Imported Upstream version 8.0pl3+8.1alphaupstream/8.0pl3+8.1alpha

1447 files changed, 127495 insertions, 108235 deletions

diff --git a/.depend b/.depend
index 26002dd0..77caebd1 100644
--- a/.depend
+++ b/.depend
@@ -1,759 +1,875 @@
 ide/config_parser.cmi: lib/util.cmi 
-ide/coq.cmi: toplevel/vernacexpr.cmo lib/util.cmi kernel/term.cmi \
-    kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi 
-interp/constrextern.cmi: lib/util.cmi interp/topconstr.cmi \
-    pretyping/termops.cmi kernel/term.cmi interp/symbols.cmi kernel/sign.cmi \
-    pretyping/rawterm.cmi pretyping/pattern.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi library/impargs.cmi \
-    kernel/environ.cmi 
-interp/constrintern.cmi: interp/topconstr.cmi pretyping/termops.cmi \
-    kernel/term.cmi kernel/sign.cmi pretyping/rawterm.cmi \
-    pretyping/pattern.cmi kernel/names.cmi library/libnames.cmi \
-    library/impargs.cmi pretyping/evd.cmi kernel/environ.cmi \
-    parsing/coqast.cmi 
-interp/coqlib.cmi: kernel/term.cmi pretyping/pattern.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi 
-interp/genarg.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi kernel/names.cmi library/libnames.cmi \
-    pretyping/evd.cmi 
-interp/modintern.cmi: interp/topconstr.cmi kernel/environ.cmi \
-    kernel/entries.cmi kernel/declarations.cmi 
-interp/ppextend.cmi: lib/pp.cmi kernel/names.cmi 
-interp/reserve.cmi: lib/util.cmi pretyping/rawterm.cmi kernel/names.cmi 
-interp/symbols.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    pretyping/rawterm.cmi interp/ppextend.cmi lib/pp.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi pretyping/classops.cmi \
-    lib/bignat.cmi 
-interp/syntax_def.cmi: lib/util.cmi interp/topconstr.cmi \
-    pretyping/rawterm.cmi kernel/names.cmi 
-interp/topconstr.cmi: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \
-    lib/pp.cmi kernel/names.cmi library/libnames.cmi lib/dyn.cmi \
-    lib/bignat.cmi 
-kernel/closure.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi \
-    kernel/esubst.cmi kernel/environ.cmi 
-kernel/conv_oracle.cmi: kernel/names.cmi kernel/closure.cmi 
-kernel/cooking.cmi: kernel/univ.cmi kernel/term.cmi kernel/names.cmi \
-    kernel/environ.cmi kernel/declarations.cmi 
-kernel/declarations.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
-    lib/rtree.cmi kernel/names.cmi 
-kernel/entries.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
+ide/coq.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \
+    kernel/term.cmi lib/util.cmi toplevel/vernacexpr.cmo 
+interp/constrextern.cmi: kernel/environ.cmi library/libnames.cmi \
+    kernel/names.cmi library/nametab.cmi interp/notation.cmi \
+    pretyping/pattern.cmi pretyping/rawterm.cmi kernel/sign.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi 
+interp/constrintern.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    library/impargs.cmi library/libnames.cmi kernel/names.cmi \
+    pretyping/pattern.cmi pretyping/pretyping.cmi pretyping/rawterm.cmi \
+    kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \
+    interp/topconstr.cmi 
+interp/coqlib.cmi: library/libnames.cmi kernel/names.cmi library/nametab.cmi \
+    pretyping/pattern.cmi kernel/term.cmi 
+interp/genarg.cmi: pretyping/evd.cmi library/libnames.cmi kernel/names.cmi \
+    lib/pp.cmi pretyping/rawterm.cmi kernel/term.cmi interp/topconstr.cmi \
+    lib/util.cmi 
+interp/modintern.cmi: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi interp/topconstr.cmi 
+interp/notation.cmi: lib/bigint.cmi pretyping/classops.cmi \
+    library/libnames.cmi kernel/names.cmi library/nametab.cmi lib/pp.cmi \
+    interp/ppextend.cmi pretyping/rawterm.cmi kernel/term.cmi \
+    interp/topconstr.cmi lib/util.cmi 
+interp/ppextend.cmi: kernel/names.cmi lib/pp.cmi 
+interp/reserve.cmi: kernel/names.cmi pretyping/rawterm.cmi lib/util.cmi 
+interp/syntax_def.cmi: library/libnames.cmi kernel/names.cmi \
+    pretyping/rawterm.cmi interp/topconstr.cmi lib/util.cmi 
+interp/topconstr.cmi: lib/bigint.cmi lib/dyn.cmi pretyping/evd.cmi \
+    library/libnames.cmi kernel/mod_subst.cmi kernel/names.cmi lib/pp.cmi \
+    pretyping/rawterm.cmi kernel/term.cmi lib/util.cmi 
+kernel/cbytecodes.cmi: kernel/names.cmi kernel/term.cmi 
+kernel/cbytegen.cmi: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \
+    kernel/declarations.cmi kernel/names.cmi kernel/pre_env.cmi \
+    kernel/term.cmi 
+kernel/cemitcodes.cmi: kernel/cbytecodes.cmi kernel/mod_subst.cmi \
     kernel/names.cmi 
-kernel/environ.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/names.cmi kernel/declarations.cmi 
+kernel/closure.cmi: kernel/environ.cmi kernel/esubst.cmi kernel/names.cmi \
+    lib/pp.cmi kernel/term.cmi 
+kernel/conv_oracle.cmi: kernel/names.cmi 
+kernel/cooking.cmi: kernel/declarations.cmi kernel/environ.cmi \
+    kernel/names.cmi kernel/sign.cmi kernel/term.cmi kernel/univ.cmi 
+kernel/csymtable.cmi: kernel/names.cmi kernel/pre_env.cmi kernel/term.cmi 
+kernel/declarations.cmi: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \
+    kernel/mod_subst.cmi kernel/names.cmi lib/rtree.cmi kernel/sign.cmi \
+    kernel/term.cmi kernel/univ.cmi 
+kernel/entries.cmi: kernel/names.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi 
+kernel/environ.cmi: kernel/cemitcodes.cmi kernel/declarations.cmi \
+    kernel/names.cmi kernel/pre_env.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi 
 kernel/esubst.cmi: lib/util.cmi 
-kernel/indtypes.cmi: kernel/univ.cmi kernel/typeops.cmi kernel/term.cmi \
-    kernel/names.cmi kernel/environ.cmi kernel/entries.cmi \
-    kernel/declarations.cmi 
-kernel/inductive.cmi: kernel/univ.cmi kernel/term.cmi kernel/names.cmi \
-    kernel/environ.cmi kernel/declarations.cmi 
-kernel/mod_typing.cmi: kernel/environ.cmi kernel/entries.cmi \
-    kernel/declarations.cmi 
-kernel/modops.cmi: lib/util.cmi kernel/univ.cmi kernel/names.cmi \
-    kernel/environ.cmi kernel/entries.cmi kernel/declarations.cmi 
-kernel/names.cmi: lib/predicate.cmi lib/pp.cmi 
-kernel/reduction.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
+kernel/indtypes.cmi: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi kernel/names.cmi kernel/term.cmi kernel/typeops.cmi \
+    kernel/univ.cmi 
+kernel/inductive.cmi: kernel/declarations.cmi kernel/environ.cmi \
+    kernel/names.cmi kernel/term.cmi kernel/univ.cmi 
+kernel/modops.cmi: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi kernel/mod_subst.cmi kernel/names.cmi kernel/univ.cmi \
+    lib/util.cmi 
+kernel/mod_subst.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi 
+kernel/mod_typing.cmi: kernel/declarations.cmi kernel/entries.cmi \
     kernel/environ.cmi 
-kernel/safe_typing.cmi: kernel/univ.cmi kernel/term.cmi kernel/names.cmi \
-    kernel/environ.cmi kernel/entries.cmi kernel/declarations.cmi \
-    kernel/cooking.cmi 
-kernel/sign.cmi: kernel/term.cmi kernel/names.cmi 
-kernel/subtyping.cmi: kernel/univ.cmi kernel/environ.cmi \
-    kernel/declarations.cmi 
-kernel/term.cmi: kernel/univ.cmi kernel/names.cmi kernel/esubst.cmi 
-kernel/term_typing.cmi: kernel/univ.cmi kernel/typeops.cmi kernel/term.cmi \
-    kernel/names.cmi kernel/inductive.cmi kernel/environ.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/univ.cmi: lib/pp.cmi kernel/names.cmi 
-lib/bignat.cmi: lib/pp.cmi 
+kernel/names.cmi: lib/pp.cmi lib/predicate.cmi 
+kernel/pre_env.cmi: kernel/declarations.cmi kernel/names.cmi kernel/sign.cmi \
+    kernel/term.cmi kernel/univ.cmi lib/util.cmi 
+kernel/reduction.cmi: kernel/environ.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi 
+kernel/safe_typing.cmi: kernel/cooking.cmi kernel/declarations.cmi \
+    kernel/entries.cmi kernel/environ.cmi kernel/names.cmi kernel/term.cmi \
+    kernel/univ.cmi 
+kernel/sign.cmi: kernel/names.cmi kernel/term.cmi 
+kernel/subtyping.cmi: kernel/declarations.cmi kernel/environ.cmi \
+    kernel/univ.cmi 
+kernel/term.cmi: kernel/esubst.cmi kernel/names.cmi kernel/univ.cmi 
+kernel/term_typing.cmi: kernel/cooking.cmi kernel/declarations.cmi \
+    kernel/entries.cmi kernel/environ.cmi kernel/inductive.cmi \
+    kernel/names.cmi kernel/term.cmi kernel/typeops.cmi kernel/univ.cmi 
+kernel/type_errors.cmi: kernel/environ.cmi kernel/names.cmi kernel/term.cmi 
+kernel/typeops.cmi: kernel/entries.cmi kernel/environ.cmi kernel/names.cmi \
+    kernel/sign.cmi kernel/term.cmi kernel/univ.cmi 
+kernel/univ.cmi: kernel/names.cmi lib/pp.cmi 
+kernel/vconv.cmi: kernel/environ.cmi kernel/names.cmi kernel/reduction.cmi \
+    kernel/term.cmi kernel/vm.cmi 
+kernel/vm.cmi: kernel/cbytecodes.cmi kernel/cemitcodes.cmi kernel/names.cmi \
+    kernel/term.cmi 
+lib/bigint.cmi: lib/pp.cmi 
 lib/pp.cmi: lib/pp_control.cmi 
+library/declare.cmi: library/decl_kinds.cmo kernel/declarations.cmi \
+    kernel/entries.cmi kernel/environ.cmi kernel/indtypes.cmi \
+    library/libnames.cmi kernel/names.cmi library/nametab.cmi \
+    kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi 
+library/declaremods.cmi: kernel/entries.cmi kernel/environ.cmi \
+    library/lib.cmi library/libnames.cmi library/libobject.cmi \
+    kernel/names.cmi lib/pp.cmi kernel/safe_typing.cmi lib/util.cmi 
+library/dischargedhypsmap.cmi: kernel/environ.cmi library/libnames.cmi \
+    library/nametab.cmi kernel/term.cmi 
+library/global.cmi: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi kernel/indtypes.cmi library/libnames.cmi \
+    kernel/names.cmi kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi 
+library/goptions.cmi: library/libnames.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi library/nametab.cmi lib/pp.cmi kernel/term.cmi \
+    lib/util.cmi 
+library/impargs.cmi: kernel/environ.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi kernel/term.cmi interp/topconstr.cmi 
+library/lib.cmi: library/libnames.cmi library/libobject.cmi \
+    kernel/mod_subst.cmi kernel/names.cmi kernel/sign.cmi library/summary.cmi \
+    kernel/term.cmi lib/util.cmi 
+library/libnames.cmi: kernel/mod_subst.cmi kernel/names.cmi lib/pp.cmi \
+    lib/predicate.cmi kernel/term.cmi lib/util.cmi 
+library/libobject.cmi: library/libnames.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi 
+library/library.cmi: library/libnames.cmi library/libobject.cmi \
+    kernel/names.cmi lib/pp.cmi lib/system.cmi lib/util.cmi 
+library/nameops.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi 
+library/nametab.cmi: library/libnames.cmi kernel/names.cmi lib/pp.cmi \
+    lib/util.cmi 
 lib/rtree.cmi: lib/pp.cmi 
 lib/system.cmi: lib/pp.cmi 
-lib/util.cmi: lib/pp.cmi lib/compat.cmo 
-library/declare.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/safe_typing.cmi library/nametab.cmi kernel/names.cmi \
-    library/libobject.cmi library/libnames.cmi kernel/indtypes.cmi \
-    kernel/entries.cmi library/dischargedhypsmap.cmi kernel/declarations.cmi \
-    library/decl_kinds.cmo kernel/cooking.cmi 
-library/declaremods.cmi: lib/util.cmi kernel/safe_typing.cmi lib/pp.cmi \
-    kernel/names.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi kernel/environ.cmi kernel/entries.cmi 
-library/dischargedhypsmap.cmi: kernel/term.cmi library/nametab.cmi \
-    library/libnames.cmi kernel/environ.cmi 
-library/global.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/safe_typing.cmi kernel/names.cmi library/libnames.cmi \
-    kernel/indtypes.cmi kernel/environ.cmi kernel/entries.cmi \
-    kernel/declarations.cmi 
-library/goptions.cmi: lib/util.cmi kernel/term.cmi lib/pp.cmi \
-    library/nametab.cmi kernel/names.cmi library/libnames.cmi 
-library/impargs.cmi: interp/topconstr.cmi kernel/term.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi kernel/environ.cmi 
-library/lib.cmi: lib/util.cmi library/summary.cmi kernel/names.cmi \
-    library/libobject.cmi library/libnames.cmi 
-library/libnames.cmi: lib/util.cmi kernel/term.cmi lib/predicate.cmi \
-    lib/pp.cmi kernel/names.cmi 
-library/libobject.cmi: kernel/names.cmi library/libnames.cmi 
-library/library.cmi: lib/util.cmi lib/system.cmi lib/pp.cmi kernel/names.cmi \
-    library/libobject.cmi library/libnames.cmi 
-library/nameops.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi 
-library/nametab.cmi: lib/util.cmi lib/pp.cmi kernel/names.cmi \
-    library/libnames.cmi 
-parsing/ast.cmi: lib/util.cmi interp/topconstr.cmi lib/pp.cmi \
-    kernel/names.cmi library/libnames.cmi interp/genarg.cmi lib/dyn.cmi \
-    parsing/coqast.cmi 
-parsing/coqast.cmi: lib/util.cmi kernel/names.cmi library/libnames.cmi \
-    lib/dyn.cmi 
-parsing/egrammar.cmi: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi \
-    parsing/pptactic.cmi interp/ppextend.cmi kernel/names.cmi \
-    interp/genarg.cmi parsing/extend.cmi parsing/coqast.cmi parsing/ast.cmi 
-parsing/esyntax.cmi: interp/topconstr.cmi interp/symbols.cmi \
-    interp/ppextend.cmi lib/pp.cmi parsing/extend.cmi parsing/coqast.cmi \
-    parsing/ast.cmi 
-parsing/extend.cmi: lib/util.cmi interp/topconstr.cmi interp/ppextend.cmi \
-    lib/pp.cmi kernel/names.cmi interp/genarg.cmi parsing/coqast.cmi \
-    parsing/ast.cmi 
-parsing/g_minicoq.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi \
-    kernel/environ.cmi 
-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 parsing/coqast.cmi lib/bignat.cmi parsing/ast.cmi 
-parsing/ppconstr.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    proofs/tacexpr.cmo pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi \
-    kernel/names.cmi library/libnames.cmi parsing/extend.cmi \
-    kernel/environ.cmi parsing/coqast.cmi 
-parsing/pptactic.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    proofs/tacexpr.cmo pretyping/rawterm.cmi proofs/proof_type.cmi \
-    pretyping/pretyping.cmi lib/pp.cmi library/libnames.cmi interp/genarg.cmi 
-parsing/prettyp.cmi: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    kernel/sign.cmi kernel/safe_typing.cmi pretyping/reductionops.cmi \
-    lib/pp.cmi library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    library/lib.cmi library/impargs.cmi kernel/environ.cmi \
-    pretyping/classops.cmi 
-parsing/printer.cmi: pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi pretyping/pattern.cmi \
-    library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    kernel/environ.cmi 
-parsing/printmod.cmi: lib/pp.cmi kernel/names.cmi 
-parsing/search.cmi: kernel/term.cmi lib/pp.cmi pretyping/pattern.cmi \
-    library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    kernel/environ.cmi 
-parsing/termast.cmi: pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \
-    pretyping/rawterm.cmi pretyping/pattern.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi kernel/environ.cmi \
-    parsing/coqast.cmi 
-pretyping/cases.cmi: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \
-    kernel/names.cmi pretyping/inductiveops.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/environ.cmi 
-pretyping/cbv.cmi: kernel/term.cmi kernel/names.cmi kernel/esubst.cmi \
-    kernel/environ.cmi kernel/closure.cmi 
-pretyping/classops.cmi: kernel/term.cmi lib/pp.cmi library/nametab.cmi \
-    kernel/names.cmi library/libobject.cmi library/libnames.cmi \
-    pretyping/evd.cmi kernel/environ.cmi library/decl_kinds.cmo 
-pretyping/coercion.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
-    pretyping/rawterm.cmi kernel/names.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/environ.cmi 
-pretyping/detyping.cmi: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    kernel/sign.cmi pretyping/rawterm.cmi kernel/names.cmi kernel/environ.cmi 
-pretyping/evarconv.cmi: kernel/term.cmi kernel/sign.cmi \
-    pretyping/reductionops.cmi pretyping/evarutil.cmi kernel/environ.cmi 
-pretyping/evarutil.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
-    pretyping/reductionops.cmi pretyping/rawterm.cmi kernel/names.cmi \
-    pretyping/evd.cmi kernel/environ.cmi 
-pretyping/evd.cmi: kernel/term.cmi kernel/sign.cmi kernel/names.cmi 
-pretyping/indrec.cmi: kernel/term.cmi kernel/names.cmi \
-    pretyping/inductiveops.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/declarations.cmi 
-pretyping/inductiveops.cmi: kernel/term.cmi kernel/sign.cmi kernel/names.cmi \
-    pretyping/evd.cmi kernel/environ.cmi kernel/declarations.cmi 
-pretyping/instantiate.cmi: kernel/term.cmi kernel/sign.cmi kernel/names.cmi \
-    pretyping/evd.cmi kernel/environ.cmi 
-pretyping/matching.cmi: pretyping/termops.cmi kernel/term.cmi \
-    pretyping/pattern.cmi kernel/names.cmi pretyping/evd.cmi \
-    kernel/environ.cmi 
-pretyping/pattern.cmi: kernel/term.cmi kernel/sign.cmi pretyping/rawterm.cmi \
-    lib/pp.cmi library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    kernel/environ.cmi 
-pretyping/pretype_errors.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi kernel/names.cmi \
-    pretyping/inductiveops.cmi pretyping/evd.cmi kernel/environ.cmi 
-pretyping/pretyping.cmi: kernel/term.cmi kernel/sign.cmi \
-    pretyping/rawterm.cmi kernel/names.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/environ.cmi lib/dyn.cmi 
-pretyping/rawterm.cmi: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/sign.cmi library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    lib/dyn.cmi 
-pretyping/recordops.cmi: kernel/term.cmi library/nametab.cmi kernel/names.cmi \
-    library/library.cmi library/libobject.cmi library/libnames.cmi \
-    pretyping/classops.cmi 
-pretyping/reductionops.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi kernel/closure.cmi 
-pretyping/retyping.cmi: pretyping/termops.cmi kernel/term.cmi \
-    pretyping/pattern.cmi kernel/names.cmi pretyping/evd.cmi \
-    kernel/environ.cmi 
-pretyping/tacred.cmi: kernel/term.cmi pretyping/reductionops.cmi \
-    pretyping/rawterm.cmi kernel/names.cmi library/libnames.cmi \
-    pretyping/evd.cmi kernel/environ.cmi kernel/closure.cmi 
-pretyping/termops.cmi: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/sign.cmi lib/pp.cmi kernel/names.cmi kernel/environ.cmi 
-pretyping/typing.cmi: kernel/term.cmi pretyping/evd.cmi kernel/environ.cmi 
-proofs/clenv.cmi: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    kernel/sign.cmi pretyping/reductionops.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi pretyping/pretyping.cmi lib/pp.cmi kernel/names.cmi \
-    pretyping/evd.cmi kernel/environ.cmi 
-proofs/evar_refiner.cmi: interp/topconstr.cmi kernel/term.cmi \
-    proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \
-    proofs/proof_type.cmi kernel/names.cmi pretyping/evd.cmi \
-    kernel/environ.cmi 
-proofs/logic.cmi: kernel/term.cmi kernel/sign.cmi proofs/proof_type.cmi \
-    lib/pp.cmi kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi 
-proofs/pfedit.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi lib/pp.cmi \
-    kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi kernel/entries.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 
-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 
-proofs/refiner.cmi: pretyping/termops.cmi kernel/term.cmi proofs/tacexpr.cmo \
-    kernel/sign.cmi proofs/proof_type.cmi proofs/proof_trees.cmi lib/pp.cmi \
-    pretyping/evd.cmi 
-proofs/tacmach.cmi: interp/topconstr.cmi pretyping/termops.cmi \
-    kernel/term.cmi pretyping/tacred.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    proofs/refiner.cmi kernel/reduction.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi proofs/proof_trees.cmi lib/pp.cmi kernel/names.cmi \
-    pretyping/evd.cmi kernel/environ.cmi 
-proofs/tactic_debug.cmi: kernel/term.cmi proofs/tacexpr.cmo \
-    proofs/proof_type.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \
-    kernel/environ.cmi 
-tactics/auto.cmi: toplevel/vernacexpr.cmo lib/util.cmi kernel/term.cmi \
-    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi lib/pp.cmi \
-    pretyping/pattern.cmi kernel/names.cmi library/libnames.cmi \
-    pretyping/evd.cmi kernel/environ.cmi proofs/clenv.cmi tactics/btermdn.cmi 
-tactics/autorewrite.cmi: kernel/term.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo 
-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/dhyp.cmi: toplevel/vernacexpr.cmo interp/topconstr.cmi \
-    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/names.cmi 
-tactics/eauto.cmi: kernel/term.cmi proofs/tacexpr.cmo proofs/proof_type.cmi 
-tactics/elim.cmi: kernel/term.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi kernel/names.cmi \
-    interp/genarg.cmi 
-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 
-tactics/extraargs.cmi: interp/topconstr.cmi kernel/term.cmi \
-    proofs/tacexpr.cmo proofs/proof_type.cmi parsing/pcoq.cmi 
-tactics/extratactics.cmi: kernel/term.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi kernel/names.cmi interp/genarg.cmi 
-tactics/hiddentac.cmi: kernel/term.cmi tactics/tacticals.cmi \
-    pretyping/tacred.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \
-    pretyping/rawterm.cmi proofs/proof_type.cmi kernel/names.cmi \
-    interp/genarg.cmi 
-tactics/hipattern.cmi: lib/util.cmi kernel/term.cmi proofs/tacmach.cmi \
-    kernel/sign.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    pretyping/pattern.cmi kernel/names.cmi pretyping/evd.cmi \
-    interp/coqlib.cmi 
-tactics/inv.cmi: kernel/term.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \
-    pretyping/rawterm.cmi kernel/names.cmi interp/genarg.cmi 
-tactics/leminv.cmi: interp/topconstr.cmi kernel/term.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi kernel/names.cmi 
-tactics/nbtermdn.cmi: kernel/term.cmi pretyping/pattern.cmi \
-    tactics/btermdn.cmi 
-tactics/refine.cmi: kernel/term.cmi proofs/tacmach.cmi \
-    pretyping/pretyping.cmi 
-tactics/setoid_replace.cmi: interp/topconstr.cmi kernel/term.cmi \
-    proofs/proof_type.cmi kernel/names.cmi 
-tactics/tacinterp.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    proofs/tactic_debug.cmi pretyping/tacred.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo proofs/proof_type.cmi lib/pp.cmi library/nametab.cmi \
-    kernel/names.cmi interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi \
-    lib/dyn.cmi parsing/coqast.cmi 
-tactics/tacticals.cmi: kernel/term.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \
-    kernel/sign.cmi kernel/reduction.cmi proofs/proof_type.cmi \
-    pretyping/pattern.cmi kernel/names.cmi interp/genarg.cmi proofs/clenv.cmi 
-tactics/tactics.cmi: interp/topconstr.cmi kernel/term.cmi \
-    tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo kernel/sign.cmi kernel/reduction.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi interp/genarg.cmi pretyping/evd.cmi \
-    proofs/evar_refiner.cmi kernel/environ.cmi proofs/clenv.cmi 
-tactics/termdn.cmi: kernel/term.cmi pretyping/pattern.cmi 
-toplevel/cerrors.cmi: lib/util.cmi lib/pp.cmi 
-toplevel/class.cmi: kernel/term.cmi proofs/tacexpr.cmo library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi library/declare.cmi \
-    library/decl_kinds.cmo pretyping/classops.cmi 
-toplevel/command.cmi: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi kernel/term.cmi pretyping/tacred.cmi \
-    proofs/tacexpr.cmo pretyping/rawterm.cmi library/nametab.cmi \
-    kernel/names.cmi library/library.cmi library/libnames.cmi \
-    pretyping/evd.cmi kernel/environ.cmi kernel/entries.cmi \
-    library/declare.cmi library/decl_kinds.cmo 
+lib/util.cmi: lib/compat.cmo lib/pp.cmi 
+parsing/egrammar.cmi: parsing/extend.cmi interp/genarg.cmi \
+    kernel/mod_subst.cmi kernel/names.cmi parsing/pcoq.cmi \
+    interp/ppextend.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \
+    interp/topconstr.cmi lib/util.cmi toplevel/vernacexpr.cmo 
+parsing/extend.cmi: lib/util.cmi 
+parsing/g_minicoq.cmi: kernel/environ.cmi kernel/names.cmi lib/pp.cmi \
+    kernel/term.cmi 
+parsing/lexer.cmi: lib/pp.cmi lib/util.cmi 
+parsing/pcoq.cmi: lib/bigint.cmi library/decl_kinds.cmo parsing/extend.cmi \
+    interp/genarg.cmi library/libnames.cmi kernel/names.cmi \
+    pretyping/rawterm.cmi proofs/tacexpr.cmo interp/topconstr.cmi \
+    lib/util.cmi toplevel/vernacexpr.cmo 
+parsing/ppconstr.cmi: kernel/environ.cmi interp/genarg.cmi \
+    library/libnames.cmi kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi \
+    interp/ppextend.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \
+    kernel/term.cmi interp/topconstr.cmi lib/util.cmi 
+parsing/pptactic.cmi: kernel/environ.cmi interp/genarg.cmi \
+    library/libnames.cmi lib/pp.cmi interp/ppextend.cmi \
+    pretyping/pretyping.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    proofs/tacexpr.cmo kernel/term.cmi interp/topconstr.cmi 
+parsing/ppvernac.cmi: interp/genarg.cmi library/libnames.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi parsing/pcoq.cmi \
+    lib/pp.cmi parsing/ppconstr.cmi interp/ppextend.cmi parsing/pptactic.cmi \
+    pretyping/rawterm.cmi interp/topconstr.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo 
+parsing/prettyp.cmi: pretyping/classops.cmi kernel/environ.cmi \
+    library/impargs.cmi library/lib.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi pretyping/reductionops.cmi \
+    kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi 
+parsing/printer.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    library/libnames.cmi kernel/names.cmi library/nametab.cmi \
+    pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi 
+parsing/printmod.cmi: kernel/names.cmi lib/pp.cmi 
+parsing/q_util.cmi: parsing/pcoq.cmi lib/util.cmi 
+parsing/search.cmi: kernel/environ.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi pretyping/pattern.cmi lib/pp.cmi kernel/term.cmi 
+parsing/tactic_printer.cmi: pretyping/evd.cmi lib/pp.cmi \
+    proofs/proof_type.cmi kernel/sign.cmi proofs/tacexpr.cmo 
+pretyping/cases.cmi: pretyping/coercion.cmi kernel/environ.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi pretyping/inductiveops.cmi \
+    kernel/names.cmi pretyping/rawterm.cmi kernel/term.cmi lib/util.cmi 
+pretyping/cbv.cmi: kernel/closure.cmi kernel/environ.cmi kernel/esubst.cmi \
+    kernel/names.cmi kernel/term.cmi 
+pretyping/classops.cmi: library/decl_kinds.cmo kernel/environ.cmi \
+    pretyping/evd.cmi library/libnames.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi library/nametab.cmi lib/pp.cmi kernel/term.cmi 
+pretyping/clenv.cmi: kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi kernel/mod_subst.cmi kernel/names.cmi lib/pp.cmi \
+    pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi lib/util.cmi 
+pretyping/coercion.cmi: kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi kernel/names.cmi pretyping/rawterm.cmi kernel/sign.cmi \
+    kernel/term.cmi lib/util.cmi 
+pretyping/detyping.cmi: kernel/environ.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi 
+pretyping/evarconv.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    pretyping/reductionops.cmi kernel/sign.cmi kernel/term.cmi 
+pretyping/evarutil.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \
+    pretyping/rawterm.cmi pretyping/reductionops.cmi kernel/sign.cmi \
+    kernel/term.cmi lib/util.cmi 
+pretyping/evd.cmi: kernel/environ.cmi library/libnames.cmi \
+    kernel/mod_subst.cmi kernel/names.cmi lib/pp.cmi kernel/reduction.cmi \
+    kernel/sign.cmi kernel/term.cmi lib/util.cmi 
+pretyping/indrec.cmi: kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi pretyping/inductiveops.cmi kernel/names.cmi \
+    kernel/term.cmi 
+pretyping/inductiveops.cmi: kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi kernel/mod_subst.cmi kernel/names.cmi kernel/sign.cmi \
+    kernel/term.cmi 
+pretyping/matching.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \
+    pretyping/pattern.cmi kernel/term.cmi pretyping/termops.cmi 
+pretyping/pattern.cmi: kernel/environ.cmi library/libnames.cmi \
+    kernel/mod_subst.cmi kernel/names.cmi library/nametab.cmi lib/pp.cmi \
+    pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi 
+pretyping/pretype_errors.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    pretyping/inductiveops.cmi kernel/names.cmi lib/pp.cmi \
+    pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi lib/util.cmi 
+pretyping/pretyping.cmi: pretyping/cases.cmi pretyping/coercion.cmi \
+    lib/dyn.cmi kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    kernel/names.cmi pretyping/rawterm.cmi kernel/sign.cmi kernel/term.cmi 
+pretyping/rawterm.cmi: lib/dyn.cmi pretyping/evd.cmi library/libnames.cmi \
+    kernel/names.cmi library/nametab.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi lib/util.cmi 
+pretyping/recordops.cmi: pretyping/classops.cmi library/libnames.cmi \
+    library/libobject.cmi library/library.cmi kernel/names.cmi \
+    library/nametab.cmi kernel/term.cmi 
+pretyping/reductionops.cmi: kernel/closure.cmi kernel/environ.cmi \
+    pretyping/evd.cmi kernel/names.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi 
+pretyping/retyping.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/term.cmi \
+    pretyping/termops.cmi 
+pretyping/tacred.cmi: kernel/closure.cmi kernel/environ.cmi pretyping/evd.cmi \
+    library/libnames.cmi kernel/names.cmi pretyping/rawterm.cmi \
+    pretyping/reductionops.cmi kernel/term.cmi kernel/type_errors.cmi 
+pretyping/termops.cmi: kernel/environ.cmi kernel/names.cmi lib/pp.cmi \
+    kernel/sign.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi 
+pretyping/typing.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/term.cmi 
+pretyping/unification.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    kernel/term.cmi 
+proofs/clenvtac.cmi: pretyping/clenv.cmi pretyping/evd.cmi kernel/names.cmi \
+    proofs/proof_type.cmi kernel/sign.cmi kernel/term.cmi lib/util.cmi 
+proofs/evar_refiner.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    kernel/names.cmi pretyping/rawterm.cmi proofs/refiner.cmi kernel/term.cmi \
+    interp/topconstr.cmi 
+proofs/logic.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \
+    proofs/proof_type.cmi kernel/sign.cmi kernel/term.cmi 
+proofs/pfedit.cmi: library/decl_kinds.cmo kernel/entries.cmi \
+    kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi lib/pp.cmi \
+    kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \
+    interp/topconstr.cmi lib/util.cmi 
+proofs/proof_trees.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \
+    lib/pp.cmi proofs/proof_type.cmi kernel/sign.cmi kernel/term.cmi \
+    lib/util.cmi 
+proofs/proof_type.cmi: kernel/environ.cmi pretyping/evd.cmi interp/genarg.cmi \
+    library/libnames.cmi kernel/names.cmi library/nametab.cmi \
+    pretyping/pattern.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \
+    kernel/term.cmi lib/util.cmi 
+proofs/redexpr.cmi: kernel/closure.cmi kernel/names.cmi pretyping/rawterm.cmi \
+    pretyping/reductionops.cmi kernel/term.cmi 
+proofs/refiner.cmi: kernel/environ.cmi pretyping/evd.cmi lib/pp.cmi \
+    proofs/proof_trees.cmi proofs/proof_type.cmi kernel/sign.cmi \
+    proofs/tacexpr.cmo kernel/term.cmi pretyping/termops.cmi 
+proofs/tacmach.cmi: kernel/environ.cmi pretyping/evd.cmi kernel/names.cmi \
+    lib/pp.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi proofs/redexpr.cmi kernel/reduction.cmi \
+    proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo kernel/term.cmi \
+    pretyping/termops.cmi interp/topconstr.cmi 
+proofs/tactic_debug.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \
+    proofs/tacexpr.cmo kernel/term.cmi 
+tactics/auto.cmi: tactics/btermdn.cmi pretyping/clenv.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/libnames.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi kernel/sign.cmi proofs/tacexpr.cmo \
+    proofs/tacmach.cmi kernel/term.cmi lib/util.cmi toplevel/vernacexpr.cmo 
+tactics/autorewrite.cmi: kernel/names.cmi proofs/tacexpr.cmo \
+    proofs/tacmach.cmi kernel/term.cmi 
+tactics/btermdn.cmi: pretyping/pattern.cmi kernel/term.cmi 
+tactics/contradiction.cmi: kernel/names.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi kernel/term.cmi 
+tactics/dhyp.cmi: kernel/names.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \
+    interp/topconstr.cmi toplevel/vernacexpr.cmo 
+tactics/eauto.cmi: tactics/auto.cmi proofs/proof_type.cmi proofs/tacexpr.cmo \
+    kernel/term.cmi interp/topconstr.cmi 
+tactics/elim.cmi: interp/genarg.cmi kernel/names.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi proofs/tacmach.cmi tactics/tacticals.cmi \
+    kernel/term.cmi 
+tactics/equality.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    tactics/hipattern.cmi kernel/names.cmi pretyping/pattern.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi kernel/sign.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi 
+tactics/evar_tactics.cmi: kernel/names.cmi pretyping/rawterm.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi 
+tactics/extraargs.cmi: kernel/names.cmi parsing/pcoq.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi tactics/setoid_replace.cmi \
+    proofs/tacexpr.cmo kernel/term.cmi interp/topconstr.cmi lib/util.cmi 
+tactics/extratactics.cmi: interp/genarg.cmi kernel/names.cmi parsing/pcoq.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \
+    kernel/term.cmi interp/topconstr.cmi 
+tactics/hiddentac.cmi: interp/genarg.cmi kernel/names.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi proofs/redexpr.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \
+    kernel/term.cmi 
+tactics/hipattern.cmi: interp/coqlib.cmi pretyping/evd.cmi kernel/names.cmi \
+    pretyping/pattern.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \
+    kernel/sign.cmi proofs/tacmach.cmi kernel/term.cmi lib/util.cmi 
+tactics/inv.cmi: interp/genarg.cmi kernel/names.cmi pretyping/rawterm.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi 
+tactics/leminv.cmi: kernel/names.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi 
+tactics/nbtermdn.cmi: tactics/btermdn.cmi library/libnames.cmi \
+    pretyping/pattern.cmi kernel/term.cmi 
+tactics/refine.cmi: pretyping/evd.cmi proofs/tacmach.cmi 
+tactics/setoid_replace.cmi: kernel/names.cmi lib/pp.cmi proofs/proof_type.cmi \
+    kernel/term.cmi interp/topconstr.cmi 
+tactics/tacinterp.cmi: lib/dyn.cmi kernel/environ.cmi pretyping/evd.cmi \
+    interp/genarg.cmi library/libnames.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi library/nametab.cmi lib/pp.cmi proofs/proof_type.cmi \
+    proofs/redexpr.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \
+    proofs/tactic_debug.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi 
+tactics/tacticals.cmi: pretyping/clenv.cmi interp/genarg.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi proofs/proof_type.cmi \
+    kernel/reduction.cmi kernel/sign.cmi proofs/tacexpr.cmo \
+    proofs/tacmach.cmi kernel/term.cmi 
+tactics/tactics.cmi: pretyping/clenv.cmi kernel/environ.cmi \
+    proofs/evar_refiner.cmi pretyping/evd.cmi interp/genarg.cmi \
+    library/libnames.cmi kernel/names.cmi library/nametab.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi proofs/redexpr.cmi \
+    kernel/reduction.cmi kernel/sign.cmi proofs/tacexpr.cmo \
+    proofs/tacmach.cmi tactics/tacticals.cmi kernel/term.cmi \
+    interp/topconstr.cmi 
+tactics/termdn.cmi: library/libnames.cmi pretyping/pattern.cmi \
+    kernel/term.cmi 
+toplevel/cerrors.cmi: lib/pp.cmi lib/util.cmi 
+toplevel/class.cmi: pretyping/classops.cmi library/decl_kinds.cmo \
+    library/declare.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi proofs/tacexpr.cmo kernel/term.cmi 
+toplevel/command.cmi: library/decl_kinds.cmo library/declare.cmi \
+    kernel/entries.cmi kernel/environ.cmi pretyping/evd.cmi \
+    library/libnames.cmi library/library.cmi kernel/names.cmi \
+    library/nametab.cmi pretyping/rawterm.cmi proofs/redexpr.cmi \
+    proofs/tacexpr.cmo kernel/term.cmi interp/topconstr.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo 
 toplevel/coqinit.cmi: kernel/names.cmi 
-toplevel/discharge.cmi: kernel/names.cmi 
-toplevel/fhimsg.cmi: kernel/type_errors.cmi kernel/term.cmi kernel/sign.cmi \
-    lib/pp.cmi kernel/names.cmi kernel/environ.cmi 
-toplevel/himsg.cmi: kernel/type_errors.cmi pretyping/pretype_errors.cmi \
-    lib/pp.cmi kernel/names.cmi proofs/logic.cmi kernel/indtypes.cmi \
-    kernel/environ.cmi pretyping/cases.cmi 
-toplevel/metasyntax.cmi: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi proofs/tacexpr.cmo interp/symbols.cmi \
-    interp/ppextend.cmi library/libnames.cmi parsing/extend.cmi \
-    interp/constrintern.cmi pretyping/classops.cmi 
-toplevel/mltop.cmi: kernel/names.cmi library/libobject.cmi 
+toplevel/discharge.cmi: kernel/cooking.cmi kernel/declarations.cmi \
+    kernel/entries.cmi kernel/sign.cmi 
+toplevel/fhimsg.cmi: kernel/environ.cmi kernel/names.cmi lib/pp.cmi \
+    kernel/sign.cmi kernel/term.cmi kernel/type_errors.cmi 
+toplevel/himsg.cmi: pretyping/cases.cmi kernel/environ.cmi \
+    pretyping/indrec.cmi kernel/indtypes.cmi proofs/logic.cmi \
+    kernel/names.cmi lib/pp.cmi pretyping/pretype_errors.cmi \
+    pretyping/tacred.cmi kernel/type_errors.cmi 
+toplevel/metasyntax.cmi: pretyping/classops.cmi interp/constrintern.cmi \
+    parsing/extend.cmi library/libnames.cmi interp/notation.cmi \
+    interp/ppextend.cmi proofs/tacexpr.cmo interp/topconstr.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo 
+toplevel/mltop.cmi: library/libobject.cmi kernel/names.cmi 
 toplevel/protectedtoplevel.cmi: lib/pp.cmi 
-toplevel/record.cmi: toplevel/vernacexpr.cmo interp/topconstr.cmi \
-    kernel/term.cmi kernel/sign.cmi kernel/names.cmi 
-toplevel/recordobj.cmi: proofs/tacexpr.cmo library/libnames.cmi 
-toplevel/searchisos.cmi: kernel/term.cmi kernel/names.cmi \
-    library/libobject.cmi 
-toplevel/toplevel.cmi: lib/pp.cmi parsing/pcoq.cmi 
-toplevel/vernac.cmi: toplevel/vernacexpr.cmo lib/util.cmi parsing/pcoq.cmi 
-toplevel/vernacentries.cmi: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \
-    interp/topconstr.cmi kernel/term.cmi kernel/names.cmi \
-    library/libnames.cmi pretyping/evd.cmi kernel/environ.cmi 
+toplevel/record.cmi: kernel/names.cmi kernel/sign.cmi kernel/term.cmi \
+    interp/topconstr.cmi toplevel/vernacexpr.cmo 
+toplevel/searchisos.cmi: library/libobject.cmi kernel/names.cmi \
+    kernel/term.cmi 
+toplevel/toplevel.cmi: parsing/pcoq.cmi lib/pp.cmi 
+toplevel/vernacentries.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    library/libnames.cmi kernel/names.cmi kernel/term.cmi \
+    interp/topconstr.cmi toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi 
 toplevel/vernacinterp.cmi: proofs/tacexpr.cmo 
-translate/ppconstrnew.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 pretyping/pattern.cmi kernel/names.cmi \
-    library/libnames.cmi interp/genarg.cmi parsing/extend.cmi \
-    kernel/environ.cmi parsing/coqast.cmi 
-translate/pptacticnew.cmi: interp/topconstr.cmi proofs/tacexpr.cmo \
-    proofs/proof_type.cmi lib/pp.cmi kernel/names.cmi interp/genarg.cmi \
-    kernel/environ.cmi 
-translate/ppvernacnew.cmi: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi \
-    parsing/pptactic.cmi interp/ppextend.cmi parsing/ppconstr.cmi lib/pp.cmi \
-    parsing/pcoq.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libnames.cmi interp/genarg.cmi parsing/extend.cmi \
-    kernel/environ.cmi parsing/coqast.cmi parsing/ast.cmi 
-contrib/cc/ccalgo.cmi: kernel/term.cmi kernel/names.cmi 
-contrib/cc/ccproof.cmi: kernel/names.cmi contrib/cc/ccalgo.cmi 
-contrib/correctness/past.cmi: lib/util.cmi interp/topconstr.cmi \
-    kernel/term.cmi kernel/names.cmi 
+toplevel/vernac.cmi: parsing/pcoq.cmi lib/util.cmi toplevel/vernacexpr.cmo 
+toplevel/whelp.cmi: kernel/environ.cmi kernel/names.cmi kernel/term.cmi \
+    interp/topconstr.cmi 
+contrib/cc/ccalgo.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi \
+    lib/util.cmi 
+contrib/cc/ccproof.cmi: contrib/cc/ccalgo.cmi kernel/names.cmi 
+contrib/cc/cctac.cmi: proofs/proof_type.cmi kernel/term.cmi 
+contrib/correctness/past.cmi: kernel/names.cmi kernel/term.cmi \
+    interp/topconstr.cmi lib/util.cmi 
+contrib/correctness/pcicenv.cmi: kernel/names.cmi kernel/sign.cmi \
+    kernel/term.cmi 
 contrib/correctness/pcic.cmi: pretyping/rawterm.cmi 
-contrib/correctness/pcicenv.cmi: kernel/term.cmi kernel/sign.cmi \
-    kernel/names.cmi 
 contrib/correctness/pdb.cmi: kernel/names.cmi 
-contrib/correctness/peffect.cmi: lib/pp.cmi kernel/names.cmi 
-contrib/correctness/penv.cmi: kernel/term.cmi kernel/names.cmi \
-    library/libnames.cmi 
-contrib/correctness/perror.cmi: lib/util.cmi lib/pp.cmi kernel/names.cmi 
+contrib/correctness/peffect.cmi: kernel/names.cmi lib/pp.cmi 
+contrib/correctness/penv.cmi: library/libnames.cmi kernel/names.cmi \
+    kernel/term.cmi 
+contrib/correctness/perror.cmi: kernel/names.cmi lib/pp.cmi lib/util.cmi 
 contrib/correctness/pextract.cmi: kernel/names.cmi 
-contrib/correctness/pmisc.cmi: lib/util.cmi interp/topconstr.cmi \
-    kernel/term.cmi lib/pp.cmi kernel/names.cmi 
+contrib/correctness/pmisc.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi \
+    interp/topconstr.cmi lib/util.cmi 
 contrib/correctness/pmlize.cmi: kernel/names.cmi 
-contrib/correctness/pmonad.cmi: kernel/term.cmi kernel/names.cmi 
+contrib/correctness/pmonad.cmi: kernel/names.cmi kernel/term.cmi 
 contrib/correctness/pred.cmi: kernel/term.cmi 
-contrib/correctness/prename.cmi: lib/pp.cmi kernel/names.cmi 
-contrib/correctness/psyntax.cmi: interp/topconstr.cmi parsing/pcoq.cmi 
+contrib/correctness/prename.cmi: kernel/names.cmi lib/pp.cmi 
+contrib/correctness/psyntax.cmi: parsing/pcoq.cmi interp/topconstr.cmi 
 contrib/correctness/ptactic.cmi: proofs/tacmach.cmi 
-contrib/correctness/ptype.cmi: kernel/term.cmi kernel/names.cmi 
-contrib/correctness/ptyping.cmi: interp/topconstr.cmi kernel/term.cmi \
-    kernel/names.cmi 
-contrib/correctness/putil.cmi: kernel/term.cmi lib/pp.cmi kernel/names.cmi 
+contrib/correctness/ptype.cmi: kernel/names.cmi kernel/term.cmi 
+contrib/correctness/ptyping.cmi: kernel/names.cmi kernel/term.cmi \
+    interp/topconstr.cmi 
+contrib/correctness/putil.cmi: kernel/names.cmi lib/pp.cmi kernel/term.cmi 
 contrib/correctness/pwp.cmi: kernel/term.cmi 
-contrib/extraction/common.cmi: kernel/names.cmi contrib/extraction/mlutil.cmi \
-    contrib/extraction/miniml.cmi 
-contrib/extraction/extract_env.cmi: kernel/names.cmi library/libnames.cmi 
-contrib/extraction/extraction.cmi: kernel/term.cmi kernel/names.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi kernel/environ.cmi \
-    kernel/declarations.cmi 
-contrib/extraction/haskell.cmi: lib/pp.cmi kernel/names.cmi \
-    contrib/extraction/miniml.cmi 
-contrib/extraction/miniml.cmi: lib/util.cmi lib/pp.cmi kernel/names.cmi \
-    library/libnames.cmi 
-contrib/extraction/mlutil.cmi: lib/util.cmi kernel/term.cmi kernel/names.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi 
-contrib/extraction/modutil.cmi: kernel/names.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi kernel/environ.cmi \
-    kernel/declarations.cmi 
-contrib/extraction/ocaml.cmi: lib/pp.cmi kernel/names.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi 
-contrib/extraction/scheme.cmi: lib/pp.cmi kernel/names.cmi \
-    contrib/extraction/miniml.cmi 
-contrib/extraction/table.cmi: kernel/term.cmi kernel/names.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi kernel/environ.cmi 
-contrib/first-order/formula.cmi: kernel/term.cmi proofs/tacmach.cmi \
-    kernel/sign.cmi proofs/proof_type.cmi kernel/names.cmi \
-    library/libnames.cmi kernel/closure.cmi 
-contrib/first-order/ground.cmi: proofs/tacmach.cmi \
-    contrib/first-order/sequent.cmi proofs/proof_type.cmi 
-contrib/first-order/instances.cmi: contrib/first-order/unify.cmi \
-    kernel/term.cmi proofs/tacmach.cmi contrib/first-order/sequent.cmi \
-    contrib/first-order/rules.cmi kernel/names.cmi library/libnames.cmi \
-    contrib/first-order/formula.cmi 
-contrib/first-order/rules.cmi: kernel/term.cmi proofs/tacmach.cmi \
-    contrib/first-order/sequent.cmi kernel/names.cmi library/libnames.cmi 
-contrib/first-order/sequent.cmi: lib/util.cmi kernel/term.cmi \
-    proofs/tacmach.cmi proofs/proof_type.cmi kernel/names.cmi \
-    library/libnames.cmi lib/heap.cmi contrib/first-order/formula.cmi \
-    tactics/auto.cmi 
+contrib/dp/dp_cvcl.cmi: contrib/dp/fol.cmi 
+contrib/dp/dp.cmi: library/libnames.cmi proofs/proof_type.cmi 
+contrib/dp/dp_simplify.cmi: contrib/dp/fol.cmi 
+contrib/dp/dp_sorts.cmi: contrib/dp/fol.cmi 
+contrib/dp/dp_zenon.cmi: contrib/dp/fol.cmi 
+contrib/extraction/common.cmi: contrib/extraction/miniml.cmi \
+    contrib/extraction/mlutil.cmi kernel/names.cmi 
+contrib/extraction/extract_env.cmi: library/libnames.cmi kernel/names.cmi 
+contrib/extraction/extraction.cmi: kernel/declarations.cmi kernel/environ.cmi \
+    library/libnames.cmi contrib/extraction/miniml.cmi kernel/names.cmi \
+    kernel/term.cmi 
+contrib/extraction/haskell.cmi: contrib/extraction/miniml.cmi \
+    kernel/names.cmi lib/pp.cmi 
+contrib/extraction/miniml.cmi: library/libnames.cmi kernel/names.cmi \
+    lib/pp.cmi lib/util.cmi 
+contrib/extraction/mlutil.cmi: library/libnames.cmi \
+    contrib/extraction/miniml.cmi kernel/names.cmi kernel/term.cmi \
+    lib/util.cmi 
+contrib/extraction/modutil.cmi: kernel/declarations.cmi kernel/environ.cmi \
+    library/libnames.cmi contrib/extraction/miniml.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi 
+contrib/extraction/ocaml.cmi: library/libnames.cmi \
+    contrib/extraction/miniml.cmi kernel/names.cmi lib/pp.cmi 
+contrib/extraction/scheme.cmi: contrib/extraction/miniml.cmi kernel/names.cmi \
+    lib/pp.cmi 
+contrib/extraction/table.cmi: kernel/environ.cmi library/libnames.cmi \
+    contrib/extraction/miniml.cmi kernel/names.cmi kernel/term.cmi 
+contrib/first-order/formula.cmi: kernel/closure.cmi library/libnames.cmi \
+    kernel/names.cmi proofs/proof_type.cmi kernel/sign.cmi proofs/tacmach.cmi \
+    kernel/term.cmi 
+contrib/first-order/ground.cmi: proofs/proof_type.cmi \
+    contrib/first-order/sequent.cmi proofs/tacmach.cmi 
+contrib/first-order/instances.cmi: contrib/first-order/formula.cmi \
+    library/libnames.cmi kernel/names.cmi contrib/first-order/rules.cmi \
+    contrib/first-order/sequent.cmi proofs/tacmach.cmi kernel/term.cmi \
+    contrib/first-order/unify.cmi 
+contrib/first-order/rules.cmi: library/libnames.cmi kernel/names.cmi \
+    contrib/first-order/sequent.cmi proofs/tacmach.cmi kernel/term.cmi 
+contrib/first-order/sequent.cmi: tactics/auto.cmi \
+    contrib/first-order/formula.cmi lib/heap.cmi library/libnames.cmi \
+    kernel/names.cmi proofs/proof_type.cmi proofs/tacmach.cmi kernel/term.cmi \
+    lib/util.cmi 
 contrib/first-order/unify.cmi: kernel/term.cmi 
-contrib/funind/tacinvutils.cmi: lib/util.cmi pretyping/termops.cmi \
-    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
-    proofs/tacmach.cmi tactics/tacinterp.cmi tactics/refine.cmi \
-    pretyping/reductionops.cmi proofs/proof_type.cmi parsing/printer.cmi \
-    lib/pp.cmi kernel/names.cmi pretyping/inductiveops.cmi pretyping/evd.cmi \
-    tactics/equality.cmi interp/coqlib.cmi 
-contrib/interface/blast.cmi: proofs/tacmach.cmi proofs/tacexpr.cmo \
-    proofs/proof_type.cmi 
-contrib/interface/dad.cmi: interp/topconstr.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo proofs/proof_type.cmi 
-contrib/interface/debug_tac.cmi: proofs/tacmach.cmi proofs/tacexpr.cmo \
-    proofs/proof_type.cmi 
-contrib/interface/name_to_ast.cmi: toplevel/vernacexpr.cmo \
-    library/libnames.cmi parsing/coqast.cmi 
-contrib/interface/pbp.cmi: proofs/tacmach.cmi proofs/tacexpr.cmo \
-    proofs/proof_type.cmi kernel/names.cmi 
-contrib/interface/showproof.cmi: toplevel/vernacinterp.cmi lib/util.cmi \
-    pretyping/typing.cmi contrib/interface/translate.cmi kernel/term.cmi \
-    kernel/sign.cmi contrib/interface/showproof_ct.cmo kernel/reduction.cmi \
-    proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \
-    lib/pp.cmi proofs/pfedit.cmi kernel/names.cmi kernel/inductive.cmi \
-    pretyping/evd.cmi kernel/environ.cmi kernel/declarations.cmi \
-    parsing/coqast.cmi proofs/clenv.cmi contrib/interface/ascent.cmi 
-contrib/interface/translate.cmi: kernel/term.cmi proofs/proof_type.cmi \
-    pretyping/evd.cmi kernel/environ.cmi contrib/interface/ascent.cmi 
+contrib/funind/indfun_common.cmi: library/libnames.cmi kernel/names.cmi \
+    lib/pp.cmi pretyping/rawterm.cmi kernel/term.cmi 
+contrib/funind/new_arg_principle.cmi: kernel/names.cmi pretyping/rawterm.cmi \
+    proofs/tacmach.cmi kernel/term.cmi 
+contrib/funind/rawtermops.cmi: library/libnames.cmi kernel/names.cmi \
+    pretyping/rawterm.cmi lib/util.cmi 
+contrib/funind/rawterm_to_relation.cmi: kernel/names.cmi \
+    pretyping/rawterm.cmi interp/topconstr.cmi 
+contrib/funind/tacinvutils.cmi: interp/coqlib.cmi tactics/equality.cmi \
+    pretyping/evd.cmi pretyping/inductiveops.cmi kernel/names.cmi lib/pp.cmi \
+    parsing/printer.cmi proofs/proof_type.cmi pretyping/reductionops.cmi \
+    tactics/refine.cmi tactics/tacinterp.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi 
+contrib/interface/blast.cmi: proofs/proof_type.cmi proofs/tacexpr.cmo 
+contrib/interface/dad.cmi: proofs/proof_type.cmi proofs/tacexpr.cmo \
+    proofs/tacmach.cmi interp/topconstr.cmi 
+contrib/interface/debug_tac.cmi: pretyping/evd.cmi proofs/proof_type.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi 
+contrib/interface/name_to_ast.cmi: library/libnames.cmi \
+    toplevel/vernacexpr.cmo 
+contrib/interface/pbp.cmi: kernel/names.cmi proofs/proof_type.cmi \
+    proofs/tacexpr.cmo 
+contrib/interface/showproof.cmi: contrib/interface/ascent.cmi \
+    pretyping/clenv.cmi kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi kernel/inductive.cmi kernel/names.cmi proofs/pfedit.cmi \
+    lib/pp.cmi parsing/printer.cmi proofs/proof_trees.cmi \
+    proofs/proof_type.cmi kernel/reduction.cmi \
+    contrib/interface/showproof_ct.cmo kernel/sign.cmi kernel/term.cmi \
+    pretyping/typing.cmi lib/util.cmi toplevel/vernacinterp.cmi 
+contrib/interface/translate.cmi: contrib/interface/ascent.cmi \
+    kernel/environ.cmi pretyping/evd.cmi proofs/proof_type.cmi \
+    kernel/term.cmi 
 contrib/interface/vtp.cmi: contrib/interface/ascent.cmi 
-contrib/interface/xlate.cmi: toplevel/vernacexpr.cmo interp/topconstr.cmi \
-    proofs/tacexpr.cmo kernel/names.cmi contrib/interface/ascent.cmi 
-contrib/jprover/jall.cmi: contrib/jprover/opname.cmi \
-    contrib/jprover/jterm.cmi contrib/jprover/jlogic.cmi 
+contrib/interface/xlate.cmi: contrib/interface/ascent.cmi kernel/names.cmi \
+    proofs/tacexpr.cmo interp/topconstr.cmi toplevel/vernacexpr.cmo 
+contrib/jprover/jall.cmi: contrib/jprover/jlogic.cmi \
+    contrib/jprover/jterm.cmi contrib/jprover/opname.cmi 
 contrib/jprover/jlogic.cmi: contrib/jprover/jterm.cmi 
 contrib/jprover/jterm.cmi: contrib/jprover/opname.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 \
-    proofs/proof_type.cmi contrib/xml/proof2aproof.cmo library/libnames.cmi \
-    pretyping/evd.cmi contrib/xml/acic.cmo 
-ide/utils/configwin.cmi: ide/utils/uoptions.cmi 
-tools/coqdoc/output.cmi: tools/coqdoc/index.cmi 
-tools/coqdoc/pretty.cmi: tools/coqdoc/index.cmi 
+contrib/rtauto/refl_tauto.cmi: kernel/names.cmi \
+    contrib/rtauto/proof_search.cmi proofs/proof_type.cmi proofs/tacmach.cmi \
+    kernel/term.cmi 
+contrib/subtac/context.cmi: kernel/names.cmi kernel/term.cmi 
+contrib/subtac/eterm.cmi: pretyping/evd.cmi proofs/tacmach.cmi 
+contrib/subtac/subtac_coercion.cmi: pretyping/coercion.cmi 
+contrib/subtac/subtac_command.cmi: interp/constrintern.cmi kernel/environ.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi library/libnames.cmi \
+    kernel/names.cmi lib/pp.cmi pretyping/pretyping.cmi pretyping/rawterm.cmi \
+    kernel/term.cmi interp/topconstr.cmi lib/util.cmi toplevel/vernacexpr.cmo 
+contrib/subtac/subtac_errors.cmi: lib/pp.cmi lib/util.cmi 
+contrib/subtac/subtac_interp_fixpoint.cmi: library/libnames.cmi \
+    kernel/names.cmi lib/pp.cmi pretyping/rawterm.cmi interp/topconstr.cmi \
+    lib/util.cmi 
+contrib/subtac/subtac.cmi: kernel/names.cmi interp/topconstr.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo 
+contrib/subtac/subtac_pretyping.cmi: kernel/environ.cmi pretyping/evd.cmi \
+    library/global.cmi kernel/names.cmi pretyping/pretyping.cmi \
+    kernel/sign.cmi kernel/term.cmi interp/topconstr.cmi 
+contrib/subtac/subtac_utils.cmi: interp/coqlib.cmi library/decl_kinds.cmo \
+    kernel/environ.cmi pretyping/evd.cmi library/libnames.cmi lib/pp.cmi \
+    pretyping/rawterm.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi 
+contrib/xml/doubleTypeInference.cmi: contrib/xml/acic.cmo kernel/environ.cmi \
+    pretyping/evd.cmi kernel/names.cmi kernel/term.cmi 
+contrib/xml/xmlcommand.cmi: contrib/xml/acic.cmo pretyping/evd.cmi \
+    library/libnames.cmi contrib/xml/proof2aproof.cmo proofs/proof_type.cmi \
+    kernel/term.cmi contrib/xml/xml.cmi 
+ide/utils/configwin.cmi: ide/utils/config_file.cmi 
+tools/coqdoc/index.cmi: tools/coqdoc/cdglobals.cmo 
+tools/coqdoc/output.cmi: tools/coqdoc/cdglobals.cmo tools/coqdoc/index.cmi 
+tools/coqdoc/pretty.cmi: tools/coqdoc/cdglobals.cmo tools/coqdoc/index.cmi 
 config/coq_config.cmo: config/coq_config.cmi 
 config/coq_config.cmx: config/coq_config.cmi 
-dev/db_printers.cmo: lib/pp.cmi kernel/names.cmi 
-dev/db_printers.cmx: lib/pp.cmx kernel/names.cmx 
-dev/top_printers.cmo: kernel/univ.cmi pretyping/termops.cmi kernel/term.cmi \
-    proofs/tacmach.cmi lib/system.cmi kernel/sign.cmi proofs/refiner.cmi \
-    proofs/proof_trees.cmi parsing/printer.cmi parsing/pptactic.cmi \
-    lib/pp.cmi kernel/names.cmi library/nameops.cmi library/libobject.cmi \
-    library/libnames.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/declarations.cmi interp/constrintern.cmi interp/constrextern.cmi \
-    kernel/closure.cmi proofs/clenv.cmi toplevel/cerrors.cmi parsing/ast.cmi 
-dev/top_printers.cmx: kernel/univ.cmx pretyping/termops.cmx kernel/term.cmx \
-    proofs/tacmach.cmx lib/system.cmx kernel/sign.cmx proofs/refiner.cmx \
-    proofs/proof_trees.cmx parsing/printer.cmx parsing/pptactic.cmx \
-    lib/pp.cmx kernel/names.cmx library/nameops.cmx library/libobject.cmx \
-    library/libnames.cmx pretyping/evd.cmx kernel/environ.cmx \
-    kernel/declarations.cmx interp/constrintern.cmx interp/constrextern.cmx \
-    kernel/closure.cmx proofs/clenv.cmx toplevel/cerrors.cmx parsing/ast.cmx 
-doc/parse.cmo: parsing/ast.cmi 
-doc/parse.cmx: parsing/ast.cmx 
-ide/blaster_window.cmo: ide/ideutils.cmi ide/coq.cmi 
-ide/blaster_window.cmx: ide/ideutils.cmx ide/coq.cmx 
-ide/command_windows.cmo: ide/ideutils.cmi ide/coq_commands.cmo ide/coq.cmi \
+dev/db_printers.cmo: kernel/names.cmi lib/pp.cmi 
+dev/db_printers.cmx: kernel/names.cmx lib/pp.cmx 
+dev/top_printers.cmo: lib/bigint.cmi toplevel/cerrors.cmi pretyping/clenv.cmi \
+    kernel/closure.cmi interp/constrextern.cmi interp/constrintern.cmi \
+    kernel/declarations.cmi parsing/egrammar.cmi kernel/environ.cmi \
+    pretyping/evd.cmi interp/genarg.cmi library/global.cmi \
+    library/goptions.cmi library/libnames.cmi library/libobject.cmi \
+    proofs/logic.cmi library/nameops.cmi kernel/names.cmi parsing/pcoq.cmi \
+    proofs/pfedit.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \
+    proofs/proof_trees.cmi proofs/refiner.cmi kernel/sign.cmi lib/system.cmi \
+    parsing/tactic_printer.cmi kernel/term.cmi pretyping/termops.cmi \
+    kernel/univ.cmi lib/util.cmi toplevel/vernacinterp.cmi 
+dev/top_printers.cmx: lib/bigint.cmx toplevel/cerrors.cmx pretyping/clenv.cmx \
+    kernel/closure.cmx interp/constrextern.cmx interp/constrintern.cmx \
+    kernel/declarations.cmx parsing/egrammar.cmx kernel/environ.cmx \
+    pretyping/evd.cmx interp/genarg.cmx library/global.cmx \
+    library/goptions.cmx library/libnames.cmx library/libobject.cmx \
+    proofs/logic.cmx library/nameops.cmx kernel/names.cmx parsing/pcoq.cmx \
+    proofs/pfedit.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \
+    proofs/proof_trees.cmx proofs/refiner.cmx kernel/sign.cmx lib/system.cmx \
+    parsing/tactic_printer.cmx kernel/term.cmx pretyping/termops.cmx \
+    kernel/univ.cmx lib/util.cmx toplevel/vernacinterp.cmx 
+dev/vm_printers.cmo: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \
+    kernel/names.cmi kernel/term.cmi kernel/vm.cmi 
+dev/vm_printers.cmx: kernel/cbytecodes.cmx kernel/cemitcodes.cmx \
+    kernel/names.cmx kernel/term.cmx kernel/vm.cmx 
+ide/blaster_window.cmo: ide/coq.cmi ide/ideutils.cmi 
+ide/blaster_window.cmx: ide/coq.cmx ide/ideutils.cmx 
+ide/command_windows.cmo: ide/coq.cmi ide/coq_commands.cmo ide/ideutils.cmi \
     ide/command_windows.cmi 
-ide/command_windows.cmx: ide/ideutils.cmx ide/coq_commands.cmx ide/coq.cmx \
+ide/command_windows.cmx: ide/coq.cmx ide/coq_commands.cmx ide/ideutils.cmx \
     ide/command_windows.cmi 
-ide/config_lexer.cmo: lib/util.cmi ide/config_parser.cmi 
-ide/config_lexer.cmx: lib/util.cmx ide/config_parser.cmx 
+ide/config_lexer.cmo: ide/config_parser.cmi lib/util.cmi 
+ide/config_lexer.cmx: ide/config_parser.cmx lib/util.cmx 
 ide/config_parser.cmo: lib/util.cmi ide/config_parser.cmi 
 ide/config_parser.cmx: lib/util.cmx ide/config_parser.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 library/states.cmi \
-    proofs/refiner.cmi pretyping/reductionops.cmi proofs/proof_trees.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 
-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 library/states.cmx \
-    proofs/refiner.cmx pretyping/reductionops.cmx proofs/proof_trees.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 
+ide/coqide.cmo: ide/blaster_window.cmo ide/command_windows.cmi ide/coq.cmi \
+    ide/coq_commands.cmo ide/find_phrase.cmo ide/highlight.cmo \
+    ide/ideutils.cmi proofs/pfedit.cmi ide/preferences.cmi lib/system.cmi \
+    ide/undo.cmi lib/util.cmi toplevel/vernacexpr.cmo ide/coqide.cmi 
+ide/coqide.cmx: ide/blaster_window.cmx ide/command_windows.cmx ide/coq.cmx \
+    ide/coq_commands.cmx ide/find_phrase.cmx ide/highlight.cmx \
+    ide/ideutils.cmx proofs/pfedit.cmx ide/preferences.cmx lib/system.cmx \
+    ide/undo.cmx lib/util.cmx toplevel/vernacexpr.cmx ide/coqide.cmi 
+ide/coq.cmo: toplevel/cerrors.cmi config/coq_config.cmi toplevel/coqtop.cmi \
+    kernel/declarations.cmi kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi library/global.cmi tactics/hipattern.cmi \
+    ide/ideutils.cmi library/lib.cmi library/libnames.cmi library/library.cmi \
+    toplevel/mltop.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi parsing/printer.cmi \
+    pretyping/reductionops.cmi proofs/refiner.cmi library/states.cmi \
+    tactics/tacinterp.cmi proofs/tacmach.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi toplevel/vernac.cmi \
+    toplevel/vernacentries.cmi toplevel/vernacexpr.cmo ide/coq.cmi 
+ide/coq.cmx: toplevel/cerrors.cmx config/coq_config.cmx toplevel/coqtop.cmx \
+    kernel/declarations.cmx kernel/environ.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx library/global.cmx tactics/hipattern.cmx \
+    ide/ideutils.cmx library/lib.cmx library/libnames.cmx library/library.cmx \
+    toplevel/mltop.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx parsing/printer.cmx \
+    pretyping/reductionops.cmx proofs/refiner.cmx library/states.cmx \
+    tactics/tacinterp.cmx proofs/tacmach.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx toplevel/vernac.cmx \
+    toplevel/vernacentries.cmx toplevel/vernacexpr.cmx ide/coq.cmi 
 ide/coq_tactics.cmo: ide/coq_tactics.cmi 
 ide/coq_tactics.cmx: ide/coq_tactics.cmi 
-ide/coqide.cmo: toplevel/vernacexpr.cmo lib/util.cmi ide/undo.cmi \
-    lib/system.cmi ide/preferences.cmi proofs/pfedit.cmi ide/ideutils.cmi \
-    ide/highlight.cmo ide/find_phrase.cmo 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 proofs/pfedit.cmx ide/ideutils.cmx \
-    ide/highlight.cmx ide/find_phrase.cmx ide/coq_commands.cmx ide/coq.cmx \
-    ide/command_windows.cmx ide/blaster_window.cmx ide/coqide.cmi 
 ide/find_phrase.cmo: ide/ideutils.cmi 
 ide/find_phrase.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 \
-    lib/pp_control.cmi lib/options.cmi config/coq_config.cmi ide/ideutils.cmi 
-ide/ideutils.cmx: ide/utf8_convert.cmx lib/system.cmx ide/preferences.cmx \
-    lib/pp_control.cmx lib/options.cmx config/coq_config.cmx ide/ideutils.cmi 
-ide/preferences.cmo: lib/util.cmi lib/system.cmi ide/utils/configwin.cmi \
-    ide/config_lexer.cmo ide/preferences.cmi 
-ide/preferences.cmx: lib/util.cmx lib/system.cmx ide/utils/configwin.cmx \
-    ide/config_lexer.cmx ide/preferences.cmi 
+ide/ideutils.cmo: config/coq_config.cmi lib/options.cmi lib/pp_control.cmi \
+    ide/preferences.cmi lib/system.cmi ide/utf8_convert.cmo ide/ideutils.cmi 
+ide/ideutils.cmx: config/coq_config.cmx lib/options.cmx lib/pp_control.cmx \
+    ide/preferences.cmx lib/system.cmx ide/utf8_convert.cmx ide/ideutils.cmi 
+ide/preferences.cmo: ide/config_lexer.cmo ide/utils/configwin.cmi \
+    lib/options.cmi lib/system.cmi lib/util.cmi ide/preferences.cmi 
+ide/preferences.cmx: ide/config_lexer.cmx ide/utils/configwin.cmx \
+    lib/options.cmx lib/system.cmx lib/util.cmx ide/preferences.cmi 
 ide/undo.cmo: ide/ideutils.cmi ide/undo.cmi 
 ide/undo.cmx: ide/ideutils.cmx ide/undo.cmi 
-interp/constrextern.cmo: lib/util.cmi kernel/univ.cmi interp/topconstr.cmi \
-    pretyping/termops.cmi kernel/term.cmi interp/symbols.cmi kernel/sign.cmi \
-    interp/reserve.cmi pretyping/recordops.cmi pretyping/rawterm.cmi \
-    lib/pp.cmi pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi library/lib.cmi \
-    kernel/inductive.cmi library/impargs.cmi library/global.cmi \
-    kernel/environ.cmi pretyping/detyping.cmi kernel/declarations.cmi \
-    pretyping/classops.cmi lib/bignat.cmi interp/constrextern.cmi 
-interp/constrextern.cmx: lib/util.cmx kernel/univ.cmx interp/topconstr.cmx \
-    pretyping/termops.cmx kernel/term.cmx interp/symbols.cmx kernel/sign.cmx \
-    interp/reserve.cmx pretyping/recordops.cmx pretyping/rawterm.cmx \
-    lib/pp.cmx pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx library/lib.cmx \
-    kernel/inductive.cmx library/impargs.cmx library/global.cmx \
-    kernel/environ.cmx pretyping/detyping.cmx kernel/declarations.cmx \
-    pretyping/classops.cmx lib/bignat.cmx interp/constrextern.cmi 
-interp/constrintern.cmo: lib/util.cmi interp/topconstr.cmi \
-    pretyping/termops.cmi kernel/term.cmi interp/syntax_def.cmi \
-    interp/symbols.cmi kernel/sign.cmi pretyping/retyping.cmi \
-    interp/reserve.cmi pretyping/recordops.cmi pretyping/rawterm.cmi \
-    pretyping/pretyping.cmi pretyping/pretype_errors.cmi lib/pp.cmi \
-    pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi library/lib.cmi \
-    parsing/lexer.cmi kernel/inductive.cmi library/impargs.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/declarations.cmi lib/bignat.cmi interp/constrintern.cmi 
-interp/constrintern.cmx: lib/util.cmx interp/topconstr.cmx \
-    pretyping/termops.cmx kernel/term.cmx interp/syntax_def.cmx \
-    interp/symbols.cmx kernel/sign.cmx pretyping/retyping.cmx \
-    interp/reserve.cmx pretyping/recordops.cmx pretyping/rawterm.cmx \
-    pretyping/pretyping.cmx pretyping/pretype_errors.cmx lib/pp.cmx \
-    pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx library/lib.cmx \
-    parsing/lexer.cmx kernel/inductive.cmx library/impargs.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    kernel/declarations.cmx lib/bignat.cmx interp/constrintern.cmi 
-interp/coqlib.cmo: lib/util.cmi kernel/term.cmi lib/pp.cmi \
-    pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi interp/constrextern.cmi \
-    interp/coqlib.cmi 
-interp/coqlib.cmx: lib/util.cmx kernel/term.cmx lib/pp.cmx \
-    pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/libnames.cmx interp/constrextern.cmx \
-    interp/coqlib.cmi 
-interp/genarg.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi pretyping/evd.cmi interp/genarg.cmi 
-interp/genarg.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
-    pretyping/rawterm.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx pretyping/evd.cmx interp/genarg.cmi 
-interp/modintern.cmo: lib/util.cmi interp/topconstr.cmi lib/pp.cmi \
-    library/nametab.cmi kernel/names.cmi kernel/modops.cmi \
-    library/libnames.cmi pretyping/evd.cmi kernel/entries.cmi \
-    interp/constrintern.cmi interp/modintern.cmi 
-interp/modintern.cmx: lib/util.cmx interp/topconstr.cmx lib/pp.cmx \
-    library/nametab.cmx kernel/names.cmx kernel/modops.cmx \
-    library/libnames.cmx pretyping/evd.cmx kernel/entries.cmx \
-    interp/constrintern.cmx interp/modintern.cmi 
-interp/ppextend.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \
+interp/constrextern.cmo: lib/bigint.cmi pretyping/classops.cmi \
+    kernel/declarations.cmi pretyping/detyping.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi library/impargs.cmi \
+    kernel/inductive.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi interp/notation.cmi lib/options.cmi \
+    pretyping/pattern.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    pretyping/recordops.cmi interp/reserve.cmi kernel/sign.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \
+    kernel/univ.cmi lib/util.cmi interp/constrextern.cmi 
+interp/constrextern.cmx: lib/bigint.cmx pretyping/classops.cmx \
+    kernel/declarations.cmx pretyping/detyping.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx library/impargs.cmx \
+    kernel/inductive.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx interp/notation.cmx lib/options.cmx \
+    pretyping/pattern.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    pretyping/recordops.cmx interp/reserve.cmx kernel/sign.cmx \
+    kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \
+    kernel/univ.cmx lib/util.cmx interp/constrextern.cmi 
+interp/constrintern.cmo: lib/bigint.cmi pretyping/cases.cmi \
+    kernel/declarations.cmi kernel/environ.cmi pretyping/evd.cmi \
+    library/global.cmi library/impargs.cmi kernel/inductive.cmi \
+    pretyping/inductiveops.cmi parsing/lexer.cmi library/lib.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi interp/notation.cmi lib/options.cmi \
+    pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \
+    pretyping/pretyping.cmi pretyping/rawterm.cmi pretyping/recordops.cmi \
+    interp/reserve.cmi kernel/sign.cmi interp/syntax_def.cmi kernel/term.cmi \
+    pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi \
+    interp/constrintern.cmi 
+interp/constrintern.cmx: lib/bigint.cmx pretyping/cases.cmx \
+    kernel/declarations.cmx kernel/environ.cmx pretyping/evd.cmx \
+    library/global.cmx library/impargs.cmx kernel/inductive.cmx \
+    pretyping/inductiveops.cmx parsing/lexer.cmx library/lib.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx interp/notation.cmx lib/options.cmx \
+    pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \
+    pretyping/pretyping.cmx pretyping/rawterm.cmx pretyping/recordops.cmx \
+    interp/reserve.cmx kernel/sign.cmx interp/syntax_def.cmx kernel/term.cmx \
+    pretyping/termops.cmx interp/topconstr.cmx lib/util.cmx \
+    interp/constrintern.cmi 
+interp/coqlib.cmo: library/libnames.cmi library/library.cmi kernel/names.cmi \
+    library/nametab.cmi pretyping/pattern.cmi lib/pp.cmi kernel/term.cmi \
+    lib/util.cmi interp/coqlib.cmi 
+interp/coqlib.cmx: library/libnames.cmx library/library.cmx kernel/names.cmx \
+    library/nametab.cmx pretyping/pattern.cmx lib/pp.cmx kernel/term.cmx \
+    lib/util.cmx interp/coqlib.cmi 
+interp/genarg.cmo: pretyping/evd.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi pretyping/rawterm.cmi kernel/term.cmi \
+    interp/topconstr.cmi lib/util.cmi interp/genarg.cmi 
+interp/genarg.cmx: pretyping/evd.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx pretyping/rawterm.cmx kernel/term.cmx \
+    interp/topconstr.cmx lib/util.cmx interp/genarg.cmi 
+interp/modintern.cmo: interp/constrintern.cmi kernel/entries.cmi \
+    pretyping/evd.cmi library/libnames.cmi kernel/modops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi interp/topconstr.cmi lib/util.cmi \
+    interp/modintern.cmi 
+interp/modintern.cmx: interp/constrintern.cmx kernel/entries.cmx \
+    pretyping/evd.cmx library/libnames.cmx kernel/modops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx interp/topconstr.cmx lib/util.cmx \
+    interp/modintern.cmi 
+interp/notation.cmo: lib/bigint.cmi pretyping/classops.cmi library/global.cmi \
+    lib/gmap.cmi lib/gmapl.cmi library/lib.cmi library/libnames.cmi \
+    library/libobject.cmi kernel/names.cmi library/nametab.cmi \
+    lib/options.cmi lib/pp.cmi interp/ppextend.cmi pretyping/rawterm.cmi \
+    pretyping/reductionops.cmi library/summary.cmi kernel/term.cmi \
+    interp/topconstr.cmi lib/util.cmi interp/notation.cmi 
+interp/notation.cmx: lib/bigint.cmx pretyping/classops.cmx library/global.cmx \
+    lib/gmap.cmx lib/gmapl.cmx library/lib.cmx library/libnames.cmx \
+    library/libobject.cmx kernel/names.cmx library/nametab.cmx \
+    lib/options.cmx lib/pp.cmx interp/ppextend.cmx pretyping/rawterm.cmx \
+    pretyping/reductionops.cmx library/summary.cmx kernel/term.cmx \
+    interp/topconstr.cmx lib/util.cmx interp/notation.cmi 
+interp/ppextend.cmo: kernel/names.cmi lib/pp.cmi lib/util.cmi \
     interp/ppextend.cmi 
-interp/ppextend.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx \
+interp/ppextend.cmx: kernel/names.cmx lib/pp.cmx lib/util.cmx \
     interp/ppextend.cmi 
-interp/reserve.cmo: lib/util.cmi library/summary.cmi pretyping/rawterm.cmi \
-    lib/pp.cmi lib/options.cmi kernel/names.cmi library/nameops.cmi \
-    library/libobject.cmi library/lib.cmi interp/reserve.cmi 
-interp/reserve.cmx: lib/util.cmx library/summary.cmx pretyping/rawterm.cmx \
-    lib/pp.cmx lib/options.cmx kernel/names.cmx library/nameops.cmx \
-    library/libobject.cmx library/lib.cmx interp/reserve.cmi 
-interp/symbols.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    library/summary.cmi pretyping/reductionops.cmi pretyping/rawterm.cmi \
-    interp/ppextend.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi lib/gmapl.cmi lib/gmap.cmi library/global.cmi \
-    pretyping/classops.cmi lib/bignat.cmi interp/symbols.cmi 
-interp/symbols.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
-    library/summary.cmx pretyping/reductionops.cmx pretyping/rawterm.cmx \
-    interp/ppextend.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx lib/gmapl.cmx lib/gmap.cmx library/global.cmx \
-    pretyping/classops.cmx lib/bignat.cmx interp/symbols.cmi 
-interp/syntax_def.cmo: lib/util.cmi interp/topconstr.cmi interp/symbols.cmi \
-    library/summary.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi interp/syntax_def.cmi 
-interp/syntax_def.cmx: lib/util.cmx interp/topconstr.cmx interp/symbols.cmx \
-    library/summary.cmx lib/pp.cmx library/nametab.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 lib/options.cmi kernel/names.cmi library/nameops.cmi \
-    library/libnames.cmi lib/dyn.cmi lib/bignat.cmi interp/topconstr.cmi 
-interp/topconstr.cmx: lib/util.cmx kernel/term.cmx pretyping/rawterm.cmx \
-    lib/pp.cmx lib/options.cmx kernel/names.cmx library/nameops.cmx \
-    library/libnames.cmx lib/dyn.cmx lib/bignat.cmx interp/topconstr.cmi 
-kernel/closure.cmo: lib/util.cmi kernel/term.cmi lib/pp.cmi kernel/names.cmi \
-    kernel/esubst.cmi kernel/environ.cmi kernel/declarations.cmi \
-    kernel/closure.cmi 
-kernel/closure.cmx: lib/util.cmx kernel/term.cmx lib/pp.cmx kernel/names.cmx \
-    kernel/esubst.cmx kernel/environ.cmx kernel/declarations.cmx \
-    kernel/closure.cmi 
-kernel/conv_oracle.cmo: kernel/names.cmi kernel/closure.cmi \
-    kernel/conv_oracle.cmi 
-kernel/conv_oracle.cmx: kernel/names.cmx kernel/closure.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/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/cooking.cmi 
-kernel/declarations.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/sign.cmi lib/rtree.cmi kernel/names.cmi kernel/declarations.cmi 
-kernel/declarations.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    kernel/sign.cmx lib/rtree.cmx kernel/names.cmx kernel/declarations.cmi 
-kernel/entries.cmo: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/names.cmi kernel/entries.cmi 
-kernel/entries.cmx: kernel/univ.cmx kernel/term.cmx kernel/sign.cmx \
-    kernel/names.cmx kernel/entries.cmi 
-kernel/environ.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/sign.cmi kernel/names.cmi kernel/declarations.cmi \
+interp/reserve.cmo: pretyping/evd.cmi library/lib.cmi library/libobject.cmi \
+    library/nameops.cmi kernel/names.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    library/summary.cmi lib/util.cmi interp/reserve.cmi 
+interp/reserve.cmx: pretyping/evd.cmx library/lib.cmx library/libobject.cmx \
+    library/nameops.cmx kernel/names.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    library/summary.cmx lib/util.cmx interp/reserve.cmi 
+interp/syntax_def.cmo: library/lib.cmi library/libnames.cmi \
+    library/libobject.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi interp/notation.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    library/summary.cmi interp/topconstr.cmi lib/util.cmi \
+    interp/syntax_def.cmi 
+interp/syntax_def.cmx: library/lib.cmx library/libnames.cmx \
+    library/libobject.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx interp/notation.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    library/summary.cmx interp/topconstr.cmx lib/util.cmx \
+    interp/syntax_def.cmi 
+interp/topconstr.cmo: lib/bigint.cmi pretyping/detyping.cmi lib/dyn.cmi \
+    pretyping/evd.cmi library/libnames.cmi kernel/mod_subst.cmi \
+    library/nameops.cmi kernel/names.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    kernel/term.cmi lib/util.cmi interp/topconstr.cmi 
+interp/topconstr.cmx: lib/bigint.cmx pretyping/detyping.cmx lib/dyn.cmx \
+    pretyping/evd.cmx library/libnames.cmx kernel/mod_subst.cmx \
+    library/nameops.cmx kernel/names.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    kernel/term.cmx lib/util.cmx interp/topconstr.cmi 
+kernel/cbytecodes.cmo: kernel/names.cmi kernel/term.cmi kernel/cbytecodes.cmi 
+kernel/cbytecodes.cmx: kernel/names.cmx kernel/term.cmx kernel/cbytecodes.cmi 
+kernel/cbytegen.cmo: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \
+    kernel/declarations.cmi kernel/names.cmi kernel/pre_env.cmi \
+    kernel/term.cmi lib/util.cmi kernel/cbytegen.cmi 
+kernel/cbytegen.cmx: kernel/cbytecodes.cmx kernel/cemitcodes.cmx \
+    kernel/declarations.cmx kernel/names.cmx kernel/pre_env.cmx \
+    kernel/term.cmx lib/util.cmx kernel/cbytegen.cmi 
+kernel/cemitcodes.cmo: kernel/cbytecodes.cmi kernel/copcodes.cmo \
+    kernel/mod_subst.cmi kernel/names.cmi kernel/term.cmi \
+    kernel/cemitcodes.cmi 
+kernel/cemitcodes.cmx: kernel/cbytecodes.cmx kernel/copcodes.cmx \
+    kernel/mod_subst.cmx kernel/names.cmx kernel/term.cmx \
+    kernel/cemitcodes.cmi 
+kernel/closure.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    kernel/esubst.cmi kernel/names.cmi lib/pp.cmi kernel/sign.cmi \
+    kernel/term.cmi lib/util.cmi kernel/closure.cmi 
+kernel/closure.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    kernel/esubst.cmx kernel/names.cmx lib/pp.cmx kernel/sign.cmx \
+    kernel/term.cmx lib/util.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: kernel/cemitcodes.cmi kernel/declarations.cmi \
+    kernel/environ.cmi kernel/names.cmi lib/pp.cmi kernel/reduction.cmi \
+    kernel/sign.cmi kernel/term.cmi lib/util.cmi kernel/cooking.cmi 
+kernel/cooking.cmx: kernel/cemitcodes.cmx kernel/declarations.cmx \
+    kernel/environ.cmx kernel/names.cmx lib/pp.cmx kernel/reduction.cmx \
+    kernel/sign.cmx kernel/term.cmx lib/util.cmx kernel/cooking.cmi 
+kernel/csymtable.cmo: kernel/cbytecodes.cmi kernel/cbytegen.cmi \
+    kernel/cemitcodes.cmi kernel/declarations.cmi kernel/names.cmi \
+    kernel/pre_env.cmi kernel/term.cmi kernel/vm.cmi kernel/csymtable.cmi 
+kernel/csymtable.cmx: kernel/cbytecodes.cmx kernel/cbytegen.cmx \
+    kernel/cemitcodes.cmx kernel/declarations.cmx kernel/names.cmx \
+    kernel/pre_env.cmx kernel/term.cmx kernel/vm.cmx kernel/csymtable.cmi 
+kernel/declarations.cmo: kernel/cbytecodes.cmi kernel/cemitcodes.cmi \
+    kernel/mod_subst.cmi kernel/names.cmi lib/rtree.cmi kernel/sign.cmi \
+    kernel/term.cmi kernel/univ.cmi lib/util.cmi kernel/declarations.cmi 
+kernel/declarations.cmx: kernel/cbytecodes.cmx kernel/cemitcodes.cmx \
+    kernel/mod_subst.cmx kernel/names.cmx lib/rtree.cmx kernel/sign.cmx \
+    kernel/term.cmx kernel/univ.cmx lib/util.cmx kernel/declarations.cmi 
+kernel/entries.cmo: kernel/names.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi kernel/entries.cmi 
+kernel/entries.cmx: kernel/names.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/univ.cmx kernel/entries.cmi 
+kernel/environ.cmo: kernel/cbytegen.cmi kernel/csymtable.cmi \
+    kernel/declarations.cmi kernel/names.cmi kernel/pre_env.cmi \
+    kernel/sign.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi \
     kernel/environ.cmi 
-kernel/environ.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    kernel/sign.cmx kernel/names.cmx kernel/declarations.cmx \
+kernel/environ.cmx: kernel/cbytegen.cmx kernel/csymtable.cmx \
+    kernel/declarations.cmx kernel/names.cmx kernel/pre_env.cmx \
+    kernel/sign.cmx kernel/term.cmx kernel/univ.cmx lib/util.cmx \
     kernel/environ.cmi 
 kernel/esubst.cmo: lib/util.cmi kernel/esubst.cmi 
 kernel/esubst.cmx: lib/util.cmx kernel/esubst.cmi 
-kernel/indtypes.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \
-    kernel/term.cmi kernel/sign.cmi lib/rtree.cmi kernel/reduction.cmi \
-    kernel/names.cmi kernel/inductive.cmi kernel/environ.cmi \
-    kernel/entries.cmi kernel/declarations.cmi kernel/indtypes.cmi 
-kernel/indtypes.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
-    kernel/term.cmx kernel/sign.cmx lib/rtree.cmx kernel/reduction.cmx \
-    kernel/names.cmx kernel/inductive.cmx kernel/environ.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/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/mod_typing.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \
-    kernel/term_typing.cmi kernel/subtyping.cmi kernel/reduction.cmi \
-    kernel/names.cmi kernel/modops.cmi kernel/environ.cmi kernel/entries.cmi \
-    kernel/declarations.cmi kernel/mod_typing.cmi 
-kernel/mod_typing.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
-    kernel/term_typing.cmx kernel/subtyping.cmx kernel/reduction.cmx \
-    kernel/names.cmx kernel/modops.cmx kernel/environ.cmx kernel/entries.cmx \
-    kernel/declarations.cmx kernel/mod_typing.cmi 
-kernel/modops.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi lib/pp.cmi \
-    kernel/names.cmi kernel/environ.cmi kernel/entries.cmi \
-    kernel/declarations.cmi kernel/modops.cmi 
-kernel/modops.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx lib/pp.cmx \
-    kernel/names.cmx kernel/environ.cmx kernel/entries.cmx \
-    kernel/declarations.cmx kernel/modops.cmi 
-kernel/names.cmo: lib/util.cmi lib/predicate.cmi lib/pp.cmi lib/options.cmi \
-    lib/hashcons.cmi kernel/names.cmi 
-kernel/names.cmx: lib/util.cmx lib/predicate.cmx lib/pp.cmx lib/options.cmx \
-    lib/hashcons.cmx kernel/names.cmi 
-kernel/reduction.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/sign.cmi kernel/names.cmi kernel/esubst.cmi kernel/environ.cmi \
-    kernel/declarations.cmi kernel/conv_oracle.cmi kernel/closure.cmi \
-    kernel/reduction.cmi 
-kernel/reduction.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    kernel/sign.cmx kernel/names.cmx kernel/esubst.cmx kernel/environ.cmx \
-    kernel/declarations.cmx kernel/conv_oracle.cmx kernel/closure.cmx \
-    kernel/reduction.cmi 
-kernel/safe_typing.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \
-    kernel/type_errors.cmi kernel/term_typing.cmi kernel/term.cmi \
-    kernel/subtyping.cmi kernel/sign.cmi kernel/reduction.cmi \
-    kernel/names.cmi kernel/modops.cmi kernel/mod_typing.cmi \
-    kernel/inductive.cmi kernel/indtypes.cmi kernel/environ.cmi \
-    kernel/entries.cmi kernel/declarations.cmi kernel/cooking.cmi \
+kernel/indtypes.cmo: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi kernel/inductive.cmi kernel/names.cmi \
+    kernel/reduction.cmi lib/rtree.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/typeops.cmi kernel/univ.cmi lib/util.cmi kernel/indtypes.cmi 
+kernel/indtypes.cmx: kernel/declarations.cmx kernel/entries.cmx \
+    kernel/environ.cmx kernel/inductive.cmx kernel/names.cmx \
+    kernel/reduction.cmx lib/rtree.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/typeops.cmx kernel/univ.cmx lib/util.cmx kernel/indtypes.cmi 
+kernel/inductive.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    kernel/names.cmi kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/type_errors.cmi kernel/univ.cmi lib/util.cmi kernel/inductive.cmi 
+kernel/inductive.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    kernel/names.cmx kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/type_errors.cmx kernel/univ.cmx lib/util.cmx kernel/inductive.cmi 
+kernel/modops.cmo: kernel/cemitcodes.cmi kernel/declarations.cmi \
+    kernel/entries.cmi kernel/environ.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi lib/pp.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi \
+    kernel/modops.cmi 
+kernel/modops.cmx: kernel/cemitcodes.cmx kernel/declarations.cmx \
+    kernel/entries.cmx kernel/environ.cmx kernel/mod_subst.cmx \
+    kernel/names.cmx lib/pp.cmx kernel/term.cmx kernel/univ.cmx lib/util.cmx \
+    kernel/modops.cmi 
+kernel/mod_subst.cmo: kernel/names.cmi lib/pp.cmi kernel/term.cmi \
+    lib/util.cmi kernel/mod_subst.cmi 
+kernel/mod_subst.cmx: kernel/names.cmx lib/pp.cmx kernel/term.cmx \
+    lib/util.cmx kernel/mod_subst.cmi 
+kernel/mod_typing.cmo: kernel/cemitcodes.cmi kernel/declarations.cmi \
+    kernel/entries.cmi kernel/environ.cmi kernel/mod_subst.cmi \
+    kernel/modops.cmi kernel/names.cmi kernel/reduction.cmi \
+    kernel/subtyping.cmi kernel/term_typing.cmi kernel/typeops.cmi \
+    kernel/univ.cmi lib/util.cmi kernel/mod_typing.cmi 
+kernel/mod_typing.cmx: kernel/cemitcodes.cmx kernel/declarations.cmx \
+    kernel/entries.cmx kernel/environ.cmx kernel/mod_subst.cmx \
+    kernel/modops.cmx kernel/names.cmx kernel/reduction.cmx \
+    kernel/subtyping.cmx kernel/term_typing.cmx kernel/typeops.cmx \
+    kernel/univ.cmx lib/util.cmx kernel/mod_typing.cmi 
+kernel/names.cmo: lib/hashcons.cmi lib/pp.cmi lib/predicate.cmi lib/util.cmi \
+    kernel/names.cmi 
+kernel/names.cmx: lib/hashcons.cmx lib/pp.cmx lib/predicate.cmx lib/util.cmx \
+    kernel/names.cmi 
+kernel/pre_env.cmo: kernel/declarations.cmi kernel/names.cmi kernel/sign.cmi \
+    kernel/term.cmi kernel/univ.cmi lib/util.cmi kernel/pre_env.cmi 
+kernel/pre_env.cmx: kernel/declarations.cmx kernel/names.cmx kernel/sign.cmx \
+    kernel/term.cmx kernel/univ.cmx lib/util.cmx kernel/pre_env.cmi 
+kernel/reduction.cmo: kernel/closure.cmi kernel/conv_oracle.cmi \
+    kernel/declarations.cmi kernel/environ.cmi kernel/esubst.cmi \
+    kernel/names.cmi kernel/sign.cmi kernel/term.cmi kernel/univ.cmi \
+    lib/util.cmi kernel/reduction.cmi 
+kernel/reduction.cmx: kernel/closure.cmx kernel/conv_oracle.cmx \
+    kernel/declarations.cmx kernel/environ.cmx kernel/esubst.cmx \
+    kernel/names.cmx kernel/sign.cmx kernel/term.cmx kernel/univ.cmx \
+    lib/util.cmx kernel/reduction.cmi 
+kernel/safe_typing.cmo: kernel/cooking.cmi kernel/declarations.cmi \
+    kernel/entries.cmi kernel/environ.cmi kernel/indtypes.cmi \
+    kernel/inductive.cmi kernel/mod_typing.cmi kernel/modops.cmi \
+    kernel/names.cmi kernel/reduction.cmi kernel/sign.cmi \
+    kernel/subtyping.cmi kernel/term.cmi kernel/term_typing.cmi \
+    kernel/type_errors.cmi kernel/typeops.cmi kernel/univ.cmi lib/util.cmi \
     kernel/safe_typing.cmi 
-kernel/safe_typing.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
-    kernel/type_errors.cmx kernel/term_typing.cmx kernel/term.cmx \
-    kernel/subtyping.cmx kernel/sign.cmx kernel/reduction.cmx \
-    kernel/names.cmx kernel/modops.cmx kernel/mod_typing.cmx \
-    kernel/inductive.cmx kernel/indtypes.cmx kernel/environ.cmx \
-    kernel/entries.cmx kernel/declarations.cmx kernel/cooking.cmx \
+kernel/safe_typing.cmx: kernel/cooking.cmx kernel/declarations.cmx \
+    kernel/entries.cmx kernel/environ.cmx kernel/indtypes.cmx \
+    kernel/inductive.cmx kernel/mod_typing.cmx kernel/modops.cmx \
+    kernel/names.cmx kernel/reduction.cmx kernel/sign.cmx \
+    kernel/subtyping.cmx kernel/term.cmx kernel/term_typing.cmx \
+    kernel/type_errors.cmx kernel/typeops.cmx kernel/univ.cmx lib/util.cmx \
     kernel/safe_typing.cmi 
-kernel/sign.cmo: lib/util.cmi kernel/term.cmi kernel/names.cmi \
+kernel/sign.cmo: kernel/names.cmi kernel/term.cmi lib/util.cmi \
     kernel/sign.cmi 
-kernel/sign.cmx: lib/util.cmx kernel/term.cmx kernel/names.cmx \
+kernel/sign.cmx: kernel/names.cmx kernel/term.cmx lib/util.cmx \
     kernel/sign.cmi 
-kernel/subtyping.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/reduction.cmi lib/pp.cmi kernel/names.cmi kernel/modops.cmi \
-    kernel/inductive.cmi kernel/environ.cmi kernel/declarations.cmi \
-    kernel/subtyping.cmi 
-kernel/subtyping.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    kernel/reduction.cmx lib/pp.cmx kernel/names.cmx kernel/modops.cmx \
-    kernel/inductive.cmx kernel/environ.cmx kernel/declarations.cmx \
-    kernel/subtyping.cmi 
-kernel/term.cmo: lib/util.cmi kernel/univ.cmi lib/pp.cmi kernel/names.cmi \
-    lib/hashcons.cmi kernel/esubst.cmi kernel/term.cmi 
-kernel/term.cmx: lib/util.cmx kernel/univ.cmx lib/pp.cmx kernel/names.cmx \
-    lib/hashcons.cmx kernel/esubst.cmx kernel/term.cmi 
-kernel/term_typing.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \
-    kernel/type_errors.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/reduction.cmi kernel/names.cmi kernel/inductive.cmi \
-    kernel/indtypes.cmi kernel/environ.cmi kernel/entries.cmi \
-    kernel/declarations.cmi kernel/cooking.cmi kernel/term_typing.cmi 
-kernel/term_typing.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
-    kernel/type_errors.cmx kernel/term.cmx kernel/sign.cmx \
-    kernel/reduction.cmx kernel/names.cmx kernel/inductive.cmx \
-    kernel/indtypes.cmx kernel/environ.cmx kernel/entries.cmx \
-    kernel/declarations.cmx kernel/cooking.cmx kernel/term_typing.cmi 
-kernel/type_errors.cmo: kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi \
-    kernel/names.cmi kernel/environ.cmi kernel/type_errors.cmi 
-kernel/type_errors.cmx: kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx \
-    kernel/names.cmx kernel/environ.cmx kernel/type_errors.cmi 
-kernel/typeops.cmo: lib/util.cmi kernel/univ.cmi kernel/type_errors.cmi \
-    kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi kernel/names.cmi \
-    kernel/inductive.cmi kernel/environ.cmi kernel/entries.cmi \
-    kernel/declarations.cmi kernel/typeops.cmi 
-kernel/typeops.cmx: lib/util.cmx kernel/univ.cmx kernel/type_errors.cmx \
-    kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx kernel/names.cmx \
-    kernel/inductive.cmx kernel/environ.cmx kernel/entries.cmx \
-    kernel/declarations.cmx kernel/typeops.cmi 
-kernel/univ.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi lib/hashcons.cmi \
+kernel/subtyping.cmo: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi kernel/inductive.cmi kernel/mod_subst.cmi \
+    kernel/modops.cmi kernel/names.cmi kernel/reduction.cmi kernel/term.cmi \
+    kernel/univ.cmi lib/util.cmi kernel/subtyping.cmi 
+kernel/subtyping.cmx: kernel/declarations.cmx kernel/entries.cmx \
+    kernel/environ.cmx kernel/inductive.cmx kernel/mod_subst.cmx \
+    kernel/modops.cmx kernel/names.cmx kernel/reduction.cmx kernel/term.cmx \
+    kernel/univ.cmx lib/util.cmx kernel/subtyping.cmi 
+kernel/term.cmo: kernel/esubst.cmi lib/hashcons.cmi kernel/names.cmi \
+    lib/pp.cmi kernel/univ.cmi lib/util.cmi kernel/term.cmi 
+kernel/term.cmx: kernel/esubst.cmx lib/hashcons.cmx kernel/names.cmx \
+    lib/pp.cmx kernel/univ.cmx lib/util.cmx kernel/term.cmi 
+kernel/term_typing.cmo: kernel/cemitcodes.cmi kernel/cooking.cmi \
+    kernel/declarations.cmi kernel/entries.cmi kernel/environ.cmi \
+    kernel/indtypes.cmi kernel/inductive.cmi kernel/names.cmi \
+    kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/type_errors.cmi kernel/typeops.cmi kernel/univ.cmi lib/util.cmi \
+    kernel/term_typing.cmi 
+kernel/term_typing.cmx: kernel/cemitcodes.cmx kernel/cooking.cmx \
+    kernel/declarations.cmx kernel/entries.cmx kernel/environ.cmx \
+    kernel/indtypes.cmx kernel/inductive.cmx kernel/names.cmx \
+    kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/type_errors.cmx kernel/typeops.cmx kernel/univ.cmx lib/util.cmx \
+    kernel/term_typing.cmi 
+kernel/type_errors.cmo: kernel/environ.cmi kernel/names.cmi \
+    kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/type_errors.cmi 
+kernel/type_errors.cmx: kernel/environ.cmx kernel/names.cmx \
+    kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/type_errors.cmi 
+kernel/typeops.cmo: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi kernel/inductive.cmi kernel/names.cmi \
+    kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/type_errors.cmi kernel/univ.cmi lib/util.cmi kernel/typeops.cmi 
+kernel/typeops.cmx: kernel/declarations.cmx kernel/entries.cmx \
+    kernel/environ.cmx kernel/inductive.cmx kernel/names.cmx \
+    kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/type_errors.cmx kernel/univ.cmx lib/util.cmx kernel/typeops.cmi 
+kernel/univ.cmo: lib/hashcons.cmi kernel/names.cmi lib/pp.cmi lib/util.cmi \
     kernel/univ.cmi 
-kernel/univ.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx lib/hashcons.cmx \
+kernel/univ.cmx: lib/hashcons.cmx kernel/names.cmx lib/pp.cmx lib/util.cmx \
     kernel/univ.cmi 
-lib/bignat.cmo: lib/pp.cmi lib/bignat.cmi 
-lib/bignat.cmx: lib/pp.cmx lib/bignat.cmi 
+kernel/vconv.cmo: kernel/closure.cmi kernel/conv_oracle.cmi \
+    kernel/csymtable.cmi kernel/declarations.cmi kernel/environ.cmi \
+    kernel/inductive.cmi kernel/names.cmi kernel/reduction.cmi \
+    kernel/term.cmi kernel/univ.cmi lib/util.cmi kernel/vm.cmi \
+    kernel/vconv.cmi 
+kernel/vconv.cmx: kernel/closure.cmx kernel/conv_oracle.cmx \
+    kernel/csymtable.cmx kernel/declarations.cmx kernel/environ.cmx \
+    kernel/inductive.cmx kernel/names.cmx kernel/reduction.cmx \
+    kernel/term.cmx kernel/univ.cmx lib/util.cmx kernel/vm.cmx \
+    kernel/vconv.cmi 
+kernel/vm.cmo: kernel/cbytecodes.cmi kernel/conv_oracle.cmi kernel/names.cmi \
+    kernel/term.cmi lib/util.cmi kernel/vm.cmi 
+kernel/vm.cmx: kernel/cbytecodes.cmx kernel/conv_oracle.cmx kernel/names.cmx \
+    kernel/term.cmx lib/util.cmx kernel/vm.cmi 
+lib/bigint.cmo: lib/pp.cmi lib/bigint.cmi 
+lib/bigint.cmx: lib/pp.cmx lib/bigint.cmi 
 lib/bstack.cmo: lib/util.cmi lib/bstack.cmi 
 lib/bstack.cmx: lib/util.cmx lib/bstack.cmi 
 lib/dyn.cmo: lib/util.cmi lib/dyn.cmi 
 lib/dyn.cmx: lib/util.cmx lib/dyn.cmi 
-lib/edit.cmo: lib/util.cmi lib/pp.cmi lib/bstack.cmi lib/edit.cmi 
-lib/edit.cmx: lib/util.cmx lib/pp.cmx lib/bstack.cmx lib/edit.cmi 
+lib/edit.cmo: lib/bstack.cmi lib/pp.cmi lib/util.cmi lib/edit.cmi 
+lib/edit.cmx: lib/bstack.cmx lib/pp.cmx lib/util.cmx lib/edit.cmi 
 lib/explore.cmo: lib/explore.cmi 
 lib/explore.cmx: lib/explore.cmi 
+lib/gmapl.cmo: lib/gmap.cmi lib/util.cmi lib/gmapl.cmi 
+lib/gmapl.cmx: lib/gmap.cmx lib/util.cmx lib/gmapl.cmi 
 lib/gmap.cmo: lib/gmap.cmi 
 lib/gmap.cmx: lib/gmap.cmi 
-lib/gmapl.cmo: lib/util.cmi lib/gmap.cmi lib/gmapl.cmi 
-lib/gmapl.cmx: lib/util.cmx lib/gmap.cmx lib/gmapl.cmi 
 lib/gset.cmo: lib/gset.cmi 
 lib/gset.cmx: lib/gset.cmi 
 lib/hashcons.cmo: lib/hashcons.cmi 
@@ -762,2282 +878,2362 @@ lib/heap.cmo: lib/heap.cmi
 lib/heap.cmx: lib/heap.cmi 
 lib/options.cmo: lib/util.cmi lib/options.cmi 
 lib/options.cmx: lib/util.cmx lib/options.cmi 
-lib/pp.cmo: lib/pp_control.cmi lib/pp.cmi 
-lib/pp.cmx: lib/pp_control.cmx lib/pp.cmi 
 lib/pp_control.cmo: lib/pp_control.cmi 
 lib/pp_control.cmx: lib/pp_control.cmi 
+lib/pp.cmo: lib/pp_control.cmi lib/pp.cmi 
+lib/pp.cmx: lib/pp_control.cmx lib/pp.cmi 
 lib/predicate.cmo: lib/predicate.cmi 
 lib/predicate.cmx: lib/predicate.cmi 
 lib/profile.cmo: lib/profile.cmi 
 lib/profile.cmx: lib/profile.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 
-lib/tlm.cmx: lib/gset.cmx lib/gmap.cmx lib/tlm.cmi 
-lib/util.cmo: lib/pp.cmi lib/compat.cmo lib/util.cmi 
-lib/util.cmx: lib/pp.cmx lib/compat.cmx lib/util.cmi 
-library/declare.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \
-    kernel/type_errors.cmi kernel/term.cmi interp/symbols.cmi \
-    library/summary.cmi kernel/sign.cmi kernel/safe_typing.cmi \
-    kernel/reduction.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libobject.cmi \
-    library/libnames.cmi library/lib.cmi kernel/inductive.cmi \
-    kernel/indtypes.cmi library/impargs.cmi library/global.cmi \
-    kernel/environ.cmi kernel/entries.cmi library/dischargedhypsmap.cmi \
-    kernel/declarations.cmi library/decl_kinds.cmo library/declare.cmi 
-library/declare.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
-    kernel/type_errors.cmx kernel/term.cmx interp/symbols.cmx \
-    library/summary.cmx kernel/sign.cmx kernel/safe_typing.cmx \
-    kernel/reduction.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libobject.cmx \
-    library/libnames.cmx library/lib.cmx kernel/inductive.cmx \
-    kernel/indtypes.cmx library/impargs.cmx library/global.cmx \
-    kernel/environ.cmx kernel/entries.cmx library/dischargedhypsmap.cmx \
-    kernel/declarations.cmx library/decl_kinds.cmx library/declare.cmi 
-library/declaremods.cmo: lib/util.cmi library/summary.cmi \
-    kernel/subtyping.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \
-    kernel/modops.cmi kernel/mod_typing.cmi library/libobject.cmi \
-    library/libnames.cmi library/lib.cmi library/global.cmi \
-    kernel/environ.cmi kernel/entries.cmi kernel/declarations.cmi \
-    library/declaremods.cmi 
-library/declaremods.cmx: lib/util.cmx library/summary.cmx \
-    kernel/subtyping.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \
-    kernel/modops.cmx kernel/mod_typing.cmx library/libobject.cmx \
-    library/libnames.cmx library/lib.cmx library/global.cmx \
-    kernel/environ.cmx kernel/entries.cmx kernel/declarations.cmx \
-    library/declaremods.cmi 
-library/dischargedhypsmap.cmo: lib/util.cmi kernel/term.cmi \
-    library/summary.cmi kernel/reduction.cmi library/nametab.cmi \
-    kernel/names.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi kernel/inductive.cmi kernel/environ.cmi \
-    kernel/declarations.cmi library/dischargedhypsmap.cmi 
-library/dischargedhypsmap.cmx: lib/util.cmx kernel/term.cmx \
-    library/summary.cmx kernel/reduction.cmx library/nametab.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/declare.cmo: kernel/cooking.cmi library/decl_kinds.cmo \
+    kernel/declarations.cmi toplevel/discharge.cmi \
+    library/dischargedhypsmap.cmi kernel/entries.cmi kernel/environ.cmi \
+    library/global.cmi library/impargs.cmi kernel/indtypes.cmi \
+    kernel/inductive.cmi library/lib.cmi library/libnames.cmi \
+    library/libobject.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi interp/notation.cmi lib/options.cmi lib/pp.cmi \
+    kernel/reduction.cmi kernel/safe_typing.cmi kernel/sign.cmi \
+    library/summary.cmi kernel/term.cmi kernel/type_errors.cmi \
+    kernel/typeops.cmi kernel/univ.cmi lib/util.cmi library/declare.cmi 
+library/declare.cmx: kernel/cooking.cmx library/decl_kinds.cmx \
+    kernel/declarations.cmx toplevel/discharge.cmx \
+    library/dischargedhypsmap.cmx kernel/entries.cmx kernel/environ.cmx \
+    library/global.cmx library/impargs.cmx kernel/indtypes.cmx \
+    kernel/inductive.cmx library/lib.cmx library/libnames.cmx \
+    library/libobject.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx interp/notation.cmx lib/options.cmx lib/pp.cmx \
+    kernel/reduction.cmx kernel/safe_typing.cmx kernel/sign.cmx \
+    library/summary.cmx kernel/term.cmx kernel/type_errors.cmx \
+    kernel/typeops.cmx kernel/univ.cmx lib/util.cmx library/declare.cmi 
+library/declaremods.cmo: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi library/global.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi kernel/mod_subst.cmi \
+    kernel/mod_typing.cmi kernel/modops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi kernel/subtyping.cmi library/summary.cmi \
+    lib/util.cmi library/declaremods.cmi 
+library/declaremods.cmx: kernel/declarations.cmx kernel/entries.cmx \
+    kernel/environ.cmx library/global.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx kernel/mod_subst.cmx \
+    kernel/mod_typing.cmx kernel/modops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx kernel/subtyping.cmx library/summary.cmx \
+    lib/util.cmx library/declaremods.cmi 
+library/decl_kinds.cmo: lib/util.cmi 
+library/decl_kinds.cmx: lib/util.cmx 
+library/dischargedhypsmap.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    kernel/inductive.cmi library/lib.cmi library/libnames.cmi \
+    library/libobject.cmi kernel/names.cmi library/nametab.cmi \
+    kernel/reduction.cmi library/summary.cmi kernel/term.cmi lib/util.cmi \
+    library/dischargedhypsmap.cmi 
+library/dischargedhypsmap.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    kernel/inductive.cmx library/lib.cmx library/libnames.cmx \
+    library/libobject.cmx kernel/names.cmx library/nametab.cmx \
+    kernel/reduction.cmx library/summary.cmx kernel/term.cmx lib/util.cmx \
+    library/dischargedhypsmap.cmi 
+library/global.cmo: kernel/environ.cmi kernel/inductive.cmi \
+    library/libnames.cmi kernel/names.cmi kernel/safe_typing.cmi \
+    kernel/sign.cmi library/summary.cmi kernel/term.cmi lib/util.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.cmx: kernel/environ.cmx kernel/inductive.cmx \
+    library/libnames.cmx kernel/names.cmx kernel/safe_typing.cmx \
+    kernel/sign.cmx library/summary.cmx kernel/term.cmx lib/util.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 library/libobject.cmi \
-    library/libnames.cmi library/lib.cmi library/goptions.cmi 
-library/goptions.cmx: lib/util.cmx kernel/term.cmx library/summary.cmx \
-    lib/pp.cmx library/nametab.cmx kernel/names.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 \
-    lib/options.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 \
-    lib/options.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 library/summary.cmi lib/pp.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libobject.cmi library/libnames.cmi library/lib.cmi 
-library/lib.cmx: lib/util.cmx library/summary.cmx lib/pp.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/libobject.cmx library/libnames.cmx library/lib.cmi 
-library/libnames.cmo: lib/util.cmi kernel/term.cmi lib/predicate.cmi \
-    lib/pp.cmi kernel/names.cmi library/nameops.cmi library/libnames.cmi 
-library/libnames.cmx: lib/util.cmx kernel/term.cmx lib/predicate.cmx \
-    lib/pp.cmx kernel/names.cmx library/nameops.cmx library/libnames.cmi 
-library/libobject.cmo: lib/util.cmi kernel/names.cmi library/libnames.cmi \
-    lib/dyn.cmi library/libobject.cmi 
-library/libobject.cmx: lib/util.cmx kernel/names.cmx library/libnames.cmx \
-    lib/dyn.cmx library/libobject.cmi 
-library/library.cmo: lib/util.cmi lib/system.cmi library/summary.cmi \
-    kernel/safe_typing.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libobject.cmi \
-    library/libnames.cmi library/lib.cmi library/declaremods.cmi \
+library/goptions.cmo: library/lib.cmi library/libnames.cmi \
+    library/libobject.cmi kernel/mod_subst.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi library/summary.cmi kernel/term.cmi \
+    lib/util.cmi library/goptions.cmi 
+library/goptions.cmx: library/lib.cmx library/libnames.cmx \
+    library/libobject.cmx kernel/mod_subst.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx library/summary.cmx kernel/term.cmx \
+    lib/util.cmx library/goptions.cmi 
+library/impargs.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    library/global.cmi kernel/inductive.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi kernel/reduction.cmi library/summary.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi \
+    library/impargs.cmi 
+library/impargs.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    library/global.cmx kernel/inductive.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx kernel/reduction.cmx library/summary.cmx \
+    kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx lib/util.cmx \
+    library/impargs.cmi 
+library/lib.cmo: kernel/cooking.cmi library/libnames.cmi \
+    library/libobject.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/options.cmi lib/pp.cmi kernel/sign.cmi \
+    library/summary.cmi kernel/term.cmi lib/util.cmi library/lib.cmi 
+library/lib.cmx: kernel/cooking.cmx library/libnames.cmx \
+    library/libobject.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/options.cmx lib/pp.cmx kernel/sign.cmx \
+    library/summary.cmx kernel/term.cmx lib/util.cmx library/lib.cmi 
+library/libnames.cmo: kernel/mod_subst.cmi library/nameops.cmi \
+    kernel/names.cmi lib/pp.cmi lib/predicate.cmi kernel/term.cmi \
+    lib/util.cmi library/libnames.cmi 
+library/libnames.cmx: kernel/mod_subst.cmx library/nameops.cmx \
+    kernel/names.cmx lib/pp.cmx lib/predicate.cmx kernel/term.cmx \
+    lib/util.cmx library/libnames.cmi 
+library/libobject.cmo: lib/dyn.cmi library/libnames.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi lib/util.cmi library/libobject.cmi 
+library/libobject.cmx: lib/dyn.cmx library/libnames.cmx kernel/mod_subst.cmx \
+    kernel/names.cmx lib/util.cmx library/libobject.cmi 
+library/library.cmo: library/declaremods.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi lib/options.cmi lib/pp.cmi \
+    kernel/safe_typing.cmi library/summary.cmi lib/system.cmi lib/util.cmi \
     library/library.cmi 
-library/library.cmx: lib/util.cmx lib/system.cmx library/summary.cmx \
-    kernel/safe_typing.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libobject.cmx \
-    library/libnames.cmx library/lib.cmx library/declaremods.cmx \
+library/library.cmx: library/declaremods.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx lib/options.cmx lib/pp.cmx \
+    kernel/safe_typing.cmx library/summary.cmx lib/system.cmx lib/util.cmx \
     library/library.cmi 
-library/nameops.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \
+library/nameops.cmo: kernel/names.cmi lib/pp.cmi lib/util.cmi \
     library/nameops.cmi 
-library/nameops.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx \
+library/nameops.cmx: kernel/names.cmx lib/pp.cmx lib/util.cmx \
     library/nameops.cmi 
-library/nametab.cmo: lib/util.cmi library/summary.cmi lib/pp.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    kernel/declarations.cmi library/nametab.cmi 
-library/nametab.cmx: lib/util.cmx library/summary.cmx lib/pp.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    kernel/declarations.cmx library/nametab.cmi 
-library/states.cmo: lib/system.cmi library/summary.cmi library/library.cmi \
-    library/lib.cmi library/states.cmi 
-library/states.cmx: lib/system.cmx library/summary.cmx library/library.cmx \
-    library/lib.cmx library/states.cmi 
-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 
-parsing/argextend.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    parsing/q_util.cmi parsing/q_coqast.cmo parsing/pcoq.cmi \
-    interp/genarg.cmi parsing/ast.cmi 
-parsing/argextend.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    parsing/q_util.cmx parsing/q_coqast.cmx parsing/pcoq.cmx \
-    interp/genarg.cmx parsing/ast.cmx 
-parsing/ast.cmo: lib/util.cmi interp/topconstr.cmi lib/pp.cmi \
-    kernel/names.cmi library/libnames.cmi interp/genarg.cmi lib/dyn.cmi \
-    parsing/coqast.cmi parsing/ast.cmi 
-parsing/ast.cmx: lib/util.cmx interp/topconstr.cmx lib/pp.cmx \
-    kernel/names.cmx library/libnames.cmx interp/genarg.cmx lib/dyn.cmx \
-    parsing/coqast.cmx parsing/ast.cmi 
-parsing/coqast.cmo: lib/util.cmi kernel/names.cmi library/libnames.cmi \
-    lib/hashcons.cmi lib/dyn.cmi parsing/coqast.cmi 
-parsing/coqast.cmx: lib/util.cmx kernel/names.cmx library/libnames.cmx \
-    lib/hashcons.cmx lib/dyn.cmx parsing/coqast.cmi 
-parsing/egrammar.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi proofs/tacexpr.cmo library/summary.cmi \
-    parsing/pptactic.cmi interp/ppextend.cmi lib/pp.cmi parsing/pcoq.cmi \
-    lib/options.cmi kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    parsing/lexer.cmi interp/genarg.cmi parsing/extend.cmi lib/bignat.cmi \
-    parsing/ast.cmi parsing/egrammar.cmi 
-parsing/egrammar.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx proofs/tacexpr.cmx library/summary.cmx \
-    parsing/pptactic.cmx interp/ppextend.cmx lib/pp.cmx parsing/pcoq.cmx \
-    lib/options.cmx kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    parsing/lexer.cmx interp/genarg.cmx parsing/extend.cmx lib/bignat.cmx \
-    parsing/ast.cmx parsing/egrammar.cmi 
-parsing/esyntax.cmo: lib/util.cmi interp/topconstr.cmi interp/symbols.cmi \
-    interp/ppextend.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi lib/gmapl.cmi lib/gmap.cmi \
-    parsing/extend.cmi parsing/coqast.cmi parsing/ast.cmi parsing/esyntax.cmi 
-parsing/esyntax.cmx: lib/util.cmx interp/topconstr.cmx interp/symbols.cmx \
-    interp/ppextend.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/libnames.cmx lib/gmapl.cmx lib/gmap.cmx \
-    parsing/extend.cmx parsing/coqast.cmx parsing/ast.cmx parsing/esyntax.cmi 
-parsing/extend.cmo: lib/util.cmi interp/topconstr.cmi pretyping/rawterm.cmi \
-    interp/ppextend.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \
-    library/libnames.cmi parsing/lexer.cmi interp/genarg.cmi \
-    parsing/coqast.cmi parsing/ast.cmi parsing/extend.cmi 
-parsing/extend.cmx: lib/util.cmx interp/topconstr.cmx pretyping/rawterm.cmx \
-    interp/ppextend.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \
-    library/libnames.cmx parsing/lexer.cmx interp/genarg.cmx \
-    parsing/coqast.cmx parsing/ast.cmx parsing/extend.cmi 
-parsing/g_basevernac.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    parsing/termast.cmi interp/ppextend.cmi lib/pp.cmi parsing/pcoq.cmi \
-    lib/options.cmi kernel/names.cmi toplevel/metasyntax.cmi \
-    parsing/lexer.cmi library/goptions.cmi library/global.cmi \
-    parsing/extend.cmi pretyping/evd.cmi parsing/coqast.cmi \
-    interp/constrintern.cmi parsing/ast.cmi 
-parsing/g_basevernac.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    parsing/termast.cmx interp/ppextend.cmx lib/pp.cmx parsing/pcoq.cmx \
-    lib/options.cmx kernel/names.cmx toplevel/metasyntax.cmx \
-    parsing/lexer.cmx library/goptions.cmx library/global.cmx \
-    parsing/extend.cmx pretyping/evd.cmx parsing/coqast.cmx \
-    interp/constrintern.cmx parsing/ast.cmx 
-parsing/g_cases.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    lib/pp.cmi parsing/pcoq.cmi lib/options.cmi library/libnames.cmi \
-    parsing/g_constr.cmo 
-parsing/g_cases.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
-    lib/pp.cmx parsing/pcoq.cmx lib/options.cmx library/libnames.cmx \
-    parsing/g_constr.cmx 
-parsing/g_constr.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi \
-    lib/options.cmi kernel/names.cmi library/libnames.cmi parsing/lexer.cmi 
-parsing/g_constr.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
-    pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx \
-    lib/options.cmx kernel/names.cmx library/libnames.cmx parsing/lexer.cmx 
-parsing/g_constrnew.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.cmi \
-    kernel/names.cmi library/libnames.cmi parsing/lexer.cmi \
-    parsing/coqast.cmi lib/bignat.cmi 
-parsing/g_constrnew.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
-    pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx lib/options.cmx \
-    kernel/names.cmx library/libnames.cmx parsing/lexer.cmx \
-    parsing/coqast.cmx lib/bignat.cmx 
-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 \
-    pretyping/pattern.cmi lib/options.cmi kernel/names.cmi \
-    library/libnames.cmi interp/genarg.cmi parsing/ast.cmi 
-parsing/g_ltac.cmx: toplevel/vernacexpr.cmx lib/util.cmx interp/topconstr.cmx \
-    proofs/tacexpr.cmx pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx \
-    pretyping/pattern.cmx lib/options.cmx kernel/names.cmx \
-    library/libnames.cmx interp/genarg.cmx parsing/ast.cmx 
-parsing/g_ltacnew.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi lib/pp.cmi \
-    parsing/pcoq.cmi lib/options.cmi kernel/names.cmi interp/genarg.cmi \
-    parsing/ast.cmi 
-parsing/g_ltacnew.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx proofs/tacexpr.cmx pretyping/rawterm.cmx lib/pp.cmx \
-    parsing/pcoq.cmx lib/options.cmx kernel/names.cmx interp/genarg.cmx \
-    parsing/ast.cmx 
-parsing/g_minicoq.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    lib/pp.cmi kernel/names.cmi parsing/lexer.cmi kernel/environ.cmi \
+library/nametab.cmo: kernel/declarations.cmi library/libnames.cmi \
+    library/nameops.cmi kernel/names.cmi lib/pp.cmi library/summary.cmi \
+    lib/util.cmi library/nametab.cmi 
+library/nametab.cmx: kernel/declarations.cmx library/libnames.cmx \
+    library/nameops.cmx kernel/names.cmx lib/pp.cmx library/summary.cmx \
+    lib/util.cmx library/nametab.cmi 
+library/states.cmo: library/lib.cmi library/library.cmi library/summary.cmi \
+    lib/system.cmi library/states.cmi 
+library/states.cmx: library/lib.cmx library/library.cmx library/summary.cmx \
+    lib/system.cmx library/states.cmi 
+library/summary.cmo: lib/dyn.cmi lib/pp.cmi lib/util.cmi library/summary.cmi 
+library/summary.cmx: lib/dyn.cmx lib/pp.cmx lib/util.cmx library/summary.cmi 
+lib/rtree.cmo: lib/pp.cmi lib/util.cmi lib/rtree.cmi 
+lib/rtree.cmx: lib/pp.cmx lib/util.cmx lib/rtree.cmi 
+lib/stamps.cmo: lib/stamps.cmi 
+lib/stamps.cmx: lib/stamps.cmi 
+lib/system.cmo: config/coq_config.cmi lib/pp.cmi lib/util.cmi lib/system.cmi 
+lib/system.cmx: config/coq_config.cmx lib/pp.cmx lib/util.cmx lib/system.cmi 
+lib/tlm.cmo: lib/gmap.cmi lib/gset.cmi lib/tlm.cmi 
+lib/tlm.cmx: lib/gmap.cmx lib/gset.cmx lib/tlm.cmi 
+lib/util.cmo: lib/compat.cmo lib/pp.cmi lib/util.cmi 
+lib/util.cmx: lib/compat.cmx lib/pp.cmx lib/util.cmi 
+parsing/argextend.cmo: interp/genarg.cmi parsing/pcoq.cmi \
+    parsing/q_coqast.cmo parsing/q_util.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo 
+parsing/argextend.cmx: interp/genarg.cmx parsing/pcoq.cmx \
+    parsing/q_coqast.cmx parsing/q_util.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx 
+parsing/egrammar.cmo: lib/bigint.cmi parsing/extend.cmi interp/genarg.cmi \
+    parsing/lexer.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi interp/notation.cmi parsing/pcoq.cmi lib/pp.cmi \
+    library/summary.cmi proofs/tacexpr.cmo interp/topconstr.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo parsing/egrammar.cmi 
+parsing/egrammar.cmx: lib/bigint.cmx parsing/extend.cmx interp/genarg.cmx \
+    parsing/lexer.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx interp/notation.cmx parsing/pcoq.cmx lib/pp.cmx \
+    library/summary.cmx proofs/tacexpr.cmx interp/topconstr.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx parsing/egrammar.cmi 
+parsing/extend.cmo: interp/genarg.cmi kernel/names.cmi lib/pp.cmi \
+    interp/ppextend.cmi interp/topconstr.cmi lib/util.cmi parsing/extend.cmi 
+parsing/extend.cmx: interp/genarg.cmx kernel/names.cmx lib/pp.cmx \
+    interp/ppextend.cmx interp/topconstr.cmx lib/util.cmx parsing/extend.cmi 
+parsing/g_ascii_syntax.cmo: lib/bigint.cmi interp/coqlib.cmi \
+    library/libnames.cmi kernel/names.cmi interp/notation.cmi \
+    parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi interp/topconstr.cmi \
+    lib/util.cmi 
+parsing/g_ascii_syntax.cmx: lib/bigint.cmx interp/coqlib.cmx \
+    library/libnames.cmx kernel/names.cmx interp/notation.cmx \
+    parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx interp/topconstr.cmx \
+    lib/util.cmx 
+parsing/g_constr.cmo: lib/bigint.cmi parsing/lexer.cmi library/libnames.cmi \
+    kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    kernel/term.cmi interp/topconstr.cmi lib/util.cmi 
+parsing/g_constr.cmx: lib/bigint.cmx parsing/lexer.cmx library/libnames.cmx \
+    kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    kernel/term.cmx interp/topconstr.cmx lib/util.cmx 
+parsing/g_ltac.cmo: interp/genarg.cmi kernel/names.cmi parsing/pcoq.cmi \
+    lib/pp.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo interp/topconstr.cmi \
+    lib/util.cmi toplevel/vernacexpr.cmo 
+parsing/g_ltac.cmx: interp/genarg.cmx kernel/names.cmx parsing/pcoq.cmx \
+    lib/pp.cmx pretyping/rawterm.cmx proofs/tacexpr.cmx interp/topconstr.cmx \
+    lib/util.cmx toplevel/vernacexpr.cmx 
+parsing/g_minicoq.cmo: kernel/environ.cmi parsing/lexer.cmi kernel/names.cmi \
+    lib/pp.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi \
     parsing/g_minicoq.cmi 
-parsing/g_minicoq.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    lib/pp.cmx kernel/names.cmx parsing/lexer.cmx kernel/environ.cmx \
+parsing/g_minicoq.cmx: kernel/environ.cmx parsing/lexer.cmx kernel/names.cmx \
+    lib/pp.cmx kernel/term.cmx kernel/univ.cmx lib/util.cmx \
     parsing/g_minicoq.cmi 
-parsing/g_module.cmo: lib/util.cmi interp/topconstr.cmi lib/pp.cmi \
-    parsing/pcoq.cmi lib/options.cmi parsing/ast.cmi 
-parsing/g_module.cmx: lib/util.cmx interp/topconstr.cmx lib/pp.cmx \
-    parsing/pcoq.cmx lib/options.cmx parsing/ast.cmx 
-parsing/g_natsyntax.cmo: lib/util.cmi parsing/termast.cmi interp/symbols.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.cmi \
-    kernel/names.cmi library/libnames.cmi parsing/extend.cmi \
-    parsing/esyntax.cmi interp/coqlib.cmi parsing/coqast.cmi lib/bignat.cmi \
-    parsing/ast.cmi parsing/g_natsyntax.cmi 
-parsing/g_natsyntax.cmx: lib/util.cmx parsing/termast.cmx interp/symbols.cmx \
-    pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx lib/options.cmx \
-    kernel/names.cmx library/libnames.cmx parsing/extend.cmx \
-    parsing/esyntax.cmx interp/coqlib.cmx parsing/coqast.cmx lib/bignat.cmx \
-    parsing/ast.cmx parsing/g_natsyntax.cmi 
-parsing/g_prim.cmo: interp/topconstr.cmi parsing/pcoq.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi parsing/coqast.cmi lib/bignat.cmi 
-parsing/g_prim.cmx: interp/topconstr.cmx parsing/pcoq.cmx library/nametab.cmx \
-    kernel/names.cmx library/libnames.cmx parsing/coqast.cmx lib/bignat.cmx 
-parsing/g_primnew.cmo: lib/util.cmi interp/topconstr.cmi lib/pp.cmi \
-    parsing/pcoq.cmi lib/options.cmi library/nametab.cmi kernel/names.cmi \
-    library/libnames.cmi parsing/lexer.cmi parsing/coqast.cmi lib/bignat.cmi 
-parsing/g_primnew.cmx: lib/util.cmx interp/topconstr.cmx lib/pp.cmx \
-    parsing/pcoq.cmx lib/options.cmx library/nametab.cmx kernel/names.cmx \
-    library/libnames.cmx parsing/lexer.cmx parsing/coqast.cmx lib/bignat.cmx 
-parsing/g_proofs.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi proofs/tacexpr.cmo lib/pp.cmi parsing/pcoq.cmi \
-    lib/options.cmi interp/genarg.cmi 
-parsing/g_proofs.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx proofs/tacexpr.cmx lib/pp.cmx parsing/pcoq.cmx \
-    lib/options.cmx interp/genarg.cmx 
-parsing/g_proofsnew.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi proofs/tacexpr.cmo lib/pp.cmi parsing/pcoq.cmi \
-    lib/options.cmi interp/genarg.cmi parsing/g_vernacnew.cmo 
-parsing/g_proofsnew.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx proofs/tacexpr.cmx lib/pp.cmx parsing/pcoq.cmx \
-    lib/options.cmx interp/genarg.cmx parsing/g_vernacnew.cmx 
-parsing/g_rsyntax.cmo: lib/util.cmi interp/topconstr.cmi parsing/termast.cmi \
-    interp/symbols.cmi pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi \
-    lib/options.cmi library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    parsing/extend.cmi parsing/esyntax.cmi parsing/coqast.cmi lib/bignat.cmi \
-    parsing/ast.cmi 
-parsing/g_rsyntax.cmx: lib/util.cmx interp/topconstr.cmx parsing/termast.cmx \
-    interp/symbols.cmx pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx \
-    lib/options.cmx library/nametab.cmx kernel/names.cmx library/libnames.cmx \
-    parsing/extend.cmx parsing/esyntax.cmx parsing/coqast.cmx lib/bignat.cmx \
-    parsing/ast.cmx 
-parsing/g_tactic.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \
-    pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi \
-    lib/options.cmi kernel/names.cmi library/libnames.cmi parsing/lexer.cmi \
-    interp/genarg.cmi parsing/ast.cmi 
-parsing/g_tactic.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \
-    pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx \
-    lib/options.cmx kernel/names.cmx library/libnames.cmx parsing/lexer.cmx \
-    interp/genarg.cmx parsing/ast.cmx 
-parsing/g_tacticnew.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \
-    pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.cmi \
-    kernel/names.cmi parsing/lexer.cmi interp/genarg.cmi parsing/ast.cmi 
-parsing/g_tacticnew.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \
-    pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx lib/options.cmx \
-    kernel/names.cmx parsing/lexer.cmx interp/genarg.cmx parsing/ast.cmx 
-parsing/g_vernac.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi toplevel/recordobj.cmi lib/pp.cmi parsing/pcoq.cmi \
-    lib/options.cmi kernel/names.cmi library/goptions.cmi interp/genarg.cmi \
-    parsing/g_proofs.cmo parsing/g_basevernac.cmo library/decl_kinds.cmo \
-    toplevel/class.cmi parsing/ast.cmi 
-parsing/g_vernac.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx toplevel/recordobj.cmx lib/pp.cmx parsing/pcoq.cmx \
-    lib/options.cmx kernel/names.cmx library/goptions.cmx interp/genarg.cmx \
-    parsing/g_proofs.cmx parsing/g_basevernac.cmx library/decl_kinds.cmx \
-    toplevel/class.cmx parsing/ast.cmx 
-parsing/g_vernacnew.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi toplevel/recordobj.cmi interp/ppextend.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_constrnew.cmo parsing/extend.cmi \
-    parsing/egrammar.cmi library/decl_kinds.cmo parsing/coqast.cmi \
-    toplevel/class.cmi parsing/ast.cmi 
-parsing/g_vernacnew.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx toplevel/recordobj.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_constrnew.cmx parsing/extend.cmx \
-    parsing/egrammar.cmx library/decl_kinds.cmx parsing/coqast.cmx \
-    toplevel/class.cmx parsing/ast.cmx 
-parsing/g_zsyntax.cmo: lib/util.cmi interp/topconstr.cmi parsing/termast.cmi \
-    interp/symbols.cmi pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi \
-    lib/options.cmi kernel/names.cmi library/libnames.cmi parsing/extend.cmi \
-    parsing/esyntax.cmi interp/coqlib.cmi parsing/coqast.cmi lib/bignat.cmi \
-    parsing/ast.cmi parsing/g_zsyntax.cmi 
-parsing/g_zsyntax.cmx: lib/util.cmx interp/topconstr.cmx parsing/termast.cmx \
-    interp/symbols.cmx pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx \
-    lib/options.cmx kernel/names.cmx library/libnames.cmx parsing/extend.cmx \
-    parsing/esyntax.cmx interp/coqlib.cmx parsing/coqast.cmx lib/bignat.cmx \
-    parsing/ast.cmx parsing/g_zsyntax.cmi 
-parsing/lexer.cmo: lib/util.cmi lib/pp.cmi lib/options.cmi parsing/lexer.cmi 
-parsing/lexer.cmx: lib/util.cmx lib/pp.cmx lib/options.cmx parsing/lexer.cmi 
-parsing/pcoq.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \
-    pretyping/rawterm.cmi interp/ppextend.cmi lib/pp.cmi lib/options.cmi \
-    kernel/names.cmi library/libnames.cmi parsing/lexer.cmi interp/genarg.cmi \
-    parsing/extend.cmi library/decl_kinds.cmo parsing/coqast.cmi \
-    parsing/ast.cmi parsing/pcoq.cmi 
-parsing/pcoq.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \
-    pretyping/rawterm.cmx interp/ppextend.cmx lib/pp.cmx lib/options.cmx \
-    kernel/names.cmx library/libnames.cmx parsing/lexer.cmx interp/genarg.cmx \
-    parsing/extend.cmx library/decl_kinds.cmx parsing/coqast.cmx \
-    parsing/ast.cmx parsing/pcoq.cmi 
-parsing/ppconstr.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    interp/symbols.cmi pretyping/rawterm.cmi interp/ppextend.cmi lib/pp.cmi \
-    pretyping/pattern.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi library/libnames.cmi interp/genarg.cmi \
-    pretyping/evd.cmi parsing/coqast.cmi interp/constrextern.cmi \
-    lib/bignat.cmi parsing/ast.cmi parsing/ppconstr.cmi 
-parsing/ppconstr.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
-    interp/symbols.cmx pretyping/rawterm.cmx interp/ppextend.cmx lib/pp.cmx \
-    pretyping/pattern.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx library/libnames.cmx interp/genarg.cmx \
-    pretyping/evd.cmx parsing/coqast.cmx interp/constrextern.cmx \
-    lib/bignat.cmx parsing/ast.cmx parsing/ppconstr.cmi 
-parsing/pptactic.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    proofs/tacexpr.cmo pretyping/rawterm.cmi parsing/printer.cmi \
-    translate/ppconstrnew.cmi parsing/ppconstr.cmi lib/pp.cmi \
-    pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    interp/genarg.cmi parsing/extend.cmi lib/dyn.cmi interp/constrextern.cmi \
-    kernel/closure.cmi parsing/pptactic.cmi 
-parsing/pptactic.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
-    proofs/tacexpr.cmx pretyping/rawterm.cmx parsing/printer.cmx \
-    translate/ppconstrnew.cmx parsing/ppconstr.cmx lib/pp.cmx \
-    pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    interp/genarg.cmx parsing/extend.cmx lib/dyn.cmx interp/constrextern.cmx \
-    kernel/closure.cmx parsing/pptactic.cmi 
-parsing/prettyp.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    interp/syntax_def.cmi interp/symbols.cmi kernel/sign.cmi \
-    kernel/safe_typing.cmi pretyping/reductionops.cmi kernel/reduction.cmi \
-    parsing/printmod.cmi parsing/printer.cmi lib/pp.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libobject.cmi library/libnames.cmi library/lib.cmi \
-    pretyping/instantiate.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
-    library/impargs.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi library/declare.cmi kernel/declarations.cmi \
-    interp/constrextern.cmi pretyping/classops.cmi parsing/prettyp.cmi 
-parsing/prettyp.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    interp/syntax_def.cmx interp/symbols.cmx kernel/sign.cmx \
-    kernel/safe_typing.cmx pretyping/reductionops.cmx kernel/reduction.cmx \
-    parsing/printmod.cmx parsing/printer.cmx lib/pp.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/libobject.cmx library/libnames.cmx library/lib.cmx \
-    pretyping/instantiate.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
-    library/impargs.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx library/declare.cmx kernel/declarations.cmx \
-    interp/constrextern.cmx pretyping/classops.cmx parsing/prettyp.cmi 
-parsing/printer.cmo: lib/util.cmi pretyping/termops.cmi parsing/termast.cmi \
-    kernel/term.cmi kernel/sign.cmi interp/ppextend.cmi \
-    translate/ppconstrnew.cmi parsing/ppconstr.cmi lib/pp.cmi \
-    pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    library/global.cmi parsing/extend.cmi parsing/esyntax.cmi \
-    kernel/environ.cmi lib/dyn.cmi library/declare.cmi parsing/coqast.cmi \
-    interp/constrextern.cmi parsing/ast.cmi parsing/printer.cmi 
-parsing/printer.cmx: lib/util.cmx pretyping/termops.cmx parsing/termast.cmx \
-    kernel/term.cmx kernel/sign.cmx interp/ppextend.cmx \
-    translate/ppconstrnew.cmx parsing/ppconstr.cmx lib/pp.cmx \
-    pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    library/global.cmx parsing/extend.cmx parsing/esyntax.cmx \
-    kernel/environ.cmx lib/dyn.cmx library/declare.cmx parsing/coqast.cmx \
-    interp/constrextern.cmx parsing/ast.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 
-parsing/printmod.cmx: lib/util.cmx lib/pp.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    library/global.cmx kernel/declarations.cmx parsing/printmod.cmi 
-parsing/q_coqast.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \
-    pretyping/rawterm.cmi parsing/q_util.cmi parsing/pcoq.cmi \
-    kernel/names.cmi library/libnames.cmi interp/genarg.cmi \
-    parsing/coqast.cmi 
-parsing/q_coqast.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \
-    pretyping/rawterm.cmx parsing/q_util.cmx parsing/pcoq.cmx \
-    kernel/names.cmx library/libnames.cmx interp/genarg.cmx \
-    parsing/coqast.cmx 
-parsing/q_util.cmo: lib/util.cmi parsing/q_util.cmi 
-parsing/q_util.cmx: lib/util.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/library.cmi \
-    library/libobject.cmi library/libnames.cmi kernel/inductive.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    library/declaremods.cmi library/declare.cmi kernel/declarations.cmi \
-    interp/coqlib.cmi parsing/coqast.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/library.cmx \
-    library/libobject.cmx library/libnames.cmx kernel/inductive.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    library/declaremods.cmx library/declare.cmx kernel/declarations.cmx \
-    interp/coqlib.cmx parsing/coqast.cmx parsing/search.cmi 
-parsing/tacextend.cmo: toplevel/vernacexpr.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 
-parsing/tacextend.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    parsing/q_util.cmx parsing/q_coqast.cmx lib/pp_control.cmx lib/pp.cmx \
-    parsing/pcoq.cmx interp/genarg.cmx parsing/argextend.cmx 
-parsing/termast.cmo: lib/util.cmi kernel/univ.cmi pretyping/termops.cmi \
-    kernel/term.cmi kernel/sign.cmi pretyping/reductionops.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi pretyping/pattern.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libnames.cmi kernel/inductive.cmi library/impargs.cmi \
-    kernel/environ.cmi pretyping/detyping.cmi library/declare.cmi \
-    parsing/coqast.cmi interp/constrextern.cmi pretyping/classops.cmi \
-    parsing/ast.cmi parsing/termast.cmi 
-parsing/termast.cmx: lib/util.cmx kernel/univ.cmx pretyping/termops.cmx \
-    kernel/term.cmx kernel/sign.cmx pretyping/reductionops.cmx \
-    pretyping/rawterm.cmx lib/pp.cmx pretyping/pattern.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/libnames.cmx kernel/inductive.cmx library/impargs.cmx \
-    kernel/environ.cmx pretyping/detyping.cmx library/declare.cmx \
-    parsing/coqast.cmx interp/constrextern.cmx pretyping/classops.cmx \
-    parsing/ast.cmx parsing/termast.cmi 
-parsing/vernacextend.cmo: toplevel/vernacexpr.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/ast.cmi parsing/argextend.cmo 
-parsing/vernacextend.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    parsing/q_util.cmx parsing/q_coqast.cmx lib/pp_control.cmx lib/pp.cmx \
-    parsing/pcoq.cmx interp/genarg.cmx parsing/ast.cmx parsing/argextend.cmx 
-pretyping/cases.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 pretyping/rawterm.cmi \
-    pretyping/pretype_errors.cmi lib/pp.cmi kernel/names.cmi \
-    library/nameops.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
-    library/global.cmi pretyping/evarutil.cmi pretyping/evarconv.cmi \
-    kernel/environ.cmi kernel/declarations.cmi pretyping/coercion.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 \
-    pretyping/pretype_errors.cmx lib/pp.cmx kernel/names.cmx \
-    library/nameops.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
-    library/global.cmx pretyping/evarutil.cmx pretyping/evarconv.cmx \
-    kernel/environ.cmx kernel/declarations.cmx pretyping/coercion.cmx \
-    pretyping/cases.cmi 
-pretyping/cbv.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi lib/pp.cmi \
-    kernel/names.cmi pretyping/instantiate.cmi pretyping/evd.cmi \
-    kernel/esubst.cmi kernel/environ.cmi kernel/closure.cmi pretyping/cbv.cmi 
-pretyping/cbv.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx lib/pp.cmx \
-    kernel/names.cmx pretyping/instantiate.cmx pretyping/evd.cmx \
-    kernel/esubst.cmx kernel/environ.cmx kernel/closure.cmx pretyping/cbv.cmi 
-pretyping/classops.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    pretyping/tacred.cmi library/summary.cmi pretyping/reductionops.cmi \
-    pretyping/rawterm.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.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/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 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/coercion.cmo: lib/util.cmi kernel/typeops.cmi kernel/term.cmi \
-    pretyping/retyping.cmi pretyping/reductionops.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 kernel/term.cmx \
-    pretyping/retyping.cmx pretyping/reductionops.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 \
-    library/libnames.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
-    library/goptions.cmi library/global.cmi kernel/environ.cmi \
-    kernel/declarations.cmi pretyping/detyping.cmi 
-pretyping/detyping.cmx: lib/util.cmx kernel/univ.cmx pretyping/termops.cmx \
-    kernel/term.cmx kernel/sign.cmx pretyping/rawterm.cmx lib/pp.cmx \
-    lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/libnames.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
-    library/goptions.cmx library/global.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 pretyping/recordops.cmi pretyping/rawterm.cmi \
-    kernel/names.cmi library/libnames.cmi pretyping/instantiate.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 pretyping/recordops.cmx pretyping/rawterm.cmx \
-    kernel/names.cmx library/libnames.cmx pretyping/instantiate.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 kernel/typeops.cmi \
-    pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \
-    pretyping/reductionops.cmi pretyping/rawterm.cmi \
-    pretyping/pretype_errors.cmi lib/pp.cmi kernel/names.cmi \
-    library/nameops.cmi pretyping/instantiate.cmi pretyping/indrec.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    pretyping/evarutil.cmi 
-pretyping/evarutil.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
-    pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \
-    pretyping/reductionops.cmx pretyping/rawterm.cmx \
-    pretyping/pretype_errors.cmx lib/pp.cmx kernel/names.cmx \
-    library/nameops.cmx pretyping/instantiate.cmx pretyping/indrec.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    pretyping/evarutil.cmi 
-pretyping/evd.cmo: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/names.cmi pretyping/evd.cmi 
-pretyping/evd.cmx: lib/util.cmx kernel/term.cmx kernel/sign.cmx \
-    kernel/names.cmx pretyping/evd.cmi 
-pretyping/indrec.cmo: lib/util.cmi kernel/typeops.cmi kernel/type_errors.cmi \
-    pretyping/termops.cmi kernel/term.cmi kernel/safe_typing.cmi \
-    pretyping/reductionops.cmi kernel/reduction.cmi lib/pp.cmi \
-    lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libnames.cmi pretyping/instantiate.cmi pretyping/inductiveops.cmi \
-    kernel/inductive.cmi kernel/indtypes.cmi library/global.cmi \
-    kernel/environ.cmi kernel/entries.cmi kernel/declarations.cmi \
+parsing/g_natsyntax.cmo: lib/bigint.cmi interp/coqlib.cmi \
+    library/libnames.cmi kernel/names.cmi interp/notation.cmi lib/options.cmi \
+    parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi lib/util.cmi \
+    parsing/g_natsyntax.cmi 
+parsing/g_natsyntax.cmx: lib/bigint.cmx interp/coqlib.cmx \
+    library/libnames.cmx kernel/names.cmx interp/notation.cmx lib/options.cmx \
+    parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx lib/util.cmx \
+    parsing/g_natsyntax.cmi 
+parsing/g_prim.cmo: lib/bigint.cmi parsing/lexer.cmi library/libnames.cmi \
+    kernel/names.cmi library/nametab.cmi parsing/pcoq.cmi lib/pp.cmi \
+    interp/topconstr.cmi lib/util.cmi 
+parsing/g_prim.cmx: lib/bigint.cmx parsing/lexer.cmx library/libnames.cmx \
+    kernel/names.cmx library/nametab.cmx parsing/pcoq.cmx lib/pp.cmx \
+    interp/topconstr.cmx lib/util.cmx 
+parsing/g_proofs.cmo: parsing/g_vernac.cmo interp/genarg.cmi parsing/pcoq.cmi \
+    lib/pp.cmi proofs/tacexpr.cmo kernel/term.cmi interp/topconstr.cmi \
+    lib/util.cmi toplevel/vernacexpr.cmo 
+parsing/g_proofs.cmx: parsing/g_vernac.cmx interp/genarg.cmx parsing/pcoq.cmx \
+    lib/pp.cmx proofs/tacexpr.cmx kernel/term.cmx interp/topconstr.cmx \
+    lib/util.cmx toplevel/vernacexpr.cmx 
+parsing/g_rsyntax.cmo: lib/bigint.cmi library/libnames.cmi kernel/names.cmi \
+    interp/notation.cmi parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    interp/topconstr.cmi lib/util.cmi 
+parsing/g_rsyntax.cmx: lib/bigint.cmx library/libnames.cmx kernel/names.cmx \
+    interp/notation.cmx parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    interp/topconstr.cmx lib/util.cmx 
+parsing/g_string_syntax.cmo: interp/coqlib.cmi parsing/g_ascii_syntax.cmo \
+    library/libnames.cmi kernel/names.cmi interp/notation.cmi \
+    parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi interp/topconstr.cmi \
+    lib/util.cmi 
+parsing/g_string_syntax.cmx: interp/coqlib.cmx parsing/g_ascii_syntax.cmx \
+    library/libnames.cmx kernel/names.cmx interp/notation.cmx \
+    parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx interp/topconstr.cmx \
+    lib/util.cmx 
+parsing/g_tactic.cmo: interp/genarg.cmi parsing/lexer.cmi kernel/names.cmi \
+    parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \
+    interp/topconstr.cmi lib/util.cmi 
+parsing/g_tactic.cmx: interp/genarg.cmx parsing/lexer.cmx kernel/names.cmx \
+    parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx proofs/tacexpr.cmx \
+    interp/topconstr.cmx lib/util.cmx 
+parsing/g_vernac.cmo: toplevel/class.cmi library/decl_kinds.cmo \
+    parsing/extend.cmi parsing/g_constr.cmo interp/genarg.cmi \
+    library/goptions.cmi parsing/lexer.cmi library/nameops.cmi \
+    kernel/names.cmi lib/options.cmi parsing/pcoq.cmi lib/pp.cmi \
+    interp/ppextend.cmi pretyping/recordops.cmi interp/topconstr.cmi \
+    lib/util.cmi toplevel/vernacexpr.cmo 
+parsing/g_vernac.cmx: toplevel/class.cmx library/decl_kinds.cmx \
+    parsing/extend.cmx parsing/g_constr.cmx interp/genarg.cmx \
+    library/goptions.cmx parsing/lexer.cmx library/nameops.cmx \
+    kernel/names.cmx lib/options.cmx parsing/pcoq.cmx lib/pp.cmx \
+    interp/ppextend.cmx pretyping/recordops.cmx interp/topconstr.cmx \
+    lib/util.cmx toplevel/vernacexpr.cmx 
+parsing/g_xml.cmo: interp/genarg.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    proofs/tacexpr.cmo kernel/term.cmi lib/util.cmi 
+parsing/g_xml.cmx: interp/genarg.cmx library/libnames.cmx kernel/names.cmx \
+    library/nametab.cmx parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    proofs/tacexpr.cmx kernel/term.cmx lib/util.cmx 
+parsing/g_zsyntax.cmo: lib/bigint.cmi library/libnames.cmi kernel/names.cmi \
+    interp/notation.cmi parsing/pcoq.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    interp/topconstr.cmi lib/util.cmi parsing/g_zsyntax.cmi 
+parsing/g_zsyntax.cmx: lib/bigint.cmx library/libnames.cmx kernel/names.cmx \
+    interp/notation.cmx parsing/pcoq.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    interp/topconstr.cmx lib/util.cmx parsing/g_zsyntax.cmi 
+parsing/lexer.cmo: lib/options.cmi lib/pp.cmi lib/util.cmi parsing/lexer.cmi 
+parsing/lexer.cmx: lib/options.cmx lib/pp.cmx lib/util.cmx parsing/lexer.cmi 
+parsing/pcoq.cmo: library/decl_kinds.cmo parsing/extend.cmi interp/genarg.cmi \
+    parsing/lexer.cmi library/libnames.cmi kernel/names.cmi lib/options.cmi \
+    lib/pp.cmi interp/ppextend.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \
+    interp/topconstr.cmi lib/util.cmi parsing/pcoq.cmi 
+parsing/pcoq.cmx: library/decl_kinds.cmx parsing/extend.cmx interp/genarg.cmx \
+    parsing/lexer.cmx library/libnames.cmx kernel/names.cmx lib/options.cmx \
+    lib/pp.cmx interp/ppextend.cmx pretyping/rawterm.cmx proofs/tacexpr.cmx \
+    interp/topconstr.cmx lib/util.cmx parsing/pcoq.cmi 
+parsing/ppconstr.cmo: lib/bigint.cmi interp/constrextern.cmi \
+    pretyping/evd.cmi interp/genarg.cmi library/libnames.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi \
+    interp/notation.cmi lib/options.cmi pretyping/pattern.cmi lib/pp.cmi \
+    interp/ppextend.cmi pretyping/rawterm.cmi kernel/term.cmi \
+    pretyping/termops.cmi interp/topconstr.cmi kernel/univ.cmi lib/util.cmi \
+    parsing/ppconstr.cmi 
+parsing/ppconstr.cmx: lib/bigint.cmx interp/constrextern.cmx \
+    pretyping/evd.cmx interp/genarg.cmx library/libnames.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx \
+    interp/notation.cmx lib/options.cmx pretyping/pattern.cmx lib/pp.cmx \
+    interp/ppextend.cmx pretyping/rawterm.cmx kernel/term.cmx \
+    pretyping/termops.cmx interp/topconstr.cmx kernel/univ.cmx lib/util.cmx \
+    parsing/ppconstr.cmi 
+parsing/pptactic.cmo: kernel/closure.cmi lib/dyn.cmi parsing/egrammar.cmi \
+    kernel/environ.cmi interp/genarg.cmi library/global.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi pretyping/pattern.cmi lib/pp.cmi parsing/ppconstr.cmi \
+    interp/ppextend.cmi parsing/printer.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi proofs/tacexpr.cmo proofs/tactic_debug.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi \
+    parsing/pptactic.cmi 
+parsing/pptactic.cmx: kernel/closure.cmx lib/dyn.cmx parsing/egrammar.cmx \
+    kernel/environ.cmx interp/genarg.cmx library/global.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx pretyping/pattern.cmx lib/pp.cmx parsing/ppconstr.cmx \
+    interp/ppextend.cmx parsing/printer.cmx proofs/proof_type.cmx \
+    pretyping/rawterm.cmx proofs/tacexpr.cmx proofs/tactic_debug.cmx \
+    kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx lib/util.cmx \
+    parsing/pptactic.cmi 
+parsing/ppvernac.cmo: library/decl_kinds.cmo library/declaremods.cmi \
+    parsing/egrammar.cmi parsing/extend.cmi interp/genarg.cmi \
+    library/global.cmi library/goptions.cmi library/impargs.cmi \
+    library/lib.cmi library/libnames.cmi interp/modintern.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi parsing/ppconstr.cmi \
+    interp/ppextend.cmi parsing/pptactic.cmi pretyping/rawterm.cmi \
+    proofs/tacexpr.cmo tactics/tacinterp.cmi interp/topconstr.cmi \
+    lib/util.cmi toplevel/vernacexpr.cmo parsing/ppvernac.cmi 
+parsing/ppvernac.cmx: library/decl_kinds.cmx library/declaremods.cmx \
+    parsing/egrammar.cmx parsing/extend.cmx interp/genarg.cmx \
+    library/global.cmx library/goptions.cmx library/impargs.cmx \
+    library/lib.cmx library/libnames.cmx interp/modintern.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx parsing/ppconstr.cmx \
+    interp/ppextend.cmx parsing/pptactic.cmx pretyping/rawterm.cmx \
+    proofs/tacexpr.cmx tactics/tacinterp.cmx interp/topconstr.cmx \
+    lib/util.cmx toplevel/vernacexpr.cmx parsing/ppvernac.cmi 
+parsing/prettyp.cmo: pretyping/classops.cmi interp/constrextern.cmi \
+    kernel/conv_oracle.cmi kernel/declarations.cmi library/declare.cmi \
+    kernel/environ.cmi pretyping/evd.cmi library/global.cmi \
+    library/impargs.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \
+    library/lib.cmi library/libnames.cmi library/libobject.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi \
+    interp/notation.cmi lib/pp.cmi parsing/printer.cmi parsing/printmod.cmi \
+    pretyping/recordops.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    kernel/safe_typing.cmi kernel/sign.cmi interp/syntax_def.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi parsing/prettyp.cmi 
+parsing/prettyp.cmx: pretyping/classops.cmx interp/constrextern.cmx \
+    kernel/conv_oracle.cmx kernel/declarations.cmx library/declare.cmx \
+    kernel/environ.cmx pretyping/evd.cmx library/global.cmx \
+    library/impargs.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \
+    library/lib.cmx library/libnames.cmx library/libobject.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx \
+    interp/notation.cmx lib/pp.cmx parsing/printer.cmx parsing/printmod.cmx \
+    pretyping/recordops.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    kernel/safe_typing.cmx kernel/sign.cmx interp/syntax_def.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.cmx parsing/prettyp.cmi 
+parsing/printer.cmo: interp/constrextern.cmi library/declare.cmi \
+    kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    library/global.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi lib/options.cmi proofs/pfedit.cmi \
+    lib/pp.cmi parsing/ppconstr.cmi proofs/proof_type.cmi proofs/refiner.cmi \
+    kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
+    parsing/printer.cmi 
+parsing/printer.cmx: interp/constrextern.cmx library/declare.cmx \
+    kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    library/global.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx lib/options.cmx proofs/pfedit.cmx \
+    lib/pp.cmx parsing/ppconstr.cmx proofs/proof_type.cmx proofs/refiner.cmx \
+    kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
+    parsing/printer.cmi 
+parsing/printmod.cmo: kernel/declarations.cmi library/global.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi lib/util.cmi parsing/printmod.cmi 
+parsing/printmod.cmx: kernel/declarations.cmx library/global.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx lib/util.cmx parsing/printmod.cmi 
+parsing/q_constr.cmo: kernel/names.cmi pretyping/pattern.cmi \
+    parsing/q_util.cmi pretyping/rawterm.cmi kernel/term.cmi lib/util.cmi 
+parsing/q_constr.cmx: kernel/names.cmx pretyping/pattern.cmx \
+    parsing/q_util.cmx pretyping/rawterm.cmx kernel/term.cmx lib/util.cmx 
+parsing/q_coqast.cmo: interp/genarg.cmi library/libnames.cmi kernel/names.cmi \
+    parsing/pcoq.cmi parsing/q_util.cmi pretyping/rawterm.cmi \
+    proofs/tacexpr.cmo interp/topconstr.cmi lib/util.cmi 
+parsing/q_coqast.cmx: interp/genarg.cmx library/libnames.cmx kernel/names.cmx \
+    parsing/pcoq.cmx parsing/q_util.cmx pretyping/rawterm.cmx \
+    proofs/tacexpr.cmx interp/topconstr.cmx lib/util.cmx 
+parsing/q_util.cmo: interp/genarg.cmi parsing/pcoq.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo parsing/q_util.cmi 
+parsing/q_util.cmx: interp/genarg.cmx parsing/pcoq.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx parsing/q_util.cmi 
+parsing/search.cmo: interp/coqlib.cmi kernel/declarations.cmi \
+    library/declare.cmi library/declaremods.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi pretyping/inductiveops.cmi \
+    library/libnames.cmi library/libobject.cmi pretyping/matching.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi \
+    pretyping/pattern.cmi lib/pp.cmi parsing/printer.cmi \
+    pretyping/rawterm.cmi kernel/term.cmi pretyping/termops.cmi \
+    pretyping/typing.cmi lib/util.cmi parsing/search.cmi 
+parsing/search.cmx: interp/coqlib.cmx kernel/declarations.cmx \
+    library/declare.cmx library/declaremods.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx pretyping/inductiveops.cmx \
+    library/libnames.cmx library/libobject.cmx pretyping/matching.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx \
+    pretyping/pattern.cmx lib/pp.cmx parsing/printer.cmx \
+    pretyping/rawterm.cmx kernel/term.cmx pretyping/termops.cmx \
+    pretyping/typing.cmx lib/util.cmx parsing/search.cmi 
+parsing/tacextend.cmo: parsing/argextend.cmo interp/genarg.cmi lib/pp.cmi \
+    lib/pp_control.cmi parsing/q_coqast.cmo parsing/q_util.cmi lib/util.cmi 
+parsing/tacextend.cmx: parsing/argextend.cmx interp/genarg.cmx lib/pp.cmx \
+    lib/pp_control.cmx parsing/q_coqast.cmx parsing/q_util.cmx lib/util.cmx 
+parsing/tactic_printer.cmo: kernel/environ.cmi pretyping/evd.cmi \
+    library/global.cmi proofs/logic.cmi lib/pp.cmi parsing/pptactic.cmi \
+    parsing/printer.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \
+    proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo lib/util.cmi \
+    parsing/tactic_printer.cmi 
+parsing/tactic_printer.cmx: kernel/environ.cmx pretyping/evd.cmx \
+    library/global.cmx proofs/logic.cmx lib/pp.cmx parsing/pptactic.cmx \
+    parsing/printer.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \
+    proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx lib/util.cmx \
+    parsing/tactic_printer.cmi 
+parsing/vernacextend.cmo: parsing/argextend.cmo interp/genarg.cmi lib/pp.cmi \
+    lib/pp_control.cmi parsing/q_coqast.cmo parsing/q_util.cmi lib/util.cmi 
+parsing/vernacextend.cmx: parsing/argextend.cmx interp/genarg.cmx lib/pp.cmx \
+    lib/pp_control.cmx parsing/q_coqast.cmx parsing/q_util.cmx lib/util.cmx 
+pretyping/cases.cmo: pretyping/coercion.cmi kernel/declarations.cmi \
+    kernel/environ.cmi pretyping/evarconv.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi library/global.cmi kernel/inductive.cmi \
+    pretyping/inductiveops.cmi library/nameops.cmi kernel/names.cmi \
+    lib/pp.cmi pretyping/pretype_errors.cmi pretyping/rawterm.cmi \
+    pretyping/reductionops.cmi pretyping/retyping.cmi kernel/sign.cmi \
+    kernel/term.cmi pretyping/termops.cmi kernel/type_errors.cmi \
+    kernel/typeops.cmi lib/util.cmi pretyping/cases.cmi 
+pretyping/cases.cmx: pretyping/coercion.cmx kernel/declarations.cmx \
+    kernel/environ.cmx pretyping/evarconv.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx library/global.cmx kernel/inductive.cmx \
+    pretyping/inductiveops.cmx library/nameops.cmx kernel/names.cmx \
+    lib/pp.cmx pretyping/pretype_errors.cmx pretyping/rawterm.cmx \
+    pretyping/reductionops.cmx pretyping/retyping.cmx kernel/sign.cmx \
+    kernel/term.cmx pretyping/termops.cmx kernel/type_errors.cmx \
+    kernel/typeops.cmx lib/util.cmx pretyping/cases.cmi 
+pretyping/cbv.cmo: kernel/closure.cmi kernel/conv_oracle.cmi \
+    kernel/environ.cmi kernel/esubst.cmi pretyping/evd.cmi kernel/names.cmi \
+    lib/pp.cmi kernel/term.cmi kernel/univ.cmi lib/util.cmi pretyping/cbv.cmi 
+pretyping/cbv.cmx: kernel/closure.cmx kernel/conv_oracle.cmx \
+    kernel/environ.cmx kernel/esubst.cmx pretyping/evd.cmx kernel/names.cmx \
+    lib/pp.cmx kernel/term.cmx kernel/univ.cmx lib/util.cmx pretyping/cbv.cmi 
+pretyping/classops.cmo: library/decl_kinds.cmo kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi lib/gmap.cmi library/goptions.cmi \
+    library/lib.cmi library/libnames.cmi library/libobject.cmi \
+    library/library.cmi kernel/mod_subst.cmi kernel/names.cmi \
+    library/nametab.cmi lib/options.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    pretyping/reductionops.cmi library/summary.cmi pretyping/tacred.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi pretyping/classops.cmi 
+pretyping/classops.cmx: library/decl_kinds.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx lib/gmap.cmx library/goptions.cmx \
+    library/lib.cmx library/libnames.cmx library/libobject.cmx \
+    library/library.cmx kernel/mod_subst.cmx kernel/names.cmx \
+    library/nametab.cmx lib/options.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    pretyping/reductionops.cmx library/summary.cmx pretyping/tacred.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.cmx pretyping/classops.cmi 
+pretyping/clenv.cmo: pretyping/coercion.cmi kernel/environ.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi \
+    kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \
+    pretyping/rawterm.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    pretyping/retyping.cmi kernel/sign.cmi proofs/tacexpr.cmo \
+    pretyping/tacred.cmi kernel/term.cmi pretyping/termops.cmi \
+    pretyping/typing.cmi pretyping/unification.cmi lib/util.cmi \
+    pretyping/clenv.cmi 
+pretyping/clenv.cmx: pretyping/coercion.cmx kernel/environ.cmx \
+    pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx \
+    kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx \
+    pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \
+    pretyping/rawterm.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    pretyping/retyping.cmx kernel/sign.cmx proofs/tacexpr.cmx \
+    pretyping/tacred.cmx kernel/term.cmx pretyping/termops.cmx \
+    pretyping/typing.cmx pretyping/unification.cmx lib/util.cmx \
+    pretyping/clenv.cmi 
+pretyping/coercion.cmo: pretyping/classops.cmi kernel/environ.cmi \
+    pretyping/evarconv.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    kernel/names.cmi pretyping/pretype_errors.cmi pretyping/rawterm.cmi \
+    pretyping/recordops.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    pretyping/retyping.cmi kernel/term.cmi kernel/typeops.cmi lib/util.cmi \
+    pretyping/coercion.cmi 
+pretyping/coercion.cmx: pretyping/classops.cmx kernel/environ.cmx \
+    pretyping/evarconv.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    kernel/names.cmx pretyping/pretype_errors.cmx pretyping/rawterm.cmx \
+    pretyping/recordops.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    pretyping/retyping.cmx kernel/term.cmx kernel/typeops.cmx lib/util.cmx \
+    pretyping/coercion.cmi 
+pretyping/detyping.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi library/goptions.cmi \
+    kernel/inductive.cmi pretyping/inductiveops.cmi library/libnames.cmi \
+    kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/options.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi kernel/univ.cmi \
+    lib/util.cmi pretyping/detyping.cmi 
+pretyping/detyping.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx library/goptions.cmx \
+    kernel/inductive.cmx pretyping/inductiveops.cmx library/libnames.cmx \
+    kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/options.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx kernel/univ.cmx \
+    lib/util.cmx pretyping/detyping.cmi 
+pretyping/evarconv.cmo: pretyping/classops.cmi kernel/closure.cmi \
+    kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    library/libnames.cmi kernel/names.cmi pretyping/recordops.cmi \
+    kernel/reduction.cmi pretyping/reductionops.cmi kernel/term.cmi \
+    pretyping/typing.cmi lib/util.cmi pretyping/evarconv.cmi 
+pretyping/evarconv.cmx: pretyping/classops.cmx kernel/closure.cmx \
+    kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    library/libnames.cmx kernel/names.cmx pretyping/recordops.cmx \
+    kernel/reduction.cmx pretyping/reductionops.cmx kernel/term.cmx \
+    pretyping/typing.cmx lib/util.cmx pretyping/evarconv.cmi 
+pretyping/evarutil.cmo: kernel/environ.cmi pretyping/evd.cmi \
+    library/nameops.cmi kernel/names.cmi lib/pp.cmi \
+    pretyping/pretype_errors.cmi kernel/reduction.cmi \
+    pretyping/reductionops.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi kernel/typeops.cmi pretyping/typing.cmi \
+    kernel/univ.cmi lib/util.cmi pretyping/evarutil.cmi 
+pretyping/evarutil.cmx: kernel/environ.cmx pretyping/evd.cmx \
+    library/nameops.cmx kernel/names.cmx lib/pp.cmx \
+    pretyping/pretype_errors.cmx kernel/reduction.cmx \
+    pretyping/reductionops.cmx kernel/sign.cmx kernel/term.cmx \
+    pretyping/termops.cmx kernel/typeops.cmx pretyping/typing.cmx \
+    kernel/univ.cmx lib/util.cmx pretyping/evarutil.cmi 
+pretyping/evd.cmo: kernel/environ.cmi library/global.cmi library/libnames.cmi \
+    kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi lib/pp.cmi \
+    kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi kernel/univ.cmi lib/util.cmi pretyping/evd.cmi 
+pretyping/evd.cmx: kernel/environ.cmx library/global.cmx library/libnames.cmx \
+    kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx lib/pp.cmx \
+    kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \
+    pretyping/termops.cmx kernel/univ.cmx lib/util.cmx pretyping/evd.cmi 
+pretyping/indrec.cmo: kernel/declarations.cmi kernel/entries.cmi \
+    kernel/environ.cmi library/global.cmi kernel/inductive.cmi \
+    pretyping/inductiveops.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi lib/options.cmi lib/pp.cmi \
+    kernel/reduction.cmi pretyping/reductionops.cmi kernel/safe_typing.cmi \
+    kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \
+    kernel/type_errors.cmi kernel/typeops.cmi lib/util.cmi \
     pretyping/indrec.cmi 
-pretyping/indrec.cmx: lib/util.cmx kernel/typeops.cmx kernel/type_errors.cmx \
-    pretyping/termops.cmx kernel/term.cmx kernel/safe_typing.cmx \
-    pretyping/reductionops.cmx kernel/reduction.cmx lib/pp.cmx \
-    lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/libnames.cmx pretyping/instantiate.cmx pretyping/inductiveops.cmx \
-    kernel/inductive.cmx kernel/indtypes.cmx library/global.cmx \
-    kernel/environ.cmx kernel/entries.cmx kernel/declarations.cmx \
+pretyping/indrec.cmx: kernel/declarations.cmx kernel/entries.cmx \
+    kernel/environ.cmx library/global.cmx kernel/inductive.cmx \
+    pretyping/inductiveops.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx lib/options.cmx lib/pp.cmx \
+    kernel/reduction.cmx pretyping/reductionops.cmx kernel/safe_typing.cmx \
+    kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx \
+    kernel/type_errors.cmx kernel/typeops.cmx lib/util.cmx \
     pretyping/indrec.cmi 
-pretyping/inductiveops.cmo: lib/util.cmi kernel/univ.cmi \
-    pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \
-    pretyping/reductionops.cmi kernel/names.cmi kernel/inductive.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/declarations.cmi pretyping/inductiveops.cmi 
-pretyping/inductiveops.cmx: lib/util.cmx kernel/univ.cmx \
-    pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \
-    pretyping/reductionops.cmx kernel/names.cmx kernel/inductive.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    kernel/declarations.cmx pretyping/inductiveops.cmi 
-pretyping/instantiate.cmo: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
-    lib/pp.cmi kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/declarations.cmi pretyping/instantiate.cmi 
-pretyping/instantiate.cmx: lib/util.cmx kernel/term.cmx kernel/sign.cmx \
-    lib/pp.cmx kernel/names.cmx pretyping/evd.cmx kernel/environ.cmx \
-    kernel/declarations.cmx pretyping/instantiate.cmi 
-pretyping/matching.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    pretyping/reductionops.cmi pretyping/rawterm.cmi pretyping/pattern.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    kernel/environ.cmi pretyping/matching.cmi 
-pretyping/matching.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    pretyping/reductionops.cmx pretyping/rawterm.cmx pretyping/pattern.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    kernel/environ.cmx pretyping/matching.cmi 
-pretyping/pattern.cmo: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \
-    lib/pp.cmi lib/options.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi library/libnames.cmi kernel/environ.cmi \
-    pretyping/pattern.cmi 
-pretyping/pattern.cmx: lib/util.cmx kernel/term.cmx pretyping/rawterm.cmx \
-    lib/pp.cmx lib/options.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx library/libnames.cmx kernel/environ.cmx \
-    pretyping/pattern.cmi 
-pretyping/pretype_errors.cmo: lib/util.cmi kernel/type_errors.cmi \
-    pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \
-    pretyping/reductionops.cmi kernel/reduction.cmi pretyping/rawterm.cmi \
-    kernel/names.cmi pretyping/inductiveops.cmi pretyping/evd.cmi \
-    kernel/environ.cmi pretyping/pretype_errors.cmi 
-pretyping/pretype_errors.cmx: lib/util.cmx kernel/type_errors.cmx \
-    pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \
-    pretyping/reductionops.cmx kernel/reduction.cmx pretyping/rawterm.cmx \
-    kernel/names.cmx pretyping/inductiveops.cmx pretyping/evd.cmx \
-    kernel/environ.cmx pretyping/pretype_errors.cmi 
-pretyping/pretyping.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 \
-    pretyping/recordops.cmi pretyping/rawterm.cmi \
-    pretyping/pretype_errors.cmi lib/pp.cmi pretyping/pattern.cmi \
-    lib/options.cmi kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    pretyping/instantiate.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
-    pretyping/indrec.cmi library/global.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi pretyping/evarconv.cmi kernel/environ.cmi \
-    lib/dyn.cmi pretyping/detyping.cmi kernel/declarations.cmi \
-    pretyping/coercion.cmi pretyping/classops.cmi pretyping/cases.cmi \
-    pretyping/pretyping.cmi 
-pretyping/pretyping.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/recordops.cmx pretyping/rawterm.cmx \
-    pretyping/pretype_errors.cmx lib/pp.cmx pretyping/pattern.cmx \
-    lib/options.cmx kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    pretyping/instantiate.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
-    pretyping/indrec.cmx library/global.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx pretyping/evarconv.cmx kernel/environ.cmx \
-    lib/dyn.cmx pretyping/detyping.cmx kernel/declarations.cmx \
-    pretyping/coercion.cmx pretyping/classops.cmx pretyping/cases.cmx \
-    pretyping/pretyping.cmi 
-pretyping/rawterm.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/sign.cmi library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    lib/dyn.cmi pretyping/rawterm.cmi 
-pretyping/rawterm.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    kernel/sign.cmx library/nametab.cmx kernel/names.cmx library/libnames.cmx \
-    lib/dyn.cmx pretyping/rawterm.cmi 
-pretyping/recordops.cmo: lib/util.cmi kernel/typeops.cmi \
-    pretyping/termops.cmi kernel/term.cmi library/summary.cmi lib/pp.cmi \
-    library/nametab.cmi kernel/names.cmi library/library.cmi \
-    library/libobject.cmi library/libnames.cmi library/lib.cmi \
-    pretyping/classops.cmi pretyping/recordops.cmi 
-pretyping/recordops.cmx: lib/util.cmx kernel/typeops.cmx \
-    pretyping/termops.cmx kernel/term.cmx library/summary.cmx lib/pp.cmx \
-    library/nametab.cmx kernel/names.cmx library/library.cmx \
-    library/libobject.cmx library/libnames.cmx library/lib.cmx \
-    pretyping/classops.cmx pretyping/recordops.cmi 
-pretyping/reductionops.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 \
-    pretyping/instantiate.cmi pretyping/evd.cmi kernel/esubst.cmi \
-    kernel/environ.cmi kernel/declarations.cmi kernel/closure.cmi \
+pretyping/inductiveops.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi kernel/inductive.cmi \
+    kernel/mod_subst.cmi kernel/names.cmi pretyping/reductionops.cmi \
+    kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi kernel/univ.cmi \
+    lib/util.cmi pretyping/inductiveops.cmi 
+pretyping/inductiveops.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx kernel/inductive.cmx \
+    kernel/mod_subst.cmx kernel/names.cmx pretyping/reductionops.cmx \
+    kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx kernel/univ.cmx \
+    lib/util.cmx pretyping/inductiveops.cmi 
+pretyping/matching.cmo: kernel/environ.cmi library/libnames.cmi \
+    library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi \
+    pretyping/rawterm.cmi pretyping/reductionops.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi pretyping/matching.cmi 
+pretyping/matching.cmx: kernel/environ.cmx library/libnames.cmx \
+    library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx \
+    pretyping/rawterm.cmx pretyping/reductionops.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx pretyping/matching.cmi 
+pretyping/pattern.cmo: kernel/environ.cmi library/libnames.cmi \
+    kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/options.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    kernel/term.cmi lib/util.cmi pretyping/pattern.cmi 
+pretyping/pattern.cmx: kernel/environ.cmx library/libnames.cmx \
+    kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/options.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    kernel/term.cmx lib/util.cmx pretyping/pattern.cmi 
+pretyping/pretype_errors.cmo: kernel/environ.cmi pretyping/evd.cmi \
+    pretyping/inductiveops.cmi kernel/names.cmi library/nametab.cmi \
+    pretyping/rawterm.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \
+    kernel/type_errors.cmi lib/util.cmi pretyping/pretype_errors.cmi 
+pretyping/pretype_errors.cmx: kernel/environ.cmx pretyping/evd.cmx \
+    pretyping/inductiveops.cmx kernel/names.cmx library/nametab.cmx \
+    pretyping/rawterm.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx \
+    kernel/type_errors.cmx lib/util.cmx pretyping/pretype_errors.cmi 
+pretyping/pretyping.cmo: pretyping/cases.cmi pretyping/classops.cmi \
+    pretyping/coercion.cmi kernel/declarations.cmi lib/dyn.cmi \
+    kernel/environ.cmi pretyping/evarconv.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \
+    pretyping/rawterm.cmi pretyping/recordops.cmi pretyping/reductionops.cmi \
+    pretyping/retyping.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi kernel/type_errors.cmi kernel/typeops.cmi \
+    lib/util.cmi pretyping/pretyping.cmi 
+pretyping/pretyping.cmx: pretyping/cases.cmx pretyping/classops.cmx \
+    pretyping/coercion.cmx kernel/declarations.cmx lib/dyn.cmx \
+    kernel/environ.cmx pretyping/evarconv.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \
+    pretyping/rawterm.cmx pretyping/recordops.cmx pretyping/reductionops.cmx \
+    pretyping/retyping.cmx kernel/sign.cmx kernel/term.cmx \
+    pretyping/termops.cmx kernel/type_errors.cmx kernel/typeops.cmx \
+    lib/util.cmx pretyping/pretyping.cmi 
+pretyping/rawterm.cmo: lib/dyn.cmi pretyping/evd.cmi library/libnames.cmi \
+    kernel/names.cmi library/nametab.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi lib/util.cmi pretyping/rawterm.cmi 
+pretyping/rawterm.cmx: lib/dyn.cmx pretyping/evd.cmx library/libnames.cmx \
+    kernel/names.cmx library/nametab.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/univ.cmx lib/util.cmx pretyping/rawterm.cmi 
+pretyping/recordops.cmo: pretyping/classops.cmi kernel/declarations.cmi \
+    kernel/environ.cmi pretyping/evd.cmi library/global.cmi \
+    pretyping/inductiveops.cmi library/lib.cmi library/libnames.cmi \
+    library/libobject.cmi library/library.cmi kernel/mod_subst.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/pp.cmi \
+    pretyping/reductionops.cmi library/summary.cmi kernel/term.cmi \
+    pretyping/termops.cmi kernel/typeops.cmi lib/util.cmi \
+    pretyping/recordops.cmi 
+pretyping/recordops.cmx: pretyping/classops.cmx kernel/declarations.cmx \
+    kernel/environ.cmx pretyping/evd.cmx library/global.cmx \
+    pretyping/inductiveops.cmx library/lib.cmx library/libnames.cmx \
+    library/libobject.cmx library/library.cmx kernel/mod_subst.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/pp.cmx \
+    pretyping/reductionops.cmx library/summary.cmx kernel/term.cmx \
+    pretyping/termops.cmx kernel/typeops.cmx lib/util.cmx \
+    pretyping/recordops.cmi 
+pretyping/reductionops.cmo: kernel/closure.cmi kernel/declarations.cmi \
+    kernel/environ.cmi kernel/esubst.cmi pretyping/evd.cmi kernel/names.cmi \
+    lib/pp.cmi kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi kernel/univ.cmi lib/util.cmi \
     pretyping/reductionops.cmi 
-pretyping/reductionops.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 \
-    pretyping/instantiate.cmx pretyping/evd.cmx kernel/esubst.cmx \
-    kernel/environ.cmx kernel/declarations.cmx kernel/closure.cmx \
+pretyping/reductionops.cmx: kernel/closure.cmx kernel/declarations.cmx \
+    kernel/environ.cmx kernel/esubst.cmx pretyping/evd.cmx kernel/names.cmx \
+    lib/pp.cmx kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx \
+    pretyping/termops.cmx kernel/univ.cmx lib/util.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/instantiate.cmi pretyping/inductiveops.cmi kernel/inductive.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/instantiate.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
-    kernel/environ.cmx kernel/declarations.cmx pretyping/retyping.cmi 
-pretyping/tacred.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \
-    kernel/term.cmi library/summary.cmi pretyping/retyping.cmi \
-    pretyping/reductionops.cmi pretyping/rawterm.cmi lib/pp.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libnames.cmi pretyping/instantiate.cmi kernel/inductive.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/declarations.cmi kernel/conv_oracle.cmi kernel/closure.cmi \
-    pretyping/cbv.cmi pretyping/tacred.cmi 
-pretyping/tacred.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
-    kernel/term.cmx library/summary.cmx pretyping/retyping.cmx \
-    pretyping/reductionops.cmx pretyping/rawterm.cmx lib/pp.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/libnames.cmx pretyping/instantiate.cmx kernel/inductive.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    kernel/declarations.cmx kernel/conv_oracle.cmx kernel/closure.cmx \
-    pretyping/cbv.cmx pretyping/tacred.cmi 
-pretyping/termops.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/sign.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi library/libnames.cmi library/lib.cmi \
-    library/global.cmi kernel/environ.cmi pretyping/termops.cmi 
-pretyping/termops.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    kernel/sign.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx library/libnames.cmx library/lib.cmx \
-    library/global.cmx kernel/environ.cmx pretyping/termops.cmi 
-pretyping/typing.cmo: lib/util.cmi kernel/typeops.cmi kernel/type_errors.cmi \
-    kernel/term.cmi pretyping/reductionops.cmi pretyping/pretype_errors.cmi \
-    kernel/names.cmi pretyping/instantiate.cmi kernel/inductive.cmi \
-    kernel/environ.cmi pretyping/typing.cmi 
-pretyping/typing.cmx: lib/util.cmx kernel/typeops.cmx kernel/type_errors.cmx \
-    kernel/term.cmx pretyping/reductionops.cmx pretyping/pretype_errors.cmx \
-    kernel/names.cmx pretyping/instantiate.cmx kernel/inductive.cmx \
-    kernel/environ.cmx pretyping/typing.cmi 
-proofs/clenv.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \
-    kernel/term.cmi proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    pretyping/retyping.cmi proofs/refiner.cmi pretyping/reductionops.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    parsing/printer.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \
-    library/nameops.cmi proofs/logic.cmi pretyping/instantiate.cmi \
-    library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
-    proofs/evar_refiner.cmi kernel/environ.cmi pretyping/coercion.cmi \
-    proofs/clenv.cmi 
-proofs/clenv.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
-    kernel/term.cmx proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx \
-    pretyping/retyping.cmx proofs/refiner.cmx pretyping/reductionops.cmx \
-    pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
-    parsing/printer.cmx lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx \
-    library/nameops.cmx proofs/logic.cmx pretyping/instantiate.cmx \
-    library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
-    proofs/evar_refiner.cmx kernel/environ.cmx pretyping/coercion.cmx \
-    proofs/clenv.cmi 
-proofs/evar_refiner.cmo: lib/util.cmi pretyping/typing.cmi \
-    kernel/type_errors.cmi kernel/term.cmi pretyping/tacred.cmi \
-    proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \
-    pretyping/reductionops.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    lib/pp.cmi lib/options.cmi kernel/names.cmi library/nameops.cmi \
-    proofs/logic.cmi pretyping/instantiate.cmi library/global.cmi \
-    pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \
-    interp/constrintern.cmi proofs/evar_refiner.cmi 
-proofs/evar_refiner.cmx: lib/util.cmx pretyping/typing.cmx \
-    kernel/type_errors.cmx kernel/term.cmx pretyping/tacred.cmx \
-    proofs/tacexpr.cmx kernel/sign.cmx proofs/refiner.cmx \
-    pretyping/reductionops.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
-    lib/pp.cmx lib/options.cmx kernel/names.cmx library/nameops.cmx \
-    proofs/logic.cmx pretyping/instantiate.cmx library/global.cmx \
-    pretyping/evd.cmx pretyping/evarutil.cmx kernel/environ.cmx \
-    interp/constrintern.cmx proofs/evar_refiner.cmi 
-proofs/logic.cmo: lib/util.cmi pretyping/typing.cmi kernel/typeops.cmi \
-    kernel/type_errors.cmi pretyping/termops.cmi kernel/term.cmi \
-    kernel/sign.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \
-    proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \
-    pretyping/pretype_errors.cmi lib/pp.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    pretyping/inductiveops.cmi kernel/inductive.cmi kernel/indtypes.cmi \
-    library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
-    kernel/environ.cmi parsing/coqast.cmi interp/constrextern.cmi \
-    proofs/logic.cmi 
-proofs/logic.cmx: lib/util.cmx pretyping/typing.cmx kernel/typeops.cmx \
-    kernel/type_errors.cmx pretyping/termops.cmx kernel/term.cmx \
-    kernel/sign.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \
-    proofs/proof_type.cmx proofs/proof_trees.cmx parsing/printer.cmx \
-    pretyping/pretype_errors.cmx lib/pp.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    pretyping/inductiveops.cmx kernel/inductive.cmx kernel/indtypes.cmx \
-    library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
-    kernel/environ.cmx parsing/coqast.cmx interp/constrextern.cmx \
-    proofs/logic.cmi 
-proofs/pfedit.cmo: lib/util.cmi pretyping/typing.cmi kernel/term.cmi \
-    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    kernel/safe_typing.cmi proofs/refiner.cmi proofs/proof_type.cmi \
-    proofs/proof_trees.cmi lib/pp.cmi kernel/names.cmi library/nameops.cmi \
-    library/lib.cmi pretyping/evd.cmi proofs/evar_refiner.cmi \
-    kernel/environ.cmi kernel/entries.cmi lib/edit.cmi \
-    kernel/declarations.cmi library/decl_kinds.cmo proofs/pfedit.cmi 
-proofs/pfedit.cmx: lib/util.cmx pretyping/typing.cmx kernel/term.cmx \
-    proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx \
-    kernel/safe_typing.cmx proofs/refiner.cmx proofs/proof_type.cmx \
-    proofs/proof_trees.cmx lib/pp.cmx kernel/names.cmx library/nameops.cmx \
-    library/lib.cmx pretyping/evd.cmx proofs/evar_refiner.cmx \
-    kernel/environ.cmx kernel/entries.cmx lib/edit.cmx \
-    kernel/declarations.cmx library/decl_kinds.cmx proofs/pfedit.cmi 
-proofs/proof_trees.cmo: lib/util.cmi pretyping/typing.cmi \
-    pretyping/termops.cmi kernel/term.cmi pretyping/tacred.cmi \
-    kernel/sign.cmi proofs/proof_type.cmi parsing/printer.cmi lib/pp.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 pretyping/detyping.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 parsing/printer.cmx lib/pp.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 pretyping/detyping.cmx \
-    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 
-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/refiner.cmo: lib/util.cmi kernel/type_errors.cmi pretyping/termops.cmi \
-    kernel/term.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    pretyping/reductionops.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    parsing/printer.cmi translate/pptacticnew.cmi parsing/pptactic.cmi \
-    lib/pp.cmi lib/options.cmi proofs/logic.cmi pretyping/instantiate.cmi \
-    library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
-    kernel/environ.cmi proofs/refiner.cmi 
-proofs/refiner.cmx: lib/util.cmx kernel/type_errors.cmx pretyping/termops.cmx \
-    kernel/term.cmx proofs/tacexpr.cmx kernel/sign.cmx \
-    pretyping/reductionops.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
-    parsing/printer.cmx translate/pptacticnew.cmx parsing/pptactic.cmx \
-    lib/pp.cmx lib/options.cmx proofs/logic.cmx pretyping/instantiate.cmx \
-    library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
-    kernel/environ.cmx proofs/refiner.cmi 
-proofs/tacexpr.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    pretyping/rawterm.cmi pretyping/pattern.cmi library/nametab.cmi \
-    kernel/names.cmi library/libnames.cmi interp/genarg.cmi lib/dyn.cmi \
-    library/decl_kinds.cmo 
-proofs/tacexpr.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
-    pretyping/rawterm.cmx pretyping/pattern.cmx library/nametab.cmx \
-    kernel/names.cmx library/libnames.cmx interp/genarg.cmx lib/dyn.cmx \
-    library/decl_kinds.cmx 
-proofs/tacmach.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \
-    kernel/term.cmi pretyping/tacred.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    proofs/refiner.cmi pretyping/reductionops.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \
-    lib/pp.cmi kernel/names.cmi library/nameops.cmi proofs/logic.cmi \
-    pretyping/instantiate.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi interp/constrintern.cmi proofs/tacmach.cmi 
-proofs/tacmach.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
-    kernel/term.cmx pretyping/tacred.cmx proofs/tacexpr.cmx kernel/sign.cmx \
-    proofs/refiner.cmx pretyping/reductionops.cmx pretyping/rawterm.cmx \
-    proofs/proof_type.cmx proofs/proof_trees.cmx parsing/printer.cmx \
-    lib/pp.cmx kernel/names.cmx library/nameops.cmx proofs/logic.cmx \
-    pretyping/instantiate.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx interp/constrintern.cmx proofs/tacmach.cmi 
-proofs/tactic_debug.cmo: pretyping/termops.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo proofs/proof_trees.cmi parsing/printer.cmi \
-    translate/pptacticnew.cmi parsing/pptactic.cmi lib/pp.cmi lib/options.cmi \
-    kernel/names.cmi proofs/logic.cmi library/global.cmi \
-    interp/constrextern.cmi parsing/ast.cmi proofs/tactic_debug.cmi 
-proofs/tactic_debug.cmx: pretyping/termops.cmx proofs/tacmach.cmx \
-    proofs/tacexpr.cmx proofs/proof_trees.cmx parsing/printer.cmx \
-    translate/pptacticnew.cmx parsing/pptactic.cmx lib/pp.cmx lib/options.cmx \
-    kernel/names.cmx proofs/logic.cmx library/global.cmx \
-    interp/constrextern.cmx parsing/ast.cmx proofs/tactic_debug.cmi 
-scripts/coqc.cmo: toplevel/usage.cmi config/coq_config.cmi 
-scripts/coqc.cmx: toplevel/usage.cmx config/coq_config.cmx 
-scripts/coqmktop.cmo: scripts/tolink.cmo config/coq_config.cmi 
-scripts/coqmktop.cmx: scripts/tolink.cmx config/coq_config.cmx 
-tactics/auto.cmo: toplevel/vernacexpr.cmo lib/util.cmi pretyping/typing.cmi \
-    pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo library/summary.cmi kernel/sign.cmi proofs/refiner.cmi \
-    kernel/reduction.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
-    parsing/printer.cmi translate/pptacticnew.cmi parsing/pptactic.cmi \
-    lib/pp.cmi proofs/pfedit.cmi pretyping/pattern.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    pretyping/matching.cmi proofs/logic.cmi library/library.cmi \
-    library/libobject.cmi library/libnames.cmi library/lib.cmi \
-    kernel/inductive.cmi tactics/hipattern.cmi tactics/hiddentac.cmi \
-    library/global.cmi interp/genarg.cmi pretyping/evd.cmi \
-    proofs/evar_refiner.cmi tactics/dhyp.cmi kernel/declarations.cmi \
-    interp/constrintern.cmi proofs/clenv.cmi tactics/btermdn.cmi \
-    tactics/auto.cmi 
-tactics/auto.cmx: toplevel/vernacexpr.cmx lib/util.cmx pretyping/typing.cmx \
-    pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx pretyping/tacred.cmx proofs/tacmach.cmx \
-    proofs/tacexpr.cmx library/summary.cmx kernel/sign.cmx proofs/refiner.cmx \
-    kernel/reduction.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
-    parsing/printer.cmx translate/pptacticnew.cmx parsing/pptactic.cmx \
-    lib/pp.cmx proofs/pfedit.cmx pretyping/pattern.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    pretyping/matching.cmx proofs/logic.cmx library/library.cmx \
-    library/libobject.cmx library/libnames.cmx library/lib.cmx \
-    kernel/inductive.cmx tactics/hipattern.cmx tactics/hiddentac.cmx \
-    library/global.cmx interp/genarg.cmx pretyping/evd.cmx \
-    proofs/evar_refiner.cmx tactics/dhyp.cmx kernel/declarations.cmx \
-    interp/constrintern.cmx proofs/clenv.cmx tactics/btermdn.cmx \
-    tactics/auto.cmi 
-tactics/autorewrite.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 \
-    proofs/proof_type.cmi lib/pp.cmi kernel/names.cmi library/libobject.cmi \
-    library/lib.cmi tactics/hipattern.cmi tactics/equality.cmi \
-    parsing/coqast.cmi parsing/ast.cmi tactics/autorewrite.cmi 
-tactics/autorewrite.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 \
-    proofs/proof_type.cmx lib/pp.cmx kernel/names.cmx library/libobject.cmx \
-    library/lib.cmx tactics/hipattern.cmx tactics/equality.cmx \
-    parsing/coqast.cmx parsing/ast.cmx tactics/autorewrite.cmi 
-tactics/btermdn.cmo: tactics/termdn.cmi kernel/term.cmi pretyping/pattern.cmi \
-    tactics/dn.cmi tactics/btermdn.cmi 
-tactics/btermdn.cmx: tactics/termdn.cmx kernel/term.cmx pretyping/pattern.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/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/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 \
-    pretyping/rawterm.cmi proofs/proof_type.cmi lib/pp.cmi parsing/pcoq.cmi \
-    pretyping/pattern.cmi tactics/nbtermdn.cmi kernel/names.cmi \
-    pretyping/matching.cmi library/library.cmi library/libobject.cmi \
-    library/libnames.cmi library/lib.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi interp/constrintern.cmi proofs/clenv.cmi \
-    parsing/ast.cmi tactics/dhyp.cmi 
-tactics/dhyp.cmx: lib/util.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx proofs/tacmach.cmx proofs/tacexpr.cmx \
-    library/summary.cmx proofs/refiner.cmx kernel/reduction.cmx \
-    pretyping/rawterm.cmx proofs/proof_type.cmx lib/pp.cmx parsing/pcoq.cmx \
-    pretyping/pattern.cmx tactics/nbtermdn.cmx kernel/names.cmx \
-    pretyping/matching.cmx library/library.cmx library/libobject.cmx \
-    library/libnames.cmx library/lib.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx interp/constrintern.cmx proofs/clenv.cmx \
-    parsing/ast.cmx tactics/dhyp.cmi 
+pretyping/retyping.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \
+    kernel/names.cmi pretyping/reductionops.cmi kernel/term.cmi \
+    kernel/typeops.cmi kernel/univ.cmi lib/util.cmi pretyping/retyping.cmi 
+pretyping/retyping.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    pretyping/evd.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \
+    kernel/names.cmx pretyping/reductionops.cmx kernel/term.cmx \
+    kernel/typeops.cmx kernel/univ.cmx lib/util.cmx pretyping/retyping.cmi 
+pretyping/tacred.cmo: pretyping/cbv.cmi kernel/closure.cmi \
+    kernel/conv_oracle.cmi kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi kernel/inductive.cmi library/libnames.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/pp.cmi \
+    pretyping/rawterm.cmi pretyping/reductionops.cmi pretyping/retyping.cmi \
+    library/summary.cmi kernel/term.cmi pretyping/termops.cmi \
+    kernel/type_errors.cmi pretyping/typing.cmi lib/util.cmi \
+    pretyping/tacred.cmi 
+pretyping/tacred.cmx: pretyping/cbv.cmx kernel/closure.cmx \
+    kernel/conv_oracle.cmx kernel/declarations.cmx kernel/environ.cmx \
+    pretyping/evd.cmx kernel/inductive.cmx library/libnames.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/pp.cmx \
+    pretyping/rawterm.cmx pretyping/reductionops.cmx pretyping/retyping.cmx \
+    library/summary.cmx kernel/term.cmx pretyping/termops.cmx \
+    kernel/type_errors.cmx pretyping/typing.cmx lib/util.cmx \
+    pretyping/tacred.cmi 
+pretyping/termops.cmo: kernel/environ.cmi library/global.cmi library/lib.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/univ.cmi lib/util.cmi pretyping/termops.cmi 
+pretyping/termops.cmx: kernel/environ.cmx library/global.cmx library/lib.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/univ.cmx lib/util.cmx pretyping/termops.cmi 
+pretyping/typing.cmo: kernel/environ.cmi pretyping/evd.cmi \
+    kernel/inductive.cmi pretyping/inductiveops.cmi kernel/names.cmi \
+    pretyping/pretype_errors.cmi pretyping/reductionops.cmi kernel/term.cmi \
+    kernel/type_errors.cmi kernel/typeops.cmi lib/util.cmi \
+    pretyping/typing.cmi 
+pretyping/typing.cmx: kernel/environ.cmx pretyping/evd.cmx \
+    kernel/inductive.cmx pretyping/inductiveops.cmx kernel/names.cmx \
+    pretyping/pretype_errors.cmx pretyping/reductionops.cmx kernel/term.cmx \
+    kernel/type_errors.cmx kernel/typeops.cmx lib/util.cmx \
+    pretyping/typing.cmi 
+pretyping/unification.cmo: kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi library/global.cmi library/nameops.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi pretyping/pretype_errors.cmi \
+    pretyping/rawterm.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    pretyping/retyping.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \
+    pretyping/unification.cmi 
+pretyping/unification.cmx: kernel/environ.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx library/global.cmx library/nameops.cmx kernel/names.cmx \
+    pretyping/pattern.cmx lib/pp.cmx pretyping/pretype_errors.cmx \
+    pretyping/rawterm.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    pretyping/retyping.cmx kernel/sign.cmx kernel/term.cmx \
+    pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \
+    pretyping/unification.cmi 
+proofs/clenvtac.cmo: pretyping/clenv.cmi kernel/environ.cmi \
+    proofs/evar_refiner.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    proofs/logic.cmi library/nameops.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \
+    pretyping/reductionops.cmi proofs/refiner.cmi kernel/sign.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \
+    pretyping/termops.cmi pretyping/typing.cmi pretyping/unification.cmi \
+    lib/util.cmi proofs/clenvtac.cmi 
+proofs/clenvtac.cmx: pretyping/clenv.cmx kernel/environ.cmx \
+    proofs/evar_refiner.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    proofs/logic.cmx library/nameops.cmx kernel/names.cmx \
+    pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \
+    pretyping/reductionops.cmx proofs/refiner.cmx kernel/sign.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx kernel/term.cmx \
+    pretyping/termops.cmx pretyping/typing.cmx pretyping/unification.cmx \
+    lib/util.cmx proofs/clenvtac.cmi 
+proofs/evar_refiner.cmo: interp/constrintern.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi kernel/names.cmi pretyping/pretyping.cmi \
+    proofs/proof_trees.cmi proofs/refiner.cmi kernel/sign.cmi kernel/term.cmi \
+    lib/util.cmi proofs/evar_refiner.cmi 
+proofs/evar_refiner.cmx: interp/constrintern.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx kernel/names.cmx pretyping/pretyping.cmx \
+    proofs/proof_trees.cmx proofs/refiner.cmx kernel/sign.cmx kernel/term.cmx \
+    lib/util.cmx proofs/evar_refiner.cmi 
+proofs/logic.cmo: kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    library/global.cmi pretyping/indrec.cmi kernel/inductive.cmi \
+    pretyping/inductiveops.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/options.cmi lib/pp.cmi \
+    pretyping/pretype_errors.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \
+    pretyping/reductionops.cmi pretyping/retyping.cmi kernel/sign.cmi \
+    kernel/term.cmi pretyping/termops.cmi kernel/type_errors.cmi \
+    kernel/typeops.cmi pretyping/typing.cmi lib/util.cmi proofs/logic.cmi 
+proofs/logic.cmx: kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    library/global.cmx pretyping/indrec.cmx kernel/inductive.cmx \
+    pretyping/inductiveops.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/options.cmx lib/pp.cmx \
+    pretyping/pretype_errors.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \
+    pretyping/reductionops.cmx pretyping/retyping.cmx kernel/sign.cmx \
+    kernel/term.cmx pretyping/termops.cmx kernel/type_errors.cmx \
+    kernel/typeops.cmx pretyping/typing.cmx lib/util.cmx proofs/logic.cmi 
+proofs/pfedit.cmo: library/decl_kinds.cmo kernel/declarations.cmi \
+    lib/edit.cmi kernel/entries.cmi kernel/environ.cmi \
+    proofs/evar_refiner.cmi pretyping/evd.cmi library/lib.cmi \
+    library/nameops.cmi kernel/names.cmi lib/pp.cmi proofs/proof_trees.cmi \
+    proofs/proof_type.cmi proofs/refiner.cmi kernel/safe_typing.cmi \
+    kernel/sign.cmi proofs/tacexpr.cmo kernel/term.cmi pretyping/typing.cmi \
+    lib/util.cmi proofs/pfedit.cmi 
+proofs/pfedit.cmx: library/decl_kinds.cmx kernel/declarations.cmx \
+    lib/edit.cmx kernel/entries.cmx kernel/environ.cmx \
+    proofs/evar_refiner.cmx pretyping/evd.cmx library/lib.cmx \
+    library/nameops.cmx kernel/names.cmx lib/pp.cmx proofs/proof_trees.cmx \
+    proofs/proof_type.cmx proofs/refiner.cmx kernel/safe_typing.cmx \
+    kernel/sign.cmx proofs/tacexpr.cmx kernel/term.cmx pretyping/typing.cmx \
+    lib/util.cmx proofs/pfedit.cmi 
+proofs/proof_trees.cmo: kernel/closure.cmi pretyping/detyping.cmi \
+    kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi proofs/proof_type.cmi kernel/sign.cmi \
+    pretyping/tacred.cmi kernel/term.cmi pretyping/termops.cmi \
+    pretyping/typing.cmi lib/util.cmi proofs/proof_trees.cmi 
+proofs/proof_trees.cmx: kernel/closure.cmx pretyping/detyping.cmx \
+    kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx proofs/proof_type.cmx kernel/sign.cmx \
+    pretyping/tacred.cmx kernel/term.cmx pretyping/termops.cmx \
+    pretyping/typing.cmx lib/util.cmx proofs/proof_trees.cmi 
+proofs/proof_type.cmo: kernel/environ.cmi pretyping/evd.cmi interp/genarg.cmi \
+    library/libnames.cmi kernel/names.cmi library/nametab.cmi \
+    pretyping/pattern.cmi pretyping/rawterm.cmi proofs/tacexpr.cmo \
+    kernel/term.cmi lib/util.cmi proofs/proof_type.cmi 
+proofs/proof_type.cmx: kernel/environ.cmx pretyping/evd.cmx interp/genarg.cmx \
+    library/libnames.cmx kernel/names.cmx library/nametab.cmx \
+    pretyping/pattern.cmx pretyping/rawterm.cmx proofs/tacexpr.cmx \
+    kernel/term.cmx lib/util.cmx proofs/proof_type.cmi 
+proofs/redexpr.cmo: kernel/closure.cmi kernel/conv_oracle.cmi \
+    kernel/csymtable.cmi kernel/declarations.cmi kernel/environ.cmi \
+    library/global.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    pretyping/reductionops.cmi library/summary.cmi pretyping/tacred.cmi \
+    kernel/term.cmi kernel/typeops.cmi lib/util.cmi kernel/vconv.cmi \
+    proofs/redexpr.cmi 
+proofs/redexpr.cmx: kernel/closure.cmx kernel/conv_oracle.cmx \
+    kernel/csymtable.cmx kernel/declarations.cmx kernel/environ.cmx \
+    library/global.cmx library/libnames.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    pretyping/reductionops.cmx library/summary.cmx pretyping/tacred.cmx \
+    kernel/term.cmx kernel/typeops.cmx lib/util.cmx kernel/vconv.cmx \
+    proofs/redexpr.cmi 
+proofs/refiner.cmo: kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi library/global.cmi proofs/logic.cmi lib/pp.cmi \
+    proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/reductionops.cmi \
+    kernel/sign.cmi proofs/tacexpr.cmo kernel/term.cmi pretyping/termops.cmi \
+    kernel/type_errors.cmi lib/util.cmi proofs/refiner.cmi 
+proofs/refiner.cmx: kernel/environ.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx library/global.cmx proofs/logic.cmx lib/pp.cmx \
+    proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/reductionops.cmx \
+    kernel/sign.cmx proofs/tacexpr.cmx kernel/term.cmx pretyping/termops.cmx \
+    kernel/type_errors.cmx lib/util.cmx proofs/refiner.cmi 
+proofs/tacexpr.cmo: library/decl_kinds.cmo lib/dyn.cmi interp/genarg.cmi \
+    library/libnames.cmi kernel/names.cmi library/nametab.cmi \
+    pretyping/pattern.cmi pretyping/rawterm.cmi kernel/term.cmi \
+    interp/topconstr.cmi lib/util.cmi 
+proofs/tacexpr.cmx: library/decl_kinds.cmx lib/dyn.cmx interp/genarg.cmx \
+    library/libnames.cmx kernel/names.cmx library/nametab.cmx \
+    pretyping/pattern.cmx pretyping/rawterm.cmx kernel/term.cmx \
+    interp/topconstr.cmx lib/util.cmx 
+proofs/tacmach.cmo: interp/constrintern.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi proofs/logic.cmi library/nameops.cmi \
+    kernel/names.cmi lib/pp.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi proofs/redexpr.cmi pretyping/reductionops.cmi \
+    proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo \
+    pretyping/tacred.cmi kernel/term.cmi pretyping/termops.cmi \
+    pretyping/typing.cmi lib/util.cmi proofs/tacmach.cmi 
+proofs/tacmach.cmx: interp/constrintern.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx proofs/logic.cmx library/nameops.cmx \
+    kernel/names.cmx lib/pp.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \
+    pretyping/rawterm.cmx proofs/redexpr.cmx pretyping/reductionops.cmx \
+    proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx \
+    pretyping/tacred.cmx kernel/term.cmx pretyping/termops.cmx \
+    pretyping/typing.cmx lib/util.cmx proofs/tacmach.cmi 
+proofs/tactic_debug.cmo: interp/constrextern.cmi proofs/logic.cmi \
+    kernel/names.cmi lib/pp.cmi proofs/proof_trees.cmi proofs/refiner.cmi \
+    proofs/tacexpr.cmo pretyping/termops.cmi proofs/tactic_debug.cmi 
+proofs/tactic_debug.cmx: interp/constrextern.cmx proofs/logic.cmx \
+    kernel/names.cmx lib/pp.cmx proofs/proof_trees.cmx proofs/refiner.cmx \
+    proofs/tacexpr.cmx pretyping/termops.cmx proofs/tactic_debug.cmi 
+scripts/coqc.cmo: config/coq_config.cmi toplevel/usage.cmi 
+scripts/coqc.cmx: config/coq_config.cmx toplevel/usage.cmx 
+scripts/coqmktop.cmo: config/coq_config.cmi scripts/tolink.cmo 
+scripts/coqmktop.cmx: config/coq_config.cmx scripts/tolink.cmx 
+tactics/auto.cmo: tactics/btermdn.cmi pretyping/clenv.cmi \
+    interp/constrintern.cmi kernel/declarations.cmi tactics/dhyp.cmi \
+    kernel/environ.cmi proofs/evar_refiner.cmi pretyping/evd.cmi \
+    interp/genarg.cmi library/global.cmi lib/gmap.cmi tactics/hiddentac.cmi \
+    tactics/hipattern.cmi kernel/inductive.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi library/library.cmi \
+    proofs/logic.cmi pretyping/matching.cmi kernel/mod_subst.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    pretyping/pattern.cmi proofs/pfedit.cmi lib/pp.cmi parsing/pptactic.cmi \
+    parsing/printer.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    kernel/reduction.cmi proofs/refiner.cmi kernel/sign.cmi \
+    library/summary.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \
+    pretyping/tacred.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo tactics/auto.cmi 
+tactics/auto.cmx: tactics/btermdn.cmx pretyping/clenv.cmx \
+    interp/constrintern.cmx kernel/declarations.cmx tactics/dhyp.cmx \
+    kernel/environ.cmx proofs/evar_refiner.cmx pretyping/evd.cmx \
+    interp/genarg.cmx library/global.cmx lib/gmap.cmx tactics/hiddentac.cmx \
+    tactics/hipattern.cmx kernel/inductive.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx library/library.cmx \
+    proofs/logic.cmx pretyping/matching.cmx kernel/mod_subst.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    pretyping/pattern.cmx proofs/pfedit.cmx lib/pp.cmx parsing/pptactic.cmx \
+    parsing/printer.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \
+    kernel/reduction.cmx proofs/refiner.cmx kernel/sign.cmx \
+    library/summary.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \
+    pretyping/tacred.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx tactics/auto.cmi 
+tactics/autorewrite.cmo: kernel/environ.cmi tactics/equality.cmi \
+    pretyping/evd.cmi library/global.cmi tactics/hipattern.cmi \
+    library/lib.cmi library/libobject.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \
+    proofs/proof_type.cmi library/summary.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/typing.cmi lib/util.cmi \
+    toplevel/vernacinterp.cmi tactics/autorewrite.cmi 
+tactics/autorewrite.cmx: kernel/environ.cmx tactics/equality.cmx \
+    pretyping/evd.cmx library/global.cmx tactics/hipattern.cmx \
+    library/lib.cmx library/libobject.cmx kernel/mod_subst.cmx \
+    kernel/names.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \
+    proofs/proof_type.cmx library/summary.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/typing.cmx lib/util.cmx \
+    toplevel/vernacinterp.cmx tactics/autorewrite.cmi 
+tactics/btermdn.cmo: tactics/dn.cmi library/libnames.cmi \
+    pretyping/pattern.cmi kernel/term.cmi tactics/termdn.cmi \
+    tactics/btermdn.cmi 
+tactics/btermdn.cmx: tactics/dn.cmx library/libnames.cmx \
+    pretyping/pattern.cmx kernel/term.cmx tactics/termdn.cmx \
+    tactics/btermdn.cmi 
+tactics/contradiction.cmo: interp/coqlib.cmi tactics/hipattern.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \
+    proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi lib/util.cmi tactics/contradiction.cmi 
+tactics/contradiction.cmx: interp/coqlib.cmx tactics/hipattern.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \
+    proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx lib/util.cmx tactics/contradiction.cmi 
+tactics/dhyp.cmo: pretyping/clenv.cmi interp/constrintern.cmi \
+    kernel/environ.cmi pretyping/evd.cmi library/global.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi library/library.cmi \
+    pretyping/matching.cmi kernel/names.cmi tactics/nbtermdn.cmi \
+    pretyping/pattern.cmi parsing/pcoq.cmi lib/pp.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi kernel/reduction.cmi proofs/refiner.cmi \
+    library/summary.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi \
+    tactics/dhyp.cmi 
+tactics/dhyp.cmx: pretyping/clenv.cmx interp/constrintern.cmx \
+    kernel/environ.cmx pretyping/evd.cmx library/global.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx library/library.cmx \
+    pretyping/matching.cmx kernel/names.cmx tactics/nbtermdn.cmx \
+    pretyping/pattern.cmx parsing/pcoq.cmx lib/pp.cmx proofs/proof_type.cmx \
+    pretyping/rawterm.cmx kernel/reduction.cmx proofs/refiner.cmx \
+    library/summary.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx lib/util.cmx \
+    tactics/dhyp.cmi 
 tactics/dn.cmo: lib/tlm.cmi tactics/dn.cmi 
 tactics/dn.cmx: lib/tlm.cmx tactics/dn.cmi 
-tactics/eauto.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
-    tactics/tacinterp.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    proofs/refiner.cmi kernel/reduction.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi proofs/proof_trees.cmi parsing/pptactic.cmi \
-    lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi lib/options.cmi \
-    kernel/names.cmi library/nameops.cmi proofs/logic.cmi library/global.cmi \
-    interp/genarg.cmi parsing/extend.cmi lib/explore.cmi \
-    proofs/evar_refiner.cmi parsing/egrammar.cmi kernel/declarations.cmi \
-    proofs/clenv.cmi toplevel/cerrors.cmi tactics/auto.cmi tactics/eauto.cmi 
-tactics/eauto.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
-    tactics/tacinterp.cmx proofs/tacexpr.cmx kernel/sign.cmx \
-    proofs/refiner.cmx kernel/reduction.cmx pretyping/rawterm.cmx \
-    proofs/proof_type.cmx proofs/proof_trees.cmx parsing/pptactic.cmx \
-    lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx lib/options.cmx \
-    kernel/names.cmx library/nameops.cmx proofs/logic.cmx library/global.cmx \
-    interp/genarg.cmx parsing/extend.cmx lib/explore.cmx \
-    proofs/evar_refiner.cmx parsing/egrammar.cmx kernel/declarations.cmx \
-    proofs/clenv.cmx toplevel/cerrors.cmx tactics/auto.cmx tactics/eauto.cmi 
-tactics/elim.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo proofs/refiner.cmi kernel/reduction.cmi \
-    proofs/proof_type.cmi parsing/printer.cmi lib/pp.cmi kernel/names.cmi \
-    library/libnames.cmi pretyping/inductiveops.cmi tactics/hipattern.cmi \
-    tactics/hiddentac.cmi interp/genarg.cmi kernel/environ.cmi \
-    proofs/clenv.cmi tactics/elim.cmi 
-tactics/elim.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
-    proofs/tacexpr.cmx proofs/refiner.cmx kernel/reduction.cmx \
-    proofs/proof_type.cmx parsing/printer.cmx lib/pp.cmx kernel/names.cmx \
-    library/libnames.cmx pretyping/inductiveops.cmx tactics/hipattern.cmx \
-    tactics/hiddentac.cmx interp/genarg.cmx kernel/environ.cmx \
-    proofs/clenv.cmx tactics/elim.cmi 
-tactics/eqdecide.cmo: lib/util.cmi kernel/term.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 proofs/proof_trees.cmi parsing/pptactic.cmi \
-    lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi lib/options.cmi \
-    kernel/names.cmi library/nameops.cmi pretyping/matching.cmi \
-    tactics/hipattern.cmi tactics/hiddentac.cmi library/global.cmi \
-    interp/genarg.cmi tactics/extratactics.cmi tactics/equality.cmi \
-    parsing/egrammar.cmi kernel/declarations.cmi interp/coqlib.cmi \
-    toplevel/cerrors.cmi tactics/auto.cmi 
-tactics/eqdecide.cmx: lib/util.cmx kernel/term.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 proofs/proof_trees.cmx parsing/pptactic.cmx \
-    lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx lib/options.cmx \
-    kernel/names.cmx library/nameops.cmx pretyping/matching.cmx \
-    tactics/hipattern.cmx tactics/hiddentac.cmx library/global.cmx \
-    interp/genarg.cmx tactics/extratactics.cmx tactics/equality.cmx \
-    parsing/egrammar.cmx kernel/declarations.cmx interp/coqlib.cmx \
-    toplevel/cerrors.cmx tactics/auto.cmx 
-tactics/equality.cmo: toplevel/vernacexpr.cmo lib/util.cmi kernel/univ.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 proofs/tacexpr.cmo \
-    kernel/sign.cmi tactics/setoid_replace.cmi pretyping/retyping.cmi \
-    pretyping/reductionops.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
-    lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \
-    pretyping/matching.cmi proofs/logic.cmi library/libnames.cmi \
-    pretyping/instantiate.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
-    pretyping/indrec.cmi tactics/hipattern.cmi pretyping/evarutil.cmi \
-    pretyping/evarconv.cmi proofs/evar_refiner.cmi kernel/environ.cmi \
-    kernel/declarations.cmi interp/coqlib.cmi proofs/clenv.cmi \
-    tactics/equality.cmi 
-tactics/equality.cmx: toplevel/vernacexpr.cmx lib/util.cmx kernel/univ.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 proofs/tacexpr.cmx \
-    kernel/sign.cmx tactics/setoid_replace.cmx pretyping/retyping.cmx \
-    pretyping/reductionops.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
-    lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \
-    pretyping/matching.cmx proofs/logic.cmx library/libnames.cmx \
-    pretyping/instantiate.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
-    pretyping/indrec.cmx tactics/hipattern.cmx pretyping/evarutil.cmx \
-    pretyping/evarconv.cmx proofs/evar_refiner.cmx kernel/environ.cmx \
-    kernel/declarations.cmx interp/coqlib.cmx proofs/clenv.cmx \
-    tactics/equality.cmi 
-tactics/extraargs.cmo: tactics/tacinterp.cmi parsing/pptactic.cmi lib/pp.cmi \
-    parsing/pcoq.cmi toplevel/metasyntax.cmi interp/genarg.cmi \
-    parsing/extend.cmi tactics/extraargs.cmi 
-tactics/extraargs.cmx: tactics/tacinterp.cmx parsing/pptactic.cmx lib/pp.cmx \
-    parsing/pcoq.cmx toplevel/metasyntax.cmx interp/genarg.cmx \
-    parsing/extend.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 lib/pp.cmi parsing/pcoq.cmi \
-    lib/options.cmi library/nametab.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/equality.cmi parsing/egrammar.cmi \
-    tactics/contradiction.cmi interp/constrintern.cmi toplevel/cerrors.cmi \
-    tactics/autorewrite.cmi tactics/extratactics.cmi 
-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 lib/pp.cmx parsing/pcoq.cmx \
-    lib/options.cmx library/nametab.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/equality.cmx parsing/egrammar.cmx \
-    tactics/contradiction.cmx interp/constrintern.cmx toplevel/cerrors.cmx \
-    tactics/autorewrite.cmx tactics/extratactics.cmi 
-tactics/hiddentac.cmo: lib/util.cmi kernel/term.cmi tactics/tactics.cmi \
-    proofs/tacmach.cmi proofs/tacexpr.cmo proofs/refiner.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi interp/genarg.cmi \
-    proofs/evar_refiner.cmi tactics/hiddentac.cmi 
-tactics/hiddentac.cmx: lib/util.cmx kernel/term.cmx tactics/tactics.cmx \
-    proofs/tacmach.cmx proofs/tacexpr.cmx proofs/refiner.cmx \
-    pretyping/rawterm.cmx proofs/proof_type.cmx interp/genarg.cmx \
-    proofs/evar_refiner.cmx tactics/hiddentac.cmi 
-tactics/hipattern.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tacticals.cmi proofs/tacmach.cmi pretyping/reductionops.cmi \
-    proofs/proof_trees.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \
-    library/nameops.cmi pretyping/matching.cmi pretyping/inductiveops.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/declarations.cmi interp/coqlib.cmi proofs/clenv.cmi \
+tactics/eauto.cmo: tactics/auto.cmi toplevel/cerrors.cmi pretyping/clenv.cmi \
+    proofs/clenvtac.cmi kernel/declarations.cmi parsing/egrammar.cmi \
+    proofs/evar_refiner.cmi lib/explore.cmi interp/genarg.cmi \
+    library/global.cmi parsing/lexer.cmi proofs/logic.cmi library/nameops.cmi \
+    kernel/names.cmi pretyping/pattern.cmi parsing/pcoq.cmi lib/pp.cmi \
+    parsing/pptactic.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi kernel/reduction.cmi proofs/refiner.cmi \
+    kernel/sign.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \
+    proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi tactics/eauto.cmi 
+tactics/eauto.cmx: tactics/auto.cmx toplevel/cerrors.cmx pretyping/clenv.cmx \
+    proofs/clenvtac.cmx kernel/declarations.cmx parsing/egrammar.cmx \
+    proofs/evar_refiner.cmx lib/explore.cmx interp/genarg.cmx \
+    library/global.cmx parsing/lexer.cmx proofs/logic.cmx library/nameops.cmx \
+    kernel/names.cmx pretyping/pattern.cmx parsing/pcoq.cmx lib/pp.cmx \
+    parsing/pptactic.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \
+    pretyping/rawterm.cmx kernel/reduction.cmx proofs/refiner.cmx \
+    kernel/sign.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \
+    proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.cmx tactics/eauto.cmi 
+tactics/elim.cmo: pretyping/clenv.cmi kernel/environ.cmi interp/genarg.cmi \
+    tactics/hiddentac.cmi tactics/hipattern.cmi pretyping/inductiveops.cmi \
+    library/libnames.cmi kernel/names.cmi lib/pp.cmi parsing/printer.cmi \
+    proofs/proof_type.cmi kernel/reduction.cmi proofs/refiner.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
+    tactics/elim.cmi 
+tactics/elim.cmx: pretyping/clenv.cmx kernel/environ.cmx interp/genarg.cmx \
+    tactics/hiddentac.cmx tactics/hipattern.cmx pretyping/inductiveops.cmx \
+    library/libnames.cmx kernel/names.cmx lib/pp.cmx parsing/printer.cmx \
+    proofs/proof_type.cmx kernel/reduction.cmx proofs/refiner.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
+    tactics/elim.cmi 
+tactics/eqdecide.cmo: tactics/auto.cmi toplevel/cerrors.cmi interp/coqlib.cmi \
+    kernel/declarations.cmi parsing/egrammar.cmi tactics/equality.cmi \
+    tactics/extratactics.cmi interp/genarg.cmi library/global.cmi \
+    tactics/hiddentac.cmi tactics/hipattern.cmi pretyping/matching.cmi \
+    library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi \
+    parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi proofs/proof_trees.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi proofs/refiner.cmi \
+    proofs/tacexpr.cmo tactics/tacinterp.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi 
+tactics/eqdecide.cmx: tactics/auto.cmx toplevel/cerrors.cmx interp/coqlib.cmx \
+    kernel/declarations.cmx parsing/egrammar.cmx tactics/equality.cmx \
+    tactics/extratactics.cmx interp/genarg.cmx library/global.cmx \
+    tactics/hiddentac.cmx tactics/hipattern.cmx pretyping/matching.cmx \
+    library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx \
+    parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx proofs/proof_trees.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \
+    proofs/tacexpr.cmx tactics/tacinterp.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx lib/util.cmx 
+tactics/equality.cmo: interp/coqlib.cmi kernel/declarations.cmi \
+    kernel/environ.cmi proofs/evar_refiner.cmi pretyping/evarconv.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi tactics/hipattern.cmi \
+    pretyping/indrec.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \
+    library/libnames.cmi proofs/logic.cmi pretyping/matching.cmi \
+    library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \
+    pretyping/retyping.cmi tactics/setoid_replace.cmi kernel/sign.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi pretyping/tacred.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi kernel/typeops.cmi pretyping/typing.cmi \
+    kernel/univ.cmi lib/util.cmi toplevel/vernacexpr.cmo tactics/equality.cmi 
+tactics/equality.cmx: interp/coqlib.cmx kernel/declarations.cmx \
+    kernel/environ.cmx proofs/evar_refiner.cmx pretyping/evarconv.cmx \
+    pretyping/evarutil.cmx pretyping/evd.cmx tactics/hipattern.cmx \
+    pretyping/indrec.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \
+    library/libnames.cmx proofs/logic.cmx pretyping/matching.cmx \
+    library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \
+    pretyping/retyping.cmx tactics/setoid_replace.cmx kernel/sign.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx pretyping/tacred.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx kernel/typeops.cmx pretyping/typing.cmx \
+    kernel/univ.cmx lib/util.cmx toplevel/vernacexpr.cmx tactics/equality.cmi 
+tactics/evar_tactics.cmo: kernel/environ.cmi proofs/evar_refiner.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi proofs/proof_type.cmi \
+    proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
+    tactics/evar_tactics.cmi 
+tactics/evar_tactics.cmx: kernel/environ.cmx proofs/evar_refiner.cmx \
+    pretyping/evarutil.cmx pretyping/evd.cmx proofs/proof_type.cmx \
+    proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
+    tactics/evar_tactics.cmi 
+tactics/extraargs.cmo: interp/genarg.cmi parsing/lexer.cmi \
+    toplevel/metasyntax.cmi library/nameops.cmi kernel/names.cmi \
+    parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \
+    tactics/setoid_replace.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \
+    lib/util.cmi tactics/extraargs.cmi 
+tactics/extraargs.cmx: interp/genarg.cmx parsing/lexer.cmx \
+    toplevel/metasyntax.cmx library/nameops.cmx kernel/names.cmx \
+    parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \
+    tactics/setoid_replace.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \
+    lib/util.cmx tactics/extraargs.cmi 
+tactics/extratactics.cmo: tactics/autorewrite.cmi toplevel/cerrors.cmi \
+    interp/constrintern.cmi tactics/contradiction.cmi parsing/egrammar.cmi \
+    tactics/equality.cmi tactics/evar_tactics.cmi pretyping/evd.cmi \
+    tactics/extraargs.cmi interp/genarg.cmi library/global.cmi \
+    tactics/inv.cmi tactics/leminv.cmi parsing/lexer.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    pretyping/rawterm.cmi tactics/refine.cmi proofs/refiner.cmi \
+    tactics/setoid_replace.cmi library/summary.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi lib/util.cmi toplevel/vernacinterp.cmi \
+    tactics/extratactics.cmi 
+tactics/extratactics.cmx: tactics/autorewrite.cmx toplevel/cerrors.cmx \
+    interp/constrintern.cmx tactics/contradiction.cmx parsing/egrammar.cmx \
+    tactics/equality.cmx tactics/evar_tactics.cmx pretyping/evd.cmx \
+    tactics/extraargs.cmx interp/genarg.cmx library/global.cmx \
+    tactics/inv.cmx tactics/leminv.cmx parsing/lexer.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx kernel/mod_subst.cmx \
+    kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    pretyping/rawterm.cmx tactics/refine.cmx proofs/refiner.cmx \
+    tactics/setoid_replace.cmx library/summary.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx lib/util.cmx toplevel/vernacinterp.cmx \
+    tactics/extratactics.cmi 
+tactics/hiddentac.cmo: tactics/evar_tactics.cmi interp/genarg.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi proofs/refiner.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tactics.cmi kernel/term.cmi \
+    lib/util.cmi tactics/hiddentac.cmi 
+tactics/hiddentac.cmx: tactics/evar_tactics.cmx interp/genarg.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tactics.cmx kernel/term.cmx \
+    lib/util.cmx tactics/hiddentac.cmi 
+tactics/hipattern.cmo: pretyping/clenv.cmi interp/coqlib.cmi \
+    kernel/declarations.cmi kernel/environ.cmi pretyping/evd.cmi \
+    library/global.cmi pretyping/inductiveops.cmi library/libnames.cmi \
+    pretyping/matching.cmi library/nameops.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \
+    pretyping/rawterm.cmi pretyping/reductionops.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
     tactics/hipattern.cmi 
-tactics/hipattern.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tacticals.cmx proofs/tacmach.cmx pretyping/reductionops.cmx \
-    proofs/proof_trees.cmx lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx \
-    library/nameops.cmx pretyping/matching.cmx pretyping/inductiveops.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    kernel/declarations.cmx interp/coqlib.cmx proofs/clenv.cmx \
+tactics/hipattern.cmx: pretyping/clenv.cmx interp/coqlib.cmx \
+    kernel/declarations.cmx kernel/environ.cmx pretyping/evd.cmx \
+    library/global.cmx pretyping/inductiveops.cmx library/libnames.cmx \
+    pretyping/matching.cmx library/nameops.cmx kernel/names.cmx \
+    pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \
+    pretyping/rawterm.cmx pretyping/reductionops.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
     tactics/hipattern.cmi 
-tactics/inv.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \
-    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
-    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi parsing/printer.cmi \
-    lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi library/nameops.cmi \
-    pretyping/matching.cmi pretyping/inductiveops.cmi tactics/hipattern.cmi \
-    library/global.cmi interp/genarg.cmi proofs/evar_refiner.cmi \
-    tactics/equality.cmi kernel/environ.cmi tactics/elim.cmi \
-    interp/coqlib.cmi proofs/clenv.cmi tactics/inv.cmi 
-tactics/inv.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
-    kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
-    proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx \
-    pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \
-    pretyping/rawterm.cmx proofs/proof_type.cmx parsing/printer.cmx \
-    lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \
-    pretyping/matching.cmx pretyping/inductiveops.cmx tactics/hipattern.cmx \
-    library/global.cmx interp/genarg.cmx proofs/evar_refiner.cmx \
-    tactics/equality.cmx kernel/environ.cmx tactics/elim.cmx \
-    interp/coqlib.cmx proofs/clenv.cmx tactics/inv.cmi 
-tactics/leminv.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi proofs/tacmach.cmi kernel/sign.cmi \
-    kernel/safe_typing.cmi pretyping/reductionops.cmi proofs/proof_type.cmi \
-    proofs/proof_trees.cmi parsing/printer.cmi pretyping/pretyping.cmi \
-    lib/pp.cmi proofs/pfedit.cmi kernel/names.cmi library/nameops.cmi \
-    tactics/inv.cmi pretyping/inductiveops.cmi library/global.cmi \
-    pretyping/evd.cmi proofs/evar_refiner.cmi kernel/environ.cmi \
-    kernel/entries.cmi library/declare.cmi kernel/declarations.cmi \
-    library/decl_kinds.cmo interp/constrintern.cmi proofs/clenv.cmi \
+tactics/inv.cmo: pretyping/clenv.cmi interp/coqlib.cmi tactics/elim.cmi \
+    kernel/environ.cmi tactics/equality.cmi proofs/evar_refiner.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi interp/genarg.cmi \
+    library/global.cmi tactics/hipattern.cmi pretyping/inductiveops.cmi \
+    pretyping/matching.cmi library/nameops.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi parsing/printer.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \
+    pretyping/reductionops.cmi pretyping/retyping.cmi kernel/sign.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \
+    pretyping/typing.cmi pretyping/unification.cmi lib/util.cmi \
+    tactics/inv.cmi 
+tactics/inv.cmx: pretyping/clenv.cmx interp/coqlib.cmx tactics/elim.cmx \
+    kernel/environ.cmx tactics/equality.cmx proofs/evar_refiner.cmx \
+    pretyping/evarutil.cmx pretyping/evd.cmx interp/genarg.cmx \
+    library/global.cmx tactics/hipattern.cmx pretyping/inductiveops.cmx \
+    pretyping/matching.cmx library/nameops.cmx kernel/names.cmx \
+    pretyping/pattern.cmx lib/pp.cmx parsing/printer.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \
+    pretyping/reductionops.cmx pretyping/retyping.cmx kernel/sign.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \
+    pretyping/typing.cmx pretyping/unification.cmx lib/util.cmx \
+    tactics/inv.cmi 
+tactics/leminv.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \
+    interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \
+    library/declare.cmi kernel/entries.cmi kernel/environ.cmi \
+    proofs/evar_refiner.cmi pretyping/evd.cmi library/global.cmi \
+    pretyping/inductiveops.cmi tactics/inv.cmi library/nameops.cmi \
+    kernel/names.cmi lib/options.cmi proofs/pfedit.cmi lib/pp.cmi \
+    pretyping/pretype_errors.cmi pretyping/pretyping.cmi parsing/printer.cmi \
+    proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/reductionops.cmi \
+    kernel/safe_typing.cmi kernel/sign.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi toplevel/vernacexpr.cmo \
     tactics/leminv.cmi 
-tactics/leminv.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx proofs/tacmach.cmx kernel/sign.cmx \
-    kernel/safe_typing.cmx pretyping/reductionops.cmx proofs/proof_type.cmx \
-    proofs/proof_trees.cmx parsing/printer.cmx pretyping/pretyping.cmx \
-    lib/pp.cmx proofs/pfedit.cmx kernel/names.cmx library/nameops.cmx \
-    tactics/inv.cmx pretyping/inductiveops.cmx library/global.cmx \
-    pretyping/evd.cmx proofs/evar_refiner.cmx kernel/environ.cmx \
-    kernel/entries.cmx library/declare.cmx kernel/declarations.cmx \
-    library/decl_kinds.cmx interp/constrintern.cmx proofs/clenv.cmx \
+tactics/leminv.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \
+    interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \
+    library/declare.cmx kernel/entries.cmx kernel/environ.cmx \
+    proofs/evar_refiner.cmx pretyping/evd.cmx library/global.cmx \
+    pretyping/inductiveops.cmx tactics/inv.cmx library/nameops.cmx \
+    kernel/names.cmx lib/options.cmx proofs/pfedit.cmx lib/pp.cmx \
+    pretyping/pretype_errors.cmx pretyping/pretyping.cmx parsing/printer.cmx \
+    proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/reductionops.cmx \
+    kernel/safe_typing.cmx kernel/sign.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx toplevel/vernacexpr.cmx \
     tactics/leminv.cmi 
-tactics/nbtermdn.cmo: lib/util.cmi tactics/termdn.cmi kernel/term.cmi \
-    pretyping/pattern.cmi kernel/names.cmi library/library.cmi \
-    library/libobject.cmi lib/gmap.cmi tactics/btermdn.cmi \
+tactics/nbtermdn.cmo: tactics/btermdn.cmi lib/gmap.cmi library/libnames.cmi \
+    library/libobject.cmi library/library.cmi kernel/names.cmi \
+    pretyping/pattern.cmi kernel/term.cmi tactics/termdn.cmi lib/util.cmi \
     tactics/nbtermdn.cmi 
-tactics/nbtermdn.cmx: lib/util.cmx tactics/termdn.cmx kernel/term.cmx \
-    pretyping/pattern.cmx kernel/names.cmx library/library.cmx \
-    library/libobject.cmx lib/gmap.cmx tactics/btermdn.cmx \
+tactics/nbtermdn.cmx: tactics/btermdn.cmx lib/gmap.cmx library/libnames.cmx \
+    library/libobject.cmx library/library.cmx kernel/names.cmx \
+    pretyping/pattern.cmx kernel/term.cmx tactics/termdn.cmx lib/util.cmx \
     tactics/nbtermdn.cmi 
-tactics/refine.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \
-    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
-    proofs/tacmach.cmi kernel/sign.cmi pretyping/retyping.cmi \
-    kernel/reduction.cmi parsing/printer.cmi lib/pp.cmi kernel/names.cmi \
-    pretyping/evd.cmi kernel/environ.cmi proofs/clenv.cmi tactics/refine.cmi 
-tactics/refine.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
-    kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
-    proofs/tacmach.cmx kernel/sign.cmx pretyping/retyping.cmx \
-    kernel/reduction.cmx parsing/printer.cmx lib/pp.cmx kernel/names.cmx \
-    pretyping/evd.cmx kernel/environ.cmx proofs/clenv.cmx tactics/refine.cmi 
-tactics/setoid_replace.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
-    library/summary.cmi kernel/safe_typing.cmi pretyping/reductionops.cmi \
-    proofs/proof_type.cmi parsing/printer.cmi lib/pp.cmi proofs/pfedit.cmi \
-    lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libobject.cmi library/libnames.cmi library/lib.cmi lib/gmap.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/entries.cmi library/declare.cmi library/decl_kinds.cmo \
-    interp/coqlib.cmi interp/constrintern.cmi tactics/auto.cmi \
-    tactics/setoid_replace.cmi 
-tactics/setoid_replace.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    pretyping/typing.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
-    library/summary.cmx kernel/safe_typing.cmx pretyping/reductionops.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 \
-    library/libobject.cmx library/libnames.cmx library/lib.cmx lib/gmap.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    kernel/entries.cmx library/declare.cmx library/decl_kinds.cmx \
-    interp/coqlib.cmx interp/constrintern.cmx tactics/auto.cmx \
-    tactics/setoid_replace.cmi 
-tactics/tacinterp.cmo: lib/util.cmi pretyping/typing.cmi interp/topconstr.cmi \
-    pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \
-    proofs/tactic_debug.cmi pretyping/tacred.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo interp/syntax_def.cmi library/summary.cmi \
-    kernel/sign.cmi kernel/safe_typing.cmi pretyping/retyping.cmi \
-    proofs/refiner.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
-    parsing/printer.cmi pretyping/pretyping.cmi pretyping/pretype_errors.cmi \
-    lib/pp.cmi proofs/pfedit.cmi pretyping/pattern.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    pretyping/matching.cmi proofs/logic.cmi library/libobject.cmi \
-    library/libnames.cmi library/lib.cmi tactics/leminv.cmi tactics/inv.cmi \
-    tactics/hiddentac.cmi lib/gmap.cmi library/global.cmi interp/genarg.cmi \
-    pretyping/evd.cmi kernel/environ.cmi kernel/entries.cmi tactics/elim.cmi \
-    lib/dyn.cmi tactics/dhyp.cmi kernel/declarations.cmi \
-    library/decl_kinds.cmo parsing/coqast.cmi interp/constrintern.cmi \
-    kernel/closure.cmi tactics/auto.cmi parsing/ast.cmi tactics/tacinterp.cmi 
-tactics/tacinterp.cmx: lib/util.cmx pretyping/typing.cmx interp/topconstr.cmx \
-    pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \
-    proofs/tactic_debug.cmx pretyping/tacred.cmx proofs/tacmach.cmx \
-    proofs/tacexpr.cmx interp/syntax_def.cmx library/summary.cmx \
-    kernel/sign.cmx kernel/safe_typing.cmx pretyping/retyping.cmx \
-    proofs/refiner.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
-    parsing/printer.cmx pretyping/pretyping.cmx pretyping/pretype_errors.cmx \
-    lib/pp.cmx proofs/pfedit.cmx pretyping/pattern.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    pretyping/matching.cmx proofs/logic.cmx library/libobject.cmx \
-    library/libnames.cmx library/lib.cmx tactics/leminv.cmx tactics/inv.cmx \
-    tactics/hiddentac.cmx lib/gmap.cmx library/global.cmx interp/genarg.cmx \
-    pretyping/evd.cmx kernel/environ.cmx kernel/entries.cmx tactics/elim.cmx \
-    lib/dyn.cmx tactics/dhyp.cmx kernel/declarations.cmx \
-    library/decl_kinds.cmx parsing/coqast.cmx interp/constrintern.cmx \
-    kernel/closure.cmx tactics/auto.cmx parsing/ast.cmx tactics/tacinterp.cmi 
-tactics/tacticals.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \
-    kernel/reduction.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \
-    pretyping/matching.cmi library/libnames.cmi kernel/inductive.cmi \
-    pretyping/indrec.cmi library/global.cmi interp/genarg.cmi \
-    proofs/evar_refiner.cmi kernel/environ.cmi kernel/declarations.cmi \
-    proofs/clenv.cmi tactics/tacticals.cmi 
-tactics/tacticals.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx proofs/refiner.cmx \
-    kernel/reduction.cmx lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx \
-    pretyping/matching.cmx library/libnames.cmx kernel/inductive.cmx \
-    pretyping/indrec.cmx library/global.cmx interp/genarg.cmx \
-    proofs/evar_refiner.cmx kernel/environ.cmx kernel/declarations.cmx \
-    proofs/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 \
-    pretyping/reductionops.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
-    proofs/proof_trees.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi proofs/logic.cmi \
-    library/libnames.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
-    pretyping/indrec.cmi tactics/hipattern.cmi library/global.cmi \
-    interp/genarg.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
-    proofs/evar_refiner.cmi kernel/environ.cmi kernel/entries.cmi \
-    library/declare.cmi kernel/declarations.cmi library/decl_kinds.cmo \
-    interp/coqlib.cmi interp/constrintern.cmi proofs/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 \
-    pretyping/reductionops.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
-    proofs/proof_trees.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx proofs/logic.cmx \
-    library/libnames.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
-    pretyping/indrec.cmx tactics/hipattern.cmx library/global.cmx \
-    interp/genarg.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
-    proofs/evar_refiner.cmx kernel/environ.cmx kernel/entries.cmx \
-    library/declare.cmx kernel/declarations.cmx library/decl_kinds.cmx \
-    interp/coqlib.cmx interp/constrintern.cmx proofs/clenv.cmx \
-    tactics/tactics.cmi 
-tactics/tauto.cmo: lib/util.cmi interp/topconstr.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \
-    proofs/refiner.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
-    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.cmi \
-    kernel/names.cmi library/libnames.cmi tactics/hipattern.cmi \
-    interp/genarg.cmi parsing/egrammar.cmi parsing/coqast.cmi \
-    toplevel/cerrors.cmi parsing/ast.cmi 
-tactics/tauto.cmx: lib/util.cmx interp/topconstr.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \
-    proofs/refiner.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
-    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx lib/options.cmx \
-    kernel/names.cmx library/libnames.cmx tactics/hipattern.cmx \
-    interp/genarg.cmx parsing/egrammar.cmx parsing/coqast.cmx \
-    toplevel/cerrors.cmx parsing/ast.cmx 
-tactics/termdn.cmo: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \
-    pretyping/pattern.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi library/libnames.cmi tactics/dn.cmi \
-    tactics/termdn.cmi 
-tactics/termdn.cmx: lib/util.cmx kernel/term.cmx pretyping/rawterm.cmx \
-    pretyping/pattern.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx library/libnames.cmx tactics/dn.cmx \
-    tactics/termdn.cmi 
-tools/coqdep.cmo: tools/coqdep_lexer.cmo config/coq_config.cmi 
-tools/coqdep.cmx: tools/coqdep_lexer.cmx config/coq_config.cmx 
+tactics/refine.cmo: kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi kernel/names.cmi lib/pp.cmi parsing/printer.cmi \
+    kernel/reduction.cmi proofs/refiner.cmi pretyping/retyping.cmi \
+    kernel/sign.cmi proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \
+    pretyping/typing.cmi lib/util.cmi tactics/refine.cmi 
+tactics/refine.cmx: kernel/environ.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx kernel/names.cmx lib/pp.cmx parsing/printer.cmx \
+    kernel/reduction.cmx proofs/refiner.cmx pretyping/retyping.cmx \
+    kernel/sign.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \
+    pretyping/typing.cmx lib/util.cmx tactics/refine.cmi 
+tactics/setoid_replace.cmo: pretyping/clenv.cmi kernel/closure.cmi \
+    interp/constrintern.cmi interp/coqlib.cmi library/decl_kinds.cmo \
+    library/declare.cmi kernel/entries.cmi kernel/environ.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi lib/gmap.cmi \
+    library/lib.cmi library/libnames.cmi library/libobject.cmi \
+    proofs/logic.cmi kernel/mod_subst.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi lib/options.cmi proofs/pfedit.cmi \
+    lib/pp.cmi parsing/ppconstr.cmi pretyping/pretype_errors.cmi \
+    parsing/printer.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    kernel/reduction.cmi pretyping/reductionops.cmi kernel/safe_typing.cmi \
+    kernel/sign.cmi library/summary.cmi proofs/tacmach.cmi \
+    pretyping/tacred.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \
+    pretyping/typing.cmi pretyping/unification.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo tactics/setoid_replace.cmi 
+tactics/setoid_replace.cmx: pretyping/clenv.cmx kernel/closure.cmx \
+    interp/constrintern.cmx interp/coqlib.cmx library/decl_kinds.cmx \
+    library/declare.cmx kernel/entries.cmx kernel/environ.cmx \
+    pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx lib/gmap.cmx \
+    library/lib.cmx library/libnames.cmx library/libobject.cmx \
+    proofs/logic.cmx kernel/mod_subst.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx lib/options.cmx proofs/pfedit.cmx \
+    lib/pp.cmx parsing/ppconstr.cmx pretyping/pretype_errors.cmx \
+    parsing/printer.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \
+    kernel/reduction.cmx pretyping/reductionops.cmx kernel/safe_typing.cmx \
+    kernel/sign.cmx library/summary.cmx proofs/tacmach.cmx \
+    pretyping/tacred.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \
+    pretyping/typing.cmx pretyping/unification.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx tactics/setoid_replace.cmi 
+tactics/tacinterp.cmo: tactics/auto.cmi kernel/closure.cmi \
+    interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \
+    pretyping/detyping.cmi tactics/dhyp.cmi lib/dyn.cmi tactics/elim.cmi \
+    kernel/entries.cmi kernel/environ.cmi pretyping/evd.cmi parsing/g_xml.cmo \
+    interp/genarg.cmi library/global.cmi lib/gmap.cmi tactics/hiddentac.cmi \
+    pretyping/inductiveops.cmi tactics/inv.cmi tactics/leminv.cmi \
+    library/lib.cmi library/libnames.cmi library/libobject.cmi \
+    proofs/logic.cmi pretyping/matching.cmi kernel/mod_subst.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    pretyping/pattern.cmi proofs/pfedit.cmi lib/pp.cmi parsing/pptactic.cmi \
+    pretyping/pretype_errors.cmi pretyping/pretyping.cmi parsing/printer.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \
+    proofs/refiner.cmi pretyping/retyping.cmi kernel/safe_typing.cmi \
+    kernel/sign.cmi library/summary.cmi interp/syntax_def.cmi lib/system.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi pretyping/tacred.cmi \
+    proofs/tactic_debug.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi interp/topconstr.cmi pretyping/typing.cmi \
+    lib/util.cmi tactics/tacinterp.cmi 
+tactics/tacinterp.cmx: tactics/auto.cmx kernel/closure.cmx \
+    interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \
+    pretyping/detyping.cmx tactics/dhyp.cmx lib/dyn.cmx tactics/elim.cmx \
+    kernel/entries.cmx kernel/environ.cmx pretyping/evd.cmx parsing/g_xml.cmx \
+    interp/genarg.cmx library/global.cmx lib/gmap.cmx tactics/hiddentac.cmx \
+    pretyping/inductiveops.cmx tactics/inv.cmx tactics/leminv.cmx \
+    library/lib.cmx library/libnames.cmx library/libobject.cmx \
+    proofs/logic.cmx pretyping/matching.cmx kernel/mod_subst.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    pretyping/pattern.cmx proofs/pfedit.cmx lib/pp.cmx parsing/pptactic.cmx \
+    pretyping/pretype_errors.cmx pretyping/pretyping.cmx parsing/printer.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \
+    proofs/refiner.cmx pretyping/retyping.cmx kernel/safe_typing.cmx \
+    kernel/sign.cmx library/summary.cmx interp/syntax_def.cmx lib/system.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx pretyping/tacred.cmx \
+    proofs/tactic_debug.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx interp/topconstr.cmx pretyping/typing.cmx \
+    lib/util.cmx tactics/tacinterp.cmi 
+tactics/tacticals.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \
+    kernel/declarations.cmi kernel/environ.cmi proofs/evar_refiner.cmi \
+    pretyping/evd.cmi interp/genarg.cmi library/global.cmi \
+    pretyping/indrec.cmi kernel/inductive.cmi library/libnames.cmi \
+    pretyping/matching.cmi kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi \
+    kernel/reduction.cmi proofs/refiner.cmi kernel/sign.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi tactics/tacticals.cmi 
+tactics/tacticals.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \
+    kernel/declarations.cmx kernel/environ.cmx proofs/evar_refiner.cmx \
+    pretyping/evd.cmx interp/genarg.cmx library/global.cmx \
+    pretyping/indrec.cmx kernel/inductive.cmx library/libnames.cmx \
+    pretyping/matching.cmx kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx \
+    kernel/reduction.cmx proofs/refiner.cmx kernel/sign.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx tactics/tacticals.cmi 
+tactics/tactics.cmo: pretyping/clenv.cmi proofs/clenvtac.cmi \
+    interp/constrintern.cmi interp/coqlib.cmi library/decl_kinds.cmo \
+    kernel/declarations.cmi library/declare.cmi kernel/entries.cmi \
+    kernel/environ.cmi proofs/evar_refiner.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi interp/genarg.cmi library/global.cmi \
+    tactics/hipattern.cmi pretyping/indrec.cmi kernel/inductive.cmi \
+    pretyping/inductiveops.cmi library/libnames.cmi proofs/logic.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    proofs/pfedit.cmi lib/pp.cmi pretyping/pretype_errors.cmi \
+    proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    proofs/redexpr.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    proofs/refiner.cmi kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi \
+    pretyping/tacred.cmi tactics/tacticals.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi tactics/tactics.cmi 
+tactics/tactics.cmx: pretyping/clenv.cmx proofs/clenvtac.cmx \
+    interp/constrintern.cmx interp/coqlib.cmx library/decl_kinds.cmx \
+    kernel/declarations.cmx library/declare.cmx kernel/entries.cmx \
+    kernel/environ.cmx proofs/evar_refiner.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx interp/genarg.cmx library/global.cmx \
+    tactics/hipattern.cmx pretyping/indrec.cmx kernel/inductive.cmx \
+    pretyping/inductiveops.cmx library/libnames.cmx proofs/logic.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    proofs/pfedit.cmx lib/pp.cmx pretyping/pretype_errors.cmx \
+    proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \
+    proofs/redexpr.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    proofs/refiner.cmx kernel/sign.cmx proofs/tacexpr.cmx proofs/tacmach.cmx \
+    pretyping/tacred.cmx tactics/tacticals.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx tactics/tactics.cmi 
+tactics/tauto.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    interp/genarg.cmi tactics/hipattern.cmi library/libnames.cmi \
+    kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi proofs/refiner.cmi \
+    proofs/tacexpr.cmo tactics/tacinterp.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi interp/topconstr.cmi lib/util.cmi 
+tactics/tauto.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    interp/genarg.cmx tactics/hipattern.cmx library/libnames.cmx \
+    kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \
+    proofs/tacexpr.cmx tactics/tacinterp.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx interp/topconstr.cmx lib/util.cmx 
+tactics/termdn.cmo: tactics/dn.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi pretyping/pattern.cmi \
+    pretyping/rawterm.cmi kernel/term.cmi lib/util.cmi tactics/termdn.cmi 
+tactics/termdn.cmx: tactics/dn.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx pretyping/pattern.cmx \
+    pretyping/rawterm.cmx kernel/term.cmx lib/util.cmx tactics/termdn.cmi 
+tools/coqdep.cmo: config/coq_config.cmi tools/coqdep_lexer.cmo 
+tools/coqdep.cmx: config/coq_config.cmx tools/coqdep_lexer.cmx 
 tools/gallina.cmo: tools/gallina_lexer.cmo 
 tools/gallina.cmx: tools/gallina_lexer.cmx 
-toplevel/cerrors.cmo: lib/util.cmi kernel/univ.cmi kernel/type_errors.cmi \
-    proofs/tactic_debug.cmi proofs/refiner.cmi pretyping/pretype_errors.cmi \
-    lib/pp.cmi lib/options.cmi library/nametab.cmi proofs/logic.cmi \
-    library/libnames.cmi parsing/lexer.cmi kernel/indtypes.cmi \
-    toplevel/himsg.cmi pretyping/cases.cmi parsing/ast.cmi \
-    toplevel/cerrors.cmi 
-toplevel/cerrors.cmx: lib/util.cmx kernel/univ.cmx kernel/type_errors.cmx \
-    proofs/tactic_debug.cmx proofs/refiner.cmx pretyping/pretype_errors.cmx \
-    lib/pp.cmx lib/options.cmx library/nametab.cmx proofs/logic.cmx \
-    library/libnames.cmx parsing/lexer.cmx kernel/indtypes.cmx \
-    toplevel/himsg.cmx pretyping/cases.cmx parsing/ast.cmx \
-    toplevel/cerrors.cmi 
-toplevel/class.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \
-    kernel/term.cmi kernel/sign.cmi kernel/safe_typing.cmi \
-    pretyping/retyping.cmi pretyping/reductionops.cmi parsing/printer.cmi \
-    lib/pp.cmi lib/options.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi library/libnames.cmi library/lib.cmi \
-    kernel/inductive.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi kernel/entries.cmi library/declare.cmi \
-    kernel/declarations.cmi library/decl_kinds.cmo pretyping/classops.cmi \
+toplevel/cerrors.cmo: pretyping/cases.cmi toplevel/himsg.cmi \
+    pretyping/indrec.cmi kernel/indtypes.cmi parsing/lexer.cmi \
+    library/libnames.cmi proofs/logic.cmi library/nametab.cmi lib/options.cmi \
+    lib/pp.cmi pretyping/pretype_errors.cmi proofs/refiner.cmi \
+    pretyping/tacred.cmi proofs/tactic_debug.cmi kernel/type_errors.cmi \
+    kernel/univ.cmi lib/util.cmi toplevel/cerrors.cmi 
+toplevel/cerrors.cmx: pretyping/cases.cmx toplevel/himsg.cmx \
+    pretyping/indrec.cmx kernel/indtypes.cmx parsing/lexer.cmx \
+    library/libnames.cmx proofs/logic.cmx library/nametab.cmx lib/options.cmx \
+    lib/pp.cmx pretyping/pretype_errors.cmx proofs/refiner.cmx \
+    pretyping/tacred.cmx proofs/tactic_debug.cmx kernel/type_errors.cmx \
+    kernel/univ.cmx lib/util.cmx toplevel/cerrors.cmi 
+toplevel/class.cmo: pretyping/classops.cmi library/decl_kinds.cmo \
+    kernel/declarations.cmi library/declare.cmi kernel/entries.cmi \
+    kernel/environ.cmi pretyping/evd.cmi library/global.cmi \
+    kernel/inductive.cmi library/lib.cmi library/libnames.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    lib/pp.cmi parsing/printer.cmi pretyping/reductionops.cmi \
+    kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \
     toplevel/class.cmi 
-toplevel/class.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
-    kernel/term.cmx kernel/sign.cmx kernel/safe_typing.cmx \
-    pretyping/retyping.cmx pretyping/reductionops.cmx parsing/printer.cmx \
-    lib/pp.cmx lib/options.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx library/libnames.cmx library/lib.cmx \
-    kernel/inductive.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx kernel/entries.cmx library/declare.cmx \
-    kernel/declarations.cmx library/decl_kinds.cmx pretyping/classops.cmx \
+toplevel/class.cmx: pretyping/classops.cmx library/decl_kinds.cmx \
+    kernel/declarations.cmx library/declare.cmx kernel/entries.cmx \
+    kernel/environ.cmx pretyping/evd.cmx library/global.cmx \
+    kernel/inductive.cmx library/lib.cmx library/libnames.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    lib/pp.cmx parsing/printer.cmx pretyping/reductionops.cmx \
+    kernel/safe_typing.cmx kernel/sign.cmx kernel/term.cmx \
+    pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \
     toplevel/class.cmi 
-toplevel/command.cmo: toplevel/vernacexpr.cmo lib/util.cmi kernel/typeops.cmi \
-    interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \
-    pretyping/tacred.cmi proofs/tacmach.cmi interp/syntax_def.cmi \
-    interp/symbols.cmi library/states.cmi kernel/safe_typing.cmi \
-    pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \
-    proofs/proof_type.cmi parsing/printer.cmi pretyping/pretyping.cmi \
-    lib/pp.cmi proofs/pfedit.cmi lib/options.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 pretyping/evarutil.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 \
-    pretyping/tacred.cmx proofs/tacmach.cmx interp/syntax_def.cmx \
-    interp/symbols.cmx library/states.cmx kernel/safe_typing.cmx \
-    pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \
-    proofs/proof_type.cmx parsing/printer.cmx pretyping/pretyping.cmx \
-    lib/pp.cmx proofs/pfedit.cmx lib/options.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 pretyping/evarutil.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 \
+toplevel/command.cmo: toplevel/class.cmi interp/constrextern.cmi \
+    interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \
+    library/declare.cmi kernel/entries.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi library/impargs.cmi \
+    pretyping/indrec.cmi kernel/indtypes.cmi kernel/inductive.cmi \
+    library/lib.cmi library/libnames.cmi library/libobject.cmi \
+    library/library.cmi proofs/logic.cmi toplevel/metasyntax.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi \
+    interp/notation.cmi lib/options.cmi proofs/pfedit.cmi lib/pp.cmi \
+    pretyping/pretyping.cmi parsing/printer.cmi proofs/proof_type.cmi \
+    proofs/redexpr.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    pretyping/retyping.cmi kernel/safe_typing.cmi library/states.cmi \
+    interp/syntax_def.cmi proofs/tacmach.cmi kernel/term.cmi \
+    pretyping/termops.cmi interp/topconstr.cmi kernel/typeops.cmi \
+    lib/util.cmi toplevel/vernacexpr.cmo toplevel/command.cmi 
+toplevel/command.cmx: toplevel/class.cmx interp/constrextern.cmx \
+    interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \
+    library/declare.cmx kernel/entries.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx library/impargs.cmx \
+    pretyping/indrec.cmx kernel/indtypes.cmx kernel/inductive.cmx \
+    library/lib.cmx library/libnames.cmx library/libobject.cmx \
+    library/library.cmx proofs/logic.cmx toplevel/metasyntax.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx \
+    interp/notation.cmx lib/options.cmx proofs/pfedit.cmx lib/pp.cmx \
+    pretyping/pretyping.cmx parsing/printer.cmx proofs/proof_type.cmx \
+    proofs/redexpr.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    pretyping/retyping.cmx kernel/safe_typing.cmx library/states.cmx \
+    interp/syntax_def.cmx proofs/tacmach.cmx kernel/term.cmx \
+    pretyping/termops.cmx interp/topconstr.cmx kernel/typeops.cmx \
+    lib/util.cmx toplevel/vernacexpr.cmx toplevel/command.cmi 
+toplevel/coqinit.cmo: config/coq_config.cmi toplevel/mltop.cmi \
+    library/nameops.cmi kernel/names.cmi lib/options.cmi lib/pp.cmi \
+    lib/system.cmi toplevel/toplevel.cmi toplevel/vernac.cmi \
     toplevel/coqinit.cmi 
-toplevel/coqinit.cmx: toplevel/vernac.cmx toplevel/toplevel.cmx \
-    lib/system.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \
-    library/nameops.cmx toplevel/mltop.cmx config/coq_config.cmx \
+toplevel/coqinit.cmx: config/coq_config.cmx toplevel/mltop.cmx \
+    library/nameops.cmx kernel/names.cmx lib/options.cmx lib/pp.cmx \
+    lib/system.cmx toplevel/toplevel.cmx toplevel/vernac.cmx \
     toplevel/coqinit.cmi 
-toplevel/coqtop.cmo: toplevel/vernac.cmi lib/util.cmi toplevel/usage.cmi \
-    toplevel/toplevel.cmi lib/system.cmi library/states.cmi lib/profile.cmi \
-    lib/pp.cmi lib/options.cmi kernel/names.cmi library/nameops.cmi \
-    toplevel/mltop.cmi library/library.cmi library/libnames.cmi \
-    library/lib.cmi library/global.cmi kernel/environ.cmi \
-    library/declaremods.cmi toplevel/coqinit.cmi config/coq_config.cmi \
-    toplevel/cerrors.cmi toplevel/coqtop.cmi 
-toplevel/coqtop.cmx: toplevel/vernac.cmx lib/util.cmx toplevel/usage.cmx \
-    toplevel/toplevel.cmx lib/system.cmx library/states.cmx lib/profile.cmx \
-    lib/pp.cmx lib/options.cmx kernel/names.cmx library/nameops.cmx \
-    toplevel/mltop.cmx library/library.cmx library/libnames.cmx \
-    library/lib.cmx library/global.cmx kernel/environ.cmx \
-    library/declaremods.cmx toplevel/coqinit.cmx config/coq_config.cmx \
-    toplevel/cerrors.cmx toplevel/coqtop.cmi 
-toplevel/discharge.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \
-    kernel/term.cmi library/summary.cmi kernel/sign.cmi kernel/reduction.cmi \
-    pretyping/recordops.cmi toplevel/recordobj.cmi lib/pp.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/library.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi pretyping/instantiate.cmi kernel/inductive.cmi \
-    kernel/indtypes.cmi library/impargs.cmi library/global.cmi \
-    kernel/environ.cmi kernel/entries.cmi library/dischargedhypsmap.cmi \
-    library/declare.cmi kernel/declarations.cmi library/decl_kinds.cmo \
-    kernel/cooking.cmi pretyping/classops.cmi toplevel/class.cmi \
-    toplevel/discharge.cmi 
-toplevel/discharge.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
-    kernel/term.cmx library/summary.cmx kernel/sign.cmx kernel/reduction.cmx \
-    pretyping/recordops.cmx toplevel/recordobj.cmx lib/pp.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/library.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx pretyping/instantiate.cmx kernel/inductive.cmx \
-    kernel/indtypes.cmx library/impargs.cmx library/global.cmx \
-    kernel/environ.cmx kernel/entries.cmx library/dischargedhypsmap.cmx \
-    library/declare.cmx kernel/declarations.cmx library/decl_kinds.cmx \
-    kernel/cooking.cmx pretyping/classops.cmx toplevel/class.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 
-toplevel/fhimsg.cmx: lib/util.cmx kernel/type_errors.cmx kernel/term.cmx \
-    kernel/sign.cmx kernel/reduction.cmx lib/pp.cmx kernel/names.cmx \
-    parsing/g_minicoq.cmx kernel/environ.cmx toplevel/fhimsg.cmi 
-toplevel/himsg.cmo: lib/util.cmi kernel/type_errors.cmi pretyping/termops.cmi \
-    kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi \
-    pretyping/rawterm.cmi parsing/printer.cmi pretyping/pretype_errors.cmi \
-    lib/pp.cmi lib/options.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi proofs/logic.cmi kernel/inductive.cmi \
-    kernel/indtypes.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi pretyping/cases.cmi parsing/ast.cmi toplevel/himsg.cmi 
-toplevel/himsg.cmx: lib/util.cmx kernel/type_errors.cmx pretyping/termops.cmx \
-    kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx \
-    pretyping/rawterm.cmx parsing/printer.cmx pretyping/pretype_errors.cmx \
-    lib/pp.cmx lib/options.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx proofs/logic.cmx kernel/inductive.cmx \
-    kernel/indtypes.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx pretyping/cases.cmx parsing/ast.cmx toplevel/himsg.cmi 
+toplevel/coqtop.cmo: toplevel/cerrors.cmi config/coq_config.cmi \
+    toplevel/coqinit.cmi kernel/declarations.cmi library/declaremods.cmi \
+    library/global.cmi library/lib.cmi library/libnames.cmi \
+    library/library.cmi toplevel/mltop.cmi library/nameops.cmi \
+    kernel/names.cmi lib/options.cmi lib/pp.cmi lib/profile.cmi \
+    library/states.cmi lib/system.cmi toplevel/toplevel.cmi \
+    toplevel/usage.cmi lib/util.cmi kernel/vconv.cmi toplevel/vernac.cmi \
+    kernel/vm.cmi toplevel/coqtop.cmi 
+toplevel/coqtop.cmx: toplevel/cerrors.cmx config/coq_config.cmx \
+    toplevel/coqinit.cmx kernel/declarations.cmx library/declaremods.cmx \
+    library/global.cmx library/lib.cmx library/libnames.cmx \
+    library/library.cmx toplevel/mltop.cmx library/nameops.cmx \
+    kernel/names.cmx lib/options.cmx lib/pp.cmx lib/profile.cmx \
+    library/states.cmx lib/system.cmx toplevel/toplevel.cmx \
+    toplevel/usage.cmx lib/util.cmx kernel/vconv.cmx toplevel/vernac.cmx \
+    kernel/vm.cmx toplevel/coqtop.cmi 
+toplevel/discharge.cmo: kernel/cooking.cmi kernel/declarations.cmi \
+    kernel/entries.cmi kernel/names.cmi kernel/sign.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi toplevel/discharge.cmi 
+toplevel/discharge.cmx: kernel/cooking.cmx kernel/declarations.cmx \
+    kernel/entries.cmx kernel/names.cmx kernel/sign.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx toplevel/discharge.cmi 
+toplevel/fhimsg.cmo: kernel/environ.cmi parsing/g_minicoq.cmi \
+    kernel/names.cmi lib/pp.cmi kernel/reduction.cmi kernel/sign.cmi \
+    kernel/term.cmi kernel/type_errors.cmi lib/util.cmi toplevel/fhimsg.cmi 
+toplevel/fhimsg.cmx: kernel/environ.cmx parsing/g_minicoq.cmx \
+    kernel/names.cmx lib/pp.cmx kernel/reduction.cmx kernel/sign.cmx \
+    kernel/term.cmx kernel/type_errors.cmx lib/util.cmx toplevel/fhimsg.cmi 
+toplevel/himsg.cmo: pretyping/cases.cmi kernel/environ.cmi pretyping/evd.cmi \
+    library/global.cmi pretyping/indrec.cmi kernel/indtypes.cmi \
+    kernel/inductive.cmi proofs/logic.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi lib/options.cmi lib/pp.cmi \
+    pretyping/pretype_errors.cmi parsing/printer.cmi pretyping/rawterm.cmi \
+    kernel/reduction.cmi kernel/sign.cmi pretyping/tacred.cmi kernel/term.cmi \
+    pretyping/termops.cmi kernel/type_errors.cmi lib/util.cmi \
+    toplevel/himsg.cmi 
+toplevel/himsg.cmx: pretyping/cases.cmx kernel/environ.cmx pretyping/evd.cmx \
+    library/global.cmx pretyping/indrec.cmx kernel/indtypes.cmx \
+    kernel/inductive.cmx proofs/logic.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx lib/options.cmx lib/pp.cmx \
+    pretyping/pretype_errors.cmx parsing/printer.cmx pretyping/rawterm.cmx \
+    kernel/reduction.cmx kernel/sign.cmx pretyping/tacred.cmx kernel/term.cmx \
+    pretyping/termops.cmx kernel/type_errors.cmx lib/util.cmx \
+    toplevel/himsg.cmi 
 toplevel/line_oriented_parser.cmo: toplevel/line_oriented_parser.cmi 
 toplevel/line_oriented_parser.cmx: toplevel/line_oriented_parser.cmi 
-toplevel/metasyntax.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi parsing/termast.cmi interp/symbols.cmi \
-    library/summary.cmi pretyping/rawterm.cmi parsing/pptactic.cmi \
-    interp/ppextend.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/library.cmi \
-    library/libobject.cmi library/libnames.cmi library/lib.cmi \
-    parsing/lexer.cmi library/global.cmi interp/genarg.cmi parsing/extend.cmi \
-    pretyping/evd.cmi parsing/esyntax.cmi parsing/egrammar.cmi \
-    parsing/coqast.cmi interp/constrintern.cmi interp/constrextern.cmi \
-    pretyping/classops.cmi parsing/ast.cmi toplevel/metasyntax.cmi 
-toplevel/metasyntax.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx parsing/termast.cmx interp/symbols.cmx \
-    library/summary.cmx pretyping/rawterm.cmx parsing/pptactic.cmx \
-    interp/ppextend.cmx lib/pp.cmx parsing/pcoq.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/library.cmx \
-    library/libobject.cmx library/libnames.cmx library/lib.cmx \
-    parsing/lexer.cmx library/global.cmx interp/genarg.cmx parsing/extend.cmx \
-    pretyping/evd.cmx parsing/esyntax.cmx parsing/egrammar.cmx \
-    parsing/coqast.cmx interp/constrintern.cmx interp/constrextern.cmx \
-    pretyping/classops.cmx parsing/ast.cmx toplevel/metasyntax.cmi 
-toplevel/minicoq.cmo: lib/util.cmi kernel/type_errors.cmi kernel/term.cmi \
-    kernel/sign.cmi kernel/safe_typing.cmi lib/pp.cmi kernel/names.cmi \
-    kernel/inductive.cmi parsing/g_minicoq.cmi toplevel/fhimsg.cmi \
-    kernel/declarations.cmi 
-toplevel/minicoq.cmx: lib/util.cmx kernel/type_errors.cmx kernel/term.cmx \
-    kernel/sign.cmx kernel/safe_typing.cmx lib/pp.cmx kernel/names.cmx \
-    kernel/inductive.cmx parsing/g_minicoq.cmx toplevel/fhimsg.cmx \
-    kernel/declarations.cmx 
-toplevel/mltop.cmo: toplevel/vernacinterp.cmi lib/util.cmi lib/system.cmi \
-    library/summary.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \
-    library/library.cmi library/libobject.cmi library/lib.cmi \
-    toplevel/mltop.cmi 
-toplevel/mltop.cmx: toplevel/vernacinterp.cmx lib/util.cmx lib/system.cmx \
-    library/summary.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \
-    library/library.cmx library/libobject.cmx library/lib.cmx \
-    toplevel/mltop.cmi 
-toplevel/protectedtoplevel.cmo: toplevel/vernacexpr.cmo toplevel/vernac.cmi \
-    lib/pp.cmi parsing/pcoq.cmi toplevel/line_oriented_parser.cmi \
-    toplevel/cerrors.cmi toplevel/protectedtoplevel.cmi 
-toplevel/protectedtoplevel.cmx: toplevel/vernacexpr.cmx toplevel/vernac.cmx \
-    lib/pp.cmx parsing/pcoq.cmx toplevel/line_oriented_parser.cmx \
-    toplevel/cerrors.cmx toplevel/protectedtoplevel.cmi 
-toplevel/record.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    kernel/type_errors.cmi interp/topconstr.cmi pretyping/termops.cmi \
-    kernel/term.cmi kernel/safe_typing.cmi pretyping/recordops.cmi \
-    parsing/printer.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    pretyping/inductiveops.cmi kernel/inductive.cmi kernel/indtypes.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    kernel/entries.cmi library/declare.cmi kernel/declarations.cmi \
-    library/decl_kinds.cmo parsing/coqast.cmi interp/constrintern.cmi \
-    toplevel/command.cmi toplevel/class.cmi toplevel/record.cmi 
-toplevel/record.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    kernel/type_errors.cmx interp/topconstr.cmx pretyping/termops.cmx \
-    kernel/term.cmx kernel/safe_typing.cmx pretyping/recordops.cmx \
-    parsing/printer.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    pretyping/inductiveops.cmx kernel/inductive.cmx kernel/indtypes.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    kernel/entries.cmx library/declare.cmx kernel/declarations.cmx \
-    library/decl_kinds.cmx parsing/coqast.cmx interp/constrintern.cmx \
-    toplevel/command.cmx toplevel/class.cmx toplevel/record.cmi 
-toplevel/recordobj.cmo: lib/util.cmi kernel/term.cmi pretyping/recordops.cmi \
-    lib/pp.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libnames.cmi library/lib.cmi pretyping/instantiate.cmi \
-    library/global.cmi kernel/environ.cmi library/declare.cmi \
-    pretyping/classops.cmi toplevel/recordobj.cmi 
-toplevel/recordobj.cmx: lib/util.cmx kernel/term.cmx pretyping/recordops.cmx \
-    lib/pp.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/libnames.cmx library/lib.cmx pretyping/instantiate.cmx \
-    library/global.cmx kernel/environ.cmx library/declare.cmx \
-    pretyping/classops.cmx toplevel/recordobj.cmi 
-toplevel/toplevel.cmo: toplevel/vernacexpr.cmo toplevel/vernac.cmi \
-    lib/util.cmi toplevel/protectedtoplevel.cmi lib/pp.cmi proofs/pfedit.cmi \
-    parsing/pcoq.cmi lib/options.cmi kernel/names.cmi toplevel/mltop.cmi \
-    library/lib.cmi toplevel/cerrors.cmi toplevel/toplevel.cmi 
-toplevel/toplevel.cmx: toplevel/vernacexpr.cmx toplevel/vernac.cmx \
-    lib/util.cmx toplevel/protectedtoplevel.cmx lib/pp.cmx proofs/pfedit.cmx \
-    parsing/pcoq.cmx lib/options.cmx kernel/names.cmx toplevel/mltop.cmx \
-    library/lib.cmx toplevel/cerrors.cmx toplevel/toplevel.cmi 
+toplevel/metasyntax.cmo: lib/bigint.cmi pretyping/classops.cmi \
+    interp/constrintern.cmi parsing/egrammar.cmi parsing/extend.cmi \
+    library/global.cmi parsing/lexer.cmi library/lib.cmi library/libnames.cmi \
+    library/libobject.cmi kernel/names.cmi interp/notation.cmi \
+    lib/options.cmi parsing/pcoq.cmi lib/pp.cmi interp/ppextend.cmi \
+    parsing/pptactic.cmi pretyping/rawterm.cmi library/summary.cmi \
+    tactics/tacinterp.cmi interp/topconstr.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo toplevel/metasyntax.cmi 
+toplevel/metasyntax.cmx: lib/bigint.cmx pretyping/classops.cmx \
+    interp/constrintern.cmx parsing/egrammar.cmx parsing/extend.cmx \
+    library/global.cmx parsing/lexer.cmx library/lib.cmx library/libnames.cmx \
+    library/libobject.cmx kernel/names.cmx interp/notation.cmx \
+    lib/options.cmx parsing/pcoq.cmx lib/pp.cmx interp/ppextend.cmx \
+    parsing/pptactic.cmx pretyping/rawterm.cmx library/summary.cmx \
+    tactics/tacinterp.cmx interp/topconstr.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx toplevel/metasyntax.cmi 
+toplevel/minicoq.cmo: kernel/declarations.cmi toplevel/fhimsg.cmi \
+    parsing/g_minicoq.cmi kernel/inductive.cmi kernel/names.cmi lib/pp.cmi \
+    kernel/safe_typing.cmi kernel/sign.cmi kernel/term.cmi \
+    kernel/type_errors.cmi lib/util.cmi 
+toplevel/minicoq.cmx: kernel/declarations.cmx toplevel/fhimsg.cmx \
+    parsing/g_minicoq.cmx kernel/inductive.cmx kernel/names.cmx lib/pp.cmx \
+    kernel/safe_typing.cmx kernel/sign.cmx kernel/term.cmx \
+    kernel/type_errors.cmx lib/util.cmx 
+toplevel/mltop.cmo: library/lib.cmi library/libobject.cmi library/library.cmi \
+    kernel/names.cmi lib/options.cmi lib/pp.cmi library/summary.cmi \
+    lib/system.cmi lib/util.cmi toplevel/vernacinterp.cmi toplevel/mltop.cmi 
+toplevel/mltop.cmx: library/lib.cmx library/libobject.cmx library/library.cmx \
+    kernel/names.cmx lib/options.cmx lib/pp.cmx library/summary.cmx \
+    lib/system.cmx lib/util.cmx toplevel/vernacinterp.cmx toplevel/mltop.cmi 
+toplevel/protectedtoplevel.cmo: toplevel/cerrors.cmi \
+    toplevel/line_oriented_parser.cmi parsing/pcoq.cmi lib/pp.cmi \
+    toplevel/vernac.cmi toplevel/vernacexpr.cmo \
+    toplevel/protectedtoplevel.cmi 
+toplevel/protectedtoplevel.cmx: toplevel/cerrors.cmx \
+    toplevel/line_oriented_parser.cmx parsing/pcoq.cmx lib/pp.cmx \
+    toplevel/vernac.cmx toplevel/vernacexpr.cmx \
+    toplevel/protectedtoplevel.cmi 
+toplevel/record.cmo: toplevel/class.cmi toplevel/command.cmi \
+    interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \
+    library/declare.cmi kernel/entries.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi kernel/indtypes.cmi \
+    kernel/inductive.cmi pretyping/inductiveops.cmi library/libnames.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    lib/pp.cmi parsing/printer.cmi pretyping/recordops.cmi \
+    kernel/safe_typing.cmi kernel/term.cmi pretyping/termops.cmi \
+    interp/topconstr.cmi kernel/type_errors.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo toplevel/record.cmi 
+toplevel/record.cmx: toplevel/class.cmx toplevel/command.cmx \
+    interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \
+    library/declare.cmx kernel/entries.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx kernel/indtypes.cmx \
+    kernel/inductive.cmx pretyping/inductiveops.cmx library/libnames.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    lib/pp.cmx parsing/printer.cmx pretyping/recordops.cmx \
+    kernel/safe_typing.cmx kernel/term.cmx pretyping/termops.cmx \
+    interp/topconstr.cmx kernel/type_errors.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx toplevel/record.cmi 
+toplevel/toplevel.cmo: toplevel/cerrors.cmi library/lib.cmi \
+    toplevel/mltop.cmi kernel/names.cmi lib/options.cmi parsing/pcoq.cmi \
+    proofs/pfedit.cmi lib/pp.cmi parsing/printer.cmi \
+    toplevel/protectedtoplevel.cmi lib/util.cmi toplevel/vernac.cmi \
+    toplevel/vernacexpr.cmo toplevel/toplevel.cmi 
+toplevel/toplevel.cmx: toplevel/cerrors.cmx library/lib.cmx \
+    toplevel/mltop.cmx kernel/names.cmx lib/options.cmx parsing/pcoq.cmx \
+    proofs/pfedit.cmx lib/pp.cmx parsing/printer.cmx \
+    toplevel/protectedtoplevel.cmx lib/util.cmx toplevel/vernac.cmx \
+    toplevel/vernacexpr.cmx toplevel/toplevel.cmi 
 toplevel/usage.cmo: config/coq_config.cmi toplevel/usage.cmi 
 toplevel/usage.cmx: config/coq_config.cmx toplevel/usage.cmi 
-toplevel/vernac.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \
-    toplevel/vernacentries.cmi lib/util.cmi proofs/tacmach.cmi \
-    tactics/tacinterp.cmi lib/system.cmi library/states.cmi \
-    proofs/refiner.cmi translate/ppvernacnew.cmi lib/pp.cmi proofs/pfedit.cmi \
-    parsing/pcoq.cmi lib/options.cmi kernel/names.cmi library/library.cmi \
-    library/lib.cmi parsing/lexer.cmi parsing/coqast.cmi \
-    interp/constrintern.cmi interp/constrextern.cmi toplevel/vernac.cmi 
-toplevel/vernac.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \
-    toplevel/vernacentries.cmx lib/util.cmx proofs/tacmach.cmx \
-    tactics/tacinterp.cmx lib/system.cmx library/states.cmx \
-    proofs/refiner.cmx translate/ppvernacnew.cmx lib/pp.cmx proofs/pfedit.cmx \
-    parsing/pcoq.cmx lib/options.cmx kernel/names.cmx library/library.cmx \
-    library/lib.cmx parsing/lexer.cmx parsing/coqast.cmx \
-    interp/constrintern.cmx interp/constrextern.cmx toplevel/vernac.cmi 
-toplevel/vernacentries.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \
-    lib/util.cmi kernel/univ.cmi kernel/typeops.cmi interp/topconstr.cmi \
-    kernel/term.cmi tactics/tactics.cmi proofs/tactic_debug.cmi \
-    pretyping/tacred.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo lib/system.cmi interp/syntax_def.cmi \
-    interp/symbols.cmi library/states.cmi parsing/search.cmi \
-    kernel/safe_typing.cmi interp/reserve.cmi proofs/refiner.cmi \
-    pretyping/reductionops.cmi toplevel/recordobj.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 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 toplevel/discharge.cmi \
-    pretyping/detyping.cmi library/declaremods.cmi library/decl_kinds.cmo \
-    interp/constrintern.cmi interp/constrextern.cmi toplevel/command.cmi \
-    pretyping/classops.cmi toplevel/class.cmi tactics/auto.cmi \
-    toplevel/vernacentries.cmi 
-toplevel/vernacentries.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \
-    lib/util.cmx kernel/univ.cmx kernel/typeops.cmx interp/topconstr.cmx \
-    kernel/term.cmx tactics/tactics.cmx proofs/tactic_debug.cmx \
-    pretyping/tacred.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx lib/system.cmx interp/syntax_def.cmx \
-    interp/symbols.cmx library/states.cmx parsing/search.cmx \
-    kernel/safe_typing.cmx interp/reserve.cmx proofs/refiner.cmx \
-    pretyping/reductionops.cmx toplevel/recordobj.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 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 toplevel/discharge.cmx \
-    pretyping/detyping.cmx library/declaremods.cmx library/decl_kinds.cmx \
-    interp/constrintern.cmx interp/constrextern.cmx toplevel/command.cmx \
-    pretyping/classops.cmx toplevel/class.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 
-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 
-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 \
-    parsing/extend.cmi parsing/coqast.cmi parsing/ast.cmi \
-    toplevel/vernacinterp.cmi 
-toplevel/vernacinterp.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    tactics/tacinterp.cmx proofs/tacexpr.cmx proofs/proof_type.cmx lib/pp.cmx \
-    lib/options.cmx kernel/names.cmx library/libnames.cmx toplevel/himsg.cmx \
-    parsing/extend.cmx parsing/coqast.cmx parsing/ast.cmx \
-    toplevel/vernacinterp.cmi 
-translate/ppconstrnew.cmo: lib/util.cmi kernel/univ.cmi interp/topconstr.cmi \
-    pretyping/termops.cmi kernel/term.cmi interp/syntax_def.cmi \
-    interp/symbols.cmi pretyping/retyping.cmi pretyping/rawterm.cmi \
-    pretyping/pretyping.cmi interp/ppextend.cmi lib/pp.cmi \
-    pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi library/lib.cmi \
-    library/global.cmi interp/genarg.cmi pretyping/evd.cmi parsing/coqast.cmi \
-    interp/constrintern.cmi interp/constrextern.cmi lib/bignat.cmi \
-    parsing/ast.cmi translate/ppconstrnew.cmi 
-translate/ppconstrnew.cmx: lib/util.cmx kernel/univ.cmx interp/topconstr.cmx \
-    pretyping/termops.cmx kernel/term.cmx interp/syntax_def.cmx \
-    interp/symbols.cmx pretyping/retyping.cmx pretyping/rawterm.cmx \
-    pretyping/pretyping.cmx interp/ppextend.cmx lib/pp.cmx \
-    pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx library/lib.cmx \
-    library/global.cmx interp/genarg.cmx pretyping/evd.cmx parsing/coqast.cmx \
-    interp/constrintern.cmx interp/constrextern.cmx lib/bignat.cmx \
-    parsing/ast.cmx translate/ppconstrnew.cmi 
-translate/pptacticnew.cmo: lib/util.cmi interp/topconstr.cmi \
-    pretyping/termops.cmi kernel/term.cmi proofs/tacexpr.cmo \
-    pretyping/rawterm.cmi parsing/pptactic.cmi interp/ppextend.cmi \
-    translate/ppconstrnew.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    library/global.cmi interp/genarg.cmi parsing/extend.cmi \
-    kernel/environ.cmi parsing/egrammar.cmi lib/dyn.cmi \
-    interp/constrextern.cmi kernel/closure.cmi translate/pptacticnew.cmi 
-translate/pptacticnew.cmx: lib/util.cmx interp/topconstr.cmx \
-    pretyping/termops.cmx kernel/term.cmx proofs/tacexpr.cmx \
-    pretyping/rawterm.cmx parsing/pptactic.cmx interp/ppextend.cmx \
-    translate/ppconstrnew.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    library/global.cmx interp/genarg.cmx parsing/extend.cmx \
-    kernel/environ.cmx parsing/egrammar.cmx lib/dyn.cmx \
-    interp/constrextern.cmx kernel/closure.cmx translate/pptacticnew.cmi 
-translate/ppvernacnew.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tacinterp.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi \
-    translate/pptacticnew.cmi parsing/pptactic.cmi interp/ppextend.cmi \
-    translate/ppconstrnew.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \
-    lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    interp/modintern.cmi toplevel/metasyntax.cmi library/library.cmi \
-    library/libnames.cmi library/lib.cmi library/impargs.cmi \
-    library/goptions.cmi library/global.cmi interp/genarg.cmi \
-    parsing/extend.cmi pretyping/evd.cmi kernel/environ.cmi \
-    parsing/egrammar.cmi library/declaremods.cmi library/decl_kinds.cmo \
-    parsing/coqast.cmi interp/constrintern.cmi interp/constrextern.cmi \
-    parsing/ast.cmi translate/ppvernacnew.cmi 
-translate/ppvernacnew.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tacinterp.cmx proofs/tacexpr.cmx pretyping/rawterm.cmx \
-    translate/pptacticnew.cmx parsing/pptactic.cmx interp/ppextend.cmx \
-    translate/ppconstrnew.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \
-    lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    interp/modintern.cmx toplevel/metasyntax.cmx library/library.cmx \
-    library/libnames.cmx library/lib.cmx library/impargs.cmx \
-    library/goptions.cmx library/global.cmx interp/genarg.cmx \
-    parsing/extend.cmx pretyping/evd.cmx kernel/environ.cmx \
-    parsing/egrammar.cmx library/declaremods.cmx library/decl_kinds.cmx \
-    parsing/coqast.cmx interp/constrintern.cmx interp/constrextern.cmx \
-    parsing/ast.cmx translate/ppvernacnew.cmi 
-contrib/cc/ccalgo.cmo: lib/util.cmi kernel/term.cmi kernel/names.cmi \
-    contrib/cc/ccalgo.cmi 
-contrib/cc/ccalgo.cmx: lib/util.cmx kernel/term.cmx kernel/names.cmx \
-    contrib/cc/ccalgo.cmi 
-contrib/cc/ccproof.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \
-    contrib/cc/ccalgo.cmi contrib/cc/ccproof.cmi 
-contrib/cc/ccproof.cmx: lib/util.cmx lib/pp.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 proofs/tacexpr.cmo kernel/sign.cmi \
-    proofs/refiner.cmi proofs/proof_type.cmi parsing/pptactic.cmi lib/pp.cmi \
-    parsing/pcoq.cmi lib/options.cmi kernel/names.cmi library/nameops.cmi \
-    library/library.cmi library/libnames.cmi pretyping/inductiveops.cmi \
-    kernel/inductive.cmi library/global.cmi pretyping/evd.cmi \
-    parsing/egrammar.cmi kernel/declarations.cmi interp/coqlib.cmi \
-    toplevel/cerrors.cmi contrib/cc/ccproof.cmi contrib/cc/ccalgo.cmi 
-contrib/cc/cctac.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
-    tactics/tacinterp.cmx proofs/tacexpr.cmx kernel/sign.cmx \
-    proofs/refiner.cmx proofs/proof_type.cmx parsing/pptactic.cmx lib/pp.cmx \
-    parsing/pcoq.cmx lib/options.cmx kernel/names.cmx library/nameops.cmx \
-    library/library.cmx library/libnames.cmx pretyping/inductiveops.cmx \
-    kernel/inductive.cmx library/global.cmx pretyping/evd.cmx \
-    parsing/egrammar.cmx kernel/declarations.cmx interp/coqlib.cmx \
-    toplevel/cerrors.cmx contrib/cc/ccproof.cmx contrib/cc/ccalgo.cmx 
-contrib/correctness/pcic.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    kernel/typeops.cmi interp/topconstr.cmi pretyping/termops.cmi \
-    kernel/term.cmi kernel/sign.cmi toplevel/record.cmi pretyping/rawterm.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/libnames.cmi kernel/indtypes.cmi library/global.cmi \
-    kernel/entries.cmi pretyping/detyping.cmi library/declare.cmi \
-    kernel/declarations.cmi contrib/correctness/pcic.cmi 
-contrib/correctness/pcic.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    kernel/typeops.cmx interp/topconstr.cmx pretyping/termops.cmx \
-    kernel/term.cmx kernel/sign.cmx toplevel/record.cmx pretyping/rawterm.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/libnames.cmx kernel/indtypes.cmx library/global.cmx \
-    kernel/entries.cmx pretyping/detyping.cmx library/declare.cmx \
-    kernel/declarations.cmx contrib/correctness/pcic.cmi 
-contrib/correctness/pcicenv.cmo: kernel/univ.cmi kernel/term.cmi \
-    kernel/sign.cmi kernel/names.cmi library/global.cmi \
+toplevel/vernacentries.cmo: tactics/auto.cmi tactics/autorewrite.cmi \
+    toplevel/class.cmi pretyping/classops.cmi toplevel/command.cmi \
+    interp/constrextern.cmi interp/constrintern.cmi library/decl_kinds.cmo \
+    kernel/declarations.cmi library/declaremods.cmi pretyping/detyping.cmi \
+    kernel/entries.cmi kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi library/global.cmi library/goptions.cmi \
+    library/impargs.cmi pretyping/inductiveops.cmi library/lib.cmi \
+    library/libnames.cmi library/library.cmi toplevel/metasyntax.cmi \
+    toplevel/mltop.cmi interp/modintern.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi interp/notation.cmi lib/options.cmi \
+    proofs/pfedit.cmi lib/pp.cmi lib/pp_control.cmi parsing/prettyp.cmi \
+    pretyping/pretyping.cmi parsing/printer.cmi parsing/printmod.cmi \
+    proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    toplevel/record.cmi pretyping/recordops.cmi proofs/redexpr.cmi \
+    pretyping/reductionops.cmi interp/reserve.cmi kernel/safe_typing.cmi \
+    parsing/search.cmi tactics/setoid_replace.cmi library/states.cmi \
+    interp/syntax_def.cmi lib/system.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi proofs/tacmach.cmi proofs/tactic_debug.cmi \
+    parsing/tactic_printer.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi interp/topconstr.cmi kernel/typeops.cmi \
+    kernel/univ.cmi lib/util.cmi kernel/vconv.cmi toplevel/vernacexpr.cmo \
+    toplevel/vernacinterp.cmi kernel/vm.cmi toplevel/vernacentries.cmi 
+toplevel/vernacentries.cmx: tactics/auto.cmx tactics/autorewrite.cmx \
+    toplevel/class.cmx pretyping/classops.cmx toplevel/command.cmx \
+    interp/constrextern.cmx interp/constrintern.cmx library/decl_kinds.cmx \
+    kernel/declarations.cmx library/declaremods.cmx pretyping/detyping.cmx \
+    kernel/entries.cmx kernel/environ.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx library/global.cmx library/goptions.cmx \
+    library/impargs.cmx pretyping/inductiveops.cmx library/lib.cmx \
+    library/libnames.cmx library/library.cmx toplevel/metasyntax.cmx \
+    toplevel/mltop.cmx interp/modintern.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx interp/notation.cmx lib/options.cmx \
+    proofs/pfedit.cmx lib/pp.cmx lib/pp_control.cmx parsing/prettyp.cmx \
+    pretyping/pretyping.cmx parsing/printer.cmx parsing/printmod.cmx \
+    proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \
+    toplevel/record.cmx pretyping/recordops.cmx proofs/redexpr.cmx \
+    pretyping/reductionops.cmx interp/reserve.cmx kernel/safe_typing.cmx \
+    parsing/search.cmx tactics/setoid_replace.cmx library/states.cmx \
+    interp/syntax_def.cmx lib/system.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx proofs/tacmach.cmx proofs/tactic_debug.cmx \
+    parsing/tactic_printer.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx interp/topconstr.cmx kernel/typeops.cmx \
+    kernel/univ.cmx lib/util.cmx kernel/vconv.cmx toplevel/vernacexpr.cmx \
+    toplevel/vernacinterp.cmx kernel/vm.cmx toplevel/vernacentries.cmi 
+toplevel/vernacexpr.cmo: library/decl_kinds.cmo parsing/extend.cmi \
+    interp/genarg.cmi library/goptions.cmi library/libnames.cmi \
+    kernel/names.cmi library/nametab.cmi interp/ppextend.cmi \
+    pretyping/rawterm.cmi proofs/tacexpr.cmo interp/topconstr.cmi \
+    lib/util.cmi 
+toplevel/vernacexpr.cmx: library/decl_kinds.cmx parsing/extend.cmx \
+    interp/genarg.cmx library/goptions.cmx library/libnames.cmx \
+    kernel/names.cmx library/nametab.cmx interp/ppextend.cmx \
+    pretyping/rawterm.cmx proofs/tacexpr.cmx interp/topconstr.cmx \
+    lib/util.cmx 
+toplevel/vernacinterp.cmo: toplevel/himsg.cmi library/libnames.cmi \
+    kernel/names.cmi lib/options.cmi lib/pp.cmi proofs/proof_type.cmi \
+    proofs/tacexpr.cmo tactics/tacinterp.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi 
+toplevel/vernacinterp.cmx: toplevel/himsg.cmx library/libnames.cmx \
+    kernel/names.cmx lib/options.cmx lib/pp.cmx proofs/proof_type.cmx \
+    proofs/tacexpr.cmx tactics/tacinterp.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx toplevel/vernacinterp.cmi 
+toplevel/vernac.cmo: interp/constrintern.cmi parsing/lexer.cmi \
+    library/lib.cmi library/library.cmi kernel/names.cmi lib/options.cmi \
+    parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi parsing/ppvernac.cmi \
+    library/states.cmi lib/system.cmi lib/util.cmi toplevel/vernacentries.cmi \
+    toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi toplevel/vernac.cmi 
+toplevel/vernac.cmx: interp/constrintern.cmx parsing/lexer.cmx \
+    library/lib.cmx library/library.cmx kernel/names.cmx lib/options.cmx \
+    parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx parsing/ppvernac.cmx \
+    library/states.cmx lib/system.cmx lib/util.cmx toplevel/vernacentries.cmx \
+    toplevel/vernacexpr.cmx toplevel/vernacinterp.cmx toplevel/vernac.cmi 
+toplevel/whelp.cmo: toplevel/cerrors.cmi toplevel/command.cmi \
+    interp/constrintern.cmi pretyping/detyping.cmi \
+    library/dischargedhypsmap.cmi parsing/egrammar.cmi kernel/environ.cmi \
+    interp/genarg.cmi parsing/lexer.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi lib/options.cmi parsing/pcoq.cmi proofs/pfedit.cmi \
+    lib/pp.cmi pretyping/rawterm.cmi proofs/refiner.cmi interp/syntax_def.cmi \
+    lib/system.cmi proofs/tacmach.cmi kernel/term.cmi pretyping/termops.cmi \
+    lib/util.cmi toplevel/vernacinterp.cmi toplevel/whelp.cmi 
+toplevel/whelp.cmx: toplevel/cerrors.cmx toplevel/command.cmx \
+    interp/constrintern.cmx pretyping/detyping.cmx \
+    library/dischargedhypsmap.cmx parsing/egrammar.cmx kernel/environ.cmx \
+    interp/genarg.cmx parsing/lexer.cmx library/libnames.cmx kernel/names.cmx \
+    library/nametab.cmx lib/options.cmx parsing/pcoq.cmx proofs/pfedit.cmx \
+    lib/pp.cmx pretyping/rawterm.cmx proofs/refiner.cmx interp/syntax_def.cmx \
+    lib/system.cmx proofs/tacmach.cmx kernel/term.cmx pretyping/termops.cmx \
+    lib/util.cmx toplevel/vernacinterp.cmx toplevel/whelp.cmi 
+contrib/cc/ccalgo.cmo: library/goptions.cmi kernel/names.cmi lib/pp.cmi \
+    kernel/term.cmi lib/util.cmi contrib/cc/ccalgo.cmi 
+contrib/cc/ccalgo.cmx: library/goptions.cmx kernel/names.cmx lib/pp.cmx \
+    kernel/term.cmx lib/util.cmx contrib/cc/ccalgo.cmi 
+contrib/cc/ccproof.cmo: contrib/cc/ccalgo.cmi kernel/names.cmi lib/util.cmi \
+    contrib/cc/ccproof.cmi 
+contrib/cc/ccproof.cmx: contrib/cc/ccalgo.cmx kernel/names.cmx lib/util.cmx \
+    contrib/cc/ccproof.cmi 
+contrib/cc/cctac.cmo: contrib/cc/ccalgo.cmi contrib/cc/ccproof.cmi \
+    kernel/closure.cmi interp/coqlib.cmi kernel/declarations.cmi \
+    kernel/environ.cmi pretyping/evd.cmi library/global.cmi \
+    pretyping/inductiveops.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi lib/pp.cmi proofs/proof_type.cmi kernel/sign.cmi \
+    tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
+    contrib/cc/cctac.cmi 
+contrib/cc/cctac.cmx: contrib/cc/ccalgo.cmx contrib/cc/ccproof.cmx \
+    kernel/closure.cmx interp/coqlib.cmx kernel/declarations.cmx \
+    kernel/environ.cmx pretyping/evd.cmx library/global.cmx \
+    pretyping/inductiveops.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx lib/pp.cmx proofs/proof_type.cmx kernel/sign.cmx \
+    tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
+    contrib/cc/cctac.cmi 
+contrib/cc/g_congruence.cmo: contrib/cc/cctac.cmi toplevel/cerrors.cmi \
+    parsing/egrammar.cmi interp/genarg.cmi parsing/pcoq.cmi lib/pp.cmi \
+    parsing/pptactic.cmi proofs/refiner.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    lib/util.cmi 
+contrib/cc/g_congruence.cmx: contrib/cc/cctac.cmx toplevel/cerrors.cmx \
+    parsing/egrammar.cmx interp/genarg.cmx parsing/pcoq.cmx lib/pp.cmx \
+    parsing/pptactic.cmx proofs/refiner.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    lib/util.cmx 
+contrib/correctness/pcicenv.cmo: library/global.cmi kernel/names.cmi \
+    kernel/sign.cmi kernel/term.cmi kernel/univ.cmi \
     contrib/correctness/pcicenv.cmi 
-contrib/correctness/pcicenv.cmx: kernel/univ.cmx kernel/term.cmx \
-    kernel/sign.cmx kernel/names.cmx library/global.cmx \
+contrib/correctness/pcicenv.cmx: library/global.cmx kernel/names.cmx \
+    kernel/sign.cmx kernel/term.cmx kernel/univ.cmx \
     contrib/correctness/pcicenv.cmi 
-contrib/correctness/pdb.cmo: pretyping/termops.cmi kernel/term.cmi \
-    library/nametab.cmi kernel/names.cmi library/global.cmi \
-    interp/constrintern.cmi contrib/correctness/pdb.cmi 
-contrib/correctness/pdb.cmx: pretyping/termops.cmx kernel/term.cmx \
-    library/nametab.cmx kernel/names.cmx library/global.cmx \
-    interp/constrintern.cmx contrib/correctness/pdb.cmi 
-contrib/correctness/peffect.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \
-    library/nameops.cmi toplevel/himsg.cmi contrib/correctness/peffect.cmi 
-contrib/correctness/peffect.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx \
-    library/nameops.cmx toplevel/himsg.cmx contrib/correctness/peffect.cmi 
-contrib/correctness/penv.cmo: kernel/term.cmi library/summary.cmi lib/pp.cmi \
-    lib/options.cmi kernel/names.cmi library/nameops.cmi library/library.cmi \
-    library/libobject.cmi library/lib.cmi toplevel/himsg.cmi \
-    contrib/correctness/penv.cmi 
-contrib/correctness/penv.cmx: kernel/term.cmx library/summary.cmx lib/pp.cmx \
-    lib/options.cmx kernel/names.cmx library/nameops.cmx library/library.cmx \
-    library/libobject.cmx library/lib.cmx toplevel/himsg.cmx \
-    contrib/correctness/penv.cmi 
-contrib/correctness/perror.cmo: lib/util.cmi kernel/term.cmi \
-    pretyping/reductionops.cmi lib/pp.cmi kernel/names.cmi \
-    library/nameops.cmi toplevel/himsg.cmi library/global.cmi \
-    pretyping/evd.cmi interp/constrintern.cmi contrib/correctness/perror.cmi 
-contrib/correctness/perror.cmx: lib/util.cmx kernel/term.cmx \
-    pretyping/reductionops.cmx lib/pp.cmx kernel/names.cmx \
-    library/nameops.cmx toplevel/himsg.cmx library/global.cmx \
-    pretyping/evd.cmx interp/constrintern.cmx contrib/correctness/perror.cmi 
-contrib/correctness/pextract.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
-    kernel/term.cmi lib/system.cmi pretyping/reductionops.cmi \
-    kernel/reduction.cmi lib/pp_control.cmi lib/pp.cmi \
-    contrib/extraction/ocaml.cmi library/nametab.cmi kernel/names.cmi \
-    library/library.cmi toplevel/himsg.cmi pretyping/evd.cmi parsing/ast.cmi \
+contrib/correctness/pcic.cmo: kernel/declarations.cmi library/declare.cmi \
+    pretyping/detyping.cmi kernel/entries.cmi library/global.cmi \
+    kernel/indtypes.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi pretyping/rawterm.cmi \
+    toplevel/record.cmi kernel/sign.cmi kernel/term.cmi pretyping/termops.cmi \
+    interp/topconstr.cmi kernel/typeops.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo contrib/correctness/pcic.cmi 
+contrib/correctness/pcic.cmx: kernel/declarations.cmx library/declare.cmx \
+    pretyping/detyping.cmx kernel/entries.cmx library/global.cmx \
+    kernel/indtypes.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx pretyping/rawterm.cmx \
+    toplevel/record.cmx kernel/sign.cmx kernel/term.cmx pretyping/termops.cmx \
+    interp/topconstr.cmx kernel/typeops.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx contrib/correctness/pcic.cmi 
+contrib/correctness/pdb.cmo: interp/constrintern.cmi library/global.cmi \
+    kernel/names.cmi library/nametab.cmi kernel/term.cmi \
+    pretyping/termops.cmi contrib/correctness/pdb.cmi 
+contrib/correctness/pdb.cmx: interp/constrintern.cmx library/global.cmx \
+    kernel/names.cmx library/nametab.cmx kernel/term.cmx \
+    pretyping/termops.cmx contrib/correctness/pdb.cmi 
+contrib/correctness/peffect.cmo: toplevel/himsg.cmi library/nameops.cmi \
+    kernel/names.cmi lib/pp.cmi lib/util.cmi contrib/correctness/peffect.cmi 
+contrib/correctness/peffect.cmx: toplevel/himsg.cmx library/nameops.cmx \
+    kernel/names.cmx lib/pp.cmx lib/util.cmx contrib/correctness/peffect.cmi 
+contrib/correctness/penv.cmo: toplevel/himsg.cmi library/lib.cmi \
+    library/libobject.cmi library/library.cmi library/nameops.cmi \
+    kernel/names.cmi lib/options.cmi lib/pp.cmi library/summary.cmi \
+    kernel/term.cmi contrib/correctness/penv.cmi 
+contrib/correctness/penv.cmx: toplevel/himsg.cmx library/lib.cmx \
+    library/libobject.cmx library/library.cmx library/nameops.cmx \
+    kernel/names.cmx lib/options.cmx lib/pp.cmx library/summary.cmx \
+    kernel/term.cmx contrib/correctness/penv.cmi 
+contrib/correctness/perror.cmo: interp/constrintern.cmi pretyping/evd.cmi \
+    library/global.cmi toplevel/himsg.cmi library/nameops.cmi \
+    kernel/names.cmi lib/pp.cmi pretyping/reductionops.cmi kernel/term.cmi \
+    lib/util.cmi contrib/correctness/perror.cmi 
+contrib/correctness/perror.cmx: interp/constrintern.cmx pretyping/evd.cmx \
+    library/global.cmx toplevel/himsg.cmx library/nameops.cmx \
+    kernel/names.cmx lib/pp.cmx pretyping/reductionops.cmx kernel/term.cmx \
+    lib/util.cmx contrib/correctness/perror.cmi 
+contrib/correctness/pextract.cmo: pretyping/evd.cmi toplevel/himsg.cmi \
+    library/library.cmi kernel/names.cmi library/nametab.cmi \
+    contrib/extraction/ocaml.cmi lib/pp.cmi lib/pp_control.cmi \
+    kernel/reduction.cmi pretyping/reductionops.cmi lib/system.cmi \
+    kernel/term.cmi lib/util.cmi toplevel/vernacinterp.cmi \
     contrib/correctness/pextract.cmi 
-contrib/correctness/pextract.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
-    kernel/term.cmx lib/system.cmx pretyping/reductionops.cmx \
-    kernel/reduction.cmx lib/pp_control.cmx lib/pp.cmx \
-    contrib/extraction/ocaml.cmx library/nametab.cmx kernel/names.cmx \
-    library/library.cmx toplevel/himsg.cmx pretyping/evd.cmx parsing/ast.cmx \
+contrib/correctness/pextract.cmx: pretyping/evd.cmx toplevel/himsg.cmx \
+    library/library.cmx kernel/names.cmx library/nametab.cmx \
+    contrib/extraction/ocaml.cmx lib/pp.cmx lib/pp_control.cmx \
+    kernel/reduction.cmx pretyping/reductionops.cmx lib/system.cmx \
+    kernel/term.cmx lib/util.cmx toplevel/vernacinterp.cmx \
     contrib/correctness/pextract.cmi 
-contrib/correctness/pmisc.cmo: lib/util.cmi interp/topconstr.cmi \
-    kernel/term.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \
-    library/nameops.cmi library/libnames.cmi library/global.cmi \
-    pretyping/evarutil.cmi interp/constrintern.cmi interp/constrextern.cmi \
+contrib/correctness/pmisc.cmo: interp/constrextern.cmi \
+    interp/constrintern.cmi pretyping/evarutil.cmi library/global.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi lib/options.cmi \
+    lib/pp.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi \
     contrib/correctness/pmisc.cmi 
-contrib/correctness/pmisc.cmx: lib/util.cmx interp/topconstr.cmx \
-    kernel/term.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \
-    library/nameops.cmx library/libnames.cmx library/global.cmx \
-    pretyping/evarutil.cmx interp/constrintern.cmx interp/constrextern.cmx \
+contrib/correctness/pmisc.cmx: interp/constrextern.cmx \
+    interp/constrintern.cmx pretyping/evarutil.cmx library/global.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx lib/options.cmx \
+    lib/pp.cmx kernel/term.cmx interp/topconstr.cmx lib/util.cmx \
     contrib/correctness/pmisc.cmi 
-contrib/correctness/pmlize.cmo: lib/util.cmi pretyping/typing.cmi \
-    parsing/termast.cmi kernel/term.cmi pretyping/reductionops.cmi \
-    pretyping/pattern.cmi kernel/names.cmi pretyping/matching.cmi \
-    tactics/hipattern.cmi library/global.cmi pretyping/evd.cmi \
-    contrib/correctness/pmlize.cmi 
-contrib/correctness/pmlize.cmx: lib/util.cmx pretyping/typing.cmx \
-    parsing/termast.cmx kernel/term.cmx pretyping/reductionops.cmx \
-    pretyping/pattern.cmx kernel/names.cmx pretyping/matching.cmx \
-    tactics/hipattern.cmx library/global.cmx pretyping/evd.cmx \
-    contrib/correctness/pmlize.cmi 
-contrib/correctness/pmonad.cmo: lib/util.cmi parsing/termast.cmi \
-    kernel/term.cmi kernel/names.cmi contrib/correctness/pmonad.cmi 
-contrib/correctness/pmonad.cmx: lib/util.cmx parsing/termast.cmx \
-    kernel/term.cmx kernel/names.cmx contrib/correctness/pmonad.cmi 
-contrib/correctness/pred.cmo: kernel/term.cmi pretyping/reductionops.cmi \
-    lib/pp.cmi library/global.cmi pretyping/evd.cmi \
-    contrib/correctness/pred.cmi 
-contrib/correctness/pred.cmx: kernel/term.cmx pretyping/reductionops.cmx \
-    lib/pp.cmx library/global.cmx pretyping/evd.cmx \
-    contrib/correctness/pred.cmi 
-contrib/correctness/prename.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi \
-    library/nameops.cmi toplevel/himsg.cmi contrib/correctness/prename.cmi 
-contrib/correctness/prename.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx \
-    library/nameops.cmx toplevel/himsg.cmx contrib/correctness/prename.cmi 
-contrib/correctness/ptactic.cmo: toplevel/vernacentries.cmi lib/util.cmi \
-    pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi proofs/tacmach.cmi kernel/reduction.cmi \
-    parsing/printer.cmi pretyping/pretyping.cmi lib/pp.cmi proofs/pfedit.cmi \
-    pretyping/pattern.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi library/library.cmi \
-    library/libnames.cmi library/global.cmi tactics/extratactics.cmi \
-    pretyping/evd.cmi tactics/equality.cmi library/decl_kinds.cmo \
-    contrib/correctness/ptactic.cmi 
-contrib/correctness/ptactic.cmx: toplevel/vernacentries.cmx lib/util.cmx \
-    pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx proofs/tacmach.cmx kernel/reduction.cmx \
-    parsing/printer.cmx pretyping/pretyping.cmx lib/pp.cmx proofs/pfedit.cmx \
-    pretyping/pattern.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx library/library.cmx \
-    library/libnames.cmx library/global.cmx tactics/extratactics.cmx \
-    pretyping/evd.cmx tactics/equality.cmx library/decl_kinds.cmx \
-    contrib/correctness/ptactic.cmi 
-contrib/correctness/ptyping.cmo: lib/util.cmi pretyping/typing.cmi \
-    interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \
-    pretyping/reductionops.cmi proofs/proof_trees.cmi lib/pp.cmi \
-    kernel/names.cmi toplevel/himsg.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi interp/constrintern.cmi \
-    contrib/correctness/ptyping.cmi 
-contrib/correctness/ptyping.cmx: lib/util.cmx pretyping/typing.cmx \
-    interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \
-    pretyping/reductionops.cmx proofs/proof_trees.cmx lib/pp.cmx \
-    kernel/names.cmx toplevel/himsg.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx interp/constrintern.cmx \
-    contrib/correctness/ptyping.cmi 
-contrib/correctness/putil.cmo: lib/util.cmi pretyping/termops.cmi \
-    kernel/term.cmi parsing/printer.cmi lib/pp.cmi pretyping/pattern.cmi \
-    kernel/names.cmi library/nameops.cmi pretyping/matching.cmi \
-    tactics/hipattern.cmi library/global.cmi kernel/environ.cmi \
+contrib/correctness/pmlize.cmo: pretyping/evd.cmi library/global.cmi \
+    tactics/hipattern.cmi pretyping/matching.cmi kernel/names.cmi \
+    pretyping/pattern.cmi pretyping/reductionops.cmi kernel/term.cmi \
+    pretyping/typing.cmi lib/util.cmi contrib/correctness/pmlize.cmi 
+contrib/correctness/pmlize.cmx: pretyping/evd.cmx library/global.cmx \
+    tactics/hipattern.cmx pretyping/matching.cmx kernel/names.cmx \
+    pretyping/pattern.cmx pretyping/reductionops.cmx kernel/term.cmx \
+    pretyping/typing.cmx lib/util.cmx contrib/correctness/pmlize.cmi 
+contrib/correctness/pmonad.cmo: kernel/names.cmi kernel/term.cmi lib/util.cmi \
+    contrib/correctness/pmonad.cmi 
+contrib/correctness/pmonad.cmx: kernel/names.cmx kernel/term.cmx lib/util.cmx \
+    contrib/correctness/pmonad.cmi 
+contrib/correctness/pred.cmo: pretyping/evd.cmi library/global.cmi lib/pp.cmi \
+    pretyping/reductionops.cmi kernel/term.cmi contrib/correctness/pred.cmi 
+contrib/correctness/pred.cmx: pretyping/evd.cmx library/global.cmx lib/pp.cmx \
+    pretyping/reductionops.cmx kernel/term.cmx contrib/correctness/pred.cmi 
+contrib/correctness/prename.cmo: toplevel/himsg.cmi library/nameops.cmi \
+    kernel/names.cmi lib/pp.cmi lib/util.cmi contrib/correctness/prename.cmi 
+contrib/correctness/prename.cmx: toplevel/himsg.cmx library/nameops.cmx \
+    kernel/names.cmx lib/pp.cmx lib/util.cmx contrib/correctness/prename.cmi 
+contrib/correctness/ptactic.cmo: interp/coqlib.cmi library/decl_kinds.cmo \
+    tactics/equality.cmi pretyping/evd.cmi tactics/extratactics.cmi \
+    library/global.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    pretyping/pattern.cmi proofs/pfedit.cmi lib/pp.cmi \
+    pretyping/pretyping.cmi parsing/printer.cmi kernel/reduction.cmi \
+    proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
+    toplevel/vernacentries.cmi contrib/correctness/ptactic.cmi 
+contrib/correctness/ptactic.cmx: interp/coqlib.cmx library/decl_kinds.cmx \
+    tactics/equality.cmx pretyping/evd.cmx tactics/extratactics.cmx \
+    library/global.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    pretyping/pattern.cmx proofs/pfedit.cmx lib/pp.cmx \
+    pretyping/pretyping.cmx parsing/printer.cmx kernel/reduction.cmx \
+    proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
+    toplevel/vernacentries.cmx contrib/correctness/ptactic.cmi 
+contrib/correctness/ptyping.cmo: interp/constrintern.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi toplevel/himsg.cmi kernel/names.cmi \
+    lib/pp.cmi proofs/proof_trees.cmi pretyping/reductionops.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \
+    pretyping/typing.cmi lib/util.cmi contrib/correctness/ptyping.cmi 
+contrib/correctness/ptyping.cmx: interp/constrintern.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx toplevel/himsg.cmx kernel/names.cmx \
+    lib/pp.cmx proofs/proof_trees.cmx pretyping/reductionops.cmx \
+    kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \
+    pretyping/typing.cmx lib/util.cmx contrib/correctness/ptyping.cmi 
+contrib/correctness/putil.cmo: kernel/environ.cmi library/global.cmi \
+    tactics/hipattern.cmi pretyping/matching.cmi library/nameops.cmi \
+    kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi parsing/printer.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
     contrib/correctness/putil.cmi 
-contrib/correctness/putil.cmx: lib/util.cmx pretyping/termops.cmx \
-    kernel/term.cmx parsing/printer.cmx lib/pp.cmx pretyping/pattern.cmx \
-    kernel/names.cmx library/nameops.cmx pretyping/matching.cmx \
-    tactics/hipattern.cmx library/global.cmx kernel/environ.cmx \
+contrib/correctness/putil.cmx: kernel/environ.cmx library/global.cmx \
+    tactics/hipattern.cmx pretyping/matching.cmx library/nameops.cmx \
+    kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx parsing/printer.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
     contrib/correctness/putil.cmi 
-contrib/correctness/pwp.cmo: lib/util.cmi pretyping/termops.cmi \
-    kernel/term.cmi pretyping/reductionops.cmi kernel/reduction.cmi \
-    library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    tactics/hipattern.cmi library/global.cmi kernel/environ.cmi \
+contrib/correctness/pwp.cmo: kernel/environ.cmi library/global.cmi \
+    tactics/hipattern.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
     contrib/correctness/pwp.cmi 
-contrib/correctness/pwp.cmx: lib/util.cmx pretyping/termops.cmx \
-    kernel/term.cmx pretyping/reductionops.cmx kernel/reduction.cmx \
-    library/nametab.cmx kernel/names.cmx library/libnames.cmx \
-    tactics/hipattern.cmx library/global.cmx kernel/environ.cmx \
+contrib/correctness/pwp.cmx: kernel/environ.cmx library/global.cmx \
+    tactics/hipattern.cmx library/libnames.cmx kernel/names.cmx \
+    library/nametab.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
     contrib/correctness/pwp.cmi 
-contrib/extraction/common.cmo: lib/util.cmi kernel/term.cmi \
-    contrib/extraction/table.cmi contrib/extraction/scheme.cmi \
-    lib/pp_control.cmi lib/pp.cmi lib/options.cmi \
-    contrib/extraction/ocaml.cmi kernel/names.cmi library/nameops.cmi \
-    contrib/extraction/modutil.cmi kernel/modops.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi \
-    contrib/extraction/haskell.cmi lib/gset.cmi library/global.cmi \
-    contrib/extraction/extraction.cmi kernel/declarations.cmi \
+contrib/dp/dp_cvcl.cmo: contrib/dp/fol.cmi contrib/dp/dp_cvcl.cmi 
+contrib/dp/dp_cvcl.cmx: contrib/dp/fol.cmi contrib/dp/dp_cvcl.cmi 
+contrib/dp/dp.cmo: interp/coqlib.cmi kernel/declarations.cmi \
+    contrib/dp/dp_why.cmo kernel/environ.cmi pretyping/evd.cmi \
+    contrib/dp/fol.cmi library/global.cmi tactics/hipattern.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi parsing/printer.cmi \
+    pretyping/reductionops.cmi library/summary.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi contrib/dp/dp.cmi 
+contrib/dp/dp.cmx: interp/coqlib.cmx kernel/declarations.cmx \
+    contrib/dp/dp_why.cmx kernel/environ.cmx pretyping/evd.cmx \
+    contrib/dp/fol.cmi library/global.cmx tactics/hipattern.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx parsing/printer.cmx \
+    pretyping/reductionops.cmx library/summary.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx contrib/dp/dp.cmi 
+contrib/dp/dp_simplify.cmo: contrib/dp/fol.cmi contrib/dp/dp_simplify.cmi 
+contrib/dp/dp_simplify.cmx: contrib/dp/fol.cmi contrib/dp/dp_simplify.cmi 
+contrib/dp/dp_sorts.cmo: contrib/dp/fol.cmi contrib/dp/dp_sorts.cmi 
+contrib/dp/dp_sorts.cmx: contrib/dp/fol.cmi contrib/dp/dp_sorts.cmi 
+contrib/dp/dp_why.cmo: contrib/dp/fol.cmi 
+contrib/dp/dp_why.cmx: contrib/dp/fol.cmi 
+contrib/dp/dp_zenon.cmo: contrib/dp/fol.cmi lib/util.cmi \
+    contrib/dp/dp_zenon.cmi 
+contrib/dp/dp_zenon.cmx: contrib/dp/fol.cmi lib/util.cmx \
+    contrib/dp/dp_zenon.cmi 
+contrib/dp/g_dp.cmo: toplevel/cerrors.cmi contrib/dp/dp.cmi \
+    parsing/egrammar.cmi interp/genarg.cmi parsing/pcoq.cmi lib/pp.cmi \
+    parsing/pptactic.cmi proofs/refiner.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi tactics/tactics.cmi lib/util.cmi \
+    toplevel/vernacinterp.cmi 
+contrib/dp/g_dp.cmx: toplevel/cerrors.cmx contrib/dp/dp.cmx \
+    parsing/egrammar.cmx interp/genarg.cmx parsing/pcoq.cmx lib/pp.cmx \
+    parsing/pptactic.cmx proofs/refiner.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx tactics/tactics.cmx lib/util.cmx \
+    toplevel/vernacinterp.cmx 
+contrib/extraction/common.cmo: kernel/declarations.cmi \
+    contrib/extraction/extraction.cmi library/global.cmi lib/gset.cmi \
+    contrib/extraction/haskell.cmi library/libnames.cmi \
+    contrib/extraction/miniml.cmi kernel/modops.cmi \
+    contrib/extraction/modutil.cmi library/nameops.cmi kernel/names.cmi \
+    contrib/extraction/ocaml.cmi lib/options.cmi lib/pp.cmi \
+    lib/pp_control.cmi contrib/extraction/scheme.cmi \
+    contrib/extraction/table.cmi kernel/term.cmi lib/util.cmi \
     contrib/extraction/common.cmi 
-contrib/extraction/common.cmx: lib/util.cmx kernel/term.cmx \
-    contrib/extraction/table.cmx contrib/extraction/scheme.cmx \
-    lib/pp_control.cmx lib/pp.cmx lib/options.cmx \
-    contrib/extraction/ocaml.cmx kernel/names.cmx library/nameops.cmx \
-    contrib/extraction/modutil.cmx kernel/modops.cmx \
-    contrib/extraction/miniml.cmi library/libnames.cmx \
-    contrib/extraction/haskell.cmx lib/gset.cmx library/global.cmx \
-    contrib/extraction/extraction.cmx kernel/declarations.cmx \
+contrib/extraction/common.cmx: kernel/declarations.cmx \
+    contrib/extraction/extraction.cmx library/global.cmx lib/gset.cmx \
+    contrib/extraction/haskell.cmx library/libnames.cmx \
+    contrib/extraction/miniml.cmi kernel/modops.cmx \
+    contrib/extraction/modutil.cmx library/nameops.cmx kernel/names.cmx \
+    contrib/extraction/ocaml.cmx lib/options.cmx lib/pp.cmx \
+    lib/pp_control.cmx contrib/extraction/scheme.cmx \
+    contrib/extraction/table.cmx kernel/term.cmx lib/util.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 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.cmo: contrib/extraction/common.cmi \
+    kernel/declarations.cmi contrib/extraction/extraction.cmi \
+    library/global.cmi library/lib.cmi library/libnames.cmi \
+    library/libobject.cmi library/library.cmi contrib/extraction/miniml.cmi \
+    kernel/mod_subst.cmi kernel/modops.cmi contrib/extraction/modutil.cmi \
+    kernel/names.cmi library/nametab.cmi lib/pp.cmi kernel/reduction.cmi \
+    contrib/extraction/table.cmi kernel/term.cmi lib/util.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 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.cmx: contrib/extraction/common.cmx \
+    kernel/declarations.cmx contrib/extraction/extraction.cmx \
+    library/global.cmx library/lib.cmx library/libnames.cmx \
+    library/libobject.cmx library/library.cmx contrib/extraction/miniml.cmi \
+    kernel/mod_subst.cmx kernel/modops.cmx contrib/extraction/modutil.cmx \
+    kernel/names.cmx library/nametab.cmx lib/pp.cmx kernel/reduction.cmx \
+    contrib/extraction/table.cmx kernel/term.cmx lib/util.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/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/miniml.cmi library/libnames.cmx \
-    pretyping/inductiveops.cmx kernel/inductive.cmx pretyping/evd.cmx \
-    kernel/environ.cmx kernel/declarations.cmx \
-    contrib/extraction/extraction.cmi 
-contrib/extraction/g_extraction.cmo: toplevel/vernacinterp.cmi \
-    toplevel/vernacexpr.cmo lib/util.cmi tactics/tacinterp.cmi \
-    contrib/extraction/table.cmi translate/pptacticnew.cmi \
-    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.cmi \
-    interp/genarg.cmi contrib/extraction/extract_env.cmi parsing/extend.cmi \
-    parsing/egrammar.cmi toplevel/cerrors.cmi 
-contrib/extraction/g_extraction.cmx: toplevel/vernacinterp.cmx \
-    toplevel/vernacexpr.cmx lib/util.cmx tactics/tacinterp.cmx \
-    contrib/extraction/table.cmx translate/pptacticnew.cmx \
-    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx lib/options.cmx \
-    interp/genarg.cmx contrib/extraction/extract_env.cmx parsing/extend.cmx \
-    parsing/egrammar.cmx toplevel/cerrors.cmx 
-contrib/extraction/haskell.cmo: lib/util.cmi contrib/extraction/table.cmi \
-    lib/pp.cmi contrib/extraction/ocaml.cmi kernel/names.cmi \
-    library/nameops.cmi contrib/extraction/mlutil.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi \
+contrib/extraction/extraction.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \
+    library/libnames.cmi contrib/extraction/miniml.cmi \
+    contrib/extraction/mlutil.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi pretyping/recordops.cmi kernel/reduction.cmi \
+    pretyping/reductionops.cmi pretyping/retyping.cmi library/summary.cmi \
+    contrib/extraction/table.cmi kernel/term.cmi pretyping/termops.cmi \
+    lib/util.cmi contrib/extraction/extraction.cmi 
+contrib/extraction/extraction.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    pretyping/evd.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \
+    library/libnames.cmx contrib/extraction/miniml.cmi \
+    contrib/extraction/mlutil.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx pretyping/recordops.cmx kernel/reduction.cmx \
+    pretyping/reductionops.cmx pretyping/retyping.cmx library/summary.cmx \
+    contrib/extraction/table.cmx kernel/term.cmx pretyping/termops.cmx \
+    lib/util.cmx contrib/extraction/extraction.cmi 
+contrib/extraction/g_extraction.cmo: toplevel/cerrors.cmi \
+    parsing/egrammar.cmi contrib/extraction/extract_env.cmi interp/genarg.cmi \
+    parsing/lexer.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    contrib/extraction/table.cmi tactics/tacinterp.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi 
+contrib/extraction/g_extraction.cmx: toplevel/cerrors.cmx \
+    parsing/egrammar.cmx contrib/extraction/extract_env.cmx interp/genarg.cmx \
+    parsing/lexer.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    contrib/extraction/table.cmx tactics/tacinterp.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx toplevel/vernacinterp.cmx 
+contrib/extraction/haskell.cmo: library/libnames.cmi \
+    contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmi \
+    library/nameops.cmi kernel/names.cmi contrib/extraction/ocaml.cmi \
+    lib/pp.cmi contrib/extraction/table.cmi lib/util.cmi \
     contrib/extraction/haskell.cmi 
-contrib/extraction/haskell.cmx: lib/util.cmx contrib/extraction/table.cmx \
-    lib/pp.cmx contrib/extraction/ocaml.cmx kernel/names.cmx \
-    library/nameops.cmx contrib/extraction/mlutil.cmx \
-    contrib/extraction/miniml.cmi library/libnames.cmx \
+contrib/extraction/haskell.cmx: library/libnames.cmx \
+    contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmx \
+    library/nameops.cmx kernel/names.cmx contrib/extraction/ocaml.cmx \
+    lib/pp.cmx contrib/extraction/table.cmx lib/util.cmx \
     contrib/extraction/haskell.cmi 
-contrib/extraction/mlutil.cmo: lib/util.cmi contrib/extraction/table.cmi \
-    lib/pp.cmi library/nametab.cmi kernel/names.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi \
+contrib/extraction/mlutil.cmo: library/libnames.cmi \
+    contrib/extraction/miniml.cmi kernel/names.cmi library/nametab.cmi \
+    lib/pp.cmi contrib/extraction/table.cmi lib/util.cmi \
     contrib/extraction/mlutil.cmi 
-contrib/extraction/mlutil.cmx: lib/util.cmx contrib/extraction/table.cmx \
-    lib/pp.cmx library/nametab.cmx kernel/names.cmx \
-    contrib/extraction/miniml.cmi library/libnames.cmx \
+contrib/extraction/mlutil.cmx: library/libnames.cmx \
+    contrib/extraction/miniml.cmi kernel/names.cmx library/nametab.cmx \
+    lib/pp.cmx contrib/extraction/table.cmx lib/util.cmx \
     contrib/extraction/mlutil.cmi 
-contrib/extraction/modutil.cmo: lib/util.cmi contrib/extraction/table.cmi \
-    kernel/names.cmi kernel/modops.cmi contrib/extraction/mlutil.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi kernel/environ.cmi \
-    kernel/declarations.cmi contrib/extraction/modutil.cmi 
-contrib/extraction/modutil.cmx: lib/util.cmx contrib/extraction/table.cmx \
-    kernel/names.cmx kernel/modops.cmx contrib/extraction/mlutil.cmx \
-    contrib/extraction/miniml.cmi library/libnames.cmx kernel/environ.cmx \
-    kernel/declarations.cmx contrib/extraction/modutil.cmi 
-contrib/extraction/ocaml.cmo: lib/util.cmi contrib/extraction/table.cmi \
-    lib/pp.cmi kernel/names.cmi library/nameops.cmi \
-    contrib/extraction/modutil.cmi contrib/extraction/mlutil.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi \
+contrib/extraction/modutil.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    library/libnames.cmi contrib/extraction/miniml.cmi \
+    contrib/extraction/mlutil.cmi kernel/mod_subst.cmi kernel/modops.cmi \
+    kernel/names.cmi contrib/extraction/table.cmi lib/util.cmi \
+    contrib/extraction/modutil.cmi 
+contrib/extraction/modutil.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    library/libnames.cmx contrib/extraction/miniml.cmi \
+    contrib/extraction/mlutil.cmx kernel/mod_subst.cmx kernel/modops.cmx \
+    kernel/names.cmx contrib/extraction/table.cmx lib/util.cmx \
+    contrib/extraction/modutil.cmi 
+contrib/extraction/ocaml.cmo: library/libnames.cmi \
+    contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmi \
+    contrib/extraction/modutil.cmi library/nameops.cmi kernel/names.cmi \
+    lib/pp.cmi contrib/extraction/table.cmi lib/util.cmi \
     contrib/extraction/ocaml.cmi 
-contrib/extraction/ocaml.cmx: lib/util.cmx contrib/extraction/table.cmx \
-    lib/pp.cmx kernel/names.cmx library/nameops.cmx \
-    contrib/extraction/modutil.cmx contrib/extraction/mlutil.cmx \
-    contrib/extraction/miniml.cmi library/libnames.cmx \
+contrib/extraction/ocaml.cmx: library/libnames.cmx \
+    contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmx \
+    contrib/extraction/modutil.cmx library/nameops.cmx kernel/names.cmx \
+    lib/pp.cmx contrib/extraction/table.cmx lib/util.cmx \
     contrib/extraction/ocaml.cmi 
-contrib/extraction/scheme.cmo: lib/util.cmi contrib/extraction/table.cmi \
-    lib/pp.cmi contrib/extraction/ocaml.cmi kernel/names.cmi \
-    library/nameops.cmi contrib/extraction/mlutil.cmi \
-    contrib/extraction/miniml.cmi library/libnames.cmi \
+contrib/extraction/scheme.cmo: library/libnames.cmi \
+    contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmi \
+    library/nameops.cmi kernel/names.cmi contrib/extraction/ocaml.cmi \
+    lib/pp.cmi contrib/extraction/table.cmi lib/util.cmi \
     contrib/extraction/scheme.cmi 
-contrib/extraction/scheme.cmx: lib/util.cmx contrib/extraction/table.cmx \
-    lib/pp.cmx contrib/extraction/ocaml.cmx kernel/names.cmx \
-    library/nameops.cmx contrib/extraction/mlutil.cmx \
-    contrib/extraction/miniml.cmi library/libnames.cmx \
+contrib/extraction/scheme.cmx: library/libnames.cmx \
+    contrib/extraction/miniml.cmi contrib/extraction/mlutil.cmx \
+    library/nameops.cmx kernel/names.cmx contrib/extraction/ocaml.cmx \
+    lib/pp.cmx contrib/extraction/table.cmx lib/util.cmx \
     contrib/extraction/scheme.cmi 
-contrib/extraction/table.cmo: lib/util.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 \
-    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 \
-    library/lib.cmx library/goptions.cmx library/global.cmx \
-    kernel/environ.cmx kernel/declarations.cmx contrib/extraction/table.cmi 
-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 \
-    translate/ppconstrnew.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.cmi \
-    kernel/names.cmi library/library.cmi library/libobject.cmi \
-    library/libnames.cmi library/lib.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 \
-    translate/ppconstrnew.cmx lib/pp.cmx parsing/pcoq.cmx lib/options.cmx \
-    kernel/names.cmx library/library.cmx library/libobject.cmx \
-    library/libnames.cmx library/lib.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 \
-    kernel/term.cmi proofs/tacmach.cmi kernel/sign.cmi \
-    pretyping/reductionops.cmi kernel/names.cmi library/libnames.cmi \
-    pretyping/inductiveops.cmi kernel/inductive.cmi tactics/hipattern.cmi \
-    library/global.cmi kernel/declarations.cmi kernel/closure.cmi \
-    contrib/first-order/formula.cmi 
-contrib/first-order/formula.cmx: lib/util.cmx pretyping/termops.cmx \
-    kernel/term.cmx proofs/tacmach.cmx kernel/sign.cmx \
-    pretyping/reductionops.cmx kernel/names.cmx library/libnames.cmx \
-    pretyping/inductiveops.cmx kernel/inductive.cmx tactics/hipattern.cmx \
-    library/global.cmx kernel/declarations.cmx kernel/closure.cmx \
-    contrib/first-order/formula.cmi 
-contrib/first-order/g_ground.cmo: lib/util.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo contrib/first-order/sequent.cmi proofs/refiner.cmi \
-    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.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 
-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 lib/options.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 
-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 \
-    contrib/first-order/rules.cmi proofs/proof_trees.cmi lib/pp.cmi \
-    kernel/names.cmi library/libnames.cmi contrib/first-order/instances.cmi \
-    lib/heap.cmi contrib/first-order/formula.cmi kernel/closure.cmi \
-    pretyping/classops.cmi contrib/first-order/ground.cmi 
-contrib/first-order/ground.cmx: kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx proofs/tactic_debug.cmx proofs/tacmach.cmx \
-    tactics/tacinterp.cmx contrib/first-order/sequent.cmx \
-    contrib/first-order/rules.cmx proofs/proof_trees.cmx lib/pp.cmx \
-    kernel/names.cmx library/libnames.cmx contrib/first-order/instances.cmx \
-    lib/heap.cmx contrib/first-order/formula.cmx kernel/closure.cmx \
-    pretyping/classops.cmx contrib/first-order/ground.cmi 
-contrib/first-order/instances.cmo: lib/util.cmi contrib/first-order/unify.cmi \
-    pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi proofs/tacmach.cmi kernel/sign.cmi \
-    contrib/first-order/sequent.cmi contrib/first-order/rules.cmi \
-    proofs/refiner.cmi pretyping/reductionops.cmi pretyping/rawterm.cmi \
-    pretyping/pretyping.cmi kernel/names.cmi library/libnames.cmi \
-    lib/heap.cmi contrib/first-order/formula.cmi pretyping/detyping.cmi \
-    kernel/declarations.cmi contrib/first-order/instances.cmi 
-contrib/first-order/instances.cmx: lib/util.cmx contrib/first-order/unify.cmx \
-    pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx proofs/tacmach.cmx kernel/sign.cmx \
-    contrib/first-order/sequent.cmx contrib/first-order/rules.cmx \
-    proofs/refiner.cmx pretyping/reductionops.cmx pretyping/rawterm.cmx \
-    pretyping/pretyping.cmx kernel/names.cmx library/libnames.cmx \
-    lib/heap.cmx contrib/first-order/formula.cmx pretyping/detyping.cmx \
-    kernel/declarations.cmx contrib/first-order/instances.cmi 
-contrib/first-order/rules.cmo: lib/util.cmi pretyping/termops.cmi \
-    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
-    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \
-    contrib/first-order/sequent.cmi kernel/names.cmi library/libnames.cmi \
-    contrib/first-order/formula.cmi kernel/declarations.cmi interp/coqlib.cmi \
+contrib/extraction/table.cmo: kernel/declarations.cmi kernel/environ.cmi \
+    library/global.cmi library/goptions.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi contrib/extraction/miniml.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi lib/options.cmi \
+    lib/pp.cmi parsing/printer.cmi kernel/reduction.cmi library/summary.cmi \
+    kernel/term.cmi lib/util.cmi contrib/extraction/table.cmi 
+contrib/extraction/table.cmx: kernel/declarations.cmx kernel/environ.cmx \
+    library/global.cmx library/goptions.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx contrib/extraction/miniml.cmi \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx lib/options.cmx \
+    lib/pp.cmx parsing/printer.cmx kernel/reduction.cmx library/summary.cmx \
+    kernel/term.cmx lib/util.cmx contrib/extraction/table.cmi 
+contrib/field/field.cmo: toplevel/cerrors.cmi interp/constrintern.cmi \
+    interp/coqlib.cmi parsing/egrammar.cmi pretyping/evd.cmi \
+    parsing/extend.cmi interp/genarg.cmi library/global.cmi lib/gmap.cmi \
+    tactics/hipattern.cmi parsing/lexer.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi kernel/mod_subst.cmi \
+    kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi parsing/ppconstr.cmi \
+    parsing/pptactic.cmi parsing/printer.cmi proofs/proof_type.cmi \
+    contrib/ring/quote.cmo pretyping/reductionops.cmi proofs/refiner.cmi \
+    contrib/ring/ring.cmo library/summary.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \
+    kernel/term.cmi interp/topconstr.cmi pretyping/typing.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo toplevel/vernacinterp.cmi 
+contrib/field/field.cmx: toplevel/cerrors.cmx interp/constrintern.cmx \
+    interp/coqlib.cmx parsing/egrammar.cmx pretyping/evd.cmx \
+    parsing/extend.cmx interp/genarg.cmx library/global.cmx lib/gmap.cmx \
+    tactics/hipattern.cmx parsing/lexer.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx kernel/mod_subst.cmx \
+    kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx parsing/ppconstr.cmx \
+    parsing/pptactic.cmx parsing/printer.cmx proofs/proof_type.cmx \
+    contrib/ring/quote.cmx pretyping/reductionops.cmx proofs/refiner.cmx \
+    contrib/ring/ring.cmx library/summary.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    kernel/term.cmx interp/topconstr.cmx pretyping/typing.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx toplevel/vernacinterp.cmx 
+contrib/first-order/formula.cmo: kernel/closure.cmi kernel/declarations.cmi \
+    library/global.cmi tactics/hipattern.cmi pretyping/inductiveops.cmi \
+    library/libnames.cmi kernel/names.cmi pretyping/reductionops.cmi \
+    kernel/sign.cmi proofs/tacmach.cmi kernel/term.cmi pretyping/termops.cmi \
+    lib/util.cmi contrib/first-order/formula.cmi 
+contrib/first-order/formula.cmx: kernel/closure.cmx kernel/declarations.cmx \
+    library/global.cmx tactics/hipattern.cmx pretyping/inductiveops.cmx \
+    library/libnames.cmx kernel/names.cmx pretyping/reductionops.cmx \
+    kernel/sign.cmx proofs/tacmach.cmx kernel/term.cmx pretyping/termops.cmx \
+    lib/util.cmx contrib/first-order/formula.cmi 
+contrib/first-order/g_ground.cmo: tactics/auto.cmi toplevel/cerrors.cmi \
+    parsing/egrammar.cmi contrib/first-order/formula.cmi interp/genarg.cmi \
+    library/goptions.cmi contrib/first-order/ground.cmi library/libnames.cmi \
+    kernel/names.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    proofs/refiner.cmi contrib/first-order/sequent.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi lib/util.cmi 
+contrib/first-order/g_ground.cmx: tactics/auto.cmx toplevel/cerrors.cmx \
+    parsing/egrammar.cmx contrib/first-order/formula.cmx interp/genarg.cmx \
+    library/goptions.cmx contrib/first-order/ground.cmx library/libnames.cmx \
+    kernel/names.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    proofs/refiner.cmx contrib/first-order/sequent.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx lib/util.cmx 
+contrib/first-order/ground.cmo: pretyping/classops.cmi kernel/closure.cmi \
+    contrib/first-order/formula.cmi lib/heap.cmi \
+    contrib/first-order/instances.cmi library/libnames.cmi kernel/names.cmi \
+    lib/pp.cmi parsing/printer.cmi contrib/first-order/rules.cmi \
+    contrib/first-order/sequent.cmi tactics/tacinterp.cmi proofs/tacmach.cmi \
+    proofs/tactic_debug.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi contrib/first-order/ground.cmi 
+contrib/first-order/ground.cmx: pretyping/classops.cmx kernel/closure.cmx \
+    contrib/first-order/formula.cmx lib/heap.cmx \
+    contrib/first-order/instances.cmx library/libnames.cmx kernel/names.cmx \
+    lib/pp.cmx parsing/printer.cmx contrib/first-order/rules.cmx \
+    contrib/first-order/sequent.cmx tactics/tacinterp.cmx proofs/tacmach.cmx \
+    proofs/tactic_debug.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx contrib/first-order/ground.cmi 
+contrib/first-order/instances.cmo: kernel/declarations.cmi \
+    pretyping/detyping.cmi pretyping/evd.cmi contrib/first-order/formula.cmi \
+    lib/heap.cmi library/libnames.cmi kernel/names.cmi lib/pp.cmi \
+    pretyping/pretyping.cmi pretyping/rawterm.cmi pretyping/reductionops.cmi \
+    proofs/refiner.cmi contrib/first-order/rules.cmi \
+    contrib/first-order/sequent.cmi kernel/sign.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi contrib/first-order/unify.cmi lib/util.cmi \
+    contrib/first-order/instances.cmi 
+contrib/first-order/instances.cmx: kernel/declarations.cmx \
+    pretyping/detyping.cmx pretyping/evd.cmx contrib/first-order/formula.cmx \
+    lib/heap.cmx library/libnames.cmx kernel/names.cmx lib/pp.cmx \
+    pretyping/pretyping.cmx pretyping/rawterm.cmx pretyping/reductionops.cmx \
+    proofs/refiner.cmx contrib/first-order/rules.cmx \
+    contrib/first-order/sequent.cmx kernel/sign.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx contrib/first-order/unify.cmx lib/util.cmx \
+    contrib/first-order/instances.cmi 
+contrib/first-order/rules.cmo: interp/coqlib.cmi kernel/declarations.cmi \
+    contrib/first-order/formula.cmi library/libnames.cmi kernel/names.cmi \
+    lib/pp.cmi contrib/first-order/sequent.cmi kernel/sign.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
     contrib/first-order/rules.cmi 
-contrib/first-order/rules.cmx: lib/util.cmx pretyping/termops.cmx \
-    kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
-    proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx \
-    contrib/first-order/sequent.cmx kernel/names.cmx library/libnames.cmx \
-    contrib/first-order/formula.cmx kernel/declarations.cmx interp/coqlib.cmx \
+contrib/first-order/rules.cmx: interp/coqlib.cmx kernel/declarations.cmx \
+    contrib/first-order/formula.cmx library/libnames.cmx kernel/names.cmx \
+    lib/pp.cmx contrib/first-order/sequent.cmx kernel/sign.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
     contrib/first-order/rules.cmi 
-contrib/first-order/sequent.cmo: lib/util.cmi contrib/first-order/unify.cmi \
-    kernel/term.cmi proofs/tacmach.cmi parsing/ppconstr.cmi lib/pp.cmi \
-    kernel/names.cmi library/libnames.cmi lib/heap.cmi library/global.cmi \
-    contrib/first-order/formula.cmi interp/constrextern.cmi tactics/auto.cmi \
+contrib/first-order/sequent.cmo: tactics/auto.cmi interp/constrextern.cmi \
+    contrib/first-order/formula.cmi library/global.cmi lib/heap.cmi \
+    library/libnames.cmi kernel/names.cmi lib/pp.cmi parsing/ppconstr.cmi \
+    parsing/printer.cmi proofs/tacmach.cmi kernel/term.cmi \
+    contrib/first-order/unify.cmi lib/util.cmi \
     contrib/first-order/sequent.cmi 
-contrib/first-order/sequent.cmx: lib/util.cmx contrib/first-order/unify.cmx \
-    kernel/term.cmx proofs/tacmach.cmx parsing/ppconstr.cmx lib/pp.cmx \
-    kernel/names.cmx library/libnames.cmx lib/heap.cmx library/global.cmx \
-    contrib/first-order/formula.cmx interp/constrextern.cmx tactics/auto.cmx \
+contrib/first-order/sequent.cmx: tactics/auto.cmx interp/constrextern.cmx \
+    contrib/first-order/formula.cmx library/global.cmx lib/heap.cmx \
+    library/libnames.cmx kernel/names.cmx lib/pp.cmx parsing/ppconstr.cmx \
+    parsing/printer.cmx proofs/tacmach.cmx kernel/term.cmx \
+    contrib/first-order/unify.cmx lib/util.cmx \
     contrib/first-order/sequent.cmi 
-contrib/first-order/unify.cmo: lib/util.cmi pretyping/termops.cmi \
-    kernel/term.cmi proofs/tacmach.cmi pretyping/reductionops.cmi \
-    kernel/names.cmi contrib/first-order/formula.cmi \
+contrib/first-order/unify.cmo: contrib/first-order/formula.cmi \
+    kernel/names.cmi pretyping/reductionops.cmi proofs/tacmach.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
     contrib/first-order/unify.cmi 
-contrib/first-order/unify.cmx: lib/util.cmx pretyping/termops.cmx \
-    kernel/term.cmx proofs/tacmach.cmx pretyping/reductionops.cmx \
-    kernel/names.cmx contrib/first-order/formula.cmx \
+contrib/first-order/unify.cmx: contrib/first-order/formula.cmx \
+    kernel/names.cmx pretyping/reductionops.cmx proofs/tacmach.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
     contrib/first-order/unify.cmi 
-contrib/fourier/fourierR.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
-    proofs/tacmach.cmi contrib/ring/ring.cmo kernel/names.cmi \
-    library/library.cmi library/libnames.cmi contrib/fourier/fourier.cmo \
-    tactics/equality.cmi interp/coqlib.cmi tactics/contradiction.cmi \
-    proofs/clenv.cmi 
-contrib/fourier/fourierR.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
-    proofs/tacmach.cmx contrib/ring/ring.cmx kernel/names.cmx \
-    library/library.cmx library/libnames.cmx contrib/fourier/fourier.cmx \
-    tactics/equality.cmx interp/coqlib.cmx tactics/contradiction.cmx \
-    proofs/clenv.cmx 
-contrib/fourier/g_fourier.cmo: lib/util.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo proofs/refiner.cmi parsing/pptactic.cmi lib/pp.cmi \
-    parsing/pcoq.cmi lib/options.cmi contrib/fourier/fourierR.cmo \
-    parsing/egrammar.cmi toplevel/cerrors.cmi 
-contrib/fourier/g_fourier.cmx: lib/util.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx proofs/refiner.cmx parsing/pptactic.cmx lib/pp.cmx \
-    parsing/pcoq.cmx lib/options.cmx contrib/fourier/fourierR.cmx \
-    parsing/egrammar.cmx toplevel/cerrors.cmx 
-contrib/funind/tacinv.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
-    pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi pretyping/tacred.cmi \
-    proofs/tacmach.cmi contrib/funind/tacinvutils.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo tactics/setoid_replace.cmi kernel/safe_typing.cmi \
-    proofs/refiner.cmi tactics/refine.cmi pretyping/reductionops.cmi \
-    proofs/proof_type.cmi parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi \
-    parsing/pcoq.cmi lib/options.cmi kernel/names.cmi \
-    pretyping/inductiveops.cmi library/global.cmi interp/genarg.cmi \
-    pretyping/evd.cmi tactics/equality.cmi kernel/environ.cmi \
-    kernel/entries.cmi parsing/egrammar.cmi library/declare.cmi \
-    library/decl_kinds.cmo interp/coqlib.cmi interp/constrintern.cmi \
-    toplevel/cerrors.cmi 
-contrib/funind/tacinv.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
-    pretyping/typing.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx pretyping/tacred.cmx \
-    proofs/tacmach.cmx contrib/funind/tacinvutils.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx tactics/setoid_replace.cmx kernel/safe_typing.cmx \
-    proofs/refiner.cmx tactics/refine.cmx pretyping/reductionops.cmx \
-    proofs/proof_type.cmx parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx \
-    parsing/pcoq.cmx lib/options.cmx kernel/names.cmx \
-    pretyping/inductiveops.cmx library/global.cmx interp/genarg.cmx \
-    pretyping/evd.cmx tactics/equality.cmx kernel/environ.cmx \
-    kernel/entries.cmx parsing/egrammar.cmx library/declare.cmx \
-    library/decl_kinds.cmx interp/coqlib.cmx interp/constrintern.cmx \
-    toplevel/cerrors.cmx 
-contrib/funind/tacinvutils.cmo: lib/util.cmi pretyping/termops.cmi \
-    kernel/term.cmi kernel/sign.cmi pretyping/reductionops.cmi \
-    parsing/printer.cmi lib/pp.cmi kernel/names.cmi library/nameops.cmi \
-    pretyping/inductiveops.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi kernel/declarations.cmi interp/coqlib.cmi \
+contrib/fourier/fourierR.cmo: pretyping/clenv.cmi tactics/contradiction.cmi \
+    interp/coqlib.cmi tactics/equality.cmi pretyping/evarutil.cmi \
+    contrib/fourier/fourier.cmo library/libnames.cmi kernel/names.cmi \
+    contrib/ring/ring.cmo proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi lib/util.cmi toplevel/vernacexpr.cmo 
+contrib/fourier/fourierR.cmx: pretyping/clenv.cmx tactics/contradiction.cmx \
+    interp/coqlib.cmx tactics/equality.cmx pretyping/evarutil.cmx \
+    contrib/fourier/fourier.cmx library/libnames.cmx kernel/names.cmx \
+    contrib/ring/ring.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx lib/util.cmx toplevel/vernacexpr.cmx 
+contrib/fourier/g_fourier.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    contrib/fourier/fourierR.cmo parsing/pcoq.cmi lib/pp.cmi \
+    parsing/pptactic.cmi proofs/refiner.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi lib/util.cmi 
+contrib/fourier/g_fourier.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    contrib/fourier/fourierR.cmx parsing/pcoq.cmx lib/pp.cmx \
+    parsing/pptactic.cmx proofs/refiner.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx lib/util.cmx 
+contrib/funind/indfun_common.cmo: interp/coqlib.cmi kernel/declarations.cmi \
+    library/global.cmi library/libnames.cmi kernel/names.cmi \
+    library/nametab.cmi lib/pp.cmi pretyping/rawterm.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi contrib/funind/indfun_common.cmi 
+contrib/funind/indfun_common.cmx: interp/coqlib.cmx kernel/declarations.cmx \
+    library/global.cmx library/libnames.cmx kernel/names.cmx \
+    library/nametab.cmx lib/pp.cmx pretyping/rawterm.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx contrib/funind/indfun_common.cmi 
+contrib/funind/indfun_main.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    interp/genarg.cmi contrib/funind/indfun.cmo \
+    contrib/funind/indfun_common.cmi pretyping/indrec.cmi \
+    contrib/funind/invfun.cmo parsing/lexer.cmi library/nameops.cmi \
+    kernel/names.cmi contrib/funind/new_arg_principle.cmi parsing/pcoq.cmi \
+    lib/pp.cmi parsing/pptactic.cmi pretyping/rawterm.cmi proofs/refiner.cmi \
+    proofs/tacexpr.cmo tactics/tacinterp.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi interp/topconstr.cmi lib/util.cmi \
+    toplevel/vernacinterp.cmi 
+contrib/funind/indfun_main.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    interp/genarg.cmx contrib/funind/indfun.cmx \
+    contrib/funind/indfun_common.cmx pretyping/indrec.cmx \
+    contrib/funind/invfun.cmx parsing/lexer.cmx library/nameops.cmx \
+    kernel/names.cmx contrib/funind/new_arg_principle.cmx parsing/pcoq.cmx \
+    lib/pp.cmx parsing/pptactic.cmx pretyping/rawterm.cmx proofs/refiner.cmx \
+    proofs/tacexpr.cmx tactics/tacinterp.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx interp/topconstr.cmx lib/util.cmx \
+    toplevel/vernacinterp.cmx 
+contrib/funind/indfun.cmo: toplevel/command.cmi interp/constrintern.cmi \
+    library/decl_kinds.cmo kernel/declarations.cmi kernel/environ.cmi \
+    pretyping/evd.cmi library/global.cmi library/impargs.cmi \
+    contrib/funind/indfun_common.cmi pretyping/indrec.cmi \
+    library/libnames.cmi kernel/names.cmi \
+    contrib/funind/new_arg_principle.cmi interp/notation.cmi lib/options.cmi \
+    lib/pp.cmi pretyping/rawterm.cmi contrib/funind/rawterm_to_relation.cmi \
+    contrib/recdef/recdef.cmo library/states.cmi proofs/tacmach.cmi \
+    kernel/term.cmi interp/topconstr.cmi lib/util.cmi toplevel/vernacexpr.cmo 
+contrib/funind/indfun.cmx: toplevel/command.cmx interp/constrintern.cmx \
+    library/decl_kinds.cmx kernel/declarations.cmx kernel/environ.cmx \
+    pretyping/evd.cmx library/global.cmx library/impargs.cmx \
+    contrib/funind/indfun_common.cmx pretyping/indrec.cmx \
+    library/libnames.cmx kernel/names.cmx \
+    contrib/funind/new_arg_principle.cmx interp/notation.cmx lib/options.cmx \
+    lib/pp.cmx pretyping/rawterm.cmx contrib/funind/rawterm_to_relation.cmx \
+    contrib/recdef/recdef.cmx library/states.cmx proofs/tacmach.cmx \
+    kernel/term.cmx interp/topconstr.cmx lib/util.cmx toplevel/vernacexpr.cmx 
+contrib/funind/invfun.cmo: kernel/declarations.cmi tactics/equality.cmi \
+    tactics/extratactics.cmi library/global.cmi tactics/hiddentac.cmi \
+    contrib/funind/indfun_common.cmi pretyping/indrec.cmi \
+    library/libnames.cmi kernel/names.cmi lib/pp.cmi pretyping/rawterm.cmi \
+    kernel/sign.cmi contrib/funind/tacinvutils.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi 
+contrib/funind/invfun.cmx: kernel/declarations.cmx tactics/equality.cmx \
+    tactics/extratactics.cmx library/global.cmx tactics/hiddentac.cmx \
+    contrib/funind/indfun_common.cmx pretyping/indrec.cmx \
+    library/libnames.cmx kernel/names.cmx lib/pp.cmx pretyping/rawterm.cmx \
+    kernel/sign.cmx contrib/funind/tacinvutils.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx lib/util.cmx 
+contrib/funind/new_arg_principle.cmo: toplevel/cerrors.cmi \
+    pretyping/clenv.cmi kernel/closure.cmi toplevel/command.cmi \
+    interp/coqlib.cmi library/decl_kinds.cmo kernel/declarations.cmi \
+    library/declare.cmi tactics/eauto.cmi kernel/entries.cmi \
+    kernel/environ.cmi tactics/equality.cmi pretyping/evd.cmi \
+    interp/genarg.cmi library/global.cmi tactics/hiddentac.cmi \
+    contrib/funind/indfun_common.cmi pretyping/indrec.cmi \
+    library/libnames.cmi kernel/names.cmi lib/options.cmi proofs/pfedit.cmi \
+    lib/pp.cmi parsing/ppconstr.cmi pretyping/pretyping.cmi \
+    parsing/printer.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    contrib/recdef/recdef.cmo pretyping/reductionops.cmi \
+    tactics/tacinterp.cmi proofs/tacmach.cmi pretyping/tacred.cmi \
+    proofs/tactic_debug.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi pretyping/termops.cmi pretyping/typing.cmi \
+    pretyping/unification.cmi lib/util.cmi toplevel/vernacentries.cmi \
+    toplevel/vernacexpr.cmo contrib/funind/new_arg_principle.cmi 
+contrib/funind/new_arg_principle.cmx: toplevel/cerrors.cmx \
+    pretyping/clenv.cmx kernel/closure.cmx toplevel/command.cmx \
+    interp/coqlib.cmx library/decl_kinds.cmx kernel/declarations.cmx \
+    library/declare.cmx tactics/eauto.cmx kernel/entries.cmx \
+    kernel/environ.cmx tactics/equality.cmx pretyping/evd.cmx \
+    interp/genarg.cmx library/global.cmx tactics/hiddentac.cmx \
+    contrib/funind/indfun_common.cmx pretyping/indrec.cmx \
+    library/libnames.cmx kernel/names.cmx lib/options.cmx proofs/pfedit.cmx \
+    lib/pp.cmx parsing/ppconstr.cmx pretyping/pretyping.cmx \
+    parsing/printer.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \
+    contrib/recdef/recdef.cmx pretyping/reductionops.cmx \
+    tactics/tacinterp.cmx proofs/tacmach.cmx pretyping/tacred.cmx \
+    proofs/tactic_debug.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx pretyping/termops.cmx pretyping/typing.cmx \
+    pretyping/unification.cmx lib/util.cmx toplevel/vernacentries.cmx \
+    toplevel/vernacexpr.cmx contrib/funind/new_arg_principle.cmi 
+contrib/funind/rawtermops.cmo: interp/coqlib.cmi pretyping/evd.cmi \
+    library/global.cmi contrib/funind/indfun_common.cmi \
+    pretyping/inductiveops.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi lib/pp.cmi parsing/ppconstr.cmi parsing/printer.cmi \
+    pretyping/rawterm.cmi tactics/tacinterp.cmi proofs/tactic_debug.cmi \
+    lib/util.cmi contrib/funind/rawtermops.cmi 
+contrib/funind/rawtermops.cmx: interp/coqlib.cmx pretyping/evd.cmx \
+    library/global.cmx contrib/funind/indfun_common.cmx \
+    pretyping/inductiveops.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx lib/pp.cmx parsing/ppconstr.cmx parsing/printer.cmx \
+    pretyping/rawterm.cmx tactics/tacinterp.cmx proofs/tactic_debug.cmx \
+    lib/util.cmx contrib/funind/rawtermops.cmi 
+contrib/funind/rawterm_to_relation.cmo: toplevel/cerrors.cmi \
+    toplevel/command.cmi interp/constrextern.cmi interp/coqlib.cmi \
+    library/impargs.cmi contrib/funind/indfun_common.cmi library/libnames.cmi \
+    library/nameops.cmi kernel/names.cmi lib/options.cmi lib/pp.cmi \
+    parsing/ppvernac.cmi parsing/printer.cmi pretyping/rawterm.cmi \
+    contrib/funind/rawtermops.cmi kernel/term.cmi interp/topconstr.cmi \
+    lib/util.cmi toplevel/vernacexpr.cmo \
+    contrib/funind/rawterm_to_relation.cmi 
+contrib/funind/rawterm_to_relation.cmx: toplevel/cerrors.cmx \
+    toplevel/command.cmx interp/constrextern.cmx interp/coqlib.cmx \
+    library/impargs.cmx contrib/funind/indfun_common.cmx library/libnames.cmx \
+    library/nameops.cmx kernel/names.cmx lib/options.cmx lib/pp.cmx \
+    parsing/ppvernac.cmx parsing/printer.cmx pretyping/rawterm.cmx \
+    contrib/funind/rawtermops.cmx kernel/term.cmx interp/topconstr.cmx \
+    lib/util.cmx toplevel/vernacexpr.cmx \
+    contrib/funind/rawterm_to_relation.cmi 
+contrib/funind/tacinv.cmo: toplevel/cerrors.cmi interp/constrintern.cmi \
+    interp/coqlib.cmi library/decl_kinds.cmo library/declare.cmi \
+    parsing/egrammar.cmi kernel/entries.cmi kernel/environ.cmi \
+    tactics/equality.cmi pretyping/evd.cmi interp/genarg.cmi \
+    library/global.cmi pretyping/inductiveops.cmi kernel/names.cmi \
+    parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi parsing/printer.cmi \
+    proofs/proof_type.cmi pretyping/reductionops.cmi tactics/refine.cmi \
+    proofs/refiner.cmi kernel/safe_typing.cmi tactics/setoid_replace.cmi \
+    proofs/tacexpr.cmo tactics/tacinterp.cmi contrib/funind/tacinvutils.cmi \
+    proofs/tacmach.cmi pretyping/tacred.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \
+    pretyping/typing.cmi lib/util.cmi toplevel/vernacinterp.cmi 
+contrib/funind/tacinv.cmx: toplevel/cerrors.cmx interp/constrintern.cmx \
+    interp/coqlib.cmx library/decl_kinds.cmx library/declare.cmx \
+    parsing/egrammar.cmx kernel/entries.cmx kernel/environ.cmx \
+    tactics/equality.cmx pretyping/evd.cmx interp/genarg.cmx \
+    library/global.cmx pretyping/inductiveops.cmx kernel/names.cmx \
+    parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx parsing/printer.cmx \
+    proofs/proof_type.cmx pretyping/reductionops.cmx tactics/refine.cmx \
+    proofs/refiner.cmx kernel/safe_typing.cmx tactics/setoid_replace.cmx \
+    proofs/tacexpr.cmx tactics/tacinterp.cmx contrib/funind/tacinvutils.cmx \
+    proofs/tacmach.cmx pretyping/tacred.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \
+    pretyping/typing.cmx lib/util.cmx toplevel/vernacinterp.cmx 
+contrib/funind/tacinvutils.cmo: interp/coqlib.cmi kernel/declarations.cmi \
+    kernel/environ.cmi pretyping/evd.cmi library/global.cmi \
+    pretyping/inductiveops.cmi library/nameops.cmi kernel/names.cmi \
+    lib/pp.cmi parsing/printer.cmi pretyping/reductionops.cmi kernel/sign.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
     contrib/funind/tacinvutils.cmi 
-contrib/funind/tacinvutils.cmx: lib/util.cmx pretyping/termops.cmx \
-    kernel/term.cmx kernel/sign.cmx pretyping/reductionops.cmx \
-    parsing/printer.cmx lib/pp.cmx kernel/names.cmx library/nameops.cmx \
-    pretyping/inductiveops.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx kernel/declarations.cmx interp/coqlib.cmx \
+contrib/funind/tacinvutils.cmx: interp/coqlib.cmx kernel/declarations.cmx \
+    kernel/environ.cmx pretyping/evd.cmx library/global.cmx \
+    pretyping/inductiveops.cmx library/nameops.cmx kernel/names.cmx \
+    lib/pp.cmx parsing/printer.cmx pretyping/reductionops.cmx kernel/sign.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.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 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 \
-    proofs/evar_refiner.cmi tactics/equality.cmi kernel/environ.cmi \
-    tactics/eauto.cmi library/declare.cmi kernel/declarations.cmi \
-    contrib/interface/ctast.cmo toplevel/command.cmi proofs/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 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 \
-    proofs/evar_refiner.cmx tactics/equality.cmx kernel/environ.cmx \
-    tactics/eauto.cmx library/declare.cmx kernel/declarations.cmx \
-    contrib/interface/ctast.cmx toplevel/command.cmx proofs/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 parsing/termast.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 pretyping/pretyping.cmi \
-    parsing/pptactic.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \
-    contrib/interface/pbp.cmi lib/options.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi contrib/interface/name_to_ast.cmi \
-    pretyping/matching.cmi toplevel/line_oriented_parser.cmi \
-    library/library.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi contrib/interface/history.cmi library/global.cmi \
-    interp/genarg.cmi parsing/extend.cmi pretyping/evd.cmi kernel/environ.cmi \
-    parsing/egrammar.cmi library/declare.cmi kernel/declarations.cmi \
-    contrib/interface/debug_tac.cmi parsing/coqast.cmi \
-    interp/constrintern.cmi toplevel/command.cmi pretyping/classops.cmi \
-    toplevel/cerrors.cmi contrib/interface/blast.cmi parsing/ast.cmi \
-    contrib/interface/ascent.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 parsing/termast.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 pretyping/pretyping.cmx \
-    parsing/pptactic.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \
-    contrib/interface/pbp.cmx lib/options.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx contrib/interface/name_to_ast.cmx \
-    pretyping/matching.cmx toplevel/line_oriented_parser.cmx \
-    library/library.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx contrib/interface/history.cmx library/global.cmx \
-    interp/genarg.cmx parsing/extend.cmx pretyping/evd.cmx kernel/environ.cmx \
-    parsing/egrammar.cmx library/declare.cmx kernel/declarations.cmx \
-    contrib/interface/debug_tac.cmx parsing/coqast.cmx \
-    interp/constrintern.cmx toplevel/command.cmx pretyping/classops.cmx \
-    toplevel/cerrors.cmx contrib/interface/blast.cmx parsing/ast.cmx \
-    contrib/interface/ascent.cmi 
-contrib/interface/ctast.cmo: lib/util.cmi kernel/names.cmi \
-    library/libnames.cmi lib/dyn.cmi parsing/coqast.cmi 
-contrib/interface/ctast.cmx: lib/util.cmx kernel/names.cmx \
-    library/libnames.cmx lib/dyn.cmx parsing/coqast.cmx 
-contrib/interface/dad.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \
-    lib/util.cmi pretyping/typing.cmi interp/topconstr.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo kernel/reduction.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi proofs/proof_trees.cmi lib/pp.cmi \
-    pretyping/pattern.cmi contrib/interface/paths.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi pretyping/matching.cmi \
-    library/libnames.cmi library/global.cmi interp/genarg.cmi \
-    pretyping/evd.cmi kernel/environ.cmi interp/constrintern.cmi \
-    interp/constrextern.cmi contrib/interface/dad.cmi 
-contrib/interface/dad.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \
-    lib/util.cmx pretyping/typing.cmx interp/topconstr.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
-    proofs/tacexpr.cmx kernel/reduction.cmx pretyping/rawterm.cmx \
-    proofs/proof_type.cmx proofs/proof_trees.cmx lib/pp.cmx \
-    pretyping/pattern.cmx contrib/interface/paths.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx pretyping/matching.cmx \
-    library/libnames.cmx library/global.cmx interp/genarg.cmx \
-    pretyping/evd.cmx kernel/environ.cmx interp/constrintern.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/pptactic.cmi lib/pp.cmi interp/genarg.cmi parsing/coqast.cmi \
-    toplevel/cerrors.cmi parsing/ast.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/pptactic.cmx lib/pp.cmx interp/genarg.cmx parsing/coqast.cmx \
-    toplevel/cerrors.cmx parsing/ast.cmx contrib/interface/debug_tac.cmi 
+contrib/interface/blast.cmo: tactics/auto.cmi pretyping/clenv.cmi \
+    toplevel/command.cmi kernel/declarations.cmi library/declare.cmi \
+    tactics/eauto.cmi kernel/environ.cmi tactics/equality.cmi \
+    pretyping/evd.cmi lib/explore.cmi library/global.cmi \
+    tactics/hipattern.cmi kernel/inductive.cmi proofs/logic.cmi \
+    library/nameops.cmi kernel/names.cmi pretyping/pattern.cmi \
+    contrib/interface/pbp.cmi parsing/pcoq.cmi proofs/pfedit.cmi lib/pp.cmi \
+    parsing/pptactic.cmi parsing/printer.cmi proofs/proof_trees.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \
+    proofs/refiner.cmi kernel/sign.cmi tactics/tacinterp.cmi \
+    proofs/tacmach.cmi pretyping/tacred.cmi parsing/tactic_printer.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi pretyping/typing.cmi lib/util.cmi \
+    toplevel/vernacentries.cmi toplevel/vernacinterp.cmi \
+    contrib/interface/blast.cmi 
+contrib/interface/blast.cmx: tactics/auto.cmx pretyping/clenv.cmx \
+    toplevel/command.cmx kernel/declarations.cmx library/declare.cmx \
+    tactics/eauto.cmx kernel/environ.cmx tactics/equality.cmx \
+    pretyping/evd.cmx lib/explore.cmx library/global.cmx \
+    tactics/hipattern.cmx kernel/inductive.cmx proofs/logic.cmx \
+    library/nameops.cmx kernel/names.cmx pretyping/pattern.cmx \
+    contrib/interface/pbp.cmx parsing/pcoq.cmx proofs/pfedit.cmx lib/pp.cmx \
+    parsing/pptactic.cmx parsing/printer.cmx proofs/proof_trees.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \
+    proofs/refiner.cmx kernel/sign.cmx tactics/tacinterp.cmx \
+    proofs/tacmach.cmx pretyping/tacred.cmx parsing/tactic_printer.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx pretyping/typing.cmx lib/util.cmx \
+    toplevel/vernacentries.cmx toplevel/vernacinterp.cmx \
+    contrib/interface/blast.cmi 
+contrib/interface/centaur.cmo: contrib/interface/ascent.cmi \
+    contrib/interface/blast.cmi toplevel/cerrors.cmi pretyping/classops.cmi \
+    toplevel/command.cmi interp/constrintern.cmi \
+    contrib/interface/debug_tac.cmi kernel/declarations.cmi \
+    library/declare.cmi parsing/egrammar.cmi kernel/environ.cmi \
+    pretyping/evd.cmi interp/genarg.cmi library/global.cmi \
+    contrib/interface/history.cmi parsing/lexer.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi library/library.cmi \
+    toplevel/line_oriented_parser.cmi pretyping/matching.cmi \
+    contrib/interface/name_to_ast.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi contrib/interface/pbp.cmi parsing/pcoq.cmi \
+    proofs/pfedit.cmi lib/pp.cmi parsing/pptactic.cmi pretyping/pretyping.cmi \
+    parsing/printer.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \
+    toplevel/protectedtoplevel.cmi pretyping/rawterm.cmi kernel/reduction.cmi \
+    proofs/refiner.cmi parsing/search.cmi contrib/interface/showproof.cmi \
+    contrib/interface/showproof_ct.cmo proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi proofs/tacmach.cmi kernel/term.cmi \
+    contrib/interface/translate.cmi lib/util.cmi toplevel/vernac.cmi \
+    toplevel/vernacentries.cmi toplevel/vernacexpr.cmo \
+    toplevel/vernacinterp.cmi contrib/interface/vtp.cmi \
+    contrib/interface/xlate.cmi 
+contrib/interface/centaur.cmx: contrib/interface/ascent.cmi \
+    contrib/interface/blast.cmx toplevel/cerrors.cmx pretyping/classops.cmx \
+    toplevel/command.cmx interp/constrintern.cmx \
+    contrib/interface/debug_tac.cmx kernel/declarations.cmx \
+    library/declare.cmx parsing/egrammar.cmx kernel/environ.cmx \
+    pretyping/evd.cmx interp/genarg.cmx library/global.cmx \
+    contrib/interface/history.cmx parsing/lexer.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx library/library.cmx \
+    toplevel/line_oriented_parser.cmx pretyping/matching.cmx \
+    contrib/interface/name_to_ast.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx contrib/interface/pbp.cmx parsing/pcoq.cmx \
+    proofs/pfedit.cmx lib/pp.cmx parsing/pptactic.cmx pretyping/pretyping.cmx \
+    parsing/printer.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \
+    toplevel/protectedtoplevel.cmx pretyping/rawterm.cmx kernel/reduction.cmx \
+    proofs/refiner.cmx parsing/search.cmx contrib/interface/showproof.cmx \
+    contrib/interface/showproof_ct.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx proofs/tacmach.cmx kernel/term.cmx \
+    contrib/interface/translate.cmx lib/util.cmx toplevel/vernac.cmx \
+    toplevel/vernacentries.cmx toplevel/vernacexpr.cmx \
+    toplevel/vernacinterp.cmx contrib/interface/vtp.cmx \
+    contrib/interface/xlate.cmx 
+contrib/interface/dad.cmo: interp/constrextern.cmi interp/constrintern.cmi \
+    kernel/environ.cmi pretyping/evd.cmi interp/genarg.cmi library/global.cmi \
+    library/libnames.cmi pretyping/matching.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi contrib/interface/paths.cmi \
+    pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi interp/topconstr.cmi \
+    pretyping/typing.cmi lib/util.cmi toplevel/vernacexpr.cmo \
+    toplevel/vernacinterp.cmi contrib/interface/dad.cmi 
+contrib/interface/dad.cmx: interp/constrextern.cmx interp/constrintern.cmx \
+    kernel/environ.cmx pretyping/evd.cmx interp/genarg.cmx library/global.cmx \
+    library/libnames.cmx pretyping/matching.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx contrib/interface/paths.cmx \
+    pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx interp/topconstr.cmx \
+    pretyping/typing.cmx lib/util.cmx toplevel/vernacexpr.cmx \
+    toplevel/vernacinterp.cmx contrib/interface/dad.cmi 
+contrib/interface/debug_tac.cmo: toplevel/cerrors.cmi interp/genarg.cmi \
+    library/global.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    parsing/printer.cmi proofs/proof_trees.cmi proofs/proof_type.cmi \
+    proofs/refiner.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \
+    proofs/tacmach.cmi tactics/tacticals.cmi lib/util.cmi \
+    contrib/interface/debug_tac.cmi 
+contrib/interface/debug_tac.cmx: toplevel/cerrors.cmx interp/genarg.cmx \
+    library/global.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    parsing/printer.cmx proofs/proof_trees.cmx proofs/proof_type.cmx \
+    proofs/refiner.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \
+    proofs/tacmach.cmx tactics/tacticals.cmx lib/util.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 \
     contrib/interface/history.cmi 
 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 parsing/termast.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 \
-    parsing/coqast.cmi interp/constrextern.cmi pretyping/classops.cmi \
-    parsing/ast.cmi contrib/interface/name_to_ast.cmi 
-contrib/interface/name_to_ast.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx parsing/termast.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 \
-    parsing/coqast.cmx interp/constrextern.cmx pretyping/classops.cmx \
-    parsing/ast.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 \
-    parsing/pcoq.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    toplevel/mltop.cmi contrib/interface/line_parser.cmi library/library.cmi \
-    library/libobject.cmi library/libnames.cmi parsing/esyntax.cmi \
-    library/declaremods.cmi config/coq_config.cmi toplevel/cerrors.cmi \
-    contrib/interface/ascent.cmi 
-contrib/interface/parse.cmx: contrib/interface/xlate.cmx \
-    contrib/interface/vtp.cmx toplevel/vernacexpr.cmx \
-    toplevel/vernacentries.cmx lib/util.cmx lib/system.cmx lib/pp.cmx \
-    parsing/pcoq.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    toplevel/mltop.cmx contrib/interface/line_parser.cmx library/library.cmx \
-    library/libobject.cmx library/libnames.cmx parsing/esyntax.cmx \
-    library/declaremods.cmx config/coq_config.cmx toplevel/cerrors.cmx \
-    contrib/interface/ascent.cmi 
+contrib/interface/name_to_ast.cmo: pretyping/classops.cmi \
+    interp/constrextern.cmi library/decl_kinds.cmo kernel/declarations.cmi \
+    library/declare.cmi kernel/environ.cmi library/global.cmi \
+    library/impargs.cmi kernel/inductive.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi lib/pp.cmi parsing/prettyp.cmi \
+    kernel/reduction.cmi kernel/sign.cmi kernel/term.cmi interp/topconstr.cmi \
+    lib/util.cmi toplevel/vernacexpr.cmo contrib/interface/name_to_ast.cmi 
+contrib/interface/name_to_ast.cmx: pretyping/classops.cmx \
+    interp/constrextern.cmx library/decl_kinds.cmx kernel/declarations.cmx \
+    library/declare.cmx kernel/environ.cmx library/global.cmx \
+    library/impargs.cmx kernel/inductive.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx lib/pp.cmx parsing/prettyp.cmx \
+    kernel/reduction.cmx kernel/sign.cmx kernel/term.cmx interp/topconstr.cmx \
+    lib/util.cmx toplevel/vernacexpr.cmx contrib/interface/name_to_ast.cmi 
+contrib/interface/parse.cmo: contrib/interface/ascent.cmi \
+    toplevel/cerrors.cmi config/coq_config.cmi library/declaremods.cmi \
+    library/libnames.cmi library/libobject.cmi library/library.cmi \
+    contrib/interface/line_parser.cmi toplevel/mltop.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi parsing/pcoq.cmi lib/pp.cmi \
+    lib/system.cmi lib/util.cmi toplevel/vernacentries.cmi \
+    toplevel/vernacexpr.cmo contrib/interface/vtp.cmi \
+    contrib/interface/xlate.cmi 
+contrib/interface/parse.cmx: contrib/interface/ascent.cmi \
+    toplevel/cerrors.cmx config/coq_config.cmx library/declaremods.cmx \
+    library/libnames.cmx library/libobject.cmx library/library.cmx \
+    contrib/interface/line_parser.cmx toplevel/mltop.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx parsing/pcoq.cmx lib/pp.cmx \
+    lib/system.cmx lib/util.cmx toplevel/vernacentries.cmx \
+    toplevel/vernacexpr.cmx contrib/interface/vtp.cmx \
+    contrib/interface/xlate.cmx 
 contrib/interface/paths.cmo: contrib/interface/paths.cmi 
 contrib/interface/paths.cmx: contrib/interface/paths.cmi 
-contrib/interface/pbp.cmo: lib/util.cmi pretyping/typing.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 kernel/reduction.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    pretyping/pretyping.cmi lib/pp.cmi pretyping/pattern.cmi \
-    library/nametab.cmi kernel/names.cmi pretyping/matching.cmi \
-    proofs/logic.cmi library/libnames.cmi tactics/hipattern.cmi \
-    library/global.cmi interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi \
-    interp/coqlib.cmi contrib/interface/pbp.cmi 
-contrib/interface/pbp.cmx: lib/util.cmx pretyping/typing.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 kernel/reduction.cmx \
-    pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
-    pretyping/pretyping.cmx lib/pp.cmx pretyping/pattern.cmx \
-    library/nametab.cmx kernel/names.cmx pretyping/matching.cmx \
-    proofs/logic.cmx library/libnames.cmx tactics/hipattern.cmx \
-    library/global.cmx interp/genarg.cmx pretyping/evd.cmx kernel/environ.cmx \
-    interp/coqlib.cmx contrib/interface/pbp.cmi 
-contrib/interface/showproof.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
-    pretyping/typing.cmi contrib/interface/translate.cmi \
-    pretyping/termops.cmi parsing/termast.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 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/global.cmi interp/genarg.cmi \
-    pretyping/evd.cmi kernel/environ.cmi kernel/declarations.cmi \
-    parsing/coqast.cmi interp/constrintern.cmi proofs/clenv.cmi \
+contrib/interface/pbp.cmo: interp/coqlib.cmi kernel/environ.cmi \
+    pretyping/evd.cmi interp/genarg.cmi library/global.cmi \
+    tactics/hipattern.cmi library/libnames.cmi proofs/logic.cmi \
+    pretyping/matching.cmi kernel/names.cmi library/nametab.cmi \
+    pretyping/pattern.cmi lib/pp.cmi pretyping/pretyping.cmi \
+    proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    kernel/reduction.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \
+    proofs/tacmach.cmi tactics/tacticals.cmi tactics/tactics.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \
+    pretyping/typing.cmi lib/util.cmi contrib/interface/pbp.cmi 
+contrib/interface/pbp.cmx: interp/coqlib.cmx kernel/environ.cmx \
+    pretyping/evd.cmx interp/genarg.cmx library/global.cmx \
+    tactics/hipattern.cmx library/libnames.cmx proofs/logic.cmx \
+    pretyping/matching.cmx kernel/names.cmx library/nametab.cmx \
+    pretyping/pattern.cmx lib/pp.cmx pretyping/pretyping.cmx \
+    proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \
+    kernel/reduction.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \
+    proofs/tacmach.cmx tactics/tacticals.cmx tactics/tactics.cmx \
+    kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \
+    pretyping/typing.cmx lib/util.cmx contrib/interface/pbp.cmi 
+contrib/interface/showproof_ct.cmo: contrib/interface/ascent.cmi \
+    library/global.cmi toplevel/metasyntax.cmi lib/pp.cmi parsing/printer.cmi \
+    contrib/interface/translate.cmi contrib/interface/vtp.cmi \
+    contrib/interface/xlate.cmi 
+contrib/interface/showproof_ct.cmx: contrib/interface/ascent.cmi \
+    library/global.cmx toplevel/metasyntax.cmx lib/pp.cmx parsing/printer.cmx \
+    contrib/interface/translate.cmx contrib/interface/vtp.cmx \
+    contrib/interface/xlate.cmx 
+contrib/interface/showproof.cmo: pretyping/clenv.cmi interp/constrintern.cmi \
+    kernel/declarations.cmi kernel/environ.cmi pretyping/evd.cmi \
+    interp/genarg.cmi library/global.cmi kernel/inductive.cmi \
+    pretyping/inductiveops.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi proofs/pfedit.cmi lib/pp.cmi parsing/printer.cmi \
+    proofs/proof_trees.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    pretyping/reductionops.cmi contrib/interface/showproof_ct.cmo \
+    kernel/sign.cmi proofs/tacexpr.cmo proofs/tacmach.cmi kernel/term.cmi \
+    pretyping/termops.cmi contrib/interface/translate.cmi \
+    pretyping/typing.cmi lib/util.cmi toplevel/vernacinterp.cmi \
     contrib/interface/showproof.cmi 
-contrib/interface/showproof.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
-    pretyping/typing.cmx contrib/interface/translate.cmx \
-    pretyping/termops.cmx parsing/termast.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 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/global.cmx interp/genarg.cmx \
-    pretyping/evd.cmx kernel/environ.cmx kernel/declarations.cmx \
-    parsing/coqast.cmx interp/constrintern.cmx proofs/clenv.cmx \
+contrib/interface/showproof.cmx: pretyping/clenv.cmx interp/constrintern.cmx \
+    kernel/declarations.cmx kernel/environ.cmx pretyping/evd.cmx \
+    interp/genarg.cmx library/global.cmx kernel/inductive.cmx \
+    pretyping/inductiveops.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx proofs/pfedit.cmx lib/pp.cmx parsing/printer.cmx \
+    proofs/proof_trees.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \
+    pretyping/reductionops.cmx contrib/interface/showproof_ct.cmx \
+    kernel/sign.cmx proofs/tacexpr.cmx proofs/tacmach.cmx kernel/term.cmx \
+    pretyping/termops.cmx contrib/interface/translate.cmx \
+    pretyping/typing.cmx lib/util.cmx toplevel/vernacinterp.cmx \
     contrib/interface/showproof.cmi 
-contrib/interface/showproof_ct.cmo: contrib/interface/xlate.cmi \
-    contrib/interface/vtp.cmi contrib/interface/translate.cmi \
-    parsing/printer.cmi lib/pp.cmi toplevel/metasyntax.cmi library/global.cmi \
-    parsing/esyntax.cmi contrib/interface/ascent.cmi 
-contrib/interface/showproof_ct.cmx: contrib/interface/xlate.cmx \
-    contrib/interface/vtp.cmx contrib/interface/translate.cmx \
-    parsing/printer.cmx lib/pp.cmx toplevel/metasyntax.cmx library/global.cmx \
-    parsing/esyntax.cmx contrib/interface/ascent.cmi 
-contrib/interface/translate.cmo: contrib/interface/xlate.cmi \
-    contrib/interface/vtp.cmi toplevel/vernacinterp.cmi lib/util.cmi \
-    parsing/termast.cmi kernel/term.cmi proofs/tacmach.cmi kernel/sign.cmi \
-    proofs/proof_type.cmi lib/pp.cmi proofs/pfedit.cmi kernel/names.cmi \
-    library/library.cmi library/libobject.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/environ.cmi contrib/interface/ctast.cmo \
-    interp/constrextern.cmi parsing/ast.cmi contrib/interface/ascent.cmi \
-    contrib/interface/translate.cmi 
-contrib/interface/translate.cmx: contrib/interface/xlate.cmx \
-    contrib/interface/vtp.cmx toplevel/vernacinterp.cmx lib/util.cmx \
-    parsing/termast.cmx kernel/term.cmx proofs/tacmach.cmx kernel/sign.cmx \
-    proofs/proof_type.cmx lib/pp.cmx proofs/pfedit.cmx kernel/names.cmx \
-    library/library.cmx library/libobject.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx kernel/environ.cmx contrib/interface/ctast.cmx \
-    interp/constrextern.cmx parsing/ast.cmx contrib/interface/ascent.cmi \
-    contrib/interface/translate.cmi 
+contrib/interface/translate.cmo: contrib/interface/ascent.cmi \
+    interp/constrextern.cmi kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi library/libobject.cmi library/library.cmi \
+    kernel/names.cmi proofs/pfedit.cmi lib/pp.cmi proofs/proof_type.cmi \
+    kernel/sign.cmi proofs/tacmach.cmi kernel/term.cmi lib/util.cmi \
+    toplevel/vernacinterp.cmi contrib/interface/vtp.cmi \
+    contrib/interface/xlate.cmi contrib/interface/translate.cmi 
+contrib/interface/translate.cmx: contrib/interface/ascent.cmi \
+    interp/constrextern.cmx kernel/environ.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx library/libobject.cmx library/library.cmx \
+    kernel/names.cmx proofs/pfedit.cmx lib/pp.cmx proofs/proof_type.cmx \
+    kernel/sign.cmx proofs/tacmach.cmx kernel/term.cmx lib/util.cmx \
+    toplevel/vernacinterp.cmx contrib/interface/vtp.cmx \
+    contrib/interface/xlate.cmx contrib/interface/translate.cmi 
 contrib/interface/vtp.cmo: contrib/interface/ascent.cmi \
     contrib/interface/vtp.cmi 
 contrib/interface/vtp.cmx: contrib/interface/ascent.cmi \
     contrib/interface/vtp.cmi 
-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 lib/options.cmi \
-    kernel/names.cmi library/libnames.cmi library/goptions.cmi \
-    interp/genarg.cmi contrib/field/field.cmo tactics/extraargs.cmi \
-    parsing/extend.cmi tactics/eauto.cmi library/decl_kinds.cmo \
-    lib/bignat.cmi parsing/ast.cmi contrib/interface/ascent.cmi \
+contrib/interface/xlate.cmo: contrib/interface/ascent.cmi lib/bigint.cmi \
+    library/decl_kinds.cmo tactics/eauto.cmi parsing/extend.cmi \
+    tactics/extraargs.cmi tactics/extratactics.cmi contrib/field/field.cmo \
+    interp/genarg.cmi library/goptions.cmi library/libnames.cmi \
+    kernel/names.cmi parsing/pcoq.cmi parsing/ppconstr.cmi \
+    pretyping/rawterm.cmi proofs/tacexpr.cmo kernel/term.cmi \
+    interp/topconstr.cmi lib/util.cmi toplevel/vernacexpr.cmo \
     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 lib/options.cmx \
-    kernel/names.cmx library/libnames.cmx library/goptions.cmx \
-    interp/genarg.cmx contrib/field/field.cmx tactics/extraargs.cmx \
-    parsing/extend.cmx tactics/eauto.cmx library/decl_kinds.cmx \
-    lib/bignat.cmx parsing/ast.cmx contrib/interface/ascent.cmi \
+contrib/interface/xlate.cmx: contrib/interface/ascent.cmi lib/bigint.cmx \
+    library/decl_kinds.cmx tactics/eauto.cmx parsing/extend.cmx \
+    tactics/extraargs.cmx tactics/extratactics.cmx contrib/field/field.cmx \
+    interp/genarg.cmx library/goptions.cmx library/libnames.cmx \
+    kernel/names.cmx parsing/pcoq.cmx parsing/ppconstr.cmx \
+    pretyping/rawterm.cmx proofs/tacexpr.cmx kernel/term.cmx \
+    interp/topconstr.cmx lib/util.cmx toplevel/vernacexpr.cmx \
     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 
-contrib/jprover/jall.cmx: lib/pp.cmx contrib/jprover/opname.cmx \
-    contrib/jprover/jtunify.cmx contrib/jprover/jterm.cmx \
-    contrib/jprover/jlogic.cmx contrib/jprover/jall.cmi 
-contrib/jprover/jlogic.cmo: contrib/jprover/opname.cmi \
-    contrib/jprover/jterm.cmi contrib/jprover/jlogic.cmi 
-contrib/jprover/jlogic.cmx: contrib/jprover/opname.cmx \
-    contrib/jprover/jterm.cmx contrib/jprover/jlogic.cmi 
-contrib/jprover/jprover.cmo: lib/util.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 parsing/printer.cmi \
-    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi pretyping/pattern.cmi \
-    lib/options.cmi kernel/names.cmi contrib/jprover/jterm.cmi \
-    contrib/jprover/jlogic.cmi contrib/jprover/jall.cmi tactics/hipattern.cmi \
-    tactics/hiddentac.cmi library/global.cmi interp/genarg.cmi \
-    parsing/egrammar.cmi proofs/clenv.cmi toplevel/cerrors.cmi 
-contrib/jprover/jprover.cmx: lib/util.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 parsing/printer.cmx \
-    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx pretyping/pattern.cmx \
-    lib/options.cmx kernel/names.cmx contrib/jprover/jterm.cmx \
-    contrib/jprover/jlogic.cmx contrib/jprover/jall.cmx tactics/hipattern.cmx \
-    tactics/hiddentac.cmx library/global.cmx interp/genarg.cmx \
-    parsing/egrammar.cmx proofs/clenv.cmx toplevel/cerrors.cmx 
+contrib/jprover/jall.cmo: contrib/jprover/jlogic.cmi \
+    contrib/jprover/jterm.cmi contrib/jprover/jtunify.cmi \
+    contrib/jprover/opname.cmi lib/pp.cmi contrib/jprover/jall.cmi 
+contrib/jprover/jall.cmx: contrib/jprover/jlogic.cmx \
+    contrib/jprover/jterm.cmx contrib/jprover/jtunify.cmx \
+    contrib/jprover/opname.cmx lib/pp.cmx contrib/jprover/jall.cmi 
+contrib/jprover/jlogic.cmo: contrib/jprover/jterm.cmi \
+    contrib/jprover/opname.cmi contrib/jprover/jlogic.cmi 
+contrib/jprover/jlogic.cmx: contrib/jprover/jterm.cmx \
+    contrib/jprover/opname.cmx contrib/jprover/jlogic.cmi 
+contrib/jprover/jprover.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    pretyping/evarutil.cmi interp/genarg.cmi library/global.cmi \
+    tactics/hiddentac.cmi tactics/hipattern.cmi contrib/jprover/jall.cmi \
+    contrib/jprover/jlogic.cmi contrib/jprover/jterm.cmi kernel/names.cmi \
+    pretyping/pattern.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    parsing/printer.cmi proofs/proof_type.cmi pretyping/rawterm.cmi \
+    kernel/reduction.cmi pretyping/reductionops.cmi proofs/refiner.cmi \
+    proofs/tacexpr.cmo tactics/tacinterp.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi 
+contrib/jprover/jprover.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    pretyping/evarutil.cmx interp/genarg.cmx library/global.cmx \
+    tactics/hiddentac.cmx tactics/hipattern.cmx contrib/jprover/jall.cmx \
+    contrib/jprover/jlogic.cmx contrib/jprover/jterm.cmx kernel/names.cmx \
+    pretyping/pattern.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    parsing/printer.cmx proofs/proof_type.cmx pretyping/rawterm.cmx \
+    kernel/reduction.cmx pretyping/reductionops.cmx proofs/refiner.cmx \
+    proofs/tacexpr.cmx tactics/tacinterp.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx 
 contrib/jprover/jterm.cmo: contrib/jprover/opname.cmi \
     contrib/jprover/jterm.cmi 
 contrib/jprover/jterm.cmx: contrib/jprover/opname.cmx \
@@ -3046,229 +3242,501 @@ contrib/jprover/jtunify.cmo: contrib/jprover/jtunify.cmi
 contrib/jprover/jtunify.cmx: contrib/jprover/jtunify.cmi 
 contrib/jprover/opname.cmo: contrib/jprover/opname.cmi 
 contrib/jprover/opname.cmx: contrib/jprover/opname.cmi 
-contrib/omega/coq_omega.cmo: lib/util.cmi pretyping/termops.cmi \
-    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
-    pretyping/tacred.cmi proofs/tacmach.cmi kernel/sign.cmi \
-    kernel/reduction.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
-    parsing/printer.cmi lib/pp.cmi lib/options.cmi contrib/omega/omega.cmo \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi proofs/logic.cmi \
-    library/library.cmi library/libnames.cmi kernel/inductive.cmi \
-    library/goptions.cmi library/global.cmi proofs/evar_refiner.cmi \
-    tactics/equality.cmi kernel/environ.cmi kernel/declarations.cmi \
-    interp/coqlib.cmi tactics/contradiction.cmi kernel/closure.cmi \
-    proofs/clenv.cmi parsing/ast.cmi 
-contrib/omega/coq_omega.cmx: lib/util.cmx pretyping/termops.cmx \
-    kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
-    pretyping/tacred.cmx proofs/tacmach.cmx kernel/sign.cmx \
-    kernel/reduction.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
-    parsing/printer.cmx lib/pp.cmx lib/options.cmx contrib/omega/omega.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx proofs/logic.cmx \
-    library/library.cmx library/libnames.cmx kernel/inductive.cmx \
-    library/goptions.cmx library/global.cmx proofs/evar_refiner.cmx \
-    tactics/equality.cmx kernel/environ.cmx kernel/declarations.cmx \
-    interp/coqlib.cmx tactics/contradiction.cmx kernel/closure.cmx \
-    proofs/clenv.cmx parsing/ast.cmx 
-contrib/omega/g_omega.cmo: lib/util.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo proofs/refiner.cmi parsing/pptactic.cmi lib/pp.cmi \
-    parsing/pcoq.cmi lib/options.cmi parsing/egrammar.cmi \
-    contrib/omega/coq_omega.cmo toplevel/cerrors.cmi 
-contrib/omega/g_omega.cmx: lib/util.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx proofs/refiner.cmx parsing/pptactic.cmx lib/pp.cmx \
-    parsing/pcoq.cmx lib/options.cmx parsing/egrammar.cmx \
-    contrib/omega/coq_omega.cmx toplevel/cerrors.cmx 
-contrib/omega/omega.cmo: lib/util.cmi kernel/names.cmi library/nameops.cmi 
-contrib/omega/omega.cmx: lib/util.cmx kernel/names.cmx library/nameops.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 lib/options.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 lib/options.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 \
-    parsing/pcoq.cmi lib/options.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 \
-    parsing/pcoq.cmx lib/options.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 \
-    pretyping/matching.cmi library/library.cmi pretyping/instantiate.cmi \
-    library/global.cmi kernel/environ.cmi interp/coqlib.cmi 
-contrib/ring/quote.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx proofs/tacmach.cmx proofs/tacexpr.cmx \
-    proofs/proof_trees.cmx lib/pp.cmx pretyping/pattern.cmx kernel/names.cmx \
-    pretyping/matching.cmx library/library.cmx pretyping/instantiate.cmx \
-    library/global.cmx kernel/environ.cmx interp/coqlib.cmx 
-contrib/ring/ring.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \
-    lib/util.cmi pretyping/typing.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo library/summary.cmi tactics/setoid_replace.cmi \
-    pretyping/reductionops.cmi contrib/ring/quote.cmo proofs/proof_trees.cmi \
-    parsing/printer.cmi lib/pp.cmi pretyping/pattern.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    library/library.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi tactics/hipattern.cmi tactics/hiddentac.cmi \
-    library/global.cmi pretyping/evd.cmi tactics/equality.cmi \
-    interp/coqlib.cmi interp/constrintern.cmi kernel/closure.cmi 
-contrib/ring/ring.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \
-    lib/util.cmx pretyping/typing.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx pretyping/tacred.cmx proofs/tacmach.cmx \
-    proofs/tacexpr.cmx library/summary.cmx tactics/setoid_replace.cmx \
-    pretyping/reductionops.cmx contrib/ring/quote.cmx proofs/proof_trees.cmx \
-    parsing/printer.cmx lib/pp.cmx pretyping/pattern.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    library/library.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx tactics/hipattern.cmx tactics/hiddentac.cmx \
-    library/global.cmx pretyping/evd.cmx tactics/equality.cmx \
-    interp/coqlib.cmx interp/constrintern.cmx kernel/closure.cmx 
-contrib/romega/const_omega.cmo: lib/util.cmi kernel/term.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/libnames.cmi \
-    library/global.cmi interp/coqlib.cmi 
-contrib/romega/const_omega.cmx: lib/util.cmx kernel/term.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/libnames.cmx \
-    library/global.cmx interp/coqlib.cmx 
-contrib/romega/g_romega.cmo: lib/util.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo contrib/romega/refl_omega.cmo proofs/refiner.cmi \
-    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi lib/options.cmi \
-    parsing/egrammar.cmi toplevel/cerrors.cmi 
-contrib/romega/g_romega.cmx: lib/util.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx contrib/romega/refl_omega.cmx proofs/refiner.cmx \
-    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx lib/options.cmx \
-    parsing/egrammar.cmx toplevel/cerrors.cmx 
-contrib/romega/omega2.cmo: lib/util.cmi kernel/names.cmi 
-contrib/romega/omega2.cmx: lib/util.cmx kernel/names.cmx 
-contrib/romega/refl_omega.cmo: lib/util.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
-    parsing/printer.cmi lib/pp.cmi lib/options.cmi contrib/romega/omega2.cmo \
-    kernel/names.cmi proofs/logic.cmi contrib/romega/const_omega.cmo 
-contrib/romega/refl_omega.cmx: lib/util.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
-    parsing/printer.cmx lib/pp.cmx lib/options.cmx contrib/romega/omega2.cmx \
-    kernel/names.cmx proofs/logic.cmx contrib/romega/const_omega.cmx 
-contrib/xml/acic.cmo: kernel/term.cmi kernel/names.cmi 
-contrib/xml/acic.cmx: kernel/term.cmx kernel/names.cmx 
-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 
-contrib/xml/acic2Xml.cmx: contrib/xml/xml.cmx lib/util.cmx kernel/term.cmx \
-    kernel/names.cmx contrib/xml/cic2acic.cmx contrib/xml/acic.cmx 
-contrib/xml/cic2acic.cmo: lib/util.cmi contrib/xml/unshare.cmi \
-    kernel/univ.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 \
-    pretyping/instantiate.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
-    library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
-    kernel/environ.cmi contrib/xml/doubleTypeInference.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 \
-    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 \
-    pretyping/instantiate.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
-    library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
-    kernel/environ.cmx contrib/xml/doubleTypeInference.cmx \
-    library/dischargedhypsmap.cmx library/declare.cmx kernel/declarations.cmx \
-    contrib/xml/acic.cmx 
-contrib/xml/doubleTypeInference.cmo: lib/util.cmi contrib/xml/unshare.cmi \
-    kernel/typeops.cmi pretyping/termops.cmi kernel/term.cmi \
-    pretyping/tacred.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \
-    kernel/reduction.cmi pretyping/rawterm.cmi parsing/printer.cmi lib/pp.cmi \
-    kernel/names.cmi library/libnames.cmi pretyping/instantiate.cmi \
-    kernel/inductive.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
-    kernel/environ.cmi kernel/conv_oracle.cmi contrib/xml/acic.cmo \
-    contrib/xml/doubleTypeInference.cmi 
-contrib/xml/doubleTypeInference.cmx: lib/util.cmx contrib/xml/unshare.cmx \
-    kernel/typeops.cmx pretyping/termops.cmx kernel/term.cmx \
-    pretyping/tacred.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \
-    kernel/reduction.cmx pretyping/rawterm.cmx parsing/printer.cmx lib/pp.cmx \
-    kernel/names.cmx library/libnames.cmx pretyping/instantiate.cmx \
-    kernel/inductive.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
-    kernel/environ.cmx kernel/conv_oracle.cmx contrib/xml/acic.cmx \
-    contrib/xml/doubleTypeInference.cmi 
-contrib/xml/proof2aproof.cmo: lib/util.cmi contrib/xml/unshare.cmi \
-    pretyping/termops.cmi kernel/term.cmi proofs/tacmach.cmi kernel/sign.cmi \
-    proofs/refiner.cmi proofs/proof_type.cmi lib/pp.cmi proofs/logic.cmi \
-    pretyping/instantiate.cmi library/global.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi 
-contrib/xml/proof2aproof.cmx: lib/util.cmx contrib/xml/unshare.cmx \
-    pretyping/termops.cmx kernel/term.cmx proofs/tacmach.cmx kernel/sign.cmx \
-    proofs/refiner.cmx proofs/proof_type.cmx lib/pp.cmx proofs/logic.cmx \
-    pretyping/instantiate.cmx library/global.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx 
-contrib/xml/proofTree2Xml.cmo: contrib/xml/xml.cmi lib/util.cmi \
-    contrib/xml/unshare.cmi kernel/term.cmi proofs/tacexpr.cmo \
-    kernel/sign.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    contrib/xml/proof2aproof.cmo parsing/printer.cmi \
-    translate/pptacticnew.cmi parsing/pptactic.cmi lib/pp.cmi lib/options.cmi \
-    kernel/names.cmi proofs/logic.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi contrib/xml/cic2acic.cmo contrib/xml/acic2Xml.cmo \
-    contrib/xml/acic.cmo 
-contrib/xml/proofTree2Xml.cmx: contrib/xml/xml.cmx lib/util.cmx \
-    contrib/xml/unshare.cmx kernel/term.cmx proofs/tacexpr.cmx \
-    kernel/sign.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
-    contrib/xml/proof2aproof.cmx parsing/printer.cmx \
-    translate/pptacticnew.cmx parsing/pptactic.cmx lib/pp.cmx lib/options.cmx \
-    kernel/names.cmx proofs/logic.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx contrib/xml/cic2acic.cmx contrib/xml/acic2Xml.cmx \
-    contrib/xml/acic.cmx 
+contrib/omega/coq_omega.cmo: lib/bigint.cmi pretyping/clenv.cmi \
+    kernel/closure.cmi tactics/contradiction.cmi interp/coqlib.cmi \
+    kernel/declarations.cmi kernel/environ.cmi tactics/equality.cmi \
+    proofs/evar_refiner.cmi pretyping/evarutil.cmi library/global.cmi \
+    library/goptions.cmi kernel/inductive.cmi library/libnames.cmi \
+    proofs/logic.cmi library/nameops.cmi kernel/names.cmi library/nametab.cmi \
+    contrib/omega/omega.cmo lib/pp.cmi parsing/printer.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi kernel/reduction.cmi \
+    kernel/sign.cmi proofs/tacmach.cmi pretyping/tacred.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi 
+contrib/omega/coq_omega.cmx: lib/bigint.cmx pretyping/clenv.cmx \
+    kernel/closure.cmx tactics/contradiction.cmx interp/coqlib.cmx \
+    kernel/declarations.cmx kernel/environ.cmx tactics/equality.cmx \
+    proofs/evar_refiner.cmx pretyping/evarutil.cmx library/global.cmx \
+    library/goptions.cmx kernel/inductive.cmx library/libnames.cmx \
+    proofs/logic.cmx library/nameops.cmx kernel/names.cmx library/nametab.cmx \
+    contrib/omega/omega.cmx lib/pp.cmx parsing/printer.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx kernel/reduction.cmx \
+    kernel/sign.cmx proofs/tacmach.cmx pretyping/tacred.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx 
+contrib/omega/g_omega.cmo: toplevel/cerrors.cmi contrib/omega/coq_omega.cmo \
+    parsing/egrammar.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    proofs/refiner.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi lib/util.cmi 
+contrib/omega/g_omega.cmx: toplevel/cerrors.cmx contrib/omega/coq_omega.cmx \
+    parsing/egrammar.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    proofs/refiner.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx lib/util.cmx 
+contrib/omega/omega.cmo: kernel/names.cmi lib/util.cmi 
+contrib/omega/omega.cmx: kernel/names.cmx lib/util.cmx 
+contrib/recdef/recdef.cmo: tactics/auto.cmi toplevel/cerrors.cmi \
+    kernel/closure.cmi toplevel/command.cmi interp/constrintern.cmi \
+    interp/coqlib.cmi library/decl_kinds.cmo kernel/declarations.cmi \
+    library/declare.cmi tactics/eauto.cmi parsing/egrammar.cmi \
+    tactics/elim.cmi kernel/entries.cmi kernel/environ.cmi \
+    tactics/equality.cmi pretyping/evd.cmi interp/genarg.cmi \
+    library/global.cmi tactics/hiddentac.cmi library/lib.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/options.cmi parsing/pcoq.cmi proofs/pfedit.cmi \
+    lib/pp.cmi pretyping/pretyping.cmi parsing/printer.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi kernel/safe_typing.cmi \
+    proofs/tacmach.cmi pretyping/tacred.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/termops.cmi \
+    interp/topconstr.cmi pretyping/typing.cmi lib/util.cmi \
+    toplevel/vernacinterp.cmi 
+contrib/recdef/recdef.cmx: tactics/auto.cmx toplevel/cerrors.cmx \
+    kernel/closure.cmx toplevel/command.cmx interp/constrintern.cmx \
+    interp/coqlib.cmx library/decl_kinds.cmx kernel/declarations.cmx \
+    library/declare.cmx tactics/eauto.cmx parsing/egrammar.cmx \
+    tactics/elim.cmx kernel/entries.cmx kernel/environ.cmx \
+    tactics/equality.cmx pretyping/evd.cmx interp/genarg.cmx \
+    library/global.cmx tactics/hiddentac.cmx library/lib.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/options.cmx parsing/pcoq.cmx proofs/pfedit.cmx \
+    lib/pp.cmx pretyping/pretyping.cmx parsing/printer.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx kernel/safe_typing.cmx \
+    proofs/tacmach.cmx pretyping/tacred.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/termops.cmx \
+    interp/topconstr.cmx pretyping/typing.cmx lib/util.cmx \
+    toplevel/vernacinterp.cmx 
+contrib/ring/g_quote.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    interp/genarg.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    contrib/ring/quote.cmo proofs/refiner.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi lib/util.cmi 
+contrib/ring/g_quote.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    interp/genarg.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    contrib/ring/quote.cmx proofs/refiner.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx lib/util.cmx 
+contrib/ring/g_ring.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    interp/genarg.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    contrib/ring/quote.cmo proofs/refiner.cmi contrib/ring/ring.cmo \
+    proofs/tacexpr.cmo tactics/tacinterp.cmi lib/util.cmi \
+    toplevel/vernacinterp.cmi 
+contrib/ring/g_ring.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    interp/genarg.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    contrib/ring/quote.cmx proofs/refiner.cmx contrib/ring/ring.cmx \
+    proofs/tacexpr.cmx tactics/tacinterp.cmx lib/util.cmx \
+    toplevel/vernacinterp.cmx 
+contrib/ring/quote.cmo: interp/coqlib.cmi kernel/environ.cmi \
+    library/global.cmi pretyping/matching.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi proofs/proof_trees.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi lib/util.cmi 
+contrib/ring/quote.cmx: interp/coqlib.cmx kernel/environ.cmx \
+    library/global.cmx pretyping/matching.cmx kernel/names.cmx \
+    pretyping/pattern.cmx lib/pp.cmx proofs/proof_trees.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx lib/util.cmx 
+contrib/ring/ring.cmo: kernel/closure.cmi interp/constrintern.cmi \
+    interp/coqlib.cmi tactics/equality.cmi pretyping/evd.cmi \
+    library/global.cmi tactics/hiddentac.cmi tactics/hipattern.cmi \
+    library/lib.cmi library/libnames.cmi library/libobject.cmi \
+    kernel/mod_subst.cmi library/nameops.cmi kernel/names.cmi \
+    library/nametab.cmi lib/options.cmi pretyping/pattern.cmi lib/pp.cmi \
+    parsing/printer.cmi proofs/proof_trees.cmi contrib/ring/quote.cmo \
+    pretyping/reductionops.cmi tactics/setoid_replace.cmi library/summary.cmi \
+    proofs/tacexpr.cmo proofs/tacmach.cmi pretyping/tacred.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/typing.cmi lib/util.cmi toplevel/vernacexpr.cmo \
+    toplevel/vernacinterp.cmi 
+contrib/ring/ring.cmx: kernel/closure.cmx interp/constrintern.cmx \
+    interp/coqlib.cmx tactics/equality.cmx pretyping/evd.cmx \
+    library/global.cmx tactics/hiddentac.cmx tactics/hipattern.cmx \
+    library/lib.cmx library/libnames.cmx library/libobject.cmx \
+    kernel/mod_subst.cmx library/nameops.cmx kernel/names.cmx \
+    library/nametab.cmx lib/options.cmx pretyping/pattern.cmx lib/pp.cmx \
+    parsing/printer.cmx proofs/proof_trees.cmx contrib/ring/quote.cmx \
+    pretyping/reductionops.cmx tactics/setoid_replace.cmx library/summary.cmx \
+    proofs/tacexpr.cmx proofs/tacmach.cmx pretyping/tacred.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/typing.cmx lib/util.cmx toplevel/vernacexpr.cmx \
+    toplevel/vernacinterp.cmx 
+contrib/romega/const_omega.cmo: lib/bigint.cmi interp/coqlib.cmi \
+    library/libnames.cmi kernel/names.cmi library/nametab.cmi kernel/term.cmi \
+    lib/util.cmi 
+contrib/romega/const_omega.cmx: lib/bigint.cmx interp/coqlib.cmx \
+    library/libnames.cmx kernel/names.cmx library/nametab.cmx kernel/term.cmx \
+    lib/util.cmx 
+contrib/romega/g_romega.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi proofs/refiner.cmi \
+    contrib/romega/refl_omega.cmo proofs/tacexpr.cmo tactics/tacinterp.cmi \
+    lib/util.cmi 
+contrib/romega/g_romega.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx proofs/refiner.cmx \
+    contrib/romega/refl_omega.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \
+    lib/util.cmx 
+contrib/romega/refl_omega.cmo: lib/bigint.cmi contrib/romega/const_omega.cmo \
+    interp/coqlib.cmi proofs/logic.cmi kernel/names.cmi \
+    contrib/omega/omega.cmo lib/pp.cmi parsing/printer.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi lib/util.cmi 
+contrib/romega/refl_omega.cmx: lib/bigint.cmx contrib/romega/const_omega.cmx \
+    interp/coqlib.cmx proofs/logic.cmx kernel/names.cmx \
+    contrib/omega/omega.cmx lib/pp.cmx parsing/printer.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx lib/util.cmx 
+contrib/rtauto/g_rtauto.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi proofs/refiner.cmi \
+    contrib/rtauto/refl_tauto.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \
+    lib/util.cmi 
+contrib/rtauto/g_rtauto.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx proofs/refiner.cmx \
+    contrib/rtauto/refl_tauto.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \
+    lib/util.cmx 
+contrib/rtauto/proof_search.cmo: library/goptions.cmi lib/pp.cmi \
+    kernel/term.cmi lib/util.cmi contrib/rtauto/proof_search.cmi 
+contrib/rtauto/proof_search.cmx: library/goptions.cmx lib/pp.cmx \
+    kernel/term.cmx lib/util.cmx contrib/rtauto/proof_search.cmi 
+contrib/rtauto/refl_tauto.cmo: kernel/closure.cmi interp/coqlib.cmi \
+    kernel/environ.cmi pretyping/evd.cmi lib/explore.cmi library/goptions.cmi \
+    kernel/names.cmi lib/pp.cmi contrib/rtauto/proof_search.cmi \
+    pretyping/retyping.cmi lib/system.cmi tactics/tacinterp.cmi \
+    proofs/tacmach.cmi proofs/tactic_debug.cmi tactics/tactics.cmi \
+    kernel/term.cmi pretyping/termops.cmi lib/util.cmi \
+    contrib/rtauto/refl_tauto.cmi 
+contrib/rtauto/refl_tauto.cmx: kernel/closure.cmx interp/coqlib.cmx \
+    kernel/environ.cmx pretyping/evd.cmx lib/explore.cmx library/goptions.cmx \
+    kernel/names.cmx lib/pp.cmx contrib/rtauto/proof_search.cmx \
+    pretyping/retyping.cmx lib/system.cmx tactics/tacinterp.cmx \
+    proofs/tacmach.cmx proofs/tactic_debug.cmx tactics/tactics.cmx \
+    kernel/term.cmx pretyping/termops.cmx lib/util.cmx \
+    contrib/rtauto/refl_tauto.cmi 
+contrib/setoid_ring/newring.cmo: toplevel/cerrors.cmi kernel/closure.cmi \
+    interp/constrintern.cmi interp/coqlib.cmi parsing/egrammar.cmi \
+    kernel/environ.cmi kernel/esubst.cmi pretyping/evd.cmi interp/genarg.cmi \
+    library/global.cmi parsing/lexer.cmi library/lib.cmi \
+    library/libobject.cmi kernel/mod_subst.cmi kernel/names.cmi \
+    parsing/pcoq.cmi lib/pp.cmi parsing/ppconstr.cmi parsing/pptactic.cmi \
+    pretyping/pretyping.cmi parsing/printer.cmi proofs/proof_type.cmi \
+    pretyping/rawterm.cmi proofs/refiner.cmi pretyping/retyping.cmi \
+    tactics/setoid_replace.cmi library/summary.cmi proofs/tacexpr.cmo \
+    tactics/tacinterp.cmi proofs/tacmach.cmi tactics/tacticals.cmi \
+    tactics/tactics.cmi kernel/term.cmi pretyping/typing.cmi lib/util.cmi \
+    toplevel/vernacinterp.cmi 
+contrib/setoid_ring/newring.cmx: toplevel/cerrors.cmx kernel/closure.cmx \
+    interp/constrintern.cmx interp/coqlib.cmx parsing/egrammar.cmx \
+    kernel/environ.cmx kernel/esubst.cmx pretyping/evd.cmx interp/genarg.cmx \
+    library/global.cmx parsing/lexer.cmx library/lib.cmx \
+    library/libobject.cmx kernel/mod_subst.cmx kernel/names.cmx \
+    parsing/pcoq.cmx lib/pp.cmx parsing/ppconstr.cmx parsing/pptactic.cmx \
+    pretyping/pretyping.cmx parsing/printer.cmx proofs/proof_type.cmx \
+    pretyping/rawterm.cmx proofs/refiner.cmx pretyping/retyping.cmx \
+    tactics/setoid_replace.cmx library/summary.cmx proofs/tacexpr.cmx \
+    tactics/tacinterp.cmx proofs/tacmach.cmx tactics/tacticals.cmx \
+    tactics/tactics.cmx kernel/term.cmx pretyping/typing.cmx lib/util.cmx \
+    toplevel/vernacinterp.cmx 
+contrib/subtac/context.cmo: kernel/names.cmi kernel/term.cmi \
+    contrib/subtac/context.cmi 
+contrib/subtac/context.cmx: kernel/names.cmx kernel/term.cmx \
+    contrib/subtac/context.cmi 
+contrib/subtac/eterm.cmo: library/decl_kinds.cmo library/declare.cmi \
+    kernel/environ.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    library/global.cmi kernel/names.cmi lib/pp.cmi proofs/tacmach.cmi \
+    tactics/tacticals.cmi tactics/tactics.cmi kernel/term.cmi \
+    pretyping/termops.cmi contrib/subtac/eterm.cmi 
+contrib/subtac/eterm.cmx: library/decl_kinds.cmx library/declare.cmx \
+    kernel/environ.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    library/global.cmx kernel/names.cmx lib/pp.cmx proofs/tacmach.cmx \
+    tactics/tacticals.cmx tactics/tactics.cmx kernel/term.cmx \
+    pretyping/termops.cmx contrib/subtac/eterm.cmi 
+contrib/subtac/g_eterm.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    contrib/subtac/eterm.cmi parsing/pcoq.cmi lib/pp.cmi parsing/pptactic.cmi \
+    proofs/refiner.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \
+    proofs/tacmach.cmi lib/util.cmi 
+contrib/subtac/g_eterm.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    contrib/subtac/eterm.cmx parsing/pcoq.cmx lib/pp.cmx parsing/pptactic.cmx \
+    proofs/refiner.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \
+    proofs/tacmach.cmx lib/util.cmx 
+contrib/subtac/g_subtac.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    interp/genarg.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi lib/options.cmi parsing/pcoq.cmi lib/pp.cmi \
+    kernel/reduction.cmi contrib/subtac/subtac.cmi proofs/tacexpr.cmo \
+    kernel/term.cmi interp/topconstr.cmi lib/util.cmi \
+    toplevel/vernacentries.cmi toplevel/vernacexpr.cmo \
+    toplevel/vernacinterp.cmi 
+contrib/subtac/g_subtac.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    interp/genarg.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx lib/options.cmx parsing/pcoq.cmx lib/pp.cmx \
+    kernel/reduction.cmx contrib/subtac/subtac.cmx proofs/tacexpr.cmx \
+    kernel/term.cmx interp/topconstr.cmx lib/util.cmx \
+    toplevel/vernacentries.cmx toplevel/vernacexpr.cmx \
+    toplevel/vernacinterp.cmx 
+contrib/subtac/subtac_coercion.cmo: pretyping/classops.cmi \
+    contrib/subtac/context.cmi interp/coqlib.cmi kernel/environ.cmi \
+    contrib/subtac/eterm.cmi pretyping/evarconv.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi library/global.cmi kernel/names.cmi lib/pp.cmi \
+    pretyping/pretype_errors.cmi parsing/printer.cmi pretyping/rawterm.cmi \
+    pretyping/recordops.cmi kernel/reduction.cmi pretyping/reductionops.cmi \
+    pretyping/retyping.cmi contrib/subtac/subtac_errors.cmi \
+    contrib/subtac/subtac_utils.cmi kernel/term.cmi kernel/typeops.cmi \
+    lib/util.cmi contrib/subtac/subtac_coercion.cmi 
+contrib/subtac/subtac_coercion.cmx: pretyping/classops.cmx \
+    contrib/subtac/context.cmx interp/coqlib.cmx kernel/environ.cmx \
+    contrib/subtac/eterm.cmx pretyping/evarconv.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx library/global.cmx kernel/names.cmx lib/pp.cmx \
+    pretyping/pretype_errors.cmx parsing/printer.cmx pretyping/rawterm.cmx \
+    pretyping/recordops.cmx kernel/reduction.cmx pretyping/reductionops.cmx \
+    pretyping/retyping.cmx contrib/subtac/subtac_errors.cmx \
+    contrib/subtac/subtac_utils.cmx kernel/term.cmx kernel/typeops.cmx \
+    lib/util.cmx contrib/subtac/subtac_coercion.cmi 
+contrib/subtac/subtac_command.cmo: kernel/closure.cmi toplevel/command.cmi \
+    interp/constrintern.cmi library/decl_kinds.cmo kernel/declarations.cmi \
+    library/declare.cmi lib/dyn.cmi kernel/entries.cmi kernel/environ.cmi \
+    contrib/subtac/eterm.cmi pretyping/evd.cmi interp/genarg.cmi \
+    library/global.cmi tactics/hiddentac.cmi library/impargs.cmi \
+    pretyping/inductiveops.cmi library/libnames.cmi library/libobject.cmi \
+    pretyping/matching.cmi toplevel/metasyntax.cmi kernel/mod_subst.cmi \
+    library/nameops.cmi kernel/names.cmi library/nametab.cmi \
+    interp/notation.cmi lib/options.cmi pretyping/pattern.cmi \
+    proofs/pfedit.cmi lib/pp.cmi pretyping/pretyping.cmi parsing/printer.cmi \
+    proofs/proof_type.cmi pretyping/rawterm.cmi proofs/refiner.cmi \
+    kernel/safe_typing.cmi kernel/sign.cmi library/states.cmi \
+    contrib/subtac/subtac_interp_fixpoint.cmi \
+    contrib/subtac/subtac_pretyping.cmi contrib/subtac/subtac_utils.cmi \
+    interp/syntax_def.cmi proofs/tacexpr.cmo tactics/tacinterp.cmi \
+    proofs/tacmach.cmi pretyping/tacred.cmi proofs/tactic_debug.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \
+    pretyping/typing.cmi lib/util.cmi toplevel/vernacexpr.cmo \
+    contrib/subtac/subtac_command.cmi 
+contrib/subtac/subtac_command.cmx: kernel/closure.cmx toplevel/command.cmx \
+    interp/constrintern.cmx library/decl_kinds.cmx kernel/declarations.cmx \
+    library/declare.cmx lib/dyn.cmx kernel/entries.cmx kernel/environ.cmx \
+    contrib/subtac/eterm.cmx pretyping/evd.cmx interp/genarg.cmx \
+    library/global.cmx tactics/hiddentac.cmx library/impargs.cmx \
+    pretyping/inductiveops.cmx library/libnames.cmx library/libobject.cmx \
+    pretyping/matching.cmx toplevel/metasyntax.cmx kernel/mod_subst.cmx \
+    library/nameops.cmx kernel/names.cmx library/nametab.cmx \
+    interp/notation.cmx lib/options.cmx pretyping/pattern.cmx \
+    proofs/pfedit.cmx lib/pp.cmx pretyping/pretyping.cmx parsing/printer.cmx \
+    proofs/proof_type.cmx pretyping/rawterm.cmx proofs/refiner.cmx \
+    kernel/safe_typing.cmx kernel/sign.cmx library/states.cmx \
+    contrib/subtac/subtac_interp_fixpoint.cmx \
+    contrib/subtac/subtac_pretyping.cmx contrib/subtac/subtac_utils.cmx \
+    interp/syntax_def.cmx proofs/tacexpr.cmx tactics/tacinterp.cmx \
+    proofs/tacmach.cmx pretyping/tacred.cmx proofs/tactic_debug.cmx \
+    kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \
+    pretyping/typing.cmx lib/util.cmx toplevel/vernacexpr.cmx \
+    contrib/subtac/subtac_command.cmi 
+contrib/subtac/subtac_errors.cmo: lib/pp.cmi parsing/printer.cmi lib/util.cmi \
+    contrib/subtac/subtac_errors.cmi 
+contrib/subtac/subtac_errors.cmx: lib/pp.cmx parsing/printer.cmx lib/util.cmx \
+    contrib/subtac/subtac_errors.cmi 
+contrib/subtac/subtac_interp_fixpoint.cmo: pretyping/classops.cmi \
+    contrib/subtac/context.cmi interp/coqlib.cmi lib/dyn.cmi \
+    kernel/environ.cmi contrib/subtac/eterm.cmi pretyping/evarconv.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi \
+    library/libnames.cmi library/nameops.cmi kernel/names.cmi \
+    pretyping/pattern.cmi lib/pp.cmi parsing/ppconstr.cmi \
+    pretyping/pretype_errors.cmi parsing/printer.cmi pretyping/rawterm.cmi \
+    pretyping/recordops.cmi pretyping/reductionops.cmi kernel/sign.cmi \
+    contrib/subtac/subtac_coercion.cmi contrib/subtac/subtac_errors.cmi \
+    contrib/subtac/subtac_utils.cmi kernel/term.cmi pretyping/termops.cmi \
+    interp/topconstr.cmi kernel/type_errors.cmi kernel/typeops.cmi \
+    lib/util.cmi contrib/subtac/subtac_interp_fixpoint.cmi 
+contrib/subtac/subtac_interp_fixpoint.cmx: pretyping/classops.cmx \
+    contrib/subtac/context.cmx interp/coqlib.cmx lib/dyn.cmx \
+    kernel/environ.cmx contrib/subtac/eterm.cmx pretyping/evarconv.cmx \
+    pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx \
+    library/libnames.cmx library/nameops.cmx kernel/names.cmx \
+    pretyping/pattern.cmx lib/pp.cmx parsing/ppconstr.cmx \
+    pretyping/pretype_errors.cmx parsing/printer.cmx pretyping/rawterm.cmx \
+    pretyping/recordops.cmx pretyping/reductionops.cmx kernel/sign.cmx \
+    contrib/subtac/subtac_coercion.cmx contrib/subtac/subtac_errors.cmx \
+    contrib/subtac/subtac_utils.cmx kernel/term.cmx pretyping/termops.cmx \
+    interp/topconstr.cmx kernel/type_errors.cmx kernel/typeops.cmx \
+    lib/util.cmx contrib/subtac/subtac_interp_fixpoint.cmi 
+contrib/subtac/subtac.cmo: toplevel/cerrors.cmi pretyping/classops.cmi \
+    toplevel/command.cmi contrib/subtac/context.cmi interp/coqlib.cmi \
+    lib/dyn.cmi kernel/environ.cmi contrib/subtac/eterm.cmi \
+    pretyping/evarconv.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    library/global.cmi toplevel/himsg.cmi library/libnames.cmi \
+    library/library.cmi kernel/names.cmi pretyping/pattern.cmi \
+    proofs/pfedit.cmi lib/pp.cmi parsing/ppconstr.cmi \
+    pretyping/pretype_errors.cmi parsing/printer.cmi pretyping/rawterm.cmi \
+    pretyping/recordops.cmi pretyping/reductionops.cmi kernel/sign.cmi \
+    contrib/subtac/subtac_coercion.cmi contrib/subtac/subtac_command.cmi \
+    contrib/subtac/subtac_errors.cmi \
+    contrib/subtac/subtac_interp_fixpoint.cmi \
+    contrib/subtac/subtac_pretyping.cmi contrib/subtac/subtac_utils.cmi \
+    kernel/term.cmi pretyping/termops.cmi kernel/type_errors.cmi \
+    kernel/typeops.cmi lib/util.cmi toplevel/vernacexpr.cmo \
+    contrib/subtac/subtac.cmi 
+contrib/subtac/subtac.cmx: toplevel/cerrors.cmx pretyping/classops.cmx \
+    toplevel/command.cmx contrib/subtac/context.cmx interp/coqlib.cmx \
+    lib/dyn.cmx kernel/environ.cmx contrib/subtac/eterm.cmx \
+    pretyping/evarconv.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    library/global.cmx toplevel/himsg.cmx library/libnames.cmx \
+    library/library.cmx kernel/names.cmx pretyping/pattern.cmx \
+    proofs/pfedit.cmx lib/pp.cmx parsing/ppconstr.cmx \
+    pretyping/pretype_errors.cmx parsing/printer.cmx pretyping/rawterm.cmx \
+    pretyping/recordops.cmx pretyping/reductionops.cmx kernel/sign.cmx \
+    contrib/subtac/subtac_coercion.cmx contrib/subtac/subtac_command.cmx \
+    contrib/subtac/subtac_errors.cmx \
+    contrib/subtac/subtac_interp_fixpoint.cmx \
+    contrib/subtac/subtac_pretyping.cmx contrib/subtac/subtac_utils.cmx \
+    kernel/term.cmx pretyping/termops.cmx kernel/type_errors.cmx \
+    kernel/typeops.cmx lib/util.cmx toplevel/vernacexpr.cmx \
+    contrib/subtac/subtac.cmi 
+contrib/subtac/subtac_pretyping.cmo: pretyping/classops.cmi \
+    interp/constrintern.cmi contrib/subtac/context.cmi interp/coqlib.cmi \
+    lib/dyn.cmi kernel/environ.cmi contrib/subtac/eterm.cmi \
+    pretyping/evarconv.cmi pretyping/evarutil.cmi pretyping/evd.cmi \
+    library/global.cmi library/libnames.cmi library/nameops.cmi \
+    kernel/names.cmi pretyping/pattern.cmi lib/pp.cmi \
+    pretyping/pretype_errors.cmi pretyping/pretyping.cmi parsing/printer.cmi \
+    pretyping/rawterm.cmi pretyping/recordops.cmi pretyping/reductionops.cmi \
+    kernel/sign.cmi contrib/subtac/subtac_coercion.cmi \
+    contrib/subtac/subtac_errors.cmi contrib/subtac/subtac_utils.cmi \
+    kernel/term.cmi pretyping/termops.cmi interp/topconstr.cmi \
+    kernel/type_errors.cmi kernel/typeops.cmi lib/util.cmi \
+    toplevel/vernacexpr.cmo contrib/subtac/subtac_pretyping.cmi 
+contrib/subtac/subtac_pretyping.cmx: pretyping/classops.cmx \
+    interp/constrintern.cmx contrib/subtac/context.cmx interp/coqlib.cmx \
+    lib/dyn.cmx kernel/environ.cmx contrib/subtac/eterm.cmx \
+    pretyping/evarconv.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    library/global.cmx library/libnames.cmx library/nameops.cmx \
+    kernel/names.cmx pretyping/pattern.cmx lib/pp.cmx \
+    pretyping/pretype_errors.cmx pretyping/pretyping.cmx parsing/printer.cmx \
+    pretyping/rawterm.cmx pretyping/recordops.cmx pretyping/reductionops.cmx \
+    kernel/sign.cmx contrib/subtac/subtac_coercion.cmx \
+    contrib/subtac/subtac_errors.cmx contrib/subtac/subtac_utils.cmx \
+    kernel/term.cmx pretyping/termops.cmx interp/topconstr.cmx \
+    kernel/type_errors.cmx kernel/typeops.cmx lib/util.cmx \
+    toplevel/vernacexpr.cmx contrib/subtac/subtac_pretyping.cmi 
+contrib/subtac/subtac_utils.cmo: interp/constrextern.cmi interp/coqlib.cmi \
+    library/decl_kinds.cmo pretyping/evarutil.cmi pretyping/evd.cmi \
+    library/global.cmi library/libnames.cmi kernel/names.cmi lib/pp.cmi \
+    pretyping/pretype_errors.cmi parsing/printer.cmi kernel/term.cmi \
+    pretyping/termops.cmi interp/topconstr.cmi lib/util.cmi \
+    contrib/subtac/subtac_utils.cmi 
+contrib/subtac/subtac_utils.cmx: interp/constrextern.cmx interp/coqlib.cmx \
+    library/decl_kinds.cmx pretyping/evarutil.cmx pretyping/evd.cmx \
+    library/global.cmx library/libnames.cmx kernel/names.cmx lib/pp.cmx \
+    pretyping/pretype_errors.cmx parsing/printer.cmx kernel/term.cmx \
+    pretyping/termops.cmx interp/topconstr.cmx lib/util.cmx \
+    contrib/subtac/subtac_utils.cmi 
+contrib/xml/acic2Xml.cmo: contrib/xml/acic.cmo contrib/xml/cic2acic.cmo \
+    kernel/names.cmi kernel/term.cmi lib/util.cmi contrib/xml/xml.cmi 
+contrib/xml/acic2Xml.cmx: contrib/xml/acic.cmx contrib/xml/cic2acic.cmx \
+    kernel/names.cmx kernel/term.cmx lib/util.cmx contrib/xml/xml.cmx 
+contrib/xml/acic.cmo: kernel/names.cmi kernel/term.cmi 
+contrib/xml/acic.cmx: kernel/names.cmx kernel/term.cmx 
+contrib/xml/cic2acic.cmo: contrib/xml/acic.cmo kernel/declarations.cmi \
+    library/declare.cmi library/dischargedhypsmap.cmi \
+    contrib/xml/doubleTypeInference.cmi kernel/environ.cmi pretyping/evd.cmi \
+    library/global.cmi pretyping/inductiveops.cmi library/lib.cmi \
+    library/libnames.cmi library/library.cmi library/nameops.cmi \
+    kernel/names.cmi library/nametab.cmi lib/pp.cmi parsing/printer.cmi \
+    pretyping/reductionops.cmi kernel/term.cmi pretyping/termops.cmi \
+    kernel/univ.cmi contrib/xml/unshare.cmi lib/util.cmi 
+contrib/xml/cic2acic.cmx: contrib/xml/acic.cmx kernel/declarations.cmx \
+    library/declare.cmx library/dischargedhypsmap.cmx \
+    contrib/xml/doubleTypeInference.cmx kernel/environ.cmx pretyping/evd.cmx \
+    library/global.cmx pretyping/inductiveops.cmx library/lib.cmx \
+    library/libnames.cmx library/library.cmx library/nameops.cmx \
+    kernel/names.cmx library/nametab.cmx lib/pp.cmx parsing/printer.cmx \
+    pretyping/reductionops.cmx kernel/term.cmx pretyping/termops.cmx \
+    kernel/univ.cmx contrib/xml/unshare.cmx lib/util.cmx 
+contrib/xml/cic2Xml.cmo: contrib/xml/acic.cmo contrib/xml/acic2Xml.cmo \
+    contrib/xml/cic2acic.cmo tactics/tacinterp.cmi contrib/xml/unshare.cmi \
+    contrib/xml/xml.cmi 
+contrib/xml/cic2Xml.cmx: contrib/xml/acic.cmx contrib/xml/acic2Xml.cmx \
+    contrib/xml/cic2acic.cmx tactics/tacinterp.cmx contrib/xml/unshare.cmx \
+    contrib/xml/xml.cmx 
+contrib/xml/doubleTypeInference.cmo: contrib/xml/acic.cmo \
+    kernel/conv_oracle.cmi kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi kernel/inductive.cmi pretyping/inductiveops.cmi \
+    library/libnames.cmi kernel/names.cmi lib/pp.cmi parsing/printer.cmi \
+    pretyping/rawterm.cmi proofs/redexpr.cmi kernel/reduction.cmi \
+    pretyping/reductionops.cmi pretyping/retyping.cmi kernel/term.cmi \
+    pretyping/termops.cmi kernel/typeops.cmi contrib/xml/unshare.cmi \
+    lib/util.cmi contrib/xml/doubleTypeInference.cmi 
+contrib/xml/doubleTypeInference.cmx: contrib/xml/acic.cmx \
+    kernel/conv_oracle.cmx kernel/environ.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx kernel/inductive.cmx pretyping/inductiveops.cmx \
+    library/libnames.cmx kernel/names.cmx lib/pp.cmx parsing/printer.cmx \
+    pretyping/rawterm.cmx proofs/redexpr.cmx kernel/reduction.cmx \
+    pretyping/reductionops.cmx pretyping/retyping.cmx kernel/term.cmx \
+    pretyping/termops.cmx kernel/typeops.cmx contrib/xml/unshare.cmx \
+    lib/util.cmx contrib/xml/doubleTypeInference.cmi 
+contrib/xml/proof2aproof.cmo: kernel/environ.cmi pretyping/evarutil.cmi \
+    pretyping/evd.cmi proofs/logic.cmi lib/pp.cmi proofs/proof_type.cmi \
+    proofs/refiner.cmi kernel/sign.cmi proofs/tacmach.cmi \
+    parsing/tactic_printer.cmi kernel/term.cmi pretyping/termops.cmi \
+    contrib/xml/unshare.cmi lib/util.cmi 
+contrib/xml/proof2aproof.cmx: kernel/environ.cmx pretyping/evarutil.cmx \
+    pretyping/evd.cmx proofs/logic.cmx lib/pp.cmx proofs/proof_type.cmx \
+    proofs/refiner.cmx kernel/sign.cmx proofs/tacmach.cmx \
+    parsing/tactic_printer.cmx kernel/term.cmx pretyping/termops.cmx \
+    contrib/xml/unshare.cmx lib/util.cmx 
+contrib/xml/proofTree2Xml.cmo: contrib/xml/acic.cmo contrib/xml/acic2Xml.cmo \
+    contrib/xml/cic2acic.cmo kernel/environ.cmi pretyping/evd.cmi \
+    library/global.cmi proofs/logic.cmi kernel/names.cmi lib/pp.cmi \
+    parsing/pptactic.cmi parsing/printer.cmi contrib/xml/proof2aproof.cmo \
+    proofs/proof_type.cmi kernel/sign.cmi proofs/tacexpr.cmo kernel/term.cmi \
+    contrib/xml/unshare.cmi lib/util.cmi contrib/xml/xml.cmi 
+contrib/xml/proofTree2Xml.cmx: contrib/xml/acic.cmx contrib/xml/acic2Xml.cmx \
+    contrib/xml/cic2acic.cmx kernel/environ.cmx pretyping/evd.cmx \
+    library/global.cmx proofs/logic.cmx kernel/names.cmx lib/pp.cmx \
+    parsing/pptactic.cmx parsing/printer.cmx contrib/xml/proof2aproof.cmx \
+    proofs/proof_type.cmx kernel/sign.cmx proofs/tacexpr.cmx kernel/term.cmx \
+    contrib/xml/unshare.cmx lib/util.cmx contrib/xml/xml.cmx 
 contrib/xml/unshare.cmo: contrib/xml/unshare.cmi 
 contrib/xml/unshare.cmx: contrib/xml/unshare.cmi 
+contrib/xml/xmlcommand.cmo: contrib/xml/acic.cmo contrib/xml/acic2Xml.cmo \
+    contrib/xml/cic2acic.cmo config/coq_config.cmi library/decl_kinds.cmo \
+    kernel/declarations.cmi library/declare.cmi kernel/environ.cmi \
+    pretyping/evarutil.cmi pretyping/evd.cmi library/global.cmi \
+    pretyping/inductiveops.cmi parsing/lexer.cmi library/lib.cmi \
+    library/libnames.cmi library/libobject.cmi library/library.cmi \
+    kernel/names.cmi library/nametab.cmi proofs/pfedit.cmi \
+    contrib/xml/proof2aproof.cmo proofs/proof_trees.cmi \
+    pretyping/recordops.cmi proofs/tacmach.cmi kernel/term.cmi \
+    contrib/xml/unshare.cmi lib/util.cmi toplevel/vernac.cmi \
+    contrib/xml/xml.cmi contrib/xml/xmlcommand.cmi 
+contrib/xml/xmlcommand.cmx: contrib/xml/acic.cmx contrib/xml/acic2Xml.cmx \
+    contrib/xml/cic2acic.cmx config/coq_config.cmx library/decl_kinds.cmx \
+    kernel/declarations.cmx library/declare.cmx kernel/environ.cmx \
+    pretyping/evarutil.cmx pretyping/evd.cmx library/global.cmx \
+    pretyping/inductiveops.cmx parsing/lexer.cmx library/lib.cmx \
+    library/libnames.cmx library/libobject.cmx library/library.cmx \
+    kernel/names.cmx library/nametab.cmx proofs/pfedit.cmx \
+    contrib/xml/proof2aproof.cmx proofs/proof_trees.cmx \
+    pretyping/recordops.cmx proofs/tacmach.cmx kernel/term.cmx \
+    contrib/xml/unshare.cmx lib/util.cmx toplevel/vernac.cmx \
+    contrib/xml/xml.cmx contrib/xml/xmlcommand.cmi 
+contrib/xml/xmlentries.cmo: toplevel/cerrors.cmi parsing/egrammar.cmi \
+    parsing/extend.cmi interp/genarg.cmi parsing/lexer.cmi parsing/pcoq.cmi \
+    lib/pp.cmi lib/util.cmi toplevel/vernacinterp.cmi \
+    contrib/xml/xmlcommand.cmi 
+contrib/xml/xmlentries.cmx: toplevel/cerrors.cmx parsing/egrammar.cmx \
+    parsing/extend.cmx interp/genarg.cmx parsing/lexer.cmx parsing/pcoq.cmx \
+    lib/pp.cmx lib/util.cmx toplevel/vernacinterp.cmx \
+    contrib/xml/xmlcommand.cmx 
 contrib/xml/xml.cmo: contrib/xml/xml.cmi 
 contrib/xml/xml.cmx: contrib/xml/xml.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 \
-    kernel/sign.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 \
-    kernel/inductive.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi library/declare.cmi kernel/declarations.cmi \
-    library/decl_kinds.cmo 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 \
-    kernel/sign.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 \
-    kernel/inductive.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx library/declare.cmx kernel/declarations.cmx \
-    library/decl_kinds.cmx config/coq_config.cmx contrib/xml/cic2acic.cmx \
-    contrib/xml/acic2Xml.cmx contrib/xml/acic.cmx contrib/xml/xmlcommand.cmi 
-contrib/xml/xmlentries.cmo: contrib/xml/xmlcommand.cmi \
-    toplevel/vernacinterp.cmi lib/util.cmi lib/pp.cmi parsing/pcoq.cmi \
-    interp/genarg.cmi parsing/extend.cmi parsing/egrammar.cmi \
-    toplevel/cerrors.cmi 
-contrib/xml/xmlentries.cmx: contrib/xml/xmlcommand.cmx \
-    toplevel/vernacinterp.cmx lib/util.cmx lib/pp.cmx parsing/pcoq.cmx \
-    interp/genarg.cmx parsing/extend.cmx parsing/egrammar.cmx \
-    toplevel/cerrors.cmx 
-ide/utils/configwin.cmo: ide/utils/configwin_types.cmo \
-    ide/utils/configwin_ihm.cmo ide/utils/configwin.cmi 
-ide/utils/configwin.cmx: ide/utils/configwin_types.cmx \
-    ide/utils/configwin_ihm.cmx ide/utils/configwin.cmi 
-ide/utils/configwin_html_config.cmo: ide/utils/uoptions.cmi \
-    ide/utils/configwin_types.cmo ide/utils/configwin_messages.cmo \
-    ide/utils/configwin_ihm.cmo 
-ide/utils/configwin_html_config.cmx: ide/utils/uoptions.cmx \
-    ide/utils/configwin_types.cmx ide/utils/configwin_messages.cmx \
-    ide/utils/configwin_ihm.cmx 
-ide/utils/configwin_ihm.cmo: ide/utils/uoptions.cmi ide/utils/okey.cmi \
-    ide/utils/configwin_types.cmo ide/utils/configwin_messages.cmo 
-ide/utils/configwin_ihm.cmx: ide/utils/uoptions.cmx ide/utils/okey.cmx \
-    ide/utils/configwin_types.cmx ide/utils/configwin_messages.cmx 
-ide/utils/configwin_types.cmo: ide/utils/uoptions.cmi \
+ide/utils/config_file.cmo: ide/utils/config_file.cmi 
+ide/utils/config_file.cmx: ide/utils/config_file.cmi 
+ide/utils/configwin_html_config.cmo: ide/utils/config_file.cmi \
+    ide/utils/configwin_ihm.cmo ide/utils/configwin_messages.cmo \
+    ide/utils/configwin_types.cmo 
+ide/utils/configwin_html_config.cmx: ide/utils/config_file.cmx \
+    ide/utils/configwin_ihm.cmx ide/utils/configwin_messages.cmx \
+    ide/utils/configwin_types.cmx 
+ide/utils/configwin_ihm.cmo: ide/utils/config_file.cmi \
+    ide/utils/configwin_messages.cmo ide/utils/configwin_types.cmo \
+    ide/utils/okey.cmi 
+ide/utils/configwin_ihm.cmx: ide/utils/config_file.cmx \
+    ide/utils/configwin_messages.cmx ide/utils/configwin_types.cmx \
+    ide/utils/okey.cmx 
+ide/utils/configwin.cmo: ide/utils/configwin_ihm.cmo \
+    ide/utils/configwin_types.cmo ide/utils/configwin.cmi 
+ide/utils/configwin.cmx: ide/utils/configwin_ihm.cmx \
+    ide/utils/configwin_types.cmx ide/utils/configwin.cmi 
+ide/utils/configwin_types.cmo: ide/utils/config_file.cmi \
     ide/utils/configwin_keys.cmo 
-ide/utils/configwin_types.cmx: ide/utils/uoptions.cmx \
+ide/utils/configwin_types.cmx: ide/utils/config_file.cmx \
     ide/utils/configwin_keys.cmx 
 ide/utils/okey.cmo: ide/utils/okey.cmi 
 ide/utils/okey.cmx: ide/utils/okey.cmi 
@@ -3276,18 +3744,22 @@ ide/utils/uoptions.cmo: ide/utils/uoptions.cmi
 ide/utils/uoptions.cmx: ide/utils/uoptions.cmi 
 tools/coqdoc/alpha.cmo: tools/coqdoc/alpha.cmi 
 tools/coqdoc/alpha.cmx: tools/coqdoc/alpha.cmi 
-tools/coqdoc/index.cmo: tools/coqdoc/alpha.cmi tools/coqdoc/index.cmi 
-tools/coqdoc/index.cmx: tools/coqdoc/alpha.cmx tools/coqdoc/index.cmi 
-tools/coqdoc/main.cmo: tools/coqdoc/pretty.cmi tools/coqdoc/output.cmi \
-    tools/coqdoc/index.cmi config/coq_config.cmi 
-tools/coqdoc/main.cmx: tools/coqdoc/pretty.cmx tools/coqdoc/output.cmx \
-    tools/coqdoc/index.cmx config/coq_config.cmx 
-tools/coqdoc/output.cmo: tools/coqdoc/index.cmi tools/coqdoc/output.cmi 
-tools/coqdoc/output.cmx: tools/coqdoc/index.cmx tools/coqdoc/output.cmi 
-tools/coqdoc/pretty.cmo: tools/coqdoc/output.cmi tools/coqdoc/index.cmi \
-    tools/coqdoc/pretty.cmi 
-tools/coqdoc/pretty.cmx: tools/coqdoc/output.cmx tools/coqdoc/index.cmx \
-    tools/coqdoc/pretty.cmi 
+tools/coqdoc/index.cmo: tools/coqdoc/alpha.cmi tools/coqdoc/cdglobals.cmo \
+    tools/coqdoc/index.cmi 
+tools/coqdoc/index.cmx: tools/coqdoc/alpha.cmx tools/coqdoc/cdglobals.cmx \
+    tools/coqdoc/index.cmi 
+tools/coqdoc/main.cmo: tools/coqdoc/cdglobals.cmo config/coq_config.cmi \
+    tools/coqdoc/index.cmi tools/coqdoc/output.cmi tools/coqdoc/pretty.cmi 
+tools/coqdoc/main.cmx: tools/coqdoc/cdglobals.cmx config/coq_config.cmx \
+    tools/coqdoc/index.cmx tools/coqdoc/output.cmx tools/coqdoc/pretty.cmx 
+tools/coqdoc/output.cmo: tools/coqdoc/cdglobals.cmo tools/coqdoc/index.cmi \
+    tools/coqdoc/output.cmi 
+tools/coqdoc/output.cmx: tools/coqdoc/cdglobals.cmx tools/coqdoc/index.cmx \
+    tools/coqdoc/output.cmi 
+tools/coqdoc/pretty.cmo: tools/coqdoc/cdglobals.cmo tools/coqdoc/index.cmi \
+    tools/coqdoc/output.cmi tools/coqdoc/pretty.cmi 
+tools/coqdoc/pretty.cmx: tools/coqdoc/cdglobals.cmx tools/coqdoc/index.cmx \
+    tools/coqdoc/output.cmx tools/coqdoc/pretty.cmi 
 tactics/tauto.cmo: parsing/grammar.cma
 tactics/tauto.cmx: parsing/grammar.cma
 tactics/eqdecide.cmo: parsing/grammar.cma
@@ -3298,6 +3770,10 @@ tactics/extratactics.cmo: parsing/grammar.cma
 tactics/extratactics.cmx: parsing/grammar.cma
 tactics/eauto.cmo: parsing/grammar.cma
 tactics/eauto.cmx: parsing/grammar.cma
+toplevel/whelp.cmo: parsing/grammar.cma
+toplevel/whelp.cmx: parsing/grammar.cma
+tactics/hipattern.cmo: parsing/grammar.cma parsing/q_constr.cmo
+tactics/hipattern.cmx: parsing/grammar.cma parsing/q_constr.cmo
 contrib/omega/g_omega.cmo: parsing/grammar.cma
 contrib/omega/g_omega.cmx: parsing/grammar.cma
 contrib/romega/g_romega.cmo: parsing/grammar.cma
@@ -3306,6 +3782,10 @@ contrib/ring/g_quote.cmo: parsing/grammar.cma
 contrib/ring/g_quote.cmx: parsing/grammar.cma
 contrib/ring/g_ring.cmo: parsing/grammar.cma
 contrib/ring/g_ring.cmx: parsing/grammar.cma
+contrib/dp/g_dp.cmo: parsing/grammar.cma
+contrib/dp/g_dp.cmx: parsing/grammar.cma
+contrib/setoid_ring/newring.cmo: parsing/grammar.cma
+contrib/setoid_ring/newring.cmx: parsing/grammar.cma
 contrib/field/field.cmo: parsing/grammar.cma
 contrib/field/field.cmx: parsing/grammar.cma
 contrib/fourier/g_fourier.cmo: parsing/grammar.cma
@@ -3316,40 +3796,46 @@ contrib/xml/xmlentries.cmo: parsing/grammar.cma
 contrib/xml/xmlentries.cmx: parsing/grammar.cma
 contrib/jprover/jprover.cmo: parsing/grammar.cma
 contrib/jprover/jprover.cmx: parsing/grammar.cma
-contrib/cc/cctac.cmo: parsing/grammar.cma
-contrib/cc/cctac.cmx: parsing/grammar.cma
+contrib/cc/g_congruence.cmo: parsing/grammar.cma
+contrib/cc/g_congruence.cmx: parsing/grammar.cma
 contrib/funind/tacinv.cmo: parsing/grammar.cma
 contrib/funind/tacinv.cmx: parsing/grammar.cma
 contrib/first-order/g_ground.cmo: parsing/grammar.cma
 contrib/first-order/g_ground.cmx: parsing/grammar.cma
+contrib/subtac/g_subtac.cmo: parsing/grammar.cma
+contrib/subtac/g_subtac.cmx: parsing/grammar.cma
+contrib/subtac/g_eterm.cmo: parsing/grammar.cma
+contrib/subtac/g_eterm.cmx: parsing/grammar.cma
+contrib/rtauto/g_rtauto.cmo: parsing/grammar.cma
+contrib/rtauto/g_rtauto.cmx: parsing/grammar.cma
+contrib/recdef/recdef.cmo: parsing/grammar.cma
+contrib/recdef/recdef.cmx: parsing/grammar.cma
+contrib/funind/indfun_main.cmo: parsing/grammar.cma
+contrib/funind/indfun_main.cmx: parsing/grammar.cma
 contrib/interface/debug_tac.cmo: parsing/grammar.cma
 contrib/interface/debug_tac.cmx: parsing/grammar.cma
 contrib/interface/centaur.cmo: parsing/grammar.cma
 contrib/interface/centaur.cmx: parsing/grammar.cma
 parsing/lexer.cmo: 
 parsing/lexer.cmx: 
+parsing/pcoq.cmo: 
+parsing/pcoq.cmx: 
 parsing/q_util.cmo: 
 parsing/q_util.cmx: 
 parsing/q_coqast.cmo: 
 parsing/q_coqast.cmx: 
 parsing/g_prim.cmo: 
 parsing/g_prim.cmx: 
-parsing/pcoq.cmo: 
-parsing/pcoq.cmx: 
-parsing/g_basevernac.cmo: 
-parsing/g_basevernac.cmx: 
 parsing/g_minicoq.cmo: 
 parsing/g_minicoq.cmx: 
-parsing/g_vernac.cmo: 
-parsing/g_vernac.cmx: 
+parsing/g_vernac.cmo: parsing/grammar.cma
+parsing/g_vernac.cmx: parsing/grammar.cma
 parsing/g_proofs.cmo: 
 parsing/g_proofs.cmx: 
-parsing/g_cases.cmo: 
-parsing/g_cases.cmx: 
+parsing/g_xml.cmo: 
+parsing/g_xml.cmx: 
 parsing/g_constr.cmo: 
 parsing/g_constr.cmx: 
-parsing/g_module.cmo: 
-parsing/g_module.cmx: 
 parsing/g_tactic.cmo: 
 parsing/g_tactic.cmx: 
 parsing/g_ltac.cmo: 
@@ -3360,18 +3846,8 @@ parsing/tacextend.cmo:
 parsing/tacextend.cmx: 
 parsing/vernacextend.cmo: 
 parsing/vernacextend.cmx: 
-parsing/g_primnew.cmo: 
-parsing/g_primnew.cmx: 
-parsing/g_vernacnew.cmo: 
-parsing/g_vernacnew.cmx: 
-parsing/g_proofsnew.cmo: 
-parsing/g_proofsnew.cmx: 
-parsing/g_constrnew.cmo: 
-parsing/g_constrnew.cmx: 
-parsing/g_tacticnew.cmo: 
-parsing/g_tacticnew.cmx: 
-parsing/g_ltacnew.cmo: 
-parsing/g_ltacnew.cmx: 
+parsing/q_constr.cmo: 
+parsing/q_constr.cmx: 
 toplevel/mltop.cmo: 
 toplevel/mltop.cmx: 
 lib/pp.cmo: 
@@ -3390,3 +3866,51 @@ tools/coq_makefile.cmo:
 tools/coq_makefile.cmx: 
 tools/coq-tex.cmo: 
 tools/coq-tex.cmx: 
+coq_fix_code.o: kernel/byterun/coq_fix_code.c \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/misc.h /usr/lib/ocaml/caml/mlvalues.h \
+  /usr/lib/ocaml/caml/fail.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 \
+  /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 kernel/byterun/coq_instruct.h \
+  kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \
+  /usr/lib/ocaml/caml/fail.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 \
+  /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 kernel/byterun/coq_instruct.h \
+  kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \
+  /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h
+coq_values.o: kernel/byterun/coq_values.c kernel/byterun/coq_fix_code.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/fail.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 \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/misc.h /usr/lib/ocaml/caml/mlvalues.h \
+  /usr/lib/ocaml/caml/fail.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 \
+  /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 kernel/byterun/coq_instruct.h \
+  kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \
+  /usr/lib/ocaml/caml/fail.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 \
+  /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 kernel/byterun/coq_instruct.h \
+  kernel/byterun/coq_fix_code.h kernel/byterun/coq_memory.h \
+  /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/memory.h
+coq_values.d.o: kernel/byterun/coq_values.c kernel/byterun/coq_fix_code.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/fail.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 a34765fc..e1a671bc 100644
--- a/.depend.camlp4
+++ b/.depend.camlp4
@@ -3,43 +3,45 @@ tactics/eqdecide.ml: parsing/grammar.cma
 tactics/extraargs.ml: parsing/grammar.cma
 tactics/extratactics.ml: parsing/grammar.cma
 tactics/eauto.ml: parsing/grammar.cma
+toplevel/whelp.ml: parsing/grammar.cma
+tactics/hipattern.ml: parsing/grammar.cma parsing/q_constr.cmo
 contrib/omega/g_omega.ml: parsing/grammar.cma
 contrib/romega/g_romega.ml: parsing/grammar.cma
 contrib/ring/g_quote.ml: parsing/grammar.cma
 contrib/ring/g_ring.ml: parsing/grammar.cma
+contrib/dp/g_dp.ml: parsing/grammar.cma
+contrib/setoid_ring/newring.ml: parsing/grammar.cma
 contrib/field/field.ml: parsing/grammar.cma
 contrib/fourier/g_fourier.ml: parsing/grammar.cma
 contrib/extraction/g_extraction.ml: parsing/grammar.cma
 contrib/xml/xmlentries.ml: parsing/grammar.cma
 contrib/jprover/jprover.ml: parsing/grammar.cma
-contrib/cc/cctac.ml: parsing/grammar.cma
+contrib/cc/g_congruence.ml: parsing/grammar.cma
 contrib/funind/tacinv.ml: parsing/grammar.cma
 contrib/first-order/g_ground.ml: parsing/grammar.cma
+contrib/subtac/g_subtac.ml: parsing/grammar.cma
+contrib/subtac/g_eterm.ml: parsing/grammar.cma
+contrib/rtauto/g_rtauto.ml: parsing/grammar.cma
+contrib/recdef/recdef.ml: parsing/grammar.cma
+contrib/funind/indfun_main.ml: parsing/grammar.cma
 contrib/interface/debug_tac.ml: parsing/grammar.cma
 contrib/interface/centaur.ml: parsing/grammar.cma
 parsing/lexer.ml: 
+parsing/pcoq.ml: 
 parsing/q_util.ml: 
 parsing/q_coqast.ml: 
 parsing/g_prim.ml: 
-parsing/pcoq.ml: 
-parsing/g_basevernac.ml: 
 parsing/g_minicoq.ml: 
-parsing/g_vernac.ml: 
+parsing/g_vernac.ml: parsing/grammar.cma
 parsing/g_proofs.ml: 
-parsing/g_cases.ml: 
+parsing/g_xml.ml: 
 parsing/g_constr.ml: 
-parsing/g_module.ml: 
 parsing/g_tactic.ml: 
 parsing/g_ltac.ml: 
 parsing/argextend.ml: 
 parsing/tacextend.ml: 
 parsing/vernacextend.ml: 
-parsing/g_primnew.ml: 
-parsing/g_vernacnew.ml: 
-parsing/g_proofsnew.ml: 
-parsing/g_constrnew.ml: 
-parsing/g_tacticnew.ml: 
-parsing/g_ltacnew.ml: 
+parsing/q_constr.ml: 
 toplevel/mltop.ml: 
 lib/pp.ml: 
 lib/compat.ml: 
diff --git a/.depend.coq b/.depend.coq
index 1b20c607..9f5a2674 100644
--- a/.depend.coq
+++ b/.depend.coq
@@ -58,7 +58,8 @@ theories/Init/Logic.vo: theories/Init/Logic.v theories/Init/Notations.vo
 theories/Init/Specif.vo: theories/Init/Specif.v theories/Init/Notations.vo theories/Init/Datatypes.vo theories/Init/Logic.vo
 theories/Init/Logic_Type.vo: theories/Init/Logic_Type.v theories/Init/Datatypes.vo theories/Init/Logic.vo
 theories/Init/Wf.vo: theories/Init/Wf.v theories/Init/Notations.vo theories/Init/Logic.vo theories/Init/Datatypes.vo
-theories/Init/Prelude.vo: theories/Init/Prelude.v theories/Init/Notations.vo theories/Init/Logic.vo theories/Init/Datatypes.vo theories/Init/Specif.vo theories/Init/Peano.vo theories/Init/Wf.vo
+theories/Init/Tactics.vo: theories/Init/Tactics.v theories/Init/Notations.vo theories/Init/Logic.vo
+theories/Init/Prelude.vo: theories/Init/Prelude.v theories/Init/Notations.vo theories/Init/Logic.vo theories/Init/Datatypes.vo theories/Init/Specif.vo theories/Init/Peano.vo theories/Init/Wf.vo theories/Init/Tactics.vo
 theories/Init/Notations.vo: theories/Init/Notations.v
 theories/Init/Datatypes.vo: theories/Init/Datatypes.v theories/Init/Notations.vo theories/Init/Logic.vo
 theories/Init/Peano.vo: theories/Init/Peano.v theories/Init/Notations.vo theories/Init/Datatypes.vo theories/Init/Logic.vo
@@ -66,25 +67,28 @@ theories/Init/Logic.vo: theories/Init/Logic.v theories/Init/Notations.vo
 theories/Init/Specif.vo: theories/Init/Specif.v theories/Init/Notations.vo theories/Init/Datatypes.vo theories/Init/Logic.vo
 theories/Init/Logic_Type.vo: theories/Init/Logic_Type.v theories/Init/Datatypes.vo theories/Init/Logic.vo
 theories/Init/Wf.vo: theories/Init/Wf.v theories/Init/Notations.vo theories/Init/Logic.vo theories/Init/Datatypes.vo
-theories/Init/Prelude.vo: theories/Init/Prelude.v theories/Init/Notations.vo theories/Init/Logic.vo theories/Init/Datatypes.vo theories/Init/Specif.vo theories/Init/Peano.vo theories/Init/Wf.vo
+theories/Init/Tactics.vo: theories/Init/Tactics.v theories/Init/Notations.vo theories/Init/Logic.vo
+theories/Init/Prelude.vo: theories/Init/Prelude.v theories/Init/Notations.vo theories/Init/Logic.vo theories/Init/Datatypes.vo theories/Init/Specif.vo theories/Init/Peano.vo theories/Init/Wf.vo theories/Init/Tactics.vo
 theories/Logic/Hurkens.vo: theories/Logic/Hurkens.v
-theories/Logic/ProofIrrelevance.vo: theories/Logic/ProofIrrelevance.v theories/Logic/Hurkens.vo
+theories/Logic/ProofIrrelevance.vo: theories/Logic/ProofIrrelevance.v theories/Logic/ProofIrrelevanceFacts.vo
 theories/Logic/Classical.vo: theories/Logic/Classical.v theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo
 theories/Logic/Classical_Type.vo: theories/Logic/Classical_Type.v theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo
-theories/Logic/Classical_Pred_Set.vo: theories/Logic/Classical_Pred_Set.v theories/Logic/Classical_Prop.vo
-theories/Logic/Eqdep.vo: theories/Logic/Eqdep.v
+theories/Logic/Classical_Pred_Set.vo: theories/Logic/Classical_Pred_Set.v theories/Logic/Classical_Pred_Type.vo
+theories/Logic/Eqdep.vo: theories/Logic/Eqdep.v theories/Logic/EqdepFacts.vo
 theories/Logic/Classical_Pred_Type.vo: theories/Logic/Classical_Pred_Type.v theories/Logic/Classical_Prop.vo
-theories/Logic/Classical_Prop.vo: theories/Logic/Classical_Prop.v theories/Logic/ProofIrrelevance.vo
-theories/Logic/ClassicalFacts.vo: theories/Logic/ClassicalFacts.v
-theories/Logic/ChoiceFacts.vo: theories/Logic/ChoiceFacts.v
+theories/Logic/Classical_Prop.vo: theories/Logic/Classical_Prop.v theories/Logic/ClassicalFacts.vo theories/Logic/EqdepFacts.vo
+theories/Logic/ClassicalFacts.vo: theories/Logic/ClassicalFacts.v theories/Logic/Hurkens.vo
+theories/Logic/ChoiceFacts.vo: theories/Logic/ChoiceFacts.v theories/Arith/Wf_nat.vo theories/Arith/Compare_dec.vo theories/Logic/Decidable.vo theories/Arith/Arith.vo
 theories/Logic/Berardi.vo: theories/Logic/Berardi.v
-theories/Logic/Eqdep_dec.vo: theories/Logic/Eqdep_dec.v
+theories/Logic/Eqdep_dec.vo: theories/Logic/Eqdep_dec.v theories/Logic/EqdepFacts.vo
 theories/Logic/Decidable.vo: theories/Logic/Decidable.v
 theories/Logic/JMeq.vo: theories/Logic/JMeq.v theories/Logic/Eqdep.vo
 theories/Logic/ClassicalDescription.vo: theories/Logic/ClassicalDescription.v theories/Logic/Classical.vo
 theories/Logic/ClassicalChoice.vo: theories/Logic/ClassicalChoice.v theories/Logic/ClassicalDescription.vo theories/Logic/RelationalChoice.vo theories/Logic/ChoiceFacts.vo
 theories/Logic/RelationalChoice.vo: theories/Logic/RelationalChoice.v
 theories/Logic/Diaconescu.vo: theories/Logic/Diaconescu.v theories/Logic/ClassicalFacts.vo theories/Logic/ChoiceFacts.vo theories/Bool/Bool.vo
+theories/Logic/EqdepFacts.vo: theories/Logic/EqdepFacts.v
+theories/Logic/ProofIrrelevanceFacts.vo: theories/Logic/ProofIrrelevanceFacts.v theories/Logic/EqdepFacts.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/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
@@ -127,6 +131,8 @@ theories/ZArith/Znat.vo: theories/ZArith/Znat.v theories/Arith/Arith.vo theories
 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/Zminmax.vo: theories/ZArith/Zminmax.v theories/ZArith/Zmin.vo theories/ZArith/BinInt.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
@@ -135,7 +141,7 @@ theories/ZArith/Zcomplements.vo: theories/ZArith/Zcomplements.v contrib/ring/ZAr
 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/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/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/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
@@ -144,6 +150,9 @@ theories/Lists/ListSet.vo: theories/Lists/ListSet.v theories/Lists/List.vo
 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/Lists/SetoidList.vo: theories/Lists/SetoidList.v theories/Lists/List.vo theories/Sorting/Sorting.vo theories/Setoids/Setoid.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
 theories/Sets/Permut.vo: theories/Sets/Permut.v
 theories/Sets/Constructive_sets.vo: theories/Sets/Constructive_sets.v theories/Sets/Ensembles.vo
@@ -166,11 +175,30 @@ theories/Sets/Multiset.vo: theories/Sets/Multiset.v theories/Sets/Permut.vo theo
 theories/Sets/Relations_3_facts.vo: theories/Sets/Relations_3_facts.v theories/Sets/Relations_1.vo theories/Sets/Relations_1_facts.vo theories/Sets/Relations_2.vo theories/Sets/Relations_2_facts.vo theories/Sets/Relations_3.vo
 theories/Sets/Partial_Order.vo: theories/Sets/Partial_Order.v theories/Sets/Ensembles.vo theories/Sets/Relations_1.vo
 theories/Sets/Uniset.vo: theories/Sets/Uniset.v theories/Bool/Bool.vo theories/Sets/Permut.vo
+theories/FSets/DecidableType.vo: theories/FSets/DecidableType.v theories/Lists/SetoidList.vo
+theories/FSets/OrderedType.vo: theories/FSets/OrderedType.v theories/Lists/SetoidList.vo
+theories/FSets/FSetInterface.vo: theories/FSets/FSetInterface.v theories/Bool/Bool.vo theories/FSets/OrderedType.vo
+theories/FSets/FSetList.vo: theories/FSets/FSetList.v theories/FSets/FSetInterface.vo
+theories/FSets/FSetBridge.vo: theories/FSets/FSetBridge.v theories/FSets/FSetInterface.vo
+theories/FSets/FSetFacts.vo: theories/FSets/FSetFacts.v theories/FSets/FSetInterface.vo
+theories/FSets/FSetProperties.vo: theories/FSets/FSetProperties.v theories/FSets/FSetInterface.vo theories/FSets/FSetFacts.vo
+theories/FSets/FSetEqProperties.vo: theories/FSets/FSetEqProperties.v theories/FSets/FSetProperties.vo theories/Bool/Zerob.vo theories/Bool/Sumbool.vo contrib/omega/Omega.vo
+theories/FSets/FSets.vo: theories/FSets/FSets.v theories/FSets/OrderedType.vo theories/FSets/FSetInterface.vo theories/FSets/FSetBridge.vo theories/FSets/FSetProperties.vo theories/FSets/FSetEqProperties.vo theories/FSets/FSetList.vo
+theories/FSets/FSetWeakInterface.vo: theories/FSets/FSetWeakInterface.v theories/Bool/Bool.vo theories/FSets/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/FSets/DecidableType.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FSetFacts.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/FMapInterface.vo theories/FSets/FMapList.vo
+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/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakList.vo
 theories/IntMap/Adalloc.vo: theories/IntMap/Adalloc.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/Arith/Arith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo
 theories/IntMap/Mapcanon.vo: theories/IntMap/Mapcanon.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Fset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/IntMap/Mapsubset.vo theories/IntMap/Mapcard.vo
 theories/IntMap/Addec.vo: theories/IntMap/Addec.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo
 theories/IntMap/Mapcard.vo: theories/IntMap/Mapcard.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Fset.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/Arith/Peano_dec.vo
-theories/IntMap/Addr.vo: theories/IntMap/Addr.v theories/Bool/Bool.vo theories/ZArith/ZArith.vo
+theories/IntMap/Addr.vo: theories/IntMap/Addr.v theories/Bool/Bool.vo theories/NArith/NArith.vo theories/ZArith/ZArith.vo
 theories/IntMap/Mapc.vo: theories/IntMap/Mapc.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Fset.vo theories/IntMap/Mapiter.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo theories/IntMap/Lsort.vo theories/IntMap/Mapcard.vo theories/IntMap/Mapcanon.vo
 theories/IntMap/Adist.vo: theories/IntMap/Adist.v theories/Bool/Bool.vo theories/ZArith/ZArith.vo theories/Arith/Arith.vo theories/Arith/Min.vo theories/IntMap/Addr.vo
 theories/IntMap/Mapfold.vo: theories/IntMap/Mapfold.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/ZArith/ZArith.vo theories/IntMap/Addr.vo theories/IntMap/Adist.vo theories/IntMap/Addec.vo theories/IntMap/Map.vo theories/IntMap/Fset.vo theories/IntMap/Mapaxioms.vo theories/IntMap/Mapiter.vo theories/IntMap/Lsort.vo theories/IntMap/Mapsubset.vo theories/Lists/List.vo
@@ -202,62 +230,14 @@ theories/Reals/Raxioms.vo: theories/Reals/Raxioms.v theories/ZArith/ZArith_base.
 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/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/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/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/Setoids/Setoid.vo: theories/Setoids/Setoid.v
+theories/Setoids/Setoid.vo: theories/Setoids/Setoid.v theories/Relations/Relation_Definitions.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/Sorting/Sorting.vo: theories/Sorting/Sorting.v theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo theories/Relations/Relations.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.vo contrib/omega/OmegaLemmas.vo theories/Logic/Decidable.vo
-contrib/romega/ROmega.vo: contrib/romega/ROmega.v contrib/omega/Omega.vo contrib/romega/ReflOmegaCore.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
@@ -275,4 +255,12 @@ contrib/field/Field_Tactic.vo: contrib/field/Field_Tactic.v contrib/ring/Ring.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/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/cc/CCSolve.vo: contrib/cc/CCSolve.v
+contrib/subtac/FixSub.vo: contrib/subtac/FixSub.v theories/Init/Wf.vo
+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
diff --git a/.depend.coq7 b/.depend.coq7
deleted file mode 100644
index 452c951f..00000000
--- a/.depend.coq7
+++ /dev/null
@@ -1,231 +0,0 @@
-theories7/Init/Notations.vo: theories7/Init/Notations.v
-theories7/Init/Datatypes.vo: theories7/Init/Datatypes.v theories7/Init/Notations.vo theories7/Init/Logic.vo
-theories7/Init/Peano.vo: theories7/Init/Peano.v theories7/Init/Notations.vo theories7/Init/Datatypes.vo theories7/Init/Logic.vo
-theories7/Init/Logic.vo: theories7/Init/Logic.v theories7/Init/Notations.vo
-theories7/Init/Specif.vo: theories7/Init/Specif.v theories7/Init/Notations.vo theories7/Init/Datatypes.vo theories7/Init/Logic.vo
-theories7/Init/Logic_Type.vo: theories7/Init/Logic_Type.v theories7/Init/Datatypes.vo theories7/Init/Logic.vo
-theories7/Init/Wf.vo: theories7/Init/Wf.v theories7/Init/Notations.vo theories7/Init/Logic.vo theories7/Init/Datatypes.vo
-theories7/Init/Prelude.vo: theories7/Init/Prelude.v theories7/Init/Notations.vo theories7/Init/Logic.vo theories7/Init/Datatypes.vo theories7/Init/Specif.vo theories7/Init/Peano.vo theories7/Init/Wf.vo
-theories7/Init/Notations.vo: theories7/Init/Notations.v
-theories7/Init/Datatypes.vo: theories7/Init/Datatypes.v theories7/Init/Notations.vo theories7/Init/Logic.vo
-theories7/Init/Peano.vo: theories7/Init/Peano.v theories7/Init/Notations.vo theories7/Init/Datatypes.vo theories7/Init/Logic.vo
-theories7/Init/Logic.vo: theories7/Init/Logic.v theories7/Init/Notations.vo
-theories7/Init/Specif.vo: theories7/Init/Specif.v theories7/Init/Notations.vo theories7/Init/Datatypes.vo theories7/Init/Logic.vo
-theories7/Init/Logic_Type.vo: theories7/Init/Logic_Type.v theories7/Init/Datatypes.vo theories7/Init/Logic.vo
-theories7/Init/Wf.vo: theories7/Init/Wf.v theories7/Init/Notations.vo theories7/Init/Logic.vo theories7/Init/Datatypes.vo
-theories7/Init/Prelude.vo: theories7/Init/Prelude.v theories7/Init/Notations.vo theories7/Init/Logic.vo theories7/Init/Datatypes.vo theories7/Init/Specif.vo theories7/Init/Peano.vo theories7/Init/Wf.vo
-theories7/Logic/Hurkens.vo: theories7/Logic/Hurkens.v
-theories7/Logic/ProofIrrelevance.vo: theories7/Logic/ProofIrrelevance.v theories7/Logic/Hurkens.vo
-theories7/Logic/Classical.vo: theories7/Logic/Classical.v theories7/Logic/Classical_Prop.vo theories7/Logic/Classical_Pred_Type.vo
-theories7/Logic/Classical_Type.vo: theories7/Logic/Classical_Type.v theories7/Logic/Classical_Prop.vo theories7/Logic/Classical_Pred_Type.vo
-theories7/Logic/Classical_Pred_Set.vo: theories7/Logic/Classical_Pred_Set.v theories7/Logic/Classical_Prop.vo
-theories7/Logic/Eqdep.vo: theories7/Logic/Eqdep.v
-theories7/Logic/Classical_Pred_Type.vo: theories7/Logic/Classical_Pred_Type.v theories7/Logic/Classical_Prop.vo
-theories7/Logic/Classical_Prop.vo: theories7/Logic/Classical_Prop.v theories7/Logic/ProofIrrelevance.vo
-theories7/Logic/ClassicalFacts.vo: theories7/Logic/ClassicalFacts.v
-theories7/Logic/ChoiceFacts.vo: theories7/Logic/ChoiceFacts.v
-theories7/Logic/Berardi.vo: theories7/Logic/Berardi.v
-theories7/Logic/Eqdep_dec.vo: theories7/Logic/Eqdep_dec.v
-theories7/Logic/Decidable.vo: theories7/Logic/Decidable.v
-theories7/Logic/JMeq.vo: theories7/Logic/JMeq.v theories7/Logic/Eqdep.vo
-theories7/Logic/ClassicalDescription.vo: theories7/Logic/ClassicalDescription.v theories7/Logic/Classical.vo
-theories7/Logic/ClassicalChoice.vo: theories7/Logic/ClassicalChoice.v theories7/Logic/ClassicalDescription.vo theories7/Logic/RelationalChoice.vo theories7/Logic/ChoiceFacts.vo
-theories7/Logic/RelationalChoice.vo: theories7/Logic/RelationalChoice.v
-theories7/Logic/Diaconescu.vo: theories7/Logic/Diaconescu.v theories7/Logic/ClassicalFacts.vo theories7/Logic/ChoiceFacts.vo theories7/Bool/Bool.vo
-theories7/Arith/Arith.vo: theories7/Arith/Arith.v theories7/Arith/Le.vo theories7/Arith/Lt.vo theories7/Arith/Plus.vo theories7/Arith/Gt.vo theories7/Arith/Minus.vo theories7/Arith/Mult.vo theories7/Arith/Between.vo theories7/Arith/Peano_dec.vo theories7/Arith/Compare_dec.vo theories7/Arith/Factorial.vo
-theories7/Arith/Gt.vo: theories7/Arith/Gt.v theories7/Arith/Le.vo theories7/Arith/Lt.vo theories7/Arith/Plus.vo
-theories7/Arith/Between.vo: theories7/Arith/Between.v theories7/Arith/Le.vo theories7/Arith/Lt.vo
-theories7/Arith/Le.vo: theories7/Arith/Le.v
-theories7/Arith/Compare.vo: theories7/Arith/Compare.v theories7/Arith/Arith.vo theories7/Arith/Peano_dec.vo theories7/Arith/Compare_dec.vo theories7/Arith/Wf_nat.vo theories7/Arith/Min.vo
-theories7/Arith/Lt.vo: theories7/Arith/Lt.v theories7/Arith/Le.vo
-theories7/Arith/Compare_dec.vo: theories7/Arith/Compare_dec.v theories7/Arith/Le.vo theories7/Arith/Lt.vo theories7/Arith/Gt.vo theories7/Logic/Decidable.vo
-theories7/Arith/Min.vo: theories7/Arith/Min.v theories7/Arith/Arith.vo
-theories7/Arith/Div2.vo: theories7/Arith/Div2.v theories7/Arith/Lt.vo theories7/Arith/Plus.vo theories7/Arith/Compare_dec.vo theories7/Arith/Even.vo
-theories7/Arith/Minus.vo: theories7/Arith/Minus.v theories7/Arith/Lt.vo theories7/Arith/Le.vo
-theories7/Arith/Mult.vo: theories7/Arith/Mult.v theories7/Arith/Plus.vo theories7/Arith/Minus.vo theories7/Arith/Lt.vo theories7/Arith/Le.vo
-theories7/Arith/Even.vo: theories7/Arith/Even.v
-theories7/Arith/EqNat.vo: theories7/Arith/EqNat.v
-theories7/Arith/Peano_dec.vo: theories7/Arith/Peano_dec.v theories7/Logic/Decidable.vo
-theories7/Arith/Euclid.vo: theories7/Arith/Euclid.v theories7/Arith/Mult.vo theories7/Arith/Compare_dec.vo theories7/Arith/Wf_nat.vo
-theories7/Arith/Plus.vo: theories7/Arith/Plus.v theories7/Arith/Le.vo theories7/Arith/Lt.vo
-theories7/Arith/Wf_nat.vo: theories7/Arith/Wf_nat.v theories7/Arith/Lt.vo
-theories7/Arith/Max.vo: theories7/Arith/Max.v theories7/Arith/Arith.vo
-theories7/Arith/Bool_nat.vo: theories7/Arith/Bool_nat.v theories7/Arith/Compare_dec.vo theories7/Arith/Peano_dec.vo theories7/Bool/Sumbool.vo
-theories7/Arith/Factorial.vo: theories7/Arith/Factorial.v theories7/Arith/Plus.vo theories7/Arith/Mult.vo theories7/Arith/Lt.vo
-theories7/Bool/Bool.vo: theories7/Bool/Bool.v
-theories7/Bool/IfProp.vo: theories7/Bool/IfProp.v theories7/Bool/Bool.vo
-theories7/Bool/Zerob.vo: theories7/Bool/Zerob.v theories7/Arith/Arith.vo theories7/Bool/Bool.vo
-theories7/Bool/DecBool.vo: theories7/Bool/DecBool.v
-theories7/Bool/Sumbool.vo: theories7/Bool/Sumbool.v
-theories7/Bool/BoolEq.vo: theories7/Bool/BoolEq.v theories7/Bool/Bool.vo
-theories7/Bool/Bvector.vo: theories7/Bool/Bvector.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/Arith/Arith.vo
-theories7/NArith/BinPos.vo: theories7/NArith/BinPos.v
-theories7/NArith/Pnat.vo: theories7/NArith/Pnat.v theories7/NArith/BinPos.vo theories7/Arith/Le.vo theories7/Arith/Lt.vo theories7/Arith/Gt.vo theories7/Arith/Plus.vo theories7/Arith/Mult.vo theories7/Arith/Minus.vo
-theories7/NArith/BinNat.vo: theories7/NArith/BinNat.v theories7/NArith/BinPos.vo
-theories7/NArith/NArith.vo: theories7/NArith/NArith.v theories7/NArith/BinPos.vo theories7/NArith/BinNat.vo
-theories7/ZArith/BinInt.vo: theories7/ZArith/BinInt.v theories7/NArith/BinPos.vo theories7/NArith/Pnat.vo theories7/NArith/BinNat.vo theories7/Arith/Plus.vo theories7/Arith/Mult.vo
-theories7/ZArith/Wf_Z.vo: theories7/ZArith/Wf_Z.v theories7/ZArith/BinInt.vo theories7/ZArith/Zcompare.vo theories7/ZArith/Zorder.vo theories7/ZArith/Znat.vo theories7/ZArith/Zmisc.vo theories7/ZArith/Zsyntax.vo theories7/Arith/Wf_nat.vo
-theories7/ZArith/ZArith.vo: theories7/ZArith/ZArith.v theories7/ZArith/ZArith_base.vo theories7/ZArith/Zcomplements.vo theories7/ZArith/Zsqrt.vo theories7/ZArith/Zpower.vo theories7/ZArith/Zdiv.vo theories7/ZArith/Zlogarithm.vo theories7/ZArith/Zbool.vo
-theories7/ZArith/ZArith_dec.vo: theories7/ZArith/ZArith_dec.v theories7/Bool/Sumbool.vo theories7/ZArith/BinInt.vo theories7/ZArith/Zorder.vo theories7/ZArith/Zcompare.vo theories7/ZArith/Zsyntax.vo
-theories7/ZArith/auxiliary.vo: theories7/ZArith/auxiliary.v theories7/Arith/Arith.vo theories7/ZArith/BinInt.vo theories7/ZArith/Zorder.vo theories7/Logic/Decidable.vo theories7/Arith/Peano_dec.vo theories7/Arith/Compare_dec.vo theories7/ZArith/Znat.vo theories7/ZArith/Zcompare.vo
-theories7/ZArith/Zmisc.vo: theories7/ZArith/Zmisc.v theories7/ZArith/BinInt.vo theories7/ZArith/Zcompare.vo theories7/ZArith/Zorder.vo theories7/ZArith/Zsyntax.vo theories7/Bool/Bool.vo theories7/ZArith/Zbool.vo theories7/ZArith/Zeven.vo theories7/ZArith/Zabs.vo theories7/ZArith/Zmin.vo
-theories7/ZArith/Zcompare.vo: theories7/ZArith/Zcompare.v theories7/NArith/BinPos.vo theories7/ZArith/BinInt.vo theories7/ZArith/Zsyntax.vo theories7/Arith/Lt.vo theories7/Arith/Gt.vo theories7/Arith/Plus.vo theories7/Arith/Mult.vo
-theories7/ZArith/Znat.vo: theories7/ZArith/Znat.v theories7/Arith/Arith.vo theories7/NArith/BinPos.vo theories7/ZArith/BinInt.vo theories7/ZArith/Zcompare.vo theories7/ZArith/Zorder.vo theories7/Logic/Decidable.vo theories7/Arith/Peano_dec.vo theories7/Arith/Compare_dec.vo
-theories7/ZArith/Zorder.vo: theories7/ZArith/Zorder.v theories7/NArith/BinPos.vo theories7/ZArith/BinInt.vo theories7/Arith/Arith.vo theories7/Logic/Decidable.vo theories7/ZArith/Zsyntax.vo theories7/ZArith/Zcompare.vo
-theories7/ZArith/Zabs.vo: theories7/ZArith/Zabs.v theories7/Arith/Arith.vo theories7/NArith/BinPos.vo theories7/ZArith/BinInt.vo theories7/ZArith/Zorder.vo theories7/ZArith/Zsyntax.vo theories7/ZArith/ZArith_dec.vo
-theories7/ZArith/Zmin.vo: theories7/ZArith/Zmin.v theories7/Arith/Arith.vo theories7/ZArith/BinInt.vo theories7/ZArith/Zcompare.vo theories7/ZArith/Zorder.vo
-theories7/ZArith/Zeven.vo: theories7/ZArith/Zeven.v theories7/ZArith/BinInt.vo theories7/ZArith/Zsyntax.vo
-theories7/ZArith/Zhints.vo: theories7/ZArith/Zhints.v theories7/ZArith/BinInt.vo theories7/ZArith/Zorder.vo theories7/ZArith/Zmin.vo theories7/ZArith/Zabs.vo theories7/ZArith/Zcompare.vo theories7/ZArith/Znat.vo theories7/ZArith/auxiliary.vo theories7/ZArith/Zsyntax.vo theories7/ZArith/Zmisc.vo theories7/ZArith/Wf_Z.vo
-theories7/ZArith/Zlogarithm.vo: theories7/ZArith/Zlogarithm.v theories7/ZArith/ZArith_base.vo contrib7/omega/Omega.vo theories7/ZArith/Zcomplements.vo theories7/ZArith/Zpower.vo
-theories7/ZArith/Zpower.vo: theories7/ZArith/Zpower.v theories7/ZArith/ZArith_base.vo contrib7/omega/Omega.vo theories7/ZArith/Zcomplements.vo
-theories7/ZArith/Zcomplements.vo: theories7/ZArith/Zcomplements.v contrib7/ring/ZArithRing.vo theories7/ZArith/ZArith_base.vo contrib7/omega/Omega.vo theories7/Arith/Wf_nat.vo theories7/Lists/PolyList.vo
-theories7/ZArith/Zdiv.vo: theories7/ZArith/Zdiv.v theories7/ZArith/ZArith_base.vo theories7/ZArith/Zbool.vo contrib7/omega/Omega.vo contrib7/ring/ZArithRing.vo theories7/ZArith/Zcomplements.vo
-theories7/ZArith/Zsqrt.vo: theories7/ZArith/Zsqrt.v contrib7/omega/Omega.vo theories7/ZArith/ZArith_base.vo contrib7/ring/ZArithRing.vo
-theories7/ZArith/Zwf.vo: theories7/ZArith/Zwf.v theories7/ZArith/ZArith_base.vo theories7/Arith/Wf_nat.vo contrib7/omega/Omega.vo
-theories7/ZArith/ZArith_base.vo: theories7/ZArith/ZArith_base.v theories7/ZArith/fast_integer.vo theories7/ZArith/zarith_aux.vo theories7/NArith/BinPos.vo theories7/NArith/BinNat.vo theories7/ZArith/BinInt.vo theories7/ZArith/Zcompare.vo theories7/ZArith/Zorder.vo theories7/ZArith/Zeven.vo theories7/ZArith/Zmin.vo theories7/ZArith/Zabs.vo theories7/ZArith/Znat.vo theories7/ZArith/auxiliary.vo theories7/ZArith/Zsyntax.vo theories7/ZArith/ZArith_dec.vo theories7/ZArith/Zbool.vo theories7/ZArith/Zmisc.vo theories7/ZArith/Wf_Z.vo theories7/ZArith/Zhints.vo
-theories7/ZArith/Zbool.vo: theories7/ZArith/Zbool.v theories7/ZArith/BinInt.vo theories7/ZArith/Zeven.vo theories7/ZArith/Zorder.vo theories7/ZArith/Zcompare.vo theories7/ZArith/ZArith_dec.vo theories7/ZArith/Zsyntax.vo theories7/Bool/Sumbool.vo
-theories7/ZArith/Zbinary.vo: theories7/ZArith/Zbinary.v theories7/Bool/Bvector.vo theories7/ZArith/ZArith.vo theories7/ZArith/Zpower.vo contrib7/omega/Omega.vo
-theories7/ZArith/Znumtheory.vo: theories7/ZArith/Znumtheory.v theories7/ZArith/ZArith_base.vo contrib7/ring/ZArithRing.vo theories7/ZArith/Zcomplements.vo theories7/ZArith/Zdiv.vo
-theories7/Lists/MonoList.vo: theories7/Lists/MonoList.v theories7/Arith/Le.vo
-theories7/Lists/ListSet.vo: theories7/Lists/ListSet.v theories7/Lists/PolyList.vo
-theories7/Lists/Streams.vo: theories7/Lists/Streams.v
-theories7/Lists/TheoryList.vo: theories7/Lists/TheoryList.v theories7/Lists/PolyList.vo theories7/Arith/Le.vo theories7/Arith/Lt.vo theories7/Arith/Minus.vo theories7/Bool/DecBool.vo
-theories7/Lists/List.vo: theories7/Lists/List.v theories7/Arith/Le.vo
-theories7/Sets/Classical_sets.vo: theories7/Sets/Classical_sets.v theories7/Sets/Ensembles.vo theories7/Sets/Constructive_sets.vo theories7/Logic/Classical_Type.vo
-theories7/Sets/Permut.vo: theories7/Sets/Permut.v
-theories7/Sets/Constructive_sets.vo: theories7/Sets/Constructive_sets.v theories7/Sets/Ensembles.vo
-theories7/Sets/Powerset.vo: theories7/Sets/Powerset.v theories7/Sets/Ensembles.vo theories7/Sets/Relations_1.vo theories7/Sets/Relations_1_facts.vo theories7/Sets/Partial_Order.vo theories7/Sets/Cpo.vo
-theories7/Sets/Cpo.vo: theories7/Sets/Cpo.v theories7/Sets/Ensembles.vo theories7/Sets/Relations_1.vo theories7/Sets/Partial_Order.vo
-theories7/Sets/Powerset_Classical_facts.vo: theories7/Sets/Powerset_Classical_facts.v theories7/Sets/Ensembles.vo theories7/Sets/Constructive_sets.vo theories7/Sets/Relations_1.vo theories7/Sets/Relations_1_facts.vo theories7/Sets/Partial_Order.vo theories7/Sets/Cpo.vo theories7/Sets/Powerset.vo theories7/Sets/Powerset_facts.vo theories7/Logic/Classical_Type.vo theories7/Sets/Classical_sets.vo
-theories7/Sets/Ensembles.vo: theories7/Sets/Ensembles.v
-theories7/Sets/Powerset_facts.vo: theories7/Sets/Powerset_facts.v theories7/Sets/Ensembles.vo theories7/Sets/Constructive_sets.vo theories7/Sets/Relations_1.vo theories7/Sets/Relations_1_facts.vo theories7/Sets/Partial_Order.vo theories7/Sets/Cpo.vo theories7/Sets/Powerset.vo
-theories7/Sets/Finite_sets.vo: theories7/Sets/Finite_sets.v theories7/Sets/Ensembles.vo theories7/Sets/Constructive_sets.vo
-theories7/Sets/Relations_1.vo: theories7/Sets/Relations_1.v
-theories7/Sets/Finite_sets_facts.vo: theories7/Sets/Finite_sets_facts.v theories7/Sets/Finite_sets.vo theories7/Sets/Constructive_sets.vo theories7/Logic/Classical_Type.vo theories7/Sets/Classical_sets.vo theories7/Sets/Powerset.vo theories7/Sets/Powerset_facts.vo theories7/Sets/Powerset_Classical_facts.vo theories7/Arith/Gt.vo theories7/Arith/Lt.vo
-theories7/Sets/Relations_1_facts.vo: theories7/Sets/Relations_1_facts.v theories7/Sets/Relations_1.vo
-theories7/Sets/Image.vo: theories7/Sets/Image.v theories7/Sets/Finite_sets.vo theories7/Sets/Constructive_sets.vo theories7/Logic/Classical_Type.vo theories7/Sets/Classical_sets.vo theories7/Sets/Powerset.vo theories7/Sets/Powerset_facts.vo theories7/Sets/Powerset_Classical_facts.vo theories7/Arith/Gt.vo theories7/Arith/Lt.vo theories7/Arith/Le.vo theories7/Sets/Finite_sets_facts.vo
-theories7/Sets/Relations_2.vo: theories7/Sets/Relations_2.v theories7/Sets/Relations_1.vo
-theories7/Sets/Infinite_sets.vo: theories7/Sets/Infinite_sets.v theories7/Sets/Finite_sets.vo theories7/Sets/Constructive_sets.vo theories7/Logic/Classical_Type.vo theories7/Sets/Classical_sets.vo theories7/Sets/Powerset.vo theories7/Sets/Powerset_facts.vo theories7/Sets/Powerset_Classical_facts.vo theories7/Arith/Gt.vo theories7/Arith/Lt.vo theories7/Arith/Le.vo theories7/Sets/Finite_sets_facts.vo theories7/Sets/Image.vo
-theories7/Sets/Relations_2_facts.vo: theories7/Sets/Relations_2_facts.v theories7/Sets/Relations_1.vo theories7/Sets/Relations_1_facts.vo theories7/Sets/Relations_2.vo
-theories7/Sets/Integers.vo: theories7/Sets/Integers.v theories7/Sets/Finite_sets.vo theories7/Sets/Constructive_sets.vo theories7/Logic/Classical_Type.vo theories7/Sets/Classical_sets.vo theories7/Sets/Powerset.vo theories7/Sets/Powerset_facts.vo theories7/Sets/Powerset_Classical_facts.vo theories7/Arith/Gt.vo theories7/Arith/Lt.vo theories7/Arith/Le.vo theories7/Sets/Finite_sets_facts.vo theories7/Sets/Image.vo theories7/Sets/Infinite_sets.vo theories7/Arith/Compare_dec.vo theories7/Sets/Relations_1.vo theories7/Sets/Partial_Order.vo theories7/Sets/Cpo.vo
-theories7/Sets/Relations_3.vo: theories7/Sets/Relations_3.v theories7/Sets/Relations_1.vo theories7/Sets/Relations_2.vo
-theories7/Sets/Multiset.vo: theories7/Sets/Multiset.v theories7/Sets/Permut.vo theories7/Arith/Plus.vo
-theories7/Sets/Relations_3_facts.vo: theories7/Sets/Relations_3_facts.v theories7/Sets/Relations_1.vo theories7/Sets/Relations_1_facts.vo theories7/Sets/Relations_2.vo theories7/Sets/Relations_2_facts.vo theories7/Sets/Relations_3.vo
-theories7/Sets/Partial_Order.vo: theories7/Sets/Partial_Order.v theories7/Sets/Ensembles.vo theories7/Sets/Relations_1.vo
-theories7/Sets/Uniset.vo: theories7/Sets/Uniset.v theories7/Bool/Bool.vo theories7/Sets/Permut.vo
-theories7/IntMap/Adalloc.vo: theories7/IntMap/Adalloc.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/ZArith/ZArith.vo theories7/Arith/Arith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Fset.vo
-theories7/IntMap/Mapcanon.vo: theories7/IntMap/Mapcanon.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/Arith/Arith.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Mapaxioms.vo theories7/IntMap/Mapiter.vo theories7/IntMap/Fset.vo theories7/Lists/PolyList.vo theories7/IntMap/Lsort.vo theories7/IntMap/Mapsubset.vo theories7/IntMap/Mapcard.vo
-theories7/IntMap/Addec.vo: theories7/IntMap/Addec.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo
-theories7/IntMap/Mapcard.vo: theories7/IntMap/Mapcard.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/Arith/Arith.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Mapaxioms.vo theories7/IntMap/Mapiter.vo theories7/IntMap/Fset.vo theories7/IntMap/Mapsubset.vo theories7/Lists/PolyList.vo theories7/IntMap/Lsort.vo theories7/Arith/Peano_dec.vo
-theories7/IntMap/Addr.vo: theories7/IntMap/Addr.v theories7/Bool/Bool.vo theories7/ZArith/ZArith.vo
-theories7/IntMap/Mapc.vo: theories7/IntMap/Mapc.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/Arith/Arith.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Mapaxioms.vo theories7/IntMap/Fset.vo theories7/IntMap/Mapiter.vo theories7/IntMap/Mapsubset.vo theories7/Lists/PolyList.vo theories7/IntMap/Lsort.vo theories7/IntMap/Mapcard.vo theories7/IntMap/Mapcanon.vo
-theories7/IntMap/Adist.vo: theories7/IntMap/Adist.v theories7/Bool/Bool.vo theories7/ZArith/ZArith.vo theories7/Arith/Arith.vo theories7/Arith/Min.vo theories7/IntMap/Addr.vo
-theories7/IntMap/Mapfold.vo: theories7/IntMap/Mapfold.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Fset.vo theories7/IntMap/Mapaxioms.vo theories7/IntMap/Mapiter.vo theories7/IntMap/Lsort.vo theories7/IntMap/Mapsubset.vo theories7/Lists/PolyList.vo
-theories7/IntMap/Allmaps.vo: theories7/IntMap/Allmaps.v theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Fset.vo theories7/IntMap/Mapaxioms.vo theories7/IntMap/Mapiter.vo theories7/IntMap/Mapsubset.vo theories7/IntMap/Lsort.vo theories7/IntMap/Mapfold.vo theories7/IntMap/Mapcard.vo theories7/IntMap/Mapcanon.vo theories7/IntMap/Mapc.vo theories7/IntMap/Maplists.vo theories7/IntMap/Adalloc.vo
-theories7/IntMap/Mapiter.vo: theories7/IntMap/Mapiter.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Mapaxioms.vo theories7/IntMap/Fset.vo theories7/Lists/PolyList.vo
-theories7/IntMap/Fset.vo: theories7/IntMap/Fset.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo
-theories7/IntMap/Maplists.vo: theories7/IntMap/Maplists.v theories7/IntMap/Addr.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Fset.vo theories7/IntMap/Mapaxioms.vo theories7/IntMap/Mapsubset.vo theories7/IntMap/Mapcard.vo theories7/IntMap/Mapcanon.vo theories7/IntMap/Mapc.vo theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/Lists/PolyList.vo theories7/Arith/Arith.vo theories7/IntMap/Mapiter.vo theories7/IntMap/Mapfold.vo
-theories7/IntMap/Lsort.vo: theories7/IntMap/Lsort.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/Arith/Arith.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/Lists/PolyList.vo theories7/IntMap/Mapiter.vo
-theories7/IntMap/Mapsubset.vo: theories7/IntMap/Mapsubset.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/Arith/Arith.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Fset.vo theories7/IntMap/Mapaxioms.vo theories7/IntMap/Mapiter.vo
-theories7/IntMap/Mapaxioms.vo: theories7/IntMap/Mapaxioms.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo theories7/IntMap/Map.vo theories7/IntMap/Fset.vo
-theories7/IntMap/Map.vo: theories7/IntMap/Map.v theories7/Bool/Bool.vo theories7/Bool/Sumbool.vo theories7/ZArith/ZArith.vo theories7/IntMap/Addr.vo theories7/IntMap/Adist.vo theories7/IntMap/Addec.vo
-theories7/Relations/Newman.vo: theories7/Relations/Newman.v theories7/Relations/Rstar.vo
-theories7/Relations/Operators_Properties.vo: theories7/Relations/Operators_Properties.v theories7/Relations/Relation_Definitions.vo theories7/Relations/Relation_Operators.vo
-theories7/Relations/Relation_Definitions.vo: theories7/Relations/Relation_Definitions.v
-theories7/Relations/Relation_Operators.vo: theories7/Relations/Relation_Operators.v theories7/Relations/Relation_Definitions.vo theories7/Lists/PolyList.vo theories7/Lists/PolyListSyntax.vo
-theories7/Relations/Relations.vo: theories7/Relations/Relations.v theories7/Relations/Relation_Definitions.vo theories7/Relations/Relation_Operators.vo theories7/Relations/Operators_Properties.vo
-theories7/Relations/Rstar.vo: theories7/Relations/Rstar.v
-theories7/Wellfounded/Disjoint_Union.vo: theories7/Wellfounded/Disjoint_Union.v theories7/Relations/Relation_Operators.vo
-theories7/Wellfounded/Inclusion.vo: theories7/Wellfounded/Inclusion.v theories7/Relations/Relation_Definitions.vo
-theories7/Wellfounded/Inverse_Image.vo: theories7/Wellfounded/Inverse_Image.v
-theories7/Wellfounded/Lexicographic_Exponentiation.vo: theories7/Wellfounded/Lexicographic_Exponentiation.v theories7/Logic/Eqdep.vo theories7/Lists/PolyList.vo theories7/Lists/PolyListSyntax.vo theories7/Relations/Relation_Operators.vo theories7/Wellfounded/Transitive_Closure.vo
-theories7/Wellfounded/Transitive_Closure.vo: theories7/Wellfounded/Transitive_Closure.v theories7/Relations/Relation_Definitions.vo theories7/Relations/Relation_Operators.vo
-theories7/Wellfounded/Union.vo: theories7/Wellfounded/Union.v theories7/Relations/Relation_Operators.vo theories7/Relations/Relation_Definitions.vo theories7/Wellfounded/Transitive_Closure.vo
-theories7/Wellfounded/Wellfounded.vo: theories7/Wellfounded/Wellfounded.v theories7/Wellfounded/Disjoint_Union.vo theories7/Wellfounded/Inclusion.vo theories7/Wellfounded/Inverse_Image.vo theories7/Wellfounded/Lexicographic_Exponentiation.vo theories7/Wellfounded/Lexicographic_Product.vo theories7/Wellfounded/Transitive_Closure.vo theories7/Wellfounded/Union.vo theories7/Wellfounded/Well_Ordering.vo
-theories7/Wellfounded/Well_Ordering.vo: theories7/Wellfounded/Well_Ordering.v theories7/Logic/Eqdep.vo
-theories7/Wellfounded/Lexicographic_Product.vo: theories7/Wellfounded/Lexicographic_Product.v theories7/Logic/Eqdep.vo theories7/Relations/Relation_Operators.vo theories7/Wellfounded/Transitive_Closure.vo
-theories7/Reals/Rdefinitions.vo: theories7/Reals/Rdefinitions.v theories7/ZArith/ZArith_base.vo
-theories7/Reals/Raxioms.vo: theories7/Reals/Raxioms.v theories7/ZArith/ZArith_base.vo theories7/Reals/Rsyntax.vo
-theories7/Reals/RIneq.vo: theories7/Reals/RIneq.v theories7/Reals/Raxioms.vo contrib7/ring/ZArithRing.vo contrib7/omega/Omega.vo contrib7/field/Field.vo
-theories7/Reals/DiscrR.vo: theories7/Reals/DiscrR.v theories7/Reals/RIneq.vo contrib7/omega/Omega.vo
-theories7/Reals/Rbase.vo: theories7/Reals/Rbase.v theories7/Reals/Rdefinitions.vo theories7/Reals/Raxioms.vo theories7/Reals/RIneq.vo theories7/Reals/DiscrR.vo
-theories7/Reals/R_Ifp.vo: theories7/Reals/R_Ifp.v theories7/Reals/Rbase.vo contrib7/omega/Omega.vo
-theories7/Reals/Rbasic_fun.vo: theories7/Reals/Rbasic_fun.v theories7/Reals/Rbase.vo theories7/Reals/R_Ifp.vo contrib7/fourier/Fourier.vo
-theories7/Reals/R_sqr.vo: theories7/Reals/R_sqr.v theories7/Reals/Rbase.vo theories7/Reals/Rbasic_fun.vo
-theories7/Reals/SplitAbsolu.vo: theories7/Reals/SplitAbsolu.v theories7/Reals/Rbasic_fun.vo
-theories7/Reals/SplitRmult.vo: theories7/Reals/SplitRmult.v theories7/Reals/Rbase.vo
-theories7/Reals/ArithProp.vo: theories7/Reals/ArithProp.v theories7/Reals/Rbase.vo theories7/Reals/Rbasic_fun.vo theories7/Arith/Even.vo theories7/Arith/Div2.vo
-theories7/Reals/Rfunctions.vo: theories7/Reals/Rfunctions.v theories7/Reals/Rbase.vo theories7/Reals/R_Ifp.vo theories7/Reals/Rbasic_fun.vo theories7/Reals/R_sqr.vo theories7/Reals/SplitAbsolu.vo theories7/Reals/SplitRmult.vo theories7/Reals/ArithProp.vo contrib7/omega/Omega.vo theories7/ZArith/Zpower.vo
-theories7/Reals/Rseries.vo: theories7/Reals/Rseries.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Logic/Classical.vo theories7/Arith/Compare.vo
-theories7/Reals/SeqProp.vo: theories7/Reals/SeqProp.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rseries.vo theories7/Logic/Classical.vo theories7/Arith/Max.vo
-theories7/Reals/Rcomplete.vo: theories7/Reals/Rcomplete.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rseries.vo theories7/Reals/SeqProp.vo theories7/Arith/Max.vo
-theories7/Reals/PartSum.vo: theories7/Reals/PartSum.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rseries.vo theories7/Reals/Rcomplete.vo theories7/Arith/Max.vo
-theories7/Reals/AltSeries.vo: theories7/Reals/AltSeries.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rseries.vo theories7/Reals/SeqProp.vo theories7/Reals/PartSum.vo theories7/Arith/Max.vo
-theories7/Reals/Binomial.vo: theories7/Reals/Binomial.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/PartSum.vo
-theories7/Reals/Rsigma.vo: theories7/Reals/Rsigma.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rseries.vo theories7/Reals/PartSum.vo
-theories7/Reals/Rprod.vo: theories7/Reals/Rprod.v theories7/Arith/Compare.vo theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rseries.vo theories7/Reals/PartSum.vo theories7/Reals/Binomial.vo
-theories7/Reals/Cauchy_prod.vo: theories7/Reals/Cauchy_prod.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rseries.vo theories7/Reals/PartSum.vo
-theories7/Reals/Alembert.vo: theories7/Reals/Alembert.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rseries.vo theories7/Reals/SeqProp.vo theories7/Reals/PartSum.vo theories7/Arith/Max.vo
-theories7/Reals/SeqSeries.vo: theories7/Reals/SeqSeries.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Arith/Max.vo theories7/Reals/Rseries.vo theories7/Reals/SeqProp.vo theories7/Reals/Rcomplete.vo theories7/Reals/PartSum.vo theories7/Reals/AltSeries.vo theories7/Reals/Binomial.vo theories7/Reals/Rsigma.vo theories7/Reals/Rprod.vo theories7/Reals/Cauchy_prod.vo theories7/Reals/Alembert.vo
-theories7/Reals/Rtrigo_fun.vo: theories7/Reals/Rtrigo_fun.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo
-theories7/Reals/Rtrigo_def.vo: theories7/Reals/Rtrigo_def.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo_fun.vo theories7/Arith/Max.vo
-theories7/Reals/Rtrigo_alt.vo: theories7/Reals/Rtrigo_alt.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo_def.vo
-theories7/Reals/Cos_rel.vo: theories7/Reals/Cos_rel.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo_def.vo
-theories7/Reals/Cos_plus.vo: theories7/Reals/Cos_plus.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo_def.vo theories7/Reals/Cos_rel.vo theories7/Arith/Max.vo
-theories7/Reals/Rtrigo.vo: theories7/Reals/Rtrigo.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo_fun.vo theories7/Reals/Rtrigo_def.vo theories7/Reals/Rtrigo_alt.vo theories7/Reals/Cos_rel.vo theories7/Reals/Cos_plus.vo theories7/ZArith/ZArith_base.vo theories7/ZArith/Zcomplements.vo theories7/Logic/Classical_Prop.vo
-theories7/Reals/Rlimit.vo: theories7/Reals/Rlimit.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Logic/Classical_Prop.vo contrib7/fourier/Fourier.vo
-theories7/Reals/Rderiv.vo: theories7/Reals/Rderiv.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rlimit.vo contrib7/fourier/Fourier.vo theories7/Logic/Classical_Prop.vo theories7/Logic/Classical_Pred_Type.vo contrib7/omega/Omega.vo
-theories7/Reals/RList.vo: theories7/Reals/RList.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo
-theories7/Reals/Ranalysis1.vo: theories7/Reals/Ranalysis1.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rlimit.vo theories7/Reals/Rderiv.vo
-theories7/Reals/Ranalysis2.vo: theories7/Reals/Ranalysis2.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Ranalysis1.vo
-theories7/Reals/Ranalysis3.vo: theories7/Reals/Ranalysis3.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Ranalysis1.vo theories7/Reals/Ranalysis2.vo
-theories7/Reals/Rtopology.vo: theories7/Reals/Rtopology.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Ranalysis1.vo theories7/Reals/RList.vo theories7/Logic/Classical_Prop.vo theories7/Logic/Classical_Pred_Type.vo
-theories7/Reals/MVT.vo: theories7/Reals/MVT.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Ranalysis1.vo theories7/Reals/Rtopology.vo
-theories7/Reals/PSeries_reg.vo: theories7/Reals/PSeries_reg.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Ranalysis1.vo theories7/Arith/Max.vo theories7/Arith/Even.vo
-theories7/Reals/Exp_prop.vo: theories7/Reals/Exp_prop.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo.vo theories7/Reals/Ranalysis1.vo theories7/Reals/PSeries_reg.vo theories7/Arith/Div2.vo theories7/Arith/Even.vo theories7/Arith/Max.vo
-theories7/Reals/Rtrigo_reg.vo: theories7/Reals/Rtrigo_reg.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo.vo theories7/Reals/Ranalysis1.vo theories7/Reals/PSeries_reg.vo
-theories7/Reals/Rsqrt_def.vo: theories7/Reals/Rsqrt_def.v theories7/Bool/Sumbool.vo theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Ranalysis1.vo
-theories7/Reals/R_sqrt.vo: theories7/Reals/R_sqrt.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rsqrt_def.vo
-theories7/Reals/Rtrigo_calc.vo: theories7/Reals/Rtrigo_calc.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo.vo theories7/Reals/R_sqrt.vo
-theories7/Reals/Rgeom.vo: theories7/Reals/Rgeom.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo.vo theories7/Reals/R_sqrt.vo
-theories7/Reals/Sqrt_reg.vo: theories7/Reals/Sqrt_reg.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Ranalysis1.vo theories7/Reals/R_sqrt.vo
-theories7/Reals/Ranalysis4.vo: theories7/Reals/Ranalysis4.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo.vo theories7/Reals/Ranalysis1.vo theories7/Reals/Ranalysis3.vo theories7/Reals/Exp_prop.vo
-theories7/Reals/Rpower.vo: theories7/Reals/Rpower.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo.vo theories7/Reals/Ranalysis1.vo theories7/Reals/Exp_prop.vo theories7/Reals/Rsqrt_def.vo theories7/Reals/R_sqrt.vo theories7/Reals/MVT.vo theories7/Reals/Ranalysis4.vo
-theories7/Reals/Ranalysis.vo: theories7/Reals/Ranalysis.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Rtrigo.vo theories7/Reals/SeqSeries.vo theories7/Reals/Ranalysis1.vo theories7/Reals/Ranalysis2.vo theories7/Reals/Ranalysis3.vo theories7/Reals/Rtopology.vo theories7/Reals/MVT.vo theories7/Reals/PSeries_reg.vo theories7/Reals/Exp_prop.vo theories7/Reals/Rtrigo_reg.vo theories7/Reals/Rsqrt_def.vo theories7/Reals/R_sqrt.vo theories7/Reals/Rtrigo_calc.vo theories7/Reals/Rgeom.vo theories7/Reals/RList.vo theories7/Reals/Sqrt_reg.vo theories7/Reals/Ranalysis4.vo theories7/Reals/Rpower.vo
-theories7/Reals/NewtonInt.vo: theories7/Reals/NewtonInt.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo.vo theories7/Reals/Ranalysis.vo
-theories7/Reals/RiemannInt_SF.vo: theories7/Reals/RiemannInt_SF.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/Ranalysis.vo theories7/Logic/Classical_Prop.vo
-theories7/Reals/RiemannInt.vo: theories7/Reals/RiemannInt.v theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Ranalysis.vo theories7/Reals/Rbase.vo theories7/Reals/RiemannInt_SF.vo theories7/Logic/Classical_Prop.vo theories7/Logic/Classical_Pred_Type.vo theories7/Arith/Max.vo
-theories7/Reals/Integration.vo: theories7/Reals/Integration.v theories7/Reals/NewtonInt.vo theories7/Reals/RiemannInt_SF.vo theories7/Reals/RiemannInt.vo
-theories7/Reals/Reals.vo: theories7/Reals/Reals.v theories7/Reals/Rbase.vo theories7/Reals/Rfunctions.vo theories7/Reals/SeqSeries.vo theories7/Reals/Rtrigo.vo theories7/Reals/Ranalysis.vo theories7/Reals/Integration.vo
-theories7/Setoids/Setoid.vo: theories7/Setoids/Setoid.v
-theories7/Sorting/Heap.vo: theories7/Sorting/Heap.v theories7/Lists/PolyList.vo theories7/Sets/Multiset.vo theories7/Sorting/Permutation.vo theories7/Relations/Relations.vo theories7/Sorting/Sorting.vo
-theories7/Sorting/Permutation.vo: theories7/Sorting/Permutation.v theories7/Relations/Relations.vo theories7/Lists/PolyList.vo theories7/Sets/Multiset.vo
-theories7/Sorting/Sorting.vo: theories7/Sorting/Sorting.v theories7/Lists/PolyList.vo theories7/Sets/Multiset.vo theories7/Sorting/Permutation.vo theories7/Relations/Relations.vo
-theories7/Lists/PolyList.vo: theories7/Lists/PolyList.v theories7/Arith/Le.vo
-theories7/Lists/PolyListSyntax.vo: theories7/Lists/PolyListSyntax.v
-theories7/ZArith/Zsyntax.vo: theories7/ZArith/Zsyntax.v theories7/ZArith/BinInt.vo
-theories7/ZArith/zarith_aux.vo: theories7/ZArith/zarith_aux.v theories7/ZArith/BinInt.vo theories7/ZArith/Zcompare.vo theories7/ZArith/Zorder.vo theories7/ZArith/Zmin.vo theories7/ZArith/Zabs.vo
-theories7/ZArith/fast_integer.vo: theories7/ZArith/fast_integer.v theories7/NArith/BinPos.vo theories7/NArith/BinNat.vo theories7/ZArith/BinInt.vo theories7/ZArith/Zcompare.vo theories7/Arith/Mult.vo
-theories7/Reals/Rsyntax.vo: theories7/Reals/Rsyntax.v theories7/Reals/Rdefinitions.vo
-contrib7/omega/OmegaLemmas.vo: contrib7/omega/OmegaLemmas.v theories7/ZArith/ZArith_base.vo
-contrib7/omega/Omega.vo: contrib7/omega/Omega.v theories7/ZArith/ZArith_base.vo contrib7/omega/OmegaLemmas.vo theories7/ZArith/Zhints.vo
-contrib7/romega/ReflOmegaCore.vo: contrib7/romega/ReflOmegaCore.v theories7/Arith/Arith.vo theories7/Lists/PolyList.vo theories7/Bool/Bool.vo theories7/ZArith/ZArith.vo contrib7/omega/OmegaLemmas.vo theories7/Logic/Decidable.vo
-contrib7/romega/ROmega.vo: contrib7/romega/ROmega.v contrib7/omega/Omega.vo contrib7/romega/ReflOmegaCore.vo
-contrib7/ring/ArithRing.vo: contrib7/ring/ArithRing.v contrib7/ring/Ring.vo theories7/Arith/Arith.vo theories7/Logic/Eqdep_dec.vo
-contrib7/ring/Ring_normalize.vo: contrib7/ring/Ring_normalize.v contrib7/ring/Ring_theory.vo contrib7/ring/Quote.vo
-contrib7/ring/Ring_theory.vo: contrib7/ring/Ring_theory.v theories7/Bool/Bool.vo
-contrib7/ring/Ring.vo: contrib7/ring/Ring.v theories7/Bool/Bool.vo contrib7/ring/Ring_theory.vo contrib7/ring/Quote.vo contrib7/ring/Ring_normalize.vo contrib7/ring/Ring_abstract.vo
-contrib7/ring/NArithRing.vo: contrib7/ring/NArithRing.v contrib7/ring/Ring.vo theories7/ZArith/ZArith_base.vo theories7/NArith/NArith.vo theories7/Logic/Eqdep_dec.vo
-contrib7/ring/ZArithRing.vo: contrib7/ring/ZArithRing.v contrib7/ring/ArithRing.vo theories7/ZArith/ZArith_base.vo theories7/Logic/Eqdep_dec.vo
-contrib7/ring/Ring_abstract.vo: contrib7/ring/Ring_abstract.v contrib7/ring/Ring_theory.vo contrib7/ring/Quote.vo contrib7/ring/Ring_normalize.vo
-contrib7/ring/Quote.vo: contrib7/ring/Quote.v
-contrib7/ring/Setoid_ring_normalize.vo: contrib7/ring/Setoid_ring_normalize.v contrib7/ring/Setoid_ring_theory.vo contrib7/ring/Quote.vo
-contrib7/ring/Setoid_ring.vo: contrib7/ring/Setoid_ring.v contrib7/ring/Setoid_ring_theory.vo contrib7/ring/Quote.vo contrib7/ring/Setoid_ring_normalize.vo
-contrib7/ring/Setoid_ring_theory.vo: contrib7/ring/Setoid_ring_theory.v theories7/Bool/Bool.vo theories7/Setoids/Setoid.vo
-contrib7/field/Field_Compl.vo: contrib7/field/Field_Compl.v
-contrib7/field/Field_Theory.vo: contrib7/field/Field_Theory.v theories7/Arith/Peano_dec.vo contrib7/ring/Ring.vo contrib7/field/Field_Compl.vo
-contrib7/field/Field_Tactic.vo: contrib7/field/Field_Tactic.v contrib7/ring/Ring.vo contrib7/field/Field_Compl.vo contrib7/field/Field_Theory.vo
-contrib7/field/Field.vo: contrib7/field/Field.v contrib7/field/Field_Compl.vo contrib7/field/Field_Theory.vo contrib7/field/Field_Tactic.vo
-contrib7/fourier/Fourier_util.vo: contrib7/fourier/Fourier_util.v theories7/Reals/Rbase.vo
-contrib7/fourier/Fourier.vo: contrib7/fourier/Fourier.v contrib7/fourier/Fourier_util.vo contrib7/field/Field.vo theories7/Reals/DiscrR.vo
-contrib7/cc/CCSolve.vo: contrib7/cc/CCSolve.v
diff --git a/ANNONCE b/ANNONCE
new file mode 100644
index 00000000..5e634f2c
--- /dev/null
+++ b/ANNONCE
@@ -0,0 +1,27 @@
+The main features of Coq version 8.1 are
+
+- the implementation of an alternative algorithm for checking the
+  convertibility of types, specially dedicated to fast type-checking
+  of reflexion-based proofs, and more generally to intensive
+  computation
+
+- richer inductive types
+
+  - support for recursively non uniform parameters
+  - support for a strong form of sort-polymorphism
+
+- improved tactics
+
+  - new implementation of setoid rewrite (contributed by C. Sacerdoti Coen)
+  - new implementation of ring (contributed by B. Grégoire and A. Mahboubi)
+  - and several other new tactic features
+
+- new libraries
+ 
+  - finite sets and finite maps (by J.-C. Filliâtre and P. Letouzey)
+  - strings (by L. Théry)
+  - significative extensions of the library on lists
+  - a few other extensions
+
+- improved module system
+
diff --git a/CHANGES b/CHANGES
index 7c7f5dc7..b094d8ff 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,78 +1,119 @@
-Changes from V8.0pl2 to V8.0pl3
-===============================
+Changes from V8.0
+=================
 
-Tactics
+Syntax
 
-- The search depth argument of auto can be parameterised in the
-  Ltac language
-- Added entry constr_may_eval for tactic extensions (new syntax)
+- No more support for version 7 syntax and for translation to version 8 syntax.
+- Support for primitive interpretation of string literals
+- Extended support for Unicode ranges (Unicode doc TODO)
 
-Compilation
+Environment variables
 
-- Coq sources made compatible with ocaml 3.09.0 and lablgtk 2.6.0.
+- COQREMOTEBROWSER to set the command invoked to start the remote browser
+  both in Coq and coqide. Standard syntax: "%s" is the placeholder for the
+  URL (doc TODO)
 
-Standard library
+Vernacular commands
 
-- A couple of lemmas of ZArith were renamed. This concerns names
-  containing O (the letter), which is replaced by 0 (the number).
+- Added "Print Ltac qualid" to print a user defined tactic (doc TODO)
+- Added "Print Rewrite HintDb" to print the content of a DB used by
+  autorewrite (doc TODO)
+- Added "Print Canonical Projections" (doc TODO)
+- Added "Example" as synonym of "Definition"
+- Added "Property", "Proposition" and "Corollary" as extra synonyms of "Lemma"
 
-Bug fixes
+Gallina
 
-- Fixes a serious bug in CoqIde. The windows port should be able
-  to load large libraries (such as Reals) without producing the
-  "bad file descriptor" error.
-- Scope of Ltac variables: global Ltac macros no longer hide goal
-  hypotheses
-- Many fixes concerning extraction: 
-  * fewer useless eta-expansions
-  * for Ocaml: extraction of records should be ok now. Problem with 
-    type t = M.t in modules fixed.
-  * in Haskell: improved use of unsafeCoerce, fixed Extract Constant, 
-    function types are now printed.
-  * important revision of the Scheme extraction: 
-    see http://www.pps.jussieu.fr/~letouzey/scheme
-- Fixes a bug in the interpretation of record projections ("bad number
-  of parameters" error)
-- Fixed a bug in the omega tactic
-- Fixed a bug in the fold tactic regarding hypotheses ordering
-- Pretty-print of universes fixed
-- Added an empty level 99 in patterns syntax entry
-- "Notation" bug fixes ("only parsing" bug, printing of numerals
-  arguments of coercions, default spacing for recursive notations
-  with no terminal separator, "Tactic Notation" printer).
-
-Changes from V8.0pl1 to V8.0pl2
-===============================
+- Added disjunctive patterns in match-with patterns
 
-Notations
+Ltac
 
-- Option "format" now aware of recursive notations
+- New primitive "external" for communication with tool external to Coq
+- Semantics of "match t with" changed: if a clause returns a
+  tactic, it is now applied to the current goal. If it fails, the next
+  clause or next matching subterm is tried (i.e. it behaves as "match
+  goal with").
+- New modifier "lazy" (TODO) for "match t with" and "match goal with" telling
+  to delay the evaluation of tactic expression.
+- Hint base name can be parametric in auto and trivial.
 
-Bug fixes
+Tactics
 
-- Tactic "fail n" for n<>0 now works (notice that each "match term with"
-  block decreases the failure level, in accordance with the intuition but
-  not in conformity with the reference manual)
-- Option -dump-glob now strips module segment as expected by coqdoc (which
-  is still not aware of modules)
-- See coq-bugs web page for a full list of fixed bugs (look for
-  fixes committed before Jan 2005 to cvs version V8-0-bugfix)
+- New implementation and generalization of [setoid_]* (setoid_rewrite,
+  setoid_symmetry, setoid_transitivity, setoid_reflexivity and autorewite).
+  New syntax for declaring relations and morphisms (old syntax still working
+  with minor modifications, but deprecated) (doc TODO)
+- Added "clear - id" to clear all hypotheses except the ones depending in id.
+- Added "dependent rewrite term" and "dependent rewrite term in hyp" (doc TODO)
+- The argument of Declare Left Step and Declare Right Step is now a term
+  (it used to be a reference) (doc TODO)
+- Omega now handles arbitrary precision integers
+- Idtac can now be left implicit in a [...|...] construct: for instance, 
+  [ foo | | bar ] stands for [ foo | idtac | bar ]. (doc TODO). 
+- "Tactic Notation" extended to allow notations of tacticals (doc TODO).
+- Added "autorewrite with ... in hyp [using ...]" (doc TODO).
+- Added entry constr_may_eval for tactic extensions (new syntax).
+- Fixed a "fold" bug (non critical and possible source of incompatibilities).
+- Added classical_left and classical_right which transforms |- A \/ B into 
+  ~B |- A and ~A |- B respectively.
+- Added command "Declare Implicit Tactic" to set up a default tactic to be
+  used to solve unresolved subterms of term arguments of tactics.
+- Better support for coercions to Sortclass in tactics expecting type arguments
+- Low-priority term printer made available in ML-written tactic extensions
+- Tactic "assert" now accepts "as" intro patterns and "by" tactic clauses
+- New tactic "pose proof" that generalizes "assert (id:=p)" with intro patterns
+- New introduction pattern "?" for letting Coq choose a name
+- Added "eassumption"
+- Added option 'using lemmas' to auto, trivial and eauto
+- Numbering of "pattern", "unfold", "simpl", ... occurrences in "match
+  with" made consistent with the printing of the return clause after
+  the term to match in the "match-with" construct (use "Set Printing All"
+  to see hidden occurrences).
+- New definition command: "GenFixpoint" (TODO) (doc)
+- functional induction has been re-implemented from the new definition
+  command (doc TODO)
+- Genralisation of induction "induction x1...xn using scheme" where
+  scheme is an induction principle with complex predicates (like the
+  ones generated by function induction) (doc TODO).
 
-Changes from V8.0 to V8.0pl1
-============================
 
-Unicode support
+Modules
 
-- Miscellaneous Mathematical Symbols-A and B, and Supplemental
-  Arrows-A now supported
+- Added "Locate Module qualid" to get the full path of a module.
+- Module/Declare Module syntax made more uniform (doc TODO)
+- Added syntactic sugar "Declare Module Export/Import" and
+  "Module Export/Import" (doc TODO)
+- Added syntactic sugar "Module M(Export/Import X Y: T)" and
+  "Module Type M(Export/Import X Y: T)"
+  (only for interactive definitions) (doc TODO)
+- Construct "with" generalized to module paths:
+   T with (Definition|Module) M1.M2....Mn.l := l'.  (doc TODO)
 
-Bug fixes
+Notations
+
+- "format" option aware of recursive notations.
+- added insertion of spaces by default in recursive notations w/o separators.
+- no more automatic printing box in case of user-provided printing "format".
+- new notation "exists! x:A, P" for unique existence.
+
+Library
+
+- Small extension of Zmin.V, new Zmax.v, new Zminmax.v
+- New library on String and Ascii characters (contributed by L. Thery)
+- Few other improvements in ZArith potentially exceptionally breaking the
+  compatibility (useless hypothesys of Zgt_square_simpl and
+  Zlt_square_simpl removed; fixed names mentioning letter O instead of
+  digit 0; weaken premises in Z_lt_induction)
+- More lemmas stated on Type in Wf.v, removal of redundant Fix_F
+- Coq.List.In_dec has been set transparent (this may exceptionally break
+  proof scripts, set it locally opaque for compatibility)
+- Change of the internal names of lemmas in OmegaLemmas
+
+Tools
 
-- GPL-incompatible QPL files for CoqIde are now GPL 
-- Pretty-printing of coercions to Funclass fixed and improved
-- Erroneous interpretation of the quantified hypothesis in intro until fixed
-- See coq-bugs web page for a full list of fixed bugs (look for
-  fixes in V8-0-bugfix before July 17)
+- New semantics for coqtop options ("-batch" expects option "-top dir"
+  for loading vernac file that contains definitions).
+- coq_makefile now removes custom targets that are file names in "make clean"
 
 Changes from V8.0beta to V8.0
 =============================
diff --git a/CREDITS b/CREDITS
index 12cd8e65..0bc6ee56 100644
--- a/CREDITS
+++ b/CREDITS
@@ -1,115 +1,136 @@
-
-The "Coq proof assistant" was developed conjointly by 
-	INRIA Formel-Coq-LogiCal projects (since 1985), 
-	Laboratoire de l'Informatique du Parallelisme (LIP) 
-	associated to CNRS and ENS Lyon (Sep. 1989 to Aug. 1997),
-	Laboratoire de Recherche en Informatique (LRI)
-	associated to CNRS and Paris Sud (since Sep. 1997),
-	Laboratoire d'Informatique de l'Ecole Polytechnique (since Jan. 2003)
-	associated to CNRS and Ecole Polytechnique.
+The "Coq proof assistant" was jointly developed by 
+	
+- INRIA Formel, Coq, LogiCal, ProVal projects (since 1985), 
+- Laboratoire de l'Informatique du Parallelisme (LIP) 
+  associated to CNRS and ENS Lyon (Sep. 1989 to Aug. 1997),
+- Laboratoire de Recherche en Informatique (LRI)
+  associated to CNRS and Paris Sud (since Sep. 1997),
+- Laboratoire d'Informatique de l'Ecole Polytechnique (since Jan. 2003)
+  associated to CNRS and Ecole Polytechnique.
 
 All files of the "Coq proof assistant" in directories or sub-directories of
-	config dev doc interp kernel lib library parsing pretyping proofs
-	scripts syntax tactics test-suite theories tools toplevel translate
+
+  config dev ide interp kernel lib library parsing pretyping proofs
+  scripts states tactics test-suite theories tools toplevel
+
 are distributed under the terms of the GNU Lesser General Public License 
-Version 2.1 (see file LICENSE).
-These files are COPYRIGHT 1999-2004, The Coq development team, 
-CNRS, INRIA and Université Paris Sud
+Version 2.1 (see file LICENSE). These files are COPYRIGHT 1999-2006,
+The Coq development team, CNRS, INRIA and Université Paris Sud.
 
+Files from the directory doc are distributed as indicated in file doc/LICENCE.
 
 The following directories contain independent contributions supported 
-by the Coq development team :
+by the Coq development team. All of them are released under the terms of
+the GNU Lesser General Public License Version 2.1.
+
 contrib/cc
-	developed by Pierre Corbineau (ENS Cachan, 2001)
+  developed by Pierre Corbineau (ENS Cachan, 2001 and LRI, 2001-2005)
 contrib/correctness
-	developed by Jean-Christophe Filliâtre (LRI, 1999-2001)
+  developed by Jean-Christophe Filliâtre (LRI, 1999-2001)
+contrib/dp
+  developed by Nicolas Ayache and Jean-Christophe Filliâtre (LRI, 2005-2006)
 contrib/extraction
-	developed by Pierre Letouzey (LRI, 2000-2004)
+  developed by Pierre Letouzey (LRI, 2000-2006)
 contrib/field
-	developed by David Delahaye and Micaela Mayero (INRIA-LogiCal, 2001)
+  developed by David Delahaye and Micaela Mayero (INRIA-LogiCal, 2001)
 contrib/first-order 
-	developed by Pierre Corbineau (LRI, 2003-2004)
+  developed by Pierre Corbineau (LRI, 2003-2005)
 contrib/fourier
-	developed by Loïc Pottier (INRIA-Lemme, 2001)
+  developed by Loïc Pottier (INRIA-Lemme, 2001)
 contrib/funind
-	developed by Pierre Courtieu (INRIA-Lemme, 2003-2004)
+  developed by Pierre Courtieu (INRIA-Lemme, 2003-2004, CNAM, 2004-2006)
+  and Julien Forest, Benjamin Grégoire and Gilles Barthe (INRIA-Everest, 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-2004)
-contrib/jprover
-	The author of JProver is Stephan Schmitt <schmitts@spmail.slu.edu>,
-	and is integrated into MetaPRL by Aleksey Nogin <nogin@cs.cornell.edu>
-	and then into Coq by Guan-Shieng Huang (LRI, 2001-2002)
-	original files from Stephan Schmitt are "GPL"
+  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/romega
-	developed by Pierre Crégut (France Telecom R&D, 2001-2004)
+  developed by Pierre Crégut (France Telecom R&D, 1996)
+contrib/recdef
+  developed by Yves Bertot (INRIA-Marelle, 2005)
 contrib/ring
-	developed by Samuel Boutin (INRIA-Coq, 1996) and Patrick 
-	Loiseleur (LRI, 1997-1999)
+  developed by Samuel Boutin (INRIA-Coq, 1996) and Patrick 
+  Loiseleur (LRI, 1997-1999)
+contrib/romega
+  developed by Pierre Crégut (France Telecom R&D, 2001-2004)
+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)
+contrib/subtac
+  developed by Matthieu Sozeau (LRI, 2005-2006)
 contrib/xml
-	developed by Claudio Sacerdoti (Univ. Bologna, 2000-2004) 
-	as part of the HELM and MoWGLI project
+  developed by Claudio Sacerdoti (Univ. Bologna, 2000-2005) 
+  as part of the HELM and MoWGLI projects
 
 parsing/search.ml
-	developed by Yves Bertot (INRIA-Lemme, 2000-2004)
+  mainly developed by Yves Bertot (INRIA-Lemme, 2000-2004)
 theories/ZArith
-	started by Pierre Crégut (France Telecom R&D, 1996)
-ide/
-	developed by Benjamin Monate (LRI, 2003) with contributions 
-	from Claude Marché (INRIA, 2003-2004); some files from ide/utils 
-	come from Maxence Guesdon's Cameleon project and are "GPL"
+  started by Pierre Crégut (France Telecom R&D, 1996)
+theories/IntMap
+  developed by Jean Goubault-Larrecq (Dyade, 1998)
+theories/Strings
+  developed by Laurent Théry (INRIA-Lemme, 2003)
+ide/utils
+  some files come from Maxence Guesdon's Cameleon tool 
 
-Many discussions within the Démons team and the LogiCal project
+Many discussions within the Démons team at LRI and the LogiCal project
 influenced significantly the design of Coq especially with
-J. Courant, P. Courtieu, J. Duprat, J. Goubault,
-A. Miquel, C. Marché, B. Monate, B. Werner
+
+  J. Courant, P. Courtieu, J. Duprat, J. Goubault,
+  A. Miquel, C. Marché, B. Monate, B. Werner.
 
 Intensive users suggested improvements of the system : 
-Y. Bertot, L. Pottier, L. Théry (INRIA-Lemme project) 
-C. Alvarado, P. Crégut, J.-F. Monin (France Telecom R&D)
-P. Castéran (Université Bordeaux 1)
+
+  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 (Radbout University, Nijmegen, The Netherlands),
+  Laboratoire J.-A. Dieudonné (University of Nice-Sophia Antipolis).
 
 The following people have contributed to the development of different versions 
 of the Coq Proof assistant during the indicated time :
 
-	Bruno Barras (INRIA, 1995-now)
-	Jacek Chrzaszcz (Paris Sud, 1998-2003)
-	Thierry Coquand (INRIA, 1985-1989)
-	Cristina Cornes (INRIA, 1993-1996)
-	Yann Coscoy (INRIA Sophia-Antipolis, 1995-1996)
-	David Delahaye (INRIA, 1997-2002)
-	Daniel de Rauglaudre (INRIA, 1996-1998)
-	Olivier Desmettre (INRIA, 2001-2003)
-	Gilles Dowek (INRIA, 1991-1994)
-	Amy Felty (INRIA, 1993)
-	Jean-Christophe Filliâtre (ENS Lyon, 1994-1997, Paris Sud, 1997-now)
-	Eduardo Giménez (ENS Lyon, 1993-1996, INRIA, 1997-1998)
-	Hugo Herbelin (INRIA, 1996-now)
-	Gérard Huet (INRIA, 1985-1997)
-	Pierre Letouzey (LRI, 2000-now)
-	Pascal Manoury (INRIA, 1993)
-	Micaela Mayero (INRIA, 1997-2002)
-	Claude Marché (Paris Sud & INRIA, 2003-now)
-	César Muñoz (INRIA, 1994-1995)
-	Chetan Murthy (INRIA, 1992-1994)
-	Catherine Parent-Vigouroux (ENS Lyon, 1992-1995)
-	Patrick Loiseleur (Paris Sud, 1997-1999)
-	Christine Paulin-Mohring (INRIA, 1985-1989, ENS Lyon, 1989-1997, 
-				  Paris Sud, 1997-now)
-	Clément Renard (INRIA, 2001-now)
-	Amokrane Saïbi (INRIA, 1993-1998)
-	Benjamin Werner (INRIA, 1989-1994)
-
+  Bruno Barras (INRIA, 1995-now)
+  Jacek Chrzaszcz (LRI, 1998-2003)
+  Thierry Coquand (INRIA, 1985-1989)
+  Cristina Cornes (INRIA, 1993-1996)
+  Yann Coscoy (INRIA Sophia-Antipolis, 1995-1996)
+  David Delahaye (INRIA, 1997-2002)
+  Daniel de Rauglaudre (INRIA, 1996-1998)
+  Olivier Desmettre (INRIA, 2001-2003)
+  Gilles Dowek (INRIA, 1991-1994)
+  Amy Felty (INRIA, 1993)
+  Jean-Christophe Filliâtre (ENS Lyon, 1994-1997, LRI, 1997-now)
+  Eduardo Giménez (ENS Lyon, 1993-1996, INRIA, 1997-1998)
+  Benjamin Grégoire (INRIA, 2003-now)
+  Hugo Herbelin (INRIA, 1996-now)
+  Gérard Huet (INRIA, 1985-1997)
+  Pierre Letouzey (LRI, 2000-2005 & PPS-Paris 7, 2005-now)
+  Pascal Manoury (INRIA, 1993)
+  Micaela Mayero (INRIA, 1997-2002)
+  Claude Marché (INRIA 2003-2004 & LRI, 2004-now)
+  Benjamin Monate (LRI, 2003)
+  César Muñoz (INRIA, 1994-1995)
+  Chetan Murthy (INRIA, 1992-1994)
+  Julien Narboux (INRIA, 2005-2006)
+  Jean-Marc Notin (CNRS, 2006)
+  Catherine Parent-Vigouroux (ENS Lyon, 1992-1995)
+  Patrick Loiseleur (Paris Sud, 1997-1999)
+  Christine Paulin-Mohring (INRIA, 1985-1989, ENS Lyon, 1989-1997, 
+                            LRI, 1997-now)
+  Clément Renard (INRIA, 2001-2004)
+  Claudio Sacerdoti Coen (INRIA, 2004-2005)
+  Amokrane Saïbi (INRIA, 1993-1998)
+  Benjamin Werner (INRIA, 1989-1994)
 
 ***************************************************************************
 INRIA refers to :
-	Institut National de la Recherche en Informatique et Automatique
+  Institut National de la Recherche en Informatique et Automatique
 CNRS refers to :
-	Centre National de la Recherche Scientifique
-Paris Sud refers to :
-	Université Paris Sud
+  Centre National de la Recherche Scientifique
+LRI refers to : Laboratoire de Recherche en Informatique, UMR 8623 
+  CNRS and Université Paris-Sud
 ENS Lyon refers to :
-	Ecole Normale Supérieure de Lyon
+  Ecole Normale Supérieure de Lyon
 ****************************************************************************
diff --git a/Coq.bat b/Coq.bat
new file mode 100755
index 00000000..cdd7d50d
--- /dev/null
+++ b/Coq.bat
@@ -0,0 +1,8 @@
+@echo off
+set COQBIN=%~0\..\bin
+set COQLIB=%~0\..\lib
+echo Using COQBIN= %COQBIN%
+echo and   COQLIB= %COQLIB%
+echo Starting Coq
+%~0\..\bin\coqtop.opt.exe
+pause
\ No newline at end of file
diff --git a/Coqide.bat b/Coqide.bat
new file mode 100755
index 00000000..f955a970
--- /dev/null
+++ b/Coqide.bat
@@ -0,0 +1,7 @@
+@echo off
+set COQBIN=%~0\..\bin
+set COQLIB=%~0\..\lib
+echo Using COQBIN= %COQBIN%
+echo and   COQLIB= %COQLIB%
+echo Starting Coqide
+%~0\..\bin\coqide.opt.exe
\ No newline at end of file
diff --git a/INSTALL b/INSTALL
index ccfc65e0..56c03e2e 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,12 +1,12 @@
 
-            INSTALLATION PROCEDURES FOR THE COQ V8.0 SYSTEM
+            INSTALLATION PROCEDURES FOR THE COQ V8.1 SYSTEM
             -----------------------------------------------
 
 WHAT DO YOU NEED ?
 ==================
 
    Coq is designed to work on computers equipped with the Unix operating 
-   system. In order to compile Coq V8.0 you need:
+   system. In order to compile Coq V8.1 you need:
 
      - Objective Caml version 3.06 or later
        (available at http://caml.inria.fr/)
diff --git a/INSTALL.ide b/INSTALL.ide
index 1c1d40c8..d8f1208b 100644
--- a/INSTALL.ide
+++ b/INSTALL.ide
@@ -35,7 +35,7 @@ INSTALLATION
 
  1) You need to install the OCaml stub library lablgtk2. See 
        	http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html
-    The first official release of lablgtk2 is here:
+    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.
     If you are in a hurry just run :
diff --git a/INSTALL.macosx b/INSTALL.macosx
index b756bdb7..ac9c3e05 100644
--- a/INSTALL.macosx
+++ b/INSTALL.macosx
@@ -1,4 +1,4 @@
-INSTALLATION PROCEDURE FOR THE COQ V8.0 SYSTEM UNDER MACOS X
+INSTALLATION PROCEDURE FOR THE COQ V8.1 SYSTEM UNDER MACOS X
 ------------------------------------------------------------
 
 1) Download archive coq-8.0-macosx.dmg.
diff --git a/INSTALL.win b/INSTALL.win
new file mode 100644
index 00000000..f2cddb8a
--- /dev/null
+++ b/INSTALL.win
@@ -0,0 +1,63 @@
+*****************************************************************
+* INSTALLATION PROCEDURE FOR THE COQ V8 SYSTEM UNDER WINDOWS OS *
+*****************************************************************
+
+    The binary distribution consists in a .zip archive file. This .zip contains
+long filenames and cannot therefore be unpacked with pkunzip version 2. Use
+either Winzip (shareware) or the Windows version of unzip (freeware):
+
+    http://www.winzip.com/
+    http://www.winimage.com/zLibDll/
+
+    Unzipping the distribution creates (among others) the following directories
+and files:
+
+    coq\bin\		The command-line tools
+    coq\lib\		The standard library files
+    coq\emacs		A Coq mode for your Emacs
+    coq\man\man1	The man pages for the command-line tools
+
+    There are two cases to consider :
+
+1. You unzip in the root of your drive (say C):
+===============================================
+
+    Hence Coq will be installed in C:\coq
+
+    You must add the C:\coq\bin path to your environment variable PATH. This is
+done by adding the following line to your AUTOEXEC.BAT:
+
+	set PATH=%PATH%;C:\coq\bin
+
+    You may also want to specify where Coq has to look for your configuration
+file .coqrc (not mandatory), e.g.:
+
+	set HOME=C:\My_Documents\Coq
+
+2. You unzip in some other place (say D:\My_Dir):
+=================================================
+
+    You must add the D:\My_Dir\coq\bin path to your environment variable PATH.
+This is done by adding the following line to AUTOEXEC.BAT:
+
+	set PATH=%PATH%;D:\My_Dir\coq\bin
+
+    You must also set the environment variables COQBIN and COQLIB to tell Coq
+that binaries and libraries are not in the default place. This is done by
+adding the following lines to your AUTOEXEC.BAT:
+
+	set COQBIN=D:\My_Dir\coq\bin
+	set COQLIB=D:\My_Dir\coq\lib
+
+    You may also want to specify where Coq has to look for your configuration
+file .coqrc (not mandatory), e.g.:
+
+	set HOME=C:\My_Documents\Coq
+
+PROBLEMS:
+=========
+
+    If you have any trouble with this installation, please contact:
+coq-bugs@pauillac.inria.fr.
+
+    The Coq Team.
diff --git a/LICENSE b/LICENSE
index b1e3f5a2..27950e8d 100644
--- a/LICENSE
+++ b/LICENSE
@@ -55,7 +55,7 @@ modified by someone else and passed on, the recipients should know
 that what they have is not the original version, so that the original
 author's reputation will not be affected by problems that might be
 introduced by others.
-
+
   Finally, software patents pose a constant threat to the existence of
 any free program.  We wish to make sure that a company cannot
 effectively restrict the users of a free program by obtaining a
@@ -111,7 +111,7 @@ modification follow.  Pay close attention to the difference between a
 "work based on the library" and a "work that uses the library".  The
 former contains code derived from the library, whereas the latter must
 be combined with the library in order to run.
-
+
 		  GNU LESSER GENERAL PUBLIC LICENSE
    TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
 
@@ -158,7 +158,7 @@ Library.
   You may charge a fee for the physical act of transferring a copy,
 and you may at your option offer warranty protection in exchange for a
 fee.
-
+
   2. You may modify your copy or copies of the Library or any portion
 of it, thus forming a work based on the Library, and copy and
 distribute such modifications or work under the terms of Section 1
@@ -216,7 +216,7 @@ instead of to this License.  (If a newer version than version 2 of the
 ordinary GNU General Public License has appeared, then you can specify
 that version instead if you wish.)  Do not make any other change in
 these notices.
-
+
   Once this change is made in a given copy, it is irreversible for
 that copy, so the ordinary GNU General Public License applies to all
 subsequent copies and derivative works made from that copy.
@@ -267,7 +267,7 @@ Library will still fall under Section 6.)
 distribute the object code for the work under the terms of Section 6.
 Any executables containing that work also fall under Section 6,
 whether or not they are linked directly with the Library itself.
-
+
   6. As an exception to the Sections above, you may also combine or
 link a "work that uses the Library" with the Library to produce a
 work containing portions of the Library, and distribute that work
@@ -329,7 +329,7 @@ restrictions of other proprietary libraries that do not normally
 accompany the operating system.  Such a contradiction means you cannot
 use both them and the Library together in an executable that you
 distribute.
-
+
   7. You may place library facilities that are a work based on the
 Library side-by-side in a single library together with other library
 facilities not covered by this License, and distribute such a combined
@@ -370,7 +370,7 @@ subject to these terms and conditions.  You may not impose any further
 restrictions on the recipients' exercise of the rights granted herein.
 You are not responsible for enforcing compliance by third parties with
 this License.
-
+
   11. If, as a consequence of a court judgment or allegation of patent
 infringement or for any other reason (not limited to patent issues),
 conditions are imposed on you (whether by court order, agreement or
@@ -422,7 +422,7 @@ conditions either of that version or of any later version published by
 the Free Software Foundation.  If the Library does not specify a
 license version number, you may choose any version ever published by
 the Free Software Foundation.
-
+
   14. If you wish to incorporate parts of the Library into other free
 programs whose distribution conditions are incompatible with these,
 write to the author to ask for permission.  For software which is
@@ -456,49 +456,3 @@ SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
 DAMAGES.
 
 		     END OF TERMS AND CONDITIONS
-
-           How to Apply These Terms to Your New Libraries
-
-  If you develop a new library, and you want it to be of the greatest
-possible use to the public, we recommend making it free software that
-everyone can redistribute and change.  You can do so by permitting
-redistribution under these terms (or, alternatively, under the terms of the
-ordinary General Public License).
-
-  To apply these terms, attach the following notices to the library.  It is
-safest to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least the
-"copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the library's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
-
-    This library is free software; you can redistribute it and/or
-    modify it under the terms of the GNU Lesser General Public
-    License as published by the Free Software Foundation; either
-    version 2.1 of the License, or (at your option) any later version.
-
-    This library is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-    Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public
-    License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-
-Also add information on how to contact you by electronic and paper mail.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the library, if
-necessary.  Here is a sample; alter the names:
-
-  Yoyodyne, Inc., hereby disclaims all copyright interest in the
-  library `Frob' (a library for tweaking knobs) written by James Random Hacker.
-
-  <signature of Ty Coon>, 1 April 1990
-  Ty Coon, President of Vice
-
-That's all there is to it!
-
-
diff --git a/Makefile b/Makefile
index fcd6c782..4523b02a 100644
--- a/Makefile
+++ b/Makefile
@@ -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        #
-########################################################################
+#######################################################################
+#  v      #   The Coq Proof Assistant  /  The Coq Development Team    #
+# <O___,, #        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              #
+#   \VV/  #############################################################
+#    //   #      This file is distributed under the terms of the      #
+#         #       GNU Lesser General Public License Version 2.1       #
+#######################################################################
 
-# $Id: Makefile,v 1.459.2.22 2006/01/11 23:18:05 barras Exp $ 
+# $Id: Makefile 8688 2006-04-07 15:08:12Z msozeau $ 
 
 
 # Makefile for Coq
@@ -26,7 +26,7 @@
 
 include config/Makefile
 
-noargument:
+NOARG:
 	@echo "Please use either"
 	@echo "   ./configure"
 	@echo "   make world"
@@ -38,12 +38,8 @@ noargument:
 
 # build and install the three subsystems: coq, coqide, pcoq
 world: coq coqide pcoq
-world8: coq8 coqide pcoq
-world7: coq7 coqide pcoq
 
 install: install-coq install-coqide install-pcoq
-install8: install-coq8 install-coqide install-pcoq
-install7: install-coq7 install-coqide install-pcoq
 #install-manpages: install-coq-manpages install-pcoq-manpages
 
 ###########################################################################
@@ -63,42 +59,47 @@ else
 endif
 
 LOCALINCLUDES=-I config -I tools -I tools/coqdoc \
-	      -I scripts -I lib -I kernel -I library \
+	      -I scripts -I lib -I kernel -I kernel/byterun -I library \
               -I proofs -I tactics -I pretyping \
-              -I interp -I toplevel -I parsing -I ide/utils \
-	      -I ide -I translate \
+              -I interp -I toplevel -I parsing -I ide/utils -I ide \
               -I contrib/omega -I contrib/romega \
-	      -I contrib/ring -I contrib/xml \
-	      -I contrib/extraction \
+	      -I contrib/ring -I contrib/dp -I contrib/setoid_ring \
+              -I contrib/xml -I contrib/extraction \
               -I contrib/interface -I contrib/fourier \
 	      -I contrib/jprover -I contrib/cc \
 	      -I contrib/funind -I contrib/first-order \
-              -I contrib/field
+              -I contrib/field -I contrib/subtac -I contrib/rtauto \
+              -I contrib/recdef
 
 MLINCLUDES=$(LOCALINCLUDES) -I $(MYCAMLP4LIB)
 
 BYTEFLAGS=$(MLINCLUDES) $(CAMLDEBUG)
-OPTFLAGS=$(MLINCLUDES) $(CAMLTIMEPROF)
+OPTFLAGS=$(MLINCLUDES) $(CAMLTIMEPROF) -noassert
 OCAMLDEP=ocamldep
-DEPFLAGS=-slash $(LOCALINCLUDES)
+DEPFLAGS=$(LOCALINCLUDES)
 
 OCAMLC_P4O=$(OCAMLC) -pp $(CAMLP4O) $(BYTEFLAGS)
 OCAMLOPT_P4O=$(OCAMLOPT) -pp $(CAMLP4O) $(OPTFLAGS)
-CAMLP4EXTENDFLAGS=-I . pa_extend.cmo pa_extend_m.cmo pa_ifdef.cmo q_MLast.cmo 
+CAMLP4EXTENDFLAGS=-I . pa_extend.cmo pa_extend_m.cmo q_MLast.cmo
 CAMLP4DEPS=sed -n -e 's|^(\*.*camlp4deps: "\(.*\)".*\*)$$|\1|p'
 
 COQINCLUDES=          # coqtop includes itself the needed paths
 GLOB=           # is "-dump-glob file" when making the doc
 COQ_XML=	# is "-xml" when building XML library
-COQOPTS=$(GLOB) $(COQ_XML)
-TRANSLATE=-translate -strict-implicit
+VM=          # is "-no-vm" to not use the vm"
+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=$(BESTCOQTOP) -boot $(COQOPTS)
 
 ###########################################################################
 # Objects files 
 ###########################################################################
 
+LIBCOQRUN=kernel/byterun/libcoqrun.a
+
 CLIBS=unix.cma
 
 CAMLP4OBJS=gramlib.cma
@@ -107,20 +108,28 @@ CONFIG=\
   config/coq_config.cmo
 
 LIBREP=\
-  lib/pp_control.cmo lib/pp.cmo lib/compat.cmo lib/util.cmo lib/bignat.cmo \
+  lib/pp_control.cmo lib/pp.cmo lib/compat.cmo lib/util.cmo lib/bigint.cmo \
   lib/hashcons.cmo lib/dyn.cmo lib/system.cmo lib/options.cmo \
   lib/bstack.cmo lib/edit.cmo lib/gset.cmo lib/gmap.cmo \
   lib/tlm.cmo lib/gmapl.cmo lib/profile.cmo lib/explore.cmo \
   lib/predicate.cmo lib/rtree.cmo lib/heap.cmo
 # Rem: Cygwin already uses variable LIB 
 
+BYTERUN=\
+  kernel/byterun/coq_fix_code.o kernel/byterun/coq_memory.o \
+  kernel/byterun/coq_values.o kernel/byterun/coq_interp.o 
+
 KERNEL=\
   kernel/names.cmo kernel/univ.cmo \
-  kernel/esubst.cmo kernel/term.cmo kernel/sign.cmo \
-  kernel/declarations.cmo kernel/environ.cmo kernel/closure.cmo \
-  kernel/conv_oracle.cmo kernel/reduction.cmo kernel/entries.cmo \
-  kernel/modops.cmo \
-  kernel/type_errors.cmo kernel/inductive.cmo kernel/typeops.cmo \
+  kernel/esubst.cmo kernel/term.cmo kernel/mod_subst.cmo kernel/sign.cmo \
+  kernel/cbytecodes.cmo kernel/copcodes.cmo \
+  kernel/cemitcodes.cmo kernel/vm.cmo \
+  kernel/declarations.cmo kernel/pre_env.cmo \
+  kernel/cbytegen.cmo  kernel/environ.cmo  \
+  kernel/csymtable.cmo kernel/conv_oracle.cmo \
+  kernel/closure.cmo kernel/reduction.cmo kernel/type_errors.cmo \
+  kernel/entries.cmo kernel/modops.cmo \
+  kernel/inductive.cmo kernel/vconv.cmo kernel/typeops.cmo \
   kernel/indtypes.cmo kernel/cooking.cmo kernel/term_typing.cmo \
   kernel/subtyping.cmo kernel/mod_typing.cmo kernel/safe_typing.cmo
 
@@ -128,85 +137,78 @@ LIBRARY=\
   library/nameops.cmo library/libnames.cmo library/libobject.cmo \
   library/summary.cmo library/nametab.cmo library/global.cmo library/lib.cmo \
   library/declaremods.cmo library/library.cmo library/states.cmo \
-  library/decl_kinds.cmo library/dischargedhypsmap.cmo library/goptions.cmo 
+  library/decl_kinds.cmo library/dischargedhypsmap.cmo library/goptions.cmo
 
 PRETYPING=\
-  pretyping/termops.cmo pretyping/evd.cmo pretyping/instantiate.cmo \
+  pretyping/termops.cmo pretyping/evd.cmo \
   pretyping/reductionops.cmo pretyping/inductiveops.cmo \
-  pretyping/rawterm.cmo pretyping/pattern.cmo \
-  pretyping/detyping.cmo pretyping/retyping.cmo \
-  pretyping/cbv.cmo pretyping/pretype_errors.cmo pretyping/typing.cmo \
+  pretyping/retyping.cmo pretyping/cbv.cmo \
+  pretyping/pretype_errors.cmo pretyping/recordops.cmo pretyping/typing.cmo \
   pretyping/tacred.cmo \
-  pretyping/classops.cmo pretyping/recordops.cmo pretyping/indrec.cmo \
-  pretyping/evarutil.cmo pretyping/evarconv.cmo \
-  pretyping/coercion.cmo pretyping/cases.cmo pretyping/pretyping.cmo \
-  pretyping/matching.cmo
+  pretyping/evarutil.cmo pretyping/unification.cmo pretyping/evarconv.cmo \
+  pretyping/classops.cmo pretyping/coercion.cmo pretyping/clenv.cmo \
+  pretyping/rawterm.cmo pretyping/pattern.cmo \
+  pretyping/detyping.cmo  pretyping/indrec.cmo\
+  pretyping/cases.cmo pretyping/pretyping.cmo pretyping/matching.cmo
 
 INTERP=\
-  parsing/lexer.cmo interp/topconstr.cmo interp/ppextend.cmo interp/symbols.cmo \
+  parsing/lexer.cmo interp/topconstr.cmo interp/ppextend.cmo \
+  interp/notation.cmo \
   interp/genarg.cmo interp/syntax_def.cmo interp/reserve.cmo \
   library/impargs.cmo interp/constrintern.cmo \
   interp/modintern.cmo interp/constrextern.cmo interp/coqlib.cmo \
-  library/declare.cmo
-
-PARSING=\
-  parsing/coqast.cmo parsing/ast.cmo \
-  parsing/termast.cmo parsing/extend.cmo parsing/esyntax.cmo \
-  parsing/pcoq.cmo parsing/egrammar.cmo \
-  parsing/ppconstr.cmo translate/ppconstrnew.cmo parsing/printer.cmo \
-  parsing/pptactic.cmo translate/pptacticnew.cmo \
-  parsing/printmod.cmo parsing/prettyp.cmo parsing/search.cmo
-
-HIGHPARSING=\
-  parsing/g_prim.cmo parsing/g_proofs.cmo parsing/g_basevernac.cmo \
-  parsing/g_vernac.cmo parsing/g_tactic.cmo \
-  parsing/g_ltac.cmo parsing/g_constr.cmo parsing/g_cases.cmo \
-  parsing/g_module.cmo \
-  parsing/g_natsyntax.cmo parsing/g_zsyntax.cmo parsing/g_rsyntax.cmo
-
-HIGHPARSINGNEW=\
-  parsing/g_primnew.cmo parsing/g_constrnew.cmo parsing/g_tacticnew.cmo \
-  parsing/g_ltacnew.cmo parsing/g_vernacnew.cmo parsing/g_proofsnew.cmo
-
-ARITHSYNTAX=\
-  parsing/g_natsyntax.cmo parsing/g_zsyntax.cmo parsing/g_rsyntax.cmo
+  toplevel/discharge.cmo library/declare.cmo
 
 PROOFS=\
-  proofs/tacexpr.cmo proofs/proof_type.cmo \
+  proofs/tacexpr.cmo proofs/proof_type.cmo proofs/redexpr.cmo \
   proofs/proof_trees.cmo proofs/logic.cmo \
   proofs/refiner.cmo proofs/evar_refiner.cmo proofs/tacmach.cmo \
-  proofs/clenv.cmo proofs/pfedit.cmo proofs/tactic_debug.cmo
+  proofs/pfedit.cmo proofs/tactic_debug.cmo \
+  proofs/clenvtac.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/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
 
 TACTICS=\
   tactics/dn.cmo tactics/termdn.cmo tactics/btermdn.cmo \
   tactics/nbtermdn.cmo tactics/tacticals.cmo \
   tactics/hipattern.cmo tactics/tactics.cmo \
+  tactics/evar_tactics.cmo \
   tactics/hiddentac.cmo tactics/elim.cmo \
   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/tacinterp.cmo tactics/autorewrite.cmo
 
 TOPLEVEL=\
   toplevel/himsg.cmo toplevel/cerrors.cmo toplevel/class.cmo \
   toplevel/vernacexpr.cmo  toplevel/metasyntax.cmo \
-  toplevel/command.cmo \
-  toplevel/record.cmo toplevel/recordobj.cmo \
-  toplevel/discharge.cmo translate/ppvernacnew.cmo \
+  toplevel/command.cmo toplevel/record.cmo \
+  parsing/ppvernac.cmo \
   toplevel/vernacinterp.cmo toplevel/mltop.cmo \
-  toplevel/vernacentries.cmo toplevel/vernac.cmo \
+  toplevel/vernacentries.cmo toplevel/whelp.cmo toplevel/vernac.cmo \
   toplevel/line_oriented_parser.cmo toplevel/protectedtoplevel.cmo \
   toplevel/toplevel.cmo toplevel/usage.cmo \
   toplevel/coqinit.cmo toplevel/coqtop.cmo
 
 HIGHTACTICS=\
-  tactics/autorewrite.cmo tactics/refine.cmo \
-  tactics/extraargs.cmo tactics/extratactics.cmo tactics/eauto.cmo
+  tactics/refine.cmo tactics/extraargs.cmo \
+  tactics/extratactics.cmo tactics/eauto.cmo
 
 SPECTAC= tactics/tauto.ml4 tactics/eqdecide.ml4
 USERTAC = $(SPECTAC)
 ML4FILES += $(USERTAC) tactics/extraargs.ml4 tactics/extratactics.ml4 \
-	tactics/eauto.ml4 
+	tactics/eauto.ml4 toplevel/whelp.ml4 tactics/hipattern.ml4
 
 USERTACCMO=$(USERTAC:.ml4=.cmo)
 USERTACCMX=$(USERTAC:.ml4=.cmx)
@@ -214,7 +216,8 @@ USERTACCMX=$(USERTAC:.ml4=.cmx)
 ML4FILES +=\
   contrib/omega/g_omega.ml4 \
   contrib/romega/g_romega.ml4 contrib/ring/g_quote.ml4 \
-  contrib/ring/g_ring.ml4 \
+  contrib/ring/g_ring.ml4 contrib/dp/g_dp.ml4 \
+  contrib/setoid_ring/newring.ml4 \
   contrib/field/field.ml4 contrib/fourier/g_fourier.ml4 \
   contrib/extraction/g_extraction.ml4 contrib/xml/xmlentries.ml4
 
@@ -223,13 +226,20 @@ OMEGACMO=\
   contrib/omega/g_omega.cmo 
 
 ROMEGACMO=\
-  contrib/romega/omega2.cmo contrib/romega/const_omega.cmo \
+  contrib/romega/const_omega.cmo \
   contrib/romega/refl_omega.cmo contrib/romega/g_romega.cmo
 
 RINGCMO=\
   contrib/ring/quote.cmo contrib/ring/g_quote.cmo \
   contrib/ring/ring.cmo contrib/ring/g_ring.cmo 
 
+NEWRINGCMO=\
+  contrib/setoid_ring/newring.cmo
+
+DPCMO=contrib/dp/dp_why.cmo contrib/dp/dp.cmo contrib/dp/g_dp.cmo
+#  contrib/dp/dp_simplify.cmo contrib/dp/dp_zenon.cmo contrib/dp/dp_cvcl.cmo \
+#  contrib/dp/dp_sorts.cmo 
+
 FIELDCMO=\
   contrib/field/field.cmo 
 
@@ -239,7 +249,7 @@ XMLCMO=\
   contrib/xml/cic2acic.cmo contrib/xml/acic2Xml.cmo \
   contrib/xml/proof2aproof.cmo \
   contrib/xml/xmlcommand.cmo contrib/xml/proofTree2Xml.cmo \
-	contrib/xml/xmlentries.cmo 	
+  contrib/xml/xmlentries.cmo 	contrib/xml/cic2Xml.cmo
 
 FOURIERCMO=\
   contrib/fourier/fourier.cmo contrib/fourier/fourierR.cmo \
@@ -264,7 +274,14 @@ JPROVERCMO=\
   contrib/jprover/jprover.cmo
 
 FUNINDCMO=\
-  contrib/funind/tacinvutils.cmo contrib/funind/tacinv.cmo 
+  contrib/funind/tacinvutils.cmo contrib/funind/tacinv.cmo \
+  contrib/funind/indfun_common.cmo contrib/funind/rawtermops.cmo \
+  contrib/funind/rawterm_to_relation.cmo contrib/funind/new_arg_principle.cmo \
+  contrib/funind/invfun.cmo contrib/funind/indfun.cmo \
+  contrib/funind/indfun_main.cmo
+
+RECDEFCMO=\
+  contrib/recdef/recdef.cmo
 
 FOCMO=\
   contrib/first-order/formula.cmo contrib/first-order/unify.cmo \
@@ -272,28 +289,91 @@ FOCMO=\
   contrib/first-order/instances.cmo contrib/first-order/ground.cmo \
   contrib/first-order/g_ground.cmo
 
-CCCMO=contrib/cc/ccalgo.cmo contrib/cc/ccproof.cmo contrib/cc/cctac.cmo  
+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.cmo \
+	contrib/subtac/subtac_interp_fixpoint.cmo \
+	contrib/subtac/subtac_command.cmo \
+	contrib/subtac/subtac.cmo \
+	contrib/subtac/g_subtac.cmo
+
 
-ML4FILES += contrib/jprover/jprover.ml4 contrib/cc/cctac.ml4 \
-  contrib/funind/tacinv.ml4 contrib/first-order/g_ground.ml4
+RTAUTOCMO=contrib/rtauto/proof_search.cmo contrib/rtauto/refl_tauto.cmo \
+	contrib/rtauto/g_rtauto.cmo
 
-CONTRIB=$(OMEGACMO) $(ROMEGACMO) $(RINGCMO) $(FIELDCMO) \
+ML4FILES += contrib/jprover/jprover.ml4 contrib/cc/g_congruence.ml4 \
+	contrib/funind/tacinv.ml4 contrib/first-order/g_ground.ml4 \
+	contrib/subtac/g_subtac.ml4 contrib/subtac/g_eterm.ml4 \
+	contrib/rtauto/g_rtauto.ml4 contrib/recdef/recdef.ml4 \
+	contrib/funind/indfun_main.ml4 
+
+
+CONTRIB=$(OMEGACMO) $(ROMEGACMO) $(RINGCMO) $(DPCMO) $(FIELDCMO) \
 	$(FOURIERCMO) $(EXTRACTIONCMO) $(JPROVERCMO) $(XMLCMO) \
-	$(CCCMO) $(FUNINDCMO) $(FOCMO)
+	$(CCCMO)  $(FOCMO) $(SUBTACCMO) $(RTAUTOCMO) \
+        $(RECDEFCMO) $(FUNINDCMO) $(NEWRINGCMO)
 
 CMA=$(CLIBS) $(CAMLP4OBJS)
 CMXA=$(CMA:.cma=.cmxa)
 
-# Beware that highparsingnew.cma should appear before hightactics.cma
+# LINK ORDER:
+# Beware that highparsing.cma should appear before hightactics.cma
 # respecting this order is useful for developers that want to load or link
 # the libraries directly
-CMO=$(CONFIG) lib/lib.cma kernel/kernel.cma library/library.cma \
-    pretyping/pretyping.cma interp/interp.cma parsing/parsing.cma \
-    proofs/proofs.cma tactics/tactics.cma toplevel/toplevel.cma \
-    parsing/highparsing.cma parsing/highparsingnew.cma tactics/hightactics.cma \
-    contrib/contrib.cma
-CMOCMXA=$(CMO:.cma=.cmxa)
-CMX=$(CMOCMXA:.cmo=.cmx)
+LINKCMO=$(CONFIG) lib/lib.cma kernel/kernel.cma library/library.cma \
+        pretyping/pretyping.cma interp/interp.cma proofs/proofs.cma \
+        parsing/parsing.cma tactics/tactics.cma toplevel/toplevel.cma \
+        parsing/highparsing.cma tactics/hightactics.cma contrib/contrib.cma
+LINKCMOCMXA=$(LINKCMO:.cma=.cmxa)
+LINKCMX=$(LINKCMOCMXA:.cmo=.cmx)
+
+# objects known by the toplevel of Coq
+OBJSCMO=$(CONFIG) $(LIBREP) $(KERNEL) $(LIBRARY) $(PRETYPING) $(INTERP) \
+        $(PROOFS) $(PARSING) $(TACTICS) $(TOPLEVEL) $(HIGHPARSING) \
+        $(HIGHTACTICS) $(USERTACMO) $(CONTRIB)
+
+###########################################################################
+# Compilation option for .c files 
+###########################################################################
+
+CINCLUDES= -I $(CAMLHLIB)
+CC=gcc
+AR=ar
+RANLIB=ranlib
+BYTECCCOMPOPTS=-fno-defer-pop -Wall -Wno-unused
+
+# libcoqrun.a 
+
+$(LIBCOQRUN): kernel/byterun/coq_jumptbl.h $(BYTERUN) 
+	$(AR) rc $(LIBCOQRUN) $(BYTERUN) 
+	$(RANLIB) $(LIBCOQRUN)
+
+#coq_jumptbl.h is required only if you have GCC 2.0 or later
+kernel/byterun/coq_jumptbl.h : kernel/byterun/coq_instruct.h
+	sed -n -e '/^  /s/ \([A-Z]\)/ \&\&coq_lbl_\1/gp' \
+               -e '/^}/q' kernel/byterun/coq_instruct.h > \
+                          kernel/byterun/coq_jumptbl.h
+
+
+kernel/copcodes.ml: kernel/byterun/coq_instruct.h
+	sed -n -e '/^enum/p' -e 's/,//g' -e '/^  /p' \
+	kernel/byterun/coq_instruct.h | \
+	awk -f kernel/make-opcodes > kernel/copcodes.ml
+
+bytecompfile : kernel/byterun/coq_jumptbl.h kernel/copcodes.ml
+
+beforedepend:: bytecompfile
+
+clean ::
+	rm -f kernel/byterun/coq_jumptbl.h kernel/copcodes.ml
 
 ###########################################################################
 # Main targets (coqmktop, coqtop.opt, coqtop.byte)
@@ -310,26 +390,20 @@ COQBINARIES= $(COQMKTOP) $(COQC) $(COQTOPBYTE) $(BESTCOQTOP) $(COQTOP)
 
 coqbinaries:: ${COQBINARIES}
 
-coq: coqlib tools coqbinaries coqlib7
-coq8: coqlib tools coqbinaries
-coq7: coqlib7 tools coqbinaries
-
-coqlib:: newtheories newcontrib
+coq: coqlib tools coqbinaries
 
-coqlib7: theories7 contrib7
+coqlib:: theories contrib
 
 coqlight: theories-light tools coqbinaries
 
-states7:: states7/initial.coq
-
 states:: states/initial.coq
 
-$(COQTOPOPT): $(COQMKTOP) $(CMX) $(USERTACCMX)
+$(COQTOPOPT): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) $(USERTACCMX)
 	$(SHOW)'COQMKTOP -o $@'	
 	$(HIDE)$(COQMKTOP) -opt $(OPTFLAGS) -o $@
 	$(STRIP) $@
 
-$(COQTOPBYTE): $(COQMKTOP) $(CMO) $(USERTACCMO)
+$(COQTOPBYTE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) $(USERTACCMO)
 	$(SHOW)'COQMKTOP -o $@'	
 	$(HIDE)$(COQMKTOP) -top $(BYTEFLAGS) -o $@
 
@@ -345,21 +419,12 @@ $(COQMKTOP): $(COQMKTOPCMO)
 	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom str.cma unix.cma \
           $(COQMKTOPCMO) $(OSDEPLIBS)
 
+
 scripts/tolink.ml: Makefile
 	$(SHOW)"ECHO... >" $@
-	$(HIDE)echo "let lib = \""$(LIBREP)"\"" > $@
-	$(HIDE)echo "let kernel = \""$(KERNEL)"\"" >> $@
-	$(HIDE)echo "let library = \""$(LIBRARY)"\"" >> $@
-	$(HIDE)echo "let pretyping = \""$(PRETYPING)"\"" >> $@
-	$(HIDE)echo "let proofs = \""$(PROOFS)"\"" >> $@
-	$(HIDE)echo "let tactics = \""$(TACTICS)"\"" >> $@
-	$(HIDE)echo "let interp = \""$(INTERP)"\"" >> $@
-	$(HIDE)echo "let parsing = \""$(PARSING)"\"" >> $@
-	$(HIDE)echo "let toplevel = \""$(TOPLEVEL)"\"" >> $@
-	$(HIDE)echo "let highparsing = \""$(HIGHPARSING)"\"" >> $@
-	$(HIDE)echo "let highparsingnew = \""$(HIGHPARSINGNEW)"\"" >> $@
-	$(HIDE)echo "let hightactics = \""$(HIGHTACTICS)" "$(USERTACCMO)"\"" >> $@
-	$(HIDE)echo "let contrib = \""$(CONTRIB)"\"" >> $@
+	$(HIDE)echo "let copts = \"-cclib -lcoqrun\"" > $@
+	$(HIDE)echo "let core_libs = \""$(LINKCMO)"\"" >> $@
+	$(HIDE)echo "let core_objs = \""$(OBJSCMO)"\"" >> $@
 	$(HIDE)echo "let ide = \""$(COQIDECMO)"\"" >> $@
 
 beforedepend:: scripts/tolink.ml
@@ -375,10 +440,15 @@ $(COQC): $(COQCCMO) $(COQTOPBYTE) $(BESTCOQTOP)
 clean::
 	rm -f scripts/tolink.ml
 
+archclean::
+	rm -f $(COQTOPBYTE) $(COQTOPOPT) $(BESTCOQTOP) $(COQC) $(COQMKTOP)
+	rm -f $(COQTOP)
+
 # we provide targets for each subdirectory
 
 lib: $(LIBREP)
 kernel: $(KERNEL)
+byterun: $(BYTERUN)
 library: $(LIBRARY)
 proofs: $(PROOFS)
 tactics: $(TACTICS)
@@ -386,7 +456,6 @@ interp: $(INTERP)
 parsing: $(PARSING)
 pretyping: $(PRETYPING)
 highparsing: $(HIGHPARSING)
-highparsingnew: $(HIGHPARSINGNEW)
 toplevel: $(TOPLEVEL)
 hightactics: $(HIGHTACTICS)
 
@@ -489,14 +558,6 @@ contrib/contrib.cmxa: $(CONTRIB:.cmo=.cmx)
 	$(SHOW)'OCAMLOPT -a -o $@'
 	$(HIDE)$(OCAMLOPT) $(OPTFLAGS) -a -o $@ $(CONTRIB:.cmo=.cmx)
 
-parsing/highparsingnew.cma: $(HIGHPARSINGNEW)
-	$(SHOW)'OCAMLC -a -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -a -o $@ $(HIGHPARSINGNEW)
-
-parsing/highparsingnew.cmxa: $(HIGHPARSINGNEW:.cmo=.cmx)
-	$(SHOW)'OCAMLOPT -a -o $@'
-	$(HIDE)$(OCAMLOPT) $(OPTFLAGS) -a -o $@ $(HIGHPARSINGNEW:.cmo=.cmx)
-
 ###########################################################################
 # CoqIde special targets
 ###########################################################################
@@ -508,7 +569,7 @@ COQIDEBYTE=bin/coqide.byte$(EXE)
 COQIDEOPT=bin/coqide.opt$(EXE)
 COQIDE=bin/coqide$(EXE)
 
-COQIDECMO=ide/utils/okey.cmo ide/utils/uoptions.cmo \
+COQIDECMO=ide/utils/okey.cmo ide/utils/config_file.cmo \
 	  ide/utils/configwin_keys.cmo ide/utils/configwin_types.cmo \
 	  ide/utils/configwin_messages.cmo ide/utils/configwin_ihm.cmo \
 	  ide/utils/configwin.cmo \
@@ -530,7 +591,7 @@ COQIDEVO=ide/utf8.vo
 $(COQIDEVO): states/initial.coq 
 	$(BOOTCOQTOP) -compile $*
 
-IDEFILES=$(COQIDEVO) ide/utf8.v ide/coq.ico ide/coq2.ico ide/.coqide-gtk2rc
+IDEFILES=$(COQIDEVO) ide/utf8.v ide/coq.png ide/.coqide-gtk2rc
 
 coqide-binaries: coqide-$(HASCOQIDE)
 coqide-no:
@@ -544,47 +605,42 @@ clean-ide:
 	rm -f ide/config_lexer.ml ide/config_parser.mli ide/config_parser.ml
 	rm -f ide/utf8_convert.ml
 
-$(COQIDEOPT): $(COQMKTOP) $(CMX) $(USERTACCMX) ide/ide.cmxa
+$(COQIDEOPT): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) $(USERTACCMX) ide/ide.cmxa
 	$(SHOW)'COQMKTOP -o $@'	
 	$(HIDE)$(COQMKTOP) -ide -opt $(OPTFLAGS) -o $@
 	$(STRIP) $@
 
-$(COQIDEBYTE): $(COQMKTOP) $(CMO) $(USERTACCMO) ide/ide.cma
+$(COQIDEBYTE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) $(USERTACCMO) ide/ide.cma
 	$(SHOW)'COQMKTOP -o $@'	
-	$(HIDE)$(COQMKTOP) -ide -top $(BYTEFLAGS) -o $@
+	$(HIDE)$(COQMKTOP) -g -ide -top $(BYTEFLAGS) -o $@
 
 $(COQIDE):
 	cd bin; ln -sf coqide.$(HASCOQIDE)$(EXE) coqide$(EXE)
 
 ide/%.cmo: ide/%.ml
 	$(SHOW)'OCAMLC    $<'	
-	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
+	$(HIDE)$(OCAMLC) -g $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
 
 ide/%.cmi: ide/%.mli
 	$(SHOW)'OCAMLC    $<'	
-	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
+	$(HIDE)$(OCAMLC) -g $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
 
 ide/%.cmx: ide/%.ml
 	$(SHOW)'OCAMLOPT  $<'	
 	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) -c $<
 
-ide/utils/%.cmo: ide/utils/%.ml
+ide/utils/%.cmo: ide/%.ml
 	$(SHOW)'OCAMLC    $<'	
-	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
+	$(HIDE)$(OCAMLC) -g $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
 
-ide/utils/%.cmi: ide/utils/%.mli
+ide/utils/%.cmi: ide/%.mli
 	$(SHOW)'OCAMLC    $<'	
-	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
+	$(HIDE)$(OCAMLC) -g $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
 
-ide/utils/%.cmx: ide/utils/%.ml
+ide/utils/%.cmx: ide/%.ml
 	$(SHOW)'OCAMLOPT  $<'	
 	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) -c $<
 
-# Special target to select between whether lablgtk >= 2.6.0 or not
-ide/undo.cmi: ide/undo.mli
-	$(SHOW)'OCAMLC    $<'	
-	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) $(CAMLP4COMPAT) -intf" -c -intf $<
-
 clean::
 	rm -f ide/extract_index.ml ide/find_phrase.ml ide/highlight.ml
 	rm -f ide/config_lexer.ml ide/config_parser.mli ide/config_parser.ml
@@ -642,12 +698,13 @@ INTERFACE=\
   contrib/interface/name_to_ast.cmo contrib/interface/debug_tac.cmo \
   contrib/interface/showproof_ct.cmo contrib/interface/showproof.cmo \
   contrib/interface/blast.cmo contrib/interface/centaur.cmo
+
 INTERFACECMX=$(INTERFACE:.cmo=.cmx)
 
 ML4FILES += contrib/interface/debug_tac.ml4 contrib/interface/centaur.ml4
 
-PARSERREQUIRES=$(CMO) # Solution de facilité...
-PARSERREQUIRESCMX=$(CMX)
+PARSERREQUIRES=$(LINKCMO) $(LIBCOQRUN) # Solution de facilité...
+PARSERREQUIRESCMX=$(LINKCMX)
 
 ifeq ($(BEST),opt)
   COQINTERFACE=bin/coq-interface$(EXE) bin/coq-interface.opt$(EXE) bin/parser$(EXE) bin/parser.opt$(EXE)
@@ -657,11 +714,11 @@ endif
 
 pcoq-binaries:: $(COQINTERFACE) 
 
-bin/coq-interface$(EXE): $(COQMKTOP) $(CMO) $(USERTACCMO) $(INTERFACE)
+bin/coq-interface$(EXE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) $(USERTACCMO) $(INTERFACE)
 	$(SHOW)'COQMKTOP -o $@'
 	$(HIDE)$(COQMKTOP) -top $(BYTEFLAGS) -o $@ $(INTERFACE)
 
-bin/coq-interface.opt$(EXE): $(COQMKTOP) $(CMX) $(USERTACCMX) $(INTERFACECMX)
+bin/coq-interface.opt$(EXE): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) $(USERTACCMX) $(INTERFACECMX)
 	$(SHOW)'COQMKTOP -o $@'
 	$(HIDE)$(COQMKTOP) -opt $(OPTFLAGS) -o $@ $(INTERFACECMX)
 
@@ -672,13 +729,13 @@ PARSERCMX= $(PARSERREQUIRESCMX) $(PARSERCODE:.cmo=.cmx)
 
 bin/parser$(EXE): $(PARSERCMO)
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) -linkall -custom -cclib -lunix $(OPTFLAGS) -o $@ \
+	$(HIDE)$(OCAMLC) -linkall -custom -cclib -lunix $(BYTEFLAGS) -o $@ \
 	  dynlink.cma $(CMA) $(PARSERCMO)
 
 bin/parser.opt$(EXE): $(PARSERCMX)
 	$(SHOW)'OCAMLOPT -o $@'
 	$(HIDE)$(OCAMLOPT) -linkall -cclib -lunix $(OPTFLAGS) -o $@ \
-	  $(CMXA) $(PARSERCMX)
+	  $(LIBCOQRUN) $(CMXA) $(PARSERCMX)
 
 INTERFACEVO=
 
@@ -686,14 +743,8 @@ INTERFACERC= contrib/interface/vernacrc
 
 pcoq-files:: $(INTERFACEVO) $(INTERFACERC)
 
-# Centaur grammar rules now in centaur.ml4
-contrib7/interface/Centaur.vo: contrib7/interface/Centaur.v $(INTERFACE)
-	$(BESTCOQTOP) $(TRANSLATE) -boot -byte $(COQOPTS) -compile $*
-
-# Move the grammar rules to dad.ml ?
-contrib7/interface/AddDad.vo: contrib7/interface/AddDad.v $(INTERFACE) states7/initial.coq
-	$(BESTCOQTOP) $(TRANSLATE) -boot -byte  $(COQOPTS) -compile $*
-
+clean::
+	rm -f bin/parser$(EXE) bin/parser.opt$(EXE) bin/coq-interface$(EXE) bin/coq-interface.opt$(EXE)
 
 # install targets
 install-pcoq:: install-pcoq-binaries install-pcoq-files install-pcoq-manpages
@@ -730,7 +781,7 @@ INITVO=\
  theories/Init/Datatypes.vo         theories/Init/Peano.vo     \
  theories/Init/Logic.vo             theories/Init/Specif.vo    \
  theories/Init/Logic_Type.vo        theories/Init/Wf.vo      \
- theories/Init/Prelude.vo
+ theories/Init/Tactics.vo           theories/Init/Prelude.vo
 
 init: $(INITVO)
 
@@ -743,7 +794,8 @@ LOGICVO=\
  theories/Logic/Berardi.vo       	theories/Logic/Eqdep_dec.vo \
  theories/Logic/Decidable.vo            theories/Logic/JMeq.vo \
  theories/Logic/ClassicalDescription.vo theories/Logic/ClassicalChoice.vo \
- theories/Logic/RelationalChoice.vo     theories/Logic/Diaconescu.vo
+ theories/Logic/RelationalChoice.vo     theories/Logic/Diaconescu.vo \
+ theories/Logic/EqdepFacts.vo           theories/Logic/ProofIrrelevanceFacts.vo
 
 ARITHVO=\
  theories/Arith/Arith.vo        theories/Arith/Gt.vo          \
@@ -778,7 +830,8 @@ ZARITHVO=\
  theories/ZArith/auxiliary.vo   theories/ZArith/Zmisc.vo \
  theories/ZArith/Zcompare.vo    theories/ZArith/Znat.vo \
  theories/ZArith/Zorder.vo      theories/ZArith/Zabs.vo \
- theories/ZArith/Zmin.vo        theories/ZArith/Zeven.vo \
+ theories/ZArith/Zmin.vo        theories/ZArith/Zmax.vo \
+ theories/ZArith/Zminmax.vo     theories/ZArith/Zeven.vo \
  theories/ZArith/Zhints.vo	theories/ZArith/Zlogarithm.vo \
  theories/ZArith/Zpower.vo 	theories/ZArith/Zcomplements.vo \
  theories/ZArith/Zdiv.vo	theories/ZArith/Zsqrt.vo \
@@ -789,7 +842,11 @@ ZARITHVO=\
 LISTSVO=\
  theories/Lists/MonoList.vo \
  theories/Lists/ListSet.vo   	theories/Lists/Streams.vo \
- theories/Lists/TheoryList.vo   theories/Lists/List.vo
+ theories/Lists/TheoryList.vo   theories/Lists/List.vo \
+ theories/Lists/SetoidList.vo
+
+STRINGSVO=\
+ theories/Strings/Ascii.vo      theories/Strings/String.vo
 
 SETSVO=\
  theories/Sets/Classical_sets.vo    theories/Sets/Permut.vo \
@@ -804,6 +861,19 @@ SETSVO=\
  theories/Sets/Multiset.vo          theories/Sets/Relations_3_facts.vo \
  theories/Sets/Partial_Order.vo     theories/Sets/Uniset.vo
 
+FSETSVO=\
+ theories/FSets/DecidableType.vo     theories/FSets/OrderedType.vo \
+ theories/FSets/FSetInterface.vo     theories/FSets/FSetList.vo \
+ theories/FSets/FSetBridge.vo        theories/FSets/FSetFacts.vo \
+ theories/FSets/FSetProperties.vo    theories/FSets/FSetEqProperties.vo \
+ theories/FSets/FSets.vo \
+ theories/FSets/FSetWeakInterface.vo theories/FSets/FSetWeakList.vo \
+ theories/FSets/FSetWeakFacts.vo     theories/FSets/FSetWeak.vo \
+ theories/FSets/FMapInterface.vo     theories/FSets/FMapList.vo \
+ theories/FSets/FMaps.vo \
+ theories/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakList.vo \
+ theories/FSets/FMapWeak.vo
+
 INTMAPVO=\
  theories/IntMap/Adalloc.vo    theories/IntMap/Mapcanon.vo \
  theories/IntMap/Addec.vo      theories/IntMap/Mapcard.vo \
@@ -870,28 +940,28 @@ REALS_all=\
 REALSVO=$(REALSBASEVO) $(REALS_$(REALS))
 
 ALLREALS=$(REALSBASEVO) $(REALS_all)
-ALLOLDREALS=$(REALSBASEVO:theories%.vo:theories7%.vo) $(REALS_all:theories%.vo:theories7%.vo)
 
 SETOIDSVO=theories/Setoids/Setoid.vo
 
 THEORIESVO =\
   $(INITVO) $(LOGICVO) $(ARITHVO) $(BOOLVO) $(NARITHVO) $(ZARITHVO) \
-  $(LISTSVO) $(SETSVO) $(INTMAPVO) $(RELATIONSVO) $(WELLFOUNDEDVO) \
-  $(REALSVO) $(SETOIDSVO) $(SORTINGVO)
+  $(LISTSVO) $(STRINGSVO) $(SETSVO) $(FSETSVO) $(INTMAPVO) $(RELATIONSVO) \
+  $(WELLFOUNDEDVO) $(REALSVO) $(SETOIDSVO) $(SORTINGVO)
 
-NEWTHEORIESLIGHTVO = $(INITVO) $(LOGICVO) $(ARITHVO)
-OLDTHEORIESLIGHTVO = $(NEWTHEORIESLIGHTVO:theories%.vo:theories7%.vo)
+THEORIESLIGHTVO = $(INITVO) $(LOGICVO) $(ARITHVO)
 
 theories: $(THEORIESVO)
-theories-light: $(NEWTHEORIESLIGHTVO)
+theories-light: $(THEORIESLIGHTVO)
 
 logic: $(LOGICVO)
 arith: $(ARITHVO)
 bool: $(BOOLVO)
 narith: $(NARITHVO)
 zarith: $(ZARITHVO)
-lists: $(LISTVO) $(LISTSVO)
+lists: $(LISTSVO)
+strings: $(STRINGSVO)
 sets: $(SETSVO)
+fsets: $(FSETSVO)
 intmap: $(INTMAPVO)
 relations: $(RELATIONSVO)
 wellfounded: $(WELLFOUNDEDVO)
@@ -901,7 +971,7 @@ allreals: $(ALLREALS)
 setoids: $(SETOIDSVO)
 sorting: $(SORTINGVO)
 
-noreal: logic arith bool zarith lists sets intmap relations wellfounded \
+noreal: logic arith bool zarith lists sets fsets intmap relations wellfounded \
 	setoids sorting
 
 ###########################################################################
@@ -922,6 +992,11 @@ RINGVO=\
  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
+
 FIELDVO=\
  contrib/field/Field_Compl.vo     contrib/field/Field_Theory.vo \
  contrib/field/Field_Tactic.vo    contrib/field/Field.vo
@@ -933,19 +1008,28 @@ FOURIERVO=\
 
 FUNINDVO= 
 
+RECDEFVO=contrib/recdef/Recdef.vo
+
 JPROVERVO= 
 
-CCVO=\
- contrib/cc/CCSolve.vo
+CCVO=
+
+SUBTACVO=contrib/subtac/FixSub.vo contrib/subtac/Utils.vo
+
+RTAUTOVO = \
+ contrib/rtauto/Bintree.vo contrib/rtauto/Rtauto.vo
 
 CONTRIBVO = $(OMEGAVO) $(ROMEGAVO) $(RINGVO) $(FIELDVO) $(XMLVO) \
-	    $(FOURIERVO) $(JPROVERVO) $(CCVO) $(FUNINDVO)
+	    $(FOURIERVO) $(JPROVERVO) $(CCVO) $(FUNINDVO) $(SUBTACVO) \
+	    $(RTAUTOVO) $(RECDEFVO) $(NEWRINGVO)
 
 $(CONTRIBVO): states/initial.coq
 
 contrib: $(CONTRIBVO) $(CONTRIBCMO)
 omega: $(OMEGAVO) $(OMEGACMO) $(ROMEGAVO) $(ROMEGACMO)
 ring: $(RINGVO) $(RINGCMO)
+setoid_ring: $(NEWRINGVO) $(NEWRINGCMO)
+dp: $(DPCMO)
 xml: $(XMLVO) $(XMLCMO)
 extraction: $(EXTRACTIONCMO)
 field: $(FIELDVO) $(FIELDCMO)
@@ -953,40 +1037,10 @@ fourier: $(FOURIERVO) $(FOURIERCMO)
 jprover: $(JPROVERVO) $(JPROVERCMO)
 funind: $(FUNINDCMO) $(FUNINDVO)
 cc: $(CCVO) $(CCCMO)
+subtac: $(SUBTACVO) $(SUBTACCMO)
+rtauto: $(RTAUTOVO) $(RTAUTOCMO)
 
-NEWINITVO=$(INITVO)
-NEWTHEORIESVO=$(THEORIESVO)
-NEWCONTRIBVO=$(CONTRIBVO)
-
-OBSOLETETHEORIESVO=\
- theories7/Lists/PolyList.vo theories7/Lists/PolyListSyntax.vo \
- theories7/ZArith/Zsyntax.vo \
- theories7/ZArith/zarith_aux.vo	theories7/ZArith/fast_integer.vo \
- theories7/Reals/Rsyntax.vo
-
-OLDINITVO=$(INITVO:theories%.vo=theories7%.vo)
-OLDTHEORIESVO=$(THEORIESVO:theories%.vo=theories7%.vo) $(OBSOLETETHEORIESVO)
-OLDCONTRIBVO=$(CONTRIBVO:contrib%.vo=contrib7%.vo)
-
-$(OLDCONTRIBVO): states7/initial.coq
-
-NEWINITV=$(INITVO:%.vo=%.v)
-NEWTHEORIESV=$(THEORIESVO:%.vo=%.v)
-NEWCONTRIBV=$(CONTRIBVO:%.vo=%.v)
-
-# Made *.vo and new*.v targets explicit, otherwise "make" 
-# either removes them after use or don't do them (e.g. List.vo)
-newinit:: $(NEWINITV) $(NEWINITVO)
-newtheories:: $(NEWTHEORIESV) $(NEWTHEORIESVO)
-newcontrib:: $(NEWCONTRIBV) $(NEWCONTRIBVO) $(CONTRIBCMO)
-
-theories7:: $(OLDTHEORIESVO)
-contrib7:: $(OLDCONTRIBVO) 
-
-translation:: $(NEWTHEORIESV) $(NEWCONTRIBV)
-
-ALLNEWVO = $(INITVO) $(THEORIESVO) $(CONTRIBVO)
-ALLOLDVO = $(OLDINITVO) $(OLDTHEORIESVO) $(OLDCONTRIBVO)
+ALLVO = $(INITVO) $(THEORIESVO) $(CONTRIBVO)
 
 ###########################################################################
 # rules to make theories, contrib and states
@@ -994,23 +1048,8 @@ ALLOLDVO = $(OLDINITVO) $(OLDTHEORIESVO) $(OLDCONTRIBVO)
 
 SYNTAXPP=syntax/PPConstr.v syntax/PPCases.v
 
-states7/barestate.coq: $(SYNTAXPP) $(BESTCOQTOP)
-	$(BESTCOQTOP) -v7 -boot -batch -silent -nois -I syntax -load-vernac-source syntax/MakeBare.v -outputstate $@
-
-states7/initial.coq: states7/barestate.coq states7/MakeInitial.v $(OLDINITVO) $(BESTCOQTOP)
-	$(BOOTCOQTOP) -v7 -batch -silent -is states7/barestate.coq -load-vernac-source states7/MakeInitial.v -outputstate states7/initial.coq
-
-states/initial.coq: states/MakeInitial.v $(NEWINITVO)
-	$(BOOTCOQTOP) -batch -silent -nois -load-vernac-source states/MakeInitial.v -outputstate states/initial.coq
-
-theories7/Init/%.vo: $(BESTCOQTOP) theories7/Init/%.v
-	$(BOOTCOQTOP) $(TRANSLATE) -nois -compile theories7/Init/$*
-
-theories7/%.vo: theories7/%.v states7/initial.coq
-	$(BOOTCOQTOP) $(TRANSLATE) -compile theories7/$*
-
-contrib7/%.vo: contrib7/%.v states7/initial.coq
-	$(BOOTCOQTOP) $(TRANSLATE) -compile contrib7/$*
+states/initial.coq: states/MakeInitial.v $(INITVO)
+	$(BOOTCOQTOP) -batch -notop -silent -nois -load-vernac-source states/MakeInitial.v -outputstate states/initial.coq
 
 theories/Init/%.vo: $(BESTCOQTOP) theories/Init/%.v
 	$(BOOTCOQTOP) -nois -compile theories/Init/$*
@@ -1024,13 +1063,14 @@ contrib/%.vo: contrib/%.v
 contrib/extraction/%.vo: contrib/extraction/%.v states/barestate.coq $(COQC)
 	$(BOOTCOQTOP) -is states/barestate.coq -compile $*
 
-contrib7/extraction/%.vo: contrib7/extraction/%.v states/barestate.coq $(COQC)
-	$(BOOTCOQTOP) $(TRANSLATE) -is states7/barestate.coq -compile $*
+cleantheories:
+	rm -f states/*.coq
+	rm -f theories/*/*.vo
+
+clean :: cleantheories
 
-clean::
-	rm -f states/*.coq states7/*.coq
-	rm -f theories/*/*.vo theories7/*/*.vo
-	rm -f contrib/*/*.cm[io] contrib/*.cma contrib/*/*.vo contrib7/*/*.vo 
+clean :: 
+	rm -f contrib/*/*.cm[io] contrib/*.cma contrib/*/*.vo
 
 archclean::
 	rm -f contrib/*/*.cmx contrib/*.cmxa contrib/*.a contrib/*/*.[so]
@@ -1056,7 +1096,11 @@ COQDOC=bin/coqdoc$(EXE)
 TOOLS=$(COQDEP) $(COQMAKEFILE) $(GALLINA) $(COQTEX) \
       $(COQWC) $(COQDOC)
 
-tools:: $(TOOLS) dev/top_printers.cmo
+DEBUGPRINTERS=dev/top_printers.cmo dev/vm_printers.cmo dev/printers.cma
+
+printers: $(DEBUGPRINTERS)
+
+tools:: $(TOOLS) $(DEBUGPRINTERS)
 
 COQDEPCMO=config/coq_config.cmo tools/coqdep_lexer.cmo tools/coqdep.cmo
 
@@ -1090,9 +1134,9 @@ $(COQWC): tools/coqwc.cmo
 
 beforedepend:: tools/coqdoc/pretty.ml tools/coqdoc/index.ml
 
-COQDOCCMO=$(CONFIG) tools/coqdoc/alpha.cmo tools/coqdoc/index.cmo \
-          tools/coqdoc/output.cmo tools/coqdoc/pretty.cmo \
-	  tools/coqdoc/main.cmo
+COQDOCCMO=$(CONFIG) tools/coqdoc/cdglobals.cmo tools/coqdoc/alpha.cmo \
+	tools/coqdoc/index.cmo tools/coqdoc/output.cmo \
+	tools/coqdoc/pretty.cmo tools/coqdoc/main.cmo
 
 $(COQDOC): $(COQDOCCMO)
 	$(SHOW)'OCAMLC -o $@'
@@ -1103,6 +1147,9 @@ clean::
 	rm -f tools/coqwc.ml
 	rm -f tools/coqdoc/pretty.ml tools/coqdoc/index.ml
 
+archclean::
+	rm -f $(TOOLS)
+
 ###########################################################################
 # minicoq
 ###########################################################################
@@ -1117,23 +1164,24 @@ $(MINICOQ): $(MINICOQCMO)
 	$(SHOW)'OCAMLC -o $@'
 	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom $(CMA) $(MINICOQCMO) $(OSDEPLIBS)
 
+archclean::
+	rm -f $(MINICOQ)
+
 ###########################################################################
 # Installation
 ###########################################################################
 
-#COQINSTALLPREFIX=
-# Can be changed for a local installation (to make packages).
-# You must NOT put a "/" at the end (Cygnus for win32 does not like "//").
+COQINSTALLPREFIX=
+  # Can be changed for a local installation (to make packages).
+  # You must NOT put a "/" at the end (Cygnus for win32 does not like "//").
 
-FULLBINDIR=$(BINDIR:'$(OLDROOT)%='$(COQINSTALLPREFIX)%)
-FULLCOQLIB=$(COQLIB:'$(OLDROOT)%='$(COQINSTALLPREFIX)%)
-FULLMANDIR=$(MANDIR:'$(OLDROOT)%='$(COQINSTALLPREFIX)%)
-FULLEMACSLIB=$(EMACSLIB:'$(OLDROOT)%='$(COQINSTALLPREFIX)%)
-FULLCOQDOCDIR=$(COQDOCDIR:'$(OLDROOT)%='$(COQINSTALLPREFIX)%)
+FULLBINDIR=$(COQINSTALLPREFIX)$(BINDIR)
+FULLCOQLIB=$(COQINSTALLPREFIX)$(COQLIB)
+FULLMANDIR=$(COQINSTALLPREFIX)$(MANDIR)
+FULLEMACSLIB=$(COQINSTALLPREFIX)$(EMACSLIB)
+FULLCOQDOCDIR=$(COQINSTALLPREFIX)$(COQDOCDIR)
 
 install-coq: install-binaries install-library install-coq-info
-install-coq8: install-binaries install-library8 install-coq-info
-install-coq7: install-binaries install-library7 install-coq-info
 install-coqlight: install-binaries install-library-light
 
 install-binaries:: install-$(BEST) install-tools
@@ -1152,42 +1200,27 @@ install-tools::
 	$(MKDIR) $(FULLBINDIR)
 	cp $(TOOLS) $(FULLBINDIR)
 
-LIBFILES=$(OLDTHEORIESVO) $(OLDCONTRIBVO)
-LIBFILESLIGHT=$(OLDTHEORIESLIGHTVO)
+LIBFILES=$(THEORIESVO) $(CONTRIBVO)
+LIBFILESLIGHT=$(THEORIESLIGHTVO)
 
-NEWLIBFILES=$(NEWTHEORIESVO) $(NEWCONTRIBVO)
-NEWLIBFILESLIGHT=$(NEWTHEORIESLIGHTVO)
-
-install-library: install-library7 install-library8
-
-install-library8:
+install-library:
 	$(MKDIR) $(FULLCOQLIB)
-	for f in $(NEWLIBFILES); do \
+	for f in $(LIBFILES); do \
 	  $(MKDIR) $(FULLCOQLIB)/`dirname $$f`; \
 	  cp $$f $(FULLCOQLIB)/`dirname $$f`; \
         done
 	$(MKDIR) $(FULLCOQLIB)/states
 	cp states/*.coq $(FULLCOQLIB)/states
-
-install-library7:
-	$(MKDIR) $(FULLCOQLIB)
-	for f in $(LIBFILES); do \
-	  $(MKDIR) $(FULLCOQLIB)/`dirname $$f`; \
-	  cp $$f $(FULLCOQLIB)/`dirname $$f`; \
-        done
-	$(MKDIR) $(FULLCOQLIB)/states7
-	cp states7/*.coq $(FULLCOQLIB)/states7
+	$(MKDIR) $(FULLCOQLIB)/user-contrib
 
 install-library-light:
 	$(MKDIR) $(FULLCOQLIB)
-	for f in $(LIBFILESLIGHT) $(NEWLIBFILESLIGHT); do \
+	for f in $(LIBFILESLIGHT); do \
 	  $(MKDIR) $(FULLCOQLIB)/`dirname $$f`; \
 	  cp $$f $(FULLCOQLIB)/`dirname $$f`; \
         done
 	$(MKDIR) $(FULLCOQLIB)/states
 	cp states/*.coq $(FULLCOQLIB)/states
-	$(MKDIR) $(FULLCOQLIB)/states7
-	cp states7/*.coq $(FULLCOQLIB)/states7
 
 install-allreals::
 	for f in $(ALLREALS); do \
@@ -1215,7 +1248,7 @@ install-emacs:
 
 install-latex:
 	$(MKDIR) $(FULLCOQDOCDIR)
-	cp tools/coqdoc/coqdoc.sty $(FULLCOQDOCDIR)
+	cp tools/coqdoc/coqdoc.sty $(FULLCOQDOCDIR)	
 #	-$(UPDATETEX)
 
 ###########################################################################
@@ -1223,19 +1256,25 @@ install-latex:
 # Literate programming (with ocamlweb)
 ###########################################################################
 
-.PHONY: doc
+.PHONY: doc devdoc
 
-doc: doc/coq.tex
-	$(MAKE) -C doc coq.ps minicoq.dvi
+doc: glob.dump
+	(cd doc; make all)
 
-doc/coq.tex:
+clean::
+	(cd doc; make clean)
+
+devdoc: dev/doc/coq.tex
+	$(MAKE) -C dev/doc coq.ps minicoq.dvi
+
+dev/doc/coq.tex:
 	ocamlweb -p "\usepackage{epsfig}" \
-	doc/macros.tex doc/intro.tex \
+	dev/doc/macros.tex dev/doc/intro.tex \
 	lib/{doc.tex,*.mli} kernel/{doc.tex,*.mli} library/{doc.tex,*.mli} \
 	pretyping/{doc.tex,*.mli} interp/{doc.tex,*.mli} \
-	parsing/{doc.tex,*.mli} proofs/{doc.tex,tacexpr.ml,*.mli} \
-	tactics/{doc.tex,*.mli} toplevel/{doc.tex,vernacexpr.ml,*.mli} \
-	-o doc/coq.tex
+	parsing/{doc.tex,*.mli} proofs/{doc.tex,*.mli} \
+	tactics/{doc.tex,*.mli} toplevel/{doc.tex,*.mli} \
+	-o dev/doc/coq.tex
 
 clean::
 	rm -f doc/coq.tex
@@ -1277,60 +1316,116 @@ otags:
 
 # grammar modules with camlp4
 
-ML4FILES += parsing/lexer.ml4 parsing/q_util.ml4 parsing/q_coqast.ml4 \
-            parsing/g_prim.ml4 parsing/pcoq.ml4
+ML4FILES += parsing/lexer.ml4 parsing/pcoq.ml4 parsing/q_util.ml4 \
+  parsing/q_coqast.ml4 parsing/g_prim.ml4 
 
 GRAMMARNEEDEDCMO=\
-  lib/pp_control.cmo lib/pp.cmo lib/compat.cmo lib/util.cmo lib/bignat.cmo \
-  lib/dyn.cmo lib/options.cmo \
-  lib/hashcons.cmo lib/predicate.cmo lib/rtree.cmo \
-  kernel/names.cmo kernel/univ.cmo kernel/esubst.cmo kernel/term.cmo \
-  kernel/sign.cmo kernel/declarations.cmo kernel/environ.cmo\
+  lib/pp_control.cmo lib/pp.cmo lib/compat.cmo lib/util.cmo lib/bigint.cmo \
+  lib/dyn.cmo lib/options.cmo lib/hashcons.cmo lib/predicate.cmo \
+  lib/rtree.cmo \
+  kernel/names.cmo kernel/univ.cmo \
+  kernel/esubst.cmo kernel/term.cmo kernel/mod_subst.cmo kernel/sign.cmo \
+  kernel/cbytecodes.cmo kernel/copcodes.cmo kernel/cemitcodes.cmo \
+  kernel/declarations.cmo kernel/pre_env.cmo \
+  kernel/cbytegen.cmo kernel/conv_oracle.cmo kernel/environ.cmo \
+  kernel/closure.cmo kernel/reduction.cmo kernel/type_errors.cmo\
+  kernel/entries.cmo \
+  kernel/modops.cmo \
+  kernel/inductive.cmo kernel/typeops.cmo \
+  kernel/indtypes.cmo kernel/cooking.cmo kernel/term_typing.cmo \
+  kernel/subtyping.cmo kernel/mod_typing.cmo kernel/safe_typing.cmo \
   library/nameops.cmo library/libnames.cmo library/summary.cmo \
   library/nametab.cmo library/libobject.cmo library/lib.cmo \
-  library/goptions.cmo library/decl_kinds.cmo \
-  pretyping/rawterm.cmo pretyping/pattern.cmo pretyping/evd.cmo \
-  interp/topconstr.cmo interp/genarg.cmo \
-  interp/ppextend.cmo parsing/coqast.cmo parsing/ast.cmo \
-  proofs/tacexpr.cmo parsing/ast.cmo \
-  parsing/lexer.cmo parsing/q_util.cmo parsing/extend.cmo \
-  toplevel/vernacexpr.cmo parsing/pcoq.cmo parsing/q_coqast.cmo \
-  parsing/egrammar.cmo
+  library/goptions.cmo library/decl_kinds.cmo library/global.cmo \
+  pretyping/termops.cmo pretyping/evd.cmo pretyping/reductionops.cmo \
+  pretyping/inductiveops.cmo pretyping/rawterm.cmo pretyping/detyping.cmo \
+  pretyping/pattern.cmo \
+  interp/topconstr.cmo interp/genarg.cmo interp/ppextend.cmo \
+  proofs/tacexpr.cmo \
+  parsing/lexer.cmo parsing/extend.cmo \
+  toplevel/vernacexpr.cmo parsing/pcoq.cmo parsing/q_util.cmo \
+  parsing/q_coqast.cmo
 
 CAMLP4EXTENSIONSCMO=\
   parsing/argextend.cmo parsing/tacextend.cmo parsing/vernacextend.cmo 
 
 GRAMMARSCMO=\
   parsing/g_prim.cmo parsing/g_tactic.cmo \
-  parsing/g_ltac.cmo parsing/g_constr.cmo \
-  parsing/g_primnew.cmo parsing/g_tacticnew.cmo \
-  parsing/g_ltacnew.cmo parsing/g_constrnew.cmo 
+  parsing/g_ltac.cmo parsing/g_constr.cmo
 
 GRAMMARCMO=$(GRAMMARNEEDEDCMO) $(CAMLP4EXTENSIONSCMO) $(GRAMMARSCMO)
 
+PRINTERSCMO=\
+  config/coq_config.cmo lib/lib.cma \
+  kernel/names.cmo kernel/univ.cmo kernel/esubst.cmo kernel/term.cmo	\
+  kernel/mod_subst.cmo kernel/copcodes.cmo kernel/cemitcodes.cmo	\
+  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/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	\
+  library/lib.cmo library/goptions.cmo \
+  pretyping/termops.cmo pretyping/evd.cmo				    \
+  pretyping/rawterm.cmo pretyping/termops.cmo pretyping/evd.cmo		    \
+  pretyping/reductionops.cmo pretyping/inductiveops.cmo			    \
+  pretyping/retyping.cmo pretyping/cbv.cmo				    \
+  pretyping/pretype_errors.cmo pretyping/recordops.cmo pretyping/typing.cmo \
+  pretyping/evarutil.cmo pretyping/unification.cmo pretyping/evarconv.cmo   \
+  pretyping/tacred.cmo pretyping/classops.cmo pretyping/detyping.cmo	    \
+  pretyping/indrec.cmo pretyping/coercion.cmo pretyping/cases.cmo	    \
+  pretyping/pretyping.cmo pretyping/clenv.cmo pretyping/pattern.cmo \
+  parsing/lexer.cmo interp/ppextend.cmo interp/genarg.cmo \
+  interp/topconstr.cmo interp/notation.cmo interp/reserve.cmo		\
+  library/impargs.cmo\
+  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	\
+  parsing/ppconstr.cmo parsing/extend.cmo \
+  parsing/printer.cmo parsing/pptactic.cmo parsing/tactic_printer.cmo \
+  parsing/pcoq.cmo parsing/egrammar.cmo toplevel/himsg.cmo \
+  toplevel/cerrors.cmo toplevel/vernacexpr.cmo toplevel/vernacinterp.cmo \
+  dev/top_printers.cmo
+
+dev/printers.cma: $(PRINTERSCMO)
+	$(SHOW)'Testing $@'
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) gramlib.cma $(PRINTERSCMO) -o test-printer
+	@rm -f test-printer
+	$(SHOW)'OCAMLC -a $@'   
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) $(PRINTERSCMO) -linkall -a -o $@
+
 parsing/grammar.cma: $(GRAMMARCMO)
+	$(SHOW)'Testing $@'
+	@touch test.ml4
+	$(HIDE)$(OCAMLOPT) $(OPTFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) $(GRAMMARCMO) -impl" -impl test.ml4 -o test-grammar
+	@rm -f test-grammar test.*
 	$(SHOW)'OCAMLC -a $@'   
 	$(HIDE)$(OCAMLC) $(BYTEFLAGS) $(GRAMMARCMO) -linkall -a -o $@
 
 clean::
 	rm -f parsing/grammar.cma
 
-ML4FILES +=parsing/g_basevernac.ml4 parsing/g_minicoq.ml4 \
+ML4FILES +=parsing/g_minicoq.ml4 \
 	   parsing/g_vernac.ml4 parsing/g_proofs.ml4 \
-	   parsing/g_cases.ml4 \
-	   parsing/g_constr.ml4 parsing/g_module.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/g_primnew.ml4 \
-           parsing/g_vernacnew.ml4 parsing/g_proofsnew.ml4 \
-	   parsing/g_constrnew.ml4 \
-	   parsing/g_tacticnew.ml4 parsing/g_ltacnew.ml4 \
+	   parsing/vernacextend.ml4 parsing/q_constr.ml4
 
 # beforedepend:: $(GRAMMARCMO)
 
 # beforedepend:: parsing/pcoq.ml parsing/extend.ml
 
+# File using pa_ifdef and only necessary for parsing ml files
+
+parsing/q_coqast.cmo: parsing/q_coqast.ml4
+	$(SHOW)'OCAMLC4  $<' 
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pa_ifdef.cmo $(CAMLP4COMPAT) -impl" -c -impl $<
+
 # toplevel/mltop.ml4 (ifdef Byte)
 
 toplevel/mltop.cmo: toplevel/mltop.byteml
@@ -1343,11 +1438,11 @@ toplevel/mltop.cmx: toplevel/mltop.optml
 
 toplevel/mltop.byteml: toplevel/mltop.ml4
 	$(SHOW)'CAMLP4O   $<'	
-	$(HIDE)$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pr_o.cmo -DByte -impl $< > $@ || rm -f $@
+	$(HIDE)$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pa_ifdef.cmo pr_o.cmo -DByte -impl $< > $@ || rm -f $@
 
 toplevel/mltop.optml: toplevel/mltop.ml4
 	$(SHOW)'CAMLP4O   $<'	
-	$(HIDE)$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pr_o.cmo -impl $< > $@ || rm -f $@
+	$(HIDE)$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pa_ifdef.cmo pr_o.cmo -impl $< > $@ || rm -f $@
 
 ML4FILES += toplevel/mltop.ml4
 
@@ -1380,21 +1475,27 @@ proofs/tacexpr.cmx: proofs/tacexpr.ml
 	$(SHOW)'OCAMLOPT  -rectypes $<'
 	$(HIDE)$(OCAMLOPT) -rectypes $(OPTFLAGS) -c $<
 
-# files compiled with camlp4 because of macros
+parsing/pptactic.cmo: parsing/pptactic.ml
+	$(SHOW)'OCAMLC    -rectypes $<'
+	$(HIDE)$(OCAMLC) -rectypes $(BYTEFLAGS) -c $<
+
+parsing/pptactic.cmx: parsing/pptactic.ml
+	$(SHOW)'OCAMLOPT    -rectypes $<'
+	$(HIDE)$(OCAMLOPT) -rectypes $(OPTFLAGS) -c $<
+
+ML4FILES += lib/pp.ml4 lib/compat.ml4
 
 lib/compat.cmo: lib/compat.ml4
 	$(SHOW)'OCAMLC4  $<' 
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) -impl" -c -impl $<
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pa_ifdef.cmo -impl" -c -impl $<
 
 lib/compat.cmx: lib/compat.ml4
 	$(SHOW)'OCAMLOPT  $<' 
-	$(HIDE)$(OCAMLOPT) $(OPTFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) -impl" -c -impl $<
+	$(HIDE)$(OCAMLOPT) $(OPTFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pa_ifdef.cmo -impl" -c -impl $<
 
 # files compiled with camlp4 because of streams syntax
 
-ML4FILES += lib/pp.ml4 			\
-         lib/compat.ml4 	       	\
-	 contrib/xml/xml.ml4		\
+ML4FILES += contrib/xml/xml.ml4		\
 	 contrib/xml/acic2Xml.ml4	\
 	 contrib/xml/proofTree2Xml.ml4	\
 	 contrib/interface/line_parser.ml4	\
@@ -1404,13 +1505,13 @@ ML4FILES += lib/pp.ml4 			\
 # Add pr_o.cmo to circumvent a useless-warning bug when preprocessed with
 # ast-based camlp4
 
-#parsing/lexer.cmx: parsing/lexer.ml4
-#	$(SHOW)'OCAMLOPT4 $<'
-#	$(HIDE)$(OCAMLOPT) $(OPTFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) `$(CAMLP4DEPS) $<` pr_o.cmo -impl" -c -impl $<
+parsing/lexer.cmx: parsing/lexer.ml4
+	$(SHOW)'OCAMLOPT4 $<'
+	$(HIDE)$(OCAMLOPT) $(OPTFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) `$(CAMLP4DEPS) $<` pr_o.cmo -impl" -c -impl $<
 
-#parsing/lexer.cmo: parsing/lexer.ml4
-#	$(SHOW)'OCAMLC4   $<'
-#	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) `$(CAMLP4DEPS) $<` pr_o.cmo -impl" -c -impl $<
+parsing/lexer.cmo: parsing/lexer.ml4
+	$(SHOW)'OCAMLC4   $<'
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) `$(CAMLP4DEPS) $<` pr_o.cmo -impl" -c -impl $<
 
 
 
@@ -1418,7 +1519,10 @@ ML4FILES += lib/pp.ml4 			\
 # Default rules
 ###########################################################################
 
-.SUFFIXES: .ml .mli .cmo .cmi .cmx .mll .mly .ml4 .v .vo .el .elc
+.SUFFIXES: .ml .mli .cmo .cmi .cmx .mll .mly .ml4 .v .vo .el .elc .h .c .o
+
+.c.o:
+	$(CC) -o $@ $(CFLAGS) $(CINCLUDES)  -c $<
 
 .ml.cmo:
 	$(SHOW)'OCAMLC    $<'
@@ -1466,10 +1570,11 @@ ML4FILES += lib/pp.ml4 			\
 ###########################################################################
 
 archclean::
-	-rm -f bin/*
 	rm -f config/*.cmx* config/*.[soa]
 	rm -f lib/*.cmx* lib/*.[soa]
-	rm -f kernel/*.cmx* kernel/*.[soa]
+	rm -f kernel/*.cmx* kernel/*.[soa]	
+	rm -f kernel/byterun/*.o
+	rm -f kernel/byterun/libcoqrun.a
 	rm -f library/*.cmx* library/*.[soa]
 	rm -f proofs/*.cmx* proofs/*.[soa]
 	rm -f tactics/*.cmx* tactics/*.[soa]
@@ -1479,7 +1584,6 @@ archclean::
 	rm -f toplevel/*.cmx* toplevel/*.[soa]
 	rm -f ide/*.cmx* ide/*.[soa]
 	rm -f ide/utils/*.cmx* ide/utils/*.[soa]
-	rm -f translate/*.cmx* translate/*.[soa]
 	rm -f tools/*.cmx* tools/*.[soa]
 	rm -f tools/*/*.cmx* tools/*/*.[soa]
 	rm -f scripts/*.cmx* scripts/*.[soa]
@@ -1500,7 +1604,6 @@ clean:: archclean
 	rm -f toplevel/*.cm[ioa]
 	rm -f ide/*.cm[ioa]
 	rm -f ide/utils/*.cm[ioa]
-	rm -f translate/*.cm[ioa]
 	rm -f tools/*.cm[ioa]
 	rm -f tools/*/*.cm[ioa]
 	rm -f scripts/*.cm[ioa]
@@ -1518,9 +1621,7 @@ alldepend: depend dependcoq
 
 dependcoq:: beforedepend
 	$(COQDEP) -coqlib . -R theories Coq -R contrib Coq $(COQINCLUDES) \
-	 $(ALLREALS:.vo=.v) $(ALLNEWVO:.vo=.v) > .depend.coq
-	$(COQDEP) -coqlib . -R theories7 Coq -R contrib7 Coq $(COQINCLUDES) \
-	 $(ALLOLDREALS:.vo=.v) $(ALLOLDVO:.vo=.v) > .depend.coq7
+	 $(ALLREALS:.vo=.v) $(ALLVO:.vo=.v) > .depend.coq
 
 # Build dependencies ignoring failures in building ml files from ml4 files
 # This is useful to rebuild dependencies when they are strongly corrupted:
@@ -1528,6 +1629,7 @@ dependcoq:: beforedepend
 # .ml4 files not using fancy parsers. This is sufficient to get beforedepend
 # and depend targets successfully built
 scratchdepend:: dependp4
+	$(OCAMLDEP) $(DEPFLAGS) */*.mli */*/*.mli */*.ml */*/*.ml > .depend
 	-$(MAKE) -k -f Makefile.dep $(ML4FILESML)
 	$(OCAMLDEP) $(DEPFLAGS) */*.mli */*/*.mli */*.ml */*/*.ml > .depend
 	$(MAKE) depend
@@ -1562,9 +1664,13 @@ depend: beforedepend dependp4 ml4filesml
 	  printf "%s" `dirname $$f`/`basename $$f .ml4`".cmx: " >> .depend; \
 	  echo `$(CAMLP4DEPS) $$f` >> .depend; \
 	done
-# 5. Finally, we erase the generated .ml files
+# 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/' >> \
+                    .depend
+# 6. Finally, we erase the generated .ml files
 	rm -f $(ML4FILESML)
-# 6. Since .depend contains correct dependencies .depend.devel can be deleted
+# 7. Since .depend contains correct dependencies .depend.devel can be deleted
 # (see dev/Makefile.dir for details about this file)
 	if [ -e makefile ]; then >.depend.devel; else rm -f .depend.devel; fi
 
@@ -1578,14 +1684,12 @@ clean::
 devel:	
 	touch .depend.devel
 	$(MAKE) -f dev/Makefile.devel setup-devel
-	$(MAKE) dev/top_printers.cmo
+	$(MAKE) $(DEBUGPRINTERS)
 
-include .depend
-include .depend.coq
-include .depend.coq7
+-include .depend
+-include .depend.coq
 
 clean::
-	rm -fr *.v8 syntax/*.v8 ide/*.v8 theories7/*/*.v8 contrib7/*/*.v8
 	find . -name "\.#*" -exec rm -f {} \;
 	find . -name "*~" -exec rm -f {} \;
 
diff --git a/Makefile.dep b/Makefile.dep
index 30690fac..93ca6dfa 100644
--- a/Makefile.dep
+++ b/Makefile.dep
@@ -12,4 +12,4 @@ include Makefile
 include .depend.camlp4
 
 .ml4.ml:
-	$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pr_o.cmo `$(CAMLP4DEPS) $<` -impl $< > $@ || rm -f $@
+	$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pa_ifdef.cmo pr_o.cmo `$(CAMLP4DEPS) $<` $(CAMLP4COMPAT) -impl $< > $@ || rm -f $@
diff --git a/README b/README
index f801891e..2ed855e7 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
 
-            		THE COQ V8.0 SYSTEM
+            		THE COQ V8.1 SYSTEM
             		===================
 
 INSTALLATION.
@@ -11,7 +11,7 @@ INSTALLATION.
 DOCUMENTATION.
 ==============
 
-   The documentation of Coq V8.0 is available by anonymous ftp (see below),
+   The documentation of Coq V8.1 is available by anonymous ftp (see below),
    in a directory doc/. It is also available on Coq web site at
    http://coq.inria.fr/doc-eng.html.
 
diff --git a/README.win b/README.win
index b8cc0c17..d4431ac6 100644
--- a/README.win
+++ b/README.win
@@ -1,4 +1,4 @@
-THE COQ V8.0 SYSTEM
+THE COQ V8.1 SYSTEM
 ===================
 
     This file contains remarks specific to the windows port of Coq.
@@ -6,26 +6,7 @@ THE COQ V8.0 SYSTEM
 INSTALLATION.
 =============
 
-    The windows distribution of Coq consists of an installer that should
-    perform all installation steps. CoqIde (a GTK interface to Coq) can
-    be installed. In case the GTK runtime libraries are not installed,
-    the Coq installer can be set to make a copy of those libraries
-    within the directory of Coq.
-    However, if the files are installed but Coq does not work properly,
-    some steps can be made manually.
-    Let us assume that the installation dir was c:\coq. The following
-    environment variables must be set as:
-      set COQBIN=c:\coq\bin
-      set COQLIB=c:\coq\lib
-    On win9x systems, this is achieved by inserting the 2 lines above
-    in the autoexec.bat file of the system. On other windows systems,
-    environment variables can be configured via the System application
-    of the Control Panel. Then select the Advanced tab.
-    The .bat files in c:\coq should now launch Coq (or CoqIde).
-    The COQBIN path can also be added to the PATH. This might be a
-    bad idea if the GTK libraries of Coq's installer were installed
-    since they might conflict with already installed GTK libraries.
-
+    See the file INSTALL.win for installation procedure.
 
 COMPILATION.
 ============
@@ -34,10 +15,12 @@ COMPILATION.
     distribution. If you really need to recompile under Windows, here
     are some indications:
 
-    1- Install ocaml version 3.06 or later (mingw port preferably).
+    1- Install ocaml version 3.06 or later, Visual C++ (needed
+       for the -custom option of ocaml) and MASM (needed if you want
+       to produce a native version).
 
     2- Install a complete set of Unix utilities (used by Makefiles). 
-       See: http://www.cygwin.com/.
+       See: http://sources.redhat.com/cygwin/.
 
     3- Under cygwin, type successively
 
diff --git a/Tutorial.tex b/Tutorial.tex
new file mode 100755
index 00000000..73d833c4
--- /dev/null
+++ b/Tutorial.tex
@@ -0,0 +1,1555 @@
+\documentclass[11pt,a4paper]{book}
+\usepackage[T1]{fontenc}
+\usepackage[latin1]{inputenc}
+\usepackage{pslatex}
+
+\input{../common/version.tex}
+\input{../common/macros.tex}
+\input{../common/title.tex}
+
+%\makeindex
+
+\begin{document}
+\coverpage{A Tutorial}{Gérard Huet, Gilles Kahn and Christine Paulin-Mohring}{}
+
+%\tableofcontents
+
+\chapter*{Getting started}
+
+\Coq\ is a Proof Assistant for a Logical Framework known as the Calculus
+of Inductive Constructions. It allows the interactive construction of
+formal proofs, and also the manipulation of functional programs 
+consistently with their specifications. It runs as a computer program
+on many architectures.
+%, and mainly on Unix machines. 
+It is available with a variety of user interfaces. The present
+document does not attempt to present a comprehensive view of all the
+possibilities of \Coq, but rather to present in the most elementary
+manner a tutorial on the basic specification language, called Gallina,
+in which formal axiomatisations may be developed, and on the main
+proof tools.  For more advanced information, the reader could refer to
+the \Coq{} Reference Manual or the \textit{Coq'Art}, a new book by Y.
+Bertot and P. Castéran on practical uses of the \Coq{} system.
+
+We assume here that the potential user has installed \Coq~ on his workstation,
+that he calls \Coq~ from a standard teletype-like shell window, and that
+he does not use any special interface.
+Instructions on installation procedures, as well as more comprehensive
+documentation, may be found in the standard distribution of \Coq,
+which may be obtained from \Coq{} web site \texttt{http://coq.inria.fr}.
+
+In the following, all examples preceded by the prompting sequence
+\verb:Coq < : represent user input, terminated by a period. The
+following lines usually show \Coq's answer as it appears on the users
+screen. The sequence of such examples is a valid \Coq~ session, unless
+otherwise specified. This version of the tutorial has been prepared 
+on a PC workstation running Linux.
+The standard invocation of \Coq\ delivers a message such as:
+
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+unix:~> coqtop
+Welcome to Coq 8.0 (Mar 2004)
+
+Coq < 
+\end{verbatim}
+\end{flushleft}
+\end{small}
+
+The first line gives a banner stating the precise version of \Coq~
+used. You should always return this banner when you report an
+anomaly to our hot-line \verb:coq-bugs@pauillac.inria.fr: or on our
+bug-tracking system~:\verb:http://coq.inria.fr/bin/coq-bugs:
+
+\chapter{Basic Predicate Calculus}
+
+\section{An overview of the specification language Gallina}
+
+A formal development in Gallina consists in a sequence of {\sl declarations}
+and {\sl definitions}. You may also send \Coq~ {\sl commands} which are
+not really part of the formal development, but correspond to information
+requests, or service routine invocations. For instance, the command:
+\begin{verbatim}
+Coq < Quit.
+\end{verbatim}
+terminates the current session.
+
+\subsection{Declarations}
+
+A declaration associates a {\sl name} with 
+a {\sl specification}. 
+A name corresponds roughly to an identifier in a programming
+language, i.e. to a string of letters, digits, and a few ASCII symbols like
+underscore (\verb"_") and prime (\verb"'"), starting with a letter. 
+We use case distinction, so that the names \verb"A" and \verb"a" are distinct.
+Certain strings are reserved as key-words of \Coq, and thus are forbidden 
+as user identifiers.
+
+A specification is a formal expression which classifies the notion which is
+being declared. There are basically three kinds of specifications: 
+{\sl logical propositions}, {\sl mathematical collections}, and
+{\sl abstract types}. They are classified by the three basic sorts
+of the system, called respectively \verb:Prop:, \verb:Set:, and
+\verb:Type:, which are themselves atomic abstract types.
+
+Every valid expression $e$ in Gallina is associated with a specification,
+itself a valid expression, called its {\sl type} $\tau(E)$. We write
+$e:\tau(E)$ for the judgment that $e$ is of type $E$. 
+You may request \Coq~ to return to you the type of a valid expression by using
+the command \verb:Check::
+
+\begin{coq_example}
+Check O.
+\end{coq_example}
+
+Thus we know that the identifier \verb:O: (the name `O', not to be
+confused with the numeral `0' which is not a proper identifier!) is
+known in the current context, and that its type is the specification 
+\verb:nat:. This specification is itself classified as a mathematical
+collection, as we may readily check:
+
+\begin{coq_example}
+Check nat.
+\end{coq_example}
+
+The specification \verb:Set: is an abstract type, one of the basic
+sorts of the Gallina language, whereas the notions $nat$ and $O$ are
+notions which are defined in the arithmetic prelude,
+automatically loaded when running the \Coq\ system.
+
+We start by introducing a so-called section name. The role of sections
+is to structure the modelisation by limiting the scope of parameters,
+hypotheses and definitions. It will also give a convenient way to
+reset part of the development.
+
+\begin{coq_example}
+Section Declaration.
+\end{coq_example}
+With what we already know, we may now enter in the system a declaration,
+corresponding to the informal mathematics {\sl let n be a natural
+  number}. 
+
+\begin{coq_example}
+Variable n : nat.
+\end{coq_example}
+
+If we want to translate a more precise statement, such as
+{\sl let n be a positive natural number},
+we have to add another declaration, which will declare explicitly the
+hypothesis \verb:Pos_n:, with specification the proper logical
+proposition:
+\begin{coq_example}
+Hypothesis Pos_n : (gt n 0).
+\end{coq_example}
+
+Indeed we may check that the relation \verb:gt: is known with the right type
+in the current context:
+
+\begin{coq_example}
+Check gt.
+\end{coq_example}
+
+which tells us that \verb:gt: is a function expecting two arguments of
+type \verb:nat: in order to build a logical proposition.
+What happens here is similar to what we are used to in a functional
+programming language: we may compose the (specification) type \verb:nat:
+with the (abstract) type \verb:Prop: of logical propositions through the
+arrow function constructor, in order to get a functional type
+\verb:nat->Prop::
+\begin{coq_example}
+Check (nat -> Prop).
+\end{coq_example}
+which may be composed again with \verb:nat: in order to obtain the
+type \verb:nat->nat->Prop: of binary relations over natural numbers.
+Actually \verb:nat->nat->Prop: is an abbreviation for 
+\verb:nat->(nat->Prop):. 
+
+Functional notions may be composed in the usual way. An expression $f$
+of type $A\ra B$ may be applied to an expression $e$ of type $A$ in order
+to form the expression $(f~e)$ of type $B$. Here we get that
+the expression \verb:(gt n): is well-formed of type \verb:nat->Prop:,
+and thus that the expression \verb:(gt n O):, which abbreviates
+\verb:((gt n) O):, is a well-formed proposition.
+\begin{coq_example}
+Check gt n O.
+\end{coq_example}
+
+\subsection{Definitions}
+
+The initial prelude contains a few arithmetic definitions:
+\verb:nat: is defined as a mathematical collection (type \verb:Set:), constants
+\verb:O:, \verb:S:, \verb:plus:, are defined as objects of types
+respectively \verb:nat:, \verb:nat->nat:, and \verb:nat->nat->nat:.
+You may introduce new definitions, which link a name to a well-typed value.
+For instance, we may introduce the constant \verb:one: as being defined
+to be equal to the successor of zero:
+\begin{coq_example}
+Definition one := (S O).
+\end{coq_example}
+We may optionally indicate the required type:
+\begin{coq_example}
+Definition two : nat := S one.
+\end{coq_example}
+
+Actually \Coq~ allows several possible syntaxes:
+\begin{coq_example}
+Definition three : nat := S two.
+\end{coq_example}
+
+Here is a way to define the doubling function, which expects an
+argument \verb:m: of type \verb:nat: in order to build its result as
+\verb:(plus m m)::
+
+\begin{coq_example}
+Definition double (m:nat) := plus m m.
+\end{coq_example}
+This definition introduces the constant \texttt{double} defined as the
+expression \texttt{fun m:nat => plus m m}.
+The abstraction introduced by \texttt{fun} is explained as follows. The expression
+\verb+fun x:A => e+ is well formed of type \verb+A->B+ in a context
+whenever the expression \verb+e+ is well-formed of type \verb+B+ in 
+the given context to which we add the declaration that \verb+x+
+is of type \verb+A+. Here \verb+x+ is a bound, or dummy variable in
+the expression \verb+fun x:A => e+. For instance we could as well have
+defined \verb:double: as \verb+fun n:nat => (plus n n)+.
+
+Bound (local) variables and free (global) variables may be mixed.
+For instance, we may define the function which adds the constant \verb:n:
+to its argument as
+\begin{coq_example}
+Definition add_n (m:nat) := plus m n.
+\end{coq_example}
+However, note that here we may not rename the formal argument $m$ into $n$
+without capturing the free occurrence of $n$, and thus changing the meaning
+of the defined notion.
+
+Binding operations are well known for instance in logic, where they
+are called quantifiers.  Thus we may universally quantify a
+proposition such as $m>0$ in order to get a universal proposition
+$\forall m\cdot m>0$. Indeed this operator is available in \Coq, with
+the following syntax: \verb+forall m:nat, gt m O+. Similarly to the
+case of the functional abstraction binding, we are obliged to declare
+explicitly the type of the quantified variable. We check:
+\begin{coq_example}
+Check (forall m:nat, gt m 0).
+\end{coq_example}
+We may clean-up the development by removing the contents of the
+current section:
+\begin{coq_example}
+Reset Declaration.
+\end{coq_example}
+
+\section{Introduction to the proof engine: Minimal Logic}
+
+In the following, we are going to consider various propositions, built
+from atomic propositions $A, B, C$. This may be done easily, by
+introducing these atoms as global variables declared of type \verb:Prop:.
+It is easy to declare several names with the same specification:
+\begin{coq_example}
+Section Minimal_Logic.
+Variables A B C : Prop.
+\end{coq_example}
+
+We shall consider simple implications, such as $A\ra B$, read as 
+``$A$ implies $B$''. Remark that we overload the arrow symbol, which
+has been used above as the functionality type constructor, and which
+may be used as well as propositional connective:
+\begin{coq_example}
+Check (A -> B).
+\end{coq_example}
+
+Let us now embark on a simple proof. We want to prove the easy tautology
+$((A\ra (B\ra C))\ra (A\ra B)\ra (A\ra C)$. 
+We enter the proof engine by the command
+\verb:Goal:, followed by the conjecture we want to verify:
+\begin{coq_example}
+Goal (A -> B -> C) -> (A -> B) -> A -> C.
+\end{coq_example}
+
+The system displays the current goal below a double line, local hypotheses
+(there are none initially) being displayed above the line. We call 
+the combination of local hypotheses with a goal a {\sl judgment}.
+We are now in an inner 
+loop of the system, in proof mode. 
+New commands are available in this
+mode, such as {\sl tactics}, which are proof combining primitives.
+A tactic operates on the current goal by attempting to construct a proof
+of the corresponding judgment, possibly from proofs of some
+hypothetical judgments, which are then added to the current
+list of conjectured judgments.
+For instance, the \verb:intro: tactic is applicable to any judgment
+whose goal is an implication, by moving the proposition to the left
+of the application to the list of local hypotheses:
+\begin{coq_example}
+intro H.
+\end{coq_example}
+
+Several introductions may be done in one step:
+\begin{coq_example}
+intros H' HA.
+\end{coq_example}
+
+We notice that $C$, the current goal, may be obtained from hypothesis
+\verb:H:, provided the truth of $A$ and $B$ are established.
+The tactic \verb:apply: implements this piece of reasoning:
+\begin{coq_example}
+apply H.
+\end{coq_example}
+
+We are now in the situation where we have two judgments as conjectures
+that remain to be proved. Only the first is listed in full, for the
+others the system displays only the corresponding subgoal, without its
+local hypotheses list. Remark that \verb:apply: has kept the local
+hypotheses of its father judgment, which are still available for
+the judgments it generated.
+
+In order to solve the current goal, we just have to notice that it is
+exactly available as hypothesis $HA$:
+\begin{coq_example}
+exact HA.
+\end{coq_example}
+
+Now $H'$ applies:
+\begin{coq_example}
+apply H'.
+\end{coq_example}
+
+And we may now conclude the proof as before, with \verb:exact HA.:
+Actually, we may not bother with the name \verb:HA:, and just state that
+the current goal is solvable from the current local assumptions:
+\begin{coq_example}
+assumption.
+\end{coq_example}
+
+The proof is now finished. We may either discard it, by using the
+command \verb:Abort: which returns to the standard \Coq~ toplevel loop
+without further ado, or else save it as a lemma in the current context,
+under name say \verb:trivial_lemma::
+\begin{coq_example}
+Save trivial_lemma.
+\end{coq_example}
+
+As a comment, the system shows the proof script listing all tactic
+commands used in the proof. 
+
+Let us redo the same proof with a few variations. First of all we may name
+the initial goal as a conjectured lemma:
+\begin{coq_example}
+Lemma distr_impl : (A -> B -> C) -> (A -> B) -> A -> C.
+\end{coq_example}
+
+Next, we may omit the names of local assumptions created by the introduction
+tactics, they can be automatically created by the proof engine as new
+non-clashing names.
+\begin{coq_example}
+intros.
+\end{coq_example}
+
+The \verb:intros: tactic, with no arguments, effects as many individual
+applications of \verb:intro: as is legal.
+
+Then, we may compose several tactics together in sequence, or in parallel,
+through {\sl tacticals}, that is tactic combinators. The main constructions
+are the following:
+\begin{itemize}
+\item $T_1 ; T_2$ (read $T_1$ then $T_2$) applies tactic $T_1$ to the current
+goal, and then tactic $T_2$ to all the subgoals generated by $T_1$.
+\item $T; [T_1 | T_2 | ... | T_n]$ applies tactic $T$ to the current
+goal, and then tactic $T_1$ to the first newly generated subgoal, 
+..., $T_n$ to the nth.
+\end{itemize}
+
+We may thus complete the proof of \verb:distr_impl: with one composite tactic:
+\begin{coq_example}
+apply H; [ assumption | apply H0; assumption ].
+\end{coq_example}
+
+Let us now save lemma \verb:distr_impl::
+\begin{coq_example}
+Save.
+\end{coq_example}
+
+Here \verb:Save: needs no argument, since we gave the name \verb:distr_impl: 
+in advance;
+it is however possible to override the given name by giving a different 
+argument to command \verb:Save:.
+
+Actually, such an easy combination of tactics \verb:intro:, \verb:apply:
+and \verb:assumption: may be found completely automatically by an automatic
+tactic, called \verb:auto:, without user guidance:
+\begin{coq_example}
+Lemma distr_imp : (A -> B -> C) -> (A -> B) -> A -> C.
+auto.
+\end{coq_example}
+
+This time, we do not save the proof, we just discard it with the \verb:Abort: 
+command:
+
+\begin{coq_example}
+Abort.
+\end{coq_example}
+
+At any point during a proof, we may use \verb:Abort: to exit the proof mode
+and go back to Coq's main loop. We may also use \verb:Restart: to restart
+from scratch the proof of the same lemma. We may also use \verb:Undo: to
+backtrack one step, and more generally \verb:Undo n: to
+backtrack n steps.
+
+We end this section by showing a useful command, \verb:Inspect n.:,
+which inspects the global \Coq~ environment, showing the last \verb:n: declared
+notions: 
+\begin{coq_example}
+Inspect 3.
+\end{coq_example}
+
+The declarations, whether global parameters or axioms, are shown preceded by 
+\verb:***:; definitions and lemmas are stated with their specification, but
+their value (or proof-term) is omitted.
+
+\section{Propositional Calculus}
+
+\subsection{Conjunction}
+
+We have seen how \verb:intro: and \verb:apply: tactics could be combined
+in order to prove implicational statements. More generally, \Coq~ favors a style
+of reasoning, called {\sl Natural Deduction}, which decomposes reasoning into 
+so called {\sl introduction rules}, which tell how to prove a goal whose main 
+operator is a given propositional connective, and {\sl elimination rules},
+which tell how to use an hypothesis whose main operator is the propositional 
+connective. Let us show how to use these ideas for the propositional connectives
+\verb:/\: and \verb:\/:.
+
+\begin{coq_example}
+Lemma and_commutative : A /\ B -> B /\ A.
+intro.
+\end{coq_example}
+
+We make use of the conjunctive hypothesis \verb:H: with the \verb:elim: tactic,
+which breaks it into its components:
+\begin{coq_example}
+elim H.
+\end{coq_example}
+
+We now use the conjunction introduction tactic \verb:split:, which splits the 
+conjunctive goal into the two subgoals:
+\begin{coq_example}
+split.
+\end{coq_example}
+
+and the proof is now trivial. Indeed, the whole proof is obtainable as follows:
+\begin{coq_example}
+Restart.
+intro H; elim H; auto.
+Qed.
+\end{coq_example}
+
+The tactic \verb:auto: succeeded here because it knows as a hint the 
+conjunction introduction operator \verb+conj+
+\begin{coq_example}
+Check conj.
+\end{coq_example}
+
+Actually, the tactic \verb+Split+ is just an abbreviation for \verb+apply conj.+
+
+What we have just seen is that the \verb:auto: tactic is more powerful than
+just a simple application of local hypotheses; it tries to apply as well 
+lemmas which have been specified as hints. A 
+\verb:Hint Resolve: command registers a
+lemma as a hint to be used from now on by the \verb:auto: tactic, whose power 
+may thus be incrementally augmented.
+
+\subsection{Disjunction}
+
+In a similar fashion, let us consider disjunction:
+
+\begin{coq_example}
+Lemma or_commutative : A \/ B -> B \/ A.
+intro H; elim H.
+\end{coq_example}
+
+Let us prove the first subgoal in detail. We use \verb:intro: in order to
+be left to prove \verb:B\/A: from \verb:A::
+
+\begin{coq_example}
+intro HA.
+\end{coq_example}
+
+Here the hypothesis \verb:H: is not needed anymore. We could choose to
+actually erase it with the tactic \verb:clear:; in this simple proof it
+does not really matter, but in bigger proof developments it is useful to
+clear away unnecessary hypotheses which may clutter your screen.
+\begin{coq_example}
+clear H.
+\end{coq_example}
+
+The disjunction connective has two introduction rules, since \verb:P\/Q:
+may be obtained from \verb:P: or from \verb:Q:; the two corresponding
+proof constructors are called respectively \verb:or_introl: and
+\verb:or_intror:; they are applied to the current goal by tactics
+\verb:left: and \verb:right: respectively. For instance:
+\begin{coq_example}
+right.
+trivial.
+\end{coq_example}
+The tactic \verb:trivial: works like \verb:auto: with the hints
+database, but it only tries those tactics that can solve the goal in one
+step. 
+
+As before, all these tedious elementary steps may be performed automatically,
+as shown for the second symmetric case:
+
+\begin{coq_example}
+auto.
+\end{coq_example}
+
+However, \verb:auto: alone does not succeed in proving the full lemma, because
+it does not try any elimination step.
+It is a bit disappointing that \verb:auto: is not able to prove automatically 
+such a simple tautology. The reason is that we want to keep
+\verb:auto: efficient, so that it is always effective to use. 
+
+\subsection{Tauto}
+
+A complete tactic for propositional
+tautologies is indeed available in \Coq~ as the \verb:tauto: tactic. 
+\begin{coq_example}
+Restart.
+tauto.
+Qed.
+\end{coq_example}
+
+It is possible to inspect the actual proof tree constructed by \verb:tauto:,
+using a standard command of the system, which prints the value of any notion 
+currently defined in the context:
+\begin{coq_example}
+Print or_commutative.
+\end{coq_example}
+
+It is not easy to understand the notation for proof terms without a few
+explanations. The \texttt{fun} prefix, such as \verb+fun H:A\/B =>+, 
+corresponds
+to \verb:intro H:, whereas a subterm such as 
+\verb:(or_intror: \verb:B H0):
+corresponds to the sequence \verb:apply or_intror; exact H0:. 
+The generic combinator \verb:or_intror: needs to be instantiated by
+the two properties \verb:B: and \verb:A:. Because \verb:A: can be
+deduced from the type of \verb:H0:, only  \verb:B: is printed.
+The two instantiations are effected automatically by the tactic
+\verb:apply: when pattern-matching a goal. The specialist will of course
+recognize our proof term as a $\lambda$-term, used as notation for the
+natural deduction proof term through the Curry-Howard isomorphism. The
+naive user of \Coq~ may safely ignore these formal details.
+
+Let us exercise the \verb:tauto: tactic on a more complex example:
+\begin{coq_example}
+Lemma distr_and : A -> B /\ C -> (A -> B) /\ (A -> C).
+tauto.
+Qed.
+\end{coq_example}
+
+\subsection{Classical reasoning}
+
+\verb:tauto: always comes back with an answer. Here is an example where it 
+fails:
+\begin{coq_example}
+Lemma Peirce : ((A -> B) -> A) -> A.
+try tauto.
+\end{coq_example}
+
+Note the use of the \verb:Try: tactical, which does nothing if its tactic
+argument fails.
+
+This may come as a surprise to someone familiar with classical reasoning. 
+Peirce's lemma is true in Boolean logic, i.e. it evaluates to \verb:true: for 
+every truth-assignment to \verb:A: and \verb:B:. Indeed the double negation
+of Peirce's law may be proved in \Coq~ using \verb:tauto::
+\begin{coq_example}
+Abort.
+Lemma NNPeirce : ~ ~ (((A -> B) -> A) -> A).
+tauto.
+Qed.
+\end{coq_example}
+
+In classical logic, the double negation of a proposition is equivalent to this 
+proposition, but in the constructive logic of \Coq~ this is not so. If you 
+want to use classical logic in \Coq, you have to import explicitly the
+\verb:Classical: module, which will declare the axiom \verb:classic:
+of excluded middle, and classical tautologies such as de Morgan's laws.
+The \verb:Require: command is used to import a module from \Coq's library:
+\begin{coq_example}
+Require Import Classical.
+Check NNPP.
+\end{coq_example}
+
+and it is now easy (although admittedly not the most direct way) to prove
+a classical law such as Peirce's:
+\begin{coq_example}
+Lemma Peirce : ((A -> B) -> A) -> A.
+apply NNPP; tauto.
+Qed.
+\end{coq_example}
+
+Here is one more example of propositional reasoning, in the shape of
+a Scottish puzzle. A private club has the following rules:
+\begin{enumerate}
+\item Every non-scottish member wears red socks
+\item Every member wears a kilt or doesn't wear red socks
+\item The married members don't go out on Sunday
+\item A member goes out on Sunday if and only if he is Scottish
+\item Every member who wears a kilt is Scottish and married
+\item Every scottish member wears a kilt
+\end{enumerate}
+Now, we show that these rules are so strict that no one can be accepted.
+\begin{coq_example}
+Section club.
+Variables Scottish RedSocks WearKilt Married GoOutSunday : Prop.
+Hypothesis rule1 : ~ Scottish -> RedSocks.
+Hypothesis rule2 : WearKilt \/ ~ RedSocks.
+Hypothesis rule3 : Married -> ~ GoOutSunday.
+Hypothesis rule4 : GoOutSunday <-> Scottish.
+Hypothesis rule5 : WearKilt -> Scottish /\ Married.
+Hypothesis rule6 : Scottish -> WearKilt.
+Lemma NoMember : False.
+tauto.
+Qed.
+\end{coq_example}
+At that point \verb:NoMember: is a proof of the absurdity depending on
+hypotheses.
+We may end the section, in that case, the variables and hypotheses
+will be discharged, and the type of \verb:NoMember: will be
+generalised.
+
+\begin{coq_example}
+End club.
+Check NoMember.
+\end{coq_example}
+
+\section{Predicate Calculus}
+
+Let us now move into predicate logic, and first of all into first-order
+predicate calculus. The essence of predicate calculus is that to try to prove 
+theorems in the most abstract possible way, without using the definitions of 
+the mathematical notions, but by formal manipulations of uninterpreted 
+function and predicate symbols. 
+
+\subsection{Sections and signatures}
+
+Usually one works in some domain of discourse, over which range the individual 
+variables and function symbols. In \Coq~ we speak in a language with a rich 
+variety of types, so me may mix several domains of discourse, in our 
+multi-sorted language. For the moment, we just do a few exercises, over a 
+domain of discourse \verb:D: axiomatised as a \verb:Set:, and we consider two 
+predicate symbols  \verb:P: and \verb:R: over \verb:D:, of arities 
+respectively 1 and 2. Such abstract entities may be entered in the context
+as global variables. But we must be careful about the pollution of our
+global environment by such declarations. For instance, we have already 
+polluted our \Coq~ session by declaring the variables
+\verb:n:, \verb:Pos_n:, \verb:A:, \verb:B:, and \verb:C:. If we want to revert to the clean state of
+our initial session, we may use the \Coq~ \verb:Reset: command, which returns
+to the state just prior the given global notion as we did before to
+remove a section, or we may return to the initial state using~:
+\begin{coq_example}
+Reset Initial.
+\end{coq_example}
+
+We shall now declare a new \verb:Section:, which will allow us to define
+notions local to a well-delimited scope. We start by assuming a domain of
+discourse \verb:D:, and a binary relation \verb:R:  over \verb:D:: 
+\begin{coq_example}
+Section Predicate_calculus.
+Variable D : Set.
+Variable R : D -> D -> Prop.
+\end{coq_example}
+
+As a simple example of predicate calculus reasoning, let us assume
+that relation \verb:R: is symmetric and transitive, and let us show that
+\verb:R: is reflexive in any point \verb:x: which has an \verb:R: successor.
+Since we do not want to make the assumptions about \verb:R: global axioms of 
+a theory, but rather local hypotheses to a theorem, we open a specific
+section to this effect.
+\begin{coq_example}
+Section R_sym_trans.
+Hypothesis R_symmetric : forall x y:D, R x y -> R y x.
+Hypothesis R_transitive : forall x y z:D, R x y -> R y z -> R x z.
+\end{coq_example}
+
+Remark the syntax \verb+forall x:D,+ which stands for universal quantification
+$\forall x : D$.
+
+\subsection{Existential quantification}
+
+We now state our lemma, and enter proof mode.
+\begin{coq_example}
+Lemma refl_if : forall x:D, (exists y, R x y) -> R x x.
+\end{coq_example}
+
+Remark that the hypotheses which are local to the currently opened sections
+are listed as local hypotheses to the current goals.
+The rationale is that these hypotheses are going to be discharged, as we
+shall see, when we shall close the corresponding sections.
+
+Note the functional syntax for existential quantification. The existential
+quantifier is built from the operator \verb:ex:, which expects a 
+predicate as argument:
+\begin{coq_example}
+Check ex.
+\end{coq_example}
+and the notation \verb+(exists x:D, P x)+ is just concrete syntax for 
+\verb+(ex D (fun x:D => P x))+. 
+Existential quantification is handled in \Coq~ in a similar
+fashion to the connectives \verb:/\: and \verb:\/: : it is introduced by
+the proof combinator \verb:ex_intro:, which is invoked by the specific 
+tactic \verb:Exists:, and its elimination provides a witness \verb+a:D+ to
+\verb:P:, together with an assumption \verb+h:(P a)+ that indeed \verb+a+
+verifies \verb:P:. Let us see how this works on this simple example.
+\begin{coq_example}
+intros x x_Rlinked.
+\end{coq_example}
+
+Remark that \verb:intros: treats universal quantification in the same way
+as the premises of implications. Renaming of bound variables occurs
+when it is needed; for instance, had we started with \verb:intro y:,
+we would have obtained the goal:
+\begin{coq_eval}
+Undo.
+\end{coq_eval}
+\begin{coq_example}
+intro y.
+\end{coq_example}
+\begin{coq_eval}
+Undo.
+intros x x_Rlinked.
+\end{coq_eval}
+
+Let us now use the existential hypothesis \verb:x_Rlinked: to 
+exhibit an R-successor y of x. This is done in two steps, first with
+\verb:elim:, then with \verb:intros:
+
+\begin{coq_example}
+elim x_Rlinked.
+intros y Rxy.
+\end{coq_example}
+
+Now we want to use \verb:R_transitive:. The \verb:apply: tactic will know
+how to match \verb:x: with \verb:x:, and \verb:z: with \verb:x:, but needs
+help on how to instantiate \verb:y:, which appear in the hypotheses of
+\verb:R_transitive:, but not in its conclusion. We give the proper hint
+to \verb:apply: in a \verb:with: clause, as follows:
+\begin{coq_example}
+apply R_transitive with y.
+\end{coq_example}
+
+The rest of the proof is routine:
+\begin{coq_example}
+assumption.
+apply R_symmetric; assumption.
+\end{coq_example}
+\begin{coq_example*}
+Qed.
+\end{coq_example*}
+
+Let us now close the current section.
+\begin{coq_example}
+End R_sym_trans.
+\end{coq_example}
+
+Here \Coq's printout is a warning that all local hypotheses have been 
+discharged in the statement of \verb:refl_if:, which now becomes a general
+theorem in the first-order language declared in section 
+\verb:Predicate_calculus:. In this particular example, the use of section
+\verb:R_sym_trans: has not been really significant, since we could have
+instead stated theorem \verb:refl_if: in its general form, and done 
+basically the same proof, obtaining \verb:R_symmetric: and
+\verb:R_transitive: as local hypotheses by initial \verb:intros: rather
+than as global hypotheses in the context. But if we had pursued the
+theory by proving more theorems about relation \verb:R:,
+we would have obtained all general statements at the closing of the section,
+with minimal dependencies on the hypotheses of symmetry and transitivity.
+
+\subsection{Paradoxes of classical predicate calculus}
+
+Let us illustrate this feature by pursuing our \verb:Predicate_calculus:
+section with an enrichment of our language: we declare a unary predicate
+\verb:P: and a constant \verb:d::
+\begin{coq_example}
+Variable P :  D -> Prop.
+Variable d : D.
+\end{coq_example}
+
+We shall now prove a well-known fact from first-order logic: a universal 
+predicate is non-empty, or in other terms existential quantification 
+follows from universal quantification.
+\begin{coq_example}
+Lemma weird : (forall x:D, P x) ->  exists a, P a.
+ intro UnivP.
+\end{coq_example}
+
+First of all, notice the pair of parentheses around
+\verb+forall x:D, P x+ in
+the statement of lemma \verb:weird:.
+If we had omitted them, \Coq's parser would have interpreted the
+statement as a truly trivial fact, since we would 
+postulate an \verb:x: verifying \verb:(P x):. Here the situation is indeed
+more problematic. If we have some element in \verb:Set: \verb:D:, we may
+apply \verb:UnivP: to it and conclude, otherwise we are stuck. Indeed
+such an element \verb:d: exists, but this is just by virtue of our
+new signature. This points out a subtle difference between standard
+predicate calculus and \Coq. In standard first-order logic,
+the equivalent of lemma \verb:weird: always holds, 
+because such a rule is wired in the inference rules for quantifiers, the
+semantic justification being that the interpretation domain is assumed to
+be non-empty. Whereas in \Coq, where types are not assumed to be 
+systematically inhabited, lemma \verb:weird: only holds in signatures
+which allow the explicit construction of an element in the domain of
+the predicate. 
+
+Let us conclude the proof, in order to show the use of the \verb:Exists:
+tactic:
+\begin{coq_example}
+exists d; trivial.
+Qed.
+\end{coq_example}
+
+Another fact which illustrates the sometimes disconcerting rules of
+classical 
+predicate calculus is Smullyan's drinkers' paradox: ``In any non-empty
+bar, there is a person such that if she drinks, then everyone drinks''.
+We modelize the bar by Set \verb:D:, drinking by predicate \verb:P:.
+We shall need classical reasoning. Instead of loading the \verb:Classical:
+module as we did above, we just state the law of excluded middle as a
+local hypothesis schema at this point:
+\begin{coq_example}
+Hypothesis EM : forall A:Prop, A \/ ~ A.
+Lemma drinker :  exists x:D, P x -> forall x:D, P x.
+\end{coq_example}
+The proof goes by cases on whether or not
+there is someone who does not drink. Such reasoning by cases proceeds
+by invoking the excluded middle principle, via \verb:elim: of the
+proper instance of \verb:EM::
+\begin{coq_example}
+elim (EM (exists x, ~ P x)).
+\end{coq_example}
+
+We first look at the first case. Let Tom be the non-drinker:
+\begin{coq_example}
+intro Non_drinker; elim Non_drinker; intros Tom Tom_does_not_drink.
+\end{coq_example}
+
+We conclude in that case by considering Tom, since his drinking leads to
+a contradiction:
+\begin{coq_example}
+exists Tom; intro Tom_drinks.
+\end{coq_example}
+
+There are several ways in which we may eliminate a contradictory case;
+a simple one is to use the \verb:absurd: tactic as follows:
+\begin{coq_example}
+absurd (P Tom); trivial.
+\end{coq_example}
+
+We now proceed with the second case, in which actually any person will do;
+such a John Doe is given by the non-emptiness witness \verb:d::
+\begin{coq_example}
+intro No_nondrinker; exists d; intro d_drinks.
+\end{coq_example}
+
+Now we consider any Dick in the bar, and reason by cases according to its
+drinking or not:
+\begin{coq_example}
+intro Dick; elim (EM (P Dick)); trivial.
+\end{coq_example}
+
+The only non-trivial case is again treated by contradiction:
+\begin{coq_example}
+intro Dick_does_not_drink; absurd (exists x, ~ P x); trivial.
+exists Dick; trivial.
+Qed.
+\end{coq_example}
+
+Now, let us close the main section and look at the complete statements
+we proved:
+\begin{coq_example}
+End Predicate_calculus.
+Check refl_if.
+Check weird.
+Check drinker.
+\end{coq_example}
+
+Remark how the three theorems are completely generic in the most general 
+fashion;
+the domain \verb:D: is discharged in all of them, \verb:R: is discharged in
+\verb:refl_if: only, \verb:P: is discharged only in \verb:weird: and
+\verb:drinker:, along with the hypothesis that \verb:D: is inhabited. 
+Finally, the excluded middle hypothesis is discharged only in 
+\verb:drinker:.
+
+Note that the name \verb:d: has vanished as well from
+the statements of \verb:weird: and \verb:drinker:, 
+since \Coq's pretty-printer replaces
+systematically a quantification such as \verb+forall d:D, E+, where \verb:d:
+does not occur in \verb:E:, by the functional notation \verb:D->E:. 
+Similarly the name \verb:EM: does not appear in \verb:drinker:. 
+
+Actually, universal quantification, implication, 
+as well as function formation, are
+all special cases of one general construct of type theory called
+{\sl dependent product}. This is the mathematical construction 
+corresponding to an indexed family of functions. A function 
+$f\in \Pi x:D\cdot Cx$ maps an element $x$ of its domain $D$ to its
+(indexed) codomain $Cx$. Thus a proof of $\forall x:D\cdot Px$ is
+a function mapping an element $x$ of $D$ to a proof of proposition $Px$.
+
+
+\subsection{Flexible use of local assumptions}
+
+Very often during the course of a proof we want to retrieve a local
+assumption and reintroduce it explicitly in the goal, for instance
+in order to get a more general induction hypothesis. The tactic
+\verb:generalize: is what is needed here:
+
+\begin{coq_example}
+Section Predicate_Calculus.
+Variables P Q : nat -> Prop.
+Variable R :  nat -> nat -> Prop.
+Lemma PQR :
+ forall x y:nat, (R x x -> P x -> Q x) -> P x -> R x y -> Q x.
+intros.
+generalize H0.
+\end{coq_example}
+
+Sometimes it may be convenient to use a lemma, although we do not have
+a direct way to appeal to such an already proven fact. The tactic \verb:cut:
+permits to use the lemma at this point, keeping the corresponding proof
+obligation as a new subgoal:
+\begin{coq_example}
+cut (R x x); trivial.
+\end{coq_example}
+We clean the goal by doing an \verb:Abort: command.
+\begin{coq_example*}
+Abort.
+\end{coq_example*}
+
+
+\subsection{Equality}
+
+The basic equality provided in \Coq~ is Leibniz equality, noted infix like
+\verb+x=y+, when \verb:x: and \verb:y: are two expressions of
+type the same Set. The replacement of \verb:x: by \verb:y: in any
+term is effected by a variety of tactics, such as \verb:rewrite:
+and \verb:replace:. 
+
+Let us give a few examples of equality replacement. Let us assume that
+some arithmetic function \verb:f: is null in zero:
+\begin{coq_example}
+Variable f : nat -> nat.
+Hypothesis foo : f 0 = 0.
+\end{coq_example}
+
+We want to prove the following conditional equality:
+\begin{coq_example*}
+Lemma L1 : forall k:nat, k = 0 -> f k = k.
+\end{coq_example*}
+
+As usual, we first get rid of local assumptions with \verb:intro::
+\begin{coq_example}
+intros k E.
+\end{coq_example}
+
+Let us now use equation \verb:E: as a left-to-right rewriting:
+\begin{coq_example}
+rewrite E.
+\end{coq_example}
+This replaced both occurrences of \verb:k: by \verb:O:. 
+
+Now \verb:apply foo: will finish the proof:
+
+\begin{coq_example}
+apply foo.
+Qed.
+\end{coq_example}
+
+When one wants to rewrite an equality in a right to left fashion, we should
+use \verb:rewrite <- E: rather than \verb:rewrite E: or the equivalent
+\verb:rewrite -> E:. 
+Let us now illustrate the tactic \verb:replace:.
+\begin{coq_example}
+Hypothesis f10 : f 1 = f 0.
+Lemma L2 : f (f 1) = 0.
+replace (f 1) with 0.
+\end{coq_example}
+What happened here is that the replacement left the first subgoal to be
+proved, but another proof obligation was generated by the \verb:replace:
+tactic, as the second subgoal. The first subgoal is solved immediately
+by applying lemma \verb:foo:; the second one transitivity and then 
+symmetry of equality, for instance with tactics \verb:transitivity: and 
+\verb:symmetry::
+\begin{coq_example}
+apply foo.
+transitivity (f 0); symmetry; trivial.
+\end{coq_example}
+In case the equality $t=u$ generated by \verb:replace: $u$ \verb:with:
+$t$ is an assumption
+(possibly modulo symmetry), it will be automatically proved and the
+corresponding goal will not appear. For instance:
+\begin{coq_example}
+Restart.
+replace (f 0) with 0.
+rewrite f10; rewrite foo; trivial.
+Qed.
+\end{coq_example}
+
+\section{Using definitions}
+
+The development of mathematics does not simply proceed by logical 
+argumentation from first principles: definitions are used in an essential way.
+A formal development proceeds by a dual process of abstraction, where one
+proves abstract statements in predicate calculus, and use of definitions, 
+which in the contrary one instantiates general statements with particular 
+notions in order to use the structure of mathematical values for the proof of
+more specialised properties.
+
+\subsection{Unfolding definitions}
+
+Assume that we want to develop the theory of sets represented as characteristic
+predicates over some universe \verb:U:. For instance:
+\begin{coq_example}
+Variable U : Type.
+Definition set := U -> Prop.
+Definition element (x:U) (S:set) := S x.
+Definition subset (A B:set) := forall x:U, element x A -> element x B.
+\end{coq_example}
+
+Now, assume that we have loaded a module of general properties about
+relations over some abstract type \verb:T:, such as transitivity:
+
+\begin{coq_example}
+Definition transitive (T:Type) (R:T -> T -> Prop) :=
+  forall x y z:T, R x y -> R y z -> R x z.
+\end{coq_example}
+
+Now, assume that we want to prove that \verb:subset: is a \verb:transitive:
+relation. 
+\begin{coq_example}
+Lemma subset_transitive : transitive set subset.
+\end{coq_example}
+
+In order to make any progress, one needs to use the definition of
+\verb:transitive:. The \verb:unfold: tactic, which replaces all
+occurrences of a defined notion by its definition in the current goal,
+may be used here.
+\begin{coq_example}
+unfold transitive.
+\end{coq_example}
+
+Now, we must unfold \verb:subset::
+\begin{coq_example}
+unfold subset.
+\end{coq_example}
+Now, unfolding \verb:element: would be a mistake, because indeed a simple proof
+can be found by \verb:auto:, keeping \verb:element: an abstract predicate:
+\begin{coq_example}
+auto.
+\end{coq_example}
+
+Many variations on \verb:unfold: are provided in \Coq. For instance,
+we may selectively unfold one designated occurrence:
+\begin{coq_example}
+Undo 2.
+unfold subset at 2.
+\end{coq_example}
+
+One may also unfold a definition in a given local hypothesis, using the
+\verb:in: notation:
+\begin{coq_example}
+intros.
+unfold subset in H.
+\end{coq_example}
+
+Finally, the tactic \verb:red: does only unfolding of the head occurrence
+of the current goal:
+\begin{coq_example}
+red.
+auto.
+Qed.
+\end{coq_example}
+
+
+\subsection{Principle of proof irrelevance}
+
+Even though in principle the proof term associated with a verified lemma
+corresponds to a defined value of the corresponding specification, such
+definitions cannot be unfolded in \Coq: a lemma is considered an {\sl opaque}
+definition. This conforms to the mathematical tradition of {\sl proof
+irrelevance}: the proof of a logical proposition does not matter, and the
+mathematical justification of a logical development relies only on
+{\sl provability} of the lemmas used in the formal proof. 
+
+Conversely, ordinary mathematical definitions can be unfolded at will, they
+are {\sl transparent}. 
+\chapter{Induction}
+
+\section{Data Types as Inductively Defined Mathematical Collections}
+
+All the notions which were studied until now pertain to traditional
+mathematical logic. Specifications of objects were abstract properties
+used in reasoning more or less constructively; we are now entering
+the realm of inductive types, which specify the existence of concrete
+mathematical constructions.
+
+\subsection{Booleans}
+
+Let us start with the collection of booleans, as they are specified
+in the \Coq's \verb:Prelude: module: 
+\begin{coq_example}
+Inductive bool :  Set := true | false.
+\end{coq_example}
+
+Such a declaration defines several objects at once. First, a new
+\verb:Set: is declared, with name \verb:bool:. Then the {\sl constructors}
+of this \verb:Set: are declared, called \verb:true: and \verb:false:.
+Those are analogous to introduction rules of the new Set \verb:bool:.
+Finally, a specific elimination rule for \verb:bool: is now available, which
+permits to reason by cases on \verb:bool: values. Three instances are
+indeed defined as new combinators in the global context: \verb:bool_ind:,
+a proof combinator corresponding to reasoning by cases,
+\verb:bool_rec:, an if-then-else programming construct,
+and \verb:bool_rect:, a similar combinator at the level of types.
+Indeed:
+\begin{coq_example}
+Check bool_ind.
+Check bool_rec.
+Check bool_rect.
+\end{coq_example}
+
+Let us for instance prove that every Boolean is true or false.
+\begin{coq_example}
+Lemma duality : forall b:bool, b = true \/ b = false.
+intro b.
+\end{coq_example}
+
+We use the knowledge that \verb:b: is a \verb:bool: by calling tactic
+\verb:elim:, which is this case will appeal to combinator \verb:bool_ind:
+in order to split the proof according to the two cases:
+\begin{coq_example}
+elim b.
+\end{coq_example}
+
+It is easy to conclude in each case:
+\begin{coq_example}
+left; trivial.
+right; trivial.
+\end{coq_example}
+
+Indeed, the whole proof can be done with the combination of the
+\verb:simple induction: tactic, which combines \verb:intro: and \verb:elim:,
+with good old \verb:auto::
+\begin{coq_example}
+Restart.
+simple induction b; auto.
+Qed.
+\end{coq_example}
+
+\subsection{Natural numbers}
+
+Similarly to Booleans, natural numbers are defined in the \verb:Prelude:
+module with constructors \verb:S: and \verb:O::
+\begin{coq_example}
+Inductive nat : Set :=
+  | O : nat
+  | S : nat -> nat.
+\end{coq_example}
+
+The elimination principles which are automatically generated are Peano's
+induction principle, and a recursion operator:
+\begin{coq_example}
+Check nat_ind.
+Check nat_rec.
+\end{coq_example}
+
+Let us start by showing how to program the standard primitive recursion
+operator \verb:prim_rec: from the more general \verb:nat_rec::
+\begin{coq_example}
+Definition prim_rec := nat_rec (fun i:nat => nat).
+\end{coq_example}
+
+That is, instead of computing for natural \verb:i: an element of the indexed
+\verb:Set: \verb:(P i):, \verb:prim_rec: computes uniformly an element of 
+\verb:nat:. Let us check the type of \verb:prim_rec::
+\begin{coq_example}
+Check prim_rec.
+\end{coq_example}
+
+Oops! Instead of the expected type \verb+nat->(nat->nat->nat)->nat->nat+ we
+get an apparently more complicated expression. Indeed the type of
+\verb:prim_rec: is equivalent by rule $\beta$ to its expected type; this may
+be checked in \Coq~ by command \verb:Eval Cbv Beta:, which $\beta$-reduces
+an expression to its {\sl normal form}:
+\begin{coq_example}
+Eval cbv beta in
+  ((fun _:nat => nat) O ->
+   (forall y:nat, (fun _:nat => nat) y -> (fun _:nat => nat) (S y)) ->
+   forall n:nat, (fun _:nat => nat) n).
+\end{coq_example}
+
+Let us now show how to program addition with primitive recursion:
+\begin{coq_example}
+Definition addition (n m:nat) := prim_rec m (fun p rec:nat => S rec) n.
+\end{coq_example}
+
+That is, we specify that \verb+(addition n m)+ computes by cases on \verb:n:
+according to its main constructor; when \verb:n = O:, we get \verb:m:;
+ when \verb:n = S p:, we get \verb:(S rec):, where \verb:rec: is the result
+of the recursive computation \verb+(addition p m)+. Let us verify it by
+asking \Coq~to compute for us say $2+3$:
+\begin{coq_example}
+Eval compute in (addition (S (S O)) (S (S (S O)))).
+\end{coq_example}
+
+Actually, we do not have to do all explicitly. {\Coq} provides a
+special syntax {\tt Fixpoint/match} for generic primitive recursion,
+and we could thus have defined directly addition as:
+
+\begin{coq_example}
+Fixpoint plus (n m:nat) {struct n} : nat :=
+  match n with
+  | O => m
+  | S p => S (plus p m)
+  end.
+\end{coq_example}
+
+For the rest of the session, we shall clean up what we did so far with 
+types \verb:bool: and \verb:nat:, in order to use the initial definitions
+given in \Coq's \verb:Prelude: module, and not to get confusing error
+messages due to our redefinitions. We thus revert to the state before
+our definition of \verb:bool: with the \verb:Reset: command:
+\begin{coq_example}
+Reset bool.
+\end{coq_example}
+
+
+\subsection{Simple proofs by induction}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+Let us now show how to do proofs by structural induction. We start with easy
+properties of the \verb:plus: function we just defined. Let us first
+show that $n=n+0$.
+\begin{coq_example}
+Lemma plus_n_O : forall n:nat, n = n + 0.
+intro n; elim n.
+\end{coq_example}
+
+What happened was that \verb:elim n:, in order to construct a \verb:Prop:
+(the initial goal) from a \verb:nat: (i.e. \verb:n:), appealed to the
+corresponding induction principle \verb:nat_ind: which we saw was indeed
+exactly Peano's induction scheme. Pattern-matching instantiated the 
+corresponding predicate \verb:P: to \verb+fun n:nat => n = n + 0+, and we get
+as subgoals the corresponding instantiations of the base case \verb:(P O): ,
+and of the inductive step \verb+forall y:nat, P y -> P (S y)+.
+In each case we get an instance of function \verb:plus: in which its second
+argument starts with a constructor, and is thus amenable to simplification
+by primitive recursion. The \Coq~tactic \verb:simpl: can be used for
+this purpose:
+\begin{coq_example}
+simpl.
+auto.
+\end{coq_example}
+
+We proceed in the same way for the base step:
+\begin{coq_example}
+simpl; auto.
+Qed.
+\end{coq_example}
+
+Here \verb:auto: succeeded, because it used as a hint lemma \verb:eq_S:,
+which say that successor preserves equality:
+\begin{coq_example}
+Check eq_S.
+\end{coq_example}
+
+Actually, let us see how to declare our lemma \verb:plus_n_O: as a hint
+to be used by \verb:auto::
+\begin{coq_example}
+Hint Resolve plus_n_O .
+\end{coq_example}
+
+We now proceed to the similar property concerning the other constructor
+\verb:S::
+\begin{coq_example}
+Lemma plus_n_S : forall n m:nat, S (n + m) = n + S m.
+\end{coq_example}
+
+We now go faster, remembering that tactic \verb:simple induction: does the
+necessary \verb:intros: before applying \verb:elim:. Factoring simplification
+and automation in both cases thanks to tactic composition, we prove this
+lemma in one line:
+\begin{coq_example}
+simple induction n; simpl; auto.
+Qed.
+Hint Resolve plus_n_S .
+\end{coq_example}
+
+Let us end this exercise with the commutativity of \verb:plus::
+
+\begin{coq_example}
+Lemma plus_com : forall n m:nat, n + m = m + n.
+\end{coq_example}
+
+Here we have a choice on doing an induction on \verb:n: or on \verb:m:, the
+situation being symmetric. For instance:
+\begin{coq_example}
+simple induction m; simpl; auto.
+\end{coq_example}
+
+Here \verb:auto: succeeded on the base case, thanks to our hint
+\verb:plus_n_O:, but the induction step requires rewriting, which
+\verb:auto: does not handle:
+
+\begin{coq_example}
+intros m' E; rewrite <- E; auto.
+Qed.
+\end{coq_example}
+
+\subsection{Discriminate}
+
+It is also possible to define new propositions by primitive recursion.
+Let us for instance define the predicate which discriminates between
+the constructors \verb:O: and \verb:S:: it computes to \verb:False: 
+when its argument is \verb:O:, and to \verb:True: when its argument is 
+of the form \verb:(S n)::
+\begin{coq_example}
+Definition Is_S (n:nat) := match n with
+                           | O => False
+                           | S p => True
+                           end.
+\end{coq_example}
+
+Now we may use the computational power of \verb:Is_S: in order to prove
+trivially that \verb:(Is_S (S n))::
+\begin{coq_example}
+Lemma S_Is_S : forall n:nat, Is_S (S n).
+simpl; trivial.
+Qed.
+\end{coq_example}
+
+But we may also use it to transform a \verb:False: goal into 
+\verb:(Is_S O):. Let us show a particularly important use of this feature;
+we want to prove that \verb:O: and \verb:S: construct different values, one
+of Peano's axioms:
+\begin{coq_example}
+Lemma no_confusion : forall n:nat, 0 <> S n.
+\end{coq_example}
+
+First of all, we replace negation by its definition, by reducing the
+goal with tactic \verb:red:; then we get contradiction by successive
+\verb:intros::
+\begin{coq_example}
+red; intros n H.
+\end{coq_example}
+
+Now we use our trick:
+\begin{coq_example}
+change (Is_S 0).
+\end{coq_example}
+
+Now we use equality in order to get a subgoal which computes out to 
+\verb:True:, which finishes the proof:
+\begin{coq_example}
+rewrite H; trivial.
+simpl; trivial.
+\end{coq_example}
+
+Actually, a specific tactic \verb:discriminate: is provided
+to produce mechanically such proofs, without the need for the user to define
+explicitly the relevant discrimination predicates:
+
+\begin{coq_example}
+Restart.
+intro n; discriminate.
+Qed.
+\end{coq_example}
+
+
+\section{Logic programming}
+
+In the same way as we defined standard data-types above, we
+may define inductive families, and for instance inductive predicates.
+Here is the definition of predicate $\le$ over type \verb:nat:, as
+given in \Coq's \verb:Prelude: module:
+\begin{coq_example*}
+Inductive le (n:nat) : nat -> Prop :=
+  | le_n : le n n
+  | le_S : forall m:nat, le n m -> le n (S m).
+\end{coq_example*}
+
+This definition introduces a new predicate \verb+le:nat->nat->Prop+,
+and the two constructors \verb:le_n: and \verb:le_S:, which are the
+defining clauses of \verb:le:. That is, we get not only the ``axioms''
+\verb:le_n: and \verb:le_S:, but also the converse property, that 
+\verb:(le n m): if and only if this statement can be obtained as a
+consequence of these defining clauses; that is, \verb:le: is the
+minimal predicate verifying clauses \verb:le_n: and \verb:le_S:. This is
+insured, as in the case of inductive data types, by an elimination principle,
+which here amounts to an induction principle \verb:le_ind:, stating this 
+minimality property:
+\begin{coq_example}
+Check le.
+Check le_ind.
+\end{coq_example}
+
+Let us show how proofs may be conducted with this principle.
+First we show that $n\le m \Rightarrow n+1\le m+1$:
+\begin{coq_example}
+Lemma le_n_S : forall n m:nat, le n m -> le (S n) (S m).
+intros n m n_le_m.
+elim n_le_m.
+\end{coq_example}
+
+What happens here is similar to the behaviour of \verb:elim: on natural
+numbers: it appeals to the relevant induction principle, here \verb:le_ind:,
+which generates the two subgoals, which may then be solved easily
+with the help of the defining clauses of \verb:le:.
+\begin{coq_example}
+apply le_n; trivial.
+intros; apply le_S; trivial.
+\end{coq_example}
+
+Now we know that it is a good idea to give the defining clauses as hints,
+so that the proof may proceed with a simple combination of 
+\verb:induction: and \verb:auto:.
+\begin{coq_example}
+Restart.
+Hint Resolve le_n le_S .
+\end{coq_example}
+
+We have a slight problem however. We want to say ``Do an induction on
+hypothesis \verb:(le n m):'', but we have no explicit name for it. What we
+do in this case is to say ``Do an induction on the first unnamed hypothesis'',
+as follows.
+\begin{coq_example}
+simple induction 1; auto.
+Qed.
+\end{coq_example}
+
+Here is a more tricky problem. Assume we want to show that
+$n\le 0 \Rightarrow n=0$. This reasoning ought to follow simply from the
+fact that only the first defining clause of \verb:le: applies.
+\begin{coq_example} 
+Lemma tricky : forall n:nat, le n 0 -> n = 0.
+\end{coq_example}
+
+However, here trying something like \verb:induction 1: would lead
+nowhere (try it and see what happens). 
+An induction on \verb:n: would not be convenient either.
+What we must do here is analyse the definition of \verb"le" in order
+to match hypothesis \verb:(le n O): with the defining clauses, to find
+that only \verb:le_n: applies, whence the result. 
+This analysis may be performed by the ``inversion'' tactic
+\verb:inversion_clear: as follows:
+\begin{coq_example} 
+intros n H; inversion_clear H.
+trivial.
+Qed.
+\end{coq_example}
+
+\chapter{Modules}
+
+\section{Opening library modules}
+
+When you start \Coq~ without further requirements in the command line,
+you get a bare system with few libraries loaded.  As we saw, a standard
+prelude module provides the standard logic connectives, and a few
+arithmetic notions. If you want to load and open other modules from
+the library, you have to use the \verb"Require" command, as we saw for
+classical logic above. For instance, if you want more arithmetic
+constructions, you should request:
+\begin{coq_example*}
+Require Import Arith.
+\end{coq_example*}
+
+Such a command looks for a (compiled) module file \verb:Arith.vo: in
+the libraries registered by \Coq. Libraries inherit the structure of
+the file system of the operating system and are registered with the
+command \verb:Add LoadPath:. Physical directories are mapped to
+logical directories. Especially the standard library of \Coq~ is
+pre-registered as a library of name \verb=Coq=.  Modules have absolute
+unique names denoting their place in \Coq~ libraries.  An absolute
+name is a sequence of single identifiers separated by dots.  E.g. the
+module \verb=Arith= has full name \verb=Coq.Arith.Arith= and because
+it resides in eponym subdirectory \verb=Arith= of the standard
+library, it can be as well required by the command
+
+\begin{coq_example*}
+Require Import Coq.Arith.Arith.
+\end{coq_example*}
+
+This may be useful to avoid ambiguities if somewhere, in another branch
+of the libraries known by Coq, another module is also called
+\verb=Arith=. Notice that by default, when a library is registered,
+all its contents, and all the contents of its subdirectories recursively are
+visible and accessible by a short (relative) name as \verb=Arith=.
+Notice also that modules or definitions not explicitly registered in
+a library are put in a default library called \verb=Top=.
+
+The loading of a compiled file is quick, because the corresponding
+development is not type-checked again. 
+
+\section{Creating your own modules}
+
+You may create your own modules, by writing \Coq~ commands in a file,
+say \verb:my_module.v:. Such a module may be simply loaded in the current
+context, with command \verb:Load my_module:. It may also be compiled,
+in ``batch'' mode, using the UNIX command
+\verb:coqc:. Compiling the module \verb:my_module.v: creates a 
+file \verb:my_module.vo:{} that can be reloaded with command
+\verb:Require Import my_module:. 
+
+If a required module depends on other modules then the latters are
+automatically required beforehand. However their contents is not
+automatically visible.  If you want a module \verb=M= required in a
+module \verb=N= to be automatically visible when \verb=N= is required,
+you should use \verb:Require Export M: in your module \verb:N:.
+
+\section{Managing the context}
+
+It is often difficult to remember the names of all lemmas and
+definitions available in the current context, especially if large
+libraries have been loaded. A convenient \verb:SearchAbout: command
+is available to lookup all known facts 
+concerning a given predicate. For instance, if you want to know all the
+known lemmas about the less or equal relation, just ask:
+\begin{coq_example}
+SearchAbout le.
+\end{coq_example}
+Another command \verb:Search: displays only lemmas where the searched
+predicate appears at the head position in the conclusion.
+\begin{coq_example}
+Search le.
+\end{coq_example}
+
+A new and more convenient search tool is \textsf{SearchPattern}
+developed by Yves Bertot. It allows to find the theorems with a
+conclusion matching a given pattern, where \verb:\_: can be used in
+place of an arbitrary term. We remark in this example, that \Coq{}
+provides usual infix notations for arithmetic operators.
+
+\begin{coq_example}
+SearchPattern (_ + _ = _).
+\end{coq_example}
+
+\section{Now you are on your own}
+
+This tutorial is necessarily incomplete. If you wish to pursue serious
+proving in \Coq, you should now get your hands on \Coq's Reference Manual,
+which contains a complete description of all the tactics we saw, 
+plus many more.
+You also should look in the library of developed theories which is distributed
+with \Coq, in order to acquaint yourself with various proof techniques.
+
+
+\end{document}
+
+% $Id: Tutorial.tex 8715 2006-04-14 12:43:23Z cpaulin $ 
diff --git a/config/Makefile.template b/config/Makefile.template
index e75b8bd0..9432a884 100644
--- a/config/Makefile.template
+++ b/config/Makefile.template
@@ -24,26 +24,29 @@ LOCAL=LOCALINSTALLATION
 # LIBDIR=path where the Coq library will reside
 # MANDIR=path where to install manual pages
 # EMACSDIR=path where to put Coq's Emacs mode (coq.el)
-BINDIR='BINDIRDIRECTORY'
-COQLIB='COQLIBDIRECTORY'
-MANDIR='MANDIRDIRECTORY'
-EMACSLIB='EMACSLIBDIRECTORY'
+BINDIR="BINDIRDIRECTORY"
+COQLIB="COQLIBDIRECTORY"
+MANDIR="MANDIRDIRECTORY"
+EMACSLIB="EMACSLIBDIRECTORY"
 EMACS=EMACSCOMMAND
 
 # Path to Coq distribution
-COQTOP='COQTOPDIRECTORY'
+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
+
 # Camlp4 library directory (avoid CAMLP4LIB used on Windows)
 CAMLP4O=CAMLP4TOOL
 CAMLP4COMPAT=CAMLP4COMPATFLAGS
-MYCAMLP4LIB='CAMLP4LIBDIRECTORY'
+MYCAMLP4LIB=CAMLP4LIBDIRECTORY
 
 # Objective-Caml compile command 
 OCAMLC=BYTECAMLC
@@ -87,7 +90,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
diff --git a/config/coq_config.mli b/config/coq_config.mli
index 4b780b1f..099db808 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,v 1.9.16.2 2006/01/10 17:06:23 barras Exp $ i*)
+(*i $Id: coq_config.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 val local : bool        (* local use (no installation) *)
 
@@ -26,6 +26,7 @@ val osdeplibs : string  (* OS dependant link options for ocamlc *)
 (* val defined : string list  (* options for lib/ocamlpp *) *)
 
 val version : string    (* version number of Coq *)
+val versionsi : string  (* version number of Coq\_SearchIsos *)
 val date : string       (* release date *)
 val compile_date : string (* compile date *)
 
diff --git a/configure b/configure
index 193ebff4..a380cf86 100755
--- a/configure
+++ b/configure
@@ -6,8 +6,8 @@
 # 
 ##################################
 
-VERSION=8.0pl3
-DATE="Jan 2006"
+VERSION=8.1-alpha
+DATE="Mar 2006"
 
 # a local which command for sh
 which () {
@@ -30,50 +30,66 @@ coq_profile_flag=
 best_compiler=opt
 
 local=false
-src_spec=no
-prefix_spec=no
 bindir_spec=no
 libdir_spec=no
 mandir_spec=no
 emacslib_spec=no
-#emacs_spec=no
+emacs_spec=no
 coqdocdir_spec=no
 reals_opt=no
 reals=all
 arch_spec=no
 coqide_spec=no
 
+COQTOP=`pwd`
+
+
 # Parse command-line arguments
 
 while : ; do
   case "$1" in
     "") break;;
-    -prefix|--prefix) prefix_spec=yes
-                      prefix="$2"
+    -prefix|--prefix) bindir_spec=yes
+                      bindir=$2/bin
+                      libdir_spec=yes
+		      libdir=$2/lib/coq
+                      mandir_spec=yes
+		      mandir=$2/man
+		      coqdocdir_spec=yes
+		      coqdocdir=$2/share/texmf/tex/latex/misc
 		      shift;;
     -local|--local) local=true
+                    bindir_spec=yes
+                    bindir=$COQTOP/bin
+                    libdir_spec=yes
+		    libdir=$COQTOP
+                    mandir_spec=yes
+		    mandir=$COQTOP/man
+                    emacslib_spec=yes
+		    emacslib=$COQTOP/tools/emacs
+		    coqdocdir_spec=yes
+		    coqdocdir=$COQTOP/tools/coqdoc
 		    reals_opt=yes
 		    reals=all;;
-    -src|--src) src_spec=yes
-                COQTOP="$2"
+    -src|--src) COQTOP=$2
 	        shift;;
     -bindir|--bindir) bindir_spec=yes
-                      bindir="$2"
+                      bindir=$2
 		      shift;;
     -libdir|--libdir) libdir_spec=yes
-                      libdir="$2"
+                      libdir=$2
 		      shift;;
     -mandir|--mandir) mandir_spec=yes
                       mandir=$2
 		      shift;;
     -emacslib|--emacslib) emacslib_spec=yes
-                          emacslib="$2"
+                          emacslib=$2
 			  shift;;
-#    -emacs |--emacs) emacs_spec=yes
-#		     emacs="$2"
-#		     shift;;
+    -emacs |--emacs) emacs_spec=yes
+		     emacs=$2
+		     shift;;
     -coqdocdir|--coqdocdir) coqdocdir_spec=yes
-	              coqdocdir="$2"
+	              coqdocdir=$2
 		      shift;;
     -arch|--arch) arch_spec=yes
                   arch=$2
@@ -95,11 +111,6 @@ while : ; do
   shift
 done
 
-if [ $prefix_spec = yes -a $local = true ] ; then
-  echo "Options -prefix and -local are incompatible"
-  echo "Configure script failed!"
-  exit 1
-fi
 
 # compile date
 DATEPGM=`which date`
@@ -135,28 +146,125 @@ case $arch_spec in
     yes) ARCH=$arch
 esac
 
-# executable extension
+# bindir, libdir, mandir, etc.
 
 case $ARCH in
-    win32) EXE=".exe";;
-    *) EXE=""
+  win32)
+	 bindir_def=C:\\coq\\bin
+	 libdir_def=C:\\coq\\lib
+	 mandir_def=C:\\coq\\man
+	 emacslib_def=C:\\coq\\emacs;;
+  *)
+	 bindir_def=/usr/local/bin
+	 libdir_def=/usr/local/lib/coq
+	 mandir_def=/usr/local/man
+	 emacslib_def=/usr/share/emacs/site-lisp
+         coqdocdir_def=/usr/share/texmf/tex/latex/misc;;
+esac
+
+emacs_def=emacs
+
+case $bindir_spec in
+    no) echo "Where should I install the Coq binaries [$bindir_def] ?"
+        read BINDIR
+	
+	case $BINDIR in
+	    "") BINDIR=$bindir_def;;
+	    *) true;;
+	esac;;
+    yes) BINDIR=$bindir;;
 esac
 
-# strip command
+case $libdir_spec in
+    no) echo "Where should I install the Coq library [$libdir_def] ?"
+        read LIBDIR
+	
+	case $LIBDIR in
+	    "") LIBDIR=$libdir_def;;
+	    *) true;;
+	esac;;
+    yes) LIBDIR=$libdir;;
+esac
+
+case $mandir_spec in
+    no) echo "Where should I install the Coq man pages [$mandir_def] ?"
+        read MANDIR
+	
+	case $MANDIR in
+	    "") MANDIR=$mandir_def;;
+	    *) true;;
+	esac;;
+    yes) MANDIR=$mandir;;
+esac
+
+case $emacslib_spec in
+    no) echo "Where should I install the Coq Emacs mode [$emacslib_def] ?"
+        read EMACSLIB
+	
+	case $EMACSLIB in
+	    "") EMACSLIB=$emacslib_def;;
+	    *) true;;
+	esac;;
+    yes) EMACSLIB=$emacslib;;
+esac
+
+case $coqdocdir_spec in
+    no) echo "Where should I install Coqdoc TeX/LaTeX files [$coqdocdir_def] ?"
+        read COQDOCDIR
+	
+	case $COQDOCDIR in
+	    "") COQDOCDIR=$coqdocdir_def;;
+	    *) true;;
+	esac;;
+    yes) COQDOCDIR=$coqdocdir;;
+esac
+
+case $reals_opt in
+    no) echo "Should I compile the complete theory of real analysis [Y/N, default is Y] ?"
+	read reals_ans
+
+	case $reals_ans in
+	    "N"|"n"|"No"|"NO"|"no")
+		    reals=basic;;
+		*) reals=all;;
+	esac;;
+    yes) true;;
+esac
+
+# case $emacs_spec in
+#     no) echo "Which Emacs command should I use to compile coq.el [$emacs_def] ?"
+#         read EMACS
+	
+# 	case $EMACS in
+# 	    "") EMACS=$emacs_def;;
+# 	    *) true;;
+# 	esac;;
+#     yes) EMACS=$emacs;;
+# esac
+
+# OS dependent libraries
 
 case $ARCH in
-    win32)
-	# true -> strip : it exists under cygwin !
-	STRIPCOMMAND="strip";; 
-    *)
-    if [ "$coq_profile_flag" = "-p" ] ; then
-	STRIPCOMMAND="true"
-    else
-	STRIPCOMMAND="strip"
-    fi
+  sun4*) OS=`uname -r`
+	case $OS in
+	   5*) OS="Sun Solaris $OS"
+	       OSDEPLIBS="-cclib -lunix -cclib -lnsl -cclib -lsocket";;
+	   *) OS="Sun OS $OS"
+	      OSDEPLIBS="-cclib -lunix"
+        esac;;
+  alpha) OSDEPLIBS="-cclib -lunix";;
+  win32) OS="Win32" 
+	 OSDEPLIBS="-cclib -lunix";;
+  *) OSDEPLIBS="-cclib -lunix"
+esac
+
+# executable extension
+
+case $ARCH in
+    win32) EXE=".exe";;
+    *) EXE=""
 esac
 
-#########################################
 # Objective Caml programs
 
 CAMLC=`which $bytecamlc`
@@ -222,30 +330,21 @@ if [ "$best_compiler" = "opt" ] ; then
   esac
 fi
 
-# For coqmktop
+# For coqmktop & bytecode compiler
 
 CAMLLIB=`"$CAMLC" -where`
 
 # Camlp4 (greatly simplified since merged with ocaml)
 
 CAMLP4BIN=${CAMLBIN}
-CAMLP4LIB=+camlp4
 
-# OS dependent libraries
-
-case $ARCH in
-  sun4*) OS=`uname -r`
-	case $OS in
-	   5*) OS="Sun Solaris $OS"
-	       OSDEPLIBS="-cclib -lunix -cclib -lnsl -cclib -lsocket";;
-	   *) OS="Sun OS $OS"
-	      OSDEPLIBS="-cclib -lunix"
-        esac;;
-  alpha) OSDEPLIBS="-cclib -lunix";;
-  win32) OS="Win32" 
-	 OSDEPLIBS="-cclib -lunix";;
-  *) OSDEPLIBS="-cclib -lunix"
-esac
+#case $OS in
+#  Win32)
+    CAMLP4LIB=+camlp4
+# ;;
+#  *)
+#    CAMLP4LIB=${CAMLLIB}/camlp4
+#esac
 
 # lablgtk2 and CoqIDE
 
@@ -259,6 +358,11 @@ if test -x "${CAMLLIB}/lablgtk2" ; then
             echo "LablGtk2 found, no native threads: bytecode CoqIde will be available"
 	    COQIDE=byte
 	fi
+	if grep "class view " "${CAMLLIB}/lablgtk2/gText.mli" | grep -q "\[>" ; then
+	    LABLGTKGE26=yes;
+        else
+	    LABLGTKGE26=no
+	fi;
     else
         echo "LablGtk2 found but too old: CoqIde will not be available"
         COQIDE=no;
@@ -269,154 +373,30 @@ else
 fi
 fi
 
-if [ $COQIDE != no ] ; then
-  if grep "class view " "${CAMLLIB}/lablgtk2/gText.mli" | grep -q "\[>" ; then
-    LABLGTKGE26=yes;
-  else
-    LABLGTKGE26=no
-  fi
-fi
-
 # Tell on windows if ocaml understands cygwin or windows path formats
 
 #"$CAMLC" -o config/giveostype config/giveostype.ml
 #CAMLOSTYPE=`config/giveostype`
 #rm config/giveostype
 
-######################################
-# mktexlsr
+case $ARCH in
+    win32)
+	# true -> strip : it exists under cygwin !
+	STRIPCOMMAND="strip";; 
+    *)
+    if [ "$coq_profile_flag" = "-p" ] ; then
+	STRIPCOMMAND="true"
+    else
+	STRIPCOMMAND="strip"
+    fi
+esac
 
+# mktexlsr
 #MKTEXLSR=`which mktexlsr`
 #case $MKTEXLSR in
 #    "") MKTEXLSR=true;;
 #esac
 
-###########################################
-# bindir, libdir, mandir, etc.
-
-canonical_pwd () {
-ocaml 2>&1 1>/dev/null <<EOF
-  prerr_endline(Sys.getcwd());;
-EOF
-}
-
-case $src_spec in
-  no) COQTOP=`canonical_pwd`
-esac
-
-case $ARCH in
-  win32)
-	 bindir_def='C:\coq\bin'
-	 libdir_def='C:\coq\lib'
-	 mandir_def='C:\coq\man'
-	 emacslib_def='C:\coq\emacs'
-         coqdocdir_def='C:\coq\latex';;
-  *)
-	 bindir_def=/usr/local/bin
-	 libdir_def=/usr/local/lib/coq
-	 mandir_def=/usr/local/man
-	 emacslib_def=/usr/share/emacs/site-lisp
-         coqdocdir_def=/usr/share/texmf/tex/latex/misc;;
-esac
-
-emacs_def=emacs
-
-case $bindir_spec/$prefix_spec/$local in
-    yes/*/*) BINDIR=$bindir ;;
-    */yes/*) BINDIR=$prefix/bin ;;
-    */*/true) BINDIR=$COQTOP/bin ;;
-    *) echo "Where should I install the Coq binaries [$bindir_def] ?"
-        read BINDIR
-	case $BINDIR in
-	    "") BINDIR=$bindir_def;;
-	    *) true;;
-	esac;;
-esac
-
-case $libdir_spec/$prefix_spec/$local in
-    yes/*/*) LIBDIR=$libdir;;
-    */yes/*)
-        case $ARCH in
-          win32) LIBDIR=$prefix ;;
-          *)  LIBDIR=$prefix/lib/coq ;;
-        esac ;;
-    */*/true) LIBDIR=$COQTOP ;;
-    *)  echo "Where should I install the Coq library [$libdir_def] ?"
-        read LIBDIR
-	case $LIBDIR in
-	    "") LIBDIR=$libdir_def;;
-	    *) true;;
-	esac;;
-esac
-
-case $mandir_spec/$prefix_spec/$local in
-    yes/*/*) MANDIR=$mandir;;
-    */yes/*) MANDIR=$prefix/man ;;
-    */*/true) MANDIR=$COQTOP/man ;;
-    *)  echo "Where should I install the Coq man pages [$mandir_def] ?"
-        read MANDIR
-	case $MANDIR in
-	    "") MANDIR=$mandir_def;;
-	    *) true;;
-	esac;;
-esac
-
-case $emacslib_spec/$prefix_spec/$local in
-    yes/*/*) EMACSLIB=$emacslib;;
-    */yes/*)
-        case $ARCH in
-          win32) EMACSLIB=$prefix/emacs ;;
-          *)  EMACSLIB=$prefix/share/emacs/site-lisp ;;
-        esac ;;
-    */*/true) EMACSLIB=$COQTOP/tools/emacs ;;
-    *) echo "Where should I install the Coq Emacs mode [$emacslib_def] ?"
-        read EMACSLIB
-	case $EMACSLIB in
-	    "") EMACSLIB=$emacslib_def;;
-	    *) true;;
-	esac;;
-esac
-
-case $coqdocdir_spec/$prefix_spec/$local in
-    yes/*/*) COQDOCDIR=$coqdocdir;;
-    */yes/*)
-        case $ARCH in
-          win32) COQDOCDIR=$prefix/latex ;;
-          *)  COQDOCDIR=$prefix/share/emacs/site-lisp ;;
-        esac ;;
-    */*/true) COQDOCDIR=$COQTOP/tools/coqdoc ;;
-    *) echo "Where should I install Coqdoc TeX/LaTeX files [$coqdocdir_def] ?"
-        read COQDOCDIR
-	case $COQDOCDIR in
-	    "") COQDOCDIR=$coqdocdir_def;;
-	    *) true;;
-	esac;;
-esac
-
-case $reals_opt in
-    no) echo "Should I compile the complete theory of real analysis [Y/N, default is Y] ?"
-	read reals_ans
-
-	case $reals_ans in
-	    "N"|"n"|"No"|"NO"|"no")
-		    reals=basic;;
-		*) reals=all;;
-	esac;;
-    yes) true;;
-esac
-
-# case $emacs_spec in
-#     no) echo "Which Emacs command should I use to compile coq.el [$emacs_def] ?"
-#         read EMACS
-	
-# 	case $EMACS in
-# 	    "") EMACS=$emacs_def;;
-# 	    *) true;;
-# 	esac;;
-#     yes) EMACS=$emacs;;
-# esac
-
-###########################################
 # Summary of the configuration
 
 echo ""
@@ -449,19 +429,16 @@ echo ""
 # Building the $COQTOP/config/coq_config.ml file
 #####################################################
 
-# An escaped version of a variable
-escape_var () {
-ocaml 2>&1 1>/dev/null <<EOF
-  prerr_endline(String.escaped(Sys.getenv"$VAR"));;
-EOF
-}
-
-export COQTOP BINDIR LIBDIR CAMLLIB
-ESCCOQTOP="`VAR=COQTOP escape_var`"
-ESCBINDIR="`VAR=BINDIR escape_var`"
-ESCLIBDIR="`VAR=LIBDIR escape_var`"
-ESCCAMLLIB="`VAR=CAMLLIB escape_var`"
-ESCCAMLP4LIB="$ESCCAMLLIB"/camlp4
+# damned backslashes under M$Windows
+case $ARCH in
+    win32)
+	CAMLLIB=`echo $CAMLLIB |sed -e 's|\\\|\\\\\\\|g'`
+	BINDIR=`echo $BINDIR |sed -e 's|\\\|\\\\\\\|g'`
+	LIBDIR=`echo $LIBDIR |sed -e 's|\\\|\\\\\\\|g'`
+  	MANDIR=`echo $MANDIR |sed -e 's|\\\|\\\\\\\|g'`
+   	EMACSLIB=`echo $EMACSLIB |sed -e 's|\\\|\\\\\\\|g'`
+	;;
+esac
 
 mlconfig_file=$COQTOP/config/coq_config.ml
 rm -f $mlconfig_file
@@ -469,15 +446,16 @@ cat << END_OF_COQ_CONFIG > $mlconfig_file
 (* DO NOT EDIT THIS FILE: automatically generated by ../configure *)
 
 let local = $local
-let bindir = "$ESCBINDIR" 
-let coqlib = "$ESCLIBDIR"
-let coqtop = "$ESCCOQTOP"
-let camllib = "$ESCCAMLLIB"
-let camlp4lib = "$ESCCAMLP4LIB"
+let bindir = "$BINDIR" 
+let coqlib = "$LIBDIR"
+let coqtop = "$COQTOP"
+let camllib = "$CAMLLIB"
+let camlp4lib = "$CAMLP4LIB"
 let best = "$best_compiler"
 let arch = "$ARCH"
 let osdeplibs = "$OSDEPLIBS"
 let version = "$VERSION"
+let versionsi = "$VERSIONSI"
 let date = "$DATE"
 let compile_date = "$COMPILEDATE"
 let exec_extension = "$EXE"
@@ -489,7 +467,7 @@ PRINTF=`which printf`
 
 # Subdirectories of theories/ added in coq_config.ml
 subdirs () {
-    (cd $1; find * -type d ! -name CVS -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
@@ -509,42 +487,32 @@ chmod a-w $mlconfig_file
 
 rm -f $COQTOP/config/Makefile
 
-# damned backslashes under M$Windows
+# damned backslashes under M$Windows (bis)
 case $ARCH in
     win32)
-	ESCCOQTOP=`echo $COQTOP |sed -e 's|\\\|\\\\\\\|g'`
-	ESCBINDIR=`echo $BINDIR |sed -e 's|\\\|\\\\\\\|g'`
-	ESCLIBDIR=`echo $LIBDIR |sed -e 's|\\\|\\\\\\\|g'`
-  	ESCMANDIR=`echo $MANDIR |sed -e 's|\\\|\\\\\\\|g'`
-   	ESCEMACSLIB=`echo $EMACSLIB |sed -e 's|\\\|\\\\\\\|g'`
-   	ESCCOQDOCDIR=`echo $COQDOCDIR |sed -e 's|\\\|\\\\\\\|g'`
-   	ESCCAMLP4BIN=`echo $CAMLP4BIN |sed -e 's|\\\|\\\\\\\|g'`
+	BINDIR=`echo $BINDIR |sed -e 's|\\\|\\\\\\\|g'`
+	LIBDIR=`echo $LIBDIR |sed -e 's|\\\|\\\\\\\|g'`
+  	MANDIR=`echo $MANDIR |sed -e 's|\\\|\\\\\\\|g'`
+   	EMACSLIB=`echo $EMACSLIB |sed -e 's|\\\|\\\\\\\|g'`
 	;;
-    *)
-        ESCCOQTOP="$COQTOP"
-	ESCBINDIR="$BINDIR"
-	ESCLIBDIR="$LIBDIR"
-  	ESCMANDIR="$MANDIR"
-   	ESCEMACSLIB="$EMACSLIB"
-   	ESCCOQDOCDIR="$COQDOCDIR"
-   	ESCCAMLP4BIN="$CAMLP4BIN" ;;
 esac
 
 sed -e "s|LOCALINSTALLATION|$local|" \
-    -e "s|COQTOPDIRECTORY|$ESCCOQTOP|" \
+    -e "s|COQTOPDIRECTORY|$COQTOP|" \
     -e "s|COQVERSION|$VERSION|" \
-    -e "s|BINDIRDIRECTORY|$ESCBINDIR|" \
-    -e "s|COQLIBDIRECTORY|$ESCLIBDIR|" \
-    -e "s|MANDIRDIRECTORY|$ESCMANDIR|" \
-    -e "s|EMACSLIBDIRECTORY|$ESCEMACSLIB|" \
+    -e "s|BINDIRDIRECTORY|$BINDIR|" \
+    -e "s|COQLIBDIRECTORY|$LIBDIR|" \
+    -e "s|MANDIRDIRECTORY|$MANDIR|" \
+    -e "s|EMACSLIBDIRECTORY|$EMACSLIB|" \
     -e "s|EMACSCOMMAND|$EMACS|" \
-    -e "s|COQDOCDIRECTORY|$ESCCOQDOCDIR|" \
+    -e "s|COQDOCDIRECTORY|$COQDOCDIR|" \
     -e "s|MKTEXLSRCOMMAND|$MKTEXLSR|" \
     -e "s|ARCHITECTURE|$ARCH|" \
     -e "s|OSDEPENDENTLIBS|$OSDEPLIBS|" \
     -e "s|OSDEPENDENTP4OPTFLAGS|$OSDEPP4OPTFLAGS|" \
+    -e "s|CAMLLIBDIRECTORY|$CAMLLIB|" \
     -e "s|CAMLTAG|$CAMLTAG|" \
-    -e "s|CAMLP4BINDIRECTORY|$ESCCAMLP4BIN|" \
+    -e "s|CAMLP4BINDIRECTORY|$CAMLP4BIN|" \
     -e "s|CAMLP4LIBDIRECTORY|$CAMLP4LIB|" \
     -e "s|CAMLP4TOOL|$camlp4o|" \
     -e "s|CAMLP4COMPATFLAGS|$CAMLP4COMPAT|" \
@@ -562,17 +530,29 @@ sed -e "s|LOCALINSTALLATION|$local|" \
 chmod a-w $COQTOP/config/Makefile
 
 ##################################################
-# Building the $COQTOP/dev/ocamldebug-v7 file
-####################################################
+# Building the $COQTOP/dev/ocamldebug-coq file
+##################################################
+
+OCAMLDEBUGCOQ=$COQTOP/dev/ocamldebug-coq
 
 if test "$coq_debug_flag" = "-g" ; then
-  rm -f $COQTOP/dev/ocamldebug-v7
+  rm -f $OCAMLDEBUGCOQ
+  if [ "$CAMLP4LIB" = "+camlp4" ] ; then
+    CAMLP4LIBFORCAMLDEBUG=$CAMLLIB/camlp4
+  else
+    CAMLP4LIBFORCAMLDEBUG=$CAMLP4LIB
+  fi
   sed -e "s|COQTOPDIRECTORY|$COQTOP|" \
       -e "s|COQLIBDIRECTORY|$LIBDIR|" \
       -e "s|CAMLBINDIRECTORY|$CAMLBIN|" \
-      -e "s|CAMLP4LIBDIRECTORY|$CAMLLIB/camlp4|" \
-      $COQTOP/dev/ocamldebug-v7.template > $COQTOP/dev/ocamldebug-v7
-  chmod a-w,a+x $COQTOP/dev/ocamldebug-v7
+      -e "s|CAMLP4LIBDIRECTORY|$CAMLP4LIBFORCAMLDEBUG|" \
+      $OCAMLDEBUGCOQ.template > $OCAMLDEBUGCOQ
+  chmod a-w,a+x $OCAMLDEBUGCOQ
+fi
+
+# Compatibility with previous name
+if [ ! -f $COQTOP/dev/ocamldebug-v7 ] ; then
+  ln -s `basename $OCAMLDEBUGCOQ` $COQTOP/dev/ocamldebug-v7
 fi
 
 ##################################################
@@ -594,4 +574,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,v 1.74.2.19 2006/01/13 11:50:07 barras Exp $
+# $Id: configure 8712 2006-04-14 10:34:47Z notin $
diff --git a/contrib/cc/CCSolve.v b/contrib/cc/CCSolve.v
deleted file mode 100644
index fab6f775..00000000
--- a/contrib/cc/CCSolve.v
+++ /dev/null
@@ -1,22 +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        *)
-(************************************************************************)
-
-(* $Id: CCSolve.v,v 1.4.2.1 2004/07/16 19:29:58 herbelin Exp $ *)
-
-Ltac CCsolve :=
-  repeat
-   match goal with
-   | H:?X1 |- ?X2 =>
-       let Heq := fresh "Heq" in
-       (assert (Heq : X2 = X1); [ congruence | rewrite Heq; exact H ])
-   | H:?X1,G:(?X2 -> ?X3) |- _ =>
-       let Heq := fresh "Heq" in
-       (assert (Heq : X2 = X1);
-         [ congruence
-         | rewrite Heq in G; generalize (G H); clear G; intro G ])
-   end.  
diff --git a/contrib/cc/ccalgo.ml b/contrib/cc/ccalgo.ml
index e73a6221..3e2d11a2 100644
--- a/contrib/cc/ccalgo.ml
+++ b/contrib/cc/ccalgo.ml
@@ -6,45 +6,33 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ccalgo.ml,v 1.6.2.1 2004/07/16 19:29:58 herbelin Exp $ *)
+(* $Id: ccalgo.ml 7298 2005-08-17 12:56:38Z corbinea $ *)
 
 (* This file implements the basic congruence-closure algorithm by *)
 (* Downey,Sethi and Tarjan. *)
 
 open Util
+open Pp
+open Goptions
 open Names
 open Term
 
-let init_size=251
+let init_size=5
 
-type pa_constructor=
-    {head_constr: int;
-     arity:int;
-     nhyps:int;
-     args:int list;
-     term_head:int}
-
-
-module PacMap=Map.Make(struct type t=int*int let compare=compare end) 
-
-type term=
-    Symb of constr
-  | Appli of term*term
-  | Constructor of constructor*int*int (* constructor arity+ nhyps *)
+let cc_verbose=ref false 
 
-type rule=
-    Congruence
-  | Axiom of identifier
-  | Injection of int*int*int*int (* terms+head+arg position *)
+let debug msg (stdpp:std_ppcmds) = 
+  if !cc_verbose then msg stdpp
 
-type equality = {lhs:int;rhs:int;rule:rule}
-
-let swap eq=
-  let swap_rule=match eq.rule with
-      Congruence -> Congruence
-    | Injection (i,j,c,a) -> Injection (j,i,c,a)
-    | Axiom id -> anomaly "no symmetry for axioms"    
-  in {lhs=eq.rhs;rhs=eq.lhs;rule=swap_rule}
+let _=
+  let gdopt=
+    { optsync=true;
+      optname="Congruence Verbose";
+      optkey=SecondaryTable("Congruence","Verbose"); 
+      optread=(fun ()-> !cc_verbose); 
+      optwrite=(fun b -> cc_verbose := b)}  
+  in
+    declare_bool_option gdopt
 
 (* Signature table *)
 
@@ -68,290 +56,452 @@ module ST=struct
 	  
   let query sign st=Hashtbl.find st.toterm sign
 	  
-  let delete t st=
+  let delete st t=
     try let sign=Hashtbl.find st.tosign t in
 	Hashtbl.remove st.toterm sign;
 	Hashtbl.remove st.tosign t
     with
 	Not_found -> ()
 
-  let rec delete_list l st=
-    match l with
-      []->()
-    | t::q -> delete t st;delete_list q st
+  let rec delete_set st s = Intset.iter (delete st) s
 	  
 end
-    
-(* Basic Union-Find algo w/o path compression *)
-    
-module UF = struct
 
-module IndMap=Map.Make(struct type t=inductive let compare=compare end) 
+type pa_constructor=
+    { cnode : int;
+      arity : int;
+      args  : int list}
 
-  type representative=
-      {mutable nfathers:int;
-       mutable fathers:int list;
-       mutable constructors:pa_constructor PacMap.t;
-       mutable inductives:(int * int) IndMap.t}
+module PacMap=Map.Make(struct 
+			 type t=pa_constructor 
+			 let compare=Pervasives.compare end) 
 
-  type cl = Rep of representative| Eqto of int*equality
+type cinfo=
+    {ci_constr: constructor; (* inductive type *)
+     ci_arity: int;     (* # args *)
+     ci_nhyps: int}     (* # projectable args *)
 
-  type vertex = Leaf| Node of (int*int) 
+type term=
+    Symb of constr
+  | Eps
+  | Appli of term*term
+  | Constructor of cinfo (* constructor arity + nhyps *)
 
-  type node = 
-      {clas:cl;
-       vertex:vertex;
-       term:term;
-       mutable node_constr: int PacMap.t}    
+type rule=
+    Congruence
+  | Axiom of identifier * bool 
+  | Injection of int * pa_constructor * int * pa_constructor * int
 
-  type t={mutable size:int;
-          map:(int,node) Hashtbl.t;
-          syms:(term,int) Hashtbl.t;
-	  sigtable:ST.t}
+type from=
+    Goal
+  | Hyp of identifier
+  | HeqG of identifier
+  | HeqnH of identifier * identifier
 
-  let empty ():t={size=0;
-		  map=Hashtbl.create init_size;
-		  syms=Hashtbl.create init_size;
-		  sigtable=ST.empty ()}
+type 'a eq = {lhs:int;rhs:int;rule:'a}
 
-  let rec find uf i=
-    match (Hashtbl.find uf.map i).clas with
-	Rep _ -> i
-      | Eqto (j,_) ->find uf j
-	  
-  let get_representative uf i=
-    let node=Hashtbl.find uf.map i in
-      match node.clas with
-	  Rep r ->r
-	| _ -> anomaly "get_representative: not a representative"
+type equality = rule eq
+
+type disequality = from eq
 
-  let get_constructor uf i=
-    match (Hashtbl.find uf.map i).term with
-	Constructor (cstr,_,_)->cstr
-      | _ -> anomaly "get_constructor: not a constructor"
+let swap eq : equality =
+  let swap_rule=match eq.rule with
+      Congruence -> Congruence
+    | Injection (i,pi,j,pj,k) -> Injection (j,pj,i,pi,k)
+    | Axiom (id,reversed) -> Axiom (id,not reversed)
+  in {lhs=eq.rhs;rhs=eq.lhs;rule=swap_rule}
+    
+type inductive_status =
+    Unknown
+  | Partial of pa_constructor
+  | Partial_applied
+  | Total of (int * pa_constructor)
+
+type representative=
+    {mutable nfathers:int;
+     mutable lfathers:Intset.t;
+     mutable fathers:Intset.t;
+     mutable inductive_status: inductive_status;
+     mutable constructors: int PacMap.t} (*pac -> term = app(constr,t) *)
+
+type cl = Rep of representative| Eqto of int*equality
+  
+type vertex = Leaf| Node of (int*int) 
+
+type node = 
+    {mutable clas:cl;
+     mutable cpath: int; 
+     vertex:vertex;
+     term:term}
+    
+type forest=
+    {mutable max_size:int;
+     mutable size:int;
+     mutable map: node array;
+     axioms: (identifier,term*term) Hashtbl.t;
+     mutable epsilons: pa_constructor list;
+     syms:(term,int) Hashtbl.t}
+
+type state = 
+    {uf: forest;
+     sigtable:ST.t;
+     mutable terms: Intset.t; 
+     combine: equality Queue.t; 
+     marks: (int * pa_constructor) Queue.t;
+     mutable diseq: disequality list;
+     mutable pa_classes: Intset.t}
+
+let dummy_node =
+  {clas=Eqto(min_int,{lhs=min_int;rhs=min_int;rule=Congruence});
+   cpath=min_int;
+   vertex=Leaf;
+   term=Symb (mkRel min_int)}
+
+let empty ():state =
+  {uf=
+     {max_size=init_size;
+      size=0;
+      map=Array.create init_size dummy_node;
+      epsilons=[];
+      axioms=Hashtbl.create init_size;
+      syms=Hashtbl.create init_size};
+  terms=Intset.empty;
+  combine=Queue.create ();
+  marks=Queue.create ();
+  sigtable=ST.empty ();
+  diseq=[];
+  pa_classes=Intset.empty}
+
+let forest state = state.uf 
+       
+let compress_path uf i j = uf.map.(j).cpath<-i
+			     
+let rec find_aux uf visited i=  
+  let j = uf.map.(i).cpath in 
+    if j<0 then let _ = List.iter (compress_path uf i) visited in i else
+      find_aux uf (i::visited) j
+	
+let find uf i= find_aux uf [] i
+		 
+let get_representative uf i=
+  match uf.map.(i).clas with
+      Rep r -> r
+    | _ -> anomaly "get_representative: not a representative"
+
+let find_pac uf i pac =
+  PacMap.find pac (get_representative uf i).constructors
+
+let get_constructor_info uf i=
+  match uf.map.(i).term with
+      Constructor cinfo->cinfo
+    | _ -> anomaly "get_constructor: not a constructor"
+	
+let size uf i=
+  (get_representative uf i).nfathers
 
+let axioms uf = uf.axioms
 
-  let fathers uf i=
-    (get_representative uf i).fathers
-	  
-  let size uf i=
-    (get_representative uf i).nfathers
+let epsilons uf = uf.epsilons
 
-  let add_father uf i t=
-    let r=get_representative uf i in
-      r.nfathers<-r.nfathers+1;
-      r.fathers<-t::r.fathers 
+let add_lfather uf i t=
+  let r=get_representative uf i in
+    r.nfathers<-r.nfathers+1;
+    r.lfathers<-Intset.add t r.lfathers;
+    r.fathers <-Intset.add t r.fathers
 
-  let pac_map uf i=
-    (get_representative uf i).constructors  
+let add_rfather uf i t=
+  let r=get_representative uf i in
+    r.nfathers<-r.nfathers+1;
+    r.fathers <-Intset.add t r.fathers
 
-  let pac_arity uf i sg=
-    (PacMap.find sg (get_representative uf i).constructors).arity
+exception Discriminable of int * pa_constructor * int * pa_constructor 
 
-  let add_node_pac uf i sg j=
-    let node=Hashtbl.find uf.map i in
-      if not (PacMap.mem sg node.node_constr) then
-	node.node_constr<-PacMap.add sg j node.node_constr 
-  
-  let mem_node_pac uf i sg= 
-    PacMap.find sg (Hashtbl.find uf.map i).node_constr
-  
-  exception Discriminable of int * int * int * int * t 
-
-  let add_pacs uf i pacs =
-    let rep=get_representative uf i in
-    let pending=ref [] and combine=ref [] in 
-    let add_pac sg pac=
-      try  
-	let opac=PacMap.find sg rep.constructors in
-	  if (snd sg)>0 then () else
-	    let tk=pac.term_head 
-	    and tl=opac.term_head in
-	    let rec f n lk ll q=
-	      if n > 0 then match (lk,ll) with
-		  k::qk,l::ql->
-		    let eq=
-		      {lhs=k;rhs=l;rule=Injection(tk,tl,pac.head_constr,n)} 
-		    in f (n-1) qk ql (eq::q) 
-		| _-> anomaly 
-		    "add_pacs : weird error in injection subterms merge"
-	      else q in
- 	      combine:=f pac.nhyps pac.args opac.args !combine
-      with Not_found -> (* Still Unknown Constructor *)
-	rep.constructors <- PacMap.add sg pac rep.constructors;
-	pending:=
-	    (fathers uf (find uf pac.term_head)) @rep.fathers@ !pending;
-	let (c,a)=sg in
-	  if a=0 then
-	    let (ind,_)=get_constructor uf c in  
-	      try
-		let th2,hc2=IndMap.find ind rep.inductives in
-		  raise (Discriminable (pac.term_head,c,th2,hc2,uf)) 
-	      with Not_found ->
-		rep.inductives<-
-		IndMap.add ind (pac.term_head,c) rep.inductives in
-      PacMap.iter add_pac pacs;
-      !pending,!combine
+let append_pac t p =
+  {p with arity=pred p.arity;args=t::p.args} 
+
+let tail_pac p=
+  {p with arity=succ p.arity;args=List.tl p.args}
+    
+let add_pac rep pac t =
+  if not (PacMap.mem pac rep.constructors) then
+    rep.constructors<-PacMap.add pac t rep.constructors
+
+let term uf i=uf.map.(i).term
+		
+let subterms uf i=
+  match uf.map.(i).vertex with
+      Node(j,k) -> (j,k)
+    | _ -> anomaly "subterms: not a node"
 	
-  let term uf i=(Hashtbl.find uf.map i).term
-		  
-  let subterms uf i=
-    match (Hashtbl.find uf.map i).vertex with
-	Node(j,k) -> (j,k)
-      | _ -> anomaly "subterms: not a node"
-
-  let signature uf i=
-    let j,k=subterms uf i in (find uf j,find uf k)
-
-  let nodes uf=  (* cherche les noeuds binaires *)
-    Hashtbl.fold 
-      (fun i node l->
-	 match node.vertex with 
-	     Node (_,_)->i::l
-	   | _ ->l) uf.map [] 
-
-  let next uf=
-    let n=uf.size in uf.size<-n+1; n
+let signature uf i=
+  let j,k=subterms uf i in (find uf j,find uf k)
+			     
+let next uf=
+  let size=uf.size in
+  let nsize= succ size in
+    if nsize=uf.max_size then
+      let newmax=uf.max_size * 3 / 2 + 1 in
+      let newmap=Array.create newmax dummy_node in
+	begin
+	  uf.max_size<-newmax;
+	  Array.blit uf.map 0 newmap 0 size;
+	  uf.map<-newmap
+	end 
+    else ();
+    uf.size<-nsize; 
+    size
 	
-  let new_representative pm im=
-    {nfathers=0;
-     fathers=[];
-     constructors=pm;
-     inductives=im}
-
-  let rec add uf t= 
+let new_representative ()=
+  {nfathers=0;
+   lfathers=Intset.empty;
+   fathers=Intset.empty;
+   inductive_status=Unknown;
+   constructors=PacMap.empty}
+    
+let rec add_term state t= 
+  let uf=state.uf in
     try Hashtbl.find uf.syms t with 
 	Not_found ->
 	  let b=next uf in
 	  let new_node=
 	    match t with
-		Symb s -> 
-		  {clas=Rep (new_representative PacMap.empty IndMap.empty);
-		   vertex=Leaf;term=t;node_constr=PacMap.empty}
+		Symb _ | Eps -> 
+		  {clas= Rep (new_representative ());
+		   cpath= -1;
+		   vertex= Leaf;
+		   term= t}
 	      | Appli (t1,t2) -> 
-		  let i1=add uf t1 and i2=add uf t2 in
-		    add_father uf (find uf i1) b;
-		    add_father uf (find uf i2) b;
-		    {clas=Rep (new_representative PacMap.empty IndMap.empty);
-		     vertex=Node(i1,i2);term=t;node_constr=PacMap.empty}
-	      | Constructor (c,a,n) ->
-		  let pacs=
-		    PacMap.add (b,a) 
-		      {head_constr=b;arity=a;nhyps=n;args=[];term_head=b} 
-		      PacMap.empty in
-		  let inds=
-		    if a=0 then
-		      let (ind,_)=c in
-			IndMap.add ind (b,b) IndMap.empty 
-		    else IndMap.empty in
-		    {clas=Rep (new_representative pacs inds);
-		     vertex=Leaf;term=t;node_constr=PacMap.empty}
+		  let i1=add_term state t1 and i2=add_term state t2 in
+		    add_lfather uf (find uf i1) b;
+		    add_rfather uf (find uf i2) b;
+		    state.terms<-Intset.add b state.terms;
+		    {clas= Rep (new_representative ());
+		     cpath= -1;
+		     vertex= Node(i1,i2);
+		     term= t}
+	      | Constructor cinfo ->
+		  let pac =
+		    {cnode= b;
+		     arity= cinfo.ci_arity;
+		     args=[]} in
+		    Queue.add (b,pac) state.marks;
+		    {clas=Rep (new_representative ());
+		     cpath= -1;
+		     vertex=Leaf;
+		     term=t}
 	  in
-	    Hashtbl.add uf.map b new_node;
+	    uf.map.(b)<-new_node;
 	    Hashtbl.add uf.syms t b;
 	    b
 
-  let link uf i j eq= (* links i -> j *)
-    let node=Hashtbl.find uf.map i in 
-      Hashtbl.replace uf.map i {node with clas=Eqto (j,eq)}
-	      
-  let union uf i1 i2 eq=
-    let r1= get_representative uf i1 
-    and r2= get_representative uf i2 in
-      link uf i1 i2 eq;
-      r2.nfathers<-r1.nfathers+r2.nfathers;
-      r2.fathers<-r1.fathers@r2.fathers;
-      add_pacs uf i2 r1.constructors 
+let add_equality state id 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)
+
+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 link uf i j eq = (* links i -> j *)
+  let node=uf.map.(i) in 
+    node.clas<-Eqto (j,eq);
+    node.cpath<-j
 	
-  let rec down_path uf i l=
-    match (Hashtbl.find uf.map i).clas with
-	Eqto(j,t)->down_path uf j (((i,j),t)::l)
-      | Rep _ ->l
-
-  let rec min_path=function
-      ([],l2)->([],l2)
-    | (l1,[])->(l1,[])
-    | (((c1,t1)::q1),((c2,t2)::q2)) when c1=c2 -> min_path (q1,q2) 
-    | cpl -> cpl
+let rec down_path uf i l=
+  match uf.map.(i).clas with
+      Eqto(j,t)->down_path uf j (((i,j),t)::l)
+    | Rep _ ->l
 	
-  let join_path uf i j=
-    assert (find uf i=find uf j);
-    min_path (down_path uf i [],down_path uf j [])
+let rec min_path=function
+    ([],l2)->([],l2)
+  | (l1,[])->(l1,[])
+  | (((c1,t1)::q1),((c2,t2)::q2)) when c1=c2 -> min_path (q1,q2) 
+  | cpl -> cpl
       
-end    
-    
-let rec combine_rec uf=function 
-    []->[]
-  | t::pending->
-      let combine=combine_rec uf pending in
-      let s=UF.signature uf t in
-      let u=snd (UF.subterms uf t) in
-      let f (c,a) pac pacs=
-	if a=0 then pacs else 
-	  let sg=(c,a-1) in
-	    UF.add_node_pac uf t sg pac.term_head;
-	    PacMap.add sg {pac with args=u::pac.args;term_head=t} pacs
-      in
-      let pacs=PacMap.fold f (UF.pac_map uf (fst s)) PacMap.empty in
-      let i=UF.find uf t in
-      let (p,c)=UF.add_pacs uf i pacs in
-      let combine2=(combine_rec uf p)@c@combine in
-      try {lhs=t;rhs=ST.query s uf.UF.sigtable;rule=Congruence}::combine2 with
-	Not_found->
-	  ST.enter t s uf.UF.sigtable;combine2
-	    
-let rec process_rec uf=function
-    []->[] 
-  | eq::combine->
-      let pending=process_rec uf combine in
-      let i=UF.find uf eq.lhs 
-      and j=UF.find uf eq.rhs in
-      if i=j then
-	pending
+let join_path uf i j=
+  assert (find uf i=find uf j);
+  min_path (down_path uf i [],down_path uf j [])
+
+let union state i1 i2 eq=
+  debug msgnl (str "Linking " ++ int i1 ++ str " and " ++ int i2 ++ str ".");
+  let r1= get_representative state.uf i1 
+  and r2= get_representative state.uf i2 in
+    link state.uf i1 i2 eq;
+    let f= Intset.union r1.fathers r2.fathers in
+      r2.nfathers<-Intset.cardinal f;
+      r2.fathers<-f;
+      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;
+      match r1.inductive_status,r2.inductive_status with 
+	  Unknown,_ -> ()
+	| Partial pac,Unknown -> 
+	    r2.inductive_status<-Partial pac;
+	    state.pa_classes<-Intset.remove i1 state.pa_classes;
+	    state.pa_classes<-Intset.add i2 state.pa_classes
+	| Partial _ ,(Partial _ |Partial_applied) -> 
+	    state.pa_classes<-Intset.remove i1 state.pa_classes
+	| Partial_applied,Unknown -> 
+	    r2.inductive_status<-Partial_applied	      
+	| Partial_applied,Partial _ -> 
+	    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    
+	| _,_ -> () 
+            
+let merge eq state = (* merge and no-merge *)
+  debug msgnl 
+    (str "Merging " ++ int eq.lhs ++ str " and " ++ int eq.rhs ++ str ".");
+  let uf=state.uf in
+  let i=find uf eq.lhs 
+  and j=find uf eq.rhs in
+    if i<>j then 
+      if (size uf i)<(size uf j) then
+	union state i j eq
       else
-	if (UF.size uf i)<(UF.size uf j) then
-	  let l=UF.fathers uf i in
-	  let (p,c)=UF.union uf i j eq in
-	  let _ =ST.delete_list l uf.UF.sigtable in
-	  let inj_pending=process_rec uf c in
-	    inj_pending@p@l@pending
+	union state j i (swap eq)
+
+let update t state = (* update 1 and 2 *)
+  debug msgnl 
+    (str "Updating term " ++ int t ++ str ".");
+  let (i,j) as sign = signature state.uf t in
+  let (u,v) = subterms state.uf t in
+  let rep = get_representative state.uf i in
+    begin
+      match rep.inductive_status with 
+	  Partial _ ->
+	    rep.inductive_status <- Partial_applied;
+	    state.pa_classes <- Intset.remove i state.pa_classes
+	| _ -> ()
+    end;
+    PacMap.iter 
+      (fun pac _ -> Queue.add (t,append_pac v pac) state.marks) 
+      rep.constructors; 
+    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
+    match rep.inductive_status with
+	Total (s,opac) ->
+	  if pac.cnode <> opac.cnode then (* Conflict *) 
+	    raise (Discriminable (s,opac,t,pac)) 
+	  else (* Match *)
+	    let cinfo = get_constructor_info state.uf pac.cnode in
+	    let rec f n oargs args=
+	      if n > 0 then 
+		match (oargs,args) with
+		    s1::q1,s2::q2->
+		      Queue.add 
+			{lhs=s1;rhs=s2;rule=Injection(s,opac,t,pac,n)}
+			state.combine;
+		      f (n-1) q1 q2 
+		  | _-> anomaly 
+		      "add_pacs : weird error in injection subterms merge" 
+	    in f cinfo.ci_nhyps opac.args pac.args
+      | Partial_applied | Partial _ ->
+	  add_pac rep pac t;
+	  state.terms<-Intset.union rep.lfathers state.terms
+      | Unknown ->
+	  if pac.arity = 0 then
+	    rep.inductive_status <- Total (t,pac)
+	  else
+	    begin
+	      add_pac rep pac t;
+	      state.terms<-Intset.union rep.lfathers state.terms;
+	      rep.inductive_status <- Partial pac;
+	      state.pa_classes<- Intset.add i state.pa_classes
+	    end
+
+type explanation =
+    Discrimination of (int*pa_constructor*int*pa_constructor)
+  | Contradiction of disequality
+  | Incomplete
+
+let check_disequalities state =
+  let uf=state.uf in
+  let rec check_aux = function
+      dis::q -> 
+	debug msg 
+	(str "Checking if " ++ int dis.lhs ++ str " = " ++ 
+	 int dis.rhs ++ str " ... ");  
+	if find uf dis.lhs=find uf dis.rhs then 
+	  begin debug msgnl (str "Yes");Some dis end 
 	else
-	  let l=UF.fathers uf j in
-	  let (p,c)=UF.union uf j i (swap eq) in
-	  let _ =ST.delete_list l uf.UF.sigtable in
-	  let inj_pending=process_rec uf c in
-	    inj_pending@p@l@pending
-	  
-let rec cc_rec uf=function
-    []->()
-  | pending->
-      let combine=combine_rec uf pending in
-      let pending0=process_rec uf combine in
-	cc_rec uf pending0
-	
-let cc uf=cc_rec uf (UF.nodes uf)
-
-let rec make_uf=function
-    []->UF.empty ()
-  | (ax,(t1,t2))::q->
-      let uf=make_uf q in
-      let i1=UF.add uf t1 in
-      let i2=UF.add uf t2 in
-      let j1=UF.find uf i1 and j2=UF.find uf i2 in
-	if j1=j2 then uf else  
-	    let (_,inj_combine)=
-		UF.union uf j1 j2 {lhs=i1;rhs=i2;rule=Axiom ax} in
-	    let _ = process_rec uf inj_combine in uf
-      
-let add_one_diseq uf (t1,t2)=(UF.add uf t1,UF.add uf t2)
-
-let add_disaxioms uf disaxioms=
-  let f (id,cpl)=(id,add_one_diseq uf cpl) in
-    List.map f disaxioms
-
-let check_equal uf (i1,i2) = UF.find uf i1 = UF.find uf i2
-
-let find_contradiction uf diseq =
-  List.find (fun (id,cpl) -> check_equal uf cpl) diseq
- 
+	  begin debug msgnl (str "No");check_aux q end
+    | [] -> None 
+  in
+    check_aux state.diseq
+
+let one_step state =
+    try
+      let eq = Queue.take state.combine in
+	merge eq state
+    with Queue.Empty -> 
+      try 
+	let (t,m) = Queue.take state.marks in
+	  process_mark t m state
+      with Queue.Empty ->
+	  let t = Intset.choose state.terms in
+	    state.terms<-Intset.remove t state.terms;
+	    update t state
+
+let complete_one_class state i=
+  match (get_representative state.uf i).inductive_status with
+      Partial pac ->
+	let rec app t n = 
+	  if n<=0 then t else
+	    app (Appli(t,Eps)) (n-1) in
+	  state.uf.epsilons <- pac :: state.uf.epsilons; 
+	  ignore (add_term state (app (term state.uf i) pac.arity))
+    | _ -> anomaly "wrong incomplete class" 
+
+let complete state =
+  Intset.iter (complete_one_class state) state.pa_classes
+
+let rec execute first_run state =
+  debug msgnl (str "Executing ... ");
+  try
+    while true do 
+      one_step state
+    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
+		else
+		  Incomplete
+	      end
 
diff --git a/contrib/cc/ccalgo.mli b/contrib/cc/ccalgo.mli
index 47cdb3ea..74132811 100644
--- a/contrib/cc/ccalgo.mli
+++ b/contrib/cc/ccalgo.mli
@@ -6,15 +6,109 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ccalgo.mli,v 1.6.2.1 2004/07/16 19:29:58 herbelin Exp $ *)
+(* $Id: ccalgo.mli 7298 2005-08-17 12:56:38Z corbinea $ *)
 
-type pa_constructor
-    (*{head: int; arity: int; args: (int * int) list}*)
+open Util
+open Term
+open Names
 
-module PacMap:Map.S with type key=int * int 
+type cinfo =
+    {ci_constr: constructor; (* inductive type *)
+     ci_arity: int;     (* # args *)
+     ci_nhyps: int}     (* # projectable args *)
+
+type term =
+    Symb of constr
+  | Eps
+  | Appli of term*term
+  | Constructor of cinfo (* constructor arity + nhyps *)
+
+type pa_constructor =
+    { cnode : int;
+      arity : int;
+      args  : int list}
+
+module PacMap : Map.S with type key = pa_constructor  
+
+type forest
+
+type state 
+
+type rule=
+    Congruence
+  | Axiom of identifier * bool 
+  | Injection of int * pa_constructor * int * pa_constructor * int
+
+type from=
+    Goal
+  | Hyp of identifier
+  | HeqG of identifier
+  | HeqnH of identifier * identifier
+
+type 'a eq = {lhs:int;rhs:int;rule:'a}
+
+type equality = rule eq
+
+type disequality = from eq
+
+type explanation =
+    Discrimination of (int*pa_constructor*int*pa_constructor)
+  | Contradiction of disequality
+  | Incomplete
+
+val debug : (Pp.std_ppcmds -> unit) -> Pp.std_ppcmds -> unit
+
+val forest : state -> forest
+
+val axioms : forest -> (identifier, term * term) Hashtbl.t
+
+val epsilons : forest -> pa_constructor list
+
+val empty : unit -> state
+
+val add_term : state -> term -> int
+
+val add_equality : state -> identifier -> term -> term -> unit
+
+val add_disequality : state -> from -> term -> term -> unit
+
+val tail_pac : pa_constructor -> pa_constructor
+
+val find : forest -> int -> int
+
+val find_pac : forest -> int -> pa_constructor -> int
+
+val term : forest -> int -> term
+
+val get_constructor_info : forest -> int -> cinfo
+
+val subterms : forest -> int -> int * int
+
+val join_path : forest -> int -> int -> 
+  ((int * int) * equality) list * ((int * int) * equality) list
+
+val execute : bool -> state -> explanation option
+
+
+
+
+
+
+
+
+
+
+
+
+
+(*type pa_constructor
+
+
+module PacMap:Map.S with type key=pa_constructor
 
 type term = 
     Symb of Term.constr 
+  | Eps
   | Appli of term * term 
   | Constructor of Names.constructor*int*int
 
@@ -79,6 +173,6 @@ val check_equal : UF.t -> int * int -> bool
 val find_contradiction : UF.t -> 
   (Names.identifier * (int * int)) list -> 
   (Names.identifier * (int * int))
-
+*)
 
 
diff --git a/contrib/cc/ccproof.ml b/contrib/cc/ccproof.ml
index fa525e65..1200dc2e 100644
--- a/contrib/cc/ccproof.ml
+++ b/contrib/cc/ccproof.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ccproof.ml,v 1.8.2.1 2004/07/16 19:29:58 herbelin Exp $ *)
+(* $Id: ccproof.ml 7298 2005-08-17 12:56:38Z corbinea $ *)
 
 (* This file uses the (non-compressed) union-find structure to generate *) 
 (* proof-trees that will be transformed into proof-terms in cctac.ml4   *)
@@ -51,8 +51,8 @@ let pcongr=function
 let build_proof uf=
   
   let rec equal_proof i j=
-    if i=j then Refl (UF.term uf i) else 
-      let (li,lj)=UF.join_path uf i j in
+    if i=j then Refl (term uf i) else 
+      let (li,lj)=join_path uf i j in
 	ptrans (path_proof i li,psym (path_proof j lj))
   
   and edge_proof ((i,j),eq)=
@@ -60,45 +60,44 @@ let build_proof uf=
     let pj=psym (equal_proof j eq.rhs) in
     let pij=
       match eq.rule with 
-	  Axiom s->Ax s
+	  Axiom (s,reversed)->if reversed then SymAx s else Ax s
 	| Congruence ->congr_proof eq.lhs eq.rhs
-	| Injection (ti,tj,c,a) ->
-	    let p=equal_proof ti tj in
-	    let p1=constr_proof ti ti c 0
-	    and p2=constr_proof tj tj c 0 in
-	      match UF.term uf c with
-		  Constructor (cstr,nargs,nhyps) -> 
-		    Inject(ptrans(psym p1,ptrans(p,p2)),cstr,nhyps,a)
-		| _ -> anomaly "injection on non-constructor terms" 
+	| Injection (ti,ipac,tj,jpac,k) ->
+	    let p=ind_proof ti ipac tj jpac in
+	    let cinfo= get_constructor_info uf ipac.cnode in
+	      Inject(p,cinfo.ci_constr,cinfo.ci_nhyps,k)	
     in  ptrans(ptrans (pi,pij),pj)
 
-  and constr_proof i j c n=
-    try
-      let nj=UF.mem_node_pac uf j (c,n) in
-      let (ni,arg)=UF.subterms uf j in 
-      let p=constr_proof ni nj c (n+1) in
-      let targ=UF.term uf arg in 
-	ptrans (equal_proof i j, pcongr (p,Refl targ))
-    with Not_found->equal_proof i j
+  and constr_proof i t ipac=
+    if ipac.args=[] then
+      equal_proof i t
+    else
+      let npac=tail_pac ipac in
+      let (j,arg)=subterms uf t in
+      let targ=term uf arg in
+      let rj=find uf j in
+      let u=find_pac uf rj npac in
+      let p=constr_proof j u npac in
+	ptrans (equal_proof i t, pcongr (p,Refl targ))
 
   and path_proof i=function
-      [] -> Refl (UF.term uf i)
+      [] -> Refl (term uf i)
     | x::q->ptrans (path_proof (snd (fst x)) q,edge_proof x)
   
   and congr_proof i j=
-    let (i1,i2) = UF.subterms uf i
-    and (j1,j2) = UF.subterms uf j in   
+    let (i1,i2) = subterms uf i
+    and (j1,j2) = subterms uf j in   
       pcongr (equal_proof i1 j1, equal_proof i2 j2)
 	
-  and discr_proof i ci j cj=
+  and ind_proof i ipac j jpac=
     let p=equal_proof i j 
-    and p1=constr_proof i i ci 0 
-    and p2=constr_proof j j cj 0 in
+    and p1=constr_proof i i ipac 
+    and p2=constr_proof j j jpac in
       ptrans(psym p1,ptrans(p,p2))
   in
     function
-	`Prove_goal (i,j) | `Refute_hyp (i,j) -> equal_proof i j
-      | `Discriminate (i,ci,j,cj)-> discr_proof i ci j cj
+	`Prove (i,j) -> equal_proof i j
+      | `Discr (i,ci,j,cj)-> ind_proof i ci j cj
 
 let rec nth_arg t n=
   match t with 
@@ -110,8 +109,8 @@ let rec nth_arg t n=
 
 let rec type_proof axioms p=
   match p with
-      Ax s->List.assoc s axioms
-    | SymAx s-> let (t1,t2)=List.assoc s axioms in (t2,t1)
+      Ax s->Hashtbl.find axioms s
+    | SymAx s-> let (t1,t2)=Hashtbl.find axioms s in (t2,t1)
     | Refl t-> t,t
     | Trans (p1,p2)->
 	let (s1,t1)=type_proof axioms p1 
@@ -125,33 +124,3 @@ let rec type_proof axioms p=
 	let (ti,tj)=type_proof axioms p in
 	  nth_arg ti (n-a),nth_arg tj (n-a)
 
-let by_contradiction uf diseq axioms disaxioms= 
-  try 
-    let id,cpl=find_contradiction uf diseq in
-    let prf=build_proof uf (`Refute_hyp cpl) in
-      if List.assoc id disaxioms=type_proof axioms prf then
-	`Refute_hyp (id,prf)
-      else 
-	anomaly "wrong proof generated"
-  with Not_found ->
-    errorlabstrm  "Congruence" (Pp.str "I couldn't solve goal")  
-
-let cc_proof axioms disaxioms glo=
-  try
-    let uf=make_uf axioms in
-    let diseq=add_disaxioms uf disaxioms in
-      match glo with 
-	  Some cpl ->
-	    let goal=add_one_diseq uf cpl in cc uf;
-	      if check_equal uf goal then 
-		let prf=build_proof uf (`Prove_goal goal) in
-		  if cpl=type_proof axioms prf then
-		    `Prove_goal prf
-		  else anomaly "wrong proof generated"
-	      else by_contradiction uf diseq axioms disaxioms  
-	| None -> cc uf; by_contradiction uf diseq axioms disaxioms
-    with UF.Discriminable (i,ci,j,cj,uf) ->
-      let prf=build_proof uf (`Discriminate (i,ci,j,cj)) in 
-	`Discriminate (UF.get_constructor uf ci,prf) 
-
-
diff --git a/contrib/cc/ccproof.mli b/contrib/cc/ccproof.mli
index 887ed070..18c745bf 100644
--- a/contrib/cc/ccproof.mli
+++ b/contrib/cc/ccproof.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ccproof.mli,v 1.6.2.1 2004/07/16 19:29:59 herbelin Exp $ *)
+(* $Id: ccproof.mli 7298 2005-08-17 12:56:38Z corbinea $ *)
 
 open Ccalgo
 open Names
@@ -19,27 +19,12 @@ type proof =
   | Congr of proof * proof
   | Inject of proof * constructor * int * int
 
-val pcongr : proof * proof -> proof
-val ptrans : proof * proof -> proof
-val psym : proof -> proof
-val pcongr : proof * proof -> proof
-
 val build_proof : 
-  UF.t -> 
-  [ `Discriminate of int * int * int * int
-  | `Prove_goal of int * int
-  | `Refute_hyp of int * int ]
-  -> proof
+  forest -> 
+  [ `Discr of int * pa_constructor * int * pa_constructor
+  | `Prove of int * int ] -> proof
 
 val type_proof :
-  (identifier * (term * term)) list -> proof -> term * term
-
-val cc_proof :
-  (identifier * (term * term)) list ->
-  (identifier * (term * term)) list ->
-  (term * term) option ->
-  [ `Discriminate of constructor * proof
-  | `Prove_goal of proof
-  | `Refute_hyp of identifier * proof ]
+  (identifier, (term * term)) Hashtbl.t -> proof -> term * term
 
 
diff --git a/contrib/cc/cctac.ml b/contrib/cc/cctac.ml
new file mode 100644
index 00000000..4a719f38
--- /dev/null
+++ b/contrib/cc/cctac.ml
@@ -0,0 +1,336 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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 camlp4deps: "parsing/grammar.cma" i*)
+
+(* $Id: cctac.ml 7909 2006-01-21 11:09:18Z herbelin $ *)
+
+(* This file is the interface between the c-c algorithm and Coq *)
+
+open Evd
+open Proof_type
+open Names
+open Libnames
+open Nameops
+open Inductiveops
+open Declarations
+open Term
+open Termops
+open Tacmach
+open Tactics
+open Tacticals
+open Ccalgo
+open Tacinterp
+open Ccproof
+open Pp
+open Util
+open Format
+
+let constant dir s = lazy (Coqlib.gen_constant "CC" dir s)
+
+let _f_equal = constant ["Init";"Logic"] "f_equal"
+
+let _eq_rect = constant ["Init";"Logic"] "eq_rect"
+
+let _eq = constant ["Init";"Logic"] "eq"
+
+let _False = constant ["Init";"Logic"] "False"
+
+(* decompose member of equality in an applicative format *)
+
+let whd env=
+  let infos=Closure.create_clos_infos Closure.betaiotazeta env in
+    (fun t -> Closure.whd_val infos (Closure.inject t))
+
+let whd_delta env=
+   let infos=Closure.create_clos_infos Closure.betadeltaiota env in
+    (fun t -> Closure.whd_val infos (Closure.inject t))
+
+let rec decompose_term env t=
+    match kind_of_term (whd env t) with
+      App (f,args)->
+	let tf=decompose_term env f in
+	let targs=Array.map (decompose_term env) args in
+	  Array.fold_left (fun s t->Appli (s,t)) tf targs
+    | Construct c->
+	let (oib,_)=Global.lookup_inductive (fst c) in
+	let nargs=mis_constructor_nargs_env env c in
+	  Constructor {ci_constr=c;
+		       ci_arity=nargs;
+		       ci_nhyps=nargs-oib.mind_nparams}
+    | _ ->(Symb t)
+	
+(* decompose equality in members and type *)
+	
+let atom_of_constr env term =
+  let wh =  (whd_delta env term) in
+  let kot = kind_of_term wh in 
+    match kot with
+      App (f,args)->
+	  if eq_constr f (Lazy.force _eq) && (Array.length args)=3 
+	  then `Eq (args.(0),
+		   decompose_term env args.(1), 
+		   decompose_term env args.(2)) 
+	  else `Other (decompose_term env term)
+    | _ -> `Other (decompose_term env term)
+
+let rec 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
+	
+(* 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 env=pf_env gls in
+  let state = empty () in
+  let pos_hyps = ref [] in
+  let neg_hyps =ref [] in
+    List.iter
+      (fun c ->
+	 let t = decompose_term env c in
+	   ignore (add_term state t)) additionnal_terms; 
+    List.iter 
+      (fun (id,_,e) ->
+	 begin
+	   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
+	     | `Other ph ->
+		 List.iter 
+		   (fun (idn,nh) -> 
+		      add_disequality state (HeqnH (id,idn)) ph nh) 
+		   !neg_hyps;
+		 pos_hyps:=(id,ph):: !pos_hyps
+	     | `Nother nh ->
+		 List.iter 
+		   (fun (idp,ph) -> 
+		      add_disequality state (HeqnH (idp,id)) ph nh) 
+		   !pos_hyps;
+		 neg_hyps:=(id,nh):: !neg_hyps
+	 end) (Environ.named_context_of_val gls.it.evar_hyps);
+    begin
+      match atom_of_constr env gls.it.evar_concl with
+	  `Eq (t,a,b) -> add_disequality state Goal a b
+	|	`Other g ->  
+		  List.iter 
+	      (fun (idp,ph) -> 
+		 add_disequality state (HeqG idp) ph g) !pos_hyps
+    end;
+    state
+
+(* indhyps builds the array of arrays of constructor hyps for (ind largs) *)
+
+let build_projection intype outtype (cstr:constructor) special default gls=
+  let env=pf_env gls in 
+  let (h,argv) = 
+    try destApp intype with 
+	Invalid_argument _ -> (intype,[||])  in
+  let ind=destInd h in 
+  let types=Inductiveops.arities_of_constructors env ind in
+  let lp=Array.length types in
+  let ci=(snd cstr)-1 in
+  let branch i=
+    let ti=Term.prod_appvect types.(i) argv in
+    let rc=fst (Sign.decompose_prod_assum ti) in
+    let head=
+      if i=ci then special else default in  
+      Sign.it_mkLambda_or_LetIn head rc in
+  let branches=Array.init lp branch in
+  let casee=mkRel 1 in
+  let pred=mkLambda(Anonymous,intype,outtype) in
+  let case_info=make_default_case_info (pf_env gls) RegularStyle ind in
+  let body= mkCase(case_info, pred, casee, branches) in
+  let id=pf_get_new_id (id_of_string "t") gls in     
+    mkLambda(Name id,intype,body)
+  
+(* 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
+      (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 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
+	let appx1=mkLambda(Name id,typf,mkApp(mkRel 1,[|tx1|])) in
+	let lemma1=
+	  mkApp(Lazy.force _f_equal,[|typf;typfx;appx1;tf1;tf2|])
+	and lemma2=
+	  mkApp(Lazy.force _f_equal,[|typx;typfx;tf2;tx1;tx2|]) in
+	  (tclTHENS (transitivity (mkApp(tf2,[|tx1|])))
+	     [tclTHEN (apply lemma1) (proof_tac axioms p1);
+  	      tclFIRST
+		[tclTHEN (apply lemma2) (proof_tac axioms p2);
+		 reflexivity;
+		 fun gls ->
+		   errorlabstrm  "Congruence" 
+		   (Pp.str 
+		      "I don't know how to handle dependent equality")]]
+	     gls)
+  | Inject (prf,cstr,nargs,argind)  as gprf->
+      (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 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 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 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
+    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 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
+    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 h=pf_get_new_id (id_of_string "H") gls in
+  let false_t=mkApp (mkVar id2,[|mkVar h|]) in
+    tclTHENS (true_cut (Name h) tt2)
+      [convert_to_goal_tac axioms id1 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 intype=pf_type_of gls tt1 in
+  let concl=pf_concl gls in
+  let outsort=mkType (new_univ ()) in
+  let xid=pf_get_new_id (id_of_string "X") gls in
+  let tid=pf_get_new_id (id_of_string "t") gls in
+  let identity=mkLambda(Name xid,outsort,mkLambda(Name tid,mkRel 1,mkRel 1)) in
+  let trivial=pf_type_of gls identity in
+  let outtype=mkType (new_univ ()) in
+  let pred=mkLambda(Name xid,outtype,mkRel 1) in
+  let hid=pf_get_new_id (id_of_string "Heq") gls in     
+  let proj=build_projection intype outtype cstr trivial concl gls in
+  let injt=mkApp (Lazy.force _f_equal,
+		  [|intype;outtype;proj;tt1;tt2;mkVar hid|]) in   
+  let endt=mkApp (Lazy.force _eq_rect,
+		  [|outtype;trivial;pred;identity;concl;injt|]) in
+  let neweq=mkApp(Lazy.force _eq,[|intype;tt1;tt2|]) in
+    tclTHENS (true_cut (Name hid) neweq) 
+      [proof_tac axioms p;exact_check endt] gls
+      
+(* wrap everything *)
+	
+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 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=
+  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 _ = debug Pp.msgnl (Pp.str "Problem built, solving ...") in
+  let sol = execute true state in
+  let _ = debug Pp.msgnl (Pp.str "Computation completed.") in
+  let uf=forest state in
+    match sol with
+	None -> tclFAIL 0 (str "congruence failed") gls  
+      | Some reason ->
+	  debug Pp.msgnl (Pp.str "Goal solved, generating proof ...");
+	  match reason with
+	      Discrimination (i,ipac,j,jpac) ->
+		let p=build_proof uf (`Discr (i,ipac,j,jpac)) in	  
+		let cstr=(get_constructor_info uf ipac.cnode).ci_constr in
+		  discriminate_tac (axioms uf) cstr p gls
+	    | Incomplete ->
+		let metacnt = ref 0 in
+		let newmeta _ = incr metacnt; mkMeta !metacnt in
+		let terms_to_complete = 
+		  List.map 
+		    (build_term_to_complete uf newmeta) 
+		    (epsilons uf) in 
+		  Pp.msgnl
+		    (Pp.str "Goal is solvable by congruence but \
+ some arguments are missing.");
+		  Pp.msgnl
+		    (Pp.str "  Try " ++
+		     hov 8
+		       begin 
+			 str "\"congruence with (" ++  
+			 prlist_with_sep 
+			   (fun () -> str ")" ++ pr_spc () ++ str "(")
+			   (print_constr_env (pf_env gls))
+			   terms_to_complete ++ 
+			 str ")\","
+		       end);
+		  Pp.msgnl
+		    (Pp.str "  replacing metavariables by arbitrary terms.");
+		  tclFAIL 0 (str "Incomplete") gls
+	    | Contradiction dis ->
+		let p=build_proof uf (`Prove (dis.lhs,dis.rhs)) in
+		let ta=term uf dis.lhs and tb=term uf dis.rhs in
+		let axioms = axioms uf in 
+		  match dis.rule with
+		      Goal -> proof_tac axioms p gls
+		    | Hyp id -> refute_tac axioms id ta tb p gls
+		    | HeqG id -> 
+			convert_to_goal_tac axioms id ta tb p gls
+		    | HeqnH (ida,idb) -> 
+			convert_to_hyp_tac axioms ida ta idb tb p gls
+		    
+
+let cc_fail gls =
+  errorlabstrm  "Congruence" (Pp.str "congruence failed.")     
diff --git a/contrib/cc/cctac.ml4 b/contrib/cc/cctac.ml4
deleted file mode 100644
index 49fe46fe..00000000
--- a/contrib/cc/cctac.ml4
+++ /dev/null
@@ -1,247 +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 camlp4deps: "parsing/grammar.cma" i*)
-
-(* $Id: cctac.ml4,v 1.13.2.1 2004/07/16 19:29:59 herbelin Exp $ *)
-
-(* This file is the interface between the c-c algorithm and Coq *)
-
-open Evd
-open Proof_type
-open Names
-open Libnames
-open Nameops
-open Inductiveops
-open Declarations
-open Term
-open Termops
-open Tacmach
-open Tactics
-open Tacticals
-open Ccalgo
-open Tacinterp
-open Ccproof
-open Pp
-open Util
-open Format
-
-exception Not_an_eq
-
-let fail()=raise Not_an_eq
-    
-let constant dir s = lazy (Coqlib.gen_constant "CC" dir s)
-
-let f_equal_theo = constant ["Init";"Logic"] "f_equal"
-
-let eq_rect_theo = constant ["Init";"Logic"] "eq_rect"
-
-(* decompose member of equality in an applicative format *)
-
-let rec decompose_term env t=
-  match kind_of_term t with
-      App (f,args)->
-	let tf=decompose_term env f in
-	let targs=Array.map (decompose_term env) args in
-	  Array.fold_left (fun s t->Appli (s,t)) tf targs
-    | Construct c->
-	let (_,oib)=Global.lookup_inductive (fst c) in
-	let nargs=mis_constructor_nargs_env env c in
-	  Constructor (c,nargs,nargs-oib.mind_nparams)
-    | _ ->(Symb t)
-	
-(* decompose equality in members and type *)
-	
-let rec eq_type_of_term term=
-  match kind_of_term term with
-      App (f,args)->
-	(try 
-	   let ref = reference_of_constr f in
-	     if ref=Coqlib.glob_eq && (Array.length args)=3 
-	     then (true,args.(0),args.(1),args.(2)) 
-	     else 
-	       if ref=(Lazy.force Coqlib.coq_not_ref) && 
-		 (Array.length args)=1 then
-		   let (pol,t,a,b)=eq_type_of_term args.(0) in
-		     if pol then (false,t,a,b) else fail ()
-	       else fail ()
-	 with Not_found -> fail ())
-    | Prod (_,eq,ff) ->
-	(try 
-	   let ref = reference_of_constr ff in
-	     if ref=(Lazy.force Coqlib.coq_False_ref) then
-	       let (pol,t,a,b)=eq_type_of_term eq in
-		 if pol then (false,t,a,b) else fail ()
-	     else fail ()
-	 with Not_found -> fail ())
-    | _ -> fail ()
-	
-(* read an equality *)
-	  
-let read_eq env term=
-  let (pol,_,t1,t2)=eq_type_of_term term in 
-    (pol,(decompose_term env t1,decompose_term env t2))
-
-(* rebuild a term from applicative format *)
-    
-let rec make_term=function
-    Symb s->s
-  | Constructor(c,_,_)->mkConstruct c 
-  | Appli (s1,s2)->
-      make_app [(make_term s2)] s1
-and make_app l=function
-    Symb s->applistc s l
-  | Constructor(c,_,_)->applistc (mkConstruct c) l
-  | Appli (s1,s2)->make_app ((make_term s2)::l) s1
-
-(* store all equalities from the context *)
-	
-let rec read_hyps env=function
-    []->[],[]
-  | (id,_,e)::hyps->let eq,diseq=read_hyps env hyps in
-      try let pol,cpl=read_eq env e in
-	if pol then 
-	  ((id,cpl)::eq),diseq 
-	else 
-	  eq,((id,cpl)::diseq)
-      with Not_an_eq -> eq,diseq
-
-(* build a problem ( i.e. read the goal as an equality ) *)
-	
-let make_prb gl=
-  let env=pf_env gl in
-  let eq,diseq=read_hyps env gl.it.evar_hyps in
-    try
-      let pol,cpl=read_eq env gl.it.evar_concl in
-	if pol then (eq,diseq,Some cpl) else assert false with 
-	    Not_an_eq -> (eq,diseq,None)
-
-(* indhyps builds the array of arrays of constructor hyps for (ind largs) *)
-
-let build_projection intype outtype (cstr:constructor) special default gls=
-  let env=pf_env gls in 
-  let (h,argv) = 
-    try destApplication intype with 
-	Invalid_argument _ -> (intype,[||])  in
-  let ind=destInd h in 
-  let types=Inductive.arities_of_constructors env ind in
-  let lp=Array.length types in
-  let ci=(snd cstr)-1 in
-  let branch i=
-    let ti=Term.prod_appvect types.(i) argv in
-    let rc=fst (Sign.decompose_prod_assum ti) in
-    let head=
-      if i=ci then special else default in  
-      Sign.it_mkLambda_or_LetIn head rc in
-  let branches=Array.init lp branch in
-  let casee=mkRel 1 in
-  let pred=mkLambda(Anonymous,intype,outtype) in
-  let case_info=make_default_case_info (pf_env gls) RegularStyle ind in
-  let body= mkCase(case_info, pred, casee, branches) in
-  let id=pf_get_new_id (id_of_string "t") gls in     
-    mkLambda(Name id,intype,body)
-  
-(* 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
-      (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 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
-	let appx1=mkLambda(Name id,typf,mkApp(mkRel 1,[|tx1|])) in
-	let lemma1=
-	  mkApp(Lazy.force f_equal_theo,[|typf;typfx;appx1;tf1;tf2|])
-	and lemma2=
-	  mkApp(Lazy.force f_equal_theo,[|typx;typfx;tf2;tx1;tx2|]) in
-	  (tclTHENS (transitivity (mkApp(tf2,[|tx1|])))
-	     [tclTHEN (apply lemma1) (proof_tac axioms p1);
-  	      tclFIRST
-		[tclTHEN (apply lemma2) (proof_tac axioms p2);
-		 reflexivity;
-		 fun gls ->
-		   errorlabstrm  "Congruence" 
-		   (Pp.str 
-		      "I don't know how to handle dependent equality")]]
-	     gls)
-  | Inject (prf,cstr,nargs,argind)  as gprf->
-      (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 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 proj=build_projection intype outtype cstr special default gls in
-	 let injt=
-	   mkApp (Lazy.force f_equal_theo,[|intype;outtype;proj;cti;ctj|]) in 
-	   tclTHEN (apply injt) (proof_tac axioms prf) gls)
-
-let refute_tac axioms disaxioms id p gls =      
-  let t1,t2=List.assoc id disaxioms in
-  let tt1=make_term t1 and tt2=make_term t2 in
-  let intype=pf_type_of gls tt1 in
-  let neweq=
-    mkApp(constr_of_reference Coqlib.glob_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
-    tclTHENS (true_cut (Name hid) neweq)
-      [proof_tac axioms 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 intype=pf_type_of gls tt1 in
-  let concl=pf_concl gls in
-  let outsort=mkType (new_univ ()) in
-  let xid=pf_get_new_id (id_of_string "X") gls in
-  let tid=pf_get_new_id (id_of_string "t") gls in
-  let identity=mkLambda(Name xid,outsort,mkLambda(Name tid,mkRel 1,mkRel 1)) in
-  let trivial=pf_type_of gls identity in
-  let outtype=mkType (new_univ ()) in
-  let pred=mkLambda(Name xid,outtype,mkRel 1) in
-  let hid=pf_get_new_id (id_of_string "Heq") gls in     
-  let proj=build_projection intype outtype cstr trivial concl gls in
-  let injt=mkApp (Lazy.force f_equal_theo,
-		  [|intype;outtype;proj;tt1;tt2;mkVar hid|]) in   
-  let endt=mkApp (Lazy.force eq_rect_theo,
-		  [|outtype;trivial;pred;identity;concl;injt|]) in
-  let neweq=mkApp(constr_of_reference Coqlib.glob_eq,[|intype;tt1;tt2|]) in
-    tclTHENS (true_cut (Name hid) neweq) 
-      [proof_tac axioms p;exact_check endt] gls
-      
-(* wrap everything *)
-	
-let cc_tactic gls=
-  Library.check_required_library ["Coq";"Init";"Logic"];
-  let (axioms,disaxioms,glo)=make_prb gls in
-    match (cc_proof axioms disaxioms glo) with
-        `Prove_goal p -> proof_tac axioms p gls
-      | `Refute_hyp (id,p) -> refute_tac axioms disaxioms id p gls
-      | `Discriminate (cstr,p) -> discriminate_tac axioms cstr p gls
-
-(* Tactic registration *)
-      
-TACTIC EXTEND CC
- [ "Congruence" ] -> [ tclSOLVE [tclTHEN (tclREPEAT introf) cc_tactic] ]
-END
-   
diff --git a/theories7/Lists/PolyListSyntax.v b/contrib/cc/cctac.mli
index 15c57166..6082beb6 100644
--- a/theories7/Lists/PolyListSyntax.v
+++ b/contrib/cc/cctac.mli
@@ -6,5 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: PolyListSyntax.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+(* $Id: cctac.mli 7298 2005-08-17 12:56:38Z corbinea $ *)
 
+open Term 
+open Proof_type
+
+val cc_tactic : constr list -> tactic
+
+val cc_fail : tactic
diff --git a/theories7/ZArith/ZArith.v b/contrib/cc/g_congruence.ml4
index e1746433..0bdf7608 100644
--- a/theories7/ZArith/ZArith.v
+++ b/contrib/cc/g_congruence.ml4
@@ -6,17 +6,24 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ZArith.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+(*i camlp4deps: "parsing/grammar.cma" i*)
 
-(** Library for manipulating integers based on binary encoding *)
+(* $Id: g_congruence.ml4 7734 2005-12-26 14:06:51Z herbelin $ *)
 
-Require Export ZArith_base.
+open Cctac
+open Tactics
+open Tacticals
 
-(** Extra modules using [Omega] or [Ring]. *)
-
-Require Export Zcomplements.
-Require Export Zsqrt.
-Require Export Zpower.
-Require Export Zdiv.
-Require Export Zlogarithm.
-Require Export Zbool.
+(* 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]
+END
diff --git a/contrib/correctness/ArrayPermut.v b/contrib/correctness/ArrayPermut.v
index b352045a..30f5ac8f 100644
--- a/contrib/correctness/ArrayPermut.v
+++ b/contrib/correctness/ArrayPermut.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ArrayPermut.v,v 1.3.2.1 2004/07/16 19:29:59 herbelin Exp $ *)
+(* $Id: ArrayPermut.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (****************************************************************************)
 (*                    Permutations of elements in arrays                    *)
diff --git a/contrib/correctness/Arrays.v b/contrib/correctness/Arrays.v
index 1659917a..3a6aaaf8 100644
--- a/contrib/correctness/Arrays.v
+++ b/contrib/correctness/Arrays.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: Arrays.v,v 1.9.2.1 2004/07/16 19:29:59 herbelin Exp $ *)
+(* $Id: Arrays.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (**********************************************)
 (* Functional arrays, for use in Correctness. *)
diff --git a/contrib/correctness/Arrays_stuff.v b/contrib/correctness/Arrays_stuff.v
index 899d7007..a8a2858f 100644
--- a/contrib/correctness/Arrays_stuff.v
+++ b/contrib/correctness/Arrays_stuff.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: Arrays_stuff.v,v 1.2.16.1 2004/07/16 19:29:59 herbelin Exp $ *)
+(* $Id: Arrays_stuff.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Exchange.
 Require Export ArrayPermut.
diff --git a/contrib/correctness/Correctness.v b/contrib/correctness/Correctness.v
index a2ad2f50..b7513d09 100644
--- a/contrib/correctness/Correctness.v
+++ b/contrib/correctness/Correctness.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: Correctness.v,v 1.6.2.1 2004/07/16 19:29:59 herbelin Exp $ *)
+(* $Id: Correctness.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* Correctness is base on the tactic Refine (developped on purpose) *)
 
diff --git a/contrib/correctness/Exchange.v b/contrib/correctness/Exchange.v
index 7dc5218e..035a98f2 100644
--- a/contrib/correctness/Exchange.v
+++ b/contrib/correctness/Exchange.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: Exchange.v,v 1.4.2.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: Exchange.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (****************************************************************************)
 (*                   Exchange of two elements in an array                   *)
diff --git a/contrib/correctness/ProgBool.v b/contrib/correctness/ProgBool.v
index bce19870..38448efc 100644
--- a/contrib/correctness/ProgBool.v
+++ b/contrib/correctness/ProgBool.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ProgBool.v,v 1.4.2.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: ProgBool.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Import ZArith.
 Require Export Bool_nat.
diff --git a/contrib/correctness/ProgInt.v b/contrib/correctness/ProgInt.v
index c26e3553..b1eaaea7 100644
--- a/contrib/correctness/ProgInt.v
+++ b/contrib/correctness/ProgInt.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ProgInt.v,v 1.2.2.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: ProgInt.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export ZArith.
 Require Export ZArith_dec.
diff --git a/contrib/correctness/ProgramsExtraction.v b/contrib/correctness/ProgramsExtraction.v
index 40253f33..5f7dfdbf 100644
--- a/contrib/correctness/ProgramsExtraction.v
+++ b/contrib/correctness/ProgramsExtraction.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ProgramsExtraction.v,v 1.2.16.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: ProgramsExtraction.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Extraction.
 
diff --git a/contrib/correctness/Programs_stuff.v b/contrib/correctness/Programs_stuff.v
index 1ca4b63e..6489de81 100644
--- a/contrib/correctness/Programs_stuff.v
+++ b/contrib/correctness/Programs_stuff.v
@@ -8,6 +8,6 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: Programs_stuff.v,v 1.1.16.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: Programs_stuff.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Arrays_stuff.
diff --git a/contrib/correctness/Sorted.v b/contrib/correctness/Sorted.v
index 2efe54a4..ca4ed880 100644
--- a/contrib/correctness/Sorted.v
+++ b/contrib/correctness/Sorted.v
@@ -8,7 +8,7 @@
 
 (*  Library about sorted (sub-)arrays / Nicolas Magaud, July 1998 *)
 
-(* $Id: Sorted.v,v 1.7.2.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: Sorted.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Arrays.
 Require Import ArrayPermut.
diff --git a/contrib/correctness/Tuples.v b/contrib/correctness/Tuples.v
index e3fff08d..c7071f32 100644
--- a/contrib/correctness/Tuples.v
+++ b/contrib/correctness/Tuples.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: Tuples.v,v 1.2.2.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: Tuples.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* Tuples *)
 
diff --git a/contrib/correctness/examples/Handbook.v b/contrib/correctness/examples/Handbook.v
index 8c983a72..abb1cc76 100644
--- a/contrib/correctness/examples/Handbook.v
+++ b/contrib/correctness/examples/Handbook.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: Handbook.v,v 1.3 2001/04/11 07:56:19 filliatr Exp $ *)
+(* $Id: Handbook.v 1577 2001-04-11 07:56:19Z filliatr $ *)
 
 (* This file contains proofs of programs taken from the
  * "Handbook of Theoretical Computer Science", volume B,
diff --git a/contrib/correctness/examples/exp.v b/contrib/correctness/examples/exp.v
index dcfcec87..3142e906 100644
--- a/contrib/correctness/examples/exp.v
+++ b/contrib/correctness/examples/exp.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(*i $Id: exp.v,v 1.3 2001/04/11 07:56:19 filliatr Exp $ i*)
+(*i $Id: exp.v 1577 2001-04-11 07:56:19Z filliatr $ i*)
 
 (* Efficient computation of X^n using
  * 
diff --git a/contrib/correctness/examples/exp_int.v b/contrib/correctness/examples/exp_int.v
index accd60c2..044263ca 100644
--- a/contrib/correctness/examples/exp_int.v
+++ b/contrib/correctness/examples/exp_int.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: exp_int.v,v 1.4 2001/04/11 07:56:19 filliatr Exp $ *)
+(* $Id: exp_int.v 1577 2001-04-11 07:56:19Z filliatr $ *)
 
 (* Efficient computation of X^n using
  * 
diff --git a/contrib/correctness/examples/fact.v b/contrib/correctness/examples/fact.v
index e480c806..07e77140 100644
--- a/contrib/correctness/examples/fact.v
+++ b/contrib/correctness/examples/fact.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: fact.v,v 1.3 2001/04/11 07:56:19 filliatr Exp $ *)
+(* $Id: fact.v 1577 2001-04-11 07:56:19Z filliatr $ *)
 
 (* Proof of an imperative program computing the factorial (over type nat) *)
 
diff --git a/contrib/correctness/examples/fact_int.v b/contrib/correctness/examples/fact_int.v
index cb2b0460..f463ca80 100644
--- a/contrib/correctness/examples/fact_int.v
+++ b/contrib/correctness/examples/fact_int.v
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: fact_int.v,v 1.3 2001/04/11 07:56:19 filliatr Exp $ *)
+(* $Id: fact_int.v 1577 2001-04-11 07:56:19Z filliatr $ *)
 
 (* Proof of an imperative program computing the factorial (over type Z) *)
 
diff --git a/contrib/correctness/past.mli b/contrib/correctness/past.mli
index 1cc7164e..70328704 100644
--- a/contrib/correctness/past.mli
+++ b/contrib/correctness/past.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: past.mli,v 1.7.6.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: past.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (*s Abstract syntax of imperative programs. *)
 
diff --git a/contrib/correctness/pcic.ml b/contrib/correctness/pcic.ml
index e87ba70c..041cd81f 100644
--- a/contrib/correctness/pcic.ml
+++ b/contrib/correctness/pcic.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pcic.ml,v 1.23.2.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: pcic.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Util
 open Names
diff --git a/contrib/correctness/pcic.mli b/contrib/correctness/pcic.mli
index 89731472..67b152f3 100644
--- a/contrib/correctness/pcic.mli
+++ b/contrib/correctness/pcic.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(*i $Id: pcic.mli,v 1.3.16.1 2004/07/16 19:30:00 herbelin Exp $ i*)
+(*i $Id: pcic.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 open Past
 open Rawterm
diff --git a/contrib/correctness/pcicenv.ml b/contrib/correctness/pcicenv.ml
index cc15c8f3..368d0281 100644
--- a/contrib/correctness/pcicenv.ml
+++ b/contrib/correctness/pcicenv.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pcicenv.ml,v 1.5.14.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: pcicenv.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 open Term
diff --git a/contrib/correctness/pcicenv.mli b/contrib/correctness/pcicenv.mli
index fc4fa0b9..365fa960 100644
--- a/contrib/correctness/pcicenv.mli
+++ b/contrib/correctness/pcicenv.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pcicenv.mli,v 1.2.16.1 2004/07/16 19:30:00 herbelin Exp $ *)
+(* $Id: pcicenv.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Penv
 open Names
diff --git a/contrib/correctness/pdb.ml b/contrib/correctness/pdb.ml
index 302db871..759e9133 100644
--- a/contrib/correctness/pdb.ml
+++ b/contrib/correctness/pdb.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pdb.ml,v 1.8.2.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: pdb.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 open Term
diff --git a/contrib/correctness/pdb.mli b/contrib/correctness/pdb.mli
index a0df29bd..d6e647b7 100644
--- a/contrib/correctness/pdb.mli
+++ b/contrib/correctness/pdb.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pdb.mli,v 1.2.16.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: pdb.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Ptype
 open Past
diff --git a/contrib/correctness/peffect.ml b/contrib/correctness/peffect.ml
index 08d6b002..faf5f3d3 100644
--- a/contrib/correctness/peffect.ml
+++ b/contrib/correctness/peffect.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: peffect.ml,v 1.3.14.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: peffect.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 open Nameops
diff --git a/contrib/correctness/peffect.mli b/contrib/correctness/peffect.mli
index d6d0ce22..9a10dea4 100644
--- a/contrib/correctness/peffect.mli
+++ b/contrib/correctness/peffect.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: peffect.mli,v 1.1.16.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: peffect.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 
diff --git a/contrib/correctness/penv.ml b/contrib/correctness/penv.ml
index 820d1cf0..7f89b1e1 100644
--- a/contrib/correctness/penv.ml
+++ b/contrib/correctness/penv.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: penv.ml,v 1.10.2.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: penv.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pmisc
 open Past
diff --git a/contrib/correctness/penv.mli b/contrib/correctness/penv.mli
index ef2e4c6e..6743b465 100644
--- a/contrib/correctness/penv.mli
+++ b/contrib/correctness/penv.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: penv.mli,v 1.3.8.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: penv.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Ptype
 open Past
diff --git a/contrib/correctness/perror.ml b/contrib/correctness/perror.ml
index 40fe4c98..8415e96d 100644
--- a/contrib/correctness/perror.ml
+++ b/contrib/correctness/perror.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: perror.ml,v 1.9.2.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: perror.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Util
diff --git a/contrib/correctness/perror.mli b/contrib/correctness/perror.mli
index 40b2d25c..45b2acdc 100644
--- a/contrib/correctness/perror.mli
+++ b/contrib/correctness/perror.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: perror.mli,v 1.2.6.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: perror.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Util
diff --git a/contrib/correctness/pextract.ml b/contrib/correctness/pextract.ml
index 2a35d471..407567ad 100644
--- a/contrib/correctness/pextract.ml
+++ b/contrib/correctness/pextract.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pextract.ml,v 1.5.6.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: pextract.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp_control
 open Pp
diff --git a/contrib/correctness/pextract.mli b/contrib/correctness/pextract.mli
index dc5b4124..3492729c 100644
--- a/contrib/correctness/pextract.mli
+++ b/contrib/correctness/pextract.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pextract.mli,v 1.2.16.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: pextract.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 
diff --git a/contrib/correctness/pmisc.ml b/contrib/correctness/pmisc.ml
index aed8c5cb..29d8fdcf 100644
--- a/contrib/correctness/pmisc.ml
+++ b/contrib/correctness/pmisc.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pmisc.ml,v 1.18.2.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: pmisc.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Util
diff --git a/contrib/correctness/pmisc.mli b/contrib/correctness/pmisc.mli
index ec7521cc..9d96467f 100644
--- a/contrib/correctness/pmisc.mli
+++ b/contrib/correctness/pmisc.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pmisc.mli,v 1.9.6.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: pmisc.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 open Term
diff --git a/contrib/correctness/pmlize.ml b/contrib/correctness/pmlize.ml
index f899366d..e812fa57 100644
--- a/contrib/correctness/pmlize.ml
+++ b/contrib/correctness/pmlize.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pmlize.ml,v 1.7.2.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: pmlize.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 open Term
diff --git a/contrib/correctness/pmlize.mli b/contrib/correctness/pmlize.mli
index 95f74ef9..1f8936f0 100644
--- a/contrib/correctness/pmlize.mli
+++ b/contrib/correctness/pmlize.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pmlize.mli,v 1.2.16.1 2004/07/16 19:30:01 herbelin Exp $ *)
+(* $Id: pmlize.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Past
 open Penv
diff --git a/contrib/correctness/pmonad.ml b/contrib/correctness/pmonad.ml
index b8b39353..31effc1b 100644
--- a/contrib/correctness/pmonad.ml
+++ b/contrib/correctness/pmonad.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pmonad.ml,v 1.6.16.1 2004/07/16 19:30:02 herbelin Exp $ *)
+(* $Id: pmonad.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Util
 open Names
diff --git a/contrib/correctness/pmonad.mli b/contrib/correctness/pmonad.mli
index e1400fcb..a46a040e 100644
--- a/contrib/correctness/pmonad.mli
+++ b/contrib/correctness/pmonad.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pmonad.mli,v 1.1.16.1 2004/07/16 19:30:02 herbelin Exp $ *)
+(* $Id: pmonad.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 open Term
diff --git a/contrib/correctness/pred.ml b/contrib/correctness/pred.ml
index 732dcf08..669727fc 100644
--- a/contrib/correctness/pred.ml
+++ b/contrib/correctness/pred.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pred.ml,v 1.6.14.1 2004/07/16 19:30:05 herbelin Exp $ *)
+(* $Id: pred.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Past
diff --git a/contrib/correctness/pred.mli b/contrib/correctness/pred.mli
index 2f43f4ad..a5a9549b 100644
--- a/contrib/correctness/pred.mli
+++ b/contrib/correctness/pred.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pred.mli,v 1.1.16.1 2004/07/16 19:30:05 herbelin Exp $ *)
+(* $Id: pred.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Term
 open Past
diff --git a/contrib/correctness/prename.ml b/contrib/correctness/prename.ml
index 864f6abd..4ef1982d 100644
--- a/contrib/correctness/prename.ml
+++ b/contrib/correctness/prename.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: prename.ml,v 1.3.14.1 2004/07/16 19:30:05 herbelin Exp $ *)
+(* $Id: prename.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 open Nameops
diff --git a/contrib/correctness/prename.mli b/contrib/correctness/prename.mli
index 88b49d2c..1d3ab669 100644
--- a/contrib/correctness/prename.mli
+++ b/contrib/correctness/prename.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: prename.mli,v 1.1.16.1 2004/07/16 19:30:05 herbelin Exp $ *)
+(* $Id: prename.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 
diff --git a/contrib/correctness/psyntax.ml4 b/contrib/correctness/psyntax.ml4
index c1f00a3d..eeec28a5 100644
--- a/contrib/correctness/psyntax.ml4
+++ b/contrib/correctness/psyntax.ml4
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: psyntax.ml4,v 1.29.2.1 2004/07/16 19:30:05 herbelin Exp $ *)
+(* $Id: psyntax.ml4 7740 2005-12-26 20:07:21Z herbelin $ *)
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
@@ -145,7 +145,7 @@ let bool_not loc a =
   let d = SApp ( [Variable connective_not ], [a]) in
   w d
 
-let ast_zwf_zero loc = mk_appl loc loc "Zwf" [mk_ref loc "ZERO"]
+let ast_zwf_zero loc = mk_appl loc loc "Zwf" [mk_ref loc "Z0"]
 
 (* program -> Coq AST *)
 
@@ -852,7 +852,7 @@ let pr_effects x =
   let (ro,rw) = Peffect.get_repr x in pr_reads ro ++ pr_writes rw
 
 let pr_predicate delimited { a_name = n; a_value = c } =
-  (if delimited then Ppconstrnew.pr_lconstr else Ppconstrnew.pr_constr) c ++
+  (if delimited then Ppconstr.pr_lconstr else Ppconstr.pr_constr) c ++
   (match n with Name id -> spc () ++ str "as " ++ pr_id id | Anonymous -> mt())
 
 let pr_assert b { p_name = x; p_value = v } =
@@ -870,7 +870,7 @@ let pr_post_condition_opt = function
 
 let rec pr_type_v_v8 = function
   | Array (a,v) ->
-      str "array" ++ spc() ++ Ppconstrnew.pr_constr a ++ spc() ++ str "of " ++
+      str "array" ++ spc() ++ Ppconstr.pr_constr a ++ spc() ++ str "of " ++
       pr_type_v_v8 v
   | v -> pr_type_v3 v
 
@@ -882,7 +882,7 @@ and pr_type_v3 = function
       pr_type_v_v8 v ++ pr_effects e ++ 
       pr_pre_condition_list prel ++ pr_post_condition_opt postl ++
       spc () ++ str "end"
-  | TypePure a -> Ppconstrnew.pr_constr a
+  | TypePure a -> Ppconstr.pr_constr a
   | v -> str "(" ++ pr_type_v_v8 v ++ str ")"
 
 and pr_binder = function
@@ -910,9 +910,9 @@ let pr_invariant = function
   | Some c -> hov 2 (str "invariant" ++ spc ()  ++ pr_predicate false c)
 
 let pr_variant (c1,c2) =
-  Ppconstrnew.pr_constr c1 ++
+  Ppconstr.pr_constr c1 ++
   (try Constrextern.check_same_type c2 (ast_zwf_zero dummy_loc); mt ()
-   with _ -> spc() ++ hov 0 (str "for" ++ spc () ++ Ppconstrnew.pr_constr c2))
+   with _ -> spc() ++ hov 0 (str "for" ++ spc () ++ Ppconstr.pr_constr c2))
 
 let rec pr_desc = function
   | Variable id ->
@@ -1025,7 +1025,7 @@ let rec pr_desc = function
       (* Numeral or "tt": use a printer which doesn't globalize *)
       Ppconstr.pr_constr
         (Constrextern.extern_constr_in_scope false "Z_scope" (Global.env()) c)
-  | Debug (s,p) -> str "@" ++ Pptacticnew.qsnew s ++ pr_prog p
+  | Debug (s,p) -> str "@" ++ Pptactic.qsnew s ++ pr_prog p
 
 and pr_block_st = function
   | Label s -> hov 0 (str "label" ++ spc() ++ str s)
@@ -1046,7 +1046,7 @@ and pr_prog0 b { desc = desc; pre = pre; post = post } =
     hov 0
       (if b & post<>None then str"(" ++ pr_desc desc ++ str")"
        else pr_desc desc)
-    ++ Ppconstrnew.pr_opt pr_postcondition post)
+    ++ Ppconstr.pr_opt pr_postcondition post)
 
 and pr_prog x = pr_prog0 true x
 
diff --git a/contrib/correctness/psyntax.mli b/contrib/correctness/psyntax.mli
index 18912548..c0f0990b 100644
--- a/contrib/correctness/psyntax.mli
+++ b/contrib/correctness/psyntax.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: psyntax.mli,v 1.3.2.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: psyntax.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pcoq
 open Ptype
diff --git a/contrib/correctness/ptactic.ml b/contrib/correctness/ptactic.ml
index 4b22954e..e5347670 100644
--- a/contrib/correctness/ptactic.ml
+++ b/contrib/correctness/ptactic.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ptactic.ml,v 1.30.2.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: ptactic.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 open Pp
 open Options
@@ -51,7 +51,7 @@ let coqast_of_prog p =
 
   (* 4a. traduction type *)
   let ty = Pmonad.trad_ml_type_c ren env c in
-  deb_print (Printer.prterm_env (Global.env())) ty;
+  deb_print (Printer.pr_lconstr_env (Global.env())) ty;
 
   (* 4b. traduction terme (terme intermédiaire de type cc_term) *)
   deb_mess 
@@ -65,12 +65,12 @@ let coqast_of_prog p =
     (fnl () ++ str"Pcic.constr_of_prog: Translation cc_term -> rawconstr..." ++ 
        fnl ());
   let r = Pcic.rawconstr_of_prog cc in
-  deb_print Printer.pr_rawterm r;
+  deb_print Printer.pr_lrawconstr r;
 
   (* 6. résolution implicites *)
   deb_mess (fnl () ++ str"Resolution implicits (? => Meta(n))..." ++ fnl ());
   let oc = understand_gen_tcc Evd.empty (Global.env()) [] None r in
-  deb_print (Printer.prterm_env (Global.env())) (snd oc);
+  deb_print (Printer.pr_lconstr_env (Global.env())) (snd oc);
 
   p,oc,ty,v
 
@@ -234,7 +234,7 @@ let correctness_hook _ ref =
   register pf_id None
 
 let correctness s p opttac =
-  Library.check_required_library ["Coq";"correctness";"Correctness"];
+  Coqlib.check_required_library ["Coq";"correctness";"Correctness"];
   Pmisc.reset_names();
   let p,oc,cty,v = coqast_of_prog p in
   let env = Global.env () in
@@ -248,7 +248,7 @@ let correctness s p opttac =
   deb_mess (str"Pred.red_cci: Reduction..." ++ fnl ());
   let oc = reduce_open_constr oc in
   deb_mess (str"AFTER REDUCTION:" ++ fnl ());
-  deb_print (Printer.prterm_env (Global.env())) (snd oc);
+  deb_print (Printer.pr_lconstr_env (Global.env())) (snd oc);
   let tac = (tclTHEN (Extratactics.refine_tac oc) automatic) in
   let tac = match opttac with 
     | None -> tac
diff --git a/contrib/correctness/ptactic.mli b/contrib/correctness/ptactic.mli
index 875e0780..87378cff 100644
--- a/contrib/correctness/ptactic.mli
+++ b/contrib/correctness/ptactic.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ptactic.mli,v 1.2.16.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: ptactic.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* The main tactic: takes a name N, a program P, creates a goal
  * of name N with the functional specification of P, then apply the Refine
diff --git a/contrib/correctness/ptype.mli b/contrib/correctness/ptype.mli
index f2dc85e3..be181bcc 100644
--- a/contrib/correctness/ptype.mli
+++ b/contrib/correctness/ptype.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ptype.mli,v 1.2.16.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: ptype.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Term
 
diff --git a/contrib/correctness/ptyping.ml b/contrib/correctness/ptyping.ml
index 9047a925..91c1f293 100644
--- a/contrib/correctness/ptyping.ml
+++ b/contrib/correctness/ptyping.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ptyping.ml,v 1.7.6.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: ptyping.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Util
diff --git a/contrib/correctness/ptyping.mli b/contrib/correctness/ptyping.mli
index 0c0d5905..eaf548b1 100644
--- a/contrib/correctness/ptyping.mli
+++ b/contrib/correctness/ptyping.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: ptyping.mli,v 1.3.6.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: ptyping.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Names
 open Term
diff --git a/contrib/correctness/putil.ml b/contrib/correctness/putil.ml
index 48f0781a..0eb8806c 100644
--- a/contrib/correctness/putil.ml
+++ b/contrib/correctness/putil.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: putil.ml,v 1.10.2.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: putil.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 open Util
 open Names
@@ -231,26 +231,26 @@ and c_of_constr c =
 open Pp
 open Util
 
-let prterm x = Printer.prterm_env (Global.env()) x
+let pr_lconstr x = Printer.pr_lconstr_env (Global.env()) x
 
 let pp_pre = function
     [] -> (mt ())
   | l  ->
       hov 0 (str"pre " ++ 
 	       prlist_with_sep (fun () -> (spc ())) 
-		 (fun x -> prterm x.p_value) l)
+		 (fun x -> pr_lconstr x.p_value) l)
 
 let pp_post = function
     None -> (mt ())
-  | Some c -> hov 0 (str"post " ++ prterm c.a_value)
+  | Some c -> hov 0 (str"post " ++ pr_lconstr c.a_value)
 
 let rec pp_type_v = function
     Ref v -> hov 0 (pp_type_v v ++ spc () ++ str"ref")
-  | Array (cc,v) -> hov 0 (str"array " ++ prterm cc ++ str" of " ++ pp_type_v v)
+  | Array (cc,v) -> hov 0 (str"array " ++ pr_lconstr cc ++ str" of " ++ pp_type_v v)
   | Arrow (b,c) -> 
       hov 0 (prlist_with_sep (fun () -> (mt ())) pp_binder b ++ 
 	       pp_type_c c)
-  | TypePure c -> prterm c
+  | TypePure c -> pr_lconstr c
 
 and pp_type_c ((id,v),e,p,q) =
   hov 0 (str"returns " ++ pr_id id ++ str":" ++ pp_type_v v ++ spc () ++ 
@@ -297,7 +297,7 @@ let rec pp_cc_term = function
   | CC_case _ ->
       hov 0 (str"<Case: not yet implemented>")
   | CC_expr c ->
-      hov 0 (prterm c)
+      hov 0 (pr_lconstr c)
   | CC_hole c ->
-      (str"(?::" ++ prterm c ++ str")")
+      (str"(?::" ++ pr_lconstr c ++ str")")
 
diff --git a/contrib/correctness/putil.mli b/contrib/correctness/putil.mli
index b44774ae..6c487f3f 100644
--- a/contrib/correctness/putil.mli
+++ b/contrib/correctness/putil.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: putil.mli,v 1.3.2.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: putil.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Names
diff --git a/contrib/correctness/pwp.ml b/contrib/correctness/pwp.ml
index 58bef673..1e485180 100644
--- a/contrib/correctness/pwp.ml
+++ b/contrib/correctness/pwp.ml
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pwp.ml,v 1.8.2.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: pwp.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Util
 open Names
diff --git a/contrib/correctness/pwp.mli b/contrib/correctness/pwp.mli
index 015031a0..4027a623 100644
--- a/contrib/correctness/pwp.mli
+++ b/contrib/correctness/pwp.mli
@@ -8,7 +8,7 @@
 
 (* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
 
-(* $Id: pwp.mli,v 1.2.16.1 2004/07/16 19:30:06 herbelin Exp $ *)
+(* $Id: pwp.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Term
 open Penv
diff --git a/contrib/dp/TODO b/contrib/dp/TODO
new file mode 100644
index 00000000..387cacdf
--- /dev/null
+++ b/contrib/dp/TODO
@@ -0,0 +1,28 @@
+
+TODO
+----
+
+- axiomes pour les prédicats récursifs comme
+
+  Fixpoint even (n:nat) : Prop :=
+  match n with 
+  O => True
+  | S O => False
+  | S (S p) => even p
+  end.
+
+  ou encore In sur les listes du module Coq List.
+
+- discriminate
+
+- inversion (Set et Prop)
+
+
+BUGS
+----
+
+- value = Some : forall A:Set, A -> option A
+
+  -> eta_expanse échoue sur assert false (ligne 147)
+
+
diff --git a/contrib/dp/dp.ml b/contrib/dp/dp.ml
new file mode 100644
index 00000000..af684e6e
--- /dev/null
+++ b/contrib/dp/dp.ml
@@ -0,0 +1,760 @@
+(* Authors: Nicolas Ayache and Jean-Christophe Filliâtre *)
+(* Tactics to call decision procedures *)
+
+(* Works in two steps: 
+
+   - first the Coq context and the current goal are translated in
+     Polymorphic First-Order Logic (see fol.mli in this directory)
+
+   - then the resulting query is passed to the Why tool that translates
+     it to the syntax of the selected prover (Simplify, CVC Lite, haRVey,
+     Zenon)
+*)
+
+open Util
+open Pp
+open Term
+open Tacmach
+open Tactics
+open Tacticals
+open Fol
+open Names
+open Nameops
+open Termops
+open Coqlib
+open Hipattern
+open Libnames
+open Declarations
+
+let debug = ref false
+
+let logic_dir = ["Coq";"Logic";"Decidable"]
+let coq_modules =
+  init_modules @ [logic_dir] @ arith_modules @ zarith_base_modules
+    @ [["Coq"; "omega"; "OmegaLemmas"]]
+
+let constant = gen_constant_in_modules "dp" coq_modules
+
+let coq_Z = lazy (constant "Z")
+let coq_Zplus = lazy (constant "Zplus")
+let coq_Zmult = lazy (constant "Zmult")
+let coq_Zopp = lazy (constant "Zopp")
+let coq_Zminus = lazy (constant "Zminus")
+let coq_Zdiv = lazy (constant "Zdiv")
+let coq_Zs = lazy (constant "Zs")
+let coq_Zgt = lazy (constant "Zgt")
+let coq_Zle = lazy (constant "Zle")
+let coq_Zge = lazy (constant "Zge")
+let coq_Zlt = lazy (constant "Zlt")
+let coq_Z0 = lazy (constant "Z0")
+let coq_Zpos = lazy (constant "Zpos")
+let coq_Zneg = lazy (constant "Zneg")
+let coq_xH = lazy (constant "xH")
+let coq_xI = lazy (constant "xI")
+let coq_xO = lazy (constant "xO")
+
+(* not Prop typed expressions *)
+exception NotProp
+
+(* not first-order expressions *)
+exception NotFO
+
+(* Renaming of Coq globals *)
+
+let global_names = Hashtbl.create 97
+let used_names = Hashtbl.create 97
+
+let rename_global r =
+  try 
+    Hashtbl.find global_names r
+  with Not_found ->
+    let rec loop id = 
+      if Hashtbl.mem used_names id then 
+	loop (lift_ident id)
+      else begin 
+	Hashtbl.add used_names id ();
+	let s = string_of_id id in
+	Hashtbl.add global_names r s; 
+	s
+      end
+    in
+    loop (Nametab.id_of_global r)
+
+let foralls =
+  List.fold_right 
+    (fun (x,t) p -> Forall (x, t, p))
+
+let fresh_var = function
+  | Anonymous -> rename_global (VarRef (id_of_string "x"))
+  | Name x -> rename_global (VarRef x)
+
+(* coq_rename_vars env [(x1,t1);...;(xn,tn)] renames the xi outside of 
+   env names, and returns the new variables together with the new 
+   environment *)
+let coq_rename_vars env vars =
+  let avoid = ref (ids_of_named_context (Environ.named_context env)) in
+  List.fold_right
+    (fun (na,t) (newvars, newenv) -> 
+       let id = next_name_away na !avoid in
+       avoid := id :: !avoid;
+       id :: newvars, Environ.push_named (id, None, t) newenv)
+    vars ([],env)
+
+(* extract the prenex type quantifications i.e.
+   type_quantifiers env (A1:Set)...(Ak:Set)t = A1...An, (env+Ai), t *)
+let decomp_type_quantifiers env t =
+  let rec loop vars t = match kind_of_term t with
+    | Prod (n, a, t) when is_Set a -> 
+	loop ((n,a) :: vars) t
+    | _ -> 
+	let vars, env = coq_rename_vars env vars in
+	let t = substl (List.map mkVar vars) t in
+	List.rev vars, env, t
+  in
+  loop [] t
+
+(* same thing with lambda binders (for axiomatize body) *)
+let decomp_type_lambdas env t =
+  let rec loop vars t = match kind_of_term t with
+    | Lambda (n, a, t) when is_Set a -> 
+	loop ((n,a) :: vars) t
+    | _ -> 
+	let vars, env = coq_rename_vars env vars in
+	let t = substl (List.map mkVar vars) t in
+	List.rev vars, env, t
+  in
+  loop [] t
+
+let decompose_arrows = 
+  let rec arrows_rec l c = match kind_of_term c with
+    | Prod (_,t,c) when not (dependent (mkRel 1) c) -> arrows_rec (t :: l) c
+    | Cast (c,_,_) -> arrows_rec l c
+    | _ -> List.rev l, c
+  in 
+  arrows_rec []
+
+let rec eta_expanse t vars env i =
+  assert (i >= 0);
+  if i = 0 then
+    t, vars, env
+  else
+    match kind_of_term (Typing.type_of env Evd.empty t) with
+      | Prod (n, a, b) when not (dependent (mkRel 1) b) ->
+	  let avoid = ids_of_named_context (Environ.named_context env) in
+	  let id = next_name_away n avoid in
+	  let env' = Environ.push_named (id, None, a) env in
+	  let t' = mkApp (t, [| mkVar id |]) in
+	  eta_expanse t' (id :: vars) env' (pred i)
+      | _ -> 
+	  assert false
+
+let rec skip_k_args k cl = match k, cl with
+  | 0, _ -> cl
+  | _, _ :: cl -> skip_k_args (k-1) cl
+  | _, [] -> raise NotFO
+
+(* Coq global references *)
+
+type global = Gnot_fo | Gfo of Fol.decl
+
+let globals = ref Refmap.empty
+let globals_stack = ref []
+
+(* synchronization *)
+let () =
+  Summary.declare_summary "Dp globals"
+    { Summary.freeze_function = (fun () -> !globals, !globals_stack);
+      Summary.unfreeze_function = 
+	(fun (g,s) -> globals := g; globals_stack := s);
+      Summary.init_function = (fun () -> ());
+      Summary.survive_module = false;
+      Summary.survive_section = false }
+
+let add_global r d = globals := Refmap.add r d !globals
+let mem_global r = Refmap.mem r !globals
+let lookup_global r = match Refmap.find r !globals with
+  | Gnot_fo -> raise NotFO
+  | Gfo d -> d
+
+let locals = Hashtbl.create 97
+
+let lookup_local r =  match Hashtbl.find locals r with
+  | Gnot_fo -> raise NotFO
+  | Gfo d -> d
+
+let iter_all_constructors i f =  
+  let _, oib = Global.lookup_inductive i in
+  Array.iteri
+    (fun j tj -> f j (mkConstruct (i, j+1)))
+    oib.mind_nf_lc
+
+
+(* injection c [t1,...,tn] adds the injection axiom
+     forall x1:t1,...,xn:tn,y1:t1,...,yn:tn. 
+       c(x1,...,xn)=c(y1,...,yn) -> x1=y1 /\ ... /\ xn=yn *)
+
+let injection c l =
+  let i = ref 0 in
+  let var s = incr i; id_of_string (s ^ string_of_int !i) in
+  let xl = List.map (fun t -> rename_global (VarRef (var "x")), t) l in
+  i := 0;
+  let yl = List.map (fun t -> rename_global (VarRef (var "y")), t) l in
+  let f = 
+    List.fold_right2 
+      (fun (x,_) (y,_) p -> And (Fatom (Eq (App (x,[]),App (y,[]))), p))
+      xl yl True
+  in
+  let vars = List.map (fun (x,_) -> App(x,[])) in
+  let f = Imp (Fatom (Eq (App (c, vars xl), App (c, vars yl))), f) in
+  let foralls = List.fold_right (fun (x,t) p -> Forall (x, t, p)) in
+  let f = foralls xl (foralls yl f) in
+  let ax = Axiom ("injection_" ^ c, f) in
+  globals_stack := ax :: !globals_stack
+
+(* rec_names_for c [|n1;...;nk|] builds the list of constant names for 
+   identifiers n1...nk with the same path as c, if they exist; otherwise
+   raises Not_found *)
+let rec_names_for c =
+  let mp,dp,_ = Names.repr_con c in
+  array_map_to_list
+    (function 
+       | Name id -> 
+	   let c' = Names.make_con mp dp (label_of_id id) in
+	   ignore (Global.lookup_constant c');
+	   msgnl (Printer.pr_constr (mkConst c'));
+	   c'
+       | Anonymous ->
+	   raise Not_found)
+
+(* abstraction tables *)
+
+let term_abstractions = Hashtbl.create 97
+
+let new_abstraction = 
+  let r = ref 0 in fun () -> incr r; "abstraction_" ^ string_of_int !r
+
+(* Arithmetic constants *)
+
+exception NotArithConstant
+
+(* translates a closed Coq term p:positive into a FOL term of type int *)
+let rec tr_positive p = match kind_of_term p with
+  | Term.Construct _ when p = Lazy.force coq_xH ->
+      Cst 1
+  | Term.App (f, [|a|]) when f = Lazy.force coq_xI ->
+      Plus (Mult (Cst 2, tr_positive a), Cst 1)
+  | Term.App (f, [|a|]) when f = Lazy.force coq_xO ->
+      Mult (Cst 2, tr_positive a)
+  | Term.Cast (p, _, _) ->
+      tr_positive p
+  | _ ->
+      raise NotArithConstant
+
+(* translates a closed Coq term t:Z into a FOL term of type int *)
+let rec tr_arith_constant t = match kind_of_term t with
+  | Term.Construct _ when t = Lazy.force coq_Z0 ->
+      Cst 0
+  | Term.App (f, [|a|]) when f = Lazy.force coq_Zpos ->
+      tr_positive a
+  | Term.App (f, [|a|]) when f = Lazy.force coq_Zneg ->
+      Moins (Cst 0, tr_positive a)
+  | Term.Cast (t, _, _) ->
+      tr_arith_constant t
+  | _ -> 
+      raise NotArithConstant
+
+(* translate a Coq term t:Set into a FOL type expression;
+   tv = list of type variables *)
+and tr_type tv env t =
+  let t = Reductionops.nf_betadeltaiota env Evd.empty t in
+  if t = Lazy.force coq_Z then 
+    Tid ("int", [])
+  else match kind_of_term t with
+    | Var x when List.mem x tv ->
+	Tvar (string_of_id x)
+    | _ ->
+	let f, cl = decompose_app t in
+	begin try
+	  let r = global_of_constr f in
+	  match tr_global env r with
+	    | DeclType (id, k) -> 
+		assert (k = List.length cl); (* since t:Set *)
+		Tid (id, List.map (tr_type tv env) cl)
+	    | _ -> 
+		raise NotFO
+	with 
+	  | Not_found ->
+	      raise NotFO
+	  | NotFO -> 
+	      (* we need to abstract some part of (f cl) *)
+	      (*TODO*)
+	      raise NotFO
+	end
+
+and make_term_abstraction tv env c =
+  let ty = Typing.type_of env Evd.empty c in
+  let id = new_abstraction () in
+  match tr_decl env id ty with
+    | DeclFun (id,_,_,_) as d ->
+	begin try
+	  Hashtbl.find term_abstractions c
+	with Not_found ->
+	  Hashtbl.add term_abstractions c id;
+	  globals_stack := d :: !globals_stack;
+	  id
+	end
+    | _ ->
+	raise NotFO
+
+(* translate a Coq declaration id:ty in a FOL declaration, that is either
+   - a type declaration : DeclType (id, n) where n:int is the type arity
+   - a function declaration : DeclFun (id, tl, t) ; that includes constants
+   - a predicate declaration : DeclPred (id, tl)
+   - an axiom : Axiom (id, p)
+ *)
+and tr_decl env id ty =
+  let tv, env, t = decomp_type_quantifiers env ty in
+  if is_Set t then
+    DeclType (id, List.length tv)
+  else if is_Prop t then
+    DeclPred (id, List.length tv, [])
+  else 
+    let s = Typing.type_of env Evd.empty t in
+    if is_Prop s then
+      Axiom (id, tr_formula tv [] env t)
+    else
+      let l, t = decompose_arrows t in
+      let l = List.map (tr_type tv env) l in
+      if is_Prop t then
+	DeclPred(id, List.length tv, l)
+      else 
+	let s = Typing.type_of env Evd.empty t in
+	if is_Set s then 
+	  DeclFun(id, List.length tv, l, tr_type tv env t)
+	else 
+	  raise NotFO
+
+(* tr_global(r) = tr_decl(id(r),typeof(r)) + a cache mechanism *)
+and tr_global env r = match r with
+  | VarRef id ->
+      lookup_local id
+  | r ->
+      try
+	lookup_global r
+      with Not_found ->
+	try
+	  let ty = Global.type_of_global r in
+	  let id = rename_global r in
+	  let d = tr_decl env id ty in
+	  (* r can be already declared if it is a constructor *)
+	  if not (mem_global r) then begin 
+	    add_global r (Gfo d);
+	    globals_stack := d :: !globals_stack
+	  end;
+	  begin try axiomatize_body env r id d with NotFO -> () end;
+	  d
+	with NotFO ->
+	  add_global r Gnot_fo;
+	  raise NotFO
+
+and axiomatize_body env r id d = match r with
+  | VarRef _ -> 
+      assert false
+  | ConstRef c ->
+      begin match (Global.lookup_constant c).const_body with
+	| Some b ->
+	    let b = force b in
+	    let tv, env, b = decomp_type_lambdas env b in
+	    let axioms =
+	      (match d with
+		 | DeclPred (id, _, []) ->
+		     let value = tr_formula tv [] env b in
+		     [id, Iff (Fatom (Pred (id, [])), value)]
+		 | DeclFun (id, _, [], _) ->
+		     let value = tr_term tv [] env b in
+		     [id, Fatom (Eq (Fol.App (id, []), value))]
+		 | DeclFun (id, _, l, _) | DeclPred (id, _, l) ->
+		     Format.eprintf "axiomatize_body %S@." id;
+		     let b = match kind_of_term b with
+		       (* a single recursive function *)
+		       | Fix (_, (_,_,[|b|])) -> 
+			   subst1 (mkConst c) b
+                       (* mutually recursive functions *)
+		       | Fix ((_,i), (names,_,bodies)) ->
+                           (* we only deal with named functions *)
+			   begin try
+			     let l = rec_names_for c names in
+			     substl (List.rev_map mkConst l) bodies.(i)
+			   with Not_found ->
+			     b
+			   end
+		       | _ -> 
+			   b
+		     in
+		     let vars, t = decompose_lam b in
+		     let n = List.length l in
+		     let k = List.length vars in
+		     assert (k <= n);
+		     let vars, env = coq_rename_vars env vars in
+		     let t = substl (List.map mkVar vars) t in
+		     let t, vars, env = eta_expanse t vars env (n-k) in
+		     let vars = List.rev vars in
+		     let bv = vars in
+		     let vars = List.map (fun x -> string_of_id x) vars in
+		     let fol_var x =
+		       Fol.App (x, []) in
+		     let fol_vars = List.map fol_var vars in
+		     let vars = List.combine vars l in
+		     begin match d with
+		       | DeclFun _ ->
+			   begin match kind_of_term t with
+			     | Case (ci, _, e, br) ->
+				 equations_for_case env id vars tv bv ci e br
+			     | _ -> 
+				 let p = 
+				   Fatom (Eq (App (id, fol_vars), 
+					      tr_term tv bv env t)) 
+				 in
+				 [id, foralls vars p]
+			   end
+		       | DeclPred _ ->
+			   let value = tr_formula tv bv env t in
+			   let p = Iff (Fatom (Pred (id, fol_vars)), value) in
+			   [id, foralls vars p]
+		       | _ ->
+			   assert false
+		     end
+		 | DeclType _ ->
+		     raise NotFO
+		 | Axiom _ -> assert false)
+	    in
+	    let axioms = List.map (fun (id,ax) -> Axiom (id, ax)) axioms in
+	    globals_stack := axioms @ !globals_stack
+	| None -> 
+	    () (* Coq axiom *)
+      end
+  | IndRef i ->
+      iter_all_constructors i
+	(fun _ c ->
+	   let rc = reference_of_constr c in
+	   try
+	     begin match tr_global env rc with
+	       | DeclFun (_, _, [], _) -> ()
+	       | DeclFun (idc, _, al, _) -> injection idc al
+	       | _ -> ()
+	     end
+	   with NotFO ->
+	     ())
+  | _ -> ()
+
+and equations_for_case env id vars tv bv ci e br = match kind_of_term e with
+  | Var x when List.exists (fun (y, _) -> string_of_id x = y) vars ->
+      let eqs = ref [] in
+      iter_all_constructors ci.ci_ind
+	(fun j cj ->
+	   try
+	     let cjr = reference_of_constr cj in
+	     begin match tr_global env cjr with
+	       | DeclFun (idc, _, l, _) ->
+		   let b = br.(j) in
+		   let rec_vars, b = decompose_lam b in
+		   let rec_vars, env = coq_rename_vars env rec_vars in
+		   let b = substl (List.map mkVar rec_vars) b in
+		   let rec_vars = List.rev rec_vars in
+		   let bv = bv @ rec_vars in
+		   let rec_vars = List.map string_of_id rec_vars in
+		   let fol_var x =
+		     Fol.App (x, []) in
+		   let fol_rec_vars = List.map fol_var rec_vars in
+		   let fol_rec_term = App (idc, fol_rec_vars) in
+		   let rec_vars = List.combine rec_vars l in
+		   let fol_vars = List.map fst vars in
+		   let fol_vars = List.map fol_var fol_vars in
+		   let fol_vars = List.map (fun y -> match y with
+					      | App (id, _) ->
+						  if id = string_of_id x
+						  then fol_rec_term
+						  else y
+					      | _ -> y)
+				    fol_vars in
+		   let vars = vars @ rec_vars in
+		   let rec remove l e = match l with
+		     | [] -> []
+		     | (y, t)::l' -> if y = string_of_id e then l'
+		       else (y, t)::(remove l' e) in
+		   let vars = remove vars x in
+		   let p = 
+		     Fatom (Eq (App (id, fol_vars), 
+				tr_term tv bv env b))
+		   in
+		   eqs := (id ^ "_" ^ idc, foralls vars p) :: !eqs
+	       | _ -> 
+		   assert false end
+	   with NotFO ->
+	     ());
+      !eqs
+  | _ ->
+      raise NotFO
+
+(* assumption: t:T:Set *)
+and tr_term tv bv env t = match kind_of_term t with
+  | Term.App (f, [|a;b|]) when f = Lazy.force coq_Zplus -> 
+      Plus (tr_term tv bv env a, tr_term tv bv env b)
+  | Term.App (f, [|a;b|]) when f = Lazy.force coq_Zminus -> 
+      Moins (tr_term tv bv env a, tr_term tv bv env b)
+  | Term.App (f, [|a;b|]) when f = Lazy.force coq_Zmult -> 
+      Mult (tr_term tv bv env a, tr_term tv bv env b)
+  | Term.App (f, [|a;b|]) when f = Lazy.force coq_Zdiv -> 
+      Div (tr_term tv bv env a, tr_term tv bv env b)
+  | Term.Var id when List.mem id bv ->
+      App (string_of_id id, [])
+  | _ ->
+      try
+	tr_arith_constant t
+      with NotArithConstant ->
+	let f, cl = decompose_app t in
+	begin try
+	  let r = global_of_constr f in
+	  match tr_global env r with
+	    | DeclFun (s, k, _, _) -> 
+		let cl = skip_k_args k cl in
+		Fol.App (s, List.map (tr_term tv bv env) cl)
+	    | _ -> 
+		raise NotFO
+	with 
+	  | Not_found ->
+	      raise NotFO
+	  | NotFO -> (* we need to abstract some part of (f cl) *)
+	      let rec abstract app = function
+		| [] ->
+		    Fol.App (make_term_abstraction tv env app, [])
+		| x :: l as args ->
+		    begin try
+		      let s = make_term_abstraction tv env app in
+		      Fol.App (s, List.map (tr_term tv bv env) args)
+		    with NotFO ->
+		      abstract (applist (app, [x])) l
+		    end
+	      in
+	      let app,l = match cl with 
+		| x :: l -> applist (f, [x]), l | [] -> raise NotFO
+	      in
+	      abstract app l
+	end
+
+and quantifiers n a b tv bv env =
+  let vars, env = coq_rename_vars env [n,a] in
+  let id = match vars with [x] -> x | _ -> assert false in
+  let b = subst1 (mkVar id) b in
+  let t = tr_type tv env a in
+  let bv = id :: bv in
+  id, t, bv, env, b
+
+(* assumption: f is of type Prop *)
+and tr_formula tv bv env f =
+  let c, args = decompose_app f in
+  match kind_of_term c, args with
+    | Var id, [] -> 
+	Fatom (Pred (rename_global (VarRef id), []))
+    | _, [t;a;b] when c = build_coq_eq () ->
+	let ty = Typing.type_of env Evd.empty t in
+	if is_Set ty then
+	  let _ = tr_type tv env t in
+	  Fatom (Eq (tr_term tv bv env a, tr_term tv bv env b))
+	else 
+	  raise NotFO
+    | _, [a;b] when c = Lazy.force coq_Zle ->
+	Fatom (Le (tr_term tv bv env a, tr_term tv bv env b))
+    | _, [a;b] when c = Lazy.force coq_Zlt ->
+	Fatom (Lt (tr_term tv bv env a, tr_term tv bv env b))
+    | _, [a;b] when c = Lazy.force coq_Zge ->
+	Fatom (Ge (tr_term tv bv env a, tr_term tv bv env b))
+    | _, [a;b] when c = Lazy.force coq_Zgt ->
+	Fatom (Gt (tr_term tv bv env a, tr_term tv bv env b))
+    | _, [] when c = build_coq_False () ->
+	False
+    | _, [] when c = build_coq_True () ->
+	True
+    | _, [a] when c = build_coq_not () ->
+	Not (tr_formula tv bv env a)
+    | _, [a;b] when c = build_coq_and () ->
+	And (tr_formula tv bv env a, tr_formula tv bv env b)
+    | _, [a;b] when c = build_coq_or () ->
+	Or (tr_formula tv bv env a, tr_formula tv bv env b)
+    | Prod (n, a, b), _ ->
+	if is_imp_term f then
+	  Imp (tr_formula tv bv env a, tr_formula tv bv env b)
+	else
+	  let id, t, bv, env, b = quantifiers n a b tv bv env in
+	  Forall (string_of_id id, t, tr_formula tv bv env b)
+    | _, [_; a] when c = build_coq_ex () ->
+	begin match kind_of_term a with
+	  | Lambda(n, a, b) ->
+	      let id, t, bv, env, b = quantifiers n a b tv bv env in
+	      Exists (string_of_id id, t, tr_formula tv bv env b)
+	  | _ -> 
+	      (* unusual case of the shape (ex p) *)
+	      raise NotFO (* TODO: we could eta-expanse *)
+	end
+    | _ ->
+	begin try
+	  let r = global_of_constr c in
+	  match tr_global env r with
+	    | DeclPred (s, k, _) -> 
+		let args = skip_k_args k args in
+		Fatom (Pred (s, List.map (tr_term tv bv env) args))
+	    | _ -> 
+		raise NotFO
+	with Not_found ->
+	  raise NotFO
+	end
+
+
+let tr_goal gl =
+  Hashtbl.clear locals;
+  let tr_one_hyp (id, ty) = 
+    try
+      let s = rename_global (VarRef id) in
+      let d = tr_decl (pf_env gl) s ty in
+      Hashtbl.add locals id (Gfo d);
+      d
+    with NotFO ->
+      Hashtbl.add locals id Gnot_fo;
+      raise NotFO
+  in
+  let hyps =
+    List.fold_right 
+      (fun h acc -> try tr_one_hyp h :: acc with NotFO -> acc)
+      (pf_hyps_types gl) []
+  in
+  let c = tr_formula [] [] (pf_env gl) (pf_concl gl) in
+  let hyps = List.rev_append !globals_stack (List.rev hyps) in
+  hyps, c
+
+
+type prover = Simplify | CVCLite | Harvey | Zenon
+
+let remove_files = List.iter (fun f -> try Sys.remove f with _ -> ())
+
+let sprintf = Format.sprintf
+
+let call_simplify fwhy =
+  if Sys.command (sprintf "why --simplify %s" fwhy) <> 0 then
+    anomaly ("call to why --simplify " ^ fwhy ^ " failed; please report");
+  let fsx = Filename.chop_suffix fwhy ".why" ^ "_why.sx" in
+  let cmd = 
+    sprintf "timeout 10 Simplify %s > out 2>&1 && grep -q -w Valid out" fsx
+  in
+  let out = Sys.command cmd in
+  let r = if out = 0 then Valid else if out = 1 then Invalid else Timeout in
+  if not !debug then remove_files [fwhy; fsx];
+  r
+
+let call_zenon fwhy =
+  let cmd = sprintf "why --no-prelude --no-zenon-prelude --zenon %s" fwhy in
+  if Sys.command cmd <> 0 then
+    anomaly ("call to " ^ cmd ^ " failed; please report");
+  let fznn = Filename.chop_suffix fwhy ".why" ^ "_why.znn" in
+  let cmd = 
+    sprintf "timeout 10 zenon %s > out 2>&1 && grep -q PROOF-FOUND out" fznn
+  in
+  let out = Sys.command cmd in
+  let r = 
+    if out = 0 then Valid 
+    else if out = 1 then Invalid 
+    else if out = 137 then Timeout 
+    else anomaly ("malformed Zenon input file " ^ fznn)
+  in
+  if not !debug then remove_files [fwhy; fznn];
+  r
+
+let call_cvcl fwhy =
+  if Sys.command (sprintf "why --cvcl %s" fwhy) <> 0 then
+    anomaly ("call to why --cvcl " ^ fwhy ^ " failed; please report");
+  let fcvc = Filename.chop_suffix fwhy ".why" ^ "_why.cvc" in
+  let cmd = 
+    sprintf "timeout 10 cvcl < %s > out 2>&1 && grep -q -w Valid out" fcvc
+  in
+  let out = Sys.command cmd in
+  let r = if out = 0 then Valid else if out = 1 then Invalid else Timeout in
+  if not !debug then remove_files [fwhy; fcvc];
+  r
+
+let call_harvey fwhy =
+  if Sys.command (sprintf "why --harvey %s" fwhy) <> 0 then
+    anomaly ("call to why --harvey " ^ fwhy ^ " failed; please report");
+  let frv = Filename.chop_suffix fwhy ".why" ^ "_why.rv" in
+  let out = Sys.command (sprintf "rvc -e -t %s > /dev/null 2>&1" frv) in
+  if out <> 0 then anomaly ("call to rvc -e -t " ^ frv ^ " failed");
+  let f = Filename.chop_suffix frv ".rv" ^ "-0.baf" in
+  let outf = Filename.temp_file "rv" ".out" in
+  let out = 
+    Sys.command (sprintf "timeout 10 rv -e\"-T 2000\" %s > %s 2>&1" f outf) 
+  in
+  let r =
+    if out <> 0 then 
+      Timeout
+    else
+      let cmd = 
+	sprintf "grep \"Proof obligation in\" %s | grep -q \"is valid\"" outf
+      in
+      if Sys.command cmd = 0 then Valid else Invalid
+  in
+  if not !debug then remove_files [fwhy; frv; outf];
+  r
+
+let call_prover prover q =
+  let fwhy = Filename.temp_file "coq_dp" ".why" in
+  Dp_why.output_file fwhy q;
+  if !debug then ignore (Sys.command (sprintf "cat %s" fwhy));
+  match prover with
+    | Simplify -> call_simplify fwhy
+    | Zenon -> call_zenon fwhy
+    | CVCLite -> call_cvcl fwhy
+    | Harvey -> call_harvey fwhy
+  
+let dp prover gl =
+  let concl_type = pf_type_of gl (pf_concl gl) in
+  if not (is_Prop concl_type) then error "Conclusion is not a Prop";
+  try 
+    let q = tr_goal gl in
+    begin match call_prover prover q with
+      | Valid -> Tactics.admit_as_an_axiom gl
+      | Invalid -> error "Invalid"
+      | DontKnow -> error "Don't know"
+      | Timeout -> error "Timeout"
+    end
+  with NotFO ->
+    error "Not a first order goal"
+  
+
+let simplify = tclTHEN intros (dp Simplify)
+let cvc_lite = tclTHEN intros (dp CVCLite)
+let harvey = dp Harvey
+let zenon = tclTHEN intros (dp Zenon)
+
+let dp_hint l =
+  let env = Global.env () in
+  let one_hint (qid,r) = 
+    if not (mem_global r) then begin
+      let ty = Global.type_of_global r in
+      let s = Typing.type_of env Evd.empty ty in
+      if is_Prop s then
+	try
+	  let id = rename_global r in
+	  let d = Axiom (id, tr_formula [] [] env ty) in
+	  add_global r (Gfo d);
+	  globals_stack := d :: !globals_stack
+	with NotFO ->
+	  add_global r Gnot_fo;
+	  msg_warning
+	    (pr_reference qid ++ 
+	     str " ignored (not a first order proposition)")
+	else begin
+	  add_global r Gnot_fo;
+	  msg_warning
+	    (pr_reference qid ++ str " ignored (not a proposition)")
+	end
+    end
+  in
+  List.iter one_hint (List.map (fun qid -> qid, Nametab.global qid) l)
diff --git a/contrib/dp/dp.mli b/contrib/dp/dp.mli
new file mode 100644
index 00000000..3dad469c
--- /dev/null
+++ b/contrib/dp/dp.mli
@@ -0,0 +1,12 @@
+
+open Libnames
+open Proof_type
+
+val simplify : tactic
+val cvc_lite : tactic
+val harvey : tactic
+val zenon : tactic
+
+val dp_hint : reference list -> unit
+
+
diff --git a/contrib/dp/dp_cvcl.ml b/contrib/dp/dp_cvcl.ml
new file mode 100644
index 00000000..05d43081
--- /dev/null
+++ b/contrib/dp/dp_cvcl.ml
@@ -0,0 +1,112 @@
+
+open Format
+open Fol
+
+let rec print_list sep print fmt = function
+  | [] -> ()
+  | [x] -> print fmt x
+  | x :: r -> print fmt x; sep fmt (); print_list sep print fmt r
+
+let space fmt () = fprintf fmt "@ "
+let comma fmt () = fprintf fmt ",@ "
+
+let rec print_term fmt = function
+  | Cst n -> 
+      fprintf fmt "%d" n
+  | Plus (a, b) ->
+      fprintf fmt "@[(%a@ +@ %a)@]" print_term a print_term b
+  | Moins (a, b) ->
+      fprintf fmt "@[(%a@ -@ %a)@]" print_term a print_term b
+  | Mult (a, b) ->
+      fprintf fmt "@[(%a@ *@ %a)@]" print_term a print_term b
+  | Div (a, b) ->
+      fprintf fmt "@[(%a@ /@ %a)@]" print_term a print_term b
+  | App (id, []) ->
+      fprintf fmt "@[%s@]" id
+  | App (id, tl) ->
+      fprintf fmt "@[%s(%a)@]" id print_terms tl
+
+and print_terms fmt tl = 
+  print_list comma print_term fmt tl
+
+let rec print_predicate fmt p = 
+  let pp = print_predicate in 
+  match p with
+  | True ->
+      fprintf fmt "TRUE"
+  | False ->
+      fprintf fmt "FALSE"
+  | Fatom (Eq (a, b)) ->
+      fprintf fmt "@[(%a = %a)@]" print_term a print_term b
+  | Fatom (Le (a, b)) ->
+      fprintf fmt "@[(%a@ <= %a)@]" print_term a print_term b
+  | Fatom (Lt (a, b))->
+      fprintf fmt "@[(%a@ < %a)@]" print_term a print_term b
+  | Fatom (Ge (a, b)) ->
+      fprintf fmt "@[(%a@ >= %a)@]" print_term a print_term b
+  | Fatom (Gt (a, b)) ->
+      fprintf fmt "@[(%a@ > %a)@]" print_term a print_term b
+  | Fatom (Pred (id, [])) ->
+      fprintf fmt "@[%s@]" id
+  | Fatom (Pred (id, tl)) ->
+      fprintf fmt "@[%s(%a)@]" id print_terms tl
+  | Imp (a, b) ->
+      fprintf fmt "@[(%a@ => %a)@]" pp a pp b
+  | And (a, b) ->
+      fprintf fmt "@[(%a@ AND@ %a)@]" pp a pp b
+  | Or (a, b) ->
+      fprintf fmt "@[(%a@ OR@ %a)@]" pp a pp b
+  | Not a ->
+      fprintf fmt "@[(NOT@ %a)@]" pp a
+  | Forall (id, t, p) -> 
+      fprintf fmt "@[(FORALL (%s:%s): %a)@]" id t pp p
+  | Exists (id, t, p) -> 
+      fprintf fmt "@[(EXISTS (%s:%s): %a)@]" id t pp p
+
+let rec string_of_type_list  = function
+  | [] -> assert false
+  | [e] -> e
+  | e :: l' -> e ^ ", " ^ (string_of_type_list l')
+
+let print_query fmt (decls,concl) =
+  let print_decl = function
+    | DeclVar (id, [], t) ->
+	fprintf fmt "@[%s: %s;@]@\n" id t
+    | DeclVar (id, [e], t) ->
+	fprintf fmt "@[%s: [%s -> %s];@]@\n"
+	  id e t
+    | DeclVar (id, l, t) ->
+	fprintf fmt "@[%s: [[%s] -> %s];@]@\n"
+	  id (string_of_type_list l) t
+    | DeclPred (id, []) ->
+	fprintf fmt "@[%s: BOOLEAN;@]@\n" id
+     | DeclPred (id, [e]) ->
+	fprintf fmt "@[%s: [%s -> BOOLEAN];@]@\n"
+	  id e
+   | DeclPred (id, l) ->
+	fprintf fmt "@[%s: [[%s] -> BOOLEAN];@]@\n"
+	  id (string_of_type_list l)
+    | DeclType id ->
+	fprintf fmt "@[%s: TYPE;@]@\n" id
+    | Assert (id, f)  -> 
+	fprintf fmt "@[ASSERT %% %s@\n %a;@]@\n" id print_predicate f
+  in
+  List.iter print_decl decls;
+  fprintf fmt "QUERY %a;" print_predicate concl
+
+let call q = 
+  let f = Filename.temp_file "coq_dp" ".cvc" in
+  let c = open_out f in
+  let fmt = formatter_of_out_channel c in
+  fprintf fmt "@[%a@]@." print_query q;
+  close_out c;
+  ignore (Sys.command (sprintf "cat %s" f));
+  let cmd = 
+    sprintf "timeout 10 cvcl < %s > out 2>&1 && grep -q -w Valid out" f
+  in
+  prerr_endline cmd; flush stderr;
+  let out = Sys.command cmd in
+  if out = 0 then Valid else if out = 1 then Invalid else Timeout
+  (* TODO: effacer le fichier f et le fichier out *)
+
+
diff --git a/contrib/dp/dp_cvcl.mli b/contrib/dp/dp_cvcl.mli
new file mode 100644
index 00000000..03b6d347
--- /dev/null
+++ b/contrib/dp/dp_cvcl.mli
@@ -0,0 +1,4 @@
+
+open Fol
+
+val call : query -> prover_answer
diff --git a/contrib/dp/dp_simplify.ml b/contrib/dp/dp_simplify.ml
new file mode 100644
index 00000000..d5376b8d
--- /dev/null
+++ b/contrib/dp/dp_simplify.ml
@@ -0,0 +1,117 @@
+
+open Format
+open Fol
+
+let is_simplify_ident s =
+  let is_simplify_char = function
+    | 'a'..'z' | 'A'..'Z' | '0'..'9' -> true 
+    | _ -> false
+  in
+  try 
+    String.iter (fun c -> if not (is_simplify_char c) then raise Exit) s; true
+  with Exit ->
+    false
+
+let ident fmt s =
+  if is_simplify_ident s then fprintf fmt "%s" s else fprintf fmt "|%s|" s
+
+let rec print_list sep print fmt = function
+  | [] -> ()
+  | [x] -> print fmt x
+  | x :: r -> print fmt x; sep fmt (); print_list sep print fmt r
+
+let space fmt () = fprintf fmt "@ "
+let comma fmt () = fprintf fmt ",@ "
+
+let rec print_term fmt = function
+  | Cst n -> 
+      fprintf fmt "%d" n
+  | Plus (a, b) ->
+      fprintf fmt "@[(+@ %a@ %a)@]" print_term a print_term b
+  | Moins (a, b) ->
+      fprintf fmt "@[(-@ %a@ %a)@]" print_term a print_term b
+  | Mult (a, b) ->
+      fprintf fmt "@[(*@ %a@ %a)@]" print_term a print_term b
+  | Div (a, b) ->
+      fprintf fmt "@[(/@ %a@ %a)@]" print_term a print_term b
+  | App (id, []) ->
+      fprintf fmt "%a" ident id
+  | App (id, tl) ->
+      fprintf fmt "@[(%a@ %a)@]" ident id print_terms tl
+
+and print_terms fmt tl = 
+  print_list space print_term fmt tl
+
+let rec print_predicate fmt p = 
+  let pp = print_predicate in 
+  match p with
+  | True ->
+      fprintf fmt "TRUE"
+  | False ->
+      fprintf fmt "FALSE"
+  | Fatom (Eq (a, b)) ->
+      fprintf fmt "@[(EQ %a@ %a)@]" print_term a print_term b
+  | Fatom (Le (a, b)) ->
+      fprintf fmt "@[(<= %a@ %a)@]" print_term a print_term b
+  | Fatom (Lt (a, b))->
+      fprintf fmt "@[(< %a@ %a)@]" print_term a print_term b
+  | Fatom (Ge (a, b)) ->
+      fprintf fmt "@[(>= %a@ %a)@]" print_term a print_term b
+  | Fatom (Gt (a, b)) ->
+      fprintf fmt "@[(> %a@ %a)@]" print_term a print_term b
+  | Fatom (Pred (id, tl)) -> 
+      fprintf fmt "@[(EQ (%a@ %a) |@@true|)@]" ident id print_terms tl
+  | Imp (a, b) ->
+      fprintf fmt "@[(IMPLIES@ %a@ %a)@]" pp a pp b
+  | And (a, b) ->
+      fprintf fmt "@[(AND@ %a@ %a)@]" pp a pp b
+  | Or (a, b) ->
+      fprintf fmt "@[(OR@ %a@ %a)@]" pp a pp b
+  | Not a ->
+      fprintf fmt "@[(NOT@ %a)@]" pp a
+  | Forall (id, _, p) -> 
+      fprintf fmt "@[(FORALL (%a)@ %a)@]" ident id pp p
+  | Exists (id, _, p) -> 
+      fprintf fmt "@[(EXISTS (%a)@ %a)@]" ident id pp p
+
+(**
+let rec string_list l = match l with
+    [] -> ""
+  | [e] -> e
+  | e::l' -> e ^ " " ^ (string_list l')
+**)
+
+let print_query fmt (decls,concl) =
+  let print_decl = function
+    | DeclVar (id, [], t) ->
+	fprintf fmt "@[;; %s : %s@]@\n"	id t
+    | DeclVar (id, l, t) ->
+	fprintf fmt "@[;; %s : %a -> %s@]@\n" 
+	  id (print_list comma pp_print_string) l t
+    | DeclPred (id, []) ->
+	fprintf fmt "@[;; %s : BOOLEAN @]@\n" id
+    | DeclPred (id, l) -> 
+	fprintf fmt "@[;; %s : %a -> BOOLEAN@]@\n" 
+	  id (print_list comma pp_print_string) l
+    | DeclType id ->
+	fprintf fmt "@[;; %s : TYPE@]@\n" id
+    | Assert (id, f)  -> 
+	fprintf fmt "@[(BG_PUSH ;; %s@\n %a)@]@\n" id print_predicate f
+  in
+  List.iter print_decl decls;
+  fprintf fmt "%a@." print_predicate concl
+
+let call q = 
+  let f = Filename.temp_file "coq_dp" ".sx" in
+  let c = open_out f in
+  let fmt = formatter_of_out_channel c in
+  fprintf fmt "@[%a@]@." print_query q;
+  close_out c;
+  ignore (Sys.command (sprintf "cat %s" f));
+  let cmd = 
+    sprintf "timeout 10 Simplify %s > out 2>&1 && grep -q -w Valid out" f
+  in
+  prerr_endline cmd; flush stderr;
+  let out = Sys.command cmd in
+  if out = 0 then Valid else if out = 1 then Invalid else Timeout
+  (* TODO: effacer le fichier f et le fichier out *)
diff --git a/contrib/dp/dp_simplify.mli b/contrib/dp/dp_simplify.mli
new file mode 100644
index 00000000..03b6d347
--- /dev/null
+++ b/contrib/dp/dp_simplify.mli
@@ -0,0 +1,4 @@
+
+open Fol
+
+val call : query -> prover_answer
diff --git a/contrib/dp/dp_sorts.ml b/contrib/dp/dp_sorts.ml
new file mode 100644
index 00000000..7dbdfa56
--- /dev/null
+++ b/contrib/dp/dp_sorts.ml
@@ -0,0 +1,51 @@
+
+open Fol
+
+let term_has_sort x s = Fatom (Pred ("%sort_" ^ s, [x]))
+
+let has_sort x s = term_has_sort (App (x, [])) s
+
+let rec form = function
+  | True | False | Fatom _ as f -> f
+  | Imp (f1, f2) -> Imp (form f1, form f2)
+  | And (f1, f2) -> And (form f1, form f2)
+  | Or (f1, f2) -> Or (form f1, form f2)
+  | Not f -> Not (form f)
+  | Forall (x, ("INT" as t), f) -> Forall (x, t, form f)
+  | Forall (x, t, f) -> Forall (x, t, Imp (has_sort x t, form f))
+  | Exists (x, ("INT" as t), f) -> Exists (x, t, form f)
+  | Exists (x, t, f) -> Exists (x, t, Imp (has_sort x t, form f))
+
+let sort_ax = let r = ref 0 in fun () -> incr r; "sort_ax_" ^ string_of_int !r
+
+let hyp acc = function
+  | Assert (id, f) -> 
+      (Assert (id, form f)) :: acc
+  | DeclVar (id, _, "INT") as d ->
+      d :: acc
+  | DeclVar (id, [], t) as d -> 
+      (Assert (sort_ax (), has_sort id t)) :: d :: acc
+  | DeclVar (id, l, t) as d -> 
+      let n = ref 0 in
+      let xi = 
+	List.fold_left 
+	  (fun l t -> incr n; ("x" ^ string_of_int !n, t) :: l) [] l
+      in
+      let f =
+	List.fold_left
+	  (fun f (x,t) -> if t = "INT" then f else Imp (has_sort x t, f))
+	  (term_has_sort 
+	     (App (id, List.rev_map (fun (x,_) -> App (x,[])) xi)) t)
+	  xi 
+      in
+      let f = List.fold_left (fun f (x,t) -> Forall (x, t, f)) f xi in
+      (Assert (sort_ax (), f)) :: d :: acc
+  | DeclPred _ as d ->
+      d :: acc
+  | DeclType t as d ->
+      (DeclPred ("%sort_" ^ t, [t])) :: d :: acc
+
+let query (hyps, f) =
+  let hyps' = List.fold_left hyp [] hyps in
+  List.rev hyps', form f
+
diff --git a/contrib/dp/dp_sorts.mli b/contrib/dp/dp_sorts.mli
new file mode 100644
index 00000000..9e74f997
--- /dev/null
+++ b/contrib/dp/dp_sorts.mli
@@ -0,0 +1,4 @@
+
+open Fol
+
+val query : query -> query
diff --git a/contrib/dp/dp_why.ml b/contrib/dp/dp_why.ml
new file mode 100644
index 00000000..e1ddb039
--- /dev/null
+++ b/contrib/dp/dp_why.ml
@@ -0,0 +1,139 @@
+
+(* Pretty-print PFOL (see fol.mli) in Why syntax *)
+
+open Format
+open Fol
+
+let rec print_list sep print fmt = function
+  | [] -> ()
+  | [x] -> print fmt x
+  | x :: r -> print fmt x; sep fmt (); print_list sep print fmt r
+
+let space fmt () = fprintf fmt "@ "
+let comma fmt () = fprintf fmt ",@ "
+
+let is_why_keyword = 
+  let h = Hashtbl.create 17 in
+  List.iter 
+    (fun s -> Hashtbl.add h s ())
+    ["absurd"; "and"; "array"; "as"; "assert"; "axiom"; "begin";
+     "bool"; "do"; "done"; "else"; "end"; "exception"; "exists";
+     "external"; "false"; "for"; "forall"; "fun"; "function"; "goal";
+     "if"; "in"; "int"; "invariant"; "label"; "let"; "logic"; "not";
+     "of"; "or"; "parameter"; "predicate"; "prop"; "raise"; "raises";
+     "reads"; "real"; "rec"; "ref"; "returns"; "then"; "true"; "try";
+     "type"; "unit"; "variant"; "void"; "while"; "with"; "writes" ]; 
+  Hashtbl.mem h
+
+let ident fmt s =
+  if is_why_keyword s then fprintf fmt "coq__%s" s else fprintf fmt "%s" s
+
+let rec print_typ fmt = function
+  | Tvar x -> fprintf fmt "'%a" ident x
+  | Tid ("int", []) -> fprintf fmt "int"
+  | Tid (x, []) -> fprintf fmt "%a" ident x
+  | Tid (x, [t]) -> fprintf fmt "%a %a" print_typ t ident x
+  | Tid (x,tl) -> fprintf fmt "(%a) %a" (print_list comma print_typ) tl ident x
+
+let rec print_term fmt = function
+  | Cst n -> 
+      fprintf fmt "%d" n
+  | Plus (a, b) ->
+      fprintf fmt "@[(%a +@ %a)@]" print_term a print_term b
+  | Moins (a, b) ->
+      fprintf fmt "@[(%a -@ %a)@]" print_term a print_term b
+  | Mult (a, b) ->
+      fprintf fmt "@[(%a *@ %a)@]" print_term a print_term b
+  | Div (a, b) ->
+      fprintf fmt "@[(%a /@ %a)@]" print_term a print_term b
+  | App (id, []) ->
+      fprintf fmt "%a" ident id
+  | App (id, tl) ->
+      fprintf fmt "@[%a(%a)@]" ident id print_terms tl
+
+and print_terms fmt tl = 
+  print_list comma print_term fmt tl
+
+let rec print_predicate fmt p = 
+  let pp = print_predicate in 
+  match p with
+  | True ->
+      fprintf fmt "true"
+  | False ->
+      fprintf fmt "false"
+  | Fatom (Eq (a, b)) ->
+      fprintf fmt "@[(%a =@ %a)@]" print_term a print_term b
+  | Fatom (Le (a, b)) ->
+      fprintf fmt "@[(%a <=@ %a)@]" print_term a print_term b
+  | Fatom (Lt (a, b))->
+      fprintf fmt "@[(%a <@ %a)@]" print_term a print_term b
+  | Fatom (Ge (a, b)) ->
+      fprintf fmt "@[(%a >=@ %a)@]" print_term a print_term b
+  | Fatom (Gt (a, b)) ->
+      fprintf fmt "@[(%a >@ %a)@]" print_term a print_term b
+  | Fatom (Pred (id, [])) -> 
+      fprintf fmt "%a" ident id
+  | Fatom (Pred (id, tl)) -> 
+      fprintf fmt "@[%a(%a)@]" ident id print_terms tl
+  | Imp (a, b) ->
+      fprintf fmt "@[(%a ->@ %a)@]" pp a pp b
+  | Iff (a, b) ->
+      fprintf fmt "@[(%a <->@ %a)@]" pp a pp b
+  | And (a, b) ->
+      fprintf fmt "@[(%a and@ %a)@]" pp a pp b
+  | Or (a, b) ->
+      fprintf fmt "@[(%a or@ %a)@]" pp a pp b
+  | Not a ->
+      fprintf fmt "@[(not@ %a)@]" pp a
+  | Forall (id, t, p) -> 
+      fprintf fmt "@[(forall %a:%a.@ %a)@]" ident id print_typ t pp p
+  | Exists (id, t, p) -> 
+      fprintf fmt "@[(exists %a:%a.@ %a)@]" ident id print_typ t pp p
+
+let print_query fmt (decls,concl) =
+  let print_dtype = function
+    | DeclType (id, 0) ->
+	fprintf fmt "@[type %a@]@\n@\n" ident id
+    | DeclType (id, 1) ->
+	fprintf fmt "@[type 'a %a@]@\n@\n" ident id
+    | DeclType (id, n) ->
+	fprintf fmt "@[type (";
+	for i = 1 to n do 
+	  fprintf fmt "'a%d" i; if i < n then fprintf fmt ", "
+	done;
+	fprintf fmt ") %a@]@\n@\n" ident id
+    | DeclFun _ | DeclPred _ | Axiom _ ->
+	()
+  in
+  let print_dvar_dpred = function
+    | DeclFun (id, _, [], t) ->
+	fprintf fmt "@[logic %a : -> %a@]@\n@\n" ident id print_typ t
+    | DeclFun (id, _, l, t) ->
+	fprintf fmt "@[logic %a : %a -> %a@]@\n@\n" 
+	  ident id (print_list comma print_typ) l print_typ t
+    | DeclPred (id, _, []) ->
+	fprintf fmt "@[logic %a : -> prop @]@\n@\n" ident id
+    | DeclPred (id, _, l) -> 
+	fprintf fmt "@[logic %a : %a -> prop@]@\n@\n" 
+	  ident id (print_list comma print_typ) l
+    | DeclType _ | Axiom _ ->
+	()
+  in
+  let print_assert = function
+    | Axiom (id, f)  -> 
+	fprintf fmt "@[<hov 2>axiom %a:@ %a@]@\n@\n" ident id print_predicate f
+    | DeclType _ | DeclFun _ | DeclPred _ ->
+	()
+  in
+  List.iter print_dtype decls;
+  List.iter print_dvar_dpred decls;
+  List.iter print_assert decls;
+  fprintf fmt "@[<hov 2>goal coq___goal: %a@]" print_predicate concl
+
+let output_file f q =
+  let c = open_out f in
+  let fmt = formatter_of_out_channel c in
+  fprintf fmt "@[%a@]@." print_query q;
+  close_out c
+
+
diff --git a/contrib/dp/dp_zenon.ml b/contrib/dp/dp_zenon.ml
new file mode 100644
index 00000000..57b0a44f
--- /dev/null
+++ b/contrib/dp/dp_zenon.ml
@@ -0,0 +1,103 @@
+
+open Format
+open Fol
+
+let rec print_list sep print fmt = function
+  | [] -> ()
+  | [x] -> print fmt x
+  | x :: r -> print fmt x; sep fmt (); print_list sep print fmt r
+
+let space fmt () = fprintf fmt "@ "
+
+let rec print_term fmt = function
+  | Cst n -> 
+      fprintf fmt "%d" n
+  | Plus (a, b) ->
+      fprintf fmt "@[(+@ %a@ %a)@]" print_term a print_term b
+  | Moins (a, b) ->
+      fprintf fmt "@[(-@ %a@ %a)@]" print_term a print_term b
+  | Mult (a, b) ->
+      fprintf fmt "@[(*@ %a@ %a)@]" print_term a print_term b
+  | Div (a, b) ->
+      fprintf fmt "@[(/@ %a@ %a)@]" print_term a print_term b
+  | App (id, []) ->
+      fprintf fmt "%s" id 
+  | App (id, tl) ->
+      fprintf fmt "@[(%s@ %a)@]" id print_terms tl
+
+and print_terms fmt tl = 
+  print_list space print_term fmt tl
+
+let rec print_predicate fmt p = 
+  let pp = print_predicate in 
+  match p with
+  | True ->
+      fprintf fmt "True"
+  | False ->
+      fprintf fmt "False"
+  | Fatom (Eq (a, b)) ->
+      fprintf fmt "@[(= %a@ %a)@]" print_term a print_term b
+  | Fatom (Le (a, b)) ->
+      fprintf fmt "@[(<= %a@ %a)@]" print_term a print_term b
+  | Fatom (Lt (a, b))->
+      fprintf fmt "@[(< %a@ %a)@]" print_term a print_term b
+  | Fatom (Ge (a, b)) ->
+      fprintf fmt "@[(>= %a@ %a)@]" print_term a print_term b
+  | Fatom (Gt (a, b)) ->
+      fprintf fmt "@[(> %a@ %a)@]" print_term a print_term b
+  | Fatom (Pred (id, tl)) -> 
+      fprintf fmt "@[(%s@ %a)@]" id print_terms tl
+  | Imp (a, b) ->
+      fprintf fmt "@[(=>@ %a@ %a)@]" pp a pp b
+  | And (a, b) ->
+      fprintf fmt "@[(/\\@ %a@ %a)@]" pp a pp b
+  | Or (a, b) ->
+      fprintf fmt "@[(\\/@ %a@ %a)@]" pp a pp b
+  | Not a ->
+      fprintf fmt "@[(-.@ %a)@]" pp a
+  | Forall (id, t, p) -> 
+      fprintf fmt "@[(A. ((%s \"%s\")@ %a))@]" id t pp p
+  | Exists (id, t, p) -> 
+      fprintf fmt "@[(E. ((%s \"%s\")@ %a))@]" id t pp p
+
+let rec string_of_type_list  = function
+  | [] -> ""
+  | e :: l' -> e ^ " -> " ^ (string_of_type_list l')
+
+let print_query fmt (decls,concl) =
+  let print_decl = function
+    | DeclVar (id, [], t) ->
+	fprintf fmt "@[;; %s: %s@]@\n" id t
+    | DeclVar (id, l, t) ->
+	fprintf fmt "@[;; %s: %s%s@]@\n"
+	  id (string_of_type_list l) t
+    | DeclPred (id, l) -> 
+	fprintf fmt "@[;; %s: %sBOOLEAN@]@\n"
+	  id (string_of_type_list l)
+    | DeclType id ->
+	fprintf fmt "@[;; %s: TYPE@]@\n" id
+    | Assert (id, f)  -> 
+	fprintf fmt "@[\"%s\" %a@]@\n" id print_predicate f
+  in
+  List.iter print_decl decls;
+  fprintf fmt "$goal %a@." print_predicate concl
+
+let call q = 
+  let f = Filename.temp_file "coq_dp" ".znn" in
+  let c = open_out f in
+  let fmt = formatter_of_out_channel c in
+  fprintf fmt "@[%a@]@." print_query q;
+  close_out c;
+  ignore (Sys.command (sprintf "cat %s" f));
+  let cmd = 
+    sprintf "timeout 10 zenon %s > out 2>&1 && grep -q PROOF-FOUND out" f
+  in
+  prerr_endline cmd; flush stderr;
+  let out = Sys.command cmd in
+  if out = 0 then Valid 
+  else if out = 1 then Invalid 
+  else if out = 137 then Timeout
+  else Util.anomaly "malformed Zenon input file"
+  (* TODO: effacer le fichier f et le fichier out *)
+
+
diff --git a/contrib/dp/dp_zenon.mli b/contrib/dp/dp_zenon.mli
new file mode 100644
index 00000000..03b6d347
--- /dev/null
+++ b/contrib/dp/dp_zenon.mli
@@ -0,0 +1,4 @@
+
+open Fol
+
+val call : query -> prover_answer
diff --git a/contrib/dp/fol.mli b/contrib/dp/fol.mli
new file mode 100644
index 00000000..a85469cc
--- /dev/null
+++ b/contrib/dp/fol.mli
@@ -0,0 +1,48 @@
+
+(* Polymorphic First-Order Logic (that is Why's input logic) *)
+
+type typ = 
+  | Tvar of string
+  | Tid of string * typ list
+
+type term =   
+  | Cst of int
+  | Plus of term * term
+  | Moins of term * term
+  | Mult of term * term
+  | Div of term * term
+  | App of string * term list
+
+and atom =   
+  | Eq of term * term
+  | Le of term * term
+  | Lt of term * term
+  | Ge of term * term
+  | Gt of term * term
+  | Pred of string * term list
+
+and form = 
+  | Fatom of atom
+  | Imp of form * form
+  | Iff of form * form
+  | And of form * form
+  | Or of form * form
+  | Not of form
+  | Forall of string * typ * form
+  | Exists of string * typ * form
+  | True
+  | False
+
+(* the integer indicates the number of type variables *)
+type decl =
+  | DeclType of string * int
+  | DeclFun of string * int * typ list * typ
+  | DeclPred of string * int * typ list
+  | Axiom of string * form
+
+type query = decl list * form
+
+
+(* prover result *)
+
+type prover_answer = Valid | Invalid | DontKnow | Timeout
diff --git a/theories7/Bool/DecBool.v b/contrib/dp/g_dp.ml4
index c22cd032..eb7fb73b 100755..100644
--- a/theories7/Bool/DecBool.v
+++ b/contrib/dp/g_dp.ml4
@@ -6,22 +6,33 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: DecBool.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+(*i camlp4deps: "parsing/grammar.cma" i*)
 
-Set Implicit Arguments.
+(* $Id: g_dp.ml4 7165 2005-06-24 12:56:46Z coq $ *)
 
-Definition ifdec : (A,B:Prop)(C:Set)({A}+{B})->C->C->C
-   := [A,B,C,H,x,y]if H then [_]x else [_]y.
+open Dp
 
+TACTIC EXTEND Simplify
+  [ "simplify" ] -> [ simplify ]
+END
 
-Theorem ifdec_left : (A,B:Prop)(C:Set)(H:{A}+{B})~B->(x,y:C)(ifdec H x y)=x.
-Intros; Case H; Auto.
-Intro; Absurd B; Trivial.
-Qed.
+TACTIC EXTEND CVCLite
+  [ "cvcl" ] -> [ cvc_lite ]
+END
 
-Theorem ifdec_right : (A,B:Prop)(C:Set)(H:{A}+{B})~A->(x,y:C)(ifdec H x y)=y.
-Intros; Case H; Auto.
-Intro; Absurd A; Trivial.
-Qed.
+TACTIC EXTEND Harvey
+  [ "harvey" ] -> [ harvey ]
+END
 
-Unset Implicit Arguments.
+TACTIC EXTEND Zenon
+  [ "zenon" ] -> [ zenon ]
+END
+
+(* should be part of basic tactics syntax *)
+TACTIC EXTEND admit
+  [ "admit"    ] -> [ Tactics.admit_as_an_axiom ]
+END
+
+VERNAC COMMAND EXTEND Dp_hint 
+  [ "Dp_hint" ne_global_list(l) ] -> [ dp_hint l ]
+END
diff --git a/contrib/dp/test2.v b/contrib/dp/test2.v
new file mode 100644
index 00000000..4e933a3c
--- /dev/null
+++ b/contrib/dp/test2.v
@@ -0,0 +1,78 @@
+Require Import ZArith.
+Require Import Classical.
+Require Import List.
+
+Open Scope list_scope.
+Open Scope Z_scope.
+
+Definition neg (z:Z) : Z := match z with
+  | Z0 => Z0
+  | Zpos p => Zneg p
+  | Zneg p => Zpos p
+  end.
+
+Goal forall z, neg (neg z) = z.
+  Admitted.
+
+Open Scope nat_scope.
+Print plus.
+
+Goal forall x, x+0=x.
+  induction x.
+  zenon.
+  zenon.
+  (* simplify resoud le premier, pas le second *)
+  Admitted.
+
+Goal 1::2::3::nil = 1::2::(1+2)::nil.
+  zenon.
+  Admitted.
+
+Definition T := nat.
+Parameter fct : T -> nat.
+Goal fct O = O.
+ Admitted.
+
+Fixpoint even (n:nat) : Prop :=
+  match n with 
+  O => True
+  | S O => False
+  | S (S p) => even p
+  end.
+
+Goal even 4%nat.
+  try zenon.
+  Admitted.
+
+Definition p (A B:Set) (a:A) (b:B) : list (A*B) := cons (a,b) nil.
+
+Definition head :=
+fun (A : Set) (l : list A) =>
+match l with
+| nil => None (A:=A)
+| x :: _ => Some x
+end.
+
+Goal forall x, head _ (p _ _ 1 2) = Some x -> fst x = 1.
+
+Admitted.
+
+(*
+BUG avec head prédéfini : manque eta-expansion sur A:Set
+
+Goal forall x, head _ (p _ _ 1 2) = Some x -> fst x = 1.
+
+Print value. 
+Print Some.
+ 
+zenon.
+*)
+
+Inductive IN (A:Set) : A -> list A -> Prop :=
+  | IN1 : forall x l, IN A x (x::l)
+  | IN2: forall x l, IN A x l -> forall y, IN A x (y::l).
+Implicit Arguments IN [A].
+
+Goal forall x, forall (l:list nat), IN x l -> IN x (1%nat::l).
+  zenon.
+Print In.
diff --git a/contrib/dp/tests.v b/contrib/dp/tests.v
new file mode 100644
index 00000000..52a57a0c
--- /dev/null
+++ b/contrib/dp/tests.v
@@ -0,0 +1,220 @@
+
+Require Import ZArith.
+Require Import Classical.
+
+(* First example with the 0 and the equality translated *)
+
+Goal 0 = 0.
+zenon.
+Qed.
+
+
+(* Examples in the Propositional Calculus
+   and theory of equality *)
+
+Parameter A C : Prop.
+
+Goal A -> A.
+zenon.
+Qed.
+
+
+Goal A -> (A \/ C).
+
+zenon.
+Qed.
+
+
+Parameter x y z : Z.
+
+Goal x = y -> y = z -> x = z.
+
+zenon.
+Qed.
+
+
+Goal ((((A -> C) -> A) -> A) -> C) -> C.
+
+zenon.
+Qed.
+
+
+(* Arithmetic *)
+Open Scope Z_scope.
+
+Goal 1 + 1 = 2.
+simplify.
+Qed.
+
+
+Goal 2*x + 10 = 18 -> x = 4.
+
+simplify.
+Qed.
+
+
+(* Universal quantifier *)
+
+Goal (forall (x y : Z), x = y) -> 0=1.
+try zenon.
+simplify.
+Qed.
+
+Goal forall (x: nat), (x + 0 = x)%nat.
+
+induction x0.
+zenon.
+zenon.
+Qed.
+
+
+(* No decision procedure can solve this problem 
+  Goal forall (x a b : Z), a * x + b = 0 -> x = - b/a.
+*)
+
+
+(* Functions definitions *) 
+
+Definition fst (x y : Z) : Z := x.
+
+Goal forall (g : Z -> Z) (x y : Z), g (fst x y) = g x.
+
+simplify.
+Qed.
+
+
+(* Eta-expansion example *)
+
+Definition snd_of_3 (x y z : Z) : Z := y.
+
+Definition f : Z -> Z -> Z := snd_of_3 0.
+
+Goal forall (x y z z1 : Z), snd_of_3 x y z = f y z1.
+
+simplify.
+Qed.
+
+
+(* Inductive types definitions - call to incontrib/dp/jection function *)
+
+Inductive even : Z -> Prop :=
+| even_0 : even 0
+| even_plus2 : forall z : Z, even z -> even (z + 2).
+
+
+(* Simplify and Zenon can't prove this goal before the timeout
+   unlike CVC Lite *)
+
+Goal even 4.
+cvcl.
+Qed.
+
+
+Definition skip_z (z : Z) (n : nat) := n.
+
+Definition skip_z1 := skip_z.
+
+Goal forall (z : Z) (n : nat), skip_z z n = skip_z1 z n.
+
+zenon.
+Qed.
+
+
+(* Axioms definitions and dp_hint *)
+
+Parameter add : nat -> nat -> nat.
+Axiom add_0 : forall (n : nat), add 0%nat n = n.
+Axiom add_S : forall (n1 n2 : nat), add (S n1) n2 = S (add n1 n2).
+
+Dp_hint add_0.
+Dp_hint add_S.
+
+(* Simplify can't prove this goal before the timeout 
+   unlike zenon *)
+
+Goal forall n : nat, add n 0 = n.
+
+induction n ; zenon.
+Qed.
+
+
+Definition pred (n : nat) : nat := match n with
+  | 0%nat => 0%nat
+  | S n' => n'
+end.
+
+Goal forall n : nat, n <> 0%nat -> pred (S n) <> 0%nat.
+
+zenon.
+Qed.
+
+
+Fixpoint plus (n m : nat) {struct n} : nat :=
+  match n with
+  | 0%nat => m
+  | S n' => S (plus n' m)
+end.
+
+Goal forall n : nat, plus n 0%nat = n.
+
+induction n; zenon.
+Qed.
+
+
+(* Mutually recursive functions *)
+
+Fixpoint even_b (n : nat) : bool := match n with
+  | O => true
+  | S m => odd_b m
+end
+with odd_b (n : nat) : bool := match n with
+  | O => false
+  | S m => even_b m
+end.
+
+Goal even_b (S (S O)) = true.
+
+zenon.
+Qed.
+
+
+(* sorts issues *)
+
+Parameter foo : Set.         
+Parameter ff : nat -> foo -> foo -> nat.
+Parameter g : foo -> foo.
+Goal (forall x:foo, ff 0 x x = O) -> forall y, ff 0 (g y) (g y) = O.
+zenon.
+Qed.
+
+
+
+(* abstractions *)
+
+Parameter poly_f : forall A:Set, A->A.
+
+Goal forall x:nat, poly_f nat x = poly_f nat x.
+zenon.
+Qed.
+
+
+
+(* Anonymous mutually recursive functions : no equations are produced
+
+Definition mrf :=
+  fix even2 (n : nat) : bool := match n with
+    | O => true
+    | S m => odd2 m
+  end
+  with odd2 (n : nat) : bool := match n with
+    | O => false
+    | S m => even2 m
+  end for even.
+
+   Thus this goal is unsolvable
+
+Goal mrf (S (S O)) = true.
+
+zenon.
+
+*)
diff --git a/contrib/extraction/common.ml b/contrib/extraction/common.ml
index 8e441613..8d8438dc 100644
--- a/contrib/extraction/common.ml
+++ b/contrib/extraction/common.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: common.ml,v 1.51.2.4 2005/12/16 03:07:39 letouzey Exp $ i*)
+(*i $Id: common.ml 7651 2005-12-16 03:19:20Z letouzey $ i*)
 
 open Pp
 open Util
@@ -143,7 +143,7 @@ let create_modular_renamings struc =
   in 
   (* 1) creates renamings of objects *)
   let add upper r = 
-    let mp = modpath (kn_of_r r) in 
+    let mp = modpath_of_r r in 
     let l = mp_create_modular_renamings mp in 
     let s = modular_rename upper (id_of_global r) in 
     global_ids := Idset.add (id_of_string s) !global_ids;    
@@ -184,7 +184,7 @@ let create_modular_renamings struc =
   List.iter contents_first_level used_modules; 
   let used_modules' = List.rev used_modules in 
   let needs_qualify r = 
-    let mp = modpath (kn_of_r r) in 
+    let mp = modpath_of_r r in 
     if (is_modfile mp) && mp <> current_module && 
       (clash mp [] (List.hd (get_renamings r)) used_modules')
     then to_qualify := Refset.add r !to_qualify
@@ -239,7 +239,7 @@ let rec mp_create_mono_renamings mp =
 let create_mono_renamings struc = 
   let { up = u ; down = d } = struct_get_references_list struc in 
   let add upper r = 
-    let mp = modpath (kn_of_r r) in 
+    let mp = modpath_of_r r in 
     let l = mp_create_mono_renamings mp in
     let mycase = if upper then uppercase_id else lowercase_id in 
     let id = 
@@ -285,7 +285,7 @@ module StdParams = struct
   let pp_global mpl r = 
     let ls = get_renamings r in 
     let s = List.hd ls in 
-    let mp = modpath (kn_of_r r) in 
+    let mp = modpath_of_r r in 
     let ls = 
       if mp = List.hd mpl then [s] (* simpliest situation *)
       else 
@@ -317,7 +317,6 @@ module StdParams = struct
 	(*i TODO: clash possible i*)
 	list_firstn ((mp_length mp)-(mp_length pref)) ls
       with Not_found -> (* [mp] is othogonal with every element of [mp]. *)
-	let base = base_mp mp in 
 	if !modular && (at_toplevel mp) 
 	then snd (list_sep_last ls)
 	else ls
diff --git a/contrib/extraction/common.mli b/contrib/extraction/common.mli
index 3e5efa0c..2ba51e1c 100644
--- a/contrib/extraction/common.mli
+++ b/contrib/extraction/common.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: common.mli,v 1.19.2.1 2004/07/16 19:30:07 herbelin Exp $ i*)
+(*i $Id: common.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 open Names
 open Miniml
diff --git a/contrib/extraction/extract_env.ml b/contrib/extraction/extract_env.ml
index d725a1d7..c581c620 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,v 1.74.2.1 2004/07/16 19:30:07 herbelin Exp $ i*)
+(*i $Id: extract_env.ml 6328 2004-11-18 17:31:41Z sacerdot $ i*)
 
 open Term
 open Declarations
@@ -19,6 +19,7 @@ open Table
 open Extraction
 open Modutil
 open Common
+open Mod_subst
 
 (*s Obtaining Coq environment. *)
 
@@ -28,7 +29,7 @@ let toplevel_env () =
     | (_,kn), Lib.Leaf o ->
 	let mp,_,l = repr_kn kn in 
 	let seb = match Libobject.object_tag o with
-	  | "CONSTANT" -> SEBconst (Global.lookup_constant kn)
+	  | "CONSTANT" -> SEBconst (Global.lookup_constant (constant_of_kn kn))
 	  | "INDUCTIVE" -> SEBmind (Global.lookup_mind kn) 
 	  | "MODULE" -> SEBmodule (Global.lookup_module (MPdot (mp,l)))
 	  | "MODULE TYPE" -> SEBmodtype (Global.lookup_modtype kn)
@@ -52,14 +53,23 @@ let environment_until dir_opt =
 	  | _ -> assert false
   in parse (Library.loaded_libraries ())
 
-type visit = { mutable kn : KNset.t; mutable mp : MPset.t }
+type visit =
+ { mutable kn : KNset.t; mutable ref : Refset.t; mutable mp : MPset.t }
 
 let in_kn v kn = KNset.mem kn v.kn
+let in_ref v ref = Refset.mem ref v.ref
 let in_mp v mp = MPset.mem mp v.mp
 
 let visit_mp v mp = v.mp <- MPset.union (prefixes_mp mp) v.mp
 let visit_kn v kn = v.kn <- KNset.add kn v.kn; visit_mp v (modpath kn)
-let visit_ref v r = visit_kn v (kn_of_r r) 
+let visit_ref v r =
+ let r =
+  (* if we meet a constructor we must export the inductive definition *)
+  match r with
+     ConstructRef (r,_) -> IndRef r
+   | _ -> r
+ in
+  v.ref <- Refset.add r v.ref; visit_mp v (modpath_of_r r) 
 
 exception Impossible
 
@@ -102,7 +112,7 @@ let get_spec_references v s =
 let rec extract_msig env v mp = function 
   | [] -> [] 
   | (l,SPBconst cb) :: msig -> 
-      let kn = make_kn mp empty_dirpath l in 
+      let kn = make_con mp empty_dirpath l in 
       let s = extract_constant_spec env kn cb in 
       if logical_spec s then extract_msig env v mp msig
       else begin
@@ -143,9 +153,9 @@ let rec extract_msb env v mp all = function
   | (l,SEBconst cb) :: msb -> 
       (try 
 	 let vl,recd,msb = factor_fix env l cb msb in 
-	 let vkn = Array.map (fun id -> make_kn mp empty_dirpath id) vl in
+	 let vkn = Array.map (fun id -> make_con mp empty_dirpath id) vl in
 	 let ms = extract_msb env v mp all msb in 
-	 let b = array_exists (in_kn v) vkn in 
+	 let b = array_exists (fun con -> in_ref v (ConstRef con)) vkn in 
 	 if all || b then 
 	   let d = extract_fixpoint env vkn recd in 
 	   if (not b) && (logical_decl d) then ms 
@@ -153,8 +163,8 @@ let rec extract_msb env v mp all = function
 	 else ms
        with Impossible ->
 	 let ms = extract_msb env v mp all msb in 
-	 let kn = make_kn mp empty_dirpath l in 
-	 let b = in_kn v kn in 
+	 let kn = make_con mp empty_dirpath l in 
+	 let b = in_ref v (ConstRef kn) in 
 	 if all || b then 
 	   let d = extract_constant env kn cb in
 	   if (not b) && (logical_decl d) then ms 
@@ -163,7 +173,7 @@ let rec extract_msb env v mp all = function
   | (l,SEBmind mib) :: msb ->
       let ms = extract_msb env v mp all msb in
       let kn = make_kn mp empty_dirpath l in 
-      let b = in_kn v kn in 
+      let b = in_ref v (IndRef (kn,0)) in  (* 0 is dummy *)
       if all || b then 
 	let d = Dind (kn, extract_inductive env kn) in 
 	if (not b) && (logical_decl d) then ms 
@@ -217,12 +227,12 @@ let unpack = function MEstruct (_,sel) -> sel | _ -> assert false
 let mono_environment refs mpl = 
   let l = environment_until None in 
   let v = 
-    let add_kn r = KNset.add (kn_of_r r) in 
-    let kns = List.fold_right add_kn refs KNset.empty in 
+    let add_ref r = Refset.add r in 
+    let refs = List.fold_right add_ref refs Refset.empty in 
     let add_mp mp = MPset.union (prefixes_mp mp) in
     let mps = List.fold_right add_mp mpl MPset.empty in 
-    let mps = KNset.fold (fun k -> add_mp (modpath k)) kns mps in 
-    { kn = kns; mp = mps }
+    let mps = Refset.fold (fun k -> add_mp (modpath_of_r k)) refs mps in 
+    { kn = KNset.empty; ref = refs; mp = mps }
   in 
   let env = Global.env () in 
   List.rev_map (fun (mp,m) -> mp, unpack (extract_meb env v (Some mp) false m)) 
@@ -270,10 +280,9 @@ let extraction qid =
     else begin 
       let prm = 
 	{ modular = false; mod_name = id_of_string "Main"; to_appear = [r]} in 
-      let kn = kn_of_r r in 
       let struc = optimize_struct prm None (mono_environment [r] []) in 
       let d = get_decl_in_structure r struc in 
-      print_one_decl struc (modpath kn) d;
+      print_one_decl struc (modpath_of_r r) d;
       reset_tables ()
     end
 
@@ -315,7 +324,7 @@ let extraction_module m =
 	let b = is_modfile mp in 
 	let prm = {modular=b; mod_name = id_of_string ""; to_appear= []} in
 	let l = environment_until None in 
-	let v = { kn = KNset.empty ; mp = prefixes_mp mp } in
+	let v={ kn = KNset.empty ; ref = Refset.empty; mp = prefixes_mp mp } in
 	let env = Global.env () in 
 	let struc = 
 	  List.rev_map
@@ -350,7 +359,9 @@ let extraction_library is_rec m =
     | Scheme -> error_scheme ()
     | _ -> 
 	let dir_m = dir_module_of_id m in 
-	let v = { kn = KNset.empty; mp = MPset.singleton (MPfile dir_m) } in 
+	let v =
+         { kn = KNset.empty; ref = Refset.empty;
+           mp = MPset.singleton (MPfile dir_m) } in 
 	let l = environment_until (Some dir_m) in 
 	let struc = 
 	  let env = Global.env () in
diff --git a/contrib/extraction/extract_env.mli b/contrib/extraction/extract_env.mli
index 8ce64342..a09464a1 100644
--- a/contrib/extraction/extract_env.mli
+++ b/contrib/extraction/extract_env.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: extract_env.mli,v 1.13.2.1 2004/07/16 19:30:07 herbelin Exp $ i*)
+(*i $Id: extract_env.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*s This module declares the extraction commands. *)
 
diff --git a/contrib/extraction/extraction.ml b/contrib/extraction/extraction.ml
index 6bfe861f..a4bf973d 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,v 1.136.2.4 2005/12/01 11:27:15 letouzey Exp $ i*)
+(*i $Id: extraction.ml 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Util
@@ -230,7 +230,7 @@ let rec extract_type env db j c args =
 		      (* We try to reduce. *)
 		      let newc = applist (Declarations.force lbody, args) in 
 		      extract_type env db j newc []))
-    | Ind ((kn,i) as ip) ->
+    | Ind (kn,i) ->
 	let s = (extract_ind env kn).ind_packets.(i).ip_sign in  
 	extract_type_app env db (IndRef (kn,i),s) args
     | Case _ | Fix _ | CoFix _ -> Tunknown
@@ -295,8 +295,8 @@ and extract_ind env kn = (* kn is supposed to be in long form *)
     (* Everything concerning parameters. *)
     (* We do that first, since they are common to all the [mib]. *)
     let mip0 = mib.mind_packets.(0) in 
-    let npar = mip0.mind_nparams in
-    let epar = push_rel_context mip0.mind_params_ctxt env in
+    let npar = mib.mind_nparams in
+    let epar = push_rel_context mib.mind_params_ctxt env in
     (* First pass: we store inductive signatures together with *)
     (* their type var list. *)
     let packets = 
@@ -354,22 +354,22 @@ and extract_ind env kn = (* kn is supposed to be in long form *)
 	let rec names_prod t = match kind_of_term t with 
 	  | Prod(n,_,t) -> n::(names_prod t)
 	  | LetIn(_,_,_,t) -> names_prod t
-	  | Cast(t,_) -> names_prod t
+	  | Cast(t,_,_) -> names_prod t
 	  | _ -> []
 	in 
 	let field_names = 
-	  list_skipn mip0.mind_nparams (names_prod mip0.mind_user_lc.(0)) in 
+	  list_skipn mib.mind_nparams (names_prod mip0.mind_user_lc.(0)) in 
 	assert (List.length field_names = List.length typ);
-	let projs = ref KNset.empty in 
+	let projs = ref Cset.empty in 
 	let mp,d,_ = repr_kn kn in 
 	let rec select_fields l typs = match l,typs with 
 	  | [],[] -> []
 	  | (Name id)::l, typ::typs -> 
 	      if type_eq (mlt_env env) Tdummy typ then select_fields l typs 
 	      else  
-		let knp = make_kn mp d (label_of_id id) in 
+		let knp = make_con mp d (label_of_id id) in 
 		if not (List.mem false (type_to_sign (mlt_env env) typ)) then 
-		  projs := KNset.add knp !projs; 
+		  projs := Cset.add knp !projs; 
 		(ConstRef knp) :: (select_fields l typs)
 	  | Anonymous::l, typ::typs -> 
 	      if type_eq (mlt_env env) Tdummy typ then select_fields l typs
@@ -384,8 +384,8 @@ and extract_ind env kn = (* kn is supposed to be in long form *)
 	  let n = nb_default_params env mip0.mind_nf_arity in
 	  List.iter 
 	    (option_iter 
-	       (fun kn -> if KNset.mem kn !projs then add_projection n kn))
-	    (find_structure ip).s_PROJ 
+	       (fun kn -> if Cset.mem kn !projs then add_projection n kn))
+	    (lookup_structure ip).s_PROJ 
 	with Not_found -> ()
 	end; 
 	Record field_glob
@@ -419,7 +419,7 @@ and extract_type_cons env db dbmap c i =
 and mlt_env env r = match r with 
   | ConstRef kn -> 
       (try 
-	 if not (visible_kn kn) then raise Not_found; 
+	 if not (visible_con kn) then raise Not_found; 
 	 match lookup_term kn with 
 	   | Dtype (_,vl,mlt) -> Some mlt
 	   | _ -> None
@@ -448,7 +448,7 @@ let type_expunge env = type_expunge (mlt_env env)
 
 let record_constant_type env kn opt_typ = 
   try 
-    if not (visible_kn kn) then raise Not_found; 
+    if not (visible_con kn) then raise Not_found; 
     lookup_type kn 
   with Not_found ->
     let typ = match opt_typ with 
@@ -515,7 +515,7 @@ let rec extract_term env mle mlt c args =
  	extract_app env mle mlt (extract_fix env mle i recd) args 
     | CoFix (i,recd) ->
  	extract_app env mle mlt (extract_fix env mle i recd) args
-    | Cast (c, _) -> extract_term env mle mlt c args
+    | Cast (c,_,_) -> extract_term env mle mlt c args
     | Ind _ | Prod _ | Sort _ | Meta _ | Evar _ | Var _ -> assert false 
 
 (*s [extract_maybe_term] is [extract_term] for usual terms, else [MLdummy] *) 
@@ -678,7 +678,6 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt =
       end 
     else 
       let mi = extract_ind env kn in 
-      let params_nb = mi.ind_nparams in 
       let oi = mi.ind_packets.(i) in 
       let metas = Array.init (List.length oi.ip_vars) new_meta in 
       (* The extraction of the head. *)
diff --git a/contrib/extraction/extraction.mli b/contrib/extraction/extraction.mli
index fc5782c9..1dfd7e1a 100644
--- a/contrib/extraction/extraction.mli
+++ b/contrib/extraction/extraction.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: extraction.mli,v 1.27.2.1 2004/07/16 19:30:07 herbelin Exp $ i*)
+(*i $Id: extraction.mli 6303 2004-11-16 12:37:40Z sacerdot $ i*)
 
 (*s Extraction from Coq terms to Miniml. *)
 
@@ -17,12 +17,12 @@ open Environ
 open Libnames
 open Miniml
 
-val extract_constant : env -> kernel_name -> constant_body -> ml_decl
+val extract_constant : env -> constant -> constant_body -> ml_decl
 
-val extract_constant_spec : env -> kernel_name -> constant_body -> ml_spec
+val extract_constant_spec : env -> constant -> constant_body -> ml_spec
 
 val extract_fixpoint : 
-  env -> kernel_name array -> (constr, types) prec_declaration -> ml_decl 
+  env -> constant array -> (constr, types) prec_declaration -> ml_decl 
 
 val extract_inductive : env -> kernel_name -> ml_ind
 
diff --git a/contrib/extraction/g_extraction.ml4 b/contrib/extraction/g_extraction.ml4
index 33a6117d..13b29c7b 100644
--- a/contrib/extraction/g_extraction.ml4
+++ b/contrib/extraction/g_extraction.ml4
@@ -15,10 +15,7 @@ open Pcoq
 open Genarg
 open Pp
 
-let pr_mlname _ _ s =
-  spc () ++
-  (if !Options.v7 && not (Options.do_translate()) then qs s
-  else Pptacticnew.qsnew s)
+let pr_mlname _ _ _ s = spc () ++ qs s
 
 ARGUMENT EXTEND mlname
   TYPED AS string
@@ -37,21 +34,6 @@ VERNAC ARGUMENT EXTEND language
 | [ "Toplevel" ] -> [ Toplevel ]
 END
 
-(* Temporary for translator *)
-if !Options.v7 then
-  let pr_language _ _ = function
-    | Ocaml -> str " Ocaml"
-    | Haskell -> str " Haskell"
-    | Scheme -> str " Scheme"
-    | Toplevel -> str " Toplevel"
-  in
-  let globwit_language = Obj.magic rawwit_language in
-  let wit_language = Obj.magic rawwit_language in
-  Pptactic.declare_extra_genarg_pprule true
-    (rawwit_language, pr_language)
-    (globwit_language, pr_language)
-    (wit_language, pr_language);
-
 (* Extraction commands *)
 
 VERNAC COMMAND EXTEND Extraction
diff --git a/contrib/extraction/haskell.ml b/contrib/extraction/haskell.ml
index 3834fe81..c4ed364a 100644
--- a/contrib/extraction/haskell.ml
+++ b/contrib/extraction/haskell.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: haskell.ml,v 1.40.2.5 2005/12/16 04:11:28 letouzey Exp $ i*)
+(*i $Id: haskell.ml 7653 2005-12-16 04:12:26Z letouzey $ i*)
 
 (*s Production of Haskell syntax. *)
 
@@ -240,11 +240,11 @@ let pp_one_ind ip pl cv =
       	       	prlist_with_sep 
 		  (fun () -> (str " ")) (pp_type true pl) l))
   in
-  str (if cv = [||] then "type " else "data ") ++ 
+  str (if Array.length cv = 0 then "type " else "data ") ++ 
   pp_global (IndRef ip) ++ str " " ++
   prlist_with_sep (fun () -> str " ") pr_lower_id pl ++
   (if pl = [] then mt () else str " ") ++
-  if cv = [||] then str "= () -- empty inductive"
+  if Array.length cv = 0 then str "= () -- empty inductive"
   else 
     (v 0 (str "= " ++
 	  prvect_with_sep (fun () -> fnl () ++ str "  | ") pp_constructor 
diff --git a/contrib/extraction/haskell.mli b/contrib/extraction/haskell.mli
index 822444bd..106f7868 100644
--- a/contrib/extraction/haskell.mli
+++ b/contrib/extraction/haskell.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: haskell.mli,v 1.15.6.2 2005/12/01 17:01:22 letouzey Exp $ i*)
+(*i $Id: haskell.mli 7632 2005-12-01 14:35:21Z letouzey $ i*)
 
 open Pp
 open Names
diff --git a/contrib/extraction/miniml.mli b/contrib/extraction/miniml.mli
index 7c18f9f5..cf722e4e 100644
--- a/contrib/extraction/miniml.mli
+++ b/contrib/extraction/miniml.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: miniml.mli,v 1.46.2.3 2005/12/01 16:43:58 letouzey Exp $ i*)
+(*i $Id: miniml.mli 6064 2004-09-06 07:49:51Z letouzey $ i*)
 
 (*s Target language for extraction: a core ML called MiniML. *)
 
diff --git a/contrib/extraction/mlutil.ml b/contrib/extraction/mlutil.ml
index c01766b0..facab18e 100644
--- a/contrib/extraction/mlutil.ml
+++ b/contrib/extraction/mlutil.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: mlutil.ml,v 1.104.2.3 2005/12/01 16:28:04 letouzey Exp $ i*)
+(*i $Id: mlutil.ml 7574 2005-11-17 15:48:45Z letouzey $ i*)
 
 (*i*)
 open Pp
@@ -209,8 +209,8 @@ end
 (*s Does a section path occur in a ML type ? *)
 
 let rec type_mem_kn kn = function 
-  | Tmeta _ -> assert false
-  | Tglob (r,l) -> (kn_of_r r) = kn || List.exists (type_mem_kn kn) l
+  | Tmeta {contents = Some t} -> type_mem_kn kn t
+  | Tglob (r,l) -> occur_kn_in_ref kn r || List.exists (type_mem_kn kn) l
   | Tarr (a,b) -> (type_mem_kn kn a) || (type_mem_kn kn b)
   | _ -> false
 
@@ -218,7 +218,7 @@ let rec type_mem_kn kn = function
 
 let type_maxvar t = 
   let rec parse n = function 
-    | Tmeta _ -> assert false
+    | Tmeta {contents = Some t} -> parse n t
     | Tvar i -> max i n 
     | Tarr (a,b) -> parse (parse n a) b
     | Tglob (_,l) -> List.fold_left parse n l 
@@ -228,7 +228,7 @@ let type_maxvar t =
 (*s From [a -> b -> c] to [[a;b],c]. *) 
 
 let rec type_decomp = function 
-  | Tmeta _ -> assert false
+  | Tmeta {contents = Some t} -> type_decomp t 
   | Tarr (a,b) -> let l,h = type_decomp b in a::l, h 
   | a -> [],a
 
@@ -241,7 +241,7 @@ let rec type_recomp (l,t) = match l with
 (*s Translating [Tvar] to [Tvar'] to avoid clash. *)
 
 let rec var2var' = function 
-  | Tmeta _ -> assert false
+  | Tmeta {contents = Some t} -> var2var' t
   | Tvar i -> Tvar' i
   | Tarr (a,b) -> Tarr (var2var' a, var2var' b)
   | Tglob (r,l) -> Tglob (r, List.map var2var' l)
@@ -252,16 +252,17 @@ type abbrev_map = global_reference -> ml_type option
 (*s Delta-reduction of type constants everywhere in a ML type [t].
    [env] is a function of type [ml_type_env]. *)
 
+
 let type_expand env t = 
   let rec expand = function
-    | Tmeta _ -> assert false
-    | Tglob (r,l) as t ->    
+    | Tmeta {contents = Some t} -> expand t
+    | Tglob (r,l) ->    
 	(match env r with 
 	   | Some mlt -> expand (type_subst_list l mlt) 
 	   | None -> Tglob (r, List.map expand l))
     | Tarr (a,b) -> Tarr (expand a, expand b)
     | a -> a
-  in expand t
+  in if Table.type_expand () then expand t else t
 
 (*s Idem, but only at the top level of implications. *)
 
@@ -269,7 +270,7 @@ let is_arrow = function Tarr _ -> true | _ -> false
 
 let type_weak_expand env t = 
   let rec expand = function
-    | Tmeta _ -> assert false
+    | Tmeta {contents = Some t} -> expand t
     | Tglob (r,l) as t ->    
 	(match env r with 
 	   | Some mlt -> 
@@ -290,7 +291,7 @@ let type_neq env t t' = (type_expand env t <> type_expand env t')
 
 let type_to_sign env t = 
   let rec f = function 
-    | Tmeta _ -> assert false
+    | Tmeta {contents = Some t} -> f t 
     | Tarr (a,b) -> (Tdummy <> a) :: (f b)
     | _ -> [] 
   in f (type_expand env t)
@@ -304,7 +305,7 @@ let type_expunge env t =
     let rec f t s = 
       if List.mem false s then 
 	match t with 
-	  | Tmeta _ -> assert false
+	  | Tmeta {contents = Some t} -> f t s
 	  | Tarr (a,b) -> 
 	      let t = f b (List.tl s) in 
 	      if List.hd s then Tarr (a, t) else t  
@@ -377,7 +378,7 @@ let ast_iter f = function
   | MLapp (a,l) -> f a; List.iter f l
   | MLcons (_,c,l) -> List.iter f l
   | MLmagic a -> f a
-  | MLrel _ | MLglob _ | MLexn _ | MLdummy | MLaxiom as a -> ()
+  | MLrel _ | MLglob _ | MLexn _ | MLdummy | MLaxiom  -> ()
 
 (*S Operations concerning De Bruijn indices. *)
 
@@ -594,11 +595,12 @@ let rec linear_beta_red a t = match a,t with
   linear beta reductions at modified positions. *)  
 
 let rec ast_glob_subst s t = match t with 
-  | MLapp ((MLglob (ConstRef kn)) as f, a) -> 
+  | MLapp ((MLglob ((ConstRef kn) as refe)) as f, a) -> 
       let a = List.map (ast_glob_subst s) a in 
-      (try linear_beta_red a (KNmap.find kn s) 
+      (try linear_beta_red a (Refmap.find refe s) 
        with Not_found -> MLapp (f, a))
-  | MLglob (ConstRef kn) -> (try KNmap.find kn s with Not_found -> t)
+  | MLglob ((ConstRef kn) as refe) ->
+      (try Refmap.find refe s with Not_found -> t)
   | _ -> ast_map (ast_glob_subst s) t
 
 
@@ -653,7 +655,7 @@ let check_generalizable_case unsafe br =
 (*s Do all branches correspond to the same thing? *)
 
 let check_constant_case br = 
-  if br = [||] then raise Impossible; 
+  if Array.length br = 0 then raise Impossible; 
   let (r,l,t) = br.(0) in
   let n = List.length l in 
   if ast_occurs_itvl 1 n t then raise Impossible; 
@@ -1117,7 +1119,7 @@ let inline_test t =
 
 let manual_inline_list = 
   let mp = MPfile (dirpath_of_string "Coq.Init.Wf") in 
-  List.map (fun s -> (make_kn mp empty_dirpath (mk_label s)))
+  List.map (fun s -> (make_con mp empty_dirpath (mk_label s)))
     [ "well_founded_induction_type"; "well_founded_induction"; 
       "Acc_rect"; "Acc_rec" ; "Acc_iter" ]
 
diff --git a/contrib/extraction/mlutil.mli b/contrib/extraction/mlutil.mli
index eaf38778..1ba1df64 100644
--- a/contrib/extraction/mlutil.mli
+++ b/contrib/extraction/mlutil.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: mlutil.mli,v 1.47.2.1 2004/07/16 19:30:08 herbelin Exp $ i*)
+(*i $Id: mlutil.mli 6303 2004-11-16 12:37:40Z sacerdot $ i*)
 
 open Util
 open Names
@@ -101,7 +101,7 @@ val ast_lift : int -> ml_ast -> ml_ast
 val ast_pop : ml_ast -> ml_ast
 val ast_subst : ml_ast -> ml_ast -> ml_ast
 
-val ast_glob_subst : ml_ast KNmap.t -> ml_ast -> ml_ast
+val ast_glob_subst : ml_ast Refmap.t -> ml_ast -> ml_ast
 
 val normalize : ml_ast -> ml_ast 
 val optimize_fix : ml_ast -> ml_ast
diff --git a/contrib/extraction/modutil.ml b/contrib/extraction/modutil.ml
index 54f0c992..ff8daf46 100644
--- a/contrib/extraction/modutil.ml
+++ b/contrib/extraction/modutil.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: modutil.ml,v 1.7.2.4 2005/12/01 17:01:22 letouzey Exp $ i*)
+(*i $Id: modutil.ml 7632 2005-12-01 14:35:21Z letouzey $ i*)
 
 open Names
 open Declarations
@@ -16,6 +16,7 @@ open Util
 open Miniml
 open Table
 open Mlutil
+open Mod_subst
 
 (*S Functions upon modules missing in [Modops]. *) 
 
@@ -25,8 +26,9 @@ open Mlutil
 let add_structure mp msb env = 
   let add_one env (l,elem) = 
     let kn = make_kn mp empty_dirpath l in 
+    let con = make_con mp empty_dirpath l in 
     match elem with 
-      | SEBconst cb -> Environ.add_constant kn cb env 
+      | SEBconst cb -> Environ.add_constant con cb env 
       | SEBmind mib -> Environ.add_mind kn mib env 
       | SEBmodule mb -> Modops.add_module (MPdot (mp,l)) mb env 
       | SEBmodtype mtb -> Environ.add_modtype kn mtb env  
@@ -116,8 +118,15 @@ let rec parse_labels ll = function
 
 let labels_of_mp mp = parse_labels [] mp 
 
-let labels_of_kn kn = 
-  let mp,_,l = repr_kn kn in parse_labels [l] mp
+let labels_of_ref r = 
+ let mp,_,l =
+  match r with
+     ConstRef con -> repr_con con
+   | IndRef (kn,_)
+   | ConstructRef ((kn,_),_) -> repr_kn kn
+   | VarRef _ -> assert false
+ in
+  parse_labels [l] mp
 
 let rec add_labels_mp mp = function 
   | [] -> mp 
@@ -176,7 +185,7 @@ let ast_iter_references do_term do_cons do_type a =
       | MLcons (i,r,_) -> 
 	  if lang () = Ocaml then record_iter_references do_term i; 
 	  do_cons r 
-      | MLcase (i,_,v) as a -> 
+      | MLcase (i,_,v) -> 
 	  if lang () = Ocaml then record_iter_references do_term i; 
 	  Array.iter (fun (r,_,_) -> do_cons r) v
       | _ -> ()
@@ -307,8 +316,7 @@ let signature_of_structure s =
 
 let get_decl_in_structure r struc = 
   try 
-    let kn = kn_of_r r in 
-    let base_mp,ll = labels_of_kn kn in 
+    let base_mp,ll = labels_of_ref r in 
     if not (at_toplevel base_mp) then error_not_visible r;
     let sel = List.assoc base_mp struc in
     let rec go ll sel = match ll with 
@@ -336,16 +344,16 @@ let get_decl_in_structure r struc =
 let dfix_to_mlfix rv av i = 
   let rec make_subst n s = 
     if n < 0 then s 
-    else make_subst (n-1) (KNmap.add (kn_of_r rv.(n)) (n+1) s)
+    else make_subst (n-1) (Refmap.add rv.(n) (n+1) s)
   in 
-  let s = make_subst (Array.length rv - 1) KNmap.empty 
+  let s = make_subst (Array.length rv - 1) Refmap.empty 
   in 
   let rec subst n t = match t with 
-    | MLglob (ConstRef kn) -> 
-	(try MLrel (n + (KNmap.find kn s)) with Not_found -> t)
+    | MLglob ((ConstRef kn) as refe) -> 
+	(try MLrel (n + (Refmap.find refe s)) with Not_found -> t)
     | _ -> ast_map_lift subst n t 
   in 
-  let ids = Array.map (fun r -> id_of_label (label (kn_of_r r))) rv in 
+  let ids = Array.map (fun r -> id_of_label (label_of_r r)) rv in 
   let c = Array.map (subst 0) av 
   in MLfix(i, ids, c)
 
@@ -356,7 +364,7 @@ let rec optim prm s = function
   | Dterm (r,t,typ) :: l ->
       let t = normalize (ast_glob_subst !s t) in 
       let i = inline r t in 
-      if i then s := KNmap.add (kn_of_r r) t !s; 
+      if i then s := Refmap.add r t !s; 
       if not i || prm.modular || List.mem r prm.to_appear 
       then 
 	let d = match optimize_fix t with 
@@ -370,10 +378,9 @@ let rec optim prm s = function
 let rec optim_se top prm s = function 
   | [] -> [] 
   | (l,SEdecl (Dterm (r,a,t))) :: lse -> 
-      let kn = kn_of_r r in 
       let a = normalize (ast_glob_subst !s a) in 
       let i = inline r a in 
-      if i then s := KNmap.add kn a !s; 
+      if i then s := Refmap.add r a !s; 
       if top && i && not prm.modular && not (List.mem r prm.to_appear)
       then optim_se top prm s lse
       else 
@@ -389,7 +396,7 @@ let rec optim_se top prm s = function
       let fake_body = MLfix (0,[||],[||]) in 
       for i = 0 to Array.length rv - 1 do 
 	if inline rv.(i) fake_body
-	then s := KNmap.add (kn_of_r rv.(i)) (dfix_to_mlfix rv av i) !s
+	then s := Refmap.add rv.(i) (dfix_to_mlfix rv av i) !s
 	else all := false
       done; 
       if !all && top && not prm.modular 
@@ -408,6 +415,6 @@ and optim_me prm s = function
   | MEfunctor (mbid,mt,me) -> MEfunctor (mbid,mt, optim_me prm s me)
 
 let optimize_struct prm before struc = 
-  let subst = ref (KNmap.empty : ml_ast KNmap.t) in 
+  let subst = ref (Refmap.empty : ml_ast Refmap.t) in 
   option_iter (fun l -> ignore (optim prm subst l)) before; 
   List.map (fun (mp,lse) -> (mp, optim_se true prm subst lse)) struc
diff --git a/contrib/extraction/modutil.mli b/contrib/extraction/modutil.mli
index 7f8c4113..f5208c0d 100644
--- a/contrib/extraction/modutil.mli
+++ b/contrib/extraction/modutil.mli
@@ -6,13 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: modutil.mli,v 1.2.2.2 2005/12/01 17:01:22 letouzey Exp $ i*)
+(*i $Id: modutil.mli 7632 2005-12-01 14:35:21Z letouzey $ i*)
 
 open Names
 open Declarations
 open Environ
 open Libnames
 open Miniml
+open Mod_subst
 
 (*s Functions upon modules missing in [Modops]. *) 
 
diff --git a/contrib/extraction/ocaml.ml b/contrib/extraction/ocaml.ml
index ff9cfd21..a0620d72 100644
--- a/contrib/extraction/ocaml.ml
+++ b/contrib/extraction/ocaml.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ocaml.ml,v 1.100.2.6 2005/12/01 17:01:22 letouzey Exp $ i*)
+(*i $Id: ocaml.ml 7632 2005-12-01 14:35:21Z letouzey $ i*)
 
 (*s Production of Ocaml syntax. *)
 
@@ -264,7 +264,6 @@ let rec pp_expr par env args =
 	let tuple = pp_tuple (pp_expr true env []) args' in 
 	pp_par par (pp_global r ++ spc () ++ tuple)
     | MLcase (i, t, pv) ->
-	let r,_,_ = pv.(0) in 
 	let expr = if i = Coinductive then 
 	  (str "Lazy.force" ++ spc () ++ pp_expr true env [] t)
 	else 
@@ -409,7 +408,7 @@ let pp_one_ind prefix ip pl cv =
 			(fun () -> spc () ++ str "* ") (pp_type true pl) l))
   in
   pp_parameters pl ++ str prefix ++ pp_global (IndRef ip) ++ str " =" ++ 
-  if cv = [||] then str " unit (* empty inductive *)" 
+  if Array.length cv = 0 then str " unit (* empty inductive *)" 
   else fnl () ++ v 0 (prvect_with_sep fnl pp_constructor
 			(Array.mapi (fun i c -> ConstructRef (ip,i+1), c) cv))
 
@@ -480,13 +479,13 @@ let pp_mind kn i =
 let pp_decl mpl = 
   local_mpl := mpl; 
   function
-    | Dind (kn,i) as d -> pp_mind kn i
+    | Dind (kn,i) -> pp_mind kn i
     | Dtype (r, l, t) ->
 	if is_inline_custom r then failwith "empty phrase"
 	else 
-	  let pp_r = pp_global r in 
+          let pp_r = pp_global r in 
 	  let l = rename_tvars keywords l in 
-	  let ids, def = try 
+          let ids, def = try 
 	    let ids,s = find_type_custom r in 
 	    pp_string_parameters ids, str "=" ++ spc () ++ str s 
 	  with not_found -> 
diff --git a/contrib/extraction/ocaml.mli b/contrib/extraction/ocaml.mli
index 5015a50d..8c521ccd 100644
--- a/contrib/extraction/ocaml.mli
+++ b/contrib/extraction/ocaml.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ocaml.mli,v 1.26.6.3 2005/12/01 17:01:22 letouzey Exp $ i*)
+(*i $Id: ocaml.mli 7632 2005-12-01 14:35:21Z letouzey $ i*)
 
 (*s Some utility functions to be reused in module [Haskell]. *)
 
diff --git a/contrib/extraction/scheme.ml b/contrib/extraction/scheme.ml
index 4a881da2..7004a202 100644
--- a/contrib/extraction/scheme.ml
+++ b/contrib/extraction/scheme.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: scheme.ml,v 1.9.2.5 2005/12/16 03:07:39 letouzey Exp $ i*)
+(*i $Id: scheme.ml 7651 2005-12-16 03:19:20Z letouzey $ i*)
 
 (*s Production of Scheme syntax. *)
 
diff --git a/contrib/extraction/scheme.mli b/contrib/extraction/scheme.mli
index 2a828fb9..ef4a3a63 100644
--- a/contrib/extraction/scheme.mli
+++ b/contrib/extraction/scheme.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: scheme.mli,v 1.6.6.2 2005/12/01 17:01:22 letouzey Exp $ i*)
+(*i $Id: scheme.mli 7632 2005-12-01 14:35:21Z letouzey $ i*)
 
 (*s Some utility functions to be reused in module [Haskell]. *)
 
diff --git a/contrib/extraction/table.ml b/contrib/extraction/table.ml
index 9d73d13f..bd4fe924 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,v 1.35.2.2 2005/11/29 21:40:51 letouzey Exp $ i*)
+(*i $Id: table.ml 6555 2005-01-03 19:25:36Z sacerdot $ i*)
 
 open Names
 open Term
@@ -22,10 +22,23 @@ open Miniml
 
 (*S Utilities concerning [module_path] and [kernel_names] *)
 
-let kn_of_r r = match r with 
-    | ConstRef kn -> kn
-    | IndRef (kn,_) -> kn
-    | ConstructRef ((kn,_),_) -> kn
+let occur_kn_in_ref kn =
+ function
+  | IndRef (kn',_)
+  | ConstructRef ((kn',_),_) -> kn = kn'
+  | ConstRef _ -> false
+  | VarRef _ -> assert false
+
+let modpath_of_r r = match r with 
+    | ConstRef kn -> con_modpath kn
+    | IndRef (kn,_)
+    | ConstructRef ((kn,_),_) -> modpath kn
+    | VarRef _ -> assert false
+
+let label_of_r r = match r with 
+    | ConstRef kn -> con_label kn
+    | IndRef (kn,_)
+    | ConstructRef ((kn,_),_) -> label kn
     | VarRef _ -> assert false
 
 let current_toplevel () = fst (Lib.current_prefix ())
@@ -45,21 +58,22 @@ let at_toplevel mp =
   is_modfile mp || is_toplevel mp
 
 let visible_kn kn = at_toplevel (base_mp (modpath kn))
+let visible_con kn = at_toplevel (base_mp (con_modpath kn))
 
 
 (*S The main tables: constants, inductives, records, ... *)
 
 (*s Constants tables. *) 
 
-let terms = ref (KNmap.empty : ml_decl KNmap.t)
-let init_terms () = terms := KNmap.empty
-let add_term kn d = terms := KNmap.add kn d !terms
-let lookup_term kn = KNmap.find kn !terms
+let terms = ref (Cmap.empty : ml_decl Cmap.t)
+let init_terms () = terms := Cmap.empty
+let add_term kn d = terms := Cmap.add kn d !terms
+let lookup_term kn = Cmap.find kn !terms
 
-let types = ref (KNmap.empty : ml_schema KNmap.t)
-let init_types () = types := KNmap.empty
-let add_type kn s = types := KNmap.add kn s !types
-let lookup_type kn = KNmap.find kn !types 
+let types = ref (Cmap.empty : ml_schema Cmap.t)
+let init_types () = types := Cmap.empty
+let add_type kn s = types := Cmap.add kn s !types
+let lookup_type kn = Cmap.find kn !types 
 
 (*s Inductives table. *)
 
@@ -70,22 +84,22 @@ let lookup_ind kn = KNmap.find kn !inductives
 
 (*s Recursors table. *)
 
-let recursors = ref KNset.empty
-let init_recursors () = recursors := KNset.empty
+let recursors = ref Cset.empty
+let init_recursors () = recursors := Cset.empty
 
 let add_recursors env kn = 
-  let make_kn id = make_kn (modpath kn) empty_dirpath (label_of_id id) in 
+  let make_kn id = make_con (modpath kn) empty_dirpath (label_of_id id) in 
   let mib = Environ.lookup_mind kn env in 
   Array.iter 
     (fun mip -> 
        let id = mip.mind_typename in 
        let kn_rec = make_kn (Nameops.add_suffix id "_rec")
        and kn_rect = make_kn (Nameops.add_suffix id "_rect") in 
-       recursors := KNset.add kn_rec (KNset.add kn_rect !recursors))
+       recursors := Cset.add kn_rec (Cset.add kn_rect !recursors))
     mib.mind_packets
 
 let is_recursor = function 
-  | ConstRef kn -> KNset.mem kn !recursors
+  | ConstRef kn -> Cset.mem kn !recursors
   | _ -> false
 
 (*s Record tables. *)
@@ -109,7 +123,7 @@ let reset_tables () =
    done before. *)
 
 let id_of_global = function 
-  | ConstRef kn -> let _,_,l = repr_kn kn in id_of_label l
+  | ConstRef kn -> let _,_,l = repr_con kn in id_of_label l
   | IndRef (kn,i) -> (lookup_ind kn).ind_packets.(i).ip_typename
   | ConstructRef ((kn,i),j) -> (lookup_ind kn).ind_packets.(i).ip_consnames.(j-1)
   | _ -> assert false
@@ -207,6 +221,18 @@ let _ = declare_bool_option
 	   optread = auto_inline; 
 	   optwrite = (:=) auto_inline_ref}
 
+(*s Extraction TypeExpand *)
+
+let type_expand_ref = ref true
+
+let type_expand () = !type_expand_ref
+
+let _ = declare_bool_option 
+	  {optsync = true;
+	   optname = "Extraction TypeExpand";
+	   optkey = SecondaryTable ("Extraction", "TypeExpand");
+	   optread = type_expand; 
+	   optwrite = (:=) type_expand_ref}
 
 (*s Extraction Optimize *)
 
@@ -311,14 +337,22 @@ let add_inline_entries b l =
 
 (* Registration of operations for rollback. *)
 
-let (inline_extraction,_) = 
+let (inline_extraction,_) =
   declare_object 
     {(default_object "Extraction Inline") with 
        cache_function = (fun (_,(b,l)) -> add_inline_entries b l);
        load_function = (fun _ (_,(b,l)) -> add_inline_entries b l);
        export_function = (fun x -> Some x); 
        classify_function = (fun (_,o) -> Substitute o); 
-       subst_function = (fun (_,s,(b,l)) -> (b,(List.map (subst_global s) l))) }
+       (*CSC: The following substitution may istantiate a realized parameter.
+         The right solution would be to make the substitution erase the
+         realizer from the table. However, this is not allowed by Coq.
+         In this particular case, though, keeping the realizer is place seems
+         to be harmless since the current code looks for a realizer only
+         when the constant is a parameter. However, if this behaviour changes
+         subtle bugs can happear in the future. *)
+       subst_function =
+        (fun (_,s,(b,l)) -> (b,(List.map (fun x -> fst (subst_global s x)) l)))}
 
 let _ = declare_summary "Extraction Inline"
 	  { freeze_function = (fun () -> !inline_table);
diff --git a/contrib/extraction/table.mli b/contrib/extraction/table.mli
index 6160452a..66662138 100644
--- a/contrib/extraction/table.mli
+++ b/contrib/extraction/table.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: table.mli,v 1.25.2.2 2005/11/29 21:40:51 letouzey Exp $ i*)
+(*i $Id: table.mli 6441 2004-12-09 02:27:09Z letouzey $ i*)
 
 open Names
 open Libnames
@@ -35,7 +35,9 @@ val check_inside_section : unit -> unit
 
 (*s utilities concerning [module_path]. *)
 
-val kn_of_r : global_reference -> kernel_name
+val occur_kn_in_ref : kernel_name -> global_reference -> bool
+val modpath_of_r : global_reference -> module_path
+val label_of_r : global_reference -> label
 
 val current_toplevel : unit -> module_path
 val base_mp : module_path -> module_path
@@ -43,14 +45,15 @@ val is_modfile : module_path -> bool
 val is_toplevel : module_path -> bool
 val at_toplevel : module_path -> bool 
 val visible_kn : kernel_name -> bool
+val visible_con : constant -> bool
 
 (*s Some table-related operations *)
 
-val add_term : kernel_name -> ml_decl -> unit
-val lookup_term : kernel_name -> ml_decl
+val add_term : constant -> ml_decl -> unit
+val lookup_term : constant -> ml_decl
 
-val add_type : kernel_name -> ml_schema -> unit
-val lookup_type : kernel_name -> ml_schema
+val add_type : constant -> ml_schema -> unit
+val lookup_type : constant -> ml_schema
 
 val add_ind : kernel_name -> ml_ind -> unit
 val lookup_ind : kernel_name -> ml_ind
@@ -58,7 +61,7 @@ val lookup_ind : kernel_name -> ml_ind
 val add_recursors : Environ.env -> kernel_name -> unit
 val is_recursor : global_reference -> bool 
 
-val add_projection : int -> kernel_name -> unit
+val add_projection : int -> constant -> unit
 val is_projection : global_reference -> bool 
 val projection_arity : global_reference -> int
 
@@ -68,6 +71,10 @@ val reset_tables : unit -> unit
 
 val auto_inline : unit -> bool
 
+(*s TypeExpand parameter *) 
+
+val type_expand : unit -> bool
+
 (*s Optimize parameter *) 
 
 type opt_flag = 
diff --git a/contrib/field/Field.v b/contrib/field/Field.v
index 7b48e275..3cc097fc 100644
--- a/contrib/field/Field.v
+++ b/contrib/field/Field.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field.v,v 1.6.2.1 2004/07/16 19:30:09 herbelin Exp $ *)
+(* $Id: Field.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Field_Compl.
 Require Export Field_Theory.
diff --git a/contrib/field/Field_Compl.v b/contrib/field/Field_Compl.v
index cba921f7..774b3084 100644
--- a/contrib/field/Field_Compl.v
+++ b/contrib/field/Field_Compl.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field_Compl.v,v 1.8.2.1 2004/07/16 19:30:09 herbelin Exp $ *)
+(* $Id: Field_Compl.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Inductive listT (A:Type) : Type :=
   | nilT : listT A
diff --git a/contrib/field/Field_Tactic.v b/contrib/field/Field_Tactic.v
index c5c06547..afa0a814 100644
--- a/contrib/field/Field_Tactic.v
+++ b/contrib/field/Field_Tactic.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field_Tactic.v,v 1.20.2.1 2004/07/16 19:30:09 herbelin Exp $ *)
+(* $Id: Field_Tactic.v 8134 2006-03-05 16:39:17Z herbelin $ *)
 
 Require Import Ring.
 Require Export Field_Compl.
@@ -14,6 +14,10 @@ Require Export Field_Theory.
 
 (**** Interpretation A --> ExprA ****)
 
+Ltac get_component a s := eval cbv beta iota delta [a] in (a s).
+
+Ltac body_of s := eval cbv beta iota delta [s] in s.
+
 Ltac mem_assoc var lvar :=
   match constr:lvar with
   | (nilT _) => constr:false
@@ -24,49 +28,46 @@ Ltac mem_assoc var lvar :=
       end
   end.
 
-Ltac seek_var_aux FT lvar trm :=
-  let AT := eval cbv beta iota delta [A] in (A FT)
-  with AzeroT := eval cbv beta iota delta [Azero] in (Azero FT)
-  with AoneT := eval cbv beta iota delta [Aone] in (Aone FT)
-  with AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT)
-  with AmultT := eval cbv beta iota delta [Amult] in (Amult FT)
-  with AoppT := eval cbv beta iota delta [Aopp] in (Aopp FT)
-  with AinvT := eval cbv beta iota delta [Ainv] in (Ainv FT) in
-  match constr:trm with
-  | AzeroT => lvar
-  | AoneT => lvar
-  | (AplusT ?X1 ?X2) =>
-      let l1 := seek_var_aux FT lvar X1 in
-      seek_var_aux FT l1 X2
-  | (AmultT ?X1 ?X2) =>
-      let l1 := seek_var_aux FT lvar X1 in
-      seek_var_aux FT l1 X2
-  | (AoppT ?X1) => seek_var_aux FT lvar X1
-  | (AinvT ?X1) => seek_var_aux FT lvar X1
-  | ?X1 =>
-      let res := mem_assoc X1 lvar in
-      match constr:res with
-      | true => lvar
-      | false => constr:(consT AT X1 lvar)
-      end
-  end.
-
-Ltac seek_var FT trm :=
-  let AT := eval cbv beta iota delta [A] in (A FT) in
-  seek_var_aux FT (nilT AT) trm.
-
-Ltac number_aux lvar cpt :=
-  match constr:lvar with
-  | (nilT ?X1) => constr:(nilT (prodT X1 nat))
-  | (consT ?X1 ?X2 ?X3) =>
-      let l2 := number_aux X3 (S cpt) in
-      constr:(consT (prodT X1 nat) (pairT X1 nat X2 cpt) l2)
-  end.
-
-Ltac number lvar := number_aux lvar 0.
-
-Ltac build_varlist FT trm := let lvar := seek_var FT trm in
-                             number lvar.
+Ltac number lvar := 
+  let rec number_aux lvar cpt :=
+    match constr:lvar with
+    | (nilT ?X1) => constr:(nilT (prodT X1 nat))
+    | (consT ?X1 ?X2 ?X3) =>
+        let l2 := number_aux X3 (S cpt) in
+        constr:(consT (prodT X1 nat) (pairT X1 nat X2 cpt) l2) 
+    end
+  in number_aux lvar 0.
+
+Ltac build_varlist FT trm := 
+  let rec seek_var lvar trm :=
+    let AT := get_component A FT
+    with AzeroT := get_component Azero FT
+    with AoneT := get_component Aone FT
+    with AplusT := get_component Aplus FT
+    with AmultT := get_component Amult FT
+    with AoppT := get_component Aopp FT
+    with AinvT := get_component Ainv FT in
+    match constr:trm with
+    | AzeroT => lvar
+    | AoneT => lvar
+    | (AplusT ?X1 ?X2) =>
+        let l1 := seek_var lvar X1 in
+        seek_var l1 X2
+    | (AmultT ?X1 ?X2) =>
+        let l1 := seek_var lvar X1 in
+        seek_var l1 X2
+    | (AoppT ?X1) => seek_var lvar X1
+    | (AinvT ?X1) => seek_var lvar X1
+    | ?X1 =>
+        let res := mem_assoc X1 lvar in
+        match constr:res with
+        | true => lvar
+        | false => constr:(consT AT X1 lvar)
+        end
+    end in
+  let AT := get_component A FT in
+  let lvar := seek_var (nilT AT) trm in
+  number lvar.
 
 Ltac assoc elt lst :=
   match constr:lst with
@@ -79,13 +80,13 @@ Ltac assoc elt lst :=
   end.
 
 Ltac interp_A FT lvar trm :=
-  let AT := eval cbv beta iota delta [A] in (A FT)
-  with AzeroT := eval cbv beta iota delta [Azero] in (Azero FT)
-  with AoneT := eval cbv beta iota delta [Aone] in (Aone FT)
-  with AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT)
-  with AmultT := eval cbv beta iota delta [Amult] in (Amult FT)
-  with AoppT := eval cbv beta iota delta [Aopp] in (Aopp FT)
-  with AinvT := eval cbv beta iota delta [Ainv] in (Ainv FT) in
+  let AT := get_component A FT
+  with AzeroT := get_component Azero FT
+  with AoneT := get_component Aone FT
+  with AplusT := get_component Aplus FT
+  with AmultT := get_component Amult FT
+  with AoppT := get_component Aopp FT
+  with AinvT := get_component Ainv FT in
   match constr:trm with
   | AzeroT => constr:EAzero
   | AoneT => constr:EAone
@@ -181,18 +182,17 @@ Ltac weak_reduce :=
 
 Ltac multiply mul :=
   match goal with
-  |  |- (interp_ExprA ?X1 ?X2 ?X3 = interp_ExprA ?X1 ?X2 ?X4) =>
-      let AzeroT := eval cbv beta iota delta [Azero X1] in (Azero X1) in
-      (cut (interp_ExprA X1 X2 mul <> AzeroT);
-        [ intro; let id := grep_mult in
-                 apply (mult_eq X1 X3 X4 mul X2 id)
+  |  |- (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 := eval cbv beta iota delta [Aone X1] in (Aone X1)
-           with AmultT := eval cbv beta iota delta [Amult X1] in (Amult X1) in
+           let AoneT := get_component Aone ltac:(body_of FT)
+           with AmultT := get_component Amult ltac:(body_of FT) in
            (try
              match goal with
-             |  |- context [(AmultT _ AoneT)] => rewrite (AmultT_1r X1)
-             end; clear X1 X2) ])
+             |  |- context [(AmultT _ AoneT)] => rewrite (AmultT_1r FT)
+             end; clear FT X2) ])
   end.
 
 Ltac apply_multiply FT lvar trm :=
@@ -219,10 +219,10 @@ Ltac apply_inverse mul FT lvar trm :=
 Ltac strong_fail tac := first [ tac | fail 2 ].
 
 Ltac inverse_test_aux FT trm :=
-  let AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT)
-  with AmultT := eval cbv beta iota delta [Amult] in (Amult FT)
-  with AoppT := eval cbv beta iota delta [Aopp] in (Aopp FT)
-  with AinvT := eval cbv beta iota delta [Ainv] in (Ainv FT) in
+  let AplusT := get_component Aplus FT
+  with AmultT := get_component Amult FT
+  with AoppT := get_component Aopp FT
+  with AinvT := get_component Ainv FT in
   match constr:trm with
   | (AinvT _) => fail 1
   | (AoppT ?X1) =>
@@ -235,7 +235,7 @@ Ltac inverse_test_aux FT trm :=
   end.
 
 Ltac inverse_test FT :=
-  let AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT) in
+  let AplusT := get_component Aplus FT in
   match goal with
   |  |- (?X1 = ?X2) => inverse_test_aux FT (AplusT X1 X2)
   end.
@@ -253,27 +253,27 @@ Ltac apply_simplif sfun :=
    end.
 
 Ltac unfolds FT :=
-  match eval cbv beta iota delta [Aminus] in (Aminus FT) with
+  match get_component Aminus FT with
   | (Field_Some _ ?X1) => unfold X1 in |- *
   | _ => idtac
   end;
-   match eval cbv beta iota delta [Adiv] in (Adiv FT) with
+   match get_component Adiv FT with
    | (Field_Some _ ?X1) => unfold X1 in |- *
    | _ => idtac
    end.
 
 Ltac reduce FT :=
-  let AzeroT := eval cbv beta iota delta [Azero] in (Azero FT)
-  with AoneT := eval cbv beta iota delta [Aone] in (Aone FT)
-  with AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT)
-  with AmultT := eval cbv beta iota delta [Amult] in (Amult FT)
-  with AoppT := eval cbv beta iota delta [Aopp] in (Aopp FT)
-  with AinvT := eval cbv beta iota delta [Ainv] in (Ainv FT) in
+  let AzeroT := get_component Azero FT
+  with AoneT := get_component Aone FT
+  with AplusT := get_component Aplus FT
+  with AmultT := get_component Amult FT
+  with AoppT := get_component Aopp FT
+  with AinvT := get_component Ainv FT in
   (cbv beta iota zeta delta -[AzeroT AoneT AplusT AmultT AoppT AinvT] in |- * ||
      compute in |- *).
 
 Ltac field_gen_aux FT :=
-  let AplusT := eval cbv beta iota delta [Aplus] in (Aplus FT) in
+  let AplusT := get_component Aplus FT in
   match goal with
   |  |- (?X1 = ?X2) =>
       let lvar := build_varlist FT (AplusT X1 X2) in
@@ -303,11 +303,11 @@ Ltac field_gen FT := unfolds FT; (inverse_test FT; ring) || field_gen_aux FT.
 
 Ltac init_exp FT trm :=
   let e :=
-   (match eval cbv beta iota delta [Aminus] in (Aminus FT) with
+   (match get_component Aminus FT with
     | (Field_Some _ ?X1) => eval cbv beta delta [X1] in trm
     | _ => trm
     end) in
-  match eval cbv beta iota delta [Adiv] in (Adiv FT) with
+  match get_component Adiv FT with
   | (Field_Some _ ?X1) => eval cbv beta delta [X1] in e
   | _ => e
   end.
@@ -429,4 +429,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 ]).
\ No newline at end of file
+  (replace exp with trep; [ ring trep | field_gen FT ]).
diff --git a/contrib/field/Field_Theory.v b/contrib/field/Field_Theory.v
index 8737fd79..2c954652 100644
--- a/contrib/field/Field_Theory.v
+++ b/contrib/field/Field_Theory.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field_Theory.v,v 1.12.2.1 2004/07/16 19:30:09 herbelin Exp $ *)
+(* $Id: Field_Theory.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Import Peano_dec.
 Require Import Ring.
diff --git a/contrib/field/field.ml4 b/contrib/field/field.ml4
index 32adec66..35591f23 100644
--- a/contrib/field/field.ml4
+++ b/contrib/field/field.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: field.ml4,v 1.33.2.1 2004/07/16 19:30:09 herbelin Exp $ *)
+(* $Id: field.ml4 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 open Names
 open Pp
@@ -21,6 +21,7 @@ open Util
 open Vernacinterp
 open Vernacexpr
 open Tacexpr
+open Mod_subst
 
 (* Interpretation of constr's *)
 let constr_of c = Constrintern.interp_constr Evd.empty (Global.env()) c
@@ -43,7 +44,7 @@ let lookup env typ =
   with Not_found -> 
     errorlabstrm "field"
       (str "No field is declared for type" ++ spc() ++
-      Printer.prterm_env env typ)
+      Printer.pr_lconstr_env env typ)
 
 let _ = 
   let init () = th_tab := Gmap.empty in
@@ -113,8 +114,8 @@ END
 *)
 
 (* For the translator, otherwise the code above is OK *)
-open Ppconstrnew
-let pp_minus_div_arg _prc _prt (omin,odiv) = 
+open Ppconstr
+let pp_minus_div_arg _prc _prlc _prt (omin,odiv) = 
   if omin=None && odiv=None then mt() else
     spc() ++ str "with" ++
     pr_opt (fun c -> str "minus := " ++ _prc c) omin ++
@@ -149,8 +150,7 @@ END
 
 (* Guesses the type and calls field_gen with the right theory *)
 let field g =
-  Library.check_required_library ["Coq";"field";"Field"];
-  let ist = { lfun=[]; debug=get_debug () } in
+  Coqlib.check_required_library ["Coq";"field";"Field"];
   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
@@ -172,7 +172,7 @@ let guess_theory env evc = function
 
 (* Guesses the type and calls Field_Term with the right theory *)
 let field_term l g =
-  Library.check_required_library ["Coq";"field";"Field"];
+  Coqlib.check_required_library ["Coq";"field";"Field"];
   let env = (pf_env g)
   and evc = (project g) in
   let th = valueIn (VConstr (guess_theory env evc l))
@@ -184,7 +184,7 @@ let field_term l g =
 
 (* Declaration of Field *)
 
-TACTIC EXTEND Field
-| [ "Field" ] -> [ field ]
-| [ "Field" ne_constr_list(l) ] -> [ field_term l ]
+TACTIC EXTEND field
+| [ "field" ] -> [ field ]
+| [ "field" ne_constr_list(l) ] -> [ field_term l ]
 END
diff --git a/contrib/first-order/formula.ml b/contrib/first-order/formula.ml
index 49cb8e25..fde48d2b 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,v 1.18.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: formula.ml 7493 2005-11-02 22:12:16Z mohring $ *)
 
 open Hipattern
 open Names
@@ -47,14 +47,14 @@ let rec nb_prod_after n c=
 
 let construct_nhyps ind gls =
   let env=pf_env gls in
-  let nparams = (snd (Global.lookup_inductive ind)).mind_nparams in
-  let constr_types = Inductive.arities_of_constructors (pf_env gls) ind 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	
     Array.map hyp constr_types
 
 (* indhyps builds the array of arrays of constructor hyps for (ind largs)*)
 let ind_hyps nevar ind largs gls= 
-  let types= Inductive.arities_of_constructors (pf_env gls) ind in 
+  let types= Inductiveops.arities_of_constructors (pf_env gls) ind in 
   let lp=Array.length types in     
   let myhyps i=
     let t1=Term.prod_applist types.(i) largs in
@@ -99,7 +99,7 @@ let rec kind_of_formula gl term =
 			let has_realargs=(n>0) in
 			let is_trivial=
 			  let is_constant c =
-			    nb_prod c = mip.mind_nparams in  
+			    nb_prod c = mib.mind_nparams in  
 			    array_exists is_constant mip.mind_nf_lc in 
 			  if Inductiveops.mis_is_recursive (ind,mib,mip) ||
 			    (has_realargs && not is_trivial)
diff --git a/contrib/first-order/formula.mli b/contrib/first-order/formula.mli
index db24f20f..8703045c 100644
--- a/contrib/first-order/formula.mli
+++ b/contrib/first-order/formula.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: formula.mli,v 1.17.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: formula.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Term
 open Names
diff --git a/contrib/first-order/g_ground.ml4 b/contrib/first-order/g_ground.ml4
index f85f2171..0970d5db 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,v 1.10.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: g_ground.ml4 7909 2006-01-21 11:09:18Z herbelin $ *)
 
 open Formula
 open Sequent
@@ -41,7 +41,7 @@ let _=
       
 let default_solver=(Tacinterp.interp <:tactic<auto with *>>)
     
-let fail_solver=tclFAIL 0 "GTauto failed"
+let fail_solver=tclFAIL 0 (Pp.str "GTauto failed")
 		      
 type external_env=
     Ids of global_reference list
@@ -81,23 +81,16 @@ let normalize_evaluables=
 	   unfold_in_hyp (Lazy.force defined_connectives) 
 	   (Tacexpr.InHypType id)) *)
 
-TACTIC EXTEND Firstorder
-    [ "Firstorder" tactic_opt(t) "with" ne_reference_list(l) ] -> 
+TACTIC EXTEND firstorder
+    [ "firstorder" tactic_opt(t) "with" ne_reference_list(l) ] -> 
       [ gen_ground_tac true (option_app eval_tactic t) (Ids l) ]
-|   [ "Firstorder" tactic_opt(t) "using" ne_preident_list(l) ] -> 
+|   [ "firstorder" tactic_opt(t) "using" ne_preident_list(l) ] -> 
       [ gen_ground_tac true (option_app eval_tactic t) (Bases l) ]
-|   [ "Firstorder" tactic_opt(t) ] -> 
+|   [ "firstorder" tactic_opt(t) ] -> 
       [ gen_ground_tac true (option_app eval_tactic t) Void ]
 END
 
-(* Obsolete since V8.0
-TACTIC EXTEND GTauto   
-  [ "GTauto" ] ->
-     [ gen_ground_tac false (Some fail_solver) Void ]   
-END
-*)
-
-TACTIC EXTEND GIntuition
-  [ "GIntuition" tactic_opt(t) ] ->
+TACTIC EXTEND gintuition
+  [ "gintuition" tactic_opt(t) ] ->
      [ gen_ground_tac false (option_app eval_tactic t) Void ]
 END
diff --git a/contrib/first-order/ground.ml b/contrib/first-order/ground.ml
index 23e27a3c..bb096308 100644
--- a/contrib/first-order/ground.ml
+++ b/contrib/first-order/ground.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ground.ml,v 1.5.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: ground.ml 7909 2006-01-21 11:09:18Z herbelin $ *)
 
 open Formula
 open Sequent
@@ -45,23 +45,23 @@ let update_flags ()=
 *)
 
 let update_flags ()=
-  let predref=ref Names.KNpred.empty in
+  let predref=ref Names.Cpred.empty in
   let f coe=
     try
       let kn=destConst (Classops.get_coercion_value coe) in
-	predref:=Names.KNpred.add kn !predref
+	predref:=Names.Cpred.add kn !predref
     with Invalid_argument "destConst"-> () in
     List.iter f (Classops.coercions ());
     red_flags:=
     Closure.RedFlags.red_add_transparent 
       Closure.betaiotazeta 
-      (Names.Idpred.full,Names.KNpred.complement !predref)
+      (Names.Idpred.full,Names.Cpred.complement !predref)
 
 let ground_tac solver startseq gl=
   update_flags ();
   let rec toptac skipped seq gl=
     if Tacinterp.get_debug()=Tactic_debug.DebugOn 0
-    then Pp.msgnl (Proof_trees.pr_goal (sig_it gl));
+    then Pp.msgnl (Printer.pr_goal (sig_it gl));
     tclORELSE (axiom_tac seq.gl seq)
       begin
 	try      
@@ -78,7 +78,7 @@ let ground_tac solver startseq gl=
 		      | Rforall->
 			  let backtrack1=
 			    if !qflag then 
-			      tclFAIL 0 "reversible in 1st order mode"
+			      tclFAIL 0 (Pp.str "reversible in 1st order mode")
 			    else
 			      backtrack in
 			    forall_tac backtrack continue (re_add seq1)
@@ -117,7 +117,8 @@ let ground_tac solver startseq gl=
 			      backtrack2 (* need special backtracking *)
   		      | Lexists ind ->
 			  if !qflag then 
-			    left_exists_tac ind hd.id continue (re_add seq1)
+			    left_exists_tac ind backtrack hd.id
+			      continue (re_add seq1)
 			  else backtrack
 		      | LA (typ,lap)->
 			  let la_tac=
diff --git a/contrib/first-order/ground.mli b/contrib/first-order/ground.mli
index cfc17e77..621f99db 100644
--- a/contrib/first-order/ground.mli
+++ b/contrib/first-order/ground.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ground.mli,v 1.1.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: ground.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 val ground_tac:     Tacmach.tactic ->
   (Proof_type.goal Tacmach.sigma -> Sequent.t) -> Tacmach.tactic
diff --git a/contrib/first-order/instances.ml b/contrib/first-order/instances.ml
index e2e9e2ef..254d7b84 100644
--- a/contrib/first-order/instances.ml
+++ b/contrib/first-order/instances.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: instances.ml,v 1.9.2.1 2004/07/16 19:30:10 herbelin Exp $ i*)
+(*i $Id: instances.ml 8654 2006-03-22 15:36:58Z msozeau $ i*)
 
 open Formula
 open Sequent
@@ -105,10 +105,10 @@ let dummy_bvid=id_of_string "x"
 
 let mk_open_instance id gl m t=
   let env=pf_env gl in
-  let evmap=Refiner.sig_sig gl in
+  let evmap=Refiner.project gl in
   let var_id=
     if id==dummy_id then dummy_bvid else
-      let typ=pf_type_of gl (constr_of_reference id) in
+      let typ=pf_type_of gl (constr_of_global id) in
 	(* since we know we will get a product, 
 	   reduction is not too expensive *)
       let (nam,_,_)=destProd (whd_betadeltaiota env evmap typ) in
@@ -121,15 +121,18 @@ let mk_open_instance id gl m t=
       let nid=(fresh_id avoid var_id gl) in
 	(Name nid,None,dummy_constr)::(aux (n-1) (nid::avoid)) in
   let nt=it_mkLambda_or_LetIn revt (aux m []) in
-  let rawt=Detyping.detype (false,env) [] [] nt in
+  let rawt=Detyping.detype false [] [] nt in
   let rec raux n t=
     if n=0 then t else 
       match t with
 	  RLambda(loc,name,_,t0)->
 	    let t1=raux (n-1) t0 in
-	      RLambda(loc,name,RHole (dummy_loc,BinderType name),t1)
+	      RLambda(loc,name,RHole (dummy_loc,Evd.BinderType name),t1)
 	| _-> anomaly "can't happen" in
-  let ntt=Pretyping.understand evmap env (raux m rawt) in
+  let ntt=try 
+    Pretyping.Default.understand evmap env (raux m rawt)
+  with _ -> 
+    error "Untypable instance, maybe higher-order non-prenex quantification" in
     Sign.decompose_lam_n_assum m ntt
 
 (* tactics   *)
@@ -138,13 +141,13 @@ let left_instance_tac (inst,id) continue seq=
   match inst with
       Phantom dom->
 	if lookup (id,None) seq then 
-	  tclFAIL 0 "already done"
+	  tclFAIL 0 (Pp.str "already done")
 	else
 	  tclTHENS (cut dom) 
 	    [tclTHENLIST
 	       [introf;
 		(fun gls->generalize 
-		   [mkApp(constr_of_reference id,
+		   [mkApp(constr_of_global id,
 			  [|mkVar (Tacmach.pf_nth_hyp_id gls 1)|])] gls);
 		introf;
 		tclSOLVE [wrap 1 false continue 
@@ -152,7 +155,7 @@ let left_instance_tac (inst,id) continue seq=
 	    tclTRY assumption]
     | Real((m,t) as c,_)->
 	if lookup (id,Some c) seq then 
-	  tclFAIL 0 "already done" 
+	  tclFAIL 0 (Pp.str "already done")
 	else 
 	  let special_generalize=
 	    if m>0 then 
@@ -160,10 +163,10 @@ let left_instance_tac (inst,id) continue seq=
 		let (rc,ot)= mk_open_instance id gl m t in
 		let gt= 
 		  it_mkLambda_or_LetIn 
-		    (mkApp(constr_of_reference id,[|ot|])) rc in
+		    (mkApp(constr_of_global id,[|ot|])) rc in
 		  generalize [gt] gl
 	    else
-	      generalize [mkApp(constr_of_reference id,[|t|])]
+	      generalize [mkApp(constr_of_global id,[|t|])]
 	  in
 	    tclTHENLIST 
 	      [special_generalize;
@@ -186,7 +189,7 @@ let right_instance_tac inst continue seq=
 	(tclTHEN (split (Rawterm.ImplicitBindings [t]))
 	   (tclSOLVE [wrap 0 true continue (deepen seq)]))
     | Real ((m,t),_) ->
-	tclFAIL 0 "not implemented ... yet"
+	tclFAIL 0 (Pp.str "not implemented ... yet")
 
 let instance_tac inst=
   if (snd inst)==dummy_id then 
diff --git a/contrib/first-order/instances.mli b/contrib/first-order/instances.mli
index 509bfc70..7667c89f 100644
--- a/contrib/first-order/instances.mli
+++ b/contrib/first-order/instances.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: instances.mli,v 1.3.2.1 2004/07/16 19:30:10 herbelin Exp $ i*)
+(*i $Id: instances.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 open Term
 open Tacmach
diff --git a/contrib/first-order/rules.ml b/contrib/first-order/rules.ml
index 7fbefa37..f6653b82 100644
--- a/contrib/first-order/rules.ml
+++ b/contrib/first-order/rules.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: rules.ml,v 1.24.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: rules.ml 7909 2006-01-21 11:09:18Z herbelin $ *)
 
 open Util
 open Names
@@ -57,18 +57,18 @@ let clear_global=function
 (* connection rules *)
 
 let axiom_tac t seq=
-  try exact_no_check (constr_of_reference (find_left t seq)) 
-  with Not_found->tclFAIL 0 "No axiom link" 
+  try exact_no_check (constr_of_global (find_left t seq)) 
+  with Not_found->tclFAIL 0 (Pp.str "No axiom link")
 
 let ll_atom_tac a backtrack id continue seq= 
   tclIFTHENELSE
     (try 
       tclTHENLIST
-	[generalize [mkApp(constr_of_reference id,
-			   [|constr_of_reference (find_left a seq)|])];
+	[generalize [mkApp(constr_of_global id,
+			   [|constr_of_global (find_left a seq)|])];
 	 clear_global id;
 	 intro]
-    with Not_found->tclFAIL 0 "No link") 
+    with Not_found->tclFAIL 0 (Pp.str "No link"))
     (wrap 1 false continue seq) backtrack 
 
 (* right connectives rules *)
@@ -92,7 +92,7 @@ let left_and_tac ind backtrack id continue seq gls=
  let n=(construct_nhyps ind gls).(0) in  
    tclIFTHENELSE
      (tclTHENLIST 
-      [simplest_elim (constr_of_reference id);
+      [simplest_elim (constr_of_global id);
        clear_global id; 
        tclDO n intro])
      (wrap n false continue seq)
@@ -106,12 +106,12 @@ let left_or_tac ind backtrack id continue seq gls=
        tclDO n intro;
        wrap n false continue seq] in
     tclIFTHENSVELSE
-      (simplest_elim (constr_of_reference id))
+      (simplest_elim (constr_of_global id))
       (Array.map f v)
       backtrack gls
 
 let left_false_tac id=
-  simplest_elim (constr_of_reference id)
+  simplest_elim (constr_of_global id)
 
 (* left arrow connective rules *)
 
@@ -127,7 +127,7 @@ let ll_ind_tac ind largs backtrack id continue seq gl=
        let cstr=mkApp ((mkConstruct (ind,(i+1))),vargs) in
        let vars=Array.init p (fun j->mkRel (p-j)) in
        let capply=mkApp ((lift p cstr),vars) in
-       let head=mkApp ((lift p (constr_of_reference id)),[|capply|]) in
+       let head=mkApp ((lift p (constr_of_global id)),[|capply|]) in
 	 Sign.it_mkLambda_or_LetIn head rc in
        let lp=Array.length rcs in
        let newhyps=list_tabulate myterm lp in
@@ -141,7 +141,7 @@ let ll_ind_tac ind largs backtrack id continue seq gl=
 let ll_arrow_tac a b c backtrack id continue seq=
   let cc=mkProd(Anonymous,a,(lift 1 b)) in
   let d=mkLambda (Anonymous,b,
-		  mkApp ((constr_of_reference id),
+		  mkApp ((constr_of_global id),
 			 [|mkLambda (Anonymous,(lift 1 a),(mkRel 2))|])) in
     tclORELSE
       (tclTHENS (cut c)
@@ -150,7 +150,7 @@ let ll_arrow_tac a b c backtrack id continue seq=
 	     clear_global id;
 	     wrap 1 false continue seq];
 	  tclTHENS (cut cc) 
-            [exact_no_check (constr_of_reference id); 
+            [exact_no_check (constr_of_global id); 
 	     tclTHENLIST 
 	       [generalize [d];
 		clear_global id;
@@ -168,17 +168,19 @@ let forall_tac backtrack continue seq=
 	  (tclTHEN introf (tclCOMPLETE (wrap 0 true continue seq)))
 	  backtrack))
     (if !qflag then 
-       tclFAIL 0 "reversible in 1st order mode"
+       tclFAIL 0 (Pp.str "reversible in 1st order mode")
      else
        backtrack)
 
-let left_exists_tac ind id continue seq gls=
+let left_exists_tac ind backtrack id continue seq gls=
   let n=(construct_nhyps ind gls).(0) in  
-    tclTHENLIST
-      [simplest_elim (constr_of_reference id);
-       clear_global id;
-       tclDO n intro;
-       (wrap (n-1) false continue seq)] gls
+    tclIFTHENELSE
+      (simplest_elim (constr_of_global id))
+      (tclTHENLIST [clear_global id;
+                    tclDO n intro;
+                    (wrap (n-1) false continue seq)]) 
+      backtrack 
+      gls
 	
 let ll_forall_tac prod backtrack id continue seq=
   tclORELSE
@@ -187,7 +189,7 @@ let ll_forall_tac prod backtrack id continue seq=
 	  [intro;
 	   (fun gls->
 	      let id0=pf_nth_hyp_id gls 1 in
-	      let term=mkApp((constr_of_reference id),[|mkVar(id0)|]) in
+	      let term=mkApp((constr_of_global id),[|mkVar(id0)|]) in
 		tclTHEN (generalize [term]) (clear [id0]) gls);  
 	   clear_global id;
 	   intro;
@@ -211,4 +213,4 @@ let normalize_evaluables=
 	 None->unfold_in_concl (Lazy.force defined_connectives)
        | Some (id,_,_)-> 
 	   unfold_in_hyp (Lazy.force defined_connectives) 
-	   (id,[],(Tacexpr.InHypTypeOnly,ref None)))
+	   (id,[],Tacexpr.InHypTypeOnly))
diff --git a/contrib/first-order/rules.mli b/contrib/first-order/rules.mli
index eb4d81bd..3798d8d4 100644
--- a/contrib/first-order/rules.mli
+++ b/contrib/first-order/rules.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: rules.mli,v 1.11.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: rules.mli 6141 2004-09-27 14:55:34Z corbinea $ *)
 
 open Term
 open Tacmach
@@ -47,7 +47,7 @@ val ll_arrow_tac : constr -> constr -> constr -> lseqtac with_backtracking
 
 val forall_tac : seqtac with_backtracking
 
-val left_exists_tac : inductive -> lseqtac
+val left_exists_tac : inductive -> lseqtac with_backtracking
 
 val ll_forall_tac : types -> lseqtac with_backtracking 
 
diff --git a/contrib/first-order/sequent.ml b/contrib/first-order/sequent.ml
index 13215348..805700b0 100644
--- a/contrib/first-order/sequent.ml
+++ b/contrib/first-order/sequent.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: sequent.ml,v 1.17.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: sequent.ml 7925 2006-01-24 23:20:39Z herbelin $ *)
 
 open Term
 open Util
@@ -91,8 +91,8 @@ let compare_constr_int f t1 t2 =
     | Meta m1, Meta m2 -> m1 - m2
     | Var id1, Var id2 -> Pervasives.compare id1 id2
     | Sort s1, Sort s2 -> Pervasives.compare s1 s2
-    | Cast (c1,_), _ -> f c1 t2
-    | _, Cast (c2,_) -> f t1 c2
+    | Cast (c1,_,_), _ -> f c1 t2
+    | _, Cast (c2,_,_) -> f t1 c2
     | Prod (_,t1,c1), Prod (_,t2,c2) 
     | Lambda (_,t1,c1), Lambda (_,t2,c2) ->
 	(f =? f) t1 t2 c1 c2 
@@ -255,7 +255,7 @@ let empty_seq depth=
 
 let create_with_ref_list l depth gl=
   let f gr seq=
-    let c=constr_of_reference gr in    
+    let c=constr_of_global gr in    
     let typ=(pf_type_of gl c) in
       add_formula Hyp gr typ seq gl in
     List.fold_right f l (empty_seq depth)
@@ -269,7 +269,7 @@ let create_with_auto_hints l depth gl=
 	Res_pf (c,_) | Give_exact c
       | Res_pf_THEN_trivial_fail (c,_) ->
 	  (try 
-	     let gr=reference_of_constr c in 
+	     let gr=global_of_constr c in 
 	     let typ=(pf_type_of gl c) in
 	       seqref:=add_formula Hint gr typ !seqref gl
 	   with Not_found->())
@@ -278,7 +278,7 @@ let create_with_auto_hints l depth gl=
   let h dbname=
     let hdb=
       try
-	Util.Stringmap.find dbname !searchtable 
+	searchtable_map dbname
       with Not_found-> 
 	error ("Firstorder: "^dbname^" : No such Hint database") in
       Hint_db.iter g hdb in
@@ -289,9 +289,9 @@ let print_cmap map=
   let print_entry c l s=
     let xc=Constrextern.extern_constr false (Global.env ()) c in
       str "| " ++ 
-      Util.prlist (Ppconstr.pr_global Idset.empty) l ++ 
+      Util.prlist Printer.pr_global l ++ 
       str " : " ++
-      Ppconstr.pr_constr xc ++ 
+      Ppconstr.pr_constr_expr xc ++ 
       cut () ++ 
       s in
     msgnl (v 0 
diff --git a/contrib/first-order/sequent.mli b/contrib/first-order/sequent.mli
index df27d2ff..47fb74c7 100644
--- a/contrib/first-order/sequent.mli
+++ b/contrib/first-order/sequent.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: sequent.mli,v 1.8.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: sequent.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Term
 open Util
diff --git a/contrib/first-order/unify.ml b/contrib/first-order/unify.ml
index 1186fb90..1dd13cbe 100644
--- a/contrib/first-order/unify.ml
+++ b/contrib/first-order/unify.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: unify.ml,v 1.10.2.1 2004/07/16 19:30:10 herbelin Exp $ i*)
+(*i $Id: unify.ml 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 open Util
 open Formula 
@@ -59,8 +59,8 @@ let unif t1 t2=
 		if Intset.is_empty (free_rels t) && 
 		  not (occur_term (mkMeta i) t) then
 		    bind i t else raise (UFAIL(nt1,nt2))
-	  | Cast(_,_),_->Queue.add (strip_outer_cast nt1,nt2) bige
- 	  | _,Cast(_,_)->Queue.add (nt1,strip_outer_cast nt2) bige 
+	  | Cast(_,_,_),_->Queue.add (strip_outer_cast nt1,nt2) bige
+ 	  | _,Cast(_,_,_)->Queue.add (nt1,strip_outer_cast nt2) bige 
 	  | (Prod(_,a,b),Prod(_,c,d))|(Lambda(_,a,b),Lambda(_,c,d))->
 	      Queue.add (a,c) bige;Queue.add (pop b,pop d) bige
 	  | Case (_,pa,ca,va),Case (_,pb,cb,vb)->
diff --git a/contrib/first-order/unify.mli b/contrib/first-order/unify.mli
index dd9dbdec..9fbe3dda 100644
--- a/contrib/first-order/unify.mli
+++ b/contrib/first-order/unify.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: unify.mli,v 1.7.2.1 2004/07/16 19:30:10 herbelin Exp $ *)
+(* $Id: unify.mli 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Term
 
diff --git a/contrib/fourier/Fourier.v b/contrib/fourier/Fourier.v
index f6faf94c..8836b76e 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,v 1.4.2.1 2004/07/16 19:30:11 herbelin Exp $ *)
+(* $Id: Fourier.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* "Fourier's method to solve linear inequations/equations systems.".*)
 
diff --git a/contrib/fourier/Fourier_util.v b/contrib/fourier/Fourier_util.v
index abcd4449..c3257b7d 100644
--- a/contrib/fourier/Fourier_util.v
+++ b/contrib/fourier/Fourier_util.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Fourier_util.v,v 1.4.2.1 2004/07/16 19:30:11 herbelin Exp $ *)
+(* $Id: Fourier_util.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Rbase.
 Comments "Lemmas used by the tactic Fourier".
diff --git a/contrib/fourier/fourier.ml b/contrib/fourier/fourier.ml
index f5763c34..ed804e94 100644
--- a/contrib/fourier/fourier.ml
+++ b/contrib/fourier/fourier.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: fourier.ml,v 1.2.16.1 2004/07/16 19:30:11 herbelin Exp $ *)
+(* $Id: fourier.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* Méthode d'élimination de Fourier *)
 (* Référence:
diff --git a/contrib/fourier/fourierR.ml b/contrib/fourier/fourierR.ml
index 49fa35da..f9518bcb 100644
--- a/contrib/fourier/fourierR.ml
+++ b/contrib/fourier/fourierR.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: fourierR.ml,v 1.14.2.2 2004/07/19 13:28:28 herbelin Exp $ *)
+(* $Id: fourierR.ml 7760 2005-12-30 10:49:13Z herbelin $ *)
 
 
 
@@ -76,7 +76,7 @@ open Vernacexpr
 type ineq = Rlt | Rle | Rgt | Rge
 
 let string_of_R_constant kn = 
-  match Names.repr_kn kn with
+  match Names.repr_con kn with
     | MPfile dir, sec_dir, id when 
 	sec_dir = empty_dirpath && 
 	string_of_dirpath dir = "Coq.Reals.Rdefinitions" 
@@ -85,13 +85,13 @@ let string_of_R_constant kn =
 
 let rec string_of_R_constr c =
  match kind_of_term c with
-   Cast (c,t) -> string_of_R_constr c
+   Cast (c,_,_) -> string_of_R_constr c
   |Const c -> string_of_R_constant c
   | _ -> "not_of_constant"
 
 let rec rational_of_constr c =
   match kind_of_term c with
-  | Cast (c,t) -> (rational_of_constr c)
+  | Cast (c,_,_) -> (rational_of_constr c)
   | App (c,args) ->
       (match (string_of_R_constr c) with
 	 | "Ropp" -> 
@@ -122,7 +122,7 @@ let rec rational_of_constr c =
 let rec flin_of_constr c =
   try(
     match kind_of_term c with
-  | Cast (c,t) -> (flin_of_constr c)
+  | Cast (c,_,_) -> (flin_of_constr c)
   | App (c,args) ->
       (match (string_of_R_constr c) with
 	   "Ropp" -> 
@@ -221,7 +221,7 @@ let ineq1_of_constr (h,t) =
 			   hstrict=false}]
                 |_->assert false)
           | Ind (kn,i) ->
-	      if IndRef(kn,i) = Coqlib.glob_eqT then
+	      if IndRef(kn,i) = Coqlib.glob_eq then
 		           let t0= args.(0) in
                            let t1= args.(1) in
                            let t2= args.(2) in
@@ -281,7 +281,7 @@ let constant = Coqlib.gen_constant "Fourier"
 
 (* Standard library *)
 open Coqlib
-let coq_sym_eqT = lazy (build_coq_sym_eqT ())
+let coq_sym_eqT = lazy (build_coq_sym_eq ())
 let coq_False = lazy (build_coq_False ())
 let coq_not = lazy (build_coq_not ())
 let coq_eq = lazy (build_coq_eq ())
@@ -303,7 +303,7 @@ let coq_R0 = lazy (constant_real "R0")
 let coq_R1 = lazy (constant_real "R1")
 
 (* RIneq *)
-let coq_Rinv_R1 = lazy (constant ["Reals";"RIneq"] "Rinv_R1")
+let coq_Rinv_1 = lazy (constant ["Reals";"RIneq"] "Rinv_1")
 
 (* Fourier_util *)
 let constant_fourier = constant ["fourier";"Fourier_util"]
@@ -408,7 +408,7 @@ let tac_zero_infeq_false gl (n,d) =
 	      (tac_zero_inf_pos gl (-n,d)))
 ;;
 
-let create_meta () = mkMeta(new_meta());;
+let create_meta () = mkMeta(Evarutil.new_meta());;
    
 let my_cut c gl=
      let concl = pf_concl gl in
@@ -458,7 +458,7 @@ let mkAppL a =
 
 (* Résolution d'inéquations linéaires dans R *)
 let rec fourier gl=
-    Library.check_required_library ["Coq";"fourier";"Fourier"];
+    Coqlib.check_required_library ["Coq";"fourier";"Fourier"];
     let goal = strip_outer_cast (pf_concl gl) in
     let fhyp=id_of_string "new_hyp_for_fourier" in
     (* si le but est une inéquation, on introduit son contraire,
@@ -604,7 +604,7 @@ let rec fourier gl=
                                    (Ring.polynom [])
                                    tclIDTAC;
 					  (tclTHEN (apply (get coq_sym_eqT))
-						(apply (get coq_Rinv_R1)))]
+						(apply (get coq_Rinv_1)))]
                                
 					 )
 				]));
diff --git a/contrib/fourier/g_fourier.ml4 b/contrib/fourier/g_fourier.ml4
index 05c3adbd..3a6be850 100644
--- a/contrib/fourier/g_fourier.ml4
+++ b/contrib/fourier/g_fourier.ml4
@@ -8,10 +8,10 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: g_fourier.ml4,v 1.1.12.1 2004/07/16 19:30:11 herbelin Exp $ *)
+(* $Id: g_fourier.ml4 7734 2005-12-26 14:06:51Z herbelin $ *)
 
 open FourierR
 
-TACTIC EXTEND Fourier
-  [ "FourierZ" (* constr_list(l) *) ] -> [ fourier (* l *) ]
+TACTIC EXTEND fourier
+  [ "fourierz" ] -> [ fourier ]
 END
diff --git a/contrib/funind/indfun.ml b/contrib/funind/indfun.ml
new file mode 100644
index 00000000..2fcdd3a7
--- /dev/null
+++ b/contrib/funind/indfun.ml
@@ -0,0 +1,468 @@
+open Util
+open Names
+open Term
+
+open Pp
+open Indfun_common
+open Libnames
+open Rawterm
+open Declarations
+
+type annot = 
+    Struct of identifier 
+  | Wf of Topconstr.constr_expr * identifier option
+  | Mes of Topconstr.constr_expr * identifier option
+
+
+type newfixpoint_expr =
+    identifier * annot * Topconstr.local_binder list * Topconstr.constr_expr * Topconstr.constr_expr
+
+let rec abstract_rawconstr c = function
+  | [] -> c
+  | Topconstr.LocalRawDef (x,b)::bl -> Topconstr.mkLetInC(x,b,abstract_rawconstr c bl)
+  | Topconstr.LocalRawAssum (idl,t)::bl ->
+      List.fold_right (fun x b -> Topconstr.mkLambdaC([x],t,b)) idl
+        (abstract_rawconstr c bl)
+
+let interp_casted_constr_with_implicits sigma env impls c  =
+(*   Constrintern.interp_rawconstr_with_implicits sigma env [] impls c *)
+  Constrintern.intern_gen false sigma env ~impls:([],impls) 
+    ~allow_soapp:false  ~ltacvars:([],[]) c
+
+let build_newrecursive
+(lnameargsardef)  =
+  let env0 = Global.env()
+  and sigma = Evd.empty
+  in
+  let (rec_sign,rec_impls) =
+    List.fold_left
+      (fun (env,impls) (recname,_,bl,arityc,_) ->
+        let arityc = Command.generalize_constr_expr arityc bl in
+        let arity = Constrintern.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,Notation.compute_arguments_scope arity))::impls in
+        (Environ.push_named (recname,None,arity) env, impls'))
+      (env0,[]) lnameargsardef in
+  let recdef =
+    (* Declare local notations *)
+    let fs = States.freeze() in
+    let def =
+      try
+	List.map
+	  (fun (_,_,bl,_,def)  ->
+             let def = abstract_rawconstr def bl in
+             interp_casted_constr_with_implicits
+	       sigma rec_sign rec_impls def
+	  )
+          lnameargsardef
+	with e ->
+	States.unfreeze fs; raise e in
+    States.unfreeze fs; def
+  in
+  recdef
+	
+
+let compute_annot (name,annot,args,types,body) =
+  let names = List.map snd (Topconstr.names_of_local_assums args) in
+  match annot with
+    | None ->
+        if List.length names > 1 then
+          user_err_loc
+            (dummy_loc,"GenFixpoint",
+             Pp.str "the recursive argument needs to be specified");
+        let new_annot = (id_of_name (List.hd names)) in
+	(name,Struct new_annot,args,types,body)
+    | Some r -> (name,r,args,types,body)
+
+
+
+let rec is_rec names = 
+  let names = List.fold_right Idset.add names Idset.empty in 
+  let check_id id =  Idset.mem id names in 
+  let rec lookup = function 
+    | RVar(_,id) -> check_id id
+    | RRef _ | REvar _ | RPatVar _ | RSort _ |  RHole _ | RDynamic _ -> false
+    | RCast(_,b,_,_) -> lookup b
+    | RRec _ -> assert false 
+    | RIf _ -> failwith "Rif not implemented"
+    | RLetIn(_,_,t,b) | RLambda(_,_,t,b) | RProd(_,_,t,b) | RLetTuple(_,_,_,t,b) -> 
+	lookup t || lookup b
+    | RApp(_,f,args) -> List.exists lookup (f::args)
+    | RCases(_,_,el,brl) -> 
+	List.exists (fun (e,_) -> lookup e) el ||
+	  List.exists (fun (_,_,_,ret)-> lookup ret) brl
+  in
+  lookup 
+
+let prepare_body (name,annot,args,types,body) rt = 
+  let n = (Topconstr.local_binders_length args) in 
+(*   Pp.msgnl (str "nb lambda to chop : " ++ str (string_of_int n) ++ fnl () ++Printer.pr_rawconstr rt); *)
+  let fun_args,rt' = chop_rlambda_n n rt in
+  (fun_args,rt')
+
+
+let generate_principle 
+    do_built fix_rec_l recdefs  interactive_proof parametrize 
+    (continue_proof : int -> Names.constant array -> Term.constr array -> int -> Tacmach.tactic)  =
+  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;
+    if do_built 
+    then
+      begin
+	let f_R_mut = Ident (dummy_loc,mk_rel_id (List.nth names 0)) in
+	let ind_kn =
+	  fst (locate_with_msg
+		 (pr_reference f_R_mut++str ": Not an inductive type!")
+		 locate_ind
+		 f_R_mut)
+	in
+	let fname_kn (fname,_,_,_,_) =
+	  let f_ref = Ident (dummy_loc,fname) in
+	  locate_with_msg
+	    (pr_reference f_ref++str ": Not an inductive type!")
+	    locate_constant
+	    f_ref
+	in
+	let funs_kn = Array.of_list (List.map fname_kn fix_rec_l) in 
+	let _ = 
+	  Util.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
+	       in
+	       New_arg_principle.generate_functional_principle
+		 interactive_proof 
+		 princ_type
+		 None
+		 None 
+		 funs_kn
+		 i
+		 (continue_proof  0 [|funs_kn.(i)|]) 
+	    )
+	    0
+	    fix_rec_l
+	in 
+	()
+      end
+  with e -> 
+    Pp.msg_warning (Cerrors.explain_exn e) 
+
+
+let register_struct is_rec fixpoint_exprl = 
+  match fixpoint_exprl with 
+    | [(fname,_,bl,ret_type,body),_] when not is_rec -> 
+	Command.declare_definition
+	  fname
+	  (Decl_kinds.Global,Options.boxed_definitions (),Decl_kinds.Definition)
+	  bl
+	  None
+  	  body
+	  (Some ret_type)
+	  (fun _ _ -> ())
+    | _ -> 
+	Command.build_recursive fixpoint_exprl (Options.boxed_definitions())
+
+
+let generate_correction_proof_wf tcc_lemma_ref   
+    is_mes f_ref eq_ref rec_arg_num rec_arg_type nb_args relation
+    (_: int) (_:Names.constant array) (_:Term.constr array) (_:int) : Tacmach.tactic = 
+  Recdef.prove_principle  tcc_lemma_ref
+    is_mes f_ref eq_ref rec_arg_num rec_arg_type nb_args relation
+
+
+let register_wf ?(is_mes=false) fname wf_rel_expr wf_arg args ret_type body
+    pre_hook 
+    =  
+  let type_of_f = Command.generalize_constr_expr ret_type args in 
+  let rec_arg_num = 
+    let names = 
+      List.map
+	snd
+	(Topconstr.names_of_local_assums args) 
+    in 
+    match wf_arg with 
+      | None -> 
+	  if List.length names = 1 then 1
+	  else error "Recursive argument must be specified"
+      | Some wf_arg -> 
+	  Util.list_index (Name wf_arg) names 
+  in
+  let unbounded_eq = 
+    let f_app_args = 
+      Topconstr.CApp 
+	(dummy_loc, 
+	 (None,Topconstr.mkIdentC fname) ,
+	 (List.map 
+	    (function
+	       | _,Anonymous -> assert false 
+	       | _,Name e -> (Topconstr.mkIdentC e,None)
+	    ) 
+	    (Topconstr.names_of_local_assums args)
+	 )
+	) 
+    in
+    Topconstr.CApp (dummy_loc,(None,Topconstr.mkIdentC (id_of_string "eq")),
+		    [(f_app_args,None);(body,None)])
+  in
+  let eq = Command.generalize_constr_expr unbounded_eq args in 
+  let hook tcc_lemma_ref f_ref eq_ref rec_arg_num rec_arg_type nb_args relation =
+    try 
+      pre_hook 
+	(generate_correction_proof_wf tcc_lemma_ref is_mes
+	   f_ref eq_ref rec_arg_num rec_arg_type nb_args relation
+	);
+      Command.save_named true
+    with e -> 
+      (* No proof done *) 
+      ()
+  in 
+  Recdef.recursive_definition 
+    is_mes fname 
+    type_of_f
+    wf_rel_expr
+    rec_arg_num
+    eq
+    hook
+
+    
+let register_mes fname wf_mes_expr wf_arg args ret_type body = 
+  let wf_arg_type,wf_arg = 
+    match wf_arg with 
+      | None -> 
+	  begin
+	    match args with 
+	      | [Topconstr.LocalRawAssum ([(_,Name x)],t)] -> t,x 
+	      | _ -> error "Recursive argument must be specified" 
+	  end
+      | Some wf_args -> 
+	  try 
+	    match 
+	      List.find 
+		(function 
+		   | Topconstr.LocalRawAssum(l,t) -> 
+		       List.exists 
+			 (function (_,Name id) -> id =  wf_args | _ -> false) 
+			 l 
+		   | _ -> false
+		)
+		args 
+	    with 
+	      | Topconstr.LocalRawAssum(_,t)  ->	    t,wf_args
+	      | _ -> assert false 
+	  with Not_found -> assert false 
+  in
+  let ltof = 
+    let make_dir l = make_dirpath (List.map id_of_string (List.rev l)) in 
+    Libnames.Qualid (dummy_loc,Libnames.qualid_of_sp 
+      (Libnames.make_path (make_dir ["Arith";"Wf_nat"]) (id_of_string "ltof")))
+  in
+  let fun_from_mes = 
+    let applied_mes = 
+      Topconstr.mkAppC(wf_mes_expr,[Topconstr.mkIdentC wf_arg])    in
+    Topconstr.mkLambdaC ([(dummy_loc,Name wf_arg)],wf_arg_type,applied_mes) 
+  in
+  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
+	  
+
+let do_generate_principle register_built interactive_proof fixpoint_exprl  = 
+  let recdefs = build_newrecursive fixpoint_exprl in 
+  let _is_struct = 
+    match fixpoint_exprl with 
+      | [((name,Some (Wf (wf_rel,wf_x)),args,types,body))] -> 
+	  let pre_hook = 
+	    generate_principle 
+	      register_built
+	      fixpoint_exprl 
+	      recdefs
+	      true
+	      false
+	  in 
+	  if register_built then register_wf name wf_rel wf_x args types body pre_hook;
+	  false
+      | [((name,Some (Mes (wf_mes,wf_x)),args,types,body))] -> 
+	  let pre_hook = 
+	    generate_principle 
+	      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
+      | _ -> 
+	  let fix_names = 
+	    List.map (function (name,_,_,_,_) -> name) fixpoint_exprl 
+	  in
+	  let is_one_rec = is_rec fix_names  in
+	  let old_fixpoint_exprl =  
+	    List.map
+	      (function
+		 | (name,Some (Struct id),args,types,body),_ -> 
+		     let names = 
+		       List.map
+			 snd
+			 (Topconstr.names_of_local_assums args) 
+		     in 
+		     let annot = 
+		       try Util.list_index (Name id) names - 1, Topconstr.CStructRec 
+		       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 -> 
+		     let names =  (Topconstr.names_of_local_assums args) in
+		     if  is_one_rec recdef  && List.length names > 1 then
+		       Util.user_err_loc
+			 (Util.dummy_loc,"GenFixpoint",
+			  Pp.str "the recursive argument needs to be specified")
+		     else 
+		       (name,(0, Topconstr.CStructRec),args,types,body),(None:Vernacexpr.decl_notation)
+		 | (_,Some (Wf _),_,_,_),_ | (_,Some (Mes _),_,_,_),_-> 
+		     error 
+		       ("Cannot use mutual definition with well-founded recursion")
+	      ) 
+	      (List.combine fixpoint_exprl recdefs)
+	  in
+	  (* ok all the expressions are structural *) 
+	  let fix_names = 
+	    List.map (function (name,_,_,_,_) -> name) fixpoint_exprl 
+	  in
+	  let is_rec = List.exists (is_rec fix_names) recdefs in
+	  if register_built then register_struct is_rec old_fixpoint_exprl;
+	  generate_principle
+	    register_built
+	    fixpoint_exprl
+	    recdefs 
+	    interactive_proof
+	    true
+	    (New_arg_principle.prove_princ_for_struct interactive_proof);
+	  true
+						 
+  in
+  ()
+
+let make_graph (id:identifier) =
+ let c_body = 
+    try
+      let c = const_of_id id  in
+      Global.lookup_constant c 
+    with Not_found -> 
+      raise (UserError ("",str "Cannot find " ++ Ppconstr.pr_id id) )
+  in
+
+  match c_body.const_body with
+    | None -> error "Cannot build a graph over an axiom !"
+    | Some b ->
+	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 expr_list = 
+	  match extern_body with 
+	    | Topconstr.CFix(loc,l_id,fixexprl) -> 
+	      let l = 
+		List.map
+		  (fun (id,(n,recexp),bl,t,b) -> 
+		     let nal =  
+		       List.flatten 
+			 (List.map 
+			    (function 
+			       | Topconstr.LocalRawDef (na,_)-> []
+			       | Topconstr.LocalRawAssum (nal,_) -> nal
+			    )
+			    bl
+			 )
+		     in 
+		     let rec_id = 
+		       match List.nth nal n  with |(_,Name id) -> id | _ -> anomaly ""
+		     in
+		     (id, Some (Struct rec_id),bl,t,b)
+		  )
+		  fixexprl
+	      in
+	      l
+	    | _ ->  
+		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
+		in
+		let nal_tas,b,t = get_args extern_body extern_type in
+		[(id,None,nal_tas,t,b)]
+		  
+	in
+	do_generate_principle false false expr_list
+(* let make_graph _ = assert false	 *)
+	  
+let do_generate_principle = do_generate_principle true 
diff --git a/contrib/funind/indfun_common.ml b/contrib/funind/indfun_common.ml
new file mode 100644
index 00000000..b32dfacb
--- /dev/null
+++ b/contrib/funind/indfun_common.ml
@@ -0,0 +1,319 @@
+open Names
+open Pp
+
+open Libnames
+
+let mk_prefix pre id = id_of_string (pre^(string_of_id id))
+let mk_rel_id = mk_prefix "R_"
+
+let msgnl m =
+  ()
+
+let invalid_argument s = raise (Invalid_argument s)
+
+(* let idtbl = Hashtbl.create 29 *)
+(* let reset_name () = Hashtbl.clear idtbl *)
+
+(* let fresh_id s = *)
+(*   try *)
+(*     let id = Hashtbl.find idtbl s in *)
+(*     incr id; *)
+(*     id_of_string (s^(string_of_int !id)) *)
+(*   with Not_found -> *)
+(*     Hashtbl.add idtbl s (ref (-1)); *)
+(*     id_of_string s *)
+
+(* let fresh_name s = Name (fresh_id s) *)
+(* let get_name ?(default="H") = function *)
+(*   | Anonymous -> fresh_name default *)
+(*   | Name n -> Name n *)
+
+
+
+let fresh_id avoid s = Termops.next_global_ident_away true (id_of_string s) avoid
+
+let fresh_name avoid s = Name (fresh_id avoid s)
+
+let get_name avoid ?(default="H") = function
+  | Anonymous -> fresh_name avoid default
+  | Name n -> Name n
+
+let array_get_start a =
+  try 
+    Array.init
+      (Array.length a - 1)
+      (fun i -> a.(i))
+  with Invalid_argument "index out of bounds" -> 
+    invalid_argument "array_get_start"
+      
+let id_of_name = function
+    Name id -> id
+  | _ -> raise Not_found
+
+let locate  ref =
+    let (loc,qid) = qualid_of_reference ref in
+    Nametab.locate qid
+
+let locate_ind ref =
+  match locate ref with
+    | IndRef x -> x
+    | _ -> raise Not_found
+
+let locate_constant ref =
+  match locate ref with
+    | ConstRef x -> x
+    | _ -> raise Not_found
+
+
+let locate_with_msg msg f x =
+  try
+    f x
+  with
+    | Not_found -> raise (Util.UserError("", msg))
+    | e -> raise e
+
+
+let filter_map filter f =
+  let rec it = function
+    | [] -> []
+    | e::l ->
+	if filter e
+	then
+	  (f e) :: it l
+	else it l
+  in
+  it
+
+
+let chop_rlambda_n  =
+  let rec chop_lambda_n acc n rt =
+      if n == 0
+      then List.rev acc,rt
+      else
+	match rt with
+	  | Rawterm.RLambda(_,name,t,b) -> chop_lambda_n ((name,t,false)::acc) (n-1) b
+	  | Rawterm.RLetIn(_,name,v,b) -> chop_lambda_n ((name,v,true)::acc) (n-1) b
+	  | _ -> 
+	      raise (Util.UserError("chop_rlambda_n",
+				    str "chop_rlambda_n: Not enough Lambdas"))
+  in
+  chop_lambda_n []
+
+let chop_rprod_n  =
+  let rec chop_prod_n acc n rt =
+      if n == 0
+      then List.rev acc,rt
+      else
+	match rt with
+	  | Rawterm.RProd(_,name,t,b) -> chop_prod_n ((name,t)::acc) (n-1) b
+	  | _ -> raise (Util.UserError("chop_rprod_n",str "chop_rprod_n: Not enough products"))
+  in
+  chop_prod_n []
+
+
+
+let list_union_eq eq_fun l1 l2 =
+  let rec urec = function
+    | [] -> l2
+    | a::l -> if List.exists (eq_fun a) l2 then urec l else a::urec l
+  in
+  urec l1
+
+let list_add_set_eq eq_fun x l =
+  if List.exists (eq_fun x) l then l else x::l
+
+  
+
+
+let const_of_id id =
+  let _,princ_ref = 
+    qualid_of_reference (Libnames.Ident (Util.dummy_loc,id))
+  in
+  try Nametab.locate_constant princ_ref
+  with Not_found -> Util.error ("cannot find "^ string_of_id id)
+
+let def_of_const t =
+   match (Term.kind_of_term t) with
+    Term.Const sp -> 
+      (try (match (Global.lookup_constant sp) with
+             {Declarations.const_body=Some c} -> Declarations.force c
+	     |_ -> assert false)
+       with _ -> assert false)
+    |_ -> assert false
+
+let coq_constant s =
+  Coqlib.gen_constant_in_modules "RecursiveDefinition" 
+    (Coqlib.init_modules @ Coqlib.arith_modules) s;;
+
+let constant sl s =
+  constr_of_reference
+    (Nametab.locate (make_qualid(Names.make_dirpath 
+			   (List.map id_of_string (List.rev sl)))
+	       (id_of_string s)));;
+
+let find_reference sl s =
+    (Nametab.locate (make_qualid(Names.make_dirpath 
+			   (List.map id_of_string (List.rev sl)))
+	       (id_of_string s)));;
+
+let eq = lazy(coq_constant "eq")
+let refl_equal = lazy(coq_constant "refl_equal")
+
+
+(* (\************************************************\)  *)
+(* (\* Should be removed latter                     *\) *)
+(* (\* Comes from new induction  (cf Pierre)        *\) *)
+(* (\************************************************\)  *)
+
+(* open Sign *)
+(* open Term *)
+
+(* type elim_scheme =  *)
+
+(* (\* { (\\* lists are in reverse order! *\\) *\) *)
+(* (\*   params: rel_context;     (\\* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *\\) *\) *)
+(* (\*   predicates: rel_context; (\\* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *\\) *\) *)
+(* (\*   branches: rel_context;    (\\* branchr,...,branch1 *\\) *\) *)
+(* (\*   args: rel_context;       (\\* (xni, Ti_ni) ... (x1, Ti_1) *\\) *\) *)
+(* (\*   indarg: rel_declaration option; (\\* Some (H,I prm1..prmp x1...xni) if present, None otherwise *\\) *\) *)
+(* (\*   concl: types;            (\\* Qi x1...xni HI, some prmis may not be present *\\) *\) *)
+(* (\*   indarg_in_concl:bool;    (\\* true if HI appears at the end of conclusion (dependent scheme) *\\) *\) *)
+(* (\* } *\) *)
+
+
+
+(* let occur_rel n c =  *)
+(*   let res = not (noccurn n c) in *)
+(*   res *)
+
+(* let list_filter_firsts f l = *)
+(*   let rec list_filter_firsts_aux f acc l = *)
+(*     match l with *)
+(*       | e::l' when f e -> list_filter_firsts_aux f (acc@[e]) l' *)
+(*       | _ -> acc,l *)
+(*   in *)
+(*   list_filter_firsts_aux f [] l *)
+
+(* let count_rels_from n c = *)
+(*   let rels = Termops.free_rels c in *)
+(*   let cpt,rg = ref 0, ref n in *)
+(*   while Util.Intset.mem !rg rels do *)
+(*     cpt:= !cpt+1; rg:= !rg+1; *)
+(*   done; *)
+(*   !cpt *)
+
+(* let count_nonfree_rels_from n c = *)
+(*   let rels = Termops.free_rels c in *)
+(*   if Util.Intset.exists (fun x -> x >= n) rels then *)
+(*     let cpt,rg = ref 0, ref n in *)
+(*     while not (Util.Intset.mem !rg rels) do *)
+(*       cpt:= !cpt+1; rg:= !rg+1; *)
+(*     done; *)
+(*     !cpt *)
+(*   else raise Not_found *)
+
+(* (\* cuts a list in two parts, first of size n. Size must be greater than n *\) *)
+(* let cut_list n l = *)
+(*   let rec cut_list_aux acc n l = *)
+(*     if n<=0 then acc,l *)
+(*     else match l with *)
+(*       | [] -> assert false *)
+(*       | e::l' -> cut_list_aux (acc@[e]) (n-1) l' in *)
+(*   let res = cut_list_aux [] n l in *)
+(*   res *)
+
+(* let exchange_hd_prod subst_hd t = *)
+(*   let hd,args= decompose_app t in mkApp (subst_hd,Array.of_list args) *)
+
+(* let compute_elim_sig elimt  = *)
+(*   (\* conclusion is the final (Qi ...) *\) *)
+(*   let hyps,conclusion = decompose_prod_assum elimt in *)
+(*   (\* ccl is conclusion where Qi (that is rel <something>) is replaced *)
+(*      by a constant (Prop) to avoid it being counted as an arg or *)
+(* parameter in the following. *\) *)
+(*   let ccl = exchange_hd_prod mkProp conclusion in *)
+(*   (\* indarg is the inductive argument if it exists. If it exists it is *)
+(* the last hyp before the conclusion, so it is the first element of *)
+(*      hyps. To know the first elmt is an inductive arg, we check if the *)
+(*      it appears in the conclusion (as rel 1). If yes, then it is not *)
+(*      an inductive arg, otherwise it is. There is a pathological case *)
+(*      with False_inf where Qi is rel 1, so we first get rid of Qi in *)
+(*      ccl. *\) *)
+(*   (\* if last arg of ccl is an application then this a functional ind *)
+(* principle *\) let last_arg_ccl =  *)
+(*     try List.hd (List.rev (snd (decompose_app ccl)))  *)
+(*     with Failure "hd" -> mkProp in (\* dummy constr that is not an app *)
+(* *\) let hyps',indarg,dep =  *)
+(*     if isApp last_arg_ccl  *)
+(*     then  *)
+(*       hyps,None , false (\* no HI at all *\) *)
+(*     else  *)
+(*       try  *)
+(* 	if noccurn 1 ccl (\* rel 1 does not occur in ccl *\) *)
+(* 	then *)
+(* 	  List.tl hyps , Some (List.hd hyps), false (\* it does not *)
+(* occur in concl *\) else *)
+(* 	  List.tl hyps , Some (List.hd hyps) , true (\* it does occur in concl *\)  *)
+(*       with Failure s -> Util.error "cannot recognise an induction schema" *)
+(*   in *)
+
+(*   (\* Arguments [xni...x1] must appear in the conclusion, so we count *)
+(*      successive rels appearing in conclusion **Qi is not considered a *)
+(* rel** *\) let nargs = count_rels_from  *)
+(*     (match indarg with *)
+(*       | None -> 1 *)
+(*       | Some _ -> 2) ccl in *)
+(*   let args,hyps'' = cut_list nargs hyps' in *)
+(*   let rel_is_pred (_,_,c) = isSort (snd(decompose_prod_assum c)) in *)
+(*   let branches,hyps''' =  *)
+(*     list_filter_firsts (function x -> not (rel_is_pred x)) hyps'' *)
+(*   in *)
+(*   (\* Now we want to know which hyps remaining are predicates and which *)
+(*      are parameters *\) *)
+(*   (\* We rebuild  *)
+     
+(*      forall (x1:Ti_1) (xni:Ti_ni) (HI:I prm1..prmp x1...xni), DUMMY *)
+(* x1...xni HI ^^^^^^^^^^^^^^^^^^^^^^^^^                  ^^ *)
+(*                                           optional *)
+(* opt *)
+
+(*      Free rels appearing in this term are parameters. We catch all of *)
+(*      them if HI is present. In this case the number of parameters is *)
+(*      the number of free rels. Otherwise (principle generated by *)
+(*      functional induction or by hand) WE GUESS that all parameters *)
+(*      appear in Ti_js, IS THAT TRUE??. *)
+
+(*      TODO: if we want to generalize to the case where arges are merged *)
+(*      with branches (?) and/or where several predicates are cited in *)
+(*      the conclusion, we should do something more precise than just *)
+(*      counting free rels. *)
+(*  *\) *)
+(*   let concl_with_indarg =  *)
+(*     match indarg with *)
+(*     | None -> ccl *)
+(*     | Some c -> it_mkProd_or_LetIn ccl [c] in *)
+(*   let concl_with_args = it_mkProd_or_LetIn concl_with_indarg args in *)
+(* (\*   let nparams2 = Util.Intset.cardinal (Termops.free_rels concl_with_args) in *\) *)
+(*   let nparams =  *)
+(*     try List.length (hyps'''@branches) - count_nonfree_rels_from 1 *)
+(*       concl_with_args with Not_found -> 0 in *)
+(*   let preds,params = cut_list (List.length hyps''' - nparams) hyps''' in *)
+(*   let elimscheme = { *)
+(*     params = params; *)
+(*     predicates = preds; *)
+(*     branches = branches; *)
+(*     args = args; *)
+(*     indarg = indarg; *)
+(*     concl = conclusion; *)
+(*     indarg_in_concl = dep; *)
+(*   } *)
+(*   in *)
+(*   elimscheme *)
+
+(* let get_params elimt =  *)
+(*   (compute_elim_sig elimt).params *)
+(* (\************************************************\)  *)
+(* (\* end of Should be removed latter              *\) *)
+(* (\* Comes from new induction  (cf Pierre)        *\) *)
+(* (\************************************************\)  *)
+
diff --git a/contrib/funind/indfun_common.mli b/contrib/funind/indfun_common.mli
new file mode 100644
index 00000000..ab5195b0
--- /dev/null
+++ b/contrib/funind/indfun_common.mli
@@ -0,0 +1,41 @@
+open Names
+open Pp
+
+val mk_rel_id : identifier -> identifier
+
+val msgnl : std_ppcmds -> unit
+
+val invalid_argument : string -> 'a
+
+val fresh_id : identifier list -> string -> identifier
+val fresh_name : identifier list -> string -> name 
+val get_name : identifier list -> ?default:string -> name -> name 
+
+val array_get_start : 'a array -> 'a array
+
+val id_of_name : name -> identifier
+
+val locate_ind : Libnames.reference -> inductive
+val locate_constant : Libnames.reference -> constant
+val locate_with_msg :
+  Pp.std_ppcmds -> (Libnames.reference -> 'a) ->
+  Libnames.reference -> 'a
+
+val filter_map : ('a -> bool) -> ('a -> 'b) -> 'a list -> 'b list
+val list_union_eq :
+  ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list
+val list_add_set_eq :
+  ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
+
+val chop_rlambda_n : int -> Rawterm.rawconstr ->
+  (name*Rawterm.rawconstr*bool) list * Rawterm.rawconstr
+
+val chop_rprod_n : int -> Rawterm.rawconstr ->
+  (name*Rawterm.rawconstr) list * Rawterm.rawconstr
+
+val def_of_const : Term.constr -> Term.constr
+val eq : Term.constr Lazy.t
+val refl_equal : Term.constr Lazy.t
+val const_of_id: identifier -> constant
+
+
diff --git a/contrib/funind/indfun_main.ml4 b/contrib/funind/indfun_main.ml4
new file mode 100644
index 00000000..7b3d8cbd
--- /dev/null
+++ b/contrib/funind/indfun_main.ml4
@@ -0,0 +1,201 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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 camlp4deps: "parsing/grammar.cma" i*)
+open Term
+open Names
+open Pp
+open Topconstr
+open Indfun_common 
+open Indfun
+open Genarg
+
+TACTIC EXTEND newfuninv
+   [ "functional" "inversion" ident(hyp) ident(fname) ] -> 
+     [
+       Invfun.invfun hyp fname
+     ]
+END
+
+
+let pr_fun_ind_using  prc _ _ opt_c = 
+  match opt_c with 
+    | None -> mt ()
+    | Some c -> spc () ++ hov 2 (str "using" ++ spc () ++ prc c)
+
+ARGUMENT EXTEND fun_ind_using
+  TYPED AS constr_opt
+  PRINTED BY pr_fun_ind_using
+| [ "using" constr(c) ] -> [ Some c ]
+| [ ] -> [ None ]
+END
+
+let pr_intro_as_pat prc _ _ pat = 
+  str "as" ++ spc () ++ pr_intro_pattern pat
+
+
+
+
+
+ARGUMENT EXTEND with_names TYPED AS intro_pattern PRINTED BY pr_intro_as_pat
+|   [ "as"  simple_intropattern(ipat) ] -> [ ipat ] 
+| []  ->[ IntroAnonymous ] 
+END
+
+
+let is_rec scheme_info = 
+  let test_branche min acc (_,_,br) = 
+    acc ||
+      (let new_branche = Sign.it_mkProd_or_LetIn mkProp (fst (Sign.decompose_prod_assum br)) in 
+      let free_rels_in_br = Termops.free_rels new_branche in 
+      let max = min + scheme_info.Tactics.npredicates in 
+      Util.Intset.exists (fun i -> i >= min && i< max) free_rels_in_br)
+  in
+  Util.list_fold_left_i test_branche 1 false (List.rev scheme_info.Tactics.branches)
+
+
+let choose_dest_or_ind scheme_info =
+    if is_rec scheme_info
+    then Tactics.new_induct
+    else
+      Tactics.new_destruct
+
+
+TACTIC EXTEND newfunind
+   ["new" "functional" "induction" constr(c) fun_ind_using(princl) with_names(pat)] -> 
+     [
+       let f,args = decompose_app c in 
+       fun g -> 
+	 let princ = 
+	   match princl with 
+	     | None -> (* No principle is given let's find the good one *)
+		 let fname = 
+		   match kind_of_term f with 
+		     | Const c' -> 
+			 id_of_label (con_label c') 
+		     | _ -> Util.error "Must be used with a function" 
+		 in
+		 let princ_name = 
+		   (
+		     Indrec.make_elimination_ident
+		       fname
+		       (Tacticals.elimination_sort_of_goal g)
+		   )
+		 in
+		 mkConst(const_of_id princ_name )
+	     | Some princ -> princ 
+	 in
+	 let princ_type = Tacmach.pf_type_of g princ in 
+	 let princ_infos = Tactics.compute_elim_sig princ_type in 
+	 let args_as_induction_constr =
+	   let c_list = 
+	     if princ_infos.Tactics.farg_in_concl 
+	     then [c] else [] 
+	   in
+	   List.map (fun c -> Tacexpr.ElimOnConstr c) (args@c_list) 
+	 in 
+	 let princ' = Some (princ,Rawterm.NoBindings) in 
+	 choose_dest_or_ind 
+	   princ_infos
+	   args_as_induction_constr
+	   princ'
+	   pat g
+     ]
+END
+
+
+VERNAC ARGUMENT EXTEND rec_annotation2
+  [ "{"  "struct" ident(id)  "}"] -> [ Struct id ]
+| [ "{" "wf" constr(r) ident_opt(id) "}" ] -> [ Wf(r,id) ]
+| [ "{" "mes" constr(r) ident_opt(id) "}" ] -> [ Mes(r,id) ] 
+END
+
+
+VERNAC ARGUMENT EXTEND binder2
+    [ "(" ne_ident_list(idl) ":" lconstr(c)  ")"] ->
+     [
+       LocalRawAssum (List.map (fun id -> (Util.dummy_loc,Name id)) idl,c) ]
+END
+
+
+VERNAC ARGUMENT EXTEND rec_definition2
+ [ ident(id)  binder2_list( bl)
+     rec_annotation2_opt(annot) ":" lconstr( type_)
+	":=" lconstr(def)] ->
+    [let names = List.map snd (Topconstr.names_of_local_assums bl) in
+     let check_one_name () =
+       if List.length names > 1 then
+         Util.user_err_loc
+           (Util.dummy_loc,"GenFixpoint",
+            Pp.str "the recursive argument needs to be specified");
+     in
+     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" in 
+	 (try ignore(Util.list_index (Name id) names - 1); annot
+	  with Not_found ->  Util.user_err_loc
+            (Util.dummy_loc,"GenFixpoint",
+             Pp.str "No argument named " ++ Nameops.pr_id id)
+	 )
+       with Failure "check_exists_args" ->  check_one_name ();annot
+     in
+     let ni =
+       match annot with
+         | None ->
+             annot
+	 | Some an ->
+	     check_exists_args an
+     in
+     (id, ni, bl, type_, def) ]
+      END
+
+
+VERNAC ARGUMENT EXTEND rec_definitions2
+| [ rec_definition2(rd) ] -> [ [rd] ]
+| [ rec_definition2(hd) "with" rec_definitions2(tl) ] -> [ hd::tl ]
+END
+
+
+VERNAC COMMAND EXTEND GenFixpoint
+   ["GenFixpoint" rec_definitions2(recsl)] ->
+	[ do_generate_principle false  recsl]
+END
+
+VERNAC COMMAND EXTEND IGenFixpoint
+   ["IGenFixpoint" rec_definitions2(recsl)] ->
+	[ do_generate_principle true  recsl]
+END
+
+
+VERNAC ARGUMENT EXTEND fun_scheme_arg
+| [ ident(princ_name) ":=" "Induction" "for" ident(fun_name) "Sort" sort(s) ] -> [ (princ_name,fun_name,s) ] 
+END 
+
+VERNAC ARGUMENT EXTEND fun_scheme_args
+| [ fun_scheme_arg(fa) ] -> [ [fa] ] 
+| [ fun_scheme_arg(fa) "with" fun_scheme_args(fas) ] -> [fa::fas]
+END 
+
+VERNAC COMMAND EXTEND NewFunctionalScheme
+   ["New" "Functional" "Scheme" fun_scheme_args(fas) ] ->
+    [
+      New_arg_principle.make_scheme fas
+    ]
+END
+
+
+VERNAC COMMAND EXTEND NewFunctionalCase
+   ["New" "Functional" "Case" fun_scheme_arg(fas) ] ->
+    [
+      New_arg_principle.make_case_scheme fas
+    ]
+END
+
+
+VERNAC COMMAND EXTEND GenerateGraph 
+["Generate" "graph" "for" ident(c)] -> [ make_graph c ]
+END
diff --git a/contrib/funind/invfun.ml b/contrib/funind/invfun.ml
new file mode 100644
index 00000000..1f711297
--- /dev/null
+++ b/contrib/funind/invfun.ml
@@ -0,0 +1,148 @@
+open Util
+open Names
+open Term
+open Tacinvutils
+open Pp
+open Libnames
+open Tacticals
+open Tactics
+open Indfun_common
+open Tacmach
+open Sign
+
+
+let tac_pattern l =
+  (Hiddentac.h_reduce 
+    (Rawterm.Pattern l)
+    Tacticals.onConcl
+  )
+
+
+let rec nb_prod x =
+  let rec count n c =
+    match kind_of_term c with
+        Prod(_,_,t) -> count (n+1) t
+      | LetIn(_,a,_,t) -> count n (subst1 a t)
+      | Cast(c,_,_) -> count n c
+      | _ -> n
+  in count 0 x
+
+let intro_discr_until n tac : tactic = 
+  let rec intro_discr_until acc : tactic =
+  fun g -> 
+    if nb_prod (pf_concl g) <= n then tac (List.rev acc) g
+    else 
+      tclTHEN 
+	intro 
+	(fun g' ->
+	  let id,_,t = pf_last_hyp g' in
+	  tclORELSE
+	     (tclABSTRACT None (Extratactics.h_discrHyp (Rawterm.NamedHyp id)))
+	    (intro_discr_until ((id,t)::acc))
+	    g'
+	) 
+	g
+  in
+  intro_discr_until []
+
+
+let rec discr_rew_in_H hypname idl : tactic =
+  match idl with 
+    | [] -> (Extratactics.h_discrHyp (Rawterm.NamedHyp hypname))
+    | ((id,t)::idl') ->
+       match kind_of_term t with 
+	 | App(eq',[| _ ; arg1 ; _ |]) when eq_constr eq' (Lazy.force eq) -> 
+	     begin 
+	       let constr,_ = decompose_app arg1 in 
+	       if isConstruct constr 
+	       then 
+		 (discr_rew_in_H hypname idl')
+	       else 
+		 tclTHEN 
+		   (tclTRY (Equality.general_rewrite_in true hypname (mkVar id)))
+		   (discr_rew_in_H hypname idl')
+	     end
+	 | _ -> discr_rew_in_H hypname idl'
+
+let finalize fname hypname idl : tactic = 
+  tclTRY (
+    (tclTHEN 
+      (Hiddentac.h_reduce
+	(Rawterm.Unfold [[],EvalConstRef fname])
+	(Tacticals.onHyp hypname)
+      )
+      (discr_rew_in_H hypname idl)
+    ))
+
+let gen_fargs fargs : tactic = 
+  fun g -> 
+    generalize
+      (List.map
+	 (fun arg -> 
+	    let targ = pf_type_of g arg in
+	    let refl_arg = mkApp (Lazy.force refl_equal , [|targ ; arg|]) in
+	    refl_arg
+	 )
+	 (Array.to_list fargs)
+      ) 
+      g 
+      
+
+let invfun (hypname:identifier) (fid:identifier) : tactic=
+  fun g -> 
+    let nprod_goal = nb_prod (pf_concl g) in
+    let f_ind_id =  
+      (
+	Indrec.make_elimination_ident
+	  fid 
+	  (Tacticals.elimination_sort_of_goal g)
+      )
+    in
+    let fname = const_of_id fid in
+    let princ = const_of_id f_ind_id in
+    let princ_info = 
+      let princ_type = 
+	(try (match (Global.lookup_constant princ) with
+		  {Declarations.const_type=t} -> t
+	     )
+	 with _ -> assert false)
+      in
+      Tactics.compute_elim_sig princ_type
+    in
+    let _,_,typhyp = List.find (fun (id,_,_) -> hypname=id) (pf_hyps g) in
+    let do_invert  fargs  appf : tactic = 
+      let frealargs = (snd (array_chop (List.length princ_info.params) fargs))  
+      in
+      let pat_args = 
+	(List.map (fun e -> ([-1],e)) (Array.to_list frealargs)) @ [[],appf] 
+      in
+      tclTHENSEQ 
+	[
+	  gen_fargs frealargs;
+	  tac_pattern pat_args;
+	  Hiddentac.h_apply (mkConst princ,Rawterm.NoBindings);
+	  intro_discr_until nprod_goal (finalize fname hypname) 
+	    
+	]
+    in
+    match kind_of_term typhyp with
+      | App(eq',[| _ ; arg1 ; arg2 |]) when eq_constr eq' (Lazy.force eq) -> 
+(* 	  let valf = def_of_const (mkConst fname) in *)
+	  let eq_arg1 , eq_arg2 , good_eq_form , fargs = 
+	    match kind_of_term arg1 , kind_of_term arg2 with
+	      | App(f, args),_ when eq_constr f (mkConst fname) -> 
+		  arg1 , arg2 , tclIDTAC , args
+	      | _,App(f, args) when eq_constr f (mkConst fname) -> 
+		  arg2 , arg1 , symmetry_in hypname , args
+	      | _ , _  -> error "inversion impossible" 
+	  in
+	  tclTHEN
+	    good_eq_form
+	    (do_invert fargs eq_arg1)
+	    g
+      | App(f',fargs) when eq_constr f' (mkConst fname) -> 
+	  do_invert fargs typhyp g
+	  
+
+      | _ -> error "inversion impossible"
+
diff --git a/contrib/funind/new_arg_principle.ml b/contrib/funind/new_arg_principle.ml
new file mode 100644
index 00000000..8ef23c48
--- /dev/null
+++ b/contrib/funind/new_arg_principle.ml
@@ -0,0 +1,1770 @@
+open Printer
+open Util
+open Term
+open Termops 
+open Names 
+open Declarations
+open Pp
+open Entries
+open Hiddentac
+open Evd
+open Tacmach
+open Proof_type
+open Tacticals
+open Tactics
+open Indfun_common
+
+
+let msgnl = Pp.msgnl
+
+let do_observe () = 
+  Tacinterp.get_debug () <> Tactic_debug.DebugOff  
+
+
+let observe strm =
+  if do_observe ()
+  then Pp.msgnl strm
+  else ()
+
+let observennl strm =
+  if do_observe ()
+  then begin Pp.msg strm;Pp.pp_flush () end
+  else ()
+
+
+
+
+let do_observe_tac s tac g =
+ try let v = tac g in (* msgnl (goal ++ fnl () ++ (str s)++(str " ")++(str "finished")); *) v
+ with e ->
+   let goal = begin try (Printer.pr_goal (sig_it g)) with _ -> assert false end in
+   msgnl (str "observation "++str s++str " raised exception " ++ 
+	    Cerrors.explain_exn e ++ str "on goal " ++ goal ); 
+   raise e;;
+
+
+let observe_tac s tac g =
+  if do_observe ()
+  then do_observe_tac s tac g
+  else tac g
+
+
+let tclTRYD tac = 
+  if  !Options.debug  || do_observe ()
+  then (fun g -> try do_observe_tac "" tac g with _ -> tclIDTAC g)
+  else tac
+
+
+let list_chop ?(msg="") n l = 
+  try 
+    list_chop n l 
+  with Failure (msg') -> 
+    failwith (msg ^ msg')
+  
+
+let make_refl_eq type_of_t t  =
+  let refl_equal_term = Lazy.force refl_equal in
+  mkApp(refl_equal_term,[|type_of_t;t|])
+
+
+type static_fix_info = 
+    {
+      idx : int;
+      name : identifier;
+      types : types
+    }
+
+type static_infos = 
+    {
+      fixes_ids : identifier list; 
+      ptes_to_fixes : static_fix_info Idmap.t
+    }
+
+type 'a dynamic_info = 
+    { 
+      nb_rec_hyps : int;
+      rec_hyps : identifier list ; 
+      eq_hyps : identifier list;
+      info : 'a
+    }
+
+let finish_proof dynamic_infos g = 
+  observe_tac "finish" 
+    h_assumption
+    g
+	  
+
+let refine c = 
+  Tacmach.refine_no_check c
+
+let thin l = 
+  Tacmach.thin_no_check l
+  
+
+let cut_replacing id t tac :tactic= 
+  tclTHENS (cut t)
+    [ tclTHEN (thin_no_check [id]) (introduction_no_check id);
+      tac 
+    ]
+
+let intro_erasing id = tclTHEN (thin [id]) (introduction id)
+
+
+
+let rec_hyp_id = id_of_string "rec_hyp"
+
+let is_trivial_eq t = 
+  match kind_of_term t with 
+    | App(f,[|_;t1;t2|]) when eq_constr f (Lazy.force eq) -> 
+	eq_constr t1 t2
+    | _ -> false 
+
+
+let rec incompatible_constructor_terms t1 t2 = 
+  let c1,arg1 = decompose_app t1 
+  and c2,arg2 = decompose_app t2 
+  in 
+  (not (eq_constr t1 t2)) &&
+    isConstruct c1 && isConstruct c2 && 
+    (
+      not (eq_constr c1 c2) || 
+	List.exists2 incompatible_constructor_terms arg1 arg2
+    )
+
+let is_incompatible_eq t = 
+  match kind_of_term t with 
+    | App(f,[|_;t1;t2|]) when eq_constr f (Lazy.force eq) -> 
+	incompatible_constructor_terms t1 t2
+    | _ -> false 
+
+let change_hyp_with_using hyp_id t tac = 
+  fun g -> 
+    let prov_id = pf_get_new_id hyp_id g in 
+    tclTHENLIST 
+      [
+	forward (Some tac) (Genarg.IntroIdentifier prov_id) t;
+	thin [hyp_id];
+	h_rename prov_id hyp_id
+      ] g
+
+exception TOREMOVE
+
+
+let prove_trivial_eq h_id context (type_of_term,term) = 
+  let nb_intros = List.length context in 
+  tclTHENLIST
+    [
+      tclDO nb_intros intro; (* introducing context *)
+      (fun g -> 
+	 let context_hyps =  
+	   fst (list_chop ~msg:"prove_trivial_eq : " nb_intros (pf_ids_of_hyps g)) 
+	 in
+	 let context_hyps' = 
+	   (mkApp(Lazy.force refl_equal,[|type_of_term;term|]))::
+	     (List.map mkVar context_hyps)
+	 in
+	 let to_refine = applist(mkVar h_id,List.rev context_hyps') in 
+	 refine to_refine g
+      )
+    ]
+
+
+let isAppConstruct t = 
+  if isApp t 
+  then isConstruct (fst (destApp t))
+  else false 
+
+
+let nf_betaoiotazeta = Reductionops.local_strong Reductionops.whd_betaiotazeta 
+
+let remove_useless_rel env sigma hyp_id (context:Sign.rel_context) t end_of_type t1 t2 =
+    let rel_num = destRel t2 in
+
+    let nb_kept = List.length context - rel_num 
+    and nb_popped = rel_num - 1
+    in
+
+    (* We remove the equation *) 
+    let new_end_of_type = pop end_of_type in
+    
+    let lt_relnum,ge_relnum = 
+      list_chop  
+	~msg:("removing useless variable "^(string_of_int rel_num)^" :")
+	nb_popped
+	context 
+    in
+    (* we rebuilt the type of hypothesis after the rel to remove *)
+    let hyp_type_lt_relnum = 
+      it_mkProd_or_LetIn ~init:new_end_of_type lt_relnum 
+    in 
+    (* we replace Rel 1 by t1 *) 
+    let new_hyp_type_lt_relnum = subst1 t1 hyp_type_lt_relnum in 
+    (* we resplit the type of hyp_type *)
+    let new_lt_relnum,new_end_of_type = 
+      Sign.decompose_prod_n_assum nb_popped new_hyp_type_lt_relnum 
+    in
+    (* and rebuilt new context of hyp *)
+    let new_context = new_lt_relnum@(List.tl ge_relnum) in 
+    let new_typ_of_hyp =
+      nf_betaoiotazeta (it_mkProd_or_LetIn ~init:new_end_of_type new_context)
+    in
+    let prove_simpl_eq =
+      tclTHENLIST
+	[
+	  tclDO (nb_popped + nb_kept) intro;
+	  (fun g'  ->
+	     let new_hyps_ids = pf_ids_of_hyps g' in
+	     let popped_ids,others =
+	       list_chop ~msg:"removing useless variable pop :"
+		 nb_popped new_hyps_ids in
+	     let kept_ids,_ =
+	       list_chop ~msg: " removing useless variable kept : "
+		 nb_kept others
+	     in
+	     let rev_to_apply =
+	       (mkApp(Lazy.force refl_equal,[|Typing.type_of env sigma t1;t1|]))::
+		 ((List.map mkVar popped_ids)@
+		    (t1::
+		       (List.map mkVar kept_ids)))
+	       in
+	     let to_refine = applist(mkVar hyp_id,List.rev rev_to_apply) in
+	     refine to_refine g'
+	  )
+	]
+    in
+    let simpl_eq_tac = change_hyp_with_using hyp_id new_typ_of_hyp
+      (observe_tac "prove_simpl_eq" prove_simpl_eq)
+    in
+    let new_end_of_type = nf_betaoiotazeta new_end_of_type in
+    (new_context,new_end_of_type,simpl_eq_tac),new_typ_of_hyp,
+  (str " removing useless variable " ++ str (string_of_int rel_num) )
+
+
+let decompose_eq env sigma hyp_id (context:Sign.rel_context) t end_of_type t1 t2 = 
+    let c1,args1 = destApp t1 
+    and c2,args2 = destApp t2 
+    in
+    (* This tactic must be used after is_incompatible_eq *)
+    assert (eq_constr c1 c2); 
+    (* we remove this equation *)
+    let new_end_of_type = pop end_of_type in 
+    let new_eqs = 
+      array_map2_i 
+	(fun i arg1 arg2 -> 
+	   let new_eq = 
+	     let type_of_arg =  Typing.type_of env sigma arg1 in 
+ 	     mkApp(Lazy.force eq,[|type_of_arg;arg1;arg2|])
+	   in
+	    Anonymous,None,lift i new_eq
+	)
+	args1
+	args2
+    in
+    let nb_new_eqs = Array.length new_eqs in 
+    (* we add the new equation *) 
+    let new_end_of_type = lift nb_new_eqs new_end_of_type in 
+    let local_context = 
+      List.rev (Array.to_list new_eqs) in 
+    let new_end_of_type = it_mkProd_or_LetIn ~init:new_end_of_type local_context in
+    let new_typ_of_hyp = 
+      nf_betaoiotazeta (it_mkProd_or_LetIn ~init:new_end_of_type context) 
+    in 
+    let prove_pattern_simplification =
+      let context_length = List.length context in
+      tclTHENLIST 
+	[
+	  tclDO (context_length + nb_new_eqs) intro ;
+	  (fun g -> 
+	     let new_eqs,others = 
+	       list_chop ~msg:"simplifying pattern : new_eqs" nb_new_eqs (pf_hyps g)
+	     in
+	     let context_hyps,_ = list_chop ~msg:"simplifying pattern : context_hyps" 
+	       context_length others in
+	     let eq_args = 
+	       List.rev_map 
+		 (fun (_,_, eq) -> let _,args = destApp eq in   args.(1),args.(2))
+		 new_eqs 
+	     in
+	     let lhs_args,rhs_args = List.split eq_args in 
+	     let lhs_eq = applist(c1,lhs_args) 
+	     and rhs_eq = applist(c1,rhs_args) 
+	     in 
+	     let type_of_eq = pf_type_of g lhs_eq in 
+	     let eq_to_assert = 
+	       mkApp(Lazy.force eq,[|type_of_eq;lhs_eq;rhs_eq|])
+	     in
+	     let prove_new_eq = 
+	       tclTHENLIST [
+		 tclMAP 
+		   (fun (id,_,_) -> 
+		      (* The tclTRY here is used when trying to rewrite 
+			 on Set 
+			 eg (@cons A x l)=(@cons A x' l') generates 3 eqs 
+			 A=A -> x=x' -> l = l' ...
+			 
+		      *)
+		      tclTRY (Equality.rewriteLR (mkVar id))
+		   )
+		   new_eqs;
+		 reflexivity
+	       ]
+	     in
+	     let new_eq_id = pf_get_new_id  (id_of_string "H") g in 
+	     let create_new_eq = 
+	       forward         
+		 (Some (observe_tac "prove_new_eq" (prove_new_eq)))
+		 (Genarg.IntroIdentifier new_eq_id)        
+		 eq_to_assert 
+	     in
+	     let to_refine =
+	       applist (
+		 mkVar hyp_id,
+		 List.rev ((mkVar new_eq_id)::
+			     (List.map (fun (id,_,_) -> mkVar id) context_hyps)))
+	     in 
+	     tclTHEN 
+	       (observe_tac "create_new_eq" create_new_eq )
+	       (observe_tac "refine in decompose_eq " (refine to_refine))
+	       g
+	  )
+	]
+    in
+    let simpl_eq_tac = 
+      change_hyp_with_using hyp_id new_typ_of_hyp (observe_tac "prove_pattern_simplification " prove_pattern_simplification)
+    in 
+    (context,nf_betaoiotazeta new_end_of_type,simpl_eq_tac),new_typ_of_hyp,
+  str "simplifying an equation " 
+
+let change_eq env sigma hyp_id (context:Sign.rel_context) x t end_of_type  = 
+  if not (noccurn 1 end_of_type)
+  then (* if end_of_type depends on this term we don't touch it  *)
+    begin 
+      observe (str "Not treating " ++ pr_lconstr t    );
+      failwith "NoChange"; 
+    end;
+  let res,new_typ_of_hyp,msg = 
+    if not (isApp t) then failwith "NoChange";
+    let f,args = destApp t in 
+    if not (eq_constr f (Lazy.force eq)) then failwith "NoChange"; 
+      let t1 = args.(1) 
+      and t2 = args.(2)
+      in 
+      if isRel t2 && closed0 t1 then (* closed_term = x with x bound in context *)
+	begin
+	  remove_useless_rel env sigma hyp_id (context:Sign.rel_context) t end_of_type t1 t2
+	end 
+      else if isAppConstruct t1 && isAppConstruct t2 (* C .... = C .... *) 
+      then decompose_eq env sigma hyp_id context t end_of_type t1 t2
+      else failwith "NoChange"
+  in 
+  observe (str "In " ++ Ppconstr.pr_id hyp_id ++ 
+	     msg ++ fnl ()++ 
+	     str "old_typ_of_hyp :=" ++
+	     Printer.pr_lconstr_env
+	     env
+	       (it_mkProd_or_LetIn ~init:end_of_type ((x,None,t)::context))
+	   ++ fnl () ++
+	     str "new_typ_of_hyp := "++ 
+	     Printer.pr_lconstr_env env new_typ_of_hyp ++ fnl ());
+  (res:'a*'b*'c)
+  
+
+
+
+let is_property static_info t_x = 
+  if isApp t_x 
+  then 
+    let pte,args = destApp t_x in 
+    if isVar pte && array_for_all closed0 args 
+    then Idmap.mem (destVar pte) static_info.ptes_to_fixes
+    else false 
+  else false 
+
+let isLetIn t = 
+  match kind_of_term t with 
+    | LetIn _ -> true 
+    | _ -> false 
+
+
+let h_reduce_with_zeta = 	 
+  h_reduce 
+    (Rawterm.Cbv
+       {Rawterm.all_flags 
+	with Rawterm.rDelta = false; 		 
+       })
+  
+(* 
+let rewrite_until_var arg_num : tactic =
+  let constr_eq =  Lazy.force eq in 
+  let replace_if_unify arg (pat,cl,id,lhs)  : tactic =
+    fun g ->
+      try
+	let (evd,matched) =
+	  Unification.w_unify_to_subterm
+	    (pf_env g) ~mod_delta:false (pat,arg) cl.Clenv.env
+	in
+	let cl' = {cl with Clenv.env = evd } in
+	let c2 = Clenv.clenv_nf_meta cl' lhs in
+	(Equality.replace matched c2) g
+      with _ -> tclFAIL 0 (str "") g
+  in
+  let rewrite_on_step equalities : tactic =
+    fun g ->
+      match kind_of_term (pf_concl g) with
+	| App(_,args) when (not (test_var args arg_num)) ->
+(* 	    tclFIRST (List.map (fun a -> observe_tac (str "replace_if_unify") (replace_if_unify args.(arg_num) a)) equalities) g *)
+	    tclFIRST (List.map (replace_if_unify args.(arg_num)) equalities) g
+	| _ ->
+	    raise (Util.UserError("", (str "No more rewrite" ++
+					 pr_lconstr_env (pf_env g) (pf_concl g))))
+  in
+  fun g ->
+    let equalities =
+      List.filter
+	(
+	  fun (_,_,id_t) ->
+	    match kind_of_term id_t with
+	      | App(f,_) -> eq_constr f constr_eq
+	      | _ -> false
+	)
+	(pf_hyps g)
+    in
+    let f (id,_,ctype)  =
+      let c = mkVar id in
+      let eqclause = Clenv.make_clenv_binding g (c,ctype) Rawterm.NoBindings in
+      let clause_type = Clenv.clenv_type eqclause in
+      let f,args = decompose_app (clause_type) in
+      let rec split_last_two = function
+	| [c1;c2] -> (c1, c2)
+	| x::y::z ->
+	    split_last_two (y::z)
+	| _ ->
+	    error ("The term provided is not an equivalence")
+      in
+      let (c1,c2) = split_last_two args in
+      (c2,eqclause,id,c1)
+    in
+    let matching_hyps = List.map f equalities in
+    tclTRY (tclREPEAT (tclPROGRESS (rewrite_on_step matching_hyps))) g
+
+*)
+
+
+let rewrite_until_var arg_num eq_ids : tactic =
+  let test_var g = 
+    let _,args = destApp (pf_concl g) in 
+    isVar args.(arg_num)
+  in
+  let rec do_rewrite eq_ids g  = 
+    if test_var g 
+    then tclIDTAC g
+    else
+      match eq_ids with 
+	| [] -> anomaly "Cannot find a way to prove recursive property";
+	| eq_id::eq_ids -> 
+	    tclTHEN 
+	      (tclTRY (Equality.rewriteRL (mkVar eq_id)))
+	      (do_rewrite eq_ids)
+	      g
+  in
+  do_rewrite eq_ids
+
+let prove_rec_hyp eq_hyps fix_info =
+  tclTHEN 
+    (rewrite_until_var (fix_info.idx - 1) eq_hyps)
+    (fun g -> 
+       let _,pte_args = destApp (pf_concl g) in 
+       let rec_hyp_proof = 
+	 mkApp(mkVar fix_info.name,array_get_start pte_args) 
+       in
+       refine rec_hyp_proof g
+    )
+
+	 
+
+
+
+let rec_pte_id = id_of_string "Hrec" 
+let clean_hyp_with_heq static_infos eq_hyps hyp_id env sigma = 
+  let coq_False = Coqlib.build_coq_False () in 
+  let coq_True = Coqlib.build_coq_True () in 
+  let coq_I = Coqlib.build_coq_I () in 
+  let rec scan_type  context type_of_hyp : tactic = 
+    if isLetIn type_of_hyp then 
+      let real_type_of_hyp = it_mkProd_or_LetIn ~init:type_of_hyp context in
+      let reduced_type_of_hyp = nf_betaoiotazeta real_type_of_hyp in 
+      (* length of context didn't change ? *)
+      let new_context,new_typ_of_hyp = 
+	 Sign.decompose_prod_n_assum (List.length context) reduced_type_of_hyp
+      in
+        tclTHENLIST 
+	[
+	  h_reduce_with_zeta
+	    (Tacticals.onHyp hyp_id)
+	  ;
+	  scan_type new_context new_typ_of_hyp 
+	  
+	]
+    else if isProd type_of_hyp 
+    then 
+      begin 
+	let (x,t_x,t') = destProd type_of_hyp in
+	if is_property static_infos t_x then
+	  begin
+	    let pte,pte_args =  (destApp t_x) in 
+	    let fix_info = Idmap.find (destVar pte) static_infos.ptes_to_fixes in 
+	    let popped_t' = pop t' in 
+	    let real_type_of_hyp = it_mkProd_or_LetIn ~init:popped_t' context in 
+	    let prove_new_type_of_hyp = 
+	      let context_length = List.length context in 
+	      tclTHENLIST
+		[ 
+		  tclDO context_length intro; 
+		  (fun g ->  
+		     let context_hyps_ids = 
+		       fst (list_chop ~msg:"rec hyp : context_hyps"
+			      context_length (pf_ids_of_hyps g))
+		     in
+		     let rec_pte_id = pf_get_new_id rec_pte_id g in 
+		     let to_refine = 
+		       applist(mkVar hyp_id,
+			       List.rev_map mkVar (rec_pte_id::context_hyps_ids)
+			      )
+		     in
+		     tclTHENLIST
+		       [ 
+			 forward 
+			   (Some (prove_rec_hyp eq_hyps fix_info))
+			   (Genarg.IntroIdentifier rec_pte_id)
+			   t_x;
+			 refine to_refine
+		       ]
+		       g
+		  )
+		]
+	    in
+	    tclTHENLIST 
+	      [
+		observe_tac "hyp rec" 
+		  (change_hyp_with_using hyp_id real_type_of_hyp prove_new_type_of_hyp);
+		scan_type context popped_t'
+	      ]
+	  end
+	else if eq_constr t_x coq_False then 
+	  begin
+	    observe (str "Removing : "++ Ppconstr.pr_id hyp_id++ 
+		       str " since it has False in its preconds "
+		    );
+	    raise TOREMOVE;  (* False -> .. useless *)
+	  end
+	else if is_incompatible_eq t_x then raise TOREMOVE (* t_x := C1 ... =  C2 ... *) 
+	else if eq_constr t_x coq_True  (* Trivial => we remove this precons *)
+	then 
+	  let _ = 
+	    observe (str "In "++Ppconstr.pr_id hyp_id++ 
+		       str " removing useless precond True"
+		    ) 
+	  in 
+	  let popped_t' = pop t' in
+	  let real_type_of_hyp = 
+	    it_mkProd_or_LetIn ~init:popped_t' context 
+	  in 
+	  let prove_trivial =  
+	    let nb_intro = List.length context in 
+	    tclTHENLIST [
+	      tclDO nb_intro intro;
+	      (fun g -> 
+		 let context_hyps = 
+		   fst (list_chop ~msg:"removing True : context_hyps "nb_intro (pf_ids_of_hyps g))
+		 in
+		 let to_refine = 
+		   applist (mkVar hyp_id,
+			    List.rev (coq_I::List.map mkVar context_hyps)
+			   )
+		 in
+		 refine to_refine g
+	      )
+	    ]
+	  in
+	  tclTHENLIST[
+	    change_hyp_with_using hyp_id real_type_of_hyp (observe_tac "prove_trivial" prove_trivial);
+	    scan_type context popped_t'
+	  ]
+	else if is_trivial_eq t_x 
+	then (*  t_x :=  t = t   => we remove this precond *) 
+	  let popped_t' = pop t' in
+	  let real_type_of_hyp =
+	    it_mkProd_or_LetIn ~init:popped_t' context
+	  in
+	  let _,args = destApp t_x in
+	  tclTHENLIST
+	    [
+	      change_hyp_with_using
+		hyp_id
+		real_type_of_hyp
+		(observe_tac "prove_trivial_eq" (prove_trivial_eq hyp_id context (args.(0),args.(1))));
+	      scan_type context popped_t'
+	    ] 
+	else 
+	  begin
+	    try 
+	      let new_context,new_t',tac = change_eq env sigma hyp_id context x t_x t' in 
+	      tclTHEN
+		tac 
+		(scan_type new_context new_t')
+	    with Failure "NoChange" -> 
+	      (* Last thing todo : push the rel in the context and continue *) 
+	      scan_type ((x,None,t_x)::context) t'
+	  end
+      end
+    else
+      tclIDTAC
+  in 
+  try 
+    scan_type [] (Typing.type_of env sigma (mkVar hyp_id)), [hyp_id]
+  with TOREMOVE -> 
+    thin [hyp_id],[]
+
+
+let clean_goal_with_heq static_infos continue_tac dyn_infos  = 
+  fun g -> 
+    let env = pf_env g 
+    and sigma = project g 
+    in
+    let tac,new_hyps = 
+      List.fold_left ( 
+	fun (hyps_tac,new_hyps) hyp_id ->
+	  let hyp_tac,new_hyp = 
+	    clean_hyp_with_heq static_infos dyn_infos.eq_hyps hyp_id env sigma 
+	  in
+	  (tclTHEN hyp_tac hyps_tac),new_hyp@new_hyps
+      )
+	(tclIDTAC,[])
+	dyn_infos.rec_hyps
+    in
+    let new_infos = 
+      { dyn_infos with 
+	  rec_hyps = new_hyps; 
+	  nb_rec_hyps  = List.length new_hyps
+      }
+    in
+    tclTHENLIST 
+      [
+	tac ;
+	(continue_tac new_infos)
+      ]
+      g    
+
+let heq_id = id_of_string "Heq"
+
+let treat_new_case static_infos nb_prod continue_tac term dyn_infos = 
+  fun g -> 
+    let heq_id = pf_get_new_id heq_id g in 
+    let nb_first_intro = nb_prod - 1 - dyn_infos.nb_rec_hyps in
+    tclTHENLIST
+      [ 
+	(* We first introduce the variables *) 
+	tclDO nb_first_intro (intro_avoiding dyn_infos.rec_hyps);
+	(* Then the equation itself *)
+	introduction_no_check heq_id;
+	(* Then the new hypothesis *) 
+	tclMAP introduction_no_check dyn_infos.rec_hyps;
+	observe_tac "after_introduction" (fun g' -> 
+	   (* We get infos on the equations introduced*)
+	   let new_term_value_eq = pf_type_of g' (mkVar heq_id) in 
+	   (* compute the new value of the body *)
+	   let new_term_value =
+	     match kind_of_term new_term_value_eq with
+	       | App(f,[| _;_;args2 |]) -> args2
+	       | _ ->
+		   observe (pr_gls g' ++ fnl () ++ str "last hyp is" ++
+			      pr_lconstr_env (pf_env g') new_term_value_eq
+			   );
+		   assert false
+	   in
+	 let fun_body =
+	   mkLambda(Anonymous,
+		    pf_type_of g' term,
+		    replace_term term (mkRel 1) dyn_infos.info
+		   )
+	 in
+	 let new_body = pf_nf_betaiota g' (mkApp(fun_body,[| new_term_value |])) in
+	 let new_infos = 
+	   {dyn_infos with 
+	      info = new_body;
+	      eq_hyps = heq_id::dyn_infos.eq_hyps
+	   }
+	 in 
+	 clean_goal_with_heq static_infos continue_tac new_infos  g'
+      )
+    ]
+      g
+
+let do_prove_princ_for_struct 
+    (interactive_proof:bool)
+    (fnames:constant list)
+    static_infos
+(*     (ptes:identifier list)  *)
+(*     (fixes:(int*constr*identifier*constr) Idmap.t) *)
+(*     (hyps: identifier list) *)
+(*     (term:constr) *)
+    dyn_infos
+    : tactic =
+(*   let fixes_ids = Idmap.fold (fun _ (_,_,id,_) acc -> id::acc) fixes [] in *)
+  let rec do_prove_princ_for_struct_aux do_finalize dyn_infos : tactic = 
+    fun g -> 
+(*      observe (str "proving on " ++ Printer.pr_lconstr_env (pf_env g) term);*)
+	match kind_of_term dyn_infos.info with 
+	  | Case(_,_,t,_) -> 
+	      let g_nb_prod = nb_prod (pf_concl g) in
+	      let type_of_term = pf_type_of g t in
+	      let term_eq =
+		make_refl_eq type_of_term t
+	      in
+  	      tclTHENSEQ
+		[
+		  h_generalize (term_eq::List.map mkVar dyn_infos.rec_hyps);
+		  thin dyn_infos.rec_hyps;
+		  pattern_option [[-1],t] None;
+		  h_simplest_case t;
+		  (fun g' -> 
+		     let g'_nb_prod = nb_prod (pf_concl g') in 
+		     let nb_instanciate_partial = g'_nb_prod - g_nb_prod in 
+		     observe_tac "treat_new_case" 
+		       (treat_new_case  
+		       static_infos
+		       nb_instanciate_partial 
+		       (do_prove_princ_for_struct do_finalize) 
+		       t 
+		       dyn_infos)
+		       g'
+		  )
+		  
+		] g
+	  | Lambda(n,t,b) ->
+	      begin
+		match kind_of_term( pf_concl g) with
+		  | Prod _ ->
+		      tclTHEN
+			intro
+			(fun g' ->
+			   let (id,_,_) = pf_last_hyp g' in
+			   let new_term = 
+			     pf_nf_betaiota g' 
+			       (mkApp(dyn_infos.info,[|mkVar id|])) 
+			   in
+			   let new_infos = {dyn_infos with info = new_term} in
+			   do_prove_princ_for_struct do_finalize new_infos g'
+			) g
+		  | _ ->
+		      do_finalize dyn_infos g 
+	      end
+	  | Cast(t,_,_) -> 
+	      do_prove_princ_for_struct do_finalize {dyn_infos with info = t} g
+	  | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ ->
+	      do_finalize dyn_infos g
+	  | App(_,_) ->
+	      let f,args = decompose_app dyn_infos.info in
+	      begin
+		match kind_of_term f with
+		  | Var _ | Construct _ | Rel _ | Evar _ | Meta _  | Ind _ ->
+		      let new_infos = 
+			{ dyn_infos with 
+			    info = (f,args)
+			}
+		      in
+		      do_prove_princ_for_struct_args do_finalize new_infos  g
+		  | Const c when not (List.mem c fnames) ->
+		      let new_infos = 
+			{ dyn_infos with 
+			    info = (f,args)
+			}
+		      in
+		      do_prove_princ_for_struct_args do_finalize new_infos g
+		  | Const _ ->
+		      do_finalize dyn_infos  g
+		  | _ ->
+(* 		      observe *)
+(* 			(str "Applied binders not yet implemented: in "++ fnl () ++ *)
+(* 			   pr_lconstr_env (pf_env g) term ++ fnl () ++ *)
+(* 			   pr_lconstr_env (pf_env g) f ++ spc () ++ str "is applied") ; *)
+		      tclFAIL 0 (str "TODO : Applied binders not yet implemented") g
+	      end
+	  | Fix _ | CoFix _ ->
+	      error ( "Anonymous local (co)fixpoints are not handled yet")
+
+	  | Prod _ -> assert false
+	  | LetIn _ -> 
+	      let new_infos = 
+		{ dyn_infos with 
+		    info = nf_betaoiotazeta dyn_infos.info 
+		}
+	      in 
+
+	      tclTHENLIST 
+		[tclMAP 
+		   (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) 
+		   dyn_infos.rec_hyps;
+		 h_reduce_with_zeta Tacticals.onConcl;
+		 do_prove_princ_for_struct do_finalize new_infos
+		] g
+	  | _ ->
+	      errorlabstrm "" (str "in do_prove_princ_for_struct found : "(* ++ *)
+(* 				 pr_lconstr_env (pf_env g) term *)
+			      )
+  and do_prove_princ_for_struct do_finalize dyn_infos g =
+(*     observe (str "proving with "++Printer.pr_lconstr term++ str " on goal " ++ pr_gls g); *)
+    do_prove_princ_for_struct_aux do_finalize dyn_infos g
+  and do_prove_princ_for_struct_args do_finalize dyn_infos (* f_args'  args *) :tactic =
+    fun g ->
+(*      if Tacinterp.get_debug () <> Tactic_debug.DebugOff  *)
+(*      then msgnl (str "do_prove_princ_for_struct_args with "  ++  *)
+(* 		   pr_lconstr_env (pf_env g) f_args' *)
+(* 		); *)
+      let (f_args',args) = dyn_infos.info in 
+      let tac =
+	match args with
+	  | []  ->
+	      do_finalize {dyn_infos with info = f_args'}
+	  | arg::args ->
+	      let do_finalize dyn_infos =
+		let new_arg = dyn_infos.info in 
+		tclTRYD
+		  (do_prove_princ_for_struct_args
+		     do_finalize
+		     {dyn_infos with info = (mkApp(f_args',[|new_arg|])), args}
+		  )
+	      in
+	      do_prove_princ_for_struct do_finalize 
+		{dyn_infos with info = arg }
+      in
+      tclTRYD(tac ) g
+  in
+  let do_finish_proof dyn_infos = 
+    clean_goal_with_heq 
+      static_infos
+      finish_proof dyn_infos
+  in
+  observe_tac "do_prove_princ_for_struct"
+    (do_prove_princ_for_struct do_finish_proof dyn_infos) 
+
+let is_pte_type t =
+  isSort (snd (decompose_prod t))
+    
+let is_pte (_,_,t) = is_pte_type t
+
+exception Not_Rec
+
+
+
+let instanciate_hyps_with_args (do_prove:identifier list -> tactic) hyps args_id = 
+  let args = Array.of_list (List.map mkVar  args_id) in 
+  let instanciate_one_hyp hid = 
+    tclORELSE
+      ( (* we instanciate the hyp if possible  *)
+(* 	tclTHENLIST *)
+(* 	  [h_generalize [mkApp(mkVar hid,args)]; *)
+(* 	   intro_erasing hid] *)
+	fun g -> 
+	  let prov_hid = pf_get_new_id hid g in
+	  tclTHENLIST[
+	    forward None (Genarg.IntroIdentifier prov_hid) (mkApp(mkVar hid,args));
+	    thin [hid];
+	    h_rename prov_hid hid
+	  ] g
+      )
+      ( (*
+	  if not then we are in a mutual function block 
+	  and this hyp is a recursive hyp on an other function.
+	  
+	  We are not supposed to use it while proving this 
+	  principle so that we can trash it 
+	  
+	*)
+	(fun g -> 
+	   observe (str "Instanciation: removing hyp " ++ Ppconstr.pr_id hid);
+	   thin [hid] g
+	)
+      )
+  in
+  (* if no args then no instanciation ! *)     
+  if args_id = []  
+  then 
+    tclTHENLIST [
+      tclMAP (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) hyps;
+      do_prove hyps
+    ]
+  else
+    tclTHENLIST
+      [
+	tclMAP (fun hyp_id -> h_reduce_with_zeta (Tacticals.onHyp hyp_id)) hyps;
+	tclMAP instanciate_one_hyp hyps;
+	(fun g ->  
+	   let all_g_hyps_id = 
+	     List.fold_right Idset.add (pf_ids_of_hyps g) Idset.empty
+	   in 
+	   let remaining_hyps = 
+	     List.filter (fun id -> Idset.mem id all_g_hyps_id) hyps
+	   in
+	   do_prove remaining_hyps g
+	  )
+      ]
+    
+
+let prove_princ_for_struct interactive_proof fun_num fnames all_funs _naprams : tactic =
+   fun goal ->
+(*      observe (str "Proving principle for "++ str (string_of_int fun_num) ++ str "th function : " ++  *)
+(* 		pr_lconstr (mkConst fnames.(fun_num))); *)
+     let princ_type = pf_concl goal in
+     let princ_info = compute_elim_sig princ_type in
+     let get_body const =
+       match (Global.lookup_constant const ).const_body with
+	 | Some b ->
+	     let body = force b in
+	     Tacred.cbv_norm_flags
+	       (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA])
+	       (Global.env ())
+	       (Evd.empty)
+	       body
+	 | None -> error ( "Cannot define a principle over an axiom ")
+     in
+     let fbody = get_body fnames.(fun_num) in
+     let params : identifier list ref = ref [] in
+     let predicates : identifier list ref = ref [] in
+     let args : identifier list ref = ref [] in
+     let branches : identifier list ref = ref [] in
+     let pte_to_fix = ref Idmap.empty in
+     let fbody_with_params = ref None in
+     let intro_with_remembrance  ref number : tactic =
+       tclTHEN
+	 ( tclDO number intro )
+	 (fun g ->
+	    let last_n = list_chop number (pf_hyps g) in
+	    ref :=  List.map (fun (id,_,_) -> id) (fst last_n)@ !ref;
+	    tclIDTAC g
+	 )
+     in
+     let rec partial_combine body params =
+       match kind_of_term body,params with
+	 | Lambda (x,t,b),param::params ->
+	     partial_combine (subst1 param b) params
+	 | Fix(infos),_ ->
+	     body,params, Some (infos)
+	 | _ -> body,params,None
+     in
+     let build_pte_to_fix (offset:int) params predicates
+	 ((idxs,fix_num),(na,typearray,ca))  (avoid,_) =
+(*        let true_params,_ =  list_chop offset params  in  *)
+       let true_params = List.rev params in
+       let avoid = ref avoid in
+       let res = list_fold_left_i
+	 (fun i acc pte_id  ->
+	    let this_fix_id = fresh_id !avoid "fix___" in
+	    avoid := this_fix_id::!avoid;
+(* 	    let this_body = substl (List.rev fnames_as_constr) ca.(i) in  *)
+	    let new_type = prod_applist typearray.(i) true_params in
+	    let new_type_args,_ = decompose_prod new_type in
+	    let nargs = List.length new_type_args in
+	    let pte_args =
+	      (* 	      let rev_args = List.rev_map (fun (id,_,_) -> mkVar id) new_type_args in  *)
+	      let f = applist((* all_funs *)mkConst fnames.(i),true_params) in
+	      let app_f = mkApp(f,Array.init nargs (fun i -> mkRel(nargs - i))) in
+	      (Array.to_list (Array.init nargs (fun i -> mkRel(nargs - i))))@[app_f]
+	    in
+	    let app_pte = applist(mkVar pte_id,pte_args) in
+	    let new_type = compose_prod new_type_args app_pte in
+	    let fix_info = 
+	      {
+		idx = idxs.(i) - offset + 1;
+		name = this_fix_id; 
+		types = new_type
+	      }
+	    in
+	    pte_to_fix := Idmap.add  pte_id fix_info !pte_to_fix;
+	    fix_info::acc
+	 )
+	 0
+	 []
+	 predicates
+       in
+       !avoid,List.rev res
+     in
+     let mk_fixes : tactic =
+       fun g ->
+	 let body_p,params',fix_infos =
+	   partial_combine fbody (List.rev_map mkVar  !params)
+	 in
+	 fbody_with_params := Some body_p;
+	 let offset  = List.length params' in
+	 let not_real_param,true_params =
+	   list_chop
+	     ((List.length !params ) - offset)
+	     !params
+	 in
+	 params := true_params; args := not_real_param;
+(* 	 observe (str "mk_fixes : params are "++  *)
+(* 		    prlist_with_sep spc *)
+(* 		    (fun id -> pr_lconstr (mkVar id)) *)
+(* 		    !params *)
+(* 		 ); *)
+	 let new_avoid,infos =
+	   option_fold_right
+	     (build_pte_to_fix
+		offset
+		(List.map mkVar !params)
+		(List.rev !predicates)
+	     )
+	     fix_infos
+	     ((pf_ids_of_hyps g),[])
+	 in
+	 let pre_info,infos = list_chop fun_num infos in
+	 match pre_info,infos with
+	   | [],[] -> tclIDTAC g
+	   | _,this_fix_info::infos' ->
+	       let other_fix_info =
+		 List.map 
+		   (fun fix_info -> fix_info.name,fix_info.idx,fix_info.types) 
+		   (pre_info@infos')
+	       in
+	       tclORELSE
+		 (h_mutual_fix this_fix_info.name this_fix_info.idx other_fix_info)
+		 (tclFAIL 1000 (str "bad index" ++ 
+				  str (string_of_int this_fix_info.idx) ++
+				  str "offset := " ++
+				  (str (string_of_int offset))))
+		 g
+	   | _,[] -> anomaly "Not a valid information"
+     in
+     let do_prove ptes_to_fixes args branches : tactic =
+       fun g ->
+	 let static_infos = 
+	   {
+	     ptes_to_fixes = ptes_to_fixes;
+	     fixes_ids = 
+	       Idmap.fold 
+		 (fun _ fix_info acc -> fix_info.name::acc) 
+		 ptes_to_fixes []
+	   }
+	 in
+	 match kind_of_term (pf_concl g) with
+	   | App(pte,pte_args) when isVar pte ->
+	       begin
+		 let pte = destVar pte in
+		 try
+		   if not (Idmap.mem pte ptes_to_fixes) then raise Not_Rec;
+		   let nparams = List.length !params in
+		   let args_as_constr = List.map mkVar  args in
+		  let rec_num,new_body =
+		    let idx' = list_index pte (List.rev !predicates)  - 1 in
+		    let f = fnames.(idx') in
+		    let body_with_params = match !fbody_with_params with Some f -> f | _ -> anomaly ""
+		    in
+		    let name_of_f = Name ( id_of_label (con_label f)) in
+		    let ((rec_nums,_),(na,_,bodies)) = destFix body_with_params in
+		    let idx'' = list_index name_of_f (Array.to_list na) - 1 in
+		    let body = substl (List.rev (Array.to_list all_funs)) bodies.(idx'') in
+		    let body = Reductionops.nf_beta (applist(body,(List.rev_map mkVar !params))) in
+		    rec_nums.(idx'') - nparams ,body
+		  in
+		  let applied_body =
+		    Reductionops.nf_beta
+		      (applist(new_body,List.rev args_as_constr))
+		  in
+		  let do_prove branches applied_body =
+		    do_prove_princ_for_struct
+		      interactive_proof
+		      (Array.to_list fnames)
+		      static_infos
+		      branches
+		      applied_body
+		  in
+		  let replace_and_prove =
+		    tclTHENS
+		      (fun g ->
+(* 			 observe (str "replacing " ++  *)
+(* 				    pr_lconstr_env (pf_env g) (array_last pte_args) ++ *)
+(* 				    str " with " ++  *)
+(* 				    pr_lconstr_env (pf_env g) applied_body  ++  *)
+(* 				    str " rec_arg_num is " ++ str (string_of_int rec_num) *)
+(* 				 ); *)
+			 (Equality.replace (array_last pte_args) applied_body) g
+		      )
+		      [
+			clean_goal_with_heq 
+			  static_infos do_prove 
+			  {
+			    nb_rec_hyps = List.length branches;
+			    rec_hyps = branches;
+			    info = applied_body;
+			    eq_hyps = [];
+			  } ;
+			try
+			  let id = List.nth (List.rev args_as_constr) (rec_num) in
+			  (* observe (str "choosen var := "++ pr_lconstr id); *)
+			  (tclTHENSEQ
+			     [(h_simplest_case id);
+			      Tactics.intros_reflexivity
+			     ])
+			with _ -> tclIDTAC
+			
+		      ]
+		  in
+		  (observe_tac "doing replacement" ( replace_and_prove)) g
+		 with Not_Rec ->
+		   let fname = destConst (fst (decompose_app (array_last pte_args))) in
+		   tclTHEN
+		     (unfold_in_concl [([],Names.EvalConstRef fname)])
+		     (observe_tac "" 
+			(fun g' ->
+			   let body = array_last (snd (destApp (pf_concl g'))) in 
+			   let dyn_infos = 
+			     { nb_rec_hyps = List.length branches;
+			       rec_hyps = branches;
+			       info = body;
+			       eq_hyps = []
+			     }
+			   in
+			   let do_prove = 
+			     do_prove_princ_for_struct
+			       interactive_proof
+			       (Array.to_list fnames)
+			       static_infos
+			   in
+			   clean_goal_with_heq static_infos
+			     do_prove dyn_infos g'
+			)
+		     )
+		     g
+	       end
+	   | _ -> assert false
+     in
+     tclTHENSEQ
+       [
+	 (fun g -> observe_tac "introducing params" (intro_with_remembrance  params princ_info.nparams) g);
+	 (fun g -> observe_tac "introducing predicate" (intro_with_remembrance predicates  princ_info.npredicates) g);
+	 (fun g -> observe_tac "introducing branches" (intro_with_remembrance branches princ_info.nbranches) g);
+	 (fun g -> observe_tac "declaring fix(es)" mk_fixes g);
+	 (fun g -> 
+	    let nb_prod_g = nb_prod (pf_concl g) in 
+	    tclTHENLIST [
+	      tclDO nb_prod_g intro;
+	      (fun g' -> 
+		 let args = 
+		   fst (list_chop ~msg:"args" nb_prod_g (pf_ids_of_hyps g')) 
+		 in
+		 let do_prove_on_branches branches : tactic =
+		   observe_tac "proving" (do_prove !pte_to_fix args branches)
+		 in
+		   observe_tac "instanciating rec hyps" 
+		   (instanciate_hyps_with_args do_prove_on_branches !branches (List.rev args))
+		 g'
+	      )
+	    ]
+	      g
+	 )
+       ]
+       goal
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  
+exception Toberemoved_with_rel of int*constr
+exception Toberemoved
+  
+let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
+  let princ_type_info = compute_elim_sig princ_type in 
+  let env = Global.env () in 
+(*   let type_sort = (Termops.new_sort_in_family InType) in  *)
+  let change_predicate_sort i (x,_,t) = 
+    let new_sort = sorts.(i) in
+    let args,_ = decompose_prod t in 
+    let real_args = 
+      if princ_type_info.indarg_in_concl 
+      then List.tl args 
+      else args
+    in
+    x,None,compose_prod real_args (mkSort new_sort) 
+  in
+  let new_predicates = 
+    list_map_i
+      change_predicate_sort 
+      0
+      princ_type_info.predicates
+  in
+  let env_with_params_and_predicates = 
+    Environ.push_rel_context 
+      new_predicates
+      (Environ.push_rel_context 
+	 princ_type_info.params 
+	 env
+      )
+  in
+  let rel_as_kn = 
+    fst (match princ_type_info.indref with
+	   | Some (Libnames.IndRef ind) -> ind 
+	   | _ -> failwith "Not a valid predicate"
+	)
+  in
+  let pre_princ = 
+    it_mkProd_or_LetIn 
+      ~init:
+      (it_mkProd_or_LetIn 
+	 ~init:(option_fold_right
+			   mkProd_or_LetIn
+			   princ_type_info.indarg
+			   princ_type_info.concl
+			)
+	 princ_type_info.args
+      )
+      princ_type_info.branches
+  in
+  let is_dom c =
+    match kind_of_term c with
+      | Ind((u,_)) -> u = rel_as_kn
+      | Construct((u,_),_) -> u = rel_as_kn
+      | _ -> false
+  in
+  let get_fun_num c =
+    match kind_of_term c with
+      | Ind(_,num) -> num
+      | Construct((_,num),_) -> num
+      | _ -> assert false
+  in
+  let dummy_var = mkVar (id_of_string "________") in
+  let mk_replacement c i args =
+    let res = mkApp(rel_to_fun.(i),Array.map pop (array_get_start args)) in 
+(*     observe (str "replacing " ++ pr_lconstr c ++ str " by "  ++ pr_lconstr res); *)
+    res
+  in
+  let rec has_dummy_var t  =
+    fold_constr
+      (fun b t -> b || (eq_constr t dummy_var) || (has_dummy_var t))
+      false
+      t
+  in
+  let rec compute_new_princ_type remove env pre_princ : types*(constr list) =
+    let (new_princ_type,_) as res =
+      match kind_of_term pre_princ with
+	| Rel n ->
+	    begin
+	      try match Environ.lookup_rel n env with
+		| _,_,t when is_dom t -> raise Toberemoved
+		| _ -> pre_princ,[] with Not_found -> assert false
+	    end
+	| Prod(x,t,b) ->
+	    compute_new_princ_type_for_binder remove mkProd env x t b
+	| Lambda(x,t,b) ->
+	    compute_new_princ_type_for_binder remove mkLambda env x t b
+	| Ind _ | Construct _ when is_dom pre_princ -> raise Toberemoved
+	| App(f,args) when is_dom f ->
+	    let var_to_be_removed = destRel (array_last args) in
+	    let num = get_fun_num f in
+	    raise (Toberemoved_with_rel (var_to_be_removed,mk_replacement pre_princ num args))
+	| App(f,args) ->
+	    let is_pte = 
+	      match kind_of_term f with 
+		| Rel n ->  
+		    is_pte (Environ.lookup_rel n env)
+		| _ -> false 
+	    in
+	    let args = 
+	      if is_pte && remove 
+	      then array_get_start args 
+	      else args 
+	    in
+	    let new_args,binders_to_remove =
+	      Array.fold_right (compute_new_princ_type_with_acc remove env)
+		args
+		([],[])
+	    in
+	    let new_f,binders_to_remove_from_f = compute_new_princ_type remove env f in
+	    applist(new_f, new_args),
+	    list_union_eq eq_constr binders_to_remove_from_f binders_to_remove
+	| LetIn(x,v,t,b) ->
+	    compute_new_princ_type_for_letin remove env x v t b
+	| _ -> pre_princ,[]
+    in
+(*     observennl ( *)
+(*       match kind_of_term pre_princ with  *)
+(* 	| Prod _ ->  *)
+(* 	    str "compute_new_princ_type for "++ *)
+(* 	      pr_lconstr_env env pre_princ ++ *)
+(* 	      str" is "++ *)
+(* 	      pr_lconstr_env env new_princ_type ++ fnl () *)
+(* 	| _ -> str "" *)
+(*     ); *)
+    res
+	
+  and compute_new_princ_type_for_binder remove bind_fun env x t b =
+    begin
+      try
+	let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in
+	let new_x : name = get_name (ids_of_context env) x in
+	let new_env = Environ.push_rel (x,None,t) env in
+	let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in
+	if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b
+	then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b
+	else
+	  (
+	    bind_fun(new_x,new_t,new_b),
+	    list_union_eq
+	      eq_constr
+	      binders_to_remove_from_t
+	      (List.map pop binders_to_remove_from_b)
+	  )
+	
+      with
+	| Toberemoved ->
+(* 	    msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *)
+	    let new_b,binders_to_remove_from_b = compute_new_princ_type  remove env (substnl [dummy_var] 1 b)  in
+	    new_b, List.map pop binders_to_remove_from_b
+	| Toberemoved_with_rel (n,c) ->
+(* 	    msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *)
+	    let new_b,binders_to_remove_from_b = compute_new_princ_type  remove env (substnl [c] n b)  in
+	    new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b)
+    end
+  and compute_new_princ_type_for_letin remove env x v t b =
+    begin
+      try
+	let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in
+	let new_v,binders_to_remove_from_v = compute_new_princ_type remove env v in
+	let new_x : name = get_name (ids_of_context env) x in
+	let new_env = Environ.push_rel (x,Some v,t) env in
+	let new_b,binders_to_remove_from_b = compute_new_princ_type remove  new_env b in
+	if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b
+	then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b
+	else
+	  (
+	    mkLetIn(new_x,new_v,new_t,new_b),
+	    list_union_eq
+	      eq_constr
+	      (list_union_eq eq_constr binders_to_remove_from_t binders_to_remove_from_v)
+	      (List.map pop binders_to_remove_from_b)
+	  )
+	
+      with
+	| Toberemoved ->
+(* 	    msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *)
+	    let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b)  in
+	    new_b, List.map pop binders_to_remove_from_b
+	| Toberemoved_with_rel (n,c) ->
+(* 	    msgnl (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *)
+	    let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b)  in
+	    new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b)
+    end
+  and  compute_new_princ_type_with_acc remove env e (c_acc,to_remove_acc)  =
+	      let new_e,to_remove_from_e = compute_new_princ_type remove env e
+	      in
+	      new_e::c_acc,list_union_eq eq_constr to_remove_from_e to_remove_acc
+  in
+(*   observe (str "Computing new principe from " ++ pr_lconstr_env  env_with_params_and_predicates pre_princ); *)
+  let pre_res,_ = 
+    compute_new_princ_type princ_type_info.indarg_in_concl env_with_params_and_predicates pre_princ in 
+  it_mkProd_or_LetIn  	 
+    ~init:(it_mkProd_or_LetIn ~init:pre_res new_predicates)
+    princ_type_info.params
+    
+  
+
+let change_property_sort toSort princ princName = 
+  let princ_info = compute_elim_sig princ in 
+  let change_sort_in_predicate (x,v,t) = 
+    (x,None,
+     let args,_ = decompose_prod t in 
+     compose_prod args (mkSort toSort)
+    )
+  in 
+  let princName_as_constr = Tacinterp.constr_of_id (Global.env ()) princName in 
+  let init = 
+    let nargs =  (princ_info.nparams + (List.length  princ_info.predicates)) in 
+    mkApp(princName_as_constr,
+	  Array.init nargs
+	    (fun i -> mkRel (nargs - i )))
+  in
+  it_mkLambda_or_LetIn
+    ~init: 
+    (it_mkLambda_or_LetIn ~init 
+       (List.map change_sort_in_predicate princ_info.predicates)
+    )
+    princ_info.params
+    
+
+let pp_dur time time' = 
+  str (string_of_float (System.time_difference time time'))
+
+(* Things to be removed latter : just here to compare 
+   saving proof with and without  normalizing the proof 
+*)
+let new_save id const (locality,kind) hook =
+  let {const_entry_body = pft;
+       const_entry_type = tpo;
+       const_entry_opaque = opacity } = const in
+  let l,r = match locality with
+    | Decl_kinds.Local when Lib.sections_are_opened () ->
+        let k = Decl_kinds.logical_kind_of_goal_kind kind in
+	let c = Declare.SectionLocalDef (pft, tpo, opacity) in
+	let _ = Declare.declare_variable id (Lib.cwd(), c, k) in
+	(Decl_kinds.Local, Libnames.VarRef id)
+    | Decl_kinds.Local ->
+        let k = Decl_kinds.logical_kind_of_goal_kind kind in
+        let kn = Declare.declare_constant id (DefinitionEntry const, k) in
+	(Decl_kinds.Global, Libnames.ConstRef kn)
+    | Decl_kinds.Global ->
+        let k = Decl_kinds.logical_kind_of_goal_kind kind in
+        let kn = Declare.declare_constant id (DefinitionEntry const, k) in
+	(Decl_kinds.Global, Libnames.ConstRef kn) in
+  let time1 = System.get_time () in
+  Pfedit.delete_current_proof ();
+  let time2 = System.get_time () in
+  hook l r;
+  time1,time2
+(*   definition_message id *)
+
+
+
+
+
+let new_save_named opacity =
+(*   if do_observe ()  *)
+(*   then  *)
+  let time1 = System.get_time () in 
+    let id,(const,persistence,hook) = Pfedit.cook_proof () in
+    let time2 = System.get_time () in 
+    let const = 
+      { const with 
+	  const_entry_body = (* nf_betaoiotazeta  *)const.const_entry_body ;
+	  const_entry_opaque = opacity
+      }
+    in
+    let time3 = System.get_time ()  in
+    let time4,time5 = new_save id const persistence hook in
+    let time6 = System.get_time () in 
+    Pp.msgnl
+      (str "cooking proof time : " ++ pp_dur time1 time2 ++ fnl () ++
+	 str "reducing proof time : " ++ pp_dur time2 time3 ++ fnl () ++
+	 str "saving proof time : " ++ pp_dur time3 time4 ++fnl () ++
+	 str "deleting proof time : " ++ pp_dur time4 time5 ++fnl () ++
+	 str "hook time :" ++ pp_dur time5 time6
+      )
+       
+;;
+
+(* End of things to be removed latter : just here to compare 
+   saving proof with and without  normalizing the proof 
+*)
+
+
+let generate_functional_principle 
+    interactive_proof
+    old_princ_type sorts new_princ_name funs i proof_tac 
+    = 
+  let f = funs.(i) in 
+  let type_sort = Termops.new_sort_in_family InType in 
+  let new_sorts = 
+    match sorts with 
+      | None -> Array.make (Array.length funs) (type_sort)
+      | Some a -> a
+  in
+  (* First we get the type of the old graph principle *)
+  let mutr_nparams = (compute_elim_sig old_princ_type).nparams in 
+  (* First we get the type of the old graph principle *)
+   let new_principle_type =
+    compute_new_princ_type_from_rel
+      (Array.map mkConst funs)
+      new_sorts
+      old_princ_type
+   in
+(*    observe (str "new_principle_type : " ++ pr_lconstr new_principle_type); *)
+  let base_new_princ_name,new_princ_name =
+    match new_princ_name with
+      | Some (id) -> id,id
+      | None ->
+	  let id_of_f = id_of_label (con_label f) in
+	  id_of_f,Indrec.make_elimination_ident id_of_f (family_of_sort type_sort)
+  in
+  let names = ref [new_princ_name] in 
+  let hook _ _  =
+    if sorts = None 
+    then
+(*     let id_of_f = id_of_label (con_label f) in *)
+    let register_with_sort fam_sort =
+      let s = Termops.new_sort_in_family  fam_sort in
+      let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in
+      let value =
+	change_property_sort s new_principle_type new_princ_name
+      in
+(*       Pp.msgnl (str "new principle := " ++ pr_lconstr value); *)
+      let ce =
+	{ const_entry_body = value;
+	  const_entry_type = None;
+	  const_entry_opaque = false;
+	  const_entry_boxed = Options.boxed_definitions()
+	}
+      in
+      ignore(
+	Declare.declare_constant
+	  name
+	  (Entries.DefinitionEntry ce,
+	   Decl_kinds.IsDefinition (Decl_kinds.Scheme)
+	  )
+      );
+      names := name :: !names
+    in
+    register_with_sort InProp;
+    register_with_sort InSet
+  in
+  begin
+    Command.start_proof
+      new_princ_name
+      (Decl_kinds.Global,(Decl_kinds.Proof Decl_kinds.Theorem))
+      new_principle_type
+      hook
+    ;
+    try
+      let _tim1 = System.get_time ()  in
+      Pfedit.by  (proof_tac (Array.map mkConst funs) mutr_nparams);
+      let _tim2 =  System.get_time ()  in
+(* 	begin *)
+(* 	  let dur1 = System.time_difference tim1 tim2 in *)
+(* 	  Pp.msgnl (str ("Time to compute proof: ") ++ str (string_of_float dur1)); *)
+(* 	end; *)
+      let do_save =  not (do_observe ()) && not interactive_proof in 
+      let _ = 
+	try 
+	  Options.silently Command.save_named true;
+	  let _dur2 = System.time_difference _tim2 (System.get_time ()) in
+(* 	  Pp.msgnl (str ("Time to check proof: ") ++ str (string_of_float dur2)); *)
+	  Options.if_verbose 
+	    (fun () -> 
+	       Pp.msgnl (
+		 prlist_with_sep
+		   (fun () -> str" is defined " ++ fnl ()) 
+		   Ppconstr.pr_id
+		   (List.rev !names) ++ str" is defined " 
+	       )
+	    ) 
+	       ()
+	with e when do_save -> 
+	  msg_warning
+	    (
+	      Cerrors.explain_exn e
+	    );
+	  if not (do_observe ())
+	  then begin Vernacentries.interp (Vernacexpr.VernacAbort None);raise e end
+      in
+      ()
+
+(*       let tim3 = Sys.time ()  in *)
+(* Pp.msgnl (str ("Time to save proof: ") ++ str (string_of_float (tim3 -. tim2))); *)
+
+    with
+      | e ->
+	  msg_warning
+	    (
+	      Cerrors.explain_exn e
+	    );
+	  if not ( do_observe ())
+	  then begin Vernacentries.interp (Vernacexpr.VernacAbort None);raise e end
+  end
+
+
+
+
+
+
+let get_funs_constant mp dp = 
+  let rec get_funs_constant const e : (Names.constant*int) array = 
+    match kind_of_term (snd (decompose_lam e)) with 
+      | Fix((_,(na,_,_))) -> 
+	  Array.mapi 
+	    (fun i na -> 
+	       match na with 
+		 | Name id -> 
+		     let const = make_con mp dp (label_of_id id) in 
+		     const,i
+		 | Anonymous -> 
+		     anomaly "Anonymous fix" 
+	    )
+	    na
+      | _ -> [|const,0|]
+  in
+  function const -> 
+    let find_constant_body const = 
+      match (Global.lookup_constant const ).const_body with
+	| Some b ->
+	    let body = force b in
+	    let body = Tacred.cbv_norm_flags
+	      (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA])
+	      (Global.env ())
+	      (Evd.empty)
+	      body
+	    in
+	    body
+	| None -> error ( "Cannot define a principle over an axiom ")
+    in
+    let f = find_constant_body const in
+    let l_const = get_funs_constant const f in 
+    (* 
+       We need to check that all the functions found are in the same block 
+       to prevent Reset stange thing
+    *) 
+    let l_bodies = List.map find_constant_body (Array.to_list (Array.map fst l_const)) in 
+    let l_params,l_fixes = List.split (List.map decompose_lam l_bodies) in 
+    (* all the paremeter must be equal*) 
+    let _check_params = 
+      let first_params = List.hd l_params  in 
+      List.iter 
+	(fun params -> 
+	   if not ((=) first_params params) 
+	   then error "Not a mutal recursive block"
+	)
+	l_params
+    in
+    (* The bodies has to be very similar *) 
+    let _check_bodies = 
+      try 
+	let extract_info is_first body = 
+	  match kind_of_term body with 
+	    | Fix((idxs,_),(na,ta,ca)) -> (idxs,na,ta,ca)
+	    | _ -> 
+		if is_first && (List.length l_bodies = 1) 
+		then raise Not_Rec
+		else error "Not a mutal recursive block"
+	in
+	let first_infos = extract_info true (List.hd l_bodies) in 
+	let check body  = (* Hope this is correct *)
+	  if not (first_infos = (extract_info false body)) 
+	  then  error "Not a mutal recursive block"
+	in 
+	List.iter check l_bodies
+      with Not_Rec -> ()
+    in
+    l_const
+	
+let make_scheme fas = 
+  let env = Global.env () 
+  and sigma = Evd.empty in
+  let id_to_constr id = 
+    Tacinterp.constr_of_id env  id
+  in 
+  let funs = List.map (fun (_,f,_) -> id_to_constr f) fas in 
+  let first_fun = destConst (List.hd funs) in 
+  let funs_mp,funs_dp,first_fun_id = Names.repr_con first_fun in 
+  let first_fun_rel_id = mk_rel_id (id_of_label first_fun_id) in 
+  let first_fun_kn = 
+    (* Fixme: take into accour funs_mp and funs_dp *)
+    fst (destInd (id_to_constr first_fun_rel_id))
+  in
+  let this_block_funs_indexes = get_funs_constant funs_mp funs_dp first_fun in
+  let this_block_funs = Array.map fst this_block_funs_indexes in 
+  let prop_sort = InProp in
+  let funs_indexes = 
+    let this_block_funs_indexes = Array.to_list this_block_funs_indexes in 
+    List.map
+      (function const -> List.assoc (destConst const) this_block_funs_indexes)
+      funs
+  in
+  let ind_list = 
+    List.map 
+      (fun (idx) -> 
+	 let ind = first_fun_kn,idx in 
+	 let (mib,mip) = Global.lookup_inductive ind in
+	 ind,mib,mip,true,prop_sort
+      )
+      funs_indexes
+  in
+  let l_schemes = List.map (Typing.type_of env sigma ) (Indrec.build_mutual_indrec env sigma ind_list) in 
+  let i = ref (-1) in
+  let sorts = 
+    List.rev_map (fun (_,_,x) -> 
+		Termops.new_sort_in_family (Pretyping.interp_elimination_sort x)
+	     ) 
+      fas 
+  in
+  let princ_names = List.map (fun (x,_,_) -> x) fas in 
+  let _ = List.map2
+    (fun princ_name scheme_type -> 
+       incr i;
+(*        observe (str "Generating " ++ Ppconstr.pr_id princ_name ++str " with " ++ *)
+(* 	       pr_lconstr scheme_type ++ str " and " ++ (fun a -> prlist_with_sep spc (fun c -> pr_lconstr (mkConst c)) (Array.to_list a)) this_block_funs *)
+(* 	       ); *)
+       generate_functional_principle
+	 false
+	 scheme_type
+	 (Some (Array.of_list sorts))
+	 (Some princ_name)
+	 this_block_funs
+	 !i
+	 (prove_princ_for_struct false !i (Array.of_list (List.map destConst funs)))
+    )
+    princ_names
+    l_schemes 
+  in
+  ()
+
+let make_case_scheme fa = 
+  let env = Global.env () 
+  and sigma = Evd.empty in
+  let id_to_constr id = 
+    Tacinterp.constr_of_id env  id
+  in 
+  let funs =  (fun (_,f,_) -> id_to_constr f) fa in 
+  let first_fun = destConst  funs in 
+  let funs_mp,funs_dp,first_fun_id = Names.repr_con first_fun in 
+  let first_fun_rel_id = mk_rel_id (id_of_label first_fun_id) in 
+  let first_fun_kn = 
+    (* Fixme: take into accour funs_mp and funs_dp *)
+    fst (destInd (id_to_constr first_fun_rel_id))
+  in
+  let this_block_funs_indexes = get_funs_constant funs_mp funs_dp first_fun in
+  let this_block_funs = Array.map fst this_block_funs_indexes in 
+  let prop_sort = InProp in
+  let funs_indexes = 
+    let this_block_funs_indexes = Array.to_list this_block_funs_indexes in 
+    List.assoc (destConst funs) this_block_funs_indexes
+  in
+  let ind_fun = 
+	 let ind = first_fun_kn,funs_indexes in 
+	 ind,prop_sort
+  in
+  let scheme_type =  (Typing.type_of env sigma ) ((fun (ind,sf) -> Indrec.make_case_gen env sigma ind sf)  ind_fun) in 
+  let sorts =
+    (fun (_,_,x) ->
+       Termops.new_sort_in_family (Pretyping.interp_elimination_sort x)
+    )
+      fa
+  in
+  let princ_name =  (fun (x,_,_) -> x) fa in
+  let _ = 
+(*     observe (str "Generating " ++ Ppconstr.pr_id princ_name ++str " with " ++ *)
+(* 	       pr_lconstr scheme_type ++ str " and " ++ (fun a -> prlist_with_sep spc (fun c -> pr_lconstr (mkConst c)) (Array.to_list a)) this_block_funs *)
+(* 	    ); *)
+    generate_functional_principle
+      false
+      scheme_type
+      (Some ([|sorts|]))
+      (Some princ_name)
+      this_block_funs
+      0
+      (prove_princ_for_struct false 0 [|destConst funs|])
+  in
+  ()
diff --git a/contrib/funind/new_arg_principle.mli b/contrib/funind/new_arg_principle.mli
new file mode 100644
index 00000000..cad68da6
--- /dev/null
+++ b/contrib/funind/new_arg_principle.mli
@@ -0,0 +1,34 @@
+
+val generate_functional_principle : 
+  (* do we accept interactive proving *)
+  bool ->
+  (* induction principle on rel *) 
+  Term.types ->
+  (* *)
+  Term.sorts array option -> 
+  (* Name of the new principle *) 
+  (Names.identifier) option -> 
+  (* the compute functions to use   *)
+  Names.constant array -> 
+  (* We prove the nth- principle *)
+  int  ->
+  (* The tactic to use to make the proof w.r
+     the number of params
+  *)
+  (Term.constr array -> int -> Tacmach.tactic) -> 
+  unit
+
+
+
+(* val my_reflexivity : Tacmach.tactic  *)
+
+val prove_princ_for_struct : 
+  bool -> 
+  int -> Names.constant array -> Term.constr array -> int -> Tacmach.tactic
+
+
+val compute_new_princ_type_from_rel : Term.constr array -> Term.sorts array -> 
+  Term.types -> Term.types
+
+val make_scheme : (Names.identifier*Names.identifier*Rawterm.rawsort) list ->  unit
+val make_case_scheme : (Names.identifier*Names.identifier*Rawterm.rawsort)  ->  unit
diff --git a/contrib/funind/rawterm_to_relation.ml b/contrib/funind/rawterm_to_relation.ml
new file mode 100644
index 00000000..327198b9
--- /dev/null
+++ b/contrib/funind/rawterm_to_relation.ml
@@ -0,0 +1,1012 @@
+open Printer
+open Pp
+open Names 
+open Term
+open Rawterm
+open Libnames
+open Indfun_common
+open Util
+open Rawtermops
+
+let observe strm =  
+  if Tacinterp.get_debug () <> Tactic_debug.DebugOff  && false 
+  then Pp.msgnl strm 
+  else ()
+let observennl strm =  
+  if Tacinterp.get_debug () <> Tactic_debug.DebugOff  &&false 
+  then Pp.msg strm 
+  else ()
+
+(* type binder_type =  *)
+(*   | Lambda  *)
+(*   | Prod  *)
+(*   | LetIn *)
+  
+(* type raw_context = (binder_type*name*rawconstr) list *)
+
+type binder_type =
+  | Lambda of name 
+  | Prod of name 
+  | LetIn of name
+(*   | LetTuple of name list * name  *)
+
+type raw_context = (binder_type*rawconstr) list
+
+
+(* 
+   compose_raw_context [(bt_1,n_1,t_1);......] rt returns 
+   b_1(n_1,t_1,.....,bn(n_k,t_k,rt)) where the b_i's are the 
+   binders corresponding to the bt_i's
+*)
+let compose_raw_context = 
+  let compose_binder  (bt,t) acc =
+    match bt with 
+      | Lambda n -> mkRLambda(n,t,acc)
+      | Prod n -> mkRProd(n,t,acc)
+      | LetIn n -> mkRLetIn(n,t,acc)
+(*       | LetTuple (nal,na) ->  *)
+(* 	  RLetTuple(dummy_loc,nal,(na,None),t,acc) *)
+  in
+  List.fold_right compose_binder
+  
+
+(* 
+   The main part deals with building a list of raw constructor expressions
+   from the rhs of a fixpoint equation. 
+   
+   
+*)
+
+
+
+type 'a build_entry_pre_return = 
+    {
+      context : raw_context;  (* the binding context of the result *)
+      value : 'a; (* The value *)
+    }
+
+type 'a build_entry_return = 
+    {
+      result : 'a build_entry_pre_return list; 
+      to_avoid : identifier list
+    }
+
+
+(*
+  [combine_results combine_fun res1 res2] combine two results [res1] and [res2] 
+  w.r.t. [combine_fun].
+
+  Informally, both [res1] and [res2] are lists of "constructors"  [res1_1;...] 
+  and [res2_1,....] and we need to produce 
+  [combine_fun res1_1 res2_1;combine_fun res1_1 res2_2;........]
+*)
+
+let combine_results 
+    (combine_fun : 'a build_entry_pre_return -> 'b build_entry_pre_return -> 
+      'c build_entry_pre_return
+    )  
+    (res1: 'a build_entry_return) 
+    (res2 : 'b build_entry_return) 
+    : 'c build_entry_return 
+    = 
+  let pre_result =     List.map 
+    ( fun res1 ->  (* for each result in arg_res *)
+	  List.map (* we add it in each args_res *) 
+	    (fun res2 -> 
+	       combine_fun res1 res2
+	    )
+	    res2.result
+      )
+      res1.result
+  in (* and then we flatten the map *)
+  {
+    result = List.concat pre_result; 
+    to_avoid = list_union res1.to_avoid res2.to_avoid
+  }
+    
+
+(* 
+   The combination function for an argument with a list of argument 
+*)
+
+let combine_args arg args = 
+  {
+    context = arg.context@args.context; 
+    (* Note that the binding context of [arg] MUST be placed before the one of 
+       [args] in order to preserve possible type dependencies 
+    *)
+    value = arg.value::args.value;
+  }
+
+
+let ids_of_binder =  function 
+  | LetIn Anonymous | Prod Anonymous | Lambda Anonymous -> []
+  | LetIn (Name id)  | Prod (Name id) | Lambda (Name id) -> [id]
+(*   | LetTuple(nal,_) ->  *)
+(*       map_succeed (function Name id -> id | _ -> failwith "ids_of_binder") nal *)
+
+let rec change_vars_in_binder mapping = function 
+    [] -> []
+  | (bt,t)::l ->
+      let new_mapping = List.fold_right Idmap.remove (ids_of_binder bt) mapping in 
+      (bt,change_vars mapping t)::
+	(if idmap_is_empty new_mapping
+	 then l 
+	 else change_vars_in_binder new_mapping l
+	)
+
+let rec replace_var_by_term_in_binder x_id term = function
+  | [] -> []
+  | (bt,t)::l -> 
+      (bt,replace_var_by_term x_id term t)::
+	if List.mem x_id (ids_of_binder bt) 
+	then l
+	else replace_var_by_term_in_binder x_id term l
+
+let add_bt_names bt = List.append (ids_of_binder bt)
+
+(* let rec replace_var_by_term_in_binder x_id term = function  *)
+(*   | [] -> []  *)
+(*   | (bt,Name id,t)::l when id_ord id x_id = 0 ->  *)
+(*       (bt,Name id,replace_var_by_term x_id term t)::l *)
+(*   | (bt,na,t)::l ->  *)
+(*       (bt,na,replace_var_by_term x_id term t)::(replace_var_by_term_in_binder x_id term l) *)
+
+(* let rec change_vars_in_binder mapping = function *)
+(*   | [] -> [] *)
+(*   | (bt,(Name id as na),t)::l when Idmap.mem id mapping -> *)
+(*       (bt,na,change_vars mapping t):: l *)
+(*   | (bt,na,t)::l -> *)
+(*       (bt,na,change_vars mapping t):: *)
+(* 	(change_vars_in_binder mapping l) *)
+
+   
+(* let alpha_ctxt avoid b = *)
+(*   let rec alpha_ctxt = function *)
+(*     | [] -> [],b *)
+(*     | (bt,n,t)::ctxt -> *)
+(* 	let new_ctxt,new_b = alpha_ctxt ctxt in *)
+(* 	match n with *)
+(* 	  | Name id when List.mem id avoid -> *)
+(* 	      let new_id = Nameops.next_ident_away id avoid in *)
+(* 	      let mapping = Idmap.add id new_id Idmap.empty in *)
+(* 	      (bt,Name new_id,t):: *)
+(* 		(change_vars_in_binder mapping new_ctxt), *)
+(* 	      change_vars mapping new_b *)
+(* 	  | _ -> (bt,n,t)::new_ctxt,new_b *)
+(*   in *)
+(*   alpha_ctxt *)
+let apply_args ctxt body args = 
+  let need_convert_id avoid id = 
+    List.exists (is_free_in id) args || List.mem id avoid 
+  in 
+  let need_convert avoid  bt =  
+    List.exists (need_convert_id avoid) (ids_of_binder bt)
+  in
+(*   let add_name na avoid =  *)
+(*     match na with  *)
+(*       | Anonymous -> avoid  *)
+(*       | Name id -> id::avoid  *)
+(*   in *)
+  let next_name_away (na:name) (mapping: identifier Idmap.t) (avoid: identifier list) = 
+    match na with 
+       | Name id when List.mem id avoid -> 
+	   let new_id = Nameops.next_ident_away id avoid in 
+	   Name new_id,Idmap.add id new_id mapping,new_id::avoid
+       | _ -> na,mapping,avoid
+  in
+  let next_bt_away bt (avoid:identifier list) = 
+    match bt with 
+      | LetIn na -> 
+	  let new_na,mapping,new_avoid = next_name_away na Idmap.empty avoid  in 
+	  LetIn new_na,mapping,new_avoid
+      | Prod na -> 
+	  let new_na,mapping,new_avoid = next_name_away na Idmap.empty avoid  in 
+	  Prod new_na,mapping,new_avoid
+      | Lambda na -> 
+	  let new_na,mapping,new_avoid = next_name_away na Idmap.empty avoid  in 
+	  Lambda new_na,mapping,new_avoid
+(*       | LetTuple (nal,na) ->  *)
+(* 	  let rev_new_nal,mapping,new_avoid =  *)
+(* 	    List.fold_left *)
+(* 	      (fun (nal,mapping,(avoid:identifier list)) na ->  *)
+(* 		 let new_na,new_mapping,new_avoid = next_name_away na mapping avoid in *)
+(* 		 (new_na::nal,new_mapping,new_avoid) *)
+(* 	      ) *)
+(* 	      ([],Idmap.empty,avoid) *)
+(* 	      nal *)
+(* 	  in  *)
+(* 	  (LetTuple(List.rev rev_new_nal,na),mapping,new_avoid) *)
+  in
+  let rec do_apply avoid ctxt body args = 
+    match ctxt,args with  
+      | _,[] -> (* No more args *)
+	  (ctxt,body)
+      | [],_ -> (* no more fun *)
+	  let f,args' = raw_decompose_app body in
+	  (ctxt,mkRApp(f,args'@args))
+      | (Lambda Anonymous,t)::ctxt',arg::args' -> 
+	  do_apply avoid ctxt' body args'
+      | (Lambda (Name id),t)::ctxt',arg::args' -> 
+	  let new_avoid,new_ctxt',new_body,new_id = 
+	    if need_convert_id avoid id 
+	    then 
+	      let new_avoid =  id::avoid in 
+	      let new_id = Nameops.next_ident_away id new_avoid in 
+	      let new_avoid' = new_id :: new_avoid in 
+	      let mapping = Idmap.add id new_id Idmap.empty in 
+	      let new_ctxt' = change_vars_in_binder mapping ctxt' in 
+	      let new_body = change_vars mapping body in 
+	      new_avoid',new_ctxt',new_body,new_id
+	    else 
+	      id::avoid,ctxt',body,id 
+	  in
+	  let new_body = replace_var_by_term new_id arg new_body in
+	  let new_ctxt' = replace_var_by_term_in_binder new_id arg new_ctxt' in
+	  do_apply avoid new_ctxt' new_body args'
+      | (bt,t)::ctxt',_ -> 
+	  let new_avoid,new_ctxt',new_body,new_bt = 
+	    let new_avoid = add_bt_names bt avoid in 
+	    if need_convert avoid bt 
+	    then 
+	      let new_bt,mapping,new_avoid = next_bt_away bt new_avoid in 
+	      (
+		new_avoid,
+		change_vars_in_binder mapping ctxt',
+		change_vars mapping body,
+		new_bt
+	     )
+	    else new_avoid,ctxt',body,bt
+	  in
+	  let new_ctxt',new_body = 
+	    do_apply new_avoid new_ctxt' new_body args 
+	  in
+	  (new_bt,t)::new_ctxt',new_body
+  in 
+  do_apply []  ctxt body args
+
+
+let combine_app f args = 
+  let new_ctxt,new_value = apply_args f.context f.value args.value in 
+  { 
+    (* Note that the binding context of [args] MUST be placed before the one of 
+       the applied value in order to preserve possible type dependencies 
+    *)
+
+      context = args.context@new_ctxt;
+      value = new_value;
+  }
+
+let combine_lam n t b = 
+  {
+    context = []; 
+    value = mkRLambda(n, compose_raw_context t.context t.value, 
+		      compose_raw_context b.context b.value )
+  }
+
+
+
+let combine_prod n t b = 
+  { context = t.context@((Prod n,t.value)::b.context); value = b.value}
+
+let combine_letin n t b = 
+  { context = t.context@((LetIn n,t.value)::b.context); value = b.value}
+
+(* let combine_tuple nal na b in_e =  *)
+(*   {  *)
+(*     context = b.context@(LetTuple(nal,na),b.value)::in_e.context;  *)
+(*     value = in_e.value *)
+(*   } *)
+
+let mk_result ctxt value avoid = 
+  { 
+    result = 
+      [{context = ctxt;
+	value = value}]
+	;
+    to_avoid = avoid
+  }
+
+
+let make_discr_match_el  = 
+  List.map (fun e -> (e,(Anonymous,None)))
+
+let coq_True_ref = 
+  lazy  (Coqlib.gen_reference "" ["Init";"Logic"] "True")
+
+let coq_False_ref = 
+  lazy  (Coqlib.gen_reference "" ["Init";"Logic"] "False")
+
+let make_discr_match_brl i = 
+  list_map_i 
+    (fun j (_,idl,patl,_) -> 
+       if j=i
+       then (dummy_loc,idl,patl, mkRRef (Lazy.force coq_True_ref))
+       else (dummy_loc,idl,patl, mkRRef (Lazy.force coq_False_ref))
+    )
+    0 
+    
+let make_discr_match brl = 
+  fun el i -> 
+  mkRCases(None,
+	   make_discr_match_el el,
+	   make_discr_match_brl i brl)
+  
+
+
+let rec make_pattern_eq_precond id e pat : identifier * (binder_type * Rawterm.rawconstr) list = 
+  match pat with 
+    | PatVar(_,Anonymous) -> assert false 
+    | PatVar(_,Name x) -> 
+	id,[Prod (Name x),mkRHole ();Prod Anonymous,raw_make_eq (mkRVar x) e]
+    | PatCstr(_,constr,patternl,_) -> 
+	let new_id,new_patternl,patternl_eq_precond = 
+	  List.fold_right 
+	    (fun pat' (id,new_patternl,preconds) -> 
+	       match pat' with 
+		 | PatVar (_,Name id) -> (id,id::new_patternl,preconds)
+		 | _ -> 
+		     let new_id = Nameops.lift_ident id in 
+		     let new_id',pat'_precond = 
+		       make_pattern_eq_precond new_id (mkRVar id) pat' 
+		     in
+		     (new_id',id::new_patternl,preconds@pat'_precond)
+	    )
+	    patternl
+	    (id,[],[])
+	in
+	let cst_narg = 
+	  Inductiveops.mis_constructor_nargs_env
+	    (Global.env ())
+	    constr
+	in
+	let implicit_args =  
+	  Array.to_list 
+	    (Array.init 
+	       (cst_narg - List.length patternl)
+	       (fun _ -> mkRHole ())
+	    )
+	in
+	let cst_as_term =      
+	  mkRApp(mkRRef(Libnames.ConstructRef constr),
+		 implicit_args@(List.map mkRVar new_patternl)
+		)
+	in
+	let precond' = 
+	  (Prod Anonymous, raw_make_eq cst_as_term  e)::patternl_eq_precond 
+	in
+	let precond'' = 
+	  List.fold_right 
+	    (fun id acc ->
+	       (Prod (Name id),(mkRHole ()))::acc
+	    )
+	    new_patternl
+	    precond'
+	in
+	new_id,precond''
+
+let pr_name = function
+  | Name id -> Ppconstr.pr_id id
+  | Anonymous -> str "_"
+
+let make_pattern_eq_precond id e pat = 
+  let res = make_pattern_eq_precond id e pat in 
+  observe 
+    (prlist_with_sep spc  
+       (function (Prod na,t) -> 
+	  str "forall " ++ pr_name na ++ str ":" ++ pr_rawconstr t
+	| _ -> assert false
+       )
+       (snd res)
+    );
+  res
+
+
+let rec build_entry_lc funnames avoid rt  : rawconstr build_entry_return = 
+(*   Pp.msgnl (str " Entering : " ++ Printer.pr_rawconstr rt); *)
+  match rt with 
+    | RRef _ | RVar _ | REvar _ | RPatVar _     | RSort _  | RHole _  -> 
+	mk_result [] rt avoid
+    | RApp(_,_,_) ->
+	let f,args = raw_decompose_app rt in
+	let args_res : (rawconstr list) build_entry_return =
+	  List.fold_right
+	    (fun arg ctxt_argsl ->
+	       let arg_res = build_entry_lc  funnames ctxt_argsl.to_avoid arg in
+	       combine_results combine_args  arg_res ctxt_argsl
+	    )
+	    args
+	    (mk_result [] [] avoid)
+	in
+	begin
+	  match f with
+	    | RVar(_,id) when Idset.mem id funnames ->
+		let res = fresh_id args_res.to_avoid "res" in
+		let new_avoid = res::args_res.to_avoid in
+		let res_rt = mkRVar res in 
+		let new_result = 
+		  List.map 
+		    (fun arg_res -> 
+		       let new_hyps = 
+			 [Prod (Name res),mkRHole ();
+			  Prod Anonymous,mkRApp(res_rt,(mkRVar id)::arg_res.value)]
+		       in
+		       {context =  arg_res.context@new_hyps; value = res_rt } 
+		    )
+		    args_res.result
+		in 
+		{ result = new_result; to_avoid = new_avoid }
+	    | RVar _ | REvar _ | RPatVar _ | RHole _ | RSort _ | RRef _ -> 
+		{
+		  args_res with 
+		    result = 
+		    List.map 
+		      (fun args_res -> 
+			 {args_res with value = mkRApp(f,args_res.value)})
+		      args_res.result
+		}
+	    | RApp _ -> assert false (* we have collected all the app *)
+       	    | RLetIn(_,n,t,b) -> 
+		let new_n,new_b,new_avoid = 
+		  match n with 
+		    | Name id when List.exists (is_free_in id) args -> 
+			(* need to alpha-convert the name *)
+			let new_id = Nameops.next_ident_away id avoid in 
+			let new_avoid = id:: avoid in
+			let new_b = 
+			  replace_var_by_term
+			    id
+			    (RVar(dummy_loc,id)) 
+			    b
+			in 
+			(Name new_id,new_b,new_avoid)
+		    | _ -> n,b,avoid
+		in
+		build_entry_lc 
+		  funnames 
+		  avoid
+		  (mkRLetIn(new_n,t,mkRApp(new_b,args)))
+	    | RCases _ | RLambda _  -> 
+		let f_res = build_entry_lc funnames  args_res.to_avoid f in
+		combine_results combine_app f_res  args_res
+	    | RDynamic _ ->error "Not handled RDynamic"
+	    | RCast _ -> error "Not handled RCast"
+	    | RRec _ -> error "Not handled RRec"
+	    | RIf _ -> error "Not handled RIf"
+	    | RLetTuple _ -> error "Not handled RLetTuple"
+	    | RProd _ -> error "Cannot apply a type"
+	end
+    | RLambda(_,n,t,b) ->
+	let b_res = build_entry_lc funnames avoid b in
+	let t_res = build_entry_lc funnames avoid t  in
+	let new_n = 
+	  match n with 
+	    | Name _ -> n 
+	    | Anonymous -> Name (Indfun_common.fresh_id [] "_x")
+	in
+	combine_results (combine_lam new_n) t_res b_res
+    | RProd(_,n,t,b) ->
+	let b_res = build_entry_lc funnames avoid b in
+	let t_res = build_entry_lc funnames avoid t in
+	combine_results (combine_prod n) t_res b_res
+    | RLetIn(_,n,t,b) ->
+	let b_res = build_entry_lc funnames avoid b in
+	let t_res = build_entry_lc funnames avoid t in
+	combine_results (combine_letin n) t_res b_res
+    | RCases(_,_,el,brl) -> 
+	let make_discr = make_discr_match brl in 
+	build_entry_lc_from_case funnames make_discr el brl avoid
+    | RIf _ -> error "Not handled RIf"
+    | RLetTuple _ -> error "Not handled RLetTuple"
+    | RRec _ -> error "Not handled RRec"
+    | RCast _ -> error "Not handled RCast"
+    | RDynamic _ -> error "Not handled RDynamic"
+and build_entry_lc_from_case funname make_discr
+    (el:(Rawterm.rawconstr *
+	   (Names.name * (loc * Names.inductive * Names.name list) option) )
+       list)
+    (brl:(loc * identifier list * cases_pattern list * rawconstr) list) avoid : 
+    rawconstr build_entry_return = 
+  match el with 
+    | [] -> assert false (* matched on Nothing !*) 
+    | el -> 
+	let case_resl = 
+	    List.fold_right
+	    (fun (case_arg,_) ctxt_argsl ->
+	       let arg_res = build_entry_lc funname avoid case_arg  in
+	       combine_results combine_args arg_res ctxt_argsl
+	    )
+	    el
+	      (mk_result [] [] avoid)
+	in
+	let results =
+	  List.map 
+	    (build_entry_lc_from_case_term funname make_discr []  brl case_resl.to_avoid) 
+	    case_resl.result 
+	in 
+	{ 
+	  result = List.concat (List.map (fun r -> r.result) results);
+	  to_avoid = 
+	    List.fold_left (fun acc r -> list_union acc r.to_avoid) [] results
+	} 
+
+and build_entry_lc_from_case_term funname make_discr patterns_to_prevent brl avoid
+    matched_expr =
+  match brl with
+    | [] -> (* computed_branches  *) {result = [];to_avoid = avoid}
+    | br::brl' ->
+	let _,idl,patl,return = alpha_br avoid br in
+	let new_avoid  = idl@avoid in 
+(* 	let e_ctxt,el = (matched_expr.context,matched_expr.value) in *)
+(*  	if  (List.length patl) <> (List.length el) *)
+(* 	then error ("Pattern matching on product: not yet implemented"); *)
+	let not_those_patterns : (identifier list -> rawconstr -> rawconstr) list = 
+	  List.map 
+	    (fun pat -> 
+	       fun avoid pat'_as_term -> 
+		 let renamed_pat,_,_ = alpha_pat avoid pat in
+		 let pat_ids = get_pattern_id renamed_pat  in 
+		 List.fold_right 
+		   (fun id acc -> mkRProd (Name id,mkRHole (),acc))
+		   pat_ids
+		   (raw_make_neq pat'_as_term (pattern_to_term renamed_pat))
+	    )
+	    patl
+	in
+	let unify_with_those_patterns : (cases_pattern -> bool*bool) list =
+	  List.map 
+	    (fun pat pat' -> are_unifiable pat pat',eq_cases_pattern pat pat') 
+	    patl
+	in
+	let brl'_res =
+	  build_entry_lc_from_case_term
+	    funname
+	    make_discr
+	    ((unify_with_those_patterns,not_those_patterns)::patterns_to_prevent)
+	    brl'
+	    avoid
+	    matched_expr
+	in
+(* 	let ids = List.map (fun id -> Prod (Name id),mkRHole ()) idl in *)
+      	let those_pattern_preconds =
+(	  List.flatten
+	    (
+	    List.map2
+	      (fun pat e ->
+		 let this_pat_ids = ids_of_pat pat in 
+		 let pat_as_term = pattern_to_term pat in
+		 List.fold_right 
+		   (fun id  acc -> 
+		      if Idset.mem id this_pat_ids 
+		      then (Prod (Name id),mkRHole ())::acc
+		      else acc
+			
+		   )
+		   idl
+		   [(Prod Anonymous,raw_make_eq pat_as_term e)]
+	      )
+	      patl
+	      matched_expr.value
+	  )
+)
+	  @
+	    (if List.exists (function (unifl,neql) ->
+			       let (unif,eqs) = 
+				 List.split (List.map2 (fun x y -> x y) unifl patl)
+			       in
+			       List.for_all (fun x -> x) unif) patterns_to_prevent
+	     then 
+	       let i = List.length patterns_to_prevent in 
+	       [(Prod Anonymous,make_discr (List.map pattern_to_term patl) i  )]
+	     else 
+	       []
+	    )
+	in
+	let return_res = build_entry_lc funname new_avoid return in
+	let this_branch_res =
+	  List.map
+	    (fun res  ->
+	       { context = 
+		   matched_expr.context@
+(* 		     ids@ *)
+		     those_pattern_preconds@res.context ;
+		 value = res.value}
+	    )
+	    return_res.result
+	in
+	{ brl'_res with result = this_branch_res@brl'_res.result }
+	  
+	  
+let is_res id = 
+  try
+    String.sub (string_of_id id) 0 3 = "res"
+  with Invalid_argument _ -> false 
+
+(* rebuild the raw constructors expression. 
+   eliminates some meaningless equalities, applies some rewrites......
+*)
+let rec rebuild_cons nb_args relname args crossed_types depth rt = 
+  match rt with 
+    | RProd(_,n,t,b) -> 
+	let not_free_in_t id = not (is_free_in id t) in 
+	let new_crossed_types = t::crossed_types in 
+	begin
+	  match t with 
+	    | RApp(_,(RVar(_,res_id) as res_rt),args') when is_res res_id ->
+		begin
+		  match args' with 
+		    | (RVar(_,this_relname))::args' -> 
+			let new_b,id_to_exclude =  
+			  rebuild_cons 
+			    nb_args relname
+			    args new_crossed_types
+			    (depth + 1) b
+			in 
+			let new_t = 
+			  mkRApp(mkRVar(mk_rel_id this_relname),args'@[res_rt]) 
+			in mkRProd(n,new_t,new_b),
+			Idset.filter not_free_in_t id_to_exclude
+		    | _ -> (* the first args is the name of the function! *)
+			assert false 
+		end
+	    | RApp(_,RRef(_,eq_as_ref),[_;RVar(_,id);rt]) 
+		when  eq_as_ref = Lazy.force Coqlib.coq_eq_ref  
+		  -> 
+		let is_in_b = is_free_in id b in
+		let _keep_eq = 
+		  not (List.exists (is_free_in id) args) || is_in_b  || 
+		    List.exists (is_free_in id) crossed_types 
+		in 
+		let new_args = List.map (replace_var_by_term id rt) args in 
+		let subst_b = 
+		  if is_in_b then b else  replace_var_by_term id rt b 
+		in 
+		let new_b,id_to_exclude =  
+		  rebuild_cons 
+		    nb_args relname
+		    new_args new_crossed_types
+		    (depth + 1) subst_b
+		in 
+		mkRProd(n,t,new_b),id_to_exclude
+(*  		if keep_eq then *)
+(* 		  mkRProd(n,t,new_b),id_to_exclude *)
+(* 		else new_b, Idset.add id id_to_exclude *)
+	    | _ -> 
+		let new_b,id_to_exclude =  
+		  rebuild_cons 
+		    nb_args relname
+		    args new_crossed_types
+		    (depth + 1) b
+		in 
+		match n with
+		  | Name id when Idset.mem id id_to_exclude && depth >= nb_args ->
+		      new_b,Idset.remove id 
+			(Idset.filter not_free_in_t id_to_exclude)
+		  | _ -> mkRProd(n,t,new_b),Idset.filter not_free_in_t id_to_exclude
+	end
+    | RLambda(_,n,t,b) ->
+	begin
+(* 	  let not_free_in_t id = not (is_free_in id t) in  *)
+(* 	  let new_crossed_types = t :: crossed_types in  *)
+(* 	  let new_b,id_to_exclude = rebuild_cons relname args new_crossed_types b in *)
+(* 	  match n with *)
+(* 	    | Name id when Idset.mem id id_to_exclude -> *)
+(* 		new_b, *)
+(* 		Idset.remove id (Idset.filter not_free_in_t id_to_exclude) *)
+(* 	    | _ ->  *)
+(* 		RProd(dummy_loc,n,t,new_b),Idset.filter not_free_in_t id_to_exclude *)
+	  let not_free_in_t id = not (is_free_in id t) in
+	  let new_crossed_types = t :: crossed_types in
+(* 	  let new_b,id_to_exclude = rebuild_cons relname (args new_crossed_types b in *)
+	  match n with
+	    | Name id ->
+		let new_b,id_to_exclude = 
+		  rebuild_cons 
+		    nb_args relname
+		    (args@[mkRVar id])new_crossed_types
+		    (depth + 1 ) b 
+		in
+		if Idset.mem id id_to_exclude && depth >= nb_args
+		then 
+		  new_b, Idset.remove id (Idset.filter not_free_in_t id_to_exclude)
+		else
+		  RProd(dummy_loc,n,t,new_b),Idset.filter not_free_in_t id_to_exclude
+	    | _ -> anomaly "Should not have an anonymous function here" 
+		(* We have renamed all the anonymous functions during alpha_renaming phase *)
+	  
+	end
+    | RLetIn(_,n,t,b) -> 
+	begin
+	  let not_free_in_t id = not (is_free_in id t) in 
+	  let new_b,id_to_exclude = 
+	    rebuild_cons 
+	      nb_args relname
+	      args (t::crossed_types)
+	      (depth + 1 ) b in
+	  match n with 
+	    | Name id when Idset.mem id id_to_exclude && depth >= nb_args  -> 
+		new_b,Idset.remove id (Idset.filter not_free_in_t id_to_exclude)
+	    | _ -> RLetIn(dummy_loc,n,t,new_b),
+		Idset.filter not_free_in_t id_to_exclude
+	end
+    | RLetTuple(_,nal,(na,rto),t,b) -> 
+	assert (rto=None);
+	begin
+	  let not_free_in_t id = not (is_free_in id t) in 
+	  let new_t,id_to_exclude' = 
+	    rebuild_cons 
+	      nb_args
+	      relname 
+	      args (crossed_types) 
+	      depth t 
+	  in
+	  let new_b,id_to_exclude = 
+	    rebuild_cons 
+	      nb_args relname
+	      args (t::crossed_types) 
+	      (depth + 1) b 
+	  in
+(* 	  match n with  *)
+(* 	    | Name id when Idset.mem id id_to_exclude ->  *)
+(* 		new_b,Idset.remove id (Idset.filter not_free_in_t id_to_exclude) *)
+(* 	    | _ -> *)
+	  RLetTuple(dummy_loc,nal,(na,None),t,new_b),
+		Idset.filter not_free_in_t (Idset.union id_to_exclude id_to_exclude')
+
+	end
+
+    | _ -> mkRApp(mkRVar  relname,args@[rt]),Idset.empty
+
+
+let rebuild_cons nb_args relname args crossed_types rt = 
+  observennl  (str "rebuild_cons : rt := "++ pr_rawconstr rt ++ 
+		 str "nb_args := " ++ str (string_of_int nb_args));
+  let res = 
+    rebuild_cons nb_args relname args crossed_types 0 rt 
+  in
+  observe (str " leads to "++ pr_rawconstr (fst res));
+  res
+
+let rec compute_cst_params relnames params = function 
+  | RRef _ | RVar _ | REvar _ | RPatVar _ -> params
+  | RApp(_,RVar(_,relname'),rtl) when Idset.mem relname' relnames ->
+      compute_cst_params_from_app [] (params,rtl)
+  | RApp(_,f,args) -> 
+      List.fold_left (compute_cst_params relnames) params (f::args)
+  | RLambda(_,_,t,b) | RProd(_,_,t,b) | RLetIn(_,_,t,b) | RLetTuple(_,_,_,t,b) -> 
+      let t_params = compute_cst_params relnames params t in 
+      compute_cst_params relnames t_params b
+  | RCases _ -> params  (* If there is still cases at this point they can only be 
+			discriminitation ones *)
+  | RSort _ -> params
+  | RHole _ -> params
+  | RIf _ | RRec _ | RCast _ | RDynamic _  ->
+      raise (UserError("compute_cst_params", str "Not handled case"))
+and compute_cst_params_from_app acc (params,rtl) = 
+  match params,rtl with 
+    | _::_,[] -> assert false (* the rel has at least nargs + 1 arguments ! *)
+    | ((Name id,_,is_defined) as param)::params',(RVar(_,id'))::rtl' 
+	when id_ord id id' == 0 && not is_defined -> 
+	compute_cst_params_from_app (param::acc) (params',rtl')
+    | _  -> List.rev acc 
+   
+let compute_params_name relnames (args : (Names.name * Rawterm.rawconstr * bool) list array) csts =  
+  let rels_params = 
+    Array.mapi 
+      (fun i args -> 
+	 List.fold_left 
+	   (fun params (_,cst) -> compute_cst_params relnames params cst) 
+	   args
+	   csts.(i)
+      )
+      args
+  in 
+  let l = ref [] in 
+  let _ = 
+    try 
+      list_iter_i
+	(fun i ((n,nt,is_defined) as param) -> 
+	   if array_for_all 
+	     (fun l -> 
+		let (n',nt',is_defined') = List.nth l i in 
+		n = n' && Topconstr.eq_rawconstr nt nt' && is_defined = is_defined')
+	     rels_params
+	   then 
+	     l := param::!l
+	) 
+	rels_params.(0)
+    with _ -> 
+      ()
+  in 
+  List.rev !l
+
+(*      (Topconstr.CProdN
+	 (dummy_loc,
+	  [[(dummy_loc,Anonymous)],returned_types.(i)],
+	  Topconstr.CSort(dummy_loc, RProp Null )
+	 )
+      )
+*)
+let rec rebuild_return_type rt = 
+  match rt with 
+    | Topconstr.CProdN(loc,n,t') -> 
+	Topconstr.CProdN(loc,n,rebuild_return_type t') 
+    | Topconstr.CArrow(loc,t,t') -> 
+	Topconstr.CArrow(loc,t,rebuild_return_type t')
+    | Topconstr.CLetIn(loc,na,t,t') -> 
+	Topconstr.CLetIn(loc,na,t,rebuild_return_type t') 
+    | _ -> Topconstr.CArrow(dummy_loc,rt,Topconstr.CSort(dummy_loc, RProp Null))
+
+
+let build_inductive parametrize funnames (funsargs: (Names.name * rawconstr * bool) list list)  returned_types (rtl:rawconstr list) =
+(*   Pp.msgnl (prlist_with_sep fnl Printer.pr_rawconstr rtl); *)
+  let funnames_as_set = List.fold_right Idset.add funnames Idset.empty in
+  let funnames = Array.of_list funnames in  
+  let funsargs = Array.of_list funsargs in 
+  let returned_types = Array.of_list returned_types in
+  let rtl_alpha = List.map (function rt ->  (alpha_rt [] rt) ) rtl in
+  let rta = Array.of_list rtl_alpha in
+  let relnames = Array.map mk_rel_id funnames in
+  let relnames_as_set = Array.fold_right Idset.add relnames Idset.empty in 
+  let resa = Array.map (build_entry_lc funnames_as_set []) rta in 
+  let constr i res = 
+    List.map 
+      (function result (* (args',concl') *) -> 
+	 let rt = compose_raw_context result.context result.value in 
+	 let nb_args = List.length funsargs.(i) in 
+(* 	 Pp.msgnl (str "raw constr " ++ pr_rawconstr rt); *)
+	 fst (
+	   rebuild_cons nb_args relnames.(i)
+(* 	     (List.map  *)
+(* 		(function  *)
+(* 		     (Anonymous,_,_) -> mkRVar(fresh_id res.to_avoid "x__")  *)
+(* 		   | Name id, _,_ -> mkRVar id *)
+(* 		) *)
+(* 		funsargs.(i) *)
+(* 	     )  *)
+	     []
+	     []
+	     rt 
+	 )
+      ) 
+      res.result 
+  in 
+  let next_constructor_id = ref (-1) in 
+  let mk_constructor_id i = 
+    incr next_constructor_id;
+    id_of_string ((string_of_id (mk_rel_id funnames.(i)))^"_"^(string_of_int !next_constructor_id))
+  in
+  let rel_constructors i rt : (identifier*rawconstr) list = 
+    List.map (fun constr -> (mk_constructor_id i),constr) (constr i rt)
+  in
+  let rel_constructors = Array.mapi rel_constructors resa in
+  let rels_params = 
+    if parametrize 
+    then
+      compute_params_name relnames_as_set funsargs  rel_constructors 
+    else []
+  in
+  let nrel_params = List.length rels_params in
+  let rel_constructors = 
+    Array.map (List.map 
+    (fun (id,rt) -> (id,snd (chop_rprod_n nrel_params rt))))
+    rel_constructors
+  in
+  let rel_arity i funargs = 
+    let rel_first_args :(Names.name * Rawterm.rawconstr * bool ) list  = 
+      (snd (list_chop nrel_params funargs))
+    in 
+    List.fold_right
+      (fun (n,t,is_defined) acc -> 
+	 if is_defined
+	 then 
+	   Topconstr.CLetIn(dummy_loc,(dummy_loc, n),Constrextern.extern_rawconstr Idset.empty t,
+			    acc)
+	 else
+	   Topconstr.CProdN
+	   (dummy_loc,
+	    [[(dummy_loc,n)],Constrextern.extern_rawconstr Idset.empty t],
+	    acc
+	   )
+      )
+      rel_first_args
+      (rebuild_return_type returned_types.(i))
+(*       (Topconstr.CProdN *)
+(* 	 (dummy_loc, *)
+(* 	  [[(dummy_loc,Anonymous)],returned_types.(i)], *)
+(* 	  Topconstr.CSort(dummy_loc, RProp Null ) *)
+(* 	 ) *)
+(* ) *)
+  in
+  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) -> 
+	 if is_defined 
+	 then
+	   Topconstr.LocalRawDef((dummy_loc,n), Constrextern.extern_rawconstr Idset.empty t)
+	 else
+	 Topconstr.LocalRawAssum 
+	   ([(dummy_loc,n)], Constrextern.extern_rawconstr Idset.empty t)
+      )
+      rels_params
+  in 
+  let ext_rels_constructors = 
+    Array.map (List.map 
+      (fun (id,t) -> 
+	 false,((dummy_loc,id),Constrextern.extern_rawtype Idset.empty t)
+      ))
+      rel_constructors
+  in
+  let rel_ind i ext_rel_constructors = 
+    (dummy_loc,relnames.(i)),
+    None,
+    rel_params,
+    rel_arities.(i),
+    ext_rel_constructors
+  in
+  let ext_rel_constructors = (Array.mapi rel_ind ext_rels_constructors) in 
+  let rel_inds = Array.to_list ext_rel_constructors in 
+  let _ = 
+    observe (
+      str "Inductive" ++ spc () ++
+	prlist_with_sep 
+	(fun () -> fnl ()++spc () ++ str "with" ++ spc ()) 
+	(function ((_,id),_,params,ar,constr) -> 
+	   Ppconstr.pr_id id ++ spc () ++ 
+	     Ppconstr.pr_binders params ++ spc () ++
+	     str ":" ++ spc () ++ 
+	     Ppconstr.pr_lconstr_expr ar ++ spc () ++ 
+	     prlist_with_sep 
+	     (fun _ -> fnl () ++ spc () ++ str "|" ++ spc ())
+	     (function (_,((_,id),t)) -> 
+		Ppconstr.pr_id id ++ spc () ++ str ":" ++ spc () ++
+		  Ppconstr.pr_lconstr_expr t)
+	     constr
+	)
+	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;
+  try 
+    Options.silently (Command.build_mutual rel_inds) true;
+    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) -> 
+	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))
+    | 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;
+	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))
+
+
diff --git a/contrib/funind/rawterm_to_relation.mli b/contrib/funind/rawterm_to_relation.mli
new file mode 100644
index 00000000..0cda56df
--- /dev/null
+++ b/contrib/funind/rawterm_to_relation.mli
@@ -0,0 +1,16 @@
+
+(* val new_build_entry_lc :  *)
+(*   Names.identifier list ->  *)
+(*   (Names.name*Rawterm.rawconstr) list list ->  *)
+(*   Topconstr.constr_expr list ->  *)
+(*   Rawterm.rawconstr list ->  *)
+(*   unit  *)
+
+val build_inductive :
+  bool -> 
+  Names.identifier list ->
+  (Names.name*Rawterm.rawconstr*bool) list list ->
+  Topconstr.constr_expr list ->
+  Rawterm.rawconstr list ->
+  unit
+
diff --git a/contrib/funind/rawtermops.ml b/contrib/funind/rawtermops.ml
new file mode 100644
index 00000000..99bf2bf1
--- /dev/null
+++ b/contrib/funind/rawtermops.ml
@@ -0,0 +1,525 @@
+open Pp 
+open Rawterm
+open Util
+open Names
+(* Ocaml 3.06 Map.S does not handle is_empty *)
+let idmap_is_empty m = m = Idmap.empty
+
+(* 
+   Some basic functions to rebuild rawconstr
+   In each of them the location is Util.dummy_loc
+*)
+let mkRRef ref = RRef(dummy_loc,ref)
+let mkRVar id = RVar(dummy_loc,id)
+let mkRApp(rt,rtl) = RApp(dummy_loc,rt,rtl)
+let mkRLambda(n,t,b) = RLambda(dummy_loc,n,t,b)
+let mkRProd(n,t,b) = RProd(dummy_loc,n,t,b)
+let mkRLetIn(n,t,b) = RLetIn(dummy_loc,n,t,b)
+let mkRCases(rto,l,brl) = RCases(dummy_loc,rto,l,brl)
+let mkRSort s = RSort(dummy_loc,s)
+let mkRHole () = RHole(dummy_loc,Evd.BinderType Anonymous)
+
+
+(*
+  Some basic functions to decompose rawconstrs
+  These are analogous to the ones constrs
+*)
+let raw_decompose_prod = 
+  let rec raw_decompose_prod args = function 
+  | RProd(_,n,t,b) -> 
+      raw_decompose_prod ((n,t)::args) b 
+  | rt -> args,rt
+  in
+  raw_decompose_prod []
+
+let raw_compose_prod = 
+  List.fold_left (fun b (n,t) -> mkRProd(n,t,b))
+
+let raw_decompose_app = 
+  let rec decompose_rapp acc rt =
+(*     msgnl (str "raw_decompose_app on : "++ Printer.pr_rawconstr rt); *)
+    match rt with 
+    | RApp(_,rt,rtl) -> 
+	decompose_rapp (List.fold_left (fun y x -> x::y) acc rtl) rt
+    | rt -> rt,List.rev acc
+  in
+  decompose_rapp [] 
+
+
+
+
+(* [raw_make_eq t1 t2] build the rawconstr corresponding to [t2 = t1] *) 
+let raw_make_eq t1 t2  = 
+  mkRApp(mkRRef (Lazy.force Coqlib.coq_eq_ref),[mkRHole ();t2;t1])
+
+(* [raw_make_neq t1 t2] build the rawconstr corresponding to [t1 <> t2] *) 
+let raw_make_neq t1 t2 = 
+  mkRApp(mkRRef (Lazy.force Coqlib.coq_not_ref),[raw_make_eq t1 t2])
+
+(* [raw_make_or P1 P2] build the rawconstr corresponding to [P1 \/ P2] *) 
+let raw_make_or t1 t2 = mkRApp (mkRRef(Lazy.force Coqlib.coq_or_ref),[t1;t2])
+
+(* [raw_make_or_list [P1;...;Pn]] build the rawconstr corresponding 
+   to [P1 \/ ( .... \/ Pn)] 
+*) 
+let rec raw_make_or_list = function  
+  | [] -> raise (Invalid_argument "mk_or")
+  | [e] -> e
+  | e::l -> raw_make_or e (raw_make_or_list l)
+
+  
+
+
+let change_vars = 
+  let rec change_vars mapping rt = 
+    match rt with 
+      | RRef _ -> rt 
+      | RVar(loc,id) ->  
+	  let new_id = 
+	    try 
+	      Idmap.find id mapping 
+	    with Not_found -> id 
+	  in
+	  RVar(loc,new_id)
+      | REvar _ -> rt 
+      | RPatVar _ -> rt 
+      | RApp(loc,rt',rtl) -> 
+	  RApp(loc,
+	       change_vars mapping rt',
+	       List.map (change_vars mapping) rtl
+	      )
+      | RLambda(_,Name id,_,_) when Idmap.mem id mapping -> rt
+      | RLambda(loc,name,t,b) -> 
+	  RLambda(loc,
+		  name,
+		  change_vars mapping t,
+		  change_vars mapping b
+		 )
+      | RProd(_,Name id,_,_) when Idmap.mem id mapping -> rt
+      | RProd(loc,name,t,b) -> 
+	  RProd(loc,
+		  name,
+		  change_vars mapping t,
+		  change_vars mapping b
+		 )
+      | RLetIn(_,Name id,_,_) when Idmap.mem id mapping -> rt
+      | RLetIn(loc,name,def,b) -> 
+	  RLetIn(loc,
+		 name,
+		 change_vars mapping def,
+		 change_vars mapping b
+		)
+      | RLetTuple(_,nal,(na,_),_,_) when List.exists (function Name id -> Idmap.mem id mapping | _ -> false) (na::nal) -> rt 
+      | RLetTuple(loc,nal,(na,rto),b,e) -> 
+	  RLetTuple(loc,
+		    nal, 
+		    (na, option_app (change_vars mapping) rto), 
+		    change_vars mapping b,
+		    change_vars mapping e
+		   )
+      | RCases(loc,infos,el,brl) -> 
+	  RCases(loc,
+		 infos,
+		 List.map (fun (e,x) -> (change_vars mapping e,x)) el, 
+		 List.map (change_vars_br mapping) brl
+		)
+      | RIf _ -> error "Not handled RIf"
+      | RRec _ -> error "Not handled RRec"
+      | RSort _ -> rt 
+      | RHole _ -> rt 
+      | RCast(loc,b,k,t) -> 
+	  RCast(loc,change_vars mapping b,k,change_vars mapping t)
+      | RDynamic _ -> error "Not handled RDynamic"
+  and change_vars_br mapping ((loc,idl,patl,res) as br) = 
+    let new_mapping = List.fold_right Idmap.remove idl mapping in 
+    if idmap_is_empty new_mapping 
+    then br 
+    else (loc,idl,patl,change_vars new_mapping res)
+  in
+  change_vars 
+
+
+
+let rec alpha_pat excluded pat = 
+  match pat with 
+    | PatVar(loc,Anonymous) -> 
+	let new_id = Indfun_common.fresh_id excluded "_x" in 
+	PatVar(loc,Name new_id),(new_id::excluded),Idmap.empty
+    | PatVar(loc,Name id) -> 
+	if List.mem id excluded 
+	then 
+	  let new_id = Nameops.next_ident_away id excluded in 
+	  PatVar(loc,Name new_id),(new_id::excluded),
+	(Idmap.add id new_id Idmap.empty)
+	else pat,excluded,Idmap.empty
+    | PatCstr(loc,constr,patl,na) -> 
+	let new_na,new_excluded,map = 
+	  match na with 
+	    | Name id when List.mem id excluded -> 
+		let new_id = Nameops.next_ident_away id excluded in 
+		Name new_id,new_id::excluded, Idmap.add id new_id Idmap.empty
+	    | _ -> na,excluded,Idmap.empty
+	in 
+	let new_patl,new_excluded,new_map = 
+	  List.fold_left 
+	    (fun (patl,excluded,map) pat -> 
+	       let new_pat,new_excluded,new_map = alpha_pat excluded pat in 
+	       (new_pat::patl,new_excluded,Idmap.fold Idmap.add new_map map)
+	    )
+	    ([],new_excluded,map)
+	    patl
+	in 
+	PatCstr(loc,constr,List.rev new_patl,new_na),new_excluded,new_map
+
+let alpha_patl excluded patl  = 
+  let patl,new_excluded,map = 
+    List.fold_left 
+      (fun (patl,excluded,map) pat -> 
+	 let new_pat,new_excluded,new_map = alpha_pat excluded pat in 
+	 new_pat::patl,new_excluded,(Idmap.fold Idmap.add new_map map)
+      )
+      ([],excluded,Idmap.empty)
+      patl
+  in 
+  (List.rev patl,new_excluded,map)
+
+
+
+  
+let raw_get_pattern_id pat acc = 
+  let rec get_pattern_id pat = 
+    match pat with 
+      | PatVar(loc,Anonymous) -> assert false
+      | PatVar(loc,Name id) -> 
+	  [id]
+      | PatCstr(loc,constr,patternl,_) -> 
+	  List.fold_right 
+	  (fun pat idl -> 
+	     let idl' = get_pattern_id pat in 
+	     idl'@idl
+	  )
+	    patternl 
+	    []
+  in
+  (get_pattern_id pat)@acc
+
+let get_pattern_id pat = raw_get_pattern_id pat []
+	      
+let rec alpha_rt excluded rt = 
+  let new_rt = 
+    match rt with   
+      | RRef _ | RVar _ | REvar _ | RPatVar _ -> rt
+      | RLambda(loc,Anonymous,t,b) -> 
+	  let new_id = Nameops.next_ident_away (id_of_string "_x") excluded in 
+	  let new_excluded = new_id :: excluded in 
+	  let new_t = alpha_rt new_excluded t in 
+	  let new_b = alpha_rt new_excluded b in 
+	  RLambda(loc,Name new_id,new_t,new_b)
+      | RProd(loc,Anonymous,t,b) -> 
+	let new_t = alpha_rt excluded t in 
+	let new_b = alpha_rt excluded b in 
+	RProd(loc,Anonymous,new_t,new_b)
+    | RLetIn(loc,Anonymous,t,b) -> 
+	let new_t = alpha_rt excluded t in 
+	let new_b = alpha_rt excluded b in 
+	RLetIn(loc,Anonymous,new_t,new_b)
+    | RLambda(loc,Name id,t,b) -> 
+	let new_id = Nameops.next_ident_away id excluded in 
+	let t,b = 
+	  if new_id = id 
+	  then t,b
+	  else 
+	    let replace = change_vars (Idmap.add id new_id Idmap.empty) in 
+	    (replace t,replace b)
+	in
+	let new_excluded = new_id::excluded in 
+	let new_t = alpha_rt new_excluded t in 
+	let new_b = alpha_rt new_excluded b in 
+	RLambda(loc,Name new_id,new_t,new_b)
+    | RProd(loc,Name id,t,b) -> 
+	let new_id = Nameops.next_ident_away id excluded in 
+	let new_excluded = new_id::excluded in 
+	let t,b = 
+	  if new_id = id 
+	  then t,b
+	  else 
+	    let replace = change_vars (Idmap.add id new_id Idmap.empty) in 
+	    (replace t,replace b)
+	in
+	let new_t = alpha_rt new_excluded t in 
+	let new_b = alpha_rt new_excluded b in 
+	RProd(loc,Name new_id,new_t,new_b)
+    | RLetIn(loc,Name id,t,b) -> 
+	let new_id = Nameops.next_ident_away id excluded in 
+	let t,b = 
+	  if new_id = id 
+	  then t,b
+	  else 
+	    let replace = change_vars (Idmap.add id new_id Idmap.empty) in 
+	    (replace t,replace b)
+	in
+	let new_excluded = new_id::excluded in 
+	let new_t = alpha_rt new_excluded t in 
+	let new_b = alpha_rt new_excluded b in 
+	RLetIn(loc,Name new_id,new_t,new_b)
+
+
+    | RLetTuple(loc,nal,(na,rto),t,b) -> 
+	let rev_new_nal,new_excluded,mapping = 
+	  List.fold_left 
+	    (fun (nal,excluded,mapping) na -> 
+	       match na with 
+		 | Anonymous -> (na::nal,excluded,mapping)
+		 | Name id ->  
+		     let new_id = Nameops.next_ident_away id excluded in 
+		     if new_id = id 
+		     then 
+		       na::nal,id::excluded,mapping 
+		     else 
+		       (Name new_id)::nal,id::excluded,(Idmap.add id new_id mapping)
+	    )
+	    ([],excluded,Idmap.empty)
+	    nal
+	in
+	let new_nal = List.rev rev_new_nal in 
+	let new_rto,new_t,new_b = 
+	  if idmap_is_empty mapping
+	  then rto,t,b
+	  else let replace = change_vars mapping in 
+	  (option_app replace rto,replace t,replace b)
+	in
+	let new_t = alpha_rt new_excluded new_t in 
+	let new_b = alpha_rt new_excluded new_b in 
+	let new_rto = option_app (alpha_rt new_excluded) new_rto  in
+	RLetTuple(loc,new_nal,(na,new_rto),new_t,new_b)
+    | RCases(loc,infos,el,brl) -> 
+	let new_el = 
+	  List.map (function (rt,i) -> alpha_rt excluded rt, i) el 
+	in 
+	RCases(loc,infos,new_el,List.map (alpha_br excluded) brl) 
+    | RIf _ -> error "Not handled RIf"
+    | RRec _ -> error "Not handled RRec"
+    | RSort _ -> rt 
+    | RHole _ -> rt 
+    | RCast (loc,b,k,t) -> 
+	RCast(loc,alpha_rt excluded b,k,alpha_rt excluded t)
+    | RDynamic _ -> error "Not handled RDynamic"
+    | RApp(loc,f,args) -> 
+	RApp(loc,
+	     alpha_rt excluded f,
+	     List.map (alpha_rt excluded) args
+	    )
+  in 
+  if Tacinterp.get_debug () <> Tactic_debug.DebugOff  && 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) = 
+  let new_patl,new_excluded,mapping = alpha_patl excluded patl in 
+  let new_ids = List.fold_right raw_get_pattern_id new_patl [] in 
+  let new_excluded = new_ids@excluded in 
+  let renamed_res = change_vars mapping res in 
+  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]
+*)
+let is_free_in id =
+  let rec is_free_in = function
+    | RRef _ ->  false
+    | RVar(_,id') -> id_ord id' id == 0
+    | REvar _ -> false
+    | RPatVar _ -> false
+    | RApp(_,rt,rtl) -> List.exists is_free_in (rt::rtl)
+    | RLambda(_,n,t,b) | RProd(_,n,t,b) | RLetIn(_,n,t,b) ->
+	let check_in_b =
+	  match n with
+	    | Name id' -> id_ord id' id <> 0
+	    | _ -> true
+	in
+	is_free_in t || (check_in_b && is_free_in b)
+    | RCases(_,_,el,brl) ->
+	(List.exists (fun (e,_) -> is_free_in e) el) ||
+	  List.exists is_free_in_br brl
+
+    | RLetTuple(_,nal,_,b,t) -> 
+	let check_in_nal = 
+	  not (List.exists (function Name id' -> id'= id | _ -> false) nal) 
+	in 
+	is_free_in t  || (check_in_nal && is_free_in b)
+	  
+    | RIf(_,cond,_,br1,br2) ->
+	is_free_in cond || is_free_in br1 || is_free_in br2
+    | RRec _ -> raise (UserError("",str "Not handled RRec"))
+    | RSort _ -> false
+    | RHole _ -> false
+    | RCast (_,b,_,t) -> is_free_in b || is_free_in t
+    | RDynamic _ -> raise (UserError("",str "Not handled RDynamic"))
+  and is_free_in_br (_,ids,_,rt) =
+    (not (List.mem id ids)) && is_free_in rt
+  in
+  is_free_in
+      
+
+
+let rec pattern_to_term  = function 
+  | PatVar(loc,Anonymous) -> assert false
+  | PatVar(loc,Name id) -> 
+	mkRVar id
+  | PatCstr(loc,constr,patternl,_) -> 
+      let cst_narg = 
+	Inductiveops.mis_constructor_nargs_env
+	  (Global.env ())
+	  constr
+      in
+      let implicit_args =  
+	Array.to_list 
+	  (Array.init 
+	     (cst_narg - List.length patternl)
+	     (fun _ -> mkRHole ())
+	  )
+      in
+      let patl_as_term = 
+	List.map pattern_to_term patternl
+      in
+      mkRApp(mkRRef(Libnames.ConstructRef constr),
+	     implicit_args@patl_as_term
+	    )
+
+let replace_var_by_term x_id term = 
+  let rec replace_var_by_pattern rt = 
+    match rt with 
+      | RRef _ -> rt 
+      | RVar(_,id) when id_ord id x_id == 0 -> term
+      | RVar _ -> rt 
+      | REvar _ -> rt 
+      | RPatVar _ -> rt 
+      | RApp(loc,rt',rtl) -> 
+	  RApp(loc,
+	       replace_var_by_pattern rt',
+	       List.map replace_var_by_pattern rtl
+	      )
+      | RLambda(_,Name id,_,_) when id_ord id x_id == 0 -> rt
+      | RLambda(loc,name,t,b) -> 
+	  RLambda(loc,
+		  name,
+		  replace_var_by_pattern t,
+		  replace_var_by_pattern b
+		 )
+      | RProd(_,Name id,_,_) when id_ord id x_id == 0 -> rt
+      | RProd(loc,name,t,b) -> 
+	  RProd(loc,
+		  name,
+		  replace_var_by_pattern t,
+		  replace_var_by_pattern b
+		 )
+      | RLetIn(_,Name id,_,_) when id_ord id x_id == 0 -> rt
+      | RLetIn(loc,name,def,b) -> 
+	  RLetIn(loc,
+		 name,
+		 replace_var_by_pattern def,
+		 replace_var_by_pattern b
+		)
+      | RLetTuple(_,nal,_,_,_) 
+	  when List.exists (function Name id -> id = x_id | _ -> false) nal  ->  
+	  rt
+      | RLetTuple(loc,nal,(na,rto),def,b) -> 
+	  RLetTuple(loc,
+		    nal,
+		    (na,option_app replace_var_by_pattern rto),
+		    replace_var_by_pattern def,
+		    replace_var_by_pattern b
+		   )
+      | RCases(loc,infos,el,brl) -> 
+	  RCases(loc,
+		 infos,
+		 List.map (fun (e,x) -> (replace_var_by_pattern e,x)) el, 
+		 List.map replace_var_by_pattern_br brl
+		)
+      | RIf _ -> raise (UserError("",str "Not handled RIf"))
+      | RRec _ -> raise (UserError("",str "Not handled RRec"))
+      | RSort _ -> rt 
+      | RHole _ -> rt 
+      | RCast(loc,b,k,t) -> 
+	  RCast(loc,replace_var_by_pattern b,k,replace_var_by_pattern t)
+      | RDynamic _ -> raise (UserError("",str "Not handled RDynamic"))
+  and replace_var_by_pattern_br ((loc,idl,patl,res) as br) = 
+    if List.exists (fun id -> id_ord id x_id == 0) idl 
+    then br 
+    else (loc,idl,patl,replace_var_by_pattern res)
+  in
+  replace_var_by_pattern 
+
+
+
+
+(* checking unifiability of patterns *) 
+exception NotUnifiable  
+
+let rec are_unifiable_aux  = function 
+  | [] -> () 
+  | eq::eqs -> 
+      match eq with 
+	 | PatVar _,_ | _,PatVar _ -> are_unifiable_aux eqs 
+	 | PatCstr(_,constructor1,cpl1,_),PatCstr(_,constructor2,cpl2,_) -> 
+	     if constructor2 <> constructor1 
+	     then raise NotUnifiable
+	     else 
+	       let eqs' = 
+ 		 try  ((List.combine cpl1 cpl2)@eqs)
+		 with _ -> anomaly "are_unifiable_aux" 
+	       in
+	       are_unifiable_aux eqs'
+		 
+let are_unifiable pat1 pat2 = 
+  try 
+    are_unifiable_aux [pat1,pat2];
+    true
+  with NotUnifiable -> false
+
+
+let rec eq_cases_pattern_aux  = function 
+  | [] -> () 
+  | eq::eqs -> 
+      match eq with 
+	 | PatVar _,PatVar _ -> eq_cases_pattern_aux eqs 
+	 | PatCstr(_,constructor1,cpl1,_),PatCstr(_,constructor2,cpl2,_) -> 
+	     if constructor2 <> constructor1 
+	     then raise NotUnifiable
+	     else 
+	       let eqs' = 
+ 		 try  ((List.combine cpl1 cpl2)@eqs)
+		 with _ -> anomaly "eq_cases_pattern_aux" 
+	       in
+	       eq_cases_pattern_aux eqs'
+	 | _ -> raise NotUnifiable
+
+let eq_cases_pattern pat1 pat2 = 
+  try
+    eq_cases_pattern_aux [pat1,pat2];
+    true
+  with NotUnifiable -> false
+
+
+
+let ids_of_pat = 
+  let rec ids_of_pat ids = function 
+    | PatVar(_,Anonymous) -> ids 
+    | PatVar(_,Name id) -> Idset.add id ids 
+    | PatCstr(_,_,patl,_) -> List.fold_left ids_of_pat ids patl
+  in
+  ids_of_pat Idset.empty 
+  
diff --git a/contrib/funind/rawtermops.mli b/contrib/funind/rawtermops.mli
new file mode 100644
index 00000000..92df0ec6
--- /dev/null
+++ b/contrib/funind/rawtermops.mli
@@ -0,0 +1,111 @@
+open Rawterm
+
+(* Ocaml 3.06 Map.S does not handle is_empty *)
+val idmap_is_empty : 'a Names.Idmap.t -> bool
+
+
+(* [get_pattern_id pat] returns a list of all the variable appearing in [pat] *)
+val get_pattern_id : cases_pattern -> Names.identifier list
+
+(* [pattern_to_term pat] returns a rawconstr corresponding to [pat]. 
+   [pat] must not contain occurences of anonymous pattern 
+*)
+val pattern_to_term : cases_pattern -> rawconstr 
+
+(* 
+   Some basic functions to rebuild rawconstr
+   In each of them the location is Util.dummy_loc
+*)
+val mkRRef : Libnames.global_reference -> rawconstr
+val mkRVar : Names.identifier -> rawconstr
+val mkRApp  : rawconstr*(rawconstr list) -> rawconstr
+val mkRLambda : Names.name*rawconstr*rawconstr -> rawconstr
+val mkRProd : Names.name*rawconstr*rawconstr -> rawconstr
+val mkRLetIn : Names.name*rawconstr*rawconstr -> rawconstr
+val mkRCases : rawconstr option *
+  (rawconstr * (Names.name * (Util.loc * Names.inductive * Names.name list) option)) list * 
+  (Util.loc * Names.identifier list * cases_pattern list * rawconstr) list -> 
+  rawconstr
+val mkRSort : rawsort -> rawconstr 
+val mkRHole : unit -> rawconstr (* we only build Evd.BinderType Anonymous holes *)
+
+(*
+  Some basic functions to decompose rawconstrs
+  These are analogous to the ones constrs
+*)
+val raw_decompose_prod : rawconstr -> (Names.name*rawconstr) list * rawconstr
+val raw_compose_prod : rawconstr -> (Names.name*rawconstr) list  ->  rawconstr 
+val raw_decompose_app : rawconstr -> rawconstr*(rawconstr list)
+
+
+(* [raw_make_eq t1 t2] build the rawconstr corresponding to [t2 = t1] *) 
+val  raw_make_eq : rawconstr -> rawconstr -> rawconstr
+(* [raw_make_neq t1 t2] build the rawconstr corresponding to [t1 <> t2] *) 
+val  raw_make_neq : rawconstr -> rawconstr -> rawconstr
+(* [raw_make_or P1 P2] build the rawconstr corresponding to [P1 \/ P2] *) 
+val  raw_make_or : rawconstr -> rawconstr -> rawconstr
+
+(* [raw_make_or_list [P1;...;Pn]] build the rawconstr corresponding 
+   to [P1 \/ ( .... \/ Pn)] 
+*) 
+val  raw_make_or_list : rawconstr list -> rawconstr
+
+
+(* alpha_conversion functions *)
+
+
+
+(* Replace the var mapped in the rawconstr/context *)
+val change_vars : Names.identifier Names.Idmap.t -> rawconstr -> rawconstr
+
+
+
+(* [alpha_pat avoid pat] rename all the variables present in [pat] s.t. 
+   the result does not share variables with [avoid]. This function create 
+   a fresh variable for each occurence of the anonymous pattern.
+
+   Also returns a mapping  from old variables to new ones and the concatenation of
+   [avoid] with the variables appearing in the result.
+*)
+  val alpha_pat :
+    Names.Idmap.key list ->
+    Rawterm.cases_pattern ->
+    Rawterm.cases_pattern * Names.Idmap.key list *
+      Names.identifier Names.Idmap.t
+
+(* [alpha_rt avoid rt] alpha convert [rt] s.t. the result repects barendregt 
+   conventions and  does not share bound variables with avoid 
+*)
+val alpha_rt : Names.identifier list -> rawconstr -> rawconstr
+
+(* same as alpha_rt but for case branches *)
+val alpha_br : Names.identifier list ->
+    Util.loc * Names.identifier list * Rawterm.cases_pattern list *
+    Rawterm.rawconstr ->
+    Util.loc * Names.identifier list * Rawterm.cases_pattern list *
+    Rawterm.rawconstr
+
+
+(* Reduction function *) 
+val replace_var_by_term  :     
+  Names.identifier ->
+  Rawterm.rawconstr -> Rawterm.rawconstr -> Rawterm.rawconstr
+
+
+
+(* 
+   [is_free_in id rt] checks if [id] is a free variable in [rt]
+*)
+val is_free_in : Names.identifier -> rawconstr -> bool
+
+
+val are_unifiable : cases_pattern -> cases_pattern -> bool 
+val eq_cases_pattern : cases_pattern -> cases_pattern -> bool
+
+
+
+(* 
+   ids_of_pat : cases_pattern -> Idset.t 
+   returns the set of variables appearing in a pattern 
+*)
+val   ids_of_pat : cases_pattern -> Names.Idset.t 
diff --git a/contrib/funind/tacinv.ml4 b/contrib/funind/tacinv.ml4
index 1500e1ae..c2410d55 100644
--- a/contrib/funind/tacinv.ml4
+++ b/contrib/funind/tacinv.ml4
@@ -46,6 +46,8 @@ let smap_to_list m = Smap.fold (fun c cb l -> (c,cb)::l) m []
 let merge_smap m1 m2 = Smap.fold (fun c cb m -> Smap.add c cb m) m1 m2
 let rec listsuf i l = if i<=0 then l else listsuf (i-1) (List.tl l)
 let rec listpref i l = if i<=0 then [] else List.hd l :: listpref (i-1) (List.tl l)
+let rec split3 l = 
+  List.fold_right (fun (e1,e2,e3) (a,b,c) -> (e1::a),(e2::b),(e3::c)) l ([],[],[])
 
 let mkthesort = mkProp (* would like to put Type here, but with which index? *)
 
@@ -56,9 +58,7 @@ let equality_hyp_string = "_eg_"
 (* bug de refine: on doit ssavoir sur quelle hypothese on se trouve. valeur
    initiale au debut de l'appel a la fonction proofPrinc: 1. *)
 let nthhyp = ref 1
- (*debugging*)
- (* let rewrules = ref [] *)
- (*debugging*)
+
 let debug i = prstr ("DEBUG "^ string_of_int i ^"\n")
 let pr2constr = (fun c1 c2 -> prconstr c1; prstr " <---> "; prconstr c2)
 (* Operations on names *)
@@ -71,21 +71,6 @@ let string_of_name nme = string_of_id (id_of_name nme)
 (* Interpretation of constr's *)
 let constr_of c = Constrintern.interp_constr Evd.empty (Global.env()) c
 
-let rec collect_cases l =
- match l with
-  | [||] -> [||],[],[],[||],[||],[]
-  | arr -> 
-     let (a,c,d,f,e,g)= arr.(0) in
-     let aa,lc,ld,_,_,_ = 
-      collect_cases (Array.sub arr 1 ((Array.length arr)-1)) in
-     Array.append [|a|] aa , (c@lc) , (d@ld) , f , e, g
-
-let rec collect_pred l =
- match l with
-  | [] -> [],[],[]
-  | (e1,e2,e3)::l' -> let a,b,c = collect_pred l' in (e1::a),(e2::b),(e3::c)
-
-
 (*s specific manipulations on constr *)
 let lift1_leqs leq=
  List.map 
@@ -194,29 +179,25 @@ let applFull c typofc =
  let res = mkAppRel c ltyp (List.length ltyp) in
  res
 
-
+(* Take two terms with same structure and return a map of deBruijn from the
+   first to the second. Only DeBruijn should be different between the two
+   terms. *)
 let rec build_rel_map typ type_of_b = 
  match (kind_of_term typ), (kind_of_term type_of_b) with
     Evar _ , Evar _  -> Smap.empty
-  | Rel i, Rel j -> if i=j then Smap.empty 
-    else Smap.add typ type_of_b Smap.empty
+  | Const c1, Const c2  when c1=c2 -> Smap.empty
+  | Ind c1, Ind c2 when c1=c2 -> Smap.empty
+  | Rel i, Rel j when i=j -> Smap.empty
+  | Rel i, Rel j -> Smap.add typ type_of_b Smap.empty
   | Prod (name,c1,c2), Prod (nameb,c1b,c2b) -> 
      let map1 = build_rel_map c1 c1b in
      let map2 = build_rel_map (pop c2) (pop c2b) in
      merge_smap map1 map2
-  | App (f,args), App (fb,argsb) ->
-     (try build_rel_map_list (Array.to_list args) (Array.to_list argsb)
-     with Invalid_argument _ -> 
-      failwith ("Could not generate case annotation. "^ 
-      "Two application with different length"))
-  | Const c1, Const c2 -> if c1=c2 then Smap.empty
-    else failwith ("Could not generate case annotation. "^ 
-    "Two different constants in a case annotation.")
-  | Ind c1, Ind c2 -> if c1=c2 then Smap.empty
-    else failwith ("Could not generate case annotation. "^ 
-    "Two different constants in a case annotation.")
+  | App (f,args), App (fb,argsb) when Array.length args = Array.length argsb ->
+     build_rel_map_list (Array.to_list args) (Array.to_list argsb)
   | _,_ -> failwith ("Could not generate case annotation. "^
     "Incompatibility between annotation and actual type")
+
 and build_rel_map_list ltyp ltype_of_b =
  List.fold_left2 (fun a b c -> merge_smap a (build_rel_map b c))
   Smap.empty ltyp ltype_of_b
@@ -224,299 +205,235 @@ and build_rel_map_list ltyp ltype_of_b =
 
 (*s Use (and proof) of the principle *)
 
-(*
-  \begin {itemize}
-  \item [concl] ([constr]): conclusions, cad (xi:ti)gl, ou gl est le but a
-  prouver, et xi:ti correspondent aux arguments donnés à la tactique.  On
-  enlève un produit à chaque fois qu'on rencontre un binder, sans lift ou pop.
-  Initialement: une seule conclusion, puis specifique a chaque branche.
-  \item[absconcl] ([constr array]): les conclusions (un predicat pour chaque
-  fixp. mutuel) patternisées pour  pouvoir être appliquées.
-  \item [mimick] ([constr]): le terme qu'on imite. On plonge  dedans au fur et
-  à mesure, sans lift ni pop.
-  \item [nmefonc] ([constr array]): la constante correspondant à la fonction
-  appelée, permet de remplacer les appels recursifs par des appels à la
-  constante correspondante (non pertinent (et inutile) si on permet l'appel de
-  la tactique sur une terme donné directement (au lieu d'une constante comme
-  pour l'instant)).
-  \item [fonc] ([int*int]) : bornes des indices des variable correspondant aux
-  appels récursifs (plusieurs car fixp.  mutuels), utile pour reconnaître les
-  appels récursifs (ATTENTION: initialement vide, reste vide tant qu'on n'est
-  pas dans un fix).  
-  \end{itemize}
-*)
+(* This is the type of the argument of [proofPrinc] *)
 
 type mimickinfo =
     {
-     concl: constr;
-     absconcl: constr array;
-     mimick: constr;
-     env: env;
-     sigma: Evd.evar_map;
-     nmefonc: constr array;
-     fonc: int * int;
+     concl: constr; (* conclusion voulue, cad (xi:ti)gl, ou gl est le but a
+                       prouver, et xi:ti correspondent aux arguments donnés à
+                       la tactique.  On enlèvera un produit à chaque fois
+                       qu'on rencontrera un binder, sans lift ou pop.
+                       Initialement: une seule conclusion, puis specifique à
+                       chaque branche. *)
+     absconcl: constr array; (* conclusions patternisées pour pouvoir être
+                                appliquées = un predicat pour chaque fixpt
+                                mutuel. *)
+     mimick: constr; (* le terme qu'on imite. On plongera  dedans au fur et
+                        à mesure, sans lift ni pop. *)
+     env: env; (* The global typing environment, we will add thing in it when
+                  going inside the term (push_rel, push_rec_types) *)
+     sigma: Evd.evar_map; 
+     nmefonc: constr array; (* la constante correspondant à la fonction
+                               appelée, permet de remplacer les appels
+                               recursifs par des appels à la constante
+                               correspondante (non pertinent (et inutile) si
+                               on permet l'appel de la tactique sur une terme
+                               donné directement (au lieu d'une constante
+                               comme pour l'instant)). *)
+     fonc: int * int; (* bornes des indices des variable correspondant aux
+                         appels récursifs (plusieurs car fixp.  mutuels),
+                         utile pour reconnaître les appels récursifs
+                         (ATTENTION: initialement vide, reste vide tant qu'on
+                         n'est pas dans un fix).  *)
      doeqs: bool; (* this reference is to toggle building of equalities during
                     the building of the principle (default is true) *)
-     fix: bool (* did I already went through a fix or case constr? lambdas
+     fix: bool; (* did I already went through a fix or case constr? lambdas
                   found before a case or a fix are treated as parameters of
                   the induction principle *)
+     lst_vars: (constr*(name*constr)) list ; (* Variables rencontrées jusque là *)
+     lst_eqs: (Term.constr * (Term.constr * Term.constr * Term.constr)) list ; 
+                                   (* liste d'équations engendrées au cours du
+                                      parcours, cette liste grandit à chaque
+                                      case, et il faut lifter le tout à chaque
+                                      binder *)
+     lst_recs: constr list ; (* appels récursifs rencontrés jusque là *)
     }
 
-(*
-  \begin{itemize}
-  \item [lst_vars] ([(constr*(name*constr)) list]): liste des variables
-  rencontrées jusqu'à maintenant.
-  \item [lst_eqs] ([constr list]): liste d'équations engendrées au cours du
-  parcours, cette liste grandit à chaque case, et il faut lifter le tout à
-  chaque binder.
-  \item [lst_recs] ([constr list]): listes des appels récursifs rencontrés
-  jusque là.
-  \end{itemize}
-
-  Cette fonction rends un nuplet de la forme:
-
-  [t,
-  [(ev1,tev1);(ev2,tev2)..],
-  [(i1,j1,k1);(i2,j2,k2)..],
-  [|c1;c2..|],
-  [|typ1;typ2..|],
-  [(param,tparam)..]]
-
- *)
-
-(* This could be the return type of [proofPrinc], but not yet *)
-type funind =
+(* This is the return type of [proofPrinc] *)
+type 'a funind = (* 'A = CONTR  OU  CONSTR ARRAY *)
     {
-     princ:constr;
-     evarlist: (constr*Term.types) list;
-     hypnum: (int*int*int) list;
-     mutfixmetas: constr array ;
-     conclarray: types array;
-     params:(constr*name*constr) list
+
+     princ:'a; (* le (ou les) principe(s) demandé(s), il contient des meta
+                  variables représentant soit des trous à prouver plus tard,
+                  soit les conclusions à compléter avant de rendre le terme
+                  (suivant qu'on utilise le principe pour faire refine ou
+                  functional scheme). Il y plusieurs conclusions si plusieurs
+                  fonction mutuellement récursives) voir la suite. *)
+     evarlist: (constr*Term.types) list; (* [(ev1,tev1);(ev2,tev2)...]]
+                                            l'ensemble des meta variables
+                                            correspondant à des trous. [evi]
+                                            est la meta variable, [tevi] est
+                                            son type. *)
+     hypnum: (int*int*int) list; (* [[(in,jn,kn)...]] sont les nombres
+                                    respectivement de variables, d'équations,
+                                    et d'hypothèses de récurrence pour le but
+                                    n. Permet de faire le bon nombre d'intros
+                                    et des rewrite au bons endroits dans la
+                                    suite. *)
+     mutfixmetas: constr array ; (* un tableau de meta variables correspondant
+                                    à chacun des prédicats mutuellement
+                                    récursifs construits. *)
+     conclarray: types array; (* un tableau contenant les conclusions
+                                 respectives de chacun des prédicats
+                                 mutuellement récursifs. Permet de finir la
+                                 construction du principe. *)
+     params:(constr*name*constr) list; (* [[(metavar,param,tparam)..]] la
+                                          liste des paramètres (les lambdas
+                                          au-dessus du fix) du fixpoint si
+                                          fixpoint il y a, le paramètre est
+                                          une meta var, dont on stocke le nom
+                                          et le type. TODO: utiliser la
+                                          structure adequat? *)
     }
 
-(* 
-  où:
 
-  \begin{itemize} 
 
-  \item[t] est le principe demandé, il contient des meta variables
-  représentant soit des trous à prouver plus tard, soit les conclusions à
-  compléter avant de rendre le terme (suivant qu'on utilise le principe pour
-  faire refine ou functional scheme). Il y plusieurs conclusions si plusieurs
-  fonction mutuellement récursives) voir la suite.
+let empty_funind_constr =
+    {
+     princ = mkProp;
+     evarlist = [];
+     hypnum = [];
+     mutfixmetas = [||];
+     conclarray = [||];
+     params = []
+    }
 
-  \item[[(ev1,tev1);(ev2,tev2)...]] est l'ensemble des méta variables
-  correspondant à des trous. [evi] est la meta variable, [tevi] est son type.
+let empty_funind_array =
+    { empty_funind_constr with
+     princ = [||];
+    }
 
-  \item[(in,jn,kn)] sont les nombres respectivement de variables, d'équations,
-  et d'hypothèses de récurrence pour le but n. Permet de faire le bon nombre
-  d'intros et des rewrite au bons endroits dans la suite.
+(* Replace the calls to the function (recursive calls) by calls to the
+   corresponding constant  *)
+let replace_reccalls mi b =
+ let d,f = mi.fonc in 
+ let res = ref b in
+ let _ = for i = d to f do 
+   res := substitterm 0 (mkRel i) mi.nmefonc.(f-i) !res done in
+ !res
+ 
 
-  \item[[|c1;c2...|]] est un tableau de meta variables correspondant à chacun
-  des prédicats mutuellement récursifs construits.
 
-  \item[[|typ1;typ2...|]] est un tableau contenant les conclusions respectives
-  de chacun des prédicats mutuellement récursifs. Permet de finir la
-  construction du principe.
+(* collects all information of match branches stored in [l] *)
+let rec collect_cases l =
+ match l with
+  | [||] -> empty_funind_array
+  | arr -> 
+     let x = arr.(0) in
+     let resrec = collect_cases (Array.sub arr 1 (Array.length arr - 1)) in
+     { x with
+      princ= Array.append [|x.princ|] resrec.princ;
+      evarlist = x.evarlist@resrec.evarlist;
+      hypnum = x.hypnum@resrec.hypnum;
+     }
+
+let collect_pred l = 
+ let l1,l2,l3 = split3 l in
+ Array.of_list l1 , Array.of_list l2 , Array.of_list l3
+
+
+(* [build_pred n tarr] builds the right predicates for each element of [tarr]
+   (of type: [type array] of size [n]). Return the list of triples: 
+   (?i , 
+   fun (x1:t1) ... (xn:tn) => (?i x1...xn) ,
+   forall (x1:t1) ... (xn:tn), (?i x1...xn)),
+   where ti's are deduced from elements of tarr, which are of the form:
+   t1 -> t2 -> ... -> tn -> <nevermind>. *)
+let rec build_pred n tarr =
+ if n >= Array.length tarr (* iarr *) then []
+ else
+   let ftyp = Array.get tarr n in
+   let gl = mknewmeta() in
+   let gl_app = applFull gl ftyp in
+   let pis = prod_change_concl ftyp gl_app in
+   let gl_abstr = lam_change_concl ftyp gl_app in
+   (gl,gl_abstr,pis):: build_pred (n+1) tarr
 
-  \item[[(param,tparam)..]] est la liste des paramètres (les lambda au-dessus
-  du fix) du fixpoint si fixpoint il y a.
 
-  \end{itemize}
-*)
 let heq_prefix = "H_eq_"
 
 type kind_of_hyp = Var | Eq  (*| Rec*)
 
-let rec proofPrinc mi lst_vars lst_eqs lst_recs:
- constr * (constr*Term.types) list * (int*int*int) list 
- * constr array * types array * (constr*name*constr) list =
+(* the main function, build the principle by exploring the term and reproduce
+   the same structure. *)
+let rec proofPrinc mi: constr funind =
  match kind_of_term mi.mimick with
     (* Fixpoint: we reproduce the Fix, fonc becomes (1,nbofmutf) to point on
        the name of recursive calls *) 
   | Fix((iarr,i),(narr,tarr,carr)) -> 
-
-     (* We construct the right predicates for each mutual fixpt *)     
-     let rec build_pred n =
-      if n >= Array.length iarr then []
-      else
-        let ftyp = Array.get tarr n in
-        let gl = mknewmeta() in
-        let gl_app = applFull gl ftyp in
-        let pis = prod_change_concl ftyp gl_app in
-        let gl_abstr = lam_change_concl ftyp gl_app in
-        (gl,gl_abstr,pis):: build_pred (n+1) in
-
-     let evarl,predl,pisl = collect_pred (build_pred 0) in
-     let newabsconcl = Array.of_list predl in
-     let evararr = Array.of_list evarl in
-     let pisarr = Array.of_list pisl in
+     (* We construct the right predicates for each mutual fixpt *)
+     let evararr,newabsconcl,pisarr = collect_pred (build_pred 0 tarr) in
      let newenv = push_rec_types (narr,tarr,carr) mi.env in
-
-     let rec collect_fix n =
-      if n >= Array.length iarr then [],[],[],[]
-      else
-        let nme = Array.get narr n in
-        let c = Array.get carr n in
-        (* rappelle sur le sous-terme, on ajoute un niveau de
-           profondeur (lift) parce que Fix est un binder. *)
-        let newmi = {mi with concl=(pisarr.(n)); absconcl=newabsconcl;
-        mimick=c; fonc=(1,((Array.length iarr)));env=newenv;fix=true} in
-        let appel_rec,levar,lposeq,_,evarrarr,parms = 
-         proofPrinc newmi (lift1_lvars lst_vars) 
-          (lift1_leqs lst_eqs) (lift1L lst_recs) in
-        let lnme,lappel_rec,llevar,llposeq = collect_fix (n+1) in
-        (nme::lnme),(appel_rec::lappel_rec),(levar@llevar), (lposeq@llposeq) in
-
-     let lnme,lappel_rec,llevar,llposeq =collect_fix  0 in
-     let lnme' = List.map (fun nme -> newname_append nme "_ind") lnme in
-     let anme = Array.of_list lnme' in
-     let aappel_rec = Array.of_list lappel_rec in
-     (* llevar are put outside the fix, so one level of rel must be removed *)
-     mkFix((iarr,i),(anme, pisarr,aappel_rec))
-      , (pop1_levar llevar) , llposeq,evararr,pisarr,[]
-
+     let anme',aappel_rec,llevar,llposeq = 
+      collect_fix mi 0 iarr narr carr pisarr newabsconcl newenv in
+     let anme = Array.map (fun nme -> newname_append nme "_ind") anme' in
+     { 
+      princ = mkFix((iarr,i),(anme, pisarr,aappel_rec));
+      evarlist= pop1_levar llevar; (* llevar are put outside the fix, so we pop 1 *)
+      hypnum = llposeq;
+      mutfixmetas = evararr;
+      conclarray = pisarr;
+      params = []
+     }
   (* <pcase> Cases b of arrPt end.*)
-  | Case(cinfo, pcase, b, arrPt) -> 
-
+  | Case (cinfo, pcase, b, arrPt) -> 
      let prod_pcase,_ = decompose_lam pcase in
-     let nmeb,lastprod_pcase = List.hd prod_pcase in
-     let b'= apply_leqtrpl_t b lst_eqs in
+     let nmeb,_ = List.hd prod_pcase in
+     let newb'= apply_leqtrpl_t b mi.lst_eqs in
      let type_of_b = Typing.type_of mi.env mi.sigma b in
-     let new_lst_recs = lst_recs @ hdMatchSub_cpl b mi.fonc in
-     (* Replace the calls to the function (recursive calls) by calls to the
-        corresponding constant:  *)
-     let d,f = mi.fonc in 
-     let res = ref b' in
-     let _ = for i = d to f do 
-       res := substitterm 0 (mkRel i) mi.nmefonc.(f-i) !res done in
-     let newb = !res in
-
-     (* [fold_proof t l n] rend le resultat de l'appel recursif sur les
-        elements de la liste l (correpsondant a arrPt), appele avec les bons
-        arguments: [concl] devient [(DUMMY1:t1;...;DUMMY:tn)concl'], ou [n]
-        est le nombre d'arguments du constructeur considéré (FIX: Hormis les
-        parametres!!), et [concl'] est concl ou l'on a réécrit [b] en ($c_n$
-        [rel1]...).*)
-
-     let rec fold_proof nth_construct eltPt' =  
-      (* mise a jour de concl pour l'interieur du case, concl'= concl[b <- C x3
-         x2 x1... ], sans quoi les annotations ne sont plus coherentes *)
-      let cstr_appl,nargs = nth_dep_constructor type_of_b nth_construct in
-      let concl'' = 
-       substitterm 0 (lift nargs b) cstr_appl (lift nargs mi.concl) in
-      let neweq = mkEq type_of_b newb (popn nargs cstr_appl) in
-      let concl_dummy = add_n_dummy_prod concl'' nargs in
-      let lsteqs_rew = apply_eq_leqtrpl lst_eqs neweq in
-      let new_lsteqs = 
-       (mkRel (0-nargs),(type_of_b,newb, popn nargs cstr_appl))::lsteqs_rew in
-      let a',a'' = decompose_lam_n nargs eltPt' in
-      let newa'' = 
-       if mi.doeqs 
-       then mkLambda (name_of_string heq_prefix,lift nargs neweq,lift 1 a'') 
-       else a'' in
-      let newmimick = lamn nargs a' newa'' in
-      let b',b'' = decompose_prod_n nargs concl_dummy in
-      let newb'' = 
-       if mi.doeqs 
-       then mkProd (name_of_string heq_prefix,lift nargs neweq,lift 1 b'')
-       else b'' in
-      let newconcl = prodn nargs b' newb'' in
-      let newmi = {mi with mimick=newmimick; concl=newconcl; fix=true} in
-      let a,b,c,d,e,p = proofPrinc newmi lst_vars new_lsteqs new_lst_recs in
-      a,b,c,d,e,p
-      in
-     
-     let arrPt_proof,levar,lposeq,evararr,absc,_ = 
-      collect_cases (Array.mapi fold_proof arrPt) in
-     let prod_pcase,concl_pcase = decompose_lam pcase in
-     let nme,typ = List.hd prod_pcase in
-     let suppllam_pcase = List.tl prod_pcase in
-     (* je remplace b par rel1 (apres avoir lifte un coup) dans la
-        future annotation du futur case: ensuite je mettrai un lambda devant *)
-     let typesofeqs' = eqs_of_beqs_named equality_hyp_string lst_eqs in
-     (*      let typesofeqs = prod_it_lift typesofeqs' mi.concl in *)
-     let typesofeqs = mi.concl in
-     let typeof_case'' = 
-      substitterm 0 (lift 1 b) (mkRel 1) (lift 1 typesofeqs) in
-     
-     (* C'est un peu compliqué ici: en cas de type inductif vraiment dépendant
-        le piquant du case [pcase] contient des lambdas supplémentaires en tête
-        je les ai dans la variable [suppllam_pcase]. Le problème est que la
-        conclusion du piquant doit faire référence à ces variables plutôt qu'à
-        celle de l'exterieur. Ce qui suit permet de changer les reference de
-        newpacse' pour pointer vers les lambda du piquant. On procède comme
-        suit: on repère les rels qui pointent à l'interieur du piquant dans la
-        fonction imitée, pour ça on parcourt le dernier lambda du piquant (qui
-        contient le type de l'argument du case), et on remplace les rels
-        correspondant dans la preuve construite. *)
-     
-     (* typ vient du piquant, type_of_b vient du typage de b.*)
-     
-     let rel_smap = 
-      if List.length suppllam_pcase=0 then Smap.empty else
-        build_rel_map (lift (List.length suppllam_pcase) type_of_b) typ in
-     let rel_map = smap_to_list rel_smap in
-     let rec substL l c =
-      match l with
-         [] -> c
-       | ((e,e') ::l') -> substL l' (substitterm 0 e (lift 1 e') c) in
-     let newpcase' = substL rel_map typeof_case'' in
-     let neweq = mkEq (lift (List.length suppllam_pcase + 1) type_of_b) 
-      (lift (List.length suppllam_pcase + 1) newb) (mkRel 1) in
-     let newpcase = 
-      if mi.doeqs then
-        mkProd (name_of_string "eg", neweq, lift 1 newpcase') else newpcase'
-     in
-     (* construction du dernier lambda du piquant. *)
-     let typeof_case' = mkLambda (newname_append nme "_ind" ,typ, newpcase) in
-     (* ajout des lambdas supplémentaires (type dépendant) du piquant. *)
-     let typeof_case = 
-      lamn (List.length suppllam_pcase) suppllam_pcase typeof_case' in 
-     let trm' = mkCase (cinfo,typeof_case,newb, arrPt_proof) in
-     let trm = 
-      if mi.doeqs then mkApp (trm',[|(mkRefl type_of_b newb)|]) 
-      else trm' in
-     trm,levar,lposeq,evararr,absc,[] (* fix parms here (fix inside case)*)
-      
+     (* Replace the recursive calls to the function by calls to the constant *)
+     let newb = replace_reccalls mi newb' in     
+     let cases = collect_cases (Array.mapi (fold_proof mi b type_of_b newb) arrPt) in
+     (* the match (case) annotation must be transformed, see [build_pcase] below *)
+     let newpcase = build_pcase mi pcase b type_of_b newb in
+     let trm' = mkCase (cinfo,newpcase,newb, cases.princ) in
+    { cases with
+     princ = if mi.doeqs then mkApp (trm',[|(mkRefl type_of_b newb)|]) else trm';
+     params = [] (* FIX: fix parms here (fixpt inside a match)*)
+    }
+
+
   | Lambda(nme, typ, cstr) ->
      let _, _, cconcl = destProd mi.concl in
      let d,f=mi.fonc in
      let newenv = push_rel (nme,None,typ) mi.env in
-     let newmi = {mi with concl=cconcl; mimick=cstr; env=newenv;
-      fonc=((if d > 0 then d+1 else 0),(if f > 0 then f+1 else 0))} in
      let newlst_var = (* if this lambda is a param, then don't add it here *)
-      if mi.fix then (mkRel 1,(nme,typ)) :: lift1_lvars lst_vars
-      else (*(mkRel 1,(nme,typ)) :: *) lift1_lvars lst_vars in
-     let rec_call,levar,lposeq,evararr,absc,parms =
-      proofPrinc newmi newlst_var (lift1_leqs lst_eqs) (lift1L lst_recs) in
+      if mi.fix then (mkRel 1,(nme,typ)) :: lift1_lvars mi.lst_vars
+      else (*(mkRel 1,(nme,typ)) :: *) lift1_lvars mi.lst_vars in
+     let newmi = {mi with concl=cconcl; mimick=cstr; env=newenv;
+      fonc = (if d > 0 then d+1 else 0) , (if f > 0 then f+1 else 0);
+      lst_vars = newlst_var ; lst_eqs = lift1_leqs mi.lst_eqs;
+      lst_recs = lift1L mi.lst_recs} in
+     let resrec = proofPrinc newmi in
      (* are we inside a fixpoint or a case? then this is a normal lambda *)
-     if mi.fix then mkLambda (nme,typ,rec_call) , levar, lposeq,evararr,absc,[]
+     if mi.fix 
+     then { resrec with princ = mkLambda (nme,typ,resrec.princ) ; params = [] }
      else (* otherwise this is a parameter *)
        let metav = mknewmeta() in
        let substmeta t = popn 1 (substitterm 0 (mkRel 1) metav t) in
-       let newrec_call = substmeta rec_call in
-       let newlevar = List.map (fun (ev,tev) -> ev, substmeta tev) levar in
-       let newabsc = Array.map substmeta absc in
-       newrec_call,newlevar,lposeq,evararr,newabsc,((metav,nme, typ)::parms)
+       { resrec with
+        princ = substmeta resrec.princ;
+        evarlist = List.map (fun (ev,tev) -> ev, substmeta tev) resrec.evarlist;
+        conclarray = Array.map substmeta resrec.conclarray;
+        params = (metav,nme,typ) :: resrec.params
+       }
+
 
   | LetIn(nme,cstr1, typ, cstr) ->
      failwith ("I don't deal with let ins yet. "^
 				 "Please expand them before applying this function.")
 
   | u -> 
-     let varrels = List.rev (List.map fst lst_vars) in
-     let varnames = List.map snd lst_vars in
+     let varrels = List.rev (List.map fst mi.lst_vars) in
+     let varnames = List.map snd mi.lst_vars in
      let nb_vars = List.length varnames in
-     let nb_eqs = List.length lst_eqs in
-     let eqrels = List.map fst lst_eqs in
+     let nb_eqs = List.length mi.lst_eqs in
+     let eqrels = List.map fst mi.lst_eqs in
      (* [terms_recs]: appel rec du fixpoint, On concatène les appels recs
         trouvés dans les let in et les Cases avec ceux trouves dans u (ie
         mi.mimick). *)
      (* TODO: il faudra gérer plusieurs pt fixes imbriqués ? *)
-     let terms_recs = lst_recs @ hdMatchSub_cpl mi.mimick mi.fonc in
-
+     let terms_recs = mi.lst_recs @ hdMatchSub_cpl mi.mimick mi.fonc in
      (*c construction du terme: application successive des variables, des
        egalites et des appels rec, a la variable existentielle correspondant a
        l'hypothese de recurrence en cours. *)
@@ -527,18 +444,110 @@ let rec proofPrinc mi lst_vars lst_eqs lst_recs:
      let appsrecpred = exchange_reli_arrayi_L mi.absconcl mi.fonc terms_recs in
      let typeofhole''  = prod_it_anonym_lift mi.concl appsrecpred in
      let typeofhole    = prodn nb_vars varnames typeofhole'' in
-		   
      (* Un bug de refine m'oblige à mettre ici un H (meta variable à ce point,
         mais remplacé par H avant le refine) au lieu d'un '?', je mettrai les
         '?'  à la fin comme ça [(([H1,H2,H3...] ...) ? ? ?)] *)
-
      let newmeta = mknewmeta() in
      let concl_with_var = applistc newmeta varrels in
      let conclrecs = applistc concl_with_var terms_recs in
-     conclrecs,[newmeta,typeofhole], [nb_vars,(List.length terms_recs)
-      ,nb_eqs],[||],mi.absconcl,[]
-
+     { empty_funind_constr with
+      princ = conclrecs;
+      evarlist = [ newmeta , typeofhole ];
+      hypnum = [ nb_vars , List.length terms_recs , nb_eqs ];
+      conclarray = mi.absconcl;
+     }
 
+     
+(* C'est un peu compliqué ici: en cas de type inductif vraiment dépendant
+   l'annotation de type du case [pcase] contient des lambdas supplémentaires
+   en tête. Je les récupère dans la variable [suppllam_pcase]. Le problème est
+   que la conclusion de l'annotation du nouveauacse doit faire référence à ces
+   variables plutôt qu'à celle de l'exterieur. Ce qui suit permet de changer
+   les reference de newpcase' pour pointer vers les lambda du piquant. On
+   procède comme suit: on repère les rels qui pointent à l'interieur de
+   l'annotation dans la fonction initiale et on les relie à celle du type
+   voulu pour le case, pour ça ([build_rel_map]) on parcourt en même temps le
+   dernier lambda du piquant ([typ]) (qui contient le type de l'argument du
+   case) et le type attendu pour le case ([type_of_b]) et on construit un
+   map. Ensuite on remplace les rels correspondant dans la preuve construite
+   en suivant le map. *)
+     
+and build_pcase mi pcase b type_of_b newb =
+     let prod_pcase,_ = decompose_lam pcase in
+     let nme,typ = List.hd prod_pcase in
+     (* je remplace b par rel1 (apres avoir lifte un coup) dans la future
+        annotation du futur case: ensuite je mettrai un lambda devant *)
+     let typeof_case'' = substitterm 0 (lift 1 b) (mkRel 1) (lift 1 mi.concl) in
+     let suppllam_pcase = List.tl prod_pcase in
+     let suppllam_pcasel = List.length suppllam_pcase  in
+     let rel_smap = 
+      if suppllam_pcasel=0 then Smap.empty else (* FIX: is this test necessary ? *)
+        build_rel_map (lift suppllam_pcasel type_of_b) typ in
+     let newpcase''' =  
+      Smap.fold (fun e e' acc -> substitterm 0 e (lift 1 e') acc)
+       rel_smap typeof_case'' in
+     let neweq = mkEq (lift (suppllam_pcasel + 1) type_of_b) 
+      (lift (suppllam_pcasel + 1) newb) (mkRel 1) in
+     let newpcase'' = 
+      if mi.doeqs 
+      then mkProd (name_of_string "eg", neweq, lift 1 newpcase''') 
+      else newpcase''' in
+     (* construction du dernier lambda du piquant. *)
+     let newpcase' = mkLambda (newname_append nme "_ind" ,typ, newpcase'') in
+     (* ajout des lambdas supplémentaires (type dépendant) du piquant. *)
+     lamn suppllam_pcasel suppllam_pcase newpcase'
+
+
+(* [fold_proof mi b typeofb newb l n] rend le resultat de l'appel recursif sur
+   cstr (correpsondant au ième elt de [arrPt] ci-dessus et donc au ième
+   constructeur de [typeofb]), appele avec les bons arguments: [mi.concl]
+   devient [(DUMMY1:t1;...;DUMMY:tn)concl'], ou [n] est le nombre d'arguments
+   du constructeur considéré, et [concl'] est [mi.concl] ou l'on a réécrit [b]
+   en ($c_n$ [rel1]...). *)
+and fold_proof mi b type_of_b newb i cstr = 
+ let new_lst_recs = mi.lst_recs @ hdMatchSub_cpl b mi.fonc in
+ (* mise a jour de concl pour l'interieur du case, concl'= concl[b <- C x3
+    x2 x1... ], sans quoi les annotations ne sont plus coherentes *)
+ let cstr_appl,nargs = nth_dep_constructor type_of_b i in
+ let concl'' = 
+  substitterm 0 (lift nargs b) cstr_appl (lift nargs mi.concl) in
+ let neweq = mkEq type_of_b newb (popn nargs cstr_appl) in
+ let concl_dummy = add_n_dummy_prod concl'' nargs in
+ let lsteqs_rew = apply_eq_leqtrpl mi.lst_eqs neweq in
+ let new_lsteqs = (mkRel (-nargs),(type_of_b,newb, popn nargs cstr_appl))::lsteqs_rew in
+ let a',a'' = decompose_lam_n nargs cstr in
+ let newa'' = 
+  if mi.doeqs 
+  then mkLambda (name_of_string heq_prefix,lift nargs neweq,lift 1 a'') 
+  else a'' in
+ let newmimick = lamn nargs a' newa'' in
+ let b',b'' = decompose_prod_n nargs concl_dummy in
+ let newb'' = 
+  if mi.doeqs 
+  then mkProd (name_of_string heq_prefix,lift nargs neweq,lift 1 b'')
+  else b'' in
+ let newconcl = prodn nargs b' newb'' in
+ let newmi = {mi with mimick=newmimick; concl=newconcl; fix=true; 
+  lst_eqs= new_lsteqs; lst_recs = new_lst_recs} in
+ proofPrinc newmi 
+
+
+and collect_fix mi n iarr narr carr pisarr newabsconcl newenv =
+ if n >= Array.length iarr then [||],[||],[],[]
+ else
+   let nme = Array.get narr n in
+   let c = Array.get carr n in
+   (* rappelle sur le sous-terme, on ajoute un niveau de
+      profondeur (lift) parce que Fix est un binder. *)
+   let newmi = {mi with concl=(pisarr.(n)); absconcl=newabsconcl;
+    mimick=c; fonc=(1,((Array.length iarr)));env=newenv;fix=true;
+    lst_vars=lift1_lvars mi.lst_vars; lst_eqs=lift1_leqs mi.lst_eqs; 
+    lst_recs= lift1L mi.lst_recs;} in
+   let resrec = proofPrinc newmi  in
+   let lnme,lappel_rec,llevar,llposeq = 
+    collect_fix mi (n+1) iarr narr carr pisarr newabsconcl newenv in
+   Array.append [|nme|] lnme , Array.append [|resrec.princ|] lappel_rec
+    , (resrec.evarlist@llevar) , (resrec.hypnum@llposeq)
 
 let mkevarmap_aux ex = let x,y = ex in	(mkevarmap_from_listex x),y
 
@@ -568,9 +577,10 @@ let interp_fonc_tacarg fonctac gl =
 
 let invfun_proof fonc def_fonc gl_abstr pis env sigma =
  let mi = {concl=pis; absconcl=gl_abstr; mimick=def_fonc; env=env;
- sigma=sigma; nmefonc=fonc; fonc=(0,0); doeqs=true; fix=false} in
- let princ_proof,levar,lposeq,evararr,absc,parms = proofPrinc mi [] [] [] in
- princ_proof,levar,lposeq,evararr,absc,parms
+ sigma=sigma; nmefonc=fonc; fonc=(0,0); doeqs=true; fix=false ; 
+ lst_vars = []; lst_eqs = []; lst_recs = []} in
+ proofPrinc mi
+
 (* Do intros [i] times, then do rewrite on all introduced hyps which are called
    like [heq_prefix], FIX: have another filter than the name. *)
 let rec iterintro i = 
@@ -587,7 +597,7 @@ let rec iterintro i =
         let sub = 
          try String.sub hypname 0 (String.length heq_prefix)
          with _ -> "" (* different than [heq_prefix] *) in
-        if sub=heq_prefix then rewriteLR hyp else tclFAIL 0 "Cannot rewrite")
+        if sub=heq_prefix then rewriteLR hyp else tclFAIL 0 (str "Cannot rewrite"))
       )) gl)
 
 
@@ -647,7 +657,7 @@ let rec applistc_iota cstr lcstr env sigma =
   | [] -> cstr,[]
   | arg::lcstr' -> 
      let arghd = 
-      if isApp arg then let x,_ = destApplication arg in x else arg in
+      if isApp arg then let x,_ = destApp arg in x else arg in
      if isConstruct arghd (* of the form [(C ...)]*)
      then 
         applistc_iota (Tacred.nf env sigma (nf_beta (applistc cstr [arg])))
@@ -686,39 +696,38 @@ let invfun c l dorew gl =
  let pis = add_pis (pf_concl gl) gl listargs' in
  (* princ_proof builds the principle *)
  let _ = resetmeta() in
- let princ_proof,levar, lposeq,evararr,_,parms = 
-  invfun_proof [|fonc|] def_fonc [||] pis (pf_env gl) (project gl) in
+ let pr = invfun_proof [|fonc|] def_fonc [||] pis (pf_env gl) (project gl) in
  (* Generalize the goal. [[x1:T1][x2:T2]... g[arg1 <- x1 ...]]. *)
  let gl_abstr' = add_lambdas (pf_concl gl) gl listargs' in
  (* apply parameters immediately *)
  let gl_abstr = 
-  applistc gl_abstr' (List.map (fun (x,y,z) -> x) (List.rev parms)) in
+  applistc gl_abstr' (List.map (fun (x,y,z) -> x) (List.rev pr.params)) in
  (* we apply args of the fix now, the parameters will be applied later *)
  let princ_proof_applied_args = 
-  applistc princ_proof (listsuf (List.length parms) listargs') in
+  applistc pr.princ (listsuf (List.length pr.params) listargs') in
  (* parameters are still there so patternify must not take them -> lift *)
  let princ_proof_applied_lift = 
-  lift (List.length levar) princ_proof_applied_args in
- let princ_applied_hyps'' = patternify (List.rev levar)
+  lift (List.length pr.evarlist) princ_proof_applied_args in
+ let princ_applied_hyps'' = patternify (List.rev pr.evarlist)
   princ_proof_applied_lift (Name (id_of_string "Hyp"))  in
  (* if there was a fix, we will not add "Q" as in funscheme, so we make a pop,
     TODO: find were we made the lift in proofPrinc instead and supress it here,
     and add lift in funscheme. *)
  let princ_applied_hyps' = 
-  if Array.length evararr > 0 then popn 1 princ_applied_hyps''
+  if Array.length pr.mutfixmetas > 0 then popn 1 princ_applied_hyps''
   else princ_applied_hyps'' in 
  (* if there is was fix, we have to replace the meta representing the
     predicate of the goal by the abstracted goal itself. *)
  let princ_applied_hyps = 
-  if Array.length evararr > 0 then (* mutual Fixpoint not treated in the tactic *) 
-    (substit_red 0 (evararr.(0)) gl_abstr princ_applied_hyps')
+  if Array.length pr.mutfixmetas > 0 then(* mutual Fixpoint not treated in the tactic*) 
+    (substit_red 0 (pr.mutfixmetas.(0)) gl_abstr princ_applied_hyps')
   else princ_applied_hyps' (* No Fixpoint *) in
  let _ = prNamedConstr "princ_applied_hyps" princ_applied_hyps in
  (* Same thing inside levar *)
  let newlevar' = 
-  if Array.length evararr > 0 then (* mutual Fixpoint not treated in the tactic *) 
-    List.map (fun (x,y) -> x,substit_red 0 (evararr.(0)) gl_abstr y) levar 
-  else levar
+  if Array.length pr.mutfixmetas > 0 then(* mutual Fixpoint not treated in the tactic*) 
+    List.map (fun (x,y) -> x,substit_red 0 (pr.mutfixmetas.(0)) gl_abstr y) pr.evarlist 
+  else pr.evarlist
  in
  (* replace params metavar by real args *)
  let rec replace_parms lparms largs t = 
@@ -726,19 +735,19 @@ let invfun c l dorew gl =
      [], _ -> t
    | ((p,_,_)::lp), (a::la) -> let t'= substitterm 0 p a t in replace_parms lp la t'
    | _, _ -> error "problem with number of args." in
- let princ_proof_applied = replace_parms parms listargs' princ_applied_hyps in
+ let princ_proof_applied = replace_parms pr.params listargs' princ_applied_hyps in
  let _ = prNamedLConstr "levar:" (List.map fst newlevar') in
  let _ = prNamedLConstr "levar types:" (List.map snd newlevar') in
  let _ = prNamedConstr "princ_proof_applied" princ_proof_applied in
  (* replace also in levar *)
  let newlevar = 
-  List.rev (List.map (fun (x,y) -> x, replace_parms parms listargs' y) newlevar') in
+  List.rev (List.map (fun (x,y) -> x, replace_parms pr.params listargs' y) newlevar') in
 (*
  (* replace params metavar by abstracted variables *)
-  let princ_proof_params = npatternify (List.rev parms) princ_applied_hyps in
+  let princ_proof_params = npatternify (List.rev pr.params) princ_applied_hyps in
  (* we apply now the real parameters *)
  let princ_proof_applied = 
-  applistc princ_proof_params (listpref (List.length parms) listargs') in
+  applistc princ_proof_params (listpref (List.length pr.params) listargs') in
 *)
  let princ_applied_evars = apply_levars princ_proof_applied newlevar in
  let open_princ_proof_applied = princ_applied_evars in
@@ -746,11 +755,11 @@ let invfun c l dorew gl =
  let _ = prNamedLConstr "evars" (List.map snd (fst princ_applied_evars)) in
  let listargs_ids = List.map destVar (List.filter isVar listargs') in
  (* debug: impression du but*)
-(*  let lgl = Evd.to_list (sig_sig gl) in *)
-(*  let _ = prNamedLConstr "\ngl= " (List.map (fun x -> (snd x).evar_concl) lgl) in *)
-(*  let _ = prstr "fin gl \n\n" in *)
+ let lgl = Evd.to_list (sig_sig gl) in
+ let _ = prNamedLConstr "\ngl= " (List.map (fun x -> (snd x).evar_concl) lgl) in
+ let _ = prstr "fin gl \n\n" in
  invfun_basic (mkevarmap_aux open_princ_proof_applied) listargs_ids 
-  gl dorew lposeq
+  gl dorew pr.hypnum
 
 (* function must be a constant, all arguments must be given. *)
 let invfun_verif c l dorew gl =
@@ -763,8 +772,8 @@ let invfun_verif c l dorew gl =
    else error "wrong number of arguments for the function"
 
 
-TACTIC EXTEND FunctionalInduction
-  [ "Functional" "Induction" constr(c)  ne_constr_list(l) ] 
+TACTIC EXTEND functional_induction
+  [ "functional" "induction" constr(c)  ne_constr_list(l) ] 
      -> [ invfun_verif c l true ]
 END
 
@@ -780,13 +789,14 @@ let buildFunscheme fonc mutflist =
  let pis = prod_change_concl ftyp gl_app in
  (* Here we call the function invfun_proof, that effectively 
     builds the scheme *)
- let princ_proof,levar,_,evararr,absc,parms = 
-  invfun_proof mutflist def_fonc [||] pis (Global.env()) Evd.empty in
+(*  let princ_proof,levar,_,evararr,absc,parms =  *)
+ let _ = prstr "Recherche du principe... lancement de invfun_proof\n" in
+ let pr = invfun_proof mutflist def_fonc [||] pis (Global.env()) Evd.empty in
  (* parameters are still there (unboud rel), and patternify must not take them
   -> lift*)
- let princ_proof_lift = lift (List.length levar) princ_proof in
+ let princ_proof_lift = lift (List.length pr.evarlist) pr.princ in
  let princ_proof_hyps = 
-  patternify (List.rev levar) princ_proof_lift (Name (id_of_string "Hyp"))  in
+  patternify (List.rev pr.evarlist) princ_proof_lift (Name (id_of_string "Hyp"))  in
  let rec princ_replace_metas ev abs i t = 
   if i>= Array.length ev then t
   else (* fix? *)
@@ -802,38 +812,46 @@ let buildFunscheme fonc mutflist =
     mkLambda (Name (id_of_name nam) , typ, 
     substitterm 0 ev (mkRel 1) (lift 0 acc)))
    t (List.rev params) in
- if Array.length evararr = 0 (* Is there a Fixpoint? *)
+ if Array.length pr.mutfixmetas = 0 (* Is there a Fixpoint? *)
 	then (* No Fixpoint *)
-   princ_replace_params parms (mkLambda ((Name (id_of_string "Q")), 
+   princ_replace_params pr.params (mkLambda ((Name (id_of_string "Q")), 
 		 prod_change_concl ftyp mkthesort,
    (substitterm 0 gl (mkRel 1) princ_proof_hyps)))
 	else (* there is a fix -> add parameters + replace metas *)
-   let princ_rpl = princ_replace_metas evararr absc 0 princ_proof_hyps in
-   princ_replace_params parms princ_rpl
+   let princ_rpl = 
+    princ_replace_metas pr.mutfixmetas pr.conclarray 0 princ_proof_hyps in
+   princ_replace_params pr.params princ_rpl
 
 
     
 (* Declaration of the functional scheme. *)
 let declareFunScheme f fname mutflist =
+ let _ = prstr "Recherche du perincipe...\n" in
+ let id_to_cstr id = 
+  try constr_of_id (Global.env()) id 
+  with
+     Not_found -> error (string_of_id id ^ " not found in the environment") in
  let flist = if mutflist=[] then [f] else mutflist in
- let fcstrlist = Array.of_list (List.map constr_of flist) in
- let scheme = buildFunscheme (constr_of f) fcstrlist in
+ let fcstrlist = Array.of_list (List.map id_to_cstr flist) in
+ let idf = id_to_cstr f in
+ let scheme = buildFunscheme idf fcstrlist in
   let _ = prstr "Principe:" in
   let _ = prconstr scheme in
  let ce = { 
   const_entry_body = scheme;
   const_entry_type = None;
-  const_entry_opaque = false } in
- let _= ignore (declare_constant fname (DefinitionEntry ce,IsDefinition)) in
+  const_entry_opaque = false;
+  const_entry_boxed = true } in
+ let _= ignore (declare_constant fname (DefinitionEntry ce,IsDefinition Scheme)) in
  ()
 
 
 
 VERNAC COMMAND EXTEND FunctionalScheme
  [ "Functional" "Scheme" ident(na) ":=" "Induction" "for" 
-    constr(c) "with" ne_constr_list(l) ]
+    ident(c) "with" ne_ident_list(l) ] 
   -> [ declareFunScheme c na l ]
-| [ "Functional" "Scheme" ident(na) ":=" "Induction" "for" constr(c) ]
+| [ "Functional" "Scheme" ident(na) ":=" "Induction" "for" ident (c) ]
   -> [ declareFunScheme c na [] ]
 END
 
diff --git a/contrib/funind/tacinvutils.ml b/contrib/funind/tacinvutils.ml
index a125b9a7..2877c19d 100644
--- a/contrib/funind/tacinvutils.ml
+++ b/contrib/funind/tacinvutils.ml
@@ -21,9 +21,9 @@ open Reductionops
 (*s printing of constr -- debugging *)
 
 (* comment this line to see debug msgs *)
-let msg x = () ;; let prterm c = str ""
+let msg x = () ;; let pr_lconstr c = str ""
   (* uncomment this to see debugging *)
-let prconstr c =  msg (str"  " ++ prterm c ++ str"\n")
+let prconstr c =  msg (str"  " ++ pr_lconstr c ++ str"\n")
 let prlistconstr lc = List.iter prconstr lc
 let prstr s = msg(str s)
 
@@ -31,7 +31,7 @@ let prchr () = msg (str" (ret) \n")
 let prNamedConstr s c = 
   begin
     msg(str "");
-    msg(str(s^"==>\n ") ++ prterm c ++ str "\n<==\n");
+    msg(str(s^"==>\n ") ++ pr_lconstr c ++ str "\n<==\n");
     msg(str "");
   end
 
@@ -74,7 +74,7 @@ let  rec mkevarmap_from_listex lex =
 		  let _ = prconstr typ in*)
 		  let info ={
 			 evar_concl = typ;
-			 evar_hyps = empty_named_context;
+			 evar_hyps = empty_named_context_val;
 			 evar_body = Evar_empty} in
 		  Evd.add (mkevarmap_from_listex lex') ex info
 
@@ -126,7 +126,7 @@ let apply_leqtrpl_t t leq =
 
 
 let apply_refl_term eq t =
-  let _,arr = destApplication eq in
+  let _,arr = destApp eq in
   let reli= (Array.get arr 1) in
   let by_t= (Array.get arr 2) in
   substitterm 0 reli by_t t
@@ -144,7 +144,7 @@ let apply_eq_leqtrpl leq eq =
 let constr_head_match u t=
   if isApp u 
   then 
-	 let uhd,args= destApplication u in
+	 let uhd,args= destApp u in
     uhd=t
   else false
 
@@ -187,7 +187,7 @@ let rec buildrefl_from_eqs eqs =
   match eqs with 
     | []  ->  []
     | cstr::eqs' -> 
-        let eq,args = destApplication cstr in
+        let eq,args = destApp cstr in
         (mkRefl (Array.get args 0) (Array.get args 2))
 	:: (buildrefl_from_eqs eqs')
 
@@ -237,7 +237,7 @@ let rec substit_red prof t by_t in_u =
 (* [exchange_reli_arrayi t=(reli x y ...) tarr (d,f)] exchange each
 	reli by tarr.(f-i). *) 
 let exchange_reli_arrayi tarr (d,f) t =
-  let hd,args= destApplication t in 
+  let hd,args= destApp t in 
   let i = destRel hd in
   let res = whd_beta (mkApp (tarr.(f-i) ,args)) in
   res
@@ -269,7 +269,7 @@ let def_of_const t =
 (* nom d'une constante. Must be a constante. x*)
 let name_of_const t =
     match (kind_of_term t) with
-        Const cst -> Names.string_of_label (Names.label cst)
+        Const cst -> Names.string_of_label (Names.con_label cst)
 		|_ -> assert false
  ;;
 
diff --git a/contrib/funind/tacinvutils.mli b/contrib/funind/tacinvutils.mli
index 2fc37b2c..64b21213 100644
--- a/contrib/funind/tacinvutils.mli
+++ b/contrib/funind/tacinvutils.mli
@@ -71,9 +71,10 @@ val expand_letins: constr -> constr
 
 val def_of_const: constr -> constr
 val name_of_const: constr -> string
+
 (*i
- Local Variables:
- compile-command: "make -k tacinvutils.cmi"
- End:
+ *** Local Variables: ***
+ *** compile-command: "make -C ../.. contrib/funind/tacinvutils.cmi" ***
+ *** End: ***
 i*)
 
diff --git a/contrib/interface/ascent.mli b/contrib/interface/ascent.mli
index 61d0d5a3..fb71288a 100644
--- a/contrib/interface/ascent.mli
+++ b/contrib/interface/ascent.mli
@@ -119,11 +119,13 @@ and ct_COMMAND =
   | CT_print_about of ct_ID
   | CT_print_all
   | CT_print_classes
+  | CT_print_ltac of ct_ID
   | CT_print_coercions
   | CT_print_grammar of ct_GRAMMAR
   | CT_print_graph
   | CT_print_hint of ct_ID_OPT
   | CT_print_hintdb of ct_ID_OR_STAR
+  | CT_print_rewrite_hintdb of ct_ID
   | CT_print_id of ct_ID
   | CT_print_implicit of ct_ID
   | CT_print_loadpath
@@ -135,6 +137,7 @@ and ct_COMMAND =
   | CT_print_opaqueid of ct_ID
   | CT_print_path of ct_ID * ct_ID
   | CT_print_proof of ct_ID
+  | CT_print_setoids
   | CT_print_scope of ct_ID
   | CT_print_scopes
   | CT_print_section of ct_ID
@@ -465,8 +468,8 @@ and ct_MODULE_EXPR =
   | CT_module_app of ct_MODULE_EXPR * ct_MODULE_EXPR
 and ct_MODULE_TYPE =
     CT_coerce_ID_to_MODULE_TYPE of ct_ID
-  | CT_module_type_with_def of ct_MODULE_TYPE * ct_ID * ct_FORMULA
-  | CT_module_type_with_mod of ct_MODULE_TYPE * ct_ID * ct_ID
+  | CT_module_type_with_def of ct_MODULE_TYPE * ct_ID_LIST * ct_FORMULA
+  | CT_module_type_with_mod of ct_MODULE_TYPE * ct_ID_LIST * ct_ID
 and ct_MODULE_TYPE_CHECK =
     CT_coerce_MODULE_TYPE_OPT_to_MODULE_TYPE_CHECK of ct_MODULE_TYPE_OPT
   | CT_only_check of ct_MODULE_TYPE
@@ -530,6 +533,7 @@ and ct_RED_COM =
   | CT_lazy of ct_CONVERSION_FLAG_LIST * ct_CONV_SET
   | CT_pattern of ct_PATTERN_NE_LIST
   | CT_red
+  | CT_cbvvm
   | CT_simpl of ct_PATTERN_OPT
   | CT_unfold of ct_UNFOLD_NE_LIST
 and ct_RETURN_INFO =
@@ -637,6 +641,7 @@ and ct_TACTIC_COM =
   | CT_elim of ct_FORMULA * ct_SPEC_LIST * ct_USING
   | CT_elim_type of ct_FORMULA
   | CT_exact of ct_FORMULA
+  | CT_exact_no_check of ct_FORMULA
   | CT_exists of ct_SPEC_LIST
   | CT_fail of ct_ID_OR_INT * ct_STRING_OPT
   | CT_first of ct_TACTIC_COM * ct_TACTIC_COM list
@@ -665,8 +670,8 @@ and ct_TACTIC_COM =
   | CT_match_context_reverse of ct_CONTEXT_RULE * ct_CONTEXT_RULE list
   | CT_match_tac of ct_TACTIC_COM * ct_MATCH_TAC_RULES
   | CT_move_after of ct_ID * ct_ID
-  | CT_new_destruct of ct_FORMULA_OR_INT * ct_USING * ct_INTRO_PATT_OPT
-  | CT_new_induction of ct_FORMULA_OR_INT * ct_USING * ct_INTRO_PATT_OPT
+  | CT_new_destruct of ct_FORMULA_OR_INT list * ct_USING * ct_INTRO_PATT_OPT
+  | CT_new_induction of ct_FORMULA_OR_INT list * ct_USING * ct_INTRO_PATT_OPT
   | CT_omega
   | CT_orelse of ct_TACTIC_COM * ct_TACTIC_COM
   | CT_parallel of ct_TACTIC_COM * ct_TACTIC_COM list
@@ -679,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_replace_with of ct_FORMULA * ct_FORMULA * ct_ID_OPT * ct_TACTIC_OPT
   | CT_rewrite_lr of ct_FORMULA * ct_SPEC_LIST * ct_ID_OPT
   | CT_rewrite_rl of ct_FORMULA * ct_SPEC_LIST * ct_ID_OPT
   | CT_right of ct_SPEC_LIST
diff --git a/contrib/interface/blast.ml b/contrib/interface/blast.ml
index d5236a7a..21f977f1 100755..100644
--- a/contrib/interface/blast.ml
+++ b/contrib/interface/blast.ml
@@ -1,13 +1,11 @@
 (* Une tactique qui tente de démontrer toute seule le but courant,
    interruptible par pcoq (si dans le fichier C:\WINDOWS\free il y a un A)
 *)
-open Ctast;;
 open Termops;;
 open Nameops;;
 open Auto;;
 open Clenv;;
 open Command;;
-open Ctast;;
 open Declarations;;
 open Declare;;
 open Eauto;;
@@ -38,7 +36,6 @@ open Typing;;
 open Util;;
 open Vernacentries;;
 open Vernacinterp;;
-open Evar_refiner;;
 
 
 let parse_com   = Pcoq.parse_string Pcoq.Constr.constr;;
@@ -94,7 +91,7 @@ let rec def_const_in_term_rec vl x =
           def_const_in_term_rec vl (mkInd (inductive_of_constructor c))
    | Case(_,x,t,a) 
         -> def_const_in_term_rec vl x
-   | Cast(x,t)-> def_const_in_term_rec vl t
+   | Cast(x,_,t)-> def_const_in_term_rec vl t
    | Const(c)  -> def_const_in_term_rec vl (lookup_constant c vl).const_type
    | _ -> def_const_in_term_rec vl (type_of vl Evd.empty x)
 ;;
@@ -113,7 +110,7 @@ let rec print_info_script sigma osign pf =
   match pf.ref with
     | None -> (mt ())
     | Some(r,spfl) ->
-        pr_rule r ++
+        Tactic_printer.pr_rule r ++
            match spfl with
              | [] ->
 		   (str " " ++ fnl())
@@ -152,8 +149,7 @@ let pp_string x =
 (***************************************************************************)
 
 let unify_e_resolve  (c,clenv) gls = 
-  let (wc,kONT) = startWalk gls in
-  let clenv' = connect_clenv wc clenv in
+  let clenv' = connect_clenv gls clenv in
   let _ = clenv_unique_resolver false clenv' gls in
   vernac_e_resolve_constr c gls
 
@@ -179,7 +175,7 @@ and e_my_find_search db_list local_db hdc concl =
       list_map_append (Hint_db.map_auto (hdc,concl)) (local_db::db_list)
   in 
   let tac_of_hint = 
-    fun ({pri=b; pat = p; code=t} as patac) -> 
+    fun ({pri=b; pat = p; code=t} as _patac) -> 
       (b, 
        let tac =
 	 match t with
@@ -189,7 +185,7 @@ and e_my_find_search db_list local_db hdc concl =
 	   | Res_pf_THEN_trivial_fail (term,cl) ->
                tclTHEN (unify_e_resolve (term,cl)) 
 		 (e_trivial_fail_db db_list local_db)
-	   | Unfold_nth c -> unfold_constr c
+	   | Unfold_nth c -> unfold_in_concl [[],c]
 	   | Extern tacast -> Auto.conclPattern concl 
 	       (out_some p) tacast
        in 
@@ -341,7 +337,7 @@ let e_breadth_search debug n db_list local_db gl =
   with Not_found -> error "EAuto: breadth first search failed"
 
 let e_search_auto debug (n,p) db_list gl = 
-  let local_db = make_local_hint_db gl in 
+  let local_db = make_local_hint_db [] gl in 
   if n = 0 then 
     e_depth_search debug p db_list local_db gl
   else 
@@ -351,17 +347,17 @@ let eauto debug np dbnames =
   let db_list =
     List.map
       (fun x -> 
-	 try Stringmap.find x !searchtable
+	 try searchtable_map x
 	 with Not_found -> error ("EAuto: "^x^": No such Hint database"))
       ("core"::dbnames) 
   in
   tclTRY (e_search_auto debug np db_list)
 
 let full_eauto debug n gl = 
-  let dbnames = stringmap_dom !searchtable in
+  let dbnames = current_db_names () in
   let dbnames =  list_subtract dbnames ["v62"] in
-  let db_list = List.map (fun x -> Stringmap.find x !searchtable) dbnames in
-  let local_db = make_local_hint_db gl in
+  let db_list = List.map searchtable_map dbnames in
+  let _local_db = make_local_hint_db [] gl in
   tclTRY (e_search_auto debug n db_list) gl
 
 let my_full_eauto n gl = full_eauto false (n,0) gl
@@ -369,8 +365,6 @@ let my_full_eauto n gl = full_eauto false (n,0) gl
 (**********************************************************************
    copié de tactics/auto.ml on a juste modifié search_gen
 *)
-let searchtable_map name = 
-  Stringmap.find name !searchtable
 
 (* local_db is a Hint database containing the hypotheses of current goal *)
 (* Papageno : cette fonction a été pas mal simplifiée depuis que la base
@@ -397,7 +391,7 @@ and my_find_search db_list local_db hdc concl =
       	(local_db::db_list)
   in
   List.map 
-    (fun ({pri=b; pat=p; code=t} as patac) -> 
+    (fun ({pri=b; pat=p; code=t} as _patac) -> 
        (b,
 	match t with
 	  | Res_pf (term,cl)  -> unify_resolve (term,cl)
@@ -407,7 +401,7 @@ and my_find_search db_list local_db hdc concl =
 	      tclTHEN 
 		(unify_resolve (term,cl)) 
 		(trivial_fail_db db_list local_db)
-	  | Unfold_nth c -> unfold_constr c
+	  | Unfold_nth c -> unfold_in_concl [[],c]
 	  | Extern tacast -> 
 	      conclPattern concl (out_some p) tacast))
     tacl
@@ -476,7 +470,7 @@ let rec search_gen decomp n db_list local_db extra_sign goal =
 	   try 
 	     [make_apply_entry (pf_env g') (project g')
 		(true,false) 
-		hid (mkVar hid,body_of_type htyp)]
+		(mkVar hid,body_of_type htyp)]
 	   with Failure _ -> [] 
 	 in
          (free_try
@@ -499,11 +493,11 @@ let search = search_gen 0
 let default_search_depth = ref 5
 			     
 let full_auto n gl = 
-  let dbnames = stringmap_dom !searchtable in
+  let dbnames = current_db_names () in
   let dbnames = list_subtract dbnames ["v62"] in
-  let db_list = List.map (fun x -> searchtable_map x) dbnames in
+  let db_list = List.map searchtable_map dbnames in
   let hyps = pf_hyps gl in
-  tclTRY (search n db_list (make_local_hint_db gl) hyps) gl
+  tclTRY (search n db_list (make_local_hint_db [] gl) hyps) gl
   
 let default_full_auto gl = full_auto !default_search_depth gl
 (************************************************************************)
@@ -568,7 +562,7 @@ let blast gls =
       open_subgoals = 1;
       goal = g;
       ref = None } in
-     try (let (sgl,v) as res = !blast_tactic gls in
+     try (let (sgl,v) as _res = !blast_tactic gls in
 	  let {it=lg} = sgl in
           if lg = [] 
           then (let pf = v (List.map leaf (sig_it sgl)) in
@@ -590,7 +584,7 @@ let blast gls =
 ;;
 
 let blast_tac display_function = function 
-          | (n::_) as l -> 
+          | (n::_) as _l -> 
                  (function g ->
                     let exp_ast = (blast g) in
                      (display_function exp_ast;
@@ -599,7 +593,7 @@ let blast_tac display_function = function
 
 let blast_tac_txt = 
   blast_tac
-    (function x -> msgnl(Pptactic.pr_glob_tactic (Tacinterp.glob_tactic x)));;
+    (function x -> msgnl(Pptactic.pr_glob_tactic (Global.env()) (Tacinterp.glob_tactic x)));;
 
 (* Obsolète ?
 overwriting_add_tactic "Blast1" blast_tac_txt;;
diff --git a/contrib/interface/blast.mli b/contrib/interface/blast.mli
index 21c29bc9..f6701943 100644
--- a/contrib/interface/blast.mli
+++ b/contrib/interface/blast.mli
@@ -1,5 +1,3 @@
 val blast_tac : (Tacexpr.raw_tactic_expr -> 'a) ->
-    int list ->
-    Proof_type.goal Tacmach.sigma ->
-    Proof_type.goal list Proof_type.sigma * Proof_type.validation;;
+    int list -> Proof_type.tactic
 
diff --git a/contrib/interface/centaur.ml4 b/contrib/interface/centaur.ml4
index 7bf12f3b..8fcdb5d9 100644
--- a/contrib/interface/centaur.ml4
+++ b/contrib/interface/centaur.ml4
@@ -4,7 +4,6 @@
 open Names;;
 open Nameops;;
 open Util;;
-open Ast;;
 open Term;;
 open Pp;;
 open Libnames;;
@@ -13,7 +12,6 @@ open Library;;
 open Vernacinterp;;
 open Evd;;
 open Proof_trees;;
-open Termast;;
 open Tacmach;;
 open Pfedit;;
 open Proof_type;;
@@ -28,7 +26,6 @@ open Vernacinterp;;
 open Vernac;;
 open Command;;
 open Protectedtoplevel;;
-open Coqast;;
 open Line_oriented_parser;;
 open Xlate;;
 open Vtp;;
@@ -283,15 +280,12 @@ let print_check judg =
  let value_ct_ast = 
      (try translate_constr false (Global.env()) value 
       with UserError(f,str) ->
-           raise(UserError(f,
-			   Ast.print_ast 
-				(ast_of_constr true (Global.env()) value) ++
+           raise(UserError(f,Printer.pr_lconstr value ++
 			      fnl () ++ str ))) in
  let type_ct_ast =
      (try translate_constr false (Global.env()) typ
       with UserError(f,str) ->
-           raise(UserError(f, Ast.print_ast (ast_of_constr true (Global.env())
-					       value) ++ fnl() ++ str))) in
+           raise(UserError(f, Printer.pr_lconstr value ++ fnl() ++ str))) in
  ((ctf_SearchResults !global_request_id),
  (Some  (P_pl
   (CT_premises_list
@@ -315,18 +309,6 @@ and ntyp = nf_betaiota typ in
 
 
 
-(* The following function is copied from globpr in env/printer.ml *)
-let globcv x =
-    match x with
-      | Node(_,"MUTIND", (Path(_,sp))::(Num(_,tyi))::_) ->
-	    convert_qualid
-	      (Nametab.shortest_qualid_of_global Idset.empty (IndRef(sp,tyi)))
-      | Node(_,"MUTCONSTRUCT",(Path(_,sp))::(Num(_,tyi))::(Num(_,i))::_) ->
-	  convert_qualid
-            (Nametab.shortest_qualid_of_global Idset.empty
-	       (ConstructRef ((sp, tyi), i)))
-  | _ -> failwith "globcv : unexpected value";;
-
 let pbp_tac_pcoq =
     pbp_tac (function (x:raw_tactic_expr) -> 
       output_results
@@ -360,12 +342,13 @@ let debug_tac2_pcoq tac =
 	let the_ast = ref tac in
 	let the_path = ref ([] : int list) in
 	try
-	  let result = report_error tac the_goal the_ast the_path [] g in
+	  let _result = report_error tac the_goal the_ast the_path [] g in
 	  (errorlabstrm "DEBUG TACTIC"
-	     (str "no error here " ++ fnl () ++ pr_goal (sig_it g) ++
+	     (str "no error here " ++ fnl () ++ Printer.pr_goal (sig_it g) ++
 	      fnl () ++ str "the tactic is" ++ fnl () ++
-	      Pptactic.pr_glob_tactic tac);
-	   result)
+	      Pptactic.pr_glob_tactic (Global.env()) tac) (*
+Caution, this is in the middle of what looks like dead code. ;
+	   result *))
 	with
 	  e ->
 	    match !the_goal with
@@ -413,11 +396,11 @@ 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 kn in
+			 let {const_type=typ} = Global.lookup_constant (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))
-			   (Pretyping.understand Evd.empty (Global.env())
+			   (Pretyping.Default.understand Evd.empty (Global.env())
 			      (RRef(dummy_loc, IndRef(kn,0))))
 		     | _ -> failwith ("unexpected value 1 for "^ 
 				      (string_of_id (basename (fst oname)))))
@@ -571,11 +554,11 @@ let pcoq_search s l =
 
 (* Check sequentially whether the pattern is one of the premises *)
 let rec hyp_pattern_filter pat name a c =
-  let c1 = strip_outer_cast c in
+  let _c1 = strip_outer_cast c in
     match kind_of_term c with
       | Prod(_, hyp, c2) -> 
 	  (try
-(*	     let _ = msgnl ((str "WHOLE ") ++ (Printer.prterm c)) in
+(*	     let _ = msgnl ((str "WHOLE ") ++ (Printer.pr_lconstr c)) in
              let _ = msgnl ((str "PAT ") ++ (Printer.pr_pattern pat)) in *)
              if Matching.is_matching pat hyp then
 	       (msgnl (str "ok"); true)
@@ -616,7 +599,7 @@ let pcoq_show_goal = function
   | Some n -> show_nth n
   | None ->
       if !pcoq_started = Some true (* = debug *) then
-	msg (Pfedit.pr_open_subgoals ())
+	msg (Printer.pr_open_subgoals ())
       else errorlabstrm "show_goal"
 	(str "Show must be followed by an integer in Centaur mode");;
 
@@ -632,17 +615,17 @@ let pcoq_hook = {
 }
 
 
-TACTIC EXTEND Pbp
-| [ "Pbp" ident_opt(idopt) natural_list(nl) ] -> 
+TACTIC EXTEND pbp
+| [ "pbp" ident_opt(idopt) natural_list(nl) ] -> 
     [ if_pcoq pbp_tac_pcoq idopt nl ]
 END
 
-TACTIC EXTEND CtDebugTac
-| [ "DebugTac" tactic(t) ] -> [ if_pcoq debug_tac2_pcoq (fst t) ]
+TACTIC EXTEND ct_debugtac
+| [ "debugtac" tactic(t) ] -> [ if_pcoq debug_tac2_pcoq (fst t) ]
 END
 
-TACTIC EXTEND CtDebugTac2
-| [ "DebugTac2" tactic(t) ] -> [ if_pcoq debug_tac2_pcoq (fst t) ]
+TACTIC EXTEND ct_debugtac2
+| [ "debugtac2" tactic(t) ] -> [ if_pcoq debug_tac2_pcoq (fst t) ]
 END
 
 
diff --git a/contrib/interface/ctast.ml b/contrib/interface/ctast.ml
deleted file mode 100644
index 67279bb8..00000000
--- a/contrib/interface/ctast.ml
+++ /dev/null
@@ -1,76 +0,0 @@
-(* A copy of pre V7 ast *)
-
-open Names
-open Libnames
-
-type loc = Util.loc
-
-type t =
-  | Node of loc * string * t list
-  | Nvar of loc * string
-  | Slam of loc * string option * t
-  | Num of loc * int
-  | Id of loc * string
-  | Str of loc * string
-  | Path of loc * string list
-  | Dynamic of loc * Dyn.t
-
-let section_path sl =
-  match List.rev sl with
-    | s::pa ->
-	Libnames.encode_kn
-	  (make_dirpath (List.map id_of_string pa))
-	  (id_of_string s)
-    | [] -> invalid_arg "section_path"
-
-let is_meta s = String.length s > 0 && s.[0] == '$'
-
-let purge_str s =
-  if String.length s == 0 || s.[0] <> '$' then s
-  else String.sub s 1 (String.length s - 1)
-
-let rec ct_to_ast = function
-  | Node (loc,a,b) -> Coqast.Node (loc,a,List.map ct_to_ast b)
-  | Nvar (loc,a) ->
-      if is_meta a then Coqast.Nmeta (loc,purge_str a)
-      else Coqast.Nvar (loc,id_of_string a)
-  | Slam (loc,Some a,b) ->
-      if is_meta a then Coqast.Smetalam (loc,purge_str a,ct_to_ast b)
-      else Coqast.Slam (loc,Some (id_of_string a),ct_to_ast b)
-  | Slam (loc,None,b) -> Coqast.Slam (loc,None,ct_to_ast b)
-  | Num (loc,a) -> Coqast.Num (loc,a)
-  | Id (loc,a) -> Coqast.Id (loc,a)
-  | Str (loc,a) -> Coqast.Str (loc,a)
-  | Path (loc,sl) -> Coqast.Path (loc,section_path sl)
-  | Dynamic (loc,a) -> Coqast.Dynamic (loc,a)
-
-let rec ast_to_ct = function x -> failwith "ast_to_ct: not TODO?"
-(*
-  | Coqast.Node (loc,a,b) -> Node (loc,a,List.map ast_to_ct b)
-  | Coqast.Nvar (loc,a) -> Nvar (loc,string_of_id a)
-  | Coqast.Nmeta (loc,a) -> Nvar (loc,"$"^a)
-  | Coqast.Slam (loc,Some a,b) ->
-   Slam (loc,Some (string_of_id a),ast_to_ct b)
-  | Coqast.Slam (loc,None,b) -> Slam (loc,None,ast_to_ct b)
-  | Coqast.Smetalam (loc,a,b) -> Slam (loc,Some ("$"^a),ast_to_ct b)
-  | Coqast.Num (loc,a) -> Num (loc,a)
-  | Coqast.Id (loc,a) -> Id (loc,a)
-  | Coqast.Str (loc,a) -> Str (loc,a)
-  | Coqast.Path (loc,a) ->
-    let (sl,bn) = Libnames.decode_kn a in
-    Path(loc, (List.map string_of_id
-                (List.rev (repr_dirpath sl))) @ [string_of_id bn])
-  | Coqast.Dynamic (loc,a) -> Dynamic (loc,a)
-*)
-
-let loc = function
-  | Node (loc,_,_) -> loc
-  | Nvar (loc,_) -> loc
-  | Slam (loc,_,_) -> loc
-  | Num (loc,_) -> loc
-  | Id (loc,_) -> loc
-  | Str (loc,_) -> loc
-  | Path (loc,_) -> loc
-  | Dynamic (loc,_) -> loc
-
-let str s = Str(Util.dummy_loc,s)
diff --git a/contrib/interface/dad.ml b/contrib/interface/dad.ml
index ec989296..578abc49 100644
--- a/contrib/interface/dad.ml
+++ b/contrib/interface/dad.ml
@@ -251,7 +251,7 @@ let rec sort_list = function
 let mk_dad_meta n = CPatVar (zz,(true,Nameops.make_ident "DAD" (Some n)));;
 let mk_rewrite lr ast =
   let b = in_gen rawwit_bool lr in
-  let cb = in_gen rawwit_constr_with_bindings ((*Ctast.ct_to_ast*) ast,NoBindings) in
+  let cb = in_gen rawwit_constr_with_bindings (ast,NoBindings) in
   TacExtend (zz,"Rewrite",[b;cb])
 
 open Vernacexpr
diff --git a/contrib/interface/debug_tac.ml4 b/contrib/interface/debug_tac.ml4
index bf596b28..56abfb82 100644
--- a/contrib/interface/debug_tac.ml4
+++ b/contrib/interface/debug_tac.ml4
@@ -1,7 +1,5 @@
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-open Ast;;
-open Coqast;;
 open Tacmach;;
 open Tacticals;;
 open Proof_trees;;
@@ -12,6 +10,8 @@ open Proof_type;;
 open Tacexpr;;
 open Genarg;;
 
+let pr_glob_tactic = Pptactic.pr_glob_tactic (Global.env())
+
 (* Compacting and uncompacting proof commands *)
 
 type report_tree =
@@ -72,11 +72,6 @@ let check_subgoals_count2
 	 Recursive_fail (List.hd !new_report_holder)));
     result;;
 
-(*
-let traceable = function
-    Node(_, "TACTICLIST", a::b::tl) -> true
-  | _ -> false;;
-*)
 let traceable = function
   | TacThen _ | TacThens _ -> true
   | _ -> false;;
@@ -116,25 +111,6 @@ let count_subgoals2
     result;;
 
 let rec local_interp : glob_tactic_expr -> report_holder -> tactic = function
-(*
-    Node(_, "TACTICLIST", [a;Node(_, "TACLIST", l)]) ->
-      (fun report_holder -> checked_thens report_holder a l)
-  | Node(_, "TACTICLIST", a::((Node(_, "TACLIST", l))as b)::c::tl) ->
-      local_interp(ope ("TACTICLIST", (ope("TACTICLIST", [a;b]))::c::tl))
-  | Node(_, "TACTICLIST", [a;b]) ->
-      (fun report_holder -> checked_then report_holder a b)
-  | Node(_, "TACTICLIST", a::b::c::tl) ->
-	local_interp(ope ("TACTICLIST", (ope("TACTICLIST", [a;b]))::c::tl))
-  | ast ->
-      (fun report_holder g ->
-	try
-	  let (gls, _) as result = Tacinterp.interp ast g in
-	  report_holder := (Report_node(true, List.length (sig_it gls), []))
-			    ::!report_holder;
-	  result
-	with e -> (report_holder := (Failed 1)::!report_holder;
-		   tclIDTAC g))
-*)
     TacThens (a,l) ->
       (fun report_holder -> checked_thens report_holder a l)
   | TacThen (a,b) ->
@@ -263,9 +239,14 @@ and checked_then: report_holder -> glob_tactic_expr -> glob_tactic_expr -> tacti
    by the list of integers given as extra arguments.
  *)
 
+let rawwit_main_tactic = rawwit_tactic Pcoq.Tactic.tactic_main_level
+let globwit_main_tactic = globwit_tactic Pcoq.Tactic.tactic_main_level
+let wit_main_tactic = wit_tactic Pcoq.Tactic.tactic_main_level
+
+
 let on_then = function [t1;t2;l] ->
-  let t1 = out_gen wit_tactic t1 in
-  let t2 = out_gen wit_tactic t2 in
+  let t1 = out_gen wit_main_tactic t1 in
+  let t2 = out_gen wit_main_tactic t2 in
   let l = out_gen (wit_list0 wit_int) l in
   tclTHEN_i (Tacinterp.eval_tactic t1)
     (fun i ->
@@ -276,78 +257,18 @@ let on_then = function [t1;t2;l] ->
   | _ -> anomaly "bad arguments for on_then";;
 
 let mkOnThen t1 t2 selected_indices =
-  let a = in_gen rawwit_tactic t1 in
-  let b = in_gen rawwit_tactic t2 in
+  let a = in_gen rawwit_main_tactic t1 in
+  let b = in_gen rawwit_main_tactic t2 in
   let l = in_gen (wit_list0 rawwit_int) selected_indices in
   TacAtom (dummy_loc, TacExtend (dummy_loc, "OnThen", [a;b;l]));;
 
 (* Analyzing error reports *)
 
-(*
-let rec select_success n = function
-    [] -> []
-  | Report_node(true,_,_)::tl -> (Num((0,0),n))::select_success (n+1) tl
-  | _::tl -> select_success (n+1) tl;;
-*)
 let rec select_success n = function
     [] -> []
   | Report_node(true,_,_)::tl -> n::select_success (n+1) tl
   | _::tl -> select_success (n+1) tl;;
 
-(*
-let rec expand_tactic = function
-    Node(loc1, "TACTICLIST", [a;Node(loc2,"TACLIST", l)]) ->
-      Node(loc1, "TACTICLIST",
-	   [expand_tactic a;
-	     Node(loc2, "TACLIST", List.map expand_tactic l)])
-  | Node(loc1, "TACTICLIST", a::((Node(loc2, "TACLIST", l))as b)::c::tl) ->
-      expand_tactic (Node(loc1, "TACTICLIST",
-			  (Node(loc1, "TACTICLIST", [a;b]))::c::tl))
-  | Node(loc1, "TACTICLIST", [a;b]) ->
-      Node(loc1, "TACTICLIST",[expand_tactic a;expand_tactic b])
-  | Node(loc1, "TACTICLIST", a::b::c::tl) ->
-      expand_tactic (Node(loc1, "TACTICLIST",
-			  (Node(loc1, "TACTICLIST", [a;b]))::c::tl))
-  | any -> any;;
-*)
-(* Useless: already in binary form...
-let rec expand_tactic = function
-    TacThens (a,l) -> TacThens (expand_tactic a, List.map expand_tactic l)
-  | TacThen (a,b) -> TacThen (expand_tactic a, expand_tactic b)
-  | any -> any;;
-*)
-
-(*
-let rec reconstruct_success_tac ast = 
-  match ast with
-    Node(_, "TACTICLIST", [a;Node(_,"TACLIST",l)]) ->
-      (function 
-	  Report_node(true, n, l) -> ast
-      	| Report_node(false, n, rl) ->
-	    ope("TACTICLIST",[a;ope("TACLIST", 
-				    List.map2 reconstruct_success_tac l rl)])
-      	| Failed n -> ope("Idtac",[])
-      	| Tree_fail r -> reconstruct_success_tac a r
-      	| Mismatch (n,p) -> a)
-  | Node(_, "TACTICLIST", [a;b]) ->
-      (function
-	  Report_node(true, n, l) -> ast
-	| Report_node(false, n, rl) ->
-	    let selected_indices = select_success 1 rl in
-	    ope("OnThen", a::b::selected_indices)
-	| Failed n -> ope("Idtac",[])
-	| Tree_fail r -> reconstruct_success_tac a r
-	| _ -> error "this error case should not happen in a THEN tactic")
-  | _ -> 
-      (function
-	  Report_node(true, n, l) -> ast
-	| Failed n -> ope("Idtac",[])
-	| _ ->
-	    errorlabstrm
-	      "this error case should not happen on an unknown tactic"
-              (str "error in reconstruction with " ++ fnl () ++
-	       (gentacpr ast)));;
-*)
 let rec reconstruct_success_tac (tac:glob_tactic_expr) =
   match tac with
     TacThens (a,l) ->
@@ -355,7 +276,7 @@ let rec reconstruct_success_tac (tac:glob_tactic_expr) =
 	  Report_node(true, n, l) -> tac
       	| Report_node(false, n, rl) ->
 	    TacThens (a,List.map2 reconstruct_success_tac l rl)
-      	| Failed n -> TacId ""
+      	| Failed n -> TacId []
       	| Tree_fail r -> reconstruct_success_tac a r
       	| Mismatch (n,p) -> a)
   | TacThen (a,b) ->
@@ -364,16 +285,16 @@ let rec reconstruct_success_tac (tac:glob_tactic_expr) =
 	| Report_node(false, n, rl) ->
 	    let selected_indices = select_success 1 rl in
 	    TacAtom (dummy_loc,TacExtend (dummy_loc,"OnThen",
-	      [in_gen globwit_tactic a;
-	       in_gen globwit_tactic b;
+	      [in_gen globwit_main_tactic a;
+	       in_gen globwit_main_tactic b;
 	       in_gen (wit_list0 globwit_int) selected_indices]))
-	| Failed n -> TacId ""
+	| Failed n -> TacId []
 	| Tree_fail r -> reconstruct_success_tac a r
 	| _ -> error "this error case should not happen in a THEN tactic")
   | _ -> 
       (function
 	  Report_node(true, n, l) -> tac
-	| Failed n -> TacId ""
+	| Failed n -> TacId []
 	| _ ->
 	    errorlabstrm
 	      "this error case should not happen on an unknown tactic"
@@ -391,21 +312,6 @@ let rec path_to_first_error = function
     p::(path_to_first_error t)
 | _ -> [];;
 
-(*
-let rec flatten_then_list tail = function
-  | Node(_, "TACTICLIST", [a;b]) ->
-      flatten_then_list ((flatten_then b)::tail) a
-  | ast -> ast::tail
-and flatten_then = function
-    Node(_, "TACTICLIST", [a;b]) ->
-      ope("TACTICLIST", flatten_then_list [flatten_then b] a)
-  | Node(_, "TACLIST", l) ->
-      ope("TACLIST", List.map flatten_then l)
-  | Node(_, "OnThen", t1::t2::l) ->
-      ope("OnThen", (flatten_then t1)::(flatten_then t2)::l)
-  | ast -> ast;;
-*)
-
 let debug_tac = function
     [(Tacexp ast)] ->
       (fun g -> 
@@ -430,26 +336,8 @@ let debug_tac = function
 add_tactic "DebugTac" debug_tac;;
 *)
 
-(*
-hide_tactic "OnThen" on_then;;
-*)
 Refiner.add_tactic "OnThen" on_then;;
 
-(*
-let rec clean_path p ast l = 
-  match ast, l with
-    Node(_, "TACTICLIST", ([_;_] as tacs)), fst::tl ->
-       fst::(clean_path 0 (List.nth tacs (fst - 1)) tl)
-  | Node(_, "TACTICLIST", tacs), 2::tl ->
-     let rank = (List.length tacs) - p in
-     rank::(clean_path 0 (List.nth tacs (rank - 1)) tl)
-  | Node(_, "TACTICLIST", tacs), 1::tl ->
-      clean_path (p+1) ast tl
-  | Node(_, "TACLIST", tacs), fst::tl ->
-      fst::(clean_path 0 (List.nth tacs (fst - 1)) tl)
-  | _, [] -> []
-  | _, _ -> failwith "this case should not happen in clean_path";;
-*)
 let rec clean_path tac l = 
   match tac, l with
   | TacThen (a,b), fst::tl ->
@@ -554,8 +442,8 @@ let descr_first_error tac =
 	    (msgnl (str "Execution of this tactic raised message " ++ fnl () ++
 		    fnl () ++ Cerrors.explain_exn e ++ fnl () ++
 		    fnl () ++ str "on goal"  ++ fnl () ++
-		    pr_goal (sig_it (strip_some !the_goal)) ++ fnl () ++
-		    str "faulty tactic is" ++ fnl () ++ fnl () ++
+		    Printer.pr_goal (sig_it (strip_some !the_goal)) ++
+                    fnl () ++ str "faulty tactic is" ++ fnl () ++ fnl () ++
 		    pr_glob_tactic ((*flatten_then*) !the_ast) ++ fnl ());
 	     tclIDTAC g))
 
diff --git a/contrib/interface/debug_tac.mli b/contrib/interface/debug_tac.mli
index ded714b6..da4bbaa0 100644
--- a/contrib/interface/debug_tac.mli
+++ b/contrib/interface/debug_tac.mli
@@ -1,6 +1,6 @@
 
 val report_error : Tacexpr.glob_tactic_expr ->
-    Proof_type.goal Proof_type.sigma option ref ->
+    Proof_type.goal Evd.sigma option ref ->
     Tacexpr.glob_tactic_expr ref -> int list ref -> int list -> Tacmach.tactic;;
 
 val clean_path : Tacexpr.glob_tactic_expr -> int list -> int list;;
diff --git a/contrib/interface/line_parser.ml4 b/contrib/interface/line_parser.ml4
index b5669351..0b13a092 100755
--- a/contrib/interface/line_parser.ml4
+++ b/contrib/interface/line_parser.ml4
@@ -84,7 +84,7 @@ let rec string len = parser
    spaces and tabulations are ignored, identifiers, integers,
    strings, opening and closing square brackets.  Lexical errors are
    ignored ! *)
-let rec next_token = parser count
+let rec next_token = parser _count
   [< '' ' | '\t'; tok = next_token >] -> tok
 | [< ''_' | 'a'..'z' | 'A'..'Z' as c;i = (ident (add_in_buff 0 c))>] -> i
 | [< ''0'..'9' as c ; i = (parse_int (get_digit c))>] -> i
@@ -96,7 +96,7 @@ let rec next_token = parser count
 (* A very simple lexical analyser to recognize a integer value behind 
    blank characters *)
 
-let rec next_int = parser count
+let rec next_int = parser _count
   [< '' ' | '\t'; v = next_int >] -> v
 | [< ''0'..'9' as c; i = (parse_int (get_digit c))>] ->
      (match i with
diff --git a/contrib/interface/name_to_ast.ml b/contrib/interface/name_to_ast.ml
index eaff0968..b06ba199 100644
--- a/contrib/interface/name_to_ast.ml
+++ b/contrib/interface/name_to_ast.ml
@@ -2,9 +2,6 @@ open Sign;;
 open Classops;;
 open Names;;
 open Nameops
-open Coqast;;
-open Ast;;
-open Termast;;
 open Term;;
 open Impargs;;
 open Reduction;;
@@ -90,13 +87,6 @@ let implicit_args_to_ast_list sp mipv =
 	  [] -> []
 	| _ -> [VernacComments (List.rev implicit_args_descriptions)];;
 	      
-let convert_qualid qid =
-  let d, id = Libnames.repr_qualid qid in
-    match repr_dirpath d with
-	[] -> nvar id
-      | d -> ope("QUALID", List.fold_left (fun l s -> (nvar s)::l)
-		   [nvar id] d);;
-
 (* This function converts constructors for an inductive definition to a
    Coqast.t.  It is obtained directly from print_constructors in pretty.ml *)
 
@@ -142,16 +132,6 @@ let implicits_to_ast_list implicits =
     | None -> []
     | Some s -> [VernacComments [CommentString s]];;
 
-(*
-let make_variable_ast name typ implicits =
-   (ope("VARIABLE",
-    [string "VARIABLE";
-     ope("BINDERLIST",
-         [ope("BINDER",
-            [(constr_to_ast (body_of_type typ));
-             nvar name])])]))::(implicits_to_ast_list implicits)
-    ;;
-*)
 let make_variable_ast name typ implicits =
   (VernacAssumption
     ((Local,Definitional),
@@ -160,7 +140,7 @@ let make_variable_ast name typ implicits =
     
 
 let make_definition_ast name c typ implicits =
-  VernacDefinition ((Global,Definition), (dummy_loc,name), DefineBody ([], None,
+  VernacDefinition ((Global,false,Definition), (dummy_loc,name), DefineBody ([], None,
     (constr_to_ast c), Some (constr_to_ast (body_of_type typ))),
     (fun _ _ -> ()))
   ::(implicits_to_ast_list implicits);;
@@ -173,9 +153,9 @@ let constant_to_ast_list kn =
   let l = implicits_of_global (ConstRef kn) in
   (match c with
       None -> 
-	make_variable_ast (id_of_label (label kn)) typ l
+	make_variable_ast (id_of_label (con_label kn)) typ l
     | Some c1 ->
-	make_definition_ast (id_of_label (label kn)) (Declarations.force c1) typ l)
+	make_definition_ast (id_of_label (con_label kn)) (Declarations.force c1) typ l)
 
 let variable_to_ast_list sp =
   let (id, c, v) = get_variable sp in
@@ -198,7 +178,7 @@ let leaf_entry_to_ast_list ((sp,kn),lobj) =
   let tag = object_tag lobj in
   match tag with
   | "VARIABLE" -> variable_to_ast_list (basename sp)
-  | "CONSTANT" -> constant_to_ast_list kn
+  | "CONSTANT" -> constant_to_ast_list (constant_of_kn kn)
   | "INDUCTIVE" -> inductive_to_ast_list kn
   | s -> 
       errorlabstrm 
@@ -240,7 +220,7 @@ let name_to_ast ref =
 		   | Some c1 -> make_definition_ast name c1 typ [])
 	  with Not_found ->
 	    try
-	      let sp = Nametab.locate_syntactic_definition qid in
+	      let _sp = Nametab.locate_syntactic_definition qid in
 		errorlabstrm "print"
       		  (str "printing of syntax definitions not implemented")
 	    with Not_found ->
diff --git a/contrib/interface/name_to_ast.mli b/contrib/interface/name_to_ast.mli
index 0eca0a1e..b8c2d7dc 100644
--- a/contrib/interface/name_to_ast.mli
+++ b/contrib/interface/name_to_ast.mli
@@ -1,2 +1 @@
 val name_to_ast : Libnames.reference -> Vernacexpr.vernac_expr;;
-val convert_qualid : Libnames.qualid -> Coqast.t;;
diff --git a/contrib/interface/parse.ml b/contrib/interface/parse.ml
index 3f0b2d2e..4d4df59f 100644
--- a/contrib/interface/parse.ml
+++ b/contrib/interface/parse.ml
@@ -48,55 +48,8 @@ let ctf_FileErrorMessage reqid pps =
   int reqid ++ fnl () ++ pps ++ fnl () ++ str "E-n-d---M-e-s-s-a-g-e" ++
   fnl ();;
 
-(*
-(*In the code for CoqV6.2, the require_module call is encapsulated in
-  a function "without_mes_ambig".  Here I have supposed that this
-  function has no effect on parsing *)
-let try_require_module import specif names =
- try Library.require_module 
-   (if specif = "UNSPECIFIED" then None
-    else Some (specif = "SPECIFICATION"))
-   (List.map 
-     (fun name ->
-       (dummy_loc,Libnames.make_short_qualid (Names.id_of_string name)))
-      names)
-   (import = "IMPORT")
- with
-   | e -> msgnl (str "Reinterning of " ++ prlist str names ++ str " failed");;
-*)
-(*
-let try_require_module_from_file import specif name fname =
- try Library.require_module_from_file (if specif = "UNSPECIFIED" then None
-  else Some (specif = "SPECIFICATION")) (Some (Names.id_of_string name)) fname (import = "IMPORT")
- with
- | e -> msgnl (str "Reinterning of " ++ str name ++ str " failed");;
-*)
-(*
-let execute_when_necessary ast =
- (match ast with
-  | Node (_, "GRAMMAR", ((Nvar (_, s)) :: ((Node (_, "ASTLIST", al)) :: []))) ->
-   Metasyntax.add_grammar_obj s (List.map Ctast.ct_to_ast al)
-(* Obsolete
-  | Node (_, "TOKEN", ((Str (_, s)) :: [])) -> Metasyntax.add_token_obj s
-*)
-  | Node (_, "Require",
-            ((Str (_, import)) ::
-              ((Str (_, specif)) :: l))) ->
-   let mnames = List.map (function
-     | (Nvar (_, m)) -> m
-     | _ -> error "parse_string_action : bad require expression") l in
-   try_require_module import specif mnames
-  | Node (_, "RequireFrom",
-            ((Str (_, import)) ::
-              ((Str (_, specif)) ::
-                ((Nvar (_, mname)) :: ((Str (_, file_name)) :: []))))) ->
-   try_require_module_from_file import specif mname file_name
-  | _ -> ()); ast;;
-*)
-
 let execute_when_necessary v =
  (match v with
-  | VernacGrammar _ -> Vernacentries.interp v
   | VernacOpenCloseScope sc -> Vernacentries.interp v
   | VernacRequire (_,_,l) ->
       (try 
@@ -202,12 +155,6 @@ let parse_command_list reqid stream string_list =
                 discard_to_dot stream;
                 msgnl (str "debug" ++ fnl () ++ int this_pos ++ fnl () ++
 		       int (Stream.count stream));
-(*
-                Some( Node(l, "PARSING_ERROR",
-                        List.map Ctast.str
-                        (get_substring_list string_list this_pos
-                            (Stream.count stream))))
-*)
 		ParseError ("PARSING_ERROR",
                   get_substring_list string_list this_pos
 		    (Stream.count stream))
@@ -216,27 +163,14 @@ let parse_command_list reqid stream string_list =
         | e-> 
           begin
             discard_to_dot stream;
-(*
-            Some(Node((0,0), "PARSING_ERROR2",
-                   List.map Ctast.str
-		   (get_substring_list string_list this_pos
-                     (Stream.count stream))))
-*)
 	    ParseError ("PARSING_ERROR2",
 	      get_substring_list string_list this_pos (Stream.count stream))
           end in
     match first_ast with
     | ParseOK (Some (loc,ast)) ->
-        let ast0 = (execute_when_necessary ast) in
+        let _ast0 = (execute_when_necessary ast) in
           (try xlate_vernac ast
 	  with e ->
-(*
-	    xlate_vernac 
-              (Node((0,0), "PARSING_ERROR2",
-               List.map Ctast.str
-		 (get_substring_list string_list this_pos
-		    (Stream.count stream)))))::parse_whole_stream()
-*)
 	    make_parse_error_item "PARSING_ERROR2" 
 		     (get_substring_list string_list this_pos
 		       (Stream.count stream)))::parse_whole_stream()
@@ -311,7 +245,7 @@ let parse_file_action reqid file_name =
         get the text when a syntax error occurs *)
      let file_chan_err = open_in file_name in 
      let stream = Stream.of_channel file_chan in
-     let stream_err = Stream.of_channel file_chan_err in
+     let _stream_err = Stream.of_channel file_chan_err in
      let rec discard_to_dot () =
        try Gram.Entry.parse parse_to_dot (Gram.parsable stream)
        with Stdpp.Exc_located(_,Token.Error _) -> discard_to_dot() in
@@ -345,7 +279,7 @@ let parse_file_action reqid file_name =
 		   
              with
                | ParseOK (Some (_,ast)) ->
-		   let ast0=(execute_when_necessary ast) in 
+		   let _ast0=(execute_when_necessary ast) in 
 		   let term =
                      (try xlate_vernac ast
 		      with e ->
@@ -395,13 +329,13 @@ let add_path_action reqid string_arg =
 
 let print_version_action () =
   msgnl (mt ());
-  msgnl (str "$Id: parse.ml,v 1.22 2004/04/21 08:36:58 barras Exp $");;
+  msgnl (str "$Id: parse.ml 7844 2006-01-11 16:36:14Z bertot $");;
 
 let load_syntax_action reqid module_name =
  msg (str "loading " ++ str module_name ++ str "... ");
  try
       (let qid = Libnames.make_short_qualid (Names.id_of_string module_name) in
-      read_library (dummy_loc,qid);
+      require_library [dummy_loc,qid] None;
       msg (str "opening... ");
       Declaremods.import_module false (Nametab.locate_module qid); 
       msgnl (str "done" ++ fnl ());
@@ -456,7 +390,6 @@ Libobject.relax true;
 	   coqdir [ "contrib"; "interface"; "vernacrc"] in
    try
      (Gramext.warning_verbose := false;
-      Esyntax.warning_verbose := false;
       coqparser_loop (open_in vernacrc))
    with
      | End_of_file -> ()
@@ -470,7 +403,7 @@ Libobject.relax true;
 (try let user_vernacrc =
    try Some(Sys.getenv "USERVERNACRC")
    with
-     | Not_found as e ->
+     | Not_found ->
 	 msgnl (str "no .vernacrc file"); None in
    (match user_vernacrc with
       	Some f -> coqparser_loop (open_in f)
diff --git a/contrib/interface/pbp.ml b/contrib/interface/pbp.ml
index e0f88ba6..d2f71bfc 100644
--- a/contrib/interface/pbp.ml
+++ b/contrib/interface/pbp.ml
@@ -34,13 +34,13 @@ let get_hyp_by_name g name =
   let evd = project g in
   let env = pf_env g in
   try (let judgment = 
-         Pretyping.understand_judgment 
+         Pretyping.Default.understand_judgment 
           evd env (RVar(zz, name)) in
        ("hyp",judgment.uj_type))
 (* je sais, c'est pas beau, mais je ne sais pas trop me servir de look_up...
    Loïc *)
   with _ -> (let c = Nametab.global (Ident (zz,name)) in
-             ("cste",type_of (Global.env()) Evd.empty (constr_of_reference c)))
+             ("cste",type_of (Global.env()) Evd.empty (constr_of_global c)))
 ;;
 
 type pbp_atom =
@@ -106,7 +106,7 @@ let make_final_cmd f optname clear_names constr path =
     add_clear_names_if_necessary (f optname constr path) clear_names;;
 
 let (rem_cast:pbp_rule) = function
-    (a,c,cf,o, Cast(f,_), p, func) ->
+    (a,c,cf,o, Cast(f,_,_), p, func) ->
       Some(func a c cf o (kind_of_term f) p)
   | _ -> None;;
 
@@ -154,7 +154,7 @@ let make_pbp_pattern x =
      [make_var (id_of_string ("Value_for_" ^ (string_of_id x)))]
 
 let rec make_then = function
-  | [] -> TacId ""
+  | [] -> TacId []
   | [t] -> t
   | t1::t2::l -> make_then (TacThen (t1,t2)::l)
 
@@ -177,7 +177,7 @@ let make_pbp_atomic_tactic = function
       TacAtom
 	(zz, TacElim ((make_var hyp_name,ExplicitBindings bind),None))
   | PbpTryClear l -> 
-      TacTry (TacAtom (zz, TacClear (List.map (fun s -> AI (zz,s)) l)))
+      TacTry (TacAtom (zz, TacClear (false,List.map (fun s -> AI (zz,s)) l)))
   | PbpSplit -> TacAtom (zz, TacSplit (false,NoBindings));;
 
 let rec make_pbp_tactic = function
@@ -203,7 +203,7 @@ let (imply_elim1: pbp_rule) = function
   Some h, Prod(Anonymous, prem, body), 1::path, f ->
   let clear_names' = if clear_flag then h::clear_names else clear_names in
   let h' = next_global_ident hyp_radix avoid in
-  let str_h' = (string_of_id h') in
+  let _str_h' = (string_of_id h') in
   Some(PbpThens
 	  ([PbpLApply h],
 	   [chain_tactics [make_named_intro h'] (make_clears (h::clear_names));
diff --git a/contrib/interface/pbp.mli b/contrib/interface/pbp.mli
index 43ec1274..9daba184 100644
--- a/contrib/interface/pbp.mli
+++ b/contrib/interface/pbp.mli
@@ -1,4 +1,2 @@
 val pbp_tac : (Tacexpr.raw_tactic_expr -> 'a) ->
-    Names.identifier option -> int list ->
-    Proof_type.goal Tacmach.sigma ->
-    Proof_type.goal list Proof_type.sigma * Proof_type.validation;;
+    Names.identifier option -> int list -> Proof_type.tactic
diff --git a/contrib/interface/showproof.ml b/contrib/interface/showproof.ml
index 5b265ec8..b7da5c1b 100644
--- a/contrib/interface/showproof.ml
+++ b/contrib/interface/showproof.ml
@@ -11,7 +11,6 @@ open Term
 open Termops
 open Util
 open Proof_type
-open Coqast
 open Pfedit
 open Translate
 open Term
@@ -54,7 +53,7 @@ and ngoal=
      {newhyp : nhyp list;
       t_concl : Term.constr;
       t_full_concl: Term.constr;
-      t_full_env: Sign.named_context}
+      t_full_env: Environ.named_context_val}
 and ntree=
       {t_info:string;
 	t_goal:ngoal;
@@ -151,7 +150,7 @@ let seq_to_lnhyp sign sign' cl =
       {newhyp=nh;
        t_concl=cl;
        t_full_concl=long_type_hyp !lh cl;
-       t_full_env = sign@sign'}
+       t_full_env = Environ.val_of_named_context (sign@sign')}
 ;;
 
 
@@ -163,26 +162,6 @@ let rule_is_complex r =
    |_ -> false
 ;;
 
-let ast_of_constr = Termast.ast_of_constr true (Global.env()) ;;
-
-(*
-let rule_to_ntactic r =
-   let rast =
-     (match r with
-       Tactic (s,l) ->
-	 Ast.ope (s,(List.map ast_of_cvt_arg l))
-     | Prim (Refine h) ->
-	 Ast.ope ("Exact",
-		  [Node ((0,0), "COMMAND", [ast_of_constr h])])
-     | _ -> Ast.ope ("Intros",[])) in
-   if rule_is_complex r
-   then (match rast with
-           Node(_,_,[Node(_,_,[Node(_,_,x)])]) ->x
-          | _ -> assert false)
-
-   else [rast ]
-;;
-*)
 let rule_to_ntactic r =
    let rt =
      (match r with
@@ -197,14 +176,6 @@ let rule_to_ntactic r =
    else rt
 ;;
 
-(*
-let term_of_command x =
-  match x with
-    Node(_,_,y::_) -> y
-  | _ -> x
-;;
-*)
-
 (* Attribue les preuves de la liste l aux sous-buts non-prouvés de nt  *)
 
 
@@ -226,7 +197,7 @@ let fill_unproved nt l =
 let new_sign osign sign =
     let res=ref [] in
     List.iter (fun (id,c,ty) ->
-		   try (let  (_,_,ty1)= (lookup_named id osign) in
+		   try (let  (_,_,_ty1)= (lookup_named id osign) in
 			())
 		   with Not_found -> res:=(id,c,ty)::(!res))
               sign;
@@ -247,6 +218,7 @@ let old_sign osign sign =
 let  to_nproof sigma osign pf =
   let rec to_nproof_rec sigma osign pf =
     let {evar_hyps=sign;evar_concl=cl} = pf.goal in
+    let sign = Environ.named_context_of_val sign in
     let nsign = new_sign osign sign in 
     let oldsign = old_sign osign sign in 
     match pf.ref with
@@ -417,13 +389,6 @@ let enumerate f ln =
 
 let constr_of_ast = Constrintern.interp_constr Evd.empty (Global.env());;
 
-(*
-let sp_tac tac =
-   try spt (constr_of_ast (term_of_command tac))
-   with _ -> (* let Node(_,t,_) = tac in *)
-             spe (* sps ("error in sp_tac " ^ t) *)
-;;
-*)
 let sp_tac tac = failwith "TODO"
 
 let soit_A_une_proposition nh ln t=  match !natural_language with
@@ -759,7 +724,7 @@ let rec nsortrec vl x =
           nsortrec vl (mkInd (inductive_of_constructor c))
    | Case(_,x,t,a) 
         -> nsortrec vl x
-   | Cast(x,t)-> nsortrec vl t
+   | Cast(x,_, t)-> nsortrec vl t
    | Const c  -> nsortrec vl (lookup_constant c vl).const_type
    | _ -> nsortrec vl (type_of vl Evd.empty x)
 ;;
@@ -791,7 +756,7 @@ let rec group_lhyp lh =
 let natural_ghyp (sort,ln,lt) intro =
   let t=List.hd lt in
   let nh=List.length ln in
-  let ns=List.hd ln in
+  let _ns=List.hd ln in
   match sort with
     Nprop -> soit_A_une_proposition nh ln t
   | Ntype -> soit_X_un_element_de_T nh ln t
@@ -963,16 +928,6 @@ let  natural_lhyp lh hi =
     Analyse des tactiques.
 *)
 
-(*
-let name_tactic tac =
-      match tac with
-        (Node(_,"Interp",
-		(Node(_,_,
-		      (Node(_,t,_))::_))::_))::_  -> t
-       |(Node(_,t,_))::_ -> t
-       | _ -> assert false
-;;
-*)
 let name_tactic = function
   | TacIntroPattern _ -> "Intro"
   | TacAssumption -> "Assumption"
@@ -991,51 +946,8 @@ let arg1_tactic tac =
 ;;
 *)
 
-let arg1_tactic tac = failwith "TODO"
-
-let arg2_tactic tac =
-   match tac with
-     (Node(_,"Interp",
-		(Node(_,_,
-		      (Node(_,_,_::x::_))::_))::_))::_ -> x
-    | (Node(_,_,_::x::_))::_ -> x
-    | _ -> assert false
-;;
-
-(*
-type nat_tactic =
-    Split of (Coqast.t list)
-  | Generalize of (Coqast.t list)
-  | Reduce of string*(Coqast.t list)
-  | Other of string*(Coqast.t list)
-;;
-
-let analyse_tac tac =
-  match tac with
-    [Node (_, "Split", [Node (_, "BINDINGS", [])])]
-      -> Split []
-  | [Node (_, "Split",[Node(_, "BINDINGS",[Node(_, "BINDING",
-	[Node (_, "COMMAND", x)])])])] 
-     -> Split x
-  | [Node (_, "Generalize", [Node (_, "COMMAND", x)])] 
-     ->Generalize x
-  | [Node (_, "Reduce", [Node (_, "REDEXP", [Node (_, mode, _)]);
-             Node (_, "CLAUSE", lhyp)])] 
-     -> Reduce(mode,lhyp)
-  | [Node (_, x,la)] -> Other (x,la)
-  | _ -> assert false
-;;
-*)
-      
-
-
+let arg1_tactic tac = failwith "TODO";;
 
-
-let id_of_command x =
-  match x with
-      Node(_,_,Node(_,_,y::_)::_) ->  y
-     |_ -> assert false
-;;
 type type_info_subgoals =
     {ihsg: type_info_subgoals_hyp;
      isgintro : string}
@@ -1285,7 +1197,7 @@ let rec natural_ntree ig ntree =
 	  | TacAssumption -> natural_trivial ig lh g gs ltree
 	  | TacClear _ -> natural_clear ig lh g gs ltree
 (* Besoin de l'argument de la tactique *)
-	  | TacSimpleInduction (NamedHyp id,_) -> 
+	  | TacSimpleInduction (NamedHyp id) -> 
               natural_induction ig lh g gs ge id ltree false
 	  | TacExtend (_,"InductionIntro",[a]) -> 
               let id=(out_gen wit_ident a) in
@@ -1294,7 +1206,7 @@ let rec natural_ntree ig ntree =
 	  | TacExact c -> natural_exact ig lh g gs c ltree
 	  | TacCut c -> natural_cut ig lh g gs c ltree
 	  | TacExtend (_,"CutIntro",[a]) ->
-	      let c = out_gen wit_constr a in
+	      let _c = out_gen wit_constr a in
 	      natural_cutintro ig lh g gs a ltree
 	  | TacCase (c,_) -> natural_case ig lh g gs ge c ltree false
 	  | TacExtend (_,"CaseIntro",[a]) ->
@@ -1518,7 +1430,7 @@ and natural_case ig lh g gs ge arg1 ltree with_intros =
 	 if with_intros
          then (arity_of_constr_of_mind env indf 1)
 	 else 0 in
-       let ici= 1 in
+       let _ici= 1 in
        sph[ (natural_ntree  
                {ihsg=
                  (match (nsort targ1) with
@@ -1547,7 +1459,7 @@ and prod_list_var t =
 and  hd_is_mind t ti =
     try (let env = Global.env() in
          let IndType (indf,targ) = find_rectype env Evd.empty t in
-	 let ncti= Array.length(get_constructors env indf) in
+	 let _ncti= Array.length(get_constructors env indf) in
 	 let (ind,_) = dest_ind_family indf in
          let (mib,mip) = lookup_mind_specif env ind in
 	 (string_of_id mip.mind_typename) = ti)
@@ -1556,7 +1468,7 @@ and mind_ind_info_hyp_constr indf c =
   let env = Global.env() in
   let (ind,_) = dest_ind_family indf in
   let (mib,mip) = lookup_mind_specif env ind in
-  let p = mip.mind_nparams in
+  let _p = mib.mind_nparams in
   let a = arity_of_constr_of_mind env indf c in
   let lp=ref (get_constructors env indf).(c).cs_args in
   let lr=ref [] in
@@ -1586,8 +1498,8 @@ and natural_elim ig lh g gs ge arg1 ltree with_intros=
  let ncti= Array.length(get_constructors env indf) in
  let (ind,_) = dest_ind_family indf in
  let (mib,mip) = lookup_mind_specif env ind in
- let ti =(string_of_id mip.mind_typename) in
- let type_arg=targ1 (* List.nth targ (mis_index dmi) *) in
+ let _ti =(string_of_id mip.mind_typename) in
+ let _type_arg=targ1 (* List.nth targ (mis_index dmi) *) in
   spv
          [  (natural_lhyp lh ig.ihsg);
              (show_goal2 lh ig g gs "");
@@ -1630,11 +1542,11 @@ and natural_induction ig lh g gs ge arg2 ltree with_intros=
  let arg1= mkVar arg2 in
  let targ1 = prod_head (type_of env Evd.empty arg1) in
  let IndType (indf,targ) = find_rectype env Evd.empty targ1 in
- let ncti= Array.length(get_constructors env indf) in
+ let _ncti= Array.length(get_constructors env indf) in
  let (ind,_) = dest_ind_family indf in
  let (mib,mip) = lookup_mind_specif env ind in
- let ti =(string_of_id mip.mind_typename) in
- let type_arg= targ1(*List.nth targ (mis_index dmi)*) in
+ let _ti =(string_of_id mip.mind_typename) in
+ let _type_arg= targ1(*List.nth targ (mis_index dmi)*) in
 
  let lh1= hyps (List.hd ltree) in (* la liste des hyp jusqu'a n *)
  (* on les enleve des hypotheses des sous-buts *)
@@ -1719,8 +1631,8 @@ and natural_reduce ig lh g gs ge mode la ltree =
 and natural_split ig lh g gs ge la ltree =
   match la with
     [arg] -> 
-      let env= (gLOB ge) in
-      let arg1= (*dbize env*) arg in
+      let _env= (gLOB ge) in
+      let arg1= (*dbize _env*) arg in
       spv
       	[ (natural_lhyp lh ig.ihsg);
           (show_goal2 lh ig g gs ""); 
@@ -1740,9 +1652,9 @@ and natural_split ig lh g gs ge la ltree =
 and natural_generalize ig lh g gs ge la ltree =
   match la with
     [arg] ->
-      let env= (gLOB ge) in
+      let _env= (gLOB ge) in
       let arg1= (*dbize env*) arg in
-      let type_arg=type_of (Global.env()) Evd.empty arg in
+      let _type_arg=type_of (Global.env()) Evd.empty arg in
 (*      let type_arg=type_of_ast ge arg in*)
       spv
       	[ (natural_lhyp lh ig.ihsg);
diff --git a/contrib/interface/showproof.mli b/contrib/interface/showproof.mli
index ee269458..9b6787b7 100755
--- a/contrib/interface/showproof.mli
+++ b/contrib/interface/showproof.mli
@@ -4,9 +4,7 @@ open Names
 open Term
 open Util
 open Proof_type
-open Coqast
 open Pfedit
-open Translate
 open Term
 open Reduction
 open Clenv
diff --git a/contrib/interface/showproof_ct.ml b/contrib/interface/showproof_ct.ml
index ee901c5e..dd7f455d 100644
--- a/contrib/interface/showproof_ct.ml
+++ b/contrib/interface/showproof_ct.ml
@@ -3,7 +3,6 @@
    Vers Ctcoq
 *)
 
-open Esyntax
 open Metasyntax
 open Printer
 open Pp
@@ -131,12 +130,12 @@ let rec sp_print x =
 	     | "\n" -> fnl ()
 	     | "Retour chariot pour Show proof" -> fnl ()
 	     |_ -> str s)
-     | CT_text_formula  f -> prterm (Hashtbl.find ct_FORMULA_constr f)
+     | CT_text_formula  f -> pr_lconstr (Hashtbl.find ct_FORMULA_constr f)
      | CT_text_op [CT_coerce_ID_to_TEXT (CT_ident "to_prove");
 		   CT_text_path (CT_signed_int_list p);
 		   CT_coerce_ID_to_TEXT (CT_ident "goal");
 		   g] ->
-      let p=(List.map (fun y -> match y with
+      let _p=(List.map (fun y -> match y with
 	                 (CT_coerce_INT_to_SIGNED_INT
 			      (CT_int x)) -> x
 		       | _ -> raise (Failure "sp_print")) p) in
@@ -149,7 +148,7 @@ let rec sp_print x =
 	      CT_text_path (CT_signed_int_list p);
 	      CT_coerce_ID_to_TEXT (CT_ident hyp);
               g]  ->
-      let p=(List.map (fun y -> match y with
+      let _p=(List.map (fun y -> match y with
 	                  (CT_coerce_INT_to_SIGNED_INT
 			      (CT_int x)) -> x
 		       | _ -> raise (Failure "sp_print")) p) in
@@ -159,7 +158,7 @@ let rec sp_print x =
 	      CT_text_path (CT_signed_int_list p);
 	      CT_coerce_ID_to_TEXT (CT_ident hyp);
               g]  ->
-      let p=(List.map (fun y -> match y with
+      let _p=(List.map (fun y -> match y with
                          (CT_coerce_INT_to_SIGNED_INT
 			      (CT_int x)) -> x
 		       | _ -> raise (Failure "sp_print")) p) in
diff --git a/contrib/interface/translate.ml b/contrib/interface/translate.ml
index e63baecf..6e4782be 100644
--- a/contrib/interface/translate.ml
+++ b/contrib/interface/translate.ml
@@ -1,13 +1,11 @@
 open Names;;
 open Sign;;
 open Util;;
-open Ast;;
 open Term;;
 open Pp;;
 open Libobject;;
 open Library;;
 open Vernacinterp;;
-open Termast;;
 open Tacmach;;
 open Pfedit;;
 open Parsing;;
@@ -15,97 +13,11 @@ open Evd;;
 open Evarutil;;
 
 open Xlate;;
-open Ctast;;
 open Vtp;;
 open Ascent;;
 open Environ;;
 open Proof_type;;
 
-(* dead code: let rel_reference gt k oper = 
- if is_existential_oper oper then ope("XTRA", [str "ISEVAR"])
- else begin
-  let id = id_of_global oper in
-  let oper', _ = global_operator (Nametab.sp_of_id k id) id in
-  if oper = oper' then nvar (string_of_id id)
-  else failwith "xlate"
-end;;
-*)
-
-(* dead code: 
-let relativize relfun =
- let rec relrec =
-  function
-     | Nvar (_, id) -> nvar id
-     | Slam (l, na, ast) -> Slam (l, na, relrec ast)
-     | Node (loc, nna, l) as ast -> begin
-       try relfun ast
-       with
-       | Failure _ -> Node (loc, nna, List.map relrec l)
-     end
-     | a -> a in
- relrec;;
-*)
-
-(* dead code:
-let dbize_sp =
- function
-    | Path (loc, sl, s) -> begin
-      try section_path sl s
-      with
-      | Invalid_argument _ | Failure _ ->
-      anomaly_loc
-       (loc, "Translate.dbize_sp (taken from Astterm)",
-       [< str "malformed section-path" >])
-    end
-    | ast ->
-     anomaly_loc
-      (Ast.loc ast, "Translate.dbize_sp (taken from Astterm)",
-      [< str "not a section-path" >]);;
-*)
-
-(* dead code:
-let relativize_cci gt = relativize (function
-    | Node (_, "CONST", (p :: _)) as gt ->
-     rel_reference gt CCI (Const (dbize_sp p))
-    | Node (_, "MUTIND", (p :: ((Num (_, tyi)) :: _))) as gt ->
-     rel_reference gt CCI (MutInd (dbize_sp p, tyi))
-    | Node (_, "MUTCONSTRUCT", (p :: ((Num (_, tyi)) :: ((Num (_, i)) :: _)))) as gt ->
-     rel_reference gt CCI (MutConstruct (
-      (dbize_sp p, tyi), i))
-    | _ -> failwith "caught") gt;;
-*)
-
-let coercion_description_holder = ref (function _ -> None : t -> int option);;
-
-let coercion_description t = !coercion_description_holder t;;
-
-let set_coercion_description f =
- coercion_description_holder:=f; ();;
-
-let rec nth_tl l n = if n = 0 then l
- else (match l with
- | a :: b -> nth_tl b (n - 1)
- | [] -> failwith "list too short for nth_tl");;
-
-let rec discard_coercions =
- function
-    | Slam (l, na, ast) -> Slam (l, na, discard_coercions ast)
-    | Node (l, ("APPLIST" as nna), (f :: args as all_sons)) ->
-     (match coercion_description f with
-     | Some n ->
-      let new_args =
-       try nth_tl args n
-       with
-       | Failure "list too short for nth_tl" -> [] in
-      (match new_args with
-       | a :: (b :: c) -> Node (l, nna, List.map discard_coercions new_args)
-       | a :: [] -> discard_coercions a
-       | [] -> Node (l, nna, List.map discard_coercions all_sons))
-     | None -> Node (l, nna, List.map discard_coercions all_sons))
-    | Node (l, nna, all_sons) ->
-     Node (l, nna, List.map discard_coercions all_sons)
-    | it -> it;;
-
 (*translates a formula into a centaur-tree --> FORMULA *)
 let translate_constr at_top env c =
   xlate_formula (Constrextern.extern_constr at_top env c);;
diff --git a/contrib/interface/vernacrc b/contrib/interface/vernacrc
index 42b5e5ab..4d3dc558 100644
--- a/contrib/interface/vernacrc
+++ b/contrib/interface/vernacrc
@@ -1,4 +1,4 @@
-# $Id: vernacrc,v 1.3 2004/01/14 14:52:59 bertot Exp $
+# $Id: vernacrc 5202 2004-01-14 14:52:59Z bertot $
 
 # This file is loaded initially by ./vernacparser.
 
diff --git a/contrib/interface/vtp.ml b/contrib/interface/vtp.ml
index ff418523..5a7ccc26 100644
--- a/contrib/interface/vtp.ml
+++ b/contrib/interface/vtp.ml
@@ -407,6 +407,9 @@ and fCOMMAND = function
    fNODE "print_about" 1
 | CT_print_all -> fNODE "print_all" 0
 | CT_print_classes -> fNODE "print_classes" 0
+| CT_print_ltac id ->
+   fID id;
+   fNODE "print_ltac" 1
 | CT_print_coercions -> fNODE "print_coercions" 0
 | CT_print_grammar(x1) ->
    fGRAMMAR x1;
@@ -418,6 +421,9 @@ and fCOMMAND = function
 | CT_print_hintdb(x1) ->
    fID_OR_STAR x1;
    fNODE "print_hintdb" 1
+| CT_print_rewrite_hintdb(x1) ->
+   fID x1;
+   fNODE "print_rewrite_hintdb" 1
 | CT_print_id(x1) ->
    fID x1;
    fNODE "print_id" 1
@@ -451,6 +457,7 @@ and fCOMMAND = function
 | CT_print_scope(x1) ->
    fID x1;
    fNODE "print_scope" 1
+| CT_print_setoids -> fNODE "print_setoids" 0
 | CT_print_scopes -> fNODE "print_scopes" 0
 | CT_print_section(x1) ->
    fID x1;
@@ -1153,12 +1160,12 @@ and fMODULE_TYPE = function
 | CT_coerce_ID_to_MODULE_TYPE x -> fID x
 | CT_module_type_with_def(x1, x2, x3) ->
    fMODULE_TYPE x1;
-   fID x2;
+   fID_LIST x2;
    fFORMULA x3;
    fNODE "module_type_with_def" 3
 | CT_module_type_with_mod(x1, x2, x3) ->
    fMODULE_TYPE x1;
-   fID x2;
+   fID_LIST x2;
    fID x3;
    fNODE "module_type_with_mod" 3
 and fMODULE_TYPE_CHECK = function
@@ -1281,6 +1288,7 @@ and fRED_COM = function
    fPATTERN_NE_LIST x1;
    fNODE "pattern" 1
 | CT_red -> fNODE "red" 0
+| CT_cbvvm -> fNODE "vm_compute" 0
 | CT_simpl(x1) ->
    fPATTERN_OPT x1;
    fNODE "simpl" 1
@@ -1545,6 +1553,9 @@ and fTACTIC_COM = function
 | CT_exact(x1) ->
    fFORMULA x1;
    fNODE "exact" 1
+| CT_exact_no_check(x1) ->
+   fFORMULA x1;
+   fNODE "exact_no_check" 1
 | CT_exists(x1) ->
    fSPEC_LIST x1;
    fNODE "exists" 1
@@ -1649,12 +1660,12 @@ and fTACTIC_COM = function
    fID x2;
    fNODE "move_after" 2
 | CT_new_destruct(x1, x2, x3) ->
-   fFORMULA_OR_INT x1;
+   (List.iter fFORMULA_OR_INT x1); (* Julien F. Est-ce correct? *)
    fUSING x2;
    fINTRO_PATT_OPT x3;
    fNODE "new_destruct" 3
 | CT_new_induction(x1, x2, x3) ->
-   fFORMULA_OR_INT x1;
+   (List.iter fFORMULA_OR_INT x1); (* Pierre C. Est-ce correct? *)
    fUSING x2;
    fINTRO_PATT_OPT x3;
    fNODE "new_induction" 3
@@ -1697,10 +1708,12 @@ and fTACTIC_COM = function
 | CT_repeat(x1) ->
    fTACTIC_COM x1;
    fNODE "repeat" 1
-| CT_replace_with(x1, x2) ->
+| CT_replace_with(x1, x2,x3,x4) ->
    fFORMULA x1;
    fFORMULA x2;
-   fNODE "replace_with" 2
+   fID_OPT x3;
+   fTACTIC_OPT x4;
+   fNODE "replace_with" 4
 | CT_rewrite_lr(x1, x2, x3) ->
    fFORMULA x1;
    fSPEC_LIST x2;
diff --git a/contrib/interface/xlate.ml b/contrib/interface/xlate.ml
index 02dc57de..da87086e 100644
--- a/contrib/interface/xlate.ml
+++ b/contrib/interface/xlate.ml
@@ -3,7 +3,6 @@
 open String;;
 open Char;;
 open Util;;
-open Ast;;
 open Names;;
 open Ascent;;
 open Genarg;;
@@ -64,11 +63,7 @@ let coercion_description t = !coercion_description_holder t;;
 let set_coercion_description f =
  coercion_description_holder:=f; ();;
 
-let string_of_node_loc the_node =
-  match Util.unloc (loc the_node) with
-      (a,b) -> "(" ^ (string_of_int a) ^ ", " ^ (string_of_int b) ^ ")";;
-
-let xlate_error s = failwith ("Translation error: " ^ s);;
+let xlate_error s = print_endline ("xlate_error : "^s);failwith ("Translation error: " ^ s);;
 
 let ctf_STRING_OPT_NONE = CT_coerce_NONE_to_STRING_OPT CT_none;;
 
@@ -266,11 +261,13 @@ let rec xlate_match_pattern =
     | CPatAlias  (_,  pattern, id) ->
      CT_pattern_as
       (xlate_match_pattern pattern, CT_coerce_ID_to_ID_OPT (xlate_ident id))
+    | CPatOr (_,l) -> xlate_error "CPatOr: TODO"
     | CPatDelimiters(_, key, p) -> 
 	CT_pattern_delimitors(CT_num_type key, xlate_match_pattern p)
-    | CPatNumeral(_,n) ->
+    | CPatPrim (_,Numeral n) ->
  	CT_coerce_NUM_to_MATCH_PATTERN
-	  (CT_int_encapsulator(Bignat.bigint_to_string n))
+	  (CT_int_encapsulator(Bigint.to_string n))
+    | CPatPrim (_,String _) -> xlate_error "CPatPrim (String): TODO"
     | CPatNotation(_, s, l) -> 
 	CT_pattern_notation(CT_string s,
 			    CT_match_pattern_list(List.map xlate_match_pattern l))
@@ -373,14 +370,11 @@ and (xlate_formula:Topconstr.constr_expr -> Ascent.ct_FORMULA) = function
    | CApp(_, (_,f), l) -> 
        CT_appc(xlate_formula f, xlate_formula_expl_ne_list l)
    | CCases (_, _, [], _) -> assert false
-   | CCases (_, (Some _, _), _, _) -> xlate_error "NOT parsed: Cases with Some"
-   | CCases (_,(None, ret_type), tm::tml, eqns)->
+   | CCases (_, ret_type, tm::tml, eqns)->
        CT_cases(CT_matched_formula_ne_list(xlate_matched_formula tm,
 					   List.map xlate_matched_formula tml),
 		xlate_formula_opt ret_type,
                 CT_eqn_list (List.map (fun x -> translate_one_equation x) eqns))
-   | COrderedCase (_,Term.IfStyle,po,c,[b1;b2]) -> 
-       xlate_error "No more COrderedCase"
    | CLetTuple (_,a::l, ret_info, c, b) -> 
       CT_let_tuple(CT_id_opt_ne_list(xlate_id_opt_aux a,
 				     List.map xlate_id_opt_aux l),
@@ -393,27 +387,18 @@ and (xlate_formula:Topconstr.constr_expr -> Ascent.ct_FORMULA) = function
 	 (xlate_formula c, xlate_return_info ret_info,
 	  xlate_formula b1, xlate_formula b2)
 
-   | COrderedCase (_,Term.LetStyle, po, c, [CLambdaN(_,[l,_],b)]) ->
-       CT_inductive_let(xlate_formula_opt po,
-	       xlate_id_opt_ne_list l,
-	       xlate_formula c, xlate_formula b) 
-   | COrderedCase (_,c,v,e,l) -> 
-       let case_string = match c with
-	   Term.MatchStyle -> "Match"
-	 | _ -> "Case" in
-	 CT_elimc(CT_case "Case", xlate_formula_opt v, xlate_formula e,
-		  CT_formula_list(List.map xlate_formula l))
    | CSort(_, s) -> CT_coerce_SORT_TYPE_to_FORMULA(xlate_sort s)
    | CNotation(_, s, l) -> notation_to_formula s (List.map xlate_formula l)
-   | CNumeral(_, i) -> 
-       CT_coerce_NUM_to_FORMULA(CT_int_encapsulator(Bignat.bigint_to_string i))
+   | CPrim (_, Numeral i) -> 
+       CT_coerce_NUM_to_FORMULA(CT_int_encapsulator(Bigint.to_string i))
+   | CPrim (_, String _) -> xlate_error "CPrim (String): TODO"
    | CHole _ -> CT_existvarc 
 (* I assume CDynamic has been inserted to make free form extension of
    the language possible, but this would go agains the logic of pcoq anyway. *)
    | CDynamic (_, _) -> assert false
    | CDelimiters (_, key, num) -> 
 	 CT_num_encapsulator(CT_num_type key , xlate_formula  num)
-   | CCast (_, e, t) -> 
+   | CCast (_, e,_, t) -> 
        CT_coerce_TYPED_FORMULA_to_FORMULA
 	 (CT_typed_formula(xlate_formula e, xlate_formula t))
    | CPatVar (_, (_,i)) when is_int_meta i ->
@@ -430,11 +415,10 @@ and (xlate_formula:Topconstr.constr_expr -> Ascent.ct_FORMULA) = function
         CT_cofixc(xlate_ident id,
 	  (CT_cofix_rec_list (strip_mutcorec lm, List.map strip_mutcorec lmi)))
    | CFix (_, (_, id), lm::lmi) ->       
-     let strip_mutrec (fid, n, bl, arf, ardef) =
+     let strip_mutrec (fid, (n, ro), bl, arf, ardef) =
         let (struct_arg,bl,arf,ardef) =
          if bl = [] then
            let (bl,arf,ardef) = Ppconstr.split_fix (n+1) arf ardef in
-           let bl = List.map (fun(nal,ty)->LocalRawAssum(nal,ty)) bl in
            (xlate_id_opt(List.nth (names_of_local_assums bl) n),bl,arf,ardef)
          else (make_fix_struct (n, bl),bl,arf,ardef) in
         let arf = xlate_formula arf in
@@ -485,14 +469,14 @@ let xlate_hyp = function
 
 let xlate_hyp_location =
  function
-  | AI (_,id), nums, (InHypTypeOnly,_) ->
+  | AI (_,id), nums, InHypTypeOnly ->
       CT_intype(xlate_ident id, nums_to_int_list nums)
-  | AI (_,id), nums, (InHypValueOnly,_) ->
+  | AI (_,id), nums, InHypValueOnly ->
       CT_invalue(xlate_ident id, nums_to_int_list nums)
-  | AI (_,id), [], (InHyp,_) ->
+  | AI (_,id), [], InHyp ->
       CT_coerce_UNFOLD_to_HYP_LOCATION 
 	(CT_coerce_ID_to_UNFOLD (xlate_ident id))
-  | AI (_,id), a::l, (InHyp,_) ->
+  | AI (_,id), a::l, InHyp ->
       CT_coerce_UNFOLD_to_HYP_LOCATION 
 	(CT_unfold_occ (xlate_ident id, 
 			CT_int_ne_list(CT_int a, nums_to_int_list_aux l)))
@@ -631,6 +615,7 @@ let rec xlate_intro_pattern =
 	   ll)
   | IntroWildcard -> CT_coerce_ID_to_INTRO_PATT(CT_ident "_" )
   | IntroIdentifier c -> CT_coerce_ID_to_INTRO_PATT(xlate_ident c)
+  | IntroAnonymous -> xlate_error "TODO: IntroAnonymous"
 
 let compute_INV_TYPE = function
    FullInversionClear -> CT_inv_clear
@@ -678,9 +663,11 @@ let xlate_one_unfold_block = function
   | (n::nums, qid) ->
       CT_unfold_occ(tac_qualid_to_ct_ID qid, nums_to_int_ne_list n nums);;
 
-let xlate_intro_patt_opt = function
-    None -> CT_coerce_ID_OPT_to_INTRO_PATT_OPT ctv_ID_OPT_NONE
-  | Some fp -> CT_coerce_INTRO_PATT_to_INTRO_PATT_OPT (xlate_intro_pattern fp)
+let xlate_with_names = function
+    IntroAnonymous -> CT_coerce_ID_OPT_to_INTRO_PATT_OPT ctv_ID_OPT_NONE
+  | fp -> CT_coerce_INTRO_PATT_to_INTRO_PATT_OPT (xlate_intro_pattern fp)
+
+let rawwit_main_tactic = rawwit_tactic Pcoq.Tactic.tactic_main_level
 
 let rec (xlate_tacarg:raw_tactic_arg -> ct_TACTIC_ARG) =
   function
@@ -729,6 +716,7 @@ and xlate_red_tactic =
  function
   | Red true -> xlate_error ""
   | Red false -> CT_red
+  | CbvVm -> CT_cbvvm
   | Hnf -> CT_hnf
   | Simpl None -> CT_simpl ctv_PATTERN_OPT_NONE
   | Simpl (Some (l,c)) -> 
@@ -788,6 +776,7 @@ and xlate_tactic =
    | TacFirst(t1::l)-> CT_first(xlate_tactic t1, List.map xlate_tactic l)
    | TacSolve([]) -> assert false
    | TacSolve(t1::l)-> CT_tacsolve(xlate_tactic t1, List.map xlate_tactic l)
+   | TacComplete _ -> xlate_error "TODO: tactical complete"
    | TacDo(count, t) -> CT_do(xlate_id_or_int count, xlate_tactic t)
    | TacTry t -> CT_try (xlate_tactic t)
    | TacRepeat t -> CT_repeat(xlate_tactic t)
@@ -798,7 +787,8 @@ and xlate_tactic =
 		   xlate_tactic t)
    | TacProgress t -> CT_progress(xlate_tactic t)
    | TacOrelse(t1,t2) -> CT_orelse(xlate_tactic t1, xlate_tactic t2)
-   | TacMatch (exp, rules) ->
+   | TacMatch (true,_,_) -> failwith "TODO: lazy match"
+   | TacMatch (false, exp, rules) ->
         CT_match_tac(xlate_tactic exp,
                      match List.map 
                        (function 
@@ -814,11 +804,11 @@ and xlate_tactic =
                          | [] -> assert false
                          | fst::others ->
                              CT_match_tac_rules(fst, others))
-   | TacMatchContext (_,[]) -> failwith ""
-   | TacMatchContext (false,rule1::rules) ->
+   | TacMatchContext (_,_,[]) | TacMatchContext (true,_,_) -> failwith ""
+   | TacMatchContext (false,false,rule1::rules) ->
          CT_match_context(xlate_context_rule rule1,
                           List.map xlate_context_rule rules)
-   | TacMatchContext (true,rule1::rules) ->
+   | TacMatchContext (false,true,rule1::rules) ->
          CT_match_context_reverse(xlate_context_rule rule1,
                           List.map xlate_context_rule rules)
    | TacLetIn (l, t) ->
@@ -855,18 +845,23 @@ and xlate_tactic =
 		   (xlate_local_rec_tac f1, List.map xlate_local_rec_tac l) in
        CT_rec_tactic_in(tl, xlate_tactic t)
    | TacAtom (_, t) -> xlate_tac t 
-   | TacFail (count, "") -> CT_fail(xlate_id_or_int count, ctf_STRING_OPT_NONE)
-   | TacFail (count, s) -> CT_fail(xlate_id_or_int count,
+   | TacFail (count, []) -> CT_fail(xlate_id_or_int count, ctf_STRING_OPT_NONE)
+   | TacFail (count, [MsgString s]) -> CT_fail(xlate_id_or_int count,
 				   ctf_STRING_OPT_SOME (CT_string s))
-   | TacId "" -> CT_idtac ctf_STRING_OPT_NONE
-   | TacId s -> CT_idtac(ctf_STRING_OPT_SOME (CT_string s))
+   | TacFail (count, _) -> xlate_error "TODO: generic fail message"
+   | TacId [] -> CT_idtac ctf_STRING_OPT_NONE
+   | TacId [MsgString s] -> CT_idtac(ctf_STRING_OPT_SOME (CT_string s))
+   | TacId _ -> xlate_error "TODO: generic idtac message"
    | TacInfo t -> CT_info(xlate_tactic t)
    | TacArg a -> xlate_call_or_tacarg a
 
 and xlate_tac =
   function
     | TacExtend (_, "firstorder", tac_opt::l) ->
-       let t1 = match out_gen (wit_opt rawwit_tactic) tac_opt with
+       let t1 =
+	 match
+	   out_gen (wit_opt rawwit_main_tactic) tac_opt
+	 with
 	 | None -> CT_coerce_NONE_to_TACTIC_OPT CT_none
 	 | Some t2 -> CT_coerce_TACTIC_COM_to_TACTIC_OPT (xlate_tactic t2) in
 	 (match l with
@@ -914,7 +909,7 @@ and xlate_tac =
      CT_discriminate_eq
          (xlate_quantified_hypothesis_opt
 	    (out_gen (wit_opt rawwit_quant_hyp) idopt))
-    | TacExtend (_,"deq", [idopt]) ->
+    | TacExtend (_,"simplify_eq", [idopt]) ->
 	let idopt1 = out_gen (wit_opt rawwit_quant_hyp) idopt in
 	let idopt2 = match idopt1 with
 	    None -> CT_coerce_ID_OPT_to_ID_OR_INT_OPT
@@ -962,53 +957,68 @@ 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]) ->
-     let c1 = xlate_formula (out_gen rawwit_constr c1) in
-     let c2 = xlate_formula (out_gen rawwit_constr c2) in
-     CT_replace_with (c1, c2)
+    | TacExtend (_,"replace", [c1; c2;id_opt;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 tac_opt = 
+	  match out_gen (Extratactics.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)
     | TacExtend (_,"rewrite", [b; cbindl]) ->
      let b = out_gen Extraargs.rawwit_orient b in
      let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
      let c = xlate_formula c and bindl = xlate_bindings bindl in
      if b then CT_rewrite_lr (c, bindl, ctv_ID_OPT_NONE)
      else CT_rewrite_rl (c, bindl, ctv_ID_OPT_NONE)
-    | TacExtend (_,"rewritein", [b; cbindl; id]) ->
+    | TacExtend (_,"rewrite_in", [b; cbindl; id]) ->
      let b = out_gen Extraargs.rawwit_orient b in
      let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
      let c = xlate_formula c and bindl = xlate_bindings bindl in
-     let id = ctf_ID_OPT_SOME (xlate_ident (out_gen rawwit_ident id)) in
+     let id = ctf_ID_OPT_SOME (xlate_ident (snd (out_gen rawwit_var id))) in
      if b then CT_rewrite_lr (c, bindl, id)
      else CT_rewrite_rl (c, bindl, id)
-    | TacExtend (_,"conditionalrewrite", [t; b; cbindl]) ->
-     let t = out_gen rawwit_tactic t in
+    | TacExtend (_,"conditional_rewrite", [t; b; cbindl]) ->
+     let t = out_gen rawwit_main_tactic t in
      let b = out_gen Extraargs.rawwit_orient b in
      let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
      let c = xlate_formula c and bindl = xlate_bindings bindl in
      if b then CT_condrewrite_lr (xlate_tactic t, c, bindl, ctv_ID_OPT_NONE)
      else CT_condrewrite_rl (xlate_tactic t, c, bindl, ctv_ID_OPT_NONE)
-    | TacExtend (_,"conditionalrewritein", [t; b; cbindl; id]) ->
-     let t = out_gen rawwit_tactic t in
+    | TacExtend (_,"conditional_rewrite", [t; b; cbindl; id]) ->
+     let t = out_gen rawwit_main_tactic t in
      let b = out_gen Extraargs.rawwit_orient b in
      let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
      let c = xlate_formula c and bindl = xlate_bindings bindl in
-     let id = ctf_ID_OPT_SOME (xlate_ident (out_gen rawwit_ident id)) in
+     let id = ctf_ID_OPT_SOME (xlate_ident (snd (out_gen rawwit_var id))) in
      if b then CT_condrewrite_lr (xlate_tactic t, c, bindl, id)
      else CT_condrewrite_rl (xlate_tactic t, c, bindl, id)
-    | TacExtend (_,"dependentrewrite", [b; id_or_constr]) ->
+    | TacExtend (_,"dependent_rewrite", [b; c]) ->
       let b = out_gen Extraargs.rawwit_orient b in
-      (match genarg_tag id_or_constr with
-	| IdentArgType -> (*Dependent Rewrite/SubstHypInConcl*)
-	    let id = xlate_ident (out_gen rawwit_ident id_or_constr) in
+      let c = xlate_formula (out_gen rawwit_constr c) in
+      (match c with
+	| CT_coerce_ID_to_FORMULA (CT_ident _ as id) -> 
 	    if b then CT_deprewrite_lr id else CT_deprewrite_rl id
-	| ConstrArgType -> (*CutRewrite/SubstConcl*)
-	    let c = xlate_formula (out_gen rawwit_constr id_or_constr) in
-	    if b then CT_cutrewrite_lr (c, ctv_ID_OPT_NONE)
-	    else CT_cutrewrite_rl (c, ctv_ID_OPT_NONE)
-	| _ -> xlate_error "")
-    | TacExtend (_,"dependentrewrite", [b; c; id]) -> (*CutRewrite in/SubstHyp*)
+	| _ -> xlate_error "dependent rewrite on term: not supported")
+    | TacExtend (_,"dependent_rewrite", [b; c; id]) ->
+	xlate_error "dependent rewrite on terms in hypothesis: not supported"
+    | TacExtend (_,"cut_rewrite", [b; c]) ->
+      let b = out_gen Extraargs.rawwit_orient b in
+      let c = xlate_formula (out_gen rawwit_constr c) in
+      if b then CT_cutrewrite_lr (c, ctv_ID_OPT_NONE)
+      else CT_cutrewrite_lr (c, ctv_ID_OPT_NONE)
+    | TacExtend (_,"cut_rewrite", [b; c; id]) ->
       let b = out_gen Extraargs.rawwit_orient b in
       let c = xlate_formula (out_gen rawwit_constr c) in
-      let id = xlate_ident (out_gen rawwit_ident id) in
+      let id = xlate_ident (snd (out_gen rawwit_var id)) in
       if b then CT_cutrewrite_lr (c, ctf_ID_OPT_SOME id)
       else CT_cutrewrite_lr (c, ctf_ID_OPT_SOME id)
     | TacExtend(_, "subst", [l]) ->
@@ -1021,6 +1031,7 @@ and xlate_tac =
     | TacTransitivity c -> CT_transitivity (xlate_formula c)
     | TacAssumption -> CT_assumption
     | TacExact c -> CT_exact (xlate_formula c)
+    | TacExactNoCheck c -> CT_exact_no_check (xlate_formula c)
     | TacDestructHyp (true, (_,id)) -> CT_cdhyp (xlate_ident id)
     | TacDestructHyp (false, (_,id)) -> CT_dhyp (xlate_ident id)
     | TacDestructConcl -> CT_dconcl
@@ -1031,14 +1042,16 @@ and xlate_tac =
         (if a3 then CT_destructing else CT_coerce_NONE_to_DESTRUCTING CT_none),
         (if a4 then CT_usingtdb else CT_coerce_NONE_to_USINGTDB CT_none))
     | TacAutoTDB nopt -> CT_autotdb (xlate_int_opt nopt)
-    | TacAuto (nopt, Some []) -> CT_auto (xlate_int_or_var_opt_to_int_opt nopt)
-    | TacAuto (nopt, None) ->
+    | TacAuto (nopt, [], Some []) -> CT_auto (xlate_int_or_var_opt_to_int_opt nopt)
+    | TacAuto (nopt, [], None) ->
  	CT_auto_with (xlate_int_or_var_opt_to_int_opt nopt,
 		      CT_coerce_STAR_to_ID_NE_LIST_OR_STAR CT_star)
-    | TacAuto (nopt, Some (id1::idl)) ->
+    | TacAuto (nopt, [], Some (id1::idl)) ->
 	CT_auto_with(xlate_int_or_var_opt_to_int_opt nopt,
              CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STAR(
              CT_id_ne_list(CT_ident id1, List.map (fun x -> CT_ident x) idl)))
+    | TacAuto (nopt, _::_, _) ->
+	xlate_error "TODO: auto using"
     |TacExtend(_, ("autorewritev7"|"autorewritev8"), l::t) ->
        let (id_list:ct_ID list) =
 	 List.map (fun x -> CT_ident x) (out_gen (wit_list1 rawwit_pre_ident) l) in
@@ -1048,11 +1061,11 @@ and xlate_tac =
 	 match t with
 	     [t0] -> 
 	       CT_coerce_TACTIC_COM_to_TACTIC_OPT
-		 (xlate_tactic(out_gen rawwit_tactic t0))
+	       (xlate_tactic(out_gen rawwit_main_tactic t0))
 	   | [] -> CT_coerce_NONE_to_TACTIC_OPT CT_none
 	   | _ -> assert false in
 	 CT_autorewrite (CT_id_ne_list(fst, id_list1), t1)
-    | TacExtend (_,"eauto", [nopt; popt; idl]) ->
+    | TacExtend (_,"eauto", [nopt; popt; lems; idl]) ->
 	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
@@ -1063,6 +1076,10 @@ and xlate_tac =
 	    | Some (ArgVar(_, s)) -> xlate_id_to_id_or_int_opt s
 	    | 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
+	    | [] -> []
+	    | _ -> xlate_error "TODO: eauto using" in
 	let idl = out_gen Eauto.rawwit_hintbases idl in
           (match idl with
 	    None -> CT_eauto_with(first_n,
@@ -1084,12 +1101,14 @@ and xlate_tac =
      let (c,bindl) = out_gen rawwit_constr_with_bindings cbindl in
      let c = xlate_formula c and bindl = xlate_bindings bindl in
      CT_eapply (c, bindl)
-    | TacTrivial (Some []) -> CT_trivial
-    | TacTrivial None -> 
+    | TacTrivial ([],Some []) -> CT_trivial
+    | TacTrivial ([],None) -> 
 	CT_trivial_with(CT_coerce_STAR_to_ID_NE_LIST_OR_STAR CT_star)
-    | TacTrivial (Some (id1::idl)) ->
+    | TacTrivial ([],Some (id1::idl)) ->
 	 CT_trivial_with(CT_coerce_ID_NE_LIST_to_ID_NE_LIST_OR_STAR(
             (CT_id_ne_list(CT_ident id1,List.map (fun x -> CT_ident x) idl))))
+    | TacTrivial (_::_,_) ->
+	xlate_error "TODO: trivial using"
     | TacReduce (red, l) ->
      CT_reduce (xlate_red_tactic red, xlate_clause l)
     | TacApply (c,bindl) ->
@@ -1111,7 +1130,7 @@ and xlate_tac =
      CT_elim (xlate_formula c1, xlate_bindings sl, xlate_using u)
     | TacCase (c1,sl) ->
      CT_casetac (xlate_formula c1, xlate_bindings sl)
-    | TacSimpleInduction (h,_) -> CT_induction (xlate_quantified_hypothesis h)
+    | TacSimpleInduction h -> CT_induction (xlate_quantified_hypothesis h)
     | TacSimpleDestruct h -> CT_destruct (xlate_quantified_hypothesis h)
     | TacCut c -> CT_cut (xlate_formula c)
     | TacLApply c -> CT_use (xlate_formula c)
@@ -1123,20 +1142,21 @@ and xlate_tac =
         CT_decompose_list(CT_id_ne_list(id',l'),xlate_formula c)
     | TacDecomposeAnd c -> CT_decompose_record (xlate_formula c)
     | TacDecomposeOr c -> CT_decompose_sum(xlate_formula c)
-    | TacClear [] ->
+    | TacClear (false,[]) ->
 	xlate_error "Clear expects a non empty list of identifiers"
-    | TacClear (id::idl) ->
+    | TacClear (false,id::idl) ->
        let idl' = List.map xlate_hyp idl in
        CT_clear (CT_id_ne_list (xlate_hyp id, idl'))
+    | TacClear (true,_) -> xlate_error "TODO: 'clear - idl' and 'clear'"
     | (*For translating tactics/Inv.v *)
       TacInversion (NonDepInversion (k,idl,l),quant_hyp) ->
 	CT_inversion(compute_INV_TYPE k, xlate_quantified_hypothesis quant_hyp,
-		     xlate_intro_patt_opt l,
+		     xlate_with_names l,
 	             CT_id_list (List.map xlate_hyp idl))
     | TacInversion (DepInversion (k,copt,l),quant_hyp) ->
 	let id = xlate_quantified_hypothesis quant_hyp in
 	CT_depinversion (compute_INV_TYPE k, id, 
-			 xlate_intro_patt_opt l, xlate_formula_opt copt)
+			 xlate_with_names l, xlate_formula_opt copt)
     | TacInversion (InversionUsing (c,idlist), id) ->
 	let id = xlate_quantified_hypothesis id in
 	  CT_use_inversion (id, xlate_formula c,
@@ -1148,28 +1168,34 @@ and xlate_tac =
 	CT_clear_body (CT_id_ne_list (xlate_hyp a, List.map xlate_hyp l))
     | TacDAuto (a, b) ->
 	CT_dauto(xlate_int_or_var_opt_to_int_opt a, xlate_int_opt b)
-    | TacNewDestruct(a,b,(c,_)) ->
-	CT_new_destruct
-	  (xlate_int_or_constr a, xlate_using b, 
-	   xlate_intro_patt_opt c)
-    | TacNewInduction(a,b,(c,_)) ->
-	CT_new_induction
-	  (xlate_int_or_constr a, xlate_using b,
-	   xlate_intro_patt_opt c)
-    | TacInstantiate (a, b, cl) -> 
+    | TacNewDestruct(a,b,c) ->
+	CT_new_destruct (* Julien F. : est-ce correct *)
+	  (List.map  xlate_int_or_constr a, xlate_using b, 
+	   xlate_with_names c)
+    | TacNewInduction(a,b,c) ->
+	CT_new_induction (* Pierre C. : est-ce correct *)
+	  (List.map xlate_int_or_constr a, xlate_using b,
+	   xlate_with_names c)
+    (*| TacInstantiate (a, b, cl) -> 
         CT_instantiate(CT_int a, xlate_formula b,
-		       xlate_clause cl)
+		       assert false) *)
+    | TacLetTac (na, c, cl) when cl = nowhere -> 
+        CT_pose(xlate_id_opt_aux na, xlate_formula c)
     | TacLetTac (na, c, cl) ->
         CT_lettac(xlate_id_opt ((0,0),na), xlate_formula c, 
 		  (* TODO LATER: This should be shared with Unfold,
 		     but the structures are different *)
 		  xlate_clause cl)
-    | TacForward (true, name, c) -> 
-               CT_pose(xlate_id_opt_aux name, xlate_formula c)
-    | TacForward (false, name, c) -> 
-               CT_assert(xlate_id_opt ((0,0),name), xlate_formula c)
-    | TacTrueCut (na, c) -> 
-        CT_truecut(xlate_id_opt ((0,0),na), xlate_formula c)
+    | TacAssert (None, IntroIdentifier id, c) -> 
+        CT_assert(xlate_id_opt ((0,0),Name id), xlate_formula c)
+    | TacAssert (None, IntroAnonymous, c) -> 
+        CT_assert(xlate_id_opt ((0,0),Anonymous), xlate_formula c)
+    | TacAssert (Some (TacId []), IntroIdentifier id, c) -> 
+        CT_truecut(xlate_id_opt ((0,0),Name id), xlate_formula c)
+    | TacAssert (Some (TacId []), IntroAnonymous, c) -> 
+        CT_truecut(xlate_id_opt ((0,0),Anonymous), xlate_formula c)
+    | TacAssert _ ->
+	xlate_error "TODO: assert with 'as' and 'by' and pose proof with 'as'"
     | TacAnyConstructor(Some tac) -> 
 	CT_any_constructor
 	(CT_coerce_TACTIC_COM_to_TACTIC_OPT(xlate_tactic tac))
@@ -1181,6 +1207,7 @@ and xlate_tac =
 	     (List.map xlate_formula
 		(out_gen (wit_list0 rawwit_constr) args)))
     | TacExtend (_,id, l) ->
+	print_endline ("Extratactics : "^ id);
      CT_user_tac (CT_ident id, CT_targ_list (List.map coerce_genarg_to_TARG l))
     | TacAlias _ -> xlate_error "Alias not supported"
 
@@ -1216,8 +1243,11 @@ and coerce_genarg_to_TARG x =
 	CT_coerce_FORMULA_OR_INT_to_TARG
 	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
 	     (CT_coerce_ID_to_ID_OR_INT id))
-  | HypArgType ->
-      xlate_error "TODO (similar to IdentArgType)"
+  | VarArgType ->
+      let id = xlate_ident (snd (out_gen rawwit_var x)) in
+	CT_coerce_FORMULA_OR_INT_to_TARG
+	  (CT_coerce_ID_OR_INT_to_FORMULA_OR_INT
+	     (CT_coerce_ID_to_ID_OR_INT id))
   | RefArgType ->
       let id = tac_qualid_to_ct_ID (out_gen rawwit_ref x) in
 	CT_coerce_FORMULA_OR_INT_to_TARG
@@ -1233,19 +1263,14 @@ and coerce_genarg_to_TARG x =
       (CT_coerce_FORMULA_to_SCOMMENT_CONTENT (xlate_formula (out_gen rawwit_constr x)))
   | ConstrMayEvalArgType -> xlate_error"TODO: generic constr-may-eval argument"
   | QuantHypArgType ->xlate_error"TODO: generic quantified hypothesis argument"
-  | TacticArgType ->
-      let t = xlate_tactic (out_gen rawwit_tactic x) in
+  | TacticArgType n ->
+      let t = xlate_tactic (out_gen (rawwit_tactic n) x) in
       CT_coerce_TACTIC_COM_to_TARG t
-  | OpenConstrArgType ->
-      CT_coerce_SCOMMENT_CONTENT_to_TARG
-      	(CT_coerce_FORMULA_to_SCOMMENT_CONTENT(xlate_formula
-						 (snd (out_gen
-						    rawwit_open_constr x))))
-  | CastedOpenConstrArgType -> 
+  | OpenConstrArgType b -> 
       CT_coerce_SCOMMENT_CONTENT_to_TARG
       	(CT_coerce_FORMULA_to_SCOMMENT_CONTENT(xlate_formula
-						 (snd (out_gen
-						    rawwit_casted_open_constr x))))
+					 (snd (out_gen
+					    (rawwit_open_constr_gen b) x))))
   | ConstrWithBindingsArgType -> xlate_error "TODO: generic constr with bindings"
   | BindingsArgType -> xlate_error "TODO: generic with bindings"
   | RedExprArgType -> xlate_error "TODO: generic red expr"
@@ -1315,8 +1340,11 @@ let coerce_genarg_to_VARG x =
       CT_coerce_ID_OPT_OR_ALL_to_VARG
 	      (CT_coerce_ID_OPT_to_ID_OPT_OR_ALL
 	        (CT_coerce_ID_to_ID_OPT id))
-  | HypArgType ->
-      xlate_error "TODO (similar to IdentArgType)"
+  | VarArgType ->
+      let id = xlate_ident (snd (out_gen rawwit_var x)) in
+      CT_coerce_ID_OPT_OR_ALL_to_VARG
+	      (CT_coerce_ID_OPT_to_ID_OPT_OR_ALL
+	        (CT_coerce_ID_to_ID_OPT id))
   | RefArgType ->
       let id = tac_qualid_to_ct_ID (out_gen rawwit_ref x) in
       CT_coerce_ID_OPT_OR_ALL_to_VARG
@@ -1332,11 +1360,10 @@ let coerce_genarg_to_VARG x =
       (CT_coerce_FORMULA_to_FORMULA_OPT (xlate_formula (out_gen rawwit_constr x)))
   | ConstrMayEvalArgType -> xlate_error"TODO: generic constr-may-eval argument"
   | QuantHypArgType ->xlate_error"TODO: generic quantified hypothesis argument"
-  | TacticArgType ->
-      let t = xlate_tactic (out_gen rawwit_tactic x) in
+  | TacticArgType n ->
+      let t = xlate_tactic (out_gen (rawwit_tactic n) x) in
       CT_coerce_TACTIC_OPT_to_VARG (CT_coerce_TACTIC_COM_to_TACTIC_OPT t)
-  | OpenConstrArgType -> xlate_error "TODO: generic open constr"
-  | CastedOpenConstrArgType -> xlate_error "TODO: generic open constr"
+  | OpenConstrArgType _ -> xlate_error "TODO: generic open constr"
   | ConstrWithBindingsArgType -> xlate_error "TODO: generic constr with bindings"
   | BindingsArgType -> xlate_error "TODO: generic with bindings"
   | RedExprArgType -> xlate_error "TODO: red expr as generic argument"
@@ -1347,23 +1374,9 @@ let coerce_genarg_to_VARG x =
   | ExtraArgType s -> xlate_error "Cannot treat extra generic arguments"
 
 
-let xlate_thm x = CT_thm (match x with
-  | Theorem -> "Theorem"
-  | Remark -> "Remark"
-  | Lemma -> "Lemma"
-  | Fact -> "Fact")
+let xlate_thm x = CT_thm (string_of_theorem_kind x)
 
-
-let xlate_defn x = CT_defn (match x with
- | (Local, Definition) -> "Local"
- | (Global, Definition) -> "Definition"
- | (Global, SubClass) -> "SubClass"
- | (Global, Coercion) -> "Coercion"
- | (Local, SubClass) -> "Local SubClass"
- | (Local, Coercion) -> "Local Coercion"
- | (Global,CanonicalStructure) -> "Canonical Structure"
- | (Local, CanonicalStructure) -> 
-     xlate_error "Local CanonicalStructure not parsed")
+let xlate_defn k = CT_defn (string_of_definition_kind k)
 
 let xlate_var x = CT_var (match x with
  | (Global,Definitional) -> "Parameter"
@@ -1511,17 +1524,18 @@ let rec xlate_module_type = function
   | CMTEwith(mty, decl) ->
       let mty1 = xlate_module_type mty in
 	(match decl with
-	     CWith_Definition((_, id), c) ->
-	       CT_module_type_with_def(xlate_module_type mty, 
-				       xlate_ident id, xlate_formula c)
-	   | CWith_Module((_, id), (_, qid)) ->
-	       CT_module_type_with_mod(xlate_module_type mty,
-				       xlate_ident id, 
+	     CWith_Definition((_, idl), c) ->
+	       CT_module_type_with_def(mty1, 
+				       CT_id_list (List.map xlate_ident idl),
+                                       xlate_formula c)
+	   | CWith_Module((_, idl), (_, qid)) ->
+	       CT_module_type_with_mod(mty1,
+				       CT_id_list (List.map xlate_ident idl), 
 				       CT_ident (xlate_qualid qid)));;
 
 let xlate_module_binder_list (l:module_binder list) =
   CT_module_binder_list
-    (List.map (fun (idl, mty) ->
+    (List.map (fun (_, idl, mty) ->
 		 let idl1 = 
 		   List.map (fun (_, x) -> CT_ident (string_of_id x)) idl in
 		 let fst,idl2 = match idl1 with
@@ -1643,18 +1657,13 @@ let rec xlate_vernac =
 		 CT_add_field(a1, aplus1, amult1, aone1, azero1, aopp1, aeq1,
 			      ainv1, fth1, ainvl1, bind)
 	   |_ -> assert false)
-  | VernacExtend (("HintRewriteV7"|"HintRewriteV8") as key, largs) ->
-      let in_v8 = (key = "HintRewriteV8") in
-      let orient = out_gen Extraargs.rawwit_orient (List.nth largs 0) in
-      let formula_list = out_gen (wit_list1 rawwit_constr) (List.nth largs 1) in
-      let t =
-	if List.length largs = 4 then
-	   out_gen rawwit_tactic (List.nth largs (if in_v8 then 2 else 3))
-	 else
-	   TacId "" in
-      let base = 
-	out_gen rawwit_pre_ident
-	  (if in_v8 then last largs else List.nth largs 2) in
+  | VernacExtend ("HintRewrite", o::f::([b]|[_;b] as args)) ->
+      let orient = out_gen Extraargs.rawwit_orient o in
+      let formula_list = out_gen (wit_list1 rawwit_constr) f in
+      let base = out_gen rawwit_pre_ident b in
+      let t = 
+	match args with [t;_] -> out_gen rawwit_main_tactic t | _ -> TacId []
+      in
       let ct_orient = match orient with
 	| true  -> CT_lr
 	| false -> CT_rl in
@@ -1665,7 +1674,7 @@ let rec xlate_vernac =
   | VernacHints (local,dbnames,h) ->
       let dblist = CT_id_list(List.map (fun x -> CT_ident x) dbnames) in
       (match h with
-	| HintsConstructors (None, l) ->
+	| HintsConstructors l ->
 	 let n1, names = match List.map tac_qualid_to_ct_ID l with
 	     n1 :: names -> n1, names
 	   | _  -> failwith "" in
@@ -1675,15 +1684,10 @@ let rec xlate_vernac =
 	   else
 	     CT_hints(CT_ident "Constructors",
 		      CT_id_ne_list(n1, names), dblist)
-	| HintsExtern (None, n, c, t) ->
+	| HintsExtern (n, c, t) ->
 	    CT_hint_extern(CT_int n, xlate_formula c, xlate_tactic t, dblist)
         | HintsResolve l | HintsImmediate l -> 
-	    let l = 
-	      List.map 
-	     	(function (None, f) -> xlate_formula f
-		   | _ -> 
-		       xlate_error "obsolete Hint Resolve not supported") l in
-	 let f1, formulas = match l  with
+	 let f1, formulas = match List.map xlate_formula l with
 	     a :: tl -> a, tl
 	   | _  -> failwith "" in
 	 let l' = CT_formula_ne_list(f1, formulas) in
@@ -1700,10 +1704,7 @@ let rec xlate_vernac =
 		| HintsImmediate _ -> CT_hints_immediate(l', dblist)
 		| _ -> assert false)
         | HintsUnfold l -> 
-	 let l = List.map
-	   (function (None,ref) -> loc_qualid_to_ct_ID ref |
-	      _ -> xlate_error "obsolete Hint Unfold not supported") l in
-	 let n1, names = match l with
+	 let n1, names = match List.map loc_qualid_to_ct_ID l with
 	     n1 :: names -> n1, names
 	   | _  -> failwith "" in
 	   if local then
@@ -1724,9 +1725,6 @@ let rec xlate_vernac =
 	       CT_hint_destruct
 		 (xlate_ident id, CT_int n, dl, xlate_formula f,
 		  xlate_tactic t, dblist)
-	| HintsExtern(Some _, _, _, _)
-	| HintsConstructors(Some _, _) -> 
-            xlate_error "obsolete Hint Constructors not supported"
 )
   | VernacEndProof (Proved (true,None)) ->
       CT_save (CT_coerce_THM_to_THM_OPT (CT_thm "Theorem"), ctv_ID_OPT_NONE)
@@ -1759,6 +1757,7 @@ let rec xlate_vernac =
   | VernacShow (ShowGoalImplicitly (Some n)) -> CT_show_implicit (CT_int n)
   | VernacShow ShowExistentials -> CT_show_existentials
   | VernacShow ShowScript -> CT_show_script
+  | VernacShow(ShowMatch _) -> xlate_error "TODO: VernacShow(ShowMatch _)"
   | VernacGo arg -> CT_go (xlate_locn arg)
   | VernacShow ExplainProof l -> CT_explain_proof (nums_to_int_list l)
   | VernacShow ExplainTree l ->
@@ -1775,6 +1774,8 @@ let rec xlate_vernac =
 	| PrintHintDb -> CT_print_hintdb (CT_coerce_STAR_to_ID_OR_STAR CT_star)
 	| PrintHintDbName id -> 
 	    CT_print_hintdb (CT_coerce_ID_to_ID_OR_STAR (CT_ident id))
+	| PrintRewriteHintDbName id -> 
+	    CT_print_rewrite_hintdb (CT_ident id)
 	| PrintHint id ->
 	    CT_print_hint (CT_coerce_ID_to_ID_OPT (loc_qualid_to_ct_ID id))
 	| PrintHintGoal -> CT_print_hint ctv_ID_OPT_NONE
@@ -1783,12 +1784,15 @@ let rec xlate_vernac =
 	| PrintMLModules -> CT_ml_print_modules
 	| PrintGraph -> CT_print_graph
 	| PrintClasses -> CT_print_classes
+	| PrintLtac qid -> CT_print_ltac (loc_qualid_to_ct_ID qid)
 	| PrintCoercions -> CT_print_coercions
 	| PrintCoercionPaths (id1, id2) -> 
 	    CT_print_path (xlate_class id1, xlate_class id2)
+	| PrintCanonicalConversions ->
+	    xlate_error "TODO: Print Canonical Structures"
 	| PrintInspect n -> CT_inspect (CT_int n)
 	| PrintUniverses opt_s -> CT_print_universes(ctf_STRING_OPT opt_s)
-	| PrintLocalContext -> CT_print
+	| PrintSetoids -> CT_print_setoids
 	| PrintTables -> CT_print_tables
         | PrintModuleType a -> CT_print_module_type (loc_qualid_to_ct_ID a)
         | PrintModule a -> CT_print_module (loc_qualid_to_ct_ID a)
@@ -1867,13 +1871,12 @@ let rec xlate_vernac =
 	     translate_opt_notation_decl notopt) in
         CT_mind_decl
 	  (CT_co_ind co_or_ind, CT_ind_spec_list (List.map strip_mutind lmi))
-   | VernacFixpoint [] -> xlate_error "mutual recursive"
-   | VernacFixpoint (lm :: lmi) ->
-      let strip_mutrec ((fid, n, bl, arf, ardef), ntn) =
+   | VernacFixpoint ([],_) -> xlate_error "mutual recursive"
+   | VernacFixpoint ((lm :: lmi),boxed) ->
+      let strip_mutrec ((fid, (n, ro), bl, arf, ardef), ntn) =
         let (struct_arg,bl,arf,ardef) =
          if bl = [] then
            let (bl,arf,ardef) = Ppconstr.split_fix (n+1) arf ardef in
-           let bl = List.map (fun(nal,ty)->LocalRawAssum(nal,ty)) bl in
            (xlate_id_opt(List.nth (names_of_local_assums bl) n),bl,arf,ardef)
          else (make_fix_struct (n, bl),bl,arf,ardef) in
         let arf = xlate_formula arf in
@@ -1885,8 +1888,8 @@ let rec xlate_vernac =
           | _ -> xlate_error "mutual recursive" in
         CT_fix_decl
 	  (CT_fix_rec_list (strip_mutrec lm, List.map strip_mutrec lmi))
-   | VernacCoFixpoint [] -> xlate_error "mutual corecursive"
-   | VernacCoFixpoint (lm :: lmi) ->
+   | VernacCoFixpoint ([],boxed) -> xlate_error "mutual corecursive"
+   | VernacCoFixpoint ((lm :: lmi),boxed) ->
       let strip_mutcorec (fid, bl, arf, ardef) =
 	CT_cofix_rec (xlate_ident fid, xlate_binder_list bl,
                       xlate_formula arf, xlate_formula ardef) in
@@ -1916,20 +1919,18 @@ let rec xlate_vernac =
 			    | Some mty1 ->
 				CT_coerce_MODULE_TYPE_to_MODULE_TYPE_OPT
 				  (xlate_module_type mty1))
-   | VernacDefineModule((_, id), bl, mty_o, mexpr_o) ->
+   | VernacDefineModule(_,(_, id), bl, mty_o, mexpr_o) ->
        CT_module(xlate_ident id, 
 		 xlate_module_binder_list bl,
 		 xlate_module_type_check_opt mty_o,
 		 match mexpr_o with
 		     None -> CT_coerce_ID_OPT_to_MODULE_EXPR ctv_ID_OPT_NONE
 		   | Some m -> xlate_module_expr m)
-  | VernacDeclareModule((_, id), bl, mty_o, mexpr_o) -> 
+  | VernacDeclareModule(_,(_, id), bl, mty_o) -> 
        CT_declare_module(xlate_ident id, 
 		 xlate_module_binder_list bl,
-		 xlate_module_type_check_opt mty_o,
-		 match mexpr_o with
-		     None -> CT_coerce_ID_OPT_to_MODULE_EXPR ctv_ID_OPT_NONE
-		   | Some m -> xlate_module_expr m)
+		 xlate_module_type_check_opt (Some mty_o),
+		 CT_coerce_ID_OPT_to_MODULE_EXPR ctv_ID_OPT_NONE)
    | VernacRequire (impexp, spec, id::idl) ->
       let ct_impexp, ct_spec = get_require_flags impexp spec in
       CT_require (ct_impexp, ct_spec, 
@@ -1943,8 +1944,6 @@ let rec xlate_vernac =
       CT_require(ct_impexp, ct_spec, 
 		 CT_coerce_STRING_to_ID_NE_LIST_OR_STRING(CT_string filename))
 
-   | VernacSyntax (phylum, l) -> xlate_error "SYNTAX not implemented"
-
    | VernacOpenCloseScope(true, true, s) -> CT_local_open_scope(CT_ident s)
    | VernacOpenCloseScope(false, true, s) -> CT_open_scope(CT_ident s)
    | VernacOpenCloseScope(true, false, s) -> CT_local_close_scope(CT_ident s)
@@ -1966,8 +1965,7 @@ let rec xlate_vernac =
 		     CT_id_ne_list(xlate_class_rawexpr a,
 				   List.map xlate_class_rawexpr l))
    | VernacBindScope(id, []) -> assert false
-   | VernacNotation(b, c, None, _, _) -> assert false
-   | VernacNotation(b, c, Some(s,modif_list), _, opt_scope) -> 
+   | VernacNotation(b, c, (s,modif_list), opt_scope) -> 
        let translated_s = CT_string s in
        let formula = xlate_formula c in
        let translated_modif_list = 
@@ -1981,7 +1979,7 @@ let rec xlate_vernac =
        else
 	 CT_define_notation(translated_s, formula, 
 			    translated_modif_list, translated_scope)
-   | VernacSyntaxExtension(b,Some(s,modif_list), None) -> 
+   | VernacSyntaxExtension(b,(s,modif_list)) -> 
        let translated_s = CT_string s in
        let translated_modif_list = 
 	 CT_modifier_list(List.map xlate_syntax_modifier modif_list) in
@@ -1989,8 +1987,7 @@ let rec xlate_vernac =
 	 CT_local_reserve_notation(translated_s, translated_modif_list)
        else
 	 CT_reserve_notation(translated_s, translated_modif_list)
-   | VernacSyntaxExtension(_, _, _) -> assert false
-   | VernacInfix (b,(str,modl),id,_, opt_scope) ->
+   | VernacInfix (b,(str,modl),id, opt_scope) ->
        let id1 = loc_qualid_to_ct_ID id in
        let modl1 = CT_modifier_list(List.map xlate_syntax_modifier modl) in
        let s = CT_string str in
@@ -2001,7 +1998,6 @@ let rec xlate_vernac =
 	   CT_local_infix(s, id1,modl1, translated_scope)
 	 else
 	   CT_infix(s, id1,modl1, translated_scope)
-   | VernacGrammar _ -> xlate_error "GRAMMAR not implemented"
    | VernacCoercion (s, id1, id2, id3) ->
       let id_opt = CT_coerce_NONE_to_IDENTITY_OPT CT_none in
       let local_opt =
@@ -2032,8 +2028,6 @@ let rec xlate_vernac =
 	(CT_command_list(xlate_vernac a, 
 			 List.map (fun (_, x) -> xlate_vernac x) l))
   | VernacList([]) -> assert false
-  | (VernacV7only _ | VernacV8only _) ->
-      xlate_error "Not treated here"
   | VernacNop -> CT_proof_no_op
   | VernacComments l -> 
       CT_scomments(CT_scomment_content_list (List.map xlate_comment l))
@@ -2057,6 +2051,7 @@ let rec xlate_vernac =
   | VernacReserve([], _) -> assert false
   | VernacLocate(LocateTerm id) -> CT_locate(reference_to_ct_ID id)
   | VernacLocate(LocateLibrary id) -> CT_locate_lib(reference_to_ct_ID id)
+  | VernacLocate(LocateModule _) -> xlate_error "TODO: Locate Module"
   | VernacLocate(LocateFile s) -> CT_locate_file(CT_string s)
   | VernacLocate(LocateNotation s) -> CT_locate_notation(CT_string s)
   | VernacTime(v) -> CT_time(xlate_vernac v)
@@ -2113,9 +2108,9 @@ let rec xlate_vernac =
   | VernacVar _ -> xlate_error "Grammar vernac obsolete"
   | (VernacGlobalCheck _|VernacPrintOption _|
      VernacMemOption (_, _)|VernacRemoveOption (_, _)
-  | VernacBack _|VernacRestoreState _| VernacWriteState _|
-    VernacSolveExistential (_, _)|VernacCanonical _ | VernacDistfix _|
-     VernacTacticGrammar _)
+  | VernacBack _ | VernacBacktrack _ |VernacBackTo _|VernacRestoreState _| VernacWriteState _|
+    VernacSolveExistential (_, _)|VernacCanonical _ |
+     VernacTacticNotation _)
     -> xlate_error "TODO: vernac";;
 
 let rec xlate_vernac_list =
@@ -2123,8 +2118,5 @@ let rec xlate_vernac_list =
    | VernacList (v::l) ->
        CT_command_list
          (xlate_vernac (snd v), List.map (fun (_,x) -> xlate_vernac x) l)
-   | VernacV7only v -> 
-       if !Options.v7 then xlate_vernac_list v
-       else xlate_error "Unknown command"
    | VernacList [] -> xlate_error "xlate_command_list"
    | _ -> xlate_error "Not a list of commands";;
diff --git a/contrib/jprover/jall.ml b/contrib/jprover/jall.ml
index 876dc6c0..a2a72676 100644
--- a/contrib/jprover/jall.ml
+++ b/contrib/jprover/jall.ml
@@ -1788,11 +1788,13 @@ struct
       else  if o = ("",Orr,dummyt,dummyt) then  (* Orr is a dummy for no d-gen. rule *)
          ptree
       else
+(*
          let (x1,x2,x3,x4) = r
          and (y1,y2,y3,y4) = o in
-(*   print_endline ("top or_l: "^x1);
+   print_endline ("top or_l: "^x1);
    print_endline ("or_l address: "^addr);
-   print_endline ("top dgen-rule: "^y1); *)
+   print_endline ("top dgen-rule: "^y1);
+*)
          trans_add_branch r o addr "" ptree dglist (subrel,tsubrel)
 
 (* Isolate layer and outer recursion structure *)
@@ -1989,8 +1991,7 @@ struct
                         let (srel,sren) = build_formula_rel dtreelist slist predname in
                         (srel @ rest_rel),(sren @ rest_renlist)
                    | Gamma ->
-                        let n = Array.length suctrees
-                        and succlist = (Array.to_list suctrees) in
+                        let succlist = (Array.to_list suctrees) in
                         let dtreelist = (List.map (fun x -> (1,x)) succlist) in
 (*                if (nonemptys suctrees 0 n) = 1  then
    let (srel,sren) = build_formula_rel dtreelist slist pos.name in
@@ -3039,8 +3040,7 @@ struct
                if (p.pt = Delta) then                 (* keep the tree ordering for the successor position only *)
                   let psucc = List.hd succs in
                   let ppsuccs = tpredsucc psucc ftree in
-                  let pre = List.hd ppsuccs
-                  and sucs = List.tl ppsuccs in
+                  let sucs = List.tl ppsuccs in
                   replace_ordering (psucc.name) sucs redpo (* union the succsets of psucc *)
                else
                   redpo
@@ -4582,7 +4582,6 @@ let gen_prover mult_limit logic calculus hyps concls =
    let (input_map,renamed_termlist) = renam_free_vars (hyps @ concls) in
    let (ftree,red_ordering,eqlist,(sigmaQ,sigmaJ),ext_proof) = prove mult_limit renamed_termlist logic in
    let sequent_proof = reconstruct ftree red_ordering sigmaQ ext_proof logic calculus in
-      let (ptree,count_ax) = bproof sequent_proof in
       let idl = build_formula_id ftree in
 (*      print_ftree ftree;   apple *)
          (* transform types and rename constants *)
diff --git a/contrib/jprover/jprover.ml4 b/contrib/jprover/jprover.ml4
index dd76438f..294943f7 100644
--- a/contrib/jprover/jprover.ml4
+++ b/contrib/jprover/jprover.ml4
@@ -51,7 +51,7 @@ let mbreak s = Format.print_flush (); print_string ("-break at: "^s);
 let jp_error re = raise (JT.RefineError ("jprover", JT.StringError re))
 
 (* print Coq constructor *)
-let print_constr ct = Pp.ppnl (PR.prterm ct); Format.print_flush ()
+let print_constr ct = Pp.ppnl (PR.pr_lconstr ct); Format.print_flush ()
 
 let rec print_constr_list = function
   |  [] -> ()
@@ -361,7 +361,7 @@ let dyn_impl id gl =
          (TCL.tclTHENLAST
             (TCL.tclTHENS (T.cut b) [T.intro_using id2;TCL.tclIDTAC])
          (T.apply_term (TR.mkVar (short_addr id))
-                       [TR.mkMeta (Clenv.new_meta())])) gl
+                       [TR.mkMeta (Evarutil.new_meta())])) gl
 
 let dyn_allr c =       (* [c] must be an eigenvariable which replaces [v] *)
   HT.h_intro (N.id_of_string c)
@@ -390,7 +390,7 @@ let dyn_truer =
 (* Do the proof by the guidance of JProver. *)
 
 let do_one_step inf =
-  let (rule, (s1, t1), ((s2, t2) as k)) = inf in
+  let (rule, (s1, t1), (s2, t2)) = inf in
    begin
 (*i   if not (Jterm.is_xnil_term t2) then
    begin
@@ -542,20 +542,9 @@ let jpn n gls =
   TCL.tclTHEN (TCL.tclTRY T.red_in_concl)
               (TCL.tclTHEN (unfail_gen (List.map TR.mkVar ls))
                          (jp n)) gls
-(*
-let dyn_jpn l gls =
-  match l with
-   | [PT.Integer n] -> jpn n
-   | _ -> jp_error "Impossible!!!"
-
-
-let h_jp = TM.hide_tactic "Jp" dyn_jp
-
-let h_jpn = TM.hide_tactic "Jpn" dyn_jpn
-*)
 
-TACTIC EXTEND Jprover
-  [ "Jp" natural_opt(n) ] -> [ jpn n ]
+TACTIC EXTEND jprover
+  [ "jp" natural_opt(n) ] -> [ jpn n ]
 END
 
 (*
diff --git a/contrib/jprover/jtunify.ml b/contrib/jprover/jtunify.ml
index 2295e62c..91aa6b4b 100644
--- a/contrib/jprover/jtunify.ml
+++ b/contrib/jprover/jtunify.ml
@@ -177,7 +177,7 @@ let rec combine subst ((ov,oslist) as one_subst)  =
          else
             (f::rest_combine)
 
-let compose ((n,subst) as sigma) ((ov,oslist) as one_subst) =
+let compose ((n,subst) as _sigma) ((ov,oslist) as one_subst) =
    let com = combine subst one_subst in
 (* begin
    print_endline "!!!!!!!!!test print!!!!!!!!!!";
diff --git a/contrib/omega/Omega.v b/contrib/omega/Omega.v
index e72dcec2..66f86a49 100755..100644
--- a/contrib/omega/Omega.v
+++ b/contrib/omega/Omega.v
@@ -13,7 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* $Id: Omega.v,v 1.10.2.1 2004/07/16 19:30:12 herbelin Exp $ *)
+(* $Id: Omega.v 8642 2006-03-17 10:09:02Z notin $ *)
 
 (* We do not require [ZArith] anymore, but only what's necessary for Omega *)
 Require Export ZArith_base.
diff --git a/contrib/omega/OmegaLemmas.v b/contrib/omega/OmegaLemmas.v
index 6f0ea2c6..ae642a3e 100644
--- a/contrib/omega/OmegaLemmas.v
+++ b/contrib/omega/OmegaLemmas.v
@@ -1,45 +1,45 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
 
-(*i $Id: OmegaLemmas.v,v 1.4.2.1 2004/07/16 19:30:12 herbelin Exp $ i*)
+(*i $Id: OmegaLemmas.v 7727 2005-12-25 13:42:20Z herbelin $ i*)
 
 Require Import ZArith_base.
+Open Local Scope Z_scope.
 
 (** These are specific variants of theorems dedicated for the Omega tactic *)
 
-Lemma new_var : forall x:Z,  exists y : Z, x = y.
+Lemma new_var : forall x : Z, exists y : Z, x = y.
 intros x; exists x; trivial with arith. 
 Qed.
 
-Lemma OMEGA1 : forall x y:Z, x = y -> (0 <= x)%Z -> (0 <= y)%Z.
+Lemma OMEGA1 : forall x y : Z, x = y -> 0 <= x -> 0 <= y.
 intros x y H; rewrite H; auto with arith.
 Qed.
 
-Lemma OMEGA2 : forall x y:Z, (0 <= x)%Z -> (0 <= y)%Z -> (0 <= x + y)%Z.
+Lemma OMEGA2 : forall x y : Z, 0 <= x -> 0 <= y -> 0 <= x + y.
 exact Zplus_le_0_compat.
 Qed. 
 
-Lemma OMEGA3 :
- forall x y k:Z, (k > 0)%Z -> x = (y * k)%Z -> x = 0%Z -> y = 0%Z.
+Lemma OMEGA3 : forall x y k : Z, k > 0 -> x = y * k -> x = 0 -> y = 0.
 
 intros x y k H1 H2 H3; apply (Zmult_integral_l k);
- [ unfold not in |- *; intros H4; absurd (k > 0)%Z;
+ [ unfold not in |- *; intros H4; absurd (k > 0);
     [ rewrite H4; unfold Zgt in |- *; simpl in |- *; discriminate
     | assumption ]
  | rewrite <- H2; assumption ].
 Qed.
 
-Lemma OMEGA4 : forall x y z:Z, (x > 0)%Z -> (y > x)%Z -> (z * y + x)%Z <> 0%Z.
+Lemma OMEGA4 : forall x y z : Z, x > 0 -> y > x -> z * y + x <> 0.
 
-unfold not in |- *; intros x y z H1 H2 H3; cut (y > 0)%Z;
- [ intros H4; cut (0 <= z * y + x)%Z;
+unfold not in |- *; intros x y z H1 H2 H3; cut (y > 0);
+ [ intros H4; cut (0 <= z * y + x);
     [ intros H5; generalize (Zmult_le_approx y z x H4 H2 H5); intros H6;
-       absurd (z * y + x > 0)%Z;
+       absurd (z * y + x > 0);
        [ rewrite H3; unfold Zgt in |- *; simpl in |- *; discriminate
        | apply Zle_gt_trans with x;
           [ pattern x at 1 in |- *; rewrite <- (Zplus_0_l x);
@@ -55,48 +55,44 @@ unfold not in |- *; intros x y z H1 H2 H3; cut (y > 0)%Z;
  | apply Zgt_trans with x; [ assumption | assumption ] ].
 Qed.
 
-Lemma OMEGA5 : forall x y z:Z, x = 0%Z -> y = 0%Z -> (x + y * z)%Z = 0%Z.
+Lemma OMEGA5 : forall x y z : Z, x = 0 -> y = 0 -> x + y * z = 0.
 
 intros x y z H1 H2; rewrite H1; rewrite H2; simpl in |- *; trivial with arith.
 Qed.
 
-Lemma OMEGA6 : forall x y z:Z, (0 <= x)%Z -> y = 0%Z -> (0 <= x + y * z)%Z.
+Lemma OMEGA6 : forall x y z : Z, 0 <= x -> y = 0 -> 0 <= x + y * z.
 
 intros x y z H1 H2; rewrite H2; simpl in |- *; rewrite Zplus_0_r; assumption.
 Qed.
 
 Lemma OMEGA7 :
- forall x y z t:Z,
-   (z > 0)%Z ->
-   (t > 0)%Z -> (0 <= x)%Z -> (0 <= y)%Z -> (0 <= x * z + y * t)%Z.
+ forall x y z t : Z, z > 0 -> t > 0 -> 0 <= x -> 0 <= y -> 0 <= x * z + y * t.
 
 intros x y z t H1 H2 H3 H4; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat;
  apply Zmult_gt_0_le_0_compat; assumption.
 Qed.
 
-Lemma OMEGA8 :
- forall x y:Z, (0 <= x)%Z -> (0 <= y)%Z -> x = (- y)%Z -> x = 0%Z.
+Lemma OMEGA8 : forall x y : Z, 0 <= x -> 0 <= y -> x = - y -> x = 0.
 
 intros x y H1 H2 H3; elim (Zle_lt_or_eq 0 x H1);
- [ intros H4; absurd (0 < x)%Z;
-    [ change (0 >= x)%Z in |- *; apply Zle_ge; apply Zplus_le_reg_l with y;
+ [ intros H4; absurd (0 < x);
+    [ change (0 >= x) in |- *; apply Zle_ge; apply Zplus_le_reg_l with y;
        rewrite H3; rewrite Zplus_opp_r; rewrite Zplus_0_r; 
        assumption
     | assumption ]
  | intros H4; rewrite H4; trivial with arith ].
 Qed.
 
-Lemma OMEGA9 :
- forall x y z t:Z, y = 0%Z -> x = z -> (y + (- x + z) * t)%Z = 0%Z.
+Lemma OMEGA9 : forall x y z t : Z, y = 0 -> x = z -> y + (- x + z) * t = 0.
 
 intros x y z t H1 H2; rewrite H2; rewrite Zplus_opp_l; rewrite Zmult_0_l;
  rewrite Zplus_0_r; assumption.
 Qed.
 
 Lemma OMEGA10 :
- forall v c1 c2 l1 l2 k1 k2:Z,
-   ((v * c1 + l1) * k1 + (v * c2 + l2) * k2)%Z =
-   (v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2))%Z.
+ forall v c1 c2 l1 l2 k1 k2 : Z,
+ (v * c1 + l1) * k1 + (v * c2 + l2) * k2 =
+ v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2).
 
 intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
  repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
@@ -104,8 +100,8 @@ intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
 Qed.
 
 Lemma OMEGA11 :
- forall v1 c1 l1 l2 k1:Z,
-   ((v1 * c1 + l1) * k1 + l2)%Z = (v1 * (c1 * k1) + (l1 * k1 + l2))%Z.
+ forall v1 c1 l1 l2 k1 : Z,
+ (v1 * c1 + l1) * k1 + l2 = v1 * (c1 * k1) + (l1 * k1 + l2).
 
 intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
  repeat rewrite Zmult_assoc; repeat elim Zplus_assoc; 
@@ -113,8 +109,8 @@ intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
 Qed.
 
 Lemma OMEGA12 :
- forall v2 c2 l1 l2 k2:Z,
-   (l1 + (v2 * c2 + l2) * k2)%Z = (v2 * (c2 * k2) + (l1 + l2 * k2))%Z.
+ forall v2 c2 l1 l2 k2 : Z,
+ l1 + (v2 * c2 + l2) * k2 = v2 * (c2 * k2) + (l1 + l2 * k2).
 
 intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
  repeat rewrite Zmult_assoc; repeat elim Zplus_assoc; 
@@ -122,8 +118,8 @@ intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
 Qed.
 
 Lemma OMEGA13 :
- forall (v l1 l2:Z) (x:positive),
-   (v * Zpos x + l1 + (v * Zneg x + l2))%Z = (l1 + l2)%Z.
+ forall (v l1 l2 : Z) (x : positive),
+ v * Zpos x + l1 + (v * Zneg x + l2) = l1 + l2.
 
 intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zpos x) l1);
  rewrite (Zplus_assoc_reverse l1); rewrite <- Zmult_plus_distr_r;
@@ -133,8 +129,8 @@ intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zpos x) l1);
 Qed.
  
 Lemma OMEGA14 :
- forall (v l1 l2:Z) (x:positive),
-   (v * Zneg x + l1 + (v * Zpos x + l2))%Z = (l1 + l2)%Z.
+ forall (v l1 l2 : Z) (x : positive),
+ v * Zneg x + l1 + (v * Zpos x + l2) = l1 + l2.
 
 intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zneg x) l1);
  rewrite (Zplus_assoc_reverse l1); rewrite <- Zmult_plus_distr_r;
@@ -142,128 +138,126 @@ intros; rewrite Zplus_assoc; rewrite (Zplus_comm (v * Zneg x) l1);
  rewrite Zplus_0_r; trivial with arith.
 Qed.
 Lemma OMEGA15 :
- forall v c1 c2 l1 l2 k2:Z,
-   (v * c1 + l1 + (v * c2 + l2) * k2)%Z =
-   (v * (c1 + c2 * k2) + (l1 + l2 * k2))%Z.
+ forall v c1 c2 l1 l2 k2 : Z,
+ v * c1 + l1 + (v * c2 + l2) * k2 = v * (c1 + c2 * k2) + (l1 + l2 * k2).
 
 intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
  repeat rewrite Zmult_assoc; repeat elim Zplus_assoc;
  rewrite (Zplus_permute l1 (v * c2 * k2)); trivial with arith.
 Qed.
 
-Lemma OMEGA16 :
- forall v c l k:Z, ((v * c + l) * k)%Z = (v * (c * k) + l * k)%Z.
+Lemma OMEGA16 : forall v c l k : Z, (v * c + l) * k = v * (c * k) + l * k.
 
 intros; repeat rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r;
  repeat rewrite Zmult_assoc; repeat elim Zplus_assoc; 
  trivial with arith.
 Qed.
 
-Lemma OMEGA17 : forall x y z:Z, Zne x 0 -> y = 0%Z -> Zne (x + y * z) 0.
+Lemma OMEGA17 : forall x y z : Z, Zne x 0 -> y = 0 -> Zne (x + y * z) 0.
 
 unfold Zne, not in |- *; intros x y z H1 H2 H3; apply H1;
- apply Zplus_reg_l with (y * z)%Z; rewrite Zplus_comm; 
+ apply Zplus_reg_l with (y * z); rewrite Zplus_comm; 
  rewrite H3; rewrite H2; auto with arith.
 Qed.
 
-Lemma OMEGA18 : forall x y k:Z, x = (y * k)%Z -> Zne x 0 -> Zne y 0.
+Lemma OMEGA18 : forall x y k : Z, x = y * k -> Zne x 0 -> Zne y 0.
 
 unfold Zne, not in |- *; intros x y k H1 H2 H3; apply H2; rewrite H1;
  rewrite H3; auto with arith.
 Qed.
 
-Lemma OMEGA19 :
- forall x:Z, Zne x 0 -> (0 <= x + -1)%Z \/ (0 <= x * -1 + -1)%Z.
+Lemma OMEGA19 : forall x : Z, Zne x 0 -> 0 <= x + -1 \/ 0 <= x * -1 + -1.
 
 unfold Zne in |- *; intros x H; elim (Zle_or_lt 0 x);
  [ intros H1; elim Zle_lt_or_eq with (1 := H1);
-    [ intros H2; left; change (0 <= Zpred x)%Z in |- *; apply Zsucc_le_reg;
+    [ intros H2; left; change (0 <= Zpred x) in |- *; apply Zsucc_le_reg;
        rewrite <- Zsucc_pred; apply Zlt_le_succ; assumption
-    | intros H2; absurd (x = 0%Z); auto with arith ]
+    | intros H2; absurd (x = 0); auto with arith ]
  | intros H1; right; rewrite <- Zopp_eq_mult_neg_1; rewrite Zplus_comm;
     apply Zle_left; apply Zsucc_le_reg; simpl in |- *; 
     apply Zlt_le_succ; auto with arith ].
 Qed.
 
-Lemma OMEGA20 : forall x y z:Z, Zne x 0 -> y = 0%Z -> Zne (x + y * z) 0.
+Lemma OMEGA20 : forall x y z : Z, Zne x 0 -> y = 0 -> Zne (x + y * z) 0.
 
 unfold Zne, not in |- *; intros x y z H1 H2 H3; apply H1; rewrite H2 in H3;
  simpl in H3; rewrite Zplus_0_r in H3; trivial with arith.
 Qed.
 
-Definition fast_Zplus_sym (x y:Z) (P:Z -> Prop) (H:P (y + x)%Z) :=
-  eq_ind_r P H (Zplus_comm x y).
+Definition fast_Zplus_comm (x y : Z) (P : Z -> Prop)
+  (H : P (y + x)) := eq_ind_r P H (Zplus_comm x y).
 
-Definition fast_Zplus_assoc_r (n m p:Z) (P:Z -> Prop)
-  (H:P (n + (m + p))%Z) := eq_ind_r P H (Zplus_assoc_reverse n m p).
+Definition fast_Zplus_assoc_reverse (n m p : Z) (P : Z -> Prop)
+  (H : P (n + (m + p))) := eq_ind_r P H (Zplus_assoc_reverse n m p).
 
-Definition fast_Zplus_assoc_l (n m p:Z) (P:Z -> Prop) 
-  (H:P (n + m + p)%Z) := eq_ind_r P H (Zplus_assoc n m p).
+Definition fast_Zplus_assoc (n m p : Z) (P : Z -> Prop) 
+  (H : P (n + m + p)) := eq_ind_r P H (Zplus_assoc n m p).
 
-Definition fast_Zplus_permute (n m p:Z) (P:Z -> Prop)
-  (H:P (m + (n + p))%Z) := eq_ind_r P H (Zplus_permute n m p).
+Definition fast_Zplus_permute (n m p : Z) (P : Z -> Prop)
+  (H : P (m + (n + p))) := eq_ind_r P H (Zplus_permute n m p).
 
-Definition fast_OMEGA10 (v c1 c2 l1 l2 k1 k2:Z) (P:Z -> Prop)
-  (H:P (v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2))%Z) :=
+Definition fast_OMEGA10 (v c1 c2 l1 l2 k1 k2 : Z) (P : Z -> Prop)
+  (H : P (v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2))) :=
   eq_ind_r P H (OMEGA10 v c1 c2 l1 l2 k1 k2).
 
-Definition fast_OMEGA11 (v1 c1 l1 l2 k1:Z) (P:Z -> Prop)
-  (H:P (v1 * (c1 * k1) + (l1 * k1 + l2))%Z) :=
+Definition fast_OMEGA11 (v1 c1 l1 l2 k1 : Z) (P : Z -> Prop)
+  (H : P (v1 * (c1 * k1) + (l1 * k1 + l2))) :=
   eq_ind_r P H (OMEGA11 v1 c1 l1 l2 k1).
-Definition fast_OMEGA12 (v2 c2 l1 l2 k2:Z) (P:Z -> Prop)
-  (H:P (v2 * (c2 * k2) + (l1 + l2 * k2))%Z) :=
+Definition fast_OMEGA12 (v2 c2 l1 l2 k2 : Z) (P : Z -> Prop)
+  (H : P (v2 * (c2 * k2) + (l1 + l2 * k2))) :=
   eq_ind_r P H (OMEGA12 v2 c2 l1 l2 k2).
 
-Definition fast_OMEGA15 (v c1 c2 l1 l2 k2:Z) (P:Z -> Prop)
-  (H:P (v * (c1 + c2 * k2) + (l1 + l2 * k2))%Z) :=
+Definition fast_OMEGA15 (v c1 c2 l1 l2 k2 : Z) (P : Z -> Prop)
+  (H : P (v * (c1 + c2 * k2) + (l1 + l2 * k2))) :=
   eq_ind_r P H (OMEGA15 v c1 c2 l1 l2 k2).
-Definition fast_OMEGA16 (v c l k:Z) (P:Z -> Prop)
-  (H:P (v * (c * k) + l * k)%Z) := eq_ind_r P H (OMEGA16 v c l k).
+Definition fast_OMEGA16 (v c l k : Z) (P : Z -> Prop)
+  (H : P (v * (c * k) + l * k)) := eq_ind_r P H (OMEGA16 v c l k).
 
-Definition fast_OMEGA13 (v l1 l2:Z) (x:positive) (P:Z -> Prop)
-  (H:P (l1 + l2)%Z) := eq_ind_r P H (OMEGA13 v l1 l2 x).
+Definition fast_OMEGA13 (v l1 l2 : Z) (x : positive) (P : Z -> Prop)
+  (H : P (l1 + l2)) := eq_ind_r P H (OMEGA13 v l1 l2 x).
 
-Definition fast_OMEGA14 (v l1 l2:Z) (x:positive) (P:Z -> Prop)
-  (H:P (l1 + l2)%Z) := eq_ind_r P H (OMEGA14 v l1 l2 x).
-Definition fast_Zred_factor0 (x:Z) (P:Z -> Prop) (H:P (x * 1)%Z) :=
-  eq_ind_r P H (Zred_factor0 x).
+Definition fast_OMEGA14 (v l1 l2 : Z) (x : positive) (P : Z -> Prop)
+  (H : P (l1 + l2)) := eq_ind_r P H (OMEGA14 v l1 l2 x).
+Definition fast_Zred_factor0 (x : Z) (P : Z -> Prop) 
+  (H : P (x * 1)) := eq_ind_r P H (Zred_factor0 x).
 
-Definition fast_Zopp_one (x:Z) (P:Z -> Prop) (H:P (x * -1)%Z) :=
-  eq_ind_r P H (Zopp_eq_mult_neg_1 x).
+Definition fast_Zopp_eq_mult_neg_1 (x : Z) (P : Z -> Prop)
+  (H : P (x * -1)) := eq_ind_r P H (Zopp_eq_mult_neg_1 x).
 
-Definition fast_Zmult_sym (x y:Z) (P:Z -> Prop) (H:P (y * x)%Z) :=
-  eq_ind_r P H (Zmult_comm x y).
+Definition fast_Zmult_comm (x y : Z) (P : Z -> Prop)
+  (H : P (y * x)) := eq_ind_r P H (Zmult_comm x y).
 
-Definition fast_Zopp_Zplus (x y:Z) (P:Z -> Prop) (H:P (- x + - y)%Z) :=
-  eq_ind_r P H (Zopp_plus_distr x y).
+Definition fast_Zopp_plus_distr (x y : Z) (P : Z -> Prop)
+  (H : P (- x + - y)) := eq_ind_r P H (Zopp_plus_distr x y).
 
-Definition fast_Zopp_Zopp (x:Z) (P:Z -> Prop) (H:P x) :=
+Definition fast_Zopp_involutive (x : Z) (P : Z -> Prop) (H : P x) :=
   eq_ind_r P H (Zopp_involutive x).
 
-Definition fast_Zopp_Zmult_r (x y:Z) (P:Z -> Prop) 
-  (H:P (x * - y)%Z) := eq_ind_r P H (Zopp_mult_distr_r x y).
+Definition fast_Zopp_mult_distr_r (x y : Z) (P : Z -> Prop) 
+  (H : P (x * - y)) := eq_ind_r P H (Zopp_mult_distr_r x y).
 
-Definition fast_Zmult_plus_distr (n m p:Z) (P:Z -> Prop)
-  (H:P (n * p + m * p)%Z) := eq_ind_r P H (Zmult_plus_distr_l n m p).
-Definition fast_Zmult_Zopp_left (x y:Z) (P:Z -> Prop) 
-  (H:P (x * - y)%Z) := eq_ind_r P H (Zmult_opp_comm x y).
+Definition fast_Zmult_plus_distr_l (n m p : Z) (P : Z -> Prop)
+  (H : P (n * p + m * p)) := eq_ind_r P H (Zmult_plus_distr_l n m p).
+Definition fast_Zmult_opp_comm (x y : Z) (P : Z -> Prop) 
+  (H : P (x * - y)) := eq_ind_r P H (Zmult_opp_comm x y).
 
-Definition fast_Zmult_assoc_r (n m p:Z) (P:Z -> Prop)
-  (H:P (n * (m * p))%Z) := eq_ind_r P H (Zmult_assoc_reverse n m p).
+Definition fast_Zmult_assoc_reverse (n m p : Z) (P : Z -> Prop)
+  (H : P (n * (m * p))) := eq_ind_r P H (Zmult_assoc_reverse n m p).
 
-Definition fast_Zred_factor1 (x:Z) (P:Z -> Prop) (H:P (x * 2)%Z) :=
-  eq_ind_r P H (Zred_factor1 x).
+Definition fast_Zred_factor1 (x : Z) (P : Z -> Prop) 
+  (H : P (x * 2)) := eq_ind_r P H (Zred_factor1 x).
 
-Definition fast_Zred_factor2 (x y:Z) (P:Z -> Prop) 
-  (H:P (x * (1 + y))%Z) := eq_ind_r P H (Zred_factor2 x y).
-Definition fast_Zred_factor3 (x y:Z) (P:Z -> Prop) 
-  (H:P (x * (1 + y))%Z) := eq_ind_r P H (Zred_factor3 x y).
+Definition fast_Zred_factor2 (x y : Z) (P : Z -> Prop)
+  (H : P (x * (1 + y))) := eq_ind_r P H (Zred_factor2 x y).
 
-Definition fast_Zred_factor4 (x y z:Z) (P:Z -> Prop) 
-  (H:P (x * (y + z))%Z) := eq_ind_r P H (Zred_factor4 x y z).
+Definition fast_Zred_factor3 (x y : Z) (P : Z -> Prop)
+  (H : P (x * (1 + y))) := eq_ind_r P H (Zred_factor3 x y).
 
-Definition fast_Zred_factor5 (x y:Z) (P:Z -> Prop) 
-  (H:P y) := eq_ind_r P H (Zred_factor5 x y).
+Definition fast_Zred_factor4 (x y z : Z) (P : Z -> Prop)
+  (H : P (x * (y + z))) := eq_ind_r P H (Zred_factor4 x y z).
 
-Definition fast_Zred_factor6 (x:Z) (P:Z -> Prop) (H:P (x + 0)%Z) :=
-  eq_ind_r P H (Zred_factor6 x).
+Definition fast_Zred_factor5 (x y : Z) (P : Z -> Prop) 
+  (H : P y) := eq_ind_r P H (Zred_factor5 x y).
+
+Definition fast_Zred_factor6 (x : Z) (P : Z -> Prop) 
+  (H : P (x + 0)) := eq_ind_r P H (Zred_factor6 x).
diff --git a/contrib/omega/coq_omega.ml b/contrib/omega/coq_omega.ml
index 7a20aeb6..ee3301d7 100644
--- a/contrib/omega/coq_omega.ml
+++ b/contrib/omega/coq_omega.ml
@@ -13,13 +13,12 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* $Id: coq_omega.ml,v 1.59.2.3 2004/07/16 19:30:12 herbelin Exp $ *)
+(* $Id: coq_omega.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 open Util
 open Pp
 open Reduction
 open Proof_type
-open Ast
 open Names
 open Nameops
 open Term
@@ -36,9 +35,11 @@ open Clenv
 open Logic
 open Libnames
 open Nametab
-open Omega
 open Contradiction
 
+module OmegaSolver = Omega.MakeOmegaSolver (Bigint)
+open OmegaSolver
+
 (* Added by JCF, 09/03/98 *)
 
 let elim_id id gl = simplest_elim (pf_global gl id) gl
@@ -56,16 +57,6 @@ let write f x = f:=x
 
 open Goptions
 
-(* Obsolete, subsumed by Time Omega
-let _ =
-  declare_bool_option 
-    { optsync  = false;
-      optname  = "Omega time displaying flag";
-      optkey   = SecondaryTable ("Omega","Time");
-      optread  = read display_time_flag;
-      optwrite = write display_time_flag }
-*)
-
 let _ =
   declare_bool_option 
     { optsync  = false;
@@ -110,6 +101,31 @@ let new_identifier_var =
   let cpt = ref 0 in 
   (fun () -> let s = "Zvar" ^ string_of_int !cpt in incr cpt; id_of_string s)
 
+let new_id =
+  let cpt = ref 0 in fun () -> incr cpt; !cpt
+
+let new_var_num =
+  let cpt = ref 1000 in (fun () -> incr cpt; !cpt)
+
+let new_var =
+  let cpt = ref 0 in fun () -> incr cpt; Nameops.make_ident "WW" (Some !cpt)
+
+let display_var i = Printf.sprintf "X%d" i
+
+let intern_id,unintern_id =
+  let cpt = ref 0 in
+  let table = Hashtbl.create 7 and co_table = Hashtbl.create 7 in
+  (fun (name : identifier) -> 
+     try Hashtbl.find table name with Not_found -> 
+       let idx = !cpt in
+       Hashtbl.add table name idx; 
+       Hashtbl.add co_table idx name;
+       incr cpt; idx),
+  (fun idx -> 
+     try Hashtbl.find co_table idx with Not_found -> 
+       let v = new_var () in
+       Hashtbl.add table v idx; Hashtbl.add co_table idx v; v)
+    
 let mk_then = tclTHENLIST
 
 let exists_tac c = constructor_tac (Some 1) 1 (Rawterm.ImplicitBindings [c])
@@ -156,22 +172,22 @@ let constant = gen_constant_in_modules "Omega" coq_modules
 let coq_xH = lazy (constant "xH")
 let coq_xO = lazy (constant "xO")
 let coq_xI = lazy (constant "xI")
-let coq_ZERO = lazy (constant (if !Options.v7 then "ZERO" else "Z0"))
-let coq_POS = lazy (constant (if !Options.v7 then "POS" else "Zpos"))
-let coq_NEG = lazy (constant (if !Options.v7 then "NEG" else "Zneg"))
+let coq_Z0 = lazy (constant "Z0")
+let coq_Zpos = lazy (constant "Zpos")
+let coq_Zneg = lazy (constant "Zneg")
 let coq_Z = lazy (constant "Z")
-let coq_relation = lazy (constant (if !Options.v7 then "relation" else "comparison"))
-let coq_SUPERIEUR = lazy (constant "SUPERIEUR")
-let coq_INFEEIEUR = lazy (constant "INFERIEUR")
-let coq_EGAL = lazy (constant "EGAL")
+let coq_comparison = lazy (constant "comparison")
+let coq_Gt = lazy (constant "Gt")
+let coq_INFEEIEUR = lazy (constant "Lt")
+let coq_Eq = lazy (constant "Eq")
 let coq_Zplus = lazy (constant "Zplus")
 let coq_Zmult = lazy (constant "Zmult")
 let coq_Zopp = lazy (constant "Zopp")
 let coq_Zminus = lazy (constant "Zminus")
-let coq_Zs = lazy (constant "Zs")
+let coq_Zsucc = lazy (constant "Zsucc")
 let coq_Zgt = lazy (constant "Zgt")
 let coq_Zle = lazy (constant "Zle")
-let coq_inject_nat = lazy (constant "inject_nat")
+let coq_Z_of_nat = lazy (constant "Z_of_nat")
 let coq_inj_plus = lazy (constant "inj_plus")
 let coq_inj_mult = lazy (constant "inj_mult")
 let coq_inj_minus1 = lazy (constant "inj_minus1")
@@ -183,12 +199,12 @@ let coq_inj_ge = lazy (constant "inj_ge")
 let coq_inj_gt = lazy (constant "inj_gt")
 let coq_inj_neq = lazy (constant "inj_neq")
 let coq_inj_eq = lazy (constant "inj_eq")
-let coq_fast_Zplus_assoc_r = lazy (constant "fast_Zplus_assoc_r")
-let coq_fast_Zplus_assoc_l = lazy (constant "fast_Zplus_assoc_l")
-let coq_fast_Zmult_assoc_r = lazy (constant "fast_Zmult_assoc_r")
+let coq_fast_Zplus_assoc_reverse = lazy (constant "fast_Zplus_assoc_reverse")
+let coq_fast_Zplus_assoc = lazy (constant "fast_Zplus_assoc")
+let coq_fast_Zmult_assoc_reverse = lazy (constant "fast_Zmult_assoc_reverse")
 let coq_fast_Zplus_permute = lazy (constant "fast_Zplus_permute")
-let coq_fast_Zplus_sym = lazy (constant "fast_Zplus_sym")
-let coq_fast_Zmult_sym = lazy (constant "fast_Zmult_sym")
+let coq_fast_Zplus_comm = lazy (constant "fast_Zplus_comm")
+let coq_fast_Zmult_comm = lazy (constant "fast_Zmult_comm")
 let coq_Zmult_le_approx = lazy (constant "Zmult_le_approx")
 let coq_OMEGA1 = lazy (constant "OMEGA1")
 let coq_OMEGA2 = lazy (constant "OMEGA2")
@@ -217,12 +233,12 @@ let coq_fast_Zred_factor3 = lazy (constant "fast_Zred_factor3")
 let coq_fast_Zred_factor4 = lazy (constant "fast_Zred_factor4")
 let coq_fast_Zred_factor5 = lazy (constant "fast_Zred_factor5")
 let coq_fast_Zred_factor6 = lazy (constant "fast_Zred_factor6")
-let coq_fast_Zmult_plus_distr = lazy (constant "fast_Zmult_plus_distr")
-let coq_fast_Zmult_Zopp_left =  lazy (constant "fast_Zmult_Zopp_left")
-let coq_fast_Zopp_Zplus =   lazy (constant "fast_Zopp_Zplus")
-let coq_fast_Zopp_Zmult_r = lazy (constant "fast_Zopp_Zmult_r")
-let coq_fast_Zopp_one =  lazy (constant "fast_Zopp_one")
-let coq_fast_Zopp_Zopp = lazy (constant "fast_Zopp_Zopp")
+let coq_fast_Zmult_plus_distr_l = lazy (constant "fast_Zmult_plus_distr_l")
+let coq_fast_Zmult_opp_comm =  lazy (constant "fast_Zmult_opp_comm")
+let coq_fast_Zopp_plus_distr =   lazy (constant "fast_Zopp_plus_distr")
+let coq_fast_Zopp_mult_distr_r = lazy (constant "fast_Zopp_mult_distr_r")
+let coq_fast_Zopp_eq_mult_neg_1 =  lazy (constant "fast_Zopp_eq_mult_neg_1")
+let coq_fast_Zopp_involutive = lazy (constant "fast_Zopp_involutive")
 let coq_Zegal_left = lazy (constant "Zegal_left")
 let coq_Zne_left = lazy (constant "Zne_left")
 let coq_Zlt_left = lazy (constant "Zlt_left")
@@ -240,10 +256,10 @@ let coq_dec_Zgt = lazy (constant "dec_Zgt")
 let coq_dec_Zge = lazy (constant "dec_Zge")
 
 let coq_not_Zeq = lazy (constant "not_Zeq")
-let coq_not_Zle = lazy (constant "not_Zle")
-let coq_not_Zlt = lazy (constant "not_Zlt")
-let coq_not_Zge = lazy (constant "not_Zge")
-let coq_not_Zgt = lazy (constant "not_Zgt")
+let coq_Znot_le_gt = lazy (constant "Znot_le_gt")
+let coq_Znot_lt_ge = lazy (constant "Znot_lt_ge")
+let coq_Znot_ge_lt = lazy (constant "Znot_ge_lt")
+let coq_Znot_gt_le = lazy (constant "Znot_gt_le")
 let coq_neq = lazy (constant "neq")
 let coq_Zne = lazy (constant "Zne")
 let coq_Zle = lazy (constant "Zle")
@@ -304,7 +320,7 @@ let evaluable_ref_of_constr s c = match kind_of_term (Lazy.force c) with
       EvalConstRef kn
   | _ -> anomaly ("Coq_omega: "^s^" is not an evaluable constant")
 
-let sp_Zs =     lazy (evaluable_ref_of_constr "Zs" coq_Zs)
+let sp_Zsucc =     lazy (evaluable_ref_of_constr "Zsucc" coq_Zsucc)
 let sp_Zminus = lazy (evaluable_ref_of_constr "Zminus" coq_Zminus)
 let sp_Zle = lazy (evaluable_ref_of_constr "Zle" coq_Zle)
 let sp_Zgt = lazy (evaluable_ref_of_constr "Zgt" coq_Zgt)
@@ -324,23 +340,23 @@ let mk_and t1 t2 =  mkApp (build_coq_and (), [| t1; t2 |])
 let mk_or t1 t2 =  mkApp (build_coq_or (), [| t1; t2 |])
 let mk_not t = mkApp (build_coq_not (), [| t |])
 let mk_eq_rel t1 t2 = mkApp (build_coq_eq (),
-			      [| Lazy.force coq_relation; t1; t2 |])
-let mk_inj t = mkApp (Lazy.force coq_inject_nat, [| t |])
+			      [| Lazy.force coq_comparison; t1; t2 |])
+let mk_inj t = mkApp (Lazy.force coq_Z_of_nat, [| t |])
 
 let mk_integer n =
   let rec loop n = 
-    if n=1 then Lazy.force coq_xH else 
-      mkApp ((if n mod 2 = 0 then Lazy.force coq_xO else Lazy.force coq_xI),
-		[| loop (n/2) |])
+    if n =? one then Lazy.force coq_xH else 
+    mkApp((if n mod two =? zero then Lazy.force coq_xO else Lazy.force coq_xI),
+		[| loop (n/two) |])
   in
-  if n = 0 then Lazy.force coq_ZERO 
-  else mkApp ((if n > 0 then Lazy.force coq_POS else Lazy.force coq_NEG),
+  if n =? zero then Lazy.force coq_Z0 
+  else mkApp ((if n >? zero then Lazy.force coq_Zpos else Lazy.force coq_Zneg),
 		 [| loop (abs n) |])
     
 type omega_constant =
-  | Zplus | Zmult | Zminus | Zs | Zopp
+  | Zplus | Zmult | Zminus | Zsucc | Zopp
   | Plus | Mult | Minus | Pred | S | O
-  | POS | NEG | ZERO | Inject_nat
+  | Zpos | Zneg | Z0 | Z_of_nat
   | Eq | Neq
   | Zne | Zle | Zlt | Zge | Zgt
   | Z | Nat
@@ -401,7 +417,7 @@ let destructurate_term t =
     | _, [_;_] when c = Lazy.force coq_Zplus -> Kapp (Zplus,args)
     | _, [_;_] when c = Lazy.force coq_Zmult -> Kapp (Zmult,args)
     | _, [_;_] when c = Lazy.force coq_Zminus -> Kapp (Zminus,args)
-    | _, [_] when c = Lazy.force coq_Zs -> Kapp (Zs,args)
+    | _, [_] when c = Lazy.force coq_Zsucc -> Kapp (Zsucc,args)
     | _, [_] when c = Lazy.force coq_Zopp -> Kapp (Zopp,args)
     | _, [_;_] when c = Lazy.force coq_plus -> Kapp (Plus,args)
     | _, [_;_] when c = Lazy.force coq_mult -> Kapp (Mult,args)
@@ -409,25 +425,25 @@ let destructurate_term t =
     | _, [_] when c = Lazy.force coq_pred -> Kapp (Pred,args)
     | _, [_] when c = Lazy.force coq_S -> Kapp (S,args)
     | _, [] when c = Lazy.force coq_O -> Kapp (O,args)
-    | _, [_] when c = Lazy.force coq_POS -> Kapp (NEG,args)
-    | _, [_] when c = Lazy.force coq_NEG -> Kapp (POS,args)
-    | _, [] when c = Lazy.force coq_ZERO -> Kapp (ZERO,args)
-    | _, [_] when c = Lazy.force coq_inject_nat -> Kapp (Inject_nat,args)
+    | _, [_] when c = Lazy.force coq_Zpos -> Kapp (Zneg,args)
+    | _, [_] when c = Lazy.force coq_Zneg -> Kapp (Zpos,args)
+    | _, [] when c = Lazy.force coq_Z0 -> Kapp (Z0,args)
+    | _, [_] when c = Lazy.force coq_Z_of_nat -> Kapp (Z_of_nat,args)
     | Var id,[] -> Kvar id
     | _ -> Kufo
 
 let recognize_number t =
   let rec loop t =
     match decompose_app t with
-      | f, [t] when f = Lazy.force coq_xI -> 1 + 2 * loop t
-      | f, [t] when f = Lazy.force coq_xO -> 2 * loop t
-      | f, [] when f = Lazy.force coq_xH -> 1
+      | f, [t] when f = Lazy.force coq_xI -> one + two * loop t
+      | f, [t] when f = Lazy.force coq_xO -> two * loop t
+      | f, [] when f = Lazy.force coq_xH -> one
       | _ -> failwith "not a number" 
   in
   match decompose_app t with 
-    | f, [t] when f = Lazy.force coq_POS -> loop t
-    | f, [t] when f = Lazy.force coq_NEG -> - (loop t)
-    | f, [] when f = Lazy.force coq_ZERO -> 0
+    | f, [t] when f = Lazy.force coq_Zpos -> loop t
+    | f, [t] when f = Lazy.force coq_Zneg -> neg (loop t)
+    | f, [] when f = Lazy.force coq_Z0 -> zero
     | _ -> failwith "not a number"
 	  
 type constr_path =
@@ -443,13 +459,11 @@ type constr_path =
 let context operation path (t : constr) =
   let rec loop i p0 t = 
     match (p0,kind_of_term t) with 
-      | (p, Cast (c,t)) -> mkCast (loop i p c,t)
+      | (p, Cast (c,k,t)) -> mkCast (loop i p c,k,t)
       | ([], _) -> operation i t
       | ((P_APP n :: p),  App (f,v)) ->
-(*	  let f,l = get_applist t in   NECESSAIRE ??
-	  let v' = Array.of_list (f::l) in  *)
 	  let v' = Array.copy v in
-	  v'.(n-1) <- loop i p v'.(n-1); mkApp (f, v')
+	  v'.(pred n) <- loop i p v'.(pred n); mkApp (f, v')
       | ((P_BRANCH n :: p), Case (ci,q,c,v)) ->
 	  (* avant, y avait mkApp... anyway, BRANCH seems nowhere used *)
 	  let v' = Array.copy v in
@@ -462,13 +476,13 @@ let context operation path (t : constr) =
       | (p, Fix ((_,n as ln),(tys,lna,v))) ->
 	  let l = Array.length v in
 	  let v' = Array.copy v in
-	  v'.(n) <- loop (i+l) p v.(n); (mkFix (ln,(tys,lna,v')))
+	  v'.(n)<- loop (Pervasives.(+) i l) p v.(n); (mkFix (ln,(tys,lna,v')))
       | ((P_BODY :: p), Prod (n,t,c)) ->
-	  (mkProd (n,t,loop (i+1) p c))
+	  (mkProd (n,t,loop (succ i) p c))
       | ((P_BODY :: p), Lambda (n,t,c)) ->
-	  (mkLambda (n,t,loop (i+1) p c))
+	  (mkLambda (n,t,loop (succ i) p c))
       | ((P_BODY :: p), LetIn (n,b,t,c)) ->
-	  (mkLetIn (n,b,t,loop (i+1) p c))
+	  (mkLetIn (n,b,t,loop (succ i) p c))
       | ((P_TYPE :: p), Prod (n,t,c)) ->
 	  (mkProd (n,loop i p t,c))
       | ((P_TYPE :: p), Lambda (n,t,c)) ->
@@ -476,16 +490,16 @@ let context operation path (t : constr) =
       | ((P_TYPE :: p), LetIn (n,b,t,c)) ->
 	  (mkLetIn (n,b,loop i p t,c))
       | (p, _) -> 
-	  ppnl (Printer.prterm t);
+	  ppnl (Printer.pr_lconstr t);
 	  failwith ("abstract_path " ^ string_of_int(List.length p)) 
   in
   loop 1 path t
 
 let occurence path (t : constr) =
   let rec loop p0 t = match (p0,kind_of_term t) with
-    | (p, Cast (c,t)) -> loop p c
+    | (p, Cast (c,_,_)) -> loop p c
     | ([], _) -> t
-    | ((P_APP n :: p),  App (f,v)) -> loop p v.(n-1)
+    | ((P_APP n :: p),  App (f,v)) -> loop p v.(pred n)
     | ((P_BRANCH n :: p), Case (_,_,_,v)) -> loop p v.(n)
     | ((P_ARITY :: p),  App (f,_)) -> loop p f
     | ((P_ARG :: p),  App (f,v)) -> loop p v.(0)
@@ -497,7 +511,7 @@ let occurence path (t : constr) =
     | ((P_TYPE :: p), Lambda (n,term,c)) -> loop p term
     | ((P_TYPE :: p), LetIn (n,b,term,c)) -> loop p term
     | (p, _) -> 
-	ppnl (Printer.prterm t);
+	ppnl (Printer.pr_lconstr t);
 	failwith ("occurence " ^ string_of_int(List.length p)) 
   in
   loop path t
@@ -509,7 +523,7 @@ let abstract_path typ path t =
 
 let focused_simpl path gl =
   let newc = context (fun i t -> pf_nf gl t) (List.rev path) (pf_concl gl) in
-  convert_concl_no_check newc gl
+  convert_concl_no_check newc DEFAULTcast gl
 
 let focused_simpl path = simpl_time (focused_simpl path)
 
@@ -518,7 +532,7 @@ type oformula =
   | Oinv of  oformula
   | Otimes of oformula * oformula
   | Oatom of identifier
-  | Oz of int
+  | Oz of bigint
   | Oufo of constr
 
 let rec oprint = function 
@@ -530,7 +544,7 @@ let rec oprint = function
       print_string "("; oprint t1; print_string "*"; 
       oprint t2; print_string ")"
   | Oatom s -> print_string (string_of_id s)
-  | Oz i -> print_int i
+  | Oz i -> print_string (string_of_bigint i)
   | Oufo f -> print_string "?"
 
 let rec weight = function
@@ -567,7 +581,7 @@ let rec decompile af =
   in
   loop af.body
 
-let mkNewMeta () = mkMeta (Clenv.new_meta())
+let mkNewMeta () = mkMeta (Evarutil.new_meta())
 
 let clever_rewrite_base_poly typ p result theorem gl = 
   let full = pf_concl gl in
@@ -606,7 +620,7 @@ let clever_rewrite p vpath t gl =
   let vargs = List.map (fun p -> occurence p occ) vpath in
   let t' = applist(t, (vargs @ [abstracted])) in
   exact (applist(t',[mkNewMeta()])) gl
-    
+
 let rec shuffle p (t1,t2) = 
   match t1,t2 with
     | Oplus(l1,r1), Oplus(l2,r2) ->
@@ -614,7 +628,7 @@ let rec shuffle p (t1,t2) =
           let (tac,t') = shuffle (P_APP 2 :: p) (r1,t2) in
           (clever_rewrite p [[P_APP 1;P_APP 1]; 
 			     [P_APP 1; P_APP 2];[P_APP 2]]
-             (Lazy.force coq_fast_Zplus_assoc_r)
+             (Lazy.force coq_fast_Zplus_assoc_reverse)
            :: tac,
            Oplus(l1,t'))
 	else 
@@ -627,12 +641,12 @@ let rec shuffle p (t1,t2) =
 	if weight l1 > weight t2 then
           let (tac,t') = shuffle (P_APP 2 :: p) (r1,t2) in
           clever_rewrite p [[P_APP 1;P_APP 1]; [P_APP 1; P_APP 2];[P_APP 2]]
-            (Lazy.force coq_fast_Zplus_assoc_r)
+            (Lazy.force coq_fast_Zplus_assoc_reverse)
           :: tac, 
           Oplus(l1, t')
 	else 
           [clever_rewrite p [[P_APP 1];[P_APP 2]] 
-	     (Lazy.force coq_fast_Zplus_sym)],
+	     (Lazy.force coq_fast_Zplus_comm)],
           Oplus(t2,t1)
     | t1,Oplus(l2,r2) -> 
 	if weight l2 > weight t1 then
@@ -643,11 +657,11 @@ let rec shuffle p (t1,t2) =
           Oplus(l2,t')
 	else [],Oplus(t1,t2)
     | Oz t1,Oz t2 ->
-	[focused_simpl p], Oz(t1+t2)
+	[focused_simpl p], Oz(Bigint.add t1 t2)
     | t1,t2 ->
 	if weight t1 < weight t2 then
           [clever_rewrite p [[P_APP 1];[P_APP 2]] 
-	     (Lazy.force coq_fast_Zplus_sym)],
+	     (Lazy.force coq_fast_Zplus_comm)],
 	  Oplus(t2,t1)
 	else [],Oplus(t1,t2)
 	  
@@ -665,7 +679,7 @@ let rec shuffle_mult p_init k1 e1 k2 e2 =
                               [P_APP 2; P_APP 2]]
               (Lazy.force coq_fast_OMEGA10) 
 	  in
-          if k1*c1 + k2 * c2 = 0 then 
+          if Bigint.add (Bigint.mult k1 c1) (Bigint.mult k2 c2) =? zero then 
             let tac' = 
 	      clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 2]]
                 (Lazy.force coq_fast_Zred_factor5) in
@@ -722,7 +736,7 @@ let rec shuffle_mult_right p_init e1 k2 e2 =
                [P_APP 2; P_APP 2]]
               (Lazy.force coq_fast_OMEGA15) 
 	  in
-          if c1 + k2 * c2 = 0 then 
+          if Bigint.add c1 (Bigint.mult k2 c2) =? zero then 
             let tac' = 
               clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 2]]
                 (Lazy.force coq_fast_Zred_factor5) 
@@ -732,7 +746,7 @@ let rec shuffle_mult_right p_init e1 k2 e2 =
           else tac :: loop (P_APP 2 :: p) (l1,l2)
 	else if v1 > v2 then
           clever_rewrite p [[P_APP 1;P_APP 1]; [P_APP 1; P_APP 2];[P_APP 2]]
-            (Lazy.force coq_fast_Zplus_assoc_r) ::
+            (Lazy.force coq_fast_Zplus_assoc_reverse) ::
           loop (P_APP 2 :: p) (l1,l2')
 	else
           clever_rewrite p [[P_APP 2; P_APP 1; P_APP 1; P_APP 1];
@@ -744,7 +758,7 @@ let rec shuffle_mult_right p_init e1 k2 e2 =
           loop (P_APP 2 :: p) (l1',l2)
     | ({c=c1;v=v1}::l1), [] -> 
         clever_rewrite p [[P_APP 1;P_APP 1]; [P_APP 1; P_APP 2];[P_APP 2]]
-          (Lazy.force coq_fast_Zplus_assoc_r) ::
+          (Lazy.force coq_fast_Zplus_assoc_reverse) ::
         loop (P_APP 2 :: p) (l1,[])
     | [],({c=c2;v=v2}::l2) -> 
         clever_rewrite p [[P_APP 2; P_APP 1; P_APP 1; P_APP 1];
@@ -765,7 +779,7 @@ let rec shuffle_cancel p = function
 	clever_rewrite p [[P_APP 1; P_APP 1; P_APP 1];[P_APP 1; P_APP 2];
                           [P_APP 2; P_APP 2]; 
                           [P_APP 1; P_APP 1; P_APP 2; P_APP 1]]
-          (if c1 > 0 then 
+          (if c1 >? zero then 
 	     (Lazy.force coq_fast_OMEGA13) 
 	   else 
 	     (Lazy.force coq_fast_OMEGA14)) 
@@ -777,15 +791,15 @@ let rec scalar p n = function
       let tac1,t1' = scalar (P_APP 1 :: p) n t1 and 
         tac2,t2' = scalar (P_APP 2 :: p) n t2 in
       clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 1;P_APP 2];[P_APP 2]]
-        (Lazy.force coq_fast_Zmult_plus_distr) :: 
+        (Lazy.force coq_fast_Zmult_plus_distr_l) :: 
       (tac1 @ tac2), Oplus(t1',t2')
   | Oinv t ->
       [clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 2]] 
-	 (Lazy.force coq_fast_Zmult_Zopp_left);
-       focused_simpl (P_APP 2 :: p)], Otimes(t,Oz(-n))
+	 (Lazy.force coq_fast_Zmult_opp_comm);
+       focused_simpl (P_APP 2 :: p)], Otimes(t,Oz(neg n))
   | Otimes(t1,Oz x) -> 
       [clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 1;P_APP 2];[P_APP 2]]
-         (Lazy.force coq_fast_Zmult_assoc_r);
+         (Lazy.force coq_fast_Zmult_assoc_reverse);
        focused_simpl (P_APP 2 :: p)], 
       Otimes(t1,Oz (n*x))
   | Otimes(t1,t2) -> error "Omega: Can't solve a goal with non-linear products"
@@ -809,7 +823,7 @@ let rec norm_add p_init =
     | [] -> [focused_simpl p_init]
     | _:: l -> 
 	clever_rewrite p [[P_APP 1;P_APP 1]; [P_APP 1; P_APP 2];[P_APP 2]]
-          (Lazy.force coq_fast_Zplus_assoc_r) ::
+          (Lazy.force coq_fast_Zplus_assoc_reverse) ::
 	loop (P_APP 2 :: p) l 
   in
   loop p_init
@@ -831,31 +845,31 @@ let rec negate p = function
       let tac1,t1' = negate (P_APP 1 :: p) t1 and 
         tac2,t2' = negate (P_APP 2 :: p) t2 in
       clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 1;P_APP 2]]
-        (Lazy.force coq_fast_Zopp_Zplus) :: 
+        (Lazy.force coq_fast_Zopp_plus_distr) :: 
       (tac1 @ tac2),
       Oplus(t1',t2')
   | Oinv t ->
-      [clever_rewrite p [[P_APP 1;P_APP 1]] (Lazy.force coq_fast_Zopp_Zopp)], t
+      [clever_rewrite p [[P_APP 1;P_APP 1]] (Lazy.force coq_fast_Zopp_involutive)], t
   | Otimes(t1,Oz x) -> 
       [clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 1;P_APP 2]]
-         (Lazy.force coq_fast_Zopp_Zmult_r);
-       focused_simpl (P_APP 2 :: p)], Otimes(t1,Oz (-x))
+         (Lazy.force coq_fast_Zopp_mult_distr_r);
+       focused_simpl (P_APP 2 :: p)], Otimes(t1,Oz (neg x))
   | Otimes(t1,t2) -> error "Omega: Can't solve a goal with non-linear products"
   | (Oatom _ as t) ->
-      let r = Otimes(t,Oz(-1)) in
-      [clever_rewrite p [[P_APP 1]] (Lazy.force coq_fast_Zopp_one)], r
-  | Oz i -> [focused_simpl p],Oz(-i)
+      let r = Otimes(t,Oz(negone)) in
+      [clever_rewrite p [[P_APP 1]] (Lazy.force coq_fast_Zopp_eq_mult_neg_1)], r
+  | Oz i -> [focused_simpl p],Oz(neg i)
   | Oufo c -> [], Oufo (mkApp (Lazy.force coq_Zopp, [| c |]))
       
 let rec transform p t = 
-  let default () =
+  let default isnat t' =
     try 
-      let v,th,_ = find_constr t in
+      let v,th,_ = find_constr t' in
       [clever_rewrite_base p (mkVar v) (mkVar th)], Oatom v
     with _ -> 
       let v = new_identifier_var ()
       and th = new_identifier () in
-      hide_constr t v th false;
+      hide_constr t' v th isnat;
       [clever_rewrite_base p (mkVar v) (mkVar th)], Oatom v
   in
   try match destructurate_term t with
@@ -870,10 +884,10 @@ let rec transform p t =
 	    (mkApp (Lazy.force coq_Zplus,
 		     [| t1; (mkApp (Lazy.force coq_Zopp, [| t2 |])) |])) in
 	unfold sp_Zminus :: tac,t
-    | Kapp(Zs,[t1]) ->
+    | Kapp(Zsucc,[t1]) ->
 	let tac,t = transform p (mkApp (Lazy.force coq_Zplus,
-					 [| t1; mk_integer 1 |])) in
-	unfold sp_Zs :: tac,t
+					 [| t1; mk_integer one |])) in
+	unfold sp_Zsucc :: tac,t
    | Kapp(Zmult,[t1;t2]) ->
        let tac1,t1' = transform (P_APP 1 :: p) t1 
        and tac2,t2' = transform (P_APP 2 :: p) t2 in
@@ -882,40 +896,32 @@ let rec transform p t =
          | (Oz n,_) ->
              let sym = 
 	       clever_rewrite p [[P_APP 1];[P_APP 2]] 
-		 (Lazy.force coq_fast_Zmult_sym) in
+		 (Lazy.force coq_fast_Zmult_comm) in
              let tac,t' = scalar p n t2' in tac1 @ tac2 @ (sym :: tac),t'
-         | _ -> default ()
+         | _ -> default false t
        end
-   | Kapp((POS|NEG|ZERO),_) -> 
-       (try ([],Oz(recognize_number t)) with _ -> default ())
+   | Kapp((Zpos|Zneg|Z0),_) -> 
+       (try ([],Oz(recognize_number t)) with _ -> default false t)
    | Kvar s -> [],Oatom s
    | Kapp(Zopp,[t]) ->
        let tac,t' = transform (P_APP 1 :: p) t in
        let tac',t'' = negate p t' in
        tac @ tac', t''
-   | Kapp(Inject_nat,[t']) ->
-       begin try 
-         let v,th,_ = find_constr t' in 
-         [clever_rewrite_base p (mkVar v) (mkVar th)],Oatom v
-       with _ -> 
-         let v = new_identifier_var () and th = new_identifier () in
-         hide_constr t' v th true;
-         [clever_rewrite_base p (mkVar v) (mkVar th)], Oatom v
-       end
-   | _ -> default ()
-  with e when catchable_exception e -> default ()
+   | Kapp(Z_of_nat,[t']) -> default true t'
+   | _ -> default false t
+  with e when catchable_exception e -> default false t
       
 let shrink_pair p f1 f2 =
   match f1,f2 with
     | Oatom v,Oatom _ -> 
-	let r = Otimes(Oatom v,Oz 2) in
+	let r = Otimes(Oatom v,Oz two) in
 	clever_rewrite p [[P_APP 1]] (Lazy.force coq_fast_Zred_factor1), r
     | Oatom v, Otimes(_,c2) -> 
-	let r = Otimes(Oatom v,Oplus(c2,Oz 1)) in
+	let r = Otimes(Oatom v,Oplus(c2,Oz one)) in
 	clever_rewrite p [[P_APP 1];[P_APP 2;P_APP 2]] 
 	  (Lazy.force coq_fast_Zred_factor2), r
     | Otimes (v1,c1),Oatom v -> 
-	let r = Otimes(Oatom v,Oplus(c1,Oz 1)) in
+	let r = Otimes(Oatom v,Oplus(c1,Oz one)) in
 	clever_rewrite p [[P_APP 2];[P_APP 1;P_APP 2]]
           (Lazy.force coq_fast_Zred_factor3), r
     | Otimes (Oatom v,c1),Otimes (v2,c2) ->
@@ -931,13 +937,13 @@ let shrink_pair p f1 f2 =
 
 let reduce_factor p = function
   | Oatom v ->
-      let r = Otimes(Oatom v,Oz 1) in
+      let r = Otimes(Oatom v,Oz one) in
       [clever_rewrite p [[]] (Lazy.force coq_fast_Zred_factor0)],r
   | Otimes(Oatom v,Oz n) as f -> [],f
   | Otimes(Oatom v,c) ->
       let rec compute = function
         | Oz n -> n
-	| Oplus(t1,t2) -> compute t1 + compute t2 
+	| Oplus(t1,t2) -> Bigint.add (compute t1) (compute t2)
 	| _ -> error "condense.1" 
       in
       [focused_simpl (P_APP 2 :: p)], Otimes(Oatom v,Oz(compute c))
@@ -950,7 +956,7 @@ let rec condense p = function
 	let assoc_tac = 
           clever_rewrite p 
             [[P_APP 1];[P_APP 2;P_APP 1];[P_APP 2;P_APP 2]]
-            (Lazy.force coq_fast_Zplus_assoc_l) in
+            (Lazy.force coq_fast_Zplus_assoc) in
 	let tac_list,t' = condense p (Oplus(t,r)) in
 	(assoc_tac :: shrink_tac :: tac_list), t'
       end else begin
@@ -958,7 +964,7 @@ let rec condense p = function
 	let tac',t' = condense (P_APP 2 :: p) t in 
 	(tac @ tac'), Oplus(f,t') 
       end
-  | Oplus(f1,Oz n) as t -> 
+  | Oplus(f1,Oz n) -> 
       let tac,f1' = reduce_factor (P_APP 1 :: p) f1 in tac,Oplus(f1',Oz n)
   | Oplus(f1,f2) -> 
       if weight f1 = weight f2 then begin
@@ -973,12 +979,12 @@ let rec condense p = function
   | Oz _ as t -> [],t
   | t -> 
       let tac,t' = reduce_factor p t in
-      let final = Oplus(t',Oz 0) in
+      let final = Oplus(t',Oz zero) in
       let tac' = clever_rewrite p [[]] (Lazy.force coq_fast_Zred_factor6) in
       tac @ [tac'], final
 
 let rec clear_zero p = function
-  | Oplus(Otimes(Oatom v,Oz 0),r) ->
+  | Oplus(Otimes(Oatom v,Oz n),r) when n =? zero ->
       let tac =
 	clever_rewrite p [[P_APP 1;P_APP 1];[P_APP 2]] 
 	  (Lazy.force coq_fast_Zred_factor5) in
@@ -992,7 +998,7 @@ let replay_history tactic_normalisation =
   let aux  = id_of_string "auxiliary" in
   let aux1 = id_of_string "auxiliary_1" in
   let aux2 = id_of_string "auxiliary_2" in
-  let zero = mk_integer 0 in
+  let izero = mk_integer zero in
   let rec loop t =
     match t with
       | HYP e :: l -> 
@@ -1007,7 +1013,7 @@ let replay_history tactic_normalisation =
 	  and eq2 = decompile e2 in 
 	  let id1 = hyp_of_tag e1.id 
 	  and id2 = hyp_of_tag e2.id in
-	  let k = if b then (-1) else 1 in
+	  let k = if b then negone else one in
 	  let p_initial = [P_APP 1;P_TYPE] in
 	  let tac= shuffle_mult_right p_initial e1.body k e2.body in
 	  tclTHENLIST [
@@ -1028,11 +1034,10 @@ let replay_history tactic_normalisation =
 	  let p_initial = [P_APP 2;P_TYPE] in
 	  let tac = shuffle_cancel p_initial e1.body in
 	  let solve_le =
-            let superieur = Lazy.force coq_SUPERIEUR in
             let not_sup_sup = mkApp (build_coq_eq (), [| 
-					Lazy.force coq_relation; 
-					Lazy.force coq_SUPERIEUR;
-					Lazy.force coq_SUPERIEUR |])
+					Lazy.force coq_comparison; 
+					Lazy.force coq_Gt;
+					Lazy.force coq_Gt |])
 	    in
             tclTHENS 
 	      (tclTHENLIST [
@@ -1070,7 +1075,7 @@ let replay_history tactic_normalisation =
 		  (intros_using [id]);
 		  (cut (mk_gt kk dd)) ])
 	        [ tclTHENS 
-		    (cut (mk_gt kk zero)) 
+		    (cut (mk_gt kk izero)) 
 		    [ tclTHENLIST [
 		        (intros_using [aux1; aux2]);
 		        (generalize_tac 
@@ -1088,20 +1093,16 @@ let replay_history tactic_normalisation =
 	      tclTHEN (mk_then tac) reflexivity ]
 	    
       | NOT_EXACT_DIVIDE (e1,k) :: l ->
-	  let id = hyp_of_tag e1.id in
 	  let c = floor_div e1.constant k in
-	  let d = e1.constant - c * k in
+	  let d = Bigint.sub e1.constant (Bigint.mult c k) in
 	  let e2 =  {id=e1.id; kind=EQUA;constant = c; 
                      body = map_eq_linear (fun c -> c / k) e1.body } in
-	  let eq1 = val_of(decompile e1) 
-	  and eq2 = val_of(decompile e2) in
+	  let eq2 = val_of(decompile e2) in
 	  let kk = mk_integer k 
 	  and dd = mk_integer d in
-	  let rhs = mk_plus (mk_times eq2 kk) dd in
-	  let state_eq = mk_eq eq1 rhs in
 	  let tac = scalar_norm_add [P_APP 2] e2.body in
 	  tclTHENS 
-	    (cut (mk_gt dd zero)) 
+	    (cut (mk_gt dd izero)) 
 	    [ tclTHENS (cut (mk_gt kk dd)) 
 		[tclTHENLIST [
 		  (intros_using [aux2;aux1]);
@@ -1147,7 +1148,7 @@ let replay_history tactic_normalisation =
             tclTHENS (cut state_eq) 
 	      [
 		tclTHENS 
-		 (cut (mk_gt kk zero)) 
+		 (cut (mk_gt kk izero)) 
 		 [tclTHENLIST [
 		   (intros_using [aux2;aux1]);
 		   (generalize_tac 
@@ -1170,7 +1171,7 @@ let replay_history tactic_normalisation =
 	  and eq2 = val_of (decompile (negate_eq e1)) in
 	  let tac = 
 	    clever_rewrite [P_APP 3] [[P_APP 1]] 
-	      (Lazy.force coq_fast_Zopp_one) ::
+	      (Lazy.force coq_fast_Zopp_eq_mult_neg_1) ::
             scalar_norm [P_APP 3] e1.body 
 	  in
 	  tclTHENS 
@@ -1184,13 +1185,13 @@ let replay_history tactic_normalisation =
 	      (loop l) ];
             tclTHEN (mk_then tac) reflexivity]
 	    
-      | STATE(new_eq,def,orig,m,sigma) :: l ->
+      | STATE {st_new_eq=e;st_def=def;st_orig=orig;st_coef=m;st_var=v} :: l ->
 	  let id = new_identifier () 
 	  and id2 = hyp_of_tag orig.id in
-	  tag_hypothesis id new_eq.id;
+	  tag_hypothesis id e.id;
 	  let eq1 = val_of(decompile def) 
 	  and eq2 = val_of(decompile orig) in
-	  let vid = unintern_id sigma in
+	  let vid = unintern_id v in
 	  let theorem =
             mkApp (build_coq_ex (), [| 
 		      Lazy.force coq_Z;
@@ -1201,12 +1202,11 @@ let replay_history tactic_normalisation =
 	  in
 	  let mm = mk_integer m in
 	  let p_initial = [P_APP 2;P_TYPE] in
-	  let r = mk_plus eq2 (mk_times (mk_plus (mk_inv (mkVar vid)) eq1) mm) in
 	  let tac = 
             clever_rewrite (P_APP 1 :: P_APP 1 :: P_APP 2 :: p_initial) 
-              [[P_APP 1]] (Lazy.force coq_fast_Zopp_one) ::
+              [[P_APP 1]] (Lazy.force coq_fast_Zopp_eq_mult_neg_1) ::
             shuffle_mult_right p_initial
-              orig.body m ({c= -1;v=sigma}::def.body) in
+              orig.body m ({c= negone;v= v}::def.body) in
 	  tclTHENS 
 	    (cut theorem)  
 	    [tclTHENLIST [
@@ -1241,7 +1241,7 @@ let replay_history tactic_normalisation =
 	  and id2 = hyp_of_tag e2.id in
 	  let eq1 = val_of(decompile e1) 
 	  and eq2 = val_of(decompile e2) in
-	  if k1 = 1 & e2.kind = EQUA then
+	  if k1 =? one & e2.kind = EQUA then
             let tac_thm =
               match e1.kind with
 		| EQUA -> Lazy.force coq_OMEGA5 
@@ -1264,9 +1264,9 @@ let replay_history tactic_normalisation =
 	    and kk2 = mk_integer k2 in
 	    let p_initial = [P_APP 2;P_TYPE] in
 	    let tac= shuffle_mult p_initial k1 e1.body k2 e2.body in
-            tclTHENS (cut (mk_gt kk1 zero)) 
+            tclTHENS (cut (mk_gt kk1 izero)) 
 	      [tclTHENS 
-		 (cut (mk_gt kk2 zero)) 
+		 (cut (mk_gt kk2 izero)) 
 		 [tclTHENLIST [
 		   (intros_using [aux2;aux1]);
 		   (generalize_tac
@@ -1345,7 +1345,7 @@ let destructure_omega gl tac_def (id,c) =
 	  normalize_equation
 	    id INEQ (Lazy.force coq_Zle_left) 2 t t1 t2 tac_def
       | Kapp(Zlt,[t1;t2]) ->
-	  let t = mk_plus (mk_plus t2 (mk_integer (-1))) (mk_inv t1) in
+	  let t = mk_plus (mk_plus t2 (mk_integer negone)) (mk_inv t1) in
 	  normalize_equation
 	    id INEQ (Lazy.force coq_Zlt_left) 2 t t1 t2 tac_def
       | Kapp(Zge,[t1;t2]) ->
@@ -1353,7 +1353,7 @@ let destructure_omega gl tac_def (id,c) =
 	  normalize_equation
 	    id INEQ (Lazy.force coq_Zge_left) 2 t t1 t2 tac_def
       | Kapp(Zgt,[t1;t2]) ->
-	  let t = mk_plus (mk_plus t1 (mk_integer (-1))) (mk_inv t2) in
+	  let t = mk_plus (mk_plus t1 (mk_integer negone)) (mk_inv t2) in
 	  normalize_equation
 	    id INEQ (Lazy.force coq_Zgt_left) 2 t t1 t2 tac_def
       | _ -> tac_def
@@ -1362,7 +1362,7 @@ let destructure_omega gl tac_def (id,c) =
 let reintroduce id =
   (* [id] cannot be cleared if dependent: protect it by a try *)
   tclTHEN (tclTRY (clear [id])) (intro_using id)
-      
+
 let coq_omega gl =
   clear_tables ();
   let tactic_normalisation, system = 
@@ -1382,8 +1382,8 @@ let coq_omega gl =
 	     (intros_using [th;id]);
 	     tac ]),
            {kind = INEQ; 
-	    body = [{v=intern_id v; c=1}]; 
-            constant = 0; id = i} :: sys
+	    body = [{v=intern_id v; c=one}]; 
+            constant = zero; id = i} :: sys
 	 else
            (tclTHENLIST [
 	     (simplest_elim (applist (Lazy.force coq_new_var, [t])));
@@ -1393,17 +1393,19 @@ let coq_omega gl =
       (tclIDTAC,[]) (dump_tables ())
   in
   let system = system @ sys in
-  if !display_system_flag then display_system system;
+  if !display_system_flag then display_system display_var system;
   if !old_style_flag then begin
-    try let _ = simplify false system in tclIDTAC gl
+    try 
+      let _ = simplify (new_id,new_var_num,display_var) false system in
+      tclIDTAC gl
     with UNSOLVABLE -> 
       let _,path = depend [] [] (history ()) in
-      if !display_action_flag then display_action path;
+      if !display_action_flag then display_action display_var path;
       (tclTHEN prelude (replay_history tactic_normalisation path)) gl 
   end else begin 
     try
-      let path = simplify_strong system in
-      if !display_action_flag then display_action path; 
+      let path = simplify_strong (new_id,new_var_num,display_var) system in
+      if !display_action_flag then display_action display_var path; 
       (tclTHEN prelude (replay_history tactic_normalisation path)) gl
     with NO_CONTRADICTION -> error "Omega can't solve this system"
   end
@@ -1411,8 +1413,6 @@ let coq_omega gl =
 let coq_omega = solver_time coq_omega
 
 let nat_inject gl =
-  let aux = id_of_string "auxiliary" in
-  let table = Hashtbl.create 7 in
   let rec explore p t = 
     try match destructurate_term t with
       | Kapp(Plus,[t1;t2]) ->
@@ -1444,7 +1444,7 @@ let nat_inject gl =
 		(explore (P_APP 1 :: p) t1);
 		(explore (P_APP 2 :: p) t2) ];
 	      (tclTHEN 
-		 (clever_rewrite_gen p (mk_integer 0)
+		 (clever_rewrite_gen p (mk_integer zero)
                     ((Lazy.force coq_inj_minus2),[t1;t2;mkVar id]))
 		 (loop [id,mkApp (Lazy.force coq_gt, [| t2;t1 |])]))
 	    ]
@@ -1461,7 +1461,7 @@ let nat_inject gl =
 		Kapp(S,[t]) ->
                   (tclTHEN 
                      (clever_rewrite_gen p 
-			(mkApp (Lazy.force coq_Zs, [| mk_inj t |]))
+			(mkApp (Lazy.force coq_Zsucc, [| mk_inj t |]))
 			((Lazy.force coq_inj_S),[t])) 
 		     (loop (P_APP 1 :: p) t))
               | _ -> explore p t 
@@ -1564,7 +1564,7 @@ let rec decidability gl t =
           | Kapp(Nat,[]) ->  mkApp (Lazy.force coq_dec_eq_nat, [| t1;t2 |])
           | _ -> errorlabstrm "decidability" 
 		(str "Omega: Can't solve a goal with equality on " ++ 
-		   Printer.prterm typ)
+		   Printer.pr_lconstr typ)
 	end
     | Kapp(Zne,[t1;t2]) -> mkApp (Lazy.force coq_dec_Zne, [| t1;t2 |])
     | Kapp(Zle,[t1;t2]) -> mkApp (Lazy.force coq_dec_Zle, [| t1;t2 |])
@@ -1665,25 +1665,25 @@ let destructure_hyps gl =
 		| Kapp(Zle, [t1;t2]) ->
                     tclTHENLIST [
 		      (generalize_tac
-                        [mkApp (Lazy.force coq_not_Zle, [| t1;t2;mkVar i|])]);
+                        [mkApp (Lazy.force coq_Znot_le_gt, [| t1;t2;mkVar i|])]);
 		      (onClearedName i (fun _ -> loop lit))
                     ]
 		| Kapp(Zge, [t1;t2]) ->
                     tclTHENLIST [
 		      (generalize_tac
-                        [mkApp (Lazy.force coq_not_Zge, [| t1;t2;mkVar i|])]);
+                        [mkApp (Lazy.force coq_Znot_ge_lt, [| t1;t2;mkVar i|])]);
 		      (onClearedName i (fun _ -> loop lit))
                     ]
 		| Kapp(Zlt, [t1;t2]) ->
                     tclTHENLIST [
 		      (generalize_tac 
-                        [mkApp (Lazy.force coq_not_Zlt, [| t1;t2;mkVar i|])]);
+                        [mkApp (Lazy.force coq_Znot_lt_ge, [| t1;t2;mkVar i|])]);
 		      (onClearedName i (fun _ -> loop lit))
                     ]
 		| Kapp(Zgt, [t1;t2]) ->
                     tclTHENLIST [
 		      (generalize_tac
-                        [mkApp (Lazy.force coq_not_Zgt, [| t1;t2;mkVar i|])]);
+                        [mkApp (Lazy.force coq_Znot_gt_le, [| t1;t2;mkVar i|])]);
 		      (onClearedName i (fun _ -> loop lit))
                     ]
 		| Kapp(Le, [t1;t2]) ->
@@ -1776,7 +1776,7 @@ let destructure_goal gl =
 let destructure_goal = all_time (destructure_goal)
 
 let omega_solver gl =
-  Library.check_required_library ["Coq";"omega";"Omega"];
+  Coqlib.check_required_library ["Coq";"omega";"Omega"];
   let result = destructure_goal gl in 
   (* if !display_time_flag then begin text_time (); 
      flush Pervasives.stdout end; *)
diff --git a/contrib/omega/g_omega.ml4 b/contrib/omega/g_omega.ml4
index 726cf8bc..01592ebe 100644
--- a/contrib/omega/g_omega.ml4
+++ b/contrib/omega/g_omega.ml4
@@ -15,10 +15,10 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: g_omega.ml4,v 1.1.12.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: g_omega.ml4 7734 2005-12-26 14:06:51Z herbelin $ *)
 
 open Coq_omega
 
-TACTIC EXTEND Omega
-  [ "Omega" ] -> [ omega_solver ]
+TACTIC EXTEND omega
+  [ "omega" ] -> [ omega_solver ]
 END
diff --git a/contrib/omega/omega.ml b/contrib/omega/omega.ml
index f0eb1e78..fd774c16 100755..100644
--- a/contrib/omega/omega.ml
+++ b/contrib/omega/omega.ml
@@ -11,52 +11,75 @@
 (*                                                                        *)
 (* Pierre Crégut (CNET, Lannion, France)                                  *)
 (*                                                                        *)
+(* 13/10/2002 : modified to cope with an external numbering of equations  *)
+(*   and hypothesis. Its use for Omega is not more complex and it makes   *)
+(*   things much simpler for the reflexive version where we should limit  *)
+(*   the number of source of numbering.                                   *)
 (**************************************************************************)
 
-(* $Id: omega.ml,v 1.7.2.2 2005/02/17 18:25:20 herbelin Exp $ *) 
-
-open Util
-open Hashtbl
 open Names
 
-let flat_map f =
- let rec flat_map_f = function
-   | [] -> [] 
-   | x :: l -> f x @ flat_map_f l
- in 
- flat_map_f
-
-let pp i = print_int i; print_newline (); flush stdout
+module type INT = sig
+  type bigint
+  val less_than : bigint -> bigint -> bool
+  val add : bigint -> bigint -> bigint
+  val sub : bigint -> bigint -> bigint
+  val mult : bigint -> bigint -> bigint
+  val euclid : bigint -> bigint -> bigint * bigint
+  val neg : bigint -> bigint
+  val zero : bigint
+  val one : bigint
+  val to_string : bigint -> string
+end
 
 let debug = ref false
 
-let filter = List.partition
+module MakeOmegaSolver (Int:INT) = struct
+
+type bigint = Int.bigint
+let (<?) = Int.less_than
+let (<=?) x y = Int.less_than x y or x = y
+let (>?) x y = Int.less_than y x
+let (>=?) x y = Int.less_than y x or x = y
+let (=?) = (=)
+let (+) = Int.add
+let (-) = Int.sub
+let ( * ) = Int.mult
+let (/) x y = fst (Int.euclid x y)
+let (mod) x y = snd (Int.euclid x y)
+let zero = Int.zero
+let one = Int.one
+let two = one + one
+let negone = Int.neg one
+let abs x = if Int.less_than x zero then Int.neg x else x
+let string_of_bigint = Int.to_string
+let neg = Int.neg
+
+(* To ensure that polymorphic (<) is not used mistakenly on big integers *)
+(* Warning: do not use (=) either on big int *)
+let (<) = ((<) : int -> int -> bool)
+let (>) = ((>) : int -> int -> bool)
+let (<=) = ((<=) : int -> int -> bool)
+let (>=) = ((>=) : int -> int -> bool)
+
+let pp i = print_int i; print_newline (); flush stdout
 
 let push v l = l := v :: !l
 
-let rec pgcd x y = if y = 0 then x else pgcd y (x mod y)
+let rec pgcd x y = if y =? zero then x else pgcd y (x mod y)
 
 let pgcd_l = function
   | [] -> failwith "pgcd_l"
   | x :: l -> List.fold_left pgcd x l
 
 let floor_div a b =
-  match a >=0 , b > 0 with
+  match a >=? zero , b >? zero with
     | true,true -> a / b
     | false,false -> a / b
-    | true, false -> (a-1) / b - 1
-    | false,true  -> (a+1) / b - 1
+    | true, false -> (a-one) / b - one
+    | false,true  -> (a+one) / b - one
 
-let new_id =
-  let cpt = ref 0 in fun () -> incr cpt; ! cpt
-
-let new_var =
-  let cpt = ref 0 in fun () -> incr cpt; Nameops.make_ident "WW" (Some !cpt)
-    
-let new_var_num =
-  let cpt = ref 1000 in (fun () -> incr cpt; !cpt)
-					  
-type coeff = {c: int ; v: int}
+type coeff = {c: bigint ; v: int}
 
 type linear = coeff list
 
@@ -70,60 +93,63 @@ type afine = {
   (* the variables and their coefficient *)
   body: coeff list; 
   (* a constant *)
-  constant: int }
+  constant: bigint }
+
+type state_action = {
+  st_new_eq : afine;
+  st_def    : afine;
+  st_orig   : afine;
+  st_coef   : bigint;
+  st_var    : int }
 
 type action =
-  | DIVIDE_AND_APPROX of afine * afine * int * int
-  | NOT_EXACT_DIVIDE of afine * int
+  | DIVIDE_AND_APPROX of afine * afine * bigint * bigint
+  | NOT_EXACT_DIVIDE of afine * bigint
   | FORGET_C of int
-  | EXACT_DIVIDE of afine * int
-  | SUM of int * (int * afine) * (int * afine)
-  | STATE of afine * afine * afine * int * int
+  | EXACT_DIVIDE of afine * bigint
+  | SUM of int * (bigint * afine) * (bigint * afine)
+  | STATE of state_action 
   | HYP of afine
   | FORGET   of int * int
   | FORGET_I of int * int
   | CONTRADICTION of afine * afine
   | NEGATE_CONTRADICT of afine * afine * bool
-  | MERGE_EQ of int * afine * int 
-  | CONSTANT_NOT_NUL of int * int
+  | MERGE_EQ of int * afine * int
+  | CONSTANT_NOT_NUL of int * bigint
   | CONSTANT_NUL of int
-  | CONSTANT_NEG of int * int
+  | CONSTANT_NEG of int * bigint
   | SPLIT_INEQ of afine * (int * action list) * (int * action list)
-  | WEAKEN of int * int
+  | WEAKEN of int * bigint
 
 exception UNSOLVABLE
 
 exception NO_CONTRADICTION
 
-let intern_id,unintern_id =
-  let cpt = ref 0 in
-  let table = create 7 and co_table = create 7 in
-  (fun (name : identifier) -> 
-     try find table name with Not_found -> 
-       let idx = !cpt in
-       add table name idx; add co_table idx name; incr cpt; idx),
-  (fun idx -> 
-     try find co_table idx with Not_found -> 
-       let v = new_var () in add table v idx; add co_table idx v; v)
-
-let display_eq (l,e) =
+let display_eq print_var (l,e) =
   let _ = 
     List.fold_left 
       (fun not_first f ->
 	 print_string 
-	   (if f.c < 0 then "- " else if not_first then "+ " else "");
+	   (if f.c <? zero then "- " else if not_first then "+ " else "");
 	 let c = abs f.c in
-	 if c = 1 then 
-	   Printf.printf "%s " (string_of_id (unintern_id f.v))
+	 if c =? one then 
+	   Printf.printf "%s " (print_var f.v)
 	 else 
-	   Printf.printf "%d %s " c (string_of_id (unintern_id f.v)); 
+	   Printf.printf "%s %s " (string_of_bigint c) (print_var f.v); 
 	 true)
       false l
   in
-  if e > 0 then 
-    Printf.printf "+ %d " e 
-  else if e < 0 then 
-    Printf.printf "- %d " (abs e)
+  if e >? zero then 
+    Printf.printf "+ %s " (string_of_bigint e)
+  else if e <? zero then 
+    Printf.printf "- %s " (string_of_bigint (abs e))
+
+let rec trace_length l =
+  let action_length accu = function
+    | SPLIT_INEQ (_,(_,l1),(_,l2)) ->
+	accu + one + trace_length l1 + trace_length l2
+    | _ -> accu + one in
+  List.fold_left action_length zero l
 
 let operator_of_eq = function 
   | EQUA -> "=" | DISE -> "!=" | INEQ -> ">="
@@ -131,49 +157,51 @@ let operator_of_eq = function
 let kind_of = function
   | EQUA -> "equation" | DISE -> "disequation" | INEQ -> "inequation"
 
-let display_system l = 
+let display_system print_var l = 
   List.iter 
     (fun { kind=b; body=e; constant=c; id=id} -> 
-       print_int id; print_string ": ";
-       display_eq (e,c); print_string (operator_of_eq b);
-       print_string "0\n") 
+       Printf.printf "E%d: " id;
+       display_eq print_var (e,c);
+       Printf.printf "%s 0\n" (operator_of_eq b))
     l;
   print_string "------------------------\n\n"
 
-let display_inequations l = 
-  List.iter (fun e -> display_eq e;print_string ">= 0\n") l;
+let display_inequations print_var l = 
+  List.iter (fun e -> display_eq print_var e;print_string ">= 0\n") l;
   print_string "------------------------\n\n"
 
-let rec display_action = function
+let sbi = string_of_bigint
+
+let rec display_action print_var = function
   | act :: l -> begin match act with
       | DIVIDE_AND_APPROX (e1,e2,k,d) ->
           Printf.printf 
-            "Inequation E%d is divided by %d and the constant coefficient is \
-            rounded by substracting %d.\n" e1.id k d
+            "Inequation E%d is divided by %s and the constant coefficient is \
+            rounded by substracting %s.\n" e1.id (sbi k) (sbi d)
       | NOT_EXACT_DIVIDE (e,k) ->
           Printf.printf
             "Constant in equation E%d is not divisible by the pgcd \
-            %d of its other coefficients.\n" e.id k
+            %s of its other coefficients.\n" e.id (sbi k)
       | EXACT_DIVIDE (e,k) ->
           Printf.printf
             "Equation E%d is divided by the pgcd \
-            %d of its coefficients.\n" e.id k
+            %s of its coefficients.\n" e.id (sbi k)
       | WEAKEN (e,k) ->
           Printf.printf 
             "To ensure a solution in the dark shadow \
-            the equation E%d is weakened by %d.\n" e k
+            the equation E%d is weakened by %s.\n" e (sbi k)
       | SUM (e,(c1,e1),(c2,e2)) -> 
           Printf.printf
-            "We state %s E%d = %d %s E%d + %d %s E%d.\n" 
-            (kind_of e1.kind) e c1 (kind_of e1.kind) e1.id c2 
+            "We state %s E%d = %s %s E%d + %s %s E%d.\n" 
+            (kind_of e1.kind) e (sbi c1) (kind_of e1.kind) e1.id (sbi c2)
             (kind_of e2.kind) e2.id
-      | STATE (e,_,_,x,_) ->
-          Printf.printf "We define a new equation %d :" e.id; 
-          display_eq (e.body,e.constant); 
-          print_string (operator_of_eq e.kind); print_string " 0\n"
+      | STATE { st_new_eq = e } ->
+          Printf.printf "We define a new equation E%d: " e.id; 
+          display_eq print_var (e.body,e.constant); 
+          print_string (operator_of_eq e.kind); print_string " 0"
       | HYP e ->   
-          Printf.printf "We define %d :" e.id; 
-          display_eq (e.body,e.constant); 
+          Printf.printf "We define E%d: " e.id; 
+          display_eq print_var (e.body,e.constant); 
           print_string (operator_of_eq e.kind); print_string " 0\n"
       | FORGET_C e ->  Printf.printf "E%d is trivially satisfiable.\n" e
       | FORGET (e1,e2) -> Printf.printf "E%d subsumes E%d.\n" e1 e2
@@ -182,33 +210,34 @@ let rec display_action = function
          Printf.printf "E%d and E%d can be merged into E%d.\n" e1.id e2 e
       | CONTRADICTION (e1,e2) -> 
           Printf.printf
-            "equations E%d and E%d implie a contradiction on their \
+            "Equations E%d and E%d imply a contradiction on their \
             constant factors.\n" e1.id e2.id
       | NEGATE_CONTRADICT(e1,e2,b) ->
           Printf.printf
-            "Eqations E%d and E%d state that their body is at the same time
+            "Equations E%d and E%d state that their body is at the same time
             equal and different\n" e1.id e2.id
       | CONSTANT_NOT_NUL (e,k) -> 
-          Printf.printf "equation E%d states %d=0.\n" e k
+          Printf.printf "Equation E%d states %s = 0.\n" e (sbi k)
       | CONSTANT_NEG(e,k) -> 
-          Printf.printf "equation E%d states %d >= 0.\n" e k
+          Printf.printf "Equation E%d states %s >= 0.\n" e (sbi k)
       | CONSTANT_NUL e ->
-          Printf.printf "inequation E%d states 0 != 0.\n" e
+          Printf.printf "Inequation E%d states 0 != 0.\n" e
       | SPLIT_INEQ (e,(e1,l1),(e2,l2)) -> 
-          Printf.printf "equation E%d is split in E%d and E%d\n\n" e.id e1 e2;
-          display_action l1;
+          Printf.printf "Equation E%d is split in E%d and E%d\n\n" e.id e1 e2;
+          display_action print_var l1;
           print_newline ();
-          display_action l2;
+          display_action print_var l2;
           print_newline ()
-    end; display_action l
+    end; display_action print_var l
   | [] -> 
       flush stdout
 
-(*""*)
+let default_print_var v = Printf.sprintf "X%d" v (* For debugging *)
 
+(*""*)
 let add_event, history, clear_history =
   let accu = ref [] in
-  (fun (v : action) -> if !debug then display_action [v]; push v accu), 
+  (fun (v:action) -> if !debug then display_action default_print_var [v]; push v accu),
   (fun () -> !accu),
   (fun () -> accu := [])
 
@@ -218,7 +247,7 @@ let nf ((b : bool),(e,(x : int))) = (b,(nf_linear e,x))
 
 let map_eq_linear f = 
   let rec loop = function
-    | x :: l -> let c = f x.c in if c=0 then loop l else {v=x.v; c=c} :: loop l
+    | x :: l -> let c = f x.c in if c=?zero then loop l else {v=x.v; c=c} :: loop l
     | [] -> [] 
   in
   loop
@@ -227,28 +256,28 @@ let map_eq_afine f e =
   { id = e.id; kind = e.kind; body = map_eq_linear f e.body; 
     constant = f e.constant }
 
-let negate_eq = map_eq_afine (fun x -> -x)
+let negate_eq = map_eq_afine (fun x -> neg x)
 
 let rec sum p0 p1 = match (p0,p1) with 
   | ([], l) -> l | (l, []) -> l
   | (((x1::l1) as l1'), ((x2::l2) as l2')) -> 
       if x1.v = x2.v then
 	let c = x1.c + x2.c in
-	if c = 0 then sum l1 l2 else {v=x1.v;c=c} :: sum l1 l2
+	if c =? zero then sum l1 l2 else {v=x1.v;c=c} :: sum l1 l2
       else if x1.v > x2.v then 
 	x1 :: sum l1 l2'
       else 
 	x2 :: sum l1' l2
 
-let sum_afine eq1 eq2 = 
-  { kind = eq1.kind; id = new_id ();
+let sum_afine new_eq_id eq1 eq2 = 
+  { kind = eq1.kind; id = new_eq_id ();
     body = sum eq1.body eq2.body; constant = eq1.constant + eq2.constant }
 
 exception FACTOR1
 
 let rec chop_factor_1 = function
   | x :: l -> 
-      if abs x.c = 1 then x,l else let (c',l') = chop_factor_1 l in (c',x::l')
+    if abs x.c =? one then x,l else let (c',l') = chop_factor_1 l in (c',x::l')
   | [] -> raise FACTOR1
 
 exception CHOPVAR
@@ -261,24 +290,24 @@ let normalize ({id=id; kind=eq_flag; body=e; constant =x} as eq) =
   if e = [] then begin 
     match eq_flag with
       | EQUA ->
-          if x =0 then [] else begin
+          if x =? zero then [] else begin
             add_event (CONSTANT_NOT_NUL(id,x)); raise UNSOLVABLE
          end
       | DISE ->
-          if x <> 0 then [] else begin
+          if x <> zero then [] else begin
             add_event (CONSTANT_NUL id); raise UNSOLVABLE
           end
       | INEQ ->
-          if x >= 0 then [] else begin
+          if x >=? zero then [] else begin
             add_event (CONSTANT_NEG(id,x)); raise UNSOLVABLE
           end
   end else
     let gcd = pgcd_l (List.map (fun f -> abs f.c) e) in
-    if eq_flag=EQUA & x mod gcd <> 0 then begin
+    if eq_flag=EQUA & x mod gcd <> zero then begin
       add_event (NOT_EXACT_DIVIDE (eq,gcd)); raise UNSOLVABLE
-    end else if eq_flag=DISE & x mod gcd <> 0 then begin
+    end else if eq_flag=DISE & x mod gcd <> zero then begin
       add_event (FORGET_C eq.id); []
-    end else if gcd <> 1 then begin
+    end else if gcd <> one then begin
       let c = floor_div x gcd in
       let d = x - c * gcd in
       let new_eq = {id=id; kind=eq_flag; constant=c; 
@@ -288,97 +317,107 @@ let normalize ({id=id; kind=eq_flag; body=e; constant =x} as eq) =
       [new_eq]
     end else [eq]
 
-let eliminate_with_in {v=v;c=c_unite} eq2
+let eliminate_with_in new_eq_id {v=v;c=c_unite} eq2
                         ({body=e1; constant=c1} as eq1) =
   try
     let (f,_) = chop_var v e1 in 
-    let coeff = if c_unite=1 then -f.c else if c_unite= -1 then f.c 
+    let coeff = if c_unite=?one then neg f.c else if c_unite=? negone then f.c 
                 else failwith "eliminate_with_in" in
-    let res = sum_afine eq1 (map_eq_afine (fun c -> c * coeff) eq2) in
-    add_event (SUM (res.id,(1,eq1),(coeff,eq2))); res
+    let res = sum_afine new_eq_id eq1 (map_eq_afine (fun c -> c * coeff) eq2) in
+    add_event (SUM (res.id,(one,eq1),(coeff,eq2))); res
   with CHOPVAR -> eq1
 
-let omega_mod a b = a - b * floor_div (2 * a + b) (2 * b)
-let banerjee_step original l1 l2 = 
+let omega_mod a b = a - b * floor_div (two * a + b) (two * b)
+let banerjee_step (new_eq_id,new_var_id,print_var) original l1 l2 = 
   let e = original.body in
-  let sigma = new_var_num () in
+  let sigma = new_var_id () in
   let smallest,var =
     try
-      List.fold_left (fun (v,p) c ->  if v > (abs c.c) then abs c.c,c.v else (v,p))
+      List.fold_left (fun (v,p) c ->  if v >? (abs c.c) then abs c.c,c.v else (v,p))
               (abs (List.hd e).c, (List.hd e).v) (List.tl e)
-    with Failure "tl" -> display_system [original] ; failwith "TL" in
-  let m = smallest + 1 in
+    with Failure "tl" -> display_system print_var [original] ; failwith "TL" in
+  let m = smallest + one in
   let new_eq =
     { constant = omega_mod original.constant m;
-      body = {c= -m;v=sigma} :: 
+      body = {c= neg m;v=sigma} :: 
              map_eq_linear (fun a -> omega_mod a m) original.body;
-      id = new_id (); kind = EQUA } in
+      id = new_eq_id (); kind = EQUA } in
   let definition =
-    { constant = - floor_div (2 * original.constant + m) (2 * m);
-      body = map_eq_linear (fun a -> - floor_div (2 * a + m) (2 * m))
+    { constant = neg (floor_div (two * original.constant + m) (two * m));
+      body = map_eq_linear (fun a -> neg (floor_div (two * a + m) (two * m)))
                              original.body;
-      id = new_id (); kind = EQUA } in
-  add_event (STATE (new_eq,definition,original,m,sigma));
+      id = new_eq_id (); kind = EQUA } in
+  add_event (STATE {st_new_eq = new_eq; st_def = definition;
+		    st_orig = original; st_coef = m; st_var = sigma});
   let new_eq = List.hd (normalize new_eq) in
   let eliminated_var, def = chop_var var new_eq.body in
   let other_equations = 
-    flat_map (fun e -> normalize (eliminate_with_in eliminated_var new_eq e))
-             l1 in
+    Util.list_map_append
+      (fun e -> 
+        normalize (eliminate_with_in new_eq_id eliminated_var new_eq e)) l1 in
   let inequations = 
-    flat_map (fun e -> normalize (eliminate_with_in eliminated_var new_eq e))
-             l2 in
-  let original' = eliminate_with_in eliminated_var new_eq original in
+    Util.list_map_append
+      (fun e ->
+        normalize (eliminate_with_in new_eq_id eliminated_var new_eq e)) l2 in
+  let original' = eliminate_with_in new_eq_id eliminated_var new_eq original in
   let mod_original = map_eq_afine (fun c -> c / m) original' in
   add_event (EXACT_DIVIDE (original',m));
   List.hd (normalize mod_original),other_equations,inequations
 
-let rec eliminate_one_equation (e,other,ineqs) = 
-  if !debug then display_system (e::other);
+let rec eliminate_one_equation ((new_eq_id,new_var_id,print_var) as new_ids) (e,other,ineqs) = 
+  if !debug then display_system print_var (e::other);
   try
     let v,def = chop_factor_1 e.body in
-    (flat_map (fun e' -> normalize (eliminate_with_in v e e')) other,
-     flat_map (fun e' -> normalize (eliminate_with_in v e e')) ineqs)
-  with FACTOR1 -> eliminate_one_equation (banerjee_step e other ineqs)
-
-let rec banerjee (sys_eq,sys_ineq) =
+    (Util.list_map_append
+      (fun e' -> normalize (eliminate_with_in new_eq_id v e e')) other,
+     Util.list_map_append
+       (fun e' -> normalize (eliminate_with_in new_eq_id v e e')) ineqs)
+  with FACTOR1 ->
+    eliminate_one_equation new_ids (banerjee_step new_ids e other ineqs)
+
+let rec banerjee ((_,_,print_var) as new_ids) (sys_eq,sys_ineq) =
   let rec fst_eq_1 = function
      (eq::l) -> 
-        if List.exists (fun x -> abs x.c = 1) eq.body then eq,l
+        if List.exists (fun x -> abs x.c =? one) eq.body then eq,l
         else let (eq',l') = fst_eq_1 l in (eq',eq::l')
    | [] -> raise Not_found in
   match sys_eq with
-     [] -> if !debug then display_system sys_ineq; sys_ineq
+     [] -> if !debug then display_system print_var sys_ineq; sys_ineq
    | (e1::rest) -> 
        let eq,other = try fst_eq_1 sys_eq with Not_found -> (e1,rest) in
        if eq.body = [] then 
-         if eq.constant = 0 then begin
-           add_event (FORGET_C eq.id); banerjee (other,sys_ineq)
+         if eq.constant =? zero then begin
+           add_event (FORGET_C eq.id); banerjee new_ids (other,sys_ineq)
          end else begin
            add_event (CONSTANT_NOT_NUL(eq.id,eq.constant)); raise UNSOLVABLE
          end
-       else banerjee (eliminate_one_equation (eq,other,sys_ineq))
+       else
+	 banerjee new_ids 
+	   (eliminate_one_equation new_ids (eq,other,sys_ineq))
+
 type kind = INVERTED | NORMAL
-let redundancy_elimination system =
+
+let redundancy_elimination new_eq_id system =
   let normal = function
-     ({body=f::_} as e) when f.c < 0 ->  negate_eq e, INVERTED
+     ({body=f::_} as e) when f.c <? zero ->  negate_eq e, INVERTED
    | e -> e,NORMAL in
-  let table = create 7 in
+  let table = Hashtbl.create 7 in
   List.iter
     (fun e -> 
        let ({body=ne} as nx) ,kind = normal e in
        if ne = [] then
-         if nx.constant < 0 then begin
+         if nx.constant <? zero then begin
            add_event (CONSTANT_NEG(nx.id,nx.constant)); raise UNSOLVABLE
          end else add_event (FORGET_C nx.id)
        else
        try 
-         let (optnormal,optinvert) = find table ne in
+         let (optnormal,optinvert) = Hashtbl.find table ne in
          let final =
            if kind = NORMAL then begin
              match optnormal with 
                 Some v -> 
                   let kept =
-                    if v.constant < nx.constant 
+                    if v.constant <? nx.constant 
                     then begin add_event (FORGET (v.id,nx.id));v end
                     else begin add_event (FORGET (nx.id,v.id));nx end in
                   (Some(kept),optinvert)
@@ -386,32 +425,32 @@ let redundancy_elimination system =
            end else begin
              match optinvert with 
                 Some v ->
-                  let kept =
-                    if v.constant > nx.constant 
+                  let _kept =
+                    if v.constant >? nx.constant 
                     then begin add_event (FORGET_I (v.id,nx.id));v end
                     else begin add_event (FORGET_I (nx.id,v.id));nx end in
-                  (optnormal,Some(if v.constant > nx.constant then v else nx))
+                  (optnormal,Some(if v.constant >? nx.constant then v else nx))
               | None -> optnormal,Some nx
            end in
          begin match final with
             (Some high, Some low) -> 
-              if high.constant < low.constant then begin
+              if high.constant <? low.constant then begin
                 add_event(CONTRADICTION (high,negate_eq low));
                 raise UNSOLVABLE
               end
           | _ -> () end;
-         remove table ne;
-         add table ne final
+         Hashtbl.remove table ne;
+         Hashtbl.add table ne final
        with Not_found ->
-         add table ne 
+         Hashtbl.add table ne 
            (if kind = NORMAL then (Some nx,None) else (None,Some nx)))
     system;
   let accu_eq = ref [] in
   let accu_ineq = ref [] in
-  iter
+  Hashtbl.iter
     (fun p0 p1 -> match (p0,p1) with 
-       | (e, (Some x, Some y)) when x.constant = y.constant ->
-           let id=new_id () in
+       | (e, (Some x, Some y)) when x.constant =? y.constant ->
+           let id=new_eq_id () in
            add_event (MERGE_EQ(id,x,y.id));
            push {id=id; kind=EQUA; body=x.body; constant=x.constant} accu_eq
        | (e, (optnorm,optinvert)) ->
@@ -425,17 +464,17 @@ let redundancy_elimination system =
 exception SOLVED_SYSTEM
 
 let select_variable system =
-  let table = create 7 in
+  let table = Hashtbl.create 7 in
   let push v c= 
-    try let r = find table v in r := max !r (abs c)
-    with Not_found -> add table v (ref (abs c)) in
+    try let r = Hashtbl.find table v in r := max !r (abs c)
+    with Not_found -> Hashtbl.add table v (ref (abs c)) in
   List.iter (fun {body=l} -> List.iter (fun f -> push f.v f.c) l) system;
-  let vmin,cmin = ref (-1), ref 0 in
+  let vmin,cmin = ref (-1), ref zero in
   let var_cpt = ref 0 in
-  iter
+  Hashtbl.iter
     (fun v ({contents =  c}) ->
        incr var_cpt;
-       if c < !cmin or !vmin = (-1) then begin vmin := v; cmin := c end)
+       if c <? !cmin or !vmin = (-1) then begin vmin := v; cmin := c end)
     table;
   if !var_cpt < 1 then raise SOLVED_SYSTEM;
   !vmin
@@ -444,25 +483,25 @@ let classify v system =
   List.fold_left 
     (fun (not_occ,below,over) eq ->
        try let f,eq' = chop_var v eq.body in
-       if f.c >= 0 then (not_occ,((f.c,eq) :: below),over)
-       else (not_occ,below,((-f.c,eq) :: over))
+       if f.c >=? zero then (not_occ,((f.c,eq) :: below),over)
+       else (not_occ,below,((neg f.c,eq) :: over))
        with CHOPVAR -> (eq::not_occ,below,over))
     ([],[],[]) system
 
-let product dark_shadow low high =
+let product new_eq_id dark_shadow low high =
   List.fold_left
     (fun accu (a,eq1) ->
        List.fold_left
          (fun accu (b,eq2) ->
             let eq = 
-              sum_afine (map_eq_afine (fun c -> c * b) eq1)
+              sum_afine new_eq_id (map_eq_afine (fun c -> c * b) eq1)
                 (map_eq_afine (fun c -> c * a) eq2) in
             add_event(SUM(eq.id,(b,eq1),(a,eq2)));
             match normalize eq with
 	      | [eq] ->
                   let final_eq =
                     if dark_shadow then 
-                      let delta = (a - 1) * (b - 1) in
+                      let delta = (a - one) * (b - one) in
                       add_event(WEAKEN(eq.id,delta));
                       {id = eq.id; kind=INEQ; body = eq.body; 
                        constant = eq.constant - delta} 
@@ -473,33 +512,34 @@ let product dark_shadow low high =
          accu high)
     [] low
 
-let fourier_motzkin dark_shadow system =
+let fourier_motzkin (new_eq_id,_,print_var) dark_shadow system =
   let v = select_variable system in
   let (ineq_out, ineq_low,ineq_high) = classify v system in
-  let expanded = ineq_out @ product dark_shadow ineq_low ineq_high in
-  if !debug then display_system expanded; expanded
+  let expanded = ineq_out @ product new_eq_id dark_shadow ineq_low ineq_high in
+  if !debug then display_system print_var expanded; expanded
 
-let simplify dark_shadow system =
+let simplify ((new_eq_id,new_var_id,print_var) as new_ids) dark_shadow system =
   if List.exists (fun e -> e.kind = DISE) system then 
     failwith "disequation in simplify";
   clear_history ();
   List.iter (fun e -> add_event (HYP e)) system;
-  let system = flat_map normalize system in
-  let eqs,ineqs = filter (fun e -> e.kind=EQUA) system in
-  let simp_eq,simp_ineq = redundancy_elimination ineqs in
+  let system = Util.list_map_append normalize system in
+  let eqs,ineqs = List.partition (fun e -> e.kind=EQUA) system in
+  let simp_eq,simp_ineq = redundancy_elimination new_eq_id ineqs in
   let system = (eqs @ simp_eq,simp_ineq) in
   let rec loop1a system =
-    let sys_ineq = banerjee system in 
+    let sys_ineq = banerjee new_ids system in 
     loop1b sys_ineq 
   and loop1b sys_ineq =
-    let simp_eq,simp_ineq = redundancy_elimination sys_ineq in
+    let simp_eq,simp_ineq = redundancy_elimination new_eq_id sys_ineq in
     if simp_eq = [] then simp_ineq else loop1a (simp_eq,simp_ineq) 
   in
   let rec loop2 system =
     try
-      let expanded = fourier_motzkin dark_shadow system in
+      let expanded = fourier_motzkin new_ids dark_shadow system in
       loop2 (loop1b expanded)
-    with SOLVED_SYSTEM -> if !debug then display_system system; system 
+    with SOLVED_SYSTEM ->
+      if !debug then display_system print_var system; system 
   in
   loop2 (loop1a system)
 
@@ -520,11 +560,9 @@ let rec depend relie_on accu = function
 	      depend (e1.id::e2.id::relie_on) (act::accu) l
             else 
 	      depend relie_on accu l
-	| STATE (e,_,o,_,_) ->
-            if List.mem e.id relie_on then
-	      depend (o.id::relie_on) (act::accu) l
-            else
-	      depend relie_on accu l
+	| STATE {st_new_eq=e;st_orig=o} ->
+            if List.mem e.id relie_on then depend (o.id::relie_on) (act::accu) l
+            else depend relie_on accu l
 	| HYP e ->   
             if List.mem e.id relie_on then depend relie_on (act::accu) l
             else depend relie_on accu l
@@ -548,59 +586,68 @@ let rec depend relie_on accu = function
       end
   | [] -> relie_on, accu
 
-let solve system =
-  try let _ = simplify false system in failwith "no contradiction"
-  with UNSOLVABLE -> display_action (snd (depend [] [] (history ())))
+(*
+let depend relie_on accu trace = 
+  Printf.printf "Longueur de la trace initiale : %d\n" 
+    (trace_length trace + trace_length accu);
+  let rel',trace' = depend relie_on accu trace in
+  Printf.printf "Longueur de la trace simplifiée : %d\n" (trace_length trace');
+  rel',trace'
+*)
+
+let solve (new_eq_id,new_eq_var,print_var) system =
+  try let _ = simplify new_eq_id false system in failwith "no contradiction"
+  with UNSOLVABLE -> display_action print_var (snd (depend [] [] (history ())))
       
 let negation (eqs,ineqs) =
-  let diseq,_ = filter (fun e -> e.kind = DISE) ineqs in
+  let diseq,_ = List.partition (fun e -> e.kind = DISE) ineqs in
   let normal = function
-    | ({body=f::_} as e) when f.c < 0 ->  negate_eq e, INVERTED
+    | ({body=f::_} as e) when f.c <? zero ->  negate_eq e, INVERTED
     | e -> e,NORMAL in
-  let table = create 7 in
+  let table = Hashtbl.create 7 in
   List.iter (fun e -> 
                let {body=ne;constant=c} ,kind = normal e in
-               add table (ne,c) (kind,e)) diseq;
+               Hashtbl.add table (ne,c) (kind,e)) diseq;
   List.iter (fun e ->
-               if e.kind <> EQUA then pp 9999;
+               assert (e.kind = EQUA);
                let {body=ne;constant=c},kind = normal e in
                try 
-		 let (kind',e') = find table (ne,c) in
+		 let (kind',e') = Hashtbl.find table (ne,c) in
 		 add_event (NEGATE_CONTRADICT (e,e',kind=kind'));
 		 raise UNSOLVABLE
                with Not_found -> ()) eqs
 
 exception FULL_SOLUTION of action list * int list
 
-let simplify_strong system =
+let simplify_strong ((new_eq_id,new_var_id,print_var) as new_ids) system =
   clear_history ();
   List.iter (fun e -> add_event (HYP e)) system;
   (* Initial simplification phase *)
   let rec loop1a system =
     negation system;
-    let sys_ineq = banerjee system in 
+    let sys_ineq = banerjee new_ids system in 
     loop1b sys_ineq 
   and loop1b sys_ineq =
-    let dise,ine = filter (fun e -> e.kind = DISE) sys_ineq in
-    let simp_eq,simp_ineq = redundancy_elimination ine in
+    let dise,ine = List.partition (fun e -> e.kind = DISE) sys_ineq in
+    let simp_eq,simp_ineq = redundancy_elimination new_eq_id ine in
     if simp_eq = [] then dise @ simp_ineq
     else loop1a (simp_eq,dise @ simp_ineq) 
   in
   let rec loop2 system =
     try
-      let expanded = fourier_motzkin false system in
+      let expanded = fourier_motzkin new_ids false system in
       loop2 (loop1b expanded)
-    with SOLVED_SYSTEM -> if !debug then display_system system; system 
+    with SOLVED_SYSTEM -> if !debug then display_system print_var system; system 
   in
   let rec explode_diseq = function 
     | (de::diseq,ineqs,expl_map) ->
-	let id1 = new_id () 
-	and id2 = new_id () in
+	let id1 = new_eq_id () 
+	and id2 = new_eq_id () in
 	let e1 = 
-	  {id = id1; kind=INEQ; body = de.body; constant = de.constant - 1} in
+          {id = id1; kind=INEQ; body = de.body; constant = de.constant -one} in
 	let e2 = 
-	  {id = id2; kind=INEQ; body = map_eq_linear (fun x -> -x) de.body; 
-           constant = - de.constant - 1} in
+	  {id = id2; kind=INEQ; body = map_eq_linear neg de.body; 
+           constant = neg de.constant - one} in
 	let new_sys =
           List.map (fun (what,sys) -> ((de.id,id1,true)::what, e1::sys)) 
 	    ineqs @ 
@@ -611,13 +658,13 @@ let simplify_strong system =
     | ([],ineqs,expl_map) -> ineqs,expl_map 
   in
   try 
-    let system = flat_map normalize system in
-    let eqs,ineqs = filter (fun e -> e.kind=EQUA) system in
-    let dise,ine = filter (fun e -> e.kind = DISE) ineqs in
-    let simp_eq,simp_ineq = redundancy_elimination ine in
+    let system = Util.list_map_append normalize system in
+    let eqs,ineqs = List.partition (fun e -> e.kind=EQUA) system in
+    let dise,ine = List.partition (fun e -> e.kind = DISE) ineqs in
+    let simp_eq,simp_ineq = redundancy_elimination new_eq_id ine in
     let system = (eqs @ simp_eq,simp_ineq @ dise) in
     let system' = loop1a system in
-    let diseq,ineq = filter (fun e -> e.kind = DISE) system' in
+    let diseq,ineq = List.partition (fun e -> e.kind = DISE) system' in
     let first_segment = history () in
     let sys_exploded,explode_map = explode_diseq (diseq,[[],ineq],[]) in
     let all_solutions =
@@ -627,20 +674,21 @@ let simplify_strong system =
            try let _ = loop2 sys in raise NO_CONTRADICTION
            with UNSOLVABLE -> 
              let relie_on,path = depend [] [] (history ()) in
-             let dc,_ = filter (fun (_,id,_) -> List.mem id relie_on) decomp in
+             let dc,_ = List.partition (fun (_,id,_) -> List.mem id relie_on) decomp in
              let red = List.map (fun (x,_,_) -> x) dc in
              (red,relie_on,decomp,path))
         sys_exploded 
     in
     let max_count sys = 
-      let tbl = create 7 in
+      let tbl = Hashtbl.create 7 in
       let augment x = 
-        try incr (find tbl x) with Not_found -> add tbl x (ref 1) in
+        try incr (Hashtbl.find tbl x) 
+	with Not_found -> Hashtbl.add tbl x (ref 1) in
       let eq = ref (-1) and c = ref 0 in
       List.iter (function 
 		   | ([],r_on,_,path) -> raise (FULL_SOLUTION (path,r_on))
                    | (l,_,_,_) -> List.iter augment l) sys;
-      iter (fun x v -> if !v > !c then begin eq := x; c := !v end) tbl;
+      Hashtbl.iter (fun x v -> if !v > !c then begin eq := x; c := !v end) tbl;
       !eq 
     in
     let rec solve systems = 
@@ -649,17 +697,20 @@ let simplify_strong system =
         let rec sign = function 
 	  | ((id',_,b)::l) -> if id=id' then b else sign l 
           | [] -> failwith "solve" in
-        let s1,s2 = filter (fun (_,_,decomp,_) -> sign decomp) systems in
+        let s1,s2 =
+          List.partition (fun (_,_,decomp,_) -> sign decomp) systems in
         let s1' = 
-	  List.map (fun (dep,ro,dc,pa) -> (list_except id dep,ro,dc,pa)) s1 in
+	  List.map (fun (dep,ro,dc,pa) -> (Util.list_except id dep,ro,dc,pa)) s1 in
         let s2' = 
-	  List.map (fun (dep,ro,dc,pa) -> (list_except id dep,ro,dc,pa)) s2 in
+	  List.map (fun (dep,ro,dc,pa) -> (Util.list_except id dep,ro,dc,pa)) s2 in
         let (r1,relie1) = solve s1' 
 	and (r2,relie2) = solve s2' in
 	let (eq,id1,id2) = List.assoc id explode_map in
-	[SPLIT_INEQ(eq,(id1,r1),(id2, r2))], eq.id :: list_union relie1 relie2
+	[SPLIT_INEQ(eq,(id1,r1),(id2, r2))], eq.id :: Util.list_union relie1 relie2
       with FULL_SOLUTION (x0,x1) -> (x0,x1) 
     in
     let act,relie_on = solve all_solutions in
     snd(depend relie_on act first_segment)
   with UNSOLVABLE -> snd (depend [] [] (history ()))
+
+end
diff --git a/contrib/recdef/Recdef.v b/contrib/recdef/Recdef.v
new file mode 100644
index 00000000..2d206220
--- /dev/null
+++ b/contrib/recdef/Recdef.v
@@ -0,0 +1,48 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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 Compare_dec.
+Require Wf_nat.
+
+Section Iter.
+Variable A : Type.
+
+Fixpoint iter (n : nat) : (A -> A) -> A -> A :=
+  fun (fl : A -> A) (def : A) =>
+  match n with
+  | O => def
+  | S m => fl (iter m fl def)
+  end.
+End Iter.
+
+Theorem SSplus_lt : forall p p' : nat, p < S (S (p + p')).
+  intro p; intro p'; change (S p <= S (S (p + p'))); 
+    apply le_S; apply Gt.gt_le_S; change (p < S (p + p')); 
+    apply Lt.le_lt_n_Sm; apply Plus.le_plus_l.
+Qed.
+ 
+
+Theorem Splus_lt : forall p p' : nat, p' < S (p + p').
+  intro p; intro p'; change (S p' <= S (p + p')); 
+    apply Gt.gt_le_S; change (p' < S (p + p')); apply Lt.le_lt_n_Sm;
+       apply Plus.le_plus_r.
+Qed.
+
+Theorem le_lt_SS : forall x y, x <= y -> x < S (S y).
+intro x; intro y; intro H; change (S x <= S (S y)); 
+    apply le_S; apply Gt.gt_le_S; change (x < S y); 
+    apply Lt.le_lt_n_Sm; exact H.
+Qed.
+
+Inductive max_type (m n:nat) : Set :=
+  cmt : forall v, m <= v -> n <= v -> max_type m n.
+
+Definition max : forall m n:nat, max_type m n.
+intros m n; case (Compare_dec.le_gt_dec m n).
+intros h; exists n; [exact h | apply le_n].
+intros h; exists m; [apply le_n | apply Lt.lt_le_weak; exact h].
+Defined.
diff --git a/contrib/recdef/recdef.ml4 b/contrib/recdef/recdef.ml4
new file mode 100644
index 00000000..cf09e63a
--- /dev/null
+++ b/contrib/recdef/recdef.ml4
@@ -0,0 +1,1385 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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 camlp4deps: "parsing/grammar.cma" i*)
+
+open Term
+open Termops
+open Environ
+open Declarations
+open Entries
+open Pp
+open Names
+open Libnames
+open Nameops
+open Util
+open Closure
+open RedFlags
+open Tacticals
+open Typing
+open Tacmach
+open Tactics
+open Nametab
+open Declare
+open Decl_kinds
+open Tacred
+open Proof_type
+open Vernacinterp
+open Pfedit
+open Topconstr
+open Rawterm
+open Pretyping
+open Pretyping.Default
+open Safe_typing
+open Constrintern
+open Hiddentac
+
+open Equality
+open Auto
+open Eauto
+
+open Genarg
+
+
+let h_intros l = 
+  tclMAP h_intro l
+
+let do_observe_tac s tac g =
+  let goal = begin try (Printer.pr_goal (sig_it g)) with _ -> assert false end in
+ try let v = tac g in msgnl (goal ++ fnl () ++ (str s)++(str " ")++(str "finished")); v
+ with e ->
+   msgnl (str "observation "++str s++str " raised exception " ++ 
+	    Cerrors.explain_exn e ++ str "on goal " ++ goal ); 
+   raise e;;
+
+
+let observe_tac s tac g = tac g
+
+
+let hyp_ids = List.map id_of_string
+    ["x";"v";"k";"def";"p";"h";"n";"h'"; "anonymous"; "teq"; "rec_res";
+     "hspec";"heq"; "hrec"; "hex"; "teq"; "pmax";"hle"];;
+
+let rec nthtl = function
+    l, 0 -> l  | _::tl, n -> nthtl (tl, n-1) | [], _ -> [];;
+
+let hyp_id n l = List.nth l n;;
+
+let (x_id:identifier) = hyp_id 0 hyp_ids;;
+let (v_id:identifier) = hyp_id 1 hyp_ids;;
+let (k_id:identifier) = hyp_id 2 hyp_ids;;
+let (def_id:identifier) = hyp_id 3 hyp_ids;;
+let (p_id:identifier) = hyp_id 4 hyp_ids;;
+let (h_id:identifier) = hyp_id 5 hyp_ids;;
+let (n_id:identifier) = hyp_id 6 hyp_ids;;
+let (h'_id:identifier) = hyp_id 7 hyp_ids;;
+let (ano_id:identifier) = hyp_id 8 hyp_ids;;
+let (rec_res_id:identifier) = hyp_id 10 hyp_ids;;
+let (hspec_id:identifier) = hyp_id 11 hyp_ids;;
+let (heq_id:identifier) = hyp_id 12 hyp_ids;;
+let (hrec_id:identifier) = hyp_id 13 hyp_ids;;
+let (hex_id:identifier) = hyp_id 14 hyp_ids;;
+let (teq_id:identifier) = hyp_id 15 hyp_ids;;
+let (pmax_id:identifier) = hyp_id 16 hyp_ids;;
+let (hle_id:identifier) = hyp_id 17 hyp_ids;;
+
+let message s = if Options.is_verbose () then msgnl(str s);;
+
+let def_of_const t =
+   match (kind_of_term t) with
+    Const sp -> 
+      (try (match (Global.lookup_constant sp) with
+             {const_body=Some c} -> Declarations.force c
+	     |_ -> assert false)
+       with _ -> anomaly ("Cannot find definition of constant "^(string_of_id (id_of_label (con_label sp)))))
+    |_ -> assert false
+
+let type_of_const t =
+   match (kind_of_term t) with
+    Const sp -> 
+      (Global.lookup_constant sp).const_type
+    |_ -> assert false
+
+let arg_type t =
+  match kind_of_term (def_of_const t) with
+      Lambda(a,b,c) -> b
+    | _ -> assert false;;
+
+let evaluable_of_global_reference r =
+  match r with 
+      ConstRef sp -> EvalConstRef sp
+    | VarRef id -> EvalVarRef id
+    | _ -> assert false;;
+  
+let rec (find_call_occs:
+	   constr -> constr -> (constr list ->constr)*(constr  list list)) =
+ fun f expr ->
+  match (kind_of_term expr) with
+    App (g, args) when g = f -> 
+      (* For now we suppose that the function takes only one argument. *)
+      (fun l -> List.hd l), [Array.to_list args]
+  | App (g, args) ->
+     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)) -> 
+           (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)
+	 | _, [] ->
+	   (match find_call_occs f a with
+	     cf, (arg1::args) -> (fun l -> cf l::tl), (arg1::args)
+	   | _, [] -> (fun x -> a::tl), [])) in
+     begin
+       match (find_aux largs) with
+	   cf, [] -> (fun l -> mkApp(g, args)), []
+	 | cf, args ->
+	     (fun l -> mkApp (g, Array.of_list (cf l))), args
+     end
+  | Rel(_) -> error "find_call_occs : Rel"
+  | Var(id) -> (fun l -> expr), []
+  | Meta(_) -> error "find_call_occs : Meta"
+  | Evar(_) -> error "find_call_occs : Evar"
+  | Sort(_)  -> error "find_call_occs : Sort"
+  | Cast(_,_,_) -> error "find_call_occs : cast"
+  | Prod(_,_,_) -> error "find_call_occs : Prod"
+  | Lambda(_,_,_) -> error "find_call_occs : Lambda"
+  | LetIn(_,_,_,_) -> error "find_call_occs : let in"
+  | Const(_) -> (fun l -> expr), []
+  | Ind(_) -> (fun l -> expr), []
+  | Construct (_, _) -> (fun l -> expr), []
+  | Case(i,t,a,r) ->
+      (match find_call_occs f a with
+	cf, (arg1::args) -> (fun l -> mkCase(i, t, (cf l), r)),(arg1::args)
+      | _ -> (fun l -> mkCase(i, t, a, r)),[])
+  | 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;;
+
+let constant sl s =
+  constr_of_reference
+    (locate (make_qualid(Names.make_dirpath 
+			   (List.map id_of_string (List.rev sl)))
+	       (id_of_string s)));;
+
+let find_reference sl s =
+    (locate (make_qualid(Names.make_dirpath 
+			   (List.map id_of_string (List.rev sl)))
+	       (id_of_string s)));;
+
+let delayed_force f = f ()
+
+let le_lt_SS = function () -> (constant ["Recdef"] "le_lt_SS")
+let le_lt_n_Sm = function () -> (coq_constant "le_lt_n_Sm")
+
+let le_trans = function () -> (coq_constant "le_trans")
+let le_lt_trans = function () -> (coq_constant "le_lt_trans")
+let lt_S_n = function () -> (coq_constant "lt_S_n")
+let le_n = function () -> (coq_constant "le_n")
+let refl_equal = function () -> (coq_constant "refl_equal")
+let eq = function () -> (coq_constant "eq")
+let ex = function () -> (coq_constant "ex")
+let coq_sig_ref = function () -> (find_reference ["Coq";"Init";"Specif"] "sig")
+let coq_sig = function () -> (coq_constant "sig")
+let coq_O = function () -> (coq_constant "O")
+let coq_S = function () -> (coq_constant "S")
+
+let gt_antirefl = function () -> (coq_constant "gt_irrefl")
+let lt_n_O = function () -> (coq_constant "lt_n_O")
+let lt_n_Sn = function () -> (coq_constant "lt_n_Sn")
+
+let f_equal = function () -> (coq_constant "f_equal")
+let well_founded_induction = function () -> (coq_constant "well_founded_induction")
+let well_founded = function () -> (coq_constant "well_founded")
+let acc_rel = function () -> (coq_constant "Acc")
+let acc_inv_id = function () -> (coq_constant "Acc_inv")
+let well_founded_ltof = function () ->  (Coqlib.coq_constant "" ["Arith";"Wf_nat"] "well_founded_ltof")
+let iter_ref = function () -> (try find_reference ["Recdef"] "iter" with Not_found -> error "module Recdef not loaded")
+let max_ref = function () -> (find_reference ["Recdef"] "max")
+let iter = function () -> (constr_of_reference (delayed_force iter_ref))
+let max_constr = function () -> (constr_of_reference (delayed_force max_ref))
+
+let ltof_ref = function  () -> (find_reference ["Coq";"Arith";"Wf_nat"] "ltof")
+let coq_conj = function () -> find_reference ["Coq";"Init";"Logic"] "conj"
+
+(* These are specific to experiments in nat with lt as well_founded_relation, *)
+(*    but this should be made more general. *)
+let nat = function () -> (coq_constant "nat")
+let lt = function () -> (coq_constant "lt")
+
+let  mkCaseEq a  : tactic =
+     (fun g ->
+(* commentaire de Yves: on pourra avoir des problemes si
+   a n'est pas bien type dans l'environnement du but *)
+       let type_of_a = pf_type_of g a in
+       (tclTHEN (generalize [mkApp(delayed_force refl_equal, [| type_of_a; a|])])
+	  (tclTHEN 
+	     (fun g2 ->
+		change_in_concl None 
+		  (pattern_occs [([2], a)] (pf_env g2) Evd.empty (pf_concl g2))
+		  g2)
+	     (simplest_case a))) g);;
+
+let rec  mk_intros_and_continue (extra_eqn:bool)
+    cont_function (eqs:constr list) (expr:constr) g =
+  let ids = pf_ids_of_hyps g in
+  match kind_of_term expr with
+    | Lambda (n, _, b) -> 
+     	let n1 = 
+	  match n with
+      	      Name x -> x
+            | Anonymous -> ano_id
+	in
+     	let new_n = next_global_ident_away true n1 ids in
+	  tclTHEN (h_intro new_n)
+	    (mk_intros_and_continue extra_eqn cont_function eqs 
+	       (subst1 (mkVar new_n) b)) g
+    | _ -> 
+ 	if extra_eqn then
+	  let teq = next_global_ident_away true teq_id ids in
+	    tclTHEN (h_intro teq)	
+	      (cont_function (mkVar teq::eqs) expr) g
+	else
+	  cont_function eqs expr g
+
+let const_of_ref = function
+    ConstRef kn -> kn
+  | _ -> anomaly "ConstRef expected"
+
+let simpl_iter () =
+  reduce 
+    (Lazy 
+       {rBeta=true;rIota=true;rZeta= true; rDelta=false;
+        rConst = [ EvalConstRef (const_of_ref (delayed_force iter_ref))]})
+    onConcl
+    
+let tclUSER is_mes l g = 
+  let b,l = 
+    match l with 
+	None -> true,[]
+      | Some l -> false,l
+  in
+  tclTHENSEQ 
+    [
+      (h_clear b l);
+      if is_mes 
+      then unfold_in_concl [([], evaluable_of_global_reference (delayed_force ltof_ref))]
+      else tclIDTAC
+    ]
+    g
+    
+    
+let list_rewrite (rev:bool) (eqs: constr list) =
+  tclREPEAT
+    (List.fold_right
+       (fun eq i -> tclORELSE (rewriteLR eq) i)
+       (if rev then (List.rev eqs) else eqs) (tclFAIL 0 (mt())));;
+
+let base_leaf_terminate (func:global_reference) eqs expr =
+(*  let _ = msgnl (str "entering base_leaf") in *)
+  (fun g ->
+     let ids = pf_ids_of_hyps g in
+     let k' = next_global_ident_away true k_id ids in
+     let h = next_global_ident_away true h_id (k'::ids) in
+       tclTHENLIST [observe_tac "first split" (split (ImplicitBindings [expr]));
+		    observe_tac "second split" (split (ImplicitBindings [delayed_force coq_O]));
+		    observe_tac "intro k" (h_intro k');
+                    observe_tac "case on k" 
+		      (tclTHENS 
+			 (simplest_case (mkVar k'))
+			 [(tclTHEN (h_intro h) 
+		     	     (tclTHEN (simplest_elim 
+					 (mkApp (delayed_force gt_antirefl,
+						 [| delayed_force coq_O |])))
+				default_auto)); tclIDTAC ]);
+                    intros;
+
+		    simpl_iter();
+		    unfold_constr func;
+                    list_rewrite true eqs;
+		    default_auto ] g);;
+
+(* La fonction est donnee en premier argument a la 
+   fonctionnelle suivie d'autres Lambdas et de Case ...
+   Pour recuperer la fonction f a partir de la 
+   fonctionnelle *)
+let get_f foncl = 
+  match (kind_of_term (def_of_const foncl)) with
+      Lambda (Name f, _, _) -> f  
+    |_ -> error "la fonctionnelle est mal definie";;
+
+
+let rec compute_le_proofs = function
+    [] -> assumption
+  | a::tl ->
+      tclORELSE assumption 
+	(tclTHENS
+	   (apply_with_bindings
+	      (delayed_force le_trans,
+	       ExplicitBindings[dummy_loc,NamedHyp(id_of_string "m"),a]))
+	   [compute_le_proofs tl; 
+            tclORELSE (apply (delayed_force le_n)) assumption])
+
+let make_lt_proof pmax le_proof =
+  tclTHENS
+    (apply_with_bindings
+       (delayed_force le_lt_trans,
+	ExplicitBindings[dummy_loc,NamedHyp(id_of_string "m"), pmax]))
+    [compute_le_proofs le_proof; 
+     tclTHENLIST[apply (delayed_force lt_S_n); default_full_auto]];;
+
+let rec list_cond_rewrite k def pmax cond_eqs le_proofs =
+  match cond_eqs with
+    [] -> tclIDTAC
+  | eq::eqs ->
+      tclTHENS
+	(general_rewrite_bindings false
+	 (mkVar eq,
+	    ExplicitBindings[dummy_loc,   NamedHyp k_id, mkVar k;
+			     dummy_loc,   NamedHyp def_id, mkVar def]))
+	[list_cond_rewrite k def pmax eqs le_proofs;
+         make_lt_proof pmax le_proofs];;
+
+
+let rec introduce_all_equalities func eqs values specs bound le_proofs 
+    cond_eqs =
+  match specs with
+    [] -> 
+      fun g ->
+	let ids = pf_ids_of_hyps g in
+	let s_max = mkApp(delayed_force coq_S, [|bound|]) in
+	let k = next_global_ident_away true k_id ids in
+        let ids = k::ids in
+	let h' = next_global_ident_away true (h'_id) ids in
+        let ids = h'::ids in
+	let def = next_global_ident_away true def_id ids in
+	tclTHENLIST
+	  [observe_tac "introduce_all_equalities_final split" (split (ImplicitBindings [s_max]));
+	   observe_tac "introduce_all_equalities_final intro k" (h_intro  k);
+	   tclTHENS
+	     (observe_tac "introduce_all_equalities_final case k" (simplest_case (mkVar k)))
+	     [tclTHENLIST[h_intro h';
+			  simplest_elim(mkApp(delayed_force lt_n_O,[|s_max|]));
+			  default_full_auto]; tclIDTAC];
+	   observe_tac "clearing k " (clear [k]);
+	   h_intros [k;h';def];
+	   simpl_iter();
+	   unfold_in_concl[([1],evaluable_of_global_reference func)];
+	   list_rewrite true eqs;
+           list_cond_rewrite  k def bound cond_eqs le_proofs;
+	   apply (delayed_force refl_equal)] g
+  | spec1::specs ->
+      fun g ->
+	let ids = ids_of_named_context (pf_hyps g) in
+	let p = next_global_ident_away true p_id ids in
+        let ids = p::ids in
+	let pmax = next_global_ident_away true pmax_id ids in
+        let ids = pmax::ids in
+	let hle1 = next_global_ident_away true hle_id ids in
+        let ids = hle1::ids in
+	let hle2 = next_global_ident_away true  hle_id ids in
+	let ids = hle2::ids in
+	let heq = next_global_ident_away true heq_id ids in
+	tclTHENLIST
+	  [simplest_elim (mkVar spec1);
+	   list_rewrite true eqs;
+	   h_intros [p; heq];
+	   simplest_elim (mkApp(delayed_force max_constr, [| bound; mkVar p|]));
+	   h_intros [pmax; hle1; hle2];
+	   introduce_all_equalities func eqs values specs 
+	     (mkVar pmax) ((mkVar pmax)::le_proofs)
+	     (heq::cond_eqs)] g;;
+    
+let string_match  s =
+ try 
+  for i = 0 to 3  do
+    if String.get s i <> String.get "Acc_" i then failwith ""
+  done;
+ with Invalid_argument _ -> failwith ""
+	  
+let retrieve_acc_var g = 
+  (* Julien: I don't like this version .... *) 
+  let hyps = pf_ids_of_hyps g  in 
+  map_succeed 
+    (fun id -> 
+       try 
+	 string_match (string_of_id id);
+	 id
+       with _ -> failwith "")
+    hyps 
+
+let rec introduce_all_values is_mes acc_inv func context_fn
+    eqs  hrec args values specs =
+    (match args with
+    [] -> 
+      tclTHENLIST
+	[split(ImplicitBindings
+		 [context_fn (List.map mkVar (List.rev values))]);
+	 observe_tac "introduce_all_equalities" (introduce_all_equalities func eqs
+	   (List.rev values) (List.rev specs) (delayed_force coq_O) [] [])]
+  | arg::args ->
+      (fun g ->
+	let ids = ids_of_named_context (pf_hyps g) in
+	let rec_res = next_global_ident_away true rec_res_id ids in
+        let ids = rec_res::ids in
+	let hspec = next_global_ident_away true hspec_id ids in
+	let tac = introduce_all_values is_mes acc_inv func context_fn eqs 
+	  hrec args
+	  (rec_res::values)(hspec::specs) in
+	(tclTHENS
+	   (simplest_elim (mkApp(mkVar hrec, Array.of_list arg)))
+	   [tclTHENLIST [h_intros [rec_res; hspec];
+			 tac]; 
+	    (tclTHENS
+		 (apply (Lazy.force acc_inv))
+		 [ h_assumption
+		 ;
+		   (fun g ->  
+		      tclUSER
+			is_mes
+			(Some (hrec::hspec::(retrieve_acc_var g)@specs))
+			g
+		   )
+		 ]
+	    )
+	   ]) g)
+	
+    )
+ 
+	   
+let rec_leaf_terminate is_mes acc_inv hrec (func:global_reference) eqs expr =
+  match find_call_occs (mkVar (get_f (constr_of_reference func))) expr with
+  | context_fn, args ->
+      observe_tac "introduce_all_values" 
+	(introduce_all_values is_mes acc_inv func context_fn eqs  hrec args  [] [])
+
+(* 
+let rec proveterminate is_mes acc_inv (hrec:identifier)  
+  (f_constr:constr) (func:global_reference) (eqs:constr list) (expr:constr)  =
+try
+(*  let _ = msgnl (str "entering proveterminate") in *)
+  let v =
+  match (kind_of_term expr) with
+      Case (_, t, a, l) -> 
+	(match find_call_occs f_constr a with
+	     _,[] ->
+      	       tclTHENS (fun g ->
+(* 			   let _ = msgnl(str "entering mkCaseEq") in *)
+			   let v = (mkCaseEq a) g in 
+(* 			   let _ = msgnl (str "exiting mkCaseEq") in *)
+			   v
+			)
+   	         (List.map (mk_intros_and_continue true
+                              (proveterminate is_mes acc_inv hrec f_constr func)
+                              eqs)
+	            (Array.to_list l))
+	   | _, _::_ -> 
+	       (
+		 match find_call_occs  f_constr expr with
+	     	     _,[] -> observe_tac "base_leaf" (base_leaf func eqs expr)
+		   | _, _:: _ -> 
+		       observe_tac "rec_leaf" (rec_leaf is_mes acc_inv hrec  func eqs expr)
+	       )
+	)
+    | _ ->  (match find_call_occs  f_constr expr with
+	     	_,[] -> 
+		  (try 
+		    observe_tac "base_leaf" (base_leaf func eqs expr)
+		   with e -> (msgerrnl (str "failure in base case");raise e ))
+	       | _, _::_ -> 
+		   observe_tac "rec_leaf" (rec_leaf is_mes acc_inv hrec  func eqs expr)
+	 ) in
+  (*  let _ = msgnl(str "exiting proveterminate") in *)
+  v
+with e -> 
+  msgerrnl(str "failure in proveterminate"); 
+  raise e
+*)
+let proveterminate is_mes acc_inv (hrec:identifier)  
+  (f_constr:constr) (func:global_reference) base_leaf rec_leaf = 
+  let rec proveterminate (eqs:constr list) (expr:constr)  =
+    try
+      (*  let _ = msgnl (str "entering proveterminate") in *)
+      let v =
+	match (kind_of_term expr) with
+	    Case (_, t, a, l) -> 
+	      (match find_call_occs f_constr a with
+		   _,[] ->
+      		     tclTHENS 
+		       (fun g ->
+			  (* let _ = msgnl(str "entering mkCaseEq") in *)
+			  let v = (mkCaseEq a) g in 
+			  (* let _ = msgnl (str "exiting mkCaseEq") in *)
+			  v
+		       )
+   	               (List.map 
+			  (mk_intros_and_continue true proveterminate eqs)
+			  (Array.to_list l)
+		       )
+		 | _, _::_ -> 
+		     (
+		       match find_call_occs  f_constr expr with
+	     		   _,[] -> observe_tac "base_leaf" (base_leaf func eqs expr)
+			 | _, _:: _ -> 
+			     observe_tac "rec_leaf" 
+			       (rec_leaf is_mes acc_inv hrec  func eqs expr)
+		     )
+	      )
+	  | _ ->  (match find_call_occs  f_constr expr with
+	     	       _,[] -> 
+			 (try 
+			    observe_tac "base_leaf" (base_leaf func eqs expr)
+			  with e -> 
+			    (msgerrnl (str "failure in base case");raise e ))
+		     | _, _::_ -> 
+			 observe_tac "rec_leaf" 
+			   (rec_leaf is_mes acc_inv hrec  func eqs expr)
+		  ) in
+      (*  let _ = msgnl(str "exiting proveterminate") in *)
+      v
+    with e -> 
+      msgerrnl(str "failure in proveterminate"); 
+      raise e
+  in 
+  proveterminate 
+
+let hyp_terminates func = 
+  let a_arrow_b = arg_type (constr_of_reference func) in 
+  let rev_args,b = decompose_prod a_arrow_b in 
+  let left = 
+    mkApp(delayed_force iter, 
+	  Array.of_list 
+	    (lift 5 a_arrow_b:: mkRel 3::
+	       constr_of_reference func::mkRel 1::
+	       List.rev (list_map_i (fun i _ -> mkRel (6+i)) 0 rev_args)
+	    )
+	 )
+  in
+  let right = mkRel 5 in 
+  let equality = mkApp(delayed_force eq, [|lift 5 b; left; right|]) in
+  let result = (mkProd ((Name def_id) , lift 4 a_arrow_b, equality)) in
+  let cond = mkApp(delayed_force lt, [|(mkRel 2); (mkRel 1)|]) in
+  let nb_iter =
+    mkApp(delayed_force ex,
+	  [|delayed_force nat;
+	    (mkLambda 
+	       (Name
+		  p_id,
+		  delayed_force nat, 
+		  (mkProd (Name k_id, delayed_force nat, 
+			   mkArrow cond result))))|])in
+  let value = mkApp(delayed_force coq_sig, 
+		    [|b;
+		      (mkLambda (Name v_id, b, nb_iter))|]) in
+  compose_prod rev_args value
+	     
+
+
+let tclUSER_if_not_mes is_mes = 
+  if is_mes 
+  then 
+    tclCOMPLETE (h_apply (delayed_force well_founded_ltof,Rawterm.NoBindings))
+  else tclUSER is_mes None
+
+let start 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
+      let pre_rec_args = 
+	List.rev_map
+	  mkVar (fst (list_chop (rec_arg_num - 1) args_id)) 
+      in 
+      let relation = substl pre_rec_args relation in 
+      let input_type = substl pre_rec_args input_type in 
+      let wf_thm = next_global_ident_away true (id_of_string ("wf_R")) ids in 
+      let wf_rec_arg = 
+	next_global_ident_away true 
+	  (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 acc_inv = 
+	  lazy (
+	    mkApp (
+	      delayed_force acc_inv_id,
+	      [|input_type;relation;mkVar rec_arg_id|]
+	    )
+	  )
+      in
+      tclTHEN
+	(h_intros args_id)
+	(tclTHENS
+	   (observe_tac 
+	      "first assert" 
+	      (assert_tac 
+		 true (* the assert thm is in first subgoal *)
+		 (Name wf_rec_arg) 
+		 (mkApp (delayed_force acc_rel,
+			 [|input_type;relation;mkVar rec_arg_id|])
+		 )
+	      )
+	   )
+	   [
+	     (* accesibility proof *) 
+	     tclTHENS 
+	       (observe_tac 
+		  "second assert" 
+		  (assert_tac 
+		     true 
+		     (Name wf_thm)
+		     (mkApp (delayed_force well_founded,[|input_type;relation|]))
+		  )
+	       )
+	       [ 
+		 (* interactive proof of the well_foundness of the relation *) 
+		 wf_tac is_mes;
+		 (* well_foundness -> Acc for any element *)
+		 observe_tac 
+		   "apply wf_thm" 
+		   (h_apply ((mkApp(mkVar wf_thm,
+				    [|mkVar rec_arg_id |])),Rawterm.NoBindings)
+		   )
+	       ]
+	     ;
+	     (* rest of the proof *)
+	     tclTHENSEQ 
+	       [observe_tac "generalize" 
+		  (onNLastHyps (nargs+1)
+		     (fun (id,_,_) -> 
+			tclTHEN (generalize [mkVar id]) (h_clear false [id])
+		     ))
+	       ;
+		observe_tac "h_fix" (h_fix (Some hrec) (nargs+1));
+		h_intros args_id;
+		h_intro wf_rec_arg;
+		observe_tac "tac" (tac hrec acc_inv)
+	       ]
+	   ]
+	) g  
+  end
+
+
+
+let rec instantiate_lambda t l = 
+  match l with
+  | [] -> t
+  | a::l -> 
+      let (bound_name, _, body) = destLambda t in
+      instantiate_lambda (subst1 a body) l
+;;
+
+
+let whole_start is_mes func input_type relation rec_arg_num  : tactic = 
+  begin 
+    fun g -> 
+      let ids = ids_of_named_context (pf_hyps g) in
+      let func_body = (def_of_const (constr_of_reference func)) in
+      let (f_name, _, body1) = destLambda func_body in
+      let f_id =
+	match f_name with
+	  | Name f_id -> next_global_ident_away true f_id ids
+	  | Anonymous -> assert false 
+      in
+      let n_names_types,_ = decompose_lam body1 in 
+      let n_ids,ids = 
+	List.fold_left 
+	  (fun (n_ids,ids) (n_name,_) -> 
+	     match n_name with 
+	       | Name id -> 
+		   let n_id = next_global_ident_away true id ids in 
+		   n_id::n_ids,n_id::ids
+	       | _ -> assert false
+	  )
+	  ([],(f_id::ids))
+	  n_names_types
+      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 
+	is_mes
+	input_type
+	ids
+	n_ids
+	relation 
+	rec_arg_num
+	rec_arg_id
+	(fun hrec acc_inv g ->  
+           (proveterminate 
+	      is_mes
+	      acc_inv 
+	      hrec
+	      (mkVar f_id)
+	      func
+	      base_leaf_terminate 
+	      rec_leaf_terminate
+	      []
+	      expr
+	   )
+	     g 
+	)
+	tclUSER_if_not_mes
+	g 
+  end
+
+
+let get_current_subgoals_types () = 
+  let pts =  get_pftreestate () in 
+  let _,subs = extract_open_pftreestate pts in 
+  List.map snd subs 
+
+
+let build_and_l l = 
+  let and_constr =  Coqlib.build_coq_and () in 
+  let conj_constr = coq_conj () in 
+  let mk_and p1 p2 = 
+    Term.mkApp(and_constr,[|p1;p2|]) in 
+  let rec f  = function 
+    | [] -> assert false 
+    | [p] -> p,tclIDTAC,1 
+    | p1::pl -> 
+	let c,tac,nb = f pl in 
+	mk_and p1 c, 
+	tclTHENS
+	  (apply (constr_of_reference conj_constr)) 
+	  [tclIDTAC;
+	   tac
+	  ],nb+1
+  in f l
+
+let build_new_goal_type () = 
+  let sub_gls_types = get_current_subgoals_types () in 
+  let res = build_and_l sub_gls_types in 
+  res
+  
+
+
+let interpretable_as_section_decl d1 d2 = match d1,d2 with
+  | (_,Some _,_), (_,None,_) -> false
+  | (_,Some b1,t1), (_,Some b2,t2) -> eq_constr b1 b2 & eq_constr t1 t2
+  | (_,None,t1), (_,_,t2) -> eq_constr t1 t2
+
+
+
+
+(* let final_decompose lemma n : tactic =   *)
+(*   fun gls ->  *)
+(*     let hid = next_global_ident_away true h_id (pf_ids_of_hyps gls) in  *)
+(*     tclTHENSEQ  *)
+(*       [ *)
+(* 	generalize [lemma]; *)
+(* 	tclDO  *)
+(* 	  n  *)
+(* 	  (tclTHENSEQ  *)
+(* 	     [h_intro hid; *)
+(* 	      h_case (mkVar hid,Rawterm.NoBindings);  *)
+(* 	      clear [hid];  *)
+(* 	      intro_patterns [Genarg.IntroWildcard] *)
+(* 	     ] *)
+(* 	  ); *)
+(* 	h_intro hid; *)
+(* 	tclTRY  *)
+(* 	  (tclTHENSEQ [h_case (mkVar hid,Rawterm.NoBindings);  *)
+(* 		       clear [hid];  *)
+(* 		       h_intro hid; *)
+(* 		       intro_patterns [Genarg.IntroWildcard] *)
+(* 		      ]); *)
+(* 	e_resolve_constr (mkVar hid); *)
+(* 	e_assumption *)
+(*       ] *)
+(*       gls *)
+
+
+    
+let prove_with_tcc lemma _ : tactic = 
+  fun gls ->
+    let hid = next_global_ident_away true h_id (pf_ids_of_hyps gls) in 
+    tclTHENSEQ 
+      [
+	generalize [lemma];
+	h_intro hid;
+	Elim.h_decompose_and (mkVar hid); 
+	gen_eauto(* default_eauto *) false (false,5) [] (Some [])
+	  (* 	      default_auto *)
+      ]
+      gls
+      
+	     
+
+let open_new_goal 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 
+    | None   ->  
+	try (add_suffix current_proof_name "_subproof") with _ -> assert false 
+	  
+  in  
+  let sign = Global.named_context () in
+  let sign = clear_proofs sign in
+  let na = next_global_ident_away false name [] in
+  if occur_existential gls_type then
+    Util.error "\"abstract\" cannot handle existentials";
+  (*   let v =     let lemme =  mkConst (Lib.make_con na) in  *)
+(*     Tactics.exact_no_check  *)
+(*       (applist (lemme,  *)
+(* 		List.rev (Array.to_list (Sign.instance_from_named_context sign)))) *)
+(*       gls in  *)
+  
+  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 ());
+    ref := Some lemma ;
+    Command.save_named true;
+  in
+  start_proof
+    na
+    (Decl_kinds.Global, Decl_kinds.Proof Decl_kinds.Lemma) 
+    sign
+    gls_type 
+    hook ;
+  by (decompose_and_tac);
+  ()
+    
+let com_terminate ref is_mes fonctional_ref input_type relation rec_arg_num
+    thm_name hook =
+  let (evmap, env) = Command.get_current_context() in
+  start_proof thm_name
+    (Global, Proof Lemma) (Environ.named_context_val env)
+    (hyp_terminates fonctional_ref) hook;
+  by (observe_tac "whole_start" (whole_start is_mes fonctional_ref
+				       input_type relation rec_arg_num ));
+  open_new_goal ref
+     None
+     (build_new_goal_type ())
+  
+
+    
+
+let ind_of_ref = function 
+  | IndRef (ind,i) -> (ind,i)
+  | _ -> anomaly "IndRef expected"
+
+let (value_f:constr list -> global_reference -> constr) =
+  fun al fterm ->
+    let d0 = dummy_loc in 
+    let rev_x_id_l =  
+      (
+	List.fold_left 
+	  (fun x_id_l _ -> 
+	     let x_id = next_global_ident_away true x_id x_id_l in 
+	     x_id::x_id_l
+	  )
+	  []
+	  al
+      )
+    in
+    let fun_body = 
+      RCases
+	(d0,None,
+	 [RApp(d0, RRef(d0,fterm), List.rev_map (fun x_id -> RVar(d0, x_id)) rev_x_id_l),
+	  (Anonymous,None)],
+	 [d0, [v_id], [PatCstr(d0,(ind_of_ref 
+				     (delayed_force coq_sig_ref),1),
+			       [PatVar(d0, Name v_id);
+				PatVar(d0, Anonymous)],
+			       Anonymous)],
+	  RVar(d0,v_id)])
+    in
+    let value =
+      List.fold_left2 
+	(fun acc x_id a -> 
+	   RLambda
+      	     (d0, Name x_id, RDynamic(d0, constr_in a),
+	      acc
+	     ) 
+	)
+	fun_body
+	rev_x_id_l
+	(List.rev al)
+    in
+    understand Evd.empty (Global.env()) value;;
+
+let (declare_fun : identifier -> logical_kind -> constr -> global_reference) =
+  fun f_id kind value ->
+    let ce = {const_entry_body = value;
+	      const_entry_type = None;
+	      const_entry_opaque = false;
+              const_entry_boxed = true} in
+      ConstRef(declare_constant f_id (DefinitionEntry ce, kind));;
+
+let (declare_f : identifier -> logical_kind -> constr list -> global_reference -> global_reference) =
+  fun f_id kind input_type fterm_ref ->
+    declare_fun f_id kind (value_f input_type fterm_ref);;
+
+let start_equation (f:global_reference) (term_f:global_reference) 
+  (cont_tactic:identifier list -> tactic) g =
+  let ids = pf_ids_of_hyps g in
+  let terminate_constr = constr_of_reference term_f in 
+  let nargs = nb_prod (type_of_const terminate_constr) in 
+  let x = 
+    let rec f ids n =
+      if n = 0 
+      then []
+      else 
+	let x = next_global_ident_away true x_id ids in 
+	x::f (x::ids) (n-1)
+    in
+    f ids nargs
+  in
+  tclTHENLIST [
+    h_intros x;
+    unfold_constr f;
+    simplest_case (mkApp (terminate_constr, Array.of_list (List.map mkVar x)));
+    cont_tactic x] g
+;;
+
+let base_leaf_eq func eqs f_id g =
+  let ids = pf_ids_of_hyps g in
+  let k = next_global_ident_away true k_id ids in
+  let p = next_global_ident_away true p_id (k::ids) in
+  let v = next_global_ident_away true v_id (p::k::ids) in
+  let heq = next_global_ident_away true heq_id (v::p::k::ids) in
+  let heq1 = next_global_ident_away true heq_id (heq::v::p::k::ids) in
+  let hex = next_global_ident_away true hex_id (heq1::heq::v::p::k::ids) in
+    tclTHENLIST [
+      h_intros [v; hex]; 
+      simplest_elim (mkVar hex);
+      h_intros [p;heq1];
+      tclTRY
+	(rewriteRL 
+	   (mkApp(mkVar heq1, 
+		  [|mkApp (delayed_force coq_S, [|mkVar p|]);
+		    mkApp(delayed_force lt_n_Sn, [|mkVar p|]); f_id|])));
+      simpl_iter();
+      unfold_in_concl [([1], evaluable_of_global_reference func)];
+      list_rewrite true eqs;
+      apply (delayed_force refl_equal)] g;;
+
+let f_S t = mkApp(delayed_force coq_S, [|t|]);;
+
+let rec introduce_all_values_eq  cont_tac functional termine 
+    f p heq1 pmax bounds le_proofs eqs ids =
+  function
+      [] ->
+	tclTHENLIST
+	  [tclTHENS
+	     (general_rewrite_bindings false
+		(mkVar heq1,
+		 ExplicitBindings[dummy_loc,NamedHyp k_id,
+				  f_S(f_S(mkVar pmax));
+				  dummy_loc,NamedHyp def_id,
+				  f]))
+	     [tclTHENLIST
+		[simpl_iter();
+		 unfold_constr (reference_of_constr functional);
+		 list_rewrite true eqs; cont_tac pmax le_proofs];
+	      tclTHENLIST[apply (delayed_force le_lt_SS);
+			compute_le_proofs le_proofs]]]
+    | arg::args ->
+	let v' = next_global_ident_away true v_id ids in
+        let ids = v'::ids in
+	let hex' = next_global_ident_away true hex_id ids in
+        let ids = hex'::ids in
+	let p' = next_global_ident_away true p_id ids in
+        let ids = p'::ids in
+	let new_pmax = next_global_ident_away true pmax_id ids in
+        let ids = pmax::ids in
+	let hle1 = next_global_ident_away true hle_id ids in
+        let ids = hle1::ids in
+	let hle2 = next_global_ident_away true hle_id ids in
+        let ids = hle2::ids in
+	let heq = next_global_ident_away true heq_id ids in
+        let ids = heq::ids in
+	let heq2 = next_global_ident_away true heq_id ids in
+        let ids = heq2::ids in
+	tclTHENLIST
+	  [mkCaseEq(mkApp(termine, Array.of_list arg));
+	   h_intros [v'; hex'];
+	   simplest_elim(mkVar hex');
+	   h_intros [p'];
+	   simplest_elim(mkApp(delayed_force max_constr, [|mkVar pmax;
+							mkVar p'|]));
+	   h_intros [new_pmax;hle1;hle2];
+           introduce_all_values_eq 
+              (fun pmax' le_proofs'->
+		tclTHENLIST
+		  [cont_tac pmax' le_proofs';
+		   h_intros [heq;heq2];
+		   rewriteLR (mkVar heq2);
+		   tclTHENS
+		     (general_rewrite_bindings false
+			(mkVar heq,
+			 ExplicitBindings
+			   [dummy_loc, NamedHyp k_id,
+			    f_S(mkVar pmax');
+			    dummy_loc, NamedHyp def_id, f]))
+		     [tclIDTAC;
+		      tclTHENLIST
+			[apply (delayed_force le_lt_n_Sm);
+			 compute_le_proofs le_proofs']]])
+	     functional termine f p heq1 new_pmax
+	     (p'::bounds)((mkVar pmax)::le_proofs) eqs
+             (heq2::heq::hle2::hle1::new_pmax::p'::hex'::v'::ids) args]
+  
+
+let rec_leaf_eq termine f ids functional eqs expr fn args =
+  let p = next_global_ident_away true p_id ids in
+  let ids = p::ids in
+  let v = next_global_ident_away true v_id ids in
+  let ids = v::ids in
+  let hex = next_global_ident_away true hex_id ids in
+  let ids = hex::ids in
+  let heq1 = next_global_ident_away true heq_id ids in
+  let ids = heq1::ids in
+  let hle1 = next_global_ident_away true hle_id ids in
+  let ids = hle1::ids in
+    tclTHENLIST
+      [h_intros [v;hex];
+       simplest_elim (mkVar hex);
+       h_intros [p;heq1];
+       generalize [mkApp(delayed_force le_n,[|mkVar p|])];
+       h_intros [hle1];
+       introduce_all_values_eq
+	 (fun _ _ -> tclIDTAC)
+	 functional termine f p heq1 p [] [] eqs ids args;
+       apply (delayed_force refl_equal)]
+
+let rec prove_eq  (termine:constr) (f:constr)(functional:global_reference)
+    (eqs:constr list)
+  (expr:constr) =
+  tclTRY
+    (match kind_of_term expr with
+      Case(_,t,a,l) ->
+	(match find_call_occs f a with
+	     _,[] -> 
+	       tclTHENS(mkCaseEq a)(* (simplest_case a) *)
+	  	 (List.map
+		    (mk_intros_and_continue true
+		       (prove_eq  termine f functional) eqs)
+		    (Array.to_list l))
+	   | _,_::_ ->
+               	(match find_call_occs f expr with
+	     _,[] -> base_leaf_eq functional eqs f
+	   | fn,args ->
+	       fun g ->
+		 let ids = ids_of_named_context (pf_hyps g) in
+	       rec_leaf_eq termine f ids
+		 (constr_of_reference functional)
+		 eqs expr fn args g))
+       | _ -> 
+	   (match find_call_occs f expr with
+		_,[] -> base_leaf_eq functional eqs f
+	      | fn,args ->
+		  fun g ->
+		    let ids = ids_of_named_context (pf_hyps g) in
+		    rec_leaf_eq  
+		      termine f ids (constr_of_reference functional)
+		      eqs expr fn args g));;
+
+let (com_eqn : identifier ->
+       global_reference -> global_reference -> global_reference
+	 -> constr_expr -> unit) =
+  fun eq_name functional_ref f_ref terminate_ref eq ->
+    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
+    (start_proof eq_name (Global, Proof Lemma)
+       (Environ.named_context_val env) eq_constr (fun _ _ -> ());
+     by
+       (start_equation f_ref terminate_ref
+	  (fun x ->
+	     prove_eq 
+	       (constr_of_reference terminate_ref)
+	       f_constr 
+	       functional_ref
+	       []
+	       (instantiate_lambda
+	       	  (def_of_const (constr_of_reference functional_ref))
+	       	  (f_constr::List.map mkVar x)
+	       )
+	  )
+       );
+     Command.save_named true);;
+
+
+let recursive_definition is_mes f type_of_f r rec_arg_num eq 
+    generate_induction_principle : unit =
+  let function_type = interp_constr Evd.empty (Global.env()) type_of_f in
+  let env = push_rel (Name f,None,function_type) (Global.env()) in
+  let res_vars,eq' = decompose_prod (interp_constr Evd.empty env eq) 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 f,function_type,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 
+  let (_, rec_arg_type, _) = destProd function_type_before_rec_arg in
+  let arg_types = List.rev_map snd (fst (decompose_prod_n (List.length res_vars) function_type)) in
+  let equation_id = add_suffix f "_equation" in
+  let functional_id =  add_suffix f "_F" in
+  let term_id = add_suffix f "_terminate" in
+  let functional_ref = declare_fun functional_id (IsDefinition Definition) res in
+(*   let _ = Pp.msgnl (str "res := " ++ Printer.pr_lconstr res) in *)
+  let env_with_pre_rec_args = push_rel_context(List.map (function (x,t) -> (x,None,t)) pre_rec_args) env in 
+  let relation = 
+    interp_constr
+      Evd.empty 
+      env_with_pre_rec_args
+      r
+  in 
+  let tcc_lemma_constr = ref None in 
+(*   let _ = Pp.msgnl (str "relation := " ++ Printer.pr_lconstr_env env_with_pre_rec_args relation) in *)
+  let hook _ _ =   
+    let term_ref = Nametab.locate (make_short_qualid term_id) in
+    let f_ref = declare_f f (IsProof Lemma) arg_types term_ref in
+(*     let _ = message "start second proof" in *)
+    com_eqn equation_id functional_ref f_ref term_ref eq;
+    let eq_ref = Nametab.locate (make_short_qualid equation_id ) in
+    generate_induction_principle tcc_lemma_constr
+      functional_ref eq_ref rec_arg_num rec_arg_type (nb_prod res) relation;
+    ()
+
+  in
+  com_terminate 
+    tcc_lemma_constr
+    is_mes functional_ref
+    rec_arg_type
+    relation rec_arg_num
+    term_id
+    hook 
+;;
+
+
+
+(* let observe_tac = do_observe_tac  *)
+
+let base_leaf_princ eq_cst functional_ref eqs expr = 
+  tclTHENSEQ 
+    [rewriteLR (mkConst eq_cst);
+     tclTRY (list_rewrite true eqs);
+     gen_eauto(* default_eauto *) false (false,5) [] (Some [])
+    ]
+
+
+
+let prove_with_tcc tcc_lemma_constr eqs : tactic = 
+  match !tcc_lemma_constr with 
+    | None -> tclIDTAC_MESSAGE (str "No tcc proof !!")
+    | Some lemma -> 
+	fun gls ->
+	  let hid = next_global_ident_away true h_id (pf_ids_of_hyps gls) in 
+	  tclTHENSEQ 
+	    [
+	      generalize [lemma];
+	      h_intro hid;
+	      Elim.h_decompose_and (mkVar hid); 
+	      tclTRY(list_rewrite true eqs);
+	      gen_eauto(* default_eauto *) false (false,5) [] (Some [])
+       (* 	      default_auto *)
+	    ]
+	    gls
+	    
+	    
+
+let finalize_rec_leaf_princ_with tcc_lemma_constr is_mes hrec acc_inv  eqs br = 
+  fun g -> 
+    tclTHENSEQ [
+      Eauto.e_resolve_constr (mkVar br);
+      tclFIRST
+	[
+	  e_assumption;
+	  reflexivity;
+	  tclTHEN (apply (mkVar hrec))
+	  (tclTHENS
+	     (* (try *) (observe_tac "applying inversion" (apply (Lazy.force acc_inv))) 
+(* 	      with e -> Pp.msgnl (Printer.pr_lconstr (Lazy.force acc_inv));raise e *)
+(* 	     ) *)
+	     [ h_assumption
+	     ;
+	      tclTHEN
+		(fun g ->
+		   tclUSER
+		     is_mes
+		     (Some (hrec::(retrieve_acc_var g)))
+		     g
+		)
+		(fun g -> prove_with_tcc tcc_lemma_constr eqs g)
+	     ]
+	  );
+	  gen_eauto(* default_eauto *) false (false,5) [] (Some []);
+	(fun g -> tclIDTAC_MESSAGE (str "here" ++ Printer.pr_goal (sig_it g)) g)
+      ]
+    ]
+      g
+    
+let rec_leaf_princ
+    tcc_lemma_constr
+    eq_cst
+    branches_names 
+    is_mes
+    acc_inv
+    hrec
+    (functional_ref:global_reference) 
+    eqs
+    expr
+    = 
+  fun g -> 
+  tclTHENSEQ 
+    [ rewriteLR (mkConst eq_cst);
+      list_rewrite true eqs;
+      tclFIRST 
+	(List.map (finalize_rec_leaf_princ_with tcc_lemma_constr is_mes hrec acc_inv eqs) branches_names)
+    ]
+    g
+
+let fresh_id avoid na = 
+  let id =  
+    match na with 
+      | Name id -> id 
+      | Anonymous -> h_id 
+  in 
+  next_global_ident_away true id avoid
+
+
+
+let prove_principle tcc_lemma_ref is_mes functional_ref 
+    eq_ref rec_arg_num rec_arg_type nb_args relation = 
+(*  f_ref eq_ref rec_arg_num rec_arg_type nb_args relation *)
+  let eq_cst =   
+    match eq_ref with 
+	ConstRef sp -> sp 
+      | _ -> assert false 
+  in
+  fun g -> 
+    let type_of_goal = pf_concl g in 
+    let goal_ids = pf_ids_of_hyps g in 
+    let goal_elim_infos = compute_elim_sig type_of_goal in 
+    let params_names,ids = List.fold_left 
+      (fun (params_names,avoid) (na,_,_) -> 
+	 let new_id = fresh_id avoid na in 
+	 (new_id::params_names,new_id::avoid)
+      )
+      ([],goal_ids)
+      goal_elim_infos.params
+    in
+    let predicates_names,ids = 
+      List.fold_left 
+	(fun (predicates_names,avoid) (na,_,_) -> 
+	   let new_id = fresh_id avoid na in 
+	   (new_id::predicates_names,new_id::avoid)
+	)
+	([],ids)
+	goal_elim_infos.predicates
+    in
+    let branches_names,ids = 
+      List.fold_left 
+	(fun (branches_names,avoid) (na,_,_) -> 
+	   let new_id = fresh_id avoid na in 
+	   (new_id::branches_names,new_id::avoid)
+	)
+	([],ids)
+	goal_elim_infos.branches
+    in
+    let to_intro = params_names@predicates_names@branches_names in 
+    let nparams = List.length params_names in 
+    let rec_arg_num = rec_arg_num - nparams in 
+    begin 
+      tclTHEN 
+	(h_intros to_intro)
+	(observe_tac (string_of_int (rec_arg_num)) 
+	   (fun g -> 
+	      let ids = ids_of_named_context (pf_hyps g) in
+	      let func_body = (def_of_const (constr_of_reference functional_ref)) in
+(* 	      let _ = Pp.msgnl (Printer.pr_lconstr func_body) in  *)
+	      let (f_name, _, body1) = destLambda func_body in
+	      let f_id =
+		match f_name with
+		  | Name f_id -> next_global_ident_away true f_id ids
+		  | Anonymous -> assert false 
+	      in
+	      let n_names_types,_ = decompose_lam body1 in 
+	      let n_ids,ids = 
+		List.fold_left 
+		  (fun (n_ids,ids) (n_name,_) -> 
+		     match n_name with 
+		       | Name id -> 
+			   let n_id = next_global_ident_away true id ids in 
+			   n_id::n_ids,n_id::ids
+		       | _ -> assert false
+		  )
+		  ([],(f_id::ids))
+		  n_names_types
+	      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 
+		is_mes
+		rec_arg_type
+		ids
+		(snd (list_chop nparams n_ids))
+		(substl (List.map mkVar params_names) relation)
+		(rec_arg_num)
+		rec_arg_id
+		(fun hrec acc_inv g ->  
+		   (proveterminate 
+		      is_mes
+		      acc_inv 
+		      hrec
+		      (mkVar f_id)
+		      functional_ref
+		      (base_leaf_princ eq_cst)
+		      (rec_leaf_princ tcc_lemma_ref eq_cst branches_names)
+		      []
+		      expr
+		   )
+		     g 
+		)
+		(if is_mes 
+		 then 
+		   tclUSER_if_not_mes 
+		 else fun _ -> prove_with_tcc tcc_lemma_ref [])
+	   
+		g 
+	   )
+	)
+    end
+      g
+
+
+
+VERNAC COMMAND EXTEND RecursiveDefinition
+  [ "Recursive" "Definition" ident(f) constr(type_of_f) constr(r) constr(wf)
+     constr(proof) integer_opt(rec_arg_num) constr(eq) ] ->
+  [ ignore(proof);ignore(wf);
+    let rec_arg_num = 
+      match rec_arg_num with 
+	| None -> 1
+	| Some n -> n 
+    in
+    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  _ _  _ _ _ _ _ -> ())]
+END
+
+
+
diff --git a/contrib/ring/ArithRing.v b/contrib/ring/ArithRing.v
index 1a6e0ba6..68464c10 100644
--- a/contrib/ring/ArithRing.v
+++ b/contrib/ring/ArithRing.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ArithRing.v,v 1.9.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: ArithRing.v 6295 2004-11-12 16:40:39Z gregoire $ *)
 
 (* Instantiation of the Ring tactic for the naturals of Arith $*)
 
@@ -16,7 +16,7 @@ Require Import Eqdep_dec.
 
 Open Local Scope nat_scope.
 
-Fixpoint nateq (n m:nat) {struct m} : bool :=
+Unboxed Fixpoint nateq (n m:nat) {struct m} : bool :=
   match n, m with
   | O, O => true
   | S n', S m' => nateq n' m'
@@ -32,12 +32,12 @@ Proof.
   trivial.
 Qed.
 
-Hint Resolve nateq_prop eq2eqT: arithring.
+Hint Resolve nateq_prop: arithring.
 
 Definition NatTheory : Semi_Ring_Theory plus mult 1 0 nateq.
   split; intros; auto with arith arithring.
-  apply eq2eqT; apply (fun n m p:nat => plus_reg_l m p n) with (n := n).
-  apply eqT2eq; trivial.
+  apply (fun n m p:nat => plus_reg_l m p n) with (n := n).
+  trivial.
 Defined.
 
 
@@ -86,4 +86,4 @@ Ltac rewrite_S_to_plus :=
        change (t1 = t2) in |- *
   end.
 
-Ltac ring_nat := rewrite_S_to_plus; ring.
\ No newline at end of file
+Ltac ring_nat := rewrite_S_to_plus; ring.
diff --git a/contrib/ring/NArithRing.v b/contrib/ring/NArithRing.v
index cfec29ce..878346ba 100644
--- a/contrib/ring/NArithRing.v
+++ b/contrib/ring/NArithRing.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: NArithRing.v,v 1.5.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: NArithRing.v 6295 2004-11-12 16:40:39Z gregoire $ *)
 
 (* Instantiation of the Ring tactic for the binary natural numbers *)
 
@@ -15,7 +15,7 @@ Require Export ZArith_base.
 Require Import NArith.
 Require Import Eqdep_dec.
 
-Definition Neq (n m:N) :=
+Unboxed Definition Neq (n m:N) :=
   match (n ?= m)%N with
   | Datatypes.Eq => true
   | _ => false
@@ -41,4 +41,4 @@ Definition NTheory : Semi_Ring_Theory Nplus Nmult 1%N 0%N Neq.
     apply Neq_prop.
 Qed.
 
-Add Semi Ring N Nplus Nmult 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ].
\ No newline at end of file
+Add Semi Ring N Nplus Nmult 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ].
diff --git a/contrib/ring/Quote.v b/contrib/ring/Quote.v
index b4ac5745..6f7414a3 100644
--- a/contrib/ring/Quote.v
+++ b/contrib/ring/Quote.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Quote.v,v 1.7.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: Quote.v 6295 2004-11-12 16:40:39Z gregoire $ *)
 
 (***********************************************************************
   The "abstract" type index is defined to represent variables.
@@ -26,6 +26,7 @@
 ***********************************************************************)
 
 Set Implicit Arguments.
+Unset Boxed Definitions.
 
 Section variables_map.
 
@@ -81,4 +82,4 @@ Qed.
 
 End variables_map.
 
-Unset Implicit Arguments.
\ No newline at end of file
+Unset Implicit Arguments.
diff --git a/contrib/ring/Ring.v b/contrib/ring/Ring.v
index 81497533..6572e79a 100644
--- a/contrib/ring/Ring.v
+++ b/contrib/ring/Ring.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ring.v,v 1.9.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: Ring.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Bool.
 Require Export Ring_theory.
diff --git a/contrib/ring/Ring_abstract.v b/contrib/ring/Ring_abstract.v
index de42e8c3..c0818da8 100644
--- a/contrib/ring/Ring_abstract.v
+++ b/contrib/ring/Ring_abstract.v
@@ -6,12 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ring_abstract.v,v 1.13.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: Ring_abstract.v 6295 2004-11-12 16:40:39Z gregoire $ *)
 
 Require Import Ring_theory.
 Require Import Quote.
 Require Import Ring_normalize.
 
+Unset Boxed Definitions.
+
 Section abstract_semi_rings.
 
 Inductive aspolynomial : Type :=
@@ -701,4 +703,4 @@ Proof.
     rewrite H; reflexivity.
 Qed.  
 
-End abstract_rings.
\ No newline at end of file
+End abstract_rings.
diff --git a/contrib/ring/Ring_normalize.v b/contrib/ring/Ring_normalize.v
index 8c0fd5fb..7b40328a 100644
--- a/contrib/ring/Ring_normalize.v
+++ b/contrib/ring/Ring_normalize.v
@@ -6,12 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ring_normalize.v,v 1.16.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: Ring_normalize.v 6295 2004-11-12 16:40:39Z gregoire $ *)
 
 Require Import Ring_theory.
 Require Import Quote.
 
 Set Implicit Arguments.
+Unset Boxed Definitions.
 
 Lemma index_eq_prop : forall n m:index, Is_true (index_eq n m) -> n = m.
 Proof.
@@ -898,4 +899,4 @@ Infix "*" := Pmult : ring_scope.
 Notation "- x" := (Popp x) : ring_scope.
 Notation "[ x ]" := (Pvar x) (at level 1) : ring_scope.
 
-Delimit Scope ring_scope with ring.
\ No newline at end of file
+Delimit Scope ring_scope with ring.
diff --git a/contrib/ring/Ring_theory.v b/contrib/ring/Ring_theory.v
index dfdfdf66..5536294e 100644
--- a/contrib/ring/Ring_theory.v
+++ b/contrib/ring/Ring_theory.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ring_theory.v,v 1.21.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: Ring_theory.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Bool.
 
diff --git a/contrib/ring/Setoid_ring.v b/contrib/ring/Setoid_ring.v
index c4537fe3..7bf33b17 100644
--- a/contrib/ring/Setoid_ring.v
+++ b/contrib/ring/Setoid_ring.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Setoid_ring.v,v 1.4.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: Setoid_ring.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Setoid_ring_theory.
 Require Export Quote.
diff --git a/contrib/ring/Setoid_ring_normalize.v b/contrib/ring/Setoid_ring_normalize.v
index 0c9c1e6a..56329ade 100644
--- a/contrib/ring/Setoid_ring_normalize.v
+++ b/contrib/ring/Setoid_ring_normalize.v
@@ -6,13 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Setoid_ring_normalize.v,v 1.11.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: Setoid_ring_normalize.v 6662 2005-02-02 21:33:14Z sacerdot $ *)
 
 Require Import Setoid_ring_theory.
 Require Import Quote.
 
 Set Implicit Arguments.
-
+Unset Boxed Definitions.
+ 
 Lemma index_eq_prop : forall n m:index, Is_true (index_eq n m) -> n = m.
 Proof.
   simple induction n; simple induction m; simpl in |- *;
@@ -34,24 +35,24 @@ Variable Aeq : A -> A -> bool.
 
 Variable S : Setoid_Theory A Aequiv.
 
-Add Setoid A Aequiv S.
+Add Setoid A Aequiv S as Asetoid.
 
-Variable
-  plus_morph :
-    forall a a0 a1 a2:A,
-      Aequiv a a0 -> Aequiv a1 a2 -> Aequiv (Aplus a a1) (Aplus a0 a2).
-Variable
-  mult_morph :
-    forall a a0 a1 a2:A,
-      Aequiv a a0 -> Aequiv a1 a2 -> Aequiv (Amult a a1) (Amult a0 a2).
+Variable plus_morph :
+ forall a a0:A, Aequiv a a0 ->
+   forall a1 a2:A, Aequiv a1 a2 ->
+     Aequiv (Aplus a a1)  (Aplus a0 a2).
+Variable mult_morph :
+ forall a a0:A, Aequiv a a0 ->
+   forall a1 a2:A, Aequiv a1 a2 ->
+     Aequiv (Amult a a1) (Amult a0 a2).
 Variable opp_morph : forall a a0:A, Aequiv a a0 -> Aequiv (Aopp a) (Aopp a0).
 
 Add Morphism Aplus : Aplus_ext.
-exact plus_morph.
+intros; apply plus_morph; assumption.
 Qed.
 
 Add Morphism Amult : Amult_ext.
-exact mult_morph.
+intros; apply mult_morph; assumption.
 Qed.
 
 Add Morphism Aopp : Aopp_ext.
@@ -488,19 +489,22 @@ rewrite (interp_m_ok (Aplus a a0) v0).
 rewrite (interp_m_ok a v0).
 rewrite (interp_m_ok a0 v0).
 setoid_replace (Amult (Aplus a a0) (interp_vl v0)) with
- (Aplus (Amult a (interp_vl v0)) (Amult a0 (interp_vl v0))).
+ (Aplus (Amult a (interp_vl v0)) (Amult a0 (interp_vl v0)));
+ [ idtac | trivial ].
 setoid_replace
  (Aplus (Aplus (Amult a (interp_vl v0)) (Amult a0 (interp_vl v0)))
     (Aplus (interp_setcs c) (interp_setcs c0))) with
  (Aplus (Amult a (interp_vl v0))
     (Aplus (Amult a0 (interp_vl v0))
-       (Aplus (interp_setcs c) (interp_setcs c0)))).
+       (Aplus (interp_setcs c) (interp_setcs c0))));
+ [ idtac | trivial ].
 setoid_replace
  (Aplus (Aplus (Amult a (interp_vl v0)) (interp_setcs c))
     (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0))) with
  (Aplus (Amult a (interp_vl v0))
     (Aplus (interp_setcs c)
-       (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0)))).
+       (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0))));
+ [ idtac | trivial ].
 auto.
 
 elim (varlist_lt v v0); simpl in |- *.
@@ -550,19 +554,23 @@ rewrite (H c0).
 rewrite (interp_m_ok (Aplus a Aone) v0).
 rewrite (interp_m_ok a v0).
 setoid_replace (Amult (Aplus a Aone) (interp_vl v0)) with
- (Aplus (Amult a (interp_vl v0)) (Amult Aone (interp_vl v0))).
+ (Aplus (Amult a (interp_vl v0)) (Amult Aone (interp_vl v0)));
+ [ idtac | trivial ].
 setoid_replace
  (Aplus (Aplus (Amult a (interp_vl v0)) (Amult Aone (interp_vl v0)))
     (Aplus (interp_setcs c) (interp_setcs c0))) with
  (Aplus (Amult a (interp_vl v0))
     (Aplus (Amult Aone (interp_vl v0))
-       (Aplus (interp_setcs c) (interp_setcs c0)))).
+       (Aplus (interp_setcs c) (interp_setcs c0))));
+ [ idtac | trivial ].
 setoid_replace
  (Aplus (Aplus (Amult a (interp_vl v0)) (interp_setcs c))
     (Aplus (interp_vl v0) (interp_setcs c0))) with
  (Aplus (Amult a (interp_vl v0))
-    (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0)))).
-setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0).
+    (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0))));
+ [ idtac | trivial ].
+setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0);
+ [ idtac | trivial ].
 auto.
 
 elim (varlist_lt v v0); simpl in |- *.
@@ -613,18 +621,21 @@ rewrite (ics_aux_ok (interp_m (Aplus Aone a) v0) (canonical_sum_merge c c0));
 rewrite (interp_m_ok (Aplus Aone a) v0); rewrite (interp_m_ok a v0).
 setoid_replace (Amult (Aplus Aone a) (interp_vl v0)) with
  (Aplus (Amult Aone (interp_vl v0)) (Amult a (interp_vl v0)));
- setoid_replace
-  (Aplus (Aplus (Amult Aone (interp_vl v0)) (Amult a (interp_vl v0)))
-     (Aplus (interp_setcs c) (interp_setcs c0))) with
-  (Aplus (Amult Aone (interp_vl v0))
-     (Aplus (Amult a (interp_vl v0))
-        (Aplus (interp_setcs c) (interp_setcs c0))));
- setoid_replace
-  (Aplus (Aplus (interp_vl v0) (interp_setcs c))
-     (Aplus (Amult a (interp_vl v0)) (interp_setcs c0))) with
-  (Aplus (interp_vl v0)
-     (Aplus (interp_setcs c)
-        (Aplus (Amult a (interp_vl v0)) (interp_setcs c0)))).
+ [ idtac | trivial ].
+setoid_replace
+ (Aplus (Aplus (Amult Aone (interp_vl v0)) (Amult a (interp_vl v0)))
+    (Aplus (interp_setcs c) (interp_setcs c0))) with
+ (Aplus (Amult Aone (interp_vl v0))
+    (Aplus (Amult a (interp_vl v0))
+       (Aplus (interp_setcs c) (interp_setcs c0))));
+ [ idtac | trivial ].
+setoid_replace
+ (Aplus (Aplus (interp_vl v0) (interp_setcs c))
+    (Aplus (Amult a (interp_vl v0)) (interp_setcs c0))) with
+ (Aplus (interp_vl v0)
+    (Aplus (interp_setcs c)
+       (Aplus (Amult a (interp_vl v0)) (interp_setcs c0))));
+ [ idtac | trivial ].
 auto.
 
 elim (varlist_lt v v0); simpl in |- *; intros.
@@ -668,17 +679,20 @@ rewrite
 rewrite (interp_m_ok (Aplus Aone Aone) v0).
 setoid_replace (Amult (Aplus Aone Aone) (interp_vl v0)) with
  (Aplus (Amult Aone (interp_vl v0)) (Amult Aone (interp_vl v0)));
- setoid_replace
-  (Aplus (Aplus (Amult Aone (interp_vl v0)) (Amult Aone (interp_vl v0)))
-     (Aplus (interp_setcs c) (interp_setcs c0))) with
-  (Aplus (Amult Aone (interp_vl v0))
-     (Aplus (Amult Aone (interp_vl v0))
-        (Aplus (interp_setcs c) (interp_setcs c0))));
- setoid_replace
-  (Aplus (Aplus (interp_vl v0) (interp_setcs c))
-     (Aplus (interp_vl v0) (interp_setcs c0))) with
-  (Aplus (interp_vl v0)
-     (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0)))).
+ [ idtac | trivial ].
+setoid_replace
+ (Aplus (Aplus (Amult Aone (interp_vl v0)) (Amult Aone (interp_vl v0)))
+    (Aplus (interp_setcs c) (interp_setcs c0))) with
+ (Aplus (Amult Aone (interp_vl v0))
+    (Aplus (Amult Aone (interp_vl v0))
+       (Aplus (interp_setcs c) (interp_setcs c0))));
+ [ idtac | trivial ].
+setoid_replace
+ (Aplus (Aplus (interp_vl v0) (interp_setcs c))
+    (Aplus (interp_vl v0) (interp_setcs c0))) with
+ (Aplus (interp_vl v0)
+    (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0))));
+[ idtac | trivial ].
 setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0); auto.
 
 elim (varlist_lt v v0); simpl in |- *.
@@ -727,7 +741,8 @@ rewrite (ics_aux_ok (interp_m (Aplus a a0) v) c);
  rewrite (ics_aux_ok (interp_m a0 v) c).
 rewrite (interp_m_ok (Aplus a a0) v); rewrite (interp_m_ok a0 v).
 setoid_replace (Amult (Aplus a a0) (interp_vl v)) with
- (Aplus (Amult a (interp_vl v)) (Amult a0 (interp_vl v))).
+ (Aplus (Amult a (interp_vl v)) (Amult a0 (interp_vl v)));
+ [ idtac | trivial ].
 auto.
 
 elim (varlist_lt l v); simpl in |- *; intros.
@@ -746,8 +761,10 @@ rewrite (ics_aux_ok (interp_m (Aplus a Aone) v) c);
  rewrite (ics_aux_ok (interp_vl v) c).
 rewrite (interp_m_ok (Aplus a Aone) v).
 setoid_replace (Amult (Aplus a Aone) (interp_vl v)) with
- (Aplus (Amult a (interp_vl v)) (Amult Aone (interp_vl v))).
-setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v).
+ (Aplus (Amult a (interp_vl v)) (Amult Aone (interp_vl v)));
+ [ idtac | trivial ].
+setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v);
+ [ idtac | trivial ].
 auto.
 
 elim (varlist_lt l v); simpl in |- *; intros; auto.
@@ -769,7 +786,8 @@ rewrite (ics_aux_ok (interp_m (Aplus Aone a) v) c);
  rewrite (ics_aux_ok (interp_m a v) c).
 rewrite (interp_m_ok (Aplus Aone a) v); rewrite (interp_m_ok a v).
 setoid_replace (Amult (Aplus Aone a) (interp_vl v)) with
- (Aplus (Amult Aone (interp_vl v)) (Amult a (interp_vl v))).
+ (Aplus (Amult Aone (interp_vl v)) (Amult a (interp_vl v)));
+ [ idtac | trivial ].
 setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); auto.
 
 elim (varlist_lt l v); simpl in |- *; intros; auto.
@@ -784,7 +802,8 @@ rewrite (ics_aux_ok (interp_m (Aplus Aone Aone) v) c);
  rewrite (ics_aux_ok (interp_vl v) c).
 rewrite (interp_m_ok (Aplus Aone Aone) v).
 setoid_replace (Amult (Aplus Aone Aone) (interp_vl v)) with
- (Aplus (Amult Aone (interp_vl v)) (Amult Aone (interp_vl v))).
+ (Aplus (Amult Aone (interp_vl v)) (Amult Aone (interp_vl v)));
+ [ idtac | trivial ].
 setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); auto.
 
 elim (varlist_lt l v); simpl in |- *; intros; auto.
@@ -806,7 +825,8 @@ rewrite (ics_aux_ok (interp_m (Amult a a0) v) (canonical_sum_scalar a c));
 rewrite (interp_m_ok (Amult a a0) v); rewrite (interp_m_ok a0 v).
 rewrite H.
 setoid_replace (Amult a (Aplus (Amult a0 (interp_vl v)) (interp_setcs c)))
- with (Aplus (Amult a (Amult a0 (interp_vl v))) (Amult a (interp_setcs c))).
+ with (Aplus (Amult a (Amult a0 (interp_vl v))) (Amult a (interp_setcs c)));
+ [ idtac | trivial ].
 auto.
 
 rewrite (ics_aux_ok (interp_m a v) (canonical_sum_scalar a c));
@@ -829,7 +849,8 @@ rewrite (varlist_merge_ok l v).
 setoid_replace
  (Amult (interp_vl l) (Aplus (Amult a (interp_vl v)) (interp_setcs c))) with
  (Aplus (Amult (interp_vl l) (Amult a (interp_vl v)))
-    (Amult (interp_vl l) (interp_setcs c))).
+    (Amult (interp_vl l) (interp_setcs c)));
+ [ idtac | trivial ].
 auto.
 
 rewrite (varlist_insert_ok (varlist_merge l v) (canonical_sum_scalar2 l c)).
@@ -858,15 +879,18 @@ rewrite (varlist_merge_ok l v).
 setoid_replace
  (Amult (interp_vl l) (Aplus (Amult a (interp_vl v)) (interp_setcs c0))) with
  (Aplus (Amult (interp_vl l) (Amult a (interp_vl v)))
-    (Amult (interp_vl l) (interp_setcs c0))).
+    (Amult (interp_vl l) (interp_setcs c0)));
+ [ idtac | trivial ].
 setoid_replace
  (Amult c
     (Aplus (Amult (interp_vl l) (Amult a (interp_vl v)))
        (Amult (interp_vl l) (interp_setcs c0)))) with
  (Aplus (Amult c (Amult (interp_vl l) (Amult a (interp_vl v))))
-    (Amult c (Amult (interp_vl l) (interp_setcs c0)))).
+    (Amult c (Amult (interp_vl l) (interp_setcs c0))));
+ [ idtac | trivial ].
 setoid_replace (Amult (Amult c a) (Amult (interp_vl l) (interp_vl v))) with
- (Amult c (Amult a (Amult (interp_vl l) (interp_vl v)))).
+ (Amult c (Amult a (Amult (interp_vl l) (interp_vl v))));
+ [ idtac | trivial ].
 auto.
 
 rewrite
@@ -880,7 +904,8 @@ setoid_replace
     (Amult c (Amult (interp_vl l) (interp_setcs c0)))) with
  (Amult c
     (Aplus (Amult (interp_vl l) (interp_vl v))
-       (Amult (interp_vl l) (interp_setcs c0)))).
+       (Amult (interp_vl l) (interp_setcs c0))));
+ [ idtac | trivial ].
 auto.
 Qed.
 
@@ -900,12 +925,14 @@ rewrite (ics_aux_ok (interp_m a v) c).
 rewrite (interp_m_ok a v).
 rewrite (H y).
 setoid_replace (Amult a (Amult (interp_vl v) (interp_setcs y))) with
- (Amult (Amult a (interp_vl v)) (interp_setcs y)).
+ (Amult (Amult a (interp_vl v)) (interp_setcs y));
+ [ idtac | trivial ].
 setoid_replace
  (Amult (Aplus (Amult a (interp_vl v)) (interp_setcs c)) (interp_setcs y))
  with
  (Aplus (Amult (Amult a (interp_vl v)) (interp_setcs y))
-    (Amult (interp_setcs c) (interp_setcs y))).
+    (Amult (interp_setcs c) (interp_setcs y)));
+ [ idtac | trivial ].
 trivial.
 
 rewrite
@@ -947,7 +974,8 @@ intros.
 rewrite (ics_aux_ok (interp_m a v) c).
 rewrite (interp_m_ok a v).
 rewrite (H0 I).
-setoid_replace (Amult Azero (interp_vl v)) with Azero.
+setoid_replace (Amult Azero (interp_vl v)) with Azero;
+ [ idtac | trivial ].
 rewrite H.
 trivial.
 
@@ -1134,4 +1162,4 @@ Qed.
 
 End setoid_rings.
 
-End setoid.
\ No newline at end of file
+End setoid.
diff --git a/contrib/ring/Setoid_ring_theory.v b/contrib/ring/Setoid_ring_theory.v
index 69712216..ae6610d3 100644
--- a/contrib/ring/Setoid_ring_theory.v
+++ b/contrib/ring/Setoid_ring_theory.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Setoid_ring_theory.v,v 1.16.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: Setoid_ring_theory.v 6662 2005-02-02 21:33:14Z sacerdot $ *)
 
 Require Export Bool.
 Require Export Setoid.
@@ -22,7 +22,7 @@ Infix Local "==" := Aequiv (at level 70, no associativity).
 
 Variable S : Setoid_Theory A Aequiv.
 
-Add Setoid A Aequiv S.
+Add Setoid A Aequiv S as Asetoid.
 
 Variable Aplus : A -> A -> A.
 Variable Amult : A -> A -> A.
@@ -37,18 +37,18 @@ Notation "0" := Azero.
 Notation "1" := Aone.
 Notation "- x" := (Aopp x).
 
-Variable
-  plus_morph : forall a a0 a1 a2:A, a == a0 -> a1 == a2 -> a + a1 == a0 + a2.
-Variable
-  mult_morph : forall a a0 a1 a2:A, a == a0 -> a1 == a2 -> a * a1 == a0 * a2.
+Variable plus_morph :
+ forall a a0:A, a == a0 -> forall a1 a2:A, a1 == a2 -> a + a1 == a0 + a2.
+Variable mult_morph :
+  forall a a0:A, a == a0 -> forall a1 a2:A, a1 == a2 -> a * a1 == a0 * a2.
 Variable opp_morph : forall a a0:A, a == a0 -> - a == - a0.
 
 Add Morphism Aplus : Aplus_ext.
-exact plus_morph.
+intros; apply plus_morph; assumption.
 Qed.
 
 Add Morphism Amult : Amult_ext.
-exact mult_morph.
+intros; apply mult_morph; assumption.
 Qed.
 
 Add Morphism Aopp : Aopp_ext.
@@ -424,4 +424,4 @@ Section power_ring.
 
 End power_ring.
 
-End Setoid_rings.
\ No newline at end of file
+End Setoid_rings.
diff --git a/contrib/ring/ZArithRing.v b/contrib/ring/ZArithRing.v
index c511c076..3999b632 100644
--- a/contrib/ring/ZArithRing.v
+++ b/contrib/ring/ZArithRing.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ZArithRing.v,v 1.5.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: ZArithRing.v 6295 2004-11-12 16:40:39Z gregoire $ *)
 
 (* Instantiation of the Ring tactic for the binary integers of ZArith *)
 
@@ -14,7 +14,7 @@ Require Export ArithRing.
 Require Export ZArith_base.
 Require Import Eqdep_dec.
 
-Definition Zeq (x y:Z) :=
+Unboxed Definition Zeq (x y:Z) :=
   match (x ?= y)%Z with
   | Datatypes.Eq => true
   | _ => false
@@ -27,10 +27,10 @@ Lemma Zeq_prop : forall x y:Z, Is_true (Zeq x y) -> x = y.
 Qed.
 
 Definition ZTheory : Ring_Theory Zplus Zmult 1%Z 0%Z Zopp Zeq.
-  split; intros; apply eq2eqT; eauto with zarith.
-  apply eqT2eq; apply Zeq_prop; assumption.
+  split; intros; eauto with zarith.
+  apply Zeq_prop; assumption.
 Qed.
 
 (* NatConstants and NatTheory are defined in Ring_theory.v *)
 Add Ring Z Zplus Zmult 1%Z 0%Z Zopp Zeq ZTheory
- [ Zpos Zneg 0%Z xO xI 1%positive ].
\ No newline at end of file
+ [ Zpos Zneg 0%Z xO xI 1%positive ].
diff --git a/contrib/ring/g_quote.ml4 b/contrib/ring/g_quote.ml4
index af23a8f7..d0058026 100644
--- a/contrib/ring/g_quote.ml4
+++ b/contrib/ring/g_quote.ml4
@@ -8,11 +8,11 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: g_quote.ml4,v 1.1.12.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: g_quote.ml4 7734 2005-12-26 14:06:51Z herbelin $ *)
 
 open Quote
 
-TACTIC EXTEND Quote
-  [ "Quote" ident(f) ] -> [ quote f [] ]
-| [ "Quote" ident(f) "[" ne_ident_list(lc) "]"] -> [ quote f lc ]
+TACTIC EXTEND quote
+  [ "quote" ident(f) ] -> [ quote f [] ]
+| [ "quote" ident(f) "[" ne_ident_list(lc) "]"] -> [ quote f lc ]
 END
diff --git a/contrib/ring/g_ring.ml4 b/contrib/ring/g_ring.ml4
index f7c74c0b..dccd1944 100644
--- a/contrib/ring/g_ring.ml4
+++ b/contrib/ring/g_ring.ml4
@@ -8,13 +8,13 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: g_ring.ml4,v 1.4.2.1 2004/07/16 19:30:13 herbelin Exp $ *)
+(* $Id: g_ring.ml4 7734 2005-12-26 14:06:51Z herbelin $ *)
 
 open Quote
 open Ring
 
-TACTIC EXTEND Ring
-  [ "Ring" constr_list(l) ] -> [ polynom l ]
+TACTIC EXTEND ring
+  [ "ring" constr_list(l) ] -> [ polynom l ]
 END
 
 (* The vernac commands "Add Ring" and co *)
diff --git a/contrib/ring/quote.ml b/contrib/ring/quote.ml
index bda04db3..462e5ed8 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,v 1.30.2.1 2004/07/16 19:30:14 herbelin Exp $ *)
+(* $Id: quote.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 (* The `Quote' tactic *)
 
@@ -107,7 +107,6 @@ open Pp
 open Util
 open Names
 open Term
-open Instantiate
 open Pattern
 open Matching
 open Tacmach
@@ -213,7 +212,7 @@ let compute_rhs bodyi index_of_f =
 	  PMeta (Some (coerce_meta_in i))
       | App (f,args) ->
           PApp (pattern_of_constr f, Array.map aux args)
-      | Cast (c,t) -> aux c 
+      | Cast (c,_,_) -> aux c 
       | _ -> pattern_of_constr c
   in
   aux bodyi
@@ -298,7 +297,7 @@ binary search trees (see file \texttt{Quote.v}) *)
 let rec closed_under cset t =
   (ConstrSet.mem t cset) or
   (match (kind_of_term t) with
-     | Cast(c,_) -> closed_under cset c  
+     | Cast(c,_,_) -> closed_under cset c  
      | App(f,l) -> closed_under cset f & array_for_all (closed_under cset) l
      | _ -> false)
     
@@ -361,7 +360,7 @@ let rec subterm gl (t : constr) (t' : constr) =
   (pf_conv_x gl t t') or
   (match (kind_of_term t) with 
      | App (f,args) -> array_exists (fun t -> subterm gl t t') args
-     | Cast(t,_) -> (subterm gl t t')
+     | Cast(t,_,_) -> (subterm gl t t')
      | _ -> false)
            
 (*s We want to sort the list according to reverse subterm order. *)
@@ -386,7 +385,7 @@ let rec sort_subterm gl l =
   [gl: goal sigma]\\ *)
 
 let quote_terms ivs lc gl =
-  Library.check_required_library ["Coq";"ring";"Quote"];
+  Coqlib.check_required_library ["Coq";"ring";"Quote"];
   let varhash  = (Hashtbl.create 17 : (constr, constr) Hashtbl.t) in
   let varlist = ref ([] : constr list) in (* list of variables *)
   let counter = ref 1 in (* number of variables created + 1 *)
@@ -448,8 +447,8 @@ let quote f lid gl =
     | _ -> assert false
   in
   match ivs.variable_lhs with
-    | None -> Tactics.convert_concl (mkApp (f, [| p |])) gl
-    | Some _ -> Tactics.convert_concl (mkApp (f, [| vm; p |])) gl
+    | None -> Tactics.convert_concl (mkApp (f, [| p |])) DEFAULTcast gl
+    | Some _ -> Tactics.convert_concl (mkApp (f, [| vm; p |])) DEFAULTcast gl
 
 (*i 
 
diff --git a/contrib/ring/ring.ml b/contrib/ring/ring.ml
index 378f19a4..5251dcc5 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,v 1.49.2.1 2004/07/16 19:30:14 herbelin Exp $ *)
+(* $Id: ring.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 (* ML part of the Ring tactic *)
 
@@ -34,6 +34,7 @@ open Pattern
 open Hiddentac
 open Nametab
 open Quote
+open Mod_subst
 
 let mt_evd = Evd.empty
 let constr_of c = Constrintern.interp_constr mt_evd (Global.env()) c
@@ -286,7 +287,7 @@ let guess_theory a =
   with Not_found -> 
     errorlabstrm "Ring" 
       (str "No Declared Ring Theory for " ++
-	 prterm a ++ fnl () ++
+	 pr_lconstr a ++ fnl () ++
 	 str "Use Add [Semi] Ring to declare it")
 
 (* Looks up an option *)
@@ -306,23 +307,42 @@ let safe_pf_conv_x gl c1 c2 = try pf_conv_x gl c1 c2 with _ -> false
 let implement_theory env t th args =
   is_conv env Evd.empty (Typing.type_of env Evd.empty t) (mkLApp (th, args))
 
+(* The following test checks whether the provided morphism is the default
+   one for the given operation. In principle the test is too strict, since
+   it should possible to provide another proof for the same fact (proof
+   irrelevance). In particular, the error message is be not very explicative. *)
+let states_compatibility_for env plus mult opp morphs =
+ let check op compat =
+  is_conv env Evd.empty (Setoid_replace.default_morphism op).Setoid_replace.lem
+   compat in
+ check plus morphs.plusm &&
+ check mult morphs.multm &&
+ (match (opp,morphs.oppm) with
+     None, None -> true
+   | Some opp, Some compat -> check opp compat
+   | _,_ -> assert false)
+
 let add_theory want_ring want_abstract want_setoid a aequiv asetth amorph aplus amult aone azero aopp aeq t cset = 
   if theories_map_mem a then errorlabstrm "Add Semi Ring" 
     (str "A (Semi-)(Setoid-)Ring Structure is already declared for " ++
-       prterm a);
+       pr_lconstr a);
   let env = Global.env () in
-    if (want_ring & want_setoid &
+    if (want_ring & want_setoid & (
 	not (implement_theory env t coq_Setoid_Ring_Theory
 	  [| a; (unbox aequiv); aplus; amult; aone; azero; (unbox aopp); aeq|])
-        &
+        ||
 	not (implement_theory env (unbox asetth) coq_Setoid_Theory
-	  [| a; (unbox aequiv) |])) then 
+	  [| a; (unbox aequiv) |]) ||
+        not (states_compatibility_for env aplus amult aopp (unbox amorph))
+        )) then 
       errorlabstrm "addring" (str "Not a valid Setoid-Ring theory");
-    if (not want_ring & want_setoid &
+    if (not want_ring & want_setoid & (
         not (implement_theory env t coq_Semi_Setoid_Ring_Theory 
-	  [| a; (unbox aequiv); aplus; amult; aone; azero; aeq|]) &
+	  [| a; (unbox aequiv); aplus; amult; aone; azero; aeq|]) ||
 	not (implement_theory env (unbox asetth) coq_Setoid_Theory
-	  [| a; (unbox aequiv) |])) then 
+	  [| a; (unbox aequiv) |]) ||
+        not (states_compatibility_for env aplus amult aopp (unbox amorph))))
+    then
       errorlabstrm "addring" (str "Not a valid Semi-Setoid-Ring theory");
     if (want_ring & not want_setoid &
 	not (implement_theory env t coq_Ring_Theory
@@ -705,10 +725,10 @@ let build_setspolynom gl th lc =
 			       th.th_eq; p |])) |]),
 	mkLApp(coq_setspolynomial_simplify_ok,
 	       [| th.th_a; (unbox th.th_equiv); th.th_plus;
-                  th.th_mult; th.th_one; th.th_zero; th.th_eq; v;
-                  th.th_t; (unbox th.th_setoid_th);
+                  th.th_mult; th.th_one; th.th_zero; th.th_eq;
+                  (unbox th.th_setoid_th);
 		  (unbox th.th_morph).plusm;
-                  (unbox th.th_morph).multm; p |])))
+                  (unbox th.th_morph).multm; v; th.th_t; p |])))
     lp
 
 module SectionPathSet =
@@ -724,7 +744,7 @@ let constants_to_unfold =
   let transform s = 
     let sp = path_of_string s in
     let dir, id = repr_path sp in
-      Libnames.encode_kn dir id 
+      Libnames.encode_con dir id 
   in
   List.map transform
     [ "Coq.ring.Ring_normalize.interp_cs";
@@ -753,7 +773,7 @@ open RedFlags
 let polynom_unfold_tac =
   let flags =
     (mkflags(fBETA::fIOTA::(List.map fCONST constants_to_unfold))) in
-  reduct_in_concl (cbv_norm_flags flags)
+  reduct_in_concl (cbv_norm_flags flags,DEFAULTcast)
       
 let polynom_unfold_tac_in_term gl =
   let flags = 
@@ -804,20 +824,22 @@ let raw_polynom th op lc gl =
 				  [| th.th_a; (unbox th.th_equiv);
                                      (unbox th.th_setoid_th);
 				     c'''i; ci; c'i_eq_c''i |]))))
-	      (tclTHEN 
-		 (Setoid_replace.setoid_replace ci c'''i None)
-		 (tclTHEN 
-		    (tclTRY (h_exact c'i_eq_c''i))
-		    tac)))
+	      (tclTHENS
+		 (tclORELSE
+                   (Setoid_replace.general_s_rewrite true c'i_eq_c''i
+                     ~new_goals:[])
+                   (Setoid_replace.general_s_rewrite false c'i_eq_c''i
+                     ~new_goals:[]))
+                 [tac]))
 	 else
            (tclORELSE
               (tclORELSE
 		 (h_exact c'i_eq_c''i)
-		 (h_exact (mkApp(build_coq_sym_eqT (),
+		 (h_exact (mkApp(build_coq_sym_eq (),
 				 [|th.th_a; c'''i; ci; c'i_eq_c''i |]))))
 	      (tclTHENS 
 		 (elim_type 
-		    (mkApp(build_coq_eqT (), [|th.th_a; c'''i; ci |])))
+		    (mkApp(build_coq_eq (), [|th.th_a; c'''i; ci |])))
 		 [ tac;
                    h_exact c'i_eq_c''i ]))
 )
@@ -863,7 +885,7 @@ let match_with_equiv c = match (kind_of_term c) with
   | _ -> None
 
 let polynom lc gl =
-  Library.check_required_library ["Coq";"ring";"Ring"];
+  Coqlib.check_required_library ["Coq";"ring";"Ring"];
   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/romega/ROmega.v b/contrib/romega/ROmega.v
index b3895b2a..19933873 100644
--- a/contrib/romega/ROmega.v
+++ b/contrib/romega/ROmega.v
@@ -6,6 +6,5 @@
 
  *************************************************************************)
 
-Require Import Omega.
 Require Import ReflOmegaCore.
 
diff --git a/contrib/romega/ReflOmegaCore.v b/contrib/romega/ReflOmegaCore.v
index 3dfb5593..2aa3516f 100644
--- a/contrib/romega/ReflOmegaCore.v
+++ b/contrib/romega/ReflOmegaCore.v
@@ -1,3 +1,4 @@
+(* -*- coding: utf-8 -*- *)
 (*************************************************************************
 
    PROJET RNRT Calife - 2001
@@ -9,9 +10,11 @@
 Require Import Arith.
 Require Import List.
 Require Import Bool.
-Require Import ZArith.
+Require Import ZArith_base.
 Require Import OmegaLemmas.
 
+Open Scope Z_scope.
+
 (* \subsection{Definition of basic types} *)
 
 (* \subsubsection{Environment of propositions (lists) *)
@@ -45,6 +48,13 @@ Inductive term : Set :=
   | Topp : term -> term
   | Tvar : nat -> term.
 
+Delimit Scope romega_scope with term.
+Infix "+" := Tplus : romega_scope.
+Infix "*" := Tmult : romega_scope.
+Infix "-" := Tminus : romega_scope.
+Notation "- x" := (Topp x) : romega_scope.
+Notation "[ x ]" := (Tvar x) (at level 1) : romega_scope.
+
 (* \subsubsection{Definition of reified goals} *)
 (* Very restricted definition of handled predicates that should be extended
    to cover a wider set of operations.
@@ -67,13 +77,13 @@ Inductive proposition : Set :=
   | Tprop : nat -> proposition.
 
 (* Definition of goals as a list of hypothesis *)
-Notation hyps := (list proposition) (only parsing).      
+Notation hyps := (list proposition).      
 
 (* Definition of lists of subgoals  (set of open goals) *)
-Notation lhyps := (list (list proposition)) (only parsing).
+Notation lhyps := (list hyps).
 
 (* a syngle goal packed in a subgoal list *)
-Notation singleton := (fun a : list proposition => a :: nil) (only parsing).
+Notation singleton := (fun a : hyps => a :: nil).
 
 (* an absurd goal *)
 Definition absurd := FalseTerm :: nil.
@@ -120,7 +130,7 @@ Inductive step : Set :=
   | C_PLUS_ASSOC_R : step
   | C_PLUS_ASSOC_L : step
   | C_PLUS_PERMUTE : step
-  | C_PLUS_SYM : step
+  | C_PLUS_COMM : step
   | C_RED0 : step
   | C_RED1 : step
   | C_RED2 : step
@@ -130,7 +140,7 @@ Inductive step : Set :=
   | C_RED6 : step
   | C_MULT_ASSOC_REDUCED : step
   | C_MINUS : step
-  | C_MULT_SYM : step.
+  | C_MULT_COMM : step.
 
 (* \subsubsection{Omega steps} *)
 (* The following inductive type describes steps as they can be found in
@@ -176,7 +186,7 @@ Inductive p_step : Set :=
    type [p_step] permettant
    de parcourir à la fois les branches gauches et droit, on pourrait n'avoir
    qu'une normalisation par hypothèse. Et comme toutes les hypothèses sont 
-   utiles (sinon on ne les incluerait pas), on pourrait remplacer [h_step] 
+   utiles (sinon on ne les inclurait pas), on pourrait remplacer [h_step] 
    par une simple liste *)
 
 Inductive h_step : Set :=
@@ -360,29 +370,31 @@ Fixpoint eq_term (t1 t2 : term) {struct t2} : bool :=
                 | Tint st2 => eq_Z st1 st2
                 | _ => false
                 end
-  | Tplus st11 st12 =>
+  | (st11 + st12)%term =>
       match t2 with
-      | Tplus st21 st22 => eq_term st11 st21 && eq_term st12 st22
+      | (st21 + st22)%term => eq_term st11 st21 && eq_term st12 st22
       | _ => false
       end
-  | Tmult st11 st12 =>
+  | (st11 * st12)%term =>
       match t2 with
-      | Tmult st21 st22 => eq_term st11 st21 && eq_term st12 st22
+      | (st21 * st22)%term => eq_term st11 st21 && eq_term st12 st22
       | _ => false
       end
-  | Tminus st11 st12 =>
+  | (st11 - st12)%term =>
       match t2 with
-      | Tminus st21 st22 => eq_term st11 st21 && eq_term st12 st22
+      | (st21 - st22)%term => eq_term st11 st21 && eq_term st12 st22
+      | _ => false
+      end
+  | (- st1)%term =>
+      match t2 with
+      | (- st2)%term => eq_term st1 st2
+      | _ => false
+      end
+  | [st1]%term =>
+      match t2 with
+      | [st2]%term => eq_nat st1 st2
       | _ => false
       end
-  | Topp st1 => match t2 with
-                | Topp st2 => eq_term st1 st2
-                | _ => false
-                end
-  | Tvar st1 => match t2 with
-                | Tvar st2 => eq_nat st1 st2
-                | _ => false
-                end
   end.  
 
 Theorem eq_term_true : forall t1 t2 : term, eq_term t1 t2 = true -> t1 = t2.
@@ -480,15 +492,15 @@ Ltac elim_eq_pos t1 t2 :=
    avec son théorème *)
 
 Theorem relation_ind2 :
- forall (P : Datatypes.comparison -> Prop) (b : Datatypes.comparison),
- (b = Datatypes.Eq -> P Datatypes.Eq) ->
- (b = Datatypes.Lt -> P Datatypes.Lt) ->
- (b = Datatypes.Gt -> P Datatypes.Gt) -> P b.
+ forall (P : comparison -> Prop) (b : comparison),
+ (b = Eq -> P Eq) ->
+ (b = Lt -> P Lt) ->
+ (b = Gt -> P Gt) -> P b.
 
 simple induction b; auto.
 Qed.
 
-Ltac elim_Zcompare t1 t2 := pattern (t1 ?= t2)%Z in |- *; apply relation_ind2.
+Ltac elim_Zcompare t1 t2 := pattern (t1 ?= t2) in |- *; apply relation_ind2.
 
 (* \subsection{Interprétations}
    \subsubsection{Interprétation des termes dans Z} *)
@@ -496,11 +508,11 @@ Ltac elim_Zcompare t1 t2 := pattern (t1 ?= t2)%Z in |- *; apply relation_ind2.
 Fixpoint interp_term (env : list Z) (t : term) {struct t} : Z :=
   match t with
   | Tint x => x
-  | Tplus t1 t2 => (interp_term env t1 + interp_term env t2)%Z
-  | Tmult t1 t2 => (interp_term env t1 * interp_term env t2)%Z
-  | Tminus t1 t2 => (interp_term env t1 - interp_term env t2)%Z
-  | Topp t => (- interp_term env t)%Z
-  | Tvar n => nth n env 0%Z
+  | (t1 + t2)%term => interp_term env t1 + interp_term env t2
+  | (t1 * t2)%term => interp_term env t1 * interp_term env t2
+  | (t1 - t2)%term => interp_term env t1 - interp_term env t2
+  | (- t)%term => - interp_term env t
+  | [n]%term => nth n env 0
   end.
 
 (* \subsubsection{Interprétation des prédicats} *) 
@@ -508,13 +520,13 @@ Fixpoint interp_proposition (envp : PropList) (env : list Z)
  (p : proposition) {struct p} : Prop :=
   match p with
   | EqTerm t1 t2 => interp_term env t1 = interp_term env t2
-  | LeqTerm t1 t2 => (interp_term env t1 <= interp_term env t2)%Z
+  | LeqTerm t1 t2 => interp_term env t1 <= interp_term env t2
   | TrueTerm => True
   | FalseTerm => False
   | Tnot p' => ~ interp_proposition envp env p'
-  | GeqTerm t1 t2 => (interp_term env t1 >= interp_term env t2)%Z
-  | GtTerm t1 t2 => (interp_term env t1 > interp_term env t2)%Z
-  | LtTerm t1 t2 => (interp_term env t1 < interp_term env t2)%Z
+  | GeqTerm t1 t2 => interp_term env t1 >= interp_term env t2
+  | GtTerm t1 t2 => interp_term env t1 > interp_term env t2
+  | LtTerm t1 t2 => interp_term env t1 < interp_term env t2
   | NeqTerm t1 t2 => Zne (interp_term env t1) (interp_term env t2)
   | Tor p1 p2 =>
       interp_proposition envp env p1 \/ interp_proposition envp env p2
@@ -531,7 +543,7 @@ Fixpoint interp_proposition (envp : PropList) (env : list Z)
    à manipuler individuellement *)
 
 Fixpoint interp_hyps (envp : PropList) (env : list Z) 
- (l : list proposition) {struct l} : Prop :=
+ (l : hyps) {struct l} : Prop :=
   match l with
   | nil => True
   | p' :: l' => interp_proposition envp env p' /\ interp_hyps envp env l'
@@ -542,26 +554,22 @@ Fixpoint interp_hyps (envp : PropList) (env : list Z)
    [Generalize] et qu'une conjonction est forcément lourde (répétition des
    types dans les conjonctions intermédiaires) *)
 
-Fixpoint interp_goal_concl (envp : PropList) (env : list Z) 
- (c : proposition) (l : list proposition) {struct l} : Prop :=
+Fixpoint interp_goal_concl (c : proposition) (envp : PropList) 
+ (env : list Z) (l : hyps) {struct l} : Prop :=
   match l with
   | nil => interp_proposition envp env c
   | p' :: l' =>
-      interp_proposition envp env p' -> interp_goal_concl envp env c l'
+      interp_proposition envp env p' -> interp_goal_concl c envp env l'
   end.
 
-Notation interp_goal :=
-  (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-   interp_goal_concl envp env FalseTerm l) (only parsing).
+Notation interp_goal := (interp_goal_concl FalseTerm).
 
 (* Les théorèmes qui suivent assurent la correspondance entre les deux
    interprétations. *)
 
 Theorem goal_to_hyps :
- forall (envp : PropList) (env : list Z) (l : list proposition),
- (interp_hyps envp env l -> False) ->
- (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-  interp_goal_concl envp env FalseTerm l) envp env l.
+ forall (envp : PropList) (env : list Z) (l : hyps),
+ (interp_hyps envp env l -> False) -> interp_goal envp env l.
 
 simple induction l;
  [ simpl in |- *; auto
@@ -569,10 +577,8 @@ simple induction l;
 Qed.
 
 Theorem hyps_to_goal :
- forall (envp : PropList) (env : list Z) (l : list proposition),
- (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-  interp_goal_concl envp env FalseTerm l) envp env l ->
- interp_hyps envp env l -> False.
+ forall (envp : PropList) (env : list Z) (l : hyps),
+ interp_goal envp env l -> interp_hyps envp env l -> False.
 
 simple induction l; simpl in |- *; [ auto | intros; apply H; elim H1; auto ].
 Qed.
@@ -603,22 +609,16 @@ Definition valid2 (f : proposition -> proposition -> proposition) :=
    liste de propositions et rend une nouvelle liste de proposition. 
    On reste contravariant *)
 
-Definition valid_hyps (f : list proposition -> list proposition) :=
-  forall (ep : PropList) (e : list Z) (lp : list proposition),
+Definition valid_hyps (f : hyps -> hyps) :=
+  forall (ep : PropList) (e : list Z) (lp : hyps),
   interp_hyps ep e lp -> interp_hyps ep e (f lp).
 
 (* Enfin ce théorème élimine la contravariance et nous ramène à une 
    opération sur les buts *)
 
  Theorem valid_goal :
-  forall (ep : PropList) (env : list Z) (l : list proposition)
-    (a : list proposition -> list proposition),
-  valid_hyps a ->
-  (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-   interp_goal_concl envp env FalseTerm l) ep env (
-    a l) ->
-  (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-   interp_goal_concl envp env FalseTerm l) ep env l.
+  forall (ep : PropList) (env : list Z) (l : hyps) (a : hyps -> hyps),
+  valid_hyps a -> interp_goal ep env (a l) -> interp_goal ep env l.
 
 intros; simpl in |- *; apply goal_to_hyps; intro H1;
  apply (hyps_to_goal ep env (a l) H0); apply H; assumption.
@@ -627,25 +627,22 @@ Qed.
 (* \subsubsection{Généralisation a des listes de buts (disjonctions)} *)
 
 
-Fixpoint interp_list_hyps (envp : PropList) (env : list Z)
- (l : list (list proposition)) {struct l} : Prop :=
+Fixpoint interp_list_hyps (envp : PropList) (env : list Z) 
+ (l : lhyps) {struct l} : Prop :=
   match l with
   | nil => False
   | h :: l' => interp_hyps envp env h \/ interp_list_hyps envp env l'
   end.
 
-Fixpoint interp_list_goal (envp : PropList) (env : list Z)
- (l : list (list proposition)) {struct l} : Prop :=
+Fixpoint interp_list_goal (envp : PropList) (env : list Z) 
+ (l : lhyps) {struct l} : Prop :=
   match l with
   | nil => True
-  | h :: l' =>
-      (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-       interp_goal_concl envp env FalseTerm l) envp env h /\
-      interp_list_goal envp env l'
+  | h :: l' => interp_goal envp env h /\ interp_list_goal envp env l'
   end.
 
 Theorem list_goal_to_hyps :
- forall (envp : PropList) (env : list Z) (l : list (list proposition)),
+ forall (envp : PropList) (env : list Z) (l : lhyps),
  (interp_list_hyps envp env l -> False) -> interp_list_goal envp env l.
 
 simple induction l; simpl in |- *;
@@ -656,7 +653,7 @@ simple induction l; simpl in |- *;
 Qed.
 
 Theorem list_hyps_to_goal :
- forall (envp : PropList) (env : list Z) (l : list (list proposition)),
+ forall (envp : PropList) (env : list Z) (l : lhyps),
  interp_list_goal envp env l -> interp_list_hyps envp env l -> False.
 
 simple induction l; simpl in |- *;
@@ -665,21 +662,16 @@ simple induction l; simpl in |- *;
     [ apply hyps_to_goal with (1 := H1); assumption | auto ] ].
 Qed.
 
-Definition valid_list_hyps
-  (f : list proposition -> list (list proposition)) :=
-  forall (ep : PropList) (e : list Z) (lp : list proposition),
+Definition valid_list_hyps (f : hyps -> lhyps) :=
+  forall (ep : PropList) (e : list Z) (lp : hyps),
   interp_hyps ep e lp -> interp_list_hyps ep e (f lp).
 
-Definition valid_list_goal
-  (f : list proposition -> list (list proposition)) :=
-  forall (ep : PropList) (e : list Z) (lp : list proposition),
-  interp_list_goal ep e (f lp) ->
-  (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-   interp_goal_concl envp env FalseTerm l) ep e lp.
+Definition valid_list_goal (f : hyps -> lhyps) :=
+  forall (ep : PropList) (e : list Z) (lp : hyps),
+  interp_list_goal ep e (f lp) -> interp_goal ep e lp.
 
 Theorem goal_valid :
- forall f : list proposition -> list (list proposition),
- valid_list_hyps f -> valid_list_goal f.
+ forall f : hyps -> lhyps, valid_list_hyps f -> valid_list_goal f.
 
 unfold valid_list_goal in |- *; intros f H ep e lp H1; apply goal_to_hyps;
  intro H2; apply list_hyps_to_goal with (1 := H1); 
@@ -687,7 +679,7 @@ unfold valid_list_goal in |- *; intros f H ep e lp H1; apply goal_to_hyps;
 Qed.
  
 Theorem append_valid :
- forall (ep : PropList) (e : list Z) (l1 l2 : list (list proposition)),
+ forall (ep : PropList) (e : list Z) (l1 l2 : lhyps),
  interp_list_hyps ep e l1 \/ interp_list_hyps ep e l2 ->
  interp_list_hyps ep e (l1 ++ l2).
 
@@ -703,10 +695,10 @@ Qed.
 (* \subsubsection{Opérateurs valides sur les hypothèses} *)
 
 (* Extraire une hypothèse de la liste *)
-Definition nth_hyps (n : nat) (l : list proposition) := nth n l TrueTerm.
+Definition nth_hyps (n : nat) (l : hyps) := nth n l TrueTerm.
 
 Theorem nth_valid :
- forall (ep : PropList) (e : list Z) (i : nat) (l : list proposition),
+ forall (ep : PropList) (e : list Z) (i : nat) (l : hyps),
  interp_hyps ep e l -> interp_proposition ep e (nth_hyps i l).
 
 unfold nth_hyps in |- *; simple induction i;
@@ -719,7 +711,7 @@ Qed.
 (* Appliquer une opération (valide) sur deux hypothèses extraites de 
    la liste et ajouter le résultat à la liste. *)
 Definition apply_oper_2 (i j : nat)
-  (f : proposition -> proposition -> proposition) (l : list proposition) :=
+  (f : proposition -> proposition -> proposition) (l : hyps) :=
   f (nth_hyps i l) (nth_hyps j l) :: l.
 
 Theorem apply_oper_2_valid :
@@ -732,8 +724,8 @@ Qed.
 
 (* Modifier une hypothèse par application d'une opération valide *)
 
-Fixpoint apply_oper_1 (i : nat) (f : proposition -> proposition)
- (l : list proposition) {struct i} : list proposition :=
+Fixpoint apply_oper_1 (i : nat) (f : proposition -> proposition) 
+ (l : hyps) {struct i} : hyps :=
   match l with
   | nil => nil (A:=proposition)
   | p :: l' =>
@@ -767,23 +759,23 @@ Qed.
 
 Definition apply_left (f : term -> term) (t : term) :=
   match t with
-  | Tplus x y => Tplus (f x) y
-  | Tmult x y => Tmult (f x) y
-  | Topp x => Topp (f x)
+  | (x + y)%term => (f x + y)%term
+  | (x * y)%term => (f x * y)%term
+  | (- x)%term => (- f x)%term
   | x => x
   end.
 
 Definition apply_right (f : term -> term) (t : term) :=
   match t with
-  | Tplus x y => Tplus x (f y)
-  | Tmult x y => Tmult x (f y)
+  | (x + y)%term => (x + f y)%term
+  | (x * y)%term => (x * f y)%term
   | x => x
   end.
 
 Definition apply_both (f g : term -> term) (t : term) :=
   match t with
-  | Tplus x y => Tplus (f x) (g y)
-  | Tmult x y => Tmult (f x) (g y)
+  | (x + y)%term => (f x + g y)%term
+  | (x * y)%term => (f x * g y)%term
   | x => x
   end.
 
@@ -849,31 +841,25 @@ Qed.
 (* \subsubsection{La tactique pour prouver la stabilité} *)
 
 Ltac loop t :=
-  match constr:t with
-  | (?X1 = ?X2) => 
-                    (* Global *)
-                    loop X1 || loop X2
+  match t with
+  (* Global *)
+  | (?X1 = ?X2) => loop X1 || loop X2
   | (_ -> ?X1) => loop X1
-  | (interp_hyps _ _ ?X1) =>
-      
   (* Interpretations *)
-  loop X1
+  | (interp_hyps _ _ ?X1) => loop X1
   | (interp_list_hyps _ _ ?X1) => loop X1
   | (interp_proposition _ _ ?X1) => loop X1
   | (interp_term _ ?X1) => loop X1
-  | (EqTerm ?X1 ?X2) =>
-      
-       (* Propositions *)
-       loop X1 || loop X2
+  (* Propositions *)
+  | (EqTerm ?X1 ?X2) => loop X1 || loop X2
   | (LeqTerm ?X1 ?X2) => loop X1 || loop X2
-  | (Tplus ?X1 ?X2) => 
-                        (* Termes *)
-                        loop X1 || loop X2
-  | (Tminus ?X1 ?X2) => loop X1 || loop X2
-  | (Tmult ?X1 ?X2) => loop X1 || loop X2
-  | (Topp ?X1) => loop X1
-  | (Tint ?X1) =>
-      loop X1
+  (* Termes *)
+  | (?X1 + ?X2)%term => loop X1 || loop X2
+  | (?X1 - ?X2)%term => loop X1 || loop X2
+  | (?X1 * ?X2)%term => loop X1 || loop X2
+  | (- ?X1)%term => loop X1
+  | (Tint ?X1) => loop X1
+  (* Eliminations *)
   | match ?X1 with
     | EqTerm x x0 => _
     | LeqTerm x x0 => _
@@ -889,8 +875,6 @@ Ltac loop t :=
     | Timp x x0 => _
     | Tprop x => _
     end =>
-      
-       (* Eliminations *)
        case X1;
        [ intro; intro
        | intro; intro
@@ -907,19 +891,19 @@ Ltac loop t :=
        | intro ]; auto; Simplify
   | match ?X1 with
     | Tint x => _
-    | Tplus x x0 => _
-    | Tmult x x0 => _
-    | Tminus x x0 => _
-    | Topp x => _
-    | Tvar x => _
+    | (x + x0)%term => _
+    | (x * x0)%term => _
+    | (x - x0)%term => _
+    | (- x)%term => _
+    | [x]%term => _
     end =>
       case X1;
        [ intro | intro; intro | intro; intro | intro; intro | intro | intro ];
        auto; Simplify
-  | match (?X1 ?= ?X2)%Z with
-    | Datatypes.Eq => _
-    | Datatypes.Lt => _
-    | Datatypes.Gt => _
+  | match ?X1 ?= ?X2 with
+    | Eq => _
+    | Lt => _
+    | Gt => _
     end =>
       elim_Zcompare X1 X2; intro; auto; Simplify
   | match ?X1 with
@@ -955,7 +939,7 @@ Ltac prove_stable x th :=
 (* \subsubsection{Les règles elle mêmes} *)
 Definition Tplus_assoc_l (t : term) :=
   match t with
-  | Tplus n (Tplus m p) => Tplus (Tplus n m) p
+  | (n + (m + p))%term => (n + m + p)%term
   | _ => t
   end.
 
@@ -966,7 +950,7 @@ Qed.
 
 Definition Tplus_assoc_r (t : term) :=
   match t with
-  | Tplus (Tplus n m) p => Tplus n (Tplus m p)
+  | (n + m + p)%term => (n + (m + p))%term
   | _ => t
   end.
 
@@ -977,7 +961,7 @@ Qed.
 
 Definition Tmult_assoc_r (t : term) :=
   match t with
-  | Tmult (Tmult n m) p => Tmult n (Tmult m p)
+  | (n * m * p)%term => (n * (m * p))%term
   | _ => t
   end.
 
@@ -988,7 +972,7 @@ Qed.
 
 Definition Tplus_permute (t : term) :=
   match t with
-  | Tplus n (Tplus m p) => Tplus m (Tplus n p)
+  | (n + (m + p))%term => (m + (n + p))%term
   | _ => t
   end.
 
@@ -999,7 +983,7 @@ Qed.
 
 Definition Tplus_sym (t : term) :=
   match t with
-  | Tplus x y => Tplus y x
+  | (x + y)%term => (y + x)%term
   | _ => t
   end.
 
@@ -1010,7 +994,7 @@ Qed.
 
 Definition Tmult_sym (t : term) :=
   match t with
-  | Tmult x y => Tmult y x
+  | (x * y)%term => (y * x)%term
   | _ => t
   end.
 
@@ -1021,12 +1005,10 @@ Qed.
 
 Definition T_OMEGA10 (t : term) :=
   match t with
-  | Tplus (Tmult (Tplus (Tmult v (Tint c1)) l1) (Tint k1)) (Tmult (Tplus
-    (Tmult v' (Tint c2)) l2) (Tint k2)) =>
+  | ((v * Tint c1 + l1) * Tint k1 + (v' * Tint c2 + l2) * Tint k2)%term =>
       match eq_term v v' with
       | true =>
-          Tplus (Tmult v (Tint (c1 * k1 + c2 * k2)))
-            (Tplus (Tmult l1 (Tint k1)) (Tmult l2 (Tint k2)))
+          (v * Tint (c1 * k1 + c2 * k2) + (l1 * Tint k1 + l2 * Tint k2))%term
       | false => t
       end
   | _ => t
@@ -1039,8 +1021,8 @@ Qed.
 
 Definition T_OMEGA11 (t : term) :=
   match t with
-  | Tplus (Tmult (Tplus (Tmult v1 (Tint c1)) l1) (Tint k1)) l2 =>
-      Tplus (Tmult v1 (Tint (c1 * k1))) (Tplus (Tmult l1 (Tint k1)) l2)
+  | ((v1 * Tint c1 + l1) * Tint k1 + l2)%term =>
+      (v1 * Tint (c1 * k1) + (l1 * Tint k1 + l2))%term
   | _ => t
   end.
 
@@ -1051,8 +1033,8 @@ Qed.
 
 Definition T_OMEGA12 (t : term) :=
   match t with
-  | Tplus l1 (Tmult (Tplus (Tmult v2 (Tint c2)) l2) (Tint k2)) =>
-      Tplus (Tmult v2 (Tint (c2 * k2))) (Tplus l1 (Tmult l2 (Tint k2)))
+  | (l1 + (v2 * Tint c2 + l2) * Tint k2)%term =>
+      (v2 * Tint (c2 * k2) + (l1 + l2 * Tint k2))%term
   | _ => t
   end.
 
@@ -1063,22 +1045,22 @@ Qed.
 
 Definition T_OMEGA13 (t : term) :=
   match t with
-  | Tplus (Tplus (Tmult v (Tint (Zpos x))) l1) (Tplus (Tmult v' (Tint (Zneg
-    x'))) l2) =>
+  | (v * Tint (Zpos x) + l1 + (v' * Tint (Zneg x') + l2))%term =>
       match eq_term v v' with
-      | true => match eq_pos x x' with
-                | true => Tplus l1 l2
-                | false => t
-                end
+      | true =>
+          match eq_pos x x' with
+          | true => (l1 + l2)%term
+          | false => t
+          end
       | false => t
       end
-  | Tplus (Tplus (Tmult v (Tint (Zneg x))) l1) (Tplus (Tmult v' (Tint (Zpos
-    x'))) l2) =>
+  | (v * Tint (Zneg x) + l1 + (v' * Tint (Zpos x') + l2))%term =>
       match eq_term v v' with
-      | true => match eq_pos x x' with
-                | true => Tplus l1 l2
-                | false => t
-                end
+      | true =>
+          match eq_pos x x' with
+          | true => (l1 + l2)%term
+          | false => t
+          end
       | false => t
       end
   | _ => t
@@ -1092,12 +1074,9 @@ Qed.
 
 Definition T_OMEGA15 (t : term) :=
   match t with
-  | Tplus (Tplus (Tmult v (Tint c1)) l1) (Tmult (Tplus (Tmult v' (Tint c2))
-    l2) (Tint k2)) =>
+  | (v * Tint c1 + l1 + (v' * Tint c2 + l2) * Tint k2)%term =>
       match eq_term v v' with
-      | true =>
-          Tplus (Tmult v (Tint (c1 + c2 * k2)))
-            (Tplus l1 (Tmult l2 (Tint k2)))
+      | true => (v * Tint (c1 + c2 * k2) + (l1 + l2 * Tint k2))%term
       | false => t
       end
   | _ => t
@@ -1110,8 +1089,7 @@ Qed.
 
 Definition T_OMEGA16 (t : term) :=
   match t with
-  | Tmult (Tplus (Tmult v (Tint c)) l) (Tint k) =>
-      Tplus (Tmult v (Tint (c * k))) (Tmult l (Tint k))
+  | ((v * Tint c + l) * Tint k)%term => (v * Tint (c * k) + l * Tint k)%term
   | _ => t
   end.
 
@@ -1123,7 +1101,7 @@ Qed.
 
 Definition Tred_factor5 (t : term) :=
   match t with
-  | Tplus (Tmult x (Tint Z0)) y => y
+  | (x * Tint Z0 + y)%term => y
   | _ => t
   end.
 
@@ -1135,7 +1113,7 @@ Qed.
 
 Definition Topp_plus (t : term) :=
   match t with
-  | Topp (Tplus x y) => Tplus (Topp x) (Topp y)
+  | (- (x + y))%term => (- x + - y)%term
   | _ => t
   end.
 
@@ -1147,7 +1125,7 @@ Qed.
 
 Definition Topp_opp (t : term) :=
   match t with
-  | Topp (Topp x) => x
+  | (- - x)%term => x
   | _ => t
   end.
 
@@ -1158,7 +1136,7 @@ Qed.
 
 Definition Topp_mult_r (t : term) :=
   match t with
-  | Topp (Tmult x (Tint k)) => Tmult x (Tint (- k))
+  | (- (x * Tint k))%term => (x * Tint (- k))%term
   | _ => t
   end.
 
@@ -1169,7 +1147,7 @@ Qed.
 
 Definition Topp_one (t : term) :=
   match t with
-  | Topp x => Tmult x (Tint (-1))
+  | (- x)%term => (x * Tint (-1))%term
   | _ => t
   end.
 
@@ -1180,7 +1158,7 @@ Qed.
 
 Definition Tmult_plus_distr (t : term) :=
   match t with
-  | Tmult (Tplus n m) p => Tplus (Tmult n p) (Tmult m p)
+  | ((n + m) * p)%term => (n * p + m * p)%term
   | _ => t
   end.
 
@@ -1191,7 +1169,7 @@ Qed.
 
 Definition Tmult_opp_left (t : term) :=
   match t with
-  | Tmult (Topp x) (Tint y) => Tmult x (Tint (- y))
+  | (- x * Tint y)%term => (x * Tint (- y))%term
   | _ => t
   end.
 
@@ -1202,7 +1180,7 @@ Qed.
 
 Definition Tmult_assoc_reduced (t : term) :=
   match t with
-  | Tmult (Tmult n (Tint m)) (Tint p) => Tmult n (Tint (m * p))
+  | (n * Tint m * Tint p)%term => (n * Tint (m * p))%term
   | _ => t
   end.
 
@@ -1211,7 +1189,7 @@ Theorem Tmult_assoc_reduced_stable : term_stable Tmult_assoc_reduced.
 prove_stable Tmult_assoc_reduced Zmult_assoc_reverse.
 Qed.
 
-Definition Tred_factor0 (t : term) := Tmult t (Tint 1).
+Definition Tred_factor0 (t : term) := (t * Tint 1)%term.
 
 Theorem Tred_factor0_stable : term_stable Tred_factor0.
 
@@ -1220,9 +1198,9 @@ Qed.
 
 Definition Tred_factor1 (t : term) :=
   match t with
-  | Tplus x y =>
+  | (x + y)%term =>
       match eq_term x y with
-      | true => Tmult x (Tint 2)
+      | true => (x * Tint 2)%term
       | false => t
       end
   | _ => t
@@ -1235,9 +1213,9 @@ Qed.
 
 Definition Tred_factor2 (t : term) :=
   match t with
-  | Tplus x (Tmult y (Tint k)) =>
+  | (x + y * Tint k)%term =>
       match eq_term x y with
-      | true => Tmult x (Tint (1 + k))
+      | true => (x * Tint (1 + k))%term
       | false => t
       end
   | _ => t
@@ -1254,9 +1232,9 @@ Qed.
 
 Definition Tred_factor3 (t : term) :=
   match t with
-  | Tplus (Tmult x (Tint k)) y =>
+  | (x * Tint k + y)%term =>
       match eq_term x y with
-      | true => Tmult x (Tint (1 + k))
+      | true => (x * Tint (1 + k))%term
       | false => t
       end
   | _ => t
@@ -1270,9 +1248,9 @@ Qed.
 
 Definition Tred_factor4 (t : term) :=
   match t with
-  | Tplus (Tmult x (Tint k1)) (Tmult y (Tint k2)) =>
+  | (x * Tint k1 + y * Tint k2)%term =>
       match eq_term x y with
-      | true => Tmult x (Tint (k1 + k2))
+      | true => (x * Tint (k1 + k2))%term
       | false => t
       end
   | _ => t
@@ -1283,7 +1261,7 @@ Theorem Tred_factor4_stable : term_stable Tred_factor4.
 prove_stable Tred_factor4 Zred_factor4.
 Qed.
 
-Definition Tred_factor6 (t : term) := Tplus t (Tint 0).
+Definition Tred_factor6 (t : term) := (t + Tint 0)%term.
 
 Theorem Tred_factor6_stable : term_stable Tred_factor6.
 
@@ -1294,7 +1272,7 @@ Transparent Zplus.
 
 Definition Tminus_def (t : term) :=
   match t with
-  | Tminus x y => Tplus x (Topp y)
+  | (x - y)%term => (x + - y)%term
   | _ => t
   end.
 
@@ -1313,37 +1291,37 @@ Qed.
 
 Fixpoint reduce (t : term) : term :=
   match t with
-  | Tplus x y =>
+  | (x + y)%term =>
       match reduce x with
       | Tint x' =>
           match reduce y with
           | Tint y' => Tint (x' + y')
-          | y' => Tplus (Tint x') y'
+          | y' => (Tint x' + y')%term
           end
-      | x' => Tplus x' (reduce y)
+      | x' => (x' + reduce y)%term
       end
-  | Tmult x y =>
+  | (x * y)%term =>
       match reduce x with
       | Tint x' =>
           match reduce y with
           | Tint y' => Tint (x' * y')
-          | y' => Tmult (Tint x') y'
+          | y' => (Tint x' * y')%term
           end
-      | x' => Tmult x' (reduce y)
+      | x' => (x' * reduce y)%term
       end
-  | Tminus x y =>
+  | (x - y)%term =>
       match reduce x with
       | Tint x' =>
           match reduce y with
           | Tint y' => Tint (x' - y')
-          | y' => Tminus (Tint x') y'
+          | y' => (Tint x' - y')%term
           end
-      | x' => Tminus x' (reduce y)
+      | x' => (x' - reduce y)%term
       end
-  | Topp x =>
+  | (- x)%term =>
       match reduce x with
       | Tint x' => Tint (- x')
-      | x' => Topp x'
+      | x' => (- x')%term
       end
   | _ => t
   end.
@@ -1412,7 +1390,7 @@ Definition fusion_right (trace : list t_fusion) (t : term) : term :=
       end
   end.
 
-(* \paragraph{Fusion avec anihilation} *)
+(* \paragraph{Fusion avec annihilation} *)
 (* Normalement le résultat est une constante *)
 
 Fixpoint fusion_cancel (trace : nat) (t : term) {struct trace} : term :=
@@ -1428,7 +1406,7 @@ unfold term_stable, fusion_cancel in |- *; intros trace e; elim trace;
  | intros n H t; elim H; exact (T_OMEGA13_stable e t) ].
 Qed. 
 
-(* \subsubsection{Opérations afines sur une équation} *)
+(* \subsubsection{Opérations affines sur une équation} *)
 (* \paragraph{Multiplication scalaire et somme d'une constante} *)
 
 Fixpoint scalar_norm_add (trace : nat) (t : term) {struct trace} : term :=
@@ -1497,7 +1475,7 @@ Fixpoint rewrite (s : step) : term -> term :=
   | C_PLUS_ASSOC_R => Tplus_assoc_r
   | C_PLUS_ASSOC_L => Tplus_assoc_l
   | C_PLUS_PERMUTE => Tplus_permute
-  | C_PLUS_SYM => Tplus_sym
+  | C_PLUS_COMM => Tplus_sym
   | C_RED0 => Tred_factor0
   | C_RED1 => Tred_factor1
   | C_RED2 => Tred_factor2
@@ -1507,7 +1485,7 @@ Fixpoint rewrite (s : step) : term -> term :=
   | C_RED6 => Tred_factor6
   | C_MULT_ASSOC_REDUCED => Tmult_assoc_reduced
   | C_MINUS => Tminus_def
-  | C_MULT_SYM => Tmult_sym
+  | C_MULT_COMM => Tmult_sym
   end.
 
 Theorem rewrite_stable : forall s : step, term_stable (rewrite s).
@@ -1547,7 +1525,7 @@ Qed.
 \subsubsection{Tactiques générant une contradiction}
 \paragraph{[O_CONSTANT_NOT_NUL]} *)
 
-Definition constant_not_nul (i : nat) (h : list proposition) :=
+Definition constant_not_nul (i : nat) (h : hyps) :=
   match nth_hyps i h with
   | EqTerm (Tint Z0) (Tint n) =>
       match eq_Z n 0 with
@@ -1562,13 +1540,13 @@ Theorem constant_not_nul_valid :
 
 unfold valid_hyps, constant_not_nul in |- *; intros;
  generalize (nth_valid ep e i lp); Simplify; simpl in |- *;
- elim_eq_Z ipattern:z0 0%Z; auto; simpl in |- *; intros H1 H2; 
+ elim_eq_Z ipattern:z0 0; auto; simpl in |- *; intros H1 H2; 
  elim H1; symmetry  in |- *; auto.
 Qed.   
 
 (* \paragraph{[O_CONSTANT_NEG]} *)
 
-Definition constant_neg (i : nat) (h : list proposition) :=
+Definition constant_neg (i : nat) (h : hyps) :=
   match nth_hyps i h with
   | LeqTerm (Tint Z0) (Tint (Zneg n)) => absurd
   | _ => h
@@ -1584,18 +1562,17 @@ Qed.
 
 (* \paragraph{[NOT_EXACT_DIVIDE]} *)
 Definition not_exact_divide (k1 k2 : Z) (body : term) 
-  (t i : nat) (l : list proposition) :=
+  (t i : nat) (l : hyps) :=
   match nth_hyps i l with
   | EqTerm (Tint Z0) b =>
       match
-        eq_term (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2)))
-          b
+        eq_term (scalar_norm_add t (body * Tint k1 + Tint k2)%term) b
       with
       | true =>
-          match (k2 ?= 0)%Z with
-          | Datatypes.Gt =>
-              match (k1 ?= k2)%Z with
-              | Datatypes.Gt => absurd
+          match k2 ?= 0 with
+          | Gt =>
+              match k1 ?= k2 with
+              | Gt => absurd
               | _ => l
               end
           | _ => l
@@ -1611,27 +1588,26 @@ Theorem not_exact_divide_valid :
 
 unfold valid_hyps, not_exact_divide in |- *; intros;
  generalize (nth_valid ep e i lp); Simplify;
- elim_eq_term (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) t1;
+ elim_eq_term (scalar_norm_add t (body * Tint k1 + Tint k2)%term) t1; 
  auto; Simplify; intro H2; elim H2; simpl in |- *;
  elim (scalar_norm_add_stable t e); simpl in |- *; 
- intro H4; absurd ((interp_term e body * k1 + k2)%Z = 0%Z);
+ intro H4; absurd (interp_term e body * k1 + k2 = 0);
  [ apply OMEGA4; assumption | symmetry  in |- *; auto ].
 
 Qed.
 
 (* \paragraph{[O_CONTRADICTION]} *)
 
-Definition contradiction (t i j : nat) (l : list proposition) :=
+Definition contradiction (t i j : nat) (l : hyps) :=
   match nth_hyps i l with
   | LeqTerm (Tint Z0) b1 =>
       match nth_hyps j l with
       | LeqTerm (Tint Z0) b2 =>
-          match fusion_cancel t (Tplus b1 b2) with
-          | Tint k =>
-              match (0 ?= k)%Z with
-              | Datatypes.Gt => absurd
-              | _ => l
-              end
+          match fusion_cancel t (b1 + b2)%term with
+          | Tint k => match 0 ?= k with
+                      | Gt => absurd
+                      | _ => l
+                      end
           | _ => l
           end
       | _ => l
@@ -1648,9 +1624,9 @@ unfold valid_hyps, contradiction in |- *; intros t i j ep e l H;
  auto; intros z; case z; auto; case (nth_hyps j l); 
  auto; intros t3 t4; case t3; auto; intros z'; case z'; 
  auto; simpl in |- *; intros H1 H2;
- generalize (refl_equal (interp_term e (fusion_cancel t (Tplus t2 t4))));
- pattern (fusion_cancel t (Tplus t2 t4)) at 2 3 in |- *;
- case (fusion_cancel t (Tplus t2 t4)); simpl in |- *; 
+ generalize (refl_equal (interp_term e (fusion_cancel t (t2 + t4)%term)));
+ pattern (fusion_cancel t (t2 + t4)%term) at 2 3 in |- *;
+ case (fusion_cancel t (t2 + t4)%term); simpl in |- *; 
  auto; intro k; elim (fusion_cancel_stable t); simpl in |- *; 
  intro E; generalize (OMEGA2 _ _ H2 H1); rewrite E; 
  case k; auto; unfold Zle in |- *; simpl in |- *; intros p H3; 
@@ -1660,7 +1636,7 @@ Qed.
 
 (* \paragraph{[O_NEGATE_CONTRADICT]} *)
 
-Definition negate_contradict (i1 i2 : nat) (h : list proposition) :=
+Definition negate_contradict (i1 i2 : nat) (h : hyps) :=
   match nth_hyps i1 h with
   | EqTerm (Tint Z0) b1 =>
       match nth_hyps i2 h with
@@ -1683,12 +1659,12 @@ Definition negate_contradict (i1 i2 : nat) (h : list proposition) :=
   | _ => h
   end.
 
-Definition negate_contradict_inv (t i1 i2 : nat) (h : list proposition) :=
+Definition negate_contradict_inv (t i1 i2 : nat) (h : hyps) :=
   match nth_hyps i1 h with
   | EqTerm (Tint Z0) b1 =>
       match nth_hyps i2 h with
       | NeqTerm (Tint Z0) b2 =>
-          match eq_term b1 (scalar_norm t (Tmult b2 (Tint (-1)))) with
+          match eq_term b1 (scalar_norm t (b2 * Tint (-1))%term) with
           | true => absurd
           | false => h
           end
@@ -1697,7 +1673,7 @@ Definition negate_contradict_inv (t i1 i2 : nat) (h : list proposition) :=
   | NeqTerm (Tint Z0) b1 =>
       match nth_hyps i2 h with
       | EqTerm (Tint Z0) b2 =>
-          match eq_term b1 (scalar_norm t (Tmult b2 (Tint (-1)))) with
+          match eq_term b1 (scalar_norm t (b2 * Tint (-1))%term) with
           | true => absurd
           | false => h
           end
@@ -1732,11 +1708,11 @@ unfold valid_hyps, negate_contradict_inv in |- *; intros t i j ep e l H;
  auto; intros z; case z; auto; case (nth_hyps j l); 
  auto; intros t3 t4; case t3; auto; intros z'; case z'; 
  auto; simpl in |- *; intros H1 H2;
- (pattern (eq_term t2 (scalar_norm t (Tmult t4 (Tint (-1))))) in |- *;
+ (pattern (eq_term t2 (scalar_norm t (t4 * Tint (-1))%term)) in |- *;
    apply bool_ind2; intro Aux;
-   [ generalize (eq_term_true t2 (scalar_norm t (Tmult t4 (Tint (-1)))) Aux);
+   [ generalize (eq_term_true t2 (scalar_norm t (t4 * Tint (-1))%term) Aux);
       clear Aux
-   | generalize (eq_term_false t2 (scalar_norm t (Tmult t4 (Tint (-1)))) Aux);
+   | generalize (eq_term_false t2 (scalar_norm t (t4 * Tint (-1))%term) Aux);
       clear Aux ]);
  [ intro H3; elim H1; generalize H2; rewrite H3;
     rewrite <- (scalar_norm_stable t e); simpl in |- *;
@@ -1762,32 +1738,28 @@ Definition sum (k1 k2 : Z) (trace : list t_fusion)
   | EqTerm (Tint Z0) b1 =>
       match prop2 with
       | EqTerm (Tint Z0) b2 =>
-          EqTerm (Tint 0)
-            (fusion trace (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))
+          EqTerm (Tint 0) (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
       | LeqTerm (Tint Z0) b2 =>
-          match (k2 ?= 0)%Z with
-          | Datatypes.Gt =>
+          match k2 ?= 0 with
+          | Gt =>
               LeqTerm (Tint 0)
-                (fusion trace
-                   (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))
+                (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
           | _ => TrueTerm
           end
       | _ => TrueTerm
       end
   | LeqTerm (Tint Z0) b1 =>
-      match (k1 ?= 0)%Z with
-      | Datatypes.Gt =>
+      match k1 ?= 0 with
+      | Gt =>
           match prop2 with
           | EqTerm (Tint Z0) b2 =>
               LeqTerm (Tint 0)
-                (fusion trace
-                   (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))
+                (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
           | LeqTerm (Tint Z0) b2 =>
-              match (k2 ?= 0)%Z with
-              | Datatypes.Gt =>
+              match k2 ?= 0 with
+              | Gt =>
                   LeqTerm (Tint 0)
-                    (fusion trace
-                       (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))
+                    (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
               | _ => TrueTerm
               end
           | _ => TrueTerm
@@ -1801,23 +1773,20 @@ Definition sum (k1 k2 : Z) (trace : list t_fusion)
           | true => TrueTerm
           | false =>
               NeqTerm (Tint 0)
-                (fusion trace
-                   (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2))))
+                (fusion trace (b1 * Tint k1 + b2 * Tint k2)%term)
           end
       | _ => TrueTerm
       end
   | _ => TrueTerm
   end.
 
-Theorem sum1 :
- forall a b c d : Z, 0%Z = a -> 0%Z = b -> 0%Z = (a * c + b * d)%Z.
+Theorem sum1 : forall a b c d : Z, 0 = a -> 0 = b -> 0 = a * c + b * d.
 
 intros; elim H; elim H0; simpl in |- *; auto.
 Qed.
   
 Theorem sum2 :
- forall a b c d : Z,
- (0 <= d)%Z -> 0%Z = a -> (0 <= b)%Z -> (0 <= a * c + b * d)%Z.
+ forall a b c d : Z, 0 <= d -> 0 = a -> 0 <= b -> 0 <= a * c + b * d.
 
 intros; elim H0; simpl in |- *; generalize H H1; case b; case d;
  unfold Zle in |- *; simpl in |- *; auto.  
@@ -1825,21 +1794,19 @@ Qed.
 
 Theorem sum3 :
  forall a b c d : Z,
- (0 <= c)%Z ->
- (0 <= d)%Z -> (0 <= a)%Z -> (0 <= b)%Z -> (0 <= a * c + b * d)%Z.
+ 0 <= c -> 0 <= d -> 0 <= a -> 0 <= b -> 0 <= a * c + b * d.
 
 intros a b c d; case a; case b; case c; case d; unfold Zle in |- *;
  simpl in |- *; auto. 
 Qed.
 
-Theorem sum4 : forall k : Z, (k ?= 0)%Z = Datatypes.Gt -> (0 <= k)%Z.
+Theorem sum4 : forall k : Z, (k ?= 0) = Gt -> 0 <= k.
 
 intro; case k; unfold Zle in |- *; simpl in |- *; auto; intros; discriminate.  
 Qed.
 
 Theorem sum5 :
- forall a b c d : Z,
- c <> 0%Z -> 0%Z <> a -> 0%Z = b -> 0%Z <> (a * c + b * d)%Z.
+ forall a b c d : Z, c <> 0 -> 0 <> a -> 0 = b -> 0 <> a * c + b * d.
 
 intros a b c d H1 H2 H3; elim H3; simpl in |- *; rewrite Zplus_comm;
  simpl in |- *; generalize H1 H2; case a; case c; simpl in |- *; 
@@ -1857,9 +1824,8 @@ unfold valid2 in |- *; intros k1 k2 t ep e p1 p2; unfold sum in |- *;
  | apply sum2; try assumption; apply sum4; assumption
  | rewrite Zplus_comm; apply sum2; try assumption; apply sum4; assumption
  | apply sum3; try assumption; apply sum4; assumption
- | elim_eq_Z k1 0%Z; simpl in |- *; auto; elim (fusion_stable t);
-    simpl in |- *; intros; unfold Zne in |- *; apply sum5; 
-    assumption ].
+ | elim_eq_Z k1 0; simpl in |- *; auto; elim (fusion_stable t); simpl in |- *;
+    intros; unfold Zne in |- *; apply sum5; assumption ].
 Qed.
 
 (* \paragraph{[O_EXACT_DIVIDE]}
@@ -1869,7 +1835,7 @@ Definition exact_divide (k : Z) (body : term) (t : nat)
   (prop : proposition) :=
   match prop with
   | EqTerm (Tint Z0) b =>
-      match eq_term (scalar_norm t (Tmult body (Tint k))) b with
+      match eq_term (scalar_norm t (body * Tint k)%term) b with
       | true =>
           match eq_Z k 0 with
           | true => TrueTerm
@@ -1885,13 +1851,13 @@ Theorem exact_divide_valid :
 
 
 unfold valid1, exact_divide in |- *; intros k1 k2 t ep e p1; Simplify;
- simpl in |- *; auto; elim_eq_term (scalar_norm t (Tmult k2 (Tint k1))) t1;
- simpl in |- *; auto; elim_eq_Z k1 0%Z; simpl in |- *; 
+ simpl in |- *; auto; elim_eq_term (scalar_norm t (k2 * Tint k1)%term) t1;
+ simpl in |- *; auto; elim_eq_Z k1 0; simpl in |- *; 
  auto; intros H1 H2; elim H2; elim scalar_norm_stable; 
  simpl in |- *; generalize H1; case (interp_term e k2); 
  try trivial;
  (case k1; simpl in |- *;
-   [ intros; absurd (0%Z = 0%Z); assumption
+   [ intros; absurd (0 = 0); assumption
    | intros p2 p3 H3 H4; discriminate H4
    | intros p2 p3 H3 H4; discriminate H4 ]).
 
@@ -1908,14 +1874,13 @@ Definition divide_and_approx (k1 k2 : Z) (body : term)
   match prop with
   | LeqTerm (Tint Z0) b =>
       match
-        eq_term (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2)))
-          b
+        eq_term (scalar_norm_add t (body * Tint k1 + Tint k2)%term) b
       with
       | true =>
-          match (k1 ?= 0)%Z with
-          | Datatypes.Gt =>
-              match (k1 ?= k2)%Z with
-              | Datatypes.Gt => LeqTerm (Tint 0) body
+          match k1 ?= 0 with
+          | Gt =>
+              match k1 ?= k2 with
+              | Gt => LeqTerm (Tint 0) body
               | _ => prop
               end
           | _ => prop
@@ -1931,7 +1896,7 @@ Theorem divide_and_approx_valid :
 
 unfold valid1, divide_and_approx in |- *; intros k1 k2 body t ep e p1;
  Simplify;
- elim_eq_term (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) t1;
+ elim_eq_term (scalar_norm_add t (body * Tint k1 + Tint k2)%term) t1;
  Simplify; auto; intro E; elim E; simpl in |- *;
  elim (scalar_norm_add_stable t e); simpl in |- *; 
  intro H1; apply Zmult_le_approx with (3 := H1); assumption.
@@ -1944,7 +1909,7 @@ Definition merge_eq (t : nat) (prop1 prop2 : proposition) :=
   | LeqTerm (Tint Z0) b1 =>
       match prop2 with
       | LeqTerm (Tint Z0) b2 =>
-          match eq_term b1 (scalar_norm t (Tmult b2 (Tint (-1)))) with
+          match eq_term b1 (scalar_norm t (b2 * Tint (-1))%term) with
           | true => EqTerm (Tint 0) b1
           | false => TrueTerm
           end
@@ -1965,7 +1930,7 @@ Qed.
 
 (* \paragraph{[O_CONSTANT_NUL]} *)
 
-Definition constant_nul (i : nat) (h : list proposition) :=
+Definition constant_nul (i : nat) (h : hyps) :=
   match nth_hyps i h with
   | NeqTerm (Tint Z0) (Tint Z0) => absurd
   | _ => h
@@ -1975,8 +1940,7 @@ Theorem constant_nul_valid : forall i : nat, valid_hyps (constant_nul i).
 
 unfold valid_hyps, constant_nul in |- *; intros;
  generalize (nth_valid ep e i lp); Simplify; simpl in |- *;
- unfold Zne in |- *; intro H1; absurd (0%Z = 0%Z); 
- auto.
+ unfold Zne in |- *; intro H1; absurd (0 = 0); auto.
 Qed.
 
 (* \paragraph{[O_STATE]} *)
@@ -1985,9 +1949,8 @@ Definition state (m : Z) (s : step) (prop1 prop2 : proposition) :=
   match prop1 with
   | EqTerm (Tint Z0) b1 =>
       match prop2 with
-      | EqTerm (Tint Z0) (Tplus b2 (Topp b3)) =>
-          EqTerm (Tint 0)
-            (rewrite s (Tplus b1 (Tmult (Tplus (Topp b3) b2) (Tint m))))
+      | EqTerm (Tint Z0) (b2 + - b3)%term =>
+          EqTerm (Tint 0) (rewrite s (b1 + (- b3 + b2) * Tint m)%term)
       | _ => TrueTerm
       end
   | _ => TrueTerm
@@ -2007,21 +1970,19 @@ Qed.
    \paragraph{[O_SPLIT_INEQ]} 
    La seule pour le moment (tant que la normalisation n'est pas réfléchie). *)
 
-Definition split_ineq (i t : nat)
-  (f1 f2 : list proposition -> list (list proposition))
-  (l : list proposition) :=
+Definition split_ineq (i t : nat) (f1 f2 : hyps -> lhyps) 
+  (l : hyps) :=
   match nth_hyps i l with
   | NeqTerm (Tint Z0) b1 =>
-      f1 (LeqTerm (Tint 0) (add_norm t (Tplus b1 (Tint (-1)))) :: l) ++
+      f1 (LeqTerm (Tint 0) (add_norm t (b1 + Tint (-1))%term) :: l) ++
       f2
         (LeqTerm (Tint 0)
-           (scalar_norm_add t (Tplus (Tmult b1 (Tint (-1))) (Tint (-1))))
-         :: l)
+           (scalar_norm_add t (b1 * Tint (-1) + Tint (-1))%term) :: l)
   | _ => l :: nil
   end.
 
 Theorem split_ineq_valid :
- forall (i t : nat) (f1 f2 : list proposition -> list (list proposition)),
+ forall (i t : nat) (f1 f2 : hyps -> lhyps),
  valid_list_hyps f1 ->
  valid_list_hyps f2 -> valid_list_hyps (split_ineq i t f1 f2).
 
@@ -2041,34 +2002,27 @@ Qed.
 
 (* \subsection{La fonction de rejeu de la trace} *)
 
-Fixpoint execute_omega (t : t_omega) (l : list proposition) {struct t} :
- list (list proposition) :=
+Fixpoint execute_omega (t : t_omega) (l : hyps) {struct t} : lhyps :=
   match t with
-  | O_CONSTANT_NOT_NUL n =>
-      (fun a : list proposition => a :: nil) (constant_not_nul n l)
-  | O_CONSTANT_NEG n =>
-      (fun a : list proposition => a :: nil) (constant_neg n l)
+  | O_CONSTANT_NOT_NUL n => singleton (constant_not_nul n l)
+  | O_CONSTANT_NEG n => singleton (constant_neg n l)
   | O_DIV_APPROX k1 k2 body t cont n =>
       execute_omega cont (apply_oper_1 n (divide_and_approx k1 k2 body t) l)
   | O_NOT_EXACT_DIVIDE k1 k2 body t i =>
-      (fun a : list proposition => a :: nil)
-        (not_exact_divide k1 k2 body t i l)
+      singleton (not_exact_divide k1 k2 body t i l)
   | O_EXACT_DIVIDE k body t cont n =>
       execute_omega cont (apply_oper_1 n (exact_divide k body t) l)
   | O_SUM k1 i1 k2 i2 t cont =>
       execute_omega cont (apply_oper_2 i1 i2 (sum k1 k2 t) l)
-  | O_CONTRADICTION t i j =>
-      (fun a : list proposition => a :: nil) (contradiction t i j l)
+  | O_CONTRADICTION t i j => singleton (contradiction t i j l)
   | O_MERGE_EQ t i1 i2 cont =>
       execute_omega cont (apply_oper_2 i1 i2 (merge_eq t) l)
   | O_SPLIT_INEQ t i cont1 cont2 =>
       split_ineq i t (execute_omega cont1) (execute_omega cont2) l
-  | O_CONSTANT_NUL i =>
-      (fun a : list proposition => a :: nil) (constant_nul i l)
-  | O_NEGATE_CONTRADICT i j =>
-      (fun a : list proposition => a :: nil) (negate_contradict i j l)
+  | O_CONSTANT_NUL i => singleton (constant_nul i l)
+  | O_NEGATE_CONTRADICT i j => singleton (negate_contradict i j l)
   | O_NEGATE_CONTRADICT_INV t i j =>
-      (fun a : list proposition => a :: nil) (negate_contradict_inv t i j l)
+      singleton (negate_contradict_inv t i j l)
   | O_STATE m s i1 i2 cont =>
       execute_omega cont (apply_oper_2 i1 i2 (state m s) l)
   end.
@@ -2126,14 +2080,12 @@ Qed.
 
 Definition move_right (s : step) (p : proposition) :=
   match p with
-  | EqTerm t1 t2 => EqTerm (Tint 0) (rewrite s (Tplus t1 (Topp t2)))
-  | LeqTerm t1 t2 => LeqTerm (Tint 0) (rewrite s (Tplus t2 (Topp t1)))
-  | GeqTerm t1 t2 => LeqTerm (Tint 0) (rewrite s (Tplus t1 (Topp t2)))
-  | LtTerm t1 t2 =>
-      LeqTerm (Tint 0) (rewrite s (Tplus (Tplus t2 (Tint (-1))) (Topp t1)))
-  | GtTerm t1 t2 =>
-      LeqTerm (Tint 0) (rewrite s (Tplus (Tplus t1 (Tint (-1))) (Topp t2)))
-  | NeqTerm t1 t2 => NeqTerm (Tint 0) (rewrite s (Tplus t1 (Topp t2)))
+  | EqTerm t1 t2 => EqTerm (Tint 0) (rewrite s (t1 + - t2)%term)
+  | LeqTerm t1 t2 => LeqTerm (Tint 0) (rewrite s (t2 + - t1)%term)
+  | GeqTerm t1 t2 => LeqTerm (Tint 0) (rewrite s (t1 + - t2)%term)
+  | LtTerm t1 t2 => LeqTerm (Tint 0) (rewrite s (t2 + Tint (-1) + - t1)%term)
+  | GtTerm t1 t2 => LeqTerm (Tint 0) (rewrite s (t1 + Tint (-1) + - t2)%term)
+  | NeqTerm t1 t2 => NeqTerm (Tint 0) (rewrite s (t1 + - t2)%term)
   | p => p
   end.
 
@@ -2165,7 +2117,7 @@ intros; unfold do_normalize in |- *; apply apply_oper_1_valid;
 Qed.
 
 Fixpoint do_normalize_list (l : list step) (i : nat) 
- (h : list proposition) {struct l} : list proposition :=
+ (h : hyps) {struct l} : hyps :=
   match l with
   | s :: l' => do_normalize_list l' (S i) (do_normalize i s h)
   | nil => h
@@ -2181,11 +2133,8 @@ simple induction l; simpl in |- *; unfold valid_hyps in |- *;
 Qed.
 
 Theorem normalize_goal :
- forall (s : list step) (ep : PropList) (env : list Z) (l : list proposition),
- (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-  interp_goal_concl envp env FalseTerm l) ep env (do_normalize_list s 0 l) ->
- (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-  interp_goal_concl envp env FalseTerm l) ep env l.
+ forall (s : list step) (ep : PropList) (env : list Z) (l : hyps),
+ interp_goal ep env (do_normalize_list s 0 l) -> interp_goal ep env l.
 
 intros; apply valid_goal with (2 := H); apply do_normalize_list_valid.
 Qed.
@@ -2193,17 +2142,15 @@ Qed.
 (* \subsubsection{Exécution de la trace} *)
 
 Theorem execute_goal :
- forall (t : t_omega) (ep : PropList) (env : list Z) (l : list proposition),
- interp_list_goal ep env (execute_omega t l) ->
- (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-  interp_goal_concl envp env FalseTerm l) ep env l.
+ forall (t : t_omega) (ep : PropList) (env : list Z) (l : hyps),
+ interp_list_goal ep env (execute_omega t l) -> interp_goal ep env l.
 
 intros; apply (goal_valid (execute_omega t) (omega_valid t) ep env l H).
 Qed.
 
 
 Theorem append_goal :
- forall (ep : PropList) (e : list Z) (l1 l2 : list (list proposition)),
+ forall (ep : PropList) (e : list Z) (l1 l2 : lhyps),
  interp_list_goal ep e l1 /\ interp_list_goal ep e l2 ->
  interp_list_goal ep e (l1 ++ l2).
 
@@ -2262,15 +2209,15 @@ Qed.
    conclusion. We use an intermediate fixpoint. *)
 
 Fixpoint interp_full_goal (envp : PropList) (env : list Z) 
- (c : proposition) (l : list proposition) {struct l} : Prop :=
+ (c : proposition) (l : hyps) {struct l} : Prop :=
   match l with
   | nil => interp_proposition envp env c
   | p' :: l' =>
       interp_proposition envp env p' -> interp_full_goal envp env c l'
   end.
 
-Definition interp_full (ep : PropList) (e : list Z)
-  (lc : list proposition * proposition) : Prop :=
+Definition interp_full (ep : PropList) (e : list Z) 
+  (lc : hyps * proposition) : Prop :=
   match lc with
   | (l, c) => interp_full_goal ep e c l
   end.
@@ -2279,7 +2226,7 @@ Definition interp_full (ep : PropList) (e : list Z)
    of its hypothesis and conclusion *)
 
 Theorem interp_full_false :
- forall (ep : PropList) (e : list Z) (l : list proposition) (c : proposition),
+ forall (ep : PropList) (e : list Z) (l : hyps) (c : proposition),
  (interp_hyps ep e l -> interp_proposition ep e c) -> interp_full ep e (l, c).
 
 simple induction l; unfold interp_full in |- *; simpl in |- *;
@@ -2291,7 +2238,7 @@ Qed.
    If the decidability cannot be "proven", then just forget about the 
    conclusion (equivalent of replacing it with false) *)
 
-Definition to_contradict (lc : list proposition * proposition) :=
+Definition to_contradict (lc : hyps * proposition) :=
   match lc with
   | (l, c) => if decidability c then Tnot c :: l else l
   end.
@@ -2300,10 +2247,8 @@ Definition to_contradict (lc : list proposition * proposition) :=
    hypothesis implies the original goal *)
 
 Theorem to_contradict_valid :
- forall (ep : PropList) (e : list Z) (lc : list proposition * proposition),
- (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-  interp_goal_concl envp env FalseTerm l) ep e (to_contradict lc) ->
- interp_full ep e lc.
+ forall (ep : PropList) (e : list Z) (lc : hyps * proposition),
+ interp_goal ep e (to_contradict lc) -> interp_full ep e lc.
 
 intros ep e lc; case lc; intros l c; simpl in |- *;
  pattern (decidability c) in |- *; apply bool_ind2;
@@ -2336,8 +2281,7 @@ Fixpoint map_cons (A : Set) (x : A) (l : list (list A)) {struct l} :
           hypothesis will get desynchronised and this will be a mess.
  *)
  
-Fixpoint destructure_hyps (nn : nat) (ll : list proposition) {struct nn} :
- list (list proposition) :=
+Fixpoint destructure_hyps (nn : nat) (ll : hyps) {struct nn} : lhyps :=
   match nn with
   | O => ll :: nil
   | S n =>
@@ -2371,8 +2315,7 @@ Fixpoint destructure_hyps (nn : nat) (ll : list proposition) {struct nn} :
   end.
 
 Theorem map_cons_val :
- forall (ep : PropList) (e : list Z) (p : proposition)
-   (l : list (list proposition)),
+ forall (ep : PropList) (e : list Z) (p : proposition) (l : lhyps),
  interp_proposition ep e p ->
  interp_list_hyps ep e l -> interp_list_hyps ep e (map_cons _ p l).
 
@@ -2514,7 +2457,7 @@ unfold prop_stable in |- *; intros f H ep e p; split;
       unfold decidable, Zne in |- *; tauto ]).
 Qed.
 
-Theorem Zlt_left_inv : forall x y : Z, (0 <= y + -1 + - x)%Z -> (x < y)%Z.
+Theorem Zlt_left_inv : forall x y : Z, 0 <= y + -1 + - x -> x < y.
 
 intros; apply Zsucc_lt_reg; apply Zle_lt_succ;
  apply (fun a b : Z => Zplus_le_reg_r a b (-1 + - x)); 
@@ -2570,8 +2513,7 @@ simple induction s; simpl in |- *;
  | unfold prop_stable in |- *; simpl in |- *; intros; split; auto ].
 Qed.
 
-Fixpoint normalize_hyps (l : list h_step) (lh : list proposition) {struct l}
- : list proposition :=
+Fixpoint normalize_hyps (l : list h_step) (lh : hyps) {struct l} : hyps :=
   match l with
   | nil => lh
   | pair_step i s :: r => normalize_hyps r (apply_oper_1 i (p_rewrite s) lh)
@@ -2590,12 +2532,8 @@ simple induction l; unfold valid_hyps in |- *; simpl in |- *;
 Qed.
 
 Theorem normalize_hyps_goal :
- forall (s : list h_step) (ep : PropList) (env : list Z)
-   (l : list proposition),
- (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-  interp_goal_concl envp env FalseTerm l) ep env (normalize_hyps s l) ->
- (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-  interp_goal_concl envp env FalseTerm l) ep env l.
+ forall (s : list h_step) (ep : PropList) (env : list Z) (l : hyps),
+ interp_goal ep env (normalize_hyps s l) -> interp_goal ep env l.
 
 intros; apply valid_goal with (2 := H); apply normalize_hyps_valid.
 Qed.
@@ -2675,8 +2613,7 @@ unfold valid1, co_valid1 in |- *; simple induction s;
 
 Qed.
 
-Fixpoint decompose_solve (s : e_step) (h : list proposition) {struct s} :
- list (list proposition) :=
+Fixpoint decompose_solve (s : e_step) (h : hyps) {struct s} : lhyps :=
   match s with
   | E_SPLIT i dl s1 s2 =>
       match extract_hyp_pos dl (nth_hyps i h) with
@@ -2687,6 +2624,10 @@ Fixpoint decompose_solve (s : e_step) (h : list proposition) {struct s} :
            decompose_solve s1 (Tnot x :: h) ++
            decompose_solve s2 (Tnot y :: h)
           else h :: nil
+      | Timp x y => 
+          if decidability x then 
+            decompose_solve s1 (Tnot x :: h) ++ decompose_solve s2 (y :: h)
+          else h::nil
       | _ => h :: nil
       end
   | E_EXTRACT i dl s1 =>
@@ -2710,28 +2651,32 @@ intro s; apply goal_valid; unfold valid_list_hyps in |- *; elim s;
           | simpl in |- *; auto ]
        | intros p1 p2 H2; apply append_valid; simpl in |- *; elim H2;
           [ intros H3; left; apply H; simpl in |- *; auto
-          | intros H3; right; apply H0; simpl in |- *; auto ] ]
+          | intros H3; right; apply H0; simpl in |- *; auto ] 
+       | intros p1 p2 H2;
+         pattern (decidability p1) in |- *; apply bool_ind2;
+          [ intro H3; generalize (decidable_correct ep e1 p1 H3); intro H4;
+             apply append_valid; elim H4; intro H5; 
+             [ right; apply H0; simpl in |- *; tauto
+             | left; apply H; simpl in |- *; tauto ]
+          | simpl in |- *; auto ] ]
     | elim (extract_valid l); intros H2 H3; apply H2; apply nth_valid; auto ]
  | intros; apply H; simpl in |- *; split;
     [ elim (extract_valid l); intros H2 H3; apply H2; apply nth_valid; auto
     | auto ]
  | apply omega_valid with (1 := H) ].
-
 Qed.
 
 (* \subsection{La dernière étape qui élimine tous les séquents inutiles} *)
 
-Definition valid_lhyps
-  (f : list (list proposition) -> list (list proposition)) :=
-  forall (ep : PropList) (e : list Z) (lp : list (list proposition)),
+Definition valid_lhyps (f : lhyps -> lhyps) :=
+  forall (ep : PropList) (e : list Z) (lp : lhyps),
   interp_list_hyps ep e lp -> interp_list_hyps ep e (f lp).
 
-Fixpoint reduce_lhyps (lp : list (list proposition)) :
- list (list proposition) :=
+Fixpoint reduce_lhyps (lp : lhyps) : lhyps :=
   match lp with
   | (FalseTerm :: nil) :: lp' => reduce_lhyps lp'
   | x :: lp' => x :: reduce_lhyps lp'
-  | nil => nil (A:=list proposition)
+  | nil => nil (A:=hyps)
   end.
 
 Theorem reduce_lhyps_valid : valid_lhyps reduce_lhyps.
@@ -2744,7 +2689,7 @@ unfold valid_lhyps in |- *; intros ep e lp; elim lp;
 Qed.
 
 Theorem do_reduce_lhyps :
- forall (envp : PropList) (env : list Z) (l : list (list proposition)),
+ forall (envp : PropList) (env : list Z) (l : lhyps),
  interp_list_goal envp env (reduce_lhyps l) -> interp_list_goal envp env l.
 
 intros envp env l H; apply list_goal_to_hyps; intro H1;
@@ -2756,13 +2701,11 @@ Definition concl_to_hyp (p : proposition) :=
   if decidability p then Tnot p else TrueTerm.
 
 Definition do_concl_to_hyp :
-  forall (envp : PropList) (env : list Z) (c : proposition)
-    (l : list proposition),
-  (fun (envp : PropList) (env : list Z) (l : list proposition) =>
-   interp_goal_concl envp env FalseTerm l) envp env (
-    concl_to_hyp c :: l) -> interp_goal_concl envp env c l.
+  forall (envp : PropList) (env : list Z) (c : proposition) (l : hyps),
+  interp_goal envp env (concl_to_hyp c :: l) ->
+  interp_goal_concl c envp env l.
 
-simpl in |- *; intros envp env c l; induction  l as [| a l Hrecl];
+simpl in |- *; intros envp env c l; induction l as [| a l Hrecl];
  [ simpl in |- *; unfold concl_to_hyp in |- *;
     pattern (decidability c) in |- *; apply bool_ind2;
     [ intro H; generalize (decidable_correct envp env c H);
@@ -2772,16 +2715,16 @@ simpl in |- *; intros envp env c l; induction  l as [| a l Hrecl];
 Qed.
 
 Definition omega_tactic (t1 : e_step) (t2 : list h_step) 
-  (c : proposition) (l : list proposition) :=
+  (c : proposition) (l : hyps) :=
   reduce_lhyps (decompose_solve t1 (normalize_hyps t2 (concl_to_hyp c :: l))).
 
 Theorem do_omega :
  forall (t1 : e_step) (t2 : list h_step) (envp : PropList) 
-   (env : list Z) (c : proposition) (l : list proposition),
+   (env : list Z) (c : proposition) (l : hyps),
  interp_list_goal envp env (omega_tactic t1 t2 c l) ->
- interp_goal_concl envp env c l.
+ interp_goal_concl c envp env l.
 
 unfold omega_tactic in |- *; intros; apply do_concl_to_hyp;
  apply (normalize_hyps_goal t2); apply (decompose_solve_valid t1);
  apply do_reduce_lhyps; assumption.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/contrib/romega/const_omega.ml b/contrib/romega/const_omega.ml
index 3b2a7d31..69b4b2de 100644
--- a/contrib/romega/const_omega.ml
+++ b/contrib/romega/const_omega.ml
@@ -17,7 +17,6 @@ type result =
 
 let destructurate t =
   let c, args = Term.decompose_app t in
-  let env = Global.env() in
   match Term.kind_of_term c, args with
     | Term.Const sp, args ->
 	Kapp (Names.string_of_id
@@ -43,7 +42,7 @@ let dest_const_apply t =
   let f,args = Term.decompose_app t in 
   let ref = 
   match Term.kind_of_term f with 
-    | Term.Const sp         -> Libnames.ConstRef sp
+    | Term.Const sp      -> Libnames.ConstRef sp
     | Term.Construct csp -> Libnames.ConstructRef csp
     | Term.Ind isp       -> Libnames.IndRef isp
     | _ -> raise Destruct
@@ -53,14 +52,16 @@ let recognize_number t =
   let rec loop t =
     let f,l = dest_const_apply t in
     match Names.string_of_id f,l with
-       "xI",[t] -> 1 + 2 * loop t
-     | "xO",[t] -> 2 * loop t 
-     | "xH",[] -> 1
+       "xI",[t] -> Bigint.add Bigint.one (Bigint.mult Bigint.two (loop t))
+     | "xO",[t] -> Bigint.mult Bigint.two (loop t)
+     | "xH",[] -> Bigint.one
      | _ -> failwith "not a number" in
   let f,l = dest_const_apply t in
     match Names.string_of_id f,l with
-       "Zpos",[t] -> loop t | "Zneg",[t] -> - (loop t) | "Z0",[] -> 0
-     | _ -> failwith "not a number";;
+        "Zpos",[t] -> loop t
+      | "Zneg",[t] -> Bigint.neg (loop t)
+      | "Z0",[] -> Bigint.zero
+      | _ -> failwith "not a number";;
 
 
 let logic_dir = ["Coq";"Logic";"Decidable"]
@@ -68,7 +69,7 @@ let logic_dir = ["Coq";"Logic";"Decidable"]
 let coq_modules =
   Coqlib.init_modules @ [logic_dir] @ Coqlib.arith_modules @ Coqlib.zarith_base_modules
     @ [["Coq"; "omega"; "OmegaLemmas"]]
-    @ [["Coq"; "Lists"; (if !Options.v7 then "PolyList" else "List")]]
+    @ [["Coq"; "Lists"; "List"]]
     @ [module_refl_path]
 
 
@@ -77,23 +78,23 @@ let constant = Coqlib.gen_constant_in_modules "Omega" coq_modules
 let coq_xH = lazy (constant "xH")
 let coq_xO = lazy (constant "xO")
 let coq_xI = lazy (constant "xI")
-let coq_ZERO = lazy (constant "Z0")
-let coq_POS = lazy (constant "Zpos")
-let coq_NEG = lazy (constant "Zneg")
+let coq_Z0 = lazy (constant "Z0")
+let coq_Zpos = lazy (constant "Zpos")
+let coq_Zneg = lazy (constant "Zneg")
 let coq_Z = lazy (constant "Z")
-let coq_relation = lazy (constant  "comparison")
-let coq_SUPERIEUR = lazy (constant "SUPERIEUR")
-let coq_INFEEIEUR = lazy (constant "INFERIEUR")
-let coq_EGAL = lazy (constant "EGAL")
+let coq_comparison = lazy (constant  "comparison")
+let coq_Gt = lazy (constant "Gt")
+let coq_Lt = lazy (constant "Lt")
+let coq_Eq = lazy (constant "Eq")
 let coq_Zplus = lazy (constant "Zplus")
 let coq_Zmult = lazy (constant  "Zmult")
 let coq_Zopp = lazy (constant "Zopp")
 
 let coq_Zminus = lazy (constant "Zminus")
-let coq_Zs = lazy (constant  "Zs")
+let coq_Zsucc = lazy (constant  "Zsucc")
 let coq_Zgt = lazy (constant "Zgt")
 let coq_Zle = lazy (constant "Zle")
-let coq_inject_nat = lazy (constant  "inject_nat")
+let coq_Z_of_nat = lazy (constant  "Z_of_nat")
 
 (* Peano *)
 let coq_le = lazy(constant "le")
@@ -111,8 +112,8 @@ let coq_refl_equal = lazy(constant  "refl_equal")
 let coq_and = lazy(constant "and")
 let coq_not = lazy(constant "not")
 let coq_or = lazy(constant "or")
-let coq_true = lazy(constant "true")
-let coq_false = lazy(constant "false")
+let coq_True = lazy(constant "True")
+let coq_False = lazy(constant "False")
 let coq_ex = lazy(constant "ex")
 let coq_I = lazy(constant "I")
 
@@ -159,8 +160,7 @@ let coq_normalize_sequent = lazy (constant  "normalize_goal")
 let coq_execute_sequent = lazy (constant  "execute_goal")
 let coq_do_concl_to_hyp =  lazy (constant  "do_concl_to_hyp")
 let coq_sequent_to_hyps = lazy (constant  "goal_to_hyps")
-let coq_normalize_hyps_goal =
-  lazy (constant  "normalize_hyps_goal")
+let coq_normalize_hyps_goal = lazy (constant  "normalize_hyps_goal")
 
 (* Constructors for shuffle tactic *)
 let coq_t_fusion =  lazy (constant  "t_fusion")
@@ -187,7 +187,7 @@ let coq_c_mult_assoc_r = lazy (constant  "C_MULT_ASSOC_R")
 let coq_c_plus_assoc_r = lazy (constant  "C_PLUS_ASSOC_R")
 let coq_c_plus_assoc_l = lazy (constant  "C_PLUS_ASSOC_L")
 let coq_c_plus_permute = lazy (constant  "C_PLUS_PERMUTE")
-let coq_c_plus_sym = lazy (constant  "C_PLUS_SYM")
+let coq_c_plus_comm = lazy (constant  "C_PLUS_COMM")
 let coq_c_red0 = lazy (constant  "C_RED0")
 let coq_c_red1 = lazy (constant  "C_RED1")
 let coq_c_red2 = lazy (constant  "C_RED2")
@@ -199,7 +199,7 @@ let coq_c_mult_opp_left = lazy (constant  "C_MULT_OPP_LEFT")
 let coq_c_mult_assoc_reduced = 
   lazy (constant  "C_MULT_ASSOC_REDUCED")
 let coq_c_minus = lazy (constant  "C_MINUS")
-let coq_c_mult_sym = lazy (constant  "C_MULT_SYM")
+let coq_c_mult_comm = lazy (constant  "C_MULT_COMM")
 
 let coq_s_constant_not_nul = lazy (constant  "O_CONSTANT_NOT_NUL")
 let coq_s_constant_neg = lazy (constant  "O_CONSTANT_NEG")
@@ -230,184 +230,6 @@ let coq_decompose_solve_valid =
 let coq_do_reduce_lhyps = lazy (constant   "do_reduce_lhyps")
 let coq_do_omega = lazy (constant  "do_omega")
 
-(**
-let constant dir s =
-   try
-     Libnames.constr_of_reference 
-       (Nametab.absolute_reference
-	  (Libnames.make_path
-             (Names.make_dirpath (List.map Names.id_of_string (List.rev dir)))
-             (Names.id_of_string s)))
-   with e -> print_endline (String.concat "." dir); print_endline s;
-             raise e
-
-let path_fast_integer = ["Coq"; "ZArith"; "fast_integer"]
-let path_zarith_aux = ["Coq"; "ZArith"; "zarith_aux"]
-let path_logic = ["Coq"; "Init";"Logic"]
-let path_datatypes = ["Coq"; "Init";"Datatypes"]
-let path_peano = ["Coq"; "Init"; "Peano"]
-let path_list = ["Coq"; "Lists"; "PolyList"]
-
-let coq_xH = lazy (constant path_fast_integer "xH")
-let coq_xO = lazy (constant path_fast_integer "xO")
-let coq_xI = lazy (constant path_fast_integer "xI")
-let coq_ZERO = lazy (constant path_fast_integer "ZERO")
-let coq_POS = lazy (constant path_fast_integer "POS")
-let coq_NEG = lazy (constant path_fast_integer "NEG")
-let coq_Z = lazy (constant path_fast_integer "Z")
-let coq_relation = lazy (constant path_fast_integer "relation")
-let coq_SUPERIEUR = lazy (constant path_fast_integer "SUPERIEUR")
-let coq_INFEEIEUR = lazy (constant path_fast_integer "INFERIEUR")
-let coq_EGAL = lazy (constant path_fast_integer "EGAL")
-let coq_Zplus = lazy (constant path_fast_integer "Zplus")
-let coq_Zmult = lazy (constant path_fast_integer "Zmult")
-let coq_Zopp = lazy (constant path_fast_integer "Zopp")
-
-(* auxiliaires zarith *)
-let coq_Zminus = lazy (constant path_zarith_aux "Zminus")
-let coq_Zs = lazy (constant path_zarith_aux "Zs")
-let coq_Zgt = lazy (constant path_zarith_aux "Zgt")
-let coq_Zle = lazy (constant path_zarith_aux "Zle")
-let coq_inject_nat = lazy (constant path_zarith_aux "inject_nat")
-
-(* Peano *)
-let coq_le = lazy(constant path_peano "le")
-let coq_gt = lazy(constant path_peano "gt")
-
-(* Integers *)
-let coq_nat = lazy(constant path_datatypes "nat")
-let coq_S = lazy(constant path_datatypes "S")
-let coq_O = lazy(constant path_datatypes "O")
-
-(* Minus *)
-let coq_minus = lazy(constant ["Arith"; "Minus"] "minus")
-
-(* Logic *)
-let coq_eq = lazy(constant path_logic "eq")
-let coq_refl_equal = lazy(constant path_logic "refl_equal")
-let coq_and = lazy(constant path_logic "and")
-let coq_not = lazy(constant path_logic "not")
-let coq_or = lazy(constant path_logic "or")
-let coq_true = lazy(constant path_logic "true")
-let coq_false = lazy(constant path_logic "false")
-let coq_ex = lazy(constant path_logic "ex")
-let coq_I = lazy(constant path_logic "I")
-
-(* Lists *)
-let coq_cons =  lazy (constant path_list  "cons")
-let coq_nil =  lazy (constant path_list "nil")
-
-let coq_pcons = lazy (constant module_refl_path "Pcons")
-let coq_pnil = lazy (constant module_refl_path "Pnil")
-
-let coq_h_step = lazy (constant module_refl_path "h_step")
-let coq_pair_step = lazy (constant module_refl_path "pair_step")
-let coq_p_left = lazy (constant module_refl_path "P_LEFT")
-let coq_p_right = lazy (constant module_refl_path "P_RIGHT")
-let coq_p_invert = lazy (constant module_refl_path "P_INVERT")
-let coq_p_step = lazy (constant module_refl_path "P_STEP")
-let coq_p_nop = lazy (constant module_refl_path "P_NOP")
-
-
-let coq_t_int = lazy (constant module_refl_path "Tint")
-let coq_t_plus = lazy (constant module_refl_path "Tplus")
-let coq_t_mult = lazy (constant module_refl_path "Tmult")
-let coq_t_opp = lazy (constant module_refl_path "Topp")
-let coq_t_minus = lazy (constant module_refl_path "Tminus")
-let coq_t_var = lazy (constant module_refl_path "Tvar")
-
-let coq_p_eq = lazy (constant module_refl_path "EqTerm")
-let coq_p_leq = lazy (constant module_refl_path "LeqTerm")
-let coq_p_geq = lazy (constant module_refl_path "GeqTerm")
-let coq_p_lt = lazy (constant module_refl_path "LtTerm")
-let coq_p_gt = lazy (constant module_refl_path "GtTerm")
-let coq_p_neq = lazy (constant module_refl_path "NeqTerm")
-let coq_p_true = lazy (constant module_refl_path "TrueTerm")
-let coq_p_false = lazy (constant module_refl_path "FalseTerm")
-let coq_p_not = lazy (constant module_refl_path "Tnot")
-let coq_p_or = lazy (constant module_refl_path "Tor")
-let coq_p_and = lazy (constant module_refl_path "Tand")
-let coq_p_imp = lazy (constant module_refl_path "Timp")
-let coq_p_prop = lazy (constant module_refl_path "Tprop")
-
-let coq_proposition = lazy (constant module_refl_path "proposition")
-let coq_interp_sequent = lazy (constant module_refl_path "interp_goal_concl")
-let coq_normalize_sequent = lazy (constant module_refl_path "normalize_goal")
-let coq_execute_sequent = lazy (constant module_refl_path "execute_goal")
-let coq_do_concl_to_hyp =  lazy (constant module_refl_path "do_concl_to_hyp")
-let coq_sequent_to_hyps = lazy (constant module_refl_path "goal_to_hyps")
-let coq_normalize_hyps_goal =
-  lazy (constant module_refl_path "normalize_hyps_goal")
-
-(* Constructors for shuffle tactic *)
-let coq_t_fusion =  lazy (constant module_refl_path "t_fusion")
-let coq_f_equal =  lazy (constant module_refl_path "F_equal")
-let coq_f_cancel =  lazy (constant module_refl_path "F_cancel")
-let coq_f_left =  lazy (constant module_refl_path "F_left")
-let coq_f_right =  lazy (constant module_refl_path "F_right")
-
-(* Constructors for reordering tactics *)
-let coq_step = lazy (constant module_refl_path "step")
-let coq_c_do_both = lazy (constant module_refl_path "C_DO_BOTH")
-let coq_c_do_left = lazy (constant module_refl_path "C_LEFT")
-let coq_c_do_right = lazy (constant module_refl_path "C_RIGHT")
-let coq_c_do_seq = lazy (constant module_refl_path "C_SEQ")
-let coq_c_nop = lazy (constant module_refl_path "C_NOP")
-let coq_c_opp_plus = lazy (constant module_refl_path "C_OPP_PLUS")
-let coq_c_opp_opp = lazy (constant module_refl_path "C_OPP_OPP")
-let coq_c_opp_mult_r = lazy (constant module_refl_path "C_OPP_MULT_R")
-let coq_c_opp_one = lazy (constant module_refl_path "C_OPP_ONE")
-let coq_c_reduce = lazy (constant module_refl_path "C_REDUCE")
-let coq_c_mult_plus_distr = lazy (constant module_refl_path "C_MULT_PLUS_DISTR")
-let coq_c_opp_left = lazy (constant module_refl_path "C_MULT_OPP_LEFT")
-let coq_c_mult_assoc_r = lazy (constant module_refl_path "C_MULT_ASSOC_R")
-let coq_c_plus_assoc_r = lazy (constant module_refl_path "C_PLUS_ASSOC_R")
-let coq_c_plus_assoc_l = lazy (constant module_refl_path "C_PLUS_ASSOC_L")
-let coq_c_plus_permute = lazy (constant module_refl_path "C_PLUS_PERMUTE")
-let coq_c_plus_sym = lazy (constant module_refl_path "C_PLUS_SYM")
-let coq_c_red0 = lazy (constant module_refl_path "C_RED0")
-let coq_c_red1 = lazy (constant module_refl_path "C_RED1")
-let coq_c_red2 = lazy (constant module_refl_path "C_RED2")
-let coq_c_red3 = lazy (constant module_refl_path "C_RED3")
-let coq_c_red4 = lazy (constant module_refl_path "C_RED4")
-let coq_c_red5 = lazy (constant module_refl_path "C_RED5")
-let coq_c_red6 = lazy (constant module_refl_path "C_RED6")
-let coq_c_mult_opp_left = lazy (constant module_refl_path "C_MULT_OPP_LEFT")
-let coq_c_mult_assoc_reduced = 
-  lazy (constant module_refl_path "C_MULT_ASSOC_REDUCED")
-let coq_c_minus = lazy (constant module_refl_path "C_MINUS")
-let coq_c_mult_sym = lazy (constant module_refl_path "C_MULT_SYM")
-
-let coq_s_constant_not_nul = lazy (constant module_refl_path "O_CONSTANT_NOT_NUL")
-let coq_s_constant_neg = lazy (constant module_refl_path "O_CONSTANT_NEG")
-let coq_s_div_approx = lazy (constant module_refl_path "O_DIV_APPROX")
-let coq_s_not_exact_divide = lazy (constant module_refl_path "O_NOT_EXACT_DIVIDE")
-let coq_s_exact_divide = lazy (constant module_refl_path "O_EXACT_DIVIDE")
-let coq_s_sum = lazy (constant module_refl_path "O_SUM")
-let coq_s_state = lazy (constant module_refl_path "O_STATE")
-let coq_s_contradiction = lazy (constant module_refl_path "O_CONTRADICTION")
-let coq_s_merge_eq = lazy (constant module_refl_path "O_MERGE_EQ")
-let coq_s_split_ineq =lazy (constant module_refl_path "O_SPLIT_INEQ")
-let coq_s_constant_nul =lazy (constant module_refl_path "O_CONSTANT_NUL")
-let coq_s_negate_contradict =lazy (constant module_refl_path "O_NEGATE_CONTRADICT")
-let coq_s_negate_contradict_inv =lazy (constant module_refl_path "O_NEGATE_CONTRADICT_INV")
-
-(* construction for the [extract_hyp] tactic *)
-let coq_direction = lazy  (constant module_refl_path "direction")
-let coq_d_left = lazy  (constant module_refl_path "D_left")
-let coq_d_right = lazy  (constant module_refl_path "D_right")
-let coq_d_mono = lazy  (constant module_refl_path "D_mono")
-
-let coq_e_split = lazy  (constant module_refl_path "E_SPLIT")
-let coq_e_extract = lazy  (constant module_refl_path "E_EXTRACT")
-let coq_e_solve = lazy  (constant module_refl_path "E_SOLVE")
-
-let coq_decompose_solve_valid = 
-  lazy (constant  module_refl_path "decompose_solve_valid")
-let coq_do_reduce_lhyps = lazy (constant  module_refl_path "do_reduce_lhyps")
-let coq_do_omega = lazy (constant module_refl_path "do_omega")
-
-*)
 (* \subsection{Construction d'expressions} *)
 
 
@@ -423,8 +245,8 @@ let mk_and t1 t2 =  Term.mkApp (Lazy.force coq_and, [|t1; t2 |])
 let mk_or t1 t2 =  Term.mkApp (Lazy.force coq_or, [|t1; t2 |])
 let mk_not t = Term.mkApp (Lazy.force coq_not, [|t |])
 let mk_eq_rel t1 t2 = Term.mkApp (Lazy.force coq_eq, [|
-				Lazy.force coq_relation; t1; t2 |])
-let mk_inj t = Term.mkApp (Lazy.force coq_inject_nat, [|t |])
+				Lazy.force coq_comparison; t1; t2 |])
+let mk_inj t = Term.mkApp (Lazy.force coq_Z_of_nat, [|t |])
 
 
 let do_left t = 
@@ -450,16 +272,20 @@ let rec do_list = function
   | [x] -> x
   | (x::l) -> do_seq x (do_list l)
 
-				 
 let mk_integer n =
   let rec loop n = 
-    if n=1 then Lazy.force coq_xH else 
-      Term.mkApp ((if n mod 2 = 0 then Lazy.force coq_xO else Lazy.force coq_xI),
-		 [| loop (n/2) |]) in
+    if n=Bigint.one then Lazy.force coq_xH else
+      let (q,r) = Bigint.euclid n Bigint.two in
+      Term.mkApp
+        ((if r = Bigint.zero then Lazy.force coq_xO else Lazy.force coq_xI),
+	[| loop q |]) in
     
-    if n = 0 then Lazy.force coq_ZERO 
-    else Term.mkApp ((if n > 0 then Lazy.force coq_POS else Lazy.force coq_NEG),
-		     [| loop (abs n) |])
+    if n = Bigint.zero then Lazy.force coq_Z0 
+    else
+      if Bigint.is_strictly_pos n then
+        Term.mkApp (Lazy.force coq_Zpos, [| loop n |])
+      else
+        Term.mkApp (Lazy.force coq_Zneg, [| loop (Bigint.neg n) |])
 
 let mk_Z = mk_integer
 
diff --git a/contrib/romega/g_romega.ml4 b/contrib/romega/g_romega.ml4
index 386f7f28..7cfc50f8 100644
--- a/contrib/romega/g_romega.ml4
+++ b/contrib/romega/g_romega.ml4
@@ -10,6 +10,6 @@
 
 open Refl_omega
 
-TACTIC EXTEND ROmega
-  [ "ROmega" ] -> [ total_reflexive_omega_tactic ]
+TACTIC EXTEND romelga
+  [ "romega" ] -> [ total_reflexive_omega_tactic ]
 END
diff --git a/contrib/romega/omega2.ml b/contrib/romega/omega2.ml
deleted file mode 100644
index 91aefc60..00000000
--- a/contrib/romega/omega2.ml
+++ /dev/null
@@ -1,675 +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        *)
-(************************************************************************)
-(**************************************************************************)
-(*                                                                        *)
-(* Omega: a solver of quantifier-free problems in Presburger Arithmetic   *)
-(*                                                                        *)
-(* Pierre Crégut (CNET, Lannion, France)                                  *)
-(*                                                                        *)
-(* 13/10/2002 : modified to cope with an external numbering of equations  *)
-(*   and hypothesis. Its use for Omega is not more complex and it makes   *)
-(*   things much simpler for the reflexive version where we should limit  *)
-(*   the number of source of numbering.                                   *)
-(**************************************************************************)
-
-open Names
-
-let flat_map f =
- let rec flat_map_f = function
-   | [] -> [] 
-   | x :: l -> f x @ flat_map_f l
- in 
- flat_map_f
-
-let pp i = print_int i; print_newline (); flush stdout
-
-let debug = ref false
-
-let filter = List.partition
-
-let push v l = l := v :: !l
-
-let rec pgcd x y = if y = 0 then x else pgcd y (x mod y)
-
-let pgcd_l = function
-  | [] -> failwith "pgcd_l"
-  | x :: l -> List.fold_left pgcd x l
-
-let floor_div a b =
-  match a >=0 , b > 0 with
-    | true,true -> a / b
-    | false,false -> a / b
-    | true, false -> (a-1) / b - 1
-    | false,true  -> (a+1) / b - 1
-
-type coeff = {c: int ; v: int}
-
-type linear = coeff list
-
-type eqn_kind = EQUA | INEQ | DISE
-
-type afine = { 
-  (* a number uniquely identifying the equation *)
-  id: int ; 
-  (* a boolean true for an eq, false for an ineq (Sigma a_i x_i >= 0) *)
-  kind: eqn_kind; 
-  (* the variables and their coefficient *)
-  body: coeff list; 
-  (* a constant *)
-  constant: int }
-
-type state_action = {
-  st_new_eq : afine;
-  st_def    :  afine;
-  st_orig   : afine;
-  st_coef   : int;
-  st_var    : int }
-
-type action =
-  | DIVIDE_AND_APPROX of afine * afine * int * int
-  | NOT_EXACT_DIVIDE of afine * int
-  | FORGET_C of int
-  | EXACT_DIVIDE of afine * int
-  | SUM of int * (int * afine) * (int * afine)
-  | STATE of state_action 
-  | HYP of afine
-  | FORGET   of int * int
-  | FORGET_I of int * int
-  | CONTRADICTION of afine * afine
-  | NEGATE_CONTRADICT of afine * afine * bool
-  | MERGE_EQ of int * afine * int 
-  | CONSTANT_NOT_NUL of int * int
-  | CONSTANT_NUL of int
-  | CONSTANT_NEG of int * int
-  | SPLIT_INEQ of afine * (int * action list) * (int * action list)
-  | WEAKEN of int * int
-
-exception UNSOLVABLE
-
-exception NO_CONTRADICTION
-
-let display_eq print_var (l,e) =
-  let _ = 
-    List.fold_left 
-      (fun not_first f ->
-	 print_string 
-	   (if f.c < 0 then "- " else if not_first then "+ " else "");
-	 let c = abs f.c in
-	 if c = 1 then 
-	   Printf.printf "%s " (print_var f.v)
-	 else 
-	   Printf.printf "%d %s " c (print_var f.v); 
-	 true)
-      false l
-  in
-  if e > 0 then 
-    Printf.printf "+ %d " e 
-  else if e < 0 then 
-    Printf.printf "- %d " (abs e)
-
-let rec trace_length l =
-  let action_length accu = function
-    | SPLIT_INEQ (_,(_,l1),(_,l2)) ->
-	accu + 1 + trace_length l1 + trace_length l2
-    | _ -> accu + 1 in
-  List.fold_left action_length 0 l
-
-let operator_of_eq = function 
-  | EQUA -> "=" | DISE -> "!=" | INEQ -> ">="
-
-let kind_of = function
-  | EQUA -> "equation" | DISE -> "disequation" | INEQ -> "inequation"
-
-let display_system print_var l = 
-  List.iter 
-    (fun { kind=b; body=e; constant=c; id=id} -> 
-       print_int id; print_string ": ";
-       display_eq print_var (e,c); print_string (operator_of_eq b);
-       print_string "0\n") 
-    l;
-  print_string "------------------------\n\n"
-
-let display_inequations print_var l = 
-  List.iter (fun e -> display_eq print_var e;print_string ">= 0\n") l;
-  print_string "------------------------\n\n"
-
-let rec display_action print_var = function
-  | act :: l -> begin match act with
-      | DIVIDE_AND_APPROX (e1,e2,k,d) ->
-          Printf.printf 
-            "Inequation E%d is divided by %d and the constant coefficient is \
-            rounded by substracting %d.\n" e1.id k d
-      | NOT_EXACT_DIVIDE (e,k) ->
-          Printf.printf
-            "Constant in equation E%d is not divisible by the pgcd \
-            %d of its other coefficients.\n" e.id k
-      | EXACT_DIVIDE (e,k) ->
-          Printf.printf
-            "Equation E%d is divided by the pgcd \
-            %d of its coefficients.\n" e.id k
-      | WEAKEN (e,k) ->
-          Printf.printf 
-            "To ensure a solution in the dark shadow \
-            the equation E%d is weakened by %d.\n" e k
-      | SUM (e,(c1,e1),(c2,e2)) -> 
-          Printf.printf
-            "We state %s E%d = %d %s E%d + %d %s E%d.\n" 
-            (kind_of e1.kind) e c1 (kind_of e1.kind) e1.id c2 
-            (kind_of e2.kind) e2.id
-      | STATE { st_new_eq = e; st_coef = x} ->
-          Printf.printf "We define a new equation %d :" e.id; 
-          display_eq print_var (e.body,e.constant); 
-          print_string (operator_of_eq e.kind); print_string " 0\n"
-      | HYP e ->   
-          Printf.printf "We define %d :" e.id; 
-          display_eq print_var (e.body,e.constant); 
-          print_string (operator_of_eq e.kind); print_string " 0\n"
-      | FORGET_C e ->  Printf.printf "E%d is trivially satisfiable.\n" e
-      | FORGET (e1,e2) -> Printf.printf "E%d subsumes E%d.\n" e1 e2
-      | FORGET_I (e1,e2) -> Printf.printf "E%d subsumes E%d.\n" e1 e2
-      | MERGE_EQ (e,e1,e2) ->
-         Printf.printf "E%d and E%d can be merged into E%d.\n" e1.id e2 e
-      | CONTRADICTION (e1,e2) -> 
-          Printf.printf
-            "equations E%d and E%d implie a contradiction on their \
-            constant factors.\n" e1.id e2.id
-      | NEGATE_CONTRADICT(e1,e2,b) ->
-          Printf.printf
-            "Eqations E%d and E%d state that their body is at the same time
-            equal and different\n" e1.id e2.id
-      | CONSTANT_NOT_NUL (e,k) -> 
-          Printf.printf "equation E%d states %d=0.\n" e k
-      | CONSTANT_NEG(e,k) -> 
-          Printf.printf "equation E%d states %d >= 0.\n" e k
-      | CONSTANT_NUL e ->
-          Printf.printf "inequation E%d states 0 != 0.\n" e
-      | SPLIT_INEQ (e,(e1,l1),(e2,l2)) -> 
-          Printf.printf "equation E%d is split in E%d and E%d\n\n" e.id e1 e2;
-          display_action print_var l1;
-          print_newline ();
-          display_action print_var l2;
-          print_newline ()
-    end; display_action print_var l
-  | [] -> 
-      flush stdout
-
-(*""*)
-let default_print_var v = Printf.sprintf "XX%d" v
-
-let add_event, history, clear_history =
-  let accu = ref [] in
-  (fun (v:action) -> if !debug then display_action default_print_var [v]; push v accu),
-  (fun () -> !accu),
-  (fun () -> accu := [])
-
-let nf_linear = Sort.list (fun x y -> x.v > y.v)
-
-let nf ((b : bool),(e,(x : int))) = (b,(nf_linear e,x))
-
-let map_eq_linear f = 
-  let rec loop = function
-    | x :: l -> let c = f x.c in if c=0 then loop l else {v=x.v; c=c} :: loop l
-    | [] -> [] 
-  in
-  loop
-
-let map_eq_afine f e = 
-  { id = e.id; kind = e.kind; body = map_eq_linear f e.body; 
-    constant = f e.constant }
-
-let negate_eq = map_eq_afine (fun x -> -x)
-
-let rec sum p0 p1 = match (p0,p1) with 
-  | ([], l) -> l | (l, []) -> l
-  | (((x1::l1) as l1'), ((x2::l2) as l2')) -> 
-      if x1.v = x2.v then
-	let c = x1.c + x2.c in
-	if c = 0 then sum l1 l2 else {v=x1.v;c=c} :: sum l1 l2
-      else if x1.v > x2.v then 
-	x1 :: sum l1 l2'
-      else 
-	x2 :: sum l1' l2
-
-let sum_afine new_eq_id eq1 eq2 = 
-  { kind = eq1.kind; id = new_eq_id ();
-    body = sum eq1.body eq2.body; constant = eq1.constant + eq2.constant }
-
-exception FACTOR1
-
-let rec chop_factor_1 = function
-  | x :: l -> 
-      if abs x.c = 1 then x,l else let (c',l') = chop_factor_1 l in (c',x::l')
-  | [] -> raise FACTOR1
-
-exception CHOPVAR
-
-let rec chop_var v = function
-  | f :: l -> if f.v = v then f,l else let (f',l') = chop_var v l in (f',f::l')
-  | [] -> raise CHOPVAR
-
-let normalize ({id=id; kind=eq_flag; body=e; constant =x} as eq) =
-  if e = [] then begin 
-    match eq_flag with
-      | EQUA ->
-          if x =0 then [] else begin
-            add_event (CONSTANT_NOT_NUL(id,x)); raise UNSOLVABLE
-         end
-      | DISE ->
-          if x <> 0 then [] else begin
-            add_event (CONSTANT_NUL id); raise UNSOLVABLE
-          end
-      | INEQ ->
-          if x >= 0 then [] else begin
-            add_event (CONSTANT_NEG(id,x)); raise UNSOLVABLE
-          end
-  end else
-    let gcd = pgcd_l (List.map (fun f -> abs f.c) e) in
-    if eq_flag=EQUA & x mod gcd <> 0 then begin
-      add_event (NOT_EXACT_DIVIDE (eq,gcd)); raise UNSOLVABLE
-    end else if eq_flag=DISE & x mod gcd <> 0 then begin
-      add_event (FORGET_C eq.id); []
-    end else if gcd <> 1 then begin
-      let c = floor_div x gcd in
-      let d = x - c * gcd in
-      let new_eq = {id=id; kind=eq_flag; constant=c; 
-                    body=map_eq_linear (fun c -> c / gcd) e} in
-      add_event (if eq_flag=EQUA or eq_flag = DISE then EXACT_DIVIDE(eq,gcd)
-                 else DIVIDE_AND_APPROX(eq,new_eq,gcd,d));
-      [new_eq]
-    end else [eq]
-
-let eliminate_with_in new_eq_id {v=v;c=c_unite} eq2
-                        ({body=e1; constant=c1} as eq1) =
-  try
-    let (f,_) = chop_var v e1 in 
-    let coeff = if c_unite=1 then -f.c else if c_unite= -1 then f.c 
-                else failwith "eliminate_with_in" in
-    let res = sum_afine new_eq_id eq1 (map_eq_afine (fun c -> c * coeff) eq2) in
-    add_event (SUM (res.id,(1,eq1),(coeff,eq2))); res
-  with CHOPVAR -> eq1
-
-let omega_mod a b = a - b * floor_div (2 * a + b) (2 * b)
-let banerjee_step (new_eq_id,new_var_id,print_var) original l1 l2 = 
-  let e = original.body in
-  let sigma = new_var_id () in
-  let smallest,var =
-    try
-      List.fold_left (fun (v,p) c ->  if v > (abs c.c) then abs c.c,c.v else (v,p))
-              (abs (List.hd e).c, (List.hd e).v) (List.tl e)
-    with Failure "tl" -> display_system print_var [original] ; failwith "TL" in
-  let m = smallest + 1 in
-  let new_eq =
-    { constant = omega_mod original.constant m;
-      body = {c= -m;v=sigma} :: 
-             map_eq_linear (fun a -> omega_mod a m) original.body;
-      id = new_eq_id (); kind = EQUA } in
-  let definition =
-    { constant = - floor_div (2 * original.constant + m) (2 * m);
-      body = map_eq_linear (fun a -> - floor_div (2 * a + m) (2 * m))
-                             original.body;
-      id = new_eq_id (); kind = EQUA } in
-  add_event (STATE {st_new_eq = new_eq; st_def = definition;
-		    st_orig =original; st_coef = m; st_var = sigma});
-  let new_eq = List.hd (normalize new_eq) in
-  let eliminated_var, def = chop_var var new_eq.body in
-  let other_equations = 
-    flat_map (fun e -> normalize (eliminate_with_in new_eq_id eliminated_var new_eq e))
-             l1 in
-  let inequations = 
-    flat_map (fun e -> normalize (eliminate_with_in new_eq_id eliminated_var new_eq e))
-             l2 in
-  let original' = eliminate_with_in new_eq_id eliminated_var new_eq original in
-  let mod_original = map_eq_afine (fun c -> c / m) original' in
-  add_event (EXACT_DIVIDE (original',m));
-  List.hd (normalize mod_original),other_equations,inequations
-
-let rec eliminate_one_equation ((new_eq_id,new_var_id,print_var) as new_ids) (e,other,ineqs) = 
-  if !debug then display_system print_var (e::other);
-  try
-    let v,def = chop_factor_1 e.body in
-    (flat_map (fun e' -> normalize (eliminate_with_in new_eq_id v e e')) other,
-     flat_map (fun e' -> normalize (eliminate_with_in new_eq_id v e e')) ineqs)
-  with FACTOR1 -> 
-    eliminate_one_equation new_ids (banerjee_step new_ids e other ineqs)
-
-let rec banerjee ((_,_,print_var) as new_ids) (sys_eq,sys_ineq) =
-  let rec fst_eq_1 = function
-     (eq::l) -> 
-        if List.exists (fun x -> abs x.c = 1) eq.body then eq,l
-        else let (eq',l') = fst_eq_1 l in (eq',eq::l')
-   | [] -> raise Not_found in
-  match sys_eq with
-     [] -> if !debug then display_system print_var sys_ineq; sys_ineq
-   | (e1::rest) -> 
-       let eq,other = try fst_eq_1 sys_eq with Not_found -> (e1,rest) in
-       if eq.body = [] then 
-         if eq.constant = 0 then begin
-           add_event (FORGET_C eq.id); banerjee new_ids (other,sys_ineq)
-         end else begin
-           add_event (CONSTANT_NOT_NUL(eq.id,eq.constant)); raise UNSOLVABLE
-         end
-       else
-	 banerjee new_ids 
-	   (eliminate_one_equation new_ids (eq,other,sys_ineq))
-
-type kind = INVERTED | NORMAL
-
-let redundancy_elimination new_eq_id system =
-  let normal = function
-     ({body=f::_} as e) when f.c < 0 ->  negate_eq e, INVERTED
-   | e -> e,NORMAL in
-  let table = Hashtbl.create 7 in
-  List.iter
-    (fun e -> 
-       let ({body=ne} as nx) ,kind = normal e in
-       if ne = [] then
-         if nx.constant < 0 then begin
-           add_event (CONSTANT_NEG(nx.id,nx.constant)); raise UNSOLVABLE
-         end else add_event (FORGET_C nx.id)
-       else
-       try 
-         let (optnormal,optinvert) = Hashtbl.find table ne in
-         let final =
-           if kind = NORMAL then begin
-             match optnormal with 
-                Some v -> 
-                  let kept =
-                    if v.constant < nx.constant 
-                    then begin add_event (FORGET (v.id,nx.id));v end
-                    else begin add_event (FORGET (nx.id,v.id));nx end in
-                  (Some(kept),optinvert)
-              | None -> Some nx,optinvert
-           end else begin
-             match optinvert with 
-                Some v ->
-                  let kept =
-                    if v.constant > nx.constant 
-                    then begin add_event (FORGET_I (v.id,nx.id));v end
-                    else begin add_event (FORGET_I (nx.id,v.id));nx end in
-                  (optnormal,Some(if v.constant > nx.constant then v else nx))
-              | None -> optnormal,Some nx
-           end in
-         begin match final with
-            (Some high, Some low) -> 
-              if high.constant < low.constant then begin
-                add_event(CONTRADICTION (high,negate_eq low));
-                raise UNSOLVABLE
-              end
-          | _ -> () end;
-         Hashtbl.remove table ne;
-         Hashtbl.add table ne final
-       with Not_found ->
-         Hashtbl.add table ne 
-           (if kind = NORMAL then (Some nx,None) else (None,Some nx)))
-    system;
-  let accu_eq = ref [] in
-  let accu_ineq = ref [] in
-  Hashtbl.iter
-    (fun p0 p1 -> match (p0,p1) with 
-       | (e, (Some x, Some y)) when x.constant = y.constant -> 
-           let id=new_eq_id () in
-           add_event (MERGE_EQ(id,x,y.id));
-           push {id=id; kind=EQUA; body=x.body; constant=x.constant} accu_eq
-       | (e, (optnorm,optinvert)) ->
-           begin match optnorm with 
-               Some x -> push x accu_ineq | _ -> () end;
-           begin match optinvert with 
-               Some x -> push (negate_eq x) accu_ineq | _ -> () end)
-    table;
-  !accu_eq,!accu_ineq
-
-exception SOLVED_SYSTEM
-
-let select_variable system =
-  let table = Hashtbl.create 7 in
-  let push v c= 
-    try let r = Hashtbl.find table v in r := max !r (abs c)
-    with Not_found -> Hashtbl.add table v (ref (abs c)) in
-  List.iter (fun {body=l} -> List.iter (fun f -> push f.v f.c) l) system;
-  let vmin,cmin = ref (-1), ref 0 in
-  let var_cpt = ref 0 in
-  Hashtbl.iter
-    (fun v ({contents =  c}) ->
-       incr var_cpt;
-       if c < !cmin or !vmin = (-1) then begin vmin := v; cmin := c end)
-    table;
-  if !var_cpt < 1 then raise SOLVED_SYSTEM;
-  !vmin
-
-let classify v system =
-  List.fold_left 
-    (fun (not_occ,below,over) eq ->
-       try let f,eq' = chop_var v eq.body in
-       if f.c >= 0 then (not_occ,((f.c,eq) :: below),over)
-       else (not_occ,below,((-f.c,eq) :: over))
-       with CHOPVAR -> (eq::not_occ,below,over))
-    ([],[],[]) system
-
-let product new_eq_id dark_shadow low high =
-  List.fold_left
-    (fun accu (a,eq1) ->
-       List.fold_left
-         (fun accu (b,eq2) ->
-            let eq = 
-              sum_afine new_eq_id (map_eq_afine (fun c -> c * b) eq1)
-                (map_eq_afine (fun c -> c * a) eq2) in
-            add_event(SUM(eq.id,(b,eq1),(a,eq2)));
-            match normalize eq with
-	      | [eq] ->
-                  let final_eq =
-                    if dark_shadow then 
-                      let delta = (a - 1) * (b - 1) in
-                      add_event(WEAKEN(eq.id,delta));
-                      {id = eq.id; kind=INEQ; body = eq.body; 
-                       constant = eq.constant - delta} 
-                    else eq
-                  in final_eq :: accu
-              | (e::_) -> failwith "Product dardk"
-              | [] -> accu)
-         accu high)
-    [] low
-
-let fourier_motzkin (_,new_eq_id,print_var) dark_shadow system =
-  let v = select_variable system in
-  let (ineq_out, ineq_low,ineq_high) = classify v system in
-  let expanded = ineq_out @ product new_eq_id dark_shadow ineq_low ineq_high in
-  if !debug then display_system print_var expanded; expanded
-
-let simplify ((new_eq_id,new_var_id,print_var) as new_ids) dark_shadow system =
-  if List.exists (fun e -> e.kind = DISE) system then 
-    failwith "disequation in simplify";
-  clear_history ();
-  List.iter (fun e -> add_event (HYP e)) system;
-  let system = flat_map normalize system in
-  let eqs,ineqs = filter (fun e -> e.kind=EQUA) system in
-  let simp_eq,simp_ineq = redundancy_elimination new_eq_id ineqs in
-  let system = (eqs @ simp_eq,simp_ineq) in
-  let rec loop1a system =
-    let sys_ineq = banerjee new_ids system in 
-    loop1b sys_ineq 
-  and loop1b sys_ineq =
-    let simp_eq,simp_ineq = redundancy_elimination new_eq_id sys_ineq in
-    if simp_eq = [] then simp_ineq else loop1a (simp_eq,simp_ineq) 
-  in
-  let rec loop2 system =
-    try
-      let expanded = fourier_motzkin new_ids dark_shadow system in
-      loop2 (loop1b expanded)
-    with SOLVED_SYSTEM ->
-      if !debug then display_system print_var system; system 
-  in
-  loop2 (loop1a system)
-
-let rec depend relie_on accu = function
-  | act :: l -> 
-      begin match act with
-	| DIVIDE_AND_APPROX (e,_,_,_) ->
-            if List.mem e.id relie_on then depend relie_on (act::accu) l
-            else depend relie_on accu l
-	| EXACT_DIVIDE (e,_) ->
-            if List.mem e.id relie_on then depend relie_on (act::accu) l
-            else depend relie_on accu l
-	| WEAKEN (e,_) ->
-            if List.mem e relie_on then depend relie_on (act::accu) l
-            else depend relie_on accu l
-	| SUM (e,(_,e1),(_,e2)) -> 
-            if List.mem e relie_on then 
-	      depend (e1.id::e2.id::relie_on) (act::accu) l
-            else 
-	      depend relie_on accu l
-	| STATE {st_new_eq=e} ->
-            if List.mem e.id relie_on then depend relie_on (act::accu) l
-            else depend relie_on accu l
-	| HYP e ->   
-            if List.mem e.id relie_on then depend relie_on (act::accu) l
-            else depend relie_on accu l
-	| FORGET_C _ -> depend relie_on accu l
-	| FORGET _ -> depend relie_on accu l
-	| FORGET_I _ -> depend relie_on accu l
-	| MERGE_EQ (e,e1,e2) ->
-            if List.mem e relie_on then 
-	      depend (e1.id::e2::relie_on) (act::accu) l
-            else 
-	      depend relie_on accu l
-	| NOT_EXACT_DIVIDE (e,_) -> depend (e.id::relie_on) (act::accu) l
-	| CONTRADICTION (e1,e2) -> 
-	    depend (e1.id::e2.id::relie_on) (act::accu) l
-	| CONSTANT_NOT_NUL (e,_) -> depend (e::relie_on) (act::accu) l
-	| CONSTANT_NEG (e,_) -> depend (e::relie_on) (act::accu) l
-	| CONSTANT_NUL e -> depend (e::relie_on) (act::accu) l
-	| NEGATE_CONTRADICT (e1,e2,_) -> 
-            depend (e1.id::e2.id::relie_on) (act::accu) l
-	| SPLIT_INEQ _ -> failwith "depend"
-      end
-  | [] -> relie_on, accu
-
-(*
-let depend relie_on accu trace = 
-  Printf.printf "Longueur de la trace initiale : %d\n" 
-    (trace_length trace + trace_length accu);
-  let rel',trace' = depend relie_on accu trace in
-  Printf.printf "Longueur de la trace simplifiée : %d\n" (trace_length trace');
-  rel',trace'
-*)
-
-let solve (new_eq_id,new_eq_var,print_var) system =
-  try let _ = simplify new_eq_id false system in failwith "no contradiction"
-  with UNSOLVABLE -> display_action print_var (snd (depend [] [] (history ())))
-      
-let negation (eqs,ineqs) =
-  let diseq,_ = filter (fun e -> e.kind = DISE) ineqs in
-  let normal = function
-    | ({body=f::_} as e) when f.c < 0 ->  negate_eq e, INVERTED
-    | e -> e,NORMAL in
-  let table = Hashtbl.create 7 in
-  List.iter (fun e -> 
-               let {body=ne;constant=c} ,kind = normal e in
-               Hashtbl.add table (ne,c) (kind,e)) diseq;
-  List.iter (fun e ->
-               if e.kind <> EQUA then pp 9999;
-               let {body=ne;constant=c},kind = normal e in
-               try 
-		 let (kind',e') = Hashtbl.find table (ne,c) in
-		 add_event (NEGATE_CONTRADICT (e,e',kind=kind'));
-		 raise UNSOLVABLE
-               with Not_found -> ()) eqs
-
-exception FULL_SOLUTION of action list * int list
-
-let simplify_strong ((new_eq_id,new_var_id,print_var) as new_ids) system =
-  clear_history ();
-  List.iter (fun e -> add_event (HYP e)) system;
-  (* Initial simplification phase *)
-  let rec loop1a system =
-    negation system;
-    let sys_ineq = banerjee new_ids system in 
-    loop1b sys_ineq 
-  and loop1b sys_ineq =
-    let dise,ine = filter (fun e -> e.kind = DISE) sys_ineq in
-    let simp_eq,simp_ineq = redundancy_elimination new_eq_id ine in
-    if simp_eq = [] then dise @ simp_ineq
-    else loop1a (simp_eq,dise @ simp_ineq) 
-  in
-  let rec loop2 system =
-    try
-      let expanded = fourier_motzkin new_ids false system in
-      loop2 (loop1b expanded)
-    with SOLVED_SYSTEM -> if !debug then display_system print_var system; system 
-  in
-  let rec explode_diseq = function 
-    | (de::diseq,ineqs,expl_map) ->
-	let id1 = new_eq_id () 
-	and id2 = new_eq_id () in
-	let e1 = 
-	  {id = id1; kind=INEQ; body = de.body; constant = de.constant - 1} in
-	let e2 = 
-	  {id = id2; kind=INEQ; body = map_eq_linear (fun x -> -x) de.body; 
-           constant = - de.constant - 1} in
-	let new_sys =
-          List.map (fun (what,sys) -> ((de.id,id1,true)::what, e1::sys)) 
-	    ineqs @ 
-          List.map (fun (what,sys) -> ((de.id,id2,false)::what,e2::sys)) 
-	    ineqs 
-	in
-	explode_diseq (diseq,new_sys,(de.id,(de,id1,id2))::expl_map)
-    | ([],ineqs,expl_map) -> ineqs,expl_map 
-  in
-  try 
-    let system = flat_map normalize system in
-    let eqs,ineqs = filter (fun e -> e.kind=EQUA) system in
-    let dise,ine = filter (fun e -> e.kind = DISE) ineqs in
-    let simp_eq,simp_ineq = redundancy_elimination new_eq_id ine in
-    let system = (eqs @ simp_eq,simp_ineq @ dise) in
-    let system' = loop1a system in
-    let diseq,ineq = filter (fun e -> e.kind = DISE) system' in
-    let first_segment = history () in
-    let sys_exploded,explode_map = explode_diseq (diseq,[[],ineq],[]) in
-    let all_solutions =
-      List.map
-        (fun (decomp,sys) -> 
-           clear_history ();
-           try let _ = loop2 sys in raise NO_CONTRADICTION
-           with UNSOLVABLE -> 
-             let relie_on,path = depend [] [] (history ()) in
-             let dc,_ = filter (fun (_,id,_) -> List.mem id relie_on) decomp in
-             let red = List.map (fun (x,_,_) -> x) dc in
-             (red,relie_on,decomp,path))
-        sys_exploded 
-    in
-    let max_count sys = 
-      let tbl = Hashtbl.create 7 in
-      let augment x = 
-        try incr (Hashtbl.find tbl x) 
-	with Not_found -> Hashtbl.add tbl x (ref 1) in
-      let eq = ref (-1) and c = ref 0 in
-      List.iter (function 
-		   | ([],r_on,_,path) -> raise (FULL_SOLUTION (path,r_on))
-                   | (l,_,_,_) -> List.iter augment l) sys;
-      Hashtbl.iter (fun x v -> if !v > !c then begin eq := x; c := !v end) tbl;
-      !eq 
-    in
-    let rec solve systems = 
-      try 
-	let id = max_count systems in 
-        let rec sign = function 
-	  | ((id',_,b)::l) -> if id=id' then b else sign l 
-          | [] -> failwith "solve" in
-        let s1,s2 = filter (fun (_,_,decomp,_) -> sign decomp) systems in
-        let s1' = 
-	  List.map (fun (dep,ro,dc,pa) -> (Util.list_except id dep,ro,dc,pa)) s1 in
-        let s2' = 
-	  List.map (fun (dep,ro,dc,pa) -> (Util.list_except id dep,ro,dc,pa)) s2 in
-        let (r1,relie1) = solve s1' 
-	and (r2,relie2) = solve s2' in
-	let (eq,id1,id2) = List.assoc id explode_map in
-	[SPLIT_INEQ(eq,(id1,r1),(id2, r2))], eq.id :: Util.list_union relie1 relie2
-      with FULL_SOLUTION (x0,x1) -> (x0,x1) 
-    in
-    let act,relie_on = solve all_solutions in
-    snd(depend relie_on act first_segment)
-  with UNSOLVABLE -> snd (depend [] [] (history ()))
diff --git a/contrib/romega/refl_omega.ml b/contrib/romega/refl_omega.ml
index ef68c587..285fc0ca 100644
--- a/contrib/romega/refl_omega.ml
+++ b/contrib/romega/refl_omega.ml
@@ -7,7 +7,8 @@
  *************************************************************************)
 
 open Const_omega
-
+module OmegaSolver = Omega.MakeOmegaSolver (Bigint)
+open OmegaSolver
 
 (* \section{Useful functions and flags} *)
 (* Especially useful debugging functions *)
@@ -25,7 +26,7 @@ let (>>) = Tacticals.tclTHEN
 
 let list_index t = 
   let rec loop i = function
-    | (u::l) -> if u = t then i else loop (i+1) l
+    | (u::l) -> if u = t then i else loop (succ i) l
     | [] -> raise Not_found in
   loop 0
 
@@ -101,7 +102,7 @@ type occurence = {o_hyp : Names.identifier; o_path : occ_path}
 (* \subsection{refiable formulas} *)
 type oformula =
     (* integer *)
-  | Oint of int
+  | Oint of Bigint.bigint
     (* recognized binary and unary operations *)
   | Oplus of oformula * oformula
   | Omult of oformula * oformula
@@ -139,7 +140,7 @@ and oequation = {
     e_depends: direction  list;		(* liste des points de disjonction dont 
 					   dépend l'accès à l'équation avec la 
 					   direction (branche) pour y accéder *)
-    e_omega: Omega2.afine		(* la fonction normalisée *)
+    e_omega: afine		(* la fonction normalisée *)
   } 
 
 (* \subsection{Proof context} 
@@ -172,7 +173,7 @@ type environment = {
 type solution = {
   s_index : int;
   s_equa_deps : int list;
-  s_trace : Omega2.action list }
+  s_trace : action list }
 
 (* Arbre de solution résolvant complètement un ensemble de systèmes *)
 type solution_tree = 
@@ -203,8 +204,8 @@ let new_environment () = {
 }
 
 (* Génération d'un nom d'équation *)
-let new_eq_id env =
-   env.cnt_connectors <- env.cnt_connectors + 1; env.cnt_connectors
+let new_connector_id env =  
+   env.cnt_connectors <- succ env.cnt_connectors; env.cnt_connectors
 
 (* Calcul de la branche complémentaire *)
 let barre = function Left x -> Right x | Right x -> Left x
@@ -215,21 +216,36 @@ let indice = function Left x | Right x -> x
 (* Affichage de l'environnement de réification (termes et propositions) *)
 let print_env_reification env = 
   let rec loop c i = function
-      [] -> Printf.printf "===============================\n\n"
+      [] -> Printf.printf "  ===============================\n\n"
     | t :: l -> 
-	Printf.printf "(%c%02d) : " c i;
-	Pp.ppnl (Printer.prterm t);
+	Printf.printf "  (%c%02d) := " c i;
+	Pp.ppnl (Printer.pr_lconstr t);
 	Pp.flush_all ();
-	loop c (i+1) l in
-  Printf.printf "PROPOSITIONS :\n\n"; loop 'P' 0 env.props;
-  Printf.printf "TERMES :\n\n"; loop 'V' 0 env.terms
+	loop c (succ i) l in
+  print_newline ();
+  Printf.printf "  ENVIRONMENT OF PROPOSITIONS :\n\n"; loop 'P' 0 env.props;
+  Printf.printf "  ENVIRONMENT OF TERMS :\n\n"; loop 'V' 0 env.terms
 
 
 (* \subsection{Gestion des environnements de variable pour Omega} *)
 (* generation d'identifiant d'equation pour Omega *)
-let new_omega_id = let cpt = ref 0 in function () -> incr cpt; !cpt
+
+let new_omega_eq, rst_omega_eq = 
+  let cpt = ref 0 in 
+  (function () -> incr cpt; !cpt), 
+  (function () -> cpt:=0)
+
+(* generation d'identifiant de variable pour Omega *)
+
+let new_omega_var, rst_omega_var = 
+  let cpt = ref 0 in 
+  (function () -> incr cpt; !cpt), 
+  (function () -> cpt:=0)
+
 (* Affichage des variables d'un système *)
-let display_omega_id i = Printf.sprintf "O%d" i
+
+let display_omega_var i = Printf.sprintf "OV%d" i
+
 (* Recherche la variable codant un terme pour Omega et crée la variable dans
    l'environnement si il n'existe pas. Cas ou la variable dans Omega représente
    le terme d'un monome (le plus souvent un atome) *)
@@ -237,12 +253,12 @@ let display_omega_id i = Printf.sprintf "O%d" i
 let intern_omega env t =
   begin try List.assoc t env.om_vars
   with Not_found -> 
-    let v = new_omega_id () in 
+    let v = new_omega_var () in 
     env.om_vars <- (t,v) :: env.om_vars; v
   end
 
-(* Ajout forcé d'un lien entre un terme et une variable Omega. Cas ou la
-   variable est crée par Omega et ou il faut la lier après coup a un atome
+(* Ajout forcé d'un lien entre un terme et une variable  Cas où la
+   variable est créée par Omega et où il faut la lier après coup à un atome
    réifié introduit de force *)
 let intern_omega_force env t v = env.om_vars <- (t,v) :: env.om_vars
 
@@ -281,7 +297,7 @@ let get_prop v env = try List.nth v env with _ -> failwith "get_prop"
 (* \subsection{Gestion du nommage des équations} *)
 (* Ajout d'une equation dans l'environnement de reification *)
 let add_equation env e =
-  let id = e.e_omega.Omega2.id in
+  let id = e.e_omega.id in
   try let _ = Hashtbl.find env.equations id in ()
   with Not_found -> Hashtbl.add env.equations id e
 
@@ -292,7 +308,7 @@ let get_equation env id =
 
 (* Affichage des termes réifiés *)
 let rec oprint ch = function 
-  | Oint n -> Printf.fprintf ch "%d" n
+  | Oint n -> Printf.fprintf ch "%s" (Bigint.to_string n)
   | Oplus (t1,t2) -> Printf.fprintf ch "(%a + %a)" oprint t1 oprint t2  
   | Omult (t1,t2) -> Printf.fprintf ch "(%a * %a)" oprint t1 oprint t2 
   | Ominus(t1,t2) -> Printf.fprintf ch "(%a - %a)" oprint t1 oprint t2 
@@ -304,7 +320,7 @@ let rec pprint ch = function
     Pequa (_,{ e_comp=comp; e_left=t1; e_right=t2 })  ->
       let connector = 
 	match comp with 
-	  Eq -> "=" | Leq -> "=<" | Geq -> ">="
+	  Eq -> "=" | Leq -> "<=" | Geq -> ">="
 	| Gt -> ">" | Lt -> "<" | Neq -> "!=" in
       Printf.fprintf ch "%a %s %a" oprint t1 connector oprint t2  
   | Ptrue -> Printf.fprintf ch "TT"
@@ -331,12 +347,12 @@ let rec weight env = function
 let omega_of_oformula env kind = 
   let rec loop accu = function
     | Oplus(Omult(v,Oint n),r) -> 
-	loop ({Omega2.v=intern_omega env v; Omega2.c=n} :: accu) r
+	loop ({v=intern_omega env v; c=n} :: accu) r
     | Oint n ->
-	let id = new_omega_id () in
+	let id = new_omega_eq () in
 	(*i tag_equation name id; i*)
-	{Omega2.kind = kind; Omega2.body = List.rev accu; 
-	 Omega2.constant = n; Omega2.id = id}
+	{kind = kind; body = List.rev accu; 
+	 constant = n; id = id}
     | t -> print_string "CO"; oprint stdout t; failwith "compile_equation" in
   loop []
 
@@ -351,10 +367,10 @@ let reified_of_atom env i =
 
 let rec oformula_of_omega env af = 
   let rec loop = function
-    | ({Omega2.v=v; Omega2.c=n}::r) ->
+    | ({v=v; c=n}::r) ->
 	Oplus(Omult(unintern_omega env v,Oint n),loop r)
-    | [] -> Oint af.Omega2.constant in
-  loop af.Omega2.body
+    | [] -> Oint af.constant in
+  loop af.body
 
 let app f v = mkApp(Lazy.force f,v)
 
@@ -429,7 +445,7 @@ let reified_of_proposition env f =
 let reified_of_omega env body constant = 
   let coeff_constant = 
     app coq_t_int [| mk_Z constant |] in
-  let mk_coeff {Omega2.c=c; Omega2.v=v} t =
+  let mk_coeff {c=c; v=v} t =
     let coef = 
       app coq_t_mult 
 	[| reified_of_formula env (unintern_omega env v); 
@@ -441,7 +457,7 @@ let reified_of_omega env body c  =
   begin try 
     reified_of_omega env body c 
   with e -> 
-    Omega2.display_eq display_omega_id (body,c); raise e 
+    display_eq display_omega_var (body,c); raise e 
   end
 
 (* \section{Opérations sur les équations}
@@ -475,7 +491,7 @@ let rec scalar n = function
      do_list [Lazy.force coq_c_mult_plus_distr; do_both tac1 tac2], 
      Oplus(t1',t2')
  | Oopp t ->
-     do_list [Lazy.force coq_c_mult_opp_left], Omult(t,Oint(-n))
+     do_list [Lazy.force coq_c_mult_opp_left], Omult(t,Oint(Bigint.neg n))
  | Omult(t1,Oint x) -> 
      do_list [Lazy.force coq_c_mult_assoc_reduced], Omult(t1,Oint (n*x))
  | Omult(t1,t2) -> 
@@ -496,12 +512,12 @@ let rec negate = function
  | Oopp t ->
      do_list [Lazy.force coq_c_opp_opp], t
  | Omult(t1,Oint x) -> 
-     do_list [Lazy.force coq_c_opp_mult_r], Omult(t1,Oint (-x))
+     do_list [Lazy.force coq_c_opp_mult_r], Omult(t1,Oint (Bigint.neg x))
  | Omult(t1,t2) -> 
      Util.error "Omega: Can't solve a goal with non-linear products"
  | (Oatom _ as t) ->
-     do_list [Lazy.force coq_c_opp_one], Omult(t,Oint(-1))
- | Oint i -> do_list [Lazy.force coq_c_reduce] ,Oint(-i)
+     do_list [Lazy.force coq_c_opp_one], Omult(t,Oint(negone))
+ | Oint i -> do_list [Lazy.force coq_c_reduce] ,Oint(Bigint.neg i)
  | Oufo c -> do_list [], Oufo (Oopp c)
  | Ominus _ -> failwith "negate minus"
 
@@ -511,10 +527,10 @@ let rec norm l = (List.length l)
 (* \subsubsection{Version avec coefficients} *)
 let rec shuffle_path k1 e1 k2 e2 =
   let rec loop = function
-      (({Omega2.c=c1;Omega2.v=v1}::l1) as l1'),
-      (({Omega2.c=c2;Omega2.v=v2}::l2) as l2') ->
+      (({c=c1;v=v1}::l1) as l1'),
+      (({c=c2;v=v2}::l2) as l2') ->
 	if v1 = v2 then
-          if k1*c1 + k2 * c2 = 0 then (
+          if k1*c1 + k2 * c2 = zero then (
             Lazy.force coq_f_cancel :: loop (l1,l2))
           else (
             Lazy.force coq_f_equal :: loop (l1,l2) )
@@ -522,9 +538,9 @@ let rec shuffle_path k1 e1 k2 e2 =
 	  Lazy.force coq_f_left :: loop(l1,l2'))
 	else (
 	  Lazy.force coq_f_right :: loop(l1',l2))
-    | ({Omega2.c=c1;Omega2.v=v1}::l1), [] -> 
+    | ({c=c1;v=v1}::l1), [] -> 
 	  Lazy.force coq_f_left :: loop(l1,[])
-    | [],({Omega2.c=c2;Omega2.v=v2}::l2) -> 
+    | [],({c=c2;v=v2}::l2) -> 
 	  Lazy.force coq_f_right :: loop([],l2)
     | [],[] -> flush stdout; [] in
   mk_shuffle_list (loop (e1,e2))
@@ -543,7 +559,7 @@ let rec shuffle env (t1,t2) =
       if weight env l1 > weight env t2 then
         let (l_action,t') = shuffle env (r1,t2) in
 	do_list [Lazy.force coq_c_plus_assoc_r;do_right l_action],Oplus(l1, t')
-      else do_list [Lazy.force coq_c_plus_sym], Oplus(t2,t1)
+      else do_list [Lazy.force coq_c_plus_comm], Oplus(t2,t1)
   | t1,Oplus(l2,r2) -> 
       if weight env l2 > weight env t1 then
         let (l_action,t') = shuffle env (t1,r2) in
@@ -553,7 +569,7 @@ let rec shuffle env (t1,t2) =
       do_list [Lazy.force coq_c_reduce], Oint(t1+t2)
   | t1,t2 ->
       if weight env t1 < weight env t2 then
-	do_list [Lazy.force coq_c_plus_sym], Oplus(t2,t1)
+	do_list [Lazy.force coq_c_plus_comm], Oplus(t2,t1)
       else do_list [],Oplus(t1,t2)
 
 (* \subsection{Fusion avec réduction} *)
@@ -561,11 +577,11 @@ let rec shuffle env (t1,t2) =
 let shrink_pair f1 f2 =
   begin match f1,f2 with
      Oatom v,Oatom _ -> 
-       Lazy.force coq_c_red1, Omult(Oatom v,Oint 2)
+       Lazy.force coq_c_red1, Omult(Oatom v,Oint two)
    | Oatom v, Omult(_,c2) -> 
-       Lazy.force coq_c_red2, Omult(Oatom v,Oplus(c2,Oint 1))
+       Lazy.force coq_c_red2, Omult(Oatom v,Oplus(c2,Oint one))
    | Omult (v1,c1),Oatom v -> 
-       Lazy.force coq_c_red3, Omult(Oatom v,Oplus(c1,Oint 1))
+       Lazy.force coq_c_red3, Omult(Oatom v,Oplus(c1,Oint one))
    | Omult (Oatom v,c1),Omult (v2,c2) ->
        Lazy.force coq_c_red4, Omult(Oatom v,Oplus(c1,c2))
    | t1,t2 -> 
@@ -577,7 +593,7 @@ let shrink_pair f1 f2 =
 
 let reduce_factor = function
    Oatom v ->
-     let r = Omult(Oatom v,Oint 1) in
+     let r = Omult(Oatom v,Oint one) in
        [Lazy.force coq_c_red0],r
   | Omult(Oatom v,Oint n) as f -> [],f
   | Omult(Oatom v,c) ->
@@ -588,7 +604,7 @@ let reduce_factor = function
 	[Lazy.force coq_c_reduce], Omult(Oatom v,Oint(compute c))
   | t -> Util.error "reduce_factor.1"
 
-(* \subsection{Réordonancement} *)
+(* \subsection{Réordonnancement} *)
 
 let rec condense env = function
     Oplus(f1,(Oplus(f2,r) as t)) ->
@@ -602,7 +618,7 @@ let rec condense env = function
 	let tac',t' = condense env t in 
 	[do_both (do_list tac) (do_list tac')], Oplus(f,t') 
       end
-  | (Oplus(f1,Oint n) as t) -> 
+  | Oplus(f1,Oint n) -> 
       let tac,f1' = reduce_factor f1 in 
       [do_left (do_list tac)],Oplus(f1',Oint n)
   | Oplus(f1,f2) -> 
@@ -618,13 +634,13 @@ let rec condense env = function
   | (Oint _ as t)-> [],t
   | t -> 
       let tac,t' = reduce_factor t in
-      let final = Oplus(t',Oint 0) in
+      let final = Oplus(t',Oint zero) in
       tac @ [Lazy.force coq_c_red6], final
 
 (* \subsection{Elimination des zéros} *)
 
 let rec clear_zero = function
-   Oplus(Omult(Oatom v,Oint 0),r) ->
+   Oplus(Omult(Oatom v,Oint n),r) when n=zero ->
      let tac',t = clear_zero r in
      Lazy.force coq_c_red5 :: tac',t
   | Oplus(f,r) -> 
@@ -652,7 +668,7 @@ let rec reduce env = function
 	  t', do_list [do_both trace1 trace2; tac]
       | (Oint n,_) ->
 	  let tac,t' = scalar n t2' in
-	  t', do_list [do_both trace1 trace2; Lazy.force coq_c_mult_sym; tac]
+	  t', do_list [do_both trace1 trace2; Lazy.force coq_c_mult_comm; tac]
       | _ -> Oufo t, Lazy.force coq_c_nop
       end
   | Oopp t ->
@@ -681,25 +697,36 @@ let normalize_equation env (negated,depends,origin,path) (oper,t1,t2) =
       e_origin = { o_hyp = origin; o_path = List.rev path };
       e_trace = trace; e_omega = equa } in
   try match (if negated then (negate_oper oper) else oper) with
-    | Eq  -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) Omega2.EQUA
-    | Neq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) Omega2.DISE
-    | Leq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o2,Oopp o1)) Omega2.INEQ
-    | Geq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) Omega2.INEQ
+    | Eq  -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) EQUA
+    | Neq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) DISE
+    | Leq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o2,Oopp o1)) INEQ
+    | Geq -> mk_step t1 t2 (fun o1 o2 -> Oplus (o1,Oopp o2)) INEQ
     | Lt  ->
-        mk_step t1 t2 (fun o1 o2 -> Oplus (Oplus(o2,Oint (-1)),Oopp o1))
-	  Omega2.INEQ
+        mk_step t1 t2 (fun o1 o2 -> Oplus (Oplus(o2,Oint negone),Oopp o1))
+	  INEQ
     | Gt ->
-        mk_step t1 t2 (fun o1 o2 -> Oplus (Oplus(o1,Oint (-1)),Oopp o2)) 
-	  Omega2.INEQ
+        mk_step t1 t2 (fun o1 o2 -> Oplus (Oplus(o1,Oint negone),Oopp o2)) 
+	  INEQ
   with e when Logic.catchable_exception e -> raise e
 
 (* \section{Compilation des hypothèses} *)
 
+let is_scalar t =
+  let rec aux t = match destructurate t with
+    | Kapp(("Zplus"|"Zminus"|"Zmult"),[t1;t2]) -> aux t1 & aux t2
+    | Kapp(("Zopp"|"Zsucc"),[t]) -> aux t
+    | Kapp(("Zpos"|"Zneg"|"Z0"),_) -> let _ = recognize_number t in true
+    | _ -> false in
+  try aux t with _ -> false
+
 let rec oformula_of_constr env t =
   try match destructurate t with
   | Kapp("Zplus",[t1;t2]) -> binop env (fun x y -> Oplus(x,y)) t1 t2
-  | Kapp("Zminus",[t1;t2]) ->binop env (fun x y -> Ominus(x,y)) t1 t2
-  | Kapp("Zmult",[t1;t2]) ->binop env (fun x y -> Omult(x,y)) t1 t2
+  | Kapp("Zminus",[t1;t2]) -> binop env (fun x y -> Ominus(x,y)) t1 t2
+  | Kapp("Zmult",[t1;t2]) when is_scalar t1 or is_scalar t2 ->
+      binop env (fun x y -> Omult(x,y)) t1 t2
+  | Kapp("Zopp",[t]) -> Oopp(oformula_of_constr env t)
+  | Kapp("Zsucc",[t]) -> Oplus(oformula_of_constr env t, Oint one)
   | Kapp(("Zpos"|"Zneg"|"Z0"),_) -> 
       begin try Oint(recognize_number t)
       with _ -> Oatom (add_reified_atom t env) end
@@ -715,7 +742,7 @@ and  binop env c t1 t2 =
 
 and  binprop env (neg2,depends,origin,path) 
              add_to_depends neg1 gl c t1 t2 =
-  let i = new_eq_id env in
+  let i = new_connector_id env in
   let depends1 = if add_to_depends then Left i::depends else depends in
   let depends2 = if add_to_depends then Right i::depends else depends in
   if add_to_depends then
@@ -775,13 +802,14 @@ let reify_gl env gl =
   let t_concl =
     Pnot (oproposition_of_constr env (true,[],id_concl,[O_mono]) gl concl) in
   if !debug then begin
-    Printf.printf "CONCL: "; pprint stdout t_concl; Printf.printf "\n"
+    Printf.printf "REIFED PROBLEM\n\n";
+    Printf.printf "  CONCL: "; pprint stdout t_concl; Printf.printf "\n"
   end;
   let rec loop = function
       (i,t) :: lhyps ->
 	let t' = oproposition_of_constr env (false,[],i,[]) gl t in
 	if !debug then begin
-	  Printf.printf "%s: " (Names.string_of_id i);
+	  Printf.printf "  %s: " (Names.string_of_id i);
 	  pprint stdout t';
 	  Printf.printf "\n"
 	end;
@@ -859,11 +887,11 @@ let display_depend = function
 
 let display_systems syst_list = 
   let display_omega om_e = 
-    Printf.printf "%d : %a %s 0\n"
-      om_e.Omega2.id
-      (fun _ -> Omega2.display_eq display_omega_id) 
-      (om_e.Omega2.body, om_e.Omega2.constant)
-      (Omega2.operator_of_eq om_e.Omega2.kind) in
+    Printf.printf "  E%d : %a %s 0\n"
+      om_e.id
+      (fun _ -> display_eq display_omega_var) 
+      (om_e.body, om_e.constant)
+      (operator_of_eq om_e.kind) in
 
   let display_equation oformula_eq = 
     pprint stdout (Pequa (Lazy.force coq_c_nop,oformula_eq)); print_newline ();
@@ -874,12 +902,12 @@ let display_systems syst_list =
       (String.concat ""
 	 (List.map (function O_left -> "L" | O_right -> "R" | O_mono -> "M")
 	    oformula_eq.e_origin.o_path));
-    Printf.printf "\n  Origin: %s -- Negated : %s\n"
+    Printf.printf "\n  Origin: %s (negated : %s)\n\n"
       (Names.string_of_id oformula_eq.e_origin.o_hyp)
-      (if oformula_eq.e_negated then "yes" else "false") in
+      (if oformula_eq.e_negated then "yes" else "no") in
 
   let display_system syst =
-    Printf.printf "=SYSTEME==================================\n";
+    Printf.printf "=SYSTEM===================================\n";
     List.iter display_equation syst in
   List.iter display_system syst_list
 
@@ -889,8 +917,8 @@ let display_systems syst_list =
 let rec hyps_used_in_trace = function
   | act :: l -> 
       begin match act with
-	| Omega2.HYP e -> e.Omega2.id :: hyps_used_in_trace l
-	| Omega2.SPLIT_INEQ (_,(_,act1),(_,act2)) -> 
+	| HYP e -> e.id :: hyps_used_in_trace l
+	| SPLIT_INEQ (_,(_,act1),(_,act2)) -> 
 	    hyps_used_in_trace act1 @ hyps_used_in_trace act2
 	| _ -> hyps_used_in_trace l
       end
@@ -903,11 +931,11 @@ let rec hyps_used_in_trace = function
 let rec variable_stated_in_trace = function
   | act :: l -> 
       begin match act with
-	| Omega2.STATE action ->
+	| STATE action ->
 	    (*i nlle_equa: afine, def: afine, eq_orig: afine, i*)
             (*i coef: int, var:int                            i*)
 	    action :: variable_stated_in_trace l
-	| Omega2.SPLIT_INEQ (_,(_,act1),(_,act2)) -> 
+	| SPLIT_INEQ (_,(_,act1),(_,act2)) -> 
 	    variable_stated_in_trace act1 @ variable_stated_in_trace act2
 	| _ -> variable_stated_in_trace l
       end
@@ -922,10 +950,10 @@ let add_stated_equations env tree =
   (* Il faut trier les variables par ordre d'introduction pour ne pas risquer
      de définir dans le mauvais ordre *)
   let stated_equations = 
-    List.sort (fun x y -> x.Omega2.st_var - y.Omega2.st_var) (loop tree) in
+    List.sort (fun x y -> Pervasives.(-) x.st_var y.st_var) (loop tree) in
   let add_env st = 
     (* On retransforme la définition de v en formule reifiée *)
-    let v_def = oformula_of_omega env st.Omega2.st_def in
+    let v_def = oformula_of_omega env st.st_def in
     (* Notez que si l'ordre de création des variables n'est pas respecté, 
      * ca va planter *)
     let coq_v = coq_of_formula env v_def in
@@ -936,8 +964,8 @@ let add_stated_equations env tree =
      * l'environnement pour le faire correctement *)
     let term_to_reify = (v_def,Oatom v) in
     (* enregistre le lien entre la variable omega et la variable Coq *)
-    intern_omega_force env (Oatom v) st.Omega2.st_var; 
-    (v, term_to_generalize,term_to_reify,st.Omega2.st_def.Omega2.id) in
+    intern_omega_force env (Oatom v) st.st_var; 
+    (v, term_to_generalize,term_to_reify,st.st_def.id) in
  List.map add_env stated_equations
 
 (* Calcule la liste des éclatements à réaliser sur les hypothèses 
@@ -950,7 +978,7 @@ let rec get_eclatement env = function
   | [] -> []
 
 let select_smaller l = 
-  let comp (_,x) (_,y) = List.length x - List.length y in
+  let comp (_,x) (_,y) = Pervasives.(-) (List.length x) (List.length y) in
   try List.hd (List.sort comp l) with Failure _ -> failwith "select_smaller"
 
 let filter_compatible_systems required systems =
@@ -968,11 +996,15 @@ let rec equas_of_solution_tree = function
   | Leaf s -> s.s_equa_deps
 
 
+(* Because of really_useful_prop, decidable formulas such as Pfalse
+   and Ptrue are moved to Pprop, thus breaking the decidability check
+   in ReflOmegaCore.concl_to_hyp... *)
+
 let really_useful_prop l_equa c =
   let rec real_of = function
       Pequa(t,_) -> t
-    | Ptrue ->  app  coq_true [||]
-    | Pfalse -> app  coq_false [||]
+    | Ptrue ->  app  coq_True [||]
+    | Pfalse -> app  coq_False [||]
     | Pnot t1 -> app coq_not [|real_of t1|]
     | Por(_,t1,t2) -> app coq_or [|real_of t1; real_of t2|]
     | Pand(_,t1,t2) -> app coq_and [|real_of t1; real_of t2|]
@@ -982,7 +1014,7 @@ let really_useful_prop l_equa c =
   let rec loop c = 
     match c with 
       Pequa(_,e) ->
-	if List.mem e.e_omega.Omega2.id l_equa then Some c else None
+	if List.mem e.e_omega.id l_equa then Some c else None
     | Ptrue -> None
     | Pfalse -> None
     | Pnot t1 -> 
@@ -1041,9 +1073,9 @@ let find_path {o_hyp=id;o_path=p} env =
       CCHyp{o_hyp=id';o_path=p'} :: l when id = id' ->
 	begin match loop_path (p',p) with
 	  Some r -> i,r
-	| None -> loop_id (i+1) l
+	| None -> loop_id (succ i) l
 	end
-    | _ :: l -> loop_id (i+1) l
+    | _ :: l -> loop_id (succ i) l
     | [] -> failwith "find_path" in
   loop_id 0 env
 
@@ -1062,59 +1094,59 @@ let get_hyp env_hyp i =
 let replay_history env env_hyp =
   let rec loop env_hyp t =
     match t with
-      | Omega2.CONTRADICTION (e1,e2) :: l -> 
-	  let trace = mk_nat (List.length e1.Omega2.body) in
+      | CONTRADICTION (e1,e2) :: l -> 
+	  let trace = mk_nat (List.length e1.body) in
 	  mkApp (Lazy.force coq_s_contradiction,
-		 [| trace ; mk_nat (get_hyp env_hyp e1.Omega2.id); 
-		    mk_nat (get_hyp env_hyp e2.Omega2.id) |])
-      | Omega2.DIVIDE_AND_APPROX (e1,e2,k,d) :: l ->
+		 [| trace ; mk_nat (get_hyp env_hyp e1.id); 
+		    mk_nat (get_hyp env_hyp e2.id) |])
+      | DIVIDE_AND_APPROX (e1,e2,k,d) :: l ->
 	  mkApp (Lazy.force coq_s_div_approx,
 		 [| mk_Z k; mk_Z d; 
-		    reified_of_omega env e2.Omega2.body e2.Omega2.constant;
-		    mk_nat (List.length e2.Omega2.body); 
-		    loop env_hyp l; mk_nat (get_hyp env_hyp e1.Omega2.id) |])
-      | Omega2.NOT_EXACT_DIVIDE (e1,k) :: l ->
-	  let e2_constant = Omega2.floor_div e1.Omega2.constant k in
-	  let d = e1.Omega2.constant - e2_constant * k in
-	  let e2_body = Omega2.map_eq_linear (fun c -> c / k) e1.Omega2.body in
+		    reified_of_omega env e2.body e2.constant;
+		    mk_nat (List.length e2.body); 
+		    loop env_hyp l; mk_nat (get_hyp env_hyp e1.id) |])
+      | NOT_EXACT_DIVIDE (e1,k) :: l ->
+	  let e2_constant = floor_div e1.constant k in
+	  let d = e1.constant - e2_constant * k in
+	  let e2_body = map_eq_linear (fun c -> c / k) e1.body in
           mkApp (Lazy.force coq_s_not_exact_divide,
 		 [|mk_Z k; mk_Z d; 
 		   reified_of_omega env e2_body e2_constant; 
 		   mk_nat (List.length e2_body); 
-		   mk_nat (get_hyp env_hyp e1.Omega2.id)|])
-      | Omega2.EXACT_DIVIDE (e1,k) :: l ->
+		   mk_nat (get_hyp env_hyp e1.id)|])
+      | EXACT_DIVIDE (e1,k) :: l ->
 	  let e2_body =  
-	    Omega2.map_eq_linear (fun c -> c / k) e1.Omega2.body in
-	  let e2_constant = Omega2.floor_div e1.Omega2.constant k in
+	    map_eq_linear (fun c -> c / k) e1.body in
+	  let e2_constant = floor_div e1.constant k in
           mkApp (Lazy.force coq_s_exact_divide,
 		 [|mk_Z k; 
 		   reified_of_omega env e2_body e2_constant; 
 		   mk_nat (List.length e2_body);
-		   loop env_hyp l; mk_nat (get_hyp env_hyp e1.Omega2.id)|])
-      | (Omega2.MERGE_EQ(e3,e1,e2)) :: l ->
-	  let n1 = get_hyp env_hyp e1.Omega2.id and n2 = get_hyp env_hyp e2 in
+		   loop env_hyp l; mk_nat (get_hyp env_hyp e1.id)|])
+      | (MERGE_EQ(e3,e1,e2)) :: l ->
+	  let n1 = get_hyp env_hyp e1.id and n2 = get_hyp env_hyp e2 in
           mkApp (Lazy.force coq_s_merge_eq,
-		 [| mk_nat (List.length e1.Omega2.body);
+		 [| mk_nat (List.length e1.body);
 		    mk_nat n1; mk_nat n2;
 		    loop (CCEqua e3:: env_hyp) l |])
-      | Omega2.SUM(e3,(k1,e1),(k2,e2)) :: l ->
-	  let n1 = get_hyp env_hyp e1.Omega2.id 
-	  and n2 = get_hyp env_hyp e2.Omega2.id in
-	  let trace = shuffle_path k1 e1.Omega2.body k2 e2.Omega2.body in
+      | SUM(e3,(k1,e1),(k2,e2)) :: l ->
+	  let n1 = get_hyp env_hyp e1.id 
+	  and n2 = get_hyp env_hyp e2.id in
+	  let trace = shuffle_path k1 e1.body k2 e2.body in
           mkApp (Lazy.force coq_s_sum,
 		 [| mk_Z k1; mk_nat n1; mk_Z k2;
 		    mk_nat n2; trace; (loop (CCEqua e3 :: env_hyp) l) |])
-      | Omega2.CONSTANT_NOT_NUL(e,k) :: l -> 
+      | CONSTANT_NOT_NUL(e,k) :: l -> 
           mkApp (Lazy.force coq_s_constant_not_nul,
 		 [|  mk_nat (get_hyp env_hyp e) |])
-      | Omega2.CONSTANT_NEG(e,k) :: l ->
+      | CONSTANT_NEG(e,k) :: l ->
           mkApp (Lazy.force coq_s_constant_neg,
 		 [|  mk_nat (get_hyp env_hyp e) |])
-      | Omega2.STATE {Omega2.st_new_eq=new_eq; Omega2.st_def =def; 
-		      Omega2.st_orig=orig; Omega2.st_coef=m;
-                      Omega2.st_var=sigma } :: l ->
-	  let n1 = get_hyp env_hyp orig.Omega2.id 
-	  and n2 = get_hyp env_hyp def.Omega2.id in
+      | STATE {st_new_eq=new_eq; st_def =def; 
+		      st_orig=orig; st_coef=m;
+                      st_var=sigma } :: l ->
+	  let n1 = get_hyp env_hyp orig.id 
+	  and n2 = get_hyp env_hyp def.id in
 	  let v = unintern_omega env sigma in
 	  let o_def = oformula_of_omega env def in
 	  let o_orig = oformula_of_omega env orig in
@@ -1123,24 +1155,24 @@ let replay_history env env_hyp =
           let trace,_ = normalize_linear_term env body in
 	  mkApp (Lazy.force coq_s_state,
 		 [| mk_Z m; trace; mk_nat n1; mk_nat n2; 
-		    loop (CCEqua new_eq.Omega2.id :: env_hyp) l |])
-      |	Omega2.HYP _ :: l -> loop env_hyp l
-      |	Omega2.CONSTANT_NUL e :: l ->
+		    loop (CCEqua new_eq.id :: env_hyp) l |])
+      |	HYP _ :: l -> loop env_hyp l
+      |	CONSTANT_NUL e :: l ->
 	  mkApp (Lazy.force coq_s_constant_nul, 
 		 [|  mk_nat (get_hyp env_hyp e) |])
-      |	Omega2.NEGATE_CONTRADICT(e1,e2,b) :: l ->
+      |	NEGATE_CONTRADICT(e1,e2,b) :: l ->
 	  mkApp (Lazy.force coq_s_negate_contradict, 
-		 [|  mk_nat (get_hyp env_hyp e1.Omega2.id);
-		     mk_nat (get_hyp env_hyp e2.Omega2.id) |])
-      | Omega2.SPLIT_INEQ(e,(e1,l1),(e2,l2)) :: l ->
-	  let i =  get_hyp env_hyp e.Omega2.id in
+		 [|  mk_nat (get_hyp env_hyp e1.id);
+		     mk_nat (get_hyp env_hyp e2.id) |])
+      | SPLIT_INEQ(e,(e1,l1),(e2,l2)) :: l ->
+	  let i =  get_hyp env_hyp e.id in
 	  let r1 = loop (CCEqua e1 :: env_hyp) l1 in
 	  let r2 = loop (CCEqua e2 :: env_hyp) l2 in
 	  mkApp (Lazy.force coq_s_split_ineq, 
-                  [| mk_nat (List.length e.Omega2.body); mk_nat i; r1 ; r2 |])
-      |	(Omega2.FORGET_C _ | Omega2.FORGET _ | Omega2.FORGET_I _) :: l ->
+                  [| mk_nat (List.length e.body); mk_nat i; r1 ; r2 |])
+      |	(FORGET_C _ | FORGET _ | FORGET_I _) :: l ->
 	  loop env_hyp l
-      | (Omega2.WEAKEN  _ ) :: l -> failwith "not_treated"
+      | (WEAKEN  _ ) :: l -> failwith "not_treated"
       |	[] -> failwith "no contradiction"
   in loop env_hyp
 
@@ -1171,7 +1203,7 @@ and decompose_tree_hyps trace env ctxt = function
       let full_path = if equation.e_negated then path @ [O_mono] else path in
       let cont = 
 	decompose_tree_hyps trace env 
-	   (CCEqua equation.e_omega.Omega2.id :: ctxt) l in
+	   (CCEqua equation.e_omega.id :: ctxt) l in
       app coq_e_extract [|mk_nat index;
 			  mk_direction_list full_path;
 			  cont |]
@@ -1190,15 +1222,15 @@ let resolution env full_reified_goal systems_list =
     let index = !num in
     let system = List.map (fun eq -> eq.e_omega) list_eq in
     let trace = 
-      Omega2.simplify_strong 
-	((fun () -> new_eq_id env),new_omega_id,display_omega_id) 
+      simplify_strong 
+	(new_omega_eq,new_omega_var,display_omega_var) 
 	system in 
     (* calcule les hypotheses utilisées pour la solution *)
     let vars = hyps_used_in_trace trace in
     let splits = get_eclatement env vars in
     if !debug then begin
       Printf.printf "SYSTEME %d\n" index;
-      Omega2.display_action display_omega_id trace;
+      display_action display_omega_var trace;
       print_string "\n  Depend :";
       List.iter (fun i -> Printf.printf " %d" i) vars;
       print_string "\n  Split points :";
@@ -1236,7 +1268,7 @@ let resolution env full_reified_goal systems_list =
     let rec loop i = function
 	var :: l -> 
 	  let t = get_reified_atom env var in 
-	  Hashtbl.add env.real_indices var i; t :: loop (i+1) l
+	  Hashtbl.add env.real_indices var i; t :: loop (succ i) l
       |	[] -> [] in
     loop 0 all_vars_env in
   let env_terms_reified = mk_list (Lazy.force coq_Z) basic_env in
@@ -1262,7 +1294,7 @@ let resolution env full_reified_goal systems_list =
             (l_reified_stated @ l_reified_terms) in
   let reified = 
     app coq_interp_sequent 
-       [| env_props_reified;env_terms_reified;reified_concl;reified_goal |] in
+       [| reified_concl;env_props_reified;env_terms_reified;reified_goal|] in
   let normalize_equation e = 
     let rec loop = function
 	[] -> app (if e.e_negated then coq_p_invert else coq_p_step)
@@ -1286,20 +1318,26 @@ let resolution env full_reified_goal systems_list =
   Tactics.change_in_concl None reified >> 
   Tactics.apply (app coq_do_omega [|decompose_tactic; normalization_trace|]) >>
   show_goal >>
-  Tactics.normalise_in_concl >>
+  Tactics.normalise_vm_in_concl >>
+  (*i Alternatives to the previous line: 
+   - Normalisation without VM: 
+      Tactics.normalise_in_concl
+   - Skip the conversion check and rely directly on the QED: 
+      Tacmach.convert_concl_no_check (Lazy.force coq_True) Term.VMcast >> 
+  i*)
   Tactics.apply (Lazy.force coq_I)
 
 let total_reflexive_omega_tactic gl = 
-  if !Options.v7 then Util.error "ROmega does not work in v7 mode";
+  Coqlib.check_required_library ["Coq";"romega";"ROmega"];
+  rst_omega_eq (); 
+  rst_omega_var ();
   try
   let env = new_environment () in
   let full_reified_goal = reify_gl env gl in
   let systems_list = destructurate_hyps full_reified_goal in
-  if !debug then begin 
-    display_systems systems_list
-  end;
+  if !debug then display_systems systems_list;
   resolution env full_reified_goal systems_list gl
-  with Omega2.NO_CONTRADICTION -> Util.error "ROmega can't solve this system"
+  with NO_CONTRADICTION -> Util.error "ROmega can't solve this system"
 
 
 (*i let tester = Tacmach.hide_atomic_tactic "TestOmega" test_tactic i*)
diff --git a/contrib/rtauto/Bintree.v b/contrib/rtauto/Bintree.v
new file mode 100644
index 00000000..97d80a92
--- /dev/null
+++ b/contrib/rtauto/Bintree.v
@@ -0,0 +1,498 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: Bintree.v 7233 2005-07-15 12:34:56Z corbinea $ *)
+
+Require Export List.
+Require Export BinPos.
+
+Unset Boxed Definitions.
+
+Open Scope positive_scope.
+
+Ltac clean := try (simpl; congruence). 
+Ltac caseq t := generalize (refl_equal t); pattern t at -1; case t.
+
+Functional Scheme Pcompare_ind := Induction for Pcompare.
+
+Lemma Prect : forall P : positive -> Type,
+       P 1 ->
+       (forall n : positive, P n -> P (Psucc n)) -> forall p : positive, P p.
+intros P H1 Hsucc n; induction n.
+rewrite <- plus_iter_xI; apply Hsucc; apply iterate_add; assumption.
+rewrite <- plus_iter_xO; apply iterate_add; assumption.
+assumption.
+Qed.
+
+Lemma Gt_Eq_Gt : forall p q cmp,
+       (p ?= q) Eq = Gt -> (p ?= q) cmp = Gt.
+apply (Pcompare_ind (fun p q cmp => (p ?= q) Eq = Gt -> (p ?= q) cmp = Gt));
+simpl;auto;congruence.
+Qed.
+
+Lemma Gt_Lt_Gt : forall p q cmp,
+       (p ?= q) Lt = Gt -> (p ?= q) cmp = Gt.
+apply (Pcompare_ind (fun p q cmp => (p ?= q) Lt = Gt -> (p ?= q) cmp = Gt));
+simpl;auto;congruence.
+Qed.
+
+Lemma Gt_Psucc_Eq: forall p q,
+  (p ?= Psucc q) Gt = Gt -> (p ?= q) Eq = Gt.
+intros p q;generalize p;clear p;induction q;destruct p;simpl;auto;try congruence.
+intro;apply Gt_Eq_Gt;auto.
+apply Gt_Lt_Gt.
+Qed.
+
+Lemma Eq_Psucc_Gt: forall p q,
+  (p ?= Psucc q) Eq = Eq -> (p ?= q) Eq = Gt.
+intros p q;generalize p;clear p;induction q;destruct p;simpl;auto;try congruence.
+intro H;elim (Pcompare_not_Eq p (Psucc q));tauto.
+intro H;apply Gt_Eq_Gt;auto.
+intro H;rewrite Pcompare_Eq_eq with p q;auto.
+generalize q;clear q IHq p H;induction q;simpl;auto.
+intro H;elim (Pcompare_not_Eq p q);tauto.
+Qed.
+
+Lemma Gt_Psucc_Gt : forall n p cmp cmp0,
+ (n?=p) cmp = Gt -> (Psucc n?=p) cmp0 = Gt.
+induction n;intros [ | p | p];simpl;try congruence.
+intros; apply IHn with cmp;trivial.
+intros; apply IHn with Gt;trivial.
+intros;apply Gt_Lt_Gt;trivial.
+intros [ | | ] _ H.
+apply Gt_Eq_Gt;trivial.
+apply Gt_Lt_Gt;trivial.
+trivial.
+Qed.
+
+Lemma Gt_Psucc: forall p q,
+       (p ?= Psucc q) Eq = Gt -> (p ?= q) Eq = Gt.
+intros p q;generalize p;clear p;induction q;destruct p;simpl;auto;try congruence.
+apply Gt_Psucc_Eq.
+intro;apply Gt_Eq_Gt;apply IHq;auto.
+apply Gt_Eq_Gt.
+apply Gt_Lt_Gt.
+Qed.
+
+Lemma Psucc_Gt : forall p,
+       (Psucc p ?= p) Eq = Gt.
+induction p;simpl.
+apply Gt_Eq_Gt;auto.
+generalize p;clear p IHp.
+induction p;simpl;auto.
+reflexivity.
+Qed.
+
+Fixpoint pos_eq (m n:positive) {struct m} :bool :=
+match m, n with
+  xI mm, xI nn => pos_eq mm nn
+| xO mm, xO nn => pos_eq mm nn
+| xH, xH => true
+| _, _ => false
+end. 
+
+Theorem pos_eq_refl : forall m n, pos_eq m n = true -> m = n.
+induction m;simpl;intro n;destruct n;congruence ||
+(intro e;apply f_equal with positive;auto).
+Defined.
+
+Theorem refl_pos_eq : forall m, pos_eq m m = true.
+induction m;simpl;auto.
+Qed.
+
+Definition pos_eq_dec (m n:positive) :{m=n}+{m<>n} .
+fix 1;intros [mm|mm|] [nn|nn|];try (right;congruence).
+case (pos_eq_dec mm nn).
+intro e;left;apply (f_equal xI e).
+intro ne;right;congruence.
+case (pos_eq_dec mm nn).
+intro e;left;apply (f_equal xO e).
+intro ne;right;congruence.
+left;reflexivity.
+Defined.
+
+Theorem pos_eq_dec_refl : forall m, pos_eq_dec m m = left (m<>m) (refl_equal m) .
+fix 1;intros [mm|mm|].
+simpl; rewrite  pos_eq_dec_refl; reflexivity.
+simpl; rewrite  pos_eq_dec_refl; reflexivity.
+reflexivity.
+Qed.
+
+Theorem pos_eq_dec_ex : forall m n,
+ pos_eq m n =true -> exists h:m=n,
+ pos_eq_dec m n = left (m<>n) h.
+fix 1;intros [mm|mm|] [nn|nn|];try (simpl;congruence).
+simpl;intro e.
+elim (pos_eq_dec_ex _ _ e).
+intros x ex; rewrite ex. 
+exists (f_equal xI x).
+reflexivity.
+simpl;intro e.
+elim (pos_eq_dec_ex _ _ e).
+intros x ex; rewrite ex. 
+exists (f_equal xO x).
+reflexivity.
+simpl.
+exists (refl_equal xH).
+reflexivity.
+Qed.
+
+Fixpoint nat_eq (m n:nat) {struct m}: bool:=
+match m, n with 
+O,O => true
+| S mm,S nn => nat_eq mm nn
+| _,_ => false
+end.
+
+Theorem nat_eq_refl : forall m n, nat_eq m n = true -> m = n.
+induction m;simpl;intro n;destruct n;congruence ||
+(intro e;apply f_equal with nat;auto).
+Defined.
+
+Theorem refl_nat_eq : forall n, nat_eq n n = true.
+induction n;simpl;trivial.
+Defined.
+
+Fixpoint Lget (A:Set) (n:nat) (l:list A) {struct l}:option A :=
+match l with nil => None
+| x::q => 
+match n with O => Some x
+| S m => Lget A m q
+end end .
+
+Implicit Arguments Lget [A].
+
+Lemma map_app : forall (A B:Set) (f:A -> B) l m, 
+List.map  f (l ++ m) = List.map  f  l ++ List.map  f  m.
+induction l.
+reflexivity.
+simpl.
+intro m ; apply f_equal with (list B);apply IHl.
+Qed.
+
+Lemma length_map : forall (A B:Set) (f:A -> B) l, 
+length (List.map  f l) = length l.
+induction l.
+reflexivity.
+simpl; apply f_equal with nat;apply IHl.
+Qed.
+
+Lemma Lget_map : forall (A B:Set) (f:A -> B) i l, 
+Lget i (List.map  f l) = 
+match Lget i l with Some a => 
+Some (f a) | None => None end.
+induction i;intros [ | x l ] ;trivial.
+simpl;auto.
+Qed.
+
+Lemma Lget_app : forall (A:Set) (a:A) l i,
+Lget i (l ++ a :: nil) = if nat_eq i (length l) then Some a else Lget i l.
+induction l;simpl Lget;simpl length.
+intros [ | i];simpl;reflexivity.
+intros [ | i];simpl.
+reflexivity.
+auto.
+Qed.
+
+Lemma Lget_app_Some : forall (A:Set) l delta i (a: A), 
+Lget i l = Some a ->
+Lget i (l ++ delta) = Some a.
+induction l;destruct i;simpl;try congruence;auto.
+Qed.
+
+Section Store.
+
+Variable A:Type.
+
+Inductive Poption : Type:=
+  PSome : A -> Poption
+| PNone : Poption.
+
+Inductive Tree : Type :=
+   Tempty : Tree
+ | Branch0 : Tree -> Tree -> Tree
+ | Branch1 : A -> Tree -> Tree -> Tree.
+        
+Fixpoint Tget (p:positive) (T:Tree) {struct p} : Poption := 
+  match T with
+    Tempty => PNone
+  | Branch0 T1 T2 =>
+    match p with
+      xI pp => Tget pp T2
+    | xO pp => Tget pp T1
+    | xH => PNone
+    end
+  | Branch1 a T1 T2 =>
+    match p with
+      xI pp => Tget pp T2
+    | xO pp => Tget pp T1
+    | xH => PSome a
+    end
+end.
+
+Fixpoint Tadd (p:positive) (a:A) (T:Tree) {struct p}: Tree := 
+ match T with
+   | Tempty =>
+       match p with
+       | xI pp => Branch0 Tempty (Tadd pp a Tempty)
+       | xO pp => Branch0 (Tadd pp a Tempty) Tempty
+       | xH => Branch1 a Tempty Tempty
+       end
+   | Branch0 T1 T2 =>
+       match p with
+       | xI pp => Branch0 T1 (Tadd pp a T2)
+       | xO pp => Branch0 (Tadd pp a T1) T2
+       | xH => Branch1 a T1 T2
+       end
+   | Branch1 b T1 T2 =>
+       match p with
+       | xI pp => Branch1 b T1 (Tadd pp a T2)
+       | xO pp => Branch1 b (Tadd pp a T1) T2
+       | xH => Branch1 a T1 T2
+       end
+   end.
+
+Definition mkBranch0 (T1 T2:Tree) :=
+  match T1,T2 with
+    Tempty ,Tempty => Tempty
+  | _,_ => Branch0 T1 T2
+  end.
+  
+Fixpoint Tremove (p:positive) (T:Tree) {struct p}: Tree :=
+   match T with
+      | Tempty => Tempty
+      | Branch0 T1 T2 => 
+        match p with
+        | xI pp => mkBranch0 T1 (Tremove pp T2)                  
+        | xO pp => mkBranch0 (Tremove pp T1) T2
+        | xH => T
+        end
+      | Branch1 b T1 T2 =>
+        match p with
+        | xI pp => Branch1 b T1 (Tremove pp T2)
+        | xO pp => Branch1 b (Tremove pp T1) T2
+        | xH => mkBranch0 T1 T2
+        end
+      end.
+                                                                                                                        
+ 
+Theorem Tget_Tempty: forall (p : positive), Tget p (Tempty) = PNone.
+destruct p;reflexivity.
+Qed.
+
+Theorem Tget_Tadd: forall i j a T,
+       Tget i (Tadd j a T) =
+       match (i ?= j) Eq with
+         Eq => PSome a
+       | Lt => Tget i T
+       | Gt => Tget i T
+       end.
+intros i j.
+caseq ((i ?= j) Eq).
+intro H;rewrite (Pcompare_Eq_eq _ _ H);intros a;clear i H.
+induction j;destruct T;simpl;try (apply IHj);congruence.
+generalize i;clear i;induction j;destruct T;simpl in H|-*;
+destruct i;simpl;try rewrite (IHj _ H);try (destruct i;simpl;congruence);reflexivity|| congruence.
+generalize i;clear i;induction j;destruct T;simpl in H|-*;
+destruct i;simpl;try rewrite (IHj _ H);try (destruct i;simpl;congruence);reflexivity|| congruence.
+Qed.
+
+Record Store : Type :=  
+mkStore  {index:positive;contents:Tree}.
+
+Definition empty := mkStore xH Tempty.
+
+Definition push a  S :=
+mkStore (Psucc (index S)) (Tadd (index S) a (contents S)).
+
+Definition get i S := Tget i (contents S).
+
+Lemma get_empty : forall i, get i empty = PNone.
+intro i; case i; unfold empty,get; simpl;reflexivity.
+Qed.
+
+Inductive Full : Store -> Type:=
+    F_empty : Full empty
+  | F_push : forall a S, Full S -> Full (push a S).
+
+Theorem get_Full_Gt : forall S, Full S ->
+       forall i, (i ?= index S) Eq = Gt -> get i S = PNone.
+intros S W;induction W.
+unfold empty,index,get,contents;intros;apply Tget_Tempty.
+unfold index,get,push;simpl contents.
+intros i e;rewrite Tget_Tadd.
+rewrite (Gt_Psucc _ _ e). 
+unfold get in IHW.
+apply IHW;apply Gt_Psucc;assumption.
+Qed.
+
+Theorem get_Full_Eq : forall S, Full S -> get (index S) S = PNone.
+intros [index0 contents0] F.
+case F.
+unfold empty,index,get,contents;intros;apply Tget_Tempty.
+unfold index,get,push;simpl contents.
+intros a S.
+rewrite Tget_Tadd.
+rewrite Psucc_Gt.
+intro W.
+change (get (Psucc (index S)) S =PNone).
+apply get_Full_Gt; auto.
+apply Psucc_Gt.
+Qed.
+
+Theorem get_push_Full : 
+  forall i a S, Full S -> 
+  get i (push a S) =
+  match (i ?= index S) Eq with
+    Eq => PSome a
+  | Lt => get i S
+  | Gt => PNone
+end.
+intros i a S F.
+caseq ((i ?= index S) Eq).
+intro e;rewrite (Pcompare_Eq_eq _ _ e).
+destruct S;unfold get,push,index;simpl contents;rewrite Tget_Tadd.
+rewrite Pcompare_refl;reflexivity.
+intros;destruct S;unfold get,push,index;simpl contents;rewrite Tget_Tadd.
+simpl index in H;rewrite H;reflexivity.
+intro H;generalize H;clear H.
+unfold get,push;simpl index;simpl contents.
+rewrite Tget_Tadd;intro e;rewrite e.
+change (get i S=PNone).
+apply get_Full_Gt;auto.
+Qed.
+
+Lemma Full_push_compat : forall i a S, Full S ->
+forall x, get i S = PSome x -> 
+ get i (push a S) = PSome x.
+intros i a S F x H. 
+caseq ((i ?= index S) Eq);intro test.
+rewrite (Pcompare_Eq_eq _ _ test) in H.
+rewrite (get_Full_Eq _ F) in H;congruence.
+rewrite <- H.
+rewrite (get_push_Full i a).
+rewrite test;reflexivity.
+assumption.
+rewrite (get_Full_Gt _ F) in H;congruence.
+Qed.
+
+Lemma Full_index_one_empty : forall S, Full S -> index S = 1 -> S=empty. 
+intros [ind cont] F one; inversion F.
+reflexivity.
+simpl index in one;assert (h:=Psucc_not_one (index S)).
+congruence.
+Qed.
+
+Lemma push_not_empty: forall a S, (push a S) <> empty.
+intros a [ind cont];unfold push,empty.
+simpl;intro H;injection H; intros _ ; apply Psucc_not_one.
+Qed. 
+
+Fixpoint In (x:A) (S:Store) (F:Full S) {struct F}: Prop :=
+match F with
+F_empty => False
+| F_push a SS FF => x=a \/ In x SS FF
+end.
+
+Lemma get_In : forall (x:A) (S:Store) (F:Full S) i , 
+get i S = PSome x -> In x S F.
+induction F.
+intro i;rewrite get_empty; congruence.
+intro i;rewrite get_push_Full;trivial.
+caseq ((i ?= index S) Eq);simpl.
+left;congruence.
+right;eauto.
+congruence.
+Qed.
+
+End Store.
+
+Implicit Arguments PNone [A].
+Implicit Arguments PSome [A].
+
+Implicit Arguments Tempty [A].
+Implicit Arguments Branch0 [A].
+Implicit Arguments Branch1 [A].
+
+Implicit Arguments Tget [A].
+Implicit Arguments Tadd [A].
+
+Implicit Arguments Tget_Tempty [A].
+Implicit Arguments Tget_Tadd [A].
+
+Implicit Arguments mkStore [A].
+Implicit Arguments index [A].
+Implicit Arguments contents [A].
+
+Implicit Arguments empty [A].
+Implicit Arguments get [A].
+Implicit Arguments push [A].
+
+Implicit Arguments get_empty [A].
+Implicit Arguments get_push_Full [A].
+
+Implicit Arguments Full [A].
+Implicit Arguments F_empty [A].
+Implicit Arguments F_push [A].
+Implicit Arguments In [A].
+
+Section Map. 
+
+Variables A B:Set.
+
+Variable f: A -> B.
+
+Fixpoint Tmap (T: Tree A) : Tree B :=
+match T with
+Tempty => Tempty
+| Branch0 t1 t2 => Branch0 (Tmap t1) (Tmap t2)
+| Branch1 a t1 t2 => Branch1 (f a) (Tmap t1) (Tmap t2)
+end.
+
+Lemma Tget_Tmap: forall T i, 
+Tget i (Tmap T)= match Tget i T with PNone => PNone 
+| PSome a => PSome (f a) end.
+induction T;intro i;case i;simpl;auto.
+Defined.
+
+Lemma Tmap_Tadd: forall i a T,
+Tmap (Tadd i a T) = Tadd i (f a) (Tmap T).
+induction i;intros a T;case T;simpl;intros;try (rewrite IHi);simpl;reflexivity.
+Defined.
+
+Definition map (S:Store A) : Store B :=
+mkStore (index S) (Tmap (contents S)).
+
+Lemma get_map: forall i S, 
+get i (map S)= match get i S with PNone => PNone 
+| PSome a => PSome (f a) end.
+destruct S;unfold get,map,contents,index;apply Tget_Tmap.
+Defined.
+
+Lemma map_push: forall a S, 
+map (push a S) = push (f a) (map S).
+intros a S.
+case S.
+unfold push,map,contents,index.
+intros;rewrite Tmap_Tadd;reflexivity.
+Defined.
+
+Theorem Full_map : forall S, Full S -> Full (map S).
+intros S F. 
+induction F.
+exact F_empty.
+rewrite map_push;constructor 2;assumption.
+Defined.
+
+End Map.
+
+Implicit Arguments Tmap [A B].
+Implicit Arguments map [A B].
+Implicit Arguments Full_map [A B f].
+
+Notation "hyps \ A" := (push A hyps) (at level 72,left associativity).
diff --git a/contrib/rtauto/Rtauto.v b/contrib/rtauto/Rtauto.v
new file mode 100644
index 00000000..98fca90f
--- /dev/null
+++ b/contrib/rtauto/Rtauto.v
@@ -0,0 +1,398 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: Rtauto.v 7639 2005-12-02 10:01:15Z gregoire $ *)
+
+
+Require Export List.
+Require Export Bintree.
+Require Import Bool.
+Unset Boxed Definitions.
+
+Ltac caseq t := generalize (refl_equal t); pattern t at -1; case t.
+Ltac clean:=try (simpl;congruence).
+
+Inductive form:Set:=
+  Atom : positive -> form
+| Arrow : form -> form -> form
+| Bot
+| Conjunct : form -> form -> form 
+| Disjunct : form -> form -> form.
+
+Notation "[ n ]":=(Atom n).
+Notation "A =>> B":= (Arrow A B) (at level 59, right associativity).
+Notation "#" := Bot.
+Notation "A //\\ B" := (Conjunct A B) (at level 57, left associativity).
+Notation "A \\// B" := (Disjunct A B) (at level 58, left associativity).
+
+Definition ctx := Store form.
+
+Fixpoint pos_eq (m n:positive) {struct m} :bool :=
+match m with
+  xI mm => match n with xI nn => pos_eq mm nn | _ => false end
+| xO mm => match n with xO nn => pos_eq mm nn | _ => false end
+| xH => match n with xH => true | _ => false end
+end. 
+
+Theorem pos_eq_refl : forall m n, pos_eq m n = true -> m = n.
+induction m;simpl;destruct n;congruence ||
+(intro e;apply f_equal with positive;auto).
+Qed.
+
+Fixpoint form_eq (p q:form) {struct p} :bool :=
+match p with
+  Atom m => match q with Atom n => pos_eq m n | _ => false end
+| Arrow p1 p2 => 
+match q with 
+  Arrow q1 q2 => form_eq p1 q1 && form_eq p2 q2 
+| _ => false end
+| Bot => match q with Bot => true | _ => false end
+| Conjunct p1 p2 => 
+match q with 
+  Conjunct q1 q2 => form_eq p1 q1 && form_eq p2 q2 
+| _ => false 
+end
+| Disjunct p1 p2 => 
+match q with 
+  Disjunct q1 q2 => form_eq p1 q1 && form_eq p2 q2 
+| _ => false 
+end
+end. 
+
+Theorem form_eq_refl: forall p q, form_eq p q = true -> p = q.
+induction p;destruct q;simpl;clean.
+intro h;generalize (pos_eq_refl _ _ h);congruence.
+caseq (form_eq p1 q1);clean.
+intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. 
+caseq (form_eq p1 q1);clean.
+intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. 
+caseq (form_eq p1 q1);clean.
+intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. 
+Qed.
+
+Implicit Arguments form_eq_refl [p q].
+
+Section with_env.
+
+Variable env:Store Prop.
+
+Fixpoint interp_form (f:form): Prop :=
+match f with
+[n]=> match get n env with PNone => True | PSome P => P end
+| A =>> B => (interp_form A) -> (interp_form B)
+| # => False
+| A //\\ B => (interp_form A) /\ (interp_form B)
+| A \\// B => (interp_form A) \/ (interp_form B)
+end.
+
+Notation "[[ A ]]" := (interp_form A).
+
+Fixpoint interp_ctx (hyps:ctx) (F:Full hyps) (G:Prop) {struct F} : Prop :=
+match F with
+  F_empty => G
+| F_push H hyps0 F0 =>  interp_ctx hyps0 F0  ([[H]] -> G)
+end.
+
+Require Export BinPos.
+
+Ltac wipe := intros;simpl;constructor.  
+
+Lemma compose0 : 
+forall hyps F (A:Prop),
+ A -> 
+ (interp_ctx hyps F A).
+induction F;intros A H;simpl;auto.
+Qed.
+
+Lemma compose1 : 
+forall hyps F (A B:Prop),
+ (A -> B) ->
+ (interp_ctx hyps F A) ->
+ (interp_ctx hyps F B).
+induction F;intros A B H;simpl;auto.
+apply IHF;auto.
+Qed.
+
+Theorem compose2 : 
+forall hyps F (A B C:Prop),
+ (A -> B -> C) -> 
+ (interp_ctx hyps F A) ->
+ (interp_ctx hyps F B) ->
+ (interp_ctx hyps F C).
+induction F;intros A B C H;simpl;auto.
+apply IHF;auto.
+Qed.
+
+Theorem compose3 : 
+forall hyps F (A B C D:Prop),
+ (A -> B -> C -> D) -> 
+ (interp_ctx hyps F A) -> 
+ (interp_ctx hyps F B) ->
+ (interp_ctx hyps F C) ->
+ (interp_ctx hyps F D).
+induction F;intros A B C D H;simpl;auto.
+apply IHF;auto.
+Qed.
+
+Lemma weaken : forall hyps F f G,
+ (interp_ctx hyps F G) ->
+ (interp_ctx (hyps\f)  (F_push f hyps F) G).
+induction F;simpl;intros;auto.
+apply compose1 with ([[a]]-> G);auto.
+Qed.
+
+Theorem project_In : forall hyps F g, 
+In g hyps F ->
+interp_ctx hyps F [[g]].
+induction F;simpl.
+contradiction.
+intros g H;destruct H.
+subst;apply compose0;simpl;trivial.
+apply compose1 with [[g]];auto.
+Qed.
+
+Theorem project : forall hyps F p g, 
+get  p hyps = PSome g->
+interp_ctx hyps F [[g]].
+intros hyps F p g e; apply project_In.
+apply get_In with p;assumption.
+Qed.
+
+Implicit Arguments project [hyps p g].
+
+Inductive proof:Set :=
+  Ax : positive -> proof
+| I_Arrow : proof -> proof
+| E_Arrow : positive -> positive -> proof -> proof
+| D_Arrow : positive -> proof -> proof -> proof
+| E_False : positive -> proof
+| I_And: proof -> proof -> proof
+| E_And: positive -> proof -> proof
+| D_And: positive -> proof -> proof
+| I_Or_l: proof -> proof
+| I_Or_r: proof -> proof
+| E_Or: positive -> proof -> proof -> proof
+| D_Or: positive -> proof -> proof
+| Cut: form -> proof -> proof -> proof.
+
+Notation "hyps \ A" := (push A hyps) (at level 72,left associativity).
+
+Fixpoint check_proof (hyps:ctx) (gl:form) (P:proof) {struct P}: bool :=
+ match P with
+   Ax i => 
+     match get i hyps with
+         PSome F => form_eq F gl
+ | _ => false
+    end 
+| I_Arrow p =>
+   match gl with
+      A  =>> B  => check_proof (hyps \ A) B p
+   | _ => false        
+    end 
+| E_Arrow i j p =>
+   match get i hyps,get j hyps with
+       PSome A,PSome (B =>>C) =>
+         form_eq A B && check_proof (hyps \ C) (gl) p
+    | _,_ => false
+    end
+| D_Arrow i p1 p2 => 
+   match get i hyps with
+      PSome  ((A =>>B)=>>C) =>
+     (check_proof ( hyps \ B =>> C \ A) B p1) && (check_proof (hyps \ C) gl p2)
+    | _ => false
+  end
+| E_False i =>
+  match get i hyps with
+    PSome # => true
+  | _ => false
+  end
+| I_And p1 p2 =>
+   match gl with
+      A //\\ B =>
+      check_proof hyps A p1 && check_proof hyps B p2
+      | _ => false
+      end
+| E_And i p => 
+   match get i hyps with
+      PSome  (A //\\ B) => check_proof (hyps \ A \ B) gl p
+    | _=> false
+   end
+| D_And i p => 
+   match get i hyps with
+      PSome  (A //\\ B =>> C) => check_proof (hyps \ A=>>B=>>C) gl p
+    | _=> false
+   end
+| I_Or_l p =>
+   match gl with
+      (A \\// B) => check_proof hyps A p
+      | _ => false
+      end
+| I_Or_r p =>
+   match gl with
+      (A \\// B) => check_proof hyps B p
+      | _ => false
+      end
+| E_Or i p1 p2 =>
+  match get i hyps with
+  PSome (A \\// B) =>
+  check_proof (hyps \ A) gl p1 && check_proof (hyps \ B) gl p2
+  | _=> false
+  end
+| D_Or i p => 
+   match get i hyps with
+      PSome  (A \\// B =>> C) =>
+      (check_proof (hyps \ A=>>C \ B=>>C) gl p)
+    | _=> false
+   end
+| Cut A p1 p2 =>
+  check_proof hyps A p1 && check_proof (hyps \ A) gl p2
+end. 
+
+Theorem interp_proof: 
+forall p hyps F gl, 
+check_proof hyps gl p = true -> interp_ctx hyps F [[gl]].
+
+induction p;intros hyps F gl.
+
+(* cas Axiom *)
+Focus 1.
+simpl;caseq (get p hyps);clean.
+intros f nth_f e;rewrite <- (form_eq_refl e).
+apply project with p;trivial.
+
+(* Cas Arrow_Intro *)
+Focus 1.
+destruct gl;clean.
+simpl;intros.
+change (interp_ctx (hyps\gl1)  (F_push gl1 hyps F) [[gl2]]).
+apply IHp;try constructor;trivial.
+
+(* Cas Arrow_Elim *)
+Focus 1.
+simpl check_proof;caseq (get p hyps);clean.
+intros f ef;caseq (get p0 hyps);clean.
+intros f0 ef0;destruct f0;clean.
+caseq (form_eq f f0_1);clean.
+simpl;intros e check_p1.
+generalize  (project  F ef) (project  F ef0) 
+(IHp (hyps \ f0_2) (F_push f0_2 hyps F) gl check_p1);
+clear check_p1 IHp p p0 p1 ef ef0.
+simpl.
+apply compose3.
+rewrite (form_eq_refl e).
+auto.
+
+(* cas Arrow_Destruct *)
+Focus 1.
+simpl;caseq (get p1 hyps);clean.
+intros f ef;destruct f;clean.
+destruct f1;clean.
+caseq (check_proof (hyps \ f1_2 =>> f2 \ f1_1) f1_2 p2);clean.
+intros check_p1 check_p2.
+generalize (project F ef)
+(IHp1 (hyps \ f1_2 =>> f2 \ f1_1)   
+(F_push f1_1 (hyps \ f1_2 =>> f2)
+ (F_push (f1_2 =>> f2) hyps F)) f1_2 check_p1)
+(IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2).
+simpl;apply compose3;auto.
+
+(* Cas False_Elim *)
+Focus 1.
+simpl;caseq (get p hyps);clean.
+intros f ef;destruct f;clean.
+intros _; generalize (project F ef).
+apply compose1;apply False_ind.
+
+(* Cas And_Intro *)
+Focus 1.
+simpl;destruct gl;clean.
+caseq (check_proof hyps gl1 p1);clean.
+intros Hp1 Hp2;generalize (IHp1 hyps F gl1 Hp1) (IHp2 hyps F gl2 Hp2).
+apply compose2 ;simpl;auto.
+
+(* cas And_Elim *)
+Focus 1.
+simpl;caseq (get p hyps);clean.
+intros f ef;destruct f;clean.
+intro check_p;generalize  (project F ef)
+(IHp (hyps \ f1 \ f2) (F_push f2 (hyps \ f1) (F_push f1 hyps F)) gl check_p).
+simpl;apply compose2;intros [h1 h2];auto.
+
+(* cas And_Destruct *)
+Focus 1.
+simpl;caseq (get p hyps);clean.
+intros f ef;destruct f;clean.
+destruct f1;clean.
+intro H;generalize  (project F ef)
+(IHp (hyps \ f1_1 =>> f1_2 =>> f2)  
+(F_push (f1_1 =>> f1_2 =>> f2) hyps F) gl H);clear H;simpl.
+apply compose2;auto.
+
+(* cas Or_Intro_left *)
+Focus 1.
+destruct gl;clean.
+intro Hp;generalize (IHp hyps F gl1 Hp).
+apply compose1;simpl;auto.
+
+(* cas Or_Intro_right *)
+Focus 1.
+destruct gl;clean.
+intro Hp;generalize (IHp hyps F gl2 Hp).
+apply compose1;simpl;auto.
+
+(* cas Or_elim *)
+Focus 1.
+simpl;caseq (get p1 hyps);clean.
+intros f ef;destruct f;clean.
+caseq (check_proof (hyps \ f1) gl p2);clean.
+intros check_p1 check_p2;generalize (project F ef)
+(IHp1 (hyps \ f1) (F_push f1 hyps F) gl check_p1)
+(IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2);
+simpl;apply compose3;simpl;intro h;destruct h;auto.
+
+(* cas Or_Destruct *)
+Focus 1.
+simpl;caseq (get p hyps);clean.
+intros f ef;destruct f;clean.
+destruct f1;clean.
+intro check_p0;generalize (project F ef)
+(IHp (hyps \ f1_1 =>> f2 \ f1_2 =>> f2)
+(F_push (f1_2 =>> f2) (hyps \ f1_1 =>> f2) 
+ (F_push (f1_1 =>> f2) hyps F)) gl check_p0);simpl.
+apply compose2;auto.
+
+(* cas Cut *)
+Focus 1.
+simpl;caseq (check_proof hyps f p1);clean.
+intros check_p1 check_p2;
+generalize (IHp1 hyps F f check_p1) 
+(IHp2 (hyps\f) (F_push f hyps F) gl check_p2);
+simpl; apply compose2;auto.
+Qed.
+
+Theorem Reflect: forall gl prf, if check_proof empty gl prf then [[gl]] else True.
+intros gl prf;caseq (check_proof empty gl prf);intro check_prf.
+change (interp_ctx empty F_empty [[gl]]) ;
+apply interp_proof with prf;assumption.
+trivial.
+Qed.
+
+End with_env.
+
+(*
+(* A small example *)
+Parameters A B C D:Prop.
+Theorem toto:A /\ (B \/ C) -> (A /\ B) \/ (A /\ C).
+exact (Reflect (empty \ A \ B \ C)
+([1] //\\ ([2] \\// [3]) =>> [1] //\\ [2] \\// [1] //\\ [3])
+(I_Arrow (E_And 1 (E_Or 3 
+  (I_Or_l (I_And (Ax 2) (Ax 4))) 
+  (I_Or_r (I_And (Ax 2) (Ax 4))))))).
+Qed.
+Print toto.
+*)
diff --git a/theories7/NArith/NArith.v b/contrib/rtauto/g_rtauto.ml4
index d924ae2e..d7bb6e31 100644
--- a/theories7/NArith/NArith.v
+++ b/contrib/rtauto/g_rtauto.ml4
@@ -6,9 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: NArith.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ *)
+(* $Id: g_rtauto.ml4 7734 2005-12-26 14:06:51Z herbelin $*)
 
-(** Library for binary natural numbers *)
+(*i camlp4deps: "parsing/grammar.cma"  i*)
+
+TACTIC EXTEND rtauto
+  [ "rtauto" ] -> [ Refl_tauto.rtauto_tac ]
+END
 
-Require Export BinPos.
-Require Export BinNat.
diff --git a/contrib/rtauto/proof_search.ml b/contrib/rtauto/proof_search.ml
new file mode 100644
index 00000000..98643e0f
--- /dev/null
+++ b/contrib/rtauto/proof_search.ml
@@ -0,0 +1,546 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: proof_search.ml 7233 2005-07-15 12:34:56Z corbinea $ *)
+
+open Term
+open Util  
+open Goptions
+
+type s_info=
+    {mutable created_steps     : int; (* node count*)
+     mutable pruned_steps      : int;
+     mutable created_branches  : int; (* path count *)
+     mutable pruned_branches   : int;
+     mutable created_hyps      : int; (* hyps count *)
+     mutable pruned_hyps       : int;
+     mutable branch_failures   : int;
+     mutable branch_successes  : int;
+     mutable nd_branching      : int}
+
+let s_info=
+    {created_steps    = 0; (* node count*)
+     pruned_steps     = 0;
+     created_branches = 0; (* path count *)
+     pruned_branches  = 0;
+     created_hyps     = 0; (* hyps count *)
+     pruned_hyps      = 0;
+     branch_failures  = 0;
+     branch_successes = 0;
+     nd_branching     = 0}
+
+let reset_info () =
+     s_info.created_steps    <- 0; (* node count*)
+     s_info.pruned_steps     <- 0;
+     s_info.created_branches <- 0; (* path count *)
+     s_info.pruned_branches  <- 0;
+     s_info.created_hyps     <- 0; (* hyps count *)
+     s_info.pruned_hyps      <- 0;
+     s_info.branch_failures  <- 0;
+     s_info.branch_successes <- 0;
+     s_info.nd_branching     <- 0
+
+let pruning = ref true
+
+let opt_pruning=
+  {optsync=true;
+   optname="Rtauto Pruning";
+   optkey=SecondaryTable("Rtauto","Pruning");
+   optread=(fun () -> !pruning);
+   optwrite=(fun b -> pruning:=b)}
+
+let _ = declare_bool_option opt_pruning 
+
+type form=
+    Atom of int
+  | Arrow of form * form
+  | Bot 
+  | Conjunct of form * form
+  | Disjunct of form * form
+
+type tag=int
+
+let decomp_form=function
+    Atom i -> Some (i,[])
+  | Arrow (f1,f2) -> Some (-1,[f1;f2]) 
+  | Bot -> Some (-2,[])
+  | Conjunct (f1,f2) -> Some (-3,[f1;f2])
+  | Disjunct (f1,f2) -> Some (-4,[f1;f2])
+
+module Fmap=Map.Make(struct type t=form let compare=compare end)
+
+type sequent = 
+    {rev_hyps: form Intmap.t;
+     norev_hyps: form Intmap.t;
+     size:int;
+     left:int Fmap.t;
+     right:(int*form) list Fmap.t;
+     cnx:(int*int*form*form) list;
+     abs:int option;
+     gl:form}
+
+let add_one_arrow i f1 f2 m=
+  try Fmap.add f1 ((i,f2)::(Fmap.find f1 m)) m with
+      Not_found ->
+	Fmap.add f1 [i,f2] m
+
+type proof =
+    Ax of int
+  | I_Arrow of proof
+  | E_Arrow of int*int*proof
+  | D_Arrow of int*proof*proof
+  | E_False of int
+  | I_And of proof*proof
+  | E_And of int*proof
+  | D_And of int*proof
+  | I_Or_l of proof
+  | I_Or_r of proof
+  | E_Or of int*proof*proof
+  | D_Or of int*proof
+  | Pop of int*proof
+      
+type rule =
+    SAx of int
+  | SI_Arrow 
+  | SE_Arrow of int*int
+  | SD_Arrow of int
+  | SE_False of int
+  | SI_And 
+  | SE_And of int
+  | SD_And of int
+  | SI_Or_l
+  | SI_Or_r
+  | SE_Or of int
+  | SD_Or of int
+
+let add_step s sub =
+  match s,sub with
+      SAx i,[] -> Ax i
+    | SI_Arrow,[p] -> I_Arrow p
+    | SE_Arrow(i,j),[p] -> E_Arrow (i,j,p)
+    | SD_Arrow i,[p1;p2] -> D_Arrow (i,p1,p2)
+    | SE_False i,[] -> E_False i
+    | SI_And,[p1;p2] -> I_And(p1,p2)
+    | SE_And i,[p] -> E_And(i,p)
+    | SD_And i,[p] -> D_And(i,p)
+    | SI_Or_l,[p] -> I_Or_l p
+    | SI_Or_r,[p] -> I_Or_r p
+    | SE_Or i,[p1;p2] -> E_Or(i,p1,p2)
+    | SD_Or i,[p] -> D_Or(i,p)
+    | _,_ -> anomaly "add_step: wrong arity" 
+    
+type 'a with_deps = 
+    {dep_it:'a;
+     dep_goal:bool;
+     dep_hyps:Intset.t}
+
+type slice=
+    {proofs_done:proof list;
+     proofs_todo:sequent with_deps list;
+     step:rule;
+     needs_goal:bool;
+     needs_hyps:Intset.t;
+     changes_goal:bool;
+     creates_hyps:Intset.t}
+
+type state = 
+    Complete of proof
+  | Incomplete of sequent * slice list
+
+let project = function
+    Complete prf -> prf
+  | Incomplete (_,_) -> anomaly "not a successful state"
+
+let pop n prf =
+  let nprf=
+    match prf.dep_it with
+	Pop (i,p) -> Pop (i+n,p)
+      | p -> Pop(n,p) in
+    {prf with dep_it = nprf}
+
+let rec fill stack proof =
+  match stack with 
+      [] -> Complete proof.dep_it
+    | slice::super ->
+	if 
+	  !pruning &&
+	  slice.proofs_done=[] &&
+	  not (slice.changes_goal && proof.dep_goal) &&
+	  not (Intset.exists 
+		 (fun i -> Intset.mem i proof.dep_hyps) 
+		 slice.creates_hyps)
+	then
+	  begin
+	    s_info.pruned_steps<-s_info.pruned_steps+1;
+	    s_info.pruned_branches<- s_info.pruned_branches +
+	    List.length slice.proofs_todo;
+	    let created_here=Intset.cardinal slice.creates_hyps in
+	      s_info.pruned_hyps<-s_info.pruned_hyps+
+	      List.fold_left 
+		(fun sum dseq -> sum + Intset.cardinal dseq.dep_hyps) 
+		created_here slice.proofs_todo;
+	    fill super (pop (Intset.cardinal slice.creates_hyps) proof)
+	  end
+	else
+	  let dep_hyps=
+	    Intset.union slice.needs_hyps 
+	      (Intset.diff proof.dep_hyps slice.creates_hyps) in
+	  let dep_goal=
+	    slice.needs_goal || 
+	    ((not slice.changes_goal) && proof.dep_goal) in
+	  let proofs_done=
+	    proof.dep_it::slice.proofs_done in
+	    match slice.proofs_todo with
+		[] ->
+		  fill super {dep_it = 
+				add_step slice.step (List.rev proofs_done);
+			      dep_goal = dep_goal;
+			      dep_hyps = dep_hyps}
+	      | current::next ->
+		  let nslice=
+		    {proofs_done=proofs_done;
+		     proofs_todo=next;
+		     step=slice.step;
+		     needs_goal=dep_goal;
+		     needs_hyps=dep_hyps;
+		     changes_goal=current.dep_goal;
+		     creates_hyps=current.dep_hyps} in
+		    Incomplete (current.dep_it,nslice::super)
+
+let append stack (step,subgoals) =
+  s_info.created_steps<-s_info.created_steps+1;
+  match subgoals with 
+      [] -> 
+	s_info.branch_successes<-s_info.branch_successes+1;
+	fill stack {dep_it=add_step step.dep_it [];
+		    dep_goal=step.dep_goal;
+		    dep_hyps=step.dep_hyps}
+    | hd :: next ->
+	s_info.created_branches<-
+	s_info.created_branches+List.length next;
+	let slice=
+	  {proofs_done=[];
+	   proofs_todo=next;
+	   step=step.dep_it;
+	   needs_goal=step.dep_goal;
+	   needs_hyps=step.dep_hyps;
+	   changes_goal=hd.dep_goal;
+	   creates_hyps=hd.dep_hyps} in
+	  Incomplete(hd.dep_it,slice::stack)
+
+let embed seq=
+  {dep_it=seq;
+   dep_goal=false;
+   dep_hyps=Intset.empty}
+
+let change_goal seq gl=
+    {seq with 
+       dep_it={seq.dep_it with gl=gl};
+       dep_goal=true}
+	
+let add_hyp seqwd f=
+  s_info.created_hyps<-s_info.created_hyps+1;
+  let seq=seqwd.dep_it in
+  let num = seq.size+1 in
+  let left = Fmap.add f num seq.left in
+  let cnx,right=
+    try
+      let l=Fmap.find f seq.right in
+	List.fold_right (fun (i,f0) l0 -> (num,i,f,f0)::l0) l seq.cnx,
+	Fmap.remove f seq.right
+    with Not_found -> seq.cnx,seq.right in
+  let nseq=
+    match f with
+	Bot -> 
+	  {seq with 
+	     left=left;
+	     right=right;
+	     size=num;
+	     abs=Some num;
+	     cnx=cnx}
+      | Atom _ ->
+	  {seq with 
+	     size=num;
+	     left=left;
+	     right=right;
+	     cnx=cnx}
+      | Conjunct (_,_) | Disjunct (_,_) ->
+	  {seq with
+	     rev_hyps=Intmap.add num f seq.rev_hyps; 
+	     size=num;
+	     left=left;
+	     right=right;
+	     cnx=cnx}
+      | Arrow (f1,f2) ->
+	  let ncnx,nright=
+	    try 
+	      let i = Fmap.find f1 seq.left in	  
+		(i,num,f1,f2)::cnx,right
+	    with Not_found ->
+	      cnx,(add_one_arrow num f1 f2 right) in
+	    match f1 with
+		Conjunct (_,_) | Disjunct (_,_) ->
+		  {seq with
+		     rev_hyps=Intmap.add num f seq.rev_hyps; 
+		     size=num;
+		     left=left;
+		     right=nright;
+		     cnx=ncnx}
+	      | Arrow(_,_) ->
+		  {seq with
+		     norev_hyps=Intmap.add num f seq.norev_hyps; 
+		     size=num;
+		     left=left;
+		     right=nright;
+		     cnx=ncnx}
+	      | _ -> 
+		  {seq with
+		     size=num;
+		     left=left;
+		     right=nright;
+		     cnx=ncnx} in
+    {seqwd with 
+       dep_it=nseq;
+       dep_hyps=Intset.add num seqwd.dep_hyps}
+
+exception Here_is of (int*form)
+
+let choose m= 
+  try 
+    Intmap.iter (fun i f -> raise (Here_is (i,f))) m;
+    raise Not_found
+  with 
+      Here_is (i,f) -> (i,f)
+
+
+let search_or seq=
+  match seq.gl with
+      Disjunct (f1,f2) -> 
+	[{dep_it = SI_Or_l;
+	  dep_goal = true;
+	  dep_hyps = Intset.empty},
+	 [change_goal (embed seq) f1];
+	 {dep_it = SI_Or_r;
+	  dep_goal = true;
+	  dep_hyps = Intset.empty},
+	 [change_goal (embed seq) f2]]
+    | _ -> []
+
+let search_norev seq=
+  let goals=ref (search_or seq) in
+  let add_one i f= 
+    match f with
+	Arrow (Arrow (f1,f2),f3) ->
+	  let nseq = 
+	    {seq with norev_hyps=Intmap.remove i seq.norev_hyps} in
+	    goals:=
+	      ({dep_it=SD_Arrow(i);
+		dep_goal=false;
+		dep_hyps=Intset.singleton i},
+	       [add_hyp 
+		  (add_hyp 
+		     (change_goal (embed nseq) f2) 
+		     (Arrow(f2,f3))) 
+		  f1;
+		add_hyp (embed nseq) f3]):: !goals
+      | _ -> anomaly "search_no_rev: can't happen" in
+    Intmap.iter add_one seq.norev_hyps;
+    List.rev !goals
+
+let search_in_rev_hyps seq=
+  try 
+    let i,f=choose seq.rev_hyps in
+    let make_step step=
+      {dep_it=step;
+       dep_goal=false;
+       dep_hyps=Intset.singleton i} in
+    let nseq={seq with rev_hyps=Intmap.remove i seq.rev_hyps} in
+      match f with
+	  Conjunct (f1,f2) -> 
+	    [make_step (SE_And(i)),
+	     [add_hyp (add_hyp (embed nseq) f1) f2]]
+	| Disjunct (f1,f2) ->
+	    [make_step (SE_Or(i)),
+	     [add_hyp (embed nseq) f1;add_hyp (embed nseq) f2]]
+	| Arrow (Conjunct (f1,f2),f0) -> 
+	    [make_step (SD_And(i)),
+	     [add_hyp (embed nseq) (Arrow (f1,Arrow (f2,f0)))]]
+	| Arrow (Disjunct (f1,f2),f0) ->
+	    [make_step (SD_Or(i)),
+	     [add_hyp (add_hyp (embed nseq) (Arrow(f1,f0))) (Arrow (f2,f0))]]
+	| _ -> anomaly "search_in_rev_hyps: can't happen"	      
+  with
+      Not_found -> search_norev seq
+ 
+let search_rev seq=
+  match seq.cnx with
+      (i,j,f1,f2)::next -> 
+	let nseq=
+	  match f1 with
+	      Conjunct (_,_) | Disjunct (_,_) ->
+		{seq with cnx=next;
+		   rev_hyps=Intmap.remove j seq.rev_hyps}
+	    | Arrow (_,_) ->
+		{seq with cnx=next;
+		   norev_hyps=Intmap.remove j seq.norev_hyps}
+	    | _ ->
+		{seq with cnx=next} in
+	  [{dep_it=SE_Arrow(i,j);
+	    dep_goal=false;
+	    dep_hyps=Intset.add i (Intset.singleton j)},
+	   [add_hyp (embed nseq) f2]]
+    | [] -> 
+	match seq.gl with
+	    Arrow (f1,f2) ->
+	      [{dep_it=SI_Arrow;
+		dep_goal=true;
+		dep_hyps=Intset.empty},
+	       [add_hyp (change_goal (embed seq) f2) f1]]
+	  | Conjunct (f1,f2) ->
+	      [{dep_it=SI_And;
+		dep_goal=true;
+		dep_hyps=Intset.empty},[change_goal (embed seq) f1;
+					change_goal (embed seq) f2]]
+	  | _ -> search_in_rev_hyps seq
+
+let search_all seq=
+  match seq.abs with
+      Some i -> 
+	[{dep_it=SE_False (i);
+	  dep_goal=false;
+	  dep_hyps=Intset.singleton i},[]]
+    | None ->
+	try 
+	  let ax = Fmap.find seq.gl seq.left in
+	    [{dep_it=SAx (ax);
+	      dep_goal=true;
+	      dep_hyps=Intset.singleton ax},[]]
+	with Not_found -> search_rev seq
+
+let bare_sequent = embed 
+		     {rev_hyps=Intmap.empty;
+		      norev_hyps=Intmap.empty;
+		      size=0;
+		      left=Fmap.empty;
+		      right=Fmap.empty;
+		      cnx=[];
+		      abs=None;
+		      gl=Bot}
+		     
+let init_state hyps gl=
+  let init = change_goal bare_sequent gl in
+  let goal=List.fold_right (fun (_,f,_) seq ->add_hyp seq f) hyps init in
+    Incomplete (goal.dep_it,[])
+
+let success= function
+    Complete _ -> true
+  | Incomplete (_,_) -> false
+
+let branching = function
+    Incomplete (seq,stack) ->
+      check_for_interrupt ();
+      let successors = search_all seq in
+      let _ =
+	match successors with
+	    [] -> s_info.branch_failures<-s_info.branch_failures+1
+	  | _::next ->  
+	      s_info.nd_branching<-s_info.nd_branching+List.length next in
+	List.map (append stack) successors
+  | Complete prf -> anomaly "already succeeded"
+
+open Pp 
+
+let rec pp_form =
+  function
+      Arrow(f1,f2) -> (pp_or f1) ++ (str " -> ") ++ (pp_form f2)
+    | f -> pp_or f
+and pp_or = function
+    Disjunct(f1,f2) ->
+      (pp_or f1) ++ (str " \\/ ") ++ (pp_and f2)
+  | f -> pp_and f
+and pp_and = function
+    Conjunct(f1,f2) ->
+      (pp_and f1) ++ (str " /\\ ") ++ (pp_atom f2)
+  | f -> pp_atom f
+and pp_atom= function
+    Bot -> str "#"
+  | Atom n -> int n
+  | f -> str "(" ++ hv 2 (pp_form f) ++ str ")" 
+
+let pr_form f = msg (pp_form f)
+
+let pp_intmap map = 
+  let pp=ref (str "") in  
+   Intmap.iter (fun i obj -> pp:= (!pp ++ 
+		pp_form obj ++ cut ())) map;
+    str "{ " ++ v 0 (!pp) ++ str " }"
+
+let pp_list pp_obj l=
+let pp=ref (str "") in
+  List.iter (fun o -> pp := !pp ++ (pp_obj o) ++ str ", ") l;
+  str "[ " ++ !pp ++ str "]"
+
+let pp_mapint map =
+  let pp=ref (str "") in  
+   Fmap.iter (fun obj l -> pp:= (!pp ++ 
+		pp_form obj ++ str " => " ++ 
+				 pp_list (fun (i,f) -> pp_form f) l ++ 
+				 cut ()) ) map;
+    str "{ " ++ vb 0 ++  (!pp) ++ str " }" ++ close ()
+
+let pp_connect (i,j,f1,f2) = pp_form f1 ++ str " => " ++ pp_form f2
+
+let pp_gl gl= cut () ++
+  str "{ " ++ vb 0 ++ 
+	      begin
+		match gl.abs with
+		    None -> str ""
+		  | Some i -> str "ABSURD" ++ cut ()
+	      end ++
+  str "rev   =" ++ pp_intmap gl.rev_hyps ++ cut () ++
+  str "norev =" ++ pp_intmap gl.norev_hyps ++ cut () ++
+  str "arrows=" ++ pp_mapint gl.right ++ cut () ++ 
+  str "cnx   =" ++ pp_list pp_connect gl.cnx ++ cut () ++ 
+  str "goal  =" ++ pp_form gl.gl ++ str " }" ++ close ()
+
+let pp = 
+  function
+      Incomplete(gl,ctx) -> msgnl (pp_gl gl)
+    | _ -> msg (str "<complete>")
+
+let pp_info () = 
+  let count_info = 
+    if !pruning then
+	str "Proof steps : " ++ 
+	int s_info.created_steps ++ str " created / " ++ 
+	int s_info.pruned_steps ++ str " pruned" ++ fnl () ++
+	str "Proof branches : " ++ 
+	int s_info.created_branches ++ str " created / " ++ 
+	int s_info.pruned_branches ++ str " pruned" ++ fnl () ++
+	str "Hypotheses : " ++ 
+	int s_info.created_hyps ++ str " created / " ++ 
+	int s_info.pruned_hyps ++ str " pruned" ++ fnl ()
+    else
+	str "Pruning is off" ++ fnl () ++
+	str "Proof steps : " ++ 
+	int s_info.created_steps ++ str " created" ++ fnl () ++
+	str "Proof branches : " ++ 
+	int s_info.created_branches ++ str " created" ++ fnl () ++
+	str "Hypotheses : " ++ 
+	int s_info.created_hyps ++ str " created" ++ fnl () in
+    msgnl
+      ( str "Proof-search statistics :" ++ fnl () ++
+	count_info ++ 
+	str "Branch ends: " ++
+	int s_info.branch_successes ++ str " successes / " ++
+	int s_info.branch_failures ++ str " failures" ++ fnl () ++
+	str "Non-deterministic choices : " ++
+	int s_info.nd_branching ++ str " branches")
+
+
+ 
diff --git a/contrib/rtauto/proof_search.mli b/contrib/rtauto/proof_search.mli
new file mode 100644
index 00000000..eb11aeae
--- /dev/null
+++ b/contrib/rtauto/proof_search.mli
@@ -0,0 +1,49 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* $Id: proof_search.mli 7233 2005-07-15 12:34:56Z corbinea $ *)
+
+type form=
+    Atom of int
+  | Arrow of form * form
+  | Bot 
+  | Conjunct of form * form
+  | Disjunct of form * form
+  
+type proof =
+    Ax of int
+  | I_Arrow of proof
+  | E_Arrow of int*int*proof
+  | D_Arrow of int*proof*proof
+  | E_False of int
+  | I_And of proof*proof
+  | E_And of int*proof
+  | D_And of int*proof
+  | I_Or_l of proof
+  | I_Or_r of proof
+  | E_Or of int*proof*proof
+  | D_Or of int*proof
+  | Pop of int*proof
+
+type state
+
+val project: state -> proof
+
+val init_state : ('a * form * 'b)  list -> form -> state
+
+val branching: state -> state list
+
+val success: state -> bool
+
+val pp: state -> unit
+
+val pr_form : form -> unit
+
+val reset_info : unit -> unit
+
+val pp_info : unit -> unit
diff --git a/contrib/rtauto/refl_tauto.ml b/contrib/rtauto/refl_tauto.ml
new file mode 100644
index 00000000..445dead2
--- /dev/null
+++ b/contrib/rtauto/refl_tauto.ml
@@ -0,0 +1,338 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* $Id: refl_tauto.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
+
+module Search = Explore.Make(Proof_search)
+
+open Util
+open Term
+open Termops
+open Names
+open Evd
+open Tacmach
+open Proof_search
+
+let force count lazc = incr count;Lazy.force lazc 
+
+let step_count = ref 0
+
+let node_count = ref 0  
+
+let logic_constant = 
+  Coqlib.gen_constant "refl_tauto" ["Init";"Logic"] 
+
+let li_False = lazy (destInd (logic_constant "False"))
+let li_and = lazy (destInd (logic_constant "and"))
+let li_or =  lazy (destInd (logic_constant "or"))
+
+let data_constant =
+  Coqlib.gen_constant "refl_tauto" ["Init";"Datatypes"] 
+
+let l_true_equals_true = 
+  lazy (mkApp(logic_constant "refl_equal", 
+        [|data_constant "bool";data_constant "true"|]))
+
+let pos_constant =
+  Coqlib.gen_constant "refl_tauto" ["NArith";"BinPos"]
+
+let l_xI = lazy (pos_constant "xI")
+let l_xO = lazy (pos_constant "xO")
+let l_xH = lazy (pos_constant "xH")
+
+let store_constant = 
+  Coqlib.gen_constant "refl_tauto" ["rtauto";"Bintree"]
+
+let l_empty = lazy (store_constant "empty")
+let l_push = lazy (store_constant "push")
+
+let constant=
+  Coqlib.gen_constant "refl_tauto" ["rtauto";"Rtauto"]
+
+let l_Reflect = lazy (constant "Reflect")
+
+let l_Atom = lazy (constant "Atom")
+let l_Arrow = lazy (constant "Arrow")
+let l_Bot = lazy (constant "Bot")
+let l_Conjunct = lazy (constant "Conjunct")
+let l_Disjunct = lazy (constant "Disjunct")
+
+let l_Ax = lazy (constant "Ax")
+let l_I_Arrow = lazy (constant "I_Arrow")
+let l_E_Arrow = lazy (constant "E_Arrow")
+let l_D_Arrow = lazy (constant "D_Arrow")
+let l_E_False = lazy (constant "E_False")
+let l_I_And = lazy (constant "I_And")
+let l_E_And = lazy (constant "E_And")
+let l_D_And = lazy (constant "D_And")
+let l_I_Or_l = lazy (constant "I_Or_l")
+let l_I_Or_r = lazy (constant "I_Or_r")
+let l_E_Or = lazy (constant "E_Or")
+let l_D_Or = lazy (constant "D_Or")
+
+
+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))
+
+type atom_env=
+    {mutable next:int;
+     mutable env:(constr*int) list}
+
+let make_atom atom_env term=
+  try
+    let (_,i)=
+      List.find (fun (t,_)-> eq_constr term t) atom_env.env
+    in Atom i
+  with Not_found ->
+    let i=atom_env.next in
+      atom_env.env <- (term,i)::atom_env.env;
+      atom_env.next<- i + 1;
+      Atom i
+
+let rec make_form atom_env gls term =
+  let normalize=special_nf gls in
+  let cciterm=special_whd gls term  in
+    match kind_of_term cciterm with
+	Prod(_,a,b) -> 
+	  if not (dependent (mkRel 1) b) && 
+	    Retyping.get_sort_family_of 
+	    (pf_env gls) (Tacmach.project gls) a = InProp
+	  then 
+	    let fa=make_form atom_env gls a in
+	    let fb=make_form atom_env gls b in
+	      Arrow (fa,fb)
+	  else
+	    make_atom atom_env (normalize term)
+      | Cast(a,_,_) -> 
+	  make_form atom_env gls a
+      | Ind ind ->
+	  if ind = Lazy.force li_False then
+	    Bot
+	  else
+	    make_atom atom_env (normalize term)
+      | App(hd,argv) when Array.length argv = 2 ->
+	  begin
+	    try 
+	      let ind = destInd hd in
+		if ind = Lazy.force li_and then
+		  let fa=make_form atom_env gls argv.(0) in
+		  let fb=make_form atom_env gls argv.(1) in
+		    Conjunct (fa,fb)
+		else if ind = Lazy.force li_or then
+		  let fa=make_form atom_env gls argv.(0) in
+		  let fb=make_form atom_env gls argv.(1) in
+		    Disjunct (fa,fb)
+		else make_atom atom_env (normalize term)
+	    with Invalid_argument _ -> make_atom atom_env (normalize term)
+	  end
+      | _ -> make_atom atom_env (normalize term)
+
+let rec make_hyps atom_env gls lenv = function
+    [] -> []
+  | (_,Some body,typ)::rest -> 
+      make_hyps atom_env gls (typ::body::lenv) rest  
+  | (id,None,typ)::rest ->
+      let hrec=
+	make_hyps atom_env gls (typ::lenv) rest in
+	if List.exists (dependent (mkVar id)) lenv || 
+	  (Retyping.get_sort_family_of 
+	     (pf_env gls) (Tacmach.project gls) typ <> InProp) 
+	then
+	  hrec 
+	else
+	  (id,make_form atom_env gls typ)::hrec
+
+let rec build_pos n =
+  if n<=1 then force node_count l_xH 
+  else if n land 1 = 0 then 
+    mkApp (force node_count l_xO,[|build_pos (n asr 1)|])
+  else 
+    mkApp (force node_count l_xI,[|build_pos (n asr 1)|])
+
+let rec build_form = function
+    Atom n -> mkApp (force node_count l_Atom,[|build_pos n|])
+  | Arrow (f1,f2) -> 
+      mkApp (force node_count l_Arrow,[|build_form f1;build_form f2|])
+  | Bot -> force node_count l_Bot
+  | Conjunct (f1,f2) -> 
+      mkApp (force node_count l_Conjunct,[|build_form f1;build_form f2|])
+  | Disjunct (f1,f2) -> 
+      mkApp (force node_count l_Disjunct,[|build_form f1;build_form f2|])
+
+let rec decal k = function 
+    [] -> k
+  | (start,delta)::rest -> 
+      if k>start then
+	k - delta
+      else 
+	decal k rest
+
+let add_pop size d pops=
+  match pops with
+      [] -> [size+d,d]
+    | (_,sum)::_ -> (size+sum,sum+d)::pops  
+
+let rec build_proof pops size = 
+  function
+      Ax i ->
+	mkApp (force step_count l_Ax,
+	       [|build_pos (decal i pops)|])
+      | I_Arrow p -> 
+	  mkApp (force step_count l_I_Arrow,
+		 [|build_proof pops (size + 1) p|])
+      | E_Arrow(i,j,p) -> 
+	  mkApp (force step_count l_E_Arrow, 
+		 [|build_pos (decal i pops);
+		   build_pos (decal j pops);
+		   build_proof pops (size + 1) p|])
+      | D_Arrow(i,p1,p2) -> 
+	  mkApp (force step_count l_D_Arrow, 
+		 [|build_pos (decal i pops);
+		   build_proof pops (size + 2) p1;
+		   build_proof pops (size + 1) p2|])
+      | E_False i -> 
+	  mkApp (force step_count l_E_False,
+		 [|build_pos (decal i pops)|])
+      | I_And(p1,p2) -> 
+	  mkApp (force step_count l_I_And, 
+		 [|build_proof pops size p1;
+		   build_proof pops size p2|])
+      | E_And(i,p) -> 
+	  mkApp (force step_count l_E_And,
+		 [|build_pos (decal i pops);
+		   build_proof pops (size + 2) p|])
+      | D_And(i,p) -> 
+	  mkApp (force step_count l_D_And,
+		 [|build_pos (decal i pops);
+		   build_proof pops (size + 1) p|])
+      | I_Or_l(p) -> 
+	  mkApp (force step_count l_I_Or_l,
+		 [|build_proof pops size p|])
+      | I_Or_r(p) -> 
+	  mkApp (force step_count l_I_Or_r,
+		 [|build_proof pops size p|])
+      | E_Or(i,p1,p2) ->
+	  mkApp (force step_count l_E_Or, 
+		 [|build_pos (decal i pops);
+		   build_proof pops (size + 1) p1;
+		   build_proof pops (size + 1) p2|])
+      | D_Or(i,p) -> 
+	  mkApp (force step_count l_D_Or,
+		 [|build_pos (decal i pops);
+		   build_proof pops (size + 2) p|])
+      | Pop(d,p) ->
+	  build_proof (add_pop size d pops) size p 
+	    
+let build_env gamma=
+  List.fold_right (fun (p,_) e -> 
+		     mkApp(force node_count l_push,[|mkProp;p;e|])) 
+    gamma.env (mkApp (force node_count l_empty,[|mkProp|]))
+
+open Goptions
+
+let verbose = ref false
+
+let opt_verbose=
+  {optsync=true;
+   optname="Rtauto Verbose";
+   optkey=SecondaryTable("Rtauto","Verbose");
+   optread=(fun () -> !verbose);
+   optwrite=(fun b -> verbose:=b)}
+
+let _ = declare_bool_option opt_verbose 
+
+let check = ref false
+
+let opt_check=
+  {optsync=true;
+   optname="Rtauto Check";
+   optkey=SecondaryTable("Rtauto","Check");
+   optread=(fun () -> !check);
+   optwrite=(fun b -> check:=b)}
+
+let _ = declare_bool_option opt_check 
+
+open Pp
+
+let rtauto_tac gls=
+  Coqlib.check_required_library ["Coq";"rtauto";"Rtauto"];
+  let gamma={next=1;env=[]} in
+  let gl=gls.it.evar_concl in
+  let _=
+    if Retyping.get_sort_family_of 
+      (pf_env gls) (Tacmach.project gls) gl <> InProp 
+    then errorlabstrm "rtauto" (Pp.str "goal should be in Prop") in
+  let glf=make_form gamma gls gl in
+  let hyps=make_hyps gamma gls [gl] 
+      (Environ.named_context_of_val gls.it.evar_hyps) in
+  let formula=
+    List.fold_left (fun gl (_,f)-> Arrow (f,gl)) glf hyps in  
+  let search_fun = 
+    if Tacinterp.get_debug()=Tactic_debug.DebugOn 0 then
+      Search.debug_depth_first
+    else 
+      Search.depth_first in
+  let _ = 
+    begin
+      reset_info ();
+      if !verbose then
+	msgnl (str "Starting proof-search ...");
+    end in
+  let search_start_time = System.get_time () in
+  let prf = 
+    try project (search_fun (init_state [] formula)) 
+    with Not_found ->
+      errorlabstrm "rtauto" (Pp.str "rtauto could'nt find any proof") in
+  let search_end_time = System.get_time () in
+  let _ = if !verbose then
+    begin
+      msgnl (str "Proof tree found in " ++ 
+	     System.fmt_time_difference search_start_time search_end_time);
+      pp_info ();
+      msgnl (str "Building proof term ... ")
+    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;
+		      build_proof [] 0 prf|]) in
+  let term=
+    Term.applist (main,List.rev_map (fun (id,_) -> mkVar id) hyps) in
+  let build_end_time=System.get_time () in
+  let _ = if !verbose then
+    begin
+      msgnl (str "Proof term built in " ++ 
+	     System.fmt_time_difference build_start_time build_end_time ++
+	     fnl () ++
+	     str "Proof size : " ++ int !step_count ++ 
+	     str " steps" ++ fnl () ++
+	     str "Proof term size : " ++ int (!step_count+ !node_count) ++
+	     str " nodes (constants)" ++ fnl () ++
+	     str "Giving proof term to Coq ... ")
+    end in
+  let tac_start_time = System.get_time () in
+  let result=
+    if !check then 
+      Tactics.exact_check term gls
+    else
+      Tactics.exact_no_check term gls in
+  let tac_end_time = System.get_time () in
+  let _ = 
+    if !check then msgnl (str "Proof term type-checking is on");
+    if !verbose then
+      msgnl (str "Internal tactic executed in " ++ 
+	     System.fmt_time_difference tac_start_time tac_end_time) in
+    result
+
diff --git a/contrib7/fourier/Fourier.v b/contrib/rtauto/refl_tauto.mli
index 740bbef6..480dbb30 100644
--- a/contrib7/fourier/Fourier.v
+++ b/contrib/rtauto/refl_tauto.mli
@@ -5,24 +5,22 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
+(* $Id: refl_tauto.mli 7233 2005-07-15 12:34:56Z corbinea $ *)
 
-(* $Id: Fourier.v,v 1.1.2.1 2004/07/16 19:30:17 herbelin Exp $ *)
+(* raises Not_found if no proof is found *)
 
-(* "Fourier's method to solve linear inequations/equations systems.".*)
+type atom_env=
+    {mutable next:int;
+     mutable env:(Term.constr*int) list}
 
-Declare ML Module "quote".
-Declare ML Module "ring".
-Declare ML Module "fourier".
-Declare ML Module "fourierR".
-Declare ML Module "field".
+val make_form : atom_env ->
+    Proof_type.goal Tacmach.sigma -> Term.types -> Proof_search.form
 
-Require Export Fourier_util.
-Require Export Field.
-Require Export DiscrR.
-
-Tactic Definition Fourier  :=
-  Abstract (FourierZ;Field;DiscrR).
-
-Tactic Definition FourierEq  :=
-  Apply Rge_ge_eq ; Fourier.
+val make_hyps :
+    atom_env ->
+    Proof_type.goal Tacmach.sigma ->
+    Term.types list ->
+    (Names.identifier * Term.types option * Term.types) list ->
+    (Names.identifier * Proof_search.form) list
 
+val rtauto_tac : Proof_type.tactic
diff --git a/contrib/setoid_ring/BinList.v b/contrib/setoid_ring/BinList.v
new file mode 100644
index 00000000..0def087f
--- /dev/null
+++ b/contrib/setoid_ring/BinList.v
@@ -0,0 +1,101 @@
+Set Implicit Arguments.
+Require Import BinPos.
+Open Scope positive_scope.
+
+
+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 :=
+  match p with
+  | xH => tl l
+  | xO p => jump p (jump p l)
+  | xI p  => jump p (jump p (tl l))
+  end.
+
+ Fixpoint nth (p:positive) (l:list) {struct p} : A:=
+  match p with
+  | xH => hd l
+  | xO p => nth p (jump p l)
+  | xI p => nth p (jump p (tl 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).
+ Proof. 
+  induction j;simpl;intros.
+  repeat rewrite IHj;trivial.
+  repeat rewrite IHj;trivial.
+  trivial.
+ Qed.
+
+ Lemma jump_Psucc : forall j l, 
+  (jump (Psucc j) l) = (jump 1 (jump j l)).
+ Proof.
+  induction j;simpl;intros.
+  repeat rewrite IHj;simpl;repeat rewrite jump_tl;trivial.
+  repeat rewrite jump_tl;trivial.
+  trivial.
+ Qed.
+
+ Lemma jump_Pplus : forall i j l, 
+  (jump (i + j) l) = (jump i (jump j l)).
+ Proof.
+  induction i;intros.
+  rewrite xI_succ_xO;rewrite Pplus_one_succ_r.
+  rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
+  repeat rewrite IHi.
+  rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite jump_Psucc;trivial.
+  rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
+  repeat rewrite IHi;trivial.
+  rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite jump_Psucc;trivial.
+ Qed.
+
+ Lemma jump_Pdouble_minus_one : forall i l,
+  (jump (Pdouble_minus_one i) (tl l)) = (jump i (jump i l)).
+ Proof.
+  induction i;intros;simpl.
+  repeat rewrite jump_tl;trivial.
+  rewrite IHi. do 2 rewrite <- jump_tl;rewrite IHi;trivial.
+  trivial.
+ Qed.
+
+ 
+ Lemma nth_jump : forall p l, nth p (tl l) = hd (jump p l).
+ Proof.
+  induction p;simpl;intros.
+  rewrite <-jump_tl;rewrite IHp;trivial.
+  rewrite <-jump_tl;rewrite IHp;trivial.
+  trivial.
+ Qed.
+
+ Lemma nth_Pdouble_minus_one :
+  forall p l, nth (Pdouble_minus_one p) (tl l) = nth p (jump p l).
+ Proof.
+  induction p;simpl;intros.
+  repeat rewrite jump_tl;trivial.
+  rewrite jump_Pdouble_minus_one.
+  repeat rewrite <- jump_tl;rewrite IHp;trivial.
+  trivial.
+ Qed.
+
+End LIST.
diff --git a/contrib/setoid_ring/Pol.v b/contrib/setoid_ring/Pol.v
new file mode 100644
index 00000000..2bf2574f
--- /dev/null
+++ b/contrib/setoid_ring/Pol.v
@@ -0,0 +1,1195 @@
+Set Implicit Arguments.
+Require Import Setoid.
+Require Export BinList.
+Require Import BinPos.
+Require Import BinInt.
+Require Export Ring_th.
+
+Section MakeRingPol.
+ 
+ (* Ring elements *)     
+ Variable R:Type.
+ Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R->R).
+ Variable req : R -> R -> Prop.
+ 
+ (* Ring properties *)
+ Variable Rsth : Setoid_Theory R req.
+ Variable Reqe : ring_eq_ext radd rmul ropp req.
+ Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req.
+
+ (* Coefficients *) 
+ Variable C: Type.
+ Variable (cO cI: C) (cadd cmul csub : C->C->C) (copp : C->C).
+ Variable ceqb : C->C->bool. 
+ Variable phi : C -> R.
+ Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req
+                                cO cI cadd cmul csub copp ceqb phi.
+
+
+ (* R notations *)
+ Notation "0" := rO. Notation "1" := rI.
+ Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
+ Notation "x - y " := (rsub x y). Notation "- x" := (ropp x).
+ Notation "x == y" := (req x y).
+
+ (* C notations *)		 
+ Notation "x +! y" := (cadd x y). Notation "x *! y " := (cmul x y).
+ Notation "x -! y " := (csub x y). Notation "-! x" := (copp x).
+ Notation " x ?=! y" := (ceqb x y). Notation "[ x ]" := (phi x).
+
+ (* Usefull tactics *)		  
+  Add Setoid R req Rsth as R_set1.
+ Ltac rrefl := gen_reflexivity Rsth.
+  Add Morphism radd : radd_ext.  exact (Radd_ext Reqe). Qed.
+  Add Morphism rmul : rmul_ext.  exact (Rmul_ext Reqe). Qed.
+  Add Morphism ropp : ropp_ext.  exact (Ropp_ext Reqe). Qed.
+  Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
+ Ltac rsimpl := gen_srewrite 0 1 radd rmul rsub ropp req Rsth Reqe ARth.
+ Ltac add_push := gen_add_push radd Rsth Reqe ARth.
+ Ltac mul_push := gen_mul_push rmul Rsth Reqe ARth.
+
+ (* Definition of multivariable polynomials with coefficients in C :
+    Type [Pol] represents [X1 ... Xn].
+    The representation is Horner's where a [n] variable polynomial
+    (C[X1..Xn]) is seen as a polynomial on [X1] which coefficients
+    are polynomials with [n-1] variables (C[X2..Xn]).
+    There are several optimisations to make the repr compacter:
+    - [Pc c] is the constant polynomial of value c
+       == c*X1^0*..*Xn^0
+    - [Pinj j Q] is a polynomial constant w.r.t the [j] first variables.
+        variable indices are shifted of j in Q.
+       == X1^0 *..* Xj^0 * Q{X1 <- Xj+1;..; Xn-j <- Xn}
+    - [PX P i Q] is an optimised Horner form of P*X^i + Q
+        with P not the null polynomial
+       == P * X1^i + Q{X1 <- X2; ..; Xn-1 <- Xn}
+
+    In addition:
+    - polynomials of the form (PX (PX P i (Pc 0)) j Q) are forbidden
+      since they can be represented by the simpler form (PX P (i+j) Q)
+    - (Pinj i (Pinj j P)) is (Pinj (i+j) P)
+    - (Pinj i (Pc c)) is (Pc c)
+ *)
+
+ Inductive Pol : Type :=
+  | Pc : C -> Pol 
+  | Pinj : positive -> Pol -> Pol                   
+  | PX : Pol -> positive -> Pol -> Pol.
+
+ Definition P0 := Pc cO.
+ Definition P1 := Pc cI.
+ 
+ Fixpoint Peq (P P' : Pol) {struct P'} : bool := 
+  match P, P' with
+  | Pc c, Pc c' => c ?=! c'
+  | Pinj j Q, Pinj j' Q' => 
+    match Pcompare j j' Eq with
+    | Eq => Peq Q Q' 
+    | _ => false 
+    end
+  | PX P i Q, PX P' i' Q' =>
+    match Pcompare i i' Eq with
+    | Eq => if Peq P P' then Peq Q Q' else false
+    | _ => false
+    end
+  | _, _ => false
+  end.
+
+ Notation " P ?== P' " := (Peq P P').
+
+ Definition mkPinj j P :=
+  match P with 
+  | Pc _ => P
+  | Pinj j' Q => Pinj ((j + j'):positive) Q
+  | _ => Pinj j P
+  end.
+
+ Definition mkPX P i Q := 
+  match P with
+  | Pc c => if c ?=! cO then mkPinj xH Q else PX P i Q
+  | Pinj _ _ => PX P i Q
+  | PX P' i' Q' => if Q' ?== P0 then PX P' (i' + i) Q else PX P i Q
+  end.
+ 
+ (** Opposite of addition *)
+ 
+ Fixpoint Popp (P:Pol) : Pol := 
+  match P with
+  | Pc c => Pc (-! c)
+  | Pinj j Q => Pinj j (Popp Q)
+  | PX P i Q => PX (Popp P) i (Popp Q)
+  end.
+ 
+ Notation "-- P" := (Popp P).
+
+ (** Addition et subtraction *)
+ 
+ Fixpoint PaddC (P:Pol) (c:C) {struct P} : Pol :=
+  match P with
+  | Pc c1 => Pc (c1 +! c)
+  | Pinj j Q => Pinj j (PaddC Q c)
+  | PX P i Q => PX P i (PaddC Q c)
+  end.
+
+ Fixpoint PsubC (P:Pol) (c:C) {struct P} : Pol :=
+  match P with
+  | Pc c1 => Pc (c1 -! c)
+  | Pinj j Q => Pinj j (PsubC Q c)
+  | PX P i Q => PX P i (PsubC Q c)
+  end.
+
+ Section PopI.
+
+  Variable Pop : Pol -> Pol -> Pol.
+  Variable Q : Pol.
+
+  Fixpoint PaddI (j:positive) (P:Pol){struct P} : Pol :=
+   match P with
+   | Pc c => mkPinj j (PaddC Q c)
+   | Pinj j' Q' => 
+     match ZPminus j' j with
+     | Zpos k =>  mkPinj j (Pop (Pinj k Q') Q)
+     | Z0 => mkPinj j (Pop Q' Q)
+     | Zneg k => mkPinj j' (PaddI k Q')
+     end
+   | PX P i Q' => 
+     match j with
+     | xH => PX P i (Pop Q' Q)
+     | xO j => PX P i (PaddI (Pdouble_minus_one j) Q')
+     | xI j => PX P i (PaddI (xO j) Q')
+     end 
+   end.
+
+  Fixpoint PsubI (j:positive) (P:Pol){struct P} : Pol :=
+   match P with
+   | Pc c => mkPinj j (PaddC (--Q) c)
+   | Pinj j' Q' => 
+     match ZPminus j' j with
+     | Zpos k =>  mkPinj j (Pop (Pinj k Q') Q)
+     | Z0 => mkPinj j (Pop Q' Q)
+     | Zneg k => mkPinj j' (PsubI k Q')
+     end
+   | PX P i Q' => 
+     match j with
+     | xH => PX P i (Pop Q' Q)
+     | xO j => PX P i (PsubI (Pdouble_minus_one j) Q')
+     | xI j => PX P i (PsubI (xO j) Q')
+     end 
+   end.
+ 
+ Variable P' : Pol.
+ 
+ Fixpoint PaddX (i':positive) (P:Pol) {struct P} : Pol :=
+  match P with
+  | Pc c => PX P' i' P
+  | Pinj j Q' =>
+    match j with
+    | xH =>  PX P' i' Q'
+    | xO j => PX P' i' (Pinj (Pdouble_minus_one j) Q')
+    | xI j => PX P' i' (Pinj (xO j) Q')
+    end
+  | PX P i Q' =>
+    match ZPminus i i' with
+    | Zpos k => mkPX (Pop (PX P k P0) P') i' Q'
+    | Z0 => mkPX (Pop P P') i Q'
+    | Zneg k => mkPX (PaddX k P) i Q'
+    end
+  end.
+
+ Fixpoint PsubX (i':positive) (P:Pol) {struct P} : Pol :=
+  match P with
+  | Pc c => PX (--P') i' P
+  | Pinj j Q' =>
+    match j with
+    | xH =>  PX (--P') i' Q'
+    | xO j => PX (--P') i' (Pinj (Pdouble_minus_one j) Q')
+    | xI j => PX (--P') i' (Pinj (xO j) Q')
+    end
+  | PX P i Q' =>
+    match ZPminus i i' with
+    | Zpos k => mkPX (Pop (PX P k P0) P') i' Q'
+    | Z0 => mkPX (Pop P P') i Q'
+    | Zneg k => mkPX (PsubX k P) i Q'
+    end
+  end.
+
+    
+ End PopI.
+
+ Fixpoint Padd (P P': Pol) {struct P'} : Pol :=
+  match P' with
+  | Pc c' => PaddC P c'
+  | Pinj j' Q' => PaddI Padd Q' j' P
+  | PX P' i' Q' =>
+    match P with
+    | Pc c => PX P' i' (PaddC Q' c)
+    | Pinj j Q =>  
+      match j with
+      | xH => PX P' i' (Padd Q Q')
+      | xO j => PX P' i' (Padd (Pinj (Pdouble_minus_one j) Q) Q')
+      | xI j => PX P' i' (Padd (Pinj (xO j) Q) Q')
+      end 
+    | PX P i Q =>
+      match ZPminus i i' with
+      | Zpos k => mkPX (Padd (PX P k P0) P') i' (Padd Q Q')
+      | Z0 => mkPX (Padd P P') i (Padd Q Q')
+      | Zneg k => mkPX (PaddX Padd P' k P) i (Padd Q Q')
+      end
+    end
+  end.
+ Notation "P ++ P'" := (Padd P P').
+
+ Fixpoint Psub (P P': Pol) {struct P'} : Pol :=
+  match P' with
+  | Pc c' => PsubC P c'
+  | Pinj j' Q' => PsubI Psub Q' j' P
+  | PX P' i' Q' =>
+    match P with
+    | Pc c => PX (--P') i' (*(--(PsubC Q' c))*) (PaddC (--Q') c)
+    | Pinj j Q =>  
+      match j with
+      | xH => PX (--P') i' (Psub Q Q')
+      | xO j => PX (--P') i' (Psub (Pinj (Pdouble_minus_one j) Q) Q')
+      | xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q')
+      end 
+    | PX P i Q =>
+      match ZPminus i i' with
+      | Zpos k => mkPX (Psub (PX P k P0) P') i' (Psub Q Q')
+      | Z0 => mkPX (Psub P P') i (Psub Q Q')
+      | Zneg k => mkPX (PsubX Psub P' k P) i (Psub Q Q')
+      end
+    end
+  end.
+ Notation "P -- P'" := (Psub P P').
+ 
+ (** Multiplication *) 
+
+ Fixpoint PmulC_aux (P:Pol) (c:C) {struct P} : Pol :=
+  match P with
+  | Pc c' => Pc (c' *! c)
+  | Pinj j Q => mkPinj j (PmulC_aux Q c)
+  | PX P i Q => mkPX (PmulC_aux P c) i (PmulC_aux Q c)
+  end.
+
+ Definition PmulC P c :=
+  if c ?=! cO then P0 else
+  if c ?=! cI then P else PmulC_aux P c.
+ 
+ Section PmulI. 
+  Variable Pmul : Pol -> Pol -> Pol.
+  Variable Q : Pol.
+  Fixpoint PmulI (j:positive) (P:Pol) {struct P} : Pol :=
+   match P with
+   | Pc c => mkPinj j (PmulC Q c)
+   | Pinj j' Q' => 
+     match ZPminus j' j with
+     | Zpos k => mkPinj j (Pmul (Pinj k Q') Q)
+     | Z0 => mkPinj j (Pmul Q' Q)
+     | Zneg k => mkPinj j' (PmulI k Q')
+     end
+   | PX P' i' Q' =>
+     match j with
+     | xH => mkPX (PmulI xH P') i' (Pmul Q' Q)
+     | xO j' => mkPX (PmulI j P') i' (PmulI (Pdouble_minus_one j') Q')
+     | xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q')
+     end
+   end.
+ 
+ End PmulI.
+
+ Fixpoint Pmul_aux (P P' : Pol) {struct P'} : Pol :=
+  match P' with
+  | Pc c' => PmulC P c'
+  | Pinj j' Q' => PmulI Pmul_aux Q' j' P
+  | PX P' i' Q' => 
+     (mkPX (Pmul_aux P P') i' P0) ++ (PmulI Pmul_aux Q' xH P)
+  end.
+
+ Definition Pmul P P' :=
+  match P with
+  | Pc c => PmulC P' c
+  | Pinj j Q => PmulI Pmul_aux Q j P'
+  | PX P i Q => 
+    Padd (mkPX (Pmul_aux P P') i P0) (PmulI Pmul_aux Q xH P')
+  end.
+ Notation "P ** P'" := (Pmul P P').
+ 
+ (** Evaluation of a polynomial towards R *)
+
+ Fixpoint pow (x:R) (i:positive) {struct i}: R :=
+  match i with
+  | xH => x
+  | xO i => let p := pow x i in p * p
+  | xI i => let p := pow x i in x * p * p
+  end.
+
+ Fixpoint Pphi(l:list R) (P:Pol) {struct P} : R :=
+  match P with
+  | Pc c => [c]
+  | Pinj j Q => Pphi (jump j l) Q
+  | PX P i Q => 
+     let x := hd 0 l in
+     let xi := pow x i in
+    (Pphi l P) * xi + (Pphi (tl l) Q)      
+  end.
+
+ Reserved Notation "P @ l " (at level 10, no associativity).
+ Notation "P @ l " := (Pphi l P).
+ (** Proofs *)
+ Lemma ZPminus_spec : forall x y,
+  match ZPminus x y with
+  | Z0 => x = y
+  | Zpos k => x = (y + k)%positive
+  | Zneg k => y = (x + k)%positive
+  end.
+ Proof.
+  induction x;destruct y.
+  replace (ZPminus (xI x) (xI y)) with (Zdouble (ZPminus x y));trivial.
+  assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite H;trivial.
+  replace (ZPminus (xI x) (xO y)) with (Zdouble_plus_one (ZPminus x y));trivial.
+  assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble_plus_one;rewrite H;trivial.
+  apply Pplus_xI_double_minus_one.
+  simpl;trivial.
+  replace (ZPminus (xO x) (xI y)) with (Zdouble_minus_one (ZPminus x y));trivial.
+  assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble_minus_one;rewrite H;trivial.
+  apply Pplus_xI_double_minus_one.
+  replace (ZPminus (xO x) (xO y)) with (Zdouble (ZPminus x y));trivial.
+  assert (H := IHx y);destruct (ZPminus x y);unfold Zdouble;rewrite H;trivial.
+  replace (ZPminus (xO x) xH) with (Zpos (Pdouble_minus_one x));trivial.
+  rewrite <- Pplus_one_succ_l.
+  rewrite Psucc_o_double_minus_one_eq_xO;trivial.
+  replace (ZPminus xH (xI y)) with (Zneg (xO y));trivial.
+  replace (ZPminus xH (xO y)) with (Zneg (Pdouble_minus_one y));trivial.
+  rewrite <- Pplus_one_succ_l.
+  rewrite Psucc_o_double_minus_one_eq_xO;trivial.
+  simpl;trivial.
+ Qed.
+
+ Lemma pow_Psucc : forall x j, pow x (Psucc j) == x * pow x j.
+ Proof.
+  induction j;simpl;rsimpl.
+  rewrite IHj;rsimpl;mul_push x;rrefl.
+ Qed.
+
+ Lemma pow_Pplus : forall x i j, pow x (i + j) == pow x i * pow x j.
+ Proof.
+  intro x;induction i;intros.
+  rewrite xI_succ_xO;rewrite Pplus_one_succ_r.
+  rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
+  repeat rewrite IHi.
+  rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite pow_Psucc.
+  simpl;rsimpl.
+  rewrite <- Pplus_diag;repeat rewrite <- Pplus_assoc.
+  repeat rewrite IHi;rsimpl.
+  rewrite Pplus_comm;rewrite <- Pplus_one_succ_r;rewrite pow_Psucc;
+   simpl;rsimpl.
+ Qed.
+  
+ Lemma Peq_ok : forall P P', 
+    (P ?== P') = true -> forall l, P@l == P'@ l.
+ Proof.
+  induction P;destruct P';simpl;intros;try discriminate;trivial.
+  apply (morph_eq CRmorph);trivial.
+  assert (H1 := Pcompare_Eq_eq p p0); destruct ((p ?= p0)%positive Eq);
+   try discriminate H.
+  rewrite (IHP P' H); rewrite H1;trivial;rrefl.
+  assert (H1 := Pcompare_Eq_eq p p0); destruct ((p ?= p0)%positive Eq);
+   try discriminate H.
+  rewrite H1;trivial. clear H1.
+  assert (H1 := IHP1 P'1);assert (H2 := IHP2 P'2);
+   destruct (P2 ?== P'1);[destruct (P3 ?== P'2); [idtac|discriminate H]
+                         |discriminate H].
+  rewrite (H1 H);rewrite (H2 H);rrefl.
+ Qed.
+
+ Lemma Pphi0 : forall l, P0@l == 0.
+ Proof.
+  intros;simpl;apply (morph0 CRmorph).
+ Qed.
+
+ Lemma Pphi1 : forall l,  P1@l == 1.
+ Proof.
+  intros;simpl;apply (morph1 CRmorph).
+ Qed.
+
+ Lemma mkPinj_ok : forall j l P, (mkPinj j P)@l == P@(jump j l).
+ Proof.
+  intros j l p;destruct p;simpl;rsimpl.
+  rewrite <-jump_Pplus;rewrite Pplus_comm;rrefl.
+ Qed.
+
+ Lemma mkPX_ok : forall l P i Q, 
+  (mkPX P i Q)@l == P@l*(pow (hd 0 l) i) + Q@(tl l).
+ Proof.
+  intros l P i Q;unfold mkPX.
+  destruct P;try (simpl;rrefl).
+  assert (H := morph_eq CRmorph c cO);destruct (c ?=! cO);simpl;try rrefl.
+  rewrite (H (refl_equal true));rewrite (morph0 CRmorph).
+  rewrite mkPinj_ok;rsimpl;simpl;rrefl.
+  assert (H := @Peq_ok P3 P0);destruct (P3 ?== P0);simpl;try rrefl.
+  rewrite (H (refl_equal true));trivial.
+  rewrite Pphi0;rewrite pow_Pplus;rsimpl.
+ Qed.
+
+ Ltac Esimpl :=
+  repeat (progress (
+   match goal with
+   | |- context [P0@?l] => rewrite (Pphi0 l)
+   | |- context [P1@?l] => rewrite (Pphi1 l)
+   | |- context [(mkPinj ?j ?P)@?l] => rewrite (mkPinj_ok j l P)
+   | |- context [(mkPX ?P ?i ?Q)@?l] => rewrite (mkPX_ok l P i Q)
+   | |- context [[cO]] => rewrite (morph0 CRmorph)
+   | |- context [[cI]] => rewrite (morph1 CRmorph)
+   | |- context [[?x +! ?y]] => rewrite ((morph_add CRmorph) x y)
+   | |- context [[?x *! ?y]] => rewrite ((morph_mul CRmorph) x y)
+   | |- context [[?x -! ?y]] => rewrite ((morph_sub CRmorph) x y)
+   | |- context [[-! ?x]] => rewrite ((morph_opp CRmorph) x)
+   end));
+  rsimpl; simpl. 
+ 
+ Lemma PaddC_ok : forall c P l, (PaddC P c)@l == P@l + [c].
+ Proof.
+  induction P;simpl;intros;Esimpl;trivial.
+  rewrite IHP2;rsimpl.
+ Qed.
+
+ Lemma PsubC_ok : forall c P l, (PsubC P c)@l == P@l - [c].
+ Proof.
+  induction P;simpl;intros.
+  Esimpl.
+  rewrite IHP;rsimpl.
+  rewrite IHP2;rsimpl.
+ Qed.
+
+ Lemma PmulC_aux_ok : forall c P l, (PmulC_aux P c)@l == P@l * [c].
+ Proof.
+  induction P;simpl;intros;Esimpl;trivial.
+  rewrite IHP1;rewrite IHP2;rsimpl.
+  mul_push ([c]);rrefl.
+ Qed. 
+
+ Lemma PmulC_ok : forall c P l, (PmulC P c)@l == P@l * [c].
+ Proof.
+  intros c P l; unfold PmulC.
+  assert (H:= morph_eq CRmorph c cO);destruct (c ?=! cO).
+  rewrite (H (refl_equal true));Esimpl.
+  assert (H1:= morph_eq CRmorph c cI);destruct (c ?=! cI).
+  rewrite (H1 (refl_equal true));Esimpl.
+  apply PmulC_aux_ok.
+ Qed.
+
+ Lemma Popp_ok : forall P l, (--P)@l == - P@l.
+ Proof.
+  induction P;simpl;intros.
+  Esimpl.
+  apply IHP.
+  rewrite IHP1;rewrite IHP2;rsimpl.
+ Qed.
+
+ Ltac Esimpl2 :=
+  Esimpl;
+  repeat (progress (
+   match goal with 
+   | |- context [(PaddC ?P ?c)@?l] => rewrite (PaddC_ok c P l)
+   | |- context [(PsubC ?P ?c)@?l] => rewrite (PsubC_ok c P l)
+   | |- context [(PmulC ?P ?c)@?l] => rewrite (PmulC_ok c P l)
+   | |- context [(--?P)@?l] => rewrite (Popp_ok P l)
+   end)); Esimpl.
+
+ Lemma Padd_ok : forall P' P l, (P ++ P')@l == P@l + P'@l.
+ Proof.
+  induction P';simpl;intros;Esimpl2.
+  generalize P p l;clear P p l.
+  induction P;simpl;intros.
+  Esimpl2;apply (ARadd_sym ARth).
+  assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
+  rewrite H;Esimpl. rewrite IHP';rrefl.
+  rewrite H;Esimpl. rewrite IHP';Esimpl.
+  rewrite <- jump_Pplus;rewrite Pplus_comm;rrefl.
+  rewrite H;Esimpl. rewrite IHP.
+  rewrite <- jump_Pplus;rewrite Pplus_comm;rrefl.
+  destruct p0;simpl.
+  rewrite IHP2;simpl;rsimpl.
+  rewrite IHP2;simpl.
+  rewrite jump_Pdouble_minus_one;rsimpl.
+  rewrite IHP';rsimpl.
+  destruct P;simpl. 
+  Esimpl2;add_push [c];rrefl.
+  destruct p0;simpl;Esimpl2.
+  rewrite IHP'2;simpl.
+  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.
+  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.
+  rewrite IHP'1;rewrite IHP'2;simpl;Esimpl.
+  rewrite H;rewrite Pplus_comm.
+  rewrite pow_Pplus;rsimpl.
+  add_push (P3 @ (tl 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).
+    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;simpl;Esimpl.
+    rewrite H1;rewrite Pplus_comm.
+    rewrite pow_Pplus;simpl;Esimpl.
+    add_push (P5 @ (tl l0));rrefl.
+    rewrite IHP1;rewrite H1;rewrite Pplus_comm.
+    rewrite pow_Pplus;simpl;rsimpl.
+    add_push (P5 @ (tl l0));rrefl.
+  rewrite H0;rsimpl.
+  add_push (P3 @ (tl l)).
+  rewrite H;rewrite Pplus_comm.
+  rewrite IHP'2;rewrite pow_Pplus;rsimpl.
+  add_push (P3 @ (tl l));rrefl.
+ Qed.
+
+ Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l.
+ Proof.
+  induction P';simpl;intros;Esimpl2;trivial.
+  generalize P p l;clear P p l.
+  induction P;simpl;intros.
+  Esimpl2;apply (ARadd_sym ARth).
+  assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
+  rewrite H;Esimpl. rewrite IHP';rsimpl. 
+  rewrite H;Esimpl. rewrite IHP';Esimpl.
+  rewrite <- jump_Pplus;rewrite Pplus_comm;rrefl.
+  rewrite H;Esimpl. rewrite IHP.
+  rewrite <- jump_Pplus;rewrite Pplus_comm;rrefl.
+  destruct p0;simpl.
+  rewrite IHP2;simpl;rsimpl.
+  rewrite IHP2;simpl.
+  rewrite jump_Pdouble_minus_one;rsimpl.
+  rewrite IHP';rsimpl. 
+  destruct P;simpl. 
+  repeat rewrite Popp_ok;Esimpl2;rsimpl;add_push [c];try rrefl.
+  destruct p0;simpl;Esimpl2.
+  rewrite IHP'2;simpl;rsimpl;add_push (P'1@l * (pow (hd 0 l) p));trivial.
+  add_push (P @ (jump p0 (jump p0 (tl 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.
+  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.
+   rewrite IHP'1; rewrite IHP'2;rsimpl;simpl;Esimpl.
+  rewrite H;rewrite Pplus_comm.
+  rewrite pow_Pplus;rsimpl.
+  add_push (P3 @ (tl 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.
+   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.
+    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;rewrite H1;rewrite Pplus_comm.
+    rewrite pow_Pplus;simpl;Esimpl.
+    add_push (P5 @ (tl l0));rrefl.
+    rewrite IHP1;rewrite H1;rewrite Pplus_comm.
+    rewrite pow_Pplus;simpl;rsimpl.
+    add_push (P5 @ (tl l0));rrefl.
+  rewrite H0;rsimpl.
+  rewrite IHP'2;rsimpl;add_push (P3 @ (tl l)).
+  rewrite H;rewrite Pplus_comm.
+  rewrite pow_Pplus;rsimpl.
+ Qed.
+ 
+ Lemma PmulI_ok : 
+  forall P', 
+   (forall (P : Pol) (l : list R), (Pmul_aux P P') @ l == P @ l * P' @ l) ->
+   forall (P : Pol) (p : positive) (l : list R),
+    (PmulI Pmul_aux P' p P) @ l == P @ l * P' @ (jump p l).
+ Proof.
+  induction P;simpl;intros.
+  Esimpl2;apply (ARmul_sym ARth).
+  assert (H1 := ZPminus_spec p p0);destruct (ZPminus p p0);Esimpl2.
+  rewrite H1; rewrite H;rrefl.
+  rewrite H1; rewrite H.
+  rewrite Pplus_comm.
+  rewrite jump_Pplus;simpl;rrefl.
+  rewrite H1;rewrite Pplus_comm.
+  rewrite jump_Pplus;rewrite IHP;rrefl.
+  destruct p0;Esimpl2.
+  rewrite IHP1;rewrite IHP2;simpl;rsimpl.
+  mul_push (pow (hd 0 l) p);rrefl.
+  rewrite IHP1;rewrite IHP2;simpl;rsimpl.
+  mul_push (pow (hd 0 l) p); rewrite jump_Pdouble_minus_one;rrefl.
+  rewrite IHP1;simpl;rsimpl.
+  mul_push (pow (hd 0 l) p).
+  rewrite H;rrefl.
+ Qed.
+
+ Lemma Pmul_aux_ok : forall P' P l,(Pmul_aux P P')@l == P@l * P'@l.
+ Proof.
+  induction P';simpl;intros.
+  Esimpl2;trivial.
+  apply PmulI_ok;trivial.
+  rewrite Padd_ok;Esimpl2.
+  rewrite (PmulI_ok P'2 IHP'2). rewrite IHP'1. rrefl.
+ Qed.
+
+ Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
+ Proof.
+  destruct P;simpl;intros.
+  Esimpl2;apply (ARmul_sym ARth).
+  rewrite (PmulI_ok P (Pmul_aux_ok P)).
+  apply (ARmul_sym 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.
+ Qed.
+
+ (** Definition of polynomial expressions *)
+
+ Inductive PExpr : Type :=
+  | PEc : C -> PExpr
+  | PEX : positive -> PExpr
+  | PEadd : PExpr -> PExpr -> PExpr
+  | PEsub : PExpr -> PExpr -> PExpr
+  | PEmul : PExpr -> PExpr -> PExpr
+  | PEopp : PExpr -> PExpr.
+
+ (** normalisation towards polynomials *)
+ 
+ Definition X := (PX P1 xH P0).
+
+ Definition mkX j :=
+  match j with
+  | xH => X
+  | xO j => Pinj (Pdouble_minus_one j) X
+  | xI j => Pinj (xO j) X
+  end.
+
+ Fixpoint norm (pe:PExpr) : Pol :=
+  match pe with
+  | PEc c => Pc c
+  | PEX j => mkX j
+  | PEadd pe1 (PEopp pe2) => Psub (norm pe1) (norm pe2)
+  | PEadd (PEopp pe1) pe2 => Psub (norm pe2) (norm pe1)
+  | PEadd pe1 pe2 => Padd (norm pe1) (norm pe2)
+  | PEsub pe1 pe2 => Psub (norm pe1) (norm pe2)
+  | PEmul pe1 pe2 => Pmul (norm pe1) (norm pe2)
+  | PEopp pe1 => Popp (norm pe1)
+  end.
+
+ (** evaluation of polynomial expressions towards R *)
+ 
+ Fixpoint PEeval (l:list R) (pe:PExpr) {struct pe} : R :=
+  match pe with
+  | PEc c => phi c
+  | PEX j => nth 0 j l
+  | PEadd pe1 pe2 => (PEeval l pe1) + (PEeval l pe2)
+  | PEsub pe1 pe2 => (PEeval l pe1) - (PEeval l pe2)
+  | PEmul pe1 pe2 => (PEeval l pe1) * (PEeval l pe2)
+  | PEopp pe1 => - (PEeval l pe1)
+  end.
+
+ (** Correctness proofs *)
+ 
+
+ Lemma mkX_ok : forall p l, nth 0 p l == (mkX p) @ l.
+ Proof.
+  destruct p;simpl;intros;Esimpl;trivial.
+  rewrite <-jump_tl;rewrite nth_jump;rrefl.
+  rewrite <- nth_jump.
+  rewrite nth_Pdouble_minus_one;rrefl.
+ Qed.
+
+ Lemma norm_PEopp : forall l pe,  (norm (PEopp pe))@l == -(norm pe)@l.
+ Proof.
+  intros;simpl;apply Popp_ok.
+ Qed.
+
+ Ltac Esimpl3 := 
+  repeat match goal with
+  | |- context [(?P1 ++ ?P2)@?l] => rewrite (Padd_ok P2 P1 l)
+  | |- context [(?P1 -- ?P2)@?l] => rewrite (Psub_ok P2 P1 l)
+  | |- context [(norm (PEopp ?pe))@?l] => rewrite (norm_PEopp l pe)
+  end;Esimpl2;try rrefl;try apply (ARadd_sym ARth).
+
+ Lemma norm_ok : forall l pe,  PEeval l pe == (norm pe)@l.
+ Proof.
+  induction pe;simpl;Esimpl3.
+  apply mkX_ok.
+  rewrite IHpe1;rewrite IHpe2; destruct pe1;destruct pe2;Esimpl3.
+  rewrite IHpe1;rewrite IHpe2;rrefl.
+  rewrite Pmul_ok;rewrite IHpe1;rewrite IHpe2;rrefl.
+  rewrite IHpe;rrefl.
+ Qed.
+
+ Lemma ring_correct : forall l pe1 pe2, 
+  ((norm pe1) ?== (norm pe2)) = true -> (PEeval l pe1) == (PEeval l pe2).
+ Proof.
+  intros l pe1 pe2 H.
+  repeat rewrite norm_ok.
+  apply  (Peq_ok (norm pe1) (norm pe2) H l).
+ Qed.
+
+(** Evaluation function avoiding parentheses *)
+ Fixpoint mkmult (r:R) (lm:list R) {struct lm}: R :=
+  match lm with
+  | nil => r
+  | cons h t => mkmult (r*h) t
+  end.
+ 		       
+ Definition mkadd_mult rP lm :=
+  match lm with
+  | nil => rP + 1
+  | cons h t => rP + mkmult h t
+  end.
+
+ Fixpoint powl (i:positive) (x:R) (l:list R) {struct i}: list R :=
+  match i with
+  | xH => cons x l
+  | xO i => powl i x (powl i x l)
+  | xI i => powl i x (powl i x (cons x l))
+  end.
+			       
+ 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))
+  | 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
+  end.
+ 
+ Definition mkmult1 lm :=
+  match lm with
+  | nil => rI
+  | cons h t => mkmult h t
+  end.
+    
+ 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)
+  | 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
+  end. 
+
+ Definition Pphi_dev fv P := mult_dev P fv (nil R).
+
+ Add Morphism mkmult : mkmult_ext.
+  intros r r0 eqr l;generalize l r r0 eqr;clear l r r0 eqr;
+   induction l;simpl;intros.
+  trivial. apply IHl; rewrite eqr;rrefl.
+ Qed.
+
+ Lemma mul_mkmult : forall lm r1 r2, r1 * mkmult r2 lm == mkmult (r1*r2) lm.
+ Proof.
+  induction lm;simpl;intros;try rrefl.
+  rewrite IHlm.
+  setoid_replace (r1 * (r2 * a)) with (r1 * r2 * a);Esimpl.
+ Qed.
+
+ Lemma mkmult1_mkmult : forall lm r, r * mkmult1 lm == mkmult r lm.
+ Proof.
+  destruct lm;simpl;intros. Esimpl.
+  apply mul_mkmult.
+ Qed.
+ 
+ Lemma mkmult1_mkmult_1 : forall lm, mkmult1 lm == mkmult 1 lm.
+ Proof.
+  intros;rewrite <- mkmult1_mkmult;Esimpl.
+ Qed.
+
+ Lemma mkmult_rev_append : forall lm l r,
+  mkmult r (rev_append l lm) == 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.
+   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).
+ Proof.
+  induction p;simpl;intros.
+  repeat rewrite IHp.
+  unfold rev;simpl.
+  repeat rewrite mkmult_rev_append.
+  simpl.
+  setoid_replace (pow x p * (pow x p * r) * x) 
+    with (x * pow x p * pow x p * r);Esimpl.
+  mul_push x;rrefl.
+  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.
+ Qed.
+
+ Lemma Pphi_add_mult_dev : forall P rP 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.
+    rewrite mkmult1_mkmult;rrefl.
+   apply IHP.
+   replace (match P3 with
+       | Pc c => c ?=! cO
+       | Pinj _ _ => false
+       | PX _ _ _ => false
+       end) with (Peq P3 P0);trivial.
+   assert (H := Peq_ok P3 P0).
+    destruct (P3 ?== P0).
+    rewrite (H (refl_equal true));simpl;Esimpl.
+   rewrite <- IHP1.
+     repeat rewrite mkmult1_mkmult_1.
+     rewrite powl_mkmult_rev.
+     rewrite <- mul_mkmult;Esimpl.
+   rewrite <- IHP2.
+   rewrite <- IHP1.
+     repeat rewrite mkmult1_mkmult_1.
+     rewrite powl_mkmult_rev.
+     rewrite <- mul_mkmult;Esimpl.
+ Qed.
+                                     
+ Lemma Pphi_mult_dev : forall 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).
+   destruct (c ?=! cI).
+    rewrite (H (refl_equal true));rewrite (morph1 CRmorph);Esimpl.
+    apply  mkmult1_mkmult.
+   apply IHP.
+   replace (match P3 with
+       | Pc c => c ?=! cO
+       | Pinj _ _ => false
+       | PX _ _ _ => false
+       end) with (Peq P3 P0);trivial.
+   assert (H := Peq_ok P3 P0).
+   destruct (P3 ?== P0).
+   rewrite (H (refl_equal true));simpl;Esimpl.
+   rewrite <- IHP1.
+     repeat rewrite mkmult1_mkmult_1.
+     rewrite powl_mkmult_rev.
+     rewrite <- mul_mkmult;Esimpl.
+   rewrite <- Pphi_add_mult_dev.
+   rewrite <- IHP1.
+     repeat rewrite mkmult1_mkmult_1.
+     rewrite powl_mkmult_rev.
+     rewrite <- mul_mkmult;Esimpl.
+ Qed.
+
+ Lemma Pphi_Pphi_dev :  forall P l,  P@l == Pphi_dev l P.
+ Proof. 		
+  unfold Pphi_dev;intros.
+  rewrite <- Pphi_mult_dev;simpl;Esimpl.
+ Qed.
+
+ Lemma Pphi_dev_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' :
+   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
+
+ 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.
+
+ 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.
+
+ Lemma Pphi_Pphi_dev : forall P fv, P@fv == Pphi_dev fv P.
+ 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.
+ 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.
+ 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
new file mode 100644
index 00000000..6c3f87a5
--- /dev/null
+++ b/contrib/setoid_ring/Ring_tac.v
@@ -0,0 +1,754 @@
+Set Implicit Arguments.
+Require Import Setoid.
+Require Import BinList.
+Require Import BinPos.
+Require Import Pol.
+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
+  (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')]).
+
+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
+  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
+  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*)
+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.
+		      
+Ltac FV Cst add mul sub opp t fv :=
+ let rec TFV t fv :=
+  match Cst t with
+  | 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
+      | _ => AddFv t fv
+      end
+  | _ => fv
+  end 
+ in TFV t fv.
+
+ (* syntaxification *)
+ Ltac mkPolexpr C Cst radd rmul rsub ropp t fv := 
+ let rec mkP t :=
+    match Cst t with
+    | NotConstant =>
+        match t with 
+        | (radd ?t1 ?t2) => 
+          let e1 := mkP t1 in
+          let e2 := mkP t2 in constr:(PEadd e1 e2)
+        | (rmul ?t1 ?t2) => 
+          let e1 := mkP t1 in
+          let e2 := mkP t2 in constr:(PEmul e1 e2)
+        | (rsub ?t1 ?t2) => 
+          let e1 := mkP t1 in
+          let e2 := mkP t2 in constr:(PEsub e1 e2)
+        | (ropp ?t1) =>
+          let e1 := mkP t1 in constr:(PEopp e1)
+        | _ =>
+          let p := Find_at t fv in constr:(PEX C p)
+        end
+    | ?c => constr:(PEc c)
+    end
+ 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.
+
+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.
+
+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.
+
+*)
diff --git a/contrib/setoid_ring/Ring_th.v b/contrib/setoid_ring/Ring_th.v
new file mode 100644
index 00000000..9583dd2d
--- /dev/null
+++ b/contrib/setoid_ring/Ring_th.v
@@ -0,0 +1,462 @@
+Require Import Setoid.
+ Set Implicit Arguments.
+
+
+Reserved Notation "x ?=! y" (at level 70, no associativity).
+Reserved Notation "x +! y " (at level 50, left associativity).
+Reserved Notation "x -! y" (at level 50, left associativity).
+Reserved Notation "x *! y" (at level 40, left associativity).
+Reserved Notation "-! x" (at level 35, right associativity).
+
+Reserved Notation "[ x ]" (at level 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).
+
+
+
+Section DEFINITIONS.
+ Variable R : Type.
+ Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
+ Variable req : R -> R -> Prop.
+  Notation "0" := rO.  Notation "1" := rI.
+  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).
+
+ (** 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_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
+  }.
+  
+ (** Almost Ring *)
+(*Almost ring are no ring : Ropp_def is missi**)
+ 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_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_assoc : forall x y z, x * (y * z) == (x * y) * z;
+    ARdistr_l   : forall x y z, (x + y) * z == (x * z) + (y * z);
+    ARopp_mul_l : forall x y, -(x * y) == -x * y;
+    ARopp_add   : forall x y, -(x + y) == -x + -y;
+    ARsub_def   : forall x y, x - y == x + -y
+  }. 
+
+ (** Ring *)
+ Record ring_theory : Prop := mk_rt {
+    Radd_0_l    : forall x, 0 + x == x;
+    Radd_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
+ }.
+
+ (** Equality is extensional *)
+  
+ Record sring_eq_ext : Prop := mk_seqe {
+    (* SRing operators are compatible with equality *)
+    SRadd_ext :
+      forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 + y1 == x2 + y2;
+    SRmul_ext :
+      forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 * y1 == x2 * y2
+  }.
+
+ Record ring_eq_ext : Prop := mk_reqe {
+    (* Ring operators are compatible with equality *)
+    Radd_ext :
+      forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 + y1 == x2 + y2;
+    Rmul_ext :
+      forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 * y1 == x2 * y2;
+    Ropp_ext : forall x1 x2, x1 == x2 ->  -x1 == -x2
+  }.
+
+ (** Interpretation morphisms definition*) 
+ Section MORPHISM.
+ Variable C:Type.
+ Variable (cO cI : C) (cadd cmul csub : C->C->C) (copp : C->C).
+ Variable ceqb : C->C->bool.
+ (* [phi] est un morphisme de [C] dans [R] *) 
+ Variable phi : C -> R.
+ Notation "x +! y" := (cadd x y). Notation "x -! y " := (csub x y).
+ Notation "x *! y " := (cmul x y). Notation "-! x" := (copp x).
+ Notation "x ?=! y" := (ceqb x y). Notation "[ x ]" := (phi x).
+
+(*for semi rings*)
+ Record semi_morph : Prop := mkRmorph {
+    Smorph0 : [cO] == 0;
+    Smorph1 : [cI] == 1;
+    Smorph_add : forall x y, [x +! y] == [x]+[y];
+    Smorph_mul : forall x y, [x *! y] == [x]*[y];
+    Smorph_eq  : forall x y, x?=!y = true -> [x] == [y] 
+  }.
+
+(* for rings*)
+ Record ring_morph : Prop := mkmorph {
+    morph0    : [cO] == 0;
+    morph1    : [cI] == 1;
+    morph_add : forall x y, [x +! y] == [x]+[y];
+    morph_sub : forall x y, [x -! y] == [x]-[y];
+    morph_mul : forall x y, [x *! y] == [x]*[y];
+    morph_opp : forall x, [-!x] == -[x];
+    morph_eq  : forall x y, x?=!y = true -> [x] == [y] 
+  }.
+ End MORPHISM. 
+
+ (** Identity is a morphism *)
+ Variable Rsth : Setoid_Theory R req.
+   Add Setoid R req Rsth as R_setoid1.
+ Variable reqb : R->R->bool.
+ Hypothesis morph_req : forall x y, (reqb x y) = true -> x == y.
+ Definition IDphi (x:R) := x.
+ Lemma IDmorph : ring_morph rO rI radd rmul rsub ropp reqb IDphi.
+ Proof.
+  apply (mkmorph rO rI radd rmul rsub ropp reqb IDphi);intros;unfold IDphi;
+  try apply (Seq_refl _ _ Rsth);auto.
+ Qed.
+
+End DEFINITIONS.
+
+
+
+Section ALMOST_RING.
+ Variable R : Type.
+ Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
+ Variable req : R -> R -> Prop.
+  Notation "0" := rO.  Notation "1" := rI.
+  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).
+
+ (** Leibniz equality leads to a setoid theory and is extensional*)
+ Lemma Eqsth : Setoid_Theory R (@eq R).
+ Proof.  constructor;intros;subst;trivial. Qed.
+
+ Lemma Eq_s_ext : sring_eq_ext radd rmul (@eq R).
+ Proof. constructor;intros;subst;trivial. Qed.
+
+ Lemma Eq_ext : ring_eq_ext radd rmul ropp (@eq R).
+ Proof. constructor;intros;subst;trivial. Qed.
+
+ Variable Rsth : Setoid_Theory R req.
+   Add Setoid R req Rsth as R_setoid2.
+   Ltac sreflexivity := apply (Seq_refl _ _ Rsth).
+ 
+ Section SEMI_RING.
+ Variable SReqe : sring_eq_ext radd rmul req.
+   Add Morphism radd : radd_ext1.  exact (SRadd_ext SReqe). Qed.
+   Add Morphism rmul : rmul_ext1.  exact (SRmul_ext SReqe). Qed.
+ Variable SRth : semi_ring_theory 0 1 radd rmul req.
+
+ (** Every semi ring can be seen as an almost ring, by taking :
+        -x = x and x - y = x + y *)
+ Definition SRopp (x:R) := x. Notation "- x" := (SRopp x).
+ 
+ Definition SRsub x y := x + -y. Notation "x - y " := (SRsub x y).
+
+ Lemma SRopp_ext : forall x y, x == y -> -x == -y.
+ Proof. intros x y H;exact H. Qed.
+
+ Lemma SReqe_Reqe : ring_eq_ext radd rmul SRopp req.
+ Proof.
+  constructor.  exact (SRadd_ext SReqe). exact (SRmul_ext SReqe).
+  exact SRopp_ext.
+ Qed.
+
+ Lemma SRopp_mul_l : forall x y, -(x * y) == -x * y.
+ Proof. intros;sreflexivity. Qed.
+
+ Lemma SRopp_add : forall x y, -(x + y) == -x + -y.
+ Proof. intros;sreflexivity.  Qed.
+
+  
+ Lemma SRsub_def   : forall x y, x - y == x + -y.
+ Proof. intros;sreflexivity. Qed.
+
+ Lemma SRth_ARth : almost_ring_theory 0 1 radd rmul SRsub SRopp req.
+ Proof (mk_art 0 1 radd rmul SRsub SRopp req
+    (SRadd_0_l SRth) (SRadd_sym SRth) (SRadd_assoc SRth)
+    (SRmul_1_l SRth) (SRmul_0_l SRth)
+    (SRmul_sym SRth) (SRmul_assoc SRth) (SRdistr_l SRth)
+    SRopp_mul_l SRopp_add SRsub_def).
+ 
+ (** Identity morphism for semi-ring equipped with their almost-ring structure*)
+ Variable reqb : R->R->bool.
+
+ Hypothesis morph_req : forall x y, (reqb x y) = true -> x == y.
+
+ Definition SRIDmorph : ring_morph 0 1 radd rmul SRsub SRopp req
+                            0 1 radd rmul SRsub SRopp reqb (@IDphi R).
+ Proof.
+  apply mkmorph;intros;try sreflexivity.  unfold IDphi;auto.
+ Qed.
+
+ (* a semi_morph can be extended to a ring_morph for the almost_ring derived
+    from a semi_ring, provided the ring is a setoid (we only need
+    reflexivity) *)
+ Variable C : Type.
+ Variable (cO cI : C) (cadd cmul: C->C->C).
+ Variable (ceqb : C -> C -> bool).
+ Variable phi : C -> R.
+ Variable Smorph : semi_morph rO rI radd rmul req cO cI cadd cmul ceqb phi.
+
+ Lemma SRmorph_Rmorph :
+   ring_morph rO rI radd rmul SRsub SRopp req
+              cO cI cadd cmul cadd (fun x => x) ceqb phi.
+ Proof.
+ case Smorph; intros; constructor; auto.
+ unfold SRopp in |- *; intros.
+  setoid_reflexivity.
+ Qed.
+
+ End  SEMI_RING.
+ 
+ Variable Reqe : ring_eq_ext radd rmul ropp req.
+   Add Morphism radd : radd_ext2.  exact (Radd_ext Reqe). Qed.
+   Add Morphism rmul : rmul_ext2.  exact (Rmul_ext Reqe). Qed.
+   Add Morphism ropp : ropp_ext2.  exact (Ropp_ext Reqe). Qed.
+ 
+ Section RING.
+ Variable Rth : ring_theory 0 1 radd rmul rsub ropp req.
+
+ (** Rings are almost rings*)
+ Lemma Rmul_0_l : forall x, 0 * x == 0.
+ Proof.
+  intro x; setoid_replace (0*x) with ((0+1)*x + -x).
+  rewrite (Radd_0_l Rth); rewrite (Rmul_1_l Rth).
+  rewrite (Ropp_def Rth);sreflexivity.
+
+  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.
+ 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 <-(Ropp_def Rth (x*y)).
+  rewrite (Radd_assoc Rth).
+  rewrite <- (Rdistr_l Rth).
+  rewrite (Rth.(Radd_sym) (-x));rewrite (Ropp_def Rth).
+  rewrite Rmul_0_l;rewrite (Radd_0_l Rth);sreflexivity.
+ Qed.
+ 
+ Lemma Ropp_add : forall x y, -(x + y) == -x + -y.
+ Proof.
+  intros x y;rewrite <- ((Radd_0_l Rth) (-(x+y))).
+  rewrite <- ((Ropp_def Rth) x).
+  rewrite <- ((Radd_0_l Rth) (x + - x + - (x + y))).
+  rewrite <- ((Ropp_def Rth) y).
+  rewrite ((Radd_sym Rth) x).
+  rewrite ((Radd_sym Rth) y).
+  rewrite <- ((Radd_assoc Rth) (-y)).
+  rewrite <- ((Radd_assoc Rth) (- x)).
+  rewrite ((Radd_assoc Rth)  y).
+  rewrite ((Radd_sym 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).
+ Qed.
+ 
+ Lemma Ropp_opp : forall x, - -x == x.
+ Proof.
+  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).
+ 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)
+    Ropp_mul_l Ropp_add (Rsub_def Rth)).
+
+ (** Every semi morphism between two rings is a morphism*) 
+ Variable C : Type.
+ Variable (cO cI : C) (cadd cmul csub: C->C->C) (copp : C -> C).
+ Variable (ceq : C -> C -> Prop) (ceqb : C -> C -> bool).
+ Variable phi : C -> R.
+  Notation "x +! y" := (cadd x y).  Notation "x *! y " := (cmul x y).
+  Notation "x -! y " := (csub x y).  Notation "-! x" := (copp x).
+  Notation "x ?=! y" := (ceqb x y). Notation "[ x ]" := (phi x).
+ Variable Csth : Setoid_Theory C ceq.
+ Variable Ceqe : ring_eq_ext cadd cmul copp ceq.
+   Add Setoid C ceq Csth as C_setoid.
+   Add Morphism cadd : cadd_ext.  exact (Radd_ext Ceqe). Qed.
+   Add Morphism cmul : cmul_ext.  exact (Rmul_ext Ceqe). Qed.
+   Add Morphism copp : copp_ext.  exact (Ropp_ext Ceqe). Qed.
+ Variable Cth : ring_theory cO cI cadd cmul csub copp ceq.
+ Variable Smorph : semi_morph 0 1 radd rmul req cO cI cadd cmul ceqb phi.
+ Variable phi_ext : forall x y, ceq x y -> [x] == [y].
+   Add Morphism phi : phi_ext1.  exact phi_ext. Qed.
+ Lemma Smorph_opp : forall x, [-!x] == -[x].
+ Proof.
+  intros x;rewrite <-  (Rth.(Radd_0_l) [-!x]).
+  rewrite <- ((Ropp_def Rth) [x]).
+  rewrite ((Radd_sym Rth) [x]).
+  rewrite <- (Radd_assoc Rth).
+  rewrite <- (Smorph_add Smorph).
+  rewrite (Ropp_def Cth).
+  rewrite (Smorph0 Smorph).
+  rewrite (Radd_sym Rth (-[x])).
+  apply (Radd_0_l Rth);sreflexivity.
+ Qed. 
+
+ Lemma Smorph_sub : forall x y, [x -! y] == [x] - [y].
+ Proof.
+  intros x y; rewrite (Rsub_def Cth);rewrite (Rsub_def Rth).
+  rewrite (Smorph_add Smorph);rewrite Smorph_opp;sreflexivity.
+ Qed.
+
+ Lemma Smorph_morph : ring_morph 0 1 radd rmul rsub ropp req 
+                                             cO cI cadd cmul csub copp ceqb phi.
+ Proof
+  (mkmorph 0 1 radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi
+        (Smorph0 Smorph) (Smorph1 Smorph) 
+         (Smorph_add Smorph) Smorph_sub (Smorph_mul Smorph) Smorph_opp
+         (Smorph_eq Smorph)).
+
+ End RING.
+
+ (** Usefull lemmas on almost ring *)
+ Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
+
+ Lemma ARsub_ext :
+      forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 - y1 == x2 - y2.
+ Proof.
+  intros.
+  setoid_replace (x1 - y1) with (x1 + -y1). 
+  setoid_replace (x2 - y2) with (x2 + -y2).
+  rewrite H;rewrite H0;sreflexivity.
+  apply (ARsub_def ARth).
+  apply (ARsub_def ARth).
+ Qed.
+   Add Morphism rsub : rsub_ext.  exact ARsub_ext. Qed.
+
+ Ltac mrewrite :=
+   repeat first
+     [ rewrite (ARadd_0_l ARth)
+     | rewrite <- ((ARadd_sym ARth) 0)
+     | rewrite (ARmul_1_l ARth)
+     | rewrite <- ((ARmul_sym ARth) 1)
+     | rewrite (ARmul_0_l ARth)
+     | rewrite <- ((ARmul_sym ARth) 0)
+     | rewrite (ARdistr_l ARth)
+     | sreflexivity
+     | match goal with
+       | |- context [?z * (?x + ?y)] => rewrite ((ARmul_sym ARth) z (x+y))
+       end].
+ 
+ Lemma ARadd_0_r : forall x, (x + 0) == x.
+ Proof. intros; mrewrite. Qed.
+ 
+ Lemma ARmul_1_r   : forall x, x * 1 == x.
+ Proof. intros;mrewrite. Qed.
+
+ Lemma ARmul_0_r : forall x, x * 0 == 0.
+ Proof. intros;mrewrite. Qed.
+
+ Lemma ARdistr_r : forall x y z, z * (x + y) == z*x + z*y.
+ Proof. 
+  intros;mrewrite. 
+  repeat rewrite (ARth.(ARmul_sym) 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.
+ 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.
+ 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.
+ 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.
+ 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).
+ Qed.
+
+ Lemma ARopp_zero : -0 == 0.
+ Proof.
+  rewrite <- (ARmul_0_r 0); rewrite (ARopp_mul_l ARth).
+  repeat rewrite ARmul_0_r; sreflexivity.
+ Qed.
+
+End ALMOST_RING.
+
+(** Some simplification tactics*)
+Ltac gen_reflexivity Rsth := apply (Seq_refl _ _ Rsth).
+
+Ltac gen_srewrite O I add mul sub opp eq Rsth Reqe ARth :=
+  repeat first
+     [ gen_reflexivity Rsth
+     | progress rewrite (ARopp_zero Rsth Reqe ARth)
+     | rewrite (ARadd_0_l ARth)
+     | rewrite (ARadd_0_r Rsth ARth)
+     | rewrite (ARmul_1_l ARth)
+     | rewrite (ARmul_1_r Rsth ARth)
+     | rewrite (ARmul_0_l ARth)
+     | rewrite (ARmul_0_r Rsth ARth)
+     | rewrite (ARdistr_l ARth)
+     | rewrite (ARdistr_r Rsth Reqe ARth)
+     | rewrite (ARadd_assoc ARth)
+     | rewrite (ARmul_assoc ARth)
+     | progress rewrite (ARopp_add ARth)
+     | progress rewrite (ARsub_def ARth)
+     | progress rewrite <- (ARopp_mul_l ARth)
+     | progress rewrite <- (ARopp_mul_r Rsth Reqe ARth) ].
+
+Ltac gen_add_push add Rsth Reqe ARth x :=
+  repeat (match goal with
+  | |- context [add (add ?y x) ?z] => 
+     progress rewrite (ARadd_assoc2 Rsth Reqe ARth x y z)
+  | |- context [add (add x ?y) ?z] => 
+     progress rewrite (ARadd_assoc1 Rsth ARth x y z)
+  end).
+
+Ltac gen_mul_push mul Rsth Reqe ARth x :=
+  repeat (match goal with
+  | |- context [mul (mul ?y x) ?z] => 
+     progress rewrite (ARmul_assoc2 Rsth Reqe ARth x y z)
+  | |- context [mul (mul x ?y) ?z] => 
+     progress rewrite (ARmul_assoc1 Rsth ARth x y z)
+  end).
+
diff --git a/contrib/setoid_ring/ZRing_th.v b/contrib/setoid_ring/ZRing_th.v
new file mode 100644
index 00000000..9060428b
--- /dev/null
+++ b/contrib/setoid_ring/ZRing_th.v
@@ -0,0 +1,802 @@
+Require Import Ring_th.
+Require Import Pol.
+Require Import Ring_tac.
+Require Import ZArith_base.
+Require Import BinInt.
+Require Import BinNat.
+Require Import Setoid.
+ Set Implicit Arguments.
+
+(** Z is a ring and a setoid*)
+
+Lemma Zsth : Setoid_Theory Z (@eq Z).
+Proof (Eqsth Z).
+ 
+Lemma Zeqe : ring_eq_ext Zplus Zmult Zopp (@eq Z).
+Proof (Eq_ext Zplus Zmult Zopp).
+
+Lemma Zth : ring_theory Z0 (Zpos xH) Zplus Zmult Zminus Zopp (@eq Z).
+Proof.
+ constructor. exact Zplus_0_l. exact Zplus_comm. exact Zplus_assoc.
+ exact Zmult_1_l. exact Zmult_comm. exact Zmult_assoc.
+ exact Zmult_plus_distr_l. trivial. exact Zminus_diag.
+Qed.
+
+ Lemma Zeqb_ok : forall x y, Zeq_bool x y = true -> x = y.
+ Proof.
+  intros x y.
+  assert (H := Zcompare_Eq_eq x y);unfold Zeq_bool;
+  destruct (Zcompare x y);intros H1;auto;discriminate H1.
+ Qed.
+
+
+(** Two generic morphisms from Z to (abrbitrary) rings, *)
+(**second one is more convenient for proofs but they are ext. equal*)
+Section ZMORPHISM.
+ Variable R : Type.
+ Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
+ Variable req : R -> R -> Prop.
+  Notation "0" := rO.  Notation "1" := rI.
+  Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
+  Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
+  Notation "x == y" := (req x y).
+  Variable Rsth : Setoid_Theory R req.
+     Add 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 (Radd_ext Reqe). Qed.
+   Add Morphism rmul : rmul_ext3.  exact (Rmul_ext Reqe). Qed.
+   Add Morphism ropp : ropp_ext3.  exact (Ropp_ext Reqe). Qed.
+
+ Fixpoint gen_phiPOS1 (p:positive) : R :=
+  match p with
+  | xH => 1
+  | xO p => (1 + 1) * (gen_phiPOS1 p)
+  | xI p => 1 + ((1 + 1) * (gen_phiPOS1 p))
+  end.
+
+ Fixpoint gen_phiPOS (p:positive) : R :=
+  match p with
+  | xH => 1 
+  | xO xH => (1 + 1)
+  | xO p => (1 + 1) * (gen_phiPOS p)
+  | xI xH => 1 + (1 +1)
+  | xI p => 1 + ((1 + 1) * (gen_phiPOS p))
+  end.
+
+ Definition gen_phiZ1 z :=
+  match z with
+  | Zpos p => gen_phiPOS1 p
+  | Z0 => 0
+  | Zneg p => -(gen_phiPOS1 p)
+  end.
+ 
+ Definition gen_phiZ z := 
+  match z with
+  | Zpos p => gen_phiPOS p
+  | Z0 => 0
+  | Zneg p => -(gen_phiPOS p)
+  end.
+ Notation "[ x ]" := (gen_phiZ x).   
+ 
+ Section ALMOST_RING.
+ Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
+   Add Morphism rsub : rsub_ext3. 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 same_gen : forall x, gen_phiPOS1 x == gen_phiPOS x.
+ Proof.
+  induction x;simpl. 
+  rewrite IHx;destruct x;simpl;norm.
+  rewrite IHx;destruct x;simpl;norm.
+  rrefl.
+ Qed.
+
+ Lemma ARgen_phiPOS_Psucc : forall x,
+   gen_phiPOS1 (Psucc x) == 1 + (gen_phiPOS1 x).
+ Proof.
+  induction x;simpl;norm.
+  rewrite IHx;norm.
+  add_push 1;rrefl.
+ Qed.
+
+ Lemma ARgen_phiPOS_add : forall x y,
+   gen_phiPOS1 (x + y) == (gen_phiPOS1 x) + (gen_phiPOS1 y).
+ Proof.
+  induction x;destruct y;simpl;norm.
+  rewrite Pplus_carry_spec.
+  rewrite ARgen_phiPOS_Psucc.
+  rewrite IHx;norm.
+  add_push (gen_phiPOS1 y);add_push 1;rrefl.
+  rewrite IHx;norm;add_push (gen_phiPOS1 y);rrefl.
+  rewrite ARgen_phiPOS_Psucc;norm;add_push 1;rrefl.
+  rewrite IHx;norm;add_push(gen_phiPOS1 y); add_push 1;rrefl.
+  rewrite IHx;norm;add_push(gen_phiPOS1 y);rrefl.
+  add_push 1;rrefl.
+  rewrite ARgen_phiPOS_Psucc;norm;add_push 1;rrefl.
+ Qed.
+
+ Lemma ARgen_phiPOS_mult :
+   forall x y, gen_phiPOS1 (x * y) == gen_phiPOS1 x * gen_phiPOS1 y.
+ Proof.
+  induction x;intros;simpl;norm.
+  rewrite ARgen_phiPOS_add;simpl;rewrite IHx;norm.
+  rewrite IHx;rrefl.
+ Qed.
+
+ End ALMOST_RING.
+
+ Variable Rth : ring_theory 0 1 radd rmul rsub ropp req.
+ Let ARth := Rth_ARth Rsth Reqe Rth.
+   Add Morphism rsub : rsub_ext4. 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.
+  
+(*morphisms are extensionaly equal*)
+ Lemma same_genZ : forall x, [x] == gen_phiZ1 x.
+ Proof.
+  destruct x;simpl; try rewrite (same_gen ARth);rrefl.
+ Qed.
+ 
+ Lemma gen_Zeqb_ok : forall x y, 
+   Zeq_bool x y = true -> [x] == [y].
+ Proof.
+  intros x y H; repeat rewrite same_genZ.
+  assert (H1 := Zeqb_ok x y H);unfold IDphi in H1.
+  rewrite H1;rrefl.
+ Qed.
+  
+ Lemma gen_phiZ1_add_pos_neg : forall x y,
+ gen_phiZ1
+    match (x ?= y)%positive Eq with
+    | Eq => Z0
+    | Lt => Zneg (y - x)
+    | Gt => Zpos (x - y)
+    end 
+ == gen_phiPOS1 x + -gen_phiPOS1 y.
+ Proof.
+  intros x y.
+  assert (H:= (Pcompare_Eq_eq x y)); assert (H0 := Pminus_mask_Gt x y).
+  generalize (Pminus_mask_Gt y x).
+  replace Eq with (CompOpp Eq);[intro H1;simpl|trivial].
+  rewrite <- Pcompare_antisym in H1.
+  destruct ((x ?= y)%positive Eq).
+  rewrite H;trivial. rewrite (Ropp_def Rth);rrefl.
+  destruct H1 as [h [Heq1 [Heq2 Hor]]];trivial.
+  unfold Pminus; rewrite Heq1;rewrite <- Heq2.
+  rewrite (ARgen_phiPOS_add ARth);simpl;norm.
+  rewrite (Ropp_def Rth);norm.
+  destruct H0 as [h [Heq1 [Heq2 Hor]]];trivial.
+  unfold Pminus; rewrite Heq1;rewrite <- Heq2.
+  rewrite (ARgen_phiPOS_add ARth);simpl;norm.
+  add_push (gen_phiPOS1 h);rewrite (Ropp_def Rth); norm.
+ Qed.
+
+ Lemma match_compOpp : forall x (B:Type) (be bl bg:B),
+  match CompOpp x with Eq => be | Lt => bl | Gt => bg end 
+  = match x with Eq => be | Lt => bg | Gt => bl end.
+ Proof. destruct x;simpl;intros;trivial. Qed.
+
+ Lemma gen_phiZ_add : forall x y, [x + y] == [x] + [y].
+ Proof.
+  intros x y; repeat rewrite same_genZ; generalize x y;clear x y.
+  induction x;destruct y;simpl;norm.
+  apply (ARgen_phiPOS_add ARth).
+  apply gen_phiZ1_add_pos_neg.
+  replace Eq with (CompOpp Eq);trivial.
+  rewrite <- Pcompare_antisym;simpl.
+  rewrite match_compOpp.    
+  rewrite (Radd_sym Rth).
+  apply gen_phiZ1_add_pos_neg.
+  rewrite (ARgen_phiPOS_add ARth); norm.
+ Qed.
+
+ Lemma gen_phiZ_mul : forall x y, [x * y] == [x] * [y].
+ Proof.
+  intros x y;repeat rewrite same_genZ.
+  destruct x;destruct y;simpl;norm;
+  rewrite  (ARgen_phiPOS_mult ARth);try (norm;fail).
+  rewrite (Ropp_opp Rsth Reqe Rth);rrefl.
+ Qed.
+
+ Lemma gen_phiZ_ext : forall x y : Z, x = y -> [x] == [y].
+ Proof. intros;subst;rrefl. Qed.
+
+(*proof that [.] satisfies morphism specifications*)
+ Lemma gen_phiZ_morph : 
+  ring_morph 0 1 radd rmul rsub ropp req Z0 (Zpos xH) 
+   Zplus Zmult Zminus Zopp Zeq_bool gen_phiZ.
+ Proof. 
+  assert ( SRmorph : semi_morph 0 1 radd rmul req Z0 (Zpos xH) 
+                  Zplus Zmult Zeq_bool gen_phiZ).
+   apply mkRmorph;simpl;try rrefl.
+   apply gen_phiZ_add.  apply gen_phiZ_mul. apply gen_Zeqb_ok.
+  apply  (Smorph_morph Rsth Reqe Rth Zsth Zth SRmorph gen_phiZ_ext).
+ Qed.
+
+End ZMORPHISM.
+
+(** N is a semi-ring and a setoid*)
+Lemma Nsth : Setoid_Theory N (@eq N).
+Proof (Eqsth N).
+
+Lemma Nseqe : sring_eq_ext Nplus Nmult (@eq N).
+Proof (Eq_s_ext Nplus Nmult).
+
+Lemma Nth : semi_ring_theory N0 (Npos xH) Nplus Nmult (@eq N).
+Proof.
+ constructor. exact Nplus_0_l. exact Nplus_comm. exact Nplus_assoc.
+ exact Nmult_1_l. exact Nmult_0_l. exact Nmult_comm. exact Nmult_assoc.
+ exact Nmult_plus_distr_r. 
+Qed.
+
+Definition Nsub := SRsub Nplus.
+Definition Nopp := (@SRopp N).
+
+Lemma Neqe : ring_eq_ext Nplus Nmult Nopp (@eq N).
+Proof (SReqe_Reqe Nseqe).
+
+Lemma Nath : 
+ almost_ring_theory N0 (Npos xH) Nplus Nmult Nsub Nopp (@eq N).
+Proof (SRth_ARth Nsth Nth).
+ 
+Definition Neq_bool (x y:N) := 
+  match Ncompare x y with
+  | Eq => true
+  | _ => false
+  end.
+
+Lemma Neq_bool_ok : 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.
+ Variable R : Type.
+ Variable  (rO rI : R) (radd rmul: R->R->R).
+ Variable req : R -> R -> Prop.
+  Notation "0" := rO.  Notation "1" := rI.
+  Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
+ Variable Rsth : Setoid_Theory R req.
+     Add Setoid R req Rsth as R_setoid4.
+     Ltac rrefl := gen_reflexivity Rsth.
+ Variable SReqe : sring_eq_ext radd rmul req.
+ Variable SRth : semi_ring_theory 0 1 radd rmul req. 
+ Let ARth := SRth_ARth Rsth SRth.
+ Let Reqe := SReqe_Reqe SReqe.
+ Let ropp := (@SRopp R).
+ Let rsub := (@SRsub R radd).
+  Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
+  Notation "x == y" := (req x y).
+   Add Morphism radd : radd_ext4.  exact (Radd_ext Reqe). Qed.
+   Add Morphism rmul : rmul_ext4.  exact (Rmul_ext Reqe). Qed.
+   Add Morphism ropp : ropp_ext4.  exact (Ropp_ext Reqe). Qed.
+   Add Morphism rsub : rsub_ext5.  exact (ARsub_ext Rsth Reqe ARth). Qed.
+   Ltac norm := gen_srewrite 0 1 radd rmul rsub ropp req Rsth Reqe ARth.
+  
+ Definition gen_phiN1 x :=
+  match x with
+  | N0 => 0
+  | Npos x => gen_phiPOS1 1 radd rmul x
+  end. 
+
+ Definition gen_phiN x :=
+  match x with
+  | N0 => 0
+  | Npos x => gen_phiPOS 1 radd rmul x
+  end. 
+ Notation "[ x ]" := (gen_phiN x).   
+  
+ Lemma same_genN : forall x, [x] == gen_phiN1 x.
+ Proof.
+  destruct x;simpl. rrefl.
+  rewrite (same_gen Rsth Reqe ARth);rrefl.
+ Qed.
+
+ Lemma gen_phiN_add : forall x y, [x + y] == [x] + [y].
+ Proof.
+  intros x y;repeat rewrite same_genN.
+  destruct x;destruct y;simpl;norm.
+  apply (ARgen_phiPOS_add Rsth Reqe ARth).
+ Qed.
+ 
+ Lemma gen_phiN_mult : forall x y, [x * y] == [x] * [y].
+ Proof.
+  intros x y;repeat rewrite same_genN.
+  destruct x;destruct y;simpl;norm.
+  apply (ARgen_phiPOS_mult Rsth Reqe ARth).
+ Qed.
+
+ Lemma gen_phiN_sub : forall x y, [Nsub x y] == [x] - [y].
+ Proof. exact gen_phiN_add. Qed.
+
+(*gen_phiN satisfies morphism specifications*)
+ Lemma gen_phiN_morph : ring_morph 0 1 radd rmul rsub ropp req
+                           N0 (Npos xH) Nplus Nmult Nsub Nopp Neq_bool gen_phiN.
+ 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 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 *)
+ Ltac inv_gen_phi_pos rI add mul t :=
+   let rec inv_cst t :=
+   match t with
+     rI => constr:1%positive
+   | (add rI rI) => constr:2%positive
+   | (add rI (add rI rI)) => constr:3%positive
+   | (mul (add rI rI) ?p) => (* 2p *)
+       match inv_cst p with
+         NotConstant => NotConstant
+       | 1%positive => NotConstant
+       | ?p => constr:(xO p)
+       end
+   | (add rI (mul (add rI rI) ?p)) => (* 1+2p *)
+       match inv_cst p with
+         NotConstant => NotConstant
+       | 1%positive => NotConstant
+       | ?p => constr:(xI p)
+       end
+   | _ => NotConstant
+   end in
+   inv_cst t.
+
+ Ltac inv_gen_phiN rO rI add mul t :=
+   match t with
+     rO => constr:0%N
+   | _ =>
+     match inv_gen_phi_pos rI add mul t with
+       NotConstant => NotConstant
+     | ?p => constr:(Npos p)
+     end
+   end.
+
+ Ltac inv_gen_phiZ rO rI add mul opp t :=
+   match t with
+     rO => constr:0%Z
+   | (opp ?p) =>
+     match inv_gen_phi_pos rI add mul p with
+       NotConstant => NotConstant
+     | ?p => constr:(Zneg p)
+     end
+   | _ =>
+     match inv_gen_phi_pos rI add mul t with
+       NotConstant => NotConstant
+     | ?p => constr:(Zpos p)
+     end
+   end.
+(* coefs = Z (abstract ring) *)
+Module Zpol.
+
+Definition ring_gen_correct
+  R rO rI radd rmul rsub ropp req rSet req_th Rth :=
+  @ring_correct 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
+                (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
+                 (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_gen_eq_correct R rO rI radd rmul rsub ropp Rth :=
+  @ring_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.
+
+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) *)
+Module Npol.
+
+Definition ring_gen_correct
+  R rO rI radd rmul req rSet req_th SRth :=
+  @ring_correct 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
+                (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
+                 (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_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'
+     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
+  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
+  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 New Ring natr : natSRth Computational nateq_ok Constant natcst.
+
diff --git a/contrib/setoid_ring/newring.ml4 b/contrib/setoid_ring/newring.ml4
new file mode 100644
index 00000000..7041d7e8
--- /dev/null
+++ b/contrib/setoid_ring/newring.ml4
@@ -0,0 +1,525 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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 camlp4deps: "parsing/grammar.cma" i*)
+
+(*i $Id: newring.ml4 7974 2006-02-01 19:02:09Z barras $ i*)
+
+open Pp
+open Util
+open Names
+open Term
+open Closure
+open Environ
+open Tactics
+open Rawterm
+open Tacticals
+open Tacexpr
+open Pcoq
+open Tactic
+open Constr
+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"
+
+(****************************************************************************)
+(* controlled reduction *)
+
+let mark_arg i c = mkEvar(i,[|c|]);;
+let unmark_arg f c =
+  match destEvar c with
+    | (i,[|c|]) -> f i c
+    | _ -> assert false;;
+
+type protect_flag = Eval|Prot|Rec ;;
+
+let tag_arg tag_rec map i c =
+  match map i with
+      Eval -> inject c
+    | Prot -> mk_atom c
+    | Rec -> if i = -1 then inject c else tag_rec c
+
+let rec mk_clos_but f_map t =
+  match f_map t with
+    | Some map -> tag_arg (mk_clos_but f_map) map (-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)
+
+and mk_clos_app_but f_map f args n =
+  if n >= Array.length args then inject(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)
+            (mkApp (mark_arg (-1) f', Array.mapi mark_arg args'))
+      | None -> mk_clos_app_but f_map f args (n+1)
+;;
+
+let interp_map l c =
+  try
+    let (im,am) = List.assoc c l in
+    Some(fun i ->
+      if List.mem i im then Eval
+      else if List.mem i am then Prot
+      else if i = -1 then Eval
+      else Rec)
+  with Not_found -> None
+
+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);
+];;
+
+(* 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
+  kl (create_clos_infos betadeltaiota env)
+    (mk_clos_but (is_ring_thm req) c);;
+
+let protect_tac =
+  Tactics.reduct_option (protect_red,DEFAULTcast) None ;;
+
+let protect_tac_in id =
+  Tactics.reduct_option (protect_red,DEFAULTcast) (Some(id,[],InHyp));;
+
+
+TACTIC EXTEND protect_fv
+  [ "protect_fv" "in" ident(id) ] -> 
+    [ protect_tac_in id ]
+| [ "protect_fv" ] -> 
+    [ protect_tac ]
+END;;
+
+(****************************************************************************)
+(* Ring database *)
+
+let ty c = Typing.type_of (Global.env()) Evd.empty c
+
+
+type ring_info =
+    { ring_carrier : types;
+      ring_req : constr;
+      ring_cst_tac : glob_tactic_expr;
+      ring_lemma1 : constr;
+      ring_lemma2 : constr }
+
+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 _ = 
+  Summary.declare_summary "tactic-new-ring-table"
+    { Summary.freeze_function = (fun () -> !from_carrier,!from_relation);
+      Summary.unfreeze_function =
+        (fun (ct,rt) -> from_carrier := ct; from_relation := rt);
+      Summary.init_function =
+        (fun () -> from_carrier := Cmap.empty; from_relation := Cmap.empty);
+      Summary.survive_module = false;
+      Summary.survive_section = false }
+
+let add_entry _ 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
+
+
+let subst_th (_,subst,th) = 
+  let c' = subst_mps subst th.ring_carrier in                   
+  let eq' = subst_mps subst th.ring_req 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
+  if c' == th.ring_carrier &&
+     eq' == th.ring_req &&
+     thm1' == th.ring_lemma1 &&
+     thm2' == th.ring_lemma2 &&
+     tac' == th.ring_cst_tac then th
+  else
+    { ring_carrier = c';
+      ring_req = eq';
+      ring_cst_tac = tac';
+      ring_lemma1 = thm1';
+      ring_lemma2 = thm2' }
+
+
+let (theory_to_obj, obj_to_theory) = 
+  let cache_th (name,th) = add_entry name th
+  and export_th x = Some x in
+  declare_object
+    {(default_object "tactic-new-ring-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 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;
+      out_some r.rel_refl; out_some r.rel_sym; out_some r.rel_trans |]
+
+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|]
+
+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 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
+        (setoid,op_morph)
+    | Relation rel ->
+        let setoid = setoid_of_relation rel in
+        let is_endomorphism = function
+            { args=args } -> List.for_all
+                (function (var,Relation rel) ->
+                  var=None && eq_constr req rel
+                  | _ -> false) args in
+        let add_m =
+          try default_morphism ~filter:is_endomorphism add
+          with Not_found ->
+            error "ring addition should be declared as a morphism" in
+        let mul_m =
+          try default_morphism ~filter:is_endomorphism mul
+          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
+             let op_morph =
+               op_morph r add mul opp req add_m.lem mul_m.lem opp_m.lem in
+             msgnl
+               (str"Using setoid \""++pr_constr rel.rel_aeq++str"\""++spc()++  
+               str"and morphisms \""++pr_constr add_m.morphism_theory++
+               str"\","++spc()++ str"\""++pr_constr mul_m.morphism_theory++
+               str"\""++spc()++str"and \""++pr_constr opp_m.morphism_theory++
+               str"\"");
+             op_morph)
+          else
+            (msgnl
+              (str"Using setoid \""++pr_constr rel.rel_aeq++str"\"" ++ spc() ++  
+               str"and morphisms \""++pr_constr add_m.morphism_theory++
+               str"\""++spc()++str"and \""++
+               pr_constr mul_m.morphism_theory++str"\"");
+            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 =
+  match eqth with
+      Some th -> th
+    | None -> default_ring_equality is_semi (r,add,mul,opp,req)
+
+let dest_ring th_spec =
+  let th_typ = Retyping.get_type_of (Global.env()) Evd.empty 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)
+    | 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)
+    | 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)
+    | _ -> 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 *)
+
+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
+      Some (CstTac t) -> Tacinterp.glob_tactic t
+    | Some (Closed lc) -> failwith "TODO"
+    | None ->
+        (match kind with
+            Some true ->
+              let t = Genarg.ArgArg(dummy_loc,Lazy.force ltac_inv_morphN) in
+              TacArg(TacCall(dummy_loc,t,List.map carg [zero;one;add;mul]))
+          | Some false ->
+              let t = Genarg.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
+  let _ =
+    Lib.add_leaf name
+      (theory_to_obj
+        { ring_carrier = r;
+          ring_req = req;
+          ring_cst_tac = cst_tac;
+          ring_lemma1 = lemma1;
+          ring_lemma2 = lemma2 }) in
+  ()
+
+VERNAC ARGUMENT EXTEND ring_coefs
+| [ "Computational" constr(c)] -> [ Computational (ic c) ]
+| [ "Abstract" ] -> [ Abstract ]
+| [ "Coefficients" constr(m)] -> [ Morphism (ic m) ]
+| [ ] -> [ Abstract ]
+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
+
+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 ]
+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,
+      Genarg.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
+  Tacinterp.eval_tactic
+    (TacArg(TacCall(dummy_loc,
+      Genarg.ArgArg(dummy_loc, Lazy.force ltac_setoid_ring_rewrite),
+      Tacexp e.ring_cst_tac::List.map carg [e.ring_lemma2;e.ring_req;rl])))
+
+let setoid_ring = function
+  | [] -> ring
+  | l -> ring_rewrite l
+
+TACTIC EXTEND setoid_ring
+  [ "setoid" "ring" constr_list(l) ] -> [ setoid_ring l ]
+END
+
diff --git a/contrib/subtac/FixSub.v b/contrib/subtac/FixSub.v
new file mode 100644
index 00000000..bbf722db
--- /dev/null
+++ b/contrib/subtac/FixSub.v
@@ -0,0 +1,22 @@
+Require Import Wf.
+
+Section Well_founded.
+Variable A : Set.
+Variable R : A -> A -> Prop.
+Hypothesis Rwf : well_founded R.
+
+Section FixPoint.
+
+Variable P : A -> Set.
+
+Variable F_sub : forall x:A, (forall y: { y : A | R y x }, P (proj1_sig y)) -> P x.
+ 
+Fixpoint Fix_F_sub (x : A) (r : Acc R x) {struct r} : P x :=
+   F_sub x (fun y: { y : A | R y x}  => Fix_F_sub (proj1_sig y) 
+   (Acc_inv r (proj1_sig y) (proj2_sig y))).
+
+Definition Fix_sub (x : A) := Fix_F_sub x (Rwf x).
+
+End FixPoint.
+
+End Well_founded.
diff --git a/contrib/subtac/Utils.v b/contrib/subtac/Utils.v
new file mode 100644
index 00000000..9acb10ae
--- /dev/null
+++ b/contrib/subtac/Utils.v
@@ -0,0 +1,34 @@
+Set Implicit Arguments.
+
+Definition ex_pi1 (A : Prop) (P : A -> Prop) (t : ex P) : A.
+intros.
+induction t.
+exact x.
+Defined.
+
+Check proj1_sig.
+Lemma subset_simpl : forall (A : Set) (P : A -> Prop)
+  (t : sig P), P (proj1_sig t).
+Proof.
+intros.
+induction t.
+ simpl ; auto.
+Qed.
+
+Lemma ex_pi2  : forall (A : Prop) (P : A -> Prop) (t : ex P),
+ P (ex_pi1 t).
+intros A P.
+dependent inversion t.
+simpl.
+exact p.
+Defined.
+
+Notation "'forall' { x : A | P } , Q" :=
+  (forall x:{x:A|P}, Q)
+  (at level 200, x ident, right associativity).
+
+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.
diff --git a/contrib/subtac/context.ml b/contrib/subtac/context.ml
new file mode 100644
index 00000000..236b0ea5
--- /dev/null
+++ b/contrib/subtac/context.ml
@@ -0,0 +1,35 @@
+open Term
+open Names
+
+type t = rel_declaration list (* name, optional coq interp, algorithmic type *)
+
+let assoc n t = 
+  let _, term, typ = List.find (fun (x, _, _) -> x = n) t in
+    term, typ
+
+let assoc_and_index x l =
+  let rec aux i = function
+      (y, term, typ) :: tl -> if x = y then i, term, typ else aux (succ i) tl
+    | [] -> raise Not_found
+  in aux 0 l
+
+let id_of_name = function
+    Name id -> id
+  | Anonymous -> raise (Invalid_argument "id_of_name")
+(*
+
+let subst_ctx ctx c = 
+  let rec aux ((ctx, n, c) as acc) = function
+      (name, None, typ) :: tl -> 
+	aux (((id_of_name name, None, rel_to_vars ctx typ) :: ctx), 
+	     pred n, c) tl
+    | (name, Some term, typ) :: tl ->
+	let t' = Term.substnl [term] n c in
+	  aux (ctx, n, t') tl
+    | [] -> acc
+  in 
+  let (x, _, z) = aux ([], pred (List.length ctx), c) (List.rev ctx) in 
+    (x, rel_to_vars x z)
+*)
+
+let subst_env env c = (env, c)
diff --git a/contrib/subtac/context.mli b/contrib/subtac/context.mli
new file mode 100644
index 00000000..671d6f36
--- /dev/null
+++ b/contrib/subtac/context.mli
@@ -0,0 +1,5 @@
+type t = Term.rel_declaration list
+val assoc : 'a -> ('a * 'b * 'c) list -> 'b * 'c
+val assoc_and_index : 'a -> ('a * 'b * 'c) list -> int * 'b * 'c
+val id_of_name : Names.name -> Names.identifier
+val subst_env : 'a -> 'b -> 'a * 'b
diff --git a/contrib/subtac/eterm.ml b/contrib/subtac/eterm.ml
new file mode 100644
index 00000000..5703c0ef
--- /dev/null
+++ b/contrib/subtac/eterm.ml
@@ -0,0 +1,168 @@
+(**
+   - Get types of existentials ;
+   - Flatten dependency tree (prefix order) ;
+   - Replace existentials by De Bruijn indices in term, applied to the right arguments ;
+   - Apply term prefixed by quantification on "existentials".
+*)
+
+open Term
+open Names
+open Evd
+open List
+open Pp
+open Util
+
+let reverse_array arr = 
+  Array.of_list (List.rev (Array.to_list arr))
+    
+let trace s = 
+  if !Options.debug then msgnl s
+  else ()
+
+(** Utilities to find indices in lists *)
+let list_index x l =
+  let rec aux i = function
+      k :: tl -> if k = x then i else aux (succ i) tl
+    | [] -> raise Not_found
+  in aux 0 l
+
+let list_assoc_index x l =
+  let rec aux i = function
+      (k, _, v) :: tl -> if k = x then i else aux (succ i) tl
+    | [] -> 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 evar_info id = 
+    let rec aux i = function
+	(k, h, v) :: tl -> if k = id then (i, h, v) else aux (succ i) tl
+      | [] -> raise Not_found
+    in 
+    let (idx, hyps, v) = aux 0 evs in
+      n + idx + 1, hyps
+  in
+  let rec substrec depth c = match kind_of_term c with
+    | Evar (k, args) ->
+	(try 
+	   let index, hyps = evar_info k in
+	     trace (str "Evar " ++ int k ++ str " found, applied to " ++ int (Array.length args) ++ str "arguments," ++
+		    int (List.length hyps) ++ str " hypotheses");
+
+	   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 =
+	       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"
+	     in aux hyps (Array.to_list args) [] 
+	   in
+	     mkApp (ex, Array.of_list args)
+	 with Not_found -> 
+	   anomaly ("eterm: existential variable " ^ string_of_int k ^ " not found"))
+    | _ -> map_constr_with_binders succ substrec depth c
+  in 
+    substrec 0 t
+      
+(** Substitute variable references in t using De Bruijn indices, 
+  where n binders were passed through. *)
+let subst_vars acc n t = 
+  let var_index id = 
+    let idx = list_index id acc in
+      idx + 1
+  in
+  let rec substrec depth c = match kind_of_term c with
+    | Var v -> (try mkRel (depth + (var_index v)) with Not_found -> c)
+    | _ -> map_constr_with_binders succ substrec depth c
+  in 
+    substrec 0 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.
+*)
+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'' = subst_vars acc 0 t' in
+ 	  mkNamedProd_or_LetIn (id, copt, t'') (aux (id :: acc) (succ n) tl)
+    | [] ->
+	let t' = subst_evars evs n ev.evar_concl in
+	  subst_vars acc 0 t'	
+  in aux [] 0 (rev hyps)
+
+
+open Tacticals
+    
+let eterm_term evm t tycon = 
+  (* 'Serialize' the evars, we assume that the types of the existentials
+     refer to previous existentials in the list only *)
+  let evl = to_list evm in
+  let evts = 
+    (* Remove existential variables in types and build the corresponding products *)
+    fold_right 
+      (fun (id, ev) l ->
+	 let hyps = Environ.named_context_of_val ev.evar_hyps in
+	 let y' = (id, hyps, etype_of_evar l ev hyps) in
+	   y' :: l) 
+      evl []
+  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_app 
+		(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))
+  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)
+  in
+    trace (str "Term given to eterm" ++ spc () ++
+	   Termops.print_constr_env (Global.env ()) t);
+    trace (str "Term constructed in eterm" ++ spc () ++
+	   Termops.print_constr_env (Global.env ()) t'');
+    ignore(option_app 
+	     (fun typ ->
+		trace (str "Type :" ++ spc () ++
+		       Termops.print_constr_env (Global.env ()) typ))
+	     tycon);
+    t'', tycon, evar_names
+
+let mkMetas n = 
+  let rec aux i acc = 
+    if i > 0 then aux (pred i) (Evarutil.mk_new_meta () :: acc)
+    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))
+     
+open Tacmach
+
+let etermtac (evm, t) = eterm evm t None
diff --git a/contrib7/correctness/Arrays_stuff.v b/contrib/subtac/eterm.mli
index 448b0ab6..fbe2ac1d 100644
--- a/contrib7/correctness/Arrays_stuff.v
+++ b/contrib/subtac/eterm.mli
@@ -6,11 +6,15 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
+(*i $Id: eterm.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
 
-(* $Id: Arrays_stuff.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
+open Tacmach
+open Term
+open Evd
+open Names
 
-Require Export Exchange.
-Require Export ArrayPermut.
-Require Export Sorted.
+val mkMetas : int -> constr list
 
+val eterm_term : evar_map -> constr -> types option -> constr * types option * (identifier * types) list
+
+val etermtac : open_constr -> tactic
diff --git a/contrib/subtac/g_eterm.ml4 b/contrib/subtac/g_eterm.ml4
new file mode 100644
index 00000000..d9dd42cd
--- /dev/null
+++ b/contrib/subtac/g_eterm.ml4
@@ -0,0 +1,27 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+(**************************************************************************)
+(*                                                                        *)
+(* Omega: a solver of quantifier-free problems in Presburger Arithmetic   *)
+(*                                                                        *)
+(* Pierre Crégut (CNET, Lannion, France)                                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*i camlp4deps: "parsing/grammar.cma" i*)
+
+(* $Id: g_eterm.ml4 8654 2006-03-22 15:36:58Z msozeau $ *)
+
+open Eterm
+
+TACTIC EXTEND eterm
+  [ "eterm" ] -> [ 
+    (fun gl ->
+       let evm = Tacmach.project gl and t = Tacmach.pf_concl gl in
+         Eterm.etermtac (evm, t) gl) ]
+END
diff --git a/contrib/subtac/g_subtac.ml4 b/contrib/subtac/g_subtac.ml4
new file mode 100644
index 00000000..c3f2a24d
--- /dev/null
+++ b/contrib/subtac/g_subtac.ml4
@@ -0,0 +1,62 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(*
+  Syntax for the subtac terms and types.
+  Elaborated from correctness/psyntax.ml4 by Jean-Christophe Filliâtre *)
+
+(* $Id: g_subtac.ml4 8688 2006-04-07 15:08:12Z msozeau $ *)
+
+(*i camlp4deps: "parsing/grammar.cma" i*)
+
+open Options
+open Util
+open Names
+open Nameops
+open Vernacentries
+open Reduction
+open Term
+open Libnames
+open Topconstr
+
+(* We define new entries for programs, with the use of this module
+ * Subtac. These entries are named Subtac.<foo>
+ *)
+
+module Gram = Pcoq.Gram
+module Vernac = Pcoq.Vernac_
+
+module SubtacGram =
+struct
+  let gec s = Gram.Entry.create ("Subtac."^s)
+		(* types *)
+  let subtac_gallina_loc : Vernacexpr.vernac_expr located Gram.Entry.e = gec "subtac_gallina_loc"
+end
+
+open SubtacGram 
+open Util
+
+GEXTEND Gram
+  GLOBAL: subtac_gallina_loc;
+ 
+  subtac_gallina_loc:
+    [ [ g = Vernac.gallina -> loc, g ] ]
+    ;
+  END
+
+type gallina_loc_argtype = (Vernacexpr.vernac_expr located, constr_expr, Tacexpr.raw_tactic_expr) Genarg.abstract_argument_type
+
+let (wit_subtac_gallina_loc : gallina_loc_argtype),
+  (globwit_subtac_gallina_loc : gallina_loc_argtype),
+  (rawwit_subtac_gallina_loc : gallina_loc_argtype) =
+  Genarg.create_arg "subtac_gallina_loc"
+
+VERNAC COMMAND EXTEND Subtac
+[ "Program" subtac_gallina_loc(g) ] -> 
+  [ Subtac.subtac g ]
+END
diff --git a/contrib/subtac/subtac.ml b/contrib/subtac/subtac.ml
new file mode 100644
index 00000000..84b7d39b
--- /dev/null
+++ b/contrib/subtac/subtac.ml
@@ -0,0 +1,203 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: subtac.ml 8688 2006-04-07 15:08:12Z msozeau $ *)
+
+open Global
+open Pp
+open Util
+open Names
+open Sign
+open Evd
+open Term
+open Termops
+open Reductionops
+open Environ
+open Type_errors
+open Typeops
+open Libnames
+open Classops
+open List
+open Recordops 
+open Evarutil
+open Pretype_errors
+open Rawterm
+open Evarconv
+open Pattern
+open Dyn
+open Vernacexpr
+
+open Subtac_coercion
+open Subtac_utils
+open Coqlib
+open Printer
+open Subtac_errors
+open Context
+open Eterm
+
+let require_library dirpath =
+  let qualid = (dummy_loc, qualid_of_dirpath (dirpath_of_string dirpath)) in
+    Library.require_library [qualid] None
+
+let subtac_one_fixpoint env isevars (f, decl) = 
+  let ((id, n, bl, typ, body), decl) = 
+    Subtac_interp_fixpoint.rewrite_fixpoint env [] (f, decl) 
+  in
+  let _ = trace (str "Working on a single fixpoint rewritten as: " ++ spc () ++
+		 Ppconstr.pr_constr_expr body)
+  in ((id, n, bl, typ, body), decl)
+    
+	      
+let subtac_fixpoint isevars l = 
+  (* TODO: Copy command.build_recursive *)
+  ()
+(*
+let save id const (locality,kind) hook =
+  let {const_entry_body = pft;
+       const_entry_type = tpo;
+       const_entry_opaque = opacity } = const in
+  let l,r = match locality with
+    | Local when Lib.sections_are_opened () ->
+        let k = logical_kind_of_goal_kind kind in
+	let c = SectionLocalDef (pft, tpo, opacity) in
+	let _ = declare_variable id (Lib.cwd(), c, k) in
+	(Local, VarRef id)
+    | Local ->
+        let k = logical_kind_of_goal_kind kind in
+        let kn = declare_constant id (DefinitionEntry const, k) in
+	(Global, ConstRef kn)
+    | Global ->
+        let k = logical_kind_of_goal_kind kind in
+        let kn = declare_constant id (DefinitionEntry const, k) in
+	(Global, ConstRef kn) in
+  Pfedit.delete_current_proof ();
+  hook l r;
+  definition_message id
+
+let save_named opacity =
+  let id,(const,persistence,hook) = Pfedit.cook_proof () in
+  let const = { const with const_entry_opaque = opacity } in
+  save id const persistence hook
+
+let check_anonymity id save_ident =
+  if atompart_of_id id <> "Unnamed_thm" then
+    error "This command can only be used for unnamed theorem"
+(*
+    message("Overriding name "^(string_of_id id)^" and using "^save_ident)
+*)
+
+let save_anonymous opacity save_ident =
+  let id,(const,persistence,hook) = Pfedit.cook_proof () in
+  let const = { const with const_entry_opaque = opacity } in
+  check_anonymity id save_ident;
+  save save_ident const persistence hook
+
+let save_anonymous_with_strength kind opacity save_ident =
+  let id,(const,_,hook) = Pfedit.cook_proof () in
+  let const = { const with const_entry_opaque = opacity } in
+  check_anonymity id save_ident;
+  (* we consider that non opaque behaves as local for discharge *)
+  save save_ident const (Global, Proof kind) hook
+
+let subtac_end_proof = function
+  | Admitted -> admit ()
+  | Proved (is_opaque,idopt) ->
+    if_verbose show_script ();
+    match idopt with
+    | None -> save_named is_opaque
+    | Some ((_,id),None) -> save_anonymous is_opaque id
+    | Some ((_,id),Some kind) -> save_anonymous_with_strength kind is_opaque id
+
+	*)
+
+let subtac (loc, command) =
+  check_required_library ["Coq";"Init";"Datatypes"];
+  check_required_library ["Coq";"Init";"Specif"];
+  require_library "Coq.subtac.FixSub";
+  require_library "Coq.subtac.Utils";
+  try
+    match command with
+	VernacDefinition (defkind, (locid, id), expr, hook) -> 
+	  let env = Global.env () in
+	  let isevars = ref (create_evar_defs Evd.empty) in
+	    (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");	     
+		     
+	       | 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)
+      | VernacFixpoint (l, b) -> 
+	  let _ = trace (str "Building fixpoint") in
+	    ignore(Subtac_command.build_recursive l b)
+      (*| VernacEndProof e -> 
+	  subtac_end_proof e*)
+
+      | _ -> user_err_loc (loc,"", str ("Invalid Program command"))
+  with 
+    | Typing_error e ->
+	msg_warning (str "Type error in Program tactic:");
+	let cmds = 
+	  (match e with
+	     | NonFunctionalApp (loc, x, mux, e) ->
+		 str "non functional application of term " ++ 
+		 e ++ str " to function " ++ x ++ str " of (mu) type " ++ mux
+	     | NonSigma (loc, t) ->
+		 str "Term is not of Sigma type: " ++ t
+	     | NonConvertible (loc, x, y) ->
+		 str "Unconvertible terms:" ++ spc () ++
+		   x ++ spc () ++ str "and" ++ spc () ++ y
+	     | IllSorted (loc, t) ->
+		 str "Term is ill-sorted:" ++ spc () ++ t
+	  )
+	in msg_warning cmds
+	     
+    | Subtyping_error e ->
+	msg_warning (str "(Program tactic) Subtyping error:");
+	let cmds = 
+	  match e with
+	    | UncoercibleInferType (loc, x, y) ->
+		str "Uncoercible terms:" ++ spc ()
+		++ x ++ spc () ++ str "and" ++ spc () ++ y
+	    | UncoercibleInferTerm (loc, x, y, tx, ty) ->
+		str "Uncoercible terms:" ++ spc ()
+		++ tx ++ spc () ++ str "of" ++ spc () ++ str "type" ++ spc () ++ x
+		++ str "and" ++ spc() ++ ty ++ spc () ++ str "of" ++ spc () ++ str "type" ++ spc () ++ y
+	    | UncoercibleRewrite (x, y) ->
+		str "Uncoercible terms:" ++ spc ()
+		++ x ++ spc () ++ str "and" ++ spc () ++ y
+	in msg_warning cmds
+    
+    | Type_errors.TypeError (env, e) ->
+	debug 2 (Himsg.explain_type_error env e)
+	  
+    | Pretype_errors.PretypeError (env, e) ->
+	debug 2 (Himsg.explain_pretype_error env e)
+	  
+    | Stdpp.Exc_located (loc, e) ->
+	debug 2 (str "Parsing exception: ");
+	(match e with
+	   | Type_errors.TypeError (env, e) ->
+	       debug 2 (Himsg.explain_type_error env e)
+		 
+	   | Pretype_errors.PretypeError (env, e) ->
+	       debug 2 (Himsg.explain_pretype_error env e)
+
+	   | e -> msg_warning (str "Unexplained exception: " ++ Cerrors.explain_exn e))
+  
+    | e -> 
+	msg_warning (str "Uncatched exception: " ++ Cerrors.explain_exn e)
+
+
diff --git a/contrib/subtac/subtac.mli b/contrib/subtac/subtac.mli
new file mode 100644
index 00000000..a0d2fb2b
--- /dev/null
+++ b/contrib/subtac/subtac.mli
@@ -0,0 +1,14 @@
+val require_library : string -> unit
+val subtac_one_fixpoint :
+  'a ->
+  'b ->
+  (Names.identifier * (int * Topconstr.recursion_order_expr) *
+   Topconstr.local_binder list * Topconstr.constr_expr *
+   Topconstr.constr_expr) *
+  'c ->
+  (Names.identifier * (int * Topconstr.recursion_order_expr) *
+   Topconstr.local_binder list * Topconstr.constr_expr *
+   Topconstr.constr_expr) *
+  'c
+val subtac_fixpoint : 'a -> 'b -> unit
+val subtac : Util.loc * Vernacexpr.vernac_expr -> unit
diff --git a/contrib/subtac/subtac_coercion.ml b/contrib/subtac/subtac_coercion.ml
new file mode 100644
index 00000000..7c8ea2d6
--- /dev/null
+++ b/contrib/subtac/subtac_coercion.ml
@@ -0,0 +1,485 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: subtac_coercion.ml 8695 2006-04-10 16:33:52Z msozeau $ *)
+
+open Util
+open Names
+open Term
+open Reductionops
+open Environ
+open Typeops
+open Pretype_errors
+open Classops
+open Recordops
+open Evarutil
+open Evarconv
+open Retyping
+open Evd
+
+open Global
+open Subtac_utils
+open Coqlib
+open Printer
+open Subtac_errors
+open Context
+open Eterm
+open Pp
+
+let pair_of_array a = (a.(0), a.(1))
+let make_name s = Name (id_of_string s)
+
+module Coercion = struct
+
+  exception NoSubtacCoercion
+
+  let rec disc_subset x = 
+    match kind_of_term x with
+      | App (c, l) ->
+	  (match kind_of_term c with
+	       Ind i ->
+		 let len = Array.length l in
+		 let sig_ = Lazy.force sig_ in
+		   if len = 2 && i = Term.destInd sig_.typ
+		   then
+		     let (a, b) = pair_of_array l in
+		       Some (a, b)
+		   else None
+	     | _ -> None)
+      | _ -> None
+	  
+  and disc_exist env x =
+    trace (str "Disc_exist: " ++ my_print_constr env x);
+    match kind_of_term x with
+      | App (c, l) ->
+	  (match kind_of_term c with
+	       Construct c ->	       
+		 if c = Term.destConstruct (Lazy.force sig_).intro
+		 then Some (l.(0), l.(1), l.(2), l.(3))
+		 else None
+	     | _ -> None)
+      | _ -> None
+
+
+  let disc_proj_exist env x =
+    trace (str "disc_proj_exist: " ++ my_print_constr env x);
+    match kind_of_term x with
+      | App (c, l) ->
+	  (if Term.eq_constr c (Lazy.force sig_).proj1 
+	     && Array.length l = 3 
+	   then disc_exist env l.(2)
+	   else None)
+      | _ -> None
+
+
+  let sort_rel s1 s2 = 
+    match s1, s2 with
+	Prop Pos, Prop Pos -> Prop Pos
+      | Prop Pos, Prop Null -> Prop Null
+      | Prop Null, Prop Null -> Prop Null
+      | Prop Null, Prop Pos -> Prop Pos
+      | Type _, Prop Pos -> Prop Pos
+      | Type _, Prop Null -> Prop Null
+      | _, Type _ -> s2
+
+  let hnf env isevars c = whd_betadeltaiota env (evars_of !isevars) c
+
+  let rec mu env isevars t =   
+    let rec aux v = 
+      match disc_subset v with
+	  Some (u, p) -> 
+	    let f, ct = aux u in
+	      (Some (fun x ->		   
+		       app_opt f (mkApp ((Lazy.force sig_).proj1, 
+					 [| u; p; x |]))),
+	       ct)
+	| None -> (None, t)
+    in aux t
+
+  and coerce loc env isevars (x : Term.constr) (y : Term.constr) 
+      : (Term.constr -> Term.constr) option 
+      =
+    let x = nf_evar (evars_of !isevars) x and y = nf_evar (evars_of !isevars) y in
+      trace (str "Coerce called for " ++ (my_print_constr env x) ++ 
+	     str " and "++ my_print_constr env y ++ 
+	     str " with evars: " ++ spc () ++
+	     my_print_evardefs !isevars);
+    let rec coerce_unify env x y =
+      trace (str "coerce_unify from " ++ (my_print_constr env x) ++ 
+	     str " to "++ my_print_constr env y);
+      try 
+	isevars := the_conv_x_leq env x y !isevars;
+	trace (str "Unified " ++ (my_print_constr env x) ++ 
+	       str " and "++ my_print_constr env y);
+	None
+      with Reduction.NotConvertible -> coerce' env (hnf env isevars x) (hnf env isevars y)
+    and coerce' env x y : (Term.constr -> Term.constr) option =
+      let subco () = subset_coerce env isevars x y in
+	trace (str "coerce' from " ++ (my_print_constr env x) ++ 
+		 str " to "++ my_print_constr env y);
+	match (kind_of_term x, kind_of_term y) with
+	  | Sort s, Sort s' -> 
+	      (match s, s' with
+		   Prop x, Prop y when x = y -> None
+		 | Prop _, Type _ -> None
+		 | 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 env' = push_rel (name', None, a') env in
+	      let c2 = coerce_unify env' b b' in
+		(match c1, c2 with
+		     None, None -> failwith "subtac.coerce': Should have detected equivalence earlier"
+		   | _, _ ->
+		       Some
+			 (fun f -> 
+			    mkLambda (name', a',
+				      app_opt c2
+					(mkApp (Term.lift 1 f, 
+						[| app_opt c1 (mkRel 1) |])))))
+		  
+	  | App (c, l), App (c', l') ->
+	      (match kind_of_term c, kind_of_term c' with
+		   Ind i, Ind i' -> (* Sigma types *)
+		     let len = Array.length l in
+		     let existS = Lazy.force existS in
+		     let prod = Lazy.force prod in
+		       if len = Array.length l' && len = 2 && i = i'
+		       then 
+			 if i = Term.destInd existS.typ 
+			 then
+			   begin 
+			     debug 1 (str "In coerce sigma types");
+			     let (a, pb), (a', pb') = 
+			       pair_of_array l, pair_of_array l' 
+			     in
+			     let c1 = coerce_unify env a a' in
+			     let rec remove_head a c = 
+			       match kind_of_term c with 
+				 | Lambda (n, t, t') -> c, t'
+				     (*| Prod (n, t, t') -> t'*)
+				 | Evar (k, args) ->
+				     let (evs, t) = Evarutil.define_evar_as_lambda !isevars (k,args) in
+				       isevars := evs;
+				       let (n, dom, rng) = destLambda t in
+				       let (domk, args) = destEvar dom in
+					 isevars := evar_define domk a !isevars;
+					 t, rng
+				 | _ -> raise NoSubtacCoercion
+			     in
+			     let (pb, b), (pb', b') = remove_head a pb, remove_head a' pb' in
+			     let env' = push_rel (make_name "x", None, a) env in
+			     let c2 = coerce_unify env' b b' in
+			       match c1, c2 with
+				   None, None -> 
+				     trace (str "No coercion needed");
+				     None
+				 | _, _ ->
+				     Some 
+				       (fun x ->
+					  let x, y = 
+					    app_opt c1 (mkApp (existS.proj1,
+							       [| a; pb; x |])),
+					    app_opt c2 (mkApp (existS.proj2, 
+							       [| a; pb; x |]))
+					  in
+					    mkApp (existS.intro, [| a'; pb'; x ; y |]))
+			   end
+			 else if i = Term.destInd prod.typ then
+			   begin 
+			     debug 1 (str "In coerce prod types");
+			     let (a, b), (a', b') = 
+			       pair_of_array l, pair_of_array l' 
+			     in
+			     let c1 = coerce_unify env a a' in
+			     let c2 = coerce_unify env b b' in
+			       match c1, c2 with
+				   None, None -> None
+				 | _, _ ->
+				     Some 
+				       (fun x ->
+					  let x, y = 
+					    app_opt c1 (mkApp (prod.proj1,
+							       [| a; b; x |])),
+					    app_opt c2 (mkApp (prod.proj2, 
+							       [| a; b; x |]))
+					  in
+					    mkApp (prod.intro, [| a'; b'; x ; y |]))
+			   end
+			 else subco ()
+		       else subco ()
+		 | _ ->  subco ())
+	  | _, _ ->  subco ()
+
+    and subset_coerce env isevars x y =
+      match disc_subset x with
+	  Some (u, p) -> 
+	    let c = coerce_unify env u y in
+	    let f x = 
+	      app_opt c (mkApp ((Lazy.force sig_).proj1, 
+				[| u; p; x |]))
+	    in Some f
+	| None ->
+	    match disc_subset y with
+		Some (u, p) ->
+		  let c = coerce_unify env x u in
+		    Some 
+		      (fun x ->
+			 let cx = app_opt c x in
+			 let evar = make_existential dummy_loc env isevars (mkApp (p, [| cx |]))
+			 in
+			   (mkApp 
+			      ((Lazy.force sig_).intro, 
+			       [| u; p; cx; evar |])))
+	      | None -> 
+		  raise NoSubtacCoercion
+		    (*isevars := Evd.add_conv_pb (Reduction.CONV, x, y) !isevars;
+		  None*)
+    in coerce_unify env x y
+
+  let coerce_itf loc env isevars v t c1 =
+    let evars = ref isevars in
+    let coercion = coerce loc env evars t c1 in
+      !evars, option_app (app_opt coercion) v, t
+	
+  (* Taken from pretyping/coercion.ml *)
+
+  (* Typing operations dealing with coercions *)
+
+  let class_of1 env sigma t = class_of env sigma (nf_evar sigma t)
+
+  (* Here, funj is a coercion therefore already typed in global context *)
+  let apply_coercion_args env argl funj =
+    let rec apply_rec acc typ = function
+      | [] -> { uj_val = applist (j_val funj,argl);
+		uj_type = typ }
+      | h::restl ->
+	  (* On devrait pouvoir s'arranger pour qu'on n'ait pas à faire hnf_constr *)
+  	  match kind_of_term (whd_betadeltaiota env Evd.empty typ) with
+	    | Prod (_,c1,c2) -> 
+		(* Typage garanti par l'appel à app_coercion*)
+		apply_rec (h::acc) (subst1 h c2) restl
+	    | _ -> anomaly "apply_coercion_args"
+    in 
+      apply_rec [] funj.uj_type argl
+
+  (* appliquer le chemin de coercions de patterns p *)
+  exception NoCoercion
+
+  let apply_pattern_coercion loc pat p =
+    List.fold_left
+      (fun pat (co,n) ->
+	 let f i = if i<n then Rawterm.PatVar (loc, Anonymous) else pat in
+	   Rawterm.PatCstr (loc, co, list_tabulate f (n+1), Anonymous))
+      pat p
+
+  (* raise Not_found if no coercion found *)
+  let inh_pattern_coerce_to loc pat ind1 ind2 =
+    let i1 = inductive_class_of ind1 in
+    let i2 = inductive_class_of ind2 in
+    let p = lookup_pattern_path_between (i1,i2) in
+      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
+             (fun (ja,typ_cl) i -> 
+		let fv,isid = coercion_value i in
+		let argl = (class_args_of typ_cl)@[ja.uj_val] in
+		let jres = apply_coercion_args env argl fv in
+		  (if isid then 
+		     { uj_val = ja.uj_val; uj_type = jres.uj_type }
+		   else 
+		     jres),
+		jres.uj_type)
+             (hj,typ_cl) p)
+    with _ -> anomaly "apply_coercion"
+
+  let inh_app_fun env isevars j = 
+    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) ->
+	    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 p = lookup_path_to_fun_from i1 in
+		 (isevars,apply_coercion env p j t)
+	     with Not_found ->
+	       try 
+		 let coercef, t = mu env isevars t in
+		   (isevars, { uj_val = app_opt coercef j.uj_val; uj_type = t })
+	       with NoSubtacCoercion | NoCoercion ->
+		 (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 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))
+    with Not_found ->
+      error_not_a_type_loc loc env (evars_of isevars) j
+
+  let inh_coerce_to_sort loc env isevars j =
+    let typ = whd_betadeltaiota env (evars_of isevars) j.uj_type in
+      match kind_of_term typ with
+	| Sort s -> (isevars,{ utj_val = j.uj_val; utj_type = s })
+	| Evar ev when not (is_defined_evar isevars ev) ->
+	    let (isevars',s) = define_evar_as_sort isevars ev in
+	      (isevars',{ utj_val = j.uj_val; utj_type = s })
+	| _ ->
+	    inh_tosort_force loc env isevars j
+
+  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 p = lookup_path_between (i2,i1) in
+	  match v with
+	      Some v -> 
+		let j = apply_coercion env p {uj_val = v; uj_type = t} t2 in
+		  Some j.uj_val, j.uj_type
+	    | None -> None, t
+      with Not_found -> raise NoCoercion 
+    in
+      try (the_conv_x_leq env t' c1 isevars, v', t')
+      with Reduction.NotConvertible -> raise NoCoercion
+
+  let rec inh_conv_coerce_to_fail loc env isevars v t c1 =
+    (try
+       trace (str "inh_conv_coerce_to_fail called for " ++
+	      Termops.print_constr_env env t ++ str " and "++ spc () ++
+	      Termops.print_constr_env env c1 ++ str " with evars: " ++ spc () ++
+	      Evd.pr_evar_defs isevars ++ str " in env: " ++ spc () ++
+	      Termops.print_env env);
+     with _ -> ());
+    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_app (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_app (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_app (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_app (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) as tycon) =
+    (try 
+       trace (str "Subtac_coercion.inh_conv_coerce_to called for " ++
+	      Termops.print_constr_env env cj.uj_type ++ str " and "++ spc () ++ 
+	      Evarutil.pr_tycon_type env tycon ++ str " with evars: " ++ spc () ++
+	      Evd.pr_evar_defs isevars ++ str " in env: " ++ spc () ++
+	      Termops.print_env env);
+     with _ -> ());
+    match n with
+	None ->
+	  let (evd', val', type') = 
+	    try 
+	      inh_conv_coerce_to_fail loc env isevars (Some cj.uj_val) cj.uj_type t
+	    with NoCoercion ->
+	      let sigma = evars_of isevars in
+		try
+		  coerce_itf loc env isevars (Some cj.uj_val) cj.uj_type t
+		with NoSubtacCoercion ->
+		  error_actual_type_loc loc env sigma cj t
+	  in
+	  let val' = match val' with Some v -> v | None -> assert(false) in
+	    (evd',{ uj_val = val'; uj_type = t })
+      | Some (init, cur) ->
+	  (isevars, cj)
+
+  let inh_conv_coerces_to loc env isevars t ((abs, t') as tycon) =
+    (try 
+       trace (str "Subtac_coercion.inh_conv_coerces_to called for " ++
+	      Termops.print_constr_env env t ++ str " and "++ spc () ++ 
+	      Evarutil.pr_tycon_type env tycon ++ str " with evars: " ++ spc () ++
+	      Evd.pr_evar_defs isevars ++ str " in env: " ++ spc () ++
+	      Termops.print_env env);
+     with _ -> ());
+    let nabsinit, nabs = 
+      match abs with
+	  None -> 0, 0
+	| Some (init, cur) -> init, cur
+    in
+    let (rels, rng) = 
+      (* a little more effort to get products is needed *) 
+      try decompose_prod_n nabs t
+      with _ -> 
+	trace (str "decompose_prod_n failed");
+	raise (Invalid_argument "Subtac_coercion.inh_conv_coerces_to")
+    in
+      (* The final range free variables must have been replaced by evars, we accept only that evars
+	 in rng are applied to free vars. *)
+      if noccur_with_meta 0 (succ nabsinit) rng then (
+	trace (str "No occur between 0 and " ++ int (succ nabsinit));
+	let env', t, t' = 
+	  let env' = List.fold_right (fun (n, t) env -> push_rel (n, None, t) env) rels env in
+	    env', rng, lift nabs t'
+	in
+	  try 
+	    pi1 (try inh_conv_coerce_to_fail loc env' isevars None t t'
+		 with NoCoercion ->
+		   coerce_itf loc env' isevars None t t') 
+	  with NoSubtacCoercion ->
+	    let sigma = evars_of isevars in
+	      error_cannot_coerce env' sigma (t, t'))
+      else isevars 
+end
diff --git a/contrib/subtac/subtac_coercion.mli b/contrib/subtac/subtac_coercion.mli
new file mode 100644
index 00000000..53a8d213
--- /dev/null
+++ b/contrib/subtac/subtac_coercion.mli
@@ -0,0 +1 @@
+module Coercion : Coercion.S
diff --git a/contrib/subtac/subtac_command.ml b/contrib/subtac/subtac_command.ml
new file mode 100644
index 00000000..1b92c691
--- /dev/null
+++ b/contrib/subtac/subtac_command.ml
@@ -0,0 +1,422 @@
+open Closure
+open RedFlags
+open Declarations
+open Entries
+open Dyn
+open Libobject
+open Pattern
+open Matching
+open Pp
+open Rawterm
+open Sign
+open Tacred
+open Util
+open Names
+open Nameops
+open Libnames
+open Nametab
+open Pfedit
+open Proof_type
+open Refiner
+open Tacmach
+open Tactic_debug
+open Topconstr
+open Term
+open Termops
+open Tacexpr
+open Safe_typing
+open Typing
+open Hiddentac
+open Genarg
+open Decl_kinds
+open Mod_subst
+open Printer
+open Inductiveops
+open Syntax_def
+open Environ
+open Tactics
+open Tacticals
+open Tacinterp
+open Vernacexpr
+open Notation
+
+module SPretyping = Subtac_pretyping.Pretyping
+open Subtac_utils
+open Pretyping
+
+(*********************************************************************)
+(* Functions to parse and interpret constructions *)
+
+let evar_nf isevars c =
+  isevars := Evarutil.nf_evar_defs !isevars;
+  Evarutil.nf_isevar !isevars c
+
+let interp_gen kind isevars env 
+               ?(impls=([],[])) ?(allow_soapp=false) ?(ltacvars=([],[]))
+               c =
+  let c' = Constrintern.intern_gen (kind=IsType) ~impls ~allow_soapp ~ltacvars (Evd.evars_of !isevars) env c in
+  let c' = Subtac_interp_fixpoint.rewrite_cases env c' in
+    msgnl (str "Pretyping " ++ my_print_constr_expr c);
+  let c' = SPretyping.pretype_gen isevars env ([],[]) kind c' in
+    evar_nf isevars c'
+    
+let interp_constr isevars env c =
+  interp_gen (OfType None) isevars env c 
+
+let interp_type isevars env ?(impls=([],[])) c =
+  interp_gen IsType isevars env ~impls c
+
+let interp_casted_constr isevars env ?(impls=([],[])) c typ =
+  interp_gen (OfType (Some typ)) isevars env ~impls c 
+
+let interp_open_constr isevars env c =
+    msgnl (str "Pretyping " ++ my_print_constr_expr c);
+  let c = Constrintern.intern_constr (Evd.evars_of !isevars) env c in
+  let c' = SPretyping.pretype_gen isevars env ([], []) (OfType None) c in
+    evar_nf isevars c'
+
+let interp_constr_judgment isevars env c =
+  let j = 
+    SPretyping.understand_judgment_tcc isevars env
+      (Constrintern.intern_constr (Evd.evars_of !isevars) env c) 
+  in
+    { uj_val = evar_nf isevars j.uj_val; uj_type = evar_nf isevars j.uj_type }
+
+let locate_if_isevar loc na = function
+  | RHole _ -> 
+      (try match na with
+	| Name id ->  Reserve.find_reserved_type id
+	| Anonymous -> raise Not_found 
+      with Not_found -> RHole (loc, Evd.BinderType na))
+  | x -> x
+
+let interp_binder sigma env na t =
+  let t = Constrintern.intern_gen true (Evd.evars_of !sigma) env t in
+    SPretyping.understand_type (Evd.evars_of !sigma) env (locate_if_isevar (loc_of_rawconstr t) na t)
+      
+
+let interp_context sigma env params = 
+  List.fold_left
+    (fun (env,params) d -> match d with
+      | LocalRawAssum ([_,na],(CHole _ as t)) ->
+	  let t = interp_binder sigma env na t in
+	  let d = (na,None,t) in
+	  (push_rel d env, d::params)
+      | LocalRawAssum (nal,t) ->
+	  let t = interp_type sigma 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 sigma env c in
+	  let d = (na, Some c.uj_val, c.uj_type) in
+	  (push_rel d env,d::params))
+    (env,[]) params
+
+(* 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 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 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
+      hd :: tl -> (match f hd with Some t -> aux (t :: acc) tl
+		     | None -> aux acc tl)
+    | [] -> List.rev acc
+  in aux [] l
+
+let list_of_local_binders l = 
+  let rec aux acc = function
+      Topconstr.LocalRawDef (n, c) :: tl -> aux ((n, Some c, None) :: acc) tl
+    | Topconstr.LocalRawAssum (nl, c) :: tl -> 
+	aux (List.fold_left (fun acc n -> (n, None, Some c) :: acc) acc nl) tl
+    | [] -> List.rev acc
+  in aux [] l
+
+let build_recursive (lnameargsardef:(fixpoint_expr * decl_notation) list) boxed =
+  let sigma = Evd.empty
+  and env0 = Global.env()
+  in 
+  let lnameargsardef =
+    (*List.map (fun (f, d) -> Subtac_interp_fixpoint.rewrite_fixpoint env0 protos (f, d))*)
+      lnameargsardef
+  in
+  let lrecnames = List.map (fun ((f,_,_,_,_),_) -> f) lnameargsardef 
+  and nv = List.map (fun ((_,n,_,_,_),_) -> n) 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,(n, ro),bl,arityc,body),_) -> 
+	let isevars = ref (Evd.create_evar_defs sigma) in	  
+	  match ro with
+	      CStructRec ->
+		let arityc = Command.generalize_constr_expr arityc bl in
+		let arity = interp_type isevars 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', (isevars, None, arity)::arl)
+	    | CWfRec r -> 		    
+		let _ = trace (str "Rewriting fixpoint: " ++ Ppconstr.pr_id recname ++ 
+			       Ppconstr.pr_binders bl ++ str " : " ++ 
+			       Ppconstr.pr_constr_expr arityc ++ str " := " ++ spc () ++
+			       Ppconstr.pr_constr_expr body)
+		in
+		let env', binders_rel = interp_context isevars env0 bl in
+		let after, ((argname, _, argtyp) as arg), before = list_chop_hd n binders_rel in
+		let argid = match argname with Name n -> n | _ -> assert(false) in
+		let after' = List.map (fun (n, c, t) -> (n, option_app (lift 1) c, lift 1 t)) after in
+		let envwf = push_rel_context before env0 in
+		let wf_rel = interp_constr isevars envwf r in
+		let accarg_id = id_of_string ("Acc_" ^ string_of_id argid) in
+		let accarg = (Name accarg_id, None, mkApp (Lazy.force acc_inv, [| argtyp; wf_rel; mkRel 1 |])) in
+		let argid' = id_of_string (string_of_id argid ^ "'") in
+		let before_length, after_length = List.length before, List.length after in
+		let full_length = before_length + 1 + after_length in
+		let wfarg len = (Name argid, None, 
+				 mkSubset (Name argid') argtyp 
+				   (mkApp (wf_rel, [|mkRel 1; mkRel (len + 1)|])))
+		in
+		let new_bl = after' @ (accarg :: arg :: before)
+		and intern_bl =  after @ (wfarg (before_length + 1) :: before)
+		in
+		let intern_env = push_rel_context intern_bl env0 in
+		let env' = push_rel_context new_bl env0 in
+		let arity = interp_type isevars intern_env arityc in
+		let intern_arity = it_mkProd_or_LetIn arity intern_bl in
+		let arity' = interp_type isevars env' arityc in
+		let arity' = it_mkProd_or_LetIn arity' new_bl in
+		let fun_bl = after @ ((Name recname, None, intern_arity) :: arg :: before) in
+		let _ = 
+		  let pr c = my_print_constr env c in
+		  let prr = Printer.pr_rel_context env in
+		    trace (str "Fun bl: " ++ prr fun_bl ++ spc () ++
+			     str "Intern bl" ++ prr intern_bl ++ spc () ++
+			     str "Extern bl" ++ prr new_bl ++ spc () ++
+			     str "Intern arity: " ++ pr intern_arity)
+		in
+		let impl = 
+		  if Impargs.is_implicit_args()
+		  then Impargs.compute_implicits intern_env arity'
+		  else [] in
+		let impls' = (recname,([],impl,compute_arguments_scope arity'))::impls in
+		  (Environ.push_named (recname,None,arity') env, impls', 
+		   (isevars, Some (full_length - n, argtyp, wf_rel, fun_bl, intern_bl, intern_arity), 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) -> (* No scope for tmp notation *)
+	 Metasyntax.add_notation_interpretation df rec_impls c None) notations;
+	List.map2
+	  (fun ((_,_,bl,_,def),_) (isevars, info, arity) ->
+	     match info with
+		 None ->
+		   let def = abstract_constr_expr def bl in
+		     isevars, info, interp_casted_constr isevars rec_sign ~impls:([],rec_impls)
+		       def arity
+	       | Some (n, artyp, wfrel, fun_bl, intern_bl, intern_arity) ->
+		   let rec_sign = push_rel_context fun_bl rec_sign in
+		   let cstr = interp_casted_constr isevars rec_sign ~impls:([],rec_impls)
+				def intern_arity
+		   in isevars, info, it_mkLambda_or_LetIn cstr fun_bl)
+          lnameargsardef arityl
+      with e ->
+	States.unfreeze fs; raise e in
+    States.unfreeze fs; def 
+  in
+
+  let (lnonrec,(namerec,defrec,arrec,nvrec)) = 
+    collect_non_rec env0 lrecnames recdef arityl nv in
+  let nvrec' = Array.map fst nvrec in(* ignore rec order *)
+  let declare arrec defrec =
+    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 =
+      trace (str "Declaring: " ++ pr_id fi ++ spc () ++
+	     my_print_constr env0 (recvec.(i)));
+      let ce = 
+	{ const_entry_body = mkFix ((nvrec',i),recdecls); 
+          const_entry_type = Some arrec.(i);
+          const_entry_opaque = false;
+          const_entry_boxed = boxed} in
+      let kn = Declare.declare_constant fi (DefinitionEntry ce,IsDefinition Fixpoint)
+      in (ConstRef kn)
+    in 
+      (* declare the recursive definitions *)
+    let lrefrec = Array.mapi declare namerec in
+      Options.if_verbose ppnl (recursive_message lrefrec);
+
+
+      (*(* The others are declared as normal definitions *)
+      let var_subst id = (id, Constrintern.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.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
+  in 
+  let declare l = 
+    let recvec = Array.of_list l
+    and arrec = Array.map pi3 arrec
+    in declare arrec recvec
+  in
+  let recdefs = Array.length defrec in
+    trace (int recdefs ++ str " recursive definitions");
+    (* Solve remaining evars *)
+  let rec collect_evars i acc = 
+    if i < recdefs then
+      let (isevars, info, def) = defrec.(i) in
+      let _ = trace (str "In solve evars, isevars is: " ++ Evd.pr_evar_defs !isevars) in
+      let def = evar_nf isevars def in
+      let isevars = Evd.undefined_evars !isevars in
+      let _ = trace (str "In solve evars, undefined is: " ++ Evd.pr_evar_defs isevars) in
+      let evm = Evd.evars_of isevars in
+      let _, _, typ = arrec.(i) in
+      let id = namerec.(i) in
+      let evars_def, evars_typ, evars = Eterm.eterm_term evm def (Some typ) in 	
+      (* Generalize by the recursive prototypes  *)
+      let def = 
+	Termops.it_mkNamedLambda_or_LetIn def (Environ.named_context rec_sign)
+      and typ = 
+	Termops.it_mkNamedProd_or_LetIn typ (Environ.named_context rec_sign) 
+      in
+      (*let evars_typ = match evars_typ with Some t -> t | None -> assert(false) in*)
+      (*let fi = id_of_string (string_of_id id ^ "_evars") in*)
+      (*let ce = 
+	{ const_entry_body = evars_def; 
+	  const_entry_type = Some evars_typ;
+	  const_entry_opaque = false;
+	  const_entry_boxed = boxed} in
+      let kn = Declare.declare_constant fi (DefinitionEntry ce,IsDefinition Definition) in
+	definition_message fi;
+	trace (str (string_of_id fi) ++ str " is defined");*)
+	let evar_sum =
+	  if evars = [] then None
+	  else 
+	    let sum = Subtac_utils.build_dependent_sum evars in
+	      trace (str "Evars sum: " ++ my_print_constr env0 (pi1 sum));
+	      Some sum
+	in
+	  collect_evars (succ i) ((id, evars_def, evar_sum) :: acc)
+    else acc
+  in 
+  let defs = collect_evars 0 [] in
+
+  (* Solve evars then create the definitions *)
+  let real_evars = 
+    filter_map (fun (id, kn, sum) ->
+		  match sum with Some (sumg, sumtac, _) -> Some (id, kn, sumg, sumtac) | None -> None)
+      defs
+  in
+    Subtac_utils.and_tac real_evars
+      (fun f _ gr ->
+	 let _ = trace (str "Got a proof of: " ++ pr_global gr) in
+	 let constant = match gr with Libnames.ConstRef c -> c
+	   | _ -> assert(false)
+	 in
+	   try
+	     (*let value = Environ.constant_value (Global.env ()) constant in*)
+	     let pis = f (mkConst constant) in
+	       trace (str "Accessors: " ++
+		      List.fold_right (fun (_, _, _, c) acc -> my_print_constr env0 c ++ spc () ++ acc)
+			pis (mt()));
+	       trace (str "Applied existentials: " ++
+		      (List.fold_right
+			 (fun (id, kn, sumg, pi) acc ->
+			    let args = Subtac_utils.destruct_ex pi sumg in
+			      my_print_constr env0 (mkApp (kn, Array.of_list args)))
+			 pis (mt ())));
+	       let rec aux pis acc = function
+		   (id, kn, sum) :: tl ->
+		     (match sum with 
+			  None -> aux pis (kn :: acc) tl
+			| Some (sumg, _, _) -> 
+			    let (id, kn, sumg, pi), pis = List.hd pis, List.tl pis in
+			    let args = Subtac_utils.destruct_ex pi sumg in
+			    let args = 
+			      List.map (fun c -> 
+					  try Reductionops.whd_betadeltaiota (Global.env ()) Evd.empty c
+					  with Not_found ->
+					    trace (str "Not_found while reducing " ++
+						   my_print_constr (Global.env ()) c);
+					    c
+				       ) args 				  
+			    in
+			    let _, newdef = decompose_lam_n (recdefs + List.length args) kn in
+			    let constr = Term.substl (mkRel 1 :: List.rev args) newdef in
+			      aux pis (constr :: acc) tl)
+		 | [] -> List.rev acc
+	       in
+		 declare (aux pis [] defs)
+	   with Environ.NotEvaluableConst cer ->
+	     match cer with
+		 Environ.NoBody -> trace (str "Constant has no body")
+	       | Environ.Opaque -> trace (str "Constant is opaque")
+      )
+      
+      
diff --git a/contrib/subtac/subtac_command.mli b/contrib/subtac/subtac_command.mli
new file mode 100644
index 00000000..e1bbbbb5
--- /dev/null
+++ b/contrib/subtac/subtac_command.mli
@@ -0,0 +1,42 @@
+open Pretyping
+open Evd
+open Environ
+open Term
+open Topconstr
+open Names
+open Libnames
+open Pp
+open Vernacexpr
+open Constrintern
+
+val interp_gen :
+  typing_constraint ->
+  evar_defs ref ->
+  env ->
+  ?impls:full_implicits_env ->
+  ?allow_soapp:bool ->
+  ?ltacvars:ltac_sign ->
+  constr_expr -> constr
+val interp_constr :
+  evar_defs ref ->
+  env -> constr_expr -> constr
+val interp_type :
+  evar_defs ref ->
+  env ->
+  ?impls:full_implicits_env ->
+  constr_expr -> constr
+val interp_casted_constr :
+  evar_defs ref ->
+  env ->
+  ?impls:full_implicits_env ->
+  constr_expr -> types -> constr
+val interp_open_constr :
+  evar_defs ref -> env -> constr_expr -> constr
+val interp_constr_judgment :
+  evar_defs ref ->
+  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_errors.ml b/contrib/subtac/subtac_errors.ml
new file mode 100644
index 00000000..3bbfe22b
--- /dev/null
+++ b/contrib/subtac/subtac_errors.ml
@@ -0,0 +1,24 @@
+open Util
+open Pp
+open Printer
+
+type term_pp = Pp.std_ppcmds
+
+type subtyping_error = 
+  | UncoercibleInferType of loc * term_pp * term_pp
+  | UncoercibleInferTerm of loc * term_pp * term_pp * term_pp * term_pp
+  | UncoercibleRewrite of term_pp * term_pp
+
+type typing_error = 
+  | NonFunctionalApp of loc * term_pp * term_pp * term_pp
+  | NonConvertible of loc * term_pp * term_pp
+  | NonSigma of loc * term_pp
+  | IllSorted of loc * term_pp
+
+exception Subtyping_error of subtyping_error
+exception Typing_error of typing_error
+  
+exception Debug_msg of string
+
+let typing_error e = raise (Typing_error e)
+let subtyping_error e = raise (Subtyping_error e)
diff --git a/contrib/subtac/subtac_errors.mli b/contrib/subtac/subtac_errors.mli
new file mode 100644
index 00000000..8d75b9c0
--- /dev/null
+++ b/contrib/subtac/subtac_errors.mli
@@ -0,0 +1,15 @@
+type term_pp = Pp.std_ppcmds
+type subtyping_error =
+    UncoercibleInferType of Util.loc * term_pp * term_pp
+  | UncoercibleInferTerm of Util.loc * term_pp * term_pp * term_pp * term_pp
+  | UncoercibleRewrite of term_pp * term_pp
+type typing_error =
+    NonFunctionalApp of Util.loc * term_pp * term_pp * term_pp
+  | NonConvertible of Util.loc * term_pp * term_pp
+  | NonSigma of Util.loc * term_pp
+  | IllSorted of Util.loc * term_pp
+exception Subtyping_error of subtyping_error
+exception Typing_error of typing_error
+exception Debug_msg of string
+val typing_error : typing_error -> 'a
+val subtyping_error : subtyping_error -> 'a
diff --git a/contrib/subtac/subtac_interp_fixpoint.ml b/contrib/subtac/subtac_interp_fixpoint.ml
new file mode 100644
index 00000000..599dbe39
--- /dev/null
+++ b/contrib/subtac/subtac_interp_fixpoint.ml
@@ -0,0 +1,219 @@
+open Global
+open Pp
+open Util
+open Names
+open Sign
+open Evd
+open Term
+open Termops
+open Reductionops
+open Environ
+open Type_errors
+open Typeops
+open Libnames
+open Classops
+open List
+open Recordops 
+open Evarutil
+open Pretype_errors
+open Rawterm
+open Evarconv
+open Pattern
+open Dyn
+open Topconstr
+
+open Subtac_coercion
+open Subtac_utils
+open Coqlib
+open Printer
+open Subtac_errors
+open Context
+open Eterm
+
+
+let mkAppExplC (f, args) = CAppExpl (dummy_loc, (None, f), args)
+
+let mkSubset name typ prop = 
+  mkAppExplC (sig_ref,
+	      [ typ; mkLambdaC ([name], typ, prop) ])
+	      
+let mkProj1 u p x = 
+  mkAppExplC (proj1_sig_ref, [ u; p; x ])
+
+let mkProj2 u p x = 
+  mkAppExplC (proj2_sig_ref, [ u; p; x ])
+
+let list_of_local_binders l = 
+  let rec aux acc = function
+      Topconstr.LocalRawDef (n, c) :: tl -> aux ((n, c) :: acc) tl
+    | Topconstr.LocalRawAssum (nl, c) :: tl -> 
+	aux (List.fold_left (fun acc n -> (n, c) :: acc) acc nl) tl
+    | [] -> List.rev acc
+  in aux [] l
+       
+let abstract_constr_expr_bl abs c bl =
+  List.fold_right (fun (n, t) c -> abs ([n], t, c)) bl c
+
+let pr_binder_list b = 
+  List.fold_right (fun ((loc, name), t) acc -> Nameops.pr_name name ++ str " : " ++
+		     Ppconstr.pr_constr_expr t ++ spc () ++ acc) b (mt ()) 
+
+
+let rec rewrite_rec_calls l c = c
+
+let rewrite_fixpoint env l (f, decl) = 
+  let (id, (n, ro), bl, typ, body) = f in
+  let body = rewrite_rec_calls l body in
+    match ro with
+	CStructRec -> ((id, (n, ro), bl, typ, body), decl)
+      | CWfRec wfrel -> 
+	  let bls = list_of_local_binders bl in
+	  let _ = trace (str "Rewriting fixpoint: " ++ Ppconstr.pr_id id ++ 
+			 Ppconstr.pr_binders bl ++ str " : " ++ 
+			 Ppconstr.pr_constr_expr typ ++ str " := " ++ spc () ++
+			 Ppconstr.pr_constr_expr body)
+	  in
+	  let before, after = list_chop n bls in
+	  let _ = trace (str "Binders before the recursion arg: " ++ spc () ++
+			 pr_binder_list before ++ str "; after the recursion arg: " ++
+			 pr_binder_list after)
+	  in
+	  let ((locn, name) as lnid, ntyp), after = match after with
+	      hd :: tl -> hd, tl
+	    | _ -> assert(false) (* Rec arg must be in after *)
+	  in
+	  let nid = match name with
+	      Name id -> id
+	    | Anonymous -> assert(false) (* Rec arg _must_ be named *)
+	  in
+	  let _wfproof = 
+	    let _wf_rel = mkAppExplC (well_founded_ref, [ntyp; wfrel]) in
+	      (*make_existential_expr dummy_loc before wf_rel*)
+	      mkRefC lt_wf_ref
+	  in
+	  let nid', accproofid = 
+	    let nid = string_of_id nid in
+	      id_of_string (nid ^ "'"), id_of_string ("Acc_" ^ nid)
+	  in
+	  let lnid', laccproofid = (dummy_loc, Name nid'), (dummy_loc, Name accproofid) in
+	  let wf_prop = (mkAppC (wfrel, [ mkIdentC nid'; mkIdentC nid ])) in
+	  let lam_wf_prop = mkLambdaC ([lnid'], ntyp, wf_prop) in
+	  let typnid' = mkSubset lnid' ntyp wf_prop in
+	  let internal_type = 
+	    abstract_constr_expr_bl mkProdC 
+	      (mkProdC ([lnid'], typnid', 
+			mkLetInC (lnid, mkProj1 ntyp lam_wf_prop (mkIdentC nid'), 
+				  abstract_constr_expr_bl mkProdC typ after)))
+	      before
+	  in
+	  let body' =
+	    let body =
+	      (* cast or we will loose some info at pretyping time as body
+		 is a function *)
+	      CCast (dummy_loc, body,  DEFAULTcast, typ) 
+	    in
+	    let body' = (* body abstracted by rec call *)
+	      mkLambdaC ([(dummy_loc, Name id)], internal_type, body)
+	    in
+	      mkAppC (body',
+		      [mkLambdaC 
+			 ([lnid'], typnid',
+			  mkAppC (mkIdentC id, 
+				  [mkProj1 ntyp lam_wf_prop (mkIdentC nid');
+				   (mkAppExplC (acc_inv_ref,
+						[ ntyp; wfrel;
+						  mkIdentC nid;
+						  mkIdentC accproofid;
+						  mkProj1 ntyp lam_wf_prop (mkIdentC nid');
+						  mkProj2 ntyp lam_wf_prop (mkIdentC nid') ])) ]))])
+	  in
+	  let acctyp = mkAppExplC (acc_ref, [ ntyp; wfrel; mkIdentC nid ]) in
+	  let bl' = 
+	    let rec aux acc = function
+		Topconstr.LocalRawDef _ as x :: tl -> 
+		  aux (x :: acc) tl
+	      | Topconstr.LocalRawAssum (bl, typ) as assum :: tl ->
+		  let rec aux' bl' = function
+		      ((loc, name') as x) :: tl ->
+			if name' = name then
+			  (if tl = [] then [] else [LocalRawAssum (tl, typ)]) @
+			  LocalRawAssum ([(dummy_loc, Name accproofid)], acctyp) ::
+			    [LocalRawAssum (List.rev (x :: bl'), typ)]
+			else aux' (x :: bl') tl
+		    | [] -> [assum]
+		  in aux (aux' [] bl @ acc) tl
+	      | [] -> List.rev acc
+	    in aux [] bl
+	  in
+	  let _ = trace (str "Rewrote fixpoint: " ++ Ppconstr.pr_id id ++ 
+			 Ppconstr.pr_binders bl' ++ str " : " ++ 
+			 Ppconstr.pr_constr_expr typ ++ str " := " ++ spc () ++
+			 Ppconstr.pr_constr_expr body')
+	  in (id, (succ n, ro), bl', typ, body'), decl
+
+let list_mapi f = 
+  let rec aux i = function 
+      hd :: tl -> f i hd :: aux (succ i) tl 
+    | [] -> []
+  in aux 0
+
+let rewrite_cases_aux (loc, po, tml, eqns) =
+  let tml = list_mapi (fun i (c, (n, opt)) -> c, 
+		       ((match n with
+			    Name id -> (match c with
+					  | RVar (_, id') when id = id' ->
+					      Name (id_of_string (string_of_id id ^ "'"))
+					  | _ -> n)
+			  | Anonymous -> Name (id_of_string ("x" ^ string_of_int i))),
+			opt)) tml 
+  in
+  let mkHole = RHole (dummy_loc, InternalHole) in
+  let mkeq c n = RApp (dummy_loc, RRef (dummy_loc, (Lazy.force eqind_ref)),
+		       [mkHole; c; n])
+  in
+  let eqs_types = 
+    List.map
+      (fun (c, (n, _)) ->
+	 let id = match n with Name id -> id | _ -> assert false in
+	 let heqid = id_of_string ("Heq" ^ string_of_id id) in
+	   Name heqid, mkeq c (RVar (dummy_loc, id)))
+      tml
+  in
+  let po = 
+    List.fold_right
+      (fun (n,t) acc ->
+	 RProd (dummy_loc, Anonymous, t, acc))
+      eqs_types (match po with 
+		     Some e -> e
+		   | None -> mkHole)
+  in
+  let eqns =   
+    List.map (fun (loc, idl, cpl, c) ->
+		let c' = 
+		  List.fold_left 
+		    (fun acc (n, t) ->
+		       RLambda (dummy_loc, n, mkHole, acc))
+		    c eqs_types
+		in (loc, idl, cpl, c'))
+      eqns
+  in
+  let mk_refl_equal c = RApp (dummy_loc, RRef (dummy_loc, Lazy.force refl_equal_ref),
+			      [mkHole; c])
+  in
+  let refls = List.map (fun (c, _) -> mk_refl_equal c) tml in
+  let case = RCases (loc,Some po,tml,eqns) in
+  let app = RApp (dummy_loc, case, refls) in
+    app
+
+let rec rewrite_cases c = 
+  match c with 
+      RCases _ -> let c' = map_rawconstr rewrite_cases c in
+	(match c' with 
+	   | RCases (x, y, z, w) -> rewrite_cases_aux (x,y,z,w)
+	   | _ -> assert(false))
+    | _ -> map_rawconstr rewrite_cases c
+	  
+let rewrite_cases env c =
+  let c' = rewrite_cases c in
+  let _ = trace (str "Rewrote cases: " ++ spc () ++ my_print_rawconstr env c') in
+    c'
diff --git a/contrib/subtac/subtac_interp_fixpoint.mli b/contrib/subtac/subtac_interp_fixpoint.mli
new file mode 100644
index 00000000..b0de0641
--- /dev/null
+++ b/contrib/subtac/subtac_interp_fixpoint.mli
@@ -0,0 +1,39 @@
+val mkAppExplC :
+  Libnames.reference * Topconstr.constr_expr list -> Topconstr.constr_expr
+val mkSubset :
+  Names.name Util.located ->
+  Topconstr.constr_expr -> Topconstr.constr_expr -> Topconstr.constr_expr
+val mkProj1 :
+  Topconstr.constr_expr ->
+  Topconstr.constr_expr -> Topconstr.constr_expr -> Topconstr.constr_expr
+val mkProj2 :
+  Topconstr.constr_expr ->
+  Topconstr.constr_expr -> Topconstr.constr_expr -> Topconstr.constr_expr
+val list_of_local_binders :
+  Topconstr.local_binder list ->
+  (Names.name Util.located * Topconstr.constr_expr) list
+val pr_binder_list :
+  (('a * Names.name) * Topconstr.constr_expr) list -> Pp.std_ppcmds
+val rewrite_rec_calls : 'a -> 'b -> 'b
+val rewrite_fixpoint :
+  'a ->
+  'b ->
+  (Names.identifier * (int * Topconstr.recursion_order_expr) *
+   Topconstr.local_binder list * Topconstr.constr_expr *
+   Topconstr.constr_expr) *
+  'c ->
+  (Names.identifier * (int * Topconstr.recursion_order_expr) *
+   Topconstr.local_binder list * Topconstr.constr_expr *
+   Topconstr.constr_expr) *
+  'c
+val list_mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
+val rewrite_cases_aux :
+  Util.loc * Rawterm.rawconstr option *
+  (Rawterm.rawconstr *
+   (Names.name * (Util.loc * Names.inductive * Names.name list) option))
+  list *
+  (Util.loc * Names.identifier list * Rawterm.cases_pattern list *
+   Rawterm.rawconstr)
+  list -> Rawterm.rawconstr
+
+val rewrite_cases : Environ.env -> Rawterm.rawconstr -> Rawterm.rawconstr
diff --git a/contrib/subtac/subtac_pretyping.ml b/contrib/subtac/subtac_pretyping.ml
new file mode 100644
index 00000000..104a0a58
--- /dev/null
+++ b/contrib/subtac/subtac_pretyping.ml
@@ -0,0 +1,150 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: subtac_pretyping.ml 8688 2006-04-07 15:08:12Z msozeau $ *)
+
+open Global
+open Pp
+open Util
+open Names
+open Sign
+open Evd
+open Term
+open Termops
+open Reductionops
+open Environ
+open Type_errors
+open Typeops
+open Libnames
+open Classops
+open List
+open Recordops 
+open Evarutil
+open Pretype_errors
+open Rawterm
+open Evarconv
+open Pattern
+open Dyn
+
+open Subtac_coercion
+open Subtac_utils
+open Coqlib
+open Printer
+open Subtac_errors
+open Context
+open Eterm
+
+module Pretyping = Pretyping.Pretyping_F(Subtac_coercion.Coercion)
+
+open Pretyping
+
+let _ = Pretyping.allow_anonymous_refs := true
+
+type recursion_info = {
+  arg_name: name;
+  arg_type: types; (* A *)
+  args_after : rel_context;
+  wf_relation: constr; (* R : A -> A -> Prop *)
+  wf_proof: constr; (* : well_founded R *)
+  f_type: types; (* f: A -> Set *)
+  f_fulltype: types; (* Type with argument and wf proof product first *)
+}
+
+let my_print_rec_info env t = 
+  str "Name: " ++ Nameops.pr_name t.arg_name ++ spc () ++
+  str "Arg type: " ++ my_print_constr env t.arg_type ++ spc () ++
+  str "Wf relation: " ++ my_print_constr env t.wf_relation ++ spc () ++
+  str "Wf proof: " ++ my_print_constr env t.wf_proof ++ spc () ++
+  str "Abbreviated Type: " ++ my_print_constr env t.f_type ++ spc () ++
+  str "Full type: " ++ my_print_constr env t.f_fulltype
+(*   trace (str "pretype for " ++ (my_print_rawconstr env c) ++ *)
+(* 	   str " and tycon "++ my_print_tycon env tycon ++ *)
+(* 	   str " in environment: " ++ my_print_env env); *)
+
+let merge_evms x y = 
+  Evd.fold (fun ev evi evm -> Evd.add evm ev evi) x y
+
+let interp env isevars c tycon = 
+  let j = pretype tycon env isevars ([],[]) c in
+  let evm = evars_of !isevars in    
+    nf_evar evm j.uj_val, nf_evar evm j.uj_type
+
+let find_with_index x l =
+  let rec aux i = function
+      (y, _, _) as t :: tl -> if x = y then i, t else aux (succ i) tl
+    | [] -> raise Not_found
+  in aux 0 l
+
+let list_split_at index l = 
+  let rec aux i acc = function
+      hd :: tl when i = index -> (List.rev acc), tl
+    | hd :: tl -> aux (succ i) (hd :: acc) tl
+    | [] -> failwith "list_split_at: Invalid argument"
+  in aux 0 [] l
+
+open Vernacexpr
+
+let coqintern evd env : Topconstr.constr_expr -> Rawterm.rawconstr = Constrintern.intern_constr (evars_of evd) env
+let coqinterp evd env : Topconstr.constr_expr -> Term.constr = Constrintern.interp_constr (evars_of evd) env
+
+let env_with_binders env isevars l =
+  let rec aux ((env, rels) as acc) = function
+      Topconstr.LocalRawDef ((loc, name), def) :: tl -> 
+	let rawdef = coqintern !isevars env def in
+	let coqdef, deftyp = interp env isevars rawdef empty_tycon in
+	let reldecl = (name, Some coqdef, deftyp) in
+	  aux  (push_rel reldecl env, reldecl :: rels) tl
+    | Topconstr.LocalRawAssum (bl, typ) :: tl ->
+	let rawtyp = coqintern !isevars env typ in
+	let coqtyp, typtyp = interp env isevars rawtyp empty_tycon in
+	let acc = 
+	  List.fold_left (fun (env, rels) (loc, name) -> 
+			    let reldecl = (name, None, coqtyp) in
+			      (push_rel reldecl env, 
+			       reldecl :: rels))
+	    (env, rels) bl
+	in aux acc tl
+    | [] -> acc
+  in aux (env, []) l
+
+let subtac_process env isevars id l c tycon =
+  let evars () = evars_of !isevars in
+  let _ = trace (str "Creating env with binders") in
+  let env_binders, binders_rel = env_with_binders env isevars l in
+  let _ = trace (str "New env created:" ++ my_print_context env_binders) in
+  let tycon = 
+    match tycon with
+	None -> empty_tycon
+      | Some t -> 
+	  let t = coqintern !isevars env_binders t in
+	  let _ = trace (str "Internalized specification: " ++ my_print_rawconstr env_binders t) in
+	  let coqt, ttyp = interp env_binders isevars t empty_tycon in
+	  let _ = trace (str "Interpreted type: " ++ my_print_constr env_binders coqt) in
+	    mk_tycon coqt
+  in    
+  let c = coqintern !isevars env_binders c in
+  let _ = trace (str "Internalized term: " ++ my_print_rawconstr env c) in
+  let coqc, ctyp = interp env_binders isevars c tycon in
+  let _ = trace (str "Interpreted term: " ++ my_print_constr env_binders coqc ++ spc () ++
+		 str "Coq type: " ++ my_print_constr env_binders ctyp)
+  in
+  let _ = trace (str "Original evar map: " ++ Evd.pr_evar_map (evars ())) in
+    
+  let fullcoqc = it_mkLambda_or_LetIn coqc binders_rel 
+  and fullctyp = it_mkProd_or_LetIn ctyp binders_rel
+  in
+  let fullcoqc = Evarutil.nf_evar (evars_of !isevars) fullcoqc in
+  let fullctyp = Evarutil.nf_evar (evars_of !isevars) fullctyp in
+
+  let _ = trace (str "After evar normalization: " ++ spc () ++
+		 str "Coq term: " ++ my_print_constr env fullcoqc ++ spc ()
+		 ++ str "Coq type: " ++ my_print_constr env fullctyp) 
+  in
+  let evm = non_instanciated_map env isevars in
+  let _ = trace (str "Non instanciated evars map: " ++ Evd.pr_evar_map evm) in
+    evm, fullcoqc, fullctyp
diff --git a/contrib/subtac/subtac_pretyping.mli b/contrib/subtac/subtac_pretyping.mli
new file mode 100644
index 00000000..97e56ecb
--- /dev/null
+++ b/contrib/subtac/subtac_pretyping.mli
@@ -0,0 +1,12 @@
+open Term
+open Environ
+open Names
+open Sign
+open Evd
+open Global
+open Topconstr
+
+module Pretyping : Pretyping.S
+
+val subtac_process : env -> evar_defs ref -> identifier -> local_binder list ->
+  constr_expr -> constr_expr option -> evar_map * constr * types
diff --git a/contrib/subtac/subtac_utils.ml b/contrib/subtac/subtac_utils.ml
new file mode 100644
index 00000000..6c165dad
--- /dev/null
+++ b/contrib/subtac/subtac_utils.ml
@@ -0,0 +1,246 @@
+open Evd
+open Libnames
+open Coqlib
+open Term
+open Names
+open Util
+
+(****************************************************************************)
+(* Library linking *)
+
+let contrib_name = "subtac"
+
+let subtac_dir = [contrib_name]
+let fix_sub_module = "FixSub"
+let utils_module = "Utils"
+let fixsub_module = subtac_dir @ [fix_sub_module]
+let utils_module = subtac_dir @ [utils_module]
+let init_constant dir s = gen_constant contrib_name dir s
+let init_reference dir s = gen_reference contrib_name dir s
+
+let fixsub = lazy (init_constant fixsub_module "Fix_sub")
+let ex_pi1 = lazy (init_constant utils_module "ex_pi1")
+let ex_pi2 = lazy (init_constant utils_module "ex_pi2")
+
+let make_ref s =  Qualid (dummy_loc, (qualid_of_string s))
+let well_founded_ref = make_ref "Init.Wf.Well_founded"
+let acc_ref = make_ref "Init.Wf.Acc"
+let acc_inv_ref = make_ref "Init.Wf.Acc_inv"
+let fix_sub_ref = make_ref "Coq.subtac.FixSub.Fix_sub"
+let lt_wf_ref = make_ref "Coq.Wf_nat.lt_wf"
+let sig_ref = make_ref "Init.Specif.sig"
+let proj1_sig_ref = make_ref "Init.Specif.proj1_sig"
+let proj2_sig_ref = make_ref "Init.Specif.proj2_sig"
+
+let build_sig () = 
+  { proj1 = init_constant ["Init"; "Specif"] "proj1_sig";
+    proj2 = init_constant ["Init"; "Specif"] "proj2_sig";
+    elim = init_constant ["Init"; "Specif"] "sig_rec";
+    intro = init_constant ["Init"; "Specif"] "exist";
+    typ = init_constant ["Init"; "Specif"] "sig" }
+
+let sig_ = lazy (build_sig ())
+
+let eqind = lazy (init_constant ["Init"; "Logic"] "eq")
+let eqind_ref = lazy (init_reference ["Init"; "Logic"] "eq")
+let refl_equal_ref = lazy (init_reference ["Init"; "Logic"] "refl_equal")
+
+let ex_ind = lazy (init_constant ["Init"; "Logic"] "ex")
+let ex_intro = lazy (init_reference ["Init"; "Logic"] "ex_intro")
+
+let proj1 = lazy (init_constant ["Init"; "Logic"] "proj1")
+let proj2 = lazy (init_constant ["Init"; "Logic"] "proj2")
+
+let boolind = lazy (init_constant ["Init"; "Datatypes"] "bool")
+let sumboolind = lazy (init_constant ["Init"; "Specif"] "sumbool")
+let natind = lazy (init_constant ["Init"; "Datatypes"] "nat")
+let intind = lazy (init_constant ["ZArith"; "binint"] "Z")
+let existSind = lazy (init_constant ["Init"; "Specif"] "sigS")
+  
+let existS = lazy (build_sigma_set ())
+
+let prod = lazy (build_prod ())
+
+
+(* orders *)
+let well_founded = lazy (init_constant ["Init"; "Wf"] "well_founded")
+let fix = lazy (init_constant ["Init"; "Wf"] "Fix")
+let acc = lazy (init_constant ["Init"; "Wf"] "Acc")
+let acc_inv = lazy (init_constant ["Init"; "Wf"] "Acc_inv")
+
+let extconstr = Constrextern.extern_constr true (Global.env ())
+let extsort s = Constrextern.extern_constr true (Global.env ()) (mkSort s)
+
+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_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 n s = 
+  if !Options.debug then
+    msgnl s
+  else ()
+
+let debug_msg n s = 
+  if !Options.debug then s
+  else mt ()
+
+let trace s = 
+  if !Options.debug then msgnl s
+  else ()
+
+let wf_relations = Hashtbl.create 10
+
+let std_relations () = 
+  let add k v = Hashtbl.add wf_relations k v in
+    add (init_constant ["Init"; "Peano"] "lt")
+      (lazy (init_constant ["Arith"; "Wf_nat"] "lt_wf"))
+      
+let std_relations = Lazy.lazy_from_fun std_relations
+
+type binders = Topconstr.local_binder list
+
+let app_opt c e = 
+  match c with
+      Some constr -> constr e
+    | None -> e	
+
+let print_args env args = 
+  Array.fold_right (fun a acc -> my_print_constr env a ++ spc () ++ acc) args (str "")
+
+let make_existential loc env isevars c =
+  let evar = Evarutil.e_new_evar isevars env ~src:(loc, QuestionMark) c in
+  let (key, args) = destEvar evar in
+    debug 2 (str "Constructed evar " ++ int key ++ str " applied to args: " ++
+	     print_args env args);
+    evar
+
+let make_existential_expr loc env c =
+  let key = Evarutil.new_untyped_evar () in
+  let evar = Topconstr.CEvar (loc, key) in
+    debug 2 (str "Constructed evar " ++ int key);
+    evar
+
+let string_of_hole_kind = function
+  | ImplicitArg _ -> "ImplicitArg"
+  | BinderType _ -> "BinderType"
+  | QuestionMark -> "QuestionMark"
+  | CasesType -> "CasesType"
+  | InternalHole -> "InternalHole"
+  | TomatchTypeParameter _ -> "TomatchTypeParameter"
+      
+let non_instanciated_map env evd =
+  let evm = evars_of !evd in
+    List.fold_left 
+      (fun evm (key, evi) -> 
+	 let (loc,k) = evar_source key !evd in
+	   debug 2 (str "evar " ++ int key ++ str " has kind " ++ 
+		      str (string_of_hole_kind k));
+	   match k with 
+	       QuestionMark -> Evd.add evm key evi
+	     | _ ->
+	       debug 2 (str " and is an implicit");
+	       Pretype_errors.error_unsolvable_implicit loc env evm k)
+      Evd.empty (Evarutil.non_instantiated evm)
+
+let global_kind = Decl_kinds.IsDefinition Decl_kinds.Definition
+let goal_kind = Decl_kinds.Global, Decl_kinds.DefinitionBody Decl_kinds.Definition
+
+let global_fix_kind = Decl_kinds.IsDefinition Decl_kinds.Fixpoint
+let goal_fix_kind = Decl_kinds.Global, Decl_kinds.DefinitionBody Decl_kinds.Fixpoint
+
+open Tactics
+open Tacticals
+
+let build_dependent_sum l =
+  let rec aux (acc, tac, typ) = function
+      (n, t) :: tl ->
+	let t' = mkLambda (Name n, t, typ) in
+	  trace (str ("treating " ^ string_of_id n) ++
+		 str "assert: " ++ my_print_constr (Global.env ()) t);
+	let tac' = 
+	  tclTHEN (assert_tac true (Name n) t) 
+	    (tclTHENLIST
+	       [intros;
+		(tclTHENSEQ 
+		   [tclTRY (constructor_tac (Some 1) 1 
+		       (Rawterm.ImplicitBindings [mkVar n]));
+		    tac]);
+	       ])
+	in
+	  aux (mkApp (Lazy.force ex_ind, [| t; t'; |]), tac', t') tl
+    | [] -> acc, tac, typ
+  in 
+    match l with 
+	(_, hd) :: tl -> aux (hd, intros, hd) tl
+      | [] -> raise (Invalid_argument "build_dependent_sum")
+
+open Proof_type
+open Tacexpr
+
+let mkProj1 a b c = 
+  mkApp (Lazy.force proj1, [| a; b; c |])
+
+let mkProj2 a b c = 
+  mkApp (Lazy.force proj2, [| a; b; c |])
+
+let mk_ex_pi1 a b c =
+  mkApp (Lazy.force ex_pi1, [| a; b; c |])
+
+let mk_ex_pi2 a b c =
+  mkApp (Lazy.force ex_pi2, [| a; b; c |])
+    
+
+let mkSubset name typ prop = 
+  mkApp ((Lazy.force sig_).typ,
+	 [| typ; mkLambda (name, typ, prop) |])
+
+let and_tac l hook =
+  let andc = Coqlib.build_coq_and () in      
+  let rec aux ((accid, goal, tac, extract) as acc) = function
+    | [] -> (* Singleton *) acc
+	
+    | (id, x, elgoal, eltac) :: tl ->
+	let tac' = tclTHEN simplest_split (tclTHENLIST [tac; eltac]) in
+	let proj = fun c -> mkProj2 goal elgoal c in
+	let extract = List.map (fun (id, x, y, f) -> (id, x, y, (fun c -> f (mkProj1 goal elgoal c)))) extract in
+	  aux ((string_of_id id) ^ "_" ^ accid, mkApp (andc, [| goal; elgoal |]), tac', 
+	       (id, x, elgoal, proj) :: extract) tl
+
+  in
+  let and_proof_id, and_goal, and_tac, and_extract = 
+    match l with
+      | [] -> raise (Invalid_argument "and_tac: empty list of goals")
+      | (hdid, x, hdg, hdt) :: tl -> aux (string_of_id hdid, hdg, hdt, [hdid, x, hdg, (fun c -> c)]) tl
+  in
+  let and_proofid = id_of_string (and_proof_id ^ "_and_proof") in
+    Command.start_proof and_proofid goal_kind and_goal
+      (hook (fun c -> List.map (fun (id, x, t, f) -> (id, x, t, f c)) and_extract));
+    trace (str "Started and proof");
+    Pfedit.by and_tac;
+    trace (str "Applied and tac")
+      
+
+let destruct_ex ext ex = 
+  let rec aux c acc = 
+    match kind_of_term c with
+	App (f, args) ->
+	  (match kind_of_term f with
+	       Ind i when i = Term.destInd (Lazy.force ex_ind) && Array.length args = 2 ->
+		 let (dom, rng) = 
+		   try (args.(0), args.(1))
+		   with _ -> assert(false)
+		 in
+		   (mk_ex_pi1 dom rng acc) :: aux rng (mk_ex_pi2 dom rng acc)
+	     | _ -> [acc])
+      | _ -> [acc]
+  in aux ex ext
+
+
diff --git a/contrib/subtac/subtac_utils.mli b/contrib/subtac/subtac_utils.mli
new file mode 100644
index 00000000..92a995c8
--- /dev/null
+++ b/contrib/subtac/subtac_utils.mli
@@ -0,0 +1,85 @@
+open Term
+open Libnames
+open Coqlib
+open Environ
+open Pp
+open Evd
+open Decl_kinds
+open Topconstr
+open Rawterm
+open Util
+open Evarutil
+open Names
+
+val contrib_name : string
+val subtac_dir : string list
+val fix_sub_module : string
+val fixsub_module : string list
+val init_constant : string list -> string -> constr
+val init_reference : string list -> string -> global_reference
+val fixsub : constr lazy_t
+val make_ref : string -> reference
+val well_founded_ref : reference
+val acc_ref : reference
+val acc_inv_ref : reference
+val fix_sub_ref : reference
+val lt_wf_ref : reference
+val sig_ref : reference
+val proj1_sig_ref : reference
+val proj2_sig_ref : reference
+val build_sig : unit -> coq_sigma_data
+val sig_ : coq_sigma_data lazy_t
+val eqind : constr lazy_t
+val eqind_ref : global_reference lazy_t
+val refl_equal_ref : global_reference lazy_t
+val boolind : constr lazy_t
+val sumboolind : constr lazy_t
+val natind : constr lazy_t
+val intind : constr lazy_t
+val existSind : constr lazy_t
+val existS : coq_sigma_data lazy_t
+val prod : coq_sigma_data lazy_t
+
+val well_founded : constr lazy_t
+val fix : constr lazy_t
+val acc : constr lazy_t
+val acc_inv : constr lazy_t
+val extconstr : constr -> constr_expr
+val extsort : sorts -> constr_expr
+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_env : env -> std_ppcmds
+val my_print_rawconstr : env -> rawconstr -> std_ppcmds
+val my_print_tycon_type : env -> type_constraint_type -> std_ppcmds
+
+
+val debug : int -> std_ppcmds -> unit
+val debug_msg : int -> std_ppcmds -> std_ppcmds
+val trace : std_ppcmds -> unit
+val wf_relations : (constr, constr lazy_t) Hashtbl.t
+
+type binders = local_binder list
+val app_opt : ('a -> 'a) option -> 'a -> 'a
+val print_args : env -> constr array -> std_ppcmds
+val make_existential : loc -> env -> evar_defs ref -> types -> constr
+val make_existential_expr : loc -> 'a -> 'b -> constr_expr
+val string_of_hole_kind : hole_kind -> string
+val non_instanciated_map : env -> evar_defs ref -> evar_map
+val global_kind : logical_kind
+val goal_kind : locality_flag * goal_object_kind
+val global_fix_kind : logical_kind
+val goal_fix_kind : locality_flag * goal_object_kind
+
+val mkSubset : name -> constr -> constr -> constr
+val mkProj1 : constr -> constr -> constr -> constr
+val mkProj1 : constr -> constr -> constr -> constr
+val mk_ex_pi1 : constr -> constr -> constr -> constr
+val mk_ex_pi1 : constr -> constr -> constr -> constr
+
+val build_dependent_sum : (identifier * types) list -> constr * Proof_type.tactic * types
+val and_tac : (identifier * 'a * constr * Proof_type.tactic) list ->  
+  ((constr -> (identifier * 'a * constr * constr) list) -> Tacexpr.declaration_hook) -> unit
+
+val destruct_ex : constr -> constr -> constr list
diff --git a/contrib/xml/cic2Xml.ml b/contrib/xml/cic2Xml.ml
new file mode 100644
index 00000000..f04a03f9
--- /dev/null
+++ b/contrib/xml/cic2Xml.ml
@@ -0,0 +1,17 @@
+let print_xml_term ch env sigma cic =
+  let ids_to_terms = Hashtbl.create 503 in
+  let constr_to_ids = Acic.CicHash.create 503 in
+  let ids_to_father_ids = Hashtbl.create 503 in
+  let ids_to_inner_sorts = Hashtbl.create 503 in
+  let ids_to_inner_types = Hashtbl.create 503 in
+  let seed = ref 0 in
+  let acic =
+   Cic2acic.acic_of_cic_context' true seed ids_to_terms constr_to_ids 
+    ids_to_father_ids ids_to_inner_sorts ids_to_inner_types []
+    env [] sigma (Unshare.unshare cic) None in
+  let xml = Acic2Xml.print_term ids_to_inner_sorts acic in
+  Xml.pp_ch xml ch
+;;
+
+Tacinterp.declare_xml_printer print_xml_term
+;;
diff --git a/contrib/xml/cic2acic.ml b/contrib/xml/cic2acic.ml
index d820f9e5..bac7ad7c 100644
--- a/contrib/xml/cic2acic.ml
+++ b/contrib/xml/cic2acic.ml
@@ -83,16 +83,28 @@ let get_uri_of_var v pvars =
 ;;
 
 type tag =
-   Constant
- | Inductive
- | Variable
+   Constant of Names.constant
+ | Inductive of Names.kernel_name
+ | Variable of Names.kernel_name
 ;;
 
+type etag =
+   TConstant
+ | TInductive
+ | TVariable
+;;
+
+let etag_of_tag =
+ function
+    Constant _ -> TConstant
+  | Inductive _ -> TInductive
+  | Variable _ -> TVariable
+
 let ext_of_tag =
  function
-    Constant  -> "con"
-  | Inductive -> "ind"
-  | Variable  -> "var"
+    TConstant -> "con"
+  | TInductive -> "ind"
+  | TVariable -> "var"
 ;;
 
 exception FunctorsXMLExportationNotImplementedYet;;
@@ -147,23 +159,24 @@ let token_list_of_path dir id tag =
    List.rev_map N.string_of_id (N.repr_dirpath dirpath) in
   token_list_of_dirpath dir @ [N.string_of_id id ^ "." ^ (ext_of_tag tag)]
 
-let token_list_of_kernel_name kn tag =
+let token_list_of_kernel_name tag =
  let module N = Names in
  let module LN = Libnames in
- let dir = match tag with
-   | Variable -> 
-       Lib.cwd ()
-   | Constant -> 
-       Lib.library_part (LN.ConstRef kn)
-   | Inductive ->
+ let id,dir = match tag with
+   | Variable kn -> 
+       N.id_of_label (N.label kn), Lib.cwd ()
+   | Constant con -> 
+       N.id_of_label (N.con_label con),
+       Lib.library_part (LN.ConstRef con)
+   | Inductive kn ->
+       N.id_of_label (N.label kn),
        Lib.library_part (LN.IndRef (kn,0))
  in
- let id = N.id_of_label (N.label kn) in
- token_list_of_path dir id tag
+ token_list_of_path dir id (etag_of_tag tag)
 ;;
 
-let uri_of_kernel_name kn tag =
-  let tokens = token_list_of_kernel_name kn tag in
+let uri_of_kernel_name tag =
+  let tokens = token_list_of_kernel_name tag in
    "cic:/" ^ String.concat "/" tokens
 
 let uri_of_declaration id tag =
@@ -229,10 +242,10 @@ let typeur sigma metamap =
     | T.Const c ->
         let cb = Environ.lookup_constant c env in
         T.body_of_type cb.Declarations.const_type
-    | T.Evar ev -> Instantiate.existential_type sigma ev
-    | T.Ind ind -> T.body_of_type (Inductive.type_of_inductive env ind)
+    | T.Evar ev -> Evd.existential_type sigma ev
+    | T.Ind ind -> T.body_of_type (Inductiveops.type_of_inductive env ind)
     | T.Construct cstr ->
-       T.body_of_type (Inductive.type_of_constructor env cstr)
+       T.body_of_type (Inductiveops.type_of_constructor env cstr)
     | T.Case (_,p,c,lf) ->
         let Inductiveops.IndType(_,realargs) =
           try Inductiveops.find_rectype env sigma (type_of env c)
@@ -250,7 +263,7 @@ let typeur sigma metamap =
     | T.App(f,args)->
         T.strip_outer_cast
           (subst_type env sigma (type_of env f) (Array.to_list args))
-    | T.Cast (c,t) -> t
+    | T.Cast (c,_, t) -> t
     | T.Sort _ | T.Prod _ ->
        match sort_of env cstr with
           Coq_sort T.InProp -> T.mkProp
@@ -260,7 +273,7 @@ let typeur sigma metamap =
                                                                                 
   and sort_of env t =
     match Term.kind_of_term t with
-    | T.Cast (c,s) when T.isSort s -> family_of_term s
+    | T.Cast (c,_, s) when T.isSort s -> family_of_term s
     | T.Sort (T.Prop c) -> Coq_sort T.InType
     | T.Sort (T.Type u) -> Coq_sort T.InType
     | T.Prod (name,t,c2) ->
@@ -270,7 +283,7 @@ let typeur sigma metamap =
           | Coq_sort T.InSet, (Coq_sort T.InSet as s) -> s
           | Coq_sort T.InType, (Coq_sort T.InSet as s)
           | CProp, (Coq_sort T.InSet as s) when
-              Environ.engagement env = Some Environ.ImpredicativeSet -> s
+              Environ.engagement env = Some Declarations.ImpredicativeSet -> s
           | Coq_sort T.InType, Coq_sort T.InSet
           | CProp, Coq_sort T.InSet -> Coq_sort T.InType
           | _, (Coq_sort T.InType as s) -> s (*Type Univ.dummy_univ*)
@@ -282,7 +295,7 @@ let typeur sigma metamap =
                                                                                 
   and sort_family_of env t =
     match T.kind_of_term t with
-    | T.Cast (c,s) when T.isSort s -> family_of_term s
+    | T.Cast (c,_, s) when T.isSort s -> family_of_term s
     | T.Sort (T.Prop c) -> Coq_sort T.InType
     | T.Sort (T.Type u) -> Coq_sort T.InType
     | T.Prod (name,t,c2) -> sort_family_of (Environ.push_rel (name,None,t) env) c2
@@ -375,7 +388,7 @@ try
           Acic.CicHash.find terms_to_types tt
 with _ ->
 (*CSC: Warning: it really happens, for example in Ring_theory!!! *)
-Pp.ppnl (Pp.(++) (Pp.str "BUG: this subterm was not visited during the double-type-inference: ") (Printer.prterm tt)) ; assert false
+Pp.ppnl (Pp.(++) (Pp.str "BUG: this subterm was not visited during the double-type-inference: ") (Printer.pr_lconstr tt)) ; assert false
          else
           (* We are already in an inner-type and Coscoy's double *)
           (* type inference algorithm has not been applied.      *)
@@ -384,19 +397,33 @@ Pp.ppnl (Pp.(++) (Pp.str "BUG: this subterm was not visited during the double-ty
           {D.synthesized =
             Reductionops.nf_beta
              (CPropRetyping.get_type_of env evar_map
-              (Evarutil.refresh_universes tt)) ;
+              (Termops.refresh_universes tt)) ;
            D.expected = None}
         in
 (* Debugging only:
 print_endline "TERMINE:" ; flush stdout ;
-Pp.ppnl (Printer.prterm tt) ; flush stdout ;
+Pp.ppnl (Printer.pr_lconstr tt) ; flush stdout ;
 print_endline "TIPO:" ; flush stdout ;
-Pp.ppnl (Printer.prterm synthesized) ; flush stdout ;
+Pp.ppnl (Printer.pr_lconstr synthesized) ; flush stdout ;
 print_endline "ENVIRONMENT:" ; flush stdout ;
 Pp.ppnl (Printer.pr_context_of env) ; flush stdout ;
 print_endline "FINE_ENVIRONMENT" ; flush stdout ;
 *)
-         let innersort = get_sort_family_of env evar_map synthesized in
+         let innersort =
+          let synthesized_innersort =
+           get_sort_family_of env evar_map synthesized
+          in
+           match expected with
+              None -> synthesized_innersort
+            | Some ty ->
+              let expected_innersort =
+               get_sort_family_of env evar_map ty
+              in
+               match expected_innersort, synthesized_innersort with
+                  CProp, _
+                | _, CProp -> CProp
+                | _, _ -> expected_innersort
+         in
 (* Debugging only:
 print_endline "PASSATO" ; flush stdout ;
 *)
@@ -441,7 +468,7 @@ print_endline "PASSATO" ; flush stdout ;
           let subst,residual_args,uninst_vars =
            let variables,basedir =
              try
-               let g = Libnames.reference_of_constr h in
+               let g = Libnames.global_of_constr h in
                let sp =
                 match g with
                    Libnames.ConstructRef ((induri,_),_)
@@ -533,7 +560,7 @@ print_endline "PASSATO" ; flush stdout ;
                (fresh_id'', n, Array.to_list (Array.map (aux' env idrefs) l))
            | T.Meta _ -> Util.anomaly "Meta met during exporting to XML"
            | T.Sort s -> A.ASort (fresh_id'', s)
-           | T.Cast (v,t) ->
+           | T.Cast (v,_, t) ->
               Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ;
               if is_a_Prop innersort then
                add_inner_type fresh_id'' ;
@@ -670,7 +697,7 @@ print_endline "PASSATO" ; flush stdout ;
               let
                compute_result_if_eta_expansion_not_required subst residual_args
               =
-               let residual_args_not_empty = List.length residual_args > 0 in
+               let residual_args_not_empty = residual_args <> [] in
                let h' =
                 if residual_args_not_empty then
                  aux' env idrefs ~subst:(None,subst) h
@@ -695,7 +722,7 @@ print_endline "PASSATO" ; flush stdout ;
               if is_a_Prop innersort  && expected_available then
                add_inner_type fresh_id'' ;
               let compute_result_if_eta_expansion_not_required _ _ =
-               A.AConst (fresh_id'', subst, (uri_of_kernel_name kn Constant))
+               A.AConst (fresh_id'', subst, (uri_of_kernel_name (Constant kn)))
               in
                let (_,subst') = subst in
                 explicit_substitute_and_eta_expand_if_required tt []
@@ -703,7 +730,7 @@ print_endline "PASSATO" ; flush stdout ;
                  compute_result_if_eta_expansion_not_required
            | T.Ind (kn,i) ->
               let compute_result_if_eta_expansion_not_required _ _ =
-               A.AInd (fresh_id'', subst, (uri_of_kernel_name kn Inductive), i)
+               A.AInd (fresh_id'', subst, (uri_of_kernel_name (Inductive kn)), i)
               in
                let (_,subst') = subst in
                 explicit_substitute_and_eta_expand_if_required tt []
@@ -715,7 +742,7 @@ print_endline "PASSATO" ; flush stdout ;
                add_inner_type fresh_id'' ;
               let compute_result_if_eta_expansion_not_required _ _ =
                A.AConstruct
-                (fresh_id'', subst, (uri_of_kernel_name kn Inductive), i, j)
+                (fresh_id'', subst, (uri_of_kernel_name (Inductive kn)), i, j)
               in
                let (_,subst') = subst in
                 explicit_substitute_and_eta_expand_if_required tt []
@@ -729,7 +756,7 @@ print_endline "PASSATO" ; flush stdout ;
                Array.fold_right (fun x i -> (aux' env idrefs x)::i) a []
               in
                A.ACase
-                (fresh_id'', (uri_of_kernel_name kn Inductive), i,
+                (fresh_id'', (uri_of_kernel_name (Inductive kn)), i,
                   aux' env idrefs ty, aux' env idrefs term, a')
            | T.Fix ((ai,i),(f,t,b)) ->
               Hashtbl.add ids_to_inner_sorts fresh_id'' innersort ;
diff --git a/contrib/xml/doubleTypeInference.ml b/contrib/xml/doubleTypeInference.ml
index f0e3f5e3..518f6c11 100644
--- a/contrib/xml/doubleTypeInference.ml
+++ b/contrib/xml/doubleTypeInference.ml
@@ -19,7 +19,7 @@ let prerr_endline _ = ();;
 
 let cprop =
  let module N = Names in
-  N.make_kn
+  N.make_con
    (N.MPfile
      (Libnames.dirpath_of_string "CoRN.algebra.CLogic"))
    (N.make_dirpath [])
@@ -40,13 +40,13 @@ let whd_betadeltaiotacprop env evar_map ty =
 Conv_oracle.set_opaque_const cprop;
 prerr_endline "###whd_betadeltaiotacprop:" ;
 let xxx =
-(*Pp.msgerr (Printer.prterm_env env ty);*)
+(*Pp.msgerr (Printer.pr_lconstr_env env ty);*)
 prerr_endline "";
-   Tacred.reduction_of_redexp red_exp env evar_map ty
+   (fst (Redexpr.reduction_of_red_expr red_exp)) env evar_map ty
 in
 prerr_endline "###FINE" ;
 (*
-Pp.msgerr (Printer.prterm_env env xxx);
+Pp.msgerr (Printer.pr_lconstr_env env xxx);
 *)
 prerr_endline "";
 Conv_oracle.set_transparent_const cprop;
@@ -89,10 +89,11 @@ let double_type_of env sigma cstr expectedty subterms_to_types =
          "DoubleTypeInference.double_type_of: found a non-instanciated goal"
  
      | T.Evar ((n,l) as ev) ->
-        let ty = Unshare.unshare (Instantiate.existential_type sigma ev) in
+        let ty = Unshare.unshare (Evd.existential_type sigma ev) in
         let jty = execute env sigma ty None in
         let jty = assumption_of_judgment env sigma jty in
-        let evar_context = (Evd.map sigma n).Evd.evar_hyps in
+        let evar_context = 
+	  E.named_context_of_val (Evd.map sigma n).Evd.evar_hyps in
          let rec iter actual_args evar_context =
           match actual_args,evar_context with
              [],[] -> ()
@@ -124,10 +125,10 @@ let double_type_of env sigma cstr expectedty subterms_to_types =
         E.make_judge cstr (E.constant_type env c)
 	  
      | T.Ind ind ->
-        E.make_judge cstr (Inductive.type_of_inductive env ind)
+        E.make_judge cstr (Inductiveops.type_of_inductive env ind)
 	  
      | T.Construct cstruct -> 
-        E.make_judge cstr (Inductive.type_of_constructor env cstruct)
+        E.make_judge cstr (Inductiveops.type_of_constructor env cstruct)
 	  
      | T.Case (ci,p,c,lf) ->
         let expectedtype =
@@ -230,11 +231,11 @@ let double_type_of env sigma cstr expectedty subterms_to_types =
          let j3 = execute env1 sigma c3 None in
           Typeops.judge_of_letin env name j1 j2 j3
   
-     | T.Cast (c,t) ->
+     | T.Cast (c,k,t) ->
         let cj = execute env sigma c (Some (Reductionops.nf_beta t)) in
         let tj = execute env sigma t None in
 	let tj = type_judgment env sigma tj in
-        let j, _ = Typeops.judge_of_cast env cj tj in
+        let j, _ = Typeops.judge_of_cast env cj k tj in
 	 j
     in
      let synthesized = E.j_type judgement in
@@ -244,19 +245,20 @@ let double_type_of env sigma cstr expectedty subterms_to_types =
           None ->
            (* No expected type *)
            {synthesized = synthesized' ; expected = None}, synthesized
-        (*CSC: in HELM we did not considered Casts to be irrelevant. *)
-        (*CSC: does it really matter? (eq_constr is up to casts)     *)
         | Some ty when Term.eq_constr synthesized' ty ->
-           (* The expected type is synthactically equal to *)
-           (* the synthesized type. Let's forget it.       *)
-           {synthesized = synthesized' ; expected = None}, synthesized
+           (* The expected type is synthactically equal to the    *)
+           (* synthesized type. Let's forget it.                  *)
+           (* Note: since eq_constr is up to casts, it is better  *)
+           (* to keep the expected type, since it can bears casts *)
+           (* that change the innersort to CProp                  *)
+           {synthesized = ty ; expected = None}, ty
         | Some expectedty' ->
            {synthesized = synthesized' ; expected = Some expectedty'},
            expectedty'
       in
 (*CSC: debugging stuff to be removed *)
 if Acic.CicHash.mem subterms_to_types cstr then
- (Pp.ppnl (Pp.(++) (Pp.str "DUPLICATE INSERTION: ") (Printer.prterm cstr)) ; flush stdout ) ;
+ (Pp.ppnl (Pp.(++) (Pp.str "DUPLICATE INSERTION: ") (Printer.pr_lconstr cstr)) ; flush stdout ) ;
        Acic.CicHash.add subterms_to_types cstr types ;
        E.make_judge cstr res
 
diff --git a/contrib/xml/doubleTypeInference.mli b/contrib/xml/doubleTypeInference.mli
index 33d3e5cd..2e14b558 100644
--- a/contrib/xml/doubleTypeInference.mli
+++ b/contrib/xml/doubleTypeInference.mli
@@ -14,7 +14,7 @@
 
 type types = { synthesized : Term.types; expected : Term.types option; } 
 
-val cprop : Names.kernel_name
+val cprop : Names.constant
 
 val whd_betadeltaiotacprop :
   Environ.env -> Evd.evar_map -> Term.constr -> Term.constr
diff --git a/contrib/xml/proof2aproof.ml b/contrib/xml/proof2aproof.ml
index 165a456d..dff546c9 100644
--- a/contrib/xml/proof2aproof.ml
+++ b/contrib/xml/proof2aproof.ml
@@ -32,7 +32,7 @@ let nf_evar sigma ~preserve =
     match T.kind_of_term t with
      | T.Rel _ | T.Meta _ | T.Var _ | T.Sort _ | T.Const _ | T.Ind _
      | T.Construct _ -> t
-     | T.Cast (c1,c2) -> T.mkCast (aux c1, aux c2)
+     | T.Cast (c1,k,c2) -> T.mkCast (aux c1, k, aux c2)
      | T.Prod (na,c1,c2) -> T.mkProd (na, aux c1, aux c2)
      | T.Lambda (na,t,c) -> T.mkLambda (na, aux t, aux c)
      | T.LetIn (na,b,t,c) -> T.mkLetIn (na, aux b, aux t, aux c)
@@ -41,14 +41,14 @@ let nf_evar sigma ~preserve =
         let l' = Array.map aux l in
          (match T.kind_of_term c' with
              T.App (c'',l'') -> T.mkApp (c'', Array.append l'' l')
-           | T.Cast (he,_) ->
+           | T.Cast (he,_,_) ->
               (match T.kind_of_term he with
                   T.App (c'',l'') -> T.mkApp (c'', Array.append l'' l')
                 | _ -> T.mkApp (c', l')
               )
            | _ -> T.mkApp (c', l'))
      | T.Evar (e,l) when Evd.in_dom sigma e & Evd.is_defined sigma e ->
-	aux (Instantiate.existential_value sigma (e,l))
+	aux (Evd.existential_value sigma (e,l))
      | T.Evar (e,l) -> T.mkEvar (e, Array.map aux l)
      | T.Case (ci,p,c,bl) -> T.mkCase (ci, aux p, aux c, Array.map aux bl)
      | T.Fix (ln,(lna,tl,bl)) ->
@@ -93,7 +93,7 @@ module ProofTreeHash =
 let extract_open_proof sigma pf =
  let module PT = Proof_type in
  let module L = Logic in
-  let sigma = ref sigma in
+  let evd = ref (Evd.create_evar_defs sigma) in
   let proof_tree_to_constr = ProofTreeHash.create 503 in
   let proof_tree_to_flattened_proof_tree = ProofTreeHash.create 503 in
   let unshared_constrs = ref S.empty in
@@ -117,34 +117,39 @@ let extract_open_proof sigma pf =
              (fun id ->
                 (* Section variables are in the [id] list but are not *)
                 (* lambda abstracted in the term [vl]                 *)
-                try let n = Util.list_index id vl in (n,id)
+                try let n = Logic.proof_variable_index id vl in (n,id)
 	        with Not_found -> failwith "caught")
 (*CSC: the above function must be modified such that when it is found  *)
 (*CSC: it becomes a Rel; otherwise a Var. Then it can be already used  *)
 (*CSC: as the evar_instance. Ordering the instance becomes useless (it *)
 (*CSC: will already be ordered.                                        *)
-             (Termops.ids_of_named_context goal.Evd.evar_hyps) in
+             (Termops.ids_of_named_context 
+		(Environ.named_context_of_val goal.Evd.evar_hyps)) in
 	 let sorted_rels =
 	   Sort.list (fun (n1,_) (n2,_) -> n1 < n2 ) visible_rels in
 	 let context =
-          List.map
-            (fun (_,id) -> Sign.lookup_named id goal.Evd.evar_hyps)
-            sorted_rels
+	   let l = 
+             List.map
+               (fun (_,id) -> Sign.lookup_named id 
+		   (Environ.named_context_of_val goal.Evd.evar_hyps))
+               sorted_rels in
+	   Environ.val_of_named_context l
          in
 (*CSC: the section variables in the right order must be added too *)
          let evar_instance = List.map (fun (n,_) -> Term.mkRel n) sorted_rels in
-         let env = Global.env_of_context context in
-         let sigma',evar =
-          Evarutil.new_isevar_sign env !sigma goal.Evd.evar_concl evar_instance
-         in
-         sigma := sigma' ;
+    (*     let env = Global.env_of_context context in *)
+	 let evd',evar =
+           Evarutil.new_evar_instance context !evd goal.Evd.evar_concl
+             evar_instance in
+         evd := evd' ;
          evar
 	  
      | _ -> Util.anomaly "Bug : a case has been forgotten in proof_extractor"
    in
     let unsharedconstr =
      let evar_nf_constr =
-      nf_evar !sigma ~preserve:(function e -> S.mem e !unshared_constrs) constr
+      nf_evar (Evd.evars_of !evd)
+        ~preserve:(function e -> S.mem e !unshared_constrs) constr
      in
       Unshare.unshare
        ~already_unshared:(function e -> S.mem e !unshared_constrs)
@@ -152,14 +157,15 @@ let extract_open_proof sigma pf =
     in
 (*CSC: debugging stuff to be removed *)
 if ProofTreeHash.mem proof_tree_to_constr node then
- Pp.ppnl (Pp.(++) (Pp.str "#DUPLICATE INSERTION: ") (Refiner.print_proof !sigma [] node)) ;
+ Pp.ppnl (Pp.(++) (Pp.str "#DUPLICATE INSERTION: ")
+ (Tactic_printer.print_proof (Evd.evars_of !evd) [] node)) ;
      ProofTreeHash.add proof_tree_to_constr node unsharedconstr ;
      unshared_constrs := S.add unsharedconstr !unshared_constrs ;
      unsharedconstr
   in
   let unshared_pf = unshare_proof_tree pf in
   let pfterm = proof_extractor [] unshared_pf in
-   (pfterm, !sigma, proof_tree_to_constr, proof_tree_to_flattened_proof_tree,
+   (pfterm, Evd.evars_of !evd, proof_tree_to_constr, proof_tree_to_flattened_proof_tree,
     unshared_pf)
 ;;
 
diff --git a/contrib/xml/proofTree2Xml.ml4 b/contrib/xml/proofTree2Xml.ml4
index b9b66774..578c1ed2 100644
--- a/contrib/xml/proofTree2Xml.ml4
+++ b/contrib/xml/proofTree2Xml.ml4
@@ -46,7 +46,8 @@ let constr_to_xml obj sigma env =
   let rel_context = Sign.push_named_to_rel_context named_context' [] in
   let rel_env =
    Environ.push_rel_context rel_context
-    (Environ.reset_with_named_context real_named_context env) in
+    (Environ.reset_with_named_context 
+	(Environ.val_of_named_context real_named_context) env) in
   let obj' =
    Term.subst_vars (List.map (function (i,_,_) -> i) named_context') obj in
   let seed = ref 0 in
@@ -66,9 +67,9 @@ Pp.ppnl (Pp.str "Problem during the conversion of constr into XML") ;
 Pp.ppnl (Pp.str "ENVIRONMENT:") ;
 Pp.ppnl (Printer.pr_context_of rel_env) ;
 Pp.ppnl (Pp.str "TERM:") ;
-Pp.ppnl (Printer.prterm_env rel_env obj') ;
+Pp.ppnl (Printer.pr_lconstr_env rel_env obj') ;
 Pp.ppnl (Pp.str "RAW-TERM:") ;
-Pp.ppnl (Printer.prterm obj') ;
+Pp.ppnl (Printer.pr_lconstr obj') ;
 Xml.xml_empty "MISSING TERM" [] (*; raise e*)
 *)
 ;;
@@ -95,7 +96,7 @@ let string_of_prim_rule x = match x with
 
 
 let
- print_proof_tree curi sigma0 pf proof_tree_to_constr
+ print_proof_tree curi sigma pf proof_tree_to_constr
   proof_tree_to_flattened_proof_tree constr_to_ids
 =
  let module PT = Proof_type in
@@ -119,7 +120,7 @@ in
    with _ ->
 Pp.ppnl (Pp.(++) (Pp.str
 "The_generated_term_is_not_a_subterm_of_the_final_lambda_term")
-(Printer.prterm constr)) ;
+(Printer.pr_lconstr constr)) ;
     None
   in
   let rec aux node old_hyps =
@@ -155,7 +156,7 @@ Pp.ppnl (Pp.(++) (Pp.str
             aux flat_proof old_hyps
         | _ ->
          (****** la tactique employee *)
-	 let prtac = if !Options.v7 then Pptactic.pr_tactic else Pptacticnew.pr_tactic (Global.env()) in
+	 let prtac = Pptactic.pr_tactic (Global.env()) in
          let tac = std_ppcmds_to_string (prtac tactic_expr) in
          let tacname= first_word tac in
          let of_attribute = ("name",tacname)::("script",tac)::of_attribute in
@@ -164,10 +165,7 @@ Pp.ppnl (Pp.(++) (Pp.str
          let {Evd.evar_concl=concl;
               Evd.evar_hyps=hyps}=goal in
 
-         let rc = (Proof_trees.rc_of_gc sigma0 goal) in
-         let sigma = Proof_trees.get_gc rc in
-         let hyps = Proof_trees.get_hyps rc in
-         let env= Proof_trees.get_env rc in
+         let env = Global.env_of_context hyps in
 
          let xgoal =
           X.xml_nempty "Goal" [] (constr_to_xml concl sigma env) in
@@ -183,11 +181,12 @@ Pp.ppnl (Pp.(++) (Pp.str
                     (constr_to_xml tid sigma env))
                >] in
          let old_names = List.map (fun (id,c,tid)->id) old_hyps in
+	 let nhyps = Environ.named_context_of_val hyps in
          let new_hyps =
-          List.filter (fun (id,c,tid)-> not (List.mem id old_names)) hyps in
+          List.filter (fun (id,c,tid)-> not (List.mem id old_names)) nhyps in
 
          X.xml_nempty "Tactic" of_attribute
-          [<(build_hyps new_hyps) ; (aux flat_proof hyps)>]
+          [<(build_hyps new_hyps) ; (aux flat_proof nhyps)>]
         end
 
      | {PT.ref=Some(PT.Change_evars,nodes)} ->
diff --git a/contrib/xml/xml.ml4 b/contrib/xml/xml.ml4
index d0c64f30..e2d04cb7 100644
--- a/contrib/xml/xml.ml4
+++ b/contrib/xml/xml.ml4
@@ -31,8 +31,7 @@ let xml_cdata str = [< 'Str str >]
 (* Usage:                                                                   *)
 (*  pp tokens None     pretty prints the output on stdout                   *)
 (*  pp tokens (Some filename) pretty prints the output on the file filename *)
-let pp strm fn =
- let channel = ref stdout in
+let pp_ch strm channel =
  let rec pp_r m =
   parser
     [< 'Str a ; s >] ->
@@ -58,16 +57,22 @@ let pp strm fn =
  and print_spaces m =
   for i = 1 to m do fprint_string "  " done
  and fprint_string str =
-  output_string !channel str
+  output_string channel str
  in
+  pp_r 0 strm
+;;
+
+
+let pp strm fn =
   match fn with
      Some filename ->
       let filename = filename ^ ".xml" in
-       channel := open_out filename ;
-       pp_r 0 strm ;
-       close_out !channel ;
+      let ch = open_out filename in
+       pp_ch strm ch;
+       close_out ch ;
        print_string ("\nWriting on file \"" ^ filename ^ "\" was succesful\n");
        flush stdout
    | None ->
-       pp_r 0 strm
+       pp_ch strm stdout
 ;;
+
diff --git a/contrib/xml/xml.mli b/contrib/xml/xml.mli
index e65e6c81..38a4e01c 100644
--- a/contrib/xml/xml.mli
+++ b/contrib/xml/xml.mli
@@ -12,7 +12,7 @@
 (*                       http://helm.cs.unibo.it                        *)
 (************************************************************************)
 
-(*i $Id: xml.mli,v 1.5.2.2 2004/07/16 19:30:15 herbelin Exp $ i*)
+(*i $Id: xml.mli 6681 2005-02-04 18:20:16Z herbelin $ i*)
 
 (* Tokens for XML cdata, empty elements and not-empty elements           *)
 (* Usage:                                                                *)
@@ -31,6 +31,8 @@ val xml_nempty :
   string -> (string * string) list -> token Stream.t -> token Stream.t
 val xml_cdata : string -> token Stream.t
 
+val pp_ch : token Stream.t -> out_channel -> unit
+
 (* The pretty printer for streams of token                                  *)
 (* Usage:                                                                   *)
 (*  pp tokens None     pretty prints the output on stdout                   *)
diff --git a/contrib/xml/xmlcommand.ml b/contrib/xml/xmlcommand.ml
index 9fba5474..871a7f15 100644
--- a/contrib/xml/xmlcommand.ml
+++ b/contrib/xml/xmlcommand.ml
@@ -38,6 +38,8 @@ let print_if_verbose s = if !verbose then print_string s;;
 (* Next exception is used only inside print_coq_object and tag_of_string_tag *)
 exception Uninteresting;;
 
+(* NOT USED anymore, we back to the V6 point of view with global parameters 
+
 (* Internally, for Coq V7, params of inductive types are associated     *)
 (* not to the whole block of mutual inductive (as it was in V6) but to  *)
 (* each member of the block; but externally, all params are required    *)
@@ -60,6 +62,8 @@ let extract_nparams pack =
   done;
   nparams0
 
+*)
+
 (* could_have_namesakes sp = true iff o is an object that could be cooked and *)
 (* than that could exists in cooked form with the same name in a super        *)
 (* section of the actual section                                              *)
@@ -177,12 +181,12 @@ let rec join_dirs cwd =
       join_dirs newcwd tail
 ;;
 
-let filename_of_path xml_library_root kn tag =
+let filename_of_path xml_library_root tag =
  let module N = Names in
   match xml_library_root with
      None -> None  (* stdout *)
    | Some xml_library_root' ->
-      let tokens = Cic2acic.token_list_of_kernel_name kn tag in
+      let tokens = Cic2acic.token_list_of_kernel_name tag in
        Some (join_dirs xml_library_root' tokens)
 ;;
 
@@ -210,7 +214,6 @@ let theory_filename xml_library_root =
     None -> None  (* stdout *)
   | Some xml_library_root' ->
      let toks = List.map N.string_of_id (N.repr_dirpath (Lib.library_dp ())) in
-     let hd = List.hd toks in
      (* theory from A/B/C/F.v goes into A/B/C/F.theory *)
      let alltoks = List.rev toks in
        Some (join_dirs xml_library_root' alltoks ^ ".theory")
@@ -286,7 +289,7 @@ let find_hyps t =
     | T.Meta _
     | T.Evar _
     | T.Sort _ -> l
-    | T.Cast (te,ty) -> aux (aux l te) ty
+    | T.Cast (te,_, ty) -> aux (aux l te) ty
     | T.Prod (_,s,t) -> aux (aux l s) t
     | T.Lambda (_,s,t) -> aux (aux l s) t
     | T.LetIn (_,s,_,t) -> aux (aux l s) t
@@ -355,11 +358,11 @@ let mk_current_proof_obj is_a_variable id bo ty evar_map env =
                (* t will not be exported to XML. Thus no unsharing performed *)
                final_var_ids,(n, Acic.Def  (Unshare.unshare b',t))::tl'
         in
-         aux [] (List.rev evar_hyps)
+         aux [] (List.rev (Environ.named_context_of_val evar_hyps))
        in
         (* We map the named context to a rel context and every Var to a Rel *)
         (n,context,Unshare.unshare (Term.subst_vars final_var_ids evar_concl))
-   ) (Evd.non_instantiated evar_map)
+   ) (Evarutil.non_instantiated evar_map)
  in
   let id' = Names.string_of_id id in
    if metasenv = [] then
@@ -392,11 +395,11 @@ let mk_constant_obj id bo ty variables hyps =
          ty,params)
 ;;
 
-let mk_inductive_obj sp packs variables hyps finite =
+let mk_inductive_obj sp packs variables nparams hyps finite =
  let module D = Declarations in
   let hyps = string_list_of_named_context_list hyps in
   let params = filter_params variables hyps in
-  let nparams = extract_nparams packs in
+(*  let nparams = extract_nparams packs in *)
    let tys =
     let tyno = ref (Array.length packs) in
     Array.fold_right
@@ -406,7 +409,7 @@ let mk_inductive_obj sp packs variables hyps finite =
             D.mind_typename=typename ;
             D.mind_nf_arity=arity} = p
        in
-        let lc = Inductive.arities_of_constructors (Global.env ()) (sp,!tyno) in
+        let lc = Inductiveops.arities_of_constructors (Global.env ()) (sp,!tyno) in
         let cons =
          (Array.fold_right (fun (name,lc) i -> (name,lc)::i)
           (Array.mapi
@@ -430,16 +433,10 @@ let theory_output_string ?(do_not_quote = false) s =
    Buffer.add_string theory_buffer s
 ;;
 
-let kind_of_theorem = function
-  | Decl_kinds.Theorem -> "Theorem"
-  | Decl_kinds.Lemma -> "Lemma"
-  | Decl_kinds.Fact -> "Fact"
-  | Decl_kinds.Remark -> "Remark"
-
 let kind_of_global_goal = function
-  | Decl_kinds.IsGlobal Decl_kinds.DefinitionBody -> "DEFINITION","InteractiveDefinition"
-  | Decl_kinds.IsGlobal (Decl_kinds.Proof k) -> "THEOREM",kind_of_theorem k
-  | Decl_kinds.IsLocal -> assert false
+  | Decl_kinds.Global, Decl_kinds.DefinitionBody _ -> "DEFINITION","InteractiveDefinition"
+  | Decl_kinds.Global, (Decl_kinds.Proof k) -> "THEOREM",Decl_kinds.string_of_theorem_kind k
+  | Decl_kinds.Local, _ -> assert false
 
 let kind_of_inductive isrecord kn =
  "DEFINITION",
@@ -454,9 +451,9 @@ let kind_of_variable id =
     | DK.IsAssumption DK.Definitional -> "VARIABLE","Assumption"
     | DK.IsAssumption DK.Logical -> "VARIABLE","Hypothesis"
     | DK.IsAssumption DK.Conjectural -> "VARIABLE","Conjecture"
-    | DK.IsDefinition -> "VARIABLE","LocalDefinition"
-    | DK.IsConjecture -> "VARIABLE","Conjecture"
-    | DK.IsProof DK.LocalStatement -> "VARIABLE","LocalFact"
+    | DK.IsDefinition DK.Definition -> "VARIABLE","LocalDefinition"
+    | DK.IsProof _ -> "VARIABLE","LocalFact"
+    | _ -> Util.anomaly "Unsupported variable kind"
 ;;
 
 let kind_of_constant kn = 
@@ -465,9 +462,10 @@ let kind_of_constant kn =
     | DK.IsAssumption DK.Definitional -> "AXIOM","Declaration"
     | DK.IsAssumption DK.Logical -> "AXIOM","Axiom"
     | DK.IsAssumption DK.Conjectural -> "AXIOM","Conjecture"
-    | DK.IsDefinition -> "DEFINITION","Definition"
-    | DK.IsConjecture -> "THEOREM","Conjecture"
-    | DK.IsProof thm -> "THEOREM",kind_of_theorem thm
+    | DK.IsDefinition DK.Definition -> "DEFINITION","Definition"
+    | DK.IsDefinition DK.Example -> "DEFINITION","Example"
+    | DK.IsDefinition _ -> Util.anomaly "Unsupported constant kind"
+    | DK.IsProof thm -> "THEOREM",DK.string_of_theorem_kind thm
 ;;
 
 let kind_of_global r =
@@ -476,7 +474,7 @@ let kind_of_global r =
   match r with
   | Ln.IndRef kn | Ln.ConstructRef (kn,_) -> 
       let isrecord =
-	try let _ = Recordops.find_structure kn in true
+	try let _ = Recordops.lookup_structure kn in true
         with Not_found -> false in
       kind_of_inductive isrecord (fst kn)
   | Ln.VarRef id -> kind_of_variable id
@@ -509,7 +507,7 @@ let print internal glob_ref kind xml_library_root =
  let module Ln = Libnames in
   (* Variables are the identifiers of the variables in scope *)
   let variables = search_variables () in
-  let kn,tag,obj =
+  let tag,obj =
    match glob_ref with
       Ln.VarRef id ->
        let sp = Declare.find_section_variable id in
@@ -519,23 +517,23 @@ let print internal glob_ref kind xml_library_root =
         N.make_kn mod_path dir_path (N.label_of_id (Ln.basename sp))
        in
        let (_,body,typ) = G.lookup_named id in
-        kn,Cic2acic.Variable,mk_variable_obj id body typ
+        Cic2acic.Variable kn,mk_variable_obj id body typ
     | Ln.ConstRef kn ->
-       let id = N.id_of_label (N.label kn) in
+       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
-        kn,Cic2acic.Constant,mk_constant_obj id val0 typ variables hyps
+        Cic2acic.Constant kn,mk_constant_obj id val0 typ variables hyps
     | Ln.IndRef (kn,_) ->
-       let {D.mind_packets=packs ;
+       let {D.mind_nparams=nparams;
+	    D.mind_packets=packs ;
             D.mind_hyps=hyps;
             D.mind_finite=finite} = G.lookup_mind kn in
-          kn,Cic2acic.Inductive,
-           mk_inductive_obj kn packs variables hyps finite
+          Cic2acic.Inductive kn,mk_inductive_obj kn packs variables nparams hyps finite
     | Ln.ConstructRef _ ->
        Util.anomaly ("print: this should not happen")
   in
-  let fn = filename_of_path xml_library_root kn tag in
-  let uri = Cic2acic.uri_of_kernel_name kn tag in
+  let fn = filename_of_path xml_library_root tag in
+  let uri = Cic2acic.uri_of_kernel_name tag in
    if not internal then print_object_kind uri kind;
    print_object uri obj Evd.empty None fn
 ;;
@@ -558,18 +556,19 @@ let show_pftreestate internal fn (kind,pftst) id =
  let kn = Lib.make_kn id in
  let env = Global.env () in
  let obj =
-  mk_current_proof_obj (kind = Decl_kinds.IsLocal) id val0 typ evar_map env in
+  mk_current_proof_obj (fst kind = Decl_kinds.Local) id val0 typ evar_map env in
  let uri =
   match kind with
-     Decl_kinds.IsLocal ->
+     Decl_kinds.Local, _ ->
       let uri =
        "cic:/" ^ String.concat "/"
-        (Cic2acic.token_list_of_path (Lib.cwd ()) id Cic2acic.Variable) in
+        (Cic2acic.token_list_of_path (Lib.cwd ()) id Cic2acic.TVariable)
+      in
       let kind_of_var = "VARIABLE","LocalFact" in
        if not internal then print_object_kind uri kind_of_var;
       uri
-   | Decl_kinds.IsGlobal _ ->
-      let uri = Cic2acic.uri_of_declaration id Cic2acic.Constant in
+   | Decl_kinds.Global, _ ->
+      let uri = Cic2acic.uri_of_declaration id Cic2acic.TConstant in
        if not internal then print_object_kind uri (kind_of_global_goal kind);
        uri
  in
@@ -610,7 +609,7 @@ let _ =
 
 let _ =
   Declare.set_xml_declare_constant
-   (function (internal,(sp,kn)) ->
+   (function (internal,kn) ->
      match !proof_to_export with
         None ->
           print internal (Libnames.ConstRef kn) (kind_of_constant kn) 
@@ -618,9 +617,9 @@ let _ =
       | Some pftreestate ->
          (* It is a proof. Let's export it starting from the proof-tree *)
          (* I saved in the Pfedit.set_xml_cook_proof callback.          *)
-        let fn = filename_of_path xml_library_root kn Cic2acic.Constant in
+        let fn = filename_of_path xml_library_root (Cic2acic.Constant kn) in
          show_pftreestate internal fn pftreestate 
-	  (Names.id_of_label (Names.label kn)) ;
+	  (Names.id_of_label (Names.con_label kn)) ;
          proof_to_export := None)
 ;;
 
@@ -675,7 +674,7 @@ let _ =
            let dot = if fn.[0]='/' then "." else "" in
            command ("mv "^dir^"/"^dot^"*.html "^fn^".xml ");
            command ("rm "^fn^".v");
-           print_string("\nWriting on file \"" ^ fn ^ ".xml\" was succesful\n"))
+           print_string("\nWriting on file \"" ^ fn ^ ".xml\" was successful\n"))
        ofn)
 ;;
 
diff --git a/contrib/xml/xmlcommand.mli b/contrib/xml/xmlcommand.mli
index 9a7464bd..7c0d31a1 100644
--- a/contrib/xml/xmlcommand.mli
+++ b/contrib/xml/xmlcommand.mli
@@ -12,7 +12,7 @@
 (*                       http://helm.cs.unibo.it                        *)
 (************************************************************************)
 
-(*i $Id: xmlcommand.mli,v 1.18.2.2 2004/07/16 19:30:15 herbelin Exp $ i*)
+(*i $Id: xmlcommand.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* print_global qid fn                                                    *)
 (*  where qid  is a long name denoting a definition/theorem or            *)
diff --git a/contrib/xml/xmlentries.ml4 b/contrib/xml/xmlentries.ml4
index 2bc686f7..496debe1 100644
--- a/contrib/xml/xmlentries.ml4
+++ b/contrib/xml/xmlentries.ml4
@@ -14,7 +14,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: xmlentries.ml4,v 1.12.2.2 2004/07/16 19:30:15 herbelin Exp $ *)
+(* $Id: xmlentries.ml4 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Util;;
 open Vernacinterp;;
diff --git a/contrib7/cc/CCSolve.v b/contrib7/cc/CCSolve.v
deleted file mode 100644
index 388763ed..00000000
--- a/contrib7/cc/CCSolve.v
+++ /dev/null
@@ -1,20 +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        *)
-(************************************************************************)
-
-(* $Id: CCSolve.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-Tactic Definition CCsolve :=
- Repeat (Match Context With
- [ H: ?1 |- ?2] -> 
-  Let Heq = FreshId "Heq" In
- (Assert Heq:(?2==?1);[Congruence|(Rewrite Heq;Exact H)])
- |[ H: ?1; G: ?2 -> ?3 |- ?] ->                        
-  Let Heq = FreshId "Heq" In
- (Assert Heq:(?2==?1) ;[Congruence|                              
-     (Rewrite Heq in G;Generalize (G H);Clear G;Intro G)])).  
-
diff --git a/contrib7/correctness/ArrayPermut.v b/contrib7/correctness/ArrayPermut.v
deleted file mode 100644
index 4a0025ca..00000000
--- a/contrib7/correctness/ArrayPermut.v
+++ /dev/null
@@ -1,183 +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        *)
-(************************************************************************)
-
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
-
-(* $Id: ArrayPermut.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-(****************************************************************************)
-(*                    Permutations of elements in arrays                    *)
-(*                        Definition and properties                         *)
-(****************************************************************************)
-
-Require ProgInt.
-Require Arrays.
-Require Export Exchange.
-
-Require Omega.
-
-Set Implicit Arguments.
-
-(* We define "permut" as the smallest equivalence relation which contains
- * transpositions i.e. exchange of two elements.
- *)
-
-Inductive permut [n:Z; A:Set] : (array n A)->(array n A)->Prop :=
-    exchange_is_permut : 
-      (t,t':(array n A))(i,j:Z)(exchange t t' i j) -> (permut t t')
-  | permut_refl : 
-      (t:(array n A))(permut t t)
-  | permut_sym : 
-      (t,t':(array n A))(permut t t') -> (permut t' t)
-  | permut_trans : 
-      (t,t',t'':(array n A))
-      (permut t t') -> (permut t' t'') -> (permut t t'').
-
-Hints Resolve exchange_is_permut permut_refl permut_sym permut_trans : v62 datatypes.
-
-(* We also define the permutation on a segment of an array, "sub_permut",
- * the other parts of the array being unchanged
- *
- * One again we define it as the smallest equivalence relation containing
- * transpositions on the given segment.
- *)
-
-Inductive sub_permut [n:Z; A:Set; g,d:Z] : (array n A)->(array n A)->Prop :=
-    exchange_is_sub_permut : 
-      (t,t':(array n A))(i,j:Z)`g <= i <= d` -> `g <= j <= d`
-      -> (exchange t t' i j) -> (sub_permut g d t t')
-  | sub_permut_refl : 
-      (t:(array n A))(sub_permut g d t t)
-  | sub_permut_sym : 
-      (t,t':(array n A))(sub_permut g d t t') -> (sub_permut g d t' t)
-  | sub_permut_trans : 
-      (t,t',t'':(array n A))
-      (sub_permut g d t t') -> (sub_permut g d t' t'') 
-      -> (sub_permut g d t t'').
-
-Hints Resolve exchange_is_sub_permut sub_permut_refl sub_permut_sym sub_permut_trans
-  : v62 datatypes.
-
-(* To express that some parts of arrays are equal we introduce the
- * property "array_id" which says that a segment is the same on two
- * arrays.
- *)
-
-Definition array_id := [n:Z][A:Set][t,t':(array n A)][g,d:Z]
-  (i:Z) `g <= i <= d` -> #t[i] = #t'[i].
-
-(* array_id is an equivalence relation *)
-
-Lemma array_id_refl : 
-  (n:Z)(A:Set)(t:(array n A))(g,d:Z)
-  (array_id t t g d).
-Proof.
-Unfold array_id.
-Auto with datatypes.
-Save.
-
-Hints Resolve array_id_refl : v62 datatypes.
-
-Lemma array_id_sym :
-  (n:Z)(A:Set)(t,t':(array n A))(g,d:Z)
-  (array_id t t' g d)
-  -> (array_id t' t g d).
-Proof.
-Unfold array_id. Intros.
-Symmetry; Auto with datatypes.
-Save.
-
-Hints Resolve  array_id_sym : v62 datatypes.
-
-Lemma array_id_trans :
-  (n:Z)(A:Set)(t,t',t'':(array n A))(g,d:Z)
-  (array_id t t' g d)
-  -> (array_id t' t'' g d)
-    -> (array_id t t'' g d).
-Proof.
-Unfold array_id. Intros.
-Apply trans_eq with y:=#t'[i]; Auto with datatypes.
-Save.
-
-Hints Resolve array_id_trans: v62 datatypes.
-
-(* Outside the segment [g,d] the elements are equal *)
-
-Lemma sub_permut_id :
-  (n:Z)(A:Set)(t,t':(array n A))(g,d:Z)
-  (sub_permut g d t t') ->
-  (array_id t t' `0` `g-1`) /\ (array_id t t' `d+1` `n-1`).
-Proof.
-Intros n A t t' g d. Induction 1; Intros.
-Elim H2; Intros.
-Unfold array_id; Split; Intros.
-Apply H7; Omega.
-Apply H7; Omega.
-Auto with datatypes.
-Decompose [and] H1; Auto with datatypes.
-Decompose [and] H1; Decompose [and] H3; EAuto with datatypes.
-Save.
-
-Hints Resolve sub_permut_id.
-
-Lemma sub_permut_eq :
-  (n:Z)(A:Set)(t,t':(array n A))(g,d:Z)
-  (sub_permut g d t t') ->
-  (i:Z) (`0<=i<g` \/ `d<i<n`) -> #t[i]=#t'[i].
-Proof.
-Intros n A t t' g d Htt' i Hi.
-Elim (sub_permut_id Htt'). Unfold array_id. 
-Intros.
-Elim Hi; [ Intro; Apply H; Omega | Intro; Apply H0; Omega ].
-Save.
-
-(* sub_permut is a particular case of permutation *)
-
-Lemma sub_permut_is_permut :
-  (n:Z)(A:Set)(t,t':(array n A))(g,d:Z)
-  (sub_permut g d t t') ->
-  (permut t t').
-Proof.
-Intros n A t t' g d. Induction 1; Intros; EAuto with datatypes.
-Save.
-
-Hints Resolve sub_permut_is_permut.
-
-(* If we have a sub-permutation on an empty segment, then we have a 
- * sub-permutation on any segment.
- *)
-
-Lemma sub_permut_void :
-  (N:Z)(A:Set)(t,t':(array N A))
-  (g,g',d,d':Z) `d < g`
-   -> (sub_permut g d t t') -> (sub_permut g' d' t t').
-Proof.
-Intros N A t t' g g' d d' Hdg.
-(Induction 1; Intros).
-(Absurd `g <= d`; Omega).
-Auto with datatypes.
-Auto with datatypes.
-EAuto with datatypes.
-Save.
-
-(* A sub-permutation on a segment may be extended to any segment that
- * contains the first one.
- *)
-
-Lemma sub_permut_extension :
-  (N:Z)(A:Set)(t,t':(array N A))
-  (g,g',d,d':Z) `g' <= g` -> `d <= d'`
-   -> (sub_permut g d t t') -> (sub_permut g' d' t t').
-Proof.
-Intros N A t t' g g' d d' Hgg' Hdd'.
-(Induction 1; Intros).
-Apply exchange_is_sub_permut with i:=i j:=j; [ Omega | Omega | Assumption ].
-Auto with datatypes.
-Auto with datatypes.
-EAuto with datatypes.
-Save.
diff --git a/contrib7/correctness/Arrays.v b/contrib7/correctness/Arrays.v
deleted file mode 100644
index 3fdc78c1..00000000
--- a/contrib7/correctness/Arrays.v
+++ /dev/null
@@ -1,75 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
-
-(* $Id: Arrays.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-(**********************************************)
-(* Functional arrays, for use in Correctness. *)
-(**********************************************)
-
-(* This is an axiomatization of arrays.
- *
- * The type (array N T) is the type of arrays ranging from 0 to N-1 
- * which elements are of type T.
- *
- * Arrays are created with new, accessed with access and modified with store. 
- *
- * Operations of accessing and storing are not guarded, but axioms are.
- * So these arrays can be viewed as arrays where accessing and storing
- * out of the bounds has no effect.
- *)
-
-
-Require Export ProgInt.
-
-Set Implicit Arguments.
-
-
-(* The type of arrays *)
-
-Parameter array : Z -> Set -> Set.
-
-
-(* Functions to create, access and modify arrays *)
-
-Parameter new : (n:Z)(T:Set) T -> (array n T).
-
-Parameter access : (n:Z)(T:Set) (array n T) -> Z -> T.
-
-Parameter store : (n:Z)(T:Set) (array n T) -> Z -> T -> (array n T).
-
-
-(* Axioms *)
-
-Axiom new_def : (n:Z)(T:Set)(v0:T)
-                (i:Z) `0<=i<n` -> (access (new n v0) i) = v0.
-
-Axiom store_def_1 : (n:Z)(T:Set)(t:(array n T))(v:T)
-                    (i:Z) `0<=i<n` ->
-                    (access (store t i v) i) = v.
-
-Axiom store_def_2 : (n:Z)(T:Set)(t:(array n T))(v:T)
-                    (i:Z)(j:Z) `0<=i<n` -> `0<=j<n` ->
-		    `i <> j` ->
-                    (access (store t i v) j) = (access t j).
-
-Hints Resolve new_def store_def_1 store_def_2 : datatypes v62.
-
-(* A tactic to simplify access in arrays *)
-
-Tactic Definition ArrayAccess i j H :=
-    Elim (Z_eq_dec i j); [ 
-      Intro H; Rewrite H; Rewrite store_def_1
-    | Intro H; Rewrite store_def_2; [ Idtac | Idtac | Idtac | Exact H ] ].
-
-(* Symbolic notation for access *)
-
-Notation "# t [ c ]" := (access t c) (at level 0, t ident)
-  V8only (at level 0, t at level 0).
diff --git a/contrib7/correctness/Correctness.v b/contrib7/correctness/Correctness.v
deleted file mode 100644
index b0fde165..00000000
--- a/contrib7/correctness/Correctness.v
+++ /dev/null
@@ -1,25 +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        *)
-(************************************************************************)
-
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
-
-(* $Id: Correctness.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-(* Correctness is base on the tactic Refine (developped on purpose) *)
-
-Require Export Tuples.
-
-Require Export ProgInt.
-Require Export ProgBool.
-Require Export Zwf.
-
-Require Export Arrays.
-
-(*
-Token "'".
-*)
diff --git a/contrib7/correctness/Exchange.v b/contrib7/correctness/Exchange.v
deleted file mode 100644
index 12c8c9de..00000000
--- a/contrib7/correctness/Exchange.v
+++ /dev/null
@@ -1,94 +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        *)
-(************************************************************************)
-
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
-
-(* $Id: Exchange.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-(****************************************************************************)
-(*                   Exchange of two elements in an array                   *)
-(*                        Definition and properties                         *)
-(****************************************************************************)
-
-Require ProgInt.
-Require Arrays.
-
-Set Implicit Arguments.
-
-(* Definition *)
-
-Inductive exchange [n:Z; A:Set; t,t':(array n A); i,j:Z] : Prop :=
-  exchange_c :
-    `0<=i<n` -> `0<=j<n` ->
-    (#t[i] = #t'[j]) ->
-    (#t[j] = #t'[i]) ->
-    ((k:Z)`0<=k<n` -> `k<>i` -> `k<>j` -> #t[k] = #t'[k]) ->
-    (exchange t t' i j).
-    
-(* Properties about exchanges *)
-
-Lemma exchange_1 : (n:Z)(A:Set)(t:(array n A))
-  (i,j:Z) `0<=i<n` -> `0<=j<n` ->
-  (access (store (store t i #t[j]) j #t[i]) i) = #t[j].
-Proof.
-Intros n A t i j H_i H_j.
-Case (dec_eq j i).
-Intro eq_i_j. Rewrite eq_i_j.
-Auto with datatypes.
-Intro not_j_i.
-Rewrite (store_def_2 (store t i #t[j]) #t[i] H_j H_i not_j_i).
-Auto with datatypes.
-Save.
-
-Hints Resolve exchange_1 : v62 datatypes.
-
-
-Lemma exchange_proof :
-  (n:Z)(A:Set)(t:(array n A))
-  (i,j:Z) `0<=i<n` -> `0<=j<n` ->
-  (exchange (store (store t i (access t j)) j (access t i)) t i j).
-Proof.
-Intros n A t i j H_i H_j.
-Apply exchange_c; Auto with datatypes.
-Intros k H_k not_k_i not_k_j.
-Cut ~j=k; Auto with datatypes. Intro not_j_k.
-Rewrite (store_def_2 (store t i (access t j)) (access t i) H_j H_k not_j_k).
-Auto with datatypes.
-Save.
-
-Hints Resolve exchange_proof : v62 datatypes.
-
-
-Lemma exchange_sym :
-  (n:Z)(A:Set)(t,t':(array n A))(i,j:Z)
-  (exchange t t' i j) -> (exchange t' t i j).
-Proof.
-Intros n A t t' i j H1.
-Elim H1. Clear H1. Intros.
-Constructor 1; Auto with datatypes.
-Intros. Rewrite (H3 k); Auto with datatypes.
-Save.
-
-Hints Resolve exchange_sym : v62 datatypes.
-
-
-Lemma exchange_id :
-  (n:Z)(A:Set)(t,t':(array n A))(i,j:Z)
-  (exchange t t' i j) -> 
-  i=j ->
-  (k:Z) `0 <= k < n` -> (access t k)=(access t' k).
-Proof.
-Intros n A t t' i j Hex Heq k Hk.
-Elim Hex. Clear Hex. Intros.
-Rewrite Heq in H1. Rewrite Heq in H2.
-Case (Z_eq_dec k j). 
-  Intro Heq'. Rewrite Heq'. Assumption.
-  Intro Hnoteq. Apply (H3 k); Auto with datatypes. Rewrite Heq. Assumption.
-Save.
-
-Hints Resolve exchange_id : v62 datatypes.
diff --git a/contrib7/correctness/ProgBool.v b/contrib7/correctness/ProgBool.v
deleted file mode 100644
index c7a7687d..00000000
--- a/contrib7/correctness/ProgBool.v
+++ /dev/null
@@ -1,66 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
-
-(* $Id: ProgBool.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-Require ZArith.
-Require Export Bool_nat.
-Require Export Sumbool.
-
-Definition annot_bool :
-  (b:bool) { b':bool | if b' then b=true else b=false }.
-Proof.
-Intro b.
-Exists b. Case b; Trivial.
-Save.
-
-
-(* Logical connectives *)
-
-Definition spec_and := [A,B,C,D:Prop][b:bool]if b then A /\ C else B \/ D.
-
-Definition prog_bool_and :
-  (Q1,Q2:bool->Prop) (sig bool Q1) -> (sig bool Q2)
-  -> { b:bool | if b then (Q1 true) /\ (Q2 true)
-                     else (Q1 false) \/ (Q2 false) }.
-Proof.
-Intros Q1 Q2 H1 H2.
-Elim H1. Intro b1. Elim H2. Intro b2. 
-Case b1; Case b2; Intros.
-Exists true; Auto.
-Exists false; Auto. Exists false; Auto. Exists false; Auto.
-Save.
-
-Definition spec_or := [A,B,C,D:Prop][b:bool]if b then A \/ C else B /\ D.
-
-Definition prog_bool_or :
-  (Q1,Q2:bool->Prop) (sig bool Q1) -> (sig bool Q2)
-  -> { b:bool | if b then (Q1 true) \/ (Q2 true)
-                     else (Q1 false) /\ (Q2 false) }.
-Proof.
-Intros Q1 Q2 H1 H2.
-Elim H1. Intro b1. Elim H2. Intro b2. 
-Case b1; Case b2; Intros.
-Exists true; Auto. Exists true; Auto. Exists true; Auto.
-Exists false; Auto.
-Save.
-
-Definition spec_not:= [A,B:Prop][b:bool]if b then B else A.
-
-Definition prog_bool_not :
-  (Q:bool->Prop) (sig bool Q)
-  -> { b:bool | if b then (Q false) else (Q true) }.
-Proof.
-Intros Q H.
-Elim H. Intro b.
-Case b; Intro.
-Exists false; Auto. Exists true; Auto.
-Save.
-
diff --git a/contrib7/correctness/ProgramsExtraction.v b/contrib7/correctness/ProgramsExtraction.v
deleted file mode 100644
index 20f82ce4..00000000
--- a/contrib7/correctness/ProgramsExtraction.v
+++ /dev/null
@@ -1,30 +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        *)
-(************************************************************************)
-
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
-
-(* $Id: ProgramsExtraction.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-Require Export Extraction.
-
-Extract Inductive unit => unit [ "()" ].
-Extract Inductive bool => bool [ true false ].
-Extract Inductive sumbool => bool [ true false ].
-
-Require Export Correctness.
-
-Declare ML Module "pextract".
-
-Grammar vernac vernac : ast :=
-  imperative_ocaml [ "Write" "Caml" "File" stringarg($file) 
-    "[" ne_identarg_list($idl) "]" "." ]
-     -> [ (IMPERATIVEEXTRACTION $file (VERNACARGLIST ($LIST $idl))) ]
-
-| initialize [ "Initialize" identarg($id) "with" comarg($c) "." ]
-     -> [ (INITIALIZE $id $c) ]
-.
diff --git a/contrib7/correctness/Sorted.v b/contrib7/correctness/Sorted.v
deleted file mode 100644
index f476142e..00000000
--- a/contrib7/correctness/Sorted.v
+++ /dev/null
@@ -1,198 +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        *)
-(************************************************************************)
-
-(*  Library about sorted (sub-)arrays / Nicolas Magaud, July 1998 *)
-
-(* $Id: Sorted.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-Require Export Arrays.
-Require ArrayPermut.
-
-Require ZArithRing.
-Require Omega.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-Set Implicit Arguments.
-
-(* Definition *)
-
-Definition sorted_array :=
-  [N:Z][A:(array N Z)][deb:Z][fin:Z]
-     `deb<=fin` -> (x:Z) `x>=deb` -> `x<fin` -> (Zle #A[x] #A[`x+1`]).
-
-(* Elements of a sorted sub-array are in increasing order *)
-
-(* one element and the next one *)
-
-Lemma sorted_elements_1 :
-  (N:Z)(A:(array N Z))(n:Z)(m:Z)
-  (sorted_array A n m)
-  -> (k:Z)`k>=n`
-  -> (i:Z) `0<=i` -> `k+i<=m`
-  -> (Zle (access A k) (access A `k+i`)).
-Proof.
-Intros N A n m H_sorted k H_k i H_i.
-Pattern i. Apply natlike_ind.
-Intro.
-Replace `k+0` with k; Omega. (*** Ring `k+0` => BUG ***)
-
-Intros.
-Apply Zle_trans with m:=(access A `k+x`).
-Apply H0 ; Omega.
-
-Unfold Zs.
-Replace `k+(x+1)` with `(k+x)+1`.
-Unfold sorted_array in H_sorted.
-Apply H_sorted ; Omega.
-
-Omega.
-
-Assumption.
-Save.
-
-(* one element and any of the following *)
-
-Lemma sorted_elements :
-  (N:Z)(A:(array N Z))(n:Z)(m:Z)(k:Z)(l:Z)
-  (sorted_array A n m)
-  -> `k>=n` -> `l<N` -> `k<=l` -> `l<=m`
-  -> (Zle (access A k) (access A l)).
-Proof.
-Intros.
-Replace l with `k+(l-k)`.
-Apply sorted_elements_1 with n:=n m:=m; [Assumption | Omega | Omega | Omega].
-Omega.
-Save.
-
-Hints Resolve sorted_elements : datatypes v62.
-
-(* A sub-array of a sorted array is sorted *)
-
-Lemma sub_sorted_array : (N:Z)(A:(array N Z))(deb:Z)(fin:Z)(i:Z)(j:Z)
-      (sorted_array A deb fin) -> 
-        (`i>=deb` -> `j<=fin` -> `i<=j` -> (sorted_array A i j)).
-Proof.
-Unfold sorted_array.
-Intros.
-Apply H ; Omega.
-Save.
-
-Hints Resolve sub_sorted_array : datatypes v62.
-
-(* Extension on the left of the property of being sorted *)
-
-Lemma left_extension : (N:Z)(A:(array N Z))(i:Z)(j:Z)
-   `i>0` -> `j<N` -> (sorted_array A i j) 
-   -> (Zle #A[`i-1`]  #A[i]) -> (sorted_array A `i-1` j).
-Proof.
-(Intros; Unfold sorted_array ; Intros).
-Elim (Z_ge_lt_dec x i).   (* (`x >= i`) + (`x < i`) *)
-Intro Hcut.
-Apply H1 ; Omega.
-
-Intro Hcut.
-Replace x with `i-1`.
-Replace `i-1+1` with i ; [Assumption | Omega].
-
-Omega.
-Save.
-
-(* Extension on the right *)
-
-Lemma right_extension : (N:Z)(A:(array N Z))(i:Z)(j:Z)
-   `i>=0` -> `j<N-1` -> (sorted_array A i j) 
-   -> (Zle #A[j]  #A[`j+1`]) -> (sorted_array A i `j+1`).
-Proof.
-(Intros; Unfold sorted_array ; Intros).
-Elim (Z_lt_ge_dec x j).
-Intro Hcut. 
-Apply H1 ; Omega.
-
-Intro HCut.
-Replace x with j ; [Assumption | Omega].
-Save.
-
-(* Substitution of the leftmost value by a smaller value *) 
-
-Lemma left_substitution : 
-   (N:Z)(A:(array N Z))(i:Z)(j:Z)(v:Z)
-   `i>=0`  -> `j<N`  -> (sorted_array A i j)
-   -> (Zle v #A[i])
-   -> (sorted_array (store A i v) i j).
-Proof.
-Intros N A i j v H_i H_j H_sorted H_v.
-Unfold sorted_array ; Intros.
-
-Cut `x = i`\/`x > i`.
-(Intro Hcut ; Elim Hcut ; Clear Hcut ; Intro).
-Rewrite H2.
-Rewrite store_def_1 ; Try Omega.
-Rewrite store_def_2 ; Try Omega.
-Apply Zle_trans with m:=(access A i) ; [Assumption | Apply H_sorted ; Omega].
-
-(Rewrite store_def_2; Try Omega).
-(Rewrite store_def_2; Try Omega).
-Apply H_sorted ; Omega.
-Omega.
-Save.
-
-(* Substitution of the rightmost value by a larger value *)
-
-Lemma right_substitution : 
-   (N:Z)(A:(array N Z))(i:Z)(j:Z)(v:Z)
-   `i>=0`  -> `j<N`  -> (sorted_array A i j)
-   -> (Zle #A[j] v)
-   -> (sorted_array (store A j v) i j).
-Proof.
-Intros N A i j v H_i H_j H_sorted H_v.
-Unfold sorted_array ; Intros.
-
-Cut `x = j-1`\/`x < j-1`.
-(Intro Hcut ; Elim Hcut ; Clear Hcut ; Intro).
-Rewrite H2.
-Replace `j-1+1` with j; [ Idtac | Omega ]. (*** Ring `j-1+1`. => BUG ***)
-Rewrite store_def_2 ; Try Omega.
-Rewrite store_def_1 ; Try Omega.
-Apply Zle_trans with m:=(access A j). 
-Apply sorted_elements with n:=i m:=j ; Try Omega ; Assumption.
-Assumption.
-
-(Rewrite store_def_2; Try Omega).
-(Rewrite store_def_2; Try Omega).
-Apply H_sorted ; Omega.
-
-Omega.
-Save.
-
-(* Affectation outside of the sorted region *)
-
-Lemma no_effect : 
-   (N:Z)(A:(array N Z))(i:Z)(j:Z)(k:Z)(v:Z)
-   `i>=0`  -> `j<N`  -> (sorted_array A i j)
-   -> `0<=k<i`\/`j<k<N`
-   -> (sorted_array (store A k v) i j).
-Proof.
-Intros.
-Unfold sorted_array ; Intros. 
-Rewrite store_def_2 ; Try Omega.
-Rewrite store_def_2 ; Try Omega.
-Apply H1 ; Assumption.
-Save.
-
-Lemma sorted_array_id : (N:Z)(t1,t2:(array N Z))(g,d:Z)
-  (sorted_array t1 g d) -> (array_id t1 t2 g d) -> (sorted_array t2 g d).
-Proof.
-Intros N t1 t2 g d Hsorted Hid.
-Unfold array_id in Hid.
-Unfold sorted_array in Hsorted. Unfold sorted_array.
-Intros Hgd x H1x H2x.
-Rewrite <- (Hid x); [ Idtac | Omega ].
-Rewrite <- (Hid `x+1`); [ Idtac | Omega ].
-Apply Hsorted; Assumption.
-Save.
diff --git a/contrib7/correctness/Tuples.v b/contrib7/correctness/Tuples.v
deleted file mode 100644
index 6e1eb03a..00000000
--- a/contrib7/correctness/Tuples.v
+++ /dev/null
@@ -1,106 +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        *)
-(************************************************************************)
-
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
-
-(* $Id: Tuples.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-(* Tuples *)
-
-Definition tuple_1 := [X:Set]X.
-Definition tuple_2 := prod.
-Definition Build_tuple_2 := pair.
-Definition proj_2_1 := fst.
-Definition proj_2_2 := snd.
-
-Record tuple_3 [ T1,T2,T3 : Set ] : Set := 
-  { proj_3_1 : T1 ;
-    proj_3_2 : T2 ;
-    proj_3_3 : T3 }.
-
-Record tuple_4 [ T1,T2,T3,T4 : Set ] : Set := 
-  { proj_4_1 : T1 ;
-    proj_4_2 : T2 ;
-    proj_4_3 : T3 ;
-    proj_4_4 : T4 }.
-
-Record tuple_5 [ T1,T2,T3,T4,T5 : Set ] : Set :=
-  { proj_5_1 : T1 ;
-    proj_5_2 : T2 ;
-    proj_5_3 : T3 ;
-    proj_5_4 : T4 ;
-    proj_5_5 : T5 }.
-
-Record tuple_6 [ T1,T2,T3,T4,T5,T6 : Set ] : Set :=
-  { proj_6_1 : T1 ;
-    proj_6_2 : T2 ;
-    proj_6_3 : T3 ;
-    proj_6_4 : T4 ;
-    proj_6_5 : T5 ;
-    proj_6_6 : T6 }.
-
-Record tuple_7 [ T1,T2,T3,T4,T5,T6,T7 : Set ] : Set :=
-  { proj_7_1 : T1 ;
-    proj_7_2 : T2 ;
-    proj_7_3 : T3 ;
-    proj_7_4 : T4 ;
-    proj_7_5 : T5 ;
-    proj_7_6 : T6 ;
-    proj_7_7 : T7 }.
-
-
-(* Existentials *)
-
-Definition sig_1 := sig.
-Definition exist_1 := exist.
-
-Inductive sig_2 [ T1,T2 : Set; P:T1->T2->Prop ] : Set := 
-  exist_2 : (x1:T1)(x2:T2)(P x1 x2) -> (sig_2 T1 T2 P).
-
-Inductive sig_3 [ T1,T2,T3 : Set; P:T1->T2->T3->Prop ] : Set := 
-  exist_3 : (x1:T1)(x2:T2)(x3:T3)(P x1 x2 x3) -> (sig_3 T1 T2 T3 P).
-
-
-Inductive sig_4 [ T1,T2,T3,T4 : Set;
-                  P:T1->T2->T3->T4->Prop ] : Set :=
-  exist_4 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)
-             (P x1 x2 x3 x4)
-          -> (sig_4 T1 T2 T3 T4 P).
-
-Inductive sig_5 [ T1,T2,T3,T4,T5 : Set;
-                  P:T1->T2->T3->T4->T5->Prop ] : Set :=
-  exist_5 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)(x5:T5)
-             (P x1 x2 x3 x4 x5)
-          -> (sig_5 T1 T2 T3 T4 T5 P).
-
-Inductive sig_6 [ T1,T2,T3,T4,T5,T6 : Set;
-                  P:T1->T2->T3->T4->T5->T6->Prop ] : Set :=
-  exist_6 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)(x5:T5)(x6:T6)
-             (P x1 x2 x3 x4 x5 x6)
-          -> (sig_6 T1 T2 T3 T4 T5 T6 P).
-
-Inductive sig_7 [ T1,T2,T3,T4,T5,T6,T7 : Set;
-                  P:T1->T2->T3->T4->T5->T6->T7->Prop ] : Set :=
-  exist_7 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)(x5:T5)(x6:T6)(x7:T7)
-             (P x1 x2 x3 x4 x5 x6 x7)
-          -> (sig_7 T1 T2 T3 T4 T5 T6 T7 P).
-
-Inductive sig_8 [ T1,T2,T3,T4,T5,T6,T7,T8 : Set;
-                  P:T1->T2->T3->T4->T5->T6->T7->T8->Prop ] : Set :=
-  exist_8 : (x1:T1)(x2:T2)(x3:T3)(x4:T4)(x5:T5)(x6:T6)(x7:T7)(x8:T8)
-             (P x1 x2 x3 x4 x5 x6 x7 x8)
-          -> (sig_8 T1 T2 T3 T4 T5 T6 T7 T8 P).      
-
-Inductive dep_tuple_2 [ T1,T2 : Set; P:T1->T2->Set ] : Set := 
-  Build_dep_tuple_2 : (x1:T1)(x2:T2)(P x1 x2) -> (dep_tuple_2 T1 T2 P).
-
-Inductive dep_tuple_3 [ T1,T2,T3 : Set; P:T1->T2->T3->Set ] : Set := 
-  Build_dep_tuple_3 : (x1:T1)(x2:T2)(x3:T3)(P x1 x2 x3)
-      	       	   -> (dep_tuple_3 T1 T2 T3 P).
-
-
diff --git a/contrib7/correctness/preuves.v b/contrib7/correctness/preuves.v
deleted file mode 100644
index 33659b43..00000000
--- a/contrib7/correctness/preuves.v
+++ /dev/null
@@ -1,128 +0,0 @@
-
-(* Quelques preuves sur des programmes simples,
- * juste histoire d'avoir un petit bench.
- *)
-
-Require Correctness.
-Require Omega.
-
-Global Variable x : Z ref.
-Global Variable y : Z ref.
-Global Variable z : Z ref.
-Global Variable i : Z ref.
-Global Variable j : Z ref.
-Global Variable n : Z ref.
-Global Variable m : Z ref.
-Variable r : Z.
-Variable N : Z.
-Global Variable t : array N of Z.
-
-(**********************************************************************)
-
-Require Exchange.
-Require ArrayPermut.
-
-Correctness swap
-  fun (N:Z)(t:array N of Z)(i,j:Z) ->
-    { `0 <= i < N` /\ `0 <= j < N` }
-    (let v = t[i] in
-     begin
-       t[i] := t[j];
-       t[j] := v
-     end)
-    { (exchange t t@ i j) }.
-Proof.
-Auto with datatypes.
-Save.
-
-Correctness downheap
-  let rec downheap (N:Z)(t:array N of Z) : unit { variant `0` } =
-    (swap N t 0 0) { True }
-.
-
-(**********************************************************************)
-
-Global Variable x : Z ref.
-Debug on.
-Correctness assign0 (x := 0) { `x=0` }.
-Save.
-
-(**********************************************************************)
-
-Global Variable i : Z ref.
-Debug on.
-Correctness assign1 { `0 <= i` } (i := !i + 1) { `0 < i` }.
-Omega.
-Save.
-
-(**********************************************************************)
-
-Global Variable i : Z ref.
-Debug on.
-Correctness if0 { `0 <= i` } (if !i>0 then i:=!i-1 else tt) { `0 <= i` }.
-Omega.
-Save.
-
-(**********************************************************************)
-
-Global Variable i : Z ref.
-Debug on.
-Correctness assert0 { `0 <= i` } begin assert { `i=2` }; i:=!i-1 end { `i=1` }.
-
-(**********************************************************************)
-
-Correctness echange
-  { `0 <= i < N` /\ `0 <= j < N` }
-  begin
-    label B;
-    x := t[!i]; t[!i] := t[!j]; t[!j] := !x;
-    assert { #t[i] = #t@B[j] /\ #t[j] = #t@B[i] }
-  end.
-Proof.
-Auto with datatypes.
-Save.
-
-  
-(**********************************************************************)
-
-(*
- *   while x <= y do x := x+1 done { y < x }
- *)
-
-Correctness incrementation
-  while !x < !y do
-    { invariant True variant `(Zs y)-x` }
-    x := !x + 1
-  done
-  { `y < x` }.
-Proof.
-Exact (Zwf_well_founded `0`).
-Unfold Zwf. Omega.
-Exact I.
-Save.
-
-
-(************************************************************************)
-
-Correctness pivot1
-  begin
-    while (Z_lt_ge_dec !i r) do
-      { invariant True variant (Zminus (Zs r) i) } i := (Zs !i)
-    done;
-    while (Z_lt_ge_dec r !j) do
-      { invariant True variant (Zminus (Zs j) r) } j := (Zpred !j)
-    done
-  end
-  { `j <= r` /\ `r <= i` }.
-Proof.
-Exact (Zwf_well_founded `0`).
-Unfold Zwf. Omega.
-Exact I.
-Exact (Zwf_well_founded `0`).
-Unfold Zwf. Unfold Zpred. Omega.
-Exact I.
-Omega.
-Save.
-
-
-
diff --git a/contrib7/extraction/test_extraction.v b/contrib7/extraction/test_extraction.v
deleted file mode 100644
index e76b1c69..00000000
--- a/contrib7/extraction/test_extraction.v
+++ /dev/null
@@ -1,533 +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        *)
-(************************************************************************)
-
-Require Arith.
-Require PolyList.
-
-(*** STANDARD EXAMPLES *)
-
-(** Functions. *)
-
-Definition idnat := [x:nat]x.
-Extraction idnat.
-(* let idnat x = x *)
-
-Definition id := [X:Type][x:X]x.      
-Extraction id. (* let id x = x *)
-Definition id' := (id Set nat).
-Extraction id'. (* type id' = nat *)
-
-Definition test2 := [f:nat->nat][x:nat](f x).
-Extraction test2.
-(* let test2 f x = f x *)
-
-Definition test3 := [f:nat->Set->nat][x:nat](f x nat).
-Extraction test3.
-(* let test3 f x = f x __ *)
-
-Definition test4 := [f:(nat->nat)->nat][x:nat][g:nat->nat](f g).
-Extraction test4.
-(* let test4 f x g = f g *)
-
-Definition test5 := ((1),(0)).
-Extraction test5.
-(* let test5 = Pair ((S O), O) *)
-
-Definition cf :=  [x:nat][_:(le x O)](S x).
-Extraction NoInline cf.
-Definition test6 := (cf O (le_n O)).
-Extraction test6.  
-(* let test6 = cf O *)
-
-Definition test7 := ([X:Set][x:X]x nat).
-Extraction test7.
-(* let test7 x = x *)
-
-Definition d := [X:Type]X.
-Extraction d. (* type 'x d = 'x *)
-Definition d2 := (d Set).
-Extraction d2. (* type d2 = __ d *)
-Definition d3 := [x:(d Set)]O.
-Extraction d3. (* let d3 _ = O *)
-Definition d4 := (d nat). 
-Extraction d4. (* type d4 = nat d *)
-Definition d5 := ([x:(d Type)]O Type).  
-Extraction d5.  (* let d5 = O *)
-Definition d6 := ([x:(d Type)]x).
-Extraction d6.  (* type 'x d6 = 'x *)
-
-Definition test8 := ([X:Type][x:X]x Set nat).
-Extraction test8. (* type test8 = nat *)
-
-Definition test9 := let t = nat in (id Set t).
-Extraction test9.  (* type test9 = nat *)
-
-Definition test10 := ([X:Type][x:X]O Type Type).
-Extraction test10. (* let test10 = O *)
-
-Definition test11 := let n=O in let p=(S n) in (S p).
-Extraction test11. (* let test11 = S (S O) *)
-
-Definition test12 := (x:(X:Type)X->X)(x Type Type).
-Extraction test12. 
-(* type test12 = (__ -> __ -> __) -> __ *)
-
-
-Definition test13 := Cases (left True True I) of (left x)=>(S O) | (right x)=>O end.
-Extraction test13. (* let test13 = S O *)
-
-
-(** example with more arguments that given by the type *)
-
-Definition test19 := (nat_rec [n:nat]nat->nat [n:nat]O [n:nat][f:nat->nat]f O O).
-Extraction test19.
-(* let test19 =
-  let rec f = function
-    | O -> (fun n0 -> O)
-    | S n0 -> f n0
-  in f O O
-*)
-
-
-(** casts *)
-
-Definition test20 := (True :: Type).
-Extraction test20.
-(* type test20 = __ *)
-
-
-(** Simple inductive type and recursor. *)
-
-Extraction nat.
-(* 
-type nat = 
-  | O 
-  | S of nat 
-*)
-
-Extraction sumbool_rect.
-(* 
-let sumbool_rect f f0 = function
-  |  Left -> f __
-  | Right -> f0 __
-*)
-
-(** Less simple inductive type. *)
-
-Inductive c [x:nat] : nat -> Set :=
-    refl : (c x x)                  
-  | trans : (y,z:nat)(c x y)->(le y z)->(c x z).
-Extraction c.
-(* 
-type c =
-  | Refl
-  | Trans of nat * nat * c
-*)
-
-Definition Ensemble := [U:Type]U->Prop.
-Definition Empty_set := [U:Type][x:U]False.
-Definition Add := [U:Type][A:(Ensemble U)][x:U][y:U](A y) \/ x==y.
-
-Inductive Finite [U:Type] : (Ensemble U) -> Set :=
-      Empty_is_finite: (Finite U (Empty_set U))
-   |  Union_is_finite:
-      (A: (Ensemble U)) (Finite U A) -> 
-      (x: U) ~ (A x) -> (Finite U (Add U A x)).
-Extraction Finite.
-(* 
-type 'u finite =
-  | Empty_is_finite
-  | Union_is_finite of 'u finite * 'u
-*)
-
-
-(** Mutual Inductive *)
-
-Inductive tree : Set := 
-   Node : nat -> forest -> tree
-with forest : Set :=
- | Leaf : nat -> forest
- | Cons : tree -> forest -> forest .
-
-Extraction tree.
-(* 
-type tree =
-  | Node of nat * forest
-and forest =
-  | Leaf of nat
-  | Cons of tree * forest
-*)
-
-Fixpoint tree_size [t:tree] : nat :=
-         Cases t of (Node a f) => (S (forest_size f)) end
-with forest_size [f:forest] : nat :=
-         Cases f of 
-	 | (Leaf b) => (S O)
-         | (Cons t f') => (plus (tree_size t) (forest_size f'))
-         end.
-
-Extraction tree_size.
-(* 
-let rec tree_size = function
-  | Node (a, f) -> S (forest_size f)
-and forest_size = function
-  | Leaf b -> S O
-  | Cons (t, f') -> plus (tree_size t) (forest_size f')
-*)
-
-
-(** Eta-expansions of inductive constructor *)
-
-Inductive titi : Set := tata : nat->nat->nat->nat->titi.
-Definition test14 := (tata O).
-Extraction test14.
-(* let test14 x x0 x1 = Tata (O, x, x0, x1) *)
-Definition test15 := (tata O (S O)).
-Extraction test15. 
-(* let test15 x x0 = Tata (O, (S O), x, x0) *)
-
-Inductive eta : Set := eta_c : nat->Prop->nat->Prop->eta.
-Extraction eta_c.
-(* 
-type eta =
-  | Eta_c of nat * nat
-*)
-Definition test16 := (eta_c O).
-Extraction test16.
-(* let test16 x = Eta_c (O, x) *)
-Definition test17 := (eta_c O True).
-Extraction test17.
-(* let test17 x = Eta_c (O, x) *)
-Definition test18 := (eta_c O True O).
-Extraction test18. 
-(* let test18 _ = Eta_c (O, O) *)
-
-
-(** Example of singleton inductive type *)
-
-Inductive bidon [A:Prop;B:Type] : Set := tb : (x:A)(y:B)(bidon A B). 
-Definition fbidon := [A,B:Type][f:A->B->(bidon True nat)][x:A][y:B](f x y).
-Extraction bidon.
-(* type 'b bidon = 'b *)
-Extraction tb.
-(* tb : singleton inductive constructor *)
-Extraction fbidon.
-(* let fbidon f x y =
-  f x y
-*)
-
-Definition fbidon2 := (fbidon True nat (tb True nat)).
-Extraction fbidon2. (* let fbidon2 y = y *)
-Extraction NoInline fbidon.
-Extraction fbidon2.
-(* let fbidon2 y = fbidon (fun _ x -> x) __ y *)
-
-(* NB: first argument of fbidon2 has type [True], so it disappears. *)
-
-(** mutual inductive on many sorts *)
-
-Inductive 
-  test_0 : Prop := ctest0 : test_0 
-with 
-  test_1 : Set := ctest1 : test_0-> test_1.  
-Extraction test_0.
-(* test0 : logical inductive *)
-Extraction test_1. 
-(* 
-type test1 =
-  | Ctest1
-*)
-
-(** logical singleton *)
-
-Extraction eq.
-(* eq : logical inductive *)
-Extraction eq_rect.
-(* let eq_rect x f y =
-  f
-*)
-
-(** No more propagation of type parameters. Obj.t instead. *)
-
-Inductive tp1 : Set := 
-  T : (C:Set)(c:C)tp2 -> tp1 with tp2 : Set  := T' : tp1->tp2.
-Extraction tp1.
-(* 
-type tp1 =
-  | T of __ * tp2
-and tp2 =
-  | T' of tp1
-*) 
-
-Inductive tp1bis : Set := 
-  Tbis : tp2bis -> tp1bis 
-with tp2bis : Set  := T'bis : (C:Set)(c:C)tp1bis->tp2bis.
-Extraction tp1bis.
-(* 
-type tp1bis =
-  | Tbis of tp2bis
-and tp2bis =
-  | T'bis of __ * tp1bis
-*)
-
-
-(** Strange inductive type. *)
-
-Inductive Truc : Set->Set :=
-       chose  : (A:Set)(Truc A)
-     | machin : (A:Set)A->(Truc bool)->(Truc A).
-Extraction Truc.
-(*
-type 'x truc =
-  | Chose
-  | Machin of 'x * bool truc
-*)
-
-
-(** Dependant type over Type *)
-
-Definition test24:= (sigT Set [a:Set](option a)).
-Extraction test24.
-(* type test24 = (__, __ option) sigT *)
-
-
-(** Coq term non strongly-normalizable after extraction *)
-
-Require Gt.
-Definition loop := 
- [Ax:(Acc nat gt O)]
- (Fix F {F [a:nat;b:(Acc nat gt a)] : nat := 
-          (F (S a) (Acc_inv nat gt a b (S a) (gt_Sn_n a)))}
- O Ax).
-Extraction loop.
-(* let loop _ =
-  let rec f a =
-    f (S a)
-  in f O
-*)
-
-(*** EXAMPLES NEEDING OBJ.MAGIC *)
-
-(** False conversion of type: *)
-
-Lemma oups : (H:(nat==(list nat)))nat -> nat.
-Intros.
-Generalize H0;Intros.
-Rewrite H in H1.
-Case H1.
-Exact H0.
-Intros.
-Exact n.
-Qed.
-Extraction oups.
-(* 
-let oups h0 = 
-  match Obj.magic h0 with
-    | Nil -> h0
-    | Cons0 (n, l) -> n
-*)
-
-
-(** hybrids *)
-
-Definition horibilis := [b:bool]<[b:bool]if b then Type else nat>if b then Set else O.
-Extraction horibilis.
-(* 
-let horibilis = function
-  | True -> Obj.magic __
-  | False -> Obj.magic O
-*)
-
-Definition PropSet := [b:bool]if b then Prop else Set.
-Extraction PropSet. (* type propSet = __ *)
-
-Definition natbool := [b:bool]if b then nat else bool.
-Extraction natbool. (* type natbool = __ *)
-
-Definition zerotrue := [b:bool]<natbool>if b then O else true.
-Extraction zerotrue. 
-(* 
-let zerotrue = function
-  | True -> Obj.magic O
-  | False -> Obj.magic True
-*)
-
-Definition natProp := [b:bool]<[_:bool]Type>if b then nat else Prop.
-
-Definition natTrue := [b:bool]<[_:bool]Type>if b then nat else True.
-
-Definition zeroTrue := [b:bool]<natProp>if b then O else True.
-Extraction zeroTrue.
-(* 
-let zeroTrue = function
-  | True -> Obj.magic O
-  | False -> Obj.magic __
-*)
-
-Definition natTrue2 := [b:bool]<[_:bool]Type>if b then nat else True.
-
-Definition zeroprop := [b:bool]<natTrue>if b then O else I.
-Extraction zeroprop.
-(* 
-let zeroprop = function
-  | True -> Obj.magic O
-  | False -> Obj.magic __
-*)
-
-(** polymorphic f applied several times *)
-
-Definition test21 := (id nat O, id bool true).
-Extraction test21.
-(* let test21 = Pair ((id O), (id True)) *)
-
-(** ok *)
-
-Definition test22 := ([f:(X:Type)X->X](f nat O, f bool true) [X:Type][x:X]x).
-Extraction test22. 
-(* let test22 = 
-  let f = fun x -> x in Pair ((f O), (f True)) *)
-
-(* still ok via optim beta -> let *)
-
-Definition test23 := [f:(X:Type)X->X](f nat O, f bool true).
-Extraction test23.
-(* let test23 f = Pair ((Obj.magic f __ O), (Obj.magic f __ True)) *)
-
-(* problem: fun f -> (f 0, f true) not legal in ocaml *)
-(* solution: magic ... *)
-
-
-(** Dummy constant __ can be applied.... *)
-
-Definition f : (X:Type)(nat->X)->(X->bool)->bool := 
- [X:Type;x:nat->X;y:X->bool](y (x O)).
-Extraction f.
-(* let f x y =
-  y (x O)
-*)
-
-Definition f_prop := (f (O=O) [_](refl_equal ? O) [_]true).
-Extraction NoInline f.
-Extraction f_prop.
-(* let f_prop =
-  f (Obj.magic __) (fun _ -> True)
-*)
-
-Definition f_arity := (f Set [_:nat]nat [_:Set]true).
-Extraction f_arity.
-(* let f_arity =
-  f (Obj.magic __) (fun _ -> True)
-*)
-
-Definition f_normal := (f nat [x]x [x](Cases x of O => true | _ => false end)).
-Extraction f_normal.
-(* let f_normal =
-  f (fun x -> x) (fun x -> match x with
-                             | O -> True
-                             | S n -> False)
-*)
-
-
-(* inductive with magic needed *)
-
-Inductive Boite : Set := 
-  boite : (b:bool)(if b then nat else nat*nat)->Boite. 
-Extraction Boite. 
-(*
-type boite =
-  | Boite of bool * __
-*)
-
-
-Definition boite1 := (boite true O).
-Extraction boite1.
-(* let boite1 = Boite (True, (Obj.magic O)) *)
-
-Definition boite2 := (boite false (O,O)).
-Extraction boite2.
-(* let boite2 = Boite (False, (Obj.magic (Pair (O, O)))) *)
-
-Definition test_boite := [B:Boite]<nat>Cases B of 
-  (boite true n) => n 
-| (boite false n) => (plus (fst ? ? n) (snd ? ? n))
-end.
-Extraction test_boite. 
-(* 
-let test_boite = function
-  | Boite (b0, n) ->
-      (match b0 with
-         | True -> Obj.magic n
-         | False -> plus (fst (Obj.magic n)) (snd (Obj.magic n)))
-*)
-
-(* singleton inductive with magic needed *)
-
-Inductive Box : Set := 
-  box : (A:Set)A -> Box. 
-Extraction Box.
-(* type box = __ *)
-
-Definition box1 := (box nat O). 
-Extraction box1. (* let box1 = Obj.magic O *)
-
-(* applied constant, magic needed *)
-
-Definition idzarb := [b:bool][x:(if b then nat else bool)]x.
-Definition zarb := (idzarb true O).
-Extraction NoInline idzarb. 
-Extraction zarb. 
-(* let zarb = Obj.magic idzarb True (Obj.magic O) *)
-
-(** function of variable arity. *)
-(** Fun n = nat -> nat -> ... -> nat *)  
-
-Fixpoint Fun [n:nat] : Set := 
-   Cases n of 
-     O => nat
-   | (S n) => nat -> (Fun n)
-  end.
-
-Fixpoint Const [k,n:nat] : (Fun n) := 
-  <Fun>Cases n of 
-     O => k 
-   | (S n) => [p:nat](Const k n)
-  end.
-
-Fixpoint proj [k,n:nat] : (Fun n) := 
-  <Fun>Cases n of 
-    O => O (* ou assert false ....*)
-  | (S n) => Cases k of 
-             O => [x](Const x n)
-           | (S k) => [x](proj k n)
-          end 
-  end. 
-
-Definition test_proj := (proj (2) (4) (0) (1) (2) (3)).
-
-Eval Compute in test_proj. 
-
-Recursive Extraction test_proj. 
-
-
-
-(*** TO SUM UP: ***) 
-
-
-Extraction "test_extraction.ml" 
-  idnat id id' test2 test3 test4 test5 test6 test7 
-  d d2 d3 d4 d5 d6 test8 id id' test9 test10 test11 
-  test12 test13 test19 test20 
-  nat sumbool_rect c Finite tree tree_size
-  test14 test15 eta_c test16 test17 test18 bidon tb fbidon fbidon2 
-  fbidon2 test_0 test_1 eq eq_rect tp1 tp1bis Truc oups test24 loop
-  horibilis PropSet natbool zerotrue zeroTrue zeroprop test21 test22 
-  test23 f f_prop f_arity f_normal
-  Boite boite1 boite2 test_boite
-  Box box1 zarb test_proj.
-
-
diff --git a/contrib7/field/Field.v b/contrib7/field/Field.v
deleted file mode 100644
index f282e246..00000000
--- a/contrib7/field/Field.v
+++ /dev/null
@@ -1,15 +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        *)
-(************************************************************************)
-
-(* $Id: Field.v,v 1.1.2.1 2004/07/16 19:30:17 herbelin Exp $ *)
-
-Require Export Field_Compl.
-Require Export Field_Theory.
-Require Export Field_Tactic.
-
-(* Command declarations are moved to the ML side *)
diff --git a/contrib7/field/Field_Compl.v b/contrib7/field/Field_Compl.v
deleted file mode 100644
index 2cc01038..00000000
--- a/contrib7/field/Field_Compl.v
+++ /dev/null
@@ -1,62 +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        *)
-(************************************************************************)
-
-(* $Id: Field_Compl.v,v 1.2.2.1 2004/07/16 19:30:17 herbelin Exp $ *)
-
-Inductive listT [A:Type] : Type :=
-  nilT : (listT A) | consT : A->(listT A)->(listT A).
-
-Fixpoint appT [A:Type][l:(listT A)] : (listT A) -> (listT A) :=
-  [m:(listT A)]
-  Cases l of
-  | nilT => m 
-  | (consT a l1) => (consT A a (appT A l1 m))
-  end.
-
-Inductive prodT [A,B:Type] : Type :=
-  pairT: A->B->(prodT A B).
-
-Definition assoc_2nd :=
-Fix assoc_2nd_rec
-  {assoc_2nd_rec 
-   [A:Type;B:Set;eq_dec:(e1,e2:B){e1=e2}+{~e1=e2};lst:(listT (prodT A B))]
-   : B->A->A:=
-  [key:B;default:A]
-  Cases lst of
-  | nilT => default
-  | (consT (pairT v e) l) =>
-    (Cases (eq_dec e key) of
-    | (left _) => v
-    | (right _) => (assoc_2nd_rec A B eq_dec l key default)
-    end)
-  end}.
-
-Definition fstT [A,B:Type;c:(prodT A B)] :=
-  Cases c of
-  | (pairT a _) => a
-  end.
-
-Definition sndT [A,B:Type;c:(prodT A B)] :=
-  Cases c of
-  | (pairT _ a) => a
-  end.
-
-Definition mem :=
-Fix mem {mem [A:Set;eq_dec:(e1,e2:A){e1=e2}+{~e1=e2};a:A;l:(listT A)] : bool :=
-  Cases l of
-  | nilT => false
-  | (consT a1 l1) =>
-    Cases (eq_dec a a1) of
-    | (left _) => true
-    | (right _) => (mem A eq_dec a l1)
-    end
-  end}.
-
-Inductive field_rel_option [A:Type] : Type :=
-  | Field_None : (field_rel_option A)
-  | Field_Some : (A -> A -> A) -> (field_rel_option A).
diff --git a/contrib7/field/Field_Tactic.v b/contrib7/field/Field_Tactic.v
deleted file mode 100644
index ffd2aad4..00000000
--- a/contrib7/field/Field_Tactic.v
+++ /dev/null
@@ -1,397 +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        *)
-(************************************************************************)
-
-(* $Id: Field_Tactic.v,v 1.2.2.1 2004/07/16 19:30:17 herbelin Exp $ *)
-
-Require Ring.
-Require Export Field_Compl.
-Require Export Field_Theory.
-
-(**** Interpretation A --> ExprA ****)
-
-Recursive Tactic Definition MemAssoc var lvar :=
-  Match lvar With
-  | [(nilT ?)] -> false
-  | [(consT ? ?1 ?2)] ->
-    (Match ?1=var With
-     | [?1=?1] -> true
-     | _ -> (MemAssoc var ?2)).
-
-Recursive Tactic Definition SeekVarAux FT lvar trm :=
-  Let AT     = Eval Cbv Beta Delta [A] Iota in (A FT)
-  And AzeroT = Eval Cbv Beta Delta [Azero] Iota in (Azero FT)
-  And AoneT  = Eval Cbv Beta Delta [Aone] Iota in (Aone FT)
-  And AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT)
-  And AmultT = Eval Cbv Beta Delta [Amult] Iota in (Amult FT)
-  And AoppT  = Eval Cbv Beta Delta [Aopp] Iota in (Aopp FT)
-  And AinvT  = Eval Cbv Beta Delta [Ainv] Iota in (Ainv FT) In 
-  Match trm With
-  | [(AzeroT)] -> lvar
-  | [(AoneT)] -> lvar
-  | [(AplusT ?1 ?2)] ->
-    Let l1 = (SeekVarAux FT lvar ?1) In
-    (SeekVarAux FT l1 ?2)
-  | [(AmultT ?1 ?2)] ->
-    Let l1 = (SeekVarAux FT lvar ?1) In
-    (SeekVarAux FT l1 ?2)
-  | [(AoppT ?1)] -> (SeekVarAux FT lvar ?1)
-  | [(AinvT ?1)] -> (SeekVarAux FT lvar ?1)
-  | [?1] ->
-    Let res = (MemAssoc ?1 lvar) In
-    Match res With
-    | [(true)] -> lvar
-    | [(false)] -> '(consT AT ?1 lvar).
-
-Tactic Definition SeekVar FT trm :=
-  Let AT = Eval Cbv Beta Delta [A] Iota in (A FT) In
-  (SeekVarAux FT '(nilT AT) trm).
-
-Recursive Tactic Definition NumberAux lvar cpt :=
-  Match lvar With
-  | [(nilT ?1)] -> '(nilT (prodT ?1 nat))
-  | [(consT ?1 ?2 ?3)] ->
-    Let l2 = (NumberAux ?3 '(S cpt)) In
-    '(consT (prodT ?1 nat) (pairT ?1 nat ?2 cpt) l2).
-
-Tactic Definition Number lvar := (NumberAux lvar O).
-
-Tactic Definition BuildVarList FT trm :=
-  Let lvar = (SeekVar FT trm) In
-  (Number lvar).
-V7only [
-(*Used by contrib Maple *)
-Tactic Definition build_var_list := BuildVarList.
-].
-
-Recursive Tactic Definition Assoc elt lst :=
-  Match lst With
-  | [(nilT ?)] -> Fail
-  | [(consT (prodT ? nat) (pairT ? nat ?1 ?2) ?3)] ->
-    Match elt= ?1 With
-    | [?1= ?1] -> ?2
-    | _ -> (Assoc elt ?3).
-
-Recursive Meta Definition interp_A FT lvar trm :=
-  Let AT     = Eval Cbv Beta Delta [A] Iota in (A FT)
-  And AzeroT = Eval Cbv Beta Delta [Azero] Iota in (Azero FT)
-  And AoneT  = Eval Cbv Beta Delta [Aone] Iota in (Aone FT)
-  And AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT)
-  And AmultT = Eval Cbv Beta Delta [Amult] Iota in (Amult FT)
-  And AoppT  = Eval Cbv Beta Delta [Aopp] Iota in (Aopp FT)
-  And AinvT  = Eval Cbv Beta Delta [Ainv] Iota in (Ainv FT) In
-  Match trm With
-  | [(AzeroT)] -> EAzero
-  | [(AoneT)] -> EAone
-  | [(AplusT ?1 ?2)] ->
-    Let e1 = (interp_A FT lvar ?1)
-    And e2 = (interp_A FT lvar ?2) In
-    '(EAplus e1 e2)
-  | [(AmultT ?1 ?2)] ->
-    Let e1 = (interp_A FT lvar ?1)
-    And e2 = (interp_A FT lvar ?2) In
-    '(EAmult e1 e2)
-  | [(AoppT ?1)] ->
-    Let e = (interp_A FT lvar ?1) In
-    '(EAopp e)
-  | [(AinvT ?1)] ->
-    Let e = (interp_A FT lvar ?1) In
-    '(EAinv e)
-  | [?1] ->
-    Let idx = (Assoc ?1 lvar) In
-    '(EAvar idx).
-
-(************************)
-(*    Simplification    *)
-(************************)
-
-(**** Generation of the multiplier ****)
-
-Recursive Tactic Definition Remove e l :=
-  Match l With
-  | [(nilT ?)] -> l
-  | [(consT ?1 e ?2)] -> ?2
-  | [(consT ?1 ?2 ?3)] ->
-    Let nl = (Remove e ?3) In
-    '(consT ?1 ?2 nl).
-
-Recursive Tactic Definition Union l1 l2 :=
-  Match l1 With
-  | [(nilT ?)] -> l2
-  | [(consT ?1 ?2 ?3)] ->
-    Let nl2 = (Remove ?2 l2) In
-    Let nl = (Union ?3 nl2) In
-    '(consT ?1 ?2 nl).
-
-Recursive Tactic Definition RawGiveMult trm :=
-  Match trm With
-  | [(EAinv ?1)] -> '(consT ExprA ?1 (nilT ExprA))
-  | [(EAopp ?1)] -> (RawGiveMult ?1)
-  | [(EAplus ?1 ?2)] ->
-    Let l1 = (RawGiveMult ?1)
-    And l2 = (RawGiveMult ?2) In
-    (Union l1 l2)
-  | [(EAmult ?1 ?2)] ->
-    Let l1 = (RawGiveMult ?1)
-    And l2 = (RawGiveMult ?2) In
-    Eval Compute in (appT ExprA l1 l2)
-  | _ -> '(nilT ExprA).
-
-Tactic Definition GiveMult trm :=
-  Let ltrm = (RawGiveMult trm) In
-  '(mult_of_list ltrm).
-
-(**** Associativity ****)
-
-Tactic Definition ApplyAssoc FT lvar trm :=
-  Let t=Eval Compute in (assoc trm) In
-  Match t=trm With
-  | [ ?1=?1 ] -> Idtac
-  | _ -> Rewrite <- (assoc_correct FT trm); Change (assoc trm) with t.
-
-(**** Distribution *****)
-
-Tactic Definition ApplyDistrib FT lvar trm :=
-  Let t=Eval Compute in (distrib trm) In
-  Match t=trm With
-  | [ ?1=?1 ] -> Idtac
-  | _ -> Rewrite <- (distrib_correct FT trm); Change (distrib trm) with t.
-
-(**** Multiplication by the inverse product ****)
-
-Tactic Definition GrepMult :=
-  Match Context With
-    | [ id: ~(interp_ExprA ? ? ?)= ? |- ?] -> id.
-
-Tactic Definition WeakReduce :=
-  Match Context With
-  | [|-[(interp_ExprA ?1 ?2 ?)]] ->
-    Cbv Beta Delta [interp_ExprA assoc_2nd eq_nat_dec mult_of_list ?1 ?2 A
-                    Azero Aone Aplus Amult Aopp Ainv] Zeta Iota.
-
-Tactic Definition Multiply mul :=
-  Match Context With
-  | [|-(interp_ExprA ?1 ?2 ?3)=(interp_ExprA ?1 ?2 ?4)] ->
-    Let AzeroT = Eval Cbv Beta Delta [Azero ?1] Iota in (Azero ?1) In
-    Cut ~(interp_ExprA ?1 ?2 mul)=AzeroT;
-    [Intro;
-     Let id = GrepMult In
-     Apply (mult_eq ?1 ?3 ?4 mul ?2 id)
-    |WeakReduce;
-     Let AoneT  = Eval Cbv Beta Delta [Aone ?1] Iota in (Aone ?1)
-     And AmultT = Eval Cbv Beta Delta [Amult ?1] Iota in (Amult ?1) In
-     Try (Match Context With
-          | [|-[(AmultT ? AoneT)]] -> Rewrite (AmultT_1r ?1));Clear ?1 ?2].
-
-Tactic Definition ApplyMultiply FT lvar trm :=
-  Let t=Eval Compute in (multiply trm) In
-  Match t=trm With
-  | [ ?1=?1 ] -> Idtac
-  | _ -> Rewrite <- (multiply_correct FT trm); Change (multiply trm) with t.
-
-(**** Permutations and simplification ****)
-
-Tactic Definition ApplyInverse mul FT lvar trm :=
-  Let t=Eval Compute in (inverse_simplif mul trm) In
-  Match t=trm With
-  | [ ?1=?1 ] -> Idtac
-  | _ -> Rewrite <- (inverse_correct FT trm mul);
-         [Change (inverse_simplif mul trm) with t|Assumption].
-(**** Inverse test ****)
-
-Tactic Definition StrongFail tac := First [tac|Fail 2].
-
-Recursive Tactic Definition InverseTestAux FT trm :=
-  Let AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT)
-  And AmultT = Eval Cbv Beta Delta [Amult] Iota in (Amult FT)
-  And AoppT  = Eval Cbv Beta Delta [Aopp] Iota in (Aopp FT)
-  And AinvT  = Eval Cbv Beta Delta [Ainv] Iota in (Ainv FT) In
-  Match trm With
-  | [(AinvT ?)] -> Fail 1
-  | [(AoppT ?1)] -> StrongFail ((InverseTestAux FT ?1);Idtac)
-  | [(AplusT ?1 ?2)] ->
-    StrongFail ((InverseTestAux FT ?1);(InverseTestAux FT ?2))
-  | [(AmultT ?1 ?2)] ->
-    StrongFail ((InverseTestAux FT ?1);(InverseTestAux FT ?2))
-  | _ -> Idtac.
-
-Tactic Definition InverseTest FT :=
-  Let AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT) In
-  Match Context With
-  | [|- ?1=?2] -> (InverseTestAux FT '(AplusT ?1 ?2)).
-
-(**** Field itself ****)
-
-Tactic Definition ApplySimplif sfun :=
-  (Match Context With
-   | [|- (interp_ExprA ?1 ?2 ?3)=(interp_ExprA ? ? ?)] ->
-     (sfun ?1 ?2 ?3));
-  (Match Context With
-   | [|- (interp_ExprA ? ? ?)=(interp_ExprA ?1 ?2 ?3)] ->
-     (sfun ?1 ?2 ?3)).
-
-Tactic Definition Unfolds FT :=
-  (Match Eval Cbv Beta Delta [Aminus] Iota in (Aminus FT) With
-   | [(Field_Some ? ?1)] -> Unfold ?1
-   | _ -> Idtac);
-  (Match Eval Cbv Beta Delta [Adiv] Iota in (Adiv FT) With
-   | [(Field_Some ? ?1)] -> Unfold ?1
-   | _ -> Idtac).
-
-Tactic Definition Reduce FT :=
-  Let AzeroT = Eval Cbv Beta Delta [Azero] Iota in (Azero FT)
-  And AoneT  = Eval Cbv Beta Delta [Aone] Iota in (Aone FT)
-  And AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT)
-  And AmultT = Eval Cbv Beta Delta [Amult] Iota in (Amult FT)
-  And AoppT  = Eval Cbv Beta Delta [Aopp] Iota in (Aopp FT)
-  And AinvT  = Eval Cbv Beta Delta [Ainv] Iota in (Ainv FT) In
-  Cbv Beta Delta -[AzeroT AoneT AplusT AmultT AoppT AinvT] Zeta Iota
-  Orelse Compute.
-
-Recursive Tactic Definition Field_Gen_Aux FT :=
-  Let AplusT = Eval Cbv Beta Delta [Aplus] Iota in (Aplus FT) In
-  Match Context With
-  | [|- ?1=?2] ->
-    Let lvar = (BuildVarList FT '(AplusT ?1 ?2)) In
-    Let trm1 = (interp_A FT lvar ?1)
-    And trm2 = (interp_A FT lvar ?2) In
-    Let mul = (GiveMult '(EAplus trm1 trm2)) In
-    Cut [ft:=FT][vm:=lvar](interp_ExprA ft vm trm1)=(interp_ExprA ft vm trm2);
-    [Compute;Auto
-    |Intros ft vm;(ApplySimplif ApplyDistrib);(ApplySimplif ApplyAssoc);
-     (Multiply mul);[(ApplySimplif ApplyMultiply);
-       (ApplySimplif (ApplyInverse mul));
-       (Let id = GrepMult In Clear id);WeakReduce;Clear ft vm;
-       First [(InverseTest FT);Ring|(Field_Gen_Aux FT)]|Idtac]].
-
-Tactic Definition Field_Gen FT :=
-  Unfolds FT;((InverseTest FT);Ring) Orelse (Field_Gen_Aux FT).
-V7only [Tactic Definition field_gen := Field_Gen.].
-
-(*****************************)
-(*    Term Simplification    *)
-(*****************************)
-
-(**** Minus and division expansions ****)
-
-Meta Definition InitExp FT trm :=
-  Let e =
-    (Match Eval Cbv Beta Delta [Aminus] Iota in (Aminus FT) With
-     | [(Field_Some ? ?1)] -> Eval Cbv Beta Delta [?1] in trm
-     | _ -> trm) In
-  Match Eval Cbv Beta Delta [Adiv] Iota in (Adiv FT) With
-  | [(Field_Some ? ?1)] -> Eval Cbv Beta Delta [?1] in e
-  | _ -> e.
-V7only [
-(*Used by contrib Maple *)
-Tactic Definition init_exp := InitExp.
-].
-
-(**** Inverses simplification ****)
-
-Recursive Meta Definition SimplInv trm:=
-  Match trm With
-  | [(EAplus ?1 ?2)] ->
-    Let e1 = (SimplInv ?1)
-    And e2 = (SimplInv ?2) In
-    '(EAplus e1 e2)
-  | [(EAmult ?1 ?2)] ->
-    Let e1 = (SimplInv ?1)
-    And e2 = (SimplInv ?2) In
-    '(EAmult e1 e2)
-  | [(EAopp ?1)] -> Let e = (SimplInv ?1) In '(EAopp e)
-  | [(EAinv ?1)] -> (SimplInvAux ?1)
-  | [?1] -> ?1
-And SimplInvAux trm :=
-  Match trm With
-  | [(EAinv ?1)] -> (SimplInv ?1)
-  | [(EAmult ?1 ?2)] ->
-    Let e1 = (SimplInv '(EAinv ?1))
-    And e2 = (SimplInv '(EAinv ?2)) In
-    '(EAmult e1 e2)
-  | [?1] -> Let e = (SimplInv ?1) In '(EAinv e).
-
-(**** Monom simplification ****)
-
-Recursive Meta Definition Map fcn lst :=
-  Match lst With
-  | [(nilT ?)] -> lst
-  | [(consT ?1 ?2 ?3)] ->
-    Let r = (fcn ?2)
-    And t = (Map fcn ?3) In
-    '(consT ?1 r t).
-
-Recursive Meta Definition BuildMonomAux lst trm :=
-  Match lst With
-  | [(nilT ?)] -> Eval Compute in (assoc trm)
-  | [(consT ? ?1 ?2)] -> BuildMonomAux ?2 '(EAmult trm ?1).
-
-Recursive Meta Definition BuildMonom lnum lden :=
-  Let ildn = (Map (Fun e -> '(EAinv e)) lden) In
-  Let ltot = Eval Compute in (appT ExprA lnum ildn) In
-  Let trm = (BuildMonomAux ltot EAone) In
-  Match trm With
-  | [(EAmult ? ?1)] -> ?1
-  | [?1] -> ?1.
-
-Recursive Meta Definition SimplMonomAux lnum lden trm :=
-  Match trm With
-  | [(EAmult (EAinv ?1) ?2)] ->
-    Let mma = (MemAssoc ?1 lnum) In
-    (Match mma With
-     | [true] ->
-       Let newlnum = (Remove ?1 lnum) In SimplMonomAux newlnum lden ?2
-     | [false] -> SimplMonomAux lnum '(consT ExprA ?1 lden) ?2)
-  | [(EAmult ?1 ?2)] ->
-    Let mma = (MemAssoc ?1 lden) In
-    (Match mma With
-     | [true] ->
-       Let newlden = (Remove ?1 lden) In SimplMonomAux lnum newlden ?2
-     | [false] -> SimplMonomAux '(consT ExprA ?1 lnum) lden ?2)
-  | [(EAinv ?1)] ->
-    Let mma = (MemAssoc ?1 lnum) In
-    (Match mma With
-     | [true] ->
-       Let newlnum = (Remove ?1 lnum) In BuildMonom newlnum lden
-     | [false] -> BuildMonom lnum '(consT ExprA ?1 lden))
-  | [?1] ->
-    Let mma = (MemAssoc ?1 lden) In
-    (Match mma With
-     | [true] ->
-       Let newlden = (Remove ?1 lden) In BuildMonom lnum newlden
-     | [false] -> BuildMonom '(consT ExprA ?1 lnum) lden).
-
-Meta Definition SimplMonom trm :=
-  SimplMonomAux '(nilT ExprA) '(nilT ExprA) trm.
-
-Recursive Meta Definition SimplAllMonoms trm :=
-  Match trm With
-  | [(EAplus ?1 ?2)] ->
-    Let e1 = (SimplMonom ?1)
-    And e2 = (SimplAllMonoms ?2) In
-    '(EAplus e1 e2)
-  | [?1] -> SimplMonom ?1.
-
-(**** Associativity and distribution ****)
-
-Meta Definition AssocDistrib trm := Eval Compute in (assoc (distrib trm)).
-
-(**** The tactic Field_Term ****)
-
-Tactic Definition EvalWeakReduce trm :=
-  Eval Cbv Beta Delta [interp_ExprA assoc_2nd eq_nat_dec mult_of_list A Azero
-                       Aone Aplus Amult Aopp Ainv] Zeta Iota in trm.
-
-Tactic Definition Field_Term FT exp :=
-  Let newexp = (InitExp FT exp) In
-  Let lvar = (BuildVarList FT newexp) In
-  Let trm = (interp_A FT lvar newexp) In
-  Let tma = Eval Compute in (assoc trm) In
-  Let tsmp = (SimplAllMonoms (AssocDistrib (SimplAllMonoms
-                (SimplInv tma)))) In
-  Let trep = (EvalWeakReduce '(interp_ExprA FT lvar tsmp)) In
-  Replace exp with trep;[Ring trep|Field_Gen FT].
diff --git a/contrib7/field/Field_Theory.v b/contrib7/field/Field_Theory.v
deleted file mode 100644
index 3ba2fbc0..00000000
--- a/contrib7/field/Field_Theory.v
+++ /dev/null
@@ -1,612 +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        *)
-(************************************************************************)
-
-(* $Id: Field_Theory.v,v 1.2.2.1 2004/07/16 19:30:17 herbelin Exp $ *)
-
-Require Peano_dec.
-Require Ring.
-Require Field_Compl.
-
-Record Field_Theory : Type :=
-{ A : Type;
-  Aplus : A -> A -> A;
-  Amult : A -> A -> A;
-  Aone : A;
-  Azero : A;
-  Aopp : A -> A;
-  Aeq : A -> A -> bool;
-  Ainv : A -> A;
-  Aminus : (field_rel_option A);
-  Adiv : (field_rel_option A);
-  RT : (Ring_Theory Aplus Amult Aone Azero Aopp Aeq);
-  Th_inv_def : (n:A)~(n=Azero)->(Amult (Ainv n) n)=Aone
-}.
-
-(* The reflexion structure *)
-Inductive ExprA : Set :=
-| EAzero    : ExprA
-| EAone    : ExprA
-| EAplus : ExprA -> ExprA -> ExprA
-| EAmult : ExprA -> ExprA -> ExprA
-| EAopp  : ExprA -> ExprA
-| EAinv  : ExprA -> ExprA
-| EAvar  : nat -> ExprA.
-
-(**** Decidability of equality ****)
-
-Lemma eqExprA_O:(e1,e2:ExprA){e1=e2}+{~e1=e2}.
-Proof.
-  Double Induction e1 e2;Try Intros;
-   Try (Left;Reflexivity) Orelse Try (Right;Discriminate).
-  Elim (H1 e0);Intro y;Elim (H2 e);Intro y0;
-    Try (Left; Rewrite y; Rewrite y0;Auto)
-    Orelse (Right;Red;Intro;Inversion H3;Auto).
-  Elim (H1 e0);Intro y;Elim (H2 e);Intro y0;
-    Try (Left; Rewrite y; Rewrite y0;Auto)
-    Orelse (Right;Red;Intro;Inversion H3;Auto).
-  Elim (H0 e);Intro y.
-  Left; Rewrite y; Auto.
-  Right;Red; Intro;Inversion H1;Auto.
-  Elim (H0 e);Intro y.
-  Left; Rewrite y; Auto.
-  Right;Red; Intro;Inversion H1;Auto.
-  Elim (eq_nat_dec n n0);Intro y.
-  Left; Rewrite y; Auto.
-  Right;Red;Intro;Inversion H;Auto. 
-Defined.
-
-Definition eq_nat_dec := Eval Compute in Peano_dec.eq_nat_dec.
-Definition eqExprA := Eval Compute in eqExprA_O.
-
-(**** Generation of the multiplier ****)
-
-Fixpoint mult_of_list [e:(listT ExprA)]: ExprA :=
-  Cases e of
-  | nilT => EAone
-  | (consT e1 l1) => (EAmult e1 (mult_of_list l1))
-  end.
-
-Section Theory_of_fields.
-
-Variable T : Field_Theory.
-
-Local AT := (A T).
-Local AplusT := (Aplus T).
-Local AmultT := (Amult T).
-Local AoneT := (Aone T).
-Local AzeroT := (Azero T).
-Local AoppT := (Aopp T).
-Local AeqT := (Aeq T).
-Local AinvT := (Ainv T).
-Local RTT := (RT T).
-Local Th_inv_defT := (Th_inv_def T).
-
-Add 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.
-
-(***************************)
-(*    Lemmas to be used    *)
-(***************************)
-
-Lemma AplusT_sym:(r1,r2:AT)(AplusT r1 r2)=(AplusT r2 r1).
-Proof.
-  Intros;Ring.
-Save.
-
-Lemma AplusT_assoc:(r1,r2,r3:AT)(AplusT (AplusT r1 r2) r3)=
-                                (AplusT r1 (AplusT r2 r3)).
-Proof.
-  Intros;Ring.
-Save.
-
-Lemma AmultT_sym:(r1,r2:AT)(AmultT r1 r2)=(AmultT r2 r1).
-Proof.
-  Intros;Ring.
-Save.
-
-Lemma AmultT_assoc:(r1,r2,r3:AT)(AmultT (AmultT r1 r2) r3)=
-                                (AmultT r1 (AmultT r2 r3)).
-Proof.
-  Intros;Ring.
-Save.
-
-Lemma AplusT_Ol:(r:AT)(AplusT AzeroT r)=r.
-Proof.
-  Intros;Ring.
-Save.
-
-Lemma AmultT_1l:(r:AT)(AmultT AoneT r)=r.
-Proof.
-  Intros;Ring.
-Save.
-
-Lemma AplusT_AoppT_r:(r:AT)(AplusT r (AoppT r))=AzeroT.
-Proof.
-  Intros;Ring.
-Save.
-
-Lemma AmultT_AplusT_distr:(r1,r2,r3:AT)(AmultT r1 (AplusT r2 r3))=
-                        (AplusT (AmultT r1 r2) (AmultT r1 r3)).
-Proof.
-  Intros;Ring.
-Save.
-
-Lemma r_AplusT_plus:(r,r1,r2:AT)(AplusT r r1)=(AplusT r r2)->r1=r2.
-Proof.
-  Intros; Transitivity (AplusT (AplusT (AoppT r) r) r1).
-  Ring.
-  Transitivity (AplusT (AplusT (AoppT r) r) r2).
-  Repeat Rewrite -> AplusT_assoc; Rewrite <- H; Reflexivity.
-  Ring.
-Save.
- 
-Lemma r_AmultT_mult:
-  (r,r1,r2:AT)(AmultT r r1)=(AmultT r r2)->~r=AzeroT->r1=r2.
-Proof.
-  Intros; Transitivity (AmultT (AmultT (AinvT r) r) r1).
-  Rewrite Th_inv_defT;[Symmetry; Apply AmultT_1l;Auto|Auto].
-  Transitivity (AmultT (AmultT (AinvT r) r) r2).
-  Repeat Rewrite AmultT_assoc; Rewrite H; Trivial.
-  Rewrite Th_inv_defT;[Apply AmultT_1l;Auto|Auto].
-Save.
-
-Lemma AmultT_Or:(r:AT) (AmultT r AzeroT)=AzeroT.
-Proof.
-  Intro; Ring.
-Save.
- 
-Lemma AmultT_Ol:(r:AT)(AmultT AzeroT r)=AzeroT.
-Proof.
-  Intro; Ring.
-Save.
- 
-Lemma AmultT_1r:(r:AT)(AmultT r AoneT)=r.
-Proof.
-  Intro; Ring.
-Save.
- 
-Lemma AinvT_r:(r:AT)~r=AzeroT->(AmultT r (AinvT r))=AoneT.
-Proof.
-  Intros; Rewrite -> AmultT_sym; Apply Th_inv_defT; Auto.
-Save.
- 
-Lemma without_div_O_contr:
-  (r1,r2:AT)~(AmultT r1 r2)=AzeroT ->~r1=AzeroT/\~r2=AzeroT.
-Proof.
-  Intros r1 r2 H; Split; Red; Intro; Apply H; Rewrite H0; Ring.
-Save.
-
-(************************)
-(*    Interpretation    *)
-(************************)
-
-(**** ExprA --> A ****)
-
-Fixpoint interp_ExprA [lvar:(listT (prodT AT nat));e:ExprA] : AT :=
-  Cases e of
-  | EAzero         => AzeroT
-  | EAone          => AoneT
-  | (EAplus e1 e2) => (AplusT (interp_ExprA lvar e1) (interp_ExprA lvar e2))
-  | (EAmult e1 e2) => (AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2))
-  | (EAopp e)      => ((Aopp T) (interp_ExprA lvar e))
-  | (EAinv e)      => ((Ainv T) (interp_ExprA lvar e))
-  | (EAvar n)      => (assoc_2nd AT nat eq_nat_dec lvar n AzeroT)
-  end.
-
-(************************)
-(*    Simplification    *)
-(************************)
-
-(**** Associativity ****)
-
-Definition merge_mult :=
-  Fix merge_mult {merge_mult [e1:ExprA] : ExprA -> ExprA :=
-  [e2:ExprA]Cases e1 of
-  | (EAmult t1 t2) =>
-    Cases t2 of
-    | (EAmult t2 t3) => (EAmult t1 (EAmult t2 (merge_mult t3 e2)))
-    | _ => (EAmult t1 (EAmult t2 e2))
-    end
-  | _ => (EAmult e1 e2)
-  end}.
-
-Fixpoint assoc_mult [e:ExprA] : ExprA :=
-  Cases e of
-  | (EAmult e1 e3) =>
-    Cases e1 of
-    | (EAmult e1 e2) =>
-      (merge_mult (merge_mult (assoc_mult e1) (assoc_mult e2))
-        (assoc_mult e3))
-    | _ => (EAmult e1 (assoc_mult e3))
-    end
-  | _ => e
-  end.
-
-Definition merge_plus :=
-  Fix merge_plus {merge_plus [e1:ExprA]:ExprA->ExprA:=
-  [e2:ExprA]Cases e1 of
-  | (EAplus t1 t2) =>
-    Cases t2 of
-    | (EAplus t2 t3) => (EAplus t1 (EAplus t2 (merge_plus t3 e2)))
-    | _ => (EAplus t1 (EAplus t2 e2))
-    end
-  | _ => (EAplus e1 e2)
-  end}.
-
-Fixpoint assoc [e:ExprA] : ExprA :=
-  Cases e of
-  | (EAplus e1 e3) =>
-    Cases e1 of
-    | (EAplus e1 e2) =>
-      (merge_plus (merge_plus (assoc e1) (assoc e2)) (assoc e3))
-    | _ => (EAplus (assoc_mult e1) (assoc e3))
-    end
-  | _ => (assoc_mult e)
-  end.
-
-Lemma merge_mult_correct1:
-  (e1,e2,e3:ExprA)(lvar:(listT (prodT AT nat)))
-  (interp_ExprA lvar (merge_mult (EAmult e1 e2) e3))=
-  (interp_ExprA lvar (EAmult e1 (merge_mult e2 e3))).
-Proof.
-Intros e1 e2;Generalize e1;Generalize e2;Clear e1 e2.
-Induction e2;Auto;Intros.
-Unfold 1 merge_mult;Fold merge_mult;
- Unfold 2 interp_ExprA;Fold interp_ExprA;
- Rewrite (H0 e e3 lvar);
- Unfold 1 interp_ExprA;Fold interp_ExprA;
- Unfold 5 interp_ExprA;Fold interp_ExprA;Auto.
-Save.
-
-Lemma merge_mult_correct:
-  (e1,e2:ExprA)(lvar:(listT (prodT AT nat)))
-    (interp_ExprA lvar (merge_mult e1 e2))=
-    (interp_ExprA lvar (EAmult e1 e2)).
-Proof.
-Induction e1;Auto;Intros.
-Elim e0;Try (Intros;Simpl;Ring).
-Unfold interp_ExprA in H2;Fold interp_ExprA in H2;
- Cut (AmultT (interp_ExprA lvar e2) (AmultT (interp_ExprA lvar e4) 
-       (AmultT (interp_ExprA lvar e) (interp_ExprA lvar e3))))=
-       (AmultT (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;Ring.
-Ring.
-Save.
-
-Lemma assoc_mult_correct1:(e1,e2:ExprA)(lvar:(listT (prodT AT nat)))
-  (AmultT (interp_ExprA lvar (assoc_mult e1)) 
-         (interp_ExprA lvar (assoc_mult e2)))=
-  (interp_ExprA lvar (assoc_mult (EAmult e1 e2))).
-Proof.
-Induction e1;Auto;Intros.
-Rewrite <-(H e0 lvar);Simpl;Rewrite merge_mult_correct;Simpl;
- Rewrite merge_mult_correct;Simpl;Auto.
-Save.
-
-Lemma assoc_mult_correct:
-  (e:ExprA)(lvar:(listT (prodT AT nat)))
-    (interp_ExprA lvar (assoc_mult e))=(interp_ExprA lvar e).
-Proof.
-Induction e;Auto;Intros.
-Elim e0;Intros.
-Intros;Simpl;Ring.
-Simpl;Rewrite (AmultT_1l (interp_ExprA lvar (assoc_mult e1)));
- Rewrite (AmultT_1l (interp_ExprA lvar e1)); Apply H0.
-Simpl;Rewrite (H0 lvar);Auto.
-Simpl;Rewrite merge_mult_correct;Simpl;Rewrite merge_mult_correct;Simpl;
- Rewrite AmultT_assoc;Rewrite assoc_mult_correct1;Rewrite H2;Simpl;
- Rewrite <-assoc_mult_correct1 in H1;
- Unfold 3 interp_ExprA 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_assoc;Rewrite H1;Rewrite AmultT_assoc;Ring.
-Simpl;Rewrite (H0 lvar);Auto.
-Simpl;Rewrite (H0 lvar);Auto.
-Simpl;Rewrite (H0 lvar);Auto.
-Save.
-
-Lemma merge_plus_correct1:
-  (e1,e2,e3:ExprA)(lvar:(listT (prodT AT nat)))
-  (interp_ExprA lvar (merge_plus (EAplus e1 e2) e3))=
-  (interp_ExprA lvar (EAplus e1 (merge_plus e2 e3))).
-Proof.
-Intros e1 e2;Generalize e1;Generalize e2;Clear e1 e2.
-Induction e2;Auto;Intros.
-Unfold 1 merge_plus;Fold merge_plus;
- Unfold 2 interp_ExprA;Fold interp_ExprA;
- Rewrite (H0 e e3 lvar);
- Unfold 1 interp_ExprA;Fold interp_ExprA;
- Unfold 5 interp_ExprA;Fold interp_ExprA;Auto.
-Save.
-
-Lemma merge_plus_correct:
-  (e1,e2:ExprA)(lvar:(listT (prodT AT nat)))
-    (interp_ExprA lvar (merge_plus e1 e2))=
-    (interp_ExprA lvar (EAplus e1 e2)).
-Proof.
-Induction e1;Auto;Intros.
-Elim e0;Try Intros;Try (Simpl;Ring).
-Unfold interp_ExprA in H2;Fold interp_ExprA in H2;
-  Cut (AplusT (interp_ExprA lvar e2) (AplusT (interp_ExprA lvar e4) 
-        (AplusT (interp_ExprA lvar e) (interp_ExprA lvar e3))))=
-        (AplusT (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;Ring.
-Ring.
-Save.
-
-Lemma assoc_plus_correct:(e1,e2:ExprA)(lvar:(listT (prodT AT nat)))
-  (AplusT (interp_ExprA lvar (assoc e1)) (interp_ExprA lvar (assoc e2)))=
-  (interp_ExprA lvar (assoc (EAplus e1 e2))).
-Proof.
-Induction e1;Auto;Intros.
-Rewrite <-(H e0 lvar);Simpl;Rewrite merge_plus_correct;Simpl;
- Rewrite merge_plus_correct;Simpl;Auto.
-Save.
-
-Lemma assoc_correct:
-  (e:ExprA)(lvar:(listT (prodT AT nat)))
-    (interp_ExprA lvar (assoc e))=(interp_ExprA lvar e).
-Proof.
-Induction e;Auto;Intros.
-Elim e0;Intros.
-Simpl;Rewrite (H0 lvar);Auto.
-Simpl;Rewrite (H0 lvar);Auto.
-Simpl;Rewrite merge_plus_correct;Simpl;Rewrite merge_plus_correct;
- Simpl;Rewrite AplusT_assoc;Rewrite assoc_plus_correct;Rewrite H2;
- Simpl;Apply (r_AplusT_plus (interp_ExprA lvar (assoc e1))
-   (AplusT (interp_ExprA lvar (assoc e2))
-     (AplusT (interp_ExprA lvar e3) (interp_ExprA lvar e1)))
-   (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)));
- Rewrite assoc_plus_correct;Rewrite H1;Simpl;Rewrite (H0 lvar);
- Rewrite <-(AplusT_assoc (AplusT (interp_ExprA lvar e2) 
-            (interp_ExprA lvar e1))
- (interp_ExprA lvar e3) (interp_ExprA lvar e1));
- 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_assoc (interp_ExprA lvar e2) (interp_ExprA lvar e3)
-                        (interp_ExprA lvar e1));Apply AplusT_sym.
-Unfold assoc;Fold assoc;Unfold interp_ExprA;Fold interp_ExprA;
- Rewrite assoc_mult_correct;Rewrite (H0 lvar);Simpl;Auto.
-Simpl;Rewrite (H0 lvar);Auto.
-Simpl;Rewrite (H0 lvar);Auto.
-Simpl;Rewrite (H0 lvar);Auto.
-Unfold assoc;Fold assoc;Unfold interp_ExprA;Fold interp_ExprA;
- Rewrite assoc_mult_correct;Simpl;Auto.
-Save.
-
-(**** Distribution *****)
-
-Fixpoint distrib_EAopp [e:ExprA] : ExprA :=
-  Cases e of
-  | (EAplus e1 e2) => (EAplus (distrib_EAopp e1) (distrib_EAopp e2))
-  | (EAmult e1 e2) => (EAmult (distrib_EAopp e1) (distrib_EAopp e2))
-  | (EAopp e) => (EAmult (EAopp EAone) (distrib_EAopp e))
-  | e => e
-  end.
-
-Definition distrib_mult_right :=
-  Fix distrib_mult_right {distrib_mult_right [e1:ExprA]:ExprA->ExprA:=
-  [e2:ExprA]Cases e1 of
-  | (EAplus t1 t2) =>
-    (EAplus (distrib_mult_right t1 e2) (distrib_mult_right t2 e2))
-  | _ => (EAmult e1 e2)
-  end}.
-
-Fixpoint distrib_mult_left [e1:ExprA] : ExprA->ExprA :=
-  [e2:ExprA]
-  Cases e1 of
-  | (EAplus t1 t2) =>
-    (EAplus (distrib_mult_left t1 e2) (distrib_mult_left t2 e2))
-  | _ => (distrib_mult_right e2 e1)
-  end.
-
-Fixpoint distrib_main [e:ExprA] : ExprA :=
-  Cases e of
-  | (EAmult e1 e2) => (distrib_mult_left (distrib_main e1) (distrib_main e2))
-  | (EAplus e1 e2) => (EAplus (distrib_main e1) (distrib_main e2))
-  | (EAopp e) => (EAopp (distrib_main e))
-  | _ => e
-  end.
-
-Definition distrib [e:ExprA] : ExprA := (distrib_main (distrib_EAopp e)).
-
-Lemma distrib_mult_right_correct:
-  (e1,e2:ExprA)(lvar:(listT (prodT AT nat)))
-     (interp_ExprA lvar (distrib_mult_right e1 e2))=
-     (AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2)).
-Proof.
-Induction e1;Try Intros;Simpl;Auto.
-Rewrite AmultT_sym;Rewrite AmultT_AplusT_distr;
- Rewrite (H e2 lvar);Rewrite (H0 e2 lvar);Ring.
-Save.
-
-Lemma distrib_mult_left_correct:
-  (e1,e2:ExprA)(lvar:(listT (prodT AT nat)))
-     (interp_ExprA lvar (distrib_mult_left e1 e2))=
-     (AmultT (interp_ExprA lvar e1)  (interp_ExprA lvar e2)).
-Proof.
-Induction e1;Try Intros;Simpl.
-Rewrite AmultT_Ol;Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_Or.
-Rewrite distrib_mult_right_correct;Simpl;
- Apply AmultT_sym. 
-Rewrite AmultT_sym;
- 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 (H e2 lvar);Rewrite (H0 e2 lvar);Auto.
-Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_sym.
-Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_sym.
-Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_sym.
-Rewrite distrib_mult_right_correct;Simpl;Apply AmultT_sym.
-Save.
-
-Lemma distrib_correct:
-  (e:ExprA)(lvar:(listT (prodT AT nat)))
-    (interp_ExprA lvar (distrib e))=(interp_ExprA lvar e).
-Proof.
-Induction e;Intros;Auto.
-Simpl;Rewrite <- (H lvar);Rewrite <- (H0 lvar); Unfold distrib;Simpl;Auto.
-Simpl;Rewrite <- (H lvar);Rewrite <- (H0 lvar); Unfold distrib;Simpl;
- Apply distrib_mult_left_correct.
-Simpl;Fold AoppT;Rewrite <- (H lvar);Unfold distrib;Simpl; 
- Rewrite distrib_mult_right_correct;
- Simpl;Fold AoppT;Ring.
-Save.
-
-(**** Multiplication by the inverse product ****)
-
-Lemma mult_eq:
-  (e1,e2,a:ExprA)(lvar:(listT (prodT AT nat)))
-    ~((interp_ExprA lvar a)=AzeroT)->
-      (interp_ExprA lvar (EAmult a e1))=(interp_ExprA lvar (EAmult a e2))->
-        (interp_ExprA lvar e1)=(interp_ExprA lvar e2).
-Proof.
-  Simpl;Intros;
-    Apply (r_AmultT_mult (interp_ExprA lvar a) (interp_ExprA lvar e1)
-      (interp_ExprA lvar e2));Assumption.
-Save.
-
-Fixpoint multiply_aux [a,e:ExprA] : ExprA :=
-  Cases e of
-  | (EAplus e1 e2) =>
-    (EAplus (EAmult a e1) (multiply_aux a e2))
-  | _ => (EAmult a e)
-  end.
-
-Definition multiply [e:ExprA] : ExprA :=
-  Cases e of
-  | (EAmult a e1) => (multiply_aux a e1)
-  | _ => e
-  end.
-
-Lemma multiply_aux_correct:
-  (a,e:ExprA)(lvar:(listT (prodT AT nat)))
-    (interp_ExprA lvar (multiply_aux a e))=
-    (AmultT (interp_ExprA lvar a) (interp_ExprA lvar e)).
-Proof.
-Induction e;Simpl;Intros;Try (Rewrite merge_mult_correct);Auto.
-  Simpl;Rewrite (H0 lvar);Ring.
-Save.
-
-Lemma multiply_correct:
-  (e:ExprA)(lvar:(listT (prodT AT nat)))
-    (interp_ExprA lvar (multiply e))=(interp_ExprA lvar e).
-Proof.
-  Induction e;Simpl;Auto.
-  Intros;Apply multiply_aux_correct.
-Save.
-
-(**** Permutations and simplification ****)
-
-Fixpoint monom_remove [a,m:ExprA] : ExprA :=
-  Cases m of
-  | (EAmult m0 m1) =>
-    (Cases (eqExprA m0 (EAinv a)) of
-     | (left _) => m1
-     | (right _) => (EAmult m0 (monom_remove a m1))
-     end)
-  | _ =>
-    (Cases (eqExprA m (EAinv a)) of
-     | (left _) => EAone
-     | (right _) => (EAmult a m)
-     end)
-  end.
-
-Definition monom_simplif_rem := 
-  Fix monom_simplif_rem {monom_simplif_rem/1:ExprA->ExprA->ExprA:=
-  [a,m:ExprA] 
-  Cases a of
-  | (EAmult a0 a1) => (monom_simplif_rem a1 (monom_remove a0 m))
-  | _ => (monom_remove a m)
-  end}.
-
-Definition monom_simplif [a,m:ExprA] : ExprA :=
-  Cases m of
-  | (EAmult a' m') =>
-    (Cases (eqExprA a a') of
-     | (left _) => (monom_simplif_rem a m')
-     | (right _) => m
-     end)
-  | _ => m
-  end.
-
-Fixpoint inverse_simplif [a,e:ExprA] : ExprA :=
-  Cases e of
-  | (EAplus e1 e2) => (EAplus (monom_simplif a e1) (inverse_simplif a e2))
-  | _ => (monom_simplif a e)
-  end.
-
-Lemma monom_remove_correct:(e,a:ExprA)
-  (lvar:(listT (prodT AT nat)))~((interp_ExprA lvar a)=AzeroT)->
-  (interp_ExprA lvar (monom_remove a e))=
-  (AmultT (interp_ExprA lvar a) (interp_ExprA lvar e)).
-Proof.
-Induction e; Intros.
-Simpl;Case (eqExprA EAzero (EAinv a));Intros;[Inversion e0|Simpl;Trivial].
-Simpl;Case (eqExprA EAone (EAinv a));Intros;[Inversion e0|Simpl;Trivial].
-Simpl;Case (eqExprA (EAplus e0 e1) (EAinv a));Intros;[Inversion e2|
- Simpl;Trivial].
-Simpl;Case (eqExprA e0 (EAinv a));Intros.
-Rewrite e2;Simpl;Fold AinvT.
-Rewrite <-(AmultT_assoc (interp_ExprA lvar a) (AinvT (interp_ExprA lvar a))
-             (interp_ExprA lvar e1));
-  Rewrite AinvT_r;[Ring|Assumption].
-Simpl;Rewrite H0;Auto; Ring.
-Simpl;Fold AoppT;Case (eqExprA (EAopp e0) (EAinv a));Intros;[Inversion e1|
- Simpl;Trivial].
-Unfold monom_remove;Case (eqExprA (EAinv e0) (EAinv a));Intros.
-Case (eqExprA e0 a);Intros.
-Rewrite e2;Simpl;Fold AinvT;Rewrite AinvT_r;Auto.
-Inversion e1;Simpl;ElimType False;Auto.
-Simpl;Trivial.
-Unfold monom_remove;Case (eqExprA (EAvar n) (EAinv a));Intros;
- [Inversion e0|Simpl;Trivial].
-Save.
-
-Lemma monom_simplif_rem_correct:(a,e:ExprA)
-  (lvar:(listT (prodT AT nat)))~((interp_ExprA lvar a)=AzeroT)->
-  (interp_ExprA lvar (monom_simplif_rem a e))=
-  (AmultT (interp_ExprA lvar a) (interp_ExprA lvar e)).
-Proof.
-Induction a;Simpl;Intros; Try Rewrite monom_remove_correct;Auto.
-Elim (without_div_O_contr (interp_ExprA lvar e) 
-                          (interp_ExprA lvar e0) H1);Intros.
-Rewrite (H0 (monom_remove e e1) lvar H3);Rewrite monom_remove_correct;Auto.
-Ring.
-Save.
-
-Lemma monom_simplif_correct:(e,a:ExprA)
-  (lvar:(listT (prodT AT nat)))~((interp_ExprA lvar a)=AzeroT)->
-  (interp_ExprA lvar (monom_simplif a e))=(interp_ExprA lvar e).
-Proof.
-Induction e;Intros;Auto.
-Simpl;Case (eqExprA a e0);Intros.
-Rewrite <-e2;Apply monom_simplif_rem_correct;Auto. 
-Simpl;Trivial.
-Save.
-
-Lemma inverse_correct:
-  (e,a:ExprA)(lvar:(listT (prodT AT nat)))~((interp_ExprA lvar a)=AzeroT)->
-    (interp_ExprA lvar (inverse_simplif a e))=(interp_ExprA lvar e).
-Proof.
-Induction e;Intros;Auto.
-Simpl;Rewrite (H0 a lvar H1); Rewrite monom_simplif_correct ; Auto.
-Unfold inverse_simplif;Rewrite monom_simplif_correct ; Auto.
-Save.
-
-End Theory_of_fields.
diff --git a/contrib7/fourier/Fourier_util.v b/contrib7/fourier/Fourier_util.v
deleted file mode 100644
index be22e2ff..00000000
--- a/contrib7/fourier/Fourier_util.v
+++ /dev/null
@@ -1,236 +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        *)
-(************************************************************************)
-
-(* $Id: Fourier_util.v,v 1.2.2.1 2004/07/16 19:30:17 herbelin Exp $ *)
-
-Require Export Rbase.
-Comments "Lemmas used by the tactic Fourier".
-
-Open Scope R_scope.
- 
-Lemma Rfourier_lt:
- (x1, y1, a : R) (Rlt x1 y1) -> (Rlt R0 a) ->  (Rlt (Rmult a x1) (Rmult a y1)).
-Intros; Apply Rlt_monotony; Assumption.
-Qed.
- 
-Lemma Rfourier_le:
- (x1, y1, a : R) (Rle x1 y1) -> (Rlt R0 a) ->  (Rle (Rmult a x1) (Rmult a y1)).
-Red.
-Intros.
-Case H; Auto with real.
-Qed.
- 
-Lemma Rfourier_lt_lt:
- (x1, y1, x2, y2, a : R)
- (Rlt x1 y1) ->
- (Rlt x2 y2) ->
- (Rlt R0 a) ->  (Rlt (Rplus x1 (Rmult a x2)) (Rplus y1 (Rmult a y2))).
-Intros x1 y1 x2 y2 a H H0 H1; Try Assumption.
-Apply Rplus_lt.
-Try Exact H.
-Apply Rfourier_lt.
-Try Exact H0.
-Try Exact H1.
-Qed.
- 
-Lemma Rfourier_lt_le:
- (x1, y1, x2, y2, a : R)
- (Rlt x1 y1) ->
- (Rle x2 y2) ->
- (Rlt R0 a) ->  (Rlt (Rplus x1 (Rmult a x2)) (Rplus y1 (Rmult a y2))).
-Intros x1 y1 x2 y2 a H H0 H1; Try Assumption.
-Case H0; Intros.
-Apply Rplus_lt.
-Try Exact H.
-Apply Rfourier_lt; Auto with real.
-Rewrite H2.
-Rewrite (Rplus_sym y1 (Rmult a y2)).
-Rewrite (Rplus_sym x1 (Rmult a y2)).
-Apply Rlt_compatibility.
-Try Exact H.
-Qed.
- 
-Lemma Rfourier_le_lt:
- (x1, y1, x2, y2, a : R)
- (Rle x1 y1) ->
- (Rlt x2 y2) ->
- (Rlt R0 a) ->  (Rlt (Rplus x1 (Rmult a x2)) (Rplus y1 (Rmult a y2))).
-Intros x1 y1 x2 y2 a H H0 H1; Try Assumption.
-Case H; Intros.
-Apply Rfourier_lt_le; Auto with real.
-Rewrite H2.
-Apply Rlt_compatibility.
-Apply Rfourier_lt; Auto with real.
-Qed.
- 
-Lemma Rfourier_le_le:
- (x1, y1, x2, y2, a : R)
- (Rle x1 y1) ->
- (Rle x2 y2) ->
- (Rlt R0 a) ->  (Rle (Rplus x1 (Rmult a x2)) (Rplus y1 (Rmult a y2))).
-Intros x1 y1 x2 y2 a H H0 H1; Try Assumption.
-Case H0; Intros.
-Red.
-Left; Try Assumption.
-Apply Rfourier_le_lt; Auto with real.
-Rewrite H2.
-Case H; Intros.
-Red.
-Left; Try Assumption.
-Rewrite (Rplus_sym x1 (Rmult a y2)).
-Rewrite (Rplus_sym y1 (Rmult a y2)).
-Apply Rlt_compatibility.
-Try Exact H3.
-Rewrite H3.
-Red.
-Right; Try Assumption.
-Auto with real.
-Qed.
- 
-Lemma Rlt_zero_pos_plus1: (x : R) (Rlt R0 x) ->  (Rlt R0 (Rplus R1 x)).
-Intros x H; Try Assumption.
-Rewrite Rplus_sym.
-Apply Rlt_r_plus_R1.
-Red; Auto with real.
-Qed.
- 
-Lemma Rlt_mult_inv_pos:
- (x, y : R) (Rlt R0 x) -> (Rlt R0 y) ->  (Rlt R0 (Rmult x (Rinv y))).
-Intros x y H H0; Try Assumption.
-Replace R0 with (Rmult x R0).
-Apply Rlt_monotony; Auto with real.
-Ring.
-Qed.
- 
-Lemma Rlt_zero_1: (Rlt R0 R1).
-Exact Rlt_R0_R1.
-Qed.
- 
-Lemma Rle_zero_pos_plus1: (x : R) (Rle R0 x) ->  (Rle R0 (Rplus R1 x)).
-Intros x H; Try Assumption.
-Case H; Intros.
-Red.
-Left; Try Assumption.
-Apply Rlt_zero_pos_plus1; Auto with real.
-Rewrite <- H0.
-Replace (Rplus R1 R0) with R1.
-Red; Left.
-Exact Rlt_zero_1.
-Ring.
-Qed.
- 
-Lemma Rle_mult_inv_pos:
- (x, y : R) (Rle R0 x) -> (Rlt R0 y) ->  (Rle R0 (Rmult x (Rinv y))).
-Intros x y H H0; Try Assumption.
-Case H; Intros.
-Red; Left.
-Apply Rlt_mult_inv_pos; Auto with real.
-Rewrite <- H1.
-Red; Right; Ring.
-Qed.
- 
-Lemma Rle_zero_1: (Rle R0 R1).
-Red; Left.
-Exact Rlt_zero_1.
-Qed.
- 
-Lemma Rle_not_lt:
- (n, d : R) (Rle R0 (Rmult n (Rinv d))) ->  ~ (Rlt R0 (Rmult (Ropp n) (Rinv d))).
-Intros n d H; Red; Intros H0; Try Exact H0.
-Generalize (Rle_not R0 (Rmult n (Rinv d))).
-Intros H1; Elim H1; Try Assumption.
-Replace (Rmult n (Rinv d)) with (Ropp (Ropp (Rmult n (Rinv d)))).
-Replace R0 with (Ropp (Ropp R0)).
-Replace (Ropp (Rmult n (Rinv d))) with (Rmult (Ropp n) (Rinv d)).
-Replace (Ropp R0) with R0.
-Red.
-Apply Rgt_Ropp.
-Red.
-Exact H0.
-Ring.
-Ring.
-Ring.
-Ring.
-Qed.
- 
-Lemma Rnot_lt0: (x : R)  ~ (Rlt R0 (Rmult R0 x)).
-Intros x; Try Assumption.
-Replace (Rmult R0 x) with R0.
-Apply Rlt_antirefl.
-Ring.
-Qed.
- 
-Lemma Rlt_not_le:
- (n, d : R) (Rlt R0 (Rmult n (Rinv d))) ->  ~ (Rle R0 (Rmult (Ropp n) (Rinv d))).
-Intros n d H; Try Assumption.
-Apply Rle_not.
-Replace R0 with (Ropp R0).
-Replace (Rmult (Ropp n) (Rinv d)) with (Ropp (Rmult n (Rinv d))).
-Apply Rlt_Ropp.
-Try Exact H.
-Ring.
-Ring.
-Qed.
- 
-Lemma Rnot_lt_lt: (x, y : R) ~ (Rlt R0 (Rminus y x)) ->  ~ (Rlt x y).
-Unfold not; Intros.
-Apply H.
-Apply Rlt_anti_compatibility with x.
-Replace (Rplus x R0) with x.
-Replace (Rplus x (Rminus y x)) with y.
-Try Exact H0.
-Ring.
-Ring.
-Qed.
- 
-Lemma Rnot_le_le: (x, y : R) ~ (Rle R0 (Rminus y x)) ->  ~ (Rle x y).
-Unfold not; Intros.
-Apply H.
-Case H0; Intros.
-Left.
-Apply Rlt_anti_compatibility with x.
-Replace (Rplus x R0) with x.
-Replace (Rplus x (Rminus y x)) with y.
-Try Exact H1.
-Ring.
-Ring.
-Right.
-Rewrite H1; Ring.
-Qed.
- 
-Lemma Rfourier_gt_to_lt: (x, y : R) (Rgt y x) ->  (Rlt x y).
-Unfold Rgt; Intros; Assumption.
-Qed.
- 
-Lemma Rfourier_ge_to_le: (x, y : R) (Rge y x) ->  (Rle x y).
-Intros x y; Exact (Rge_le y x).
-Qed.
- 
-Lemma Rfourier_eqLR_to_le: (x, y : R) x == y ->  (Rle x y).
-Exact eq_Rle.
-Qed.
- 
-Lemma Rfourier_eqRL_to_le: (x, y : R) y == x ->  (Rle x y).
-Exact eq_Rle_sym.
-Qed.
- 
-Lemma Rfourier_not_ge_lt: (x, y : R) ((Rge x y) ->  False) ->  (Rlt x y).
-Exact not_Rge.
-Qed.
- 
-Lemma Rfourier_not_gt_le: (x, y : R) ((Rgt x y) ->  False) ->  (Rle x y).
-Exact Rgt_not_le.
-Qed.
- 
-Lemma Rfourier_not_le_gt: (x, y : R) ((Rle x y) ->  False) ->  (Rgt x y).
-Exact not_Rle.
-Qed.
- 
-Lemma Rfourier_not_lt_ge: (x, y : R) ((Rlt x y) ->  False) ->  (Rge x y).
-Exact Rlt_not_ge.
-Qed.
diff --git a/contrib7/interface/AddDad.v b/contrib7/interface/AddDad.v
deleted file mode 100644
index d22b7ed1..00000000
--- a/contrib7/interface/AddDad.v
+++ /dev/null
@@ -1,19 +0,0 @@
-Grammar vernac vernac : ast :=
- add_dad_rule00 ["AddDadRule" stringarg($name) constrarg($pat) 
-       "first_path" "second_path" tacarg($tac) "."] ->
-    [(AddDadRule $name $pat (NUMBERLIST) (NUMBERLIST) (TACTIC $tac))].
-Grammar vernac vernac:ast :=
-| add_dad_rule01 ["AddDadRule" stringarg($name) constrarg($pat)
-       "first_path" "second_path" ne_numarg_list($l) tacarg($tac) "."] ->
-    [(AddDadRule $name $pat (NUMBERLIST) (NUMBERLIST ($LIST $l)) (TACTIC $tac))]
-| add_dad_rule10 ["AddDadRule" stringarg($name) constrarg($pat)
-       "first_path" ne_numarg_list($l) "second_path" tacarg($tac) "."] ->
-    [(AddDadRule $name $pat (NUMBERLIST ($LIST $l))(NUMBERLIST) (TACTIC $tac))]
-| add_dad_rule11 ["AddDadRule" stringarg($name) constrarg($pat)
-       "first_path" ne_numarg_list($l) "second_path" ne_numarg_list($l1)
-       tacarg($tac) "."] ->
-    [(AddDadRule $name $pat (NUMBERLIST ($LIST $l))(NUMBERLIST ($LIST $l1))
-       (TACTIC $tac))].
-
-Grammar vernac vernac : ast :=
- start_dad [ "StartDad" "."] -> [(StartDad)].
diff --git a/contrib7/interface/Centaur.v b/contrib7/interface/Centaur.v
deleted file mode 100644
index d27929f8..00000000
--- a/contrib7/interface/Centaur.v
+++ /dev/null
@@ -1,88 +0,0 @@
-(*
-Declare ML Module "ctast".
-Declare ML Module "paths".
-Declare ML Module "name_to_ast".
-Declare ML Module "xlate".
-Declare ML Module "vtp".
-Declare ML Module "translate".
-Declare ML Module "pbp".
-Declare ML Module "blast".
-Declare ML Module "dad".
-Declare ML Module "showproof_ct".
-Declare ML Module "showproof".
-Declare ML Module "debug_tac".
-Declare ML Module "paths".
-Declare ML Module "history".
-Declare ML Module "centaur".
-(* Require Export Illustrations. *)
-(* Require Export AddDad. *)
-(*
-Grammar vernac vernac : ast :=
-  goal_cmd [ "Goal" "Cmd" numarg($n) "with" tacarg($tac) "." ] ->
-        [(GOAL_CMD $n (TACTIC $tac))]
-| kill_proof_after [ "Kill" "Proof" "after"  numarg($n)"." ] -> [(KILL_NODE $n)]
-| kill_proof_at [ "Kill" "Proof" "at"  numarg($n)"." ] -> [(KILL_NODE $n)]
-| kill_sub_proof [ "Kill" "SubProof" numarg($n) "." ] -> [(KILL_SUB_PROOF $n)]
-
-| print_past_goal [ "Print" "Past" "Goal" numarg($n) "." ] ->
-        [(PRINT_GOAL_AT $n) ]
-
-| check_in_goal [ "CHECK_IN_GOAL" numarg($n) constrarg($c) "." ] ->
-       [(CHECK_IN_GOAL "CHECK" $n $c)]
-| eval_in_goal [ "EVAL_IN_GOAL" numarg($n) constrarg($c) "." ] ->
-       [(CHECK_IN_GOAL "EVAL" $n $c)]
-| compute_in_goal [ "COMPUTE_IN_GOAL" numarg($n) constrarg($c) "." ] ->
-       [(CHECK_IN_GOAL "COMPUTE" $n $c)]
-| centaur_reset [ "Centaur" "Reset" identarg($id) "." ] -> [(Centaur_Reset $id)]
-(*| show_dad_rules [ "Show" "Dad" "Rules" "." ] -> [(Show_dad_rules)]*)
-| start_pcoq [ "Start" "Pcoq" "Mode" "." ] -> [ (START_PCOQ) ]
-| start_pcoq [ "Start" "Pcoq" "Debug" "Mode" "." ] -> [ (START_PCOQ_DEBUG) ].
-Grammar vernac ne_id_list : ast list :=
-   id_one [ identarg($id)] -> [$id]
- | id_more [identarg($id) ne_id_list($others)] -> [$id ($LIST $others)].
-
-Grammar tactic ne_num_list : ast list :=
-  ne_last [ numarg($n) ] -> [ $n ]
-| ne_num_ste  [ numarg($n) ne_num_list($ns) ] -> [ $n ($LIST $ns)].
-
-Grammar tactic two_numarg_list : ast list :=
-  two_single_and_ne [ numarg($n) "to"  ne_num_list($ns)] ->
-        [$n (TACTIC (to)) ($LIST $ns)]
-| two_rec [ numarg($n) two_numarg_list($ns)] -> [ $n ($LIST $ns)].
-
-Grammar tactic simple_tactic : ast :=
-  pbp0 [ "Pbp" ] -> [(PcoqPbp)]
-| pbp1 [ "Pbp" ne_num_list($ns) ] ->
-         [ (PcoqPbp ($LIST $ns)) ]
-| pbp2 [ "Pbp" identarg($id) ] -> [ (PcoqPbp $id) ]
-| pbp3 [ "Pbp" identarg($id) ne_num_list($ns)] ->
-         [ (PcoqPbp $id ($LIST $ns)) ]
-| blast1 [ "Blast" ne_num_list($ns) ] ->
-         [ (PcoqBlast ($LIST $ns)) ]
-| dad00 [ "Dad" "to" ] -> [(Dad (TACTIC (to)))]
-| dad01 [ "Dad" "to" ne_num_list($ns) ] ->
-        [(Dad (TACTIC (to)) ($LIST $ns))]
-| dadnn [ "Dad" two_numarg_list($ns) ] -> [ (Dad ($LIST $ns)) ]
-| debug_tac [ "DebugTac" tactic($tac) ] ->
-  [(CtDebugTac (TACTIC $tac))]
-| on_then_empty [ "OnThen" tactic($tac1) tactic($tac2) ] ->
-    [(OnThen (TACTIC $tac1) (TACTIC $tac2))]
-| on_then_ne [ "OnThen" tactic($tac1) tactic($tac2) ne_num_list($l) ] ->
-  [(OnThen (TACTIC $tac1) (TACTIC $tac2) ($LIST $l))]
-| debug_tac2 [ "DebugTac2" tactic($tac) ] ->
-  [(CtDebugTac2 (TACTIC $tac))].
-
-
-(* Maybe we should have syntactic rules to make sur that syntax errors are
-   displayed with a readable syntax.  It is not sure, since the error reporting
-   procedure changed from V6.1 and does not reprint the command anymore. *)
-Grammar vernac vernac : ast :=
-  text_proof_flag_on [ "Text" "Mode" "fr" "." ] ->
-       [(TEXT_MODE (AST "fr"))]
-| text_proof_flag_on [ "Text" "Mode" "en" "." ] ->
-       [(TEXT_MODE (AST "en"))]
-| text_proof_flag_on [ "Text" "Mode" "Off" "." ] ->
-       [(TEXT_MODE (AST "off"))].
-
-*)
-*)
diff --git a/contrib7/interface/vernacrc b/contrib7/interface/vernacrc
deleted file mode 100644
index f95c4212..00000000
--- a/contrib7/interface/vernacrc
+++ /dev/null
@@ -1,17 +0,0 @@
-# $Id: vernacrc,v 1.1 2003/11/29 20:02:41 herbelin Exp $
-
-# This file is loaded initially by ./vernacparser.
-
-load_syntax_file 17 LogicSyntax
-load_syntax_file 36 SpecifSyntax
-load_syntax_file 18 Logic_TypeSyntax
-load_syntax_file 19 DatatypesSyntax
-load_syntax_file 21 Equality
-load_syntax_file 22 Inv
-load_syntax_file 26 Tauto
-load_syntax_file 34 Omega
-load_syntax_file 27 Ring
-quiet_parse_string
-Goal a.
-&& END--OF--DATA
-print_version
diff --git a/contrib7/omega/Omega.v b/contrib7/omega/Omega.v
deleted file mode 100644
index 76e37519..00000000
--- a/contrib7/omega/Omega.v
+++ /dev/null
@@ -1,57 +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        *)
-(************************************************************************)
-(**************************************************************************)
-(*                                                                        *)
-(* Omega: a solver of quantifier-free problems in Presburger Arithmetic   *)
-(*                                                                        *)
-(* Pierre Crégut (CNET, Lannion, France)                                  *)
-(*                                                                        *)
-(**************************************************************************)
-
-(* $Id: Omega.v,v 1.1.2.1 2004/07/16 19:30:17 herbelin Exp $ *)
-
-(* We do not require [ZArith] anymore, but only what's necessary for Omega *)
-Require Export ZArith_base.
-Require Export OmegaLemmas.
-
-Hints Resolve Zle_n Zplus_sym Zplus_assoc Zmult_sym Zmult_assoc
-  Zero_left Zero_right Zmult_one Zplus_inverse_l Zplus_inverse_r 
-  Zmult_plus_distr_l Zmult_plus_distr_r : zarith.
-
-Require Export Zhints.
-
-(*
-(* The constant minus is required in coq_omega.ml *)
-Require Minus.
-*)
-
-Hint eq_nat_Omega : zarith := Extern 10 (eq nat ? ?) Abstract Omega.
-Hint le_Omega : zarith := Extern 10 (le ? ?) Abstract Omega.
-Hint lt_Omega : zarith := Extern 10 (lt ? ?) Abstract Omega.
-Hint ge_Omega : zarith := Extern 10 (ge ? ?) Abstract Omega.
-Hint gt_Omega : zarith := Extern 10 (gt ? ?) Abstract Omega.
-
-Hint not_eq_nat_Omega : zarith := Extern 10 ~(eq nat ? ?) Abstract Omega.
-Hint not_le_Omega : zarith := Extern 10 ~(le ? ?) Abstract Omega.
-Hint not_lt_Omega : zarith := Extern 10 ~(lt ? ?) Abstract Omega.
-Hint not_ge_Omega : zarith := Extern 10 ~(ge ? ?) Abstract Omega.
-Hint not_gt_Omega : zarith := Extern 10 ~(gt ? ?) Abstract Omega.
-
-Hint eq_Z_Omega : zarith := Extern 10 (eq Z ? ?) Abstract Omega.
-Hint Zle_Omega : zarith := Extern 10 (Zle ? ?) Abstract Omega.
-Hint Zlt_Omega : zarith := Extern 10 (Zlt ? ?) Abstract Omega.
-Hint Zge_Omega : zarith := Extern 10 (Zge ? ?) Abstract Omega.
-Hint Zgt_Omega : zarith := Extern 10 (Zgt ? ?) Abstract Omega.
-
-Hint not_eq_nat_Omega : zarith := Extern 10 ~(eq Z ? ?) Abstract Omega.
-Hint not_Zle_Omega : zarith := Extern 10 ~(Zle ? ?) Abstract Omega.
-Hint not_Zlt_Omega : zarith := Extern 10 ~(Zlt ? ?) Abstract Omega.
-Hint not_Zge_Omega : zarith := Extern 10 ~(Zge ? ?) Abstract Omega.
-Hint not_Zgt_Omega : zarith := Extern 10 ~(Zgt ? ?) Abstract Omega.
-
-Hint false_Omega : zarith := Extern 10 False Abstract Omega.
diff --git a/contrib7/omega/OmegaLemmas.v b/contrib7/omega/OmegaLemmas.v
deleted file mode 100644
index 0d05fc3e..00000000
--- a/contrib7/omega/OmegaLemmas.v
+++ /dev/null
@@ -1,399 +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: OmegaLemmas.v,v 1.1.2.1 2004/07/16 19:30:17 herbelin Exp $ i*)
-
-Require ZArith_base.
-
-(** These are specific variants of theorems dedicated for the Omega tactic *)
-
-Lemma new_var: (x:Z) (EX y:Z |(x=y)).
-Intros x; Exists x; Trivial with arith. 
-Qed.
-
-Lemma OMEGA1 : (x,y:Z) (x=y) -> (Zle ZERO x) -> (Zle ZERO y).
-Intros x y H; Rewrite H; Auto with arith.
-Qed.
-
-Lemma OMEGA2 : (x,y:Z) (Zle ZERO x) -> (Zle ZERO y) -> (Zle ZERO (Zplus x y)).
-Exact Zle_0_plus.
-Qed. 
-
-Lemma OMEGA3 : 
-  (x,y,k:Z)(Zgt k ZERO)-> (x=(Zmult y k)) -> (x=ZERO) -> (y=ZERO).
-
-Intros x y k H1 H2 H3; Apply (Zmult_eq k); [
-  Unfold not ; Intros H4; Absurd (Zgt k ZERO); [
-    Rewrite H4; Unfold Zgt ; Simpl; Discriminate | Assumption]
-  | Rewrite <- H2; Assumption].
-Qed.
-
-Lemma OMEGA4 :
-  (x,y,z:Z)(Zgt x ZERO) -> (Zgt y x) -> ~(Zplus (Zmult z y) x) = ZERO.
-
-Unfold not ; Intros x y z H1 H2 H3; Cut (Zgt y ZERO); [
-  Intros H4; Cut (Zle ZERO (Zplus (Zmult z y) x)); [
-    Intros H5; Generalize (Zmult_le_approx y z x H4 H2 H5) ; Intros H6;
-    Absurd (Zgt (Zplus (Zmult z y) x) ZERO); [
-      Rewrite -> H3; Unfold Zgt ; Simpl; Discriminate
-    | Apply Zle_gt_trans with x ; [
-        Pattern 1 x ; Rewrite <- (Zero_left x); Apply Zle_reg_r;
-        Rewrite -> Zmult_sym; Generalize H4 ; Unfold Zgt;
-        Case y; [
-          Simpl; Intros H7; Discriminate H7
-        | Intros p H7; Rewrite <- (Zero_mult_right (POS p));
-          Unfold Zle ; Rewrite -> Zcompare_Zmult_compatible; Exact H6
-        | Simpl; Intros p H7; Discriminate H7]
-      | Assumption]]
-    | Rewrite -> H3; Unfold Zle ; Simpl; Discriminate]
-  | Apply Zgt_trans with x ; [ Assumption | Assumption]].
-Qed.
-
-Lemma OMEGA5: (x,y,z:Z)(x=ZERO) -> (y=ZERO) -> (Zplus x (Zmult y z)) = ZERO.
-
-Intros x y z H1 H2; Rewrite H1; Rewrite H2; Simpl; Trivial with arith.
-Qed.
-
-Lemma OMEGA6:
-  (x,y,z:Z)(Zle ZERO x) -> (y=ZERO) -> (Zle ZERO (Zplus x (Zmult y z))).
-
-Intros x y z H1 H2; Rewrite H2; Simpl; Rewrite Zero_right; Assumption.
-Qed.
-
-Lemma OMEGA7:
-  (x,y,z,t:Z)(Zgt z ZERO) -> (Zgt t ZERO) -> (Zle ZERO x) -> (Zle ZERO y) -> 
-    (Zle ZERO (Zplus (Zmult x z) (Zmult y t))).
-
-Intros x y z t H1 H2 H3 H4; Rewrite <- (Zero_left ZERO);
-Apply Zle_plus_plus; Apply Zle_mult; Assumption.
-Qed.
-
-Lemma OMEGA8: 
-  (x,y:Z) (Zle ZERO x) -> (Zle ZERO y) -> x = (Zopp y) -> x = ZERO.
-
-Intros x y H1 H2 H3; Elim (Zle_lt_or_eq ZERO x H1); [
-  Intros H4; Absurd (Zlt ZERO x); [
-    Change (Zge ZERO x); Apply Zle_ge; Apply Zsimpl_le_plus_l with y;
-    Rewrite -> H3; Rewrite Zplus_inverse_r; Rewrite Zero_right; Assumption
-  | Assumption]
-| Intros H4; Rewrite -> H4; Trivial with arith].
-Qed.
-
-Lemma OMEGA9:(x,y,z,t:Z) y=ZERO -> x = z -> 
-  (Zplus y (Zmult (Zplus (Zopp x) z) t)) = ZERO.
-
-Intros x y z t H1 H2; Rewrite H2; Rewrite Zplus_inverse_l; 
-Rewrite Zero_mult_left;  Rewrite Zero_right; Assumption.
-Qed.
-
-Lemma OMEGA10:(v,c1,c2,l1,l2,k1,k2:Z)
-  (Zplus (Zmult (Zplus (Zmult v c1) l1) k1) (Zmult (Zplus (Zmult v c2) l2) k2))
-  = (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2)))
-           (Zplus (Zmult l1 k1) (Zmult l2 k2))).
-
-Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r);
-Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; 
-Rewrite (Zplus_permute (Zmult l1 k1) (Zmult (Zmult v c2) k2)); Trivial with arith.
-Qed.
-
-Lemma OMEGA11:(v1,c1,l1,l2,k1:Z)
-  (Zplus (Zmult (Zplus (Zmult v1 c1) l1) k1) l2)
-  = (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1) l2)).
-
-Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r);
-Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; Trivial with arith.
-Qed.
-
-Lemma OMEGA12:(v2,c2,l1,l2,k2:Z)
-  (Zplus l1 (Zmult (Zplus (Zmult v2 c2) l2) k2))
-  = (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2))).
-
-Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r);
-Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; Rewrite Zplus_permute;
-Trivial with arith.
-Qed.
-
-Lemma OMEGA13:(v,l1,l2:Z)(x:positive)
-  (Zplus (Zplus (Zmult v (POS x)) l1) (Zplus (Zmult v (NEG x)) l2))
-  = (Zplus l1 l2).
-
-Intros; Rewrite  Zplus_assoc; Rewrite (Zplus_sym (Zmult v (POS x)) l1);
-Rewrite (Zplus_assoc_r l1); Rewrite <- Zmult_plus_distr_r;
-Rewrite <- Zopp_NEG; Rewrite (Zplus_sym (Zopp (NEG x)) (NEG x));
-Rewrite Zplus_inverse_r; Rewrite  Zero_mult_right; Rewrite Zero_right; Trivial with arith.
-Qed.
- 
-Lemma OMEGA14:(v,l1,l2:Z)(x:positive)
-  (Zplus (Zplus (Zmult v (NEG x)) l1) (Zplus (Zmult v (POS x)) l2))
-  = (Zplus l1 l2).
-
-Intros; Rewrite  Zplus_assoc; Rewrite (Zplus_sym (Zmult v (NEG x)) l1);
-Rewrite (Zplus_assoc_r l1); Rewrite <- Zmult_plus_distr_r;
-Rewrite <- Zopp_NEG; Rewrite  Zplus_inverse_r; Rewrite  Zero_mult_right;
-Rewrite Zero_right; Trivial with arith.
-Qed.
-Lemma OMEGA15:(v,c1,c2,l1,l2,k2:Z)
-  (Zplus (Zplus (Zmult v c1) l1) (Zmult (Zplus (Zmult v c2) l2) k2))
-  = (Zplus (Zmult v (Zplus c1  (Zmult c2 k2)))
-           (Zplus l1 (Zmult l2 k2))).
-
-Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r);
-Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; 
-Rewrite (Zplus_permute l1 (Zmult (Zmult v c2) k2)); Trivial with arith.
-Qed.
-
-Lemma OMEGA16:
-  (v,c,l,k:Z)
-   (Zmult (Zplus (Zmult v c) l) k) = (Zplus (Zmult v (Zmult c k)) (Zmult l k)).
-
-Intros; Repeat (Rewrite Zmult_plus_distr_l Orelse Rewrite Zmult_plus_distr_r);
-Repeat Rewrite Zmult_assoc; Repeat Elim Zplus_assoc; Trivial with arith.
-Qed.
-
-Lemma OMEGA17: 
-  (x,y,z:Z)(Zne x ZERO) -> (y=ZERO) -> (Zne (Zplus x (Zmult y z)) ZERO).
-
-Unfold Zne not; Intros x y z H1 H2 H3; Apply H1; 
-Apply Zsimpl_plus_l with (Zmult y z); Rewrite Zplus_sym; Rewrite H3; 
-Rewrite H2; Auto with arith.
-Qed.
-
-Lemma OMEGA18:
-  (x,y,k:Z) x=(Zmult y k) -> (Zne x ZERO) -> (Zne y ZERO).
-
-Unfold Zne not; Intros x y k H1 H2 H3; Apply H2; Rewrite H1; Rewrite H3; Auto with arith.
-Qed.
-
-Lemma OMEGA19:
-  (x:Z) (Zne x ZERO) -> 
-    (Zle ZERO (Zplus x (NEG xH))) \/ (Zle ZERO (Zplus (Zmult x (NEG xH)) (NEG xH))).
-
-Unfold Zne ; Intros x H; Elim (Zle_or_lt ZERO x); [
-  Intros H1; Elim Zle_lt_or_eq with 1:=H1; [
-    Intros H2; Left;  Change (Zle ZERO (Zpred x)); Apply Zle_S_n;
-    Rewrite <- Zs_pred; Apply Zlt_le_S; Assumption
-  | Intros H2; Absurd x=ZERO; Auto with arith]
-| Intros H1; Right; Rewrite <- Zopp_one; Rewrite Zplus_sym;
-  Apply Zle_left; Apply Zle_S_n; Simpl; Apply Zlt_le_S; Auto with arith].
-Qed.
-
-Lemma OMEGA20:
-  (x,y,z:Z)(Zne x  ZERO) -> (y=ZERO) -> (Zne (Zplus x (Zmult y z)) ZERO).
-
-Unfold Zne not; Intros x y z H1 H2 H3; Apply H1; Rewrite H2 in H3;
-Simpl in H3; Rewrite Zero_right in H3; Trivial with arith.
-Qed.
-
-Definition fast_Zplus_sym := 
-[x,y:Z][P:Z -> Prop][H: (P (Zplus y x))]
-  (eq_ind_r Z (Zplus y x) P H (Zplus x y) (Zplus_sym x y)).
-
-Definition fast_Zplus_assoc_r :=
-[n,m,p:Z][P:Z -> Prop][H : (P (Zplus n (Zplus m p)))]
- (eq_ind_r Z (Zplus n (Zplus m p)) P H (Zplus (Zplus n m) p) (Zplus_assoc_r n m p)).
-
-Definition fast_Zplus_assoc_l :=
-[n,m,p:Z][P:Z -> Prop][H : (P (Zplus (Zplus n m) p))]
- (eq_ind_r Z (Zplus (Zplus n m) p) P H (Zplus n (Zplus m p)) 
-           (Zplus_assoc_l n m p)).
-
-Definition fast_Zplus_permute :=
-[n,m,p:Z][P:Z -> Prop][H : (P (Zplus m (Zplus n p)))]
- (eq_ind_r Z (Zplus m (Zplus n p)) P H (Zplus n (Zplus m p))
-           (Zplus_permute n m p)).
-
-Definition fast_OMEGA10 := 
-[v,c1,c2,l1,l2,k1,k2:Z][P:Z -> Prop]
-[H : (P (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2)))
-               (Zplus (Zmult l1 k1) (Zmult l2 k2))))]
- (eq_ind_r Z 
-           (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2)))
-            (Zplus (Zmult l1 k1) (Zmult l2 k2)))
-           P H 
-          (Zplus (Zmult (Zplus (Zmult v c1) l1) k1)
-                 (Zmult (Zplus (Zmult v c2) l2) k2))
-        (OMEGA10 v c1 c2 l1 l2 k1 k2)).
-
-Definition fast_OMEGA11 := 
-[v1,c1,l1,l2,k1:Z][P:Z -> Prop]
-[H : (P (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1) l2)))]
- (eq_ind_r Z 
-   (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1) l2))
-   P H 
-   (Zplus (Zmult (Zplus (Zmult v1 c1) l1) k1) l2)
-   (OMEGA11 v1 c1 l1 l2 k1)).
-Definition fast_OMEGA12 := 
-[v2,c2,l1,l2,k2:Z][P:Z -> Prop]
-[H : (P (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2))))]
- (eq_ind_r Z 
-   (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2)))
-   P H 
-   (Zplus l1 (Zmult (Zplus (Zmult v2 c2) l2) k2))
-   (OMEGA12 v2 c2 l1 l2 k2)).
-
-Definition fast_OMEGA15 :=
-[v,c1,c2,l1,l2,k2 :Z][P:Z -> Prop]
-[H : (P (Zplus (Zmult v (Zplus c1 (Zmult c2 k2))) (Zplus l1 (Zmult l2 k2))))]
- (eq_ind_r Z 
-   (Zplus (Zmult v (Zplus c1 (Zmult c2 k2))) (Zplus l1 (Zmult l2 k2)))
-   P H 
-   (Zplus (Zplus (Zmult v c1) l1) (Zmult (Zplus (Zmult v c2) l2) k2))
-   (OMEGA15 v c1 c2 l1 l2 k2)).
-Definition fast_OMEGA16 :=
-[v,c,l,k :Z][P:Z -> Prop]
-[H : (P (Zplus (Zmult v (Zmult c k)) (Zmult l k)))]
- (eq_ind_r Z 
-   (Zplus (Zmult v (Zmult c k)) (Zmult l k))
-   P H 
-   (Zmult (Zplus (Zmult v c) l) k)
-   (OMEGA16 v c l k)).
-
-Definition fast_OMEGA13 :=
-[v,l1,l2 :Z][x:positive][P:Z -> Prop]
-[H : (P (Zplus l1 l2))]
- (eq_ind_r Z 
-   (Zplus l1 l2)
-   P H 
-   (Zplus (Zplus (Zmult v (POS x)) l1) (Zplus (Zmult v (NEG x)) l2))
-   (OMEGA13 v l1 l2 x )).
-
-Definition fast_OMEGA14 :=
-[v,l1,l2 :Z][x:positive][P:Z -> Prop]
-[H : (P (Zplus l1 l2))]
- (eq_ind_r Z 
-   (Zplus l1 l2)
-   P H 
-   (Zplus (Zplus (Zmult v (NEG x)) l1) (Zplus (Zmult v (POS x)) l2))
-   (OMEGA14 v l1 l2 x )).
-Definition fast_Zred_factor0:=
-[x:Z][P:Z -> Prop]
-[H : (P (Zmult x (POS xH)) )]
- (eq_ind_r Z 
-   (Zmult x (POS xH))
-   P H 
-   x
-   (Zred_factor0 x)).
-
-Definition fast_Zopp_one :=
-[x:Z][P:Z -> Prop]
-[H : (P (Zmult x (NEG xH)))]
- (eq_ind_r Z 
-   (Zmult x (NEG xH))
-   P H 
-   (Zopp x)
-   (Zopp_one x)).
-
-Definition fast_Zmult_sym :=
-[x,y :Z][P:Z -> Prop]
-[H : (P (Zmult y x))]
- (eq_ind_r Z 
-(Zmult y x)
-   P H 
-(Zmult x y)
-   (Zmult_sym x y )).
-
-Definition fast_Zopp_Zplus :=
-[x,y :Z][P:Z -> Prop]
-[H : (P (Zplus (Zopp x) (Zopp y)) )]
- (eq_ind_r Z 
-   (Zplus (Zopp x) (Zopp y))
-   P H 
-   (Zopp (Zplus x y))
-   (Zopp_Zplus x y )).
-
-Definition fast_Zopp_Zopp :=
-[x:Z][P:Z -> Prop]
-[H : (P x )] (eq_ind_r Z x P H (Zopp (Zopp x)) (Zopp_Zopp x)).
-
-Definition fast_Zopp_Zmult_r :=
-[x,y:Z][P:Z -> Prop]
-[H : (P (Zmult x (Zopp y)))]
- (eq_ind_r Z 
-   (Zmult x (Zopp y))
-   P H 
-   (Zopp (Zmult x y))
-   (Zopp_Zmult_r x y )).
-
-Definition fast_Zmult_plus_distr :=
-[n,m,p:Z][P:Z -> Prop]
-[H : (P (Zplus (Zmult n p) (Zmult m p)))]
- (eq_ind_r Z 
-   (Zplus (Zmult n p) (Zmult m p))
-   P H 
-   (Zmult (Zplus n m) p)
-   (Zmult_plus_distr_l n m p)).
-Definition fast_Zmult_Zopp_left:=
-[x,y:Z][P:Z -> Prop]
-[H : (P (Zmult x (Zopp y)))]
- (eq_ind_r Z 
-   (Zmult x (Zopp y))
-   P H 
-   (Zmult (Zopp x) y)
-   (Zmult_Zopp_left x y)).
-
-Definition fast_Zmult_assoc_r :=
-[n,m,p :Z][P:Z -> Prop]
-[H : (P (Zmult n (Zmult m p)))]
- (eq_ind_r Z 
-   (Zmult n (Zmult m p))
-   P H 
-   (Zmult (Zmult n m) p)
-   (Zmult_assoc_r n m p)).
-
-Definition fast_Zred_factor1 :=
-[x:Z][P:Z -> Prop]
-[H : (P (Zmult x (POS (xO xH))) )]
- (eq_ind_r Z 
-   (Zmult x (POS (xO xH)))
-   P H 
-   (Zplus x x)
-   (Zred_factor1 x)).
-
-Definition fast_Zred_factor2 :=
-[x,y:Z][P:Z -> Prop]
-[H : (P (Zmult x (Zplus (POS xH) y)))]
- (eq_ind_r Z 
-   (Zmult x (Zplus (POS xH) y))
-   P H 
-   (Zplus x (Zmult x y))
-   (Zred_factor2 x y)).
-Definition fast_Zred_factor3 :=
-[x,y:Z][P:Z -> Prop]
-[H : (P (Zmult x (Zplus (POS xH) y)))]
- (eq_ind_r Z 
-   (Zmult x (Zplus (POS xH) y))
-   P H 
-   (Zplus (Zmult x y) x)
-   (Zred_factor3 x y)).
-
-Definition fast_Zred_factor4 :=
-[x,y,z:Z][P:Z -> Prop]
-[H : (P (Zmult x (Zplus y z)))]
- (eq_ind_r Z 
-   (Zmult x (Zplus y z))
-   P H 
-   (Zplus (Zmult x y) (Zmult x z))
-   (Zred_factor4 x y z)).
-
-Definition fast_Zred_factor5 :=
-[x,y:Z][P:Z -> Prop]
-[H : (P y)]
- (eq_ind_r Z 
-   y
-   P H 
-   (Zplus (Zmult x ZERO) y)
-   (Zred_factor5 x y)).
-
-Definition fast_Zred_factor6 :=
-[x :Z][P:Z -> Prop]
-[H : (P(Zplus x ZERO) )]
- (eq_ind_r Z 
-   (Zplus x ZERO)
-   P H 
-   x
-   (Zred_factor6 x )).
diff --git a/contrib7/ring/ArithRing.v b/contrib7/ring/ArithRing.v
deleted file mode 100644
index c2abc4d1..00000000
--- a/contrib7/ring/ArithRing.v
+++ /dev/null
@@ -1,81 +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        *)
-(************************************************************************)
-
-(* $Id: ArithRing.v,v 1.1.2.1 2004/07/16 19:30:18 herbelin Exp $ *)
-
-(* Instantiation of the Ring tactic for the naturals of Arith $*)
-
-Require Export Ring.
-Require Export Arith.
-Require Eqdep_dec.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Fixpoint nateq [n,m:nat] : bool :=
-  Cases n m of
-  | O O => true
-  | (S n') (S m') => (nateq n' m')
-  | _ _ => false
-  end.
-
-Lemma nateq_prop : (n,m:nat)(Is_true (nateq n m))->n==m.
-Proof.
-  Induction n; Induction m; Intros; Try Contradiction.
-  Trivial.
-  Unfold Is_true in H1.
-  Rewrite (H n1 H1).
-  Trivial.
-Save.
-
-Hints Resolve nateq_prop eq2eqT : arithring.
-
-Definition NatTheory : (Semi_Ring_Theory plus mult (1) (0) nateq).
-  Split; Intros; Auto with arith arithring.
-  Apply eq2eqT; Apply simpl_plus_l with n:=n.
-  Apply eqT2eq; Trivial.
-Defined.
-
-
-Add Semi Ring nat plus mult (1) (0) nateq NatTheory [O S].
-
-Goal (n:nat)(S n)=(plus (S O) n).
-Intro; Reflexivity.
-Save S_to_plus_one.
-
-(* Replace all occurrences of (S exp) by (plus (S O) exp), except when
-   exp is already O and only for those occurrences than can be reached by going
-   down plus and mult operations  *)
-Recursive Meta Definition S_to_plus t :=
-   Match t With 
-   | [(S O)] -> '(S O)
-   | [(S ?1)] -> Let t1 = (S_to_plus ?1) In
-                 '(plus (S O) t1)
-   | [(plus ?1 ?2)] -> Let t1 = (S_to_plus ?1) 
-                     And t2 = (S_to_plus ?2) In
-                     '(plus t1 t2)
-   | [(mult ?1 ?2)] -> Let t1 = (S_to_plus ?1)
-                     And t2 = (S_to_plus ?2) In
-                     '(mult t1 t2)
-   | [?] -> 't.
-
-(* Apply S_to_plus on both sides of an equality *)
-Tactic Definition S_to_plus_eq :=
-   Match Context With
-   | [ |- ?1 = ?2 ] -> 
-      (**) Try (**)
-      Let t1 = (S_to_plus ?1)
-      And t2 = (S_to_plus ?2) In
-        Change t1=t2
-   | [ |- ?1 == ?2 ] ->
-      (**) Try (**)
-      Let t1 = (S_to_plus ?1)
-      And t2 = (S_to_plus ?2) In
-        Change (t1==t2).
-
-Tactic Definition NatRing := S_to_plus_eq;Ring.
diff --git a/contrib7/ring/NArithRing.v b/contrib7/ring/NArithRing.v
deleted file mode 100644
index f4548bbb..00000000
--- a/contrib7/ring/NArithRing.v
+++ /dev/null
@@ -1,44 +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        *)
-(************************************************************************)
-
-(* $Id: NArithRing.v,v 1.1.2.1 2004/07/16 19:30:18 herbelin Exp $ *)
-
-(* Instantiation of the Ring tactic for the binary natural numbers *)
-
-Require Export Ring.
-Require Export ZArith_base.
-Require NArith.
-Require Eqdep_dec.
-
-Definition Neq := [n,m:entier]
-  Cases (Ncompare n m) of
-    EGAL => true
-  | _ => false
-  end.
-
-Lemma Neq_prop : (n,m:entier)(Is_true (Neq n m)) -> n=m.
-  Intros n m H; Unfold Neq in H.
-  Apply Ncompare_Eq_eq.
-  NewDestruct (Ncompare n m); [Reflexivity | Contradiction | Contradiction ].
-Save.
-
-Definition NTheory : (Semi_Ring_Theory Nplus Nmult (Pos xH) Nul Neq).
-  Split.
-    Apply Nplus_comm.
-    Apply Nplus_assoc.
-    Apply Nmult_comm.
-    Apply Nmult_assoc.
-    Apply Nplus_0_l.
-    Apply Nmult_1_l.
-    Apply Nmult_0_l.
-    Apply Nmult_plus_distr_r.
-    Apply Nplus_reg_l.
-    Apply Neq_prop.
-Save.
-
-Add Semi Ring entier Nplus Nmult (Pos xH) Nul Neq NTheory [Pos Nul xO xI xH].
diff --git a/contrib7/ring/Quote.v b/contrib7/ring/Quote.v
deleted file mode 100644
index 12a51c9f..00000000
--- a/contrib7/ring/Quote.v
+++ /dev/null
@@ -1,85 +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        *)
-(************************************************************************)
-
-(* $Id: Quote.v,v 1.1.2.1 2004/07/16 19:30:18 herbelin Exp $ *)
-
-(***********************************************************************
-  The "abstract" type index is defined to represent variables.
-
-  index : Set
-  index_eq : index -> bool
-  index_eq_prop: (n,m:index)(index_eq n m)=true -> n=m
-  index_lt : index -> bool
-  varmap : Type -> Type.	
-  varmap_find : (A:Type)A -> index -> (varmap A) -> A.
-
-  The first arg. of varmap_find is the default value to take
-  if the object is not found in the varmap.
-
-  index_lt defines a total well-founded order, but we don't prove that.
-
-***********************************************************************)
-
-Set Implicit Arguments.
-
-Section variables_map.
-
-Variable A : Type.
-
-Inductive varmap : Type :=
-  Empty_vm : varmap
-| Node_vm : A->varmap->varmap->varmap.
-
-Inductive index : Set := 
-| Left_idx : index -> index
-| Right_idx : index -> index
-| End_idx : index
-.
-
-Fixpoint varmap_find [default_value:A; i:index; v:varmap] : A :=
-  Cases i v of
-    End_idx (Node_vm x _ _) => x
-  | (Right_idx i1) (Node_vm x v1 v2) => (varmap_find default_value i1 v2)
-  | (Left_idx i1) (Node_vm x v1 v2) => (varmap_find default_value i1 v1)
-  | _ _ => default_value
-  end.
-
-Fixpoint index_eq [n,m:index] : bool :=
-  Cases n m of
-  | End_idx End_idx => true
-  | (Left_idx n') (Left_idx m') => (index_eq n' m')
-  | (Right_idx n') (Right_idx m') => (index_eq n' m')
-  | _ _ => false
-  end.
-
-Fixpoint index_lt[n,m:index] : bool :=
-  Cases n m of
-  | End_idx (Left_idx _) => true
-  | End_idx (Right_idx _) => true
-  | (Left_idx n') (Right_idx m') => true
-  | (Right_idx n') (Right_idx m') => (index_lt n' m') 
-  | (Left_idx n') (Left_idx m') => (index_lt n' m') 
-  | _ _ => false
-  end.
-
-Lemma index_eq_prop : (n,m:index)(index_eq n m)=true -> n=m.
-  Induction n; Induction m; Simpl; Intros.
-  Rewrite (H i0 H1); Reflexivity.
-  Discriminate.
-  Discriminate.
-  Discriminate.
-  Rewrite (H i0 H1); Reflexivity.
-  Discriminate.
-  Discriminate.
-  Discriminate.
-  Reflexivity.
-Save.
-
-End variables_map.
-
-Unset Implicit Arguments.
diff --git a/contrib7/ring/Ring.v b/contrib7/ring/Ring.v
deleted file mode 100644
index 860dda13..00000000
--- a/contrib7/ring/Ring.v
+++ /dev/null
@@ -1,34 +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        *)
-(************************************************************************)
-
-(* $Id: Ring.v,v 1.1.2.1 2004/07/16 19:30:18 herbelin Exp $ *)
-
-Require Export Bool.
-Require Export Ring_theory.
-Require Export Quote.
-Require Export Ring_normalize.
-Require Export Ring_abstract.
-
-(* As an example, we provide an instantation for bool. *)
-(* Other instatiations are given in ArithRing and ZArithRing in the
-   same directory *)
-
-Definition BoolTheory : (Ring_Theory xorb andb true false [b:bool]b eqb).
-Split; Simpl.
-NewDestruct n; NewDestruct m; Reflexivity.
-NewDestruct n; NewDestruct m; NewDestruct p; Reflexivity.
-NewDestruct n; NewDestruct m; Reflexivity.
-NewDestruct n; NewDestruct m; NewDestruct p; Reflexivity.
-NewDestruct n; Reflexivity.
-NewDestruct n; Reflexivity.
-NewDestruct n; Reflexivity.
-NewDestruct n; NewDestruct m; NewDestruct p; Reflexivity.
-NewDestruct x; NewDestruct y; Reflexivity Orelse Simpl; Tauto.
-Defined.
-
-Add Ring bool xorb andb true false [b:bool]b eqb BoolTheory [ true false ].
diff --git a/contrib7/ring/Ring_abstract.v b/contrib7/ring/Ring_abstract.v
deleted file mode 100644
index 55bb31da..00000000
--- a/contrib7/ring/Ring_abstract.v
+++ /dev/null
@@ -1,699 +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        *)
-(************************************************************************)
-
-(* $Id: Ring_abstract.v,v 1.1.2.1 2004/07/16 19:30:18 herbelin Exp $ *)
-
-Require Ring_theory.
-Require Quote.
-Require Ring_normalize.
-
-Section abstract_semi_rings.
-
-Inductive Type aspolynomial :=
-  ASPvar : index -> aspolynomial
-| ASP0 : aspolynomial
-| ASP1 : aspolynomial
-| ASPplus : aspolynomial -> aspolynomial -> aspolynomial
-| ASPmult : aspolynomial -> aspolynomial -> aspolynomial
-.
-
-Inductive abstract_sum : Type := 
-| Nil_acs : abstract_sum
-| Cons_acs : varlist -> abstract_sum -> abstract_sum
-.
-
-Fixpoint abstract_sum_merge [s1:abstract_sum] 
-      	 : abstract_sum -> abstract_sum :=
-Cases s1 of
-| (Cons_acs l1 t1) =>      
-     Fix asm_aux{asm_aux[s2:abstract_sum] : abstract_sum :=
-           Cases s2 of
-      	   | (Cons_acs l2 t2) =>
-	       if (varlist_lt l1 l2)
-	       then (Cons_acs l1 (abstract_sum_merge t1 s2))
-	       else (Cons_acs l2 (asm_aux t2))
-	   | Nil_acs => s1
-	   end}
-| Nil_acs => [s2]s2
-end.
-
-Fixpoint abstract_varlist_insert [l1:varlist; s2:abstract_sum] 
-      : abstract_sum :=
-  Cases s2 of
-  | (Cons_acs l2 t2) =>
-       if (varlist_lt l1 l2)
-       then (Cons_acs l1 s2)
-       else (Cons_acs l2 (abstract_varlist_insert l1 t2))
-  | Nil_acs => (Cons_acs l1 Nil_acs)
-  end.
-
-Fixpoint abstract_sum_scalar [l1:varlist; s2:abstract_sum] 
-      : abstract_sum :=
-  Cases s2 of
-  | (Cons_acs l2 t2) => (abstract_varlist_insert (varlist_merge l1 l2) 
-                                (abstract_sum_scalar l1 t2))
-  | Nil_acs => Nil_acs
-  end.
-
-Fixpoint abstract_sum_prod [s1:abstract_sum] 
-      	 : abstract_sum -> abstract_sum := 
-    [s2]Cases s1 of
-    | (Cons_acs l1 t1) =>
-	(abstract_sum_merge (abstract_sum_scalar l1 s2) 
-			     (abstract_sum_prod t1 s2))
-    | Nil_acs => Nil_acs
-    end.
-
-Fixpoint aspolynomial_normalize[p:aspolynomial] : abstract_sum :=
-  Cases p of
-  | (ASPvar i) => (Cons_acs (Cons_var i Nil_var) Nil_acs)
-  | ASP1 => (Cons_acs Nil_var Nil_acs)
-  | ASP0 => Nil_acs
-  | (ASPplus l r) => (abstract_sum_merge (aspolynomial_normalize l) 
-      	       	       	       	       	 (aspolynomial_normalize r))
-  | (ASPmult l r) => (abstract_sum_prod (aspolynomial_normalize l) 
-      	       	       	       	        (aspolynomial_normalize r))
-  end.
-
-
-
-Variable A : Type.
-Variable Aplus : A -> A -> A.
-Variable Amult : A -> A -> A.
-Variable Aone : A.
-Variable Azero : A.
-Variable Aeq : A -> A -> bool.
-Variable vm : (varmap A).
-Variable T : (Semi_Ring_Theory Aplus Amult Aone Azero Aeq).
-
-Fixpoint interp_asp [p:aspolynomial] : A :=
-  Cases p of
-  | (ASPvar i) => (interp_var Azero vm i)
-  | ASP0 => Azero
-  | ASP1 => Aone
-  | (ASPplus l r) => (Aplus (interp_asp l) (interp_asp r))
-  | (ASPmult l r) => (Amult (interp_asp l) (interp_asp r))
-  end.
-
-(* Local *) Definition iacs_aux := Fix iacs_aux{iacs_aux [a:A; s:abstract_sum] : A :=  
-  Cases s of
-  | Nil_acs => a
-  | (Cons_acs l t) => (Aplus a (iacs_aux (interp_vl Amult Aone Azero vm l) t))
-  end}.
-
-Definition interp_acs [s:abstract_sum] : A :=
-  Cases s of
-  | (Cons_acs l t) => (iacs_aux (interp_vl Amult Aone Azero vm l) t)
-  | Nil_acs => Azero
-  end.
-
-Hint SR_plus_sym_T := Resolve (SR_plus_sym T).
-Hint SR_plus_assoc_T := Resolve (SR_plus_assoc T).
-Hint SR_plus_assoc2_T := Resolve (SR_plus_assoc2 T).
-Hint SR_mult_sym_T := Resolve (SR_mult_sym T).
-Hint SR_mult_assoc_T := Resolve (SR_mult_assoc T).
-Hint SR_mult_assoc2_T := Resolve (SR_mult_assoc2 T).
-Hint SR_plus_zero_left_T := Resolve (SR_plus_zero_left T).
-Hint SR_plus_zero_left2_T := Resolve (SR_plus_zero_left2 T).
-Hint SR_mult_one_left_T := Resolve (SR_mult_one_left T).
-Hint SR_mult_one_left2_T := Resolve (SR_mult_one_left2 T).
-Hint SR_mult_zero_left_T := Resolve (SR_mult_zero_left T).
-Hint SR_mult_zero_left2_T := Resolve (SR_mult_zero_left2 T).
-Hint SR_distr_left_T := Resolve (SR_distr_left T).
-Hint SR_distr_left2_T := Resolve (SR_distr_left2 T).
-Hint SR_plus_reg_left_T := Resolve (SR_plus_reg_left T).
-Hint SR_plus_permute_T := Resolve (SR_plus_permute T).
-Hint SR_mult_permute_T := Resolve (SR_mult_permute T).
-Hint SR_distr_right_T := Resolve (SR_distr_right T).
-Hint SR_distr_right2_T := Resolve (SR_distr_right2 T).
-Hint SR_mult_zero_right_T := Resolve (SR_mult_zero_right T).
-Hint SR_mult_zero_right2_T := Resolve (SR_mult_zero_right2 T).
-Hint SR_plus_zero_right_T := Resolve (SR_plus_zero_right T).
-Hint SR_plus_zero_right2_T := Resolve (SR_plus_zero_right2 T).
-Hint SR_mult_one_right_T := Resolve (SR_mult_one_right T).
-Hint SR_mult_one_right2_T := Resolve (SR_mult_one_right2 T).
-Hint SR_plus_reg_right_T := Resolve (SR_plus_reg_right T).
-Hints Resolve refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
-Hints Immediate T.
-
-Remark iacs_aux_ok : (x:A)(s:abstract_sum)
-  (iacs_aux x s)==(Aplus x (interp_acs s)).
-Proof.
-  Induction s; Simpl; Intros.
-  Trivial.
-  Reflexivity.
-Save.
-
-Hint rew_iacs_aux : core := Extern 10 (eqT A ? ?) Rewrite iacs_aux_ok.
-
-Lemma abstract_varlist_insert_ok : (l:varlist)(s:abstract_sum)
-  (interp_acs (abstract_varlist_insert l s)) 
-   ==(Aplus (interp_vl Amult Aone Azero vm l) (interp_acs s)).
-
-  Induction s.
-  Trivial.
-
-  Simpl; Intros.
-  Elim (varlist_lt l v); Simpl.  	
-  EAuto.
-  Rewrite iacs_aux_ok.
-  Rewrite H; Auto.
-
-Save.
-
-Lemma abstract_sum_merge_ok : (x,y:abstract_sum)
-  (interp_acs (abstract_sum_merge x y))
-  ==(Aplus (interp_acs x) (interp_acs y)).
-
-Proof.  
-  Induction x.
-  Trivial.
-  Induction y; Intros.
-
-  Auto.
-
-  Simpl; Elim (varlist_lt v v0); Simpl.
-  Repeat Rewrite iacs_aux_ok.
-  Rewrite H;  Simpl; Auto.
-
-  Simpl in H0.
-  Repeat Rewrite iacs_aux_ok.
-  Rewrite H0. Simpl; Auto.
-Save.
-
-Lemma abstract_sum_scalar_ok : (l:varlist)(s:abstract_sum)
-  (interp_acs (abstract_sum_scalar l s)) 
-   == (Amult (interp_vl Amult Aone Azero vm l) (interp_acs s)).
-Proof.
-  Induction s.
-  Simpl; EAuto.
-
-  Simpl; Intros.
-  Rewrite iacs_aux_ok.
-  Rewrite abstract_varlist_insert_ok.
-  Rewrite H.
-  Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
-  Auto.
-Save.
-
-Lemma abstract_sum_prod_ok : (x,y:abstract_sum)
-  (interp_acs (abstract_sum_prod x y)) 
-   == (Amult (interp_acs x) (interp_acs y)).
-
-Proof.
-  Induction x.
-  Intros; Simpl; EAuto.
-
-  NewDestruct y; Intros.
-
-  Simpl; Rewrite H; EAuto.
-
-  Unfold abstract_sum_prod; Fold abstract_sum_prod.
-  Rewrite abstract_sum_merge_ok.
-  Rewrite abstract_sum_scalar_ok.
-  Rewrite H; Simpl; Auto.
-Save.
-
-Theorem aspolynomial_normalize_ok : (x:aspolynomial)
-	(interp_asp x)==(interp_acs (aspolynomial_normalize x)).
-Proof.
-  Induction x; Simpl; Intros; Trivial.
-  Rewrite abstract_sum_merge_ok.
-  Rewrite H; Rewrite H0; EAuto.
-  Rewrite abstract_sum_prod_ok.
-  Rewrite H; Rewrite H0; EAuto.
-Save.
-
-End abstract_semi_rings.
-
-Section abstract_rings.
-
-(* In abstract polynomials there is no constants other
-   than 0 and 1. An abstract ring is a ring whose operations plus, 
-   and mult are not functions but  constructors. In other words,
-   when c1 and c2 are closed,  (plus c1 c2) doesn't reduce to a closed
-   term. "closed" mean here "without plus and mult". *)
-
-(* this section is not parametrized by a (semi-)ring.
-   Nevertheless, they are two different types for semi-rings and rings 
-   and there will be 2 correction theorems *)
-
-Inductive Type apolynomial :=
-  APvar : index -> apolynomial
-| AP0 : apolynomial
-| AP1 : apolynomial
-| APplus : apolynomial -> apolynomial -> apolynomial
-| APmult : apolynomial -> apolynomial -> apolynomial
-| APopp : apolynomial -> apolynomial
-.
-
-(* A canonical "abstract" sum is a list of varlist with the sign "+" or "-".
-   Invariant : the list is sorted and there is no varlist is present
-   with both signs. +x +x +x -x is forbidden => the canonical form is +x+x *)
-
-Inductive signed_sum : Type := 
-| Nil_varlist : signed_sum
-| Plus_varlist : varlist -> signed_sum -> signed_sum
-| Minus_varlist : varlist -> signed_sum -> signed_sum
-.
-
-Fixpoint signed_sum_merge [s1:signed_sum] 
-      	 : signed_sum -> signed_sum :=
-Cases s1 of
-| (Plus_varlist l1 t1) =>      
-     Fix ssm_aux{ssm_aux[s2:signed_sum] : signed_sum :=
-           Cases s2 of
-      	   | (Plus_varlist l2 t2) =>
-	       if (varlist_lt l1 l2)
-	       then (Plus_varlist l1 (signed_sum_merge t1 s2))
-	       else (Plus_varlist l2 (ssm_aux t2))
-      	   | (Minus_varlist l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (signed_sum_merge t1 t2)
-	       else if (varlist_lt l1 l2)
-	       then (Plus_varlist l1 (signed_sum_merge t1 s2))
-	       else (Minus_varlist l2 (ssm_aux t2))
-	   | Nil_varlist => s1
-	   end}
-| (Minus_varlist l1 t1) =>
-     Fix ssm_aux2{ssm_aux2[s2:signed_sum] : signed_sum :=
-           Cases s2 of
-      	   | (Plus_varlist l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (signed_sum_merge t1 t2)
-	       else if (varlist_lt l1 l2)
-	       then (Minus_varlist l1 (signed_sum_merge t1 s2))
-	       else (Plus_varlist l2 (ssm_aux2 t2))
-      	   | (Minus_varlist l2 t2) =>
-	       if (varlist_lt l1 l2)
-	       then (Minus_varlist l1 (signed_sum_merge t1 s2))
-	       else (Minus_varlist l2 (ssm_aux2 t2))
-	   | Nil_varlist => s1
-	   end}
-| Nil_varlist => [s2]s2
-end.
-
-Fixpoint plus_varlist_insert [l1:varlist; s2:signed_sum] 
-      : signed_sum :=
-  Cases s2 of
-  | (Plus_varlist l2 t2) =>
-       if (varlist_lt l1 l2)
-       then (Plus_varlist l1 s2)
-       else (Plus_varlist l2 (plus_varlist_insert l1 t2))
-  | (Minus_varlist l2 t2) =>
-       if (varlist_eq l1 l2)
-       then t2
-       else if (varlist_lt l1 l2)
-       then (Plus_varlist l1 s2)
-       else (Minus_varlist l2 (plus_varlist_insert l1 t2))
-  | Nil_varlist => (Plus_varlist l1 Nil_varlist)
-  end.
-
-Fixpoint minus_varlist_insert [l1:varlist; s2:signed_sum] 
-      : signed_sum :=
-  Cases s2 of
-  | (Plus_varlist l2 t2) =>
-       if (varlist_eq l1 l2)
-       then t2
-       else if (varlist_lt l1 l2)
-       then (Minus_varlist l1 s2)
-       else (Plus_varlist l2 (minus_varlist_insert l1 t2))
-  | (Minus_varlist l2 t2) =>
-       if (varlist_lt l1 l2)
-       then (Minus_varlist l1 s2)
-       else (Minus_varlist l2 (minus_varlist_insert l1 t2))
-  | Nil_varlist => (Minus_varlist l1 Nil_varlist)
-  end.
-
-Fixpoint signed_sum_opp [s:signed_sum] : signed_sum :=
-  Cases s of
-  | (Plus_varlist l2 t2) => (Minus_varlist l2 (signed_sum_opp t2))
-  | (Minus_varlist l2 t2) => (Plus_varlist l2 (signed_sum_opp t2))
-  | Nil_varlist => Nil_varlist
-  end.
-
-
-Fixpoint plus_sum_scalar [l1:varlist; s2:signed_sum] 
-      : signed_sum :=
-  Cases s2 of
-  | (Plus_varlist l2 t2) => (plus_varlist_insert (varlist_merge l1 l2) 
-                                (plus_sum_scalar l1 t2))
-  | (Minus_varlist l2 t2) => (minus_varlist_insert (varlist_merge l1 l2) 
-                                (plus_sum_scalar l1 t2))
-  | Nil_varlist => Nil_varlist
-  end.
-
-Fixpoint minus_sum_scalar [l1:varlist; s2:signed_sum] 
-      : signed_sum :=
-  Cases s2 of
-  | (Plus_varlist l2 t2) => (minus_varlist_insert (varlist_merge l1 l2) 
-                                (minus_sum_scalar l1 t2))
-  | (Minus_varlist l2 t2) => (plus_varlist_insert (varlist_merge l1 l2) 
-                                (minus_sum_scalar l1 t2))
-  | Nil_varlist => Nil_varlist
-  end.
-
-Fixpoint signed_sum_prod [s1:signed_sum] 
-      	 : signed_sum -> signed_sum := 
-    [s2]Cases s1 of
-    | (Plus_varlist l1 t1) =>
-	(signed_sum_merge (plus_sum_scalar l1 s2) 
-			     (signed_sum_prod t1 s2))
-    | (Minus_varlist l1 t1) =>
-	(signed_sum_merge (minus_sum_scalar l1 s2) 
-			     (signed_sum_prod t1 s2))
-    | Nil_varlist => Nil_varlist
-    end.
-
-Fixpoint apolynomial_normalize[p:apolynomial] : signed_sum :=
-  Cases p of
-  | (APvar i) => (Plus_varlist (Cons_var i Nil_var) Nil_varlist)
-  | AP1 => (Plus_varlist Nil_var Nil_varlist)
-  | AP0 => Nil_varlist
-  | (APplus l r) => (signed_sum_merge (apolynomial_normalize l) 
-      	       	       	       	       	 (apolynomial_normalize r))
-  | (APmult l r) => (signed_sum_prod (apolynomial_normalize l) 
-      	       	       	       	        (apolynomial_normalize r))
-  | (APopp q) => (signed_sum_opp (apolynomial_normalize q))
-  end.
-
-
-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 vm : (varmap A).
-Variable T : (Ring_Theory Aplus Amult Aone Azero Aopp Aeq).
-
-(* Local *) Definition isacs_aux := Fix isacs_aux{isacs_aux [a:A; s:signed_sum] : A :=  
-  Cases s of
-  | Nil_varlist => a
-  | (Plus_varlist l t) => 
-	(Aplus a (isacs_aux (interp_vl Amult Aone Azero vm l) t))
-  | (Minus_varlist l t) => 
-	(Aplus a (isacs_aux (Aopp (interp_vl Amult Aone Azero vm l)) t))
-  end}.
-
-Definition interp_sacs [s:signed_sum] : A :=
-  Cases s of
-  | (Plus_varlist l t) => (isacs_aux (interp_vl Amult Aone Azero vm l) t)
-  | (Minus_varlist l t) => 
-	(isacs_aux (Aopp (interp_vl Amult Aone Azero vm l)) t)
-  | Nil_varlist => Azero
-  end.
-
-Fixpoint interp_ap [p:apolynomial] : A :=
-  Cases p of
-  | (APvar i) => (interp_var Azero vm i)
-  | AP0 => Azero
-  | AP1 => Aone
-  | (APplus l r) => (Aplus (interp_ap l) (interp_ap r))
-  | (APmult l r) => (Amult (interp_ap l) (interp_ap r))
-  | (APopp q) => (Aopp (interp_ap q))
-  end.
-
-Hint Th_plus_sym_T := Resolve (Th_plus_sym T).
-Hint Th_plus_assoc_T := Resolve (Th_plus_assoc T).
-Hint Th_plus_assoc2_T := Resolve (Th_plus_assoc2 T).
-Hint Th_mult_sym_T := Resolve (Th_mult_sym T).
-Hint Th_mult_assoc_T := Resolve (Th_mult_assoc T).
-Hint Th_mult_assoc2_T := Resolve (Th_mult_assoc2 T).
-Hint Th_plus_zero_left_T := Resolve (Th_plus_zero_left T).
-Hint Th_plus_zero_left2_T := Resolve (Th_plus_zero_left2 T).
-Hint Th_mult_one_left_T := Resolve (Th_mult_one_left T).
-Hint Th_mult_one_left2_T := Resolve (Th_mult_one_left2 T).
-Hint Th_mult_zero_left_T := Resolve (Th_mult_zero_left T).
-Hint Th_mult_zero_left2_T := Resolve (Th_mult_zero_left2 T).
-Hint Th_distr_left_T := Resolve (Th_distr_left T).
-Hint Th_distr_left2_T := Resolve (Th_distr_left2 T).
-Hint Th_plus_reg_left_T := Resolve (Th_plus_reg_left T).
-Hint Th_plus_permute_T := Resolve (Th_plus_permute T).
-Hint Th_mult_permute_T := Resolve (Th_mult_permute T).
-Hint Th_distr_right_T := Resolve (Th_distr_right T).
-Hint Th_distr_right2_T := Resolve (Th_distr_right2 T).
-Hint Th_mult_zero_right2_T := Resolve (Th_mult_zero_right2 T).
-Hint Th_plus_zero_right_T := Resolve (Th_plus_zero_right T).
-Hint Th_plus_zero_right2_T := Resolve (Th_plus_zero_right2 T).
-Hint Th_mult_one_right_T := Resolve (Th_mult_one_right T).
-Hint Th_mult_one_right2_T := Resolve (Th_mult_one_right2 T).
-Hint Th_plus_reg_right_T := Resolve (Th_plus_reg_right T).
-Hints Resolve refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
-Hints Immediate T.
-
-Lemma isacs_aux_ok : (x:A)(s:signed_sum)
-  (isacs_aux x s)==(Aplus x (interp_sacs s)).
-Proof.
-  Induction s; Simpl; Intros.
-  Trivial.
-  Reflexivity.
-  Reflexivity.
-Save.
-
-Hint rew_isacs_aux : core := Extern 10 (eqT A ? ?) Rewrite isacs_aux_ok.
-
-Tactic Definition Solve1 v v0 H H0 := 
-  Simpl; Elim (varlist_lt v v0); Simpl; Rewrite isacs_aux_ok;
-    [Rewrite H; Simpl; Auto
-    |Simpl in H0; Rewrite H0; Auto ].
-
-Lemma signed_sum_merge_ok : (x,y:signed_sum)
-  (interp_sacs (signed_sum_merge x y))
-  ==(Aplus (interp_sacs x) (interp_sacs y)).
-
-  Induction x.
-  Intro; Simpl; Auto.
-
-  Induction y; Intros.
-
-  Auto.
-
-  Solve1 v v0 H H0.
-
-  Simpl; Generalize (varlist_eq_prop v v0).
-  Elim (varlist_eq v v0); Simpl.
-
-  Intro Heq; Rewrite (Heq I).
-  Rewrite H.
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite (Th_plus_permute T). 
-  Repeat Rewrite (Th_plus_assoc T).
-  Rewrite (Th_plus_sym T (Aopp (interp_vl Amult Aone Azero vm v0))
-                         (interp_vl Amult Aone Azero vm v0)).
-  Rewrite (Th_opp_def T).
-  Rewrite (Th_plus_zero_left T).
-  Reflexivity.
-
-  Solve1 v v0 H H0.
-
-  Induction y; Intros.
-
-  Auto.
-
-  Simpl; Generalize (varlist_eq_prop v v0).
-  Elim (varlist_eq v v0); Simpl.
-
-  Intro Heq; Rewrite (Heq I).
-  Rewrite H.
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite (Th_plus_permute T). 
-  Repeat Rewrite (Th_plus_assoc T).
-  Rewrite (Th_opp_def T).
-  Rewrite (Th_plus_zero_left T).
-  Reflexivity.
-
-  Solve1 v v0 H H0.
-
-  Solve1 v v0 H H0.
-
-Save.
-
-Tactic Definition Solve2 l v H :=
- 	Elim (varlist_lt l v); Simpl; Rewrite isacs_aux_ok;
-  	[ Auto
-  	| Rewrite H; Auto ].
-
-Lemma plus_varlist_insert_ok : (l:varlist)(s:signed_sum)
-	(interp_sacs (plus_varlist_insert l s)) 
-	== (Aplus (interp_vl  Amult Aone Azero vm l) (interp_sacs s)).
-Proof.
-
-  Induction s.
-  Trivial.
-
-  Simpl; Intros.
-  Solve2 l v H.
-
-  Simpl; Intros.
-  Generalize (varlist_eq_prop l v).
-  Elim (varlist_eq l v); Simpl.
-
-  Intro Heq; Rewrite (Heq I).
-  Repeat Rewrite isacs_aux_ok.
-  Repeat Rewrite (Th_plus_assoc T).
-  Rewrite (Th_opp_def T).
-  Rewrite (Th_plus_zero_left T).
-  Reflexivity.
-
-  Solve2 l v H.
-
-Save.
-
-Lemma minus_varlist_insert_ok : (l:varlist)(s:signed_sum)
-	(interp_sacs (minus_varlist_insert l s)) 
-	== (Aplus (Aopp (interp_vl  Amult Aone Azero vm l)) (interp_sacs s)).
-Proof.
-
-  Induction s.
-  Trivial.
-
-  Simpl; Intros.
-  Generalize (varlist_eq_prop l v).
-  Elim (varlist_eq l v); Simpl.
-
-  Intro Heq; Rewrite (Heq I).
-  Repeat Rewrite isacs_aux_ok.
-  Repeat Rewrite (Th_plus_assoc T).
-  Rewrite (Th_plus_sym T (Aopp (interp_vl Amult Aone Azero vm v))
-         (interp_vl Amult Aone Azero vm v)).
-  Rewrite (Th_opp_def T).
-  Auto.
-
-  Simpl; Intros.
-  Solve2 l v H.
-
-  Simpl; Intros; Solve2 l v H.
-
-Save.
-
-Lemma signed_sum_opp_ok : (s:signed_sum)
-	(interp_sacs (signed_sum_opp s)) 
-	== (Aopp (interp_sacs s)).
-Proof.
-
-  Induction s; Simpl; Intros.
-
-  Symmetry; Apply (Th_opp_zero T).
-
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite H.
-  Rewrite (Th_plus_opp_opp T).
-  Reflexivity.
-
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite H.
-  Rewrite <- (Th_plus_opp_opp T).
-  Rewrite (Th_opp_opp T).
-  Reflexivity.
-
-Save.
-
-Lemma plus_sum_scalar_ok : (l:varlist)(s:signed_sum)
-	(interp_sacs (plus_sum_scalar l s)) 
-	== (Amult (interp_vl  Amult Aone Azero vm l) (interp_sacs s)).
-Proof.
-
-  Induction s.
-  Trivial.
-
-  Simpl; Intros.
-  Rewrite plus_varlist_insert_ok.
-  Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite H.
-  Auto.
-
-  Simpl; Intros.
-  Rewrite minus_varlist_insert_ok.
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
-  Rewrite H.
-  Rewrite (Th_distr_right T).
-  Rewrite <- (Th_opp_mult_right T).
-  Reflexivity.
-
-Save.
-
-Lemma minus_sum_scalar_ok : (l:varlist)(s:signed_sum)
-	(interp_sacs (minus_sum_scalar l s)) 
-	== (Aopp (Amult (interp_vl  Amult Aone Azero vm l) (interp_sacs s))).
-Proof.
-
-  Induction s; Simpl; Intros.
-
-  Rewrite (Th_mult_zero_right T); Symmetry; Apply (Th_opp_zero T).
-
-  Simpl; Intros.
-  Rewrite minus_varlist_insert_ok.
-  Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite H.
-  Rewrite (Th_distr_right T).
-  Rewrite (Th_plus_opp_opp T).
-  Reflexivity.
-
-  Simpl; Intros.
-  Rewrite plus_varlist_insert_ok.
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite (varlist_merge_ok A Aplus Amult Aone Azero Aeq vm T).
-  Rewrite H.
-  Rewrite (Th_distr_right T).
-  Rewrite <- (Th_opp_mult_right T).
-  Rewrite <- (Th_plus_opp_opp T).
-  Rewrite (Th_opp_opp T).
-  Reflexivity.
-
-Save.
-
-Lemma signed_sum_prod_ok : (x,y:signed_sum)
-	(interp_sacs (signed_sum_prod x y)) ==
-		(Amult (interp_sacs x) (interp_sacs y)).
-Proof.
-
-  Induction x.
-
-  Simpl; EAuto 1.
-
-  Intros; Simpl.
-  Rewrite signed_sum_merge_ok.
-  Rewrite plus_sum_scalar_ok.
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite H.
-  Auto.
-
-  Intros; Simpl.
-  Repeat Rewrite isacs_aux_ok.
-  Rewrite signed_sum_merge_ok.
-  Rewrite minus_sum_scalar_ok.
-  Rewrite H.
-  Rewrite (Th_distr_left T).
-  Rewrite (Th_opp_mult_left T).
-  Reflexivity.
-
-Save.
-
-Theorem apolynomial_normalize_ok : (p:apolynomial)
-	(interp_sacs (apolynomial_normalize p))==(interp_ap p).
-Proof.
-  Induction p; Simpl; Auto 1.
-  Intros.
-    Rewrite signed_sum_merge_ok.
-    Rewrite H; Rewrite H0; Reflexivity.
-  Intros.
-    Rewrite signed_sum_prod_ok.
-    Rewrite H; Rewrite H0; Reflexivity.
-  Intros.
-    Rewrite signed_sum_opp_ok.
-    Rewrite H; Reflexivity.
-Save.  
-
-End abstract_rings.
diff --git a/contrib7/ring/Ring_normalize.v b/contrib7/ring/Ring_normalize.v
deleted file mode 100644
index 1dbd9d56..00000000
--- a/contrib7/ring/Ring_normalize.v
+++ /dev/null
@@ -1,893 +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        *)
-(************************************************************************)
-
-(* $Id: Ring_normalize.v,v 1.1.2.1 2004/07/16 19:30:18 herbelin Exp $ *)
-
-Require Ring_theory.
-Require Quote.
-
-Set Implicit Arguments.
-
-Lemma index_eq_prop: (n,m:index)(Is_true (index_eq n m)) -> n=m.
-Proof.
-  Intros.
-  Apply Quote.index_eq_prop.
-  Generalize H.
-  Case (index_eq n m); Simpl; Trivial; Intros.
-  Contradiction.
-Save.
-
-Section semi_rings.
-
-Variable A : Type.
-Variable Aplus : A -> A -> A.
-Variable Amult : A -> A -> A.
-Variable Aone : A.
-Variable Azero : A.
-Variable Aeq : A -> A -> bool.
-
-(* Section definitions. *)
-
-
-(******************************************)
-(* Normal abtract Polynomials             *)
-(******************************************)
-(* DEFINITIONS :
-- A varlist is a sorted product of one or more variables : x, x*y*z 
-- A monom is a constant, a varlist or the product of a constant by a varlist
-  variables. 2*x*y, x*y*z, 3 are monoms : 2*3, x*3*y, 4*x*3 are NOT.
-- A canonical sum is either a monom or an ordered sum of monoms 
-  (the order on monoms is defined later) 
-- A normal polynomial it either a constant or a canonical sum or a constant
-  plus a canonical sum
-*)
-
-(* varlist is isomorphic to (list var), but we built a special inductive
-   for efficiency *)
-Inductive varlist : Type := 
-| Nil_var : varlist
-| Cons_var : index -> varlist -> varlist
-.
-
-Inductive canonical_sum : Type := 
-| Nil_monom : canonical_sum
-| Cons_monom : A -> varlist -> canonical_sum -> canonical_sum
-| Cons_varlist : varlist -> canonical_sum -> canonical_sum 
-.
-
-(* Order on monoms *)
-
-(* That's the lexicographic order on varlist, extended by : 
-  - A constant is less than every monom 
-  - The relation between two varlist is preserved by multiplication by a
-  constant.
-
-  Examples : 
-  3 < x < y
-  x*y < x*y*y*z 
-  2*x*y < x*y*y*z
-  x*y < 54*x*y*y*z
-  4*x*y < 59*x*y*y*z
-*)
-
-Fixpoint varlist_eq [x,y:varlist] : bool :=
-  Cases x y of
-  | Nil_var Nil_var => true
-  | (Cons_var i xrest) (Cons_var j yrest) => 
-        (andb (index_eq i j) (varlist_eq xrest yrest))
-  | _ _ => false
-  end.
-
-Fixpoint varlist_lt [x,y:varlist] : bool :=
-  Cases x y of 
-  | Nil_var (Cons_var _ _) => true
-  | (Cons_var i xrest) (Cons_var j yrest) => 
-      	if (index_lt i j) then true
-        else (andb (index_eq i j) (varlist_lt xrest yrest))
-  | _ _ => false
-  end.
-
-(* merges two variables lists *)
-Fixpoint varlist_merge [l1:varlist] : varlist -> varlist :=
-  Cases l1 of	
-  | (Cons_var v1 t1) => 
-      Fix vm_aux {vm_aux [l2:varlist] : varlist :=
-	Cases l2 of
-	| (Cons_var v2 t2) => 
-		     if (index_lt v1 v2)
-		     then (Cons_var v1 (varlist_merge t1 l2))
-		     else (Cons_var v2 (vm_aux t2))
-	| Nil_var => l1
-	end}
-  | Nil_var => [l2]l2
-  end.
-
-(* returns the sum of two canonical sums  *)
-Fixpoint canonical_sum_merge [s1:canonical_sum] 
-      	 : canonical_sum -> canonical_sum :=
-Cases s1 of
-| (Cons_monom c1 l1 t1) =>      
-     Fix csm_aux{csm_aux[s2:canonical_sum] : canonical_sum :=
-           Cases s2 of
-      	   | (Cons_monom c2 l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (Cons_monom (Aplus c1 c2) l1 
-      	       	       	        (canonical_sum_merge t1 t2))
-	       else if (varlist_lt l1 l2)
-	       then (Cons_monom c1 l1 (canonical_sum_merge t1 s2))
-	       else (Cons_monom c2 l2 (csm_aux t2))
-      	   | (Cons_varlist l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (Cons_monom (Aplus c1 Aone) l1 
-      	       	       	        (canonical_sum_merge t1 t2))
-	       else if (varlist_lt l1 l2)
-	       then (Cons_monom c1 l1 (canonical_sum_merge t1 s2))
-	       else (Cons_varlist l2 (csm_aux t2))
-	   | Nil_monom => s1
-	   end}
-| (Cons_varlist l1 t1) =>      
-     Fix csm_aux2{csm_aux2[s2:canonical_sum] : canonical_sum :=
-           Cases s2 of
-      	   | (Cons_monom c2 l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (Cons_monom (Aplus Aone c2) l1 
-      	       	       	        (canonical_sum_merge t1 t2))
-	       else if (varlist_lt l1 l2)
-	       then (Cons_varlist l1 (canonical_sum_merge t1 s2))
-	       else (Cons_monom c2 l2 (csm_aux2 t2))
-      	   | (Cons_varlist l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (Cons_monom (Aplus Aone Aone) l1 
-      	       	       	        (canonical_sum_merge t1 t2))
-	       else if (varlist_lt l1 l2)
-	       then (Cons_varlist l1 (canonical_sum_merge t1 s2))
-	       else (Cons_varlist l2 (csm_aux2 t2))
-	   | Nil_monom => s1
-	   end}
-| Nil_monom => [s2]s2
-end.
-
-(* Insertion of a monom in a canonical sum *)
-Fixpoint monom_insert [c1:A; l1:varlist; s2 : canonical_sum] 
-      : canonical_sum := 
-  Cases s2 of
-  | (Cons_monom c2 l2 t2) =>
-       if (varlist_eq l1 l2)
-       then (Cons_monom (Aplus c1 c2) l1 t2)
-       else if (varlist_lt l1 l2)
-       then (Cons_monom c1 l1 s2)
-       else (Cons_monom c2 l2 (monom_insert c1 l1 t2))
-  | (Cons_varlist l2 t2) =>
-       if (varlist_eq l1 l2)
-       then (Cons_monom (Aplus c1 Aone) l1 t2)
-       else if (varlist_lt l1 l2)
-       then (Cons_monom c1 l1 s2)
-       else (Cons_varlist l2 (monom_insert c1 l1 t2))
-  | Nil_monom => (Cons_monom c1 l1 Nil_monom)
-  end.
-
-Fixpoint varlist_insert [l1:varlist; s2:canonical_sum] 
-      : canonical_sum :=
-  Cases s2 of
-  | (Cons_monom c2 l2 t2) =>
-       if (varlist_eq l1 l2)
-       then (Cons_monom (Aplus Aone c2) l1 t2)
-       else if (varlist_lt l1 l2)
-       then (Cons_varlist l1 s2)
-       else (Cons_monom c2 l2 (varlist_insert l1 t2))
-  | (Cons_varlist l2 t2) =>
-       if (varlist_eq l1 l2)
-       then (Cons_monom (Aplus Aone Aone) l1 t2)
-       else if (varlist_lt l1 l2)
-       then (Cons_varlist l1 s2)
-       else (Cons_varlist l2 (varlist_insert l1 t2))
-  | Nil_monom => (Cons_varlist l1 Nil_monom)
-  end.
-
-(* Computes c0*s *)
-Fixpoint canonical_sum_scalar [c0:A; s:canonical_sum] : canonical_sum :=
-    Cases s of
-    | (Cons_monom c l t) => 
-	(Cons_monom (Amult c0 c) l (canonical_sum_scalar c0 t))
-    | (Cons_varlist l t) => 
-	(Cons_monom c0 l (canonical_sum_scalar c0 t))
-    | Nil_monom => Nil_monom
-    end.
-
-(* Computes l0*s  *)
-Fixpoint canonical_sum_scalar2 [l0:varlist; s:canonical_sum] 
-      	       	       	      : canonical_sum :=
-    Cases s of
-    | (Cons_monom c l t) => 
-      	  (monom_insert c (varlist_merge l0 l) (canonical_sum_scalar2 l0 t))
-    | (Cons_varlist l t) => 
-          (varlist_insert (varlist_merge l0 l) (canonical_sum_scalar2 l0 t))
-    | Nil_monom  => Nil_monom
-    end.
-
-(* Computes c0*l0*s  *)
-Fixpoint canonical_sum_scalar3 [c0:A;l0:varlist; s:canonical_sum] 
-      	       	       	      : canonical_sum :=
-    Cases s of
-    | (Cons_monom c l t) => 
-          (monom_insert (Amult c0 c) (varlist_merge l0 l) 
-                        (canonical_sum_scalar3 c0 l0 t))
-    | (Cons_varlist l t) => 
-      	  (monom_insert c0 (varlist_merge l0 l) 
-                          (canonical_sum_scalar3 c0 l0 t))
-    | Nil_monom  => Nil_monom
-    end.
-
-(* returns the product of two canonical sums *) 
-Fixpoint canonical_sum_prod [s1:canonical_sum] 
-      	 : canonical_sum -> canonical_sum := 
-    [s2]Cases s1 of
-    | (Cons_monom c1 l1 t1) =>
-	(canonical_sum_merge (canonical_sum_scalar3 c1 l1 s2) 
-			     (canonical_sum_prod t1 s2))
-    | (Cons_varlist l1 t1) =>
-	(canonical_sum_merge (canonical_sum_scalar2 l1 s2) 
-			     (canonical_sum_prod t1 s2))
-    | Nil_monom => Nil_monom
-    end.
-
-(* The type to represent concrete semi-ring polynomials *)
-Inductive Type spolynomial :=
-  SPvar : index -> spolynomial
-| SPconst : A -> spolynomial
-| SPplus : spolynomial -> spolynomial -> spolynomial
-| SPmult : spolynomial -> spolynomial -> spolynomial.
-
-Fixpoint spolynomial_normalize[p:spolynomial] : canonical_sum :=
-  Cases p of
-  | (SPvar i) => (Cons_varlist (Cons_var i Nil_var) Nil_monom)
-  | (SPconst c) => (Cons_monom c Nil_var Nil_monom)
-  | (SPplus l r) => (canonical_sum_merge (spolynomial_normalize l) 
-      	       	       	       	       	 (spolynomial_normalize r))
-  | (SPmult l r) => (canonical_sum_prod (spolynomial_normalize l) 
-      	       	       	       	        (spolynomial_normalize r))
-  end.
-
-(* Deletion of useless 0 and 1 in canonical sums *)
-Fixpoint canonical_sum_simplify [ s:canonical_sum] : canonical_sum :=
-  Cases s of
-  | (Cons_monom c l t) => 
-	 if (Aeq c Azero) 
-	 then (canonical_sum_simplify t)
-	 else if (Aeq c Aone)
-	 then (Cons_varlist l (canonical_sum_simplify t))
-	 else (Cons_monom c l (canonical_sum_simplify t))
-  | (Cons_varlist l t) => (Cons_varlist l (canonical_sum_simplify t))
-  | Nil_monom => Nil_monom
-  end.
-
-Definition spolynomial_simplify :=
-  [x:spolynomial](canonical_sum_simplify (spolynomial_normalize x)).
-
-(* End definitions. *)
-
-(* Section interpretation. *)
-
-(*** Here a variable map is defined and the interpetation of a spolynom
-  acording to a certain variables map. Once again the choosen definition
-  is generic and could be changed ****)
-
-Variable vm : (varmap A).
-
-(* Interpretation of list of variables 
- * [x1; ... ; xn ] is interpreted as (find v x1)* ... *(find v xn)
- * The unbound variables are mapped to 0. Normally this case sould
- * never occur. Since we want only to prove correctness theorems, which form
- * is : for any varmap and any spolynom ... this is a safe and pain-saving
- * choice *)
-Definition interp_var [i:index] := (varmap_find Azero i vm).
-
-(* Local *) Definition ivl_aux := Fix ivl_aux {ivl_aux[x:index; t:varlist] : A := 
-  Cases t of
-  | Nil_var => (interp_var x)
-  | (Cons_var x' t') => (Amult (interp_var x) (ivl_aux x' t'))
-  end}.
-
-Definition interp_vl :=  [l:varlist] 
-  Cases l of
-  | Nil_var => Aone
-  | (Cons_var x t) => (ivl_aux x t)
-  end.
-
-(* Local *) Definition interp_m := [c:A][l:varlist] 
-  Cases l of
-  | Nil_var => c
-  | (Cons_var x t) => 
-      (Amult c (ivl_aux x t))
-  end.
-
-(* Local *) Definition ics_aux := Fix ics_aux{ics_aux[a:A; s:canonical_sum] : A :=  
-  Cases s of
-  | Nil_monom => a
-  | (Cons_varlist l t) => (Aplus a (ics_aux (interp_vl l) t))
-  | (Cons_monom c l t) => (Aplus a (ics_aux (interp_m c l) t))
-  end}.
-
-(* Interpretation of a canonical sum *)
-Definition interp_cs : canonical_sum -> A  := 
-  [s]Cases s of 
-  | Nil_monom => Azero
-  | (Cons_varlist l t) =>
-      	(ics_aux (interp_vl l) t)
-  | (Cons_monom c l t) =>
-      	(ics_aux (interp_m c l) t)
-  end.
-
-Fixpoint interp_sp [p:spolynomial] : A :=
-  Cases p of
-    (SPconst c) => c
-  | (SPvar i) => (interp_var i)
-  | (SPplus p1 p2) => (Aplus (interp_sp p1) (interp_sp p2))
-  | (SPmult p1 p2) => (Amult (interp_sp p1) (interp_sp p2))
-  end.
-
-
-(* End interpretation. *)
-
-Unset Implicit Arguments.
-
-(* Section properties. *)
-
-Variable T : (Semi_Ring_Theory Aplus Amult Aone Azero Aeq).
-
-Hint SR_plus_sym_T := Resolve (SR_plus_sym T).
-Hint SR_plus_assoc_T := Resolve (SR_plus_assoc T).
-Hint SR_plus_assoc2_T := Resolve (SR_plus_assoc2 T).
-Hint SR_mult_sym_T := Resolve (SR_mult_sym T).
-Hint SR_mult_assoc_T := Resolve (SR_mult_assoc T).
-Hint SR_mult_assoc2_T := Resolve (SR_mult_assoc2 T).
-Hint SR_plus_zero_left_T := Resolve (SR_plus_zero_left T).
-Hint SR_plus_zero_left2_T := Resolve (SR_plus_zero_left2 T).
-Hint SR_mult_one_left_T := Resolve (SR_mult_one_left T).
-Hint SR_mult_one_left2_T := Resolve (SR_mult_one_left2 T).
-Hint SR_mult_zero_left_T := Resolve (SR_mult_zero_left T).
-Hint SR_mult_zero_left2_T := Resolve (SR_mult_zero_left2 T).
-Hint SR_distr_left_T := Resolve (SR_distr_left T).
-Hint SR_distr_left2_T := Resolve (SR_distr_left2 T).
-Hint SR_plus_reg_left_T := Resolve (SR_plus_reg_left T).
-Hint SR_plus_permute_T := Resolve (SR_plus_permute T).
-Hint SR_mult_permute_T := Resolve (SR_mult_permute T).
-Hint SR_distr_right_T := Resolve (SR_distr_right T).
-Hint SR_distr_right2_T := Resolve (SR_distr_right2 T).
-Hint SR_mult_zero_right_T := Resolve (SR_mult_zero_right T).
-Hint SR_mult_zero_right2_T := Resolve (SR_mult_zero_right2 T).
-Hint SR_plus_zero_right_T := Resolve (SR_plus_zero_right T).
-Hint SR_plus_zero_right2_T := Resolve (SR_plus_zero_right2 T).
-Hint SR_mult_one_right_T := Resolve (SR_mult_one_right T).
-Hint SR_mult_one_right2_T := Resolve (SR_mult_one_right2 T).
-Hint SR_plus_reg_right_T := Resolve (SR_plus_reg_right T).
-Hints Resolve refl_equal sym_equal trans_equal.
-(* Hints Resolve refl_eqT sym_eqT trans_eqT. *)
-Hints Immediate T.
-
-Lemma varlist_eq_prop : (x,y:varlist)
-  (Is_true (varlist_eq x y))->x==y.
-Proof.
-  Induction x; Induction y; Contradiction Orelse Try Reflexivity.
-  Simpl; Intros.
-  Generalize (andb_prop2 ? ? H1); Intros; Elim H2; Intros.
-  Rewrite (index_eq_prop H3); Rewrite (H v0 H4); Reflexivity.
-Save.
-
-Remark ivl_aux_ok : (v:varlist)(i:index)
-  (ivl_aux i v)==(Amult (interp_var i) (interp_vl v)).
-Proof.
-  Induction v; Simpl; Intros.
-  Trivial.
-  Rewrite H; Trivial.
-Save.
-
-Lemma varlist_merge_ok : (x,y:varlist)
-  (interp_vl (varlist_merge x y))
-  ==(Amult (interp_vl x) (interp_vl y)).
-Proof.
-  Induction x.
-  Simpl; Trivial.
-  Induction y.
-  Simpl; Trivial.
-  Simpl; Intros.
-  Elim (index_lt i i0); Simpl; Intros.
-
-  Repeat Rewrite ivl_aux_ok.
-  Rewrite H. Simpl.
-  Rewrite ivl_aux_ok.
-  EAuto.
-
-  Repeat Rewrite ivl_aux_ok.
-  Rewrite H0.
-  Rewrite ivl_aux_ok.
-  EAuto.
-Save.
-
-Remark ics_aux_ok : (x:A)(s:canonical_sum)
-  (ics_aux x s)==(Aplus x (interp_cs s)).
-Proof.
-  Induction s; Simpl; Intros.
-  Trivial.
-  Reflexivity.
-  Reflexivity.
-Save.
-
-Remark interp_m_ok : (x:A)(l:varlist)
-  (interp_m x l)==(Amult x (interp_vl l)).
-Proof.
-  NewDestruct l.
-  Simpl; Trivial.
-  Reflexivity.
-Save.
-
-Lemma canonical_sum_merge_ok : (x,y:canonical_sum)
-  (interp_cs (canonical_sum_merge x y))
-  ==(Aplus (interp_cs x) (interp_cs y)).
-
-Induction x; Simpl.
-Trivial.
-
-Induction y; Simpl; Intros.
-(* monom and nil *)
-EAuto.
-
-(* monom and monom *)
-Generalize (varlist_eq_prop v v0).
-Elim (varlist_eq v v0).
-Intros; Rewrite (H1 I).
-Simpl; Repeat Rewrite ics_aux_ok; Rewrite H.
-Repeat Rewrite interp_m_ok.
-Rewrite (SR_distr_left T).
-Repeat Rewrite <- (SR_plus_assoc T).
-Apply congr_eqT with f:=(Aplus (Amult a (interp_vl v0))).
-Trivial.
-
-Elim (varlist_lt v v0); Simpl.
-Repeat Rewrite ics_aux_ok.
-Rewrite H; Simpl; Rewrite ics_aux_ok; EAuto.
-
-Rewrite ics_aux_ok; Rewrite H0; Repeat Rewrite ics_aux_ok; Simpl; EAuto.
-
-(* monom and varlist *)
-Generalize (varlist_eq_prop v v0).
-Elim (varlist_eq v v0).
-Intros; Rewrite (H1 I).
-Simpl; Repeat Rewrite ics_aux_ok; Rewrite H.
-Repeat Rewrite interp_m_ok.
-Rewrite (SR_distr_left T).
-Repeat Rewrite <- (SR_plus_assoc T).
-Apply congr_eqT with f:=(Aplus (Amult a (interp_vl v0))).
-Rewrite (SR_mult_one_left T).
-Trivial.
-
-Elim (varlist_lt v v0); Simpl.
-Repeat Rewrite ics_aux_ok.
-Rewrite H; Simpl; Rewrite ics_aux_ok; EAuto.
-Rewrite ics_aux_ok; Rewrite H0; Repeat Rewrite ics_aux_ok; Simpl; EAuto.
-
-Induction y; Simpl; Intros.
-(* varlist and nil *)
-Trivial.
-
-(* varlist and monom *)
-Generalize (varlist_eq_prop v v0).
-Elim (varlist_eq v v0).
-Intros; Rewrite (H1 I).
-Simpl; Repeat Rewrite ics_aux_ok; Rewrite H.
-Repeat Rewrite interp_m_ok.
-Rewrite (SR_distr_left T).
-Repeat Rewrite <- (SR_plus_assoc T).
-Rewrite (SR_mult_one_left T).
-Apply congr_eqT with f:=(Aplus (interp_vl v0)).
-Trivial.
-
-Elim (varlist_lt v v0); Simpl.
-Repeat Rewrite ics_aux_ok.
-Rewrite H; Simpl; Rewrite ics_aux_ok; EAuto.
-Rewrite ics_aux_ok; Rewrite H0; Repeat Rewrite ics_aux_ok; Simpl; EAuto.
-
-(* varlist and varlist *)
-Generalize (varlist_eq_prop v v0).
-Elim (varlist_eq v v0).
-Intros; Rewrite (H1 I).
-Simpl; Repeat Rewrite ics_aux_ok; Rewrite H.
-Repeat Rewrite interp_m_ok.
-Rewrite (SR_distr_left T).
-Repeat Rewrite <- (SR_plus_assoc T).
-Rewrite (SR_mult_one_left T).
-Apply congr_eqT with f:=(Aplus (interp_vl v0)).
-Trivial.
-
-Elim (varlist_lt v v0); Simpl.
-Repeat Rewrite ics_aux_ok.
-Rewrite H; Simpl; Rewrite ics_aux_ok; EAuto.
-Rewrite ics_aux_ok; Rewrite H0; Repeat Rewrite ics_aux_ok; Simpl; EAuto.
-Save.
-
-Lemma monom_insert_ok: (a:A)(l:varlist)(s:canonical_sum)
-  (interp_cs (monom_insert a l s)) 
-  == (Aplus (Amult a (interp_vl l)) (interp_cs s)).
-Intros; Generalize s; Induction s0.
-
-Simpl; Rewrite interp_m_ok; Trivial.
-
-Simpl; Intros.
-Generalize (varlist_eq_prop  l v); Elim (varlist_eq l v).
-Intro Hr; Rewrite (Hr I); Simpl; Rewrite interp_m_ok; 
-  Repeat Rewrite ics_aux_ok; Rewrite interp_m_ok;
-  Rewrite (SR_distr_left T); EAuto.
-Elim (varlist_lt l v); Simpl; 
-[ Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; EAuto
-| Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok;
-  Rewrite H; Rewrite ics_aux_ok; EAuto].
-
-Simpl; Intros.
-Generalize (varlist_eq_prop  l v); Elim (varlist_eq l v).
-Intro Hr; Rewrite (Hr I); Simpl;  Rewrite interp_m_ok; 
-  Repeat Rewrite ics_aux_ok; 
-  Rewrite (SR_distr_left T); Rewrite (SR_mult_one_left T); EAuto.
-Elim (varlist_lt l v); Simpl; 
-[ Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; EAuto
-| Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok;
-  Rewrite H; Rewrite ics_aux_ok; EAuto].
-Save.
-
-Lemma varlist_insert_ok :
- (l:varlist)(s:canonical_sum)
-  (interp_cs (varlist_insert l s)) 
-  == (Aplus (interp_vl l) (interp_cs s)).
-Intros; Generalize s; Induction s0.
-
-Simpl; Trivial.
-
-Simpl; Intros.
-Generalize (varlist_eq_prop  l v); Elim (varlist_eq l v).
-Intro Hr; Rewrite (Hr I); Simpl; Rewrite interp_m_ok; 
-  Repeat Rewrite ics_aux_ok; Rewrite interp_m_ok;
-  Rewrite (SR_distr_left T); Rewrite (SR_mult_one_left T); EAuto.
-Elim (varlist_lt l v); Simpl; 
-[ Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; EAuto
-| Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok;
-  Rewrite H; Rewrite ics_aux_ok; EAuto].
-
-Simpl; Intros.
-Generalize (varlist_eq_prop  l v); Elim (varlist_eq l v).
-Intro Hr; Rewrite (Hr I); Simpl;  Rewrite interp_m_ok; 
-  Repeat Rewrite ics_aux_ok; 
-  Rewrite (SR_distr_left T); Rewrite (SR_mult_one_left T); EAuto.
-Elim (varlist_lt l v); Simpl; 
-[ Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok; EAuto
-| Repeat Rewrite interp_m_ok; Rewrite ics_aux_ok;
-  Rewrite H; Rewrite ics_aux_ok; EAuto].
-Save.
-
-Lemma canonical_sum_scalar_ok : (a:A)(s:canonical_sum)
-  (interp_cs (canonical_sum_scalar a s))
-  ==(Amult a (interp_cs s)).
-Induction s.
-Simpl; EAuto.
-
-Simpl; Intros.
-Repeat Rewrite ics_aux_ok.
-Repeat Rewrite interp_m_ok.
-Rewrite H.
-Rewrite (SR_distr_right T).
-Repeat Rewrite <- (SR_mult_assoc T).
-Reflexivity.
-
-Simpl; Intros.
-Repeat Rewrite ics_aux_ok.
-Repeat Rewrite interp_m_ok.
-Rewrite H.
-Rewrite (SR_distr_right T).
-Repeat Rewrite <- (SR_mult_assoc T).
-Reflexivity.
-Save.
-
-Lemma canonical_sum_scalar2_ok : (l:varlist; s:canonical_sum)
-  (interp_cs (canonical_sum_scalar2 l s))
-   ==(Amult (interp_vl l) (interp_cs s)).
-Induction s.
-Simpl; Trivial.
-
-Simpl; Intros.
-Rewrite monom_insert_ok.
-Repeat Rewrite ics_aux_ok.
-Repeat Rewrite interp_m_ok.
-Rewrite H.
-Rewrite varlist_merge_ok.
-Repeat Rewrite (SR_distr_right T). 
-Repeat Rewrite <- (SR_mult_assoc T).
-Repeat Rewrite <- (SR_plus_assoc T).
-Rewrite (SR_mult_permute T  a (interp_vl l) (interp_vl v)).
-Reflexivity.
-
-Simpl; Intros.
-Rewrite varlist_insert_ok.
-Repeat Rewrite ics_aux_ok.
-Repeat Rewrite interp_m_ok.
-Rewrite H.
-Rewrite varlist_merge_ok.
-Repeat Rewrite (SR_distr_right T). 
-Repeat Rewrite <- (SR_mult_assoc T).
-Repeat Rewrite <- (SR_plus_assoc T).
-Reflexivity.
-Save.
-
-Lemma canonical_sum_scalar3_ok : (c:A; l:varlist; s:canonical_sum)
-  (interp_cs (canonical_sum_scalar3 c l s))
-   ==(Amult c (Amult (interp_vl l) (interp_cs s))).
-Induction s.
-Simpl; Repeat Rewrite (SR_mult_zero_right T); Reflexivity.
-
-Simpl; Intros.
-Rewrite monom_insert_ok.
-Repeat Rewrite ics_aux_ok.
-Repeat Rewrite interp_m_ok.
-Rewrite H.
-Rewrite varlist_merge_ok.
-Repeat Rewrite (SR_distr_right T). 
-Repeat Rewrite <- (SR_mult_assoc T).
-Repeat Rewrite <- (SR_plus_assoc T).
-Rewrite (SR_mult_permute T  a (interp_vl l) (interp_vl v)).
-Reflexivity.
-
-Simpl; Intros.
-Rewrite monom_insert_ok.
-Repeat Rewrite ics_aux_ok.
-Repeat Rewrite interp_m_ok.
-Rewrite H.
-Rewrite varlist_merge_ok.
-Repeat Rewrite (SR_distr_right T). 
-Repeat Rewrite <- (SR_mult_assoc T).
-Repeat Rewrite <- (SR_plus_assoc T).
-Rewrite (SR_mult_permute T c (interp_vl l) (interp_vl v)).
-Reflexivity.
-Save.
-
-Lemma canonical_sum_prod_ok : (x,y:canonical_sum)
-  (interp_cs (canonical_sum_prod x y))
-  ==(Amult (interp_cs x) (interp_cs y)).
-Induction x; Simpl; Intros.
-Trivial.
-
-Rewrite canonical_sum_merge_ok.
-Rewrite canonical_sum_scalar3_ok.
-Rewrite ics_aux_ok.
-Rewrite interp_m_ok.
-Rewrite H.
-Rewrite (SR_mult_assoc T a (interp_vl v) (interp_cs y)).
-Symmetry.
-EAuto.
-
-Rewrite canonical_sum_merge_ok.
-Rewrite canonical_sum_scalar2_ok.
-Rewrite ics_aux_ok.
-Rewrite H.
-Trivial.
-Save.
-
-Theorem spolynomial_normalize_ok : (p:spolynomial)
-  (interp_cs (spolynomial_normalize p)) == (interp_sp p).
-Induction p; Simpl; Intros.
-
-Reflexivity.
-Reflexivity.
-
-Rewrite canonical_sum_merge_ok.
-Rewrite H; Rewrite H0.
-Reflexivity.
-
-Rewrite canonical_sum_prod_ok.
-Rewrite H; Rewrite H0.
-Reflexivity.
-Save.
-
-Lemma canonical_sum_simplify_ok : (s:canonical_sum)
-  (interp_cs (canonical_sum_simplify s)) == (interp_cs s).
-Induction s.
-
-Reflexivity.
-
-(* cons_monom *)
-Simpl; Intros.
-Generalize (SR_eq_prop T 8!a 9!Azero).
-Elim (Aeq a Azero).
-Intro Heq; Rewrite (Heq I).
-Rewrite H.
-Rewrite ics_aux_ok.
-Rewrite interp_m_ok.
-Rewrite (SR_mult_zero_left T).
-Trivial.
-
-Intros; Simpl.
-Generalize (SR_eq_prop T 8!a 9!Aone).
-Elim (Aeq a Aone).
-Intro Heq; Rewrite (Heq I).
-Simpl.
-Repeat Rewrite ics_aux_ok.
-Rewrite interp_m_ok.
-Rewrite H.
-Rewrite (SR_mult_one_left T).
-Reflexivity.
-
-Simpl.
-Repeat Rewrite ics_aux_ok.
-Rewrite interp_m_ok.
-Rewrite H.
-Reflexivity.
-
-(* cons_varlist *)
-Simpl; Intros.
-Repeat Rewrite ics_aux_ok.
-Rewrite H.
-Reflexivity.
-
-Save.
-
-Theorem spolynomial_simplify_ok : (p:spolynomial)
-  (interp_cs (spolynomial_simplify p)) == (interp_sp p).
-Intro.
-Unfold spolynomial_simplify.
-Rewrite canonical_sum_simplify_ok.
-Apply spolynomial_normalize_ok.
-Save.
-
-(* End properties. *)
-End semi_rings.
-
-Implicits Cons_varlist.
-Implicits Cons_monom.
-Implicits SPconst.
-Implicits SPplus.
-Implicits SPmult.
-
-Section rings.
-
-(* Here the coercion between Ring and Semi-Ring will be useful *)
-
-Set Implicit Arguments.
-
-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 vm : (varmap A).
-Variable T : (Ring_Theory Aplus Amult Aone Azero Aopp Aeq).
-
-Hint Th_plus_sym_T := Resolve (Th_plus_sym T).
-Hint Th_plus_assoc_T := Resolve (Th_plus_assoc T).
-Hint Th_plus_assoc2_T := Resolve (Th_plus_assoc2 T).
-Hint Th_mult_sym_T := Resolve (Th_mult_sym T).
-Hint Th_mult_assoc_T := Resolve (Th_mult_assoc T).
-Hint Th_mult_assoc2_T := Resolve (Th_mult_assoc2 T).
-Hint Th_plus_zero_left_T := Resolve (Th_plus_zero_left T).
-Hint Th_plus_zero_left2_T := Resolve (Th_plus_zero_left2 T).
-Hint Th_mult_one_left_T := Resolve (Th_mult_one_left T).
-Hint Th_mult_one_left2_T := Resolve (Th_mult_one_left2 T).
-Hint Th_mult_zero_left_T := Resolve (Th_mult_zero_left T).
-Hint Th_mult_zero_left2_T := Resolve (Th_mult_zero_left2 T).
-Hint Th_distr_left_T := Resolve (Th_distr_left T).
-Hint Th_distr_left2_T := Resolve (Th_distr_left2 T).
-Hint Th_plus_reg_left_T := Resolve (Th_plus_reg_left T).
-Hint Th_plus_permute_T := Resolve (Th_plus_permute T).
-Hint Th_mult_permute_T := Resolve (Th_mult_permute T).
-Hint Th_distr_right_T := Resolve (Th_distr_right T).
-Hint Th_distr_right2_T := Resolve (Th_distr_right2 T).
-Hint Th_mult_zero_right_T := Resolve (Th_mult_zero_right T).
-Hint Th_mult_zero_right2_T := Resolve (Th_mult_zero_right2 T).
-Hint Th_plus_zero_right_T := Resolve (Th_plus_zero_right T).
-Hint Th_plus_zero_right2_T := Resolve (Th_plus_zero_right2 T).
-Hint Th_mult_one_right_T := Resolve (Th_mult_one_right T).
-Hint Th_mult_one_right2_T := Resolve (Th_mult_one_right2 T).
-Hint Th_plus_reg_right_T := Resolve (Th_plus_reg_right T).
-Hints Resolve refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
-Hints Immediate T.
-
-(*** Definitions *)
-
-Inductive Type polynomial := 
-  Pvar : index -> polynomial
-| Pconst : A -> polynomial
-| Pplus : polynomial -> polynomial -> polynomial
-| Pmult : polynomial -> polynomial -> polynomial
-| Popp : polynomial -> polynomial.
-
-Fixpoint polynomial_normalize [x:polynomial] : (canonical_sum A) :=
-  Cases x of
-    (Pplus l r) => (canonical_sum_merge Aplus Aone
-      	       	       	       	(polynomial_normalize l) 
-                                (polynomial_normalize r))
-  | (Pmult l r) => (canonical_sum_prod Aplus Amult Aone 
-      	       	       	       	(polynomial_normalize l)
-                                (polynomial_normalize r))
-  | (Pconst c)  => (Cons_monom c Nil_var (Nil_monom A))
-  | (Pvar i)    => (Cons_varlist (Cons_var i Nil_var) (Nil_monom A))
-  | (Popp p)    => (canonical_sum_scalar3 Aplus Amult Aone
-                                     (Aopp Aone) Nil_var
-                                     (polynomial_normalize p))
-  end.
-
-Definition polynomial_simplify :=
-  [x:polynomial](canonical_sum_simplify Aone Azero Aeq 
-      	       	       	(polynomial_normalize x)).
-
-Fixpoint spolynomial_of [x:polynomial] : (spolynomial A) :=
-  Cases x of 
-    (Pplus l r) => (SPplus (spolynomial_of l) (spolynomial_of r))
-  | (Pmult l r) => (SPmult (spolynomial_of l) (spolynomial_of r))
-  | (Pconst c)  => (SPconst c)
-  | (Pvar i)    => (SPvar A i)
-  | (Popp p)    => (SPmult (SPconst (Aopp Aone)) (spolynomial_of p))
-  end.
-
-(*** Interpretation *)
-
-Fixpoint interp_p [p:polynomial] : A :=
-  Cases p of
-    (Pconst c)    => c
-  | (Pvar i)      => (varmap_find Azero i vm)
-  | (Pplus p1 p2) => (Aplus (interp_p p1) (interp_p p2))
-  | (Pmult p1 p2) => (Amult (interp_p p1) (interp_p p2))
-  | (Popp p1)     => (Aopp (interp_p p1))
-  end.
-
-(*** Properties *)
-
-Unset Implicit Arguments.
-
-Lemma spolynomial_of_ok : (p:polynomial)
-  (interp_p p)==(interp_sp Aplus Amult Azero vm (spolynomial_of p)).
-Induction p; Reflexivity Orelse (Simpl; Intros).
-Rewrite H; Rewrite H0; Reflexivity.
-Rewrite H; Rewrite H0; Reflexivity.
-Rewrite H.
-Rewrite (Th_opp_mult_left2 T).
-Rewrite (Th_mult_one_left T).
-Reflexivity.
-Save.
-
-Theorem polynomial_normalize_ok : (p:polynomial)
-  (polynomial_normalize p)
-  ==(spolynomial_normalize Aplus Amult Aone (spolynomial_of p)).
-Induction p; Reflexivity Orelse (Simpl; Intros).
-Rewrite H; Rewrite H0; Reflexivity.
-Rewrite H; Rewrite H0; Reflexivity.
-Rewrite H; Simpl.
-Elim (canonical_sum_scalar3 Aplus Amult Aone (Aopp Aone) Nil_var
-     (spolynomial_normalize Aplus Amult Aone (spolynomial_of p0)));
-[ Reflexivity
-| Simpl; Intros; Rewrite H0; Reflexivity
-| Simpl; Intros; Rewrite H0; Reflexivity ].
-Save.
-
-Theorem polynomial_simplify_ok : (p:polynomial)
-  (interp_cs Aplus Amult Aone Azero vm (polynomial_simplify p))
-  ==(interp_p p).
-Intro.
-Unfold polynomial_simplify.
-Rewrite spolynomial_of_ok.
-Rewrite polynomial_normalize_ok.
-Rewrite (canonical_sum_simplify_ok A Aplus Amult Aone Azero Aeq vm T).
-Rewrite (spolynomial_normalize_ok A Aplus Amult Aone Azero Aeq vm T).
-Reflexivity.
-Save.
-
-End rings.
-
-V8Infix "+" Pplus : ring_scope.
-V8Infix "*" Pmult : ring_scope.
-V8Notation "- x" := (Popp x) : ring_scope.
-V8Notation "[ x ]" := (Pvar x) (at level 1) : ring_scope.
-
-Delimits Scope ring_scope with ring.
diff --git a/contrib7/ring/Ring_theory.v b/contrib7/ring/Ring_theory.v
deleted file mode 100644
index 85fb7f6c..00000000
--- a/contrib7/ring/Ring_theory.v
+++ /dev/null
@@ -1,384 +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        *)
-(************************************************************************)
-
-(* $Id: Ring_theory.v,v 1.1.2.1 2004/07/16 19:30:19 herbelin Exp $ *)
-
-Require Export Bool.
-
-Set Implicit Arguments.
-
-Section Theory_of_semi_rings.
-
-Variable A : Type.
-Variable Aplus : A -> A -> A.
-Variable Amult : A -> A -> A.
-Variable Aone : A.
-Variable Azero : A.
-(* There is also a "weakly decidable" equality on A. That means 
-  that if (A_eq x y)=true then x=y but x=y can arise when 
-  (A_eq x y)=false. On an abstract ring the function [x,y:A]false
-  is a good choice. The proof of A_eq_prop is in this case easy. *)
-Variable Aeq : A -> A -> bool.
-
-Infix 4 "+" Aplus V8only 50 (left associativity).
-Infix 4 "*" Amult V8only 40 (left associativity).
-Notation "0" := Azero.
-Notation "1" := Aone.
-
-Record Semi_Ring_Theory : Prop :=
-{ SR_plus_sym  : (n,m:A) n + m == m + n;
-  SR_plus_assoc : (n,m,p:A) n + (m + p) == (n + m) + p;
-  SR_mult_sym : (n,m:A) n*m == m*n;
-  SR_mult_assoc : (n,m,p:A) n*(m*p) == (n*m)*p;
-  SR_plus_zero_left :(n:A) 0 + n == n;
-  SR_mult_one_left : (n:A) 1*n == n;
-  SR_mult_zero_left : (n:A) 0*n == 0;
-  SR_distr_left   : (n,m,p:A) (n + m)*p == n*p + m*p;
-  SR_plus_reg_left : (n,m,p:A) n + m == n + p -> m==p;
-  SR_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x==y
-}.
-
-Variable T : Semi_Ring_Theory.
-
-Local plus_sym  := (SR_plus_sym T).
-Local plus_assoc := (SR_plus_assoc T).
-Local mult_sym  := ( SR_mult_sym T).
-Local mult_assoc := (SR_mult_assoc T).
-Local plus_zero_left := (SR_plus_zero_left T).
-Local mult_one_left := (SR_mult_one_left T). 
-Local mult_zero_left := (SR_mult_zero_left T).
-Local distr_left := (SR_distr_left T).
-Local plus_reg_left := (SR_plus_reg_left T).
-
-Hints Resolve  plus_sym plus_assoc mult_sym mult_assoc
-  plus_zero_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 *) 
-Lemma SR_mult_assoc2 : (n,m,p:A) (n * m) * p == n * (m * p).
-Symmetry; EAuto. Qed.
-
-Lemma SR_plus_assoc2 : (n,m,p:A) (n + m) + p == n + (m + p).
-Symmetry; EAuto. Qed.
-
-Lemma SR_plus_zero_left2 : (n:A) n == 0 + n.
-Symmetry; EAuto. Qed.
-
-Lemma SR_mult_one_left2 : (n:A) n == 1*n.
-Symmetry; EAuto. Qed.
-
-Lemma SR_mult_zero_left2 : (n:A) 0 == 0*n.
-Symmetry; EAuto. Qed.
-
-Lemma SR_distr_left2 : (n,m,p:A) n*p + m*p  == (n + m)*p.
-Symmetry; EAuto. Qed.
-
-Lemma SR_plus_permute : (n,m,p:A) n + (m + p) == m + (n + p).
-Intros.
-Rewrite -> plus_assoc.
-Elim (plus_sym m n).
-Rewrite <- plus_assoc.
-Reflexivity.
-Qed.
-
-Lemma SR_mult_permute : (n,m,p:A) n*(m*p) == m*(n*p).
-Intros.
-Rewrite -> mult_assoc.
-Elim (mult_sym m n).
-Rewrite <- mult_assoc.
-Reflexivity.
-Qed.
-
-Hints Resolve SR_plus_permute SR_mult_permute.
-
-Lemma SR_distr_right : (n,m,p:A) n*(m + p) == (n*m) + (n*p).
-Intros.
-Repeat Rewrite -> (mult_sym n).
-EAuto.
-Qed.
-
-Lemma SR_distr_right2 : (n,m,p:A) (n*m) + (n*p) == n*(m + p).
-Symmetry; Apply SR_distr_right. Qed.
-
-Lemma SR_mult_zero_right : (n:A) n*0 == 0.
-Intro; Rewrite mult_sym; EAuto.
-Qed.
-
-Lemma SR_mult_zero_right2 : (n:A) 0 == n*0.
-Intro; Rewrite mult_sym; EAuto.
-Qed.
-
-Lemma SR_plus_zero_right :(n:A) n + 0 == n.
-Intro; Rewrite plus_sym; EAuto.
-Qed.
-Lemma SR_plus_zero_right2 :(n:A) n == n + 0.
-Intro; Rewrite plus_sym; EAuto.
-Qed.
-
-Lemma SR_mult_one_right : (n:A) n*1 == n.
-Intro; Elim mult_sym; Auto.
-Qed.
-
-Lemma SR_mult_one_right2 : (n:A) n == n*1.
-Intro; Elim mult_sym; Auto.
-Qed.
-
-Lemma SR_plus_reg_right : (n,m,p:A) m + n == p + n -> m==p.
-Intros n m p; Rewrite (plus_sym m n); Rewrite (plus_sym p n); EAuto.
-Qed.
-
-End Theory_of_semi_rings.
-
-Section Theory_of_rings.
-
-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.
-
-Infix 4 "+" Aplus V8only 50 (left associativity).
-Infix 4 "*" Amult V8only 40 (left associativity).
-Notation "0" := Azero.
-Notation "1" := Aone.
-Notation "- x" := (Aopp x) (at level 0) V8only.
-
-Record Ring_Theory : Prop :=
-{ Th_plus_sym  : (n,m:A) n + m == m + n;
-  Th_plus_assoc : (n,m,p:A) n + (m + p) == (n + m) + p;
-  Th_mult_sym : (n,m:A) n*m == m*n;
-  Th_mult_assoc : (n,m,p:A) n*(m*p) == (n*m)*p;
-  Th_plus_zero_left :(n:A) 0 + n == n;
-  Th_mult_one_left : (n:A) 1*n == n;
-  Th_opp_def : (n:A) n + (-n) == 0;
-  Th_distr_left : (n,m,p:A) (n + m)*p == n*p + m*p;
-  Th_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x==y
-}.
-
-Variable T : Ring_Theory.
-
-Local plus_sym  := (Th_plus_sym T).
-Local plus_assoc := (Th_plus_assoc T).
-Local mult_sym  := ( Th_mult_sym T).
-Local mult_assoc := (Th_mult_assoc T).
-Local plus_zero_left := (Th_plus_zero_left T).
-Local mult_one_left := (Th_mult_one_left T). 
-Local opp_def := (Th_opp_def T).
-Local distr_left := (Th_distr_left T).
-
-Hints Resolve plus_sym plus_assoc mult_sym mult_assoc
-  plus_zero_left mult_one_left opp_def distr_left.
-
-(* Lemmas whose form is x=y are also provided in form y=x because Auto does
-  not symmetry *) 
-Lemma Th_mult_assoc2 : (n,m,p:A) (n * m) * p == n * (m * p).
-Symmetry; EAuto. Qed.
-
-Lemma Th_plus_assoc2 : (n,m,p:A) (n + m) + p == n + (m + p).
-Symmetry; EAuto. Qed.
-
-Lemma Th_plus_zero_left2 : (n:A) n == 0 + n.
-Symmetry; EAuto. Qed.
-
-Lemma Th_mult_one_left2 : (n:A) n == 1*n.
-Symmetry; EAuto. Qed.
-
-Lemma Th_distr_left2 : (n,m,p:A) n*p + m*p  == (n + m)*p.
-Symmetry; EAuto. Qed.
-
-Lemma Th_opp_def2 : (n:A) 0 == n + (-n).
-Symmetry; EAuto. Qed.
-
-Lemma Th_plus_permute : (n,m,p:A) n + (m + p) == m + (n + p).
-Intros.
-Rewrite -> plus_assoc.
-Elim (plus_sym m n).
-Rewrite <- plus_assoc.
-Reflexivity.
-Qed.
-
-Lemma Th_mult_permute : (n,m,p:A) n*(m*p) == m*(n*p).
-Intros.
-Rewrite -> mult_assoc.
-Elim (mult_sym m n).
-Rewrite <- mult_assoc.
-Reflexivity.
-Qed.
-
-Hints Resolve Th_plus_permute Th_mult_permute.
-
-Lemma aux1 : (a:A) a + a == a -> a == 0.
-Intros.
-Generalize (opp_def a).
-Pattern 1 a.
-Rewrite <- H.
-Rewrite <- plus_assoc.
-Rewrite -> opp_def.
-Elim plus_sym.
-Rewrite plus_zero_left.
-Trivial.
-Qed.
-
-Lemma Th_mult_zero_left :(n:A) 0*n == 0.
-Intros.
-Apply aux1.
-Rewrite <- distr_left.
-Rewrite plus_zero_left.
-Reflexivity.
-Qed.
-Hints Resolve Th_mult_zero_left.
-
-Lemma Th_mult_zero_left2 : (n:A) 0 == 0*n.
-Symmetry; EAuto. Qed.
-
-Lemma aux2 : (x,y,z:A) x+y==0 -> x+z==0 -> y==z.
-Intros.
-Rewrite <- (plus_zero_left y).
-Elim H0.
-Elim plus_assoc.
-Elim (plus_sym y z).
-Rewrite -> plus_assoc.
-Rewrite -> H.
-Rewrite plus_zero_left.
-Reflexivity.
-Qed.
-
-Lemma Th_opp_mult_left : (x,y:A) -(x*y) == (-x)*y.
-Intros.
-Apply (aux2 1!x*y);
-[ Apply opp_def
-| Rewrite <- distr_left;
-  Rewrite -> opp_def;
-  Auto].
-Qed.
-Hints Resolve Th_opp_mult_left.
-
-Lemma Th_opp_mult_left2 : (x,y:A) (-x)*y == -(x*y).
-Symmetry; EAuto. Qed.
-
-Lemma Th_mult_zero_right : (n:A) n*0 == 0.
-Intro; Elim mult_sym; EAuto.
-Qed.
-
-Lemma Th_mult_zero_right2 : (n:A) 0 == n*0.
-Intro; Elim mult_sym; EAuto.
-Qed.
-
-Lemma Th_plus_zero_right :(n:A) n + 0 == n.
-Intro; Rewrite plus_sym; EAuto.
-Qed.
-
-Lemma Th_plus_zero_right2 :(n:A) n == n + 0.
-Intro; Rewrite plus_sym; EAuto.
-Qed.
-
-Lemma Th_mult_one_right : (n:A) n*1 == n.
-Intro;Elim mult_sym; EAuto.
-Qed.
-
-Lemma Th_mult_one_right2  : (n:A) n == n*1.
-Intro;Elim mult_sym; EAuto.
-Qed.
-
-Lemma Th_opp_mult_right : (x,y:A) -(x*y) == x*(-y).
-Intros; Do 2 Rewrite -> (mult_sym x); Auto.
-Qed.
-
-Lemma Th_opp_mult_right2 : (x,y:A) x*(-y) == -(x*y).
-Intros; Do 2 Rewrite -> (mult_sym x); Auto.
-Qed.
-
-Lemma Th_plus_opp_opp : (x,y:A) (-x) + (-y) == -(x+y).
-Intros.
-Apply (aux2 1! x + y);
-[ Elim plus_assoc;
-  Rewrite -> (Th_plus_permute y (-x)); Rewrite -> plus_assoc;
-  Rewrite -> opp_def;  Rewrite plus_zero_left; Auto
-| Auto ].
-Qed.
-
-Lemma Th_plus_permute_opp: (n,m,p:A) (-m)+(n+p) == n+((-m)+p).
-EAuto. Qed.
-
-Lemma Th_opp_opp : (n:A) -(-n) == n.
-Intro; Apply (aux2 1! -n); 
-  [ Auto | Elim plus_sym; Auto ].
-Qed.
-Hints Resolve Th_opp_opp.
-
-Lemma Th_opp_opp2 : (n:A) n == -(-n).
-Symmetry; EAuto. Qed.
-
-Lemma Th_mult_opp_opp : (x,y:A) (-x)*(-y) == x*y.
-Intros; Rewrite <- Th_opp_mult_left; Rewrite <- Th_opp_mult_right; Auto.
-Qed.
-
-Lemma Th_mult_opp_opp2 : (x,y:A) x*y == (-x)*(-y).
-Symmetry; Apply Th_mult_opp_opp. Qed.
-
-Lemma Th_opp_zero : -0 == 0.
-Rewrite <- (plus_zero_left (-0)).
-Auto. Qed.
-
-Lemma Th_plus_reg_left : (n,m,p:A) n + m == n + p -> m==p.
-Intros; Generalize (congr_eqT ? ? [z] (-n)+z ? ? H).
-Repeat Rewrite plus_assoc.
-Rewrite (plus_sym (-n) n).
-Rewrite opp_def.
-Repeat Rewrite Th_plus_zero_left; EAuto.
-Qed.
-
-Lemma Th_plus_reg_right : (n,m,p:A) m + n == p + n -> m==p.
-Intros.
-EApply Th_plus_reg_left with n. 
-Rewrite (plus_sym n m).
-Rewrite (plus_sym n p).
-Auto.
-Qed.
-
-Lemma Th_distr_right : (n,m,p:A)  n*(m + p) == (n*m) + (n*p).
-Intros.
-Repeat Rewrite -> (mult_sym n).
-EAuto.
-Qed.
-
-Lemma Th_distr_right2  : (n,m,p:A) (n*m) + (n*p) == n*(m + p).
-Symmetry; Apply Th_distr_right.
-Qed.
-
-End Theory_of_rings.
-
-Hints Resolve Th_mult_zero_left Th_plus_reg_left : core.
-
-Unset Implicit Arguments.
-
-Definition Semi_Ring_Theory_of :
-  (A:Type)(Aplus : A -> A -> A)(Amult : A -> A -> A)(Aone : A)
-  (Azero : A)(Aopp : A -> A)(Aeq : A -> A -> bool)
-  (Ring_Theory Aplus Amult Aone Azero Aopp Aeq)
-    ->(Semi_Ring_Theory Aplus Amult Aone Azero Aeq).
-Intros until 1; Case H.
-Split; Intros; Simpl; EAuto.
-Defined.
-
-(* Every ring can be viewed as a semi-ring : this property will be used
-  in Abstract_polynom. *)
-Coercion Semi_Ring_Theory_of : Ring_Theory >-> Semi_Ring_Theory.
-
-
-Section product_ring.
-
-End product_ring.
-
-Section power_ring.
-
-End power_ring.
diff --git a/contrib7/ring/Setoid_ring_normalize.v b/contrib7/ring/Setoid_ring_normalize.v
deleted file mode 100644
index b6b79dae..00000000
--- a/contrib7/ring/Setoid_ring_normalize.v
+++ /dev/null
@@ -1,1141 +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        *)
-(************************************************************************)
-
-(* $Id: Setoid_ring_normalize.v,v 1.1.2.1 2004/07/16 19:30:19 herbelin Exp $ *)
-
-Require Setoid_ring_theory.
-Require Quote.
-
-Set Implicit Arguments.
-
-Lemma index_eq_prop: (n,m:index)(Is_true (index_eq n m)) -> n=m.
-Proof.
-  Induction n; Induction m; Simpl; Try (Reflexivity Orelse Contradiction).
-  Intros; Rewrite (H i0); Trivial.
-  Intros; Rewrite (H i0); Trivial.
-Save.
-
-Section setoid.
-
-Variable A : Type.
-Variable Aequiv : A -> A -> Prop.
-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 S : (Setoid_Theory A Aequiv).
-
-Add Setoid A Aequiv S.
-
-Variable plus_morph : (a,a0,a1,a2:A)
- (Aequiv a a0)->(Aequiv a1 a2)->(Aequiv (Aplus a a1) (Aplus a0 a2)).
-Variable mult_morph : (a,a0,a1,a2:A)
- (Aequiv a a0)->(Aequiv a1 a2)->(Aequiv (Amult a a1) (Amult a0 a2)).
-Variable opp_morph : (a,a0:A)
- (Aequiv a a0)->(Aequiv (Aopp a) (Aopp a0)).
-
-Add Morphism Aplus : Aplus_ext.
-Exact plus_morph.
-Save.
-
-Add Morphism Amult : Amult_ext.
-Exact mult_morph.
-Save.
-
-Add Morphism Aopp : Aopp_ext.
-Exact opp_morph.
-Save.
-
-Local equiv_refl := (Seq_refl A Aequiv S).
-Local equiv_sym := (Seq_sym A Aequiv S).
-Local equiv_trans := (Seq_trans A Aequiv S).
-
-Hints Resolve equiv_refl equiv_trans.
-Hints Immediate equiv_sym.
-
-Section semi_setoid_rings.
-
-(* Section definitions. *)
-
-
-(******************************************)
-(* Normal abtract Polynomials             *)
-(******************************************)
-(* DEFINITIONS :
-- A varlist is a sorted product of one or more variables : x, x*y*z 
-- A monom is a constant, a varlist or the product of a constant by a varlist
-  variables. 2*x*y, x*y*z, 3 are monoms : 2*3, x*3*y, 4*x*3 are NOT.
-- A canonical sum is either a monom or an ordered sum of monoms 
-  (the order on monoms is defined later) 
-- A normal polynomial it either a constant or a canonical sum or a constant
-  plus a canonical sum
-*)
-
-(* varlist is isomorphic to (list var), but we built a special inductive
-   for efficiency *)
-Inductive varlist : Type := 
-| Nil_var : varlist
-| Cons_var : index -> varlist -> varlist
-.
-
-Inductive canonical_sum : Type := 
-| Nil_monom : canonical_sum
-| Cons_monom : A -> varlist -> canonical_sum -> canonical_sum
-| Cons_varlist : varlist -> canonical_sum -> canonical_sum 
-.
-
-(* Order on monoms *)
-
-(* That's the lexicographic order on varlist, extended by : 
-  - A constant is less than every monom 
-  - The relation between two varlist is preserved by multiplication by a
-  constant.
-
-  Examples : 
-  3 < x < y
-  x*y < x*y*y*z 
-  2*x*y < x*y*y*z
-  x*y < 54*x*y*y*z
-  4*x*y < 59*x*y*y*z
-*)
-
-Fixpoint varlist_eq [x,y:varlist] : bool :=
-  Cases x y of
-  | Nil_var Nil_var => true
-  | (Cons_var i xrest) (Cons_var j yrest) => 
-        (andb (index_eq i j) (varlist_eq xrest yrest))
-  | _ _ => false
-  end.
-
-Fixpoint varlist_lt [x,y:varlist] : bool :=
-  Cases x y of 
-  | Nil_var (Cons_var _ _) => true
-  | (Cons_var i xrest) (Cons_var j yrest) => 
-      	if (index_lt i j) then true
-        else (andb (index_eq i j) (varlist_lt xrest yrest))
-  | _ _ => false
-  end.
-
-(* merges two variables lists *)
-Fixpoint varlist_merge [l1:varlist] : varlist -> varlist :=
-  Cases l1 of	
-  | (Cons_var v1 t1) => 
-      Fix vm_aux {vm_aux [l2:varlist] : varlist :=
-	Cases l2 of
-	| (Cons_var v2 t2) => 
-		     if (index_lt v1 v2)
-		     then (Cons_var v1 (varlist_merge t1 l2))
-		     else (Cons_var v2 (vm_aux t2))
-	| Nil_var => l1
-	end}
-  | Nil_var => [l2]l2
-  end.
-
-(* returns the sum of two canonical sums  *)
-Fixpoint canonical_sum_merge [s1:canonical_sum] 
-      	 : canonical_sum -> canonical_sum :=
-Cases s1 of
-| (Cons_monom c1 l1 t1) =>      
-     Fix csm_aux{csm_aux[s2:canonical_sum] : canonical_sum :=
-           Cases s2 of
-      	   | (Cons_monom c2 l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (Cons_monom (Aplus c1 c2) l1 
-      	       	       	        (canonical_sum_merge t1 t2))
-	       else if (varlist_lt l1 l2)
-	       then (Cons_monom c1 l1 (canonical_sum_merge t1 s2))
-	       else (Cons_monom c2 l2 (csm_aux t2))
-      	   | (Cons_varlist l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (Cons_monom (Aplus c1 Aone) l1 
-      	       	       	        (canonical_sum_merge t1 t2))
-	       else if (varlist_lt l1 l2)
-	       then (Cons_monom c1 l1 (canonical_sum_merge t1 s2))
-	       else (Cons_varlist l2 (csm_aux t2))
-	   | Nil_monom => s1
-	   end}
-| (Cons_varlist l1 t1) =>      
-     Fix csm_aux2{csm_aux2[s2:canonical_sum] : canonical_sum :=
-           Cases s2 of
-      	   | (Cons_monom c2 l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (Cons_monom (Aplus Aone c2) l1 
-      	       	       	        (canonical_sum_merge t1 t2))
-	       else if (varlist_lt l1 l2)
-	       then (Cons_varlist l1 (canonical_sum_merge t1 s2))
-	       else (Cons_monom c2 l2 (csm_aux2 t2))
-      	   | (Cons_varlist l2 t2) =>
-      	       if (varlist_eq l1 l2)
-	       then (Cons_monom (Aplus Aone Aone) l1 
-      	       	       	        (canonical_sum_merge t1 t2))
-	       else if (varlist_lt l1 l2)
-	       then (Cons_varlist l1 (canonical_sum_merge t1 s2))
-	       else (Cons_varlist l2 (csm_aux2 t2))
-	   | Nil_monom => s1
-	   end}
-| Nil_monom => [s2]s2
-end.
-
-(* Insertion of a monom in a canonical sum *)
-Fixpoint monom_insert [c1:A; l1:varlist; s2 : canonical_sum] 
-      : canonical_sum := 
-  Cases s2 of
-  | (Cons_monom c2 l2 t2) =>
-       if (varlist_eq l1 l2)
-       then (Cons_monom (Aplus c1 c2) l1 t2)
-       else if (varlist_lt l1 l2)
-       then (Cons_monom c1 l1 s2)
-       else (Cons_monom c2 l2 (monom_insert c1 l1 t2))
-  | (Cons_varlist l2 t2) =>
-       if (varlist_eq l1 l2)
-       then (Cons_monom (Aplus c1 Aone) l1 t2)
-       else if (varlist_lt l1 l2)
-       then (Cons_monom c1 l1 s2)
-       else (Cons_varlist l2 (monom_insert c1 l1 t2))
-  | Nil_monom => (Cons_monom c1 l1 Nil_monom)
-  end.
-
-Fixpoint varlist_insert [l1:varlist; s2:canonical_sum] 
-      : canonical_sum :=
-  Cases s2 of
-  | (Cons_monom c2 l2 t2) =>
-       if (varlist_eq l1 l2)
-       then (Cons_monom (Aplus Aone c2) l1 t2)
-       else if (varlist_lt l1 l2)
-       then (Cons_varlist l1 s2)
-       else (Cons_monom c2 l2 (varlist_insert l1 t2))
-  | (Cons_varlist l2 t2) =>
-       if (varlist_eq l1 l2)
-       then (Cons_monom (Aplus Aone Aone) l1 t2)
-       else if (varlist_lt l1 l2)
-       then (Cons_varlist l1 s2)
-       else (Cons_varlist l2 (varlist_insert l1 t2))
-  | Nil_monom => (Cons_varlist l1 Nil_monom)
-  end.
-
-(* Computes c0*s *)
-Fixpoint canonical_sum_scalar [c0:A; s:canonical_sum] : canonical_sum :=
-    Cases s of
-    | (Cons_monom c l t) => 
-	(Cons_monom (Amult c0 c) l (canonical_sum_scalar c0 t))
-    | (Cons_varlist l t) => 
-	(Cons_monom c0 l (canonical_sum_scalar c0 t))
-    | Nil_monom => Nil_monom
-    end.
-
-(* Computes l0*s  *)
-Fixpoint canonical_sum_scalar2 [l0:varlist; s:canonical_sum] 
-      	       	       	      : canonical_sum :=
-    Cases s of
-    | (Cons_monom c l t) => 
-      	  (monom_insert c (varlist_merge l0 l) (canonical_sum_scalar2 l0 t))
-    | (Cons_varlist l t) => 
-          (varlist_insert (varlist_merge l0 l) (canonical_sum_scalar2 l0 t))
-    | Nil_monom  => Nil_monom
-    end.
-
-(* Computes c0*l0*s  *)
-Fixpoint canonical_sum_scalar3 [c0:A;l0:varlist; s:canonical_sum] 
-      	       	       	      : canonical_sum :=
-    Cases s of
-    | (Cons_monom c l t) => 
-          (monom_insert (Amult c0 c) (varlist_merge l0 l) 
-                        (canonical_sum_scalar3 c0 l0 t))
-    | (Cons_varlist l t) => 
-      	  (monom_insert c0 (varlist_merge l0 l) 
-                          (canonical_sum_scalar3 c0 l0 t))
-    | Nil_monom  => Nil_monom
-    end.
-
-(* returns the product of two canonical sums *) 
-Fixpoint canonical_sum_prod [s1:canonical_sum] 
-      	 : canonical_sum -> canonical_sum := 
-    [s2]Cases s1 of
-    | (Cons_monom c1 l1 t1) =>
-	(canonical_sum_merge (canonical_sum_scalar3 c1 l1 s2) 
-			     (canonical_sum_prod t1 s2))
-    | (Cons_varlist l1 t1) =>
-	(canonical_sum_merge (canonical_sum_scalar2 l1 s2) 
-			     (canonical_sum_prod t1 s2))
-    | Nil_monom => Nil_monom
-    end.
-
-(* The type to represent concrete semi-setoid-ring polynomials *)
-
-Inductive Type setspolynomial :=
-  SetSPvar : index -> setspolynomial
-| SetSPconst : A -> setspolynomial
-| SetSPplus : setspolynomial -> setspolynomial -> setspolynomial
-| SetSPmult : setspolynomial -> setspolynomial -> setspolynomial.
-
-Fixpoint setspolynomial_normalize [p:setspolynomial] : canonical_sum :=
- Cases p of
- | (SetSPplus l r) => (canonical_sum_merge (setspolynomial_normalize l) (setspolynomial_normalize r))
- | (SetSPmult l r) => (canonical_sum_prod (setspolynomial_normalize l) (setspolynomial_normalize r))
- | (SetSPconst c)  => (Cons_monom c Nil_var Nil_monom)
- | (SetSPvar i)    => (Cons_varlist (Cons_var i Nil_var) Nil_monom)
- end.
-
-Fixpoint canonical_sum_simplify [ s:canonical_sum] : canonical_sum :=
-  Cases s of
-  | (Cons_monom c l t) => 
-	 if (Aeq c Azero) 
-	 then (canonical_sum_simplify t)
-	 else if (Aeq c Aone)
-	 then (Cons_varlist l (canonical_sum_simplify t))
-	 else (Cons_monom c l (canonical_sum_simplify t))
-  | (Cons_varlist l t) => (Cons_varlist l (canonical_sum_simplify t))
-  | Nil_monom => Nil_monom
-  end.
-
-Definition setspolynomial_simplify :=
-  [x:setspolynomial] (canonical_sum_simplify (setspolynomial_normalize x)).
-
-Variable vm : (varmap A).
-
-Definition interp_var [i:index] := (varmap_find Azero i vm).
-
-Definition ivl_aux := Fix ivl_aux {ivl_aux[x:index; t:varlist] : A := 
-  Cases t of
-  | Nil_var => (interp_var x)
-  | (Cons_var x' t') => (Amult (interp_var x) (ivl_aux x' t'))
-  end}.
-
-Definition interp_vl :=  [l:varlist] 
-  Cases l of
-  | Nil_var => Aone
-  | (Cons_var x t) => (ivl_aux x t)
-  end.
-
-Definition interp_m := [c:A][l:varlist] 
-  Cases l of
-  | Nil_var => c
-  | (Cons_var x t) => 
-      (Amult c (ivl_aux x t))
-  end.
-
-Definition ics_aux := Fix ics_aux{ics_aux[a:A; s:canonical_sum] : A :=  
-  Cases s of
-  | Nil_monom => a
-  | (Cons_varlist l t) => (Aplus a (ics_aux (interp_vl l) t))
-  | (Cons_monom c l t) => (Aplus a (ics_aux (interp_m c l) t))
-  end}.
-
-Definition interp_setcs : canonical_sum -> A  := 
-  [s]Cases s of 
-  | Nil_monom => Azero
-  | (Cons_varlist l t) =>
-      	(ics_aux (interp_vl l) t)
-  | (Cons_monom c l t) =>
-      	(ics_aux (interp_m c l) t)
-  end.
-
-Fixpoint interp_setsp [p:setspolynomial] : A :=
- Cases p of
- | (SetSPconst c) => c
- | (SetSPvar i) => (interp_var i)
- | (SetSPplus p1 p2) => (Aplus (interp_setsp p1) (interp_setsp p2))
- | (SetSPmult p1 p2) => (Amult (interp_setsp p1) (interp_setsp p2))
- end.
-
-(* End interpretation. *)
-
-Unset Implicit Arguments.
-
-(* Section properties. *)
-
-Variable T : (Semi_Setoid_Ring_Theory Aequiv Aplus Amult Aone Azero Aeq).
-
-Hint SSR_plus_sym_T := Resolve (SSR_plus_sym T).
-Hint SSR_plus_assoc_T := Resolve (SSR_plus_assoc T).
-Hint SSR_plus_assoc2_T := Resolve (SSR_plus_assoc2 S T).
-Hint SSR_mult_sym_T := Resolve (SSR_mult_sym T).
-Hint SSR_mult_assoc_T := Resolve (SSR_mult_assoc T).
-Hint SSR_mult_assoc2_T := Resolve (SSR_mult_assoc2 S T).
-Hint SSR_plus_zero_left_T := Resolve (SSR_plus_zero_left T).
-Hint SSR_plus_zero_left2_T := Resolve (SSR_plus_zero_left2 S T).
-Hint SSR_mult_one_left_T := Resolve (SSR_mult_one_left T).
-Hint SSR_mult_one_left2_T := Resolve (SSR_mult_one_left2 S T).
-Hint SSR_mult_zero_left_T := Resolve (SSR_mult_zero_left T).
-Hint SSR_mult_zero_left2_T := Resolve (SSR_mult_zero_left2 S T).
-Hint SSR_distr_left_T := Resolve (SSR_distr_left T).
-Hint SSR_distr_left2_T := Resolve (SSR_distr_left2 S T).
-Hint SSR_plus_reg_left_T := Resolve (SSR_plus_reg_left T).
-Hint SSR_plus_permute_T := Resolve (SSR_plus_permute S plus_morph T).
-Hint SSR_mult_permute_T := Resolve (SSR_mult_permute S mult_morph T).
-Hint SSR_distr_right_T := Resolve (SSR_distr_right S plus_morph T).
-Hint SSR_distr_right2_T := Resolve (SSR_distr_right2 S plus_morph T).
-Hint SSR_mult_zero_right_T := Resolve (SSR_mult_zero_right S T).
-Hint SSR_mult_zero_right2_T := Resolve (SSR_mult_zero_right2 S T).
-Hint SSR_plus_zero_right_T := Resolve (SSR_plus_zero_right S T).
-Hint SSR_plus_zero_right2_T := Resolve (SSR_plus_zero_right2 S T).
-Hint SSR_mult_one_right_T := Resolve (SSR_mult_one_right S T).
-Hint SSR_mult_one_right2_T := Resolve (SSR_mult_one_right2 S T).
-Hint SSR_plus_reg_right_T := Resolve (SSR_plus_reg_right S T).
-Hints Resolve refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
-Hints Immediate T.
-
-Lemma varlist_eq_prop : (x,y:varlist)
-  (Is_true (varlist_eq x y))->x==y.
-Proof.
-  Induction x; Induction y; Contradiction Orelse Try Reflexivity.
-  Simpl; Intros.
-  Generalize (andb_prop2 ? ? H1); Intros; Elim H2; Intros.
-  Rewrite (index_eq_prop H3); Rewrite (H v0 H4); Reflexivity.
-Save.
-
-Remark ivl_aux_ok : (v:varlist)(i:index)
-  (Aequiv (ivl_aux i v) (Amult (interp_var i) (interp_vl v))).
-Proof.
-  Induction v; Simpl; Intros.
-  Trivial.
-  Rewrite (H i); Trivial.
-Save.
-
-Lemma varlist_merge_ok : (x,y:varlist)
-  (Aequiv (interp_vl (varlist_merge x y)) (Amult (interp_vl x) (interp_vl y))).
-Proof.
-  Induction x.
-  Simpl; Trivial.
-  Induction y.
-  Simpl; Trivial.
-  Simpl; Intros.
-  Elim (index_lt i i0); Simpl; Intros.
-
-  Rewrite (ivl_aux_ok v i).
-  Rewrite (ivl_aux_ok v0 i0).
-  Rewrite (ivl_aux_ok (varlist_merge v (Cons_var i0 v0)) i).
-  Rewrite (H (Cons_var i0 v0)).
-  Simpl.
-  Rewrite (ivl_aux_ok v0 i0).
-  EAuto.
-
-  Rewrite (ivl_aux_ok v i).
-  Rewrite (ivl_aux_ok v0 i0).
-  Rewrite (ivl_aux_ok
-                 (Fix vm_aux
-                    {vm_aux [l2:varlist] : varlist :=
-                       Cases (l2) of
-                         Nil_var => (Cons_var i v)
-                       | (Cons_var v2 t2) => 
-                          (if (index_lt i v2)
-                           then (Cons_var i (varlist_merge v l2))
-                           else (Cons_var v2 (vm_aux t2)))
-                       end} v0) i0).
-  Rewrite H0.
-  Rewrite (ivl_aux_ok v i).
-  EAuto.
-Save.
-
-Remark ics_aux_ok : (x:A)(s:canonical_sum)
-  (Aequiv (ics_aux x s) (Aplus x (interp_setcs s))).
-Proof.
- Induction s; Simpl; Intros;Trivial.
-Save.
-
-Remark interp_m_ok : (x:A)(l:varlist)
-  (Aequiv (interp_m x l) (Amult x (interp_vl l))).
-Proof.
-  NewDestruct l;Trivial.
-Save.
-
-Hint ivl_aux_ok_ := Resolve ivl_aux_ok.
-Hint ics_aux_ok_ := Resolve ics_aux_ok.
-Hint interp_m_ok_ := Resolve interp_m_ok.
-
-(* Hints Resolve ivl_aux_ok ics_aux_ok interp_m_ok. *)
-
-Lemma canonical_sum_merge_ok : (x,y:canonical_sum)
-  (Aequiv (interp_setcs (canonical_sum_merge x y))
-  (Aplus (interp_setcs x) (interp_setcs y))).
-Proof.
-Induction x; Simpl.
-Trivial.
-
-Induction y; Simpl; Intros.
-EAuto.
-
-Generalize (varlist_eq_prop v v0).
-Elim (varlist_eq v v0).
-Intros; Rewrite (H1 I).
-Simpl.
-Rewrite (ics_aux_ok (interp_m a v0) c).
-Rewrite (ics_aux_ok (interp_m a0 v0) c0).
-Rewrite (ics_aux_ok (interp_m (Aplus a a0) v0)
-                 (canonical_sum_merge c c0)).
-Rewrite (H c0).
-Rewrite (interp_m_ok (Aplus a a0) v0).
-Rewrite (interp_m_ok a v0).
-Rewrite (interp_m_ok a0 v0).
-Setoid_replace (Amult (Aplus a a0) (interp_vl v0))
- with (Aplus (Amult a (interp_vl v0)) (Amult a0 (interp_vl v0))).
-Setoid_replace (Aplus
-                 (Aplus (Amult a (interp_vl v0))
-                   (Amult a0 (interp_vl v0)))
-                 (Aplus (interp_setcs c) (interp_setcs c0)))
- with (Aplus (Amult a (interp_vl v0))
-        (Aplus (Amult a0 (interp_vl v0))
-          (Aplus (interp_setcs c) (interp_setcs c0)))).
-Setoid_replace (Aplus (Aplus (Amult a (interp_vl v0)) (interp_setcs c))
-                 (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0)))
- with (Aplus (Amult a (interp_vl v0))
-        (Aplus (interp_setcs c)
-          (Aplus (Amult a0 (interp_vl v0)) (interp_setcs c0)))).
-Auto.
-
-Elim (varlist_lt v v0); Simpl.
-Intro.
-Rewrite (ics_aux_ok (interp_m a v)
-                 (canonical_sum_merge c (Cons_monom a0 v0 c0))).
-Rewrite (ics_aux_ok (interp_m a v) c).
-Rewrite (ics_aux_ok (interp_m a0 v0) c0).
-Rewrite (H (Cons_monom a0 v0 c0)); Simpl.
-Rewrite (ics_aux_ok (interp_m a0 v0) c0); Auto.
-
-Intro.
-Rewrite (ics_aux_ok (interp_m a0 v0)
-                 (Fix csm_aux
-                    {csm_aux [s2:canonical_sum] : canonical_sum :=
-                       Cases (s2) of
-                         Nil_monom => (Cons_monom a v c)
-                       | (Cons_monom c2 l2 t2) => 
-                          (if (varlist_eq v l2)
-                           then
-                            (Cons_monom (Aplus a c2) v
-                              (canonical_sum_merge c t2))
-                           else
-                            (if (varlist_lt v l2)
-                             then
-                              (Cons_monom a v
-                                (canonical_sum_merge c s2))
-                             else (Cons_monom c2 l2 (csm_aux t2))))
-                       | (Cons_varlist l2 t2) => 
-                          (if (varlist_eq v l2)
-                           then
-                            (Cons_monom (Aplus a Aone) v
-                              (canonical_sum_merge c t2))
-                           else
-                            (if (varlist_lt v l2)
-                             then
-                              (Cons_monom a v
-                                (canonical_sum_merge c s2))
-                             else (Cons_varlist l2 (csm_aux t2))))
-                       end} c0)).
-Rewrite H0.
-Rewrite (ics_aux_ok (interp_m a v) c);
-Rewrite (ics_aux_ok (interp_m a0 v0) c0); Simpl; Auto.
-
-Generalize (varlist_eq_prop v v0).
-Elim (varlist_eq v v0).
-Intros; Rewrite (H1 I).
-Simpl.
-Rewrite (ics_aux_ok (interp_m (Aplus a Aone) v0)
-                 (canonical_sum_merge c c0));
-Rewrite (ics_aux_ok (interp_m a v0) c);
-Rewrite (ics_aux_ok (interp_vl v0) c0).
-Rewrite (H c0).
-Rewrite (interp_m_ok (Aplus a Aone) v0).
-Rewrite (interp_m_ok a v0).
-Setoid_replace (Amult (Aplus a Aone) (interp_vl v0))
- with (Aplus (Amult a (interp_vl v0)) (Amult Aone (interp_vl v0))).
-Setoid_replace (Aplus
-                 (Aplus (Amult a (interp_vl v0))
-                   (Amult Aone (interp_vl v0)))
-                 (Aplus (interp_setcs c) (interp_setcs c0)))
- with (Aplus (Amult a (interp_vl v0))
-        (Aplus (Amult Aone (interp_vl v0))
-          (Aplus (interp_setcs c) (interp_setcs c0)))).
-Setoid_replace (Aplus (Aplus (Amult a (interp_vl v0)) (interp_setcs c))
-                 (Aplus (interp_vl v0) (interp_setcs c0)))
- with (Aplus (Amult a (interp_vl v0))
-        (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0)))).
-Setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0).
-Auto.
-
-Elim (varlist_lt v v0); Simpl.
-Intro.
-Rewrite (ics_aux_ok (interp_m a v)
-                 (canonical_sum_merge c (Cons_varlist v0 c0)));
-Rewrite (ics_aux_ok (interp_m a v) c);
-Rewrite (ics_aux_ok (interp_vl v0) c0).
-Rewrite (H (Cons_varlist v0 c0)); Simpl.
-Rewrite (ics_aux_ok (interp_vl v0) c0).
-Auto.
-
-Intro.
-Rewrite (ics_aux_ok (interp_vl v0)
-                 (Fix csm_aux
-                    {csm_aux [s2:canonical_sum] : canonical_sum :=
-                       Cases (s2) of
-                         Nil_monom => (Cons_monom a v c)
-                       | (Cons_monom c2 l2 t2) => 
-                          (if (varlist_eq v l2)
-                           then
-                            (Cons_monom (Aplus a c2) v
-                              (canonical_sum_merge c t2))
-                           else
-                            (if (varlist_lt v l2)
-                             then
-                              (Cons_monom a v
-                                (canonical_sum_merge c s2))
-                             else (Cons_monom c2 l2 (csm_aux t2))))
-                       | (Cons_varlist l2 t2) => 
-                          (if (varlist_eq v l2)
-                           then
-                            (Cons_monom (Aplus a Aone) v
-                              (canonical_sum_merge c t2))
-                           else
-                            (if (varlist_lt v l2)
-                             then
-                              (Cons_monom a v
-                                (canonical_sum_merge c s2))
-                             else (Cons_varlist l2 (csm_aux t2))))
-                       end} c0)); Rewrite H0.
-Rewrite (ics_aux_ok (interp_m a v) c);
-Rewrite (ics_aux_ok (interp_vl v0) c0); Simpl.
-Auto.
-
-Induction y; Simpl; Intros.
-Trivial.
-
-Generalize (varlist_eq_prop v v0).
-Elim (varlist_eq v v0).
-Intros; Rewrite (H1 I).
-Simpl.
-Rewrite (ics_aux_ok (interp_m (Aplus Aone a) v0)
-                 (canonical_sum_merge c c0));
-Rewrite (ics_aux_ok (interp_vl v0) c);
-Rewrite (ics_aux_ok (interp_m a v0) c0); Rewrite (
-H c0).
-Rewrite (interp_m_ok (Aplus Aone a) v0);
-Rewrite (interp_m_ok a v0).
-Setoid_replace (Amult (Aplus Aone a) (interp_vl v0))
- with (Aplus (Amult Aone (interp_vl v0)) (Amult a (interp_vl v0)));
-Setoid_replace (Aplus
-                 (Aplus (Amult Aone (interp_vl v0))
-                   (Amult a (interp_vl v0)))
-                 (Aplus (interp_setcs c) (interp_setcs c0)))
- with (Aplus (Amult Aone (interp_vl v0))
-        (Aplus (Amult a (interp_vl v0))
-          (Aplus (interp_setcs c) (interp_setcs c0))));
-Setoid_replace (Aplus (Aplus (interp_vl v0) (interp_setcs c))
-                 (Aplus (Amult a (interp_vl v0)) (interp_setcs c0)))
- with (Aplus (interp_vl v0)
-        (Aplus (interp_setcs c)
-          (Aplus (Amult a (interp_vl v0)) (interp_setcs c0)))).
-Auto.
-
-Elim (varlist_lt v v0); Simpl; Intros.
-Rewrite (ics_aux_ok (interp_vl v)
-                 (canonical_sum_merge c (Cons_monom a v0 c0)));
-Rewrite (ics_aux_ok (interp_vl v) c);
-Rewrite (ics_aux_ok (interp_m a v0) c0).
-Rewrite (H (Cons_monom a v0 c0)); Simpl.
-Rewrite (ics_aux_ok (interp_m a v0) c0); Auto.
-
-Rewrite (ics_aux_ok (interp_m a v0)
-                 (Fix csm_aux2
-                    {csm_aux2 [s2:canonical_sum] : canonical_sum :=
-                       Cases (s2) of
-                         Nil_monom => (Cons_varlist v c)
-                       | (Cons_monom c2 l2 t2) => 
-                          (if (varlist_eq v l2)
-                           then
-                            (Cons_monom (Aplus Aone c2) v
-                              (canonical_sum_merge c t2))
-                           else
-                            (if (varlist_lt v l2)
-                             then
-                              (Cons_varlist v
-                                (canonical_sum_merge c s2))
-                             else (Cons_monom c2 l2 (csm_aux2 t2))))
-                       | (Cons_varlist l2 t2) => 
-                          (if (varlist_eq v l2)
-                           then
-                            (Cons_monom (Aplus Aone Aone) v
-                              (canonical_sum_merge c t2))
-                           else
-                            (if (varlist_lt v l2)
-                             then
-                              (Cons_varlist v
-                                (canonical_sum_merge c s2))
-                             else (Cons_varlist l2 (csm_aux2 t2))))
-                       end} c0)); Rewrite H0.
-Rewrite (ics_aux_ok (interp_vl v) c);
-Rewrite (ics_aux_ok (interp_m a v0) c0); Simpl; Auto.
-
-Generalize (varlist_eq_prop v v0).
-Elim (varlist_eq v v0); Intros.
-Rewrite (H1 I); Simpl.
-Rewrite (ics_aux_ok (interp_m (Aplus Aone Aone) v0)
-                 (canonical_sum_merge c c0));
-Rewrite (ics_aux_ok (interp_vl v0) c);
-Rewrite (ics_aux_ok (interp_vl v0) c0); Rewrite (
-H c0).
-Rewrite (interp_m_ok (Aplus Aone Aone) v0).
-Setoid_replace (Amult (Aplus Aone Aone) (interp_vl v0))
- with (Aplus (Amult Aone (interp_vl v0)) (Amult Aone (interp_vl v0)));
-Setoid_replace (Aplus
-                 (Aplus (Amult Aone (interp_vl v0))
-                   (Amult Aone (interp_vl v0)))
-                 (Aplus (interp_setcs c) (interp_setcs c0)))
- with (Aplus (Amult Aone (interp_vl v0))
-        (Aplus (Amult Aone (interp_vl v0))
-          (Aplus (interp_setcs c) (interp_setcs c0))));
-Setoid_replace (Aplus (Aplus (interp_vl v0) (interp_setcs c))
-                 (Aplus (interp_vl v0) (interp_setcs c0)))
- with (Aplus (interp_vl v0)
-        (Aplus (interp_setcs c) (Aplus (interp_vl v0) (interp_setcs c0)))).
-Setoid_replace (Amult Aone (interp_vl v0)) with (interp_vl v0); Auto.
-
-Elim (varlist_lt v v0); Simpl.
-Rewrite (ics_aux_ok (interp_vl v)
-                 (canonical_sum_merge c (Cons_varlist v0 c0)));
-Rewrite (ics_aux_ok (interp_vl v) c);
-Rewrite (ics_aux_ok (interp_vl v0) c0);
-Rewrite (H (Cons_varlist v0 c0)); Simpl.
-Rewrite (ics_aux_ok (interp_vl v0) c0); Auto.
-
-Rewrite (ics_aux_ok (interp_vl v0)
-                 (Fix csm_aux2
-                    {csm_aux2 [s2:canonical_sum] : canonical_sum :=
-                       Cases (s2) of
-                         Nil_monom => (Cons_varlist v c)
-                       | (Cons_monom c2 l2 t2) => 
-                          (if (varlist_eq v l2)
-                           then
-                            (Cons_monom (Aplus Aone c2) v
-                              (canonical_sum_merge c t2))
-                           else
-                            (if (varlist_lt v l2)
-                             then
-                              (Cons_varlist v
-                                (canonical_sum_merge c s2))
-                             else (Cons_monom c2 l2 (csm_aux2 t2))))
-                       | (Cons_varlist l2 t2) => 
-                          (if (varlist_eq v l2)
-                           then
-                            (Cons_monom (Aplus Aone Aone) v
-                              (canonical_sum_merge c t2))
-                           else
-                            (if (varlist_lt v l2)
-                             then
-                              (Cons_varlist v
-                                (canonical_sum_merge c s2))
-                             else (Cons_varlist l2 (csm_aux2 t2))))
-                       end} c0)); Rewrite H0.
-Rewrite (ics_aux_ok (interp_vl v) c);
-Rewrite (ics_aux_ok (interp_vl v0) c0); Simpl; Auto.
-Save.
-
-Lemma monom_insert_ok: (a:A)(l:varlist)(s:canonical_sum)
- (Aequiv (interp_setcs (monom_insert a l s)) 
-   (Aplus (Amult a (interp_vl l)) (interp_setcs s))).
-Proof.
-Induction s; Intros.
-Simpl; Rewrite (interp_m_ok a l); Trivial.
-
-Simpl; Generalize (varlist_eq_prop l v); Elim (varlist_eq l v).
-Intro Hr; Rewrite (Hr I); Simpl.
-Rewrite (ics_aux_ok (interp_m (Aplus a a0) v) c);
-Rewrite (ics_aux_ok (interp_m a0 v) c).
-Rewrite (interp_m_ok (Aplus a a0) v);
-Rewrite (interp_m_ok a0 v).
-Setoid_replace (Amult (Aplus a a0) (interp_vl v))
- with (Aplus (Amult a (interp_vl v)) (Amult a0 (interp_vl v))).
-Auto.
-
-Elim (varlist_lt l v); Simpl; Intros.
-Rewrite (ics_aux_ok (interp_m a0 v) c).
-Rewrite (interp_m_ok a0 v); Rewrite (interp_m_ok a l).
-Auto.
-
-Rewrite (ics_aux_ok (interp_m a0 v) (monom_insert a l c));
-Rewrite (ics_aux_ok (interp_m a0 v) c); Rewrite H.
-Auto.
-
-Simpl.
-Generalize (varlist_eq_prop l v); Elim (varlist_eq l v).
-Intro Hr; Rewrite (Hr I); Simpl.
-Rewrite (ics_aux_ok (interp_m (Aplus a Aone) v) c);
-Rewrite (ics_aux_ok (interp_vl v) c).
-Rewrite (interp_m_ok (Aplus a Aone) v).
-Setoid_replace (Amult (Aplus a Aone) (interp_vl v))
- with (Aplus (Amult a (interp_vl v)) (Amult Aone (interp_vl v))).
-Setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v).
-Auto.
-
-Elim (varlist_lt l v); Simpl; Intros; Auto.
-Rewrite (ics_aux_ok (interp_vl v) (monom_insert a l c));
-Rewrite H.
-Rewrite (ics_aux_ok (interp_vl v) c); Auto.
-Save.
-
-Lemma varlist_insert_ok :
- (l:varlist)(s:canonical_sum)
- (Aequiv (interp_setcs (varlist_insert l s)) 
-   (Aplus (interp_vl l) (interp_setcs s))).
-Proof.
-Induction s; Simpl; Intros.
-Trivial.
-
-Generalize (varlist_eq_prop l v); Elim (varlist_eq l v).
-Intro Hr; Rewrite (Hr I); Simpl.
-Rewrite (ics_aux_ok (interp_m (Aplus Aone a) v) c);
-Rewrite (ics_aux_ok (interp_m a v) c).
-Rewrite (interp_m_ok (Aplus Aone a) v);
-Rewrite (interp_m_ok a v).
-Setoid_replace (Amult (Aplus Aone a) (interp_vl v))
- with (Aplus (Amult Aone (interp_vl v)) (Amult a (interp_vl v))).
-Setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); Auto.
-
-Elim (varlist_lt l v); Simpl; Intros; Auto.
-Rewrite (ics_aux_ok (interp_m a v) (varlist_insert l c));
-Rewrite (ics_aux_ok (interp_m a v) c).
-Rewrite (interp_m_ok a v).
-Rewrite H; Auto.
-
-Generalize (varlist_eq_prop l v); Elim (varlist_eq l v).
-Intro Hr; Rewrite (Hr I); Simpl.
-Rewrite (ics_aux_ok (interp_m (Aplus Aone Aone) v) c);
-Rewrite (ics_aux_ok (interp_vl v) c).
-Rewrite (interp_m_ok (Aplus Aone Aone) v).
-Setoid_replace (Amult (Aplus Aone Aone) (interp_vl v))
- with (Aplus (Amult Aone (interp_vl v)) (Amult Aone (interp_vl v))).
-Setoid_replace (Amult Aone (interp_vl v)) with (interp_vl v); Auto.
-
-Elim (varlist_lt l v); Simpl; Intros; Auto.
-Rewrite (ics_aux_ok (interp_vl v) (varlist_insert l c)).
-Rewrite H.
-Rewrite (ics_aux_ok (interp_vl v) c); Auto.
-Save.
-
-Lemma canonical_sum_scalar_ok : (a:A)(s:canonical_sum)
-  (Aequiv (interp_setcs (canonical_sum_scalar a s)) (Amult a (interp_setcs s))).
-Proof.
-Induction s; Simpl; Intros.
-Trivial.
-
-Rewrite (ics_aux_ok (interp_m (Amult a a0) v)
-                 (canonical_sum_scalar a c));
-Rewrite (ics_aux_ok (interp_m a0 v) c).
-Rewrite (interp_m_ok (Amult a a0) v);
-Rewrite (interp_m_ok a0 v).
-Rewrite H.
-Setoid_replace (Amult a (Aplus (Amult a0 (interp_vl v)) (interp_setcs c)))
- with (Aplus (Amult a (Amult a0 (interp_vl v))) (Amult a (interp_setcs c))).
-Auto.
-
-Rewrite (ics_aux_ok (interp_m a v) (canonical_sum_scalar a c));
-Rewrite (ics_aux_ok (interp_vl v) c); Rewrite H.
-Rewrite (interp_m_ok a v).
-Auto.
-Save.
-
-Lemma canonical_sum_scalar2_ok : (l:varlist; s:canonical_sum)
-  (Aequiv (interp_setcs (canonical_sum_scalar2 l s)) (Amult (interp_vl l) (interp_setcs s))).
-Proof.
-Induction s; Simpl; Intros; Auto.
-Rewrite (monom_insert_ok a (varlist_merge l v)
-                 (canonical_sum_scalar2 l c)).
-Rewrite (ics_aux_ok (interp_m a v) c).
-Rewrite (interp_m_ok a v).
-Rewrite H.
-Rewrite (varlist_merge_ok l v).
-Setoid_replace (Amult (interp_vl l)
-                 (Aplus (Amult a (interp_vl v)) (interp_setcs c)))
- with (Aplus (Amult (interp_vl l) (Amult a (interp_vl v)))
-        (Amult (interp_vl l) (interp_setcs c))).
-Auto.
-
-Rewrite (varlist_insert_ok (varlist_merge l v)
-                 (canonical_sum_scalar2 l c)).
-Rewrite (ics_aux_ok (interp_vl v) c).
-Rewrite H.
-Rewrite (varlist_merge_ok l v).
-Auto.
-Save.
-
-Lemma canonical_sum_scalar3_ok : (c:A; l:varlist; s:canonical_sum)
-  (Aequiv (interp_setcs (canonical_sum_scalar3 c l s)) (Amult c (Amult (interp_vl l) (interp_setcs s)))).
-Proof.
-Induction s; Simpl; Intros.
-Rewrite (SSR_mult_zero_right S T (interp_vl l)).
-Auto.
-
-Rewrite (monom_insert_ok (Amult c a) (varlist_merge l v)
-                 (canonical_sum_scalar3 c l c0)).
-Rewrite (ics_aux_ok (interp_m a v) c0).
-Rewrite (interp_m_ok a v).
-Rewrite H.
-Rewrite (varlist_merge_ok l v).
-Setoid_replace (Amult (interp_vl l)
-                 (Aplus (Amult a (interp_vl v)) (interp_setcs c0)))
- with (Aplus (Amult (interp_vl l) (Amult a (interp_vl v)))
-        (Amult (interp_vl l) (interp_setcs c0))).
-Setoid_replace (Amult c
-                 (Aplus (Amult (interp_vl l) (Amult a (interp_vl v)))
-                   (Amult (interp_vl l) (interp_setcs c0))))
- with (Aplus (Amult c (Amult (interp_vl l) (Amult a (interp_vl v))))
-        (Amult c (Amult (interp_vl l) (interp_setcs c0)))).
-Setoid_replace (Amult (Amult c a) (Amult (interp_vl l) (interp_vl v)))
- with (Amult c (Amult a (Amult (interp_vl l) (interp_vl v)))).
-Auto.
-
-Rewrite (monom_insert_ok c (varlist_merge l v)
-                 (canonical_sum_scalar3 c l c0)).
-Rewrite (ics_aux_ok (interp_vl v) c0).
-Rewrite H.
-Rewrite (varlist_merge_ok l v).
-Setoid_replace (Aplus (Amult c (Amult (interp_vl l) (interp_vl v)))
-                 (Amult c (Amult (interp_vl l) (interp_setcs c0))))
- with (Amult c
-        (Aplus (Amult (interp_vl l) (interp_vl v))
-          (Amult (interp_vl l) (interp_setcs c0)))).
-Auto.
-Save.
-
-Lemma canonical_sum_prod_ok : (x,y:canonical_sum)
-  (Aequiv (interp_setcs (canonical_sum_prod x y)) (Amult (interp_setcs x) (interp_setcs y))).
-Proof.
-Induction x; Simpl; Intros.
-Trivial.
-
-Rewrite (canonical_sum_merge_ok (canonical_sum_scalar3 a v y)
-                 (canonical_sum_prod c y)).
-Rewrite (canonical_sum_scalar3_ok a v y).
-Rewrite (ics_aux_ok (interp_m a v) c).
-Rewrite (interp_m_ok a v).
-Rewrite (H y).
-Setoid_replace (Amult a (Amult (interp_vl v) (interp_setcs y)))
- with (Amult (Amult a (interp_vl v)) (interp_setcs y)).
-Setoid_replace (Amult (Aplus (Amult a (interp_vl v)) (interp_setcs c))
-                 (interp_setcs y))
- with (Aplus (Amult (Amult a (interp_vl v)) (interp_setcs y))
-        (Amult (interp_setcs c) (interp_setcs y))).
-Trivial.
-
-Rewrite (canonical_sum_merge_ok (canonical_sum_scalar2 v y)
-                 (canonical_sum_prod c y)).
-Rewrite (canonical_sum_scalar2_ok v y).
-Rewrite (ics_aux_ok (interp_vl v) c).
-Rewrite (H y).
-Trivial.
-Save.
-
-Theorem setspolynomial_normalize_ok : (p:setspolynomial)
-  (Aequiv (interp_setcs (setspolynomial_normalize p)) (interp_setsp p)).
-Proof.
-Induction p; Simpl; Intros; Trivial.
-Rewrite (canonical_sum_merge_ok (setspolynomial_normalize s)
-                 (setspolynomial_normalize s0)).
-Rewrite H; Rewrite H0; Trivial.
-
-Rewrite (canonical_sum_prod_ok (setspolynomial_normalize s)
-                 (setspolynomial_normalize s0)).
-Rewrite H; Rewrite H0; Trivial.
-Save.
-
-Lemma canonical_sum_simplify_ok : (s:canonical_sum)
-  (Aequiv (interp_setcs (canonical_sum_simplify s)) (interp_setcs s)).
-Proof.
-Induction s; Simpl; Intros.
-Trivial.
-
-Generalize (SSR_eq_prop T 9!a 10!Azero).
-Elim (Aeq a Azero).
-Simpl.
-Intros.
-Rewrite (ics_aux_ok (interp_m a v) c).
-Rewrite (interp_m_ok a v).
-Rewrite (H0 I).
-Setoid_replace (Amult Azero (interp_vl v)) with Azero.
-Rewrite H.
-Trivial.
-
-Intros; Simpl.
-Generalize (SSR_eq_prop T 9!a 10!Aone).
-Elim (Aeq a Aone).
-Intros.
-Rewrite (ics_aux_ok (interp_m a v) c).
-Rewrite (interp_m_ok a v).
-Rewrite (H1 I).
-Simpl.
-Rewrite (ics_aux_ok (interp_vl v) (canonical_sum_simplify c)).
-Rewrite H.
-Auto.
-
-Simpl.
-Intros.
-Rewrite (ics_aux_ok (interp_m a v) (canonical_sum_simplify c)).
-Rewrite (ics_aux_ok (interp_m a v) c).
-Rewrite H; Trivial.
-
-Rewrite (ics_aux_ok (interp_vl v) (canonical_sum_simplify c)).
-Rewrite H.
-Auto.
-Save.
-
-Theorem setspolynomial_simplify_ok : (p:setspolynomial)
-  (Aequiv (interp_setcs (setspolynomial_simplify p)) (interp_setsp p)).
-Proof.
-Intro.
-Unfold setspolynomial_simplify.
-Rewrite (canonical_sum_simplify_ok (setspolynomial_normalize p)).
-Exact (setspolynomial_normalize_ok p).
-Save.
-
-End semi_setoid_rings.
-
-Implicits Cons_varlist.
-Implicits Cons_monom.
-Implicits SetSPconst.
-Implicits SetSPplus.
-Implicits SetSPmult.
-
-
-
-Section setoid_rings.
-
-Set Implicit Arguments.
-
-Variable vm : (varmap A).
-Variable T : (Setoid_Ring_Theory Aequiv Aplus Amult Aone Azero Aopp Aeq).
-
-Hint STh_plus_sym_T := Resolve (STh_plus_sym T).
-Hint STh_plus_assoc_T := Resolve (STh_plus_assoc T).
-Hint STh_plus_assoc2_T := Resolve (STh_plus_assoc2 S T).
-Hint STh_mult_sym_T := Resolve (STh_mult_sym T).
-Hint STh_mult_assoc_T := Resolve (STh_mult_assoc T).
-Hint STh_mult_assoc2_T := Resolve (STh_mult_assoc2 S T).
-Hint STh_plus_zero_left_T := Resolve (STh_plus_zero_left T).
-Hint STh_plus_zero_left2_T := Resolve (STh_plus_zero_left2 S T).
-Hint STh_mult_one_left_T := Resolve (STh_mult_one_left T).
-Hint STh_mult_one_left2_T := Resolve (STh_mult_one_left2 S T).
-Hint STh_mult_zero_left_T := Resolve (STh_mult_zero_left S plus_morph mult_morph T).
-Hint STh_mult_zero_left2_T := Resolve (STh_mult_zero_left2 S plus_morph mult_morph T).
-Hint STh_distr_left_T := Resolve (STh_distr_left T).
-Hint STh_distr_left2_T := Resolve (STh_distr_left2 S T).
-Hint STh_plus_reg_left_T := Resolve (STh_plus_reg_left S plus_morph T).
-Hint STh_plus_permute_T := Resolve (STh_plus_permute S plus_morph T).
-Hint STh_mult_permute_T := Resolve (STh_mult_permute S mult_morph T).
-Hint STh_distr_right_T := Resolve (STh_distr_right S plus_morph T).
-Hint STh_distr_right2_T := Resolve (STh_distr_right2 S plus_morph T).
-Hint STh_mult_zero_right_T := Resolve (STh_mult_zero_right S plus_morph mult_morph T).
-Hint STh_mult_zero_right2_T := Resolve (STh_mult_zero_right2 S plus_morph mult_morph T).
-Hint STh_plus_zero_right_T := Resolve (STh_plus_zero_right S T).
-Hint STh_plus_zero_right2_T := Resolve (STh_plus_zero_right2 S T).
-Hint STh_mult_one_right_T := Resolve (STh_mult_one_right S T).
-Hint STh_mult_one_right2_T := Resolve (STh_mult_one_right2 S T).
-Hint STh_plus_reg_right_T := Resolve (STh_plus_reg_right S plus_morph T).
-Hints Resolve refl_equal sym_equal trans_equal.
-(*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
-Hints Immediate T.
-
-
-(*** Definitions *)
-
-Inductive Type setpolynomial := 
-  SetPvar : index -> setpolynomial
-| SetPconst : A -> setpolynomial
-| SetPplus : setpolynomial -> setpolynomial -> setpolynomial
-| SetPmult : setpolynomial -> setpolynomial -> setpolynomial
-| SetPopp : setpolynomial -> setpolynomial.
-
-Fixpoint setpolynomial_normalize [x:setpolynomial] : canonical_sum :=
- Cases x of
- | (SetPplus l r) => (canonical_sum_merge
-     (setpolynomial_normalize l) 
-     (setpolynomial_normalize r))
- | (SetPmult l r) => (canonical_sum_prod
-     (setpolynomial_normalize l)
-     (setpolynomial_normalize r))
- | (SetPconst c)  => (Cons_monom c Nil_var Nil_monom)
- | (SetPvar i)    => (Cons_varlist (Cons_var i Nil_var) Nil_monom)
- | (SetPopp p)    => (canonical_sum_scalar3
-     (Aopp Aone) Nil_var
-     (setpolynomial_normalize p))
- end.
-
-Definition setpolynomial_simplify :=
- [x:setpolynomial](canonical_sum_simplify (setpolynomial_normalize x)).
-
-Fixpoint setspolynomial_of [x:setpolynomial] : setspolynomial :=
- Cases x of 
- | (SetPplus l r) => (SetSPplus (setspolynomial_of l) (setspolynomial_of r))
- | (SetPmult l r) => (SetSPmult (setspolynomial_of l) (setspolynomial_of r))
- | (SetPconst c)  => (SetSPconst c)
- | (SetPvar i)    => (SetSPvar i)
- | (SetPopp p)    => (SetSPmult (SetSPconst (Aopp Aone)) (setspolynomial_of p))
- end.
-
-(*** Interpretation *)
-
-Fixpoint interp_setp [p:setpolynomial] : A :=
- Cases p of
- | (SetPconst c)    => c
- | (SetPvar i)      => (varmap_find Azero i vm)
- | (SetPplus p1 p2) => (Aplus (interp_setp p1) (interp_setp p2))
- | (SetPmult p1 p2) => (Amult (interp_setp p1) (interp_setp p2))
- | (SetPopp p1)     => (Aopp (interp_setp p1))
- end.
-
-(*** Properties *)
-
-Unset Implicit Arguments.
-
-Lemma setspolynomial_of_ok : (p:setpolynomial)
- (Aequiv (interp_setp p) (interp_setsp vm (setspolynomial_of p))).
-Induction p; Trivial; Simpl; Intros.
-Rewrite H; Rewrite H0; Trivial.
-Rewrite H; Rewrite H0; Trivial.
-Rewrite H.
-Rewrite (STh_opp_mult_left2 S plus_morph mult_morph T Aone
-                 (interp_setsp vm (setspolynomial_of s))).
-Rewrite (STh_mult_one_left T
-                 (interp_setsp vm (setspolynomial_of s))).
-Trivial.
-Save.
-
-Theorem setpolynomial_normalize_ok : (p:setpolynomial)
- (setpolynomial_normalize p)
-  ==(setspolynomial_normalize (setspolynomial_of p)).
-Induction p; Trivial; Simpl; Intros.
-Rewrite H; Rewrite H0; Reflexivity.
-Rewrite H; Rewrite H0; Reflexivity.
-Rewrite H; Simpl.
-Elim (canonical_sum_scalar3 (Aopp Aone) Nil_var
-   (setspolynomial_normalize (setspolynomial_of s)));
- [ Reflexivity
- | Simpl; Intros; Rewrite H0; Reflexivity
- | Simpl; Intros; Rewrite H0; Reflexivity ].
-Save.
-
-Theorem setpolynomial_simplify_ok : (p:setpolynomial)
- (Aequiv (interp_setcs vm (setpolynomial_simplify p)) (interp_setp p)).
-Intro.
-Unfold setpolynomial_simplify.
-Rewrite (setspolynomial_of_ok p).
-Rewrite setpolynomial_normalize_ok.
-Rewrite (canonical_sum_simplify_ok vm
-   (Semi_Setoid_Ring_Theory_of A Aequiv S Aplus Amult Aone Azero Aopp
-    Aeq plus_morph mult_morph T)
-   (setspolynomial_normalize (setspolynomial_of p))).
-Rewrite (setspolynomial_normalize_ok vm 
-   (Semi_Setoid_Ring_Theory_of A Aequiv S Aplus Amult Aone Azero Aopp
-    Aeq plus_morph mult_morph T) (setspolynomial_of p)).
-Trivial.
-Save.
-
-End setoid_rings.
-
-End setoid.
diff --git a/contrib7/ring/Setoid_ring_theory.v b/contrib7/ring/Setoid_ring_theory.v
deleted file mode 100644
index 13afc5ee..00000000
--- a/contrib7/ring/Setoid_ring_theory.v
+++ /dev/null
@@ -1,429 +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        *)
-(************************************************************************)
-
-(* $Id: Setoid_ring_theory.v,v 1.1.2.1 2004/07/16 19:30:19 herbelin Exp $ *)
-
-Require Export Bool.
-Require Export Setoid.
-
-Set Implicit Arguments.
-
-Section Setoid_rings.
-
-Variable A : Type.
-Variable Aequiv : A -> A -> Prop.
-
-Infix Local "==" Aequiv (at level 5, no associativity).
-
-Variable S : (Setoid_Theory A Aequiv).
-
-Add Setoid A Aequiv S.
-
-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.
-
-Infix 4 "+" Aplus V8only 50 (left associativity).
-Infix 4 "*" Amult V8only 40 (left associativity).
-Notation "0" := Azero.
-Notation "1" := Aone.
-Notation "- x" := (Aopp x) (at level 0) V8only.
-
-Variable plus_morph : (a,a0,a1,a2:A) a == a0 -> a1 == a2 -> a+a1 == a0+a2.
-Variable mult_morph : (a,a0,a1,a2:A) a == a0 -> a1 == a2 -> a*a1 == a0*a2.
-Variable opp_morph : (a,a0:A) a == a0 -> -a == -a0.
-
-Add Morphism Aplus : Aplus_ext.
-Exact plus_morph.
-Save.
-
-Add Morphism Amult : Amult_ext.
-Exact mult_morph.
-Save.
-
-Add Morphism Aopp : Aopp_ext.
-Exact opp_morph.
-Save.
-
-Section Theory_of_semi_setoid_rings.
-
-Record Semi_Setoid_Ring_Theory : Prop :=
-{ SSR_plus_sym  : (n,m:A) n + m == m + n;
-  SSR_plus_assoc : (n,m,p:A) n + (m + p) == (n + m) + p;
-  SSR_mult_sym : (n,m:A) n*m == m*n;
-  SSR_mult_assoc : (n,m,p:A) n*(m*p) == (n*m)*p;
-  SSR_plus_zero_left :(n:A) 0 + n == n;
-  SSR_mult_one_left : (n:A) 1*n == n;
-  SSR_mult_zero_left : (n:A) 0*n == 0;
-  SSR_distr_left : (n,m,p:A) (n + m)*p == n*p + m*p;
-  SSR_plus_reg_left : (n,m,p:A)n + m == n + p -> m == p;
-  SSR_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x == y
-}.
-
-Variable T : Semi_Setoid_Ring_Theory.
-
-Local plus_sym  := (SSR_plus_sym T).
-Local plus_assoc := (SSR_plus_assoc T).
-Local mult_sym  := ( SSR_mult_sym T).
-Local mult_assoc := (SSR_mult_assoc T).
-Local plus_zero_left := (SSR_plus_zero_left T).
-Local mult_one_left := (SSR_mult_one_left T). 
-Local mult_zero_left := (SSR_mult_zero_left T).
-Local distr_left := (SSR_distr_left T).
-Local plus_reg_left := (SSR_plus_reg_left T).
-Local equiv_refl := (Seq_refl A Aequiv S).
-Local equiv_sym := (Seq_sym A Aequiv S).
-Local equiv_trans := (Seq_trans A Aequiv S).
-
-Hints Resolve plus_sym plus_assoc mult_sym mult_assoc
-  plus_zero_left mult_one_left mult_zero_left distr_left
-  plus_reg_left equiv_refl (*equiv_sym*).
-Hints Immediate equiv_sym.
-
-(* Lemmas whose form is x=y are also provided in form y=x because
-  Auto does not symmetry *) 
-Lemma SSR_mult_assoc2 : (n,m,p:A) (n * m) * p == n * (m * p).
-Auto. Save.
-
-Lemma SSR_plus_assoc2 : (n,m,p:A) (n + m) + p == n + (m + p).
-Auto. Save.
-
-Lemma SSR_plus_zero_left2 : (n:A) n == 0 + n.
-Auto. Save.
-
-Lemma SSR_mult_one_left2 : (n:A) n == 1*n.
-Auto. Save.
-
-Lemma SSR_mult_zero_left2 : (n:A) 0 == 0*n.
-Auto. Save.
-
-Lemma SSR_distr_left2 : (n,m,p:A) n*p + m*p  == (n + m)*p.
-Auto. Save.
-
-Lemma SSR_plus_permute : (n,m,p:A) n+(m+p) == m+(n+p).
-Intros.
-Rewrite (plus_assoc n m p).
-Rewrite (plus_sym n m).
-Rewrite <- (plus_assoc m n p).
-Trivial.
-Save.
-
-Lemma SSR_mult_permute : (n,m,p:A) n*(m*p) == m*(n*p).
-Intros.
-Rewrite (mult_assoc n m p).
-Rewrite (mult_sym n m).
-Rewrite <- (mult_assoc m n p).
-Trivial.
-Save.
-
-Hints Resolve SSR_plus_permute SSR_mult_permute.
-
-Lemma SSR_distr_right : (n,m,p:A) n*(m+p) == (n*m) + (n*p).
-Intros.
-Rewrite (mult_sym n (Aplus m p)).
-Rewrite (mult_sym n m).
-Rewrite (mult_sym n p).
-Auto.
-Save.
-
-Lemma SSR_distr_right2 : (n,m,p:A) (n*m) + (n*p) == n*(m + p).
-Intros.
-Apply equiv_sym.
-Apply SSR_distr_right.
-Save.
-
-Lemma SSR_mult_zero_right : (n:A) n*0 == 0.
-Intro; Rewrite (mult_sym n Azero); Auto.
-Save.
-
-Lemma SSR_mult_zero_right2 : (n:A) 0 == n*0.
-Intro; Rewrite (mult_sym n Azero); Auto.
-Save.
-
-Lemma SSR_plus_zero_right :(n:A) n + 0 == n.
-Intro; Rewrite (plus_sym n Azero); Auto.
-Save.
-
-Lemma SSR_plus_zero_right2 :(n:A) n == n + 0.
-Intro; Rewrite (plus_sym n Azero); Auto.
-Save.
-
-Lemma SSR_mult_one_right : (n:A) n*1 == n.
-Intro; Rewrite (mult_sym n Aone); Auto.
-Save.
-
-Lemma SSR_mult_one_right2 : (n:A) n == n*1.
-Intro; Rewrite (mult_sym n Aone); Auto.
-Save.
-
-Lemma SSR_plus_reg_right : (n,m,p:A) m+n == p+n -> m==p.
-Intros n m p; Rewrite (plus_sym m n); Rewrite (plus_sym p n).
-Intro; Apply plus_reg_left with n; Trivial.
-Save.
-
-End Theory_of_semi_setoid_rings.
-
-Section Theory_of_setoid_rings.
-
-Record Setoid_Ring_Theory : Prop :=
-{ STh_plus_sym  : (n,m:A) n + m == m + n;
-  STh_plus_assoc : (n,m,p:A) n + (m + p) == (n + m) + p;
-  STh_mult_sym : (n,m:A) n*m == m*n;
-  STh_mult_assoc : (n,m,p:A) n*(m*p) == (n*m)*p;
-  STh_plus_zero_left :(n:A) 0 + n == n;
-  STh_mult_one_left : (n:A) 1*n == n;
-  STh_opp_def : (n:A)  n + (-n) == 0;
-  STh_distr_left : (n,m,p:A) (n + m)*p == n*p + m*p;
-  STh_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x == y
-}.
-
-Variable T : Setoid_Ring_Theory.
-
-Local plus_sym  := (STh_plus_sym T).
-Local plus_assoc := (STh_plus_assoc T).
-Local mult_sym  := (STh_mult_sym T).
-Local mult_assoc := (STh_mult_assoc T).
-Local plus_zero_left := (STh_plus_zero_left T).
-Local mult_one_left := (STh_mult_one_left T). 
-Local opp_def := (STh_opp_def T).
-Local distr_left := (STh_distr_left T).
-Local equiv_refl := (Seq_refl A Aequiv S).
-Local equiv_sym := (Seq_sym A Aequiv S).
-Local equiv_trans := (Seq_trans A Aequiv S).
-
-Hints Resolve plus_sym plus_assoc mult_sym mult_assoc
-  plus_zero_left mult_one_left opp_def distr_left
-  equiv_refl equiv_sym.
-
-(* Lemmas whose form is x=y are also provided in form y=x because Auto does
-  not symmetry *)
-
-Lemma STh_mult_assoc2 : (n,m,p:A) (n * m) * p == n * (m * p).
-Auto. Save.
-
-Lemma STh_plus_assoc2 : (n,m,p:A) (n + m) + p == n + (m + p).
-Auto. Save.
-
-Lemma STh_plus_zero_left2 : (n:A) n == 0 + n.
-Auto. Save.
-
-Lemma STh_mult_one_left2 : (n:A) n == 1*n.
-Auto. Save.
-
-Lemma STh_distr_left2 : (n,m,p:A) n*p + m*p  == (n + m)*p.
-Auto. Save.
-
-Lemma STh_opp_def2 : (n:A) 0 == n + (-n).
-Auto. Save.
-
-Lemma STh_plus_permute : (n,m,p:A) n + (m + p) == m + (n + p).
-Intros.
-Rewrite (plus_assoc n m p).
-Rewrite (plus_sym n m).
-Rewrite <- (plus_assoc m n p).
-Trivial.
-Save.
-
-Lemma STh_mult_permute : (n,m,p:A) n*(m*p) == m*(n*p).
-Intros.
-Rewrite (mult_assoc n m p).
-Rewrite (mult_sym n m).
-Rewrite <- (mult_assoc m n p).
-Trivial.
-Save.
-
-Hints Resolve STh_plus_permute STh_mult_permute.
-
-Lemma Saux1 : (a:A)  a + a == a -> a == 0.
-Intros.
-Rewrite <- (plus_zero_left a).
-Rewrite (plus_sym Azero a).
-Setoid_replace (Aplus a Azero) with (Aplus a (Aplus a (Aopp a))); Auto.
-Rewrite (plus_assoc a a (Aopp a)).
-Rewrite H.
-Apply opp_def.
-Save.
-
-Lemma STh_mult_zero_left :(n:A) 0*n == 0.
-Intros.
-Apply Saux1.
-Rewrite <- (distr_left Azero Azero n).
-Rewrite (plus_zero_left Azero).
-Trivial.
-Save.
-Hints Resolve STh_mult_zero_left.
-
-Lemma STh_mult_zero_left2 : (n:A) 0 == 0*n.
-Auto.
-Save.
-
-Lemma Saux2 : (x,y,z:A) x+y==0 -> x+z==0 -> y == z.
-Intros.
-Rewrite <- (plus_zero_left y).
-Rewrite <- H0.
-Rewrite <- (plus_assoc x z y).
-Rewrite (plus_sym z y).
-Rewrite (plus_assoc x y z).
-Rewrite H.
-Auto.
-Save.
-
-Lemma STh_opp_mult_left : (x,y:A) -(x*y) == (-x)*y.
-Intros.
-Apply Saux2 with (Amult x y); Auto.
-Rewrite <- (distr_left x (Aopp x) y).
-Rewrite (opp_def x).
-Auto.
-Save.
-Hints Resolve STh_opp_mult_left.
-
-Lemma STh_opp_mult_left2 : (x,y:A) (-x)*y == -(x*y) .
-Auto.
-Save.
-
-Lemma STh_mult_zero_right : (n:A) n*0 == 0.
-Intro; Rewrite (mult_sym n Azero); Auto.
-Save.
-
-Lemma STh_mult_zero_right2 : (n:A) 0 == n*0.
-Intro; Rewrite (mult_sym n Azero); Auto.
-Save.
-
-Lemma STh_plus_zero_right :(n:A) n + 0 == n.
-Intro; Rewrite (plus_sym n Azero); Auto.
-Save.
-
-Lemma STh_plus_zero_right2 :(n:A) n == n + 0.
-Intro; Rewrite (plus_sym n Azero); Auto.
-Save.
-
-Lemma STh_mult_one_right : (n:A) n*1 == n.
-Intro; Rewrite (mult_sym n Aone); Auto.
-Save.
-
-Lemma STh_mult_one_right2  : (n:A) n == n*1.
-Intro; Rewrite (mult_sym n Aone); Auto.
-Save.
-
-Lemma STh_opp_mult_right : (x,y:A) -(x*y) == x*(-y).
-Intros.
-Rewrite (mult_sym x y).
-Rewrite (mult_sym x (Aopp y)).
-Auto.
-Save.
-
-Lemma STh_opp_mult_right2 : (x,y:A) x*(-y) == -(x*y).
-Intros.
-Rewrite (mult_sym x y).
-Rewrite (mult_sym x (Aopp y)).
-Auto.
-Save.
-
-Lemma STh_plus_opp_opp : (x,y:A) (-x) + (-y) == -(x+y).
-Intros.
-Apply Saux2 with (Aplus x y); Auto.
-Rewrite (STh_plus_permute (Aplus x y) (Aopp x) (Aopp y)).
-Rewrite <- (plus_assoc x y (Aopp y)).
-Rewrite (opp_def y); Rewrite (STh_plus_zero_right x).
-Rewrite (STh_opp_def2 x); Trivial.
-Save.
-
-Lemma STh_plus_permute_opp: (n,m,p:A) (-m)+(n+p) == n+((-m)+p).
-Auto.
-Save.
-
-Lemma STh_opp_opp : (n:A) -(-n) == n.
-Intro.
-Apply Saux2 with (Aopp n); Auto.
-Rewrite (plus_sym (Aopp n) n); Auto.
-Save.
-Hints Resolve STh_opp_opp.
-
-Lemma STh_opp_opp2 : (n:A) n == -(-n).
-Auto.
-Save.
-
-Lemma STh_mult_opp_opp : (x,y:A) (-x)*(-y) == x*y.
-Intros.
-Rewrite (STh_opp_mult_left2 x (Aopp y)).
-Rewrite (STh_opp_mult_right2 x y).
-Trivial.
-Save.
-
-Lemma STh_mult_opp_opp2 : (x,y:A) x*y == (-x)*(-y).
-Intros.
-Apply equiv_sym.
-Apply STh_mult_opp_opp.
-Save.
-
-Lemma STh_opp_zero : -0 == 0.
-Rewrite <- (plus_zero_left (Aopp Azero)).
-Trivial.
-Save.
-
-Lemma STh_plus_reg_left : (n,m,p:A) n+m == n+p -> m==p.
-Intros.
-Rewrite <- (plus_zero_left m).
-Rewrite <- (plus_zero_left p).
-Rewrite <- (opp_def n).
-Rewrite (plus_sym n (Aopp n)).
-Rewrite <- (plus_assoc (Aopp n) n m).
-Rewrite <- (plus_assoc (Aopp n) n p).
-Auto.
-Save.
-
-Lemma STh_plus_reg_right : (n,m,p:A) m+n == p+n -> m==p.
-Intros.
-Apply STh_plus_reg_left with n.
-Rewrite (plus_sym n m); Rewrite (plus_sym n p);
-Assumption.
-Save.
-
-Lemma STh_distr_right : (n,m,p:A) n*(m+p) == (n*m)+(n*p).
-Intros.
-Rewrite (mult_sym n (Aplus m p)).
-Rewrite (mult_sym n m).
-Rewrite (mult_sym n p).
-Trivial.
-Save.
-
-Lemma STh_distr_right2 : (n,m,p:A) (n*m)+(n*p) == n*(m+p).
-Intros.
-Apply equiv_sym.
-Apply STh_distr_right.
-Save.
-
-End Theory_of_setoid_rings.
-
-Hints Resolve STh_mult_zero_left STh_plus_reg_left : core.
-
-Unset Implicit Arguments.
-
-Definition Semi_Setoid_Ring_Theory_of :
-  Setoid_Ring_Theory -> Semi_Setoid_Ring_Theory.
-Intros until 1; Case H.
-Split; Intros; Simpl; EAuto.
-Defined.
-
-Coercion Semi_Setoid_Ring_Theory_of :
-  Setoid_Ring_Theory >-> Semi_Setoid_Ring_Theory.
-
-
-
-Section product_ring.
-
-End product_ring.
-
-Section power_ring.
-
-End power_ring.
-
-End Setoid_rings.
diff --git a/contrib7/ring/ZArithRing.v b/contrib7/ring/ZArithRing.v
deleted file mode 100644
index fc7ef29f..00000000
--- a/contrib7/ring/ZArithRing.v
+++ /dev/null
@@ -1,35 +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        *)
-(************************************************************************)
-
-(* $Id: ZArithRing.v,v 1.1.2.1 2004/07/16 19:30:19 herbelin Exp $ *)
-
-(* Instantiation of the Ring tactic for the binary integers of ZArith *)
-
-Require Export ArithRing.
-Require Export ZArith_base.
-Require Eqdep_dec.
-
-Definition Zeq := [x,y:Z]
-  Cases `x ?= y ` of
-    EGAL => true
-  | _ => false
-  end.
-
-Lemma Zeq_prop : (x,y:Z)(Is_true (Zeq x y)) -> x==y.
-  Intros x y H; Unfold Zeq in H.
-  Apply Zcompare_EGAL_eq.
-  NewDestruct (Zcompare x y); [Reflexivity | Contradiction | Contradiction ].
-Save.
-
-Definition ZTheory : (Ring_Theory Zplus Zmult `1` `0` Zopp Zeq).
-  Split; Intros; Apply eq2eqT; EAuto with zarith.
-  Apply eqT2eq; Apply Zeq_prop; Assumption.
-Save.
-
-(* NatConstants and NatTheory are defined in Ring_theory.v *)
-Add Ring Z Zplus Zmult `1` `0` Zopp Zeq ZTheory [POS NEG ZERO xO xI xH].
diff --git a/contrib7/romega/ROmega.v b/contrib7/romega/ROmega.v
deleted file mode 100644
index 7ee246c7..00000000
--- a/contrib7/romega/ROmega.v
+++ /dev/null
@@ -1,12 +0,0 @@
-(*************************************************************************
-
-   PROJET RNRT Calife - 2001
-   Author: Pierre Crégut - France Télécom R&D
-   Licence : LGPL version 2.1
-
- *************************************************************************)
-
-Require Omega.
-Require ReflOmegaCore.
-
-
diff --git a/contrib7/romega/ReflOmegaCore.v b/contrib7/romega/ReflOmegaCore.v
deleted file mode 100644
index 81baa8d9..00000000
--- a/contrib7/romega/ReflOmegaCore.v
+++ /dev/null
@@ -1,2602 +0,0 @@
-(*************************************************************************
-
-   PROJET RNRT Calife - 2001
-   Author: Pierre Crégut - France Télécom R&D
-   Licence du projet : LGPL version 2.1
-
- *************************************************************************)
-
-Require Arith.
-Require PolyList.
-Require Bool.
-Require ZArith.
-Require Import OmegaLemmas.
-
-(* \subsection{Definition of basic types} *)
-
-(* \subsubsection{Environment of propositions (lists) *)
-Inductive PropList : Type := 
-  Pnil : PropList | Pcons : Prop -> PropList -> PropList.
-
-(* Access function for the environment with a default *)
-Fixpoint nthProp [n:nat; l:PropList] : Prop -> Prop :=
-  [default]Cases n l of
-    O (Pcons x l') => x
-  | O other => default
-  | (S m) Pnil => default
-  | (S m) (Pcons x t) => (nthProp m t default)
-  end.
-   
-(* \subsubsection{Définition of reified integer expressions}
-   Terms are either:
-   \begin{itemize}
-   \item integers [Tint]
-   \item variables [Tvar]
-   \item operation over integers (addition, product, opposite, subtraction)
-   The last two are translated in additions and products. *)
-
-Inductive term : Set :=
-   Tint : Z -> term
- | Tplus : term -> term -> term
- | Tmult : term -> term -> term
- | Tminus : term -> term -> term
- | Topp : term -> term
- | Tvar : nat -> term
-.
-
-(* \subsubsection{Definition of reified goals} *)
-(* Very restricted definition of handled predicates that should be extended
-   to cover a wider set of operations.
-   Taking care of negations and disequations require solving more than a
-   goal in parallel. This is a major improvement over previous versions. *)
-
-Inductive proposition : Set :=
-  EqTerm : term -> term -> proposition (* egalité entre termes *)
-| LeqTerm : term -> term -> proposition (* plus petit ou egal *)
-| TrueTerm : proposition (* vrai *)
-| FalseTerm : proposition (* faux *)
-| Tnot : proposition -> proposition (* négation *)
-| GeqTerm : term -> term -> proposition
-| GtTerm : term -> term -> proposition
-| LtTerm : term -> term -> proposition
-| NeqTerm: term -> term -> proposition
-| Tor : proposition -> proposition -> proposition
-| Tand : proposition -> proposition -> proposition
-| Timp : proposition -> proposition -> proposition
-| Tprop : nat -> proposition
-.
-
-(* Definition of goals as a list of hypothesis *)
-Syntactic Definition hyps := (list proposition).      
-
-(* Definition of lists of subgoals  (set of open goals) *)
-Syntactic Definition lhyps := (list hyps).
-
-(* a syngle goal packed in a subgoal list *)
-Syntactic Definition singleton :=  [a: hyps] (cons a (nil hyps)).
-
-(* an absurd goal *)
-Definition absurd := (cons FalseTerm (nil proposition)).
-
-(* \subsubsection{Traces for merging equations}
-   This inductive type describes how the monomial of two equations should be
-   merged when the equations are added.
-
-   For [F_equal], both equations have the same head variable and coefficient
-   must be added, furthermore if coefficients are opposite, [F_cancel] should
-   be used to collapse the term. [F_left] and [F_right] indicate which monomial
-   should be put first in the result *)
-
-Inductive t_fusion : Set :=
-    F_equal : t_fusion | F_cancel : t_fusion
-  | F_left : t_fusion  | F_right : t_fusion.
-
-(* \subsubsection{Rewriting steps to normalize terms} *)
-Inductive step : Set := 
- (* apply the rewriting steps to both subterms of an operation *)
- | C_DO_BOTH : step -> step -> step
- (* apply the rewriting step to the first branch *)
- | C_LEFT : step -> step
- (* apply the rewriting step to the second branch *)
- | C_RIGHT : step -> step
- (* apply two steps consecutively to a term *)
- | C_SEQ : step -> step -> step
- (* empty step *)
- | C_NOP : step
- (* the following operations correspond to actual rewriting *)
- | C_OPP_PLUS : step
- | C_OPP_OPP : step
- | C_OPP_MULT_R : step
- | C_OPP_ONE : step
- (* This is a special step that reduces the term (computation) *)
- | C_REDUCE : step
- | C_MULT_PLUS_DISTR : step
- | C_MULT_OPP_LEFT : step
- | C_MULT_ASSOC_R : step
- | C_PLUS_ASSOC_R : step
- | C_PLUS_ASSOC_L : step
- | C_PLUS_PERMUTE : step
- | C_PLUS_SYM : step
- | C_RED0 : step
- | C_RED1 : step
- | C_RED2 : step
- | C_RED3 : step
- | C_RED4 : step
- | C_RED5 : step
- | C_RED6 : step
- | C_MULT_ASSOC_REDUCED : step
- | C_MINUS :step
- | C_MULT_SYM : step
-.
-
-(* \subsubsection{Omega steps} *)
-(* The following inductive type describes steps as they can be found in
-   the trace coming from the decision procedure Omega. *)
-
-Inductive t_omega : Set :=
-   (* n = 0 n!= 0 *)
- | O_CONSTANT_NOT_NUL : nat -> t_omega
- | O_CONSTANT_NEG : nat -> t_omega
-   (* division et approximation of an equation *)
- | O_DIV_APPROX : Z -> Z -> term -> nat -> t_omega -> nat -> t_omega
-   (* no solution because no exact division *)
- | O_NOT_EXACT_DIVIDE :  Z -> Z -> term -> nat -> nat -> t_omega
-   (* exact division *)
- | O_EXACT_DIVIDE : Z -> term -> nat -> t_omega -> nat -> t_omega
- | O_SUM : Z -> nat -> Z -> nat -> (list t_fusion) -> t_omega -> t_omega
- | O_CONTRADICTION : nat -> nat -> nat -> t_omega
- | O_MERGE_EQ : nat -> nat -> nat -> t_omega -> t_omega
- | O_SPLIT_INEQ : nat -> nat -> t_omega -> t_omega -> t_omega
- | O_CONSTANT_NUL : nat -> t_omega 
- | O_NEGATE_CONTRADICT : nat -> nat -> t_omega
- | O_NEGATE_CONTRADICT_INV : nat -> nat -> nat -> t_omega
- | O_STATE : Z -> step -> nat -> nat -> t_omega -> t_omega.
-
-(* \subsubsection{Règles pour normaliser les hypothèses} *)
-(* Ces règles indiquent comment normaliser les propositions utiles 
-   de chaque hypothèse utile avant la décomposition des hypothèses et 
-   incluent l'étape d'inversion pour la suppression des négations *)
-Inductive p_step : Set :=
-  P_LEFT : p_step -> p_step
-| P_RIGHT :  p_step -> p_step
-| P_INVERT :  step -> p_step
-| P_STEP : step -> p_step
-| P_NOP : p_step
-.
-(* Liste des normalisations a effectuer : avec un constructeur dans le
-   type [p_step] permettant
-   de parcourir à la fois les branches gauches et droit, on pourrait n'avoir
-   qu'une normalisation par hypothèse. Et comme toutes les hypothèses sont 
-   utiles (sinon on ne les incluerait pas), on pourrait remplacer [h_step] 
-   par une simple liste *)
-
-Inductive h_step : Set := pair_step : nat -> p_step -> h_step.
-
-(* \subsubsection{Règles pour décomposer les hypothèses} *)
-(* Ce type permet de se diriger dans les constructeurs logiques formant les
-   prédicats des hypothèses pour aller les décomposer. Ils permettent
-   en particulier d'extraire une hypothèse d'une conjonction avec
-   éventuellement le bon niveau de négations. *)
-
-Inductive direction : Set :=
-   D_left : direction
- | D_right : direction
- | D_mono : direction.
-
-(* Ce type permet d'extraire les composants utiles des hypothèses : que ce
-   soit des hypothèses générées par éclatement d'une disjonction, ou 
-   des équations. Le constructeur terminal indique comment résoudre le système
-   obtenu en recourrant au type de trace d'Omega [t_omega] *)
-
-Inductive e_step : Set :=
-   E_SPLIT : nat -> (list direction) -> e_step -> e_step -> e_step
- | E_EXTRACT : nat -> (list direction) -> e_step -> e_step
- | E_SOLVE : t_omega -> e_step.
-
-(* \subsection{Egalité décidable efficace} *)
-(* Pour chaque type de donnée réifié, on calcule un test d'égalité efficace.
-   Ce n'est pas le cas de celui rendu par [Decide Equality].
-   
-   Puis on prouve deux théorèmes permettant d'éliminer de telles égalités :
-   \begin{verbatim}
-   (t1,t2: typ) (eq_typ t1 t2) = true -> t1 = t2.
-   (t1,t2: typ) (eq_typ t1 t2) = false -> ~ t1 = t2.
-   \end{verbatim} *)
-
-(* Ces deux tactiques permettent de résoudre pas mal de cas. L'une pour
-   les théorèmes positifs, l'autre pour les théorèmes négatifs *)
-
-Tactic Definition absurd_case := Simpl; Intros; Discriminate.
-Tactic Definition trivial_case := Unfold not; Intros; Discriminate.
-
-(* \subsubsection{Entiers naturels} *)
-
-Fixpoint eq_nat [t1,t2: nat] : bool := 
-  Cases t1 of
-    O => Cases t2 of O => true | _ => false end
-  | (S n1)=> Cases t2 of O => false | (S n2)  => (eq_nat n1 n2) end
-  end.
-
-Theorem eq_nat_true : (t1,t2: nat) (eq_nat t1 t2) = true -> t1 = t2.
-
-Induction t1; [
-  Intro t2; Case t2; [ Trivial | absurd_case ]
-| Intros n H t2; Case t2; 
-    [ absurd_case |  Simpl; Intros; Rewrite (H n0); [ Trivial | Assumption]]].
-
-Save.
-  
-Theorem eq_nat_false : (t1,t2: nat) (eq_nat t1 t2) = false -> ~t1 = t2.
-
-Induction t1; [
-  Intro t2; Case t2;
-   [ Simpl;Intros; Discriminate | trivial_case ]
-| Intros n H t2; Case t2; Simpl; Unfold not; Intros; [
-    Discriminate
-  | Elim (H n0 H0); Simplify_eq H1; Trivial]].
-
-Save.
-                                   
-
-(* \subsubsection{Entiers positifs} *)
-
-Fixpoint eq_pos [p1,p2 : positive] : bool := 
-  Cases p1 of
-    (xI n1) => Cases p2 of (xI n2) => (eq_pos n1 n2) | _ => false end
-  | (xO n1) =>  Cases p2 of (xO n2) => (eq_pos n1 n2) | _ => false end
-  | xH =>  Cases p2 of xH => true | _ => false end
-  end.
-
-Theorem eq_pos_true : (t1,t2: positive) (eq_pos t1 t2) = true -> t1 = t2.
-
-Induction t1; [
-  Intros p H t2; Case t2; [
-    Simpl; Intros; Rewrite (H p0 H0); Trivial | absurd_case | absurd_case ]
-| Intros p H t2; Case t2; [
-    absurd_case | Simpl; Intros; Rewrite (H p0 H0); Trivial | absurd_case ]
-| Intro t2; Case t2; [ absurd_case | absurd_case | Auto ]].
-
-Save.
-  
-Theorem eq_pos_false : (t1,t2: positive) (eq_pos t1 t2) = false -> ~t1 = t2.
-
-Induction t1; [
-  Intros p H t2; Case t2; [
-    Simpl; Unfold not; Intros; Elim (H p0 H0); Simplify_eq H1; Auto
-  | trivial_case | trivial_case ]
-| Intros p H t2; Case t2; [
-    trivial_case 
-  | Simpl; Unfold not; Intros; Elim (H p0 H0); Simplify_eq H1; Auto
-  | trivial_case ]
-| Intros t2; Case t2; [ trivial_case | trivial_case  | absurd_case ]].
-Save.
-
-(* \subsubsection{Entiers relatifs} *)
-
-Definition eq_Z [z1,z2: Z] : bool :=
-  Cases z1 of
-     ZERO     => Cases z2 of ZERO => true | _ => false end
-   | (POS p1) => Cases z2 of (POS p2) => (eq_pos p1 p2) | _ => false end
-   | (NEG p1) => Cases z2 of (NEG p2) => (eq_pos p1 p2) | _ => false end
-  end.
-
-Theorem eq_Z_true : (t1,t2: Z) (eq_Z t1 t2) = true -> t1 = t2.
-
-Induction t1; [
-  Intros t2; Case t2; [ Auto | absurd_case | absurd_case ]
-| Intros p t2; Case t2; [
-    absurd_case | Simpl; Intros; Rewrite (eq_pos_true p p0 H); Trivial 
-  | absurd_case ]
-| Intros p t2; Case t2; [
-    absurd_case | absurd_case
-  | Simpl; Intros; Rewrite (eq_pos_true p p0 H); Trivial ]].
-
-Save.
-
-Theorem eq_Z_false : (t1,t2: Z) (eq_Z t1 t2) = false -> ~(t1 = t2).
-
-Induction t1; [
-  Intros t2; Case t2; [ absurd_case | trivial_case | trivial_case ]
-| Intros p t2; Case t2; [
-    absurd_case
-  | Simpl; Unfold not; Intros; Elim (eq_pos_false p p0 H); Simplify_eq H0; Auto
-  | trivial_case ]
-| Intros p t2; Case t2; [
-    absurd_case | trivial_case 
-  | Simpl; Unfold not; Intros; Elim (eq_pos_false p p0 H); 
-    Simplify_eq H0; Auto]].
-Save.
-
-(* \subsubsection{Termes réifiés} *)
-
-Fixpoint eq_term [t1,t2: term] : bool := 
-   Cases t1 of
-      (Tint st1) =>
-         Cases t2 of (Tint st2) => (eq_Z st1 st2) | _ => false end
-    | (Tplus st11 st12) =>
-         Cases t2 of
-            (Tplus st21 st22) => 
-               (andb (eq_term st11 st21) (eq_term st12 st22))
-         | _ => false 
-         end
-    | (Tmult st11 st12) =>
-         Cases t2 of
-            (Tmult st21 st22) => 
-               (andb (eq_term st11 st21) (eq_term st12 st22))
-         | _ => false 
-         end
-    | (Tminus st11 st12) =>
-         Cases t2 of
-            (Tminus st21 st22) => 
-               (andb (eq_term st11 st21) (eq_term st12 st22))
-         | _ => false 
-         end
-    | (Topp st1) =>
-         Cases t2 of (Topp st2) => (eq_term st1 st2) | _ => false end
-    | (Tvar st1) =>
-         Cases t2 of (Tvar st2) => (eq_nat st1 st2) | _ => false end
-   end.  
-
-Theorem eq_term_true : (t1,t2: term) (eq_term t1 t2) = true -> t1 = t2.
-
-
-Induction t1; Intros until t2; Case t2; Try absurd_case; Simpl; [
-  Intros; Elim eq_Z_true with 1 := H; Trivial
-| Intros t21 t22 H3; Elim andb_prop with 1:= H3; Intros H4 H5; 
-  Elim H with 1 := H4; Elim H0 with 1 := H5; Trivial
-| Intros t21 t22 H3; Elim andb_prop with 1:= H3; Intros H4 H5;
-  Elim H with 1 := H4; Elim H0 with 1 := H5; Trivial
-| Intros t21 t22 H3; Elim andb_prop with 1:= H3; Intros H4 H5; 
-  Elim H with 1 := H4; Elim H0 with 1 := H5; Trivial
-| Intros t21 H3; Elim H with 1 := H3; Trivial
-| Intros; Elim eq_nat_true with 1 := H; Trivial ].
-
-Save.
-
-Theorem eq_term_false : (t1,t2: term) (eq_term t1 t2) = false -> ~(t1 = t2).
-
-Induction t1; [
-  Intros z t2; Case t2; Try trivial_case; Simpl; Unfold not; Intros;
-  Elim eq_Z_false with 1:=H; Simplify_eq H0; Auto
-| Intros t11 H1 t12 H2 t2; Case t2; Try trivial_case; Simpl; Intros t21 t22 H3;
-  Unfold not; Intro H4; Elim andb_false_elim with 1:= H3; Intros H5; 
-  [ Elim H1 with 1 := H5; Simplify_eq H4; Auto |
-    Elim H2 with 1 := H5; Simplify_eq H4; Auto ]
-| Intros t11 H1 t12 H2 t2; Case t2; Try trivial_case; Simpl; Intros t21 t22 H3;
-  Unfold not; Intro H4; Elim andb_false_elim with 1:= H3; Intros H5; 
-  [ Elim H1 with 1 := H5; Simplify_eq H4; Auto |
-    Elim H2 with 1 := H5; Simplify_eq H4; Auto ]
-| Intros t11 H1 t12 H2 t2; Case t2; Try trivial_case; Simpl; Intros t21 t22 H3;
-  Unfold not; Intro H4; Elim andb_false_elim with 1:= H3; Intros H5; 
-  [ Elim H1 with 1 := H5; Simplify_eq H4; Auto |
-    Elim H2 with 1 := H5; Simplify_eq H4; Auto ]
-| Intros t11 H1 t2; Case t2; Try trivial_case; Simpl; Intros t21 H3;
-  Unfold not; Intro H4; Elim H1 with 1 := H3; Simplify_eq H4; Auto 
-| Intros n t2; Case t2; Try trivial_case; Simpl; Unfold not; Intros;
-  Elim eq_nat_false with 1:=H; Simplify_eq H0; Auto ].
-
-Save.
-
-(* \subsubsection{Tactiques pour éliminer ces tests} 
-
-   Si on se contente de faire un [Case (eq_typ t1 t2)] on perd 
-   totalement dans chaque branche le fait que [t1=t2] ou [~t1=t2].
-
-   Initialement, les développements avaient été réalisés avec les
-   tests rendus par [Decide Equality], c'est à dire un test rendant
-   des termes du type [{t1=t2}+{~t1=t2}]. Faire une élimination sur un 
-   tel test préserve bien l'information voulue mais calculatoirement de
-   telles fonctions sont trop lentes. *)
-
-(* Le théorème suivant permet de garder dans les hypothèses la valeur
-   du booléen lors de l'élimination. *)
-
-Theorem bool_ind2 : 
-   (P:(bool->Prop)) (b:bool)
-     (b = true -> (P true))->
-     (b = false -> (P false)) -> (P b).
-
-Induction b; Auto.
-Save.
-
-(* Les tactiques définies si après se comportent exactement comme si on
-   avait utilisé le test précédent et fait une elimination dessus. *)
-
-Tactic Definition Elim_eq_term t1 t2 :=
-  Pattern (eq_term t1 t2); Apply bool_ind2; Intro Aux; [
-    Generalize (eq_term_true t1 t2 Aux); Clear Aux
-  | Generalize (eq_term_false t1 t2 Aux); Clear Aux ].
-
-Tactic Definition Elim_eq_Z t1 t2 :=
-  Pattern (eq_Z t1 t2); Apply bool_ind2; Intro Aux; [
-    Generalize (eq_Z_true t1 t2 Aux); Clear Aux
-  | Generalize (eq_Z_false t1 t2 Aux); Clear Aux ].
-
-Tactic Definition Elim_eq_pos t1 t2 :=
-  Pattern (eq_pos t1 t2); Apply bool_ind2; Intro Aux; [
-    Generalize (eq_pos_true t1 t2 Aux); Clear Aux
-  | Generalize (eq_pos_false t1 t2 Aux); Clear Aux ].
-
-(* \subsubsection{Comparaison sur Z} *)
-
-(* Sujet très lié au précédent : on introduit la tactique d'élimination
-   avec son théorème *)
-
-Theorem relation_ind2 : 
-   (P:(relation->Prop)) (b:relation)
-     (b = EGAL -> (P EGAL))->
-     (b = INFERIEUR -> (P INFERIEUR))->
-     (b = SUPERIEUR -> (P SUPERIEUR)) -> (P b).
-
-Induction b; Auto.
-Save.
-
-Tactic Definition Elim_Zcompare t1 t2 :=
-  Pattern (Zcompare t1 t2); Apply relation_ind2.
-
-(* \subsection{Interprétations}
-   \subsubsection{Interprétation des termes dans Z} *)
-
-Fixpoint interp_term [env:(list Z); t:term] : Z :=
-  Cases t of
-    (Tint x) => x
-  | (Tplus t1 t2) => (Zplus (interp_term env t1) (interp_term env t2))
-  | (Tmult t1 t2) => (Zmult (interp_term env t1) (interp_term env t2))
-  | (Tminus t1 t2) => (Zminus (interp_term env t1) (interp_term env t2))
-  | (Topp t) => (Zopp (interp_term env t))
-  | (Tvar n) => (nth n env ZERO)
-  end.
-
-(* \subsubsection{Interprétation des prédicats} *) 
-Fixpoint interp_proposition 
-    [envp : PropList; env: (list Z); p:proposition] : Prop := 
-  Cases p of
-    (EqTerm t1 t2) => ((interp_term env t1) = (interp_term env t2))
-  | (LeqTerm t1 t2) => `(interp_term env t1) <= (interp_term env t2)`
-  | TrueTerm => True
-  | FalseTerm => False
-  | (Tnot p') => ~(interp_proposition envp env p')
-  | (GeqTerm t1 t2) => `(interp_term env t1) >= (interp_term env t2)`
-  | (GtTerm t1 t2) => `(interp_term env t1) > (interp_term env t2)`
-  | (LtTerm t1 t2) => `(interp_term env t1) < (interp_term env t2)`
-  | (NeqTerm t1 t2) => `(Zne (interp_term env t1) (interp_term env t2))`
-
-  | (Tor p1 p2) => 
-	(interp_proposition envp env p1) \/ (interp_proposition envp env p2)
-  | (Tand p1 p2) =>
-	(interp_proposition envp env p1) /\ (interp_proposition envp env p2)
-  | (Timp p1 p2) =>
-	(interp_proposition envp env p1) -> (interp_proposition envp env p2)
-  | (Tprop n) => (nthProp n envp True)
-  end.
-
-(* \subsubsection{Inteprétation des listes d'hypothèses}
-   \paragraph{Sous forme de conjonction}
-   Interprétation sous forme d'une conjonction d'hypothèses plus faciles
-   à manipuler individuellement *)
-
-Fixpoint interp_hyps [envp: PropList; env : (list Z); l: hyps] : Prop :=
-  Cases l of 
-     nil => True
-   | (cons p' l') => 
-	(interp_proposition envp env p') /\ (interp_hyps envp env l')
-  end.
-
-(* \paragraph{sous forme de but}
-   C'est cette interpétation que l'on utilise sur le but (car on utilise
-   [Generalize] et qu'une conjonction est forcément lourde (répétition des
-   types dans les conjonctions intermédiaires) *)
-
-Fixpoint interp_goal_concl [envp: PropList;env : (list Z); c: proposition; l: hyps] : Prop :=
-  Cases l of 
-     nil => (interp_proposition envp env c)
-   | (cons p' l') => 
-	(interp_proposition envp env p') -> (interp_goal_concl envp env c l')
-  end.
-
-Syntactic Definition interp_goal  :=
-  [envp: PropList;env : (list Z); l: hyps]
-	(interp_goal_concl envp env FalseTerm l).
-
-(* Les théorèmes qui suivent assurent la correspondance entre les deux
-   interprétations. *)
-
-Theorem goal_to_hyps : 
-  (envp: PropList; env : (list Z); l: hyps) 
-     ((interp_hyps envp env l) -> False) -> (interp_goal envp env l).
-
-Induction l; [
-  Simpl; Auto
-| Simpl; Intros a l1 H1 H2 H3; Apply H1; Intro H4; Apply H2; Auto ].
-Save.
-
-Theorem hyps_to_goal : 
-  (envp: PropList; env : (list Z); l: hyps) 
-     (interp_goal envp env l) -> ((interp_hyps envp env l) -> False).
-
-Induction l; Simpl; [
-  Auto
-| Intros; Apply H; Elim H1; Auto ].
-Save.
-      
-(* \subsection{Manipulations sur les hypothèses} *)
-
-(* \subsubsection{Définitions de base de stabilité pour la réflexion} *)
-(* Une opération laisse un terme stable si l'égalité est préservée *)
-Definition term_stable [f: term -> term] :=
- (e: (list Z); t:term) (interp_term e t) = (interp_term e (f t)).
-
-(* Une opération est valide sur une hypothèse, si l'hypothèse implique le
-   résultat de l'opération. \emph{Attention : cela ne concerne que des 
-   opérations sur les hypothèses et non sur les buts (contravariance)}.
-   On définit la validité pour une opération prenant une ou deux propositions
-   en argument (cela suffit pour omega). *)
-
-Definition valid1 [f: proposition -> proposition] :=
-  (ep : PropList; e: (list Z)) (p1: proposition) 
-    (interp_proposition ep e p1) -> (interp_proposition ep e (f p1)).
-
-Definition valid2 [f: proposition -> proposition -> proposition] :=
-  (ep : PropList; e: (list Z)) (p1,p2: proposition) 
-    (interp_proposition ep e p1) -> (interp_proposition ep e p2) ->
-      (interp_proposition ep e (f p1 p2)).
-
-(* Dans cette notion de validité, la fonction prend directement une 
-   liste de propositions et rend une nouvelle liste de proposition. 
-   On reste contravariant *)
-
-Definition valid_hyps [f: hyps -> hyps] :=
-  (ep : PropList; e : (list Z))
-    (lp: hyps) (interp_hyps ep e lp) -> (interp_hyps ep e (f lp)).
-
-(* Enfin ce théorème élimine la contravariance et nous ramène à une 
-   opération sur les buts *)
-
- Theorem valid_goal :
-  (ep: PropList; env : (list Z); l: hyps; a : hyps -> hyps) 
-    (valid_hyps a) -> (interp_goal ep env (a l)) -> (interp_goal ep env l).
-
-Intros; Simpl; Apply goal_to_hyps; Intro H1;
-Apply (hyps_to_goal ep env (a l) H0); Apply H; Assumption.
-Save.
-
-(* \subsubsection{Généralisation a des listes de buts (disjonctions)} *)
-
-
-Fixpoint interp_list_hyps [envp: PropList; env: (list Z); l : lhyps] : Prop :=
-   Cases l of
-      nil => False
-    | (cons h l') => (interp_hyps envp env h) \/ (interp_list_hyps envp env l')
-   end.
-
-Fixpoint interp_list_goal [envp: PropList; env: (list Z);l : lhyps] : Prop :=
-   Cases l of
-      nil => True
-    | (cons h l') => (interp_goal envp env h) /\ (interp_list_goal envp env l')
-   end.
-
-Theorem list_goal_to_hyps : 
-  (envp: PropList; env: (list Z); l: lhyps)
-    ((interp_list_hyps envp env l) -> False) -> (interp_list_goal envp env l).
-
-Induction l; Simpl; [
-  Auto
-| Intros h1 l1 H H1; Split; [
-    Apply goal_to_hyps; Intro H2; Apply H1; Auto
-  | Apply H; Intro H2; Apply H1; Auto ]].
-Save.
-
-Theorem list_hyps_to_goal : 
-  (envp: PropList; env: (list Z); l: lhyps)
-    (interp_list_goal envp env l) -> ((interp_list_hyps envp env l) -> False).
-
-Induction l; Simpl; [
-  Auto
-|  Intros h1 l1 H (H1,H2) H3; Elim H3; Intro H4; [
-     Apply hyps_to_goal with 1 := H1; Assumption
-   | Auto ]].
-Save.
-
-Definition valid_list_hyps [f: hyps -> lhyps] :=
-  (ep : PropList; e : (list Z)) (lp: hyps)
-    (interp_hyps ep e lp) -> (interp_list_hyps ep e (f lp)).
-
-Definition valid_list_goal [f: hyps -> lhyps] :=
-  (ep : PropList; e : (list Z)) (lp: hyps) 
-     (interp_list_goal ep e (f lp)) -> (interp_goal ep e lp) .
-
-Theorem goal_valid : 
-  (f: hyps -> lhyps) (valid_list_hyps f) -> (valid_list_goal f).
-
-Unfold valid_list_goal; Intros f H ep e lp H1; Apply goal_to_hyps;
-Intro H2; Apply list_hyps_to_goal with 1:=H1; Apply (H ep e lp); Assumption.
-Save.
- 
-Theorem append_valid :
-  (ep: PropList; e: (list Z)) (l1,l2:lhyps)
-     (interp_list_hyps ep e l1) \/ (interp_list_hyps ep e l2) ->
-     (interp_list_hyps ep e (app l1 l2)).
-
-Intros ep e; Induction l1; [
-  Simpl; Intros l2 [H | H]; [ Contradiction | Trivial ]
-| Simpl; Intros h1 t1 HR l2 [[H | H] | H] ;[
-    Auto
-  | Right; Apply (HR l2); Left; Trivial
-  | Right; Apply (HR l2); Right; Trivial ]].
-
-Save.
-
-(* \subsubsection{Opérateurs valides sur les hypothèses} *)
-
-(* Extraire une hypothèse de la liste *)
-Definition nth_hyps [n:nat; l: hyps] := (nth n l TrueTerm).
-
-Theorem nth_valid :
-  (ep: PropList; e: (list Z); i:nat; l: hyps) 
-     (interp_hyps ep e l) -> (interp_proposition ep e (nth_hyps i l)).
-
-Unfold nth_hyps; Induction i; [
-  Induction l; Simpl; [ Auto | Intros; Elim H0; Auto ]
-| Intros n H; Induction l;
-    [ Simpl; Trivial | Intros; Simpl; Apply H; Elim H1; Auto ]].
-Save.
-
-(* Appliquer une opération (valide) sur deux hypothèses extraites de 
-   la liste et ajouter le résultat à la liste. *)
-Definition apply_oper_2 
-  [i,j : nat; f : proposition -> proposition -> proposition ] :=
-  [l: hyps] (cons (f (nth_hyps i l)  (nth_hyps j l)) l).
-
-Theorem apply_oper_2_valid :
-  (i,j : nat; f : proposition -> proposition -> proposition )
-    (valid2 f) -> (valid_hyps (apply_oper_2 i j f)).
-
-Intros i j f Hf; Unfold apply_oper_2 valid_hyps; Simpl; Intros lp Hlp; Split;
-  [ Apply Hf; Apply nth_valid; Assumption | Assumption].
-Save.
-
-(* Modifier une hypothèse par application d'une opération valide *)
-
-Fixpoint apply_oper_1 [i:nat] : (proposition -> proposition) -> hyps -> hyps :=
-  [f : (proposition -> proposition); l : hyps] 
-    Cases l of 
-       nil => (nil proposition)
-    | (cons p l') =>
-	 Cases i of
-           O => (cons (f p) l')
-         | (S j) => (cons p (apply_oper_1 j f l'))
-         end
-    end.
-
-Theorem apply_oper_1_valid :
-  (i : nat; f : proposition -> proposition )
-    (valid1 f) -> (valid_hyps (apply_oper_1 i f)).
-
-Unfold valid_hyps; Intros i f Hf ep e; Elim i; [
-  Intro lp; Case lp; [
-    Simpl; Trivial
-  | Simpl; Intros p l' (H1, H2); Split; [ Apply Hf with 1:=H1 | Assumption ]]
-| Intros n Hrec lp; Case lp; [
-    Simpl; Auto
-  | Simpl; Intros p l' (H1, H2); 
-    Split; [ Assumption | Apply Hrec; Assumption ]]].
-
-Save.
-
-(* \subsubsection{Manipulations de termes} *)
-(* Les fonctions suivantes permettent d'appliquer une fonction de
-   réécriture sur un sous terme du terme principal. Avec la composition,
-   cela permet de construire des réécritures complexes proches des 
-   tactiques de conversion *)
-
-Definition apply_left [f: term -> term; t : term]:= 
-  Cases t of
-    (Tplus x y) => (Tplus (f x) y)
-  | (Tmult x y) => (Tmult (f x) y)
-  | (Topp x) => (Topp (f x))
-  | x => x
-  end.
-
-Definition apply_right [f: term -> term; t : term]:= 
-  Cases t of
-    (Tplus x y) => (Tplus x (f y))
-  | (Tmult x y) => (Tmult x (f y))
-  | x => x
-  end.
-
-Definition apply_both [f,g: term -> term; t : term]:= 
-  Cases t of
-    (Tplus x y) => (Tplus (f x) (g y))
-  | (Tmult x y) => (Tmult (f x) (g y))
-  | x => x
-  end.
-
-(* Les théorèmes suivants montrent la stabilité (conditionnée) des 
-   fonctions. *)
-
-Theorem apply_left_stable :
-  (f: term -> term) (term_stable f) -> (term_stable (apply_left f)).
-
-Unfold term_stable; Intros f H e t; Case t; Auto; Simpl; 
-Intros;  Elim H; Trivial.
-Save.
-
-Theorem apply_right_stable :
-  (f: term -> term) (term_stable f) -> (term_stable (apply_right f)).
-
-Unfold term_stable; Intros f H e t; Case t; Auto; Simpl; 
-Intros t0 t1; Elim H; Trivial.
-Save.
-
-Theorem apply_both_stable :
-  (f,g: term -> term) (term_stable f) -> (term_stable g) -> 
-     (term_stable (apply_both f g)).
-
-Unfold term_stable; Intros f g H1 H2 e t; Case t; Auto; Simpl; 
-Intros t0 t1; Elim H1; Elim H2; Trivial.
-Save.
-
-Theorem compose_term_stable :
-  (f,g: term -> term) (term_stable f) -> (term_stable g) -> 
-    (term_stable [t: term](f (g t))).
-
-Unfold term_stable; Intros f g Hf Hg e t; Elim Hf; Apply Hg.
-Save.
-
-(* \subsection{Les règles de réécriture} *)
-(* Chacune des règles de réécriture est accompagnée par sa preuve de 
-   stabilité. Toutes ces preuves ont la même forme : il faut analyser 
-   suivant la forme du terme (élimination de chaque Case). On a besoin d'une
-   élimination uniquement dans les cas d'utilisation d'égalité décidable. 
-
-   Cette tactique itère la décomposition des Case. Elle est
-   constituée de deux fonctions s'appelant mutuellement :
-   \begin{itemize} 
-    \item une fonction d'enrobage qui lance la recherche sur le but,
-    \item une fonction récursive qui décompose ce but. Quand elle a trouvé un
-          Case, elle l'élimine. 
-   \end{itemize}  
-   Les motifs sur les cas sont très imparfaits et dans certains cas, il
-   semble que cela ne marche pas. On aimerait plutot un motif de la
-   forme [ Case (?1 :: T) of _ end ] permettant de s'assurer que l'on 
-   utilise le bon type.
-
-   Chaque élimination introduit correctement exactement le nombre d'hypothèses
-   nécessaires et conserve dans le cas d'une égalité la connaissance du
-   résultat du test en faisant la réécriture. Pour un test de comparaison,
-   on conserve simplement le résultat.
-
-   Cette fonction déborde très largement la résolution des réécritures
-   simples et fait une bonne partie des preuves des pas de Omega.
-*)
-
-(* \subsubsection{La tactique pour prouver la stabilité} *)
-
-Recursive Tactic Definition loop t := (
-  Match t With
-  (* Global *)
-    [(?1 = ?2)] -> (loop ?1) Orelse (loop ?2)
-  | [ ? -> ?1 ] ->  (loop ?1)
-  (* Interpretations *)
-  | [ (interp_hyps ? ? ?1) ] -> (loop ?1)
-  | [ (interp_list_hyps ? ? ?1) ] -> (loop ?1)
-  | [ (interp_proposition ? ? ?1) ] -> (loop ?1)
-  | [ (interp_term ? ?1) ] -> (loop ?1)
-  (* Propositions *)
-  | [(EqTerm ?1 ?2)] -> (loop ?1) Orelse (loop ?2)
-  | [(LeqTerm ?1 ?2)] -> (loop ?1) Orelse (loop ?2)
-  (* Termes *)
-  | [(Tplus ?1 ?2)] -> (loop ?1) Orelse (loop ?2)
-  | [(Tminus ?1 ?2)] -> (loop ?1) Orelse (loop ?2)
-  | [(Tmult ?1 ?2)] -> (loop ?1) Orelse (loop ?2)
-  | [(Topp ?1)] -> (loop ?1)
-  | [(Tint ?1)] -> (loop ?1)
-  (* Eliminations *)
-  |  [(Cases ?1 of
-        | (EqTerm _ _) => ?
-        | (LeqTerm _ _) => ?
-        | TrueTerm => ?
-        | FalseTerm => ?
-        | (Tnot _) => ?
-        | (GeqTerm _ _) => ?
-        | (GtTerm _ _) => ?
-        | (LtTerm _ _) => ?
-        | (NeqTerm _ _) => ?
-        | (Tor _ _) => ?
-        | (Tand _ _) => ?
-        | (Timp _ _) => ?
-        | (Tprop _) => ?
-        end)] -> 
-       (Case ?1; [ Intro; Intro | Intro; Intro | Idtac | Idtac 
-                 | Intro | Intro; Intro | Intro; Intro | Intro; Intro
-                 | Intro; Intro
-                 | Intro;Intro | Intro;Intro | Intro;Intro | Intro  ]);
-        Auto; Simplify
-  | [(Cases ?1 of
-        (Tint _) => ?
-      | (Tplus _ _) => ?
-      | (Tmult _ _) => ?
-      | (Tminus _ _) => ?
-      | (Topp _) => ?
-      | (Tvar _) => ?
-      end)] -> 
-       (Case ?1; [ Intro | Intro; Intro | Intro; Intro | Intro; Intro | 
-                   Intro | Intro ]); Auto; Simplify
-  | [(Cases (Zcompare ?1 ?2) of
-        EGAL => ?
-      | INFERIEUR => ?
-      | SUPERIEUR => ?
-      end)] -> 
-       (Elim_Zcompare ?1 ?2) ; Intro ; Auto; Simplify
-  | [(Cases ?1 of ZERO => ? | (POS _) => ? | (NEG _) => ? end)] -> 
-       (Case ?1; [ Idtac | Intro | Intro ]); Auto; Simplify
-  | [(if (eq_Z ?1 ?2) then ? else ?)] -> 
-       ((Elim_eq_Z ?1 ?2); Intro H; [Rewrite H; Clear H | Clear H]);
-       Simpl; Auto; Simplify
-  | [(if (eq_term ?1 ?2) then ? else ?)] -> 
-       ((Elim_eq_term ?1 ?2); Intro H; [Rewrite H; Clear H | Clear H]); 
-       Simpl; Auto; Simplify
-  | [(if (eq_pos ?1 ?2) then ? else ?)] -> 
-       ((Elim_eq_pos ?1 ?2); Intro H; [Rewrite H; Clear H | Clear H]);
-       Simpl; Auto; Simplify
-  | _ -> Fail)
-And Simplify := (
-  Match Context With [|- ?1 ] -> Try (loop ?1) | _ -> Idtac).
-
-
-Tactic Definition ProveStable x th :=
-  (Match x With [?1] -> Unfold term_stable ?1; Intros; Simplify; Simpl; Apply th).
-
-(* \subsubsection{Les règles elle mêmes} *)
-Definition Tplus_assoc_l [t: term] :=
-  Cases t of
-    (Tplus n (Tplus m p)) => (Tplus (Tplus n m) p)
-  | _ => t
-  end.
-
-Theorem  Tplus_assoc_l_stable : (term_stable  Tplus_assoc_l).
-
-(ProveStable Tplus_assoc_l Zplus_assoc_l).
-Save.
-
-Definition Tplus_assoc_r [t: term] :=
-  Cases t of
-    (Tplus (Tplus n m) p) => (Tplus n (Tplus m p))
-  | _ => t
-  end.
-
-Theorem  Tplus_assoc_r_stable : (term_stable  Tplus_assoc_r).
-
-(ProveStable Tplus_assoc_r Zplus_assoc_r).
-Save.
-
-Definition Tmult_assoc_r [t: term] :=
-  Cases t of
-    (Tmult (Tmult n m) p) => (Tmult n (Tmult m p))
-  | _ => t
-  end.
-
-Theorem  Tmult_assoc_r_stable : (term_stable  Tmult_assoc_r).
-
-(ProveStable Tmult_assoc_r Zmult_assoc_r).
-Save.
-
-Definition Tplus_permute [t: term] :=
-  Cases t of
-    (Tplus n (Tplus m p)) => (Tplus m (Tplus n p))
-  | _ => t
-  end.
-
-Theorem  Tplus_permute_stable : (term_stable  Tplus_permute).
-
-(ProveStable Tplus_permute Zplus_permute).
-Save.
-
-Definition Tplus_sym [t: term] :=
-  Cases t of
-    (Tplus x y) => (Tplus y x)
-  | _ => t
-  end.
-
-Theorem Tplus_sym_stable : (term_stable Tplus_sym).
-
-(ProveStable Tplus_sym Zplus_sym).
-Save.
-
-Definition Tmult_sym [t: term] :=
-  Cases t of
-    (Tmult x y) => (Tmult y x)
-  | _ => t
-  end.
-
-Theorem Tmult_sym_stable : (term_stable Tmult_sym).
-
-(ProveStable Tmult_sym Zmult_sym).
-Save.
-
-Definition T_OMEGA10 [t: term] :=
-  Cases t of
-    (Tplus (Tmult (Tplus (Tmult v (Tint c1)) l1) (Tint k1))
-           (Tmult (Tplus (Tmult v' (Tint c2)) l2) (Tint k2))) =>
-	Case (eq_term v v') of
-	    (Tplus (Tmult v (Tint (Zplus (Zmult c1 k1) (Zmult c2 k2)))) 
-                   (Tplus (Tmult l1 (Tint k1)) (Tmult l2 (Tint k2))))
-           t
-        end
-  | _ => t
-  end.
-
-Theorem  T_OMEGA10_stable : (term_stable  T_OMEGA10).
-
-(ProveStable T_OMEGA10 OMEGA10).
-Save.
-
-Definition T_OMEGA11 [t: term] :=
-  Cases t of
-    (Tplus (Tmult (Tplus (Tmult v1 (Tint c1)) l1) (Tint k1)) l2) =>
-	(Tplus (Tmult v1 (Tint (Zmult c1 k1))) (Tplus (Tmult l1 (Tint k1)) l2))
-  | _ => t
-  end.
-
-Theorem  T_OMEGA11_stable : (term_stable  T_OMEGA11).
-
-(ProveStable T_OMEGA11 OMEGA11).
-Save.
-
-Definition T_OMEGA12 [t: term] :=
-  Cases t of
-    (Tplus l1 (Tmult (Tplus (Tmult v2 (Tint c2)) l2) (Tint k2))) =>
-        (Tplus (Tmult v2 (Tint (Zmult c2 k2))) (Tplus l1 (Tmult l2 (Tint k2))))
-  | _ => t
-  end.
-
-Theorem  T_OMEGA12_stable : (term_stable  T_OMEGA12).
-
-(ProveStable T_OMEGA12 OMEGA12).
-Save. 
-
-Definition T_OMEGA13 [t: term] :=
-  Cases t of
-    (Tplus (Tplus (Tmult v (Tint (POS x))) l1) 
-	   (Tplus (Tmult v' (Tint (NEG x'))) l2)) =>
-	Case (eq_term v v') of
-	  Case (eq_pos x x') of
-	    (Tplus l1 l2)
-            t
-	  end
-	  t
-	end
-  | (Tplus (Tplus (Tmult v (Tint (NEG x))) l1) 
-	   (Tplus (Tmult v' (Tint (POS x'))) l2)) =>
-	Case (eq_term v v') of
-	  Case (eq_pos x x') of
-	    (Tplus l1 l2)
-             t
-	  end
-	  t
-	end
-
-  | _ => t
-  end.
-
-Theorem  T_OMEGA13_stable : (term_stable  T_OMEGA13).
-
-Unfold term_stable T_OMEGA13; Intros; Simplify; Simpl; 
-  [ Apply OMEGA13 | Apply OMEGA14 ].
-Save.
-
-Definition T_OMEGA15 [t: term] :=
-  Cases t of
-    (Tplus (Tplus (Tmult v (Tint c1)) l1) 
-	   (Tmult (Tplus (Tmult v' (Tint c2)) l2) (Tint k2))) =>
-	Case (eq_term v v') of
-	  (Tplus (Tmult v (Tint (Zplus c1 (Zmult c2 k2))))
-	                  (Tplus l1 (Tmult l2 (Tint k2))))
-	  t
-	end
-  | _ => t
-  end.
-
-Theorem  T_OMEGA15_stable : (term_stable  T_OMEGA15).
-
-(ProveStable T_OMEGA15 OMEGA15).
-Save.
-
-Definition T_OMEGA16 [t: term] :=
-  Cases t of
-    (Tmult (Tplus (Tmult v (Tint c)) l) (Tint k)) =>
-       (Tplus (Tmult v (Tint (Zmult c k))) (Tmult l (Tint k)))
-  | _ => t
-  end.
-
-
-Theorem  T_OMEGA16_stable : (term_stable  T_OMEGA16).
-
-(ProveStable T_OMEGA16 OMEGA16).
-Save.
-
-Definition Tred_factor5 [t: term] := 
-   Cases t of
-      (Tplus (Tmult x (Tint ZERO)) y) => y
-   | _ => t
-   end.
-
-Theorem Tred_factor5_stable : (term_stable  Tred_factor5).
-
-
-(ProveStable Tred_factor5 Zred_factor5).
-Save.
-
-Definition Topp_plus [t: term] :=
-  Cases t of
-    (Topp (Tplus x y)) => (Tplus (Topp x) (Topp y))
-  | _ => t
-  end.
-
-Theorem Topp_plus_stable : (term_stable Topp_plus).
-
-(ProveStable Topp_plus Zopp_Zplus).
-Save.
-
-
-Definition Topp_opp [t: term] :=
-  Cases t of
-    (Topp (Topp x)) => x
-  | _ => t
-  end.
-
-Theorem Topp_opp_stable : (term_stable Topp_opp).
-
-(ProveStable Topp_opp Zopp_Zopp).
-Save.
-
-Definition Topp_mult_r [t: term] :=
-  Cases t of
-    (Topp (Tmult x (Tint k))) => (Tmult x (Tint (Zopp k)))
-  | _ => t
-  end.
-
-Theorem Topp_mult_r_stable : (term_stable Topp_mult_r).
-
-(ProveStable Topp_mult_r Zopp_Zmult_r).
-Save.
-
-Definition Topp_one [t: term] :=
-  Cases t of
-    (Topp x) => (Tmult x (Tint `-1`))
-  | _ => t
-  end.
-
-Theorem Topp_one_stable : (term_stable Topp_one).
-
-(ProveStable Topp_one Zopp_one).
-Save.
-
-Definition Tmult_plus_distr  [t: term] :=
-  Cases t of
-    (Tmult (Tplus n m) p) => (Tplus (Tmult n p) (Tmult m p))
-  | _ => t
-  end.
-
-Theorem Tmult_plus_distr_stable : (term_stable Tmult_plus_distr).
-
-(ProveStable Tmult_plus_distr Zmult_plus_distr).
-Save.
-
-Definition Tmult_opp_left [t: term] :=
-  Cases t of
-    (Tmult (Topp x) (Tint y)) => (Tmult x (Tint (Zopp y)))
-  | _ => t
-  end.
-
-Theorem Tmult_opp_left_stable : (term_stable Tmult_opp_left).
-
-(ProveStable Tmult_opp_left Zmult_Zopp_left).
-Save.
-
-Definition Tmult_assoc_reduced [t: term] :=
-  Cases t of
-    (Tmult (Tmult n (Tint m)) (Tint p)) => (Tmult n (Tint (Zmult m p)))
-  | _ => t
-  end.
-
-Theorem  Tmult_assoc_reduced_stable : (term_stable  Tmult_assoc_reduced).
-
-(ProveStable Tmult_assoc_reduced Zmult_assoc_r).
-Save.
-
-Definition Tred_factor0 [t: term] := (Tmult t (Tint `1`)).
-
-Theorem  Tred_factor0_stable : (term_stable  Tred_factor0).
-
-(ProveStable Tred_factor0 Zred_factor0).
-Save.
-
-Definition Tred_factor1 [t: term] :=
-  Cases t of
-    (Tplus x y) => 
-	Case (eq_term x y) of
-	  (Tmult x (Tint `2`))
-	  t
-        end
-  | _ => t
-  end.
-
-Theorem  Tred_factor1_stable : (term_stable  Tred_factor1).
-
-(ProveStable Tred_factor1 Zred_factor1).
-Save.
-
-Definition Tred_factor2 [t: term] :=
-  Cases t of
-    (Tplus x (Tmult y (Tint k))) => 
-	Case (eq_term x y) of
-	  (Tmult x (Tint (Zplus `1` k)))
-	  t
-        end
-  | _ => t
-  end.
-
-(* Attention : il faut rendre opaque [Zplus] pour éviter que la tactique
-   de simplification n'aille trop loin et défasse [Zplus 1 k] *)
-
-Opaque Zplus.
-
-Theorem  Tred_factor2_stable : (term_stable  Tred_factor2).
-(ProveStable Tred_factor2 Zred_factor2).
-Save.
-
-Definition Tred_factor3 [t: term] :=
-  Cases t of
-    (Tplus (Tmult x (Tint k)) y) => 
-	Case (eq_term x y) of
-	  (Tmult x (Tint `1+k`))
-	  t
-        end
-  | _ => t
-  end.
-
-Theorem  Tred_factor3_stable : (term_stable  Tred_factor3).
-
-(ProveStable Tred_factor3 Zred_factor3).
-Save.
-
-
-Definition Tred_factor4 [t: term] :=
-  Cases t of
-    (Tplus (Tmult x (Tint k1)) (Tmult y (Tint k2))) => 
-	Case (eq_term x y) of
-	  (Tmult x (Tint `k1+k2`))
-	  t
-        end
-  | _ => t
-  end.
-
-Theorem  Tred_factor4_stable : (term_stable  Tred_factor4).
-
-(ProveStable Tred_factor4 Zred_factor4).
-Save.
-
-Definition Tred_factor6 [t: term] := (Tplus t (Tint `0`)).
-
-Theorem  Tred_factor6_stable : (term_stable  Tred_factor6).
-
-(ProveStable Tred_factor6 Zred_factor6).
-Save.
-
-Transparent Zplus.
-
-Definition Tminus_def [t:term] :=
-  Cases t of
-    (Tminus x y) => (Tplus x (Topp y))
-  | _ => t
-  end.
-
-Theorem  Tminus_def_stable : (term_stable  Tminus_def).
-
-(* Le théorème ne sert à rien. Le but est prouvé avant. *)
-(ProveStable Tminus_def False).
-Save.
-
-(* \subsection{Fonctions de réécriture complexes} *)
-
-(* \subsubsection{Fonction de réduction} *)
-(* Cette fonction réduit un terme dont la forme normale est un entier. Il
-   suffit pour cela d'échanger le constructeur [Tint] avec les opérateurs
-   réifiés. La réduction est ``gratuite''.  *)
-
-Fixpoint reduce [t:term] : term :=
-  Cases t of
-     (Tplus x y) =>
-	 Cases (reduce x) of
-	   (Tint x') =>
-	      Cases (reduce y) of
-	        (Tint y') => (Tint (Zplus x' y'))
-              | y' => (Tplus (Tint x') y')
-              end
-         | x' => (Tplus x' (reduce y))
-	 end
-  | (Tmult x y) =>
-	 Cases (reduce x) of
-	   (Tint x') =>
-	      Cases (reduce y) of
-	        (Tint y') => (Tint (Zmult x' y'))
-              | y' => (Tmult (Tint x') y')
-              end
-         | x' => (Tmult x' (reduce y))
-	 end
-  | (Tminus x y) =>
-	 Cases (reduce x) of
-	   (Tint x') =>
-	      Cases (reduce y) of
-	        (Tint y') => (Tint (Zminus x' y'))
-              | y' => (Tminus (Tint x') y')
-              end
-         | x' => (Tminus x' (reduce y))
-	 end
-  | (Topp x) =>
-        Cases (reduce x) of
-	  (Tint x') => (Tint (Zopp x'))
-	| x' => (Topp x')
-	end
-  | _ => t
-  end.
-
-Theorem reduce_stable : (term_stable reduce).
-
-Unfold term_stable; Intros e t; Elim t; Auto; 
-Try (Intros t0 H0 t1 H1; Simpl; Rewrite H0; Rewrite H1; (
- Case (reduce t0); [ 
-   Intro z0; Case (reduce t1); Intros; Auto
- | Intros; Auto
- | Intros; Auto
- | Intros; Auto
- | Intros; Auto
- | Intros; Auto ]));
-Intros t0 H0; Simpl; Rewrite H0; Case (reduce t0); Intros; Auto.
-Save.
-
-(* \subsubsection{Fusions}
-    \paragraph{Fusion de deux équations} *)
-(* On donne une somme de deux équations qui sont supposées normalisées. 
-   Cette fonction prend une trace de fusion en argument et transforme
-   le terme en une équation normalisée. C'est une version très simplifiée
-   du moteur de réécriture [rewrite]. *)
-
-Fixpoint fusion [trace : (list t_fusion)] : term -> term := [t: term]
-  Cases trace of
-    nil => (reduce t)
-  | (cons step trace') =>
-	Cases step of
-        | F_equal => 
-	    (apply_right (fusion trace') (T_OMEGA10 t))
-        | F_cancel => 
-	    (fusion trace' (Tred_factor5 (T_OMEGA10 t)))
-        | F_left => 
-	    (apply_right (fusion trace') (T_OMEGA11 t))
-        | F_right =>
-	    (apply_right (fusion trace') (T_OMEGA12 t))
-	end
-  end.
-    
-Theorem fusion_stable : (t : (list t_fusion)) (term_stable (fusion t)).
-
-Induction t; Simpl; [
-  Exact reduce_stable
-| Intros stp l H; Case stp; [
-    Apply compose_term_stable; 
-      [ Apply apply_right_stable; Assumption | Exact T_OMEGA10_stable ]
-  | Unfold term_stable; Intros e t1; Rewrite T_OMEGA10_stable; 
-    Rewrite Tred_factor5_stable; Apply H
-  | Apply compose_term_stable; 
-      [ Apply apply_right_stable; Assumption | Exact T_OMEGA11_stable ]
-  | Apply compose_term_stable;
-      [ Apply apply_right_stable; Assumption | Exact T_OMEGA12_stable ]]].
-
-Save.
-
-(* \paragraph{Fusion de deux équations dont une sans coefficient} *)
-
-Definition fusion_right [trace : (list t_fusion)] : term -> term := [t: term]
-  Cases trace of
-    nil => (reduce t)  (* Il faut mettre un compute *)
-  | (cons step trace') =>
-	Cases step of
-        | F_equal => 
-	    (apply_right (fusion trace') (T_OMEGA15 t))
-        | F_cancel => 
-	    (fusion trace' (Tred_factor5 (T_OMEGA15 t)))
-        | F_left => 
-	    (apply_right (fusion trace') (Tplus_assoc_r t))
-        | F_right =>
-	    (apply_right (fusion trace') (T_OMEGA12 t))
-	end
-  end.
-
-(* \paragraph{Fusion avec anihilation} *)
-(* Normalement le résultat est une constante *)
-
-Fixpoint fusion_cancel [trace:nat] : term -> term := [t:term]
-  Cases trace of
-    O => (reduce t)
-  | (S trace') => (fusion_cancel trace' (T_OMEGA13 t))
-  end.
-
-Theorem fusion_cancel_stable : (t:nat) (term_stable (fusion_cancel t)).
-
-Unfold term_stable fusion_cancel; Intros trace e; Elim trace; [
-  Exact (reduce_stable e)
-| Intros n H t; Elim H; Exact (T_OMEGA13_stable e t) ].
-Save. 
-
-(* \subsubsection{Opérations afines sur une équation} *)
-(* \paragraph{Multiplication scalaire et somme d'une constante} *)
-
-Fixpoint scalar_norm_add [trace:nat] : term -> term := [t: term]
-  Cases trace of
-    O => (reduce t)
-  | (S trace') => (apply_right (scalar_norm_add trace') (T_OMEGA11 t))
-  end.
-
-Theorem scalar_norm_add_stable : (t:nat) (term_stable (scalar_norm_add t)).
-
-Unfold term_stable scalar_norm_add; Intros trace; Elim trace; [
-  Exact reduce_stable
-| Intros n H e t; Elim apply_right_stable; 
-    [ Exact (T_OMEGA11_stable e t) | Exact H ]].
-Save.
-   
-(* \paragraph{Multiplication scalaire} *)
-Fixpoint scalar_norm [trace:nat] : term -> term := [t: term]
-  Cases trace of
-    O => (reduce t)
-  | (S trace') => (apply_right (scalar_norm trace') (T_OMEGA16 t))
-  end.
-
-Theorem scalar_norm_stable : (t:nat) (term_stable (scalar_norm t)).
-
-Unfold term_stable scalar_norm; Intros trace; Elim trace; [
-  Exact reduce_stable
-| Intros n H e t; Elim apply_right_stable;
-    [ Exact (T_OMEGA16_stable e t) | Exact H ]].
-Save.
-
-(* \paragraph{Somme d'une constante} *)
-Fixpoint add_norm [trace:nat] : term -> term := [t: term]
-  Cases trace of
-    O => (reduce t)
-  | (S trace') => (apply_right (add_norm trace') (Tplus_assoc_r t))
-  end.
-
-Theorem add_norm_stable : (t:nat) (term_stable (add_norm t)).
-
-Unfold term_stable add_norm; Intros trace; Elim trace; [
-  Exact reduce_stable
-| Intros n H e t; Elim apply_right_stable;
-    [ Exact (Tplus_assoc_r_stable e t) | Exact H ]].
-Save.
-
-(* \subsection{La fonction de normalisation des termes (moteur de réécriture)} *)
-
-
-Fixpoint rewrite [s: step] : term -> term :=
-  Cases s of 
-   | (C_DO_BOTH s1 s2) => (apply_both (rewrite s1) (rewrite s2))
-   | (C_LEFT s) => (apply_left (rewrite s))
-   | (C_RIGHT s) => (apply_right (rewrite s))
-   | (C_SEQ s1 s2) => [t: term] (rewrite s2 (rewrite s1 t))
-   | C_NOP => [t:term] t
-   | C_OPP_PLUS => Topp_plus
-   | C_OPP_OPP => Topp_opp
-   | C_OPP_MULT_R => Topp_mult_r
-   | C_OPP_ONE => Topp_one
-   | C_REDUCE => reduce
-   | C_MULT_PLUS_DISTR => Tmult_plus_distr
-   | C_MULT_OPP_LEFT => Tmult_opp_left
-   | C_MULT_ASSOC_R => Tmult_assoc_r
-   | C_PLUS_ASSOC_R => Tplus_assoc_r
-   | C_PLUS_ASSOC_L => Tplus_assoc_l
-   | C_PLUS_PERMUTE => Tplus_permute
-   | C_PLUS_SYM => Tplus_sym
-   | C_RED0 => Tred_factor0
-   | C_RED1 => Tred_factor1
-   | C_RED2 => Tred_factor2
-   | C_RED3 => Tred_factor3
-   | C_RED4 => Tred_factor4
-   | C_RED5 => Tred_factor5
-   | C_RED6 => Tred_factor6
-   | C_MULT_ASSOC_REDUCED => Tmult_assoc_reduced
-   | C_MINUS => Tminus_def
-   | C_MULT_SYM => Tmult_sym
-  end.
-
-Theorem rewrite_stable : (s:step) (term_stable (rewrite s)).
-
-Induction s; Simpl; [
-  Intros; Apply apply_both_stable; Auto
-| Intros; Apply apply_left_stable; Auto
-| Intros; Apply apply_right_stable; Auto
-| Unfold term_stable; Intros; Elim H0; Apply H
-| Unfold term_stable; Auto
-| Exact Topp_plus_stable
-| Exact Topp_opp_stable
-| Exact Topp_mult_r_stable
-| Exact Topp_one_stable
-| Exact reduce_stable
-| Exact Tmult_plus_distr_stable
-| Exact Tmult_opp_left_stable
-| Exact Tmult_assoc_r_stable
-| Exact Tplus_assoc_r_stable
-| Exact Tplus_assoc_l_stable
-| Exact Tplus_permute_stable
-| Exact Tplus_sym_stable
-| Exact Tred_factor0_stable
-| Exact Tred_factor1_stable
-| Exact Tred_factor2_stable
-| Exact Tred_factor3_stable
-| Exact Tred_factor4_stable
-| Exact Tred_factor5_stable
-| Exact Tred_factor6_stable
-| Exact Tmult_assoc_reduced_stable
-| Exact Tminus_def_stable
-| Exact Tmult_sym_stable ].
-Save.
-
-(* \subsection{tactiques de résolution d'un but omega normalisé} 
-   Trace de la procédure 
-\subsubsection{Tactiques générant une contradiction}
-\paragraph{[O_CONSTANT_NOT_NUL]} *)
-
-Definition constant_not_nul [i:nat; h: hyps] :=
-  Cases (nth_hyps i h) of
-     (EqTerm (Tint ZERO) (Tint n)) =>
-	Case (eq_Z n ZERO) of
-	    h
-            absurd
-        end
-   | _ => h
-  end.
-
-Theorem constant_not_nul_valid : 
-  (i:nat) (valid_hyps (constant_not_nul i)).
-
-Unfold valid_hyps constant_not_nul; Intros;
-Generalize (nth_valid ep e i lp); Simplify; Simpl; (Elim_eq_Z z0 ZERO); Auto;
-Simpl; Intros H1 H2; Elim H1; Symmetry; Auto.
-Save.   
-
-(* \paragraph{[O_CONSTANT_NEG]} *)
-
-Definition constant_neg [i:nat; h: hyps] :=
-   Cases (nth_hyps i h) of
-      (LeqTerm (Tint ZERO) (Tint (NEG n))) => absurd
-   | _ => h
-   end.
-
-Theorem constant_neg_valid : (i:nat) (valid_hyps (constant_neg i)).
-
-Unfold valid_hyps constant_neg; Intros;
-Generalize (nth_valid ep e i lp); Simplify; Simpl; Unfold Zle; Simpl;
-Intros H1; Elim H1; [ Assumption | Trivial ].
-Save.   
-
-(* \paragraph{[NOT_EXACT_DIVIDE]} *)
-Definition not_exact_divide [k1,k2:Z; body:term; t:nat; i : nat; l:hyps] :=
-  Cases (nth_hyps i l) of
-      (EqTerm (Tint ZERO) b) =>
-         Case (eq_term
-	         (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) b) of
-	   Cases (Zcompare k2 ZERO) of
-	     SUPERIEUR =>
-	       Cases (Zcompare k1 k2) of
-		 SUPERIEUR => absurd
-	       | _ => l
-	       end
-	   | _ => l
-           end
-	   l
-         end
-   | _ => l
-   end.
-
-Theorem not_exact_divide_valid : (k1,k2:Z; body:term; t:nat; i:nat) 
-	(valid_hyps (not_exact_divide k1 k2 body t i)).
-
-Unfold valid_hyps not_exact_divide; Intros; Generalize (nth_valid ep e i lp);
-Simplify;
-(Elim_eq_term '(scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2)))
-	     't1); Auto; 
-Simplify; 
-Intro H2; Elim H2; Simpl; Elim (scalar_norm_add_stable t e); Simpl;
-Intro H4; Absurd `(interp_term e body)*k1+k2 = 0`; [
-   Apply OMEGA4; Assumption | Symmetry; Auto ].
-
-Save.
-
-(* \paragraph{[O_CONTRADICTION]} *)
-
-Definition contradiction [t: nat; i,j:nat;l:hyps] :=
-  Cases (nth_hyps i l) of
-    (LeqTerm  (Tint ZERO) b1) =>
-	Cases (nth_hyps j l) of 
-	  (LeqTerm  (Tint ZERO) b2) => 
-	     Cases (fusion_cancel t (Tplus b1 b2)) of
-	       (Tint k) =>
-		  Cases (Zcompare ZERO k) of
-	            SUPERIEUR => absurd
-	          | _ => l
-                  end
-             | _ => l
-             end
-         | _ => l 
-        end
-  | _ => l 
-  end.
-
-Theorem contradiction_valid : (t,i,j: nat) (valid_hyps (contradiction t i j)).
-
-Unfold valid_hyps contradiction; Intros t i j ep e l H;
-Generalize (nth_valid ? ? i ? H); Generalize (nth_valid ? ? j ? H);
-Case (nth_hyps i l); Auto; Intros t1 t2; Case t1; Auto; Intros z; Case z; Auto;
-Case (nth_hyps j l); Auto; Intros t3 t4; Case t3; Auto; Intros z'; Case z'; 
-Auto; Simpl; Intros H1 H2;
-Generalize (refl_equal Z (interp_term e (fusion_cancel t (Tplus t2 t4))));
-Pattern 2 3 (fusion_cancel t (Tplus t2 t4));
-Case (fusion_cancel t (Tplus t2 t4)); 
-Simpl; Auto; Intro k; Elim (fusion_cancel_stable t);
-Simpl; Intro E; Generalize (OMEGA2 ? ? H2 H1); Rewrite E; Case k; 
-Auto;Unfold Zle; Simpl; Intros p H3; Elim H3; Auto.
-
-Save.
-
-(* \paragraph{[O_NEGATE_CONTRADICT]} *)
-
-Definition negate_contradict [i1,i2:nat; h:hyps]:=
-  Cases (nth_hyps i1 h) of
-    (EqTerm (Tint ZERO) b1) =>
-	Cases (nth_hyps i2 h) of
-           (NeqTerm (Tint ZERO) b2) =>
-	      Cases (eq_term b1 b2) of
-	         true => absurd
-              |  false => h
-	    end
-        | _ => h
-        end
-  | (NeqTerm (Tint ZERO) b1) =>
-	Cases (nth_hyps i2 h) of
-           (EqTerm (Tint ZERO) b2) =>
-	      Cases (eq_term b1 b2) of
-	         true => absurd
-              |  false => h
-	    end
-        | _ => h
-        end
-  | _ => h
-  end.
-
-Definition negate_contradict_inv [t:nat; i1,i2:nat; h:hyps]:=
-  Cases (nth_hyps i1 h) of
-    (EqTerm (Tint ZERO) b1) =>
-	Cases (nth_hyps i2 h) of
-           (NeqTerm (Tint ZERO) b2) =>
-              Cases (eq_term b1 (scalar_norm t (Tmult b2 (Tint `-1`)))) of
-	         true => absurd
-              |  false => h
-	    end
-        | _ => h
-        end
-  | (NeqTerm (Tint ZERO) b1) =>
-	Cases (nth_hyps i2 h) of
-           (EqTerm (Tint ZERO) b2) =>
-              Cases (eq_term b1 (scalar_norm t (Tmult b2 (Tint `-1`)))) of
-	         true => absurd
-              |  false => h
-	    end
-        | _ => h
-        end
-  | _ => h
-  end.
-
-Theorem negate_contradict_valid :
-  (i,j:nat) (valid_hyps (negate_contradict i j)).
-
-Unfold valid_hyps negate_contradict; Intros i j ep e l H;
-Generalize (nth_valid ? ? i ? H); Generalize (nth_valid ? ? j ? H);
-Case (nth_hyps i l); Auto; Intros t1 t2; Case t1; Auto; Intros z; Case z; Auto;
-Case (nth_hyps j l); Auto; Intros t3 t4; Case t3; Auto; Intros z'; Case z'; 
-Auto; Simpl; Intros H1 H2; [
-  (Elim_eq_term t2 t4); Intro H3; [ Elim H1; Elim H3; Assumption | Assumption ]
-| (Elim_eq_term t2 t4); Intro H3; 
-    [ Elim H2; Rewrite H3; Assumption | Assumption ]].
-
-Save.
-
-Theorem negate_contradict_inv_valid :
-  (t,i,j:nat) (valid_hyps (negate_contradict_inv t i j)).
-
-
-Unfold valid_hyps negate_contradict_inv; Intros t i j ep e l H;
-Generalize (nth_valid ? ? i ? H); Generalize (nth_valid ? ? j ? H);
-Case (nth_hyps i l); Auto; Intros t1 t2; Case t1; Auto; Intros z; Case z; Auto;
-Case (nth_hyps j l); Auto; Intros t3 t4; Case t3; Auto; Intros z'; Case z'; 
-Auto; Simpl; Intros H1 H2;
-(Pattern (eq_term t2 (scalar_norm t (Tmult t4 (Tint (NEG xH))))); Apply bool_ind2; Intro Aux; [
-  Generalize (eq_term_true t2 (scalar_norm t (Tmult t4 (Tint (NEG xH)))) Aux);
-  Clear Aux
-| Generalize (eq_term_false t2 (scalar_norm t (Tmult t4 (Tint (NEG xH)))) Aux);
-  Clear Aux ]); [
-   Intro H3; Elim H1; Generalize H2; Rewrite H3; 
-   Rewrite <- (scalar_norm_stable t e); Simpl; Elim (interp_term e t4) ; 
-   Simpl; Auto; Intros p H4; Discriminate H4
- | Auto 
- | Intro H3; Elim H2; Rewrite H3; Elim (scalar_norm_stable t e); Simpl;
-   Elim H1; Simpl; Trivial
- | Auto ].
-
-Save.
-
-(* \subsubsection{Tactiques générant une nouvelle équation} *)
-(* \paragraph{[O_SUM]}
- C'est une oper2 valide mais elle traite plusieurs cas à la fois (suivant
- les opérateurs de comparaison des deux arguments) d'où une
- preuve un peu compliquée. On utilise quelques lemmes qui sont des 
- généralisations des théorèmes utilisés par OMEGA. *)
-
-Definition sum [k1,k2: Z; trace: (list t_fusion); prop1,prop2:proposition]:=
-  Cases prop1 of
-    (EqTerm (Tint ZERO) b1) =>
-	Cases prop2 of
-          (EqTerm (Tint ZERO) b2) =>
-	    (EqTerm 
-	       (Tint ZERO) 
-	       (fusion trace 
-	               (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))))
-        | (LeqTerm (Tint ZERO) b2) =>
-	    Cases (Zcompare k2 ZERO) of
-	       SUPERIEUR =>
-		 (LeqTerm 
-		    (Tint ZERO) 
-		    (fusion trace 
-			 (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))))
-            | _ => TrueTerm
-           end
-       | _ => TrueTerm
-       end
-  | (LeqTerm (Tint ZERO) b1) =>
-      Cases (Zcompare k1 ZERO) of
-        SUPERIEUR =>
-	  Cases prop2 of
-	    (EqTerm (Tint ZERO) b2) =>
-	      (LeqTerm 
-		 (Tint ZERO) 
-		 (fusion trace 
-			 (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))))
-	  | (LeqTerm (Tint ZERO) b2) =>
-	       Cases (Zcompare k2 ZERO) of
-		  SUPERIEUR =>
-		    (LeqTerm 
-		       (Tint ZERO) 
-		       (fusion trace 
-			    (Tplus (Tmult b1 (Tint k1)) 
-                                   (Tmult b2 (Tint k2)))))
-	       | _ => TrueTerm
-	      end
-	 | _ => TrueTerm
-	 end
-     | _ => TrueTerm
-     end
-  | (NeqTerm (Tint ZERO) b1) =>
-       Cases prop2 of
-	 (EqTerm (Tint ZERO) b2) =>
-	    Case (eq_Z k1 ZERO) of
-	       TrueTerm
-	       (NeqTerm 
-		  (Tint ZERO) 
-		  (fusion trace 
-			  (Tplus (Tmult b1 (Tint k1)) (Tmult b2 (Tint k2)))))
-	    end
-      | _ => TrueTerm
-      end
-  | _ => TrueTerm
-  end.
-
-Theorem sum1 :
-  (a,b,c,d:Z) (`0 = a`) -> (`0 = b`) -> (`0 = a*c + b*d`).
-
-Intros; Elim H; Elim H0; Simpl; Auto.
-Save.
-  
-Theorem sum2 :
-  (a,b,c,d:Z)  (`0 <= d`) -> (`0 = a`) -> (`0 <= b`) ->(`0 <= a*c + b*d`).
-
-Intros; Elim H0; Simpl; Generalize H H1; Case b; Case d; 
-Unfold Zle; Simpl; Auto.  
-Save.
-
-Theorem sum3 :
-  (a,b,c,d:Z)  (`0 <= c`) -> (`0 <= d`) -> (`0 <= a`) -> (`0 <= b`) ->(`0 <= a*c + b*d`).
-
-Intros a b c d; Case a; Case b; Case c; Case d; Unfold Zle; Simpl; Auto. 
-Save.
-
-Theorem sum4 : (k:Z) (Zcompare k `0`)=SUPERIEUR -> (`0 <= k`).
-
-Intro; Case k; Unfold Zle; Simpl; Auto; Intros; Discriminate.  
-Save.
-
-Theorem sum5 :
-  (a,b,c,d:Z) (`c <> 0`) -> (`0 <> a`) -> (`0 = b`) -> (`0 <> a*c + b*d`).
-
-Intros a b c d H1 H2 H3; Elim H3; Simpl; Rewrite Zplus_sym;
-Simpl; Generalize H1 H2; Case a; Case c; Simpl; Intros; Try Discriminate;
-Assumption.
-Save.
-
-
-Theorem sum_valid : (k1,k2:Z; t:(list t_fusion)) (valid2 (sum k1 k2 t)).
-
-Unfold valid2; Intros k1 k2 t ep e p1 p2; Unfold sum; Simplify; Simpl; Auto;
-Try (Elim (fusion_stable t)); Simpl; Intros; [
-  Apply sum1; Assumption
-| Apply sum2; Try Assumption; Apply sum4; Assumption
-| Rewrite Zplus_sym; Apply sum2; Try Assumption; Apply sum4; Assumption
-| Apply sum3; Try Assumption; Apply sum4; Assumption
-| (Elim_eq_Z k1 ZERO); Simpl; Auto; Elim (fusion_stable t); Simpl; Intros;
-  Unfold Zne; Apply sum5; Assumption].
-Save.
-
-(* \paragraph{[O_EXACT_DIVIDE]}
-   c'est une oper1 valide mais on préfère une substitution a ce point la *)
-
-Definition exact_divide [k:Z; body:term; t: nat; prop:proposition] :=
-   Cases prop of
-      (EqTerm (Tint ZERO) b) =>
-         Case (eq_term (scalar_norm t (Tmult body (Tint k))) b) of
-	   Case (eq_Z k ZERO) of
-	      TrueTerm
-	      (EqTerm (Tint ZERO) body)
-           end
-           TrueTerm
-         end
-   | _ => TrueTerm
-   end.
-
-Theorem exact_divide_valid :
-  (k:Z) (t:term) (n:nat) (valid1 (exact_divide k t n)).
-
-
-Unfold valid1 exact_divide; Intros k1 k2 t ep e p1; Simplify;Simpl; Auto;
-(Elim_eq_term  '(scalar_norm t (Tmult k2 (Tint k1))) 't1); Simpl; Auto;
-(Elim_eq_Z 'k1 'ZERO); Simpl; Auto;  Intros H1 H2; Elim H2; 
-Elim scalar_norm_stable; Simpl; Generalize H1; Case (interp_term e k2);
-Try Trivial; (Case k1; Simpl; [
-  Intros; Absurd `0 = 0`; Assumption
-| Intros p2 p3 H3 H4; Discriminate H4
-| Intros p2 p3 H3 H4; Discriminate H4 ]).
-
-Save.
-
-
-
-(* \paragraph{[O_DIV_APPROX]}
-  La preuve reprend le schéma de la précédente mais on
-  est sur une opération de type valid1 et non sur une opération terminale. *)
-
-Definition divide_and_approx [k1,k2:Z; body:term; t:nat; prop:proposition] :=
-  Cases prop of
-      (LeqTerm (Tint ZERO) b) =>
-         Case (eq_term
-                (scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) b) of
-	   Cases (Zcompare k1 ZERO) of
-	     SUPERIEUR =>
-	       Cases (Zcompare k1 k2) of
-		 SUPERIEUR =>(LeqTerm (Tint ZERO) body)
-	       | _ => prop
-	       end
-	   | _ => prop
-           end
-	   prop
-         end
-   | _ => prop
-   end.
-
-Theorem divide_and_approx_valid : (k1,k2:Z; body:term; t:nat) 
-	(valid1 (divide_and_approx k1 k2 body t)).
-
-Unfold valid1 divide_and_approx; Intros k1 k2 body t ep e p1;Simplify;
-(Elim_eq_term '(scalar_norm_add t (Tplus (Tmult body (Tint k1)) (Tint k2))) 't1); Simplify; Auto;  Intro E; Elim E; Simpl; 
-Elim (scalar_norm_add_stable t e); Simpl; Intro H1; 
-Apply Zmult_le_approx with 3 := H1; Assumption.
-Save.
-
-(* \paragraph{[MERGE_EQ]} *)
-
-Definition merge_eq [t: nat; prop1, prop2: proposition] :=
-  Cases prop1 of
-     (LeqTerm (Tint ZERO) b1) =>
-	Cases prop2 of
-     	  (LeqTerm (Tint ZERO) b2) =>
-             Case (eq_term b1 (scalar_norm t (Tmult b2 (Tint `-1`)))) of
-	        (EqTerm (Tint ZERO) b1)
- 	       	TrueTerm
-	     end
-        | _ => TrueTerm
-	end
-  | _ => TrueTerm
-  end.
-
-Theorem merge_eq_valid : (n:nat) (valid2 (merge_eq n)).
-
-Unfold valid2 merge_eq; Intros n ep e p1 p2; Simplify; Simpl; Auto;
-Elim (scalar_norm_stable n e); Simpl; Intros; Symmetry; 
-Apply OMEGA8 with 2 := H0; [ Assumption | Elim Zopp_one; Trivial ].
-Save.
-
-
-
-(* \paragraph{[O_CONSTANT_NUL]} *)
-
-Definition constant_nul [i:nat; h: hyps] :=
-  Cases (nth_hyps i h) of
-     (NeqTerm (Tint ZERO) (Tint ZERO)) => absurd
-   | _ => h
-  end.
-
-Theorem constant_nul_valid : 
-  (i:nat) (valid_hyps (constant_nul i)).
-
-Unfold valid_hyps constant_nul; Intros; Generalize (nth_valid ep e i lp);
-Simplify; Simpl; Unfold Zne; Intro H1; Absurd `0=0`; Auto.
-Save.
-
-(* \paragraph{[O_STATE]} *)
-
-Definition state [m:Z;s:step; prop1,prop2:proposition] :=
-  Cases prop1 of
-     (EqTerm (Tint ZERO) b1) =>
-	Cases prop2 of
-	   (EqTerm (Tint ZERO) (Tplus b2 (Topp b3))) =>
-	      (EqTerm (Tint ZERO) (rewrite s (Tplus b1 (Tmult (Tplus (Topp b3) b2) (Tint m)))))
-	| _ => TrueTerm
-	end
-  | _ => TrueTerm
-  end.
-
-Theorem state_valid : (m:Z; s:step) (valid2 (state m s)).
-
-Unfold valid2; Intros m s ep e p1 p2; Unfold state; Simplify; Simpl;Auto;
-Elim (rewrite_stable s e); Simpl; Intros H1 H2; Elim H1;
-Rewrite (Zplus_sym `-(interp_term e t5)` `(interp_term e t3)`);
-Elim H2; Simpl; Reflexivity.
-
-Save.
-
-(* \subsubsection{Tactiques générant plusieurs but}
-   \paragraph{[O_SPLIT_INEQ]} 
-   La seule pour le moment (tant que la normalisation n'est pas réfléchie). *)
-
-Definition split_ineq  [i,t: nat; f1,f2:hyps -> lhyps;  l:hyps] :=
-  Cases (nth_hyps i l) of
-    (NeqTerm  (Tint ZERO) b1) =>
-       (app (f1 (cons (LeqTerm (Tint ZERO) (add_norm t (Tplus b1 (Tint `-1`)))) l))
-            (f2 (cons (LeqTerm (Tint ZERO) 
-                               (scalar_norm_add t 
-	                         (Tplus (Tmult b1 (Tint `-1`)) (Tint `-1`))))
-                      l)))
-  | _ => (cons l (nil ?))
-  end.
-
-Theorem split_ineq_valid : 
-  (i,t: nat; f1,f2: hyps -> lhyps) 
-    (valid_list_hyps f1) ->(valid_list_hyps f2) -> 
-      (valid_list_hyps (split_ineq i t f1 f2)).
-
-Unfold valid_list_hyps split_ineq; Intros i t f1 f2 H1 H2 ep e lp H; 
-Generalize (nth_valid ? ? i ? H); 
-Case (nth_hyps i lp); Simpl; Auto; Intros t1 t2; Case t1; Simpl; Auto;
-Intros z; Case z; Simpl; Auto;
-Intro H3; Apply append_valid;Elim (OMEGA19 (interp_term e t2)) ;[
-  Intro H4; Left; Apply H1; Simpl; Elim (add_norm_stable t); Simpl; Auto
-| Intro H4; Right; Apply H2; Simpl; Elim (scalar_norm_add_stable t); 
-  Simpl; Auto
-| Generalize H3; Unfold Zne not; Intros E1 E2; Apply E1; Symmetry; Trivial ].
-Save.
-
-
-(* \subsection{La fonction de rejeu de la trace} *)
-
-Fixpoint execute_omega [t: t_omega] : hyps -> lhyps := 
-  [l : hyps] Cases t of
-   | (O_CONSTANT_NOT_NUL n) => (singleton (constant_not_nul n l))
-   | (O_CONSTANT_NEG n) => (singleton (constant_neg n l))
-   | (O_DIV_APPROX  k1 k2 body t cont n) =>
-       (execute_omega cont 
-	  (apply_oper_1 n (divide_and_approx k1 k2 body t) l))
-   | (O_NOT_EXACT_DIVIDE  k1 k2 body t i) =>
-       (singleton (not_exact_divide k1 k2 body t i l))
-   | (O_EXACT_DIVIDE k body t cont n) =>
-       (execute_omega cont (apply_oper_1 n (exact_divide k body t) l))
-   | (O_SUM k1 i1 k2 i2 t cont) =>
-       (execute_omega cont (apply_oper_2 i1 i2 (sum k1 k2 t) l))
-   | (O_CONTRADICTION t i j) =>
-       (singleton (contradiction t i j l))
-   | (O_MERGE_EQ t i1 i2 cont) =>
-       (execute_omega cont (apply_oper_2 i1 i2 (merge_eq t) l))
-   | (O_SPLIT_INEQ t i cont1 cont2) =>
-       (split_ineq i t (execute_omega cont1) (execute_omega cont2) l)
-   | (O_CONSTANT_NUL i) => (singleton (constant_nul i l))
-   | (O_NEGATE_CONTRADICT i j) =>  (singleton (negate_contradict i j l))
-   | (O_NEGATE_CONTRADICT_INV t i j) => (singleton (negate_contradict_inv t i j l))
-   | (O_STATE m s i1 i2 cont) =>
-       (execute_omega cont (apply_oper_2 i1 i2 (state m s) l))
-  end.
-
-Theorem omega_valid : (t: t_omega) (valid_list_hyps (execute_omega t)).
-
-Induction t; Simpl; [
-  Unfold valid_list_hyps; Simpl; Intros; Left; 
-  Apply (constant_not_nul_valid n ep e lp H)
-| Unfold valid_list_hyps; Simpl; Intros; Left; 
-  Apply (constant_neg_valid n ep e lp H)
-| Unfold valid_list_hyps valid_hyps; Intros k1 k2 body n t' Ht' m ep e lp H; 
-  Apply Ht';
-  Apply (apply_oper_1_valid m (divide_and_approx k1 k2 body n)
-	  (divide_and_approx_valid k1 k2 body n) ep e lp H)
-| Unfold valid_list_hyps; Simpl; Intros; Left; 
-  Apply (not_exact_divide_valid z z0 t0 n n0 ep e lp H)
-| Unfold valid_list_hyps valid_hyps; Intros k body n t' Ht' m ep e lp H; 
-  Apply Ht';
-  Apply (apply_oper_1_valid m (exact_divide k body n)
-	  (exact_divide_valid k body n) ep e lp H)
-| Unfold valid_list_hyps valid_hyps; Intros k1 i1 k2 i2 trace t' Ht' ep e lp H;
-  Apply Ht'; 
-  Apply (apply_oper_2_valid i1 i2 (sum k1 k2 trace) 
-	  (sum_valid k1 k2 trace) ep e lp H)
-| Unfold valid_list_hyps; Simpl; Intros; Left; 
-  Apply (contradiction_valid n n0 n1 ep e lp H)
-| Unfold valid_list_hyps valid_hyps; Intros trace i1 i2 t' Ht' ep e lp H; 
-  Apply Ht';
-  Apply (apply_oper_2_valid i1 i2 (merge_eq trace) 
-          (merge_eq_valid trace) ep e lp H) 
-| Intros t' i k1 H1 k2 H2; Unfold valid_list_hyps; Simpl; Intros ep e lp H;
-  Apply (split_ineq_valid i t' (execute_omega k1) (execute_omega k2) 
-	 H1 H2 ep e lp H)
-| Unfold valid_list_hyps; Simpl; Intros i ep e lp H; Left; 
-  Apply (constant_nul_valid i ep e lp H)
-| Unfold valid_list_hyps; Simpl; Intros i j ep e lp H; Left; 
-  Apply (negate_contradict_valid i j ep e lp H)
-| Unfold valid_list_hyps; Simpl; Intros n i j ep e lp H; Left; 
-  Apply (negate_contradict_inv_valid n i j ep e lp H)
-| Unfold valid_list_hyps valid_hyps; Intros m s i1 i2 t' Ht' ep e lp H; Apply Ht';
-  Apply (apply_oper_2_valid i1 i2 (state m s) (state_valid m s) ep e lp H)
-].
-Save.
-
-
-(* \subsection{Les opérations globales sur le but} 
-   \subsubsection{Normalisation} *)
-
-Definition move_right [s: step; p:proposition] :=
-  Cases p of
-     (EqTerm t1 t2) => (EqTerm (Tint ZERO) (rewrite s (Tplus t1 (Topp t2))))
-   | (LeqTerm t1 t2) => (LeqTerm (Tint ZERO) (rewrite s (Tplus t2 (Topp t1))))
-   | (GeqTerm t1 t2) => (LeqTerm (Tint ZERO) (rewrite s (Tplus t1 (Topp t2))))
-   | (LtTerm t1 t2) =>
-        (LeqTerm (Tint ZERO)
-	         (rewrite s (Tplus (Tplus t2 (Tint `-1`)) (Topp t1))))
-   | (GtTerm t1 t2) => 
-        (LeqTerm (Tint ZERO)
-                 (rewrite s (Tplus (Tplus t1 (Tint `-1`)) (Topp t2))))
-   | (NeqTerm t1 t2) => (NeqTerm (Tint ZERO) (rewrite s (Tplus t1 (Topp t2))))
-   | p => p
-  end.
-
-Theorem Zne_left_2 : (x,y:Z)(Zne x y)->(Zne `0` `x+(-y)`).
-Unfold Zne not; Intros x y H1 H2; Apply H1; Apply (Zsimpl_plus_l `-y`);
-Rewrite Zplus_sym; Elim H2; Rewrite Zplus_inverse_l; Trivial.
-Save.
-
-Theorem move_right_valid : (s: step) (valid1 (move_right s)).
-
-Unfold valid1 move_right; Intros s ep e p; Simplify; Simpl;
-Elim (rewrite_stable s e); Simpl; [
-  Symmetry; Apply Zegal_left; Assumption
-| Intro; Apply Zle_left; Assumption 
-| Intro; Apply Zge_left; Assumption
-| Intro; Apply Zgt_left; Assumption
-| Intro; Apply Zlt_left; Assumption
-| Intro; Apply Zne_left_2; Assumption
-].
-Save.
-
-Definition do_normalize [i:nat; s: step] := (apply_oper_1 i (move_right s)).
-
-Theorem do_normalize_valid : (i:nat; s:step) (valid_hyps (do_normalize i s)).
-
-Intros; Unfold do_normalize; Apply apply_oper_1_valid; Apply move_right_valid.
-Save.
-
-Fixpoint do_normalize_list [l:(list step)] : nat -> hyps -> hyps := 
-  [i:nat; h:hyps] Cases l of
-    (cons s l') => (do_normalize_list l' (S i) (do_normalize i s h))
-  | nil => h
-  end.
-
-Theorem do_normalize_list_valid : 
-  (l:(list step); i:nat) (valid_hyps (do_normalize_list l i)).
-
-Induction l; Simpl; Unfold valid_hyps; [
-  Auto
-| Intros a l' Hl' i ep e lp H; Unfold valid_hyps in Hl'; Apply Hl';
-  Apply (do_normalize_valid i a ep e lp); Assumption ].
-Save.
-
-Theorem normalize_goal :
-  (s: (list step); ep: PropList; env : (list Z); l: hyps)
-    (interp_goal ep env (do_normalize_list s O l)) -> 
-      (interp_goal ep env l).
-
-Intros; Apply valid_goal with 2:=H; Apply do_normalize_list_valid.
-Save.
-
-(* \subsubsection{Exécution de la trace} *)
-
-Theorem execute_goal :
-  (t : t_omega; ep: PropList; env : (list Z); l: hyps)
-    (interp_list_goal ep env (execute_omega t l)) -> (interp_goal ep env l).
-
-Intros; Apply (goal_valid (execute_omega t) (omega_valid t) ep env l H).
-Save.
-
-
-Theorem append_goal :
-  (ep: PropList; e: (list Z)) (l1,l2:lhyps)
-     (interp_list_goal ep e l1) /\ (interp_list_goal ep e l2) ->
-     (interp_list_goal ep e (app l1 l2)).
-
-Intros ep e; Induction l1; [
-  Simpl; Intros l2 (H1, H2); Assumption
-| Simpl; Intros h1 t1 HR l2 ((H1 , H2), H3) ; Split; Auto].
-
-Save.
-
-Require Decidable.
-
-(* A simple decidability checker : if the proposition belongs to the
-   simple grammar describe below then it is decidable. Proof is by 
-   induction and uses well known theorem about arithmetic and propositional
-   calculus *)
-
-Fixpoint decidability [p:proposition] : bool :=
-  Cases p of
-    (EqTerm _ _) => true
-  | (LeqTerm _ _) => true
-  | (GeqTerm _ _) => true
-  | (GtTerm _ _) => true
-  | (LtTerm _ _) => true
-  | (NeqTerm _ _) => true
-  | (FalseTerm) => true
-  | (TrueTerm) => true
-  | (Tnot t) => (decidability t)
-  | (Tand t1 t2) => (andb (decidability t1) (decidability t2))
-  | (Timp t1 t2) => (andb (decidability t1) (decidability t2))
-  | (Tor t1 t2) =>  (andb (decidability t1) (decidability t2))
-  | (Tprop _) => false
-  end
-.
-
-Theorem decidable_correct :
-  (ep: PropList) (e: (list Z)) (p:proposition)
-    (decidability p)=true -> (decidable (interp_proposition ep e p)).
-
-Induction p; Simpl; Intros; [
-  Apply dec_eq
-| Apply dec_Zle
-| Left;Auto
-| Right; Unfold not; Auto
-| Apply dec_not; Auto
-| Apply dec_Zge
-| Apply dec_Zgt
-| Apply dec_Zlt
-| Apply dec_Zne
-| Apply dec_or; Elim andb_prop with 1 := H1; Auto
-| Apply dec_and; Elim andb_prop with 1 := H1; Auto
-| Apply dec_imp; Elim andb_prop with 1 := H1; Auto
-| Discriminate H].
-
-Save.
-
-(* An interpretation function for a complete goal with an explicit
-   conclusion. We use an intermediate fixpoint. *)
-
-Fixpoint interp_full_goal 
-    [envp: PropList;env : (list Z); c : proposition; l: hyps] : Prop :=
-  Cases l of 
-     nil => (interp_proposition envp env c)
-   | (cons p' l') => 
-	(interp_proposition envp env p') -> (interp_full_goal envp env c l')
-  end.
-
-Definition interp_full 
-    [ep: PropList;e : (list Z); lc : (hyps * proposition)] : Prop :=
-      Cases lc of (l,c) => (interp_full_goal ep e c l) end.
-
-(* Relates the interpretation of a complete goal with the interpretation
-   of its hypothesis and conclusion *)
-
-Theorem interp_full_false :
-  (ep: PropList; e : (list Z); l: hyps; c : proposition) 
-    ((interp_hyps ep e l) -> (interp_proposition ep e c)) -> 
-	(interp_full ep e (l,c)).
-
-Induction l; Unfold interp_full; Simpl; [
-  Auto
-| Intros a l1 H1 c H2 H3; Apply H1; Auto].
-
-Save.
-
-(* Push the conclusion in the list of hypothesis using a double negation
-   If the decidability cannot be "proven", then just forget about the 
-   conclusion (equivalent of replacing it with false) *)
-
-Definition to_contradict [lc : hyps * proposition] :=
-   Cases lc of
-      (l,c) => (if (decidability c) then (cons (Tnot c) l) else l)
-   end.
-
-(* The previous operation is valid in the sense that the new list of
-   hypothesis implies the original goal *)
-
-Theorem to_contradict_valid :
-  (ep: PropList; e : (list Z); lc: hyps * proposition)
-	(interp_goal ep e (to_contradict lc)) -> (interp_full ep e lc).
-
-Intros ep e lc; Case lc; Intros l c; Simpl; (Pattern (decidability c));
-Apply bool_ind2; [
-   Simpl; Intros H H1; Apply interp_full_false; Intros H2; Apply not_not; [
-     Apply decidable_correct; Assumption
-   | Unfold 1 not; Intro H3; Apply hyps_to_goal with 2:=H2; Auto]
-| Intros H1 H2; Apply interp_full_false; Intro H3; Elim hyps_to_goal with 1:= H2; Assumption ].
-Save.
-
-(* [map_cons x l] adds [x] at the head of each list in [l] (which is a list
-   of lists *)
-
-Fixpoint map_cons [A:Set; x:A; l:(list (list A))] : (list (list A)) :=
-  Cases l of
-    nil => (nil ?)
-  | (cons l ll) => (cons (cons x l) (map_cons A x ll))
-  end.
-
-(* This function breaks up a list of hypothesis in a list of simpler 
-   list of hypothesis that together implie the original one. The goal
-   of all this is to transform the goal in a list of solvable problems. 
-   Note that :
-	- we need a way to drive the analysis as some hypotheis may not
-          require a split. 
-        - this procedure must be perfectly mimicked by the ML part otherwise
-          hypothesis will get desynchronised and this will be a mess.
- *)
- 
-Fixpoint destructure_hyps [nn: nat] : hyps -> lhyps :=
-  [ll:hyps]Cases nn of
-    O => (cons ll (nil ?))
-  | (S n) =>
-       Cases ll of 
-	  nil => (cons (nil ?) (nil ?))
-       | (cons (Tor p1 p2) l) => 
-	    (app (destructure_hyps n (cons p1 l))
-	         (destructure_hyps n (cons p2 l)))
-       | (cons (Tand p1 p2) l) => 
-	    (destructure_hyps n (cons p1 (cons p2 l)))
-       | (cons (Timp p1 p2) l) =>
-	    (if (decidability p1) then 
-	      (app (destructure_hyps n (cons (Tnot p1) l))
-		   (destructure_hyps n (cons p2 l)))
-	     else (map_cons ? (Timp p1 p2) (destructure_hyps n l)))
-       | (cons (Tnot p) l) =>
-	    Cases p of 
-	       (Tnot p1) =>
-		    (if (decidability p1) then (destructure_hyps n (cons p1 l))
-		     else (map_cons ? (Tnot (Tnot p1)) (destructure_hyps n l)))
- 	    | (Tor p1 p2) =>
-		  (destructure_hyps n (cons (Tnot p1) (cons (Tnot p2) l)))
- 	    | (Tand p1 p2) =>
-   	         (if (decidability p1) then 
- 		    (app (destructure_hyps n (cons (Tnot p1) l))
-			 (destructure_hyps n (cons (Tnot p2) l)))
-		 else (map_cons ? (Tnot p) (destructure_hyps n l)))
-	    | _ =>  (map_cons ? (Tnot p) (destructure_hyps n l))
-	    end
-       | (cons x l) => (map_cons ? x (destructure_hyps n l))
-       end
-  end.
-
-Theorem map_cons_val : 
-  (ep: PropList; e : (list Z))
-  (p:proposition;l:lhyps) 
-	(interp_proposition ep e p) ->
-	(interp_list_hyps ep e l) ->
-	(interp_list_hyps ep e (map_cons ? p l) ).
-
-Induction l; Simpl; [ Auto | Intros; Elim H1;  Intro H2; Auto ].
-Save.
-
-Hints Resolve map_cons_val append_valid decidable_correct.
-
-Theorem destructure_hyps_valid : 
-  (n:nat) (valid_list_hyps (destructure_hyps n)).
-
-Induction n; [
-  Unfold valid_list_hyps; Simpl; Auto
-| Unfold 2 valid_list_hyps; Intros n1 H  ep e lp; Case lp; [
-    Simpl; Auto
-  | Intros p l; Case p; 
-    Try (Simpl; Intros; Apply map_cons_val; Simpl; Elim H0; Auto); [
-      Intro p'; Case p';
-      Try (Simpl; Intros; Apply map_cons_val; Simpl; Elim H0; Auto); [
-	Simpl; Intros p1 (H1,H2);  Pattern (decidability p1); Apply bool_ind2;
-	Intro H3; [
-	  Apply H; Simpl; Split; [ Apply not_not; Auto | Assumption ]
-        | Auto]
-      | Simpl; Intros p1 p2 (H1,H2); Apply H; Simpl; 
-	Elim not_or with 1 := H1; Auto
-      | Simpl; Intros p1 p2 (H1,H2);Pattern (decidability p1); Apply bool_ind2;
-        Intro H3; [
-	  Apply append_valid; Elim not_and with 2 := H1; [
-	    Intro; Left; Apply H; Simpl; Auto
-	  | Intro; Right; Apply H; Simpl; Auto
-          | Auto ]
-        | Auto ]]
-    | Simpl; Intros p1 p2 (H1, H2); Apply append_valid; 
-      (Elim H1; Intro H3; Simpl; [ Left | Right ]); Apply H; Simpl; Auto 
-    | Simpl; Intros; Apply H; Simpl; Tauto
-    | Simpl; Intros p1 p2 (H1, H2); Pattern (decidability p1); Apply bool_ind2;
-      Intro H3; [ 
-	Apply append_valid; Elim imp_simp with 2:=H1; [
-	  Intro H4; Left; Simpl; Apply H; Simpl; Auto
-	| Intro H4; Right; Simpl; Apply H; Simpl; Auto
-	| Auto ]
-      | Auto ]]]].
-
-Save.
-
-Definition prop_stable [f: proposition -> proposition] :=
-  (ep: PropList; e: (list Z); p:proposition) 
-     (interp_proposition ep e p) <-> (interp_proposition ep e (f p)).
-
-Definition p_apply_left [f: proposition -> proposition; p : proposition]:= 
-  Cases p of
-    (Timp x y) => (Timp (f x) y)
-  | (Tor x y) => (Tor (f x) y)
-  | (Tand x y) => (Tand (f x) y)
-  | (Tnot x) => (Tnot (f x))
-  | x => x
-  end.
-
-Theorem p_apply_left_stable :
-  (f : proposition -> proposition) 
-    (prop_stable f) -> (prop_stable (p_apply_left f)).
-
-Unfold prop_stable; Intros f H ep e p; Split; 
-(Case p; Simpl; Auto; Intros p1; Elim (H ep e p1); Tauto).
-Save.
-
-Definition p_apply_right [f: proposition -> proposition; p : proposition]:= 
-  Cases p of
-    (Timp x y) => (Timp x (f y))
-  | (Tor x y) => (Tor x (f y))
-  | (Tand x y) => (Tand x (f y))
-  | (Tnot x) => (Tnot (f x))
-  | x => x
-  end.
-
-Theorem p_apply_right_stable :
-  (f : proposition -> proposition) 
-    (prop_stable f) -> (prop_stable (p_apply_right f)).
-
-Unfold prop_stable; Intros f H ep e p; Split; 
-(Case p; Simpl; Auto; [
-   Intros p1; Elim (H ep e p1); Tauto
- | Intros p1 p2; Elim (H ep e p2); Tauto
- | Intros p1 p2; Elim (H ep e p2); Tauto
- | Intros p1 p2; Elim (H ep e p2); Tauto
- ]).
-Save.
-
-Definition p_invert [f : proposition -> proposition; p : proposition] := 
-Cases p of
-  (EqTerm x y) => (Tnot (f (NeqTerm x y)))
-| (LeqTerm x y) => (Tnot (f (GtTerm x y)))
-| (GeqTerm x y) => (Tnot (f (LtTerm x y)))
-| (GtTerm x y) => (Tnot (f (LeqTerm x y)))
-| (LtTerm x y) => (Tnot (f (GeqTerm x y)))
-| (NeqTerm x y) => (Tnot (f (EqTerm x y)))
-| x => x
-end.
-
-Theorem p_invert_stable :
-  (f : proposition -> proposition) 
-    (prop_stable f) -> (prop_stable (p_invert f)).
-
-Unfold prop_stable; Intros f H ep e p; Split;(Case p; Simpl; Auto; [
-  Intros t1 t2; Elim (H ep e (NeqTerm t1 t2)); Simpl; Unfold Zne; 
-  Generalize (dec_eq (interp_term e t1) (interp_term e t2)); 
-  Unfold decidable; Tauto
-| Intros t1 t2; Elim (H ep e (GtTerm t1 t2)); Simpl; Unfold Zgt; 
-  Generalize (dec_Zgt (interp_term e t1) (interp_term e t2)); 
-  Unfold decidable Zgt Zle; Tauto
-| Intros t1 t2; Elim (H ep e (LtTerm t1 t2)); Simpl; Unfold Zlt; 
-  Generalize (dec_Zlt (interp_term e t1) (interp_term e t2)); 
-  Unfold decidable Zge; Tauto
-| Intros t1 t2; Elim (H ep e (LeqTerm t1 t2)); Simpl; 
-  Generalize (dec_Zgt (interp_term e t1) (interp_term e t2)); Unfold Zle Zgt;
-  Unfold decidable; Tauto
-| Intros t1 t2; Elim (H ep e (GeqTerm t1 t2)); Simpl;
-  Generalize (dec_Zlt (interp_term e t1) (interp_term e t2));  Unfold Zge Zlt; 
-  Unfold decidable; Tauto
-| Intros t1 t2; Elim (H ep e (EqTerm t1 t2)); Simpl;
-  Generalize (dec_eq (interp_term e t1) (interp_term e t2)); 
-  Unfold decidable Zne; Tauto ]).
-Save.
-
-Theorem Zlt_left_inv : (x,y:Z) `0 <= ((y + (-1)) + (-x))` ->  `x<y`.
-
-Intros; Apply Zlt_S_n; Apply Zle_lt_n_Sm; 
-Apply (Zsimpl_le_plus_r (Zplus `-1` (Zopp x))); Rewrite Zplus_assoc_l; 
-Unfold Zs; Rewrite (Zplus_assoc_r x); Rewrite (Zplus_assoc_l y); Simpl;
-Rewrite Zero_right; Rewrite Zplus_inverse_r; Assumption.
-Save.
-
-Theorem move_right_stable : (s: step) (prop_stable (move_right s)).
-
-Unfold move_right prop_stable; Intros s ep e p; Split; [
-    Simplify; Simpl; Elim (rewrite_stable s e); Simpl; [
-    Symmetry; Apply Zegal_left; Assumption
-  | Intro; Apply Zle_left; Assumption
-  | Intro; Apply Zge_left; Assumption
-  | Intro; Apply Zgt_left; Assumption
-  | Intro; Apply Zlt_left; Assumption
-  | Intro; Apply Zne_left_2; Assumption ]
-| Case p; Simpl; Intros; Auto; Generalize H; Elim (rewrite_stable s); Simpl; 
-  Intro H1; [
-    Rewrite (Zplus_n_O (interp_term e t0)); Rewrite H1; Rewrite Zplus_permute;
-    Rewrite Zplus_inverse_r; Rewrite Zero_right; Trivial
-  | Apply (Zsimpl_le_plus_r (Zopp (interp_term e t))); Rewrite Zplus_inverse_r;
-    Assumption
-  | Apply Zle_ge; Apply (Zsimpl_le_plus_r (Zopp (interp_term e t0))); 
-    Rewrite Zplus_inverse_r; Assumption
-  | Apply Zlt_gt; Apply Zlt_left_inv; Assumption
-  | Apply Zlt_left_inv; Assumption
-  | Unfold Zne not; Unfold Zne in H1; Intro H2; Apply H1; Rewrite H2;
-    Rewrite Zplus_inverse_r; Trivial ]].
-Save.
-
-
-Fixpoint p_rewrite [s: p_step] : proposition -> proposition :=
-  Cases s of 
-   | (P_LEFT s) => (p_apply_left (p_rewrite s))
-   | (P_RIGHT s) => (p_apply_right (p_rewrite s))
-   | (P_STEP s) => (move_right s)
-   | (P_INVERT s) => (p_invert (move_right s))
-   | P_NOP => [p:proposition]p
-  end.
-
-Theorem p_rewrite_stable : (s : p_step) (prop_stable (p_rewrite s)).
-
-
-Induction s; Simpl; [
-  Intros; Apply p_apply_left_stable; Trivial
-| Intros; Apply p_apply_right_stable; Trivial
-| Intros; Apply p_invert_stable; Apply move_right_stable
-| Apply move_right_stable
-| Unfold prop_stable; Simpl; Intros; Split; Auto ].
-Save.
-
-Fixpoint normalize_hyps [l: (list h_step)] : hyps -> hyps :=
-  [lh:hyps] Cases l of
-    nil => lh
-  | (cons (pair_step i s) r) =>
-	 (normalize_hyps r (apply_oper_1 i (p_rewrite s) lh))
-  end.
-
-Theorem normalize_hyps_valid : 
-  (l: (list h_step)) (valid_hyps (normalize_hyps l)).
-
-Induction l; Unfold valid_hyps; Simpl; [
-  Auto
-| Intros n_s r; Case n_s; Intros n s H ep e lp H1; Apply H; 
-  Apply apply_oper_1_valid; [
-    Unfold valid1; Intros ep1 e1 p1 H2; Elim (p_rewrite_stable s ep1 e1 p1);
-    Auto
-  | Assumption ]].
-Save.
-
-Theorem normalize_hyps_goal :
-  (s: (list h_step); ep: PropList; env : (list Z); l: hyps)
-    (interp_goal ep env (normalize_hyps s l)) -> 
-      (interp_goal ep env l).
-
-Intros; Apply valid_goal with 2:=H; Apply normalize_hyps_valid.
-Save.
-
-Fixpoint extract_hyp_pos [s: (list direction)] : proposition -> proposition :=
-  [p: proposition]
-  Cases s of 
-   | (cons D_left l) =>
-	Cases p of
-          (Tand x y) => (extract_hyp_pos l x)
-        | _ => p
-        end
-   | (cons D_right l) =>
-	Cases p of
-          (Tand x y) => (extract_hyp_pos l y)
-        | _ => p
-        end
-   | (cons D_mono l) =>
-	Cases p of
-          (Tnot x ) => (extract_hyp_neg l x)
-        | _ => p
-        end
-   | _ => p
-  end
-with extract_hyp_neg [s: (list direction)] : proposition -> proposition :=
-  [p: proposition]
-  Cases s of 
-   | (cons D_left l) =>
-	Cases p of
-          (Tor x y) => (extract_hyp_neg l x)
-	| (Timp x y) =>
-	    (if (decidability x) then (extract_hyp_pos l x) else (Tnot p))
-        | _ => (Tnot p)
-        end
-   | (cons D_right l) =>
-	Cases p of
-          (Tor x y) => (extract_hyp_neg l y)
-	| (Timp x y) => (extract_hyp_neg l y)
-        | _ => (Tnot p)
-        end
-   | (cons D_mono l) =>
-	Cases p of
-          (Tnot x) => 
-	     (if (decidability x) then (extract_hyp_pos l x) else (Tnot p))
-        | _ => (Tnot p)
-        end
-   | _ => 
-	Cases p of
-	  (Tnot x) => (if (decidability x) then x else (Tnot p))
-        | _ => (Tnot p) 
-	end
-  end.
-
-Definition co_valid1 [f: proposition -> proposition] :=
-  (ep : PropList; e: (list Z)) (p1: proposition) 
-     (interp_proposition ep e (Tnot p1)) -> (interp_proposition ep e (f p1)).
-
-Theorem extract_valid : 
-  (s: (list direction))
-    ((valid1 (extract_hyp_pos s)) /\ (co_valid1 (extract_hyp_neg s))).
-
-Unfold valid1 co_valid1; Induction s; [
-  Split; [
-    Simpl; Auto
-  | Intros ep e p1; Case p1; Simpl; Auto; Intro p; Pattern (decidability p);
-    Apply bool_ind2; [
-      Intro H; Generalize (decidable_correct ep e p H); Unfold decidable; Tauto
-    | Simpl; Auto]]
-| Intros a s' (H1,H2);  Simpl in H2; Split; Intros ep e p; Case a; Auto; 
-  Case p; Auto; Simpl; Intros; 
-  (Apply H1; Tauto) Orelse (Apply H2; Tauto) Orelse
-  (Pattern (decidability p0); Apply bool_ind2; [
-     Intro H3; Generalize (decidable_correct ep e p0 H3);Unfold decidable;
-     Intro H4; Apply H1; Tauto
-   | Intro; Tauto ])].
-
-Save.
-
-Fixpoint decompose_solve [s: e_step] : hyps -> lhyps := 
- [h:hyps]
- Cases s of 
-   (E_SPLIT i dl s1 s2) => 
-	(Cases (extract_hyp_pos dl (nth_hyps i h)) of
-	   (Tor x y) => 
-	      (app (decompose_solve s1 (cons x h)) 
-	           (decompose_solve s2 (cons y h)))
-	|  (Tnot (Tand x y)) => 
-	      (if (decidability x) then
-		      (app (decompose_solve s1 (cons (Tnot x) h)) 
-		           (decompose_solve s2 (cons (Tnot y) h)))
-		else (cons h (nil hyps)))
-	| _ => (cons h (nil hyps))
-	end)
- | (E_EXTRACT i dl s1) =>
-     (decompose_solve s1 (cons (extract_hyp_pos dl (nth_hyps i h)) h))
- | (E_SOLVE t) => (execute_omega t h)
- end.
-
-Theorem decompose_solve_valid : 
-   (s:e_step)(valid_list_goal (decompose_solve s)).
-
-Intro s; Apply goal_valid; Unfold valid_list_hyps; Elim s; Simpl; Intros; [
-  Cut (interp_proposition ep e1 (extract_hyp_pos l (nth_hyps n lp))); [
-    Case (extract_hyp_pos l (nth_hyps n lp)); Simpl; Auto; [
-      Intro p; Case p; Simpl;Auto; Intros p1 p2 H2;
-      Pattern (decidability p1); Apply bool_ind2; [
-        Intro H3; Generalize (decidable_correct ep e1 p1 H3); 
-        Intro H4; Apply append_valid; Elim H4; Intro H5; [
-          Right; Apply H0; Simpl; Tauto
-        | Left; Apply H; Simpl; Tauto ]
-      | Simpl; Auto]
-    | Intros p1 p2 H2; Apply append_valid; Simpl; Elim H2; [
-        Intros H3; Left; Apply H; Simpl; Auto
-      | Intros H3; Right; Apply H0; Simpl; Auto ]]
-  | Elim (extract_valid l); Intros H2 H3; Apply H2; Apply nth_valid; Auto]
-| Intros; Apply H; Simpl; Split; [
-    Elim (extract_valid l); Intros H2 H3; Apply H2; Apply nth_valid; Auto
-  | Auto ]
-| Apply omega_valid with 1:= H].
-
-Save.
-
-(* \subsection{La dernière étape qui élimine tous les séquents inutiles} *)
-
-Definition valid_lhyps [f: lhyps -> lhyps] :=
-  (ep : PropList; e : (list Z)) (lp: lhyps)
-    (interp_list_hyps ep e lp) -> (interp_list_hyps ep e (f lp)).
-
-Fixpoint reduce_lhyps [lp:lhyps] : lhyps :=
-   Cases lp of
-     (cons (cons FalseTerm nil) lp') => (reduce_lhyps lp')
-   | (cons x lp') => (cons x (reduce_lhyps lp'))
-   | nil => (nil hyps)
-   end.
-
-Theorem reduce_lhyps_valid : (valid_lhyps reduce_lhyps).
-
-Unfold valid_lhyps; Intros ep e lp; Elim lp; [
-  Simpl; Auto
-| Intros a l HR; Elim a; [
-    Simpl; Tauto
-  | Intros a1 l1; Case l1; Case a1; Simpl; Try Tauto]].
-Save.
-
-Theorem do_reduce_lhyps : 
-  (envp: PropList; env: (list Z); l: lhyps)
-    (interp_list_goal envp env (reduce_lhyps l)) ->
-	 (interp_list_goal envp env l).
-
-Intros envp env l H; Apply list_goal_to_hyps; Intro H1; 
-Apply list_hyps_to_goal with 1 := H; Apply reduce_lhyps_valid; Assumption.
-Save.
-
-Definition concl_to_hyp := [p:proposition]
-  (if (decidability p) then (Tnot p) else TrueTerm).
-
-Definition do_concl_to_hyp :
-  (envp: PropList; env: (list Z); c : proposition; l:hyps)
-    (interp_goal envp env (cons (concl_to_hyp c) l)) ->
-       (interp_goal_concl envp env c l).
-
-Simpl; Intros envp env c l; Induction l; [
-  Simpl; Unfold concl_to_hyp; Pattern (decidability c); Apply bool_ind2; [
-    Intro H; Generalize (decidable_correct envp env c H); Unfold decidable;
-    Simpl; Tauto
-  | Simpl; Intros H1 H2; Elim H2; Trivial]
-| Simpl; Tauto ].
-Save.
-
-Definition omega_tactic := 
-  [t1:e_step ; t2:(list h_step) ; c:proposition; l:hyps] 
-    (reduce_lhyps 
-      (decompose_solve t1 (normalize_hyps t2 (cons (concl_to_hyp c) l)))).
-
-Theorem do_omega:
-  (t1: e_step ; t2: (list h_step);
-   envp: PropList; env: (list Z); c: proposition; l:hyps)
-    (interp_list_goal envp env (omega_tactic t1 t2 c l)) ->
-       (interp_goal_concl envp env c l).
-
-Unfold omega_tactic; Intros; Apply do_concl_to_hyp; 
-Apply (normalize_hyps_goal t2); Apply (decompose_solve_valid t1); 
-Apply do_reduce_lhyps; Assumption.
-Save.
diff --git a/dev/base_include b/dev/base_include
index 17293776..30a6ed96 100644
--- a/dev/base_include
+++ b/dev/base_include
@@ -13,45 +13,51 @@
 #directory "proofs";;
 #directory "tactics";;
 #directory "translate";;
-#use "top_printers.ml";;
-
-#install_printer  (* identifier *) prid;;
-#install_printer  (* label *) prlab;;
-#install_printer prmsid;;
-#install_printer prmbid;;
-#install_printer prdir;;
-#install_printer prmp;;
-#install_printer  (* section_path *)  prsp;;
-#install_printer  (* qualid *)  prqualid;;
-#install_printer  (* kernel_name *) prkn;;
-#install_printer  (* constr *)  print_pure_constr;;
 
-(* parsing of names *)
+#use "top_printers.ml";;
+#use "vm_printers.ml";;
+
+#install_printer  (* identifier *) ppid;;
+#install_printer  (* identifier *) ppidset;;
+#install_printer  (* label *) pplab;;
+#install_printer  (* mod_self_id *) ppmsid;;
+#install_printer  (* mod_bound_id *) ppmbid;;
+#install_printer  (* dir_path *) ppdir;;
+#install_printer  (* module_path *) ppmp;;
+#install_printer  (* section_path *)  ppsp;;
+#install_printer  (* qualid *)  ppqualid;;
+#install_printer  (* kernel_name *) ppkn;;
+#install_printer  (* constant *) ppcon;;
+#install_printer  (* constr *)  print_pure_constr;; 
+#install_printer  (* patch *) ppripos;;
+#install_printer  (* values *) ppvalues;;
+#install_printer ppzipper;;
+#install_printer ppstack;;
+#install_printer ppatom;;
+#install_printer ppwhd;;
+#install_printer ppvblock;;
+#install_printer  (* bigint *) ppbigint;;
+#install_printer  (* loc *) pploc;;
 
 let qid = Libnames.qualid_of_string;;
 
 (* parsing of terms *)
 
-let parse_com   = Pcoq.parse_string Pcoq.Constr.constr;;
-let parse_tac = Pcoq.parse_string Pcoq.Tactic.tactic;;
+let parse_constr = Pcoq.parse_string Pcoq.Constr.constr;;
+let parse_tac    = Pcoq.parse_string Pcoq.Tactic.tactic;;
 let parse_vernac = Pcoq.parse_string Pcoq.Vernac_.vernac;;
 
-(* For compatibility reasons *)
-let parse_ast = parse_com;;
-
 (* build a term of type rawconstr without type-checking or resolution of 
    implicit syntax *)
 
-let e s = Constrintern.interp_rawconstr Evd.empty (Global.env()) (parse_ast s);;
-
-(* For compatibility *)
-let raw_constr_of_string = e;;
+let e s =
+  Constrintern.intern_constr Evd.empty (Global.env()) (parse_constr s);;
 
 (* build a term of type constr with type-checking and resolution of 
    implicit syntax *)
 
 let constr_of_string s = 
-  Constrintern.interp_constr Evd.empty (Global.env()) (parse_ast s);;
+  Constrintern.interp_constr Evd.empty (Global.env()) (parse_constr s);;
 
 (* get the body of a constant *)
 
@@ -69,7 +75,7 @@ let get_nth_goal n = nth_goal_of_pftreestate n (Pfedit.get_pftreestate ());;
 let current_goal () = get_nth_goal 1;;
 
 let pf_e gl s = 
-    Constrintern.interp_constr (project gl) (pf_env gl) (parse_ast s);;
+  Constrintern.interp_constr (project gl) (pf_env gl) (parse_constr s);;
 
 open Toplevel
 let go = loop
diff --git a/dev/db b/dev/db
index 44effd77..6c657d4e 100644
--- a/dev/db
+++ b/dev/db
@@ -1,35 +1,37 @@
 load_printer "gramlib.cma"
-load_printer "top_printers.cmo"
-install_printer Top_printers.prid
-install_printer Top_printers.prlab
-install_printer Top_printers.prmsid
-install_printer Top_printers.prmbid
-install_printer Top_printers.prdir
-install_printer Top_printers.prmp
-install_printer Top_printers.prkn
-install_printer Top_printers.prsp
-install_printer Top_printers.prqualid
-install_printer Top_printers.prast
-install_printer Top_printers.prastpat
-install_printer Top_printers.prastpatl
+load_printer "printers.cma"
+
+install_printer Top_printers.ppid
+install_printer Top_printers.ppidset
+install_printer Top_printers.pplab
+install_printer Top_printers.ppmsid
+install_printer Top_printers.ppmbid
+install_printer Top_printers.ppdir
+install_printer Top_printers.ppmp
+install_printer Top_printers.ppkn
+install_printer Top_printers.ppcon
+install_printer Top_printers.ppsp
+install_printer Top_printers.ppqualid
+install_printer Top_printers.ppbigint
 
 install_printer Top_printers.pppattern
-install_printer Top_printers.pprawterm
+install_printer Top_printers.pprawconstr
 
-install_printer Top_printers.ppterm
-install_printer Top_printers.print_uni
-install_printer Top_printers.pp_universes
+install_printer Top_printers.ppconstr
+install_printer Top_printers.ppuni
+install_printer Top_printers.ppuniverses
 install_printer Top_printers.pptype
-install_printer Top_printers.prj
+install_printer Top_printers.ppj
+install_printer Top_printers.ppenv
 
-install_printer Top_printers.prgoal
-install_printer Top_printers.prsigmagoal
+install_printer Top_printers.ppgoal
+install_printer Top_printers.ppsigmagoal
 install_printer Top_printers.pproof
-install_printer Top_printers.prevd
-install_printer Top_printers.prevc
-install_printer Top_printers.prwc
-install_printer Top_printers.prclenv
+install_printer Top_printers.ppevd
+install_printer Top_printers.ppclenv
 
 install_printer Top_printers.pptac
-install_printer Top_printers.pr_obj                                                     
+install_printer Top_printers.ppobj
+install_printer Top_printers.pploc
+                                                  
 
diff --git a/dev/deboguage.txt b/dev/deboguage.txt
deleted file mode 100644
index eea7a0bc..00000000
--- a/dev/deboguage.txt
+++ /dev/null
@@ -1,30 +0,0 @@
-
-Debuggage
-=========
-
-   dans Emacs. nécessite le mode tuareg.
-   Coq doit être configuré avec -debug et -local (./configure -debug -local)
-
-   1. M-x camldebug
-   2. spécifier le binaire coqtop.byte
-   3. spécifier dev/ocamldebug-v7
-   4. source db  (pour avoir les pretty-printers)
-   5. poser ses points d'arrêts avec C-x C-a C-b (penser "add breakpoint")
-      directement dans le source ocaml
-   6. ensuite voir le man d'ocamldebug
-         run
-	 step
-	 next
-	 last
-	 print x
-	 ...
-
-
-Profiling
-=========
-
-   Coq doit être configuré avec -profile
-
-   1. Lancer Coq en natif, qui doit terminer normalement (utiliser Quit
-      ou l'option -batch)
-   2. gprof ./coqtop gmon.out
diff --git a/dev/debugging.txt b/dev/debugging.txt
index d3fbf48a..4c04c42f 100644
--- a/dev/debugging.txt
+++ b/dev/debugging.txt
@@ -12,15 +12,20 @@ Debugging from Coq toplevel using Caml trace mechanism
   6. Test your Coq command and observe the result of tracing your functions
   7. Freely switch from Coq to Ocaml toplevels with 'Drop.' and 'go();;'
 
+  Hints: To remove high-level pretty-printing features (coercions,
+  notations, ...), use "Set Printing All". It will affect the #trace
+  printers too.
+
 Debugging from Caml debugger
 ============================
 
+   Preferably use ocaml 3.06 (pretty-printing is broken with ocaml 3.07/3.08)
    Needs tuareg mode in Emacs
    Coq must be configured with -debug and -local (./configure -debug -local)
 
    1. M-x camldebug
-   2. give the binary name coqtop.byte
-   3. give dev/ocamldebug-v7
+   2. give the binary name bin/coqtop.byte
+   3. give ../dev/ocamldebug-coq
    4. source db  (to get pretty-printers)
    5. add breakpoints with C-x C-a C-b from the buffer displaying the ocaml
       source
@@ -36,8 +41,9 @@ Debugging from Caml debugger
    7. some hints: 
 
    - To debug a failure/error/anomaly, add a breakpoint in
-     Vernacinterp.call just before "if !Options.debug" then go "back" to
-     find where the failure/error/anomaly has been raised
+     Vernac.vernac_com at the with clause of the "try ... interp com
+     with ..." block, then go "back" a few steps to find where the
+     failure/error/anomaly has been raised
    - If "source db" fails, first recompile top_printers.ml with
      "make dev/top_printers.cmo"
 
diff --git a/dev/doc/Makefile b/dev/doc/Makefile
new file mode 100644
index 00000000..a0bef897
--- /dev/null
+++ b/dev/doc/Makefile
@@ -0,0 +1,67 @@
+
+# Makefile for doc/
+
+all:: newparse 
+#newsyntax.dvi minicoq.dvi
+
+
+OBJS=lex.cmo ast.cmo parse.cmo syntax.cmo
+
+newparse: $(OBJS) syntax.mli lex.ml syntax.ml
+	ocamlc -o newparse $(OBJS)
+
+.ml.cmo:
+	ocamlc -c $<
+
+.mli.cmi:
+	ocamlc -c $<
+
+.mll.ml:
+	ocamllex $<
+
+.mly.ml:
+	ocamlyacc -v $<
+
+.mly.mli:
+	ocamlyacc -v $<
+
+clean::
+	rm -f *.cm* *.output syntax.ml syntax.mli lex.ml newparse
+
+parse.cmo: ast.cmo
+syntax.cmi: parse.cmo
+syntax.cmo: lex.cmo parse.cmo syntax.cmi
+lex.cmo: syntax.cmi
+ast.cmo: ast.ml
+
+newsyntax.dvi: newsyntax.tex
+	latex $<
+	latex $<
+
+coq.dvi: coq.tex
+	latex coq
+	latex coq
+
+coq.tex::
+	make -C .. doc/coq.tex
+
+depend:: kernel.dep.ps library.dep.ps pretyping.dep.ps parsing.dep.ps \
+         proofs.dep.ps tactics.dep.ps toplevel.dep.ps interp.dep.ps
+
+%.dot: ../%
+	(cd ../$*; ocamldep *.ml *.mli) | ocamldot -lr > $@
+
+%.dep.ps: %.dot
+	dot -Tps $< -o $@
+
+clean::
+	rm -f *~ *.log *.aux
+
+.SUFFIXES: .tex .dvi .ps .cmo .cmi .mli .ml .mll .mly
+
+.tex.dvi:
+	latex $< && latex $<
+
+.dvi.ps:
+	dvips $< -o $@
+
diff --git a/dev/doc/ast.ml b/dev/doc/ast.ml
new file mode 100644
index 00000000..2153ef47
--- /dev/null
+++ b/dev/doc/ast.ml
@@ -0,0 +1,47 @@
+
+type constr_ast =
+  Pair of constr_ast * constr_ast
+| Prod of binder list * constr_ast
+| Lambda of binder list * constr_ast
+| Let of string * constr_ast * constr_ast
+| LetCase of binder list * constr_ast * constr_ast
+| IfCase of constr_ast * constr_ast * constr_ast
+| Eval of red_fun * constr_ast
+| Infix of string * constr_ast * constr_ast
+| Prefix of string * constr_ast
+| Postfix of string * constr_ast
+| Appl of constr_ast * constr_arg list
+| ApplExpl of string list * constr_ast list
+| Scope of string * constr_ast
+| Qualid of string list
+| Prop | Set | Type
+| Int of string
+| Hole
+| Meta of string
+| Fixp of fix_kind *
+      (string * binder list * constr_ast * string option * constr_ast) list *
+      string
+| Match of case_item list * constr_ast option *
+           (pattern list * constr_ast) list 
+
+and red_fun = Simpl
+
+and binder = string * constr_ast
+
+and constr_arg = string option * constr_ast
+
+and fix_kind = Fix | CoFix
+
+and case_item = constr_ast * (string option * constr_ast option)
+
+and pattern = 
+  PatAs of pattern * string
+| PatType of pattern * constr_ast
+| PatConstr of string * pattern list
+| PatVar of string
+
+let mk_cast c t =
+  if t=Hole then c else Infix(":",c,t)
+
+let mk_lambda bl t =
+  if bl=[] then t else Lambda(bl,t)
diff --git a/dev/doc/check-grammar b/dev/doc/check-grammar
new file mode 100755
index 00000000..67da1bc5
--- /dev/null
+++ b/dev/doc/check-grammar
@@ -0,0 +1,50 @@
+#!/bin/bash
+# This scripts checks that the new grammar of Coq as defined in syntax-v8.tex
+# is consistent in the sense that all invoked non-terminals are defined
+
+defined-nt() {
+  grep "\\DEFNT{.*}" syntax-v8.tex | sed -e "s|.*DEFNT{\([^}]*\)}.*|\1|"|\
+    sort | sort -u
+}
+
+used-nt() {
+  cat syntax-v8.tex | tr \\\\ \\n | grep "^NT{.*}" |\
+    sed -e "s|^NT{\([^}]*\)}.*|\1|" | egrep -v ^\#1\|non-terminal | sort -u
+}
+
+used-term() {
+  cat syntax-v8.tex | tr \\\\ \\n | grep "^TERM{.*}" |\
+    sed -e "s|^TERM{\([^}]*\)}.*|\1|" -e "s|\\$||g" | egrep -v ^\#1\|terminal | sort -u
+}
+
+used-kwd() {
+  cat syntax-v8.tex | tr \\\\ \\n | grep "^KWD{.*}" |\
+    sed -e "s|^KWD{\([^}]*\)}.*|\1|" -e "s|\\$||g" | egrep -v ^\#1 | sort -u
+}
+
+defined-nt > def
+used-nt > use
+used-term > use-t
+used-kwd > use-k
+diff def use > df
+
+###############################
+echo
+if grep ^\> df > /dev/null 2>&1 ; then
+  echo Undefined non-terminals:
+  echo ========================
+  echo
+  grep ^\> df | sed -e "s|^> ||"
+  echo
+fi
+if grep ^\< df > /dev/null 2>&1 ; then
+  echo Unused non-terminals:
+  echo =====================
+  echo
+  grep ^\< df | sed -e "s|^< ||"
+  echo
+fi
+#echo Used terminals:
+#echo ===============
+#echo
+#cat use-t
\ No newline at end of file
diff --git a/dev/doc/interp.dep.ps b/dev/doc/interp.dep.ps
new file mode 100644
index 00000000..b0554481
--- /dev/null
+++ b/dev/doc/interp.dep.ps
@@ -0,0 +1,583 @@
+%!PS-Adobe-2.0
+%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005)
+%%For: (herbelin) Hugo Herbelin
+%%Title: G
+%%Pages: (atend)
+%%BoundingBox: 35 35 577 160
+%%EndComments
+save
+%%BeginProlog
+/DotDict 200 dict def
+DotDict begin
+
+/setupLatin1 {
+mark
+/EncodingVector 256 array def
+ EncodingVector 0
+
+ISOLatin1Encoding 0 255 getinterval putinterval
+
+EncodingVector
+  dup 306 /AE
+  dup 301 /Aacute
+  dup 302 /Acircumflex
+  dup 304 /Adieresis
+  dup 300 /Agrave
+  dup 305 /Aring
+  dup 303 /Atilde
+  dup 307 /Ccedilla
+  dup 311 /Eacute
+  dup 312 /Ecircumflex
+  dup 313 /Edieresis
+  dup 310 /Egrave
+  dup 315 /Iacute
+  dup 316 /Icircumflex
+  dup 317 /Idieresis
+  dup 314 /Igrave
+  dup 334 /Udieresis
+  dup 335 /Yacute
+  dup 376 /thorn
+  dup 337 /germandbls
+  dup 341 /aacute
+  dup 342 /acircumflex
+  dup 344 /adieresis
+  dup 346 /ae
+  dup 340 /agrave
+  dup 345 /aring
+  dup 347 /ccedilla
+  dup 351 /eacute
+  dup 352 /ecircumflex
+  dup 353 /edieresis
+  dup 350 /egrave
+  dup 355 /iacute
+  dup 356 /icircumflex
+  dup 357 /idieresis
+  dup 354 /igrave
+  dup 360 /dcroat
+  dup 361 /ntilde
+  dup 363 /oacute
+  dup 364 /ocircumflex
+  dup 366 /odieresis
+  dup 362 /ograve
+  dup 365 /otilde
+  dup 370 /oslash
+  dup 372 /uacute
+  dup 373 /ucircumflex
+  dup 374 /udieresis
+  dup 371 /ugrave
+  dup 375 /yacute
+  dup 377 /ydieresis  
+
+% Set up ISO Latin 1 character encoding
+/starnetISO {
+        dup dup findfont dup length dict begin
+        { 1 index /FID ne { def }{ pop pop } ifelse
+        } forall
+        /Encoding EncodingVector def
+        currentdict end definefont
+} def
+/Times-Roman starnetISO def
+/Times-Italic starnetISO def
+/Times-Bold starnetISO def
+/Times-BoldItalic starnetISO def
+/Helvetica starnetISO def
+/Helvetica-Oblique starnetISO def
+/Helvetica-Bold starnetISO def
+/Helvetica-BoldOblique starnetISO def
+/Courier starnetISO def
+/Courier-Oblique starnetISO def
+/Courier-Bold starnetISO def
+/Courier-BoldOblique starnetISO def
+cleartomark
+} bind def
+
+%%BeginResource: procset graphviz 0 0
+/coord-font-family /Times-Roman def
+/default-font-family /Times-Roman def
+/coordfont coord-font-family findfont 8 scalefont def
+
+/InvScaleFactor 1.0 def
+/set_scale {
+	dup 1 exch div /InvScaleFactor exch def
+	dup scale
+} bind def
+
+% styles
+/solid { [] 0 setdash } bind def
+/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
+/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
+/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
+/bold { 2 setlinewidth } bind def
+/filled { } bind def
+/unfilled { } bind def
+/rounded { } bind def
+/diagonals { } bind def
+
+% hooks for setting color 
+/nodecolor { sethsbcolor } bind def
+/edgecolor { sethsbcolor } bind def
+/graphcolor { sethsbcolor } bind def
+/nopcolor {pop pop pop} bind def
+
+/beginpage {	% i j npages
+	/npages exch def
+	/j exch def
+	/i exch def
+	/str 10 string def
+	npages 1 gt {
+		gsave
+			coordfont setfont
+			0 0 moveto
+			(\() show i str cvs show (,) show j str cvs show (\)) show
+		grestore
+	} if
+} bind def
+
+/set_font {
+	findfont exch
+	scalefont setfont
+} def
+
+% draw aligned label in bounding box aligned to current point
+/alignedtext {			% width adj text
+	/text exch def
+	/adj exch def
+	/width exch def
+	gsave
+		width 0 gt {
+			text stringwidth pop adj mul 0 rmoveto
+		} if
+		[] 0 setdash
+		text show
+	grestore
+} def
+
+/boxprim {				% xcorner ycorner xsize ysize
+		4 2 roll
+		moveto
+		2 copy
+		exch 0 rlineto
+		0 exch rlineto
+		pop neg 0 rlineto
+		closepath
+} bind def
+
+/ellipse_path {
+	/ry exch def
+	/rx exch def
+	/y exch def
+	/x exch def
+	matrix currentmatrix
+	newpath
+	x y translate
+	rx ry scale
+	0 0 1 0 360 arc
+	setmatrix
+} bind def
+
+/endpage { showpage } bind def
+/showpage { } def
+
+/layercolorseq
+	[	% layer color sequence - darkest to lightest
+		[0 0 0]
+		[.2 .8 .8]
+		[.4 .8 .8]
+		[.6 .8 .8]
+		[.8 .8 .8]
+	]
+def
+
+/layerlen layercolorseq length def
+
+/setlayer {/maxlayer exch def /curlayer exch def
+	layercolorseq curlayer 1 sub layerlen mod get
+	aload pop sethsbcolor
+	/nodecolor {nopcolor} def
+	/edgecolor {nopcolor} def
+	/graphcolor {nopcolor} def
+} bind def
+
+/onlayer { curlayer ne {invis} if } def
+
+/onlayers {
+	/myupper exch def
+	/mylower exch def
+	curlayer mylower lt
+	curlayer myupper gt
+	or
+	{invis} if
+} def
+
+/curlayer 0 def
+
+%%EndResource
+%%EndProlog
+%%BeginSetup
+14 default-font-family set_font
+1 setmiterlimit
+% /arrowlength 10 def
+% /arrowwidth 5 def
+
+% make sure pdfmark is harmless for PS-interpreters other than Distiller
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+% make '<<' and '>>' safe on PS Level 1 devices
+/languagelevel where {pop languagelevel}{1} ifelse
+2 lt {
+    userdict (<<) cvn ([) cvn load put
+    userdict (>>) cvn ([) cvn load put
+} if
+
+%%EndSetup
+%%Page: 1 1
+%%PageBoundingBox: 36 36 577 160
+%%PageOrientation: Portrait
+gsave
+35 35 542 125 boxprim clip newpath
+36 36 translate
+0 0 1 beginpage
+0.9343 set_scale
+0 0 translate 0 rotate
+0.000 0.000 0.000 graphcolor
+14.00 /Times-Roman set_font
+
+%	Syntax_def
+gsave 10 dict begin
+303 110 45 18 ellipse_path
+stroke
+gsave 10 dict begin
+271 105 moveto
+(Syntax_def)
+[7.68 6.96 6.96 4.08 6.24 6.96 6.96 6.96 6.24 4.56]
+xshow
+end grestore
+end grestore
+
+%	Notation
+gsave 10 dict begin
+422 60 38 18 ellipse_path
+stroke
+gsave 10 dict begin
+397 55 moveto
+(Notation)
+[9.84 6.72 4.08 6.24 3.84 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Syntax_def -> Notation
+newpath 334 97 moveto
+350 90 369 83 385 76 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 386 79 moveto
+394 72 lineto
+383 73 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 386 79 moveto
+394 72 lineto
+383 73 lineto
+closepath
+stroke
+end grestore
+
+%	Ppextend
+gsave 10 dict begin
+537 60 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+511 55 moveto
+(Ppextend)
+[7.68 6.96 5.76 6.96 3.84 6.24 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Notation -> Ppextend
+newpath 460 60 moveto
+469 60 478 60 488 60 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 488 64 moveto
+498 60 lineto
+488 57 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 488 64 moveto
+498 60 lineto
+488 57 lineto
+closepath
+stroke
+end grestore
+
+%	Topconstr
+gsave 10 dict begin
+537 114 41 18 ellipse_path
+stroke
+gsave 10 dict begin
+509 109 moveto
+(Topconstr)
+[7.2 6.96 6.96 6.24 6.96 6.96 5.28 3.84 4.56]
+xshow
+end grestore
+end grestore
+
+%	Notation -> Topconstr
+newpath 449 73 moveto
+464 80 483 89 500 97 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 498 100 moveto
+509 101 lineto
+501 94 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 498 100 moveto
+509 101 lineto
+501 94 lineto
+closepath
+stroke
+end grestore
+
+%	Modintern
+gsave 10 dict begin
+44 98 43 18 ellipse_path
+stroke
+gsave 10 dict begin
+13 93 moveto
+(Modintern)
+[12.48 6.96 6.96 3.84 6.96 3.84 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	Constrintern
+gsave 10 dict begin
+173 98 48 18 ellipse_path
+stroke
+gsave 10 dict begin
+138 93 moveto
+(Constrintern)
+[9.36 6.96 6.96 5.28 3.84 4.8 3.84 6.96 3.84 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	Modintern -> Constrintern
+newpath 88 98 moveto
+97 98 106 98 115 98 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 115 102 moveto
+125 98 lineto
+115 95 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 115 102 moveto
+125 98 lineto
+115 95 lineto
+closepath
+stroke
+end grestore
+
+%	Constrintern -> Syntax_def
+newpath 220 102 moveto
+229 103 239 104 249 105 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 249 108 moveto
+259 106 lineto
+249 102 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 249 108 moveto
+259 106 lineto
+249 102 lineto
+closepath
+stroke
+end grestore
+
+%	Reserve
+gsave 10 dict begin
+303 56 35 18 ellipse_path
+stroke
+gsave 10 dict begin
+280 51 moveto
+(Reserve)
+[9.12 6.24 5.52 6.24 4.8 6.48 6.24]
+xshow
+end grestore
+end grestore
+
+%	Constrintern -> Reserve
+newpath 210 86 moveto
+227 81 246 75 263 69 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 264 72 moveto
+273 66 lineto
+262 66 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 264 72 moveto
+273 66 lineto
+262 66 lineto
+closepath
+stroke
+end grestore
+
+%	Genarg
+gsave 10 dict begin
+422 114 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+401 109 moveto
+(Genarg)
+[10.08 6.24 6.96 6.24 4.32 6.96]
+xshow
+end grestore
+end grestore
+
+%	Genarg -> Topconstr
+newpath 456 114 moveto
+465 114 476 114 486 114 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 486 118 moveto
+496 114 lineto
+486 111 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 486 118 moveto
+496 114 lineto
+486 111 lineto
+closepath
+stroke
+end grestore
+
+%	Coqlib
+gsave 10 dict begin
+44 21 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+24 16 moveto
+(Coqlib)
+[9.36 6.96 6.96 3.84 3.84 6.96]
+xshow
+end grestore
+end grestore
+
+%	Constrextern
+gsave 10 dict begin
+173 21 49 18 ellipse_path
+stroke
+gsave 10 dict begin
+137 16 moveto
+(Constrextern)
+[9.36 6.96 6.96 5.28 3.84 4.56 5.76 6.96 3.84 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	Coqlib -> Constrextern
+newpath 77 21 moveto
+88 21 101 21 114 21 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 114 25 moveto
+124 21 lineto
+114 18 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 114 25 moveto
+124 21 lineto
+114 18 lineto
+closepath
+stroke
+end grestore
+
+%	Constrextern -> Notation
+newpath 222 19 moveto
+257 18 307 20 348 29 curveto
+361 31 375 37 388 42 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 386 45 moveto
+397 46 lineto
+389 39 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 386 45 moveto
+397 46 lineto
+389 39 lineto
+closepath
+stroke
+end grestore
+
+%	Constrextern -> Reserve
+newpath 213 32 moveto
+228 36 246 41 261 45 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 260 48 moveto
+271 48 lineto
+262 42 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 260 48 moveto
+271 48 lineto
+262 42 lineto
+closepath
+stroke
+end grestore
+endpage
+showpage
+grestore
+%%PageTrailer
+%%EndPage: 1
+%%Trailer
+%%Pages: 1
+end
+restore
+%%EOF
diff --git a/dev/doc/intro.tex b/dev/doc/intro.tex
new file mode 100644
index 00000000..4cec8673
--- /dev/null
+++ b/dev/doc/intro.tex
@@ -0,0 +1,25 @@
+
+\ocwsection This is \Coq, a proof assistant for the \CCI.
+This document describes the implementation of \Coq.
+It has been automatically generated from the source of
+\Coq\ using \textsf{ocamlweb}, a literate programming tool for
+\textsf{Objective Caml}\footnote{\Coq, \textsf{Objective Caml} and
+  \textsf{ocamlweb} are all freely available at
+  \textsf{http://coq.inria.fr/}, \textsf{http://caml.inria.fr/} and
+  \textsf{http://www.lri.fr/\~{}filliatr/ocamlweb}.}.
+The source files are organized in several directories, which are
+described here as separate chapters.
+
+\begin{center}
+  \begin{tabular}{p{10cm}rr}
+    Chapter & section & page \\[0.5em]
+    \hline\\[0.2em]
+    Utility libraries \dotfill & \refsec{lib}     & \pageref{lib}     \\[0.5em]
+    Kernel            \dotfill & \refsec{kernel}  & \pageref{kernel}  \\[0.5em]
+    Library           \dotfill & \refsec{library} & \pageref{library} \\[0.5em]
+    Pretyping     \dotfill & \refsec{pretyping} & \pageref{pretyping} \\[0.5em]
+    Proof engine      \dotfill & \refsec{proofs}  & \pageref{proofs}  \\[0.5em]
+    Tactics           \dotfill & \refsec{tactics} & \pageref{tactics} \\[0.5em]
+    Toplevel          \dotfill & \refsec{toplevel}& \pageref{toplevel}\\[0.5em]
+  \end{tabular}
+\end{center}
\ No newline at end of file
diff --git a/dev/doc/kernel.dep.ps b/dev/doc/kernel.dep.ps
new file mode 100644
index 00000000..3c00121e
--- /dev/null
+++ b/dev/doc/kernel.dep.ps
@@ -0,0 +1,1454 @@
+%!PS-Adobe-2.0
+%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005)
+%%For: (herbelin) Hugo Herbelin
+%%Title: G
+%%Pages: (atend)
+%%BoundingBox: 35 35 577 127
+%%EndComments
+save
+%%BeginProlog
+/DotDict 200 dict def
+DotDict begin
+
+/setupLatin1 {
+mark
+/EncodingVector 256 array def
+ EncodingVector 0
+
+ISOLatin1Encoding 0 255 getinterval putinterval
+
+EncodingVector
+  dup 306 /AE
+  dup 301 /Aacute
+  dup 302 /Acircumflex
+  dup 304 /Adieresis
+  dup 300 /Agrave
+  dup 305 /Aring
+  dup 303 /Atilde
+  dup 307 /Ccedilla
+  dup 311 /Eacute
+  dup 312 /Ecircumflex
+  dup 313 /Edieresis
+  dup 310 /Egrave
+  dup 315 /Iacute
+  dup 316 /Icircumflex
+  dup 317 /Idieresis
+  dup 314 /Igrave
+  dup 334 /Udieresis
+  dup 335 /Yacute
+  dup 376 /thorn
+  dup 337 /germandbls
+  dup 341 /aacute
+  dup 342 /acircumflex
+  dup 344 /adieresis
+  dup 346 /ae
+  dup 340 /agrave
+  dup 345 /aring
+  dup 347 /ccedilla
+  dup 351 /eacute
+  dup 352 /ecircumflex
+  dup 353 /edieresis
+  dup 350 /egrave
+  dup 355 /iacute
+  dup 356 /icircumflex
+  dup 357 /idieresis
+  dup 354 /igrave
+  dup 360 /dcroat
+  dup 361 /ntilde
+  dup 363 /oacute
+  dup 364 /ocircumflex
+  dup 366 /odieresis
+  dup 362 /ograve
+  dup 365 /otilde
+  dup 370 /oslash
+  dup 372 /uacute
+  dup 373 /ucircumflex
+  dup 374 /udieresis
+  dup 371 /ugrave
+  dup 375 /yacute
+  dup 377 /ydieresis  
+
+% Set up ISO Latin 1 character encoding
+/starnetISO {
+        dup dup findfont dup length dict begin
+        { 1 index /FID ne { def }{ pop pop } ifelse
+        } forall
+        /Encoding EncodingVector def
+        currentdict end definefont
+} def
+/Times-Roman starnetISO def
+/Times-Italic starnetISO def
+/Times-Bold starnetISO def
+/Times-BoldItalic starnetISO def
+/Helvetica starnetISO def
+/Helvetica-Oblique starnetISO def
+/Helvetica-Bold starnetISO def
+/Helvetica-BoldOblique starnetISO def
+/Courier starnetISO def
+/Courier-Oblique starnetISO def
+/Courier-Bold starnetISO def
+/Courier-BoldOblique starnetISO def
+cleartomark
+} bind def
+
+%%BeginResource: procset graphviz 0 0
+/coord-font-family /Times-Roman def
+/default-font-family /Times-Roman def
+/coordfont coord-font-family findfont 8 scalefont def
+
+/InvScaleFactor 1.0 def
+/set_scale {
+	dup 1 exch div /InvScaleFactor exch def
+	dup scale
+} bind def
+
+% styles
+/solid { [] 0 setdash } bind def
+/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
+/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
+/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
+/bold { 2 setlinewidth } bind def
+/filled { } bind def
+/unfilled { } bind def
+/rounded { } bind def
+/diagonals { } bind def
+
+% hooks for setting color 
+/nodecolor { sethsbcolor } bind def
+/edgecolor { sethsbcolor } bind def
+/graphcolor { sethsbcolor } bind def
+/nopcolor {pop pop pop} bind def
+
+/beginpage {	% i j npages
+	/npages exch def
+	/j exch def
+	/i exch def
+	/str 10 string def
+	npages 1 gt {
+		gsave
+			coordfont setfont
+			0 0 moveto
+			(\() show i str cvs show (,) show j str cvs show (\)) show
+		grestore
+	} if
+} bind def
+
+/set_font {
+	findfont exch
+	scalefont setfont
+} def
+
+% draw aligned label in bounding box aligned to current point
+/alignedtext {			% width adj text
+	/text exch def
+	/adj exch def
+	/width exch def
+	gsave
+		width 0 gt {
+			text stringwidth pop adj mul 0 rmoveto
+		} if
+		[] 0 setdash
+		text show
+	grestore
+} def
+
+/boxprim {				% xcorner ycorner xsize ysize
+		4 2 roll
+		moveto
+		2 copy
+		exch 0 rlineto
+		0 exch rlineto
+		pop neg 0 rlineto
+		closepath
+} bind def
+
+/ellipse_path {
+	/ry exch def
+	/rx exch def
+	/y exch def
+	/x exch def
+	matrix currentmatrix
+	newpath
+	x y translate
+	rx ry scale
+	0 0 1 0 360 arc
+	setmatrix
+} bind def
+
+/endpage { showpage } bind def
+/showpage { } def
+
+/layercolorseq
+	[	% layer color sequence - darkest to lightest
+		[0 0 0]
+		[.2 .8 .8]
+		[.4 .8 .8]
+		[.6 .8 .8]
+		[.8 .8 .8]
+	]
+def
+
+/layerlen layercolorseq length def
+
+/setlayer {/maxlayer exch def /curlayer exch def
+	layercolorseq curlayer 1 sub layerlen mod get
+	aload pop sethsbcolor
+	/nodecolor {nopcolor} def
+	/edgecolor {nopcolor} def
+	/graphcolor {nopcolor} def
+} bind def
+
+/onlayer { curlayer ne {invis} if } def
+
+/onlayers {
+	/myupper exch def
+	/mylower exch def
+	curlayer mylower lt
+	curlayer myupper gt
+	or
+	{invis} if
+} def
+
+/curlayer 0 def
+
+%%EndResource
+%%EndProlog
+%%BeginSetup
+14 default-font-family set_font
+1 setmiterlimit
+% /arrowlength 10 def
+% /arrowwidth 5 def
+
+% make sure pdfmark is harmless for PS-interpreters other than Distiller
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+% make '<<' and '>>' safe on PS Level 1 devices
+/languagelevel where {pop languagelevel}{1} ifelse
+2 lt {
+    userdict (<<) cvn ([) cvn load put
+    userdict (>>) cvn ([) cvn load put
+} if
+
+%%EndSetup
+%%Page: 1 1
+%%PageBoundingBox: 36 36 577 127
+%%PageOrientation: Portrait
+gsave
+35 35 542 92 boxprim clip newpath
+36 36 translate
+0 0 1 beginpage
+0.2845 set_scale
+0 0 translate 0 rotate
+0.000 0.000 0.000 graphcolor
+14.00 /Times-Roman set_font
+
+%	Vm
+gsave 10 dict begin
+801 294 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+789 289 moveto
+(Vm)
+[10.08 10.8]
+xshow
+end grestore
+end grestore
+
+%	Cemitcodes
+gsave 10 dict begin
+1427 200 46 18 ellipse_path
+stroke
+gsave 10 dict begin
+1393 195 moveto
+(Cemitcodes)
+[9.36 6.24 10.8 3.84 3.84 6.24 6.96 6.96 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Vm -> Cemitcodes
+newpath 826 287 moveto
+871 276 969 254 1053 254 curveto
+1053 254 1053 254 1174 254 curveto
+1249 254 1332 231 1382 215 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1383 218 moveto
+1392 212 lineto
+1381 212 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1383 218 moveto
+1392 212 lineto
+1381 212 lineto
+closepath
+stroke
+end grestore
+
+%	Conv_oracle
+gsave 10 dict begin
+1053 300 48 18 ellipse_path
+stroke
+gsave 10 dict begin
+1017 295 moveto
+(Conv_oracle)
+[9.36 6.96 6.48 6.96 6.96 6.96 4.56 6.24 6.24 3.84 6.24]
+xshow
+end grestore
+end grestore
+
+%	Vm -> Conv_oracle
+newpath 828 295 moveto
+868 296 942 298 995 299 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 995 303 moveto
+1005 299 lineto
+995 296 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 995 303 moveto
+1005 299 lineto
+995 296 lineto
+closepath
+stroke
+end grestore
+
+%	Mod_subst
+gsave 10 dict begin
+1556 146 45 18 ellipse_path
+stroke
+gsave 10 dict begin
+1524 141 moveto
+(Mod_subst)
+[12.48 6.96 6.96 6.96 5.52 6.96 6.96 5.28 3.84]
+xshow
+end grestore
+end grestore
+
+%	Cemitcodes -> Mod_subst
+newpath 1459 187 moveto
+1476 180 1497 171 1516 163 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1517 166 moveto
+1525 159 lineto
+1514 160 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1517 166 moveto
+1525 159 lineto
+1514 160 lineto
+closepath
+stroke
+end grestore
+
+%	Cbytecodes
+gsave 10 dict begin
+1556 200 45 18 ellipse_path
+stroke
+gsave 10 dict begin
+1523 195 moveto
+(Cbytecodes)
+[9.36 6.48 6.96 3.84 6.24 6.24 6.96 6.96 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Cemitcodes -> Cbytecodes
+newpath 1474 200 moveto
+1482 200 1491 200 1500 200 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1500 204 moveto
+1510 200 lineto
+1500 197 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1500 204 moveto
+1510 200 lineto
+1500 197 lineto
+closepath
+stroke
+end grestore
+
+%	Copcodes
+gsave 10 dict begin
+1556 254 41 18 ellipse_path
+stroke
+gsave 10 dict begin
+1528 249 moveto
+(Copcodes)
+[9.36 6.96 6.96 6.24 6.96 6.96 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Cemitcodes -> Copcodes
+newpath 1459 213 moveto
+1476 221 1498 230 1517 237 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1515 240 moveto
+1526 241 lineto
+1518 234 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1515 240 moveto
+1526 241 lineto
+1518 234 lineto
+closepath
+stroke
+end grestore
+
+%	Names
+gsave 10 dict begin
+1865 270 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+1845 265 moveto
+(Names)
+[9.6 6.24 10.8 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Conv_oracle -> Names
+newpath 1102 300 moveto
+1151 300 1228 300 1295 300 curveto
+1295 300 1295 300 1666 300 curveto
+1722 300 1785 288 1825 279 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1826 282 moveto
+1835 277 lineto
+1825 276 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1826 282 moveto
+1835 277 lineto
+1825 276 lineto
+closepath
+stroke
+end grestore
+
+%	Vconv
+gsave 10 dict begin
+552 202 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+533 197 moveto
+(Vconv)
+[10.08 6.24 6.96 6.48 6.96]
+xshow
+end grestore
+end grestore
+
+%	Csymtable
+gsave 10 dict begin
+674 202 43 18 ellipse_path
+stroke
+gsave 10 dict begin
+643 197 moveto
+(Csymtable)
+[9.36 5.52 6.96 10.8 4.08 6.24 6.96 3.84 6.24]
+xshow
+end grestore
+end grestore
+
+%	Vconv -> Csymtable
+newpath 584 202 moveto
+595 202 608 202 620 202 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 620 206 moveto
+630 202 lineto
+620 199 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 620 206 moveto
+630 202 lineto
+620 199 lineto
+closepath
+stroke
+end grestore
+
+%	Inductive
+gsave 10 dict begin
+674 110 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+647 105 moveto
+(Inductive)
+[4.56 6.96 6.96 6.96 6.24 3.84 3.84 6.48 6.24]
+xshow
+end grestore
+end grestore
+
+%	Vconv -> Inductive
+newpath 571 187 moveto
+591 172 622 149 645 132 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 647 135 moveto
+653 126 lineto
+643 129 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 647 135 moveto
+653 126 lineto
+643 129 lineto
+closepath
+stroke
+end grestore
+
+%	Csymtable -> Vm
+newpath 696 218 moveto
+717 234 751 258 775 275 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 773 278 moveto
+783 281 lineto
+777 272 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 773 278 moveto
+783 281 lineto
+777 272 lineto
+closepath
+stroke
+end grestore
+
+%	Cbytegen
+gsave 10 dict begin
+801 164 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+774 159 moveto
+(Cbytegen)
+[9.36 6.48 6.96 3.84 6.24 6.72 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	Csymtable -> Cbytegen
+newpath 709 191 moveto
+724 187 742 181 758 177 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 759 180 moveto
+768 174 lineto
+757 174 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 759 180 moveto
+768 174 lineto
+757 174 lineto
+closepath
+stroke
+end grestore
+
+%	Type_errors
+gsave 10 dict begin
+801 110 47 18 ellipse_path
+stroke
+gsave 10 dict begin
+767 105 moveto
+(Type_errors)
+[6.96 6.96 6.96 6.24 6.96 6.24 5.04 4.56 6.96 4.56 5.52]
+xshow
+end grestore
+end grestore
+
+%	Inductive -> Type_errors
+newpath 714 110 moveto
+724 110 734 110 744 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 744 114 moveto
+754 110 lineto
+744 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 744 114 moveto
+754 110 lineto
+744 107 lineto
+closepath
+stroke
+end grestore
+
+%	Univ
+gsave 10 dict begin
+1763 241 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+1748 236 moveto
+(Univ)
+[9.6 6.96 3.84 6.96]
+xshow
+end grestore
+end grestore
+
+%	Univ -> Names
+newpath 1788 248 moveto
+1800 251 1814 255 1826 259 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1825 262 moveto
+1836 262 lineto
+1827 256 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1825 262 moveto
+1836 262 lineto
+1827 256 lineto
+closepath
+stroke
+end grestore
+
+%	Typeops
+gsave 10 dict begin
+552 110 36 18 ellipse_path
+stroke
+gsave 10 dict begin
+528 105 moveto
+(Typeops)
+[6.96 6.96 6.96 6.24 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Typeops -> Inductive
+newpath 589 110 moveto
+600 110 612 110 624 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 624 114 moveto
+634 110 lineto
+624 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 624 114 moveto
+634 110 lineto
+624 107 lineto
+closepath
+stroke
+end grestore
+
+%	Entries
+gsave 10 dict begin
+801 56 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+780 51 moveto
+(Entries)
+[8.4 6.96 3.84 4.8 3.84 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Typeops -> Entries
+newpath 581 99 moveto
+595 93 614 87 630 83 curveto
+673 73 723 66 758 61 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 758 64 moveto
+768 60 lineto
+758 58 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 758 64 moveto
+768 60 lineto
+758 58 lineto
+closepath
+stroke
+end grestore
+
+%	Sign
+gsave 10 dict begin
+1427 100 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+1414 95 moveto
+(Sign)
+[7.68 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Entries -> Sign
+newpath 834 61 moveto
+882 68 974 79 1053 79 curveto
+1053 79 1053 79 1174 79 curveto
+1251 79 1342 89 1390 95 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1390 98 moveto
+1400 96 lineto
+1390 92 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1390 98 moveto
+1400 96 lineto
+1390 92 lineto
+closepath
+stroke
+end grestore
+
+%	Reduction
+gsave 10 dict begin
+926 208 42 18 ellipse_path
+stroke
+gsave 10 dict begin
+897 203 moveto
+(Reduction)
+[9.12 6.24 6.96 6.96 6.24 3.84 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Type_errors -> Reduction
+newpath 829 125 moveto
+836 129 842 133 848 137 curveto
+868 151 887 170 902 184 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 900 187 moveto
+910 191 lineto
+905 182 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 900 187 moveto
+910 191 lineto
+905 182 lineto
+closepath
+stroke
+end grestore
+
+%	Reduction -> Conv_oracle
+newpath 948 224 moveto
+968 239 999 261 1023 278 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1021 281 moveto
+1031 284 lineto
+1025 275 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1021 281 moveto
+1031 284 lineto
+1025 275 lineto
+closepath
+stroke
+end grestore
+
+%	Closure
+gsave 10 dict begin
+1053 208 35 18 ellipse_path
+stroke
+gsave 10 dict begin
+1031 203 moveto
+(Closure)
+[9.36 3.84 6.96 5.52 6.96 4.56 6.24]
+xshow
+end grestore
+end grestore
+
+%	Reduction -> Closure
+newpath 968 208 moveto
+981 208 994 208 1008 208 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1008 212 moveto
+1018 208 lineto
+1008 205 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1008 212 moveto
+1018 208 lineto
+1008 205 lineto
+closepath
+stroke
+end grestore
+
+%	Term_typing
+gsave 10 dict begin
+313 110 49 18 ellipse_path
+stroke
+gsave 10 dict begin
+277 105 moveto
+(Term_typing)
+[7.2 6.24 4.8 10.8 6.96 3.84 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Term_typing -> Cbytegen
+newpath 347 123 moveto
+363 128 381 134 398 137 curveto
+524 161 675 165 752 165 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 752 169 moveto
+762 165 lineto
+752 162 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 752 169 moveto
+762 165 lineto
+752 162 lineto
+closepath
+stroke
+end grestore
+
+%	Cooking
+gsave 10 dict begin
+436 225 37 18 ellipse_path
+stroke
+gsave 10 dict begin
+411 220 moveto
+(Cooking)
+[9.36 6.96 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Term_typing -> Cooking
+newpath 331 127 moveto
+352 147 387 179 410 202 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 408 205 moveto
+418 209 lineto
+413 200 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 408 205 moveto
+418 209 lineto
+413 200 lineto
+closepath
+stroke
+end grestore
+
+%	Indtypes
+gsave 10 dict begin
+436 110 37 18 ellipse_path
+stroke
+gsave 10 dict begin
+411 105 moveto
+(Indtypes)
+[4.56 6.96 6.96 3.84 6.96 6.96 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Term_typing -> Indtypes
+newpath 362 110 moveto
+370 110 379 110 388 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 388 114 moveto
+398 110 lineto
+388 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 388 114 moveto
+398 110 lineto
+388 107 lineto
+closepath
+stroke
+end grestore
+
+%	Environ
+gsave 10 dict begin
+1174 181 36 18 ellipse_path
+stroke
+gsave 10 dict begin
+1151 176 moveto
+(Environ)
+[8.4 6.48 6.96 3.84 4.56 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Cbytegen -> Environ
+newpath 841 166 moveto
+911 169 1054 175 1128 179 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1128 183 moveto
+1138 179 lineto
+1128 176 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1128 183 moveto
+1138 179 lineto
+1128 176 lineto
+closepath
+stroke
+end grestore
+
+%	Cooking -> Reduction
+newpath 473 227 moveto
+485 228 498 229 510 229 curveto
+603 231 626 233 718 229 curveto
+773 226 834 220 876 214 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 876 217 moveto
+886 213 lineto
+876 211 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 876 217 moveto
+886 213 lineto
+876 211 lineto
+closepath
+stroke
+end grestore
+
+%	Indtypes -> Typeops
+newpath 474 110 moveto
+484 110 495 110 505 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 505 114 moveto
+515 110 lineto
+505 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 505 114 moveto
+515 110 lineto
+505 107 lineto
+closepath
+stroke
+end grestore
+
+%	Term
+gsave 10 dict begin
+1666 173 28 18 ellipse_path
+stroke
+gsave 10 dict begin
+1651 168 moveto
+(Term)
+[7.2 6.24 4.8 10.8]
+xshow
+end grestore
+end grestore
+
+%	Term -> Univ
+newpath 1685 186 moveto
+1699 196 1719 211 1736 222 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1734 225 moveto
+1744 228 lineto
+1738 219 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1734 225 moveto
+1744 228 lineto
+1738 219 lineto
+closepath
+stroke
+end grestore
+
+%	Esubst
+gsave 10 dict begin
+1763 173 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+1743 168 moveto
+(Esubst)
+[8.4 5.52 6.96 6.96 5.28 3.84]
+xshow
+end grestore
+end grestore
+
+%	Term -> Esubst
+newpath 1694 173 moveto
+1702 173 1711 173 1720 173 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1720 177 moveto
+1730 173 lineto
+1720 170 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1720 177 moveto
+1730 173 lineto
+1720 170 lineto
+closepath
+stroke
+end grestore
+
+%	Subtyping
+gsave 10 dict begin
+552 56 42 18 ellipse_path
+stroke
+gsave 10 dict begin
+523 51 moveto
+(Subtyping)
+[7.68 6.96 6.96 3.84 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Subtyping -> Inductive
+newpath 581 69 moveto
+597 77 618 86 636 93 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 634 96 moveto
+645 97 lineto
+637 90 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 634 96 moveto
+645 97 lineto
+637 90 lineto
+closepath
+stroke
+end grestore
+
+%	Modops
+gsave 10 dict begin
+674 18 36 18 ellipse_path
+stroke
+gsave 10 dict begin
+650 13 moveto
+(Modops)
+[12.48 6.96 6.96 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Subtyping -> Modops
+newpath 586 45 moveto
+601 41 618 35 633 31 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 634 34 moveto
+643 28 lineto
+632 28 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 634 34 moveto
+643 28 lineto
+632 28 lineto
+closepath
+stroke
+end grestore
+
+%	Modops -> Entries
+newpath 705 27 moveto
+722 32 743 39 761 44 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 760 47 moveto
+771 47 lineto
+762 41 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 760 47 moveto
+771 47 lineto
+762 41 lineto
+closepath
+stroke
+end grestore
+
+%	Modops -> Cbytegen
+newpath 686 35 moveto
+695 48 707 67 718 83 curveto
+735 107 733 118 754 137 curveto
+757 140 761 143 765 145 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 763 148 moveto
+773 151 lineto
+767 142 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 763 148 moveto
+773 151 lineto
+767 142 lineto
+closepath
+stroke
+end grestore
+
+%	Sign -> Term
+newpath 1454 99 moveto
+1489 98 1553 100 1602 119 curveto
+1626 129 1637 135 1649 148 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1647 151 moveto
+1656 156 lineto
+1652 146 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1647 151 moveto
+1656 156 lineto
+1652 146 lineto
+closepath
+stroke
+end grestore
+
+%	Safe_typing
+gsave 10 dict begin
+47 85 46 18 ellipse_path
+stroke
+gsave 10 dict begin
+13 80 moveto
+(Safe_typing)
+[7.68 6.24 4.08 6.24 6.96 3.84 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Mod_typing
+gsave 10 dict begin
+179 85 48 18 ellipse_path
+stroke
+gsave 10 dict begin
+143 80 moveto
+(Mod_typing)
+[12.48 6.96 6.96 6.96 3.84 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Safe_typing -> Mod_typing
+newpath 94 85 moveto
+103 85 111 85 120 85 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 120 89 moveto
+130 85 lineto
+120 82 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 120 89 moveto
+130 85 lineto
+120 82 lineto
+closepath
+stroke
+end grestore
+
+%	Mod_typing -> Term_typing
+newpath 223 93 moveto
+235 95 248 98 260 100 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 260 103 moveto
+270 102 lineto
+261 97 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 260 103 moveto
+270 102 lineto
+261 97 lineto
+closepath
+stroke
+end grestore
+
+%	Mod_typing -> Subtyping
+newpath 227 81 moveto
+297 75 428 65 500 60 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 500 63 moveto
+510 59 lineto
+500 57 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 500 63 moveto
+510 59 lineto
+500 57 lineto
+closepath
+stroke
+end grestore
+
+%	Closure -> Environ
+newpath 1085 201 moveto
+1099 198 1116 194 1131 190 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1132 193 moveto
+1141 188 lineto
+1131 187 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1132 193 moveto
+1141 188 lineto
+1131 187 lineto
+closepath
+stroke
+end grestore
+
+%	Mod_subst -> Term
+newpath 1594 155 moveto
+1606 158 1618 161 1630 164 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1630 167 moveto
+1640 166 lineto
+1631 161 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1630 167 moveto
+1640 166 lineto
+1631 161 lineto
+closepath
+stroke
+end grestore
+
+%	Declarations
+gsave 10 dict begin
+1295 181 49 18 ellipse_path
+stroke
+gsave 10 dict begin
+1259 176 moveto
+(Declarations)
+[10.08 6.24 6.24 3.84 6.24 4.56 6.24 3.84 3.84 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Environ -> Declarations
+newpath 1210 181 moveto
+1218 181 1227 181 1236 181 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1236 185 moveto
+1246 181 lineto
+1236 178 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1236 185 moveto
+1246 181 lineto
+1236 178 lineto
+closepath
+stroke
+end grestore
+
+%	Declarations -> Cemitcodes
+newpath 1341 188 moveto
+1351 189 1363 191 1373 192 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1373 195 moveto
+1383 194 lineto
+1374 189 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1373 195 moveto
+1383 194 lineto
+1374 189 lineto
+closepath
+stroke
+end grestore
+
+%	Declarations -> Sign
+newpath 1320 165 moveto
+1343 152 1375 132 1398 118 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1401 120 moveto
+1407 112 lineto
+1397 115 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1401 120 moveto
+1407 112 lineto
+1397 115 lineto
+closepath
+stroke
+end grestore
+
+%	Cbytecodes -> Term
+newpath 1595 190 moveto
+1607 188 1619 185 1630 182 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1631 185 moveto
+1640 179 lineto
+1629 179 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1631 185 moveto
+1640 179 lineto
+1629 179 lineto
+closepath
+stroke
+end grestore
+endpage
+showpage
+grestore
+%%PageTrailer
+%%EndPage: 1
+%%Trailer
+%%Pages: 1
+end
+restore
+%%EOF
diff --git a/dev/doc/lex.mll b/dev/doc/lex.mll
new file mode 100644
index 00000000..617163e7
--- /dev/null
+++ b/dev/doc/lex.mll
@@ -0,0 +1,81 @@
+
+{
+ open Lexing
+ open Syntax
+
+ let chan_out = ref stdout
+
+ let comment_depth = ref 0
+ let print s = output_string !chan_out s
+ 
+ exception Fin_fichier
+
+}
+
+let space = [' ' '\t' '\n']
+let letter = ['a'-'z' 'A'-'Z']
+let digit = ['0'-'9']
+
+let identifier = letter (letter | digit | ['_' '\''])*
+let number = digit+
+let oper = ['-' '+' '/' '*' '|' '>' '<' '=' '%' '#' '$' ':' '\\' '?'
+            '.' '!' '@' ]+
+
+rule token = parse
+  | "let" {LET}
+  | "in" {IN}
+  | "match" {MATCH}
+  | "with" {WITH}
+  | "end" {END}
+  | "and" {AND}
+  | "fun" {FUN}
+  | "if" {IF}
+  | "then" {THEN}
+  | "else" {ELSE}
+  | "eval" {EVAL}
+  | "for" {FOR}
+  | "Prop" {PROP}
+  | "Set" {SET}
+  | "Type" {TYPE}
+  | "fix" {FIX}
+  | "cofix" {COFIX}
+  | "struct" {STRUCT}
+  | "as" {AS}
+
+  | "Simpl" {SIMPL}
+
+  | "_" {WILDCARD}
+  | "(" {LPAR}
+  | ")" {RPAR}
+  | "{" {LBRACE}
+  | "}" {RBRACE}
+  | "!" {BANG}
+  | "@" {AT}
+  | ":" {COLON}
+  | ":=" {COLONEQ}
+  | "." {DOT}
+  | "," {COMMA}
+  | "->" {OPER "->"}
+  | "=>" {RARROW}
+  | "|" {BAR}
+  | "%" {PERCENT}
+
+  | '?' { META(ident lexbuf)}
+  | number { INT(Lexing.lexeme lexbuf) }
+  | oper { OPER(Lexing.lexeme lexbuf) }
+  | identifier { IDENT (Lexing.lexeme lexbuf) }
+  | "(*" (*"*)"*)       { comment_depth := 1;
+                          comment lexbuf;
+		          token lexbuf }
+  | space+     { token lexbuf}
+  | eof        { EOF }
+
+and ident = parse
+  | identifier { Lexing.lexeme lexbuf }
+
+and comment = parse
+  | "(*" (*"*)"*)  { incr comment_depth; comment lexbuf }
+  | (*"(*"*) "*)"
+      { decr comment_depth; if !comment_depth > 0 then comment lexbuf }
+  | eof   { raise Fin_fichier } 
+  | _     { comment lexbuf }
diff --git a/dev/doc/library.dep.ps b/dev/doc/library.dep.ps
new file mode 100644
index 00000000..1c68240e
--- /dev/null
+++ b/dev/doc/library.dep.ps
@@ -0,0 +1,836 @@
+%!PS-Adobe-2.0
+%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005)
+%%For: (herbelin) Hugo Herbelin
+%%Title: G
+%%Pages: (atend)
+%%BoundingBox: 35 35 577 207
+%%EndComments
+save
+%%BeginProlog
+/DotDict 200 dict def
+DotDict begin
+
+/setupLatin1 {
+mark
+/EncodingVector 256 array def
+ EncodingVector 0
+
+ISOLatin1Encoding 0 255 getinterval putinterval
+
+EncodingVector
+  dup 306 /AE
+  dup 301 /Aacute
+  dup 302 /Acircumflex
+  dup 304 /Adieresis
+  dup 300 /Agrave
+  dup 305 /Aring
+  dup 303 /Atilde
+  dup 307 /Ccedilla
+  dup 311 /Eacute
+  dup 312 /Ecircumflex
+  dup 313 /Edieresis
+  dup 310 /Egrave
+  dup 315 /Iacute
+  dup 316 /Icircumflex
+  dup 317 /Idieresis
+  dup 314 /Igrave
+  dup 334 /Udieresis
+  dup 335 /Yacute
+  dup 376 /thorn
+  dup 337 /germandbls
+  dup 341 /aacute
+  dup 342 /acircumflex
+  dup 344 /adieresis
+  dup 346 /ae
+  dup 340 /agrave
+  dup 345 /aring
+  dup 347 /ccedilla
+  dup 351 /eacute
+  dup 352 /ecircumflex
+  dup 353 /edieresis
+  dup 350 /egrave
+  dup 355 /iacute
+  dup 356 /icircumflex
+  dup 357 /idieresis
+  dup 354 /igrave
+  dup 360 /dcroat
+  dup 361 /ntilde
+  dup 363 /oacute
+  dup 364 /ocircumflex
+  dup 366 /odieresis
+  dup 362 /ograve
+  dup 365 /otilde
+  dup 370 /oslash
+  dup 372 /uacute
+  dup 373 /ucircumflex
+  dup 374 /udieresis
+  dup 371 /ugrave
+  dup 375 /yacute
+  dup 377 /ydieresis  
+
+% Set up ISO Latin 1 character encoding
+/starnetISO {
+        dup dup findfont dup length dict begin
+        { 1 index /FID ne { def }{ pop pop } ifelse
+        } forall
+        /Encoding EncodingVector def
+        currentdict end definefont
+} def
+/Times-Roman starnetISO def
+/Times-Italic starnetISO def
+/Times-Bold starnetISO def
+/Times-BoldItalic starnetISO def
+/Helvetica starnetISO def
+/Helvetica-Oblique starnetISO def
+/Helvetica-Bold starnetISO def
+/Helvetica-BoldOblique starnetISO def
+/Courier starnetISO def
+/Courier-Oblique starnetISO def
+/Courier-Bold starnetISO def
+/Courier-BoldOblique starnetISO def
+cleartomark
+} bind def
+
+%%BeginResource: procset graphviz 0 0
+/coord-font-family /Times-Roman def
+/default-font-family /Times-Roman def
+/coordfont coord-font-family findfont 8 scalefont def
+
+/InvScaleFactor 1.0 def
+/set_scale {
+	dup 1 exch div /InvScaleFactor exch def
+	dup scale
+} bind def
+
+% styles
+/solid { [] 0 setdash } bind def
+/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
+/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
+/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
+/bold { 2 setlinewidth } bind def
+/filled { } bind def
+/unfilled { } bind def
+/rounded { } bind def
+/diagonals { } bind def
+
+% hooks for setting color 
+/nodecolor { sethsbcolor } bind def
+/edgecolor { sethsbcolor } bind def
+/graphcolor { sethsbcolor } bind def
+/nopcolor {pop pop pop} bind def
+
+/beginpage {	% i j npages
+	/npages exch def
+	/j exch def
+	/i exch def
+	/str 10 string def
+	npages 1 gt {
+		gsave
+			coordfont setfont
+			0 0 moveto
+			(\() show i str cvs show (,) show j str cvs show (\)) show
+		grestore
+	} if
+} bind def
+
+/set_font {
+	findfont exch
+	scalefont setfont
+} def
+
+% draw aligned label in bounding box aligned to current point
+/alignedtext {			% width adj text
+	/text exch def
+	/adj exch def
+	/width exch def
+	gsave
+		width 0 gt {
+			text stringwidth pop adj mul 0 rmoveto
+		} if
+		[] 0 setdash
+		text show
+	grestore
+} def
+
+/boxprim {				% xcorner ycorner xsize ysize
+		4 2 roll
+		moveto
+		2 copy
+		exch 0 rlineto
+		0 exch rlineto
+		pop neg 0 rlineto
+		closepath
+} bind def
+
+/ellipse_path {
+	/ry exch def
+	/rx exch def
+	/y exch def
+	/x exch def
+	matrix currentmatrix
+	newpath
+	x y translate
+	rx ry scale
+	0 0 1 0 360 arc
+	setmatrix
+} bind def
+
+/endpage { showpage } bind def
+/showpage { } def
+
+/layercolorseq
+	[	% layer color sequence - darkest to lightest
+		[0 0 0]
+		[.2 .8 .8]
+		[.4 .8 .8]
+		[.6 .8 .8]
+		[.8 .8 .8]
+	]
+def
+
+/layerlen layercolorseq length def
+
+/setlayer {/maxlayer exch def /curlayer exch def
+	layercolorseq curlayer 1 sub layerlen mod get
+	aload pop sethsbcolor
+	/nodecolor {nopcolor} def
+	/edgecolor {nopcolor} def
+	/graphcolor {nopcolor} def
+} bind def
+
+/onlayer { curlayer ne {invis} if } def
+
+/onlayers {
+	/myupper exch def
+	/mylower exch def
+	curlayer mylower lt
+	curlayer myupper gt
+	or
+	{invis} if
+} def
+
+/curlayer 0 def
+
+%%EndResource
+%%EndProlog
+%%BeginSetup
+14 default-font-family set_font
+1 setmiterlimit
+% /arrowlength 10 def
+% /arrowwidth 5 def
+
+% make sure pdfmark is harmless for PS-interpreters other than Distiller
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+% make '<<' and '>>' safe on PS Level 1 devices
+/languagelevel where {pop languagelevel}{1} ifelse
+2 lt {
+    userdict (<<) cvn ([) cvn load put
+    userdict (>>) cvn ([) cvn load put
+} if
+
+%%EndSetup
+%%Page: 1 1
+%%PageBoundingBox: 36 36 577 207
+%%PageOrientation: Portrait
+gsave
+35 35 542 172 boxprim clip newpath
+36 36 translate
+0 0 1 beginpage
+0.6750 set_scale
+0 0 translate 0 rotate
+0.000 0.000 0.000 graphcolor
+14.00 /Times-Roman set_font
+
+%	States
+gsave 10 dict begin
+30 18 30 18 ellipse_path
+stroke
+gsave 10 dict begin
+13 13 moveto
+(States)
+[7.44 4.08 6.24 3.84 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Library
+gsave 10 dict begin
+132 18 34 18 ellipse_path
+stroke
+gsave 10 dict begin
+110 13 moveto
+(Library)
+[8.4 3.84 6.96 4.56 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	States -> Library
+newpath 60 18 moveto
+69 18 78 18 87 18 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 87 22 moveto
+97 18 lineto
+87 15 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 87 22 moveto
+97 18 lineto
+87 15 lineto
+closepath
+stroke
+end grestore
+
+%	Declaremods
+gsave 10 dict begin
+274 18 50 18 ellipse_path
+stroke
+gsave 10 dict begin
+236 13 moveto
+(Declaremods)
+[10.08 6.24 6.24 3.84 6.24 4.56 6.24 10.8 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Library -> Declaremods
+newpath 167 18 moveto
+181 18 197 18 213 18 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 213 22 moveto
+223 18 lineto
+213 15 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 213 22 moveto
+223 18 lineto
+213 15 lineto
+closepath
+stroke
+end grestore
+
+%	Nametab
+gsave 10 dict begin
+523 134 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+497 129 moveto
+(Nametab)
+[9.6 6.24 10.8 6 4.08 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	Libnames
+gsave 10 dict begin
+642 134 41 18 ellipse_path
+stroke
+gsave 10 dict begin
+613 129 moveto
+(Libnames)
+[8.4 3.84 6.96 6.96 6.24 10.8 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Nametab -> Libnames
+newpath 562 134 moveto
+571 134 580 134 590 134 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 590 138 moveto
+600 134 lineto
+590 131 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 590 138 moveto
+600 134 lineto
+590 131 lineto
+closepath
+stroke
+end grestore
+
+%	Summary
+gsave 10 dict begin
+642 65 40 18 ellipse_path
+stroke
+gsave 10 dict begin
+614 60 moveto
+(Summary)
+[7.68 6.96 10.8 10.8 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	Nametab -> Summary
+newpath 547 120 moveto
+565 110 589 96 608 84 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 610 87 moveto
+617 79 lineto
+607 81 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 610 87 moveto
+617 79 lineto
+607 81 lineto
+closepath
+stroke
+end grestore
+
+%	Nameops
+gsave 10 dict begin
+760 134 40 18 ellipse_path
+stroke
+gsave 10 dict begin
+733 129 moveto
+(Nameops)
+[9.6 6.24 10.8 6.24 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Libnames -> Nameops
+newpath 684 134 moveto
+693 134 701 134 710 134 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 710 138 moveto
+720 134 lineto
+710 131 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 710 138 moveto
+720 134 lineto
+710 131 lineto
+closepath
+stroke
+end grestore
+
+%	Lib
+gsave 10 dict begin
+413 153 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+402 148 moveto
+(Lib)
+[8.4 3.84 6.96]
+xshow
+end grestore
+end grestore
+
+%	Declaremods -> Lib
+newpath 315 29 moveto
+325 33 336 38 344 45 curveto
+359 58 383 99 399 127 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 396 129 moveto
+404 136 lineto
+402 126 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 396 129 moveto
+404 136 lineto
+402 126 lineto
+closepath
+stroke
+end grestore
+
+%	Global
+gsave 10 dict begin
+413 65 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+393 60 moveto
+(Global)
+[10.08 3.84 6.96 6.96 6.24 3.84]
+xshow
+end grestore
+end grestore
+
+%	Declaremods -> Global
+newpath 311 30 moveto
+331 37 355 45 375 52 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 374 55 moveto
+385 55 lineto
+376 49 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 374 55 moveto
+385 55 lineto
+376 49 lineto
+closepath
+stroke
+end grestore
+
+%	Libobject
+gsave 10 dict begin
+523 188 40 18 ellipse_path
+stroke
+gsave 10 dict begin
+495 183 moveto
+(Libobject)
+[8.4 3.84 6.96 6.96 6.96 3.84 6.24 6.24 3.84]
+xshow
+end grestore
+end grestore
+
+%	Libobject -> Libnames
+newpath 552 175 moveto
+567 168 587 159 604 151 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 605 154 moveto
+613 147 lineto
+602 148 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 605 154 moveto
+613 147 lineto
+602 148 lineto
+closepath
+stroke
+end grestore
+
+%	Lib -> Nametab
+newpath 439 148 moveto
+450 146 464 144 476 142 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 477 145 moveto
+486 140 lineto
+476 139 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 477 145 moveto
+486 140 lineto
+476 139 lineto
+closepath
+stroke
+end grestore
+
+%	Lib -> Libobject
+newpath 437 161 moveto
+450 165 466 170 480 174 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 479 177 moveto
+490 177 lineto
+481 171 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 479 177 moveto
+490 177 lineto
+481 171 lineto
+closepath
+stroke
+end grestore
+
+%	Impargs
+gsave 10 dict begin
+274 126 36 18 ellipse_path
+stroke
+gsave 10 dict begin
+251 121 moveto
+(Impargs)
+[4.56 10.56 6.96 6.24 4.32 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Impargs -> Lib
+newpath 308 133 moveto
+329 137 355 142 377 146 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 377 149 moveto
+387 148 lineto
+378 143 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 377 149 moveto
+387 148 lineto
+378 143 lineto
+closepath
+stroke
+end grestore
+
+%	Impargs -> Global
+newpath 304 116 moveto
+316 111 331 105 344 99 curveto
+357 94 369 88 381 82 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 382 85 moveto
+390 78 lineto
+379 79 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 382 85 moveto
+390 78 lineto
+379 79 lineto
+closepath
+stroke
+end grestore
+
+%	Global -> Libnames
+newpath 443 73 moveto
+473 81 522 94 564 107 curveto
+576 111 589 115 600 119 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 599 122 moveto
+610 122 lineto
+601 116 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 599 122 moveto
+610 122 lineto
+601 116 lineto
+closepath
+stroke
+end grestore
+
+%	Global -> Summary
+newpath 446 65 moveto
+484 65 547 65 591 65 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 591 69 moveto
+601 65 lineto
+591 62 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 591 69 moveto
+601 65 lineto
+591 62 lineto
+closepath
+stroke
+end grestore
+
+%	Goptions
+gsave 10 dict begin
+274 180 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+248 175 moveto
+(Goptions)
+[10.08 6.96 6.96 3.84 3.84 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Goptions -> Lib
+newpath 310 173 moveto
+331 169 356 164 377 160 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 378 163 moveto
+387 158 lineto
+377 157 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 378 163 moveto
+387 158 lineto
+377 157 lineto
+closepath
+stroke
+end grestore
+
+%	Dischargedhypsmap
+gsave 10 dict begin
+274 234 70 18 ellipse_path
+stroke
+gsave 10 dict begin
+217 229 moveto
+(Dischargedhypsmap)
+[10.08 3.84 5.52 6 6.96 6.24 4.32 6.72 6.24 6.96 6.48 6.96 6.96 5.52 10.8 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	Dischargedhypsmap -> Lib
+newpath 317 220 moveto
+326 216 336 212 344 207 curveto
+360 197 376 185 389 175 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 392 177 moveto
+397 168 lineto
+387 172 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 392 177 moveto
+397 168 lineto
+387 172 lineto
+closepath
+stroke
+end grestore
+
+%	Declare
+gsave 10 dict begin
+132 126 35 18 ellipse_path
+stroke
+gsave 10 dict begin
+109 121 moveto
+(Declare)
+[10.08 6.24 6.24 3.84 6.24 4.56 6.24]
+xshow
+end grestore
+end grestore
+
+%	Declare -> Impargs
+newpath 168 126 moveto
+186 126 208 126 228 126 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 228 130 moveto
+238 126 lineto
+228 123 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 228 130 moveto
+238 126 lineto
+228 123 lineto
+closepath
+stroke
+end grestore
+
+%	Declare -> Dischargedhypsmap
+newpath 144 143 moveto
+157 161 179 189 204 207 curveto
+209 210 215 213 221 216 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 219 219 moveto
+230 220 lineto
+222 213 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 219 219 moveto
+230 220 lineto
+222 213 lineto
+closepath
+stroke
+end grestore
+
+%	Decl_kinds
+gsave 10 dict begin
+274 72 45 18 ellipse_path
+stroke
+gsave 10 dict begin
+241 67 moveto
+(Decl_kinds)
+[10.08 6.24 6.24 3.84 6.96 6.96 3.84 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Declare -> Decl_kinds
+newpath 161 115 moveto
+181 107 209 97 232 88 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 233 91 moveto
+241 84 lineto
+230 85 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 233 91 moveto
+241 84 lineto
+230 85 lineto
+closepath
+stroke
+end grestore
+endpage
+showpage
+grestore
+%%PageTrailer
+%%EndPage: 1
+%%Trailer
+%%Pages: 1
+end
+restore
+%%EOF
diff --git a/dev/doc/macros.tex b/dev/doc/macros.tex
new file mode 100644
index 00000000..6beacf7b
--- /dev/null
+++ b/dev/doc/macros.tex
@@ -0,0 +1,7 @@
+
+% macros for coq.tex
+
+\newcommand{\Coq}{\textsf{Coq}}
+\newcommand{\CCI}{Calculus of Inductive Constructions}
+
+\newcommand{\refsec}[1]{\textbf{\ref{#1}}}
\ No newline at end of file
diff --git a/dev/doc/memo-v8.tex b/dev/doc/memo-v8.tex
new file mode 100644
index 00000000..8d116de2
--- /dev/null
+++ b/dev/doc/memo-v8.tex
@@ -0,0 +1,286 @@
+
+\documentclass{article}
+
+\usepackage{verbatim}
+\usepackage{amsmath}
+\usepackage{amssymb}
+\usepackage{array}
+\usepackage{fullpage}
+
+\author{B.~Barras}
+\title{An introduction to syntax of Coq V8}
+
+%% Le _ est un caractère normal
+\catcode`\_=13
+\let\subscr=_
+\def_{\ifmmode\sb\else\subscr\fi}
+
+\def\NT#1{\langle\textit{#1}\rangle}
+\def\NTL#1#2{\langle\textit{#1}\rangle_{#2}}
+\def\TERM#1{\textsf{\bf #1}}
+
+\newenvironment{transbox}
+  {\begin{center}\tt\begin{tabular}{l|ll} \hfil\textrm{V7} & \hfil\textrm{V8} \\ \hline}
+  {\end{tabular}\end{center}}
+\def\TRANS#1#2
+  {\begin{tabular}[t]{@{}l@{}}#1\end{tabular} & 
+   \begin{tabular}[t]{@{}l@{}}#2\end{tabular} \\}
+\def\TRANSCOM#1#2#3
+  {\begin{tabular}[t]{@{}l@{}}#1\end{tabular} & 
+   \begin{tabular}[t]{@{}l@{}}#2\end{tabular} & #3 \\}
+
+\begin{document}
+
+\maketitle
+
+The goal of this document is to introduce by example to the new syntax of
+Coq. It is strongly recommended to read first the definition of the new
+syntax, but this document should also be useful for the eager user who wants
+to start with the new syntax quickly.
+
+
+\section{Changes in lexical conventions w.r.t. V7}
+
+\subsection{Identifiers}
+
+The lexical conventions changed: \TERM{_} is not a regular identifier
+anymore. It is used in terms as a placeholder for subterms to be inferred
+at type-checking, and in patterns as a non-binding variable.
+
+Furthermore, only letters (unicode letters), digits, single quotes and
+_ are allowed after the first character.
+
+\subsection{Quoted string}
+
+Quoted strings are used typically to give a filename (which may not
+be a regular identifier). As before they are written between double
+quotes ("). Unlike for V7, there is no escape character: characters
+are written normaly but the double quote which is doubled.
+
+\section{Main changes in terms w.r.t. V7}
+
+
+\subsection{Precedence of application}
+
+In the new syntax, parentheses are not really part of the syntax of
+application. The precedence of application (10) is tighter than all
+prefix and infix notations. It makes it possible to remove parentheses
+in many contexts.
+
+\begin{transbox}
+\TRANS{(A x)->(f x)=(g y)}{A x -> f x = g y}
+\TRANS{(f [x]x)}{f (fun x => x)}
+\end{transbox}
+
+
+\subsection{Arithmetics and scopes}
+
+The specialized notation for \TERM{Z} and \TERM{R} (introduced by
+symbols \TERM{`} and \TERM{``}) have disappeared. They have been
+replaced by the general notion of scope.
+
+\begin{center}
+\begin{tabular}{l|l|l}
+type & scope name & delimiter \\
+\hline
+types & type_scope & \TERM{T} \\
+\TERM{bool} & bool_scope & \\
+\TERM{nat} & nat_scope & \TERM{nat} \\
+\TERM{Z} & Z_scope & \TERM{Z} \\
+\TERM{R} & R_scope & \TERM{R} \\
+\TERM{positive} & positive_scope & \TERM{P}
+\end{tabular}
+\end{center}
+
+In order to use notations of arithmetics on \TERM{Z}, its scope must be opened with command \verb+Open Scope Z_scope.+ Another possibility is using the scope change notation (\TERM{\%}). The latter notation is to be used when notations of several scopes appear in the same expression.
+
+In examples below, scope changes are not needed if the appropriate scope
+has been opened. Scope nat_scope is opened in the initial state of Coq.
+\begin{transbox}
+\TRANSCOM{`0+x=x+0`}{0+x=x+0}{\textrm{Z_scope}}
+\TRANSCOM{``0 + [if b then ``1`` else ``2``]``}{0 + if b then 1 else 2}{\textrm{R_scope}}
+\TRANSCOM{(0)}{0}{\textrm{nat_scope}}
+\end{transbox}
+
+Below is a table that tells which notation is available in which
+scope. The relative precedences and associativity of operators is the
+same as in usual mathematics. See the reference manual for more
+details. However, it is important to remember that unlike V7, the type
+operators for product and sum are left associative, in order not to
+clash with arithmetic operators.
+
+\begin{center}
+\begin{tabular}{l|l}
+scope & notations \\
+\hline
+nat_scope & $+ ~- ~* ~< ~\leq ~> ~\geq$ \\
+Z_scope & $+ ~- ~* ~/ ~\TERM{mod} ~< ~\leq ~> ~\geq ~?=$ \\
+R_scope & $+ ~- ~* ~/ ~< ~\leq ~> ~\geq$ \\
+type_scope & $* ~+$ \\
+bool_scope & $\TERM{\&\&} ~\TERM{$||$} ~\TERM{-}$ \\
+list_scope & $\TERM{::} ~\TERM{++}$
+\end{tabular}
+\end{center}
+(Note: $\leq$ is written \TERM{$<=$})
+
+
+
+\subsection{Notation for implicit arguments}
+
+The explicitation of arguments is closer to the \emph{bindings} notation in
+tactics. Argument positions follow the argument names of the head constant.
+
+\begin{transbox}
+\TRANS{f 1!t1 2!t2}{f (x:=t1) (y:=t2)}
+\TRANS{!f t1 t2}{@f t1 t2}
+\end{transbox}
+
+
+\subsection{Universal quantification}
+
+The universal quantification and dependent product types are now
+materialized with the \TERM{forall} keyword before the binders and a
+comma after the binders.
+
+The syntax of binders also changed significantly. A binder can simply be
+a name when its type can be inferred. In other cases, the name and the type
+of the variable are put between parentheses. When several consecutive
+variables have the same type, they can be grouped. Finally, if all variables
+have the same type parentheses can be omitted.
+
+\begin{transbox}
+\TRANS{(x:A)B}{forall (x:~A), B ~~\textrm{or}~~ forall x:~A, B}
+\TRANS{(x,y:nat)P}{forall (x y :~nat), P ~~\textrm{or}~~ forall x y :~nat, P}
+\TRANS{(x,y:nat;z:A)P}{forall (x y :~nat) (z:A), P}
+\TRANS{(x,y,z,t:?)P}{forall x y z t, P}
+\TRANS{(x,y:nat;z:?)P}{forall (x y :~nat) z, P}
+\end{transbox}
+
+\subsection{Abstraction}
+
+The notation for $\lambda$-abstraction follows that of universal
+quantification. The binders are surrounded by keyword \TERM{fun}
+and $\Rightarrow$ (\verb+=>+ in ascii).
+
+\begin{transbox}
+\TRANS{[x,y:nat; z](f a b c)}{fun (x y:nat) z => f a b c}
+\end{transbox}
+
+
+\subsection{Pattern-matching}
+
+Beside the usage of the keyword pair \TERM{match}/\TERM{with} instead of
+\TERM{Cases}/\TERM{of}, the main change is the notation for the type of
+branches and return type. It is no longer written between \TERM{$<$ $>$} before
+the \TERM{Cases} keyword, but interleaved with the destructured objects.
+
+The idea is that for each destructured object, one may specify a variable
+name to tell how the branches types depend on this destructured objects (case
+of a dependent elimination), and also how they depend on the value of the
+arguments of the inductive type of the destructured objects. The type of
+branches is then given after the keyword \TERM{return}, unless it can be
+inferred.
+
+Moreover, when the destructured object is a variable, one may use this
+variable in the return type.
+
+\begin{transbox}
+\TRANS{Cases n of\\~~ O => O \\| (S k) => (1) end}{match n with\\~~ 0 => 0 \\| (S k) => 1 end}
+\TRANS{Cases m n of \\~~0 0 => t \\| ... end}{match m, n with \\~~0, 0 => t \\| .. end}
+\TRANS{<[n:nat](P n)>Cases T of ... end}{match T as n return P n with ... end}
+\TRANS{<[n:nat][p:(even n)]\~{}(odd n)>Cases p of\\~~ ... \\end}{match p in even n return \~{} odd n with\\~~ ...\\end}
+\end{transbox}
+
+
+\subsection{Fixpoints and cofixpoints}
+
+An easier syntax for non-mutual fixpoints is provided, making it very close
+to the usual notation for non-recursive functions. The decreasing argument
+is now indicated by an annotation between curly braces, regardless of the
+binders grouping. The annotation can be omitted if the binders introduce only
+one variable. The type of the result can be omitted if inferable.
+
+\begin{transbox}
+\TRANS{Fix plus\{plus [n:nat] : nat -> nat :=\\~~ [m]...\}}{fix plus (n m:nat) \{struct n\}: nat := ...}
+\TRANS{Fix fact\{fact [n:nat]: nat :=\\
+~~Cases n of\\~~~~ O => (1) \\~~| (S k) => (mult n (fact k)) end\}}{fix fact
+  (n:nat) :=\\
+~~match n with \\~~~~0 => 1 \\~~| (S k) => n * fact k end}
+\end{transbox}
+
+There is a syntactic sugar for mutual fixpoints associated to a local
+definition:
+
+\begin{transbox}
+\TRANS{let f := Fix f \{f [x:A] : T := M\} in\\(g (f y))}{let fix f (x:A) : T := M in\\g (f x)}
+\end{transbox}
+
+The same applies to cofixpoints, annotations are not allowed in that case.
+
+\subsection{Notation for type cast}
+
+\begin{transbox}
+\TRANS{O :: nat}{0 : nat}
+\end{transbox}
+
+\section{Main changes in tactics w.r.t. V7}
+
+The main change is that all tactic names are lowercase. This also holds for
+Ltac keywords.
+
+\subsection{Ltac}
+
+Definitions of macros are introduced by \TERM{Ltac} instead of
+\TERM{Tactic Definition}, \TERM{Meta Definition} or \TERM{Recursive
+Definition}.
+
+Rules of a match command are not between square brackets anymore.
+
+Context (understand a term with a placeholder) instantiation \TERM{inst}
+became \TERM{context}. Syntax is unified with subterm matching.
+
+\begin{transbox}
+\TRANS{match t with [C[x=y]] => inst C[y=x]}{match t with context C[x=y] => context C[y=x]}
+\end{transbox}
+
+\subsection{Named arguments of theorems}
+
+\begin{transbox}
+\TRANS{Apply thm with x:=t 1:=u}{apply thm with (x:=t) (1:=u)}
+\end{transbox}
+
+
+\subsection{Occurrences}
+
+To avoid ambiguity between a numeric literal and the optionnal
+occurence numbers of this term, the occurence numbers are put after
+the term itself. This applies to tactic \TERM{pattern} and also
+\TERM{unfold}
+\begin{transbox}
+\TRANS{Pattern 1 2 (f x) 3 4 d y z}{pattern (f x at 1 2) (d at 3 4) y z}
+\end{transbox}
+
+\section{Main changes in vernacular commands w.r.t. V7}
+
+
+\subsection{Binders}
+
+The binders of vernacular commands changed in the same way as those of
+fixpoints. This also holds for parameters of inductive definitions.
+
+
+\begin{transbox}
+\TRANS{Definition x [a:A] : T := M}{Definition x (a:A) : T := M}
+\TRANS{Inductive and [A,B:Prop]: Prop := \\~~conj : A->B->(and A B)}%
+      {Inductive and (A B:Prop): Prop := \\~~conj : A -> B -> and A B}
+\end{transbox}
+
+\subsection{Hints}
+
+The syntax of \emph{extern} hints changed: the pattern and the tactic
+to be applied are separated by a \TERM{$\Rightarrow$}.
+\begin{transbox}
+\TRANS{Hint Extern 4 (toto ?) Apply lemma}{Hint Extern 4 (toto _) => apply lemma}
+\end{transbox}
+
+\end{document}
diff --git a/dev/doc/minicoq.tex b/dev/doc/minicoq.tex
new file mode 100644
index 00000000..a34b03a4
--- /dev/null
+++ b/dev/doc/minicoq.tex
@@ -0,0 +1,98 @@
+\documentclass{article}
+
+\usepackage{fullpage}
+\input{./macros.tex}
+\newcommand{\minicoq}{\textsf{minicoq}}
+\newcommand{\nonterm}[1]{\textit{#1}}
+\newcommand{\terminal}[1]{\textsf{#1}}
+\newcommand{\listzero}{\textit{LIST$_0$}}
+\newcommand{\listun}{\textit{LIST$_1$}}
+\newcommand{\sep}{\textit{SEP}}
+
+\title{Minicoq: a type-checker for the pure \\ 
+       Calculus of Inductive Constructions}
+
+
+\begin{document}
+
+\maketitle
+
+\section{Introduction}
+
+\minicoq\ is a minimal toplevel for the \Coq\ kernel.
+
+
+\section{Grammar of terms}
+
+The grammar of \minicoq's terms is given in Figure~\ref{fig:terms}. 
+
+\begin{figure}[htbp]
+  \hrulefill
+  \begin{center}
+    \begin{tabular}{lrl}
+      term & ::= & identifier \\
+           & $|$ & \terminal{Rel} integer \\
+           & $|$ & \terminal{Set} \\
+           & $|$ & \terminal{Prop} \\
+           & $|$ & \terminal{Type} \\
+           & $|$ & \terminal{Const} identifier \\
+           & $|$ & \terminal{Ind} identifier integer \\
+           & $|$ & \terminal{Construct} identifier integer integer \\
+           & $|$ & \terminal{[} name \terminal{:} term
+                   \terminal{]} term \\
+           & $|$ & \terminal{(} name \terminal{:} term
+                   \terminal{)} term \\
+           & $|$ & term \verb!->! term \\
+           & $|$ & \terminal{(} \listun\ term \terminal{)} \\
+           & $|$ & \terminal{(} term \terminal{::} term \terminal{)} \\
+           & $|$ & \verb!<! term \verb!>! \terminal{Case}
+                   term \terminal{of} \listzero\ term \terminal{end} 
+      \\[1em]
+      name & ::= & \verb!_! \\
+           & $|$ & identifier 
+   \end{tabular}
+  \end{center}
+  \hrulefill
+  \caption{Grammar of terms}
+  \label{fig:terms}
+\end{figure}
+
+\section{Commands}
+The grammar of \minicoq's commands are given in
+Figure~\ref{fig:commands}. All commands end with a dot.
+
+\begin{figure}[htbp]
+  \hrulefill
+  \begin{center}
+    \begin{tabular}{lrl}
+      command & ::= & \terminal{Definition} identifier \terminal{:=} term. \\
+              & $|$ & \terminal{Definition} identifier \terminal{:} term
+                      \terminal{:=} term. \\
+              & $|$ & \terminal{Parameter} identifier \terminal{:} term. \\
+              & $|$ & \terminal{Variable} identifier \terminal{:} term. \\
+              & $|$ & \terminal{Inductive} \terminal{[} \listzero\ param 
+                      \terminal{]} \listun\ inductive \sep\ 
+                      \terminal{with}. \\
+              & $|$ & \terminal{Check} term. 
+      \\[1em]
+      param   & ::= & identifier 
+      \\[1em]
+      inductive & ::= & identifier \terminal{:} term \terminal{:=}
+                        \listzero\ constructor \sep\ \terminal{$|$}
+      \\[1em]
+      constructor & ::= & identifier \terminal{:} term
+    \end{tabular}
+  \end{center}
+  \hrulefill
+  \caption{Commands}
+  \label{fig:commands}
+\end{figure}
+
+
+\end{document}
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: t
+%%% End: 
diff --git a/dev/doc/newsyntax.tex b/dev/doc/newsyntax.tex
new file mode 100644
index 00000000..96e61292
--- /dev/null
+++ b/dev/doc/newsyntax.tex
@@ -0,0 +1,725 @@
+
+%% -*-french-tex-*-
+
+\documentclass{article}
+
+\usepackage{verbatim}
+\usepackage[T1]{fontenc}
+\usepackage[latin1]{inputenc}
+\usepackage[french]{babel}
+\usepackage{amsmath}
+\usepackage{amssymb}
+\usepackage{array}
+
+
+\author{B.~Barras}
+\title{Proposition de syntaxe pour Coq}
+
+%% Le _ est un caractère normal
+\catcode`\_=13
+\let\subscr=_
+\def_{\ifmmode\sb\else\subscr\fi}
+
+%% Macros pour les grammaires
+\def\NT#1{\langle\textit{#1}\rangle}
+\def\TERM#1{\textsf{#1}}
+\def\STAR#1{#1\!*}
+\def\PLUS#1{#1\!+}
+
+%% Tableaux de definition de non-terminaux
+\newenvironment{cadre}
+        {\begin{array}{|c|}\hline\\}
+        {\\\\\hline\end{array}}
+\newenvironment{rulebox}
+        {$$\begin{cadre}\begin{array}{r@{~}c@{~}l@{}r}}
+        {\end{array}\end{cadre}$$}
+\def\DEFNT#1{\NT{#1} & ::= &}
+\def\EXTNT#1{\NT{#1} & ::= & ... \\&|&}
+\def\RNAME#1{(\textsc{#1})}
+\def\SEPDEF{\\\\}
+\def\nlsep{\\&|&}
+
+
+\begin{document}
+
+\maketitle
+
+\section{Grammaire des tactiques}
+\label{tacticsyntax}
+
+La réflexion de la rénovation de la syntaxe des tactiques n'est pas
+encore aussi poussée que pour les termes (section~\ref{constrsyntax}),
+mais cette section vise à énoncer les quelques principes que l'on
+souhaite suivre. 
+
+\begin{itemize}
+\item Réutiliser les mots-clés de la syntaxe des termes (i.e. en
+  minuscules) pour les constructions similaires de tactiques (let_in,
+  match, and, etc.). Le connecteur logique \texttt{and} n'étant que
+  rarement utilisé autrement que sous la forme \texttt{$\wedge$} (sauf
+  dans le code ML), on pourrait dégager ce mot-clé.
+\item Les arguments passés aux tactiques sont principalement des
+  termes, on préconise l'utilisation d'un symbole spécial (par exemple
+  l'apostrophe) pour passer une tactique ou une expression
+  (AST). L'idée étant que l'on écrit plus souvent des tactiques
+  prenant des termes en argument que des tacticals.
+\end{itemize}
+
+\begin{figure}
+\begin{rulebox}
+\DEFNT{tactic}
+       \NT{tactic} ~\TERM{\&} ~\NT{tactic}            & \RNAME{then}
+\nlsep \TERM{[} ~\NT{tactic}~\TERM{|}~...
+      ~\TERM{|}~\NT{tactic}~\TERM{]}                  & \RNAME{par}
+\nlsep \NT{ident} ~\STAR{\NT{tactic-arg}}   ~~~       & \RNAME{apply}
+\nlsep \TERM{fun} ~....                               & \RNAME{function}
+\nlsep \NT{simple-tactic}
+\SEPDEF
+\DEFNT{tactic-arg}
+       \NT{constr}
+\nlsep \TERM{'} ~\NT{tactic}
+\SEPDEF
+\DEFNT{simple-tactic}
+       \TERM{Apply} ~\NT{binding-term}
+\nlsep \NT{elim-kw} ~\NT{binding-term}
+\nlsep \NT{elim-kw} ~\NT{binding-term} ~\TERM{using} ~\NT{binding-term}
+\nlsep \TERM{Intros} ~\NT{intro-pattern}
+\SEPDEF
+\DEFNT{elim-kw}
+       \TERM{Elim} ~\mid~ \TERM{Case} ~\mid~ \TERM{Induction}
+       ~\mid~ \TERM{Destruct}
+\end{rulebox}
+\caption{Grammaire des tactiques}
+\label{tactic}
+\end{figure}
+
+
+\subsection{Arguments de tactiques}
+
+La syntaxe actuelle des arguments de tactiques est que l'on parse par
+défaut une expression de tactique, ou bien l'on parse un terme si
+celui-ci est préfixé par \TERM{'} (sauf dans le cas des
+variables). Cela est gênant pour les utilisateurs qui doivent écrire
+des \TERM{'} pour leurs tactiques.
+
+À mon avis, il n'est pas souhaitable pour l'utilisateur de l'obliger à
+marquer une différence entre les tactiques ``primitives'' (en fait
+``système'') et les tactiques définies par Ltac. En effet, on se
+dirige inévitablement vers une situation où il existera des librairies
+de tactiques et il va devenir difficile de savoir facilement s'il faut
+ou non mettre des \TERM{'}.
+
+
+
+\subsection{Bindings}
+
+Dans un premier temps, les ``bindings'' sont toujours considérés comme
+une construction du langage des tactiques, mais il est intéressant de
+prévoir l'extension de ce procédé aux termes, puisqu'il s'agit
+simplement de construire un n{\oe}ud d'application dans lequel on
+donne les arguments par nom ou par position, les autres restant à
+inférer. Le principal point est de trouver comment combiner de manière
+uniforme ce procédé avec les arguments implicites.
+
+Il est toutefois important de réfléchir dès maintenant à une syntaxe
+pour éviter de rechanger encore la syntaxe.
+
+Intégrer la notation \TERM{with} aux termes peut poser des problèmes
+puisque ce mot-clé est utilisé pour le filtrage: comment parser (en
+LL(1)) l'expression:
+\begin{verbatim}
+Cases x with y ...
+\end{verbatim}
+
+Soit on trouve un autre mot-clé, soit on joue avec les niveaus de
+priorité en obligeant a parenthéser le \TERM{with} des ``bindings'':
+\begin{verbatim}
+Cases (x with y) with (C z) => ...
+\end{verbatim}
+ce qui introduit un constructeur moralement équivalent à une
+application situé à une priorité totalement différente (les
+``bindings'' seraient au plus haut niveau alors que l'application est
+à un niveau bas).
+
+
+\begin{figure}
+\begin{rulebox}
+\DEFNT{binding-term}
+       \NT{constr} ~\TERM{with} ~\STAR{\NT{binding}}
+\SEPDEF
+\DEFNT{binding}
+       \NT{constr}
+\end{rulebox}
+\caption{Grammaire des bindings}
+\label{bindings}
+\end{figure}
+
+\subsection{Enregistrements}
+
+Il faudrait aménager la syntaxe des enregistrements dans l'optique
+d'avoir des enregistrements anonymes (termes de première classe), même
+si pour l'instant, on ne dispose que d'enregistrements définis a
+toplevel.
+
+Exemple de syntaxe pour les types d'enregistrements:
+\begin{verbatim}
+{ x1 : A1;
+  x2 : A2(x1);
+  _ : T;   (* Pas de projection disponible *)
+  y;       (* Type infere *)
+  ...      (* ; optionnel pour le dernier champ *)
+}
+\end{verbatim}
+
+Exemple de syntaxe pour le constructeur:
+\begin{verbatim}
+{ x1 = O;
+  x2 : A2(x1) = v1;
+  _ = v2;
+  ...
+}
+\end{verbatim}
+Quant aux dépendences, une convention pourrait être de considérer les
+champs non annotés par le type comme non dépendants.
+
+Plusieurs interrogations:
+\begin{itemize}
+\item l'ordre des champs doit-il être respecté ?
+  sinon, que faire pour les champs sans projection ?
+\item autorise-t-on \texttt{v1} a mentionner \texttt{x1} (comme dans
+  la définition d'un module), ce qui se comporterait comme si on avait
+  écrit \texttt{v1} à la place. Cela pourrait être une autre manière
+  de déclarer les dépendences
+\end{itemize}
+
+La notation pointée pour les projections pose un problème de parsing,
+sauf si l'on a une convention lexicale qui discrimine les noms de
+modules des projections et identificateurs: \texttt{x.y.z} peut être
+compris comme \texttt{(x.y).z} ou texttt{x.(y.z)}.
+
+
+\section{Grammaire des termes}
+\label{constrsyntax}
+
+\subsection{Quelques principes}
+
+\begin{enumerate}
+\item Diminuer le nombre de niveaux de priorité en regroupant les
+  règles qui se ressemblent: infixes, préfixes, lieurs (constructions
+  ouvertes à droite), etc.
+\item Éviter de surcharger la signification d'un symbole (ex:
+  \verb+( )+ comme parenthésage et produit dans la V7).
+\item Faire en sorte que les membres gauches (motifs de Cases, lieurs
+  d'abstraction ou de produits) utilisent une syntaxe compatible avec
+  celle des membres droits (branches de Cases et corps de fonction).
+\end{enumerate}
+
+\subsection{Présentation de la grammaire}
+
+\begin{figure}
+\begin{rulebox}
+\DEFNT{paren-constr}
+       \NT{cast-constr}~\TERM{,}~\NT{paren-constr}     &\RNAME{pair}
+\nlsep \NT{cast-constr}
+\SEPDEF
+\DEFNT{cast-constr}
+       \NT{constr}~\TERM{\!\!:}~\NT{cast-constr}       &\RNAME{cast}
+\nlsep \NT{constr}
+\SEPDEF
+\DEFNT{constr}
+       \NT{appl-constr}~\NT{infix}~\NT{constr}      &\RNAME{infix}
+\nlsep \NT{prefix}~\NT{constr}                      &\RNAME{prefix}
+\nlsep \NT{constr}~\NT{postfix}                     &\RNAME{postfix}
+\nlsep \NT{appl-constr}
+\SEPDEF
+\DEFNT{appl-constr}
+       \NT{appl-constr}~\PLUS{\NT{appl-arg}}           &\RNAME{apply}
+\nlsep \TERM{@}~\NT{global}~\PLUS{\NT{simple-constr}}  &\RNAME{expl-apply}
+\nlsep \NT{simple-constr}
+\SEPDEF
+\DEFNT{appl-arg}
+       \TERM{@}~\NT{int}~\TERM{\!:=}~\NT{simple-constr}  &\RNAME{impl-arg}
+\nlsep \NT{simple-constr}
+\SEPDEF
+\DEFNT{simple-constr}
+       \NT{atomic-constr}
+\nlsep \TERM{(}~\NT{paren-constr}~\TERM{)}
+\nlsep \NT{match-constr}
+\nlsep \NT{fix-constr}
+%% \nlsep \TERM{<\!\!:ast\!\!:<}~\NT{ast}~\TERM{>\!>} &\RNAME{quotation}
+\end{rulebox}
+\caption{Grammaire des termes}
+\label{constr}
+\end{figure}
+
+\begin{figure}
+\begin{rulebox}
+\DEFNT{prefix}
+       \TERM{!}~\PLUS{\NT{binder}}~\TERM{.}~    &\RNAME{prod}
+\nlsep \TERM{fun} ~\PLUS{\NT{binder}} ~\TERM{$\Rightarrow$} &\RNAME{lambda}
+\nlsep \TERM{let}~\NT{ident}~\STAR{\NT{binder}} ~\TERM{=}~\NT{constr}
+        ~\TERM{in}  &\RNAME{let}
+%\nlsep \TERM{let (}~\NT{comma-ident-list}~\TERM{) =}~\NT{constr}
+%        ~\TERM{in}   &~~~\RNAME{let-case}
+\nlsep \TERM{if}~\NT{constr}~\TERM{then}~\NT{constr}~\TERM{else}
+      &\RNAME{if-case}
+\nlsep \TERM{eval}~\NT{red-fun}~\TERM{in}       &\RNAME{eval}
+\SEPDEF
+\DEFNT{infix}
+      \TERM{$\rightarrow$}                     & \RNAME{impl}
+\SEPDEF
+\DEFNT{atomic-constr}
+      \TERM{_}
+\nlsep \TERM{?}\NT{int}
+\nlsep \NT{sort}
+\nlsep \NT{global}
+\SEPDEF
+\DEFNT{binder}
+       \NT{ident}                              &\RNAME{infer}
+\nlsep \TERM{(}~\NT{ident}~\NT{type}~\TERM{)}  &\RNAME{binder}
+\SEPDEF
+\DEFNT{type}
+       \TERM{\!:}~\NT{constr}
+\nlsep \epsilon
+\end{rulebox}
+\caption{Grammaires annexes aux termes}
+\label{gram-annexes}
+\end{figure}
+
+La grammaire des termes (correspondant à l'état \texttt{barestate})
+est décrite figures~\ref{constr} et~\ref{gram-annexes}. On constate
+par rapport aux précédentes versions de Coq d'importants changements
+de priorité, le plus marquant étant celui de l'application qui se
+trouve désormais juste au dessus\footnote{La convention est de
+considérer les opérateurs moins lieurs comme ``au dessus'',
+c'est-à-dire ayant un niveau de priorité plus élévé (comme c'est le
+cas avec le niveau de la grammaire actuelle des termes).} des
+constructions fermées à gauche et à droite.
+
+La grammaire des noms globaux est la suivante:
+\begin{eqnarray*}
+\DEFNT{global}
+      \NT{ident}
+%% \nlsep \TERM{\$}\NT{ident}
+\nlsep \NT{ident}\TERM{.}\NT{global}
+\end{eqnarray*}
+
+Le $\TERM{_}$ dénote les termes à synthétiser. Les métavariables sont
+reconnues au niveau du lexer pour ne pas entrer en conflit avec le
+$\TERM{?}$ de l'existentielle.
+
+Les opérateurs infixes ou préfixes sont tous au même niveau de
+priorité du point de vue de Camlp4. La solution envisagée est de les
+gérer à la manière de Yacc, avec une pile (voir discussions plus
+bas). Ainsi, l'implication est un infixe normal; la quantification
+universelle et le let sont vus comme des opérateurs préfixes avec un
+niveau de priorité plus haut (i.e. moins lieur). Il subsiste des
+problèmes si l'on ne veut pas écrire de parenthèses dans:
+\begin{verbatim}
+ A -> (!x. B -> (let y = C in D))
+\end{verbatim}
+
+La solution proposée est d'analyser le membre droit d'un infixe de
+manière à autoriser les préfixes et les infixes de niveau inférieur,
+et d'exiger le parenthésage que pour les infixes de niveau supérieurs.
+
+En revanche, à l'affichage, certains membres droits seront plus
+lisibles s'ils n'utilisent pas cette astuce:
+\begin{verbatim}
+(fun x => x) = fun x => x
+\end{verbatim}
+
+La proposition est d'autoriser ce type d'écritures au parsing, mais
+l'afficheur écrit de manière standardisée en mettant quelques
+parenthèses superflues: $\TERM{=}$ serait symétrique alors que
+$\rightarrow$ appellerait l'afficheur de priorité élevée pour son
+sous-terme droit.
+
+Les priorités des opérateurs primitifs sont les suivantes (le signe
+$*$ signifie que pour le membre droit les opérateurs préfixes seront
+affichés sans parenthèses quel que soit leur priorité):
+$$
+\begin{array}{c|l}
+$symbole$ & $priorité$ \\
+\hline
+\TERM{!}      & 200\,R* \\
+\TERM{fun}    & 200\,R* \\
+\TERM{let}    & 200\,R* \\
+\TERM{if}     & 200\,R \\
+\TERM{eval}   & 200\,R \\
+\rightarrow   & 90\,R*
+\end{array}
+$$
+
+Il y a deux points d'entrée pour les termes: $\NT{constr}$ et
+$\NT{simple-constr}$. Le premier peut être utilisé lorsqu'il est suivi
+d'un séparateur particulier. Dans le cas où l'on veut une liste de
+termes séparés par un espace, il faut lire des $\NT{simple-constr}$.
+
+
+
+Les constructions $\TERM{fix}$ et $\TERM{cofix}$ (voir aussi
+figure~\ref{gram-fix}) sont fermées par end pour simplifier
+l'analyse. Sinon, une expression de point fixe peut être suivie par un
+\TERM{in} ou un \TERM{and}, ce qui pose les mêmes problèmes que le
+``dangling else'': dans
+\begin{verbatim}
+fix f1 x {x} = fix f2 y {y} = ... and ... in ...
+\end{verbatim}
+il faut définir une stratégie pour associer le \TERM{and} et le
+\TERM{in} au bon point fixe.
+
+Un autre avantage est de faire apparaitre que le \TERM{fix} est un
+constructeur de terme de première classe et pas un lieur:
+\begin{verbatim}
+fix f1 ... and f2 ...
+in f1 end x
+\end{verbatim}
+Les propositions précédentes laissaient \texttt{f1} et \texttt{x}
+accolés, ce qui est source de confusion lorsque l'on fait par exemple
+\texttt{Pattern (f1 x)}.
+
+Les corps de points fixes et co-points fixes sont identiques, bien que
+ces derniers n'aient pas d'information de décroissance. Cela
+fonctionne puisque l'annotation est optionnelle. Cela préfigure des
+cas où l'on arrive à inférer quel est l'argument qui décroit
+structurellement (en particulier dans le cas où il n'y a qu'un seul
+argument).
+
+\begin{figure}
+\begin{rulebox}
+\DEFNT{fix-expr}
+       \TERM{fix}~\NT{fix-decls}    ~\NT{fix-select} ~\TERM{end} &\RNAME{fix}
+\nlsep \TERM{cofix}~\NT{cofix-decls}~\NT{fix-select} ~\TERM{end} &\RNAME{cofix}
+\SEPDEF
+\DEFNT{fix-decls}
+       \NT{fix-decl}~\TERM{and}~\NT{fix-decls}
+\nlsep \NT{fix-decl}
+\SEPDEF
+\DEFNT{fix-decl}
+       \NT{ident}~\PLUS{\NT{binder}}~\NT{type}~\NT{annot}
+       ~\TERM{=}~\NT{constr}
+\SEPDEF
+\DEFNT{annot}
+       \TERM{\{}~\NT{ident}~\TERM{\}}
+\nlsep \epsilon
+\SEPDEF
+\DEFNT{fix-select}
+       \TERM{in}~\NT{ident}
+\nlsep \epsilon
+\end{rulebox}
+\caption{Grammaires annexes des points fixes}
+\label{gram-fix}
+\end{figure}
+
+La construction $\TERM{Case}$ peut-être considérée comme
+obsolète. Quant au $\TERM{Match}$ de la V6, il disparaît purement et
+simplement.
+
+\begin{figure}
+\begin{rulebox}
+\DEFNT{match-expr}
+       \TERM{match}~\NT{case-items}~\NT{case-type}~\TERM{with}~
+       \NT{branches}~\TERM{end}        &\RNAME{match}
+\nlsep \TERM{match}~\NT{case-items}~\TERM{with}~
+       \NT{branches}~\TERM{end}        &\RNAME{infer-match}
+%%\nlsep \TERM{case}~\NT{constr}~\NT{case-predicate}~\TERM{of}~
+%%      \STAR{\NT{constr}}~\TERM{end}   &\RNAME{case}
+\SEPDEF
+\DEFNT{case-items}
+       \NT{case-item} ~\TERM{\&} ~\NT{case-items}
+\nlsep \NT{case-item}
+\SEPDEF
+\DEFNT{case-item}
+       \NT{constr}~\NT{pred-pattern} &\RNAME{dep-case}
+\nlsep \NT{constr}                   &\RNAME{nodep-case}
+\SEPDEF
+\DEFNT{case-type}
+       \TERM{$\Rightarrow$}~\NT{constr}
+\nlsep \epsilon
+\SEPDEF
+\DEFNT{pred-pattern}
+       \TERM{as}~\NT{ident} ~\TERM{\!:}~\NT{constr}
+\SEPDEF
+\DEFNT{branches}
+       \TERM{|} ~\NT{patterns} ~\TERM{$\Rightarrow$}
+        ~\NT{constr} ~\NT{branches}
+\nlsep \epsilon
+\SEPDEF
+\DEFNT{patterns}
+       \NT{pattern} ~\TERM{\&} ~\NT{patterns}
+\nlsep \NT{pattern}
+\SEPDEF
+\DEFNT{pattern} ...
+\end{rulebox}
+\caption{Grammaires annexes du filtrage}
+\label{gram-match}
+\end{figure}
+
+De manière globale, l'introduction de définitions dans les termes se
+fait avec le symbole $=$, et le $\!:=$ est réservé aux définitions au
+niveau vernac. Il y avait un manque de cohérence dans la
+V6, puisque l'on utilisait $=$ pour le $\TERM{let}$ et $\!:=$ pour les
+points fixes et les commandes vernac.
+
+% OBSOLETE: lieurs multiples supprimes
+%On peut remarquer que $\NT{binder}$ est un sous-ensemble de
+%$\NT{simple-constr}$, à l'exception de $\texttt{(a,b\!\!:T)}$: en tant
+%que lieur, {\tt a} et {\tt b} sont tous deux contraints, alors qu'en
+%tant que terme, seul {\tt b} l'est. Cela qui signifie que l'objectif
+%de rendre compatibles les membres gauches et droits est {\it presque}
+%atteint.
+
+\subsection{Infixes}
+
+\subsubsection{Infixes extensibles}
+
+Le problème de savoir si la liste des symboles pouvant apparaître en
+infixe est fixée ou extensible par l'utilisateur reste à voir.
+
+Notons que la solution où les symboles infixes sont des
+identificateurs que l'on peut définir paraît difficilement praticable:
+par exemple $\texttt{Logic.eq}$ n'est pas un opérateur binaire, mais
+ternaire. Il semble plus simple de garder des déclarations infixes qui
+relient un symbole infixe à un terme avec deux ``trous''. Par exemple:
+
+$$\begin{array}{c|l}
+$infixe$ &  $identificateur$ \\
+\hline
+= & \texttt{Logic.eq _ ?1 ?2} \\
+== & \texttt{JohnMajor.eq _ ?1 _ ?2}
+\end{array}$$
+
+La syntaxe d'une déclaration d'infixe serait par exemple:
+\begin{verbatim}
+Infix "=" 50 := Logic.eq _ ?1 ?2;
+\end{verbatim}
+
+
+\subsubsection{Gestion des précédences}
+
+Les infixes peuvent être soit laissé à Camlp4, ou bien (comme ici)
+considérer que tous les opérateurs ont la même précédence et gérer
+soit même la recomposition des termes à l'aide d'une pile (comme
+Yacc).
+
+
+\subsection{Extensions de syntaxe}
+
+\subsubsection{Litéraux numériques}
+
+La proposition est de considerer les litéraux numériques comme de
+simples identificateurs. Comme il en existe une infinité, il faut un
+nouveau mécanisme pour leur associer une définition. Par exemple, en
+ce qui concerne \texttt{Arith}, la définition de $5$ serait
+$\texttt{S}~4$. Pour \texttt{ZArith}, $5$ serait $\texttt{xI}~2$.
+
+Comme les infixes, les constantes numériques peuvent être qualifiées
+pour indiquer dans quels module est le type que l'on veut
+référencer. Par exemple (si on renomme \texttt{Arith} en \texttt{N} et
+\texttt{ZArith} en \texttt{Z}): \verb+N.5+, \verb+Z.5+.
+
+\begin{eqnarray*}
+\EXTNT{global}
+      \NT{int}
+\end{eqnarray*}
+
+\subsubsection{Nouveaux lieurs}
+
+$$
+\begin{array}{rclr}
+\EXTNT{constr}
+       \TERM{ex}~\PLUS{\NT{binder}}~\TERM{.}~\NT{constr}  &\RNAME{ex}
+\nlsep \TERM{ex}~\PLUS{\NT{binder}}~\TERM{.}~\NT{constr}~\TERM{,}~\NT{constr}
+        &\RNAME{ex2}
+\nlsep \TERM{ext}~\PLUS{\NT{binder}}~\TERM{.}~\NT{constr}  &\RNAME{exT}
+\nlsep \TERM{ext}~\PLUS{\NT{binder}}~\TERM{.}~\NT{constr}~\TERM{,}~\NT{constr}
+        &\RNAME{exT2}
+\end{array}
+$$
+
+Pour l'instant l'existentielle n'admet qu'une seule variable, ce qui
+oblige à écrire des cascades de $\TERM{ex}$.
+
+Pour parser les existentielles avec deux prédicats, on peut considérer
+\TERM{\&} comme un infixe intermédiaire et l'opérateur existentiel en
+présence de cet infixe se transforme en \texttt{ex2}.
+
+\subsubsection{Nouveaux infixes}
+
+Précédences des opérateurs infixes (les plus grands associent moins fort):
+$$
+\begin{array}{l|l|c|l}
+$identificateur$      & $module$     & $infixe/préfixe$ & $précédence$ \\
+\hline
+\texttt{iff}          & $Logic$      & \longleftrightarrow & 100 \\
+\texttt{or}           & $Logic$      & \vee     & 80\, R \\
+\texttt{sum}          & $Datatypes$  & +        & 80\, R \\
+\texttt{and}          & $Logic$      & \wedge   & 70\, R \\
+\texttt{prod}         & $Datatypes$  & *        & 70\, R \\
+\texttt{not}          & $Logic$      & \tilde{} & 60\, L \\
+\texttt{eq _}         & $Logic$      & =        & 50 \\
+\texttt{eqT _}        & $Logic_Type$ & =        & 50 \\
+\texttt{identityT _}  & $Data_Type$  & =        & 50 \\
+\texttt{le}           & $Peano$      & $<=$     & 50 \\
+\texttt{lt}           & $Peano$      & $<$      & 50 \\
+\texttt{ge}           & $Peano$      & $>=$     & 50 \\
+\texttt{gt}           & $Peano$      & $>$      & 50 \\
+\texttt{Zle}          & $zarith_aux$   & $<=$   & 50 \\
+\texttt{Zlt}          & $zarith_aux$   & $<$    & 50 \\
+\texttt{Zge}          & $zarith_aux$   & $>=$   & 50 \\
+\texttt{Zgt}          & $zarith_aux$   & $>$    & 50 \\
+\texttt{Rle}          & $Rdefinitions$ & $<=$   & 50 \\
+\texttt{Rlt}          & $Rdefinitions$ & $<$    & 50 \\
+\texttt{Rge}          & $Rdefinitions$ & $>=$   & 50 \\
+\texttt{Rgt}          & $Rdefinitions$ & $>$    & 50 \\
+\texttt{plus}         & $Peano$        & +      & 40\,L \\
+\texttt{Zplus}        & $fast_integer$ & +      & 40\,L \\
+\texttt{Rplus}        & $Rdefinitions$ & +      & 40\,L \\
+\texttt{minus}        & $Minus$        & -      & 40\,L \\
+\texttt{Zminus}       & $zarith_aux$   & -      & 40\,L \\
+\texttt{Rminus}       & $Rdefinitions$ & -      & 40\,L \\
+\texttt{Zopp}         & $fast_integer$ & -      & 40\,L \\
+\texttt{Ropp}         & $Rdefinitions$ & -      & 40\,L \\
+\texttt{mult}         & $Peano$        & *      & 30\,L \\
+\texttt{Zmult}        & $fast_integer$ & *      & 30\,L \\
+\texttt{Rmult}        & $Rdefinitions$ & *      & 30\,L \\
+\texttt{Rdiv}         & $Rdefinitions$ & /      & 30\,L \\
+\texttt{pow}          & $Rfunctions$   & \hat   & 20\,L \\
+\texttt{fact}         & $Rfunctions$   & !      & 20\,L \\
+\end{array}
+$$
+
+Notons qu'il faudrait découper {\tt Logic_Type} en deux car celui-ci
+définit deux égalités, ou alors les mettre dans des modules différents.
+
+\subsection{Exemples}
+
+\begin{verbatim}
+Definition not (A:Prop) := A->False;
+Inductive eq (A:Set) (x:A) : A->Prop :=
+    refl_equal : eq A x x;
+Inductive ex (A:Set) (P:A->Prop) : Prop :=
+    ex_intro : !x. P x -> ex A P;
+Lemma not_all_ex_not : !(P:U->Prop). ~(!n. P n) -> ?n. ~ P n;
+Fixpoint plus n m : nat {struct n} :=
+  match n with
+    O     => m
+  | (S k) => S (plus k m)
+  end;
+\end{verbatim}
+
+\subsection{Questions ouvertes}
+
+Voici les points sur lesquels la discussion est particulièrement
+ouverte: 
+\begin{itemize}
+\item choix d'autres symboles pour les quantificateurs \TERM{!} et
+  \TERM{?}. En l'état actuel des discussions, on garderait le \TERM{!}
+  pour la qunatification universelle, mais on choisirait quelquechose
+  comme \TERM{ex} pour l'existentielle, afin de ne pas suggérer trop
+  de symétrie entre ces quantificateurs (l'un est primitif, l'autre
+  pas).
+\item syntaxe particulière pour les \texttt{sig}, \texttt{sumor}, etc.
+\item la possibilité d'introduire plusieurs variables du même type est
+  pour l'instant supprimée au vu des problèmes de compatibilité de
+  syntaxe entre les membres gauches et membres droits. L'idée étant
+  que l'inference de type permet d'éviter le besoin de déclarer tous
+  les types.
+\end{itemize}
+
+\subsection{Autres extensions}
+
+\subsubsection{Lieur multiple}
+
+L'écriture de types en présence de polymorphisme est souvent assez
+pénible:
+\begin{verbatim}
+Check !(A:Set) (x:A) (B:Set) (y:B). P A x B y;
+\end{verbatim}
+
+On pourrait avoir des déclarations introduisant à la fois un type
+d'une certaine sorte et une variable de ce type:
+\begin{verbatim}
+Check !(x:A:Set) (y:B:Set). P A x B y;
+\end{verbatim}
+
+Noter que l'on aurait pu écrire:
+\begin{verbatim}
+Check !A x B y. P A (x:A:Set) B (y:B:Set);
+\end{verbatim}
+
+\section{Syntaxe des tactiques}
+
+\subsection{Questions diverses}
+
+Changer ``Pattern nl c ... nl c'' en ``Pattern [ nl ] c ... [ nl ] c''
+pour permettre des chiffres seuls dans la catégorie syntaxique des
+termes.
+
+Par uniformité remplacer ``Unfold nl c'' par ``Unfold [ nl ] c'' ?
+
+Même problème pour l'entier de Specialize (ou virer Specialize ?) ?
+
+\subsection{Questions en suspens}
+
+\verb=EAuto= : deux syntaxes différentes pour la recherche en largeur
+et en profondeur ? Quelle recherche par défaut ?
+
+\section*{Remarques pêle-mêle (HH)}
+
+Autoriser la syntaxe
+
+\begin{verbatim}
+Variable R (a : A) (b : B) : Prop.
+Hypotheses H (a : A) (b : B) : Prop; Y (u : U) : V.
+Variables H (a : A) (b : B), J (k : K) : nat; Z (v : V) : Set.
+\end{verbatim}
+
+Renommer eqT, refl_eqT, eqT_ind, eqT_rect, eqT_rec en eq, refl_equal, etc.
+Remplacer == en =.
+
+Mettre des \verb=?x= plutot que des \verb=?1= dans les motifs de ltac ??
+
+\section{Moulinette}
+
+\begin{itemize}
+
+\item Mettre \verb=/= et * au même niveau dans R.
+
+\item Changer la précédence du - unaire dans R.
+
+\item Ajouter Require Arith par necessite si Require ArithRing ou Require ZArithRing.
+
+\item Ajouter Require ZArith par necessite si Require ZArithRing ou Require Omega.
+
+\item Enlever le Export de Bool, Arith et ZARith de Ring quand inapproprié et
+l'ajouter à côté des Require Ring.
+
+\item Remplacer "Check n" par "n:Check ..."
+
+\item Renommer Variable/Hypothesis hors section en Parameter/Axiom.
+
+\item Renommer les \verb=command0=, \verb=command1=, ... \verb=lcommand= etc en
+\verb=constr0=, \verb=constr1=, ... \verb=lconstr=.
+
+\item Remplacer les noms Coq.omega.Omega par Coq.Omega ...
+
+\item Remplacer AddPath par Add LoadPath (ou + court)
+
+\item Unify + and \{\}+\{\} and +\{\} using Prop $\leq$ Set ??
+
+\item Remplacer Implicit Arguments On/Off par Set/Unset Implicit Arguments.
+
+\item La syntaxe \verb=Intros (a,b)= est inutile, \verb=Intros [a b]= fait l'affaire.
+
+\item Virer \verb=Goal= sans argument (synonyme de \verb=Proof= et sans effets).
+
+\item Remplacer Save. par Qed.
+
+\item Remplacer \verb=Zmult_Zplus_distr= par \verb=Zmult_plus_distr_r=
+et \verb=Zmult_plus_distr= par \verb=Zmult_plus_distr_l=.
+
+\end{itemize}
+
+\end{document}
diff --git a/dev/doc/parse.ml b/dev/doc/parse.ml
new file mode 100644
index 00000000..e537b1f2
--- /dev/null
+++ b/dev/doc/parse.ml
@@ -0,0 +1,183 @@
+
+open Ast
+
+type assoc = L | R | N
+
+let level = function
+  | "--" -> 70,L
+  | "=" -> 70,N
+  | "+" -> 60,L
+  | "++" -> 60,R
+  | "+++" -> 60,R
+  | "-" -> 60,L
+  | "*" -> 50,L
+  | "/" -> 50,L
+  | "**" -> 40,R
+  | ":" -> (100,R)
+  | "->" -> (90,R)
+  | s -> failwith ("unknowm operator '"^s^"'")
+
+let fixity = function
+  | "--" -> [L]
+  | "=" -> [N]
+  | ("+"|"-"|"*"|"/") -> [L;N]
+  | "++" -> [R]
+  | _ -> [L;N;R]
+
+let ground_oper = function
+    ("-"|"+") -> true
+  | _ -> false
+
+let is_prefix op = List.mem L (fixity op)
+let is_infix op = List.mem N (fixity op)
+let is_postfix op = List.mem R (fixity op)
+
+let mk_inf op t1 t2 =
+  if not (is_infix op) then failwith (op^" not infix");
+  Infix(op,t1,t2)
+
+let mk_post op t =
+  if not (is_postfix op) then failwith (op^" not postfix");
+  Postfix(op,t)
+
+
+(* Pb avec ground_oper: pas de diff entre -1 et -(1) *)
+let mk_pre op t =
+  if not (is_prefix op) then failwith (op^" not prefix");
+  if ground_oper op then
+    match t with
+    | Int i -> Int (op^i)
+    | _     -> Prefix(op,t)
+  else Prefix(op,t)
+
+(* teste si on peut reduire op suivi d'un op de niveau (n,a)
+   si la reponse est false, c'est que l'op (n,a) doit se reduire
+   avant *)
+let red_left_op (nl,al) (nr,ar) =
+  if nl < nr then true
+  else
+    if nl = nr then
+      match al,ar with
+        | (L|N), L -> true
+        | R, (R|N) -> false
+        | R, L ->  failwith "conflit d'assoc: ambigu"
+        | (L|N), (R|N) -> failwith "conflit d'assoc: blocage"
+    else false
+
+
+type level = int * assoc
+type stack =
+  | PrefixOper of string list
+  | Term of constr_ast * stack
+  | Oper of string list * string * constr_ast * stack
+
+let rec str_ast = function
+  | Infix(op,t1,t2) -> str_ast t1 ^ " " ^ op ^ " " ^ str_ast t2
+  | Postfix(op,t) -> str_ast t ^ " " ^ op
+  | Prefix(op,t) -> op ^ " " ^ str_ast t
+  | _ -> "_"
+
+let rec str_stack = function
+  | PrefixOper ops -> String.concat " " (List.rev ops)
+  | Term (t,s) -> str_stack s ^ " (" ^ str_ast t ^ ")"
+  | Oper(ops,lop,t,s) ->
+      str_stack (Term(t,s)) ^ " " ^ lop ^ " " ^
+      String.concat " " (List.rev ops) 
+
+let pps s = prerr_endline (str_stack s)
+let err s stk = failwith (s^": "^str_stack stk)
+
+
+let empty = PrefixOper []
+
+let check_fixity_term stk =
+  match stk with
+      Term _ -> err "2 termes successifs" stk
+    | _ -> ()
+
+let shift_term t stk =
+  check_fixity_term stk;
+  Term(t,stk)
+
+let shift_oper op stk =
+  match stk with
+    | Oper(ops,lop,t,s) -> Oper(op::ops,lop,t,s)
+    | Term(t,s) -> Oper([],op,t,s)
+    | PrefixOper ops -> PrefixOper (op::ops)
+
+let is_reducible lv stk =
+  match stk with
+    | Oper([],iop,_,_)  -> red_left_op (level iop) lv
+    | Oper(op::_,_,_,_) -> red_left_op (level op) lv
+    | PrefixOper(op::_) -> red_left_op (level op) lv
+    | _                 -> false
+
+let reduce_head (t,stk) =
+  match stk with
+    | Oper([],iop,t1,s) ->
+        (Infix(iop,t1,t), s)
+    | Oper(op::ops,lop,t',s) ->
+        (mk_pre op t, Oper(ops,lop,t',s))
+    | PrefixOper(op::ops) ->
+        (Prefix(op,t), PrefixOper ops)
+    | _ -> assert false
+
+let rec reduce_level lv (t,s) =
+  if is_reducible lv s then reduce_level lv (reduce_head (t, s))
+  else (t, s)
+
+let reduce_post op (t,s) =
+  let (t',s') = reduce_level (level op) (t,s) in
+  (mk_post op t', s')
+
+let reduce_posts stk =
+  match stk with
+      Oper(ops,iop,t,s) ->
+        let pts1 = reduce_post iop (t,s) in
+        List.fold_right reduce_post ops pts1
+    | Term(t,s) -> (t,s)
+    | PrefixOper _ -> failwith "reduce_posts"
+
+
+let shift_infix op stk =
+  let (t,s) = reduce_level (level op) (reduce_posts stk) in
+  Oper([],op,t,s)
+
+let is_better_infix op stk =
+  match stk with
+    | Oper(ops,iop,t,s) ->
+        is_postfix iop &&
+        List.for_all is_postfix ops &&
+        (not (is_prefix op) || red_left_op (level iop) (level op))
+    | Term _ -> false
+    | _ -> assert false
+
+let parse_oper op stk =
+  match stk with
+    | PrefixOper _ ->
+        if is_prefix op then shift_oper op stk else failwith "prefix_oper"
+    | Oper _ ->
+        if is_infix op then
+          if is_better_infix op stk then shift_infix op stk
+          else shift_oper op stk
+        else if is_prefix op then shift_oper op stk
+        else if is_postfix op then
+          let (t,s) = reduce_post op (reduce_posts stk) in
+          Term(t,s)
+        else assert false
+    | Term(t,s) ->
+        if is_infix op then shift_infix op stk
+        else if is_postfix op then
+          let (t2,s2) = reduce_post op (t,s) in Term(t2,s2)
+        else failwith "infix/postfix"
+
+let parse_term = shift_term
+
+let rec close_stack stk =
+  match stk with
+      Term(t,PrefixOper []) -> t
+    | PrefixOper _ -> failwith "expression sans atomes"
+    | _ ->
+        let (t,s) = reduce_head (reduce_posts stk) in
+        close_stack (Term(t,s))
+
diff --git a/dev/doc/parsing.dep.ps b/dev/doc/parsing.dep.ps
new file mode 100644
index 00000000..723d8c69
--- /dev/null
+++ b/dev/doc/parsing.dep.ps
@@ -0,0 +1,1115 @@
+%!PS-Adobe-2.0
+%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005)
+%%For: (herbelin) Hugo Herbelin
+%%Title: G
+%%Pages: (atend)
+%%BoundingBox: 35 35 577 314
+%%EndComments
+save
+%%BeginProlog
+/DotDict 200 dict def
+DotDict begin
+
+/setupLatin1 {
+mark
+/EncodingVector 256 array def
+ EncodingVector 0
+
+ISOLatin1Encoding 0 255 getinterval putinterval
+
+EncodingVector
+  dup 306 /AE
+  dup 301 /Aacute
+  dup 302 /Acircumflex
+  dup 304 /Adieresis
+  dup 300 /Agrave
+  dup 305 /Aring
+  dup 303 /Atilde
+  dup 307 /Ccedilla
+  dup 311 /Eacute
+  dup 312 /Ecircumflex
+  dup 313 /Edieresis
+  dup 310 /Egrave
+  dup 315 /Iacute
+  dup 316 /Icircumflex
+  dup 317 /Idieresis
+  dup 314 /Igrave
+  dup 334 /Udieresis
+  dup 335 /Yacute
+  dup 376 /thorn
+  dup 337 /germandbls
+  dup 341 /aacute
+  dup 342 /acircumflex
+  dup 344 /adieresis
+  dup 346 /ae
+  dup 340 /agrave
+  dup 345 /aring
+  dup 347 /ccedilla
+  dup 351 /eacute
+  dup 352 /ecircumflex
+  dup 353 /edieresis
+  dup 350 /egrave
+  dup 355 /iacute
+  dup 356 /icircumflex
+  dup 357 /idieresis
+  dup 354 /igrave
+  dup 360 /dcroat
+  dup 361 /ntilde
+  dup 363 /oacute
+  dup 364 /ocircumflex
+  dup 366 /odieresis
+  dup 362 /ograve
+  dup 365 /otilde
+  dup 370 /oslash
+  dup 372 /uacute
+  dup 373 /ucircumflex
+  dup 374 /udieresis
+  dup 371 /ugrave
+  dup 375 /yacute
+  dup 377 /ydieresis  
+
+% Set up ISO Latin 1 character encoding
+/starnetISO {
+        dup dup findfont dup length dict begin
+        { 1 index /FID ne { def }{ pop pop } ifelse
+        } forall
+        /Encoding EncodingVector def
+        currentdict end definefont
+} def
+/Times-Roman starnetISO def
+/Times-Italic starnetISO def
+/Times-Bold starnetISO def
+/Times-BoldItalic starnetISO def
+/Helvetica starnetISO def
+/Helvetica-Oblique starnetISO def
+/Helvetica-Bold starnetISO def
+/Helvetica-BoldOblique starnetISO def
+/Courier starnetISO def
+/Courier-Oblique starnetISO def
+/Courier-Bold starnetISO def
+/Courier-BoldOblique starnetISO def
+cleartomark
+} bind def
+
+%%BeginResource: procset graphviz 0 0
+/coord-font-family /Times-Roman def
+/default-font-family /Times-Roman def
+/coordfont coord-font-family findfont 8 scalefont def
+
+/InvScaleFactor 1.0 def
+/set_scale {
+	dup 1 exch div /InvScaleFactor exch def
+	dup scale
+} bind def
+
+% styles
+/solid { [] 0 setdash } bind def
+/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
+/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
+/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
+/bold { 2 setlinewidth } bind def
+/filled { } bind def
+/unfilled { } bind def
+/rounded { } bind def
+/diagonals { } bind def
+
+% hooks for setting color 
+/nodecolor { sethsbcolor } bind def
+/edgecolor { sethsbcolor } bind def
+/graphcolor { sethsbcolor } bind def
+/nopcolor {pop pop pop} bind def
+
+/beginpage {	% i j npages
+	/npages exch def
+	/j exch def
+	/i exch def
+	/str 10 string def
+	npages 1 gt {
+		gsave
+			coordfont setfont
+			0 0 moveto
+			(\() show i str cvs show (,) show j str cvs show (\)) show
+		grestore
+	} if
+} bind def
+
+/set_font {
+	findfont exch
+	scalefont setfont
+} def
+
+% draw aligned label in bounding box aligned to current point
+/alignedtext {			% width adj text
+	/text exch def
+	/adj exch def
+	/width exch def
+	gsave
+		width 0 gt {
+			text stringwidth pop adj mul 0 rmoveto
+		} if
+		[] 0 setdash
+		text show
+	grestore
+} def
+
+/boxprim {				% xcorner ycorner xsize ysize
+		4 2 roll
+		moveto
+		2 copy
+		exch 0 rlineto
+		0 exch rlineto
+		pop neg 0 rlineto
+		closepath
+} bind def
+
+/ellipse_path {
+	/ry exch def
+	/rx exch def
+	/y exch def
+	/x exch def
+	matrix currentmatrix
+	newpath
+	x y translate
+	rx ry scale
+	0 0 1 0 360 arc
+	setmatrix
+} bind def
+
+/endpage { showpage } bind def
+/showpage { } def
+
+/layercolorseq
+	[	% layer color sequence - darkest to lightest
+		[0 0 0]
+		[.2 .8 .8]
+		[.4 .8 .8]
+		[.6 .8 .8]
+		[.8 .8 .8]
+	]
+def
+
+/layerlen layercolorseq length def
+
+/setlayer {/maxlayer exch def /curlayer exch def
+	layercolorseq curlayer 1 sub layerlen mod get
+	aload pop sethsbcolor
+	/nodecolor {nopcolor} def
+	/edgecolor {nopcolor} def
+	/graphcolor {nopcolor} def
+} bind def
+
+/onlayer { curlayer ne {invis} if } def
+
+/onlayers {
+	/myupper exch def
+	/mylower exch def
+	curlayer mylower lt
+	curlayer myupper gt
+	or
+	{invis} if
+} def
+
+/curlayer 0 def
+
+%%EndResource
+%%EndProlog
+%%BeginSetup
+14 default-font-family set_font
+1 setmiterlimit
+% /arrowlength 10 def
+% /arrowwidth 5 def
+
+% make sure pdfmark is harmless for PS-interpreters other than Distiller
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+% make '<<' and '>>' safe on PS Level 1 devices
+/languagelevel where {pop languagelevel}{1} ifelse
+2 lt {
+    userdict (<<) cvn ([) cvn load put
+    userdict (>>) cvn ([) cvn load put
+} if
+
+%%EndSetup
+%%Page: 1 1
+%%PageBoundingBox: 36 36 577 314
+%%PageOrientation: Portrait
+gsave
+35 35 542 279 boxprim clip newpath
+36 36 translate
+0 0 1 beginpage
+0.6027 set_scale
+0 0 translate 0 rotate
+0.000 0.000 0.000 graphcolor
+14.00 /Times-Roman set_font
+
+%	Pcoq
+gsave 10 dict begin
+557 280 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+543 275 moveto
+(Pcoq)
+[7.68 6.24 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Extend
+gsave 10 dict begin
+664 226 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+643 221 moveto
+(Extend)
+[8.4 6.96 3.84 6.24 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Pcoq -> Extend
+newpath 579 269 moveto
+593 261 613 252 630 243 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 632 246 moveto
+639 238 lineto
+629 240 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 632 246 moveto
+639 238 lineto
+629 240 lineto
+closepath
+stroke
+end grestore
+
+%	Ast
+gsave 10 dict begin
+764 172 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+753 167 moveto
+(Ast)
+[10.08 5.28 3.84]
+xshow
+end grestore
+end grestore
+
+%	Extend -> Ast
+newpath 688 213 moveto
+701 206 719 196 734 188 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 736 191 moveto
+743 183 lineto
+733 185 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 736 191 moveto
+743 183 lineto
+733 185 lineto
+closepath
+stroke
+end grestore
+
+%	Lexer
+gsave 10 dict begin
+764 226 29 18 ellipse_path
+stroke
+gsave 10 dict begin
+747 221 moveto
+(Lexer)
+[8.4 5.76 6.48 6.24 4.56]
+xshow
+end grestore
+end grestore
+
+%	Extend -> Lexer
+newpath 698 226 moveto
+706 226 715 226 724 226 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 724 230 moveto
+734 226 lineto
+724 223 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 724 230 moveto
+734 226 lineto
+724 223 lineto
+closepath
+stroke
+end grestore
+
+%	Termast
+gsave 10 dict begin
+557 172 35 18 ellipse_path
+stroke
+gsave 10 dict begin
+534 167 moveto
+(Termast)
+[7.2 6.24 4.8 10.8 6.24 5.28 3.84]
+xshow
+end grestore
+end grestore
+
+%	Termast -> Ast
+newpath 593 172 moveto
+630 172 689 172 727 172 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 727 176 moveto
+737 172 lineto
+727 169 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 727 176 moveto
+737 172 lineto
+727 169 lineto
+closepath
+stroke
+end grestore
+
+%	Coqast
+gsave 10 dict begin
+863 172 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+843 167 moveto
+(Coqast)
+[9.36 6.96 6.96 6.24 5.28 3.84]
+xshow
+end grestore
+end grestore
+
+%	Ast -> Coqast
+newpath 791 172 moveto
+800 172 810 172 820 172 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 820 176 moveto
+830 172 lineto
+820 169 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 820 176 moveto
+830 172 lineto
+820 169 lineto
+closepath
+stroke
+end grestore
+
+%	Tactic_printer
+gsave 10 dict begin
+53 126 52 18 ellipse_path
+stroke
+gsave 10 dict begin
+13 121 moveto
+(Tactic_printer)
+[7.44 6.24 6.24 3.84 3.84 6.24 6.96 6.96 4.8 3.84 6.96 3.84 6.24 4.56]
+xshow
+end grestore
+end grestore
+
+%	Pptactic
+gsave 10 dict begin
+178 126 36 18 ellipse_path
+stroke
+gsave 10 dict begin
+155 121 moveto
+(Pptactic)
+[7.68 6.96 4.08 6.24 6.24 3.84 3.84 6.24]
+xshow
+end grestore
+end grestore
+
+%	Tactic_printer -> Pptactic
+newpath 106 126 moveto
+114 126 123 126 132 126 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 132 130 moveto
+142 126 lineto
+132 123 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 132 130 moveto
+142 126 lineto
+132 123 lineto
+closepath
+stroke
+end grestore
+
+%	Printer
+gsave 10 dict begin
+289 72 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+269 67 moveto
+(Printer)
+[7.68 4.8 3.84 6.96 3.84 6.24 4.56]
+xshow
+end grestore
+end grestore
+
+%	Pptactic -> Printer
+newpath 204 113 moveto
+219 105 238 96 255 88 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 256 91 moveto
+264 84 lineto
+253 85 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 256 91 moveto
+264 84 lineto
+253 85 lineto
+closepath
+stroke
+end grestore
+
+%	Search
+gsave 10 dict begin
+178 72 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+159 67 moveto
+(Search)
+[7.68 6.24 6.24 4.56 6 6.96]
+xshow
+end grestore
+end grestore
+
+%	Search -> Printer
+newpath 210 72 moveto
+221 72 234 72 246 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 246 76 moveto
+256 72 lineto
+246 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 246 76 moveto
+256 72 lineto
+246 69 lineto
+closepath
+stroke
+end grestore
+
+%	Printer -> Termast
+newpath 316 62 moveto
+355 48 430 30 484 58 curveto
+518 77 538 117 548 144 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 545 146 moveto
+552 154 lineto
+552 143 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 545 146 moveto
+552 154 lineto
+552 143 lineto
+closepath
+stroke
+end grestore
+
+%	Esyntax
+gsave 10 dict begin
+557 226 36 18 ellipse_path
+stroke
+gsave 10 dict begin
+533 221 moveto
+(Esyntax)
+[8.4 5.52 6.96 6.96 4.08 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	Printer -> Esyntax
+newpath 322 71 moveto
+370 70 460 72 484 91 curveto
+489 95 516 193 520 197 curveto
+527 204 532 203 538 204 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 536 207 moveto
+547 208 lineto
+539 201 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 536 207 moveto
+547 208 lineto
+539 201 lineto
+closepath
+stroke
+end grestore
+
+%	Ppconstr
+gsave 10 dict begin
+424 388 37 18 ellipse_path
+stroke
+gsave 10 dict begin
+399 383 moveto
+(Ppconstr)
+[7.68 6.96 6.24 6.96 6.96 5.28 3.84 4.56]
+xshow
+end grestore
+end grestore
+
+%	Printer -> Ppconstr
+newpath 292 90 moveto
+300 147 329 319 364 361 curveto
+369 367 375 371 382 375 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 380 378 moveto
+391 379 lineto
+383 372 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 380 378 moveto
+391 379 lineto
+383 372 lineto
+closepath
+stroke
+end grestore
+
+%	Esyntax -> Extend
+newpath 594 226 moveto
+602 226 611 226 620 226 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 620 230 moveto
+630 226 lineto
+620 223 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 620 230 moveto
+630 226 lineto
+620 223 lineto
+closepath
+stroke
+end grestore
+
+%	Ppconstr -> Pcoq
+newpath 454 377 moveto
+464 373 475 368 484 361 curveto
+506 345 526 322 540 304 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 543 306 moveto
+546 296 lineto
+537 302 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 543 306 moveto
+546 296 lineto
+537 302 lineto
+closepath
+stroke
+end grestore
+
+%	Prettyp
+gsave 10 dict begin
+178 18 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+158 13 moveto
+(Prettyp)
+[7.68 4.56 6 3.84 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Prettyp -> Printer
+newpath 203 30 moveto
+218 38 238 47 255 55 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 254 58 moveto
+264 60 lineto
+257 52 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 254 58 moveto
+264 60 lineto
+257 52 lineto
+closepath
+stroke
+end grestore
+
+%	Printmod
+gsave 10 dict begin
+289 18 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+263 13 moveto
+(Printmod)
+[7.68 4.8 3.84 6.96 3.84 10.8 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Prettyp -> Printmod
+newpath 211 18 moveto
+220 18 230 18 240 18 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 240 22 moveto
+250 18 lineto
+240 15 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 240 22 moveto
+250 18 lineto
+240 15 lineto
+closepath
+stroke
+end grestore
+
+%	G_zsyntax
+gsave 10 dict begin
+424 172 43 18 ellipse_path
+stroke
+gsave 10 dict begin
+393 167 moveto
+(G_zsyntax)
+[10.08 6.96 6.24 5.52 6.96 6.96 4.08 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	G_zsyntax -> Pcoq
+newpath 458 183 moveto
+467 188 476 193 484 199 curveto
+507 218 501 233 520 253 curveto
+523 256 526 259 530 261 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 528 264 moveto
+538 267 lineto
+532 258 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 528 264 moveto
+538 267 lineto
+532 258 lineto
+closepath
+stroke
+end grestore
+
+%	G_zsyntax -> Termast
+newpath 468 172 moveto
+482 172 497 172 511 172 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 511 176 moveto
+521 172 lineto
+511 169 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 511 176 moveto
+521 172 lineto
+511 169 lineto
+closepath
+stroke
+end grestore
+
+%	G_zsyntax -> Esyntax
+newpath 455 185 moveto
+474 193 499 203 520 211 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 518 214 moveto
+529 215 lineto
+521 208 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 518 214 moveto
+529 215 lineto
+521 208 lineto
+closepath
+stroke
+end grestore
+
+%	G_string_syntax
+gsave 10 dict begin
+424 280 59 18 ellipse_path
+stroke
+gsave 10 dict begin
+377 275 moveto
+(G_string_syntax)
+[10.08 6.96 5.28 3.84 4.8 3.84 6.96 6.96 6.96 5.52 6.96 6.96 4.08 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	G_string_syntax -> Pcoq
+newpath 484 280 moveto
+496 280 509 280 520 280 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 520 284 moveto
+530 280 lineto
+520 277 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 520 284 moveto
+530 280 lineto
+520 277 lineto
+closepath
+stroke
+end grestore
+
+%	G_string_syntax -> Esyntax
+newpath 460 266 moveto
+478 258 501 249 520 242 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 521 245 moveto
+529 238 lineto
+518 239 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 521 245 moveto
+529 238 lineto
+518 239 lineto
+closepath
+stroke
+end grestore
+
+%	G_rsyntax
+gsave 10 dict begin
+424 118 42 18 ellipse_path
+stroke
+gsave 10 dict begin
+394 113 moveto
+(G_rsyntax)
+[10.08 6.96 4.56 5.52 6.96 6.96 4.08 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	G_rsyntax -> Pcoq
+newpath 459 128 moveto
+468 132 477 138 484 145 curveto
+518 183 491 213 520 253 curveto
+523 256 526 259 529 262 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 527 265 moveto
+537 268 lineto
+531 259 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 527 265 moveto
+537 268 lineto
+531 259 lineto
+closepath
+stroke
+end grestore
+
+%	G_rsyntax -> Termast
+newpath 455 131 moveto
+474 139 499 149 520 157 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 518 160 moveto
+529 161 lineto
+521 154 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 518 160 moveto
+529 161 lineto
+521 154 lineto
+closepath
+stroke
+end grestore
+
+%	G_rsyntax -> Esyntax
+newpath 457 129 moveto
+467 133 476 139 484 145 curveto
+507 164 501 179 520 199 curveto
+522 201 525 203 527 205 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 525 208 moveto
+535 212 lineto
+530 203 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 525 208 moveto
+535 212 lineto
+530 203 lineto
+closepath
+stroke
+end grestore
+
+%	G_natsyntax
+gsave 10 dict begin
+424 226 48 18 ellipse_path
+stroke
+gsave 10 dict begin
+388 221 moveto
+(G_natsyntax)
+[10.08 6.96 6.96 6.24 3.84 5.52 6.96 6.96 4.08 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	G_natsyntax -> Pcoq
+newpath 457 239 moveto
+478 248 504 259 525 266 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 523 269 moveto
+534 270 lineto
+526 263 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 523 269 moveto
+534 270 lineto
+526 263 lineto
+closepath
+stroke
+end grestore
+
+%	G_natsyntax -> Termast
+newpath 457 213 moveto
+476 205 500 195 520 187 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 521 190 moveto
+529 183 lineto
+518 184 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 521 190 moveto
+529 183 lineto
+518 184 lineto
+closepath
+stroke
+end grestore
+
+%	G_natsyntax -> Esyntax
+newpath 473 226 moveto
+485 226 498 226 510 226 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 510 230 moveto
+520 226 lineto
+510 223 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 510 230 moveto
+520 226 lineto
+510 223 lineto
+closepath
+stroke
+end grestore
+
+%	G_ascii_syntax
+gsave 10 dict begin
+424 334 56 18 ellipse_path
+stroke
+gsave 10 dict begin
+380 329 moveto
+(G_ascii_syntax)
+[10.08 6.96 6.24 5.52 6.24 3.84 3.84 6.96 5.52 6.96 6.96 4.08 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	G_ascii_syntax -> Pcoq
+newpath 459 320 moveto
+479 311 504 301 525 293 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 526 296 moveto
+534 289 lineto
+523 290 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 526 296 moveto
+534 289 lineto
+523 290 lineto
+closepath
+stroke
+end grestore
+
+%	G_ascii_syntax -> Esyntax
+newpath 462 321 moveto
+470 317 478 312 484 307 curveto
+507 288 501 273 520 253 curveto
+522 251 524 249 527 247 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 529 250 moveto
+535 241 lineto
+525 244 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 529 250 moveto
+535 241 lineto
+525 244 lineto
+closepath
+stroke
+end grestore
+
+%	Egrammar
+gsave 10 dict begin
+424 442 43 18 ellipse_path
+stroke
+gsave 10 dict begin
+394 437 moveto
+(Egrammar)
+[8.4 7.2 4.56 6.24 10.8 10.8 6.24 4.56]
+xshow
+end grestore
+end grestore
+
+%	Egrammar -> Pcoq
+newpath 458 431 moveto
+467 427 477 422 484 415 curveto
+516 385 537 337 548 308 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 551 309 moveto
+551 298 lineto
+545 307 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 551 309 moveto
+551 298 lineto
+545 307 lineto
+closepath
+stroke
+end grestore
+endpage
+showpage
+grestore
+%%PageTrailer
+%%EndPage: 1
+%%Trailer
+%%Pages: 1
+end
+restore
+%%EOF
diff --git a/dev/doc/preamble.tex b/dev/doc/preamble.tex
new file mode 100644
index 00000000..2cd21f02
--- /dev/null
+++ b/dev/doc/preamble.tex
@@ -0,0 +1,8 @@
+\documentclass[11pt]{article}
+\usepackage[latin1]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage{ocamlweb}
+\pagestyle{ocamlweb}
+\usepackage{fullpage}
+\usepackage{epsfig}
+\begin{document}
diff --git a/dev/doc/pretyping.dep.ps b/dev/doc/pretyping.dep.ps
new file mode 100644
index 00000000..02d1b8b5
--- /dev/null
+++ b/dev/doc/pretyping.dep.ps
@@ -0,0 +1,1259 @@
+%!PS-Adobe-2.0
+%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005)
+%%For: (herbelin) Hugo Herbelin
+%%Title: G
+%%Pages: (atend)
+%%BoundingBox: 35 35 577 146
+%%EndComments
+save
+%%BeginProlog
+/DotDict 200 dict def
+DotDict begin
+
+/setupLatin1 {
+mark
+/EncodingVector 256 array def
+ EncodingVector 0
+
+ISOLatin1Encoding 0 255 getinterval putinterval
+
+EncodingVector
+  dup 306 /AE
+  dup 301 /Aacute
+  dup 302 /Acircumflex
+  dup 304 /Adieresis
+  dup 300 /Agrave
+  dup 305 /Aring
+  dup 303 /Atilde
+  dup 307 /Ccedilla
+  dup 311 /Eacute
+  dup 312 /Ecircumflex
+  dup 313 /Edieresis
+  dup 310 /Egrave
+  dup 315 /Iacute
+  dup 316 /Icircumflex
+  dup 317 /Idieresis
+  dup 314 /Igrave
+  dup 334 /Udieresis
+  dup 335 /Yacute
+  dup 376 /thorn
+  dup 337 /germandbls
+  dup 341 /aacute
+  dup 342 /acircumflex
+  dup 344 /adieresis
+  dup 346 /ae
+  dup 340 /agrave
+  dup 345 /aring
+  dup 347 /ccedilla
+  dup 351 /eacute
+  dup 352 /ecircumflex
+  dup 353 /edieresis
+  dup 350 /egrave
+  dup 355 /iacute
+  dup 356 /icircumflex
+  dup 357 /idieresis
+  dup 354 /igrave
+  dup 360 /dcroat
+  dup 361 /ntilde
+  dup 363 /oacute
+  dup 364 /ocircumflex
+  dup 366 /odieresis
+  dup 362 /ograve
+  dup 365 /otilde
+  dup 370 /oslash
+  dup 372 /uacute
+  dup 373 /ucircumflex
+  dup 374 /udieresis
+  dup 371 /ugrave
+  dup 375 /yacute
+  dup 377 /ydieresis  
+
+% Set up ISO Latin 1 character encoding
+/starnetISO {
+        dup dup findfont dup length dict begin
+        { 1 index /FID ne { def }{ pop pop } ifelse
+        } forall
+        /Encoding EncodingVector def
+        currentdict end definefont
+} def
+/Times-Roman starnetISO def
+/Times-Italic starnetISO def
+/Times-Bold starnetISO def
+/Times-BoldItalic starnetISO def
+/Helvetica starnetISO def
+/Helvetica-Oblique starnetISO def
+/Helvetica-Bold starnetISO def
+/Helvetica-BoldOblique starnetISO def
+/Courier starnetISO def
+/Courier-Oblique starnetISO def
+/Courier-Bold starnetISO def
+/Courier-BoldOblique starnetISO def
+cleartomark
+} bind def
+
+%%BeginResource: procset graphviz 0 0
+/coord-font-family /Times-Roman def
+/default-font-family /Times-Roman def
+/coordfont coord-font-family findfont 8 scalefont def
+
+/InvScaleFactor 1.0 def
+/set_scale {
+	dup 1 exch div /InvScaleFactor exch def
+	dup scale
+} bind def
+
+% styles
+/solid { [] 0 setdash } bind def
+/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
+/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
+/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
+/bold { 2 setlinewidth } bind def
+/filled { } bind def
+/unfilled { } bind def
+/rounded { } bind def
+/diagonals { } bind def
+
+% hooks for setting color 
+/nodecolor { sethsbcolor } bind def
+/edgecolor { sethsbcolor } bind def
+/graphcolor { sethsbcolor } bind def
+/nopcolor {pop pop pop} bind def
+
+/beginpage {	% i j npages
+	/npages exch def
+	/j exch def
+	/i exch def
+	/str 10 string def
+	npages 1 gt {
+		gsave
+			coordfont setfont
+			0 0 moveto
+			(\() show i str cvs show (,) show j str cvs show (\)) show
+		grestore
+	} if
+} bind def
+
+/set_font {
+	findfont exch
+	scalefont setfont
+} def
+
+% draw aligned label in bounding box aligned to current point
+/alignedtext {			% width adj text
+	/text exch def
+	/adj exch def
+	/width exch def
+	gsave
+		width 0 gt {
+			text stringwidth pop adj mul 0 rmoveto
+		} if
+		[] 0 setdash
+		text show
+	grestore
+} def
+
+/boxprim {				% xcorner ycorner xsize ysize
+		4 2 roll
+		moveto
+		2 copy
+		exch 0 rlineto
+		0 exch rlineto
+		pop neg 0 rlineto
+		closepath
+} bind def
+
+/ellipse_path {
+	/ry exch def
+	/rx exch def
+	/y exch def
+	/x exch def
+	matrix currentmatrix
+	newpath
+	x y translate
+	rx ry scale
+	0 0 1 0 360 arc
+	setmatrix
+} bind def
+
+/endpage { showpage } bind def
+/showpage { } def
+
+/layercolorseq
+	[	% layer color sequence - darkest to lightest
+		[0 0 0]
+		[.2 .8 .8]
+		[.4 .8 .8]
+		[.6 .8 .8]
+		[.8 .8 .8]
+	]
+def
+
+/layerlen layercolorseq length def
+
+/setlayer {/maxlayer exch def /curlayer exch def
+	layercolorseq curlayer 1 sub layerlen mod get
+	aload pop sethsbcolor
+	/nodecolor {nopcolor} def
+	/edgecolor {nopcolor} def
+	/graphcolor {nopcolor} def
+} bind def
+
+/onlayer { curlayer ne {invis} if } def
+
+/onlayers {
+	/myupper exch def
+	/mylower exch def
+	curlayer mylower lt
+	curlayer myupper gt
+	or
+	{invis} if
+} def
+
+/curlayer 0 def
+
+%%EndResource
+%%EndProlog
+%%BeginSetup
+14 default-font-family set_font
+1 setmiterlimit
+% /arrowlength 10 def
+% /arrowwidth 5 def
+
+% make sure pdfmark is harmless for PS-interpreters other than Distiller
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+% make '<<' and '>>' safe on PS Level 1 devices
+/languagelevel where {pop languagelevel}{1} ifelse
+2 lt {
+    userdict (<<) cvn ([) cvn load put
+    userdict (>>) cvn ([) cvn load put
+} if
+
+%%EndSetup
+%%Page: 1 1
+%%PageBoundingBox: 36 36 577 146
+%%PageOrientation: Portrait
+gsave
+35 35 542 111 boxprim clip newpath
+36 36 translate
+0 0 1 beginpage
+0.3600 set_scale
+0 0 translate 0 rotate
+0.000 0.000 0.000 graphcolor
+14.00 /Times-Roman set_font
+
+%	Unification
+gsave 10 dict begin
+610 118 45 18 ellipse_path
+stroke
+gsave 10 dict begin
+577 113 moveto
+(Unification)
+[9.6 6.96 3.84 4.8 3.84 6.24 6.24 3.84 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Evarutil
+gsave 10 dict begin
+728 72 36 18 ellipse_path
+stroke
+gsave 10 dict begin
+705 67 moveto
+(Evarutil)
+[8.4 6.72 6.24 4.8 6.96 3.84 3.84 3.84]
+xshow
+end grestore
+end grestore
+
+%	Unification -> Evarutil
+newpath 643 105 moveto
+657 99 674 93 689 87 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 691 90 moveto
+699 83 lineto
+688 83 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 691 90 moveto
+699 83 lineto
+688 83 lineto
+closepath
+stroke
+end grestore
+
+%	Pattern
+gsave 10 dict begin
+728 210 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+708 205 moveto
+(Pattern)
+[7.44 6.24 3.84 3.84 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	Unification -> Pattern
+newpath 631 134 moveto
+650 150 680 173 701 189 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 699 192 moveto
+709 195 lineto
+703 186 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 699 192 moveto
+709 195 lineto
+703 186 lineto
+closepath
+stroke
+end grestore
+
+%	Retyping
+gsave 10 dict begin
+839 118 38 18 ellipse_path
+stroke
+gsave 10 dict begin
+813 113 moveto
+(Retyping)
+[9.12 6 3.84 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Unification -> Retyping
+newpath 656 118 moveto
+695 118 750 118 790 118 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 790 122 moveto
+800 118 lineto
+790 115 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 790 122 moveto
+800 118 lineto
+790 115 lineto
+closepath
+stroke
+end grestore
+
+%	Typing
+gsave 10 dict begin
+839 64 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+819 59 moveto
+(Typing)
+[6.96 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Evarutil -> Typing
+newpath 764 69 moveto
+775 68 786 67 797 67 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 797 70 moveto
+807 66 lineto
+797 64 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 797 70 moveto
+807 66 lineto
+797 64 lineto
+closepath
+stroke
+end grestore
+
+%	Rawterm
+gsave 10 dict begin
+1109 110 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+1083 105 moveto
+(Rawterm)
+[9.36 5.76 10.08 3.84 6.24 4.8 10.8]
+xshow
+end grestore
+end grestore
+
+%	Pattern -> Rawterm
+newpath 759 216 moveto
+816 226 939 239 1024 191 curveto
+1049 176 1038 155 1060 138 curveto
+1069 131 1077 130 1084 129 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1085 132 moveto
+1094 127 lineto
+1084 126 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1085 132 moveto
+1094 127 lineto
+1084 126 lineto
+closepath
+stroke
+end grestore
+
+%	Inductiveops
+gsave 10 dict begin
+1109 164 49 18 ellipse_path
+stroke
+gsave 10 dict begin
+1073 159 moveto
+(Inductiveops)
+[4.56 6.96 6.96 6.96 6.24 3.84 3.84 6.48 6.24 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Retyping -> Inductiveops
+newpath 878 120 moveto
+915 122 974 126 1024 137 curveto
+1037 139 1051 144 1064 148 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1063 151 moveto
+1074 151 lineto
+1065 145 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1063 151 moveto
+1074 151 lineto
+1065 145 lineto
+closepath
+stroke
+end grestore
+
+%	Pretype_errors
+gsave 10 dict begin
+969 72 54 18 ellipse_path
+stroke
+gsave 10 dict begin
+927 67 moveto
+(Pretype_errors)
+[7.68 4.56 6 3.84 6.96 6.96 6.24 6.96 6.24 5.04 4.56 6.96 4.56 5.52]
+xshow
+end grestore
+end grestore
+
+%	Typing -> Pretype_errors
+newpath 871 66 moveto
+881 67 893 68 905 68 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 905 71 moveto
+915 69 lineto
+905 65 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 905 71 moveto
+915 69 lineto
+905 65 lineto
+closepath
+stroke
+end grestore
+
+%	Pretype_errors -> Inductiveops
+newpath 998 87 moveto
+1007 92 1016 98 1024 104 curveto
+1042 116 1043 124 1060 137 curveto
+1063 139 1067 142 1071 144 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1070 147 moveto
+1080 149 lineto
+1073 141 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1070 147 moveto
+1080 149 lineto
+1073 141 lineto
+closepath
+stroke
+end grestore
+
+%	Pretype_errors -> Rawterm
+newpath 1011 84 moveto
+1029 88 1048 94 1065 98 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1064 101 moveto
+1075 101 lineto
+1066 95 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1064 101 moveto
+1075 101 lineto
+1066 95 lineto
+closepath
+stroke
+end grestore
+
+%	Tacred
+gsave 10 dict begin
+728 18 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+709 13 moveto
+(Tacred)
+[7.44 6.24 6.24 4.56 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	Tacred -> Retyping
+newpath 748 32 moveto
+754 36 759 41 764 45 curveto
+783 63 782 73 800 91 curveto
+802 93 805 95 808 97 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 806 100 moveto
+816 103 lineto
+810 94 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 806 100 moveto
+816 103 lineto
+810 94 lineto
+closepath
+stroke
+end grestore
+
+%	Tacred -> Typing
+newpath 754 29 moveto
+769 35 787 43 803 49 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 802 53 moveto
+813 53 lineto
+805 46 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 802 53 moveto
+813 53 lineto
+805 46 lineto
+closepath
+stroke
+end grestore
+
+%	Cbv
+gsave 10 dict begin
+1246 41 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+1234 36 moveto
+(Cbv)
+[9.36 6.48 6.96]
+xshow
+end grestore
+end grestore
+
+%	Tacred -> Cbv
+newpath 760 19 moveto
+852 23 1111 35 1209 40 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1209 44 moveto
+1219 40 lineto
+1209 37 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1209 44 moveto
+1219 40 lineto
+1209 37 lineto
+closepath
+stroke
+end grestore
+
+%	Evd
+gsave 10 dict begin
+1361 110 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+1349 105 moveto
+(Evd)
+[8.4 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Cbv -> Evd
+newpath 1266 53 moveto
+1284 64 1312 80 1332 93 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1331 96 moveto
+1341 98 lineto
+1334 90 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1331 96 moveto
+1341 98 lineto
+1334 90 lineto
+closepath
+stroke
+end grestore
+
+%	Reductionops
+gsave 10 dict begin
+1246 164 51 18 ellipse_path
+stroke
+gsave 10 dict begin
+1207 159 moveto
+(Reductionops)
+[9.12 6.24 6.96 6.96 6.24 3.84 3.84 6.96 6.96 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Inductiveops -> Reductionops
+newpath 1158 164 moveto
+1167 164 1175 164 1184 164 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1184 168 moveto
+1194 164 lineto
+1184 161 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1184 168 moveto
+1194 164 lineto
+1184 161 lineto
+closepath
+stroke
+end grestore
+
+%	Reductionops -> Evd
+newpath 1277 150 moveto
+1294 142 1313 133 1330 125 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1331 128 moveto
+1339 121 lineto
+1328 122 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1331 128 moveto
+1339 121 lineto
+1328 122 lineto
+closepath
+stroke
+end grestore
+
+%	Termops
+gsave 10 dict begin
+1462 110 37 18 ellipse_path
+stroke
+gsave 10 dict begin
+1437 105 moveto
+(Termops)
+[7.2 6.24 4.8 10.8 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Evd -> Termops
+newpath 1388 110 moveto
+1396 110 1405 110 1414 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1414 114 moveto
+1424 110 lineto
+1414 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1414 114 moveto
+1424 110 lineto
+1414 107 lineto
+closepath
+stroke
+end grestore
+
+%	Recordops
+gsave 10 dict begin
+485 24 43 18 ellipse_path
+stroke
+gsave 10 dict begin
+455 19 moveto
+(Recordops)
+[9.12 6.24 6.24 6.96 4.32 6.96 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Classops
+gsave 10 dict begin
+610 20 38 18 ellipse_path
+stroke
+gsave 10 dict begin
+584 15 moveto
+(Classops)
+[9.36 3.84 6.24 5.52 5.52 6.96 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Recordops -> Classops
+newpath 528 23 moveto
+538 22 550 22 561 22 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 561 25 moveto
+571 21 lineto
+561 19 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 561 25 moveto
+571 21 lineto
+561 19 lineto
+closepath
+stroke
+end grestore
+
+%	Classops -> Tacred
+newpath 649 19 moveto
+661 19 674 19 686 19 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 686 23 moveto
+696 19 lineto
+686 16 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 686 23 moveto
+696 19 lineto
+686 16 lineto
+closepath
+stroke
+end grestore
+
+%	Rawterm -> Evd
+newpath 1148 110 moveto
+1196 110 1277 110 1324 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1324 114 moveto
+1334 110 lineto
+1324 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1324 114 moveto
+1334 110 lineto
+1324 107 lineto
+closepath
+stroke
+end grestore
+
+%	Pretyping
+gsave 10 dict begin
+40 183 40 18 ellipse_path
+stroke
+gsave 10 dict begin
+13 178 moveto
+(Pretyping)
+[7.68 4.56 6 3.84 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Pretyping -> Pattern
+newpath 78 189 moveto
+121 194 191 202 251 202 curveto
+251 202 251 202 485 202 curveto
+556 202 636 205 685 208 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 685 212 moveto
+695 208 lineto
+685 205 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 685 212 moveto
+695 208 lineto
+685 205 lineto
+closepath
+stroke
+end grestore
+
+%	Cases
+gsave 10 dict begin
+146 64 30 18 ellipse_path
+stroke
+gsave 10 dict begin
+129 59 moveto
+(Cases)
+[9.36 6.24 5.52 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Pretyping -> Cases
+newpath 53 166 moveto
+68 147 93 115 116 91 curveto
+118 89 119 88 121 86 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 124 88 moveto
+129 79 lineto
+119 83 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 124 88 moveto
+129 79 lineto
+119 83 lineto
+closepath
+stroke
+end grestore
+
+%	Detyping
+gsave 10 dict begin
+969 164 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+942 159 moveto
+(Detyping)
+[10.08 6 3.84 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Pretyping -> Detyping
+newpath 78 177 moveto
+121 172 191 164 251 164 curveto
+251 164 251 164 728 164 curveto
+794 164 870 164 919 164 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 919 168 moveto
+929 164 lineto
+919 161 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 919 168 moveto
+929 164 lineto
+919 161 lineto
+closepath
+stroke
+end grestore
+
+%	Indrec
+gsave 10 dict begin
+251 271 31 18 ellipse_path
+stroke
+gsave 10 dict begin
+233 266 moveto
+(Indrec)
+[4.56 6.96 6.96 4.56 6.24 6.24]
+xshow
+end grestore
+end grestore
+
+%	Pretyping -> Indrec
+newpath 69 195 moveto
+83 202 101 209 116 216 curveto
+150 230 188 246 216 257 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 214 260 moveto
+225 261 lineto
+217 254 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 214 260 moveto
+225 261 lineto
+217 254 lineto
+closepath
+stroke
+end grestore
+
+%	Coercion
+gsave 10 dict begin
+251 67 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+225 62 moveto
+(Coercion)
+[9.36 6.96 6.24 4.56 6.24 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Cases -> Coercion
+newpath 176 65 moveto
+184 65 193 66 202 66 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 202 70 moveto
+212 66 lineto
+202 63 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 202 70 moveto
+212 66 lineto
+202 63 lineto
+closepath
+stroke
+end grestore
+
+%	Detyping -> Inductiveops
+newpath 1009 164 moveto
+1022 164 1036 164 1050 164 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1050 168 moveto
+1060 164 lineto
+1050 161 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1050 168 moveto
+1060 164 lineto
+1050 161 lineto
+closepath
+stroke
+end grestore
+
+%	Detyping -> Rawterm
+newpath 999 152 moveto
+1020 144 1047 133 1069 125 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1070 128 moveto
+1079 122 lineto
+1068 122 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1070 128 moveto
+1079 122 lineto
+1068 122 lineto
+closepath
+stroke
+end grestore
+
+%	Indrec -> Inductiveops
+newpath 281 276 moveto
+325 283 412 294 485 294 curveto
+485 294 485 294 839 294 curveto
+937 294 1036 225 1082 188 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1085 190 moveto
+1090 181 lineto
+1080 185 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1085 190 moveto
+1090 181 lineto
+1080 185 lineto
+closepath
+stroke
+end grestore
+
+%	Matching
+gsave 10 dict begin
+610 248 40 18 ellipse_path
+stroke
+gsave 10 dict begin
+582 243 moveto
+(Matching)
+[12.48 6.24 3.84 6 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Matching -> Pattern
+newpath 643 237 moveto
+658 232 675 227 689 222 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 690 225 moveto
+699 219 lineto
+688 219 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 690 225 moveto
+699 219 lineto
+688 219 lineto
+closepath
+stroke
+end grestore
+
+%	Matching -> Reductionops
+newpath 650 250 moveto
+696 253 773 256 839 256 curveto
+839 256 839 256 969 256 curveto
+1059 256 1159 212 1210 184 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1212 187 moveto
+1219 179 lineto
+1209 181 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1212 187 moveto
+1219 179 lineto
+1209 181 lineto
+closepath
+stroke
+end grestore
+
+%	Evarconv
+gsave 10 dict begin
+366 67 40 18 ellipse_path
+stroke
+gsave 10 dict begin
+339 62 moveto
+(Evarconv)
+[8.4 6.72 6.24 4.56 6.24 6.96 6.48 6.96]
+xshow
+end grestore
+end grestore
+
+%	Evarconv -> Evarutil
+newpath 406 68 moveto
+474 69 610 71 682 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 682 76 moveto
+692 72 lineto
+682 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 682 76 moveto
+692 72 lineto
+682 69 lineto
+closepath
+stroke
+end grestore
+
+%	Evarconv -> Recordops
+newpath 397 56 moveto
+411 51 428 45 442 39 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 443 42 moveto
+452 36 lineto
+441 36 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 443 42 moveto
+452 36 lineto
+441 36 lineto
+closepath
+stroke
+end grestore
+
+%	Coercion -> Evarconv
+newpath 290 67 moveto
+299 67 307 67 316 67 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 316 71 moveto
+326 67 lineto
+316 64 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 316 71 moveto
+326 67 lineto
+316 64 lineto
+closepath
+stroke
+end grestore
+
+%	Clenv
+gsave 10 dict begin
+146 118 30 18 ellipse_path
+stroke
+gsave 10 dict begin
+129 113 moveto
+(Clenv)
+[9.36 3.84 6.24 6.48 6.96]
+xshow
+end grestore
+end grestore
+
+%	Clenv -> Unification
+newpath 176 118 moveto
+252 118 455 118 554 118 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 554 122 moveto
+564 118 lineto
+554 115 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 554 122 moveto
+564 118 lineto
+554 115 lineto
+closepath
+stroke
+end grestore
+
+%	Clenv -> Coercion
+newpath 170 107 moveto
+183 100 200 93 215 85 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 217 88 moveto
+224 80 lineto
+214 82 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 217 88 moveto
+224 80 lineto
+214 82 lineto
+closepath
+stroke
+end grestore
+endpage
+showpage
+grestore
+%%PageTrailer
+%%EndPage: 1
+%%Trailer
+%%Pages: 1
+end
+restore
+%%EOF
diff --git a/dev/doc/proofs.dep.ps b/dev/doc/proofs.dep.ps
new file mode 100644
index 00000000..0e78f422
--- /dev/null
+++ b/dev/doc/proofs.dep.ps
@@ -0,0 +1,638 @@
+%!PS-Adobe-2.0
+%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005)
+%%For: (herbelin) Hugo Herbelin
+%%Title: G
+%%Pages: (atend)
+%%BoundingBox: 35 35 577 136
+%%EndComments
+save
+%%BeginProlog
+/DotDict 200 dict def
+DotDict begin
+
+/setupLatin1 {
+mark
+/EncodingVector 256 array def
+ EncodingVector 0
+
+ISOLatin1Encoding 0 255 getinterval putinterval
+
+EncodingVector
+  dup 306 /AE
+  dup 301 /Aacute
+  dup 302 /Acircumflex
+  dup 304 /Adieresis
+  dup 300 /Agrave
+  dup 305 /Aring
+  dup 303 /Atilde
+  dup 307 /Ccedilla
+  dup 311 /Eacute
+  dup 312 /Ecircumflex
+  dup 313 /Edieresis
+  dup 310 /Egrave
+  dup 315 /Iacute
+  dup 316 /Icircumflex
+  dup 317 /Idieresis
+  dup 314 /Igrave
+  dup 334 /Udieresis
+  dup 335 /Yacute
+  dup 376 /thorn
+  dup 337 /germandbls
+  dup 341 /aacute
+  dup 342 /acircumflex
+  dup 344 /adieresis
+  dup 346 /ae
+  dup 340 /agrave
+  dup 345 /aring
+  dup 347 /ccedilla
+  dup 351 /eacute
+  dup 352 /ecircumflex
+  dup 353 /edieresis
+  dup 350 /egrave
+  dup 355 /iacute
+  dup 356 /icircumflex
+  dup 357 /idieresis
+  dup 354 /igrave
+  dup 360 /dcroat
+  dup 361 /ntilde
+  dup 363 /oacute
+  dup 364 /ocircumflex
+  dup 366 /odieresis
+  dup 362 /ograve
+  dup 365 /otilde
+  dup 370 /oslash
+  dup 372 /uacute
+  dup 373 /ucircumflex
+  dup 374 /udieresis
+  dup 371 /ugrave
+  dup 375 /yacute
+  dup 377 /ydieresis  
+
+% Set up ISO Latin 1 character encoding
+/starnetISO {
+        dup dup findfont dup length dict begin
+        { 1 index /FID ne { def }{ pop pop } ifelse
+        } forall
+        /Encoding EncodingVector def
+        currentdict end definefont
+} def
+/Times-Roman starnetISO def
+/Times-Italic starnetISO def
+/Times-Bold starnetISO def
+/Times-BoldItalic starnetISO def
+/Helvetica starnetISO def
+/Helvetica-Oblique starnetISO def
+/Helvetica-Bold starnetISO def
+/Helvetica-BoldOblique starnetISO def
+/Courier starnetISO def
+/Courier-Oblique starnetISO def
+/Courier-Bold starnetISO def
+/Courier-BoldOblique starnetISO def
+cleartomark
+} bind def
+
+%%BeginResource: procset graphviz 0 0
+/coord-font-family /Times-Roman def
+/default-font-family /Times-Roman def
+/coordfont coord-font-family findfont 8 scalefont def
+
+/InvScaleFactor 1.0 def
+/set_scale {
+	dup 1 exch div /InvScaleFactor exch def
+	dup scale
+} bind def
+
+% styles
+/solid { [] 0 setdash } bind def
+/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
+/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
+/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
+/bold { 2 setlinewidth } bind def
+/filled { } bind def
+/unfilled { } bind def
+/rounded { } bind def
+/diagonals { } bind def
+
+% hooks for setting color 
+/nodecolor { sethsbcolor } bind def
+/edgecolor { sethsbcolor } bind def
+/graphcolor { sethsbcolor } bind def
+/nopcolor {pop pop pop} bind def
+
+/beginpage {	% i j npages
+	/npages exch def
+	/j exch def
+	/i exch def
+	/str 10 string def
+	npages 1 gt {
+		gsave
+			coordfont setfont
+			0 0 moveto
+			(\() show i str cvs show (,) show j str cvs show (\)) show
+		grestore
+	} if
+} bind def
+
+/set_font {
+	findfont exch
+	scalefont setfont
+} def
+
+% draw aligned label in bounding box aligned to current point
+/alignedtext {			% width adj text
+	/text exch def
+	/adj exch def
+	/width exch def
+	gsave
+		width 0 gt {
+			text stringwidth pop adj mul 0 rmoveto
+		} if
+		[] 0 setdash
+		text show
+	grestore
+} def
+
+/boxprim {				% xcorner ycorner xsize ysize
+		4 2 roll
+		moveto
+		2 copy
+		exch 0 rlineto
+		0 exch rlineto
+		pop neg 0 rlineto
+		closepath
+} bind def
+
+/ellipse_path {
+	/ry exch def
+	/rx exch def
+	/y exch def
+	/x exch def
+	matrix currentmatrix
+	newpath
+	x y translate
+	rx ry scale
+	0 0 1 0 360 arc
+	setmatrix
+} bind def
+
+/endpage { showpage } bind def
+/showpage { } def
+
+/layercolorseq
+	[	% layer color sequence - darkest to lightest
+		[0 0 0]
+		[.2 .8 .8]
+		[.4 .8 .8]
+		[.6 .8 .8]
+		[.8 .8 .8]
+	]
+def
+
+/layerlen layercolorseq length def
+
+/setlayer {/maxlayer exch def /curlayer exch def
+	layercolorseq curlayer 1 sub layerlen mod get
+	aload pop sethsbcolor
+	/nodecolor {nopcolor} def
+	/edgecolor {nopcolor} def
+	/graphcolor {nopcolor} def
+} bind def
+
+/onlayer { curlayer ne {invis} if } def
+
+/onlayers {
+	/myupper exch def
+	/mylower exch def
+	curlayer mylower lt
+	curlayer myupper gt
+	or
+	{invis} if
+} def
+
+/curlayer 0 def
+
+%%EndResource
+%%EndProlog
+%%BeginSetup
+14 default-font-family set_font
+1 setmiterlimit
+% /arrowlength 10 def
+% /arrowwidth 5 def
+
+% make sure pdfmark is harmless for PS-interpreters other than Distiller
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+% make '<<' and '>>' safe on PS Level 1 devices
+/languagelevel where {pop languagelevel}{1} ifelse
+2 lt {
+    userdict (<<) cvn ([) cvn load put
+    userdict (>>) cvn ([) cvn load put
+} if
+
+%%EndSetup
+%%Page: 1 1
+%%PageBoundingBox: 36 36 577 136
+%%PageOrientation: Portrait
+gsave
+35 35 542 101 boxprim clip newpath
+36 36 translate
+0 0 1 beginpage
+0.6923 set_scale
+0 0 translate 0 rotate
+0.000 0.000 0.000 graphcolor
+14.00 /Times-Roman set_font
+
+%	Tactic_debug
+gsave 10 dict begin
+163 72 51 18 ellipse_path
+stroke
+gsave 10 dict begin
+125 67 moveto
+(Tactic_debug)
+[7.44 6.24 6.24 3.84 3.84 6.24 6.96 6.96 6.24 6.96 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Refiner
+gsave 10 dict begin
+287 72 34 18 ellipse_path
+stroke
+gsave 10 dict begin
+266 67 moveto
+(Refiner)
+[9.12 6.24 4.8 3.84 6.96 6.24 4.56]
+xshow
+end grestore
+end grestore
+
+%	Tactic_debug -> Refiner
+newpath 214 72 moveto
+223 72 233 72 243 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 243 76 moveto
+253 72 lineto
+243 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 243 76 moveto
+253 72 lineto
+243 69 lineto
+closepath
+stroke
+end grestore
+
+%	Logic
+gsave 10 dict begin
+390 72 30 18 ellipse_path
+stroke
+gsave 10 dict begin
+373 67 moveto
+(Logic)
+[8.4 6.96 6.96 3.84 6.24]
+xshow
+end grestore
+end grestore
+
+%	Refiner -> Logic
+newpath 321 72 moveto
+330 72 340 72 350 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 350 76 moveto
+360 72 lineto
+350 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 350 76 moveto
+360 72 lineto
+350 69 lineto
+closepath
+stroke
+end grestore
+
+%	Tacmach
+gsave 10 dict begin
+163 126 38 18 ellipse_path
+stroke
+gsave 10 dict begin
+137 121 moveto
+(Tacmach)
+[7.44 6.24 6.24 10.8 6.24 6 6.96]
+xshow
+end grestore
+end grestore
+
+%	Tacmach -> Refiner
+newpath 191 114 moveto
+209 106 232 96 251 88 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 253 91 moveto
+261 84 lineto
+250 84 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 253 91 moveto
+261 84 lineto
+250 84 lineto
+closepath
+stroke
+end grestore
+
+%	Redexpr
+gsave 10 dict begin
+287 126 36 18 ellipse_path
+stroke
+gsave 10 dict begin
+263 121 moveto
+(Redexpr)
+[9.12 6.24 6.96 5.76 6.96 6.96 4.56]
+xshow
+end grestore
+end grestore
+
+%	Tacmach -> Redexpr
+newpath 202 126 moveto
+214 126 227 126 240 126 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 240 130 moveto
+250 126 lineto
+240 123 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 240 130 moveto
+250 126 lineto
+240 123 lineto
+closepath
+stroke
+end grestore
+
+%	Proof_trees
+gsave 10 dict begin
+502 72 45 18 ellipse_path
+stroke
+gsave 10 dict begin
+469 67 moveto
+(Proof_trees)
+[7.68 4.56 6.96 6.96 4.56 6.96 3.84 4.56 6.24 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Logic -> Proof_trees
+newpath 420 72 moveto
+428 72 437 72 446 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 446 76 moveto
+456 72 lineto
+446 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 446 76 moveto
+456 72 lineto
+446 69 lineto
+closepath
+stroke
+end grestore
+
+%	Proof_type
+gsave 10 dict begin
+628 72 44 18 ellipse_path
+stroke
+gsave 10 dict begin
+597 67 moveto
+(Proof_type)
+[7.68 4.56 6.96 6.96 4.56 6.96 3.84 6.96 6.96 6.24]
+xshow
+end grestore
+end grestore
+
+%	Tacexpr
+gsave 10 dict begin
+744 72 35 18 ellipse_path
+stroke
+gsave 10 dict begin
+721 67 moveto
+(Tacexpr)
+[7.44 6.24 6.24 5.76 6.96 6.96 4.56]
+xshow
+end grestore
+end grestore
+
+%	Proof_type -> Tacexpr
+newpath 672 72 moveto
+680 72 689 72 698 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 698 76 moveto
+708 72 lineto
+698 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 698 76 moveto
+708 72 lineto
+698 69 lineto
+closepath
+stroke
+end grestore
+
+%	Proof_trees -> Proof_type
+newpath 548 72 moveto
+557 72 565 72 574 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 574 76 moveto
+584 72 lineto
+574 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 574 76 moveto
+584 72 lineto
+574 69 lineto
+closepath
+stroke
+end grestore
+
+%	Pfedit
+gsave 10 dict begin
+38 112 29 18 ellipse_path
+stroke
+gsave 10 dict begin
+21 107 moveto
+(Pfedit)
+[7.68 4.08 6.24 6.96 3.84 3.84]
+xshow
+end grestore
+end grestore
+
+%	Pfedit -> Tacmach
+newpath 67 115 moveto
+81 117 99 118 115 120 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 115 123 moveto
+125 122 lineto
+116 117 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 115 123 moveto
+125 122 lineto
+116 117 lineto
+closepath
+stroke
+end grestore
+
+%	Evar_refiner
+gsave 10 dict begin
+163 18 49 18 ellipse_path
+stroke
+gsave 10 dict begin
+127 13 moveto
+(Evar_refiner)
+[8.4 6.72 6.24 4.56 6.96 4.56 6.24 4.8 3.84 6.96 6.24 4.56]
+xshow
+end grestore
+end grestore
+
+%	Pfedit -> Evar_refiner
+newpath 53 96 moveto
+67 82 90 60 112 45 curveto
+116 42 120 40 124 37 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 126 40 moveto
+133 32 lineto
+123 34 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 126 40 moveto
+133 32 lineto
+123 34 lineto
+closepath
+stroke
+end grestore
+
+%	Evar_refiner -> Refiner
+newpath 195 32 moveto
+212 40 233 49 251 57 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 249 60 moveto
+260 61 lineto
+252 54 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 249 60 moveto
+260 61 lineto
+252 54 lineto
+closepath
+stroke
+end grestore
+
+%	Clenvtac
+gsave 10 dict begin
+38 45 38 18 ellipse_path
+stroke
+gsave 10 dict begin
+13 40 moveto
+(Clenvtac)
+[9.36 3.84 6.24 6.48 6.96 4.08 6.24 6.24]
+xshow
+end grestore
+end grestore
+
+%	Clenvtac -> Tacmach
+newpath 58 61 moveto
+73 72 93 87 112 99 curveto
+117 102 123 105 128 108 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 127 111 moveto
+137 113 lineto
+130 105 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 127 111 moveto
+137 113 lineto
+130 105 lineto
+closepath
+stroke
+end grestore
+
+%	Clenvtac -> Evar_refiner
+newpath 73 37 moveto
+85 35 98 32 110 29 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 111 32 moveto
+120 27 lineto
+110 26 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 111 32 moveto
+120 27 lineto
+110 26 lineto
+closepath
+stroke
+end grestore
+endpage
+showpage
+grestore
+%%PageTrailer
+%%EndPage: 1
+%%Trailer
+%%Pages: 1
+end
+restore
+%%EOF
diff --git a/dev/doc/syntax-v8.tex b/dev/doc/syntax-v8.tex
new file mode 100644
index 00000000..97973df2
--- /dev/null
+++ b/dev/doc/syntax-v8.tex
@@ -0,0 +1,1268 @@
+
+\documentclass{article}
+
+\usepackage{verbatim}
+\usepackage{amsmath}
+\usepackage{amssymb}
+\usepackage{array}
+\usepackage{fullpage}
+
+\author{B.~Barras}
+\title{Syntax of Coq V8}
+
+%% Le _ est un caractère normal
+\catcode`\_=13
+\let\subscr=_
+\def_{\ifmmode\sb\else\subscr\fi}
+
+\def\bfbar{\ensuremath{|\hskip -0.22em{}|\hskip -0.24em{}|}}
+\def\TERMbar{\bfbar}
+\def\TERMbarbar{\bfbar\bfbar}
+\def\notv{\text{_}}
+\def\infx#1{\notv#1\notv}
+
+
+%% Macros pour les grammaires
+\def\GR#1{\text{\large(}#1\text{\large)}}
+\def\NT#1{\langle\textit{#1}\rangle}
+\def\NTL#1#2{\langle\textit{#1}\rangle_{#2}}
+\def\TERM#1{{\bf\textrm{\bf #1}}}
+%\def\TERM#1{{\bf\textsf{#1}}}
+\def\KWD#1{\TERM{#1}}
+\def\ETERM#1{\TERM{#1}}
+\def\CHAR#1{\TERM{#1}}
+
+\def\STAR#1{#1*}
+\def\STARGR#1{\GR{#1}*}
+\def\PLUS#1{#1+}
+\def\PLUSGR#1{\GR{#1}+}
+\def\OPT#1{#1?}
+\def\OPTGR#1{\GR{#1}?}
+%% Tableaux de definition de non-terminaux
+\newenvironment{cadre}
+        {\begin{array}{|c|}\hline\\}
+        {\\\\\hline\end{array}}
+\newenvironment{rulebox}
+        {$$\begin{cadre}\begin{array}{r@{~}c@{~}l@{}l@{}r}}
+        {\end{array}\end{cadre}$$}
+\def\DEFNT#1{\NT{#1} & ::= &}
+\def\EXTNT#1{\NT{#1} & ::= & ... \\&|&}
+\def\RNAME#1{(\textsc{#1})}
+\def\SEPDEF{\\\\}
+\def\nlsep{\\&|&}
+\def\nlcont{\\&&}
+\newenvironment{rules}
+        {\begin{center}\begin{rulebox}}
+        {\end{rulebox}\end{center}}
+
+\begin{document}
+
+\maketitle
+
+\section{Meta notations used in this document}
+
+Non-terminals are printed between angle brackets (e.g. $\NT{non-terminal}$) and
+terminal symbols are printed in bold font (e.g. $\ETERM{terminal}$). Lexemes
+are displayed as non-terminals.
+
+The usual operators on regular expressions:
+\begin{center}
+\begin{tabular}{l|l}
+\hfil notation & \hfil  meaning \\
+\hline
+$\STAR{regexp}$ & repeat $regexp$ 0 or more times \\
+$\PLUS{regexp}$ & repeat $regexp$ 1 or more times \\
+$\OPT{regexp}$ & $regexp$ is optional \\
+$regexp_1~\mid~regexp_2$ & alternative
+\end{tabular}
+\end{center}
+
+Parenthesis are used to group regexps. Beware to distinguish this operator
+$\GR{~}$ from the terminals $\ETERM{( )}$, and $\mid$ from terminal
+\TERMbar.
+
+Rules are optionaly annotated in the right margin with:
+\begin{itemize}
+\item a precedence and associativity (L for left, R for right and N for no associativity), indicating how to solve conflicts;
+  lower levels are tighter;
+\item a rule name.
+\end{itemize}
+In order to solve some conflicts, a non-terminal may be invoked with a
+precedence (notation: $\NTL{entry}{prec}$), meaning that rules with higher
+precedence do not apply.
+
+\section{Lexical conventions}
+
+Lexical categories are:
+\begin{rules}
+\DEFNT{ident}
+     \STARGR{\NT{letter}\mid\CHAR{_}}
+     \STARGR{\NT{letter}\mid \NT{digit} \mid \CHAR{'} \mid \CHAR{_}}
+\SEPDEF
+\DEFNT{field}       \CHAR{.}\NT{ident}
+\SEPDEF
+\DEFNT{meta-ident}  \CHAR{?}\NT{ident}   
+\SEPDEF
+\DEFNT{num}         \PLUS{\NT{digit}}
+\SEPDEF
+\DEFNT{int}         \NT{num} \mid \CHAR{-}\NT{num}
+\SEPDEF
+\DEFNT{digit}       \CHAR{0}-\CHAR{9}
+\SEPDEF
+\DEFNT{letter}      \CHAR{a}-\CHAR{z}\mid\CHAR{A}-\CHAR{Z}
+                    \mid\NT{unicode-letter}
+
+\SEPDEF
+\DEFNT{string}      \CHAR{"}~\STARGR{\CHAR{""}\mid\NT{unicode-char-but-"}}~\CHAR{"}
+\end{rules}
+
+Reserved identifiers for the core syntax are:
+\begin{quote}
+\KWD{as},
+\KWD{cofix},
+\KWD{else},
+\KWD{end},
+\KWD{fix},
+\KWD{for},
+\KWD{forall},
+\KWD{fun},
+\KWD{if},
+\KWD{in},
+\KWD{let},
+\KWD{match}, 
+\KWD{Prop},
+\KWD{return}, 
+\KWD{Set},
+\KWD{then},
+\KWD{Type},
+\KWD{with}  
+\end{quote}
+
+Symbols used in the core syntax:
+$$ \KWD{(}
+~~ \KWD{)}
+~~ \KWD{\{}
+~~ \KWD{\}}
+~~ \KWD{:}
+~~ \KWD{,}
+~~ \Rightarrow
+~~ \rightarrow
+~~ \KWD{:=}
+~~ \KWD{_}
+~~ \TERMbar
+~~ \KWD{@}
+~~ \KWD{\%}
+~~ \KWD{.(}
+$$
+
+Note that \TERM{struct} is not a reserved identifier.
+
+\section{Syntax of terms}
+
+\subsection{Core syntax}
+
+The main entry point of the term grammar is $\NTL{constr}{9}$. When no
+conflict can appear, $\NTL{constr}{200}$ is also used as entry point.
+
+\begin{rules}
+\DEFNT{constr}
+       \NT{binder-constr}                             &200R~~ &\RNAME{binders}
+\nlsep \NT{constr}~\KWD{:}~\NT{constr}                &100R &\RNAME{cast}
+\nlsep \NT{constr}~\KWD{:}~\NT{binder-constr}         &100R &\RNAME{cast'}
+\nlsep \NT{constr}~\KWD{$\rightarrow$}~\NT{constr}    &80R  &\RNAME{arrow}
+\nlsep \NT{constr}~\KWD{$\rightarrow$}~\NT{binder-constr} &80R &\RNAME{arrow'}
+\nlsep \NT{constr}~\PLUS{\NT{appl-arg}}               &10L  &\RNAME{apply}
+\nlsep \KWD{@}~\NT{reference}~\STAR{\NTL{constr}{9}}  &10L  &\RNAME{expl-apply}
+\nlsep \NT{constr}~\KWD{.(}
+       ~\NT{reference}~\STAR{\NT{appl-arg}}~\TERM{)}  &1L & \RNAME{proj}
+\nlsep \NT{constr}~\KWD{.(}~\TERM{@}
+       ~\NT{reference}~\STAR{\NTL{constr}{9}}~\TERM{)} &1L & \RNAME{expl-proj}
+\nlsep \NT{constr} ~ \KWD{\%} ~ \NT{ident}            &1L   &\RNAME{scope-chg}
+\nlsep \NT{atomic-constr}                             &0
+\nlsep \NT{match-expr}                                &0
+\nlsep \KWD{(}~\NT{constr}~\KWD{)}                    &0
+\SEPDEF
+\DEFNT{binder-constr}
+       \KWD{forall}~\NT{binder-list}~\KWD{,}~\NTL{constr}{200} 
+          &&\RNAME{prod}
+\nlsep \KWD{fun} ~\NT{binder-list} ~\KWD{$\Rightarrow$}~\NTL{constr}{200}
+          &&\RNAME{lambda}
+\nlsep \NT{fix-expr}
+\nlsep \KWD{let}~\NT{ident-with-params} ~\KWD{:=}~\NTL{constr}{200}
+       ~\KWD{in}~\NTL{constr}{200}  &&\RNAME{let}
+\nlsep \KWD{let}~\NT{single-fix} ~\KWD{in}~\NTL{constr}{200}
+          &&\RNAME{rec-let}
+\nlsep \KWD{let}~\KWD{(}~\OPT{\NT{let-pattern}}~\KWD{)}~\OPT{\NT{return-type}}
+       ~\KWD{:=}~\NTL{constr}{200}~\KWD{in}~\NTL{constr}{200}
+          &&\RNAME{let-case}
+\nlsep \KWD{if}~\NT{if-item}
+       ~\KWD{then}~\NTL{constr}{200}~\KWD{else}~\NTL{constr}{200}
+          &&\RNAME{if-case}
+\SEPDEF
+\DEFNT{appl-arg}
+       \KWD{(}~\NT{ident}~\!\KWD{:=}~\NTL{constr}{200}~\KWD{)}
+          &&\RNAME{impl-arg}
+\nlsep \KWD{(}~\NT{num}~\!\KWD{:=}~\NTL{constr}{200}~\KWD{)}
+          &&\RNAME{impl-arg}
+\nlsep \NTL{constr}{9}
+\SEPDEF
+\DEFNT{atomic-constr}
+       \NT{reference}     && \RNAME{variables}
+\nlsep \NT{sort}          && \RNAME{CIC-sort}
+\nlsep \NT{num}           && \RNAME{number}
+\nlsep \KWD{_}            && \RNAME{hole}
+\nlsep \NT{meta-ident}    && \RNAME{meta/evar}
+\end{rules}
+
+
+
+\begin{rules}
+\DEFNT{ident-with-params}
+       \NT{ident}~\STAR{\NT{binder-let}}~\NT{type-cstr}
+\SEPDEF
+\DEFNT{binder-list}
+       \NT{binder}~\STAR{\NT{binder-let}}
+\nlsep \PLUS{\NT{name}}~\KWD{:}~\NT{constr}
+\SEPDEF
+\DEFNT{binder}
+       \NT{name}      &&\RNAME{infer}
+\nlsep \KWD{(}~\PLUS{\NT{name}}~\KWD{:}~\NT{constr}
+       ~\KWD{)}      &&\RNAME{binder}
+\SEPDEF
+\DEFNT{binder-let}
+       \NT{binder}
+\nlsep \KWD{(}~\NT{name}~\NT{type-cstr}~\KWD{:=}~\NT{constr}~\KWD{)}
+\SEPDEF
+\DEFNT{let-pattern}
+       \NT{name}
+\nlsep \NT{name} ~\KWD{,} ~\NT{let-pattern}
+\SEPDEF
+\DEFNT{type-cstr}
+       \OPTGR{\KWD{:}~\NT{constr}}
+\SEPDEF
+\DEFNT{reference}
+       \NT{ident}                   && \RNAME{short-ident}
+\nlsep \NT{ident}~\PLUS{\NT{field}} && \RNAME{qualid}
+\SEPDEF
+\DEFNT{sort}
+       \KWD{Prop} ~\mid~ \KWD{Set} ~\mid~ \KWD{Type}
+\SEPDEF
+\DEFNT{name}
+       \NT{ident} ~\mid~ \KWD{_}
+\end{rules}
+
+\begin{rules}
+\DEFNT{fix-expr}
+       \NT{single-fix}
+\nlsep \NT{single-fix}~\PLUSGR{\KWD{with}~\NT{fix-decl}}
+      ~\KWD{for}~\NT{ident}
+\SEPDEF
+\DEFNT{single-fix}
+       \NT{fix-kw}~\NT{fix-decl}
+\SEPDEF
+\DEFNT{fix-kw} \KWD{fix} ~\mid~ \KWD{cofix}
+\SEPDEF
+\DEFNT{fix-decl}
+       \NT{ident}~\STAR{\NT{binder-let}}~\OPT{\NT{annot}}~\NT{type-cstr}
+       ~\KWD{:=}~\NTL{constr}{200}
+\SEPDEF
+\DEFNT{annot}
+       \KWD{\{}~\TERM{struct}~\NT{ident}~\KWD{\}}
+\end{rules}
+
+
+\begin{rules}
+\DEFNT{match-expr}
+       \KWD{match}~\NT{match-items}~\OPT{\NT{return-type}}~\KWD{with}
+  ~\OPT{\TERMbar}~\OPT{\NT{branches}}~\KWD{end}        &&\RNAME{match}
+\SEPDEF
+\DEFNT{match-items}
+       \NT{match-item} ~\KWD{,} ~\NT{match-items}
+\nlsep \NT{match-item}
+\SEPDEF
+\DEFNT{match-item}
+       \NTL{constr}{100}~\OPTGR{\KWD{as}~\NT{name}}
+       ~\OPTGR{\KWD{in}~\NTL{constr}{100}}
+\SEPDEF
+\DEFNT{return-type}
+       \KWD{return}~\NTL{constr}{100}
+\SEPDEF
+\DEFNT{if-item}
+       \NT{constr}~\OPTGR{\OPTGR{\KWD{as}~\NT{name}}~\NT{return-type}}
+\SEPDEF
+\DEFNT{branches}
+       \NT{eqn}~\TERMbar~\NT{branches}
+\nlsep \NT{eqn}
+\SEPDEF
+\DEFNT{eqn}
+       \NT{pattern} ~\STARGR{\KWD{,}~\NT{pattern}}
+       ~\KWD{$\Rightarrow$}~\NT{constr}
+\SEPDEF
+\DEFNT{pattern}
+       \NT{reference}~\PLUS{\NT{pattern}}  &1L~~ & \RNAME{constructor}
+\nlsep \NT{pattern}~\KWD{as}~\NT{ident}    &1L & \RNAME{alias}
+\nlsep \NT{pattern}~\KWD{\%}~\NT{ident}    &1L & \RNAME{scope-change}
+\nlsep \NT{reference}                      &0  & \RNAME{pattern-var}
+\nlsep \KWD{_}                             &0  & \RNAME{hole}
+\nlsep \NT{num}                            &0
+\nlsep \KWD{(}~\NT{tuple-pattern}~\KWD{)}
+\SEPDEF
+\DEFNT{tuple-pattern}
+       \NT{pattern}
+\nlsep \NT{tuple-pattern}~\KWD{,}~\NT{pattern} && \RNAME{pair}
+\end{rules}
+
+\subsection{Notations of the prelude (logic and basic arithmetic)}
+
+Reserved notations:
+
+$$
+\begin{array}{l|c}
+\text{Symbol} & \text{precedence} \\
+\hline
+\infx{,}             & 250L \\
+\KWD{IF}~\notv~\KWD{then}~\notv~\KWD{else}~\notv
+                     & 200R \\
+\infx{:}             & 100R \\
+\infx{\leftrightarrow} & 95N \\
+\infx{\rightarrow}   & 90R \\
+\infx{\vee}          & 85R \\
+\infx{\wedge}        & 80R \\
+\tilde{}\notv        & 75R \\
+\begin{array}[c]{@{}l@{}}
+ \infx{=}\quad \infx{=}\KWD{$:>$}\notv \quad \infx{=}=\notv
+ \quad \infx{\neq} \quad  \infx{\neq}\KWD{$:>$}\notv \\
+ \infx{<}\quad\infx{>} \quad \infx{\leq}\quad\infx{\geq}
+ \quad \infx{<}<\notv \quad \infx{<}\leq\notv
+ \quad \infx{\leq}<\notv \quad \infx{\leq}\leq\notv
+\end{array}          & 70N \\
+\infx{+}\quad\infx{-}\quad -\notv   & 50L \\
+\infx{*}\quad\infx{/}\quad /\notv   & 40L \\
+\end{array}
+$$
+
+Existential quantifiers follows the \KWD{forall} notation (with same
+precedence 200), but only one quantified variable is allowed.
+
+\begin{rules}
+\EXTNT{binder-constr}
+       \NT{quantifier-kwd}~\NT{name}~\NT{type-cstr}~\KWD{,}~\NTL{constr}{200} \\
+\SEPDEF
+\DEFNT{quantifier-kwd}
+       \TERM{exists} && \RNAME{ex}
+\nlsep \TERM{exists2} && \RNAME{ex2}
+\end{rules}
+
+$$
+\begin{array}{l|c|l}
+\text{Symbol} & \text{precedence} \\
+\hline
+\notv+\{\notv\}                            & 50 & \RNAME{sumor} \\
+\{\notv:\notv~|~\notv\}                    & 0 & \RNAME{sig} \\
+\{\notv:\notv~|~\notv \& \notv \}          & 0 & \RNAME{sig2} \\
+\{\notv:\notv~\&~\notv \}                  & 0 & \RNAME{sigS} \\
+\{\notv:\notv~\&~\notv \& \notv \}         & 0 & \RNAME{sigS2} \\
+\{\notv\}+\{\notv\}                        & 0 & \RNAME{sumbool} \\
+\end{array}
+$$
+
+%% Strange: nat + {x:nat|x=x} * nat  == ( + ) *
+
+\section{Grammar of tactics}
+
+\def\tacconstr{\NTL{constr}{9}}
+\def\taclconstr{\NTL{constr}{200}}
+
+Additional symbols are:
+$$ \TERM{'}
+~~ \KWD{;}
+~~ \TERM{()}
+~~ \TERMbarbar
+~~ \TERM{$\vdash$}
+~~ \TERM{[}
+~~ \TERM{]}
+~~ \TERM{$\leftarrow$}
+$$
+Additional reserved keywords are:
+$$ \KWD{at}
+~~ \TERM{using}
+$$
+
+\subsection{Basic tactics}
+
+\begin{rules}
+\DEFNT{simple-tactic}
+       \TERM{intros}~\TERM{until}~\NT{quantified-hyp}
+\nlsep \TERM{intros}~\NT{intro-patterns}
+\nlsep \TERM{intro}~\OPT{\NT{ident}}~\OPTGR{\TERM{after}~\NT{ident}}
+%%
+\nlsep \TERM{assumption}
+\nlsep \TERM{exact}~\tacconstr
+%%
+\nlsep \TERM{apply}~\NT{constr-with-bindings}
+\nlsep \TERM{elim}~\NT{constr-with-bindings}~\OPT{\NT{eliminator}}
+\nlsep \TERM{elimtype}~\tacconstr
+\nlsep \TERM{case}~\NT{constr-with-bindings}
+\nlsep \TERM{casetype}~\tacconstr
+\nlsep \KWD{fix}~\OPT{\NT{ident}}~\NT{num}
+\nlsep \KWD{fix}~\NT{ident}~\NT{num}~\KWD{with}~\PLUS{\NT{fix-spec}}
+\nlsep \KWD{cofix}~\OPT{\NT{ident}}
+\nlsep \KWD{cofix}~\NT{ident}~\PLUS{\NT{fix-spec}}
+%%
+\nlsep \TERM{cut}~\tacconstr
+\nlsep \TERM{assert}~\tacconstr
+\nlsep \TERM{assert}~
+  \TERM{(}~\NT{ident}~\KWD{:}~\taclconstr~\TERM{)}
+\nlsep \TERM{assert}~
+  \TERM{(}~\NT{ident}~\KWD{:=}~\taclconstr~\TERM{)}
+\nlsep \TERM{pose}~\tacconstr
+\nlsep \TERM{pose}~
+  \TERM{(}~\NT{ident}~\KWD{:=}~\taclconstr~\TERM{)}
+\nlsep \TERM{generalize}~\PLUS{\tacconstr}
+\nlsep \TERM{generalize}~\TERM{dependent}~\tacconstr
+\nlsep \TERM{set}~\tacconstr~\OPT{\NT{clause}}
+\nlsep \TERM{set}~
+  \TERM{(}~\NT{ident}~\KWD{:=}~\taclconstr~\TERM{)}~\OPT{\NT{clause}}
+\nlsep \TERM{instantiate}~
+  \TERM{(}~\NT{num}~\TERM{:=}~\taclconstr~\TERM{)}~\OPT{\NT{clause}}
+%%
+\nlsep \TERM{specialize}~\OPT{\NT{num}}~\NT{constr-with-bindings}
+\nlsep \TERM{lapply}~\tacconstr
+%%
+\nlsep \TERM{simple}~\TERM{induction}~\NT{quantified-hyp}
+\nlsep \TERM{induction}~\NT{induction-arg}~\OPT{\NT{with-names}}
+       ~\OPT{\NT{eliminator}}
+\nlsep \TERM{double}~\TERM{induction}~\NT{quantified-hyp}~\NT{quantified-hyp}
+\nlsep \TERM{simple}~\TERM{destruct}~\NT{quantified-hyp}
+\nlsep \TERM{destruct}~\NT{induction-arg}~\OPT{\NT{with-names}}
+       ~\OPT{\NT{eliminator}}
+\nlsep \TERM{decompose}~\TERM{record}~\tacconstr
+\nlsep \TERM{decompose}~\TERM{sum}~\tacconstr
+\nlsep \TERM{decompose}~\TERM{[}~\PLUS{\NT{reference}}~\TERM{]}
+       ~\tacconstr
+%%
+\nlsep ...
+\end{rules}
+
+\begin{rules}
+\EXTNT{simple-tactic}
+       \TERM{trivial}~\OPT{\NT{hint-bases}}
+\nlsep \TERM{auto}~\OPT{\NT{num}}~\OPT{\NT{hint-bases}}
+%%
+%%\nlsep \TERM{autotdb}~\OPT{\NT{num}}
+%%\nlsep \TERM{cdhyp}~\NT{ident}
+%%\nlsep \TERM{dhyp}~\NT{ident}
+%%\nlsep \TERM{dconcl}
+%%\nlsep \TERM{superauto}~\NT{auto-args}
+\nlsep \TERM{auto}~\OPT{\NT{num}}~\TERM{decomp}~\OPT{\NT{num}}
+%%
+\nlsep \TERM{clear}~\PLUS{\NT{ident}}
+\nlsep \TERM{clearbody}~\PLUS{\NT{ident}}
+\nlsep \TERM{move}~\NT{ident}~\TERM{after}~\NT{ident}
+\nlsep \TERM{rename}~\NT{ident}~\TERM{into}~\NT{ident}
+%%
+\nlsep \TERM{left}~\OPT{\NT{with-binding-list}}
+\nlsep \TERM{right}~\OPT{\NT{with-binding-list}}
+\nlsep \TERM{split}~\OPT{\NT{with-binding-list}}
+\nlsep \TERM{exists}~\OPT{\NT{binding-list}}
+\nlsep \TERM{constructor}~\NT{num}~\OPT{\NT{with-binding-list}}
+\nlsep \TERM{constructor}~\OPT{\NT{tactic}}
+%%
+\nlsep \TERM{reflexivity}
+\nlsep \TERM{symmetry}~\OPTGR{\KWD{in}~\NT{ident}}
+\nlsep \TERM{transitivity}~\tacconstr
+%%
+\nlsep \NT{inversion-kwd}~\NT{quantified-hyp}~\OPT{\NT{with-names}}~\OPT{\NT{clause}}
+\nlsep \TERM{dependent}~\NT{inversion-kwd}~\NT{quantified-hyp}
+  ~\OPT{\NT{with-names}}~\OPTGR{\KWD{with}~\tacconstr}
+\nlsep \TERM{inversion}~\NT{quantified-hyp}~\TERM{using}~\tacconstr~\OPT{\NT{clause}}
+%%
+\nlsep \NT{red-expr}~\OPT{\NT{clause}}
+\nlsep \TERM{change}~\NT{conversion}~\OPT{\NT{clause}}
+\SEPDEF
+\DEFNT{red-expr}
+       \TERM{red} ~\mid~ \TERM{hnf} ~\mid~ \TERM{compute}
+\nlsep \TERM{simpl}~\OPT{\NT{pattern-occ}}
+\nlsep \TERM{cbv}~\PLUS{\NT{red-flag}}
+\nlsep \TERM{lazy}~\PLUS{\NT{red-flag}}
+\nlsep \TERM{unfold}~\NT{unfold-occ}~\STARGR{\KWD{,}~\NT{unfold-occ}}
+\nlsep \TERM{fold}~\PLUS{\tacconstr}
+\nlsep \TERM{pattern}~\NT{pattern-occ}~\STARGR{\KWD{,}~\NT{pattern-occ}}
+\SEPDEF
+\DEFNT{conversion}
+       \NT{pattern-occ}~\KWD{with}~\tacconstr
+\nlsep \tacconstr
+\SEPDEF
+\DEFNT{inversion-kwd}
+       \TERM{inversion} ~\mid~ \TERM{invesion_clear} ~\mid~
+       \TERM{simple}~\TERM{inversion}
+\end{rules}
+
+Conflicts exists between integers and constrs.
+
+\begin{rules}
+\DEFNT{quantified-hyp}
+       \NT{int}~\mid~\NT{ident}
+\SEPDEF
+\DEFNT{induction-arg}
+       \NT{int}~\mid~\tacconstr
+\SEPDEF
+\DEFNT{fix-spec}
+       \KWD{(}~\NT{ident}~\STAR{\NT{binder}}~\OPT{\NT{annot}}
+       ~\KWD{:}~\taclconstr~\KWD{)}
+\SEPDEF
+\DEFNT{intro-patterns}
+       \STAR{\NT{intro-pattern}}
+\SEPDEF
+\DEFNT{intro-pattern}
+       \NT{name}
+\nlsep \TERM{[}~\NT{intro-patterns}~\STARGR{\TERMbar~\NT{intro-patterns}}
+       ~\TERM{]}
+\nlsep \KWD{(}~\NT{intro-pattern}~\STARGR{\KWD{,}~\NT{intro-pattern}}
+       ~\KWD{)}
+\SEPDEF
+\DEFNT{with-names}
+%       \KWD{as}~\TERM{[}~\STAR{\NT{ident}}~\STARGR{\TERMbar~\STAR{\NT{ident}}}
+%       ~\TERM{]}
+       \KWD{as}~\NT{intro-pattern}
+\SEPDEF
+\DEFNT{eliminator}
+       \TERM{using}~\NT{constr-with-bindings}
+\SEPDEF
+\DEFNT{constr-with-bindings}
+       % dangling ``with'' of ``fix'' can conflict with ``with''
+       \tacconstr~\OPT{\NT{with-binding-list}}
+\SEPDEF
+\DEFNT{with-binding-list}
+       \KWD{with}~\NT{binding-list}
+\SEPDEF
+\DEFNT{binding-list}
+       \PLUS{\tacconstr}
+\nlsep \PLUS{\NT{simple-binding}}
+\SEPDEF
+\DEFNT{simple-binding}
+       \KWD{(}~\NT{quantified-hyp}~\KWD{:=}~\taclconstr~\KWD{)}
+\SEPDEF
+\DEFNT{red-flag}
+       \TERM{beta} ~\mid~ \TERM{iota} ~\mid~ \TERM{zeta}
+       ~\mid~ \TERM{delta} ~\mid~
+       \TERM{delta}~\OPT{\TERM{-}}~\TERM{[}~\PLUS{\NT{reference}}~\TERM{]}
+\SEPDEF
+\DEFNT{clause}
+       \KWD{in}~\TERM{*}
+\nlsep \KWD{in}~\TERM{*}~\KWD{$\vdash$}~\OPT{\NT{concl-occ}}
+\nlsep \KWD{in}~\OPT{\NT{hyp-ident-list}} ~\KWD{$\vdash$} ~\OPT{\NT{concl-occ}}
+\nlsep \KWD{in}~\OPT{\NT{hyp-ident-list}}
+\SEPDEF
+\DEFNT{hyp-ident-list}
+       \NT{hyp-ident}
+\nlsep \NT{hyp-ident}~\KWD{,}~\NT{hyp-ident-list}
+\SEPDEF
+\DEFNT{hyp-ident}
+       \NT{ident}
+\nlsep \KWD{(}~\TERM{type}~\TERM{of}~\NT{ident}~\KWD{)}
+\nlsep \KWD{(}~\TERM{value}~\TERM{of}~\NT{ident}~\KWD{)}
+\SEPDEF
+\DEFNT{concl-occ}
+       \TERM{*} ~\NT{occurrences}
+\SEPDEF
+\DEFNT{pattern-occ}
+       \tacconstr ~\NT{occurrences}
+\SEPDEF
+\DEFNT{unfold-occ}
+       \NT{reference}~\NT{occurrences}
+\SEPDEF
+\DEFNT{occurrences}
+       ~\OPTGR{\KWD{at}~\PLUS{\NT{int}}}
+\SEPDEF
+\DEFNT{hint-bases}
+       \KWD{with}~\TERM{*}
+\nlsep \KWD{with}~\PLUS{\NT{ident}}
+\SEPDEF
+\DEFNT{auto-args}
+       \OPT{\NT{num}}~\OPTGR{\TERM{adding}~\TERM{[}~\PLUS{\NT{reference}}
+       ~\TERM{]}}~\OPT{\TERM{destructuring}}~\OPTGR{\TERM{using}~\TERM{tdb}}
+\end{rules}
+
+\subsection{Ltac}
+
+%% Currently, there are conflicts with keyword \KWD{in}: in the following,
+%% has the keyword to be associated to \KWD{let} or to tactic \TERM{simpl} ?
+%% \begin{center}
+%% \texttt{let x := simpl in ...}
+%% \end{center}
+
+
+\begin{rules}
+\DEFNT{tactic}
+       \NT{tactic} ~\KWD{;} ~\NT{tactic}  &5 &\RNAME{Then}
+\nlsep \NT{tactic} ~\KWD{;}~\TERM{[} ~\OPT{\NT{tactic-seq}} ~\TERM{]}
+         &5 &\RNAME{Then-seq}
+%%
+\nlsep \TERM{try} ~\NT{tactic}     &3R &\RNAME{Try}
+\nlsep \TERM{do} ~\NT{int-or-var} ~\NT{tactic}
+\nlsep \TERM{repeat} ~\NT{tactic}
+\nlsep \TERM{progress} ~\NT{tactic}
+\nlsep \TERM{info} ~\NT{tactic}
+\nlsep \TERM{abstract}~\NTL{tactic}{2}~\OPTGR{\TERM{using}~\NT{ident}}
+%%
+\nlsep \NT{tactic} ~\TERMbarbar ~\NT{tactic} &2R &\RNAME{Orelse}
+%%
+\nlsep \KWD{fun} ~\PLUS{\NT{name}} ~\KWD{$\Rightarrow$}
+       ~\NT{tactic}  &1 &\RNAME{Fun-tac}
+\nlsep \KWD{let} ~\NT{let-clauses} ~\KWD{in} ~\NT{tactic}
+\nlsep \KWD{let} ~\TERM{rec} ~\NT{rec-clauses} ~\KWD{in} ~\NT{tactic}
+\nlsep \KWD{match}~\OPT{\TERM{reverse}}~\TERM{goal}~\KWD{with}
+       ~\OPT{\TERMbar}~\OPT{\NT{match-goal-rules}} ~\KWD{end}
+\nlsep \KWD{match} ~\NT{tactic} ~\KWD{with}
+       ~\OPT{\TERMbar}~\OPT{\NT{match-rules}} ~\KWD{end}
+\nlsep \TERM{first}~\TERM{[} ~\NT{tactic-seq} ~\TERM{]}
+\nlsep \TERM{solve}~\TERM{[} ~\NT{tactic-seq} ~\TERM{]}
+\nlsep \TERM{idtac}
+\nlsep \TERM{fail} ~\OPT{\NT{num}} ~\OPT{\NT{string}}
+\nlsep \TERM{constr}~\KWD{:}~\tacconstr
+\nlsep \TERM{ipattern}~\KWD{:}~\NT{intro-pattern}
+\nlsep \NT{term-ltac}
+\nlsep \NT{reference}~\STAR{\NT{tactic-arg}}  &&\RNAME{call-tactic}
+\nlsep \NT{simple-tactic}
+%%
+\nlsep \NT{tactic-atom}  &0 &\RNAME{atomic}
+\nlsep \KWD{(} ~\NT{tactic} ~\KWD{)}
+\SEPDEF
+\DEFNT{tactic-arg}
+       \TERM{ltac}~\KWD{:}~\NTL{tactic}{0}
+\nlsep \TERM{ipattern}~\KWD{:}~\NT{intro-pattern}
+\nlsep \NT{term-ltac}
+\nlsep \NT{tactic-atom}
+\nlsep \tacconstr
+\SEPDEF
+\DEFNT{term-ltac}
+       \TERM{fresh} ~\OPT{\NT{string}}
+\nlsep \TERM{context} ~\NT{ident} ~\TERM{[} ~\taclconstr ~\TERM{]}
+\nlsep \TERM{eval} ~\NT{red-expr} ~\KWD{in} ~\tacconstr
+\nlsep \TERM{type} ~\tacconstr
+\SEPDEF
+\DEFNT{tactic-atom}
+       \NT{reference}
+\nlsep \TERM{()}
+\SEPDEF
+\DEFNT{tactic-seq}
+       \NT{tactic} ~\TERMbar ~\NT{tactic-seq}
+\nlsep \NT{tactic}
+\end{rules}
+
+
+
+\begin{rules}
+\DEFNT{let-clauses}
+       \NT{let-clause} ~\STARGR{\KWD{with}~\NT{let-clause}}
+\SEPDEF
+\DEFNT{let-clause}
+       \NT{ident} ~\STAR{\NT{name}} ~\KWD{:=} ~\NT{tactic}
+\SEPDEF
+\DEFNT{rec-clauses}
+       \NT{rec-clause} ~\KWD{with} ~\NT{rec-clauses}
+\nlsep \NT{rec-clause}
+\SEPDEF
+\DEFNT{rec-clause}
+       \NT{ident} ~\PLUS{\NT{name}} ~\KWD{:=} ~\NT{tactic}
+\SEPDEF
+\DEFNT{match-goal-rules}
+       \NT{match-goal-rule}
+\nlsep \NT{match-goal-rule} ~\TERMbar ~\NT{match-goal-rules}
+\SEPDEF
+\DEFNT{match-goal-rule}
+       \NT{match-hyps-list} ~\TERM{$\vdash$} ~\NT{match-pattern}
+       ~\KWD{$\Rightarrow$} ~\NT{tactic}
+\nlsep \KWD{[}~\NT{match-hyps-list} ~\TERM{$\vdash$} ~\NT{match-pattern}
+       ~\KWD{]}~\KWD{$\Rightarrow$} ~\NT{tactic}
+\nlsep \KWD{_} ~\KWD{$\Rightarrow$} ~\NT{tactic}
+\SEPDEF
+\DEFNT{match-hyps-list}
+       \NT{match-hyps} ~\KWD{,} ~\NT{match-hyps-list}
+\nlsep \NT{match-hyps}
+\SEPDEF
+\DEFNT{match-hyps}
+       \NT{name} ~\KWD{:} ~\NT{match-pattern}
+\SEPDEF
+\DEFNT{match-rules}
+       \NT{match-rule}
+\nlsep \NT{match-rule} ~\TERMbar ~\NT{match-rules}
+\SEPDEF
+\DEFNT{match-rule}
+       \NT{match-pattern} ~\KWD{$\Rightarrow$} ~\NT{tactic}
+\nlsep \KWD{_} ~\KWD{$\Rightarrow$} ~\NT{tactic}
+\SEPDEF
+\DEFNT{match-pattern}
+       \TERM{context}~\OPT{\NT{ident}}
+       ~\TERM{[} ~\NT{constr-pattern} ~\TERM{]}  &&\RNAME{subterm}
+\nlsep \NT{constr-pattern}
+\SEPDEF
+\DEFNT{constr-pattern}
+       \tacconstr
+\end{rules}
+
+\subsection{Other tactics}
+
+\begin{rules}
+\EXTNT{simple-tactic}
+       \TERM{rewrite} ~\NT{orient} ~\NT{constr-with-bindings}
+         ~\OPTGR{\KWD{in}~\NT{ident}}
+\nlsep \TERM{replace} ~\tacconstr ~\KWD{with} ~\tacconstr
+         ~\OPTGR{\KWD{in}~\NT{ident}}
+\nlsep \TERM{replace} ~\OPT{\NT{orient}} ~\tacconstr
+         ~\OPTGR{\KWD{in}~\NT{ident}}
+\nlsep \TERM{symplify_eq} ~\OPT{\NT{quantified-hyp}}
+\nlsep \TERM{discriminate} ~\OPT{\NT{quantified-hyp}}
+\nlsep \TERM{injection} ~\OPT{\NT{quantified-hyp}}
+\nlsep \TERM{conditional}~\NT{tactic}~\TERM{rewrite}~\NT{orient}
+         ~\NT{constr-with-bindings}~\OPTGR{\KWD{in}~\NT{ident}}
+\nlsep \TERM{dependent}~\TERM{rewrite}~\NT{orient}~\NT{ident}
+\nlsep \TERM{cutrewrite}~\NT{orient}~\tacconstr
+         ~\OPTGR{\KWD{in}~\NT{ident}}
+\nlsep \TERM{absurd} ~\tacconstr
+\nlsep \TERM{contradiction}
+\nlsep \TERM{autorewrite}~\NT{hint-bases}~\OPTGR{\KWD{using}~\NT{tactic}}
+\nlsep \TERM{refine}~\tacconstr
+\nlsep \TERM{setoid_replace} ~\tacconstr ~\KWD{with} ~\tacconstr
+\nlsep \TERM{setoid_rewrite} ~\NT{orient} ~\tacconstr
+\nlsep \TERM{subst} ~\STAR{\NT{ident}}
+%% eqdecide.ml4
+\nlsep \TERM{decide}~\TERM{equality} ~\OPTGR{\tacconstr~\tacconstr}
+\nlsep \TERM{compare}~\tacconstr~\tacconstr
+%% eauto
+\nlsep \TERM{eexact}~\tacconstr
+\nlsep \TERM{eapply}~\NT{constr-with-bindings}
+\nlsep \TERM{prolog}~\TERM{[}~\STAR{\tacconstr}~\TERM{]}
+         ~\NT{quantified-hyp}
+\nlsep \TERM{eauto}~\OPT{\NT{quantified-hyp}}~\OPT{\NT{quantified-hyp}}
+         ~\NT{hint-bases}
+\nlsep \TERM{eautod}~\OPT{\NT{quantified-hyp}}~\OPT{\NT{quantified-hyp}}
+         ~\NT{hint-bases}
+%% tauto
+\nlsep \TERM{tauto}
+\nlsep \TERM{simplif}
+\nlsep \TERM{intuition}~\OPT{\NTL{tactic}{0}}
+\nlsep \TERM{linearintuition}~\OPT{\NT{num}}
+%% contrib/cc
+\nlsep \TERM{cc}
+%% contrib/field
+\nlsep \TERM{field}~\STAR{\tacconstr}
+%% contrib/first-order
+\nlsep \TERM{ground}~\OPT{\NTL{tactic}{0}}
+\nlsep \TERM{ground}~\OPT{\NTL{tactic}{0}}~\KWD{with}~\PLUS{\NT{reference}}
+\nlsep \TERM{ground}~\OPT{\NTL{tactic}{0}}~\KWD{using}~\PLUS{\NT{ident}}
+%%\nlsep \TERM{gtauto}
+\nlsep \TERM{gintuition}~\OPT{\NTL{tactic}{0}}
+%% contrib/fourier
+\nlsep \TERM{fourierZ}
+%% contrib/funind
+\nlsep \TERM{functional}~\TERM{induction}~\tacconstr~\PLUS{\tacconstr}
+%% contrib/jprover
+\nlsep \TERM{jp}~\OPT{\NT{num}}
+%% contrib/omega
+\nlsep \TERM{omega}
+%% contrib/ring
+\nlsep \TERM{quote}~\NT{ident}~\OPTGR{\KWD{[}~\PLUS{\NT{ident}}~\KWD{]}}
+\nlsep \TERM{ring}~\STAR{\tacconstr}
+%% contrib/romega
+\nlsep \TERM{romega}
+\SEPDEF
+\DEFNT{orient}
+       \KWD{$\rightarrow$}~\mid~\KWD{$\leftarrow$}
+\end{rules}
+
+\section{Grammar of commands}
+
+New symbols:
+$$ \TERM{.}
+~~ \TERM{..}
+~~ \TERM{\tt >->}
+~~ \TERM{:$>$}
+~~ \TERM{$<$:}
+$$
+
+New keyword:
+$$ \KWD{where}
+$$
+
+\subsection{Classification of commands}
+
+\begin{rules}
+\DEFNT{vernac}
+       \TERM{Time}~\NT{vernac}  &2~~ &\RNAME{Timing}
+%%
+\nlsep \NT{gallina}~\TERM{.}    &1
+\nlsep \NT{command}~\TERM{.}
+\nlsep \NT{syntax}~\TERM{.}
+\nlsep \TERM{[}~\PLUS{\NT{vernac}}~\TERM{]}~\TERM{.}
+%%
+\nlsep \OPTGR{\NT{num}~\KWD{:}}~\NT{subgoal-command}~\TERM{.} ~~~&0
+\SEPDEF
+\DEFNT{subgoal-command}
+       \NT{check-command}
+\nlsep %\OPT{\TERM{By}}~
+   \NT{tactic}~\OPT{\KWD{..}}
+\end{rules}
+
+\subsection{Gallina and extensions}
+
+\begin{rules}
+\DEFNT{gallina}
+       \NT{thm-token}~\NT{ident}~\STAR{\NT{binder-let}}~\KWD{:}~\NT{constr}
+\nlsep \NT{def-token}~\NT{ident}~\NT{def-body}
+\nlsep \NT{assum-token}~\NT{assum-list}
+\nlsep \NT{finite-token}~\NT{inductive-definition}
+      ~\STARGR{\KWD{with}~\NT{inductive-definition}}
+\nlsep \TERM{Fixpoint}~\NT{fix-decl}~\STARGR{\KWD{with}~\NT{fix-decl}}
+\nlsep \TERM{CoFixpoint}~\NT{fix-decl}~\STARGR{\KWD{with}~\NT{fix-decl}}
+\nlsep \TERM{Scheme}~\NT{scheme}~\STARGR{\KWD{with}~\NT{scheme}}
+%% Extension: record
+\nlsep \NT{record-tok}~\OPT{\TERM{$>$}}~\NT{ident}~\STAR{\NT{binder-let}}
+       ~\KWD{:}~\NT{constr}~\KWD{:=}
+       ~\OPT{\NT{ident}}~\KWD{\{}~\NT{field-list}~\KWD{\}}
+\nlsep \TERM{Ltac}~\NT{ltac-def}~\STARGR{~\TERM{with}~\NT{ltac-def}}
+\end{rules}
+
+\begin{rules}
+\DEFNT{thm-token}
+   \TERM{Theorem} ~\mid~ \TERM{Lemma} ~\mid~ \TERM{Fact} ~\mid~ \TERM{Remark}
+\SEPDEF
+\DEFNT{def-token}
+   \TERM{Definition} ~\mid~ \TERM{Let} ~\mid~
+   \OPT{\TERM{Local}}~\TERM{SubClass}
+\SEPDEF
+\DEFNT{assum-token}
+    \TERM{Hypothesis} ~\mid~ \TERM{Variable} ~\mid~ \TERM{Axiom} ~\mid~
+    \TERM{Parameter}
+\SEPDEF
+\DEFNT{finite-token}
+    \TERM{Inductive} ~\mid~ \TERM{CoInductive}
+\SEPDEF
+\DEFNT{record-tok}
+    \TERM{Record} ~\mid~ \TERM{Structure}
+\end{rules}
+
+
+\begin{rules}
+\DEFNT{def-body}
+       \STAR{\NT{binder-let}}~\NT{type-cstr}~\KWD{:=}
+       ~\OPT{\NT{reduce}}~\NT{constr}
+\nlsep \STAR{\NT{binder-let}}~\KWD{:}~\NT{constr}
+\SEPDEF
+\DEFNT{reduce}
+       \TERM{Eval}~\NT{red-expr}~\KWD{in}
+\SEPDEF
+\DEFNT{ltac-def}
+       \NT{ident}~\STAR{\NT{name}}~\KWD{:=}~\NT{tactic}
+\SEPDEF
+\DEFNT{rec-definition}
+       \NT{fix-decl}~\OPT{\NT{decl-notation}}
+\SEPDEF
+\DEFNT{inductive-definition}
+       \OPT{\NT{string}}~\NT{ident}~\STAR{\NT{binder-let}}~\KWD{:}
+       ~\NT{constr}~\KWD{:=}
+       ~\OPT{\TERMbar}~\OPT{\NT{constructor-list}}
+       ~\OPT{\NT{decl-notation}}
+\SEPDEF
+\DEFNT{constructor-list}
+       \NT{constructor}~\TERMbar~\NT{constructor-list}
+\nlsep \NT{constructor}
+\SEPDEF
+\DEFNT{constructor}
+       \NT{ident}~\STAR{\NT{binder-let}}\OPTGR{\NT{coerce-kwd}~\NT{constr}}
+\SEPDEF
+\DEFNT{decl-notation}
+       \TERM{where}~\NT{string}~\TERM{:=}~\NT{constr}
+\SEPDEF
+\DEFNT{field-list}
+       \NT{field}~\KWD{;}~\NT{field-list}
+\nlsep \NT{field}
+\SEPDEF
+\DEFNT{field}
+       \NT{ident}~\OPTGR{\NT{coerce-kwd}~\NT{constr}}
+\nlsep \NT{ident}~\NT{type-cstr-coe}~\KWD{:=}~\NT{constr}
+\SEPDEF
+\DEFNT{assum-list}
+       \PLUS{\GR{\KWD{(}~\NT{simple-assum-coe}~\KWD{)}}}
+\nlsep \NT{simple-assum-coe}
+\SEPDEF
+\DEFNT{simple-assum-coe}
+       \PLUS{\NT{ident}}~\NT{coerce-kwd}~\NT{constr}
+\SEPDEF
+\DEFNT{coerce-kwd} \TERM{:$>$} ~\mid~ \KWD{:}
+\SEPDEF
+\DEFNT{type-cstr-coe} \OPTGR{\NT{coerce-kwd}~\NT{constr}}
+\SEPDEF
+\DEFNT{scheme}
+       \NT{ident}~\KWD{:=}~\NT{dep-scheme}~\KWD{for}~\NT{reference}
+       ~\TERM{Sort}~\NT{sort}
+\SEPDEF
+\DEFNT{dep-scheme}
+       \TERM{Induction}~\mid~\TERM{Minimality}
+\end{rules}
+
+\subsection{Modules and sections}
+
+\begin{rules}
+\DEFNT{gallina}
+       \TERM{Module}~\NT{ident}~\STAR{\NT{mbinder}}~\OPT{\NT{of-mod-type}}
+       ~\OPTGR{\KWD{:=}~\NT{mod-expr}}
+\nlsep \TERM{Module}~\KWD{Type}~\NT{ident}~\STAR{\NT{mbinder}}
+       ~\OPTGR{\KWD{:=}~\NT{mod-type}}
+\nlsep \TERM{Declare}~\TERM{Module}~\NT{ident}~\STAR{\NT{mbinder}}
+       ~\OPT{\NT{of-mod-type}}
+       ~\OPTGR{\KWD{:=}~\NT{mod-expr}}
+\nlsep \TERM{Section}~\NT{ident}
+\nlsep \TERM{Chapter}~\NT{ident}
+\nlsep \TERM{End}~\NT{ident}
+%%
+\nlsep \TERM{Require}~\OPT{\NT{export-token}}~\OPT{\NT{specif-token}}
+       ~\PLUS{\NT{reference}}
+\nlsep \TERM{Require}~\OPT{\NT{export-token}}~\OPT{\NT{specif-token}}
+       ~\NT{string}
+\nlsep \TERM{Import}~\PLUS{\NT{reference}}
+\nlsep \TERM{Export}~\PLUS{\NT{reference}}
+\SEPDEF
+\DEFNT{export-token}
+       \TERM{Import} ~\mid~ \TERM{Export}
+\SEPDEF
+\DEFNT{specif-token}
+       \TERM{Implementation} ~\mid~ \TERM{Specification}
+\SEPDEF
+\DEFNT{mod-expr}
+       \NT{reference}
+\nlsep \NT{mod-expr}~\NT{mod-expr} & L
+\nlsep \KWD{(}~\NT{mod-expr}~\KWD{)}
+\SEPDEF
+\DEFNT{mod-type}
+       \NT{reference}
+\nlsep \NT{mod-type}~\KWD{with}~\NT{with-declaration}
+\SEPDEF
+\DEFNT{with-declaration}
+                                                          %on forcera les ( )
+                                                          %si exceptionnellemt
+                                                          %un fixpoint ici
+       \TERM{Definition}~\NT{ident}~\KWD{:=}~\NTL{constr}{} %{100}
+\nlsep \TERM{Module}~\NT{ident}~\KWD{:=}~\NT{reference}
+\SEPDEF
+\DEFNT{of-mod-type}
+       \KWD{:}~\NT{mod-type}
+\nlsep \TERM{$<$:}~\NT{mod-type}
+\SEPDEF
+\DEFNT{mbinder}
+       \KWD{(}~\PLUS{\NT{ident}}~\KWD{:}~\NT{mod-type}~\KWD{)}
+\end{rules}
+
+\begin{rules}
+\DEFNT{gallina}
+       \TERM{Transparent}~\PLUS{\NT{reference}}
+\nlsep \TERM{Opaque}~\PLUS{\NT{reference}}
+\nlsep \TERM{Canonical}~\TERM{Structure}~\NT{reference}~\OPT{\NT{def-body}}
+\nlsep \TERM{Coercion}~\OPT{\TERM{Local}}~\NT{reference}~\NT{def-body}
+\nlsep \TERM{Coercion}~\OPT{\TERM{Local}}~\NT{reference}~\KWD{:}
+       ~\NT{class-rawexpr}~\TERM{$>->$}~\NT{class-rawexpr}
+\nlsep \TERM{Identity}~\TERM{Coercion}~\OPT{\TERM{Local}}~\NT{ident}~\KWD{:}
+       ~\NT{class-rawexpr}~\TERM{$>->$}~\NT{class-rawexpr}
+\nlsep \TERM{Implicit}~\TERM{Arguments}~\NT{reference}~\TERM{[}~\STAR{\NT{num}}~\TERM{]}
+\nlsep \TERM{Implicit}~\TERM{Arguments}~\NT{reference}
+\nlsep \TERM{Implicit}~\KWD{Type}~\PLUS{\NT{ident}}~\KWD{:}~\NT{constr}
+\SEPDEF
+\DEFNT{command}
+       \TERM{Comments}~\STAR{\NT{comment}}
+\nlsep \TERM{Pwd}
+\nlsep \TERM{Cd}~\OPT{\NT{string}}
+\nlsep \TERM{Drop} ~\mid~ \TERM{ProtectedLoop} ~\mid~\TERM{Quit}
+%%
+\nlsep \TERM{Load}~\OPT{\TERM{Verbose}}~\NT{ident}
+\nlsep \TERM{Load}~\OPT{\TERM{Verbose}}~\NT{string}
+\nlsep \TERM{Declare}~\TERM{ML}~\TERM{Module}~\PLUS{\NT{string}}
+\nlsep \TERM{Dump}~\TERM{Universes}~\OPT{\NT{string}}
+\nlsep \TERM{Locate}~\NT{locatable}
+\nlsep \TERM{Add}~\OPT{\TERM{Rec}}~\TERM{LoadPath}~\NT{string}~\OPT{\NT{as-dirpath}}
+\nlsep \TERM{Remove}~\TERM{LoadPath}~\NT{string}
+\nlsep \TERM{Add}~\OPT{\TERM{Rec}}~\TERM{ML}~\TERM{Path}~\NT{string}
+%%
+\nlsep \KWD{Type}~\NT{constr}
+\nlsep \TERM{Print}~\NT{printable}
+\nlsep \TERM{Print}~\NT{reference}
+\nlsep \TERM{Inspect}~\NT{num}
+\nlsep \TERM{About}~\NT{reference}
+%%
+\nlsep \TERM{Search}~\NT{reference}~\OPT{\NT{in-out-modules}}
+\nlsep \TERM{SearchPattern}~\NT{constr-pattern}~\OPT{\NT{in-out-modules}}
+\nlsep \TERM{SearchRewrite}~\NT{constr-pattern}~\OPT{\NT{in-out-modules}}
+\nlsep \TERM{SearchAbout}~\NT{reference}~\OPT{\NT{in-out-modules}}
+\nlsep \TERM{SearchAbout}~\TERM{[}~\STAR{\NT{ref-or-string}}~\TERM{]}\OPT{\NT{in-out-modules}}
+\nlsep \KWD{Set}~\NT{ident}~\OPT{\NT{opt-value}}
+\nlsep \TERM{Unset}~\NT{ident}
+\nlsep \KWD{Set}~\NT{ident}~\NT{ident}~\OPT{\NT{opt-value}}
+\nlsep \KWD{Set}~\NT{ident}~\NT{ident}~\PLUS{\NT{opt-ref-value}}
+\nlsep \TERM{Unset}~\NT{ident}~\NT{ident}~\STAR{\NT{opt-ref-value}}
+%%
+\nlsep \TERM{Print}~\TERM{Table}~\NT{ident}~\NT{ident}
+\nlsep \TERM{Print}~\TERM{Table}~\NT{ident}
+\nlsep \TERM{Add}~\NT{ident}~\OPT{\NT{ident}}~\PLUS{\NT{opt-ref-value}}
+%%
+\nlsep \TERM{Test}~\NT{ident}~\OPT{\NT{ident}}~\STAR{\NT{opt-ref-value}}
+%%
+\nlsep \TERM{Remove}~\NT{ident}~\OPT{\NT{ident}}~\PLUS{\NT{opt-ref-value}}
+\SEPDEF
+\DEFNT{check-command}
+       \TERM{Eval}~\NT{red-expr}~\KWD{in}~\NT{constr}
+\nlsep \TERM{Check}~\NT{constr}
+\SEPDEF
+\DEFNT{ref-or-string}
+       \NT{reference}
+\nlsep \NT{string}
+\end{rules}
+
+\begin{rules}
+\DEFNT{printable}
+       \TERM{Term}~\NT{reference}
+\nlsep \TERM{All}
+\nlsep \TERM{Section}~\NT{reference}
+\nlsep \TERM{Grammar}~\NT{ident}
+\nlsep \TERM{LoadPath}
+\nlsep \TERM{Module}~\OPT{\KWD{Type}}~\NT{reference}
+\nlsep \TERM{Modules}
+\nlsep \TERM{ML}~\TERM{Path}
+\nlsep \TERM{ML}~\TERM{Modules}
+\nlsep \TERM{Graph}
+\nlsep \TERM{Classes}
+\nlsep \TERM{Coercions}
+\nlsep \TERM{Coercion}~\TERM{Paths}~\NT{class-rawexpr}~\NT{class-rawexpr}
+\nlsep \TERM{Tables}
+% \nlsep \TERM{Proof}~\NT{reference}  % Obsolete, useful in V6.3 ??
+\nlsep \TERM{Hint}~\OPT{\NT{reference}}
+\nlsep \TERM{Hint}~\TERM{*}
+\nlsep \TERM{HintDb}~\NT{ident}
+\nlsep \TERM{Scopes}
+\nlsep \TERM{Scope}~\NT{ident}
+\nlsep \TERM{Visibility}~\OPT{\NT{ident}}
+\nlsep \TERM{Implicit}~\NT{reference}
+\SEPDEF
+\DEFNT{class-rawexpr}
+       \TERM{Funclass}~\mid~\TERM{Sortclass}~\mid~\NT{reference}
+\SEPDEF
+\DEFNT{locatable}
+       \NT{reference}
+\nlsep \TERM{File}~\NT{string}
+\nlsep \TERM{Library}~\NT{reference}
+\nlsep \NT{string}
+\SEPDEF
+\DEFNT{opt-value}
+       \NT{ident} ~\mid~ \NT{string}
+\SEPDEF
+\DEFNT{opt-ref-value}
+       \NT{reference} ~\mid~ \NT{string}
+\SEPDEF
+\DEFNT{as-dirpath}
+       \KWD{as}~\NT{reference}
+\SEPDEF
+\DEFNT{in-out-modules}
+       \TERM{inside}~\PLUS{\NT{reference}}
+\nlsep \TERM{outside}~\PLUS{\NT{reference}}
+\SEPDEF
+\DEFNT{comment}
+       \NT{constr}
+\nlsep \NT{string}
+\end{rules}
+
+\subsection{Other commands}
+
+%% TODO: min/maj pas a jour
+\begin{rules}
+\EXTNT{command}
+       \TERM{Debug}~\TERM{On}
+\nlsep \TERM{Debug}~\TERM{Off}
+%% TODO: vernac
+\nlsep \TERM{Add}~\TERM{setoid}~\tacconstr~\tacconstr~\tacconstr
+\nlsep \TERM{Add}~\TERM{morphism}~\tacconstr~\KWD{:}~\NT{ident}
+\nlsep \TERM{Derive}~\TERM{inversion_clear}
+         ~\OPT{\NT{num}}~\NT{ident}~\NT{ident}
+\nlsep \TERM{Derive}~\TERM{inversion_clear}
+         ~\NT{ident}~\KWD{with}~\tacconstr~\OPTGR{\TERM{Sort}~\NT{sort}}
+\nlsep \TERM{Derive}~\TERM{inversion}
+         ~\OPT{\NT{num}}~\NT{ident}~\NT{ident}
+\nlsep \TERM{Derive}~\TERM{inversion}
+         ~\NT{ident}~\KWD{with}~\tacconstr~\OPTGR{\TERM{Sort}~\NT{sort}}
+\nlsep \TERM{Derive}~\TERM{dependent}~\TERM{inversion_clear}
+         ~\NT{ident}~\KWD{with}~\tacconstr~\OPTGR{\TERM{Sort}~\NT{sort}}
+\nlsep \TERM{Derive}~\TERM{dependent}~\TERM{inversion}
+         ~\NT{ident}~\KWD{with}~\tacconstr~\OPTGR{\TERM{Sort}~\NT{sort}}
+%% Correctness: obsolete ?
+%\nlsep Correctness
+%\nlsep Global Variable
+%% TODO: extraction
+\nlsep Extraction ...
+%% field
+\nlsep \TERM{Add}~\TERM{Field}~\tacconstr~\tacconstr~\tacconstr
+         ~\tacconstr~\tacconstr~\tacconstr
+\nlcont~~~~\tacconstr~\tacconstr~\OPT{\NT{minus-div}}
+%% funind
+\nlsep \TERM{Functional}~\TERM{Scheme}~\NT{ident}~\KWD{:=}
+         ~\TERM{Induction}~\KWD{for}~\tacconstr
+         ~\OPTGR{\KWD{with}~\PLUS{\tacconstr}}
+%% ring
+\nlsep \TERM{Add}~\TERM{Ring}~\tacconstr~\tacconstr~\tacconstr
+         ~\tacconstr~\tacconstr~\tacconstr
+\nlcont~~~~\tacconstr~\tacconstr~\KWD{[}~\PLUS{\tacconstr}~\KWD{]}
+\nlsep \TERM{Add}~\TERM{Semi}~\TERM{Ring}~\tacconstr~\tacconstr~\tacconstr
+         ~\tacconstr~\tacconstr~\tacconstr
+\nlcont~~~~\tacconstr~\KWD{[}~\PLUS{\tacconstr}~\KWD{]}
+\nlsep \TERM{Add}~\TERM{Abstract}~\TERM{Ring}~\tacconstr~\tacconstr~\tacconstr
+         ~\tacconstr~\tacconstr~\tacconstr
+\nlcont~~~~\tacconstr~\tacconstr
+\nlsep \TERM{Add}~\TERM{Abstract}~\TERM{Semi}~\TERM{Ring}~\tacconstr
+         ~\tacconstr~\tacconstr~\tacconstr~\tacconstr~\tacconstr
+\nlcont~~~~\tacconstr
+\nlsep \TERM{Add}~\TERM{Setoid}~\TERM{Ring}~\tacconstr~\tacconstr~\tacconstr
+         ~\tacconstr~\tacconstr~\tacconstr
+\nlcont~~~~\tacconstr~\tacconstr~\tacconstr~\tacconstr~\tacconstr~\tacconstr
+         ~\tacconstr~\KWD{[}~\PLUS{\tacconstr}~\KWD{]}
+\nlsep \TERM{Add}~\TERM{Setoid}~\TERM{Semi}~\TERM{Ring}~\tacconstr~\tacconstr
+         ~\tacconstr~\tacconstr~\tacconstr~\tacconstr
+\nlcont~~~~\tacconstr~\tacconstr~\tacconstr~\tacconstr~\tacconstr
+         ~\KWD{[}~\PLUS{tacconstr}~\KWD{]}
+\SEPDEF
+\DEFNT{minus-div}
+       \KWD{with}~\NT{minus-arg}~\NT{div-arg}
+\nlsep \KWD{with}~\NT{div-arg}~\NT{minus-arg}
+\SEPDEF
+\DEFNT{minus-arg}
+       \TERM{minus}~\KWD{:=}~\tacconstr
+\SEPDEF
+\DEFNT{div-arg}
+       \TERM{div}~\KWD{:=}~\tacconstr
+\end{rules}
+
+\begin{rules}
+\EXTNT{command}
+       \TERM{Write}~\TERM{State}~\NT{ident}
+\nlsep \TERM{Write}~\TERM{State}~\NT{string}
+\nlsep \TERM{Restore}~\TERM{State}~\NT{ident}
+\nlsep \TERM{Restore}~\TERM{State}~\NT{string}
+\nlsep \TERM{Reset}~\NT{ident}
+\nlsep \TERM{Reset}~\TERM{Initial}
+\nlsep \TERM{Back}~\OPT{\NT{num}}
+\end{rules}
+
+\subsection{Proof-editing commands}
+
+\begin{rules}
+\EXTNT{command}
+       \TERM{Goal}~\NT{constr}
+\nlsep \TERM{Proof}~\OPT{\NT{constr}}
+\nlsep \TERM{Proof}~\KWD{with}~\NT{tactic}
+\nlsep \TERM{Abort}~\OPT{\TERM{All}}
+\nlsep \TERM{Abort}~\NT{ident}
+\nlsep \TERM{Existential}~\NT{num}~\KWD{:=}~\NT{constr-body}
+\nlsep \TERM{Qed}
+\nlsep \TERM{Save}~\OPTGR{\NT{thm-token}~\NT{ident}}
+\nlsep \TERM{Defined}~\OPT{\NT{ident}}
+\nlsep \TERM{Suspend}
+\nlsep \TERM{Resume}~\OPT{\NT{ident}}
+\nlsep \TERM{Restart}
+\nlsep \TERM{Undo}~\OPT{\NT{num}}
+\nlsep \TERM{Focus}~\OPT{\NT{num}}
+\nlsep \TERM{Unfocus}
+\nlsep \TERM{Show}~\OPT{\NT{num}}
+\nlsep \TERM{Show}~\TERM{Implicit}~\TERM{Arguments}~\OPT{\NT{num}}
+\nlsep \TERM{Show}~\TERM{Node}
+\nlsep \TERM{Show}~\TERM{Script}
+\nlsep \TERM{Show}~\TERM{Existentials}
+\nlsep \TERM{Show}~\TERM{Tree}
+\nlsep \TERM{Show}~\TERM{Conjecture}
+\nlsep \TERM{Show}~\TERM{Proof}
+\nlsep \TERM{Show}~\TERM{Intro}
+\nlsep \TERM{Show}~\TERM{Intros}
+%% Correctness: obsolete ?
+%%\nlsep \TERM{Show}~\TERM{Programs}
+\nlsep \TERM{Explain}~\TERM{Proof}~\OPT{\TERM{Tree}}~\STAR{\NT{num}}
+%% Go not documented
+\nlsep \TERM{Hint}~\OPT{\TERM{Local}}~\NT{hint}~\OPT{\NT{inbases}}
+%% PrintConstr not documented
+\end{rules}
+
+
+\begin{rules}
+\DEFNT{constr-body}
+       \NT{type-cstr}~\KWD{:=}~\NT{constr}
+\SEPDEF
+\DEFNT{hint}
+       \TERM{Resolve}~\PLUS{\NTL{constr}{9}}
+\nlsep \TERM{Immediate}~\PLUS{\NTL{constr}{9}}
+\nlsep \TERM{Unfold}~\PLUS{\NT{reference}}
+\nlsep \TERM{Constructors}~\PLUS{\NT{reference}}
+\nlsep \TERM{Extern}~\NT{num}~\NT{constr}~\KWD{$\Rightarrow$}~\NT{tactic}
+\nlsep \TERM{Destruct}~\NT{ident}~\KWD{:=}~\NT{num}~\NT{destruct-loc}
+       ~\NT{constr}~\KWD{$\Rightarrow$}~\NT{tactic}
+\nlsep \TERM{Rewrite}~\NT{orient}~\PLUS{\NTL{constr}{9}}
+       ~\OPTGR{\KWD{using}~\NT{tactic}}
+\SEPDEF
+\DEFNT{inbases}
+       \KWD{:}~\PLUS{\NT{ident}}
+\SEPDEF
+\DEFNT{destruct-loc}
+       \TERM{Conclusion}
+\nlsep \OPT{\TERM{Discardable}}~\TERM{Hypothesis}
+\end{rules}
+
+
+\subsection{Syntax extensions}
+
+\begin{rules}
+\DEFNT{syntax}
+       \TERM{Open}~\TERM{Scope}~\NT{ident}
+\nlsep \TERM{Close}~\TERM{Scope}~\NT{ident}
+\nlsep \TERM{Delimit}~\TERM{Scope}~\NT{ident}~\KWD{with}~\NT{ident}
+\nlsep \TERM{Bind}~\TERM{Scope}~\NT{ident}~\KWD{with}~\PLUS{\NT{class-rawexpr}}
+\nlsep \TERM{Arguments}~\TERM{Scope}~\NT{reference}
+       ~\TERM{[}~\PLUS{\NT{name}}~\TERM{]}
+\nlsep \TERM{Infix}~\OPT{\TERM{Local}} %%% ~\NT{prec}~\OPT{\NT{num}}
+       ~\NT{string}~\KWD{:=}~\NT{reference}~\OPT{\NT{modifiers}}
+       ~\OPT{\NT{in-scope}}
+\nlsep \TERM{Notation}~\OPT{\TERM{Local}}~\NT{string}~\KWD{:=}~\NT{constr}
+       ~\OPT{\NT{modifiers}}~\OPT{\NT{in-scope}}
+\nlsep \TERM{Notation}~\OPT{\TERM{Local}}~\NT{ident}~\KWD{:=}~\NT{constr}
+       ~\OPT{\KWD{(}\TERM{only~\TERM{parsing}\KWD{)}}}
+\nlsep \TERM{Reserved}~\TERM{Notation}~\OPT{\TERM{Local}}~\NT{string}
+       ~\OPT{\NT{modifiers}}
+\nlsep \TERM{Tactic}~\TERM{Notation}~\NT{string}~\STAR{\NT{tac-production}}
+       ~\KWD{:=}~\NT{tactic}
+\SEPDEF
+\DEFNT{modifiers}
+       \KWD{(}~\NT{mod-list}~\KWD{)}
+\SEPDEF
+\DEFNT{mod-list}
+       \NT{modifier}
+\nlsep \NT{modifier}~\KWD{,}~\NT{mod-list}
+\SEPDEF
+\DEFNT{modifier}
+       \NT{ident}~\KWD{at}~\NT{num}
+\nlsep \NT{ident}~\STARGR{\KWD{,}~\NT{ident}}~\KWD{at}~\NT{num}
+\nlsep \KWD{at}~\TERM{next}~\TERM{level}
+\nlsep \KWD{at}~\TERM{level}~\NT{num}
+\nlsep \TERM{left}~\TERM{associativity}
+\nlsep \TERM{right}~\TERM{associativity}
+\nlsep \TERM{no}~\TERM{associativity}
+\nlsep \NT{ident}~\NT{syntax-entry}
+\nlsep \TERM{only}~\TERM{parsing}
+\nlsep \TERM{format}~\NT{string}
+\SEPDEF
+\DEFNT{in-scope}
+       \KWD{:}~\NT{ident}
+\SEPDEF
+\DEFNT{syntax-entry}
+       \TERM{ident}~\mid~\TERM{global}~\mid~\TERM{bigint}
+\SEPDEF
+\DEFNT{tac-production}
+       \NT{string}
+\nlsep \NT{ident}~\TERM{(}~\NT{ident}~\TERM{)}
+%%% \SEPDEF
+%%% \DEFNT{prec}
+%%%       \TERM{LeftA}~\mid~\TERM{RightA}~\mid~\TERM{NonA}
+\end{rules}
+
+\end{document}
diff --git a/dev/doc/syntax.mly b/dev/doc/syntax.mly
new file mode 100644
index 00000000..bfc7d5cc
--- /dev/null
+++ b/dev/doc/syntax.mly
@@ -0,0 +1,224 @@
+%{
+open Ast
+open Parse
+%}
+
+%token <string> META INT IDENT
+%token <string> OPER
+%token LPAR RPAR BAR COMMA COLON BANG FUN DOT RARROW LET COLONEQ IN IF
+%token THEN ELSE EVAL AT FOR PROP SET TYPE WILDCARD FIX
+%token COFIX MATCH WITH END AND LBRACE RBRACE STRUCT AS SIMPL PERCENT
+%token EOF
+
+%start main
+%type <Ast.constr_ast> main
+
+%start constr
+%type <Ast.constr_ast> constr
+
+%start simple_constr
+%type <Ast.constr_ast> simple_constr
+
+%%
+
+main:
+          constr EOF { $1 }
+;
+
+
+paren_constr:
+          constr COMMA paren_constr  { Pair($1,$3) }
+        | constr                     { $1 }
+;
+
+constr:
+          binder_constr  { $1 }
+        | oper_constr    { close_stack $1 }
+;
+
+binder_constr:
+          BANG ne_binders DOT constr              { Prod($2, $4) }
+        | FUN ne_binders type_cstr RARROW constr  { Lambda($2,mk_cast $5 $3) }
+        | LET IDENT binders type_cstr COLONEQ constr IN constr
+            { Let($2,mk_lambda $3 (mk_cast $6 $4),$8) }
+        | LET LPAR comma_binders RPAR COLONEQ constr IN constr
+            { LetCase($3,$6,$8) }
+        | IF constr THEN constr ELSE constr       { IfCase($2,$4,$6) }
+        | fix_constr                              { $1 }
+        | EVAL rfun IN constr                     { Eval($2,$4) }
+;
+
+comma_binders:
+          ne_comma_binders  { $1 }
+        |                   { [] }
+;
+
+ne_comma_binders:
+          binder COMMA ne_comma_binders  { $1 :: $3 }
+        | binder                         { [$1] }
+;
+
+rfun:
+          SIMPL  { Simpl }
+;
+
+
+/* 2 Conflits shift/reduce */
+oper_constr:
+          oper_constr oper appl_constr
+            { parse_term $3 (parse_oper $2 $1) }
+        | oper_constr oper binder_constr
+            { parse_term $3 (parse_oper $2 $1) }
+        | oper_constr oper  { parse_oper $2 $1 }
+        |                   { empty }
+        | appl_constr       { parse_term $1 empty }
+;
+
+oper:
+          OPER {$1}
+        | COLON {":"}
+;
+
+appl_constr:
+          simple_constr ne_appl_args  { Appl($1,$2) }
+        | AT global simple_constrs    { ApplExpl($2,$3) }
+        | simple_constr               { $1 }
+;
+
+appl_arg:
+          AT INT COLONEQ simple_constr  { (Some $2,$4) }
+        | simple_constr                 { (None,$1) }
+;
+
+ne_appl_args:
+          appl_arg               { [$1] }
+        | appl_arg ne_appl_args  { $1::$2 }
+;
+
+simple_constr:
+          atomic_constr                           { $1 }
+        | match_constr                            { $1 }
+        | LPAR paren_constr RPAR                  { $2 }
+        | simple_constr PERCENT IDENT { Scope($3,$1) }
+;
+
+simple_constrs:
+          simple_constr simple_constrs  { $1::$2 }
+        |                               { [] }
+;
+
+atomic_constr:
+          global    { Qualid $1 }
+        | PROP      { Prop }
+        | SET       { Set }
+        | TYPE      { Type }
+        | INT       { Int $1 }
+        | WILDCARD  { Hole }
+        | META      { Meta $1 }
+;
+
+global:
+          IDENT DOT global  { $1 :: $3 }
+        | IDENT             { [$1] }
+;
+
+/* Conflit normal */
+fix_constr:
+          fix_kw fix_decl
+            { let (id,_,_,_,_ as fx) = $2 in Fixp($1,[fx],id) }
+        | fix_kw fix_decl fix_decls FOR IDENT  { Fixp($1, $2::$3, $5) }
+;
+
+fix_kw: FIX {Fix} | COFIX {CoFix}
+;
+
+fix_decl:
+          IDENT binders type_cstr annot COLONEQ constr  { ($1,$2,$3,$4,$6) }
+;
+
+fix_decls:
+          AND fix_decl fix_decls  { $2::$3 }
+        | AND fix_decl            { [$2] }
+;
+
+annot:
+          LBRACE STRUCT IDENT RBRACE  { Some $3 }
+        |                             { None }
+;
+
+match_constr:
+          MATCH case_items case_type WITH branches END  { Match($2,$3,$5) }
+;
+
+case_items:
+          case_item                   { [$1] }
+        | case_item COMMA case_items  { $1::$3 }
+;
+
+case_item:
+          constr pred_pattern { ($1,$2) }
+;
+
+case_type:
+          RARROW constr  { Some $2 }
+        |                { None }
+;
+
+pred_pattern:
+          AS IDENT COLON constr  { (Some $2, Some $4) }
+        | AS IDENT               { (Some $2, None) }
+        | COLON constr           { (None, Some $2) }
+        |                        { (None,None) }
+;
+
+branches:
+          BAR branch_list  { $2 }
+        | branch_list      { $1 }
+        |                  { [] }
+;
+
+branch_list:
+          patterns RARROW constr                  { [$1, $3] }
+        | patterns RARROW constr BAR branch_list  { ($1,$3)::$5 }
+;
+
+patterns:
+          pattern                 { [$1] }
+        | pattern COMMA patterns  { $1::$3 }
+;
+
+pattern:
+          pattern AS IDENT       { PatAs($1,$3) }
+        | pattern COLON constr   { PatType($1,$3) }
+        | IDENT simple_patterns  { PatConstr($1,$2) }
+        | simple_pattern         { $1 }
+;
+
+simple_pattern:
+          IDENT              { PatVar $1 }
+        | LPAR pattern RPAR  { $2 }
+;
+
+simple_patterns:
+          simple_pattern                  { [$1] }
+        | simple_pattern simple_patterns  { $1::$2 }
+;
+
+binder:
+          IDENT                 { ($1,Hole) }
+        | LPAR IDENT type_cstr RPAR  { ($2,$3) }
+;
+
+binders:
+          ne_binders  { $1 }
+        |             { [] }
+
+ne_binders:
+          binder             { [$1] }
+        | binder ne_binders  { $1::$2 }
+;
+
+type_cstr:
+          COLON constr  { $2 }
+        |               { Hole }
+;
diff --git a/dev/doc/tactics.dep.ps b/dev/doc/tactics.dep.ps
new file mode 100644
index 00000000..f4de22b7
--- /dev/null
+++ b/dev/doc/tactics.dep.ps
@@ -0,0 +1,991 @@
+%!PS-Adobe-2.0
+%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005)
+%%For: (herbelin) Hugo Herbelin
+%%Title: G
+%%Pages: (atend)
+%%BoundingBox: 35 35 577 165
+%%EndComments
+save
+%%BeginProlog
+/DotDict 200 dict def
+DotDict begin
+
+/setupLatin1 {
+mark
+/EncodingVector 256 array def
+ EncodingVector 0
+
+ISOLatin1Encoding 0 255 getinterval putinterval
+
+EncodingVector
+  dup 306 /AE
+  dup 301 /Aacute
+  dup 302 /Acircumflex
+  dup 304 /Adieresis
+  dup 300 /Agrave
+  dup 305 /Aring
+  dup 303 /Atilde
+  dup 307 /Ccedilla
+  dup 311 /Eacute
+  dup 312 /Ecircumflex
+  dup 313 /Edieresis
+  dup 310 /Egrave
+  dup 315 /Iacute
+  dup 316 /Icircumflex
+  dup 317 /Idieresis
+  dup 314 /Igrave
+  dup 334 /Udieresis
+  dup 335 /Yacute
+  dup 376 /thorn
+  dup 337 /germandbls
+  dup 341 /aacute
+  dup 342 /acircumflex
+  dup 344 /adieresis
+  dup 346 /ae
+  dup 340 /agrave
+  dup 345 /aring
+  dup 347 /ccedilla
+  dup 351 /eacute
+  dup 352 /ecircumflex
+  dup 353 /edieresis
+  dup 350 /egrave
+  dup 355 /iacute
+  dup 356 /icircumflex
+  dup 357 /idieresis
+  dup 354 /igrave
+  dup 360 /dcroat
+  dup 361 /ntilde
+  dup 363 /oacute
+  dup 364 /ocircumflex
+  dup 366 /odieresis
+  dup 362 /ograve
+  dup 365 /otilde
+  dup 370 /oslash
+  dup 372 /uacute
+  dup 373 /ucircumflex
+  dup 374 /udieresis
+  dup 371 /ugrave
+  dup 375 /yacute
+  dup 377 /ydieresis  
+
+% Set up ISO Latin 1 character encoding
+/starnetISO {
+        dup dup findfont dup length dict begin
+        { 1 index /FID ne { def }{ pop pop } ifelse
+        } forall
+        /Encoding EncodingVector def
+        currentdict end definefont
+} def
+/Times-Roman starnetISO def
+/Times-Italic starnetISO def
+/Times-Bold starnetISO def
+/Times-BoldItalic starnetISO def
+/Helvetica starnetISO def
+/Helvetica-Oblique starnetISO def
+/Helvetica-Bold starnetISO def
+/Helvetica-BoldOblique starnetISO def
+/Courier starnetISO def
+/Courier-Oblique starnetISO def
+/Courier-Bold starnetISO def
+/Courier-BoldOblique starnetISO def
+cleartomark
+} bind def
+
+%%BeginResource: procset graphviz 0 0
+/coord-font-family /Times-Roman def
+/default-font-family /Times-Roman def
+/coordfont coord-font-family findfont 8 scalefont def
+
+/InvScaleFactor 1.0 def
+/set_scale {
+	dup 1 exch div /InvScaleFactor exch def
+	dup scale
+} bind def
+
+% styles
+/solid { [] 0 setdash } bind def
+/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
+/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
+/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
+/bold { 2 setlinewidth } bind def
+/filled { } bind def
+/unfilled { } bind def
+/rounded { } bind def
+/diagonals { } bind def
+
+% hooks for setting color 
+/nodecolor { sethsbcolor } bind def
+/edgecolor { sethsbcolor } bind def
+/graphcolor { sethsbcolor } bind def
+/nopcolor {pop pop pop} bind def
+
+/beginpage {	% i j npages
+	/npages exch def
+	/j exch def
+	/i exch def
+	/str 10 string def
+	npages 1 gt {
+		gsave
+			coordfont setfont
+			0 0 moveto
+			(\() show i str cvs show (,) show j str cvs show (\)) show
+		grestore
+	} if
+} bind def
+
+/set_font {
+	findfont exch
+	scalefont setfont
+} def
+
+% draw aligned label in bounding box aligned to current point
+/alignedtext {			% width adj text
+	/text exch def
+	/adj exch def
+	/width exch def
+	gsave
+		width 0 gt {
+			text stringwidth pop adj mul 0 rmoveto
+		} if
+		[] 0 setdash
+		text show
+	grestore
+} def
+
+/boxprim {				% xcorner ycorner xsize ysize
+		4 2 roll
+		moveto
+		2 copy
+		exch 0 rlineto
+		0 exch rlineto
+		pop neg 0 rlineto
+		closepath
+} bind def
+
+/ellipse_path {
+	/ry exch def
+	/rx exch def
+	/y exch def
+	/x exch def
+	matrix currentmatrix
+	newpath
+	x y translate
+	rx ry scale
+	0 0 1 0 360 arc
+	setmatrix
+} bind def
+
+/endpage { showpage } bind def
+/showpage { } def
+
+/layercolorseq
+	[	% layer color sequence - darkest to lightest
+		[0 0 0]
+		[.2 .8 .8]
+		[.4 .8 .8]
+		[.6 .8 .8]
+		[.8 .8 .8]
+	]
+def
+
+/layerlen layercolorseq length def
+
+/setlayer {/maxlayer exch def /curlayer exch def
+	layercolorseq curlayer 1 sub layerlen mod get
+	aload pop sethsbcolor
+	/nodecolor {nopcolor} def
+	/edgecolor {nopcolor} def
+	/graphcolor {nopcolor} def
+} bind def
+
+/onlayer { curlayer ne {invis} if } def
+
+/onlayers {
+	/myupper exch def
+	/mylower exch def
+	curlayer mylower lt
+	curlayer myupper gt
+	or
+	{invis} if
+} def
+
+/curlayer 0 def
+
+%%EndResource
+%%EndProlog
+%%BeginSetup
+14 default-font-family set_font
+1 setmiterlimit
+% /arrowlength 10 def
+% /arrowwidth 5 def
+
+% make sure pdfmark is harmless for PS-interpreters other than Distiller
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+% make '<<' and '>>' safe on PS Level 1 devices
+/languagelevel where {pop languagelevel}{1} ifelse
+2 lt {
+    userdict (<<) cvn ([) cvn load put
+    userdict (>>) cvn ([) cvn load put
+} if
+
+%%EndSetup
+%%Page: 1 1
+%%PageBoundingBox: 36 36 577 165
+%%PageOrientation: Portrait
+gsave
+35 35 542 130 boxprim clip newpath
+36 36 translate
+0 0 1 beginpage
+0.4696 set_scale
+0 0 translate 0 rotate
+0.000 0.000 0.000 graphcolor
+14.00 /Times-Roman set_font
+
+%	Extraargs
+gsave 10 dict begin
+483 110 40 18 ellipse_path
+stroke
+gsave 10 dict begin
+455 105 moveto
+(Extraargs)
+[8.4 6.96 3.84 4.56 6.24 6.24 4.32 6.96 5.52]
+xshow
+end grestore
+end grestore
+
+%	Setoid_replace
+gsave 10 dict begin
+615 64 54 18 ellipse_path
+stroke
+gsave 10 dict begin
+573 59 moveto
+(Setoid_replace)
+[7.68 6 3.84 6.96 3.84 6.96 6.96 4.56 6.24 6.96 3.84 6.24 6.24 6.24]
+xshow
+end grestore
+end grestore
+
+%	Extraargs -> Setoid_replace
+newpath 515 99 moveto
+531 93 550 87 567 81 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 569 84 moveto
+577 77 lineto
+566 77 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 569 84 moveto
+577 77 lineto
+566 77 lineto
+closepath
+stroke
+end grestore
+
+%	Tactics
+gsave 10 dict begin
+884 110 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+864 105 moveto
+(Tactics)
+[7.44 6.24 6.24 3.84 3.84 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Setoid_replace -> Tactics
+newpath 669 66 moveto
+709 68 764 72 810 83 curveto
+823 85 837 90 848 94 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 847 98 moveto
+858 98 lineto
+850 91 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 847 98 moveto
+858 98 lineto
+850 91 lineto
+closepath
+stroke
+end grestore
+
+%	Termdn
+gsave 10 dict begin
+998 256 35 18 ellipse_path
+stroke
+gsave 10 dict begin
+976 251 moveto
+(Termdn)
+[7.2 6.24 4.8 10.8 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Dn
+gsave 10 dict begin
+1112 256 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+1102 251 moveto
+(Dn)
+[10.08 6.96]
+xshow
+end grestore
+end grestore
+
+%	Termdn -> Dn
+newpath 1033 256 moveto
+1047 256 1061 256 1075 256 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1075 260 moveto
+1085 256 lineto
+1075 253 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1075 260 moveto
+1085 256 lineto
+1075 253 lineto
+closepath
+stroke
+end grestore
+
+%	Hipattern
+gsave 10 dict begin
+998 110 40 18 ellipse_path
+stroke
+gsave 10 dict begin
+971 105 moveto
+(Hipattern)
+[10.08 3.84 6.96 6.24 3.84 3.84 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	Tactics -> Hipattern
+newpath 917 110 moveto
+927 110 938 110 948 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 948 114 moveto
+958 110 lineto
+948 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 948 114 moveto
+958 110 lineto
+948 107 lineto
+closepath
+stroke
+end grestore
+
+%	Tacticals
+gsave 10 dict begin
+1112 110 38 18 ellipse_path
+stroke
+gsave 10 dict begin
+1087 105 moveto
+(Tacticals)
+[7.44 6.24 6.24 3.84 3.84 6.24 6.24 3.84 5.52]
+xshow
+end grestore
+end grestore
+
+%	Hipattern -> Tacticals
+newpath 1038 110 moveto
+1047 110 1055 110 1064 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1064 114 moveto
+1074 110 lineto
+1064 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1064 114 moveto
+1074 110 lineto
+1064 107 lineto
+closepath
+stroke
+end grestore
+
+%	Tacinterp
+gsave 10 dict begin
+170 191 39 18 ellipse_path
+stroke
+gsave 10 dict begin
+143 186 moveto
+(Tacinterp)
+[7.44 6.24 6.24 3.84 6.96 3.84 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	Auto
+gsave 10 dict begin
+483 218 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+468 213 moveto
+(Auto)
+[9.6 6.96 3.84 6.96]
+xshow
+end grestore
+end grestore
+
+%	Tacinterp -> Auto
+newpath 209 194 moveto
+269 200 386 210 445 215 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 445 218 moveto
+455 216 lineto
+445 212 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 445 218 moveto
+455 216 lineto
+445 212 lineto
+closepath
+stroke
+end grestore
+
+%	Leminv
+gsave 10 dict begin
+281 166 35 18 ellipse_path
+stroke
+gsave 10 dict begin
+259 161 moveto
+(Leminv)
+[8.4 6.24 10.8 3.84 6.48 6.96]
+xshow
+end grestore
+end grestore
+
+%	Tacinterp -> Leminv
+newpath 205 183 moveto
+216 181 228 178 239 175 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 240 178 moveto
+249 173 lineto
+239 172 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 240 178 moveto
+249 173 lineto
+239 172 lineto
+closepath
+stroke
+end grestore
+
+%	Hiddentac
+gsave 10 dict begin
+615 164 42 18 ellipse_path
+stroke
+gsave 10 dict begin
+585 159 moveto
+(Hiddentac)
+[10.08 3.84 6.96 6.96 6.24 6.96 4.08 6.24 6.24]
+xshow
+end grestore
+end grestore
+
+%	Auto -> Hiddentac
+newpath 507 208 moveto
+526 200 553 189 574 181 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 576 184 moveto
+584 177 lineto
+573 177 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 576 184 moveto
+584 177 lineto
+573 177 lineto
+closepath
+stroke
+end grestore
+
+%	Dhyp
+gsave 10 dict begin
+615 218 29 18 ellipse_path
+stroke
+gsave 10 dict begin
+599 213 moveto
+(Dhyp)
+[10.08 6.48 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Auto -> Dhyp
+newpath 511 218 moveto
+530 218 555 218 576 218 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 576 222 moveto
+586 218 lineto
+576 215 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 576 222 moveto
+586 218 lineto
+576 215 lineto
+closepath
+stroke
+end grestore
+
+%	Inv
+gsave 10 dict begin
+379 164 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+369 159 moveto
+(Inv)
+[4.56 6.48 6.96]
+xshow
+end grestore
+end grestore
+
+%	Leminv -> Inv
+newpath 316 165 moveto
+324 165 333 165 342 165 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 342 169 moveto
+352 165 lineto
+342 162 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 342 169 moveto
+352 165 lineto
+342 162 lineto
+closepath
+stroke
+end grestore
+
+%	Refine
+gsave 10 dict begin
+758 110 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+739 105 moveto
+(Refine)
+[9.12 6.24 4.8 3.84 6.96 6.24]
+xshow
+end grestore
+end grestore
+
+%	Refine -> Tactics
+newpath 790 110 moveto
+805 110 824 110 841 110 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 841 114 moveto
+851 110 lineto
+841 107 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 841 114 moveto
+851 110 lineto
+841 107 lineto
+closepath
+stroke
+end grestore
+
+%	Nbtermdn
+gsave 10 dict begin
+758 256 42 18 ellipse_path
+stroke
+gsave 10 dict begin
+729 251 moveto
+(Nbtermdn)
+[10.08 6.96 3.84 6.24 4.8 10.8 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Btermdn
+gsave 10 dict begin
+884 256 38 18 ellipse_path
+stroke
+gsave 10 dict begin
+859 251 moveto
+(Btermdn)
+[9.36 3.84 6.24 4.8 10.8 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Nbtermdn -> Btermdn
+newpath 800 256 moveto
+812 256 824 256 836 256 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 836 260 moveto
+846 256 lineto
+836 253 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 836 260 moveto
+846 256 lineto
+836 253 lineto
+closepath
+stroke
+end grestore
+
+%	Btermdn -> Termdn
+newpath 922 256 moveto
+932 256 943 256 953 256 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 953 260 moveto
+963 256 lineto
+953 253 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 953 260 moveto
+963 256 lineto
+953 253 lineto
+closepath
+stroke
+end grestore
+
+%	Elim
+gsave 10 dict begin
+483 164 27 18 ellipse_path
+stroke
+gsave 10 dict begin
+468 159 moveto
+(Elim)
+[8.4 3.84 3.84 10.8]
+xshow
+end grestore
+end grestore
+
+%	Inv -> Elim
+newpath 406 164 moveto
+418 164 432 164 445 164 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 445 168 moveto
+455 164 lineto
+445 161 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 445 168 moveto
+455 164 lineto
+445 161 lineto
+closepath
+stroke
+end grestore
+
+%	Equality
+gsave 10 dict begin
+483 56 37 18 ellipse_path
+stroke
+gsave 10 dict begin
+459 51 moveto
+(Equality)
+[8.4 6.72 6.96 6.24 3.84 3.84 3.84 6.96]
+xshow
+end grestore
+end grestore
+
+%	Inv -> Equality
+newpath 390 147 moveto
+401 130 421 102 442 83 curveto
+445 80 448 78 451 76 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 453 79 moveto
+459 70 lineto
+449 73 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 453 79 moveto
+459 70 lineto
+449 73 lineto
+closepath
+stroke
+end grestore
+
+%	Elim -> Hiddentac
+newpath 511 164 moveto
+526 164 545 164 562 164 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 562 168 moveto
+572 164 lineto
+562 161 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 562 168 moveto
+572 164 lineto
+562 161 lineto
+closepath
+stroke
+end grestore
+
+%	Equality -> Setoid_replace
+newpath 520 58 moveto
+530 59 540 60 551 60 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 551 63 moveto
+561 61 lineto
+551 57 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 551 63 moveto
+561 61 lineto
+551 57 lineto
+closepath
+stroke
+end grestore
+
+%	Evar_tactics
+gsave 10 dict begin
+758 164 48 18 ellipse_path
+stroke
+gsave 10 dict begin
+722 159 moveto
+(Evar_tactics)
+[8.4 6.72 6.24 4.56 6.96 4.08 6.24 6.24 3.84 3.84 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Hiddentac -> Evar_tactics
+newpath 658 164 moveto
+671 164 685 164 699 164 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 699 168 moveto
+709 164 lineto
+699 161 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 699 168 moveto
+709 164 lineto
+699 161 lineto
+closepath
+stroke
+end grestore
+
+%	Evar_tactics -> Tactics
+newpath 790 150 moveto
+808 142 830 132 849 125 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 850 128 moveto
+858 121 lineto
+847 122 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 850 128 moveto
+858 121 lineto
+847 122 lineto
+closepath
+stroke
+end grestore
+
+%	Dhyp -> Tactics
+newpath 644 219 moveto
+684 220 756 217 810 191 curveto
+844 175 855 163 872 137 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 875 138 moveto
+877 128 lineto
+869 135 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 875 138 moveto
+877 128 lineto
+869 135 lineto
+closepath
+stroke
+end grestore
+
+%	Dhyp -> Nbtermdn
+newpath 642 225 moveto
+662 230 689 238 712 244 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 712 247 moveto
+722 246 lineto
+713 241 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 712 247 moveto
+722 246 lineto
+713 241 lineto
+closepath
+stroke
+end grestore
+
+%	Contradiction
+gsave 10 dict begin
+758 18 51 18 ellipse_path
+stroke
+gsave 10 dict begin
+719 13 moveto
+(Contradiction)
+[9.36 6.96 6.96 3.84 4.56 6.24 6.96 3.84 6.24 3.84 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Contradiction -> Tactics
+newpath 784 34 moveto
+793 39 802 44 810 50 curveto
+827 62 845 76 859 88 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 857 91 moveto
+867 95 lineto
+862 86 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 857 91 moveto
+867 95 lineto
+862 86 lineto
+closepath
+stroke
+end grestore
+
+%	Autorewrite
+gsave 10 dict begin
+47 191 47 18 ellipse_path
+stroke
+gsave 10 dict begin
+13 186 moveto
+(Autorewrite)
+[9.6 6.96 3.84 6.96 4.56 5.76 10.08 4.8 3.84 3.84 6.24]
+xshow
+end grestore
+end grestore
+
+%	Autorewrite -> Tacinterp
+newpath 94 191 moveto
+102 191 111 191 120 191 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 120 195 moveto
+130 191 lineto
+120 188 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 120 195 moveto
+130 191 lineto
+120 188 lineto
+closepath
+stroke
+end grestore
+endpage
+showpage
+grestore
+%%PageTrailer
+%%EndPage: 1
+%%Trailer
+%%Pages: 1
+end
+restore
+%%EOF
diff --git a/dev/doc/toplevel.dep.ps b/dev/doc/toplevel.dep.ps
new file mode 100644
index 00000000..e0355aac
--- /dev/null
+++ b/dev/doc/toplevel.dep.ps
@@ -0,0 +1,971 @@
+%!PS-Adobe-2.0
+%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005)
+%%For: (herbelin) Hugo Herbelin
+%%Title: G
+%%Pages: (atend)
+%%BoundingBox: 35 35 577 166
+%%EndComments
+save
+%%BeginProlog
+/DotDict 200 dict def
+DotDict begin
+
+/setupLatin1 {
+mark
+/EncodingVector 256 array def
+ EncodingVector 0
+
+ISOLatin1Encoding 0 255 getinterval putinterval
+
+EncodingVector
+  dup 306 /AE
+  dup 301 /Aacute
+  dup 302 /Acircumflex
+  dup 304 /Adieresis
+  dup 300 /Agrave
+  dup 305 /Aring
+  dup 303 /Atilde
+  dup 307 /Ccedilla
+  dup 311 /Eacute
+  dup 312 /Ecircumflex
+  dup 313 /Edieresis
+  dup 310 /Egrave
+  dup 315 /Iacute
+  dup 316 /Icircumflex
+  dup 317 /Idieresis
+  dup 314 /Igrave
+  dup 334 /Udieresis
+  dup 335 /Yacute
+  dup 376 /thorn
+  dup 337 /germandbls
+  dup 341 /aacute
+  dup 342 /acircumflex
+  dup 344 /adieresis
+  dup 346 /ae
+  dup 340 /agrave
+  dup 345 /aring
+  dup 347 /ccedilla
+  dup 351 /eacute
+  dup 352 /ecircumflex
+  dup 353 /edieresis
+  dup 350 /egrave
+  dup 355 /iacute
+  dup 356 /icircumflex
+  dup 357 /idieresis
+  dup 354 /igrave
+  dup 360 /dcroat
+  dup 361 /ntilde
+  dup 363 /oacute
+  dup 364 /ocircumflex
+  dup 366 /odieresis
+  dup 362 /ograve
+  dup 365 /otilde
+  dup 370 /oslash
+  dup 372 /uacute
+  dup 373 /ucircumflex
+  dup 374 /udieresis
+  dup 371 /ugrave
+  dup 375 /yacute
+  dup 377 /ydieresis  
+
+% Set up ISO Latin 1 character encoding
+/starnetISO {
+        dup dup findfont dup length dict begin
+        { 1 index /FID ne { def }{ pop pop } ifelse
+        } forall
+        /Encoding EncodingVector def
+        currentdict end definefont
+} def
+/Times-Roman starnetISO def
+/Times-Italic starnetISO def
+/Times-Bold starnetISO def
+/Times-BoldItalic starnetISO def
+/Helvetica starnetISO def
+/Helvetica-Oblique starnetISO def
+/Helvetica-Bold starnetISO def
+/Helvetica-BoldOblique starnetISO def
+/Courier starnetISO def
+/Courier-Oblique starnetISO def
+/Courier-Bold starnetISO def
+/Courier-BoldOblique starnetISO def
+cleartomark
+} bind def
+
+%%BeginResource: procset graphviz 0 0
+/coord-font-family /Times-Roman def
+/default-font-family /Times-Roman def
+/coordfont coord-font-family findfont 8 scalefont def
+
+/InvScaleFactor 1.0 def
+/set_scale {
+	dup 1 exch div /InvScaleFactor exch def
+	dup scale
+} bind def
+
+% styles
+/solid { [] 0 setdash } bind def
+/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def
+/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def
+/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def
+/bold { 2 setlinewidth } bind def
+/filled { } bind def
+/unfilled { } bind def
+/rounded { } bind def
+/diagonals { } bind def
+
+% hooks for setting color 
+/nodecolor { sethsbcolor } bind def
+/edgecolor { sethsbcolor } bind def
+/graphcolor { sethsbcolor } bind def
+/nopcolor {pop pop pop} bind def
+
+/beginpage {	% i j npages
+	/npages exch def
+	/j exch def
+	/i exch def
+	/str 10 string def
+	npages 1 gt {
+		gsave
+			coordfont setfont
+			0 0 moveto
+			(\() show i str cvs show (,) show j str cvs show (\)) show
+		grestore
+	} if
+} bind def
+
+/set_font {
+	findfont exch
+	scalefont setfont
+} def
+
+% draw aligned label in bounding box aligned to current point
+/alignedtext {			% width adj text
+	/text exch def
+	/adj exch def
+	/width exch def
+	gsave
+		width 0 gt {
+			text stringwidth pop adj mul 0 rmoveto
+		} if
+		[] 0 setdash
+		text show
+	grestore
+} def
+
+/boxprim {				% xcorner ycorner xsize ysize
+		4 2 roll
+		moveto
+		2 copy
+		exch 0 rlineto
+		0 exch rlineto
+		pop neg 0 rlineto
+		closepath
+} bind def
+
+/ellipse_path {
+	/ry exch def
+	/rx exch def
+	/y exch def
+	/x exch def
+	matrix currentmatrix
+	newpath
+	x y translate
+	rx ry scale
+	0 0 1 0 360 arc
+	setmatrix
+} bind def
+
+/endpage { showpage } bind def
+/showpage { } def
+
+/layercolorseq
+	[	% layer color sequence - darkest to lightest
+		[0 0 0]
+		[.2 .8 .8]
+		[.4 .8 .8]
+		[.6 .8 .8]
+		[.8 .8 .8]
+	]
+def
+
+/layerlen layercolorseq length def
+
+/setlayer {/maxlayer exch def /curlayer exch def
+	layercolorseq curlayer 1 sub layerlen mod get
+	aload pop sethsbcolor
+	/nodecolor {nopcolor} def
+	/edgecolor {nopcolor} def
+	/graphcolor {nopcolor} def
+} bind def
+
+/onlayer { curlayer ne {invis} if } def
+
+/onlayers {
+	/myupper exch def
+	/mylower exch def
+	curlayer mylower lt
+	curlayer myupper gt
+	or
+	{invis} if
+} def
+
+/curlayer 0 def
+
+%%EndResource
+%%EndProlog
+%%BeginSetup
+14 default-font-family set_font
+1 setmiterlimit
+% /arrowlength 10 def
+% /arrowwidth 5 def
+
+% make sure pdfmark is harmless for PS-interpreters other than Distiller
+/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
+% make '<<' and '>>' safe on PS Level 1 devices
+/languagelevel where {pop languagelevel}{1} ifelse
+2 lt {
+    userdict (<<) cvn ([) cvn load put
+    userdict (>>) cvn ([) cvn load put
+} if
+
+%%EndSetup
+%%Page: 1 1
+%%PageBoundingBox: 36 36 577 166
+%%PageOrientation: Portrait
+gsave
+35 35 542 131 boxprim clip newpath
+36 36 translate
+0 0 1 beginpage
+0.4180 set_scale
+0 0 translate 0 rotate
+0.000 0.000 0.000 graphcolor
+14.00 /Times-Roman set_font
+
+%	Vernac
+gsave 10 dict begin
+562 145 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+541 140 moveto
+(Vernac)
+[8.88 6.24 4.8 6.96 6.24 6.24]
+xshow
+end grestore
+end grestore
+
+%	Vernacentries
+gsave 10 dict begin
+724 158 52 18 ellipse_path
+stroke
+gsave 10 dict begin
+685 153 moveto
+(Vernacentries)
+[8.88 6.24 4.8 6.96 6.24 6.24 6.24 6.96 3.84 4.8 3.84 6.24 5.52]
+xshow
+end grestore
+end grestore
+
+%	Vernac -> Vernacentries
+newpath 595 148 moveto
+615 149 640 151 663 153 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 663 156 moveto
+673 154 lineto
+663 150 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 663 156 moveto
+673 154 lineto
+663 150 lineto
+closepath
+stroke
+end grestore
+
+%	Vernacinterp
+gsave 10 dict begin
+862 158 50 18 ellipse_path
+stroke
+gsave 10 dict begin
+825 153 moveto
+(Vernacinterp)
+[8.88 6.24 4.8 6.96 6.24 6.24 3.84 6.96 3.84 6.24 4.8 6.96]
+xshow
+end grestore
+end grestore
+
+%	Vernacentries -> Vernacinterp
+newpath 776 158 moveto
+785 158 793 158 802 158 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 802 162 moveto
+812 158 lineto
+802 155 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 802 162 moveto
+812 158 lineto
+802 155 lineto
+closepath
+stroke
+end grestore
+
+%	Discharge
+gsave 10 dict begin
+862 212 42 18 ellipse_path
+stroke
+gsave 10 dict begin
+833 207 moveto
+(Discharge)
+[10.08 3.84 5.52 6 6.96 6.24 4.32 6.72 6.24]
+xshow
+end grestore
+end grestore
+
+%	Vernacentries -> Discharge
+newpath 758 171 moveto
+777 179 801 188 822 196 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 820 199 moveto
+831 200 lineto
+823 193 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 820 199 moveto
+831 200 lineto
+823 193 lineto
+closepath
+stroke
+end grestore
+
+%	Mltop
+gsave 10 dict begin
+862 104 31 18 ellipse_path
+stroke
+gsave 10 dict begin
+844 99 moveto
+(Mltop)
+[12.48 3.84 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Vernacentries -> Mltop
+newpath 758 145 moveto
+779 137 805 126 826 118 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 828 121 moveto
+836 114 lineto
+825 114 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 828 121 moveto
+836 114 lineto
+825 114 lineto
+closepath
+stroke
+end grestore
+
+%	Record
+gsave 10 dict begin
+862 281 33 18 ellipse_path
+stroke
+gsave 10 dict begin
+842 276 moveto
+(Record)
+[9.12 6.24 6.24 6.96 4.32 6.96]
+xshow
+end grestore
+end grestore
+
+%	Vernacentries -> Record
+newpath 742 175 moveto
+760 192 788 217 812 239 curveto
+819 246 828 253 835 259 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 833 262 moveto
+843 266 lineto
+838 257 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 833 262 moveto
+843 266 lineto
+838 257 lineto
+closepath
+stroke
+end grestore
+
+%	Himsg
+gsave 10 dict begin
+991 85 32 18 ellipse_path
+stroke
+gsave 10 dict begin
+971 80 moveto
+(Himsg)
+[10.08 3.84 10.8 5.52 6.96]
+xshow
+end grestore
+end grestore
+
+%	Vernacinterp -> Himsg
+newpath 890 143 moveto
+897 139 905 135 912 131 curveto
+929 123 946 112 960 103 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 962 106 moveto
+969 98 lineto
+959 100 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 962 106 moveto
+969 98 lineto
+959 100 lineto
+closepath
+stroke
+end grestore
+
+%	Vernacexpr
+gsave 10 dict begin
+1246 221 45 18 ellipse_path
+stroke
+gsave 10 dict begin
+1213 216 moveto
+(Vernacexpr)
+[8.88 6.24 4.8 6.96 6.24 6.24 5.76 6.96 6.96 4.56]
+xshow
+end grestore
+end grestore
+
+%	Vernacinterp -> Vernacexpr
+newpath 912 159 moveto
+947 160 994 163 1034 169 curveto
+1092 178 1158 195 1200 207 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1199 210 moveto
+1210 210 lineto
+1201 204 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1199 210 moveto
+1210 210 lineto
+1201 204 lineto
+closepath
+stroke
+end grestore
+
+%	Class
+gsave 10 dict begin
+1117 238 28 18 ellipse_path
+stroke
+gsave 10 dict begin
+1101 233 moveto
+(Class)
+[9.36 3.84 6.24 5.52 5.52]
+xshow
+end grestore
+end grestore
+
+%	Discharge -> Class
+newpath 902 217 moveto
+917 219 933 221 948 223 curveto
+992 228 1044 232 1079 235 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1079 238 moveto
+1089 236 lineto
+1079 232 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1079 238 moveto
+1089 236 lineto
+1079 232 lineto
+closepath
+stroke
+end grestore
+
+%	Recordobj
+gsave 10 dict begin
+991 196 42 18 ellipse_path
+stroke
+gsave 10 dict begin
+962 191 moveto
+(Recordobj)
+[9.12 6.24 6.24 6.96 4.32 6.96 6.96 6.96 3.84]
+xshow
+end grestore
+end grestore
+
+%	Discharge -> Recordobj
+newpath 902 207 moveto
+914 205 927 204 940 202 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 940 205 moveto
+950 201 lineto
+940 199 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 940 205 moveto
+950 201 lineto
+940 199 lineto
+closepath
+stroke
+end grestore
+
+%	Command
+gsave 10 dict begin
+991 288 42 18 ellipse_path
+stroke
+gsave 10 dict begin
+961 283 moveto
+(Command)
+[9.36 6.96 10.8 10.8 6.24 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Record -> Command
+newpath 895 283 moveto
+908 284 923 285 938 285 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 938 288 moveto
+948 286 lineto
+938 282 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 938 288 moveto
+948 286 lineto
+938 282 lineto
+closepath
+stroke
+end grestore
+
+%	Toplevel
+gsave 10 dict begin
+255 72 37 18 ellipse_path
+stroke
+gsave 10 dict begin
+231 67 moveto
+(Toplevel)
+[7.2 6.96 6.96 3.84 5.76 6.48 6.24 3.84]
+xshow
+end grestore
+end grestore
+
+%	Protectedtoplevel
+gsave 10 dict begin
+390 72 61 18 ellipse_path
+stroke
+gsave 10 dict begin
+341 67 moveto
+(Protectedtoplevel)
+[7.68 4.56 6.72 3.84 6.24 6.24 3.84 6.24 6.96 3.84 6.96 6.96 3.84 5.76 6.48 6.24 3.84]
+xshow
+end grestore
+end grestore
+
+%	Toplevel -> Protectedtoplevel
+newpath 292 72 moveto
+300 72 309 72 318 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 318 76 moveto
+328 72 lineto
+318 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 318 76 moveto
+328 72 lineto
+318 69 lineto
+closepath
+stroke
+end grestore
+
+%	Protectedtoplevel -> Vernac
+newpath 425 87 moveto
+455 100 497 117 527 130 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 525 133 moveto
+536 134 lineto
+528 127 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 525 133 moveto
+536 134 lineto
+528 127 lineto
+closepath
+stroke
+end grestore
+
+%	Cerrors
+gsave 10 dict begin
+724 65 34 18 ellipse_path
+stroke
+gsave 10 dict begin
+702 60 moveto
+(Cerrors)
+[9.36 6.24 5.04 4.56 6.96 4.56 5.52]
+xshow
+end grestore
+end grestore
+
+%	Protectedtoplevel -> Cerrors
+newpath 452 71 moveto
+518 70 621 67 679 66 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 679 70 moveto
+689 66 lineto
+679 63 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 679 70 moveto
+689 66 lineto
+679 63 lineto
+closepath
+stroke
+end grestore
+
+%	Line_oriented_parser
+gsave 10 dict begin
+562 26 73 18 ellipse_path
+stroke
+gsave 10 dict begin
+501 21 moveto
+(Line_oriented_parser)
+[8.4 3.84 6.96 6.24 6.96 6.96 4.8 3.84 6.24 6.96 3.84 6.24 6.96 6.96 6.96 6.24 4.56 5.52 6.24 4.56]
+xshow
+end grestore
+end grestore
+
+%	Protectedtoplevel -> Line_oriented_parser
+newpath 436 60 moveto
+457 55 481 48 502 42 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 503 45 moveto
+512 39 lineto
+501 39 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 503 45 moveto
+512 39 lineto
+501 39 lineto
+closepath
+stroke
+end grestore
+
+%	Metasyntax
+gsave 10 dict begin
+1117 292 46 18 ellipse_path
+stroke
+gsave 10 dict begin
+1083 287 moveto
+(Metasyntax)
+[12.48 6 4.08 6.24 5.52 6.96 6.96 4.08 6.24 6.96]
+xshow
+end grestore
+end grestore
+
+%	Command -> Metasyntax
+newpath 1034 289 moveto
+1043 290 1052 290 1061 290 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1061 293 moveto
+1071 291 lineto
+1061 287 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1061 293 moveto
+1071 291 lineto
+1061 287 lineto
+closepath
+stroke
+end grestore
+
+%	Command -> Class
+newpath 1022 276 moveto
+1041 268 1065 259 1084 252 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1085 255 moveto
+1093 248 lineto
+1082 249 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1085 255 moveto
+1093 248 lineto
+1082 249 lineto
+closepath
+stroke
+end grestore
+
+%	Cerrors -> Himsg
+newpath 758 67 moveto
+796 69 859 73 912 77 curveto
+924 78 937 79 949 80 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 949 83 moveto
+959 81 lineto
+949 77 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 949 83 moveto
+959 81 lineto
+949 77 lineto
+closepath
+stroke
+end grestore
+
+%	Minicoq
+gsave 10 dict begin
+38 126 37 18 ellipse_path
+stroke
+gsave 10 dict begin
+13 121 moveto
+(Minicoq)
+[12.48 3.84 6.96 3.84 6.24 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Fhimsg
+gsave 10 dict begin
+147 126 34 18 ellipse_path
+stroke
+gsave 10 dict begin
+125 121 moveto
+(Fhimsg)
+[7.68 6.96 3.84 10.8 5.52 6.96]
+xshow
+end grestore
+end grestore
+
+%	Minicoq -> Fhimsg
+newpath 76 126 moveto
+84 126 93 126 102 126 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 102 130 moveto
+112 126 lineto
+102 123 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 102 130 moveto
+112 126 lineto
+102 123 lineto
+closepath
+stroke
+end grestore
+
+%	Metasyntax -> Vernacexpr
+newpath 1144 277 moveto
+1163 267 1189 252 1210 241 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 1212 244 moveto
+1219 236 lineto
+1209 238 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 1212 244 moveto
+1219 236 lineto
+1209 238 lineto
+closepath
+stroke
+end grestore
+
+%	Coqtop
+gsave 10 dict begin
+38 45 34 18 ellipse_path
+stroke
+gsave 10 dict begin
+17 40 moveto
+(Coqtop)
+[9.36 6.96 6.96 3.84 6.96 6.96]
+xshow
+end grestore
+end grestore
+
+%	Coqinit
+gsave 10 dict begin
+147 72 34 18 ellipse_path
+stroke
+gsave 10 dict begin
+126 67 moveto
+(Coqinit)
+[9.36 6.96 6.96 3.84 6.96 3.84 3.84]
+xshow
+end grestore
+end grestore
+
+%	Coqtop -> Coqinit
+newpath 69 53 moveto
+81 56 94 59 106 62 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 105 65 moveto
+116 65 lineto
+107 59 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 105 65 moveto
+116 65 lineto
+107 59 lineto
+closepath
+stroke
+end grestore
+
+%	Usage
+gsave 10 dict begin
+147 18 31 18 ellipse_path
+stroke
+gsave 10 dict begin
+129 13 moveto
+(Usage)
+[10.08 5.52 6.24 6.72 6.24]
+xshow
+end grestore
+end grestore
+
+%	Coqtop -> Usage
+newpath 69 37 moveto
+81 34 95 31 108 28 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 109 31 moveto
+118 25 lineto
+107 25 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 109 31 moveto
+118 25 lineto
+107 25 lineto
+closepath
+stroke
+end grestore
+
+%	Coqinit -> Toplevel
+newpath 181 72 moveto
+190 72 199 72 208 72 curveto
+stroke
+gsave 10 dict begin
+solid
+1 setlinewidth
+0.000 0.000 0.000 edgecolor
+newpath 208 76 moveto
+218 72 lineto
+208 69 lineto
+closepath
+fill
+0.000 0.000 0.000 edgecolor
+newpath 208 76 moveto
+218 72 lineto
+208 69 lineto
+closepath
+stroke
+end grestore
+endpage
+showpage
+grestore
+%%PageTrailer
+%%EndPage: 1
+%%Trailer
+%%Pages: 1
+end
+restore
+%%EOF
diff --git a/dev/include b/dev/include
index eb370a5d..563edd04 100644
--- a/dev/include
+++ b/dev/include
@@ -4,32 +4,27 @@
 #cd ".";;
 #use "base_include";;
 
-#install_printer  (* ast *)  prast;;
-#install_printer  (* pat *)  prastpat;;
-#install_printer  (* patlist *)  prastpatl;;
-
 #install_printer  (* pattern *) pppattern;;
-#install_printer  (* rawconstr *) pprawterm;;
+#install_printer  (* rawconstr *) pprawconstr;;
 
-#install_printer  (* constr *) ppterm;;
-#install_printer  (* constr_substituted *) ppsterm;; 
-#install_printer  (* universe *)  print_uni;;
-#install_printer  (* universes *)  pp_universes;;
-#install_printer  (* type_judgement*) pptype;;
-#install_printer  (* judgement*) prj;;
+#install_printer  (* constr *) ppconstr;;
+#install_printer  (* constr_substituted *) ppsconstr;; 
+#install_printer  (* universe *)  ppuni;;
+#install_printer  (* universes *)  ppuniverses;;
+#install_printer  (* type_judgement *) pptype;;
+#install_printer  (* judgement *) ppj;;
 
-#install_printer  (* goal *)  prgoal;;
-#install_printer  (* sigma goal *)  prsigmagoal;;
+#install_printer  (* goal *)  ppgoal;;
+#install_printer  (* sigma goal *)  ppsigmagoal;;
 #install_printer  (* proof *)  pproof;;
-#install_printer  (* global_constraints *)  prevd;;
-#install_printer  (* readable_constraints *)  prevc;;
-#install_printer  (* walking_constraints *)  prwc;;
-#install_printer  (* clenv *) prclenv;;
+#install_printer  (* evar_map *)  ppevm;;
+#install_printer  (* evar_defs *)  ppevd;;
+#install_printer  (* clenv *) ppclenv;;
 #install_printer  (* env *) ppenv;;
 
 #install_printer  (* tactic *) pptac;;
-#install_printer  (* object *) pr_obj;;
-#install_printer  (* global_reference *) prglobal;;
+#install_printer  (* object *) ppobj;;
+#install_printer  (* global_reference *) ppglobal;;
 
 #install_printer  (* fconstr *) ppfconstr;;
 
diff --git a/dev/ocamldebug-v7.template b/dev/ocamldebug-coq.template
index 1dd625c8..30224216 100644
--- a/dev/ocamldebug-v7.template
+++ b/dev/ocamldebug-coq.template
@@ -2,10 +2,10 @@
 
 # wrap around ocamldebug for Coq
 
-export COQTOP='COQTOPDIRECTORY'
-export COQLIB='COQLIBDIRECTORY'
+export COQTOP=COQTOPDIRECTORY
+export COQLIB=COQLIBDIRECTORY
 export COQTH=$COQLIB/theories
-CAMLBIN='CAMLBINDIRECTORY'
+CAMLBIN=CAMLBINDIRECTORY
 OCAMLDEBUG=$CAMLBIN/ocamldebug
 export CAMLP4LIB=`$CAMLBIN/camlp4 -where`
 
@@ -36,6 +36,7 @@ case $coqdebug in
         -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 \
 	$* $args;;
     *) exec $OCAMLDEBUG $*;;
 esac
diff --git a/dev/perf-analysis b/dev/perf-analysis
index 4295a573..23259156 100644
--- a/dev/perf-analysis
+++ b/dev/perf-analysis
@@ -1,51 +1,47 @@
-Performance analysis for V8-0-bugfix branch
--------------------------------------------
+Performance analysis for V8-0 branch
+------------------------------------
 
-  Dec 27, 2005: contrib Karatsuba added (~ 24s)
+  Dec 29, 2005: new test and use of -vm in Stalmarck
+
+  Dec 27, 2005: contrib Karatsuba added (~ 30s)
+
+Dec 28, 2005: size decrease
+  mainly due to Defined moved to Qed in FSets (reduction from 95M to 7Mo)
 
 Dec 1-14, 2005: benchmarking server down
+  between the two dates: Godel: -10%, CoRN: -10%
+  probably due to changes around vm (new informative Cast,
+  change of equality in named_context_val) 
 
-Nov 29 and Dec 16, 2005: size increase
-  due to new record flag in inductive for extraction
+  Oct 6, 2005: contribs IPC and Tait added (~ 22s and ~ 25s)
 
-  Oct 6, 2005: contribs IPC and Tait added (~ 22s and ~ 24s)
- 
-  Aug 1, 2005: contrib Kildall added (~ 64s)
+Aug 19, 2005: time decrease after application of "Array.length x=0" Xavier's 
+  suggestions for optimisation
+  (e.g. Nijmegen/QArith: -3%, Nijmegen/CoRN: -7%, Godel: -3%)
  
+  Aug 1, 2005: contrib Kildall added (~ 65s)
+
 Jul 26-Aug 2, 2005: bench down
 
 Jul 14-15, 2005: 4 contribs failed including CoRN
 
-  Jul 7, 2005: adding contrib Fermat4: but not compabible and remove on Jul 8
+Jul 14, 2005: time increase after activation of "closure optimisation"
+  (e.g. Nijmegen/QArith: +8%, Nijmegen/CoRN: +3%, Godel: +13%)
 
-  Jun 17, 2005: contrib Goodstein extended and moved to CantorOrdinals (~ 28s)
+  Jul 7, 2005: adding contrib Fermat4
 
-Jun 4, 2005: significant time reduction
-   (e.g. Nijmegen/LinAlg: -15%, Nijmegen/QArith: stable; Nijmegen/CoRN: -1%)
-   only changes are the removal of an assert checking location and
-   the pre-definition of level 200 (could it be just a parsing improvement??)
+  Jun 17, 2005: contrib Goodstein extended and moved to CantorOrdinals (~ 30s)
 
   May 19, 2005: contrib Goodstein and prfx (~ 9s) added 
 
-Apr 30, 2005: evaluation order of atomic tactics changed
-   (e.g. Nijmegen/CoRN: stable, Nijmegen/QArith: -2%, Nijmegen/LinAlg: +20%) 
+Apr 21, 2005: strange time decrease
+  (could it be due to the change of Back and Reset mechanism) 
+  (e.g. Nijmegen/CoRN: -2%, Nijmegen/QARITH: -4%, Godel: -11%)
 
 Mar 20, 2005: fixed Logic.with_check bug
-  improved whole V8-0-bugfix bench by 4 %
-  (e.g. Nijmegen/CoRN: - 7.5 %, Nijmegen/QARITH: - 1.5 %)
-
-Mar 7-10, 2005: unexplained time reduction 
-  (on Mar 7, changed Ppconstrnew univ printer only)
-  (note also a server upgrade around Mar 10)
-
-Feb 17, 2005: fixed omega bug #922 (wrong STATE dependency):
-  improved whole V8-0-bugfix bench by 2 %
-  (e.g. Nijmegen/CoRN: - 6.5 %, Nijmegen/QARITH: - 3 %)
-
-Feb 2, 2005: fixed ltac var interpretation order
-
-  Jan 13, 2005: contrib SumOfTwoSquare added (~ 37s)
+  global time decrease (e.g. Nijmegen/CoRN: -3%, Nijmegen/QARITH: -1.5%)
 
-Dec 20-29, 2004: reduced whole V8-0-bugfix due to Berkeley/Godel failure
+Jan 31-Feb 8, 2005: small instability
+  (e.g. CoRN: ~2015s -> ~1999s -> ~2032s, Godel: ~340s -> ~370s)
 
-Nov 27 - Dec 10, 2004: strong instability
+  Jan 13, 2005: contrib SumOfTwoSquare added (~ 38s)
diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index 1e314929..273f109c 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -9,8 +9,8 @@
 (* Printers for the ocaml toplevel. *)
 
 open System
+open Util
 open Pp
-open Ast
 open Names
 open Libnames
 open Nameops
@@ -19,104 +19,111 @@ open Univ
 open Proof_trees
 open Environ
 open Printer
+open Tactic_printer
 open Refiner
-open Tacmach
 open Term
 open Termops
 open Clenv
 open Cerrors
-open Constrextern
-open Constrintern
+open Evd
+open Goptions
 
 let _ = Constrextern.print_evar_arguments := true
+let _ = set_bool_option_value (SecondaryTable ("Printing","Matching")) false
+
+(* name printers *)
+let ppid id = pp (pr_id id)
+let pplab l = pp (pr_lab l)
+let ppmsid msid = pp (str (debug_string_of_msid msid))
+let ppmbid mbid = pp (str (debug_string_of_mbid mbid))
+let ppdir dir = pp (pr_dirpath dir)
+let ppmp mp = pp(str (string_of_mp mp))
+let ppcon con = pp(pr_con con)
+let ppkn kn = pp(pr_kn kn)
+let ppsp sp = pp(pr_sp sp)
+let ppqualid qid = pp(pr_qualid qid)
+
+(* term printers *)
+let ppconstr x = pp(Termops.print_constr x)
+let ppterm = ppconstr
+let ppsconstr x = ppconstr (Declarations.force x)
+let ppconstr_univ x = Constrextern.with_universes ppconstr x
+let pprawconstr = (fun x -> pp(pr_lrawconstr x))
+let pppattern = (fun x -> pp(pr_constr_pattern x))
+let pptype = (fun x -> pp(pr_ltype x))
+let ppfconstr c = ppconstr (Closure.term_of_fconstr c)
+
+let ppbigint n = pp (Bigint.pr_bigint n);;
+
+let ppidset l = pp (prlist_with_sep spc pr_id (Idset.elements l))
 
 let pP s = pp (hov 0 s)
 
-let prast c = pp(print_ast c)
-
-let prastpat c = pp(print_astpat c)
-let prastpatl c = pp(print_astlpat c)
-let ppterm x = pp(prterm x)
-let ppsterm x = ppterm (Declarations.force x)
-let ppterm_univ x = Constrextern.with_universes ppterm x
-let pprawterm = (fun x -> pp(pr_rawterm x))
-let pppattern = (fun x -> pp(pr_pattern x))
-let pptype = (fun x -> pp(prtype x))
-
-let safe_prglobal = function 
-  | ConstRef kn -> pp (str "CONSTREF(" ++ pr_kn kn ++ str ")")
+let safe_pr_global = function 
+  | ConstRef kn -> pp (str "CONSTREF(" ++ pr_con kn ++ str ")")
   | IndRef (kn,i) -> pp (str "INDREF(" ++ pr_kn kn ++ str "," ++ 
 			  int i ++ str ")")
   | ConstructRef ((kn,i),j) -> pp (str "INDREF(" ++ pr_kn kn ++ str "," ++ 
 				      int i ++ str "," ++ int j ++ str ")")
   | VarRef id -> pp (str "VARREF(" ++ pr_id id ++ str ")")
 
-let prglobal x = try pp(pr_global x) with _ -> safe_prglobal x
-
-let prid id = pp (pr_id id)
-let prlab l = pp (pr_lab l)
-
-let prmsid msid = pp (str (debug_string_of_msid msid))
-let prmbid mbid = pp (str (debug_string_of_mbid mbid))
-
-let prdir dir = pp (pr_dirpath dir)
+let ppglobal x = try pp(pr_global x) with _ -> safe_pr_global x
 
-let prmp mp = pp(str (string_of_mp mp))
-let prkn kn = pp(pr_kn kn)
+let ppconst (sp,j) =
+    pp (str"#" ++ pr_kn sp ++ str"=" ++ pr_lconstr j.uj_val)
 
-let prsp sp = pp(pr_sp sp)
+let ppvar ((id,a)) =
+    pp (str"#" ++ pr_id id ++ str":" ++ pr_lconstr a)
 
-let prqualid qid = pp(pr_qualid qid)
+let genppj f j = let (c,t) = f j in (c ++ str " : " ++ t)
 
-let prconst (sp,j) =
-    pp (str"#" ++ pr_kn sp ++ str"=" ++ prterm j.uj_val)
+let ppj j = pp (genppj pr_ljudge j)
 
-let prvar ((id,a)) =
-    pp (str"#" ++ pr_id id ++ str":" ++ prterm a)
+(* proof printers *)
+let ppevm evd = pp(pr_evar_map evd)
+let ppevd evd = pp(pr_evar_defs evd)
+let ppclenv clenv = pp(pr_clenv clenv)
+let ppgoal g = pp(db_pr_goal g)
 
-let genprj f j = let (c,t) = f j in (c ++ str " : " ++ t)
+let pr_gls gls =
+  hov 0 (pr_evar_map (sig_sig gls) ++ fnl () ++ db_pr_goal (sig_it gls))
 
-let prj j = pp (genprj prjudge j)
-
-let prgoal g = pp(prgl g)
-
-let prsigmagoal g = pp(prgl (sig_it g))
+let pr_glls glls =
+  hov 0 (pr_evar_map (sig_sig glls) ++ fnl () ++
+         prlist_with_sep pr_fnl db_pr_goal (sig_it glls))
 
+let ppsigmagoal g = pp(pr_goal (sig_it g))
 let prgls gls = pp(pr_gls gls)
-
 let prglls glls = pp(pr_glls glls)
-
 let pproof p = pp(print_proof Evd.empty empty_named_context p)
 
-let prevd evd = pp(pr_decls evd)
+let ppuni u = pp(pr_uni u)
 
-let prevc evc = pp(pr_evc evc)
-
-let prwc wc = pp(pr_evc wc)
-
-let prclenv clenv = pp(pr_clenv clenv)
-
-let print_uni u = (pp (pr_uni u))
-
-let pp_universes u = pp (str"[" ++ pr_universes u ++ str"]")
+let ppuniverses u = pp (str"[" ++ pr_universes u ++ str"]")
 
 let ppenv e = pp
   (str "[" ++ pr_named_context_of e ++ str "]" ++ spc() ++
    str "[" ++ pr_rel_context e (rel_context e) ++ str "]")
 
-let pptac = (fun x -> pp(Pptactic.pr_glob_tactic x))
+let pptac = (fun x -> pp(Pptactic.pr_glob_tactic (Global.env()) x))
 
-let pr_obj obj = Format.print_string (Libobject.object_tag obj)
+let ppobj obj = Format.print_string (Libobject.object_tag obj)
 
 let cnt = ref 0
 
+let cast_kind_display k = 
+  match k with
+  | VMcast -> "VMcast"
+  | DEFAULTcast -> "DEFAULTcast"
+
 let constr_display csr =
   let rec term_display c = match kind_of_term c with
   | Rel n -> "Rel("^(string_of_int n)^")"
   | Meta n -> "Meta("^(string_of_int n)^")"
   | Var id -> "Var("^(string_of_id id)^")"
   | Sort s -> "Sort("^(sort_display s)^")"
-  | Cast (c,t) -> "Cast("^(term_display c)^","^(term_display t)^")"
+  | Cast (c,k, t) -> 
+      "Cast("^(term_display c)^","^(cast_kind_display k)^","^(term_display t)^")"
   | Prod (na,t,c) ->
       "Prod("^(name_display na)^","^(term_display t)^","^(term_display c)^")\n"
   | Lambda (na,t,c) ->
@@ -126,7 +133,7 @@ let constr_display csr =
       ^(term_display t)^","^(term_display c)^")"
   | App (c,l) -> "App("^(term_display c)^","^(array_display l)^")\n"
   | Evar (e,l) -> "Evar("^(string_of_int e)^","^(array_display l)^")"
-  | Const c -> "Const("^(string_of_kn c)^")"
+  | Const c -> "Const("^(string_of_con c)^")"
   | Ind (sp,i) ->
       "MutInd("^(string_of_kn sp)^","^(string_of_int i)^")"
   | Construct ((sp,i),j) ->
@@ -177,7 +184,7 @@ let print_pure_constr csr =
   | Meta n -> print_string "Meta("; print_int n; print_string ")"
   | Var id -> print_string (string_of_id id)
   | Sort s -> sort_display s
-  | Cast (c,t) -> open_hovbox 1;
+  | Cast (c,_, t) -> open_hovbox 1;
       print_string "("; (term_display c); print_cut();
       print_string "::"; (term_display t); print_string ")"; close_box()
   | Prod (Name(id),t,c) ->
@@ -207,7 +214,7 @@ let print_pure_constr csr =
       Array.iter (fun x -> print_space (); box_display x) l;
       print_string"}"
   | Const c -> print_string "Cons(";
-      sp_display c;
+      sp_con_display c;
       print_string ")"
   | Ind (sp,i) ->
       print_string "Ind(";
@@ -231,11 +238,12 @@ let print_pure_constr csr =
       print_string "end"; 
       close_box()
   | Fix ((t,i),(lna,tl,bl)) ->
-      print_string "Fix("; print_int i; print_string ")"; 
+      print_string "Fix"
+(* "("; print_int i; print_string ")"; 
       print_cut();
       open_vbox 0;
       let rec print_fix () =
-        for k = 0 to Array.length tl - 1 do
+        for k = 0 to (Array.length tl) - 1 do
 	  open_vbox 0;
 	  name_display lna.(k); print_string "/"; 
 	  print_int t.(k); print_cut(); print_string ":";
@@ -243,13 +251,13 @@ let print_pure_constr csr =
 	  box_display bl.(k); close_box ();
 	  print_cut()
         done
-      in print_string"{"; print_fix(); print_string"}"
+      in print_string"{"; print_fix(); print_string"}" *)
   | CoFix(i,(lna,tl,bl)) ->
       print_string "CoFix("; print_int i; print_string ")"; 
       print_cut();
       open_vbox 0;
       let rec print_fix () =
-        for k = 0 to Array.length tl - 1 do
+        for k = 0 to (Array.length tl) - 1 do
           open_vbox 1;
 	  name_display lna.(k);  print_cut(); print_string ":";
 	  box_display tl.(k) ; print_cut(); print_string ":=";
@@ -279,27 +287,85 @@ let print_pure_constr csr =
 	| l             -> l
     in  List.iter (fun x -> print_string x; print_string ".") ls;*)
       print_string (string_of_kn sp)
+  and sp_con_display sp = 
+(*    let dir,l = decode_kn sp in
+    let ls = 
+      match List.rev (List.map string_of_id (repr_dirpath dir)) with 
+          ("Top"::l)-> l
+	| ("Coq"::_::l) -> l 
+	| l             -> l
+    in  List.iter (fun x -> print_string x; print_string ".") ls;*)
+      print_string (string_of_con sp)
 
   in
+    try 
      box_display csr; print_flush()
-(*
-let _ =
-  Vernacentries.add "PrintConstr"
-    (function
-       | [VARG_CONSTR c] -> 
-	   (fun () ->
-              let (evmap,sign) = Command.get_current_context () in
-  	      constr_display (Constrintern.interp_constr evmap sign c))
-       | _ -> bad_vernac_args "PrintConstr")
+    with e ->
+	print_string (Printexc.to_string e);print_flush ();
+	raise e
 
-let _ =
-  Vernacentries.add "PrintPureConstr"
-    (function
-       | [VARG_CONSTR c] -> 
-	   (fun () ->
-              let (evmap,sign) = Command.get_current_context () in
-  	      print_pure_constr (Constrintern.interp_constr evmap sign c))
-       | _ -> bad_vernac_args "PrintPureConstr")
+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")"
+
+(**********************************************************************)
+(* Vernac-level debugging commands                                    *)
+
+let in_current_context f c =
+  let (evmap,sign) = 
+    try Pfedit.get_current_goal_context ()
+    with e when Logic.catchable_exception e -> (Evd.empty, Global.env()) in
+  f (Constrintern.interp_constr evmap sign c)
+
+(* We expand the result of preprocessing to be independent of camlp4
+
+VERNAC COMMAND EXTEND PrintPureConstr
+| [ "PrintPureConstr" constr(c) ] -> [ in_current_context print_pure_constr c ]
+END
+VERNAC COMMAND EXTEND PrintConstr
+  [ "PrintConstr" constr(c) ] -> [ in_current_context constr_display c ]
+END
 *)
 
-let ppfconstr c = ppterm (Closure.term_of_fconstr c)
+open Pcoq
+open Genarg
+open Egrammar
+
+let _ =
+  try
+    Vernacinterp.vinterp_add "PrintConstr"
+      (function
+         [c] when genarg_tag c = ConstrArgType && true ->
+           let c = out_gen rawwit_constr c in
+           (fun () -> in_current_context constr_display c)
+       | _ -> failwith "Vernac extension: cannot occur")
+  with
+    e -> Pp.pp (Cerrors.explain_exn e)
+let _ =
+  extend_vernac_command_grammar "PrintConstr"
+    [[TacTerm "PrintConstr";
+      TacNonTerm
+        (dummy_loc,
+         (Gramext.Snterm (Pcoq.Gram.Entry.obj Constr.constr),
+          ConstrArgType),
+         Some "c")]]
+
+let _ =
+  try
+    Vernacinterp.vinterp_add "PrintPureConstr"
+      (function
+         [c] when genarg_tag c = ConstrArgType && true ->
+           let c = out_gen rawwit_constr c in
+           (fun () -> in_current_context print_pure_constr c)
+       | _ -> failwith "Vernac extension: cannot occur")
+  with
+    e -> Pp.pp (Cerrors.explain_exn e)
+let _ =
+  extend_vernac_command_grammar "PrintPureConstr"
+    [[TacTerm "PrintPureConstr";
+      TacNonTerm
+        (dummy_loc,
+         (Gramext.Snterm (Pcoq.Gram.Entry.obj Constr.constr),
+          ConstrArgType),
+         Some "c")]]
diff --git a/dev/vm_printers.ml b/dev/vm_printers.ml
new file mode 100644
index 00000000..c037eca7
--- /dev/null
+++ b/dev/vm_printers.ml
@@ -0,0 +1,98 @@
+open Format
+open Term
+open Names
+open Cbytecodes
+open Cemitcodes
+open Vm
+
+let ppripos (ri,pos) =
+  (match ri with
+  | Reloc_annot a -> 
+      let sp,i = a.ci.ci_ind in
+      print_string 
+	("annot : MutInd("^(string_of_kn sp)^","^(string_of_int i)^")\n")
+  | Reloc_const _ ->
+      print_string "structured constant\n"
+  | Reloc_getglobal kn ->
+      print_string ("getglob "^(string_of_con kn)^"\n"));
+   print_flush ()
+
+let print_vfix () = print_string "vfix"
+let print_vfix_app () = print_string "vfix_app"
+let print_vswith () = print_string "switch"
+
+let ppsort = function
+  | Prop(Pos) -> print_string "Set"
+  | Prop(Null) -> print_string "Prop"
+  | Type u -> print_string "Type"
+
+
+
+let print_idkey idk =
+  match idk with 
+  | ConstKey sp -> 
+      print_string "Cons(";
+      print_string (string_of_con sp);
+      print_string ")"
+  | VarKey id -> print_string (string_of_id id)
+  | RelKey i -> print_string "~";print_int i
+
+let rec ppzipper z =
+  match z with 
+  | Zapp args -> 
+      let n = nargs args in
+      open_hbox ();
+      for i = 0 to n-2 do
+	ppvalues (arg args i);print_string ";";print_space()
+      done;
+      if n-1 >= 0 then ppvalues (arg args (n-1));
+      close_box()
+  | Zfix _ -> print_string "Zfix"
+  | Zswitch _ -> print_string "Zswitch"
+
+and ppstack s = 
+  open_hovbox 0;
+  print_string "[";
+  List.iter (fun z -> ppzipper z;print_string " | ") s;
+  print_string "]";
+  close_box()
+
+and ppatom a =
+  match a with
+  | Aid idk -> print_idkey idk
+  | Aiddef(idk,_) -> print_string "&";print_idkey idk
+  | Aind(sp,i) ->  print_string "Ind(";
+      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 
+  | Vsort s -> ppsort s
+  | 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) ->
+      open_hbox();ppatom a;close_box();
+      print_string"@";ppstack s
+
+and ppvblock b =
+  open_hbox();
+  print_string "Cb(";print_int (btag b);
+  let n = bsize b in
+  for i = 0 to n -1 do
+    print_string ",";ppvalues (bfield b i)
+  done;
+  print_string")";
+  close_box()
+
+and ppvalues v =
+  open_hovbox 0;ppwhd (whd_val v);close_box();
+  print_flush()
diff --git a/doc/INSTALL b/doc/INSTALL
new file mode 100644
index 00000000..9223a41b
--- /dev/null
+++ b/doc/INSTALL
@@ -0,0 +1,65 @@
+                           The Coq documentation
+                           =====================
+
+The Coq documentation includes 
+
+- A Reference Manual
+- A Tutorial
+- A document presenting the Coq standard library
+- A list of questions/answers in the FAQ style
+
+The sources of the documents are mainly made of LaTeX code from which
+user-readable PostScript or PDF files, or a user-browsable bunch of
+html files are generated.
+
+Prerequisite
+------------
+
+To produce the documents, you need the coqtop, coq-tex, coqdoc and
+gallina tools, with same version number as the current
+documentation. These four tools normally come with any basic Coq
+installation.
+
+In addition, to produce the PostScript documents, the following tools
+are needed:
+
+  - latex (latex2e)
+  - dvips
+  - bibtex
+  - makeindex
+  - pngtopnm and pnmtops (for the Reference Manual and the FAQ)
+
+To produce the PDF documents, the following tools are needed:
+
+  - pdflatex
+  - bibtex
+
+To produce the html documents, the following tools are needed:
+
+  - hevea (e.g. 1.07 works)
+
+To produce the documentation of the standard library, a source copy of
+the coq distribution is needed.
+
+Compilation
+-----------
+
+To produce all PostScript documents, do:                make all-ps
+To produce all PDF documents, do:                       make all-pdf
+To produce all html documents, do:                      make all-html
+To produce all formats of the Reference Manual, do:     make refman
+To produce all formats of the Tutorial, do:             make tutorial
+To produce all formats of the Coq Standard Library, do: make stdlib
+To produce all formats of the FAQ, do:                  make faq
+
+Installation
+------------
+
+To install all produced documents, do:
+
+  make DOCDIR=/some/directory/for/documentation install
+
+DOCDIR defauts to /usr/share/doc/coq-x.y were x.y is the version number
+
+
+
diff --git a/doc/LICENCE b/doc/LICENCE
new file mode 100644
index 00000000..99087480
--- /dev/null
+++ b/doc/LICENCE
@@ -0,0 +1,630 @@
+The Coq Reference Manual is a collective work from the Coq Development
+Team whose members are listed in the file CREDITS of the Coq source
+package. All related documents (the LaTeX and BibTeX sources, the
+embedded png files, and the PostScript, PDF and html outputs) are
+copyright (c) INRIA 1999-2006. The material connected to the Reference
+Manual may be distributed only subject to the terms and conditions set
+forth in the Open Publication License, v1.0 or later (the latest
+version is presently available at http://www.opencontent.org/openpub/).
+Options A and B are *not* elected.
+
+The Coq Tutorial is a work by Gérard Huet, Gilles Kahn and Christine
+Paulin-Mohring. All documents (the LaTeX source and the PostScript,
+PDF and html outputs) are copyright (c) INRIA 1999-2006. The material
+connected to the Coq Tutorial may be distributed only subject to the
+terms and conditions set forth in the Open Publication License, v1.0
+or later (the latest version is presently available at
+http://www.opencontent.org/openpub/). Options A and B are *not*
+elected.
+
+The Coq Standard Library is a collective work from the Coq Development
+Team whose members are listed in the file CREDITS of the Coq source
+package. All related documents (the Coq vernacular source files and
+the PostScript, PDF and html outputs) are copyright (c) INRIA
+1999-2006. The material connected to the Standard Library is
+distributed under the terms of the Lesser General Public License
+version 2.1 or later. 
+
+The FAQ (Coq for the Clueless) is a work by Pierre Castéran, Hugo
+Herbelin, Florent Kirchner, Benjamin Monate, and Julien Narboux. All
+documents (the LaTeX source and the PostScript, PDF and html outputs)
+are copyright (c) INRIA 2004-2006. The material connected to the FAQ
+(Coq for the Clueless) may be distributed only subject to the terms
+and conditions set forth in the Open Publication License, v1.0 or
+later (the latest version is presently available at
+http://www.opencontent.org/openpub/). Options A and B are *not*
+elected.
+
+The Tutorial on [Co-]Inductive Types in Coq is a work by Pierre
+Castéran and Eduardo Gimenez. All related documents (the LaTeX and
+BibTeX sources and the PostScript, PDF and html outputs) are copyright
+(c) INRIA 1997-2006. The material connected to the Tutorial on
+[Co-]Inductive Types in Coq may be distributed only subject to the
+terms and conditions set forth in the Open Publication License, v1.0
+or later (the latest version is presently available at
+http://www.opencontent.org/openpub/).  Options A and B are
+*not* elected.
+
+----------------------------------------------------------------------
+
+                      *Open Publication License*
+                           v1.0, 8 June 1999
+
+
+*I. REQUIREMENTS ON BOTH UNMODIFIED AND MODIFIED VERSIONS*
+
+The Open Publication works may be reproduced and distributed in whole or
+in part, in any medium physical or electronic, provided that the terms
+of this license are adhered to, and that this license or an
+incorporation of it by reference (with any options elected by the
+author(s) and/or publisher) is displayed in the reproduction.
+
+Proper form for an incorporation by reference is as follows:
+
+    Copyright (c) <year> by <author's name or designee>. This material
+    may be distributed only subject to the terms and conditions set
+    forth in the Open Publication License, vX.Y or later (the latest
+    version is presently available at http://www.opencontent.org/openpub/).
+
+The reference must be immediately followed with any options elected by
+the author(s) and/or publisher of the document (see section VI).
+
+Commercial redistribution of Open Publication-licensed material is
+permitted.
+
+Any publication in standard (paper) book form shall require the citation
+of the original publisher and author. The publisher and author's names
+shall appear on all outer surfaces of the book. On all outer surfaces of
+the book the original publisher's name shall be as large as the title of
+the work and cited as possessive with respect to the title.
+
+
+*II. COPYRIGHT*
+
+The copyright to each Open Publication is owned by its author(s) or
+designee.
+
+
+*III. SCOPE OF LICENSE*
+
+The following license terms apply to all Open Publication works, unless
+otherwise explicitly stated in the document.
+
+Mere aggregation of Open Publication works or a portion of an Open
+Publication work with other works or programs on the same media shall
+not cause this license to apply to those other works. The aggregate work
+shall contain a notice specifying the inclusion of the Open Publication
+material and appropriate copyright notice.
+
+SEVERABILITY. If any part of this license is found to be unenforceable
+in any jurisdiction, the remaining portions of the license remain in force.
+
+NO WARRANTY. Open Publication works are licensed and provided "as is"
+without warranty of any kind, express or implied, including, but not
+limited to, the implied warranties of merchantability and fitness for a
+particular purpose or a warranty of non-infringement.
+
+
+*IV. REQUIREMENTS ON MODIFIED WORKS*
+
+All modified versions of documents covered by this license, including
+translations, anthologies, compilations and partial documents, must meet
+the following requirements:
+
+   1. The modified version must be labeled as such.
+   2. The person making the modifications must be identified and the
+      modifications dated.
+   3. Acknowledgement of the original author and publisher if applicable
+      must be retained according to normal academic citation practices.
+   4. The location of the original unmodified document must be identified.
+   5. The original author's (or authors') name(s) may not be used to
+      assert or imply endorsement of the resulting document without the
+      original author's (or authors') permission. 
+
+
+*V. GOOD-PRACTICE RECOMMENDATIONS *
+
+In addition to the requirements of this license, it is requested from
+and strongly recommended of redistributors that:
+
+   1. If you are distributing Open Publication works on hardcopy or
+      CD-ROM, you provide email notification to the authors of your
+      intent to redistribute at least thirty days before your manuscript
+      or media freeze, to give the authors time to provide updated
+      documents. This notification should describe modifications, if
+      any, made to the document.
+   2. All substantive modifications (including deletions) be either
+      clearly marked up in the document or else described in an
+      attachment to the document.
+   3. Finally, while it is not mandatory under this license, it is
+      considered good form to offer a free copy of any hardcopy and
+      CD-ROM expression of an Open Publication-licensed work to its
+      author(s). 
+
+
+*VI. LICENSE OPTIONS*
+
+The author(s) and/or publisher of an Open Publication-licensed document
+may elect certain options by appending language to the reference to or
+copy of the license. These options are considered part of the license
+instance and must be included with the license (or its incorporation by
+reference) in derived works.
+
+A. To prohibit distribution of substantively modified versions without
+the explicit permission of the author(s). "Substantive modification" is
+defined as a change to the semantic content of the document, and
+excludes mere changes in format or typographical corrections.
+
+To accomplish this, add the phrase `Distribution of substantively
+modified versions of this document is prohibited without the explicit
+permission of the copyright holder.' to the license reference or copy.
+
+B. To prohibit any publication of this work or derivative works in whole
+or in part in standard (paper) book form for commercial purposes is
+prohibited unless prior permission is obtained from the copyright holder.
+
+To accomplish this, add the phrase 'Distribution of the work or
+derivative of the work in any standard (paper) book form is prohibited
+unless prior permission is obtained from the copyright holder.' to the
+license reference or copy.
+
+----------------------------------------------------------------------
+
+		  GNU LESSER GENERAL PUBLIC LICENSE
+		       Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL.  It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+  This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it.  You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations below.
+
+  When we speak of free software, we are referring to freedom of use,
+not price.  Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+  To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights.  These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+  For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you.  You must make sure that they, too, receive or can get the source
+code.  If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it.  And you must show them these terms so they know their rights.
+
+  We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+  To protect each distributor, we want to make it very clear that
+there is no warranty for the free library.  Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+
+  Finally, software patents pose a constant threat to the existence of
+any free program.  We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder.  Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+  Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License.  This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License.  We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+  When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library.  The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom.  The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+  We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License.  It also provides other free software developers Less
+of an advantage over competing non-free programs.  These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries.  However, the Lesser license provides advantages in certain
+special circumstances.
+
+  For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it becomes
+a de-facto standard.  To achieve this, non-free programs must be
+allowed to use the library.  A more frequent case is that a free
+library does the same job as widely used non-free libraries.  In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+  In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software.  For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+  Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.  Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library".  The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+
+		  GNU LESSER GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+  A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+  The "Library", below, refers to any such software library or work
+which has been distributed under these terms.  A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language.  (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+  "Source code" for a work means the preferred form of the work for
+making modifications to it.  For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+  Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it).  Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+  
+  1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+  You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+  2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+
+    b) You must cause the files modified to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    c) You must cause the whole of the work to be licensed at no
+    charge to all third parties under the terms of this License.
+
+    d) If a facility in the modified Library refers to a function or a
+    table of data to be supplied by an application program that uses
+    the facility, other than as an argument passed when the facility
+    is invoked, then you must make a good faith effort to ensure that,
+    in the event an application does not supply such function or
+    table, the facility still operates, and performs whatever part of
+    its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has
+    a purpose that is entirely well-defined independent of the
+    application.  Therefore, Subsection 2d requires that any
+    application-supplied function or table used by this function must
+    be optional: if the application does not supply it, the square
+    root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library.  To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License.  (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.)  Do not make any other change in
+these notices.
+
+  Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+  This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+  4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+  If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library".  Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+  However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library".  The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+  When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library.  The
+threshold for this to be true is not precisely defined by law.
+
+  If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work.  (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+  Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+  6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+  You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License.  You must supply a copy of this License.  If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License.  Also, you must do one
+of these things:
+
+    a) Accompany the work with the complete corresponding
+    machine-readable source code for the Library including whatever
+    changes were used in the work (which must be distributed under
+    Sections 1 and 2 above); and, if the work is an executable linked
+    with the Library, with the complete machine-readable "work that
+    uses the Library", as object code and/or source code, so that the
+    user can modify the Library and then relink to produce a modified
+    executable containing the modified Library.  (It is understood
+    that the user who changes the contents of definitions files in the
+    Library will not necessarily be able to recompile the application
+    to use the modified definitions.)
+
+    b) Use a suitable shared library mechanism for linking with the
+    Library.  A suitable mechanism is one that (1) uses at run time a
+    copy of the library already present on the user's computer system,
+    rather than copying library functions into the executable, and (2)
+    will operate properly with a modified version of the library, if
+    the user installs one, as long as the modified version is
+    interface-compatible with the version that the work was made with.
+
+    c) Accompany the work with a written offer, valid for at
+    least three years, to give the same user the materials
+    specified in Subsection 6a, above, for a charge no more
+    than the cost of performing this distribution.
+
+    d) If distribution of the work is made by offering access to copy
+    from a designated place, offer equivalent access to copy the above
+    specified materials from the same place.
+
+    e) Verify that the user has already received a copy of these
+    materials or that you have already sent this user a copy.
+
+  For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it.  However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+  It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system.  Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+  7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work
+    based on the Library, uncombined with any other library
+    facilities.  This must be distributed under the terms of the
+    Sections above.
+
+    b) Give prominent notice with the combined library of the fact
+    that part of it is a work based on the Library, and explaining
+    where to find the accompanying uncombined form of the same work.
+
+  8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License.  Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License.  However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+  9. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Library or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+  10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+
+  11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded.  In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+  13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation.  If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+  14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission.  For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this.  Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+			    NO WARRANTY
+
+  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
diff --git a/doc/Makefile b/doc/Makefile
new file mode 100644
index 00000000..07b13039
--- /dev/null
+++ b/doc/Makefile
@@ -0,0 +1,300 @@
+# Makefile for the Coq documentation
+
+# COQTOP needs to be set to a coq source repository
+
+# To compile documentation, you need the following tools:
+# Dvi: latex (latex2e), bibtex, makeindex
+# Pdf: pdflatex
+# Html: hevea (http://hevea.inria.fr) >= 1.05
+
+include ../config/Makefile
+
+
+LATEX=latex
+BIBTEX=bibtex -min-crossrefs=10
+MAKEINDEX=makeindex
+PDFLATEX=pdflatex
+
+HEVEALIB=/usr/local/lib/hevea:/usr/lib/hevea
+TEXINPUTS=$(HEVEALIB):.:
+
+DOCCOQTOP=$(COQTOP)/bin/coqtop
+COQTEX=$(COQTOP)/bin/coq-tex -n 72 -image $(DOCCOQTOP) -v -sl -small
+COQDOC=$(COQTOP)/bin/coqdoc
+
+#VERSION=POSITIONNEZ-CETTE-VARIABLE
+
+######################################################################
+### General rules
+######################################################################
+
+all: all-html all-pdf all-ps
+
+all-html:\
+  tutorial/Tutorial.v.html refman/html/index.html \
+  faq/html/index.html stdlib/html/index.html RecTutorial/RecTutorial.v.html
+
+all-pdf:\
+  tutorial/Tutorial.v.pdf refman/Reference-Manual.pdf \
+  faq/FAQ.v.pdf stdlib/Library.pdf RecTutorial/RecTutorial.v.pdf
+
+all-ps:\
+  tutorial/Tutorial.v.ps refman/Reference-Manual.ps \
+  faq/FAQ.v.ps stdlib/Library.ps RecTutorial/RecTutorial.v.ps
+
+refman:\
+  refman/html/index.html refman/Reference-Manual.ps refman/Reference-Manual.pdf
+
+tutorial:\
+  tutorial/Tutorial.v.html tutorial/Tutorial.v.ps tutorial/Tutorial.v.pdf
+
+stdlib:\
+  stdlib/html/index.html stdlib/Library.ps stdlib/Library.pdf
+
+faq:\
+  faq/html/index.html faq/FAQ.v.ps faq/FAQ.v.pdf
+
+rectutorial:\
+  RecTutorial/RecTutorial.v.html \
+  RecTutorial/RecTutorial.v.ps RecTutorial/RecTutorial.v.pdf
+
+######################################################################
+### Implicit rules
+######################################################################
+
+.SUFFIXES: .dvi .tex .v.tex .ps .pdf .eps .png
+
+%.v.tex: %.tex
+	(cd `dirname $<`; $(COQTEX) `basename $<`)
+
+%.ps: %.dvi
+	(cd `dirname $<`; dvips -o `basename $@` `basename $<`)
+
+%.eps: %.png
+	pngtopnm $< | pnmtops -equalpixels -noturn -rle > $@
+
+clean:
+	rm -f */*.dvi */*.aux */*.log */*.bbl */*.blg */*.toc \
+	*/*.idx */*~ */*.ilg */*.ind */*.dvi.gz */*.ps.gz */*.pdf.gz\
+	*/*.???idx */*.???ind */*.v.tex */*.atoc */*.lof\
+	*/*.hatoc */*.haux */*.hcomind */*.herrind */*.hidx */*.hind \
+	*/*.htacind */*.htoc */*.v.html
+	rm -f stdlib/index-list.html stdlib/index-body.html \
+	  stdlib/Library.coqdoc.tex stdlib/library.files \
+	  stdlib/library.files.ls
+	rm -f refman/euclid.ml{,i} refman/heapsort.ml{,i}
+	rm -f common/version.tex
+	rm -f refman/*.eps refman/Reference-Manual.html
+
+cleanall: clean
+	rm -f */*.ps */*.pdf
+	rm -rf refman/html stdlib/html faq/html tutorial/tutorial.v.html
+
+######################################################################
+# Common
+######################################################################
+
+COMMON=common/version.tex common/title.tex common/macros.tex 
+
+### Version
+
+common/version.tex: Makefile
+	echo "\newcommand{\coqversion}{$(VERSION)}" > common/version.tex
+
+######################################################################
+# Reference Manual
+######################################################################
+
+REFMANCOQTEXFILES=\
+  refman/RefMan-gal.v.tex refman/RefMan-ext.v.tex \
+  refman/RefMan-mod.v.tex refman/RefMan-tac.v.tex \
+  refman/RefMan-cic.v.tex refman/RefMan-lib.v.tex \
+  refman/RefMan-tacex.v.tex refman/RefMan-syn.v.tex \
+  refman/RefMan-oth.v.tex \
+  refman/Cases.v.tex refman/Coercion.v.tex refman/Extraction.v.tex \
+  refman/Program.v.tex refman/Omega.v.tex refman/Polynom.v.tex \
+  refman/Setoid.v.tex refman/Helm.tex # refman/Natural.v.tex
+
+REFMANTEXFILES=\
+  refman/headers.tex \
+  refman/Reference-Manual.tex refman/RefMan-pre.tex \
+  refman/RefMan-int.tex refman/RefMan-pro.tex \
+  refman/RefMan-com.tex refman/RefMan-ltac.tex \
+  refman/RefMan-uti.tex refman/RefMan-ide.tex \
+  refman/RefMan-add.tex refman/RefMan-modr.tex \
+  $(REFMANCOQTEXFILES) \
+
+REFMANEPSFILES= refman/coqide.eps refman/coqide-queries.eps
+
+REFMANFILES=\
+  $(REFMANTEXFILES) $(COMMON) $(REFMANEPSFILES) refman/biblio.bib
+
+REFMANPNGFILES=$(REFMANEPSFILES:.eps=.png)
+
+### Reference Manual (printable format)
+
+# The second LATEX compilation is necessary otherwise the pages of the index
+# are not correct (don't know why...) - BB
+refman/Reference-Manual.dvi: $(REFMANFILES)
+	(cd refman;\
+	$(LATEX) Reference-Manual;\
+	$(BIBTEX) Reference-Manual;\
+	$(LATEX) Reference-Manual;\
+	$(MAKEINDEX) Reference-Manual;\
+	$(MAKEINDEX) Reference-Manual.tacidx -o Reference-Manual.tacind;\
+	$(MAKEINDEX) Reference-Manual.comidx -o Reference-Manual.comind;\
+	$(MAKEINDEX) Reference-Manual.erridx -o Reference-Manual.errind;\
+	$(LATEX) Reference-Manual;\
+	$(LATEX) Reference-Manual)
+
+refman/Reference-Manual.pdf: refman/Reference-Manual.tex
+	(cd refman; $(PDFLATEX) Reference-Manual.tex)
+
+### Reference Manual (browsable format)
+
+refman/Reference-Manual.html: refman/Reference-Manual.dvi # to ensure bbl file
+	(cd refman; hevea -fix -exec xxdate.exe ./Reference-Manual.tex)
+
+refman/html/index.html: refman/Reference-Manual.html $(REFMANPNGFILES) \
+                        refman/cover.html refman/index.html
+	- rm -rf refman/html
+	mkdir refman/html
+	cp $(REFMANPNGFILES) refman/html
+	(cd refman/html; hacha -o toc.html ../Reference-Manual.html)
+	cp refman/cover.html refman/html
+	cp refman/index.html refman/html
+
+######################################################################
+# Tutorial
+######################################################################
+
+tutorial/Tutorial.v.dvi: common/version.tex common/title.tex tutorial/Tutorial.v.tex
+	(cd tutorial; $(LATEX) Tutorial.v)
+
+tutorial/Tutorial.v.pdf: common/version.tex common/title.tex tutorial/Tutorial.v.dvi
+	(cd tutorial; $(PDFLATEX) Tutorial.v.tex)
+
+tutorial/Tutorial.v.html: tutorial/Tutorial.v.tex
+	(cd tutorial; hevea -exec xxdate.exe Tutorial.v)
+
+
+######################################################################
+# FAQ
+######################################################################
+
+faq/FAQ.v.dvi: common/version.tex common/title.tex faq/FAQ.v.tex
+	(cd faq;\
+	$(LATEX) FAQ.v;\
+	$(BIBTEX) FAQ.v;\
+	$(LATEX) FAQ.v;\
+	$(LATEX) FAQ.v)
+
+faq/FAQ.v.pdf: common/version.tex common/title.tex faq/FAQ.v.dvi faq/axioms.png
+	(cd faq; $(PDFLATEX) FAQ.v.tex)
+
+faq/FAQ.v.html: faq/FAQ.v.dvi # to ensure FAQ.v.bbl
+	(cd faq; hevea -fix FAQ.v.tex)
+
+faq/html/index.html: faq/FAQ.v.html
+	- rm -rf faq/html
+	mkdir faq/html
+	cp faq/interval_discr.v faq/axioms.png faq/html
+	cp faq/FAQ.v.html faq/html/index.html
+
+######################################################################
+# Standard library
+######################################################################
+
+GLOBDUMP=$(COQTOP)/glob.dump
+
+LIBDIRS= Logic Bool Arith ZArith Reals Lists Sets Relations Sorting Wellfounded IntMap FSets
+
+### Standard library (browsable html format)
+
+stdlib/index-body.html: $(GLOBDUMP)
+	- rm -rf stdlib/html
+	mkdir stdlib/html
+	(cd stdlib/html;\
+	 $(COQDOC) -q --multi-index --html --glob-from $(GLOBDUMP)\
+	  -R $(COQTOP)/theories Coq $(COQTOP)/theories/*/*.v)
+	mv stdlib/html/index.html stdlib/index-body.html
+
+stdlib/index-list.html: stdlib/index-list.html.template
+	COQTOP=$(COQTOP) ./stdlib/make-library-index stdlib/index-list.html
+
+stdlib/html/index.html: stdlib/index-list.html stdlib/index-body.html stdlib/index-trailer.html
+	cat stdlib/index-list.html > $@
+	sed -n -e '/<table>/,/<\/table>/p' stdlib/index-body.html >> $@
+	cat stdlib/index-trailer.html >> $@
+
+### Standard library (printable format - produces > 350 pages)
+
+stdlib/Library.coqdoc.tex: 
+	(for dir in $(LIBDIRS) ; do \
+	  $(COQDOC) -q --gallina --body-only --latex --stdout \
+            -R $(COQTOP)/theories Coq "$(COQTOP)/theories/$$dir/"*.v >> $@ ; done)
+
+stdlib/Library.dvi: $(COMMON) stdlib/Library.coqdoc.tex stdlib/Library.tex
+	(cd stdlib;\
+	$(LATEX) Library;\
+	$(LATEX) Library)
+
+stdlib/Library.pdf: $(COMMON) stdlib/Library.coqdoc.tex stdlib/Library.dvi
+	(cd stdlib; $(PDFLATEX) Library)
+
+######################################################################
+# Tutorial on inductive types
+######################################################################
+
+RecTutorial/RecTutorial.v.dvi: common/version.tex common/title.tex RecTutorial/RecTutorial.v.tex
+	(cd RecTutorial;\
+	 $(LATEX) RecTutorial.v;\
+	 $(BIBTEX) RecTutorial.v;\
+	 $(LATEX) RecTutorial.v;\
+	 $(LATEX) RecTutorial.v)
+
+RecTutorial/RecTutorial.v.pdf: common/version.tex common/title.tex RecTutorial/RecTutorial.v.dvi
+	(cd RecTutorial; $(PDFLATEX) RecTutorial.v.tex)
+
+RecTutorial/RecTutorial.v.html: RecTutorial/RecTutorial.v.tex
+	(cd RecTutorial; hevea -exec xxdate.exe RecTutorial.v)
+
+
+######################################################################
+# Install all documentation files
+######################################################################
+
+COQINSTALLPREFIX=
+DOCDIR=/usr/local/share/doc/coq-8.0
+FULLDOCDIR=$(COQINSTALLPREFIX)$(DOCDIR)
+HTMLINSTALLDIR=$(FULLDOCDIR)/html
+PRINTABLEINSTALLDIR=$(FULLDOCDIR)/ps
+
+install-doc: install-meta install-doc-html install-doc-printable
+
+install-meta:
+	mkdir $(DOCDIC)
+	cp LICENCE $(DOCDIC)/LICENCE.doc
+#	cp $(COQTOP)/LICENCE $(COQTOP)/CREDITS $(COQTOP)/COPYRIGHT $(DOCDIC)
+#	cp $(COQTOP)/README $(COQTOP)/CHANGES $(DOCDIC)
+
+install-doc-html: all-html
+	mkdir $(HTMLINSTALLDIR)
+	cp -r refman/html $(HTMLINSTALLDIR)/refman
+	cp -r stdlib/html $(HTMLINSTALLDIR)/stdlib
+	cp -r tutorial/tutorial.html $(HTMLINSTALLDIR)/
+	cp -r RecTutorial/RecTutorial.html $(HTMLINSTALLDIR)/
+	cp -r faq/html $(HTMLINSTALLDIR)/faq
+
+install-doc-printable: all-pdf all-ps
+	mkdir $(PRINTABLEINSTALLDIR)
+	cp -r refman/Reference-manual.pdf $(PRINTABLEINSTALLDIR)
+	cp -r stdlib/Library.pdf $(PRINTABLEINSTALLDIR)
+	cp -r tutorial/Tutorial.v.pdf $(PRINTABLEINSTALLDIR)/Tutorial.pdf
+	cp -r RecTutorial/RecTutorial.v.pdf $(PRINTABLEINSTALLDIR)/RecTutorial.pdf
+	cp -r faq/FAQ.v.pdf $(PRINTABLEINSTALLDIR)/FAQ.pdf
+	cp -r refman/Reference-manual.ps $(PRINTABLEINSTALLDIR)
+	cp -r stdlib/Library.ps $(PRINTABLEINSTALLDIR)
+	cp -r tutorial/Tutorial.v.ps $(PRINTABLEINSTALLDIR)/Tutorial.ps
+	cp -r RecTutorial/RecTutorial.v.ps $(PRINTABLEINSTALLDIR)/RecTutorial.ps
+	cp -r faq/FAQ.v.ps $(PRINTABLEINSTALLDIR)/FAQ.ps
diff --git a/doc/Makefile.rt b/doc/Makefile.rt
new file mode 100644
index 00000000..6c328134
--- /dev/null
+++ b/doc/Makefile.rt
@@ -0,0 +1,43 @@
+# Makefile for building Coq Technical Reports
+
+# if coqc,coqtop,coq-tex are not in your PATH, you need the environment 
+# variable COQBIN to be correctly set  
+# (COQTOP is autodetected)
+# (some files are preprocessed using Coq and some part of the documentation
+# is automatically built from the theories sources)
+
+# To compile documentation, you need the following tools:
+# Dvi: latex (latex2e), bibtex, makeindex, dviselect (package RPM dviutils)
+# Ps: dvips, psutils (ftp://ftp.dcs.ed.ac.uk/pub/ajcd/psutils.tar.gz)
+# Pdf: pdflatex
+# Html:
+#   - hevea: http://para.inria.fr/~maranget/hevea/
+#   - htmlSplit: http://coq.inria.fr/~delahaye
+# Rapports INRIA: dviselect, rrkit (par Michel Mauny)
+
+include ./Makefile
+
+###################
+# RT
+###################
+# Fabrication d'un RT INRIA (utilise rrkit de Michel Mauny)
+rt/Reference-Manual-RT.dvi: refman/Reference-Manual.dvi rt/RefMan-cover.tex
+	dviselect -i refman/Reference-Manual.dvi -o rt/RefMan-body.dvi 3:
+	(cd rt; $(LATEX) RefMan-cover.tex)
+	set a=`tail -1 refman/Reference-Manual.log`;\
+	set a=expr \("$$a" : '.*(\(.*\) pages.*'\) % 2;\
+	(cd rt; if $(TEST) "$$a = 0";\
+	 then rrkit  RefMan-cover.dvi RefMan-body.dvi Reference-Manual-RT.dvi;\
+	 else rrkit -odd RefMan-cover.dvi RefMan-body.dvi Reference-Manual-RT.dvi;\
+	fi)
+
+# Fabrication d'un RT INRIA (utilise rrkit de Michel Mauny)
+rt/Tutorial-RT.dvi : tutorial/Tutorial.v.dvi rt/Tutorial-cover.tex
+	dviselect -i rt/Tutorial.v.dvi -o rt/Tutorial-body.dvi 3:
+	(cd rt; $(LATEX) Tutorial-cover.tex)
+	set a=`tail -1 tutorial/Tutorial.v.log`;\
+	set a=expr \("$$a" : '.*(\(.*\) pages.*'\) % 2;\
+	(cd rt; if $(TEST) "$$a = 0";\
+	 then rrkit      Tutorial-cover.dvi Tutorial-body.dvi Tutorial-RT.dvi;\
+	 else rrkit -odd Tutorial-cover.dvi Tutorial-body.dvi Tutorial-RT.dvi;\
+	fi)
diff --git a/doc/README b/doc/README
new file mode 100755
index 00000000..14cb6e44
--- /dev/null
+++ b/doc/README
@@ -0,0 +1,30 @@
+You can get the whole documentation of Coq in the tar file all-ps-docs.tar.
+
+You can also get separately each document. The documentation of Coq
+V8.0 is divided into the following documents :
+
+     * Tutorial.ps: An introduction to the use of the Coq Proof Assistant;
+
+     * Reference-Manual.ps:
+
+       Base chapters:
+       - the description of Gallina, the language of Coq
+       - the description of the Vernacular, the commands of Coq
+       - the description of each tactic
+       - index on tactics, commands and error messages
+
+       Additional chapters:
+       - the extended Cases (C.Cornes)
+       - the coercions (A. Saïbi)
+       - the tactic Omega (P. Crégut)
+       - the extraction features (J.-C. Filliâtre and P. Letouzey) 
+       - the tactic Ring (S. Boutin and P. Loiseleur)
+       - the Setoid_replace tactic (C. Renard)
+       - etc.
+
+     * Library.ps: A description of the Coq standard library;
+
+     * rectypes.ps : A tutorial on recursive types by Eduardo Gimenez
+
+Documentation is also available in the PDF format and HTML format
+(online at http://coq.inria.fr or by ftp in the file doc-html.tar.gz).
diff --git a/doc/RecTutorial/RecTutorial.tex b/doc/RecTutorial/RecTutorial.tex
new file mode 100644
index 00000000..9ee913d4
--- /dev/null
+++ b/doc/RecTutorial/RecTutorial.tex
@@ -0,0 +1,3606 @@
+\documentclass[11pt]{article}
+\title{A Tutorial on [Co-]Inductive Types in Coq}
+\author{Eduardo Gim\'enez\thanks{Eduardo.Gimenez@inria.fr},
+Pierre Cast\'eran\thanks{Pierre.Casteran@labri.fr}}
+\date{May 1998 --- \today}
+
+\usepackage{multirow}
+\usepackage{aeguill}
+%\externaldocument{RefMan-gal.v}
+%\externaldocument{RefMan-ext.v}
+%\externaldocument{RefMan-tac.v}
+%\externaldocument{RefMan-oth}
+%\externaldocument{RefMan-tus.v}
+%\externaldocument{RefMan-syn.v}
+%\externaldocument{Extraction.v}
+\input{recmacros}
+\input{coqartmacros}
+\newcommand{\refmancite}[1]{{}}
+%\newcommand{\refmancite}[1]{\cite{coqrefman}}
+%\newcommand{\refmancite}[1]{\cite[#1] {]{coqrefman}}
+
+\usepackage[latin1]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage{makeidx}
+%\usepackage{multind}
+\usepackage{alltt}   
+\usepackage{verbatim}
+\usepackage{amssymb}
+\usepackage{amsmath}
+\usepackage{theorem}
+\usepackage[dvips]{epsfig}
+\usepackage{epic}
+\usepackage{eepic}
+\usepackage{ecltree}
+\usepackage{moreverb} 
+\usepackage{color}
+\usepackage{pifont}
+\usepackage{xr}
+\usepackage{url}
+
+\usepackage{alltt}
+\renewcommand{\familydefault}{ptm}
+\renewcommand{\seriesdefault}{m}
+\renewcommand{\shapedefault}{n}
+\newtheorem{exercise}{Exercise}[section]	
+\makeindex
+\begin{document}
+\maketitle
+
+\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
+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,
+co-induction, etc).  Each technique is illustrated through an
+executable and self-contained {\coq} script.  
+\end{abstract}
+%\RRkeyword{Proof environments, recursive types.}
+%\makeRT
+
+\addtocontents{toc}{\protect \thispagestyle{empty}}
+\pagenumbering{arabic}
+
+\cleardoublepage
+\tableofcontents
+\clearpage
+
+\section{About this document}
+
+This document is an introduction to the definition and use of
+inductive and co-inductive  types in the {\coq} proof environment.  It was born from the
+notes written for the course about the version V5.10 of {\coq}, given
+by Eduardo Gimenez  at
+the Ecole Normale Sup\'erieure de Lyon in March 1996. This article is
+a revised and improved version of these notes for the version V8.0 of
+the system.
+
+
+We assume that the reader has some familiarity with the
+proofs-as-programs paradigm of Logic \cite{Coquand:metamathematical} and the generalities
+of the {\coq} system \cite{coqrefman}.  You would take a greater advantage of
+this document if you first read the general tutorial about {\coq} and
+{\coq}'s FAQ, both available on \cite{coqsite}.
+A text book \cite{coqart},  accompanied with a lot of
+examples and exercises \cite{Booksite}, presents a detailed description
+of the {\coq} system and its underlying
+formalism: the Calculus of Inductive Construction.
+Finally, the complete description of {\coq}  is given in the reference manual
+\cite{coqrefman}. Most of the tactics and commands we describe have
+several options, which we do not present exhaustively. 
+If some script herein uses a non described feature, please refer to
+the Reference Manual.
+
+
+If you are familiar with other proof environments
+based on type theory and the LCF style ---like PVS, LEGO, Isabelle,
+etc--- then you will find not difficulty to guess the unexplained
+details.
+
+The better way to read this document is to start up the {\coq} system,
+type by yourself the examples and exercises, and observe the
+behavior of the system. All the examples proposed in this tutorial
+can be downloaded from the same site as the present document. 
+
+
+The tutorial is organised as follows. The next section describes how
+inductive types are defined in {\coq}, and introduces some useful ones,
+like natural numbers, the empty type, the propositional equality type,
+and the logical connectives. Section \ref{CaseAnalysis} explains
+definitions by pattern-matching and their connection with the
+principle of case analysis. This principle is the most basic
+elimination rule associated with inductive or co-inductive types
+ and follows a
+general scheme that we illustrate for some of the types introduced in
+Section \ref{Introduction}.  Section \ref{CaseTechniques} illustrates
+the pragmatics of this principle, showing different proof techniques
+based on it. Section \ref{StructuralInduction} introduces definitions
+by structural recursion and proofs by induction. 
+Section~\ref{CaseStudy} presents some elaborate techniques
+about dependent case analysis. Finally, Section
+\ref{CoInduction} is a brief introduction to co-inductive types
+--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.
+
+\subsection*{Lexical conventions}
+The \texttt{typewriter} font is used to represent text
+input by the user, while the \textit{italic} font is used to represent
+the text output by the system as answers.  
+
+
+Moreover, the mathematical symbols \coqle{}, \coqdiff, \(\exists\),
+\(\forall\), \arrow{}, $\rightarrow{}$ \coqor{}, \coqand{}, and \funarrow{} 
+stand for the character strings \citecoq{<=}, \citecoq{<>},
+\citecoq{exists}, \citecoq{forall}, \citecoq{->}, \citecoq{<-},
+\texttt{\char'134/}, \texttt{/\char'134}, and \citecoq{=>},
+respectively.  For instance, the \coq{} statement
+%V8 A prendre
+% 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{).}
+\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{).}
+\end{alltt}
+
+When a fragment of \coq{} input text appears in the middle of
+regular text, we often place this fragment between double quotes
+``\dots.''  These double quotes do not belong to the \coq{} syntax.
+
+Finally, any
+string enclosed between \texttt{(*} and \texttt{*)} is a comment and
+is ignored by the \coq{} system.
+
+\section{Introducing Inductive Types} 
+\label{Introduction}
+
+Inductive types are types closed with respect to their introduction
+rules. These rules explain the most basic or \textsl{canonical} ways
+of constructing an element of the type.  In this sense, they
+characterize the recursive type. Different rules must be considered as
+introducing different objects. In order to fix ideas, let us introduce
+in {\coq} the most well-known example of a recursive type: the type of
+natural numbers.
+
+%V8 A prendre
+\begin{alltt}
+Inductive nat : Set := 
+ | O : nat 
+ | S : nat\arrow{}nat.
+\end{alltt}
+
+The definition of a recursive type has two main parts. First, we
+establish what kind of recursive type we will characterize (a set, in
+this case). Second, we present the introduction rules that define the
+type ({\Z} and {\SUCC}), also called its {\sl constructors}. The constructors
+{\Z} and {\SUCC} determine all the elements of this type. In other
+words, if $n\mbox{:}\nat$, then $n$ must have been introduced either
+by the rule {\Z} or by an application of the rule {\SUCC} to a
+previously constructed natural number. In this sense, we can say
+that {\nat} is \emph{closed}. On the contrary, the type
+$\Set$ is an {\it open} type, since we do not know {\it a priori} all
+the possible ways of introducing an object of type \texttt{Set}.
+
+After entering this command, the constants {\nat}, {\Z} and {\SUCC} are
+available in the current context. We can see their types using the
+\texttt{Check} command \refmancite{Section \ref{Check}}:
+
+%V8 A prendre 
+\begin{alltt}
+Check nat.
+\it{}nat : Set
+\tt{}Check O.
+\it{}O : nat
+\tt{}Check S.
+\it{}S : nat {\arrow} nat
+\end{alltt}
+
+Moreover, {\coq} adds to the context three constants named
+ $\natind$, $\natrec$ and $\natrect$, which
+ correspond to different principles of structural induction on
+natural numbers that {\coq} infers automatically from the definition.  We
+will come back to them in Section \ref{StructuralInduction}.
+
+
+In fact, the type of natural numbers as well as several useful
+theorems about them are already defined in the basic library of {\coq},
+so there is no need to introduce them.  Therefore, let us throw away
+our (re)definition of {\nat}, using the command \texttt{Reset}.
+
+%V8 A prendre
+\begin{alltt}
+Reset nat.
+Print nat.
+\it{}Inductive nat : Set :=  O : nat | S : nat \arrow{} nat
+For S: Argument scope is [nat_scope]
+\end{alltt}
+
+Notice that \coq{}'s \emph{interpretation scope} for natural numbers
+(called \texttt{nat\_scope}) 
+allows us to read and write natural numbers in decimal form (see \cite{coqrefman}). For instance, the constructor \texttt{O} can be read or written
+as the digit $0$, and the term ``~\texttt{S (S (S O))}~'' as $3$.
+
+%V8 A prendre
+\begin{alltt}
+Check O.
+\it 0 : nat.
+\tt
+Check (S (S (S O))).
+\it 3 : nat
+\end{alltt}
+
+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}:
+
+\begin{alltt}
+Require Import List.
+Print list.
+\it
+Inductive list (A : Set) : Set :=
+    nil : list A | cons : A {\arrow} list A {\arrow} list A
+For nil: Argument A is implicit
+For cons: Argument A is implicit
+For list: Argument scope is [type_scope]
+For nil: Argument scope is [type_scope]
+For cons: Argument scopes are [type_scope _ _]
+\end{alltt}
+
+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}.
+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 
+when {\coq}'s type inference algorithm cannot infer the implicit
+parameter \citecoq{A}.
+\begin{alltt}
+Check list.
+\it list
+     : Set {\arrow} Set
+
+\tt Check (nil (A:=nat)).
+\it nil
+     : list nat
+
+\tt Check (nil (A:= nat {\arrow} nat)).
+\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 (cons 3 (cons 2 nil)).
+\it 3 :: 2 :: nil
+     : list nat
+\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$}~''
+is the type of vectors of elements of $A$ and size $n$.
+
+
+\begin{alltt}
+Require Import  Bvector.
+
+Print vector.
+\it
+Inductive vector (A : Set) : nat {\arrow} Set :=
+    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]
+For Vnil: Argument scope is [type_scope]
+For Vcons: Argument scopes are [type_scope _ nat_scope _]
+\end{alltt}
+
+
+Remark the difference between the two parameters $A$ and $n$:
+The first one is a \textsl{general parameter}, global to all the
+introduction rules,while the second one is an \textsl{index}, which is
+instantiated differently in the introduction rules.
+Such types parameterized  by regular
+values are called \emph{dependent types}.
+
+\begin{alltt}
+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 (Vcons _ 5 _ (Vcons _ 3 _ (Vnil _))).
+\it Vcons nat 5 1 (Vcons nat 3 0 (Vnil nat))
+     : vector nat 2
+\end{alltt}
+
+\subsection{The contradictory proposition.}
+Another example of an inductive type is the contradictory proposition.
+This type inhabits the universe of propositions, and has no element
+at all.
+%V8 A prendre
+\begin{alltt}
+Print False.
+\it{} Inductive False : Prop :=
+\end{alltt}
+
+\noindent Notice that no constructor is given in this definition.
+
+\subsection{The tautological proposition.}
+Similarly, the
+tautological proposition {\True} is defined as an inductive type
+with only one element {\I}:
+
+%V8 A prendre
+\begin{alltt}
+Print True.
+\it{}Inductive True : Prop :=  I : True
+\end{alltt}
+
+\subsection{Relations as inductive types.}
+Some relations can also be introduced in a smart way as an inductive family
+of propositions. Let us take as example the order $n \leq m$ on natural
+numbers, called \citecoq{le} in {\coq}.
+ This relation is introduced through
+the following definition, quoted from the standard library\footnote{In the interpretation scope
+for Peano arithmetic:
+\citecoq{nat\_scope},  ``~\citecoq{n <= m}~'' is equivalent to 
+``~\citecoq{le n m}~'' .}:
+
+
+
+
+%V8 A prendre
+\begin{alltt}
+Print le. \it
+Inductive le (n:nat) : nat\arrow{}Prop := 
+|  le_n: n {\coqle} n 
+|  le_S: {\prodsym} m, n {\coqle} m \arrow{} n {\coqle} S m.
+\end{alltt}
+
+Notice that in this definition $n$ is a general parameter,
+while the second argument of \citecoq{le} is an index (see section
+~\ref{vectors}).
+ This definition
+introduces the binary relation $n {\leq} m$ as the family of unary predicates
+``\textsl{to be greater or equal than a given $n$}'', parameterized by $n$.
+
+The introduction rules of this type can be seen as a sort of Prolog
+rules for proving that a given integer $n$ is less or equal than another one.
+In fact, an object of type $n{\leq} m$ is nothing but a proof 
+built up using the constructors \textsl{le\_n} and
+\textsl{le\_S} of this type.  As an example, let us construct
+a proof that zero is less or equal than three using {\coq}'s interactive
+proof mode.
+Such an object can be obtained applying three times the second
+introduction rule of \citecoq{le}, to a proof that zero is less or equal
+than itself,
+which is provided by the first constructor of \citecoq{le}:
+
+%V8 A prendre
+\begin{alltt}
+Theorem zero_leq_three: 0 {\coqle} 3.
+Proof.
+\it{} 1 subgoal
+
+============================
+ 0 {\coqle} 3
+
+\tt{}Proof.
+ constructor 2. 
+
+\it{} 1 subgoal
+============================
+  0 {\coqle} 2
+
+\tt{} constructor 2.  
+\it{} 1 subgoal
+============================
+  0 {\coqle} 1
+
+\tt{} constructor 2
+\it{} 1 subgoal
+============================
+  0 {\coqle} 0
+
+\tt{} constructor 1.
+
+\it{}Proof completed
+\tt{}Qed.
+\end{alltt}
+
+\noindent When
+the current goal is an inductive type, the tactic 
+``~\citecoq{constructor $i$}~'' \refmancite{Section \ref{constructor}} applies the $i$-th constructor in the
+definition of the type. We can take a look at the proof constructed
+using the command \texttt{Print}:
+
+%V8 A prendre
+\begin{alltt}
+Print Print zero_leq_three.
+\it{}zero_leq_three = 
+zero_leq_three = le_S 0 2 (le_S 0 1 (le_S 0 0 (le_n 0)))
+     : 0 {\coqle} 3
+\end{alltt}
+
+When the parameter $i$ is not supplied, the tactic \texttt{constructor}
+tries to apply ``~\texttt{constructor $1$}~'', ``~\texttt{constructor $2$}~'',\dots,
+``~\texttt{constructor $n$}~'' where $n$ is the number of constructors
+of the inductive type (2 in our example) of the conclusion of the goal.
+Our little proof can thus be obtained iterating the tactic
+\texttt{constructor} until it fails:
+
+%V8 A prendre
+\begin{alltt}
+Lemma zero_leq_three': 0 {\coqle} 3.
+ repeat constructor.
+Qed.
+\end{alltt}
+
+Notice that the strict order on \texttt{nat}, called \citecoq{lt}
+is not inductively defined:
+
+\begin{alltt}
+Print lt.
+\it
+lt = fun n m : nat {\funarrow} S n {\coqle} m
+     : nat {\arrow} nat {\arrow} Prop
+\tt
+Lemma zero_lt_three : 0 < 3.
+Proof.
+ unfold lt.
+\it
+====================
+ 1 {\coqle} 3
+\tt
+ repeat constructor. 
+Qed.
+\end{alltt}
+
+
+
+\subsection{The propositional equality type.} \label{equality}
+In {\coq}, the propositional equality between two inhabitants $a$ and
+$b$ of
+the same type $A$ ,
+noted $a=b$, is introduced as a family of recursive predicates
+``~\textsl{to be equal to $a$}~'',  parameterised by both $a$ and its type
+$A$. This family of types has only one introduction rule, which
+corresponds to reflexivity.
+Notice that the syntax ``\citecoq{$a$ = $b$}~'' is an abbreviation  
+for ``\citecoq{eq $a$  $b$}~'', and that the parameter $A$ is \emph{implicit},
+as it can be infered from $a$.
+%V8 A prendre
+\begin{alltt}
+Print eq.
+\it{} Inductive eq (A : Type) (x : A) : A \arrow{} Prop :=  
+    refl_equal : x = x
+For eq: Argument A is implicit
+For refl_equal: Argument A is implicit
+For eq: Argument scopes are [type_scope _ _]
+For refl_equal: Argument scopes are [type_scope _]
+\end{alltt}
+
+Notice also that  the first parameter $A$ of \texttt{eq} has type
+\texttt{Type}. The type system of {\coq} allows us to consider equality between 
+various kinds of terms: elements of a set, proofs, propositions,
+types, and so on.
+Look at \cite{coqrefman, coqart} to get more details on {\coq}'s type
+system, as well as implicit arguments and argument scopes.
+
+
+\begin{alltt}
+Lemma eq_3_3 : 2 + 1 = 3.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma eq_proof_proof : refl_equal (2*6) = refl_equal (3*4).
+Proof.
+ reflexivity.
+Qed.
+
+Print eq_proof_proof.
+\it eq_proof_proof = 
+refl_equal (refl_equal (3 * 4))
+     : refl_equal (2 * 6) = refl_equal (3 * 4)
+\tt
+
+Lemma eq_lt_le : ( 2 < 4) = (3 {\coqle} 4).
+Proof.
+ reflexivity.
+Qed.
+
+Lemma eq_nat_nat : nat = nat.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma eq_Set_Set : Set = Set.
+Proof.
+ reflexivity.
+Qed.
+\end{alltt}
+
+\subsection{Logical connectives.} \label{LogicalConnectives}
+The conjunction and disjunction of two propositions are also examples
+of recursive types:
+
+\begin{alltt}
+Inductive or (A B : Prop) : Prop :=
+    or_introl : A \arrow{} A {\coqor} B | or_intror : B \arrow{} A {\coqor} B
+
+Inductive and (A B : Prop) : Prop :=  
+    conj : A \arrow{} B \arrow{} A {\coqand} B
+
+\end{alltt}
+
+The propositions $A$ and $B$ are general parameters of these
+connectives. Choosing different universes for 
+$A$ and $B$ and for the inductive type itself gives rise to different
+type constructors. For example, the type \textsl{sumbool} is a
+disjunction but with computational contents.
+
+\begin{alltt}
+Inductive sumbool (A B : Prop) : Set :=
+    left : A \arrow{} \{A\} + \{B\} | right : B \arrow{} \{A\} + \{B\}
+\end{alltt}
+
+
+
+This type --noted \texttt{\{$A$\}+\{$B$\}} in {\coq}-- can be used in {\coq}
+programs as a sort of boolean type, to check whether it is $A$ or $B$
+that is true.  The values ``~\citecoq{left $p$}~'' and
+``~\citecoq{right $q$}~'' replace the boolean values \textsl{true} and
+\textsl{false}, respectively. The advantage of this type over
+\textsl{bool} is that it makes available the proofs $p$ of $A$ or $q$
+of $B$, which could be necessary to construct a verification proof
+about the program.
+For instance, let us consider the certified program \citecoq{le\_lt\_dec}
+of the Standard Library.
+
+\begin{alltt}
+Require Import Compare_dec.
+Check le_lt_dec.
+\it
+le_lt_dec
+     : {\prodsym} n m : nat, \{n {\coqle} m\} + \{m < n\}
+
+\end{alltt}
+
+We use \citecoq{le\_lt\_dec} to build a function for computing
+the max of two natural numbers:
+
+\begin{alltt}
+Definition max (n p :nat) := match le_lt_dec n p with 
+                             | left _ {\funarrow} p
+                             | right _ {\funarrow} n
+                             end.
+\end{alltt}
+
+In the following proof, the case analysis on the term
+``~\citecoq{le\_lt\_dec n p}~'' gives us an access to proofs
+of $n\leq p$ in the first case, $p<n$ in the other.
+
+\begin{alltt}
+Theorem le_max : {\prodsym} n p, n {\coqle} p {\arrow} max n p = p.
+Proof.
+ intros n p ; unfold max ; case (le_lt_dec n p); simpl.
+\it
+2 subgoals
+  
+  n : nat
+  p : nat
+  ============================
+   n {\coqle} p {\arrow} n {\coqle} p {\arrow} p = p
+
+subgoal 2 is:
+ p < n {\arrow} n {\coqle} p {\arrow} n = p
+\tt
+ trivial.
+ intros; absurd (p < p); eauto with arith.
+Qed.
+\end{alltt}
+
+
+ Once the program verified, the proofs are
+erased by the extraction procedure:
+
+\begin{alltt}
+Extraction max.
+\it
+(** val max : nat {\arrow} nat {\arrow} nat **)
+
+let max n p =
+  match le_lt_dec n p with
+    | Left {\arrow} p
+    | Right {\arrow} n
+\end{alltt}
+
+Another example of use of \citecoq{sumbool} is given  in Section
+\ref{WellFoundedRecursion}.
+
+\subsection{The existential quantifier.}\label{ex-def}
+The existential quantifier is yet another example of a logical
+connective introduced as an inductive type.
+
+\begin{alltt}
+Inductive ex (A : Type) (P : A \arrow{} Prop) : Prop :=
+    ex_intro : {\prodsym} x : A, P x \arrow{} ex P
+\end{alltt}
+
+Notice that {\coq} uses the abreviation ``~\citecoq{\exsym\,$x$:$A$, $B$}~''
+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$,
+which is noted \texttt{sig $P$}. The syntax
+``~\citecoq{\{$x$:$A$ | $B$\}}~'' is an abreviation for ``~\citecoq{sig (fun $x$:$A$ {\funarrow} $B$)}~''.
+
+
+
+%\paragraph{The logical connectives.} Conjuction and disjuction are 
+%also introduced as recursive types:
+%\begin{alltt}
+%Print or.
+%\end{alltt}
+%begin{alltt}
+%Print and.
+%\end{alltt}
+
+
+\subsection{Mutually Dependent Definitions}
+\label{MutuallyDependent}
+
+Mutually dependent definitions of recursive types are also allowed in
+{\coq}.  A typical example of these kind of declaration is the
+introduction of the trees of unbounded (but finite) width:
+\label{Forest}
+\begin{alltt} 
+Inductive tree(A:Set)   : Set :=
+    node : A {\arrow} forest A \arrow{} tree A 
+with  forest (A: Set)   : Set := 
+    nochild  : forest A |
+    addchild : tree A \arrow{} forest A \arrow{} forest A.
+\end{alltt}
+\noindent  Yet another example of mutually dependent types are the
+predicates \texttt{even} and \texttt{odd} on natural numbers:
+\label{Even}
+\begin{alltt} 
+Inductive 
+  even    : nat\arrow{}Prop :=
+    evenO : even  O |
+    evenS : {\prodsym} n, odd n \arrow{} even (S n)
+with
+  odd    : nat\arrow{}Prop :=
+    oddS : {\prodsym} n, even n \arrow{} odd (S n).
+\end{alltt}
+
+\begin{alltt}
+Lemma odd_49 : odd (7 * 7).
+ simpl; repeat constructor.
+Qed.
+\end{alltt}
+
+
+
+\section{Case Analysis and Pattern-matching}
+\label{CaseAnalysis}
+\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}.
+
+
+For instance, any value of type {\nat} is built using either \texttt{O} or \texttt{S}.
+Thus, a systematic way of building a value of type $B$ from any 
+value of type {\nat} is to associate to \texttt{O} a constant $t_O:B$ and
+to every term of the form ``~\texttt{S $p$}~'' a term $t_S:B$. The following
+construction has type $B$:
+\begin{alltt}
+match \(n\) return \(B\) with O \funarrow \(t\sb{O}\) | S p \funarrow \(t\sb{S}\) end
+\end{alltt}
+
+
+In most of the cases, {\coq} is able to infer the type $B$ of the object
+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$:)
+
+\begin{eqnarray*}
+\texttt{match $O$ return $b$ with O {\funarrow} $t_O$ | S p {\funarrow} $t_S$ end} &\Longrightarrow& t_O\\
+\texttt{match $S\;q$  return $b$ with O {\funarrow} $t_O$ | S p {\funarrow} $t_S$ end}  &\Longrightarrow& t_S\{q/\texttt{p}\}
+\end{eqnarray*}
+
+
+\subsubsection{Example: the predecessor function.}\label{firstpred}
+An example of a definition by case analysis is the function which
+computes the predecessor of any given natural number:
+\begin{alltt}
+Definition pred (n:nat) := match n with
+                                   | O {\funarrow} O 
+                                   | S m {\funarrow} m 
+                           end.
+
+Eval simpl in pred 56.
+\it{}    = 55
+     : nat
+\tt
+Eval simpl in pred 0.
+\it{}    = 0
+     : nat
+
+\tt{}Eval simpl in fun p {\funarrow} pred (S p).
+\it{}     = fun p : nat {\funarrow} p
+     : nat {\arrow} nat
+\end{alltt}
+
+As in functional programming, tuples and wild-cards can be used in
+patterns \refmancite{Section \ref{ExtensionsOfCases}}. Such
+definitions are automatically compiled by {\coq} into an expression which
+may contain several nested case expressions. For example, the 
+exclusive \emph{or} on booleans can be defined as follows:
+\begin{alltt}
+Definition xorb (b1 b2:bool) :=
+ match b1, b2 with 
+ | false, true {\funarrow} true
+ | true, false {\funarrow} true
+ | _ , _       {\funarrow} false
+ end.
+\end{alltt}
+
+This kind of definition is compiled in {\coq} as follows\footnote{{\coq} uses
+the conditional ``~\citecoq{if $b$ then $a$ else $b$}~'' as an abreviation to
+``~\citecoq{match $b$ with true \funarrow{} $a$ | false \funarrow{} $b$ end}~''.}:
+
+\begin{alltt}
+Print xorb.
+xorb = 
+fun b1 b2 : bool {\funarrow}
+if b1 then if b2 then false else true 
+      else if b2 then true else false
+     : bool {\arrow} bool {\arrow} bool
+\end{alltt}
+
+\subsection{Dependent Case Analysis}
+\label{DependentCase}
+
+For a pattern matching construct of the form
+``~\citecoq{match n with \dots end}~'' a more general typing rule
+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}$.
+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)$.
+Notice that the terms $t_O$ and $t_S$ do not have the same type.
+
+The syntax of the \emph{dependent case analysis} and its
+associated typing rule make precise how the resulting
+type depends on the argument of the pattern matching, and
+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
+\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}}
+\end{array}
+\]
+
+
+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}
+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
+$(\SUCC\;p)$.  The former, non-dependent version of case analysis can
+be obtained from this latter rule just taking $Q$ as a constant
+function on $n$.
+
+Notice that destructuring $n$ into \citecoq{O} or ``~\citecoq{S p}~''
+ doesn't
+make appear in the goal the equalities ``~$n=\citecoq{O}$~''
+ and ``~$n=\citecoq{S p}$~''.
+They are ``internalized'' in the rules above (see section~\ref{inversion}.)
+
+\subsubsection{Example: strong specification of the predecessor function.}
+
+In Section~\ref{firstpred}, the predecessor function was defined directly
+as a function from \texttt{nat} to \texttt{nat}. It remains to prove
+that this function has some desired properties. Another way to proceed
+is to, first introduce a specification of what is the predecessor of a 
+natural number, under the form of a {\coq} type, then build an inhabitant 
+of this type: in other words, a realization of this specification. This way, the correctness
+of this realization is ensured by {\coq}'s type system.
+
+A reasonable specification for $\pred$ is to say that for all $n$
+there exists another $m$ such that either $m=n=0$, or $(\SUCC\;m)$
+is equal to  $n$. The function $\pred$ should be just the way to
+compute such an $m$. 
+
+\begin{alltt}
+Definition pred_spec (n:nat) := 
+   \{m:nat | n=0{\coqand} m=0 {\coqor} n = S m\}.
+  
+Definition  predecessor : {\prodsym} n:nat, pred_spec n.
+ intro n; case n.
+\it{}  
+  n : nat
+  ============================
+   pred_spec 0
+
+\tt{} unfold pred_spec;exists 0;auto.
+\it{}
+ =========================================
+ {\prodsym} n0 : nat, pred_spec (S n0)
+\tt{}
+ unfold pred_spec; intro n0; exists n0; auto.
+Defined.
+\end{alltt}
+
+If we print the term built by {\coq}, we can observe its dependent pattern-matching structure:
+
+\begin{alltt}
+predecessor =  fun n : nat {\funarrow}
+\textbf{match n as n0 return (pred_spec n0) with}
+\textbf{| O {\funarrow}}
+    exist (fun m : nat {\funarrow} 0 = 0 {\coqand} m = 0 {\coqor} 0 = S m) 0
+      (or_introl (0 = 1) 
+                 (conj (refl_equal 0) (refl_equal 0)))
+\textbf{| S n0 {\funarrow}}
+    exist (fun m : nat {\funarrow} S n0 = 0 {\coqand} m = 0 {\coqor} S n0 = S m) n0
+      (or_intror (S n0 = 0 {\coqand} n0 = 0) (refl_equal (S n0)))
+\textbf{end}  : {\prodsym} n : nat, \textbf{pred_spec n}
+\end{alltt}
+
+
+Notice that there are many variants to the pattern ``~\texttt{intros \dots; case \dots}~''. Look at the reference manual and/or the book: tactics
+\texttt{destruct}, ``~\texttt{intro \emph{pattern}}~'', etc.
+
+\noindent The command \texttt{Extraction} \refmancite{Section
+\ref{ExtractionIdent}} can be used to see the computational
+contents associated to the \emph{certified} function \texttt{predecessor}:
+\begin{alltt}
+Extraction predecessor.
+\it
+(** val predecessor : nat {\arrow} pred_spec **)
+
+let predecessor = function
+  | O {\arrow} O
+  | S n0 {\arrow} n0
+\end{alltt}
+
+
+\begin{exercise} \label{expand}
+Prove the following theorem:
+\begin{alltt}
+Theorem nat_expand : {\prodsym} n:nat, 
+      n = match n with 
+                  | 0 {\funarrow} 0 
+                  | S p {\funarrow} S p 
+          end.
+\end{alltt}
+\end{exercise}
+
+\subsection{Some Examples of Case Analysis}
+\label{CaseScheme}
+The reader will find in the Reference manual all details about
+typing case analysis (chapter 4: Calculus of Inductive Constructions,
+and chapter 15: Extended Pattern-Matching).
+
+The following commented examples will show the different situations to consider.
+
+
+%\subsubsection{General Scheme}
+
+%Case analysis is then the most basic elimination rule that {\coq}
+%provides for inductive  types.  This rule follows a general schema,
+%valid for any inductive type $I$. First, if $I$ has type
+%``~$\forall\,(z_1:A_1)\ldots(z_r:A_r),S$~'', with $S$ either $\Set$, $\Prop$ or
+%$\Type$, then a case expression on $p$ of type ``~$R\;a_1\ldots a_r$~''
+% inhabits ``~$Q\;a_1\ldots a_r\;p$~''. The types of the branches of the case expression
+%are obtained from the definition of the type in this way: if the type
+%of the $i$-th constructor $c_i$  of $R$ is 
+%``~$\forall\, (x_1:T_1)\ldots
+%(x_n:T_n),(R\;q_1\ldots q_r)$~'', then the  $i-th$ branch must have the
+%form ``~$c_i\; x_1\; \ldots \;x_n\;  \funarrow{}\; t_i$~'' where
+%$$(x_1:T_1),\ldots, (x_n:T_n) \vdash t_i : Q\;q_1\ldots q_r)$$
+% for non-dependent case
+%analysis, and $$(x_1:T_1)\ldots (x_n:T_n)\vdash t_i :Q\;q_1\ldots
+%q_r\;({c}_i\;x_1\;\ldots x_n)$$ for dependent one. In the
+%following section, we illustrate this general scheme for different
+%recursive types.
+%%\textbf{A vérifier}
+
+\subsubsection{The Empty Type}
+
+In a definition by case analysis, there is one branch for each
+introduction rule of the type. Hence, in a definition by case analysis
+on $p:\False$ there are no cases to be considered. In other words, the
+rule of (non-dependent) case analysis for the type $\False$ is 
+(for $s$ in  \texttt{Prop}, \texttt{Set} or \texttt{Type}):
+
+\begin{center}
+\snregla {\JM{Q}{s}\;\;\;\;\;
+          \JM{p}{\False}}
+         {\JM{\texttt{match $p$ return $Q$ with end}}{Q}}
+\end{center}
+
+As a corollary, if we could construct an object in $\False$, then it
+could be possible to define an object in any type.  The tactic
+\texttt{contradiction} \refmancite{Section \ref{Contradiction}}
+corresponds to the application of the elimination rule above.  It
+searches in the context for an absurd hypothesis (this is, a
+hypothesis whose type is $\False$) and then proves the goal by a case
+analysis of it.
+
+\begin{alltt}
+Theorem fromFalse : False \arrow{} 0=1.
+ intro H. 
+ contradiction.
+Qed.
+\end{alltt}
+
+
+In {\coq} the negation is defined as follows :
+
+\begin{alltt}
+Definition not (P:Prop) := P {\arrow} False
+\end{alltt}
+
+The proposition ``~\citecoq{not $A$}~'' is also written ``~$\neg A$~''.
+
+If $A$ and $B$ are propositions, $a$ is a proof of $A$ and
+$H$ is a proof of $\neg A$,
+the term ``~\citecoq{match $H\;a$ return $B$ with end}~'' is a proof term of
+$B$.
+Thus, if your goal is $B$ and you have some hypothesis $H:\neg A$,
+the tactic ``~\citecoq{case $H$}~'' generates a new subgoal with
+statement $A$, as shown by  the following example\footnote{Notice that
+$a\coqdiff b$ is just an abreviation for ``~\coqnot a= b~''}.
+
+\begin{alltt}
+Fact Nosense : 0 {\coqdiff} 0 {\arrow} 2 = 3.
+Proof.
+  intro H; case H.
+\it
+===========================
+  0 = 0
+\tt
+  reflexivity.
+Qed.
+\end{alltt}
+
+The tactic ``~\texttt{absurd $A$}~'' (where $A$ is any proposition), 
+is based on the same principle, but
+generates two subgoals: $A$ and $\neg A$, for solving $B$.
+
+\subsubsection{The Equality Type}
+
+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$~''.
+
+\begin{alltt}
+fun H : Q a {\funarrow}
+  match \(\pi\) in (_ = y) return Q y with
+     refl_equal {\funarrow} H
+  end
+\end{alltt}
+Notice the header of the \texttt{match} construct.
+It expresses how the resulting type ``~\citecoq{Q y}~'' depends on 
+the \emph{type} of \texttt{p}.
+Notice also that in the pattern introduced by the keyword \texttt{in},
+the parameter \texttt{a} in the type ``~\texttt{a = y}~'' must be
+implicit, and replaced by a wildcard '\texttt{\_}'.
+
+
+Therefore, case analysis on a proof of the equality $a=b$
+amounts to replacing all the occurrences of the term $b$ with the term
+$a$ in the goal to be proven. Let us illustrate this through an
+example: the transitivity property of this equality. 
+\begin{alltt}
+Theorem trans : {\prodsym} n m p:nat, n=m \arrow{} m=p \arrow{} n=p.
+Proof.
+ intros n m p eqnm.  
+\it{}  
+  n : nat
+  m : nat
+  p : nat
+  eqnm : n = m
+  ============================
+   m = p {\arrow} n = p
+\tt{} case eqnm.
+\it{}
+  n : nat
+  m : nat
+  p : nat
+  eqnm : n = m
+  ============================
+   n = p {\arrow} n = p
+\tt{} trivial.
+Qed.
+\end{alltt}
+
+%\noindent The case analysis on the hypothesis $H:n=m$ yields the
+%tautological subgoal $n=p\rightarrow n=p$, that is directly proven by
+%the tactic \texttt{Trivial}.
+
+\begin{exercise}
+Prove the symmetry property of  equality.
+\end{exercise}
+
+Instead of using \texttt{case}, we can use the tactic 
+\texttt{rewrite} \refmancite{Section \ref{Rewrite}}.  If $H$ is a proof
+of  $a=b$, then
+``~\citecoq{rewrite $H$}~''
+ performs a case analysis on a proof of $b=a$, obtained by applying a
+symmetry theorem to $H$. This application of symmetry allows us to rewrite
+the equality from left to right, which looks more natural. An optional
+parameter (either \texttt{\arrow{}} or \texttt{$\leftarrow$}) can be used to precise
+in which sense the equality must be rewritten.  By default,
+``~\texttt{rewrite} $H$~'' corresponds to ``~\texttt{rewrite \arrow{}} $H$~''
+\begin{alltt}
+Lemma Rw :  {\prodsym} x y: nat, y = y * x {\arrow} y * x * x = y.
+ intros x y e; do 2 rewrite <- e.
+\it
+1 subgoal
+  
+  x : nat
+  y : nat
+  e : y = y * x
+  ============================
+   y = y
+\tt
+ reflexivity.
+Qed.
+\end{alltt}
+
+Notice that, if $H:a=b$, then the tactic ``~\texttt{rewrite $H$}~''
+ replaces \textsl{all} the
+occurrences of $a$ by $b$. However, in certain situations we could be
+interested in rewriting some of the occurrences, but not all of them.
+This can be done using the tactic \texttt{pattern} \refmancite{Section
+\ref{Pattern}}.  Let us consider yet another example to
+illustrate this.
+
+Let us start with some simple theorems of arithmetic; two of them 
+are already proven in the Standard Library, the last is left as an exercise.
+
+\begin{alltt}
+\it
+mult_1_l
+     : {\prodsym} n : nat, 1 * n = n
+
+mult_plus_distr_r
+     : {\prodsym} n m p : nat, (n + m) * p = n * p + m * p
+
+mult_distr_S : {\prodsym} n p : nat, n * p + p = (S n)* p.
+\end{alltt}
+
+Let us now prove a simple result:
+
+\begin{alltt}
+Lemma four_n : {\prodsym} n:nat, n+n+n+n = 4*n.
+Proof.
+ intro n;rewrite <- (mult_1_l n).
+\it
+  n : nat
+  ============================
+   1 * n + 1 * n + 1 * n + 1 * n = 4 * (1 * n)
+\end{alltt}
+
+We can see that the \texttt{rewrite} tactic call replaced \emph{all}
+the occurrences of \texttt{n} by the term ``~\citecoq{1 * n}~''.
+If we want to do the rewriting ony on the leftmost occurrence of
+\texttt{n}, we can mark this occurrence using the \texttt{pattern}
+tactic:
+
+
+\begin{alltt}
+ Undo.
+ intro n; pattern n at 1.
+ \it
+ n : nat
+  ============================
+ (fun n0 : nat {\funarrow} n0 + n + n + n = 4 * n) n
+\end{alltt}
+Applying the tactic ``~\citecoq{pattern  n at 1}~'' allowed us
+to explicitly abstract the first occurrence of \texttt{n} from the
+goal, putting this goal under the form ``~\citecoq{$Q$ n}~'',
+thus pointing to \texttt{rewrite} the particular predicate on $n$
+that we search to prove. 
+
+
+\begin{alltt}
+ rewrite <- mult_1_l.
+\it
+1 subgoal
+  
+  n : nat
+  ============================
+   1 * n + n + n + n = 4 * n
+\tt
+ repeat rewrite   mult_distr_S.
+\it
+  n : nat
+  ============================
+   4 * n = 4 * n
+\tt
+ trivial.
+Qed.
+\end{alltt}
+
+\subsubsection{The Predicate $n {\leq} m$}
+
+
+The last but one instance of the elimination schema that we will illustrate is
+case analysis for the predicate $n {\leq} m$:
+
+Let $n$ and $p$ be terms of type \citecoq{nat}, and $Q$ a predicate 
+of type $\citecoq{nat}\arrow{}\Prop$.
+If $H$ is a proof of ``~\texttt{n {\coqle} p}~'',
+$H_0$ a proof of ``~\texttt{$Q$  n}~'' and
+$H_S$ a proof of ``~\citecoq{{\prodsym}m:nat, n {\coqle}  m {\arrow} Q (S m)}~'',
+then the term
+\begin{alltt}
+match H in (_ {\coqle} q) return (Q q) with
+    | le_n {\funarrow} H0
+    | le_S m Hm {\funarrow} HS m Hm
+end
+\end{alltt}
+ is a proof term of ``~\citecoq{$Q$ $p$}~''.
+
+
+The two patterns of this \texttt{match} construct describe
+all possible forms of proofs of ``~\citecoq{n {\coqle} m}~'' (notice
+again that the general parameter \texttt{n} is implicit in
+ the ``~\texttt{in \dots}~''
+clause and is absent from the match patterns.
+
+
+Notice that the choice of introducing some of the arguments of the
+predicate as being general parameters in its definition has
+consequences on the rule of case analysis that is derived. In
+particular, the type $Q$ of the object defined by the case expression
+only depends on the indexes of the predicate, and not on the general
+parameters.  In the definition of the predicate $\leq$, the first
+argument of this relation is a general parameter of the
+definition. Hence, the predicate $Q$ to be proven only depends on the
+second argument of the relation. In other words, the integer $n$ is
+also a general parameter of the rule of case analysis.
+
+An example of an application of this rule is the following theorem,
+showing that any integer greater or equal than $1$ is the successor of another
+natural number:
+
+\begin{alltt}
+Lemma predecessor_of_positive : 
+ {\prodsym} n, 1 {\coqle} n {\arrow} {\exsym} p:nat, n = S p.
+Proof.
+ intros n H;case H.
+\it
+  n : nat
+  H : 1 {\coqle} n
+  ============================
+   {\exsym} p : nat, 1 = S p
+\tt
+  exists 0; trivial.
+\it
+
+  n : nat
+  H : 1 {\coqle} n
+  ============================
+   {\prodsym} m : nat, 0 {\coqle} m {\arrow} {\exsym} p : nat, S m = S p
+\tt
+  intros m _  .
+  exists m.
+  trivial.
+Qed.
+\end{alltt}
+
+
+\subsubsection{Vectors}
+
+The \texttt{vector} polymorphic and dependent family of types will
+give an idea of the most general scheme of pattern-matching.
+
+For instance, let us define a function for computing the tail of
+any vector. Notice that we shall build a \emph{total} function,
+by considering that the tail of an empty vector is this vector itself.
+In that sense, it will be slightly different from the \texttt{Vtail}
+function of the Standard Library, which is defined only for vectors
+of type ``~\citecoq{vector $A$ (S $n$)}~''.
+
+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):=
+\end{verbatim}
+
+Since the branches will not have the same type
+(depending on the parameter \texttt{n}),
+the body of this function is a dependent pattern matching on 
+\citecoq{v}.
+So we will have :
+\begin{verbatim}
+match v in (vector _ n0) return (vector A (pred n0)) with
+\end{verbatim}
+
+The first branch  deals with the constructor \texttt{Vnil} and must
+return a value in ``~\citecoq{vector A (pred 0)}~'', convertible
+to ``~\citecoq{vector A 0}~''. So, we propose:
+\begin{alltt}
+| Vnil {\funarrow} Vnil A
+\end{alltt}
+
+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}~''.
+This second branch is thus :
+\begin{alltt}
+| Vcons _ n0 v0 {\funarrow} v0
+\end{alltt}
+
+Here is the full definition:
+
+\begin{alltt}
+Definition Vtail_total 
+   (A : Set) (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
+end.
+\end{alltt}
+
+
+\subsection{Case Analysis and Logical Paradoxes}
+
+In the previous section we have illustrated the general scheme for
+generating the rule of case analysis associated to some recursive type
+from the definition of the type. However, if the logical soundness is
+to be preserved, certain restrictions to this schema are
+necessary. This section provides a brief explanation of these
+restrictions.
+
+
+\subsubsection{The Positivity Condition}
+\label{postypes}
+
+In order to make sense of recursive types as types closed under their
+introduction rules, a constraint has to be imposed on the possible
+forms of such rules. This constraint, known as the
+\textsl{positivity condition}, is necessary to prevent the user from
+naively introducing some recursive types which would open the door to
+logical paradoxes.  An example of such a dangerous type is the
+``inductive type'' \citecoq{Lambda}, whose only constructor is 
+\citecoq{lambda} of type \citecoq{(Lambda\arrow False)\arrow Lambda}.
+ Following the pattern
+given in Section \ref{CaseScheme}, the rule of (non dependent) case
+analysis for \citecoq{Lambda} would be the following:
+
+\begin{center}
+\snregla {\JM{Q}{\Prop}\;\;\;\;\;
+          \JM{p}{\texttt{Lambda}}\;\;\;\;\;
+          {h : {\texttt{Lambda}}\arrow\False\; \vdash\; t\,:\,Q}}
+         {\JM{\citecoq{match $p$ return $Q$ with lambda h {\funarrow} $t$  end}}{Q}}
+\end{center}
+
+In order to avoid paradoxes, it is impossible to construct
+the type \citecoq{Lambda} in {\coq}:
+
+\begin{alltt}
+Inductive Lambda : Set :=
+  lambda : (Lambda {\arrow} False) {\arrow} Lambda. 
+\it
+Error: Non strictly positive occurrence of "Lambda" in
+ "(Lambda {\arrow} False) {\arrow} Lambda"
+\end{alltt}
+
+In order to explain this danger, we
+will declare some constants for simulating the construction of 
+\texttt{Lambda} as an inductive type.
+
+Let us open some section, and declare two variables, the first one for
+\texttt{Lambda}, the other for the constructor \texttt{lambda}.
+
+\begin{alltt}
+Section Paradox.
+Variable Lambda : Set.
+Variable lambda : (Lambda {\arrow} False) {\arrow}Lambda.
+\end{alltt}
+
+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
+``~\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$)}~''
+
+
+\begin{alltt}
+Variable matchL : Lambda {\arrow} 
+                  {\prodsym} Q:Prop, ((Lambda {\arrow}False) {\arrow} Q) {\arrow}
+                  Q.
+\end{alltt}
+
+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.
+
+\begin{alltt}
+Definition application (f x: Lambda) :False :=
+  matchL f False (fun h {\funarrow} h x).
+
+Definition Delta :  Lambda := 
+  lambda (fun x : Lambda {\funarrow} application x x).
+
+Definition loop : False := application Delta Delta.
+
+Theorem two_is_three : 2 = 3.
+Proof.
+ elim loop.
+Qed.
+
+End Paradox.
+\end{alltt}
+
+\noindent This example can be seen as a formulation of Russell's
+paradox in type theory associating $(\textsl{application}\;x\;x)$ to the
+formula $x\not\in x$, and \textsl{Delta} to the set $\{ x \mid
+x\not\in x\}$. If \texttt{matchL} would satisfy the reduction rule
+associated to case analysis, that is, 
+$$ \citecoq{matchL (lambda $f$) $Q$ $h$} \Longrightarrow h\;f$$
+then the term \texttt{loop}
+would compute into itself.  This is not actually surprising, since the
+proof of the logical soundness of {\coq} strongly lays on the property
+that any well-typed term must terminate. Hence, non-termination is
+usually a synonymous of inconsistency.
+
+%\paragraph{} In this case, the construction of a non-terminating
+%program comes from the so-called \textsl{negative occurrence} of
+%$\Lambda$ in the type of the constructor $\lambda$. In order to be
+%admissible for {\coq}, all the occurrences of the recursive type in its
+%own introduction rules must be positive, in the sense on the following
+%definition:
+%
+%\begin{enumerate}
+%\item $R$ is positive in $(R\;\vec{t})$;
+%\item $R$ is positive in $(x: A)C$ if it does not 
+%occur in $A$ and $R$ is positive in $C$; 
+%\item if $P\equiv (\vec{x}:\vec{T})Q$, then $R$ is positive in $(P
+%\rightarrow C)$ if $R$ does not occur in $\vec{T}$, $R$ is positive
+%in $C$, and either
+%\begin{enumerate} 
+%\item $Q\equiv (R\;\vec{q})$ or 
+%\item $Q\equiv (J\;\vec{t})$, \label{relax}
+%      where $J$ is a recursive type, and for any term $t_i$ either : 
+%   \begin{enumerate}
+%      \item $R$ does not occur in $t_i$, or
+%      \item $t_i\equiv (z:\vec{Z})(R\;\vec{q})$, $R$ does not occur
+%       in $\vec{Z}$, $t_i$ instantiates a general
+%       parameter of $J$, and this parameter is positive in the 
+%       arguments of the constructors of $J$. 
+%   \end{enumerate}
+%\end{enumerate}
+%\end{enumerate}
+%\noindent Those types obtained by erasing option (\ref{relax}) in the
+%definition above are called \textsl{strictly positive} types.
+
+
+\paragraph{} 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}. 
+
+The reader will find in the Reference Manual a complete formal 
+definition of the notions of \emph{positivity condition} and
+\emph{strict positivity} that an inductive definition must satisfy.
+
+
+%In order to be
+%admissible for {\coq}, the type $R$ must be positive in the types of the
+%arguments of its own introduction rules, in the sense on the following
+%definition:
+
+%\textbf{La définition du manuel de référence est plus complexe:
+%la recopier ou donner seulement des exemples?
+%}
+%\begin{enumerate}
+%\item $R$ is positive in $T$ if $R$ does not occur in $T$;
+%\item $R$ is positive in $(R\;\vec{t})$ if $R$ does not occur in $\vec{t}$;
+%\item $R$ is positive in $(x:A)C$ if it does not
+%      occur in $A$ and $R$ is positive in $C$; 
+%\item $R$ is positive in $(J\;\vec{t})$, \label{relax}
+%      if $J$ is a recursive type, and for any term $t_i$ either : 
+%   \begin{enumerate}
+%      \item $R$ does not occur in $t_i$, or
+%      \item $R$ is positive in $t_i$,  $t_i$ instantiates a general
+%       parameter of $J$, and this parameter is positive in the 
+%       arguments of the constructors of $J$. 
+%   \end{enumerate}
+%\end{enumerate}
+
+%\noindent When we can show that $R$ is positive without using the item
+%(\ref{relax}) of the definition above, then we say that $R$ is
+%\textsl{strictly positive}.
+
+%\textbf{Changer le discours sur les ordinaux}
+
+Notice that the positivity condition does not forbid us to
+put  functional recursive
+arguments in the constructors. 
+
+For instance, let us consider the type of infinitely branching trees,
+with labels in \texttt{Z}.
+\begin{alltt}
+Require Import ZArith.
+
+Inductive itree : Set :=
+| ileaf : itree
+| inode : Z {\arrow} (nat {\arrow} itree) {\arrow} itree.
+\end{alltt}
+
+In this representation, the $i$-th child of a tree 
+represented by ``~\texttt{inode $z$ $s$}~'' is obtained by applying
+the function $s$ to $i$.
+The following definitions show how to construct a tree with a single 
+node, a tree of height 1 and a tree of height 2:
+
+\begin{alltt}
+Definition isingle l := inode l (fun i {\funarrow} ileaf).
+
+Definition t1 := inode 0 (fun n {\funarrow} isingle (Z_of_nat n)).
+
+Definition t2 := 
+ inode 0 
+      (fun n : nat {\funarrow} 
+                   inode (Z_of_nat n)
+                   (fun p {\funarrow} isingle (Z_of_nat (n*p)))).
+\end{alltt}
+
+
+Let us define a preorder on infinitely branching trees.
+ In order to compare two non-leaf trees,
+it is necessary to compare each of their children 
+ without taking care of the order in which they
+appear:
+
+\begin{alltt}
+Inductive itree_le : itree{\arrow} itree {\arrow} Prop :=
+  | le_leaf : {\prodsym} t, itree_le  ileaf t
+  | le_node : {\prodsym} l l' s s', 
+                Zle l l' {\arrow} 
+                ({\prodsym} i, {\exsym} j:nat, itree_le (s i) (s' j)){\arrow} 
+                itree_le  (inode  l s) (inode  l' s').
+
+\end{alltt}
+
+Notice that a call to the predicate \texttt{itree\_le} appears as
+a general parameter of the inductive type  \texttt{ex} (see Sect.\ref{ex-def}).
+This kind of definition is accepted by {\coq}, but may lead to some
+difficulties, since the induction principle automatically 
+generated by the system
+is not the most appropriate (see chapter 14 of~\cite{coqart} for a detailed
+explanation).
+
+
+The following definition, obtained by 
+skolemising the
+proposition \linebreak $\forall\, i,\exists\, j,(\texttt{itree\_le}\;(s\;i)\;(s'\;j))$ in
+the type of \texttt{itree\_le}, does not present this problem:
+
+
+\begin{alltt} 
+Inductive itree_le' : itree{\arrow} itree {\arrow} Prop :=
+  | le_leaf'  : {\prodsym} t, itree_le'  ileaf t
+  | le_node' : {\prodsym} l l' s s' g, 
+                  Zle l l' {\arrow}  
+                  ({\prodsym} i, itree_le' (s i) (s' (g i))) {\arrow} 
+                  itree_le'  (inode  l s) (inode  l' s').
+
+\end{alltt}
+\iffalse
+\begin{alltt}
+Lemma t1_le'_t2 :  itree_le' t1 t2.
+Proof.
+ unfold t1, t2.
+ constructor 2  with (fun i : nat {\funarrow} 2 * i).
+ auto with zarith.
+ unfold isingle;
+ intro i ; constructor 2 with (fun i :nat {\funarrow} i).
+ auto with zarith.
+ constructor .
+Qed.
+\end{alltt}
+\fi
+
+%In general, strictly positive definitions are preferable to only
+%positive ones. The reason is that it is sometimes difficult to derive
+%structural induction combinators for the latter ones. Such combinators
+%are automatically generated for strictly positive types, but not for
+%the only positive ones. Nevertheless, sometimes non-strictly positive
+%definitions provide a smarter or shorter way of declaring a recursive
+%type.
+
+Another example is the type of trees 
+ of unbounded width, in which a recursive subterm 
+\texttt{(ltree A)} instantiates the type  of polymorphic lists:
+
+\begin{alltt} 
+Require Import List.
+
+Inductive ltree  (A:Set) : Set :=  
+          lnode   : A {\arrow} list (ltree A) {\arrow} ltree A.
+\end{alltt}
+
+This declaration can be transformed  
+adding an extra type to the definition, as was done in Section
+\ref{MutuallyDependent}.
+
+
+\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
+previously introduced are examples of predicative types. An example of
+an impredicative one is the following type:
+%\textsl{exT}, the dependent product
+%of a certain set (or proposition) $x$, and a proof of a property $P$
+%about $x$.
+
+%\begin{alltt} 
+%Print exT.
+%\end{alltt}
+%\textbf{ttention, EXT c'est ex!}
+%\begin{alltt}
+%Check (exists P:Prop, P {\arrow} not P).  
+%\end{alltt}
+
+%This type is useful for expressing existential quantification over
+%types, like ``there exists a proposition $x$ such that $(P\;x)$''
+%---written $(\textsl{EXT}\; x:Prop \mid (P\;x))$ in {\coq}. However,
+
+\begin{alltt}
+Inductive prop : Prop :=
+ prop_intro : Prop {\arrow} prop.
+\end{alltt}
+
+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
+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}
+Inductive ex_Prop  (P : Prop {\arrow} Prop) : Prop :=
+  exP_intro : {\prodsym} X : Prop, P X {\arrow} ex_Prop P.
+\end{alltt}
+
+%\begin{alltt}
+%(*
+%Check (match prop_inject with (prop_intro p _) {\funarrow} p end).
+
+%Error: Incorrect elimination of "prop_inject" in the inductive type
+% ex
+%The elimination predicate ""fun _ : prop {\funarrow} Prop" has type
+% "prop {\arrow} Type"
+%It should be one of :
+% "Prop"
+
+%Elimination of an inductive object of sort : "Prop"
+%is not allowed on a predicate in sort : "Type"
+%because non-informative objects may not construct informative ones.
+
+%*)
+%Print prop_inject.
+
+%(*
+%prop_inject = 
+%prop_inject = prop_intro prop (fun H : prop {\funarrow} H)
+%     : prop
+%*)
+%\end{alltt}
+
+% \textbf{Et par ça?
+%}
+
+Notice that predicativity on sort \citecoq{Set} forbids us to build
+the following definitions.
+
+
+\begin{alltt}
+Inductive aSet : Set :=
+  aSet_intro: Set {\arrow} aSet.
+
+\it{}User error: Large non-propositional inductive types must be in Type
+\tt 
+Inductive ex_Set  (P : Set {\arrow} Prop) : Set :=
+  exS_intro : {\prodsym} X : Set, P X {\arrow} ex_Set P.
+
+\it{}User error: Large non-propositional inductive types must be in Type
+\end{alltt}
+
+Nevertheless, one can define types like \citecoq{aSet} and \citecoq{ex\_Set}, as inhabitants of \citecoq{Type}.
+
+\begin{alltt}
+Inductive ex_Set  (P : Set {\arrow} Prop) : Type :=
+  exS_intro : {\prodsym} X : Set, P X {\arrow} ex_Set P.
+\end{alltt}
+
+In the following example, the inductive type \texttt{typ} can be defined,
+but the term associated with the interactive Definition of
+\citecoq{typ\_inject} is incompatible with {\coq}'s hierarchy of universes:
+
+
+\begin{alltt}
+Inductive  typ : Type := 
+  typ_intro : Type {\arrow} typ. 
+
+Definition typ_inject: typ.
+ split; exact typ.
+\it Proof completed
+\tt{}Defined.
+\it
+Error: Universe Inconsistency.
+\tt
+Abort.
+\end{alltt}
+
+One possible way of avoiding this new source of paradoxes is to
+restrict the kind of eliminations by case analysis that can be done on
+impredicative types. In particular, projections on those universes
+equal or bigger than the one inhabited by the impredicative type must
+be forbidden \cite{Coq86}. A consequence of this restriction is that it
+is not possible to define the first projection of the type
+``~\citecoq{ex\_Prop $P$}~'':
+\begin{alltt}
+Check (fun (P:Prop{\arrow}Prop)(p: ex_Prop P) {\funarrow}
+      match p with exP_intro X HX {\funarrow} X end).
+\it
+Error:
+Incorrect elimination of "p" in the inductive type  
+"ex_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.
+\end{alltt}
+
+%In order to explain why, let us consider for example the following
+%impredicative type \texttt{ALambda}.
+%\begin{alltt} 
+%Inductive ALambda : Set := 
+%          alambda : (A:Set)(A\arrow{}False)\arrow{}ALambda.
+%
+%Definition Lambda : Set := ALambda.
+%Definition lambda : (ALambda\arrow{}False)\arrow{}ALambda := (alambda ALambda).
+%Lemma CaseAL : (Q:Prop)ALambda\arrow{}((ALambda\arrow{}False)\arrow{}Q)\arrow{}Q.
+%\end{alltt}
+%
+%This type contains all the elements of the dangerous type $\Lambda$
+%described at the beginning of this section.  Try to construct the
+%non-ending term $(\Delta\;\Delta)$ as an object of
+%\texttt{ALambda}. Why is it not possible?
+
+\subsubsection{Extraction Constraints}
+
+There is a final constraint on case analysis that is not motivated by
+the potential introduction of paradoxes, but for compatibility reasons
+with {\coq}'s extraction mechanism \refmancite{Appendix
+\ref{CamlHaskellExtraction}}. This mechanism is based on the
+classification of basic types into the universe $\Set$ of sets and the
+universe $\Prop$ of propositions.  The objects of a type in the
+universe $\Set$ are considered as relevant for computation
+purposes. The objects of a type in $\Prop$ are considered just as
+formalised comments, not necessary for execution. The extraction
+mechanism consists in erasing such formal comments in order to obtain
+an executable program. Hence, in general, it is not possible to define
+an object in a set (that should be kept by the extraction mechanism)
+by case analysis of a proof (which will be thrown away).
+
+Nevertheless, this general rule has an exception which is important in
+practice: if the definition proceeds by case analysis on a proof of a
+\textsl{singleton proposition} or an empty type (\emph{e.g.} \texttt{False}),
+ then it is allowed. A singleton
+proposition is a non-recursive proposition with a single constructor
+$c$, all whose arguments are proofs. For example, the propositional
+equality and the conjunction of two propositions are examples of
+singleton propositions.
+
+%From the point of view of the extraction
+%mechanism, such types are isomorphic to a type containing a single
+%object $c$, so a definition $\Case{x}{c \Rightarrow b}$ is 
+%directly replaced by $b$ as an extra optimisation.
+
+\subsubsection{Strong Case Analysis on Proofs}
+
+One could consider allowing 
+ to define a proposition $Q$ by case
+analysis on the proofs of another recursive proposition $R$. As we
+will see in Section \ref{Discrimination}, this would enable one to prove that
+different introduction rules of $R$ construct different
+objects. However, this property would be in contradiction with the principle
+of excluded middle of classical logic, because this principle entails
+that the proofs of a proposition cannot be distinguished. This
+principle is not provable in {\coq}, but it is frequently introduced by
+the users as an axiom, for reasoning in classical logic. For this
+reason, the definition of propositions by case analysis on proofs is
+ not allowed in {\coq}.
+
+\begin{alltt}
+
+Definition comes_from_the_left (P Q:Prop)(H:P{\coqor}Q): Prop :=
+ match H with
+         |  or_introl p {\funarrow} True 
+         |  or_intror q {\funarrow} False
+ end.
+\it
+Error:
+Incorrect elimination of "H" in the inductive type  
+"or", 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.
+
+\end{alltt}
+
+On the other hand, if we replace the proposition $P {\coqor} Q$ with
+the informative type $\{P\}+\{Q\}$, the elimination  is accepted:
+
+\begin{alltt}
+Definition comes_from_the_left_sumbool
+            (P Q:Prop)(x:\{P\} + \{Q\}): Prop :=
+  match x with
+         |  left  p {\funarrow} True 
+         |  right q {\funarrow} False
+  end.
+\end{alltt}
+
+
+\subsubsection{Summary of Constraints}
+
+To end with this section, the following table summarizes which
+universe $U_1$ may inhabit an object of type $Q$ defined by case
+analysis on $x:R$, depending on the universe $U_2$ inhabited by the
+inductive types $R$.\footnote{In the box indexed by $U_1=\citecoq{Type}$
+and $U_2=\citecoq{Set}$, the answer ``yes''  takes into account the 
+predicativity of sort \citecoq{Set}. If you are working with the
+option ``impredicative-set'', you must put in this box the
+condition ``if $R$ is predicative''.}
+
+
+\begin{center}
+\renewcommand{\multirowsetup}{\centering} \newlength{\LL}
+\settowidth{\LL}{$x : R : s_1$}
+\begin{tabular}{|c|c|c|c|c|}
+\hline
+\multirow{5}{\LL}{$x : R : U_2$} &
+\multicolumn{4}{|c|}{$Q : U_1$}\\
+\hline
+&                 &\textsl{Set}      & \textsl{Prop} & \textsl{Type}\\
+\cline{2-5}
+&\textsl{Set}     &  yes             &   yes         &  yes\\
+\cline{2-5}
+&\textsl{Prop}    & if $R$ singleton &   yes         &  no\\
+\cline{2-5}
+&\textsl{Type}    &  yes             &   yes         &  yes\\
+\hline
+\end{tabular}
+\end{center}
+
+\section{Some Proof Techniques Based on Case Analysis}
+\label{CaseTechniques}
+
+In this section we illustrate the use of case analysis as a proof
+principle, explaining the proof techniques behind three very useful
+{\coq} tactics, called \texttt{discriminate}, \texttt{injection} and
+\texttt{inversion}. 
+
+\subsection{Discrimination of introduction rules}
+\label{Discrimination}
+
+In the informal semantics of recursive types described in Section
+\ref{Introduction} it was said that each of the introduction rules of a
+recursive type is considered as being different from all the others. 
+It is possible to capture this fact inside the logical system using
+the propositional equality. We take as example the following theorem,
+stating that \textsl{O} constructs a natural number different 
+from any of those constructed with \texttt{S}. 
+
+\begin{alltt}
+Theorem S_is_not_O : {\prodsym} n, S n {\coqdiff} 0. 
+\end{alltt}
+
+In order to prove this theorem, we first define a proposition by case
+analysis on natural numbers, so that the proposition is true for {\Z}
+and false for any natural number constructed with {\SUCC}. This uses
+the empty and singleton type introduced in Sections \ref{Introduction}.
+
+\begin{alltt}
+Definition Is_zero (x:nat):= match x with 
+                                     | 0 {\funarrow} True  
+                                     | _ {\funarrow} False
+                             end.
+\end{alltt}
+
+\noindent Then, we prove the following lemma:
+
+\begin{alltt}
+Lemma O_is_zero : {\prodsym} m, m = 0 {\arrow} Is_zero m.
+Proof.
+  intros m H; subst m. 
+\it{}
+================
+ Is_zero 0
+\tt{}
+simpl;trivial.
+Qed.
+\end{alltt}
+
+\noindent Finally, the proof of \texttt{S\_is\_not\_O} follows by the
+application of the previous lemma to $S\;n$.
+
+
+\begin{alltt}
+
+ red; intros n Hn.
+ \it{}   
+  n : nat
+  Hn : S n = 0
+  ============================
+   False \tt
+
+ apply O_is_zero with (m := S n).
+ assumption.
+Qed.
+\end{alltt}
+
+
+The tactic \texttt{discriminate} \refmancite{Section \ref{Discriminate}} is
+a special-purpose tactic for proving disequalities between two
+elements of a recursive type introduced by different constructors. It
+generalizes the proof method described here for natural numbers to any
+[co]-inductive type. This tactic is also capable of proving disequalities
+where the difference is not in the constructors at the head of the
+terms, but deeper inside them. For example, it can be used to prove
+the following theorem:
+
+\begin{alltt}
+Theorem disc2 : {\prodsym} n, S (S n) {\coqdiff} 1. 
+Proof.
+ intros n Hn; discriminate.
+Qed.
+\end{alltt}
+
+When there is an assumption $H$ in the context stating a false
+equality $t_1=t_2$, \texttt{discriminate} solves the goal by first
+proving $(t_1\not =t_2)$ and then reasoning by absurdity with respect
+to $H$:
+
+\begin{alltt}
+Theorem disc3 : {\prodsym} n, S (S n) = 0 {\arrow} {\prodsym} Q:Prop, Q.
+Proof.
+ intros n Hn Q.
+ discriminate.
+Qed.
+\end{alltt}
+
+\noindent In this case, the proof proceeds by absurdity with respect
+to the false equality assumed, whose negation is proved by
+discrimination.
+
+\subsection{Injectiveness of introduction rules}
+
+Another useful property about recursive types is the
+\textsl{injectiveness} of introduction rules, i.e., that whenever two
+objects were built using the same introduction rule, then this rule
+should have been applied to the same element. This can be stated
+formally using the propositional equality:
+
+\begin{alltt}
+Theorem inj : {\prodsym} n m, S n = S m {\arrow} n = m.
+Proof.
+\end{alltt}
+
+\noindent This theorem is just a corollary of a lemma about the
+predecessor function:
+
+\begin{alltt}
+ Lemma inj_pred : {\prodsym} n m, n = m {\arrow} pred n = pred m.
+ Proof.
+  intros n m eq_n_m.
+  rewrite eq_n_m.
+  trivial.
+ Qed.
+\end{alltt}
+\noindent Once this lemma is proven, the theorem follows directly
+from it:
+\begin{alltt}
+ intros n m eq_Sn_Sm.
+ apply inj_pred with (n:= S n) (m := S m); assumption.
+Qed.
+\end{alltt}
+
+This proof method is implemented by the tactic \texttt{injection}
+\refmancite{Section \ref{injection}}. This tactic is applied to
+a term $t$ of type ``~$c\;{t_1}\;\dots\;t_n = c\;t'_1\;\dots\;t'_n$~'', where $c$ is some constructor of
+an inductive type. The tactic \texttt{injection} is applied as deep as 
+possible to derive the equality of all pairs of subterms of $t_i$ and $t'_i$
+placed in the same position. All these equalities are put as antecedents 
+of the current goal.
+
+
+
+Like \texttt{discriminate}, the tactic \citecoq{injection} 
+can be also applied if $x$ does not
+occur in a direct sub-term, but somewhere deeper inside it. Its
+application may leave some trivial goals that can be easily solved
+using the tactic \texttt{trivial}.
+
+\begin{alltt}
+
+ Lemma list_inject : {\prodsym} (A:Set)(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.
+
+
+\it
+  e : a :: b :: l = b :: a :: l'
+  ============================
+   a = b {\coqand} l = l'
+\tt
+ injection e.
+\it
+  ============================
+   l = l' {\arrow} b = a {\arrow} a = b {\arrow} a = b {\coqand} l = l'
+
+\tt{} auto.
+Qed.
+\end{alltt}
+
+\subsection{Inversion Techniques}\label{inversion}
+
+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
+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
+the tactics \texttt{rewrite}, \texttt{discriminate} or
+\texttt{injection} presented in the previous sections. This is
+frequently the case when the element analysed is denoted by a term
+which is not a variable, or when it is an object of a particular
+instance of a recursive family of types. Consider for example the
+following theorem:
+
+\begin{alltt}
+Theorem not_le_Sn_0 : {\prodsym} n:nat, ~ (S n {\coqle} 0).
+\end{alltt}
+
+\noindent Intuitively, this theorem should follow by case analysis on
+the hypothesis $H:(S\;n\;\leq\;\Z)$, because no introduction rule allows
+to instantiate the arguments of \citecoq{le} with respectively a successor
+and zero. However, there
+is no way of capturing this with the typing rule for case analysis
+presented in section \ref{Introduction}, because it does not take into
+account what particular instance of the family the type of $H$ is.
+Let us try it:
+\begin{alltt}
+Proof.
+ red; intros n H; case H.
+\it 2 subgoals
+  
+  n : nat
+  H : S n {\coqle} 0
+  ============================
+   False
+
+subgoal 2 is:
+ {\prodsym} m : nat, S n {\coqle} m {\arrow} False
+\tt
+Undo.
+\end{alltt}
+
+\noindent What is necessary here is to make available the equalities
+``~$\SUCC\;n = \Z$~'' and ``~$\SUCC\;m = \Z$~''
+ as extra hypotheses of the
+branches, so that the goal can be solved using the
+\texttt{Discriminate} tactic. In order to obtain the desired
+equalities as hypotheses, let us prove an auxiliary lemma, that our
+theorem is a corollary of:
+
+\begin{alltt}
+ Lemma not_le_Sn_0_with_constraints :
+  {\prodsym} n p , S n {\coqle} p {\arrow}  p = 0 {\arrow} False.
+  Proof.
+   intros n p H; case H .
+\it
+2 subgoals
+  
+  n : nat
+  p : nat
+  H : S n {\coqle} p
+  ============================
+   S n = 0 {\arrow} False
+
+subgoal 2 is:
+ {\prodsym} m : nat, S n {\coqle} m {\arrow} S m = 0 {\arrow} False
+\tt
+ intros;discriminate.
+ intros;discriminate.
+Qed.
+\end{alltt}
+\noindent Our main theorem can now be solved by an application of this lemma:
+\begin{alltt}
+Show.
+\it
+2 subgoals
+  
+  n : nat
+  p : nat
+  H : S n {\coqle} p
+  ============================
+   S n = 0 {\arrow} False
+
+subgoal 2 is:
+ {\prodsym} m : nat, S n {\coqle} m {\arrow} S m = 0 {\arrow} False
+\tt
+ eapply not_le_Sn_0_with_constraints; eauto.
+Qed.
+\end{alltt}
+
+
+The general method to address such situations consists in changing the
+goal to be proven into an implication, introducing as preconditions
+the equalities needed to eliminate the cases that make no
+sense. This proof technique is implemented by the tactic
+\texttt{inversion} \refmancite{Section \ref{Inversion}}. In order
+to prove a goal $G\;\vec{q}$ from an object of type $R\;\vec{t}$,
+this tactic automatically generates a lemma $\forall, \vec{x}.
+(R\;\vec{x}) \rightarrow \vec{x}=\vec{t}\rightarrow \vec{B}\rightarrow
+(G\;\vec{q})$, where the list of propositions $\vec{B}$ correspond to
+the subgoals that cannot be directly proven using
+\texttt{discriminate}. This lemma can either be saved for later
+use, or generated interactively. In this latter case, the subgoals
+yielded by the tactic are the hypotheses $\vec{B}$ of the lemma. If the
+lemma has been stored, then the tactic \linebreak
+ ``~\citecoq{inversion \dots using \dots}~'' can be
+used to apply it. 
+
+Let us show both techniques on our previous example:
+
+\subsubsection{Interactive mode}
+
+\begin{alltt}
+Theorem not_le_Sn_0' : {\prodsym} n:nat, ~ (S n {\coqle} 0).
+Proof.
+ red; intros n H ; inversion H.
+Qed.
+\end{alltt}
+
+
+\subsubsection{Static mode}
+
+\begin{alltt}
+
+Derive Inversion le_Sn_0_inv with ({\prodsym} n :nat, S n {\coqle}  0).
+Theorem le_Sn_0'' : {\prodsym} n p : nat, ~ S n {\coqle} 0 .
+Proof.
+ intros n p H; 
+ inversion H using le_Sn_0_inv.
+Qed.
+\end{alltt}
+
+
+In the example above, all the cases are solved using discriminate, so
+there remains no subgoal to be proven (i.e. the list $\vec{B}$ is
+empty). Let us present a second example, where this list is not empty:
+
+
+\begin{alltt}
+TTheorem le_reverse_rules : 
+     {\prodsym} n m:nat, n {\coqle} m {\arrow} 
+                     n = m {\coqor}  
+                     {\exsym} p, n {\coqle}  p {\coqand} m = S p.
+Proof.
+ intros n m H; inversion H.
+\it
+2 subgoals
+
+
+
+  
+  n : nat
+  m : nat
+  H : n {\coqle} m
+  H0 : n = m
+  ============================
+   m = m {\coqor} ({\exsym} p : nat, m {\coqle} p {\coqand} m = S p)
+
+subgoal 2 is:
+ n = S m0 {\coqor} ({\exsym} p : nat, n {\coqle} p {\coqand} S m0 = S p)
+\tt
+ left;trivial.
+ right; exists m0; split; trivial.
+\it
+Proof completed
+\end{alltt}
+
+This example shows how this tactic can be used to ``reverse'' the
+introduction rules of a recursive type, deriving the possible premises
+that could lead to prove a given instance of the predicate. This is
+why these tactics are called \texttt{inversion} tactics: they go back
+from conclusions to premises.
+
+The hypotheses corresponding to the propositional equalities are not
+needed in this example, since the tactic does the necessary rewriting
+to solve the subgoals.  When the equalities are no longer needed after
+the inversion, it is better to use the tactic
+\texttt{Inversion\_clear}. This variant of the tactic clears from the
+context all the equalities introduced.
+
+\begin{alltt}
+Restart.
+ intros n m H; inversion_clear H.
+\it
+\it
+  
+  n : nat
+  m : nat
+  ============================
+   m = m {\coqor} ({\exsym} p : nat, m {\coqle} p {\coqand} m = S p)
+\tt
+ left;trivial.
+\it
+  n : nat
+  m : nat
+  m0 : nat
+  H0 : n {\coqle} m0
+  ============================
+   n = S m0 {\coqor} ({\exsym} p : nat, n {\coqle} p {\coqand} S m0 = S p)
+\tt
+ right; exists m0; split; trivial.
+Qed.
+\end{alltt}
+
+
+%This proof technique works in most of the cases, but not always.  In
+%particular, it could not if the list $\vec{t}$ contains a term $t_j$
+%whose type $T$ depends on a previous term $t_i$, with $i<j$. Remark
+%that if this is the case, the propositional equality $x_j=t_j$ is not
+%well-typed, since $x_j:T(x_i)$ but $t_j:T(t_i)$, and both types are
+%not convertible (otherwise, the problem could be solved using the
+%tactic \texttt{Case}).
+
+
+
+\begin{exercise}
+Consider the following language of arithmetic expression, and 
+its operational semantics, described by a set of rewriting rules.
+%\textbf{J'ai enlevé une règle de commutativité de l'addition qui 
+%me paraissait bizarre du point de vue de la sémantique opérationnelle}
+
+\begin{alltt}
+Inductive ArithExp : Set :=
+   | Zero : ArithExp 
+   | Succ : ArithExp {\arrow} ArithExp
+   | Plus : ArithExp {\arrow} ArithExp {\arrow} ArithExp.
+
+Inductive RewriteRel : ArithExp {\arrow} ArithExp {\arrow} Prop :=
+  |  RewSucc  : {\prodsym} e1 e2 :ArithExp,
+                  RewriteRel e1 e2 {\arrow}
+                   RewriteRel (Succ e1) (Succ e2) 
+  |  RewPlus0 : {\prodsym} e:ArithExp,
+                  RewriteRel (Plus Zero e) e 
+  |  RewPlusS : {\prodsym} e1 e2:ArithExp,
+                  RewriteRel e1 e2 {\arrow}
+                  RewriteRel (Plus (Succ e1) e2) 
+                             (Succ (Plus e1 e2)).
+
+\end{alltt}
+\begin{enumerate}
+\item Prove that \texttt{Zero} cannot be rewritten any further.
+\item Prove that an expression of the form ``~$\texttt{Succ}\;e$~'' is always 
+rewritten
+into an expression of the same form.
+\end{enumerate}
+\end{exercise}
+
+%Theorem zeroNotCompute : (e:ArithExp)~(RewriteRel Zero e).
+%Intro e.
+%Red.
+%Intro H.
+%Inversion_clear H.
+%Defined.
+%Theorem evalPlus : 
+%  (e1,e2:ArithExp)
+%    (RewriteRel (Succ e1) e2)\arrow{}(EX e3 : ArithExp | e2=(Succ e3)).
+%Intros e1 e2 H.
+%Inversion_clear H.
+%Exists e3;Reflexivity.
+%Qed.
+
+
+\section{Inductive Types and Structural Induction} 
+\label{StructuralInduction}
+
+Elements of inductive types  are well-founded with
+respect to the structural order induced by the constructors of the
+type. In addition to case analysis, this extra hypothesis about
+well-foundedness justifies a stronger elimination rule for them, called
+\textsl{structural induction}.  This form of elimination consists in
+defining a value ``~$f\;x$~'' from some element $x$ of the inductive type
+$I$, assuming that values have been already associated in the same way
+to the sub-parts of $x$ of type $I$.
+
+
+Definitions by structural induction are expressed through the
+\texttt{Fixpoint} command \refmancite{Section
+\ref{Fixpoint}}. This command is quite close to the
+\texttt{let-rec} construction of functional programming languages.
+For example, the following definition introduces the addition of two
+natural numbers (already defined in the Standard Library:)
+
+\begin{alltt} 
+Fixpoint plus (n p:nat) \{struct n\} : nat :=
+  match n with
+          | 0 {\funarrow} p
+          | S m {\funarrow} S (plus m p)
+ end.
+\end{alltt}
+
+The definition is by structural induction on the first argument of the
+function. This is indicated  by the ``~\citecoq{\{struct n\}}~''
+directive in the function's header\footnote{This directive is optional
+in the case of a function of a single argument}.
+  In
+order to be accepted, the definition must satisfy a syntactical
+condition, called the \textsl{guardedness condition}. Roughly
+speaking, this condition constrains the arguments of a recursive call
+to be pattern variables, issued from a case analysis of the formal
+argument of the function pointed by the \texttt{struct} directive.
+ In the case of the
+function \texttt{plus}, the argument \texttt{m} in the recursive call is a
+pattern variable issued from a case analysis of \texttt{n}. Therefore, the
+definition is accepted.
+
+Notice that we could have defined the addition with structural induction 
+on its second argument:
+\begin{alltt} 
+Fixpoint plus' (n p:nat) \{struct p\} : nat :=
+    match p with
+          | 0 {\funarrow} n
+          | S q {\funarrow} S (plus' n q)
+    end.
+\end{alltt}
+
+%This notation is useful when defining a function whose decreasing
+%argument has a dependent type. As an example, consider the following
+%recursivly defined proof of the theorem
+%$(n,m:\texttt{nat})n<m \rightarrow (S\;n)<(S\;m)$:
+%\begin{alltt} 
+%Fixpoint lt_n_S [n,m:nat;p:(lt n m)] : (lt (S n) (S m)) :=
+% <[n0:nat](lt (S n) (S n0))>
+%     Cases p of
+%       lt_intro1        {\funarrow} (lt_intro1 (S n))
+%    | (lt_intro2 m1 p2) {\funarrow} (lt_intro2 (S n) (S m1) (lt_n_S n m1 p2))
+%     end.
+%\end{alltt}
+
+%The guardedness condition must be satisfied only by the last argument
+%of the enclosed list. For example, the following declaration is an
+%alternative way of defining addition:
+
+%\begin{alltt}
+%Reset add.
+%Fixpoint add [n:nat] : nat\arrow{}nat :=
+%  Cases n of 
+%       O    {\funarrow} [x:nat]x
+%    | (S m) {\funarrow} [x:nat](add m (S x))
+%  end.
+%\end{alltt}
+
+In the following definition of addition, 
+the second argument of \verb@plus''@ grows at each
+recursive call. However, as the first one always decreases, the
+definition is sound.
+\begin{alltt}
+Fixpoint plus'' (n p:nat) \{struct n\} : nat :=
+ match n with
+          | 0 {\funarrow} p
+          | S m {\funarrow} plus'' m (S p)
+ end.
+\end{alltt}
+
+ Moreover, the argument in the recursive call
+could be a deeper component of $n$.  This is the case in the following
+definition of a boolean function determining whether a number is even
+or odd:
+
+\begin{alltt} 
+Fixpoint even_test (n:nat) : bool :=
+  match n 
+  with 0 {\funarrow}  true
+     | 1 {\funarrow}  false
+     | S (S p) {\funarrow} even_test p
+  end.
+\end{alltt}
+
+Mutually dependent definitions by structural induction are also
+allowed. For example, the previous function \textsl{even} could alternatively
+be defined using an auxiliary function \textsl{odd}:
+
+\begin{alltt}
+Reset even_test.
+
+
+
+Fixpoint even_test (n:nat) : bool :=
+  match n 
+  with 
+      | 0 {\funarrow}  true
+      | S p {\funarrow} odd_test p
+  end
+with odd_test (n:nat) : bool :=
+  match n
+  with 
+     | 0 {\funarrow} false
+     | S p {\funarrow} even_test p
+ end.
+\end{alltt}
+
+%\begin{exercise}
+%Define a function by structural induction that computes the number of
+%nodes of a tree structure defined in page \pageref{Forest}.
+%\end{exercise}
+
+Definitions by structural induction are computed 
+ only when they are applied, and the decreasing argument
+is a term having a constructor at the head. We can check this using
+the \texttt{Eval} command, which computes the normal form of a well
+typed term.
+
+\begin{alltt}
+Eval simpl in even_test.
+\it
+    = even_test
+     : nat {\arrow} bool
+\tt 
+Eval simpl in (fun x : nat {\funarrow} even x).
+\it
+     = fun x : nat {\funarrow} even x
+     : nat {\arrow} Prop
+\tt
+Eval simpl in (fun x : nat => plus 5 x).
+\it
+     =  fun x : nat {\funarrow} S (S (S (S (S x))))
+
+\tt
+Eval simpl in (fun x : nat {\funarrow} even_test (plus 5 x)).
+\it
+    = fun x : nat {\funarrow} odd_test x
+     : nat {\arrow} bool
+\tt
+Eval simpl in (fun x : nat {\funarrow} even_test (plus x 5)).
+\it
+    = fun x : nat {\funarrow} even_test (x + 5)
+     : nat {\arrow} bool
+\end{alltt}
+ 
+
+%\begin{exercise}
+%Prove that the second definition of even satisfies the following
+%theorem:
+%\begin{verbatim}
+%Theorem unfold_even : 
+% (x:nat)
+%   (even x)= (Cases x of 
+%                 O        {\funarrow} true
+%              | (S O)     {\funarrow} false 
+%              | (S (S m)) {\funarrow} (even m)
+%              end).
+%\end{verbatim}
+%\end{exercise}
+
+\subsection{Proofs by Structural Induction}
+
+The principle of structural induction can be also used in order to
+define proofs, that is, to prove theorems. Let us call an
+\textsl{elimination combinator} any function that, given a predicate
+$P$, defines a proof of ``~$P\;x$~'' by structural induction on $x$.  In
+{\coq}, the principle of proof by induction on natural numbers is a
+particular case of an elimination combinator. The definition of this
+combinator depends on three general parameters: the predicate to be
+proven, the base case, and the inductive step:
+
+\begin{alltt}
+Section Principle_of_Induction.
+Variable    P               : nat {\arrow} Prop.
+Hypothesis  base_case       : P 0.
+Hypothesis  inductive_step  : {\prodsym} n:nat, P n {\arrow} P (S n).
+Fixpoint nat_ind  (n:nat)   : (P n) := 
+   match n return P n with
+          | 0 {\funarrow} base_case
+          | S m {\funarrow} inductive_step m (nat_ind m)
+   end. 
+
+End Principle_of_Induction.
+\end{alltt}
+
+As this proof principle is used very often, {\coq} automatically generates it
+when an inductive type is introduced.  Similar principles
+\texttt{nat\_rec} and \texttt{nat\_rect} for defining objects in the
+universes $\Set$ and $\Type$ are also automatically generated
+\footnote{In fact, whenever possible, {\coq} generates the
+principle \texttt{$I$\_rect}, then derives from it the
+weaker principles  \texttt{$I$\_ind} and \texttt{$I$\_rec}.
+If some principle has to be defined by hand, the user may try
+to build \texttt{$I$\_rect} (if possible). Thanks to {\coq}'s conversion
+rule, this principle can be used directly to build proofs and/or
+programs.}. The
+command \texttt{Scheme} \refmancite{Section \ref{Scheme}} can be
+used to generate an elimination combinator from certain parameters,
+like the universe that the defined objects must inhabit, whether the
+case analysis in the definitions must be dependent or not, etc. For
+example, it can be used to generate an elimination combinator for
+reasoning on even natural numbers from the mutually dependent
+predicates introduced in page \pageref{Even}. We do not display the
+combinators here by lack of space, but you can see them using the
+\texttt{Print} command.
+
+\begin{alltt}
+Scheme Even_induction := Minimality for even Sort Prop
+with   Odd_induction  := Minimality for odd  Sort Prop.
+\end{alltt}
+
+\begin{alltt}
+Theorem even_plus_four : {\prodsym} n:nat, even n {\arrow} even (4+n).
+Proof.
+ intros n H.
+ elim H using Even_induction with (P0 := fun n {\funarrow} odd (4+n));
+ simpl;repeat constructor;assumption.
+Qed.
+\end{alltt}
+
+Another example of an elimination combinator is the principle 
+of double induction on natural numbers, introduced by the following
+definition:
+
+\begin{alltt}
+Section Principle_of_Double_Induction.
+Variable    P              : nat {\arrow} nat {\arrow}Prop.
+Hypothesis  base_case1     : {\prodsym} m:nat, P 0 m.
+Hypothesis  base_case2     : {\prodsym} n:nat, P (S n) 0.
+Hypothesis  inductive_step : {\prodsym} n m:nat, P n m {\arrow}
+                                       \,\, P (S n) (S m).
+
+Fixpoint nat_double_ind (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_ind x y)
+ end.
+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 
+(certified) programs can be defined in exactly the same way.
+This definition is left as an exercise.\label{natdoublerec}
+
+\iffalse
+\begin{alltt}
+Section Principle_of_Double_Recursion.
+Variable    P               : nat {\arrow} nat {\arrow} Set.
+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 := 
+  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)
+     end.
+End Principle_of_Double_Recursion.
+\end{alltt}
+\fi
+For instance the function computing the minimum of two natural
+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)
+                 (fun (x:nat) {\funarrow} 0)
+                 (fun (y:nat) {\funarrow} 0)
+                 (fun (x y r:nat) {\funarrow} S r).
+Eval compute in (min 5 8).
+\it
+= 5 : nat
+\end{alltt}
+
+
+%\begin{exercise}
+%
+%Define the combinator \texttt{nat\_double\_rec}, and apply it
+%to give another definition of \citecoq{le\_lt\_dec} (using the theorems
+%of the \texttt{Arith} library).
+%\end{exercise}
+
+\subsection{Using Elimination Combinators.} 
+The tactic \texttt{apply} can be used to apply one of these proof
+principles during the development of a proof. 
+
+\begin{alltt}
+Lemma not_circular : {\prodsym} n:nat, n {\coqdiff} S n.
+Proof.
+ intro n.
+ apply nat_ind with (P:= fun n {\funarrow} n {\coqdiff} S n).
+\it
+
+
+
+2 subgoals
+  
+  n : nat
+  ============================
+   0 {\coqdiff} 1
+
+
+subgoal 2 is:
+ {\prodsym} n0 : nat, n0 {\coqdiff} S n0 {\arrow} S n0 {\coqdiff} S (S n0)
+
+\tt
+ discriminate.
+ red; intros n0 Hn0 eqn0Sn0;injection eqn0Sn0;trivial.
+Qed.
+\end{alltt}
+
+The tactic \texttt{elim} \refmancite{Section \ref{Elim}} is a
+refinement of \texttt{apply}, specially designed for the application
+of elimination combinators.  If $t$ is an object of an inductive type
+$I$, then ``~\citecoq{elim $t$}~'' tries to find an abstraction $P$ of the
+current goal $G$ such that $(P\;t)\equiv G$. Then it solves the goal
+applying ``~$I\texttt{\_ind}\;P$~'', where $I$\texttt{\_ind} is the
+combinator associated to $I$.  The different cases of the induction
+then appear as subgoals that remain to be solved.
+In the previous proof, the tactic call ``~\citecoq{apply nat\_ind with (P:= fun n {\funarrow} n {\coqdiff} S n)}~'' can simply be replaced with ``~\citecoq{elim n}~''.
+
+The option ``~\citecoq{\texttt{elim} $t$ \texttt{using} $C$}~''
+ allows to use a
+derived combinator $C$ instead of the default one. Consider the
+following theorem, stating that equality is decidable on natural
+numbers:
+
+\label{iseqpage}
+\begin{alltt}
+Lemma eq_nat_dec : {\prodsym} n p:nat, \{n=p\}+\{n {\coqdiff} p\}.
+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
+\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
+goal, the result is not the expected one.
+
+\vspace{12pt}
+
+%\pagebreak
+\begin{alltt}
+ elim n using nat_double_rec.
+\it
+4 subgoals
+  
+  n : nat
+  p : nat
+  ============================
+   {\prodsym} x : nat, \{x = p\} + \{x {\coqdiff} p\}
+
+subgoal 2 is:
+ nat {\arrow} \{0 = p\} + \{0 {\coqdiff} p\}
+
+subgoal 3 is:
+ nat {\arrow} {\prodsym} m : nat, \{m = p\} + \{m {\coqdiff} p\} {\arrow} \{S m = p\} + \{S m {\coqdiff} p\}
+
+subgoal 4 is:
+ nat
+\end{alltt}
+
+The four sub-goals obtained do not correspond to the premises that
+would be expected for the principle \texttt{nat\_double\_rec}. The
+problem comes from the fact that 
+this principle for eliminating $n$
+has a universally quantified formula as conclusion, which confuses
+\texttt{elim} about the right way of abstracting the goal. 
+
+%In effect, let us consider the type of the goal before the call to
+%\citecoq{elim}: ``~\citecoq{\{n = p\} + \{n {\coqdiff} p\}}~''.
+
+%Among all the abstractions that can be built by ``~\citecoq{elim n}~''
+%let us consider this one
+%$P=$\citecoq{fun n :nat {\funarrow} fun q : nat {\funarrow} {\{q= p\} + \{q {\coqdiff} p\}}}.
+%It is easy to verify that 
+%$P$ has type \citecoq{nat {\arrow} nat {\arrow} Set}, and that, if some 
+%$q:\citecoq{nat}$ is given, then $P\;q\;$ matches the current goal.
+%Then applying \citecoq{nat\_double\_rec} with $P$ generates
+%four goals, corresponding to 
+ 
+
+
+
+Therefore,
+in this case the abstraction must be explicited using the tactic
+\texttt{pattern}. Once the right abstraction is provided, the rest of
+the proof is immediate:
+
+\begin{alltt}
+Undo.
+ pattern p,n.
+\it
+  n : nat
+  p : nat
+  ============================
+   (fun n0 n1 : nat {\funarrow} \{n1 = n0\} + \{n1 {\coqdiff} n0\}) p n
+\tt
+ elim n using nat_double_rec.
+\it
+3 subgoals
+  
+  n : nat
+  p : nat
+  ============================
+   {\prodsym} x : nat, \{x = 0\} + \{x {\coqdiff} 0\}
+
+subgoal 2 is:
+ {\prodsym} x : nat, \{0 = S x\} + \{0 {\coqdiff} S x\}
+subgoal 3 is:
+ {\prodsym} n0 m : nat, \{m = n0\} + \{m {\coqdiff} n0\} {\arrow} \{S m = S n0\} + \{S m {\coqdiff} S n0\}
+
+\tt
+ destruct x; auto.
+ destruct x; auto.
+ intros n0 m H; case H.
+ intro eq; rewrite eq ; auto.
+ intro neg; right; red ; injection 1; auto.
+Defined.
+\end{alltt}
+
+
+Notice that the tactic ``~\texttt{decide equality}~''
+\refmancite{Section\ref{DecideEquality}} generalises the proof
+above to a large class of inductive types.  It can be used for proving
+a proposition of the form 
+$\forall\,(x,y:R),\{x=y\}+\{x{\coqdiff}y\}$, where $R$ is an inductive datatype
+all whose constructors take informative arguments ---like for example
+the type {\nat}:
+
+\begin{alltt}
+Definition eq_nat_dec' : {\prodsym} n p:nat, \{n=p\} + \{n{\coqdiff}p\}.
+ decide equality.
+Defined.
+\end{alltt}
+
+\begin{exercise}
+\begin{enumerate}
+\item Define a recursive  function \emph{nat2itree}
+mapping any natural number $n$ into an infinitely branching
+tree of height $n$.
+\item Provide an elimination combinator for these trees.
+\item Prove that the relation \citecoq{itree\_le} is a preorder 
+(i.e. reflexive and transitive).
+\end{enumerate}
+\end{exercise}
+
+\begin{exercise} \label{zeroton}
+Define the type of lists, and a predicate ``being an ordered list''
+using an inductive family. Then, define the function
+$(from\;n)=0::1\;\ldots\; n::\texttt{nil}$ and prove that it always generates an
+ordered list.
+\end{exercise}
+
+
+\subsection{Well-founded Recursion}
+\label{WellFoundedRecursion}
+
+Structural induction is a strong elimination rule for inductive types.
+This method can be used to define any function whose termination is
+based on the well-foundedness of certain order relation $R$ decreasing
+at each recursive call. What makes this principle so strong is the
+possibility of reasoning by structural induction on the proof that
+certain $R$ is well-founded.  In order to illustrate this we have
+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 :=
+    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
+
+\dots
+\end{alltt}
+
+\noindent This inductive predicate characterize 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.  
+
+Consider now the problem of representing in {\coq} the following ML
+function $\textsl{div}(x,y)$ on natural numbers, which computes
+$\lceil\frac{x}{y}\rceil$ if $y>0$ and yields $x$ otherwise.
+
+\begin{verbatim}
+let rec div x y = 
+  if x = 0 then 0
+  else if y = 0 then x
+       else (div (x-y) y)+1;;
+\end{verbatim}
+
+
+The equality test on natural numbers can be represented as the
+function \textsl{eq\_nat\_dec} defined page \pageref{iseqpage}. Giving $x$ and
+$y$, this function yields either the value $(\textsl{left}\;p)$ if
+there exists a proof $p:x=y$, or the value $(\textsl{right}\;q)$ if
+there exists $q:a\not = b$. The subtraction function is already
+defined in the library \citecoq{Minus}. 
+
+Hence, direct translation of the ML function \textsl{div} would be:
+
+\begin{alltt}
+Require Import Minus.
+
+Fixpoint div (x y:nat)\{struct x\}: nat :=
+ if eq_nat_dec x 0 
+  then 0
+  else if eq_nat_dec y 0
+       then x
+       else S (div (x-y) y).
+
+\it Error:
+Recursive definition of div is ill-formed.
+In environment
+div : nat {\arrow} nat {\arrow} nat
+x : nat
+y : nat
+_ : x {\coqdiff} 0
+_ : y {\coqdiff} 0
+
+Recursive call to div has principal argument equal to
+"x - y"
+instead of a subterm of x
+\end{alltt}
+
+
+The program \texttt{div} is rejected by {\coq} because it does not verify
+the syntactical condition to ensure termination. In particular, the
+argument of the recursive call is not a pattern variable issued from a
+case analysis on $x$. 
+We would have the same problem if we had the directive
+``~\citecoq{\{struct y\}}~'' instead of ``~\citecoq{\{struct x\}}~''.
+However, we know that this program always
+stops. One way to justify its termination is to define it by
+structural induction on a proof that $x$ is accessible trough the
+relation $<$. Notice that any natural number $x$ is accessible
+for this relation. In order to do this, it is first necessary to prove
+some auxiliary lemmas, justifying that the first argument of
+\texttt{div} decreases at each recursive call.
+
+\begin{alltt}
+Lemma minus_smaller_S : {\prodsym} x y:nat, x - y < S x.
+Proof.
+ intros x y; pattern y, x;
+ elim x using nat_double_ind.
+ destruct x0; auto with arith.
+ simpl; auto with arith.
+ simpl; auto with arith.
+Qed.
+
+
+Lemma minus_smaller_positive : 
+ {\prodsym} x y:nat, x {\coqdiff}0 {\arrow} y {\coqdiff} 0 {\arrow}  x - y < x.
+Proof.
+ destruct x; destruct y; 
+ ( simpl;intros; apply minus_smaller || 
+   intros; absurd (0=0); auto).
+Qed.
+\end{alltt}
+
+\noindent The last two lemmas are necessary to prove that for any pair
+of positive natural numbers $x$ and $y$, if $x$ is accessible with
+respect to \citecoq{lt}, then so is $x-y$.
+
+\begin{alltt}
+Definition minus_decrease : {\prodsym} x y:nat, Acc lt x {\arrow} 
+                                         x {\coqdiff} 0 {\arrow} 
+                                         y {\coqdiff} 0 {\arrow}
+                                         Acc lt (x-y).
+Proof.
+ intros x y H; case H.
+ intros Hz posz posy. 
+ apply Hz; apply minus_smaller_positive; assumption.
+Defined.
+\end{alltt}
+
+Let us take a look at the proof of the lemma \textsl{minus\_decrease}, since
+the way in which it has been proven is crucial for what follows.
+\begin{alltt}
+Print minus_decrease.
+\it
+minus_decrease = 
+fun (x y : nat) (H : Acc lt x) {\funarrow}
+match H in (Acc _ y0) return (y0 {\coqdiff} 0 {\arrow} y {\coqdiff} 0 {\arrow} Acc lt (y0 - y)) with
+| Acc_intro z Hz {\funarrow}
+    fun (posz : z {\coqdiff} 0) (posy : y {\coqdiff} 0) {\funarrow}
+    Hz (z - y) (minus_smaller_positive z y posz posy)
+end
+     : {\prodsym} x y : nat, Acc lt x {\arrow} x {\coqdiff} 0 {\arrow} y {\coqdiff} 0 {\arrow} Acc lt (x - y)
+
+\end{alltt}
+\noindent Notice that the function call 
+$(\texttt{minus\_decrease}\;n\;m\;H)$
+indeed yields an accessibility proof that is \textsl{structurally
+smaller} than its argument $H$, because it is (an application of) its
+recursive component $Hz$.  This enables to justify the following
+definition of \textsl{div\_aux}:
+
+\begin{alltt}
+Definition div_aux (x y:nat)(H: Acc lt x):nat.
+ fix 3.
+ intros.
+ refine (if eq_nat_dec x 0 
+         then 0 
+         else if eq_nat_dec y 0 
+              then y
+              else div_aux (x-y) y _).
+\it
+ div_aux : {\prodsym} x : nat, nat {\arrow} Acc lt x {\arrow} nat
+  x : nat
+  y : nat
+  H : Acc lt x
+  _ : x {\coqdiff} 0
+  _0 : y {\coqdiff} 0
+  ============================
+   Acc lt (x - y)
+
+\tt
+ apply (minus_decrease x y H);auto. 
+Defined.
+\end{alltt}
+
+The main division function is easily defined, using the theorem
+\citecoq{lt\_wf} of the library \citecoq{Wf\_nat}. This theorem asserts that
+\citecoq{nat} is well founded w.r.t. \citecoq{lt}, thus any natural number
+is accessible.
+\begin{alltt}
+Definition div x y := div_aux x y (lt_wf x). 
+\end{alltt}
+
+Let us explain the proof above. In the definition of \citecoq{div\_aux},
+what decreases is not $x$ but the \textsl{proof} of the accessibility
+of $x$. The tactic ``~\texttt{fix 3}~'' is used to indicate that the proof
+proceeds by structural induction on the third argument of the theorem
+--that is, on the accessibility proof. It also introduces a new
+hypothesis in the context, named as the current theorem, and with the
+same type as the goal. Then, the proof is refined with an incomplete
+proof term, containing a hole \texttt{\_}.  This hole corresponds to the proof
+of accessibility for $x-y$, and is filled up with the (smaller!)
+accessibility proof provided by the function \texttt{minus\_decrease}. 
+
+
+\noindent Let us take a look to the term \textsl{div\_aux} defined:
+
+\pagebreak
+\begin{alltt}
+Print div_aux.
+\it
+div_aux = 
+(fix div_aux (x y : nat) (H : Acc lt x) \{struct H\} : nat :=
+   match eq_nat_dec x 0 with
+   | left _ {\funarrow} 0
+   | right _ {\funarrow}
+       match eq_nat_dec y 0 with
+       | left _ {\funarrow} y
+       | right _0 {\funarrow} div_aux (x - y) y (minus_decrease x y H _ _0)
+       end
+   end)
+     : {\prodsym} x : nat, nat {\arrow} Acc lt x {\arrow} nat
+
+\end{alltt}
+
+If the non-informative parts from this proof --that is, the
+accessibility proof-- are erased, then we obtain exactly the program
+that we were looking for. 
+\begin{alltt}
+
+Extraction div.
+
+\it
+let div x y =
+  div_aux x y
+\tt
+
+Extraction div_aux.
+
+\it
+let rec div_aux x y =
+  match eq_nat_dec x O with
+    | Left {\arrow} O
+    | Right {\arrow}
+        (match eq_nat_dec y O with
+           | Left {\arrow} y
+           | Right {\arrow} div_aux (minus x y) y)
+\end{alltt}
+
+This methodology enables the representation
+of any program whose termination can be proved in {\coq}. Once the
+expected properties from this program have been verified, the
+justification of its termination can be thrown away, keeping just the
+desired computational behavior for it.
+
+\section{A case study in dependent elimination}\label{CaseStudy}
+
+Dependent types are very expressive, but ignoring some useful
+techniques can cause some problems to the beginner.
+Let us consider again the type of vectors (see section~\ref{vectors}).
+We want to prove a quite trivial property: the only value of type
+``~\citecoq{vector A 0}~'' is ``~\citecoq{Vnil $A$}~''.
+
+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.
+Proof.
+ intros A v;inversion v.
+\it
+1 subgoal
+  
+  A : Set
+  v : vector A 0
+  ============================
+   v = Vnil A
+\tt
+Abort.
+\end{alltt}
+
+Another attempt is to do a case analysis on a vector of any length
+$n$, under an explicit hypothesis $n=0$. The tactic 
+\texttt{discriminate} will help us to get rid of the case 
+$n=\texttt{S $p$}$. 
+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.
+
+\it
+Error: In environment
+A : Set
+n : nat
+v : vector A n
+e : n = 0
+The term "Vnil A" has type "vector A 0" while it is expected to have type
+ "vector A n"
+\end{alltt}
+
+In effect, the equality ``~\citecoq{v = Vnil A}~'' is ill typed,
+because the type ``~\citecoq{vector A n}~'' is not \emph{convertible}
+with ``~\citecoq{vector A 0}~''.
+
+This problem can be solved if we consider the heterogeneous 
+equality \citecoq{JMeq} \cite{conor:motive}
+which allows us to consider terms of different types, even if this
+equality can only be proven for terms in the same type.
+The axiom \citecoq{JMeq\_eq}, from the library \citecoq{JMeq} allows us to convert a
+heterogeneous equality to a standard one.
+
+\begin{alltt}
+Lemma vector0_is_vnil_aux : 
+   {\prodsym} (A:Set)(n:nat)(v:vector A n), 
+      n= 0 {\arrow} JMeq v (Vnil A).
+Proof.
+ destruct v.
+ auto.
+ intro; discriminate.
+Qed.
+\end{alltt}
+
+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.
+ intros a v;apply JMeq_eq.
+ apply vector0_is_vnil_aux.
+ trivial.
+Qed.
+\end{alltt}
+
+It is interesting to look at another proof of 
+\citecoq{vector0\_is\_vnil}, which illustrates a technique developed
+and used by various people (consult in the \emph{Coq-club} mailing
+list archive the contributions by Yves Bertot, Pierre Letouzey, Laurent Théry,
+Jean Duprat, and Nicolas Magaud, Venanzio Capretta and Conor McBride).
+This technique is also used for unfolding  infinite list definitions
+(see chapter13 of~\cite{coqart}).
+Notice that this definition does not rely on any axiom (\emph{e.g.} \texttt{JMeq\_eq}).
+
+We first give a new definition of the identity on vectors. Before that,
+we make  the use of constructors and selectors lighter thanks to
+the implicit arguments feature:
+
+\begin{alltt}
+Implicit Arguments Vcons [A n].
+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.
+Proof.
+ destruct n; intro v.
+ exact Vnil.
+ exact (Vcons (Vhead v) (Vtail v)).
+Defined.
+\end{alltt}
+
+
+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).
+Proof.
+ destruct v.
+
+\it
+   A : Set
+  ============================
+   Vnil = Vid A 0 Vnil
+
+subgoal 2 is:
+  Vcons a v = Vid A (S n) (Vcons a v)
+\tt
+ reflexivity.
+ reflexivity.
+Defined.
+\end{alltt}
+
+Why defining a new identity function on vectors? The following
+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
+
+\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
+\end{alltt}
+
+Then we prove easily that any vector of length 0 is \citecoq{Vnil}:
+
+\begin{alltt}
+Theorem zero_nil : {\prodsym} A (v:vector A 0), v = Vnil.
+Proof.
+ intros.
+ change (Vnil (A:=A)) with (Vid _ 0 v). 
+\it
+1 subgoal
+  
+  A : Set
+  v : vector A 0
+  ============================
+   v = Vid A 0 v
+\tt
+ apply Vid_eq.
+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 
+is from Jean Duprat.}.
+
+\begin{alltt}
+
+
+Theorem decomp :
+  {\prodsym} (A : Set) (n : nat) (v : vector A (S n)),
+  v = Vcons (Vhead v) (Vtail v).
+Proof.
+ intros.
+ change (Vcons (Vhead v) (Vtail v)) with (Vid _  (S n) v).
+\it
+ 1 subgoal
+  
+  A : Set
+  n : nat
+  v : vector A (S n)
+  ============================
+   v = Vid A (S n) v
+
+\tt{} apply Vid_eq.
+Defined.
+\end{alltt}
+
+
+Both lemmas: \citecoq{zero\_nil} and \citecoq{decomp},
+can be used to easily derive a double recursion principle
+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),
+        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}
+        {\prodsym} n (v1 v2 : vector A n), P n v1 v2.
+ induction n.
+ intros; rewrite (zero_nil _ v1); rewrite (zero_nil _ v2).
+ auto.
+ intros v1 v2; rewrite (decomp _ _ v1);rewrite (decomp _ _ v2).
+ apply X0; auto.
+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}
+instead of type (thus it is useless to build 
+\citecoq{vector\_double\_ind} and \citecoq{vector\_double\_rec}) from scratch.
+
+We finish this example with showing how to define the bitwise
+\emph{or} on boolean vectors of the same length, 
+and proving a little property about this
+operation.
+
+\begin{alltt}
+Definition bitwise_or n v1 v2 : vector bool n :=
+   vector_double_rect 
+    bool 
+    (fun n v1 v2 {\funarrow} vector bool n)
+    Vnil
+    (fun n v1 v2 a b r {\funarrow} Vcons (orb a b) r) n v1 v2.
+\end{alltt}
+
+Let us  define recursively the $n$-th element of a vector. Notice
+that it must be a partial function, in case $n$ is greater or equal
+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)
+                  \{struct v\}
+                  : option A :=
+  match n,v  with
+    _   , Vnil {\funarrow} None
+  | 0   , Vcons b  _ _ {\funarrow} Some b
+  | S n', Vcons _  p' v' {\funarrow} vector_nth A n'  p' v'
+  end.
+Implicit Arguments vector_nth [A p].
+\end{alltt}
+
+We can now prove --- using the double induction combinator ---
+a simple property relying \citecoq{vector\_nth} and \citecoq{bitwise\_or}:
+
+\begin{alltt}
+Lemma nth_bitwise :
+   {\prodsym} (n:nat) (v1 v2: vector bool n) i  a b,
+      vector_nth i v1 = Some a {\arrow}
+      vector_nth i v2 = Some b {\arrow}
+      vector_nth i (bitwise_or _ v1 v2) = Some (orb a b).
+Proof.
+ intros  n v1 v2; pattern n,v1,v2.
+ apply vector_double_rect.
+ simpl.
+ destruct i; discriminate 1.
+ destruct i; simpl;auto.
+ injection 1; injection 2;intros; subst a; subst b; auto.
+Qed.
+\end{alltt}
+
+
+\section{Co-inductive Types and Non-ending Constructions}
+\label{CoInduction}
+
+The objects of an inductive type are well-founded with respect to
+the constructors of the type. In other words, these objects are built
+by applying \emph{a finite number of times} the constructors of the type.
+Co-inductive types are obtained by relaxing this condition,
+and may contain non-well-founded objects \cite{EG96,EG95a}.  An
+example of a co-inductive type is the type of  infinite
+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   := 
+ | Cons : A\arrow{}Stream A\arrow{}Stream A.
+\end{alltt}
+
+If we are interested in finite or infinite sequences, we consider the type
+of \emph{lazy lists}:
+
+\begin{alltt}
+CoInductive LList (A: Set) : Set :=
+ |  LNil : LList A
+ |  LCons : A {\arrow} LList A {\arrow} LList A.
+\end{alltt}
+
+
+It is also possible to define  co-inductive types for the 
+trees with infinite branches (see Chapter 13 of~\cite{coqart}).
+
+Structural induction is the way of expressing that inductive types
+only contain well-founded objects. Hence, this elimination principle
+is not valid for co-inductive types, and the only elimination rule for
+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) := 
+   match s with Cons a s' {\funarrow} a end.
+
+ Definition tail (A : Set)(s : Stream A) :=
+      match s with Cons a s' {\funarrow} s' end.
+\end{alltt}
+
+Infinite objects are defined by means of (non-ending) methods of
+construction, like in lazy functional programming languages.  Such
+methods can be defined using the \texttt{CoFixpoint} command
+\refmancite{Section \ref{CoFixpoint}}. For example, the following
+definition introduces the infinite list $[a,a,a,\ldots]$:
+
+\begin{alltt}
+ CoFixpoint repeat (A:Set)(a:A) : Stream A := 
+   Cons a (repeat a).
+\end{alltt}
+
+
+However, not every co-recursive definition is an admissible method of
+construction. Similarly to the case of structural induction, the
+definition must verify a \textsl{guardedness} condition to be
+accepted. This condition states that any recursive call in the
+definition must be protected --i.e, be an argument of-- some
+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:=
+    Cons a (iterate f (f a)).
+
+CoFixpoint map 
+  (A B:Set)(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}
+
+\begin{exercise}
+Define two different methods for constructing the stream which 
+infinitely alternates the values \citecoq{true} and \citecoq{false}.
+\end{exercise}
+\begin{exercise}
+Using the destructors \texttt{head} and \texttt{tail}, define a function
+which takes the n-th element of an infinite stream.
+\end{exercise}
+
+A non-ending method of construction is computed lazily. This means
+that its definition is unfolded only when the object that it
+introduces is eliminated, that is, when it appears as the argument of
+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
+\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
+\end{alltt}
+
+%\begin{exercise}
+%Prove the following theorem:
+%\begin{verbatim}
+%Theorem expand_repeat : (a:A)(repeat a)=(Cons a (repeat a)). 
+%\end{verbatim}
+%Hint: Prove first the streams version of the lemma in exercise 
+%\ref{expand}.
+%\end{exercise}
+
+\subsection{Extensional Properties}
+
+Case analysis is also a valid proof principle for infinite
+objects. However, this principle is not sufficient to prove
+\textsl{extensional} properties, that is, properties concerning the
+whole infinite object \cite{EG95a}. A typical example of an
+extensional property is the predicate expressing that two streams have
+the same elements. In many cases, the minimal reflexive relation $a=b$
+that is used as equality for inductive types is too small to capture
+equality between streams. Consider for example the streams
+$\texttt{iterate}\;f\;(f\;x)$ and
+$(\texttt{map}\;f\;(\texttt{iterate}\;f\;x))$. Even though these two streams have
+the same elements, no finite expansion of their definitions lead to
+equal terms. In other words, in order to deal with extensional
+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 :=
+  eqst : {\prodsym} s1 s2: Stream A,
+      head s1 = head s2 {\arrow}
+      EqSt (tail s1) (tail s2) {\arrow}
+      EqSt s1 s2.
+\end{alltt}
+
+It is possible to introduce proof principles for reasoning about
+infinite objects as combinators defined through
+\texttt{CoFixpoint}. However, oppositely to the case of inductive
+types, proof principles associated to co-inductive types are not
+elimination but \textsl{introduction} combinators. An example of such
+a combinator is Park's principle for proving the equality of two
+streams, usually called the \textsl{principle of co-induction}. It
+states that two streams are equal if they satisfy a
+\textit{bisimulation}.  A bisimulation is a binary relation $R$ such
+that any pair of streams $s_1$ ad $s_2$ satisfying $R$ have equal
+heads, and tails also satisfying $R$.  This principle is in fact a
+method for constructing an infinite proof:
+
+\begin{alltt}
+Section Parks_Principle.
+Variable A : Set.
+Variable    R      : Stream A {\arrow} Stream A {\arrow} Prop.
+Hypothesis  bisim1 : {\prodsym} s1 s2:Stream A, 
+                       R s1 s2 {\arrow} head s1 = head s2.
+
+Hypothesis  bisim2 : {\prodsym} s1 s2:Stream A, 
+                       R s1 s2 {\arrow} R (tail s1) (tail s2).
+
+CoFixpoint park_ppl     : 
+ {\prodsym} s1 s2:Stream A, R s1 s2 {\arrow} EqSt s1 s2 :=
+ fun s1 s2 (p : R s1 s2) {\funarrow}
+      eqst s1 s2 (bisim1 s1 s2 p) 
+                 (park_ppl (tail s1) 
+                           (tail s2) 
+                           (bisim2 s1 s2 p)).
+End Parks_Principle.
+\end{alltt}
+
+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),
+                       EqSt (iterate f (f x)) 
+                            (map f (iterate f x)).
+Proof.
+ intros A f x.
+ apply park_ppl with
+   (R:= fun s1 s2 {\funarrow}
+       {\exsym} x: A, s1 = iterate f (f x) {\coqand} 
+                s2 = map f (iterate f x)).
+
+ intros s1 s2 (x0,(eqs1,eqs2));
+    rewrite eqs1; rewrite eqs2; reflexivity.
+ intros s1 s2 (x0,(eqs1,eqs2)).
+ exists (f x0);split;
+    [rewrite eqs1|rewrite eqs2]; reflexivity.
+ exists x;split; reflexivity.
+Qed.
+\end{alltt}
+
+The use of Park's principle is sometimes annoying, because it requires
+to find an invariant relation and prove that it is indeed a
+bisimulation.  In many cases, a shorter proof can be obtained trying
+to construct an ad-hoc infinite proof, defined by a guarded
+declaration.  The tactic ``~``\texttt{Cofix $f$}~'' can be used to do
+that. Similarly to the tactic \texttt{fix} indicated in Section
+\ref{WellFoundedRecursion}, this tactic introduces an extra hypothesis
+$f$ into the context, whose type is the same as the current goal. Note
+that the applications of $f$ in the proof \textsl{must be guarded}. In
+order to prevent us from doing unguarded calls, we can define a tactic
+that always apply a constructor before using $f$ \refmancite{Chapter
+\ref{WritingTactics}} :
+
+\begin{alltt}
+Ltac infiniteproof f :=
+  cofix f; 
+  constructor; 
+  [clear f| simpl; try (apply f; clear f)].
+\end{alltt}
+
+
+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),
+                       EqSt (iterate f (f x))
+                            (map f (iterate f x)).
+Proof.
+ infiniteproof map_iterate'.
+ reflexivity.
+Qed.
+\end{alltt}
+
+\begin{exercise}
+Define a co-inductive type $Nat$ containing non-standard 
+natural numbers --this is, verifying 
+
+$$\exists m  \in \mbox{\texttt{Nat}}, \forall\, n \in \mbox{\texttt{Nat}}, n<m$$.
+\end{exercise}
+
+\begin{exercise}
+Prove that the extensional equality of streams is an equivalence relation
+using Park's co-induction principle.
+\end{exercise}
+
+
+\begin{exercise}
+Provide a suitable definition of ``being an ordered list'' for infinite lists
+and define a principle for proving that an infinite list is ordered. Apply
+this method to the list $[0,1,\ldots ]$. Compare the result with 
+exercise \ref{zeroton}.
+\end{exercise}
+
+\subsection{About injection, discriminate, and inversion}
+Since co-inductive types are closed w.r.t. their constructors,
+the techniques shown in Section~\ref{CaseTechniques} work also 
+with these types.
+
+Let us consider the type of lazy lists, introduced on page~\pageref{CoInduction}.
+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),
+                               LNil {\coqdiff} (LCons a l).
+Proof.
+ intros;discriminate.
+Qed.
+
+Lemma injection_demo : {\prodsym} (A:Set)(a b : A)(l l': LList A),
+                       LCons a (LCons b l) = LCons b (LCons a l') {\arrow}
+                       a = b {\coqand} l = l'.
+Proof.
+ intros A a b l l' e; injection e; auto.
+Qed.
+
+\end{alltt}
+
+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 :=
+|  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 :=
+| 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)).
+Proof.
+  intros A H;inversion H.
+Qed.
+
+Lemma Finite_not_Infinite : {\prodsym} (A:Set)(l:LList A),
+                                Finite l {\arrow} ~ Infinite l.
+Proof.
+ intros A l H; elim H.
+ apply LNil_not_Infinite.
+ intros a l0 F0 I0' I1.
+ case I0'; inversion_clear I1.
+ trivial.
+Qed.
+\end{alltt}
+
+
+On the other hand, the next proof uses the \citecoq{cofix} tactic. 
+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),
+                            ~ Finite l {\arrow} Infinite l.
+Proof.
+ cofix H.
+ destruct l.
+ intro; 
+  absurd (Finite (LNil (A:=A)));
+  [auto|constructor].
+\it
+
+
+
+
+1 subgoal
+  
+  H : forall (A : Set) (l : LList A), ~ Finite l -> Infinite l
+  A : Set
+  a : A
+  l : LList A
+  H0 : ~ Finite (LCons a l)
+  ============================
+   Infinite l
+\end{alltt}
+At this point, one must not apply \citecoq{H}! . It would be possible
+to solve the current goal by an inversion of ``~\citecoq{Finite (LCons a l)}~'', but, since the guard condition would be violated, the user
+would get an error message after typing \citecoq{Qed}.
+In order to satisfy the guard condition, we apply the constructor of
+\citecoq{Infinite}, \emph{then} apply \citecoq{H}.
+
+\begin{alltt}
+ constructor.
+ apply H.
+ red; intro H1;case H0.
+ constructor.
+ trivial.
+Qed.
+\end{alltt}
+
+
+
+
+The reader is invited to replay this proof and understand each of its steps.
+
+
+\bibliographystyle{abbrv}
+\bibliography{manbiblio,morebib}
+
+\end{document}
+
diff --git a/test-suite/success/RecTutorial.v8 b/doc/RecTutorial/RecTutorial.v
index 1cef3f2f..d79b85df 100644
--- a/test-suite/success/RecTutorial.v8
+++ b/doc/RecTutorial/RecTutorial.v
@@ -769,7 +769,7 @@ Eval simpl in even_test.
 
 Eval simpl in (fun x : nat => even_test x).
 
-
+Eval simpl in (fun x : nat => plus 5 x).
 Eval simpl in (fun x : nat => even_test (plus 5 x)).
 
 Eval simpl in (fun x : nat => even_test (plus x 5)).
@@ -778,11 +778,11 @@ Eval simpl in (fun x : nat => even_test (plus x 5)).
 Section Principle_of_Induction.
 Variable    P               : nat -> Prop.
 Hypothesis  base_case       : P 0.
-Hypothesis  inductive_hyp   : forall n:nat, P n -> P (S n).
+Hypothesis  inductive_step   : forall n:nat, P n -> P (S n).
 Fixpoint nat_ind  (n:nat)    : (P n) := 
    match n return P n with
           | 0 => base_case
-          | S m => inductive_hyp m (nat_ind m)
+          | S m => inductive_step m (nat_ind m)
    end. 
 
 End Principle_of_Induction.
@@ -802,12 +802,12 @@ Section Principle_of_Double_Induction.
 Variable    P               : nat -> nat ->Prop.
 Hypothesis  base_case1      : forall x:nat, P 0 x.
 Hypothesis  base_case2      : forall x:nat, P (S x) 0.
-Hypothesis  inductive_hyp   : forall n m:nat, P n m -> P (S n) (S m).
+Hypothesis  inductive_step   : forall n m:nat, P n m -> P (S n) (S m).
 Fixpoint nat_double_ind (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_hyp x y (nat_double_ind x y)
+         |  (S x), (S y) =>  inductive_step x y (nat_double_ind x y)
      end.
 End Principle_of_Double_Induction.
 
@@ -815,12 +815,12 @@ Section Principle_of_Double_Recursion.
 Variable    P               : nat -> nat -> Set.
 Hypothesis  base_case1      : forall x:nat, P 0 x.
 Hypothesis  base_case2      : forall x:nat, P (S x) 0.
-Hypothesis  inductive_hyp   : forall n m:nat, P n m -> P (S n) (S m).
+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 := 
   match n, m return P n m with 
          |   0 ,     x    =>  base_case1 x 
          |  (S x),    0   => base_case2 x
-         |  (S x), (S y)  => inductive_hyp x y (nat_double_rec x y)
+         |  (S x), (S y)  => inductive_step x y (nat_double_rec x y)
      end.
 End Principle_of_Double_Recursion.
 
@@ -912,7 +912,7 @@ Definition minus_decrease : forall x y:nat, Acc lt x ->
                                          Acc lt (x-y).
 Proof.
  intros x y H; case H.
- intros z Hz posz posy. 
+ intros Hz posz posy. 
  apply Hz; apply minus_smaller_positive; assumption.
 Defined.
 
diff --git a/doc/RecTutorial/coqartmacros.tex b/doc/RecTutorial/coqartmacros.tex
new file mode 100644
index 00000000..6fb7534d
--- /dev/null
+++ b/doc/RecTutorial/coqartmacros.tex
@@ -0,0 +1,180 @@
+\usepackage{url}
+
+\newcommand{\variantspringer}[1]{#1}
+\newcommand{\marginok}[1]{\marginpar{\raggedright OK:#1}}
+\newcommand{\tab}{{\null\hskip1cm}}
+\newcommand{\Ltac}{\mbox{\emph{$\cal L$}tac}}
+\newcommand{\coq}{\mbox{\emph{Coq}}}
+\newcommand{\lcf}{\mbox{\emph{LCF}}}
+\newcommand{\hol}{\mbox{\emph{HOL}}}
+\newcommand{\pvs}{\mbox{\emph{PVS}}}
+\newcommand{\isabelle}{\mbox{\emph{Isabelle}}}
+\newcommand{\prolog}{\mbox{\emph{Prolog}}}
+\newcommand{\goalbar}{\tt{}============================\it}
+\newcommand{\gallina}{\mbox{\emph{Gallina}}}
+\newcommand{\joker}{\texttt{\_}}
+\newcommand{\eprime}{\(\e^{\prime}\)}
+\newcommand{\Ztype}{\citecoq{Z}}
+\newcommand{\propsort}{\citecoq{Prop}}
+\newcommand{\setsort}{\citecoq{Set}}
+\newcommand{\typesort}{\citecoq{Type}}
+\newcommand{\ocaml}{\mbox{\emph{OCAML}}}
+\newcommand{\haskell}{\mbox{\emph{Haskell}}}
+\newcommand{\why}{\mbox{\emph{Why}}}
+\newcommand{\Pascal}{\mbox{\emph{Pascal}}}
+
+\newcommand{\ml}{\mbox{\emph{ML}}}
+
+\newcommand{\scheme}{\mbox{\emph{Scheme}}}
+\newcommand{\lisp}{\mbox{\emph{Lisp}}}
+
+\newcommand{\implarrow}{\mbox{$\Rightarrow$}}
+\newcommand{\metavar}[1]{?#1}
+\newcommand{\notincoq}[1]{#1}
+\newcommand{\coqscope}[1]{\%#1}
+\newcommand{\arrow}{\mbox{$\rightarrow$}}
+\newcommand{\fleche}{\arrow}
+\newcommand{\funarrow}{\mbox{$\Rightarrow$}}
+\newcommand{\ltacarrow}{\funarrow}
+\newcommand{\coqand}{\mbox{\(\wedge\)}}
+\newcommand{\coqor}{\mbox{\(\vee\)}}
+\newcommand{\coqnot}{\mbox{\(\neg\)}}
+\newcommand{\hide}[1]{}
+\newcommand{\hidedots}[1]{...}
+\newcommand{\sig}[3]{\texttt{\{}#1\texttt{:}#2 \texttt{|} #3\texttt{\}}}
+\renewcommand{\neg}{\sim}
+\renewcommand{\marginpar}[1]{}
+
+\addtocounter{secnumdepth}{1}
+\providecommand{\og}{«}
+\providecommand{\fg}{»}
+
+
+\newcommand{\hard}{\mbox{\small *}}
+\newcommand{\xhard}{\mbox{\small **}}
+\newcommand{\xxhard}{\mbox{\small ***}}
+
+%%% Operateurs, etc.
+\newcommand{\impl}{\mbox{$\rightarrow$}}
+\newcommand{\appli}[2]{\mbox{\tt{#1 #2}}}
+\newcommand{\applis}[1]{\mbox{\texttt{#1}}}
+\newcommand{\abst}[3]{\mbox{\tt{fun #1:#2 \funarrow #3}}}
+\newcommand{\coqle}{\mbox{$\leq$}}
+\newcommand{\coqge}{\mbox{$\geq$}}
+\newcommand{\coqdiff}{\mbox{$\neq$}}
+\newcommand{\coqiff}{\mbox{$\leftrightarrow$}}
+\newcommand{\prodsym}{\mbox{\(\forall\,\)}}
+\newcommand{\exsym}{\mbox{\(\exists\,\)}}
+
+\newcommand{\substsign}{/}
+\newcommand{\subst}[3]{\mbox{#1\{#2\substsign{}#3\}}}
+\newcommand{\anoabst}[2]{\mbox{\tt[#1]#2}}
+\newcommand{\letin}[3]{\mbox{\tt let #1:=#2 in #3}}
+\newcommand{\prodep}[3]{\mbox{\tt \(\forall\,\)#1:#2,$\,$#3}}
+\newcommand{\prodplus}[2]{\mbox{\tt\(\forall\,\)$\,$#1,$\,$#2}}
+\newcommand{\dom}[1]{\textrm{dom}(#1)} % domaine d'un contexte (log function)
+\newcommand{\norm}[1]{\textrm{n}(#1)} % forme normale (log function)
+\newcommand{\coqZ}[1]{\mbox{\tt{`#1`}}}
+\newcommand{\coqnat}[1]{\mbox{\tt{#1}}}
+\newcommand{\coqcart}[2]{\mbox{\tt{#1*#2}}}
+\newcommand{\alphacong}{\mbox{$\,\cong_{\alpha}\,$}} % alpha-congruence
+\newcommand{\betareduc}{\mbox{$\,\rightsquigarrow_{\!\beta}$}\,} % beta reduction
+%\newcommand{\betastar}{\mbox{$\,\Rightarrow_{\!\beta}^{*}\,$}} % beta reduction
+\newcommand{\deltareduc}{\mbox{$\,\rightsquigarrow_{\!\delta}$}\,} % delta reduction
+\newcommand{\dbreduc}{\mbox{$\,\rightsquigarrow_{\!\delta\beta}$}\,} % delta,beta reduction
+\newcommand{\ireduc}{\mbox{$\,\rightsquigarrow_{\!\iota}$}\,} % delta,beta reduction
+
+
+% jugement de typage
+\newcommand{\these}{\boldsymbol{\large \vdash}}
+\newcommand{\disj}{\mbox{$\backslash/$}}
+\newcommand{\conj}{\mbox{$/\backslash$}}
+%\newcommand{\juge}[3]{\mbox{$#1 \boldsymbol{\vdash} #2 : #3 $}}
+\newcommand{\juge}[4]{\mbox{$#1,#2 \these #3 \boldsymbol{:} #4 $}}
+\newcommand{\smalljuge}[3]{\mbox{$#1 \these #2 \boldsymbol{:} #3 $}}
+\newcommand{\goal}[3]{\mbox{$#1,#2 \these^{\!\!\!?} #3  $}}
+\newcommand{\sgoal}[2]{\mbox{$#1\these^{\!\!\!\!?} #2 $}}
+\newcommand{\reduc}[5]{\mbox{$#1,#2 \these #3 \rhd_{#4}#5 $}}
+\newcommand{\convert}[5]{\mbox{$#1,#2 \these #3 =_{#4}#5 $}}
+\newcommand{\convorder}[5]{\mbox{$#1,#2 \these #3\leq _{#4}#5 $}}
+\newcommand{\wouff}[2]{\mbox{$\emph{WF}(#1)[#2]$}}
+
+
+%\newcommand{\mthese}{\underset{M}{\vdash}}
+\newcommand{\mthese}{\boldsymbol{\vdash}_{\!\!M}}
+\newcommand{\type}{\boldsymbol{:}}
+
+% jugement absolu
+
+%\newcommand{\ajuge}[2]{\mbox{$ \boldsymbol{\vdash} #1 : #2 $}}
+\newcommand{\ajuge}[2]{\mbox{$\these #1 \boldsymbol{:} #2 $}}
+
+%%% logique minimale
+\newcommand{\propzero}{\mbox{$P_0$}} % types de Fzero
+
+%%% logique propositionnelle classique
+\newcommand {\ff}{\boldsymbol{f}} % faux
+\newcommand {\vv}{\boldsymbol{t}} % vrai
+
+\newcommand{\verite}{\mbox{$\cal{B}$}} % {\ff,\vv}
+\newcommand{\sequ}[2]{\mbox{$#1 \vdash #2 $}} % sequent
+\newcommand{\strip}[1]{#1^o} % enlever les variables d'un contexte
+
+
+
+%%% tactiques
+\newcommand{\decomp}{\delta} % decomposition
+\newcommand{\recomp}{\rho} % recomposition
+
+%%% divers
+\newcommand{\cqfd}{\mbox{\textbf{cqfd}}}
+\newcommand{\fail}{\mbox{\textbf{F}}}
+\newcommand{\succes}{\mbox{$\blacksquare$}}
+%%% Environnements
+
+
+%% Fzero
+\newcommand{\con}{\mbox{$\cal C$}}
+\newcommand{\var}{\mbox{$\cal V$}}
+
+\newcommand{\atomzero}{\mbox{${\cal A}_0$}} % types de base de Fzero
+\newcommand{\typezero}{\mbox{${\cal T}_0$}} % types de Fzero
+\newcommand{\termzero}{\mbox{$\Lambda_0$}} % termes de Fzero 
+\newcommand{\conzero}{\mbox{$\cal C_0$}} % contextes de Fzero 
+
+\newcommand{\buts}{\mbox{$\cal B$}} % buts
+
+%%% for drawing terms
+% abstraction [x:t]e
+\newcommand{\PicAbst}[3]{\begin{bundle}{\bf abst}\chunk{#1}\chunk{#2}\chunk{#3}%
+                        \end{bundle}}
+
+% the same in DeBruijn form
+\newcommand{\PicDbj}[2]{\begin{bundle}{\bf abst}\chunk{#1}\chunk{#2}
+                       \end{bundle}}
+
+
+% applications
+\newcommand{\PicAppl}[2]{\begin{bundle}{\bf appl}\chunk{#1}\chunk{#2}%
+                         \end{bundle}}
+
+% variables
+\newcommand{\PicVar}[1]{\begin{bundle}{\bf var}\chunk{#1}
+                          \end{bundle}}
+
+% constantes
+\newcommand{\PicCon}[1]{\begin{bundle}{\bf const}\chunk{#1}\end{bundle}}
+
+% arrows
+\newcommand{\PicImpl}[2]{\begin{bundle}{\impl}\chunk{#1}\chunk{#2}%
+                         \end{bundle}}
+
+
+
+%%%% scripts coq
+\newcommand{\prompt}{\mbox{\sl Coq $<\;$}}
+\newcommand{\natquicksort}{\texttt{nat\_quicksort}}
+\newcommand{\citecoq}[1]{\mbox{\texttt{#1}}}
+\newcommand{\safeit}{\it}
+\newtheorem{remarque}{Remark}[section]
+%\newtheorem{definition}{Definition}[chapter]
diff --git a/doc/RecTutorial/manbiblio.bib b/doc/RecTutorial/manbiblio.bib
new file mode 100644
index 00000000..099e3bbd
--- /dev/null
+++ b/doc/RecTutorial/manbiblio.bib
@@ -0,0 +1,875 @@
+
+@STRING{toappear="To appear"}
+@STRING{lncs="Lecture Notes in Computer Science"}
+
+@TECHREPORT{RefManCoq,
+        AUTHOR             = {Bruno~Barras, Samuel~Boutin,
+  Cristina~Cornes, Judicaël~Courant, Yann~Coscoy, David~Delahaye,
+  Daniel~de~Rauglaudre, Jean-Christophe~Filliâtre, Eduardo~Giménez,
+  Hugo~Herbelin, Gérard~Huet, Henri~Laulhère, César~Muñoz,
+  Chetan~Murthy, Catherine~Parent-Vigouroux, Patrick~Loiseleur,
+  Christine~Paulin-Mohring, Amokrane~Saïbi, Benjamin~Werner},
+        INSTITUTION        = {INRIA},
+        TITLE              = {{The Coq Proof Assistant Reference Manual -- Version V6.2}},
+        YEAR               = {1998}
+}
+
+@INPROCEEDINGS{Aud91,
+        AUTHOR             = {Ph. Audebaud},
+        BOOKTITLE          = {Proceedings of the sixth Conf. on Logic in Computer Science.},
+        PUBLISHER          = {IEEE},
+        TITLE              = {Partial {Objects} in the {Calculus of Constructions}},
+        YEAR               = {1991}
+}
+
+@PHDTHESIS{Aud92,
+        AUTHOR             = {Ph. Audebaud},
+        SCHOOL             = {{Universit\'e} Bordeaux I},
+        TITLE              = {Extension du Calcul des Constructions par Points fixes},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Audebaud92b,
+        AUTHOR             = {Ph. Audebaud},
+        BOOKTITLE          = {{Proceedings of the 1992 Workshop on Types for Proofs and Programs}},
+        EDITOR             = {{B. Nordstr\"om and K. Petersson and G. Plotkin}},
+        NOTE               = {Also Research Report LIP-ENS-Lyon},
+        PAGES              = {pp 21--34},
+        TITLE              = {{CC+ : an extension of the Calculus of Constructions with fixpoints}},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Augustsson85,
+        AUTHOR             = {L. Augustsson},
+        TITLE              = {{Compiling Pattern Matching}},
+        BOOKTITLE          = {Conference Functional Programming and
+Computer Architecture},
+        YEAR               = {1985}
+}
+
+@INPROCEEDINGS{EG94a,
+        AUTHOR             = {E. Gim\'enez},
+	EDITORS            = {P. Dybjer and B. Nordstr\"om and J. Smith},
+        BOOKTITLE          = {Workshop on Types for Proofs and Programs},
+        PAGES              = {39-59},
+        SERIES             = {LNCS},
+        NUMBER             = {996},
+        TITLE              = {{Codifying guarded definitions with recursive schemes}},
+        YEAR               = {1994},
+        PUBLISHER          = {Springer-Verlag},
+}
+
+@INPROCEEDINGS{EG95a,
+        AUTHOR             = {E. Gim\'enez},
+        BOOKTITLE          = {Workshop on Types for Proofs and Programs},
+        SERIES             = {LNCS},
+        NUMBER             = {1158},
+        PAGES              = {135-152},
+        TITLE              = {An application of co-Inductive types in Coq: 
+		               verification of the Alternating Bit Protocol},
+        EDITORS            = {S. Berardi and M. Coppo},
+        PUBLISHER          = {Springer-Verlag},
+        YEAR               = {1995}
+}
+
+@PhdThesis{EG96,
+  author = 	 {E. Gim\'enez},
+  title = 	 {A Calculus of Infinite Constructions and its
+                  application to the verification of communicating systems},
+  school = 	 {Ecole Normale Sup\'erieure de Lyon},
+  year = 	 {1996}
+}
+	
+@ARTICLE{BaCo85,
+        AUTHOR             = {J.L. Bates and R.L. Constable},
+        JOURNAL            = {ACM transactions on Programming Languages and Systems},
+        TITLE              = {Proofs as {Programs}},
+        VOLUME             = {7},
+        YEAR               = {1985}
+}
+
+@BOOK{Bar81,
+        AUTHOR             = {H.P. Barendregt},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {The Lambda Calculus its Syntax and Semantics},
+        YEAR               = {1981}
+}
+
+@TECHREPORT{Bar91,
+        AUTHOR             = {H. Barendregt},
+        INSTITUTION        = {Catholic University Nijmegen},
+        NOTE               = {In Handbook of Logic in Computer Science, Vol II},
+        NUMBER             = {91-19},
+        TITLE              = {Lambda {Calculi with Types}},
+        YEAR               = {1991}
+}
+
+@BOOK{Bastad92,
+        EDITOR             = {B. Nordstr\"om and K. Petersson and G. Plotkin},
+        PUBLISHER          = {Available by ftp at site ftp.inria.fr},
+        TITLE              = {Proceedings of the 1992 Workshop on Types for Proofs and Programs},
+        YEAR               = {1992}
+}
+
+@BOOK{Bee85,
+        AUTHOR             = {M.J. Beeson},
+        PUBLISHER          = {Springer-Verlag},
+        TITLE              = {Foundations of Constructive Mathematics, Metamathematical Studies},
+        YEAR               = {1985}
+}
+
+@ARTICLE{BeKe92,
+        AUTHOR             = {G. Bellin and J. Ketonen},
+        JOURNAL            = {Theoretical Computer Science},
+        PAGES              = {115--142},
+        TITLE              = {A decision procedure revisited : Notes on direct logic, linear logic and its implementation},
+        VOLUME             = {95},
+        YEAR               = {1992}
+}
+
+@BOOK{Bis67,
+        AUTHOR             = {E. Bishop},
+        PUBLISHER          = {McGraw-Hill},
+        TITLE              = {Foundations of Constructive Analysis},
+        YEAR               = {1967}
+}
+
+@BOOK{BoMo79,
+        AUTHOR             = {R.S. Boyer and J.S. Moore},
+        KEY                = {BoMo79},
+        PUBLISHER          = {Academic Press},
+        SERIES             = {ACM Monograph},
+        TITLE              = {A computational logic},
+        YEAR               = {1979}
+}
+
+@MASTERSTHESIS{Bou92,
+        AUTHOR             = {S. Boutin},
+        MONTH              = sep,
+        SCHOOL             = {{Universit\'e Paris 7}},
+        TITLE              = {Certification d'un compilateur {ML en Coq}},
+        YEAR               = {1992}
+}
+
+@ARTICLE{Bru72,
+        AUTHOR             = {N.J. de Bruijn},
+        JOURNAL            = {Indag. Math.},
+        TITLE              = {{Lambda-Calculus Notation with Nameless Dummies, a Tool for Automatic Formula Manipulation, with Application to the Church-Rosser Theorem}},
+        VOLUME             = {34},
+        YEAR               = {1972}
+}
+
+@INCOLLECTION{Bru80,
+        AUTHOR             = {N.J. de Bruijn},
+        BOOKTITLE          = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.},
+        EDITOR             = {J.P. Seldin and J.R. Hindley},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {A survey of the project {Automath}},
+        YEAR               = {1980}
+}
+
+@TECHREPORT{Leroy90,
+        AUTHOR             = {X. Leroy},
+        TITLE              = {The {ZINC} experiment: an economical implementation
+of the {ML} language},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {117},
+        YEAR               = {1990}
+}
+
+@BOOK{Caml,
+        AUTHOR             = {P. Weis and X. Leroy},
+        PUBLISHER          = {InterEditions},
+        TITLE              = {Le langage Caml},
+        YEAR               = {1993}
+}
+
+@TECHREPORT{CoC89,
+        AUTHOR             = {Projet Formel},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {110},
+        TITLE              = {{The Calculus of Constructions. Documentation and user's guide, Version 4.10}},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{CoHu85a,
+        AUTHOR             = {Th. Coquand and G. Huet},
+        ADDRESS            = {Linz},
+        BOOKTITLE          = {EUROCAL'85},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {{Constructions : A Higher Order Proof System for Mechanizing Mathematics}},
+        VOLUME             = {203},
+        YEAR               = {1985}
+}
+
+@Misc{Bar98,
+  author =    {B. Barras},
+  title =     {A formalisation of 
+               \uppercase{B}urali-\uppercase{F}orti's paradox in Coq},
+  howpublished = {Distributed within the bunch of contribution to the 
+                  Coq system},
+  year =      {1998},
+  month =     {March},
+  note =      {\texttt{http://pauillac.inria.fr/coq}}
+}
+
+
+@INPROCEEDINGS{CoHu85b,
+        AUTHOR             = {Th. Coquand and G. Huet},
+        BOOKTITLE          = {Logic Colloquium'85},
+        EDITOR             = {The Paris Logic Group},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {{Concepts Math\'ematiques et Informatiques formalis\'es dans le Calcul des Constructions}},
+        YEAR               = {1987}
+}
+
+@ARTICLE{CoHu86,
+        AUTHOR             = {Th. Coquand and G. Huet},
+        JOURNAL            = {Information and Computation},
+        NUMBER             = {2/3},
+        TITLE              = {The {Calculus of Constructions}},
+        VOLUME             = {76},
+        YEAR               = {1988}
+}
+
+@BOOK{Con86,
+        AUTHOR             = {R.L. {Constable et al.}},
+        PUBLISHER          = {Prentice-Hall},
+        TITLE              = {{Implementing Mathematics with the Nuprl Proof Development System}},
+        YEAR               = {1986}
+}
+
+@INPROCEEDINGS{CoPa89,
+        AUTHOR             = {Th. Coquand and C. Paulin-Mohring},
+        BOOKTITLE          = {Proceedings of Colog'88},
+        EDITOR             = {P. Martin-L{\"o}f and G. Mints},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {Inductively defined types},
+        VOLUME             = {417},
+        YEAR               = {1990}
+}
+
+@PHDTHESIS{Coq85,
+        AUTHOR             = {Th. Coquand},
+        MONTH              = jan,
+        SCHOOL             = {Universit\'e Paris~7},
+        TITLE              = {Une Th\'eorie des Constructions},
+        YEAR               = {1985}
+}
+
+@INPROCEEDINGS{Coq86,
+        AUTHOR             = {Th. Coquand},
+        ADDRESS            = {Cambridge, MA},
+        BOOKTITLE          = {Symposium on Logic in Computer Science},
+        PUBLISHER          = {IEEE Computer Society Press},
+        TITLE              = {{An Analysis of Girard's Paradox}},
+        YEAR               = {1986}
+}
+
+@INPROCEEDINGS{Coq90,
+        AUTHOR             = {Th. Coquand},
+        BOOKTITLE          = {Logic and Computer Science},
+        EDITOR             = {P. Oddifredi},
+        NOTE               = {INRIA Research Report 1088, also in~\cite{CoC89}},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {{Metamathematical Investigations of a Calculus of Constructions}},
+        YEAR               = {1990}
+}
+
+@INPROCEEDINGS{Coq92,
+        AUTHOR             = {Th. Coquand},
+        BOOKTITLE          = {in \cite{Bastad92}},
+        TITLE              = {{Pattern Matching with Dependent Types}},
+        YEAR               = {1992},
+        crossref = {Bastad92}
+}
+
+@TECHREPORT{COQ93,
+        AUTHOR             = {G. Dowek and A. Felty and H. Herbelin and G. Huet and C. Murthy and C. Parent and C. Paulin-Mohring and B. Werner},
+        INSTITUTION        = {INRIA},
+        MONTH              = may,
+        NUMBER             = {154},
+        TITLE              = {{The Coq Proof Assistant User's Guide Version 5.8}},
+        YEAR               = {1993}
+}
+
+@INPROCEEDINGS{Coquand93,
+        AUTHOR             = {Th. Coquand},
+        BOOKTITLE          = {in \cite{Nijmegen93}},
+        TITLE              = {{Infinite Objects in Type Theory}},
+        YEAR               = {1993},
+        crossref = {Nijmegen93}
+}
+
+@MASTERSTHESIS{Cou94a,
+        AUTHOR             = {J. Courant},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique, ENS Lyon},
+        TITLE              = {Explicitation de preuves par r\'ecurrence implicite},
+        YEAR               = {1994}
+}
+
+@TECHREPORT{CPar93,
+        AUTHOR             = {C. Parent},
+        INSTITUTION        = {Ecole {Normale} {Sup\'erieure} de {Lyon}},
+        MONTH              = oct,
+        NOTE               = {Also in~\cite{Nijmegen93}},
+        NUMBER             = {93-29},
+        TITLE              = {Developing certified programs in the system {Coq}- {The} {Program} tactic},
+        YEAR               = {1993}
+}
+
+@PHDTHESIS{CPar95,
+        AUTHOR             = {C. Parent},
+        SCHOOL             = {Ecole {Normale} {Sup\'erieure} de {Lyon}},
+        TITLE              = {{Synth\`ese de preuves de programmes dans le Calcul des Constructions Inductives}},
+        YEAR               = {1995}
+}
+
+@TECHREPORT{Dow90,
+        AUTHOR             = {G. Dowek},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {1283},
+        TITLE              = {{Naming and Scoping in a Mathematical Vernacular}},
+        TYPE               = {Research Report},
+        YEAR               = {1990}
+}
+
+@ARTICLE{Dow91a,
+        AUTHOR             = {G. Dowek},
+        JOURNAL            = {{Compte Rendu de l'Acad\'emie des Sciences}},
+        NOTE               = {(The undecidability of Third Order Pattern Matching in Calculi with Dependent Types or Type Constructors)},
+        NUMBER             = {12},
+        PAGES              = {951--956},
+        TITLE              = {{L'Ind\'ecidabilit\'e du Filtrage du Troisi\`eme Ordre dans les Calculs avec Types D\'ependants ou Constructeurs de Types}},
+        VOLUME             = {I, 312},
+        YEAR               = {1991}
+}
+
+@INPROCEEDINGS{Dow91b,
+        AUTHOR             = {G. Dowek},
+        BOOKTITLE          = {Proceedings of Mathematical Foundation of Computer Science},
+        NOTE               = {Also INRIA Research Report},
+        PAGES              = {151--160},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {{A Second Order Pattern Matching Algorithm in the Cube of Typed {$\lambda$}-calculi}},
+        VOLUME             = {520},
+        YEAR               = {1991}
+}
+
+@PHDTHESIS{Dow91c,
+        AUTHOR             = {G. Dowek},
+        MONTH              = dec,
+        SCHOOL             = {{Universit\'e Paris 7}},
+        TITLE              = {{D\'emonstration automatique dans le Calcul des Constructions}},
+        YEAR               = {1991}
+}
+
+@ARTICLE{dowek93,
+        AUTHOR             = {G. Dowek},
+        TITLE              = {{A Complete Proof Synthesis Method for the Cube of Type Systems}},
+        JOURNAL            = {Journal Logic Computation},
+        VOLUME             = {3},
+        NUMBER             = {3},
+        PAGES              = {287--315},
+        MONTH              = {June},
+        YEAR               = {1993}
+}
+
+@UNPUBLISHED{Dow92a,
+        AUTHOR             = {G. Dowek},
+        NOTE               = {To appear in Theoretical Computer Science},
+        TITLE              = {{The Undecidability of Pattern Matching in Calculi where Primitive Recursive Functions are Representable}},
+        YEAR               = {1992}
+}
+
+@ARTICLE{Dow94a,
+        AUTHOR             = {G. Dowek},
+        JOURNAL            = {Annals of Pure and Applied Logic},
+        VOLUME             = {69},
+        PAGES              = {135--155},
+        TITLE              = {Third order matching is decidable},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{Dow94b,
+        AUTHOR             = {G. Dowek},
+        BOOKTITLE          = {Proceedings of the second international conference on typed lambda calculus and applications},
+        TITLE              = {{Lambda-calculus, Combinators and the Comprehension Schema}},
+        YEAR               = {1995}
+}
+
+@INPROCEEDINGS{Dyb91,
+        AUTHOR             = {P. Dybjer},
+        BOOKTITLE          = {Logical Frameworks},
+        EDITOR             = {G. Huet and G. Plotkin},
+        PAGES              = {59--79},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {{Inductive sets and families in {Martin-L{\"o}f's Type Theory} and their set-theoretic semantics : An inversion principle for {Martin-L\"of's} type theory}},
+        VOLUME             = {14},
+        YEAR               = {1991}
+}
+
+@ARTICLE{Dyc92,
+        AUTHOR             = {Roy Dyckhoff},
+        JOURNAL            = {The Journal of Symbolic Logic},
+        MONTH              = sep,
+        NUMBER             = {3},
+        TITLE              = {Contraction-free sequent calculi for intuitionistic logic},
+        VOLUME             = {57},
+        YEAR               = {1992}
+}
+
+@MASTERSTHESIS{Fil94,
+        AUTHOR             = {J.-C. Filli\^atre},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique, ENS Lyon},
+        TITLE              = {Une proc\'edure de d\'ecision pour le {C}alcul des {P}r\'edicats {D}irect. {E}tude et impl\'ementation dans le syst\`eme {C}oq},
+        YEAR               = {1994}
+}
+
+@TECHREPORT{Filliatre95,
+        AUTHOR             = {J.-C. Filli\^atre},
+        INSTITUTION        = {LIP-ENS-Lyon},
+        TITLE              = {{A decision procedure for Direct Predicate Calculus}},
+        TYPE               = {Research report},
+        NUMBER             = {96--25},
+        YEAR               = {1995}
+}
+
+@UNPUBLISHED{Fle90,
+        AUTHOR             = {E. Fleury},
+        MONTH              = jul,
+        NOTE               = {Rapport de Stage},
+        TITLE              = {Implantation des algorithmes de {Floyd et de Dijkstra} dans le {Calcul des Constructions}},
+        YEAR               = {1990}
+}
+
+
+@TechReport{Gim98,
+  author = 	 {E. Gim\'nez},
+  title = 	 {A Tutorial on Recursive Types in Coq},
+  institution =  {INRIA},
+  year = 	 {1998}
+}
+
+@TECHREPORT{HKP97,
+  author = {G. Huet and G. Kahn and Ch. Paulin-Mohring},
+  title = {The {Coq} Proof Assistant - A tutorial, Version 6.1},
+  institution = {INRIA},
+  type = {rapport technique},
+  month = {Août},
+  year = {1997},
+  note = {Version révisée distribuée avec {Coq}},
+  number = {204},
+}
+
+<<<<<<< biblio.bib
+
+
+=======
+>>>>>>> 1.4
+@INPROCEEDINGS{Gir70,
+        AUTHOR             = {J.-Y. Girard},
+        BOOKTITLE          = {Proceedings of the 2nd Scandinavian Logic Symposium},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {Une extension de l'interpr\'etation de {G\"odel} \`a l'analyse, et son application \`a l'\'elimination des coupures dans l'analyse et la th\'eorie des types},
+        YEAR               = {1970}
+}
+
+@PHDTHESIS{Gir72,
+        AUTHOR             = {J.-Y. Girard},
+        SCHOOL             = {Universit\'e Paris~7},
+        TITLE              = {Interpr\'etation fonctionnelle et \'elimination des coupures de l'arithm\'etique d'ordre sup\'erieur},
+        YEAR               = {1972}
+}
+
+@BOOK{Gir89,
+        AUTHOR             = {J.-Y. Girard and Y. Lafont and P. Taylor},
+        PUBLISHER          = {Cambridge University Press},
+        SERIES             = {Cambridge Tracts in Theoretical Computer Science 7},
+        TITLE              = {Proofs and Types},
+        YEAR               = {1989}
+}
+
+@MASTERSTHESIS{Hir94,
+        AUTHOR             = {D. Hirschkoff},
+        MONTH              = sep,
+        SCHOOL             = {DEA IARFA, Ecole des Ponts et Chauss\'ees, Paris},
+        TITLE              = {{Ecriture d'une tactique arithm\'etique pour le syst\`eme Coq}},
+        YEAR               = {1994}
+}
+
+@INCOLLECTION{How80,
+        AUTHOR             = {W.A. Howard},
+        BOOKTITLE          = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.},
+        EDITOR             = {J.P. Seldin and J.R. Hindley},
+        NOTE               = {Unpublished 1969 Manuscript},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {The Formulae-as-Types Notion of Constructions},
+        YEAR               = {1980}
+}
+
+@INCOLLECTION{HuetLevy79,
+        AUTHOR             = {G. Huet and J.-J. L\'{e}vy},
+        TITLE              = {Call by Need Computations in Non-Ambigous
+Linear Term Rewriting Systems},
+        NOTE               = {Also research report 359, INRIA, 1979},
+        BOOKTITLE          = {Computational Logic, Essays in Honor of
+Alan Robinson},
+        EDITOR             = {J.-L. Lassez and G. Plotkin},
+        PUBLISHER          = {The MIT press},
+        YEAR               = {1991}
+}
+
+@INPROCEEDINGS{Hue87,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {Programming of Future Generation Computers},
+        EDITOR             = {K. Fuchi and M. Nivat},
+        NOTE               = {Also in Proceedings of TAPSOFT87, LNCS 249, Springer-Verlag, 1987, pp 276--286},
+        PUBLISHER          = {Elsevier Science},
+        TITLE              = {Induction Principles Formalized in the {Calculus of Constructions}},
+        YEAR               = {1988}
+}
+
+@INPROCEEDINGS{Hue88,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {A perspective in Theoretical Computer Science. Commemorative Volume for Gift Siromoney},
+        EDITOR             = {R. Narasimhan},
+        NOTE               = {Also in~\cite{CoC89}},
+        PUBLISHER          = {World Scientific Publishing},
+        TITLE              = {{The Constructive Engine}},
+        YEAR               = {1989}
+}
+
+@BOOK{Hue89,
+        EDITOR             = {G. Huet},
+        PUBLISHER          = {Addison-Wesley},
+        SERIES             = {The UT Year of Programming Series},
+        TITLE              = {Logical Foundations of Functional Programming},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{Hue92,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {Proceedings of 12th FST/TCS Conference, New Delhi},
+        PAGES              = {229--240},
+        PUBLISHER          = {Springer Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {{The Gallina Specification Language : A case study}},
+        VOLUME             = {652},
+        YEAR               = {1992}
+}
+
+@ARTICLE{Hue94,
+        AUTHOR             = {G. Huet},
+        JOURNAL            = {J. Functional Programming},
+        PAGES              = {371--394},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Residual theory in $\lambda$-calculus: a formal development},
+        VOLUME             = {4,3},
+        YEAR               = {1994}
+}
+
+@ARTICLE{KeWe84,
+        AUTHOR             = {J. Ketonen and R. Weyhrauch},
+        JOURNAL            = {Theoretical Computer Science},
+        PAGES              = {297--307},
+        TITLE              = {A decidable fragment of {P}redicate {C}alculus},
+        VOLUME             = {32},
+        YEAR               = {1984}
+}
+
+@BOOK{Kle52,
+        AUTHOR             = {S.C. Kleene},
+        PUBLISHER          = {North-Holland},
+        SERIES             = {Bibliotheca Mathematica},
+        TITLE              = {Introduction to Metamathematics},
+        YEAR               = {1952}
+}
+
+@BOOK{Kri90,
+        AUTHOR             = {J.-L. Krivine},
+        PUBLISHER          = {Masson},
+        SERIES             = {Etudes et recherche en informatique},
+        TITLE              = {Lambda-calcul {types et mod\`eles}},
+        YEAR               = {1990}
+}
+
+@ARTICLE{Laville91,
+        AUTHOR             = {A. Laville},
+        TITLE              = {Comparison of Priority Rules in Pattern
+Matching and Term Rewriting},
+        JOURNAL            = {Journal of Symbolic Computation},
+        VOLUME             = {11},
+        PAGES              = {321--347},
+        YEAR               = {1991}
+}
+
+@BOOK{LE92,
+        EDITOR             = {G. Huet and G. Plotkin},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Logical Environments},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{LePa94,
+        AUTHOR             = {F. Leclerc and C. Paulin-Mohring},
+        BOOKTITLE          = {{Types for Proofs and Programs, Types' 93}},
+        EDITOR             = {H. Barendregt and T. Nipkow},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {{Programming with Streams in Coq. A case study : The Sieve of Eratosthenes}},
+        VOLUME             = {806},
+        YEAR               = {1994}
+}
+
+@BOOK{LF91,
+        EDITOR             = {G. Huet and G. Plotkin},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Logical Frameworks},
+        YEAR               = {1991}
+}
+
+@BOOK{MaL84,
+        AUTHOR             = {{P. Martin-L\"of}},
+        PUBLISHER          = {Bibliopolis},
+        SERIES             = {Studies in Proof Theory},
+        TITLE              = {Intuitionistic Type Theory},
+        YEAR               = {1984}
+}
+
+@INPROCEEDINGS{manoury94,
+        AUTHOR             = {P. Manoury},
+        TITLE              = {{A User's Friendly Syntax to Define
+Recursive Functions as Typed $\lambda-$Terms}},
+        BOOKTITLE          = {{Types for Proofs and Programs, TYPES'94}},
+        SERIES             = {LNCS},
+        VOLUME             = {996},
+        MONTH              = jun,
+        YEAR               = {1994}
+}
+
+@ARTICLE{MaSi94,
+        AUTHOR             = {P. Manoury and M. Simonot},
+        JOURNAL            = {TCS},
+        TITLE              = {Automatizing termination proof of recursively defined function},
+        YEAR               = {To appear}
+}
+
+@TECHREPORT{maranget94,
+        AUTHOR             = {L. Maranget},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {2385},
+        TITLE              = {{Two Techniques for Compiling Lazy Pattern Matching}},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{Moh89a,
+        AUTHOR             = {C. Paulin-Mohring},
+        ADDRESS            = {Austin},
+        BOOKTITLE          = {Sixteenth Annual ACM Symposium on Principles of Programming Languages},
+        MONTH              = jan,
+        PUBLISHER          = {ACM},
+        TITLE              = {Extracting ${F}_{\omega}$'s programs from proofs in the {Calculus of Constructions}},
+        YEAR               = {1989}
+}
+
+@PHDTHESIS{Moh89b,
+        AUTHOR             = {C. Paulin-Mohring},
+        MONTH              = jan,
+        SCHOOL             = {{Universit\'e Paris 7}},
+        TITLE              = {Extraction de programmes dans le {Calcul des Constructions}},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{Moh93,
+        AUTHOR             = {C. Paulin-Mohring},
+        BOOKTITLE          = {Proceedings of the conference Typed Lambda Calculi and Applications},
+        EDITOR             = {M. Bezem and J.-F. Groote},
+        NOTE               = {Also LIP research report 92-49, ENS Lyon},
+        NUMBER             = {664},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {{Inductive Definitions in the System Coq - Rules and Properties}},
+        YEAR               = {1993}
+}
+
+@MASTERSTHESIS{Mun94,
+        AUTHOR             = {C. Mu\~noz},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique Fondamentale, Universit\'e Paris 7},
+        TITLE              = {D\'emonstration automatique dans la logique propositionnelle intuitionniste},
+        YEAR               = {1994}
+}
+
+@BOOK{Nijmegen93,
+        EDITOR             = {H. Barendregt and T. Nipkow},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {Types for Proofs and Programs},
+        VOLUME             = {806},
+        YEAR               = {1994}
+}
+
+@BOOK{NoPS90,
+        AUTHOR             = {B. {Nordstr\"om} and K. Peterson and J. Smith},
+        BOOKTITLE          = {Information Processing 83},
+        PUBLISHER          = {Oxford Science Publications},
+        SERIES             = {International Series of Monographs on Computer Science},
+        TITLE              = {Programming in {Martin-L\"of's} Type Theory},
+        YEAR               = {1990}
+}
+
+@ARTICLE{Nor88,
+        AUTHOR             = {B. {Nordstr\"om}},
+        JOURNAL            = {BIT},
+        TITLE              = {Terminating General Recursion},
+        VOLUME             = {28},
+        YEAR               = {1988}
+}
+
+@BOOK{Odi90,
+        EDITOR             = {P. Odifreddi},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {Logic and Computer Science},
+        YEAR               = {1990}
+}
+
+@INPROCEEDINGS{PaMS92,
+        AUTHOR             = {M. Parigot and P. Manoury and M. Simonot},
+        ADDRESS            = {St. Petersburg, Russia},
+        BOOKTITLE          = {Logic Programming and automated reasoning},
+        EDITOR             = {A. Voronkov},
+        MONTH              = jul,
+        NUMBER             = {624},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {{ProPre : A Programming language with proofs}},
+        YEAR               = {1992}
+}
+
+@ARTICLE{Par92,
+        AUTHOR             = {M. Parigot},
+        JOURNAL            = {Theoretical Computer Science},
+        NUMBER             = {2},
+        PAGES              = {335--356},
+        TITLE              = {{Recursive Programming with Proofs}},
+        VOLUME             = {94},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Parent95b,
+        AUTHOR             = {C. Parent},
+        BOOKTITLE          = {{Mathematics of Program Construction'95}},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {{Synthesizing proofs from programs in
+the Calculus of Inductive Constructions}},
+        VOLUME             = {947},
+        YEAR               = {1995}
+}
+
+@ARTICLE{PaWe92,
+        AUTHOR             = {C. Paulin-Mohring and B. Werner},
+        JOURNAL            = {Journal of Symbolic Computation},
+        PAGES              = {607--640},
+        TITLE              = {{Synthesis of ML programs in the system Coq}},
+        VOLUME             = {15},
+        YEAR               = {1993}
+}
+
+@INPROCEEDINGS{Prasad93,
+        AUTHOR             = {K.V. Prasad},
+        BOOKTITLE          = {{Proceedings of CONCUR'93}},
+        PUBLISHER          = {Springer-Verlag},
+        SERIES             = {LNCS},
+        TITLE              = {{Programming with broadcasts}},
+        VOLUME             = {715},
+        YEAR               = {1993}
+}
+
+@INPROCEEDINGS{puel-suarez90,
+        AUTHOR             = {L.Puel and A. Su\'arez},
+        BOOKTITLE          = {{Conference Lisp and Functional Programming}},
+        SERIES             = {ACM},
+        PUBLISHER          = {Springer-Verlag},
+        TITLE              = {{Compiling Pattern Matching by Term
+Decomposition}},
+        YEAR               = {1990}
+}
+
+@UNPUBLISHED{Rou92,
+        AUTHOR             = {J. Rouyer},
+        MONTH              = aug,
+        NOTE               = {To appear as a technical report},
+        TITLE              = {{D\'eveloppement de l'Algorithme d'Unification dans le Calcul des Constructions}},
+        YEAR               = {1992}
+}
+
+@TECHREPORT{Saibi94,
+        AUTHOR             = {A. Sa\"{\i}bi},
+        INSTITUTION        = {INRIA},
+        MONTH              = dec,
+        NUMBER             = {2345},
+        TITLE              = {{Axiomatization of a lambda-calculus with explicit-substitutions in the Coq System}},
+        YEAR               = {1994}
+}
+
+@MASTERSTHESIS{saidi94,
+        AUTHOR             = {H. Saidi},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique Fondamentale, Universit\'e Paris 7},
+        TITLE              = {R\'esolution d'\'equations dans le syst\`eme T
+ de G\"odel},
+        YEAR               = {1994}
+}
+
+@MASTERSTHESIS{Ter92,
+        AUTHOR             = {D. Terrasse},
+        MONTH              = sep,
+        SCHOOL             = {IARFA},
+        TITLE              = {{Traduction de TYPOL en COQ. Application \`a Mini ML}},
+        YEAR               = {1992}
+}
+
+@TECHREPORT{ThBeKa92,
+        AUTHOR             = {L. Th\'ery and Y. Bertot and G. Kahn},
+        INSTITUTION        = {INRIA Sophia},
+        MONTH              = may,
+        NUMBER             = {1684},
+        TITLE              = {Real theorem provers deserve real user-interfaces},
+        TYPE               = {Research Report},
+        YEAR               = {1992}
+}
+
+@BOOK{TrDa89,
+        AUTHOR             = {A.S. Troelstra and D. van Dalen},
+        PUBLISHER          = {North-Holland},
+        SERIES             = {Studies in Logic and the foundations of Mathematics, volumes 121 and 123},
+        TITLE              = {Constructivism in Mathematics, an introduction},
+        YEAR               = {1988}
+}
+
+@INCOLLECTION{wadler87,
+        AUTHOR             = {P. Wadler},
+        TITLE              = {Efficient  Compilation of Pattern Matching},
+        BOOKTITLE          = {The Implementation of Functional Programming
+Languages},
+        EDITOR             = {S.L. Peyton Jones},
+        PUBLISHER          = {Prentice-Hall},
+        YEAR               = {1987}
+}
+
+@PHDTHESIS{Wer94,
+        AUTHOR             = {B. Werner},
+        SCHOOL             = {Universit\'e Paris 7},
+        TITLE              = {Une th\'eorie des constructions inductives},
+        TYPE               = {Th\`ese de Doctorat},
+        YEAR               = {1994}
+}
+
+
diff --git a/doc/RecTutorial/morebib.bib b/doc/RecTutorial/morebib.bib
new file mode 100644
index 00000000..11dde2cd
--- /dev/null
+++ b/doc/RecTutorial/morebib.bib
@@ -0,0 +1,55 @@
+@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
+}
+
+@Article{Coquand:Huet,
+  author = 	 {Thierry Coquand and Gérard Huet},
+  title = 	 {The Calculus of Constructions},
+  journal = 	 {Information and Computation},
+  year = 	 {1988},
+  volume = 	 {76},
+}
+
+@INcollection{Coquand:metamathematical,
+ author = "Thierry Coquand",
+ title = "Metamathematical Investigations on a Calculus of Constructions",
+ booktitle="Logic and Computer Science",
+ year = {1990},
+ editor="P. Odifreddi",
+ publisher = "Academic Press",
+}
+
+@Misc{coqrefman,
+  title = {The {C}oq reference manual},
+  author={{C}oq {D}evelopment Team},
+  note= {LogiCal Project, \texttt{http://coq.inria.fr/}}
+ }
+
+@Misc{coqsite,
+  author= {{C}oq {D}evelopment Team},
+  title = 	 {The \emph{Coq} proof assistant},
+  note = {Documentation, system download. {C}ontact: \texttt{http://coq.inria.fr/}}
+}
+
+
+
+@Misc{Booksite,
+  author =	 {Yves Bertot and Pierre Cast\'eran},
+  title =	 {Coq'{A}rt: examples and exercises},
+  note =	 {\url{http://www.labri.fr/Perso/~casteran/CoqArt}}
+}
+
+
+@InProceedings{conor:motive,
+  author         ="Conor McBride",
+  title          = "Elimination with a motive",
+  booktitle =    "Types for Proofs and Programs'2000",
+  volume =         2277,
+  pages  =         "197-217",
+  year   =         "2002",
+}
diff --git a/doc/RecTutorial/recmacros.tex b/doc/RecTutorial/recmacros.tex
new file mode 100644
index 00000000..0334553f
--- /dev/null
+++ b/doc/RecTutorial/recmacros.tex
@@ -0,0 +1,75 @@
+%===================================
+% Style of the document
+%===================================
+%\newtheorem{example}{Example}[section]
+%\newtheorem{exercise}{Exercise}[section]
+
+
+\newcommand{\comentario}[1]{\texttt{#1}}
+
+%===================================
+% Keywords
+%===================================
+
+\newcommand{\Prop}{\texttt{Prop}}
+\newcommand{\Set}{\texttt{Set}}
+\newcommand{\Type}{\texttt{Type}}
+\newcommand{\true}{\texttt{true}}
+\newcommand{\false}{\texttt{false}}
+\newcommand{\Lth}{\texttt{Lth}}
+
+\newcommand{\Nat}{\texttt{nat}}
+\newcommand{\nat}{\texttt{nat}}
+\newcommand{\Z}  {\texttt{O}}
+\newcommand{\SUCC}{\texttt{S}}
+\newcommand{\pred}{\texttt{pred}}
+
+\newcommand{\False}{\texttt{False}}
+\newcommand{\True}{\texttt{True}}
+\newcommand{\I}{\texttt{I}}
+
+\newcommand{\natind}{\texttt{nat\_ind}}
+\newcommand{\natrec}{\texttt{nat\_rec}}
+\newcommand{\natrect}{\texttt{nat\_rect}}
+
+\newcommand{\eqT}{\texttt{eqT}}
+\newcommand{\identityT}{\texttt{identityT}}
+
+\newcommand{\map}{\texttt{map}}
+\newcommand{\iterates}{\texttt{iterates}}
+
+
+%===================================
+% Numbering
+%===================================
+
+
+\newtheorem{definition}{Definition}[section]
+\newtheorem{example}{Example}[section]
+
+
+%===================================
+% Judgements 
+%===================================
+
+
+\newcommand{\JM}[2]{\ensuremath{#1 : #2}}
+
+%===================================
+% Expressions 
+%===================================
+
+\newcommand{\Case}[3][]{\ensuremath{#1\textsf{Case}~#2~\textsf of}~#3~\textsf{end}}
+
+%=======================================
+
+\newcommand{\snreglados} [3] {\begin{tabular}{c} \ensuremath{#1} \\[2pt]
+   \ensuremath{#2}\\ \hline  \ensuremath{#3}  \end{tabular}}
+
+
+\newcommand{\snregla} [2] {\begin{tabular}{c}
+   \ensuremath{#1}\\ \hline  \ensuremath{#2}  \end{tabular}}
+
+
+%=======================================
+
diff --git a/doc/common/macros.tex b/doc/common/macros.tex
new file mode 100755
index 00000000..393b8547
--- /dev/null
+++ b/doc/common/macros.tex
@@ -0,0 +1,497 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% MACROS FOR THE REFERENCE MANUAL OF COQ %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% For commentaries (define \com as {} for the release manual)
+%\newcommand{\com}[1]{{\it(* #1 *)}}
+%\newcommand{\com}[1]{}
+
+%%OPTIONS for HACHA
+%\renewcommand{\cuttingunit}{section}
+
+
+%BEGIN LATEX
+\newenvironment{centerframe}%
+{\bgroup
+\dimen0=\textwidth
+\advance\dimen0 by -2\fboxrule
+\advance\dimen0 by -2\fboxsep
+\setbox0=\hbox\bgroup
+\begin{minipage}{\dimen0}%
+\begin{center}}%
+{\end{center}%
+\end{minipage}\egroup
+\centerline{\fbox{\box0}}\egroup
+}
+%END LATEX
+%HEVEA \newenvironment{centerframe}{\begin{center}}{\end{center}}
+
+%HEVEA \newcommand{\vec}[1]{\mathbf{#1}}
+%HEVEA \newcommand{\ominus}{-}
+%HEVEA \renewcommand{\oplus}{+}
+%HEVEA \renewcommand{\otimes}{\times}
+%HEVEA \newcommand{\land}{\wedge}
+%HEVEA \newcommand{\lor}{\vee}
+%HEVEA \newcommand{\k}[1]{#1}
+%HEVEA \newcommand{\phantom}[1]{\qquad}
+
+%%%%%%%%%%%%%%%%%%%%%%%
+% Formatting commands %
+%%%%%%%%%%%%%%%%%%%%%%%
+
+\newcommand{\ErrMsg}{\medskip \noindent {\bf Error message: }}
+\newcommand{\ErrMsgx}{\medskip \noindent {\bf Error messages: }}
+\newcommand{\variant}{\medskip \noindent {\bf Variant: }}
+\newcommand{\variants}{\medskip \noindent {\bf Variants: }}
+\newcommand{\SeeAlso}{\medskip \noindent {\bf See also: }}
+\newcommand{\Rem}{\medskip \noindent {\bf Remark: }}
+\newcommand{\Rems}{\medskip \noindent {\bf Remarks: }}
+\newcommand{\Example}{\medskip \noindent {\bf Example: }}
+\newcommand{\Warning}{\medskip \noindent {\bf Warning: }}
+\newcommand{\Warns}{\medskip \noindent {\bf Warnings: }}
+\newcounter{ex}
+\newcommand{\firstexample}{\setcounter{ex}{1}}
+\newcommand{\example}[1]{
+\medskip \noindent \textbf{Example \arabic{ex}: }\textit{#1}
+\addtocounter{ex}{1}}
+
+\newenvironment{Variant}{\variant\begin{enumerate}}{\end{enumerate}}
+\newenvironment{Variants}{\variants\begin{enumerate}}{\end{enumerate}}
+\newenvironment{ErrMsgs}{\ErrMsgx\begin{enumerate}}{\end{enumerate}}
+\newenvironment{Remarks}{\Rems\begin{enumerate}}{\end{enumerate}}
+\newenvironment{Warnings}{\Warns\begin{enumerate}}{\end{enumerate}}
+\newenvironment{Examples}{\medskip\noindent{\bf Examples:}
+\begin{enumerate}}{\end{enumerate}}
+
+%\newcommand{\bd}{\noindent\bf}
+%\newcommand{\sbd}{\vspace{8pt}\noindent\bf}
+%\newcommand{\sdoll}[1]{\begin{small}$ #1~ $\end{small}}
+%\newcommand{\sdollnb}[1]{\begin{small}$ #1 $\end{small}}
+\newcommand{\kw}[1]{\textsf{#1}}
+%\newcommand{\spec}[1]{\{\,#1\,\}}
+
+% Building regular expressions
+\newcommand{\zeroone}[1]{{\sl [}#1{\sl ]}}
+%\newcommand{\zeroonemany}[1]{$\{$#1$\}$*}
+%\newcommand{\onemany}[1]{$\{$#1$\}$+}
+\newcommand{\nelist}[2]{{#1} {\tt #2} {\ldots} {\tt #2} {#1}}
+\newcommand{\sequence}[2]{{\sl [}{#1} {\tt #2} {\ldots} {\tt #2} {#1}{\sl ]}}
+\newcommand{\nelistwithoutblank}[2]{#1{\tt #2}\ldots{\tt #2}#1}
+\newcommand{\sequencewithoutblank}[2]{$[$#1{\tt #2}\ldots{\tt #2}#1$]$}
+
+% Used for RefMan-gal
+%\newcommand{\ml}[1]{\hbox{\tt{#1}}}
+%\newcommand{\op}{\,|\,}
+
+%%%%%%%%%%%%%%%%%%%%%%%%
+% Trademarks and so on %
+%%%%%%%%%%%%%%%%%%%%%%%%
+
+\newcommand{\Coq}{\textsc{Coq}}
+\newcommand{\gallina}{\textsc{Gallina}}
+\newcommand{\Gallina}{\textsc{Gallina}}
+\newcommand{\CoqIDE}{\textsc{CoqIDE}}
+\newcommand{\ocaml}{\textsc{Objective Caml}}
+\newcommand{\camlpppp}{\textsc{Camlp4}}
+\newcommand{\emacs}{\textsc{GNU Emacs}}
+\newcommand{\CIC}{\pCIC}
+\newcommand{\pCIC}{p\textsc{Cic}}
+\newcommand{\iCIC}{\textsc{Cic}}
+\newcommand{\FW}{\ensuremath{F_{\omega}}}
+%\newcommand{\bn}{{\sf BNF}}
+
+%%%%%%%%%%%%%%%%%%%
+% Name of tactics %
+%%%%%%%%%%%%%%%%%%%
+
+%\newcommand{\Natural}{\mbox{\tt Natural}}
+
+%%%%%%%%%%%%%%%%%
+% \rm\sl series %
+%%%%%%%%%%%%%%%%%
+
+\newcommand{\nterm}[1]{\textrm{\textsl{#1}}}
+
+\newcommand{\qstring}{\nterm{string}}
+
+%% New syntax specific entries
+\newcommand{\annotation}{\nterm{annotation}}
+\newcommand{\assums}{\nterm{assums}} % vernac
+\newcommand{\simpleassums}{\nterm{simple\_assums}} % assumptions
+\newcommand{\binder}{\nterm{binder}}
+\newcommand{\binderlet}{\nterm{binderlet}}
+\newcommand{\binderlist}{\nterm{binderlist}}
+\newcommand{\caseitems}{\nterm{match\_items}}
+\newcommand{\caseitem}{\nterm{match\_item}}
+\newcommand{\eqn}{\nterm{equation}}
+\newcommand{\ifitem}{\nterm{dep\_ret\_type}}
+\newcommand{\letclauses}{\nterm{letclauses}}
+\newcommand{\params}{\nterm{params}} % vernac
+\newcommand{\returntype}{\nterm{return\_type}}
+\newcommand{\idparams}{\nterm{ident\_with\_params}}
+\newcommand{\statkwd}{\nterm{statement\_keyword}} % vernac
+\newcommand{\termarg}{\nterm{arg}}
+
+\newcommand{\typecstr}{\zeroone{{\tt :} {\term}}}
+
+
+\newcommand{\Fwterm}{\textrm{\textsl{Fwterm}}}
+\newcommand{\Index}{\textrm{\textsl{index}}}
+\newcommand{\abbrev}{\textrm{\textsl{abbreviation}}}
+\newcommand{\atomictac}{\textrm{\textsl{atomic\_tactic}}}
+\newcommand{\bindinglist}{\textrm{\textsl{bindings\_list}}}
+\newcommand{\cast}{\textrm{\textsl{cast}}}
+\newcommand{\cofixpointbodies}{\textrm{\textsl{cofix\_bodies}}}
+\newcommand{\cofixpointbody}{\textrm{\textsl{cofix\_body}}}
+\newcommand{\commandtac}{\textrm{\textsl{tactic\_invocation}}}
+\newcommand{\constructor}{\textrm{\textsl{constructor}}}
+\newcommand{\convtactic}{\textrm{\textsl{conv\_tactic}}}
+\newcommand{\declarationkeyword}{\textrm{\textsl{declaration\_keyword}}}
+\newcommand{\declaration}{\textrm{\textsl{declaration}}}
+\newcommand{\definition}{\textrm{\textsl{definition}}}
+\newcommand{\digit}{\textrm{\textsl{digit}}}
+\newcommand{\exteqn}{\textrm{\textsl{ext\_eqn}}}
+\newcommand{\field}{\textrm{\textsl{field}}}
+\newcommand{\firstletter}{\textrm{\textsl{first\_letter}}}
+\newcommand{\fixpg}{\textrm{\textsl{fix\_pgm}}}
+\newcommand{\fixpointbodies}{\textrm{\textsl{fix\_bodies}}}
+\newcommand{\fixpointbody}{\textrm{\textsl{fix\_body}}}
+\newcommand{\fixpoint}{\textrm{\textsl{fixpoint}}}
+\newcommand{\flag}{\textrm{\textsl{flag}}}
+\newcommand{\form}{\textrm{\textsl{form}}}
+\newcommand{\entry}{\textrm{\textsl{entry}}} 
+\newcommand{\proditem}{\textrm{\textsl{production\_item}}} 
+\newcommand{\tacargtype}{\textrm{\textsl{tactic\_argument\_type}}} 
+\newcommand{\scope}{\textrm{\textsl{scope}}} 
+\newcommand{\optscope}{\textrm{\textsl{opt\_scope}}} 
+\newcommand{\declnotation}{\textrm{\textsl{decl\_notation}}} 
+\newcommand{\symbolentry}{\textrm{\textsl{symbol}}}
+\newcommand{\modifiers}{\textrm{\textsl{modifiers}}}
+\newcommand{\localdef}{\textrm{\textsl{local\_def}}}
+\newcommand{\localdecls}{\textrm{\textsl{local\_decls}}}
+\newcommand{\ident}{\textrm{\textsl{ident}}}
+\newcommand{\accessident}{\textrm{\textsl{access\_ident}}}
+\newcommand{\inductivebody}{\textrm{\textsl{ind\_body}}}
+\newcommand{\inductive}{\textrm{\textsl{inductive}}}
+\newcommand{\naturalnumber}{\textrm{\textsl{natural}}}
+\newcommand{\integer}{\textrm{\textsl{integer}}}
+\newcommand{\multpattern}{\textrm{\textsl{mult\_pattern}}}
+\newcommand{\mutualcoinductive}{\textrm{\textsl{mutual\_coinductive}}}
+\newcommand{\mutualinductive}{\textrm{\textsl{mutual\_inductive}}}
+\newcommand{\nestedpattern}{\textrm{\textsl{nested\_pattern}}}
+\newcommand{\name}{\textrm{\textsl{name}}}
+\newcommand{\num}{\textrm{\textsl{num}}}
+\newcommand{\pattern}{\textrm{\textsl{pattern}}}
+\newcommand{\intropattern}{\textrm{\textsl{intro\_pattern}}}
+\newcommand{\pat}{\textrm{\textsl{pat}}}
+\newcommand{\pgs}{\textrm{\textsl{pgms}}}
+\newcommand{\pg}{\textrm{\textsl{pgm}}}
+%BEGIN LATEX
+\newcommand{\proof}{\textrm{\textsl{proof}}}
+%END LATEX
+%HEVEA \renewcommand{\proof}{\textrm{\textsl{proof}}}
+\newcommand{\record}{\textrm{\textsl{record}}}
+\newcommand{\rewrule}{\textrm{\textsl{rewriting\_rule}}}
+\newcommand{\sentence}{\textrm{\textsl{sentence}}}
+\newcommand{\simplepattern}{\textrm{\textsl{simple\_pattern}}}
+\newcommand{\sort}{\textrm{\textsl{sort}}}
+\newcommand{\specif}{\textrm{\textsl{specif}}}
+\newcommand{\statement}{\textrm{\textsl{statement}}}
+\newcommand{\str}{\textrm{\textsl{string}}}
+\newcommand{\subsequentletter}{\textrm{\textsl{subsequent\_letter}}}
+\newcommand{\switch}{\textrm{\textsl{switch}}}
+\newcommand{\tac}{\textrm{\textsl{tactic}}}
+\newcommand{\terms}{\textrm{\textsl{terms}}}
+\newcommand{\term}{\textrm{\textsl{term}}}
+\newcommand{\module}{\textrm{\textsl{module}}}
+\newcommand{\modexpr}{\textrm{\textsl{module\_expression}}}
+\newcommand{\modtype}{\textrm{\textsl{module\_type}}}
+\newcommand{\onemodbinding}{\textrm{\textsl{module\_binding}}}
+\newcommand{\modbindings}{\textrm{\textsl{module\_bindings}}}
+\newcommand{\qualid}{\textrm{\textsl{qualid}}}
+\newcommand{\class}{\textrm{\textsl{class}}}
+\newcommand{\dirpath}{\textrm{\textsl{dirpath}}}
+\newcommand{\typedidents}{\textrm{\textsl{typed\_idents}}}
+\newcommand{\type}{\textrm{\textsl{type}}}
+\newcommand{\vref}{\textrm{\textsl{ref}}}
+\newcommand{\zarithformula}{\textrm{\textsl{zarith\_formula}}}
+\newcommand{\zarith}{\textrm{\textsl{zarith}}}
+\newcommand{\ltac}{\mbox{${\cal L}_{tac}$}}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% \mbox{\sf } series for roman text in maths formulas %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\newcommand{\alors}{\mbox{\textsf{then}}}
+\newcommand{\alter}{\mbox{\textsf{alter}}}
+\newcommand{\bool}{\mbox{\textsf{bool}}}
+\newcommand{\conc}{\mbox{\textsf{conc}}}
+\newcommand{\cons}{\mbox{\textsf{cons}}}
+\newcommand{\consf}{\mbox{\textsf{consf}}}
+\newcommand{\emptyf}{\mbox{\textsf{emptyf}}}
+\newcommand{\EqSt}{\mbox{\textsf{EqSt}}}
+\newcommand{\false}{\mbox{\textsf{false}}}
+\newcommand{\filter}{\mbox{\textsf{filter}}}
+\newcommand{\forest}{\mbox{\textsf{forest}}}
+\newcommand{\from}{\mbox{\textsf{from}}}
+\newcommand{\hd}{\mbox{\textsf{hd}}}
+\newcommand{\Length}{\mbox{\textsf{Length}}}
+\newcommand{\length}{\mbox{\textsf{length}}}
+\newcommand{\LengthA}{\mbox {\textsf{Length\_A}}}
+\newcommand{\List}{\mbox{\textsf{List}}}
+\newcommand{\ListA}{\mbox{\textsf{List\_A}}}
+\newcommand{\LNil}{\mbox{\textsf{Lnil}}}
+\newcommand{\LCons}{\mbox{\textsf{Lcons}}}
+\newcommand{\nat}{\mbox{\textsf{nat}}}
+\newcommand{\nO}{\mbox{\textsf{O}}}
+\newcommand{\nS}{\mbox{\textsf{S}}}
+\newcommand{\node}{\mbox{\textsf{node}}}
+\newcommand{\Nil}{\mbox{\textsf{nil}}}
+\newcommand{\Prop}{\mbox{\textsf{Prop}}}
+\newcommand{\Set}{\mbox{\textsf{Set}}}
+\newcommand{\si}{\mbox{\textsf{if}}}
+\newcommand{\sinon}{\mbox{\textsf{else}}}
+\newcommand{\Str}{\mbox{\textsf{Stream}}}
+\newcommand{\tl}{\mbox{\textsf{tl}}}
+\newcommand{\tree}{\mbox{\textsf{tree}}}
+\newcommand{\true}{\mbox{\textsf{true}}}
+\newcommand{\Type}{\mbox{\textsf{Type}}}
+\newcommand{\unfold}{\mbox{\textsf{unfold}}}
+\newcommand{\zeros}{\mbox{\textsf{zeros}}}
+
+%%%%%%%%%
+% Misc. %
+%%%%%%%%%
+\newcommand{\T}{\texttt{T}}
+\newcommand{\U}{\texttt{U}}
+\newcommand{\real}{\textsf{Real}}
+\newcommand{\Spec}{\textit{Spec}}
+\newcommand{\Data}{\textit{Data}}
+\newcommand{\In} {{\textbf{in }}}
+\newcommand{\AND} {{\textbf{and}}}
+\newcommand{\If}{{\textbf{if }}}
+\newcommand{\Else}{{\textbf{else }}}
+\newcommand{\Then} {{\textbf{then }}}
+\newcommand{\Let}{{\textbf{let }}}
+\newcommand{\Where}{{\textbf{where rec }}}
+\newcommand{\Function}{{\textbf{function }}}
+\newcommand{\Rec}{{\textbf{rec }}}
+%\newcommand{\cn}{\centering}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Math commands and symbols %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\newcommand{\la}{\leftarrow}
+\newcommand{\ra}{\rightarrow}
+\newcommand{\Ra}{\Rightarrow}
+\newcommand{\rt}{\Rightarrow}
+\newcommand{\lla}{\longleftarrow}
+\newcommand{\lra}{\longrightarrow}
+\newcommand{\Llra}{\Longleftrightarrow}
+\newcommand{\mt}{\mapsto}
+\newcommand{\ov}{\overrightarrow}
+\newcommand{\wh}{\widehat}
+\newcommand{\up}{\uparrow}
+\newcommand{\dw}{\downarrow}
+\newcommand{\nr}{\nearrow}
+\newcommand{\se}{\searrow}
+\newcommand{\sw}{\swarrow}
+\newcommand{\nw}{\nwarrow}
+\newcommand{\mto}{,}
+
+\newcommand{\vm}[1]{\vspace{#1em}}
+\newcommand{\vx}[1]{\vspace{#1ex}}
+\newcommand{\hm}[1]{\hspace{#1em}}
+\newcommand{\hx}[1]{\hspace{#1ex}}
+\newcommand{\sm}{\mbox{ }}
+\newcommand{\mx}{\mbox}
+
+%\newcommand{\nq}{\neq}
+%\newcommand{\eq}{\equiv}
+\newcommand{\fa}{\forall}
+%\newcommand{\ex}{\exists}
+\newcommand{\impl}{\rightarrow}
+%\newcommand{\Or}{\vee}
+%\newcommand{\And}{\wedge}
+\newcommand{\ms}{\models}
+\newcommand{\bw}{\bigwedge}
+\newcommand{\ts}{\times}
+\newcommand{\cc}{\circ}
+%\newcommand{\es}{\emptyset}
+%\newcommand{\bs}{\backslash}
+\newcommand{\vd}{\vdash}
+%\newcommand{\lan}{{\langle }}
+%\newcommand{\ran}{{\rangle }}
+
+%\newcommand{\al}{\alpha}
+\newcommand{\bt}{\beta}
+%\newcommand{\io}{\iota}
+\newcommand{\lb}{\lambda}
+%\newcommand{\sg}{\sigma}
+%\newcommand{\sa}{\Sigma}
+%\newcommand{\om}{\Omega}
+%\newcommand{\tu}{\tau}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%
+% Custom maths commands %
+%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\newcommand{\sumbool}[2]{\{#1\}+\{#2\}}
+\newcommand{\myifthenelse}[3]{\kw{if} ~ #1 ~\kw{then} ~ #2 ~ \kw{else} ~ #3}
+\newcommand{\fun}[2]{\item[]{\tt {#1}}. \quad\\ #2}
+\newcommand{\WF}[2]{\ensuremath{{\cal W\!F}(#1)[#2]}}
+\newcommand{\WFE}[1]{\WF{E}{#1}}
+\newcommand{\WT}[4]{\ensuremath{#1[#2] \vdash #3 : #4}}
+\newcommand{\WTE}[3]{\WT{E}{#1}{#2}{#3}}
+\newcommand{\WTEG}[2]{\WTE{\Gamma}{#1}{#2}}
+
+\newcommand{\WTM}[3]{\WT{#1}{}{#2}{#3}}
+\newcommand{\WFT}[2]{\ensuremath{#1[] \vdash {\cal W\!F}(#2)}}
+\newcommand{\WS}[3]{\ensuremath{#1[] \vdash #2 <: #3}}
+\newcommand{\WSE}[2]{\WS{E}{#1}{#2}}
+
+\newcommand{\WTRED}[5]{\mbox{$#1[#2] \vdash #3 #4 #5$}}
+\newcommand{\WTERED}[4]{\mbox{$E[#1] \vdash #2 #3 #4$}}
+\newcommand{\WTELECONV}[3]{\WTERED{#1}{#2}{\leconvert}{#3}}
+\newcommand{\WTEGRED}[3]{\WTERED{\Gamma}{#1}{#2}{#3}}
+\newcommand{\WTECONV}[3]{\WTERED{#1}{#2}{\convert}{#3}}
+\newcommand{\WTEGCONV}[2]{\WTERED{\Gamma}{#1}{\convert}{#2}}
+\newcommand{\WTEGLECONV}[2]{\WTERED{\Gamma}{#1}{\leconvert}{#2}}
+
+\newcommand{\lab}[1]{\mathit{labels}(#1)}
+\newcommand{\dom}[1]{\mathit{dom}(#1)}
+
+\newcommand{\CI}[2]{\mbox{$\{#1\}^{#2}$}}
+\newcommand{\CIP}[3]{\mbox{$\{#1\}_{#2}^{#3}$}}
+\newcommand{\CIPV}[1]{\CIP{#1}{I_1.. I_k}{P_1.. P_k}}
+\newcommand{\CIPI}[1]{\CIP{#1}{I}{P}}
+\newcommand{\CIF}[1]{\mbox{$\{#1\}_{f_1.. f_n}$}}
+%BEGIN LATEX
+\newcommand{\NInd}[3]{\mbox{{\sf Ind}$(#1)(\begin{array}[t]{@{}l}#2:=#3
+                                              \,)\end{array}$}}
+\newcommand{\Ind}[4]{\mbox{{\sf Ind}$(#1)[#2](\begin{array}[t]{@{}l@{}}#3:=#4
+                                                 \,)\end{array}$}}
+%END LATEX
+%HEVEA \newcommand{\NInd}[3]{\mbox{{\sf Ind}$(#1)(#2:=#3\,)$}}
+%HEVEA \newcommand{\Ind}[4]{\mbox{{\sf Ind}$(#1)[#2](#3:=#4\,)$}}
+
+\newcommand{\Indp}[5]{\mbox{{\sf Ind}$_{#5}(#1)[#2](\begin{array}[t]{@{}l}#3:=#4
+                                                 \,)\end{array}$}}
+\newcommand{\Def}[4]{\mbox{{\sf Def}$(#1)(#2:=#3:#4)$}}
+\newcommand{\Assum}[3]{\mbox{{\sf Assum}$(#1)(#2:#3)$}}
+\newcommand{\Match}[3]{\mbox{$<\!#1\!>\!{\mbox{\tt Match}}~#2~{\mbox{\tt with}}~#3~{\mbox{\tt end}}$}}
+\newcommand{\Case}[3]{\mbox{$\kw{case}(#2,#1,#3)$}}
+\newcommand{\match}[3]{\mbox{$\kw{match}~ #2 ~\kw{with}~ #3 ~\kw{end}$}}
+\newcommand{\Fix}[2]{\mbox{\tt Fix}~#1\{#2\}}
+\newcommand{\CoFix}[2]{\mbox{\tt CoFix}~#1\{#2\}}
+\newcommand{\With}[2]{\mbox{\tt ~with~}}
+\newcommand{\subst}[3]{#1\{#2/#3\}}
+\newcommand{\substs}[4]{#1\{(#2/#3)_{#4}\}}
+\newcommand{\Sort}{\mbox{$\cal S$}}
+\newcommand{\convert}{=_{\beta\delta\iota\zeta}}
+\newcommand{\leconvert}{\leq_{\beta\delta\iota\zeta}}
+\newcommand{\NN}{\mathbb{N}}
+\newcommand{\inference}[1]{$${#1}$$}
+
+\newcommand{\compat}[2]{\mbox{$[#1|#2]$}}
+\newcommand{\tristackrel}[3]{\mathrel{\mathop{#2}\limits_{#3}^{#1}}}
+
+\newcommand{\Impl}{{\it Impl}}
+\newcommand{\Mod}[3]{{\sf Mod}({#1}:{#2}:={#3})}
+\newcommand{\ModType}[2]{{\sf ModType}({#1}:={#2})}
+\newcommand{\ModS}[2]{{\sf ModS}({#1}:{#2})}
+\newcommand{\ModSEq}[3]{{\sf ModSEq}({#1}:{#2}=={#3})}
+\newcommand{\functor}[3]{\ensuremath{{\sf Functor}(#1:#2)\;#3}}
+\newcommand{\funsig}[3]{\ensuremath{{\sf Funsig}(#1:#2)\;#3}}
+\newcommand{\sig}[1]{\ensuremath{{\sf Sig}~#1~{\sf End}}}
+\newcommand{\struct}[1]{\ensuremath{{\sf Struct}~#1~{\sf End}}}
+
+
+%\newbox\tempa
+%\newbox\tempb
+%\newdimen\tempc
+%\newcommand{\mud}[1]{\hfil $\displaystyle{\mathstrut #1}$\hfil}
+%\newcommand{\rig}[1]{\hfil $\displaystyle{#1}$}
+% \newcommand{\irulehelp}[3]{\setbox\tempa=\hbox{$\displaystyle{\mathstrut #2}$}%
+%                         \setbox\tempb=\vbox{\halign{##\cr
+%         \mud{#1}\cr
+%         \noalign{\vskip\the\lineskip}
+%         \noalign{\hrule height 0pt}
+%         \rig{\vbox to 0pt{\vss\hbox to 0pt{${\; #3}$\hss}\vss}}\cr
+%         \noalign{\hrule}
+%         \noalign{\vskip\the\lineskip}
+%         \mud{\copy\tempa}\cr}}
+%                       \tempc=\wd\tempb
+%                       \advance\tempc by \wd\tempa
+%                       \divide\tempc by 2 }
+% \newcommand{\irule}[3]{{\irulehelp{#1}{#2}{#3}
+%                      \hbox to \wd\tempa{\hss \box\tempb \hss}}}
+
+\newcommand{\sverb}[1]{{\tt #1}}
+\newcommand{\mover}[2]{{#1\over #2}}
+\newcommand{\jd}[2]{#1 \vdash #2}
+\newcommand{\mathline}[1]{\[#1\]}
+\newcommand{\zrule}[2]{#2: #1}
+\newcommand{\orule}[3]{#3: {\mover{#1}{#2}}}
+\newcommand{\trule}[4]{#4: \mover{#1  \qquad #2} {#3}}
+\newcommand{\thrule}[5]{#5: {\mover{#1  \qquad #2 \qquad #3}{#4}}}
+
+
+
+% placement of figures
+
+%BEGIN LATEX
+\renewcommand{\topfraction}{.99}
+\renewcommand{\bottomfraction}{.99}
+\renewcommand{\textfraction}{.01}
+\renewcommand{\floatpagefraction}{.9}
+%END LATEX
+
+% Macros Bruno pour description de la syntaxe
+
+\def\bfbar{\ensuremath{|\hskip -0.22em{}|\hskip -0.24em{}|}}
+\def\TERMbar{\bfbar}
+\def\TERMbarbar{\bfbar\bfbar}
+
+
+%% Macros pour les grammaires
+\def\GR#1{\text{\large(}#1\text{\large)}}
+\def\NT#1{\langle\textit{#1}\rangle}
+\def\NTL#1#2{\langle\textit{#1}\rangle_{#2}}
+\def\TERM#1{{\bf\textrm{\bf #1}}}
+%\def\TERM#1{{\bf\textsf{#1}}}
+\def\KWD#1{\TERM{#1}}
+\def\ETERM#1{\TERM{#1}}
+\def\CHAR#1{\TERM{#1}}
+
+\def\STAR#1{#1*}
+\def\STARGR#1{\GR{#1}*}
+\def\PLUS#1{#1+}
+\def\PLUSGR#1{\GR{#1}+}
+\def\OPT#1{#1?}
+\def\OPTGR#1{\GR{#1}?}
+%% Tableaux de definition de non-terminaux
+\newenvironment{cadre}
+        {\begin{array}{|c|}\hline\\}
+        {\\\\\hline\end{array}}
+\newenvironment{rulebox}
+        {$$\begin{cadre}\begin{array}{r@{~}c@{~}l@{}l@{}r}}
+        {\end{array}\end{cadre}$$}
+\def\DEFNT#1{\NT{#1} & ::= &}
+\def\EXTNT#1{\NT{#1} & ::= & ... \\&|&}
+\def\RNAME#1{(\textsc{#1})}
+\def\SEPDEF{\\\\}
+\def\nlsep{\\&|&}
+\def\nlcont{\\&&}
+\newenvironment{rules}
+        {\begin{center}\begin{rulebox}}
+        {\end{rulebox}\end{center}}
+
+% $Id: macros.tex 8606 2006-02-23 13:58:10Z herbelin $ 
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/common/title.tex b/doc/common/title.tex
new file mode 100755
index 00000000..2ed49ede
--- /dev/null
+++ b/doc/common/title.tex
@@ -0,0 +1,86 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% File title.tex
+% Page formatting commands 
+% Macro \coverpage
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%\setlength{\marginparwidth}{0pt}
+%\setlength{\oddsidemargin}{0pt}
+%\setlength{\evensidemargin}{0pt} 
+%\setlength{\marginparsep}{0pt}
+%\setlength{\topmargin}{0pt} 
+%\setlength{\textwidth}{16.9cm} 
+%\setlength{\textheight}{22cm}
+\usepackage{fullpage}
+
+\newcommand{\printingdate}{\today}
+\newcommand{\isdraft}{\Large\bf\today\\[20pt]}
+%\newcommand{\isdraft}{\vspace{20pt}}
+
+%To show the top for the toc in html
+\newcommand{\tophtml}{}
+
+\newcommand{\coverpage}[3]{
+\thispagestyle{empty}
+\begin{center}
+\begin{Huge}
+\begin{bf}
+The Coq Proof Assistant\\
+\vspace{12pt}
+    #1\\
+\end{bf}
+\end{Huge}
+\vspace{20pt}
+\isdraft
+{\Large \bf Version \coqversion}
+\footnote[1]{This research was partly supported by IST working group ``Types''}
+\\
+\vspace{120pt}
+{\bf #2}\\
+\vfill
+{\Large \bf LogiCal Project}\\
+\vspace{15pt}
+\end{center}
+%BEGIN LATEX
+\newpage
+\vspace*{500pt}
+\thispagestyle{empty}
+%END LATEX
+\begin{flushleft}
+%BEGIN LATEX
+{\large{V\coqversion,
+\printingdate}}\\[20pt]
+%END LATEX
+{\large{\copyright INRIA 1999-2004 ({\Coq} versions 7.x)}}\\
+{\large{\copyright INRIA 2004-2006 ({\Coq} versions 8.x)}}\\
+{\large{#3}}
+\end{flushleft}
+%BEGIN LATEX
+\newpage
+%END LATEX
+}
+
+
+\newcommand{\shorttitle}[1]{
+\begin{center}
+\begin{huge}
+\begin{bf}
+The Coq Proof Assistant\\
+\vspace{10pt}
+    #1\\
+\end{bf}
+\end{huge}
+\end{center}
+\vspace{5pt}
+}
+
+% Local Variables: 
+% mode: LaTeX
+% TeX-master: ""
+% End: 
+
+% $Id: title.tex 8607 2006-02-23 14:21:14Z herbelin $ 
+
+
+
+
diff --git a/doc/faq/FAQ.tex b/doc/faq/FAQ.tex
new file mode 100644
index 00000000..2b5d898f
--- /dev/null
+++ b/doc/faq/FAQ.tex
@@ -0,0 +1,2481 @@
+\RequirePackage{ifpdf}
+\ifpdf   % si on est en pdflatex
+\documentclass[a4paper,pdftex]{article}
+\else
+\documentclass[a4paper]{article}
+\fi
+\pagestyle{plain}
+
+% yay les symboles
+\usepackage{stmaryrd}
+\usepackage{amssymb}
+\usepackage{url}
+%\usepackage{multicol}
+\usepackage{hevea}
+\usepackage{fullpage}
+\usepackage[latin1]{inputenc}
+\usepackage[english]{babel}
+
+\ifpdf   % si on est en pdflatex
+  \usepackage[pdftex]{graphicx}
+\else
+  \usepackage[dvips]{graphicx}
+\fi
+
+%\input{../macros.tex}
+
+% Making hevea happy
+%HEVEA \renewcommand{\textbar}{|}
+%HEVEA \renewcommand{\textunderscore}{\_}
+
+\def\Question#1{\stepcounter{question}\subsubsection{#1}}
+
+% version et date
+\def\faqversion{0.1}
+
+% les macros d'amour
+\def\Coq{\textsc{Coq}}
+\def\Why{\textsc{Why}}
+\def\Caduceus{\textsc{Caduceus}}
+\def\Krakatoa{\textsc{Krakatoa}}
+\def\Ltac{\textsc{Ltac}}
+\def\CoqIde{\textsc{CoqIde}}
+
+\newcommand{\coqtt}[1]{{\tt #1}}
+\newcommand{\coqimp}{{\mbox{\tt ->}}}
+\newcommand{\coqequiv}{{\mbox{\tt <->}}}
+
+
+% macro pour les tactics
+\def\split{{\tt split}}
+\def\assumption{{\tt assumption}}
+\def\auto{{\tt auto}}
+\def\trivial{{\tt trivial}}
+\def\tauto{{\tt tauto}}
+\def\left{{\tt left}}
+\def\right{{\tt right}}
+\def\decompose{{\tt decompose}}
+\def\intro{{\tt intro}}
+\def\intros{{\tt intros}}
+\def\field{{\tt field}}
+\def\ring{{\tt ring}}
+\def\apply{{\tt apply}}
+\def\exact{{\tt exact}}
+\def\cut{{\tt cut}}
+\def\assert{{\tt assert}}
+\def\solve{{\tt solve}}
+\def\idtac{{\tt idtac}}
+\def\fail{{\tt fail}}
+\def\existstac{{\tt exists}}
+\def\firstorder{{\tt firstorder}}
+\def\congruence{{\tt congruence}}
+\def\gb{{\tt gb}}
+\def\generalize{{\tt generalize}}
+\def\abstracttac{{\tt abstract}}
+\def\eapply{{\tt eapply}}
+\def\unfold{{\tt unfold}}
+\def\rewrite{{\tt rewrite}}
+\def\replace{{\tt replace}}
+\def\simpl{{\tt simpl}}
+\def\elim{{\tt elim}}
+\def\set{{\tt set}}
+\def\pose{{\tt pose}}
+\def\case{{\tt case}}
+\def\destruct{{\tt destruct}}
+\def\reflexivity{{\tt reflexivity}}
+\def\transitivity{{\tt transitivity}}
+\def\symmetry{{\tt symmetry}}
+\def\Focus{{\tt Focus}}
+\def\discriminate{{\tt discriminate}}
+\def\contradiction{{\tt contradiction}}
+\def\intuition{{\tt intuition}}
+\def\try{{\tt try}}
+\def\repeat{{\tt repeat}}
+\def\eauto{{\tt eauto}}
+\def\subst{{\tt subst}}
+\def\symmetryin{{\tt symmetryin}}
+\def\instantiate{{\tt instantiate}}
+\def\inversion{{\tt inversion}}
+\def\Defined{{\tt Defined}}
+\def\Qed{{\tt Qed}}
+\def\pattern{{\tt pattern}}
+\def\Type{{\tt Type}}
+\def\Prop{{\tt Prop}}
+\def\Set{{\tt Set}}
+
+
+\newcommand\vfile[2]{\ahref{#1}{\tt {#2}.v}}
+\urldef{\InitWf}{\url}
+  {http://coq.inria.fr/library/Coq.Init.Wf.html}
+\urldef{\LogicBerardi}{\url}
+  {http://coq.inria.fr/library/Coq.Logic.Berardi.html}
+\urldef{\LogicClassical}{\url}
+  {http://coq.inria.fr/library/Coq.Logic.Classical.html}
+\urldef{\LogicClassicalFacts}{\url}
+  {http://coq.inria.fr/library/Coq.Logic.ClassicalFacts.html}
+\urldef{\LogicClassicalDescription}{\url}
+  {http://coq.inria.fr/library/Coq.Logic.ClassicalDescription.html}
+\urldef{\LogicProofIrrelevance}{\url}
+  {http://coq.inria.fr/library/Coq.Logic.ProofIrrelevance.html}
+\urldef{\LogicEqdep}{\url}
+  {http://coq.inria.fr/library/Coq.Logic.Eqdep.html}
+\urldef{\LogicEqdepDec}{\url}
+  {http://coq.inria.fr/library/Coq.Logic.Eqdep_dec.html}
+
+
+
+
+\begin{document}
+\bibliographystyle{plain}
+\newcounter{question}
+\renewcommand{\thesubsubsection}{\arabic{question}}
+
+%%%%%%% Coq pour les nuls %%%%%%%
+
+\title{Coq Version 8.0 for the Clueless\\
+  \large(\protect\ref{lastquestion}
+  \ Hints)
+}
+\author{Pierre Castéran \and Hugo Herbelin \and Florent Kirchner \and Benjamin Monate \and Julien Narboux}
+\maketitle
+
+%%%%%%%
+
+\begin{abstract}
+This note intends to provide an easy way to get acquainted with the
+{\Coq} theorem prover. It tries to formulate appropriate answers
+to some of the questions any newcomers will face, and to give
+pointers to other references when possible.
+\end{abstract}
+
+%%%%%%%
+
+%\begin{multicols}{2}
+\tableofcontents
+%\end{multicols}
+
+%%%%%%%
+
+\newpage
+
+\section{Introduction}
+This FAQ is the sum of the questions that came to mind as we developed
+proofs in \Coq. Since we are singularly short-minded, we wrote the
+answers we found on bits of papers to have them at hand whenever the
+situation occurs again. This is pretty much the result of that: a
+collection of tips one can refer to when proofs become intricate. Yes,
+this means we won't take the blame for the shortcomings of this
+FAQ. But if you want to contribute and send in your own question and
+answers, feel free to write to us\ldots
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\section{Presentation}
+
+\Question{What is {\Coq}?}\label{whatiscoq} 
+The {\Coq} tool is a formal proof management system: a proof done with {\Coq} is mechanically checked by the machine. 
+In particular, {\Coq} allows:
+\begin{itemize}
+    \item the definition of mathematical objects and programming objects,
+    \item to state mathematical theorems and software specifications,
+    \item to interactively develop formal proofs of these theorems,
+    \item to check these proofs by a small certification ``kernel''.
+\end{itemize}
+{\Coq} is based on a logical framework called ``Calculus of Inductive
+Constructions'' extended by a modular development system for theories.
+
+\Question{Did you really need to name it like that?}
+Some French computer scientists have a tradition of naming their
+software as animal species: Caml, Elan, Foc or Phox are examples
+of this tacit convention. In French, ``coq'' means rooster, and it
+sounds like the initials of the Calculus of Constructions CoC on which
+it is based.
+
+\Question{Is {\Coq} a theorem prover?}
+
+{\Coq} comes with decision and semi-decision procedures (
+propositional calculus, Presburger's arithmetic, ring and field
+simplification, resolution, ...) but the main style for proving
+theorems is interactively by using LCF-style tactics.
+
+
+\Question{What are the other theorem provers?} 
+Many other theorem provers are available for use nowadays. 
+Isabelle, HOL, HOL Light, Lego, Nuprl, PVS are examples of provers that are fairly similar
+to {\Coq} by the way they interact with the user. Other relatives of
+{\Coq} are ACL2, Agda/Alfa, Twelf, Kiv, Mizar, NqThm, 
+\begin{htmlonly}%
+Omega\ldots
+\end{htmlonly}
+\begin{latexonly}%
+{$\Omega$}mega\ldots
+\end{latexonly}
+
+\Question{What do I have to trust when I see a proof checked by Coq?}
+
+You have to trust:
+
+\begin{description}
+\item[The theory behind Coq] The theory of {\Coq} version 8.0 is
+generally admitted to be consistent wrt Zermelo-Fraenkel set theory +
+inaccessible cardinals. Proofs of consistency of subsystems of the
+theory of Coq can be found in the literature.
+\item[The Coq kernel implementation] You have to trust that the
+implementation of the {\Coq} kernel mirrors the theory behind {\Coq}. The
+kernel is intentionally small to limit the risk of conceptual or
+accidental implementation bugs.
+\item[The Objective Caml compiler] The {\Coq} kernel is written using the
+Objective Caml language but it uses only the most standard features
+(no object, no label ...), so that it is highly unprobable that an
+Objective Caml bug breaks the consistency of {\Coq} without breaking all
+other kinds of features of {\Coq} or of other software compiled with
+Objective Caml.
+\item[Your hardware] In theory, if your hardware does not work
+properly, it can accidentally be the case that False becomes
+provable. But it is more likely the case that the whole {\Coq} system
+will be unusable. You can check your proof using different computers
+if you feel the need to.
+\item[Your axioms] Your axioms must be consistent with the theory
+behind {\Coq}.
+\end{description}
+
+
+\Question{Where can I find information about the theory behind {\Coq}?}
+\begin{description}
+\item[The Calculus of Inductive Constructions] The
+\ahref{http://coq.inria.fr/doc/Reference-Manual006.html}{corresponding}
+chapter and the chapter on
+\ahref{http://coq.inria.fr/doc/Reference-Manual007.html}{modules} in
+the {\Coq} Reference Manual.
+\item[Type theory] A book~\cite{ProofsTypes} or some lecture
+notes~\cite{Types:Dowek}.
+\item[Inductive types]
+Christine Paulin-Mohring's habilitation thesis~\cite{Pau96b}.
+\item[Co-Inductive types]
+Eduardo Giménez' thesis~\cite{EGThese}.
+\item[Miscellaneous] A
+\ahref{http://coq.inria.fr/doc/biblio.html}{bibliography} about Coq
+\end{description}
+
+
+\Question{How can I use {\Coq} to prove programs?}
+
+You can either extract a program from a proof by using the extraction
+mechanism or use dedicated tools, such as
+\ahref{http://why.lri.fr}{\Why},
+\ahref{http://krakatoa.lri.fr}{\Krakatoa},
+\ahref{http://why.lri.fr/caduceus/index.en.html}{\Caduceus}, to prove
+annotated programs written in other languages.
+
+%\Question{How many {\Coq} users are there?}
+%
+%An estimation is about 100 regular users.
+
+\Question{How old is {\Coq}?}
+
+The first implementation is from 1985 (it was named {\sf CoC} which is
+the acronym of the name of the logic it implemented: the Calculus of
+Constructions).  The first official release of {\Coq} (version 4.10)
+was distributed in 1989.
+
+\Question{What are the \Coq-related tools?}
+
+There are graphical user interfaces:
+\begin{description}
+\item[Coqide] A GTK based GUI for \Coq.
+\item[Pcoq] A GUI for {\Coq} with proof by pointing and pretty printing.
+\item[coqwc] A tool similar to {\tt wc} to count lines in {\Coq} files.
+\item[Proof General] A emacs mode for {\Coq} and many other proof assistants.
+\end{description}
+
+There are documentation and browsing tools:
+
+\begin{description}
+\item[Helm/Mowgli] A rendering, searching and publishing tool.
+\item[coq-tex] A tool to insert {\Coq} examples within .tex files. 
+\item[coqdoc] A documentation tool for \Coq.
+\end{description}
+
+There are front-ends for specific languages:
+
+\begin{description}
+\item[Why] A back-end generator of verification conditions.
+\item[Krakatoa] A Java code certification tool that uses both {\Coq} and {\Why} to verify the soundness of implementations with regards to the specifications.
+\item[Caduceus] A C code certification tool that uses both {\Coq} and \Why.
+\item[Zenon] A first-order theorem prover.
+\item[Focal] The \ahref{http://focal.inria.fr}{Focal} project aims at building an environment to develop certified computer algebra libraries. 
+\end{description}
+
+\Question{What are the high-level tactics of \Coq}
+
+\begin{itemize}
+\item Decision of quantifier-free Presburger's Arithmetic
+\item Simplification of expressions on rings and fields
+\item Decision of closed systems of equations
+\item Semi-decision of first-order logic
+\item Prolog-style proof search, possibly involving equalities
+\end{itemize}
+
+\Question{What are the main libraries available for \Coq}
+
+\begin{itemize}
+\item Basic Peano's arithmetic, binary integer numbers, rational numbers,
+\item Real analysis,
+\item Libraries for lists, boolean, maps, floating-point numbers,
+\item Libraries for relations, sets and constructive algebra,
+\item Geometry
+\end{itemize}
+
+
+\Question{What are the mathematical applications for {\Coq}?}
+
+{\Coq} is used for formalizing mathematical theories, for teaching,
+and for proving properties of algorithms or programs libraries.
+
+The largest mathematical formalization has been done at the University
+of Nijmegen (see the
+\ahref{http://vacuumcleaner.cs.kun.nl/c-corn}{Constructive Coq
+Repository at Nijmegen}).
+
+A symbolic step has also been obtained by formalizing in full a proof
+of the Four Color Theorem.
+
+\Question{What are the industrial applications for {\Coq}?}
+
+{\Coq} is used e.g. to prove properties of the JavaCard system
+(especially by Schlumberger and Trusted Logic). It has
+also been used to formalize the semantics of the Lucid-Synchrone
+data-flow synchronous calculus used by Esterel-Technologies.
+
+\iffalse
+todo christine compilo lustre?
+\fi
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\section{Documentation}
+
+\Question{Where can I find documentation about {\Coq}?} 
+All the documentation about \Coq, from the reference manual~\cite{Coq:manual} to
+friendly tutorials~\cite{Coq:Tutorial} and documentation of the standard library, is available 
+\ahref{http://coq.inria.fr/doc-eng.html}{online}.
+All these documents are viewable either in browsable HTML, or as
+downloadable postscripts.
+
+\Question{Where can I find this FAQ on the web?}
+
+This FAQ is available online at \ahref{http://coq.inria.fr/doc/faq.html}{\url{http://coq.inria.fr/doc/faq.html}}.
+
+\Question{How can I submit suggestions / improvements / additions for this FAQ?}
+
+This FAQ is unfinished (in the sense that there are some obvious
+sections that are missing). Please send contributions to \texttt{Florent.Kirchner at lix.polytechnique.fr} and \texttt{Julien.Narboux at inria.fr}.
+
+\Question{Is there any mailing list about {\Coq}?} 
+The main {\Coq} mailing list is \url{coq-club@pauillac.inria.fr}, which
+broadcasts questions and suggestions about the implementation, the
+logical formalism or proof developments. See
+\ahref{http://coq.inria.fr/mailman/listinfo/coq-club}{\url{http://pauillac.inria.fr/mailman/listinfo/coq-club}} for
+subscription. For bugs reports see question \ref{coqbug}.
+
+\Question{Where can I find an archive of the list?}
+The archives of the {\Coq} mailing list are available at
+\ahref{http://pauillac.inria.fr/pipermail/coq-club}{\url{http://coq.inria.fr/pipermail/coq-club}}.
+
+
+\Question{How can I be kept informed of new releases of {\Coq}?}
+
+New versions of {\Coq} are announced on the coq-club mailing list. If you only want to receive information about new releases, you can subscribe to {\Coq} on \ahref{http://freshmeat.net/projects/coq/}{\url{http://freshmeat.net/projects/coq/}}.
+
+
+\Question{Is there any book about {\Coq}?}
+
+The first book on \Coq, Yves Bertot and Pierre Castéran's Coq'Art has been published by Springer-Verlag in 2004:
+\begin{quote}
+``This book provides a pragmatic introduction to the development of
+proofs and certified programs using \Coq. With its large collection of
+examples and exercises it is an invaluable tool for researchers,
+students, and engineers interested in formal methods and the
+development of zero-default software.''
+\end{quote}
+
+\Question{Where can I find some {\Coq} examples?} 
+
+There are examples in the manual~\cite{Coq:manual} and in the
+Coq'Art~\cite{Coq:coqart} exercises \ahref{\url{http://www.labri.fr/Perso/~casteran/CoqArt/index.html}}{\url{http://www.labri.fr/Perso/~casteran/CoqArt/index.html}}.
+You can also find large developments using
+{\Coq} in the {\Coq} user contributions:
+\ahref{http://coq.inria.fr/contrib-eng.html}{\url{http://coq.inria.fr/contrib-eng.html}}.
+
+\Question{How can I report a bug?}\label{coqbug}
+
+You can use the web interface accessible at \ahref{http://coq.inria.fr}{\url{http://coq.inria.fr}}, link ``contacts''.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\section{Installation}
+
+\Question{What is the license of {\Coq}?}
+{\Coq} is distributed under the GNU Lesser General License
+(LGPL).
+
+\Question{Where can I find the sources of {\Coq}?}
+The sources of {\Coq} can be found online in the tar.gz'ed packages
+(\ahref{http://coq.inria.fr}{\url{http://coq.inria.fr}}, link
+``download''). Development sources can be accessed at
+\ahref{http://coq.gforge.inria.fr/}{\url{http://coq.gforge.inria.fr/}}
+
+\Question{On which platform is {\Coq} available?}
+Compiled binaries are available for Linux, MacOS X, and Windows. The
+sources can be easily compiled on all platforms supporting Objective
+Caml.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\section{The logic of {\Coq}}
+
+\subsection{General}
+
+\Question{What is the logic of \Coq?}
+
+{\Coq} is based on an axiom-free type theory called
+the Calculus of Inductive Constructions (see Coquand \cite{CoHu86},
+Luo~\cite{Luo90}
+and Coquand--Paulin-Mohring \cite{CoPa89}). It includes higher-order
+functions and predicates, inductive and co-inductive datatypes and
+predicates, and a stratified hierarchy of sets.
+
+\Question{Is \Coq's logic intuitionistic or classical?}
+
+{\Coq}'s logic is modular. The core logic is intuitionistic
+(i.e. excluded-middle $A\vee\neg A$ is not granted by default). It can
+be extended to classical logic on demand by requiring an
+optional module stating $A\vee\neg A$.
+
+\Question{Can I define non-terminating programs in \Coq?}
+
+All programs in {\Coq} are terminating. Especially, loops
+must come with an evidence of their termination. 
+
+Non-terminating programs can be simulated by passing around a
+bound on how long the program is allowed to run before dying.
+
+\Question{How is equational reasoning working in {\Coq}?}
+
+ {\Coq} comes with an internal notion of computation called
+{\em conversion} (e.g. $(x+1)+y$ is internally equivalent to
+$(x+y)+1$; similarly applying argument $a$ to a function mapping $x$
+to some expression $t$ converts to the expression $t$ where $x$ is
+replaced by $a$). This notion of conversion (which is decidable
+because {\Coq} programs are terminating) covers a certain part of
+equational reasoning but is limited to sequential evaluation of
+expressions of (not necessarily closed) programs. Besides conversion,
+equations have to be treated by hand or using specialised tactics.
+
+\subsection{Axioms}
+
+\Question{What axioms can be safely added to {\Coq}?}
+
+There are a few typical useful axioms that are independent from the
+Calculus of Inductive Constructions and that can be safely added to
+{\Coq}. These axioms are stated in the directory {\tt Logic} of the
+standard library of {\Coq}. The most interesting ones are
+
+\begin{itemize}
+\item Excluded-middle: $\forall A:Prop, A \vee \neg A$
+\item Proof-irrelevance: $\forall A:Prop \forall p_1 p_2:A, p_1=p_2$
+\item Unicity of equality proofs (or equivalently Streicher's axiom $K$):
+$\forall A \forall x y:A \forall p_1 p_2:x=y, p_1=p_2$
+\item The axiom of unique choice: $\forall x \exists! y R(x,y) \rightarrow \exists f \forall x R(x,f(x))$
+\item The functional axiom of choice: $\forall x \exists y R(x,y) \rightarrow \exists f \forall x R(x,f(x))$
+\item Extensionality of predicates: $\forall P Q:A\rightarrow Prop, (\forall x, P(x) \leftrightarrow Q(x)) \rightarrow P=Q$
+\item Extensionality of functions: $\forall f g:A\rightarrow B, (\forall x, f(x)=g(x)) \rightarrow f=g$
+\end{itemize}
+
+Here is a summary of the relative strength of these axioms, most
+proofs can be found in directory {\tt Logic} of the standard library.
+The justification of their validity relies on the interpretability in
+set theory.
+
+%HEVEA\imgsrc{axioms.png}
+%BEGIN LATEX
+\ifpdf   % si on est en pdflatex
+\includegraphics[width=1.0\textwidth]{axioms.png}
+\else
+\includegraphics[width=1.0\textwidth]{axioms.eps}
+\fi
+%END LATEX
+
+\Question{What standard axioms are inconsistent with {\Coq}?}
+
+The axiom of unique choice together with classical logic
+(e.g. excluded-middle) are inconsistent in the variant of the Calculus
+of Inductive Constructions where {\Set} is impredicative.
+
+As a consequence, the functional form of the axiom of choice and
+excluded-middle, or any form of the axiom of choice together with
+predicate extensionality are inconsistent in the {\Set}-impredicative
+version of the Calculus of Inductive Constructions.
+
+The main purpose of the \Set-predicative restriction of the Calculus
+of Inductive Constructions is precisely to accommodate these axioms
+which are quite standard in mathematical usage.
+
+The $\Set$-predicative system is commonly considered consistent by
+interpreting it in a standard set-theoretic boolean model, even with
+classical logic, axiom of choice and predicate extensionality added.
+
+\Question{What is Streicher's axiom $K$}
+\label{Streicher}
+
+Streicher's axiom $K$~\cite{HofStr98} is an axiom that asserts
+dependent elimination of reflexive equality proofs.
+
+\begin{coq_example*}
+Axiom Streicher_K :
+  forall (A:Type) (x:A) (P: x=x -> Prop),
+    P (refl_equal x) -> forall p: x=x, P p.
+\end{coq_example*}
+
+In the general case, axiom $K$ is an independent statement of the
+Calculus of Inductive Constructions.  However, it is true on decidable
+domains (see file \vfile{\LogicEqdepDec}{Eqdep\_dec}). It is also
+trivially a consequence of proof-irrelevance (see
+\ref{proof-irrelevance}) hence of classical logic.
+
+Axiom $K$ is equivalent to {\em Uniqueness of Identity Proofs} \cite{HofStr98}
+
+\begin{coq_example*}
+Axiom UIP : forall (A:Set) (x y:A) (p1 p2: x=y), p1 = p2.
+\end{coq_example*}
+
+Axiom $K$ is also equivalent to {\em Uniqueness of Reflexive Identity Proofs} \cite{HofStr98}
+
+\begin{coq_example*}
+Axiom UIP_refl : forall (A:Set) (x:A) (p: x=x), p = refl_equal x.
+\end{coq_example*}
+
+Axiom $K$ is also equivalent to 
+
+\begin{coq_example*}
+Axiom
+  eq_rec_eq :
+    forall (A:Set) (x:A) (P: A->Set) (p:P x) (h: x=x),
+      p = eq_rect x P p x h.
+\end{coq_example*}
+
+It is also equivalent to the injectivity of dependent equality (dependent equality is itself equivalent to equality of dependent pairs).
+
+\begin{coq_example*}
+Inductive eq_dep (U:Set) (P:U -> Set) (p:U) (x:P p) :
+forall q:U, P q -> Prop :=
+    eq_dep_intro : eq_dep U P p x p x.
+Axiom
+  eq_dep_eq :
+    forall (U:Set) (u:U) (P:U -> Set) (p1 p2:P u),
+      eq_dep U P u p1 u p2 -> p1 = p2.
+\end{coq_example*}
+
+\Question{What is proof-irrelevance}
+\label{proof-irrelevance}
+
+A specificity of the Calculus of Inductive Constructions is to permit
+statements about proofs. This leads to the question of comparing two
+proofs of the same proposition. Identifying all proofs of the same
+proposition is called {\em proof-irrelevance}:
+$$
+\forall A:\Prop, \forall p q:A, p=q
+$$ 
+
+Proof-irrelevance (in {\Prop}) can be assumed without contradiction in
+{\Coq}. It expresses that only provability matters, whatever the exact
+form of the proof is. This is in harmony with the common purely
+logical interpretation of {\Prop}. Contrastingly, proof-irrelevance is
+inconsistent in {\Set} since there are types in {\Set}, such as the
+type of booleans, that are provably more than 2 elements.
+
+Proof-irrelevance (in {\Prop}) is a consequence of classical logic
+(see proofs in file \vfile{\LogicClassical}{Classical} and
+\vfile{\LogicBerardi}{Berardi}). Proof-irrelevance is also a
+consequence of propositional extensionality (i.e.  \coqtt{(A {\coqequiv} B)
+{\coqimp} A=B}, see the proof in file
+\vfile{\LogicClassicalFacts}{ClassicalFacts}).
+
+Proof-irrelevance directly implies Streicher's axiom $K$.
+
+\Question{What about functional extensionality?}
+
+Extensionality of functions is admittedly consistent with the
+Set-predicative Calculus of Inductive Constructions.
+
+%\begin{coq_example*}
+%  Axiom extensionality : (A,B:Set)(f,g:(A->B))(x:A)(f x)=(g x)->f=g.
+%\end{coq_example*}
+
+Let {\tt A}, {\tt B} be types. To deal with extensionality on 
+\verb=A->B= without relying on a general extensionality axiom, 
+a possible approach is to define one's own extensional equality on
+\verb=A->B=.
+
+\begin{coq_eval}
+Variables A B : Set.
+\end{coq_eval}
+
+\begin{coq_example*}
+Definition ext_eq (f g: A->B) := forall x:A, f x = g x.
+\end{coq_example*}
+
+and to reason on \verb=A->B= as a setoid (see the Chapter on
+Setoids in the Reference Manual).
+
+\Question{Is {\Prop} impredicative?}
+
+Yes, the sort {\Prop} of propositions is {\em
+impredicative}. Otherwise said, a statement of the form $\forall
+A:Prop, P(A)$ can be instantiated by itself: if $\forall A:\Prop, P(A)$
+is provable, then $P(\forall A:\Prop, P(A))$ is.
+
+\Question{Is {\Set} impredicative?}
+
+No, the sort {\Set} lying at the bottom of the hierarchy of
+computational types is {\em predicative} in the basic {\Coq} system.
+This means that a family of types in {\Set}, e.g. $\forall A:\Set, A
+\rightarrow A$, is not a type in {\Set} and it cannot be applied on
+itself.
+
+However, the sort {\Set} was impredicative in the original versions of
+{\Coq}. For backward compatibility, or for experiments by
+knowledgeable users, the logic of {\Coq} can be set impredicative for
+{\Set} by calling {\Coq} with the option {\tt -impredicative-set}.
+
+{\Set} has been made predicative from version 8.0 of {\Coq}. The main
+reason is to interact smoothly with a classical mathematical world
+where both excluded-middle and the axiom of description are valid (see
+file \vfile{\LogicClassicalDescription}{ClassicalDescription} for a
+proof that excluded-middle and description implies the double negation
+of excluded-middle in {\Set} and file {\tt Hurkens\_Set.v} from the
+user contribution {\tt Rocq/PARADOXES} for a proof that
+impredicativity of {\Set} implies the simple negation of
+excluded-middle in {\Set}).
+
+\Question{Is {\Type} impredicative?}
+
+No, {\Type} is stratified. This is hidden for the
+user, but {\Coq} internally maintains a set of constraints ensuring
+stratification.
+
+If {\Type} were impredicative then it would be possible to encode
+Girard's systems $U-$ and $U$ in {\Coq} and it is known from Girard,
+Coquand, Hurkens and Miquel that systems $U-$ and $U$ are inconsistent
+[Girard 1972, Coquand 1991, Hurkens 1993, Miquel 2001]. This encoding
+can be found in file {\tt Logic/Hurkens.v} of {\Coq} standard library.
+
+For instance, when the user see {\tt $\forall$ X:Type, X->X : Type}, each
+occurrence of {\Type} is implicitly bound to a different level, say
+$\alpha$ and $\beta$ and the actual statement is {\tt
+forall X:Type($\alpha$), X->X : Type($\beta$)} with the constraint
+$\alpha<\beta$.
+
+When a statement violates a constraint, the message {\tt Universe
+inconsistency} appears. Example: {\tt fun (x:Type) (y:$\forall$ X:Type, X
+{\coqimp} X) => y x x}.
+
+\Question{I have two proofs of the same proposition. Can I prove they are equal?}
+
+In the base {\Coq} system, the answer is generally no. However, if
+classical logic is set, the answer is yes for propositions in {\Prop}.
+The answer is also yes if proof irrelevance holds (see question
+\ref{proof-irrelevance}).
+
+There are also ``simple enough'' propositions for which you can prove
+the equality without requiring any extra axioms.  This is typically
+the case for propositions defined deterministically as a first-order
+inductive predicate on decidable sets. See for instance in question
+\ref{le-uniqueness} an axiom-free proof of the unicity of the proofs of
+the proposition {\tt le m n} (less or equal on {\tt nat}).
+
+%  It is an ongoing work of research to natively include proof
+%  irrelevance in {\Coq}.
+
+\Question{I have two proofs of an equality statement. Can I prove they are 
+equal?}
+
+ Yes, if equality is decidable on the domain considered (which
+is the case for {\tt nat}, {\tt bool}, etc): see {\Coq} file
+\verb=Eqdep_dec.v=). No otherwise, unless
+assuming Streicher's axiom $K$ (see \cite{HofStr98}) or a more general
+assumption such as proof-irrelevance (see \ref{proof-irrelevance}) or
+classical logic.
+
+All of these statements can be found in file \vfile{\LogicEqdep}{Eqdep}.
+
+\Question{Can I prove that the second components of equal dependent
+pairs are equal?}
+
+ The answer is the same as for proofs of equality
+statements. It is provable if equality on the domain of the first
+component is decidable (look at \verb=inj_right_pair= from file
+\vfile{\LogicEqdepDec}{Eqdep\_dec}), but not provable in the general
+case. However, it is consistent (with the Calculus of Constructions)
+to assume it is true. The file \vfile{\LogicEqdep}{Eqdep} actually
+provides an axiom (equivalent to Streicher's axiom $K$) which entails
+the result (look at \verb=inj_pair2= in \vfile{\LogicEqdep}{Eqdep}).
+
+\subsection{Impredicativity}
+
+\Question{Why {\tt injection} does not work on impredicative {\tt Set}?}
+
+ E.g. in this case (this occurs only in the {\tt Set}-impredicative
+ variant of \Coq):
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{coq_example*}
+Inductive I : Type :=
+  intro : forall k:Set, k -> I.
+Lemma eq_jdef : 
+   forall x y:nat, intro _ x = intro _ y -> x = y.
+Proof.
+   intros x y H; injection H.
+\end{coq_example*}
+
+ Injectivity of constructors is restricted to predicative types. If
+injectivity on large inductive types were not restricted, we would be
+allowed to derive an inconsistency (e.g. following the lines of
+Burali-Forti paradox). The question remains open whether injectivity
+is consistent on some large inductive types not expressive enough to
+encode known paradoxes (such as type I above).
+
+
+\Question{What is a ``large inductive definition''?}
+
+An inductive definition in {\Prop} or {\Set} is called large
+if its constructors embed sets or propositions. As an example, here is
+a large inductive type:
+
+\begin{coq_example*}
+Inductive sigST (P:Set -> Set) : Type :=
+  existST : forall X:Set, P X -> sigST P.
+\end{coq_example*}
+
+In the {\tt Set} impredicative variant of {\Coq}, large inductive
+definitions in {\tt Set} have restricted elimination schemes to
+prevent inconsistencies. Especially, projecting the set or the
+proposition content of a large inductive definition is forbidden. If
+it were allowed, it would be possible to encode e.g. Burali-Forti
+paradox \cite{Gir70,Coq85}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Talkin' with the Rooster}
+
+
+%%%%%%%
+\subsection{My goal is ...,  how can I prove it?}
+
+
+\Question{My goal is a conjunction, how can I prove it?}
+
+Use some theorem or assumption or use the {\split} tactic.
+\begin{coq_example}
+Goal forall A B:Prop, A->B-> A/\B.
+intros.
+split.
+assumption.
+assumption.
+Qed.
+\end{coq_example}
+
+\Question{My goal contains a conjunction as an hypothesis, how can I use it?}
+
+If you want to decompose your hypothesis into other hypothesis you can use the {\decompose} tactic:
+
+\begin{coq_example}
+Goal forall A B:Prop, A/\B-> B.
+intros.
+decompose [and] H.
+assumption.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal is a disjunction, how can I prove it?}
+
+You can prove the left part or the right part of the disjunction using
+{\left} or {\right} tactics. If you want to do a classical
+reasoning step, use the {\tt classic} axiom to prove the right part with the assumption
+that the left part of the disjunction is false.
+
+\begin{coq_example}
+Goal forall A B:Prop, A-> A\/B.
+intros.
+left.
+assumption.
+Qed.
+\end{coq_example}
+
+An example using classical reasoning:
+
+\begin{coq_example}
+Require Import Classical.
+
+Ltac classical_right := 
+match goal with 
+| _:_ |-?X1 \/ _ => (elim (classic X1);intro;[left;trivial|right])
+end.
+
+Ltac classical_left := 
+match goal with 
+| _:_ |- _ \/?X1 => (elim (classic X1);intro;[right;trivial|left])
+end.
+
+
+Goal forall A B:Prop, (~A -> B) -> A\/B.
+intros.
+classical_right.
+auto.
+Qed.
+\end{coq_example}
+
+\Question{My goal is an universally quantified statement, how can I prove it?}
+
+Use some theorem or assumption or introduce the quantified variable in
+the context using the {\intro} tactic. If there are several
+variables you can use the {\intros} tactic. A good habit is to
+provide names for these variables: {\Coq} will do it anyway, but such
+automatic naming decreases legibility and robustness.
+
+
+\Question{My goal is an existential, how can I prove it?}
+
+Use some theorem or assumption or exhibit the witness using the {\existstac} tactic.
+\begin{coq_example}
+Goal exists x:nat, forall y, x+y=y.
+exists 0.
+intros.
+auto.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal is solvable by  some lemma, how can I prove it?}
+
+Just use the {\apply} tactic.
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{coq_example}
+Lemma mylemma : forall x, x+0 = x.
+auto.
+Qed.
+
+Goal 3+0 = 3.
+apply mylemma.
+Qed.
+\end{coq_example}
+
+
+
+\Question{My goal contains False as an hypothesis, how can I prove it?}
+
+You can use the {\contradiction} or {\intuition} tactics.
+
+
+\Question{My goal is an equality of two convertible terms, how can I prove it?}
+
+Just use the {\reflexivity} tactic.
+
+\begin{coq_example}
+Goal forall x, 0+x = x.
+intros.
+reflexivity.
+Qed.
+\end{coq_example}
+
+\Question{My goal is a {\tt let x := a in ...}, how can I prove it?}
+
+Just use the {\intro} tactic.
+
+
+\Question{My goal is a {\tt let (a, ..., b) := c in}, how can I prove it?}
+
+Just use the {\destruct} c as (a,...,b) tactic.
+
+
+\Question{My goal contains some existential hypotheses, how can I use it?}
+
+You can use the tactic {\elim} with you hypotheses as an argument.
+
+\Question{My goal contains some existential hypotheses, how can I use it and decompose my knowledge about this new thing into different hypotheses?}
+
+\begin{verbatim}
+Ltac DecompEx H P := elim H;intro P;intro TO;decompose [and] TO;clear TO;clear H.
+\end{verbatim}
+
+
+\Question{My goal is an equality, how can I swap the left and right hand terms?}
+
+Just use the {\symmetry} tactic.
+\begin{coq_example}
+Goal forall x y : nat, x=y -> y=x.
+intros.
+symmetry.
+assumption.
+Qed.
+\end{coq_example}
+
+\Question{My hypothesis is an equality, how can I swap the left and right hand terms?}
+
+Just use the {\symmetryin} tactic.
+
+\begin{coq_example}
+Goal forall x y : nat, x=y -> y=x.
+intros.
+symmetry in H.
+assumption.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal is an equality, how can I prove it by transitivity?}
+
+Just use the {\transitivity} tactic.
+\begin{coq_example}
+Goal forall x y z : nat, x=y -> y=z -> x=z.
+intros.
+transitivity y.
+assumption.
+assumption.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal would be solvable using {\tt apply;assumption} if it would not create meta-variables, how can I prove it?}
+
+You can use {\tt eapply yourtheorem;eauto} but it won't work in all cases ! (for example if more than one hypothesis match one of the subgoals generated by \eapply) so you should rather use  {\tt try solve [eapply yourtheorem;eauto]}, otherwise some metavariables may be incorrectly instantiated.
+
+\begin{coq_example}
+Lemma trans : forall x y z : nat, x=y -> y=z -> x=z.
+intros.
+transitivity y;assumption.
+Qed.
+
+Goal forall x y z : nat, x=y -> y=z -> x=z.
+intros.
+eapply trans;eauto.
+Qed.
+
+Goal forall x y z t : nat, x=y -> x=t -> y=z -> x=z.
+intros.
+eapply trans;eauto.
+Undo.
+eapply trans.
+apply H.
+auto.
+Qed.
+
+Goal forall x y z t : nat, x=y -> x=t -> y=z -> x=z.
+intros.
+eapply trans;eauto.
+Undo.
+try solve [eapply trans;eauto].
+eapply trans.
+apply H.
+auto.
+Qed.
+
+\end{coq_example}
+
+\Question{My goal is solvable by  some lemma within a set of lemmas and I don't want to remember which one, how can I prove it?}
+
+You can use a what is called a hints' base.
+
+\begin{coq_example}
+Require Import ZArith.
+Require Ring.
+Open Local Scope Z_scope.
+Lemma toto1 : 1+1 = 2.
+ring.
+Qed.
+Lemma toto2 : 2+2 = 4.
+ring.
+Qed.
+Lemma toto3 : 2+1 = 3.
+ring.
+Qed.
+
+Hint Resolve toto1 toto2 toto3 : mybase.
+
+Goal 2+(1+1)=4. 
+auto with mybase.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal is one of the hypotheses, how can I prove it?}
+
+Use the {\assumption} tactic.
+
+\begin{coq_example}
+Goal 1=1 -> 1=1.
+intro.
+assumption.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal appears twice in the hypotheses and I want to choose which one is used, how can I do it?}
+
+Use the {\exact} tactic.
+\begin{coq_example}
+Goal 1=1 -> 1=1 -> 1=1.
+intros.
+exact H0.
+Qed.
+\end{coq_example}
+
+\Question{What can be the difference between applying one hypothesis or another in the context of the last question?}
+
+From a proof point of view it is equivalent but if you want to extract
+a program from your proof, the two hypotheses can lead to different
+programs.
+
+
+\Question{My goal is a propositional tautology, how can I prove it?}
+
+Just use the {\tauto} tactic.
+\begin{coq_example}
+Goal forall A B:Prop, A-> (A\/B) /\ A.
+intros.
+tauto.
+Qed.
+\end{coq_example}
+
+\Question{My goal is a first order formula, how can I prove it?}
+
+Just use the semi-decision tactic: \firstorder.
+
+\iffalse
+todo: demander un exemple à Pierre
+\fi
+
+\Question{My goal is solvable by a sequence of rewrites, how can I prove it?}
+
+Just use the {\congruence} tactic.
+\begin{coq_example}
+Goal forall a b c d e, a=d -> b=e -> c+b=d -> c+e=a.
+intros.
+congruence.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal is a disequality solvable by a sequence of rewrites, how can I prove it?}
+
+Just use the {\congruence} tactic.
+
+\begin{coq_example}
+Goal forall a b c d, a<>d -> b=a -> d=c+b -> b<>c+b.
+intros.
+congruence.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal is an equality on some ring (e.g. natural numbers), how can I prove it?}
+
+Just use the {\ring} tactic.
+
+\begin{coq_example}
+Require Import ZArith.
+Require Ring.
+Open Local Scope Z_scope.
+Goal forall a b : Z, (a+b)*(a+b) = a*a + 2*a*b + b*b. 
+intros.
+ring.
+Qed.
+\end{coq_example}
+
+\Question{My goal is an equality on some field (e.g. real numbers), how can I prove it?}
+
+Just use the {\field} tactic.
+
+\begin{coq_example}
+Require Import Reals.
+Require Ring.
+Open Local Scope R_scope.
+Goal forall a b : R, b*a<>0 -> (a/b) * (b/a) = 1. 
+intros.
+field.
+assumption.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal is an inequality on integers in Presburger's arithmetic (an expression build from +,-,constants and variables), how can I prove it?}
+
+
+\begin{coq_example}
+Require Import ZArith.
+Require Omega.
+Open Local Scope Z_scope.
+Goal forall a : Z, a>0 -> a+a > a. 
+intros.
+omega.
+Qed.
+\end{coq_example}
+
+
+\Question{My goal is an equation solvable using equational hypothesis on some ring (e.g. natural numbers), how can I prove it?}
+
+You need the {\gb} tactic (see Loïc Pottier's homepage).
+
+\subsection{Tactics usage}
+
+\Question{I want to state a fact that I will use later as an hypothesis, how can I do it?}
+
+If you want to use forward reasoning (first proving the fact and then
+using it) you just need to use the {\assert} tactic. If you want to use
+backward reasoning (proving your goal using an assumption and then
+proving the assumption) use the {\cut} tactic.
+
+\begin{coq_example}
+Goal forall A B C D : Prop, (A -> B) -> (B->C) -> A -> C. 
+intros.
+assert (A->C).
+intro;apply H0;apply H;assumption.
+apply H2.
+assumption.
+Qed.
+
+Goal forall A B C D : Prop, (A -> B) -> (B->C) -> A -> C. 
+intros.
+cut (A->C).
+intro.
+apply H2;assumption.
+intro;apply H0;apply H;assumption.
+Qed.
+\end{coq_example}
+
+
+
+
+\Question{I want to state a fact that I will use later as an hypothesis and prove it later, how can I do it?}
+
+You can use {\cut} followed by {\intro} or you can use the following {\Ltac} command:
+\begin{verbatim}
+Ltac assert_later t := cut t;[intro|idtac]. 
+\end{verbatim}
+
+\Question{What is the difference between {\Qed} and {\Defined}?}
+
+These two commands perform type checking, but when {\Defined} is used the new definition is set as transparent, otherwise it is defined as opaque (see \ref{opaque}).
+
+
+\Question{How can I know what a tactic does?}
+
+You can use the {\tt info} command.
+
+
+
+\Question{Why {\auto} does not work? How can I fix it?}
+
+You can increase the depth of the proof search or add some lemmas in the base of hints.
+Perhaps you may need to use \eauto.
+
+\Question{What is {\eauto}?}
+
+This is the same tactic as \auto, but it relies on {\eapply} instead of \apply.
+
+\iffalse
+todo les espaces
+\fi
+
+\Question{How can I speed up {\auto}?}
+
+You can use \texttt{info }\auto to replace {\auto} by the tactics it generates.
+You can split your hint bases into smaller ones.
+
+
+\Question{What is the equivalent of {\tauto} for classical logic?}
+
+Currently there are no equivalent tactic for classical logic. You can use Gödel's ``not not'' translation.
+
+
+\Question{I want to replace some term with another in the goal, how can I do it?}
+
+If one of your hypothesis (say {\tt H}) states that the terms are equal you can use the {\rewrite} tactic. Otherwise you can use the {\replace} {\tt with} tactic. 
+
+\Question{I want to replace some term with another in an hypothesis, how can I do it?}
+
+You can use the {\rewrite} {\tt in} tactic.
+
+\Question{I want to replace some symbol with its definition, how can I do it?}
+
+You can use the {\unfold} tactic.
+
+\Question{How can I reduce some term?}
+
+You can use the {\simpl} tactic.
+
+\Question{How can I declare a shortcut for some term?}
+
+You can use the {\set} or {\pose} tactics.
+
+\Question{How can I perform case analysis?}
+
+You can use the {\case} or {\destruct} tactics.
+
+
+\Question{Why should I name my intros?}
+
+When you use the {\intro} tactic you don't have to give a name to your
+hypothesis. If you do so the name will be generated by {\Coq} but your
+scripts may be less robust. If you add some hypothesis to your theorem
+(or change their order), you will have to change your proof to adapt
+to the new names.
+
+\Question{How can I automatize the naming?}
+
+You can use the {\tt Show Intro.} or  {\tt Show Intros.} commands to generate the names and use your editor to generate a fully named {\intro} tactic. 
+This can be automatized within {\tt xemacs}.
+
+\begin{coq_example}
+Goal forall A B C : Prop, A -> B -> C -> A/\B/\C.
+Show Intros.
+(*
+A B C H H0
+H1
+*)
+intros A B C H H0 H1.
+repeat split;assumption.
+Qed.
+\end{coq_example}
+
+\Question{I want to automatize the use of some tactic, how can I do it?}
+
+You need to use the {\tt proof with T} command and add {\ldots} at the
+end of your sentences.
+
+For instance:
+\begin{coq_example}
+Goal forall A B C : Prop, A -> B/\C -> A/\B/\C.
+Proof with assumption.
+intros.
+split...
+Qed.
+\end{coq_example}
+
+\Question{I want to execute the {\texttt proof with} tactic only if it solves the goal, how can I do it?}
+
+You need to use the {\try} and {\solve} tactics. For instance:
+\begin{coq_example}
+Require Import ZArith.
+Require Ring.
+Open Local Scope Z_scope.
+Goal forall a b c : Z, a+b=b+a.
+Proof with try solve [ring].
+intros...
+Qed.
+\end{coq_example}
+
+\Question{How can I do the opposite of the {\intro} tactic?}
+
+You can use the {\generalize} tactic.
+
+\begin{coq_example}
+Goal forall A B : Prop, A->B-> A/\B.
+intros.
+generalize H.
+intro.
+auto.
+Qed.
+\end{coq_example}
+
+\Question{One of the hypothesis is an equality between a variable and some term, I want to get rid of this variable, how can I do it?}
+
+You can use the {\subst} tactic. This will rewrite the equality everywhere and clear the assumption.
+
+\Question{What can I do if I get ``{\tt generated subgoal term has metavariables in it }''?}
+
+You should use the {\eapply} tactic, this will generate some goals containing metavariables. 
+
+\Question{How can I instantiate some metavariable?}
+
+Just use the {\instantiate} tactic.
+
+
+\Question{What is the use of the {\pattern} tactic?}
+
+The {\pattern} tactic transforms the current goal, performing
+beta-expansion on all the applications featuring this tactic's
+argument. For instance, if the current goal includes a subterm {\tt
+phi(t)}, then {\tt pattern t} transforms the subterm into {\tt (fun
+x:A => phi(x)) t}. This can be useful when {\apply} fails on matching,
+to abstract the appropriate terms.
+
+\Question{What is the difference between assert, cut and generalize?}
+
+PS: Notice for people that are interested in proof rendering that \assert
+and {\pose} (and \cut) are not rendered the same as {\generalize} (see the
+HELM experimental rendering tool at \ahref{http://helm.cs.unibo.it/library.html}{\url{http://helm.cs.unibo.it}}, link
+HELM, link COQ Online). Indeed {\generalize} builds a beta-expanded term
+while \assert, {\pose} and {\cut} uses a let-in.
+
+\begin{verbatim}
+  (* Goal is T *)
+  generalize (H1 H2).
+  (* Goal is A->T *)
+  ... a proof of A->T ...
+\end{verbatim}
+
+is rendered into something like
+\begin{verbatim}
+  (h) ... the proof of A->T ...
+      we proved A->T
+  (h0) by (H1 H2) we proved A
+  by (h h0) we proved T
+\end{verbatim}
+while 
+\begin{verbatim}
+  (* Goal is T *)
+  assert q := (H1 H2).
+  (* Goal is A *)
+  ... a proof of A ...
+  (* Goal is A |- T *)
+  ... a proof of T ...
+\end{verbatim}
+is rendered into something like
+\begin{verbatim}
+  (q) ... the proof of A ...
+      we proved A
+  ... the proof of T ...
+  we proved T
+\end{verbatim}
+Otherwise said, {\generalize} is not rendered in a forward-reasoning way,
+while {\assert} is.
+
+\Question{What can I do if \Coq can not infer some implicit argument ?}
+
+You can state explicitely what this implicit argument is. See \ref{implicit}.
+
+\Question{How can I explicit some implicit argument ?}\label{implicit}
+
+Just use \texttt{A:=term} where \texttt{A} is the argument.
+
+For instance if you want to use the existence of ``nil'' on nat*nat lists:
+\begin{verbatim}
+exists (nil (A:=(nat*nat))).
+\end{verbatim}
+
+\iffalse
+\Question{Is there anyway to do pattern matching with dependent types?}
+
+todo
+\fi
+
+\subsection{Proof management}
+
+
+\Question{How can I change the order of the subgoals?}
+
+You can use the {\Focus} command to concentrate on some goal. When the goal is proved you will see the remaining goals.
+
+\Question{How can I change the order of the hypothesis?}
+
+You can use the {\tt Move ... after} command.
+
+\Question{How can I change the name of an hypothesis?}
+
+You can use the {\tt Rename ... into} command.
+
+\Question{How can I delete some hypothesis?}
+
+You can use the {\tt Clear} command.
+
+\Question{How can use a proof which is not finished?}
+
+You can use the {\tt Admitted} command to state your current proof as an axiom.
+
+\Question{How can I state a conjecture?}
+
+You can use the {\tt Admitted} command to state your current proof as an axiom.
+
+\Question{What is the difference between a lemma, a fact and a theorem?}
+
+From {\Coq} point of view there are no difference. But some tools can
+have a different behavior when you use a lemma rather than a
+theorem. For instance {\tt coqdoc} will not generate documentation for
+the lemmas within your development.
+
+\Question{How can I organize my proofs?}
+
+You can organize your proofs using the section mechanism of \Coq. Have
+a look at the manual for further information.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{Inductive and Co-inductive types}
+
+\subsection{General}
+
+\Question{How can I prove that two constructors are different?}
+
+You can use the {\discriminate} tactic.
+
+\begin{coq_example}
+Inductive toto : Set := | C1 : toto | C2 : toto.
+Goal C1 <> C2.
+discriminate.
+Qed.
+\end{coq_example}
+
+\Question{During an inductive proof, how to get rid of impossible cases of an inductive definition?}
+
+Use the {\inversion} tactic.
+
+
+\Question{How can I prove that 2 terms in an inductive set are equal? Or different?}
+
+Have a look at \coqtt{decide equality} and \coqtt{discriminate} in the \ahref{http://coq.inria.fr/doc/main.html}{Reference Manual}.
+
+\Question{Why is the proof of \coqtt{0+n=n} on natural numbers
+trivial but the proof of \coqtt{n+0=n} is not?}
+
+ Since \coqtt{+} (\coqtt{plus}) on natural numbers is defined by analysis on its first argument
+
+\begin{coq_example}
+Print plus.
+\end{coq_example}
+
+{\noindent} The expression \coqtt{0+n} evaluates to \coqtt{n}. As {\Coq} reasons
+modulo evaluation of expressions, \coqtt{0+n} and \coqtt{n} are
+considered equal and the theorem \coqtt{0+n=n} is an instance of the
+reflexivity of equality. On the other side, \coqtt{n+0} does not
+evaluate to \coqtt{n} and a proof by induction on \coqtt{n} is
+necessary to trigger the evaluation of \coqtt{+}.
+
+\Question{Why is dependent elimination in Prop not
+available by default?}
+
+ 
+This is just because most of the time it is not needed. To derive a
+dependent elimination principle in {\tt Prop}, use the command {\tt Scheme} and
+apply the elimination scheme using the \verb=using= option of
+\verb=elim=, \verb=destruct= or \verb=induction=.
+
+
+\Question{Argh! I cannot write expressions like ``~{\tt if n <= p then p else n}~'', as in any programming language}
+\label{minmax}
+
+The short answer : You should use {\texttt le\_lt\_dec n p} instead.\\
+
+That's right, you can't.
+If you type for instance the following ``definition'':
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example}
+Definition max (n p : nat) := if n <= p then p else n.
+\end{coq_example}
+
+As \Coq~ says, the term ``~\texttt{n <= p}~'' is a proposition, i.e. a
+statement that belongs to the mathematical world. There are many ways to
+prove such a proposition, either by some computation, or using some already
+proven theoremas. For instance, proving $3-2 \leq 2^{45503}$ is very easy,
+using some theorems on arithmetical operations. If you compute both numbers
+before comparing them, you risk to use a lot of time and space.
+
+
+On the contrary, a function for computing the greatest of two natural numbers
+is an algorithm  which, called on two natural numbers
+$n$ and $p$, determines wether $n\leq p$ or $p < n$.
+Such a function is a \emph{decision  procedure} for the inequality of
+ \texttt{nat}.  The possibility of writing such a procedure comes 
+directly from de decidability of the order $\leq$ on natural numbers.
+
+
+When you write a piece of code like 
+``~\texttt{if n <= p then \dots{} else \dots}~''
+in a
+programming language like \emph{ML} or \emph{Java}, a call to such a 
+decision procedure is generated. The decision procedure is in general
+a primitive function, written in a low-level language, in the correctness
+of which you have to trust.
+
+The standard Library of the system \emph{Coq} contains a  
+(constructive) proof of decidability of the order $\leq$ on
+\texttt{nat} : the function \texttt{le\_lt\_dec} of 
+the module \texttt{Compare\_dec} of library \texttt{Arith}.
+
+The following code shows how to define correctly \texttt{min} and
+\texttt{max}, and prove some properties of these functions.
+
+\begin{coq_example}
+Require Import Compare_dec.
+
+Definition max (n p : nat) := if le_lt_dec n p then p else n.
+
+Definition min (n p : nat) := if le_lt_dec n p then n else p.
+
+Eval compute in (min 4 7).
+
+Theorem min_plus_max : forall n p, min n p + max n p  = n + p.
+Proof.
+ intros n p; 
+ unfold min, max; 
+ case (le_lt_dec n p);
+ simpl; auto with arith.
+Qed.
+
+Theorem max_equiv : forall n p, max n p = p <-> n <= p.
+Proof.
+ unfold max; intros n p; case (le_lt_dec n p);simpl; auto.
+ intuition auto with arith.
+ split. 
+ intro e; rewrite e; auto with arith.
+ intro H; absurd (p < p); eauto with arith.
+Qed.
+\end{coq_example}
+
+\Question{I wrote my own decision procedure for $\leq$, which
+is much  faster than yours, but proving such theorems as
+ \texttt{max\_equiv} seems to be quite difficult}
+
+Your code is probably the following one:
+
+\begin{coq_example}
+Fixpoint my_le_lt_dec (n p :nat) {struct n}: bool  :=
+ match n, p with 0, _ => true
+               | S n', S p' => my_le_lt_dec n' p'
+               | _   , _    => false
+ end.
+
+Definition my_max (n p:nat) := if my_le_lt_dec n p then p else n.
+
+Definition my_min (n p:nat) := if my_le_lt_dec n p then n else p.
+\end{coq_example}
+
+
+For instance, the computation of \texttt{my\_max 567 321} is almost
+immediate, whereas one can't wait for  the result of 
+\texttt{max 56 32}, using \emph{Coq's} \texttt{le\_lt\_dec}.
+
+This is normal. Your definition is a simple recursive function which
+returns a boolean value. Coq's \texttt{le\_lt\_dec} is a \emph{certified
+function}, i.e. a complex object, able not only to tell wether $n\leq p$
+or $p<n$, but also of building a complete proof of the correct inequality.
+What make \texttt{le\_lt\_dec} inefficient for computing \texttt{min}
+and \texttt{max} is the building of a huge proof term.
+
+Nevertheless,  \texttt{le\_lt\_dec} is very useful. Its type 
+is a strong specification, using the
+\texttt{sumbool} type (look at the reference manual or chapter 9 of
+\cite{coqart}). Eliminations of the form
+``~\texttt{case (le\_lt\_dec n p)}~'' provide proofs of
+either $n \leq p$ or $p < n$, allowing to prove easily theorems as in
+question~\ref{minmax}. Unfortunately, this not the case of your
+\texttt{my\_le\_lt\_dec}, which returns a quite non-informative boolean
+value.
+
+
+\begin{coq_example}
+Check le_lt_dec.
+\end{coq_example}
+
+You should keep in mind that \texttt{le\_lt\_dec} is useful to build
+certified programs which need to compare natural numbers, and is not
+designed to compare quickly two numbers.
+
+Nevertheless, the \emph{extraction} of \texttt{le\_lt\_dec} towards 
+\emph{Ocaml} or \emph{Haskell}, is a reasonable program for comparing two
+natural numbers in Peano form in linear time.
+
+It is also possible to keep your boolean function as a decision procedure,
+but you have to establish yourself the relationship between \texttt{my\_le\_lt\_dec} and the propositions $n\leq p$ and $p<n$:
+
+\begin{coq_example*}
+Theorem my_le_lt_dec_true : 
+    forall n p, my_le_lt_dec n p = true <-> n <= p.
+
+Theorem  my_le_lt_dec_false : 
+   forall n p, my_le_lt_dec n p = false <-> p < n.
+\end{coq_example*}
+
+
+\subsection{Recursion}
+
+\Question{Why can't I define a non terminating program?}
+
+ Because otherwise the decidability of the type-checking
+algorithm (which involves evaluation of programs) is not ensured.  On
+another side, if non terminating proofs were allowed, we could get a
+proof of {\tt False}:
+
+\begin{coq_example*}
+(* This is fortunately not allowed! *)
+Fixpoint InfiniteProof (n:nat) : False := InfiniteProof n.
+Theorem Paradox : False.
+Proof (InfiniteProof O).
+\end{coq_example*}
+
+
+\Question{Why only structurally well-founded loops are allowed?}
+
+ The structural order on inductive types is a simple and
+powerful notion of termination. The consistency of the Calculus of
+Inductive Constructions relies on it and another consistency proof
+would have to be made for stronger termination arguments (such
+as the termination of the evaluation of CIC programs themselves!).
+
+In spite of this, all non-pathological termination orders can be mapped
+to a structural order. Tools to do this are provided in the file 
+\vfile{\InitWf}{Wf} of the standard library of {\Coq}.
+
+\Question{How to define loops based on non structurally smaller
+recursive calls?}
+
+ The procedure is as follows (we consider the definition of {\tt
+mergesort} as an example).
+
+\begin{itemize}
+
+\item Define the termination order, say {\tt R} on the type {\tt A} of
+the arguments of the loop.
+
+\begin{coq_eval}
+Open Scope R_scope.
+Require Import List.
+\end{coq_eval}
+
+\begin{coq_example*}
+Definition R (a b:list nat) := length a < length b.
+\end{coq_example*}
+
+\item Prove that this order is well-founded (in fact that all elements in {\tt A} are accessible along {\tt R}).
+
+\begin{coq_example*}
+Lemma Rwf : well_founded R.
+\end{coq_example*}
+
+\item Define the step function (which needs proofs that recursive
+calls are on smaller arguments).
+
+\begin{coq_example*}
+Definition split (l : list nat) 
+   : {l1: list nat | R l1 l} * {l2 : list nat | R l2 l}
+   := (* ... *) .
+Definition concat (l1 l2 : list nat) : list nat := (* ... *) .
+Definition merge_step (l : list nat) (f: forall l':list nat, R l' l -> list nat) :=
+  let (lH1,lH2) := (split l) in
+  let (l1,H1) := lH1 in
+  let (l2,H2) := lH2 in
+  concat (f l1 H1) (f l2 H2).
+\end{coq_example*}
+
+\item Define the recursive function by fixpoint on the step function.
+
+\begin{coq_example*}
+Definition merge := Fix Rwf (fun _ => list nat) merge_step.
+\end{coq_example*}
+
+\end{itemize}
+
+\Question{What is behind the accessibility and well-foundedness proofs?}
+
+ Well-foundedness of some relation {\tt R} on some type {\tt A}
+is defined as the accessibility of all elements of {\tt A} along {\tt R}.
+
+\begin{coq_example}
+Print well_founded.
+Print Acc.
+\end{coq_example}
+
+The structure of the accessibility predicate is a well-founded tree
+branching at each node {\tt x} in {\tt A} along all the nodes {\tt x'}
+less than {\tt x} along {\tt R}. Any sequence of elements of {\tt A}
+decreasing along the order {\tt R} are branches in the accessibility
+tree. Hence any decreasing along {\tt R} is mapped into a structural
+decreasing in the accessibility tree of {\tt R}. This is emphasised in
+the definition of {\tt fix} which recurs not on its argument {\tt x:A}
+but on the accessibility of this argument along {\tt R}.
+
+See file \vfile{\InitWf}{Wf}.
+
+\Question{How to perform simultaneous double induction?}
+
+ In general a (simultaneous) double induction is simply solved by an
+induction on the first hypothesis followed by an inversion over the
+second hypothesis. Here is an example
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{coq_example}
+Inductive even : nat -> Prop :=
+  | even_O : even 0
+  | even_S : forall n:nat, even n -> even (S (S n)).
+
+Inductive odd : nat -> Prop :=
+  | odd_SO : odd 1
+  | odd_S : forall n:nat, odd n -> odd (S (S n)).
+
+Lemma not_even_and_odd : forall n:nat, even n -> odd n -> False.
+induction 1.
+  inversion 1.
+  inversion 1. apply IHeven; trivial.
+\end{coq_example}
+\begin{coq_eval}
+Qed.
+\end{coq_eval}
+
+In case the type of the second induction hypothesis is not
+dependent, {\tt inversion} can just be replaced by {\tt destruct}.
+
+\Question{How to define a function by simultaneous double recursion?}
+
+ The same trick applies, you can even use the pattern-matching
+compilation algorithm to do the work for you. Here is an example:
+
+\begin{coq_example}
+Fixpoint minus (n m:nat) {struct n} : nat :=
+  match n, m with
+  | O, _ => 0
+  | S k, O => S k
+  | S k, S l => minus k l
+  end.
+Print  minus.
+\end{coq_example}
+
+In case of dependencies in the type of the induction objects
+$t_1$ and $t_2$, an extra argument stating $t_1=t_2$ must be given to
+the fixpoint definition
+
+\Question{How to perform nested and double induction?}
+
+ To reason by nested (i.e. lexicographic) induction, just reason by
+induction on the successive components.
+
+\smallskip
+
+Double induction (or induction on pairs) is a restriction of the
+lexicographic induction. Here is an example of double induction.
+
+\begin{coq_example}
+Lemma nat_double_ind : 
+forall P : nat -> nat -> Prop, P 0 0 -> 
+  (forall m n, P m n -> P m (S n)) -> 
+  (forall m n, P m n -> P (S m) n) -> 
+     forall m n, P m n.
+intros P H00 HmS HSn; induction m.
+(* case 0 *)
+induction n; [assumption | apply HmS; apply IHn].
+(* case Sm *)
+intro n; apply HSn; apply IHm.
+\end{coq_example}
+\begin{coq_eval}
+Qed.
+\end{coq_eval}
+
+\Question{How to define a function by nested recursion?}
+
+ The same trick applies. Here is the example of Ackermann
+function.
+
+\begin{coq_example}
+Fixpoint ack (n:nat) : nat -> nat :=
+  match n with
+  | O => S
+  | S n' =>
+     (fix ack' (m:nat) : nat :=
+        match m with
+        | O => ack n' 1
+        | S m' => ack n' (ack' m')
+        end)
+  end.
+\end{coq_example}
+
+
+\subsection{Co-inductive types}
+
+\Question{I have a cofixpoint $t:=F(t)$ and I want to prove $t=F(t)$. How to do it?}
+
+Just case-expand $F({\tt t})$ then complete by a trivial case analysis.
+Here is what it gives on e.g. the type of streams on naturals
+
+\begin{coq_eval}
+Set Implicit Arguments.
+\end{coq_eval}
+\begin{coq_example}
+CoInductive Stream (A:Set) : Set :=
+  Cons : A -> Stream A -> Stream A.
+CoFixpoint nats (n:nat) : Stream nat := Cons n (nats (S n)).
+Lemma Stream_unfold : 
+   forall n:nat, nats n = Cons n (nats (S n)).
+Proof.
+  intro;
+  change (nats n = match nats n with
+                  | Cons x s => Cons x s
+                  end).
+  case (nats n); reflexivity.
+Qed.
+\end{coq_example}
+
+
+
+\section{Syntax and notations}
+
+\Question{I do not want to type ``forall'' because it is too long, what can I do?}
+
+You can define your own notation for forall:
+\begin{verbatim}
+Notation "fa x : t, P" := (forall x:t, P) (at level 200, x ident).
+\end{verbatim}
+or if your are using {\CoqIde} you can define a pretty symbol for for all and an input method (see \ref{forallcoqide}).
+
+
+
+\Question{How can I define a notation for square?}
+
+You can use for instance:
+\begin{verbatim}
+Notation "x ^2" := (Rmult x x) (at level 20).
+\end{verbatim}
+Note that you can not use:
+\begin{texttt}
+Notation "x $^²$" := (Rmult x x) (at level 20).
+\end{texttt}
+because ``$^2$'' is an iso-latin character. If you really want this kind of notation you should use UTF-8.
+
+
+\Question{Why ``no associativity'' and  ``left associativity'' at the same level does not work?}
+
+Because we relie on camlp4 for syntactical analysis and camlp4 does not really implement no associativity. By default, non associative operators are defined as right associative.
+
+
+
+\Question{How can I know the associativity associated with a level?}
+
+You can do ``Print Grammar constr'', and decode the output from camlp4, good luck !
+
+\section{Modules}
+
+
+
+
+%%%%%%%
+\section{\Ltac}
+
+\Question{What is {\Ltac}?}
+
+{\Ltac} is the tactic language for \Coq. It provides the user with a
+high-level ``toolbox'' for tactic creation.
+
+\Question{Why do I always get the same error message?}
+
+
+\Question{Is there any printing command in {\Ltac}?}
+
+You can use the {\idtac} tactic with a string argument. This string
+will be printed out. The same applies to the {\fail} tactic
+
+\Question{What is the syntax for let in {\Ltac}?}
+
+If $x_i$ are identifiers and $e_i$ and $expr$ are tactic expressions, then let reads:
+\begin{center}
+{\tt let $x_1$:=$e_1$ with $x_2$:=$e_2$\ldots with $x_n$:=$e_n$ in
+$expr$}.
+\end{center}
+Beware that if $expr$ is complex (i.e. features at least a sequence) parenthesis
+should be added around it. For example: 
+\begin{coq_example}
+Ltac twoIntro := let x:=intro in (x;x).
+\end{coq_example}
+
+\Question{What is the syntax for pattern matching in {\Ltac}?}
+
+Pattern matching on a term $expr$ (non-linear first order unification)
+with patterns $p_i$ and tactic expressions $e_i$ reads:
+\begin{center}
+\hspace{10ex}
+{\tt match $expr$ with
+\hspace*{2ex}$p_1$ => $e_1$
+\hspace*{1ex}\textbar$p_2$ => $e_2$
+\hspace*{1ex}\ldots
+\hspace*{1ex}\textbar$p_n$ => $e_n$
+\hspace*{1ex}\textbar\ \textunderscore\ => $e_{n+1}$
+end.
+}
+\end{center}
+Underscore matches all terms.
+
+\Question{What is the semantics for ``match goal''?}
+
+The semantics of {\tt match goal} depends on whether it returns
+tactics or not.  The {\tt match goal} expression matches the current
+goal against a series of patterns: {$hyp_1 {\ldots} hyp_n$ \textbar-
+$ccl$}. It uses a first-order unification algorithm and in case of
+success, if the right-hand-side is an expression, it tries to type it
+while if the right-hand-side is a tactic, it tries to apply it.  If the
+typing or the tactic application fails, the {\tt match goal} tries all
+the possible combinations of $hyp_i$ before dropping the branch and
+moving to the next one. Underscore matches all terms.
+
+\Question{Why can't I use a ``match goal'' returning a tactic in a non
+tail-recursive position?}
+
+This is precisely because the semantics of {\tt match goal} is to
+apply the tactic on the right as soon as a pattern unifies what is
+meaningful only in tail-recursive uses.
+
+The semantics in non tail-recursive call could have been the one used
+for terms (i.e. fail if the tactic expression is not typable, but
+don't try to apply it). For uniformity of semantics though, this has
+been rejected.
+
+\Question{How can I generate a new name?}
+
+You can use the following syntax:
+{\tt let id:=fresh in \ldots}\\
+For example:
+\begin{coq_example}
+Ltac introIdGen := let id:=fresh in intro id.
+\end{coq_example}
+
+
+\iffalse
+\Question{How can I access the type of a term?}
+
+You can use typeof.
+todo
+\fi
+
+\Question{How can I define static and dynamic code?}
+
+\section{Tactics written in Ocaml}
+
+\Question{Can you show me an example of a tactic written in OCaml?}
+
+You have some examples of tactics written in Ocaml in the ``contrib'' directory of {\Coq} sources. 
+
+
+
+
+\section{Case studies}
+
+
+\Question{How can I define vectors or lists of size n?}
+
+\Question{How to prove that 2 sets are different?}
+
+ You need to find a property true on one set and false on the
+other one. As an example we show how to prove that {\tt bool} and {\tt
+nat} are discriminable. As discrimination property we take the
+property to have no more than 2 elements.
+
+\begin{coq_example*}
+Theorem nat_bool_discr : bool <> nat.
+Proof.
+  pose (discr :=
+    fun X:Set =>
+      ~ (forall a b:X, ~ (forall x:X, x <> a -> x <> b -> False))).
+  intro Heq; assert (H: discr bool).
+  intro H; apply (H true false); destruct x; auto.
+  rewrite Heq in H; apply H; clear H.
+  destruct a; destruct b as [|n]; intro H0; eauto.
+  destruct n; [ apply (H0 2); discriminate | eauto ].
+Qed.
+\end{coq_example*}
+
+\Question{Is there an axiom-free proof of Streicher's axiom $K$ for
+the equality on {\tt nat}?}
+\label{K-nat}
+
+Yes, because equality is decidable on {\tt nat}. Here is the proof.
+
+\begin{coq_example*}
+Require Import Eqdep_dec.
+Require Import Peano_dec.
+Theorem K_nat :
+  forall (x:nat) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+Proof.
+intros; apply K_dec_set with (p := p).
+apply eq_nat_dec.
+assumption.
+Qed.
+\end{coq_example*}
+
+Similarly, we have
+
+\begin{coq_example*}
+Theorem eq_rect_eq_nat :
+  forall (p:nat) (Q:nat->Type) (x:Q p) (h:p=p), x = eq_rect p Q x p h.
+Proof.
+intros; apply K_nat with (p := h); reflexivity.
+Qed.
+\end{coq_example*}
+
+\Question{How to prove that two proofs of {\tt n<=m} on {\tt nat} are equal?}
+\label{le-uniqueness}
+
+This is provable without requiring any axiom because axiom $K$
+directly holds on {\tt nat}. Here is a proof using question \ref{K-nat}.
+
+\begin{coq_example*}
+Require Import Arith.
+Scheme le_ind' := Induction for le Sort Prop.
+Theorem le_uniqueness_proof : forall (n m : nat) (p q : n <= m), p = q.
+Proof.
+induction p using le_ind'; intro q.
+ replace (le_n n) with
+  (eq_rect _ (fun n0 => n <= n0) (le_n n) _ (refl_equal n)).
+ 2:reflexivity.
+  generalize (refl_equal n).
+    pattern n at 2 4 6 10, q; case q; [intro | intros m l e].
+     rewrite <- eq_rect_eq_nat; trivial.
+     contradiction (le_Sn_n m); rewrite <- e; assumption.
+ replace (le_S n m p) with
+  (eq_rect _ (fun n0 => n <= n0) (le_S n m p) _ (refl_equal (S m))).
+ 2:reflexivity.
+  generalize (refl_equal (S m)).
+    pattern (S m) at 1 3 4 6, q; case q; [intro Heq | intros m0 l HeqS].
+     contradiction (le_Sn_n m); rewrite Heq; assumption.
+     injection HeqS; intro Heq; generalize l HeqS.
+      rewrite <- Heq; intros; rewrite <- eq_rect_eq_nat.
+      rewrite (IHp l0); reflexivity.
+Qed.
+\end{coq_example*}
+
+\Question{How to exploit equalities on sets}
+
+To extract information from an equality on sets, you need to
+find a predicate of sets satisfied by the elements of the sets. As an
+example, let's consider the following theorem.
+
+\begin{coq_example*}
+Theorem interval_discr :
+  forall m n:nat,
+    {x : nat | x <= m} = {x : nat | x <= n} -> m = n.
+\end{coq_example*}
+
+We have a proof requiring the axiom of proof-irrelevance. We
+conjecture that proof-irrelevance can be circumvented by introducing a
+primitive definition of discrimination of the proofs of
+\verb!{x : nat | x <= m}!.
+
+\begin{latexonly}%
+The proof can be found in file {\tt interval$\_$discr.v} in this directory.
+%Here is the proof
+%\begin{small}
+%\begin{flushleft}
+%\begin{texttt}
+%\def_{\ifmmode\sb\else\subscr\fi}
+%\include{interval_discr.v}
+%%% WARNING semantics of \_ has changed !
+%\end{texttt}
+%$a\_b\_c$
+%\end{flushleft}
+%\end{small}
+\end{latexonly}%
+\begin{htmlonly}%
+\ahref{./interval_discr.v}{Here} is the proof.
+\end{htmlonly}
+
+\Question{I have a problem of dependent elimination on
+proofs, how to solve it?}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{coq_example*}
+Inductive Def1 : Set := c1 : Def1.
+Inductive DefProp : Def1 -> Prop :=
+  c2 : forall d:Def1, DefProp d.
+Inductive Comb : Set :=
+  c3 : forall d:Def1, DefProp d -> Comb.
+Lemma eq_comb :
+  forall (d1 d1':Def1) (d2:DefProp d1) (d2':DefProp d1'),
+    d1 = d1' -> c3 d1 d2 = c3 d1' d2'.
+\end{coq_example*}
+
+ You need to derive the dependent elimination
+scheme for DefProp by hand using {\coqtt Scheme}.
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\begin{coq_example*}
+Scheme DefProp_elim := Induction for DefProp Sort Prop.
+Lemma eq_comb :
+  forall d1 d1':Def1,
+    d1 = d1' ->
+    forall (d2:DefProp d1) (d2':DefProp d1'), c3 d1 d2 = c3 d1' d2'.
+intros.
+destruct H.
+destruct d2 using DefProp_elim.
+destruct d2' using DefProp_elim.
+reflexivity.
+Qed.
+\end{coq_example*}
+
+
+\Question{And what if I want to prove the following?}
+
+\begin{coq_example*}
+Inductive natProp : nat -> Prop :=
+  | p0 : natProp 0
+  | pS : forall n:nat, natProp n -> natProp (S n).
+Inductive package : Set :=
+  pack : forall n:nat, natProp n -> package.
+Lemma eq_pack :
+ forall n n':nat,
+   n = n' ->
+   forall (np:natProp n) (np':natProp n'), pack n np = pack n' np'.
+\end{coq_example*}
+
+
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+\begin{coq_example*}
+Scheme natProp_elim := Induction for natProp Sort Prop.
+Definition pack_S : package -> package.
+destruct 1.
+apply (pack (S n)).
+apply pS; assumption.
+Defined.
+Lemma eq_pack :
+  forall n n':nat,
+    n = n' ->
+    forall (np:natProp n) (np':natProp n'), pack n np = pack n' np'.
+intros n n' Heq np np'.
+generalize dependent n'.
+induction np using natProp_elim.
+induction np' using natProp_elim; intros; auto.
+ discriminate Heq.
+induction np' using natProp_elim; intros; auto.
+ discriminate Heq.
+change (pack_S (pack n np) = pack_S (pack n0 np')).
+apply (f_equal (A:=package)).
+apply IHnp.
+auto.
+Qed.
+\end{coq_example*}
+
+
+
+
+
+
+
+\section{Publishing tools}
+
+\Question{How can I generate some latex from my development?}
+
+You can use {\tt coqdoc}.
+
+\Question{How can I generate some HTML from my development?}
+
+You can use {\tt coqdoc}.
+
+\Question{How can I generate some dependency graph from my development?}
+
+\Question{How can I cite some {\Coq} in my latex document?}
+
+You can use {\tt coq\_tex}.
+
+\Question{How can I cite the {\Coq} reference manual?}
+
+You can use this bibtex entry:
+\begin{verbatim}
+@Manual{Coq:manual,
+  title =        {The Coq proof assistant reference manual},
+  author =       {\mbox{The Coq development team}},
+  organization = {LogiCal Project},
+  note =         {Version 8.0},
+  year =         {2004},
+  url =          "http://coq.inria.fr"
+}
+\end{verbatim}
+
+\Question{Where can I publish my developments in {\Coq}?}
+
+You can submit your developments as a user contribution to the {\Coq}
+development team. This ensures its liveness along the evolution and
+possible changes of {\Coq}.
+
+You can also submit your developments to the HELM/MoWGLI repository at
+the University of Bologna (see
+\ahref{http://mowgli.cs.unibo.it}{\url{http://mowgli.cs.unibo.it}}). For
+developments submitted in this database, it is possible to visualize
+the developments in natural language and execute various retrieving
+requests.
+
+\Question{How can I read my proof in natural language?}
+
+You can submit your proof to the HELM/MoWGLI repository and use the
+rendering tool provided by the server (see
+\ahref{http://mowgli.cs.unibo.it}{\url{http://mowgli.cs.unibo.it}}).
+
+\section{\CoqIde}
+
+\Question{What is {\CoqIde}?}
+
+{\CoqIde} is a gtk based GUI for \Coq.
+
+\Question{How to enable Emacs keybindings?}
+ Insert \texttt{gtk-key-theme-name = "Emacs"}
+    in your \texttt{.coqide-gtk2rc} file. It may be in the current dir
+    or in \verb#$HOME# dir. This is done by default.
+
+%$ juste pour que la coloration emacs marche
+
+\Question{How to enable antialiased fonts?}
+
+ Set the \verb#GDK_USE_XFT# variable to \verb#1#. This is by default with \verb#Gtk >= 2.2#.
+    If some of your fonts are not available, set \verb#GDK_USE_XFT# to \verb#0#.
+
+\Question{How to use those Forall and Exists pretty symbols?}\label{forallcoqide}
+ Thanks to the notation features in \Coq, you just need to insert these
+lines in your {\Coq} buffer:\\
+\begin{texttt}
+Notation "$\forall$ x : t, P" := (forall x:t, P) (at level 200, x ident).
+\end{texttt}\\
+\begin{texttt}
+Notation "$\exists$ x : t, P" := (exists x:t, P) (at level 200, x ident).
+\end{texttt}
+
+Copy/Paste of these lines from this file will not work outside of \CoqIde.
+You need to load a file containing these lines or to enter the $\forall$
+using an input method (see \ref{inputmeth}). To try it just use \verb#Require Import utf8# from inside
+\CoqIde. 
+To enable these notations automatically start coqide with
+\begin{verbatim}
+	coqide -l utf8
+\end{verbatim}
+In the ide subdir of {\Coq} library, you will find a sample utf8.v with some 
+pretty simple notations.
+
+\Question{How to define an input method for non ASCII symbols?}\label{inputmeth}
+
+\begin{itemize}
+\item First solution: type \verb#<CONTROL><SHIFT>2200# to enter a forall in the script widow. 
+	2200 is the hexadecimal code for forall in unicode charts and is encoded as 	
+	in UTF-8.
+	2203 is for exists. See \ahref{http://www.unicode.org}{\url{http://www.unicode.org}} for more codes.
+\item Second solution: rebind \verb#<AltGr>a# to forall and \verb#<AltGr>e# to exists. 
+	Under X11, you need to use something like
+\begin{verbatim}
+		xmodmap -e "keycode  24 = a A F13 F13" 
+		xmodmap -e "keycode  26 = e E F14 F14"
+\end{verbatim}
+	and then to add   
+\begin{verbatim}
+		bind "F13" {"insert-at-cursor" ("")}
+		bind "F14" {"insert-at-cursor" ("")}
+\end{verbatim}
+	to your "binding "text"" section in \verb#.coqiderc-gtk2rc.#
+	The strange ("") argument is the UTF-8 encoding for
+	0x2200. 
+	You can compute these encodings using the lablgtk2 toplevel with 
+\begin{verbatim}		
+Glib.Utf8.from_unichar 0x2200;;
+\end{verbatim}
+	Further symbols can be bound on higher Fxx keys or on even on other keys you
+	do not need .
+\end{itemize}
+
+\Question{How to build a custom {\CoqIde} with user ml code?}
+ Use 
+	coqmktop -ide -byte m1.cmo...mi.cmo
+    or 
+	coqmktop -ide -opt m1.cmx...mi.cmx
+
+\Question{How to customize the shortcuts for menus?}
+ Two solutions are offered:
+\begin{itemize}
+\item Edit \$HOME/.coqide.keys by hand or
+\item Add "gtk-can-change-accels = 1" in your .coqide-gtk2rc file. Then
+    from \CoqIde, you may select a menu entry and press the desired 
+    shortcut. 
+\end{itemize}
+
+\Question{What encoding should I use? What is this $\backslash$x\{iiii\} in my file?}
+ The encoding option is related to the way files are saved. 
+ Keep it as UTF-8 until it becomes important for you to exchange files 
+ with non UTF-8 aware applications.
+ If you choose something else than UTF-8, then missing characters will 
+ be encoded by $\backslash$x\{....\} or $\backslash$x\{........\}
+ where each dot is an hex. digit. 
+ The number between braces is the hexadecimal UNICODE index for the
+  missing character.
+    
+
+
+
+\section{Extraction}
+
+\Question{What is program extraction?}
+
+Program extraction consist in generating a program from a constructive proof.
+
+\Question{Which language can I extract to?}
+
+You can extract your programs to Objective Caml and Haskell.
+
+\Question{How can I extract an incomplete proof?}
+
+You can provide programs for your axioms.
+
+
+
+%%%%%%%
+\section{Glossary}
+
+\Question{Can you explain me what an evaluable constant is?}
+
+An evaluable constant is a constant which is unfoldable.
+
+\Question{What is a goal?}
+
+The goal is the statement to be proved.
+
+\Question{What is a meta variable?}
+
+A meta variable in {\Coq} represents a ``hole'', i.e. a part of a proof
+that is still unknown. 
+
+\Question{What is Gallina?}  
+
+Gallina is the specification language of \Coq. Complete documentation
+of this language can be found in the Reference Manual.
+
+\Question{What is The Vernacular?}  
+
+It is the language of commands of Gallina i.e. definitions, lemmas, {\ldots}  
+
+
+\Question{What is a dependent type?}
+
+A dependant type is a type which depends on some term. For instance
+``vector of size n'' is a dependant type representing all the vectors
+of size $n$. Its type depends on $n$
+
+\Question{What is a proof by reflection?}
+
+This is a proof generated by some computation which is done using the
+internal reduction of {\Coq} (not using the tactic language of {\Coq}
+(\Ltac) nor the implementation language for \Coq).  An example of
+tactic using the reflection mechanism is the {\ring} tactic. The
+reflection method consist in reflecting a subset of {\Coq} language (for
+example the arithmetical expressions) into an object of the \Coq
+language itself (in this case an inductive type denoting arithmetical
+expressions).  For more information see~\cite{howe,harrison,boutin}
+and the last chapter of the Coq'Art.
+
+\Question{What is intuitionistic logic?}
+
+This is any logic which does not assume that ``A or not A''.
+
+
+\Question{What is proof-irrelevance?}
+
+See question \ref{proof-irrelevance}
+
+
+\Question{What is the difference between opaque and transparent?}{\label{opaque}}	
+
+Opaque definitions can not be unfolded but transparent ones can.
+
+
+\section{Troubleshooting}
+
+\Question{What can I do when {\tt Qed.} is slow?}
+
+Sometime you can use the {\abstracttac} tactic, which makes as if you had
+stated some local lemma, this speeds up the typing process.
+
+\Question{Why \texttt{Reset Initial.} does not work when using \texttt{coqc}?}
+
+The initial state corresponds to the state of coqtop when the interactive
+session began. It does not make sense in files to compile.
+
+
+\Question{What can I do if I get ``No more subgoals but non-instantiated existential variables''?}
+
+This means that {\eauto} or {\eapply} didn't instantiate an
+existential variable which eventually got erased by some computation.
+You have to backtrack to the faulty occurrence of {\eauto} or
+{\eapply} and give the missing argument an explicit value.
+
+\Question{What can I do if I get ``Cannot solve a second-order unification problem''?}
+
+You can help {\Coq} using the {\pattern} tactic.
+
+\Question{Why does {\Coq} tell me that \texttt{\{x:A|(P x)\}} is not convertible with \texttt{(sig A P)}?}
+
+ This is because \texttt{\{x:A|P x\}} is a notation for
+\texttt{sig (fun x:A => P x)}. Since {\Coq} does not reason up to
+$\eta$-conversion, this is different from \texttt{sig P}.
+
+
+\Question{I copy-paste a term and {\Coq} says it is not convertible
+  to the original term. Sometimes it even says the copied term is not
+well-typed.}
+
+ This is probably due to invisible implicit information (implicit
+arguments, coercions and Cases annotations) in the printed term, which
+is not re-synthesised from the copied-pasted term in the same way as
+it is in the original term.
+
+  Consider for instance {\tt (@eq Type True True)}. This term is
+printed as {\tt True=True} and re-parsed as {\tt (@eq Prop True
+True)}. The two terms are not convertible (hence they fool tactics
+like {\tt pattern}).
+
+  There is currently no satisfactory answer to the problem. However,
+the command {\tt Set Printing All} is useful for diagnosing the
+problem.
+ 
+  Due to coercions, one may even face type-checking errors. In some
+rare cases, the criterion to hide coercions is a bit too loose, which
+may result in a typing error message if the parser is not able to find
+again the missing coercion.
+
+
+
+\section{Conclusion and Farewell.}
+\label{ccl}
+
+\Question{What if my question isn't answered here?} 
+\label{lastquestion}
+
+Don't panic \verb+:-)+. You can try the {\Coq} manual~\cite{Coq:manual} for a technical
+description of the prover. The Coq'Art~\cite{Coq:coqart} is the first
+book written on {\Coq} and provides a comprehensive review of the
+theorem prover as well as a number of example and exercises. Finally,
+the tutorial~\cite{Coq:Tutorial} provides a smooth introduction to
+theorem proving in \Coq.
+
+
+%%%%%%%
+\newpage
+\nocite{LaTeX:intro}
+\nocite{LaTeX:symb}
+\bibliography{fk}
+
+%%%%%%%
+\typeout{*********************************************}
+\typeout{********* That makes \thequestion{\space} questions **********}
+\typeout{*********************************************}
+
+\end{document}
diff --git a/doc/faq/axioms.eps b/doc/faq/axioms.eps
new file mode 100644
index 00000000..3f3c01c4
--- /dev/null
+++ b/doc/faq/axioms.eps
@@ -0,0 +1,378 @@
+%!PS-Adobe-2.0 EPSF-2.0
+%%Title: axioms.fig
+%%Creator: fig2dev Version 3.2 Patchlevel 4
+%%CreationDate: Wed May  5 18:30:03 2004
+%%For: herbelin@limoux.polytechnique.fr (Hugo Herbelin)
+%%BoundingBox: 0 0 437 372
+%%Magnification: 1.0000
+%%EndComments
+/$F2psDict 200 dict def
+$F2psDict begin
+$F2psDict /mtrx matrix put
+/col-1 {0 setgray} bind def
+/col0 {0.000 0.000 0.000 srgb} bind def
+/col1 {0.000 0.000 1.000 srgb} bind def
+/col2 {0.000 1.000 0.000 srgb} bind def
+/col3 {0.000 1.000 1.000 srgb} bind def
+/col4 {1.000 0.000 0.000 srgb} bind def
+/col5 {1.000 0.000 1.000 srgb} bind def
+/col6 {1.000 1.000 0.000 srgb} bind def
+/col7 {1.000 1.000 1.000 srgb} bind def
+/col8 {0.000 0.000 0.560 srgb} bind def
+/col9 {0.000 0.000 0.690 srgb} bind def
+/col10 {0.000 0.000 0.820 srgb} bind def
+/col11 {0.530 0.810 1.000 srgb} bind def
+/col12 {0.000 0.560 0.000 srgb} bind def
+/col13 {0.000 0.690 0.000 srgb} bind def
+/col14 {0.000 0.820 0.000 srgb} bind def
+/col15 {0.000 0.560 0.560 srgb} bind def
+/col16 {0.000 0.690 0.690 srgb} bind def
+/col17 {0.000 0.820 0.820 srgb} bind def
+/col18 {0.560 0.000 0.000 srgb} bind def
+/col19 {0.690 0.000 0.000 srgb} bind def
+/col20 {0.820 0.000 0.000 srgb} bind def
+/col21 {0.560 0.000 0.560 srgb} bind def
+/col22 {0.690 0.000 0.690 srgb} bind def
+/col23 {0.820 0.000 0.820 srgb} bind def
+/col24 {0.500 0.190 0.000 srgb} bind def
+/col25 {0.630 0.250 0.000 srgb} bind def
+/col26 {0.750 0.380 0.000 srgb} bind def
+/col27 {1.000 0.500 0.500 srgb} bind def
+/col28 {1.000 0.630 0.630 srgb} bind def
+/col29 {1.000 0.750 0.750 srgb} bind def
+/col30 {1.000 0.880 0.880 srgb} bind def
+/col31 {1.000 0.840 0.000 srgb} bind def
+
+end
+save
+newpath 0 372 moveto 0 0 lineto 437 0 lineto 437 372 lineto closepath clip newpath
+-90.0 435.2 translate
+1 -1 scale
+
+/cp {closepath} bind def
+/ef {eofill} bind def
+/gr {grestore} bind def
+/gs {gsave} bind def
+/sa {save} bind def
+/rs {restore} bind def
+/l {lineto} bind def
+/m {moveto} bind def
+/rm {rmoveto} bind def
+/n {newpath} bind def
+/s {stroke} bind def
+/sh {show} bind def
+/slc {setlinecap} bind def
+/slj {setlinejoin} bind def
+/slw {setlinewidth} bind def
+/srgb {setrgbcolor} bind def
+/rot {rotate} bind def
+/sc {scale} bind def
+/sd {setdash} bind def
+/ff {findfont} bind def
+/sf {setfont} bind def
+/scf {scalefont} bind def
+/sw {stringwidth} bind def
+/tr {translate} bind def
+/tnt {dup dup currentrgbcolor
+  4 -2 roll dup 1 exch sub 3 -1 roll mul add
+  4 -2 roll dup 1 exch sub 3 -1 roll mul add
+  4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb}
+  bind def
+/shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul
+  4 -2 roll mul srgb} bind def
+/reencdict 12 dict def /ReEncode { reencdict begin
+/newcodesandnames exch def /newfontname exch def /basefontname exch def
+/basefontdict basefontname findfont def /newfont basefontdict maxlength dict def
+basefontdict { exch dup /FID ne { dup /Encoding eq
+{ exch dup length array copy newfont 3 1 roll put }
+{ exch newfont 3 1 roll put } ifelse } { pop pop } ifelse } forall
+newfont /FontName newfontname put newcodesandnames aload pop
+128 1 255 { newfont /Encoding get exch /.notdef put } for
+newcodesandnames length 2 idiv { newfont /Encoding get 3 1 roll put } repeat
+newfontname newfont definefont pop end } def
+/isovec [
+8#055 /minus 8#200 /grave 8#201 /acute 8#202 /circumflex 8#203 /tilde
+8#204 /macron 8#205 /breve 8#206 /dotaccent 8#207 /dieresis
+8#210 /ring 8#211 /cedilla 8#212 /hungarumlaut 8#213 /ogonek 8#214 /caron
+8#220 /dotlessi 8#230 /oe 8#231 /OE
+8#240 /space 8#241 /exclamdown 8#242 /cent 8#243 /sterling
+8#244 /currency 8#245 /yen 8#246 /brokenbar 8#247 /section 8#250 /dieresis
+8#251 /copyright 8#252 /ordfeminine 8#253 /guillemotleft 8#254 /logicalnot
+8#255 /hyphen 8#256 /registered 8#257 /macron 8#260 /degree 8#261 /plusminus
+8#262 /twosuperior 8#263 /threesuperior 8#264 /acute 8#265 /mu 8#266 /paragraph
+8#267 /periodcentered 8#270 /cedilla 8#271 /onesuperior 8#272 /ordmasculine
+8#273 /guillemotright 8#274 /onequarter 8#275 /onehalf
+8#276 /threequarters 8#277 /questiondown 8#300 /Agrave 8#301 /Aacute
+8#302 /Acircumflex 8#303 /Atilde 8#304 /Adieresis 8#305 /Aring
+8#306 /AE 8#307 /Ccedilla 8#310 /Egrave 8#311 /Eacute
+8#312 /Ecircumflex 8#313 /Edieresis 8#314 /Igrave 8#315 /Iacute
+8#316 /Icircumflex 8#317 /Idieresis 8#320 /Eth 8#321 /Ntilde 8#322 /Ograve
+8#323 /Oacute 8#324 /Ocircumflex 8#325 /Otilde 8#326 /Odieresis 8#327 /multiply
+8#330 /Oslash 8#331 /Ugrave 8#332 /Uacute 8#333 /Ucircumflex
+8#334 /Udieresis 8#335 /Yacute 8#336 /Thorn 8#337 /germandbls 8#340 /agrave
+8#341 /aacute 8#342 /acircumflex 8#343 /atilde 8#344 /adieresis 8#345 /aring
+8#346 /ae 8#347 /ccedilla 8#350 /egrave 8#351 /eacute
+8#352 /ecircumflex 8#353 /edieresis 8#354 /igrave 8#355 /iacute
+8#356 /icircumflex 8#357 /idieresis 8#360 /eth 8#361 /ntilde 8#362 /ograve
+8#363 /oacute 8#364 /ocircumflex 8#365 /otilde 8#366 /odieresis 8#367 /divide
+8#370 /oslash 8#371 /ugrave 8#372 /uacute 8#373 /ucircumflex
+8#374 /udieresis 8#375 /yacute 8#376 /thorn 8#377 /ydieresis] def
+/Times-Roman /Times-Roman-iso isovec ReEncode
+/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def
+/$F2psEnd {$F2psEnteredState restore end} def
+
+$F2psBegin
+10 setmiterlimit
+0 slj 0 slc
+ 0.06000 0.06000 sc
+%
+% Fig objects follow
+%
+% 
+% here starts figure with depth 50
+% Arc
+7.500 slw
+gs  clippath
+3599 6933 m 3626 6879 l 3492 6812 l 3586 6893 l 3465 6865 l cp
+eoclip
+n 3600.0 6750.0 150.0 90.0 -90.0 arc
+gs col0 s gr
+ gr
+
+% arrowhead
+n 3465 6865 m 3586 6893 l 3492 6812 l 3465 6865 l  cp gs 0.00 setgray ef gr  col0 s
+% Arc
+gs  clippath
+3599 6633 m 3626 6579 l 3492 6512 l 3586 6593 l 3465 6565 l cp
+eoclip
+n 3600.0 6450.0 150.0 90.0 -90.0 arc
+gs col0 s gr
+ gr
+
+% arrowhead
+n 3465 6565 m 3586 6593 l 3492 6512 l 3465 6565 l  cp gs 0.00 setgray ef gr  col0 s
+% Arc
+gs  clippath
+3626 6020 m 3599 5966 l 3465 6034 l 3586 6007 l 3492 6087 l cp
+3599 6333 m 3626 6279 l 3492 6212 l 3586 6293 l 3465 6265 l cp
+eoclip
+n 3600.0 6150.0 150.0 90.0 -90.0 arc
+gs col0 s gr
+ gr
+
+% arrowhead
+n 3492 6087 m 3586 6007 l 3465 6034 l 3492 6087 l  cp gs 0.00 setgray ef gr  col0 s
+% arrowhead
+n 3465 6265 m 3586 6293 l 3492 6212 l 3465 6265 l  cp gs 0.00 setgray ef gr  col0 s
+% Arc
+gs  clippath
+3626 6320 m 3599 6266 l 3465 6334 l 3586 6307 l 3492 6387 l cp
+3599 6633 m 3626 6579 l 3492 6512 l 3586 6593 l 3465 6565 l cp
+eoclip
+n 3600.0 6450.0 150.0 90.0 -90.0 arc
+gs col0 s gr
+ gr
+
+% arrowhead
+n 3492 6387 m 3586 6307 l 3465 6334 l 3492 6387 l  cp gs 0.00 setgray ef gr  col0 s
+% arrowhead
+n 3465 6565 m 3586 6593 l 3492 6512 l 3465 6565 l  cp gs 0.00 setgray ef gr  col0 s
+% Arc
+gs  clippath
+3626 6620 m 3599 6566 l 3465 6634 l 3586 6607 l 3492 6687 l cp
+3599 6933 m 3626 6879 l 3492 6812 l 3586 6893 l 3465 6865 l cp
+eoclip
+n 3600.0 6750.0 150.0 90.0 -90.0 arc
+gs col0 s gr
+ gr
+
+% arrowhead
+n 3492 6687 m 3586 6607 l 3465 6634 l 3492 6687 l  cp gs 0.00 setgray ef gr  col0 s
+% arrowhead
+n 3465 6865 m 3586 6893 l 3492 6812 l 3465 6865 l  cp gs 0.00 setgray ef gr  col0 s
+% Arc
+gs  clippath
+3626 6920 m 3599 6866 l 3465 6934 l 3586 6907 l 3492 6987 l cp
+3599 7233 m 3626 7179 l 3492 7112 l 3586 7193 l 3465 7165 l cp
+eoclip
+n 3600.0 7050.0 150.0 90.0 -90.0 arc
+gs col0 s gr
+ gr
+
+% arrowhead
+n 3492 6987 m 3586 6907 l 3465 6934 l 3492 6987 l  cp gs 0.00 setgray ef gr  col0 s
+% arrowhead
+n 3465 7165 m 3586 7193 l 3492 7112 l 3465 7165 l  cp gs 0.00 setgray ef gr  col0 s
+% Arc
+gs  clippath
+4168 4060 m 4227 4068 l 4247 3919 l 4202 4034 l 4188 3911 l cp
+eoclip
+n 14032.5 5272.5 9908.2 -159.9 -172.9 arcn
+gs col0 s gr
+ gr
+
+% arrowhead
+n 4188 3911 m 4202 4034 l 4247 3919 l 4188 3911 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+gs  clippath
+4170 5790 m 4230 5790 l 4230 5639 l 4200 5759 l 4170 5639 l cp
+eoclip
+n 4200 5175 m
+ 4200 5775 l gs col0 s gr gr
+
+% arrowhead
+n 4170 5639 m 4200 5759 l 4230 5639 l 4170 5639 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+gs  clippath
+4553 5749 m 4567 5807 l 4714 5771 l 4591 5771 l 4700 5713 l cp
+eoclip
+n 7050 5175 m
+ 4575 5775 l gs col0 s gr gr
+
+% arrowhead
+n 4700 5713 m 4591 5771 l 4714 5771 l 4700 5713 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+gs  clippath
+4170 4890 m 4230 4890 l 4230 4739 l 4200 4859 l 4170 4739 l cp
+eoclip
+n 4200 4275 m
+ 4200 4875 l gs col0 s gr gr
+
+% arrowhead
+n 4170 4739 m 4200 4859 l 4230 4739 l 4170 4739 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+gs  clippath
+7131 4907 m 7147 4850 l 7001 4810 l 7109 4871 l 6985 4868 l cp
+eoclip
+n 4950 4275 m
+ 7125 4875 l gs col0 s gr gr
+
+% arrowhead
+n 6985 4868 m 7109 4871 l 7001 4810 l 6985 4868 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+gs  clippath
+7167 4057 m 7225 4071 l 7262 3924 l 7204 4034 l 7204 3910 l cp
+eoclip
+n 7725 1950 m
+ 7200 4050 l gs col0 s gr gr
+
+% arrowhead
+n 7204 3910 m 7204 4034 l 7262 3924 l 7204 3910 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+n 4350 3075 m
+ 7350 1950 l gs col0 s gr 
+% Polyline
+gs  clippath
+7170 4890 m 7230 4890 l 7230 4739 l 7200 4859 l 7170 4739 l cp
+eoclip
+n 7200 4275 m
+ 7200 4875 l gs col0 s gr gr
+
+% arrowhead
+n 7170 4739 m 7200 4859 l 7230 4739 l 7170 4739 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+n 3075 1875 m
+ 3975 1875 l gs col0 s gr 
+% Polyline
+gs  clippath
+5520 4065 m 5580 4065 l 5580 3914 l 5550 4034 l 5520 3914 l cp
+5580 3660 m 5520 3660 l 5520 3811 l 5550 3691 l 5580 3811 l cp
+eoclip
+n 5550 3675 m
+ 5550 4050 l gs col0 s gr gr
+
+% arrowhead
+n 5580 3811 m 5550 3691 l 5520 3811 l 5580 3811 l  cp gs 0.00 setgray ef gr  col0 s
+% arrowhead
+n 5520 3914 m 5550 4034 l 5580 3914 l 5520 3914 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+n 4575 4050 m
+ 6450 4050 l gs col0 s gr 
+% Polyline
+gs  clippath
+3495 2265 m 3555 2265 l 3555 2114 l 3525 2234 l 3495 2114 l cp
+3555 1860 m 3495 1860 l 3495 2011 l 3525 1891 l 3555 2011 l cp
+eoclip
+n 3525 1875 m
+ 3525 2250 l gs col0 s gr gr
+
+% arrowhead
+n 3555 2011 m 3525 1891 l 3495 2011 l 3555 2011 l  cp gs 0.00 setgray ef gr  col0 s
+% arrowhead
+n 3495 2114 m 3525 2234 l 3555 2114 l 3495 2114 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+gs  clippath
+2219 3988 m 2279 3991 l 2285 3840 l 2251 3959 l 2225 3838 l cp
+eoclip
+n 2325 1875 m
+ 2250 3975 l gs col0 s gr gr
+
+% arrowhead
+n 2225 3838 m 2251 3959 l 2285 3840 l 2225 3838 l  cp gs 0.00 setgray ef gr  col0 s
+% Polyline
+n 7800 1275 m
+ 2100 1275 l gs col0 s gr 
+/Times-Roman-iso ff 180.00 scf sf
+6600 5100 m
+gs 1 -1 sc (Proof-irrelevance) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3675 4200 m
+gs 1 -1 sc (Excluded-middle) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+6900 1800 m
+gs 1 -1 sc (Predicate extensionality) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3375 3525 m
+gs 1 -1 sc (\(Diaconescu\)) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+4650 3600 m
+gs 1 -1 sc (Propositional degeneracy) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3825 1800 m
+gs 1 -1 sc (Relational choice axiom) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+1725 1800 m
+gs 1 -1 sc (Description principle) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+2550 2400 m
+gs 1 -1 sc (Functional choice axiom) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3600 5100 m
+gs 1 -1 sc (Decidability of equality on $A$) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+4425 4575 m
+gs 1 -1 sc (\(needs Prop-impredicativity\)) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+5025 4725 m
+gs 1 -1 sc (\(Berardi\)) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+1500 3075 m
+gs 1 -1 sc (\(if Set impredicative\)) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+1500 4200 m
+gs 1 -1 sc (Not excluded-middle) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3600 6000 m
+gs 1 -1 sc (Axiom K on A) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3600 7200 m
+gs 1 -1 sc (Invariance by substitution of reflexivity proofs for equality on A) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+6150 4200 m
+gs 1 -1 sc (Propositional extensionality) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+2100 1200 m
+gs 1 -1 sc (The dependency graph of axioms in the Calculus of Inductive Constructions) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3600 6900 m
+gs 1 -1 sc (Injectivity of equality on sigma-types on A) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3600 6300 m
+gs 1 -1 sc (Uniqueness of reflexivity proofs for equality on A) col0 sh gr
+/Times-Roman-iso ff 180.00 scf sf
+3600 6600 m
+gs 1 -1 sc (Uniqueness of equality proofs on A) col0 sh gr
+% here ends figure;
+$F2psEnd
+rs
+showpage
diff --git a/doc/faq/axioms.fig b/doc/faq/axioms.fig
new file mode 100644
index 00000000..f0775930
--- /dev/null
+++ b/doc/faq/axioms.fig
@@ -0,0 +1,84 @@
+#FIG 3.2
+Landscape
+Center
+Inches
+Letter  
+100.00
+Single
+-2
+1200 2
+5 1 0 1 0 7 50 -1 -1 0.000 0 0 0 1 3600.000 6750.000 3600 6900 3450 6750 3600 6600
+	1 1 1.00 60.00 120.00
+5 1 0 1 0 7 50 -1 -1 0.000 0 0 0 1 3600.000 6450.000 3600 6600 3450 6450 3600 6300
+	1 1 1.00 60.00 120.00
+5 1 0 1 0 7 50 -1 -1 0.000 0 0 1 1 3600.000 6150.000 3600 6300 3450 6150 3600 6000
+	1 1 1.00 60.00 120.00
+	1 1 1.00 60.00 120.00
+5 1 0 1 0 7 50 -1 -1 0.000 0 0 1 1 3600.000 6450.000 3600 6600 3450 6450 3600 6300
+	1 1 1.00 60.00 120.00
+	1 1 1.00 60.00 120.00
+5 1 0 1 0 7 50 -1 -1 0.000 0 0 1 1 3600.000 6750.000 3600 6900 3450 6750 3600 6600
+	1 1 1.00 60.00 120.00
+	1 1 1.00 60.00 120.00
+5 1 0 1 0 7 50 -1 -1 0.000 0 0 1 1 3600.000 7050.000 3600 7200 3450 7050 3600 6900
+	1 1 1.00 60.00 120.00
+	1 1 1.00 60.00 120.00
+5 1 0 1 0 7 50 -1 -1 0.000 0 1 1 0 14032.500 5272.500 4725 1875 4425 2850 4200 4050
+	1 1 1.00 60.00 120.00
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	1 1 1.00 60.00 120.00
+	 4200 5175 4200 5775
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	1 1 1.00 60.00 120.00
+	 7050 5175 4575 5775
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	1 1 1.00 60.00 120.00
+	 4200 4275 4200 4875
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	1 1 1.00 60.00 120.00
+	 4950 4275 7125 4875
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	1 1 1.00 60.00 120.00
+	 7725 1950 7200 4050
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
+	 4350 3075 7350 1950
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	1 1 1.00 60.00 120.00
+	 7200 4275 7200 4875
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
+	 3075 1875 3975 1875
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
+	1 1 1.00 60.00 120.00
+	1 1 1.00 60.00 120.00
+	 5550 3675 5550 4050
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
+	 4575 4050 6450 4050
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
+	1 1 1.00 60.00 120.00
+	1 1 1.00 60.00 120.00
+	 3525 1875 3525 2250
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
+	1 1 1.00 60.00 120.00
+	 2325 1875 2250 3975
+2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
+	 7800 1275 2100 1275
+4 0 0 50 -1 0 12 0.0000 4 135 1305 6600 5100 Proof-irrelevance\001
+4 0 0 50 -1 0 12 0.0000 4 135 1260 3675 4200 Excluded-middle\001
+4 0 0 50 -1 0 12 0.0000 4 180 1830 6900 1800 Predicate extensionality\001
+4 0 0 50 -1 0 12 0.0000 4 180 1050 3375 3525 (Diaconescu)\001
+4 0 0 50 -1 0 12 0.0000 4 180 1905 4650 3600 Propositional degeneracy\001
+4 0 0 50 -1 0 12 0.0000 4 135 1800 3825 1800 Relational choice axiom\001
+4 0 0 50 -1 0 12 0.0000 4 180 1575 1725 1800 Description principle\001
+4 0 0 50 -1 0 12 0.0000 4 135 1830 2550 2400 Functional choice axiom\001
+4 0 0 50 -1 0 12 0.0000 4 195 2340 3600 5100 Decidability of equality on $A$\001
+4 0 0 50 -1 0 12 0.0000 4 180 2175 4425 4575 (needs Prop-impredicativity)\001
+4 0 0 50 -1 0 12 0.0000 4 180 705 5025 4725 (Berardi)\001
+4 0 0 50 -1 0 12 0.0000 4 180 1620 1500 3075 (if Set impredicative)\001
+4 0 0 50 -1 0 12 0.0000 4 135 1560 1500 4200 Not excluded-middle\001
+4 0 0 50 -1 0 12 0.0000 4 135 1080 3600 6000 Axiom K on A\001
+4 0 0 50 -1 0 12 0.0000 4 180 4800 3600 7200 Invariance by substitution of reflexivity proofs for equality on A\001
+4 0 0 50 -1 0 12 0.0000 4 180 2100 6150 4200 Propositional extensionality\001
+4 0 0 50 -1 0 12 0.0000 4 180 5700 2100 1200 The dependency graph of axioms in the Calculus of Inductive Constructions\001
+4 0 0 50 -1 0 12 0.0000 4 180 3210 3600 6900 Injectivity of equality on sigma-types on A\001
+4 0 0 50 -1 0 12 0.0000 4 180 3735 3600 6300 Uniqueness of reflexivity proofs for equality on A\001
+4 0 0 50 -1 0 12 0.0000 4 180 2670 3600 6600 Uniqueness of equality proofs on A\001
diff --git a/doc/faq/axioms.png b/doc/faq/axioms.png
new file mode 100644
index 00000000..2aee0916
--- /dev/null
+++ b/doc/faq/axioms.png
diff --git a/doc/faq/fk.bib b/doc/faq/fk.bib
new file mode 100644
index 00000000..d41ab7f0
--- /dev/null
+++ b/doc/faq/fk.bib
@@ -0,0 +1,2221 @@
+%%%%%%% FAQ %%%%%%%
+
+@book{ProofsTypes,
+  Author="Girard, Jean-Yves and Yves Lafont and Paul Taylor",
+  Title="Proofs and Types",
+  Publisher="Cambrige Tracts in Theoretical Computer Science, Cambridge University Press",
+  Year="1989"
+}
+
+@misc{Types:Dowek,
+  author = "Gilles Dowek",
+  title = "Th{\'e}orie des types",
+  year = 2002,
+  howpublished = "Lecture notes",
+  url= "http://www.lix.polytechnique.fr/~dowek/Cours/theories_des_types.ps.gz"
+}
+
+@PHDTHESIS{EGThese,
+  author = {Eduardo Giménez},
+  title = {Un Calcul de Constructions Infinies et son application
+a la vérification de systèmes communicants},
+  type = {thèse d'Université},
+  school = {Ecole Normale Supérieure de Lyon},
+  month = {December},
+  year = {1996},
+}
+
+
+%%%%%%% Semantique %%%%%%%
+
+@misc{Sem:cours,
+  author = "François Pottier",
+  title =  "{Typage et Programmation}",
+  year = "2002",
+  howpublished = "Lecture notes",
+  note = "DEA PSPL"
+}
+
+@inproceedings{Sem:Dubois,
+  author    = {Catherine Dubois},
+  editor    = {Mark Aagaard and
+               John Harrison},
+  title     = "{Proving ML Type Soundness Within Coq}",
+  pages     = {126-144},
+  booktitle = {TPHOLs},
+  publisher = {Springer},
+  series    = {Lecture Notes in Computer Science},
+  volume    = {1869},
+  year      = {2000},
+  isbn      = {3-540-67863-8},
+  bibsource = {DBLP, http://dblp.uni-trier.de}
+}
+
+@techreport{Sem:Plotkin, 
+author = {Gordon D. Plotkin}, 
+institution = {Aarhus University}, 
+number = {{DAIMI FN-19}}, 
+title = {{A structural approach to operational semantics}}, 
+year = {1981} 
+} 
+
+@article{Sem:RemyV98,
+  author     = "Didier R{\'e}my and J{\'e}r{\^o}me Vouillon",
+  title =        "Objective {ML}: 
+                  An effective object-oriented extension to {ML}",
+  journal =      "Theory And Practice of Object Systems",
+  year =         1998,
+  volume =    "4",
+  number =    "1",
+  pages =     "27--50",
+  note =      {A preliminary version appeared in the proceedings
+                  of the 24th ACM Conference on Principles
+                  of Programming Languages, 1997}
+}
+
+@book{Sem:Winskel,
+  AUTHOR      = {Winskel, Glynn},
+  TITLE       = {The Formal Semantics of Programming Languages},
+  NOTE        = {WIN g2 93:1 P-Ex},
+  YEAR        = {1993},
+  PUBLISHER   = {The MIT Press},
+  SERIES      = {Foundations of Computing},
+ }
+
+@Article{Sem:WrightFelleisen,
+  refkey =       "C1210",
+  title =        "A Syntactic Approach to Type Soundness",
+  author =       "Andrew K. Wright and Matthias Felleisen",
+  pages =        "38--94",
+  journal =      "Information and Computation",
+  month =        "15~" # nov,
+  year =         "1994",
+  volume =       "115",
+  number =       "1"
+}
+
+@inproceedings{Sem:Nipkow-MOD,
+  author={Tobias Nipkow},
+  title={Jinja: Towards a Comprehensive Formal Semantics for a
+       {J}ava-like Language},
+  booktitle={Proc.\ Marktobderdorf Summer School 2003},
+  publisher={IOS Press},editor={H. Schwichtenberg and K. Spies},
+  year=2003,
+  note={To appear}
+}
+
+%%%%%%% Coq %%%%%%%
+
+@book{Coq: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
+}
+			 
+@phdthesis{Coq:Del01,
+	AUTHOR = "David Delahaye",
+	TITLE = "Conception de langages pour décrire les preuves et les 
+                  automatisations dans les outils d'aide à la preuve",
+	SCHOOL = {Universit\'e Paris~6},
+	YEAR = "2001",
+        Type = {Th\`ese de Doctorat}
+}
+
+@techreport{Coq:gimenez-tut,
+    author = "Eduardo Gim\'enez",
+    title = "A Tutorial on Recursive Types in Coq",
+    number = "RT-0221",
+    pages = "42 p.",
+    url = "citeseer.nj.nec.com/gimenez98tutorial.html" }
+
+@phdthesis{Coq:Mun97,
+	AUTHOR = "César Mu{\~{n}}oz",
+	TITLE = "Un calcul de substitutions pour la repr\'esentation
+                  de preuves partielles en th\'eorie de types",
+	SCHOOL = {Universit\'e Paris~7},
+        Number = {Unit\'e de recherche INRIA-Rocquencourt, TU-0488},
+	YEAR = "1997",
+        Note = {English version available as INRIA research report RR-3309},
+        Type = {Th\`ese de Doctorat}
+}
+
+@PHDTHESIS{Coq:Filliatre99,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{Preuve de programmes imp\'eratifs en th\'eorie des types}},
+  TYPE = {Th{\`e}se de Doctorat},
+  SCHOOL = {Universit\'e Paris-Sud},
+  YEAR = 1999,
+  MONTH = {July},
+}
+
+@manual{Coq:Tutorial,
+  AUTHOR = {G\'erard Huet and Gilles Kahn and Christine Paulin-Mohring},
+  TITLE = {{The Coq Proof Assistant A Tutorial}},
+  YEAR = 2004  
+}
+
+%%%%%%% PVS %%%%%%%
+
+@manual{PVS:prover,
+  title =        "{PVS} Prover Guide",
+  author =       "N. Shankar and S. Owre and J. M. Rushby and D. W. J.
+                 Stringer-Calvert",
+  month =        sep,
+  year =         "1999",
+  organization = "Computer Science Laboratory, SRI International",
+  address =      "Menlo Park, CA",
+}
+
+@techreport{PVS-Semantics:TR,
+  TITLE = {The Formal Semantics of {PVS}},
+  AUTHOR = {Sam Owre and Natarajan Shankar},
+  NUMBER = {CR-1999-209321},
+  INSTITUTION = {Computer Science Laboratory, SRI International},
+  ADDRESS = {Menlo Park, CA},
+  MONTH = may,
+  YEAR = 1999,
+}
+
+@techreport{PVS-Tactics:DiVito,
+  TITLE = {A {PVS} Prover Strategy Package for Common Manipulations},
+  AUTHOR = {Ben L. Di Vito},
+  NUMBER = {TM-2002-211647},
+  INSTITUTION = {Langley Research Center},
+  ADDRESS = {Hampton, VA},
+  MONTH = apr,
+  YEAR = 2002,
+}
+
+@misc{PVS-Tactics:cours,
+  author = "César Muñoz",
+  title = "Strategies in {PVS}",
+  howpublished = "Lecture notes",
+  note = "National Institute of Aerospace",
+  year = 2002
+}
+
+@techreport{PVS-Tactics:field,
+  author = "C. Mu{\~n}oz and M. Mayero",
+  title = "Real Automation in the Field",
+  institution = "ICASE-NASA Langley",
+  number = "NASA/CR-2001-211271 Interim ICASE Report No. 39",
+  month =  "dec",
+  year = "2001"
+}
+
+%%%%%%% Autres Prouveurs %%%%%%%
+
+@misc{ACL2:repNuPrl,
+  author = "James L. Caldwell and John Cowles",
+  title = "{Representing Nuprl Proof Objects in ACL2: toward a proof checker for Nuprl}",
+  url = "http://www.cs.uwyo.edu/~jlc/papers/proof_checking.ps" }
+
+@inproceedings{Elan:ckl-strat,
+  author    = {H. Cirstea and C. Kirchner and L. Liquori},
+  title     = "{Rewrite Strategies in the Rewriting Calculus}",
+  booktitle = {WRLA'02},
+  publisher = "{Elsevier Science B.V.}",
+  series    = {Electronic Notes in Theoretical Computer Science},
+  volume    = {71},
+  year      = {2003},
+}
+
+@book{LCF:GMW,
+  author = {M. Gordon and R. Milner and C. Wadsworth},
+  publisher = {sv},
+  series = {lncs},
+  volume = 78,
+  title = {Edinburgh {LCF}: A Mechanized Logic of Computation},
+  year = 1979
+}
+
+%%%%%%% LaTeX %%%%%%%
+
+@manual{LaTeX:symb,
+  title = "The Great, Big List of \LaTeX\ Symbols",
+  author = "David Carlisle and Scott Pakin and Alexander Holt",
+  month = feb,
+  year = 2001,
+}
+
+@manual{LaTeX:intro,
+  title = "The Not So Short Introduction to \LaTeX2e",
+  author = "Tobias Oetiker",
+  month = jan,
+  year = 1999,
+}
+
+@MANUAL{CoqManualV7,
+  AUTHOR = {{The {Coq} Development Team}},
+  TITLE = {{The Coq Proof Assistant Reference Manual -- Version
+ V7.1}},
+  YEAR = {2001},
+  MONTH = OCT,
+  NOTE = {http://coq.inria.fr}
+}
+
+@MANUAL{CoqManual96,
+  TITLE = {The {Coq Proof Assistant Reference Manual} Version 6.1},
+  AUTHOR = {B. Barras and S. Boutin and C. Cornes and J. Courant and 
+                  J.-C. Filli\^atre and 
+                  H. Herbelin and G. Huet and P. Manoury and C. Mu{\~{n}}oz and
+                  C. Murthy and C. Parent and C. Paulin-Mohring and
+                  A. Sa{\"\i}bi and B. Werner},
+  ORGANIZATION = {{INRIA-Rocquencourt}-{CNRS-ENS Lyon}},
+  URL = {ftp://ftp.inria.fr/INRIA/coq/V6.1/doc/Reference-Manual.dvi.gz},
+  YEAR = 1996,
+  MONTH = DEC
+}
+
+@MANUAL{CoqTutorial99,
+  AUTHOR = {G.~Huet and G.~Kahn and Ch.~Paulin-Mohring},
+  TITLE = {The {\sf Coq} Proof Assistant - A tutorial - Version 6.3},
+  MONTH = JUL,
+  YEAR = {1999},
+  ABSTRACT = {http://coq.inria.fr/doc/tutorial.html}
+}
+
+@MANUAL{CoqTutorialV7,
+  AUTHOR = {G.~Huet and G.~Kahn and Ch.~Paulin-Mohring},
+  TITLE = {The {\sf Coq} Proof Assistant - A tutorial - Version 7.1},
+  MONTH = OCT,
+  YEAR = {2001},
+  NOTE = {http://coq.inria.fr}
+}
+
+@TECHREPORT{modelpa2000,
+  AUTHOR = {B. Bérard and P. Castéran and E. Fleury and L. Fribourg 
+                  and J.-F. Monin and C. Paulin and A. Petit and D. Rouillard},
+  TITLE = {Automates temporisés CALIFE},
+  INSTITUTION = {Calife},
+  YEAR = 2000,
+  URL = {http://www.loria.fr/projets/calife/WebCalifePublic/FOURNITURES/F1.1.ps.gz},
+  TYPE = {Fourniture {F1.1}}
+}
+
+@TECHREPORT{CaFrPaRo2000,
+  AUTHOR = {P. Castéran and E. Freund and C. Paulin and D. Rouillard},
+  TITLE = {Bibliothèques Coq et Isabelle-HOL pour les systèmes de transitions              et les p-automates},
+  INSTITUTION = {Calife},
+  YEAR = 2000,
+  URL = {http://www.loria.fr/projets/calife/WebCalifePublic/FOURNITURES/F5.4.ps.gz},
+  TYPE = {Fourniture {F5.4}}
+}
+
+@PROCEEDINGS{TPHOLs99,
+  TITLE = {International Conference on 
+                  Theorem Proving in Higher Order Logics (TPHOLs'99)},
+  YEAR = 1999,
+  EDITOR = {Y. Bertot and G. Dowek and C. Paulin-Mohring and L. Th{\'e}ry},
+  SERIES = {Lecture Notes in Computer Science},
+  MONTH = SEP,
+  PUBLISHER = {{Sprin\-ger-Verlag}},
+  ADDRESS = {Nice},
+  TYPE_PUBLI = {editeur}
+}
+
+@INPROCEEDINGS{Pau01,
+  AUTHOR = {Christine Paulin-Mohring},
+  TITLE = {Modelisation of Timed Automata in {Coq}},
+  BOOKTITLE = {Theoretical Aspects of Computer Software (TACS'2001)},
+  PAGES = {298--315},
+  YEAR = 2001,
+  EDITOR = {N. Kobayashi and B. Pierce},
+  VOLUME = 2215,
+  SERIES = {Lecture Notes in Computer Science},
+  PUBLISHER = {Springer-Verlag}
+}
+
+@PHDTHESIS{Moh89b,
+  AUTHOR = {C. Paulin-Mohring},
+  MONTH = JAN,
+  SCHOOL = {{Paris 7}},
+  TITLE = {Extraction de programmes dans le {Calcul des Constructions}},
+  TYPE = {Thèse d'université},
+  YEAR = {1989},
+  URL = {http://www.lri.fr/~paulin/these.ps.gz}
+}
+
+@ARTICLE{HuMo92,
+  AUTHOR = {G. Huet and C. Paulin-Mohring},
+  EDITION = {INRIA},
+  JOURNAL = {Courrier du CNRS - Informatique},
+  TITLE = {Preuves et Construction de Programmes},
+  YEAR = {1992},
+  CATEGORY = {national}
+}
+
+@INPROCEEDINGS{LePa94,
+  AUTHOR = {F. Leclerc and C. Paulin-Mohring},
+  TITLE = {Programming with Streams in {Coq}. A case study : The Sieve of Eratosthenes},
+  EDITOR = {H. Barendregt and T. Nipkow},
+  VOLUME = 806,
+  SERIES = {Lecture Notes in Computer Science},
+  BOOKTITLE = {{Types for Proofs and Programs, Types' 93}},
+  YEAR = 1994,
+  PUBLISHER = {Springer-Verlag}
+}
+
+@INPROCEEDINGS{Moh86,
+  AUTHOR = {C. Mohring},
+  ADDRESS = {Cambridge, MA},
+  BOOKTITLE = {Symposium on Logic in Computer Science},
+  PUBLISHER = {IEEE Computer Society Press},
+  TITLE = {Algorithm Development in the {Calculus of Constructions}},
+  YEAR = {1986}
+}
+
+@INPROCEEDINGS{Moh89a,
+  AUTHOR = {C. Paulin-Mohring},
+  ADDRESS = {Austin},
+  BOOKTITLE = {Sixteenth Annual ACM Symposium on Principles of Programming Languages},
+  MONTH = JAN,
+  PUBLISHER = {ACM},
+  TITLE = {Extracting ${F}_{\omega}$'s programs from proofs in the {Calculus of Constructions}},
+  YEAR = {1989}
+}
+
+@INCOLLECTION{Moh89c,
+  AUTHOR = {C. Paulin-Mohring},
+  TITLE = {{R\'ealisabilit\'e et extraction de programmes}},
+  BOOKTITLE = {Logique et Informatique : une introduction},
+  PUBLISHER = {INRIA},
+  YEAR = 1991,
+  EDITOR = {B. Courcelle},
+  VOLUME = 8,
+  SERIES = {Collection Didactique},
+  PAGES = {163-180},
+  CATEGORY = {national}
+}
+
+@INPROCEEDINGS{Moh93,
+  AUTHOR = {C. Paulin-Mohring},
+  BOOKTITLE = {Proceedings of the conference Typed Lambda Calculi a
+nd Applications},
+  EDITOR = {M. Bezem and J.-F. Groote},
+  INSTITUTION = {LIP-ENS Lyon},
+  NOTE = {LIP research report 92-49},
+  NUMBER = 664,
+  SERIES = {Lecture Notes in Computer Science},
+  TITLE = {{Inductive Definitions in the System {Coq} - Rules and Properties}},
+  TYPE = {research report},
+  YEAR = 1993
+}
+
+@ARTICLE{PaWe92,
+  AUTHOR = {C. Paulin-Mohring and B. Werner},
+  JOURNAL = {Journal of Symbolic Computation},
+  TITLE = {{Synthesis of ML programs in the system Coq}},
+  VOLUME = {15},
+  YEAR = {1993},
+  PAGES = {607--640}
+}
+
+@INPROCEEDINGS{Pau96,
+  AUTHOR = {C. Paulin-Mohring},
+  TITLE = {Circuits as streams in {Coq} : Verification of a sequential multiplier},
+  BOOKTITLE = {Types for Proofs and Programs, TYPES'95},
+  EDITOR = {S. Berardi and M. Coppo},
+  SERIES = {Lecture Notes in Computer Science},
+  YEAR = 1996,
+  VOLUME = 1158
+}
+
+@PHDTHESIS{Pau96b,
+  AUTHOR = {Christine Paulin-Mohring},
+  TITLE = {Définitions Inductives en Théorie des Types d'Ordre Supérieur},
+  SCHOOL = {Université Claude Bernard Lyon I},
+  YEAR = 1996,
+  MONTH = DEC,
+  TYPE = {Habilitation à diriger les recherches},
+  URL = {http://www.lri.fr/~paulin/habilitation.ps.gz}
+}
+
+@INPROCEEDINGS{PfPa89,
+  AUTHOR = {F. Pfenning and C. Paulin-Mohring},
+  BOOKTITLE = {Proceedings of Mathematical Foundations of Programming Semantics},
+  NOTE = {technical report CMU-CS-89-209},
+  PUBLISHER = {Springer-Verlag},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = 442,
+  TITLE = {Inductively defined types in the {Calculus of Constructions}},
+  YEAR = {1990}
+}
+
+@MISC{krakatoa02,
+  AUTHOR = {Claude March\'e and Christine Paulin and Xavier Urbain},
+  TITLE = {The \textsc{Krakatoa} proof tool},
+  YEAR = 2002,
+  NOTE = {\url{http://krakatoa.lri.fr/}}
+}
+
+@ARTICLE{marche03jlap,
+  AUTHOR = {Claude March{\'e} and Christine Paulin-Mohring and Xavier Urbain},
+  TITLE = {The \textsc{Krakatoa} Tool for Certification of \textsc{Java/JavaCard} Programs annotated in \textsc{JML}},
+  JOURNAL = {Journal of Logic and Algebraic Programming},
+  YEAR = 2003,
+  NOTE = {To appear},
+  URL = {http://krakatoa.lri.fr},
+  TOPICS = {team}
+}
+@ARTICLE{marche04jlap,
+  AUTHOR = {Claude March{\'e} and Christine Paulin-Mohring and Xavier Urbain},
+  TITLE = {The \textsc{Krakatoa} Tool for Certification of \textsc{Java/JavaCard} Programs annotated in \textsc{JML}},
+  JOURNAL = {Journal of Logic and Algebraic Programming},
+  YEAR = 2004,
+  VOLUME = 58,
+  NUMBER = {1--2},
+  PAGES = {89--106},
+  URL = {http://krakatoa.lri.fr},
+  TOPICS = {team}
+}
+
+@TECHREPORT{catano03deliv,
+  AUTHOR = {N{\'e}stor Cata{\~n}o and Marek Gawkowski and
+Marieke Huisman and Bart Jacobs and Claude March{\'e} and Christine Paulin
+and Erik Poll and Nicole Rauch and Xavier Urbain},
+  TITLE = {Logical Techniques for Applet Verification},
+  INSTITUTION = {VerifiCard Project},
+  YEAR = 2003,
+  TYPE = {Deliverable},
+  NUMBER = {5.2},
+  TOPICS = {team},
+  NOTE = {Available from \url{http://www.verificard.org}}
+}
+
+@TECHREPORT{kmu2002rr,
+  AUTHOR = {Keiichirou Kusakari and Claude Marché and Xavier Urbain},
+  TITLE = {Termination of Associative-Commutative Rewriting using Dependency Pairs Criteria},
+  INSTITUTION = {LRI},
+  YEAR = 2002,
+  TYPE = {Research Report},
+  NUMBER = 1304,
+  TYPE_PUBLI = {interne},
+  TOPICS = {team},
+  NOTE = {\url{http://www.lri.fr/~urbain/textes/rr1304.ps.gz}},
+  URL = {http://www.lri.fr/~urbain/textes/rr1304.ps.gz}
+}
+
+@ARTICLE{marche2004jsc,
+  AUTHOR = {Claude March\'e and Xavier Urbain},
+  TITLE = {Modular {\&} Incremental Proofs of {AC}-Termination},
+  JOURNAL = {Journal of Symbolic Computation},
+  YEAR = 2004,
+  TOPICS = {team}
+}
+
+@INPROCEEDINGS{contejean03wst,
+  AUTHOR = {Evelyne Contejean and Claude Marché and Benjamin Monate and Xavier Urbain},
+  TITLE = {{Proving Termination of Rewriting with {\sc C\textit{i}ME}}},
+  CROSSREF = {wst03},
+  PAGES = {71--73},
+  NOTE = {\url{http://cime.lri.fr/}},
+  URL = {http://cime.lri.fr/},
+  YEAR = 2003,
+  TYPE_PUBLI = {icolcomlec},
+  TOPICS = {team}
+}
+
+@TECHREPORT{contejean04rr,
+  AUTHOR = {Evelyne Contejean and Claude March{\'e} and Ana-Paula Tom{\'a}s and Xavier Urbain},
+  TITLE = {Mechanically proving termination using polynomial interpretations},
+  INSTITUTION = {LRI},
+  YEAR = {2004},
+  TYPE = {Research Report},
+  NUMBER = {1382},
+  TYPE_PUBLI = {interne},
+  TOPICS = {team},
+  URL = {http://www.lri.fr/~urbain/textes/rr1382.ps.gz}
+}
+
+@UNPUBLISHED{duran_sub,
+  AUTHOR = {Francisco Duran and Salvador Lucas and
+  Claude {March\'e} and {Jos\'e} Meseguer and Xavier Urbain},
+  TITLE = {Termination of Membership Equational Programs},
+  NOTE = {Submitted}
+}
+
+@PROCEEDINGS{comon95lncs,
+  TITLE = {Term Rewriting},
+  BOOKTITLE = {Term Rewriting},
+  TOPICS = {team, cclserver},
+  YEAR = 1995,
+  EDITOR = {Hubert Comon and Jean-Pierre Jouannaud},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = {909},
+  PUBLISHER = {{Sprin\-ger-Verlag}},
+  ORGANIZATION = {French Spring School of Theoretical Computer
+		  Science},
+  TYPE_PUBLI = {editeur},
+  CLEF_LABO = {CJ95}
+}
+
+@PROCEEDINGS{lics94,
+  TITLE = {Proceedings of the Ninth Annual IEEE Symposium on Logic
+			in Computer Science},
+  BOOKTITLE = {Proceedings of the Ninth Annual IEEE Symposium on Logic
+			in Computer Science},
+  YEAR = 1994,
+  MONTH = JUL,
+  ADDRESS = {Paris, France},
+  ORGANIZATION = {{IEEE} Comp. Soc. Press}
+}
+
+@PROCEEDINGS{rta91,
+  TITLE = {4th International Conference on Rewriting Techniques and
+                        Applications},
+  BOOKTITLE = {4th International Conference on Rewriting Techniques and
+                        Applications},
+  EDITOR = {Ronald. V. Book},
+  YEAR = 1991,
+  MONTH = APR,
+  ADDRESS = {Como, Italy},
+  PUBLISHER = {{Sprin\-ger-Verlag}},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = 488
+}
+
+@PROCEEDINGS{rta96,
+  TITLE = {7th International Conference on Rewriting Techniques and
+			Applications},
+  BOOKTITLE = {7th International Conference on Rewriting Techniques and
+			Applications},
+  EDITOR = {Harald Ganzinger},
+  PUBLISHER = {{Sprin\-ger-Verlag}},
+  YEAR = 1996,
+  MONTH = JUL,
+  ADDRESS = {New Brunswick, NJ, USA},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = 1103
+}
+
+@PROCEEDINGS{rta97,
+  TITLE = {8th International Conference on Rewriting Techniques and
+			Applications},
+  BOOKTITLE = {8th International Conference on Rewriting Techniques and
+			Applications},
+  EDITOR = {Hubert Comon},
+  PUBLISHER = {{Sprin\-ger-Verlag}},
+  YEAR = 1997,
+  MONTH = JUN,
+  ADDRESS = {Barcelona, Spain},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = {1232}
+}
+
+@PROCEEDINGS{rta98,
+  TITLE = {9th International Conference on Rewriting Techniques and
+			Applications},
+  BOOKTITLE = {9th International Conference on Rewriting Techniques and
+			Applications},
+  EDITOR = {Tobias Nipkow},
+  PUBLISHER = {{Sprin\-ger-Verlag}},
+  YEAR = 1998,
+  MONTH = APR,
+  ADDRESS = {Tsukuba, Japan},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = {1379}
+}
+
+@PROCEEDINGS{rta00,
+  TITLE = {11th International Conference on Rewriting Techniques and Applications},
+  BOOKTITLE = {11th International Conference on Rewriting Techniques and Applications},
+  EDITOR = {Leo Bachmair},
+  PUBLISHER = {{Sprin\-ger-Verlag}},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = 1833,
+  MONTH = JUL,
+  YEAR = 2000,
+  ADDRESS = {Norwich, UK}
+}
+
+@PROCEEDINGS{srt95,
+  TITLE = {Proceedings of the Conference on Symbolic Rewriting
+		  Techniques},
+  BOOKTITLE = {Proceedings of the Conference on Symbolic Rewriting
+		  Techniques},
+  YEAR = 1995,
+  EDITOR = {Manuel Bronstein and Volker Weispfenning},
+  ADDRESS = {Monte Verita, Switzerland}
+}
+
+@BOOK{comon01cclbook,
+  BOOKTITLE = {Constraints in Computational Logics},
+  TITLE = {Constraints in Computational Logics},
+  EDITOR = {Hubert Comon and Claude March{\'e} and Ralf Treinen},
+  YEAR = 2001,
+  PUBLISHER = {{Sprin\-ger-Verlag}},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = 2002,
+  TOPICS = {team},
+  TYPE_PUBLI = {editeur}
+}
+
+@PROCEEDINGS{wst03,
+  BOOKTITLE = {{Extended Abstracts of the 6th International Workshop on Termination, WST'03}},
+  TITLE = {{Extended Abstracts of the 6th International Workshop on Termination, WST'03}},
+  YEAR = {2003},
+  EDITOR = {Albert Rubio},
+  MONTH = JUN,
+  NOTE = {Technical Report DSIC II/15/03, Universidad Politécnica de Valencia, Spain}
+}
+
+@INPROCEEDINGS{FilliatreLetouzey03,
+  AUTHOR = {J.-C. Filli\^atre and P. Letouzey},
+  TITLE = {{Functors for Proofs and Programs}},
+  BOOKTITLE = {Proceedings of The European Symposium on Programming},
+  YEAR = 2004,
+  ADDRESS = {Barcelona, Spain},
+  MONTH = {March 29-April 2},
+  NOTE = {To appear},
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/fpp.ps.gz}
+}
+
+@TECHREPORT{Filliatre03,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{Why: a multi-language multi-prover verification tool}},
+  INSTITUTION = {{LRI, Universit\'e Paris Sud}},
+  TYPE = {{Research Report}},
+  NUMBER = {1366},
+  MONTH = {March},
+  YEAR = 2003,
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/why-tool.ps.gz}
+}
+
+@ARTICLE{FilliatrePottier02,
+  AUTHOR = {J.-C. Filli{\^a}tre and F. Pottier},
+  TITLE = {{Producing All Ideals of a Forest, Functionally}},
+  JOURNAL = {Journal of Functional Programming},
+  VOLUME = 13,
+  NUMBER = 5,
+  PAGES = {945--956},
+  MONTH = {September},
+  YEAR = 2003,
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/kr-fp.ps.gz},
+  ABSTRACT = {
+  We present a functional implementation of Koda and Ruskey's
+  algorithm for generating all ideals of a forest poset as a Gray
+  code. Using a continuation-based approach, we give an extremely
+  concise formulation of the algorithm's core. Then, in a number of
+  steps, we derive a first-order version whose efficiency is
+  comparable to a C implementation given by Knuth.}
+}
+
+@UNPUBLISHED{FORS01,
+  AUTHOR = {J.-C. Filli{\^a}tre and S. Owre and H. Rue{\ss} and N. Shankar},
+  TITLE = {Deciding Propositional Combinations of Equalities and Inequalities},
+  NOTE = {Unpublished},
+  MONTH = OCT,
+  YEAR = 2001,
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/ics.ps},
+  ABSTRACT = { 
+  We address the problem of combining individual decision procedures
+  into a single decision procedure.  Our combination approach is based
+  on using the canonizer obtained from Shostak's combination algorithm
+  for equality.  We illustrate our approach with a combination
+  algorithm for equality, disequality, arithmetic inequality, and
+  propositional logic.  Unlike the Nelson--Oppen combination where the
+  processing of equalities is distributed across different closed
+  decision procedures, our combination involves the centralized
+  processing of equalities in a single procedure.  The termination
+  argument for the combination is based on that for Shostak's
+  algorithm.  We also give soundness and completeness arguments.}
+}
+
+@INPROCEEDINGS{ICS,
+  AUTHOR = {J.-C. Filli{\^a}tre and S. Owre and H. Rue{\ss} and N. Shankar},
+  TITLE = {{ICS: Integrated Canonization and Solving (Tool presentation)}},
+  BOOKTITLE = {Proceedings of CAV'2001},
+  EDITOR = {G. Berry and H. Comon and A. Finkel},
+  PUBLISHER = {Springer-Verlag},
+  SERIES = {Lecture Notes in Computer Science},
+  VOLUME = 2102,
+  PAGES = {246--249},
+  YEAR = 2001
+}
+
+@INPROCEEDINGS{Filliatre01a,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {La supériorité de l'ordre supérieur},
+  BOOKTITLE = {Journées Francophones des Langages Applicatifs},
+  PAGES = {15--26},
+  MONTH = {Janvier},
+  YEAR = 2002,
+  ADDRESS = {Anglet, France},
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/sos.ps.gz},
+  CODE = {http://www.lri.fr/~filliatr/ftp/ocaml/misc/koda-ruskey.ps},
+  ABSTRACT = {
+  Nous présentons ici une écriture fonctionnelle de l'algorithme de
+  Koda-Ruskey, un algorithme pour engendrer une large famille
+  de codes de Gray. En s'inspirant de techniques de programmation par
+  continuation, nous aboutissons à un code de neuf lignes seulement,
+  bien plus élégant que les implantations purement impératives
+  proposées jusqu'ici, notamment par Knuth. Dans un second temps,
+  nous montrons comment notre code peut être légèrement modifié pour
+  aboutir à une version de complexité optimale.
+  Notre implantation en Objective Caml rivalise d'efficacité avec les
+  meilleurs codes C. Nous détaillons les calculs de complexité,
+  un exercice intéressant en présence d'ordre supérieur et d'effets de
+  bord combinés.}
+}
+
+@TECHREPORT{Filliatre00c,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{Design of a proof assistant: Coq version 7}},
+  INSTITUTION = {{LRI, Universit\'e Paris Sud}},
+  TYPE = {{Research Report}},
+  NUMBER = {1369},
+  MONTH = {October},
+  YEAR = 2000,
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/coqv7.ps.gz},
+  ABSTRACT = {
+  We present the design and implementation of the new version of the
+  Coq proof assistant. The main novelty is the isolation of the
+  critical part of the system, which consists in a type checker for
+  the Calculus of Inductive Constructions. This kernel is now
+  completely independent of the rest of the system and has been
+  rewritten in a purely functional way. This leads to greater clarity
+  and safety, without compromising efficiency. It also opens the way to
+  the ``bootstrap'' of the Coq system, where the kernel will be
+  certified using Coq itself.}
+}
+
+@TECHREPORT{Filliatre00b,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{Hash consing in an ML framework}},
+  INSTITUTION = {{LRI, Universit\'e Paris Sud}},
+  TYPE = {{Research Report}},
+  NUMBER = {1368},
+  MONTH = {September},
+  YEAR = 2000,
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/hash-consing.ps.gz},
+  ABSTRACT = {
+  Hash consing is a technique to share values that are structurally
+  equal. Beyond the obvious advantage of saving memory blocks, hash
+  consing may also be used to gain speed in several operations (like
+  equality test) and data structures (like sets or maps) when sharing is
+  maximal. However, physical adresses cannot be used directly for this
+  purpose when the garbage collector is likely to move blocks
+  underneath. We present an easy solution in such a framework, with
+  many practical benefits.}
+}
+
+@MISC{ocamlweb,
+  AUTHOR = {J.-C. Filli\^atre and C. March\'e},
+  TITLE = {{ocamlweb, a literate programming tool for Objective Caml}},
+  NOTE = {Available at \url{http://www.lri.fr/~filliatr/ocamlweb/}},
+  URL = {http://www.lri.fr/~filliatr/ocamlweb/}
+}
+
+@ARTICLE{Filliatre00a,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{Verification of Non-Functional Programs 
+                   using Interpretations in Type Theory}},
+  JOURNAL = {Journal of Functional Programming},
+  VOLUME = 13,
+  NUMBER = 4,
+  PAGES = {709--745},
+  MONTH = {July},
+  YEAR = 2003,
+  NOTE = {English translation of~\cite{Filliatre99}.},
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/jphd.ps.gz},
+  ABSTRACT = {We study the problem of certifying programs combining imperative and
+  functional features within the general framework of type theory.
+  
+  Type theory constitutes a powerful specification language, which is
+  naturally suited for the proof of purely functional programs. To
+  deal with imperative programs, we propose a logical interpretation
+  of an annotated program as a partial proof of its specification. The
+  construction of the corresponding partial proof term is based on a
+  static analysis of the effects of the program, and on the use of
+  monads. The usual notion of monads is refined in order to account
+  for the notion of effect. The missing subterms in the partial proof
+  term are seen as proof obligations, whose actual proofs are left to
+  the user. We show that the validity of those proof obligations
+  implies the total correctness of the program.
+  We also establish a result of partial completeness.
+  
+  This work has been implemented in the Coq proof assistant.
+  It appears as a tactic taking an annotated program as argument and
+  generating a set of proof obligations. Several nontrivial
+  algorithms have been certified using this tactic.}
+}
+
+@ARTICLE{Filliatre99c,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{Formal Proof of a Program: Find}},
+  JOURNAL = {Science of Computer Programming},
+  YEAR = 2001,
+  NOTE = {To appear},
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/find.ps.gz},
+  ABSTRACT = {In 1971, C.~A.~R.~Hoare gave the proof of correctness and termination of a
+  rather complex algorithm, in a paper entitled \emph{Proof of a
+    program: Find}. It is a hand-made proof, where the
+  program is given together with its formal specification and where
+  each step is fully 
+  justified by a mathematical reasoning.  We present here a formal
+  proof of the same program in the system Coq, using the
+  recent tactic of the system developed to establishing the total
+  correctness of 
+  imperative programs. We follow Hoare's paper as close as
+  possible, keeping the same program and the same specification. We
+  show that we get exactly the same proof obligations, which are
+  proved in a straightforward way, following the original paper.
+  We also explain how more informal reasonings of Hoare's proof are
+  formalized in the system Coq.
+  This demonstrates the adequacy of the system Coq in the
+  process of certifying imperative programs.}
+}
+
+@TECHREPORT{Filliatre99b,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{A theory of monads parameterized by effects}},
+  INSTITUTION = {{LRI, Universit\'e Paris Sud}},
+  TYPE = {{Research Report}},
+  NUMBER = {1367},
+  MONTH = {November},
+  YEAR = 1999,
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/monads.ps.gz},
+  ABSTRACT = {Monads were introduced in computer science to express the semantics
+  of programs with computational effects, while type and effect
+  inference was introduced to mark out those effects.
+  In this article, we propose a combination of the notions of effects
+  and monads, where the monadic operators are parameterized by effects.
+  We establish some relationships between those generalized monads and
+  the classical ones.
+  Then we use a generalized monad to translate imperative programs
+  into purely functional ones. We establish the correctness of that
+  translation. This work has been put into practice in the Coq proof
+  assistant to establish the correctness of imperative programs.}
+}
+
+@PHDTHESIS{Filliatre99,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{Preuve de programmes imp\'eratifs en th\'eorie des types}},
+  TYPE = {Th{\`e}se de Doctorat},
+  SCHOOL = {Universit\'e Paris-Sud},
+  YEAR = 1999,
+  MONTH = {July},
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/these.ps.gz},
+  ABSTRACT = {Nous étudions le problème de la certification de programmes mêlant
+  traits impératifs et fonctionnels dans le cadre de la théorie des
+  types.
+
+  La théorie des types constitue un puissant langage de spécification,
+  naturellement adapté à la preuve de programmes purement
+  fonctionnels.  Pour y certifier également des programmes impératifs,
+  nous commençons par exprimer leur sémantique de manière purement
+  fonctionnelle. Cette traduction repose sur une analyse statique des
+  effets de bord des programmes, et sur l'utilisation de la notion de
+  monade, notion que nous raffinons en l'associant à la notion d'effet
+  de manière générale.  Nous montrons que cette traduction est
+  sémantiquement correcte.
+
+  Puis, à partir d'un programme annoté, nous construisons une preuve
+  de sa spécification, traduite de manière fonctionnelle. Cette preuve
+  est bâtie sur la traduction fonctionnelle précédemment
+  introduite. Elle est presque toujours incomplète, les parties
+  manquantes étant autant d'obligations de preuve qui seront laissées
+  à la charge de l'utilisateur.  Nous montrons que la validité de ces
+  obligations entraîne la correction totale du programme.
+
+  Nous avons implanté notre travail dans l'assistant de preuve
+  Coq, avec lequel il est dès à présent distribué. Cette
+  implantation se présente sous la forme d'une tactique prenant en
+  argument un programme annoté et engendrant les obligations de
+  preuve.  Plusieurs algorithmes non triviaux ont été certifiés à
+  l'aide de cet outil (Find, Quicksort, Heapsort, algorithme de
+  Knuth-Morris-Pratt).}
+}
+
+@INPROCEEDINGS{FilliatreMagaud99,
+  AUTHOR = {J.-C. Filli\^atre and N. Magaud},
+  TITLE = {{Certification of sorting algorithms in the system Coq}},
+  BOOKTITLE = {Theorem Proving in Higher Order Logics: 
+                  Emerging Trends},
+  YEAR = 1999,
+  ABSTRACT = {We present the formal proofs of total correctness of three sorting
+  algorithms in the system Coq, namely \textit{insertion sort},
+  \textit{quicksort} and \textit{heapsort}. The implementations are
+  imperative programs working in-place on a given array. Those
+  developments demonstrate the usefulness of inductive types and higher-order
+  logic in the process of software certification. They also
+  show that the proof of rather complex algorithms may be done in a
+  small amount of time --- only a few days for each development ---
+  and without great difficulty.},
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/Filliatre-Magaud.ps.gz}
+}
+
+@INPROCEEDINGS{Filliatre98,
+  AUTHOR = {J.-C. Filli\^atre},
+  TITLE = {{Proof of Imperative Programs in Type Theory}},
+  BOOKTITLE = {International Workshop, TYPES '98, Kloster Irsee, Germany},
+  PUBLISHER = {Springer-Verlag},
+  VOLUME = 1657,
+  SERIES = {Lecture Notes in Computer Science},
+  MONTH = MAR,
+  YEAR = {1998},
+  ABSTRACT = {We present a new approach to certifying imperative programs,
+  in the context of Type Theory.
+  The key is a functional translation of imperative programs, which is
+  made possible by an analysis of their effects.
+  On sequential imperative programs, we get the same proof
+  obligations as those given by Floyd-Hoare logic,
+  but our approach also includes functional constructions.
+  As a side-effect, we propose a way to eradicate the use of auxiliary
+  variables in specifications.
+  This work has been implemented in the Coq Proof Assistant and applied
+  on non-trivial examples.},
+  URL = {http://www.lri.fr/~filliatr/ftp/publis/types98.ps.gz}
+}
+
+@TECHREPORT{Filliatre97,
+  AUTHOR = {J.-C. Filli\^atre},
+  INSTITUTION = {LIP - ENS Lyon},
+  NUMBER = {97--04},
+  TITLE = {{Finite Automata Theory in Coq: 
+                              A constructive proof of Kleene's theorem}},
+  TYPE = {Research Report},
+  MONTH = {February},
+  YEAR = {1997},
+  ABSTRACT = {We describe here a development in the system Coq
+  of a piece of Finite Automata Theory. The main result is the Kleene's
+  theorem, expressing that regular expressions and finite automata
+  define the same languages. From a constructive proof of this result,
+  we automatically obtain a functional program that compiles any
+  regular expression into a finite automata, which constitutes the main
+  part of the implementation of {\tt grep}-like programs. This
+  functional program is obtained by the automatic method of {\em
+  extraction} which removes the logical parts of the proof to keep only
+  its informative contents.  Starting with an idea of what we would
+  have written in ML, we write the specification and do the proofs in
+  such a way that we obtain the expected program, which is therefore
+  efficient.},
+  URL = {ftp://ftp.ens-lyon.fr/pub/LIP/Rapports/RR/RR97/RR97-04.ps.Z}
+}
+
+@TECHREPORT{Filliatre95,
+  AUTHOR = {J.-C. Filli\^atre},
+  INSTITUTION = {LIP - ENS Lyon},
+  NUMBER = {96--25},
+  TITLE = {{A decision procedure for Direct Predicate
+                              Calculus: study and implementation in
+                              the Coq system}},
+  TYPE = {Research Report},
+  MONTH = {February},
+  YEAR = {1995},
+  ABSTRACT = {The paper of J. Ketonen and R. Weyhrauch \emph{A
+  decidable fragment of Predicate Calculus} defines a decidable
+  fragment of first-order predicate logic - Direct Predicate Calculus
+  - as the subset which is provable in Gentzen sequent calculus
+  without the contraction rule, and gives an effective decision
+  procedure for it. This report is a detailed study of this
+  procedure. We extend the decidability to non-prenex formulas. We
+  prove that the intuitionnistic fragment is still decidable, with a
+  refinement of the same procedure. An intuitionnistic version has
+  been implemented in the Coq system using a translation into
+  natural deduction.},
+  URL = {ftp://ftp.ens-lyon.fr/pub/LIP/Rapports/RR/RR96/RR96-25.ps.Z}
+}
+
+@TECHREPORT{Filliatre94,
+  AUTHOR = {J.-C. Filli\^atre},
+  MONTH = {Juillet},
+  INSTITUTION = {Ecole Normale Sup\'erieure},
+  TITLE = {{Une proc\'edure de d\'ecision pour le Calcul des Pr\'edicats Direct~: \'etude et impl\'ementation dans le syst\`eme Coq}},
+  TYPE = {Rapport de {DEA}},
+  YEAR = {1994},
+  URL = {ftp://ftp.lri.fr/LRI/articles/filliatr/memoire.dvi.gz}
+}
+
+@TECHREPORT{CourantFilliatre93,
+  AUTHOR = {J. Courant et J.-C. Filli\^atre},
+  MONTH = {Septembre},
+  INSTITUTION = {Ecole Normale Sup\'erieure},
+  TITLE = {{Formalisation de la th\'eorie des langages 
+                              formels en Coq}},
+  TYPE = {Rapport de ma\^{\i}trise},
+  YEAR = {1993},
+  URL = {http://www.ens-lyon.fr/~jcourant/stage_maitrise.dvi.gz},
+  URL2 = {http://www.ens-lyon.fr/~jcourant/stage_maitrise.ps.gz}
+}
+
+@INPROCEEDINGS{tphols2000-Letouzey,
+        crossref        = "tphols2000",
+        title           = "Formalizing {S}t{\aa}lmarck's algorithm in {C}oq",
+        author          = "Pierre Letouzey and Laurent Th{\'e}ry",
+        pages           = "387--404"}
+
+@PROCEEDINGS{tphols2000,
+        editor          = "J. Harrison and M. Aagaard",
+        booktitle       = "Theorem Proving in Higher Order Logics:
+                           13th International Conference, TPHOLs 2000",
+        series          = "Lecture Notes in Computer Science",
+        volume          = 1869,
+        year            = 2000,
+        publisher       = "Springer-Verlag"}
+
+@InCollection{howe,
+  author =       {Doug Howe},
+  title =        {Computation Meta theory in Nuprl},
+  booktitle =    {The Proceedings of the Ninth International Conference of Autom
+ated Deduction},
+  volume =       {310},
+  editor =       {E. Lusk and R. Overbeek},
+  publisher =    {Springer-Verlag},
+  pages =        {238--257},
+  year =         {1988}
+}
+
+@TechReport{harrison,
+  author =       {John Harrison},
+  title =        {Meta theory and Reflection in Theorem Proving:a Survey and Cri
+tique},
+  institution =  {SRI International Cambridge Computer Science Research Center},
+  year =         {1995},
+  number =       {CRC-053}
+}
+
+@InCollection{cc,
+  author =       {Thierry Coquand and Gérard Huet},
+  title =        {The Calculus of Constructions},
+  booktitle =    {Information and Computation},
+  year =         {1988},
+  volume =       {76},
+  number =       {2/3}
+}
+
+
+@InProceedings{coquandcci,
+  author =       {Thierry Coquand and Christine Paulin-Mohring},
+  title =        {Inductively defined types},
+  booktitle =    {Proceedings of Colog'88},
+  year =         {1990},
+  editor =       {P. Martin-Löf and G. Mints},
+  volume =       {417},
+  series =       {LNCS},
+  publisher = {Springer-Verlag}
+}
+
+
+@InProceedings{boutin,
+  author =       {Samuel Boutin},
+  title =        {Using reflection to build efficient and certified decision pro
+cedures.},
+  booktitle =    {Proceedings of TACS'97},
+  year =         {1997},
+  editor =       {M. Abadi and T. Ito},
+  volume =       {1281},
+  series =       {LNCS},
+  publisher =    {Springer-Verlag}
+}
+
+@Manual{Coq:manual,
+  title =        {The Coq proof assistant reference manual},
+  author =       {\mbox{The Coq development team}},
+  organization = {LogiCal Project},
+  note =         {Version 8.0},
+  year =         {2004},
+  url =          "http://coq.inria.fr"
+}
+
+@string{jfp = "Journal of Functional Programming"}
+@STRING{lncs="Lecture Notes in Computer Science"}
+@STRING{lnai="Lecture Notes in Artificial Intelligence"}
+@string{SV = "{Sprin\-ger-Verlag}"}
+
+@INPROCEEDINGS{Aud91,
+        AUTHOR             = {Ph. Audebaud},
+        BOOKTITLE          = {Proceedings of the sixth Conf. on Logic in Computer Science.},
+        PUBLISHER          = {IEEE},
+        TITLE              = {Partial {Objects} in the {Calculus of Constructions}},
+        YEAR               = {1991}
+}
+
+@PHDTHESIS{Aud92,
+        AUTHOR             = {Ph. Audebaud},
+        SCHOOL             = {{Universit\'e} Bordeaux I},
+        TITLE              = {Extension du Calcul des Constructions par Points fixes},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Audebaud92b,
+        AUTHOR             = {Ph. Audebaud},
+        BOOKTITLE          = {{Proceedings of the 1992 Workshop on Types for Proofs and Programs}},
+        EDITOR             = {{B. Nordstr\"om and K. Petersson and G. Plotkin}},
+        NOTE               = {Also Research Report LIP-ENS-Lyon},
+        PAGES              = {pp 21--34},
+        TITLE              = {{CC+ : an extension of the Calculus of Constructions with fixpoints}},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Augustsson85,
+        AUTHOR             = {L. Augustsson},
+        TITLE              = {{Compiling Pattern Matching}},
+        BOOKTITLE          = {Conference Functional Programming and
+Computer Architecture},
+        YEAR               = {1985}
+}
+
+@ARTICLE{BaCo85,
+        AUTHOR             = {J.L. Bates and R.L. Constable},
+        JOURNAL            = {ACM transactions on Programming Languages and Systems},
+        TITLE              = {Proofs as {Programs}},
+        VOLUME             = {7},
+        YEAR               = {1985}
+}
+
+@BOOK{Bar81,
+        AUTHOR             = {H.P. Barendregt},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {The Lambda Calculus its Syntax and Semantics},
+        YEAR               = {1981}
+}
+
+@TECHREPORT{Bar91,
+        AUTHOR             = {H. Barendregt},
+        INSTITUTION        = {Catholic University Nijmegen},
+        NOTE               = {In Handbook of Logic in Computer Science, Vol II},
+        NUMBER             = {91-19},
+        TITLE              = {Lambda {Calculi with Types}},
+        YEAR               = {1991}
+}
+
+@ARTICLE{BeKe92,
+        AUTHOR             = {G. Bellin and J. Ketonen},
+        JOURNAL            = {Theoretical Computer Science},
+        PAGES              = {115--142},
+        TITLE              = {A decision procedure revisited : Notes on direct logic, linear logic and its implementation},
+        VOLUME             = {95},
+        YEAR               = {1992}
+}
+
+@BOOK{Bee85,
+        AUTHOR             = {M.J. Beeson},
+        PUBLISHER          = SV,
+        TITLE              = {Foundations of Constructive Mathematics, Metamathematical Studies},
+        YEAR               = {1985}
+}
+
+@BOOK{Bis67,
+        AUTHOR             = {E. Bishop},
+        PUBLISHER          = {McGraw-Hill},
+        TITLE              = {Foundations of Constructive Analysis},
+        YEAR               = {1967}
+}
+
+@BOOK{BoMo79,
+        AUTHOR             = {R.S. Boyer and J.S. Moore},
+        KEY                = {BoMo79},
+        PUBLISHER          = {Academic Press},
+        SERIES             = {ACM Monograph},
+        TITLE              = {A computational logic},
+        YEAR               = {1979}
+}
+
+@MASTERSTHESIS{Bou92,
+        AUTHOR             = {S. Boutin},
+        MONTH              = sep,
+        SCHOOL             = {{Universit\'e Paris 7}},
+        TITLE              = {Certification d'un compilateur {ML en Coq}},
+        YEAR               = {1992}
+}
+
+@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}
+}
+
+@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,
+        AUTHOR             = {N.J. de Bruijn},
+        JOURNAL            = {Indag. Math.},
+        TITLE              = {{Lambda-Calculus Notation with Nameless Dummies, a Tool for Automatic Formula Manipulation, with Application to the Church-Rosser Theorem}},
+        VOLUME             = {34},
+        YEAR               = {1972}
+}
+
+
+@INCOLLECTION{Bru80,
+        AUTHOR             = {N.J. de Bruijn},
+        BOOKTITLE          = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.},
+        EDITOR             = {J.P. Seldin and J.R. Hindley},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {A survey of the project {Automath}},
+        YEAR               = {1980}
+}
+
+@TECHREPORT{COQ93,
+        AUTHOR             = {G. Dowek and A. Felty and H. Herbelin and G. Huet and C. Murthy and C. Parent and C. Paulin-Mohring and B. Werner},
+        INSTITUTION        = {INRIA},
+        MONTH              = may,
+        NUMBER             = {154},
+        TITLE              = {{The Coq Proof Assistant User's Guide Version 5.8}},
+        YEAR               = {1993}
+}
+
+@TECHREPORT{CPar93,
+        AUTHOR             = {C. Parent},
+        INSTITUTION        = {Ecole {Normale} {Sup\'erieure} de {Lyon}},
+        MONTH              = oct,
+        NOTE               = {Also in~\cite{Nijmegen93}},
+        NUMBER             = {93-29},
+        TITLE              = {Developing certified programs in the system {Coq}- {The} {Program} tactic},
+        YEAR               = {1993}
+}
+
+@PHDTHESIS{CPar95,
+        AUTHOR             = {C. Parent},
+        SCHOOL             = {Ecole {Normale} {Sup\'erieure} de {Lyon}},
+        TITLE              = {{Synth\`ese de preuves de programmes dans le Calcul des Constructions Inductives}},
+        YEAR               = {1995}
+}
+
+@BOOK{Caml,
+        AUTHOR             = {P. Weis and X. Leroy},
+        PUBLISHER          = {InterEditions},
+        TITLE              = {Le langage Caml},
+        YEAR               = {1993}
+}
+
+@INPROCEEDINGS{ChiPotSimp03,
+  AUTHOR    = {Laurent Chicli and Lo\"{\i}c Pottier and Carlos Simpson},
+  ADDRESS   = {Berg en Dal, The Netherlands},
+  TITLE     = {Mathematical Quotients and Quotient Types in Coq},
+  BOOKTITLE = {TYPES'02},
+  PUBLISHER = SV,
+  SERIES    = LNCS,
+  VOLUME    = {2646},
+  YEAR      = {2003}
+}
+
+@TECHREPORT{CoC89,
+        AUTHOR             = {Projet Formel},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {110},
+        TITLE              = {{The Calculus of Constructions. Documentation and user's guide, Version 4.10}},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{CoHu85a,
+        AUTHOR             = {Thierry Coquand and Gérard Huet},
+        ADDRESS            = {Linz},
+        BOOKTITLE          = {EUROCAL'85},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {{Constructions : A Higher Order Proof System for Mechanizing Mathematics}},
+        VOLUME             = {203},
+        YEAR               = {1985}
+}
+
+@INPROCEEDINGS{CoHu85b,
+        AUTHOR             = {Thierry Coquand and Gérard Huet},
+        BOOKTITLE          = {Logic Colloquium'85},
+        EDITOR             = {The Paris Logic Group},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {{Concepts Math\'ematiques et Informatiques formalis\'es dans le Calcul des Constructions}},
+        YEAR               = {1987}
+}
+
+@ARTICLE{CoHu86,
+        AUTHOR             = {Thierry Coquand and Gérard Huet},
+        JOURNAL            = {Information and Computation},
+        NUMBER             = {2/3},
+        TITLE              = {The {Calculus of Constructions}},
+        VOLUME             = {76},
+        YEAR               = {1988}
+}
+
+@INPROCEEDINGS{CoPa89,
+        AUTHOR             = {Thierry Coquand and Christine Paulin-Mohring},
+        BOOKTITLE          = {Proceedings of Colog'88},
+        EDITOR             = {P. Martin-L\"of and G. Mints},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {Inductively defined types},
+        VOLUME             = {417},
+        YEAR               = {1990}
+}
+
+@BOOK{Con86,
+        AUTHOR             = {R.L. {Constable et al.}},
+        PUBLISHER          = {Prentice-Hall},
+        TITLE              = {{Implementing Mathematics with the Nuprl Proof Development System}},
+        YEAR               = {1986}
+}
+
+@PHDTHESIS{Coq85,
+        AUTHOR             = {Thierry Coquand},
+        MONTH              = jan,
+        SCHOOL             = {Universit\'e Paris~7},
+        TITLE              = {Une Th\'eorie des Constructions},
+        YEAR               = {1985}
+}
+
+@INPROCEEDINGS{Coq86,
+        AUTHOR             = {Thierry Coquand},
+        ADDRESS            = {Cambridge, MA},
+        BOOKTITLE          = {Symposium on Logic in Computer Science},
+        PUBLISHER          = {IEEE Computer Society Press},
+        TITLE              = {{An Analysis of Girard's Paradox}},
+        YEAR               = {1986}
+}
+
+@INPROCEEDINGS{Coq90,
+        AUTHOR             = {Thierry Coquand},
+        BOOKTITLE          = {Logic and Computer Science},
+        EDITOR             = {P. Oddifredi},
+        NOTE               = {INRIA Research Report 1088, also in~\cite{CoC89}},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {{Metamathematical Investigations of a Calculus of Constructions}},
+        YEAR               = {1990}
+}
+
+@INPROCEEDINGS{Coq91,
+        AUTHOR             = {Thierry Coquand},
+        BOOKTITLE          = {Proceedings 9th Int. Congress of Logic, Methodology and Philosophy of Science},
+        TITLE              = {{A New Paradox in Type Theory}},
+        MONTH              = {August},
+        YEAR               = {1991}
+}
+
+@INPROCEEDINGS{Coq92,
+        AUTHOR             = {Thierry Coquand},
+        TITLE              = {{Pattern Matching with Dependent Types}},
+        YEAR               = {1992},
+        crossref = {Bastad92}
+}
+
+@INPROCEEDINGS{Coquand93,
+        AUTHOR             = {Thierry Coquand},
+        TITLE              = {{Infinite Objects in Type Theory}},
+        YEAR               = {1993},
+        crossref = {Nijmegen93}
+}
+
+@MASTERSTHESIS{Cou94a,
+        AUTHOR             = {J. Courant},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique, ENS Lyon},
+        TITLE              = {Explicitation de preuves par r\'ecurrence implicite},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{Del99,
+  author    = "Delahaye, D.",
+  title     = "Information Retrieval in a Coq Proof Library using
+               Type Isomorphisms",
+  booktitle = {Proceedings of TYPES'99, L\"okeberg},
+  publisher = SV,
+  series = lncs,
+  year      = "1999",
+  url      =
+    "\\{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
+    "{\sf TYPES99-SIsos.ps.gz}"
+}
+
+@INPROCEEDINGS{Del00,
+  author    = "Delahaye, D.",
+  title     = "A {T}actic {L}anguage for the {S}ystem {{\sf Coq}}",
+  booktitle = "Proceedings of Logic for Programming and Automated Reasoning
+               (LPAR), Reunion Island",
+  publisher = SV,
+  series =  LNCS,
+  volume    = "1955",
+  pages     = "85--95",
+  month     = "November",
+  year      = "2000",
+  url      =
+    "{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
+    "{\sf LPAR2000-ltac.ps.gz}"
+}
+
+@INPROCEEDINGS{DelMay01,
+  author    = "Delahaye, D. and Mayero, M.",
+  title     = {{\tt Field}: une proc\'edure de d\'ecision pour les nombres r\'eels
+               en {\Coq}},
+  booktitle = "Journ\'ees Francophones des Langages Applicatifs, Pontarlier",
+  publisher = "INRIA",
+  month     = "Janvier",
+  year      = "2001",
+  url      =
+    "\\{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
+    "{\sf JFLA2000-Field.ps.gz}"
+}
+
+@TECHREPORT{Dow90,
+        AUTHOR             = {G. Dowek},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {1283},
+        TITLE              = {Naming and Scoping in a Mathematical Vernacular},
+        TYPE               = {Research Report},
+        YEAR               = {1990}
+}
+
+@ARTICLE{Dow91a,
+        AUTHOR             = {G. Dowek},
+        JOURNAL            = {Compte-Rendus de l'Acad\'emie des Sciences},
+        NOTE               = {The undecidability of Third Order Pattern Matching in Calculi with Dependent Types or Type Constructors},
+        NUMBER             = {12},
+        PAGES              = {951--956},
+        TITLE              = {L'Ind\'ecidabilit\'e du Filtrage du Troisi\`eme Ordre dans les Calculs avec Types D\'ependants ou Constructeurs de Types}, 
+        VOLUME             = {I, 312},
+        YEAR               = {1991}
+}		  
+
+@INPROCEEDINGS{Dow91b,
+        AUTHOR             = {G. Dowek},
+        BOOKTITLE          = {Proceedings of Mathematical Foundation of Computer Science},
+        NOTE               = {Also INRIA Research Report},
+        PAGES              = {151--160},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {A Second Order Pattern Matching Algorithm in the Cube of Typed $\lambda$-calculi},
+        VOLUME             = {520},
+        YEAR               = {1991}
+}
+                  
+@PHDTHESIS{Dow91c,
+        AUTHOR             = {G. Dowek},
+        MONTH              = dec,
+        SCHOOL             = {Universit\'e Paris 7},
+        TITLE              = {D\'emonstration automatique dans le Calcul des Constructions},
+        YEAR               = {1991}
+}
+
+@article{Dow92a,
+        AUTHOR             = {G. Dowek},
+        TITLE              = {The Undecidability of Pattern Matching in Calculi where Primitive Recursive Functions are Representable},
+        YEAR               = 1993,
+        journal = tcs,
+        volume = 107,
+        number = 2,
+        pages = {349-356}
+}
+
+
+@ARTICLE{Dow94a,
+        AUTHOR             = {G. Dowek},
+        JOURNAL            = {Annals of Pure and Applied Logic},
+        VOLUME             = {69},
+        PAGES              = {135--155},
+        TITLE              = {Third order matching is decidable},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{Dow94b,
+        AUTHOR             = {G. Dowek},
+        BOOKTITLE          = {Proceedings of the second international conference on typed lambda calculus and applications},
+        TITLE              = {Lambda-calculus, Combinators and the Comprehension Schema},
+        YEAR               = {1995}
+}
+
+@INPROCEEDINGS{Dyb91,
+        AUTHOR             = {P. Dybjer},
+        BOOKTITLE          = {Logical Frameworks},
+        EDITOR             = {G. Huet and G. Plotkin},
+        PAGES              = {59--79},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Inductive sets and families in {Martin-L{\"o}f's}
+ Type Theory and their set-theoretic semantics: An inversion principle for {Martin-L\"of's} type theory}, 
+        VOLUME             = {14},
+        YEAR               = {1991}
+}
+
+@ARTICLE{Dyc92,
+        AUTHOR             = {Roy Dyckhoff},
+        JOURNAL            = {The Journal of Symbolic Logic},
+        MONTH              = sep,
+        NUMBER             = {3},
+        TITLE              = {Contraction-free sequent calculi for intuitionistic logic},
+        VOLUME             = {57},
+        YEAR               = {1992}
+}
+
+@MASTERSTHESIS{Fil94,
+        AUTHOR             = {J.-C. Filli\^atre},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique, ENS Lyon},
+        TITLE              = {Une proc\'edure de d\'ecision pour le Calcul des Pr\'edicats Direct. {\'E}tude et impl\'ementation dans le syst\`eme {\Coq}},
+        YEAR               = {1994}
+}
+
+@TECHREPORT{Filliatre95,
+        AUTHOR             = {J.-C. Filli\^atre},
+        INSTITUTION        = {LIP-ENS-Lyon},
+        TITLE              = {A decision procedure for Direct Predicate Calculus},
+        TYPE               = {Research report},
+        NUMBER             = {96--25},
+        YEAR               = {1995}
+}
+
+@Article{Filliatre03jfp,
+  author = 	 {J.-C. Filli{\^a}tre},
+  title = 	 {Verification of Non-Functional Programs 
+                   using Interpretations in Type Theory},
+  journal =      jfp,
+  volume =       13,
+  number =       4,
+  pages =        {709--745},
+  month =	 jul,
+  year =	 2003,
+  note = 	 {[English translation of \cite{Filliatre99}]},
+  url =          {http://www.lri.fr/~filliatr/ftp/publis/jphd.ps.gz},
+  topics =       "team, lri",
+  type_publi =   "irevcomlec"
+}
+
+
+@PhdThesis{Filliatre99,
+  author = 	 {J.-C. Filli\^atre},
+  title = 	 {Preuve de programmes imp\'eratifs en th\'eorie des types},
+  type =         {Th{\`e}se de Doctorat},
+  school = 	 {Universit\'e Paris-Sud},
+  year = 	 1999,
+  month =	 {July},
+  url =         {\url{http://www.lri.fr/~filliatr/ftp/publis/these.ps.gz}}
+}
+
+@Unpublished{Filliatre99c,
+  author = 	 {J.-C. Filli\^atre},
+  title = 	 {{Formal Proof of a Program: Find}},
+  month =        {January},
+  year =         2000,
+  note = 	 {Submitted to \emph{Science of Computer Programming}},
+  url =         {\url{http://www.lri.fr/~filliatr/ftp/publis/find.ps.gz}}
+}
+
+@InProceedings{FilliatreMagaud99,
+  author = 	 {J.-C. Filli\^atre and N. Magaud},
+  title = 	 {Certification of sorting algorithms in the system {\Coq}},
+  booktitle =    {Theorem Proving in Higher Order Logics: 
+                  Emerging Trends},
+  year =	 1999,
+  url = {\url{http://www.lri.fr/~filliatr/ftp/publis/Filliatre-Magaud.ps.gz}}
+}
+
+@UNPUBLISHED{Fle90,
+        AUTHOR             = {E. Fleury},
+        MONTH              = jul,
+        NOTE               = {Rapport de Stage},
+        TITLE              = {Implantation des algorithmes de {Floyd et de Dijkstra} dans le {Calcul des Constructions}},
+        YEAR               = {1990}
+}
+
+@BOOK{Fourier,
+        AUTHOR             = {Jean-Baptiste-Joseph Fourier},
+        PUBLISHER          = {Gauthier-Villars},
+        TITLE              = {Fourier's method to solve linear 
+                              inequations/equations systems.},
+        YEAR               = {1890}
+}
+
+@INPROCEEDINGS{Gim94,
+        AUTHOR             = {Eduardo Gim\'enez},
+        BOOKTITLE          = {Types'94 : Types for Proofs and Programs},
+        NOTE               = {Extended version in LIP research report 95-07, ENS Lyon},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {Codifying guarded definitions with recursive schemes},
+        VOLUME             = {996},
+        YEAR               = {1994}
+}
+
+@TechReport{Gim98,
+  author = 	 {E. Gim\'enez},
+  title = 	 {A Tutorial on Recursive Types in Coq},
+  institution =  {INRIA},
+  year = 	 1998,
+  month =	 mar
+}
+
+@INPROCEEDINGS{Gimenez95b,
+        AUTHOR             = {E. Gim\'enez},
+        BOOKTITLE          = {Workshop on Types for Proofs and Programs},
+        SERIES             = LNCS,
+        NUMBER             = {1158},
+        PAGES              = {135-152},
+        TITLE              = {An application of co-Inductive types in Coq: 
+		               verification of the Alternating Bit Protocol},
+        EDITORS            = {S. Berardi and M. Coppo},
+        PUBLISHER          = SV,
+        YEAR               = {1995}
+}
+
+@INPROCEEDINGS{Gir70,
+        AUTHOR             = {Jean-Yves Girard},
+        BOOKTITLE          = {Proceedings of the 2nd Scandinavian Logic Symposium},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {Une extension de l'interpr\'etation de {G\"odel} \`a l'analyse, et son application \`a l'\'elimination des coupures dans l'analyse et la th\'eorie des types},
+        YEAR               = {1970}
+}
+
+@PHDTHESIS{Gir72,
+        AUTHOR             = {Jean-Yves Girard},
+        SCHOOL             = {Universit\'e Paris~7},
+        TITLE              = {Interpr\'etation fonctionnelle et \'elimination des coupures de l'arithm\'etique d'ordre sup\'erieur},
+        YEAR               = {1972}
+}
+
+
+
+@BOOK{Gir89,
+        AUTHOR             = {Jean-Yves Girard and Yves Lafont and Paul Taylor},
+        PUBLISHER          = {Cambridge University Press},
+        SERIES             = {Cambridge Tracts in Theoretical Computer Science 7},
+        TITLE              = {Proofs and Types},
+        YEAR               = {1989}
+}
+
+@TechReport{Har95,
+  author = 	 {John Harrison},
+  title = 	 {Metatheory and Reflection in Theorem Proving: A Survey and Critique},
+  institution =  {SRI International Cambridge Computer Science Research Centre,},
+  year = 	 1995,
+  type =	 {Technical Report},
+  number =	 {CRC-053},
+  abstract =	 {http://www.cl.cam.ac.uk/users/jrh/papers.html}
+}
+
+@MASTERSTHESIS{Hir94,
+        AUTHOR             = {Daniel Hirschkoff},
+        MONTH              = sep,
+        SCHOOL             = {DEA IARFA, Ecole des Ponts et Chauss\'ees, Paris},
+        TITLE              = {{\'E}criture d'une tactique arithm\'etique pour le syst\`eme {\Coq}},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{HofStr98,
+        AUTHOR        = {Martin Hofmann and Thomas Streicher},
+        TITLE         = {The groupoid interpretation of type theory},
+        BOOKTITLE     = {Proceedings of the meeting Twenty-five years of constructive type theory},
+        PUBLISHER     = {Oxford University Press},
+        YEAR          = {1998}
+} 
+
+@INCOLLECTION{How80,
+        AUTHOR             = {W.A. Howard},
+        BOOKTITLE          = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.},
+        EDITOR             = {J.P. Seldin and J.R. Hindley},
+        NOTE               = {Unpublished 1969 Manuscript},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {The Formulae-as-Types Notion of Constructions},
+        YEAR               = {1980}
+}
+
+
+
+@InProceedings{Hue87tapsoft,
+  author = 	 {G. Huet},
+  title = 	 {Programming of Future Generation Computers},
+  booktitle = 	 {Proceedings of TAPSOFT87},
+       series = LNCS,
+        volume = 249,
+  pages =	 {276--286},
+  year =	 1987,
+  publisher =	 SV
+}
+
+@INPROCEEDINGS{Hue87,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {Programming of Future Generation Computers},
+        EDITOR             = {K. Fuchi and M. Nivat},
+        NOTE               = {Also in \cite{Hue87tapsoft}},
+        PUBLISHER          = {Elsevier Science},
+        TITLE              = {Induction Principles Formalized in the {Calculus of Constructions}},
+        YEAR               = {1988}
+}
+
+
+
+@INPROCEEDINGS{Hue88,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {A perspective in Theoretical Computer Science. Commemorative Volume for Gift Siromoney},
+        EDITOR             = {R. Narasimhan},
+        NOTE               = {Also in~\cite{CoC89}},
+        PUBLISHER          = {World Scientific Publishing},
+        TITLE              = {{The Constructive Engine}},
+        YEAR               = {1989}
+}
+
+@BOOK{Hue89,
+        EDITOR             = {G. Huet},
+        PUBLISHER          = {Addison-Wesley},
+        SERIES             = {The UT Year of Programming Series},
+        TITLE              = {Logical Foundations of Functional Programming},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{Hue92,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {Proceedings of 12th FST/TCS Conference, New Delhi},
+        PAGES              = {229--240},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {The Gallina Specification Language : A case study},
+        VOLUME             = {652},
+        YEAR               = {1992}
+}
+
+@ARTICLE{Hue94,
+        AUTHOR             = {G. Huet},
+        JOURNAL            = {J. Functional Programming},
+        PAGES              = {371--394},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Residual theory in $\lambda$-calculus: a formal development},
+        VOLUME             = {4,3},
+        YEAR               = {1994}
+}
+
+@INCOLLECTION{HuetLevy79,
+        AUTHOR             = {G. Huet and J.-J. L\'{e}vy},
+        TITLE              = {Call by Need Computations in Non-Ambigous
+Linear Term Rewriting Systems},
+        NOTE               = {Also research report 359, INRIA, 1979},
+        BOOKTITLE          = {Computational Logic, Essays in Honor of
+Alan Robinson},
+        EDITOR             = {J.-L. Lassez and G. Plotkin},
+        PUBLISHER          = {The MIT press},
+        YEAR               = {1991}
+}
+
+@ARTICLE{KeWe84,
+        AUTHOR             = {J. Ketonen and R. Weyhrauch},
+        JOURNAL            = {Theoretical Computer Science},
+        PAGES              = {297--307},
+        TITLE              = {A decidable fragment of {P}redicate {C}alculus},
+        VOLUME             = {32},
+        YEAR               = {1984}
+}
+
+@BOOK{Kle52,
+        AUTHOR             = {S.C. Kleene},
+        PUBLISHER          = {North-Holland},
+        SERIES             = {Bibliotheca Mathematica},
+        TITLE              = {Introduction to Metamathematics},
+        YEAR               = {1952}
+}
+
+@BOOK{Kri90,
+        AUTHOR             = {J.-L. Krivine},
+        PUBLISHER          = {Masson},
+        SERIES             = {Etudes et recherche en informatique},
+        TITLE              = {Lambda-calcul {types et mod\`eles}},
+        YEAR               = {1990}
+}
+
+@BOOK{LE92,
+        EDITOR             = {G. Huet and G. Plotkin},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Logical Environments},
+        YEAR               = {1992}
+}
+
+@BOOK{LF91,
+        EDITOR             = {G. Huet and G. Plotkin},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Logical Frameworks},
+        YEAR               = {1991}
+}
+
+@ARTICLE{Laville91,
+        AUTHOR             = {A. Laville},
+        TITLE              = {Comparison of Priority Rules in Pattern
+Matching and Term Rewriting},
+        JOURNAL            = {Journal of Symbolic Computation},
+        VOLUME             = {11},
+        PAGES              = {321--347},
+        YEAR               = {1991}
+}
+
+@INPROCEEDINGS{LePa94,
+        AUTHOR             = {F. Leclerc and C. Paulin-Mohring},
+        BOOKTITLE          = {{Types for Proofs and Programs, Types' 93}},
+        EDITOR             = {H. Barendregt and T. Nipkow},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{Programming with Streams in Coq. A case study : The Sieve of Eratosthenes}},
+        VOLUME             = {806},
+        YEAR               = {1994}
+}
+
+@TECHREPORT{Leroy90,
+        AUTHOR             = {X. Leroy},
+        TITLE              = {The {ZINC} experiment: an economical implementation
+of the {ML} language},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {117},
+        YEAR               = {1990}
+}
+
+@INPROCEEDINGS{Let02,
+        author          = {P. Letouzey},
+        title           = {A New Extraction for Coq},
+        booktitle       = {Proceedings of the TYPES'2002 workshop},
+        year            = 2002,
+        note            = {to appear},
+        url            = {draft at \url{http://www.lri.fr/~letouzey/download/extraction2002.ps.gz}}
+}
+
+@BOOK{MaL84,
+        AUTHOR             = {{P. Martin-L\"of}},
+        PUBLISHER          = {Bibliopolis},
+        SERIES             = {Studies in Proof Theory},
+        TITLE              = {Intuitionistic Type Theory},
+        YEAR               = {1984}
+}
+
+@ARTICLE{MaSi94,
+        AUTHOR             = {P. Manoury and M. Simonot},
+        JOURNAL            = {TCS},
+        TITLE              = {Automatizing termination proof of recursively defined function},
+        YEAR               = {To appear}
+}
+
+@INPROCEEDINGS{Moh89a,
+        AUTHOR             = {Christine Paulin-Mohring},
+        ADDRESS            = {Austin},
+        BOOKTITLE          = {Sixteenth Annual ACM Symposium on Principles of Programming Languages},
+        MONTH              = jan,
+        PUBLISHER          = {ACM},
+        TITLE              = {Extracting ${F}_{\omega}$'s programs from proofs in the {Calculus of Constructions}},
+        YEAR               = {1989}
+}
+
+@PHDTHESIS{Moh89b,
+        AUTHOR             = {Christine Paulin-Mohring},
+        MONTH              = jan,
+        SCHOOL             = {{Universit\'e Paris 7}},
+        TITLE              = {Extraction de programmes dans le {Calcul des Constructions}},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{Moh93,
+        AUTHOR             = {Christine Paulin-Mohring},
+        BOOKTITLE          = {Proceedings of the conference Typed Lambda Calculi and Applications},
+        EDITOR             = {M. Bezem and J.-F. Groote},
+        NOTE               = {Also LIP research report 92-49, ENS Lyon},
+        NUMBER             = {664},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{Inductive Definitions in the System Coq - Rules and Properties}},
+        YEAR               = {1993}
+}
+
+@BOOK{Moh97,
+        AUTHOR             = {Christine Paulin-Mohring},
+        MONTH              = jan,
+        PUBLISHER          = {{ENS Lyon}},
+        TITLE              = {{Le syst\`eme Coq. \mbox{Th\`ese d'habilitation}}},
+        YEAR               = {1997}
+}
+
+@MASTERSTHESIS{Mun94,
+        AUTHOR             = {C. Mu{\~n}oz},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique Fondamentale, Universit\'e Paris 7},
+        TITLE              = {D\'emonstration automatique dans la logique propositionnelle intuitionniste},
+        YEAR               = {1994}
+}
+
+@PHDTHESIS{Mun97d,
+        AUTHOR = "C. Mu{\~{n}}oz",
+        TITLE = "Un calcul de substitutions pour la repr\'esentation
+                  de preuves partielles en th\'eorie de types",
+        SCHOOL = {Universit\'e Paris 7},
+        YEAR = "1997",
+        Note = {Version en anglais disponible comme rapport de 
+                recherche INRIA RR-3309},        
+        Type = {Th\`ese de Doctorat}
+}
+
+@BOOK{NoPS90,
+        AUTHOR             = {B. {Nordstr\"om} and K. Peterson and J. Smith},
+        BOOKTITLE          = {Information Processing 83},
+        PUBLISHER          = {Oxford Science Publications},
+        SERIES             = {International Series of Monographs on Computer Science},
+        TITLE              = {Programming in {Martin-L\"of's} Type Theory},
+        YEAR               = {1990}
+}
+
+@ARTICLE{Nor88,
+        AUTHOR             = {B. {Nordstr\"om}},
+        JOURNAL            = {BIT},
+        TITLE              = {Terminating General Recursion},
+        VOLUME             = {28},
+        YEAR               = {1988}
+}
+
+@BOOK{Odi90,
+        EDITOR             = {P. Odifreddi},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {Logic and Computer Science},
+        YEAR               = {1990}
+}
+
+@INPROCEEDINGS{PaMS92,
+        AUTHOR             = {M. Parigot and P. Manoury and M. Simonot},
+        ADDRESS            = {St. Petersburg, Russia},
+        BOOKTITLE          = {Logic Programming and automated reasoning},
+        EDITOR             = {A. Voronkov},
+        MONTH              = jul,
+        NUMBER             = {624},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{ProPre : A Programming language with proofs}},
+        YEAR               = {1992}
+}
+
+@ARTICLE{PaWe92,
+        AUTHOR             = {Christine Paulin-Mohring and Benjamin Werner},
+        JOURNAL            = {Journal of Symbolic Computation},
+        PAGES              = {607--640},
+        TITLE              = {{Synthesis of ML programs in the system Coq}},
+        VOLUME             = {15},
+        YEAR               = {1993}
+}
+
+@ARTICLE{Par92,
+        AUTHOR             = {M. Parigot},
+        JOURNAL            = {Theoretical Computer Science},
+        NUMBER             = {2},
+        PAGES              = {335--356},
+        TITLE              = {{Recursive Programming with Proofs}},
+        VOLUME             = {94},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Parent95b,
+        AUTHOR             = {C. Parent},
+        BOOKTITLE          = {{Mathematics of Program Construction'95}},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{Synthesizing proofs from programs in
+the Calculus of Inductive Constructions}},
+        VOLUME             = {947},
+        YEAR               = {1995}
+}
+
+@INPROCEEDINGS{Prasad93,
+        AUTHOR             = {K.V. Prasad},
+        BOOKTITLE          = {{Proceedings of CONCUR'93}},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{Programming with broadcasts}},
+        VOLUME             = {715},
+        YEAR               = {1993}
+}
+
+@BOOK{RC95,
+  author = "di~Cosmo, R.",
+  title  = "Isomorphisms of Types: from $\lambda$-calculus to information
+            retrieval and language design",
+  series = "Progress in Theoretical Computer Science",
+  publisher = "Birkhauser",
+  year = "1995",
+  note = "ISBN-0-8176-3763-X"
+}
+
+@TECHREPORT{Rou92,
+        AUTHOR             = {J. Rouyer},
+        INSTITUTION        = {INRIA},
+        MONTH              = nov,
+        NUMBER             = {1795},
+        TITLE              = {{D{\'e}veloppement de l'Algorithme d'Unification dans le Calcul des Constructions}},
+        YEAR               = {1992}
+}
+
+@TECHREPORT{Saibi94,
+        AUTHOR             = {A. Sa\"{\i}bi},
+        INSTITUTION        = {INRIA},
+        MONTH              = dec,
+        NUMBER             = {2345},
+        TITLE              = {{Axiomatization of a lambda-calculus with explicit-substitutions in the Coq System}},
+        YEAR               = {1994}
+}
+
+
+@MASTERSTHESIS{Ter92,
+        AUTHOR             = {D. Terrasse},
+        MONTH              = sep,
+        SCHOOL             = {IARFA},
+        TITLE              = {{Traduction de TYPOL en COQ. Application \`a Mini ML}},
+        YEAR               = {1992}
+}
+
+@TECHREPORT{ThBeKa92,
+        AUTHOR             = {L. Th\'ery and Y. Bertot and G. Kahn},
+        INSTITUTION        = {INRIA Sophia},
+        MONTH              = may,
+        NUMBER             = {1684},
+        TITLE              = {Real theorem provers deserve real user-interfaces},
+        TYPE               = {Research Report},
+        YEAR               = {1992}
+}
+
+@BOOK{TrDa89,
+        AUTHOR             = {A.S. Troelstra and D. van Dalen},
+        PUBLISHER          = {North-Holland},
+        SERIES             = {Studies in Logic and the foundations of Mathematics, volumes 121 and 123},
+        TITLE              = {Constructivism in Mathematics, an introduction},
+        YEAR               = {1988}
+}
+
+@PHDTHESIS{Wer94,
+        AUTHOR             = {B. Werner},
+        SCHOOL             = {Universit\'e Paris 7},
+        TITLE              = {Une th\'eorie des constructions inductives},
+        TYPE               = {Th\`ese de Doctorat},
+        YEAR               = {1994}
+}
+
+@PHDTHESIS{Bar99,
+        AUTHOR             = {B. Barras},
+        SCHOOL             = {Universit\'e Paris 7},
+        TITLE              = {Auto-validation d'un système de preuves avec familles inductives},
+        TYPE               = {Th\`ese de Doctorat},
+        YEAR               = {1999}
+}
+
+@UNPUBLISHED{ddr98,
+	AUTHOR	           = {D. de Rauglaudre},
+        TITLE              = {Camlp4 version 1.07.2},
+        YEAR               = {1998},
+        NOTE               = {In Camlp4 distribution}
+}
+
+@ARTICLE{dowek93,
+        AUTHOR             = {G. Dowek},
+        TITLE              = {{A Complete Proof Synthesis Method for the Cube of Type Systems}},
+        JOURNAL            = {Journal Logic Computation},
+        VOLUME             = {3},
+        NUMBER             = {3},
+        PAGES              = {287--315},
+        MONTH              = {June},
+        YEAR               = {1993}
+}
+
+@INPROCEEDINGS{manoury94,
+        AUTHOR             = {P. Manoury},
+        TITLE              = {{A User's Friendly Syntax to Define
+Recursive Functions as Typed $\lambda-$Terms}},
+        BOOKTITLE          = {{Types for Proofs and Programs, TYPES'94}},
+        SERIES             = {LNCS},
+        VOLUME             = {996},
+        MONTH              = jun,
+        YEAR               = {1994}
+}
+
+@TECHREPORT{maranget94,
+        AUTHOR             = {L. Maranget},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {2385},
+        TITLE              = {{Two Techniques for Compiling Lazy Pattern Matching}},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{puel-suarez90,
+        AUTHOR             = {L.Puel and A. Su\'arez},
+        BOOKTITLE          = {{Conference Lisp and Functional Programming}},
+        SERIES             = {ACM},
+        PUBLISHER          = SV,
+        TITLE              = {{Compiling Pattern Matching by Term
+Decomposition}},
+        YEAR               = {1990}
+}
+
+@MASTERSTHESIS{saidi94,
+        AUTHOR             = {H. Saidi},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique Fondamentale, Universit\'e Paris 7},
+        TITLE              = {R\'esolution d'\'equations dans le syst\`eme T
+ de G\"odel},
+        YEAR               = {1994}
+}
+
+@misc{streicher93semantical,
+  author = "T. Streicher",
+  title = "Semantical Investigations into Intensional Type Theory",
+  note = "Habilitationsschrift, LMU Munchen.",
+  year = "1993" }
+
+
+
+@Misc{Pcoq,
+  author =	 {Lemme Team},
+  title =	 {Pcoq a graphical user-interface for {Coq}},
+  note =	 {\url{http://www-sop.inria.fr/lemme/pcoq/}}
+}
+
+
+@Misc{ProofGeneral,
+  author =	 {David Aspinall},
+  title =	 {Proof General},
+  note =	 {\url{http://proofgeneral.inf.ed.ac.uk/}}
+}
+
+
+
+@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},
+        TITLE              = {Efficient  Compilation of Pattern Matching},
+        BOOKTITLE          = {The Implementation of Functional Programming
+Languages},
+        EDITOR             = {S.L. Peyton Jones},
+        PUBLISHER          = {Prentice-Hall},
+        YEAR               = {1987}
+}
+
+
+@COMMENT{cross-references, must be at end}
+
+@BOOK{Bastad92,
+        EDITOR             = {B. Nordstr\"om and K. Petersson and G. Plotkin},
+        PUBLISHER          = {Available by ftp at site ftp.inria.fr},
+        TITLE              = {Proceedings of the 1992 Workshop on Types for Proofs and Programs},
+        YEAR               = {1992}
+}
+
+@BOOK{Nijmegen93,
+        EDITOR             = {H. Barendregt and T. Nipkow},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {Types for Proofs and Programs},
+        VOLUME             = {806},
+        YEAR               = {1994}
+}
+
+@PHDTHESIS{Luo90,
+        AUTHOR             = {Z. Luo},
+        TITLE              = {An Extended Calculus of Constructions},
+        SCHOOL             = {University of Edinburgh},
+        YEAR               = {1990}
+}
diff --git a/doc/faq/hevea.sty b/doc/faq/hevea.sty
new file mode 100644
index 00000000..6d49aa8c
--- /dev/null
+++ b/doc/faq/hevea.sty
@@ -0,0 +1,78 @@
+% hevea  : hevea.sty
+% This is a very basic style file for latex document to be processed
+% with hevea. It contains definitions of LaTeX environment which are
+% processed in a special way by the translator. 
+%  Mostly :
+%     - latexonly, not processed by hevea, processed by latex.
+%     - htmlonly , the reverse.
+%     - rawhtml,  to include raw HTML in hevea output.
+%     - toimage, to send text to the image file.
+% The package also provides hevea logos, html related commands (ahref
+% etc.), void cutting and image commands.
+\NeedsTeXFormat{LaTeX2e}
+\ProvidesPackage{hevea}[2002/01/11]
+\RequirePackage{comment}
+\newif\ifhevea\heveafalse
+\@ifundefined{ifimagen}{\newif\ifimagen\imagenfalse}
+\makeatletter%
+\newcommand{\heveasmup}[2]{%
+\raise #1\hbox{$\m@th$%
+  \csname S@\f@size\endcsname
+  \fontsize\sf@size 0%
+  \math@fontsfalse\selectfont
+#2%
+}}%
+\DeclareRobustCommand{\hevea}{H\kern-.15em\heveasmup{.2ex}{E}\kern-.15emV\kern-.15em\heveasmup{.2ex}{E}\kern-.15emA}%
+\DeclareRobustCommand{\hacha}{H\kern-.15em\heveasmup{.2ex}{A}\kern-.15emC\kern-.1em\heveasmup{.2ex}{H}\kern-.15emA}%
+\DeclareRobustCommand{\html}{\protect\heveasmup{0.ex}{HTML}}
+%%%%%%%%% Hyperlinks hevea style
+\newcommand{\ahref}[2]{{#2}}
+\newcommand{\ahrefloc}[2]{{#2}}
+\newcommand{\aname}[2]{{#2}}
+\newcommand{\ahrefurl}[1]{\texttt{#1}}
+\newcommand{\footahref}[2]{#2\footnote{\texttt{#1}}}
+\newcommand{\mailto}[1]{\texttt{#1}}
+\newcommand{\imgsrc}[2][]{}
+\newcommand{\home}[1]{\protect\raisebox{-.75ex}{\char126}#1}
+\AtBeginDocument
+{\@ifundefined{url}
+{%url package is not loaded
+\let\url\ahref\let\oneurl\ahrefurl\let\footurl\footahref}
+{}}
+%% Void cutting instructions
+\newcounter{cuttingdepth}
+\newcommand{\tocnumber}{}
+\newcommand{\notocnumber}{}
+\newcommand{\cuttingunit}{}
+\newcommand{\cutdef}[2][]{}
+\newcommand{\cuthere}[2]{}
+\newcommand{\cutend}{}
+\newcommand{\htmlhead}[1]{}
+\newcommand{\htmlfoot}[1]{}
+\newcommand{\htmlprefix}[1]{}
+\newenvironment{cutflow}[1]{}{}
+\newcommand{\cutname}[1]{}
+\newcommand{\toplinks}[3]{}
+%%%% Html only
+\excludecomment{rawhtml}
+\newcommand{\rawhtmlinput}[1]{}
+\excludecomment{htmlonly}
+%%%% Latex only
+\newenvironment{latexonly}{}{}
+\newenvironment{verblatex}{}{}
+%%%% Image file stuff
+\def\toimage{\endgroup}
+\def\endtoimage{\begingroup\def\@currenvir{toimage}}
+\def\verbimage{\endgroup}
+\def\endverbimage{\begingroup\def\@currenvir{verbimage}}
+\newcommand{\imageflush}[1][]{}
+%%% Bgcolor definition
+\newsavebox{\@bgcolorbin}
+\newenvironment{bgcolor}[2][]
+  {\newcommand{\@mycolor}{#2}\begin{lrbox}{\@bgcolorbin}\vbox\bgroup}
+  {\egroup\end{lrbox}%
+   \begin{flushleft}%
+   \colorbox{\@mycolor}{\usebox{\@bgcolorbin}}%
+   \end{flushleft}}
+%%% Postlude
+\makeatother
diff --git a/doc/faq/interval_discr.v b/doc/faq/interval_discr.v
new file mode 100644
index 00000000..972300da
--- /dev/null
+++ b/doc/faq/interval_discr.v
@@ -0,0 +1,419 @@
+(** Sketch of the proof of {p:nat|p<=n} = {p:nat|p<=m} -> n=m
+
+  - preliminary results on the irrelevance of boundedness proofs
+  - introduce the notion of finite cardinal |A|
+  - prove that |{p:nat|p<=n}| = n
+  - prove that |A| = n /\ |A| = m -> n = m if equality is decidable on A
+  - prove that equality is decidable on A
+  - conclude
+*)
+
+(** * Preliminary results on [nat] and [le] *)
+
+(** Proving axiom K on [nat] *)
+
+Require Import Eqdep_dec.
+Require Import Arith.
+
+Theorem eq_rect_eq_nat :
+  forall (p:nat) (Q:nat->Type) (x:Q p) (h:p=p), x = eq_rect p Q x p h.
+Proof.
+intros.
+apply K_dec_set with (p := h).
+apply eq_nat_dec.
+reflexivity.
+Qed.
+
+(** Proving unicity of proofs of [(n<=m)%nat] *)
+
+Scheme le_ind' := Induction for le Sort Prop.
+
+Theorem le_uniqueness_proof : forall (n m : nat) (p q : n <= m), p = q.
+Proof.
+induction p using le_ind'; intro q.
+ replace (le_n n) with
+  (eq_rect _ (fun n0 => n <= n0) (le_n n) _ (refl_equal n)).
+ 2:reflexivity.
+  generalize (refl_equal n).
+    pattern n at 2 4 6 10, q; case q; [intro | intros m l e].
+     rewrite <- eq_rect_eq_nat; trivial.
+     contradiction (le_Sn_n m); rewrite <- e; assumption.
+ replace (le_S n m p) with
+  (eq_rect _ (fun n0 => n <= n0) (le_S n m p) _ (refl_equal (S m))).
+ 2:reflexivity.
+  generalize (refl_equal (S m)).
+    pattern (S m) at 1 3 4 6, q; case q; [intro Heq | intros m0 l HeqS].
+     contradiction (le_Sn_n m); rewrite Heq; assumption.
+     injection HeqS; intro Heq; generalize l HeqS.
+      rewrite <- Heq; intros; rewrite <- eq_rect_eq_nat.
+      rewrite (IHp l0); reflexivity.
+Qed.
+
+(** Proving irrelevance of boundedness proofs while building
+    elements of interval *)
+
+Lemma dep_pair_intro :
+  forall (n x y:nat) (Hx : x<=n) (Hy : y<=n), x=y ->
+    exist (fun x => x <= n) x Hx = exist (fun x => x <= n) y Hy.
+Proof.
+intros n x y Hx Hy Heq.
+generalize Hy.
+rewrite <- Heq.
+intros.
+rewrite (le_uniqueness_proof x n Hx Hy0).
+reflexivity.
+Qed.
+
+(** * Proving that {p:nat|p<=n} = {p:nat|p<=m} -> n=m *)
+
+(** Definition of having finite cardinality [n+1] for a set [A] *)
+
+Definition card (A:Set) n :=
+  exists f, 
+    (forall x:A, f x <= n) /\
+    (forall x y:A, f x = f y -> x = y) /\
+    (forall m, m <= n -> exists x:A, f x = m).
+
+Require Import Arith.
+
+(** Showing that the interval [0;n] has cardinality [n+1] *)
+
+Theorem card_interval : forall n, card {x:nat|x<=n} n.
+Proof.
+intro n.
+exists (fun x:{x:nat|x<=n} => proj1_sig x).
+split.
+(* bounded *)
+intro x; apply (proj2_sig x).
+split.
+(* injectivity *) 
+intros (p,Hp) (q,Hq).
+simpl.
+intro Hpq.
+apply dep_pair_intro; assumption.
+(* surjectivity *)
+intros m Hmn.
+exists (exist (fun x : nat => x <= n) m Hmn).
+reflexivity.
+Qed.
+
+(** Showing that equality on the interval [0;n] is decidable *)
+
+Lemma interval_dec :
+  forall n (x y : {m:nat|m<=n}), {x=y}+{x<>y}.
+Proof.
+intros n (p,Hp).
+induction p; intros ([|q],Hq).
+left.
+  apply dep_pair_intro.
+  reflexivity.
+right.
+  intro H; discriminate H.
+right.
+  intro H; discriminate H.
+assert (Hp' : p <= n).
+  apply le_Sn_le; assumption.
+assert (Hq' : q <= n).
+  apply le_Sn_le; assumption.
+destruct (IHp Hp' (exist (fun m => m <= n) q Hq'))
+  as [Heq|Hneq].
+left.
+  injection Heq; intro Heq'.
+  apply dep_pair_intro.
+  apply eq_S.
+  assumption.
+right.
+  intro HeqS. 
+  injection HeqS; intro Heq.
+  apply Hneq.
+  apply dep_pair_intro.
+  assumption.
+Qed.
+
+(** Showing that the cardinality relation is functional on decidable sets *)
+
+Lemma card_inj_aux :
+  forall (A:Type) f g n, 
+    (forall x:A, f x <= 0) ->
+    (forall x y:A, f x = f y -> x = y) ->
+    (forall m, m <= S n -> exists x:A, g x = m)
+     -> False.
+Proof.
+intros A f g n Hfbound Hfinj Hgsurj.
+destruct (Hgsurj (S n) (le_n _)) as (x,Hx).
+destruct (Hgsurj n (le_S _ _ (le_n _))) as (x',Hx').
+assert (Hfx : 0 = f x).
+apply le_n_O_eq.
+apply Hfbound.
+assert (Hfx' : 0 = f x').
+apply le_n_O_eq.
+apply Hfbound.
+assert (x=x').
+apply Hfinj.
+rewrite <- Hfx.
+rewrite <- Hfx'.
+reflexivity.
+rewrite H in Hx.
+rewrite Hx' in Hx.
+apply (n_Sn _ Hx).
+Qed.
+
+(** For [dec_restrict], we use a lemma on the negation of equality
+that requires proof-irrelevance. It should be possible to avoid this
+lemma by generalizing over a first-order definition of [x<>y], say
+[neq] such that [{x=y}+{neq x y}] and [~(x=y /\ neq x y)]; for such
+[neq], unicity of proofs could be proven *)
+
+  Require Import Classical.
+  Lemma neq_dep_intro :
+   forall (A:Set) (z x y:A) (p:x<>z) (q:y<>z), x=y ->
+      exist (fun x => x <> z) x p = exist (fun x => x <> z) y q.
+  Proof.
+  intros A z x y p q Heq.
+   generalize q; clear q; rewrite <- Heq; intro q.
+   rewrite (proof_irrelevance _ p q); reflexivity.
+  Qed.
+
+Lemma dec_restrict :
+  forall (A:Set), 
+    (forall x y :A, {x=y}+{x<>y}) ->
+     forall z (x y :{a:A|a<>z}), {x=y}+{x<>y}.
+Proof.
+intros A Hdec z (x,Hx) (y,Hy).
+destruct (Hdec x y) as [Heq|Hneq].
+left; apply neq_dep_intro; assumption.
+right; intro Heq; injection Heq; exact Hneq.
+Qed.
+
+Lemma pred_inj : forall n m, 
+  0 <> n -> 0 <> m -> pred m = pred n -> m = n.
+Proof.
+destruct n.
+intros m H; destruct H; reflexivity.
+destruct m.
+intros _ H; destruct H; reflexivity.
+simpl; intros _ _ H.
+rewrite H.
+reflexivity.
+Qed.
+
+Lemma le_neq_lt : forall n m, n <= m -> n<>m -> n < m.
+Proof.
+intros n m Hle Hneq.
+destruct (le_lt_eq_dec n m Hle).
+assumption.
+contradiction.
+Qed.
+
+Lemma inj_restrict :
+  forall (A:Set) (f:A->nat) x y z,
+    (forall x y : A, f x = f y -> x = y)
+    -> x <> z -> f y < f z -> f z <= f x
+    -> pred (f x) = f y
+    -> False.
+
+(* Search error sans le type de f !! *)
+Proof.
+intros A f x y z Hfinj Hneqx Hfy Hfx Heq.
+assert (f z <> f x).
+  apply sym_not_eq.
+  intro Heqf.
+  apply Hneqx.
+  apply Hfinj.
+  assumption.
+assert (f x = S (f y)).
+  assert (0 < f x).
+    apply le_lt_trans with (f z).
+    apply le_O_n.
+    apply le_neq_lt; assumption.
+  apply pred_inj.
+  apply O_S.
+  apply lt_O_neq; assumption.
+  exact Heq.
+assert (f z <= f y).
+destruct (le_lt_or_eq _ _ Hfx).
+  apply lt_n_Sm_le.
+  rewrite <- H0.
+  assumption.
+  contradiction Hneqx.
+  symmetry.
+  apply Hfinj.
+  assumption.
+contradiction (lt_not_le (f y) (f z)).
+Qed.
+
+Theorem card_inj : forall m n (A:Set), 
+  (forall x y :A, {x=y}+{x<>y}) ->
+  card A m -> card A n -> m = n. 
+Proof.
+induction m; destruct n; 
+intros A Hdec
+ (f,(Hfbound,(Hfinj,Hfsurj))) 
+ (g,(Hgbound,(Hginj,Hgsurj))).
+(* 0/0 *)
+reflexivity.
+(* 0/Sm *)
+destruct (card_inj_aux _ _ _ _ Hfbound Hfinj Hgsurj).
+(* Sn/0 *)
+destruct (card_inj_aux _ _ _ _ Hgbound Hginj Hfsurj).
+(* Sn/Sm *)
+destruct (Hgsurj (S n) (le_n _)) as (xSn,HSnx).
+rewrite IHm with (n:=n) (A := {x:A|x<>xSn}).
+reflexivity.
+(* decidability of eq on {x:A|x<>xSm} *)
+apply dec_restrict.
+assumption.
+(* cardinality of {x:A|x<>xSn} is m *)
+pose (f' := fun x' : {x:A|x<>xSn} =>
+    let (x,Hneq) := x' in 
+    if le_lt_dec (f xSn) (f x)
+    then pred (f x)
+    else f x).
+exists f'.
+split.
+(* f' is bounded *)
+unfold f'.
+intros (x,_).
+destruct (le_lt_dec (f xSn) (f x)) as [Hle|Hge].
+change m with (pred (S m)).
+apply le_pred.
+apply Hfbound.
+apply le_S_n.
+apply le_trans with (f xSn).
+exact Hge.
+apply Hfbound.
+split.
+(* f' is injective *)
+unfold f'.
+intros (x,Hneqx) (y,Hneqy) Heqf'.
+destruct (le_lt_dec (f xSn) (f x)) as [Hlefx|Hgefx];
+destruct (le_lt_dec (f xSn) (f y)) as [Hlefy|Hgefy].
+(* f xSn <= f x et f xSn <= f y *)
+assert (Heq : x = y).
+  apply Hfinj.
+  assert (f xSn <> f y).
+    apply sym_not_eq.
+    intro Heqf.
+    apply Hneqy.
+    apply Hfinj.
+    assumption.
+  assert (0 < f y).
+    apply le_lt_trans with (f xSn).
+    apply le_O_n.
+    apply le_neq_lt; assumption.
+  assert (f xSn <> f x).
+    apply sym_not_eq.
+    intro Heqf.
+    apply Hneqx.
+    apply Hfinj.
+    assumption.
+  assert (0 < f x).
+    apply le_lt_trans with (f xSn).
+    apply le_O_n.
+    apply le_neq_lt; assumption.
+  apply pred_inj.
+  apply lt_O_neq; assumption.
+  apply lt_O_neq; assumption.
+  assumption.
+apply neq_dep_intro; assumption.
+(* f y < f xSn <= f x *)
+destruct (inj_restrict A f x y xSn); assumption.
+(* f x < f xSn <= f y *)
+symmetry in Heqf'.
+destruct (inj_restrict A f y x xSn); assumption.
+(* f x < f xSn et f y < f xSn *)
+assert (Heq : x=y).
+  apply Hfinj; assumption.
+apply neq_dep_intro; assumption.
+(* f' is surjective *)
+intros p Hlep.
+destruct (le_lt_dec (f xSn) p) as [Hle|Hlt].
+(* case f xSn <= p *)
+destruct (Hfsurj (S p) (le_n_S _ _ Hlep)) as (x,Hx).
+assert (Hneq : x <> xSn).
+  intro Heqx.
+  rewrite Heqx in Hx.
+  rewrite Hx in Hle.
+  apply le_Sn_n with p; assumption.
+exists (exist (fun a => a<>xSn) x Hneq).
+unfold f'.
+destruct (le_lt_dec (f xSn) (f x)) as [Hle'|Hlt'].
+rewrite Hx; reflexivity.
+rewrite Hx in Hlt'.
+contradiction (le_not_lt (f xSn) p).
+apply lt_trans with (S p).
+apply lt_n_Sn.
+assumption.
+(* case p < f xSn *)
+destruct (Hfsurj p (le_S _ _ Hlep)) as (x,Hx).
+assert (Hneq : x <> xSn).
+  intro Heqx.
+  rewrite Heqx in Hx.
+  rewrite Hx in Hlt.
+  apply (lt_irrefl p).
+  assumption.
+exists (exist (fun a => a<>xSn) x Hneq).
+unfold f'.
+destruct (le_lt_dec (f xSn) (f x)) as [Hle'|Hlt'].
+  rewrite Hx in Hle'.
+  contradiction (lt_irrefl p).
+  apply lt_le_trans with (f xSn); assumption.
+  assumption.
+(* cardinality of {x:A|x<>xSn} is n *)
+pose (g' := fun x' : {x:A|x<>xSn} =>
+   let (x,Hneq) := x' in 
+   if Hdec x xSn then 0 else g x).
+exists g'.
+split.
+(* g is bounded *)
+unfold g'.
+intros (x,_).
+destruct (Hdec x xSn) as [_|Hneq].
+apply le_O_n.
+assert (Hle_gx:=Hgbound x).
+destruct (le_lt_or_eq _ _ Hle_gx).
+apply lt_n_Sm_le.
+assumption.
+contradiction Hneq.
+apply Hginj.
+rewrite HSnx.
+assumption.
+split.
+(* g is injective *)
+unfold g'.
+intros (x,Hneqx) (y,Hneqy) Heqg'.
+destruct (Hdec x xSn) as [Heqx|_].
+contradiction Hneqx.
+destruct (Hdec y xSn) as [Heqy|_].
+contradiction Hneqy.
+assert (Heq : x=y).
+  apply Hginj; assumption.
+apply neq_dep_intro; assumption.
+(* g is surjective *)
+intros p Hlep.
+destruct (Hgsurj p (le_S _ _ Hlep)) as (x,Hx).
+assert (Hneq : x<>xSn).
+  intro Heq.
+  rewrite Heq in Hx.
+  rewrite Hx in HSnx.
+  rewrite HSnx in Hlep.
+  contradiction (le_Sn_n _ Hlep).
+exists (exist (fun a => a<>xSn) x Hneq).
+simpl.
+destruct (Hdec x xSn) as [Heqx|_].
+contradiction Hneq.
+assumption.
+Qed.
+
+(** Conclusion *)
+
+Theorem interval_discr :
+  forall n m, {p:nat|p<=n} = {p:nat|p<=m} -> n=m.
+Proof.
+intros n m Heq.
+apply card_inj with (A := {p:nat|p<=n}).
+apply interval_dec.
+apply card_interval.
+rewrite Heq.
+apply card_interval.
+Qed.
diff --git a/doc/refman/AddRefMan-pre.tex b/doc/refman/AddRefMan-pre.tex
new file mode 100644
index 00000000..5312b8fc
--- /dev/null
+++ b/doc/refman/AddRefMan-pre.tex
@@ -0,0 +1,58 @@
+%\coverpage{Addendum to the Reference Manual}{\ }
+%\addcontentsline{toc}{part}{Additional documentation}
+\setheaders{Presentation of the Addendum}
+\chapter*{Presentation of the Addendum}
+
+Here you will find several pieces of additional documentation for the
+\Coq\ Reference Manual. Each of this chapters is concentrated on a
+particular topic, that should interest only a fraction of the \Coq\
+users: that's the reason why they are apart from the Reference
+Manual.
+
+\begin{description}
+
+\item[Extended pattern-matching] This chapter details the use of
+  generalized pattern-matching. It is contributed by Cristina Cornes
+  and Hugo Herbelin.
+
+\item[Implicit coercions] This chapter details the use of the coercion
+  mechanism.  It is contributed by Amokrane Saïbi.
+
+%\item[Proof of imperative programs] This chapter explains how to
+%  prove properties of annotated programs with imperative features.
+%  It is contributed by Jean-Christophe Filliâtre
+
+\item[Program extraction] This chapter explains how to extract in practice ML
+  files from $\FW$ terms.   It is contributed by Jean-Christophe
+  Filliâtre and Pierre Letouzey.
+
+%\item[Natural] This chapter is due to Yann Coscoy. It is the user
+%  manual of the tools he wrote for printing proofs in natural
+%  language. At this time, French and English languages are supported.
+
+\item[omega] \texttt{omega}, written by Pierre Crégut, solves a whole
+  class of arithmetic problems.
+
+%\item[Program] The \texttt{Program} technology intends to inverse the
+%  extraction mechanism. It allows the developments of certified
+%  programs in \Coq. This chapter is due to Catherine Parent. {\bf This
+%  feature is not available in {\Coq} version 7.}
+
+\item[The {\tt ring} tactic] This is a tactic to do AC rewriting. This
+  chapter explains how to use it and how it works.
+  The chapter is contributed by Patrick Loiseleur.
+
+\item[The {\tt Setoid\_replace} tactic] This is a
+  tactic to do rewriting on types equipped with specific (only partially
+  substitutive) equality. The chapter is contributed by Clément Renard.
+
+
+\end{description}
+
+\atableofcontents
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/Cases.tex b/doc/refman/Cases.tex
new file mode 100644
index 00000000..95411afa
--- /dev/null
+++ b/doc/refman/Cases.tex
@@ -0,0 +1,698 @@
+\achapter{Extended pattern-matching}\defaultheaders
+\aauthor{Cristina Cornes}
+
+\label{Mult-match-full}
+\ttindex{Cases}
+\index{ML-like patterns}
+
+This section describes the full form of pattern-matching in {\Coq} terms.
+
+\asection{Patterns}\label{implementation} The full syntax of {\tt
+match} is presented in figures~\ref{term-syntax}
+and~\ref{term-syntax-aux}.  Identifiers in patterns are either
+constructor names or variables. Any identifier that is not the
+constructor of an inductive or coinductive type is considered to be a
+variable. A variable name cannot occur more than once in a given
+pattern. It is recommended to start variable names by a lowercase
+letter.
+
+If a pattern has the form $(c~\vec{x})$ where $c$ is a constructor
+symbol and $\vec{x}$ is a linear vector of variables, it is called
+{\em simple}: it is the kind of pattern recognized by the basic
+version of {\tt match}. If a pattern is
+not simple we call it {\em nested}.
+
+A variable pattern matches any value, and the identifier is bound to
+that value. The pattern ``\texttt{\_}'' (called ``don't care'' or
+``wildcard'' symbol) also matches any value, but does not bind anything. It
+may occur an arbitrary number of times in a pattern. Alias patterns
+written \texttt{(}{\sl pattern} \texttt{as} {\sl identifier}\texttt{)} are
+also accepted. This pattern matches the same values as {\sl pattern}
+does and {\sl identifier} is bound to the matched value.  A list of
+patterns separated with commas 
+is also considered as a pattern and is called {\em multiple
+pattern}.
+
+Since extended {\tt match} expressions are compiled into the primitive
+ones, the expressiveness of the theory remains the same. Once the
+stage of parsing has finished only simple patterns remain. An easy way
+to see the result of the expansion is by printing the term with
+\texttt{Print} if the term is a constant, or using the command
+\texttt{Check}.
+
+The extended \texttt{match} still accepts an optional {\em elimination
+predicate} given after the keyword \texttt{return}.  Given a pattern
+matching expression, if all the right hand sides of \texttt{=>} ({\em
+rhs} in short) have the same type, then this type can be sometimes
+synthesized, and so we can omit the \texttt{return} part. Otherwise 
+the predicate after \texttt{return} has to be provided, like for the basic
+\texttt{match}.
+
+Let us illustrate through examples the different aspects of extended
+pattern matching. Consider for example the function that computes the
+maximum of two natural numbers. We can write it in primitive syntax
+by:
+
+\begin{coq_example}
+Fixpoint max (n m:nat) {struct m} : nat :=
+  match n with
+  | O => m
+  | S n' => match m with
+            | O => S n'
+            | S m' => S (max n' m')
+            end
+  end.
+\end{coq_example}
+
+Using multiple patterns in the definition allows to write:
+
+\begin{coq_example}
+Reset max.
+Fixpoint max (n m:nat) {struct m} : nat :=
+  match n, m with
+  | O, _ => m
+  | S n', O => S n'
+  | S n', S m' => S (max n' m')
+  end.
+\end{coq_example}
+
+which will be compiled into the previous form.
+
+The pattern-matching compilation strategy examines patterns from left
+to right. A \texttt{match} expression is generated {\bf only} when
+there is at least one constructor in the column of patterns. E.g. the
+following example does not build a \texttt{match} expression.
+
+\begin{coq_example}
+Check (fun x:nat => match x return nat with
+                    | y => y
+                    end).
+\end{coq_example}
+
+We can also use ``\texttt{as} patterns'' to associate a name to a
+sub-pattern:
+
+\begin{coq_example}
+Reset max.
+Fixpoint max (n m:nat) {struct n} : nat :=
+  match n, m with
+  | O, _ => m
+  | S n' as p, O => p
+  | S n', S m' => S (max n' m')
+  end.
+\end{coq_example}
+
+Here is now an example of nested patterns:
+
+\begin{coq_example}
+Fixpoint even (n:nat) : bool :=
+  match n with
+  | O => true
+  | S O => false
+  | S (S n') => even n'
+  end.
+\end{coq_example}
+
+This is compiled into:
+
+\begin{coq_example}
+Print even.
+\end{coq_example}
+
+In the previous examples patterns do not conflict with, but
+sometimes it is comfortable to write patterns that admit a non
+trivial superposition. Consider
+the boolean function \texttt{lef} that given two natural numbers
+yields \texttt{true} if the first one is less or equal than the second
+one and \texttt{false} otherwise. We can write it as follows:
+
+\begin{coq_example}
+Fixpoint lef (n m:nat) {struct m} : bool :=
+  match n, m with
+  | O, x => true
+  | x, O => false
+  | S n, S m => lef n m
+  end.
+\end{coq_example}
+
+Note that the first and the second multiple pattern superpose because
+the couple of values \texttt{O O} matches both. Thus, what is the result
+of the function on those values?  To eliminate ambiguity we use the
+{\em textual priority rule}: we consider patterns ordered from top to
+bottom, then a value is matched by the pattern at the $ith$ row if and
+only if it is not matched by some pattern of a previous row. Thus in the
+example,
+\texttt{O O} is matched by the first pattern, and so \texttt{(lef O O)}
+yields \texttt{true}.
+
+Another way to write  this function is:
+
+\begin{coq_example}
+Reset lef.
+Fixpoint lef (n m:nat) {struct m} : bool :=
+  match n, m with
+  | O, x => true
+  | S n, S m => lef n m
+  | _, _ => false
+  end.
+\end{coq_example}
+
+
+Here the last pattern superposes with the first two. Because
+of the priority rule, the last pattern 
+will be used only for values that do not match neither the  first nor
+the second one.  
+
+Terms with useless patterns are not accepted by the
+system. Here is an example:
+% Test failure
+\begin{coq_eval}
+Set Printing Depth 50.
+  (********** The following is not correct and should produce **********)
+  (**************** Error: This clause is redundant ********************)
+\end{coq_eval}
+\begin{coq_example}
+Check (fun x:nat =>
+         match x with
+         | O => true
+         | S _ => false
+         | x => true
+         end).
+\end{coq_example}
+
+\asection{About patterns of parametric types}
+When matching objects of a parametric type, constructors in patterns
+{\em do not expect} the parameter arguments. Their value is deduced
+during expansion.
+
+Consider for example the polymorphic lists:
+
+\begin{coq_example}
+Inductive List (A:Set) : Set :=
+  | nil : List A
+  | cons : A -> List A -> List A.
+\end{coq_example}
+
+We can check the function {\em tail}:
+
+\begin{coq_example}
+Check
+  (fun l:List nat =>
+     match l with
+     | nil => nil nat
+     | cons _ l' => l'
+     end).
+\end{coq_example}
+
+
+When we use parameters in patterns there is an error message:
+% Test failure
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is not correct and should produce **********)
+(******** Error: The constructor cons expects 2 arguments ************)
+\end{coq_eval}
+\begin{coq_example}
+Check
+  (fun l:List nat =>
+     match l with
+     | nil A => nil nat
+     | cons A _ l' => l'
+     end).
+\end{coq_example}
+
+
+
+\asection{Matching objects of dependent types}
+The previous examples illustrate pattern matching on objects of
+non-dependent types, but we can also 
+use the expansion strategy to destructure objects of dependent type.
+Consider the type \texttt{listn} of lists of a certain length:
+
+\begin{coq_example}
+Inductive listn : nat -> Set :=
+  | niln : listn 0
+  | consn : forall n:nat, nat -> listn n -> listn (S n).
+\end{coq_example}
+
+\asubsection{Understanding dependencies in patterns}
+We can define the function \texttt{length} over \texttt{listn} by:
+
+\begin{coq_example}
+Definition length (n:nat) (l:listn n) := n.
+\end{coq_example}
+
+Just for illustrating pattern matching, 
+we can define it by case analysis:
+
+\begin{coq_example}
+Reset length.
+Definition length (n:nat) (l:listn n) :=
+  match l with
+  | niln => 0
+  | consn n _ _ => S n
+  end.
+\end{coq_example}
+
+We can understand the meaning of this definition using the
+same notions of usual pattern matching.
+
+%
+% Constraining of dependencies is not longer valid in V7
+%
+\iffalse
+Now suppose we split the second pattern  of \texttt{length} into two 
+cases so to give an
+alternative definition using nested patterns:
+\begin{coq_example}
+Definition length1 (n:nat) (l:listn n) :=
+  match l with
+  | niln => 0
+  | consn n _ niln => S n
+  | consn n _ (consn _ _ _) => S n
+  end.
+\end{coq_example}
+
+It is obvious that \texttt{length1} is  another version of
+\texttt{length}. We can also give the following definition:
+\begin{coq_example}
+Definition length2 (n:nat) (l:listn n) :=
+  match l with
+  | niln => 0
+  | consn n _ niln => 1
+  | consn n _ (consn m _ _) => S (S m)
+  end.
+\end{coq_example}
+
+If we forget that \texttt{listn} is a dependent type and we read these
+definitions using the usual semantics of pattern matching,  we can conclude
+that \texttt{length1}
+and \texttt{length2} are different functions.
+In fact, they are equivalent
+because the pattern \texttt{niln} implies that \texttt{n} can only match
+the value $0$ and analogously the pattern \texttt{consn} determines that \texttt{n} can
+only match  values of the form  $(S~v)$ where $v$ is the value matched by
+\texttt{m}. 
+
+The converse is also true. If
+we destructure the  length  value with the pattern \texttt{O} then the list
+value should be $niln$. 
+Thus, the following term \texttt{length3} corresponds to the function
+\texttt{length} but this time defined by case analysis on the dependencies instead of on the list:
+
+\begin{coq_example}
+Definition length3 (n:nat) (l:listn n) :=
+  match l with
+  | niln => 0
+  | consn O _ _ => 1
+  | consn (S n) _ _ => S (S n)
+  end.
+\end{coq_example}
+
+When we have nested patterns of dependent types, the semantics of
+pattern matching becomes a little more difficult because
+the set of values that are matched by a sub-pattern may be conditioned by the
+values matched by another sub-pattern. Dependent nested patterns are
+somehow constrained patterns. 
+In the examples, the expansion of
+\texttt{length1} and \texttt{length2} yields exactly the same term
+ but the
+expansion of \texttt{length3} is completely different. \texttt{length1} and
+\texttt{length2} are expanded into two nested case analysis on
+\texttt{listn} while \texttt{length3} is expanded into a case analysis on
+\texttt{listn} containing a case analysis on natural numbers inside.
+
+
+In practice the user can think about the patterns as independent and
+it is the expansion algorithm that cares to relate them. \\
+\fi
+%
+%
+%
+
+\asubsection{When the elimination predicate must be provided}
+The examples  given so far do not need an explicit elimination predicate
+ because all the rhs have the same type and the
+strategy succeeds to synthesize it.
+Unfortunately when dealing with dependent patterns it often happens
+that we need to write cases where the type of the rhs are 
+different  instances of the elimination  predicate.
+The function  \texttt{concat} for \texttt{listn}
+is an example where the branches have different type
+and we need to provide the elimination predicate:
+
+\begin{coq_example}
+Fixpoint concat (n:nat) (l:listn n) (m:nat) (l':listn m) {struct l} :
+ listn (n + m) :=
+  match l in listn n return listn (n + m) with
+  | niln => l'
+  | consn n' a y => consn (n' + m) a (concat n' y m l')
+  end.
+\end{coq_example}
+The elimination predicate is {\tt fun (n:nat) (l:listn n) => listn~(n+m)}.
+In general if $m$ has type $(I~q_1\ldots q_r~t_1\ldots t_s)$ where 
+$q_1\ldots q_r$ are parameters, the elimination predicate should be of
+the form~:
+{\tt fun $y_1$\ldots $y_s$ $x$:($I$~$q_1$\ldots $q_r$~$y_1$\ldots
+  $y_s$) => P}. 
+
+In the concrete syntax, it should be written~:
+\[ \kw{match}~m~\kw{as}~x~\kw{in}~(I~\_\ldots \_~y_1\ldots y_s)~\kw{return}~Q~\kw{with}~\ldots~\kw{end}\]
+
+The variables which appear in the \kw{in} and \kw{as} clause are new
+and bounded in the property $Q$ in the \kw{return} clause. The
+parameters of the inductive definitions should not be mentioned and
+are replaced by \kw{\_}.
+
+Recall that a list of patterns is also a pattern. So, when
+we destructure several terms at the same time and the branches have
+different type  we need to provide
+the elimination predicate for this multiple pattern. 
+It is done using the same scheme, each term may be associated to an
+\kw{as} and \kw{in} clause in order to introduce a dependent product.
+
+For example, an equivalent definition for \texttt{concat} (even though the matching on the second term is trivial) would have
+been:
+
+\begin{coq_example}
+Reset concat.
+Fixpoint concat (n:nat) (l:listn n) (m:nat) (l':listn m) {struct l} :
+ listn (n + m) :=
+  match l in listn n, l' return listn (n + m) with
+  | niln, x => x
+  | consn n' a y, x => consn (n' + m) a (concat n' y m x)
+  end.
+\end{coq_example}
+
+% Notice that this time, the predicate \texttt{[n,\_:nat](listn (plus n
+%   m))}  is binary because we
+% destructure both \texttt{l} and \texttt{l'} whose types have arity one.
+% In general, if we destructure the terms $e_1\ldots e_n$
+% the predicate will be of arity $m$ where $m$ is the sum of the
+% number of dependencies of the type of $e_1, e_2,\ldots e_n$ 
+% (the $\lambda$-abstractions
+% should correspond from left to right to each dependent argument of the
+% type of $e_1\ldots e_n$).
+When the arity of the predicate (i.e. number of abstractions) is not
+correct Coq raises an error message. For example:
+
+% Test failure
+\begin{coq_eval}
+Reset concat.
+Set Printing Depth 50.
+(********** The following is not correct and should produce ***********)
+(** Error: the term l' has type listn m while it is expected to have **)
+(** type listn (?31 + ?32)                                           **)
+\end{coq_eval}
+\begin{coq_example}
+Fixpoint concat
+ (n:nat) (l:listn n) (m:nat)
+ (l':listn m) {struct l} : listn (n + m) :=
+  match l, l' with
+  | niln, x => x
+  | consn n' a y, x => consn (n' + m) a (concat n' y m x)
+  end.
+\end{coq_example}
+
+\asection{Using pattern matching to write proofs}
+In all the previous examples the elimination predicate does not depend
+on the object(s) matched. But it may depend and the typical case 
+is when we write a proof by induction or a function that yields an
+object of dependent type. An example of proof using \texttt{match} in
+given in section \ref{refine-example}
+
+For example, we can write 
+the function \texttt{buildlist} that given a natural number
+$n$ builds a list of length $n$ containing zeros as follows:
+
+\begin{coq_example}
+Fixpoint buildlist (n:nat) : listn n :=
+  match n return listn n with
+  | O => niln
+  | S n => consn n 0 (buildlist n)
+  end.
+\end{coq_example}
+
+We can also use multiple patterns. 
+Consider the following definition of the predicate less-equal
+\texttt{Le}:
+
+\begin{coq_example}
+Inductive LE : nat -> nat -> Prop :=
+  | LEO : forall n:nat, LE 0 n
+  | LES : forall n m:nat, LE n m -> LE (S n) (S m).
+\end{coq_example}
+
+We can use multiple patterns to write  the proof of the lemma
+ \texttt{(n,m:nat) (LE n m)}\verb=\/=\texttt{(LE m n)}:
+
+\begin{coq_example}
+Fixpoint dec (n m:nat) {struct n} : LE n m \/ LE m n :=
+  match n, m return LE n m \/ LE m n with
+  | O, x => or_introl (LE x 0) (LEO x)
+  | x, O => or_intror (LE x 0) (LEO x)
+  | S n as n', S m as m' =>
+      match dec n m with
+      | or_introl h => or_introl (LE m' n') (LES n m h)
+      | or_intror h => or_intror (LE n' m') (LES m n h)
+      end
+  end.
+\end{coq_example}
+In the example of \texttt{dec},
+the first \texttt{match} is dependent while 
+the second is not.
+
+% In general, consider the terms $e_1\ldots e_n$,
+% where  the type of $e_i$ is an instance of a family type
+% $\lb (\vec{d_i}:\vec{D_i}) \mto T_i$  ($1\leq i
+% \leq n$). Then, in expression \texttt{match}  $e_1,\ldots,
+% e_n$ \texttt{of} \ldots \texttt{end}, the 
+% elimination predicate ${\cal P}$ should be of the form:
+% $[\vec{d_1}:\vec{D_1}][x_1:T_1]\ldots [\vec{d_n}:\vec{D_n}][x_n:T_n]Q.$
+
+The user can also use \texttt{match} in combination with the tactic
+\texttt{refine} (see section \ref{refine}) to build incomplete proofs
+beginning with a \texttt{match} construction.
+
+\asection{Pattern-matching on inductive objects involving local
+definitions}
+
+If local definitions occur in the type of a constructor, then there
+are two ways to match on this constructor. Either the local
+definitions are skipped and matching is done only on the true arguments
+of the constructors, or the bindings for local definitions can also
+be caught in the matching.
+
+Example.
+
+\begin{coq_eval}
+Reset Initial.
+Require Import Arith.
+\end{coq_eval}
+
+\begin{coq_example*}
+Inductive list : nat -> Set :=
+  | nil : list 0
+  | cons : forall n:nat, let m := (2 * n) in list m -> list (S (S m)).
+\end{coq_example*}
+
+In the next example, the local definition is not caught.
+
+\begin{coq_example}
+Fixpoint length n (l:list n) {struct l} : nat :=
+  match l with
+  | nil => 0
+  | cons n l0 => S (length (2 * n) l0)
+  end.
+\end{coq_example}
+
+But in this example, it is.
+
+\begin{coq_example}
+Fixpoint length' n (l:list n) {struct l} : nat :=
+  match l with
+  | nil => 0
+  | cons _ m l0 => S (length' m l0)
+  end.
+\end{coq_example}
+
+\Rem for a given matching clause, either none of the local
+definitions or all of them can be caught.
+
+\asection{Pattern-matching and coercions}
+
+If a mismatch occurs between the expected type of a pattern and its
+actual type, a coercion made from constructors is sought. If such a
+coercion can be found, it is automatically inserted around the
+pattern.
+
+Example:
+
+\begin{coq_example}
+Inductive I : Set :=
+  | C1 : nat -> I
+  | C2 : I -> I.
+Coercion C1 : nat >-> I.
+Check (fun x => match x with
+                | C2 O => 0
+                | _ => 0
+                end).
+\end{coq_example}
+
+
+\asection{When does the expansion strategy fail ?}\label{limitations}
+The strategy works very like in ML languages when treating
+patterns of non-dependent type.  
+But there are new cases of failure that are due to the presence of 
+dependencies. 
+
+The error messages of the current implementation may be sometimes
+confusing.  When the tactic fails because patterns are somehow
+incorrect then error messages refer to the initial expression. But the
+strategy may succeed to build an expression whose sub-expressions are
+well typed when the whole expression is not. In this situation the
+message makes reference to the expanded expression.  We encourage
+users, when they have patterns with the same outer constructor in
+different equations, to name the variable patterns in the same
+positions with the same name.  
+E.g. to write {\small\texttt{(cons n O x) => e1}} 
+and {\small\texttt{(cons n \_ x) => e2}} instead of
+{\small\texttt{(cons n O x) => e1}} and 
+{\small\texttt{(cons n' \_ x') => e2}}. 
+This helps to maintain certain name correspondence between the
+generated expression and the original.
+
+Here is a summary of the error messages corresponding to each situation:
+
+\begin{ErrMsgs}
+\item \sverb{The constructor } {\sl
+    ident} \sverb{expects } {\sl num} \sverb{arguments}
+  
+ \sverb{The variable } {\sl ident} \sverb{is bound several times
+    in pattern } {\sl term}
+  
+ \sverb{Found a constructor of inductive type} {\term}
+ \sverb{while a constructor of} {\term} \sverb{is expected}
+
+ Patterns are incorrect (because constructors are not applied to
+  the correct number of the arguments, because they are not linear or
+  they are wrongly typed)
+
+\item \errindex{Non exhaustive pattern-matching}
+
+the pattern matching is not exhaustive
+
+\item \sverb{The elimination predicate } {\sl term} \sverb{should be
+    of arity } {\sl num} \sverb{(for non dependent case) or } {\sl
+    num} \sverb{(for dependent case)}
+
+The elimination predicate provided to \texttt{match} has not the
+  expected arity
+
+
+%\item the whole expression is wrongly typed
+
+% CADUC ?
+% , or the synthesis of
+%   implicit arguments fails (for example to find the elimination
+%   predicate or to resolve implicit arguments in the rhs).
+ 
+%   There are {\em nested patterns of dependent type}, the elimination
+%   predicate corresponds to non-dependent case and has the form
+%   $[x_1:T_1]...[x_n:T_n]T$ and {\bf some} $x_i$ occurs {\bf free} in
+%   $T$.  Then, the strategy may fail to find out a correct elimination
+%   predicate during some step of compilation.  In this situation we
+%   recommend the user to rewrite the nested dependent patterns into
+%   several \texttt{match} with {\em simple patterns}.
+  
+\item {\tt Unable to infer a match predicate\\
+    Either there is a type incompatiblity or the problem involves\\
+    dependencies}
+ 
+  There is a type mismatch between the different branches
+
+  Then the user should provide an elimination predicate.
+
+% Obsolete ?  
+% \item because of nested patterns, it may happen that even though all
+%   the rhs have the same type, the strategy needs dependent elimination
+%   and so an elimination predicate must be provided. The system warns
+%   about this situation, trying to compile anyway with the
+%   non-dependent strategy. The risen message is:
+
+% \begin{itemize}
+% \item {\tt Warning: This pattern matching may need dependent
+%     elimination to be compiled.  I will try, but if fails try again
+%     giving dependent elimination predicate.}
+% \end{itemize}
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% % LA PROPAGATION DES CONTRAINTES ARRIERE N'EST PAS FAITE DANS LA V7
+% TODO
+% \item there are {\em nested patterns of dependent type} and the
+%   strategy builds a term that is well typed but recursive calls in fix
+%   point are reported as illegal:
+% \begin{itemize}
+% \item {\tt Error: Recursive call applied to an illegal term ...}
+% \end{itemize}
+
+% This is because the strategy generates a term that is correct w.r.t.
+% the initial term but which does not pass the guard condition.  In
+% this situation we recommend the user to transform the nested dependent
+% patterns into {\em several \texttt{match} of simple patterns}.  Let us
+% explain this with an example.  Consider the following definition of a
+% function that yields the last element of a list and \texttt{O} if it is
+% empty:
+
+% \begin{coq_example}
+%   Fixpoint last [n:nat; l:(listn n)] : nat :=
+%    match l of 
+%      (consn _ a niln) => a
+%    | (consn m _ x) => (last m x) | niln => O
+%    end.
+% \end{coq_example}
+
+% It fails because of the priority between patterns, we know that this
+% definition is equivalent to the following more explicit one (which
+% fails too):
+
+% \begin{coq_example*}
+%   Fixpoint last [n:nat; l:(listn n)] : nat :=
+%    match l of
+%      (consn _ a niln) => a
+%    | (consn n _ (consn m b x)) => (last n (consn m b x))
+%    | niln => O
+%    end.
+% \end{coq_example*}
+
+% Note that the recursive call {\tt (last n (consn m b x))} is not
+% guarded. When treating with patterns of dependent types the strategy
+% interprets the first definition of \texttt{last} as the second
+% one\footnote{In languages of the ML family the first definition would
+%   be translated into a term where the variable \texttt{x} is shared in
+%   the expression.  When patterns are of non-dependent types, Coq
+%   compiles as in ML languages using sharing. When patterns are of
+%   dependent types the compilation reconstructs the term as in the
+%   second definition of \texttt{last} so to ensure the result of
+%   expansion is well typed.}.  Thus it generates a term where the
+% recursive call is rejected by the guard condition.
+
+% You can get rid of this problem by writing the definition with
+% \emph{simple patterns}:
+
+% \begin{coq_example}
+%   Fixpoint last [n:nat; l:(listn n)] : nat :=
+%   <[_:nat]nat>match l of
+%     (consn m a x) => Cases x of niln => a | _ => (last m x) end
+%   | niln => O
+%   end.
+% \end{coq_example}
+
+\end{ErrMsgs}
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/Coercion.tex b/doc/refman/Coercion.tex
new file mode 100644
index 00000000..5445224b
--- /dev/null
+++ b/doc/refman/Coercion.tex
@@ -0,0 +1,541 @@
+\achapter{Implicit Coercions}
+\aauthor{Amokrane Saïbi}
+
+\label{Coercions-full}
+\index{Coercions!presentation}
+
+\asection{General Presentation}
+
+This section describes the inheritance mechanism of {\Coq}. In {\Coq} with
+inheritance, we are not interested in adding any expressive power to
+our theory, but only convenience. Given a term, possibly not typable,
+we are interested in the problem of determining if it can be well
+typed modulo insertion of appropriate coercions.  We allow to write:
+
+\begin{itemize}
+\item $f~a$ where $f:forall~ x:A, B$ and $a:A'$ when $A'$ can 
+      be seen in some sense as a subtype of $A$.
+\item $x:A$ when $A$ is not a type, but can be seen in 
+      a certain sense as a type: set, group, category etc.
+\item $f~a$ when $f$ is not a function, but can be seen in a certain sense
+      as a function: bijection, functor, any structure morphism etc.
+\end{itemize}
+
+\asection{Classes}
+\index{Coercions!classes}
+ A class with $n$ parameters is any defined name with a type
+$forall~ (x_1:A_1)..(x_n:A_n), s$ where $s$ is a sort.  Thus a class with
+parameters is considered as a single class and not as a family of
+classes.  An object of a class $C$ is any term of type $C~t_1
+.. t_n$.  In addition to these user-classes, we have two abstract
+classes:
+
+\begin{itemize}
+\item {\tt Sortclass}, the class of sorts; 
+  its objects are the terms whose type is a sort.
+\item {\tt Funclass}, the class of functions; 
+  its objects are all the terms with a functional 
+  type, i.e. of form $forall~ x:A, B$.
+\end{itemize}
+
+Formally, the syntax of a classes is defined on Figure~\ref{fig:classes}.
+\begin{figure}
+\begin{centerframe}
+\begin{tabular}{lcl}
+{\class} & ::= & {\qualid} \\
+  & $|$ & {\tt Sortclass} \\
+  & $|$ & {\tt Funclass} 
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of classes}
+\label{fig:classes}
+\end{figure}
+
+\asection{Coercions}
+\index{Coercions!Funclass}
+\index{Coercions!Sortclass}
+  A name $f$ can be declared as a coercion between a source user-class
+$C$ with $n$ parameters and a target class $D$ if one of these
+conditions holds:
+
+\newcommand{\oftype}{\!:\!}
+
+\begin{itemize}
+\item $D$ is a user-class, then the type of $f$ must have the form
+      $forall~ (x_1 \oftype A_1)..(x_n \oftype A_n)(y\oftype C~x_1..x_n), D~u_1..u_m$ where $m$
+      is the number of parameters of $D$.
+\item $D$ is {\tt Funclass}, then the type of $f$ must have the form
+      $forall~ (x_1\oftype A_1)..(x_n\oftype A_n)(y\oftype C~x_1..x_n)(x:A), B$. 
+\item $D$ is {\tt Sortclass}, then the type of $f$ must have the form
+      $forall~ (x_1\oftype A_1)..(x_n\oftype A_n)(y\oftype C~x_1..x_n), s$ with $s$ a sort. 
+\end{itemize}
+
+We then write $f:C \mbox{\texttt{>->}} D$. The restriction on the type
+of coercions is called {\em the uniform inheritance condition}.
+Remark that the abstract classes {\tt Funclass} and {\tt Sortclass}
+cannot be source classes.
+
+To coerce an object $t:C~t_1..t_n$ of $C$ towards $D$, we have to
+apply the coercion $f$ to it; the obtained term $f~t_1..t_n~t$ is
+then an object of $D$.
+
+\asection{Identity Coercions}
+\index{Coercions!identity}
+
+  Identity coercions are special cases of coercions used to go around
+the uniform inheritance condition.  Let $C$ and $D$ be two classes
+with respectively $n$ and $m$ parameters and
+$f:forall~(x_1:T_1)..(x_k:T_k)(y:C~u_1..u_n), D~v_1..v_m$ a function which
+does not verify the uniform inheritance condition. To declare $f$ as
+coercion, one has first to declare a subclass $C'$ of $C$:
+
+$$C' := fun~ (x_1:T_1)..(x_k:T_k) => C~u_1..u_n$$
+
+\noindent We then define an {\em identity coercion} between $C'$ and $C$:
+\begin{eqnarray*}
+Id\_C'\_C  & := & fun~ (x_1:T_1)..(x_k:T_k)(y:C'~x_1..x_k) => (y:C~u_1..u_n)\\
+\end{eqnarray*}
+
+We can now declare $f$ as coercion from $C'$ to $D$, since we can
+``cast'' its type as
+$forall~ (x_1:T_1)..(x_k:T_k)(y:C'~x_1..x_k),D~v_1..v_m$.\\ The identity
+coercions have a special status: to coerce an object $t:C'~t_1..t_k$
+of $C'$ towards $C$, we does not have to insert explicitly $Id\_C'\_C$
+since $Id\_C'\_C~t_1..t_k~t$ is convertible with $t$.  However we
+``rewrite'' the type of $t$ to become an object of $C$; in this case,
+it becomes $C~u_1^*..u_k^*$ where each $u_i^*$ is the result of the
+substitution in $u_i$ of the variables $x_j$ by $t_j$.
+
+
+\asection{Inheritance Graph}
+\index{Coercions!inheritance graph}
+Coercions form an inheritance graph with classes as nodes.  We call
+{\em coercion path} an ordered list of coercions between two nodes of
+the graph.  A class $C$ is said to be a subclass of $D$ if there is a
+coercion path in the graph from $C$ to $D$; we also say that $C$
+inherits from $D$. Our mechanism supports multiple inheritance since a
+class may inherit from several classes, contrary to simple inheritance
+where a class inherits from at most one class.  However there must be
+at most one path between two classes.  If this is not the case, only
+the {\em oldest} one is valid and the others are ignored. So the order
+of declaration of coercions is important.
+
+We extend notations for coercions to coercion paths. For instance
+$[f_1;..;f_k]:C \mbox{\texttt{>->}} D$ is the coercion path composed
+by the coercions $f_1..f_k$.  The application of a coercion path to a
+term consists of the successive application of its coercions.
+
+\asection{Declaration of Coercions}
+
+%%%%% "Class" is useless, since classes are implicitely defined via coercions.
+
+% \asubsection{\tt Class {\qualid}.}\comindex{Class}
+% Declares {\qualid} as a new class.
+
+% \begin{ErrMsgs}
+% \item {\qualid} \errindex{not declared}
+% \item {\qualid} \errindex{is already a class}
+% \item \errindex{Type of {\qualid} does not end with a sort}
+% \end{ErrMsgs}
+
+% \begin{Variant}
+% \item {\tt Class Local {\qualid}.} \\
+% Declares the construction denoted by {\qualid} as a new local class to 
+% the current section.
+% \end{Variant}
+
+% END "Class" is useless
+
+\asubsection{\tt Coercion {\qualid} : {\class$_1$} >-> {\class$_2$}.}
+\comindex{Coercion}
+
+Declares the construction denoted by {\qualid} as a coercion between
+{\class$_1$} and {\class$_2$}.
+
+% Useless information
+% The classes {\class$_1$} and {\class$_2$} are first declared if necessary.
+   
+\begin{ErrMsgs}
+\item {\qualid} \errindex{not declared}
+\item {\qualid} \errindex{is already a coercion}
+\item \errindex{Funclass cannot be a source class}
+\item \errindex{Sortclass cannot be a source class}
+\item {\qualid} \errindex{is not a function}
+\item \errindex{Cannot find the source class of {\qualid}}
+\item \errindex{Cannot recognize {\class$_1$} as a source class of {\qualid}}
+\item {\qualid} \errindex{does not respect the inheritance uniform condition}
+\item \errindex{Found target class {\class} instead of {\class$_2$}}
+
+\end{ErrMsgs}
+
+When the coercion {\qualid} is added to the inheritance graph, non
+valid coercion paths are ignored; they are signaled by a warning.
+\\[0.3cm]
+\noindent {\bf Warning :}
+\begin{enumerate}
+\item \begin{tabbing}
+{\tt Ambiguous paths: }\= $[f_1^1;..;f_{n_1}^1] : C_1\mbox{\tt >->}D_1$\\
+                       \> ... \\
+                       \>$[f_1^m;..;f_{n_m}^m] : C_m\mbox{\tt >->}D_m$
+      \end{tabbing}
+\end{enumerate}
+
+\begin{Variants}
+\item {\tt Coercion Local {\qualid} : {\class$_1$} >-> {\class$_2$}.}
+\comindex{Coercion Local}\\
+  Declares the construction denoted by {\qualid} as a coercion local to
+  the current section.
+
+\item {\tt Coercion {\ident} := {\term}}\comindex{Coercion}\\
+  This defines {\ident} just like \texttt{Definition {\ident} :=
+    {\term}}, and then declares {\ident} as a coercion between it
+  source and its target.
+
+\item {\tt Coercion {\ident} := {\term} : {\type}}\\
+  This defines {\ident} just like 
+  \texttt{Definition {\ident} : {\type} := {\term}}, and then
+  declares {\ident} as a coercion between it source and its target. 
+
+\item {\tt Coercion Local {\ident} := {\term}}\comindex{Coercion Local}\\
+  This defines {\ident} just like \texttt{Local {\ident} :=
+    {\term}}, and then declares {\ident} as a coercion between it
+  source and its target.
+
+\item Assumptions can be declared as coercions at declaration
+time. This extends the grammar of declarations from Figure
+\ref{sentences-syntax} as follows:
+\comindex{Variable \mbox{\rm (and coercions)}}
+\comindex{Axiom \mbox{\rm (and coercions)}}
+\comindex{Parameter \mbox{\rm (and coercions)}}
+\comindex{Hypothesis \mbox{\rm (and coercions)}}
+
+\begin{tabular}{lcl}
+%% Declarations
+{\declaration} & ::= & {\declarationkeyword} {\assums} {\tt .} \\
+&&\\
+{\assums} & ::= & {\simpleassums} \\
+          & $|$ & \nelist{{\tt (} \simpleassums {\tt )}}{} \\
+&&\\
+{\simpleassums} & ::= &  \nelist{\ident}{} {\tt :}\zeroone{{\tt >}} {\term}\\  
+\end{tabular}
+
+If the extra {\tt >} is present before the type of some assumptions, these
+assumptions are declared as coercions.
+
+\item Constructors of inductive types can be declared as coercions at
+definition time of the inductive type. This extends and modifies the
+grammar of inductive types from Figure \ref{sentences-syntax} as follows: 
+\comindex{Inductive \mbox{\rm (and coercions)}}
+\comindex{CoInductive \mbox{\rm (and coercions)}}
+
+\begin{center}
+\begin{tabular}{lcl}
+%% Inductives
+{\inductive} & ::= & 
+           {\tt Inductive} \nelist{\inductivebody}{with} {\tt .} \\
+ & $|$ & {\tt CoInductive} \nelist{\inductivebody}{with} {\tt .} \\
+           & & \\
+{\inductivebody} & ::= & 
+  {\ident} \sequence{\binderlet}{} {\tt :} {\term} {\tt :=} \\
+   && ~~~\zeroone{\zeroone{\tt |} \nelist{\constructor}{|}} \\
+           & & \\
+{\constructor} & ::= &  {\ident} \sequence{\binderlet}{} \zeroone{{\tt :}\zeroone{\tt >} {\term}} \\
+\end{tabular}
+\end{center}
+
+Especially, if the extra {\tt >} is present in a constructor
+declaration, this constructor is declared as a coercion.
+\end{Variants}
+
+\asubsection{\tt Identity Coercion {\ident}:{\class$_1$} >-> {\class$_2$}.} 
+\comindex{Identity Coercion}
+
+We check that {\class$_1$} is a constant with a value of the form
+$fun~ (x_1:T_1)..(x_n:T_n) => (\mbox{\class}_2~t_1..t_m)$ where $m$ is the
+number of parameters of \class$_2$.  Then we define an identity
+function with the type
+$forall~ (x_1:T_1)..(x_n:T_n)(y:\mbox{\class}_1~x_1..x_n),
+{\mbox{\class}_2}~t_1..t_m$, and we declare it as an identity
+coercion between {\class$_1$} and {\class$_2$}.
+
+\begin{ErrMsgs}
+\item {\class$_1$} \errindex{must be a transparent constant} 
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt Identity Coercion Local {\ident}:{\ident$_1$} >-> {\ident$_2$}.} \\
+Idem but locally to the current section.
+
+\item {\tt SubClass {\ident} := {\type}.} \\
+\comindex{SubClass}
+ If {\type} is a class
+{\ident'} applied to some arguments then {\ident} is defined and an
+identity coercion of name {\tt Id\_{\ident}\_{\ident'}} is
+declared. Otherwise said, this is an abbreviation for 
+
+{\tt Definition {\ident} := {\type}.} 
+
+ followed by
+
+{\tt Identity Coercion Id\_{\ident}\_{\ident'}:{\ident} >-> {\ident'}}.
+
+\item {\tt Local SubClass {\ident} := {\type}.} \\
+Same as before but locally to the current section.
+
+\end{Variants}
+
+\asection{Displaying Available Coercions}
+
+\asubsection{\tt Print Classes.} 
+\comindex{Print Classes}
+Print the list of declared classes in the current context.
+
+\asubsection{\tt Print Coercions.}
+\comindex{Print Coercions}
+Print the list of declared coercions in the current context.
+
+\asubsection{\tt Print Graph.} 
+\comindex{Print Graph}
+Print the list of valid coercion paths in the current context.
+
+\asubsection{\tt Print Coercion Paths {\class$_1$} {\class$_2$}.} 
+\comindex{Print Coercion Paths}
+Print the list of valid coercion paths from {\class$_1$} to {\class$_2$}.
+
+\asection{Activating the Printing of Coercions}
+
+\asubsection{\tt Set Printing Coercions.}
+\comindex{Set Printing Coercions}
+\comindex{Unset Printing Coercions}
+
+This command forces all the coercions to be printed.
+Conversely, to skip the printing of coercions, use
+ {\tt Unset Printing Coercions}.
+By default, coercions are not printed.
+
+\asubsection{\tt Set Printing Coercion {\qualid}.}
+\comindex{Set Printing Coercion}
+\comindex{Unset Printing Coercion}
+
+This command forces coercion denoted by {\qualid} to be printed.
+To skip the printing of coercion {\qualid}, use
+ {\tt Unset Printing Coercion {\qualid}}.
+By default, a coercion is never printed.
+ 
+\asection{Classes as Records}
+\label{Coercions-and-records}
+\index{Coercions!and records}
+We allow the definition of {\em Structures with Inheritance} (or
+classes as records) by extending the existing {\tt Record} macro
+(see section~\ref{Record}). Its new syntax is:
+
+\begin{center}
+\begin{tabular}{l}
+{\tt Record \zeroone{>}~{\ident} {\binderlet} : {\sort} := \zeroone{\ident$_0$} \verb+{+} \\
+~~~~\begin{tabular}{l}
+        {\tt \ident$_1$ $[$:$|$:>$]$ \term$_1$ ;} \\
+        ... \\
+        {\tt \ident$_n$ $[$:$|$:>$]$ \term$_n$ \verb+}+. }
+    \end{tabular}
+\end{tabular}
+\end{center}
+The identifier {\ident} is the name of the defined record and {\sort}
+is its type. The identifier {\ident$_0$} is the name of its
+constructor. The identifiers {\ident$_1$}, .., {\ident$_n$} are the
+names of its fields and {\term$_1$}, .., {\term$_n$} their respective
+types. The alternative {\tt $[$:$|$:>$]$} is ``{\tt :}'' or ``{\tt
+:>}''. If {\tt {\ident$_i$}:>{\term$_i$}}, then {\ident$_i$} is
+automatically declared as coercion from {\ident} to the class of
+{\term$_i$}.  Remark that {\ident$_i$} always verifies the uniform
+inheritance condition.  If the optional ``{\tt >}'' before {\ident} is
+present, then {\ident$_0$} (or the default name {\tt Build\_{\ident}}
+if {\ident$_0$} is omitted) is automatically declared as a coercion
+from the class of {\term$_n$} to {\ident} (this may fail if the
+uniform inheritance condition is not satisfied).
+
+\Rem The keyword {\tt Structure}\comindex{Structure} is a synonym of {\tt
+Record}.
+
+\asection{Coercions and Sections}
+\index{Coercions!and sections}
+  The inheritance mechanism is compatible with the section
+mechanism. The global classes and coercions defined inside a section
+are redefined after its closing, using their new value and new
+type. The classes and coercions which are local to the section are
+simply forgotten.
+Coercions with a local source class or a local target class, and 
+coercions which do not verify the uniform inheritance condition any longer
+are also forgotten.
+
+\asection{Examples}
+
+  There are three situations:
+
+\begin{itemize}
+\item $f~a$ is ill-typed where $f:forall~x:A,B$ and $a:A'$. If there is a
+      coercion path between $A'$ and $A$, $f~a$ is transformed into
+      $f~a'$ where $a'$ is the result of the application of this
+      coercion path to $a$.
+
+We first give an example of coercion between atomic inductive types
+
+%\begin{\small}
+\begin{coq_example}
+Definition bool_in_nat (b:bool) := if b then 0 else 1.
+Coercion bool_in_nat : bool >-> nat.
+Check (0 = true).
+Set Printing Coercions.
+Check (0 = true).
+\end{coq_example}
+%\end{small}
+
+\begin{coq_eval}
+Unset Printing Coercions.
+\end{coq_eval}
+
+\Warning ``\verb|Check true=O.|'' fails. This is ``normal'' behaviour of
+coercions. To validate \verb|true=O|, the coercion is searched from
+\verb=nat= to \verb=bool=. There is none.
+
+We give an example of coercion between classes with parameters.
+
+%\begin{\small}
+\begin{coq_example}
+Parameters
+   (C : nat -> Set) (D : nat -> bool -> Set) (E : bool -> Set).
+Parameter f : forall n:nat, C n -> D (S n) true.
+Coercion f : C >-> D.
+Parameter g : forall (n:nat) (b:bool), D n b -> E b.
+Coercion g : D >-> E.
+Parameter c : C 0.
+Parameter T : E true -> nat.
+Check (T c).
+Set Printing Coercions.
+Check (T c).
+\end{coq_example}
+%\end{small}
+
+\begin{coq_eval}
+Unset Printing Coercions.
+\end{coq_eval}
+
+We give now an example using identity coercions.
+
+%\begin{small}
+\begin{coq_example}
+Definition D' (b:bool) := D 1 b.
+Identity Coercion IdD'D : D' >-> D.
+Print IdD'D.
+Parameter d' : D' true.
+Check (T d').
+Set Printing Coercions.
+Check (T d').
+\end{coq_example}
+%\end{small}
+
+\begin{coq_eval}
+Unset Printing Coercions.
+\end{coq_eval}
+
+
+  In the case of functional arguments, we use the monotonic rule of
+sub-typing.  Approximatively, to coerce $t:forall~x:A, B$ towards
+$forall~x:A',B'$, one have to coerce $A'$ towards $A$ and $B$ towards
+$B'$. An example is given below:
+
+%\begin{small}
+\begin{coq_example}
+Parameters (A B : Set) (h : A -> B).
+Coercion h : A >-> B.
+Parameter U : (A -> E true) -> nat.
+Parameter t : B -> C 0.
+Check (U t).
+Set Printing Coercions.
+Check (U t).
+\end{coq_example}
+%\end{small}
+
+\begin{coq_eval}
+Unset Printing Coercions.
+\end{coq_eval}
+
+  Remark the changes in the result following the modification of the
+previous example.
+
+%\begin{small}
+\begin{coq_example}
+Parameter U' : (C 0 -> B) -> nat.
+Parameter t' : E true -> A.
+Check (U' t').
+Set Printing Coercions.
+Check (U' t').
+\end{coq_example}
+%\end{small}
+
+\begin{coq_eval}
+Unset Printing Coercions.
+\end{coq_eval}
+
+\item An assumption $x:A$ when $A$ is not a type, is ill-typed.  It is
+      replaced by $x:A'$ where $A'$ is the result of the application
+      to $A$ of the coercion path between the class of $A$ and {\tt
+      Sortclass} if it exists.  This case occurs in the abstraction
+      $fun~ x:A => t$, universal quantification $forall~x:A, B$,
+      global variables and parameters of (co-)inductive definitions
+      and functions. In $forall~x:A, B$, such a coercion path may be
+      applied to $B$ also if necessary.
+
+%\begin{small}
+\begin{coq_example}
+Parameter Graph : Type.
+Parameter Node : Graph -> Type.
+Coercion Node : Graph >-> Sortclass.
+Parameter G : Graph.
+Parameter Arrows : G -> G -> Type.
+Check Arrows.
+Parameter fg : G -> G.
+Check fg.
+Set Printing Coercions.
+Check fg.
+\end{coq_example}
+%\end{small}
+
+\begin{coq_eval}
+Unset Printing Coercions.
+\end{coq_eval}
+
+\item $f~a$ is ill-typed because $f:A$ is not a function. The term
+      $f$ is replaced by the term obtained by applying to $f$ the
+      coercion path between $A$ and {\tt Funclass} if it exists.
+
+%\begin{small}
+\begin{coq_example}
+Parameter bij : Set -> Set -> Set.
+Parameter ap : forall A B:Set, bij A B -> A -> B.
+Coercion ap : bij >-> Funclass.
+Parameter b : bij nat nat.
+Check (b 0).
+Set Printing Coercions.
+Check (b 0).
+\end{coq_example}
+%\end{small}
+
+\begin{coq_eval}
+Unset Printing Coercions.
+\end{coq_eval}
+
+Let us see the resulting graph of this session.
+
+%\begin{small}
+\begin{coq_example}
+Print Graph.
+\end{coq_example}
+%\end{small}
+
+\end{itemize}
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/Extraction.tex b/doc/refman/Extraction.tex
new file mode 100644
index 00000000..fcce23f9
--- /dev/null
+++ b/doc/refman/Extraction.tex
@@ -0,0 +1,664 @@
+\achapter{Extraction of programs in Objective Caml and Haskell}
+\label{Extraction}
+\aauthor{Jean-Christophe Filliâtre and Pierre Letouzey}
+\index{Extraction}
+
+\begin{flushleft}
+  \em The status of extraction is experimental.
+\end{flushleft}
+We present here the \Coq\ extraction commands, used to build certified
+and relatively efficient functional programs, extracting them from the
+proofs of their specifications.  The functional languages available as
+output are currently \ocaml{}, \textsc{Haskell} and \textsc{Scheme}.
+In the following, ``ML'' will be used (abusively) to refer to any of
+the three.
+
+\paragraph{Differences with old versions.}
+The current extraction mechanism is new for version 7.0 of {\Coq}.
+In particular, the \FW\ toplevel used as an intermediate step between 
+\Coq\ and ML has been withdrawn.  It is also not possible 
+any more to import ML objects in this \FW\ toplevel.
+The current mechanism also differs from
+the one in previous versions of \Coq: there is no more
+an explicit toplevel for the language (formerly called \textsc{Fml}). 
+
+\asection{Generating ML code}
+\comindex{Extraction}
+\comindex{Recursive Extraction}
+\comindex{Extraction Module}
+\comindex{Recursive Extraction Module}
+
+The next two commands are meant to be used for rapid preview of
+extraction. They both display extracted term(s) inside \Coq.
+
+\begin{description}
+\item {\tt Extraction \qualid.} ~\par
+  Extracts one constant or module in the \Coq\ toplevel.
+
+\item {\tt Recursive Extraction  \qualid$_1$ \dots\ \qualid$_n$.} ~\par
+  Recursive extraction of all the globals (or modules) \qualid$_1$ \dots\
+  \qualid$_n$ and all their dependencies in the \Coq\ toplevel.
+\end{description}
+
+%% TODO error messages
+
+All the following commands produce real ML files. User can choose to produce
+one monolithic file or one file per \Coq\ library. 
+
+\begin{description}
+\item {\tt Extraction "{\em file}"}  
+      \qualid$_1$ \dots\ \qualid$_n$. ~\par
+  Recursive extraction of all the globals (or modules) \qualid$_1$ \dots\
+  \qualid$_n$ and all their dependencies in one monolithic file {\em file}.
+  Global and local identifiers are renamed according to the choosen ML
+  language to fullfill its syntactic conventions, keeping original
+  names as much as possible.
+  
+\item {\tt Extraction Library} \ident. ~\par 
+  Extraction of the whole \Coq\ library {\tt\ident.v} to an ML module
+  {\tt\ident.ml}.  In case of name clash, identifiers are here renamed
+  using prefixes \verb!coq_!  or \verb!Coq_! to ensure a
+  session-independent renaming.
+
+\item {\tt Recursive Extraction Library} \ident. ~\par
+  Extraction of the \Coq\ library {\tt\ident.v} and all other modules 
+  {\tt\ident.v} depends on. 
+\end{description}
+
+The list of globals \qualid$_i$ does not need to be
+exhaustive: it is automatically completed into a complete and minimal
+environment. 
+
+\asection{Extraction options}
+
+\asubsection{Setting the target language}
+\comindex{Extraction Language}
+
+The ability to fix target language is the first and more important
+of the extraction options. Default is Ocaml. Besides Haskell and
+Scheme, another language called Toplevel is provided. It is a pseudo-Ocaml,
+with no renaming on global names: so names are printed as in \Coq.
+This third language is available only at the \Coq\ Toplevel.
+\begin{description}
+\item {\tt Extraction Language Ocaml}.
+\item {\tt Extraction Language Haskell}.
+\item {\tt Extraction Language Scheme}.
+\item {\tt Extraction Language Toplevel}.
+\end{description}
+
+\asubsection{Inlining and optimizations}
+
+Since Objective Caml is a strict language, the extracted
+code has to be optimized in order to be efficient (for instance, when
+using induction principles we do not want to compute all the recursive
+calls but only the needed ones). So the extraction mechanism provides
+an automatic optimization routine that will be
+called each time the user want to generate Ocaml programs. Essentially,
+it performs constants inlining and reductions.  Therefore some
+constants may not appear in resulting monolithic Ocaml program (a warning is
+printed for each such constant). In the case of modular extraction, 
+even if some inlining is done, the inlined constant are nevertheless
+printed, to ensure session-independent programs. 
+
+Concerning Haskell, such optimizations are less useful because of
+lazyness. We still make some optimizations, for example in order to
+produce more readable code. 
+
+All these optimizations are controled by the following \Coq\ options: 
+
+\begin{description}
+
+\item \comindex{Set Extraction Optimize}
+{\tt Set Extraction Optimize.}
+
+\item \comindex{Unset Extraction Optimize}
+{\tt Unset Extraction Optimize.}
+
+Default is Set. This control all optimizations made on the ML terms 
+(mostly reduction of dummy beta/iota redexes, but also simplications on 
+Cases, etc). Put this option to Unset if you want a ML term as close as 
+possible to the Coq term.
+
+\item \comindex{Set Extraction AutoInline}
+{\tt Set Extraction AutoInline.} 
+
+\item \comindex{Unset Extraction AutoInline}
+{\tt Unset Extraction AutoInline.} 
+
+Default is Set, so by default, the extraction mechanism feels free to 
+inline the bodies of some defined constants, according to some heuristics 
+like size of bodies, useness of some arguments, etc. Those heuristics are 
+not always perfect, you may want to disable this feature, do it by Unset. 
+
+\item \comindex{Extraction Inline}
+{\tt Extraction Inline} \qualid$_1$ \dots\ \qualid$_n$. 
+
+\item \comindex{Extraction NoInline}
+{\tt Extraction NoInline} \qualid$_1$ \dots\ \qualid$_n$. 
+
+In addition to the automatic inline feature, you can now tell precisely to 
+inline some more constants by the {\tt Extraction Inline} command. Conversely, 
+you can forbid the automatic inlining of some specific constants by
+the {\tt Extraction NoInline} command.
+Those two commands enable a precise control of what is inlined and what is not. 
+
+\item \comindex{Print Extraction Inline}
+{\tt Print Extraction Inline}. 
+
+Prints the current state of the table recording the custom inlinings 
+declared by the two previous commands. 
+
+\item \comindex{Reset Extraction Inline}
+{\tt Reset Extraction Inline}. 
+
+Puts the table recording the custom inlinings back to empty. 
+
+\end{description}
+
+
+\paragraph{Inlining and printing of a constant declaration.}
+
+A user can explicitely asks a constant to be extracted by two means: 
+\begin{itemize}
+\item by mentioning it on the extraction command line
+\item by extracting the whole \Coq\ module of this constant.
+\end{itemize}
+In both cases, the declaration of this constant will be present in the
+produced file. 
+But this same constant may or may not be inlined in the following
+terms, depending on the automatic/custom inlining mechanism.  
+
+
+For the constants non-explicitely required but needed for dependancy
+reasons, there are two cases: 
+\begin{itemize}
+\item If an inlining decision is taken, wether automatically or not, 
+all occurences of this constant are replaced by its extracted body, and
+this constant is not declared in the generated file.
+\item If no inlining decision is taken, the constant is normally
+  declared in the produced file. 
+\end{itemize}
+
+\asubsection{Realizing axioms}\label{extraction:axioms}
+
+Extraction will fail if it encounters an informative
+axiom not realized (see section \ref{extraction:axioms}). 
+A warning will be issued if it encounters an logical axiom, to remind 
+user that inconsistant logical axioms may lead to incorrect or 
+non-terminating extracted terms. 
+
+It is possible to assume some axioms while developing a proof. Since
+these axioms can be any kind of proposition or object or type, they may
+perfectly well have some computational content. But a program must be
+a closed term, and of course the system cannot guess the program which
+realizes an axiom.  Therefore, it is possible to tell the system
+what ML term corresponds to a given axiom. 
+
+\comindex{Extract Constant}
+\begin{description}
+\item{\tt Extract Constant \qualid\ => \str.} ~\par
+  Give an ML extraction for the given constant.
+  The \str\ may be an identifier or a quoted string.
+\item{\tt Extract Inlined Constant \qualid\ => \str.} ~\par
+  Same as the previous one, except that the given ML terms will
+  be inlined everywhere instead of being declared via a let.
+\end{description}
+
+Note that the {\tt Extract Inlined Constant} command is sugar
+for an {\tt Extract Constant} followed by a {\tt Extraction Inline}. 
+Hence a {\tt Reset Extraction Inline} will have an effect on the
+realized and inlined xaxiom. 
+
+Of course, it is the responsability of the user to ensure that the ML
+terms given to realize the axioms do have the expected types.  In
+fact, the strings containing realizing code are just copied in the
+extracted files. The extraction recognize whether the realized axiom
+should become a ML type constant or a ML object declaration.
+
+\Example
+\begin{coq_example}
+Axiom X:Set.
+Axiom x:X.
+Extract Constant X => "int".
+Extract Constant x => "0".
+\end{coq_example}   
+
+Notice that in the case of type scheme axiom (i.e. whose type is an
+arity, that is a sequence of product finished by a sort), then some type
+variables has to be given. The syntax is then: 
+
+\begin{description}
+\item{\tt Extract Constant \qualid\ \str$_1$ \ldots \str$_n$ => \str.} ~\par
+\end{description}
+
+The number of type variable given is checked by the system. 
+
+\Example
+\begin{coq_example}
+Axiom Y : Set -> Set -> Set.
+Extract Constant Y "'a" "'b" => " 'a*'b ".
+\end{coq_example}
+
+Realizing an axiom via {\tt Extract Constant} is only useful in the
+case of an informative axiom (of sort Type or Set). A logical axiom
+have no computational content and hence will not appears in extracted
+terms. But a warning is nonetheless issued if extraction encounters a
+logical axiom. This warning reminds user that inconsistant logical
+axioms may lead to incorrect or non-terminating extracted terms.
+
+If an informative axiom has not been realized before an extraction, a
+warning is also issued and the definition of the axiom is filled with
+an exception labelled {\tt AXIOM TO BE REALIZED}. The user must then
+search these exceptions inside the extracted file and replace them by
+real code.
+
+\comindex{Extract Inductive} 
+
+The system also provides a mechanism to specify ML terms for inductive
+types and constructors.  For instance, the user may want to use the ML
+native boolean type instead of \Coq\ one.  The syntax is the following:
+
+\begin{description}
+\item{\tt Extract Inductive \qualid\ => \str\ [ \str\ \dots \str\ ].} ~\par
+  Give an ML extraction for the given inductive type. You must specify
+  extractions for the type itself (first \str) and all its
+  constructors (between square brackets). The ML extraction must be an
+  ML recursive datatype.
+\end{description}
+
+\Example
+Typical examples are the following:
+\begin{coq_example}
+Extract Inductive unit => "unit" [ "()" ].
+Extract Inductive bool => "bool" [ "true" "false" ].
+Extract Inductive sumbool => "bool" [ "true" "false" ].
+\end{coq_example}
+
+
+\asection{Differences between \Coq\ and ML type systems}
+
+
+Due to differences between \Coq\ and ML type systems, 
+some extracted programs are not directly typable in ML. 
+We now solve this problem (at least in Ocaml) by adding 
+when needed some unsafe casting {\tt Obj.magic}, which give
+a generic type {\tt 'a} to any term.
+
+For example, Here are two kinds of problem that can occur: 
+
+\begin{itemize}
+  \item If some part of the program is {\em very} polymorphic, there
+    may be no ML type for it. In that case the extraction to ML works
+    all right but the generated code may be refused by the ML
+    type-checker. A very well known example is the {\em distr-pair}
+    function:
+\begin{verbatim}
+Definition dp := 
+ fun (A B:Set)(x:A)(y:B)(f:forall C:Set, C->C) => (f A x, f B y).
+\end{verbatim}
+
+In Ocaml, for instance, the direct extracted term would be:
+
+\begin{verbatim}
+let dp x y f = Pair((f () x),(f () y))
+\end{verbatim}
+
+and would have type:
+\begin{verbatim}
+dp : 'a -> 'a -> (unit -> 'a -> 'b) -> ('b,'b) prod
+\end{verbatim}
+
+which is not its original type, but a restriction.
+
+We now produce the following correct version:
+\begin{verbatim}
+let dp x y f = Pair ((Obj.magic f () x), (Obj.magic f () y))
+\end{verbatim}
+
+  \item Some definitions of \Coq\ may have no counterpart in ML. This
+    happens when there is a quantification over types inside the type
+    of a constructor; for example:
+\begin{verbatim}
+Inductive anything : Set := dummy : forall A:Set, A -> anything.
+\end{verbatim}
+
+which corresponds to the definition of an ML dynamic type.
+In Ocaml, we must cast any argument of the constructor dummy.
+
+\end{itemize}
+
+Even with those unsafe castings, you should never get error like
+``segmentation fault''. In fact even if your program may seem
+ill-typed to the Ocaml type-checker, it can't go wrong: it comes 
+from a Coq well-typed terms, so for example inductives will always 
+have the correct number of arguments, etc. 
+
+More details about the correctness of the extracted programs can be 
+found in \cite{Let02}.
+
+We have to say, though, that in most ``realistic'' programs, these
+problems do not occur. For example all the programs of Coq library are
+accepted by Caml type-checker without any {\tt Obj.magic} (see examples below).
+
+
+
+\asection{Some examples}
+
+We present here two examples of extractions, taken from the 
+\Coq\ Standard Library. We choose \ocaml\ as target language, 
+but all can be done in the other dialects with slight modifications.
+We then indicate where to find other examples and tests of Extraction.
+
+\asubsection{A detailed example: Euclidean division}
+
+The file {\tt Euclid} contains the proof of Euclidean division
+(theorem {\tt eucl\_dev}). The natural numbers defined in the example
+files are unary integers defined by two constructors $O$ and $S$:
+\begin{coq_example*}
+Inductive nat : Set :=
+  | O : nat
+  | S : nat -> nat.
+\end{coq_example*}
+
+This module contains a theorem {\tt eucl\_dev}, and its extracted term
+is of type 
+\begin{verbatim}
+forall b:nat, b > 0 -> forall a:nat, diveucl a b
+\end{verbatim}
+where {\tt diveucl} is a type for the pair of the quotient and the modulo.
+We can now extract this program to \ocaml:
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example}
+Require Import Euclid.
+Extraction Inline Wf_nat.gt_wf_rec Wf_nat.lt_wf_rec.
+Recursive Extraction  eucl_dev.
+\end{coq_example}
+
+The inlining of {\tt gt\_wf\_rec} and {\tt lt\_wf\_rec} is not
+mandatory. It only enhances readability of extracted code. 
+You can then copy-paste the output to a file {\tt euclid.ml} or let 
+\Coq\ do it for you with the following command: 
+
+\begin{coq_example}
+Extraction "euclid" eucl_dev.
+\end{coq_example}
+
+Let us play the resulting program:
+
+\begin{verbatim}
+# #use "euclid.ml";;
+type sumbool = Left | Right
+type nat = O | S of nat
+type diveucl = Divex of nat * nat
+val minus : nat -> nat -> nat = <fun>
+val le_lt_dec : nat -> nat -> sumbool = <fun>
+val le_gt_dec : nat -> nat -> sumbool = <fun>
+val eucl_dev : nat -> nat -> diveucl = <fun>
+# eucl_dev (S (S O)) (S (S (S (S (S O)))));;
+- : diveucl = Divex (S (S O), S O)
+\end{verbatim}
+It is easier to test on \ocaml\ integers:
+\begin{verbatim}
+# let rec i2n = function 0 -> O | n -> S (i2n (n-1));;
+val i2n : int -> nat = <fun>
+# let rec n2i = function O -> 0 | S p -> 1+(n2i p);;
+val n2i : nat -> int = <fun>
+# let div a b = 
+     let Divex (q,r) = eucl_dev (i2n b) (i2n a) in (n2i q, n2i r);;
+div : int -> int -> int * int = <fun>
+# div 173 15;;
+- : int * int = 11, 8
+\end{verbatim}
+
+\asubsection{Another detailed example: Heapsort}
+
+The file {\tt Heap.v}
+contains the proof of an efficient list sorting algorithm described by
+Bjerner. Is is an adaptation of the well-known {\em heapsort}
+algorithm to functional languages. The main function is {\tt
+treesort}, whose type is shown below: 
+
+
+\begin{coq_eval}
+Reset Initial.
+Require Import Relation_Definitions.
+Require Import List.
+Require Import Sorting.
+Require Import Permutation.
+\end{coq_eval}
+\begin{coq_example}
+Require Import Heap.
+Check treesort.
+\end{coq_example}
+
+Let's now extract this function: 
+
+\begin{coq_example}
+Extraction Inline sort_rec is_heap_rec.
+Extraction NoInline list_to_heap.
+Extraction "heapsort" treesort.
+\end{coq_example}
+
+One more time, the {\tt Extraction Inline} and {\tt NoInline}
+directives are cosmetic. Without it, everything goes right, 
+but the output is less readable.
+Here is the produced file {\tt heapsort.ml}: 
+
+\begin{verbatim}
+type nat =
+  | O
+  | S of nat
+
+type 'a sig2 =
+  'a
+  (* singleton inductive, whose constructor was exist2 *)
+  
+type sumbool =
+  | Left
+  | Right
+
+type 'a list =
+  | Nil
+  | Cons of 'a * 'a list
+
+type 'a multiset =
+  'a -> nat
+  (* singleton inductive, whose constructor was Bag *)
+  
+type 'a merge_lem =
+  'a list
+  (* singleton inductive, whose constructor was merge_exist *)
+  
+(** val merge : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 -> sumbool) ->
+                'a1 list -> 'a1 list -> 'a1 merge_lem **)
+
+let rec merge leA_dec eqA_dec l1 l2 =
+  match l1 with
+    | Nil -> l2
+    | Cons (a, l) ->
+        let rec f = function
+          | Nil -> Cons (a, l)
+          | Cons (a0, l3) ->
+              (match leA_dec a a0 with
+                 | Left -> Cons (a,
+                     (merge leA_dec eqA_dec l (Cons (a0, l3))))
+                 | Right -> Cons (a0, (f l3)))
+        in f l2
+
+type 'a tree =
+  | Tree_Leaf
+  | Tree_Node of 'a * 'a tree * 'a tree
+
+type 'a insert_spec =
+  'a tree
+  (* singleton inductive, whose constructor was insert_exist *)
+  
+(** val insert : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 -> sumbool) ->
+                 'a1 tree -> 'a1 -> 'a1 insert_spec **)
+
+let rec insert leA_dec eqA_dec t a =
+  match t with
+    | Tree_Leaf -> Tree_Node (a, Tree_Leaf, Tree_Leaf)
+    | Tree_Node (a0, t0, t1) ->
+        let h3 = fun x -> insert leA_dec eqA_dec t0 x in
+        (match leA_dec a0 a with
+           | Left -> Tree_Node (a0, t1, (h3 a))
+           | Right -> Tree_Node (a, t1, (h3 a0)))
+
+type 'a build_heap =
+  'a tree
+  (* singleton inductive, whose constructor was heap_exist *)
+  
+(** val list_to_heap : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 ->
+                       sumbool) -> 'a1 list -> 'a1 build_heap **)
+
+let rec list_to_heap leA_dec eqA_dec = function
+  | Nil -> Tree_Leaf
+  | Cons (a, l0) ->
+      insert leA_dec eqA_dec (list_to_heap leA_dec eqA_dec l0) a
+
+type 'a flat_spec =
+  'a list
+  (* singleton inductive, whose constructor was flat_exist *)
+  
+(** val heap_to_list : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 ->
+                       sumbool) -> 'a1 tree -> 'a1 flat_spec **)
+
+let rec heap_to_list leA_dec eqA_dec = function
+  | Tree_Leaf -> Nil
+  | Tree_Node (a, t0, t1) -> Cons (a,
+      (merge leA_dec eqA_dec (heap_to_list leA_dec eqA_dec t0)
+        (heap_to_list leA_dec eqA_dec t1)))
+
+(** val treesort : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 -> sumbool)
+                   -> 'a1 list -> 'a1 list sig2 **)
+
+let treesort leA_dec eqA_dec l =
+  heap_to_list leA_dec eqA_dec (list_to_heap leA_dec eqA_dec l)
+
+\end{verbatim}
+
+Let's test it: 
+% Format.set_margin 72;;
+\begin{verbatim}
+# #use "heapsort.ml";;
+type sumbool = Left | Right
+type nat = O | S of nat
+type 'a tree = Tree_Leaf | Tree_Node of 'a * 'a tree * 'a tree
+type 'a list = Nil | Cons of 'a * 'a list
+val merge : 
+  ('a -> 'a -> sumbool) -> 'b -> 'a list -> 'a list -> 'a list = <fun>
+val heap_to_list : 
+  ('a -> 'a -> sumbool) -> 'b -> 'a tree -> 'a list = <fun>
+val insert : 
+  ('a -> 'a -> sumbool) -> 'b -> 'a tree -> 'a -> 'a tree = <fun>
+val list_to_heap : 
+  ('a -> 'a -> sumbool) -> 'b -> 'a list -> 'a tree = <fun>
+val treesort : 
+  ('a -> 'a -> sumbool) -> 'b -> 'a list -> 'a list = <fun>
+\end{verbatim}
+
+One can remark that the argument of {\tt treesort} corresponding to 
+{\tt eqAdec} is never used in the informative part of the terms, 
+only in the logical parts. So the extracted {\tt treesort} never use
+it, hence this {\tt 'b} argument. We will use {\tt ()} for this
+argument. Only remains the {\tt leAdec}
+argument (of type {\tt 'a -> 'a -> sumbool}) to really provide.
+
+\begin{verbatim}
+# let leAdec x y = if x <= y then Left else Right;;
+val leAdec : 'a -> 'a -> sumbool = <fun>
+# let rec listn = function 0 -> Nil
+                         | n -> Cons(Random.int 10000,listn (n-1));;
+val listn : int -> int list = <fun>
+# treesort leAdec () (listn 9);;
+- : int list = Cons (160, Cons (883, Cons (1874, Cons (3275, Cons 
+  (5392, Cons (7320, Cons (8512, Cons (9632, Cons (9876, Nil)))))))))
+\end{verbatim}
+
+Some tests on longer lists (10000 elements) show that the program is
+quite efficient for Caml code.
+
+
+\asubsection{The Standard Library} 
+
+As a test, we propose an automatic extraction of the 
+Standard Library of \Coq. In particular, we will find back the
+two previous examples, {\tt Euclid} and {\tt Heapsort}. 
+Go to directory {\tt contrib/extraction/test} of the sources of \Coq,
+and run commands: 
+\begin{verbatim}
+make tree; make
+\end{verbatim}
+This will extract all Standard Library files and compile them. 
+It is done via many {\tt Extraction Module}, with some customization
+(see subdirectory {\tt custom}).
+
+%The result of this extraction of the Standard Library can be browsed
+%at URL 
+%\begin{flushleft}
+%\url{http://www.lri.fr/~letouzey/extraction}.
+%\end{flushleft}
+                                
+%Reals theory is normally not extracted, since it is an axiomatic 
+%development. We propose nonetheless a dummy realization of those
+%axioms, to test, run: \\
+%
+%\mbox{\tt make reals}\\
+
+This test works also with Haskell. In the same directory, run:
+\begin{verbatim}
+make tree; make -f Makefile.haskell
+\end{verbatim}
+The haskell compiler currently used is {\tt hbc}.  Any other should
+also work, just adapt the {\tt Makefile.haskell}. In particular {\tt
+ ghc} is known to work.
+
+\asubsection{Extraction's horror museum}
+
+Some pathological examples of extraction are grouped in the file
+\begin{verbatim}
+contrib/extraction/test_extraction.v
+\end{verbatim}
+of the sources of \Coq.
+
+\asubsection{Users' Contributions}
+
+ Several of the \Coq\ Users' Contributions use extraction to produce 
+ certified programs. In particular the following ones have an automatic 
+ extraction test (just run {\tt make} in those directories): 
+
+ \begin{itemize}
+ \item Bordeaux/Additions
+ \item Bordeaux/EXCEPTIONS
+ \item Bordeaux/SearchTrees
+ \item Dyade/BDDS
+ \item Lannion
+ \item Lyon/CIRCUITS
+ \item Lyon/FIRING-SQUAD
+ \item Marseille/CIRCUITS
+ \item Muenchen/Higman
+ \item Nancy/FOUnify
+ \item Rocq/ARITH/Chinese
+ \item Rocq/COC
+ \item Rocq/GRAPHS
+ \item Rocq/HIGMAN
+ \item Sophia-Antipolis/Stalmarck
+ \item Suresnes/BDD
+ \end{itemize}
+
+ Lannion, Rocq/HIGMAN and Lyon/CIRCUITS are a bit particular. They are 
+ the only examples of developments where {\tt Obj.magic} are needed.
+ This is probably due to an heavy use of impredicativity.
+ After compilation those two examples run nonetheless,
+ thanks to the correction of the extraction~\cite{Let02}. 
+
+% $Id: Extraction.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/Helm.tex b/doc/refman/Helm.tex
new file mode 100644
index 00000000..af34af43
--- /dev/null
+++ b/doc/refman/Helm.tex
@@ -0,0 +1,317 @@
+\label{Helm}
+\index{XML exportation}
+\index{Proof rendering}
+
+This section describes the exportation of {\Coq} theories to XML that
+has been contributed by Claudio Sacerdoti Coen.  Currently, the main
+applications are the rendering and searching tool
+developed within the HELM\footnote{Hypertextual Electronic Library of
+Mathematics} and MoWGLI\footnote{Mathematics on the Web, Get it by
+Logic and Interfaces} projects mainly at the University of Bologna and
+partly at INRIA-Sophia Antipolis.
+
+\subsection{Practical use of the XML exportation tool}
+
+The basic way to export the logical content of a file into XML format
+is to use {\tt coqc} with option {\tt -xml}. 
+When the {\tt -xml} flag is set, every definition or declaration is
+immediately exported to XML once concluded.
+The system environment variable {\tt COQ\_XML\_LIBRARY\_ROOT} must be
+previously set to a directory in which the logical structure of the
+exported objects is reflected.
+
+  For {\tt Makefile} files generated by \verb+coq_makefile+ (see section
+  \ref{Makefile}), it is sufficient to compile the files using
+ \begin{quotation}
+   \verb+make COQ_XML=-xml+
+ \end{quotation}
+ (or, equivalently, setting the environment variable \verb+COQ_XML+)
+ 
+ To export a development to XML, the suggested procedure is then:
+ 
+ \begin{enumerate}
+  \item add to your own contribution a valid \verb+Make+ file and use
+      \verb+coq_makefile+ to generate the \verb+Makefile+ from the \verb+Make+
+      file.
+ 
+      \Warning Since logical names are used to structure the XML
+      hierarchy, always add to the \verb+Make+ file at least one \verb+"-R"+
+      option to map physical file names to logical module paths.
+  \item set the \verb+COQ_XML_LIBRARY_ROOT+ environment variable to
+  the directory where the XML file hierarchy must be physically
+  rooted.
+  \item compile your contribution with \verb+"make COQ_XML=-xml"+
+ \end{enumerate}
+ 
+\Rem In case the system variable {\tt COQ\_XML\_LIBRARY\_ROOT} is not set,
+the output is done on the standard output. Also, the files are
+compressed using {\tt gzip} after creation. This is to save disk space
+since the XML format is very verbose.
+
+\subsection{Reflection of the logical structure into the file system}
+
+For each {\Coq} logical object, several independent files associated
+to this object are created.  The structure of the long name of the
+object is reflected in the directory structure of the file system.
+E.g. an object of long name {\tt
+{\ident$_1$}.{\ldots}.{\ident$_n$}.{\ident}} is exported to files in the
+subdirectory {{\ident$_1$}/{\ldots}/{\ident$_n$}} of the directory 
+bound to the environment variable {\tt COQ\_XML\_LIBRARY\_ROOT}.
+
+\subsection{What is exported?}
+
+The XML exportation tool exports the logical content of {\Coq}
+theories. This covers global definitions (including lemmas, theorems,
+...), global assumptions (parameters and axioms), local assumptions or
+definitions, and inductive definitions.
+
+Vernacular files are exported to {\tt .theory.xml} files. 
+%Variables,
+%definitions, theorems, axioms and proofs are exported to individual
+%files whose suffixes range from {\tt .var.xml}, {\tt .con.xml}, {\tt
+%.con.body.xml}, {\tt .con.types.xml} to {\tt .con.proof_tree.xml}.
+Comments are pre-processed with {\sf coqdoc} (see section
+\ref{coqdoc}). Especially, they have to be enclosed within {\tt (**}
+and {\tt *)} to be exported.
+
+For each inductive definition of name
+{\ident$_1$}.{\ldots}.{\ident$_n$}.{\ident}, a file named {\tt
+{\ident}.ind.xml} is created in the subdirectory {\tt
+{\ident$_1$}/{\ldots}/{\ident$_n$}} of the xml library root
+directory. It contains the arities and constructors of the type. For mutual inductive definitions, the file is named after the
+name of the first inductive type of the block.
+
+For each global definition of base name {\tt
+{\ident$_1$}.{\ldots}.{\ident$_n$}.{\ident}}, files named
+{\tt {\ident}.con.body.xml} and {\tt {\ident}.con.xml} are created in the
+subdirectory {\tt {\ident$_1$}/{\ldots}/{\ident$_n$}}. They
+respectively contain the body and the type of the definition.
+
+For each global assumption of base name {\tt
+{\ident$_1$}.{\ident$_2$}.{\ldots}.{\ident$_n$}.{\ident}}, a file
+named {\tt {\ident}.con.xml} is created in the subdirectory {\tt
+{\ident$_1$}/{\ldots}/{\ident$_n$}}.  It contains the type of the
+global assumption.
+
+For each local assumption or definition of base name {\ident} located
+in sections {\ident$'_1$}, {\ldots}, {\ident$'_p$} of the module {\tt
+{\ident$_1$}.{\ident$_2$}.{\ldots}.{\ident$_n$}.{\ident}}, a file
+named {\tt {\ident}.var.xml} is created in the subdirectory {\tt
+{\ident$_1$}/{\ldots}/{\ident$_n$}/{\ident$'_1$}/\ldots/{\ident$'_p$}}.
+It contains its type and, if a definition, its body.
+
+In order to do proof-rendering (for example in natural language), some
+redundant typing information is required, i.e. the type of at least
+some of the subterms of the bodies and types of the CIC objects. These
+types are called inner types and are exported to files of suffix {\tt
+.types.xml} by the exportation tool.
+
+
+% Deactivated
+%% \subsection{Proof trees}
+
+%% For each definition or theorem that has been built with tactics, an
+%% extra file of suffix {\tt proof\_tree.xml} is created. It contains the
+%% proof scripts and is used for rendering the proof.
+
+\subsection{Inner types}
+\label{inner-types}
+
+The type of a subterm of a construction is called an {\em inner type}
+if it respects the following conditions.
+ 
+\begin{enumerate}
+  \item Its sort is \verb+Prop+\footnote{or {\tt CProp} which is the
+    "sort"-like definition used in C-CoRN (see
+    \url{http://vacuumcleaner.cs.kun.nl/c-corn}) to type
+    computationally relevant predicative propositions.}.
+ \item It is not a type cast nor an atomic term (variable, constructor or constant).
+ \item If it's root is an abstraction, then the root's parent node is
+    not an abstraction, i.e. only the type of the outer abstraction of
+    a block of nested abstractions is printed.
+\end{enumerate}
+                                                                               
+The rationale for the 3$^{rd}$ condition is that the type of the inner
+abstractions could be easily computed starting from the type of the
+outer ones; moreover, the types of the inner abstractions requires a
+lot of disk/memory space: removing the 3$^{rd}$ condition leads to XML
+file that are two times as big as the ones exported applying the 3$^{rd}$
+condition.
+
+\subsection{Interactive exportation commands}
+
+There are also commands to be used interactively in {\tt coqtop}.
+
+\subsubsection{\tt Print XML {\qualid}}
+\comindex{Print XML}
+
+If the variable {\tt COQ\_XML\_LIBRARY\_ROOT} is set, this command creates
+files containing the logical content in XML format of {\qualid}. If
+the variable is not set, the result is displayed on the standard
+output.
+
+\begin{Variants}
+\item {\tt Print XML File {\str} {\qualid}}\\
+This writes the logical content of {\qualid} in XML format to files
+whose prefix is {\str}.
+\end{Variants}
+
+\subsubsection{{\tt Show XML Proof}}
+\comindex{Show XML Proof}
+
+If the variable {\tt COQ\_XML\_LIBRARY\_ROOT} is set, this command creates
+files containing the current proof in progress in XML format. It
+writes also an XML file made of inner types.  If the variable is not
+set, the result is displayed on the standard output.
+
+\begin{Variants}
+\item {\tt Show XML File {\str} Proof}\\ This writes the
+logical content of {\qualid} in XML format to files whose prefix is
+{\str}. 
+\end{Variants}
+
+\subsection{Applications: rendering, searching and publishing}
+
+The HELM team at the University of Bologna has developed tools
+exploiting the XML exportation of {\Coq} libraries. This covers
+rendering, searching and publishing tools.
+
+All these tools require a running http server and, if possible, a
+MathML compliant browser.  The procedure to install the suite of tools
+ultimately allowing rendering and searching can be found on the HELM
+web site \url{http://helm.cs.unibo.it/library.html}.
+
+It may be easier though to upload your developments on the HELM http
+server and to re-use the infrastructure running on it. This requires
+publishing your development. To this aim, follow the instructions on
+\url{http://mowgli.cs.unibo.it}.
+
+Notice that the HELM server already hosts a copy of the standard
+library of {\Coq} and of the {\Coq} user contributions.
+
+\subsection{Technical informations}
+
+\subsubsection{CIC with Explicit Named Substitutions}
+                                                                               
+The exported files are XML encoding of the lambda-terms used by the
+\Coq\ system. The implementative details of the \Coq\ system are hidden as much
+as possible, so that the XML DTD is a straightforward encoding of the
+Calculus of (Co)Inductive Constructions.
+                                                                                
+Nevertheless, there is a feature of the \Coq\ system that can not be
+hidden in a completely satisfactory way: discharging (see Sect.\ref{Section}).
+In \Coq\ it is possible
+to open a section, declare variables and use them in the rest of the section
+as if they were axiom declarations. Once the section is closed, every definition and theorem in the section is discharged by abstracting it over the section
+variables. Variable declarations as well as section declarations are entirely
+dropped. Since we are interested in an XML encoding of definitions and
+theorems as close as possible to those directly provided the user, we
+do not want to export discharged forms. Exporting non-discharged theorem
+and definitions together with theorems that rely on the discharged forms
+obliges the tools that work on the XML encoding to implement discharging to
+achieve logical consistency. Moreover, the rendering of the files can be
+misleading, since hyperlinks can be shown between occurrences of the discharge
+form of a definition and the non-discharged definition, that are different
+objects.
+                                                                                
+To overcome the previous limitations, Claudio Sacerdoti Coen developed in his
+PhD. thesis an extension of CIC, called Calculus of (Co)Inductive Constructions
+with Explicit Named Substitutions, that is a slight extension of CIC where
+discharging is not necessary. The DTD of the exported XML files describes
+constants, inductive types and variables of the Calculus of (Co)Inductive
+Constructions with Explicit Named Substitutions. The conversion to the new
+calculus is performed during the exportation phase.
+
+The following example shows a very small \Coq\ development together with its
+version in CIC with Explicit Named Substitutions.
+
+\begin{verbatim}
+# CIC version: #
+Section S.
+ Variable A : Prop.
+
+ Definition impl := A -> A.
+
+ Theorem t : impl.           (* uses the undischarged form of impl *)
+  Proof.
+   exact (fun (a:A) => a).
+  Qed.
+
+End S.
+
+Theorem t' : (impl False).   (* uses the discharged form of impl *)
+ Proof.
+  exact (t False).           (* uses the discharged form of t *)
+ Qed.
+\end{verbatim}
+ 
+\begin{verbatim}
+# Corresponding CIC with Explicit Named Substitutions version: #
+Section S.
+ Variable A : Prop.
+ 
+ Definition impl(A) := A -> A. (* theorems and definitions are
+                                  explicitly abstracted over the
+                                  variables. The name is sufficient to
+                                  completely describe the abstraction *)
+ 
+ Theorem t(A) : impl.          (* impl where A is not instantiated *)
+  Proof.
+   exact (fun (a:A) => a).
+  Qed.
+ 
+End S.
+ 
+Theorem t'() : impl{False/A}. (* impl where A is instantiated with False
+                                 Notice that t' does not depend on A     *)
+ Proof.
+  exact t{False/A}.           (* t where A is instantiated with False *)
+ Qed.
+\end{verbatim}
+ 
+Further details on the typing and reduction rules of the calculus can be
+found in Claudio Sacerdoti Coen PhD. dissertation, where the consistency
+of the calculus is also proved.
+ 
+\subsubsection{The CIC with Explicit Named Substitutions XML DTD}
+ 
+A copy of the DTD can be found in the file ``\verb+cic.dtd+'' in the
+\verb+contrib/xml+ source directory of \Coq.
+The following is a very brief overview of the elements described in the DTD.
+ 
+\begin{description}
+ \item[]\texttt{<ConstantType>}
+   is the root element of the files that correspond to constant types.
+ \item[]\texttt{<ConstantBody>}
+   is the root element of the files that correspond to constant bodies.
+   It is used only for closed definitions and theorems (i.e. when no
+   metavariable occurs in the body or type of the constant)
+ \item[]\texttt{<CurrentProof>}
+   is the root element of the file that correspond to the body of a constant
+   that depends on metavariables (e.g. unfinished proofs)
+ \item[]\texttt{<Variable>}
+   is the root element of the files that correspond to variables
+ \item[]\texttt{<InductiveTypes>}
+   is the root element of the files that correspond to blocks
+   of mutually defined inductive definitions
+\end{description}
+ 
+The elements
+ \verb+<LAMBDA>+, \verb+<CAST>+, \verb+<PROD>+, \verb+<REL>+, \verb+<SORT>+,
+ \verb+<APPLY>+, \verb+<VAR>+, \verb+<META>+, \verb+<IMPLICIT>+, \verb+<CONST>+, \verb+<LETIN>+, \verb+<MUTIND>+, \verb+<MUTCONSTRUCT>+, \verb+<MUTCASE>+,
+ \verb+<FIX>+ and \verb+<COFIX>+ are used to encode the constructors of CIC.
+ The \verb+sort+ or \verb+type+ attribute of the element, if present, is
+ respectively the sort or the type of the term, that is a sort because of the
+ typing rules of CIC.
+ 
+The element \verb+<instantiate>+ correspond to the application of an explicit
+named substitution to its first argument, that is a reference to a definition
+or declaration in the environment.
+ 
+All the other elements are just syntactic sugar.
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/Natural.tex b/doc/refman/Natural.tex
new file mode 100644
index 00000000..69dfab87
--- /dev/null
+++ b/doc/refman/Natural.tex
@@ -0,0 +1,425 @@
+\achapter{\texttt{Natural} : proofs in natural language}
+\aauthor{Yann Coscoy}
+
+\asection{Introduction}
+
+\Natural~ is a package allowing the writing of proofs in natural
+language. For instance, the proof in \Coq~of the induction principle on pairs
+of natural numbers looks like this:
+
+\begin{coq_example*}
+Require Natural.
+\end{coq_example*}
+\begin{coq_example}
+Print nat_double_ind.
+\end{coq_example}
+
+Piping it through the \Natural~pretty-printer gives:
+
+\comindex{Print Natural}
+\begin{coq_example}
+Print Natural nat_double_ind.
+\end{coq_example}
+
+\asection{Activating \Natural}
+
+To enable the printing of proofs in natural language, you should
+type under \texttt{coqtop} or \texttt{coqtop -full} the command
+
+\begin{coq_example*}
+Require Natural.
+\end{coq_example*}
+
+By default, proofs are transcripted in english. If you wish to print them 
+in French, set the French option by
+
+\comindex{Set Natural}
+\begin{coq_example*}
+Set Natural French.
+\end{coq_example*}
+
+If you want to go back to English, type in
+
+\begin{coq_example*}
+Set Natural English.
+\end{coq_example*}
+
+Currently, only \verb=French= and \verb=English= are available.
+
+You may see for example the natural transcription of the proof of
+the induction principle on pairs of natural numbers:
+
+\begin{coq_example*}
+Print Natural nat_double_ind.
+\end{coq_example*}
+
+You may  also show in natural language the current proof in progress:
+
+\comindex{Show Natural}
+\begin{coq_example}
+Goal (n:nat)(le O n).
+Induction n.
+Show Natural Proof.
+\end{coq_example}
+
+\subsection*{Restrictions}
+
+For \Natural, a proof is an object of type a proposition (i.e. an
+object of type something of type {\tt Prop}). Only proofs are written
+in natural language when typing {\tt Print Natural \ident}.  All other
+objects (the objects of type something which is of type {\tt Set} or
+{\tt Type}) are written as usual $\lambda$-terms.
+
+\asection{Customizing \Natural}
+
+The transcription of proofs in natural language is mainly a paraphrase of
+the formal proofs, but some specific hints in the transcription
+can be given.
+Three kinds of customization are available.
+
+\asubsection{Implicit proof steps}
+
+\subsubsection*{Implicit lemmas}
+
+Applying a given lemma or theorem \verb=lem1= of statement, say $A
+\Rightarrow B$, to an hypothesis, say $H$ (assuming $A$) produces the
+following kind of output translation:
+
+\begin{verbatim}
+...
+Using lem1 with H we get B.
+...
+\end{verbatim}
+
+But sometimes, you may prefer not to see the explicit invocation to
+the lemma. You may prefer to see:
+
+\begin{verbatim}
+...
+With H we have A.
+...
+\end{verbatim}
+
+This is possible by declaring the lemma as implicit. You should type:
+
+\comindex{Add Natural}
+\begin{coq_example*}
+Add Natural Implicit lem1.
+\end{coq_example*}
+
+By default, the lemmas \verb=proj1=, \verb=proj2=, \verb=sym_equal=
+and \verb=sym_eqT= are declared implicit. To remove a lemma or a theorem
+previously declared as implicit, say \verb=lem1=, use the command
+
+\comindex{Remove Natural}
+\begin{coq_example*}
+Remove Natural Implicit lem1.
+\end{coq_example*}
+
+To test if the lemma or theorem \verb=lem1= is, or is not,
+declared as implicit, type
+
+\comindex{Test Natural}
+\begin{coq_example*}
+Test Natural Implicit lem1.
+\end{coq_example*}
+
+\subsubsection*{Implicit proof constructors}
+
+Let \verb=constr1= be a proof constructor of a given inductive
+proposition (or predicate)
+\verb=Q= (of type \verb=Prop=). Assume \verb=constr1= proves 
+\verb=(x:A)(P x)->(Q x)=. Then, applying \verb=constr1= to an hypothesis,
+say \verb=H= (assuming \verb=(P a)=) produces the following kind of output:
+
+\begin{verbatim}
+...
+By the definition of Q, with H we have (Q a).
+...
+\end{verbatim}
+
+But sometimes, you may prefer not to see the explicit invocation to
+this constructor. You may prefer to see:
+
+\begin{verbatim}
+...
+With H we have (Q a).
+...
+\end{verbatim}
+
+This is possible by declaring the constructor as implicit. You should
+type, as before:
+
+\comindex{Add Natural Implicit}
+\begin{coq_example*}
+Add Natural Implicit constr1.
+\end{coq_example*}
+
+By default, the proposition (or predicate) constructors
+
+\verb=conj=, \verb=or_introl=, \verb=or_intror=, \verb=ex_intro=,
+\verb=exT_intro=, \verb=refl_equal=, \verb=refl_eqT= and \verb=exist=
+
+\noindent are declared implicit. Note that declaring implicit the
+constructor of a datatype (i.e. an inductive type of type \verb=Set=)
+has no effect.
+
+As above, you can remove or test a constant declared implicit.
+
+\subsubsection*{Implicit inductive constants}
+
+Let \verb=Ind= be an inductive type (either a proposition (or a
+predicate) -- on \verb=Prop= --, or a datatype -- on \verb=Set=).
+Suppose the proof proceeds by induction on an hypothesis \verb=h=
+proving \verb=Ind= (or more generally \verb=(Ind A1 ... An)=). The
+following kind of output is produced:
+
+\begin{verbatim}
+...
+With H, we will prove A by induction on the definition of Ind.
+Case 1. ...
+Case 2. ...
+...
+\end{verbatim}
+
+But sometimes, you may prefer not to see the explicit invocation to
+\verb=Ind=. You may prefer to see:
+
+\begin{verbatim}
+...
+We will prove A by induction on H.
+Case 1. ...
+Case 2. ...
+...
+\end{verbatim}
+
+This is possible by declaring the inductive type as implicit. You should
+type, as before:
+
+\comindex{Add Natural Implicit}
+\begin{coq_example*}
+Add Natural Implicit Ind.
+\end{coq_example*}
+
+This kind of parameterization works for any inductively defined
+proposition (or predicate) or datatype. Especially, it works whatever
+the definition is recursive or purely by cases.
+
+By default, the data type \verb=nat= and the inductive connectives
+\verb=and=, \verb=or=, \verb=sig=, \verb=False=, \verb=eq=,
+\verb=eqT=, \verb=ex= and \verb=exT= are declared implicit.
+
+As above, you can remove or test a constant declared implicit.  Use
+{\tt Remove Natural Contractible $id$} or {\tt Test Natural
+Contractible $id$}.
+
+\asubsection{Contractible proof steps}
+
+\subsubsection*{Contractible lemmas or constructors}
+
+Some lemmas, theorems or proof constructors of inductive predicates are
+often applied in a row and you obtain an output of this kind:
+
+\begin{verbatim}
+...
+Using T with H1 and H2 we get P.
+      * By H3 we have Q.
+      Using T with theses results we get R.
+...
+\end{verbatim}
+
+where \verb=T=, \verb=H1=, \verb=H2= and \verb=H3= prove statements
+of the form \verb=(X,Y:Prop)X->Y->(L X Y)=, \verb=A=, \verb=B= and \verb=C=
+respectively (and thus \verb=R= is \verb=(L (L A B) C)=).
+
+You may obtain a condensed output of the form
+
+\begin{verbatim}
+...
+Using T with H1, H2, and H3 we get R.
+...
+\end{verbatim}
+
+by declaring \verb=T= as contractible:
+
+\comindex{Add Natural Contractible}
+\begin{coq_example*}
+Add Natural Contractible T.
+\end{coq_example*}
+
+By default, the lemmas \verb=proj1=, \verb=proj2= and the proof
+constructors \verb=conj=, \verb=or_introl=, \verb=or_intror= are
+declared contractible. As for implicit notions, you can remove or
+test a lemma or constructor declared contractible.
+
+\subsubsection*{Contractible induction steps}
+
+Let \verb=Ind= be an inductive type. When the proof proceeds by
+induction in a row, you may obtain an output of this kind:
+
+\begin{verbatim}
+...
+We have (Ind A (Ind B C)).
+We use definition of Ind in a study in two cases.
+Case 1: We have A.
+Case 2: We have (Ind B C).
+  We use definition of Ind in a study of two cases.
+  Case 2.1: We have B.
+  Case 2.2: We have C.
+...
+\end{verbatim}
+
+You may prefer to see
+
+\begin{verbatim}
+...
+We have (Ind A (Ind B C)).
+We use definition of Ind in a study in three cases.
+Case 1: We have A.
+Case 2: We have B.
+Case 3: We have C.
+...
+\end{verbatim}
+
+This is possible by declaring \verb=Ind= as contractible:
+
+\begin{coq_example*}
+Add Natural Contractible T.
+\end{coq_example*}
+
+By default, only \verb=or= is declared as a contractible inductive
+constant.
+As for implicit notions, you can remove or test an inductive notion declared
+contractible.
+
+\asubsection{Transparent definitions}
+
+``Normal'' definitions are all constructions except proofs and proof constructors.
+
+\subsubsection*{Transparent non inductive normal definitions}
+
+When using the definition of a non inductive constant, say \verb=D=, the
+following kind of output is produced:
+
+\begin{verbatim}
+...
+We have proved C which is equivalent to D.
+...
+\end{verbatim}
+
+But you may prefer to hide that D comes from the definition of C as
+follows:
+
+\begin{verbatim}
+...
+We have prove D.
+...
+\end{verbatim}
+
+This is possible by declaring \verb=C= as transparent:
+
+\comindex{Add Natural Transparent}
+\begin{coq_example*}
+Add Natural Transparent D.
+\end{coq_example*}
+
+By default, only \verb=not= (normally written \verb=~=) is declared as
+a non inductive transparent definition.
+As for implicit and contractible definitions, you can remove or test a
+non inductive definition declared transparent.
+Use \texttt{Remove Natural Transparent} \ident or 
+\texttt{Test Natural Transparent} \ident.
+
+\subsubsection*{Transparent inductive definitions}
+
+Let \verb=Ind= be an inductive proposition (more generally: a
+predicate \verb=(Ind x1 ... xn)=). Suppose the definition of
+\verb=Ind= is non recursive and built with just
+one constructor proving something like \verb=A -> B -> Ind=.
+When coming back to the definition of \verb=Ind= the
+following kind of output is produced:
+
+\begin{verbatim}
+...
+Assume Ind (H).
+      We use H with definition of Ind.
+      We have A and B.
+      ...
+\end{verbatim}
+
+When \verb=H= is not used a second time in the proof, you may prefer
+to hide that \verb=A= and \verb=B= comes from the definition of
+\verb=Ind=. You may prefer to get directly:
+
+\begin{verbatim}
+...
+Assume A and B.
+...
+\end{verbatim}
+
+This is possible by declaring \verb=Ind= as transparent:
+
+\begin{coq_example*}
+Add Natural Transparent Ind.
+\end{coq_example*}
+
+By default, \verb=and=, \verb=or=, \verb=ex=, \verb=exT=, \verb=sig=
+are declared as inductive transparent constants.  As for implicit and
+contractible constants, you can remove or test an inductive
+constant declared transparent.
+
+As for implicit and contractible constants, you can remove or test an
+inductive constant declared transparent.
+
+\asubsection{Extending the maximal depth of nested text}
+
+The depth of nested text is limited. To know the current depth, do:
+
+\comindex{Set Natural Depth}
+\begin{coq_example}
+Set Natural Depth.
+\end{coq_example}
+
+To change the maximal depth of nested text (for instance to 125) do:
+
+\begin{coq_example}
+Set Natural Depth 125.
+\end{coq_example}
+
+\asubsection{Restoring the default parameterization}
+
+The command \verb=Set Natural Default= sets back the parameterization tables of
+\Natural~ to their default values, as listed in the above sections.
+Moreover, the language is set back to English and the max depth of
+nested text is set back to its initial value.
+
+\asubsection{Printing the current parameterization}
+
+The commands {\tt Print Natural Implicit}, {\tt Print Natural
+Contractible} and {\tt Print \\ Natural Transparent} print the list of
+constructions declared {\tt Implicit}, {\tt Contractible},
+{\tt Transparent} respectively.
+
+\asubsection{Interferences with \texttt{Reset}}
+
+The customization of \texttt{Natural} is dependent of the \texttt{Reset}
+command. If you reset the environment back to a point preceding an
+\verb=Add Natural ...= command, the effect of the command will be
+erased. Similarly, a reset back to a point before a 
+\verb=Remove Natural ... = command invalidates the removal.
+
+\asection{Error messages}
+
+An error occurs when trying to \verb=Print=, to \verb=Add=, to
+\verb=Test=, or to \verb=remove= an undefined ident. Similarly, an
+error occurs when trying to set a language unknown from \Natural.
+Errors may also occur when trying to parameterize the printing of
+proofs: some parameterization are effectively forbidden.
+Note that to \verb=Remove= an ident absent from a table or to
+\verb=Add= to a table an already present ident does not lead to an
+error.
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/Omega.tex b/doc/refman/Omega.tex
new file mode 100644
index 00000000..bbf17f63
--- /dev/null
+++ b/doc/refman/Omega.tex
@@ -0,0 +1,226 @@
+\achapter{Omega: a solver of quantifier-free problems in
+Presburger Arithmetic}
+\aauthor{Pierre Crégut}
+\label{OmegaChapter}
+
+\asection{Description of {\tt omega}}
+\tacindex{omega}
+\label{description}
+
+{\tt omega} solves a goal in Presburger arithmetic, i.e. a universally
+quantified formula made of equations and inequations. Equations may
+be specified either on the type \verb=nat= of natural numbers or on
+the type \verb=Z= of binary-encoded integer numbers. Formulas on
+\verb=nat= are automatically injected into \verb=Z=.  The procedure
+may use any hypothesis of the current proof session to solve the goal.
+
+Multiplication is handled by {\tt omega} but only goals where at
+least one of the two multiplicands of products is a constant are
+solvable. This is the restriction meaned by ``Presburger arithmetic''.
+
+If the tactic cannot solve the goal, it fails with an error message.
+In any case, the computation eventually stops.
+
+\asubsection{Arithmetical goals recognized by {\tt omega}}
+
+{\tt omega} applied only to quantifier-free formulas built from the
+connectors
+
+\begin{quote}
+\verb=/\, \/, ~, ->=
+\end{quote}
+
+on atomic formulas. Atomic formulas are built from the predicates 
+
+\begin{quote}
+\verb!=, le, lt, gt, ge!
+\end{quote}
+
+ on \verb=nat= or from the predicates
+
+\begin{quote}
+\verb!=, <, <=, >, >=!
+\end{quote}
+
+ on \verb=Z=. In expressions of type \verb=nat=, {\tt omega} recognizes 
+
+\begin{quote}
+\verb!plus, minus, mult, pred, S, O!
+\end{quote}
+
+and in expressions of type \verb=Z=, {\tt omega} recognizes 
+
+\begin{quote}
+\verb!+, -, *, Zsucc!, and constants.
+\end{quote}
+
+All expressions of type \verb=nat= or \verb=Z= not built on these
+operators are considered abstractly as if they
+were arbitrary variables of type \verb=nat= or \verb=Z=.
+
+\asubsection{Messages from {\tt omega}}
+\label{errors}
+
+When {\tt omega} does not solve the goal, one of the following errors
+is generated:
+
+\begin{ErrMsgs}
+
+\item \errindex{omega can't solve this system}
+
+  This may happen if your goal is not quantifier-free (if it is
+  universally quantified, try {\tt intros} first; if it contains
+  existentials quantifiers too, {\tt omega} is not strong enough to solve your
+  goal). This may happen also if your goal contains arithmetical
+  operators unknown from {\tt omega}. Finally, your goal may be really
+  wrong!
+
+\item \errindex{omega: Not a quantifier-free goal}
+  
+  If your goal is universally quantified, you should first apply {\tt
+    intro} as many time as needed.
+
+\item \errindex{omega: Unrecognized predicate or connective: {\sl ident}}
+
+\item \errindex{omega: Unrecognized atomic proposition: {\sl prop}}
+  
+\item \errindex{omega: Can't solve a goal with proposition variables}
+
+\item \errindex{omega: Unrecognized proposition}
+
+\item \errindex{omega: Can't solve a goal with non-linear products}
+
+\item \errindex{omega: Can't solve a goal with equality on {\sl type}}
+
+\end{ErrMsgs}
+
+%% Ce code est débranché pour l'instant
+%% 
+% \asubsection{Control over the output}
+% There are some flags that can be set to get more information on the procedure
+
+% \begin{itemize}
+% \item \verb=Time= to get the time used by the procedure
+% \item \verb=System= to visualize the normalized systems.
+% \item \verb=Action= to visualize the actions performed by the OMEGA
+%      procedure (see \ref{technical}).
+% \end{itemize}
+
+% \comindex{Set omega Time}
+% \comindex{UnSet omega Time}
+% \comindex{Switch omega Time}
+% \comindex{Set omega System}
+% \comindex{UnSet omega System}
+% \comindex{Switch omega System}
+% \comindex{Set omega Action}
+% \comindex{UnSet omega Action}
+% \comindex{Switch omega Action}
+
+% Use {\tt Set omega {\rm\sl flag}} to set the flag
+% {\rm\sl flag}. Use {\tt Unset omega {\rm\sl flag}} to unset it and
+% {\tt Switch omega {\rm\sl flag}} to toggle it.
+
+\section{Using {\tt omega}}
+
+The {\tt omega} tactic does not belong to the core system. It should be
+loaded by
+\begin{coq_example*}
+Require Import Omega.
+Open Scope Z_scope.
+\end{coq_example*}
+
+\example{}
+
+\begin{coq_example}
+Goal forall m n:Z, 1 + 2 * m <> 2 * n.
+intros; omega.
+\end{coq_example}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\example{}
+
+\begin{coq_example}
+Goal forall z:Z, z > 0 -> 2 * z + 1 > z.
+intro; omega.
+\end{coq_example}
+
+% Other examples can be found in \verb+$COQLIB/theories/DEMOS/OMEGA+.
+
+\asection{Technical data}
+\label{technical}
+
+\asubsection{Overview of the tactic}
+\begin{itemize}
+
+\item The goal is negated twice and the first negation is introduced as an
+     hypothesis.
+\item Hypothesis are decomposed in simple equations or inequations. Multiple
+     goals may result from this phase.
+\item Equations and inequations over \verb=nat= are translated over
+     \verb=Z=, multiple goals may result from the translation of
+     substraction.
+\item Equations and inequations are normalized.
+\item Goals are solved by the {\it OMEGA} decision procedure.
+\item The script of the solution is replayed.
+
+\end{itemize}
+
+\asubsection{Overview of the {\it OMEGA} decision procedure}
+
+The {\it OMEGA} decision procedure involved in the {\tt omega} tactic uses
+a small subset of the decision procedure presented in
+
+\begin{quote}
+  "The Omega Test: a fast and practical integer programming
+algorithm for dependence analysis", William Pugh, Communication of the
+ACM , 1992, p 102-114.
+\end{quote}
+
+Here is an overview, look at the original paper for more information.
+
+\begin{itemize}
+
+\item Equations and inequations are normalized by division by the GCD of their
+     coefficients.
+\item Equations are eliminated, using the Banerjee test to get a coefficient 
+     equal to one.
+\item Note that each inequation defines a half space in the space of real value
+     of the variables.
+   \item Inequations are solved by projecting on the hyperspace
+     defined by cancelling one of the variable.  They are partitioned
+     according to the sign of the coefficient of the eliminated
+     variable. Pairs of inequations from different classes define a
+     new edge in the projection.
+   \item Redundant inequations are eliminated or merged in new
+     equations that can be eliminated by the Banerjee test.
+\item The last two steps are iterated until a contradiction is reached
+     (success) or there is no more variable to eliminate (failure).
+
+\end{itemize}
+
+It may happen that there is a real solution and no integer one. The last
+steps of the Omega procedure (dark shadow) are not implemented, so the 
+decision procedure is only partial.
+
+\asection{Bugs}
+
+\begin{itemize}
+\item The simplification procedure is very dumb and this results in
+  many redundant cases to explore.
+
+\item Much too slow.
+
+\item Certainly other bugs! You can report them to
+
+\begin{quote}
+  \url{Pierre.Cregut@cnet.francetelecom.fr}
+\end{quote}
+
+\end{itemize}
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/Polynom.tex b/doc/refman/Polynom.tex
new file mode 100644
index 00000000..70889c9d
--- /dev/null
+++ b/doc/refman/Polynom.tex
@@ -0,0 +1,504 @@
+\achapter{The \texttt{ring} tactic}
+\aauthor{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
+structures. Assume you have two binary functions $\oplus$ and $\otimes$
+that are associative and commutative, with $\oplus$ distributive on
+$\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
+commutativity.
+
+\begin{Examples}
+\item In the ring of integers, the normal form of 
+$x (3 + yx + 25(1 - z)) + zx$ is $28x + (-24)xz + xxy$.
+\item For the classical propositional calculus (or the boolean rings)
+  the normal form is what logicians call \textit{disjunctive normal
+    form}: every formula is equivalent to a disjunction of
+  conjunctions of atoms. (Here $\oplus$ is $\vee$, $\otimes$ is
+  $\wedge$, variables are atoms and the only constants are T and F)
+\end{Examples}
+
+\asection{The variables map}
+
+It is frequent to have an expression built with + and
+  $\times$, but rarely on variables only.
+Let us associate a number to each subterm of a ring
+expression in the \gallina\ language. For example in the ring
+\texttt{nat}, consider the expression:
+
+\begin{quotation}
+\begin{verbatim}
+(plus (mult (plus (f (5)) x) x)
+      (mult (if b then (4) else (f (3))) (2)))
+\end{verbatim}
+\end{quotation}
+
+\noindent As a ring expression, is has 3 subterms. Give each subterm a
+number in an arbitrary order:
+
+\begin{tabular}{ccl}
+0 & $\mapsto$ & \verb|if b then (4) else (f (3))| \\
+1 & $\mapsto$ & \verb|(f (5))| \\
+2 & $\mapsto$ & \verb|x| \\
+\end{tabular}
+
+\noindent Then normalize the ``abstract'' polynomial 
+
+$$((V_1 \otimes V_2) \oplus V_2) \oplus (V_0 \otimes 2) $$
+
+\noindent In our example the normal form is:
+
+$$(2 \otimes V_0) \oplus (V_1 \otimes V_2) \oplus (V_2 \otimes V_2)$$
+
+\noindent Then substitute the variables by their values in the variables map to
+get the concrete normal polynomial:
+
+\begin{quotation}
+\begin{verbatim}
+(plus (mult (2) (if b then (4) else (f (3)))) 
+      (plus (mult (f (5)) x) (mult x x))) 
+\end{verbatim}
+\end{quotation}
+
+\asection{Is it automatic?}
+
+Yes, building the variables map and doing the substitution after
+normalizing is automatically done by the tactic. So you can just forget
+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:
+
+\begin{quotation}
+\begin{verbatim}
+Require Ring.
+\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.
+
+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{quotation}
+\texttt{ring} $term_1$ \dots{} $term_n$
+\end{quotation}
+\tacindex{ring}
+
+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
+
+\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.
+
+\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.}
+
+  \texttt{Use Add [Semi] Ring to declare it}
+
+  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}
+
+  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$.
+
+  \ErrMsg\errindex{This goal is not an equality}
+
+\end{Variants}
+
+\asection{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:
+rings and semi-rings. Semi-rings are like rings without an opposite to
+addition. Their precise specification (in \gallina) can be found in
+the file
+
+\begin{quotation}
+\begin{verbatim}
+contrib/ring/Ring_theory.v
+\end{verbatim}
+\end{quotation}
+
+The typical example of ring is \texttt{Z}, the typical
+example of semi-ring is \texttt{nat}.
+
+The specification of a
+ring is divided in two parts: first the record of constants
+($\oplus$, $\otimes$, 1, 0, $\ominus$) and then the theorems
+(associativity, commutativity, etc.).
+
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+Section Theory_of_semi_rings.
+
+Variable A : Type.
+Variable Aplus : A -> A -> A.
+Variable Amult : A -> A -> A.
+Variable Aone : A.
+Variable Azero : A.
+(* There is also a "weakly decidable" equality on A. That means 
+  that if (A_eq x y)=true then x=y but x=y can arise when 
+  (A_eq x y)=false. On an abstract ring the function [x,y:A]false
+  is a good choice. The proof of A_eq_prop is in this case easy. *)
+Variable Aeq : A -> A -> bool.
+
+Record Semi_Ring_Theory : Prop :=
+{ SR_plus_sym  : (n,m:A)[| n + m == m + n |];
+  SR_plus_assoc : (n,m,p:A)[| n + (m + p) == (n + m) + p |];
+
+  SR_mult_sym : (n,m:A)[| n*m == m*n |];
+  SR_mult_assoc : (n,m,p:A)[| n*(m*p) == (n*m)*p |];
+  SR_plus_zero_left :(n:A)[| 0 + n == n|];
+  SR_mult_one_left : (n:A)[| 1*n == n |];
+  SR_mult_zero_left : (n:A)[| 0*n == 0 |];
+  SR_distr_left   : (n,m,p:A) [| (n + m)*p == n*p + m*p |];
+  SR_plus_reg_left : (n,m,p:A)[| n + m == n + p |] -> m==p;
+  SR_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x==y
+}.
+\end{verbatim}
+\end{flushleft}
+\end{small}
+
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+Section Theory_of_rings.
+
+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.
+
+
+Record Ring_Theory : Prop :=
+{ Th_plus_sym  : (n,m:A)[| n + m == m + n |];
+  Th_plus_assoc : (n,m,p:A)[| n + (m + p) == (n + m) + p |];
+  Th_mult_sym : (n,m:A)[| n*m == m*n |];
+  Th_mult_assoc : (n,m,p:A)[| n*(m*p) == (n*m)*p |];
+  Th_plus_zero_left :(n:A)[| 0 + n == n|];
+  Th_mult_one_left : (n:A)[| 1*n == n |];
+  Th_opp_def : (n:A) [| n + (-n) == 0 |];
+  Th_distr_left   : (n,m,p:A) [| (n + m)*p == n*p + m*p |];
+  Th_eq_prop : (x,y:A) (Is_true (Aeq x y)) -> x==y
+}.
+\end{verbatim}
+\end{flushleft}
+\end{small}
+
+To define a ring structure on A, you must provide an addition, a
+multiplication, an opposite function and two unities 0 and 1.
+
+You must then prove all theorems that make
+(A,Aplus,Amult,Aone,Azero,Aeq) 
+a ring structure, and pack them with the \verb|Build_Ring_Theory| 
+constructor.
+
+Finally to register a ring the syntax is:
+
+\comindex{Add Ring}
+\begin{quotation}
+  \texttt{Add Ring} \textit{A Aplus Amult Aone Azero Ainv Aeq T}
+  \texttt{[} \textit{c1 \dots cn} \texttt{].}
+\end{quotation}
+
+\noindent where \textit{A} is a term of type \texttt{Set}, 
+\textit{Aplus} is a term of type \texttt{A->A->A},
+\textit{Amult} is a term of type \texttt{A->A->A},
+\textit{Aone} is a term of type \texttt{A},
+\textit{Azero} is a term of type \texttt{A},
+\textit{Ainv} is a term of type \texttt{A->A},
+\textit{Aeq} is a term of type \texttt{A->bool},
+\textit{T} is a term of type 
+\texttt{(Ring\_Theory }\textit{A Aplus Amult Aone Azero Ainv
+  Aeq}\texttt{)}.
+The arguments \textit{c1 \dots cn}, 
+are the names of constructors which define closed terms: a
+subterm will be considered as a constant if it is either one of the
+terms \textit{c1 \dots cn} or the application of one of these terms to
+closed terms. For \texttt{nat}, the given constructors are \texttt{S}
+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
+    Ring}
+  
+  There are two differences with the \texttt{Add Ring} command: there
+  is no inverse function and the term $T$ must be of type
+  \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}
+  
+  This command should be used for when the operations of rings are not
+  computable; for example the real numbers of
+  \texttt{theories/REALS/}. Here $0+1$ is not beta-reduced to $1$ but
+  you still may want to \textit{rewrite} it to $1$ using the ring
+  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}
+
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{Not a valid (semi)ring theory}.
+ 
+  That happens when the typing condition does not hold.
+\end{ErrMsgs}
+
+Currently, the hypothesis is made than no more than one ring structure
+may be declared for a given type in \texttt{Set} or \texttt{Type}.
+This allows automatic detection of the theory used to achieve the
+normalization. On popular demand, we can change that and allow several
+ring structures on the same set.
+
+The table of ring theories is compatible with the \Coq\ 
+sectioning mechanism. If you declare a ring inside a section, the
+declaration will be thrown away when closing the section.
+And when you load a compiled file, all the \texttt{Add Ring}
+commands of this file that are not inside a section will be loaded.
+
+The typical example of ring is \texttt{Z}, and the typical example of
+semi-ring is \texttt{nat}. Another ring structure is defined on the
+booleans. 
+
+\Warning Only the ring of booleans is loaded by default with the
+\texttt{Ring} module. To load the ring structure for \texttt{nat},
+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}. 
+This tactic did lot of rewriting. But the proofs
+terms generated by rewriting were too big for \Coq's type-checker.
+Let us see why:
+
+\begin{coq_eval}
+Require Import ZArith.
+Open Scope Z_scope.
+\end{coq_eval}
+\begin{coq_example}
+Goal forall x y z:Z, x + 3 + y + y * z = x + 3 + y + z * y.
+\end{coq_example}
+\begin{coq_example*}
+intros; rewrite (Zmult_comm y z); reflexivity.
+Save toto.
+\end{coq_example*}
+\begin{coq_example}
+Print  toto.
+\end{coq_example}
+
+At each step of rewriting, the whole context is duplicated in the proof
+term. Then, a tactic that does hundreds of rewriting generates huge proof
+terms. Since \texttt{ACDSimpl} was too slow, Samuel Boutin rewrote it
+using reflection (see his article in TACS'97 \cite{Bou97}). Later, the
+stuff was rewritten by Patrick
+Loiseleur: the new tactic does not any more require \texttt{ACDSimpl}
+to compile and it makes use of $\beta\delta\iota$-reduction 
+not only to replace the rewriting steps, but also to achieve the
+interleaving of computation and 
+reasoning (see \ref{DiscussReflection}). He also wrote a
+few ML code for the \texttt{Add Ring} command, that allow to register
+new rings dynamically.
+
+Proofs terms generated by \texttt{ring} are quite small, they are
+linear in the number of $\oplus$ and $\otimes$ operations in the
+normalized terms. Type-checking those terms requires some time because it
+makes a large use of the conversion rule, but
+memory requirements are much smaller. 
+
+\asection{Discussion}
+\label{DiscussReflection}
+
+Efficiency is not the only motivation to use reflection
+here. \texttt{ring} also deals with constants, it rewrites for example the
+expression $34 + 2*x -x + 12$ to the expected result $x + 46$. For the
+tactic \texttt{ACDSimpl}, the only constants were 0 and 1. So the
+expression $34 + 2*(x - 1) + 12$ is interpreted as 
+$V_0 \oplus V_1 \otimes (V_2 \ominus 1) \oplus V_3$, 
+with the variables mapping 
+$\{V_0 \mt 34; V_1 \mt 2; V_2 \mt x; V_3 \mt 12 \}$. Then it is
+rewritten to $34 - x + 2*x + 12$, very far from the expected
+result. Here rewriting is not sufficient: you have to do some kind of
+reduction (some kind of \textit{computation}) to achieve the
+normalization.
+
+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
+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!
+
+ 
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/Program.tex b/doc/refman/Program.tex
new file mode 100644
index 00000000..ed1e6e63
--- /dev/null
+++ b/doc/refman/Program.tex
@@ -0,0 +1,491 @@
+\def\Program{\textsc{Program}}
+\def\Russel{\textsc{Russel}}
+
+\achapter{The \Program{} tactic}
+\label{Program}
+\aauthor{Matthieu Sozeau}
+\index{Program}
+
+\begin{flushleft}
+  \em The status of \Program is experimental.
+\end{flushleft}
+
+We present here the \Coq\ \Program tactic commands, used to build certified
+\Coq programs, elaborating them from their algorithmic skeleton and a
+rich specification. It can be sought of as a dual of extraction \ref{Extraction}.
+The languages available as input are currently restricted to \Coq's term
+language, but may be extended to \ocaml{}, \textsc{Haskell} and others
+in the future. Input terms and types are typed in an extended system (\Russel) and
+interpreted into \Coq\ terms. The interpretation process may produce
+some proof obligations which need to be resolved to create the final term.
+
+\asection{Elaborating programs}
+\comindex{Program Fixpoint}
+
+The next two commands are similar to they standard counterparts
+\ref{Simpl-definitions} and \ref{Fixpoint} in that
+they define constants. However, they may require the user to prove some
+goals to construct the final definitions.
+
+\section{\tt Program Definition {\ident} := {\term}.
+  \comindex{Program Definition}\label{ProgramDefinition}}
+
+This command types the value {\term} in \Russel and generate subgoals
+corresponding to proof obligations. Once solved, it binds the final
+\Coq\ term to the name {\ident} in the environment.
+
+\begin{ErrMsgs}
+\item \errindex{{\ident} already exists}
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt Program Definition {\ident} {\tt :}{\term$_1$} :=
+    {\term$_2$}.}\\
+  It interprets the type {\term$_1$}, potentially generating proof
+  obligations to be resolved. Once done with them, we have a \Coq\ type
+  {\term$_1'$}. It then checks that the type of the interpretation of
+  {\term$_2$} is coercible to {\term$_1'$}, and registers {\ident} as
+  being of type {\term$_1'$} once the set of obligations generated
+  during the interpretation of {\term$_2$} and the aforementioned
+  coercion derivation are solved.
+\item {\tt Program Definition {\ident} {\binder$_1$}\ldots{\binder$_n$}
+       {\tt :}\term$_1$ {\tt :=} {\term$_2$}.}\\
+  This is equivalent to \\
+   {\tt Program Definition\,{\ident}\,{\tt :\,forall}\,%
+       {\binder$_1$}\ldots{\binder$_n$}{\tt ,}\,\term$_1$\,{\tt :=}}\,%
+       {\tt fun}\,{\binder$_1$}\ldots{\binder$_n$}\,{\tt =>}\,{\term$_2$}\,%
+       {\tt .}
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{In environment {\dots} the term: {\term$_2$} does not have type
+    {\term$_1$}}.\\
+    \texttt{Actually, it has type {\term$_3$}}.
+\end{ErrMsgs}
+
+\SeeAlso Sections \ref{Opaque}, \ref{Transparent}, \ref{unfold}
+
+\section{\tt Program Fixpoint {\ident} {\params} {\tt \{order\}} : type$_0$ := \term$_0$ 
+  \comindex{Program Fixpoint}
+  \label{ProgramFixpoint}}
+
+This command allows to define objects using a fixed point
+construction. The meaning of this declaration is to define {\it ident}
+a recursive function with arguments specified by
+{\binder$_1$}\ldots{\binder$_n$} such that {\it ident} applied to
+arguments corresponding to these binders has type \type$_0$, and is
+equivalent to the expression \term$_0$. The type of the {\ident} is
+consequently {\tt forall {\params} {\tt,} \type$_0$}
+and the value is equivalent to {\tt fun {\params} {\tt =>} \term$_0$}.
+
+There are two ways to define fixpoints with \Program{}, structural and
+well-founded recursion.
+
+\subsection{\tt Program Fixpoint {\ident} {\params} {\tt \{struct}
+  \ident$_0$ {\tt \}} : type$_0$ := \term$_0$  
+  \comindex{Program Fixpoint Struct}
+  \label{ProgramFixpointStruct}}
+
+To be accepted, a structural {\tt Fixpoint} definition has to satisfy some
+syntactical constraints on a special argument called the decreasing
+argument. They are needed to ensure that the {\tt Fixpoint} definition
+always terminates. The point of the {\tt \{struct \ident {\tt \}}}
+annotation is to let the user tell the system which argument decreases
+along the recursive calls. This annotation may be left implicit for
+fixpoints with one argument. For instance, one can define the identity
+function on naturals as :
+
+\begin{coq_example}
+Program Fixpoint id (n : nat) : { x : nat | x = n } :=
+  match n with
+  | O => O
+  | S p => S (id p)
+  end.
+\end{coq_example}
+
+The {\tt match} operator matches a value (here \verb:n:) with the
+various constructors of its (inductive) type. The remaining arguments
+give the respective values to be returned, as functions of the
+parameters of the corresponding constructor. Thus here when \verb:n:
+equals \verb:O: we return \verb:0:, and when \verb:n: equals 
+\verb:(S p): we return \verb:(S (id p)):.
+
+The {\tt match} operator is formally described
+in detail in Section~\ref{Caseexpr}.  The system recognizes that in
+the inductive call {\tt (id p)} the argument actually
+decreases because it is a {\em pattern variable} coming from {\tt match
+  n with}.
+
+Here again, proof obligations may be generated. In our example, we would
+have one for each branch:
+\begin{coq_example}
+Show.
+\end{coq_example}
+
+% \subsection{\tt Program Fixpoint {\ident} {(\ident_$_0$ : \type_$_0$)
+%     \cdots (\ident_$_n$ : \type_$_n$)} {\tt \{wf}
+%   \ident$_i$ \term_{wf} {\tt \}} : type$_t$ := \term$_0$
+%   \comindex{Program Fixpoint Wf}
+%   \label{ProgramFixpointWf}}
+
+% To be accepted, a well-founded {\tt Fixpoint} definition has to satisfy some
+% logical constraints on the decreasing argument. 
+% They are needed to ensure that the {\tt Fixpoint} definition
+% always terminates. The point of the {\tt \{wf \ident \term {\tt \}}}
+% annotation is to let the user tell the system which argument decreases
+% in which well-founded relation along the recursive calls. 
+% The term \term$_0$ will be typed in a different context than usual,
+% The typing problem will in fact be reduced to: 
+
+% % \begin{center}
+% %   {\tt forall} {\params} {\ident : (\ident$_0$ : type$_0$) \cdots
+% %     \{ \ident$_i'$ : \type$_i$ | \term_{wf} \ident$_i'$ \ident$_i$ \}
+% %     \cdots (\ident$_n$ : type$_n$), type$_t$} : type$_t$ := \term$_0$
+% % \end{center}
+
+% \begin{coq_example}
+% Program Fixpoint id (n : nat) : { x : nat | x = n } :=
+%   match n with
+%   | O => O
+%   | S p => S (id p)
+%   end
+% \end{coq_example}
+
+% The {\tt match} operator matches a value (here \verb:n:) with the
+% various constructors of its (inductive) type. The remaining arguments
+% give the respective values to be returned, as functions of the
+% parameters of the corresponding constructor. Thus here when \verb:n:
+% equals \verb:O: we return \verb:0:, and when \verb:n: equals 
+% \verb:(S p): we return \verb:(S (id p)):.
+
+% The {\tt match} operator is formally described
+% in detail in Section~\ref{Caseexpr}.  The system recognizes that in
+% the inductive call {\tt (id p)} the argument actually
+% decreases because it is a {\em pattern variable} coming from {\tt match
+%   n with}.
+
+% Here again, proof obligations may be generated. In our example, we would
+% have one for each branch:
+% \begin{coq_example}
+% Show.
+% \end{coq_example}
+% \begin{coq_eval}
+% Abort.
+% \end{coq_eval}
+
+
+
+
+% \asubsection{A detailed example: Euclidean division}
+
+% The file {\tt Euclid} contains the proof of Euclidean division
+% (theorem {\tt eucl\_dev}). The natural numbers defined in the example
+% files are unary integers defined by two constructors $O$ and $S$:
+% \begin{coq_example*}
+% Inductive nat : Set :=
+%   | O : nat
+%   | S : nat -> nat.
+% \end{coq_example*}
+
+% This module contains a theorem {\tt eucl\_dev}, and its extracted term
+% is of type 
+% \begin{verbatim}
+% forall b:nat, b > 0 -> forall a:nat, diveucl a b
+% \end{verbatim}
+% where {\tt diveucl} is a type for the pair of the quotient and the modulo.
+% We can now extract this program to \ocaml:
+
+% \begin{coq_eval}
+% Reset Initial.
+% \end{coq_eval}
+% \begin{coq_example}
+% Require Import Euclid.
+% Extraction Inline Wf_nat.gt_wf_rec Wf_nat.lt_wf_rec.
+% Recursive Extraction  eucl_dev.
+% \end{coq_example}
+
+% The inlining of {\tt gt\_wf\_rec} and {\tt lt\_wf\_rec} is not
+% mandatory. It only enhances readability of extracted code. 
+% You can then copy-paste the output to a file {\tt euclid.ml} or let 
+% \Coq\ do it for you with the following command: 
+
+% \begin{coq_example}
+% Extraction "euclid" eucl_dev.
+% \end{coq_example}
+
+% Let us play the resulting program:
+
+% \begin{verbatim}
+% # #use "euclid.ml";;
+% type sumbool = Left | Right
+% type nat = O | S of nat
+% type diveucl = Divex of nat * nat
+% val minus : nat -> nat -> nat = <fun>
+% val le_lt_dec : nat -> nat -> sumbool = <fun>
+% val le_gt_dec : nat -> nat -> sumbool = <fun>
+% val eucl_dev : nat -> nat -> diveucl = <fun>
+% # eucl_dev (S (S O)) (S (S (S (S (S O)))));;
+% - : diveucl = Divex (S (S O), S O)
+% \end{verbatim}
+% It is easier to test on \ocaml\ integers:
+% \begin{verbatim}
+% # let rec i2n = function 0 -> O | n -> S (i2n (n-1));;
+% val i2n : int -> nat = <fun>
+% # let rec n2i = function O -> 0 | S p -> 1+(n2i p);;
+% val n2i : nat -> int = <fun>
+% # let div a b = 
+%      let Divex (q,r) = eucl_dev (i2n b) (i2n a) in (n2i q, n2i r);;
+% div : int -> int -> int * int = <fun>
+% # div 173 15;;
+% - : int * int = 11, 8
+% \end{verbatim}
+
+% \asubsection{Another detailed example: Heapsort}
+
+% The file {\tt Heap.v}
+% contains the proof of an efficient list sorting algorithm described by
+% Bjerner. Is is an adaptation of the well-known {\em heapsort}
+% algorithm to functional languages. The main function is {\tt
+% treesort}, whose type is shown below: 
+
+
+% \begin{coq_eval}
+% Reset Initial.
+% Require Import Relation_Definitions.
+% Require Import List.
+% Require Import Sorting.
+% Require Import Permutation.
+% \end{coq_eval}
+% \begin{coq_example}
+% Require Import Heap.
+% Check treesort.
+% \end{coq_example}
+
+% Let's now extract this function: 
+
+% \begin{coq_example}
+% Extraction Inline sort_rec is_heap_rec.
+% Extraction NoInline list_to_heap.
+% Extraction "heapsort" treesort.
+% \end{coq_example}
+
+% One more time, the {\tt Extraction Inline} and {\tt NoInline}
+% directives are cosmetic. Without it, everything goes right, 
+% but the output is less readable.
+% Here is the produced file {\tt heapsort.ml}: 
+
+% \begin{verbatim}
+% type nat =
+%   | O
+%   | S of nat
+
+% type 'a sig2 =
+%   'a
+%   (* singleton inductive, whose constructor was exist2 *)
+  
+% type sumbool =
+%   | Left
+%   | Right
+
+% type 'a list =
+%   | Nil
+%   | Cons of 'a * 'a list
+
+% type 'a multiset =
+%   'a -> nat
+%   (* singleton inductive, whose constructor was Bag *)
+  
+% type 'a merge_lem =
+%   'a list
+%   (* singleton inductive, whose constructor was merge_exist *)
+  
+% (** val merge : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 -> sumbool) ->
+%                 'a1 list -> 'a1 list -> 'a1 merge_lem **)
+
+% let rec merge leA_dec eqA_dec l1 l2 =
+%   match l1 with
+%     | Nil -> l2
+%     | Cons (a, l) ->
+%         let rec f = function
+%           | Nil -> Cons (a, l)
+%           | Cons (a0, l3) ->
+%               (match leA_dec a a0 with
+%                  | Left -> Cons (a,
+%                      (merge leA_dec eqA_dec l (Cons (a0, l3))))
+%                  | Right -> Cons (a0, (f l3)))
+%         in f l2
+
+% type 'a tree =
+%   | Tree_Leaf
+%   | Tree_Node of 'a * 'a tree * 'a tree
+
+% type 'a insert_spec =
+%   'a tree
+%   (* singleton inductive, whose constructor was insert_exist *)
+  
+% (** val insert : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 -> sumbool) ->
+%                  'a1 tree -> 'a1 -> 'a1 insert_spec **)
+
+% let rec insert leA_dec eqA_dec t a =
+%   match t with
+%     | Tree_Leaf -> Tree_Node (a, Tree_Leaf, Tree_Leaf)
+%     | Tree_Node (a0, t0, t1) ->
+%         let h3 = fun x -> insert leA_dec eqA_dec t0 x in
+%         (match leA_dec a0 a with
+%            | Left -> Tree_Node (a0, t1, (h3 a))
+%            | Right -> Tree_Node (a, t1, (h3 a0)))
+
+% type 'a build_heap =
+%   'a tree
+%   (* singleton inductive, whose constructor was heap_exist *)
+  
+% (** val list_to_heap : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 ->
+%                        sumbool) -> 'a1 list -> 'a1 build_heap **)
+
+% let rec list_to_heap leA_dec eqA_dec = function
+%   | Nil -> Tree_Leaf
+%   | Cons (a, l0) ->
+%       insert leA_dec eqA_dec (list_to_heap leA_dec eqA_dec l0) a
+
+% type 'a flat_spec =
+%   'a list
+%   (* singleton inductive, whose constructor was flat_exist *)
+  
+% (** val heap_to_list : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 ->
+%                        sumbool) -> 'a1 tree -> 'a1 flat_spec **)
+
+% let rec heap_to_list leA_dec eqA_dec = function
+%   | Tree_Leaf -> Nil
+%   | Tree_Node (a, t0, t1) -> Cons (a,
+%       (merge leA_dec eqA_dec (heap_to_list leA_dec eqA_dec t0)
+%         (heap_to_list leA_dec eqA_dec t1)))
+
+% (** val treesort : ('a1 -> 'a1 -> sumbool) -> ('a1 -> 'a1 -> sumbool)
+%                    -> 'a1 list -> 'a1 list sig2 **)
+
+% let treesort leA_dec eqA_dec l =
+%   heap_to_list leA_dec eqA_dec (list_to_heap leA_dec eqA_dec l)
+
+% \end{verbatim}
+
+% Let's test it: 
+% % Format.set_margin 72;;
+% \begin{verbatim}
+% # #use "heapsort.ml";;
+% type sumbool = Left | Right
+% type nat = O | S of nat
+% type 'a tree = Tree_Leaf | Tree_Node of 'a * 'a tree * 'a tree
+% type 'a list = Nil | Cons of 'a * 'a list
+% val merge : 
+%   ('a -> 'a -> sumbool) -> 'b -> 'a list -> 'a list -> 'a list = <fun>
+% val heap_to_list : 
+%   ('a -> 'a -> sumbool) -> 'b -> 'a tree -> 'a list = <fun>
+% val insert : 
+%   ('a -> 'a -> sumbool) -> 'b -> 'a tree -> 'a -> 'a tree = <fun>
+% val list_to_heap : 
+%   ('a -> 'a -> sumbool) -> 'b -> 'a list -> 'a tree = <fun>
+% val treesort : 
+%   ('a -> 'a -> sumbool) -> 'b -> 'a list -> 'a list = <fun>
+% \end{verbatim}
+
+% One can remark that the argument of {\tt treesort} corresponding to 
+% {\tt eqAdec} is never used in the informative part of the terms, 
+% only in the logical parts. So the extracted {\tt treesort} never use
+% it, hence this {\tt 'b} argument. We will use {\tt ()} for this
+% argument. Only remains the {\tt leAdec}
+% argument (of type {\tt 'a -> 'a -> sumbool}) to really provide.
+
+% \begin{verbatim}
+% # let leAdec x y = if x <= y then Left else Right;;
+% val leAdec : 'a -> 'a -> sumbool = <fun>
+% # let rec listn = function 0 -> Nil
+%                          | n -> Cons(Random.int 10000,listn (n-1));;
+% val listn : int -> int list = <fun>
+% # treesort leAdec () (listn 9);;
+% - : int list = Cons (160, Cons (883, Cons (1874, Cons (3275, Cons 
+%   (5392, Cons (7320, Cons (8512, Cons (9632, Cons (9876, Nil)))))))))
+% \end{verbatim}
+
+% Some tests on longer lists (10000 elements) show that the program is
+% quite efficient for Caml code.
+
+
+% \asubsection{The Standard Library} 
+
+% As a test, we propose an automatic extraction of the 
+% Standard Library of \Coq. In particular, we will find back the
+% two previous examples, {\tt Euclid} and {\tt Heapsort}. 
+% Go to directory {\tt contrib/extraction/test} of the sources of \Coq,
+% and run commands: 
+% \begin{verbatim}
+% make tree; make
+% \end{verbatim}
+% This will extract all Standard Library files and compile them. 
+% It is done via many {\tt Extraction Module}, with some customization
+% (see subdirectory {\tt custom}).
+
+% %The result of this extraction of the Standard Library can be browsed
+% %at URL 
+% %\begin{flushleft}
+% %\url{http://www.lri.fr/~letouzey/extraction}.
+% %\end{flushleft}
+                                
+% %Reals theory is normally not extracted, since it is an axiomatic 
+% %development. We propose nonetheless a dummy realization of those
+% %axioms, to test, run: \\
+% %
+% %\mbox{\tt make reals}\\
+
+% This test works also with Haskell. In the same directory, run:
+% \begin{verbatim}
+% make tree; make -f Makefile.haskell
+% \end{verbatim}
+% The haskell compiler currently used is {\tt hbc}.  Any other should
+% also work, just adapt the {\tt Makefile.haskell}. In particular {\tt
+%  ghc} is known to work.
+
+% \asubsection{Extraction's horror museum}
+
+% Some pathological examples of extraction are grouped in the file
+% \begin{verbatim}
+% contrib/extraction/test_extraction.v
+% \end{verbatim}
+% of the sources of \Coq.
+
+% \asubsection{Users' Contributions}
+
+%  Several of the \Coq\ Users' Contributions use extraction to produce 
+%  certified programs. In particular the following ones have an automatic 
+%  extraction test (just run {\tt make} in those directories): 
+
+%  \begin{itemize}
+%  \item Bordeaux/Additions
+%  \item Bordeaux/EXCEPTIONS
+%  \item Bordeaux/SearchTrees
+%  \item Dyade/BDDS
+%  \item Lannion
+%  \item Lyon/CIRCUITS
+%  \item Lyon/FIRING-SQUAD
+%  \item Marseille/CIRCUITS
+%  \item Muenchen/Higman
+%  \item Nancy/FOUnify
+%  \item Rocq/ARITH/Chinese
+%  \item Rocq/COC
+%  \item Rocq/GRAPHS
+%  \item Rocq/HIGMAN
+%  \item Sophia-Antipolis/Stalmarck
+%  \item Suresnes/BDD
+%  \end{itemize}
+
+%  Lannion, Rocq/HIGMAN and Lyon/CIRCUITS are a bit particular. They are 
+%  the only examples of developments where {\tt Obj.magic} are needed.
+%  This is probably due to an heavy use of impredicativity.
+%  After compilation those two examples run nonetheless,
+%  thanks to the correction of the extraction~\cite{Let02}. 
+
+% $Id: Program.tex 8688 2006-04-07 15:08:12Z msozeau $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-add.tex b/doc/refman/RefMan-add.tex
new file mode 100644
index 00000000..a4fdf0cd
--- /dev/null
+++ b/doc/refman/RefMan-add.tex
@@ -0,0 +1,54 @@
+\chapter{List of additional documentation}\label{Addoc}
+
+\section{Tutorials}\label{Tutorial}
+A companion volume to this reference manual, the \Coq\ Tutorial, is
+aimed at gently introducing new users to developing proofs in \Coq\
+without assuming prior knowledge of type theory. In a second step, the
+user can read also the tutorial on recursive types (document {\tt
+RecTutorial.ps}).
+
+\section{The \Coq\ standard library}\label{Addoc-library}
+A brief description of the \Coq\ standard library is given in the additional
+document {\tt Library.dvi}.
+
+\section{Installation and un-installation procedures}\label{Addoc-install}
+A \verb!INSTALL! file in the distribution explains how to install
+\Coq.
+
+\section{{\tt Extraction} of programs}\label{Addoc-extract}
+{\tt Extraction} is a package offering some special facilities to
+extract ML program files. It is described in the separate document
+{\tt Extraction.dvi}
+\index{Extraction of programs}
+
+\section{Proof printing in {\tt Natural} language}\label{Addoc-natural}
+{\tt Natural} is a tool to print proofs in natural language.
+It is described in the separate document {\tt Natural.dvi}.
+\index{Natural@{\tt Print Natural}}
+\index{Printing in natural language}
+
+\section{The {\tt Omega} decision tactic}\label{Addoc-omega}
+{\bf Omega} is a tactic to automatically solve arithmetical goals in
+Presburger arithmetic (i.e. arithmetic without multiplication). 
+It is described in the separate document {\tt Omega.dvi}.
+\index{Omega@{\tt Omega}}
+
+\section{Simplification on rings}\label{Addoc-polynom}
+A documentation of the package {\tt polynom} (simplification on rings)
+can be found in the document {\tt Polynom.dvi}
+\index{Polynom@{\tt Polynom}}
+\index{Simplification on rings}
+
+%\section{Anomalies}\label{Addoc-anomalies}
+%The separate document {\tt Anomalies.*} gives a list of known
+%anomalies and bugs of the system.  Before communicating us an
+%anomalous behavior, please check first whether it has been already
+%reported in this document.
+
+% $Id: RefMan-add.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-cas.tex b/doc/refman/RefMan-cas.tex
new file mode 100644
index 00000000..c79c14e9
--- /dev/null
+++ b/doc/refman/RefMan-cas.tex
@@ -0,0 +1,692 @@
+%\documentstyle[11pt,../tools/coq-tex/coq,fullpage]{article}
+
+%\pagestyle{plain}
+
+%\begin{document}
+%\nocite{Augustsson85,wadler87,HuetLevy79,MaSi94,maranget94,Laville91,saidi94,dowek93,Leroy90,puel-suarez90}
+
+%\input{title}
+%\input{macros}
+%\coverpage{The Macro \verb+Cases+}{Cristina Cornes}
+%\pagestyle{plain}
+\chapter{The Macro {\tt Cases}}\label{Cases}\index{Cases@{\tt Cases}}
+
+\marginparwidth 0pt \oddsidemargin 0pt \evensidemargin 0pt \marginparsep 0pt
+\topmargin 0pt \textwidth 6.5in \textheight 8.5in
+
+
+\verb+Cases+ is an extension to the concrete syntax of Coq that allows
+to write case expressions using patterns in a syntax close to that of ML languages.  
+This construction is just a  macro that is
+expanded during parsing into a sequence of the primitive construction 
+ \verb+Case+.
+The current implementation contains two strategies, one for compiling
+non-dependent case and another one for dependent case.
+\section{Patterns}\label{implementation}
+A pattern is a term that indicates the {\em shape} of a value, i.e. a
+term where the variables can be seen as holes. When a value is 
+matched against a pattern (this is called {\em pattern matching}) 
+the pattern behaves as a filter, and associates a sub-term  of the value
+to each hole (i.e. to each variable pattern). 
+ 
+
+The syntax of patterns is presented in  figure \ref{grammar}\footnote{
+Notation:  \{$P$\}$^*$ denotes zero or more repetitions of $P$ and 
+ \{$P$\}$^+$ denotes  one or more repetitions of $P$. {\sl command} is the
+non-terminal corresponding to terms in Coq.}.
+Patterns are built up from constructors and variables. Any identifier
+that is not a constructor of an inductive or coinductive type is
+considered to be 
+a variable. Identifiers in patterns should be linear except for 
+the ``don't care''  pattern denoted by ``\verb+_+''.
+We can use patterns to build more complex patterns. 
+We call {\em simple pattern} a variable  or a pattern of the form
+$(c~\vec{x})$ where $c$ is a constructor symbol and $\vec{x}$ is a
+linear vector of  variables. If a pattern is
+not simple we call it {\em nested}.  
+
+
+A variable pattern matches any value, and the
+identifier is bound to that value. The pattern ``\verb+_+'' also matches
+any value, but it is not binding. Alias patterns written \verb+(+{\sl pattern} \verb+as+ {\sl
+identifier}\verb+)+ are also accepted. This pattern matches the same values as
+{\sl pattern} does   and
+{\sl identifier} is bound to the matched value.
+A list of patterns is also considered as a pattern and is called {\em
+multiple pattern}.
+
+\begin{figure}[t]
+\begin{center}
+\begin{sl}
+\begin{tabular}{|l|}\hline  \\
+\begin{tabular}{rcl}%\hline && \\
+simple\_pattern  & := &  pattern \verb+as+  identifier \\
+                  &$|$ &  pattern \verb+,+ pattern \\ 
+                  &$|$ &  pattern pattern\_list \\ && \\
+
+pattern  & := & identifier  $|$ \verb+(+ simple\_pattern \verb+)+ \\ &&\\
+
+
+equation & := &  \{pattern\}$^+$ ~\verb+=>+ ~term \\ && \\
+
+ne\_eqn\_list & := & \verb+|+$^{opt}$ equation~ \{\verb+|+ equation\}$^*$  \\ &&\\
+
+eqn\_list & := & \{~equation~ \{\verb+|+ equation\}$^*$~\}$^*$\\ &&\\
+
+
+term & := &  
+\verb+Cases+ \{term \}$^+$ \verb+of+ ne\_eqn\_list \verb+end+ \\
+&$|$ & \verb+<+term\verb+>+ \verb+Cases+ \{ term \}$^+$
+\verb+of+ eqn\_list \verb+end+ \\&& %\\ \hline
+\end{tabular} \\ \hline
+\end{tabular} 
+\end{sl} \end{center}
+\caption{Macro Cases syntax.}
+\label{grammar}
+\end{figure}
+
+
+Pattern matching  improves readability. Compare for example the term
+of the  function {\em is\_zero} of natural 
+numbers written with patterns and the one written in primitive
+concrete syntax (note that the first bar \verb+|+ is optional)~:
+
+\begin{center}
+\begin{small}
+\begin{tabular}{l}
+\verb+[n:nat] Cases n of | O => true | _ => false end+,\\ 
+\verb+[n:nat] Case  n of true [_:nat]false end+.
+\end{tabular}
+\end{small}
+\end{center}
+
+In Coq pattern matching is compiled into the primitive constructions,
+thus the expressiveness of the theory remains the same. Once the stage
+of parsing has finished patterns disappear. An easy way to see the
+result of the expansion is by printing the term with \texttt{Print} if
+the term is a constant, or
+using the command \texttt{Check}  that displays
+the term with its type :
+
+\begin{coq_example}
+Check (fun n:nat => match n with
+                    | O => true
+                    | _ => false
+                    end).
+\end{coq_example}
+
+
+\verb+Cases+ accepts optionally an infix term enclosed between
+brackets \verb+<>+ that we
+call the {\em elimination predicate}. 
+This term is the same argument as the one expected by the primitive
+\verb+Case+. Given a pattern matching
+expression, if all the right hand sides of \verb+=>+ ({\em rhs} in
+short) have the same type, then this term
+can be sometimes synthesized, and so we can omit the \verb+<>+.
+Otherwise we have to
+provide the predicate between \verb+<>+ as for the primitive \verb+Case+.
+
+Let us illustrate through examples the different aspects of pattern matching.
+Consider for example the function that computes the maximum of two
+natural numbers.  We can write it in primitive syntax by:
+\begin{coq_example}
+Fixpoint max (n m:nat) {struct m} : nat :=
+  match n with
+  | O => 
+      (*  O   *) m
+      (* S n' *) 
+  | S n' =>
+      match m with
+      | O => 
+          (* O    *) S n'
+          (* S m' *) 
+      | S m' => S (max n' m')
+      end
+  end.
+\end{coq_example}
+
+Using patterns in the definitions gives:
+
+\begin{coq_example}
+Reset max.
+Fixpoint max (n m:nat) {struct m} : nat :=
+  match n with
+  | O => m
+  | S n' => match m with
+            | O => S n'
+            | S m' => S (max n' m')
+            end
+  end.
+\end{coq_example}
+
+Another way to write this definition is to use a multiple pattern to
+ match    \verb+n+ and \verb+m+:
+
+\begin{coq_example}
+Reset max.
+Fixpoint max (n m:nat) {struct m} : nat :=
+  match n, m with
+  | O, _ => m
+  | S n', O => S n'
+  | S n', S m' => S (max n' m')
+  end.
+\end{coq_example}
+
+
+The strategy examines patterns 
+from left to right. A case expression is generated {\bf only}  when there is at least one constructor in the column of patterns.
+For example, 
+\begin{coq_example}
+Check (fun x:nat => match x return nat with
+                    | y => y
+                    end).
+\end{coq_example}
+
+
+
+We can also use ``\verb+as+ patterns'' to associate a name to a
+sub-pattern:
+
+\begin{coq_example}
+Reset max.
+Fixpoint max (n m:nat) {struct n} : nat :=
+  match n, m with
+  | O, _ => m
+  | S n' as N, O => N
+  | S n', S m' => S (max n' m')
+  end.
+\end{coq_example}
+
+
+In the previous examples patterns do not conflict with, but
+sometimes it is comfortable to write patterns that admits a non
+trivial superposition. Consider
+the boolean function $lef$ that given two natural numbers
+yields \verb+true+ if the first one is less or equal than the second
+one and \verb+false+ otherwise. We can write it as follows:
+
+\begin{coq_example}
+Fixpoint lef (n m:nat) {struct m} : bool :=
+  match n, m with
+  | O, x => true
+  | x, O => false
+  | S n, S m => lef n m
+  end.
+\end{coq_example}
+
+Note that the first and the second  multiple pattern  superpose because the couple of
+values \verb+O O+ matches both. Thus, what is the result of the
+function on those values?
+To eliminate ambiguity we use the {\em textual priority rule}: we
+consider patterns ordered from top to bottom, then a value is matched
+by the  pattern at the $ith$ row if and only if is not matched by some
+pattern of a previous row. Thus in the example,
+\verb+O O+ is matched by the first pattern, and so \verb+(lef O O)+
+yields \verb+true+.
+
+Another way to write  this function is:
+
+\begin{coq_example}
+Reset lef.
+Fixpoint lef (n m:nat) {struct m} : bool :=
+  match n, m with
+  | O, x => true
+  | S n, S m => lef n m
+  | _, _ => false
+  end.
+\end{coq_example}
+
+
+Here the last pattern superposes with the first two. Because
+of the priority rule, the last pattern 
+will be used only for values that do not match neither the  first nor
+the second one.  
+
+Terms with useless patterns are accepted by the
+system. For example,
+\begin{coq_example}
+Check
+  (fun x:nat => match x with
+                | O => true
+                | S _ => false
+                | x => true
+                end).
+\end{coq_example}
+
+is accepted even though the last pattern is never used.
+Beware,  the
+current implementation rises no warning message when there are unused
+patterns in a term.
+
+
+
+
+\subsection{About patterns of parametric types}
+When matching objects of a parametric type, constructors in patterns
+{\em do not expect} the parameter arguments. Their value is deduced
+during expansion.
+
+Consider for example the polymorphic lists:
+
+\begin{coq_example}
+Inductive List (A:Set) : Set :=
+  | nil : List A
+  | cons : A -> List A -> List A.
+\end{coq_example}
+
+We can check the function {\em tail}:
+
+\begin{coq_example}
+Check
+  (fun l:List nat =>
+     match l with
+     | nil => nil nat
+     | cons _ l' => l'
+     end).
+\end{coq_example}
+
+
+When we use parameters in patterns there is an error message:
+\begin{coq_example}
+Check
+  (fun l:List nat =>
+     match l with
+     | nil nat => nil nat
+     | cons nat _ l' => l'
+     end).
+\end{coq_example}
+
+
+
+\subsection{Matching objects of dependent types}
+The previous examples illustrate pattern matching on objects of
+non-dependent types, but we can also 
+use the macro to destructure objects of dependent type.
+Consider the type \verb+listn+ of lists of a certain length:
+
+\begin{coq_example}
+Inductive listn : nat -> Set :=
+  | niln : listn 0%N
+  | consn : forall n:nat, nat -> listn n -> listn (S n).
+\end{coq_example}
+
+\subsubsection{Understanding dependencies in patterns}
+We can define the function \verb+length+ over \verb+listn+ by :
+
+\begin{coq_example}
+Definition length (n:nat) (l:listn n) := n.
+\end{coq_example}
+
+Just for illustrating pattern matching, 
+we can define it by case analysis:
+\begin{coq_example}
+Reset length.
+Definition length (n:nat) (l:listn n) :=
+  match l with
+  | niln => 0%N
+  | consn n _ _ => S n
+  end.
+\end{coq_example}
+
+We can understand the meaning of this definition using the
+same notions of usual pattern matching.
+
+Now suppose we split the second pattern  of \verb+length+ into two 
+cases so to give an
+alternative definition using nested patterns:
+\begin{coq_example}
+Definition length1 (n:nat) (l:listn n) :=
+  match l with
+  | niln => 0%N
+  | consn n _ niln => S n
+  | consn n _ (consn _ _ _) => S n
+  end.
+\end{coq_example}
+
+It is obvious that \verb+length1+ is  another version of
+\verb+length+. We can also give the following definition:
+\begin{coq_example}
+Definition length2 (n:nat) (l:listn n) :=
+  match l with
+  | niln => 0%N
+  | consn n _ niln => 1%N
+  | consn n _ (consn m _ _) => S (S m)
+  end.
+\end{coq_example}
+
+If we forget that \verb+listn+ is a dependent type and we read these
+definitions using the usual semantics of pattern matching,  we can conclude
+that \verb+length1+
+and \verb+length2+ are different functions.
+In fact, they are equivalent
+because the pattern \verb+niln+ implies that \verb+n+ can only match
+the value $0$ and analogously the pattern \verb+consn+ determines that \verb+n+ can
+only match  values of the form  $(S~v)$ where $v$ is the value matched by
+\verb+m+. 
+
+
+The converse is also true. If
+we destructure the  length  value with the pattern \verb+O+ then the list
+value should be $niln$. 
+Thus, the following term \verb+length3+ corresponds to the function
+\verb+length+ but this time defined by case analysis on the dependencies instead of on the list:
+
+\begin{coq_example}
+Definition length3 (n:nat) (l:listn n) :=
+  match l with
+  | niln => 0%N
+  | consn O _ _ => 1%N
+  | consn (S n) _ _ => S (S n)
+  end.
+\end{coq_example}
+
+When we have nested patterns of dependent types, the semantics of
+pattern matching becomes a little more difficult because
+the set of values that are matched by a sub-pattern may be conditioned by the
+values matched by another sub-pattern. Dependent nested patterns are
+somehow constrained patterns. 
+In the examples, the expansion of
+\verb+length1+ and \verb+length2+ yields exactly the same term
+ but the
+expansion of \verb+length3+ is completely different. \verb+length1+ and
+\verb+length2+ are expanded into two nested case analysis on
+\verb+listn+ while \verb+length3+ is expanded into a case analysis on
+\verb+listn+ containing a case analysis on natural numbers inside.
+
+
+In practice the user can think about the patterns as independent and
+it is the expansion algorithm that cares to relate them. \\
+
+
+\subsubsection{When the elimination predicate must be provided}
+The examples  given so far do not need an explicit elimination predicate
+between \verb+<>+ because all the rhs have the same type and the
+strategy succeeds to synthesize it.
+Unfortunately when dealing with dependent patterns it often happens
+that we need to write cases where the type of the rhs are 
+different  instances of the elimination  predicate.
+The function  \verb+concat+ for \verb+listn+
+is an example where the branches have different type
+and we need to provide the elimination predicate:
+
+\begin{coq_example}
+Fixpoint concat (n:nat) (l:listn n) (m:nat) (l':listn m) {struct l} :
+ listn (n + m) :=
+  match l in listn n return listn (n + m) with
+  | niln => l'
+  | consn n' a y => consn (n' + m) a (concat n' y m l')
+  end.
+\end{coq_example}
+
+Recall that a list of patterns is also a pattern. So, when
+we destructure several terms at the same time and the branches have
+different type  we need to provide
+the elimination predicate for this multiple pattern.
+
+For example, an equivalent definition for \verb+concat+ (even though with a useless extra pattern) would have
+been:
+
+\begin{coq_example}
+Reset concat.
+Fixpoint concat (n:nat) (l:listn n) (m:nat) (l':listn m) {struct l} :
+ listn (n + m) :=
+  match l in listn n, l' return listn (n + m) with
+  | niln, x => x
+  | consn n' a y, x => consn (n' + m) a (concat n' y m x)
+  end.
+\end{coq_example}
+
+Note that this time, the predicate \verb+[n,_:nat](listn (plus n m))+ is binary because we
+destructure both \verb+l+ and \verb+l'+ whose types have arity one.
+In general, if we destructure the terms $e_1\ldots e_n$
+the predicate will be of arity $m$ where $m$ is the sum of the
+number of dependencies of the type of $e_1, e_2,\ldots e_n$ (the $\lambda$-abstractions
+should correspond from left to right to each dependent argument of the
+type of $e_1\ldots e_n$).
+When the arity of the predicate (i.e. number of abstractions) is not
+correct Coq rises an error message. For example:
+
+\begin{coq_example}
+Fixpoint concat (n:nat) (l:listn n) (m:nat) (l':listn m) {struct l} :
+ listn (n + m) :=
+  match l, l' with
+  | niln, x => x
+  | consn n' a y, x => consn (n' + m) a (concat n' y m x)
+  end.
+\end{coq_example}
+
+
+\subsection{Using pattern matching to write proofs}
+In all the previous examples the  elimination predicate  does not depend on the object(s) matched. 
+The typical case where this is not possible is when we write a proof by
+induction or a function that yields an object of dependent type.
+
+For example, we can write 
+the function \verb+buildlist+ that given a natural number
+$n$ builds a list length $n$ containing zeros as follows:
+
+\begin{coq_example}
+Fixpoint buildlist (n:nat) : listn n :=
+  match n return listn n with
+  | O => niln
+  | S n => consn n 0 (buildlist n)
+  end.
+\end{coq_example}
+
+We can also use multiple patterns whenever the elimination predicate has
+the correct arity. 
+
+Consider the following definition of the predicate less-equal
+\verb+Le+:
+
+\begin{coq_example}
+Inductive Le : nat -> nat -> Prop :=
+  | LeO : forall n:nat, Le 0%N n
+  | LeS : forall n m:nat, Le n m -> Le (S n) (S m).
+\end{coq_example}
+
+We can use multiple patterns to write  the proof of the lemma
+ \verb+(n,m:nat) (Le n m)\/(Le m n)+:
+
+\begin{coq_example}
+Fixpoint dec (n m:nat) {struct n} : Le n m \/ Le m n :=
+  match n, m return Le n m \/ Le m n with
+  | O, x => or_introl (Le x 0) (LeO x)
+  | x, O => or_intror (Le x 0) (LeO x)
+  | S n as N, S m as M =>
+      match dec n m with
+      | or_introl h => or_introl (Le M N) (LeS n m h)
+      | or_intror h => or_intror (Le N M) (LeS m n h)
+      end
+  end.
+\end{coq_example}
+In the example of \verb+dec+ the elimination predicate is binary
+because we destructure two arguments of \verb+nat+ that is a
+non-dependent type. Note the first \verb+Cases+ is dependent while the
+second  is not.
+
+In general, consider the terms $e_1\ldots e_n$,
+where  the type of $e_i$ is an instance of a family type
+$[\vec{d_i}:\vec{D_i}]T_i$  ($1\leq i
+\leq n$). Then to  write \verb+<+${\cal P}$\verb+>Cases+  $e_1\ldots
+e_n$ \verb+of+ \ldots \verb+end+, the 
+elimination predicate ${\cal P}$ should be of the form:
+$[\vec{d_1}:\vec{D_1}][x_1:T_1]\ldots [\vec{d_n}:\vec{D_n}][x_n:T_n]Q.$
+
+
+
+
+\section{Extending the syntax of pattern}
+The primitive syntax for patterns considers only those patterns containing
+symbols of constructors and variables. Nevertheless, we
+may define our own syntax for  constructors and may be interested in
+using this syntax to write patterns. 
+Because not  any term is a pattern, the fact of extending the terms
+syntax does not imply the extension of pattern syntax. Thus,  
+the grammar of patterns should be explicitly extended whenever we
+want to use a particular syntax for a constructor.
+The grammar rules for the macro  \verb+Cases+ (and thus for patterns)
+are defined in the file \verb+Multcase.v+ in the directory
+\verb+src/syntax+. To extend the grammar of patterns 
+we need to extend the non-terminals corresponding to patterns
+(we refer the reader to chapter of grammar extensions).
+
+ 
+We have already extended the pattern syntax so as to note
+the constructor \verb+pair+ of cartesian product  with "( , )" in patterns. 
+This allows for example, to write the first projection
+of pairs as follows:
+\begin{coq_example}
+Definition fst (A B:Set) (H:A * B) := match H with
+                                      | pair x y => x
+                                      end.
+\end{coq_example}
+The grammar presented in figure \ref{grammar} actually
+contains this extension. 
+
+\section{When does the expansion strategy fail?}\label{limitations}
+The strategy works very like in ML languages when treating
+patterns of non-dependent type.  
+But there are new cases of failure that are due to the presence of 
+dependencies. 
+
+The error messages of the current implementation may be
+sometimes confusing.
+When the tactic fails because patterns are somehow incorrect  then 
+error messages refer to the initial expression. But the strategy
+may succeed to build an expression whose sub-expressions are well typed but
+the whole expression is not. In this situation  the message makes 
+reference to the expanded expression.
+We encourage users, when they have patterns with the same outer constructor in different equations, to name the variable patterns in the same positions with the same name.
+E.g. to write {\small\verb+(cons n O x) => e1+} and  {\small\verb+(cons n \_ x) => e2+} instead of
+{\small\verb+(cons n O x) => e1+} and  {\small\verb+(cons n' \_ x') => e2+}. This helps to maintain certain name correspondence  between the generated expression and the original.
+
+
+Here is a summary of the error messages corresponding to each situation:
+\begin{itemize}
+\item  patterns are incorrect (because constructors are not
+applied to the correct number of the arguments, because they  are not linear or they are
+wrongly typed)
+\begin{itemize}
+\item \sverb{In pattern } {\sl term} \sverb{the constructor } {\sl ident}
+\sverb{expects } {\sl num} \sverb{arguments}
+
+\item \sverb{The variable } {\sl ident} \sverb{is bound several times in pattern } {\sl term}
+
+\item \sverb{Constructor pattern: } {\sl term}  \sverb{cannot match values of type } {\sl term}
+\end{itemize}
+
+\item the pattern matching is not exhaustive
+\begin{itemize}
+\item \sverb{This pattern-matching is not exhaustive} 
+\end{itemize}
+\item the elimination predicate provided to \verb+Cases+  has not the expected arity
+
+\begin{itemize}
+\item \sverb{The elimination predicate } {\sl term} \sverb{should be
+of arity } {\sl num} \sverb{(for non dependent case) or }  {\sl num} \sverb{(for dependent case)}
+\end{itemize}
+
+ \item  the whole expression is wrongly typed, or the synthesis of implicit arguments fails (for example to find
+the elimination predicate or to resolve implicit arguments in the rhs).
+
+
+There are {\em nested patterns  of dependent type}, the
+elimination predicate corresponds to non-dependent case and has the  form $[x_1:T_1]...[x_n:T_n]T$
+and {\bf some} $x_i$ occurs {\bf free} in
+$T$.  Then, the  strategy may fail to find out a correct elimination
+predicate during some step of compilation.
+In this situation we recommend the user to rewrite the nested
+dependent patterns into several \verb+Cases+ with  {\em simple patterns}.
+
+In all these cases we have the following error message:
+
+  \begin{itemize}
+  \item 
+  {\tt Expansion strategy failed to build a well typed case expression.
+  There is a branch that mismatches the expected type.
+  The risen type error on the result of expansion was:}
+  \end{itemize}
+
+\item because of nested patterns, it may happen that even  though all
+the rhs have  the same type, the strategy needs
+dependent elimination and so an elimination predicate must be
+provided. The system
+warns about this situation, trying to compile anyway with the
+non-dependent strategy. The risen message is:
+\begin{itemize}
+\item {\tt Warning: This pattern matching may need dependent elimination to be compiled.
+I will try, but if fails try again giving dependent elimination predicate.}
+\end{itemize}
+
+\item there are {\em nested patterns of dependent type} and the strategy
+builds a term that is well typed but recursive
+calls in fix point are reported as illegal:
+\begin{itemize}
+\item {\tt Error: Recursive call applied to an illegal term ...}
+\end{itemize}
+
+This is because the strategy generates a term that is correct
+w.r.t. to the initial term but which does  not pass the guard condition.
+In this situation we recommend the user to transform the nested  dependent
+patterns into {\em several \verb+Cases+ of simple patterns}.
+Let us explain this with an example.
+Consider the following defintion of a function that yields the last
+element of a list and \verb+O+ if it is empty:
+
+\begin{coq_example}
+Fixpoint last (n:nat) (l:listn n) {struct l} : nat :=
+  match l with
+  | consn _ a niln => a
+  | consn m _ x => last m x
+  | niln => 0%N
+  end.
+\end{coq_example}
+
+It fails because of the priority between patterns, we know that this
+definition is equivalent to the following more explicit one (which
+fails too):
+
+\begin{coq_example*}
+Fixpoint last (n:nat) (l:listn n) {struct l} : nat :=
+  match l with
+  | consn _ a niln => a
+  | consn n _ (consn m b x) => last n (consn m b x)
+  | niln => 0%N
+  end.
+\end{coq_example*}
+
+Note that the recursive call  \sverb{(last n (consn m b x)) } is not
+guarded. When treating with patterns of dependent types the strategy
+interprets the first definition of \texttt{last} as the second
+onefootnote{In languages of the ML family
+the first definition would be translated into a term where the
+variable \texttt{x} is shared in the expression.  When
+patterns are of non-dependent types, Coq compiles as in ML languages
+using sharing. When patterns are of dependent types the compilation
+reconstructs the term as in the second definition of \texttt{last} so to
+ensure the result of expansion is well typed.}.
+Thus it generates a
+term where the recursive call is rejected by the 
+guard condition.
+
+You can get rid of this problem by writing the definition with \emph{simple
+patterns}:
+
+\begin{coq_example}
+Fixpoint last (n:nat) (l:listn n) {struct l} : nat :=
+  match l return nat with
+  | consn m a x => match x with
+                   | niln => a
+                   | _ => last m x
+                   end
+  | niln => 0%N
+  end.
+\end{coq_example}
+
+
+\end{itemize}
+
+%\end{document}
+
diff --git a/doc/refman/RefMan-cic.tex b/doc/refman/RefMan-cic.tex
new file mode 100644
index 00000000..18b6ed9c
--- /dev/null
+++ b/doc/refman/RefMan-cic.tex
@@ -0,0 +1,1480 @@
+\chapter{Calculus of Inductive Constructions}
+\label{Cic}
+\index{Cic@\textsc{CIC}}
+\index{pCic@p\textsc{CIC}}
+\index{Calculus of (Co)Inductive Constructions}
+
+The underlying formal language of {\Coq} is a {\em Calculus of
+  Constructions} with {\em Inductive Definitions}.  It is presented in
+this chapter.  
+For {\Coq} version V7, this Calculus was known as the
+{\em Calculus of (Co)Inductive Constructions}\index{Calculus of
+  (Co)Inductive Constructions} (\iCIC\ in short).
+The underlying calculus of {\Coq} version V8.0 and up is a weaker
+  calculus where the sort \Set{} satisfies predicative rules. 
+We call this calculus the 
+{\em Predicative Calculus of (Co)Inductive
+  Constructions}\index{Predicative Calculus of
+  (Co)Inductive Constructions} (\pCIC\ in short).
+In section~\ref{impredicativity} we give the extra-rules for \iCIC. A
+  compiling option of \Coq{} allows to type-check theories in this
+  extended system.
+
+In \CIC\, all objects have a {\em type}. There are types for functions (or
+programs), there are atomic types (especially datatypes)... but also
+types for proofs and types for the types themselves.
+Especially, any object handled in the formalism must belong to a
+type.  For instance, the statement {\it ``for all x, P''} is not
+allowed in type theory; you must say instead: {\it ``for all x
+belonging to T, P''}. The expression {\it ``x belonging to T''} is
+written {\it ``x:T''}. One also says: {\it ``x has type T''}.
+The terms of {\CIC} are detailed in section \ref{Terms}.
+
+In \CIC\, there is an internal reduction mechanism. In particular, it
+allows to decide if two programs are {\em intentionally} equal (one
+says {\em convertible}). Convertibility is presented in section 
+\ref{convertibility}.
+
+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
+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.
+Barras~\cite{Bar99}, Werner~\cite{Wer94} and
+Paulin-Mohring~\cite{Moh97} are the most recent theses dealing with
+Inductive Definitions. Coquand-Huet~\cite{CoHu85a,CoHu85b,CoHu86}
+introduces the Calculus of Constructions. Coquand-Paulin~\cite{CoPa89}
+extended this calculus to inductive definitions. The {\CIC} is a
+formulation of type theory including the possibility of inductive
+constructions, Barendregt~\cite{Bar91} studies the modern form of type
+theory.
+
+\section{The terms}\label{Terms}
+
+In most type theories, one usually makes a syntactic distinction
+between types and terms. This is not the case for \CIC\ which defines
+both types and terms in the same syntactical structure. This is
+because the type-theory itself forces terms and types to be defined in
+a mutual recursive way and also because similar constructions can be
+applied to both terms and types and consequently can share the same
+syntactic structure.
+
+Consider for instance the $\ra$ constructor and assume \nat\ is the
+type of natural numbers. Then $\ra$ is used both to denote
+$\nat\ra\nat$ which is the type of functions from \nat\ to \nat, and
+to denote $\nat \ra \Prop$ which is the type of unary predicates over
+the natural numbers. Consider abstraction which builds functions. It
+serves to build ``ordinary'' functions as $\kw{fun}~x:\nat \Ra ({\tt mult} ~x~x)$ (assuming {\tt mult} is already defined) but may build also 
+predicates over the natural numbers. For instance $\kw{fun}~x:\nat \Ra
+(x=x)$ will
+represent a predicate $P$, informally written in mathematics
+$P(x)\equiv x=x$. If $P$ has type $\nat \ra \Prop$, $(P~x)$ is a
+proposition, furthermore $\kw{forall}~x:\nat,(P~x)$ will represent the type of
+functions which associate to each natural number $n$ an object of
+type $(P~n)$ and consequently represent proofs of the formula
+``$\forall x.P(x)$''.
+
+\subsection{Sorts}\label{Sorts}
+\index{Sorts}
+Types are seen as terms of the language and then should belong to
+another type. The type of a type is always a constant of the language
+called a {\em sort}.
+
+The two basic sorts in the language of \CIC\ are \Set\ and \Prop.
+
+The sort \Prop\ intends to be the type of logical propositions.  If
+$M$ is a logical proposition then it denotes a class, namely the class
+of terms representing proofs of $M$. An object $m$ belonging to $M$
+witnesses the fact that $M$ is true.  An object of type \Prop\ is
+called a {\em proposition}.
+
+The sort \Set\ intends to be the type of specifications. This includes
+programs and the usual sets such as booleans, naturals, lists
+etc.
+
+These sorts themselves can be manipulated as ordinary terms.
+Consequently sorts also should be given a type.  Because assuming
+simply that \Set\ has type \Set\ leads to an inconsistent theory, we
+have infinitely many sorts in the language of \CIC. These are, in
+addition to \Set\ and \Prop\, a hierarchy of universes \Type$(i)$
+for any integer $i$.  We call \Sort\ the set of sorts
+which is defined by:
+\[\Sort \equiv \{\Prop,\Set,\Type(i)| i \in \NN\} \]
+\index{Type@{\Type}}
+\index{Prop@{\Prop}}
+\index{Set@{\Set}}
+The sorts enjoy the following properties: {\Prop:\Type(0)}, {\Set:\Type(0)} and
+  {\Type$(i)$:\Type$(i+1)$}.
+
+The user will never mention explicitly the index $i$ when referring to
+the universe \Type$(i)$. One only writes \Type. The
+system itself generates for each instance of \Type\ a new
+index for the universe and checks that the constraints between these
+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.
+
+\subsection{Constants}
+Besides the sorts, the language also contains constants denoting
+objects in the environment. These constants may denote previously
+defined objects but also objects related to inductive definitions
+(either the type itself or one of its constructors or destructors).
+
+\medskip\noindent {\bf Remark. } In other presentations of \CIC, 
+the inductive objects are not seen as
+external declarations but as first-class terms. Usually the
+definitions are also completely ignored.  This is a nice theoretical
+point of view but not so practical. An inductive definition is
+specified by a possibly huge set of declarations, clearly we want to
+share this specification among the various inductive objects and not
+to duplicate it. So the specification should exist somewhere and the
+various objects should refer to it.  We choose one more level of
+indirection where the objects are just represented as constants and
+the environment gives the information on the kind of object the
+constant refers to.
+
+\medskip
+Our inductive objects will be manipulated as constants declared in the
+environment. This roughly corresponds to the way they are actually
+implemented in the \Coq\ system. It is simple to map this presentation
+in a theory where inductive objects are represented by terms.
+
+\subsection{Terms}
+
+Terms are built from variables, global names, constructors,
+abstraction, application, local declarations bindings (``let-in''
+expressions) and product.
+
+From a syntactic point of view, types cannot be distinguished from terms,
+except that they cannot start by an abstraction, and that if a term is
+a sort or a product, it should be a type.
+
+More precisely the language of the {\em Calculus of Inductive
+  Constructions} is built from the following rules:
+
+\begin{enumerate}
+\item the sorts {\sf Set, Prop, Type} are terms.
+\item names for global constants of the environment are terms.
+\item variables are terms.
+\item if $x$ is a variable and $T$, $U$ are terms then $\forall~x:T,U$
+  ($\kw{forall}~x:T,U$ in \Coq{} concrete syntax) is a term. If $x$
+  occurs in $U$, $\forall~x:T,U$ reads as {\it ``for all x of type T,
+    U''}. As $U$ depends on $x$, one says that $\forall~x:T,U$ is a
+  {\em dependent product}. If $x$ doesn't occurs in $U$ then
+  $\forall~x:T,U$ reads as {\it ``if T then U''}. A non dependent
+  product can be written: $T \rightarrow U$.
+\item if $x$ is a variable and $T$, $U$ are terms then $\lb~x:T \mto U$
+  ($\kw{fun}~x:T\Ra U$ in \Coq{} concrete syntax) is a term. This is a
+  notation for the $\lambda$-abstraction of
+  $\lambda$-calculus\index{lambda-calculus@$\lambda$-calculus}
+  \cite{Bar81}. The term $\lb~x:T \mto U$ is a function which maps
+  elements of $T$ to $U$.
+\item if $T$ and $U$ are terms then $(T\ U)$ is a term  
+ ($T~U$ in \Coq{} concrete syntax).  The term $(T\ 
+  U)$ reads as {\it ``T applied to U''}.
+\item if $x$ is a variable, and $T$, $U$ are terms then
+  $\kw{let}~x:=T~\kw{in}~U$ is a
+  term which denotes the term $U$ where the variable $x$ is locally
+  bound to $T$. This stands for the common ``let-in'' construction of
+  functional programs such as ML or Scheme.
+\end{enumerate}
+
+\paragraph{Notations.} Application associates to the left such that
+$(t~t_1\ldots t_n)$ represents $(\ldots (t~t_1)\ldots t_n)$. The
+products and arrows associate to the right such that $\forall~x:A,B\ra C\ra
+D$ represents $\forall~x:A,(B\ra (C\ra D))$.  One uses sometimes
+$\forall~x~y:A,B$ or
+$\lb~x~y:A\mto B$ to denote the abstraction or product of several variables
+of the same type. The equivalent formulation is $\forall~x:A, \forall y:A,B$ or
+$\lb~x:A \mto \lb y:A \mto B$
+
+\paragraph{Free variables.}
+The notion of free variables is defined as usual.  In the expressions
+$\lb~x:T\mto U$ and $\forall x:T, U$ the occurrences of $x$ in $U$
+are bound.  They are represented by de Bruijn indexes in the internal
+structure of terms.
+
+\paragraph{Substitution.} \index{Substitution}
+The notion of substituting a term $t$ to free occurrences of a
+variable $x$ in a term $u$ is defined as usual. The resulting term
+is written $\subst{u}{x}{t}$.
+
+
+\section{Typed terms}\label{Typed-terms}
+
+As objects of type theory, terms are subjected to {\em type
+discipline}. The well typing of a term depends on an environment which
+consists in a global environment (see below) and a local context.
+
+\paragraph{Local context.}
+A {\em local context} (or shortly context) is an ordered list of
+declarations of variables. The declaration of some variable $x$ is
+either an assumption, written $x:T$ ($T$ is a type) or a definition,
+written $x:=t:T$.  We use brackets to write contexts. A
+typical example is $[x:T;y:=u:U;z:V]$.  Notice that the variables
+declared in a context must be distinct. If $\Gamma$ declares some $x$,
+we write $x \in\Gamma$. By writing $(x:T)\in\Gamma$ we mean that
+either $x:T$ is an assumption in $\Gamma$ or that there exists some $t$ such
+that $x:=t:T$ is a definition in $\Gamma$. If $\Gamma$ defines some
+$x:=t:T$, we also write $(x:=t:T)\in\Gamma$.  Contexts must be
+themselves {\em well formed}.  For the rest of the chapter, the
+notation $\Gamma::(y:T)$ (resp $\Gamma::(y:=t:T)$) denotes the context
+$\Gamma$ enriched with the declaration $y:T$ (resp $y:=t:T$). The
+notation $[]$ denotes the empty context.  \index{Context}
+
+% Does not seem to be used further...
+% Si dans l'explication WF(E)[Gamma] concernant les constantes
+% definies ds un contexte
+
+We define the inclusion of two contexts $\Gamma$ and $\Delta$ (written
+as $\Gamma \subset \Delta$) as the property, for all variable $x$,
+type $T$ and term $t$, if $(x:T) \in \Gamma$ then $(x:T)\in \Delta$
+and if $(x:=t:T) \in \Gamma$ then $(x:=t:T)\in \Delta$.  
+%We write
+% $|\Delta|$ for the length of the context $\Delta$, that is for the number
+% of declarations (assumptions or definitions) in $\Delta$.
+
+A variable $x$ is said to be free in $\Gamma$ if $\Gamma$ contains a
+declaration $y:T$ such that $x$ is free in $T$.
+
+\paragraph{Environment.}\index{Environment}
+Because we are manipulating global declarations (constants and global
+assumptions), we also need to consider a global environment $E$.
+
+An environment is an ordered list of declarations of global
+names. Declarations are either assumptions or ``standard''
+definitions, that is abbreviations for well-formed terms
+but also definitions of inductive objects. In the latter
+case, an object in the environment will define one or more constants
+(that is types and constructors, see section \ref{Cic-inductive-definitions}).
+
+An assumption will be represented in the environment as
+\Assum{\Gamma}{c}{T} which means that $c$ is assumed of some type $T$
+well-defined in some context $\Gamma$. An (ordinary) definition will
+be represented in the environment as \Def{\Gamma}{c}{t}{T} which means
+that $c$ is a constant which is valid in some context $\Gamma$ whose
+value is $t$ and type is $T$.
+
+The rules for inductive definitions (see section
+\ref{Cic-inductive-definitions}) have to be considered as assumption
+rules to which the following definitions apply: if the name $c$ is
+declared in $E$, we write $c \in E$ and if $c:T$ or $c:=t:T$ is
+declared in $E$, we write $(c : T) \in E$.
+
+\paragraph{Typing rules.}\label{Typing-rules}\index{Typing rules}
+In the following, we assume $E$ is a valid environment wrt to
+inductive definitions.  We define simultaneously two
+judgments.  The first one \WTEG{t}{T} means the term $t$ is well-typed
+and has type $T$ in the environment $E$ and context $\Gamma$.  The
+second judgment \WFE{\Gamma} means that the environment $E$ is
+well-formed and the context $\Gamma$ is a valid context in this
+environment.  It also means a third property which makes sure that any
+constant in $E$ was defined in an environment which is included in
+$\Gamma$
+\footnote{This requirement could be relaxed if we instead introduced
+  an explicit mechanism for instantiating constants. At the external
+  level, the Coq engine works accordingly to this view that all the
+  definitions in the environment were built in a sub-context of the
+  current context.}.
+
+A term $t$ is well typed in an environment $E$ iff there exists a
+context $\Gamma$ and a term $T$ such that the judgment \WTEG{t}{T} can
+be derived from the following rules.
+\begin{description}
+\item[W-E] \inference{\WF{[]}{[]}}
+\item[W-S]  % Ce n'est pas vrai : x peut apparaitre plusieurs fois dans Gamma
+\inference{\frac{\WTEG{T}{s}~~~~s\in \Sort~~~~x \not\in
+      \Gamma           % \cup E
+      }
+      {\WFE{\Gamma::(x:T)}}~~~~~
+    \frac{\WTEG{t}{T}~~~~x \not\in
+      \Gamma           % \cup E
+     }{\WFE{\Gamma::(x:=t:T)}}}
+\item[Def] \inference{\frac{\WTEG{t}{T}~~~c \notin E\cup \Gamma}
+                      {\WF{E;\Def{\Gamma}{c}{t}{T}}{\Gamma}}}
+\item[Ax] \index{Typing rules!Ax}
+\inference{\frac{\WFE{\Gamma}}{\WTEG{\Prop}{\Type(p)}}~~~~~
+\frac{\WFE{\Gamma}}{\WTEG{\Set}{\Type(q)}}}
+\inference{\frac{\WFE{\Gamma}~~~~i<j}{\WTEG{\Type(i)}{\Type(j)}}}
+\item[Var]\index{Typing rules!Var}
+ \inference{\frac{ \WFE{\Gamma}~~~~~(x:T)\in\Gamma~~\mbox{or}~~(x:=t:T)\in\Gamma~\mbox{for some $t$}}{\WTEG{x}{T}}}
+\item[Const]  \index{Typing rules!Const}
+\inference{\frac{\WFE{\Gamma}~~~~(c:T) \in E}{\WTEG{c}{T}}}
+\item[Prod]  \index{Typing rules!Prod}
+\inference{\frac{\WTEG{T}{s}~~~~s \in \Sort~~~
+    \WTE{\Gamma::(x:T)}{U}{\Prop}}
+      { \WTEG{\forall~x:T,U}{\Prop}}} 
+\inference{\frac{\WTEG{T}{s}~~~~s\in\{\Prop, \Set\}~~~~~~
+    \WTE{\Gamma::(x:T)}{U}{\Set}}
+      { \WTEG{\forall~x:T,U}{\Set}}} 
+\inference{\frac{\WTEG{T}{\Type(i)}~~~~i\leq k~~~
+    \WTE{\Gamma::(x:T)}{U}{\Type(j)}~~~j \leq k}
+    {\WTEG{\forall~x:T,U}{\Type(k)}}}
+\item[Lam]\index{Typing rules!Lam} 
+\inference{\frac{\WTEG{\forall~x:T,U}{s}~~~~ \WTE{\Gamma::(x:T)}{t}{U}}
+        {\WTEG{\lb~x:T\mto t}{\forall x:T, U}}}
+\item[App]\index{Typing rules!App}
+ \inference{\frac{\WTEG{t}{\forall~x:U,T}~~~~\WTEG{u}{U}}
+                 {\WTEG{(t\ u)}{\subst{T}{x}{u}}}}
+\item[Let]\index{Typing rules!Let} 
+\inference{\frac{\WTEG{t}{T}~~~~ \WTE{\Gamma::(x:=t:T)}{u}{U}}
+        {\WTEG{\kw{let}~x:=t~\kw{in}~u}{\subst{U}{x}{t}}}}
+\end{description}
+    
+\Rem We may have $\kw{let}~x:=t~\kw{in}~u$
+well-typed without having $((\lb~x:T\mto u)~t)$ well-typed (where
+$T$ is a type of $t$). This is because the value $t$ associated to $x$
+may be used in a conversion rule (see section \ref{conv-rules}).
+
+\section{Conversion rules}
+\index{Conversion rules}
+\label{conv-rules}
+\paragraph{$\beta$-reduction.}
+\label{beta}\index{beta-reduction@$\beta$-reduction}
+
+We want to be able to identify some terms as we can identify the
+application of a function to a given argument with its result. For
+instance the identity function over a given type $T$ can be written
+$\lb~x:T\mto x$. In any environment $E$ and context $\Gamma$, we want to identify any object $a$ (of type $T$) with the
+application $((\lb~x:T\mto x)~a)$. We define for this a {\em reduction} (or a
+{\em conversion}) rule we call $\beta$:
+\[ \WTEGRED{((\lb~x:T\mto
+  t)~u)}{\triangleright_{\beta}}{\subst{t}{x}{u}} \] 
+We say that $\subst{t}{x}{u}$ is the {\em $\beta$-contraction} of
+$((\lb~x:T\mto t)~u)$ and, conversely, that $((\lb~x:T\mto t)~u)$
+is the {\em $\beta$-expansion} of $\subst{t}{x}{u}$.
+
+According to $\beta$-reduction, terms of the {\em Calculus of
+  Inductive Constructions} enjoy some fundamental properties such as
+confluence, strong normalization, subject reduction. These results are
+theoretically of great importance but we will not detail them here and
+refer the interested reader to \cite{Coq85}.
+
+\paragraph{$\iota$-reduction.}
+\label{iota}\index{iota-reduction@$\iota$-reduction}
+A specific conversion rule is associated to the inductive objects in
+the environment.  We shall give later on (section \ref{iotared}) the
+precise rules but it just says that a destructor applied to an object
+built from a constructor behaves as expected.  This reduction is
+called $\iota$-reduction and is more precisely studied in
+\cite{Moh93,Wer94}.
+
+
+\paragraph{$\delta$-reduction.}
+\label{delta}\index{delta-reduction@$\delta$-reduction}
+
+We may have defined variables in contexts or constants in the global
+environment. It is legal to identify such a reference with its value,
+that is to expand (or unfold) it into its value. This
+reduction is called $\delta$-reduction and shows as follows.
+
+$$\WTEGRED{x}{\triangleright_{\delta}}{t}~~~~~\mbox{if $(x:=t:T)\in\Gamma$}~~~~~~~~~\WTEGRED{c}{\triangleright_{\delta}}{t}~~~~~\mbox{if $(c:=t:T)\in E$}$$
+
+
+\paragraph{$\zeta$-reduction.}
+\label{zeta}\index{zeta-reduction@$\zeta$-reduction}
+
+Coq allows also to remove local definitions occurring in terms by
+replacing the defined variable by its value. The declaration being
+destroyed, this reduction differs from $\delta$-reduction. It is
+called $\zeta$-reduction and shows as follows.
+
+$$\WTEGRED{\kw{let}~x:=u~\kw{in}~t}{\triangleright_{\zeta}}{\subst{t}{x}{u}}$$
+
+\paragraph{Convertibility.}
+\label{convertibility}
+\index{beta-reduction@$\beta$-reduction}\index{iota-reduction@$\iota$-reduction}\index{delta-reduction@$\delta$-reduction}\index{zeta-reduction@$\zeta$-reduction}
+
+Let us write $\WTEGRED{t}{\triangleright}{u}$ for the contextual closure of the relation $t$ reduces to $u$ in the environment $E$ and context $\Gamma$ with one of the previous reduction $\beta$, $\iota$, $\delta$ or $\zeta$.
+
+We say that two terms $t_1$ and $t_2$ are {\em convertible} (or {\em
+  equivalent)} in the environment $E$ and context $\Gamma$ iff there exists a term $u$ such that $\WTEGRED{t_1}{\triangleright \ldots \triangleright}{u}$
+and $\WTEGRED{t_2}{\triangleright \ldots \triangleright}{u}$.
+We then write $\WTEGCONV{t_1}{t_2}$.
+
+The convertibility relation allows to introduce a new typing rule
+which says that two convertible well-formed types have the same
+inhabitants.
+
+At the moment, we did not take into account one rule between universes
+which says that any term in a universe of index $i$ is also a term in
+the universe of index $i+1$. This property is included into the
+conversion rule by extending the equivalence relation of
+convertibility into an order inductively defined by:
+\begin{enumerate}
+\item if $\WTEGCONV{t}{u}$ then $\WTEGLECONV{t}{u}$,
+\item if $i \leq j$ then $\WTEGLECONV{\Type(i)}{\Type(j)}$,
+\item for any $i$, $\WTEGLECONV{\Prop}{\Type(i)}$,
+\item for any $i$, $\WTEGLECONV{\Set}{\Type(i)}$,
+\item if $\WTEGCONV{T}{U}$ and $\WTELECONV{\Gamma::(x:T)}{T'}{U'}$ then $\WTEGLECONV{\forall~x:T,T'}{\forall~x:U,U'}$.
+\end{enumerate}
+
+The conversion rule is now exactly:
+
+\begin{description}\label{Conv}
+\item[Conv]\index{Typing rules!Conv}
+ \inference{
+      \frac{\WTEG{U}{s}~~~~\WTEG{t}{T}~~~~\WTEGLECONV{T}{U}}{\WTEG{t}{U}}}
+  \end{description}
+
+
+\paragraph{$\eta$-conversion.
+\label{eta}
+\index{eta-conversion@$\eta$-conversion}
+\index{eta-reduction@$\eta$-reduction}}
+
+An other important rule is the $\eta$-conversion. It is to identify
+terms over a dummy abstraction of a variable followed by an
+application of this variable. Let $T$ be a type, $t$ be a term in
+which the variable $x$ doesn't occurs free. We have
+\[ \WTEGRED{\lb~x:T\mto (t\ x)}{\triangleright}{t} \]
+Indeed, as $x$ doesn't occur free in $t$, for any $u$ one
+applies to $\lb~x:T\mto (t\ x)$, it $\beta$-reduces to $(t\ u)$. So
+$\lb~x:T\mto (t\ x)$ and $t$ can be identified.
+
+\Rem The $\eta$-reduction is not taken into account in the
+convertibility rule of \Coq.
+
+\paragraph{Normal form.}\index{Normal form}\label{Normal-form}\label{Head-normal-form}\index{Head normal form}
+A term which cannot be any more reduced is said to be in {\em normal
+  form}. There are several ways (or strategies) to apply the reduction
+rule. Among them, we have to mention the {\em head reduction} which
+will play an important role (see chapter \ref{Tactics}). Any term can
+be written as $\lb~x_1:T_1\mto \ldots \lb x_k:T_k \mto 
+(t_0\ t_1\ldots t_n)$ where
+$t_0$ is not an application. We say then that $t_0$ is the {\em head
+  of $t$}. If we assume that $t_0$ is $\lb~x:T\mto u_0$ then one step of
+$\beta$-head reduction of $t$ is:
+\[\lb~x_1:T_1\mto \ldots \lb x_k:T_k\mto (\lb~x:T\mto u_0\ t_1\ldots t_n) 
+~\triangleright ~ \lb~(x_1:T_1)\ldots(x_k:T_k)\mto 
+(\subst{u_0}{x}{t_1}\ t_2 \ldots t_n)\]
+Iterating the process of head reduction until the head of the reduced
+term is no more an abstraction leads to the {\em $\beta$-head normal
+  form} of $t$:
+\[ t \triangleright \ldots \triangleright
+\lb~x_1:T_1\mto \ldots\lb x_k:T_k\mto (v\ u_1
+\ldots u_m)\]
+where $v$ is not an abstraction (nor an application).  Note that the
+head normal form must not be confused with the normal form since some
+$u_i$ can be reducible.
+
+Similar notions of head-normal forms involving $\delta$, $\iota$ and $\zeta$
+reductions or any combination of those can also be defined.
+
+\section{Derived rules for environments}
+
+From the original rules of the type system, one can derive new rules
+which change the context of definition of objects in the environment.
+Because these rules correspond to elementary operations in the \Coq\ 
+engine used in the discharge mechanism at the end of a section, we
+state them explicitly.
+
+\paragraph{Mechanism of substitution.}
+
+One rule which can be proved valid, is to replace a term $c$ by its
+value in the environment. As we defined the substitution of a term for
+a variable in a term, one can define the substitution of a term for a
+constant. One easily extends this substitution to contexts and
+environments.
+
+\paragraph{Substitution Property:} 
+\inference{\frac{\WF{E;\Def{\Gamma}{c}{t}{T}; F}{\Delta}}
+           {\WF{E; \subst{F}{c}{t}}{\subst{\Delta}{c}{t}}}}
+
+
+\paragraph{Abstraction.}
+
+One can modify the context of definition of a constant $c$ by
+abstracting a constant with respect to the last variable $x$ of its
+defining context. For doing that, we need to check that the constants
+appearing in the body of the declaration do not depend on $x$, we need
+also to modify the reference to the constant $c$ in the environment
+and context by explicitly applying this constant to the variable $x$.
+Because of the rules for building environments and terms we know the
+variable $x$ is available at each stage where $c$ is mentioned.
+
+\paragraph{Abstracting property:} 
+ \inference{\frac{\WF{E; \Def{\Gamma::(x:U)}{c}{t}{T};
+       F}{\Delta}~~~~\WFE{\Gamma}}
+           {\WF{E;\Def{\Gamma}{c}{\lb~x:U\mto t}{\forall~x:U,T};
+  \subst{F}{c}{(c~x)}}{\subst{\Delta}{c}{(c~x)}}}}
+
+\paragraph{Pruning the context.} 
+We said the judgment \WFE{\Gamma} means that the defining contexts of
+constants in $E$ are included in $\Gamma$. If one abstracts or
+substitutes the constants with the above rules then it may happen
+that the context $\Gamma$ is now bigger than the one needed for
+defining the constants in $E$. Because defining contexts are growing
+in $E$, the minimum context needed for defining the constants in $E$
+is the same as the one for the last constant. One can consequently
+derive the following property.
+
+\paragraph{Pruning property:}
+\inference{\frac{\WF{E; \Def{\Delta}{c}{t}{T}}{\Gamma}}
+                {\WF{E;\Def{\Delta}{c}{t}{T}}{\Delta}}}
+
+
+\section{Inductive Definitions}\label{Cic-inductive-definitions}
+
+A (possibly mutual) inductive definition is specified by giving the
+names and the type of the inductive sets or families to be
+defined and the names and types of the constructors of the inductive
+predicates.  An inductive declaration in the environment can
+consequently be represented with two contexts (one for inductive
+definitions, one for constructors).
+
+Stating the rules for inductive definitions in their general form
+needs quite tedious definitions. We shall try to give a concrete
+understanding of the rules by precising them on running examples.  We
+take as examples the type of natural numbers, the type of
+parameterized lists over a type $A$, the relation which states that
+a list has some given length and the mutual inductive definition of trees and
+forests. 
+
+\subsection{Representing an inductive definition}
+\subsubsection{Inductive definitions without parameters}
+As for constants, inductive definitions can be defined in a non-empty
+context. \\
+We write \NInd{\Gamma}{\Gamma_I}{\Gamma_C} an inductive
+definition valid in a context $\Gamma$, a
+context of definitions $\Gamma_I$ and a context of constructors
+$\Gamma_C$.
+\paragraph{Examples.}
+The inductive declaration for the type of natural numbers will be:
+\[\NInd{}{\nat:\Set}{\nO:\nat,\nS:\nat\ra\nat}\]
+In a context with a variable $A:\Set$, the lists of elements in $A$ is
+represented by:
+\[\NInd{A:\Set}{\List:\Set}{\Nil:\List,\cons : A \ra \List \ra
+  \List}\]
+ Assuming 
+  $\Gamma_I$ is $[I_1:A_1;\ldots;I_k:A_k]$, and $\Gamma_C$ is
+  $[c_1:C_1;\ldots;c_n:C_n]$, the general typing rules are:
+
+\bigskip
+\inference{\frac{\NInd{\Gamma}{\Gamma_I}{\Gamma_C} \in E
+    ~~j=1\ldots k}{(I_j:A_j) \in E}}
+
+\inference{\frac{\NInd{\Gamma}{\Gamma_I}{\Gamma_C} \in E
+    ~~~~i=1.. n}
+   {(c_i:C_i)\in E}}
+
+\subsubsection{Inductive definitions with parameters}
+
+We have to slightly complicate the representation above in order to handle
+the delicate problem of parameters. 
+Let us explain that on the example of \List. As they were defined
+above, the type \List\ can only be used in an environment where we
+have a variable $A:\Set$. Generally one want to consider lists of
+elements in different types. For constants this is easily done by abstracting
+the value over the parameter. In the case of inductive definitions we
+have to handle the abstraction over several objects.
+
+One possible way to do that would be to define the type \List\
+inductively as being an inductive family of type $\Set\ra\Set$:
+\[\NInd{}{\List:\Set\ra\Set}{\Nil:(A:\Set)(\List~A),\cons : (A:\Set)A
+  \ra (\List~A) \ra (\List~A)}\]
+There are drawbacks to this point of view. The
+information which says that $(\List~\nat)$ is an inductively defined
+\Set\ has been lost.
+%\footnote{
+%The interested reader may look at the compare the above definition with the two 
+%following ones which have very different logical meaning:\\
+%$\NInd{}{\List:\Set}{\Nil:\List,\cons : (A:\Set)A
+%  \ra \List \ra \List}$ \\
+%$\NInd{}{\List:\Set\ra\Set}{\Nil:(A:\Set)(\List~A),\cons : (A:\Set)A
+%  \ra (\List~A\ra A) \ra (\List~A)}$.}
+
+In the system, we keep track in the syntax of the context of
+parameters. The idea of these parameters is that they can be
+instantiated and still we have an inductive definition for which we
+know the specification.
+
+Formally the representation of an inductive declaration
+will be 
+\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} for an inductive
+definition valid in a context $\Gamma$ with parameters $\Gamma_P$, a
+context of definitions $\Gamma_I$ and a context of constructors
+$\Gamma_C$.
+The occurrences of the variables of $\Gamma_P$ in the contexts
+$\Gamma_I$ and $\Gamma_C$ are bound.
+
+The definition \Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} will be
+well-formed exactly when \NInd{\Gamma,\Gamma_P}{\Gamma_I}{\Gamma_C} is.
+If $\Gamma_P$ is $[p_1:P_1;\ldots;p_r:P_r]$, an object in 
+\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} applied to $q_1,\ldots,q_r$
+will behave as the corresponding object of 
+\NInd{\Gamma}{\substs{\Gamma_I}{p_i}{q_i}{i=1..r}}{\substs{\Gamma_C}{p_i}{q_i}{i=1..r}}.
+
+\paragraph{Examples}
+The declaration for parameterized lists is:
+\[\Ind{}{A:\Set}{\List:\Set}{\Nil:\List,\cons : A \ra \List \ra
+  \List}\]
+
+The declaration for the length of lists is:
+\[\Ind{}{A:\Set}{\Length:(\List~A)\ra \nat\ra\Prop}
+      {\LNil:(\Length~(\Nil~A)~\nO),\\ 
+     \LCons :\forall a:A, \forall l:(\List~A),\forall n:\nat, (\Length~l~n)\ra (\Length~(\cons~A~a~l)~(\nS~n))}\]
+
+The declaration for a mutual inductive definition of forests and trees is:
+\[\NInd{}{\tree:\Set,\forest:\Set}
+      {\\~~\node:\forest \ra \tree,
+       \emptyf:\forest,\consf:\tree \ra \forest \ra \forest\-}\]
+  
+These representations are the ones obtained as the result of the \Coq\ 
+declaration:
+\begin{coq_example*}
+Inductive nat : Set :=
+  | O : nat
+  | S : nat -> nat.
+Inductive list (A:Set) : Set :=
+  | nil : list A
+  | cons : A -> list A -> list A.
+\end{coq_example*}
+\begin{coq_example*}
+Inductive Length (A:Set) : list A -> nat -> Prop :=
+  | Lnil : Length A (nil A) O
+  | Lcons :
+      forall (a:A) (l:list A) (n:nat),
+        Length A l n -> Length A (cons A a l) (S n).
+Inductive tree : Set :=
+    node : forest -> tree
+with forest : Set :=
+  | emptyf : forest
+  | consf : tree -> forest -> forest.
+\end{coq_example*}
+The inductive declaration in \Coq\ is slightly different from the one
+we described theoretically. The difference is that in the type of
+constructors the inductive definition is explicitly applied to the
+parameters variables. The \Coq\ type-checker verifies that all
+parameters are applied in the correct manner in each recursive call.
+In particular, the following definition will not be accepted because 
+there is an occurrence of \List\ which is not applied to the parameter
+variable:
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is not correct and should produce **********)
+(********* Error: The 1st argument of list' must be A in ... *********)
+\end{coq_eval}
+\begin{coq_example}
+Inductive list' (A:Set) : Set :=
+  | nil' : list' A
+  | cons' : A -> list' (A -> A) -> list' A.
+\end{coq_example}
+
+\subsection{Types of inductive objects}
+We have to give the type of constants in an environment $E$ which
+contains an inductive declaration.
+
+\begin{description}
+\item[Ind-Const] Assuming $\Gamma_P$ is $[p_1:P_1;\ldots;p_r:P_r]$,
+  $\Gamma_I$ is $[I_1:A_1;\ldots;I_k:A_k]$, and $\Gamma_C$ is
+  $[c_1:C_1;\ldots;c_n:C_n]$,
+   
+\inference{\frac{\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} \in E
+    ~~j=1\ldots k}{(I_j:\forall~p_1:P_1,\ldots\forall p_r:P_r,A_j) \in E}}
+
+\inference{\frac{\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C} \in E
+    ~~~~i=1.. n}
+   {(c_i:\forall~p_1:P_1,\ldots \forall p_r:P_r,\subst{C_i}{I_j}{(I_j~p_1\ldots
+       p_r)}_{j=1\ldots k})\in E}}
+\end{description}
+
+\paragraph{Example.}
+We have $(\List:\Set \ra \Set), (\cons:\forall~A:\Set,A\ra(\List~A)\ra
+(\List~A))$, \\ 
+$(\Length:\forall~A:\Set, (\List~A)\ra\nat\ra\Prop)$, $\tree:\Set$ and $\forest:\Set$.
+
+From now on, we write $\ListA$ instead of $(\List~A)$ and $\LengthA$
+for $(\Length~A)$.
+
+%\paragraph{Parameters.}
+%%The parameters introduce a distortion between the inside specification
+%%of the inductive declaration where parameters are supposed to be
+%%instantiated (this representation is appropriate for checking the
+%%correctness or deriving the destructor principle) and the outside
+%%typing rules where the inductive objects are seen as objects
+%%abstracted with respect to the parameters.
+
+%In the definition of \List\ or \Length\, $A$ is a parameter because
+%what is effectively inductively defined is $\ListA$ or $\LengthA$ for
+%a given $A$ which is constant in the type of constructors.  But when
+%we define $(\LengthA~l~n)$, $l$ and $n$ are not parameters because the
+%constructors manipulate different instances of this family.
+
+\subsection{Well-formed inductive definitions}
+We cannot accept any inductive declaration because some of them lead
+to inconsistent systems. We restrict ourselves to definitions which
+satisfy a syntactic criterion of positivity. Before giving the formal
+rules, we need a few definitions:
+
+\paragraph{Definitions}\index{Positivity}\label{Positivity}
+
+A type $T$ is an {\em arity of sort $s$}\index{Arity} if it converts
+to the sort $s$ or to a product $\forall~x:T,U$ with $U$ an arity
+of sort $s$. (For instance $A\ra \Set$ or $\forall~A:\Prop,A\ra
+\Prop$ are arities of sort respectively \Set\ and \Prop).  A {\em type
+  of constructor of $I$}\index{Type of constructor} is either a term
+$(I~t_1\ldots ~t_n)$ or $\fa x:T,C$ with $C$ a {\em type of constructor
+  of $I$}.
+
+\smallskip
+
+The type of constructor $T$ will be said to {\em satisfy the positivity
+condition} for a constant $X$ in the following cases:
+
+\begin{itemize}
+\item $T=(X~t_1\ldots ~t_n)$ and $X$ does not occur free in
+any $t_i$
+\item $T=\forall~x:U,V$ and $X$ occurs only strictly positively in $U$ and
+the type $V$ satisfies the positivity condition for $X$
+\end{itemize}
+
+The constant $X$ {\em occurs strictly positively} in $T$ in the
+following cases:
+
+\begin{itemize}
+\item $X$ does not occur in $T$
+\item $T$ converts to $(X~t_1 \ldots ~t_n)$ and $X$ does not occur in
+  any of $t_i$
+\item $T$ converts to $\forall~x:U,V$ and $X$ does not occur in
+  type $U$ but occurs strictly positively in type $V$
+\item $T$ converts to $(I~a_1 \ldots ~a_m ~ t_1 \ldots ~t_p)$ where
+  $I$ is the name of an inductive declaration of the form
+  $\Ind{\Gamma}{p_1:P_1;\ldots;p_m:P_m}{I:A}{c_1:C_1;\ldots;c_n:C_n}$
+  (in particular, it is not mutually defined and it has $m$
+  parameters) and $X$ does not occur in any of the $t_i$, and the
+  types of constructor $C_i\{p_j/a_j\}_{j=1\ldots m}$ of $I$ satisfy
+  the nested positivity condition for $X$
+%\item more generally, when $T$ is not a type, $X$ occurs strictly
+%positively in $T[x:U]u$ if $X$ does not occur in $U$ but occurs
+%strictly positively in $u$
+\end{itemize}
+
+The type of constructor $T$ of $I$ {\em satisfies the nested
+positivity condition} for a constant $X$ in the following
+cases:
+
+\begin{itemize}
+\item $T=(I~t_1\ldots ~t_n)$ and $X$ does not occur in
+any $t_i$
+\item $T=\forall~x:U,V$ and $X$ occurs only strictly positively in $U$ and
+the type $V$ satisfies the nested positivity condition for $X$
+\end{itemize}
+
+\paragraph{Example}
+
+$X$ occurs strictly positively in $A\ra X$ or $X*A$ or $({\tt list}
+X)$ but not in $X \ra A$ or $(X \ra A)\ra A$ nor $({\tt neg}~A)$
+assuming the notion of product and lists were already defined and {\tt
+  neg} is an inductive definition with declaration \Ind{}{A:\Set}{{\tt
+    neg}:\Set}{{\tt neg}:(A\ra{\tt False}) \ra {\tt neg}}.  Assuming
+$X$ has arity ${\tt nat \ra Prop}$ and {\tt ex} is the inductively
+defined existential quantifier, the occurrence of $X$ in ${\tt (ex~
+  nat~ \lb~n:nat\mto (X~ n))}$ is also strictly positive.
+
+\paragraph{Correctness rules.}
+We shall now describe the rules allowing the introduction of a new
+inductive definition.
+
+\begin{description}
+\item[W-Ind] Let $E$ be an environment and
+  $\Gamma,\Gamma_P,\Gamma_I,\Gamma_C$ are contexts such that
+  $\Gamma_I$ is $[I_1:A_1;\ldots;I_k:A_k]$ and $\Gamma_C$ is
+  $[c_1:C_1;\ldots;c_n:C_n]$. 
+\inference{
+  \frac{
+  (\WTE{\Gamma;\Gamma_P}{A_j}{s'_j})_{j=1\ldots  k}
+  ~~ (\WTE{\Gamma;\Gamma_P;\Gamma_I}{C_i}{s_{p_i}})_{i=1\ldots  n}
+}
+  {\WF{E;\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C}}{\Gamma}}}
+providing the following side conditions hold:
+\begin{itemize}
+\item $k>0$, $I_j$, $c_i$ are different names for $j=1\ldots  k$ and $i=1\ldots  n$,
+\item for $j=1\ldots  k$ we have $A_j$ is an arity of sort $s_j$ and $I_j
+  \notin \Gamma \cup E$,
+\item for $i=1\ldots  n$ we have $C_i$ is a type of constructor of
+  $I_{p_i}$ which satisfies the positivity condition for $I_1 \ldots  I_k$
+  and $c_i \notin \Gamma \cup E$.
+\end{itemize}
+\end{description}
+One can remark that there is a constraint between the sort of the
+arity of the inductive type and the sort of the type of its
+constructors which will always be satisfied for the impredicative sort
+(\Prop) but may fail to define inductive definition 
+on sort \Set{} and generate constraints between universes for
+inductive definitions in types.
+
+\paragraph{Examples}
+It is well known that existential quantifier can be encoded as an
+inductive definition.
+The following declaration introduces the second-order existential
+quantifier $\exists X.P(X)$.
+\begin{coq_example*}
+Inductive exProp (P:Prop->Prop) : Prop 
+  := exP_intro : forall X:Prop, P X -> exProp P.
+\end{coq_example*}
+The same definition on \Set{} is not allowed and fails~:
+\begin{coq_eval}
+(********** The following is not correct and should produce **********)
+(*** Error: Large non-propositional inductive types must be in Type***)
+\end{coq_eval}
+\begin{coq_example}
+Inductive exSet (P:Set->Prop) : Set 
+  := exS_intro : forall X:Set, P X -> exSet P.
+\end{coq_example}
+It is possible to declare the same inductive definition in the
+universe \Type. 
+The \texttt{exType} inductive definition has type  $(\Type_i \ra\Prop)\ra
+\Type_j$ with the constraint that the parameter \texttt{X} of \texttt{exT\_intro} has type $\Type_k$ with $k<j$ and $k\leq i$.
+\begin{coq_example*}
+Inductive exType (P:Type->Prop) : Type
+  := exT_intro : forall X:Type, P X -> exType P.
+\end{coq_example*}
+%We shall assume for the following definitions that, if necessary, we
+%annotated the type of constructors such that we know if the argument
+%is recursive or not.  We shall write the type $(x:_R T)C$ if it is 
+%a recursive argument and $(x:_P T)C$ if the argument is not recursive.
+
+\subsection{Destructors}
+The specification of inductive definitions with arities and
+constructors is quite natural.  But we still have to say how to use an
+object in an inductive type.
+
+This problem is rather delicate. There are actually several different
+ways to do that. Some of them are logically equivalent but not always
+equivalent from the computational point of view or from the user point
+of view.
+
+From the computational point of view, we want to be able to define a
+function whose domain is an inductively defined type by using a
+combination of case analysis over the possible constructors of the
+object and recursion.
+
+Because we need to keep a consistent theory and also we prefer to keep
+a strongly normalizing reduction, we cannot accept any sort of
+recursion (even terminating). So the basic idea is to restrict
+ourselves to primitive recursive functions and functionals.
+
+For instance, assuming a parameter $A:\Set$ exists in the context, we
+want to build a function \length\ of type $\ListA\ra \nat$ which
+computes the length of the list, so such that $(\length~\Nil) = \nO$
+and $(\length~(\cons~A~a~l)) = (\nS~(\length~l))$.  We want these
+equalities to be recognized implicitly and taken into account in the
+conversion rule.
+
+From the logical point of view, we have built a type family by giving
+a set of constructors.  We want to capture the fact that we do not
+have any other way to build an object in this type. So when trying to
+prove a property $(P~m)$ for $m$ in an inductive definition it is
+enough to enumerate all the cases where $m$ starts with a different
+constructor.
+
+In case the inductive definition is effectively a recursive one, we
+want to capture the extra property that we have built the smallest
+fixed point of this recursive equation.  This says that we are only
+manipulating finite objects. This analysis provides induction
+principles.
+
+For instance, in order to prove $\forall l:\ListA,(\LengthA~l~(\length~l))$
+it is enough to prove:
+
+\noindent $(\LengthA~\Nil~(\length~\Nil))$ and
+
+\smallskip
+$\forall a:A, \forall l:\ListA, (\LengthA~l~(\length~l)) \ra
+(\LengthA~(\cons~A~a~l)~(\length~(\cons~A~a~l)))$.
+\smallskip
+
+\noindent which given the conversion equalities satisfied by \length\ is the
+same as proving:
+$(\LengthA~\Nil~\nO)$ and $\forall a:A, \forall l:\ListA, 
+(\LengthA~l~(\length~l)) \ra
+(\LengthA~(\cons~A~a~l)~(\nS~(\length~l)))$.
+
+One conceptually simple way to do that, following the basic scheme
+proposed by Martin-L\"of in his Intuitionistic Type Theory, is to
+introduce for each inductive definition an elimination operator. At
+the logical level it is a proof of the usual induction principle and
+at the computational level it implements a generic operator for doing
+primitive recursion over the structure.
+
+But this operator is rather tedious to implement and use. We choose in
+this version of Coq to factorize the operator for primitive recursion
+into two more primitive operations as was first suggested by Th. Coquand
+in~\cite{Coq92}.  One is the definition by pattern-matching. The second one is a definition by guarded fixpoints. 
+
+\subsubsection{The {\tt match\ldots with \ldots end} construction.}
+\label{Caseexpr}
+\index{match@{\tt match\ldots with\ldots end}}
+
+The basic idea of this destructor operation is that we have an object
+$m$ in an inductive type $I$ and we want to prove a property $(P~m)$
+which in general depends on $m$. For this, it is enough to prove the
+property for $m = (c_i~u_1\ldots  u_{p_i})$ for each constructor of $I$.
+
+The \Coq{} term for this proof will be written~:
+\[\kw{match}~m~\kw{with}~ (c_1~x_{11}~...~x_{1p_1}) \Ra f_1 ~|~\ldots~|~
+  (c_n~x_{n1}...x_{np_n}) \Ra f_n~ \kw{end}\]
+In this expression, if
+$m$ is a term built from a constructor $(c_i~u_1\ldots u_{p_i})$ then
+the expression will behave as it is specified with $i$-th branch and
+will reduce to $f_i$ where the $x_{i1}$\ldots $x_{ip_i}$ are replaced
+by the $u_1\ldots u_p$ according to the $\iota$-reduction.
+
+Actually, for type-checking a \kw{match\ldots with\ldots end}
+expression we also need to know the predicate $P$ to be proved by case
+analysis.  \Coq{} can sometimes infer this predicate but sometimes
+not. The concrete syntax for describing this predicate uses the
+\kw{as\ldots return} construction. 
+The predicate is made explicit using the syntax~:
+\[\kw{match}~m~\kw{as}~ x~ \kw{return}~ (P~ x) ~\kw{with}~ (c_1~x_{11}~...~x_{1p_1}) \Ra f_1 ~|~\ldots~|~
+  (c_n~x_{n1}...x_{np_n}) \Ra f_n \kw{end}\]
+For the purpose of presenting the inference rules, we use a more
+compact notation~:
+\[ \Case{(\lb x \mto P)}{m}{ \lb x_{11}~...~x_{1p_1} \mto f_1 ~|~\ldots~|~
+  \lb x_{n1}...x_{np_n} \mto f_n}\]
+
+This is the basic idea which is generalized to the case where $I$ is
+an inductively defined $n$-ary relation (in which case the property
+$P$ to be proved will be a $n+1$-ary relation).
+
+
+\paragraph{Non-dependent elimination.}
+When defining a function by case analysis, we build an object of type $I
+\ra C$ and the minimality principle on an inductively defined logical
+predicate of type $A \ra \Prop$ is often used to prove a property
+$\forall x:A,(I~x)\ra (C~x)$.  This is a particular case of the dependent
+principle that we stated before with a predicate which does not depend
+explicitly on the object in the inductive definition.
+
+For instance, a function testing whether a list is empty 
+can be
+defined as:
+
+\[\lb~l:\ListA \mto\Case{\bool}{l}{\Nil~ \Ra~\true~ |~ (\cons~a~m)~ \Ra~\false}\]
+%\noindent {\bf Remark. } 
+
+% In the system \Coq\ the expression above, can be
+% written without mentioning
+% the dummy abstraction:
+% \Case{\bool}{l}{\Nil~ \mbox{\tt =>}~\true~ |~ (\cons~a~m)~
+%  \mbox{\tt =>}~ \false}
+
+\paragraph{Allowed elimination sorts.}
+\index{Elimination sorts}
+
+An important question for building the typing rule for \kw{match} is
+what can be the type of $P$ with respect to the type of the inductive
+definitions.
+
+We define now a relation \compat{I:A}{B} between an inductive
+definition $I$ of type $A$, an arity $B$ which says that an object in
+the inductive definition $I$ can be eliminated for proving a property
+$P$ of type $B$.
+
+The case of inductive definitions in sorts \Set\ or \Type{} is simple.
+There is no restriction on the sort of the predicate to be
+eliminated. 
+
+\paragraph{Notations.}
+The \compat{I:A}{B} is defined as the smallest relation satisfying the
+following rules:
+We write \compat{I}{B} for \compat{I:A}{B} where $A$ is the type of
+$I$.
+
+\begin{description}
+\item[Prod] \inference{\frac{\compat{(I~x):A'}{B'}}
+                      {\compat{I:(x:A)A'}{(x:A)B'}}}
+\item[\Set \& \Type] \inference{\frac{
+    s_1 \in \{\Set,\Type(j)\}, 
+    s_2 \in \Sort}{\compat{I:s_1}{I\ra s_2}}}
+\end{description}
+
+The case of Inductive Definitions of sort \Prop{} is a bit more
+complicated, because of our interpretation of this sort. The only
+harmless allowed elimination, is the one when predicate $P$ is also of
+sort \Prop.
+\begin{description}
+\item[\Prop] \inference{\compat{I:\Prop}{I\ra\Prop}}
+\end{description}
+\Prop{} is the type of logical propositions, the proofs of properties
+$P$ in \Prop{} could not be used for computation and are consequently
+ignored by the extraction mechanism.
+Assume $A$ and $B$ are two propositions, and the logical disjunction
+$A\vee B$ is defined inductively by~:
+\begin{coq_example*}
+Inductive or (A B:Prop) : Prop :=
+  lintro : A -> or A B | rintro : B -> or A B.
+\end{coq_example*}
+The following definition which computes a boolean value by case over
+the proof of \texttt{or A B} is not accepted~:
+\begin{coq_eval}
+(***************************************************************)
+(*** This example should fail with ``Incorrect elimination'' ***)
+\end{coq_eval}
+\begin{coq_example}
+Definition choice (A B: Prop) (x:or A B) := 
+   match x with lintro a => true | rintro b => false end.
+\end{coq_example}
+From the computational point of view, the structure of the proof of
+\texttt{(or A B)} in this term is needed for computing the boolean
+value.
+
+In general, if $I$ has type \Prop\ then $P$ cannot have type $I\ra
+\Set$, because it will mean to build an informative proof of type
+$(P~m)$ doing a case analysis over a non-computational object that
+will disappear in the extracted program.  But the other way is safe
+with respect to our interpretation we can have $I$ a computational
+object and $P$ a non-computational one, it just corresponds to proving
+a logical property of a computational object.
+
+% Also if $I$ is in one of the sorts \{\Prop, \Set\}, one cannot in
+% general allow an elimination over a bigger sort such as \Type.  But
+% this operation is safe whenever $I$ is a {\em small inductive} type,
+% which means that all the types of constructors of
+% $I$ are small with the following definition:\\
+% $(I~t_1\ldots t_s)$ is a {\em small type of constructor} and
+% $\forall~x:T,C$ is a small type of constructor if $C$ is and if $T$
+% has type \Prop\ or \Set.  \index{Small inductive type}
+
+% We call this particular elimination which gives the possibility to
+% compute a type by induction on the structure of a term, a {\em strong
+%   elimination}\index{Strong elimination}.
+
+In the same spirit, elimination on $P$ of type $I\ra
+\Type$ cannot be allowed because it trivially implies the elimination
+on $P$ of type $I\ra \Set$ by cumulativity. It also implies that there
+is two proofs of the same property which are provably different,
+contradicting the proof-irrelevance property which is sometimes a
+useful axiom~:
+\begin{coq_example}
+Axiom proof_irrelevance : forall (P : Prop) (x y : P), x=y.
+\end{coq_example}
+\begin{coq_eval}
+Reset proof_irrelevance.
+\end{coq_eval}
+The elimination of an inductive definition of type \Prop\ on a
+predicate $P$ of type $I\ra \Type$ leads to a paradox when applied to 
+impredicative inductive definition like the second-order existential
+quantifier \texttt{exProp} defined above, because it give access to
+the two projections on this type.
+
+%\paragraph{Warning: strong elimination}
+%\index{Elimination!Strong elimination}
+%In previous versions of Coq, for a small inductive definition, only the
+%non-informative strong elimination on \Type\ was allowed, because
+%strong elimination on \Typeset\ was not compatible with the current
+%extraction procedure. In this version, strong elimination on \Typeset\
+%is accepted but a dummy element is extracted from it and may generate
+%problems if extracted terms are explicitly used such as in the 
+%{\tt Program} tactic or when extracting ML programs.
+
+\paragraph{Empty and singleton elimination}
+\index{Elimination!Singleton elimination}
+\index{Elimination!Empty elimination}
+
+There are special inductive definitions in \Prop\ for which more
+eliminations are allowed. 
+\begin{description}
+\item[\Prop-extended] 
+\inference{
+   \frac{I \mbox{~is an empty or singleton
+       definition}~~~s\in\Sort}{\compat{I:\Prop}{I\ra s}}
+}
+\end{description}
+
+% A {\em singleton definition} has always an informative content,
+% even if it is a proposition.
+
+A {\em singleton
+definition} has only one constructor and all the arguments of this
+constructor have type \Prop. In that case, there is a canonical
+way to interpret the informative extraction on an object in that type,
+such that the elimination on any sort $s$ is legal.  Typical examples are
+the conjunction of non-informative propositions and the equality. 
+If there is an hypothesis $h:a=b$ in the context, it can be used for
+rewriting not only in logical propositions but also in any type.
+% In that case, the term \verb!eq_rec! which was defined as an axiom, is
+% now a term of the calculus.
+\begin{coq_example}
+Print eq_rec.
+Extraction eq_rec.
+\end{coq_example}
+An empty definition has no constructors, in that case also,
+elimination on any sort is allowed.
+
+\paragraph{Type of branches.}
+Let $c$ be a term of type $C$, we assume $C$ is a type of constructor
+for an inductive definition $I$. Let $P$ be a term that represents the
+property to be proved.
+We assume $r$ is the number of parameters.
+
+We define a new type \CI{c:C}{P} which represents the type of the
+branch corresponding to the $c:C$ constructor.
+\[
+\begin{array}{ll}
+\CI{c:(I_i~p_1\ldots p_r\ t_1 \ldots t_p)}{P} &\equiv (P~t_1\ldots ~t_p~c) \\[2mm]
+\CI{c:\forall~x:T,C}{P} &\equiv \forall~x:T,\CI{(c~x):C}{P} 
+\end{array}
+\]
+We write \CI{c}{P} for \CI{c:C}{P} with $C$ the type of $c$.
+
+\paragraph{Examples.}
+For $\ListA$ the type of $P$ will be $\ListA\ra s$ for $s \in \Sort$. \\ 
+$ \CI{(\cons~A)}{P} \equiv
+\forall a:A, \forall l:\ListA,(P~(\cons~A~a~l))$.
+
+For $\LengthA$, the type of $P$ will be
+$\forall l:\ListA,\forall n:\nat, (\LengthA~l~n)\ra \Prop$ and the expression
+\CI{(\LCons~A)}{P} is defined as:\\ 
+$\forall a:A, \forall l:\ListA, \forall n:\nat, \forall
+h:(\LengthA~l~n), (P~(\cons~A~a~l)~(\nS~n)~(\LCons~A~a~l~n~l))$.\\ 
+If $P$ does not depend on its third argument, we find the more natural
+expression:\\ 
+$\forall a:A, \forall l:\ListA, \forall n:\nat,
+(\LengthA~l~n)\ra(P~(\cons~A~a~l)~(\nS~n))$.
+
+\paragraph{Typing rule.}
+
+Our very general destructor for inductive definition enjoys the
+following typing rule
+% , where we write 
+% \[
+% \Case{P}{c}{[x_{11}:T_{11}]\ldots[x_{1p_1}:T_{1p_1}]g_1\ldots
+%   [x_{n1}:T_{n1}]\ldots[x_{np_n}:T_{np_n}]g_n}
+% \]
+% for 
+% \[
+% \Case{P}{c}{(c_1~x_{11}~...~x_{1p_1}) \Ra g_1 ~|~\ldots~|~
+% (c_n~x_{n1}...x_{np_n}) \Ra g_n }
+% \]
+
+\begin{description}
+\item[match] \label{elimdep} \index{Typing rules!match}
+\inference{
+\frac{\WTEG{c}{(I~q_1\ldots  q_r~t_1\ldots  t_s)}~~
+  \WTEG{P}{B}~~\compat{(I~q_1\ldots  q_r)}{B}
+ ~~
+(\WTEG{f_i}{\CI{(c_{p_i}~q_1\ldots  q_r)}{P}})_{i=1\ldots  l}}
+{\WTEG{\Case{P}{c}{f_1\ldots  f_l}}{(P\ t_1\ldots  t_s\ c)}}}%\\[3mm]
+
+provided $I$ is an inductive type in a declaration
+\Ind{\Delta}{\Gamma_P}{\Gamma_I}{\Gamma_C} with $|\Gamma_P| = r$,
+$\Gamma_C = [c_1:C_1;\ldots;c_n:C_n]$ and $c_{p_1}\ldots  c_{p_l}$ are the
+only constructors of $I$.
+\end{description}
+
+\paragraph{Example.}
+For \List\ and \Length\ the typing rules for the {\tt match} expression
+are (writing just $t:M$ instead of \WTEG{t}{M}, the environment and
+context being the same in all the judgments).
+
+\[\frac{l:\ListA~~P:\ListA\ra s~~~f_1:(P~(\Nil~A))~~
+      f_2:\forall a:A, \forall l:\ListA, (P~(\cons~A~a~l))}
+    {\Case{P}{l}{f_1~f_2}:(P~l)}\]
+
+\[\frac{
+     \begin{array}[b]{@{}c@{}} 
+H:(\LengthA~L~N) \\ P:\forall l:\ListA, \forall n:\nat, (\LengthA~l~n)\ra
+  \Prop\\
+ f_1:(P~(\Nil~A)~\nO~\LNil) \\
+   f_2:\forall a:A, \forall l:\ListA, \forall n:\nat, \forall
+  h:(\LengthA~l~n), (P~(\cons~A~a~n)~(\nS~n)~(\LCons~A~a~l~n~h)) 
+      \end{array}}
+    {\Case{P}{H}{f_1~f_2}:(P~L~N~H)}\]
+
+\paragraph{Definition of $\iota$-reduction.}\label{iotared}
+\index{iota-reduction@$\iota$-reduction}
+We still have to define the $\iota$-reduction in the general case.
+
+A $\iota$-redex is a term of the following form:
+\[\Case{P}{(c_{p_i}~q_1\ldots  q_r~a_1\ldots  a_m)}{f_1\ldots 
+    f_l}\]
+with $c_{p_i}$ the $i$-th constructor of the inductive type $I$ with $r$
+parameters.
+
+The $\iota$-contraction of this term is $(f_i~a_1\ldots a_m)$ leading
+to the general reduction rule:
+\[ \Case{P}{(c_{p_i}~q_1\ldots  q_r~a_1\ldots  a_m)}{f_1\ldots 
+    f_n} \triangleright_{\iota} (f_i~a_1\ldots a_m) \]
+
+\subsection{Fixpoint definitions}
+\label{Fix-term} \index{Fix@{\tt Fix}}
+The second operator for elimination is fixpoint definition. 
+This fixpoint may involve several mutually recursive definitions.
+The basic concrete syntax for a recursive set of mutually recursive 
+declarations is (with $\Gamma_i$ contexts)~: 
+\[\kw{fix}~f_1 (\Gamma_1) :A_1:=t_1~\kw{with} \ldots \kw{with}~ f_n
+(\Gamma_n) :A_n:=t_n\]
+The terms are obtained by projections from this set of declarations
+and are written 
+\[\kw{fix}~f_1 (\Gamma_1) :A_1:=t_1~\kw{with} \ldots \kw{with}~ f_n
+(\Gamma_n) :A_n:=t_n~\kw{for}~f_i\]
+In the inference rules, we represent such a
+term by 
+\[\Fix{f_i}{f_1:A_1':=t_1' \ldots f_n:A_n':=t_n'}\]
+with $t_i'$ (resp. $A_i'$) representing the term $t_i$ abstracted
+(resp. generalized) with
+respect to the bindings in the context $\Gamma_i$, namely
+$t_i'=\lb \Gamma_i \mto t_i$ and $A_i'=\forall \Gamma_i, A_i$.
+
+\subsubsection{Typing rule}
+The typing rule is the expected one for a fixpoint.
+
+\begin{description}
+\item[Fix] \index{Typing rules!Fix}
+\inference{\frac{(\WTEG{A_i}{s_i})_{i=1\ldots n}~~~~
+            (\WTE{\Gamma,f_1:A_1,\ldots,f_n:A_n}{t_i}{A_i})_{i=1\ldots n}}
+         {\WTEG{\Fix{f_i}{f_1:A_1:=t_1 \ldots f_n:A_n:=t_n}}{A_i}}}
+\end{description}
+
+Any fixpoint definition cannot be accepted because non-normalizing terms
+will lead to proofs of absurdity.
+
+The basic scheme of recursion that should be allowed is the one needed for 
+defining primitive
+recursive functionals. In that case the fixpoint enjoys a special
+syntactic restriction, namely one of the arguments belongs to an
+inductive type, the function starts with a case analysis and recursive
+calls are done on variables coming from patterns and representing subterms.
+
+For instance in the case of natural numbers, a proof of the induction
+principle of type 
+\[\forall P:\nat\ra\Prop, (P~\nO)\ra((n:\nat)(P~n)\ra(P~(\nS~n)))\ra
+\forall n:\nat, (P~n)\]
+can be represented by the term:
+\[\begin{array}{l}
+\lb P:\nat\ra\Prop\mto\lb f:(P~\nO)\mto \lb g:(\forall n:\nat,
+(P~n)\ra(P~(\nS~n))) \mto\\
+\Fix{h}{h:\forall n:\nat, (P~n):=\lb n:\nat\mto \Case{P}{n}{f~\lb
+    p:\nat\mto (g~p~(h~p))}}
+\end{array}
+\]
+
+Before accepting a fixpoint definition as being correctly typed, we
+check that the definition is ``guarded''. A precise analysis of this
+notion can be found in~\cite{Gim94}.
+
+The first stage is to precise on which argument the fixpoint will be
+decreasing. The type of this argument should be an inductive
+definition.
+
+For doing this the syntax of fixpoints is extended and becomes 
+ \[\Fix{f_i}{f_1/k_1:A_1:=t_1 \ldots f_n/k_n:A_n:=t_n}\]
+where $k_i$ are positive integers.
+Each $A_i$ should be a type (reducible to a term) starting with at least
+$k_i$ products $\forall y_1:B_1,\ldots \forall y_{k_i}:B_{k_i}, A'_i$ 
+and $B_{k_i}$
+being an instance of an inductive definition.
+
+Now in the definition $t_i$, if $f_j$ occurs then it should be applied
+to at least $k_j$ arguments and the $k_j$-th argument should be
+syntactically recognized as structurally smaller than $y_{k_i}$
+
+
+The definition of being structurally smaller is a bit technical.
+One needs first to  define the notion of 
+{\em recursive arguments of a constructor}\index{Recursive arguments}.
+For an inductive definition \Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C},
+the type of a constructor $c$ have the form
+$\forall p_1:P_1,\ldots \forall p_r:P_r, 
+\forall x_1:T_1, \ldots \forall x_r:T_r, (I_j~p_1\ldots 
+p_r~t_1\ldots  t_s)$ the recursive arguments will correspond to $T_i$ in
+which one of the $I_l$ occurs.
+
+
+The main rules for being structurally smaller are the following:\\
+Given a variable $y$ of type an inductive
+definition in a declaration 
+\Ind{\Gamma}{\Gamma_P}{\Gamma_I}{\Gamma_C}
+where $\Gamma_I$ is $[I_1:A_1;\ldots;I_k:A_k]$, and $\Gamma_C$ is
+  $[c_1:C_1;\ldots;c_n:C_n]$.
+The terms structurally smaller than $y$ are:
+\begin{itemize}
+\item $(t~u), \lb x:u \mto t$ when $t$ is structurally smaller than $y$ .
+\item \Case{P}{c}{f_1\ldots f_n} when each $f_i$ is structurally
+  smaller than $y$. \\
+  If $c$ is $y$ or is structurally smaller than $y$, its type is an inductive
+  definition $I_p$ part of the inductive
+  declaration corresponding to $y$. 
+  Each $f_i$ corresponds to a type of constructor $C_q \equiv
+  \forall y_1:B_1, \ldots \forall y_k:B_k, (I~a_1\ldots a_k)$ 
+  and can consequently be
+  written $\lb y_1:B'_1\mto \ldots \lb y_k:B'_k\mto g_i$.
+  ($B'_i$ is obtained from $B_i$ by substituting parameters variables)
+  the variables $y_j$ occurring
+  in $g_i$ corresponding to recursive arguments $B_i$ (the ones in
+  which one of the $I_l$ occurs) are structurally smaller than $y$.
+\end{itemize}
+The following definitions are correct, we enter them using the
+{\tt Fixpoint} command as described in section~\ref{Fixpoint} and show
+the internal representation.
+\begin{coq_example}
+Fixpoint plus (n m:nat) {struct n} : nat :=
+  match n with
+  | O => m
+  | S p => S (plus p m)
+  end.
+Print plus.
+Fixpoint lgth (A:Set) (l:list A) {struct l} : nat :=
+  match l with
+  | nil => O
+  | cons a l' => S (lgth A l')
+  end.
+Print lgth.
+Fixpoint sizet (t:tree) : nat := let (f) := t in S (sizef f)
+ with sizef (f:forest) : nat :=
+  match f with
+  | emptyf => O
+  | consf t f => plus (sizet t) (sizef f)
+  end.
+Print sizet.
+\end{coq_example}
+
+
+\subsubsection{Reduction rule}
+\index{iota-reduction@$\iota$-reduction}
+Let $F$ be the set of declarations: $f_1/k_1:A_1:=t_1 \ldots
+f_n/k_n:A_n:=t_n$.
+The reduction for fixpoints is:
+\[ (\Fix{f_i}{F}~a_1\ldots
+a_{k_i}) \triangleright_{\iota} \substs{t_i}{f_k}{\Fix{f_k}{F}}{k=1\ldots n}\]
+when $a_{k_i}$ starts with a constructor.
+This last restriction is needed in order to keep strong normalization
+and corresponds to the reduction for primitive recursive operators.
+
+We can illustrate this behavior on examples.
+\begin{coq_example}
+Goal forall n m:nat, plus (S n) m = S (plus n m).
+reflexivity.
+Abort.
+Goal forall f:forest, sizet (node f) = S (sizef f).
+reflexivity.
+Abort.
+\end{coq_example}
+But assuming the definition of a son function from \tree\ to \forest:
+\begin{coq_example}
+Definition sont (t:tree) : forest 
+   := let (f) := t in f.
+\end{coq_example}
+The following is not a conversion but can be proved after a case analysis.
+\begin{coq_eval}
+(******************************************************************)
+(** Error: Impossible to unify ....                              **)
+\end{coq_eval}
+\begin{coq_example}
+Goal forall t:tree, sizet t = S (sizef (sont t)).
+reflexivity. (** this one fails **)
+destruct t.
+reflexivity.
+\end{coq_example}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+% La disparition de Program devrait rendre la construction Match obsolete
+% \subsubsection{The {\tt Match \ldots with \ldots end} expression}
+% \label{Matchexpr}
+% %\paragraph{A unary {\tt Match\ldots with \ldots end}.}
+% \index{Match...with...end@{\tt Match \ldots with \ldots end}}
+% The {\tt Match} operator which was a primitive notion in older
+% presentations of the Calculus of Inductive Constructions is now just a
+% macro definition which generates the good combination of {\tt Case}
+% and {\tt Fix} operators in order to generate an operator for primitive
+% recursive definitions. It always considers an inductive definition as 
+% a single inductive definition.
+
+% The following examples illustrates this feature.
+% \begin{coq_example}
+% Definition nat_pr : (C:Set)C->(nat->C->C)->nat->C 
+%   :=[C,x,g,n]Match n with x g end.
+% Print nat_pr.
+% \end{coq_example}
+% \begin{coq_example}
+% Definition forest_pr 
+%   : (C:Set)C->(tree->forest->C->C)->forest->C
+%   := [C,x,g,n]Match n with x g end.
+% \end{coq_example}
+
+% Cet exemple faisait error (HH le 12/12/96), j'ai change pour une
+% version plus simple
+%\begin{coq_example}
+%Definition forest_pr 
+%  : (P:forest->Set)(P emptyf)->((t:tree)(f:forest)(P f)->(P (consf t f)))
+%    ->(f:forest)(P f)
+%  := [C,x,g,n]Match n with x g end.
+%\end{coq_example}
+
+\subsubsection{Mutual induction}
+
+The principles of mutual induction can be automatically generated 
+using the {\tt Scheme} command described in section~\ref{Scheme}.
+
+\section{Coinductive types}
+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}.
+%They are described inchapter~\ref{Coinductives}.
+
+\section{\iCIC : the Calculus of Inductive Construction with
+  impredicative \Set}\label{impredicativity}
+
+\Coq{} can be used as a type-checker for \iCIC{}, the original 
+Calculus of Inductive Constructions with an impredicative sort \Set{}
+by using the compiler option \texttt{-impredicative-set}.
+
+For example, using the ordinary \texttt{coqtop} command, the following
+is rejected.
+\begin{coq_eval}
+(** This example should fail *******************************
+    Error: The term forall X:Set, X -> X has type Type
+    while it is expected to have type Set
+***)
+\end{coq_eval}
+\begin{coq_example}
+Definition id: Set := forall X:Set,X->X.
+\end{coq_example}
+while it will type-check, if one use instead the \texttt{coqtop
+  -impredicative-set} command.
+
+The major change in the theory concerns the rule for product formation
+in the sort \Set, which is extended to a domain in any sort~:
+\begin{description}
+\item [Prod]  \index{Typing rules!Prod (impredicative Set)}
+\inference{\frac{\WTEG{T}{s}~~~~s\in\Sort~~~~~~
+    \WTE{\Gamma::(x:T)}{U}{\Set}}
+      { \WTEG{\forall~x:T,U}{\Set}}} 
+\end{description}
+This extension has consequences on the inductive definitions which are
+allowed. 
+In the impredicative system, one can build so-called {\em large inductive
+  definitions} like the example of second-order existential
+quantifier (\texttt{exSet}).
+
+There should be restrictions on the eliminations which can be
+performed on such definitions. The eliminations rules in the
+impredicative system for sort \Set{} become~:
+\begin{description}
+\item[\Set] \inference{\frac{s \in
+      \{\Prop, \Set\}}{\compat{I:\Set}{I\ra s}}
+~~~~\frac{I \mbox{~is a small inductive definition}~~~~s \in
+      \{\Type(i)\}}
+         {\compat{I:\Set}{I\ra s}}}
+\end{description}
+     
+
+
+% $Id: RefMan-cic.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
+
+
diff --git a/doc/refman/RefMan-coi.tex b/doc/refman/RefMan-coi.tex
new file mode 100644
index 00000000..a7b57ca3
--- /dev/null
+++ b/doc/refman/RefMan-coi.tex
@@ -0,0 +1,406 @@
+%\documentstyle[11pt,../tools/coq-tex/coq]{article}
+%\input{title}
+ 
+%\include{macros}
+%\begin{document}
+
+%\coverpage{Co-inductive types in Coq}{Eduardo Gim\'enez}
+\chapter{Co-inductive types in Coq}\label{Coinductives}
+
+%\begin{abstract}
+{\it Co-inductive} types are types whose elements may not be well-founded.
+A formal study of the Calculus of Constructions extended by 
+co-inductive types has been presented
+in \cite{Gim94}. It is based on the notion of
+{\it guarded definitions} introduced by Th. Coquand
+in \cite{Coquand93}. The implementation is by E. Gim\'enez.
+%\end{abstract}
+
+\section{A short introduction to co-inductive types}
+
+We assume that the reader is rather familiar with inductive types.
+These types are characterized by their {\it constructors}, which can be 
+regarded as the basic methods from which the elements 
+of the type can be built up. It is implicit in the definition 
+of an inductive type that 
+its elements are the result of a {\it finite} number of 
+applications of its constructors. Co-inductive types arise from 
+relaxing this implicit condition and admitting that an element of
+the type can also be introduced by a non-ending (but effective) process 
+of construction defined in terms of the basic methods which characterize the
+type. So we could think in the wider notion of types defined by
+constructors (let us call them {\it recursive types}) and classify
+them into inductive and co-inductive ones, depending on whether or not
+we consider non-ending methods as admissible for constructing elements
+of the type. Note that in both cases we obtain a ``closed type'', all whose 
+elements are pre-determined in advance (by the constructors). When we
+know that $a$ is an element of a recursive type (no matter if it is 
+inductive or co-inductive) what we know is that it is the result of applying
+one of the basic forms of construction allowed for the type.
+So the more primitive way of eliminating an element of a recursive type is 
+by case analysis, i.e. by considering through which constructor it could have
+been introduced. In the case of inductive sets, the additional knowledge that
+constructors can be applied only a finite number of times provide
+us with a more powerful way of eliminating their elements, say,  
+the principle of
+induction. This principle is obviously not valid for co-inductive types,
+since it is just the expression of this extra knowledge attached to inductive 
+types.
+
+
+An example of a co-inductive type is the type of infinite sequences formed with
+elements of type $A$, or streams for shorter. In Coq, 
+it can be introduced using the \verb!CoInductive! command~:
+\begin{coq_example}
+CoInductive Stream (A:Set) : Set :=
+    cons : A -> Stream A -> Stream A.
+\end{coq_example}
+
+The syntax of this command is the same as the 
+command \verb!Inductive! (cf. section
+\ref{gal_Inductive_Definitions}).
+Definition of mutually coinductive types are possible.
+
+As was already said, there are not principles of 
+induction for co-inductive sets, the only way of eliminating these
+elements is by case analysis. 
+In the example of streams, this elimination principle can be
+used for instance to define the well known 
+destructors on streams $\hd : (\Str\;A)\rightarrow A$ 
+and $\tl: (\Str\;A)\rightarrow (\Str\;A)$  :
+\begin{coq_example}
+Section Destructors.
+Variable A : Set.
+Definition hd (x:Stream A) := match x with
+                              | cons a s => a
+                              end.
+Definition tl (x:Stream A) := match x with
+                              | cons a s => s
+                              end.
+\end{coq_example}
+\begin{coq_example*}
+End Destructors.
+\end{coq_example*}
+
+\subsection{Non-ending methods of construction}
+
+At this point the reader should have realized that we have left unexplained
+what is a ``non-ending but effective process of
+construction'' of a stream. In the widest sense, a 
+method is a non-ending process of construction if we can eliminate the
+stream that it introduces, in other words, if we can reduce
+any case analysis on it. In this sense, the following ways of 
+introducing a stream are not acceptable. 
+\begin{center}
+$\zeros = (\cons\;\nat\;\nO\;(\tl\;\zeros))\;\;:\;\;(\Str\;\nat)$\\[12pt]
+$\filter\;(\cons\;A\;a\;s) = \si\;\;(P\;a)\;\;\alors\;\;(\cons\;A\;a\;(\filter\;s))\;\;\sinon\;\;(\filter\;s) )\;\;:\;\;(\Str\;A)$
+\end{center}
+\noindent The former it is not valid since the stream can not be eliminated 
+to obtain its tail. In the latter, a stream is naively defined as
+the result of erasing from another (arbitrary) stream 
+all the elements which does not verify a certain property $P$. This
+does not always makes sense, for example it does not when all the elements
+of the stream verify $P$, in which case we can not eliminate it to
+obtain its head\footnote{Note that there is no notion of ``the empty
+stream'', a stream is always infinite and build by a \texttt{cons}.}. 
+On the contrary, the following definitions are acceptable methods for
+constructing a stream~:
+\begin{center}
+$\zeros = (\cons\;\nat\;\nO\;\zeros)\;\;:\;\;(\Str\;\nat)\;\;\;(*)$\\[12pt]
+$(\from\;n) = (\cons\;\nat\;n\;(\from\;(\nS\;n)))\;:\;(\Str\;\nat)$\\[12pt]
+$\alter  = (\cons\;\bool\;\true\;(\cons\;\bool\;\false\;\alter))\;:\;(\Str\;\bool)$.
+\end{center}
+\noindent The first one introduces a stream containing all the natural numbers
+greater than a given one, and the second the stream which infinitely
+alternates the booleans true and false.
+
+In general it is not evident to realise when a definition can 
+be accepted or not. However, there is a class of definitions that
+can be easily recognised as being valid :  those 
+where (1) all the recursive calls of the method  are done 
+after having explicitly mentioned  which is (at least) the first constructor 
+to start building the element, and (2) no other 
+functions apart from constructors are applied to recursive calls. 
+This class of definitions is usually
+referred as {\it guarded-by-constructors} 
+definitions \cite{Coquand93,Gim94}. 
+The methods $\from$ 
+and $\alter$ are examples of definitions which are guarded by constructors.
+The definition of function $\filter$ is not, because there is no 
+constructor to guard 
+the recursive call in the {\it else} branch. Neither is the one of
+$\zeros$, since there is function applied to the recursive call
+which is not a constructor. However, there is a difference between 
+the definition of $\zeros$ and $\filter$. The former may be seen as a
+wrong way of characterising an object which makes sense, and it can
+be reformulated in an admissible way using the equation (*). On the contrary, 
+the definition of
+$\filter$ can not be patched, since is the idea itself 
+of traversing an infinite
+construction searching for an element whose existence is not ensured
+which does not make sense.
+
+
+
+Guarded definitions are exactly the kind of non-ending process of 
+construction which are allowed in Coq. The way of introducing 
+a guarded definition in Coq is using the special command 
+{\tt CoFixpoint}.  This command verifies that the definition introduces an
+element of a co-inductive type, and checks if it is guarded by constructors. 
+If we try to 
+introduce the definitions above, $\from$ and $\alter$ will be accepted,
+while $\zeros$ and $\filter$ will be rejected giving some explanation 
+about why.
+\begin{coq_example}
+CoFixpoint zeros  : Stream nat := cons nat 0%N (tl nat zeros).
+CoFixpoint zeros  : Stream nat := cons nat 0%N zeros.
+CoFixpoint from (n:nat) : Stream nat := cons nat n (from (S n)).
+\end{coq_example}
+
+As in the \verb!Fixpoint! command (cf. section~\ref{Fixpoint}), it is possible 
+to introduce a block of mutually dependent methods. The general syntax
+for this case is :
+
+{\tt CoFixpoint {\ident$_1$}  :{\term$_1$} := {\term$_1'$}\\
+     with\\
+        \mbox{}\hspace{0.1cm} $\ldots$  \\
+        with {\ident$_m$}   : {\term$_m$} := {\term$_m'$}}
+
+
+\subsection{Non-ending methods and reduction}
+
+The elimination of a stream introduced by a \verb!CoFixpoint! definition 
+is done lazily, i.e. its definition can be expanded only when it occurs 
+at the head of an application which is the argument of a case expression. 
+Isolately it is considered as a canonical expression which 
+is completely evaluated. We can test this using the command \verb!compute! 
+to calculate the normal forms of some terms~:
+\begin{coq_example}
+Eval compute in (from 0).
+Eval compute in (hd nat (from 0)).
+Eval compute in (tl nat (from 0)).
+\end{coq_example}
+\noindent Thus, the equality 
+$(\from\;n)\equiv(\cons\;\nat\;n\;(\from \; (\S\;n)))$
+does not hold as definitional one. Nevertheless, it can be proved 
+as a propositional  equality, in the sense of Leibniz's equality. 
+The version {\it à la Leibniz} of the equality above follows from 
+a general lemma stating that eliminating and then re-introducing a stream
+yields the same stream.
+\begin{coq_example}
+Lemma unfold_Stream :
+   forall x:Stream nat, x = match x with
+                            | cons a s => cons nat a s
+                            end.
+\end{coq_example}
+ 
+\noindent The proof is immediate from the analysis of 
+the possible cases for $x$, which transforms 
+the equality in a trivial one.
+
+\begin{coq_example}
+olddestruct x.
+trivial.
+\end{coq_example}
+\begin{coq_eval}
+Qed.
+\end{coq_eval}
+The application of this lemma to  $(\from\;n)$ puts this
+constant at the head of an application which is an  argument 
+of a case analysis, forcing its expansion. 
+We can test the type of this application using Coq's command \verb!Check!,
+which infers the type of a given term. 
+\begin{coq_example}
+Check (fun n:nat => unfold_Stream (from n)).
+\end{coq_example}
+ \noindent  Actually, The elimination of $(\from\;n)$ has actually 
+no effect, because it is followed by a re-introduction, 
+so the type of this application is in fact 
+definitionally equal to the
+desired proposition. We can test this computing
+the normal form of the application above to see its type.  
+\begin{coq_example}
+Transparent unfold_Stream.
+Eval compute in (fun n:nat => unfold_Stream (from n)).
+\end{coq_example}
+
+
+\section{Reasoning about infinite objects}
+
+At a first sight, it might seem that 
+case analysis does not provide a very powerful way
+of reasoning about infinite objects. In fact, what we can prove about 
+an infinite object using
+only case analysis is just what we can prove unfolding its method
+of construction a finite number of times, which is not always
+enough. Consider for example the following method for appending 
+two streams~:
+\begin{coq_example}
+Variable A : Set.
+CoFixpoint conc (s1 s2:Stream A) : Stream A :=
+  cons A (hd A s1) (conc (tl A s1) s2).
+\end{coq_example}
+
+Informally speaking, we expect that for all pair of streams $s_1$ and $s_2$, 
+$(\conc\;s_1\;s_2)$ 
+defines the ``the same'' stream as $s_1$, 
+in the sense that if we would be able to unfold the definition 
+``up to the infinite'', we would obtain definitionally equal normal forms.
+However, no finite unfolding of the definitions gives definitionally 
+equal terms. Their equality can not be proved just using case analysis.
+
+
+The weakness of the elimination principle proposed for infinite objects
+contrast with the power provided by the inductive 
+elimination principles, but it is not actually surprising. It just means
+that we can not expect to prove very interesting things about infinite
+objects doing finite proofs. To take advantage of infinite objects we
+have to consider infinite proofs as well. For example,
+if we want to catch up the equality between $(\conc\;s_1\;s_2)$ and 
+$s_1$ we have to introduce first the type of the infinite proofs 
+of equality between streams. This is a 
+co-inductive type, whose elements are build up from a 
+unique constructor, requiring a proof of the equality of the
+heads of the streams, and an (infinite) proof of the equality 
+of their tails. 
+
+\begin{coq_example}
+CoInductive EqSt : Stream A -> Stream A -> Prop :=
+    eqst :
+      forall s1 s2:Stream A,
+        hd A s1 = hd A s2 -> EqSt (tl A s1) (tl A s2) -> EqSt s1 s2.
+\end{coq_example}
+\noindent Now the equality of both streams can be proved introducing
+an infinite object of type 
+
+\noindent $(\EqSt\;s_1\;(\conc\;s_1\;s_2))$ by a \verb!CoFixpoint!
+definition.
+\begin{coq_example}
+CoFixpoint eqproof (s1 s2:Stream A) : EqSt s1 (conc s1 s2) :=
+  eqst s1 (conc s1 s2) (refl_equal (hd A (conc s1 s2)))
+    (eqproof (tl A s1) s2).
+\end{coq_example}
+\begin{coq_eval}
+Reset eqproof.
+\end{coq_eval}
+\noindent Instead of giving an explicit definition, 
+we can use the proof editor of Coq to help us in 
+the construction of the proof.
+A tactic \verb!Cofix! allows to place a \verb!CoFixpoint! definition
+inside a proof. 
+This tactic introduces a variable in the context which has
+the same type as the current goal, and its application stands
+for a recursive call in the construction of the proof. If no name is
+specified for this variable, the name of the lemma  is chosen by
+default.
+%\pagebreak 
+
+\begin{coq_example}
+Lemma eqproof : forall s1 s2:Stream A, EqSt s1 (conc s1 s2).
+cofix.
+\end{coq_example}
+
+\noindent An easy (and wrong!) way of finishing the proof is just to apply the
+variable \verb!eqproof!, which has the same type as the goal. 
+
+\begin{coq_example}
+intros.
+apply eqproof.
+\end{coq_example}
+
+\noindent The ``proof'' constructed in this way 
+would correspond to the \verb!CoFixpoint! definition
+\begin{coq_example*}
+CoFixpoint eqproof  : forall s1 s2:Stream A, EqSt s1 (conc s1 s2) :=
+  eqproof.
+\end{coq_example*}
+
+\noindent which is obviously non-guarded. This means that 
+we can use the proof editor to
+define a method of construction which does not make sense. However,
+the system will never accept to include it as part of the theory,
+because the guard condition is always verified before saving the proof.
+
+\begin{coq_example}
+Qed.
+\end{coq_example}
+
+\noindent Thus, the user must be careful in the 
+construction of infinite proofs 
+with the tactic \verb!Cofix!. Remark that once it has been used 
+the application of tactics performing automatic proof search in 
+the environment (like for example \verb!Auto!)
+could introduce unguarded recursive calls in the proof.
+The command \verb!Guarded! allows to verify 
+if the guarded condition has been violated 
+during the construction of the proof. This command can be
+applied even if the proof term is not complete.
+
+
+
+\begin{coq_example}
+Restart.
+cofix.
+auto.
+Guarded.
+Undo.
+Guarded.
+\end{coq_example}
+
+\noindent To finish with this example, let us restart from the
+beginning and show how to construct an admissible proof~:
+
+\begin{coq_example} 
+Restart.
+ cofix.
+\end{coq_example}
+
+%\pagebreak
+
+\begin{coq_example}
+intros.
+apply eqst.
+trivial.
+simpl.
+apply eqproof.
+Qed.
+\end{coq_example}
+
+
+\section{Experiments with co-inductive types}
+
+Some examples involving co-inductive types are available with
+the distributed system, in the theories library and in the contributions
+of the Lyon site. Here we present a short description of their contents~:
+\begin{itemize}
+\item Directory \verb!theories/LISTS! : 
+        \begin{itemize}
+                \item File \verb!Streams.v! : The type of streams and the 
+extensional equality between streams. 
+        \end{itemize}
+
+\item Directory \verb!contrib/Lyon/COINDUCTIVES! : 
+      \begin{itemize}
+                \item Directory \verb!ARITH! : An arithmetic where $\infty$
+is an explicit constant of the language instead of a metatheoretical notion.
+                \item Directory \verb!STREAM! :
+      \begin{itemize}
+                \item File \verb!Examples! :
+Several examples of guarded definitions, as well as 
+of frequent errors in the introduction of a stream. A different 
+way of defining the extensional equality of two streams,
+and the proofs showing that it is equivalent to the one in \verb!theories!.
+                \item File \verb!Alter.v! : An example showing how 
+an infinite proof introduced by a guarded definition can be also described
+using an operator of co-recursion \cite{Gimenez95b}.
+                 \end{itemize}
+\item Directory \verb!PROCESSES! : A proof of the alternating 
+bit protocol based on Pra\-sad's Calculus of Broadcasting Systems \cite{Prasad93},
+and the verification of an interpreter for this calculus. 
+See \cite{Gimenez95b} for a complete description about this development.
+        \end{itemize}
+\end{itemize}
+
+%\end{document}
+
+% $Id: RefMan-coi.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
diff --git a/doc/refman/RefMan-com.tex b/doc/refman/RefMan-com.tex
new file mode 100644
index 00000000..f8a7546f
--- /dev/null
+++ b/doc/refman/RefMan-com.tex
@@ -0,0 +1,280 @@
+\chapter{The \Coq~commands}\label{Addoc-coqc}
+\ttindex{coqtop}
+\ttindex{coqc}
+
+There are two \Coq~commands: 
+\begin{itemize}
+\item {\tt coqtop}: The \Coq\ toplevel (interactive mode) ; 
+\item {\tt coqc} : The \Coq\ compiler (batch compilation).
+\end{itemize}
+The options are (basically) the same for the two commands, and
+roughly described below. You can also look at the \verb!man! pages of
+\verb!coqtop! and \verb!coqc! for more details.
+
+
+\section{Interactive use ({\tt coqtop})}
+
+In the interactive mode, also known as the \Coq~toplevel, the user can
+develop his theories and proofs step by step.  The \Coq~toplevel is
+run by the command {\tt coqtop}. 
+
+\index{byte-code}
+\index{native code}
+\label{binary-images}
+They are two different binary images of \Coq: the byte-code one and
+the native-code one (if Objective Caml provides a native-code compiler
+for your platform, which is supposed in the following).  When invoking
+\verb!coqtop! or \verb!coqc!, the native-code version of the system is
+used.  The command-line options \verb!-byte! and \verb!-opt! explicitly
+select the byte-code and the native-code versions, respectively.
+
+The byte-code toplevel is based on a Caml
+toplevel (to allow the dynamic link of tactics).  You can switch to
+the Caml toplevel with the command \verb!Drop.!, and come back to the
+\Coq~toplevel with the command \verb!Toplevel.loop();;!.
+
+% The command \verb!coqtop -searchisos! runs the search tool {\sf
+%   Coq\_SearchIsos} (see section~\ref{coqsearchisos},
+% page~\pageref{coqsearchisos}) and, as the \Coq~system, can be combined
+% with the option \verb!-opt!.
+
+\section{Batch compilation ({\tt coqc})}
+The {\tt coqc} command takes a name {\em file} as argument.  Then it
+looks for a vernacular file named {\em file}{\tt .v}, and tries to
+compile it into a {\em file}{\tt .vo} file (See ~\ref{compiled}).
+
+\Warning The name {\em file} must be a regular {\Coq} identifier, as
+defined in the section \ref{lexical}. It
+must only contain letters, digits or underscores
+(\_). Thus it can be \verb+/bar/foo/toto.v+ but cannot be
+\verb+/bar/foo/to-to.v+ . 
+
+Notice that the \verb!-byte! and \verb!-opt! options are still
+available with \verb!coqc!  and allow you to select the byte-code or
+native-code versions of the system.
+
+
+\section{Resource file}
+\index{Resource file}
+
+When \Coq\ is launched, with either {\tt coqtop} or {\tt coqc}, the
+resource file \verb:$HOME/.coqrc.7.0: is loaded, where \verb:$HOME: is
+the home directory of the user.  If this file is not found, then the
+file \verb:$HOME/.coqrc: is searched. You can also specify an
+arbitrary name for the resource file (see option \verb:-init-file:
+below), or the name of another user to load the resource file of
+someone else (see option \verb:-user:).
+
+This file may contain, for instance, \verb:Add LoadPath: commands to add
+directories to the load path of \Coq.
+It is possible to skip the loading of the resource file with the
+option \verb:-q:.
+
+\section{Environment variables}
+\label{EnvVariables}
+\index{Environment variables}
+
+There are three environment variables used by the \Coq\ system.
+\verb:$COQBIN: for the directory where the binaries are,
+\verb:$COQLIB: for the directory whrer the standard library is, and 
+\verb:$COQTOP: for the directory of the sources. The latter is useful
+only for developers that are writing their own tactics and are using
+\texttt{coq\_makefile} (see \ref{Makefile}). If \verb:$COQBIN: or
+\verb:$COQLIB: are not defined, \Coq\ will use the default values
+(defined at installation time). So these variables are useful only if
+you move the \Coq\ binaries and library after installation.
+
+\section{Options}
+\index{Options of the command line}
+
+The following command-line options are recognized by the commands {\tt
+  coqc} and {\tt coqtop}, unless stated otherwise:
+
+\begin{description}
+\item[{\tt -byte}]\ 
+
+  Run the byte-code version of \Coq{}.
+
+\item[{\tt -opt}]\ 
+
+  Run the native-code version of \Coq{}.
+
+\item[{\tt -I} {\em directory}, {\tt -include} {\em directory}]\ 
+
+  Add {\em directory} to the searched directories when looking for a
+  file.
+
+\item[{\tt -R} {\em directory} {\dirpath}]\ 
+
+  This maps the subdirectory structure of physical {\em directory} to
+  logical {\dirpath} and adds {\em directory} and its subdirectories
+  to the searched directories when looking for a file.
+
+\item[{\tt -top} {\dirpath}]\ 
+
+  This sets the toplevel module name to {\dirpath} instead of {\tt
+  Top}. Not valid for {\tt coqc}.
+
+\item[{\tt -is} {\em file}, {\tt -inputstate} {\em file}]\ 
+
+  Cause \Coq~to use the state put in the file {\em file} as its input
+  state. The default state is {\em initial.coq}.
+  Mainly useful to build the standard input state.
+
+\item[{\tt -outputstate} {\em file}]\ 
+
+  Cause \Coq~to dump its state to file {\em file}.coq just after finishing
+  parsing and evaluating all the arguments from the command line.
+
+\item[{\tt -nois}]\ 
+
+  Cause \Coq~to begin with an empty state. Mainly useful to build the
+  standard input state.
+
+%Obsolete?
+%
+%\item[{\tt -notactics}]\ 
+%
+%  Forbid the dynamic loading of tactics in the bytecode version of {\Coq}.
+
+\item[{\tt -init-file} {\em file}]\ 
+
+  Take {\em file} as the resource file.
+
+\item[{\tt -q}]\ 
+
+  Cause \Coq~not to load the resource file.
+
+\item[{\tt -user} {\em username}]\ 
+
+  Take resource file of user {\em username} (that is 
+  \verb+~+{\em username}{\tt /.coqrc.7.0}) instead of yours.
+
+\item[{\tt -load-ml-source} {\em file}]\ 
+
+  Load the Caml source file {\em file}.
+
+\item[{\tt -load-ml-object} {\em file}]\ 
+
+  Load the Caml object file {\em file}.
+
+\item[{\tt -l} {\em file}, {\tt -load-vernac-source} {\em file}]\ 
+
+  Load \Coq~file {\em file}{\tt .v}
+
+\item[{\tt -lv} {\em file}, {\tt -load-vernac-source-verbose} {\em file}]\ 
+
+  Load \Coq~file {\em file}{\tt .v} with 
+  a copy of the contents of the file on standard input.
+
+\item[{\tt -load-vernac-object} {\em file}]\ 
+
+  Load \Coq~compiled file {\em file}{\tt .vo}
+
+%\item[{\tt -preload} {\em file}]\ \\
+%Add {\em file}{\tt .vo} to the files to be loaded and opened
+%before making the initial state.
+%
+\item[{\tt -require} {\em file}]\ 
+
+  Load \Coq~compiled file {\em file}{\tt .vo} and import it ({\tt
+    Require} {\em file}).
+
+\item[{\tt -compile} {\em file}]\ 
+
+  This compiles file {\em file}{\tt .v} into {\em file}{\tt .vo}.
+  This option implies options {\tt -batch} and {\tt -silent}. It is
+  only available for {\tt coqtop}.
+
+\item[{\tt -compile-verbose} {\em file}]\ 
+
+  This compiles file {\em file}{\tt .v} into {\em file}{\tt .vo} with
+  a copy of the contents of the file on standard input.
+  This option implies options {\tt -batch} and {\tt -silent}. It is
+  only available for {\tt coqtop}.
+
+\item[{\tt -verbose}]\ 
+
+  This option is only for {\tt coqc}. It tells to compile the file with
+  a copy of its contents on standard input.
+
+\item[{\tt -batch}]\ 
+
+  Batch mode : exit just after arguments parsing. This option is only
+  used by {\tt coqc}.
+
+%Mostly unused in the code
+%\item[{\tt -debug}]\ 
+%
+%  Switch on the debug flag.
+
+\item[{\tt -xml}]\ 
+
+  This option is for use with {\tt coqc}. It tells \Coq\ to export on
+  the standard output the content of the compiled file into XML format.
+
+\item[{\tt -quality}]
+
+  Improve the legibility of the proof terms produced by some tactics.
+
+\item[{\tt -emacs}]\ 
+
+  Tells \Coq\ it is executed under Emacs.
+
+\item[{\tt -impredicative-set}]\ 
+
+  Change the logical theory of {\Coq} by declaring the sort {\tt Set}
+  impredicative; warning: this is known to be inconsistent with
+  some standard axioms of classical mathematics such as the functional
+  axiom of choice or the principle of description
+
+\item[{\tt -dump-glob} {\em file}]\
+
+  This dumps references for global names in file {\em file}
+  (to be used by coqdoc, see~\ref{coqdoc})
+ 
+\item[{\tt -dont-load-proofs}]\ 
+
+  This avoids loading in memory the proofs of opaque theorems
+  resulting in a smaller memory requirement and faster compilation;
+  warning: this invalidates some features such as the extraction tool.
+
+\item[{\tt -image} {\em file}]\ 
+
+  This option sets the binary image to be used to be {\em file}
+  instead of the standard one. Not of general use.
+
+\item[{\tt -bindir} {\em directory}]\ 
+
+  Set for {\tt coqc} the directory containing \Coq\ binaries.
+  It is equivalent to do \texttt{export COQBIN=}{\em directory}
+  before lauching {\tt coqc}.
+
+\item[{\tt -where}]\ 
+
+  Print the \Coq's standard library location and exit.
+
+\item[{\tt -v}]\ 
+
+  Print the \Coq's version and exit.
+
+\item[{\tt -h}, {\tt --help}]\ 
+
+  Print a short usage and exit.
+
+\end{description}
+
+% {\tt coqtop} has an additional option:
+
+% \begin{description}
+% \item[{\tt -searchisos}]\ \\
+%   Launch the {\sf Coq\_SearchIsos} toplevel
+%   (see section~\ref{coqsearchisos}, page~\pageref{coqsearchisos}).
+% \end{description}
+
+% $Id: RefMan-com.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-ext.tex b/doc/refman/RefMan-ext.tex
new file mode 100644
index 00000000..503d7571
--- /dev/null
+++ b/doc/refman/RefMan-ext.tex
@@ -0,0 +1,1173 @@
+\chapter{Extensions of \Gallina{}}
+\label{Gallina-extension}\index{Gallina}
+
+{\gallina} is the kernel language of {\Coq}. We describe here extensions of
+the Gallina's syntax.
+
+\section{Record types
+\comindex{Record}
+\label{Record}}
+
+The \verb+Record+ construction is a macro allowing the definition of
+records as is done in many programming languages.  Its syntax is
+described on figure \ref{record-syntax}.  In fact, the \verb+Record+
+macro is more general than the usual record types, since it allows
+also for ``manifest'' expressions. In this sense, the \verb+Record+
+construction allows to define ``signatures''.
+
+\begin{figure}[h]
+\begin{centerframe}
+\begin{tabular}{lcl}
+{\sentence} & ++= & {\record}\\
+  & & \\
+{\record} & ::= &
+   {\tt Record} {\ident} \sequence{\binderlet}{} {\tt :} {\sort} \verb.:=. \\
+&& ~~~~\zeroone{\ident}
+       \verb!{! \zeroone{\nelist{\field}{;}} \verb!}! \verb:.:\\
+  & & \\
+{\field} & ::= & {\name} : {\type} \\
+ & $|$ & {\name} {\typecstr} := {\term}
+\end{tabular}
+\end{centerframe}
+\caption{Syntax for the definition of {\tt Record}}
+\label{record-syntax}
+\end{figure}
+
+\noindent In the expression
+
+\smallskip
+{\tt Record} {\ident} {\params} \texttt{:} 
+   {\sort} := {\ident$_0$} \verb+{+
+ {\ident$_1$} \texttt{:} {\term$_1$}; 
+              \dots
+  {\ident$_n$} \texttt{:} {\term$_n$} \verb+}+.
+\smallskip
+ 
+\noindent the identifier {\ident} is the name of the defined record
+and {\sort} is its type. The identifier {\ident$_0$} is the name of
+its constructor. If {\ident$_0$} is omitted, the default name {\tt
+Build\_{\ident}} is used. The identifiers {\ident$_1$}, ..,
+{\ident$_n$} are the names of fields and {\term$_1$}, .., {\term$_n$}
+their respective types. Remark that the type of {\ident$_i$} may
+depend on the previous {\ident$_j$} (for $j<i$). Thus the order of the
+fields is important. Finally, {\params} are the parameters of the
+record.
+
+More generally, a record may have explicitly defined (a.k.a.
+manifest) fields. For instance, {\tt Record} {\ident} {\tt [}
+{\params} {\tt ]} \texttt{:} {\sort} := \verb+{+ {\ident$_1$}
+\texttt{:} {\type$_1$} \verb+;+ {\ident$_2$} \texttt{:=} {\term$_2$}
+\verb+;+ {\ident$_3$} \texttt{:} {\type$_3$} \verb+}+ in which case
+the correctness of {\type$_3$} may rely on the instance {\term$_2$} of
+{\ident$_2$} and {\term$_2$} in turn may depend on {\ident$_1$}.
+
+
+\Example
+The set of rational numbers may be defined as:
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example}
+Record Rat : Set := mkRat
+  {sign : bool;
+   top : nat;
+   bottom : nat;
+   Rat_bottom_cond : 0 <> bottom;
+   Rat_irred_cond :
+    forall x y z:nat, (x * y) = top /\ (x * z) = bottom -> x = 1}.
+\end{coq_example}
+
+Remark here that the field
+\verb+Rat_cond+ depends on the field \verb+bottom+. 
+
+%Let us now see the work done by the {\tt Record} macro.
+%First the macro generates an inductive definition
+%with just one constructor:
+%
+%\medskip
+%\noindent
+%{\tt Inductive {\ident} {\binderlet} : {\sort} := \\
+%\mbox{}\hspace{0.4cm} {\ident$_0$} : forall ({\ident$_1$}:{\term$_1$}) .. 
+%({\ident$_n$}:{\term$_n$}), {\ident} {\rm\sl params}.}
+%\medskip
+
+Let us now see the work done by the {\tt Record} macro.  First the
+macro generates an inductive definition with just one constructor:
+\begin{quote}
+{\tt Inductive {\ident} {\params} :{\sort} :=} \\
+\qquad {\tt
+  {\ident$_0$} ({\ident$_1$}:{\term$_1$}) .. ({\ident$_n$}:{\term$_n$}).}
+\end{quote}
+To build an object of type {\ident}, one should provide the
+constructor {\ident$_0$} with $n$ terms filling the fields of
+the record.
+
+As an example, let us define the rational $1/2$:
+\begin{coq_example*}
+Require Import Arith.
+Theorem one_two_irred :
+ forall x y z:nat, x * y = 1 /\ x * z = 2 -> x = 1.
+\end{coq_example*}
+\begin{coq_eval}
+Lemma mult_m_n_eq_m_1 : forall m n:nat, m * n = 1 -> m = 1.
+destruct m; trivial.
+intros; apply f_equal with (f := S).
+destruct m; trivial.
+destruct n; simpl in H.
+ rewrite <- mult_n_O in H.
+   discriminate.
+ rewrite <- plus_n_Sm in H.
+   discriminate.
+Qed.
+
+intros x y z [H1 H2].
+ apply mult_m_n_eq_m_1 with (n := y); trivial.
+\end{coq_eval}
+\ldots
+\begin{coq_example*}
+Qed.
+\end{coq_example*}
+\begin{coq_example}
+Definition half := mkRat true 1 2 (O_S 1) one_two_irred.
+\end{coq_example}
+\begin{coq_example}
+Check half.
+\end{coq_example}
+
+The macro generates also, when it is possible, the projection
+functions for destructuring an object of type {\ident}.  These
+projection functions have the same name that the corresponding
+fields. If a field is named ``\verb=_='' then no projection is built
+for it.  In our example:
+
+\begin{coq_example}
+Eval compute in half.(top).
+Eval compute in half.(bottom).
+Eval compute in half.(Rat_bottom_cond).
+\end{coq_example}
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{Warnings}
+\item {\tt Warning: {\ident$_i$} cannot be defined.}
+
+  It can happen that the definition of a projection is impossible.
+  This message is followed by an explanation of this impossibility.
+  There may be three reasons:
+   \begin{enumerate}
+   \item The name {\ident$_i$} already exists in the environment (see
+     Section~\ref{Axiom}).
+   \item The body of {\ident$_i$} uses an incorrect elimination for
+     {\ident} (see Sections~\ref{Fixpoint} and~\ref{Caseexpr}).
+   \item The type of the projections {\ident$_i$} depends on previous
+   projections which themselves couldn't be defined.
+   \end{enumerate}  
+\end{Warnings}     
+
+\begin{ErrMsgs}
+
+\item \errindex{A record cannot be recursive}
+
+  The record name {\ident} appears in the type of its fields.
+  
+\item During the definition of the one-constructor inductive
+  definition, all the errors of inductive definitions, as described in
+  Section~\ref{gal_Inductive_Definitions}, may also occur.
+
+\end{ErrMsgs}
+
+\SeeAlso Coercions and records in Section~\ref{Coercions-and-records}
+of the chapter devoted to coercions.
+
+\Rem {\tt Structure} is a synonym of the keyword {\tt Record}.
+
+\Rem An experimental syntax for projections based on a dot notation is
+available. The command to activate it is
+\begin{quote}
+{\tt Set Printing Projections.}
+\end{quote}
+
+\begin{figure}[t]
+\begin{centerframe}
+\begin{tabular}{lcl}
+{\term} & ++= & {\term} {\tt .(} {\qualid} {\tt )}\\
+ & $|$ & {\term} {\tt .(} {\qualid} \nelist{\termarg}{} {\tt )}\\
+ & $|$ & {\term} {\tt .(} {@}{\qualid} \nelist{\term}{} {\tt )}
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of \texttt{Record} projections}
+\label{fig:projsyntax}
+\end{figure}
+
+The corresponding grammar rules are given Figure~\ref{fig:projsyntax}.
+When {\qualid} denotes a projection, the syntax {\tt
+  {\term}.({\qualid})} is equivalent to {\qualid~\term}, the syntax
+{\tt {\term}.({\qualid}~{\termarg}$_1$~ \ldots~ {\termarg}$_n$)} to
+{\qualid~{\termarg}$_1$ \ldots {\termarg}$_n$~\term}, and the syntax
+{\tt {\term}.(@{\qualid}~{\term}$_1$~\ldots~{\term}$_n$)} to
+{@\qualid~{\term}$_1$ \ldots {\term}$_n$~\term}. In each case, {\term}
+is the object projected and the other arguments are the parameters of
+the inductive type.
+
+To deactivate the printing of projections, use 
+{\tt Unset Printing Projections}.
+
+
+\section{Variants and extensions of {\tt match}
+\label{Extensions-of-match}
+\index{match@{\tt match\ldots with\ldots end}}}
+
+\subsection{Multiple and nested pattern-matching
+\index{ML-like patterns}
+\label{Mult-match}}
+
+The basic version of \verb+match+ allows pattern-matching on simple
+patterns. As an extension, multiple and nested patterns are
+allowed, as in ML-like languages.
+
+The extension just acts as a macro that is expanded during parsing
+into a sequence of {\tt match} on simple patterns. Especially, a
+construction defined using the extended {\tt match} is printed under
+its expanded form.
+
+\SeeAlso chapter \ref{Mult-match-full}.
+
+\subsection{Pattern-matching on boolean values: the {\tt if} expression
+\index{if@{\tt if ... then ... else}}}
+
+For inductive types with exactly two constructors and for
+pattern-matchings expressions which do not depend on the arguments of
+the constructors, it is possible to use a {\tt if ... then ... else}
+notation. For instance, the definition
+
+\begin{coq_example}
+Definition not (b:bool) :=
+  match b with
+  | true => false
+  | false => true
+  end.
+\end{coq_example}
+
+can be alternatively written
+
+\begin{coq_eval}
+Reset not.
+\end{coq_eval}
+\begin{coq_example}
+Definition not (b:bool) := if b then false else true.
+\end{coq_example}
+
+More generally, for an inductive type with constructors {\tt C$_1$}
+and {\tt C$_2$}, we have the following equivalence
+
+\smallskip
+
+{\tt if {\term} \zeroone{\ifitem} then {\term}$_1$ else {\term}$_2$} $\equiv$
+\begin{tabular}[c]{l}
+{\tt match {\term} \zeroone{\ifitem} with}\\
+{\tt \verb!|! C$_1$ \_ {\ldots} \_ \verb!=>! {\term}$_1$} \\
+{\tt \verb!|! C$_2$ \_ {\ldots} \_ \verb!=>! {\term}$_2$} \\
+{\tt end}
+\end{tabular}
+
+Here is an example.
+
+\begin{coq_example}
+Check (fun x (H:{x=0}+{x<>0}) =>
+  match H with
+  | left _ => true
+  | right _ => false
+  end).
+\end{coq_example}
+
+Notice that the printing uses the {\tt if} syntax because {\tt sumbool} is
+declared as such (see section \ref{printing-options}).
+
+\subsection{Irrefutable patterns: the destructuring {\tt let}
+\index{let in@{\tt let ... in}}
+\label{Letin}}
+
+
+
+Closed terms (that is not relying on any axiom or variable) in an
+inductive type having only one constructor, say {\tt foo}, have
+necessarily the form \texttt{(foo ...)}. In this case, the {\tt match}
+construction can be written with a syntax close to the {\tt let ... in
+...}  construction. Expression {\tt let
+(}~{\ident$_1$},\ldots,{\ident$_n$}~{\tt ) :=}~{\term$_0$}~{\tt
+in}~{\term$_1$} performs case analysis on {\term$_0$} which must be in
+an inductive type with one constructor with $n$ arguments. Variables
+{\ident$_1$}\ldots{\ident$_n$} are bound to the $n$ arguments of the
+constructor in expression {\term$_1$}. For instance, the definition
+
+\begin{coq_example}
+Definition fst (A B:Set) (H:A * B) := match H with
+                                      | pair x y => x
+                                      end.
+\end{coq_example}
+
+can be alternatively written 
+
+\begin{coq_eval}
+Reset fst.
+\end{coq_eval}
+\begin{coq_example}
+Definition fst (A B:Set) (p:A * B) := let (x, _) := p in x.
+\end{coq_example}
+Note however that reduction is slightly different from regular {\tt
+let ... in ...} construction since it can occur only if {\term$_0$}
+can be put in constructor form. Otherwise, reduction is blocked.
+
+The pretty-printing of a definition by matching on a
+irrefutable pattern can either be done using {\tt match} or the {\tt
+let} construction (see Section~\ref{printing-options}).
+
+The general equivalence for an inductive type with one constructors {\tt C} is
+
+\smallskip
+{\tt let ({\ident}$_1$,\ldots,{\ident}$_n$) \zeroone{\ifitem} := {\term} in {\term}'} \\
+$\equiv$~
+{\tt match {\term} \zeroone{\ifitem} with C {\ident}$_1$ {\ldots} {\ident}$_n$ \verb!=>! {\term}' end}
+
+\subsection{Options for pretty-printing of {\tt match}
+\label{printing-options}}
+
+There are three options controlling the pretty-printing of {\tt match}
+expressions.
+
+\subsubsection{Printing of wildcard pattern
+\comindex{Set Printing Wildcard}
+\comindex{Unset Printing Wildcard}
+\comindex{Test Printing Wildcard}}
+
+Some variables in a pattern may not occur in the right-hand side of
+the pattern-matching clause.  There are options to control the
+display of these variables.
+
+\begin{quote}
+{\tt Set Printing Wildcard.}
+\end{quote}
+The variables having no occurrences in the right-hand side of the
+pattern-matching clause are just printed using the wildcard symbol
+``{\tt \_}''.
+
+\begin{quote}
+{\tt Unset Printing Wildcard.}
+\end{quote}
+The variables, even useless, are printed using their usual name. But some
+non dependent variables have no name. These ones are still printed
+using a ``{\tt \_}''.
+
+\begin{quote}
+{\tt Test Printing Wildcard.}
+\end{quote}
+This tells if the wildcard printing mode is on or off. The default is
+to print wildcard for useless variables.
+
+\subsubsection{Printing of the elimination predicate
+\comindex{Set Printing Synth}
+\comindex{Unset Printing Synth}
+\comindex{Test Printing Synth}}
+
+In most of the cases, the type of the result of a matched term is
+mechanically synthesisable. Especially, if the result type does not
+depend of the matched term.
+
+\begin{quote}
+{\tt Set Printing Synth.}
+\end{quote}
+The result type is not printed when {\Coq} knows that it can
+re-synthesise it.
+
+\begin{quote}
+{\tt Unset Printing Synth.}
+\end{quote}
+This forces the result type to be always printed.
+
+\begin{quote}
+{\tt Test Printing Synth.}
+\end{quote}
+This tells if the non-printing of synthesisable types is on or off.
+The default is to not print synthesisable types.
+
+\subsubsection{Printing matching on irrefutable pattern
+\comindex{Add Printing Let {\ident}}
+\comindex{Remove Printing Let {\ident}}
+\comindex{Test Printing Let {\ident}}
+\comindex{Print Table Printing Let}}
+
+If an inductive type has just one constructor,
+pattern-matching can be written using {\tt let} ... {\tt :=}
+... {\tt in}~...
+
+\begin{quote}
+{\tt Add Printing Let {\ident}.}
+\end{quote}
+This adds {\ident} to the list of inductive types for which
+pattern-matching is written using a {\tt let} expression.
+
+\begin{quote}
+{\tt Remove Printing Let {\ident}.}
+\end{quote}
+This removes {\ident} from this list.
+
+\begin{quote}
+{\tt Test Printing Let {\ident}.}
+\end{quote}
+This tells if {\ident} belongs to the list.
+
+\begin{quote}
+{\tt Print Table Printing Let.}
+\end{quote}
+This prints the list of inductive types for which pattern-matching is
+written using a {\tt let} expression.
+
+The list of inductive types for which pattern-matching is written
+using a {\tt let} expression is managed synchronously. This means that
+it is sensible to the command {\tt Reset}.
+
+\subsubsection{Printing matching on booleans
+\comindex{Add Printing If {\ident}}
+\comindex{Remove Printing If {\ident}}
+\comindex{Test Printing If {\ident}}
+\comindex{Print Table Printing If}}
+
+If an inductive type is isomorphic to the boolean type,
+pattern-matching can be written using {\tt if} ... {\tt then} ... {\tt
+  else} ...
+
+\begin{quote}
+{\tt Add Printing If {\ident}.}
+\end{quote}
+This adds {\ident} to the list of inductive types for which
+pattern-matching is written using an {\tt if} expression.
+
+\begin{quote}
+{\tt Remove Printing If {\ident}.}
+\end{quote}
+This removes {\ident} from this list.
+
+\begin{quote}
+{\tt Test Printing If {\ident}.}
+\end{quote}
+This tells if {\ident} belongs to the list.
+
+\begin{quote}
+{\tt Print Table Printing If.}
+\end{quote}
+This prints the list of inductive types for which pattern-matching is
+written using an {\tt if} expression.
+
+The list of inductive types for which pattern-matching is written
+using an {\tt if} expression is managed synchronously. This means that
+it is sensible to the command {\tt Reset}.
+
+\subsubsection{Example}
+
+This example emphasizes what the printing options offer.
+
+\begin{coq_example}
+Test Printing Let prod.
+Print fst.
+Remove Printing Let prod.
+Unset Printing Synth.
+Unset Printing Wildcard.
+Print fst.
+\end{coq_example}
+
+% \subsection{Still not dead old notations}
+
+% The following variant of {\tt match} is inherited from older version
+% of {\Coq}. 
+
+% \medskip
+% \begin{tabular}{lcl}
+% {\term} & ::= & {\annotation} {\tt Match} {\term} {\tt with} {\terms} {\tt end}\\
+% \end{tabular}
+% \medskip
+
+% This syntax is a macro generating a combination of {\tt match} with {\tt
+% Fix} implementing a combinator for primitive recursion equivalent to
+% the {\tt Match} construction of \Coq\ V5.8. It is provided only for
+% sake of compatibility with \Coq\ V5.8. It is recommended to avoid it.
+% (see section~\ref{Matchexpr}).
+
+% There is also a notation \texttt{Case} that is the
+% ancestor of \texttt{match}. Again, it is still in the code for
+% compatibility with old versions but the user should not use it.
+
+% Explained in RefMan-gal.tex
+%% \section{Forced type}
+
+%% In some cases, one may wish to assign a particular type to a term. The
+%% syntax to force the type of a term is the following:
+
+%% \medskip
+%% \begin{tabular}{lcl}
+%% {\term} & ++= & {\term} {\tt :} {\term}\\
+%% \end{tabular}
+%% \medskip
+
+%% It forces the first term to be of type the second term. The
+%% type must be compatible with
+%% the term. More precisely it must be either a type convertible to
+%% the automatically inferred type (see chapter \ref{Cic}) or a type
+%% coercible to it, (see \ref{Coercions}). When the type of a
+%% whole expression is forced, it is usually not necessary to give the types of
+%% the variables involved in the term.
+
+%% Example:
+
+%% \begin{coq_example}
+%% Definition ID := forall X:Set, X -> X.
+%% Definition id := (fun X x => x):ID.
+%% Check id.
+%% \end{coq_example}
+
+\section{Section mechanism
+\index{Sections}
+\label{Section}}
+
+The sectioning mechanism allows to organise a proof in structured
+sections. Then local declarations become available (see
+Section~\ref{Simpl-definitions}). 
+
+\subsection{\tt Section {\ident}\comindex{Section}}
+
+This command is used to open a section named {\ident}.
+
+%% Discontinued ?
+%% \begin{Variants}
+%% \comindex{Chapter}
+%% \item{\tt Chapter {\ident}}\\
+%%         Same as {\tt Section {\ident}}
+%% \end{Variants}
+
+\subsection{\tt End {\ident}
+\comindex{End}}
+
+This command closes the section named {\ident}. When a section is
+closed, all local declarations (variables and local definitions) are
+{\em discharged}. This means that all global objects defined in the
+section are generalised with respect to all variables and local
+definitions it depends on in the section.  None of the local
+declarations (considered as autonomous declarations) survive the end
+of the section.
+
+Here is an example :
+\begin{coq_example}
+Section s1.
+Variables x y : nat.
+Let y' := y.
+Definition x' := S x.
+Definition x'' := x' + y'.
+Print x'.
+End s1.
+Print x'.
+Print x''.
+\end{coq_example}
+Notice the difference between the value of {\tt x'} and {\tt x''}
+inside section {\tt s1} and outside.
+
+\begin{ErrMsgs}
+\item \errindex{This is not the last opened section}
+\end{ErrMsgs}
+
+\begin{Remarks}
+\item Most commands, like {\tt Hint}, {\tt Notation}, option management, ...
+which appear inside a section are cancelled when the
+section is closed.
+% cf section \ref{LongNames}
+%\item Usually all identifiers must be distinct. 
+%However, a name already used in a closed section (see \ref{Section})
+%can be reused. In this case, the old name is no longer accessible.
+
+% Obsolète
+%\item A module implicitly open a section. Be careful not to name a
+%module with an identifier already used in the module (see \ref{compiled}).
+\end{Remarks}
+
+\input{RefMan-mod.v}
+
+\section{Libraries and qualified names}
+
+\subsection{Names of libraries and files
+\label{Libraries}
+\index{Libraries}
+\index{Logical paths}}
+
+\paragraph{Libraries}
+
+The theories developed in {\Coq} are stored in {\em libraries}.  A
+library is characterised by a name called {\it root} of the
+library. The standard library of {\Coq} has root name {\tt Coq} and is
+known by default when a {\Coq} session starts.
+
+Libraries have a tree structure. E.g., the {\tt Coq} library
+contains the sub-libraries {\tt Init}, {\tt Logic}, {\tt Arith}, {\tt
+Lists}, ... The ``dot notation'' is used to separate the different
+component of a library name. For instance, the {\tt Arith} library of
+{\Coq} standard library is written ``{\tt Coq.Arith}''.
+
+\medskip
+\Rem no blank is allowed between the dot and the identifier on its
+right, otherwise the dot is interpreted as the full stop (period) of
+the command!
+\medskip
+
+\paragraph{Physical paths vs logical paths}
+
+Libraries and sub-libraries are denoted by {\em logical directory
+paths} (written {\dirpath} and of which the syntax is the same as
+{\qualid}, see \ref{qualid}). Logical directory
+paths can be mapped to physical directories of the
+operating system using the command (see \ref{AddLoadPath})
+\begin{quote}
+{\tt Add LoadPath {\it physical\_path} as {\dirpath}}.
+\end{quote}
+A library can inherit the tree structure of a physical directory by
+using the {\tt -R} option to {\tt coqtop} or the
+command (see \ref{AddRecLoadPath})
+\begin{quote}
+{\tt Add Rec LoadPath {\it physical\_path} as {\dirpath}}.
+\end{quote}
+
+\Rem When used interactively with {\tt coqtop} command, {\Coq} opens a
+library called {\tt Top}.
+
+\paragraph{The file level}
+
+At some point, (sub-)libraries contain {\it modules} which coincide
+with files at the physical level.  As for sublibraries, the dot
+notation is used to denote a specific module of a library. Typically,
+{\tt Coq.Init.Logic} is the logical path associated to the file {\tt
+  Logic.v} of {\Coq} standard library.  Notice that compilation (see
+\ref{Addoc-coqc}) is done at the level of files.
+
+If the physical directory where a file {\tt File.v} lies is mapped to
+the empty logical directory path (which is the default when using the
+simple form of {\tt Add LoadPath} or {\tt -I} option to coqtop), then
+the name of the module it defines is {\tt File}.
+
+\subsection{Qualified names
+\label{LongNames}
+\index{Qualified identifiers}
+\index{Absolute names}}
+
+Modules contain constructions (sub-modules, axioms, parameters,
+definitions, lemmas, theorems, remarks or facts). The (full) name of a
+construction starts with the logical name of the module in which it is defined
+followed by the (short) name of the construction.
+Typically, the full name {\tt Coq.Init.Logic.eq} denotes Leibniz' equality
+defined in the module {\tt Logic} in the sublibrary {\tt Init} of the
+standard library of \Coq.
+
+\paragraph{Absolute, partially qualified and short names}
+
+The full name of a library, module, section, definition, theorem,
+... is its {\it absolute name}.  The last identifier ({\tt eq} in the
+previous example) is its {\it short name} (or sometimes {\it base
+name}). Any suffix of the absolute name is a {\em partially qualified
+name} (e.g. {\tt Logic.eq} is a partially qualified name for {\tt
+Coq.Init.Logic.eq}). Partially qualified names (shortly {\em
+qualified name}) are also built from identifiers separated by dots.
+They are written {\qualid} in the documentation.
+
+{\Coq} does not accept two constructions (definition, theorem, ...)
+with the same absolute name but different constructions can have the
+same short name (or even same partially qualified names as soon as the
+full names are different).
+
+\paragraph{Visibility}
+
+{\Coq} maintains a {\it name table} mapping qualified names to absolute
+names. This table is modified by the commands {\tt Require} (see
+\ref{Require}), {\tt Import} and {\tt Export} (see \ref{Import}) and
+also each time a new declaration is added to the context.
+
+An absolute name is called {\it visible} from a given short or
+partially qualified name when this name suffices to denote it. This
+means that the short or partially qualified name is mapped to the absolute
+name in {\Coq} name table.
+
+It may happen that a visible name is hidden by the short name or a
+qualified name of another construction. In this case, the name that
+has been hidden must be referred to using one more level of
+qualification. Still, to ensure that a construction always remains
+accessible, absolute names can never be hidden.
+
+Examples:
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example}
+Check 0.
+Definition nat := bool.
+Check 0.
+Check Datatypes.nat.
+Locate nat.
+\end{coq_example}
+
+\Rem There is also a name table for sublibraries, modules and sections.
+
+\Rem In versions prior to {\Coq} 7.4, lemmas declared with {\tt
+Remark} and {\tt Fact} kept in their full name the names of the
+sections in which they were defined. Since {\Coq} 7.4, they strictly
+behaves as {\tt Theorem} and {\tt Lemma} do.
+
+\SeeAlso Command {\tt Locate} in Section~\ref{Locate}.
+
+%% \paragraph{The special case of remarks and facts}
+%% 
+%% In contrast with definitions, lemmas, theorems, axioms and parameters,
+%% the absolute name of remarks includes the segment of sections in which
+%% it is defined. Concretely, if a remark {\tt R} is defined in
+%% subsection {\tt S2} of section {\tt S1} in module {\tt M}, then its
+%% absolute name is {\tt M.S1.S2.R}. The same for facts, except that the
+%% name of the innermost section is dropped from the full name. Then, if
+%% a fact {\tt F} is defined in subsection {\tt S2} of section {\tt S1}
+%% in module {\tt M}, then its absolute name is {\tt M.S1.F}.
+
+
+\paragraph{Requiring a file}
+
+A module compiled in a ``.vo'' file comes with a logical names (e.g. 
+physical file \verb!theories/Init/Datatypes.vo! in the {\Coq} installation directory is bound to the logical module {\tt Coq.Init.Datatypes}). 
+When requiring the file, the mapping between physical directories and logical library should be consistent with the mapping used to compile the file (for modules of the standard library, this is automatic -- check it by typing {\tt Print LoadPath}).
+
+The command {\tt Add Rec LoadPath} is also available from {\tt coqtop}
+and {\tt coqc} by using option~\verb=-R=.
+
+\section{Implicit arguments
+\index{Implicit arguments}
+\label{Implicit Arguments}}
+
+An implicit argument of a function is an argument which can be
+inferred from the knowledge of the type of other arguments of the
+function, or of the type of the surrounding context of the application.
+Especially, an implicit argument corresponds to a parameter
+dependent in the type of the function. Typical implicit
+arguments are the type arguments in polymorphic functions.
+More precisely, there are several kinds of implicit arguments.
+
+\paragraph{Strict Implicit Arguments.} 
+An implicit argument can be either strict or non strict. An implicit
+argument is said {\em strict} if, whatever the other arguments of the
+function are, it is still inferable from the type of some other
+argument. Technically, an implicit argument is strict if it
+corresponds to a parameter which is not applied to a variable which
+itself is another parameter of the function (since this parameter
+may erase its arguments), not in the body of a {\tt match}, and not
+itself applied or matched against patterns (since the original
+form of the argument can be lost by reduction).
+
+For instance, the first argument of
+\begin{quote}
+\verb|cons: forall A:Set, A -> list A -> list A|
+\end{quote}
+in module {\tt List.v} is strict because {\tt list} is an inductive
+type and {\tt A} will always be inferable from the type {\tt
+list A} of the third argument of {\tt cons}.
+On the opposite, the second argument of a term of type 
+\begin{quote}
+\verb|forall P:nat->Prop, forall n:nat, P n -> ex nat P|
+\end{quote}
+is implicit but not strict, since it can only be inferred from the
+type {\tt P n} of the the third argument and if {\tt P} is e.g. {\tt
+fun \_ => True}, it reduces to an expression where {\tt n} does not
+occur any longer. The first argument {\tt P} is implicit but not
+strict either because it can only be inferred from {\tt P n} and {\tt
+P} is not canonically inferable from an arbitrary {\tt n} and the
+normal form of {\tt P n} (consider e.g. that {\tt n} is {\tt 0} and
+the third argument has type {\tt True}, then any {\tt P} of the form
+{\tt fun n => match n with 0 => True | \_ => \mbox{\em anything} end} would
+be a solution of the inference problem.
+
+\paragraph{Contextual Implicit Arguments.} 
+An implicit argument can be {\em contextual} or non. An implicit
+argument is said {\em contextual} if it can be inferred only from the
+knowledge of the type of the context of the current expression. For
+instance, the only argument of
+\begin{quote}
+\verb|nil : forall A:Set, list A|
+\end{quote}
+is contextual. Similarly, both arguments of a term of type
+\begin{quote}
+\verb|forall P:nat->Prop, forall n:nat, P n \/ n = 0|
+\end{quote}
+are contextual (moreover, {\tt n} is strict and {\tt P} is not).
+
+\subsection{Casual use of implicit arguments}
+
+In a given expression, if it is clear that some argument of a function
+can be inferred from the type of the other arguments, the user can
+force the given argument to be guessed by replacing it by ``{\tt \_}''. If
+possible, the correct argument will be automatically generated.
+
+\begin{ErrMsgs}
+
+\item \errindex{Cannot infer a term for this placeholder}
+
+  {\Coq} was not able to deduce an instantiation of a ``{\tt \_}''.
+
+\end{ErrMsgs}
+
+\subsection{Declaration of implicit arguments for a constant
+\comindex{Implicit Arguments}}
+
+In case one wants that some arguments of a given object (constant,
+inductive types, constructors, assumptions, local or not) are always
+inferred by Coq, one may declare once for all which are the expected
+implicit arguments of this object. The syntax is
+\begin{quote}
+\tt Implicit Arguments {\qualid} [ \nelist{\ident}{} ]
+\end{quote}
+where the list of {\ident} is the list of parameters to be declared
+implicit. After this, implicit arguments can just (and have to) be
+skipped in any expression involving an application of {\qualid}.
+
+\Example
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example*}
+Inductive list (A:Set) : Set :=
+ | nil : list A 
+ | cons : A -> list A -> list A.
+\end{coq_example*}
+\begin{coq_example}
+Check (cons nat 3 (nil nat)).
+Implicit Arguments cons [A].
+Implicit Arguments nil [A].
+Check (cons 3 nil).
+\end{coq_example}
+
+\Rem To know which are the implicit arguments of an object, use command
+{\tt Print Implicit} (see \ref{PrintImplicit}).
+
+\Rem If the list of arguments is empty, the command removes the
+implicit arguments of {\qualid}.
+
+\subsection{Automatic declaration of implicit arguments for a constant}
+
+{\Coq} can also automatically detect what are the implicit arguments
+of a defined object. The command is just
+\begin{quote}
+\tt Implicit Arguments {\qualid}.
+\end{quote}
+The auto-detection is governed by options telling if strict and
+contextual implicit arguments must be considered or not (see
+Sections~\ref{SetStrictImplicit} and~\ref{SetContextualImplicit}). 
+
+\Example
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example*}
+Inductive list (A:Set) : Set := 
+  | nil : list A 
+  | cons : A -> list A -> list A.
+\end{coq_example*}
+\begin{coq_example}
+Implicit Arguments cons.
+Print Implicit cons.
+Implicit Arguments nil.
+Print Implicit nil.
+Set Contextual Implicit.
+Implicit Arguments nil.
+Print Implicit nil.
+\end{coq_example}
+
+The computation of implicit arguments takes account of the
+unfolding of constants.  For instance, the variable {\tt p} below has
+type {\tt (Transitivity R)} which is reducible to {\tt forall x,y:U, R x
+y -> forall z:U, R y z -> R x z}. As the variables {\tt x}, {\tt y} and
+{\tt z} appear strictly in body of the type, they are implicit.
+
+\begin{coq_example*}
+Variable X : Type.
+Definition Relation := X -> X -> Prop.
+Definition Transitivity (R:Relation) :=
+  forall x y:X, R x y -> forall z:X, R y z -> R x z.
+Variables (R : Relation) (p : Transitivity R).
+Implicit Arguments p.
+\end{coq_example*}
+\begin{coq_example}
+Print p.
+Print Implicit p.
+\end{coq_example}
+\begin{coq_example*}
+Variables (a b c : X) (r1 : R a b) (r2 : R b c).
+\end{coq_example*}
+\begin{coq_example}
+Check (p r1 r2).
+\end{coq_example}
+
+\subsection{Mode for automatic declaration of implicit arguments
+\label{Auto-implicit}
+\comindex{Set Implicit Arguments}
+\comindex{Unset Implicit Arguments}}
+
+In case one wants to systematically declare implicit the arguments
+detectable as such, one may switch to the automatic declaration of
+implicit arguments mode by using the command
+\begin{quote}
+\tt Set Implicit Arguments.
+\end{quote}
+Conversely, one may unset the mode by using {\tt Unset Implicit
+Arguments}.  The mode is off by default. Auto-detection of implicit
+arguments is governed by options controlling whether strict and
+contextual implicit arguments have to be considered or not.
+
+\subsection{Controlling strict implicit arguments
+\comindex{Set Strict Implicit}
+\comindex{Unset Strict Implicit}
+\label{SetStrictImplicit}}
+
+By default, {\Coq} automatically set implicit only the strict implicit
+arguments. To relax this constraint, use command 
+\begin{quote}
+\tt Unset Strict Implicit.
+\end{quote}
+Conversely, use command {\tt Set Strict Implicit} to
+restore the strict implicit mode.
+
+\Rem In versions of {\Coq} prior to version 8.0, the default was to
+declare the strict implicit arguments as implicit.
+
+\subsection{Controlling contextual implicit arguments
+\comindex{Set Contextual Implicit}
+\comindex{Unset Contextual Implicit}
+\label{SetContextualImplicit}}
+
+By default, {\Coq} does not automatically set implicit the contextual
+implicit arguments. To tell {\Coq} to infer also contextual implicit
+argument, use command  
+\begin{quote}
+\tt Set Contextual Implicit. 
+\end{quote}
+Conversely, use command {\tt Unset Contextual Implicit} to
+unset the contextual implicit mode.
+
+\subsection{Explicit Applications
+\index{Explicitation of implicit arguments}
+\label{Implicits-explicitation}
+\index{qualid@{\qualid}}}
+
+In presence of non strict or contextual argument, or in presence of
+partial applications, the synthesis of implicit arguments may fail, so
+one may have to give explicitly certain implicit arguments of an
+application. The syntax for this is {\tt (\ident:=\term)} where {\ident}
+is the name of the implicit argument and {\term} is its corresponding
+explicit term. Alternatively, one can locally deactivate the hidding of
+implicit arguments of a function by using the notation
+{\tt @{\qualid}~{\term}$_1$..{\term}$_n$}. This syntax extension is
+given Figure~\ref{fig:explicitations}.
+\begin{figure}
+\begin{centerframe}
+\begin{tabular}{lcl}
+{\term} & ++= & @ {\qualid} \nelist{\term}{}\\
+& $|$ & @ {\qualid}\\
+& $|$ & {\qualid} \nelist{\textrm{\textsl{argument}}}{}\\
+\\
+{\textrm{\textsl{argument}}} & ::= & {\term} \\
+& $|$ & {\tt ({\ident}:={\term})}\\
+\end{tabular}
+\end{centerframe}
+\caption{Syntax for explicitations of implicit arguments}
+\label{fig:explicitations}
+\end{figure}
+
+\noindent {\bf Example (continued): }
+\begin{coq_example}
+Check (p r1 (z:=c)).
+Check (p (x:=a) (y:=b) r1 (z:=c) r2).
+\end{coq_example}
+
+\subsection{Displaying what the implicit arguments are
+\comindex{Print Implicit}
+\label{PrintImplicit}}
+
+To display the implicit arguments associated to an object use command
+\begin{quote}
+\tt Print Implicit {\qualid}.
+\end{quote}
+
+\subsection{Explicitation of implicit arguments for pretty-printing
+\comindex{Set Printing Implicit}
+\comindex{Unset Printing Implicit}}
+
+By default the basic pretty-printing rules hide the inferable implicit
+arguments of an application. To force printing all implicit arguments,
+use command
+\begin{quote}
+{\tt Set Printing Implicit.}
+\end{quote}
+Conversely, to restore the hidding of implicit arguments, use command
+\begin{quote}
+{\tt Unset Printing Implicit.}
+\end{quote}
+
+\SeeAlso {\tt Set Printing All} in section \ref{SetPrintingAll}.
+
+\subsection{Interaction with subtyping}
+
+When an implicit argument can be inferred from the type of more than
+one of the other arguments, then only the type of the first of these
+arguments is taken into account, and not an upper type of all of
+them.  As a consequence, the inference of the implicit argument of
+``='' fails in
+
+\begin{coq_example*}
+Check nat = Prop.
+\end{coq_example*}
+
+but succeeds in 
+
+\begin{coq_example*}
+Check Prop = nat.
+\end{coq_example*}
+
+\subsection{Canonical structures
+\comindex{Canonical Structure}}
+
+A canonical structure is an instance of a record/structure type that
+can be used to solve equations involving implicit arguments. Assume
+that {\qualid} denotes an object $(Build\_struc~ c_1~ \ldots~ c_n)$ in the
+structure {\em struct} of which the fields are $x_1$, ...,
+$x_n$. Assume that {\qualid} is declared as a canonical structure
+using the command
+\begin{quote}
+{\tt Canonical Structure {\qualid}.}
+\end{quote}
+Then, each time an equation of the form $(x_i~
+\_)=_{\beta\delta\iota\zeta}c_i$ has to be solved during the
+type-checking process, {\qualid} is used as a solution. Otherwise
+said, {\qualid} is canonically used to extend the field $c_i$ into a
+complete structure built on $c_i$.
+
+Canonical structures are particularly useful when mixed with
+coercions and strict implicit arguments. Here is an example.
+\begin{coq_example*}
+Require Import Relations.
+Require Import EqNat.
+Set Implicit Arguments.
+Unset Strict Implicit.
+Structure Setoid : Type := 
+  {Carrier :> Set;
+   Equal : relation Carrier;
+   Prf_equiv : equivalence Carrier Equal}.
+Definition is_law (A B:Setoid) (f:A -> B) :=
+  forall x y:A, Equal x y -> Equal (f x) (f y).
+Axiom eq_nat_equiv : equivalence nat eq_nat.
+Definition nat_setoid : Setoid := Build_Setoid eq_nat_equiv.
+Canonical Structure nat_setoid.
+\end{coq_example*}
+
+Thanks to \texttt{nat\_setoid} declared as canonical, the implicit
+arguments {\tt A} and {\tt B} can be synthesised in the next statement.
+\begin{coq_example}
+Lemma is_law_S : is_law S.
+\end{coq_example}
+
+\Rem If a same field occurs in several canonical structure, then
+only the structure declared first as canonical is considered.
+
+\begin{Variants}
+\item {\tt Canonical Structure {\ident} := {\term} : {\type}.}\\
+ {\tt Canonical Structure {\ident} := {\term}.}\\
+ {\tt Canonical Structure {\ident} : {\type} := {\term}.}
+
+These are equivalent to a regular definition of {\ident} followed by
+the declaration 
+
+{\tt Canonical Structure {\ident}}.
+\end{Variants}
+
+\SeeAlso more examples in user contribution \texttt{category}
+(\texttt{Rocq/ALGEBRA}).
+
+\subsection{Implicit types of variables}
+
+It is possible to bind variable names to a given type (e.g. in a
+development using arithmetic, it may be convenient to bind the names
+{\tt n} or {\tt m} to the type {\tt nat} of natural numbers). The
+command for that is
+\begin{quote}
+\tt Implicit Types \nelist{\ident}{} : {\type}
+\end{quote}
+The effect of the command is to automatically set the type of bound
+variables starting with {\ident} (either {\ident} itself or
+{\ident} followed by one or more single quotes, underscore or digits)
+to be {\type} (unless the bound variable is already declared with an
+explicit type in which case, this latter type is considered).
+
+\Example
+\begin{coq_example}
+Require Import List.
+Implicit Types m n : nat.
+Lemma cons_inj_nat : forall m n l, n :: l = m :: l -> n = m.
+intros m n.
+Lemma cons_inj_bool : forall (m n:bool) l, n :: l = m :: l -> n = m.
+\end{coq_example}
+
+\begin{Variants}
+\item {\tt Implicit Type {\ident} : {\type}}\\
+This is useful for declaring the implicit type of a single variable.
+\end{Variants}
+
+\section{Coercions
+\label{Coercions}
+\index{Coercions}}
+
+Coercions can be used to implicitly inject terms from one {\em class} in
+which they reside into another one. A {\em class} is either a sort
+(denoted by the keyword {\tt Sortclass}), a product type (denoted by the
+keyword {\tt Funclass}), or a type constructor (denoted by its name),
+e.g. an inductive type or any constant with a type of the form
+\texttt{forall} $(x_1:A_1) .. (x_n:A_n),~s$ where $s$ is a sort.
+
+Then the user is able to apply an
+object that is not a function, but can be coerced to a function, and
+more generally to consider that a term of type A is of type B provided
+that there is a declared coercion between A and B. The main command is
+\comindex{Coercion}
+\begin{quote}
+\tt Coercion {\qualid} : {\class$_1$} >-> {\class$_2$}.
+\end{quote}
+which declares the construction denoted by {\qualid} as a
+coercion between {\class$_1$} and {\class$_2$}.
+
+More details and examples, and a description of the commands related
+to coercions are provided in chapter \ref{Coercions-full}.
+
+\section{Printing constructions in full}
+\label{SetPrintingAll}
+\comindex{Set Printing All}
+\comindex{Unset Printing All}
+
+Coercions, implicit arguments, the type of pattern-matching, but also
+notations (see chapter \ref{Addoc-syntax}) can obfuscate the behavior
+of some tactics (typically the tactics applying to occurrences of
+subterms are sensitive to the implicit arguments). The command
+\begin{quote}
+{\tt Set Printing All.}
+\end{quote}
+deactivates all high-level printing features such as coercions,
+implicit arguments, returned type of pattern-matching, notations and
+various syntactic sugar for pattern-matching or record projections.
+Otherwise said, {\tt Set Printing All} includes the effects
+of the commands {\tt Set Printing Implicit}, {\tt Set Printing
+Coercions}, {\tt Set Printing Synth}, {\tt Unset Printing Projections}
+and {\tt Unset Printing Notations}.  To reactivate the high-level
+printing features, use the command
+\begin{quote}
+{\tt Unset Printing All.}
+\end{quote}
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-gal.tex b/doc/refman/RefMan-gal.tex
new file mode 100644
index 00000000..ce2b75b8
--- /dev/null
+++ b/doc/refman/RefMan-gal.tex
@@ -0,0 +1,1451 @@
+\chapter{The \gallina{} specification language
+\label{Gallina}\index{Gallina}}
+
+This chapter describes \gallina, the specification language of {\Coq}.
+It allows to develop mathematical theories and to prove specifications
+of programs.  The theories are built from axioms, hypotheses,
+parameters, lemmas, theorems and definitions of constants, functions,
+predicates and sets. The syntax of logical objects involved in
+theories is described in section \ref{term}. The language of
+commands, called {\em The Vernacular} is described in section
+\ref{Vernacular}.
+
+In {\Coq}, logical objects are typed to ensure their logical
+correctness. The rules implemented by the typing algorithm are described in
+chapter \ref{Cic}.
+
+\subsection*{About the grammars in the manual
+\label{BNF-syntax}\index{BNF metasyntax}}
+
+Grammars are presented in Backus-Naur form (BNF). Terminal symbols are
+set in {\tt typewriter font}.  In addition, there are special
+notations for regular expressions.
+
+An expression enclosed in square brackets \zeroone{\ldots} means at
+most one occurrence of this expression (this corresponds to an
+optional component).
+
+The notation ``\nelist{\entry}{sep}'' stands for a non empty
+sequence of expressions parsed by {\entry} and
+separated by the literal ``{\tt sep}''\footnote{This is similar to the
+expression ``{\entry} $\{$ {\tt sep} {\entry} $\}$'' in
+standard BNF, or ``{\entry} $($ {\tt sep} {\entry} $)$*'' in
+the syntax of regular expressions.}.
+
+Similarly, the notation ``\nelist{\entry}{}'' stands for a non
+empty sequence of expressions parsed by the ``{\entry}'' entry,
+without any separator between.
+
+At the end, the notation ``\sequence{\entry}{\tt sep}'' stands for a
+possibly empty sequence of expressions parsed by the ``{\entry}'' entry,
+separated by the literal ``{\tt sep}''.
+
+\section{Lexical conventions
+\label{lexical}\index{Lexical conventions}}
+
+\paragraph{Blanks}
+Space, newline and horizontal tabulation are considered as blanks.
+Blanks are ignored but they separate tokens.
+
+\paragraph{Comments}
+
+Comments in {\Coq} are enclosed between {\tt (*} and {\tt
+  *)}\index{Comments}, and can be nested. They can contain any
+character. However, string literals must be correctly closed. Comments
+are treated as blanks.
+
+\paragraph{Identifiers and access identifiers}
+
+Identifiers, written {\ident}, are sequences of letters, digits,
+\verb!_! and \verb!'!, that do not start with a digit or \verb!'!.
+That is, they are recognized by the following lexical class:
+
+\index{ident@\ident}
+\begin{center}
+\begin{tabular}{rcl} 
+{\firstletter} & ::= & {\tt a..z} $\mid$ {\tt A..Z} $\mid$ {\tt \_}
+% $\mid$ {\tt unicode-letter}  
+\\
+{\subsequentletter} & ::= & {\tt a..z} $\mid$ {\tt A..Z} $\mid$ {\tt 0..9}
+$\mid$ {\tt \_} % $\mid$ {\tt \$}
+$\mid$ {\tt '} \\
+{\ident} & ::= & {\firstletter} \sequencewithoutblank{\subsequentletter}{}
+\end{tabular}
+\end{center}
+All characters are meaningful. In particular, identifiers are case-sensitive.
+Access identifiers, written {\accessident}, are identifiers prefixed
+by \verb!.! (dot) without blank. They are used in the syntax of qualified
+identifiers.
+
+\paragraph{Natural numbers and integers}
+Numerals are sequences of digits. Integers are numerals optionally preceded by a minus sign.
+
+\index{num@{\num}}
+\index{integer@{\integer}}
+\begin{center}
+\begin{tabular}{r@{\quad::=\quad}l}
+{\digit} & {\tt 0..9} \\
+{\num} & \nelistwithoutblank{\digit}{} \\
+{\integer} & \zeroone{\tt -}{\num} \\
+\end{tabular}
+\end{center}
+
+\paragraph{Strings}
+\label{strings}
+\index{string@{\qstring}}
+Strings are delimited by \verb!"! (double quote), and enclose a
+sequence of any characters different from \verb!"! or the sequence
+\verb!""! to denote the double quote character. In grammars, the
+entry for quoted strings is {\qstring}.
+
+\paragraph{Keywords}
+The following identifiers are reserved keywords, and cannot be
+employed otherwise:
+\begin{center}
+\begin{tabular}{llllll}
+\verb!_!          &
+\verb!as!         &
+\verb!at!         &
+\verb!cofix!      &
+\verb!else!       &
+\verb!end!        \\
+%
+\verb!exists!     &
+\verb!exists2!    &
+\verb!fix!        &
+\verb!for!        &
+\verb!forall!     &
+\verb!fun!        \\
+%
+\verb!if!         &
+\verb!IF!         &
+\verb!in!         &
+\verb!let!        &
+\verb!match!      &
+\verb!mod!        \\
+%
+\verb!Prop!       &
+\verb!return!     &
+\verb!Set!        &
+\verb!then!       &
+\verb!Type!       &
+\verb!using!      \\
+%
+\verb!where!      &
+\verb!with!       &
+\end{tabular}
+\end{center}
+
+
+\paragraph{Special tokens}
+The following sequences of characters are special tokens:
+\begin{center}
+\begin{tabular}{lllllll}
+\verb/!/   &
+\verb!%!  &
+\verb!&!   &
+\verb!&&!  &
+\verb!(!   &
+\verb!()!  &
+\verb!)!   \\
+%
+\verb!*!   &
+\verb!+!   &
+\verb!++!  &
+\verb!,!   &
+\verb!-!   &
+\verb!->!  &
+\verb!.!   \\
+%
+\verb!.(!  &
+\verb!..!  &
+\verb!/!   &
+\verb!/\!  &
+\verb!:!   &
+\verb!::!  &
+\verb!:<!  \\
+%
+\verb!:=!  &
+\verb!:>!  &
+\verb!;!   &
+\verb!<!   &
+\verb!<-!  &
+\verb!<->! &
+\verb!<:!  \\
+%
+\verb!<=!  &
+\verb!<>!  &
+\verb!=!   &
+\verb!=>!  &
+\verb!=_D! &
+\verb!>!   &
+\verb!>->! \\
+%
+\verb!>=!  &
+\verb!?!   &
+\verb!?=!  &
+\verb!@!   &
+\verb![!   &
+\verb!\/!  &
+\verb!]!   \\
+%
+\verb!^!   &
+\verb!{!   &
+\verb!|!   &
+\verb!|-!  &
+\verb!||!  &
+\verb!}!   &
+\verb!~!   \\
+\end{tabular}
+\end{center}
+
+Lexical ambiguities are resolved according to the ``longest match''
+rule: when a sequence of non alphanumerical characters can be decomposed
+into several different ways, then the first token is the longest
+possible one (among all tokens defined at this moment), and so on.
+
+\section{Terms \label{term}\index{Terms}}
+
+\subsection{Syntax of terms}
+
+Figures \ref{term-syntax} and \ref{term-syntax-aux} describe the basic
+set of terms which form the {\em Calculus of Inductive Constructions}
+(also called \CIC). The formal presentation of {\CIC} is given in
+chapter \ref{Cic}. Extensions of this syntax are given in chapter
+\ref{Gallina-extension}. How to customize the syntax is described in
+chapter \ref{Addoc-syntax}.
+
+\begin{figure}[htbp]
+\begin{centerframe}
+\begin{tabular}{lcl@{\qquad}r}
+{\term} & ::= &
+         {\tt forall} {\binderlist} {\tt ,} {\term}  &(\ref{products})\\
+ & $|$ & {\tt fun} {\binderlist} {\tt =>} {\term} &(\ref{abstractions})\\
+ & $|$ & {\tt fix} {\fixpointbodies} &(\ref{fixpoints})\\
+ & $|$ & {\tt cofix} {\cofixpointbodies} &(\ref{fixpoints})\\
+ & $|$ & {\tt let} {\idparams} {\tt :=} {\term}
+         {\tt in} {\term} &(\ref{let-in})\\
+ & $|$ & {\tt let fix} {\fixpointbody} {\tt in} {\term} &(\ref{fixpoints})\\
+ & $|$ & {\tt let cofix} {\cofixpointbody}
+         {\tt in} {\term} &(\ref{fixpoints})\\
+ & $|$ & {\tt let} {\tt (} \sequence{\name}{,} {\tt )} \zeroone{\ifitem}
+         {\tt :=} {\term}
+         {\tt in} {\term}  &(\ref{caseanalysis}, \ref{Mult-match})\\
+ & $|$ & {\tt if} {\term} \zeroone{\ifitem} {\tt then} {\term}
+         {\tt else} {\term} &(\ref{caseanalysis}, \ref{Mult-match})\\
+ & $|$ & {\term} {\tt :} {\term} &(\ref{typecast})\\
+ & $|$ & {\term} {\tt ->} {\term} &(\ref{products})\\
+ & $|$ & {\term} \nelist{\termarg}{}&(\ref{applications})\\
+ & $|$ & {\tt @} {\qualid} \sequence{\term}{}
+            &(\ref{Implicits-explicitation})\\
+ & $|$ & {\term} {\tt \%} {\ident} &(\ref{scopechange})\\
+ & $|$ & {\tt match} \nelist{\caseitem}{\tt ,}
+                 \zeroone{\returntype} {\tt with} &\\
+    &&   ~~~\zeroone{\zeroone{\tt |} \nelist{\eqn}{|}} {\tt end}
+    &(\ref{caseanalysis})\\
+ & $|$ & {\qualid} &(\ref{qualid})\\
+ & $|$ & {\sort} &(\ref{Gallina-sorts})\\
+ & $|$ & {\num} &(\ref{numerals})\\
+ & $|$ & {\_} &(\ref{hole})\\
+ & & &\\
+{\termarg} & ::= & {\term} &\\
+ & $|$ & {\tt (} {\ident} {\tt :=} {\term} {\tt )}
+         &(\ref{Implicits-explicitation})\\
+%% & $|$ & {\tt (} {\num} {\tt :=} {\term} {\tt )}
+%%         &(\ref{Implicits-explicitation})\\
+&&&\\
+{\binderlist} & ::= & \nelist{\name}{} {\typecstr} & \ref{Binders} \\
+ & $|$ & {\binder} \nelist{\binderlet}{} &\\
+&&&\\
+{\binder} & ::= &   {\name} & \ref{Binders} \\
+ & $|$ & {\tt (} \nelist{\name}{} {\tt :} {\term} {\tt )} &\\  
+&&&\\
+{\binderlet} & ::= & {\binder} & \ref{Binders} \\
+ & $|$ & {\tt (} {\name} {\typecstr} {\tt :=} {\term} {\tt )} &\\
+& & &\\
+{\name} & ::= & {\ident} &\\
+ & $|$ & {\tt \_} &\\
+&&&\\
+{\qualid} & ::= & {\ident} & \\
+ & $|$ & {\qualid} {\accessident} &\\
+ & & &\\
+{\sort} & ::= & {\tt Prop} ~$|$~ {\tt Set} ~$|$~ {\tt Type} &
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of terms}
+\label{term-syntax}
+\index{term@{\term}}
+\index{sort@{\sort}}
+\end{figure}
+
+
+
+\begin{figure}[htb]
+\begin{centerframe}
+\begin{tabular}{lcl}
+{\idparams} & ::= &  {\ident} \sequence{\binderlet}{} {\typecstr} \\
+&&\\
+{\fixpointbodies} & ::= &
+         {\fixpointbody} \\
+ & $|$ & {\fixpointbody} {\tt with} \nelist{\fixpointbody}{{\tt with}}
+         {\tt for} {\ident} \\
+{\cofixpointbodies} & ::= &
+         {\cofixpointbody} \\
+ & $|$ & {\cofixpointbody} {\tt with} \nelist{\cofixpointbody}{{\tt with}}
+         {\tt for} {\ident} \\
+&&\\
+{\fixpointbody} & ::= &
+    {\ident} \nelist{\binderlet}{} \zeroone{\annotation} {\typecstr}
+    {\tt :=} {\term} \\
+{\cofixpointbody} & ::= & {\idparams} {\tt :=} {\term} \\
+  & &\\
+{\annotation} & ::= & {\tt \{ struct} {\ident} {\tt \}} \\ 
+&&\\
+{\caseitem} & ::= & {\term} \zeroone{{\tt as} \name}
+     \zeroone{{\tt in} \term} \\
+&&\\
+{\ifitem} & ::= & \zeroone{{\tt as} {\name}} {\returntype} \\
+&&\\
+{\returntype} & ::= & {\tt return} {\term} \\
+&&\\
+{\eqn} & ::= & \nelist{\pattern}{\tt ,} {\tt =>} {\term}\\
+&&\\
+{\pattern} & ::= & {\qualid} \nelist{\pattern}{}  \\
+ & $|$ & {\pattern} {\tt as} {\ident}             \\
+ & $|$ & {\pattern} {\tt \%} {\ident}         \\
+ & $|$ & {\qualid}                              \\
+ & $|$ & {\tt \_}                                  \\
+ & $|$ & {\num}                                 \\
+ & $|$ & {\tt (} \nelist{\pattern}{,} {\tt )}     
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of terms (continued)}
+\label{term-syntax-aux}
+\end{figure}
+
+
+%%%%%%%
+
+\subsection{Types}
+
+{\Coq} terms are typed. {\Coq} types are recognized by the same
+syntactic class as {\term}. We denote by {\type} the semantic subclass
+of types inside the syntactic class {\term}.
+\index{type@{\type}}
+
+
+\subsection{Qualified identifiers and simple identifiers
+\label{qualid}
+\label{ident}}
+
+{\em Qualified identifiers} ({\qualid}) denote {\em global constants}
+(definitions, lemmas, theorems, remarks or facts), {\em global
+variables} (parameters or axioms), {\em inductive
+types} or {\em constructors of inductive types}.
+{\em Simple identifiers} (or shortly {\ident}) are a
+syntactic subset of qualified identifiers.  Identifiers may also
+denote local {\em variables}, what qualified identifiers do not.
+
+\subsection{Numerals
+\label{numerals}}
+
+Numerals have no definite semantics in the calculus. They are mere
+notations that can be bound to objects through the notation mechanism
+(see chapter~\ref{Addoc-syntax} for details). Initially, numerals are
+bound to Peano's representation of natural numbers
+(see~\ref{libnats}).
+
+Note: negative integers are not at the same level as {\num}, for this
+would make precedence unnatural.
+
+\subsection{Sorts 
+\index{Sorts}
+\index{Type@{\Type}}
+\index{Set@{\Set}}
+\index{Prop@{\Prop}}
+\index{Sorts}
+\label{Gallina-sorts}}
+
+There are three sorts \Set, \Prop\ and \Type.
+\begin{itemize}
+\item \Prop\ is the universe of {\em logical propositions}.
+The logical propositions themselves are typing the proofs.
+We denote propositions by {\form}. This constitutes a semantic
+subclass of the syntactic class {\term}.
+\index{form@{\form}}
+\item \Set\ is is the universe of {\em program
+types} or {\em specifications}.
+The specifications themselves are typing the programs.
+We denote specifications by {\specif}. This constitutes a semantic
+subclass of the syntactic class {\term}.
+\index{specif@{\specif}}
+\item {\Type} is the type of {\Set} and {\Prop}
+\end{itemize}
+\noindent More on sorts can be found in section \ref{Sorts}.
+
+\subsection{Binders
+\label{Binders}
+\index{binders}}
+
+Various constructions introduce variables which scope is some of its
+sub-expressions. There is a uniform syntax for this. A binder may be
+an (unqualified) identifier: the name to use to refer to this
+variable. If the variable is not to be used, its name can be {\tt
+\_}. When its type cannot be synthesized by the system, it can be
+specified with notation {\tt (}\,{\ident}\,{\tt :}\,{\type}\,{\tt
+)}. There is a notation for several variables sharing the same type:
+{\tt (}\,{\ident$_1$}\ldots{\ident$_n$}\,{\tt :}\,{\type}\,{\tt )}.
+
+Some constructions allow ``let-binders'', that is either a binder as
+defined above, or a variable with a value. The notation is {\tt
+(}\,{\ident}\,{\tt :=}\,{\term}\,{\tt )}. Only one variable can be
+introduced at the same time. It is also possible to give the type of
+the variable before the symbol {\tt :=}.
+
+The last kind of binders is the ``binder list''. It is either a list
+of let-binders (the first one not being a variable with value), or
+{\ident$_1$}\ldots{\ident$_n$}\,{\tt :}\,{\type} if all variables
+share the same type.
+
+{\Coq} terms are typed. {\Coq} types are recognized by the same
+syntactic class as {\term}. We denote by {\type} the semantic subclass
+of types inside the syntactic class {\term}.
+\index{type@{\type}}
+
+\subsection{Abstractions
+\label{abstractions}
+\index{abstractions}}
+
+The expression ``{\tt fun} {\ident} {\tt :} \type {\tt =>}~{\term}''
+denotes the {\em abstraction} of the variable {\ident} of type
+{\type}, over the term {\term}. Put in another way, it is function of
+formal parameter {\ident} of type {\type} returning {\term}.
+
+Keyword {\tt fun} is followed by a ``binder list'', so any of the
+binders of Section~\ref{Binders} apply. Internally, abstractions are
+only over one variable. Multiple variable binders are an iteration of
+the single variable abstraction: notation {\tt
+fun}~{\ident$_{1}$}~{\ldots}~{\ident$_{n}$}~{\tt :}~\type~{\tt
+=>}~{\term} stands for {\tt fun}~{\ident$_{1}$}~{\tt :}~\type~{\tt
+=>}~{\ldots}~{\tt fun}~{\ident$_{n}$}~{\tt :}~\type~{\tt =>}~{\term}.
+Variables with a value expand to a local definition (see
+Section~\ref{let-in}).
+
+\subsection{Products
+\label{products}
+\index{products}}
+
+The expression ``{\tt forall}~{\ident}~{\tt :}~\type~{\tt ,}~{\term}''
+denotes the {\em product} of the variable {\ident} of type {\type},
+over the term {\term}. As for abstractions, {\tt forall} is followed
+by a binder list, and it is represented by an iteration of single
+variable products.
+
+Non dependent product types have a special notation ``$A$ {\tt ->}
+$B$'' stands for ``{\tt forall \_:}$A${\tt ,}~$B$''. This is to stress
+on the fact that non dependent product types are usual functional types.
+
+\subsection{Applications
+\label{applications}
+\index{applications}}
+
+The expression \term$_0$ \term$_1$ denotes the application of
+  term \term$_0$ to \term$_1$.
+
+The expression {\tt }\term$_0$ \term$_1$ ...  \term$_n${\tt}
+denotes the application of the term \term$_0$ to the arguments
+\term$_1$ ... then \term$_n$.  It is equivalent to {\tt } {\ldots}
+{\tt (} {\term$_0$} {\term$_1$} {\tt )} {\ldots} {\term$_n$} {\tt }:
+associativity is to the left.
+
+When using implicit arguments mechanism, implicit positions can be
+forced a value with notation {\tt (}\,{\ident}\,{\tt
+:=}\,{\term}\,{\tt )} or {\tt (}\,{\num}\,{\tt
+:=}\,{\term}\,{\tt )}. See Section~\ref{Implicits-explicitation} for
+details.
+
+\subsection{Type cast
+\label{typecast}
+\index{Cast}}
+
+The expression ``{\term}~{\tt :}~{\type}'' is a type cast
+expression. It enforces the type of {\term} to be {\type}.
+
+\subsection{Inferable subterms
+\label{hole}
+\index{\_}}
+
+Since there are redundancies, a term can be type-checked without
+giving it in totality. Subterms that are left to guess by the
+type-checker are replaced by ``\_''.
+
+
+\subsection{Local definitions (let-in)
+\label{let-in}
+\index{Local definitions}
+\index{let-in}}
+
+
+{\tt let}~{\ident}~{\tt :=}~{\term$_1$}~{\tt in}~{\term$_2$} denotes
+the local binding of \term$_1$ to the variable $\ident$ in
+\term$_2$. 
+
+There is a syntactic sugar for local definition of functions: {\tt
+let} {\ident} {\binder$_1$} \ldots {\binder$_n$} {\tt :=} {\term$_1$}
+{\tt in} {\term$_2$} stands for {\tt let} {\ident} {\tt := fun}
+{\binder$_1$} \ldots {\binder$_n$} {\tt in} {\term$_2$}.
+
+
+\subsection{Definition by case analysis
+\label{caseanalysis}
+\index{match@{\tt match\ldots with\ldots end}}}
+
+
+This paragraph only shows simple variants of case analysis. See
+Section~\ref{Mult-match} and Chapter~\ref{Mult-match-full} for
+explanations of the general form.
+
+Objects of inductive types can be destructurated by a case-analysis
+construction, also called pattern-matching in functional languages. In
+its simple form, a case analysis expression is used to analyze the
+structure of an inductive objects (upon which constructor it is
+built).
+
+The expression {\tt match} {\term$_0$} {\returntype} {\tt with}
+{\pattern$_1$} {\tt =>} {\term$_1$} {\tt $|$} {\ldots} {\tt $|$}
+{\pattern$_n$} {\tt =>} {\term$_n$} {\tt end}, denotes a {\em
+pattern-matching} over the term {\term$_0$} (expected to be of an
+inductive type $I$). {\term$_1$}\ldots{\term$_n$} are called branches. In
+a simple pattern \qualid~\nelist{\ident}{}, the qualified identifier
+{\qualid} is intended to
+be a constructor. There should be a branch for every constructor of
+$I$.
+
+The {\returntype} is used to compute the resulting type of the whole
+{\tt match} expression and the type of the branches. Most of the time,
+when this type is the same as the types of all the {\term$_i$}, the
+annotation is not needed\footnote{except if no equation is given, to
+match the term in an empty type, e.g. the type \texttt{False}}. This
+annotation has to be given when the resulting type of the whole {\tt
+match} depends on the actual {\term$_0$} matched.
+
+There are specific notations for case analysis on types with one or
+two constructors: {\tt if / then / else} and
+{\tt let (}\ldots{\tt ) :=} \ldots {\tt in}\ldots. \SeeAlso
+section~\ref{Mult-match} for details and examples.
+
+\SeeAlso Section~\ref{Mult-match} for details and examples.
+
+\subsection{Recursive functions
+\label{fixpoints}
+\index{fix@{fix \ident$_i$\{\dots\}}}}
+
+Expression ``{\tt fix} \ident$_1$ \binder$_1$ {\tt :} {\type$_1$}
+\texttt{:=} \term$_1$ {\tt with} {\ldots} {\tt with} \ident$_n$
+\binder$_n$~{\tt :} {\type$_n$} \texttt{:=} \term$_n$ {\tt for}
+{\ident$_i$}'' denotes the $i$th component of a block of functions
+defined by mutual well-founded recursion. It is the local counterpart
+of the {\tt Fixpoint} command. See Section~\ref{Fixpoint} for more
+details. When $n=1$, the {\tt for}~{\ident$_i$} is omitted.
+
+The expression ``{\tt cofix} \ident$_1$~\binder$_1$ {\tt :}
+{\type$_1$} {\tt with} {\ldots} {\tt with} \ident$_n$ \binder$_n$ {\tt
+:} {\type$_n$}~{\tt for} {\ident$_i$}'' denotes the $i$th component of
+a block of terms defined by a mutual guarded co-recursion. It is the
+local counterpart of the {\tt CoFixpoint} command. See
+Section~\ref{CoFixpoint} for more details. When $n=1$, the {\tt
+for}~{\ident$_i$} is omitted.
+
+The association of a single fixpoint and a local
+definition have a special syntax: ``{\tt let fix}~$f$~{\ldots}~{\tt
+  :=}~{\ldots}~{\tt in}~{\ldots}'' stands for ``{\tt let}~$f$~{\tt :=
+  fix}~$f$~\ldots~{\tt :=}~{\ldots}~{\tt in}~{\ldots}''. The same
+  applies for co-fixpoints.
+
+
+\section{The Vernacular
+\label{Vernacular}}
+
+\begin{figure}[tbp]
+\begin{centerframe}
+\begin{tabular}{lcl}
+{\sentence} & ::= & {\declaration} \\
+            & $|$ & {\definition} \\
+            & $|$ & {\inductive} \\
+            & $|$ & {\fixpoint} \\
+            & $|$ & {\statement} \zeroone{\proof} \\
+&&\\
+%% Declarations
+{\declaration} & ::= & {\declarationkeyword} {\assums} {\tt .} \\
+&&\\
+{\declarationkeyword} & ::= & {\tt Axiom} $|$ {\tt Conjecture} \\
+  & $|$  & {\tt Parameter} $|$  {\tt Parameters} \\
+  & $|$  & {\tt Variable}  $|$ {\tt Variables}  \\
+  & $|$  & {\tt Hypothesis}  $|$ {\tt Hypotheses}\\
+&&\\
+{\assums} & ::= & \nelist{\ident}{} {\tt :} {\term} \\
+          & $|$ & \nelist{\binder}{} \\
+&&\\
+%% Definitions
+{\definition} & ::= & 
+         {\tt Definition} {\idparams} {\tt :=} {\term} {\tt .} \\
+ & $|$ & {\tt Let} {\idparams} {\tt :=} {\term} {\tt .} \\
+&&\\
+%% Inductives
+{\inductive} & ::= & 
+           {\tt Inductive} \nelist{\inductivebody}{with} {\tt .} \\
+ & $|$ & {\tt CoInductive} \nelist{\inductivebody}{with} {\tt .} \\
+           & & \\
+{\inductivebody} & ::= & 
+  {\ident} \sequence{\binderlet}{} {\tt :} {\term} {\tt :=} \\
+   && ~~~\zeroone{\zeroone{\tt |} \nelist{\idparams}{|}} \\
+           & & \\  %% TODO: where ...
+%% Fixpoints
+{\fixpoint} & ::= & {\tt Fixpoint} \nelist{\fixpointbody}{with} {\tt .} \\
+       & $|$ &  {\tt CoFixpoint} \nelist{\cofixpointbody}{with} {\tt .} \\
+&&\\
+%% Lemmas & proofs
+{\statement} & ::= &
+  {\statkwd} {\ident} \sequence{\binderlet}{} {\tt :} {\term} {\tt .} \\
+&&\\
+  {\statkwd} & ::= & {\tt Theorem} $|$ {\tt Lemma} $|$ {\tt Definition} \\
+&&\\
+{\proof} & ::= & {\tt Proof} {\tt .} {\dots} {\tt Qed} {\tt .}\\
+   & $|$ & {\tt Proof} {\tt .} {\dots} {\tt Defined} {\tt .}\\
+   & $|$ & {\tt Proof} {\tt .} {\dots} {\tt Admitted} {\tt .}
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of sentences}
+\label{sentences-syntax}
+\end{figure}
+
+Figure \ref{sentences-syntax} describes {\em The Vernacular} which is the
+language of commands of \gallina.  A sentence of the vernacular
+language, like in many natural languages, begins with a capital letter
+and ends with a dot.
+
+The different kinds of command are described hereafter. They all suppose
+that the terms occurring in the sentences are well-typed.
+
+%%
+%% Axioms and Parameters
+%%
+\subsection{Declarations
+\index{Declarations}
+\label{Declarations}}
+
+The declaration mechanism allows the user to specify his own basic
+objects. Declared objects play the role of axioms or parameters in
+mathematics. A declared object is an {\ident} associated to a \term. A
+declaration is accepted by {\Coq} if and only if this {\term} is a
+correct type in the current context of the declaration and \ident\ was
+not previously defined in the same module. This {\term} is considered
+to be the type, or specification, of the \ident.
+
+\subsubsection{{\tt Axiom {\ident} :{\term} .}
+\comindex{Axiom}
+\comindex{Parameter}\comindex{Parameters}
+\comindex{Conjecture}
+\label{Axiom}}
+
+This command links {\term} to the name {\ident} as its specification
+in the global context. The fact asserted by {\term} is thus assumed as
+a postulate.
+
+\begin{ErrMsgs}
+\item \errindex{{\ident} already exists}
+\end{ErrMsgs}
+
+\begin{Variants} 
+\item {\tt Parameter {\ident} :{\term}.} \\
+  Is equivalent to {\tt Axiom {\ident} : {\term}}
+
+\item {\tt Parameter {\ident$_1$}\ldots{\ident$_n$} {\tt :}{\term}.}\\
+  Adds $n$ parameters with specification {\term}
+
+\item
+ {\tt Parameter\,%
+(\,{\ident$_{1,1}$}\ldots{\ident$_{1,k_1}$}\,{\tt :}\,{\term$_1$} {\tt )}\,%
+\ldots\,{\tt (}\,{\ident$_{n,1}$}\ldots{\ident$_{n,k_n}$}\,{\tt :}\,%
+{\term$_n$} {\tt )}.}\\ 
+  Adds $n$ blocks of parameters with different specifications.
+
+\item {\tt Conjecture {\ident} :{\term}.}\\
+  Is equivalent to {\tt Axiom {\ident} : {\term}}.
+\end{Variants}
+
+\noindent {\bf Remark: } It is possible to replace {\tt Parameter} by
+{\tt Parameters}.
+
+
+\subsubsection{{\tt Variable {\ident} :{\term}}.
+\comindex{Variable}
+\comindex{Variables}
+\comindex{Hypothesis}
+\comindex{Hypotheses}}
+
+This command links {\term} to the name {\ident} in the context of the
+current section (see Section~\ref{Section} for a description of the section
+mechanism). When the current section is closed, name {\ident} will be
+unknown and every object using this variable will be explicitly
+parameterized (the variable is {\em discharged}). Using the {\tt
+Variable} command out of any section is equivalent to {\tt Axiom}.
+
+\begin{ErrMsgs}
+\item \errindex{{\ident} already exists}
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt Variable {\ident$_1$}\ldots{\ident$_n$} {\tt :}{\term}.}\\
+  Links {\term} to names {\ident$_1$}\ldots{\ident$_n$}.
+\item
+ {\tt Variable\,%
+(\,{\ident$_{1,1}$}\ldots{\ident$_{1,k_1}$}\,{\tt :}\,{\term$_1$} {\tt )}\,%
+\ldots\,{\tt (}\,{\ident$_{n,1}$}\ldots{\ident$_{n,k_n}$}\,{\tt :}\,%
+{\term$_n$} {\tt )}.}\\ 
+  Adds $n$ blocks of variables with different specifications.
+\item {\tt Hypothesis {\ident} {\tt :}{\term}.} \\
+  \texttt{Hypothesis} is a synonymous of \texttt{Variable}
+\end{Variants}
+
+\noindent {\bf Remark: } It is possible to replace {\tt Variable} by
+{\tt Variables} and {\tt Hypothesis} by {\tt Hypotheses}.
+
+It is advised to use the keywords \verb:Axiom: and \verb:Hypothesis:
+for logical postulates (i.e. when the assertion {\term} is of sort
+\verb:Prop:), and to use the keywords \verb:Parameter: and
+\verb:Variable: in other cases (corresponding to the declaration of an
+abstract mathematical entity).
+
+%%
+%% Definitions
+%%
+\subsection{Definitions
+\index{Definitions}
+\label{Simpl-definitions}}
+
+Definitions differ from declarations in allowing to give a name to a
+term whereas declarations were just giving a type to a name. That is
+to say that the name of a defined object can be replaced at any time
+by its definition.  This replacement is called
+$\delta$-conversion\index{delta-reduction@$\delta$-reduction} (see
+Section~\ref{delta}).  A defined object is accepted by the system if
+and only if the defining term is well-typed in the current context of
+the definition.  Then the type of the name is the type of term. The
+defined name is called a {\em constant}\index{Constant} and one says
+that {\it the constant is added to the
+environment}\index{Environment}.
+
+A formal presentation of constants and environments is given in
+Section~\ref{Typed-terms}.
+
+\subsubsection{\tt Definition {\ident} := {\term}.
+\comindex{Definition}}
+
+This command binds the value {\term} to the name {\ident} in the
+environment, provided that {\term} is well-typed.
+
+\begin{ErrMsgs}
+\item \errindex{{\ident} already exists}
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt Definition {\ident} {\tt :}{\term$_1$} := {\term$_2$}.}\\
+  It checks that the type of {\term$_2$} is definitionally equal to
+  {\term$_1$}, and registers {\ident} as being of type {\term$_1$},
+  and bound to value {\term$_2$}.
+\item {\tt Definition {\ident} {\binder$_1$}\ldots{\binder$_n$}
+       {\tt :}\term$_1$ {\tt :=} {\term$_2$}.}\\
+  This is equivalent to \\
+   {\tt Definition\,{\ident}\,{\tt :\,forall}\,%
+       {\binder$_1$}\ldots{\binder$_n$}{\tt ,}\,\term$_1$\,{\tt :=}}\,%
+       {\tt fun}\,{\binder$_1$}\ldots{\binder$_n$}\,{\tt =>}\,{\term$_2$}\,%
+       {\tt .}
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{In environment {\dots} the term: {\term$_2$} does not have type
+    {\term$_1$}}.\\
+    \texttt{Actually, it has type {\term$_3$}}.
+\end{ErrMsgs}
+
+\SeeAlso Sections \ref{Opaque}, \ref{Transparent}, \ref{unfold}
+
+\subsubsection{\tt Let {\ident} := {\term}.
+\comindex{Let}}
+
+This command binds the value {\term} to the name {\ident} in the
+environment of the current section. The name {\ident} disappears
+when the current section is eventually closed, and, all
+persistent objects (such as theorems) defined within the
+section and depending on {\ident} are prefixed by the local definition
+{\tt let {\ident} := {\term} in}.
+
+\begin{ErrMsgs}
+\item \errindex{{\ident} already exists}
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt Let {\ident} : {\term$_1$} := {\term$_2$}.}
+\end{Variants}
+
+\SeeAlso Sections \ref{Section} (section mechanism), \ref{Opaque},
+\ref{Transparent} (opaque/transparent constants), \ref{unfold}
+
+%%
+%% Inductive Types
+%%
+\subsection{Inductive definitions
+\index{Inductive definitions} 
+\label{gal_Inductive_Definitions}
+\comindex{Inductive}
+\label{Inductive}}
+
+We gradually explain simple inductive types, simple
+annotated inductive types, simple parametric inductive types, 
+mutually inductive types. We explain also co-inductive types.
+
+\subsubsection{Simple inductive types}
+
+The definition of a simple inductive type has the following form:
+
+\medskip
+{\tt 
+\begin{tabular}{l}
+Inductive {\ident} : {\sort} :=  \\
+\begin{tabular}{clcl}
+   & {\ident$_1$}  &:& {\type$_1$} \\
+ | & {\ldots} && \\
+ | & {\ident$_n$} &:& {\type$_n$}
+\end{tabular}
+\end{tabular}
+}
+\medskip
+
+The name {\ident} is the name of the inductively defined type and
+{\sort} is the universes where it lives.
+The names {\ident$_1$}, {\ldots}, {\ident$_n$}
+are the names of its constructors and {\type$_1$}, {\ldots},
+{\type$_n$} their respective types. The types of the constructors have
+to satisfy a {\em positivity condition} (see Section~\ref{Positivity})
+for {\ident}.  This condition ensures the soundness of the inductive
+definition.  If this is the case, the constants {\ident},
+{\ident$_1$}, {\ldots}, {\ident$_n$} are added to the environment with
+their respective types.  Accordingly to the universe where
+the inductive type lives ({\it e.g.} its type {\sort}), {\Coq} provides a
+number of destructors for {\ident}.  Destructors are named
+{\ident}{\tt\_ind}, {\ident}{\tt \_rec} or {\ident}{\tt \_rect} which
+respectively correspond to elimination principles on {\tt Prop}, {\tt
+Set} and {\tt Type}.  The type of the destructors expresses structural
+induction/recursion principles over objects of {\ident}. We give below
+two examples of the use of the {\tt Inductive} definitions.
+
+The set of natural numbers is defined as:
+\begin{coq_example}
+Inductive nat : Set :=
+  | O : nat
+  | S : nat -> nat.
+\end{coq_example}
+
+The type {\tt nat} is defined as the least \verb:Set: containing {\tt
+  O} and closed by the {\tt S} constructor. The constants {\tt nat},
+{\tt O} and {\tt S} are added to the environment.
+
+Now let us have a look at the elimination principles. They are three :
+{\tt nat\_ind}, {\tt nat\_rec} and {\tt nat\_rect}.  The type of {\tt
+  nat\_ind} is:
+\begin{coq_example}
+Check nat_ind.
+\end{coq_example}
+
+This is the well known structural induction principle over natural
+numbers, i.e. the second-order form of Peano's induction principle.
+It allows to prove some universal property of natural numbers ({\tt
+forall n:nat, P n}) by induction on {\tt n}.
+
+The types of {\tt nat\_rec} and {\tt nat\_rect} are similar, except
+that they pertain to {\tt (P:nat->Set)} and {\tt (P:nat->Type)}
+respectively . They correspond to primitive induction principles
+(allowing dependent types) respectively over sorts \verb:Set: and
+\verb:Type:. The constant {\ident}{\tt \_ind} is always provided,
+whereas {\ident}{\tt \_rec} and {\ident}{\tt \_rect} can be impossible
+to derive (for example, when {\ident} is a proposition).
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{Variants}
+\item 
+\begin{coq_example*}
+Inductive nat : Set := O | S (_:nat).
+\end{coq_example*}
+In the case where inductive types have no annotations (next section
+gives an example of such annotations), the positivity condition
+implies that a constructor can be defined by only giving the type of
+its arguments.
+\end{Variants}
+
+\subsubsection{Simple annotated inductive types}
+
+In an annotated inductive types, the universe where the inductive
+type is defined is no longer a simple sort, but what is called an
+arity, which is a type whose conclusion is a sort.
+
+As an example of annotated inductive types, let us define the
+$even$ predicate:
+
+\begin{coq_example}
+Inductive even : nat -> Prop :=
+  | even_0 : even O
+  | even_SS : forall n:nat, even n -> even (S (S n)).
+\end{coq_example}
+
+The type {\tt nat->Prop} means that {\tt even} is a unary predicate
+(inductively defined) over natural numbers.  The type of its two
+constructors are the defining clauses of the predicate {\tt even}. The
+type of {\tt even\_ind} is:
+
+\begin{coq_example}
+Check even_ind.
+\end{coq_example}
+
+From a mathematical point of view it asserts that the natural numbers
+satisfying the predicate {\tt even} are exactly the naturals satisfying
+the clauses {\tt even\_0} or {\tt even\_SS}. This is why, when we want
+to prove any predicate {\tt P} over elements of {\tt even}, it is
+enough to prove it for {\tt O} and to prove that if any natural number
+{\tt n} satisfies {\tt P} its double successor {\tt (S (S n))}
+satisfies also {\tt P}. This is indeed analogous to the structural
+induction principle we got for {\tt nat}.
+
+\begin{ErrMsgs}
+\item \errindex{Non strictly positive occurrence of {\ident} in {\type}}
+\item \errindex{The conclusion of {\type} is not valid; it must be
+built from {\ident}}
+\end{ErrMsgs}
+
+\subsubsection{Parameterized inductive types}
+
+Inductive types may be parameterized. Parameters differ from inductive
+type annotations in the fact that recursive invokations of inductive
+types must always be done with the same values of parameters as its
+specification.
+
+The general scheme is:
+\begin{center}
+{\tt Inductive} {\ident} {\binder$_1$}\ldots{\binder$_k$} : {\term} :=
+    {\ident$_1$}: {\term$_1$} | {\ldots} | {\ident$_n$}: \term$_n$
+{\tt .}
+\end{center}
+
+A typical example is the definition of polymorphic lists:
+\begin{coq_example*}
+Inductive list (A:Set) : Set :=
+  | nil : list A
+  | cons : A -> list A -> list A.
+\end{coq_example*}
+
+Note that in the type of {\tt nil} and {\tt cons}, we write {\tt
+  (list A)} and not just {\tt list}.\\ The constants {\tt nil} and
+{\tt cons} will have respectively types:
+
+\begin{coq_example}
+Check nil.
+Check cons.
+\end{coq_example}
+
+Types of destructors are also quantified with {\tt (A:Set)}.
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{Variants}
+\item
+\begin{coq_example*}
+Inductive list (A:Set) : Set := nil | cons (_:A) (_:list A).
+\end{coq_example*}
+This is an alternative definition of lists where we specify the
+arguments of the constructors rather than their full type.
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{The {\num}th argument of {\ident} must be {\ident'} in {\type}}
+\end{ErrMsgs}
+
+\SeeAlso Sections~\ref{Cic-inductive-definitions} and~\ref{elim}.
+
+
+\subsubsection{Mutually defined inductive types
+\comindex{Mutual Inductive}
+\label{Mutual-Inductive}}
+
+The definition of a block of mutually inductive types has the form:
+
+\medskip
+{\tt 
+\begin{tabular}{l}
+Inductive {\ident$_1$} : {\type$_1$} :=  \\
+\begin{tabular}{clcl}
+   & {\ident$_1^1$}     &:& {\type$_1^1$} \\
+ | & {\ldots} && \\
+ | & {\ident$_{n_1}^1$} &:& {\type$_{n_1}^1$}
+\end{tabular}  \\
+with\\
+~{\ldots} \\
+with {\ident$_m$} : {\type$_m$} := \\
+\begin{tabular}{clcl}
+   & {\ident$_1^m$}     &:& {\type$_1^m$} \\
+ | & {\ldots} \\
+ | & {\ident$_{n_m}^m$} &:& {\type$_{n_m}^m$}.
+\end{tabular}
+\end{tabular}
+}
+\medskip
+
+\noindent It has the same semantics as the above {\tt Inductive}
+definition for each \ident$_1$, {\ldots}, \ident$_m$. All names
+\ident$_1$, {\ldots}, \ident$_m$ and \ident$_1^1$, \dots,
+\ident$_{n_m}^m$ are simultaneously added to the environment. Then
+well-typing of constructors can be checked. Each one of the
+\ident$_1$, {\ldots}, \ident$_m$ can be used on its own.
+
+It is also possible to parameterize these inductive definitions.
+However, parameters correspond to a local
+context in which the whole set of inductive declarations is done.  For
+this reason, the parameters must be strictly the same for each
+inductive types The extended syntax is:
+
+\medskip
+{\tt 
+Inductive {{\ident$_1$} {\params} : {\type$_1$} :=  \\
+\mbox{}\hspace{0.4cm}  {\ident$_1^1$} : {\type$_1^1$} \\
+\mbox{}\hspace{0.1cm}| ..  \\
+\mbox{}\hspace{0.1cm}| {\ident$_{n_1}^1$} : {\type$_{n_1}^1$}  \\
+with\\
+\mbox{}\hspace{0.1cm} .. \\
+with {\ident$_m$} {\params} : {\type$_m$} := \\
+\mbox{}\hspace{0.4cm}{\ident$_1^m$} : {\type$_1^m$} \\
+\mbox{}\hspace{0.1cm}| .. \\
+\mbox{}\hspace{0.1cm}| {\ident$_{n_m}^m$} : {\type$_{n_m}^m$}.
+}}
+\medskip
+
+\Example
+The typical example of a mutual inductive data type is the one for
+trees and forests. We assume given two types $A$ and $B$ as variables.
+It can be declared the following way.
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example*}
+Variables A B : Set.
+Inductive tree : Set :=
+    node : A -> forest -> tree
+with forest : Set :=
+  | leaf : B -> forest
+  | cons : tree -> forest -> forest.
+\end{coq_example*}
+
+This declaration generates automatically six induction
+principles. They are respectively 
+called {\tt tree\_rec}, {\tt tree\_ind}, {\tt
+  tree\_rect}, {\tt forest\_rec}, {\tt forest\_ind}, {\tt
+  forest\_rect}.  These ones are not the most general ones but are
+just the induction principles corresponding to each inductive part
+seen as a single inductive definition.
+
+To illustrate this point on our example, we give the types of {\tt
+  tree\_rec} and {\tt forest\_rec}.
+
+\begin{coq_example}
+Check tree_rec.
+Check forest_rec.
+\end{coq_example}
+
+Assume we want to parameterize our mutual inductive definitions with
+the two type variables $A$ and $B$, the declaration should be done the
+following way:
+
+\begin{coq_eval}
+Reset tree.
+\end{coq_eval}
+\begin{coq_example*}
+Inductive tree (A B:Set) : Set :=
+    node : A -> forest A B -> tree A B
+with forest (A B:Set) : Set :=
+  | leaf : B -> forest A B
+  | cons : tree A B -> forest A B -> forest A B.
+\end{coq_example*}
+
+Assume we define an inductive definition inside a section.  When the
+section is closed, the variables declared in the section and occurring
+free in the declaration are added as parameters to the inductive
+definition. 
+
+\SeeAlso Section~\ref{Section}
+
+\subsubsection{Co-inductive types
+\label{CoInductiveTypes}
+\comindex{CoInductive}}
+
+The objects of an inductive type are well-founded with respect to the
+constructors of the type. In other words, such objects contain only a
+{\it finite} number constructors. Co-inductive types arise from
+relaxing this condition, and admitting types whose objects contain an
+infinity of constructors. Infinite objects are introduced by a
+non-ending (but effective) process of construction, defined in terms
+of the constructors of the type.
+
+An example of a co-inductive type is the type of infinite sequences of
+natural numbers, usually called streams. It can be introduced in \Coq\
+using the \texttt{CoInductive} command:
+\begin{coq_example}
+CoInductive Stream : Set :=
+    Seq : nat -> Stream -> Stream.
+\end{coq_example}
+
+The syntax of this command is the same as the command \texttt{Inductive}
+(cf. Section~\ref{gal_Inductive_Definitions}). Notice that no
+principle of induction is derived from the definition of a
+co-inductive type, since such principles only make sense for inductive
+ones. For co-inductive ones, the only elimination principle is case
+analysis. For example, the usual destructors on streams
+\texttt{hd:Stream->nat} and \texttt{tl:Str->Str} can be defined as
+follows:
+\begin{coq_example}
+Definition hd (x:Stream) := let (a,s) := x in a.
+Definition tl (x:Stream) := let (a,s) := x in s.
+\end{coq_example}
+
+Definition of co-inductive predicates and blocks of mutually
+co-inductive definitions are also allowed. An example of a
+co-inductive predicate is the extensional equality on streams:
+
+\begin{coq_example}
+CoInductive EqSt : Stream -> Stream -> Prop :=
+    eqst :
+      forall s1 s2:Stream,
+        hd s1 = hd s2 -> EqSt (tl s1) (tl s2) -> EqSt s1 s2.
+\end{coq_example}
+
+In order to prove the extensionally equality of two streams $s_1$ and
+$s_2$ we have to construct and infinite proof of equality, that is,
+an infinite object of type $(\texttt{EqSt}\;s_1\;s_2)$. We will see
+how to introduce infinite objects in Section~\ref{CoFixpoint}.
+
+%%
+%% (Co-)Fixpoints
+%%
+\subsection{Definition of recursive functions}
+
+\subsubsection{\tt Fixpoint {\ident} {\params} {\tt \{struct}
+  \ident$_0$ {\tt \}} : type$_0$ := \term$_0$ 
+\comindex{Fixpoint}
+\label{Fixpoint}}
+
+This command allows to define inductive objects using a fixed point
+construction. The meaning of this declaration is to define {\it ident}
+a recursive function with arguments specified by
+{\binder$_1$}\ldots{\binder$_n$} such that {\it ident} applied to
+arguments corresponding to these binders has type \type$_0$, and is
+equivalent to the expression \term$_0$. The type of the {\ident} is
+consequently {\tt forall {\params} {\tt,} \type$_0$}
+and the value is equivalent to {\tt fun {\params} {\tt =>} \term$_0$}.
+
+To be accepted, a {\tt Fixpoint} definition has to satisfy some
+syntactical constraints on a special argument called the decreasing
+argument. They are needed to ensure that the {\tt Fixpoint} definition
+always terminates. The point of the {\tt \{struct \ident {\tt \}}}
+annotation is to let the user tell the system which argument decreases
+along the recursive calls. This annotation may be left implicit for
+fixpoints with one argument. For instance, one can define the addition
+function as :
+
+\begin{coq_example}
+Fixpoint add (n m:nat) {struct n} : nat :=
+  match n with
+  | O => m
+  | S p => S (add p m)
+  end.
+\end{coq_example}
+
+The {\tt match} operator matches a value (here \verb:n:) with the
+various constructors of its (inductive) type. The remaining arguments
+give the respective values to be returned, as functions of the
+parameters of the corresponding constructor. Thus here when \verb:n:
+equals \verb:O: we return \verb:m:, and when \verb:n: equals 
+\verb:(S p): we return \verb:(S (add p m)):.
+
+The {\tt match} operator is formally described
+in detail in Section~\ref{Caseexpr}.  The system recognizes that in
+the inductive call {\tt (add p m)} the first argument actually
+decreases because it is a {\em pattern variable} coming from {\tt match
+  n with}.
+
+\Example The following definition is not correct and generates an
+error message:
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is not correct and should produce **********)
+(*********      Error: Recursive call to wrongplus ...      **********)
+\end{coq_eval}
+\begin{coq_example}
+Fixpoint wrongplus (n m:nat) {struct n} : nat :=
+  match m with
+  | O => n
+  | S p => S (wrongplus n p)
+  end.
+\end{coq_example}
+
+because the declared decreasing argument {\tt n} actually does not
+decrease in the recursive call.  The function computing the addition
+over the second argument should rather be written:
+
+\begin{coq_example*}
+Fixpoint plus (n m:nat) {struct m} : nat :=
+  match m with
+  | O => n
+  | S p => S (plus n p)
+  end.
+\end{coq_example*}
+
+The ordinary match operation on natural numbers can be mimicked in the
+following way.
+\begin{coq_example*}
+Fixpoint nat_match 
+  (C:Set) (f0:C) (fS:nat -> C -> C) (n:nat) {struct n} : C :=
+  match n with
+  | O => f0
+  | S p => fS p (nat_match C f0 fS p)
+  end.
+\end{coq_example*}
+The recursive call may not only be on direct subterms of the recursive
+variable {\tt n} but also on a deeper subterm and we can directly
+write the function {\tt mod2} which gives the remainder modulo 2 of a
+natural number.
+\begin{coq_example*}
+Fixpoint mod2 (n:nat) : nat :=
+  match n with
+  | O => O
+  | S p => match p with
+           | O => S O
+           | S q => mod2 q
+           end
+  end.
+\end{coq_example*}
+In order to keep the strong normalisation property, the fixed point
+reduction will only be performed when the argument in position of the
+decreasing argument (which type should be in an inductive definition)
+starts with a constructor.
+
+The {\tt Fixpoint} construction enjoys also the {\tt with} extension
+to define functions over mutually defined inductive types or more
+generally any mutually recursive definitions.
+
+\begin{Variants}
+\item {\tt Fixpoint {\ident$_1$} {\params$_1$} :{\type$_1$} := {\term$_1$}\\
+        with {\ldots} \\
+        with {\ident$_m$} {\params$_m$} :{\type$_m$} :=  {\type$_m$}}\\
+        Allows to define simultaneously {\ident$_1$}, {\ldots},
+        {\ident$_m$}.
+\end{Variants}
+
+\Example 
+The size of trees and forests can be defined the following way: 
+\begin{coq_eval}
+Reset Initial.
+Variables A B : Set.
+Inductive tree : Set :=
+    node : A -> forest -> tree
+with forest : Set :=
+  | leaf : B -> forest
+  | cons : tree -> forest -> forest.
+\end{coq_eval}
+\begin{coq_example*}
+Fixpoint tree_size (t:tree) : nat :=
+  match t with
+  | node a f => S (forest_size f)
+  end
+ with forest_size (f:forest) : nat :=
+  match f with
+  | leaf b => 1
+  | cons t f' => (tree_size t + forest_size f')
+  end.
+\end{coq_example*}
+A generic command {\tt Scheme} is useful to build automatically various
+mutual induction principles. It is described in Section~\ref{Scheme}.
+
+\subsubsection{\tt CoFixpoint {\ident} : \type$_0$ := \term$_0$.
+\comindex{CoFixpoint}
+\label{CoFixpoint}}
+
+The {\tt CoFixpoint} command introduces a method for constructing an
+infinite object of a coinduc\-tive type. For example, the stream
+containing all natural numbers can be introduced applying the
+following method to the number \texttt{O} (see
+Section~\ref{CoInductiveTypes} for the definition of {\tt Stream},
+{\tt hd} and {\tt tl}):
+\begin{coq_eval}
+Reset Initial.
+CoInductive Stream : Set :=
+    Seq : nat -> Stream -> Stream.
+Definition hd (x:Stream) := match x with
+                            | Seq a s => a
+                            end.
+Definition tl (x:Stream) := match x with
+                            | Seq a s => s
+                            end.
+\end{coq_eval}
+\begin{coq_example}
+CoFixpoint from (n:nat) : Stream := Seq n (from (S n)).
+\end{coq_example}
+
+Oppositely to recursive ones, there is no decreasing argument in a
+co-recursive definition. To be admissible, a method of construction
+must provide at least one extra constructor of the infinite object for
+each iteration. A syntactical guard condition is imposed on
+co-recursive definitions in order to ensure this: each recursive call
+in the definition must be protected by at least one constructor, and
+only by constructors. That is the case in the former definition, where
+the single recursive call of \texttt{from} is guarded by an
+application of \texttt{Seq}. On the contrary, the following recursive
+function does not satisfy the guard condition:
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is not correct and should produce **********)
+(***************** Error: Unguarded recursive call *******************)
+\end{coq_eval}
+\begin{coq_example}
+CoFixpoint filter (p:nat -> bool) (s:Stream) : Stream :=
+  if p (hd s) then Seq (hd s) (filter p (tl s)) else filter p (tl s).
+\end{coq_example}
+
+The elimination of co-recursive definition is done lazily, i.e. the
+definition is expanded only when it occurs at the head of an
+application which is the argument of a case analysis expression.  In
+any other context, it is considered as a canonical expression which is
+completely evaluated. We can test this using the command
+\texttt{Eval}, which computes the normal forms of a term:
+
+\begin{coq_example}
+Eval compute in (from 0).
+Eval compute in (hd (from 0)).
+Eval compute in (tl (from 0)).
+\end{coq_example}
+
+\begin{Variants}
+\item{\tt CoFixpoint {\ident$_1$} {\params} :{\type$_1$} :=
+  {\term$_1$}}\\ As for most constructions, arguments of co-fixpoints
+  expressions can be introduced before the {\tt :=} sign.
+\item{\tt CoFixpoint {\ident$_1$} :{\type$_1$} := {\term$_1$}\\
+     with\\
+        \mbox{}\hspace{0.1cm} $\ldots$  \\
+        with {\ident$_m$}   : {\type$_m$} := {\term$_m$}}\\
+As in the \texttt{Fixpoint} command (cf. Section~\ref{Fixpoint}), it
+is possible to introduce a block of mutually dependent methods.
+\end{Variants}
+
+%%
+%% Theorems & Lemmas
+%%
+\subsection{Statement and proofs}
+
+A statement claims a goal of which the proof is then interactively done
+using tactics. More on the proof editing mode, statements and proofs can be
+found in chapter \ref{Proof-handling}.
+
+\subsubsection{\tt Theorem {\ident} : {\type}.
+\comindex{Theorem}
+\comindex{Lemma}
+\comindex{Remark}
+\comindex{Fact}}
+
+This command binds {\type} to the name {\ident} in the
+environment, provided that a proof of {\type} is next given.
+
+After a statement, {\Coq} needs a proof.
+
+\begin{Variants} 
+\item {\tt Lemma {\ident} : {\type}.}\\ 
+It is a synonymous of \texttt{Theorem}
+\item {\tt Remark {\ident} : {\type}.}\\ 
+It is a synonymous of \texttt{Theorem}
+% Same as {\tt Theorem} except
+% that if this statement is in one or more levels of sections then the
+% name {\ident} will be accessible only prefixed by the sections names
+% when the sections (see \ref{Section} and \ref{LongNames}) will be
+% closed.
+% %All proofs of  persistent objects (such as theorems) referring to {\ident}
+% %within the section will be replaced by the proof of  {\ident}.
+ \item {\tt Fact {\ident} : {\type}.}\\ 
+It is a synonymous of \texttt{Theorem}
+% Same as {\tt Remark} except
+% that the innermost section name is dropped from the full name.
+\item {\tt Definition {\ident} : {\type}.} \\
+Allow to define a term of type {\type} using the proof editing mode. It
+behaves as {\tt Theorem} but is intended for the interactive
+definition of expression which computational behaviour will be used by
+further commands. \SeeAlso~\ref{Transparent} and \ref{unfold}. 
+\end{Variants}
+
+\subsubsection{{\tt Proof} {\tt .} \dots {\tt Qed} {\tt .}
+\comindex{Proof}
+\comindex{Qed}
+\comindex{Defined}
+\comindex{Save}
+\comindex{Goal}
+\comindex{Admitted}}
+
+A proof starts by the keyword {\tt Proof}.  Then {\Coq} enters the
+proof editing mode until the proof is completed. The proof editing
+mode essentially contains tactics that are described in chapter
+\ref{Tactics}. Besides tactics, there are commands to manage the proof
+editing mode. They are described in chapter \ref{Proof-handling}. When
+the proof is completed it should be validated and put in the
+environment using the keyword {\tt Qed}.
+\medskip
+
+\ErrMsg
+\begin{enumerate}
+\item \errindex{{\ident} already exists}
+\end{enumerate}
+
+\begin{Remarks}
+\item Several statements can be simultaneously opened.
+\item Not only other statements but any vernacular command can be given
+within the proof editing mode. In this case, the command is
+understood as if it would have been given before the statements still to be
+proved. 
+\item {\tt Proof} is recommended but can currently be omitted. On the
+opposite, {\tt Qed} (or {\tt Defined}, see below) is mandatory to validate a proof.
+\item Proofs ended by {\tt Qed} are declared opaque (see \ref{Opaque})
+and cannot be unfolded by conversion tactics (see \ref{Conversion-tactics}).
+To be able to unfold a proof, you should end the proof by {\tt Defined}
+ (see below). 
+\end{Remarks}
+
+\begin{Variants}
+\item {\tt Proof} {\tt .} \dots {\tt Defined} {\tt .}\\
+  Same as {\tt Proof} {\tt .} \dots {\tt Qed} {\tt .} but the proof is
+  then declared transparent (see \ref{Transparent}), which means it
+  can be unfolded in conversion tactics (see \ref{Conversion-tactics}).
+\item {\tt Proof} {\tt .} \dots {\tt Save.}\\
+  Same as {\tt Proof} {\tt .} \dots {\tt Qed} {\tt .}
+\item {\tt Goal} \type \dots {\tt Save} \ident \\
+  Same as {\tt Lemma} \ident {\tt :} \type \dots {\tt Save.}
+  This is intended to be used in the interactive mode. Conversely to named
+  lemmas, anonymous goals cannot be nested.
+\item {\tt Proof.} \dots {\tt Admitted.}\\
+  Turns the current conjecture into an axiom and exits editing of
+  current proof.
+\end{Variants}
+
+% Local Variables: 
+% mode: LaTeX
+% TeX-master: "Reference-Manual"
+% End: 
+
+% $Id: RefMan-gal.tex 8606 2006-02-23 13:58:10Z herbelin $ 
diff --git a/doc/refman/RefMan-ide.tex b/doc/refman/RefMan-ide.tex
new file mode 100644
index 00000000..3c73c141
--- /dev/null
+++ b/doc/refman/RefMan-ide.tex
@@ -0,0 +1,327 @@
+\chapter{\Coq{} Integrated Development Environment}
+\label{Addoc-coqide}
+\ttindex{coqide}
+
+The \Coq{} Integrated Development Environment is a graphical tool, to
+be used as a user-friendly replacement to \texttt{coqtop}. Its main
+purpose is to allow the user to navigate forward and backward into a
+\Coq{} vernacular file, executing corresponding commands or undoing
+them respectively. % CREDITS ? Proof general, lablgtk, ...
+
+\CoqIDE{} is run by typing the command \verb|coqide| on the command
+line. Without argument, the main screen is displayed with an ``unnamed
+buffer'', and with a file name as argument, another buffer displaying
+the contents of that file. Additionally, coqide accepts the same
+options as coqtop, given in Chapter~\ref{Addoc-coqc}, the ones having
+obviously no meaning for \CoqIDE{} being ignored.
+
+\begin{figure}[t]
+\begin{center}
+%HEVEA\imgsrc{coqide.png}
+%BEGIN LATEX
+\ifpdf   % si on est en pdflatex
+\includegraphics[width=1.0\textwidth]{coqide.png}
+\else
+\includegraphics[width=1.0\textwidth]{coqide.eps}
+\fi
+%END LATEX
+\end{center}
+\caption{\CoqIDE{} main screen}
+\label{fig:coqide}
+\end{figure}
+
+A sample \CoqIDE{} main screen, while navigating into a file
+\verb|Fermat.v|, is shown on Figure~\ref{fig:coqide}.  At
+the top is a menu bar, and a tool bar below it. The large window on
+the left is displaying the various \emph{script buffers}. The upper right
+window is the \emph{goal window}, where goals to 
+prove are displayed. The lower right window is the \emph{message window},
+where various messages resulting from commands are displayed. At the
+bottom is the status bar.
+
+\section{Managing files and buffers, basic edition}
+
+In the script window, you may open arbitrarily many buffers to
+edit. The \emph{File} menu allows you to open files or create some,
+save them, print or export them into various formats. Among all these
+buffers, there is always one which is the current \emph{running
+  buffer}, whose name is displayed on a green background, which is the
+one where Coq commands are currently executed. 
+
+Buffers may be edited as in any text editor, and classical basic
+editing commands (Copy/Paste, \ldots) are available in the \emph{Edit}
+menu. \CoqIDE{} offers only basic editing commands, so if you need
+more complex editing commands, you may launch your favorite text
+editor on the current buffer, using the \emph{Edit/External Editor}
+menu. 
+
+\section{Interactive navigation into \Coq{} scripts}
+
+The running buffer is the one where navigation takes place. The
+toolbar proposes five basic commands for this. The first one,
+represented by a down arrow icon, is for going forward executing one
+command. If that command is successful, the part of the script that
+has been executed is displayed on a green background. If that command
+fails, the error message is displayed in the message window, and the
+location of the error is emphasized by a red underline.
+
+On Figure~\ref{fig:coqide}, the running buffer is \verb|Fermat.v|, all
+commands until the \verb|Theorem| have been already executed, and the
+user tried to go forward executing \verb|Induction n|. That command
+failed because no such tactic exist (tactics are now in
+lowercase\ldots), and the wrong word is underlined. 
+
+Notice that the green part of the running buffer is not editable. If
+you ever want to modify something you have to go backward using the up
+arrow tool, or even better, put the cursor where you want to go back
+and use the \textsf{goto} button. Unlike with \verb|coqtop|, you
+should never use \verb|Undo| to go backward.
+
+Two additional tool buttons exist, one to go directly to the end and
+one to go back to the beginning. If you try to go to the end, or in
+general to run several commands using the \textsf{goto} button, the
+  execution will stop whenever an error is found.
+
+If you ever try to execute a command which happens to run during a
+long time, and would like to abort it before its
+termination, you may use the interrupt button (the white cross on a red circle).
+ 
+Finally, notice that these navigation buttons are also available in
+the menu, where their keyboard shortcuts are given.
+
+\section{Try tactics automatically}
+\label{sec:trytactics}
+
+The menu \texttt{Try Tactics} provides some features for automatically
+trying to solve the current goal using simple tactics. If such a
+tactic succeeds in solving the goal, then its text is automatically
+inserted into the script. There is finally a combination of these
+tactics, called the \emph{proof wizard} which will try each of them in
+turn. This wizard is also available as a tool button (the light
+bulb).  The set of tactics tried by the wizard is customizable in
+the preferences.
+
+These tactics are general ones, in particular they do not refer to
+particular hypotheses. You may also try specific tactics related to
+the goal or one of the hypotheses, by clicking with the right mouse
+button one the goal or the considered hypothesis. This is the
+``contextual menu on goals'' feature, that may be disabled in the
+preferences if undesirable.
+ 
+\section{Vernacular commands, templates}
+
+The \texttt{Templates} menu allows to use shortcuts to insert
+vernacular commands. This is a nice way to proceed if you are not sure
+of the spelling of the command you want.
+
+Moreover, this menu offers some \emph{templates} which will automatic
+insert a complex command like Fixpoint with a convenient shape for its
+arguments. 
+
+\section{Queries}
+
+\begin{figure}[t]
+\begin{center}
+%HEVEA\imgsrc{coqide-queries.png}
+%BEGIN LATEX
+\ifpdf  % si on est en pdflatex
+\includegraphics[width=1.0\textwidth]{coqide-queries.png}
+\else
+\includegraphics[width=1.0\textwidth]{coqide-queries.eps}
+\fi
+%END LATEX
+\end{center}
+\caption{\CoqIDE{}: the query window}
+\label{fig:querywindow}
+\end{figure}
+
+
+We call \emph{query} any vernacular command that do not change the
+current state, such as \verb|Check|, \verb|SearchAbout|, etc. Those
+commands are of course useless during compilation of a file, hence
+should not be included in scripts. To run such commands without
+writing them in the script, \CoqIDE{} offers another input window
+called the \emph{query window}. This window can be displayed on
+demand, either by using the \texttt{Window} menu, or directly using
+shortcuts given in the \texttt{Queries} menu. Indeed, with \CoqIDE{}
+the simplest way to perform a \texttt{SearchAbout} on some identifier
+is to select it using the mouse, and pressing \verb|F2|. This will
+both make appear the query window and run the \texttt{SearchAbout} in
+it, displaying the result. Shortcuts \verb|F3| and \verb|F4| are for
+\verb|Check| and \verb|Print| respectively.
+Figure~\ref{fig:querywindow} displays the query window after selection
+of the word ``mult'' in the script windows, and pressing \verb|F4| to
+print its definition.
+
+\section{Compilation}
+
+The \verb|Compile| menu offers direct commands to:
+\begin{itemize}
+\item compile the current buffer
+\item run a compilation using \verb|make|
+\item go to the last compilation error
+\item create a \verb|makefile| using \verb|coq_makefile|.
+\end{itemize}
+
+\section{Customizations}
+
+You may customize your environment using menu
+\texttt{Edit/Preferences}. A new window will be displayed, with
+several customization sections presented as a notebook. 
+
+The first section is for selecting the text font used for scripts, goal
+and message windows. 
+
+The second section is devoted to file management: you may
+configure automatic saving of files, by periodically saving the
+contents into files named \verb|#f#| for each opened file
+\verb|f|. You may also activate the \emph{revert} feature: in case a
+opened file is modified on the disk by a third party, \CoqIDE{} may read
+it again for you. Note that in the case you edited that same file, you
+will be prompt to choose to either discard your changes or not. The
+\texttt{File charset encoding} choice is described below in
+Section~\ref{sec:coqidecharencoding}
+ 
+
+The \verb|Externals| section allows to customize the external commands
+for compilation, printing, web browsing. In the browser command, you
+may use \verb|%s| to denote the URL to open, for example: %
+\verb|mozilla -remote "OpenURL(%s)"|. 
+
+The \verb|Tactics Wizard| section allows to defined the set of tactics
+that should be tried, in sequence, to solve the current goal.
+
+The last section is for miscellaneous boolean settings, such as the
+``contextual menu on goals'' feature presented in
+Section~\ref{sec:trytactics}. 
+
+Notice that these settings are saved in the file \verb|.coqiderc| of
+your home directory. 
+
+A gtk2 accelerator keymap is saved under the name \verb|.coqide.keys|.
+This file should not be edited manually: to modify a given menu
+shortcut, go to the corresponding menu item without releasing the
+mouse button, press the key you want for the new shortcut, and release
+the mouse button afterwards.
+
+For experts: it is also possible to set up a specific gtk resource
+file, under the name \verb|.coqide-gtk2rc|, following the gtk2
+resources syntax
+\url{http://developer.gnome.org/doc/API/2.0/gtk/gtk-Resource-Files.html}.
+Such a default resource file exists in the \Coq{} library, you may
+copy this file into your home directory, and edit it using any text
+editor, \CoqIDE{} itself for example.
+
+\section{Using unicode symbols}
+
+\CoqIDE{} supports unicode character encoding in its text windows,
+consequently a large set of symbols is available for notations.
+
+\subsection{Displaying unicode symbols}
+
+You just need to define suitable notations as described in
+Chapter~\ref{Addoc-syntax}. For example, to use the mathematical symbols
+$\forall$ and $\exists$, you may define 
+\begin{quote}\tt
+Notation "$\forall$ x : t, P" := \\
+\qquad  (forall x:t, P) (at level 200, x ident).\\
+Notation "$\exists$ x : t, P" := \\
+\qquad  (exists x:t, P) (at level 200, x ident).
+\end{quote}
+There exists a small set of such notations already defined, in the
+file \verb|utf8.v| of \Coq{} library, so you may enable them just by 
+\verb|Require utf8| inside \CoqIDE{}, or equivalently, by starting
+\CoqIDE{} with \verb|coqide -l utf8|.
+
+However, there are some issues when using such unicode symbols: you of
+course need to use a character font which supports them. In the Fonts
+section of the preferences, the Preview line displays some unicode symbols, so
+you could figure out if the selected font is OK. Related to this, one
+thing you may need to do is choose whether Gtk should use antialiased
+fonts or not, by setting the environment variable \verb|GDK_USE_XFT|
+to 1 or 0 respectively.
+
+\subsection{Defining an input method for non ASCII symbols}
+
+To input an Unicode symbol, a general method is to press both the
+CONTROL and the SHIFT keys, and type the hexadecimal code of the
+symbol required, for example \verb|2200| for the $\forall$ symbol.
+A list of symbol codes is available at \url{http://www.unicode.org}. 
+
+Of course, this method is painful for symbols you use often. There is
+always the possibility to copy-paste a symbol already typed in.
+Another method is to bind some key combinations for frequently used
+symbols. For example, to bind keys \verb|F11| and \verb|F12| to
+$\forall$ and $\exists$ respectively, you may add
+\begin{quote}\tt
+  bind "F11" {"insert-at-cursor" ("$\forall$")}\\
+  bind "F12" {"insert-at-cursor" ("$\exists$")}
+\end{quote}
+to your \verb|binding "text"| section in \verb|.coqiderc-gtk2rc|.
+
+
+%  such a binding is system-dependent. We
+% give here a solution for X11:
+% \begin{itemize}
+% \item first, using \verb|xmodmap|, bind some key combination into a
+%   new key name such as Fxx where xx greater that 12: for example (on a
+%   french keyboard)
+%   \begin{quote}\tt
+%     xmodmap -e "keycode  24 = a A F13 F13" \\
+%     xmodmap -e "keycode  26 = e E F14 F14" 
+%   \end{quote}
+%   will rebind "<AltGr>a" to F13 and "<AltGr>e" to F14.
+% \item then add   
+%   \begin{quote}\tt
+%     bind "F13" {"insert-at-cursor" ("$\forall$")}\\
+%     bind "F14" {"insert-at-cursor" ("$\exists$")}
+%   \end{quote}
+%   to your \verb|binding "text"| section in \verb|.coqiderc-gtk2rc|.
+%        The strange \verb|∀| argument is the UTF-8 encoding for
+%        0x2200, that is the symbol $\forall$. Computing UTF-8 encoding
+%        for a unicode can be done in various ways, including
+%        launching a \verb|lablgtk2| toplevel and use
+%\begin{verbatim}
+%     Glib.Utf8.from_unichar 0x2200;;
+%\end{verbatim}
+%\end{itemize}
+
+\subsection{Character encoding for saved files}
+\label{sec:coqidecharencoding}
+
+In the \texttt{Files} section of the preferences, the encoding option
+is related to the way files are saved. 
+
+If you have no need to exchange files with non UTF-8 aware
+applications, it is better to choose the UTF-8 encoding, since it
+guarantees that your files will be read again without problems. (This
+is because when \CoqIDE{} reads a file, it tries to automatically
+detect its character encoding.) 
+
+If you choose something else than UTF-8, then missing characters will
+be written encoded by \verb|\x{....}| or \verb|\x{........}| where
+each dot is an hexadecimal digit: the number between braces is the
+hexadecimal UNICODE index for the missing character.
+
+
+\section{Building a custom \CoqIDE{} with user \textsc{ML} code}
+
+You can do this as described in Section~\ref{Coqmktop} for a
+custom coq text toplevel, simply by adding 
+option \verb|-ide| to \verb|coqmktop|, that is something like
+\begin{quote}
+\texttt{coqmktop -ide -byte $m_1$.cmo \ldots{} $m_n$.cmo}
+\end{quote}
+or 
+\begin{quote}
+\texttt{coqmktop -ide -opt $m_1$.cmx \ldots{} $m_n$.cmx}
+\end{quote}
+
+    
+
+% $Id: RefMan-ide.tex 8626 2006-03-14 15:01:00Z notin $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-ind.tex b/doc/refman/RefMan-ind.tex
new file mode 100644
index 00000000..d414e606
--- /dev/null
+++ b/doc/refman/RefMan-ind.tex
@@ -0,0 +1,498 @@
+
+%\documentstyle[11pt]{article}
+%\input{title}
+
+%\include{macros}
+%\makeindex
+
+%\begin{document}
+%\coverpage{The module {\tt Equality}}{Cristina CORNES}
+
+%\tableofcontents
+
+\chapter{Tactics for inductive types and families}
+\label{Addoc-equality}
+
+This chapter details a few special tactics useful for inferring facts
+from inductive hypotheses. They can be considered as tools that
+macro-generate complicated uses of the basic elimination tactics for
+inductive types. 
+
+Sections \ref{inversion_introduction} to \ref{inversion_using}  present
+inversion tactics and section \ref{scheme} describes
+a command {\tt Scheme} for automatic generation of induction schemes
+for mutual inductive types.
+
+%\end{document}
+%\documentstyle[11pt]{article}
+%\input{title}
+
+%\begin{document}
+%\coverpage{Module Inv: Inversion Tactics}{Cristina CORNES}
+
+\section{Generalities about inversion}
+\label{inversion_introduction}
+When working with (co)inductive predicates, we are very often faced to
+some of these situations:
+\begin{itemize}
+\item we have an inconsistent instance of an inductive predicate in the
+  local context of hypotheses. Thus, the current goal can be trivially
+  proved by absurdity. 
+
+\item we have a hypothesis that is an instance of an inductive
+  predicate, and the instance has some variables whose constraints we
+  would like to derive.
+\end{itemize}
+
+The inversion tactics are very useful to simplify the work in these
+cases. Inversion tools can be classified in three groups:
+\begin{enumerate}
+\item tactics for inverting an instance without stocking the inversion
+  lemma in the context: 
+  (\texttt{Dependent})  \texttt{Inversion} and
+ (\texttt{Dependent}) \texttt{Inversion\_clear}.
+\item commands for generating and stocking in the context the inversion
+  lemma corresponding to an instance: \texttt{Derive}
+  (\texttt{Dependent}) \texttt{Inversion}, \texttt{Derive}
+  (\texttt{Dependent}) \texttt{Inversion\_clear}.
+\item tactics for inverting an instance using an already defined
+  inversion lemma: \texttt{Inversion \ldots using}.
+\end{enumerate}
+
+These tactics work for inductive types of arity $(\vec{x}:\vec{T})s$ 
+where $s \in \{Prop,Set,Type\}$. Sections \ref{inversion_primitive},
+\ref{inversion_derivation} and \ref{inversion_using} 
+describe respectively each group of tools.
+
+As inversion proofs may be large in size, we recommend the user to
+stock the lemmas whenever the same instance needs to be inverted
+several times.\\
+
+Let's consider the relation \texttt{Le} over natural numbers and the
+following variables:
+
+\begin{coq_eval}
+Restore State "Initial".
+\end{coq_eval}
+
+\begin{coq_example*}
+Inductive Le : nat -> nat -> Set :=
+  | LeO : forall n:nat, Le 0%N n
+  | LeS : forall n m:nat, Le n m -> Le (S n) (S m).
+Variable P : nat -> nat -> Prop.
+Variable Q : forall n m:nat, Le n m -> Prop.
+\end{coq_example*}
+
+For example purposes we defined  \verb+Le: nat->nat->Set+
+ but we may have defined
+it \texttt{Le} of type \verb+nat->nat->Prop+ or \verb+nat->nat->Type+.
+
+
+\section{Inverting an instance}
+\label{inversion_primitive}
+\subsection{The non dependent case}
+\begin{itemize}
+
+\item \texttt{Inversion\_clear} \ident~\\
+\index{Inversion-clear@{\tt Inversion\_clear}}
+  Let the type of \ident~ in the local context be $(I~\vec{t})$,
+  where $I$ is a (co)inductive predicate. Then,
+  \texttt{Inversion} applied to \ident~ derives for each possible
+  constructor $c_i$ of $(I~\vec{t})$, {\bf all} the necessary
+  conditions that should hold for the instance $(I~\vec{t})$ to be
+  proved by $c_i$. Finally it erases \ident~ from the context.
+
+
+
+For example, consider the goal:
+\begin{coq_eval}
+Lemma ex : forall n m:nat, Le (S n) m -> P n m.
+intros.
+\end{coq_eval}
+
+\begin{coq_example}
+Show.
+\end{coq_example}
+
+To prove the goal we may need to reason by cases on \texttt{H} and to 
+ derive that \texttt{m}  is necessarily of
+the form $(S~m_0)$ for certain $m_0$ and that $(Le~n~m_0)$.  
+Deriving these conditions corresponds to prove that the
+only possible constructor of \texttt{(Le (S n) m)}  is
+\texttt{LeS} and that we can invert the 
+\texttt{->} in the type  of \texttt{LeS}.  
+This inversion is possible because \texttt{Le} is the smallest set closed by
+the constructors \texttt{LeO} and \texttt{LeS}.
+
+
+\begin{coq_example}
+inversion_clear H.
+\end{coq_example}
+
+Note that \texttt{m} has been substituted in the goal for \texttt{(S m0)}
+and that the hypothesis \texttt{(Le n m0)} has been added to the
+context.
+
+\item \texttt{Inversion} \ident~\\
+\index{Inversion@{\tt Inversion}}
+  This tactic differs from   {\tt Inversion\_clear} in the fact that
+  it adds the equality constraints in the context and
+  it does not erase  the hypothesis \ident.
+
+
+In the previous example, {\tt Inversion\_clear} 
+has substituted \texttt{m} by \texttt{(S m0)}. Sometimes it is
+interesting to have the equality \texttt{m=(S m0)} in the
+context to use it after. In that case we can use  \texttt{Inversion} that
+does not clear the equalities:
+
+\begin{coq_example*}
+Undo.
+\end{coq_example*}
+\begin{coq_example}
+inversion H.
+\end{coq_example}
+
+\begin{coq_eval}
+Undo.
+\end{coq_eval}
+
+Note that the hypothesis \texttt{(S m0)=m} has been deduced and 
+\texttt{H} has not been cleared from the context.
+
+\end{itemize}
+
+\begin{Variants}
+
+\item \texttt{Inversion\_clear } \ident~ \texttt{in} \ident$_1$ \ldots
+  \ident$_n$\\ 
+\index{Inversion_clear...in@{\tt Inversion\_clear...in}}
+  Let \ident$_1$ \ldots \ident$_n$, be identifiers in the local context. This
+  tactic behaves as generalizing \ident$_1$ \ldots \ident$_n$, and then performing
+  {\tt Inversion\_clear}.
+
+\item \texttt{Inversion } \ident~ \texttt{in} \ident$_1$ \ldots \ident$_n$\\
+\index{Inversion ... in@{\tt Inversion ... in}}
+  Let \ident$_1$ \ldots \ident$_n$, be identifiers in the local context. This
+  tactic behaves as generalizing \ident$_1$ \ldots \ident$_n$, and then performing
+  \texttt{Inversion}.
+
+
+\item \texttt{Simple Inversion} \ident~ \\
+\index{Simple Inversion@{\tt Simple Inversion}}
+  It is a very primitive inversion tactic that derives all the necessary
+  equalities  but it does not simplify
+  the  constraints as \texttt{Inversion} and
+  {\tt Inversion\_clear} do.
+
+\end{Variants}
+
+
+\subsection{The dependent case}
+\begin{itemize}
+\item \texttt{Dependent Inversion\_clear} \ident~\\
+\index{Dependent Inversion-clear@{\tt Dependent Inversion\_clear}}
+  Let the type of \ident~ in the local context be $(I~\vec{t})$,
+  where $I$ is a (co)inductive predicate, and let the goal  depend both on
+  $\vec{t}$ and \ident. Then, 
+  \texttt{Dependent Inversion\_clear} applied to \ident~ derives 
+   for each possible constructor $c_i$ of $(I~\vec{t})$, {\bf all} the
+  necessary conditions that should hold for the instance $(I~\vec{t})$ to be
+  proved by $c_i$. It also substitutes  \ident~ for the corresponding
+  term  in the goal and  it erases \ident~ from the context.
+
+
+For example, consider the  goal:
+\begin{coq_eval}
+Lemma ex_dep : forall (n m:nat) (H:Le (S n) m), Q (S n) m H.
+intros.
+\end{coq_eval}
+
+\begin{coq_example}
+Show.
+\end{coq_example}
+
+As \texttt{H} occurs in the goal, we may want to reason by cases on its
+structure and so, we would like  inversion tactics to
+substitute \texttt{H} by the corresponding term in constructor form. 
+Neither \texttt{Inversion} nor  {\tt Inversion\_clear} make such a
+substitution. To have such a behavior we use the dependent inversion tactics:
+
+\begin{coq_example}
+dependent inversion_clear H.
+\end{coq_example}
+
+Note that \texttt{H} has been substituted by \texttt{(LeS n m0 l)} and
+\texttt{m} by \texttt{(S m0)}.
+
+
+\end{itemize}
+
+\begin{Variants}
+
+\item \texttt{Dependent Inversion\_clear } \ident~ \texttt{ with } \term\\
+\index{Dependent Inversion_clear...with@{\tt Dependent Inversion\_clear...with}}
+ \noindent Behaves as \texttt{Dependent Inversion\_clear} but allows to give
+  explicitly the good generalization of the goal. It is useful when
+  the system fails to generalize the goal automatically. If
+  \ident~ has type $(I~\vec{t})$ and $I$ has type
+  $(\vec{x}:\vec{T})s$,   then \term~  must be of type
+  $I:(\vec{x}:\vec{T})(I~\vec{x})\rightarrow s'$ where $s'$ is the
+  type of the goal.
+
+
+
+\item \texttt{Dependent Inversion} \ident~\\
+\index{Dependent Inversion@{\tt Dependent Inversion}}
+ This tactic differs from   \texttt{Dependent Inversion\_clear} in the fact that
+  it also  adds the equality constraints in the context and
+  it does not erase  the hypothesis \ident~.
+
+\item \texttt{Dependent Inversion } \ident~ \texttt{ with } \term \\
+\index{Dependent Inversion...with@{\tt Dependent Inversion...with}}
+  Analogous to \texttt{Dependent Inversion\_clear .. with..} above. 
+\end{Variants}
+
+
+
+\section{Deriving the inversion lemmas}
+\label{inversion_derivation}
+\subsection{The non dependent case}
+
+The tactics (\texttt{Dependent}) \texttt{Inversion} and (\texttt{Dependent})
+{\tt Inversion\_clear} work on a
+certain instance $(I~\vec{t})$ of an inductive predicate. At each
+application, they inspect the given instance and derive the
+corresponding inversion lemma.  If we have to invert the same
+instance several times it is recommended to stock the lemma in the
+context and to reuse it whenever we need it.
+
+The families of commands \texttt{Derive Inversion}, \texttt{Derive
+Dependent Inversion}, \texttt{Derive} \\ {\tt Inversion\_clear} and \texttt{Derive Dependent Inversion\_clear}
+allow to generate inversion lemmas for given instances and sorts.  Next
+section describes the tactic \texttt{Inversion}$\ldots$\texttt{using} that refines the
+goal with a specified inversion lemma.
+
+\begin{itemize}
+
+\item \texttt{Derive Inversion\_clear} \ident~ \texttt{with}
+  $(\vec{x}:\vec{T})(I~\vec{t})$ \texttt{Sort} \sort~ \\ 
+\index{Derive Inversion_clear...with@{\tt Derive Inversion\_clear...with}}
+  Let $I$ be an inductive predicate and $\vec{x}$ the variables
+  occurring in $\vec{t}$. This command generates and stocks
+  the inversion lemma for the sort  \sort~  corresponding to the instance
+  $(\vec{x}:\vec{T})(I~\vec{t})$ with the name \ident~ in the {\bf
+    global} environment. When applied it is equivalent to have
+  inverted the instance with the tactic {\tt Inversion\_clear}.
+
+
+  For example, to generate the inversion lemma for the instance
+ \texttt{(Le (S n) m)} and the sort \texttt{Prop} we do:
+\begin{coq_example}
+Derive Inversion_clear leminv with (forall n m:nat, Le (S n) m) Sort
+ Prop.
+\end{coq_example}
+
+Let us  inspect the type of the generated lemma:
+\begin{coq_example}
+Check leminv.
+\end{coq_example}
+
+
+
+\end{itemize}
+
+%\variants
+%\begin{enumerate} 
+%\item \verb+Derive Inversion_clear+  \ident$_1$ \ident$_2$ \\ 
+%\index{Derive Inversion_clear@{\tt Derive Inversion\_clear}}
+%  Let \ident$_1$ have type $(I~\vec{t})$ in the local context ($I$
+%  an inductive predicate).  Then, this command has the same semantics
+%  as \verb+Derive Inversion_clear+ \ident$_2$~ \verb+with+
+%  $(\vec{x}:\vec{T})(I~\vec{t})$ \verb+Sort Prop+ where $\vec{x}$ are the free
+%  variables of $(I~\vec{t})$ declared in the local context (variables
+%  of the global context are considered as constants). 
+%\item \verb+Derive Inversion+ \ident$_1$~ \ident$_2$~\\
+%\index{Derive Inversion@{\tt Derive Inversion}}
+% Analogous to the previous command. 
+%\item \verb+Derive Inversion+ $num$ \ident~ \ident~ \\ 
+%\index{Derive Inversion@{\tt Derive Inversion}}
+%  This command behaves as \verb+Derive Inversion+ \ident~ {\it
+%    namehyp} performed on the goal number $num$.
+%
+%\item \verb+Derive Inversion_clear+ $num$ \ident~ \ident~ \\ 
+%\index{Derive Inversion_clear@{\tt Derive Inversion\_clear}}
+%  This command behaves as \verb+Derive Inversion_clear+ \ident~
+%  \ident~ performed on the goal number $num$.
+%\end{enumerate}
+
+
+
+A derived inversion lemma is  adequate for inverting the instance
+with which it was generated,  \texttt{Derive} applied to
+different instances yields different lemmas. In general, if we generate
+the inversion lemma with 
+an instance $(\vec{x}:\vec{T})(I~\vec{t})$ and a sort $s$,  the inversion lemma will
+expect a predicate of type $(\vec{x}:\vec{T})s$ as first argument. \\
+
+\begin{Variant}
+\item \texttt{Derive Inversion} \ident~ \texttt{with} 
+  $(\vec{x}:\vec{T})(I~\vec{t})$ \texttt{Sort} \sort\\ 
+\index{Derive Inversion...with@{\tt Derive Inversion...with}}
+     Analogous of \texttt{Derive Inversion\_clear .. with ..} but 
+ when applied it is equivalent to having
+  inverted the instance with the tactic \texttt{Inversion}.
+\end{Variant}
+
+\subsection{The dependent case}
+\begin{itemize}
+\item \texttt{Derive Dependent Inversion\_clear} \ident~ \texttt{with}
+  $(\vec{x}:\vec{T})(I~\vec{t})$ \texttt{Sort} \sort~ \\ 
+\index{Derive Dependent Inversion\_clear...with@{\tt Derive Dependent Inversion\_clear...with}}
+  Let $I$ be an inductive predicate. This command generates and stocks
+  the dependent inversion lemma for the sort  \sort~  corresponding to the instance
+  $(\vec{x}:\vec{T})(I~\vec{t})$ with the name \ident~ in the {\bf
+    global} environment. When applied it is equivalent to having
+  inverted the instance with the tactic \texttt{Dependent Inversion\_clear}.
+\end{itemize}
+
+\begin{coq_example}
+Derive Dependent Inversion_clear leminv_dep with
+ (forall n m:nat, Le (S n) m) Sort Prop.
+\end{coq_example}
+
+\begin{coq_example}
+Check leminv_dep.
+\end{coq_example}
+
+\begin{Variants}
+\item \texttt{Derive Dependent Inversion} \ident~ \texttt{with}
+  $(\vec{x}:\vec{T})(I~\vec{t})$ \texttt{Sort} \sort~ \\ 
+\index{Derive Dependent Inversion...with@{\tt Derive Dependent Inversion...with}}
+  Analogous to \texttt{Derive Dependent Inversion\_clear}, but when
+  applied  it is equivalent to having
+  inverted the instance with the tactic \texttt{Dependent Inversion}.
+
+\end{Variants}
+
+\section{Using already defined inversion  lemmas}
+\label{inversion_using}
+\begin{itemize}
+\item \texttt{Inversion} \ident \texttt{ using} \ident$'$ \\
+\index{Inversion...using@{\tt Inversion...using}}
+  Let \ident~ have type $(I~\vec{t})$ ($I$ an inductive
+  predicate) in the local context, and \ident$'$ be a (dependent) inversion
+  lemma. Then, this tactic refines the current goal with the specified
+  lemma. 
+
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\begin{coq_example}
+Show.
+\end{coq_example}
+\begin{coq_example}
+inversion H using leminv.
+\end{coq_example}
+
+
+\end{itemize}
+\variant
+\begin{enumerate}
+\item \texttt{Inversion} \ident~ \texttt{using} \ident$'$ \texttt{in} \ident$_1$\ldots \ident$_n$\\
+\index{Inversion...using...in@{\tt Inversion...using...in}}
+This tactic behaves as generalizing  \ident$_1$\ldots \ident$_n$,
+then doing \texttt{Use Inversion} \ident~\ident$'$.
+\end{enumerate}
+
+\section{\tt Scheme ...}\index{Scheme@{\tt Scheme}}\label{Scheme}
+\label{scheme}
+The {\tt Scheme} command is a high-level tool for generating
+automatically (possibly mutual) induction principles for given types
+and sorts.  Its syntax follows the schema :
+
+\noindent
+{\tt Scheme {\ident$_1$} := Induction for \term$_1$ Sort {\sort$_1$} \\
+  with\\
+  \mbox{}\hspace{0.1cm} .. \\
+        with {\ident$_m$} := Induction for {\term$_m$} Sort
+        {\sort$_m$}}\\
+\term$_1$ \ldots \term$_m$ are different inductive types belonging to
+the same package of mutual inductive definitions. This command
+generates {\ident$_1$}\ldots{\ident$_m$} to be mutually recursive
+definitions. Each term {\ident$_i$} proves a general principle 
+of mutual induction for objects in type {\term$_i$}. 
+
+\Example
+The definition of principle of mutual induction for {\tt tree} and
+{\tt forest} over the sort {\tt Set} is defined by the command:
+\begin{coq_eval}
+Restore State "Initial".
+Variables A B : Set.
+Inductive tree : Set :=
+    node : A -> forest -> tree
+with forest : Set :=
+  | leaf : B -> forest
+  | cons : tree -> forest -> forest.
+\end{coq_eval}
+\begin{coq_example*}
+Scheme tree_forest_rec := Induction for tree
+  Sort Set
+  with forest_tree_rec := Induction for forest Sort Set.
+\end{coq_example*}
+You may now look at the type of {\tt tree\_forest\_rec} :
+\begin{coq_example}
+Check tree_forest_rec.
+\end{coq_example}
+This principle involves two different predicates for {\tt trees} and
+{\tt forests}; it also has three premises each one corresponding to a
+constructor of one of the inductive definitions.
+
+The principle {\tt tree\_forest\_rec} shares exactly the same
+premises, only the conclusion now refers to the property of forests.
+\begin{coq_example}
+Check forest_tree_rec.
+\end{coq_example}
+
+\begin{Variant}
+\item {\tt Scheme {\ident$_1$} := Minimality for \term$_1$ Sort {\sort$_1$} \\
+  with\\
+  \mbox{}\hspace{0.1cm} .. \\
+        with {\ident$_m$} := Minimality for {\term$_m$} Sort
+        {\sort$_m$}}\\
+Same as before but defines a non-dependent elimination principle more
+natural in case of inductively defined relations. 
+\end{Variant}
+
+\Example
+With the predicates {\tt odd} and {\tt even} inductively defined as:
+\begin{coq_eval}
+Restore State "Initial".
+\end{coq_eval}
+\begin{coq_example*}
+Inductive odd : nat -> Prop :=
+    oddS : forall n:nat, even n -> odd (S n)
+with even : nat -> Prop :=
+  | evenO : even 0%N
+  | evenS : forall n:nat, odd n -> even (S n).
+\end{coq_example*}
+The following command generates a powerful elimination
+principle:
+\begin{coq_example*}
+Scheme odd_even := Minimality for   odd Sort Prop
+  with even_odd := Minimality for even Sort Prop.
+\end{coq_example*}
+The type of {\tt odd\_even} for instance will be:
+\begin{coq_example}
+Check odd_even.
+\end{coq_example}
+The type of {\tt even\_odd} shares the same premises but the
+conclusion is {\tt (n:nat)(even n)->(Q n)}.
+
+
+
+%\end{document}
+
+% $Id: RefMan-ind.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
diff --git a/doc/refman/RefMan-int.tex b/doc/refman/RefMan-int.tex
new file mode 100644
index 00000000..258d0ca0
--- /dev/null
+++ b/doc/refman/RefMan-int.tex
@@ -0,0 +1,147 @@
+\setheaders{Introduction}
+\chapter*{Introduction}
+
+This document is the Reference Manual of version \coqversion{} of the \Coq\ 
+proof assistant. A companion volume, the \Coq\ Tutorial, is provided
+for the beginners. It is advised to read the Tutorial first.
+A new book~\cite{CoqArt} on practical uses of the \Coq{} system will
+be published in 2004 and is a good support for both the beginner and
+the advanced user.
+
+%The system \Coq\ is designed to develop mathematical proofs. It can be
+%used by mathematicians to develop mathematical theories and by
+%computer scientists to write formal specifications,
+The \Coq{} system is designed to develop mathematical proofs, and
+especially to write formal specifications, programs and to verify that
+programs are correct with respect to their specification. It provides
+a specification language named \gallina. Terms of \gallina\ can
+represent programs as well as properties of these programs and proofs
+of these properties. Using the so-called \textit{Curry-Howard
+  isomorphism}, programs, properties and proofs are formalized in the
+same language called \textit{Calculus of Inductive Constructions},
+that is a $\lambda$-calculus with a rich type system.  All logical
+judgments in \Coq\ are typing judgments. The very heart of the Coq
+system is the type-checking algorithm that checks the correctness of
+proofs, in other words that checks that a program complies to its
+specification. \Coq\ also provides an interactive proof assistant to
+build proofs using specific programs called \textit{tactics}.
+
+All services of the \Coq\ proof assistant are accessible by
+interpretation of a command language called \textit{the vernacular}.
+
+\Coq\ has an interactive mode in which commands are interpreted as the
+user types them in from the keyboard and a compiled mode where
+commands are processed from a file.  
+
+\begin{itemize}
+\item The interactive mode may be used as a debugging mode in which
+  the user can develop his theories and proofs step by step,
+  backtracking if needed and so on. The interactive mode is run with
+  the {\tt coqtop} command from the operating system (which we shall
+  assume to be some variety of UNIX in the rest of this document).
+\item The compiled mode acts as a proof checker taking a file
+  containing a whole development in order to ensure its correctness.
+  Moreover, \Coq's compiler provides an output file containing a
+  compact representation of its input. The compiled mode is run with
+  the {\tt coqc} command from the operating system. 
+
+\end{itemize}
+These two modes are documented in chapter \ref{Addoc-coqc}.
+
+Other modes of interaction with \Coq{} are possible: through an emacs
+shell window, an emacs generic user-interface for proof assistant
+(ProofGeneral~\cite{ProofGeneral}) or through a customized interface
+(PCoq~\cite{Pcoq}).  These facilities are not documented here.  There
+is also a \Coq{} Integrated Development Environment described in
+Chapter~\ref{Addoc-coqide}.
+
+\section*{How to read this book}
+
+This is a Reference Manual, not a User Manual, then it is not made for a
+continuous reading. However, it has some structure that is explained
+below.
+
+\begin{itemize}
+\item The first part describes the specification language,
+  Gallina. Chapters~\ref{Gallina} and~\ref{Gallina-extension}
+  describe the concrete syntax as well as the meaning of programs,
+  theorems and proofs in the Calculus of Inductive
+  Constructions. Chapter~\ref{Theories} describes the standard library
+  of \Coq. Chapter~\ref{Cic} is a mathematical description of the
+  formalism. Chapter~\ref{chapter:Modules} describes the module system.
+
+\item The second part describes the proof engine. It is divided in
+  five chapters. Chapter~\ref{Vernacular-commands} presents all
+  commands (we call them \emph{vernacular commands}) that are not
+  directly related to interactive proving: requests to the
+  environment, complete or partial evaluation, loading and compiling
+  files. How to start and stop proofs, do multiple proofs in parallel
+  is explained in Chapter~\ref{Proof-handling}. In
+  Chapter~\ref{Tactics}, all commands that realize one or more steps
+  of the proof are presented: we call them \emph{tactics}. The
+  language to combine these tactics into complex proof strategies is
+  given in Chapter~\ref{TacticLanguage}. Examples of tactics are
+  described in Chapter~\ref{Tactics-examples}.
+
+%\item The third part describes how to extend the system in two ways:
+%  adding parsing and pretty-printing rules
+%  (Chapter~\ref{Addoc-syntax}) and writing new tactics
+%  (Chapter~\ref{TacticLanguage}). 
+
+\item The third part describes how to extend the syntax of \Coq. It
+corresponds to the Chapter~\ref{Addoc-syntax}.
+
+\item In the fourth part more practical tools are documented. First in
+  Chapter~\ref{Addoc-coqc}, the usage of \texttt{coqc} (batch mode)
+  and \texttt{coqtop} (interactive mode) with their options is
+  described. Then, in Chapter~\ref{Utilities},
+  various utilities that come with the \Coq\ distribution are
+  presented.
+  Finally, Chapter~\ref{Addoc-coqide} describes the \Coq{} integrated
+  development environment. 
+\end{itemize}
+
+At the end of the document, after the global index, the user can find
+specific indexes for tactics, vernacular commands, and error
+messages. 
+
+\section*{List of additional documentation}
+
+This manual does not contain all the documentation the user may need
+about \Coq{}. Various informations can be found in the following
+documents:  
+\begin{description}
+
+\item[Tutorial] 
+  A companion volume to this reference manual, the \Coq{} Tutorial, is
+  aimed at gently introducing new users to developing proofs in \Coq{}
+  without assuming prior knowledge of type theory. In a second step, the
+  user can read also the tutorial on recursive types (document {\tt
+    RecTutorial.ps}).
+
+\item[Addendum] The fifth part (the Addendum) of the Reference Manual
+  is distributed as a separate document. It contains more
+  detailed documentation and examples about some specific aspects of the
+  system that may interest only certain users. It shares the indexes,
+  the page numbers and
+  the bibliography with the Reference Manual. If you see in one of the
+  indexes a page number that is outside the Reference Manual, it refers
+  to the Addendum. 
+
+\item[Installation] A text file INSTALL that comes with the sources
+  explains how to install \Coq{}.
+
+\item[The \Coq{} standard library]
+A commented version of sources of the \Coq{} standard library
+(including only the specifications, the proofs are removed) 
+is given in the additional document {\tt Library.ps}.
+
+\end{description}
+
+
+% $Id: RefMan-int.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End:
diff --git a/doc/refman/RefMan-lib.tex b/doc/refman/RefMan-lib.tex
new file mode 100644
index 00000000..f9a5f975
--- /dev/null
+++ b/doc/refman/RefMan-lib.tex
@@ -0,0 +1,1102 @@
+\chapter{The {\Coq} library}
+\index{Theories}\label{Theories}
+
+The \Coq\ library is structured into three parts:
+
+\begin{description}
+\item[The initial library:] it contains
+  elementary logical notions and datatypes. It constitutes the
+  basic state of the system directly available when running
+  \Coq;
+
+\item[The standard library:] general-purpose libraries containing
+  various developments of \Coq\ axiomatizations about sets, lists,
+  sorting, arithmetic, etc. This library comes with the system and its
+  modules are directly accessible through the \verb!Require! command
+  (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}).
+\end{description}
+
+This chapter briefly reviews these libraries.
+
+\section{The basic library}
+\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
+{\tt Prelude} module in directory {\tt theories/Init} at the {\Coq}
+root directory; this includes the modules
+{\tt Notations},
+{\tt Logic},
+{\tt Datatypes},
+{\tt Specif},
+{\tt Peano},
+and {\tt Wf}.
+Module {\tt Logic\_Type} also makes it in the initial state}.
+
+\subsection{Notations} \label{Notations}
+
+This module defines the parsing and pretty-printing of many symbols
+(infixes, prefixes, etc.). However, it does not assign a meaning to these
+notations. The purpose of this is to define precedence and
+associativity of very common notations, and avoid users to use them
+with other precedence, which may be confusing.
+
+\begin{figure}
+\begin{center}
+\begin{tabular}{|cll|}
+\hline
+Notation & Precedence & Associativity \\
+\hline
+\verb!_ <-> _! & 95 & no \\
+\verb!_ \/ _!  & 85 & right \\
+\verb!_ /\ _!  & 80 & right \\
+\verb!~ _!   & 75 & right \\
+\verb!_ = _!   & 70 & no \\
+\verb!_ = _ = _!   & 70 & no \\
+\verb!_ = _ :> _!   & 70 & no \\
+\verb!_ <> _!  & 70 & no \\
+\verb!_ <> _ :> _!  & 70 & no \\
+\verb!_ < _!   & 70 & no \\
+\verb!_ > _!   & 70 & no \\
+\verb!_ <= _!  & 70 & no \\
+\verb!_ >= _!  & 70 & no \\
+\verb!_ < _ < _! & 70 & no \\
+\verb!_ < _ <= _! & 70 & no \\
+\verb!_ <= _ < _! & 70 & no \\
+\verb!_ <= _ <= _! & 70 & no \\
+\verb!_ + _!   & 50 & left \\
+\verb!_ - _!   & 50 & left \\
+\verb!_ * _!   & 40 & left \\
+\verb!_ / _!   & 40 & left \\
+\verb!- _!  & 35 & right \\
+\verb!/ _!  & 35 & right \\
+\verb!_ ^ _!   & 30 & right \\
+\hline
+\end{tabular}
+\end{center}
+\caption{Notations in the initial state}
+\label{init-notations}
+\end{figure}
+
+\subsection{Logic} 
+\label{Logic}
+
+\begin{figure}
+\begin{centerframe}
+\begin{tabular}{lclr}
+{\form} & ::= & {\tt True} & ({\tt True})\\
+  & $|$ & {\tt False} & ({\tt False})\\
+  & $|$ & {\tt\char'176} {\form} & ({\tt not})\\
+  & $|$ & {\form} {\tt /$\backslash$} {\form} & ({\tt and})\\
+  & $|$ & {\form} {\tt $\backslash$/} {\form} & ({\tt or})\\
+  & $|$ & {\form} {\tt ->} {\form} & (\em{primitive implication})\\
+  & $|$ & {\form} {\tt <->} {\form} & ({\tt iff})\\
+  & $|$ & {\tt forall} {\ident} {\tt :} {\type} {\tt ,}
+  {\form} & (\em{primitive for all})\\
+  & $|$ & {\tt exists} {\ident} \zeroone{{\tt :} {\specif}} {\tt
+  ,} {\form}  & ({\tt ex})\\
+  & $|$ & {\tt exists2} {\ident} \zeroone{{\tt :} {\specif}} {\tt
+  ,} {\form}  {\tt \&} {\form} & ({\tt ex2})\\
+  & $|$ & {\term} {\tt =} {\term} & ({\tt eq})\\
+  & $|$ & {\term} {\tt =} {\term} {\tt :>} {\specif} & ({\tt eq})
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of formulas}
+\label{formulas-syntax}
+\end{figure}
+
+The basic library of {\Coq} comes with the definitions of standard
+(intuitionistic) logical connectives (they are defined as inductive
+constructions). They are equipped with an appealing syntax enriching the
+(subclass {\form}) of the syntactic class {\term}. The syntax
+extension is shown on figure \ref{formulas-syntax}.
+
+% The basic library of {\Coq} comes with the definitions of standard
+% (intuitionistic) logical connectives (they are defined as inductive
+% constructions). They are equipped with an appealing syntax enriching
+% the (subclass {\form}) of the syntactic class {\term}. The syntax
+% extension \footnote{This syntax is defined in module {\tt
+%     LogicSyntax}} is shown on Figure~\ref{formulas-syntax}.
+ 
+\Rem Implication is not defined but primitive (it is a non-dependent
+product of a proposition over another proposition).  There is also a
+primitive universal quantification (it is a dependent product over a
+proposition). The primitive universal quantification allows both
+first-order and higher-order quantification.
+
+\subsubsection{Propositional Connectives} \label{Connectives}
+\index{Connectives}
+
+First, we find propositional calculus connectives:
+\ttindex{True}
+\ttindex{I}
+\ttindex{False}
+\ttindex{not}
+\ttindex{and}
+\ttindex{conj}
+\ttindex{proj1}
+\ttindex{proj2}
+
+\begin{coq_eval}
+Set Printing Depth 50.
+\end{coq_eval}
+\begin{coq_example*}
+Inductive True : Prop := I.
+Inductive False :  Prop := .
+Definition not (A: Prop) := A -> False.
+Inductive and (A B:Prop) : Prop := conj (_:A) (_:B).
+Section Projections.
+Variables A B : Prop.
+Theorem proj1 : A /\ B -> A.
+Theorem proj2 : A /\ B -> B.
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+\ttindex{or}
+\ttindex{or\_introl}
+\ttindex{or\_intror}
+\ttindex{iff}
+\ttindex{IF\_then\_else}
+\begin{coq_example*}
+End Projections.
+Inductive or (A B:Prop) : Prop :=
+  | or_introl (_:A)
+  | or_intror (_:B).
+Definition iff (P Q:Prop) := (P -> Q) /\ (Q -> P).
+Definition IF_then_else (P Q R:Prop) := P /\ Q \/ ~ P /\ R.
+\end{coq_example*}
+
+\subsubsection{Quantifiers} \label{Quantifiers}
+\index{Quantifiers}
+
+Then we find first-order quantifiers:
+\ttindex{all}
+\ttindex{ex}
+\ttindex{exists}
+\ttindex{ex\_intro}
+\ttindex{ex2}
+\ttindex{exists2}
+\ttindex{ex\_intro2}
+
+\begin{coq_example*}
+Definition all (A:Set) (P:A -> Prop) := forall x:A, P x.
+Inductive ex (A: Set) (P:A -> Prop) : Prop :=
+    ex_intro (x:A) (_:P x).
+Inductive ex2 (A:Set) (P Q:A -> Prop) : Prop :=
+    ex_intro2 (x:A) (_:P x) (_:Q x).
+\end{coq_example*}
+
+The following abbreviations are allowed:
+\begin{center}
+  \begin{tabular}[h]{|l|l|}
+    \hline
+    \verb+exists x:A, P+     & \verb+ex A (fun x:A => P)+ \\
+    \verb+exists x, P+       & \verb+ex _ (fun x => P)+ \\
+    \verb+exists2 x:A, P & Q+ & \verb+ex2 A (fun x:A => P) (fun x:A => Q)+ \\
+    \verb+exists2 x, P & Q+   & \verb+ex2 _ (fun x => P) (fun x => Q)+ \\
+    \hline
+  \end{tabular}
+\end{center}
+
+The type annotation \texttt{:A} can be omitted when \texttt{A} can be
+synthesized by the system.
+
+\subsubsection{Equality} \label{Equality}
+\index{Equality}
+
+Then, we find equality, defined as an inductive relation. That is,
+given a \verb:Type: \verb:A: and an \verb:x: of type \verb:A:, the
+predicate \verb:(eq A x): is the smallest one which contains \verb:x:.
+This definition, due to Christine Paulin-Mohring, is equivalent to
+define \verb:eq: as the smallest reflexive relation, and it is also
+equivalent to Leibniz' equality.
+
+\ttindex{eq}
+\ttindex{refl\_equal}
+
+\begin{coq_example*}
+Inductive eq (A:Type) (x:A) : A -> Prop :=
+    refl_equal : eq A x x.
+\end{coq_example*}
+
+\subsubsection{Lemmas} 
+\label{PreludeLemmas}
+
+Finally, a few easy lemmas are provided.
+
+\ttindex{absurd}
+
+\begin{coq_example*}
+Theorem absurd : forall A C:Prop, A -> ~ A -> C.
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+\ttindex{sym\_eq}
+\ttindex{trans\_eq}
+\ttindex{f\_equal}
+\ttindex{sym\_not\_eq}
+\begin{coq_example*}
+Section equality.
+Variables A B : Type.
+Variable f : A -> B.
+Variables x y z : A.
+Theorem sym_eq : x = y -> y = x.
+Theorem trans_eq : x = y -> y = z -> x = z.
+Theorem f_equal : x = y -> f x = f y.
+Theorem sym_not_eq : x <> y -> y <> x.
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+Abort.
+Abort.
+Abort.
+\end{coq_eval}
+\ttindex{eq\_ind\_r}
+\ttindex{eq\_rec\_r}
+\ttindex{eq\_rect}
+\ttindex{eq\_rect\_r}
+%Definition eq_rect: (A:Set)(x:A)(P:A->Type)(P x)->(y:A)(x=y)->(P y).
+\begin{coq_example*}
+End equality.
+Definition eq_ind_r :
+  forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y:A, y = x -> P y.
+Definition eq_rec_r :
+  forall (A:Type) (x:A) (P:A -> Set), P x -> forall y:A, y = x -> P y.
+Definition eq_rect_r :
+  forall (A:Type) (x:A) (P:A -> Type), P x -> forall y:A, y = x -> P y.
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+Abort.
+Abort.
+\end{coq_eval}
+%Abort (for now predefined eq_rect)
+\begin{coq_example*}
+Hint Immediate sym_eq sym_not_eq : core.
+\end{coq_example*}
+\ttindex{f\_equal$i$}
+
+The theorem {\tt f\_equal} is extended to functions with two to five
+arguments. The theorem are names {\tt f\_equal2}, {\tt f\_equal3}, 
+{\tt f\_equal4} and {\tt f\_equal5}.
+For instance {\tt f\_equal3} is defined the following way.
+\begin{coq_example*}
+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.
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\subsection{Datatypes}
+\label{Datatypes}
+\index{Datatypes}
+
+\begin{figure}
+\begin{centerframe}
+\begin{tabular}{rclr}
+{\specif} & ::= & {\specif} {\tt *} {\specif} & ({\tt prod})\\
+  & $|$ & {\specif} {\tt +} {\specif} & ({\tt sum})\\
+  & $|$ & {\specif} {\tt + \{} {\specif} {\tt \}} & ({\tt sumor})\\
+  & $|$ & {\tt \{} {\specif} {\tt \} + \{} {\specif} {\tt \}} &
+  ({\tt sumbool})\\  
+  & $|$ & {\tt \{} {\ident} {\tt :} {\specif} {\tt |} {\form} {\tt \}}
+  & ({\tt sig})\\
+  & $|$ & {\tt \{} {\ident} {\tt :} {\specif} {\tt |} {\form}  {\tt \&}
+  {\form} {\tt \}} & ({\tt sig2})\\
+  & $|$ & {\tt \{} {\ident} {\tt :} {\specif} {\tt \&} {\specif} {\tt
+    \}} & ({\tt sigS})\\
+  & $|$ & {\tt \{} {\ident} {\tt :} {\specif} {\tt \&} {\specif} {\tt
+    \&} {\specif} {\tt \}} & ({\tt sigS2})\\
+  &  & & \\
+{\term} & ::= & {\tt (} {\term} {\tt ,} {\term} {\tt )} & ({\tt pair})
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of datatypes and specifications}
+\label{specif-syntax}
+\end{figure}
+
+
+In the basic library, we find the definition\footnote{They are in {\tt
+    Datatypes.v}} of the basic data-types of programming, again
+defined as inductive constructions over the sort \verb:Set:. Some of
+them come with a special syntax shown on Figure~\ref{specif-syntax}.
+
+\subsubsection{Programming} 
+\label{Programming}
+\index{Programming}
+\label{libnats}
+
+\ttindex{unit}
+\ttindex{tt}
+\ttindex{bool}
+\ttindex{true}
+\ttindex{false}
+\ttindex{nat}
+\ttindex{O}
+\ttindex{S}
+\ttindex{option}
+\ttindex{Some}
+\ttindex{None}
+\ttindex{identity}
+\ttindex{refl\_identity}
+
+\begin{coq_example*}
+Inductive unit : Set := tt.
+Inductive bool : Set := true | false.
+Inductive nat : Set := O | S (n:nat).
+Inductive option (A:Set) : Set := Some (_:A) | None.
+Inductive identity (A:Type) (a:A) : A -> Type :=
+    refl_identity : identity A a a.
+\end{coq_example*}
+
+Note that zero is the letter \verb:O:, and {\sl not} the numeral
+\verb:0:.
+
+{\tt identity} is logically equivalent to equality but it lives in
+sort {\tt Set}. Computationaly, it behaves like {\tt unit}.
+
+We then define the disjoint sum of \verb:A+B: of two sets \verb:A: and
+\verb:B:, and their product \verb:A*B:.
+\ttindex{sum}
+\ttindex{A+B}
+\ttindex{+}
+\ttindex{inl}
+\ttindex{inr}
+\ttindex{prod}
+\ttindex{A*B}
+\ttindex{*}
+\ttindex{pair}
+\ttindex{fst}
+\ttindex{snd}
+
+\begin{coq_example*}
+Inductive sum (A B:Set) : Set := inl (_:A) | inr (_:B).
+Inductive prod (A B:Set) : Set := pair (_:A) (_:B).
+Section projections.
+Variables A B : Set.
+Definition fst (H: prod A B) := match H with
+                                | pair x y => x
+                                end.
+Definition snd (H: prod A B) := match H with
+                                | pair x y => y
+                                end.
+End projections.
+\end{coq_example*}
+
+\subsection{Specification}
+
+The following notions\footnote{They are defined in module {\tt
+Specif.v}} allows to build new datatypes and specifications. 
+They are available with the syntax shown on
+Figure~\ref{specif-syntax}\footnote{This syntax can be found in the module
+{\tt SpecifSyntax.v}}.
+
+For instance, given \verb|A:Set| and \verb|P:A->Prop|, the construct
+\verb+{x:A | P x}+ (in abstract syntax \verb+(sig A P)+) is a
+\verb:Set:. We may build elements of this set as \verb:(exist x p):
+whenever we have a witness \verb|x:A| with its justification
+\verb|p:P x|.
+
+From such a \verb:(exist x p): we may in turn extract its witness
+\verb|x:A| (using an elimination construct such as \verb:match:) but
+{\sl not} its justification, which stays hidden, like in an abstract
+data type. In technical terms, one says that \verb:sig: is a ``weak
+(dependent) sum''.  A variant \verb:sig2: with two predicates is also
+provided.
+
+\index{\{x:A "| (P x)\}}
+\index{"|}
+\ttindex{sig}
+\ttindex{exist}
+\ttindex{sig2}
+\ttindex{exist2}
+
+\begin{coq_example*}
+Inductive sig (A:Set) (P:A -> Prop) : Set := exist (x:A) (_:P x).
+Inductive sig2 (A:Set) (P Q:A -> Prop) : Set := 
+  exist2 (x:A) (_:P x) (_:Q x).
+\end{coq_example*}
+
+A ``strong (dependent) sum'' \verb+{x:A & (P x)}+ may be also defined,
+when the predicate \verb:P: is now defined as a \verb:Set:
+constructor.
+
+\ttindex{\{x:A \& (P x)\}}
+\ttindex{\&}
+\ttindex{sigS}
+\ttindex{existS}
+\ttindex{projS1}
+\ttindex{projS2}
+\ttindex{sigS2}
+\ttindex{existS2}
+
+\begin{coq_example*}
+Inductive sigS (A:Set) (P:A -> Set) : Set := existS (x:A) (_:P x).
+Section sigSprojections.
+Variable A : Set.
+Variable P : A -> Set.
+Definition projS1 (H:sigS A P) := let (x, h) := H in x.
+Definition projS2 (H:sigS A P) :=
+  match H return P (projS1 H) with
+    existS x h => h
+  end.
+End sigSprojections.
+Inductive sigS2 (A: Set) (P Q:A -> Set) : Set :=
+    existS2 (x:A) (_:P x) (_:Q x).
+\end{coq_example*}
+
+A related non-dependent construct is the constructive sum
+\verb"{A}+{B}" of two propositions \verb:A: and \verb:B:.
+\label{sumbool}
+\ttindex{sumbool}
+\ttindex{left}
+\ttindex{right}
+\ttindex{\{A\}+\{B\}}
+
+\begin{coq_example*}
+Inductive sumbool (A B:Prop) : Set := left (_:A) | right (_:B).
+\end{coq_example*}
+
+This \verb"sumbool" construct may be used as a kind of indexed boolean
+data type. An intermediate between \verb"sumbool" and \verb"sum" is
+the mixed \verb"sumor" which combines \verb"A:Set" and \verb"B:Prop"
+in the \verb"Set" \verb"A+{B}".
+\ttindex{sumor}
+\ttindex{inleft}
+\ttindex{inright}
+\ttindex{A+\{B\}}
+
+\begin{coq_example*}
+Inductive sumor (A:Set) (B:Prop) : Set := inleft (_:A) | inright (_:B).
+\end{coq_example*}
+
+We may define variants of the axiom of choice, like in Martin-Löf's
+Intuitionistic Type Theory.
+\ttindex{Choice}
+\ttindex{Choice2}
+\ttindex{bool\_choice}
+
+\begin{coq_example*}
+Lemma Choice :
+ forall (S S':Set) (R:S -> S' -> Prop),
+   (forall x:S, {y : S' | R x y}) ->
+   {f : S -> S' | forall z:S, R z (f z)}.
+Lemma Choice2 :
+ forall (S S':Set) (R:S -> S' -> Set),
+   (forall x:S, {y : S' &  R x y}) ->
+   {f : S -> S' &  forall z:S, R z (f z)}.
+Lemma bool_choice :
+ forall (S:Set) (R1 R2:S -> Prop),
+   (forall x:S, {R1 x} + {R2 x}) ->
+   {f : S -> bool |
+   forall x:S, f x = true /\ R1 x \/ f x = false /\ R2 x}.
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+Abort.
+Abort.
+\end{coq_eval}
+
+The next constructs builds a sum between a data type \verb|A:Set| and
+an exceptional value encoding errors:
+
+\ttindex{Exc}
+\ttindex{value}
+\ttindex{error}
+
+\begin{coq_example*}
+Definition Exc := option.
+Definition value := Some.
+Definition error := None.
+\end{coq_example*}
+
+
+This module ends with theorems, 
+relating the sorts \verb:Set: and
+\verb:Prop: in a way which is consistent with the realizability
+interpretation.
+\ttindex{False\_rec}
+\ttindex{eq\_rec}
+\ttindex{Except}
+\ttindex{absurd\_set}
+\ttindex{and\_rec}
+
+%Lemma False_rec : (P:Set)False->P.
+%Lemma False_rect : (P:Type)False->P.
+\begin{coq_example*}
+Definition except := False_rec.
+Notation Except := (except _).
+Theorem absurd_set : forall (A:Prop) (C:Set), A -> ~ A -> C.
+Theorem and_rec :
+ forall (A B:Prop) (P:Set), (A -> B -> P) -> A /\ B -> P.
+\end{coq_example*}
+%\begin{coq_eval}
+%Abort.
+%Abort.
+%\end{coq_eval}
+
+\subsection{Basic Arithmetics}
+
+The basic library includes a few elementary properties of natural
+numbers, together with the definitions of predecessor, addition and
+multiplication\footnote{This is in module {\tt Peano.v}}. It also
+provides a scope {\tt nat\_scope} gathering standard notations for
+common operations (+,*) and a decimal notation for numbers. That is he
+can write \texttt{3} for \texttt{(S (S (S O)))}. This also works on
+the left hand side of a \texttt{match} expression (see for example
+section~\ref{refine-example}). This scope is opened by default.
+
+%Remove the redefinition of nat
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+The following example is not part of the standard library, but it
+shows the usage of the notations:
+
+\begin{coq_example*}
+Fixpoint even (n:nat) : bool :=
+  match n with
+  | 0 => true
+  | 1 => false
+  | S (S n) => even n
+  end.
+\end{coq_example*}
+
+
+\ttindex{eq\_S}
+\ttindex{pred}
+\ttindex{pred\_Sn}
+\ttindex{eq\_add\_S}
+\ttindex{not\_eq\_S}
+\ttindex{IsSucc}
+\ttindex{O\_S}
+\ttindex{n\_Sn}
+\ttindex{plus}
+\ttindex{plus\_n\_O}
+\ttindex{plus\_n\_Sm}
+\ttindex{mult}
+\ttindex{mult\_n\_O}
+\ttindex{mult\_n\_Sm}
+
+\begin{coq_example*}
+Theorem eq_S : forall x y:nat, x = y -> S x = S y.
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+\begin{coq_example*}
+Definition pred (n:nat) : nat :=
+  match n with
+  | 0 => 0
+  | S u => u
+  end.
+Theorem pred_Sn : forall m:nat, m = pred (S m).
+Theorem eq_add_S : forall n m:nat, S n = S m -> n = m.
+Hint Immediate eq_add_S : core.
+Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m.
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+\begin{coq_example*}
+Definition IsSucc (n:nat) : Prop :=
+  match n with
+  | 0 => False
+  | S p => True
+  end.
+Theorem O_S : forall n:nat, 0 <> S n.
+Theorem n_Sn : forall n:nat, n <> S n.
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+\begin{coq_example*}
+Fixpoint plus (n m:nat) {struct n} : nat :=
+  match n with
+  | 0 => m
+  | S p => S (plus p m)
+  end.
+Lemma plus_n_O : forall n:nat, n = plus n 0.
+Lemma plus_n_Sm : forall n m:nat, S (plus n m) = plus n (S m).
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+\begin{coq_example*}
+Fixpoint mult (n m:nat) {struct n} : nat :=
+  match n with
+  | 0 => 0
+  | S p => m + mult p m
+  end.
+Lemma mult_n_O : forall n:nat, 0 = mult n 0.
+Lemma mult_n_Sm : forall n m:nat, plus (mult n m) n = mult n (S m).
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+
+Finally, it gives the definition of the usual orderings \verb:le:,
+\verb:lt:, \verb:ge:, and \verb:gt:.
+\ttindex{le}
+\ttindex{le\_n}
+\ttindex{le\_S}
+\ttindex{lt}
+\ttindex{ge}
+\ttindex{gt}
+
+\begin{coq_example*}
+Inductive le (n:nat) : nat -> Prop :=
+  | le_n : le n n
+  | le_S : forall m:nat, le n m -> le n (S m).
+Infix "+" := plus : nat_scope.
+Definition lt (n m:nat) := S n <= m.
+Definition ge (n m:nat) := m <= n.
+Definition gt (n m:nat) := m < n.
+\end{coq_example*}
+
+Properties of these relations are not initially known, but may be
+required by the user from modules \verb:Le: and \verb:Lt:.  Finally,
+\verb:Peano: gives some lemmas allowing pattern-matching, and a double
+induction principle.
+
+\ttindex{nat\_case}
+\ttindex{nat\_double\_ind}
+
+\begin{coq_example*}
+Theorem nat_case :
+ forall (n:nat) (P:nat -> Prop), P 0 -> (forall m:nat, P (S m)) -> P n.
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+\begin{coq_example*}
+Theorem nat_double_ind :
+ forall R:nat -> nat -> Prop,
+   (forall n:nat, R 0 n) ->
+   (forall n:nat, R (S n) 0) ->
+   (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m.
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+
+\subsection{Well-founded recursion}
+
+The basic library contains the basics of well-founded recursion and 
+well-founded induction\footnote{This is defined in module {\tt Wf.v}}.
+\index{Well foundedness}
+\index{Recursion}
+\index{Well founded induction}
+\ttindex{Acc}
+\ttindex{Acc\_inv}
+\ttindex{Acc\_rec}
+\ttindex{well\_founded}
+
+\begin{coq_example*}
+Section Well_founded.
+Variable A : Set.
+Variable R : A -> A -> Prop.
+Inductive Acc : A -> Prop :=
+    Acc_intro : forall x:A, (forall y:A, R y x -> Acc y) -> Acc x.
+Lemma Acc_inv : forall x:A, Acc x -> forall y:A, R y x -> Acc y.
+\end{coq_example*}
+\begin{coq_eval}
+simple destruct 1; trivial.
+Defined.
+\end{coq_eval}
+\begin{coq_example*}
+Section AccRec.
+Variable P : A -> Set.
+Variable F :
+    forall x:A,
+      (forall y:A, R y x -> Acc y) -> (forall y:A, R y x -> P y) -> P x.
+Fixpoint Acc_rec (x:A) (a:Acc x) {struct a} : P x :=
+  F x (Acc_inv x a)
+    (fun (y:A) (h:R y x) => Acc_rec y (Acc_inv x a y h)).
+End AccRec.
+Definition well_founded := forall a:A, Acc a.
+Hypothesis Rwf : well_founded.
+Theorem well_founded_induction :
+ forall P:A -> Set,
+   (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a.
+Theorem well_founded_ind :
+ forall P:A -> Prop,
+   (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a.
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+{\tt Acc\_rec} can be used to define functions by fixpoints using
+well-founded relations to  justify termination. Assuming
+extensionality of the functional used for the recursive call, the
+fixpoint equation can be proved.
+\ttindex{Fix\_F}
+\ttindex{fix\_eq}
+\ttindex{Fix\_F\_inv}
+\ttindex{Fix\_F\_eq}
+\begin{coq_example*}
+Section FixPoint.
+Variable P : A -> Set.
+Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x.
+Fixpoint Fix_F (x:A) (r:Acc x) {struct r} : P x :=
+  F x (fun (y:A) (p:R y x) => Fix_F y (Acc_inv x r y p)).
+Definition Fix (x:A) := Fix_F x (Rwf x).
+Hypothesis F_ext :
+    forall (x:A) (f g:forall y:A, R y x -> P y),
+      (forall (y:A) (p:R y x), f y p = g y p) -> F x f = F x g.
+Lemma Fix_F_eq :
+ forall (x:A) (r:Acc x),
+   F x (fun (y:A) (p:R y x) => Fix_F y (Acc_inv x r y p)) = Fix_F x r.
+Lemma Fix_F_inv : forall (x:A) (r s:Acc x), Fix_F x r = Fix_F x s.
+Lemma fix_eq : forall x:A, Fix x = F x (fun (y:A) (p:R y x) => Fix y).
+\end{coq_example*}
+\begin{coq_eval}
+Abort All.
+\end{coq_eval}
+\begin{coq_example*}
+End FixPoint.
+End Well_founded.
+\end{coq_example*}
+
+\subsection{Accessing the {\Type} level}
+
+The basic library includes the definitions\footnote{This is in module
+{\tt Logic\_Type.v}} of the counterparts of some datatypes and logical
+quantifiers at the \verb:Type: level: negation, pair, and properties
+of {\tt identity}.
+
+\ttindex{notT}
+\ttindex{prodT}
+\ttindex{pairT}
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example*}
+Definition notT (A:Type) := A -> False.
+Inductive prodT (A B:Type) : Type := pairT (_:A) (_:B).
+\end{coq_example*}
+
+
+At the end, it defines datatypes at the {\Type} level.
+
+\section{The standard library}
+
+\subsection{Survey}
+
+The rest of the standard library is structured into the following 
+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 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 Relations} & Relations (definitions and basic results). \\
+ {\bf Sorting} & Sorted list (basic definitions and heapsort correctness). \\
+ {\bf Wellfounded} & Well-founded relations (basic results). \\
+
+\end{tabular}
+\medskip
+
+These directories belong to the initial load path of the system, and
+the modules they provide are compiled at installation time. So they
+are directly accessible with the command \verb!Require! (see
+chapter~\ref{Other-commands}). 
+
+The different modules of the \Coq\ standard library are described in the
+additional document \verb!Library.dvi!. They are also accessible on the WWW
+through the \Coq\ homepage
+\footnote{\texttt{http://coq.inria.fr}}.
+
+\subsection{Notations for integer arithmetics}
+\index{Arithmetical notations}
+
+On figure \ref{zarith-syntax} is described the syntax of expressions
+for integer arithmetics. It is provided by requiring and opening the
+module {\tt ZArith} and opening scope {\tt Z\_scope}.
+
+\ttindex{+}
+\ttindex{*}
+\ttindex{-}
+\ttindex{/}
+\ttindex{<=}
+\ttindex{>=}
+\ttindex{<}
+\ttindex{>}
+\ttindex{?=}
+\ttindex{mod}
+
+\begin{figure}
+\begin{center}
+\begin{tabular}{l|l|l|l}
+Notation & Interpretation & Precedence & Associativity\\
+\hline
+\verb!_ < _! & {\tt Zlt} &&\\
+\verb!x <= y! & {\tt Zle} &&\\
+\verb!_ > _! & {\tt Zgt} &&\\
+\verb!x >= y! & {\tt Zge} &&\\
+\verb!x < y < z! & {\tt x < y \verb!/\! y < z} &&\\
+\verb!x < y <= z! & {\tt x < y \verb!/\! y <= z} &&\\
+\verb!x <= y < z! & {\tt x <= y \verb!/\! y < z} &&\\
+\verb!x <= y <= z! & {\tt x <= y \verb!/\! y <= z} &&\\
+\verb!_ ?= _! & {\tt Zcompare} & 70 & no\\
+\verb!_ + _! & {\tt Zplus} &&\\
+\verb!_ - _! & {\tt Zminus} &&\\
+\verb!_ * _! & {\tt Zmult} &&\\
+\verb!_ / _! & {\tt Zdiv} &&\\
+\verb!_ mod _! & {\tt Zmod} & 40 & no \\
+\verb!- _!  & {\tt Zopp} &&\\
+\verb!_ ^ _! & {\tt Zpower} &&\\
+\end{tabular}
+\end{center}
+\label{zarith-syntax}
+\caption{Definition of the scope for integer arithmetics ({\tt Z\_scope})}
+\end{figure}
+
+Figure~\ref{zarith-syntax} shows the notations provided by {\tt
+Z\_scope}. It specifies how notations are interpreted and, when not
+already reserved, the precedence and associativity.
+
+\begin{coq_example}
+Require Import ZArith.
+Check  (2 + 3)%Z.
+Open Scope Z_scope.
+Check 2 + 3.
+\end{coq_example}
+
+\subsection{Peano's arithmetic (\texttt{nat})}
+\index{Peano's arithmetic}
+\ttindex{nat\_scope}
+
+While in the initial state, many operations and predicates of Peano's
+arithmetic are defined, further operations and results belong to other
+modules. For instance, the decidability of the basic predicates are
+defined here. This is provided by requiring the module {\tt Arith}.
+
+Figure~\ref{nat-syntax} describes notation available in scope {\tt
+nat\_scope}.
+
+\begin{figure}
+\begin{center}
+\begin{tabular}{l|l}
+Notation & Interpretation \\
+\hline
+\verb!_ < _! & {\tt lt} \\
+\verb!x <= y! & {\tt le} \\
+\verb!_ > _! & {\tt gt} \\
+\verb!x >= y! & {\tt ge} \\
+\verb!x < y < z! & {\tt x < y \verb!/\! y < z} \\
+\verb!x < y <= z! & {\tt x < y \verb!/\! y <= z} \\
+\verb!x <= y < z! & {\tt x <= y \verb!/\! y < z} \\
+\verb!x <= y <= z! & {\tt x <= y \verb!/\! y <= z} \\
+\verb!_ + _! & {\tt plus} \\
+\verb!_ - _! & {\tt minus} \\
+\verb!_ * _! & {\tt mult} \\
+\end{tabular}
+\end{center}
+\label{nat-syntax}
+\caption{Definition of the scope for natural numbers ({\tt nat\_scope})}
+\end{figure}
+
+\subsection{Real numbers library}
+
+\subsubsection{Notations for real numbers}
+\index{Notations for real numbers}
+
+This is provided by requiring and opening the module {\tt Reals} and
+opening scope {\tt R\_scope}. This set of notations is very similar to
+the notation for integer arithmetics. The inverse function was added.
+\begin{figure}
+\begin{center}
+\begin{tabular}{l|l}
+Notation & Interpretation \\
+\hline
+\verb!_ < _! & {\tt Rlt} \\
+\verb!x <= y! & {\tt Rle} \\
+\verb!_ > _! & {\tt Rgt} \\
+\verb!x >= y! & {\tt Rge} \\
+\verb!x < y < z! & {\tt x < y \verb!/\! y < z} \\
+\verb!x < y <= z! & {\tt x < y \verb!/\! y <= z} \\
+\verb!x <= y < z! & {\tt x <= y \verb!/\! y < z} \\
+\verb!x <= y <= z! & {\tt x <= y \verb!/\! y <= z} \\
+\verb!_ + _! & {\tt Rplus} \\
+\verb!_ - _! & {\tt Rminus} \\
+\verb!_ * _! & {\tt Rmult} \\
+\verb!_ / _! & {\tt Rdiv} \\
+\verb!- _!  & {\tt Ropp} \\
+\verb!/ _!  & {\tt Rinv} \\
+\verb!_ ^ _! & {\tt pow} \\
+\end{tabular}
+\end{center}
+\label{reals-syntax}
+\caption{Definition of the scope for real arithmetics ({\tt R\_scope})}
+\end{figure}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example}
+Require Import Reals.
+Check  (2 + 3)%R.
+Open Scope R_scope.
+Check 2 + 3.
+\end{coq_example}
+
+\subsubsection{Some tactics}
+
+In addition to the \verb|ring|, \verb|field| and \verb|fourier|
+tactics (see Chapter~\ref{Tactics}) there are:
+\begin{itemize}
+\item {\tt discrR} \tacindex{discrR}
+  
+  Proves that a real integer constant $c_1$ is different from another
+  real integer constant $c_2$.  
+
+\begin{coq_example*}
+Require Import DiscrR.
+Goal 5 <> 0.
+\end{coq_example*}
+
+\begin{coq_example}
+discrR.
+\end{coq_example}
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\item {\tt split\_Rabs} allows to unfold {\tt Rabs} constant and splits 
+corresponding conjonctions.
+\tacindex{split\_Rabs}
+
+\begin{coq_example*}
+Require Import SplitAbsolu.
+Goal forall x:R, x <= Rabs x.
+\end{coq_example*}
+
+\begin{coq_example}
+intro; split_Rabs.
+\end{coq_example}
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\item {\tt split\_Rmult} allows to split a condition that a product is
+  non null into subgoals corresponding to the condition on each
+  operand of the product. 
+\tacindex{split\_Rmult}
+
+\begin{coq_example*}
+Require Import SplitRmult.
+Goal forall x y z:R, x * y * z <> 0.
+\end{coq_example*}
+
+\begin{coq_example}
+intros; split_Rmult.
+\end{coq_example}
+
+\end{itemize}
+
+All this tactics has been written with the tactic language Ltac
+described in Chapter~\ref{TacticLanguage}.  More details are available
+in document \url{http://coq.inria.fr/~desmettr/Reals.ps}.
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\subsection{List library}
+\index{Notations for lists}
+\ttindex{length}
+\ttindex{head}
+\ttindex{tail}
+\ttindex{app}
+\ttindex{rev}
+\ttindex{nth}
+\ttindex{map}
+\ttindex{flat\_map}
+\ttindex{fold\_left}
+\ttindex{fold\_right}
+
+Some elementary operations on polymorphic lists are defined here. They
+can be accessed by requiring module {\tt List}.
+
+It defines the following notions:
+\begin{center}
+\begin{tabular}{l|l}
+\hline
+{\tt length} & length \\
+{\tt head} & first element (with default) \\
+{\tt tail} & all but first element \\
+{\tt app} & concatenation \\
+{\tt rev} & reverse \\
+{\tt nth} & accessing $n$-th element (with default) \\
+{\tt map} & applying a function \\
+{\tt flat\_map} & applying a function returning lists \\
+{\tt fold\_left} & iterator (from head to tail) \\
+{\tt fold\_right} & iterator (from tail to head) \\
+\hline
+\end{tabular}
+\end{center}
+
+Table show notations available when opening scope {\tt list\_scope}.
+
+\begin{figure}
+\begin{center}
+\begin{tabular}{l|l|l|l}
+Notation & Interpretation & Precedence & Associativity\\
+\hline
+\verb!_ ++ _! & {\tt app} & 60 & right \\
+\verb!_ :: _! & {\tt cons} & 60 & right \\
+\end{tabular}
+\end{center}
+\label{list-syntax}
+\caption{Definition of the scope for lists ({\tt list\_scope})}
+\end{figure}
+
+
+\section{Users' contributions}
+\index{Contributions}
+\label{Contributions}
+
+Numerous users' contributions have been collected and are available at
+URL \url{coq.inria.fr/contribs/}.  On this web page, you have a list
+of all contributions with informations (author, institution, quick
+description, etc.) and the possibility to download them one by one.
+There is a small search engine to look for keywords in all
+contributions.  You will also find informations on how to submit a new
+contribution.
+
+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 $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-ltac.tex b/doc/refman/RefMan-ltac.tex
new file mode 100644
index 00000000..eced8099
--- /dev/null
+++ b/doc/refman/RefMan-ltac.tex
@@ -0,0 +1,1057 @@
+\chapter{The tactic language}
+\label{TacticLanguage}
+
+%\geometry{a4paper,body={5in,8in}}
+
+This chapter gives a compact documentation of Ltac, the tactic
+language available in {\Coq}. We start by giving the syntax, and next,
+we present the informal semantics. If you want to know more regarding
+this language and especially about its fundations, you can refer
+to~\cite{Del00}. Chapter~\ref{Tactics-examples} is devoted to giving
+examples of use of this language on small but also with non-trivial
+problems.
+
+
+\section{Syntax}
+
+\def\tacexpr{\textrm{\textsl{expr}}}
+\def\tacexprlow{\textrm{\textsl{tacexpr$_1$}}}
+\def\tacexprinf{\textrm{\textsl{tacexpr$_2$}}}
+\def\tacexprpref{\textrm{\textsl{tacexpr$_3$}}}
+\def\atom{\textrm{\textsl{atom}}}
+\def\recclause{\textrm{\textsl{rec\_clause}}}
+\def\letclause{\textrm{\textsl{let\_clause}}}
+\def\matchrule{\textrm{\textsl{match\_rule}}}
+\def\contextrule{\textrm{\textsl{context\_rule}}}
+\def\contexthyps{\textrm{\textsl{context\_hyps}}}
+\def\tacarg{\nterm{tacarg}}
+\def\cpattern{\nterm{cpattern}}
+
+The syntax of the tactic language is given Figures~\ref{ltac}
+and~\ref{ltac_aux}. See page~\pageref{BNF-syntax} for a description of
+the BNF metasyntax used in these grammar rules. Various already defined
+entries will be used in this chapter: entries {\naturalnumber},
+{\integer}, {\ident}, {\qualid}, {\term}, {\cpattern} and {\atomictac}
+represent respectively the natural and integer numbers, the authorized
+identificators and qualified names, {\Coq}'s terms and patterns and
+all the atomic tactics described in chapter~\ref{Tactics}. The syntax
+of {\cpattern} is the same as that of terms, but there can be specific
+variables like {\tt ?id} where {\tt id} is a {\ident} or {\tt \_},
+which are metavariables for pattern matching. {\tt ?id} allows us to
+keep instantiations and to make constraints whereas {\tt \_} shows
+that we are not interested in what will be matched. On the right hand
+side, they are used without the question mark.
+
+The main entry of the grammar is {\tacexpr}. This language is used in
+proof mode but it can also be used in toplevel definitions as shown in
+Figure~\ref{ltactop}.
+
+\begin{Remarks}
+\item The infix tacticals ``\dots\ {\tt ||} \dots'' and ``\dots\ {\tt
+    ;} \dots'' are associative. 
+
+\item As shown by the figure, tactical {\tt ||} binds more than the
+prefix tacticals {\tt try}, {\tt repeat}, {\tt do}, {\tt info} and
+{\tt abstract} which themselves bind more than the postfix tactical
+``{\tt \dots\ ;[ \dots\ ]}'' which binds more than ``\dots\ {\tt ;}
+\dots''.
+
+For instance
+\begin{quote}
+{\tt try repeat \tac$_1$ ||
+  \tac$_2$;\tac$_3$;[\tac$_{31}$|\dots|\tac$_{3n}$];\tac$_4$.}
+\end{quote}
+is understood as 
+\begin{quote}
+{\tt (try (repeat (\tac$_1$ || \tac$_2$)));} \\
+{\tt ((\tac$_3$;[\tac$_{31}$|\dots|\tac$_{3n}$]);\tac$_4$).}
+\end{quote}
+\end{Remarks}
+
+
+\begin{figure}[htbp]
+\begin{centerframe}
+\begin{tabular}{lcl}
+{\tacexpr} & ::= &
+           {\tacexpr} {\tt ;} {\tacexpr}\\
+& | & {\tacexpr} {\tt ; [} \nelist{\tacexpr}{|} {\tt ]}\\
+& | & {\tacexprpref}\\
+\\
+{\tacexprpref} & ::= &
+           {\tt do} {\it (}{\naturalnumber} {\it |} {\ident}{\it )} {\tacexprpref}\\
+& | & {\tt info} {\tacexprpref}\\
+& | & {\tt progress} {\tacexprpref}\\
+& | & {\tt repeat} {\tacexprpref}\\
+& | & {\tt try} {\tacexprpref}\\
+& | & {\tacexprinf} \\
+\\
+{\tacexprinf} & ::= &
+           {\tacexprlow} {\tt ||} {\tacexprpref}\\
+& | & {\tacexprlow}\\
+\\
+{\tacexprlow} & ::= &
+{\tt fun} \nelist{\name}{} {\tt =>} {\atom}\\
+& | &
+{\tt let} \nelist{\letclause}{\tt with} {\tt in}
+{\atom}\\
+& | &
+{\tt let rec} \nelist{\recclause}{\tt with} {\tt in}
+{\tacexpr}\\
+& | &
+{\tt match goal with} \nelist{\contextrule}{\tt |} {\tt end}\\
+& | &
+{\tt match reverse goal with} \nelist{\contextrule}{\tt |} {\tt end}\\
+& | &
+{\tt match} {\tacexpr} {\tt with} \nelist{\matchrule}{\tt |} {\tt end}\\
+& | & {\tt abstract} {\atom}\\
+& | & {\tt abstract} {\atom} {\tt using} {\ident} \\
+& | & {\tt first [} \nelist{\tacexpr}{\tt |} {\tt ]}\\
+& | & {\tt solve [} \nelist{\tacexpr}{\tt |} {\tt ]}\\
+& | & {\tt idtac} ~|~ {\tt idtac} {\qstring}\\
+& | & {\tt fail} ~|~ {\tt fail} {\naturalnumber} {\qstring}\\
+& | & {\tt fresh} ~|~ {\tt fresh} {\qstring}\\
+& | & {\tt context} {\ident} {\tt [} {\term} {\tt ]}\\
+& | & {\tt eval} {\nterm{redexpr}} {\tt in} {\term}\\
+& | & {\tt type of} {\term}\\
+& | & {\tt constr :} {\term}\\
+& | & \atomictac\\
+& | & {\qualid} \nelist{\tacarg}{}\\
+& | & {\atom}\\
+\\
+{\atom} & ::= &
+           {\qualid} \\
+& | & ()\\
+& | & {\tt (} {\tacexpr} {\tt )}\\
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of the tactic language}
+\label{ltac}
+\end{figure}
+
+
+
+\begin{figure}[htbp]
+\begin{centerframe}
+\begin{tabular}{lcl}
+\tacarg & ::= & 
+        {\qualid}\\
+& $|$ & {\tt ()} \\
+& $|$ & {\tt ltac :} {\atom}\\
+& $|$ & {\term}\\
+\\
+\letclause & ::= & {\ident} \sequence{\name}{} {\tt :=} {\tacexpr}\\
+\\
+\recclause & ::= & {\ident} \nelist{\name}{} {\tt :=} {\tacexpr}\\
+\\
+\contextrule & ::= &
+  \nelist{\contexthyps}{\tt ,} {\tt |-}{\cpattern} {\tt =>} {\tacexpr}\\
+& $|$ & {\tt |-} {\cpattern} {\tt =>} {\tacexpr}\\
+& $|$ & {\tt \_ =>} {\tacexpr}\\
+\\
+\contexthyps & ::= & {\name} {\tt :} {\cpattern}\\
+\\
+\matchrule & ::= &
+           {\cpattern} {\tt =>} {\tacexpr}\\
+& $|$ & {\tt context} {\zeroone{\ident}} {\tt [} {\cpattern} {\tt ]} {\tt =>} {\tacexpr}\\
+& $|$ & {\tt \_ =>} {\tacexpr}\\
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of the tactic language (continued)}
+\label{ltac_aux}
+\end{figure}
+
+\begin{figure}[ht]
+\begin{centerframe}
+\begin{tabular}{lcl}
+\nterm{top} & ::= & {\tt Ltac} \nelist{\nterm{ltac\_def}} {\tt with} \\
+\\
+\nterm{ltac\_def} & ::= & {\ident} \sequence{\ident}{} {\tt :=} {\tacexpr}
+\end{tabular}
+\end{centerframe}
+\caption{Tactic toplevel definitions}
+\label{ltactop}
+\end{figure}
+
+
+%%
+%% Semantics
+%%
+\section{Semantics}
+%\index[tactic]{Tacticals}
+\index{Tacticals}
+%\label{Tacticals}
+
+Tactic expressions can only be applied in the context of a goal.  The
+evaluation yields either a term, an integer or a tactic. Intermediary
+results can be terms or integers but the final result must be a tactic
+which is then applied to the current goal.
+
+There is a special case for {\tt match goal} expressions of which
+the clauses evaluate to tactics. Such expressions can only be used as
+end result of a tactic expression (never as argument of a local
+definition or of an application).
+
+The rest of this section explains the semantics of every construction
+of Ltac.
+
+
+%% \subsection{Values}
+
+%% Values are given by Figure~\ref{ltacval}. All these values are tactic values,
+%% i.e. to be applied to a goal, except {\tt Fun}, {\tt Rec} and $arg$ values.
+
+%% \begin{figure}[ht]
+%% \noindent{}\framebox[6in][l]
+%% {\parbox{6in}
+%% {\begin{center}
+%% \begin{tabular}{lp{0.1in}l}
+%% $vexpr$ & ::= & $vexpr$ {\tt ;} $vexpr$\\
+%% & | & $vexpr$ {\tt ; [} {\it (}$vexpr$ {\tt |}{\it )}$^*$ $vexpr$ {\tt
+%% ]}\\
+%% & | & $vatom$\\
+%% \\
+%% $vatom$ & ::= & {\tt Fun} \nelist{\inputfun}{}  {\tt ->} {\tacexpr}\\
+%% %& | & {\tt Rec} \recclause\\
+%% & | &
+%% {\tt Rec} \nelist{\recclause}{\tt And} {\tt In}
+%% {\tacexpr}\\
+%% & | &
+%% {\tt Match Context With} {\it (}$context\_rule$ {\tt |}{\it )}$^*$
+%% $context\_rule$\\
+%% & | & {\tt (} $vexpr$ {\tt )}\\
+%% & | & $vatom$ {\tt Orelse} $vatom$\\
+%% & | & {\tt Do} {\it (}{\naturalnumber} {\it |} {\ident}{\it )} $vatom$\\
+%% & | & {\tt Repeat} $vatom$\\
+%% & | & {\tt Try} $vatom$\\
+%% & | & {\tt First [} {\it (}$vexpr$ {\tt |}{\it )}$^*$ $vexpr$ {\tt ]}\\
+%% & | & {\tt Solve [} {\it (}$vexpr$ {\tt |}{\it )}$^*$ $vexpr$ {\tt ]}\\
+%% & | & {\tt Idtac}\\
+%% & | & {\tt Fail}\\
+%% & | & {\primitivetactic}\\
+%% & | & $arg$
+%% \end{tabular}
+%% \end{center}}}
+%% \caption{Values of ${\cal L}_{tac}$}
+%% \label{ltacval}
+%% \end{figure}
+
+%% \subsection{Evaluation}
+
+\subsubsection{Sequence}
+\tacindex{;}
+\index{Tacticals!;@{\tt {\tac$_1$};\tac$_2$}}
+
+A sequence is an expression of the following form:
+\begin{quote}
+{\tacexpr}$_1$ {\tt ;} {\tacexpr}$_2$
+\end{quote}
+{\tacexpr}$_1$ and {\tacexpr}$_2$ are evaluated to $v_1$ and
+$v_2$. $v_1$ and $v_2$ must be tactic values. $v_1$ is then applied
+and $v_2$ is applied to every subgoal generated by the application of
+$v_1$. Sequence is left associating.
+
+\subsubsection{General sequence}
+\tacindex{;[\ldots$\mid$\ldots$\mid$\ldots]}
+%\tacindex{; [ | ]}
+%\index{; [ | ]@{\tt ;[\ldots$\mid$\ldots$\mid$\ldots]}}
+\index{Tacticals!; [ | ]@{\tt {\tac$_0$};[{\tac$_1$}$\mid$\ldots$\mid$\tac$_n$]}}
+
+We can generalize the previous sequence operator as
+\begin{quote}
+{\tacexpr}$_0$ {\tt ; [} {\tacexpr}$_1$ {\tt |} $...$ {\tt |}
+{\tacexpr}$_n$ {\tt ]}
+\end{quote}
+{\tacexpr}$_i$ is evaluated to $v_i$, for $i=0,...,n$. $v_0$ is
+applied and $v_i$ is applied to the $i$-th generated subgoal by the
+application of $v_0$, for $=1,...,n$. It fails if the application of
+$v_0$ does not generate exactly $n$ subgoals.
+
+\subsubsection{For loop}
+\tacindex{do}
+\index{Tacticals!do@{\tt do}}
+
+There is a for loop that repeats a tactic {\num} times:
+\begin{quote}
+{\tt do} {\num} {\tacexpr}
+\end{quote}
+{\tacexpr} is evaluated to $v$. $v$ must be a tactic value. $v$ is
+applied {\num} times. Supposing ${\num}>1$, after the first
+application of $v$, $v$ is applied, at least once, to the generated
+subgoals and so on. It fails if the application of $v$ fails before
+the {\num} applications have been completed.
+
+\subsubsection{Repeat loop}
+\tacindex{repeat}
+\index{Tacticals!repeat@{\tt repeat}}
+
+We have a repeat loop with:
+\begin{quote}
+{\tt repeat} {\tacexpr}
+\end{quote}
+{\tacexpr} is evaluated to $v$. $v$ must be a tactic value. $v$ is
+applied until it fails. Supposing $n>1$, after the first application
+of $v$, $v$ is applied, at least once, to the generated subgoals and
+so on. It stops when it fails for all the generated subgoals. It never
+fails.
+
+\subsubsection{Error catching}
+\tacindex{try}
+\index{Tacticals!try@{\tt try}}
+
+We can catch the tactic errors with:
+\begin{quote}
+{\tt try} {\tacexpr}
+\end{quote}
+{\tacexpr} is evaluated to $v$. $v$ must be a tactic value. $v$ is
+applied. If the application of $v$ fails, it catches the error and
+leaves the goal unchanged. If the level of the exception is positive,
+then the exception is re-raised with its level decremented.
+
+\subsubsection{Detecting progress}
+\tacindex{progress}
+
+We can check if a tactic made progress with:
+\begin{quote}
+{\tt progress} {\tacexpr}
+\end{quote}
+{\tacexpr} is evaluated to $v$. $v$ must be a tactic value. $v$ is
+applied. If the application of $v$ produced one subgoal equal to the
+initial goal (up to syntactical equality), then an error of level 0 is
+raised. 
+
+\ErrMsg \errindex{Failed to progress}
+
+\subsubsection{Branching}
+\tacindex{$\mid\mid$}
+\index{Tacticals!orelse@{\tt $\mid\mid$}}
+
+We can easily branch with the following structure:
+\begin{quote}
+{\tacexpr}$_1$ {\tt ||} {\tacexpr}$_2$
+\end{quote}
+{\tacexpr}$_1$ and {\tacexpr}$_2$ are evaluated to $v_1$ and
+$v_2$. $v_1$ and $v_2$ must be tactic values. $v_1$ is applied and if
+it fails then $v_2$ is applied. Branching is left associating.
+
+\subsubsection{First tactic to work}
+\tacindex{first}
+\index{Tacticals!first@{\tt first}}
+
+We may consider the first tactic to work (i.e. which does not fail) among a
+panel of tactics:
+\begin{quote}
+{\tt first [} {\tacexpr}$_1$ {\tt |} $...$ {\tt |} {\tacexpr}$_n$ {\tt ]}
+\end{quote}
+{\tacexpr}$_i$ are evaluated to $v_i$ and $v_i$ must be tactic values, for 
+$i=1,...,n$. Supposing $n>1$, it applies $v_1$, if it works, it stops else it
+tries to apply $v_2$ and so on. It fails when there is no applicable tactic.
+
+\ErrMsg \errindex{No applicable tactic}
+
+\subsubsection{Solving}
+\tacindex{solve}
+\index{Tacticals!solve@{\tt solve}}
+
+We may consider the first to solve (i.e. which generates no subgoal) among a
+panel of tactics:
+\begin{quote}
+{\tt solve [} {\tacexpr}$_1$ {\tt |} $...$ {\tt |} {\tacexpr}$_n$ {\tt ]}
+\end{quote}
+{\tacexpr}$_i$ are evaluated to $v_i$ and $v_i$ must be tactic values, for 
+$i=1,...,n$. Supposing $n>1$, it applies $v_1$, if it solves, it stops else it
+tries to apply $v_2$ and so on. It fails if there is no solving tactic.
+
+\ErrMsg \errindex{Cannot solve the goal}
+
+\subsubsection{Identity}
+\tacindex{idtac}
+\index{Tacticals!idtac@{\tt idtac}}
+
+The constant {\tt idtac} is the identity tactic: it leaves any goal
+unchanged but it appears in the proof script.
+\begin{quote}
+{\tt idtac} and {\tt idtac "message"}
+\end{quote}
+The latter variant prints the string on the standard output.
+
+
+\subsubsection{Failing}
+\tacindex{fail}
+\index{Tacticals!fail@{\tt fail}}
+
+The tactic {\tt fail} is the always-failing tactic: it does not solve
+any goal. It is useful for defining other tacticals since it can be
+catched by {\tt try} or {\tt match goal}. There are three variants:
+\begin{quote}
+{\tt fail $n$}, {\tt fail "message"} and {\tt fail $n$ "message"}
+\end{quote}
+The number $n$ is the failure level. If no level is specified, it
+defaults to $0$.  The level is used by {\tt try} and {\tt match goal}.
+If $0$, it makes {\tt match goal} considering the next clause
+(backtracking). If non zero, the current {\tt match goal} block or
+{\tt try} command is aborted and the level is decremented.
+
+\ErrMsg \errindex{Tactic Failure "message" (level $n$)}.
+
+\subsubsection{Local definitions}
+\index{Ltac!let}
+\index{Ltac!let rec}
+\index{let!in Ltac}
+\index{let rec!in Ltac}
+
+Local definitions can be done as follows:
+\begin{quote}
+{\tt let} {\ident}$_1$ {\tt :=} {\tacexpr}$_1$\\
+{\tt with} {\ident}$_2$ {\tt :=} {\tacexpr}$_2$\\
+...\\
+{\tt with} {\ident}$_n$ {\tt :=} {\tacexpr}$_n$ {\tt in}\\
+{\tacexpr}
+\end{quote}
+each {\tacexpr}$_i$ is evaluated to $v_i$, then, {\tacexpr} is
+evaluated by substituting $v_i$ to each occurrence of {\ident}$_i$,
+for $i=1,...,n$. There is no dependencies between the {\tacexpr}$_i$
+and the {\ident}$_i$.
+
+Local definitions can be recursive by using {\tt let rec} instead of
+{\tt let}. Only functions can be defined by recursion, so at least one
+argument is required.
+
+\subsubsection{Application}
+
+An application is an expression of the following form:
+\begin{quote}
+{\qualid} {\tacarg}$_1$ ... {\tacarg}$_n$
+\end{quote}
+The reference {\qualid} must be bound to some defined tactic
+definition expecting at least $n$ arguments.  The expressions
+{\tacexpr}$_i$ are evaluated to $v_i$, for $i=1,...,n$.
+%If {\tacexpr} is a {\tt Fun} or {\tt Rec} value then the body is evaluated by
+%substituting $v_i$ to the formal parameters, for $i=1,...,n$. For recursive
+%clauses, the bodies are lazily substituted (when an identifier to be evaluated
+%is the name of a recursive clause).
+
+%\subsection{Application of tactic values}
+
+\subsubsection{Function construction}
+\index{fun!in Ltac}
+\index{Ltac!fun}
+
+A parameterized tactic can be built anonymously (without resorting to
+local definitions) with:
+\begin{quote}
+{\tt fun} {\ident${}_1$} ... {\ident${}_n$} {\tt =>} {\tacexpr}
+\end{quote}
+Indeed, local definitions of functions are a syntactic sugar for
+binding a {\tt fun} tactic to an identifier.
+
+\subsubsection{Pattern matching on terms}
+\index{Ltac!match}
+\index{match!in Ltac}
+
+We can carry out pattern matching on terms with:
+\begin{quote}
+{\tt match} {\tacexpr} {\tt with}\\
+~~~{\cpattern}$_1$ {\tt =>} {\tacexpr}$_1$\\
+~{\tt |} {\cpattern}$_2$ {\tt =>} {\tacexpr}$_2$\\
+~...\\
+~{\tt |} {\cpattern}$_n$ {\tt =>} {\tacexpr}$_n$\\
+~{\tt |} {\tt \_} {\tt =>} {\tacexpr}$_{n+1}$\\
+{\tt end}
+\end{quote}
+The {\tacexpr} is evaluated and should yield a term which is matched
+(non-linear first order unification) against {\cpattern}$_1$ then
+{\tacexpr}$_1$ is evaluated into some value by substituting the
+pattern matching instantiations to the metavariables. If the matching
+with {\cpattern}$_1$ fails, {\cpattern}$_2$ is used and so on.  The
+pattern {\_} matches any term and shunts all remaining patterns if
+any. If {\tacexpr}$_1$ evaluates to a tactic, this tactic is not
+immediately applied to the current goal (in contrast with {\tt match
+goal}). If all clauses fail (in particular, there is no pattern {\_})
+then a no-matching error is raised.
+
+\begin{ErrMsgs}
+
+\item \errindex{No matching clauses for match}
+
+  No pattern can be used and, in particular, there is no {\tt \_} pattern.
+
+\item \errindex{Argument of match does not evaluate to a term}
+
+  This happens when {\tacexpr} does not denote a term.
+
+\end{ErrMsgs}
+
+\index{context!in pattern}
+There is a special form of patterns to match a subterm against the
+pattern:
+\begin{quote}
+{\tt context} {\ident} {\tt [} {\cpattern} {\tt ]}
+\end{quote}
+It matches any term which one subterm matches {\cpattern}. If there is
+a match, the optional {\ident} is assign the ``matched context'', that
+is the initial term where the matched subterm is replaced by a
+hole. The definition of {\tt context} in expressions below will show
+how to use such term contexts.
+
+This operator never makes backtracking. If there are several subterms
+matching the pattern, only the first match is considered. Note that
+the order of matching is left unspecified.
+%% TODO: clarify this point! It *should* be specified
+
+
+\subsubsection{Pattern matching on goals}
+\index{Ltac!match goal}
+\index{Ltac!match reverse goal}
+\index{match goal!in Ltac}
+\index{match reverse goal!in Ltac}
+
+We can make pattern matching on goals using the following expression:
+\begin{quote}
+\begin{tabbing}
+{\tt match goal with}\\
+~~\={\tt |} $hyp_{1,1}${\tt ,}...{\tt ,}$hyp_{1,m_1}$
+   ~~{\tt |-}{\cpattern}$_1${\tt =>} {\tacexpr}$_1$\\
+  \>{\tt |} $hyp_{2,1}${\tt ,}...{\tt ,}$hyp_{2,m_2}$
+   ~~{\tt |-}{\cpattern}$_2${\tt =>} {\tacexpr}$_2$\\
+~~...\\
+  \>{\tt |} $hyp_{n,1}${\tt ,}...{\tt ,}$hyp_{n,m_n}$
+   ~~{\tt |-}{\cpattern}$_n${\tt =>} {\tacexpr}$_n$\\
+  \>{\tt |\_}~~~~{\tt =>} {\tacexpr}$_{n+1}$\\
+{\tt end}
+\end{tabbing}
+\end{quote}
+
+% TODO: specify order of hypothesis and explain reverse...
+
+If each hypothesis pattern $hyp_{1,i}$, with $i=1,...,m_1$
+is matched (non-linear first order unification) by an hypothesis of
+the goal and if {\cpattern}$_1$ is matched by the conclusion of the
+goal, then {\tacexpr}$_1$ is evaluated to $v_1$ by substituting the
+pattern matching to the metavariables and the real hypothesis names
+bound to the possible hypothesis names occurring in the hypothesis
+patterns. If $v_1$ is a tactic value, then it is applied to the
+goal. If this application fails, then another combination of
+hypotheses is tried with the same proof context pattern. If there is
+no other combination of hypotheses then the second proof context
+pattern is tried and so on. If the next to last proof context pattern
+fails then {\tacexpr}$_{n+1}$ is evaluated to $v_{n+1}$ and $v_{n+1}$
+is applied.
+
+\ErrMsg \errindex{No matching clauses for match goal}
+
+  No goal pattern can be used and, in particular, there is no {\tt
+    \_} goal pattern.
+
+\medskip
+
+It is important to know that each hypothesis of the goal can be
+matched by at most one hypothesis pattern. The order of matching is
+the following: hypothesis patterns are examined from the right to the
+left (i.e. $hyp_{i,m_i}$ before $hyp_{i,1}$). For each hypothesis
+pattern, the goal hypothesis are matched in order (fresher hypothesis
+first), but it possible to reverse this order (older first) with
+the {\tt match reverse goal with} variant.
+
+\subsubsection{Filling a term context}
+\index{context!in expression}
+
+The following expression is not a tactic in the sense that it does not
+produce subgoals but generates a term to be used in tactic
+expressions:
+\begin{quote}
+{\tt context} {\ident} {\tt [} {\tacexpr} {\tt ]}
+\end{quote}
+{\ident} must denote a context variable bound by a {\tt context}
+pattern of a {\tt match} expression. This expression evaluates
+replaces the hole of the value of {\ident} by the value of
+{\tacexpr}.
+
+\ErrMsg \errindex{not a context variable}
+
+
+\subsubsection{Generating fresh hypothesis names}
+\index{Ltac!fresh}
+\index{fresh!in Ltac}
+
+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:
+\begin{quote}
+{\tt fresh} {\qstring}
+\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}.
+
+\subsubsection{{\tt type of} {\term}}
+%\tacindex{type of}
+\index{Ltac!type of}
+\index{type of!in Ltac}
+
+This tactic computes the type of {\term}.
+
+\subsubsection{Computing in a constr}
+\index{Ltac!eval}
+\index{eval!in Ltac}
+
+Evaluation of a term can be performed with:
+\begin{quote}
+{\tt eval} {\nterm{redexpr}} {\tt in} {\term}
+\end{quote}
+where \nterm{redexpr} is a reduction tactic among {\tt red}, {\tt
+hnf}, {\tt compute}, {\tt simpl}, {\tt cbv}, {\tt lazy}, {\tt unfold},
+{\tt fold}, {\tt pattern}.
+
+
+\subsubsection{Accessing tactic decomposition}
+\tacindex{info}
+\index{Tacticals!info@{\tt info}}
+
+Tactical ``{\tt info} {\tacexpr}'' is not really a tactical. For
+elementary tactics, this is equivalent to \tacexpr. For complex tactic
+like \texttt{auto}, it displays the operations performed by the
+tactic.
+
+\subsubsection{Proving a subgoal as a separate lemma}
+\tacindex{abstract}
+\index{Tacticals!abstract@{\tt abstract}}
+
+From the outside ``\texttt{abstract \tacexpr}'' is the same as
+{\tt solve \tacexpr}. Internally it saves an auxiliary lemma called 
+{\ident}\texttt{\_subproof}\textit{n} where {\ident} is the name of the
+current goal and \textit{n} is chosen so that this is a fresh name.
+
+This tactical is useful with tactics such as \texttt{omega} or
+\texttt{discriminate} that generate huge proof terms. With that tool
+the user can avoid the explosion at time of the \texttt{Save} command
+without having to cut manually the proof in smaller lemmas.
+
+\begin{Variants}
+\item \texttt{abstract {\tacexpr} using {\ident}}.\\
+  Give explicitly the name of the auxiliary lemma.
+\end{Variants}
+
+\ErrMsg \errindex{Proof is not complete}
+
+\section{Tactic toplevel definitions}
+\comindex{Ltac}
+
+Basically, tactics toplevel definitions are made as follows:
+%{\tt Tactic Definition} {\ident} {\tt :=} {\tacexpr}\\
+%
+%{\tacexpr} is evaluated to $v$ and $v$ is associated to {\ident}. Next, every
+%script is evaluated by substituting $v$ to {\ident}.
+%
+%We can define functional definitions by:\\
+\begin{quote}
+{\tt Ltac} {\ident} {\ident}$_1$ ... {\ident}$_n$ {\tt :=}
+{\tacexpr}
+\end{quote}
+This defines a new tactic that can be used in any tactic script or new
+tactic toplevel definition.
+
+\Rem The preceding definition can equivalently be written:
+\begin{quote}
+{\tt Ltac} {\ident} {\tt := fun} {\ident}$_1$ ... {\ident}$_n$
+{\tt =>} {\tacexpr}
+\end{quote}
+Recursive and mutual recursive function definitions are also
+possible with the syntax:
+\begin{quote}
+{\tt Ltac} {\ident}$_1$ {\ident}$_{1,1}$ ...
+{\ident}$_{1,m_1}$~~{\tt :=} {\tacexpr}$_1$\\
+{\tt with} {\ident}$_2$ {\ident}$_{2,1}$ ... {\ident}$_{2,m_2}$~~{\tt :=}
+{\tacexpr}$_2$\\
+...\\
+{\tt with} {\ident}$_n$ {\ident}$_{n,1}$ ... {\ident}$_{n,m_n}$~~{\tt :=}
+{\tacexpr}$_n$
+\end{quote}
+
+%This definition bloc is a set of definitions (use of
+%the same previous syntactical sugar) and the other scripts are evaluated as
+%usual except that the substitutions are lazily carried out (when an identifier
+%to be evaluated is the name of a recursive definition).
+
+\endinput
+
+
+\subsection{Permutation on closed lists}
+
+\begin{figure}[b]
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example*}
+Require Import List.
+Section Sort.
+Variable A : Set.
+Inductive permut : list A -> list A -> Prop :=
+  | permut_refl   : forall l, permut l l
+  | permut_cons   :
+      forall a l0 l1, permut l0 l1 -> permut (a :: l0) (a :: l1)
+  | permut_append : forall a l, permut (a :: l) (l ++ a :: nil)
+  | permut_trans  :
+      forall l0 l1 l2, permut l0 l1 -> permut l1 l2 -> permut l0 l2.
+End Sort.
+\end{coq_example*}
+\end{center}
+\caption{Definition of the permutation predicate}
+\label{permutpred}
+\end{figure}
+
+
+Another more complex example is the problem of permutation on closed
+lists. The aim is to show that a closed list is a permutation of
+another one.  First, we define the permutation predicate as shown on
+Figure~\ref{permutpred}.
+ 
+\begin{figure}[p]
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example}
+Ltac Permut n :=
+  match goal with
+  | |- (permut _ ?l ?l) => apply permut_refl
+  | |- (permut _ (?a :: ?l1) (?a :: ?l2)) =>
+      let newn := eval compute in (length l1) in
+      (apply permut_cons; Permut newn)
+  | |- (permut ?A (?a :: ?l1) ?l2) =>
+      match eval compute in n with
+      | 1 => fail
+      | _ =>
+          let l1' := constr:(l1 ++ a :: nil) in
+          (apply (permut_trans A (a :: l1) l1' l2);
+            [ apply permut_append | compute; Permut (pred n) ])
+      end
+  end.
+Ltac PermutProve :=
+  match goal with
+  | |- (permut _ ?l1 ?l2) =>
+      match eval compute in (length l1 = length l2) with
+      | (?n = ?n) => Permut n
+      end
+  end.
+\end{coq_example}
+\end{minipage}}
+\end{center}
+\caption{Permutation tactic}
+\label{permutltac}
+\end{figure}
+
+\begin{figure}[p]
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example*}
+Lemma permut_ex1 :
+  permut nat (1 :: 2 :: 3 :: nil) (3 :: 2 :: 1 :: nil).
+Proof.
+PermutProve.
+Qed.
+
+Lemma permut_ex2 :
+  permut nat
+    (0 :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: nil)
+    (0 :: 2 :: 4 :: 6 :: 8 :: 9 :: 7 :: 5 :: 3 :: 1 :: nil).
+Proof.
+PermutProve.
+Qed.
+\end{coq_example*}
+\end{minipage}}
+\end{center}
+\caption{Examples of {\tt PermutProve} use}
+\label{permutlem}
+\end{figure}
+
+Next, we can write naturally the tactic and the result can be seen on
+Figure~\ref{permutltac}. We can notice that we use two toplevel
+definitions {\tt PermutProve} and {\tt Permut}. The function to be
+called is {\tt PermutProve} which computes the lengths of the two
+lists and calls {\tt Permut} with the length if the two lists have the
+same length. {\tt Permut} works as expected.  If the two lists are
+equal, it concludes. Otherwise, if the lists have identical first
+elements, it applies {\tt Permut} on the tail of the lists.  Finally,
+if the lists have different first elements, it puts the first element
+of one of the lists (here the second one which appears in the {\tt
+  permut} predicate) at the end if that is possible, i.e., if the new
+first element has been at this place previously. To verify that all
+rotations have been done for a list, we use the length of the list as
+an argument for {\tt Permut} and this length is decremented for each
+rotation down to, but not including, 1 because for a list of length
+$n$, we can make exactly $n-1$ rotations to generate at most $n$
+distinct lists. Here, it must be noticed that we use the natural
+numbers of {\Coq} for the rotation counter. On Figure~\ref{ltac}, we
+can see that it is possible to use usual natural numbers but they are
+only used as arguments for primitive tactics and they cannot be
+handled, in particular, we cannot make computations with them. So, a
+natural choice is to use {\Coq} data structures so that {\Coq} makes
+the computations (reductions) by {\tt eval compute in} and we can get
+the terms back by {\tt match}.
+
+With {\tt PermutProve}, we can now prove lemmas such those shown on
+Figure~\ref{permutlem}.
+
+
+\subsection{Deciding intuitionistic propositional logic}
+
+\begin{figure}[tbp]
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example}
+Ltac Axioms :=
+  match goal with
+  | |- True => trivial
+  | _:False |- _  => elimtype False; assumption
+  | _:?A |- ?A  => auto
+  end.
+Ltac DSimplif :=
+  repeat
+   (intros;
+    match goal with
+     | id:(~ _) |- _ => red in id
+     | id:(_ /\ _) |- _ =>
+         elim id; do 2 intro; clear id
+     | id:(_ \/ _) |- _ =>
+         elim id; intro; clear id
+     | id:(?A /\ ?B -> ?C) |- _ =>
+         cut (A -> B -> C);
+          [ intro | intros; apply id; split; assumption ]
+     | id:(?A \/ ?B -> ?C) |- _ =>
+         cut (B -> C);
+          [ cut (A -> C);
+             [ intros; clear id
+             | intro; apply id; left; assumption ]
+          | intro; apply id; right; assumption ]
+     | id0:(?A -> ?B),id1:?A |- _ =>
+         cut B; [ intro; clear id0 | apply id0; assumption ]
+     | |- (_ /\ _) => split
+     | |- (~ _) => red
+     end).
+\end{coq_example}
+\end{minipage}}
+\end{center}
+\caption{Deciding intuitionistic propositions (1)}
+\label{tautoltaca}
+\end{figure}
+
+\begin{figure}
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example}
+Ltac TautoProp :=
+  DSimplif;
+   Axioms ||
+     match goal with
+     | id:((?A -> ?B) -> ?C) |- _ =>
+          cut (B -> C);
+          [ intro; cut (A -> B);
+             [ intro; cut C;
+                [ intro; clear id | apply id; assumption ]
+             | clear id ]
+          | intro; apply id; intro; assumption ]; TautoProp
+     | id:(~ ?A -> ?B) |- _ =>
+         cut (False -> B);
+          [ intro; cut (A -> False);
+             [ intro; cut B;
+                [ intro; clear id | apply id; assumption ]
+             | clear id ]
+          | intro; apply id; red; intro; assumption ]; TautoProp
+     | |- (_ \/ _) => (left; TautoProp) || (right; TautoProp)
+     end.
+\end{coq_example}
+\end{minipage}}
+\end{center}
+\caption{Deciding intuitionistic propositions (2)}
+\label{tautoltacb}
+\end{figure}
+
+The pattern matching on goals allows a complete and so a powerful
+backtracking when returning tactic values. An interesting application
+is the problem of deciding intuitionistic propositional logic.
+Considering the contraction-free sequent calculi {\tt LJT*} of
+Roy~Dyckhoff (\cite{Dyc92}), it is quite natural to code such a tactic
+using the tactic language. On Figure~\ref{tautoltaca}, the tactic {\tt
+  Axioms} tries to conclude using usual axioms. The {\tt DSimplif}
+tactic applies all the reversible rules of Dyckhoff's system.
+Finally, on Figure~\ref{tautoltacb}, the {\tt TautoProp} tactic (the
+main tactic to be called) simplifies with {\tt DSimplif}, tries to
+conclude with {\tt Axioms} and tries several paths using the
+backtracking rules (one of the four Dyckhoff's rules for the left
+implication to get rid of the contraction and the right or).
+
+\begin{figure}[tb]
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example*}
+Lemma tauto_ex1 : forall A B:Prop, A /\ B -> A \/ B.
+Proof.
+TautoProp.
+Qed.
+
+Lemma tauto_ex2 :
+   forall A B:Prop, (~ ~ B -> B) -> (A -> B) -> ~ ~ A -> B.
+Proof.
+TautoProp.
+Qed.
+\end{coq_example*}
+\end{minipage}}
+\end{center}
+\caption{Proofs of tautologies with {\tt TautoProp}}
+\label{tautolem}
+\end{figure}
+
+For example, with {\tt TautoProp}, we can prove tautologies like those of
+Figure~\ref{tautolem}.
+
+
+\subsection{Deciding type isomorphisms}
+
+A more tricky problem is to decide equalities between types and modulo
+isomorphisms. Here, we choose to use the isomorphisms of the simply typed
+$\lb{}$-calculus with Cartesian product and $unit$ type (see, for example,
+\cite{RC95}). The axioms of this $\lb{}$-calculus are given by
+Figure~\ref{isosax}.
+
+\begin{figure}
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example*}
+Open Scope type_scope.
+Section Iso_axioms.
+Variables A B C : Set.
+Axiom Com : A * B = B * A.
+Axiom Ass : A * (B * C) = A * B * C.
+Axiom Cur : (A * B -> C) = (A -> B -> C).
+Axiom Dis : (A -> B * C) = (A -> B) * (A -> C).
+Axiom P_unit : A * unit = A.
+Axiom AR_unit : (A -> unit) = unit.
+Axiom AL_unit : (unit -> A) = A.
+Lemma Cons : B = C -> A * B = A * C.
+Proof.
+intro Heq; rewrite Heq; apply refl_equal.
+Qed.
+End Iso_axioms.
+\end{coq_example*}
+\end{minipage}}
+\end{center}
+\caption{Type isomorphism axioms}
+\label{isosax}
+\end{figure}
+
+The tactic to judge equalities modulo this axiomatization can be written as
+shown on Figures~\ref{isosltac1} and~\ref{isosltac2}. The algorithm is quite
+simple. Types are reduced using axioms that can be oriented (this done by {\tt
+MainSimplif}). The normal forms are sequences of Cartesian
+products without Cartesian product in the left component. These normal forms
+are then compared modulo permutation of the components (this is done by {\tt
+CompareStruct}). The main tactic to be called and realizing this algorithm is
+{\tt IsoProve}.
+
+\begin{figure}
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example}
+Ltac DSimplif trm :=
+  match trm with
+  | (?A * ?B * ?C) =>
+      rewrite <- (Ass A B C); try MainSimplif
+  | (?A * ?B -> ?C) =>
+      rewrite (Cur A B C); try MainSimplif
+  | (?A -> ?B * ?C) =>
+      rewrite (Dis A B C); try MainSimplif
+  | (?A * unit) =>
+      rewrite (P_unit A); try MainSimplif
+  | (unit * ?B) =>
+      rewrite (Com unit B); try MainSimplif
+  | (?A -> unit) =>
+      rewrite (AR_unit A); try MainSimplif
+  | (unit -> ?B) =>
+      rewrite (AL_unit B); try MainSimplif
+  | (?A * ?B) =>
+      (DSimplif A; try MainSimplif) || (DSimplif B; try MainSimplif)
+  | (?A -> ?B) =>
+      (DSimplif A; try MainSimplif) || (DSimplif B; try MainSimplif)
+  end
+ with MainSimplif :=
+  match goal with
+  | |- (?A = ?B) => try DSimplif A; try DSimplif B
+  end.
+Ltac Length trm :=
+  match trm with
+  | (_ * ?B) => let succ := Length B in constr:(S succ)
+  | _ => constr:1
+  end.
+Ltac assoc := repeat rewrite <- Ass.
+\end{coq_example}
+\end{minipage}}
+\end{center}
+\caption{Type isomorphism tactic (1)}
+\label{isosltac1}
+\end{figure}
+
+\begin{figure}
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example}
+Ltac DoCompare n :=
+  match goal with
+  | [ |- (?A = ?A) ] => apply refl_equal
+  | [ |- (?A * ?B = ?A * ?C) ] =>
+    apply Cons; let newn := Length B in DoCompare newn
+  | [ |- (?A * ?B = ?C) ] =>
+    match eval compute in n with
+    | 1 => fail
+    | _ =>
+      pattern (A * B) at 1; rewrite Com; assoc; DoCompare (pred n)
+    end
+  end.
+Ltac CompareStruct :=
+  match goal with
+  | [ |- (?A = ?B) ] =>
+      let l1 := Length A
+      with l2 := Length B in
+      match eval compute in (l1 = l2) with
+      | (?n = ?n) => DoCompare n
+      end
+  end.
+Ltac IsoProve := MainSimplif; CompareStruct.
+\end{coq_example}
+\end{minipage}}
+\end{center}
+\caption{Type isomorphism tactic (2)}
+\label{isosltac2}
+\end{figure}
+
+Figure~\ref{isoslem} gives examples of what can be solved by {\tt IsoProve}.
+
+\begin{figure}
+\begin{center}
+\fbox{\begin{minipage}{0.95\textwidth}
+\begin{coq_example*}
+Lemma isos_ex1 : 
+  forall A B:Set, A * unit * B = B * (unit * A).
+Proof.
+intros; IsoProve.
+Qed.
+
+Lemma isos_ex2 :
+  forall A B C:Set,
+    (A * unit -> B * (C * unit)) =
+    (A * unit -> (C -> unit) * C) * (unit -> A -> B).
+Proof.
+intros; IsoProve.
+Qed.
+\end{coq_example*}
+\end{minipage}}
+\end{center}
+\caption{Type equalities solved by {\tt IsoProve}}
+\label{isoslem}
+\end{figure}
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-mod.tex b/doc/refman/RefMan-mod.tex
new file mode 100644
index 00000000..9f6f2abc
--- /dev/null
+++ b/doc/refman/RefMan-mod.tex
@@ -0,0 +1,396 @@
+\section{Module system
+\index{Modules}
+\label{section:Modules}}
+
+The module system provides a way of packaging related elements
+together, as well as a mean of massive abstraction.
+
+\begin{figure}[t]
+\begin{centerframe}
+\begin{tabular}{rcl}
+{\modtype}  & ::= & {\ident} \\
+ & $|$ & {\modtype} \texttt{ with Definition }{\ident} := {\term} \\
+ & $|$ & {\modtype} \texttt{ with Module }{\ident} := {\qualid} \\
+ &&\\
+
+{\onemodbinding}  & ::= & {\tt ( \nelist{\ident}{} : {\modtype} )}\\
+ &&\\
+
+{\modbindings} & ::= & \nelist{\onemodbinding}{}\\
+ &&\\
+
+{\modexpr} & ::= & \nelist{\qualid}{} 
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of modules}
+\end{figure}
+
+\subsection{\tt Module {\ident}
+\comindex{Module}}
+
+This command is used to start an interactive module named {\ident}.
+
+\begin{Variants}
+
+\item{\tt Module {\ident} {\modbindings}}
+
+  Starts an interactive functor with parameters given by {\modbindings}.
+
+\item{\tt Module {\ident} \verb.:. {\modtype}}
+
+  Starts an interactive module specifying its module type. 
+
+\item{\tt Module {\ident} {\modbindings} \verb.:. {\modtype}}
+
+  Starts an interactive functor with parameters given by
+  {\modbindings}, and output module type {\modtype}.
+
+\item{\tt Module {\ident} \verb.<:. {\modtype}}
+
+  Starts an interactive module satisfying {\modtype}. 
+
+\item{\tt Module {\ident} {\modbindings} \verb.<:. {\modtype}}
+
+  Starts an interactive functor with parameters given by
+  {\modbindings}. The output module type is verified against the
+  module type {\modtype}.
+
+\end{Variants}
+
+\subsection{\tt End {\ident}
+\comindex{End}}
+
+This command closes the interactive module {\ident}. If the module type
+was given the content of the module is matched against it and an error
+is signaled if the matching fails. If the module is basic (is not a
+functor) its components (constants, inductive types, submodules etc) are
+now available through the dot notation.
+
+\begin{ErrMsgs}
+\item \errindex{No such label {\ident}}
+\item \errindex{Signature components for label {\ident} do not match}
+\item \errindex{This is not the last opened module}
+\end{ErrMsgs}
+
+
+\subsection{\tt Module {\ident} := {\modexpr}
+\comindex{Module}}
+
+This command defines the module identifier {\ident} to be equal to
+{\modexpr}. 
+
+\begin{Variants}
+\item{\tt Module {\ident} {\modbindings} := {\modexpr}}
+
+ Defines a functor with parameters given by {\modbindings} and body {\modexpr}.
+
+% Particular cases of the next 2 items
+%\item{\tt Module {\ident} \verb.:. {\modtype} := {\modexpr}}
+%
+%  Defines a module with body {\modexpr} and interface {\modtype}.
+%\item{\tt Module {\ident} \verb.<:. {\modtype} := {\modexpr}}
+%
+%  Defines a module with body {\modexpr}, satisfying {\modtype}.
+
+\item{\tt Module {\ident} {\modbindings} \verb.:. {\modtype} :=
+    {\modexpr}}
+
+  Defines a functor with parameters given by {\modbindings} (possibly none),
+  and output module type {\modtype}, with body {\modexpr}. 
+
+\item{\tt Module {\ident} {\modbindings} \verb.<:. {\modtype} :=
+    {\modexpr}}
+
+  Defines a functor with parameters given by {\modbindings} (possibly none) 
+  with body {\modexpr}. The body is checked against {\modtype}.
+
+\end{Variants}
+
+\subsection{\tt Module Type {\ident}
+\comindex{Module Type}}
+
+This command is used to start an interactive module type {\ident}.
+
+\begin{Variants}
+
+\item{\tt Module Type {\ident} {\modbindings}}
+
+  Starts an interactive functor type with parameters given by {\modbindings}.
+
+\end{Variants}
+
+\subsection{\tt End {\ident}
+\comindex{End}}
+
+This command closes the interactive module type {\ident}.
+
+\begin{ErrMsgs}
+\item \errindex{This is not the last opened module type}
+\end{ErrMsgs}
+
+\subsection{\tt Module Type {\ident} := {\modtype}}
+
+Defines a module type {\ident} equal to {\modtype}.
+
+\begin{Variants}
+\item {\tt Module Type {\ident} {\modbindings} := {\modtype}}
+
+  Defines a functor type {\ident} specifying functors taking arguments
+  {\modbindings} and returning {\modtype}.
+\end{Variants}
+
+\subsection{\tt Declare Module {\ident}}
+
+Starts an interactive module declaration. This command is available
+only in module types. 
+
+\begin{Variants}
+
+\item{\tt Declare Module {\ident} {\modbindings}}
+
+  Starts an interactive declaration of a functor with parameters given
+  by {\modbindings}.
+
+% Particular case of the next item
+%\item{\tt Declare Module {\ident} \verb.<:. {\modtype}}
+%
+%  Starts an interactive declaration of a module satisfying {\modtype}.
+
+\item{\tt Declare Module {\ident} {\modbindings} \verb.<:. {\modtype}}
+
+  Starts an interactive declaration of a functor with parameters given
+  by {\modbindings} (possibly none). The declared output module type is
+  verified against the module type {\modtype}.
+
+\end{Variants}
+
+\subsection{\tt End {\ident}}
+
+This command closes the interactive declaration of module {\ident}.
+
+\subsection{\tt Declare Module {\ident} : {\modtype}}
+
+Declares a module of {\ident} of type {\modtype}. This command is available
+only in module types. 
+
+\begin{Variants}
+
+\item{\tt Declare Module {\ident} {\modbindings} \verb.:. {\modtype}}
+
+  Declares a functor with parameters {\modbindings} and output module
+  type {\modtype}.
+
+\item{\tt Declare Module {\ident} := {\qualid}}
+
+  Declares a module equal to the module {\qualid}.
+
+\item{\tt Declare Module {\ident} \verb.<:. {\modtype} := {\qualid}}
+
+  Declares a module equal to the module {\qualid}, verifying that the
+  module type of the latter is a subtype of {\modtype}.
+
+\end{Variants}
+
+
+\subsubsection{Example}
+
+Let us define a simple module.
+\begin{coq_example}
+Module M.
+  Definition T := nat.
+  Definition x := 0.
+  Definition y : bool.
+    exact true.
+  Defined.
+End M.
+\end{coq_example}
+Inside a module one can define constants, prove theorems and do any
+other things that can be done in the toplevel. Components of a closed
+module can be accessed using the dot notation:
+\begin{coq_example}
+Print M.x.
+\end{coq_example}
+A simple module type:
+\begin{coq_example}
+Module Type SIG.
+  Parameter T : Set.
+  Parameter x : T.
+End SIG.
+\end{coq_example}
+Inside a module type the proof editing mode is not available.
+Consequently commands like \texttt{Definition}\ without body,
+\texttt{Lemma}, \texttt{Theorem} are not allowed.  In order to declare
+constants, use \texttt{Axiom} and \texttt{Parameter}.
+
+Now we can create a new module from \texttt{M}, giving it a less
+precise specification: the \texttt{y} component is dropped as well
+as the body of \texttt{x}.
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is not correct and should produce **********)
+(***************** Error: N.y not a defined object *******************)
+\end{coq_eval}
+\begin{coq_example}
+Module N  :  SIG with Definition T := nat  :=  M.
+Print N.T.
+Print N.x.
+Print N.y.
+\end{coq_example}
+\begin{coq_eval}
+Reset N.
+\end{coq_eval}
+
+\noindent
+The definition of \texttt{N} using the module type expression
+\texttt{SIG with Definition T:=nat} is equivalent to the following
+one:
+
+\begin{coq_example*}
+Module Type SIG'.
+  Definition T : Set := nat.
+  Parameter x : T.
+End SIG'.
+Module N : SIG' := M.
+\end{coq_example*}
+If we just want to be sure that the our implementation satisfies a
+given module type without restricting the interface, we can use a
+transparent constraint
+\begin{coq_example}
+Module P <: SIG := M.
+Print P.y.
+\end{coq_example}
+Now let us create a functor, i.e. a parametric module
+\begin{coq_example}
+Module Two (X Y: SIG).
+\end{coq_example}
+\begin{coq_example*}
+  Definition T := (X.T * Y.T)%type.
+  Definition x := (X.x, Y.x).
+\end{coq_example*}
+\begin{coq_example}
+End Two.
+\end{coq_example}
+and apply it to our modules and do some computations
+\begin{coq_example}
+Module Q := Two M N.
+Eval compute in (fst Q.x + snd Q.x).
+\end{coq_example}
+In the end, let us define a module type with two sub-modules, sharing
+some of the fields and give one of its possible implementations:
+\begin{coq_example}
+Module Type SIG2.
+  Declare Module M1 : SIG.
+  Declare Module M2 <: SIG.
+    Definition T := M1.T.
+    Parameter x : T.
+  End M2.
+End SIG2.
+\end{coq_example}
+\begin{coq_example*}
+Module Mod <: SIG2.
+  Module M1.
+    Definition T := nat.
+    Definition x := 1.
+  End M1.
+  Module M2 := M.
+\end{coq_example*}
+\begin{coq_example}
+End Mod.
+\end{coq_example}
+Notice that \texttt{M} is a correct body for the component \texttt{M2}
+since its \texttt{T} component is equal \texttt{nat} and hence
+\texttt{M1.T} as specified.
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{Remarks}
+\item Modules and module types can be nested components of each other.
+\item When a module declaration is started inside a module type,
+  the proof editing mode is still unavailable.
+\item One can have sections inside a module or a module type, but
+  not a module or a module type inside a section.
+\item Commands like \texttt{Hint} or \texttt{Notation} can
+  also appear inside modules and module types. Note that in case of a
+  module definition like:
+
+    \medskip
+    \noindent
+    {\tt Module N : SIG := M.} 
+    \medskip
+
+    or
+
+    \medskip
+    {\tt Module N : SIG.\\
+      \ \ \dots\\
+      End N.}
+    \medskip 
+    
+    hints and the like valid for \texttt{N} are not those defined in
+    \texttt{M} (or the module body) but the ones defined in
+    \texttt{SIG}.
+
+\end{Remarks}
+
+\subsection{Import {\qualid}
+\comindex{Import}
+\label{Import}}
+
+If {\qualid} denotes a valid basic module (i.e. its module type is a
+signature), makes its components available by their short names.
+
+Example:
+
+\begin{coq_example}
+Module Mod.
+\end{coq_example}
+\begin{coq_example}
+  Definition T:=nat.
+  Check T.
+\end{coq_example}
+\begin{coq_example}
+End Mod.
+Check Mod.T.
+Check T. (* Incorrect ! *)
+Import Mod.
+Check T. (* Now correct *)
+\end{coq_example}
+\begin{coq_eval}
+Reset Mod.
+\end{coq_eval}
+
+
+\begin{Variants}
+\item{\tt Export {\qualid}}\comindex{Export}
+
+  When the module containing the command {\tt Export {\qualid}} is
+  imported, {\qualid} is imported as well.
+\end{Variants}
+
+\begin{ErrMsgs}
+  \item \errindexbis{{\qualid} is not a module}{is not a module}
+% this error is impossible in the import command
+%  \item \errindex{Cannot mask the absolute name {\qualid} !}
+\end{ErrMsgs}
+
+\begin{Warnings}
+  \item Warning: Trying to mask the absolute name {\qualid} !
+\end{Warnings}
+
+\subsection{\tt Print Module {\ident}
+\comindex{Print Module}}
+
+Prints the module type and (optionally) the body of the module {\ident}.
+
+\subsection{\tt Print Module Type {\ident}
+\comindex{Print Module Type}}
+
+Prints the module type corresponding to {\ident}.
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-modr.tex b/doc/refman/RefMan-modr.tex
new file mode 100644
index 00000000..a52c1847
--- /dev/null
+++ b/doc/refman/RefMan-modr.tex
@@ -0,0 +1,586 @@
+\chapter{The Module System}
+\label{chapter:Modules}
+
+The module system extends the Calculus of Inductive Constructions
+providing a convenient way to structure large developments as well as
+a mean of massive abstraction.
+%It is described in details in Judicael's thesis and Jacek's thesis
+
+\section{Modules and module types}
+
+\paragraph{Access path.} It is denoted by $p$, it can be either a module 
+variable $X$ or, if $p'$ is an access path and $id$ an identifier, then
+$p'.id$ is an access path.
+
+\paragraph{Structure element.} It is denoted by \Impl\ and is either a
+definition of a constant, an assumption, a definition of an inductive
+or a definition of a module or a module type abbreviation.
+
+\paragraph{Module expression.} It is denoted by $M$ and can be:
+\begin{itemize}
+\item an access path $p$
+\item a structure $\struct{\nelist{\Impl}{;}}$
+\item a functor $\functor{X}{T}{M'}$, where $X$ is a module variable,
+  $T$ is a module type and $M'$ is a module expression
+\item an application of access paths $p' p''$
+\end{itemize}
+
+\paragraph{Signature element.} It is denoted by \Spec, it is a
+specification of a constant, an assumption, an inductive, a module or
+a module type abbreviation.
+
+\paragraph{Module type,} denoted by $T$ can be:
+\begin{itemize}
+\item a module type name
+\item an access path $p$
+\item a signature $\sig{\nelist{\Spec}{;}}$
+\item a functor type $\funsig{X}{T'}{T''}$, where $T'$ and $T''$ are
+  module types
+\end{itemize}
+
+\paragraph{Module definition,} written $\Mod{X}{T}{M}$ can be a
+structure element. It consists of a module variable $X$, a module type
+$T$ and a module expression $M$.
+
+\paragraph{Module specification,} written $\ModS{X}{T}$ or
+$\ModSEq{X}{T}{p}$ can be a signature element or a part of an
+environment. It consists of a module variable $X$, a module type $T$
+and, optionally, a module path $p$. 
+
+\paragraph{Module type abbreviation,} written $\ModType{S}{T}$, where
+$S$ is a module type name and $T$ is a module type.
+
+
+\section{Typing Modules}
+
+In order to introduce the typing system we first slightly extend
+the syntactic class of terms and environments given in
+section~\ref{Terms}. The environments, apart from definitions of
+constants and inductive types now also hold any other signature elements.
+Terms, apart from variables, constants and complex terms, 
+include also access paths.
+
+We also need additional typing judgments: 
+\begin{itemize}
+\item \WFT{E}{T}, denoting that a module type $T$ is well-formed, 
+
+\item \WTM{E}{M}{T}, denoting that a module expression $M$ has type $T$ in
+environment $E$.
+
+\item \WTM{E}{\Impl}{\Spec}, denoting that an implementation $\Impl$
+  verifies a specification $\Spec$
+
+\item \WS{E}{T_1}{T_2}, denoting that a module type $T_1$ is a subtype of a
+module type $T_2$.
+
+\item \WS{E}{\Spec_1}{\Spec_2}, denoting that a specification
+  $\Spec_1$ is more precise that a specification $\Spec_2$.
+\end{itemize}
+The rules for forming module types are the following:
+\begin{description}
+\item[WF-SIG]
+\inference{%
+  \frac{
+    \WF{E;E'}{}
+  }{%%%%%%%%%%%%%%%%%%%%%
+    \WFT{E}{\sig{E'}}
+  }
+}
+\item[WF-FUN]
+\inference{%
+  \frac{
+    \WFT{E;\ModS{X}{T}}{T'}
+  }{%%%%%%%%%%%%%%%%%%%%%%%%%%
+    \WFT{E}{\funsig{X}{T}{T'}}
+  }
+}
+\end{description}
+Rules for typing module expressions:
+\begin{description}
+\item[MT-STRUCT]
+\inference{%
+  \frac{
+    \begin{array}{c}
+      \WFT{E}{\sig{\Spec_1;\dots;\Spec_n}}\\
+      \WTM{E;\Spec_1;\dots;\Spec_{i-1}}{\Impl_i}{\Spec_i}
+                                              \textrm{ \ \ for } i=1\dots n
+    \end{array}
+  }{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+    \WTM{E}{\struct{\Impl_1;\dots;\Impl_n}}{\sig{\Spec_1;\dots;\Spec_n}}
+  }
+}
+\item[MT-FUN]
+\inference{%
+  \frac{
+    \WTM{E;\ModS{X}{T}}{M}{T'}
+  }{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+    \WTM{E}{\functor{X}{T}{M}}{\funsig{X}{T}{T'}}
+  }
+}
+\item[MT-APP]
+\inference{%
+  \frac{
+    \begin{array}{c}
+      \WTM{E}{p}{\funsig{X_1}{T_1}{\!\dots\funsig{X_n}{T_n}{T'}}}\\
+      \WTM{E}{p_i}{T_i\{X_1/p_1\dots X_{i-1}/p_{i-1}\}}
+                                   \textrm{ \ \ for } i=1\dots n
+    \end{array}
+  }{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+    \WTM{E}{p\; p_1 \dots p_n}{T'\{X_1/p_1\dots X_n/p_n\}}
+  }
+}
+\item[MT-SUB]
+\inference{%
+  \frac{
+    \WTM{E}{M}{T}~~~~~~~~~~~~\WS{E}{T}{T'}
+  }{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+    \WTM{E}{M}{T'}
+  }
+}
+\item[MT-STR]
+\inference{%
+  \frac{
+    \WTM{E}{p}{T}
+  }{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+    \WTM{E}{p}{T/p}
+  }
+}
+\end{description}
+The last rule, called strengthening is used to make all module fields
+manifestly equal to themselves. The notation $T/p$ has the following
+meaning:
+\begin{itemize}
+\item if $T=\sig{\Spec_1;\dots;\Spec_n}$ then
+  $T/p=\sig{\Spec_1/p;\dots;\Spec_n/p}$ where $\Spec/p$ is defined as
+  follows:
+  \begin{itemize}
+  \item $\Def{}{c}{U}{t}/p ~=~ \Def{}{c}{U}{t}$
+  \item $\Assum{}{c}{U}/p ~=~ \Def{}{c}{p.c}{U}$
+  \item $\ModS{X}{T}/p ~=~ \ModSEq{X}{T/p.X}{p.X}$
+  \item $\ModSEq{X}{T}{p'}/p ~=~ \ModSEq{X}{T/p}{p'}$
+  \item $\Ind{}{\Gamma_P}{\Gamma_C}{\Gamma_I}/p ~=~ \Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}$
+  \item $\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p'}/p ~=~ \Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p'}$
+  \end{itemize}
+\item if $T=\funsig{X}{T'}{T''}$ then $T/p=T$
+\item if $T$ is an access path or a module type name, then we have to
+  unfold its definition and proceed according to the rules above. 
+\end{itemize}
+The notation $\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}$ denotes an
+inductive definition that is definitionally equal to the inductive
+definition in the module denoted by the path $p$. All rules which have
+$\Ind{}{\Gamma_P}{\Gamma_C}{\Gamma_I}$ as premises are also valid for 
+$\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}$. We give the formation rule
+for $\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}$ below as well as
+the equality rules on inductive types and constructors. 
+
+The module subtyping rules:
+\begin{description}
+\item[MSUB-SIG]
+\inference{%
+  \frac{
+    \begin{array}{c}
+      \WS{E;\Spec_1;\dots;\Spec_n}{\Spec_{\sigma(i)}}{\Spec'_i}
+                                  \textrm{ \ for } i=1..m \\
+      \sigma : \{1\dots m\} \ra \{1\dots n\} \textrm{ \ injective}
+    \end{array}
+  }{
+    \WS{E}{\sig{\Spec_1;\dots;\Spec_n}}{\sig{\Spec'_1;\dots;\Spec'_m}}
+  }
+}
+\item[MSUB-FUN]
+\inference{%       T_1 -> T_2 <: T_1' -> T_2'
+  \frac{
+    \WS{E}{T_1'}{T_1}~~~~~~~~~~\WS{E;\ModS{X}{T_1'}}{T_2}{T_2'}
+  }{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+    \WS{E}{\funsig{X}{T_1}{T_2}}{\funsig{X}{T_1'}{T_2'}}
+  }
+}
+% these are derived rules
+% \item[MSUB-EQ]
+% \inference{%
+%   \frac{
+%     \WS{E}{T_1}{T_2}~~~~~~~~~~\WTERED{}{T_1}{=}{T_1'}~~~~~~~~~~\WTERED{}{T_2}{=}{T_2'}
+%   }{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%     \WS{E}{T_1'}{T_2'}
+%   }
+% }
+% \item[MSUB-REFL]
+% \inference{%
+%   \frac{
+%     \WFT{E}{T}
+%   }{
+%     \WS{E}{T}{T}
+%   }
+% }
+\end{description}
+Specification subtyping rules:
+\begin{description}
+\item[ASSUM-ASSUM]
+\inference{%
+  \frac{
+    \WTELECONV{}{U_1}{U_2}
+  }{
+    \WSE{\Assum{}{c}{U_1}}{\Assum{}{c}{U_2}}
+  }
+}
+\item[DEF-ASSUM]
+\inference{%
+  \frac{
+    \WTELECONV{}{U_1}{U_2}
+  }{
+    \WSE{\Def{}{c}{t}{U_1}}{\Assum{}{c}{U_2}}
+  }
+}
+\item[ASSUM-DEF]
+\inference{%
+  \frac{
+    \WTELECONV{}{U_1}{U_2}~~~~~~~~\WTECONV{}{c}{t_2}
+  }{
+    \WSE{\Assum{}{c}{U_1}}{\Def{}{c}{t_2}{U_2}}
+  }
+}
+\item[DEF-DEF]
+\inference{%
+  \frac{
+    \WTELECONV{}{U_1}{U_2}~~~~~~~~\WTECONV{}{t_1}{t_2}
+  }{
+    \WSE{\Def{}{c}{t_1}{U_1}}{\Def{}{c}{t_2}{U_2}}
+  }
+}
+\item[IND-IND]
+\inference{%
+  \frac{
+    \WTECONV{}{\Gamma_P}{\Gamma_P'}%
+    ~~~~~~~~\WTECONV{\Gamma_P}{\Gamma_C}{\Gamma_C'}%
+    ~~~~~~~~\WTECONV{\Gamma_P;\Gamma_C}{\Gamma_I}{\Gamma_I'}%
+  }{
+    \WSE{\Ind{}{\Gamma_P}{\Gamma_C}{\Gamma_I}}%
+        {\Ind{}{\Gamma_P'}{\Gamma_C'}{\Gamma_I'}}
+  }
+}
+\item[INDP-IND]
+\inference{%
+  \frac{
+    \WTECONV{}{\Gamma_P}{\Gamma_P'}%
+    ~~~~~~~~\WTECONV{\Gamma_P}{\Gamma_C}{\Gamma_C'}%
+    ~~~~~~~~\WTECONV{\Gamma_P;\Gamma_C}{\Gamma_I}{\Gamma_I'}%
+  }{
+    \WSE{\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}}%
+        {\Ind{}{\Gamma_P'}{\Gamma_C'}{\Gamma_I'}}
+  }
+}
+\item[INDP-INDP]
+\inference{%
+  \frac{
+    \WTECONV{}{\Gamma_P}{\Gamma_P'}%
+    ~~~~~~\WTECONV{\Gamma_P}{\Gamma_C}{\Gamma_C'}%
+    ~~~~~~\WTECONV{\Gamma_P;\Gamma_C}{\Gamma_I}{\Gamma_I'}%
+    ~~~~~~\WTECONV{}{p}{p'}
+  }{
+    \WSE{\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}}%
+        {\Indp{}{\Gamma_P'}{\Gamma_C'}{\Gamma_I'}{p'}}
+  }
+}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\item[MODS-MODS]
+\inference{%
+  \frac{
+    \WSE{T_1}{T_2}
+  }{
+    \WSE{\ModS{m}{T_1}}{\ModS{m}{T_2}}
+  }
+}
+\item[MODEQ-MODS]
+\inference{%
+  \frac{
+    \WSE{T_1}{T_2}
+  }{
+    \WSE{\ModSEq{m}{T_1}{p}}{\ModS{m}{T_2}}
+  }
+}
+\item[MODS-MODEQ]
+\inference{%
+  \frac{
+    \WSE{T_1}{T_2}~~~~~~~~\WTECONV{}{m}{p_2}
+  }{
+    \WSE{\ModS{m}{T_1}}{\ModSEq{m}{T_2}{p_2}}
+  }
+}
+\item[MODEQ-MODEQ]
+\inference{%
+  \frac{
+    \WSE{T_1}{T_2}~~~~~~~~\WTECONV{}{p_1}{p_2}
+  }{
+    \WSE{\ModSEq{m}{T_1}{p_1}}{\ModSEq{m}{T_2}{p_2}}
+  }
+}
+\item[MODTYPE-MODTYPE]
+\inference{%
+  \frac{
+    \WSE{T_1}{T_2}~~~~~~~~\WSE{T_2}{T_1}
+  }{
+    \WSE{\ModType{S}{T_1}}{\ModType{S}{T_2}}
+  }
+}
+\end{description}
+Verification of the specification
+\begin{description}
+\item[IMPL-SPEC]
+\inference{%
+  \frac{
+    \begin{array}{c}
+      \WF{E;\Spec}{}\\
+      \Spec \textrm{\ is one of } {\sf Def, Assum, Ind, ModType}
+    \end{array}
+  }{
+    \WTE{}{\Spec}{\Spec}
+  }
+}
+\item[MOD-MODS]
+\inference{%
+  \frac{
+    \WF{E;\ModS{m}{T}}{}~~~~~~~~\WTE{}{M}{T}
+  }{
+    \WTE{}{\Mod{m}{T}{M}}{\ModS{m}{T}}
+  }
+}
+\item[MOD-MODEQ]
+\inference{%
+  \frac{
+    \WF{E;\ModSEq{m}{T}{p}}{}~~~~~~~~~~~\WTECONV{}{p}{p'}
+  }{
+    \WTE{}{\Mod{m}{T}{p'}}{\ModSEq{m}{T}{p'}}
+  }
+}
+\end{description}
+New environment formation rules
+\begin{description}
+\item[WF-MODS]
+\inference{%
+  \frac{
+    \WF{E}{}~~~~~~~~\WFT{E}{T}
+  }{
+    \WF{E;\ModS{m}{T}}{}
+  }
+}
+\item[WF-MODEQ]
+\inference{%
+  \frac{
+    \WF{E}{}~~~~~~~~~~~\WTE{}{p}{T}
+  }{
+    \WF{E,\ModSEq{m}{T}{p}}{}
+  }
+}
+\item[WF-MODTYPE]
+\inference{%
+  \frac{
+    \WF{E}{}~~~~~~~~~~~\WFT{E}{T}
+  }{
+    \WF{E,\ModType{S}{T}}{}
+  }
+}
+\item[WF-IND]
+\inference{%
+  \frac{
+    \begin{array}{c}
+      \WF{E;\Ind{}{\Gamma_P}{\Gamma_C}{\Gamma_I}}{}\\
+      \WT{E}{}{p:\sig{\Spec_1;\dots;\Spec_n;\Ind{}{\Gamma_P'}{\Gamma_C'}{\Gamma_I'};\dots}}\\
+      \WS{E}{\subst{\Ind{}{\Gamma_P'}{\Gamma_C'}{\Gamma_I'}}{p.l}{l}_{l
+      \in \lab{Spec_1;\dots;Spec_n}}}{\Ind{}{\Gamma_P}{\Gamma_C}{\Gamma_I}}
+    \end{array}
+  }{%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+    \WF{E;\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}}{}
+  }
+}
+\end{description}
+Component access rules
+\begin{description}
+\item[ACC-TYPE]
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;Spec_i;\Assum{}{c}{U};\dots}}
+  }{
+    \WTEG{p.c}{\subst{U}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\\
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;Spec_i;\Def{}{c}{t}{U};\dots}}
+  }{
+    \WTEG{p.c}{\subst{U}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\item[ACC-DELTA]
+Notice that the following rule extends the delta rule defined in
+section~\ref{delta}
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;Spec_i;\Def{}{c}{t}{U};\dots}}
+  }{
+    \WTEGRED{p.c}{\triangleright_\delta}{\subst{t}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\\
+In the rules below we assume $\Gamma_P$ is $[p_1:P_1;\ldots;p_r:P_r]$,
+  $\Gamma_I$ is $[I_1:A_1;\ldots;I_k:A_k]$, and $\Gamma_C$ is
+  $[c_1:C_1;\ldots;c_n:C_n]$
+\item[ACC-IND]
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;\Spec_i;\Ind{}{\Gamma_P}{\Gamma_C}{\Gamma_I};\dots}}
+  }{
+    \WTEG{p.I_j}{\subst{(p_1:P_1)\ldots(p_r:P_r)A_j}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;\Spec_i;\Ind{}{\Gamma_P}{\Gamma_C}{\Gamma_I};\dots}}
+  }{
+    \WTEG{p.c_m}{\subst{(p_1:P_1)\ldots(p_r:P_r)\subst{C_m}{I_j}{(I_j~p_1\ldots
+       p_r)}_{j=1\ldots k}}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\item[ACC-INDP]
+\inference{%
+  \frac{
+    \WT{E}{}{p}{\sig{\Spec_1;\dots;\Spec_n;\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p'};\dots}}
+  }{
+    \WTRED{E}{}{p.I_i}{\triangleright_\delta}{p'.I_i}
+  }
+}
+\inference{%
+  \frac{
+    \WT{E}{}{p}{\sig{\Spec_1;\dots;\Spec_n;\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p'};\dots}}
+  }{
+    \WTRED{E}{}{p.c_i}{\triangleright_\delta}{p'.c_i}
+  }
+}
+%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULES
+\item[ACC-MOD]
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;Spec_i;\ModS{m}{T};\dots}}
+  }{
+    \WTEG{p.m}{\subst{T}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\\
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;Spec_i;\ModSEq{m}{T}{p'};\dots}}
+  }{
+    \WTEG{p.m}{\subst{T}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\item[ACC-MODEQ]
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;Spec_i;\ModSEq{m}{T}{p'};\dots}}
+  }{
+    \WTEGRED{p.m}{\triangleright_\delta}{\subst{p'}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\item[ACC-MODTYPE]
+\inference{%
+  \frac{
+    \WTEG{p}{\sig{\Spec_1;\dots;Spec_i;\ModType{S}{T};\dots}}
+  }{
+    \WTEGRED{p.S}{\triangleright_\delta}{\subst{T}{p.l}{l}_{l \in \lab{Spec_1;\dots;Spec_i}}}
+  }
+}
+\end{description}
+The function $\lab{}$ is used to calculate the set of label of
+the set of specifications. It is defined by
+$\lab{\Spec_1;\dots;\Spec_n}=\lab{\Spec_1}\cup\dots;\cup\lab{\Spec_n}$
+where $\lab{\Spec}$ is defined as follows:
+\begin{itemize}
+\item $\lab{\Assum{\Gamma}{c}{U}}=\{c\}$,
+\item $\lab{\Def{\Gamma}{c}{t}{U}}=\{c\}$,
+\item
+  $\lab{\Ind{\Gamma}{\Gamma_P}{\Gamma_C}{\Gamma_I}}=\dom{\Gamma_C}\cup\dom{\Gamma_I}$,
+\item $\lab{\ModS{m}{T}}=\{m\}$,
+\item $\lab{\ModSEq{m}{T}{M}}=\{m\}$,
+\item $\lab{\ModType{S}{T}}=\{S\}$
+\end{itemize}
+Environment access for modules and module types
+\begin{description}
+\item[ENV-MOD]
+\inference{%
+  \frac{
+    \WF{E;\ModS{m}{T};E'}{\Gamma}
+  }{
+    \WT{E;\ModS{m}{T};E'}{\Gamma}{m}{T}
+  }
+}
+\item[]
+\inference{%
+  \frac{
+    \WF{E;\ModSEq{m}{T}{p};E'}{\Gamma}
+  }{
+    \WT{E;\ModSEq{m}{T}{p};E'}{\Gamma}{m}{T}
+  }
+}
+\item[ENV-MODEQ]
+\inference{%
+  \frac{
+    \WF{E;\ModSEq{m}{T}{p};E'}{\Gamma}
+  }{
+    \WTRED{E;\ModSEq{m}{T}{p};E'}{\Gamma}{m}{\triangleright_\delta}{p}
+  }
+}
+\item[ENV-MODTYPE]
+\inference{%
+  \frac{
+    \WF{E;\ModType{S}{T};E'}{\Gamma}
+  }{
+    \WTRED{E;\ModType{S}{T};E'}{\Gamma}{S}{\triangleright_\delta}{T}
+  }
+}
+\item[ENV-INDP]
+\inference{%
+  \frac{
+    \WF{E;\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}}{}
+  }{
+    \WTRED{E;\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}}{}{I_i}{\triangleright_\delta}{p.I_i}
+  }
+}
+\inference{%
+  \frac{
+    \WF{E;\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}}{}
+  }{
+    \WTRED{E;\Indp{}{\Gamma_P}{\Gamma_C}{\Gamma_I}{p}}{}{c_i}{\triangleright_\delta}{p.c_i}
+  }
+}
+\end{description}
+% %%% replaced by \triangle_\delta
+% Module path equality is a transitive and reflexive closure of the
+% relation generated by ACC-MODEQ and ENV-MODEQ.
+% \begin{itemize}
+% \item []MP-EQ-REFL
+% \inference{%
+%   \frac{
+%     \WTEG{p}{T}
+%   }{
+%     \WTEG{p}{p}
+%   }
+% }
+% \item []MP-EQ-TRANS
+% \inference{%
+%   \frac{
+%     \WTEGRED{p}{=}{p'}~~~~~~\WTEGRED{p'}{=}{p''}
+%   }{
+%     \WTEGRED{p'}{=}{p''}
+%   }
+% }
+
+% \end{itemize}
+
+
+% $Id: RefMan-modr.tex 8606 2006-02-23 13:58:10Z herbelin $
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
+
diff --git a/doc/refman/RefMan-oth.tex b/doc/refman/RefMan-oth.tex
new file mode 100644
index 00000000..e92cde74
--- /dev/null
+++ b/doc/refman/RefMan-oth.tex
@@ -0,0 +1,773 @@
+\chapter{Vernacular commands}
+\label{Vernacular-commands}
+\label{Other-commands}
+
+\section{Displaying}
+
+\subsection{\tt Print {\qualid}.}\comindex{Print}
+This command displays on the screen informations about the declared or
+defined object referred by {\qualid}.
+
+\begin{ErrMsgs}
+\item {\qualid} \errindex{not a defined object}
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt Print Term {\qualid}.}
+\comindex{Print Term}\\ 
+This is a synonym to {\tt Print {\qualid}} when {\qualid} denotes a
+global constant. 
+
+\item {\tt About {\qualid}.}
+\label{About}
+\comindex{About}\\ 
+This displays various informations about the object denoted by {\qualid}:
+its kind (module, constant, assumption, inductive,
+constructor, abbreviation\ldots), long name, type, implicit
+arguments and argument scopes.
+
+%\item {\tt Print Proof {\qualid}.}\comindex{Print Proof}\\
+%In case \qualid\ denotes an opaque theorem defined in a section,
+%it is stored on a special unprintable form and displayed as 
+%{\tt <recipe>}. {\tt Print Proof} forces the printable form of \qualid\
+%to be computed and displays it.
+\end{Variants}
+
+\subsection{\tt Print All.}\comindex{Print All}
+This command displays informations about the current state of the
+environment, including sections and modules.
+
+\begin{Variants}
+\item {\tt Inspect \num.}\comindex{Inspect}\\
+This command displays the {\num} last objects of the current
+environment, including sections and modules.
+\item {\tt Print Section {\ident}.}\comindex{Print Section}\\
+should correspond to a currently open section, this command
+displays the objects defined since the beginning of this section.
+% Discontinued
+%% \item {\tt Print.}\comindex{Print}\\
+%% This command displays the axioms and variables declarations in the
+%% environment as well as the constants defined since the last variable
+%% was introduced.
+\end{Variants}
+
+\section{Requests to the environment}
+
+\subsection{\tt Check {\term}.}
+\label{Check}
+\comindex{Check}
+This command displays the type of {\term}. When called in proof mode, 
+the term is checked in the local context of the current subgoal.
+
+\subsection{\tt Eval {\rm\sl convtactic} in {\term}.}
+\comindex{Eval}
+
+This command performs the specified reduction on {\term}, and displays
+the resulting term with its type. The term to be reduced may depend on
+hypothesis introduced in the first subgoal (if a proof is in
+progress).
+
+\SeeAlso section~\ref{Conversion-tactics}.
+
+\subsection{\tt Extraction \term.}
+\label{ExtractionTerm}
+\comindex{Extraction} 
+This command displays the extracted term from
+{\term}. The extraction is processed according to the distinction
+between {\Set} and {\Prop}; that is to say, between logical and
+computational content (see section \ref{Sorts}). The extracted term is
+displayed in Objective Caml syntax, where global identifiers are still
+displayed as in \Coq\ terms.
+
+\begin{Variants}
+\item \texttt{Recursive Extraction {\qualid$_1$} \ldots{} {\qualid$_n$}.}\\
+  Recursively extracts all the material needed for the extraction of 
+  globals {\qualid$_1$} \ldots{} {\qualid$_n$}.
+\end{Variants}
+
+\SeeAlso chapter~\ref{Extraction}.
+
+\subsection{\tt Opaque \qualid$_1$ \dots \qualid$_n$.}
+\comindex{Opaque}\label{Opaque} This command tells not to unfold the
+the constants {\qualid$_1$} \dots {\qualid$_n$} in tactics using
+$\delta$-conversion. Unfolding a constant is replacing it by its
+definition. {\tt Opaque} can only apply on constants originally
+defined as {\tt Transparent}.
+
+Constants defined by a proof ended by {\tt Qed} are automatically
+stamped as {\tt Opaque} and can no longer be considered as {\tt
+Transparent}. This is to keep with the usual mathematical practice of
+{\em proof irrelevance}: what matters in a mathematical development is
+the sequence of lemma statements, not their actual proofs. This
+distinguishes lemmas from the usual defined constants, whose actual
+values are of course relevant in general.
+
+\SeeAlso sections \ref{Conversion-tactics}, \ref{Automatizing},
+\ref{Theorem}
+
+\begin{ErrMsgs}
+\item \errindex{The reference \qualid\ was not found in the current
+environment}\\
+    There is no constant referred by {\qualid} in the environment.
+    Nevertheless, if you asked \texttt{Opaque foo bar}
+    and if \texttt{bar} does not exist, \texttt{foo} is set opaque.
+\end{ErrMsgs}
+
+\subsection{\tt Transparent \qualid$_1$ \dots \qualid$_n$.}
+\comindex{Transparent}\label{Transparent}
+This command is the converse of {\tt Opaque} and can only apply on constants originally defined as {\tt Transparent} to restore their initial behaviour after an {\tt Opaque} command.
+
+The constants automatically declared transparent are the ones defined by a proof ended by {\tt Defined}, or by a {\tt
+  Definition} or {\tt Local} with an explicit body.
+
+\Warning {\tt Transparent} and \texttt{Opaque} are not synchronous
+with the reset mechanism. If a constant was transparent at point A, if
+you set it opaque at point B and reset to point A, you return to state
+of point A with the difference that the constant is still opaque. This
+can cause changes in tactic scripts behaviour.
+
+At section or module closing, a constant recovers the status it got at
+the time of its definition.
+
+%TODO: expliquer le rapport avec les sections
+
+\begin{ErrMsgs}
+% \item \errindex{Can not set transparent.}\\
+%     It is a constant from a required module or a parameter.
+\item \errindex{The reference \qualid\ was not found in the current
+environment}\\
+    There is no constant referred by {\qualid} in the environment.
+\end{ErrMsgs}
+
+\SeeAlso sections \ref{Conversion-tactics}, \ref{Automatizing},
+\ref{Theorem}
+
+\subsection{\tt Search {\qualid}.}\comindex{Search}
+This command displays the name and type of all theorems of the current
+context whose statement's conclusion has the form {\tt ({\qualid} t1 ..
+  tn)}.  This command is useful to remind the user of the name of
+library lemmas.
+\begin{ErrMsgs}
+\item \errindex{The reference \qualid\ was not found in the current
+environment}\\
+    There is no constant in the environment named \qualid.
+\end{ErrMsgs}
+
+\begin{Variants}
+\item
+{\tt Search {\qualid} inside {\module$_1$} \ldots{} {\module$_n$}.}
+
+This restricts the search to constructions defined in modules
+{\module$_1$} \ldots{} {\module$_n$}.
+
+\item {\tt Search {\qualid} outside {\module$_1$} \ldots{} {\module$_n$}.}
+
+This restricts the search to constructions not defined in modules
+{\module$_1$} \ldots{} {\module$_n$}.
+
+\begin{ErrMsgs}
+\item \errindex{Module/section \module{} not found}
+No module \module{} has been required (see section~\ref{Require}).
+\end{ErrMsgs}
+
+\end{Variants}
+
+\subsection{\tt SearchAbout {\qualid}.}\comindex{SearchAbout}
+This command displays the name and type of all objects (theorems,
+axioms, etc) of the current context whose statement contains \qualid.
+This command is useful to remind the user of the name of library
+lemmas.
+
+\begin{ErrMsgs}
+\item \errindex{The reference \qualid\ was not found in the current
+environment}\\
+    There is no constant in the environment named \qualid.
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt SearchAbout [ \nelist{\textrm{\textsl{qualid-or-string}}}{}
+].}\\
+\noindent where {\textrm{\textsl{qualid-or-string}}} is a {\qualid} or
+a {\str}.
+
+This extension of {\tt SearchAbout} searches for all objects whose
+statement mentions all of {\qualid} of the list and whose name
+contains all {\str} of the list.
+
+\Example
+
+\begin{coq_example}
+Require Import ZArith.
+SearchAbout [ Zmult Zplus "distr" ].
+\end{coq_example}
+
+\item
+\begin{tabular}[t]{@{}l}
+  {\tt SearchAbout {\term} inside {\module$_1$} \ldots{} {\module$_n$}.} \\
+  {\tt SearchAbout [ \nelist{\textrm{\textsl{qualid-or-string}}}{} ]
+    inside {\module$_1$} \ldots{} {\module$_n$}.}
+\end{tabular}
+
+This restricts the search to constructions defined in modules
+{\module$_1$} \ldots{} {\module$_n$}.
+
+\item
+\begin{tabular}[t]{@{}l}
+  {\tt SearchAbout {\term} outside {\module$_1$}...{\module$_n$}.} \\
+  {\tt SearchAbout [ \nelist{\textrm{\textsl{qualid-or-string}}}{} ]
+     outside {\module$_1$}...{\module$_n$}.}
+\end{tabular}
+
+This restricts the search to constructions not defined in modules
+{\module$_1$} \ldots{} {\module$_n$}.
+
+\end{Variants}
+
+\subsection{\tt SearchPattern {\term}.}\comindex{SearchPattern}
+
+This command displays the name and type of all theorems of the current
+context whose statement's conclusion matches the expression {\term}
+where holes in the latter are denoted by ``{\texttt \_}''.
+
+\begin{coq_example}
+Require Import Arith.
+SearchPattern (_ + _ = _ + _).
+\end{coq_example}
+
+Patterns need not be linear: you can express that the same expression
+must occur in two places by using pattern variables `{\texttt
+?{\ident}}''.
+
+\begin{coq_example}
+Require Import Arith.
+SearchPattern (?X1 + _ = _ + ?X1).
+\end{coq_example}
+
+\begin{Variants}
+\item {\tt SearchPattern {\term} inside
+{\module$_1$} \ldots{} {\module$_n$}.}\comindex{SearchPattern \ldots{} inside
+\ldots{}}
+
+This restricts the search to constructions defined in modules
+{\module$_1$} \ldots{} {\module$_n$}.
+
+\item {\tt SearchPattern {\term} outside {\module$_1$} \ldots{} {\module$_n$}.}\comindex{SearchPattern \ldots{} outside \ldots{}}
+
+This restricts the search to constructions not defined in modules
+{\module$_1$} \ldots{} {\module$_n$}.
+
+\end{Variants}
+
+\subsection{\tt SearchRewrite {\term}.}\comindex{SearchRewrite}
+
+This command displays the name and type of all theorems of the current
+context whose statement's conclusion is an equality of which one side matches
+the expression {\term =}. Holes in {\term} are denoted by ``{\texttt \_}''.
+
+\begin{coq_example}
+Require Import Arith.
+SearchRewrite (_ + _ + _).
+\end{coq_example}
+
+\begin{Variants}
+\item {\tt SearchRewrite {\term} inside
+{\module$_1$} \ldots{} {\module$_n$}.}
+
+This restricts the search to constructions defined in modules
+{\module$_1$} \ldots{} {\module$_n$}.
+
+\item {\tt SearchRewrite {\term} outside {\module$_1$} \ldots{} {\module$_n$}.}
+
+This restricts the search to constructions not defined in modules
+{\module$_1$} \ldots{} {\module$_n$}.
+
+\end{Variants}
+
+% \subsection{\tt SearchIsos {\term}.}\comindex{SearchIsos}
+% \label{searchisos}
+% \texttt{SearchIsos} searches terms by their type modulo isomorphism.
+% This command displays the full name of all constants, variables,
+% inductive types, and inductive constructors of the current
+% context whose type is isomorphic to {\term} modulo the contextual part of the
+% following axiomatization (the mutual inductive types with one constructor,
+% without implicit arguments, and for which projections exist, are regarded as a
+% sequence of $\sa{}$):
+
+
+% \begin{tabbing}
+% \ \ \ \ \=11.\ \=\kill
+% \>1.\>$A=B\mx{ if }A\stackrel{\bt{}\io{}}{\lra{}}B$\\
+% \>2.\>$\sa{}x:A.B=\sa{}y:A.B[x\la{}y]\mx{ if }y\not\in{}FV(\sa{}x:A.B)$\\
+% \>3.\>$\Pi{}x:A.B=\Pi{}y:A.B[x\la{}y]\mx{ if }y\not\in{}FV(\Pi{}x:A.B)$\\
+% \>4.\>$\sa{}x:A.B=\sa{}x:B.A\mx{ if }x\not\in{}FV(A,B)$\\
+% \>5.\>$\sa{}x:(\sa{}y:A.B).C=\sa{}x:A.\sa{}y:B[y\la{}x].C[x\la{}(x,y)]$\\
+% \>6.\>$\Pi{}x:(\sa{}y:A.B).C=\Pi{}x:A.\Pi{}y:B[y\la{}x].C[x\la{}(x,y)]$\\
+% \>7.\>$\Pi{}x:A.\sa{}y:B.C=\sa{}y:(\Pi{}x:A.B).(\Pi{}x:A.C[y\la{}(y\sm{}x)]$\\
+% \>8.\>$\sa{}x:A.unit=A$\\
+% \>9.\>$\sa{}x:unit.A=A[x\la{}tt]$\\
+% \>10.\>$\Pi{}x:A.unit=unit$\\
+% \>11.\>$\Pi{}x:unit.A=A[x\la{}tt]$
+% \end{tabbing}
+
+% For more informations about the exact working of this command, see
+% \cite{Del97}.
+
+\subsection{\tt Locate {\qualid}.}\comindex{Locate}
+\label{Locate}
+This command displays the full name of the qualified identifier {\qualid}
+and consequently the \Coq\ module in which it is defined.
+
+\begin{coq_eval}
+(*************** The last line should produce **************************)
+(*********** Error: I.Dont.Exist not a defined object ******************)
+\end{coq_eval}
+\begin{coq_eval}
+Set Printing Depth 50.
+\end{coq_eval}
+\begin{coq_example}
+Locate nat.
+Locate Datatypes.O.
+Locate Init.Datatypes.O.
+Locate Coq.Init.Datatypes.O.
+Locate I.Dont.Exist.
+\end{coq_example}
+
+\SeeAlso Section \ref{LocateSymbol}
+
+\section{Loading files}
+
+\Coq\ offers the possibility of loading different
+parts of a whole development stored in separate files. Their contents
+will be loaded as if they were entered from the keyboard. This means
+that the loaded files are ASCII files containing sequences of commands
+for \Coq's toplevel. This kind of file is called a {\em script} for
+\Coq\index{Script file}. The standard (and default) extension of
+\Coq's script files is {\tt .v}.
+
+\subsection{\tt Load {\ident}.}
+\comindex{Load}\label{Load}
+This command loads the file named {\ident}{\tt .v}, searching
+successively in each of the directories specified in the {\em
+  loadpath}. (see section \ref{loadpath})
+
+\begin{Variants}
+\item {\tt Load {\str}.}\label{Load-str}\\
+  Loads the file denoted by the string {\str}, where {\str} is any
+  complete filename. Then the \verb.~. and {\tt ..}
+  abbreviations are allowed as well as shell variables. If no
+  extension is specified, \Coq\ will use the default extension {\tt
+    .v}
+\item {\tt Load Verbose {\ident}.}, 
+  {\tt Load Verbose {\str}}\\
+  \comindex{Load Verbose}
+  Display, while loading, the answers of \Coq\ to each command
+  (including tactics) contained in the loaded file
+  \SeeAlso section \ref{Begin-Silent}
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{Can't find file {\ident} on loadpath}
+\end{ErrMsgs}
+
+\section{Compiled files}\label{compiled}\index{Compiled files}
+
+This feature allows to build files for a quick loading. When loaded,
+the commands contained in a compiled file will not be {\em replayed}.
+In particular, proofs will not be replayed. This avoids a useless
+waste of time.
+
+\Rem A module containing an opened section cannot be compiled. 
+
+% \subsection{\tt Compile Module {\ident}.}
+% \index{Modules}
+% \comindex{Compile Module}
+% \index{.vo files}
+% This command loads the file
+% {\ident}{\tt .v} and plays the script it contains. Declarations,
+% definitions and proofs it contains are {\em "packaged"} in a compiled
+% form: the {\em module} named {\ident}.
+% A file {\ident}{\tt .vo} is then created.
+% The file {\ident}{\tt .v} is searched according to the
+% current loadpath.
+% The {\ident}{\tt .vo} is then written in the directory where
+% {\ident}{\tt .v} was found.
+
+% \begin{Variants}
+% \item \texttt{Compile Module {\ident} {\str}.}\\ 
+%   Uses the file {\str}{\tt .v} or {\str} if the previous one does not
+%   exist to build the module {\ident}. In this case, {\str} is any
+%   string giving a filename in the UNIX sense (see section
+%   \ref{Load-str}). 
+%   \Warning The given filename can not contain other caracters than
+%   the caracters of \Coq's identifiers : letters or digits or the
+%   underscore symbol ``\_''.
+
+% \item \texttt{Compile Module Specification {\ident}.}\\
+%   \comindex{Compile Module Specification}
+%   Builds a specification module: only the types of terms are stored
+%   in the module. The bodies (the proofs) are {\em not} written
+%   in the module. In that case, the file created is {\ident}{\tt .vi}.
+%   This is only useful when proof terms take too much place in memory
+%   and are not necessary.
+  
+% \item \texttt{Compile Verbose Module {\ident}.}\\ 
+%   \comindex{Compile Verbose Module}
+%   Verbose version of Compile: shows the contents of the file being
+%   compiled.
+% \end{Variants}
+
+% These different variants can be combined.
+
+
+% \begin{ErrMsgs}
+% \item \texttt{You cannot open a module when there are things other than}\\
+%   \texttt{Modules and Imports in the context.}\\ 
+%   The only commands allowed before a {Compile Module} command are {\tt
+%     Require},\\
+%   {\tt Read Module} and {\tt Import}. Actually, The normal way to
+%   compile modules is by the {\tt coqc} command (see chapter
+%   \ref{Addoc-coqc}).
+% \end{ErrMsgs}
+
+% \SeeAlso sections \ref{Opaque}, \ref{loadpath}, chapter
+% \ref{Addoc-coqc}
+
+%\subsection{\tt Import {\qualid}.}\comindex{Import}
+%\label{Import}
+
+%%%%%%%%%%%%
+% Import and Export described in RefMan-mod.tex
+% the minor difference (to avoid multiple Exporting of libraries) in
+% the treatment of normal modules and libraries by Export omitted
+
+
+\subsection{\tt Require {\dirpath}.}
+\label{Require}
+\comindex{Require}
+
+This command looks in the loadpath for a file containing module
+{\dirpath}, then loads and opens (imports) its contents.
+More precisely, if {\dirpath} splits into a library dirpath {\dirpath'} and a module name {\textsl{ident}}, then the file {\ident}{\tt .vo} is searched in a physical path mapped to the logical path {\dirpath'}.
+
+TODO: effect on the name table.
+
+% The implementation file ({\ident}{\tt .vo}) is searched first,
+% then the specification file ({\ident}{\tt .vi}) in case of failure.
+If the module required has already been loaded, \Coq\ 
+simply opens it (as {\tt Import {\dirpath}} would do it).
+%If the module required is already loaded and open, \Coq\ 
+%displays the following warning: {\tt {\ident} already imported}.
+
+If a module {\it A} contains a command {\tt Require} {\it B} then the
+command {\tt Require} {\it A} loads the module {\it B} but does not
+open it (See the {\tt Require Export} variant below).
+
+\begin{Variants}
+\item {\tt Require Export {\qualid}.}\\
+  \comindex{Require Export}
+  This command acts as {\tt Require} {\qualid}.  But if a module {\it
+    A} contains a command {\tt Require Export} {\it B}, then the
+  command {\tt Require} {\it A} opens the module {\it B} as if the
+  user would have typed {\tt Require}{\it B}.
+% \item {\tt Require $[$ Implementation $|$ Specification $]$ {\qualid}.}\\
+%   \comindex{Require Implementation}
+%   \comindex{Require Specification}
+%   Is the same as {\tt Require}, but specifying explicitly the
+%   implementation ({\tt.vo} file) or the specification ({\tt.vi}
+%   file).
+
+% Redundant ?
+% \item {\tt Require {\qualid} {\str}.}\\ 
+%   Specifies the file to load as being {\str} but containing module
+%  {\qualid}. 
+% The opened module is still {\ident} and therefore must have been loaded.
+\item {\tt Require {\qualid} {\str}.}\\ 
+  Specifies the file to load as being {\str} but containing module
+  {\qualid} which is then opened.
+\end{Variants}
+
+These different variants can be combined.
+
+\begin{ErrMsgs}
+
+\item \errindex{Cannot load {\ident}: no physical path bound to {\dirpath}}
+
+\item \errindex{Can't find module toto on loadpath}
+
+  The command did not find the file {\tt toto.vo}. Either {\tt
+    toto.v} exists but is not compiled or {\tt toto.vo} is in a directory
+  which is not in your {\tt LoadPath} (see section \ref{loadpath}).
+
+\item \errindex{Bad magic number}
+
+  \index{Bad-magic-number@{\tt Bad Magic Number}}
+  The file {\tt{\ident}.vo} was found but either it is not a \Coq\
+  compiled module, or it was compiled with an older and incompatible
+  version of \Coq.
+\end{ErrMsgs}
+
+\SeeAlso chapter \ref{Addoc-coqc}
+
+\subsection{\tt Print Modules.}
+\comindex{Print Modules}
+This command shows the currently loaded and currently opened
+(imported) modules.
+
+\subsection{\tt Declare ML Module {\str$_1$} .. {\str$_n$}.}
+\comindex{Declare ML Module}
+This commands loads the Objective Caml compiled files {\str$_1$} \dots
+{\str$_n$} (dynamic link). It is mainly used to load tactics
+dynamically.
+% (see chapter \ref{WritingTactics}).
+ The files are
+searched into the current Objective Caml loadpath (see the command {\tt
+Add ML Path} in the section \ref{loadpath}).  Loading of Objective Caml
+files is only possible under the bytecode version of {\tt coqtop}
+(i.e. {\tt coqtop} called with options {\tt -byte}, see chapter 
+\ref{Addoc-coqc}).
+
+\begin{ErrMsgs}
+\item \errindex{File not found on loadpath : \str}
+\item \errindex{Loading of ML object file forbidden in a native Coq}
+\end{ErrMsgs}
+
+\subsection{\tt Print ML Modules.}\comindex{Print ML Modules}
+This print the name of all \ocaml{} modules loaded with \texttt{Declare
+  ML Module}. To know from where these module were loaded, the user
+should use the command \texttt{Locate File} (see page \pageref{Locate File})
+
+\section{Loadpath}
+\label{loadpath}\index{Loadpath}
+
+There are currently two loadpaths in \Coq. A loadpath where seeking
+{\Coq} files (extensions {\tt .v} or {\tt .vo} or {\tt .vi}) and one where
+seeking Objective Caml files. The default loadpath contains the
+directory ``\texttt{.}'' denoting the current directory and mapped to the empty logical path (see section \ref{LongNames}).
+
+\subsection{\tt Pwd.}\comindex{Pwd}\label{Pwd}
+This command displays the current working directory.
+
+\subsection{\tt Cd {\str}.}\comindex{Cd}
+This command changes the current directory according to {\str} 
+which can be any valid path.
+
+\begin{Variants}
+\item {\tt Cd.}\\
+  Is equivalent to {\tt Pwd.}
+\end{Variants}
+
+\subsection{\tt Add LoadPath {\str} as {\dirpath}.}
+\comindex{Add LoadPath}\label{AddLoadPath}
+
+This command adds the path {\str} to the current {\Coq} loadpath and
+maps it to the logical directory {\dirpath}, which means that every
+file {\tt M.v} physically lying in directory {\str} becomes accessible
+through logical name ``{\dirpath}{\tt{.M}}''. 
+
+\Rem {\tt Add LoadPath} also adds {\str} to the current ML loadpath.
+
+\begin{Variants}
+\item {\tt Add LoadPath {\str}.}\\
+Performs as {\tt Add LoadPath {\str} as {\dirpath}} but for the empty directory path.
+\end{Variants}
+
+\subsection{\tt Add Rec LoadPath {\str} as {\dirpath}.}\comindex{Add Rec LoadPath}\label{AddRecLoadPath}
+This command adds the directory {\str} and all its subdirectories 
+to the current \Coq\ loadpath. The top directory {\str} is mapped to the logical directory {\dirpath} while any subdirectory {\textsl{pdir}} is mapped to logical directory {\dirpath}{\tt{.pdir}} and so on.
+
+\Rem {\tt Add Rec LoadPath} also recursively adds {\str} to the current ML loadpath.
+
+\begin{Variants}
+\item {\tt Add Rec LoadPath {\str}.}\\
+Works as {\tt Add Rec LoadPath {\str} as {\dirpath}} but for the empty logical directory path.
+\end{Variants}
+
+\subsection{\tt Remove LoadPath {\str}.}\comindex{Remove LoadPath}
+This command removes the path {\str} from the current \Coq\ loadpath.
+
+\subsection{\tt Print LoadPath.}\comindex{Print LoadPath}
+This command displays the current \Coq\ loadpath.
+
+\subsection{\tt Add ML Path {\str}.}\comindex{Add ML Path}
+This command adds the path {\str} to the current Objective Caml loadpath (see
+the command {\tt Declare ML Module} in the section \ref{compiled}).
+
+\Rem This command is implied by {\tt Add LoadPath {\str} as {\dirpath}}.
+
+\subsection{\tt Add Rec ML Path {\str}.}\comindex{Add Rec ML Path}
+This command adds the directory {\str} and all its subdirectories 
+to the current Objective Caml loadpath (see
+the command {\tt Declare ML Module} in the section \ref{compiled}).
+
+\Rem This command is implied by {\tt Add Rec LoadPath {\str} as {\dirpath}}.
+
+\subsection{\tt Print ML Path {\str}.}\comindex{Print ML Path}
+This command displays the current Objective Caml loadpath.
+This command makes sense only under the bytecode version of {\tt
+coqtop}, i.e. using option {\tt -byte} (see the
+command {\tt Declare ML Module} in the section
+\ref{compiled}).
+
+\subsection{\tt Locate File {\str}.}\comindex{Locate
+  File}\label{Locate File}
+This command displays the location of file {\str} in the current loadpath.
+Typically, {\str} is a \texttt{.cmo} or \texttt{.vo} or \texttt{.v} file.
+
+\subsection{\tt Locate Library {\dirpath}.}
+\comindex{Locate Library}
+This command gives the status of the \Coq\ module {\dirpath}. It tells if the
+module is loaded and if not searches in the load path for a module
+of logical name {\dirpath}.
+
+\section{States and Reset}
+
+\subsection{\tt Reset \ident.}
+\comindex{Reset}
+This command removes all the objects in the environment since \ident\ 
+was introduced, including \ident. \ident\ may be the name of a defined
+or declared object as well as the name of a section.  One cannot reset
+over the name of a module or of an object inside a module.
+
+\begin{ErrMsgs}
+\item \ident: \errindex{no such entry}
+\end{ErrMsgs}
+
+\subsection{\tt Back.}
+\comindex{Back}
+
+This commands undoes all the effects of the last vernacular
+command. This does not include commands that only access to the
+environment like those described in the previous sections of this
+chapter (for instance {\tt Require} and {\tt Load} can be undone, but
+not {\tt Check} and {\tt Locate}). Commands read from a vernacular
+file are considered as a single command.
+
+\begin{Variants}
+\item {\tt Back $n$} \\
+  Undoes $n$ vernacular commands.
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{Reached begin of command history} \\
+  Happens when there is vernacular command to undo.
+\end{ErrMsgs}
+
+\subsection{\tt Restore State \str.}
+\comindex{Restore State}
+  Restores the state contained in the file \str.
+
+\begin{Variants}
+\item {\tt Restore State \ident}\\
+ Equivalent to {\tt Restore State "}{\ident}{\tt .coq"}.
+\item {\tt Reset Initial.}\comindex{Reset Initial}\\ 
+  Goes back to the initial state (like after the command {\tt coqtop},
+  when the interactive session began). This command is only available
+  interactively.
+\end{Variants}
+
+\subsection{\tt Write State \str.}
+\comindex{Write State}
+Writes the current state into a file \str{} for
+use in a further session. This file can be given as the {\tt
+  inputstate} argument of the commands {\tt coqtop} and {\tt coqc}.
+
+\begin{Variants}
+\item {\tt Write State \ident}\\
+ Equivalent to {\tt Write State "}{\ident}{\tt .coq"}.
+ The state is saved in the current directory (see \pageref{Pwd}).
+\end{Variants}
+
+\section{Quitting and debugging}
+
+\subsection{\tt Quit.}\comindex{Quit}
+This command permits to quit \Coq.
+
+\subsection{\tt Drop.}\comindex{Drop}\label{Drop}
+
+This is used mostly as a debug facility by \Coq's implementors
+and does not concern the casual user.
+This command permits to leave {\Coq} temporarily and enter the
+Objective Caml toplevel. The Objective Caml command:
+
+\begin{flushleft}
+\begin{verbatim}
+#use "include";;
+\end{verbatim}
+\end{flushleft}
+
+\noindent add the right loadpaths and loads some toplevel printers for
+all abstract types of \Coq - section\_path, identfifiers, terms, judgements,
+\dots. You can also use the file \texttt{base\_include} instead,
+that loads only the pretty-printers for section\_paths and
+identifiers.
+% See section \ref{test-and-debug} more information on the
+% usage of the toplevel.
+You can return back to \Coq{} with the command: 
+
+\begin{flushleft}
+\begin{verbatim}
+go();;
+\end{verbatim}
+\end{flushleft}
+
+\begin{Warnings}
+\item It only works with the bytecode version of {\Coq} (i.e. {\tt coqtop} called with option {\tt -byte}, see page \pageref{binary-images}).
+\item You must have compiled {\Coq} from the source package and set the
+  environment variable \texttt{COQTOP} to the root of your copy of the sources (see section \ref{EnvVariables}).
+\end{Warnings}
+
+\subsection{\tt Time \textrm{\textsl{command}}.}\comindex{Time}
+\label{time}
+This command executes the vernac command \textrm{\textsl{command}}
+and display the time needed to execute it.
+
+\section{Controlling display}
+
+\subsection{\tt Set Silent.}
+\comindex{Begin Silent}
+\label{Begin-Silent}
+\index{Silent mode}
+This command turns off the normal displaying.
+
+\subsection{\tt Unset Silent.}\comindex{End Silent}
+This command turns the normal display on.
+
+\subsection{\tt Set Printing Width {\integer}.}\comindex{Set Printing Width}
+This command sets which left-aligned part of the width of the screen
+is used for display. 
+
+\subsection{\tt Unset Printing Width.}\comindex{Unset Printing Width}
+This command resets the width of the screen used for display to its
+default value (which is 78 at the time of writing this documentation).
+
+\subsection{\tt Test Printing Width.}\comindex{Test Printing Width}
+This command displays the current screen width used for display.
+
+\subsection{\tt Set Printing Depth {\integer}.}\comindex{Set Printing Depth}
+This command sets the nesting depth of the formatter used for
+pretty-printing. Beyond this depth, display of subterms is replaced by
+dots. 
+
+\subsection{\tt Unset Printing Depth.}\comindex{Unset Printing Depth}
+This command resets the nesting depth of the formatter used for
+pretty-printing to its default value (at the
+time of writing this documentation, the default value is 50).
+
+\subsection{\tt Test Printing Depth.}\comindex{Test Printing Depth}
+This command displays the current nesting depth used for display.
+
+%\subsection{\tt Explain ...}
+%Not yet documented.
+
+%\subsection{\tt Go ...}
+%Not yet documented.
+
+%\subsection{\tt Abstraction ...}
+%Not yet documented.
+
+% $Id: RefMan-oth.tex 8606 2006-02-23 13:58:10Z herbelin $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex
new file mode 100644
index 00000000..f8a9622c
--- /dev/null
+++ b/doc/refman/RefMan-pre.tex
@@ -0,0 +1,582 @@
+\setheaders{Credits}
+\chapter*{Credits}
+%\addcontentsline{toc}{section}{Credits}
+
+\Coq{}~ is a proof assistant for higher-order logic, allowing the
+development of computer programs consistent with their formal
+specification.  It is the result of about ten years of research of the
+Coq project.  We shall briefly survey here three main aspects: the
+\emph{logical language} in which we write our axiomatizations and
+specifications, the \emph{proof assistant} which allows the development
+of verified mathematical proofs, and the \emph{program extractor} which
+synthesizes computer programs obeying their formal specifications,
+written as logical assertions in the language.
+
+The logical language used by {\Coq} is a variety of type theory,
+called the \emph{Calculus of Inductive Constructions}. Without going
+back to Leibniz and Boole, we can date the creation of what is now
+called mathematical logic to the work of Frege and Peano at the turn
+of the century. The discovery of antinomies in the free use of
+predicates or comprehension principles prompted Russell to restrict
+predicate calculus with a stratification of \emph{types}. This effort
+culminated with \emph{Principia Mathematica}, the first systematic
+attempt at a formal foundation of mathematics.  A simplification of
+this system along the lines of simply typed $\lambda$-calculus
+occurred with Church's \emph{Simple Theory of Types}.  The
+$\lambda$-calculus notation, originally used for expressing
+functionality, could also be used as an encoding of natural deduction
+proofs. This Curry-Howard isomorphism was used by N. de Bruijn in the
+\emph{Automath} project, the first full-scale attempt to develop and
+mechanically verify mathematical proofs. This effort culminated with
+Jutting's verification of Landau's \emph{Grundlagen} in the 1970's.
+Exploiting this Curry-Howard isomorphism, notable achievements in
+proof theory saw the emergence of two type-theoretic frameworks; the
+first one, Martin-L\"of's \emph{Intuitionistic Theory of Types},
+attempts a new foundation of mathematics on constructive principles.
+The second one, Girard's polymorphic $\lambda$-calculus $F_\omega$, is
+a very strong functional system in which we may represent higher-order
+logic proof structures.  Combining both systems in a higher-order
+extension of the Automath languages, T. Coquand presented in 1985 the
+first version of the \emph{Calculus of Constructions}, CoC. This strong
+logical system allowed powerful axiomatizations, but direct inductive
+definitions were not possible, and inductive notions had to be defined
+indirectly through functional encodings, which introduced
+inefficiencies and awkwardness. The formalism was extended in 1989 by
+T. Coquand and C. Paulin with primitive inductive definitions, leading
+to the current \emph{Calculus of Inductive Constructions}.  This
+extended formalism is not rigorously defined here. Rather, numerous
+concrete examples are discussed. We refer the interested reader to
+relevant research papers for more information about the formalism, its
+meta-theoretic properties, and semantics. However, it should not be
+necessary to understand this theoretical material in order to write
+specifications. It is possible to understand the Calculus of Inductive
+Constructions at a higher level, as a mixture of predicate calculus,
+inductive predicate definitions presented as typed PROLOG, and
+recursive function definitions close to the language ML.
+
+Automated theorem-proving was pioneered in the 1960's by Davis and
+Putnam in propositional calculus.  A complete mechanization (in the
+sense of a semi-decision procedure) of classical first-order logic was
+proposed in 1965 by J.A. Robinson, with a single uniform inference
+rule called \emph{resolution}. Resolution relies on solving equations
+in free algebras (i.e. term structures), using the \emph{unification
+  algorithm}. Many refinements of resolution were studied in the
+1970's, but few convincing implementations were realized, except of
+course that PROLOG is in some sense issued from this effort.  A less
+ambitious approach to proof development is computer-aided
+proof-checking.  The most notable proof-checkers developed in the
+1970's were LCF, designed by R. Milner and his colleagues at U.
+Edinburgh, specialized in proving properties about denotational
+semantics recursion equations, and the Boyer and Moore theorem-prover,
+an automation of primitive recursion over inductive data types. While
+the Boyer-Moore theorem-prover attempted to synthesize proofs by a
+combination of automated methods, LCF constructed its proofs through
+the programming of \emph{tactics}, written in a high-level functional
+meta-language, ML.
+
+The salient feature which clearly distinguishes our proof assistant
+from say LCF or Boyer and Moore's, is its possibility to extract
+programs from the constructive contents of proofs. This computational
+interpretation of proof objects, in the tradition of Bishop's
+constructive mathematics, is based on a realizability interpretation,
+in the sense of Kleene, due to C.  Paulin. The user must just mark his
+intention by separating in the logical statements the assertions
+stating the existence of a computational object from the logical
+assertions which specify its properties, but which may be considered
+as just comments in the corresponding program. Given this information,
+the system automatically extracts a functional term from a consistency
+proof of its specifications.  This functional term may be in turn
+compiled into an actual computer program.  This methodology of
+extracting programs from proofs is a revolutionary paradigm for
+software engineering.  Program synthesis has long been a theme of
+research in artificial intelligence, pioneered by R. Waldinger. The
+Tablog system of Z. Manna and R. Waldinger allows the deductive
+synthesis of functional programs from proofs in tableau form of their
+specifications, written in a variety of first-order logic. Development
+of a systematic \emph{programming logic}, based on extensions of
+Martin-L\"of's type theory, was undertaken at Cornell U. by the Nuprl
+team, headed by R. Constable.  The first actual program extractor, PX,
+was designed and implemented around 1985 by S. Hayashi from Kyoto
+University.  It allows the extraction of a LISP program from a proof
+in a logical system inspired by the logical formalisms of S. Feferman.
+Interest in this methodology is growing in the theoretical computer
+science community. We can foresee the day when actual computer systems
+used in applications will contain certified modules, automatically
+generated from a consistency proof of their formal specifications. We
+are however still far from being able to use this methodology in a
+smooth interaction with the standard tools from software engineering,
+i.e. compilers, linkers, run-time systems taking advantage of special
+hardware, debuggers, and the like. We hope that {\Coq} can be of use
+to researchers interested in experimenting with this new methodology.
+
+A first implementation of CoC was started in 1984 by G. Huet and T.
+Coquand.  Its implementation language was CAML, a functional
+programming language from the ML family designed at INRIA in
+Rocquencourt. The core of this system was a proof-checker for CoC seen
+as a typed $\lambda$-calculus, called the \emph{Constructive Engine}.
+This engine was operated through a high-level notation permitting the
+declaration of axioms and parameters, the definition of mathematical
+types and objects, and the explicit construction of proof objects
+encoded as $\lambda$-terms. A section mechanism, designed and
+implemented by G. Dowek, allowed hierarchical developments of
+mathematical theories. This high-level language was called the
+\emph{Mathematical Vernacular}.  Furthermore, an interactive
+\emph{Theorem Prover} permitted the incremental construction of proof
+trees in a top-down manner, subgoaling recursively and backtracking
+from dead-alleys. The theorem prover executed tactics written in CAML,
+in the LCF fashion.  A basic set of tactics was predefined, which the
+user could extend by his own specific tactics. This system (Version
+4.10) was released in 1989.  Then, the system was extended to deal
+with the new calculus with inductive types by C. Paulin, with
+corresponding new tactics for proofs by induction.  A new standard set
+of tactics was streamlined, and the vernacular extended for tactics
+execution. A package to compile programs extracted from proofs to
+actual computer programs in CAML or some other functional language was
+designed and implemented by B. Werner.  A new user-interface, relying
+on a CAML-X interface by D. de Rauglaudre, was designed and
+implemented by A. Felty. It allowed operation of the theorem-prover
+through the manipulation of windows, menus, mouse-sensitive buttons,
+and other widgets. This system (Version 5.6) was released in 1991.
+
+\Coq{} was ported to the new implementation Caml-light of X. Leroy and
+D.  Doligez by D. de Rauglaudre (Version 5.7) in 1992.  A new version
+of \Coq{} was then coordinated by C. Murthy, with new tools designed
+by C.  Parent to prove properties of ML programs (this methodology is
+dual to program extraction) and a new user-interaction loop.  This
+system (Version 5.8) was released in May 1993.  A Centaur interface
+\textsc{CTCoq} was then developed by Y. Bertot from the Croap project
+from INRIA-Sophia-Antipolis.
+
+In parallel, G. Dowek and H. Herbelin developed a new proof engine,
+allowing the general manipulation of existential variables
+consistently with dependent types in an experimental version of \Coq{}
+(V5.9).
+
+The version V5.10 of \Coq{} is based on a generic system for
+manipulating terms with binding operators due to Chet Murthy. A new
+proof engine allows the parallel development of partial proofs for
+independent subgoals.  The structure of these proof trees is a mixed
+representation of derivation trees for the Calculus of Inductive
+Constructions with abstract syntax trees for the tactics scripts,
+allowing the navigation in a proof at various levels of details. The
+proof engine allows generic environment items managed in an
+object-oriented way.  This new architecture, due to C. Murthy,
+supports several new facilities which make the system easier to extend
+and to scale up:
+
+\begin{itemize}
+\item User-programmable tactics are allowed
+\item It is possible to separately verify development modules, and to
+  load their compiled images without verifying them again - a quick
+  relocation process allows their fast loading
+\item A generic parsing scheme allows user-definable notations, with a
+  symmetric table-driven pretty-printer
+\item Syntactic definitions allow convenient abbreviations
+\item A limited facility of meta-variables allows the automatic
+  synthesis of certain type expressions, allowing generic notations
+  for e.g. equality, pairing, and existential quantification.
+\end{itemize}
+
+In the Fall of 1994, C. Paulin-Mohring replaced the structure of
+inductively defined types and families by a new structure, allowing
+the mutually recursive definitions. P. Manoury implemented a
+translation of recursive definitions into the primitive recursive
+style imposed by the internal recursion operators, in the style of the
+ProPre system. C. Mu{\~n}oz implemented a decision procedure for
+intuitionistic propositional logic, based on results of R. Dyckhoff.
+J.C. Filli{\^a}tre implemented a decision procedure for first-order
+logic without contraction, based on results of J. Ketonen and R.
+Weyhrauch. Finally C. Murthy implemented a library of inversion
+tactics, relieving the user from tedious definitions of ``inversion
+predicates''.
+
+\begin{flushright}
+Rocquencourt, Feb. 1st 1995\\
+Gérard Huet
+\end{flushright}
+
+\section*{Credits: addendum for version 6.1}
+%\addcontentsline{toc}{section}{Credits: addendum for version V6.1}
+
+The present version 6.1 of \Coq{} is based on the V5.10 architecture. It
+was ported to the new language Objective Caml by Bruno Barras. The
+underlying framework has slightly changed and allows more conversions
+between sorts. 
+
+The new version provides powerful tools for easier developments. 
+
+Cristina Cornes designed an extension of the \Coq{} syntax to allow
+definition of terms using a powerful pattern-matching analysis in the
+style of ML programs.
+
+Amokrane Saïbi wrote a mechanism to simulate
+inheritance between types families extending a proposal by Peter
+Aczel. He also developed a mechanism to automatically compute which
+arguments of a constant may be inferred by the system and consequently
+do not need to be explicitly written. 
+
+Yann Coscoy designed a command which explains a proof term using
+natural language. Pierre Cr{\'e}gut built a new tactic which solves
+problems in quantifier-free Presburger Arithmetic. Both
+functionalities have been integrated to the \Coq{} system by Hugo
+Herbelin.
+
+Samuel Boutin designed a tactic for simplification of commutative
+rings using a canonical set of rewriting rules and equality modulo
+associativity and commutativity. 
+
+Finally the organisation of the \Coq{} distribution has been supervised
+by Jean-Christophe Filliâtre with the help of Judicaël Courant
+and Bruno Barras.
+
+\begin{flushright}
+Lyon, Nov. 18th 1996\\
+Christine Paulin
+\end{flushright}
+
+\section*{Credits: addendum for version 6.2}
+%\addcontentsline{toc}{section}{Credits: addendum for version V6.2}
+
+In version 6.2 of \Coq{}, the parsing is done using camlp4, a
+preprocessor and pretty-printer for CAML designed by Daniel de
+Rauglaudre at INRIA.  Daniel de Rauglaudre made the first adaptation
+of \Coq{} for camlp4, this work was continued by Bruno Barras who also
+changed the structure of \Coq{} abstract syntax trees and the primitives
+to manipulate them. The result of
+these changes is a faster parsing procedure with greatly improved
+syntax-error messages. The user-interface to introduce grammar or
+pretty-printing rules has also changed.
+
+Eduardo Giménez redesigned the internal 
+tactic libraries, giving uniform names 
+to Caml functions corresponding to \Coq{} tactic names. 
+
+Bruno Barras wrote new more efficient reductions functions.
+
+Hugo Herbelin introduced more uniform notations in the \Coq{}
+specification language: the definitions by fixpoints and
+pattern-matching have a more readable syntax.  Patrick Loiseleur
+introduced user-friendly notations for arithmetic expressions.
+
+New tactics were introduced: Eduardo Giménez improved a mechanism to
+introduce macros for tactics, and designed special tactics for
+(co)inductive definitions; Patrick Loiseleur designed a tactic to
+simplify polynomial expressions in an arbitrary commutative ring which
+generalizes the previous tactic implemented by Samuel Boutin.
+Jean-Christophe Filli\^atre introduced a tactic for refining a goal,
+using a proof term with holes as a proof scheme.
+
+David Delahaye designed the \textsf{SearchIsos} tool to search an
+object in the library given its type (up to isomorphism).
+
+Henri Laulhère produced the \Coq{} distribution for the Windows environment. 
+
+Finally, Hugo Herbelin was the main coordinator of the \Coq{}
+documentation with principal contributions by Bruno Barras, David Delahaye, 
+Jean-Christophe Filli\^atre, Eduardo
+Giménez, Hugo Herbelin and Patrick Loiseleur. 
+
+\begin{flushright}
+Orsay, May 4th 1998\\
+Christine Paulin
+\end{flushright}
+
+\section*{Credits: addendum for version 6.3}
+The main changes in version V6.3 was the introduction of a few new tactics
+and the extension of the guard condition for fixpoint definitions.
+
+
+B. Barras extended the unification algorithm to complete partial terms
+and solved various tricky bugs related to universes.\\
+D. Delahaye developed the \texttt{AutoRewrite} tactic. He also designed the new
+behavior of \texttt{Intro} and provided the tacticals \texttt{First} and
+\texttt{Solve}.\\
+J.-C. Filli\^atre developed the \texttt{Correctness} tactic.\\
+E. Gim\'enez extended the guard condition in fixpoints.\\
+H. Herbelin designed the new syntax for definitions and extended the
+\texttt{Induction} tactic.\\
+P. Loiseleur developed the \texttt{Quote} tactic and 
+the new design of the \texttt{Auto}
+tactic, he also introduced the index of
+errors in the documentation.\\
+C. Paulin wrote the \texttt{Focus} command and introduced 
+the reduction functions in definitions, this last feature 
+was proposed by J.-F. Monin from CNET Lannion. 
+
+\begin{flushright}
+Orsay, Dec. 1999\\
+Christine Paulin
+\end{flushright}
+
+%\newpage
+
+\section*{Credits: versions 7}
+
+The version V7 is a new implementation started in September 1999 by
+Jean-Christophe Filliâtre. This is a major revision with respect to
+the internal architecture of the system.  The \Coq{} version 7.0 was
+distributed in March 2001, version 7.1 in September 2001, version
+7.2 in January 2002, version 7.3 in May 2002 and version 7.4 in
+February 2003.
+
+Jean-Christophe Filliâtre designed the architecture of the new system, he
+introduced a new representation for environments and wrote a new kernel
+for type-checking terms. His approach was to use functional
+data-structures in order to get more sharing, to prepare the addition
+of modules and also to get closer to a certified kernel.
+
+Hugo Herbelin introduced a new structure of terms with local
+definitions. He introduced ``qualified'' names, wrote a new
+pattern-matching compilation algorithm and designed a more compact
+algorithm for checking the logical consistency of universes. He
+contributed to the simplification of {\Coq} internal structures and the
+optimisation of the system. He added basic tactics for forward
+reasoning and coercions in patterns.
+
+David Delahaye introduced a new language for tactics. General tactics
+using pattern-matching on goals and context can directly be written
+from the {\Coq} toplevel. He also provided primitives for the design
+of user-defined tactics in \textsc{Caml}.
+
+Micaela Mayero contributed the library on real numbers.
+Olivier Desmettre extended this library with axiomatic
+trigonometric functions, square, square roots, finite sums, Chasles
+property and basic plane geometry.
+
+Jean-Christophe Filliâtre and Pierre Letouzey redesigned a new
+extraction procedure from \Coq{} terms to \textsc{Caml} or
+\textsc{Haskell} programs. This new 
+extraction procedure, unlike the one implemented in previous version
+of \Coq{} is able to handle all terms in the Calculus of Inductive
+Constructions, even involving universes and strong elimination. P.
+Letouzey adapted user contributions to extract ML programs when it was
+sensible.
+Jean-Christophe Filliâtre wrote \verb=coqdoc=, a documentation
+tool for {\Coq} libraries usable from version 7.2.
+
+Bruno Barras improved the reduction algorithms efficiency and
+the confidence level in the correctness of {\Coq} critical type-checking
+algorithm.
+
+Yves Bertot designed  the \texttt{SearchPattern} and
+\texttt{SearchRewrite} tools and the support for the \textsc{pcoq} interface 
+(\url{http://www-sop.inria.fr/lemme/pcoq/}).
+
+Micaela Mayero and David Delahaye introduced {\tt Field}, a decision tactic for commutative fields.
+
+Christine Paulin changed the elimination rules for empty and singleton
+propositional inductive types.
+
+Loïc Pottier developed {\tt Fourier}, a tactic solving linear inequalities on real numbers.
+
+Pierre Crégut developed a new version based on reflexion of the {\tt Omega}
+decision tactic.
+
+Claudio Sacerdoti Coen designed an XML output for the {\Coq}
+modules to be used in the Hypertextual Electronic Library of
+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.
+
+Jacek Chrz\k{a}szcz designed and implemented the module system of
+{\Coq} whose foundations are in Judicaël Courant's PhD thesis.
+
+\bigskip
+
+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,
+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, 
+C. Alvarado, P. Crégut, J.-F. Monin from France Telecom R \& D.
+\begin{flushright}
+Orsay, May. 2002\\
+Hugo Herbelin \& Christine Paulin
+\end{flushright}
+
+\section*{Credits: version 8.0}
+
+{\Coq} version 8 is a major revision of the {\Coq} proof assistant.
+First, the underlying logic is slightly different. The so-called {\em
+impredicativity} of the sort {\tt Set} has been dropped. The main
+reason is that it is inconsistent with the principle of description
+which is quite a useful principle for formalizing %classical
+mathematics within classical logic. Moreover, even in an constructive
+setting, the impredicativity of {\tt Set} does not add so much in
+practice and is even subject of criticism from a large part of the
+intuitionistic mathematician community. Nevertheless, the
+impredicativity of {\tt Set} remains optional for users interested in
+investigating mathematical developments which rely on it.
+
+Secondly, the concrete syntax of terms has been completely
+revised. The main motivations were
+
+\begin{itemize}
+\item a more uniform, purified style: all constructions are now lowercase, 
+  with a functional programming perfume (e.g. abstraction is now
+  written {\tt fun}), and more directly accessible to the novice
+  (e.g. dependent product is now written {\tt forall} and allows
+  omission of types). Also, parentheses and are no longer mandatory
+  for function application.
+\item extensibility: some standard notations (e.g. ``<'' and ``>'') were
+  incompatible with the previous syntax. Now all standard arithmetic
+  notations (=, +, *, /, <, <=, ... and more) are directly part of the
+  syntax.
+\end{itemize}
+
+Together with the revision of the concrete syntax, a new mechanism of
+{\em interpretation scopes} permits to reuse the same symbols
+(typically +, -, *, /, <, <=) in various mathematical theories without
+any ambiguities for {\Coq}, leading to a largely improved readability of
+{\Coq} scripts. New commands to easily add new symbols are also
+provided.
+
+Coming with the new syntax of terms, a slight reform of the tactic
+language and of the language of commands has been carried out. The
+purpose here is a better uniformity making the tactics and commands
+easier to use and to remember.
+
+Thirdly, a restructuration and uniformisation of the standard library
+of {\Coq} has been performed. There is now just one Leibniz' equality
+usable for all the different kinds of {\Coq} objects. Also, the set of
+real numbers now lies at the same level as the sets of natural and
+integer numbers. Finally, the names of the standard properties of
+numbers now follow a standard pattern and the symbolic
+notations for the standard definitions as well.
+
+The fourth point is the release of \CoqIDE{}, a new graphical
+gtk2-based interface fully integrated to {\Coq}. Close in style from
+the Proof General Emacs interface, it is faster and its integration
+with {\Coq} makes interactive developments more friendly. All
+mathematical Unicode symbols are usable within \CoqIDE{}.
+
+Finally, the module system of {\Coq} completes the picture of {\Coq}
+version 8.0. Though released with an experimental status in the previous
+version 7.4, it should be considered as a salient feature of the new
+version.
+
+Besides, {\Coq} comes with its load of novelties and improvements: new
+or improved tactics (including a new tactic for solving first-order
+statements), new management commands, extended libraries.
+
+\bigskip
+
+Bruno Barras and Hugo Herbelin have been the main contributors of the 
+reflexion and the implementation of the new syntax. The smart
+automatic translator from old to new syntax released with {\Coq} is also
+their work with contributions by Olivier Desmettre.
+
+Hugo Herbelin is the main designer and implementor of the notion of
+interpretation scopes and of the commands for easily adding new notations.
+
+Hugo Herbelin is the main implementor of the restructuration of the
+standard library.
+
+Pierre Corbineau is the main designer and implementor of the new
+tactic for solving first-order statements in presence of inductive
+types. He is also the maintainer of the non-domain specific automation
+tactics.
+
+Benjamin Monate is the developer of the \CoqIDE{} graphical
+interface with contributions by Jean-Christophe Filliâtre, Pierre
+Letouzey, Claude Marché and Bruno Barras.
+
+Claude Marché coordinated the edition of the Reference Manual for
+ \Coq{} V8.0.
+
+Pierre Letouzey and Jacek Chrz\k{a}szcz respectively maintained the
+extraction tool and module system of {\Coq}.
+
+Jean-Christophe Filliâtre, Pierre Letouzey, Hugo Herbelin and 
+contributors from Sophia-Antipolis and Nijmegen participated to the
+extension of the library.
+
+Julien Narboux built a NSIS-based automatic {\Coq} installation tool for
+the Windows platform.
+
+Hugo Herbelin and Christine Paulin coordinated the development which
+was under the responsability of Christine Paulin.
+
+\begin{flushright}
+Palaiseau \& Orsay, Apr. 2004\\
+Hugo Herbelin \& Christine Paulin\\
+(updated Apr. 2006)
+\end{flushright}
+
+\section*{Credits: version 8.1}
+
+{\Coq} version 8.1 adds various new functionalities.
+
+Benjamin Grégoire implemented an alternative algorithm to check the
+convertibility of terms in the {\Coq} type-checker. This alternative
+algorithm works by compilation to an efficient bytecode that is
+interpreted in an abstract machine similar to Xavier Leroy's ZINC
+machine.  Convertibility is performed by comparing the normal
+forms. This alternative algorithm is specifically interesting for
+proofs by reflection. More generally, it is convenient in case of
+intensive computations.
+
+Christine Paulin implemented an extension of inductive types allowing
+recursively non uniform parameters. Hugo Herbelin implemented
+sort-polymorphism for inductive types.
+
+Claudio Sacerdoti Coen improved the tactics for rewriting on arbitrary
+compatible equivalence relations. He also generalized rewriting to
+arbitrary transition systems.
+
+Claudio Sacerdoti Coen added new features to the module system. 
+
+Benjamin Grégoire, Assia Mahboubi and Bruno Barras developed a new
+more efficient and more general simplification algorithm on rings and
+semi-rings.
+
+Hugo Herbelin, Pierre Letouzey and Claudio Sacerdoti Coen added new
+tactic features.
+
+Hugo Herbelin implemented matching on disjunctive patterns.
+
+New mechanisms made easier the communication between {\Coq} and external
+provers. Nicolas Ayache and Jean-Christophe Filliâtre implemented
+connections with the provers {\sc cvcl}, {\sc Simplify} and {\sc
+zenon}. Hugo Herbelin implemented an experimental protocol for calling
+external tools from the tactic language.
+
+%Matthieu Sozeau developed an experimental language to reason over subtypes.
+
+A mechanism to automatically use some specific tactic to solve
+unresolved implicit has been implemented by Hugo Herbelin.
+
+Laurent Théry's contribution on strings and Pierre Letouzey and
+Jean-Christophe Filliâtre's contribution on finite maps have been
+integrated to the {\Coq} standard library. Pierre Letouzey developed a
+library about finite sets ``à la Objective Caml'' and extended the
+lists library.
+
+Pierre Corbineau extended his tactic for solving first-order
+statements. He wrote a reflexion-based intuitionistic tautology
+solver.
+
+Jean-Marc Notin took care of the general maintenance of the system.
+
+\begin{flushright}
+Palaiseau, Apr. 2006\\
+Hugo Herbelin
+\end{flushright}
+
+%\newpage
+
+% Integration of ZArith lemmas from Sophia and Nijmegen.
+
+
+% $Id: RefMan-pre.tex 8707 2006-04-13 18:23:35Z herbelin $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-pro.tex b/doc/refman/RefMan-pro.tex
new file mode 100644
index 00000000..739ca6b5
--- /dev/null
+++ b/doc/refman/RefMan-pro.tex
@@ -0,0 +1,389 @@
+\chapter{Proof handling}
+\index{Proof editing}
+\label{Proof-handling}
+
+In \Coq's proof editing mode all top-level commands documented in 
+chapter \ref{Vernacular-commands} remain available
+and the user has access to specialized commands dealing with proof
+development pragmas documented in this section. He can also use some
+other specialized commands called {\em tactics}.  They are the very
+tools allowing the user to deal with logical reasoning. They are
+documented in chapter \ref{Tactics}.\\ 
+When switching in editing proof mode, the prompt
+\index{Prompt} 
+{\tt Coq <} is changed into {\tt {\ident} <} where {\ident} is the
+declared name of the theorem currently edited.
+
+At each stage of a proof development, one has a list of goals to
+prove. Initially, the list consists only in the theorem itself. After
+having applied some tactics, the list of goals contains the subgoals
+generated by the tactics.
+
+To each subgoal is associated  a number of
+hypotheses we call the {\em \index*{local context}} of the goal.
+Initially, the local context is empty. It is enriched by the use of
+certain tactics (see mainly section~\ref{intro}).
+
+When a proof is achieved the message {\tt Proof completed} is
+displayed. One can then store this proof as a defined constant in the
+environment. Because there exists a correspondence between proofs and
+terms of $\lambda$-calculus, known as the {\em Curry-Howard
+isomorphism} \cite{How80,Bar91,Gir89,Hue89}, \Coq~ stores proofs as
+terms of {\sc Cic}. Those terms are called {\em proof
+  terms}\index{Proof term}.
+
+It is possible to edit several proofs at the same time: see section
+\ref{Resume}
+
+\ErrMsg When one attempts to use a proof editing command out of the
+proof editing mode, \Coq~ raises the error message : \errindex{No focused
+  proof}.
+
+\section{Switching on/off the proof editing mode}
+
+\subsection{\tt Goal {\form}.}
+\comindex{Goal}\label{Goal}
+This command switches \Coq~ to editing proof mode and sets {\form} as
+the original goal. It associates the name {\tt Unnamed\_thm} to
+that goal.
+
+\begin{ErrMsgs}
+\item \errindex{the term \form\ has type \ldots{} which should be Set,
+    Prop or Type}
+%\item \errindex{Proof objects can only be abstracted}
+%\item \errindex{A goal should be a type}
+%\item \errindex{repeated goal not permitted in refining mode}
+%the command {\tt Goal} cannot be used while a proof is already being edited.
+\end{ErrMsgs}
+
+\SeeAlso section \ref{Theorem}
+
+\subsection{\tt Qed.}\comindex{Qed}\label{Qed}
+This command is available in interactive editing proof mode when the
+proof is completed.  Then {\tt Qed} extracts a proof term from the
+proof script, switches back to {\Coq} top-level and attaches the
+extracted proof term to the declared name of the original goal. This
+name is added to the environment as an {\tt Opaque} constant.
+
+\begin{ErrMsgs}
+\item \errindex{Attempt to save an incomplete proof}
+%\item \ident\ \errindex{already exists}\\ 
+%  The implicit name is already defined. You have then to provide
+%  explicitly a new name (see variant 3 below).
+\item Sometimes an error occurs when building the proof term,
+because tactics do not enforce completely the term construction
+constraints.
+
+The user should also be aware of the fact that since the proof term is
+completely rechecked at this point, one may have to wait a while when
+the proof is large. In some exceptional cases one may even incur a
+memory overflow.
+\end{ErrMsgs}
+
+\begin{Variants}
+
+\item {\tt Defined.}
+\comindex{Defined} 
+\label{Defined} 
+
+  Defines the proved term as a transparent constant.
+
+\item {\tt Save.}
+\comindex{Save}
+
+  Is equivalent to {\tt Qed}.
+
+\item {\tt Save {\ident}.}
+  
+  Forces the name of the original goal to be {\ident}.  This command
+  (and the following ones) can only be used if the original goal has
+  been opened using the {\tt Goal} command.
+
+\item {\tt Save Theorem {\ident}.} \\
+ {\tt Save Lemma {\ident}.} \\
+ {\tt Save Remark {\ident}.}\\
+ {\tt Save Fact {\ident}.}
+
+  Are equivalent to {\tt Save {\ident}.} 
+\end{Variants}
+
+\subsection{\tt Admitted.}\comindex{Admitted}\label{Admitted}
+This command is available in interactive editing proof mode to give up
+the current proof and declare the initial goal as an axiom.
+
+\subsection{\tt Theorem {\ident} : {\form}.}
+\comindex{Theorem}
+\label{Theorem}
+
+This command switches to interactive editing proof mode and declares
+{\ident} as being the name of the original goal {\form}. When declared
+as a {\tt Theorem}, the name {\ident} is known at all section levels:
+{\tt Theorem} is a {\sl global} lemma.
+
+%\ErrMsg (see section \ref{Goal})
+
+\begin{ErrMsgs}
+
+\item \errindex{the term \form\ has type \ldots{} which should be Set,
+    Prop or Type}
+
+\item \errindexbis{\ident already exists}{already exists}
+ 
+  The name you provided already defined. You have then to choose
+  another name.
+
+\end{ErrMsgs}
+
+
+\begin{Variants}
+
+\item {\tt Lemma {\ident} : {\form}.}
+\comindex{Lemma}
+
+  It is equivalent to {\tt Theorem {\ident} : {\form}.}
+
+\item {\tt Remark {\ident} : {\form}.}\comindex{Remark}\\
+  {\tt Fact {\ident} : {\form}.}\comindex{Fact}
+
+  Used to have a different meaning, but are now equivalent to {\tt
+  Theorem {\ident} : {\form}.} They are kept for compatibility.
+
+\item {\tt Definition {\ident} : {\form}.}
+\comindex{Definition}
+
+  Analogous to {\tt Theorem}, intended to be used in conjunction with
+  {\tt Defined} (see \ref{Defined}) in order to define a
+  transparent constant.
+
+\item {\tt Let {\ident} : {\form}.}
+\comindex{Let}
+
+  Analogous to {\tt Definition} except that the definition is turned
+  into a local definition on objects depending on it after closing the
+  current section.
+\end{Variants}
+
+\subsection{\tt Proof {\term}.}\comindex{Proof}
+This command applies in proof editing mode. It is equivalent to {\tt
+  exact {\term}; Save.} That is, you have to give the full proof in
+one gulp, as a proof term (see section \ref{exact}).
+
+\begin{Variants}
+
+\item{\tt Proof.}
+  
+  Is a noop which is useful to delimit the sequence of tactic commands
+  which start a proof, after a {\tt Theorem} command.  It is a good
+  practice to use {\tt Proof.} as an opening parenthesis, closed in
+  the script with a closing {\tt Qed.}
+
+\item{\tt Proof with {\tac}.}
+  
+  This command may be used to start a proof. It defines a default
+  tactic to be used each time a tactic command is ended by
+  ``\verb#...#''. In this case the tactic command typed by the user is
+  equivalent to \emph{command};{\tac}.
+
+\end{Variants}
+
+\subsection{\tt Abort.}
+\comindex{Abort}
+
+This command cancels the current proof development, switching back to
+the previous proof development, or to the \Coq\ toplevel if no other
+proof was edited.
+
+\begin{ErrMsgs}
+\item \errindex{No focused proof (No proof-editing in progress)}
+\end{ErrMsgs}
+
+\begin{Variants}
+
+\item {\tt Abort {\ident}.}
+
+  Aborts the editing of the proof named {\ident}.
+
+\item {\tt Abort All.}
+
+  Aborts all current goals, switching back to the \Coq\ toplevel.
+
+\end{Variants}
+
+\subsection{\tt Suspend.}
+\comindex{Suspend}
+
+This command applies in proof editing mode. It switches back to the
+\Coq\ toplevel, but without canceling the current proofs.
+
+\subsection{\tt Resume.}
+\comindex{Resume}\label{Resume}
+
+This commands switches back to the editing of the last edited proof.
+
+\begin{ErrMsgs}
+\item \errindex{No proof-editing in progress}
+\end{ErrMsgs}
+
+\begin{Variants}
+
+\item {\tt Resume {\ident}.}
+
+  Restarts the editing of the proof named {\ident}. This can be used
+  to navigate between currently edited proofs.
+
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{No such proof}
+\end{ErrMsgs}
+
+\section{Navigation in the proof tree}
+
+\subsection{\tt Undo.}
+\comindex{Undo}
+
+This command cancels the effect of the last tactic command.  Thus, it
+backtracks one step.
+
+\begin{ErrMsgs}
+\item \errindex{No focused proof (No proof-editing in progress)}
+\item \errindex{Undo stack would be exhausted}
+\end{ErrMsgs}
+
+\begin{Variants}
+
+\item {\tt Undo {\num}.}
+
+  Repeats {\tt Undo} {\num} times.
+
+\end{Variants}
+
+\subsection{\tt Set Undo {\num}.}
+\comindex{Set Undo}
+
+This command changes the maximum number of {\tt Undo}'s that will be
+possible when doing a proof. It only affects proofs started after
+this command, such that if you want to change the current undo limit
+inside a proof, you should first restart this proof.
+
+\subsection{\tt Unset Undo.}
+\comindex{Unset Undo}
+
+This command resets the default number of possible {\tt Undo} commands
+(which is currently 12).
+
+\subsection{\tt Restart.}\comindex{Restart}
+This command restores the proof editing process to the original goal.
+
+\begin{ErrMsgs}
+\item \errindex{No focused proof to restart}
+\end{ErrMsgs}
+
+\subsection{\tt Focus.}\comindex{Focus}
+This focuses the attention on the first subgoal to prove and the printing
+of the other subgoals is suspended until the focused subgoal is
+solved or unfocused. This is useful when there are many current
+subgoals which clutter your screen.
+
+\begin{Variant}
+\item {\tt Focus {\num}.}\\ 
+This focuses the attention on the $\num^{\scriptsize th}$ subgoal to prove.
+
+\end{Variant}
+
+\subsection{\tt Unfocus.}\comindex{Unfocus}
+Turns off the focus mode.
+
+
+\section{Displaying information}
+
+\subsection{\tt Show.}\comindex{Show}\label{Show}
+This command displays the current goals.
+
+\begin{Variants}
+\item {\tt Show {\num}.}\\ 
+  Displays only the {\num}-th subgoal.\\ 
+\begin{ErrMsgs}
+\item \errindex{No such goal}
+\item \errindex{No focused proof}
+\end{ErrMsgs}
+
+\item {\tt Show Implicits.}\comindex{Show Implicits}\\
+  Displays the current goals, printing the implicit arguments of
+  constants.
+
+\item {\tt Show Implicits {\num}.}\\
+  Same as above, only displaying the {\num}-th subgoal.
+
+\item {\tt Show Script.}\comindex{Show Script}\\
+  Displays the whole list of tactics applied from the beginning
+  of the current proof. 
+  This tactics script may contain some holes (subgoals not yet proved).
+  They are printed under the form \verb!<Your Tactic Text here>!.
+
+\item {\tt Show Tree.}\comindex{Show Tree}\\
+This command can be seen as a more structured way of
+displaying the state of the proof than that 
+provided by {\tt Show Script}. Instead of just giving
+the list of tactics that have been applied, it 
+shows the derivation tree constructed by then. 
+Each node of the tree contains the conclusion
+of the corresponding sub-derivation (i.e. a
+goal with its corresponding local context) and 
+the tactic that has generated all the 
+sub-derivations. The leaves of this tree are
+the goals which still remain to be proved.
+
+%\item {\tt Show Node}\comindex{Show Node}\\
+%        Not yet documented
+
+\item {\tt Show Proof.}\comindex{Show Proof}\\
+It displays the proof term generated by the 
+tactics that have been applied. 
+If the proof is not completed, this term contain holes,
+which correspond to the sub-terms which are still to be 
+constructed. These holes appear as a question mark indexed 
+by an integer, and applied to the list of variables in 
+the context, since it may depend on them. 
+The types obtained by abstracting away the context from the
+type of each hole-placer are also printed.
+
+\item {\tt Show Conjectures.}\comindex{Show Conjectures}\\
+It prints the list of the names of all the theorems that 
+are currently being proved.
+As it is possible to start proving a previous lemma during
+the proof of a theorem, this list may contain several 
+names. 
+
+\item{\tt Show Intro.}\comindex{Show Intro}\\
+If the current goal begins by at least one product, this command
+prints the name of the first product, as it would be generated by 
+an anonymous {\tt Intro}. The aim of this command is to ease the
+writing of more robust scripts. For example, with an appropriate 
+Proof General macro, it is possible to transform any anonymous {\tt
+  Intro} into a qualified one such as {\tt Intro y13}.
+In the case of a non-product goal, it prints nothing. 
+
+\item{\tt Show Intros.}\comindex{Show Intros}\\
+This command is similar to the previous one, it simulates the naming 
+process of an {\tt Intros}.
+
+\end{Variants}
+
+\subsection{\tt Set Hyps Limit {\num}.}
+\comindex{Set Hyps Limit}
+This command sets the maximum number of hypotheses displayed in
+goals after the application of a tactic. 
+All the hypotheses remains usable in the proof development.
+
+\subsection{\tt Unset Hyps Limit.}
+\comindex{Unset Hyps Limit}
+This command goes back to the default mode which is to print all
+available hypotheses.
+
+% $Id: RefMan-pro.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-syn.tex b/doc/refman/RefMan-syn.tex
new file mode 100644
index 00000000..341e766e
--- /dev/null
+++ b/doc/refman/RefMan-syn.tex
@@ -0,0 +1,1016 @@
+\chapter{Syntax extensions and interpretation scopes}
+\label{Addoc-syntax}
+
+In this chapter, we introduce advanced commands to modify the way
+{\Coq} parses and prints objects, i.e. the translations between the
+concrete and internal representations of terms and commands. The main
+commands are {\tt Notation} and {\tt Infix} which are described in
+section \ref{Notation}.  It also happens that the same symbolic
+notation is expected in different contexts. To achieve this form of
+overloading, {\Coq} offers a notion of interpretation scope. This is
+described in section \ref{scopes}.
+
+\Rem The commands {\tt Grammar}, {\tt Syntax} and {\tt Distfix} which
+were present for a while in {\Coq} are no longer available from {\Coq}
+version 8.0. The underlying AST structure is also no longer available.
+The functionalities of the command {\tt Syntactic Definition} are
+still available, see section \ref{Abbreviations}.
+
+\section{Notations}
+\label{Notation}
+\comindex{Notation}
+
+\subsection{Basic notations}
+
+A {\em notation} is a symbolic abbreviation denoting some term
+or term pattern.
+
+A typical notation is the use of the infix symbol \verb=/\= to denote
+the logical conjunction (\texttt{and}). Such a notation is declared
+by
+
+\begin{coq_example*}
+Notation "A /\ B" := (and A B).
+\end{coq_example*}
+
+The expression \texttt{(and A B)} is the abbreviated term and the
+string \verb="A /\ B"= (called a {\em notation}) tells how it is 
+symbolically written.
+
+A notation is always surrounded by double quotes (excepted when the
+abbreviation is a single ident, see \ref{Abbreviations}). The
+notation is composed of {\em tokens} separated by spaces.  Identifiers
+in the string (such as \texttt{A} and \texttt{B}) are the {\em
+parameters} of the notation. They must occur at least once each in the
+denoted term. The other elements of the string (such as \verb=/\=) are
+the {\em symbols}.
+
+An identifier can be used as a symbol but it must be surrounded by
+simple quotes to avoid the confusion with a parameter. Similarly,
+every symbol of at least 3 characters and starting with a simple quote
+must be quoted (then it starts by two single quotes). Here is an example.
+
+\begin{coq_example*}
+Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3).
+\end{coq_example*}
+
+%TODO quote the identifier when not in front, not a keyword, as in "x 'U' y" ?
+
+A notation binds a syntactic expression to a term. Unless the parser
+and pretty-printer of {\Coq} already know how to deal with the
+syntactic expression (see \ref{ReservedNotation}), explicit precedences and
+associativity rules have to be given.
+
+\subsection{Precedences and associativity}
+\index{Precedences}
+\index{Associativity}
+
+Mixing different symbolic notations in a same text may cause serious
+parsing ambiguity. To deal with the ambiguity of notations, {\Coq}
+uses precedence levels ranging from 0 to 100 (plus one extra level
+numbered 200) and associativity rules.
+
+Consider for example the new notation
+
+\begin{coq_example*}
+Notation "A \/ B" := (or A B).
+\end{coq_example*}
+
+Clearly, an expression such as {\tt (A:Prop)True \verb=/\= A \verb=\/=
+A \verb=\/= False} is ambiguous. To tell the {\Coq} parser how to
+interpret the expression, a priority between the symbols \verb=/\= and
+\verb=\/= has to be given. Assume for instance that we want conjunction
+to bind more than disjunction. This is expressed by assigning a
+precedence level to each notation, knowing that a lower level binds
+more than a higher level.  Hence the level for disjunction must be
+higher than the level for conjunction.
+
+Since connectives are the less tight articulation points of a text, it
+is reasonable to choose levels not so far from the higher level which
+is 100, for example 85 for disjunction and 80 for
+conjunction\footnote{which are the levels effectively chosen in the
+current implementation of {\Coq}}.
+
+Similarly, an associativity is needed to decide whether {\tt True \verb=/\=
+False \verb=/\= False} defaults to {\tt True \verb=/\= (False
+\verb=/\= False)} (right associativity) or to {\tt (True
+\verb=/\= False) \verb=/\= False} (left associativity). We may
+even consider that the expression is not well-formed and that
+parentheses are mandatory (this is a ``no associativity'')\footnote{
+{\Coq} accepts notations declared as no associative but the parser on
+which {\Coq} is built, namely {\camlpppp}, currently does not implement the
+no-associativity and replace it by a left associativity; hence it is
+the same for {\Coq}: no-associativity is in fact left associativity}.
+We don't know of a special convention of the associativity of
+disjunction and conjunction, let's apply for instance a right
+associativity (which is the choice of {\Coq}).
+
+Precedence levels and associativity rules of notations have to be
+given between parentheses in a list of modifiers that the
+\texttt{Notation} command understands. Here is how the previous
+examples refine.
+
+\begin{coq_example*}
+Notation "A /\ B" := (and A B) (at level 80, right associativity).
+Notation "A \/ B" := (or A B)  (at level 85, right associativity).
+\end{coq_example*}
+
+By default, a notation is considered non associative, but the
+precedence level is mandatory (except for special cases whose level is
+canonical). The level is either a number or the mention {\tt next
+level} whose meaning is obvious. The list of levels already assigned
+is on Figure~\ref{init-notations}.
+
+\subsection{Complex notations}
+
+Notations can be made from arbitraly complex symbols. One can for
+instance define prefix notations.
+
+\begin{coq_example*}
+Notation "~ x" := (not x) (at level 75, right associativity).
+\end{coq_example*}
+
+One can also define notations for incomplete terms, with the hole
+expected to be inferred at typing time.
+
+\begin{coq_example*}
+Notation "x = y" := (@eq _ x y) (at level 70, no associativity).
+\end{coq_example*}
+
+One can define {\em closed} notations whose both sides are symbols. In
+this case, the default precedence level for inner subexpression is 200.
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is correct but produces **********)
+(**** an incompatibility with the reserved notation ********)
+\end{coq_eval}
+\begin{coq_example*}
+Notation "( x , y )" := (@pair _ _ x y) (at level 0).
+\end{coq_example*}
+
+One can also define notations for binders.
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is correct but produces **********)
+(**** an incompatibility with the reserved notation ********)
+\end{coq_eval}
+\begin{coq_example*}
+Notation "{ x : A  |  P }" := (sig A (fun x => P)) (at level 0).
+\end{coq_example*}
+
+In the last case though, there is a conflict with the notation for
+type casts. This last notation, as shown by the command {\tt Print Grammar
+constr} is at level 100. To avoid \verb=x : A= being parsed as a type cast,
+it is necessary to put {\tt x} at a level below 100, typically 99. Hence, a
+correct definition is 
+
+\begin{coq_example*}
+Notation "{ x : A  |  P }" := (sig A (fun x => P)) (at level 0, x at level 99).
+\end{coq_example*}
+
+%This change has retrospectively an effect on the notation for notation
+%{\tt "{ A } + { B }"}. For the sake of factorization, {\tt A} must be
+%put at level 99 too, which gives
+%
+%\begin{coq_example*}
+%Notation "{ A } + { B }" := (sumbool A B) (at level 0, A at level 99).
+%\end{coq_example*}
+
+See the next section for more about factorization.
+
+\subsection{Simple factorization rules}
+
+{\Coq} extensible parsing is performed by Camlp4 which is essentially a
+LL1 parser. Hence, some care has to be taken not to hide already
+existing rules by new rules. Some simple left factorization work has
+to be done. Here is an example.
+
+\begin{coq_eval}
+(********** The next rule for notation _ < _ < _  produces **********)
+(*** Error: Notation _ < _ < _ is already defined at level 70 ... ***)
+\end{coq_eval}
+\begin{coq_example*}
+Notation "x < y"     := (lt x y) (at level 70).
+Notation "x < y < z" := (x < y /\ y < z) (at level 70).
+\end{coq_example*}
+
+In order to factorize the left part of the rules, the subexpression
+referred by {\tt y} has to be at the same level in both rules. However
+the default behavior puts {\tt y} at the next level below 70
+in the first rule (no associativity is the default), and at the level
+200 in the second rule (level 200 is the default for inner expressions).
+To fix this, we need to force the parsing level of {\tt y},
+as follows.
+
+\begin{coq_example*}
+Notation "x < y"     := (lt x y) (at level 70).
+Notation "x < y < z" := (x < y /\ y < z) (at level 70, y at next level).
+\end{coq_example*}
+
+For the sake of factorization with {\Coq} predefined rules, simple
+rules have to be observed for notations starting with a symbol:
+e.g. rules starting with ``\{'' or ``('' should be put at level 0. The
+list of {\Coq} predefined notations can be found in chapter \ref{Theories}.
+
+The command to display the current state of the {\Coq} term parser is
+\comindex{Print Grammar constr}
+
+\begin{quote}
+\tt Print Grammar constr.
+\end{quote}
+
+\subsection{Displaying symbolic notations}
+
+The command \texttt{Notation} has an effect both on the {\Coq} parser and
+on the {\Coq} printer. For example:
+
+\begin{coq_example}
+Check (and True True).
+\end{coq_example}
+
+However, printing, especially pretty-printing, requires
+more care than parsing. We may want specific indentations,
+line breaks, alignment if on several lines, etc. 
+
+The default printing of notations is very rudimentary. For printing a
+notation, a {\em formatting box} is opened in such a way that if the
+notation and its arguments cannot fit on a single line, a line break
+is inserted before the symbols of the notation and the arguments on
+the next lines are aligned with the argument on the first line.
+
+A first, simple control that a user can have on the printing of a
+notation is the insertion of spaces at some places of the
+notation. This is performed by adding extra spaces between the symbols
+and parameters: each extra space (other than the single space needed
+to separate the components) is interpreted as a space to be inserted
+by the printer. Here is an example showing how to add spaces around
+the bar of the notation.
+
+\begin{coq_example}
+Notation "{{ x : A  |  P }}" := (sig (fun x : A => P))
+  (at level 0, x at level 99).
+Check (sig (fun x : nat => x=x)).
+\end{coq_example}
+
+The second, more powerful control on printing is by using the {\tt
+format} modifier. Here is an example
+
+\begin{small}
+\begin{coq_example}
+Notation "'If' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3)
+(at level 200, right associativity, format
+"'[v   ' 'If'  c1 '/' '[' 'then'  c2  ']' '/' '[' 'else'  c3 ']' ']'").
+\end{coq_example}
+\end{small}
+
+A {\em format} is an extension of the string denoting the notation with
+the possible following elements delimited by single quotes:
+
+\begin{itemize}
+\item extra spaces are translated into simple spaces
+\item tokens of the form \verb='/  '= are translated into breaking point,
+  in case a line break occurs, an indentation of the number of spaces
+  after the ``\verb=/='' is applied (2 spaces in the given example)
+\item token of the form \verb='//'= force writing on a new line
+\item well-bracketed pairs of tokens of the form \verb='[    '= and \verb=']'=
+  are translated into printing boxes; in case a line break occurs,
+  an extra indentation of the number of spaces given after the ``\verb=[=''
+  is applied (4 spaces in the example)
+\item well-bracketed pairs of tokens of the form \verb='[hv   '= and \verb=']'=
+  are translated into horizontal-orelse-vertical printing boxes; 
+  if the content of the box does not fit on a single line, then every breaking
+  point forces a newline and an extra  indentation of the number of spaces
+  given after the ``\verb=[='' is applied at the beginning of each newline
+  (3 spaces in the example)
+\item well-bracketed pairs of tokens of the form \verb='[v '= and
+  \verb=']'= are translated into vertical printing boxes; every
+  breaking point forces a newline, even if the line is large enough to
+  display the whole content of the box, and an extra indentation of the
+  number of spaces given after the ``\verb=[='' is applied at the beginning
+  of each newline
+\end{itemize}
+
+Thus, for the previous example, we get
+%\footnote{The ``@'' is here to shunt
+%the notation "'IF' A 'then' B 'else' C" which is defined in {\Coq}
+%initial state}:
+
+Notations do not survive the end of sections. No typing of the denoted
+expression is performed at definition time. Type-checking is done only
+at the time of use of the notation.
+
+\begin{coq_example}
+Check 
+ (IF_then_else (IF_then_else True False True) 
+   (IF_then_else True False True)
+   (IF_then_else True False True)).   
+\end{coq_example}
+
+\Rem
+Sometimes, a notation is expected only for the parser.
+%(e.g. because
+%the underlying parser of {\Coq}, namely {\camlpppp}, is LL1 and some extra
+%rules are needed to circumvent the absence of factorization).
+To do so, the option {\em only parsing} is allowed in the list of modifiers of
+\texttt{Notation}.
+
+\subsection{The \texttt{Infix} command
+\comindex{Infix}}
+
+The \texttt{Infix} command is a shortening for declaring notations of
+infix symbols. Its syntax is 
+
+\begin{quote}
+\noindent\texttt{Infix "{\symbolentry}" :=} {\qualid} {\tt (} \nelist{\em modifier}{,} {\tt )}.
+\end{quote}
+
+and it is equivalent to
+
+\begin{quote}
+\noindent\texttt{Notation "x {\symbolentry} y" := ({\qualid} x y)  (} \nelist{\em modifier}{,} {\tt )}.
+\end{quote}
+
+where {\tt x} and {\tt y} are fresh names distinct from {\qualid}. Here is an example.
+
+\begin{coq_example*}
+Infix "/\" := and (at level 80, right associativity).
+\end{coq_example*}
+
+\subsection{Reserving notations
+\label{ReservedNotation}
+\comindex{ReservedNotation}}
+
+A given notation may be used in different contexts. {\Coq} expects all
+uses of the notation to be defined at the same precedence and with the
+same associativity. To avoid giving the precedence and associativity
+every time, it is possible to declare a parsing rule in advance
+without giving its interpretation. Here is an example from the initial
+state of {\Coq}.
+
+\begin{coq_example}
+Reserved Notation "x = y" (at level 70, no associativity).
+\end{coq_example}
+
+Reserving a notation is also useful for simultaneously defined an
+inductive type or a recursive constant and a notation for it.
+
+\Rem The notations mentioned on Figure~\ref{init-notations} are
+reserved. Hence their precedence and associativity cannot be changed.
+
+\subsection{Simultaneous definition of terms and notations
+\comindex{Fixpoint {\ldots} where {\ldots}}
+\comindex{CoFixpoint {\ldots} where {\ldots}}
+\comindex{Inductive {\ldots} where {\ldots}}}
+
+Thanks to reserved notations, the inductive, coinductive, recursive
+and corecursive definitions can benefit of customized notations. To do
+this, insert a {\tt where} notation clause after the definition of the
+(co)inductive type or (co)recursive term (or after the definition of
+each of them in case of mutual definitions). The exact syntax is given
+on Figure \ref{notation-syntax}. Here are examples:
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is correct but produces an error **********)
+(********** because the symbol /\ is already bound **********)
+(**** Error: The conclusion of A -> B -> A /\ B is not valid *****)
+\end{coq_eval}
+
+\begin{coq_example*}
+Inductive and (A B:Prop) : Prop := conj : A -> B -> A /\ B 
+where "A /\ B" := (and A B).
+\end{coq_example*}
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is correct but produces an error **********)
+(********** because the symbol + is already bound **********)
+(**** Error: no recursive definition *****)
+\end{coq_eval}
+
+\begin{coq_example*}
+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).
+\end{coq_example*}
+
+\subsection{Displaying informations about notations
+\comindex{Set Printing Notations}
+\comindex{Unset Printing Notations}}
+
+To deactivate the printing of all notations, use the command
+\begin{quote}
+\tt Unset Printing Notations.
+\end{quote}
+To reactivate it, use the command
+\begin{quote}
+\tt Set Printing Notations.
+\end{quote}
+The default is to use notations for printing terms wherever possible.
+
+\SeeAlso {\tt Set Printing All} in section \ref{SetPrintingAll}.
+
+\subsection{Locating notations
+\comindex{Locate}
+\label{LocateSymbol}}
+
+To know to which notations a given symbol belongs to, use the command
+\begin{quote}
+\tt Locate {\symbolentry}
+\end{quote}
+where symbol is any (composite) symbol surrounded by quotes. To locate
+a particular notation, use a string where the variables of the
+notation are replaced by ``\_''.
+
+\Example
+\begin{coq_example}
+Locate "exists".
+Locate "'exists' _ , _".
+\end{coq_example}
+
+\SeeAlso Section \ref{Locate}.
+
+\begin{figure}
+\begin{centerframe}
+\begin{tabular}{lcl}
+{\sentence} & ::= &
+   \texttt{Notation} \zeroone{\tt Local} {\str} \texttt{:=} {\term} 
+   \zeroone{\modifiers} \zeroone{:{\scope}} .\\
+  & $|$ & 
+   \texttt{Infix} \zeroone{\tt Local} {\str} \texttt{:=} {\qualid} 
+   \zeroone{\modifiers} \zeroone{:{\scope}} .\\
+  & $|$ & 
+   \texttt{Reserved Notation} \zeroone{\tt Local} {\str}
+   \zeroone{\modifiers} .\\
+  & $|$ & {\tt Inductive}
+   \nelist{{\inductivebody} \zeroone{\declnotation}}{with}{\tt .}\\
+  & $|$ & {\tt CoInductive}
+   \nelist{{\inductivebody} \zeroone{\declnotation}}{with}{\tt .}\\
+  & $|$ & {\tt Fixpoint}
+   \nelist{{\fixpointbody} \zeroone{\declnotation}}{with} {\tt .} \\
+  & $|$ & {\tt CoFixpoint}
+   \nelist{{\cofixpointbody} \zeroone{\declnotation}}{with} {\tt .} \\
+\\
+{\declnotation} & ::= & 
+  \zeroone{{\tt where} {\str} {\tt :=} {\term} \zeroone{:{\scope}}} .
+\\
+\\
+{\modifiers}
+  & ::= & \nelist{\ident}{,} {\tt at level} {\naturalnumber} \\
+  & $|$ & \nelist{\ident}{,} {\tt at next level} \\
+  & $|$ & {\tt at level} {\naturalnumber} \\
+  & $|$ & {\tt left associativity} \\
+  & $|$ & {\tt right associativity} \\
+  & $|$ & {\tt no associativity} \\
+  & $|$ & {\ident} {\tt ident} \\
+  & $|$ & {\ident} {\tt global} \\
+  & $|$ & {\ident} {\tt bigint} \\
+  & $|$ & {\tt only parsing} \\
+  & $|$ & {\tt format} {\str} 
+\end{tabular}
+\end{centerframe}
+\caption{Syntax of the variants of {\tt Notation}}
+\label{notation-syntax}
+\end{figure}
+
+\subsection{Notations with recursive patterns}
+
+An experimental mechanism is provided for declaring elementary
+notations including recursive patterns. The basic syntax is
+
+\begin{coq_eval}
+Require Import List.
+\end{coq_eval}
+
+\begin{coq_example*}
+Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).
+\end{coq_example*}
+
+On the right-hand-side, an extra construction of the form {\tt ..} ($f$
+$t_1$ $\ldots$ $t_n$) {\tt ..} can be used. Notice that {\tt ..} is part of
+the {\Coq} syntax while $\ldots$ is just a meta-notation of this
+manual to denote a sequence of terms of arbitrary size.
+
+This extra construction enclosed within {\tt ..}, let's call it $t$,
+must be one of the argument of an applicative term of the form {\tt
+($f$ $u_1$ $\ldots$ $u_n$)}. The sequences $t_1$ $\ldots$ $t_n$ and
+$u_1$ $\ldots$ $u_n$ must coincide everywhere but in two places. In
+one place, say the terms of indice $i$, we must have $u_i = t$. In the
+other place, say the terms of indice $j$, both $u_j$ and $t_j$ must be
+variables, say $x$ and $y$ which are bound by the notation string on
+the left-hand-side of the declaration. The variables $x$ and $y$ in
+the string must occur in a substring of the form "$x$ $s$ {\tt ..} $s$
+$y$" where {\tt ..} is part of the syntax and $s$ is two times the
+same sequence of terminal symbols (i.e. symbols which are not
+variables).
+
+These invariants must be satisfied in order the notation to be
+correct.  The term $t_i$ is the {\em terminating} expression of
+the notation and the pattern {\tt ($f$ $u_1$ $\ldots$ $u_{i-1}$ {\rm [I]}
+$u_{i+1}$ $\ldots$ $u_{j-1}$ {\rm [E]} $u_{j+1}$ $\ldots$ $u_{n}$)} is the
+{\em iterating pattern}. The hole [I] is the {\em iterative} place
+and the hole [E] is the {\em enumerating} place. Remark that if $j<i$, the
+iterative place comes after the enumerating place accordingly.
+
+The notation parses sequences of tokens such that the subpart "$x$ $s$
+{\tt ..} $s$ $y$" parses any number of time (but at least one time) a
+sequence of expressions separated by the sequence of tokens $s$. The
+parsing phase produces a list of expressions which
+are used to fill in order the holes [E] of the iterating pattern
+which is nested as many time as the length of the list, the hole [I]
+being the nesting point. In the innermost occurrence of the nested
+iterating pattern, the hole [I] is finally filled with the terminating
+expression.
+
+In the example above, $f$ is {\tt cons}, $n=3$ (because {\tt cons} has
+a hidden implicit argument!), $i=3$ and $j=2$. The {\em terminating}
+expression is {\tt nil} and the {\em iterating pattern} is {\tt cons
+{\rm [E] [I]}}. Finally, the sequence $s$ is made of the single token
+``{\tt ;}''. Here is another example.
+\begin{coq_example*}
+Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) (at level 0).
+\end{coq_example*}
+
+Notations with recursive patterns can be reserved like standard
+notations, they can also be declared within interpretation scopes (see
+section \ref{scopes}).
+
+\subsection{Notations and binders}
+
+Notations can be defined for binders as in the example:
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is correct but produces **********)
+(**** an incompatibility with the reserved notation ********)
+\end{coq_eval}
+\begin{coq_example*}
+Notation "{ x : A  |  P  }" := (sig (fun x : A => P)) (at level 0).
+\end{coq_example*}
+
+The binding variables in the left-hand-side that occur as a parameter
+of the notation naturally bind all their occurrences appearing in
+their respective scope after instantiation of the parameters of the
+notation.
+
+Contrastingly, the binding variables that are not a parameter of the
+notation do not capture the variables of same name that
+could appear in their scope after instantiation of the
+notation. E.g., for the notation
+
+\begin{coq_example*}
+Notation "'exists_different' n" := (exists p:nat, p<>n) (at level 200).
+\end{coq_example*}
+the next command fails because {\tt p} does not bind in 
+the instance of {\tt n}.
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following produces **********)
+(**** The reference p was not found in the current environment ********)
+\end{coq_eval}
+\begin{coq_example}
+Check (exists_different p).
+\end{coq_example}
+
+\Rem Binding variables must not necessarily be parsed using the
+{\tt ident} entry. For factorization purposes, they can be said to be
+parsed at another level (e.g. {\tt x} in \verb="{ x : A | P }"= must be
+parsed at level 99 to be factorized with the notation
+\verb="{ A } + { B }"= for which {\tt A} can be any term).  
+However, even if parsed as a term, this term must at the end be effectively 
+a single identifier.
+
+\subsection{Summary}
+
+\paragraph{Syntax of notations}
+
+The different syntactic variants of the command \texttt{Notation} are
+given on Figure \ref{notation-syntax}. The optional {\tt :{\scope}} is
+described in the section \ref{scopes}.
+
+\Rem No typing of the denoted expression is performed at definition
+time. Type-checking is done only at the time of use of the notation.
+
+\Rem Many examples of {\tt Notation} may be found in the files
+composing the initial state of {\Coq} (see directory {\tt
+\$COQLIB/theories/Init}).
+
+\Rem The notation \verb="{ x }"= has a special status in such a way
+that complex notations of the form \verb="x + { y }"= or
+\verb="x * { y }"= can be nested with correct precedences. Especially,
+every notation involving a pattern of the form \verb="{ x }"= is
+parsed as a notation where the pattern \verb="{ x }"= has been simply
+replaced by \verb="x"= and the curly brackets are parsed separately.
+E.g. \verb="y + { z }"= is not parsed as a term of the given form but
+as a term of the form \verb="y + z"= where \verb=z= has been parsed
+using the rule parsing \verb="{ x }"=. Especially, level and
+precedences for a rule including patterns of the form \verb="{ x }"=
+are relative not to the textual notation but to the notation where the
+curly brackets have been removed (e.g. the level and the associativity
+given to some notation, say \verb="{ y } & { z }"= in fact applies to
+the underlying \verb="{ x }"=-free rule which is \verb="y & z"=).
+
+\paragraph{Persistence of notations}
+
+Notations do not survive the end of sections. They survive modules
+unless the command {\tt Notation Local} is used instead of {\tt
+Notation}.
+
+\section{Interpretation scopes}
+\index{Interpretation scopes}
+\label{scopes}
+% Introduction
+
+An {\em interpretation scope} is a set of notations for terms with
+their interpretation. Interpretation scopes provides with a weak,
+purely syntactical form of notations overloading: a same notation, for
+instance the infix symbol \verb=+= can be used to denote distinct
+definitions of an additive operator. Depending on which interpretation
+scopes is currently open, the interpretation is different.
+Interpretation scopes can include an interpretation for
+numerals. However, this is only made possible at the {\ocaml} level.
+
+See Figure \ref{notation-syntax} for the syntax of notations including
+the possibility to declare them in a given scope.  Here is a typical
+example which declares the notation for conjunction in the scope {\tt
+type\_scope}.
+
+\begin{verbatim}
+Notation "A /\ B" := (and A B) : type_scope.
+\end{verbatim}
+
+\Rem A notation not defined in a scope is called a {\em lonely} notation.
+
+\subsection{Global interpretation rules for notations}
+
+At any time, the interpretation of a notation for term is done within
+a {\em stack} of interpretation scopes and lonely notations. In case a
+notation has several interpretations, the actual interpretation is the
+one defined by (or in) the more recently declared (or open) lonely
+notation (or interpretation scope) which defines this notation.
+Typically if a given notation is defined in some scope {\scope} but
+has also an interpretation not assigned to a scope, then, if {\scope}
+is open before the lonely interpretation is declared, then the lonely
+interpretation is used (and this is the case even if the
+interpretation of the notation in {\scope} is given after the lonely
+interpretation: otherwise said, only the order of lonely
+interpretations and opening of scopes matters, and not the declaration
+of interpretations within a scope).
+
+The initial state of {\Coq} declares three interpretation scopes and
+no lonely notations. These scopes, in opening order, are {\tt
+core\_scope}, {\tt type\_scope} and {\tt nat\_scope}.
+
+The command to add a scope to the interpretation scope stack is
+\comindex{Open Scope}
+\comindex{Close Scope}
+\begin{quote}
+{\tt Open Scope} {\scope}.
+\end{quote}
+It is also possible to remove a scope from the interpretation scope
+stack by using the command
+\begin{quote}
+{\tt Close Scope} {\scope}.
+\end{quote}
+Notice that this command does not only cancel the last {\tt Open Scope
+{\scope}} but all the invocation of it.
+
+\Rem {\tt Open Scope} and {\tt Close Scope} do not survive the end of
+sections where they occur. When defined outside of a section, they are
+exported to the modules that import the module where they occur.
+
+\begin{Variants}
+
+\item {\tt Open Local Scope} {\scope}.
+
+\item {\tt Close Local Scope} {\scope}.
+
+These variants are not exported to the modules that import the module
+where they occur, even if outside a section.
+
+\end{Variants}
+
+\subsection{Local interpretation rules for notations}
+
+In addition to the global rules of interpretation of notations, some
+ways to change the interpretation of subterms are available.
+
+\subsubsection{Local opening of an interpretation scope 
+\label{scopechange}
+\index{\%}
+\comindex{Delimit Scope}}
+
+It is possible to locally extend the interpretation scope stack using
+the syntax ({\term})\%{\nterm{key}} (or simply {\term}\%{\nterm{key}}
+for atomic terms), where {\nterm{key}} is a special identifier called
+{\em delimiting key} and bound to a given scope.
+
+In such a situation, the term {\term}, and all its subterms, are
+interpreted in the scope stack extended with the scope bound to
+{\nterm{key}}.
+
+To bind a delimiting key to a scope, use the command
+
+\begin{quote}
+\texttt{Delimit Scope} {\scope} \texttt{with} {\ident} 
+\end{quote}
+
+\subsubsection{Binding arguments of a constant to an interpretation scope
+\comindex{Arguments Scope}}
+
+It is possible to set in advance that some arguments of a given
+constant have to be interpreted in a given scope. The command is
+\begin{quote}
+{\tt Arguments Scope} {\qualid} {\tt [ \nelist{\optscope}{} ]}
+\end{quote}
+where the list is a list made either of {\tt \_} or of a scope name.
+Each scope in the list is bound to the corresponding parameter of
+{\qualid} in order.  When interpreting a term, if some of the
+arguments of {\qualid} are built from a notation, then this notation
+is interpreted in the scope stack extended by the scopes bound (if any)
+to these arguments.
+
+\SeeAlso The command to show the scopes bound to the arguments of a
+function is described in section \ref{About}.
+
+\subsubsection{Binding types of arguments to an interpretation scope}
+
+When an interpretation scope is naturally associated to a type
+(e.g. the scope of operations on the natural numbers), it may be
+convenient to bind it to this type. The effect of this is that any
+argument of a function that syntactically expects a parameter of this
+type is interpreted using scope. More precisely, it applies only if
+this argument is built from a notation, and if so, this notation is
+interpreted in the scope stack extended by this particular scope.  It
+does not apply to the subterms of this notation (unless the
+interpretation of the notation itself expects arguments of the same
+type that would trigger the same scope).
+
+\comindex{Bind Scope}
+More generally, any {\class} (see chapter \ref{Coercions-full}) can be
+bound to an interpretation scope. The command to do it is
+\begin{quote}
+{\tt Bind Scope} {\scope} \texttt{with} {\class}
+\end{quote}
+
+\Example
+\begin{coq_example}
+Parameter U : Set.
+Bind Scope U_scope with U.
+Parameter Uplus : U -> U -> U.
+Parameter P : forall T:Set, T -> U -> Prop.
+Parameter f : forall T:Set, T -> U.
+Infix "+" := Uplus : U_scope.
+Unset Printing Notations.
+Open Scope nat_scope. (* Define + on the nat as the default for + *)
+Check (fun x y1 y2 z t => P _ (x + t) ((f _ (y1 + y2) + z))).
+\end{coq_example}
+
+\Rem The scope {\tt type\_scope} has also a local effect on
+interpretation. See the next section.
+
+\SeeAlso The command to show the scopes bound to the arguments of a
+function is described in section \ref{About}.
+
+\subsection{The {\tt type\_scope} interpretation scope}
+\index{type\_scope}
+
+The scope {\tt type\_scope} has a special status. It is a primitive
+interpretation scope which is temporarily activated each time a
+subterm of an expression is expected to be a type. This includes goals
+and statements, types of binders, domain and codomain of implication,
+codomain of products, and more generally any type argument of a
+declared or defined constant.
+
+\subsection{Interpretation scopes used in the standard library of {\Coq}}
+
+We give an overview of the scopes used in the standard library of
+{\Coq}. For a complete list of notations in each scope, use the
+commands {\tt Print Scopes} or {\tt Print Scopes {\scope}}.
+
+\subsubsection{\tt type\_scope}
+
+This includes infix {\tt *} for product types and infix {\tt +} for
+sum types. It is delimited by key {\tt type}.
+
+\subsubsection{\tt nat\_scope}
+
+This includes the standard arithmetical operators and relations on
+type {\tt nat}. Positive numerals in this scope are mapped to their
+canonical representent built from {\tt O} and {\tt S}. The scope is
+delimited by key {\tt nat}.
+
+\subsubsection{\tt N\_scope}
+
+This includes the standard arithmetical operators and relations on
+type {\tt N} (binary natural numbers). It is delimited by key {\tt N}
+and comes with an interpretation for numerals as closed term of type {\tt Z}.
+
+\subsubsection{\tt Z\_scope}
+
+This includes the standard arithmetical operators and relations on
+type {\tt Z} (binary integer numbers). It is delimited by key {\tt Z} 
+and comes with an interpretation for numerals as closed term of type {\tt Z}.
+
+\subsubsection{\tt positive\_scope}
+
+This includes the standard arithmetical operators and relations on
+type {\tt positive} (binary strictly positive numbers). It is
+delimited by key {\tt positive} and comes with an interpretation for
+numerals as closed term of type {\tt positive}.
+
+\subsubsection{\tt real\_scope}
+
+This includes the standard arithmetical operators and relations on
+type {\tt R} (axiomatic real numbers). It is delimited by key {\tt R}
+and comes with an interpretation for numerals as term of type {\tt
+R}. The interpretation is based on the binary decomposition.  The
+numeral 2 is represented by $1+1$.  The interpretation $\phi(n)$ of an
+odd positive numerals greater $n$ than 3 is {\tt 1+(1+1)*$\phi((n-1)/2)$}.
+The interpretation $\phi(n)$ of an even positive numerals greater $n$
+than 4 is {\tt (1+1)*$\phi(n/2)$}.  Negative numerals are represented as the
+opposite of the interpretation of their absolute value. E.g. the
+syntactic object {\tt -11} is interpreted as {\tt
+-(1+(1+1)*((1+1)*(1+(1+1))))} where the unit $1$ and all the operations are
+those of {\tt R}.
+
+\subsubsection{\tt bool\_scope}
+
+This includes notations for the boolean operators. It is
+delimited by key {\tt bool}.
+
+\subsubsection{\tt list\_scope}
+
+This includes notations for the list operators. It is
+delimited by key {\tt list}.
+
+\subsubsection{\tt core\_scope}
+
+This includes the notation for pairs. It is delimited by key {\tt core}.
+
+\subsection{Displaying informations about scopes}
+
+\subsubsection{\tt Print Visibility}
+
+This displays the current stack of notations in scopes and lonely
+notations that is used to interpret a notation. The top of the stack
+is displayed last. Notations in scopes whose interpretation is hidden
+by the same notation in a more recently open scope are not
+displayed. Hence each notation is displayed only once.
+
+\variant
+
+{\tt Print Visibility {\scope}}\\
+
+This displays the current stack of notations in scopes and lonely
+notations assuming that {\scope} is pushed on top of the stack.  This
+is useful to know how a subterm locally occurring in the scope of
+{\scope} is interpreted.
+
+\subsubsection{\tt Print Scope {\scope}}
+
+This displays all the notations defined in interpretation scope
+{\scope}.  It also displays the delimiting key if any and the class to
+which the scope is bound, if any.
+
+\subsubsection{\tt Print Scopes}
+
+This displays all the notations, delimiting keys and corresponding
+class of all the existing interpretation scopes.
+It also displays the lonely notations.
+
+\section{Abbreviations}
+\index{Abbreviations}
+\label{Abbreviations}
+\comindex{Notation}
+
+An {\em abbreviation} is a name denoting a (presumably) more complex
+expression. An abbreviation is a special form of notation with no
+parameter and only one symbol which is an identifier. This identifier
+is given with no quotes around. Example:
+
+\begin{coq_eval}
+Require Import List.
+\end{coq_eval}
+\begin{coq_example*}
+Notation List := (list nat).
+\end{coq_example*}
+
+An abbreviation expects no precedence nor associativity, since it can
+always be put at the lower level of atomic expressions, and
+associativity is irrelevant. Abbreviations are used as much as
+possible by the {\Coq} printers unless the modifier
+\verb=(only parsing)= is given.
+
+Abbreviations are bound to an absolute name like for an ordinary
+definition, and can be referred by partially qualified names too.
+
+Abbreviations are syntactic in the sense that they are bound to
+expressions which are not typed at the time of the definition of the
+abbreviation but at the time it is used. Especially, abbreviation can
+be bound to terms with holes (i.e. with ``\_''). The general syntax
+for abbreviations is
+\begin{quote}
+\texttt{Notation} \zeroone{{\tt Local}} {\ident} \texttt{:=} {\term} 
+ \zeroone{{\tt (only parsing)}} \verb=.=
+\end{quote}
+
+\Example
+\begin{coq_eval}
+Set Strict Implicit.
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example}
+Definition explicit_id (A:Set) (a:A) := a.
+Notation id := (explicit_id _).
+Check (id 0).
+\end{coq_example}
+
+Abbreviations do not survive the end of sections. No typing of the denoted
+expression is performed at definition time. Type-checking is done only
+at the time of use of the abbreviation.
+
+\Rem \index{Syntactic Definition} % For
+compatibility Abbreviations are similar to the {\em syntactic
+definitions} available in versions of {\Coq} prior to version 8.0,
+except that abbreviations are used for printing (unless the modifier
+\verb=(only parsing)= is given) while syntactic definitions were not.
+
+\section{Tactic Notations}
+
+Tactic notations allow to customize the syntax of the tactics of the
+tactic language\footnote{Tactic notations are just a simplification of
+the {\tt Grammar tactic simple\_tactic} command that existed in
+versions prior to version 8.0.}. Tactic notations obey the following
+syntax
+
+\begin{tabular}{lcl}
+{\sentence} & ::= & \texttt{Tactic Notation} {\str} \sequence{\proditem}{} \\
+& & \texttt{:= {\tac} .}\\
+{\proditem} & ::= & {\str} $|$ {\tacargtype}{\tt ({\ident})} \\ 
+{\tacargtype} & ::= &
+%{\tt preident} $|$
+{\tt ident} $|$
+{\tt simple\_intropattern} $|$
+{\tt hyp} \\ & $|$ &
+% {\tt quantified\_hypothesis} $|$
+{\tt reference} $|$
+{\tt constr} \\ & $|$ &
+%{\tt castedopenconstr} $|$
+{\tt integer} \\ & $|$ &
+{\tt int\_or\_var} $|$
+{\tt tactic} $|$
+\end{tabular}
+
+A tactic notation {\tt Tactic Notation {\str} {\sequence{\proditem}{}}
+:= {\tac}} extends the parser and pretty-printer of tactics with a
+new rule made of the juxtaposition of the head name of the tactic
+{\str} and the list of its production items (in the syntax of
+production items, {\str} stands for a terminal symbol and {\tt
+\tacargtype({\ident}) for non terminal entries}. It then evaluates
+into the tactic expression {\tac}.
+
+Each type of tactic argument has a specific semantic regarding how it
+is parsed and how it is interpreted. The semantic is described in the
+following table. The last command gives examples of tactics which
+use the corresponding kind of argument.
+
+\medskip
+\noindent
+\begin{tabular}{l|l|l|l}
+Tactic argument type & parsed as & interpreted as & as in tactic \\
+\hline \\
+{\tt\small ident} & identifier & a user-given name & {\tt intro} \\
+{\tt\small simple\_intropattern} & intro\_pattern & an intro\_pattern & {\tt intros}\\
+{\tt\small hyp} & identifier & an hypothesis defined in context & {\tt clear}\\
+%% quantified_hypothesis actually not supported
+%%{\tt\small quantified\_hypothesis} & identifier or integer & a named or non dep. hyp. of the goal & {\tt intros until}\\
+{\tt\small reference} & qualified identifier & a global reference of term & {\tt unfold}\\
+{\tt\small constr} & term & a term & {\tt exact} \\
+%% castedopenconstr actually not supported
+%%{\tt\small castedopenconstr} & term & a term with its sign. of exist. var. & {\tt refine}\\
+{\tt\small integer} & integer & an integer &  \\
+{\tt\small int\_or\_var} & identifier or integer & an integer & {\tt do} \\
+{\tt\small tactic} & tactic & a tactic & \\
+\end{tabular}
+
+\Rem In order to be bound in tactic definitions, each syntactic entry
+for argument type must include the case of simple {\ltac} identifier
+as part of what it parses. This is naturally the case for {\tt ident},
+{\tt simple\_intropattern}, {\tt reference}, {\tt constr}, ... but not
+for {\tt integer}. This is the reason for introducing a special entry
+{\tt int\_or\_var} which evaluates to integers only but which
+syntactically includes identifiers in order to be usable in tactic
+definitions.
+
+% $Id: RefMan-syn.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex
new file mode 100644
index 00000000..72df6005
--- /dev/null
+++ b/doc/refman/RefMan-tac.tex
@@ -0,0 +1,3096 @@
+\chapter{Tactics
+\index{Tactics}
+\label{Tactics}}
+
+A deduction rule is a link between some (unique) formula, that we call
+the {\em conclusion} and (several) formulas that we call the {\em
+premises}. Indeed, a deduction rule can be read in two ways. The first
+one has the shape: {\it ``if I know this and this then I can deduce
+this''}. For instance, if I have a proof of $A$ and a proof of $B$
+then I have a proof of $A \land B$. This is forward reasoning from
+premises to conclusion. The other way says: {\it ``to prove this I
+have to prove this and this''}. For instance, to prove $A \land B$, I
+have to prove $A$ and I have to prove $B$. This is backward reasoning
+which proceeds from conclusion to premises. We say that the conclusion
+is {\em the goal}\index{goal} to prove and premises are {\em the
+subgoals}\index{subgoal}.  The tactics implement {\em backward
+reasoning}. When applied to a goal, a tactic replaces this goal with
+the subgoals it generates. We say that a tactic reduces a goal to its
+subgoal(s).
+
+Each (sub)goal is denoted with a number. The current goal is numbered
+1. By default, a tactic is applied to the current goal, but one can
+address a particular goal in the list by writing {\sl n:\tac} which
+means {\it ``apply tactic {\tac} to goal number {\sl n}''}.
+We can show the list of subgoals by typing {\tt Show} (see
+Section~\ref{Show}). 
+
+Since not every rule applies to a given statement, every tactic cannot be
+used to reduce any goal. In other words, before applying a tactic to a
+given goal, the system checks that some {\em preconditions} are
+satisfied. If it is not the case, the tactic raises an error message.
+
+Tactics are build from atomic tactics and tactic expressions (which
+extends the folklore notion of tactical) to combine those atomic
+tactics. This chapter is devoted to atomic tactics. The tactic
+language will be described in chapter~\ref{TacticLanguage}.
+
+There are, at least, three levels of atomic tactics. The simplest one
+implements basic rules of the logical framework. The second level is
+the one of {\em derived rules} which are built by combination of other
+tactics. The third one implements heuristics or decision procedures to
+build a complete proof of a goal.
+
+\section{Invocation of tactics
+\label{tactic-syntax}
+\index{tactic@{\tac}}}
+
+A tactic is applied as an ordinary command. If the tactic does not
+address the first subgoal, the command may be preceded by the wished
+subgoal number as shown below:
+
+\begin{tabular}{lcl}
+{\commandtac} & ::= & {\num} {\tt :} {\tac} {\tt .}\\
+ & $|$ & {\tac} {\tt .}
+\end{tabular}
+
+\section{Explicit proof as a term}
+
+\subsection{\tt exact \term
+\tacindex{exact}
+\label{exact}}
+
+This tactic applies to any goal. It gives directly the exact proof
+term of the goal. Let {\T} be our goal, let {\tt p} be a term of type
+{\tt U} then {\tt exact p} succeeds iff {\tt T} and {\tt U} are
+convertible (see Section~\ref{conv-rules}).
+
+\begin{ErrMsgs}
+\item \errindex{Not an exact proof}
+\end{ErrMsgs}
+
+
+\subsection{\tt refine \term
+\tacindex{refine}
+\label{refine}
+\index{?@{\texttt{?}}}}
+
+This tactic allows to give an exact proof but still with some
+holes. The holes are noted ``\texttt{\_}''.
+
+\begin{ErrMsgs}
+\item \errindex{invalid argument}: 
+  the tactic \texttt{refine} doesn't know what to do
+  with the term you gave.
+\item \texttt{Refine passed ill-formed term}: the term you gave is not
+  a valid proof (not easy to debug in general).
+  This message may also occur in higher-level tactics, which call 
+  \texttt{refine} internally.
+\item \errindex{Cannot infer a term for this placeholder}
+  there is a hole in the term you gave
+  which type cannot be inferred. Put a cast around it.
+\end{ErrMsgs}
+
+An example of use is given in section~\ref{refine-example}.
+
+\section{Basics
+\index{Typing rules}}
+
+Tactics presented in this section implement the basic typing rules of
+{\sc Cic} given in Chapter~\ref{Cic}.
+
+\subsection{{\tt assumption}
+\tacindex{assumption}}
+
+This tactic applies to any goal. It implements the
+``Var''\index{Typing rules!Var} rule given in
+Section~\ref{Typed-terms}. It looks in the local context for an
+hypothesis which type is equal to the goal.  If it is the case, the
+subgoal is proved. Otherwise, it fails.
+
+\begin{ErrMsgs}
+\item  \errindex{No such assumption}
+\end{ErrMsgs}
+
+\subsection{\tt clear {\ident}
+\tacindex{clear}
+\label{clear}}
+
+This tactic erases the hypothesis named {\ident} in the local context
+of the current goal. Then {\ident} is no more displayed and no more
+usable in the proof development.
+
+\begin{Variants}
+
+\item {\tt clear {\ident$_1$} {\ldots} {\ident$_n$}.}
+  
+  This is equivalent to {\tt clear {\ident$_1$}. {\ldots} clear
+    {\ident$_n$}.}
+  
+\item {\tt clearbody {\ident}.}\tacindex{clearbody}
+  
+  This tactic expects {\ident} to be a local definition then clears
+  its body. Otherwise said, this tactic turns a definition into an
+  assumption.
+
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{{\ident} not found}
+\item \errindexbis{{\ident} is used in the conclusion}{is used in the
+    conclusion} 
+\item \errindexbis{{\ident} is used in the hypothesis {\ident'}}{is
+    used in the hypothesis} 
+\end{ErrMsgs}
+
+\subsection{\tt move {\ident$_1$} after {\ident$_2$}
+\tacindex{move}}
+
+This moves the hypothesis named {\ident$_1$} in the local context
+after the hypothesis named {\ident$_2$}.
+
+If {\ident$_1$} comes before {\ident$_2$} in the order of dependences,
+then all hypotheses between {\ident$_1$} and {\ident$_2$} which
+(possibly indirectly) depend on {\ident$_1$} are moved also.
+
+If {\ident$_1$} comes after {\ident$_2$} in the order of dependences,
+then all hypotheses between {\ident$_1$} and {\ident$_2$} which 
+(possibly indirectly) occur in {\ident$_1$} are moved also.
+
+\begin{ErrMsgs}
+
+\item \errindex{{\ident$_i$} not found}
+
+\item \errindex{Cannot move {\ident$_1$} after {\ident$_2$}:
+                   it occurs in {\ident$_2$}}
+
+\item \errindex{Cannot move {\ident$_1$} after {\ident$_2$}:
+                   it depends on {\ident$_2$}}
+
+\end{ErrMsgs}
+
+\subsection{\tt rename {\ident$_1$} into {\ident$_2$}
+\tacindex{rename}}
+
+This renames hypothesis {\ident$_1$} into {\ident$_2$} in the current
+context\footnote{but it does not rename the hypothesis in the
+  proof-term...}
+
+\begin{ErrMsgs}
+
+\item \errindex{{\ident$_2$} not found}
+
+\item \errindexbis{{\ident$_2$} is already used}{is already used}
+
+\end{ErrMsgs}
+
+\subsection{\tt intro
+\tacindex{intro}
+\label{intro}}
+
+This tactic applies to a goal which is either a product or starts with
+a let binder. If the goal is a product, the tactic implements the
+``Lam''\index{Typing rules!Lam} rule given in
+Section~\ref{Typed-terms}\footnote{Actually, only the second subgoal will be
+generated since the other one can be automatically checked.}.  If the
+goal starts with a let binder then the tactic implements a mix of the
+``Let''\index{Typing rules!Let} and ``Conv''\index{Typing rules!Conv}.
+
+If the current goal is a dependent product {\tt forall $x$:$T$, $U$} (resp {\tt
+let $x$:=$t$ in $U$}) then {\tt intro} puts {\tt $x$:$T$} (resp {\tt $x$:=$t$})
+ in the local context.
+% Obsolete (quantified names already avoid hypotheses names):
+% Otherwise, it puts
+% {\tt x}{\it n}{\tt :T} where {\it n} is such that {\tt x}{\it n} is a
+%fresh name.
+The new subgoal is $U$.
+% If the {\tt x} has been renamed {\tt x}{\it n} then it is replaced 
+% by {\tt x}{\it n} in {\tt U}. 
+
+If the goal is a non dependent product {\tt $T$ -> $U$}, then it puts
+in the local context either {\tt H}{\it n}{\tt :$T$} (if $T$ is of
+type {\tt Set} or {\tt Prop}) or {\tt X}{\it n}{\tt :$T$} (if the type
+of $T$ is {\tt Type}). The optional index {\it n} is such that {\tt
+H}{\it n} or {\tt X}{\it n} is a fresh identifier.
+In both cases the new subgoal is $U$.
+
+If the goal is neither a product nor starting with a let definition,
+the tactic {\tt intro} applies the tactic {\tt red} until the tactic
+{\tt intro} can be applied or the goal is not reducible.
+
+\begin{ErrMsgs}
+\item \errindex{No product even after head-reduction}
+\item \errindexbis{{\ident} is already used}{is already used}
+\end{ErrMsgs}
+
+\begin{Variants}
+
+\item {\tt intros}\tacindex{intros}
+
+  Repeats {\tt intro} until it meets the head-constant. It never reduces
+  head-constants and it never fails.
+
+\item {\tt intro {\ident}}
+
+  Applies {\tt intro} but forces {\ident} to be the name of the
+  introduced hypothesis.
+
+  \ErrMsg \errindex{name {\ident} is already used}
+
+  \Rem If a name used by {\tt intro} hides the base name of a global
+  constant then the latter can still be referred to by a qualified name
+  (see \ref{LongNames}).
+
+\item {\tt intros \ident$_1$ \dots\ \ident$_n$} 
+  
+  Is equivalent to the composed tactic {\tt intro \ident$_1$; \dots\ ;
+    intro \ident$_n$}.
+
+  More generally, the \texttt{intros} tactic takes a pattern as
+  argument in order to introduce names for components of an inductive
+  definition or to clear introduced hypotheses; This is explained
+  in~\ref{intros-pattern}.
+
+\item {\tt intros until {\ident}} \tacindex{intros until}
+  
+  Repeats {\tt intro} until it meets a premise of the goal having form
+  {\tt (} {\ident}~{\tt :}~{\term} {\tt )} and discharges the variable
+  named {\ident} of the current goal.
+
+  \ErrMsg \errindex{No such hypothesis in current goal}
+  
+\item {\tt intros until {\num}}  \tacindex{intros until}
+  
+  Repeats {\tt intro} until the {\num}-th non-dependent premise. For
+  instance, on the subgoal %
+  \verb+forall x y:nat, x=y -> forall z:nat,z=x->z=y+ the
+  tactic \texttt{intros until 2} is equivalent to \texttt{intros x y H
+    z H0} (assuming \texttt{x, y, H, z} and \texttt{H0} do not already
+  occur in context).
+
+  \ErrMsg \errindex{No such hypothesis in current goal}
+
+  Happens when {\num} is 0 or is greater than the number of non-dependent
+  products of the goal.
+
+\item {\tt intro after \ident} \tacindex{intro after}
+
+  Applies {\tt intro} but puts the introduced
+  hypothesis after the hypothesis \ident{} in the hypotheses.
+
+\begin{ErrMsgs}
+\item \errindex{No product even after head-reduction}
+\item \errindex{No such hypothesis} : {\ident}
+\end{ErrMsgs}
+
+\item {\tt intro \ident$_1$ after \ident$_2$}
+  \tacindex{intro ... after}
+  
+  Behaves as previously but \ident$_1$ is the name of the introduced
+  hypothesis.  It is equivalent to {\tt intro \ident$_1$; move
+    \ident$_1$ after \ident$_2$}.
+
+\begin{ErrMsgs}
+\item \errindex{No product even after head-reduction}
+\item \errindex{No such hypothesis} : {\ident}
+\end{ErrMsgs}
+
+\end{Variants}
+
+\subsection{\tt apply \term
+\tacindex{apply}
+\label{apply}}
+
+This tactic applies to any goal.  The argument {\term} is a term
+well-formed in the local context.  The tactic {\tt apply} tries to
+match the current goal against the conclusion of the type of {\term}.
+If it succeeds, then the tactic returns as many subgoals as the number
+of non dependent premises of the type of {\term}.  The tactic {\tt
+apply} relies on first-order pattern-matching with dependent
+types. See {\tt pattern} in section \ref{pattern} to transform a
+second-order pattern-matching problem into a first-order one.
+
+\begin{ErrMsgs}
+\item \errindex{Impossible to unify \dots\ with \dots} 
+
+  The {\tt apply}
+  tactic failed to match the conclusion of {\term} and the current goal.
+  You can help the {\tt apply} tactic by transforming your
+  goal with the {\tt change} or {\tt pattern} tactics (see 
+  sections~\ref{pattern},~\ref{change}).
+
+\item \errindex{generated subgoal {\term'} has metavariables in it}
+
+  This occurs when some instantiations of premises of {\term} are not
+  deducible from the unification. This is the case, for instance, when
+  you want to apply a transitivity property. In this case, you have to
+  use one of the variants below:
+
+\end{ErrMsgs}
+
+\begin{Variants}
+
+\item{\tt apply {\term} with {\term$_1$} \dots\ {\term$_n$}} 
+  \tacindex{apply \dots\ with}
+  
+  Provides {\tt apply} with explicit instantiations for all dependent
+  premises of the type of {\term} which do not occur in the conclusion
+  and consequently cannot be found by unification. Notice that
+  {\term$_1$} \dots\ {\term$_n$} must be given according to the order
+  of these dependent premises of the type of {\term}.
+
+  \ErrMsg \errindex{Not the right number of missing arguments}
+
+\item{\tt apply {\term} with ({\vref$_1$} := {\term$_1$}) \dots\ ({\vref$_n$}
+    := {\term$_n$})} 
+  
+  This also provides {\tt apply} with values for instantiating
+  premises. But variables are referred by names and non dependent
+  products by order (see syntax in Section~\ref{Binding-list}).
+
+\item {\tt eapply \term}\tacindex{eapply}\label{eapply}
+  
+  The tactic {\tt eapply} behaves as {\tt apply} but does not fail
+  when no instantiation are deducible for some variables in the
+  premises.  Rather, it turns these variables into so-called
+  existential variables which are variables still to instantiate. An
+  existential variable is identified by a name of the form {\tt ?$n$}
+  where $n$ is a number.  The instantiation is intended to be found
+  later in the proof.
+
+  An example of use of {\tt eapply} is given in
+  Section~\ref{eapply-example}. 
+
+\item {\tt lapply {\term}} \tacindex{lapply} 
+
+  This tactic applies to any goal, say {\tt G}.  The argument {\term}
+  has to be well-formed in the current context, its type being
+  reducible to a non-dependent product {\tt A -> B} with {\tt B}
+  possibly containing products. Then it generates two subgoals {\tt
+  B->G} and {\tt A}. Applying {\tt lapply H} (where {\tt H} has type
+  {\tt A->B} and {\tt B} does not start with a product) does the same
+  as giving the sequence {\tt cut B. 2:apply H.} where {\tt cut} is
+  described below.
+
+  \Warning When {\term} contains more than one non
+  dependent product the tactic {\tt lapply} only takes into account the
+  first product.
+
+\end{Variants}
+
+\subsection{{\tt set ( {\ident} {\tt :=} {\term} \tt )}
+\label{tactic:set}
+\tacindex{set}
+\tacindex{pose}}
+
+This replaces {\term} by {\ident} in the conclusion or in the
+hypotheses of the current goal and adds the new definition {\ident
+{\tt :=} \term} to the local context. The default is to make this
+replacement only in the conclusion.
+
+\begin{Variants}
+
+\item {\tt set ( } {\ident} {\tt :=} {\term} {\tt ) in *}\\
+  {\tt set ( } {\ident} {\tt :=} {\term} {\tt ) in * |- *}\\
+  
+  This behaves as above but substitutes {\term}
+  everywhere in the goal (both in conclusion and hypotheses).
+
+\item {\tt set ( } {\ident} {\tt :=} {\term} {\tt ) in * |-}
+  
+  This behaves the same but substitutes {\term} in
+  the hypotheses only (not in the conclusion).
+
+\item {\tt set ( } {\ident} {\tt :=} {\term} {\tt ) in |- *}
+  
+  This is equivalent to {\tt set ( } {\ident} {\tt :=} {\term} {\tt
+  )}, i.e. it substitutes {\term} in the conclusion only.
+
+\item {\tt set ( {\ident$_0$} {\tt :=} {\term} {\tt ) in} {\ident$_1$}}
+  
+  This behaves the same but substitutes {\term} only in
+  the hypothesis named {\ident$_1$}.
+  
+\item {\tt set (} {\ident$_0$} {\tt :=} {\term} {\tt ) in}
+    {\ident$_1$} {\tt at} {\num$_1$} \dots\ {\num$_n$}
+
+This notation allows to specify which occurrences of {\term} have to
+be substituted in the hypothesis named {\ident$_1$}. The occurrences
+are numbered from left to right and are meaningful on a pure
+expression using no implicit argument, notation or coercion. A
+negative occurrence number means an occurrence which should not be
+substituted. As an exception of the left-to-right order, the
+occurrences in the {\tt return} subexpression of a {\tt match} are
+considered {\em before} the occurrences in the matched term.
+
+For expressions using notations, or hiding implicit arguments or
+coercions, it is recommended to make explicit all occurrences in 
+order by using {\tt Set Printing All} (see
+section~\ref{SetPrintingAll}).
+
+\item {\tt set ( } {\ident} {\tt :=} {\term} {\tt ) in |- * at}
+      {\num$_1$} \dots\ {\num$_n$}
+  
+This allows to specify which occurrences of the conclusion are concerned.
+
+\item {\tt set (} {\ident$_0$} {\tt :=} {\term} {\tt ) in}
+    {\ident$_1$} {\tt at} {\num$_1^1$} \dots\ {\num$_{n_1}^1$}, \dots
+    {\ident$_m$} {\tt at} {\num$_1^m$} \dots {\num$_{n_m}^m$}
+  
+  It substitutes {\term} at occurrences {\num$_1^i$} \dots\
+  {\num$_{n_i}^i$} of hypothesis {\ident$_i$}. Each {\tt at} part is
+  optional.
+
+\item {\tt set (} {\ident$_0$} {\tt :=} {\term} {\tt ) in}
+    {\ident$_1$} {\tt at} {\num$_1^1$} \dots\ {\num$_{n_1}^1$}, \dots
+    {\ident$_m$} {\tt at} {\num$_1^m$} \dots {\num$_{n_m}^m$}
+    {\tt |- *} {\tt at} {\num$'_1$} \dots\ {\num$'_n$}
+
+  This is the more general form which combines all the previous
+  possibilities.
+
+\item {\tt set } {\term}
+
+  This behaves as {\tt set (} {\ident} := {\term} {\tt )} but {\ident}
+    is generated by {\Coq}. This variant is available for the 
+    forms with {\tt in} too.
+
+\item {\tt pose (  {\ident} {\tt :=} {\term} {\tt )}}
+  
+  This adds the local definition {\ident} := {\term} to the current
+  context without performing any replacement in the goal or in the
+  hypotheses.
+
+\item{\tt pose {\term}}
+  
+  This behaves as {\tt pose (} {\ident} := {\term} {\tt )} but
+  {\ident} is generated by {\Coq}.
+
+\end{Variants}
+
+\subsection{{\tt assert ( {\ident} : {\form} \tt )}
+\tacindex{assert}}
+
+This tactic applies to any goal. {\tt assert (H : U)} adds a new
+hypothesis of name \texttt{H} asserting \texttt{U} to the current goal
+and opens a new subgoal \texttt{U}\footnote{This corresponds to the
+  cut rule of sequent calculus.}. The subgoal {\texttt U} comes first
+in the list of subgoals remaining to prove.
+
+\begin{ErrMsgs}
+\item \errindex{Not a proposition or a type}
+  
+  Arises when the argument {\form} is neither of type {\tt Prop}, {\tt
+    Set} nor {\tt Type}.
+
+\end{ErrMsgs}
+
+\begin{Variants}
+
+\item{\tt assert {\form}}
+  
+  This behaves as {\tt assert (} {\ident} : {\form} {\tt )} but
+  {\ident} is generated by {\Coq}.
+
+\item{\tt assert (} {\ident} := {\term} {\tt )}
+  
+  This behaves as {\tt assert ({\ident} : {\type});[exact
+    {\term}|idtac]} where {\type} is the type of {\term}.
+
+\item {\tt cut {\form}}\tacindex{cut} 
+  
+  This tactic applies to any goal. It implements the non dependent
+  case of the ``App''\index{Typing rules!App} rule given in
+  Section~\ref{Typed-terms}. (This is Modus Ponens inference rule.)
+  {\tt cut U} transforms the current goal \texttt{T} into the two
+  following subgoals: {\tt U -> T} and \texttt{U}.  The subgoal {\tt U
+    -> T} comes first in the list of remaining subgoal to prove.
+
+\end{Variants}
+
+% PAS CLAIR;
+% DEVRAIT AU MOINS FAIRE UN INTRO;
+% DEVRAIT ETRE REMPLACE PAR UN LET;
+% MESSAGE D'ERREUR STUPIDE
+% POURQUOI Specialize trans_equal ECHOUE ?
+%\begin{Variants}
+%\item {\tt Specialize \term} 
+%   \tacindex{Specialize} \\
+%   The argument {\tt t} should be a well-typed
+%   term of type {\tt T}.  This tactics is to make a cut of a
+%   proposition when you have already the proof of this proposition
+%   (for example it is a theorem applied to variables of local
+%   context). It is equivalent to {\tt Assert T. exact t}.
+%
+%\item {\tt Specialize {\term} with \vref$_1$ := {\term$_1$} \dots
+%    \vref$_n$ := \term$_n$}
+%  \tacindex{Specialize \dots\ with} \\ 
+%  It is to provide the tactic with some explicit values to instantiate
+%  premises of {\term} (see section \ref{Binding-list}).
+%  Some other premises are inferred using type information and
+%  unification. The resulting well-formed 
+%  term being {\tt (\term~\term'$_1$\dots\term'$_k$)}
+%  this tactic behaves as is used as 
+%  {\tt Specialize (\term~\term'$_1$\dots\term'$_k$)} \\ 
+%
+%  \ErrMsg {\tt Metavariable wasn't in the metamap} \\ 
+%  Arises when the information provided in the bindings list is not
+%  sufficient.
+%\item {\tt Specialize {\num} {\term} with \vref$_1$ := {\term$_1$} \dots\ 
+% \vref$_n$:= \term$_n$}\\ 
+%  The behavior is the same as before but only \num\ premises of 
+%  \term\ will be kept.
+%\end{Variants}
+
+\subsection{\tt generalize \term
+\tacindex{generalize}
+\label{generalize}}
+
+This tactic applies to any goal. It generalizes the conclusion w.r.t.
+one subterm of it. For example:
+
+\begin{coq_eval}
+Goal forall x y:nat, (0 <= x + y + y).
+intros.
+\end{coq_eval}
+\begin{coq_example}
+Show.
+generalize (x + y + y).
+\end{coq_example}
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+If the goal is $G$ and $t$ is a subterm of type $T$ in the goal, then
+{\tt generalize} \textit{t} replaces the goal by {\tt forall (x:$T$), $G'$}
+where $G'$ is obtained from $G$ by replacing all occurrences of $t$ by
+{\tt x}. The name of the variable (here {\tt n}) is chosen accordingly
+to $T$.
+
+\begin{Variants}
+\item {\tt generalize \term$_1$ \dots\ \term$_n$} 
+  
+  Is equivalent to {\tt generalize \term$_n$; \dots\ ; generalize
+    \term$_1$}. Note that the sequence of \term$_i$'s are processed
+  from $n$ to $1$.
+  
+\item {\tt generalize dependent \term} \tacindex{generalize dependent}
+  
+  This generalizes {\term} but also {\em all} hypotheses which depend
+  on {\term}. It clears the generalized hypotheses.
+
+\end{Variants}
+
+\subsection{\tt change \term
+\tacindex{change}
+\label{change}}
+
+This tactic applies to any goal. It implements the rule
+``Conv''\index{Typing rules!Conv} given in section~\ref{Conv}.  {\tt
+  change U} replaces the current goal \T\ with \U\ providing that
+\U\ is well-formed and that \T\ and \U\ are convertible.
+
+\begin{ErrMsgs}
+\item \errindex{Not convertible}
+\end{ErrMsgs}
+
+\tacindex{change \dots\ in}
+\begin{Variants}
+\item {\tt change \term$_1$ with \term$_2$} 
+  
+  This replaces the occurrences of \term$_1$ by \term$_2$ in the
+  current goal.  The terms \term$_1$ and \term$_2$ must be
+  convertible.
+
+\item {\tt change \term$_1$ at \num$_1$ \dots\ \num$_i$ with \term$_2$} 
+  
+  This replaces the occurrences numbered \num$_1$ \dots\ \num$_i$ of
+  \term$_1$ by \term$_2$ in the current goal.
+  The terms \term$_1$ and \term$_2$ must be convertible.
+
+  \ErrMsg {\tt Too few occurrences}
+
+\item {\tt change {\term} in {\ident}}
+
+\item {\tt change \term$_1$ with \term$_2$ in {\ident}}
+  
+\item {\tt change \term$_1$ at  \num$_1$ \dots\ \num$_i$ with \term$_2$ in
+    {\ident}}
+  
+  This applies the {\tt change} tactic not to the goal but to the
+  hypothesis {\ident}.
+
+\end{Variants}
+
+\SeeAlso \ref{Conversion-tactics}
+
+\subsection{Bindings list
+\index{Binding list}
+\label{Binding-list}}
+
+A bindings list is generally used after the keyword {\tt with} in
+tactics.  The general shape of a bindings list is {\tt (\vref$_1$ :=
+  \term$_1$) \dots\ (\vref$_n$ := \term$_n$)} where {\vref} is either an
+{\ident} or a {\num}. It is used to provide a tactic with a list of
+values (\term$_1$, \dots, \term$_n$) that have to be substituted
+respectively to \vref$_1$, \dots, \vref$_n$. For all $i \in [1\dots\ 
+n]$, if \vref$_i$ is \ident$_i$ then it references the dependent
+product {\tt \ident$_i$:T} (for some type \T); if \vref$_i$ is
+\num$_i$ then it references the \num$_i$-th non dependent premise.
+
+A bindings list can also be a simple list of terms {\tt \term$_1$
+  \term$_2$ \dots\term$_n$}. In that case the references to which
+these terms correspond are determined by the tactic. In case of {\tt
+  elim} (see section~\ref{elim}) the terms should correspond to
+all the dependent products in the type of \term\ while in the case of
+{\tt apply} only the dependent products which are not bound in
+the conclusion of the type are given.
+
+
+\section{Negation and contradiction}
+
+\subsection{\tt absurd \term
+\tacindex{absurd}
+\label{absurd}}
+
+This tactic applies to any goal. The argument {\term} is any
+proposition {\tt P} of type {\tt Prop}. This tactic applies {\tt
+  False} elimination, that is it deduces the current goal from {\tt
+  False}, and generates as subgoals {\tt $\sim$P} and {\tt P}. It is
+very useful in proofs by cases, where some cases are impossible. In
+most cases, \texttt{P} or $\sim$\texttt{P} is one of the hypotheses of
+the local context.
+
+\subsection{\tt contradiction
+\label{contradiction}
+\tacindex{contradiction}}
+
+This tactic applies to any goal. The {\tt contradiction} tactic
+attempts to find in the current context (after all {\tt intros}) one
+which is equivalent to {\tt False}. It permits to prune irrelevant
+cases.  This tactic is a macro for the tactics sequence {\tt intros;
+  elimtype False; assumption}.
+
+\begin{ErrMsgs}
+\item \errindex{No such assumption}
+\end{ErrMsgs}
+
+
+\section{Conversion tactics
+\index{Conversion tactics}
+\label{Conversion-tactics}}
+
+This set of tactics implements different specialized usages of the
+tactic \texttt{change}.
+
+All conversion tactics (including \texttt{change}) can be
+parameterized by the parts of the goal where the conversion can
+occur. The specification of such parts are called \emph{clauses}. It
+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.
+
+The syntax and description of the various clauses follows:
+\begin{description}
+\item[\texttt{in H$_1$ $\ldots$ H$_n$ |- }] only in hypotheses $H_1
+  $\ldots$ H_n$
+\item[\texttt{in H$_1$ $\ldots$ H$_n$ |- *}] in hypotheses $H_1 \ldots
+  H_n$ and in the conclusion
+\item[\texttt{in * |-}] in every hypothesis
+\item[\texttt{in *}] (equivalent to \texttt{in * |- *}) everywhere
+\item[\texttt{in (type of H$_1$) (value of H$_2$) $\ldots$ |-}] in
+  type part of $H_1$, in the value part of $H_2$, etc. 
+\end{description}
+
+For backward compatibility, the notation \texttt{in}~$H_1\ldots H_n$
+performs the conversion in hypotheses $H_1\ldots H_n$.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%voir reduction__conv_x : histoires d'univers.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\subsection{{\tt cbv \flag$_1$ \dots\ \flag$_n$}, {\tt lazy \flag$_1$
+\dots\ \flag$_n$} and {\tt compute}
+\tacindex{cbv}
+\tacindex{lazy}
+\tacindex{compute}}
+
+These parameterized reduction tactics apply to any goal and perform
+the normalization of the goal according to the specified flags. Since
+the reduction considered in \Coq\ include $\beta$ (reduction of
+functional application), $\delta$ (unfolding of transparent constants,
+see \ref{Transparent}), $\iota$ (reduction of {\tt Cases}, {\tt Fix}
+and {\tt CoFix} expressions) and $\zeta$ (removal of local
+definitions), every flag is one of {\tt beta}, {\tt delta}, {\tt
+  iota}, {\tt zeta}, {\tt [\qualid$_1$\ldots\qualid$_k$]} and {\tt
+  -[\qualid$_1$\ldots\qualid$_k$]}.  The last two flags give the list
+of constants to unfold, or the list of constants not to unfold. These
+two flags can occur only after the {\tt delta} flag. 
+If alone (i.e. not
+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. 
+
+The goal may be normalized with two strategies: {\em lazy} ({\tt lazy}
+tactic), or {\em call-by-value} ({\tt cbv} tactic). The lazy strategy
+is a call-by-need strategy, with sharing of reductions: the arguments of a
+function call are partially evaluated only when necessary, but if an
+argument is used several times, it is computed only once. This
+reduction is efficient for reducing expressions with dead code. For
+instance, the proofs of a proposition $\exists_T ~x. P(x)$ reduce to a
+pair of a witness $t$, and a proof that $t$ verifies the predicate
+$P$. Most of the time, $t$ may be computed without computing the proof
+of $P(t)$, thanks to the lazy strategy.
+
+The call-by-value strategy is the one used in ML languages: the
+arguments of a function call are evaluated first, using a weak
+reduction (no reduction under the $\lambda$-abstractions). Despite the
+lazy strategy always performs fewer reductions than the call-by-value
+strategy, the latter should be preferred for evaluating purely
+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}.
+\end{Variants}
+
+\begin{ErrMsgs}
+\item \errindex{Delta must be specified before}
+  
+  A list of constants appeared before the {\tt delta} flag.
+\end{ErrMsgs}
+
+
+\subsection{{\tt red}
+\tacindex{red}}
+
+This tactic applies to a goal which has the form {\tt
+  forall (x:T1)\dots(xk:Tk), c t1 \dots\ tn} where {\tt c} is a constant.  If
+{\tt c} is transparent then it replaces {\tt c} with its definition
+(say {\tt t}) and then reduces {\tt (t t1 \dots\ tn)} according to
+$\beta\iota\zeta$-reduction rules.
+
+\begin{ErrMsgs}
+\item \errindex{Not reducible}
+\end{ErrMsgs}
+
+\subsection{{\tt hnf}
+\tacindex{hnf}}
+
+This tactic applies to any goal. It replaces the current goal with its
+head normal form according to the $\beta\delta\iota\zeta$-reduction rules.
+{\tt hnf} does not produce a real head normal form but either a
+product or an applicative term in head normal form or a variable.
+
+\Example
+The term \verb+forall n:nat, (plus (S n) (S n))+ is not reduced by {\tt hnf}.
+
+\Rem The $\delta$ rule only applies to transparent constants
+(see section~\ref{Opaque} on transparency and opacity).
+
+\subsection{\tt simpl
+\tacindex{simpl}}
+
+This tactic applies to any goal. The tactic {\tt simpl} first applies
+$\beta\iota$-reduction rule.  Then it expands transparent constants
+and tries to reduce {\tt T'} according, once more, to $\beta\iota$
+rules. But when the $\iota$ rule is not applicable then possible
+$\delta$-reductions are not applied.  For instance trying to use {\tt
+  simpl} on {\tt (plus n O)=n} does change nothing.
+
+\tacindex{simpl \dots\ in}
+\begin{Variants}
+\item {\tt simpl {\term}}
+  
+  This applies {\tt simpl} only to the occurrences of {\term} in the
+  current goal.
+
+\item {\tt simpl {\term} at \num$_1$ \dots\ \num$_i$}
+  
+  This applies {\tt simpl} only to the \num$_1$, \dots, \num$_i$
+  occurrences of {\term} in the current goal.
+
+  \ErrMsg {\tt Too few occurrences}
+
+\item {\tt simpl {\ident}}
+  
+  This applies {\tt simpl} only to the applicative subterms whose head
+  occurrence is {\ident}.
+
+\item {\tt simpl {\ident} at \num$_1$ \dots\ \num$_i$}
+  
+  This applies {\tt simpl} only to the \num$_1$, \dots, \num$_i$
+applicative subterms whose head occurrence is {\ident}.
+
+\end{Variants}
+
+\subsection{\tt unfold \qualid
+\tacindex{unfold}
+\label{unfold}}
+
+This tactic applies to any goal. The argument {\qualid} must denote a
+defined transparent constant or local definition (see Sections~\ref{Simpl-definitions} and~\ref{Transparent}).  The tactic {\tt
+  unfold} applies the $\delta$ rule to each occurrence of the constant
+to which {\qualid} refers in the current goal and then replaces it
+with its $\beta\iota$-normal form.
+
+\begin{ErrMsgs}
+\item {\qualid} \errindex{does not denote an evaluable constant}
+
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt unfold {\qualid}$_1$, \dots, \qualid$_n$}
+  \tacindex{unfold \dots\ in}
+  
+  Replaces {\em simultaneously} {\qualid}$_1$, \dots, {\qualid}$_n$
+  with their definitions and replaces the current goal with its
+  $\beta\iota$ normal form.
+
+\item {\tt unfold {\qualid}$_1$ at \num$_1^1$, \dots, \num$_i^1$,
+\dots,\ \qualid$_n$ at \num$_1^n$ \dots\ \num$_j^n$}
+  
+  The lists \num$_1^1$, \dots, \num$_i^1$ and \num$_1^n$, \dots,
+  \num$_j^n$ specify the occurrences of {\qualid}$_1$, \dots,
+  \qualid$_n$ to be unfolded. Occurrences are located from left to
+  right.
+
+  \ErrMsg {\tt bad occurrence number of {\qualid}$_i$}
+
+  \ErrMsg {\qualid}$_i$ {\tt does not occur}
+
+\end{Variants}
+
+\subsection{{\tt fold} \term
+\tacindex{fold}}
+
+This tactic applies to any goal. The term \term\ is reduced using the {\tt red}
+tactic. Every occurrence of the resulting term in the goal is then
+substituted for \term.
+
+\begin{Variants}
+\item {\tt fold} \term$_1$ \dots\ \term$_n$ 
+  
+  Equivalent to {\tt fold} \term$_1${\tt;}\ldots{\tt; fold} \term$_n$.
+\end{Variants}
+
+\subsection{{\tt pattern {\term}}
+\tacindex{pattern}
+\label{pattern}}
+
+This command applies to any goal. The argument {\term} must be a free
+subterm of the current goal.  The command {\tt pattern} performs
+$\beta$-expansion (the inverse of $\bt$-reduction) of the current goal
+(say \T) by
+\begin{enumerate}
+\item replacing all occurrences of {\term} in {\T} with a fresh variable
+\item abstracting this variable
+\item applying the abstracted goal to {\term}
+\end{enumerate}
+
+For instance, if the current goal $T$ is expressible has $\phi(t)$
+where the notation captures all the instances of $t$ in $\phi(t)$,
+then {\tt pattern $t$} transforms it into {\tt (fun x:$A$ => $\phi(${\tt
+x}$)$) $t$}.  This command can be used, for instance, when the tactic
+{\tt apply} fails on matching.
+
+\begin{Variants}
+\item {\tt pattern {\term} at {\num$_1$} \dots\ {\num$_n$}}
+  
+  Only the occurrences {\num$_1$} \dots\ {\num$_n$} of {\term} will be
+  considered for $\beta$-expansion. Occurrences are located from left
+  to right.
+
+\item {\tt pattern {\term$_1$}, \dots, {\term$_m$}}
+  
+  Starting from a goal $\phi(t_1 \dots\ t_m)$, the tactic
+   {\tt pattern $t_1$, \dots,\ $t_m$} generates the equivalent goal {\tt
+   (fun (x$_1$:$A_1$) \dots\ (x$_m$:$A_m$) => $\phi(${\tt x$_1$\dots\
+   x$_m$}$)$) $t_1$ \dots\ $t_m$}.\\ If $t_i$ occurs in one of the
+   generated types $A_j$ these occurrences will also be considered and
+   possibly abstracted.
+
+\item {\tt pattern {\term$_1$} at {\num$_1^1$} \dots\ {\num$_{n_1}^1$}, \dots,
+    {\term$_m$} at {\num$_1^m$} \dots\ {\num$_{n_m}^m$}}
+  
+  This behaves as above but processing only the occurrences \num$_1^1$,
+  \dots, \num$_i^1$ of \term$_1$, \dots, \num$_1^m$, \dots, \num$_j^m$
+  of \term$_m$ starting from \term$_m$.
+
+\end{Variants}
+
+\subsection{Conversion tactics applied to hypotheses}
+
+{\convtactic} {\tt in} \ident$_1$ \dots\ \ident$_n$ 
+
+Applies the conversion tactic {\convtactic} to the
+hypotheses \ident$_1$, \ldots, \ident$_n$. The tactic {\convtactic} is
+any of the conversion tactics listed in this section. 
+
+If \ident$_i$ is a local definition, then \ident$_i$ can be replaced
+by (Type of \ident$_i$) to address not the body but the type of the
+local definition. Example: {\tt unfold not in (Type of H1) (Type of H3).}
+
+\begin{ErrMsgs}
+\item \errindex{No such hypothesis} : {\ident}.
+\end{ErrMsgs}
+
+
+\section{Introductions}
+
+Introduction tactics address goals which are inductive constants.
+They are used when one guesses that the goal can be obtained with one
+of its constructors' type.
+
+\subsection{\tt constructor \num
+\label{constructor}
+\tacindex{constructor}}
+
+This tactic applies to a goal such that the head of its conclusion is
+an inductive constant (say {\tt I}).  The argument {\num} must be less
+or equal to the numbers of constructor(s) of {\tt I}. Let {\tt ci} be
+the {\tt i}-th constructor of {\tt I}, then {\tt constructor i} is
+equivalent to {\tt intros; apply ci}.
+
+\begin{ErrMsgs}
+\item \errindex{Not an inductive product}
+\item \errindex{Not enough constructors}
+\end{ErrMsgs}
+
+\begin{Variants}
+\item \texttt{constructor} 
+  
+  This tries \texttt{constructor 1} then \texttt{constructor 2},
+  \dots\ , then \texttt{constructor} \textit{n} where \textit{n} if
+  the number of constructors of the head of the goal.
+
+\item {\tt constructor \num~with} {\bindinglist}
+  \tacindex{constructor \dots\  with}
+  
+  Let {\tt ci} be the {\tt i}-th constructor of {\tt I}, then {\tt
+    constructor i with \bindinglist} is equivalent to {\tt intros;
+    apply ci with \bindinglist}.
+
+  \Warning the terms in the \bindinglist\ are checked
+  in the context where {\tt constructor} is executed and not in the
+  context where {\tt apply} is executed (the introductions are not
+  taken into account).
+
+\item {\tt split}\tacindex{split}
+
+  Applies if {\tt I} has only one constructor, typically in the case
+  of conjunction $A\land B$. Then, it is equivalent to {\tt constructor 1}.
+
+\item {\tt exists {\bindinglist}}\tacindex{exists} 
+
+  Applies if {\tt I} has only one constructor, for instance in the
+  case of existential quantification $\exists x\cdot P(x)$. 
+  Then, it is equivalent to {\tt intros; constructor 1 with \bindinglist}.
+
+\item {\tt left}\tacindex{left},  {\tt right}\tacindex{right}
+
+  Apply if {\tt I} has two constructors, for instance in the case of
+  disjunction $A\lor B$. Then, they are respectively equivalent to {\tt
+    constructor 1} and {\tt constructor 2}.
+  
+\item {\tt left \bindinglist}, {\tt right \bindinglist}, {\tt split
+    \bindinglist}
+  
+  As soon as the inductive type has the right number of constructors,
+    these expressions are equivalent to the corresponding {\tt
+    constructor $i$ with \bindinglist}.
+
+\end{Variants}
+
+\section{Eliminations (Induction and Case Analysis)}
+
+Elimination tactics are useful to prove statements by induction or
+case analysis.  Indeed, they make use of the elimination (or
+induction) principles generated with inductive definitions (see
+Section~\ref{Cic-inductive-definitions}).
+
+\subsection{\tt induction \term
+\tacindex{induction}}
+
+This tactic applies to any goal. The type of the argument {\term} must
+be an inductive constant. Then, the tactic {\tt induction}
+generates subgoals, one for each possible form of {\term}, i.e. one
+for each constructor of the inductive type.
+
+The tactic {\tt induction} automatically replaces every occurrences
+of {\term} in the conclusion and the hypotheses of the goal.  It
+automatically adds induction hypotheses (using names of the form {\tt
+  IHn1}) to the local context. If some hypothesis must not be taken
+into account in the induction hypothesis, then it needs to be removed
+first (you can also use the tactics {\tt elim} or {\tt simple induction},
+see below).
+
+There are particular cases:
+
+\begin{itemize}
+
+\item If {\term} is an identifier {\ident} denoting a quantified
+variable of the conclusion of the goal, then {\tt induction {\ident}}
+behaves as {\tt intros until {\ident}; induction {\ident}}
+
+\item If {\term} is a {\num}, then {\tt induction {\num}} behaves as
+{\tt intros until {\num}} followed by {\tt induction} applied to the
+last introduced hypothesis.
+
+\Rem For simple induction on a numeral, use syntax {\tt induction
+({\num})} (not very interesting anyway).
+
+\end{itemize}
+
+\Example
+
+\begin{coq_example}
+Lemma induction_test : forall n:nat, n = n -> n <= n.
+intros n H.
+induction n.
+\end{coq_example}
+
+\begin{ErrMsgs}
+\item \errindex{Not an inductive product}
+\item \errindex{Cannot refine to conclusions with meta-variables}
+  
+  As {\tt induction} uses {\tt apply}, see Section~\ref{apply} and
+  the variant {\tt elim \dots\ with \dots} below.
+\end{ErrMsgs}
+
+\begin{Variants}
+\item{\tt induction {\term} as {\intropattern}}
+  
+  This behaves as {\tt induction {\term}} but uses the names in
+  {\intropattern} to names the variables introduced in the context.
+  The {\intropattern} must have the form {\tt [} $p_{11}$ \ldots
+  $p_{1n_1}$ {\tt |} {\ldots} {\tt |} $p_{m1}$ \ldots $p_{mn_m}$ {\tt
+    ]} with $m$ being the number of constructors of the type of
+  {\term}. Each variable introduced by {\tt induction} in the context
+  of the $i^{th}$ goal gets its name from the list $p_{i1}$ \ldots
+  $p_{in_i}$ in order. If there are not enough names, {\tt induction}
+  invents names for the remaining variables to introduce. More
+  generally, the $p$'s can be any introduction patterns (see
+  Section~\ref{intros-pattern}). This provides a concise notation for
+  nested induction.
+
+\Rem for an inductive type with one constructor, the pattern notation
+{\tt ($p_{1}$,\ldots,$p_{n}$)} can be used instead of
+{\tt [} $p_{1}$ \ldots $p_{n}$ {\tt ]}.
+
+\item {\tt induction {\term} using {\qualid}}
+
+  This behaves as {\tt induction {\term}} but using the induction
+scheme of name {\qualid}. It does not expect that the type of
+{\term} is inductive.
+
+\item {\tt induction {\term} using {\qualid} as {\intropattern}}
+
+  This combines {\tt induction {\term} using {\qualid}}
+and {\tt induction {\term} as {\intropattern}}.
+
+\item {\tt elim \term}\label{elim}
+  
+  This is a more basic induction tactic.  Again, the type of the
+  argument {\term} must be an inductive constant. Then according to
+  the type of the goal, the tactic {\tt elim} chooses the right
+  destructor and applies it (as in the case of the {\tt apply}
+  tactic). For instance, assume that our proof context contains {\tt
+    n:nat}, assume that our current goal is {\tt T} of type {\tt
+    Prop}, then {\tt elim n} is equivalent to {\tt apply nat\_ind with
+    (n:=n)}.  The tactic {\tt elim} does not affect the hypotheses of
+  the goal, neither introduces the induction loading into the context
+  of hypotheses.
+
+\item {\tt elim \term} 
+  
+  also works when the type of {\term} starts with products and the
+  head symbol is an inductive definition. In that case the tactic
+  tries both to find an object in the inductive definition and to use
+  this inductive definition for elimination.  In case of non-dependent
+  products in the type, subgoals are generated corresponding to the
+  hypotheses. In the case of dependent products, the tactic will try
+  to find an instance for which the elimination lemma applies.
+
+\item {\tt elim {\term} with \term$_1$ \dots\ \term$_n$}
+  \tacindex{elim \dots\ with} \
+  
+  Allows the user to give explicitly the values for dependent
+  premises of the elimination schema. All arguments must be given.
+
+  \ErrMsg \errindex{Not the right number of dependent arguments}
+
+\item{\tt elim {\term} with {\vref$_1$} := {\term$_1$} \dots\ {\vref$_n$}
+    := {\term$_n$}} 
+  
+  Provides also {\tt elim} with values for instantiating premises by
+  associating explicitly variables (or non dependent products) with
+  their intended instance.
+
+\item{\tt elim {\term$_1$} using {\term$_2$}}
+\tacindex{elim \dots\ using} 
+
+Allows the user to give explicitly an elimination predicate
+{\term$_2$} which is not the standard one for the underlying inductive
+type of {\term$_1$}. Each of the {\term$_1$} and {\term$_2$} is either
+a simple term or a term with a bindings list (see \ref{Binding-list}).
+
+\item {\tt elimtype \form}\tacindex{elimtype}
+  
+  The argument {\form} must be inductively defined. {\tt elimtype I}
+  is equivalent to {\tt cut I. intro H{\rm\sl n}; elim H{\rm\sl n};
+    clear H{\rm\sl n}}. Therefore the hypothesis {\tt H{\rm\sl n}} will
+  not appear in the context(s) of the subgoal(s).  Conversely, if {\tt
+    t} is a term of (inductive) type {\tt I} and which does not occur
+  in the goal then {\tt elim t} is equivalent to {\tt elimtype I; 2:
+    exact t.}
+
+  \ErrMsg \errindex{Impossible to unify \dots\ with \dots} 
+  
+  Arises when {\form} needs to be applied to parameters.
+
+\item {\tt simple induction \ident}\tacindex{simple induction}
+  
+  This tactic behaves as {\tt intros until
+    {\ident}; elim {\tt {\ident}}} when {\ident} is a quantified
+  variable of the goal.
+
+\item {\tt simple induction {\num}}
+  
+  This tactic behaves as {\tt intros until
+    {\num}; elim {\tt {\ident}}} where {\ident} is the name given by
+  {\tt intros until {\num}} to the {\num}-th non-dependent premise of
+  the goal.
+
+%% \item {\tt simple induction {\term}}\tacindex{simple induction}
+  
+%%   If {\term} is an {\ident} corresponding to a quantified variable of
+%%   the goal then the tactic behaves as {\tt intros until {\ident}; elim
+%%   {\tt {\ident}}}.  If {\term} is a {\num} then the tactic behaves as
+%%   {\tt intros until {\ident}; elim {\tt {\ident}}}.  Otherwise, it is
+%%   a synonym for {\tt elim {\term}}.
+
+%%   \Rem For simple induction on a numeral, use syntax {\tt simple
+%%   induction ({\num})}.
+
+\end{Variants}
+
+\subsection{\tt destruct \term
+\tacindex{destruct}}
+
+The tactic {\tt destruct} is used to perform case analysis without
+recursion. Its behavior is similar to {\tt induction} except
+that no induction hypothesis is generated.  It applies to any goal and
+the type of {\term} must be inductively defined. There are particular cases:
+
+\begin{itemize}
+
+\item If {\term} is an identifier {\ident} denoting a quantified
+variable of the conclusion of the goal, then {\tt destruct {\ident}}
+behaves as {\tt intros until {\ident}; destruct {\ident}}
+
+\item If {\term} is a {\num}, then {\tt destruct {\num}} behaves as
+{\tt intros until {\num}} followed by {\tt destruct} applied to the
+last introduced hypothesis.
+
+\Rem For destruction of a numeral, use syntax {\tt destruct
+({\num})} (not very interesting anyway).
+
+\end{itemize}
+
+\begin{Variants}
+\item{\tt destruct {\term} as {\intropattern}}
+  
+  This behaves as {\tt destruct {\term}} but uses the names in
+  {\intropattern} to names the variables introduced in the context.
+  The {\intropattern} must have the form {\tt [} $p_{11}$ \ldots
+  $p_{1n_1}$ {\tt |} {\ldots} {\tt |} $p_{m1}$ \ldots $p_{mn_m}$ {\tt
+    ]} with $m$ being the number of constructors of the type of
+  {\term}. Each variable introduced by {\tt destruct} in the context
+  of the $i^{th}$ goal gets its name from the list $p_{i1}$ \ldots
+  $p_{in_i}$ in order. If there are not enough names, {\tt destruct}
+  invents names for the remaining variables to introduce. More
+  generally, the $p$'s can be any introduction patterns (see
+  Section~\ref{intros-pattern}). This provides a concise notation for
+  nested destruction.
+
+%  It is recommended to use this variant of {\tt destruct} for 
+%  robust proof scripts.
+
+\Rem for an inductive type with one constructor, the pattern notation
+{\tt ($p_{1}$,\ldots,$p_{n}$)} can be used instead of
+{\tt [} $p_{1} $\ldots $p_{n}$ {\tt ]}.
+
+\item{\tt destruct {\term} using {\qualid}}
+
+  This is a synonym of {\tt induction {\term} using {\qualid}}.
+
+\item{\tt destruct {\term} as {\intropattern} using {\qualid}}
+
+  This is a synonym of {\tt induction {\term} using {\qualid} as
+  {\intropattern}}.
+
+\item{\tt case \term}\label{case}\tacindex{case}
+  
+  The tactic {\tt case} is a more basic tactic to perform case
+  analysis without recursion. It behaves as {\tt elim \term} but using
+  a case-analysis elimination principle and not a recursive one.
+
+\item {\tt case {\term} with \term$_1$ \dots\ \term$_n$}
+  \tacindex{case \dots\ with}
+
+  Analogous to {\tt elim \dots\ with} above.
+
+\item {\tt simple destruct \ident}\tacindex{simple destruct}
+  
+  This tactic behaves as {\tt intros until
+    {\ident}; case {\tt {\ident}}} when {\ident} is a quantified
+  variable of the goal.
+
+\item {\tt simple destruct {\num}}
+  
+  This tactic behaves as {\tt intros until
+    {\num}; case {\tt {\ident}}} where {\ident} is the name given by
+  {\tt intros until {\num}} to the {\num}-th non-dependent premise of
+  the goal.
+
+\end{Variants}
+
+\subsection{\tt intros {\intropattern} {\ldots} {\intropattern}
+\label{intros-pattern}
+\tacindex{intros \intropattern}}
+
+The tactic {\tt intros} applied to introduction patterns performs both
+introduction of variables and case analysis in order to give names to
+components of an hypothesis.
+
+An introduction pattern is either:
+\begin{itemize}
+\item the wildcard: {\tt \_}
+\item a variable
+\item a disjunction of lists of patterns:
+  {\tt [$p_{11}$ {\ldots} $p_{1m_1}$ | {\ldots} | $p_{11}$ {\ldots} $p_{nm_n}$]}
+\item a conjunction of patterns: {\tt (} $p_1$ {\tt ,} {\ldots} {\tt ,} $p_n$ {\tt )}
+\end{itemize}
+
+The behavior of \texttt{intros} is defined inductively over the
+structure of the pattern given as argument:
+\begin{itemize}
+\item introduction on the wildcard do the introduction and then
+  immediately clear (cf~\ref{clear}) the corresponding hypothesis;
+\item introduction on a variable behaves like described in~\ref{intro}; 
+\item introduction over a
+list of patterns $p_1~\ldots~p_n$ is equivalent to the sequence of
+introductions over the patterns namely:
+\texttt{intros $p_1$;\ldots; intros $p_n$}, the goal should start with
+at least $n$ products;
+\item introduction over a
+disjunction of list of patterns
+{\tt [$p_{11}$ {\ldots} $p_{1m_1}$ | {\ldots} | $p_{11}$ {\ldots} $p_{nm_n}$]}. It introduces a new variable $X$, its type should be an inductive
+definition with $n$
+constructors, then it performs a case analysis over $X$ 
+(which generates $n$ subgoals), it 
+clears $X$ and performs on each generated subgoals the corresponding
+\texttt{intros}~$p_{i1}$ {\ldots} $p_{im_i}$ tactic;
+\item introduction over a 
+conjunction  of patterns $(p_1,\ldots,p_n)$, it
+introduces a new variable $X$, its type should be an inductive 
+definition with $1$
+constructor with (at least) $n$ arguments, then it performs a case 
+analysis over $X$ 
+(which generates $1$ subgoal with at least $n$ products), it 
+clears $X$ and performs an introduction over the list of patterns $p_1~\ldots~p_n$.
+\end{itemize}
+
+\Rem The pattern {\tt ($p_1$, {\ldots}, $p_n$)}
+is a synonym for the pattern {\tt [$p_1$ {\ldots} $p_n$]}, i.e. it
+corresponds to the decomposition of an hypothesis typed by an
+inductive type with a single constructor.
+
+\begin{coq_example}
+Lemma intros_test : forall A B C:Prop, A \/ B /\ C -> (A -> C) -> C.
+intros A B C [a| [_ c]] f.
+apply (f a).
+Proof c.
+\end{coq_example}
+
+%\subsection{\tt FixPoint \dots}\tacindex{Fixpoint}
+%Not yet documented.
+
+\subsection {\tt double induction \ident$_1$ \ident$_2$
+\tacindex{double induction}}
+
+This tactic applies to any goal. If the variables {\ident$_1$} and
+{\ident$_2$} of the goal have an inductive type, then this tactic
+performs double induction on these variables.  For instance, if the
+current goal is \verb+forall n m:nat, P n m+ then, {\tt double induction n
+  m} yields the four cases with their respective inductive hypotheses.
+In particular the case for \verb+(P (S n) (S m))+ with the induction
+hypotheses \verb+(P (S n) m)+ and \verb+(m:nat)(P n m)+ (hence
+\verb+(P n m)+ and \verb+(P n (S m))+).
+
+\Rem When the induction hypothesis \verb+(P (S n) m)+ is not
+needed, {\tt induction \ident$_1$; destruct \ident$_2$} produces
+more concise subgoals.
+
+\begin{Variant}
+
+\item {\tt double induction \num$_1$ \num$_2$}
+
+This applies double induction on the \num$_1^{th}$ and \num$_2^{th}$ {\it
+non dependent} premises of the goal. More generally, any combination of an
+{\ident} and an {\num} is valid.
+
+\end{Variant}
+
+\subsection{\tt decompose [ {\qualid$_1$} \dots\ {\qualid$_n$} ] \term
+\label{decompose}
+\tacindex{decompose}}
+
+This tactic allows to recursively decompose a
+complex proposition in order to obtain atomic ones.
+Example: 
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example}
+Lemma ex1 : forall A B C:Prop, A /\ B /\ C \/ B /\ C \/ C /\ A -> C.
+intros A B C H; decompose [and or] H; assumption.
+\end{coq_example}
+\begin{coq_example*}
+Qed.
+\end{coq_example*}
+
+{\tt decompose} does not work on right-hand sides of implications or products.
+
+\begin{Variants}
+  
+\item {\tt decompose sum \term}\tacindex{decompose sum}
+  This decomposes sum types (like \texttt{or}).
+\item {\tt decompose record \term}\tacindex{decompose record}
+  This decomposes record types (inductive types with one constructor,
+  like \texttt{and} and \texttt{exists} and those defined with the
+  \texttt{Record} macro, see p.~\pageref{Record}).
+\end{Variants}
+
+
+\subsection{\tt functional induction \ident\ \term$_1$ \dots\ \term$_n$.
+\tacindex{functional induction}
+\label{FunInduction}}
+
+The \emph{experimental} tactic \texttt{functional induction}
+performs case analysis and induction following the definition of
+a (not mutually recursive) function.
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example}
+Lemma le_minus : forall n m:nat, (n - m <= n).
+intros n m.
+functional induction minus n m; simpl; auto.
+\end{coq_example}
+\begin{coq_example*}
+Qed.
+\end{coq_example*}
+
+\texttt{functional induction} is a shorthand for the more general
+command \texttt{Functional Scheme} which builds induction
+principles following the recursive structure of (possibly
+mutually recursive)
+functions. \SeeAlso{\ref{FunScheme-examples}} for the difference
+between using one or the other.
+
+\Rem \texttt{functional induction} may fail on functions built by
+tactics. In particular case analysis of a function are considered
+only if they are not inside an application.
+
+\Rem Arguments of the function must be given, including the
+implicit ones. If the function is recursive, arguments must be
+variables, otherwise they may be any term.
+
+\SeeAlso{\ref{FunScheme},\ref{FunScheme-examples}}
+
+\section{Equality}
+
+These tactics use the equality {\tt eq:forall A:Type, A->A->Prop}
+defined in file {\tt Logic.v} (see Section~\ref{Equality}). The
+notation for {\tt eq}~$T~t~u$ is simply {\tt $t$=$u$} dropping the
+implicit type of $t$ and $u$.
+
+\subsection{\tt rewrite \term
+\label{rewrite}
+\tacindex{rewrite}}
+
+This tactic applies to any goal. The type of {\term}
+must have the form
+
+\texttt{(x$_1$:A$_1$) \dots\ (x$_n$:A$_n$)}\term$_1${\tt =}\term$_2$. 
+
+\noindent Then {\tt rewrite \term} replaces every occurrence of 
+\term$_1$ by \term$_2$ in the goal. Some of the variables x$_1$ are
+solved by unification, and some of the types \texttt{A}$_1$, \dots,
+\texttt{A}$_n$ become new subgoals.
+
+\Rem In case the type of  
+\term$_1$ contains occurrences of variables bound in the
+type of \term, the tactic tries first to find a subterm of the goal
+which matches this term in order to find a closed instance \term$'_1$
+of \term$_1$, and then all instances of \term$'_1$ will be replaced.
+
+\begin{ErrMsgs}
+\item \errindex{The term provided does not end with an equation}
+
+\item \errindex{Tactic generated a subgoal identical to the original goal}\\
+This happens if \term$_1$ does not occur in the goal.
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt rewrite -> {\term}}\tacindex{rewrite ->}\\
+  Is equivalent to {\tt rewrite \term}
+
+\item {\tt rewrite <- {\term}}\tacindex{rewrite <-}\\
+  Uses the equality \term$_1${\tt=}\term$_2$ from right to left
+
+\item {\tt rewrite {\term} in {\ident}}
+  \tacindex{rewrite \dots\ in}\\
+  Analogous to  {\tt rewrite {\term}} but rewriting is done in the
+  hypothesis named {\ident}.
+
+\item {\tt rewrite -> {\term} in {\ident}}
+  \tacindex{rewrite -> \dots\ in}\\
+  Behaves as {\tt rewrite {\term} in {\ident}}.
+ 
+\item {\tt rewrite <- {\term} in {\ident}}\\
+  \tacindex{rewrite <- \dots\ in}
+  Uses the equality \term$_1${\tt=}\term$_2$ from right to left to
+  rewrite in the hypothesis named {\ident}.
+\end{Variants}
+
+
+\subsection{\tt cutrewrite -> \term$_1$ = \term$_2$
+\label{cutrewrite}
+\tacindex{cutrewrite}}
+
+This tactic acts like {\tt replace {\term$_1$} with {\term$_2$}}
+(see below).
+
+\subsection{\tt replace {\term$_1$} with {\term$_2$}
+\tacindex{replace \dots\ with}}
+
+This tactic applies to any goal. It replaces all free occurrences of
+{\term$_1$} in the current goal with {\term$_2$} and generates the
+equality {\term$_2$}{\tt =}{\term$_1$} as a subgoal. This equality is
+automatically solved if it occurs amongst the assumption, or if its
+symmetric form occurs.  It is equivalent to {\tt cut
+\term$_2$=\term$_1$; [intro H{\sl n}; rewrite <- H{\sl n}; clear H{\sl
+n}| assumption || symmetry; try assumption]}.
+
+\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}
+
+\end{Variants}
+
+\subsection{\tt reflexivity
+\label{reflexivity}
+\tacindex{reflexivity}}
+
+This tactic applies to a goal which has the form {\tt t=u}. It checks
+that {\tt t} and {\tt u} are convertible and then solves the goal.
+It is equivalent to {\tt apply refl\_equal}.
+
+\begin{ErrMsgs}
+\item \errindex{The conclusion is not a substitutive equation}
+\item \errindex{Impossible to unify \dots\ with ..}
+\end{ErrMsgs}
+
+\subsection{\tt symmetry
+\tacindex{symmetry}
+\tacindex{symmetry in}}
+This tactic applies to a goal which has the form {\tt t=u} and changes it
+into {\tt u=t}.
+
+\variant {\tt symmetry in {\ident}}\\
+If the statement of the hypothesis {\ident} has the form {\tt t=u},
+the tactic changes it to {\tt u=t}.
+
+\subsection{\tt transitivity \term
+\tacindex{transitivity}}
+This tactic applies to a goal which has the form {\tt t=u}
+and transforms it into the two subgoals 
+{\tt t={\term}} and {\tt {\term}=u}.
+
+\subsection{\tt subst {\ident}
+\tacindex{subst}}
+
+This tactic applies to a goal which has \ident\ in its context and
+(at least) one hypothesis, say {\tt H}, of type {\tt
+  \ident=t} or {\tt t=\ident}. Then it replaces 
+\ident\ by {\tt t} everywhere in the goal (in the hypotheses 
+and in the conclusion) and clears \ident\ and {\tt H} from the context.
+
+\Rem 
+When several hypotheses have the form {\tt \ident=t} or {\tt
+  t=\ident}, the first one is used. 
+
+\begin{Variants}
+  \item {\tt subst \ident$_1$ \dots \ident$_n$} \\
+    Is equivalent to {\tt subst \ident$_1$; \dots; subst \ident$_n$}.
+  \item {\tt subst} \\
+    Applies {\tt subst} repeatedly to all identifiers from the context
+    for which an equality exists.
+\end{Variants}
+
+\subsection{{\tt stepl {\term}}}
+\tacindex{stepl}
+
+This tactic is for chaining rewriting steps. It assumes a goal of the
+form ``$R$ {\term}$_1$ {\term}$_2$'' where $R$ is a binary relation
+and relies on a database of lemmas of the form {\tt forall} $x$ $y$
+$z$, $R$ $x$ $y$ {\tt ->} $eq$ $x$ $z$ {\tt ->} $R$ $z$ $y$ where $eq$
+is typically a setoid equality. The application of {\tt stepl {\term}}
+then replaces the goal by ``$R$ {\term} {\term}$_2$'' and adds a new
+goal stating ``$eq$ {\term} {\term}$_1$''.
+
+Lemmas are added to the database using the command 
+\comindex{Declare Left Step}
+\begin{quote}
+{\tt Declare Left Step {\qualid}.}
+\end{quote}
+where {\qualid} is the name of the lemma.
+
+The tactic is especially useful for parametric setoids which are not
+accepted as regular setoids for {\tt rewrite} and {\tt setoid\_replace} (see chapter \ref{setoid_replace}).
+
+\tacindex{stepr}
+\comindex{Declare Right Step}
+\begin{Variants}
+\item{\tt stepl {\term} by {\tac}}\\
+This applies {\tt stepl {\term}} then applies {\tac} to the second goal.
+
+\item{\tt stepr {\term}}\\
+     {\tt stepr {\term} by {\tac}}\\
+This behaves as {\tt stepl} but on the right-hand-side of the binary relation.
+Lemmas are expected to be of the form
+``{\tt forall} $x$ $y$
+$z$, $R$ $x$ $y$ {\tt ->} $eq$ $y$ $z$ {\tt ->} $R$ $x$ $z$''
+and are registered using the command
+\begin{quote}
+{\tt Declare Right Step {\qualid}.}
+\end{quote}
+\end{Variants}
+
+\section{Equality and inductive sets}
+
+We describe in this section some special purpose tactics dealing with
+equality and inductive sets or types. These tactics use the equality
+{\tt eq:forall (A:Type), A->A->Prop}, simply written with the
+infix symbol {\tt =}.
+
+\subsection{\tt decide equality
+\label{decideequality}
+\tacindex{decide equality}}
+
+This tactic solves a goal of the form
+{\tt forall $x$ $y$:$R$, \{$x$=$y$\}+\{\verb|~|$x$=$y$\}}, where $R$
+is an inductive type such that its constructors do not take proofs or
+functions as arguments, nor objects in dependent types.
+
+\begin{Variants}
+\item {\tt decide equality {\term}$_1$ {\term}$_2$ }.\\
+ Solves a goal of the form {\tt \{}\term$_1${\tt =}\term$_2${\tt
+\}+\{\verb|~|}\term$_1${\tt =}\term$_2${\tt \}}.
+\end{Variants}
+
+\subsection{\tt compare \term$_1$ \term$_2$
+\tacindex{compare}}
+
+This tactic compares two given objects \term$_1$ and \term$_2$ 
+of an inductive datatype. If $G$ is the current goal, it leaves the sub-goals
+\term$_1${\tt =}\term$_2$ {\tt ->} $G$ and \verb|~|\term$_1${\tt =}\term$_2$
+{\tt ->} $G$. The type
+of \term$_1$ and \term$_2$ must satisfy the same restrictions as in the tactic
+\texttt{decide equality}.
+
+\subsection {\tt discriminate {\ident}
+\label{discriminate}
+\tacindex{discriminate}}
+
+This tactic proves any goal from an absurd hypothesis stating that two
+structurally different terms of an inductive set are equal. For
+example, from the hypothesis {\tt (S (S O))=(S O)} we can derive by
+absurdity any proposition.  Let {\ident} be a hypothesis of type
+{\tt{\term$_1$} = {\term$_2$}} in the local context, {\term$_1$} and
+{\term$_2$} being elements of an inductive set.  To build the proof,
+the tactic traverses the normal forms\footnote{Recall: opaque
+  constants will not be expanded by $\delta$ reductions} of
+{\term$_1$} and {\term$_2$} looking for a couple of subterms {\tt u}
+and {\tt w} ({\tt u} subterm of the normal form of {\term$_1$} and
+{\tt w} subterm of the normal form of {\term$_2$}), placed at the same
+positions and whose head symbols are two different constructors. If
+such a couple of subterms exists, then the proof of the current goal
+is completed, otherwise the tactic fails.
+
+\Rem If {\ident} does not denote an hypothesis in the local context
+but refers to an hypothesis quantified in the goal, then the
+latter is first introduced in the local context using
+\texttt{intros until \ident}.
+
+\begin{ErrMsgs}
+\item {\ident} \errindex{Not a discriminable equality} \\
+  occurs when the type of the specified hypothesis is not an equation.
+\end{ErrMsgs}  
+
+\begin{Variants}
+\item \texttt{discriminate} \num\\
+  This does the same thing as \texttt{intros until \num} then
+\texttt{discriminate \ident} where {\ident} is the identifier for the last
+introduced hypothesis.
+\item {\tt discriminate}\tacindex{discriminate} \\
+  It applies to a goal of the form {\tt
+    \verb=~={\term$_1$}={\term$_2$}} and it is equivalent to: 
+  {\tt unfold not; intro {\ident}}; {\tt discriminate
+    {\ident}}.
+
+  \begin{ErrMsgs}
+  \item \errindex{No discriminable equalities} \\
+  occurs when the goal does not verify the expected preconditions.
+  \end{ErrMsgs}
+\end{Variants}
+
+\subsection{\tt injection {\ident}
+\label{injection}
+\tacindex{injection}}
+
+The {\tt injection} tactic is based on the fact that constructors of
+inductive sets are injections. That means that if $c$ is a constructor
+of an inductive set, and if $(c~\vec{t_1})$ and $(c~\vec{t_2})$ are two
+terms that are equal then $~\vec{t_1}$ and $~\vec{t_2}$ are equal
+too.
+
+If {\ident} is an hypothesis of type {\tt {\term$_1$} = {\term$_2$}},
+then {\tt injection} behaves as applying injection as deep as possible to
+derive the equality of all the subterms of {\term$_1$} and {\term$_2$}
+placed in the same positions. For example, from the hypothesis {\tt (S
+  (S n))=(S (S (S m))} we may derive {\tt n=(S m)}.  To use this
+tactic {\term$_1$} and {\term$_2$} should be elements of an inductive
+set and they should be neither explicitly equal, nor structurally
+different. We mean by this that, if {\tt n$_1$} and {\tt n$_2$} are
+their respective normal forms, then:
+\begin{itemize}
+\item {\tt n$_1$} and {\tt n$_2$} should not be syntactically equal,
+\item there must not exist any couple of subterms {\tt u} and {\tt w},
+  {\tt u} subterm of {\tt n$_1$} and {\tt w} subterm of {\tt n$_2$} ,
+  placed in the same positions and having different constructors as
+  head symbols.
+\end{itemize}
+If these conditions are satisfied, then, the tactic derives the
+equality of all the subterms of {\term$_1$} and {\term$_2$} placed in
+the same positions and puts them as antecedents of the current goal.
+
+\Example Consider the following goal:
+
+\begin{coq_example*}
+Inductive list : Set :=
+  | nil : list
+  | cons : nat -> list -> list.
+Variable P : list -> Prop.
+\end{coq_example*}
+\begin{coq_eval}
+Lemma ex :
+ forall (l:list) (n:nat), P nil -> cons n l = cons 0 nil -> P l.
+intros l n H H0.
+\end{coq_eval}
+\begin{coq_example}
+Show.
+injection H0.
+\end{coq_example}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+Beware that \texttt{injection} yields always an equality in a sigma type
+whenever the injected object has a dependent type.
+
+\Rem If {\ident} does not denote an hypothesis in the local context
+but refers to an hypothesis quantified in the goal, then the
+latter is first introduced in the local context using
+\texttt{intros until \ident}.
+
+\begin{ErrMsgs}
+\item {\ident} \errindex{is not a projectable equality} 
+  occurs when the type of
+  the hypothesis $id$ does not verify the preconditions.
+\item \errindex{Not an equation} occurs when the type of the
+  hypothesis $id$ is not an equation.
+\end{ErrMsgs}
+
+\begin{Variants}
+\item \texttt{injection} \num{}
+
+  This does the same thing as \texttt{intros until \num} then
+\texttt{injection \ident} where {\ident} is the identifier for the last
+introduced hypothesis.
+
+\item{\tt injection}\tacindex{injection} 
+  
+  If the current goal is of the form {\term$_1$} {\tt <>} {\term$_2$},
+  the tactic computes the head normal form of the goal and then
+  behaves as the sequence: {\tt unfold not; intro {\ident}; injection
+  {\ident}}.
+  
+  \ErrMsg \errindex{goal does not satisfy the expected preconditions}
+\end{Variants}
+
+\subsection{\tt simplify\_eq {\ident}
+\tacindex{simplify\_eq}
+\label{simplify-eq}}
+
+Let {\ident} be the name of an hypothesis of type {\tt
+  {\term$_1$}={\term$_2$}} in the local context. If {\term$_1$} and
+{\term$_2$} are structurally different (in the sense described for the
+tactic {\tt discriminate}), then the tactic {\tt simplify\_eq} behaves as {\tt
+  discriminate {\ident}} otherwise it behaves as {\tt injection
+  {\ident}}.
+
+\Rem If {\ident} does not denote an hypothesis in the local context
+but refers to an hypothesis quantified in the goal, then the
+latter is first introduced in the local context using
+\texttt{intros until \ident}.
+
+\begin{Variants}
+\item \texttt{simplify\_eq} \num
+
+  This does the same thing as \texttt{intros until \num} then
+\texttt{simplify\_eq \ident} where {\ident} is the identifier for the last
+introduced hypothesis.
+\item{\tt simplify\_eq}
+If the current goal has form $\verb=~=t_1=t_2$, then this tactic does 
+\texttt{hnf; intro {\ident}; simplify\_eq {\ident}}.
+\end{Variants}
+
+\subsection{\tt dependent rewrite -> {\ident}
+\tacindex{dependent rewrite ->}
+\label{dependent-rewrite}}
+
+This tactic applies to any goal.  If \ident\ has type 
+\verb+(existS A B a b)=(existS A B a' b')+ 
+in the local context (i.e. each term of the
+equality has a sigma type $\{ a:A~ \&~(B~a)\}$) this tactic rewrites
+\verb+a+ into \verb+a'+ and \verb+b+ into \verb+b'+ in the current
+goal. This tactic works even if $B$ is also a sigma type.  This kind
+of equalities between dependent pairs may be derived by the injection
+and inversion tactics.
+
+\begin{Variants}
+\item{\tt dependent rewrite <- {\ident}}
+\tacindex{dependent rewrite <-} \\
+Analogous to {\tt dependent rewrite ->} but uses the equality from
+right to left.
+\end{Variants}
+
+\section{Inversion
+\label{inversion}}
+
+\subsection{\tt inversion {\ident}
+\tacindex{inversion}}
+
+Let the type of \ident~ in the local context be $(I~\vec{t})$,
+where $I$ is a (co)inductive predicate. Then,
+\texttt{inversion} applied to \ident~ derives for each possible
+constructor $c_i$ of $(I~\vec{t})$, {\bf all} the necessary
+conditions that should hold for the instance $(I~\vec{t})$ to be
+proved by $c_i$.
+
+\Rem If {\ident} does not denote an hypothesis in the local context
+but refers to an hypothesis quantified in the goal, then the
+latter is first introduced in the local context using
+\texttt{intros until \ident}.
+
+\begin{Variants}
+\item \texttt{inversion} \num
+  
+  This does the same thing as \texttt{intros until \num} then
+  \texttt{inversion \ident} where {\ident} is the identifier for the
+  last introduced hypothesis.
+
+\item \tacindex{inversion\_clear} \texttt{inversion\_clear} \ident
+
+  This behaves as \texttt{inversion} and then erases \ident~ from the
+  context.
+
+\item \tacindex{inversion \dots\ as} \texttt{inversion} {\ident} \texttt{as} {\intropattern}
+  
+  This behaves as \texttt{inversion} but using names in
+  {\intropattern} for naming hypotheses. The {\intropattern} must have
+  the form {\tt [} $p_{11}$ \ldots $p_{1n_1}$ {\tt |} {\ldots} {\tt |}
+  $p_{m1}$ \ldots $p_{mn_m}$ {\tt ]} with $m$ being the number of
+  constructors of the type of {\ident}. Be careful that the list must
+  be of length $m$ even if {\tt inversion} discards some cases (which
+  is precisely one of its roles): for the discarded cases, just use an
+  empty list (i.e. $n_i=0$).
+
+  The arguments of the $i^{th}$ constructor and the
+  equalities that {\tt inversion} introduces in the context of the
+  goal corresponding to the $i^{th}$ constructor, if it exists, get
+  their names from the list $p_{i1}$ \ldots $p_{in_i}$ in order. If
+  there are not enough names, {\tt induction} invents names for the
+  remaining variables to introduce. In case an equation splits into
+  several equations (because {\tt inversion} applies {\tt injection}
+  on the equalities it generates), the corresponding name $p_{ij}$ in
+  the list must be replaced by a sublist of the form {\tt [$p_{ij1}$
+  \ldots $p_{ijq}$]} (or, equivalently, {\tt ($p_{ij1}$,
+  \ldots, $p_{ijq}$)}) where $q$ is the number of subequations
+  obtained from splitting the original equation. Here is an example.
+
+\begin{coq_eval}
+Require Import List.
+\end{coq_eval}
+
+\begin{coq_example}
+Inductive contains0 : list nat -> Prop :=
+  | in_hd : forall l, contains0 (0 :: l)
+  | in_tl : forall l b, contains0 l -> contains0 (b :: l).
+Goal forall l:list nat, contains0 (1 :: l) -> contains0 l.
+intros l H; inversion H as [ | l' p Hl' [Heqp Heql'] ].
+\end{coq_example}
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\item \texttt{inversion} {\num} {\tt as} {\intropattern} 
+
+  This allows to name the hypotheses introduced by
+  \texttt{inversion} {\num} in the context.
+
+\item \tacindex{inversion\_cleardots\ as} \texttt{inversion\_clear}
+  {\ident} {\tt as} {\intropattern}  
+
+  This allows to name the hypotheses introduced by
+  \texttt{inversion\_clear} in the context.
+  
+\item \tacindex{inversion \dots\ in} \texttt{inversion } {\ident}
+  \texttt{in} \ident$_1$ \dots\ \ident$_n$
+
+  Let \ident$_1$ \dots\ \ident$_n$, be identifiers in the local context. This
+  tactic behaves as generalizing \ident$_1$ \dots\ \ident$_n$, and
+  then performing \texttt{inversion}.
+  
+\item \tacindex{inversion \dots\ as \dots\ in} \texttt{inversion }
+  {\ident} {\tt as} {\intropattern} \texttt{in} \ident$_1$ \dots\ 
+  \ident$_n$
+  
+  This allows to name the hypotheses introduced in the context by
+  \texttt{inversion} {\ident} \texttt{in} \ident$_1$ \dots\ 
+  \ident$_n$.
+  
+\item \tacindex{inversion\_clear \dots\ in} \texttt{inversion\_clear}
+  {\ident} \texttt{in} \ident$_1$ \ldots \ident$_n$
+ 
+  Let \ident$_1$ \dots\ \ident$_n$, be identifiers in the local context. This
+  tactic behaves as generalizing \ident$_1$ \dots\ \ident$_n$, and
+  then performing {\tt inversion\_clear}.
+  
+\item \tacindex{inversion\_clear \dots\ as \dots\ in}
+  \texttt{inversion\_clear} {\ident} \texttt{as} {\intropattern}
+  \texttt{in} \ident$_1$ \ldots \ident$_n$
+
+  This allows to name the hypotheses introduced in the context by
+  \texttt{inversion\_clear} {\ident} \texttt{in} \ident$_1$ \ldots
+  \ident$_n$.
+
+\item \tacindex{dependent inversion} \texttt{dependent inversion}
+  {\ident}  
+  
+  That must be used when \ident\ appears in the current goal.  It acts
+  like \texttt{inversion} and then substitutes \ident\ for the
+  corresponding term in the goal.
+  
+\item \tacindex{dependent inversion \dots\ as } \texttt{dependent
+    inversion} {\ident} \texttt{as} {\intropattern} 
+  
+  This allows to name the hypotheses introduced in the context by
+  \texttt{dependent inversion} {\ident}.
+
+\item \tacindex{dependent inversion\_clear} \texttt{dependent
+    inversion\_clear} {\ident} 
+  
+  Like \texttt{dependent inversion}, except that {\ident} is cleared
+  from the local context.
+
+\item \tacindex{dependent inversion\_clear \dots\ as}
+  \texttt{dependent inversion\_clear} {\ident}\texttt{as} {\intropattern}
+  
+  This allows to name the hypotheses introduced in the context by
+  \texttt{dependent inversion\_clear} {\ident}
+
+\item \tacindex{dependent inversion \dots\ with} \texttt{dependent
+    inversion } {\ident} \texttt{ with } \term  
+  
+  This variant allow to give the good generalization of the goal. It
+  is useful when the system fails to generalize the goal automatically. If
+  {\ident} has type $(I~\vec{t})$ and $I$ has type
+  $forall (\vec{x}:\vec{T}), s$,   then \term~  must be of type
+  $I:forall (\vec{x}:\vec{T}), I~\vec{x}\to s'$ where $s'$ is the
+  type of the goal.
+
+\item \tacindex{dependent inversion \dots\ as \dots\ with}
+  \texttt{dependent inversion } {\ident} \texttt{as} {\intropattern}
+  \texttt{ with } \term  
+  
+  This allows to name the hypotheses introduced in the context by
+  \texttt{dependent inversion } {\ident} \texttt{ with } \term.
+
+\item \tacindex{dependent inversion\_clear \dots\ with}
+  \texttt{dependent inversion\_clear } {\ident} \texttt{ with } \term 
+  
+  Like \texttt{dependent inversion \dots\ with} but clears \ident from
+  the local context.
+
+\item \tacindex{dependent inversion\_clear \dots\ as \dots\ with}
+  \texttt{dependent inversion\_clear } {\ident} \texttt{as}
+  {\intropattern} \texttt{ with } \term 
+  
+  This allows to name the hypotheses introduced in the context by
+  \texttt{dependent inversion\_clear } {\ident} \texttt{ with } \term.
+
+\item \tacindex{simple inversion} \texttt{simple inversion} {\ident}
+  
+  It is a very primitive inversion tactic that derives all the necessary
+  equalities  but it does not simplify the  constraints as
+  \texttt{inversion} do.
+
+\item \tacindex{simple inversion \dots\ as} \texttt{simple inversion}
+  {\ident} \texttt{as} {\intropattern} 
+  
+  This allows to name the hypotheses introduced in the context by
+  \texttt{simple inversion}.
+
+\item \tacindex{inversion \dots\ using} \texttt{inversion} \ident
+  \texttt{ using} \ident$'$  
+  
+  Let {\ident} have type $(I~\vec{t})$ ($I$ an inductive
+  predicate) in the local context, and \ident$'$ be a (dependent) inversion
+  lemma. Then, this tactic refines the current goal with the specified
+  lemma.
+
+\item \tacindex{inversion \dots\ using \dots\ in} \texttt{inversion}
+  {\ident} \texttt{using} \ident$'$ \texttt{in} \ident$_1$\dots\ \ident$_n$
+  
+  This tactic behaves as generalizing \ident$_1$\dots\ \ident$_n$,
+  then doing \texttt{inversion}{\ident}\texttt{using} \ident$'$.
+
+\end{Variants}
+
+\SeeAlso~\ref{inversion-examples} for detailed examples
+
+\subsection{\tt Derive Inversion {\ident} with
+  ${\tt forall (}\vec{x}{\tt :}\vec{T}{\tt),} I~\vec{t}$ Sort \sort
+\label{Derive-Inversion}
+\comindex{Derive Inversion}}
+
+This command generates an inversion principle for the
+\texttt{inversion \dots\ using} tactic.
+Let $I$ be an inductive predicate and $\vec{x}$ the variables
+occurring in $\vec{t}$. This command generates and stocks the
+inversion lemma for the sort \sort~ corresponding to the instance
+$forall (\vec{x}:\vec{T}), I~\vec{t}$ with the name {\ident} in the {\bf
+global} environment. When applied it is equivalent to have inverted
+the instance with the tactic {\tt inversion}.
+
+\begin{Variants}
+\item \texttt{Derive Inversion\_clear} {\ident} \texttt{with}
+  \comindex{Derive Inversion\_clear}
+  $forall (\vec{x}:\vec{T}), I~\vec{t}$ \texttt{Sort} \sort~ \\ 
+  \index{Derive Inversion\_clear \dots\ with}
+  When applied it is equivalent to having
+  inverted the instance with the tactic \texttt{inversion}
+  replaced by the tactic \texttt{inversion\_clear}.
+\item \texttt{Derive Dependent Inversion} {\ident} \texttt{with}
+  $forall (\vec{x}:\vec{T}), I~\vec{t}$ \texttt{Sort} \sort~\\
+  \comindex{Derive Dependent Inversion}
+  When applied it is equivalent to having
+  inverted the instance with the tactic \texttt{dependent inversion}.
+\item \texttt{Derive Dependent Inversion\_clear} {\ident} \texttt{with}
+  $forall (\vec{x}:\vec{T}), I~\vec{t}$ \texttt{Sort} \sort~\\
+  \comindex{Derive Dependent Inversion\_clear}
+  When applied it is equivalent to having
+  inverted the instance with the tactic \texttt{dependent inversion\_clear}.
+\end{Variants}
+
+\SeeAlso \ref{inversion-examples} for examples
+
+\subsection{\tt quote \ident
+\tacindex{quote}
+\index{2-level approach}}
+
+This kind of inversion has nothing to do with the tactic
+\texttt{inversion} above. This tactic does \texttt{change (\ident\
+  t)}, where \texttt{t} is a term build in order to ensure the
+convertibility. In other words, it does inversion of the function
+\ident. This function must be a fixpoint on a simple recursive
+datatype: see~\ref{quote-examples} for the full details.
+
+\begin{ErrMsgs}
+\item \errindex{quote: not a simple fixpoint}\\
+  Happens when \texttt{quote} is not able to perform inversion properly.
+\end{ErrMsgs}
+
+\begin{Variants}
+\item \texttt{quote {\ident} [ \ident$_1$ \dots \ident$_n$ ]}\\
+  All terms that are build only with \ident$_1$ \dots \ident$_n$ will be
+  considered by \texttt{quote} as constants rather than variables.
+\end{Variants}
+
+% En attente d'un moyen de valoriser les fichiers de demos
+% \SeeAlso file \texttt{theories/DEMOS/DemoQuote.v} in the distribution
+
+\section{Automatizing
+\label{Automatizing}}
+
+\subsection{\tt auto
+\label{auto}
+\tacindex{auto}}
+
+This tactic implements a Prolog-like resolution procedure to solve the
+current goal. It first tries to solve the goal using the {\tt
+  assumption} tactic, then it reduces the goal to an atomic one using
+{\tt intros} and introducing the newly generated hypotheses as hints.
+Then it looks at the list of tactics associated to the head symbol of
+the goal and tries to apply one of them (starting from the tactics
+with lower cost). This process is recursively applied to the generated
+subgoals. 
+
+By default, \texttt{auto} only uses the hypotheses of the current goal and the
+hints of the database named {\tt core}. 
+
+\begin{Variants}
+
+\item  {\tt auto \num}
+
+  Forces the search depth to be \num. The maximal search depth is 5 by
+  default. 
+
+\item {\tt auto with \ident$_1$ \dots\ \ident$_n$}
+  
+  Uses the hint databases $\ident_1$ \dots\ $\ident_n$ in addition to
+  the database {\tt core}. See Section~\ref{Hints-databases} for the
+  list of pre-defined databases and the way to create or extend a
+  database.  This option can be combined with the previous one.
+
+\item {\tt auto with *}
+
+  Uses all existing hint databases, minus the special database
+  {\tt v62}. See Section~\ref{Hints-databases}
+
+\item {\tt trivial}\tacindex{trivial}
+
+  This tactic is a restriction of {\tt auto} that is not recursive and 
+  tries only hints which cost is 0. Typically it solves trivial
+  equalities like $X=X$.
+
+\item \texttt{trivial with \ident$_1$ \dots\ \ident$_n$}
+
+\item \texttt{trivial with *}
+
+\end{Variants}
+
+\Rem {\tt auto} either solves completely the goal or else leave it
+intact. \texttt{auto} and \texttt{trivial} never fail.
+
+\SeeAlso Section~\ref{Hints-databases}
+
+\subsection{\tt eauto
+\tacindex{eauto}
+\label{eauto}}
+
+This tactic generalizes {\tt auto}. In contrast with 
+the latter, {\tt eauto} uses unification of the goal
+against the hints rather than pattern-matching
+(in other words, it uses {\tt eapply} instead of
+{\tt apply}).
+As a consequence, {\tt eauto} can solve such a goal:
+
+\begin{coq_example}
+Hint Resolve ex_intro.
+Goal forall P:nat -> Prop, P 0 ->  exists n, P n.
+eauto.
+\end{coq_example}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+Note that {\tt ex\_intro} should be declared as an
+hint.
+
+\SeeAlso Section~\ref{Hints-databases}
+
+% EXISTE ENCORE ?
+% 
+% \subsection{\tt Prolog [ \term$_1$ \dots\ \term$_n$ ] \num}
+% \tacindex{Prolog}\label{Prolog}
+% This tactic, implemented by Chet Murthy, is based upon the concept of
+% existential variables of Gilles Dowek, stating that resolution is a
+% kind of unification. It tries to solve the current goal using the {\tt
+%   Assumption} tactic, the {\tt intro} tactic, and applying hypotheses
+% of the local context and terms of the given list {\tt [ \term$_1$
+%   \dots\ \term$_n$\ ]}.  It is more powerful than {\tt auto} since it
+% may apply to any theorem, even those of the form {\tt (x:A)(P x) -> Q}
+% where {\tt x} does not appear free in {\tt Q}.  The maximal search
+% depth is {\tt \num}.
+
+% \begin{ErrMsgs}
+% \item \errindex{Prolog failed}\\
+%   The Prolog tactic was not able to prove the subgoal.
+% \end{ErrMsgs}
+
+\subsection{\tt tauto
+\tacindex{tauto}
+\label{tauto}}
+
+This tactic implements a decision procedure for intuitionistic propositional
+calculus based on the contraction-free sequent calculi LJT* of Roy Dyckhoff
+\cite{Dyc92}. Note that {\tt tauto} succeeds on any instance of an
+intuitionistic tautological proposition. {\tt tauto} unfolds negations
+and logical equivalence but does not unfold any other definition.
+
+The following goal can be proved by {\tt tauto} whereas {\tt auto}
+would fail:
+
+\begin{coq_example}
+Goal forall (x:nat) (P:nat -> Prop), x = 0 \/ P x -> x <> 0 -> P x.
+  intros.
+  tauto.
+\end{coq_example}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+Moreover, if it has nothing else to do, {\tt tauto} performs
+introductions. Therefore, the use of {\tt intros} in the previous
+proof is unnecessary. {\tt tauto} can for instance prove the
+following:
+\begin{coq_example}
+(* auto would fail *)
+Goal forall (A:Prop) (P:nat -> Prop),
+    A \/ (forall x:nat, ~ A -> P x) -> forall x:nat, ~ A -> P x.
+
+  tauto.
+\end{coq_example}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\Rem In contrast, {\tt tauto} cannot solve the following goal
+
+\begin{coq_example*}
+Goal forall (A:Prop) (P:nat -> Prop),
+    A \/ (forall x:nat, ~ A -> P x) -> forall x:nat, ~ ~ (A \/ P x).
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+because \verb=(forall x:nat, ~ A -> P x)= cannot be treated as atomic and an
+instantiation of \verb=x= is necessary.
+
+\subsection{\tt intuition {\tac}
+\tacindex{intuition}
+\label{intuition}}
+
+The tactic \texttt{intuition} takes advantage of the search-tree built
+by the decision procedure involved in the tactic {\tt tauto}. It uses
+this information to generate a set of subgoals equivalent to the
+original one (but simpler than it) and applies the tactic 
+{\tac} to them \cite{Mun94}. If this tactic fails on some goals then
+{\tt intuition} fails. In fact, {\tt tauto} is simply {\tt intuition
+  fail}.
+
+For instance, the tactic {\tt intuition auto} applied to the goal
+\begin{verbatim}
+(forall (x:nat), P x)/\B -> (forall (y:nat),P y)/\ P O \/B/\ P O
+\end{verbatim}
+internally replaces it by the equivalent one:
+\begin{verbatim}
+(forall (x:nat), P x), B |- P O
+\end{verbatim}
+and then uses {\tt auto} which completes the proof.
+
+Originally due to C{\'e}sar~Mu{\~n}oz, these tactics ({\tt tauto} and {\tt intuition})
+have been completely reengineered by David~Delahaye using mainly the tactic
+language (see chapter~\ref{TacticLanguage}). The code is now quite shorter and
+a significant increase in performances has been noticed. The general behavior
+with respect to dependent types, unfolding and introductions has
+slightly changed to get clearer semantics. This may lead to some
+incompatibilities.
+
+\begin{Variants}
+\item {\tt intuition}\\
+  Is equivalent to {\tt intuition auto with *}.
+\end{Variants}
+
+% En attente d'un moyen de valoriser les fichiers de demos
+%\SeeAlso file \texttt{contrib/Rocq/DEMOS/Demo\_tauto.v}
+
+\subsection{{\tt firstorder}
+\tacindex{firstorder}
+\label{firstorder}}
+
+The tactic \texttt{firstorder} is an {\it experimental} extension of
+\texttt{tauto} to  
+first-order reasoning, written by Pierre Corbineau. 
+It is not restricted to usual logical connectives but
+instead may reason about any first-order class inductive definition.
+
+\begin{Variants}
+ \item {\tt firstorder {\tac}}
+   \tacindex{firstorder {\tac}}
+
+   Tries to solve the goal with {\tac} when no logical rule may apply.
+
+ \item {\tt firstorder with \ident$_1$ \dots\ \ident$_n$ }
+   \tacindex{firstorder with}
+
+   Adds lemmas \ident$_1$ \dots\ \ident$_n$ to the proof-search
+   environment.
+
+ \item {\tt firstorder using \ident$_1$ \dots\ \ident$_n$ }
+   \tacindex{firstorder using}
+
+   Adds lemmas in {\tt auto} hints bases \ident$_1$ \dots\ \ident$_n$
+   to the proof-search environment.
+\end{Variants}
+
+Proof-search is bounded by a depth parameter which can be set by typing the
+{\nobreak \tt Set Firstorder Depth $n$} \comindex{Set Firstorder Depth} 
+vernacular command.
+
+%% \subsection{{\tt jp} {\em (Jprover)}
+%% \tacindex{jp}
+%% \label{jprover}}
+
+%% The tactic \texttt{jp}, due to Huang Guan-Shieng, is an experimental
+%% port of the {\em Jprover}\cite{SLKN01} semi-decision procedure for
+%% first-order intuitionistic logic implemented in {\em
+%%   NuPRL}\cite{Kre02}.
+
+%% The tactic \texttt{jp}, due to Huang Guan-Shieng, is an {\it
+%%   experimental} port of the {\em Jprover}\cite{SLKN01} semi-decision 
+%% procedure for first-order intuitionistic logic implemented in {\em
+%%   NuPRL}\cite{Kre02}. 
+
+%% Search may optionnaly be bounded by a multiplicity parameter
+%% indicating how many (at most) copies of a formula may be used in 
+%% the proof process, its absence may lead to non-termination of the tactic.
+
+%% %\begin{coq_eval}
+%% %Variable S:Set.
+%% %Variables P Q:S->Prop.
+%% %Variable f:S->S.
+%% %\end{coq_eval}
+
+%% %\begin{coq_example*}
+%% %Lemma example: (exists x |P x\/Q x)->(exists x |P x)\/(exists x |Q x).
+%% %jp.
+%% %Qed.
+
+%% %Lemma example2: (forall x ,P x->P (f x))->forall x,P x->P (f(f x)).
+%% %jp.
+%% %Qed.
+%% %\end{coq_example*}
+
+%% \begin{Variants}
+%%  \item {\tt jp $n$}\\
+%%    \tacindex{jp $n$} 
+%%    Tries the {\em Jprover} procedure with multiplicities up to $n$,
+%%    starting from 1.
+%%  \item {\tt jp}\\
+%%    Tries the {\em Jprover} procedure without multiplicity bound, 
+%%    possibly running forever.
+%% \end{Variants}
+
+%% \begin{ErrMsgs}
+%%  \item \errindex{multiplicity limit reached}\\
+%%    The procedure tried all multiplicities below the limit and
+%%    failed. Goal might be solved by increasing the multiplicity limit. 
+%%  \item \errindex{formula is not provable}\\
+%%    The procedure determined that goal was not provable in
+%%    intuitionistic first-order logic, no matter how big the
+%%    multiplicity is.
+%% \end{ErrMsgs}
+
+
+% \subsection{\tt Linear}\tacindex{Linear}\label{Linear}
+% The tactic \texttt{Linear}, due to Jean-Christophe Filli{\^a}atre
+% \cite{Fil94}, implements a decision procedure for {\em Direct
+%   Predicate Calculus}, that is first-order Gentzen's Sequent Calculus
+% without contraction rules \cite{KeWe84,BeKe92}.  Intuitively, a
+% first-order goal is provable in Direct Predicate Calculus if it can be
+% proved using each hypothesis at most once.
+
+% Unlike the previous tactics, the \texttt{Linear} tactic does not belong
+% to the initial state of the system, and it must be loaded explicitly
+% with the command
+
+% \begin{coq_example*}
+% Require Linear.
+% \end{coq_example*}
+
+% For instance, assuming that \texttt{even} and \texttt{odd} are two
+% predicates on natural numbers, and \texttt{a} of type \texttt{nat}, the
+% tactic \texttt{Linear} solves the following goal
+
+% \begin{coq_eval}
+% Variables even,odd : nat -> Prop.
+% Variable a:nat.
+% \end{coq_eval}
+
+% \begin{coq_example*}
+% Lemma example : (even a) 
+%               -> ((x:nat)((even x)->(odd (S x))))
+%               -> (EX y | (odd y)).
+% \end{coq_example*}
+
+% You can find examples of the use of \texttt{Linear} in
+% \texttt{theories/DEMOS/DemoLinear.v}.
+% \begin{coq_eval}
+% Abort.
+% \end{coq_eval}
+
+% \begin{Variants}
+% \item {\tt Linear with \ident$_1$ \dots\ \ident$_n$}\\
+%   \tacindex{Linear with} 
+%   Is equivalent to apply first {\tt generalize \ident$_1$ \dots
+%     \ident$_n$} (see section \ref{generalize}) then the \texttt{Linear}
+%   tactic.  So one can use axioms, lemmas or hypotheses of the local
+%   context with \texttt{Linear} in this way.
+% \end{Variants}
+
+% \begin{ErrMsgs}
+% \item \errindex{Not provable in Direct Predicate Calculus}
+% \item \errindex{Found $n$ classical proof(s) but no intuitionistic one}\\ 
+%   The decision procedure looks actually for classical proofs of the
+%   goals, and then checks that they are intuitionistic.  In that case,
+%   classical proofs have been found, which do not correspond to
+%   intuitionistic ones.
+% \end{ErrMsgs}
+
+\subsection{\tt congruence
+\tacindex{congruence}
+\label{congruence}}
+
+The tactic {\tt congruence}, by Pierre Corbineau, implements the standard Nelson and Oppen
+congruence closure algorithm, which is a decision procedure for ground
+equalities with uninterpreted symbols. It also include the constructor theory
+(see \ref{injection} and \ref{discriminate}).
+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.
+
+\begin{coq_eval}
+Reset Initial.
+Variable A:Set.
+Variables a b:A.
+Variable f:A->A.
+Variable g:A->A->A.
+\end{coq_eval}
+
+\begin{coq_example}
+Theorem T: 
+  a=(f a) -> (g b (f a))=(f (f a)) -> (g a b)=(f (g b a)) -> (g a b)=a.
+intros.
+congruence.
+\end{coq_example}
+
+\begin{coq_eval}
+Reset Initial.
+Variable A:Set.
+Variables a c d:A.
+Variable f:A->A*A.
+\end{coq_eval}
+
+\begin{coq_example}
+Theorem inj : f = pair a -> Some (f c) = Some (f d) -> c=d.
+intros.
+congruence.
+\end{coq_example}
+
+\begin{ErrMsgs}
+  \item \errindex{I don't know how to handle dependent equality} \\
+    The decision procedure managed to find a proof of the goal or of
+    a discriminable equality but this proof couldn't be built in Coq
+    because of dependently-typed functions.
+  \item \errindex{I couldn't solve goal} \\
+    The decision procedure didn't managed to find a proof of the goal or of
+    a discriminable equality.
+\end{ErrMsgs}
+
+\subsection{\tt omega
+\tacindex{omega}
+\label{omega}}
+
+The tactic \texttt{omega}, due to Pierre Cr{\'e}gut,
+is an automatic decision procedure for Presburger
+arithmetic. It solves quantifier-free 
+formulas built with \verb|~|, \verb|\/|, \verb|/\|,
+\verb|->| on top of equalities and inequalities on
+both the type \texttt{nat} of natural numbers and \texttt{Z} of binary
+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$
+\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.
+
+\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.
+
+\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}
+
+\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.
+
+\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.
+
+\Example
+\begin{coq_example*}
+Require Import Reals.
+Goal forall x y:R,
+    (x * y > 0)%R ->
+    (x * (1 / x + x / (x + y)))%R =
+    ((- 1 / y) * y * (- x * (x / (x + y)) - 1))%R.
+\end{coq_example*}
+
+\begin{coq_example}
+intros; field.
+\end{coq_example}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\subsection{\tt Add Field
+\comindex{Add 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
+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
+a term of type {\tt A->A->A}, {\tt {\it Amult}} is a term of type {\tt
+  A->A->A}, {\tt {\it Aone}} is a term of type {\tt A}, {\tt {\it
+    Azero}} is a term of type {\tt A}, {\tt {\it Aopp}} is a term of
+type {\tt A->A}, {\tt {\it Aeq}} is a term of type {\tt A->bool}, {\tt
+  {\it Ainv}} is a term of type {\tt A->A}, {\tt {\it Rth}} is a term
+of type {\tt (Ring\_Theory {\it A Aplus Amult Aone Azero Ainv Aeq})},
+and {\tt {\it Tinvl}} is a term of type {\tt forall n:{\it A},
+  {\~{}}(n={\it Azero})->({\it Amult} ({\it Ainv} n) n)={\it Aone}}.
+To build a ring theory, refer to Chapter~\ref{ring} for more details.
+
+This command adds also an entry in the ring theory table if this theory is not
+already declared. So, it is useless to keep, for a given type, the {\tt Add
+Ring} command if you declare a theory with {\tt Add Field}, except if you plan
+to use specific features of {\tt ring} (see Chapter~\ref{ring}). However, the
+module {\tt ring} is not loaded by {\tt Add Field} and you have to make a {\tt
+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}
+{\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}
+{\it Aopp} {\it Aeq} {\it Ainv} {\it Rth} {\it Tinvl}}\\
+{\tt \phantom{Add 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}.
+
+\subsection{\tt fourier
+\tacindex{fourier}}
+
+This tactic written by Lo{\"\i}c Pottier solves linear inequations on
+real numbers using Fourier's method~\cite{Fourier}. This tactic must
+be loaded by {\tt Require Import Fourier}.
+
+\Example
+\begin{coq_example*}
+Require Import Reals.
+Require Import Fourier.
+Goal forall x y:R, (x < y)%R -> (y + 1 >= x - 1)%R.
+\end{coq_example*}
+
+\begin{coq_example}
+intros; fourier.
+\end{coq_example}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\subsection{\tt autorewrite with \ident$_1$ \dots \ident$_n$.
+\tacindex{autorewrite}}
+
+This tactic \footnote{The behavior of this tactic has much changed compared to
+the versions available in the previous distributions (V6). This may cause
+significant changes in your theories to obtain the same result. As a drawback
+of the reengineering of the code, this tactic has also been completely revised
+to get a very compact and readable version.} carries out rewritings according
+the rewriting rule bases {\tt \ident$_1$ \dots \ident$_n$}.
+
+ Each rewriting rule of a base \ident$_i$ is applied to the main subgoal until
+it fails. Once all the rules have been processed, if the main subgoal has
+progressed (e.g., if it is distinct from the initial main goal) then the rules
+of this base are processed again. If the main subgoal has not progressed then
+the next base is processed. For the bases, the behavior is exactly similar to
+the processing of the rewriting rules.
+
+The rewriting rule bases are built with the {\tt Hint~Rewrite} vernacular
+command.
+
+\Warning{} This tactic may loop if you build non terminating rewriting systems.
+
+\begin{Variant}
+\item {\tt autorewrite with \ident$_1$ \dots \ident$_n$ using \tac}\\
+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{\tt autorewrite [ \ident$_1$ \dots \ident$_n$ ]}\\
+%{\tt autorewrite  [ \ident$_1$ \dots \ident$_n$ ] using \tac}\\
+%These are deprecated syntactic variants for
+%{\tt autorewrite with \ident$_1$ \dots \ident$_n$}
+%and
+%{\tt autorewrite  with \ident$_1$ \dots \ident$_n$ using \tac}.
+\end{Variant}
+
+\subsection{\tt Hint Rewrite \term$_1$ \dots \term$_n$ : \ident
+\comindex{Hint Rewrite}}
+
+This vernacular command adds the terms {\tt \term$_1$ \dots \term$_n$}
+(their types must be equalities) in the rewriting base {\tt \ident}
+with the default orientation (left to right). Notice that the
+rewriting bases are distinct from the {\tt auto} hint bases and that
+{\tt auto} does not take them into account.
+
+This command is synchronous with the section mechanism (see \ref{Section}):
+when closing a section, all aliases created by \texttt{Hint Rewrite} in that
+section are lost. Conversely, when loading a module, all \texttt{Hint Rewrite}
+declarations at the global level of that module are loaded.
+
+\begin{Variants}
+\item {\tt Hint Rewrite -> \term$_1$ \dots \term$_n$ : \ident}\\
+This is strictly equivalent to the command above (we only make explicit the
+orientation which otherwise defaults to {\tt ->}).
+
+\item {\tt Hint Rewrite <- \term$_1$ \dots \term$_n$ : \ident}\\
+Adds the rewriting rules {\tt \term$_1$ \dots \term$_n$} with a right-to-left
+orientation in the base {\tt \ident}.
+
+\item {\tt Hint Rewrite \term$_1$ \dots \term$_n$ using {\tac} : {\ident}}\\
+When the rewriting rules {\tt \term$_1$ \dots \term$_n$} in {\tt \ident} will
+be used, the tactic {\tt \tac} will be applied to the generated subgoals, the
+main subgoal excluded.
+
+%% \item 
+%% {\tt Hint Rewrite [ \term$_1$ \dots \term$_n$ ] in \ident}\\
+%% {\tt Hint Rewrite [ \term$_1$ \dots \term$_n$ ] in {\ident} using {\tac}}\\
+%% These are deprecated syntactic variants for
+%% {\tt Hint Rewrite \term$_1$ \dots \term$_n$ : \ident} and
+%% {\tt Hint Rewrite \term$_1$ \dots \term$_n$ using {\tac} : {\ident}}.
+
+\end{Variants}
+
+\SeeAlso \ref{autorewrite-example} for examples showing the use of
+this tactic. 
+
+% En attente d'un moyen de valoriser les fichiers de demos
+%\SeeAlso file \texttt{contrib/Rocq/DEMOS/Demo\_AutoRewrite.v}
+
+\section{The hints databases for {\tt auto} and {\tt eauto}
+\index{Hints databases}
+\label{Hints-databases}
+\comindex{Hint}}
+
+The hints for \texttt{auto} and \texttt{eauto} are stored in
+databases.  Each database maps head symbols to a list of hints. One can
+use the command \texttt{Print Hint \ident} to display the hints
+associated to the head symbol \ident{} (see \ref{PrintHint}). Each
+hint has a cost that is an nonnegative integer, and a pattern. 
+The hints with lower cost are tried first. A hint is tried by 
+\texttt{auto} when the conclusion of the current goal
+matches its pattern. The general
+command to add a hint to some database \ident$_1$, \dots, \ident$_n$ is:
+\begin{tabbing}
+  \texttt{Hint} \textsl{hint\_definition} \texttt{:} \ident$_1$ \ldots\ \ident$_n$
+\end{tabbing}
+where {\sl hint\_definition} is one of the following expressions:
+
+\begin{itemize}
+\item \texttt{Resolve} {\term} 
+  \comindex{Hint Resolve}
+  
+  This command adds {\tt apply {\term}} to the hint list
+  with the head symbol of the type of \term. The cost of that hint is
+  the number of subgoals generated by {\tt apply {\term}}.
+  
+  In case the inferred type of \term\ does not start with a product the
+  tactic added in the hint list is {\tt exact {\term}}. In case this
+  type can be reduced to a type starting with a product, the tactic {\tt
+    apply {\term}} is also stored in the hints list.
+  
+  If the inferred type of \term\ does contain a dependent
+  quantification on a predicate, it is added to the hint list of {\tt
+    eapply} instead of the hint list of {\tt apply}. In this case, a
+  warning is printed since the hint is only used by the tactic {\tt
+    eauto} (see \ref{eauto}). A typical example of hint that is used
+  only by \texttt{eauto} is a transitivity lemma.
+
+  \begin{ErrMsgs}
+  \item \errindex{Bound head variable}
+
+    The head symbol of the type of {\term} is a bound variable such
+    that this tactic cannot be associated to a constant.
+
+  \item \term\ \errindex{cannot be used as a hint}
+
+    The type of \term\ contains products over variables which do not
+    appear in the conclusion. A typical example is a transitivity axiom.
+    In that case the {\tt apply} tactic fails, and thus is useless.
+
+  \end{ErrMsgs}
+
+  \begin{Variants}
+
+  \item \texttt{Resolve} {\term$_1$} \dots {\term$_m$}
+
+    Adds each \texttt{Resolve} {\term$_i$}.
+
+  \end{Variants}
+
+\item \texttt{Immediate {\term}} 
+\comindex{Hint Immediate}
+  
+  This command adds {\tt apply {\term}; trivial} to the hint list
+  associated with the head symbol of the type of \ident in the given
+  database. This tactic will fail if all the subgoals generated by
+  {\tt apply {\term}} are not solved immediately by the {\tt trivial}
+  tactic which only tries tactics with cost $0$.
+  
+  This command is useful for theorems such that the symmetry of equality
+  or $n+1=m+1 \to n=m$ that we may like to introduce with a
+  limited use in order to avoid useless proof-search.
+  
+  The cost of this tactic (which never generates subgoals) is always 1,
+  so that it is not used by {\tt trivial} itself.
+
+  \begin{ErrMsgs}
+
+  \item \errindex{Bound head variable}
+
+  \item \term\ \errindex{cannot be used as a hint} 
+
+  \end{ErrMsgs}
+
+  \begin{Variants}
+
+    \item \texttt{Immediate} {\term$_1$} \dots {\term$_m$} 
+
+      Adds each \texttt{Immediate} {\term$_i$}.
+
+  \end{Variants}
+
+\item \texttt{Constructors} {\ident}
+\comindex{Hint Constructors}
+  
+  If {\ident} is an inductive type, this command adds all its
+  constructors as hints of type \texttt{Resolve}. Then, when the
+  conclusion of current goal has the form \texttt{({\ident} \dots)},
+  \texttt{auto} will try to apply each constructor.
+
+  \begin{ErrMsgs}
+
+    \item {\ident} \errindex{is not an inductive type}
+
+    \item {\ident} \errindex{not declared}
+
+  \end{ErrMsgs}
+
+  \begin{Variants}
+
+    \item \texttt{Constructors} {\ident$_1$} \dots {\ident$_m$} 
+
+      Adds each \texttt{Constructors} {\ident$_i$}.
+
+  \end{Variants}
+
+\item \texttt{Unfold} {\qualid}
+\comindex{Hint Unfold}
+  
+  This adds the tactic {\tt unfold {\qualid}} to the hint list that
+  will only be used when the head constant of the goal is \ident.  Its
+  cost is 4.
+
+  \begin{Variants}
+
+    \item \texttt{Unfold} {\ident$_1$} \dots {\ident$_m$} 
+
+      Adds each \texttt{Unfold} {\ident$_i$}.
+
+  \end{Variants}
+
+\item \texttt{Extern \num\ \pattern\ => }\textsl{tactic}
+\comindex{Hint Extern}
+
+  This hint type is to extend \texttt{auto} with tactics other than
+  \texttt{apply} and \texttt{unfold}. For that, we must specify a
+  cost, a pattern and a tactic to execute. Here is an example:
+
+\begin{quotation}
+\begin{verbatim}
+Hint Extern 4 ~(?=?) => discriminate.
+\end{verbatim}
+\end{quotation}
+
+  Now, when the head of the goal is a disequality, \texttt{auto} will
+  try \texttt{discriminate} if it does not succeed to solve the goal
+  with hints with a cost less than 4.
+
+  One can even use some sub-patterns of the pattern in the tactic
+  script. A sub-pattern is a question mark followed by an ident, like
+  \texttt{?X1} or \texttt{?X2}. Here is an example:
+
+% Require EqDecide.
+\begin{coq_example*}
+Require Import List.
+\end{coq_example*}
+\begin{coq_example}
+Hint Extern 5   ({?X1 = ?X2} + {?X1 <> ?X2}) =>
+ generalize X1 X2; decide equality : eqdec.
+Goal 
+forall a b:list (nat * nat), {a = b} + {a <> b}.
+info auto with eqdec.
+\end{coq_example}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\end{itemize}
+
+\Rem There is currently (in the \coqversion\ release) no way to do
+pattern-matching on hypotheses.
+
+\begin{Variants}
+\item \texttt{Hint} \textsl{hint\_definition} 
+  
+  No database name is given : the hint is registered in the {\tt core} 
+    database. 
+
+\item\texttt{Hint Local} \textsl{hint\_definition} \texttt{:}
+   \ident$_1$ \ldots\ \ident$_n$
+
+  This is used to declare hints that must not be exported to the other
+  modules that require and import the current module. Inside a
+  section, the option {\tt Local} is useless since hints do not
+  survive anyway to the closure of sections.
+
+\item\texttt{Hint Local} \textsl{hint\_definition} 
+
+  Idem for the {\tt core} database.
+    
+\end{Variants}
+
+% There are shortcuts that allow to define several goal at once:
+
+% \begin{itemize}
+% \item \comindex{Hints Resolve}\texttt{Hints Resolve \ident$_1$ \dots\ \ident$_n$ : \ident.}\\
+%   This command is a shortcut for the following ones:
+%   \begin{quotation}
+%    \noindent\texttt{Hint \ident$_1$ : \ident\ := Resolve \ident$_1$}\\
+%    \dots\\
+%    \texttt{Hint \ident$_1$ : \ident := Resolve \ident$_1$}
+%   \end{quotation}
+%   Notice that the hint name is the same that the theorem given as
+%   hint.
+% \item \comindex{Hints Immediate}\texttt{Hints Immediate \ident$_1$ \dots\ \ident$_n$ : \ident.}\\
+% \item \comindex{Hints Unfold}\texttt{Hints Unfold \qualid$_1$ \dots\ \qualid$_n$ : \ident.}\\
+% \end{itemize}
+
+%\begin{Warnings}
+%  \item \texttt{Overriding hint named \dots\ in database \dots}
+%\end{Warnings}
+
+\subsection{Hint databases defined in the \Coq\ standard library}
+
+Several hint databases are defined in the \Coq\ standard library.  The
+actual content of a database is the collection of the hints declared
+to belong to this database in each of the various modules currently
+loaded.  Especially, requiring new modules potentially extend a
+database. At {\Coq} startup, only the {\tt core} and {\tt v62}
+databases are non empty and can be used.
+
+\begin{description}
+
+\item[\tt core] This special database is automatically used by
+  \texttt{auto}. It contains only basic lemmas about negation,
+  conjunction, and so on from. Most of the hints in this database come 
+  from the \texttt{Init} and \texttt{Logic} directories.
+
+\item[\tt arith] This database contains all lemmas about Peano's
+  arithmetic proven in the directories \texttt{Init} and
+  \texttt{Arith}
+
+\item[\tt zarith] contains lemmas about binary signed integers from
+  the directories \texttt{theories/ZArith}. When required, the module
+  {\tt Omega} also extends the database {\tt zarith} with a high-cost
+  hint that calls {\tt omega} on equations and inequations in {\tt
+  nat} or {\tt Z}.
+
+\item[\tt bool] contains lemmas about booleans, mostly from directory
+  \texttt{theories/Bool}.
+
+\item[\tt datatypes] is for lemmas about lists, streams and so on that 
+  are mainly proven in the \texttt{Lists} subdirectory.
+
+\item[\tt sets] contains lemmas about sets and relations from the 
+  directories \texttt{Sets} and \texttt{Relations}.
+\end{description}
+
+There is also a special database called {\tt v62}. It collects all
+hints that were declared in the versions of {\Coq} prior to version
+6.2.4 when the databases {\tt core}, {\tt arith}, and so on were
+introduced.  The purpose of the database {\tt v62} is to ensure
+compatibility with further versions of Coq for developments done in
+versions prior to 6.2.4 ({\tt auto} being replaced by {\tt auto with v62}).
+The database {\tt v62} is intended not to be extended (!). It is not
+included in the hint databases list used in the {\tt auto with *} tactic.
+
+Furthermore, you are advised not to put your own hints in the
+{\tt core} database, but use one or several databases specific to your
+development.
+
+\subsection{\tt Print Hint
+\label{PrintHint}
+\comindex{Print Hint}}
+
+This command displays all hints that apply to the current goal. It
+fails if no proof is being edited, while the two variants can be used at
+every moment.
+
+\begin{Variants}
+
+\item {\tt  Print Hint {\ident} }
+
+ This command displays only tactics associated with \ident\ in the
+ hints list. This is independent of the goal being edited, to this
+ command will not fail if no goal is being edited.
+
+\item {\tt Print Hint *}
+
+  This command displays all declared hints. 
+
+\item {\tt  Print HintDb {\ident} }
+\label{PrintHintDb}
+\comindex{Print HintDb}
+
+ This command displays all hints from database \ident.
+
+\end{Variants}
+
+
+\subsection{Hints and sections
+\label{Hint-and-Section}}
+
+Hints provided by the \texttt{Hint} commands are erased when closing a
+section. Conversely, all hints of a module \texttt{A} that are not
+defined inside a section (and not defined with option {\tt Local}) become
+available when the module {\tt A} is imported (using
+e.g. \texttt{Require Import A.}).
+
+\section{Generation of induction principles with {\tt Scheme}
+\label{Scheme}
+\comindex{Scheme}}
+
+The {\tt Scheme} command is a high-level tool for generating
+automatically (possibly mutual) induction principles for given types
+and sorts.  Its syntax follows the schema:
+\begin{tabbing}
+{\tt 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 different inductive type
+identifiers belonging to the same package of mutual inductive
+definitions. This command generates {\ident$_1$}\dots{} {\ident$_m$}
+to be mutually recursive definitions. Each term {\ident$_i$} proves a
+general principle of mutual induction for objects in type {\term$_i$}.
+
+\begin{Variants}
+\item {\tt Scheme {\ident$_1$} := Minimality for \ident'$_1$ Sort {\sort$_1$} \\
+    with\\
+    \mbox{}\hspace{0.1cm} \dots\ \\
+    with {\ident$_m$} := Minimality for {\ident'$_m$} Sort
+    {\sort$_m$}}
+
+  Same as before but defines a non-dependent elimination principle more
+  natural in case of inductively defined relations. 
+\end{Variants}
+
+\SeeAlso \ref{Scheme-examples}
+
+\SeeAlso Section~\ref{Scheme-examples}
+
+\section{Generation of induction principles with {\tt Functional Scheme}
+\label{FunScheme}
+\comindex{Functional Scheme}}
+
+The {\tt Functional Scheme} command is a high-level experimental
+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$.}
+\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.
+
+\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}
+
+\SeeAlso Section~\ref{FunScheme-examples}
+
+
+\section{Simple tactic macros
+\index{tactic macros}
+\comindex{Tactic Definition}
+\label{TacticDefinition}}
+
+A simple example has more value than a long explanation: 
+
+\begin{coq_example}
+Ltac Solve := simpl; intros; auto.
+Ltac ElimBoolRewrite b H1 H2 :=
+  elim b; [ intros; rewrite H1; eauto | intros; rewrite H2; eauto ].
+\end{coq_example}
+
+The tactics macros are synchronous with the \Coq\ section mechanism:
+a tactic definition is deleted from the current environment
+when you close the section (see also \ref{Section}) 
+where it was defined. If you want that a
+tactic macro defined in a module is usable in the modules that
+require it, you should put it outside of any section.
+
+The chapter~\ref{TacticLanguage} gives examples of more complex
+user-defined tactics.
+
+
+% $Id: RefMan-tac.tex 8606 2006-02-23 13:58:10Z herbelin $ 
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-tacex.tex b/doc/refman/RefMan-tacex.tex
new file mode 100644
index 00000000..ecd54f44
--- /dev/null
+++ b/doc/refman/RefMan-tacex.tex
@@ -0,0 +1,1208 @@
+\chapter{Detailed examples of tactics}
+\label{Tactics-examples}
+
+This chapter presents detailed examples of certain tactics, to
+illustrate their behavior.
+
+\section{\tt refine}
+\tacindex{refine}
+\label{refine-example}
+
+This tactic applies to any goal. It behaves like {\tt exact} with a
+big difference : the user can leave some holes (denoted by \texttt{\_} or 
+{\tt (\_:}{\it type}{\tt )}) in the term. 
+{\tt refine} will generate as many
+subgoals as they are holes in the term. The type of holes must be
+either synthesized by the system or declared by an
+explicit cast like \verb|(\_:nat->Prop)|. This low-level
+tactic can be useful to advanced users.
+
+%\firstexample
+\Example
+
+\begin{coq_example*}
+Inductive Option : Set :=
+  | Fail : Option
+  | Ok : bool -> Option.
+\end{coq_example}
+\begin{coq_example}
+Definition get : forall x:Option, x <> Fail -> bool.
+refine
+ (fun x:Option =>
+    match x return x <> Fail -> bool with
+    | Fail => _
+    | Ok b => fun _ => b
+    end).
+intros; absurd (Fail = Fail); trivial.
+\end{coq_example}
+\begin{coq_example*}
+Defined.
+\end{coq_example*}
+
+% \example{Using Refine to build a poor-man's ``Cases'' tactic}
+
+% \texttt{Refine} is actually the only way for the user to do
+% a proof with the same structure as a {\tt Cases} definition. Actually,
+% the tactics \texttt{case} (see \ref{case}) and \texttt{Elim} (see
+% \ref{elim}) only allow one step of elementary induction. 
+
+% \begin{coq_example*}
+% Require Bool.
+% Require Arith.
+% \end{coq_example*}
+% %\begin{coq_eval}
+% %Abort.
+% %\end{coq_eval}
+% \begin{coq_example}
+% Definition one_two_or_five := [x:nat]
+%   Cases x of
+%     (1) => true
+%   | (2) => true
+%   | (5) => true
+%   | _ => false
+%   end.
+% Goal (x:nat)(Is_true (one_two_or_five x)) -> x=(1)\/x=(2)\/x=(5).
+% \end{coq_example}
+
+% A traditional script would be the following:
+
+% \begin{coq_example*}
+% Destruct x.
+% Tauto.
+% Destruct n.
+% Auto.
+% Destruct n0.
+% Auto.
+% Destruct n1.
+% Tauto.
+% Destruct n2.
+% Tauto.
+% Destruct n3.
+% Auto.
+% Intros; Inversion H.
+% \end{coq_example*}
+
+% With the tactic \texttt{Refine}, it becomes quite shorter:
+
+% \begin{coq_example*}
+% Restart.
+% \end{coq_example*}
+% \begin{coq_example}
+% Refine [x:nat]
+%   <[y:nat](Is_true (one_two_or_five y))->(y=(1)\/y=(2)\/y=(5))>
+%   Cases x of
+%     (1) => [H]?
+%   | (2) => [H]?
+%   | (5) => [H]?
+%   | n => [H](False_ind ? H)
+%   end; Auto.
+% \end{coq_example}
+% \begin{coq_eval}
+% Abort.
+% \end{coq_eval}
+
+\section{\tt eapply}
+\tacindex{eapply}
+\label{eapply-example}
+\Example
+Assume we have a relation on {\tt nat} which is transitive:
+
+\begin{coq_example*}
+Variable R : nat -> nat -> Prop.
+Hypothesis Rtrans : forall x y z:nat, R x y -> R y z -> R x z.
+Variables n m p : nat.
+Hypothesis Rnm : R n m.
+Hypothesis Rmp : R m p.
+\end{coq_example*}
+
+Consider the goal {\tt (R n p)} provable using the transitivity of
+{\tt R}:
+
+\begin{coq_example*}
+Goal R n p.
+\end{coq_example*}
+
+The direct application of {\tt Rtrans} with {\tt apply} fails because
+no value for {\tt y} in {\tt Rtrans} is found by {\tt apply}:
+
+\begin{coq_eval}
+Set Printing Depth 50.
+(********** The following is not correct and should produce **********)
+(**** Error: generated subgoal (R n ?17) has metavariables in it *****)
+\end{coq_eval}
+\begin{coq_example}
+apply Rtrans.
+\end{coq_example}
+
+A solution is to rather apply {\tt (Rtrans n m p)}.
+
+\begin{coq_example}
+apply (Rtrans n m p).
+\end{coq_example}
+
+\begin{coq_eval}
+Undo.
+\end{coq_eval}
+
+More elegantly, {\tt apply Rtrans with (y:=m)} allows to only mention
+the unknown {\tt m}:
+
+\begin{coq_example}
+
+  apply Rtrans with (y := m).
+\end{coq_example}
+
+\begin{coq_eval}
+Undo.
+\end{coq_eval}
+
+Another solution is to mention the proof of {\tt (R x y)} in {\tt
+Rtrans}...
+
+\begin{coq_example}
+
+  apply Rtrans with (1 := Rnm).
+\end{coq_example}
+
+\begin{coq_eval}
+Undo.
+\end{coq_eval}
+
+... or the proof of {\tt (R y z)}:
+
+\begin{coq_example}
+
+  apply Rtrans with (2 := Rmp).
+\end{coq_example}
+
+\begin{coq_eval}
+Undo.
+\end{coq_eval}
+
+On the opposite, one can use {\tt eapply} which postpone the problem
+of finding {\tt m}. Then one can apply the hypotheses {\tt Rnm} and {\tt
+Rmp}. This instantiates the existential variable and completes the proof.
+
+\begin{coq_example}
+eapply Rtrans.
+apply Rnm.
+apply Rmp.
+\end{coq_example}
+
+\begin{coq_eval}
+Reset R.
+\end{coq_eval}
+
+\section{{\tt Scheme}}
+\comindex{Scheme}
+\label{Scheme-examples}
+
+\firstexample
+\example{Induction scheme for \texttt{tree} and \texttt{forest}}
+
+The definition of principle of mutual induction for {\tt tree} and
+{\tt forest} over the sort {\tt Set} is defined by the command:
+
+\begin{coq_eval}
+Reset Initial.
+Variables A B : 
+              Set.
+\end{coq_eval}
+
+\begin{coq_example*}
+Inductive tree : Set :=
+    node : A -> forest -> tree
+with forest : Set :=
+  | leaf : B -> forest
+  | cons : tree -> forest -> forest.
+
+Scheme tree_forest_rec := Induction for tree Sort Set
+  with forest_tree_rec := Induction for forest Sort Set.
+\end{coq_example*}
+
+You may now look at the type of {\tt tree\_forest\_rec}:
+
+\begin{coq_example}
+Check tree_forest_rec.
+\end{coq_example}
+
+This principle involves two different predicates for {\tt trees} and
+{\tt forests}; it also has three premises each one corresponding to a
+constructor of one of the inductive definitions.
+
+The principle {\tt tree\_forest\_rec} shares exactly the same
+premises, only the conclusion now refers to the property of forests.
+
+\begin{coq_example}
+Check forest_tree_rec.
+\end{coq_example}
+
+\example{Predicates {\tt odd} and {\tt even} on naturals}
+
+Let {\tt odd} and {\tt even} be inductively defined as:
+
+\begin{coq_eval}
+Reset Initial.
+Open Scope nat_scope.
+\end{coq_eval}
+
+\begin{coq_example*}
+Inductive odd : nat -> Prop :=
+    oddS : forall n:nat, even n -> odd (S n)
+with even : nat -> Prop :=
+  | evenO : even 0
+  | evenS : forall n:nat, odd n -> even (S n).
+\end{coq_example*}
+
+The following command generates a powerful elimination
+principle:
+
+\begin{coq_example}
+Scheme odd_even := Minimality for   odd Sort Prop
+  with even_odd := Minimality for even Sort Prop.
+\end{coq_example}
+
+The type of {\tt odd\_even} for instance will be:
+
+\begin{coq_example}
+Check odd_even.
+\end{coq_example}
+
+The type of {\tt even\_odd} shares the same premises but the
+conclusion is {\tt (n:nat)(even n)->(Q n)}.
+
+\section{{\tt Functional Scheme} and {\tt functional induction}}
+\comindex{Functional Scheme}\tacindex{functional induction}
+\label{FunScheme-examples}
+
+\firstexample
+\example{Induction scheme for \texttt{div2}}
+
+We define the function \texttt{div2} as follows:
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{coq_example*}
+Require Import Arith.
+Fixpoint div2 (n:nat) : nat :=
+  match n with
+  | O => 0
+  | S n0 => match n0 with
+            | O => 0
+            | S n' => S (div2 n')
+            end
+  end.
+\end{coq_example*}
+
+The definition of a principle of induction corresponding to the
+recursive structure of \texttt{div2} is defined by the command:
+
+\begin{coq_example}
+Functional Scheme div2_ind := Induction for div2.
+\end{coq_example}
+
+You may now look at the type of {\tt div2\_ind}:
+
+\begin{coq_example}
+Check div2_ind.
+\end{coq_example}
+
+We can now prove the following lemma using this principle:
+
+
+\begin{coq_example*}
+Lemma div2_le' : forall n:nat, div2 n <= n.
+intro n.
+ pattern n.
+\end{coq_example*}
+
+
+\begin{coq_example}
+apply div2_ind; intros.
+\end{coq_example}
+
+\begin{coq_example*}
+auto with arith.
+auto with arith.
+simpl; auto with arith.
+Qed.
+\end{coq_example*}
+
+Since \texttt{div2} is not mutually recursive, we can use
+directly the \texttt{functional induction} tactic instead of
+building the principle:
+
+\begin{coq_example*}
+Reset div2_ind.
+Lemma div2_le : forall n:nat, div2 n <= n.
+intro n.
+\end{coq_example*}
+
+\begin{coq_example}
+functional induction div2 n.
+\end{coq_example}
+
+\begin{coq_example*}
+auto with arith.
+auto with arith.
+auto with arith.
+Qed.
+\end{coq_example*}
+
+\paragraph{remark:} \texttt{functional induction} makes no use of
+an induction principle, so be warned that each time it is
+applied, a term mimicking the structure of \texttt{div2} (roughly
+the size of {\tt div2\_ind}) is built. Using \texttt{Functional
+  Scheme} is generally faster and less memory consuming.  On the
+other hand \texttt{functional induction} performs some extra
+simplifications that \texttt{Functional Scheme} does not, and as
+it is a tactic it can be used in tactic definitions.
+
+
+\example{Induction scheme for \texttt{tree\_size}}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+We define trees by the following mutual inductive type:
+
+\begin{coq_example*}
+Variable A : Set.
+Inductive tree : Set :=
+    node : A -> forest -> tree
+with forest : Set :=
+  | empty : forest
+  | cons : tree -> forest -> forest.
+\end{coq_example*}
+
+We define the function \texttt{tree\_size} that computes the size
+of a tree or a forest.
+
+\begin{coq_example*}                
+Fixpoint tree_size (t:tree) : nat :=
+  match t with
+  | node A f => S (forest_size f)
+  end
+ with forest_size (f:forest) : nat :=
+  match f with
+  | empty => 0
+  | cons t f' => (tree_size t + forest_size f')
+  end.
+\end{coq_example*}
+
+The definition of principle of mutual induction following the
+recursive structure of \texttt{tree\_size} is defined by the
+command:
+
+\begin{coq_example*}
+Functional Scheme treeInd := Induction for tree_size
+ with tree_size forest_size.
+\end{coq_example*}
+
+You may now look at the type of {\tt treeInd}:
+
+\begin{coq_example}
+Check treeInd.
+\end{coq_example}
+
+
+
+\section{{\tt inversion}}
+\tacindex{inversion}
+\label{inversion-examples}
+
+\subsection*{Generalities about inversion}
+
+When working with (co)inductive predicates, we are very often faced to
+some of these situations:
+\begin{itemize}
+\item we have an inconsistent instance of an inductive predicate in the
+  local context of hypotheses. Thus, the current goal can be trivially
+  proved by absurdity. 
+\item we have a hypothesis that is an instance of an inductive
+  predicate, and the instance has some variables whose constraints we
+  would like to derive.
+\end{itemize}
+
+The inversion tactics are very useful to simplify the work in these
+cases. Inversion tools can be classified in three groups:
+
+\begin{enumerate}
+\item tactics for inverting an instance without stocking the inversion
+  lemma in the context; this includes the tactics
+  (\texttt{dependent})  \texttt{inversion} and
+ (\texttt{dependent}) \texttt{inversion\_clear}.
+\item commands for generating and stocking in the context the inversion
+  lemma corresponding to an instance; this includes \texttt{Derive}
+  (\texttt{Dependent}) \texttt{Inversion} and \texttt{Derive}
+  (\texttt{Dependent}) \texttt{Inversion\_clear}.
+\item tactics for inverting an instance using an already defined
+  inversion lemma; this includes the tactic \texttt{inversion \ldots using}.
+\end{enumerate}
+
+As inversion proofs may be large in size, we recommend the user to
+stock the lemmas whenever the same instance needs to be inverted
+several times.
+
+\firstexample
+\example{Non-dependent inversion}
+
+Let's consider the relation \texttt{Le} over natural numbers and the
+following variables:
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{coq_example*}
+Inductive Le : nat -> nat -> Set :=
+  | LeO : forall n:nat, Le 0 n
+  | LeS : forall n m:nat, Le n m -> Le (S n) (S m).
+Variable P : nat -> nat -> Prop.
+Variable Q : forall n m:nat, Le n m -> Prop.
+\end{coq_example*}
+
+For example, consider the goal:
+
+\begin{coq_eval}
+Lemma ex : forall n m:nat, Le (S n) m -> P n m.
+intros.
+\end{coq_eval}
+
+\begin{coq_example}
+Show.
+\end{coq_example}
+
+To prove the goal we may need to reason by cases on \texttt{H} and to 
+ derive that \texttt{m}  is necessarily of
+the form $(S~m_0)$ for certain $m_0$ and that $(Le~n~m_0)$.  
+Deriving these conditions corresponds to prove that the
+only possible constructor of \texttt{(Le (S n) m)}  is
+\texttt{LeS} and that we can invert the 
+\texttt{->} in the type  of \texttt{LeS}.  
+This inversion is possible because \texttt{Le} is the smallest set closed by
+the constructors \texttt{LeO} and \texttt{LeS}.
+
+\begin{coq_example}
+inversion_clear H.
+\end{coq_example}
+
+Note that \texttt{m} has been substituted in the goal for \texttt{(S m0)}
+and that the hypothesis \texttt{(Le n m0)} has been added to the
+context.
+
+Sometimes it is
+interesting to have the equality \texttt{m=(S m0)} in the
+context to use it after. In that case we can use \texttt{inversion} that
+does not clear the equalities:
+
+\begin{coq_example*}
+Undo.
+\end{coq_example*}
+
+\begin{coq_example}
+inversion H.
+\end{coq_example}
+
+\begin{coq_eval}
+Undo.
+\end{coq_eval}
+
+\example{Dependent Inversion}
+
+Let us consider the following goal:
+
+\begin{coq_eval}
+Lemma ex_dep : forall (n m:nat) (H:Le (S n) m), Q (S n) m H.
+intros.
+\end{coq_eval}
+
+\begin{coq_example}
+Show.
+\end{coq_example}
+
+As \texttt{H} occurs in the goal, we may want to reason by cases on its
+structure and so, we would like  inversion tactics to
+substitute \texttt{H} by the corresponding term in constructor form. 
+Neither \texttt{Inversion} nor  {\tt Inversion\_clear} make such a
+substitution. 
+To have such a behavior we use the dependent inversion tactics:
+
+\begin{coq_example}
+dependent inversion_clear H.
+\end{coq_example}
+
+Note that \texttt{H} has been substituted by \texttt{(LeS n m0 l)} and
+\texttt{m} by \texttt{(S m0)}.
+
+\example{using already defined inversion  lemmas}
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+For example, to generate the inversion lemma for the instance
+\texttt{(Le (S n) m)} and the sort \texttt{Prop} we do:
+
+\begin{coq_example*}
+Derive Inversion_clear leminv with (forall n m:nat, Le (S n) m) Sort
+ Prop.
+\end{coq_example*}
+
+\begin{coq_example}
+Check leminv.
+\end{coq_example}
+
+Then we can use the proven inversion lemma:
+
+\begin{coq_example}
+Show.
+\end{coq_example}
+
+\begin{coq_example}
+inversion H using leminv.
+\end{coq_example}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\section{\tt autorewrite}
+\label{autorewrite-example}
+
+Here are two examples of {\tt autorewrite} use. The first one ({\em Ackermann
+function}) shows actually a quite basic use where there is no conditional
+rewriting. The second one ({\em Mac Carthy function}) involves conditional
+rewritings and shows how to deal with them using the optional tactic of the
+{\tt Hint~Rewrite} command.
+
+\firstexample
+\example{Ackermann function}
+%Here is a basic use of {\tt AutoRewrite} with the Ackermann function:
+
+\begin{coq_example*}
+Require Import Arith.
+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).
+\end{coq_example*}
+
+\begin{coq_example}
+Hint Rewrite Ack0 Ack1 Ack2 : base0.
+Lemma ResAck0 : 
+ Ack 3 2 = 29.
+autorewrite with base0 using try reflexivity.
+\end{coq_example}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\example{Mac Carthy function}
+%The Mac Carthy function shows a more complex case:
+
+\begin{coq_example*}
+Require Import Omega.
+Variable g :   
+           nat -> nat -> nat.
+Axiom g0 : 
+        forall m:nat, g 0 m = m.
+Axiom
+  g1 :
+    forall n m:nat,
+      (n > 0) -> (m > 100) -> g n m = g (pred n) (m - 10).
+Axiom
+  g2 :
+    forall n m:nat,
+      (n > 0) -> (m <= 100) -> g n m = g (S n) (m + 11).
+\end{coq_example*}
+
+\begin{coq_example}
+Hint Rewrite g0 g1 g2 using omega : base1.
+Lemma Resg0 : 
+ g 1 110 = 100.
+autorewrite with base1 using reflexivity || simpl.
+\end{coq_example}
+
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+\begin{coq_example}
+Lemma Resg1 : g 1 95 = 91.
+autorewrite with base1 using reflexivity || simpl.
+\end{coq_example}
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\section{\tt quote}
+\tacindex{quote}
+\label{quote-examples}
+
+The tactic \texttt{quote} allows to use Barendregt's so-called
+2-level approach without writing any ML code. Suppose you have a
+language \texttt{L} of 
+'abstract terms' and a type \texttt{A} of 'concrete terms' 
+and a function \texttt{f : L -> A}. If \texttt{L} is a simple
+inductive datatype and \texttt{f} a simple fixpoint, \texttt{quote f}
+will replace the head of current goal by a convertible term of the form 
+\texttt{(f t)}. \texttt{L} must have a constructor of type: \texttt{A
+  -> L}. 
+
+Here is an example:
+
+\begin{coq_example}
+Require Import Quote.
+Parameters A B C : Prop.
+Inductive formula : Type :=
+  | f_and : formula -> formula -> formula (* binary constructor *)
+  | f_or : formula -> formula -> formula
+  | f_not : formula -> formula (* unary constructor *)
+  | f_true : formula (* 0-ary constructor *)
+  | f_const : Prop -> formula (* contructor for constants *).
+Fixpoint interp_f (f:
+                   formula) : Prop :=
+  match f with
+  | f_and f1 f2 => interp_f f1 /\ interp_f f2
+  | f_or f1 f2 => interp_f f1 \/ interp_f f2
+  | f_not f1 => ~ interp_f f1
+  | f_true => True
+  | f_const c => c
+  end.
+Goal A /\ (A \/ True) /\ ~ B /\ (A <-> A).
+quote interp_f.
+\end{coq_example}
+
+The algorithm to perform this inversion is: try to match the
+term with right-hand sides expression of \texttt{f}. If there is a
+match, apply the corresponding left-hand side and call yourself
+recursively on sub-terms. If there is no match, we are at a leaf:
+return the corresponding constructor (here \texttt{f\_const}) applied
+to the term. 
+
+\begin{ErrMsgs}
+\item \errindex{quote: not a simple fixpoint} \\
+  Happens when \texttt{quote} is not able to perform inversion properly.
+\end{ErrMsgs}
+
+\subsection{Introducing variables map}
+
+The normal use of \texttt{quote} is to make proofs by reflection: one
+defines a function \texttt{simplify : formula -> formula} and proves a 
+theorem \texttt{simplify\_ok: (f:formula)(interp\_f (simplify f)) ->
+  (interp\_f f)}. Then, one can simplify formulas by doing:
+\begin{verbatim}
+   quote interp_f.
+   apply simplify_ok.
+   compute.
+\end{verbatim}
+But there is a problem with leafs: in the example above one cannot
+write a function that implements, for example, the logical simplifications 
+$A \wedge A \ra A$ or $A \wedge \neg A \ra \texttt{False}$. This is
+because the \Prop{} is impredicative.
+
+It is better to use that type of formulas:
+
+\begin{coq_eval}
+Reset formula.
+\end{coq_eval}
+\begin{coq_example}
+Inductive formula : Set :=
+  | f_and : formula -> formula -> formula
+  | f_or : formula -> formula -> formula
+  | f_not : formula -> formula
+  | f_true : formula
+  | f_atom : index -> formula.
+\end{coq_example*}
+
+\texttt{index} is defined in module \texttt{quote}. Equality on that
+type is decidable so we are able to simplify $A \wedge A$ into $A$ at
+the abstract level. 
+
+When there are variables, there are bindings, and \texttt{quote}
+provides also a type \texttt{(varmap A)} of bindings from
+\texttt{index} to any set \texttt{A}, and a function
+\texttt{varmap\_find} to search in such maps. The interpretation
+function has now another argument, a variables map:
+
+\begin{coq_example}
+Fixpoint interp_f (vm:
+                    varmap Prop) (f:formula) {struct f} : Prop :=
+  match f with
+  | f_and f1 f2 => interp_f vm f1 /\ interp_f vm f2
+  | f_or f1 f2 => interp_f vm f1 \/ interp_f vm f2
+  | f_not f1 => ~ interp_f vm f1
+  | f_true => True
+  | f_atom i => varmap_find True i vm
+  end.
+\end{coq_example}
+
+\noindent\texttt{quote} handles this second case properly:
+
+\begin{coq_example}
+Goal A /\ (B \/ A) /\ (A \/ ~ B).
+quote interp_f.
+\end{coq_example}
+
+It builds \texttt{vm} and \texttt{t} such that \texttt{(f vm t)} is
+convertible with the conclusion of current goal.
+
+\subsection{Combining variables and constants}
+
+One can have both variables and constants in abstracts terms; that is
+the case, for example, for the \texttt{ring} tactic (chapter
+\ref{ring}). Then one must provide to \texttt{quote} a list of
+\emph{constructors of constants}. For example, if the list is
+\texttt{[O S]} then closed natural numbers will be considered as
+constants and other terms as variables. 
+
+Example: 
+
+\begin{coq_eval}
+Reset formula.
+\end{coq_eval}
+\begin{coq_example*}
+Inductive formula : Type :=
+  | f_and : formula -> formula -> formula
+  | f_or : formula -> formula -> formula
+  | f_not : formula -> formula
+  | f_true : formula
+  | f_const : Prop -> formula (* constructor for constants *)
+  | f_atom : index -> formula.
+Fixpoint interp_f
+ (vm:            (* constructor for variables *)
+  varmap Prop) (f:formula) {struct f} : Prop :=
+  match f with
+  | f_and f1 f2 => interp_f vm f1 /\ interp_f vm f2
+  | f_or f1 f2 => interp_f vm f1 \/ interp_f vm f2
+  | f_not f1 => ~ interp_f vm f1
+  | f_true => True
+  | f_const c => c
+  | f_atom i => varmap_find True i vm
+  end.
+Goal 
+A /\ (A \/ True) /\ ~ B /\ (C <-> C).
+\end{coq_example*}
+
+\begin{coq_example}
+quote interp_f [ A B ].
+Undo.
+  quote interp_f [ B C iff ].
+\end{coq_example}
+
+\Warning Since function inversion
+is undecidable in general case, don't expect miracles from it!
+
+% \SeeAlso file \texttt{theories/DEMOS/DemoQuote.v}
+
+\SeeAlso comments of source file \texttt{tactics/contrib/polynom/quote.ml}
+
+\SeeAlso the \texttt{ring} tactic (Chapter~\ref{ring})
+
+
+
+\section{Using the tactical language}
+
+\subsection{About the cardinality of the set of natural numbers}
+
+A first example which shows how to use the pattern matching over the proof
+contexts is the proof that natural numbers have more than two elements. The
+proof of such a lemma can be done as %shown on Figure~\ref{cnatltac}.
+follows:
+%\begin{figure}
+%\begin{centerframe}
+\begin{coq_eval}
+Reset Initial.
+Require Import Arith.
+Require Import List.
+\end{coq_eval}
+\begin{coq_example*}
+Lemma card_nat :
+ ~ (exists x : nat, exists y : nat, forall z:nat, x = z \/ y = z).
+Proof.
+red; intros (x, (y, Hy)).
+elim (Hy 0); elim (Hy 1); elim (Hy 2); intros;
+ match goal with
+ | [_:(?a = ?b),_:(?a = ?c) |- _ ] =>
+     cut (b = c); [ discriminate | apply trans_equal with a; auto ]
+ end.
+Qed.
+\end{coq_example*}
+%\end{centerframe}
+%\caption{A proof on cardinality of natural numbers}
+%\label{cnatltac}
+%\end{figure}
+
+We can notice that all the (very similar) cases coming from the three
+eliminations (with three distinct natural numbers) are successfully solved by
+a {\tt match goal} structure and, in particular, with only one pattern (use
+of non-linear matching).
+
+\subsection{Permutation on closed lists}
+
+Another more complex example is the problem of permutation on closed lists. The
+aim is to show that a closed list is a permutation of another one.
+
+First, we define the permutation predicate as shown in table~\ref{permutpred}.
+
+\begin{figure}
+\begin{centerframe}
+\begin{coq_example*}
+Section Sort.
+Variable A : Set.
+Inductive permut : list A -> list A -> Prop :=
+  | permut_refl   : forall l, permut l l
+  | permut_cons   :
+      forall a l0 l1, permut l0 l1 -> permut (a :: l0) (a :: l1)
+  | permut_append : forall a l, permut (a :: l) (l ++ a :: nil)
+  | permut_trans  :
+      forall l0 l1 l2, permut l0 l1 -> permut l1 l2 -> permut l0 l2.
+End Sort.
+\end{coq_example*}
+\end{centerframe}
+\caption{Definition of the permutation predicate}
+\label{permutpred}
+\end{figure}
+
+A more complex example is the problem of permutation on closed lists.
+The aim is to show that a closed list is a permutation of another one.
+First, we define the permutation predicate as shown on
+Figure~\ref{permutpred}.
+
+\begin{figure}
+\begin{centerframe}
+\begin{coq_example}
+Ltac Permut n :=
+  match goal with
+  | |- (permut _ ?l ?l) => apply permut_refl
+  | |- (permut _ (?a :: ?l1) (?a :: ?l2)) =>
+      let newn := eval compute in (length l1) in
+      (apply permut_cons; Permut newn)
+  | |- (permut ?A (?a :: ?l1) ?l2) =>
+      match eval compute in n with
+      | 1 => fail
+      | _ =>
+          let l1' := constr:(l1 ++ a :: nil) in
+          (apply (permut_trans A (a :: l1) l1' l2);
+            [ apply permut_append | compute; Permut (pred n) ])
+      end
+  end.
+Ltac PermutProve :=
+  match goal with
+  | |- (permut _ ?l1 ?l2) =>
+      match eval compute in (length l1 = length l2) with
+      | (?n = ?n) => Permut n
+      end
+  end.
+\end{coq_example}
+\end{centerframe}
+\caption{Permutation tactic}
+\label{permutltac}
+\end{figure}
+
+Next, we can write naturally the tactic and the result can be seen on
+Figure~\ref{permutltac}. We can notice that we use two toplevel
+definitions {\tt PermutProve} and {\tt Permut}. The function to be
+called is {\tt PermutProve} which computes the lengths of the two
+lists and calls {\tt Permut} with the length if the two lists have the
+same length. {\tt Permut} works as expected.  If the two lists are
+equal, it concludes. Otherwise, if the lists have identical first
+elements, it applies {\tt Permut} on the tail of the lists.  Finally,
+if the lists have different first elements, it puts the first element
+of one of the lists (here the second one which appears in the {\tt
+  permut} predicate) at the end if that is possible, i.e., if the new
+first element has been at this place previously. To verify that all
+rotations have been done for a list, we use the length of the list as
+an argument for {\tt Permut} and this length is decremented for each
+rotation down to, but not including, 1 because for a list of length
+$n$, we can make exactly $n-1$ rotations to generate at most $n$
+distinct lists. Here, it must be noticed that we use the natural
+numbers of {\Coq} for the rotation counter. On Figure~\ref{ltac}, we
+can see that it is possible to use usual natural numbers but they are
+only used as arguments for primitive tactics and they cannot be
+handled, in particular, we cannot make computations with them. So, a
+natural choice is to use {\Coq} data structures so that {\Coq} makes
+the computations (reductions) by {\tt eval compute in} and we can get
+the terms back by {\tt match}.
+ 
+With {\tt PermutProve}, we can now prove lemmas as 
+% shown on Figure~\ref{permutlem}.
+follows:
+%\begin{figure}
+%\begin{centerframe}
+
+\begin{coq_example*}
+Lemma permut_ex1 :
+  permut nat (1 :: 2 :: 3 :: nil) (3 :: 2 :: 1 :: nil).
+Proof. PermutProve. Qed.
+Lemma permut_ex2 :
+  permut nat
+    (0 :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: nil)
+    (0 :: 2 :: 4 :: 6 :: 8 :: 9 :: 7 :: 5 :: 3 :: 1 :: nil).
+Proof. PermutProve. Qed.
+\end{coq_example*}
+%\end{centerframe}
+%\caption{Examples of {\tt PermutProve} use}
+%\label{permutlem}
+%\end{figure}
+
+
+\subsection{Deciding intuitionistic propositional logic}
+
+\begin{figure}[b]
+\begin{centerframe}
+\begin{coq_example}
+Ltac Axioms :=
+  match goal with
+  | |- True => trivial
+  | _:False |- _  => elimtype False; assumption
+  | _:?A |- ?A  => auto
+  end.
+\end{coq_example}
+\end{centerframe}
+\caption{Deciding intuitionistic propositions (1)}
+\label{tautoltaca}
+\end{figure}
+
+
+\begin{figure}
+\begin{centerframe}
+\begin{coq_example}
+Ltac DSimplif :=
+  repeat
+   (intros;
+    match goal with
+     | id:(~ _) |- _ => red in id
+     | id:(_ /\ _) |- _ =>
+         elim id; do 2 intro; clear id
+     | id:(_ \/ _) |- _ =>
+         elim id; intro; clear id
+     | id:(?A /\ ?B -> ?C) |- _ =>
+         cut (A -> B -> C);
+          [ intro | intros; apply id; split; assumption ]
+     | id:(?A \/ ?B -> ?C) |- _ =>
+         cut (B -> C);
+          [ cut (A -> C);
+             [ intros; clear id
+             | intro; apply id; left; assumption ]
+          | intro; apply id; right; assumption ]
+     | id0:(?A -> ?B),id1:?A |- _ =>
+         cut B; [ intro; clear id0 | apply id0; assumption ]
+     | |- (_ /\ _) => split
+     | |- (~ _) => red
+     end).
+Ltac TautoProp :=
+  DSimplif;
+   Axioms ||
+     match goal with
+     | id:((?A -> ?B) -> ?C) |- _ =>
+          cut (B -> C);
+          [ intro; cut (A -> B);
+             [ intro; cut C;
+                [ intro; clear id | apply id; assumption ]
+             | clear id ]
+          | intro; apply id; intro; assumption ]; TautoProp
+     | id:(~ ?A -> ?B) |- _ =>
+         cut (False -> B);
+          [ intro; cut (A -> False);
+             [ intro; cut B;
+                [ intro; clear id | apply id; assumption ]
+             | clear id ]
+          | intro; apply id; red; intro; assumption ]; TautoProp
+     | |- (_ \/ _) => (left; TautoProp) || (right; TautoProp)
+     end.
+\end{coq_example}
+\end{centerframe}
+\caption{Deciding intuitionistic propositions (2)}
+\label{tautoltacb}
+\end{figure}
+
+The pattern matching on goals allows a complete and so a powerful
+backtracking when returning tactic values. An interesting application
+is the problem of deciding intuitionistic propositional logic.
+Considering the contraction-free sequent calculi {\tt LJT*} of
+Roy~Dyckhoff (\cite{Dyc92}), it is quite natural to code such a tactic
+using the tactic language as shown on Figures~\ref{tautoltaca}
+and~\ref{tautoltacb}. The tactic {\tt Axioms} tries to conclude using
+usual axioms. The tactic {\tt DSimplif} applies all the reversible
+rules of Dyckhoff's system. Finally, the tactic {\tt TautoProp} (the
+main tactic to be called) simplifies with {\tt DSimplif}, tries to
+conclude with {\tt Axioms} and tries several paths using the
+backtracking rules (one of the four Dyckhoff's rules for the left
+implication to get rid of the contraction and the right or).
+
+For example, with {\tt TautoProp}, we can prove tautologies like
+ those:
+% on Figure~\ref{tautolem}.
+%\begin{figure}[tbp]
+%\begin{centerframe}
+\begin{coq_example*}
+Lemma tauto_ex1 : forall A B:Prop, A /\ B -> A \/ B.
+Proof. TautoProp. Qed.
+Lemma tauto_ex2 :
+   forall A B:Prop, (~ ~ B -> B) -> (A -> B) -> ~ ~ A -> B.
+Proof. TautoProp. Qed.
+\end{coq_example*}
+%\end{centerframe}
+%\caption{Proofs of tautologies with {\tt TautoProp}}
+%\label{tautolem}
+%\end{figure}
+
+\subsection{Deciding type isomorphisms}
+
+A more tricky problem is to decide equalities between types and modulo
+isomorphisms. Here, we choose to use the isomorphisms of the simply typed
+$\lb{}$-calculus with Cartesian product and $unit$ type (see, for example,
+\cite{RC95}). The axioms of this $\lb{}$-calculus are given by
+table~\ref{isosax}.
+
+\begin{figure}
+\begin{centerframe}
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example*}
+Open Scope type_scope.
+Section Iso_axioms.
+Variables A B C : Set.
+Axiom Com : A * B = B * A.
+Axiom Ass : A * (B * C) = A * B * C.
+Axiom Cur : (A * B -> C) = (A -> B -> C).
+Axiom Dis : (A -> B * C) = (A -> B) * (A -> C).
+Axiom P_unit : A * unit = A.
+Axiom AR_unit : (A -> unit) = unit.
+Axiom AL_unit : (unit -> A) = A.
+Lemma Cons : B = C -> A * B = A * C.
+Proof.
+intro Heq; rewrite Heq; apply refl_equal.
+Qed.
+End Iso_axioms.
+\end{coq_example*}
+\end{centerframe}
+\caption{Type isomorphism axioms}
+\label{isosax}
+\end{figure}
+
+A more tricky problem is to decide equalities between types and modulo
+isomorphisms. Here, we choose to use the isomorphisms of the simply typed
+$\lb{}$-calculus with Cartesian product and $unit$ type (see, for example,
+\cite{RC95}). The axioms of this $\lb{}$-calculus are given on
+Figure~\ref{isosax}.
+
+\begin{figure}[ht]
+\begin{centerframe}
+\begin{coq_example}
+Ltac DSimplif trm :=
+  match trm with
+  | (?A * ?B * ?C) =>
+      rewrite <- (Ass A B C); try MainSimplif
+  | (?A * ?B -> ?C) =>
+      rewrite (Cur A B C); try MainSimplif
+  | (?A -> ?B * ?C) =>
+      rewrite (Dis A B C); try MainSimplif
+  | (?A * unit) =>
+      rewrite (P_unit A); try MainSimplif
+  | (unit * ?B) =>
+      rewrite (Com unit B); try MainSimplif
+  | (?A -> unit) =>
+      rewrite (AR_unit A); try MainSimplif
+  | (unit -> ?B) =>
+      rewrite (AL_unit B); try MainSimplif
+  | (?A * ?B) =>
+      (DSimplif A; try MainSimplif) || (DSimplif B; try MainSimplif)
+  | (?A -> ?B) =>
+      (DSimplif A; try MainSimplif) || (DSimplif B; try MainSimplif)
+  end
+ with MainSimplif :=
+  match goal with
+  | |- (?A = ?B) => try DSimplif A; try DSimplif B
+  end.
+Ltac Length trm :=
+  match trm with
+  | (_ * ?B) => let succ := Length B in constr:(S succ)
+  | _ => constr:1
+  end.
+Ltac assoc := repeat rewrite <- Ass.
+\end{coq_example}
+\end{centerframe}
+\caption{Type isomorphism tactic (1)}
+\label{isosltac1}
+\end{figure}
+
+\begin{figure}[ht]
+\begin{centerframe}
+\begin{coq_example}
+Ltac DoCompare n :=
+  match goal with
+  | [ |- (?A = ?A) ] => apply refl_equal
+  | [ |- (?A * ?B = ?A * ?C) ] =>
+      apply Cons; let newn := Length B in
+                  DoCompare newn
+  | [ |- (?A * ?B = ?C) ] =>
+      match eval compute in n with
+      | 1 => fail
+      | _ =>
+          pattern (A * B) at 1; rewrite Com; assoc; DoCompare (pred n)
+      end
+  end.
+Ltac CompareStruct :=
+  match goal with
+  | [ |- (?A = ?B) ] =>
+      let l1 := Length A
+      with l2 := Length B in
+      match eval compute in (l1 = l2) with
+      | (?n = ?n) => DoCompare n
+      end
+  end.
+Ltac IsoProve := MainSimplif; CompareStruct.
+\end{coq_example}
+\end{centerframe}
+\caption{Type isomorphism tactic (2)}
+\label{isosltac2}
+\end{figure}
+
+The tactic to judge equalities modulo this axiomatization can be written as
+shown on Figures~\ref{isosltac1} and~\ref{isosltac2}. The algorithm is quite
+simple. Types are reduced using axioms that can be oriented (this done by {\tt
+MainSimplif}). The normal forms are sequences of Cartesian
+products without Cartesian product in the left component. These normal forms
+are then compared modulo permutation of the components (this is done by {\tt
+CompareStruct}). The main tactic to be called and realizing this algorithm is
+{\tt IsoProve}.
+
+% Figure~\ref{isoslem} gives 
+Here are examples of what can be solved by {\tt IsoProve}.
+%\begin{figure}[ht]
+%\begin{centerframe}
+\begin{coq_example*}
+Lemma isos_ex1 : 
+  forall A B:Set, A * unit * B = B * (unit * A).
+Proof.
+intros; IsoProve.
+Qed.
+
+Lemma isos_ex2 :
+  forall A B C:Set,
+    (A * unit -> B * (C * unit)) =
+    (A * unit -> (C -> unit) * C) * (unit -> A -> B).
+Proof.
+intros; IsoProve.
+Qed.
+\end{coq_example*}
+%\end{centerframe}
+%\caption{Type equalities solved by {\tt IsoProve}}
+%\label{isoslem}
+%\end{figure}
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/RefMan-tus.tex b/doc/refman/RefMan-tus.tex
new file mode 100644
index 00000000..8be5c963
--- /dev/null
+++ b/doc/refman/RefMan-tus.tex
@@ -0,0 +1,2015 @@
+%\documentclass[11pt]{article}
+%\usepackage{fullpage,euler}
+%\usepackage[latin1]{inputenc}
+%\begin{document}
+%\title{Writing ad-hoc Tactics in Coq}
+%\author{} 
+%\date{}
+%\maketitle
+%\tableofcontents
+%\clearpage
+
+\chapter{Writing ad-hoc Tactics in Coq}
+\label{WritingTactics}
+
+\section{Introduction}
+
+\Coq\ is an open proof environment, in the sense that the collection of
+proof strategies offered by the system can be extended by the user.
+This feature has two important advantages. First, the user can develop
+his/her own ad-hoc proof procedures, customizing the system for a
+particular domain of application. Second, the repetitive and tedious
+aspects of the proofs can be abstracted away implementing new tactics
+for dealing with them. For example, this may be useful when a theorem
+needs several lemmas which are all proven in a similar but not exactly
+the same way. Let us illustrate this with an example.
+
+Consider the problem of deciding the equality of two booleans. The
+theorem establishing that this is always possible is state by 
+the following theorem:
+
+\begin{coq_example*}
+Theorem decideBool : (x,y:bool){x=y}+{~x=y}.
+\end{coq_example*}
+
+The proof proceeds by case analysis on both $x$ and $y$. This yields
+four cases to solve. The cases $x=y=\textsl{true}$ and
+$x=y=\textsl{false}$ are immediate by the reflexivity of equality.
+
+The other two cases follow by discrimination. The following script
+describes the proof:
+
+\begin{coq_example*}
+Destruct x.
+  Destruct y.
+    Left ; Reflexivity.
+    Right; Discriminate.
+  Destruct y.
+    Right; Discriminate.
+    Left ; Reflexivity.
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+Now, consider the theorem stating the same property but for the
+following enumerated type:
+
+\begin{coq_example*}
+Inductive Set Color := Blue:Color | White:Color | Red:Color.
+Theorem decideColor : (c1,c2:Color){c1=c2}+{~c1=c2}.
+\end{coq_example*}
+
+This theorem can be proven in a very similar way, reasoning by case
+analysis on $c_1$ and $c_2$. Once more, each of the (now six) cases is
+solved either by reflexivity or by discrimination:
+
+\begin{coq_example*}
+Destruct c1. 
+  Destruct c2.
+    Left  ; Reflexivity.
+    Right ; Discriminate.
+    Right ; Discriminate.
+  Destruct c2.  
+    Right ; Discriminate.
+    Left  ; Reflexivity.
+    Right ; Discriminate.
+  Destruct c2.  
+    Right ; Discriminate.
+    Right ; Discriminate.
+    Left  ; Reflexivity.
+\end{coq_example*}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+If we face the same theorem for an enumerated datatype corresponding
+to the days of the week, it would still follow a similar pattern. In
+general, the general pattern for proving the property
+$(x,y:R)\{x=y\}+\{\neg x =y\}$ for an enumerated type $R$ proceeds as
+follow:
+\begin{enumerate}
+\item Analyze the cases for $x$. 
+\item For each of the sub-goals generated by the first step, analyze
+the cases for $y$.
+\item The remaining subgoals follow either by reflexivity or
+by discrimination.
+\end{enumerate}
+
+Let us describe how this general proof procedure can be introduced in
+\Coq.
+
+\section{Tactic Macros}
+
+The simplest way to introduce it is to define it as new a
+\textsl{tactic macro}, as follows:
+
+\begin{coq_example*}
+Tactic Definition DecideEq [$a $b] := 
+   [<:tactic:<Destruct $a;
+              Destruct $b;
+              (Left;Reflexivity) Orelse (Right;Discriminate)>>].
+\end{coq_example*}
+
+The general pattern of the proof is abstracted away using the
+tacticals ``\texttt{;}'' and \texttt{Orelse}, and introducing two
+parameters for the names of the arguments to be analyzed.
+
+Once defined, this tactic can be called like any other tactic, just
+supplying the list of terms corresponding to its real arguments. Let us
+revisit the proof of the former theorems using the new tactic
+\texttt{DecideEq}:
+
+\begin{coq_example*}
+Theorem decideBool : (x,y:bool){x=y}+{~x=y}.
+DecideEq x y.
+Defined.
+\end{coq_example*}
+\begin{coq_example*}
+Theorem decideColor : (c1,c2:Color){c1=c2}+{~c1=c2}.
+DecideEq c1 c2.
+Defined.
+\end{coq_example*}
+
+In general, the command \texttt{Tactic Definition} associates a name
+to a parameterized tactic expression, built up from the tactics and
+tacticals that are already available. The general syntax rule for this
+command is the following:
+
+\begin{tabbing}
+\texttt{Tactic Definition} \textit{tactic-name} \= 
+\texttt{[}\$$id_1\ldots \$id_n$\texttt{]}\\
+\> := \texttt{[<:tactic:<} \textit{tactic-expression} \verb+>>]+
+\end{tabbing}
+
+This command provides a quick but also very primitive mechanism for
+introducing new tactics. It does not support recursive definitions,
+and the arguments of a tactic macro are restricted to term
+expressions.  Moreover, there is no static checking of the definition
+other than the syntactical one. Any error in the definition of the
+tactic ---for instance, a call to an undefined tactic--- will not be
+noticed until the tactic is called.
+
+%This command provides a very primitive mechanism for introducing new
+%tactics. The arguments of a tactic macro are restricted to term
+%expressions.  Hence, it is not possible to define higher order tactics
+%with this command. Also, there is no static checking of the definition
+%other than syntactical. If the tactic contain errors in its definition
+%--for instance, a call to an undefined tactic-- this will be noticed
+%during the tactic call.
+
+Let us illustrate the weakness of this way of introducing new tactics
+trying to extend our proof procedure to work on a larger class of
+inductive types.  Consider for example the decidability of equality
+for pairs of booleans and colors:
+
+\begin{coq_example*}
+Theorem decideBoolXColor : (p1,p2:bool*Color){p1=p2}+{~p1=p2}.
+\end{coq_example*}
+
+The proof still proceeds by a double case analysis, but now the
+constructors of the type take two arguments. Therefore, the sub-goals
+that can not be solved by discrimination need further considerations
+about the equality of such arguments:
+
+\begin{coq_example}
+  Destruct p1;
+    Destruct p2; Try (Right;Discriminate);Intros.
+\end{coq_example}
+
+The half of the disjunction to be chosen depends on whether or not
+$b=b_0$ and $c=c_0$. These equalities can be decided automatically
+using the previous lemmas about booleans and colors. If both
+equalities are satisfied, then it is sufficient to rewrite $b$ into
+$b_0$ and $c$ into $c_0$, so that the left half of the goal follows by
+reflexivity.  Otherwise, the right half follows by first contraposing
+the disequality, and then applying the invectiveness of the pairing
+constructor.
+
+As the cases associated to each argument of the pair are very similar,
+a tactic macro can be introduced to abstract this part of the proof:
+
+\begin{coq_example*}
+Hints Resolve decideBool decideColor.
+Tactic Definition SolveArg [$t1 $t2] := 
+ [<:tactic:<
+   ElimType {$t1=$t2}+{~$t1=$t2};
+   [(Intro equality;Rewrite equality;Clear equality) |
+    (Intro diseq; Right; Red; Intro absurd;
+     Apply diseq;Injection absurd;Trivial) |
+    Auto]>>].
+\end{coq_example*}
+
+This tactic is applied to each corresponding pair of arguments of the
+arguments, until the goal can be solved by reflexivity:
+
+\begin{coq_example*}
+SolveArg b b0;
+  SolveArg c c0;
+    Left; Reflexivity.
+Defined.
+\end{coq_example*}
+
+Therefore, a more general strategy for deciding the property 
+$(x,y:R)\{x=y\}+\{\neg x =y\}$ on $R$ can be sketched as follows:
+\begin{enumerate}
+\item Eliminate $x$ and then $y$.
+\item Try discrimination to solve those goals where $x$ and $y$ has
+been introduced by different constructors.
+\item If $x$ and $y$ have been introduced by the same constructor,
+then iterate the tactic \textsl{SolveArg} for each pair of
+arguments. 
+\item Finally, solve the left half of the goal by reflexivity.
+\end{enumerate}
+
+The implementation of this stronger proof strategy needs to perform a
+term decomposition, in order to extract the list of arguments of each
+constructor. It also requires the introduction of recursively defined
+tactics, so that the \textsl{SolveArg} can be iterated on the lists of
+arguments. These features are not supported by the \texttt{Tactic
+Definition} command. One possibility could be extended this command in
+order to introduce recursion, general parameter passing,
+pattern-matching, etc, but this would quickly lead us to introduce the
+whole \ocaml{} into \Coq\footnote{This is historically true. In fact,
+\ocaml{} is a direct descendent of ML, a functional programming language
+conceived language for programming the tactics of the theorem prover
+LCF.}.  Instead of doing this, we prefer to give to the user the
+possibility of writing his/her own tactics directly in \ocaml{}, and then
+to link them dynamically with \Coq's code. This requires a minimal
+knowledge about \Coq's implementation. The next section provides an
+overview of \Coq's architecture.
+
+%It is important to point out that the introduction of a new tactic
+%never endangers the correction of the theorems proven in the extended
+%system. In order to understand why, let us introduce briefly the system
+%architecture.
+
+\section{An Overview of \Coq's Architecture}
+
+The implementation of \Coq\ is based on eight \textsl{logical
+modules}. By ``module'' we mean here a logical piece of code having a
+conceptual unity, that may concern several \ocaml{} files. By the sake of
+organization, all the \ocaml{} files concerning a logical module are
+grouped altogether into the same sub-directory. The eight modules
+are:
+
+\begin{tabular}{lll}
+1. & The logical framework           & (directory \texttt{src/generic})\\
+2. &  The language of constructions  & (directory \texttt{src/constr})\\
+3. &  The type-checker               & (directory \texttt{src/typing})\\
+4. &  The proof engine               & (directory \texttt{src/proofs})\\
+5. &  The language of basic tactics  & (directory \texttt{src/tactics})\\
+6. &  The vernacular interpreter     & (directory \texttt{src/env})\\
+7. &  The parser and the pretty-printer  & (directory \texttt{src/parsing})\\
+8. &  The standard library           & (directory \texttt{src/lib})
+\end{tabular}
+
+\vspace{1em}
+
+The following sections briefly present each of the modules above.
+This presentation is not intended to be a complete description of \Coq's
+implementation, but rather a guideline to be read before taking a look
+at the sources. For each of the modules, we also present some of its
+most important functions, which are sufficient to implement a large
+class of tactics.
+
+
+\subsection{The Logical Framework}
+\label{LogicalFramework}
+
+At the very heart of \Coq there is a generic untyped language for
+expressing abstractions, applications and global constants. This
+language is used as a meta-language for expressing the terms of the
+Calculus of Inductive Constructions. General operations on terms like
+collecting the free variables of an expression, substituting a term for
+a free variable, etc, are expressed in this language.
+
+The meta-language \texttt{'op term} of terms has seven main
+constructors:
+\begin{itemize}
+\item $(\texttt{VAR}\;id)$, a reference to a global identifier called  $id$;
+\item $(\texttt{Rel}\;n)$, a bound variable, whose binder is the $nth$
+      binder up in the term;
+\item $\texttt{DLAM}\;(x,t)$, a deBruijn's binder on the term $t$;
+\item $\texttt{DLAMV}\;(x,vt)$, a deBruijn's binder on all the terms of 
+      the vector $vt$;
+\item $(\texttt{DOP0}\;op)$, a unary operator $op$;
+\item $\texttt{DOP2}\;(op,t_1,t_2)$, the application of a binary
+operator $op$ to the terms $t_1$ and $t_2$;
+\item $\texttt{DOPN} (op,vt)$, the application of an n-ary operator $op$ to the
+vector of terms $vt$.
+\end{itemize}
+
+In this meta-language, bound variables are represented using the
+so-called deBrujin's indexes. In this representation, an occurrence of
+a bound variable is denoted by an integer, meaning the number of
+binders that must be traversed to reach its own
+binder\footnote{Actually, $(\texttt{Rel}\;n)$ means that $(n-1)$ binders
+have to be traversed, since indexes are represented by strictly
+positive integers.}. On the other hand, constants are referred by its
+name, as usual. For example, if $A$ is a variable of the current
+section, then the lambda abstraction $[x:A]x$ of the Calculus of
+Constructions is represented in the meta-language by the term:
+
+\begin{displaymath}
+(DOP2 (Lambda,(Var\;A),DLAM (x,(Rel\;1)))
+\end{displaymath}
+
+In this term, $Lambda$ is a binary operator.  Its first argument
+correspond to the type $A$ of the bound variable, while the second is
+a body of the abstraction, where $x$ is bound.  The name $x$ is just kept
+to pretty-print the occurrences of the bound variable.
+
+%Similarly, the product
+%$(A:Prop)A$ of the Calculus of Constructions is represented by the
+%term:
+%\begin{displaumath}
+%DOP2 (Prod, DOP0 (Sort (Prop Null)), DLAM (Name \#A, Rel 1))
+%\end{displaymath}
+
+The following functions perform some of the most frequent operations
+on the terms of the meta-language:
+\begin{description}
+\fun{val Generic.subst1 : 'op term -> 'op term -> 'op term}
+    {$(\texttt{subst1}\;t_1\;t_2)$ substitutes $t_1$ for 
+      $\texttt{(Rel}\;1)$ in $t_2$.}
+\fun{val Generic.occur\_var : identifier -> 'op term -> bool}
+    {Returns true when the given identifier appears in the term,
+    and false otherwise.}
+\fun{val Generic.eq\_term : 'op term -> 'op term -> bool}
+    {Implements $\alpha$-equality for terms.}  
+\fun{val Generic.dependent : 'op term -> 'op term -> bool}
+    {Returns true if the first term is a sub-term of the second.}
+%\fun{val Generic.subst\_var : identifier -> 'op term -> 'op term}
+%    { $(\texttt{subst\_var}\;id\;t)$ substitutes the deBruijn's index
+%     associated to $id$ to every occurrence of the term
+%    $(\texttt{VAR}\;id)$ in $t$.}
+\end{description}
+
+\subsubsection{Identifiers, names and sections paths.} 
+
+Three different kinds of names are used in the meta-language. They are
+all defined in the \ocaml{} file \texttt{Names}.
+
+\paragraph{Identifiers.}  The simplest kind of names are
+\textsl{identifiers}. An identifier is a string possibly indexed by an
+integer. They are used to represent names that are not unique, like
+for example the name of a variable in the scope of a section.  The
+following operations can be used for handling identifiers:
+
+\begin{description}
+\fun{val Names.make\_ident : string -> int -> identifier}
+    {The value $(\texttt{make\_ident}\;x\;i)$ creates the
+    identifier $x_i$. If $i=-1$, then the identifier has
+    is created with no index at all.}
+\fun{val Names.repr\_ident : identifier -> string * int}
+    {The inverse operation of \texttt{make\_ident}: 
+     it yields the string and the index of the identifier.}
+\fun{val Names.lift\_ident : identifier -> identifier}
+    {Increases the index of the identifier by one.}
+\fun{val Names.next\_ident\_away : \\
+\qquad identifier -> identifier list -> identifier}
+    {\\ Generates a new identifier with the same root string than the
+    given one, but with a new index, different from all the indexes of
+    a given list of identifiers.} 
+\fun{val Names.id\_of\_string : string ->
+    identifier} 
+    {Creates an identifier from a string.}  
+\fun{val  Names.string\_of\_id : identifier -> string} 
+    {The inverse operation: transforms an identifier into a string}
+\end{description}
+
+\paragraph{Names.} A \textsl{name} is either an identifier or the 
+special name \texttt{Anonymous}. Names are used as arguments of
+binders, in order to pretty print bound variables.
+The following operations can be used for handling names:
+
+\begin{description}
+\fun{val Names.Name: identifier -> Name}
+    {Constructs a name from  an identifier.}
+\fun{val Names.Anonymous : Name}
+    {Constructs a special, anonymous identifier, like the variable abstracted 
+     in the term $[\_:A]0$.}
+\fun{val
+     Names.next\_name\_away\_with\_default : \\ \qquad
+          string->name->identifier list->identifier}
+{\\ If the name is not anonymous, then this function generates a new
+    identifier different from all the ones in a given list. Otherwise, it
+    generates an identifier from the given string.}
+\end{description}
+
+\paragraph{Section paths.} 
+\label{SectionPaths}
+A \textsl{section-path} is a global name to refer to an object without
+ambiguity.  It can be seen as a sort of filename, where open sections
+play the role of directories. Each section path is formed by three
+components: a \textsl{directory} (the list of open sections); a
+\textsl{basename} (the identifier for the object); and a \textsl{kind}
+(either CCI for the terms of the Calculus of Constructions, FW for the
+the terms of $F_\omega$, or OBJ for other objects). For example, the
+name of the following constant:
+\begin{verbatim}
+     Section A.
+     Section B.
+     Section C.
+     Definition zero := O.
+\end{verbatim}
+
+is internally represented by the section path:
+
+$$\underbrace{\mathtt{\#A\#B\#C}}_{\mbox{dirpath}}
+\underbrace{\mathtt{\tt \#zero}}_{\mbox{basename}}
+\underbrace{\mathtt{\tt .cci}_{\;}}_{\mbox{kind}}$$
+
+When one of the sections is closed, a new constant is created with an
+updated section-path,a nd the old one is no longer reachable.  In our
+example, after closing the section \texttt{C}, the new section-path
+for the constant {\tt zero} becomes:
+\begin{center}
+\texttt{ \#A\#B\#zero.cci}
+\end{center}
+
+The following operations can be used to handle section paths:
+
+\begin{description}
+\fun{val Names.string\_of\_path : section\_path -> string}
+    {Transforms the section path into a string.}
+\fun{val Names.path\_of\_string : string -> section\_path}
+    {Parses a string an returns the corresponding section path.}
+\fun{val Names.basename : section\_path -> identifier}
+    {Provides the basename of a section path}
+\fun{val Names.dirpath : section\_path -> string list}
+    {Provides the directory of a section path}
+\fun{val Names.kind\_of\_path : section\_path -> path\_kind}
+    {Provides the kind of a section path}
+\end{description}
+
+\subsubsection{Signatures} 
+
+A \textsl{signature} is a mapping associating different informations
+to identifiers (for example, its type, its definition, etc). The
+following operations could be useful for working with signatures:
+
+\begin{description}
+\fun{val Names.ids\_of\_sign  : 'a signature -> identifier list}
+    {Gets the list of identifiers of the signature.}
+\fun{val Names.vals\_of\_sign : 'a signature -> 'a list}
+    {Gets the list of values associated to the identifiers of the signature.}
+\fun{val Names.lookup\_glob1 : \\ \qquad
+identifier -> 'a signature -> (identifier *
+    'a)}
+    {\\ Gets the value associated to a given identifier of the signature.}
+\end{description}
+
+
+\subsection{The Terms of the Calculus of Constructions}
+
+The language of the Calculus of Inductive Constructions described in
+Chapter \ref{Cic} is implemented on the top of the logical framework,
+instantiating the parameter $op$ of the meta-language with a
+particular set of operators.  In the implementation this language is
+called \texttt{constr}, the language of constructions.
+
+% The only difference
+%with respect to the one described in Section \ref{} is that the terms
+%of \texttt{constr} may contain \textsl{existential variables}. An
+%existential variable is a place holder representing a part of the term
+%that is still to be constructed. Such ``open terms'' are necessary
+%when building proofs interactively.
+
+\subsubsection{Building Constructions}
+
+The user does not need to know the choices made to represent
+\texttt{constr} in the meta-language. They are abstracted away by the
+following constructor functions:
+
+\begin{description}
+\fun{val Term.mkRel          : int -> constr}
+    {$(\texttt{mkRel}\;n)$ represents deBrujin's index $n$.}
+
+\fun{val Term.mkVar : identifier -> constr} 
+    {$(\texttt{mkVar}\;id)$
+    represents a global identifier named $id$, like a variable
+    inside the scope of a section, or a hypothesis in a proof}.
+
+\fun{val Term.mkExistential : constr} 
+   {\texttt{mkExistential} represents an implicit sub-term, like the question
+    marks in the term \texttt{(pair ? ? O true)}.}
+
+%\fun{val Term.mkMeta         : int -> constr}
+%    {$(\texttt{mkMeta}\;n)$ represents an existential variable, whose
+%     name is the integer $n$.}
+
+\fun{val Term.mkProp         : constr}
+    {$\texttt{mkProp}$ represents the sort \textsl{Prop}.}
+
+\fun{val Term.mkSet          : constr}
+    {$\texttt{mkSet}$ represents the sort \textsl{Set}.}
+
+\fun{val Term.mkType         : Impuniv.universe -> constr}
+    {$(\texttt{mkType}\;u)$ represents the term
+    $\textsl{Type}(u)$. The universe $u$ is represented as a 
+    section path indexed by an integer. }
+
+\fun{val Term.mkConst : section\_path -> constr array -> constr}
+    {$(\texttt{mkConst}\;c\;v)$ represents a constant whose name is
+    $c$. The body of the constant is stored in a global table,
+    accessible through the name of the constant. The array of terms
+    $v$ corresponds to the variables of the environment appearing in
+    the body of the constant when it was defined. For instance, a
+    constant defined in the section \textsl{Foo} containing the
+    variable $A$, and whose body is $[x:Prop\ra Prop](x\;A)$ is
+    represented inside the scope of the section by
+    $(\texttt{mkConst}\;\texttt{\#foo\#f.cci}\;[| \texttt{mkVAR}\;A
+    |])$.  Once the section is closed, the constant is represented by
+    the term $(\texttt{mkConst}\;\#f.cci\;[| |])$, and its body
+    becomes $[A:Prop][x:Prop\ra Prop](x\;A)$}.
+
+\fun{val Term.mkMutInd : section\_path -> int -> constr array ->constr}
+    {$(\texttt{mkMutInd}\;c\;i)$ represents the $ith$ type
+    (starting from zero) of the block of mutually dependent
+    (co)inductive types, whose first type is $c$.  Similarly to the
+    case of constants, the array of terms represents the current
+    environment of the (co)inductive type. The definition of the type
+    (its arity, its constructors, whether it is inductive or co-inductive, etc.)
+    is stored in a global hash table, accessible through the name of 
+    the type.}
+
+\fun{val Term.mkMutConstruct : \\ \qquad section\_path -> int -> int -> constr array
+    ->constr} {\\ $(\texttt{mkMutConstruct}\;c\;i\;j)$ represents the
+    $jth$ constructor of the $ith$ type of the block of mutually
+    dependent (co)inductive types whose first type is $c$. The array
+    of terms represents the current environment of the (co)inductive
+    type.}
+
+\fun{val Term.mkCast : constr -> constr -> constr}
+    {$(\texttt{mkCast}\;t\;T)$ represents the annotated term $t::T$ in
+    \Coq's syntax.}  
+
+\fun{val Term.mkProd : name ->constr ->constr -> constr}
+    {$(\texttt{mkProd}\;x\;A\;B)$ represents the product $(x:A)B$.
+     The free ocurrences of $x$ in $B$ are represented by deBrujin's
+     indexes.}
+
+\fun{val Term.mkNamedProd : identifier -> constr -> constr -> constr}
+    {$(\texttt{produit}\;x\;A\;B)$ represents the product $(x:A)B$,
+     but the bound occurrences of $x$ in $B$ are denoted by 
+     the identifier $(\texttt{mkVar}\;x)$. The function automatically 
+     changes each occurrences of this identifier into the corresponding 
+     deBrujin's index.}
+
+\fun{val Term.mkArrow : constr -> constr -> constr}
+    {$(\texttt{arrow}\;A\;B)$ represents the type $(A\rightarrow B)$.}
+
+\fun{val Term.mkLambda       : name -> constr -> constr -> constr}
+    {$(\texttt{mkLambda}\;x\;A\;b)$ represents the lambda abstraction 
+     $[x:A]b$. The free ocurrences of $x$ in $B$ are represented by deBrujin's
+     indexes.}
+
+\fun{val Term.mkNamedLambda : identifier -> constr -> constr -> constr}
+    {$(\texttt{lambda}\;x\;A\;b)$ represents the lambda abstraction 
+     $[x:A]b$, but the bound occurrences of $x$ in $B$ are denoted by 
+     the identifier $(\texttt{mkVar}\;x)$. }
+
+\fun{val Term.mkAppLA        : constr array -> constr}
+    {$(\texttt{mkAppLA}\;t\;[|t_1\ldots t_n|])$ represents the application
+    $(t\;t_1\;\ldots t_n)$.}
+
+\fun{val Term.mkMutCaseA : \\ \qquad
+    case\_info -> constr ->constr
+    ->constr array -> constr} 
+    {\\ $(\texttt{mkMutCaseA}\;r\;P\;m\;[|f_1\ldots f_n|])$
+    represents the term \Case{P}{m}{f_1\ldots f_n}. The first argument
+    $r$ is either \texttt{None} or $\texttt{Some}\;(c,i)$, where the
+    pair $(c,i)$ refers to the inductive type that $m$ belongs to.}
+
+\fun{val Term.mkFix :  \\ \qquad
+int array->int->constr array->name
+    list->constr array->constr}
+    {\\ $(\texttt{mkFix}\;[|k_1\ldots k_n |]\;i\;[|A_1\ldots
+    A_n|]\;[|f_1\ldots f_n|]\;[|t_1\ldots t_n|])$ represents the term
+    $\Fix{f_i}{f_1/k_1:A_1:=t_1 \ldots f_n/k_n:A_n:=t_n}$}
+
+\fun{val Term.mkCoFix  : \\ \qquad
+    int -> constr array -> name list ->
+    constr array -> constr}
+    {\\ $(\texttt{mkCoFix}\;i\;[|A_1\ldots
+    A_n|]\;[|f_1\ldots f_n|]\;[|t_1\ldots t_n|])$ represents the term
+    $\CoFix{f_i}{f_1:A_1:=t_1 \ldots f_n:A_n:=t_n}$. There are no
+    decreasing indexes in this case.}
+\end{description}
+
+\subsubsection{Decomposing Constructions}
+
+Each of the construction functions above has its corresponding
+(partial) destruction function, whose name is obtained changing the
+prefix \texttt{mk} by \texttt{dest}. In addition to these functions, a
+concrete datatype \texttt{kindOfTerm} can be used to do pattern
+matching on terms without dealing with their internal representation
+in the meta-language. This concrete datatype is described in the \ocaml{}
+file \texttt{term.mli}. The following function transforms a construction
+into an element of type \texttt{kindOfTerm}:
+
+\begin{description}
+\fun{val Term.kind\_of\_term : constr -> kindOfTerm}
+    {Destructs a term of the language \texttt{constr},
+yielding the direct components of the term. Hence, in order to do 
+pattern matching on an object $c$ of \texttt{constr}, it is sufficient
+to do pattern matching on the value $(\texttt{kind\_of\_term}\;c)$.}
+\end{description}
+
+Part of the information associated to the constants is stored in 
+global tables. The following functions give access to such 
+information:
+
+\begin{description}
+\fun{val Termenv.constant\_value    : constr -> constr}
+    {If the term denotes a constant, projects the body of a constant}
+\fun{Termenv.constant\_type     : constr -> constr}
+    {If the term denotes a constant, projects the type of the constant}
+\fun{val mind\_arity        : constr -> constr}
+    {If the term denotes an inductive type, projects its arity (i.e.,
+     the type of the inductive type).}
+\fun{val Termenv.mis\_is\_finite    : mind\_specif -> bool}
+    {Determines whether a recursive type is inductive or co-inductive.}
+\fun{val Termenv.mind\_nparams : constr -> int}
+    {If the term denotes an inductive type, projects the number of 
+     its general parameters.}
+\fun{val Termenv.mind\_is\_recursive : constr -> bool}
+    {If the term denotes an inductive type, 
+     determines if the type has at least one recursive constructor. }
+\fun{val Termenv.mind\_recargs : constr -> recarg list array array}
+    {If the term denotes an inductive type, returns an array $v$ such 
+     that the nth element of $v.(i).(j)$ is
+    \texttt{Mrec} if the $nth$ argument of the $jth$ constructor of
+    the $ith$ type is recursive, and \texttt{Norec} if it is not.}.
+\end{description}
+
+\subsection{The Type Checker}
+\label{TypeChecker}
+
+The third logical module is the type checker. It concentrates two main
+tasks concerning the language of constructions.
+
+On one hand, it contains the type inference and type-checking
+functions.  The type inference function takes a term
+$a$ and a signature $\Gamma$, and yields a term $A$ such that
+$\Gamma \vdash a:A$.  The type-checking function takes two terms $a$
+and $A$ and a signature $\Gamma$, and determines whether or not
+$\Gamma \vdash a:A$.
+
+On the other hand, this module is in charge of the compilation of
+\Coq's abstract syntax trees into the language \texttt{constr} of
+constructions. This compilation seeks to eliminate all the ambiguities
+contained in \Coq's abstract syntax, restoring the information
+necessary to type-check it.  It concerns at least the following steps:
+\begin{enumerate}
+\item Compiling the pattern-matching expressions containing 
+constructor patterns, wild-cards, etc, into terms that only
+use the primitive \textsl{Case} described in Chapter \ref{Cic}
+\item Restoring type coercions and synthesizing the implicit arguments
+(the one denoted by question marks in
+{\Coq} syntax: cf section \ref{Coercions}).
+\item Transforming the named bound variables into deBrujin's indexes.
+\item Classifying the global names into the different classes of
+constants (defined constants, constructors, inductive types, etc).
+\end{enumerate}
+
+\subsection{The Proof Engine}
+
+The fourth stage of \Coq's implementation is the \textsl{proof engine}:
+the interactive machine for constructing proofs. The aim of the proof
+engine is to construct a top-down derivation or \textsl{proof tree},
+by the application of \textsl{tactics}. A proof tree has the following
+general structure:\\
+
+\begin{displaymath}
+\frac{\Gamma \vdash ? = t(?_1,\ldots?_n) : G}
+     {\hspace{3ex}\frac{\displaystyle \Gamma_1 \vdash ?_1 = t_1(\ldots) : G_1}
+         {\stackrel{\vdots}{\displaystyle {\Gamma_{i_1} \vdash ?_{i_1} 
+           : G_{i_1}}}}(tac_1)
+      \;\;\;\;\;\;\;\;\;
+      \frac{\displaystyle \Gamma_n \vdash ?_n = t_n(\ldots) : G_n}
+         {\displaystyle \stackrel{\vdots}{\displaystyle {\Gamma_{i_m} \vdash ?_{i_m} :
+     G_{i_m}}}}(tac_n)} (tac)    
+\end{displaymath}
+
+
+\noindent Each node of the tree is called a \textsl{goal}. A goal
+is a record type containing the following three fields:
+\begin{enumerate}
+\item the conclusion $G$ to be proven;
+\item a typing signature $\Gamma$ for the free variables in $G$;
+\item if the goal is an internal node of the proof tree, the
+definition $t(?_1,\ldots?_n)$ of an \textsl{existential variable}
+(i.e. a possible undefined constant) $?$ of type $G$ in terms of the
+existential variables of the children sub-goals. If the node is a
+leaf, the existential variable maybe still undefined.
+\end{enumerate}
+
+Once all the existential variables have been defined the derivation is
+completed, and a construction can be generated from the proof tree,
+replacing each of the existential variables by its definition.  This
+is exactly what happens when one of the commands
+\texttt{Qed}, \texttt{Save} or \texttt{Defined} is invoked
+(cf. Section \ref{Qed}). The saved theorem becomes a defined constant,
+whose body is the proof object generated.
+
+\paragraph{Important:} Before being added to the
+context, the proof object is type-checked, in order to verify that it is
+actually an object of the expected type $G$.  Hence, the correctness
+of the proof actually does not depend on the tactics applied to
+generate it or the machinery of the proof engine, but only on the
+type-checker. In other words, extending the system with a potentially
+bugged new tactic never endangers the consistency of the system.
+
+\subsubsection{What is a Tactic?}
+\label{WhatIsATactic}
+%Let us now explain what is a tactic, and how the user can introduce
+%new ones. 
+
+From an operational point of view, the current state of the proof
+engine is given by the mapping $emap$ from existential variables into
+goals, plus a pointer to one of the leaf goals $g$.  Such a pointer
+indicates where the proof tree will be refined by the application of a
+\textsl{tactic}. A tactic is a function from the current state
+$(g,emap)$ of the proof engine into a pair $(l,val)$. The first
+component of this pair is the list of children sub-goals $g_1,\ldots
+g_n$ of $g$ to be yielded by the tactic. The second one is a
+\textsl{validation function}. Once the proof trees $\pi_1,\ldots
+\pi_n$ for $g_1,\ldots g_n$ have been completed, this validation
+function must yield a proof tree $(val\;\pi_1,\ldots \pi_n)$ deriving
+$g$.
+
+Tactics can be classified into \textsl{primitive} ones and
+\textsl{defined} ones. Primitive tactics correspond to the five basic
+operations of the proof engine:
+
+\begin{enumerate}
+\item Introducing a universally quantified variable into the local
+context of the goal.
+\item Defining an undefined existential variable 
+\item Changing the conclusion of the goal for another
+--definitionally equal-- term.
+\item Changing the type of a variable in the local context for another
+definitionally equal term.
+\item Erasing a variable from the local context.
+\end{enumerate}
+
+\textsl{Defined} tactics are tactics constructed by combining these
+primitive operations.  Defined tactics are registered in a hash table,
+so that they can be introduced dynamically. In order to define such a
+tactic table, it is necessary to fix what a \textsl{possible argument}
+of a tactic may be. The type \texttt{tactic\_arg} of the possible
+arguments for tactics is a union type including:
+\begin{itemize}
+\item quoted strings;
+\item integers;
+\item identifiers;
+\item lists of identifiers;
+\item plain terms, represented by its abstract syntax tree;
+\item well-typed terms, represented by a construction;
+\item a substitution for bound variables, like the
+substitution in the tactic \\$\texttt{Apply}\;t\;\texttt{with}\;x:=t_1\ldots
+x_n:=t_n$, (cf. Section~\ref{apply});
+\item a reduction expression, denoting the reduction strategy to be
+followed.
+\end{itemize}
+Therefore, for each function $tac:a \rightarrow tactic$ implementing a
+defined tactic, an associated dynamic tactic $tacargs\_tac:
+\texttt{tactic\_arg}\;list \rightarrow tactic$ calling $tac$ must be
+written. The aim of the auxiliary function $tacargs\_tac$ is to inject
+the arguments of the tactic $tac$ into the type of possible arguments
+for a tactic.
+
+The following function can be used for registering and calling a
+defined tactic:
+
+\begin{description}
+\fun{val Tacmach.add\_tactic : \\ \qquad
+string -> (tactic\_arg list ->tactic) -> unit}
+    {\\ Registers a dynamic tactic with the given string as access index.}
+\fun{val Tacinterp.vernac\_tactic : string*tactic\_arg list -> tactic}
+    {Interprets a defined tactic given by its entry in the
+     tactics table with a particular list of possible arguments.}
+\fun{val Tacinterp.vernac\_interp        : CoqAst.t -> tactic}
+    {Interprets a tactic expression formed combining \Coq's tactics and
+          tacticals, and described by its abstract syntax tree.}
+\end{description}
+
+When programming a new tactic that calls an already defined tactic
+$tac$, we have the choice between using the \ocaml{} function
+implementing $tac$, or calling the tactic interpreter with the name
+and arguments for interpreting $tac$. In the first case, a tactic call
+will left the trace of the whole implementation of $tac$ in the proof
+tree. In the second, the implementation of $tac$ will be hidden, and
+only an invocation of $tac$ will be recalled (cf. the example of
+Section \ref{ACompleteExample}.  The following combinators can be used
+to hide the implementation of a tactic:
+
+\begin{verbatim}
+type 'a hiding_combinator = string -> ('a -> tactic) -> ('a -> tactic)
+val Tacmach.hide_atomic_tactic  : string -> tactic -> tactic
+val Tacmach.hide_constr_tactic  : constr          hiding_combinator
+val Tacmach.hide_constrl_tactic : (constr list)   hiding_combinator
+val Tacmach.hide_numarg_tactic  : int             hiding_combinator
+val Tacmach.hide_ident_tactic   : identifier      hiding_combinator
+val Tacmach.hide_identl_tactic  : identifier      hiding_combinator
+val Tacmach.hide_string_tactic  : string          hiding_combinator
+val Tacmach.hide_bindl_tactic   : substitution    hiding_combinator
+val Tacmach.hide_cbindl_tactic  : 
+          (constr * substitution) hiding_combinator
+\end{verbatim}
+
+These functions first register the tactic by a side effect, and then
+yield a function calling the interpreter with the registered name and
+the right injection into the type of possible arguments.
+
+\subsection{Tactics and Tacticals Provided by \Coq}
+
+The fifth logical module is the library of tacticals and basic tactics
+provided by \Coq. This library is distributed into the directories
+\texttt{tactics} and \texttt{src/tactics}. The former contains those
+basic tactics that make use of the types contained in the basic state
+of \Coq. For example, inversion or rewriting tactics are in the
+directory \texttt{tactics}, since they make use of the propositional
+equality type.  Those tactics which are independent from the context
+--like for example \texttt{Cut}, \texttt{Intros}, etc-- are defined in
+the directory \texttt{src/tactics}. This latter directory also
+contains some useful tools for programming new tactics, referred in 
+Section \ref{SomeUsefulToolsforWrittingTactics}.
+
+In practice, it is very unusual that the list of sub-goals and the
+validation function of the tactic must be explicitly constructed by
+the user. In most of the cases, the implementation of a new tactic
+consists in supplying the appropriate arguments to the basic tactics
+and tacticals.
+
+\subsubsection{Basic Tactics}
+
+The file \texttt{Tactics} contain the implementation of the basic
+tactics provided by \Coq. The following tactics are some of the most
+used ones:
+
+\begin{verbatim}
+val Tactics.intro           : tactic
+val Tactics.assumption      : tactic
+val Tactics.clear           : identifier list -> tactic
+val Tactics.apply           : constr -> constr substitution -> tactic
+val Tactics.one_constructor : int -> constr substitution -> tactic
+val Tactics.simplest_elim   : constr -> tactic
+val Tactics.elimType        : constr -> tactic
+val Tactics.simplest_case   : constr -> tactic
+val Tactics.caseType        : constr -> tactic
+val Tactics.cut             : constr -> tactic
+val Tactics.reduce          : redexpr -> tactic
+val Tactics.exact           : constr -> tactic
+val Auto.auto               : int option -> tactic
+val Auto.trivial            : tactic
+\end{verbatim}
+
+The functions hiding the implementation of these tactics are defined
+in the module \texttt{Hiddentac}. Their names are prefixed by ``h\_''.
+
+\subsubsection{Tacticals}
+\label{OcamlTacticals}
+
+The following tacticals can be used to combine already existing
+tactics:
+
+\begin{description}
+\fun{val Tacticals.tclIDTAC : tactic}
+    {The identity tactic: it leaves the goal as it is.}
+
+\fun{val Tacticals.tclORELSE : tactic -> tactic -> tactic}
+    {Tries the first tactic and in case of failure applies the second one.}
+
+\fun{val Tacticals.tclTHEN : tactic -> tactic -> tactic}
+  {Applies the first tactic and then the second one to each generated subgoal.}
+
+\fun{val Tacticals.tclTHENS : tactic -> tactic list -> tactic}
+    {Applies a tactic, and then applies each tactic of the tactic list to the
+     corresponding generated subgoal.}
+
+\fun{val Tacticals.tclTHENL : tactic -> tactic -> tactic}
+    {Applies the first tactic, and then applies the second one to the last
+     generated subgoal.}
+
+\fun{val Tacticals.tclREPEAT : tactic -> tactic}
+    {If the given tactic succeeds in producing a subgoal, then it
+     is recursively applied to each generated subgoal, 
+     and so on until it fails. }
+
+\fun{val Tacticals.tclFIRST : tactic list -> tactic}
+    {Tries the tactics of the given list one by one, until one of them
+     succeeds.}
+
+\fun{val Tacticals.tclTRY : tactic -> tactic}
+    {Tries the given tactic and in case of failure applies the {\tt
+    tclIDTAC} tactical to the original goal.}
+
+\fun{val Tacticals.tclDO : int -> tactic -> tactic}
+    {Applies the tactic a given number of times.}
+
+\fun{val Tacticals.tclFAIL : tactic}
+    {The always failing tactic: it raises a {\tt UserError} exception.}
+
+\fun{val Tacticals.tclPROGRESS  : tactic -> tactic}
+    {Applies the given tactic to the current goal and fails if the 
+     tactic leaves the goal unchanged}
+
+\fun{val Tacticals.tclNTH\_HYP :  int -> (constr -> tactic) -> tactic}
+    {Applies a tactic to the nth hypothesis of the local context.
+     The last hypothesis introduced correspond to the integer 1.}
+
+\fun{val Tacticals.tclLAST\_HYP :  (constr -> tactic) -> tactic}
+    {Applies a tactic to the last hypothesis introduced.}
+
+\fun{val Tacticals.tclCOMPLETE : tactic -> tactic}
+    {Applies a tactic and fails if the tactic did not solve completely the
+      goal}
+
+\fun{val Tacticals.tclMAP : ('a -> tactic) -> 'a list -> tactic}
+    {Applied to the function \texttt{f} and the list \texttt{[x\_1;
+        ... ; x\_n]}, this tactical applies the tactic
+      \texttt{tclTHEN (f x1) (tclTHEN (f x2) ... ))))}}
+    
+\fun{val Tacicals.tclIF : (goal sigma -> bool) -> tactic -> tactic -> tactic}
+    {If the condition holds, apply the first tactic; otherwise,
+      apply the second one}
+
+\end{description}
+
+
+\subsection{The Vernacular Interpreter}
+
+The sixth logical module of the implementation corresponds to the
+interpreter of the vernacular phrases of \Coq. These phrases may be
+expressions from the \gallina{} language (definitions), general
+directives (setting commands) or tactics to be applied by the proof
+engine. 
+
+\subsection{The Parser and the Pretty-Printer}
+\label{PrettyPrinter}
+
+The last logical module is the parser and pretty printer of \Coq,
+which is the interface between the vernacular interpreter and the
+user. They translate the chains of characters entered at the input
+into abstract syntax trees, and vice versa. Abstract syntax trees are
+represented by labeled n-ary trees, and its type is called
+\texttt{CoqAst.t}.  For instance, the abstract syntax tree associated
+to the term $[x:A]x$ is:
+
+\begin{displaymath}
+\texttt{Node}
+ ((0,6), "LAMBDA",
+  [\texttt{Nvar}~((3, 4),"A");~\texttt{Slam}~((0,6),~Some~"x",~\texttt{Nvar}~((5,6),"x"))])
+\end{displaymath}
+
+The numbers correspond to \textsl{locations}, used to point to some
+input line and character positions in the error messages. As it was
+already explained in Section \ref{TypeChecker}, this term is then
+translated into a construction term in order to be typed.
+
+The parser of \Coq\ is implemented using \camlpppp. The lexer and the data
+used by \camlpppp\ to generate the parser lay in the directory
+\texttt{src/parsing}.  This directory also contains \Coq's
+pretty-printer. The printing rules lay in the directory
+\texttt{src/syntax}.  The different entries of the grammar are
+described in the module \texttt{Pcoq.Entry}.  Let us present here two
+important functions of this logical module:
+
+\begin{description}
+\fun{val Pcoq.parse\_string : 'a Grammar.Entry.e -> string -> 'a}
+    {Parses a given string, trying to recognize a phrase
+     corresponding to some entry in the grammar. If it succeeds,
+     it yields a value associated to the grammar entry. For example,
+     applied to the entry \texttt{Pcoq.Command.command}, this function
+    parses a term of \Coq's language, and yields a value of type 
+    \texttt{CoqAst.t}. When applied to the entry
+    \texttt{Pcoq.Vernac.vernac}, it parses a vernacular command and
+    returns the corresponding Ast.}
+\fun{val gentermpr       : \\ \qquad 
+path\_kind -> constr assumptions -> constr -> std\_ppcmds}
+    {\\ Pretty-prints a well-typed term of certain kind (cf. Section
+    \ref{SectionPaths}) under its context of typing assumption.}
+\fun{val gentacpr        : CoqAst.t -> std\_ppcmds}
+    {Pretty-prints a given abstract syntax tree representing a tactic
+     expression.}
+\end{description}
+
+\subsection{The General Library}
+
+In addition to the ones laying in the standard library of \ocaml{},
+several useful modules about lists, arrays, sets, mappings, balanced
+trees, and other frequently used data structures can be found in the
+directory \texttt{lib}. Before writing a new one, check if it is not
+already there!
+
+\subsubsection{The module \texttt{Std}}
+This module in the directory \texttt{src/lib/util} is opened by almost 
+all modules of \Coq{}. Among other things, it contains a definition of 
+the different kinds of errors used in \Coq{} :
+
+\begin{description}
+\fun{exception UserError of string * std\_ppcmds}
+    {This is the class of ``users exceptions''. Such errors arise when 
+      the user attempts to do something illegal, for example \texttt{Intro}
+      when the current goal conclusion is not a product.}
+
+\fun{val Std.error : string -> 'a}
+    {For simple error messages}
+\fun{val Std.errorlabstrm : string -> std\_ppcmds -> 'a}
+    {See section \ref{PrettyPrinter} : this can be used if the user
+      want to display a term or build a complex error message}
+
+\fun{exception Anomaly of string * std\_ppcmds}
+    {This for reporting bugs or things that should not
+      happen. The tacticals \texttt{tclTRY} and
+      \texttt{tclTRY} described in section \ref{OcamlTacticals} catch the
+      exceptions of type \texttt{UserError}, but they don't catch the
+      anomalies. So, in your code, don't raise any anomaly, unless you
+      know what you are doing. We also recommend to avoid constructs
+      such as \texttt{try ... with \_ -> ...} : such constructs can trap 
+      an anomaly and make the debugging process harder.}
+
+\fun{val Std.anomaly : string -> 'a}{}
+\fun{val Std.anomalylabstrm : string -> std\_ppcmds -> 'a}{}
+\end{description}
+
+\section{The tactic writer mini-HOWTO}
+
+\subsection{How to add a vernacular command}
+
+The command to register a vernacular command can be found
+in module \texttt{Vernacinterp}:
+
+\begin{verbatim}
+val vinterp_add : string * (vernac_arg list -> unit -> unit) -> unit;;
+\end{verbatim}
+
+The first argument is the name, the second argument is a function that
+parses the arguments and returns a function of type
+\texttt{unit}$\rightarrow$\texttt{unit} that do the job.
+
+In this section we will show how to add a vernacular command
+\texttt{CheckCheck} that print a type of a term and the type of its
+type.
+
+File \texttt{dcheck.ml}:
+
+\begin{verbatim}
+open Vernacinterp;;
+open Trad;;
+let _ = 
+  vinterp_add 
+   ("DblCheck",
+    function [VARG_COMMAND com] ->
+       (fun () -> 
+          let evmap = Evd.mt_evd () 
+          and sign = Termenv.initial_sign () in
+           let {vAL=c;tYP=t;kIND=k} = 
+                 fconstruct_with_univ evmap sign com in
+             Pp.mSGNL [< Printer.prterm c; 'sTR ":"; 
+                       Printer.prterm t; 'sTR ":"; 
+                       Printer.prterm k >] )
+      | _ -> bad_vernac_args "DblCheck")
+;;
+\end{verbatim}
+
+Like for a new tactic, a new syntax entry must be created.
+
+File \texttt{DCheck.v}:
+
+\begin{verbatim}
+Declare ML Module "dcheck.ml".
+
+Grammar vernac vernac := 
+  dblcheck [ "CheckCheck" comarg($c) ] -> [(DblCheck $c)].
+\end{verbatim}
+
+We are now able to test our new command:
+
+\begin{verbatim}
+Coq < Require DCheck.
+Coq < CheckCheck O.
+O:nat:Set
+\end{verbatim}
+
+Most Coq vernacular commands are registered in the module 
+  \verb+src/env/vernacentries.ml+. One can see more examples here.
+
+\subsection{How to keep a hashtable synchronous with the reset mechanism}
+
+This is far more tricky. Some vernacular commands modify some
+sort of state (for example by adding something in a hashtable). One
+wants that \texttt{Reset} has the expected behavior with this
+commands.
+
+\Coq{} provides a general mechanism to do that. \Coq{} environments
+contains objects of three kinds: CCI, FW and OBJ. CCI and FW are for
+constants of the calculus. OBJ is a dynamically extensible datatype
+that contains sections, tactic definitions, hints for auto, and so
+on. 
+
+The simplest example of use of such a mechanism is in file
+\verb+src/proofs/macros.ml+ (which implements the \texttt{Tactic
+  Definition} command). Tactic macros are stored in the imperative
+hashtable \texttt{mactab}. There are two functions freeze and unfreeze
+to make a copy of the table and to restore the state of table from the
+copy. Then this table is declared using \texttt{Library.declare\_summary}.
+
+What does \Coq{} with that ? \Coq{} defines synchronization points.
+At each synchronisation point, the declared tables are frozen (that
+is, a copy of this tables is stored).
+
+When \texttt{Reset }$i$ is called, \Coq{} goes back to the first
+synchronisation point that is above $i$ and ``replays'' all objects
+between that point 
+and $i$. It will re-declare constants, re-open section, etc.
+
+So we need to declare a new type of objects, TACTIC-MACRO-DATA. To
+``replay'' on object of that type is to add the corresponding tactic
+macro to \texttt{mactab}
+
+So, now, we can say that \texttt{mactab} is synchronous with the Reset
+mechanism$^{\mathrm{TM}}$.
+
+Notice that this works for hash tables but also for a single integer
+(the Undo stack size, modified by the \texttt{Set Undo} command, for
+example).
+
+\subsection{The right way to access to Coq constants from your ML code}
+
+With their long names, Coq constants are stored using:
+
+\begin{itemize}
+\item a section path
+\item an identifier
+\end{itemize}
+
+The identifier is exactly the identifier that is used in \Coq{} to
+denote the constant; the section path can be known using the
+\texttt{Locate} command:
+
+\begin{coq_example}
+  Locate S.
+  Locate nat.
+  Locate eq.
+\end{coq_example}
+
+Now it is easy to get a constant by its name and section path:
+
+
+\begin{verbatim}
+let constant sp id = 
+  Machops.global_reference (Names.gLOB (Termenv.initial_sign ())) 
+    (Names.path_of_string sp) (Names.id_of_string id);;
+\end{verbatim}
+
+
+The only issue is that if one cannot put:
+
+
+\begin{verbatim}
+let coq_S = constant "#Datatypes#nat.cci" "S";;
+\end{verbatim}
+
+
+in his tactic's code. That is because this sentence is evaluated
+\emph{before} the module \texttt{Datatypes} is loaded. The solution is
+to use the lazy evaluation of \ocaml{}:
+
+
+\begin{verbatim}
+let coq_S = lazy (constant "#Datatypes#nat.cci" "S");;
+
+... (Lazy.force coq_S) ...
+\end{verbatim}
+
+
+Be sure to call always Lazy.force behind a closure -- i.e. inside a
+function body or behind the \texttt{lazy} keyword.
+
+One can see examples of that technique in the source code of \Coq{},
+for example 
+\verb+tactics/contrib/polynom/ring.ml+ or 
+\verb+tactics/contrib/polynom/coq_omega.ml+.
+
+\section{Some Useful Tools for Writing Tactics}
+\label{SomeUsefulToolsforWrittingTactics}
+When the implementation of a tactic is not a straightforward
+combination of tactics and tacticals, the module \texttt{Tacmach}
+provides several useful functions for handling goals, calling the
+type-checker, parsing terms, etc. This module is intended to be 
+the interface of the proof engine for the user.
+
+\begin{description}
+\fun{val Tacmach.pf\_hyps               : goal sigma -> constr signature}
+    {Projects the local typing context $\Gamma$ from a given goal $\Gamma\vdash ?:G$.} 
+\fun{val pf\_concl              : goal sigma -> constr}
+    {Projects the conclusion $G$ from a given goal $\Gamma\vdash ?:G$.}
+\fun{val Tacmach.pf\_nth\_hyp            : goal sigma -> int -> identifier *
+    constr}
+    {Projects the $ith$ typing constraint $x_i:A_i$ from the local
+     context of the given goal.}
+\fun{val Tacmach.pf\_fexecute           : goal sigma -> constr -> judgement}
+    {Given a goal whose local context is $\Gamma$ and a term $a$, this
+     function infers a type $A$ and a kind $K$ such that the judgement
+     $a:A:K$ is valid under $\Gamma$, or raises an exception if there
+     is no such judgement. A judgement is just a record type containing
+     the three terms $a$, $A$ and $K$.}
+\fun{val Tacmach.pf\_infexecute : \\
+     \qquad
+goal sigma -> constr -> judgement * information}
+    {\\ In addition to the typing judgement, this function also extracts 
+     the $F_{\omega}$ program underlying the term.}
+\fun{val Tacmach.pf\_type\_of            : goal sigma -> constr -> constr}
+    {Infers a term $A$ such that $\Gamma\vdash a:A$ for a given term
+    $a$, where $\Gamma$ is the local typing context of the goal.}
+\fun{val Tacmach.pf\_check\_type         : goal sigma -> constr -> constr -> bool}
+    {This function yields a type $A$ if the two given terms $a$ and $A$  verify $\Gamma\vdash
+     a:A$ in the local typing context $\Gamma$ of the goal. Otherwise,
+    it raises an exception.}
+\fun{val Tacmach.pf\_constr\_of\_com      : goal sigma -> CoqAst.t -> constr}
+    {Transforms an abstract syntax tree into a well-typed term of the
+    language of constructions. Raises an exception if the term cannot
+    be typed.}
+\fun{val Tacmach.pf\_constr\_of\_com\_sort : goal sigma -> CoqAst.t -> constr}
+    {Transforms an abstract syntax tree representing a type into
+    a well-typed term of the language of constructions. Raises an
+    exception if the term cannot be typed.}
+\fun{val Tacmach.pf\_parse\_const        : goal sigma -> string -> constr}
+    {Constructs the constant whose name is the given string.}
+\fun{val
+Tacmach.pf\_reduction\_of\_redexp  : \\
+         \qquad goal sigma -> red\_expr -> constr -> constr}
+    {\\ Applies a certain kind of reduction function, specified by an
+     element of the type red\_expr.}
+\fun{val Tacmach.pf\_conv\_x      : goal sigma -> constr -> constr -> bool}
+    {Test whether  two given terms are definitionally equal.}
+\end{description}
+
+\subsection{Patterns}
+\label{Patterns}
+
+The \ocaml{} file \texttt{Pattern} provides a quick way for describing a
+term pattern and performing second-order, binding-preserving, matching
+on it. Patterns are described using an extension of \Coq's concrete
+syntax, where the second-order meta-variables of the pattern are
+denoted by indexed question marks. 
+
+Patterns may depend on constants, and therefore only to make have
+sense when certain theories have been loaded. For this reason, they
+are stored with a \textsl{module-marker}, telling us which modules
+have to be open in order to use the pattern. The following functions
+can be used to store and retrieve patterns form the pattern table:
+
+\begin{description}
+\fun{val Pattern.make\_module\_marker : string list -> module\_mark}
+    {Constructs a module marker from a list of module names.}
+\fun{val Pattern.put\_pat : module\_mark -> string -> marked\_term}
+    {Constructs a pattern from a parseable string containing holes
+     and a module marker.}
+\fun{val Pattern.somatches    : constr ->   marked\_term-> bool}
+    {Tests if a term matches a pattern.} 
+\fun{val dest\_somatch : constr -> marked\_term -> constr list}
+    {If the term matches the pattern, yields the list of sub-terms
+     matching the occurrences of the pattern variables (ordered from
+     left to right). Raises a \texttt{UserError} exception if the term
+     does not match the pattern.} 
+\fun{val Pattern.soinstance : marked\_term -> constr list -> constr} 
+    {Substitutes each hole in the pattern 
+     by the corresponding term of the given the list.}
+\end{description}
+
+\paragraph{Warning:} Sometimes, a \Coq\ term may have invisible
+sub-terms that the matching functions are nevertheless sensible to.
+For example, the \Coq\ term $(?_1,?_2)$ is actually a shorthand for
+the expression $(\texttt{pair}\;?\;?\;?_1\;?_2)$.
+Hence, matching this term pattern 
+with the term $(\texttt{true},\texttt{O})$ actually yields the list
+$[?;?;\texttt{true};\texttt{O}]$ as result (and \textbf{not}
+$[\texttt{true};\texttt{O}]$, as could be expected).
+
+\subsection{Patterns on Inductive Definitions}
+
+The module \texttt{Pattern} also includes some functions for testing
+if the definition of an inductive type satisfies certain
+properties. Such functions may be used to perform pattern matching
+independently from the name given to the inductive type and the
+universe it inhabits.  They yield the value $(\texttt{Some}\;r::l)$ if
+the input term reduces into an application of an inductive type $r$ to
+a list of terms $l$, and the definition of $r$ satisfies certain
+conditions. Otherwise, they yield the value \texttt{None}.
+
+\begin{description}
+\fun{val Pattern.match\_with\_non\_recursive\_type : constr list option}
+    {Tests if the inductive type $r$ has no recursive constructors}
+\fun{val Pattern.match\_with\_disjunction : constr list option}
+    {Tests if the inductive type $r$ is a non-recursive type
+     such that all its constructors have a single argument.}
+\fun{val Pattern.match\_with\_conjunction : constr list option}
+    {Tests if the inductive type $r$ is a non-recursive type
+     with a unique constructor.}
+\fun{val Pattern.match\_with\_empty\_type  : constr list option}
+    {Tests if the inductive type $r$ has no constructors at all}
+\fun{val Pattern.match\_with\_equation    : constr list option}
+    {Tests if the inductive type $r$ has a single constructor
+     expressing the property of reflexivity for some type. For
+     example, the types $a=b$, $A\mbox{==}B$ and $A\mbox{===}B$ satisfy
+     this predicate.}
+\end{description}
+
+\subsection{Elimination Tacticals}
+
+It is frequently the case that the subgoals generated by an
+elimination can all be solved in a similar way, possibly parametrized
+on some information about each case, like for example:
+\begin{itemize}
+\item the inductive type of the object being eliminated;
+\item its arguments (if it is an inductive predicate);
+\item the branch number;
+\item the predicate to be proven;
+\item the number of assumptions to be introduced by the case
+\item the signature of the branch, i.e., for each argument of
+the branch whether it is recursive or not.
+\end{itemize}
+
+The following tacticals can be useful to deal with such situations.
+They  
+
+\begin{description}
+\fun{val Elim.simple\_elimination\_then : \\ \qquad
+(branch\_args -> tactic) -> constr -> tactic}
+    {\\ Performs the default elimination on the last argument, and then
+     tries to solve the generated subgoals using a given parametrized
+     tactic. The type branch\_args is a record type containing all 
+     information mentioned above.}
+\fun{val Elim.simple\_case\_then : \\ \qquad
+(branch\_args -> tactic) -> constr -> tactic}
+    {\\ Similarly, but it performs case analysis instead of induction.}
+\end{description}
+
+\section{A Complete Example}
+\label{ACompleteExample}
+
+In order to illustrate the implementation of a new tactic, let us come
+back to the problem of deciding the equality of two elements of an
+inductive type.
+
+\subsection{Preliminaries}
+
+Let us call \texttt{newtactic} the directory that will contain the
+implementation of the new tactic. In this directory will lay two
+files: a file \texttt{eqdecide.ml}, containing the \ocaml{} sources that
+implements the tactic, and a \Coq\ file \texttt{Eqdecide.v}, containing
+its associated grammar rules and the commands to generate a module
+that can be loaded dynamically from \Coq's toplevel. 
+
+To compile our project, we will create a \texttt{Makefile} with the
+command \texttt{do\_Makefile} (see section \ref{Makefile}) :
+
+\begin{quotation}
+  \texttt{do\_Makefile eqdecide.ml EqDecide.v > Makefile}\\
+  \texttt{touch .depend}\\
+  \texttt{make depend}
+\end{quotation}
+
+We must have kept the sources of \Coq{} somewhere and to set an
+environment variable \texttt{COQTOP} that points to that directory.
+
+\subsection{Implementing the Tactic}
+
+The file \texttt{eqdecide.ml} contains the implementation of the
+tactic in \ocaml{}. Let us recall the main steps of the proof strategy
+for deciding the proposition $(x,y:R)\{x=y\}+\{\neg x=y\}$ on the
+inductive type $R$:
+\begin{enumerate}
+\item Eliminate $x$ and then $y$.
+\item Try discrimination to solve those goals where $x$ and $y$ has
+been introduced by different constructors.
+\item If $x$ and $y$ have been introduced by the same constructor,
+      then analyze one by one the corresponding pairs of arguments.
+      If they are equal, rewrite one into the other. If they are
+      not, derive a contradiction from the invectiveness of the
+      constructor.
+\item Once all the arguments have been rewritten, solve the left half
+of the goal by reflexivity.
+\end{enumerate}
+
+In the sequel we implement these steps one by one. We start opening
+the modules necessary for the implementation of the tactic:
+
+\begin{verbatim}
+open Names
+open Term
+open Tactics
+open Tacticals
+open Hiddentac
+open Equality
+open Auto
+open Pattern
+open Names
+open Termenv
+open Std
+open Proof_trees
+open Tacmach
+\end{verbatim}
+
+The first step of the procedure can be straightforwardly implemented as
+follows:
+
+\begin{verbatim}
+let clear_last = (tclLAST_HYP (fun c -> (clear_one (destVar c))));;
+\end{verbatim}
+
+\begin{verbatim}
+let mkBranches = 
+        (tclTHEN  intro 
+        (tclTHEN (tclLAST_HYP h_simplest_elim)
+        (tclTHEN  clear_last
+        (tclTHEN  intros 
+        (tclTHEN (tclLAST_HYP h_simplest_case)
+        (tclTHEN  clear_last
+                  intros))))));;
+\end{verbatim}
+
+Notice the use of the tactical \texttt{tclLAST\_HYP}, which avoids to
+give a (potentially clashing) name to the quantified variables of the
+goal when they are introduced.
+
+The second step of the procedure is implemented by the following
+tactic:
+
+\begin{verbatim}
+let solveRightBranch  = (tclTHEN simplest_right discrConcl);;
+\end{verbatim}
+
+In order to illustrate how the implementation of a tactic can be 
+hidden, let us do it with the tactic above:
+
+\begin{verbatim}
+let h_solveRightBranch =
+    hide_atomic_tactic "solveRightBranch" solveRightBranch
+;;
+\end{verbatim}
+
+As it was already mentioned in Section \ref{WhatIsATactic}, the
+combinator \texttt{hide\_atomic\_tactic} first registers the tactic
+\texttt{solveRightBranch} in the table, and returns a tactic which
+calls the interpreter with the used to register it. Hence, when the
+tactical \texttt{Info} is used, our tactic will just inform that
+\texttt{solveRightBranch} was applied, omitting all the details
+corresponding to \texttt{simplest\_right} and \texttt{discrConcl}.
+
+
+
+The third step requires some auxiliary functions for constructing the
+type $\{c_1=c_2\}+\{\neg c_1=c_2\}$ for a given inductive type $R$ and
+two constructions $c_1$ and $c_2$, and for generalizing this type over
+$c_1$ and $c_2$:
+
+\begin{verbatim}
+let mmk         = make_module_marker ["#Logic.obj";"#Specif.obj"];;
+let eqpat       = put_pat mmk "eq";;                 
+let sumboolpat  = put_pat mmk "sumbool";;             
+let notpat      = put_pat mmk "not";;   
+let eq          = get_pat eqpat;;
+let sumbool     = get_pat sumboolpat;;
+let not         = get_pat notpat;;
+
+let mkDecideEqGoal rectype c1 c2 g = 
+     let equality    = mkAppL [eq;rectype;c1;c2] in
+     let disequality = mkAppL [not;equality]
+     in  mkAppL [sumbool;equality;disequality]
+;;
+let mkGenDecideEqGoal rectype g = 
+      let hypnames = ids_of_sign (pf_hyps g) in 
+      let xname    = next_ident_away (id_of_string "x") hypnames
+      and yname    = next_ident_away (id_of_string "y") hypnames
+      in  (mkNamedProd xname rectype 
+           (mkNamedProd yname rectype 
+            (mkDecideEqGoal rectype (mkVar xname) (mkVar yname) g)))
+;;
+\end{verbatim}
+
+The tactic will depend on the \Coq modules \texttt{Logic} and
+\texttt{Specif}, since we use the constants corresponding to
+propositional equality (\texttt{eq}), computational disjunction
+(\texttt{sumbool}), and logical negation (\texttt{not}), defined in
+that modules. This is specified creating the module maker
+\texttt{mmk} (cf. Section \ref{Patterns}).
+
+The third step of the procedure can be divided into three sub-steps.
+Assume that both $x$ and $y$ have been introduced by the same
+constructor.  For each corresponding pair of arguments of that
+constructor, we have to consider whether they are equal or not.  If
+they are equal, the following tactic is applied to rewrite one into
+the other:
+
+\begin{verbatim}
+let eqCase  tac = 
+         (tclTHEN intro  
+         (tclTHEN (tclLAST_HYP h_rewriteLR)
+         (tclTHEN clear_last 
+                  tac)))
+;;
+\end{verbatim}
+
+
+If they are not equal, then the goal is contraposed and a
+contradiction is reached form the invectiveness of the constructor:
+
+\begin{verbatim}
+let diseqCase = 
+    let diseq  = (id_of_string "diseq") in
+    let absurd = (id_of_string "absurd")
+    in (tclTHEN (intro_using diseq)
+       (tclTHEN  h_simplest_right
+       (tclTHEN  red_in_concl
+       (tclTHEN  (intro_using absurd)
+       (tclTHEN  (h_simplest_apply (mkVar diseq))
+       (tclTHEN  (h_injHyp absurd)
+                  trivial ))))))
+;;
+\end{verbatim}
+
+In the tactic above we have chosen to name the hypotheses because
+they have to be applied later on. This introduces a potential risk
+of name clashing if the context already contains other hypotheses 
+also named ``diseq'' or ``absurd''.
+
+We are now ready to implement the tactic \textsl{SolveArg}.  Given the
+two arguments $a_1$ and $a_2$ of the constructor, this tactic cuts the
+goal with the proposition $\{a_1=a_2\}+\{\neg a_1=a_2\}$, and then
+applies the tactics above to each of the generated cases. If the
+disjunction cannot be solved automatically, it remains as a sub-goal
+to be proven.
+
+\begin{verbatim}
+let solveArg a1 a2 tac  g = 
+     let rectype = pf_type_of g a1 in
+     let decide  = mkDecideEqGoal rectype a1 a2 g
+     in  (tclTHENS  (h_elimType decide) 
+                      [(eqCase tac);diseqCase;default_auto]) g
+;;
+\end{verbatim}
+
+The following tactic implements the third and fourth steps of the
+proof procedure:
+
+\begin{verbatim}
+let conclpatt = put_pat mmk "{<?1>?2=?3}+{?4}"
+;;
+let solveLeftBranch rectype g = 
+      let (_::(lhs::(rhs::_))) = 
+               try (dest_somatch (pf_concl g) conclpatt) 
+               with UserError ("somatch",_)-> error "Unexpected conclusion!" in
+      let nparams   = mind_nparams rectype   in
+      let getargs l = snd (chop_list nparams (snd (decomp_app l))) in
+      let rargs   = getargs rhs
+      and largs   = getargs lhs
+      in  List.fold_right2 
+             solveArg largs rargs (tclTHEN h_simplest_left h_reflexivity) g
+;;
+\end{verbatim}
+
+Notice the use of a pattern to decompose the goal and obtain the
+inductive type and the left and right hand sides of the equality. A
+certain number of arguments correspond to the general parameters of
+the type, and must be skipped over. Once the corresponding list of
+arguments \texttt{rargs} and \texttt{largs} have been obtained, the
+tactic \texttt{solveArg} is iterated on them, leaving a disjunction
+whose left half can be solved by reflexivity.
+
+The following tactic joints together the three steps of the 
+proof procedure:
+
+\begin{verbatim}
+let initialpatt = put_pat mmk "(x,y:?1){<?1>x=y}+{~(<?1>x=y)}"
+;;
+let decideGralEquality g = 
+  let (typ::_) = try (dest_somatch (pf_concl g) initialpatt)
+                 with UserError ("somatch",_) -> 
+                        error "The goal does not have the expected form" in
+  let headtyp = hd_app (pf_compute g typ) in
+  let rectype = match (kind_of_term  headtyp) with
+                 IsMutInd _ -> headtyp 
+               | _          -> error ("This decision procedure only"
+                                      " works for inductive objects") 
+  in (tclTHEN   mkBranches 
+     (tclORELSE h_solveRightBranch (solveLeftBranch rectype))) g
+;;
+;;
+\end{verbatim}
+
+The tactic above can be specialized in two different ways: either to
+decide a particular instance $\{c_1=c_2\}+\{\neg c_1=c_2\}$ of the
+universal quantification; or to eliminate this property and obtain two
+subgoals containing the hypotheses $c_1=c_2$ and $\neg c_1=c_2$
+respectively.
+
+\begin{verbatim}
+let decideGralEquality = 
+  (tclTHEN mkBranches (tclORELSE h_solveRightBranch solveLeftBranch))
+;;
+let decideEquality c1 c2 g = 
+     let rectype = pf_type_of g c1 in
+     let decide  = mkGenDecideEqGoal rectype g
+     in  (tclTHENS (cut decide) [default_auto;decideGralEquality]) g
+;;
+let compare c1 c2 g = 
+     let rectype = pf_type_of g c1 in
+     let decide  = mkDecideEqGoal rectype c1 c2 g
+     in  (tclTHENS (cut decide) 
+                [(tclTHEN  intro 
+                 (tclTHEN (tclLAST_HYP simplest_case)
+                          clear_last));
+                  decideEquality c1 c2]) g
+;;
+\end{verbatim}
+
+Next, for each of the tactics that will have an entry in the grammar
+we construct the associated dynamic one to be registered in the table
+of tactics. This function can be used to overload a tactic name with
+several similar tactics.  For example, the tactic proving the general
+decidability property and the one proving a particular instance for
+two terms can be grouped together with the following convention: if
+the user provides two terms as arguments, then the specialized tactic
+is used; if no argument is provided then the general tactic is invoked.
+
+\begin{verbatim}
+let dyn_decideEquality  args g =
+      match args with 
+       [(COMMAND com1);(COMMAND com2)]  -> 
+          let c1 = pf_constr_of_com g com1
+          and c2 = pf_constr_of_com g com2
+          in  decideEquality c1 c2 g 
+     | [] ->  decideGralEquality g
+     | _  ->  error "Invalid arguments for dynamic tactic"
+;;
+add_tactic "DecideEquality" dyn_decideEquality
+;;
+
+let dyn_compare args g =
+      match args with 
+       [(COMMAND com1);(COMMAND com2)]  -> 
+          let c1 = pf_constr_of_com g com1
+          and c2 = pf_constr_of_com g com2
+          in  compare c1 c2 g
+     | _  ->  error "Invalid arguments for dynamic tactic"
+;; 
+add_tactic "Compare" tacargs_compare
+;;
+\end{verbatim}
+
+This completes the implementation of the tactic. We turn now to the
+\Coq file \texttt{Eqdecide.v}.
+
+
+\subsection{The Grammar Rules}
+
+Associated to the implementation of the tactic there is a \Coq\ file
+containing the grammar and pretty-printing rules for the new tactic,
+and the commands to generate an object module that can be then loaded
+dynamically during a \Coq\ session. In order to generate an ML module,
+the \Coq\ file must contain a
+\texttt{Declare ML module} command for all the \ocaml{} files concerning
+the implementation of the tactic --in our case there is only one file,
+the file \texttt{eqdecide.ml}: 
+
+\begin{verbatim}
+Declare ML Module "eqdecide".
+\end{verbatim}
+
+The following grammar and pretty-printing rules are
+self-explanatory. We refer the reader to the Section \ref{Grammar} for
+the details:
+
+\begin{verbatim}
+Grammar tactic simple_tactic :=
+  EqDecideRuleG1 
+       [ "Decide"  "Equality" comarg($com1)  comarg($com2)] -> 
+       [(DecideEquality $com1 $com2)]
+| EqDecideRuleG2 
+       [ "Decide" "Equality"  ] -> 
+       [(DecideEquality)]
+| CompareRule 
+       [ "Compare" comarg($com1) comarg($com2)] -> 
+       [(Compare $com1 $com2)].
+
+Syntax tactic level 0:
+  EqDecideRulePP1 
+       [(DecideEquality)]   -> 
+       ["Decide" "Equality"]
+| EqDecideRulePP2 
+       [(DecideEquality $com1 $com2)]   -> 
+       ["Decide" "Equality" $com1 $com2]
+| ComparePP 
+       [(Compare $com1 $com2)] -> 
+       ["Compare" $com1 $com2].
+\end{verbatim}
+
+
+\paragraph{Important:} The names used to label the abstract syntax tree 
+in the grammar rules ---in this case ``DecideEquality'' and
+``Compare''--- must be the same as the name used to register the
+tactic in the tactics table. This is what makes the links between the
+input entered by the user and the tactic executed by the interpreter.
+
+\subsection{Loading the Tactic}
+
+Once the module \texttt{EqDecide.v} has been compiled, the tactic can
+be dynamically loaded using the \texttt{Require} command. 
+
+\begin{coq_example}
+Require EqDecide.
+Goal (x,y:nat){x=y}+{~x=y}.
+Decide Equality.
+\end{coq_example}
+
+The implementation of the tactic can be accessed through the
+tactical \texttt{Info}:
+\begin{coq_example}
+Undo.
+Info Decide Equality.
+\end{coq_example}
+\begin{coq_eval}
+Abort.
+\end{coq_eval}
+
+Remark that the task performed by the tactic \texttt{solveRightBranch}
+is not displayed, since we have chosen to hide its implementation.
+
+\section{Testing and Debugging your Tactic}
+\label{test-and-debug}
+
+When your tactic does not behave as expected, it is possible to trace
+it dynamically from \Coq. In order to do this, you have first to leave
+the toplevel of \Coq, and come back to the \ocaml{} interpreter. This can
+be done using the command \texttt{Drop} (cf. Section \ref{Drop}). Once
+in the \ocaml{} toplevel, load the file \texttt{tactics/include.ml}.
+This file installs several pretty printers for proof trees, goals,
+terms, abstract syntax trees, names, etc.  It also contains the
+function \texttt{go:unit -> unit} that enables to go back to \Coq's
+toplevel. 
+
+The modules \texttt{Tacmach} and \texttt{Pfedit} contain some basic
+functions for extracting information from the state of the proof
+engine. Such functions can be used to debug your tactic if
+necessary. Let us mention here some of them:
+
+\begin{description}
+\fun{val get\_pftreestate         : unit -> pftreestate}
+    {Projects the current state of the proof engine.}
+\fun{val proof\_of\_pftreestate    : pftreestate -> proof}
+    {Projects the current state of the proof tree. A pretty-printer 
+      displays it in a readable form.  }
+\fun{val top\_goal\_of\_pftreestate : pftreestate -> goal sigma}
+    {Projects the goal and the existential variables mapping from
+     the current state of the proof engine.} 
+\fun{val nth\_goal\_of\_pftreestate : int -> pftreestate -> goal sigma}
+    {Projects the goal and mapping corresponding to the $nth$ subgoal
+     that remains to be proven}
+\fun{val traverse                : int -> pftreestate -> pftreestate}
+    {Yields the children of the node that the current state of the 
+     proof engine points to.}
+\fun{val solve\_nth\_pftreestate   : \\ \qquad
+int -> tactic -> pftreestate ->  pftreestate}
+     {\\ Provides the new state of the proof engine obtained applying 
+      a given tactic to some unproven sub-goal.}
+\end{description}
+
+Finally, the traditional \ocaml{} debugging tools like the directives
+\texttt{trace} and \texttt{untrace} can be used to follow the
+execution of your functions. Frequently, a better solution is to use
+the \ocaml{} debugger, see Chapter \ref{Utilities}.
+
+\section{Concrete syntax for ML tactic and vernacular command}
+\label{Notations-for-ML-command}
+
+\subsection{The general case}
+
+The standard way to bind an ML-written tactic or vernacular command to
+a concrete {\Coq} syntax is to use the
+\verb=TACTIC EXTEND= and \verb=VERNAC COMMAND EXTEND= macros.
+
+These macros can be used in any {\ocaml} file defining a (new) ML tactic
+or vernacular command. They are expanded into pure {\ocaml} code by
+the {\camlpppp} preprocessor of {\ocaml}. Concretely, files that use
+these macros need to be compiled by giving to {\tt ocamlc} the option 
+
+\verb=-pp "camlp4o -I $(COQTOP)/parsing grammar.cma pa_extend.cmo"=
+
+\noindent which is the default for every file compiled by means of a Makefile
+generated by {\tt coq\_makefile} (cf chapter \ref {Addoc-coqc}). So,
+just do \verb=make= in this latter case.
+
+The syntax of the macros is given on figure
+\ref{EXTEND-syntax}. They can be used at any place of an {\ocaml}
+files where an ML sentence (called \verb=str_item= in the {\tt ocamlc}
+parser) is expected. For each rule, the left-hand-side describes the
+grammar production and the right-hand-side its interpretation which
+must be an {\ocaml} expression. Each grammar production starts with
+the concrete name of the tactic or command in {\Coq} and is followed
+by arguments, possibly separated by terminal symbols or words.
+Here is an example:
+
+\begin{verbatim}
+TACTIC EXTEND Replace
+  [ "replace" constr(c1) "with" constr(c2) ] -> [ replace c1 c2 ]
+END
+\end{verbatim}
+
+\newcommand{\grule}{\textrm{\textsl{rule}}}
+\newcommand{\stritem}{\textrm{\textsl{ocaml\_str\_item}}}
+\newcommand{\camlexpr}{\textrm{\textsl{ocaml\_expr}}}
+\newcommand{\arginfo}{\textrm{\textsl{argument\_infos}}}
+\newcommand{\lident}{\textrm{\textsl{lower\_ident}}}
+\newcommand{\argument}{\textrm{\textsl{argument}}}
+\newcommand{\entry}{\textrm{\textsl{entry}}}
+\newcommand{\argtype}{\textrm{\textsl{argtype}}}
+
+\begin{figure}
+\begin{tabular}{|lcll|}
+\hline
+{\stritem}
+ & ::= & 
+\multicolumn{2}{l|}{{\tt TACTIC EXTEND} {\ident} \nelist{\grule}{$|$} {\tt END}}\\
+ & $|$ & \multicolumn{2}{l|}{{\tt VERNAC COMMAND EXTEND} {\ident} \nelist{\grule}{$|$} {\tt END}}\\
+&&\multicolumn{2}{l|}{}\\
+{\grule} & ::= & 
+\multicolumn{2}{l|}{{\tt [} {\str} \sequence{\argument}{} {\tt ] -> [} {\camlexpr} {\tt ]}}\\
+&&\multicolumn{2}{l|}{}\\
+{\argument} & ::= & {\str} &\mbox{(terminal)}\\
+ & $|$ & {\entry} {\tt (} {\lident} {\tt )} &\mbox{(non-terminal)}\\
+&&\multicolumn{2}{l|}{}\\
+{\entry} 
+ & ::= & {\tt string} & (a string)\\
+ & $|$ & {\tt preident} & (an identifier typed as a {\tt string})\\
+ & $|$ & {\tt ident} & (an identifier of type {\tt identifier})\\
+ & $|$ & {\tt global} & (a qualified identifier)\\
+ & $|$ & {\tt constr} & (a {\Coq} term)\\
+ & $|$ & {\tt openconstr} & (a {\Coq} term with holes)\\
+ & $|$ & {\tt sort} & (a {\Coq} sort)\\
+ & $|$ & {\tt tactic} & (an ${\cal L}_{tac}$ expression)\\
+ & $|$ & {\tt constr\_with\_bindings} & (a {\Coq} term with a list of bindings\footnote{as for the tactics {\tt apply} and {\tt elim}})\\
+ & $|$ & {\tt int\_or\_var} & (an integer or an identifier denoting an integer)\\
+ & $|$ & {\tt quantified\_hypothesis} & (a quantified hypothesis\footnote{as for the tactics {\tt intros until}})\\
+ & $|$ & {\tt {\entry}\_opt} & (an optional {\entry} )\\
+ & $|$ & {\tt ne\_{\entry}\_list} & (a non empty list of {\entry})\\
+ & $|$ & {\tt {\entry}\_list} & (a list of {\entry})\\
+ & $|$ & {\tt bool} & (a boolean: no grammar rule, just for typing)\\
+ & $|$ & {\lident} & (a user-defined entry)\\
+\hline
+\end{tabular}
+\caption{Syntax of the macros binding {\ocaml} tactics or commands to a {\Coq} syntax}
+\label{EXTEND-syntax}
+\end{figure}
+
+There is a set of predefined non-terminal entries which are
+automatically translated into an {\ocaml} object of a given type. The
+type is not the same for tactics and for vernacular commands. It is
+given in the following table:
+
+\begin{small}
+\noindent \begin{tabular}{|l|l|l|}
+\hline
+{\entry} & {\it type for tactics} & {\it type for commands} \\
+{\tt string} & {\tt string} & {\tt string}\\
+{\tt preident} & {\tt string} & {\tt string}\\
+{\tt ident} & {\tt identifier} & {\tt identifier}\\
+{\tt global} & {\tt global\_reference} & {\tt qualid}\\
+{\tt constr} & {\tt constr} & {\tt constr\_expr}\\
+{\tt openconstr} & {\tt open\_constr} & {\tt constr\_expr}\\
+{\tt sort} & {\tt sorts} & {\tt rawsort}\\
+{\tt tactic} & {\tt glob\_tactic\_expr * tactic} & {\tt raw\_tactic\_expr}\\
+{\tt constr\_with\_bindings} & {\tt constr with\_bindings} & {\tt constr\_expr with\_bindings}\\\\
+{\tt int\_or\_var} & {\tt int or\_var} & {\tt int or\_var}\\
+{\tt quantified\_hypothesis} & {\tt quantified\_hypothesis} & {\tt quantified\_hypothesis}\\
+{\tt {\entry}\_opt} & {\it the type of entry} {\tt option} & {\it the type of entry} {\tt option}\\
+{\tt ne\_{\entry}\_list} & {\it the type of entry} {\tt list} & {\it the type of entry} {\tt list}\\
+{\tt {\entry}\_list} & {\it the type of entry} {\tt list} & {\it the type of entry} {\tt list}\\
+{\tt bool} & {\tt bool} & {\tt bool}\\
+{\lident} & {user-provided, cf next section} & {user-provided, cf next section}\\
+\hline
+\end{tabular}
+\end{small}
+
+\bigskip
+
+Notice that {\entry} consists in a single identifier and that the {\tt
+\_opt}, {\tt \_list}, ... modifiers are part of the identifier.
+Here is now another example of a tactic which takes either a non empty
+list of identifiers and executes the {\ocaml} function {\tt subst} or
+takes no arguments and executes the{\ocaml} function {\tt subst\_all}.
+
+\begin{verbatim}
+TACTIC EXTEND Subst
+| [ "subst" ne_ident_list(l) ] -> [ subst l ]
+| [ "subst" ] -> [ subst_all ]
+END
+\end{verbatim}
+
+\subsection{Adding grammar entries for tactic or command arguments}
+
+In case parsing the arguments of the tactic or the vernacular command
+involves grammar entries other than the predefined entries listed
+above, you have to declare a new entry using the macros
+\verb=ARGUMENT EXTEND= or \verb=VERNAC ARGUMENT EXTEND=. The syntax is
+given on figure \ref{ARGUMENT-EXTEND-syntax}. Notice that arguments
+declared by \verb=ARGUMENT EXTEND= can be used for arguments of both
+tactics and vernacular commands while arguments declared by
+\verb=VERNAC ARGUMENT EXTEND= can only be used by vernacular commands.
+
+For \verb=VERNAC ARGUMENT EXTEND=, the identifier is the name of the
+entry and it must be a valid {\ocaml} identifier (especially it must
+be lowercase).  The grammar rules works as before except that they do
+not have to start by a terminal symbol or word.  As an example, here
+is how the {\Coq} {\tt Extraction Language {\it language}} parses its
+argument:
+
+\begin{verbatim}
+VERNAC ARGUMENT EXTEND language
+| [ "Ocaml" ] -> [ Ocaml ]
+| [ "Haskell" ] -> [ Haskell ]
+| [ "Scheme" ] -> [ Scheme ]
+| [ "Toplevel" ] -> [ Toplevel ]
+END
+\end{verbatim}
+
+For tactic arguments, and especially for \verb=ARGUMENT EXTEND=, the
+procedure is more subtle because tactics are objects of the {\Coq}
+environment which can be printed and interpreted. Then the syntax
+requires extra information providing a printer and a type telling how
+the argument behaves. Here is an example of entry parsing a pair of
+optional {\Coq} terms.
+
+\begin{verbatim}
+let pp_minus_div_arg pr_constr pr_tactic (omin,odiv) = 
+  if omin=None && odiv=None then mt() else
+    spc() ++ str "with" ++
+    pr_opt (fun c -> str "minus := " ++ pr_constr c) omin ++
+    pr_opt (fun c -> str "div := " ++ pr_constr c) odiv
+
+ARGUMENT EXTEND minus_div_arg 
+  TYPED AS constr_opt * constr_opt
+  PRINTED BY pp_minus_div_arg
+| [ "with" minusarg(m) divarg_opt(d) ] -> [ Some m, d ]
+| [ "with" divarg(d) minusarg_opt(m) ] -> [ m, Some d ]
+| [ ] -> [ None, None ]
+END
+\end{verbatim}
+
+Notice that the type {\tt constr\_opt * constr\_opt} tells that the
+object behaves as a pair of optional {\Coq} terms, i.e. as an object
+of {\ocaml} type {\tt constr option * constr option} if in a
+\verb=TACTIC EXTEND= macro and of type {\tt constr\_expr option *
+constr\_expr option} if in a \verb=VERNAC COMMAND EXTEND= macro.
+
+As for the printer, it must be a function expecting a printer for
+terms, a printer for tactics and returning a printer for the created
+argument. Especially, each sub-{\term} and each sub-{\tac} in the
+argument must be typed by the corresponding printers. Otherwise, the
+{\ocaml} code will not be well-typed.
+
+\Rem The entry {\tt bool} is bound to no syntax but it can be used to
+give the type of an argument as in the following example:
+
+\begin{verbatim}
+let pr_orient _prc _prt = function
+  | true -> mt ()
+  | false -> str " <-"
+
+ARGUMENT EXTEND orient TYPED AS bool PRINTED BY pr_orient
+| [ "->" ] -> [ true ]
+| [ "<-" ] -> [ false ]
+| [ ] -> [ true ]
+END
+\end{verbatim}
+
+\begin{figure}
+\begin{tabular}{|lcl|}
+\hline
+{\stritem} & ::= & 
+ {\tt ARGUMENT EXTEND} {\ident} {\arginfo} {\nelist{\grule}{$|$}} {\tt END}\\
+& $|$ & {\tt VERNAC ARGUMENT EXTEND} {\ident} {\nelist{\grule}{$|$}} {\tt END}\\
+\\
+{\arginfo} & ::= & {\tt TYPED AS} {\argtype} \\
+&& {\tt PRINTED BY} {\lident} \\
+%&& \zeroone{{\tt INTERPRETED BY} {\lident}}\\
+%&& \zeroone{{\tt GLOBALIZED BY} {\lident}}\\
+%&& \zeroone{{\tt SUBSTITUTED BY} {\lident}}\\
+%&& \zeroone{{\tt RAW\_TYPED AS} {\lident} {\tt RAW\_PRINTED BY} {\lident}}\\
+%&& \zeroone{{\tt GLOB\_TYPED AS} {\lident} {\tt GLOB\_PRINTED BY} {\lident}}\\
+\\
+{\argtype} & ::= & {\argtype} {\tt *} {\argtype} \\ 
+& $|$ & {\entry} \\
+\hline
+\end{tabular}
+\caption{Syntax of the macros binding {\ocaml} tactics or commands to a {\Coq} syntax}
+\label{ARGUMENT-EXTEND-syntax}
+\end{figure}
+
+%\end{document}
diff --git a/doc/refman/RefMan-uti.tex b/doc/refman/RefMan-uti.tex
new file mode 100644
index 00000000..4d73b878
--- /dev/null
+++ b/doc/refman/RefMan-uti.tex
@@ -0,0 +1,276 @@
+\chapter{Utilities}\label{Utilities}
+
+The distribution provides utilities to simplify some tedious works
+beside proof development, tactics writing or documentation.
+
+\section{Building a toplevel extended with user tactics}
+\label{Coqmktop}\index{Coqmktop@{\tt coqmktop}}
+
+The native-code version of \Coq\ cannot dynamically load user tactics
+using Objective Caml code. It is possible to build a toplevel of \Coq,
+with Objective Caml code statically linked, with the tool {\tt
+  coqmktop}.
+
+For example, one can build a native-code \Coq\ toplevel extended with a tactic
+which source is in {\tt tactic.ml} with the command 
+\begin{verbatim}
+     % coqmktop -opt -o mytop.out tactic.cmx
+\end{verbatim}
+where {\tt tactic.ml} has been compiled with the native-code
+compiler {\tt ocamlopt}. This command generates an executable
+called {\tt mytop.out}. To use this executable to compile your \Coq\
+files, use {\tt coqc -image mytop.out}.
+
+A basic example is the native-code version of \Coq\ ({\tt coqtop.opt}),
+which can be generated by {\tt coqmktop -opt -o coqopt.opt}.
+
+
+\paragraph{Application: how to use the Objective Caml debugger with Coq.}
+\index{Debugger}
+
+One useful application of \texttt{coqmktop} is to build a \Coq\ toplevel in
+order to debug your tactics with the Objective Caml debugger.
+You need to have configured and compiled \Coq\ for debugging
+(see the file \texttt{INSTALL} included in the distribution).
+Then, you must compile the Caml modules of your tactic with the
+option \texttt{-g} (with the bytecode compiler) and build a stand-alone
+bytecode toplevel with the following command:
+
+\begin{quotation}
+\texttt{\% coqmktop -g -o coq-debug}~\emph{<your \texttt{.cmo} files>}
+\end{quotation}
+
+
+To launch the \ocaml\ debugger with the image you need to execute it in
+an environment which correctly sets the \texttt{COQLIB} variable.
+Moreover, you have to indicate the directories in which
+\texttt{ocamldebug} should search for Caml modules.
+
+A possible solution is to use a wrapper around \texttt{ocamldebug}
+which detects the executables containing the word \texttt{coq}. In
+this case, the debugger is called with the required additional
+arguments. In other cases, the debugger is simply called without additional
+arguments. Such a wrapper can be found in the \texttt{dev/}
+subdirectory of the sources. 
+
+\section{Modules dependencies}\label{Dependencies}\index{Dependencies}
+  \index{Coqdep@{\tt coqdep}}
+
+In order to compute modules dependencies (so to use {\tt make}),
+\Coq\ comes with an appropriate tool, {\tt coqdep}.
+
+{\tt coqdep} computes inter-module dependencies for \Coq\ and
+\ocaml\ programs, and prints the dependencies on the standard
+output in a format readable by make.  When a directory is given as
+argument, it is recursively looked at.
+
+Dependencies of \Coq\ modules are computed by looking at {\tt Require}
+commands ({\tt Require}, {\tt Requi\-re Export}, {\tt Require Import},
+{\tt Require Implementation}), but also at the command {\tt Declare ML Module}.
+
+Dependencies of \ocaml\ modules are computed by looking at
+\verb!open! commands and the dot notation {\em module.value}. However,
+this is done approximatively and you are advised to use {\tt ocamldep}
+instead for the \ocaml\ modules dependencies.
+
+See the man page of {\tt coqdep} for more details and options.
+
+
+\section{Creating a {\tt Makefile} for \Coq\ modules}
+\label{Makefile}
+\index{Makefile@{\tt Makefile}}
+\index{CoqMakefile@{\tt coq\_Makefile}}
+
+When a proof development becomes large and is split into several files,
+it becomes crucial to use a tool like {\tt make} to compile \Coq\
+modules.
+
+The writing of a generic and complete {\tt Makefile} may be a tedious work
+and that's why \Coq\ provides a tool to automate its creation,
+{\tt coq\_makefile}. Given the files to compile, the command {\tt
+coq\_makefile} prints a 
+{\tt Makefile} on the standard output. So one has just to run the
+command:
+
+\begin{quotation}
+\texttt{\% coq\_makefile} {\em file$_1$.v \dots\ file$_n$.v} \texttt{> Makefile}
+\end{quotation}
+
+The resulted {\tt Makefile} has a target {\tt depend} which computes the
+dependencies and puts them in a separate file {\tt .depend}, which is
+included by the {\tt Makefile}. 
+Therefore, you should create such a file before the first invocation
+of make. You can for instance use the command 
+
+\begin{quotation}
+\texttt{\% touch .depend}
+\end{quotation}
+
+Then, to initialize or update the modules dependencies, type in:
+
+\begin{quotation}
+\texttt{\% make depend}
+\end{quotation}
+
+There is a target {\tt all} to compile all the files {\em file$_1$
+\dots\ file$_n$}, and a generic target to produce a {\tt .vo} file from
+the corresponding {\tt .v} file (so you can do {\tt make} {\em file}{\tt.vo}
+to compile the file {\em file}{\tt.v}).
+
+{\tt coq\_makefile} can also handle the case of ML files and
+subdirectories. For more options type
+
+\begin{quotation}
+\texttt{\% coq\_makefile --help}
+\end{quotation}
+
+\Warning To compile a project containing \ocaml{} files you must keep
+the sources of \Coq{} somewhere and have an environment variable named
+\texttt{COQTOP} that points to that directory.
+
+% \section{{\sf Coq\_SearchIsos}: information retrieval in a \Coq\ proofs
+% library}
+% \label{coqsearchisos}
+% \index{Coq\_SearchIsos@{\sf Coq\_SearchIsos}}
+
+% In the \Coq\ distribution, there is also a separated and independent tool,
+% called {\sf Coq\_SearchIsos}, which allows the search in accordance with {\tt
+% SearchIsos}\index{SearchIsos@{\tt SearchIsos}} (see section~\ref{searchisos})
+% in a \Coq\ proofs library. More precisely, this program begins, once launched
+% by {\tt coqtop -searchisos}\index{coqtopsearchisos@{\tt
+% coqtop -searchisos}}, loading lightly (by using specifications functions)
+% all the \Coq\ objects files ({\tt .vo}) accessible by the {\tt LoadPath} (see
+% section~\ref{loadpath}). Next, a prompt appears and four commands are then
+% available:
+
+% \begin{description}
+% \item [{\tt SearchIsos}]\ \\
+%   Scans the fixed context.
+% \item [{\tt Time}]\index{Time@{\tt Time}}\ \\
+%   Turns on the Time Search Display mode (see section~\ref{time}).
+% \item [{\tt Untime}]\index{Untime@{\tt Untime}}\ \\
+%   Turns off the Time Search Display mode (see section~\ref{time}).
+% \item [{\tt Quit}]\index{Quit@{\tt Quit}}\ \\
+%   Ends the {\tt coqtop -searchisos} session.
+% \end{description}
+
+% When running {\tt coqtop -searchisos} you can use the two options:
+
+% \begin{description}
+% \item[{\tt -opt}]\ \\
+%   Runs the native-code version of {\sf Coq\_SearchIsos}.
+
+% \item[{\tt -image} {\em file}]\ \\
+%   This option sets the binary image to be used to be {\em file}
+%   instead of the standard one. Not of general use.
+% \end{description}
+
+
+\section{Documenting \Coq\ files with coqdoc}
+\label{coqdoc}
+\index{Coqdoc@{\sf coqdoc}}
+
+\input{./coqdoc}
+
+\section{Exporting \Coq\ theories to XML}
+
+\input{./Helm}
+
+\section{Embedded \Coq\ phrases inside \LaTeX\ documents}\label{Latex}
+  \index{Coqtex@{\tt coq-tex}}\index{Latex@{\LaTeX}}
+
+When writing a documentation about a proof development, one may want
+to insert \Coq\ phrases inside a \LaTeX\ document, possibly together with
+the corresponding answers of the system. We provide a
+mechanical way to process such \Coq\ phrases embedded in \LaTeX\ files: the
+{\tt coq-tex} filter.  This filter extracts Coq phrases embedded in
+LaTeX files, evaluates them, and insert the outcome of the evaluation
+after each phrase.
+
+Starting with a file {\em file}{\tt.tex} containing \Coq\ phrases,
+the {\tt coq-tex} filter produces a file named {\em file}{\tt.v.tex} with
+the \Coq\ outcome. 
+
+There are options to produce the \Coq\ parts in smaller font, italic,
+between horizontal rules, etc.
+See the man page of {\tt coq-tex} for more details.
+
+\medskip\noindent {\bf Remark.} This Reference Manual and the Tutorial
+have been completely produced with {\tt coq-tex}.
+
+
+\section{\Coq\ and \emacs}\label{Emacs}\index{Emacs}
+
+\subsection{The \Coq\ Emacs mode}
+
+\Coq\ comes with a Major mode for \emacs, {\tt coq.el}. This mode provides
+syntax highlighting (assuming your \emacs\ library provides
+{\tt hilit19.el}) and also a rudimentary indentation facility
+in the style of the Caml \emacs\ mode.
+
+Add the following lines to your \verb!.emacs! file:
+
+\begin{verbatim}
+  (setq auto-mode-alist (cons '("\\.v$" . coq-mode) auto-mode-alist))
+  (autoload 'coq-mode "coq" "Major mode for editing Coq vernacular." t)
+\end{verbatim}
+
+The \Coq\ major mode is triggered by visiting a file with extension {\tt .v},
+or manually with the command \verb!M-x coq-mode!.
+It gives you the correct syntax table for
+the \Coq\ language, and also a rudimentary indentation facility:
+\begin{itemize}
+  \item pressing {\sc Tab} at the beginning of a line indents the line like
+    the line above;
+
+  \item extra {\sc Tab}s increase the indentation level
+    (by 2 spaces by default);
+
+  \item M-{\sc Tab} decreases the indentation level.
+\end{itemize}
+
+An inferior mode to run \Coq\ under Emacs, by Marco Maggesi, is also
+included in the distribution, in file \texttt{coq-inferior.el}.
+Instructions to use it are contained in this file.
+
+\subsection{Proof General}\index{Proof General}
+
+Proof General is a generic interface for proof assistants based on
+Emacs (or XEmacs). The main idea is that the \Coq\ commands you are
+editing are sent to a \Coq\ toplevel running behind Emacs and the
+answers of the system automatically inserted into other Emacs buffers. 
+Thus you don't need to copy-paste the \Coq\ material from your files
+to the \Coq\ toplevel or conversely from the \Coq\ toplevel to some
+files. 
+
+Proof General is developped and distributed independently of the
+system \Coq. It is freely available at \verb!proofgeneral.inf.ed.ac.uk!.
+
+
+\section{Module specification}\label{gallina}\index{Gallina@{\tt gallina}}
+
+Given a \Coq\ vernacular file, the {\tt gallina} filter extracts its
+specification (inductive types declarations, definitions, type of
+lemmas and theorems), removing the proofs parts of the file. The \Coq\
+file {\em file}{\tt.v} gives birth to the specification file
+{\em file}{\tt.g} (where the suffix {\tt.g} stands for \gallina).
+
+See the man page of {\tt gallina} for more details and options.
+
+
+\section{Man pages}\label{ManPages}\index{Man pages}
+
+There are man pages for the commands {\tt coqdep}, {\tt gallina} and
+{\tt coq-tex}. Man pages are installed at installation time
+(see installation instructions in file {\tt INSTALL}, step 6).
+
+%BEGIN LATEX
+\RefManCutCommand{ENDREFMAN=\thepage}
+%END LATEX
+
+% $Id: RefMan-uti.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: t
+%%% End: 
diff --git a/doc/refman/Reference-Manual.tex b/doc/refman/Reference-Manual.tex
new file mode 100644
index 00000000..4542e730
--- /dev/null
+++ b/doc/refman/Reference-Manual.tex
@@ -0,0 +1,125 @@
+\RequirePackage{ifpdf}
+\ifpdf
+  \documentclass[11pt,a4paper,pdftex]{book}
+\else
+  \documentclass[11pt,a4paper]{book}
+\fi
+
+\usepackage[latin1]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage{times}
+\usepackage{url}
+\usepackage{verbatim}
+\usepackage{amsmath}
+\usepackage{amssymb}
+\usepackage{alltt}
+\usepackage{hevea}
+
+\usepackage{ifpdf}
+
+% for coqide
+\ifpdf   % si on est pas en pdflatex
+  \usepackage[pdftex]{graphicx}
+\else
+  \usepackage[dvips]{graphicx}
+\fi
+
+
+%\includeonly{RefMan-gal.v,RefMan-ltac.v,RefMan-lib.v,Cases.v}
+
+\input{../common/version.tex}
+\input{../common/macros.tex}% extension .tex pour htmlgen
+\input{../common/title.tex}% extension .tex pour htmlgen
+\input{./headers.tex}% extension .tex pour htmlgen
+
+\begin{document}
+%BEGIN LATEX
+\sloppy\hbadness=5000
+%END LATEX
+
+\tophtml{}
+%BEGIN LATEX
+\coverpage{Reference Manual}{The Coq Development Team}
+  {This material may be distributed only subject to the terms and
+   conditions set forth in the Open Publication License, v1.0 or later
+   (the latest version is presently available at
+   \ahrefurl{http://www.opencontent.org/openpub}).
+   Options A and B of the licence are {\em not} elected.}
+%END LATEX
+
+%\defaultheaders
+\include{RefMan-int}% Introduction
+\include{RefMan-pre}% Credits
+
+%BEGIN LATEX
+\tableofcontents
+%END LATEX
+
+\part{The language}
+\defaultheaders
+\include{RefMan-gal.v}% Gallina
+\include{RefMan-ext.v}% Gallina extensions
+\include{RefMan-lib.v}% The coq library
+\include{RefMan-cic.v}% The Calculus of Constructions
+\include{RefMan-modr}% The module system
+
+
+\part{The proof engine}
+\include{RefMan-oth.v}% Vernacular commands
+\include{RefMan-pro}% Proof handling
+\include{RefMan-tac.v}% Tactics and tacticals
+\include{RefMan-ltac}% Writing tactics
+\include{RefMan-tacex.v}% Detailed Examples of tactics
+
+\part{User extensions}
+\include{RefMan-syn.v}% The Syntax and the Grammad commands
+%%SUPPRIME \include{RefMan-tus.v}% Writing tactics
+
+\part{Practical tools}
+\include{RefMan-com}% The coq commands (coqc coqtop)
+\include{RefMan-uti}% utilities (gallina, do_Makefile, etc)
+\include{RefMan-ide}% Coq IDE
+
+%BEGIN LATEX
+\RefManCutCommand{BEGINADDENDUM=\thepage}
+%END LATEX
+\part{Addendum to the Reference Manual}
+\include{AddRefMan-pre}%
+\include{Cases.v}%
+\include{Coercion.v}%
+%%SUPPRIME \include{Natural.v}%
+\include{Omega.v}%
+%%SUPPRIME \include{Correctness.v}% = preuve de pgms imperatifs
+\include{Extraction.v}%
+\include{Program.v}%
+\include{Polynom.v}%  = Ring
+\include{Setoid.v}% Tactique pour les setoides
+%BEGIN LATEX
+\RefManCutCommand{ENDADDENDUM=\thepage}
+%END LATEX
+\nocite{*}
+\bibliographystyle{plain}
+\bibliography{biblio}
+\cutname{biblio.html}
+
+\printindex
+\cutname{general-index.html}
+
+\printindex[tactic]
+\cutname{tactic-index.html}
+
+\printindex[command]
+\cutname{command-index.html}
+
+\printindex[error]
+\cutname{error-index.html}
+
+%BEGIN LATEX
+\listoffigures
+\addcontentsline{toc}{chapter}{\listfigurename}
+%END LATEX
+
+\end{document}
+
+
+% $Id: Reference-Manual.tex 8688 2006-04-07 15:08:12Z msozeau $ 
diff --git a/doc/refman/Setoid.tex b/doc/refman/Setoid.tex
new file mode 100644
index 00000000..867d6036
--- /dev/null
+++ b/doc/refman/Setoid.tex
@@ -0,0 +1,158 @@
+\achapter{\protect{The \texttt{setoid$\_$replace} tactic}}
+\aauthor{Cl\'ement Renard}
+\label{setoid_replace}
+\tacindex{setoid\_replace}
+
+This chapter presents  the \texttt{setoid\_replace} tactic.
+
+\asection{Description of \texttt{setoid$\_$replace}}
+
+Working on user-defined structures in \Coq\ is not very easy if
+Leibniz equality does not denote the intended equality. For example
+using lists to denote finite sets drive to difficulties since two
+non convertible terms can denote the same set.
+
+We present here a \Coq\ module, {\tt setoid\_replace}, which allows to
+structure and automate some parts of the work. In particular, if
+everything has been registered a simple
+tactic can do replacement just as if the two terms were equal.
+
+\asection{Adding new setoid or morphisms}
+
+Under the toplevel
+load the \texttt{setoid\_replace} files with the command:
+
+\begin{coq_example*}
+  Require Setoid.
+\end{coq_example*}
+
+A setoid is just a type \verb+A+ and an equivalence relation on \verb+A+.
+
+The specification of a setoid can be found in the file
+
+\begin{quotation}
+\begin{verbatim}
+theories/Setoids/Setoid.v
+\end{verbatim}
+\end{quotation}
+
+It looks like :
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+Section Setoid.
+
+Variable A : Type.
+Variable Aeq : A -> A -> Prop.
+
+Record Setoid_Theory : Prop :=
+{ Seq_refl : (x:A) (Aeq x x);
+  Seq_sym : (x,y:A) (Aeq x y) -> (Aeq y x);
+  Seq_trans : (x,y,z:A) (Aeq x y) -> (Aeq y z) -> (Aeq x z)
+}.
+\end{verbatim}
+\end{flushleft}
+\end{small}
+
+To define a setoid structure on \verb+A+, you must provide a relation
+\verb|Aeq| on \verb+A+ and prove that \verb|Aeq| is an equivalence
+relation. That is, you have to define an object of type
+\verb|(Setoid_Theory A Aeq)|.
+
+Finally to register a setoid the syntax is:
+
+\comindex{Add Setoid}
+\begin{quotation}
+  \texttt{Add Setoid} \textit{ A Aeq ST}
+\end{quotation}
+
+\noindent where \textit{Aeq} is a term of type \texttt{A->A->Prop} and
+\textit{ST} is a term of type 
+\texttt{(Setoid\_Theory }\textit{A Aeq}\texttt{)}.
+
+\begin{ErrMsgs}
+\item \errindex{Not a valid setoid theory}.\\ 
+  That happens when the typing condition does not hold.
+\item \errindex{A Setoid Theory is already declared for \textit{A}}.\\
+  That happens when you try to declare a second setoid theory for the
+  same type.
+\end{ErrMsgs}
+
+Currently, only one setoid structure
+may be declared for a given type.
+This allows automatic detection of the theory used to achieve the
+replacement.
+
+The table of setoid theories is compatible with the \Coq\ 
+sectioning mechanism. If you declare a setoid inside a section, the
+declaration will be thrown away when closing the section.
+And when you load a compiled file, all the \texttt{Add Setoid}
+commands of this file that are not inside a section will be loaded.
+
+\Warning Only the setoid on \texttt{Prop} is loaded by default with the
+\texttt{setoid\_replace} module. The equivalence relation used is
+\texttt{iff} {\it i.e.} the logical equivalence.
+
+\asection{Adding new morphisms}
+
+A morphism is nothing else than a function compatible with the
+equivalence relation. 
+You can only replace a term by an equivalent in position of argument
+of a morphism. That's why each morphism has to be
+declared to the system, which will ask you to prove the accurate
+compatibility lemma.
+
+The syntax is the following :
+\comindex{Add Morphism}
+\begin{quotation}
+  \texttt{Add Morphism} \textit{ f }:\textit{ ident}
+\end{quotation}
+
+\noindent where f is the name of a term which type is a non dependent
+product (the term you want to declare as a morphism) and
+\textit{ident} is a new identifier which will denote the
+compatibility lemma.
+
+\begin{ErrMsgs}
+\item \errindex{The term \term \ is already declared as a morphism}
+\item \errindex{The term \term \ is not a product}
+\item \errindex{The term \term \ should not be a dependent product}
+\end{ErrMsgs}
+
+The compatibility lemma generated depends on the setoids already
+declared.
+
+\asection{The tactic itself}
+\tacindex{setoid\_replace}
+\tacindex{setoid\_rewrite}
+
+After having registered all the setoids and morphisms you need, you can
+use the tactic called \texttt{setoid\_replace}. The syntax is
+
+\begin{quotation}
+\texttt{setoid\_replace} $ term_1$ with $term_2$
+\end{quotation}
+
+The effect is similar to the one of \texttt{replace}.
+
+You also have a tactic called \texttt{setoid\_rewrite} which is the
+equivalent of \texttt{rewrite} for setoids. The syntax is 
+
+\begin{quotation}
+\texttt{setoid\_rewrite} \term
+\end{quotation}
+
+\begin{Variants}
+ \item \texttt{setoid\_rewrite ->} \term
+ \item \texttt{setoid\_rewrite <-} \term
+\end{Variants}
+
+The arrow tells the system in which direction the rewriting has to be
+done. Moreover, you can use \texttt{rewrite} for setoid
+rewriting. In that case the system will check if the term you give is
+an equality or a setoid equivalence and do the appropriate work.
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/biblio.bib b/doc/refman/biblio.bib
new file mode 100644
index 00000000..378936d9
--- /dev/null
+++ b/doc/refman/biblio.bib
@@ -0,0 +1,1144 @@
+@string{jfp = "Journal of Functional Programming"}
+@STRING{lncs="Lecture Notes in Computer Science"}
+@STRING{lnai="Lecture Notes in Artificial Intelligence"}
+@string{SV = "{Sprin\-ger-Verlag}"}
+
+@INPROCEEDINGS{Aud91,
+        AUTHOR             = {Ph. Audebaud},
+        BOOKTITLE          = {Proceedings of the sixth Conf. on Logic in Computer Science.},
+        PUBLISHER          = {IEEE},
+        TITLE              = {Partial {Objects} in the {Calculus of Constructions}},
+        YEAR               = {1991}
+}
+
+@PHDTHESIS{Aud92,
+        AUTHOR             = {Ph. Audebaud},
+        SCHOOL             = {{Universit\'e} Bordeaux I},
+        TITLE              = {Extension du Calcul des Constructions par Points fixes},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Audebaud92b,
+        AUTHOR             = {Ph. Audebaud},
+        BOOKTITLE          = {{Proceedings of the 1992 Workshop on Types for Proofs and Programs}},
+        EDITOR             = {{B. Nordstr\"om and K. Petersson and G. Plotkin}},
+        NOTE               = {Also Research Report LIP-ENS-Lyon},
+        PAGES              = {pp 21--34},
+        TITLE              = {{CC+ : an extension of the Calculus of Constructions with fixpoints}},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Augustsson85,
+        AUTHOR             = {L. Augustsson},
+        TITLE              = {{Compiling Pattern Matching}},
+        BOOKTITLE          = {Conference Functional Programming and
+Computer Architecture},
+        YEAR               = {1985}
+}
+
+@ARTICLE{BaCo85,
+        AUTHOR             = {J.L. Bates and R.L. Constable},
+        JOURNAL            = {ACM transactions on Programming Languages and Systems},
+        TITLE              = {Proofs as {Programs}},
+        VOLUME             = {7},
+        YEAR               = {1985}
+}
+
+@BOOK{Bar81,
+        AUTHOR             = {H.P. Barendregt},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {The Lambda Calculus its Syntax and Semantics},
+        YEAR               = {1981}
+}
+
+@TECHREPORT{Bar91,
+        AUTHOR             = {H. Barendregt},
+        INSTITUTION        = {Catholic University Nijmegen},
+        NOTE               = {In Handbook of Logic in Computer Science, Vol II},
+        NUMBER             = {91-19},
+        TITLE              = {Lambda {Calculi with Types}},
+        YEAR               = {1991}
+}
+
+@ARTICLE{BeKe92,
+        AUTHOR             = {G. Bellin and J. Ketonen},
+        JOURNAL            = {Theoretical Computer Science},
+        PAGES              = {115--142},
+        TITLE              = {A decision procedure revisited : Notes on direct logic, linear logic and its implementation},
+        VOLUME             = {95},
+        YEAR               = {1992}
+}
+
+@BOOK{Bee85,
+        AUTHOR             = {M.J. Beeson},
+        PUBLISHER          = SV,
+        TITLE              = {Foundations of Constructive Mathematics, Metamathematical Studies},
+        YEAR               = {1985}
+}
+
+@BOOK{Bis67,
+        AUTHOR             = {E. Bishop},
+        PUBLISHER          = {McGraw-Hill},
+        TITLE              = {Foundations of Constructive Analysis},
+        YEAR               = {1967}
+}
+
+@BOOK{BoMo79,
+        AUTHOR             = {R.S. Boyer and J.S. Moore},
+        KEY                = {BoMo79},
+        PUBLISHER          = {Academic Press},
+        SERIES             = {ACM Monograph},
+        TITLE              = {A computational logic},
+        YEAR               = {1979}
+}
+
+@MASTERSTHESIS{Bou92,
+        AUTHOR             = {S. Boutin},
+        MONTH              = sep,
+        SCHOOL             = {{Universit\'e Paris 7}},
+        TITLE              = {Certification d'un compilateur {ML en Coq}},
+        YEAR               = {1992}
+}
+
+@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}
+}
+
+@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,
+        AUTHOR             = {N.J. de Bruijn},
+        JOURNAL            = {Indag. Math.},
+        TITLE              = {{Lambda-Calculus Notation with Nameless Dummies, a Tool for Automatic Formula Manipulation, with Application to the Church-Rosser Theorem}},
+        VOLUME             = {34},
+        YEAR               = {1972}
+}
+
+
+@INCOLLECTION{Bru80,
+        AUTHOR             = {N.J. de Bruijn},
+        BOOKTITLE          = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.},
+        EDITOR             = {J.P. Seldin and J.R. Hindley},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {A survey of the project {Automath}},
+        YEAR               = {1980}
+}
+
+@TECHREPORT{COQ93,
+        AUTHOR             = {G. Dowek and A. Felty and H. Herbelin and G. Huet and C. Murthy and C. Parent and C. Paulin-Mohring and B. Werner},
+        INSTITUTION        = {INRIA},
+        MONTH              = may,
+        NUMBER             = {154},
+        TITLE              = {{The Coq Proof Assistant User's Guide Version 5.8}},
+        YEAR               = {1993}
+}
+
+@TECHREPORT{COQ02,
+        AUTHOR             = {The Coq Development Team},
+        INSTITUTION        = {INRIA},
+        MONTH              = Feb,
+        NUMBER             = {255},
+        TITLE              = {{The Coq Proof Assistant Reference Manual Version 7.2}},
+        YEAR               = {2002}
+}
+
+@TECHREPORT{CPar93,
+        AUTHOR             = {C. Parent},
+        INSTITUTION        = {Ecole {Normale} {Sup\'erieure} de {Lyon}},
+        MONTH              = oct,
+        NOTE               = {Also in~\cite{Nijmegen93}},
+        NUMBER             = {93-29},
+        TITLE              = {Developing certified programs in the system {Coq}- {The} {Program} tactic},
+        YEAR               = {1993}
+}
+
+@PHDTHESIS{CPar95,
+        AUTHOR             = {C. Parent},
+        SCHOOL             = {Ecole {Normale} {Sup\'erieure} de {Lyon}},
+        TITLE              = {{Synth\`ese de preuves de programmes dans le Calcul des Constructions Inductives}},
+        YEAR               = {1995}
+}
+
+@BOOK{Caml,
+        AUTHOR             = {P. Weis and X. Leroy},
+        PUBLISHER          = {InterEditions},
+        TITLE              = {Le langage Caml},
+        YEAR               = {1993}
+}
+
+@INPROCEEDINGS{ChiPotSimp03,
+  AUTHOR    = {Laurent Chicli and Lo\"{\i}c Pottier and Carlos Simpson},
+  ADDRESS   = {Berg en Dal, The Netherlands},
+  TITLE     = {Mathematical Quotients and Quotient Types in Coq},
+  BOOKTITLE = {TYPES'02},
+  PUBLISHER = SV,
+  SERIES    = LNCS,
+  VOLUME    = {2646},
+  YEAR      = {2003}
+}
+
+@TECHREPORT{CoC89,
+        AUTHOR             = {Projet Formel},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {110},
+        TITLE              = {{The Calculus of Constructions. Documentation and user's guide, Version 4.10}},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{CoHu85a,
+        AUTHOR             = {Th. Coquand and G. Huet},
+        ADDRESS            = {Linz},
+        BOOKTITLE          = {EUROCAL'85},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {{Constructions : A Higher Order Proof System for Mechanizing Mathematics}},
+        VOLUME             = {203},
+        YEAR               = {1985}
+}
+
+@INPROCEEDINGS{CoHu85b,
+        AUTHOR             = {Th. Coquand and G. Huet},
+        BOOKTITLE          = {Logic Colloquium'85},
+        EDITOR             = {The Paris Logic Group},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {{Concepts Math\'ematiques et Informatiques formalis\'es dans le Calcul des Constructions}},
+        YEAR               = {1987}
+}
+
+@ARTICLE{CoHu86,
+        AUTHOR             = {Th. Coquand and G. Huet},
+        JOURNAL            = {Information and Computation},
+        NUMBER             = {2/3},
+        TITLE              = {The {Calculus of Constructions}},
+        VOLUME             = {76},
+        YEAR               = {1988}
+}
+
+@INPROCEEDINGS{CoPa89,
+        AUTHOR             = {Th. Coquand and C. Paulin-Mohring},
+        BOOKTITLE          = {Proceedings of Colog'88},
+        EDITOR             = {P. Martin-L\"of and G. Mints},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {Inductively defined types},
+        VOLUME             = {417},
+        YEAR               = {1990}
+}
+
+@BOOK{Con86,
+        AUTHOR             = {R.L. {Constable et al.}},
+        PUBLISHER          = {Prentice-Hall},
+        TITLE              = {{Implementing Mathematics with the Nuprl Proof Development System}},
+        YEAR               = {1986}
+}
+
+@PHDTHESIS{Coq85,
+        AUTHOR             = {Th. Coquand},
+        MONTH              = jan,
+        SCHOOL             = {Universit\'e Paris~7},
+        TITLE              = {Une Th\'eorie des Constructions},
+        YEAR               = {1985}
+}
+
+@INPROCEEDINGS{Coq86,
+        AUTHOR             = {Th. Coquand},
+        ADDRESS            = {Cambridge, MA},
+        BOOKTITLE          = {Symposium on Logic in Computer Science},
+        PUBLISHER          = {IEEE Computer Society Press},
+        TITLE              = {{An Analysis of Girard's Paradox}},
+        YEAR               = {1986}
+}
+
+@INPROCEEDINGS{Coq90,
+        AUTHOR             = {Th. Coquand},
+        BOOKTITLE          = {Logic and Computer Science},
+        EDITOR             = {P. Oddifredi},
+        NOTE               = {INRIA Research Report 1088, also in~\cite{CoC89}},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {{Metamathematical Investigations of a Calculus of Constructions}},
+        YEAR               = {1990}
+}
+
+@INPROCEEDINGS{Coq91,
+        AUTHOR             = {Th. Coquand},
+        BOOKTITLE          = {Proceedings 9th Int. Congress of Logic, Methodology and Philosophy of Science},
+        TITLE              = {{A New Paradox in Type Theory}},
+        MONTH              = {August},
+        YEAR               = {1991}
+}
+
+@INPROCEEDINGS{Coq92,
+        AUTHOR             = {Th. Coquand},
+        TITLE              = {{Pattern Matching with Dependent Types}},
+        YEAR               = {1992},
+        crossref = {Bastad92}
+}
+
+@INPROCEEDINGS{Coquand93,
+        AUTHOR             = {Th. Coquand},
+        TITLE              = {{Infinite Objects in Type Theory}},
+        YEAR               = {1993},
+        crossref = {Nijmegen93}
+}
+
+@MASTERSTHESIS{Cou94a,
+        AUTHOR             = {J. Courant},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique, ENS Lyon},
+        TITLE              = {Explicitation de preuves par r\'ecurrence implicite},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{Del99,
+  author    = "Delahaye, D.",
+  title     = "Information Retrieval in a Coq Proof Library using
+               Type Isomorphisms",
+  booktitle = {Proceedings of TYPES'99, L\"okeberg},
+  publisher = SV,
+  series = lncs,
+  year      = "1999",
+  url      =
+    "\\{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
+    "{\sf TYPES99-SIsos.ps.gz}"
+}
+
+@INPROCEEDINGS{Del00,
+  author    = "Delahaye, D.",
+  title     = "A {T}actic {L}anguage for the {S}ystem {{\sf Coq}}",
+  booktitle = "Proceedings of Logic for Programming and Automated Reasoning
+               (LPAR), Reunion Island",
+  publisher = SV,
+  series =  LNCS,
+  volume    = "1955",
+  pages     = "85--95",
+  month     = "November",
+  year      = "2000",
+  url      =
+    "{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
+    "{\sf LPAR2000-ltac.ps.gz}"
+}
+
+@INPROCEEDINGS{DelMay01,
+  author    = "Delahaye, D. and Mayero, M.",
+  title     = {{\tt Field}: une proc\'edure de d\'ecision pour les nombres r\'eels
+               en {\Coq}},
+  booktitle = "Journ\'ees Francophones des Langages Applicatifs, Pontarlier",
+  publisher = "INRIA",
+  month     = "Janvier",
+  year      = "2001",
+  url      =
+    "\\{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
+    "{\sf JFLA2000-Field.ps.gz}"
+}
+
+@TECHREPORT{Dow90,
+        AUTHOR             = {G. Dowek},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {1283},
+        TITLE              = {Naming and Scoping in a Mathematical Vernacular},
+        TYPE               = {Research Report},
+        YEAR               = {1990}
+}
+
+@ARTICLE{Dow91a,
+        AUTHOR             = {G. Dowek},
+        JOURNAL            = {Compte-Rendus de l'Acad\'emie des Sciences},
+        NOTE               = {The undecidability of Third Order Pattern Matching in Calculi with Dependent Types or Type Constructors},
+        NUMBER             = {12},
+        PAGES              = {951--956},
+        TITLE              = {L'Ind\'ecidabilit\'e du Filtrage du Troisi\`eme Ordre dans les Calculs avec Types D\'ependants ou Constructeurs de Types}, 
+        VOLUME             = {I, 312},
+        YEAR               = {1991}
+}		  
+
+@INPROCEEDINGS{Dow91b,
+        AUTHOR             = {G. Dowek},
+        BOOKTITLE          = {Proceedings of Mathematical Foundation of Computer Science},
+        NOTE               = {Also INRIA Research Report},
+        PAGES              = {151--160},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {A Second Order Pattern Matching Algorithm in the Cube of Typed $\lambda$-calculi},
+        VOLUME             = {520},
+        YEAR               = {1991}
+}
+                  
+@PHDTHESIS{Dow91c,
+        AUTHOR             = {G. Dowek},
+        MONTH              = dec,
+        SCHOOL             = {Universit\'e Paris 7},
+        TITLE              = {D\'emonstration automatique dans le Calcul des Constructions},
+        YEAR               = {1991}
+}
+
+@article{Dow92a,
+        AUTHOR             = {G. Dowek},
+        TITLE              = {The Undecidability of Pattern Matching in Calculi where Primitive Recursive Functions are Representable},
+        YEAR               = 1993,
+        journal = tcs,
+        volume = 107,
+        number = 2,
+        pages = {349-356}
+}
+
+
+@ARTICLE{Dow94a,
+        AUTHOR             = {G. Dowek},
+        JOURNAL            = {Annals of Pure and Applied Logic},
+        VOLUME             = {69},
+        PAGES              = {135--155},
+        TITLE              = {Third order matching is decidable},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{Dow94b,
+        AUTHOR             = {G. Dowek},
+        BOOKTITLE          = {Proceedings of the second international conference on typed lambda calculus and applications},
+        TITLE              = {Lambda-calculus, Combinators and the Comprehension Schema},
+        YEAR               = {1995}
+}
+
+@INPROCEEDINGS{Dyb91,
+        AUTHOR             = {P. Dybjer},
+        BOOKTITLE          = {Logical Frameworks},
+        EDITOR             = {G. Huet and G. Plotkin},
+        PAGES              = {59--79},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Inductive sets and families in {Martin-L{\"o}f's}
+ Type Theory and their set-theoretic semantics: An inversion principle for {Martin-L\"of's} type theory}, 
+        VOLUME             = {14},
+        YEAR               = {1991}
+}
+
+@ARTICLE{Dyc92,
+        AUTHOR             = {Roy Dyckhoff},
+        JOURNAL            = {The Journal of Symbolic Logic},
+        MONTH              = sep,
+        NUMBER             = {3},
+        TITLE              = {Contraction-free sequent calculi for intuitionistic logic},
+        VOLUME             = {57},
+        YEAR               = {1992}
+}
+
+@MASTERSTHESIS{Fil94,
+        AUTHOR             = {J.-C. Filli\^atre},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique, ENS Lyon},
+        TITLE              = {Une proc\'edure de d\'ecision pour le Calcul des Pr\'edicats Direct. {\'E}tude et impl\'ementation dans le syst\`eme {\Coq}},
+        YEAR               = {1994}
+}
+
+@TECHREPORT{Filliatre95,
+        AUTHOR             = {J.-C. Filli\^atre},
+        INSTITUTION        = {LIP-ENS-Lyon},
+        TITLE              = {A decision procedure for Direct Predicate Calculus},
+        TYPE               = {Research report},
+        NUMBER             = {96--25},
+        YEAR               = {1995}
+}
+
+@Article{Filliatre03jfp,
+  author = 	 {J.-C. Filli{\^a}tre},
+  title = 	 {Verification of Non-Functional Programs 
+                   using Interpretations in Type Theory},
+  journal =      jfp,
+  volume =       13,
+  number =       4,
+  pages =        {709--745},
+  month =	 jul,
+  year =	 2003,
+  note = 	 {[English translation of \cite{Filliatre99}]},
+  url =          {http://www.lri.fr/~filliatr/ftp/publis/jphd.ps.gz},
+  topics =       "team, lri",
+  type_publi =   "irevcomlec"
+}
+
+
+@PhdThesis{Filliatre99,
+  author = 	 {J.-C. Filli\^atre},
+  title = 	 {Preuve de programmes imp\'eratifs en th\'eorie des types},
+  type =         {Th{\`e}se de Doctorat},
+  school = 	 {Universit\'e Paris-Sud},
+  year = 	 1999,
+  month =	 {July},
+  url =         {\url{http://www.lri.fr/~filliatr/ftp/publis/these.ps.gz}}
+}
+
+@Unpublished{Filliatre99c,
+  author = 	 {J.-C. Filli\^atre},
+  title = 	 {{Formal Proof of a Program: Find}},
+  month =        {January},
+  year =         2000,
+  note = 	 {Submitted to \emph{Science of Computer Programming}},
+  url =         {\url{http://www.lri.fr/~filliatr/ftp/publis/find.ps.gz}}
+}
+
+@InProceedings{FilliatreMagaud99,
+  author = 	 {J.-C. Filli\^atre and N. Magaud},
+  title = 	 {Certification of sorting algorithms in the system {\Coq}},
+  booktitle =    {Theorem Proving in Higher Order Logics: 
+                  Emerging Trends},
+  year =	 1999,
+  url = {\url{http://www.lri.fr/~filliatr/ftp/publis/Filliatre-Magaud.ps.gz}}
+}
+
+@UNPUBLISHED{Fle90,
+        AUTHOR             = {E. Fleury},
+        MONTH              = jul,
+        NOTE               = {Rapport de Stage},
+        TITLE              = {Implantation des algorithmes de {Floyd et de Dijkstra} dans le {Calcul des Constructions}},
+        YEAR               = {1990}
+}
+
+@BOOK{Fourier,
+        AUTHOR             = {Jean-Baptiste-Joseph Fourier},
+        PUBLISHER          = {Gauthier-Villars},
+        TITLE              = {Fourier's method to solve linear 
+                              inequations/equations systems.},
+        YEAR               = {1890}
+}
+
+@INPROCEEDINGS{Gim94,
+        AUTHOR             = {E. Gim\'enez},
+        BOOKTITLE          = {Types'94 : Types for Proofs and Programs},
+        NOTE               = {Extended version in LIP research report 95-07, ENS Lyon},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {Codifying guarded definitions with recursive schemes},
+        VOLUME             = {996},
+        YEAR               = {1994}
+}
+
+@TechReport{Gim98,
+  author = 	 {E. Gim\'enez},
+  title = 	 {A Tutorial on Recursive Types in Coq},
+  institution =  {INRIA},
+  year = 	 1998,
+  month =	 mar
+}
+
+@INPROCEEDINGS{Gimenez95b,
+        AUTHOR             = {E. Gim\'enez},
+        BOOKTITLE          = {Workshop on Types for Proofs and Programs},
+        SERIES             = LNCS,
+        NUMBER             = {1158},
+        PAGES              = {135-152},
+        TITLE              = {An application of co-Inductive types in Coq: 
+		               verification of the Alternating Bit Protocol},
+        EDITORS            = {S. Berardi and M. Coppo},
+        PUBLISHER          = SV,
+        YEAR               = {1995}
+}
+
+@INPROCEEDINGS{Gir70,
+        AUTHOR             = {J.-Y. Girard},
+        BOOKTITLE          = {Proceedings of the 2nd Scandinavian Logic Symposium},
+        PUBLISHER          = {North-Holland},
+        TITLE              = {Une extension de l'interpr\'etation de {G\"odel} \`a l'analyse, et son application \`a l'\'elimination des coupures dans l'analyse et la th\'eorie des types},
+        YEAR               = {1970}
+}
+
+@PHDTHESIS{Gir72,
+        AUTHOR             = {J.-Y. Girard},
+        SCHOOL             = {Universit\'e Paris~7},
+        TITLE              = {Interpr\'etation fonctionnelle et \'elimination des coupures de l'arithm\'etique d'ordre sup\'erieur},
+        YEAR               = {1972}
+}
+
+
+
+@BOOK{Gir89,
+        AUTHOR             = {J.-Y. Girard and Y. Lafont and P. Taylor},
+        PUBLISHER          = {Cambridge University Press},
+        SERIES             = {Cambridge Tracts in Theoretical Computer Science 7},
+        TITLE              = {Proofs and Types},
+        YEAR               = {1989}
+}
+
+@TechReport{Har95,
+  author = 	 {John Harrison},
+  title = 	 {Metatheory and Reflection in Theorem Proving: A Survey and Critique},
+  institution =  {SRI International Cambridge Computer Science Research Centre,},
+  year = 	 1995,
+  type =	 {Technical Report},
+  number =	 {CRC-053},
+  abstract =	 {http://www.cl.cam.ac.uk/users/jrh/papers.html}
+}
+
+@MASTERSTHESIS{Hir94,
+        AUTHOR             = {D. Hirschkoff},
+        MONTH              = sep,
+        SCHOOL             = {DEA IARFA, Ecole des Ponts et Chauss\'ees, Paris},
+        TITLE              = {{\'E}criture d'une tactique arithm\'etique pour le syst\`eme {\Coq}},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{HofStr98,
+        AUTHOR        = {Martin Hofmann and Thomas Streicher},
+        TITLE         = {The groupoid interpretation of type theory},
+        BOOKTITLE     = {Proceedings of the meeting Twenty-five years of constructive type theory},
+        PUBLISHER     = {Oxford University Press},
+        YEAR          = {1998}
+} 
+
+@INCOLLECTION{How80,
+        AUTHOR             = {W.A. Howard},
+        BOOKTITLE          = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.},
+        EDITOR             = {J.P. Seldin and J.R. Hindley},
+        NOTE               = {Unpublished 1969 Manuscript},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {The Formulae-as-Types Notion of Constructions},
+        YEAR               = {1980}
+}
+
+
+
+@InProceedings{Hue87tapsoft,
+  author = 	 {G. Huet},
+  title = 	 {Programming of Future Generation Computers},
+  booktitle = 	 {Proceedings of TAPSOFT87},
+       series = LNCS,
+        volume = 249,
+  pages =	 {276--286},
+  year =	 1987,
+  publisher =	 SV
+}
+
+@INPROCEEDINGS{Hue87,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {Programming of Future Generation Computers},
+        EDITOR             = {K. Fuchi and M. Nivat},
+        NOTE               = {Also in \cite{Hue87tapsoft}},
+        PUBLISHER          = {Elsevier Science},
+        TITLE              = {Induction Principles Formalized in the {Calculus of Constructions}},
+        YEAR               = {1988}
+}
+
+
+
+@INPROCEEDINGS{Hue88,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {A perspective in Theoretical Computer Science. Commemorative Volume for Gift Siromoney},
+        EDITOR             = {R. Narasimhan},
+        NOTE               = {Also in~\cite{CoC89}},
+        PUBLISHER          = {World Scientific Publishing},
+        TITLE              = {{The Constructive Engine}},
+        YEAR               = {1989}
+}
+
+@BOOK{Hue89,
+        EDITOR             = {G. Huet},
+        PUBLISHER          = {Addison-Wesley},
+        SERIES             = {The UT Year of Programming Series},
+        TITLE              = {Logical Foundations of Functional Programming},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{Hue92,
+        AUTHOR             = {G. Huet},
+        BOOKTITLE          = {Proceedings of 12th FST/TCS Conference, New Delhi},
+        PAGES              = {229--240},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {The Gallina Specification Language : A case study},
+        VOLUME             = {652},
+        YEAR               = {1992}
+}
+
+@ARTICLE{Hue94,
+        AUTHOR             = {G. Huet},
+        JOURNAL            = {J. Functional Programming},
+        PAGES              = {371--394},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Residual theory in $\lambda$-calculus: a formal development},
+        VOLUME             = {4,3},
+        YEAR               = {1994}
+}
+
+@INCOLLECTION{HuetLevy79,
+        AUTHOR             = {G. Huet and J.-J. L\'{e}vy},
+        TITLE              = {Call by Need Computations in Non-Ambigous
+Linear Term Rewriting Systems},
+        NOTE               = {Also research report 359, INRIA, 1979},
+        BOOKTITLE          = {Computational Logic, Essays in Honor of
+Alan Robinson},
+        EDITOR             = {J.-L. Lassez and G. Plotkin},
+        PUBLISHER          = {The MIT press},
+        YEAR               = {1991}
+}
+
+@ARTICLE{KeWe84,
+        AUTHOR             = {J. Ketonen and R. Weyhrauch},
+        JOURNAL            = {Theoretical Computer Science},
+        PAGES              = {297--307},
+        TITLE              = {A decidable fragment of {P}redicate {C}alculus},
+        VOLUME             = {32},
+        YEAR               = {1984}
+}
+
+@BOOK{Kle52,
+        AUTHOR             = {S.C. Kleene},
+        PUBLISHER          = {North-Holland},
+        SERIES             = {Bibliotheca Mathematica},
+        TITLE              = {Introduction to Metamathematics},
+        YEAR               = {1952}
+}
+
+@BOOK{Kri90,
+        AUTHOR             = {J.-L. Krivine},
+        PUBLISHER          = {Masson},
+        SERIES             = {Etudes et recherche en informatique},
+        TITLE              = {Lambda-calcul {types et mod\`eles}},
+        YEAR               = {1990}
+}
+
+@BOOK{LE92,
+        EDITOR             = {G. Huet and G. Plotkin},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Logical Environments},
+        YEAR               = {1992}
+}
+
+@BOOK{LF91,
+        EDITOR             = {G. Huet and G. Plotkin},
+        PUBLISHER          = {Cambridge University Press},
+        TITLE              = {Logical Frameworks},
+        YEAR               = {1991}
+}
+
+@ARTICLE{Laville91,
+        AUTHOR             = {A. Laville},
+        TITLE              = {Comparison of Priority Rules in Pattern
+Matching and Term Rewriting},
+        JOURNAL            = {Journal of Symbolic Computation},
+        VOLUME             = {11},
+        PAGES              = {321--347},
+        YEAR               = {1991}
+}
+
+@INPROCEEDINGS{LePa94,
+        AUTHOR             = {F. Leclerc and C. Paulin-Mohring},
+        BOOKTITLE          = {{Types for Proofs and Programs, Types' 93}},
+        EDITOR             = {H. Barendregt and T. Nipkow},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{Programming with Streams in Coq. A case study : The Sieve of Eratosthenes}},
+        VOLUME             = {806},
+        YEAR               = {1994}
+}
+
+@TECHREPORT{Leroy90,
+        AUTHOR             = {X. Leroy},
+        TITLE              = {The {ZINC} experiment: an economical implementation
+of the {ML} language},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {117},
+        YEAR               = {1990}
+}
+
+@INPROCEEDINGS{Let02,
+        author          = {P. Letouzey},
+        title           = {A New Extraction for Coq},
+        booktitle       = {Proceedings of the TYPES'2002 workshop},
+        year            = 2002,
+        note            = {to appear},
+        url            = {draft at \url{http://www.lri.fr/~letouzey/download/extraction2002.ps.gz}}
+}
+
+@PHDTHESIS{Luo90,
+        AUTHOR             = {Z. Luo},
+        TITLE              = {An Extended Calculus of Constructions},
+        SCHOOL             = {University of Edinburgh},
+        YEAR               = {1990}
+}
+
+@BOOK{MaL84,
+        AUTHOR             = {{P. Martin-L\"of}},
+        PUBLISHER          = {Bibliopolis},
+        SERIES             = {Studies in Proof Theory},
+        TITLE              = {Intuitionistic Type Theory},
+        YEAR               = {1984}
+}
+
+@ARTICLE{MaSi94,
+        AUTHOR             = {P. Manoury and M. Simonot},
+        JOURNAL            = {TCS},
+        TITLE              = {Automatizing termination proof of recursively defined function},
+        YEAR               = {To appear}
+}
+
+@INPROCEEDINGS{Miquel00,
+        AUTHOR             = {A. Miquel},
+        TITLE              = {A Model for Impredicative Type Systems with Universes,
+Intersection Types and Subtyping},
+        BOOKTITLE          = {{Proceedings of the 15th Annual IEEE Symposium on Logic in Computer Science (LICS'00)}},
+        PUBLISHER          = {IEEE Computer Society Press},
+        YEAR               = {2000}
+}
+
+@PHDTHESIS{Miquel01a,
+        AUTHOR             = {A. Miquel},
+        TITLE              = {Le Calcul des Constructions implicite: syntaxe et s\'emantique},
+        MONTH              = {dec},
+        SCHOOL             = {{Universit\'e Paris 7}},
+        YEAR               = {2001}
+}
+
+@INPROCEEDINGS{Miquel01b,
+        AUTHOR             = {A. Miquel},
+        TITLE              = {The Implicit Calculus of Constructions: Extending Pure Type Systems with an Intersection Type Binder and Subtyping},
+        BOOKTITLE          = {{Proceedings of the fifth International Conference on Typed Lambda Calculi and Applications (TLCA01), Krakow, Poland}},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        NUMBER             = 2044,
+        YEAR               = {2001}
+}
+
+@INPROCEEDINGS{MiWer02,
+        AUTHOR             = {A. Miquel and B. Werner},
+        TITLE              = {The Not So Simple Proof-Irrelevant Model of CC},
+        BOOKTITLE          = {Types for Proofs and Programs (TYPES'02)},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        NUMBER             = 2646,
+        YEAR               = 2003
+}
+
+
+@INPROCEEDINGS{Moh89a,
+        AUTHOR             = {C. Paulin-Mohring},
+        ADDRESS            = {Austin},
+        BOOKTITLE          = {Sixteenth Annual ACM Symposium on Principles of Programming Languages},
+        MONTH              = jan,
+        PUBLISHER          = {ACM},
+        TITLE              = {Extracting ${F}_{\omega}$'s programs from proofs in the {Calculus of Constructions}},
+        YEAR               = {1989}
+}
+
+@PHDTHESIS{Moh89b,
+        AUTHOR             = {C. Paulin-Mohring},
+        MONTH              = jan,
+        SCHOOL             = {{Universit\'e Paris 7}},
+        TITLE              = {Extraction de programmes dans le {Calcul des Constructions}},
+        YEAR               = {1989}
+}
+
+@INPROCEEDINGS{Moh93,
+        AUTHOR             = {C. Paulin-Mohring},
+        BOOKTITLE          = {Proceedings of the conference Typed Lambda Calculi and Applications},
+        EDITOR             = {M. Bezem and J.-F. Groote},
+        NOTE               = {Also LIP research report 92-49, ENS Lyon},
+        NUMBER             = {664},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{Inductive Definitions in the System Coq - Rules and Properties}},
+        YEAR               = {1993}
+}
+
+@BOOK{Moh97,
+        AUTHOR             = {C. Paulin-Mohring},
+        MONTH              = jan,
+        PUBLISHER          = {{ENS Lyon}},
+        TITLE              = {{Le syst\`eme Coq. \mbox{Th\`ese d'habilitation}}},
+        YEAR               = {1997}
+}
+
+@MASTERSTHESIS{Mun94,
+        AUTHOR             = {C. Mu{\~n}oz},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique Fondamentale, Universit\'e Paris 7},
+        TITLE              = {D\'emonstration automatique dans la logique propositionnelle intuitionniste},
+        YEAR               = {1994}
+}
+
+@PHDTHESIS{Mun97d,
+        AUTHOR = "C. Mu{\~{n}}oz",
+        TITLE = "Un calcul de substitutions pour la repr\'esentation
+                  de preuves partielles en th\'eorie de types",
+        SCHOOL = {Universit\'e Paris 7},
+        YEAR = "1997",
+        Note = {Version en anglais disponible comme rapport de 
+                recherche INRIA RR-3309},        
+        Type = {Th\`ese de Doctorat}
+}
+
+@BOOK{NoPS90,
+        AUTHOR             = {B. {Nordstr\"om} and K. Peterson and J. Smith},
+        BOOKTITLE          = {Information Processing 83},
+        PUBLISHER          = {Oxford Science Publications},
+        SERIES             = {International Series of Monographs on Computer Science},
+        TITLE              = {Programming in {Martin-L\"of's} Type Theory},
+        YEAR               = {1990}
+}
+
+@ARTICLE{Nor88,
+        AUTHOR             = {B. {Nordstr\"om}},
+        JOURNAL            = {BIT},
+        TITLE              = {Terminating General Recursion},
+        VOLUME             = {28},
+        YEAR               = {1988}
+}
+
+@BOOK{Odi90,
+        EDITOR             = {P. Odifreddi},
+        PUBLISHER          = {Academic Press},
+        TITLE              = {Logic and Computer Science},
+        YEAR               = {1990}
+}
+
+@INPROCEEDINGS{PaMS92,
+        AUTHOR             = {M. Parigot and P. Manoury and M. Simonot},
+        ADDRESS            = {St. Petersburg, Russia},
+        BOOKTITLE          = {Logic Programming and automated reasoning},
+        EDITOR             = {A. Voronkov},
+        MONTH              = jul,
+        NUMBER             = {624},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{ProPre : A Programming language with proofs}},
+        YEAR               = {1992}
+}
+
+@ARTICLE{PaWe92,
+        AUTHOR             = {C. Paulin-Mohring and B. Werner},
+        JOURNAL            = {Journal of Symbolic Computation},
+        PAGES              = {607--640},
+        TITLE              = {{Synthesis of ML programs in the system Coq}},
+        VOLUME             = {15},
+        YEAR               = {1993}
+}
+
+@ARTICLE{Par92,
+        AUTHOR             = {M. Parigot},
+        JOURNAL            = {Theoretical Computer Science},
+        NUMBER             = {2},
+        PAGES              = {335--356},
+        TITLE              = {{Recursive Programming with Proofs}},
+        VOLUME             = {94},
+        YEAR               = {1992}
+}
+
+@INPROCEEDINGS{Parent95b,
+        AUTHOR             = {C. Parent},
+        BOOKTITLE          = {{Mathematics of Program Construction'95}},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{Synthesizing proofs from programs in
+the Calculus of Inductive Constructions}},
+        VOLUME             = {947},
+        YEAR               = {1995}
+}
+
+@INPROCEEDINGS{Prasad93,
+        AUTHOR             = {K.V. Prasad},
+        BOOKTITLE          = {{Proceedings of CONCUR'93}},
+        PUBLISHER          = SV,
+        SERIES             = {LNCS},
+        TITLE              = {{Programming with broadcasts}},
+        VOLUME             = {715},
+        YEAR               = {1993}
+}
+
+@BOOK{RC95,
+  author = "di~Cosmo, R.",
+  title  = "Isomorphisms of Types: from $\lambda$-calculus to information
+            retrieval and language design",
+  series = "Progress in Theoretical Computer Science",
+  publisher = "Birkhauser",
+  year = "1995",
+  note = "ISBN-0-8176-3763-X"
+}
+
+@TECHREPORT{Rou92,
+        AUTHOR             = {J. Rouyer},
+        INSTITUTION        = {INRIA},
+        MONTH              = nov,
+        NUMBER             = {1795},
+        TITLE              = {{D{\'e}veloppement de l'Algorithme d'Unification dans le Calcul des Constructions}},
+        YEAR               = {1992}
+}
+
+@TECHREPORT{Saibi94,
+        AUTHOR             = {A. Sa\"{\i}bi},
+        INSTITUTION        = {INRIA},
+        MONTH              = dec,
+        NUMBER             = {2345},
+        TITLE              = {{Axiomatization of a lambda-calculus with explicit-substitutions in the Coq System}},
+        YEAR               = {1994}
+}
+
+
+@MASTERSTHESIS{Ter92,
+        AUTHOR             = {D. Terrasse},
+        MONTH              = sep,
+        SCHOOL             = {IARFA},
+        TITLE              = {{Traduction de TYPOL en COQ. Application \`a Mini ML}},
+        YEAR               = {1992}
+}
+
+@TECHREPORT{ThBeKa92,
+        AUTHOR             = {L. Th\'ery and Y. Bertot and G. Kahn},
+        INSTITUTION        = {INRIA Sophia},
+        MONTH              = may,
+        NUMBER             = {1684},
+        TITLE              = {Real theorem provers deserve real user-interfaces},
+        TYPE               = {Research Report},
+        YEAR               = {1992}
+}
+
+@BOOK{TrDa89,
+        AUTHOR             = {A.S. Troelstra and D. van Dalen},
+        PUBLISHER          = {North-Holland},
+        SERIES             = {Studies in Logic and the foundations of Mathematics, volumes 121 and 123},
+        TITLE              = {Constructivism in Mathematics, an introduction},
+        YEAR               = {1988}
+}
+
+@PHDTHESIS{Wer94,
+        AUTHOR             = {B. Werner},
+        SCHOOL             = {Universit\'e Paris 7},
+        TITLE              = {Une th\'eorie des constructions inductives},
+        TYPE               = {Th\`ese de Doctorat},
+        YEAR               = {1994}
+}
+
+@PHDTHESIS{Bar99,
+        AUTHOR             = {B. Barras},
+        SCHOOL             = {Universit\'e Paris 7},
+        TITLE              = {Auto-validation d'un système de preuves avec familles inductives},
+        TYPE               = {Th\`ese de Doctorat},
+        YEAR               = {1999}
+}
+
+@UNPUBLISHED{ddr98,
+	AUTHOR	           = {D. de Rauglaudre},
+        TITLE              = {Camlp4 version 1.07.2},
+        YEAR               = {1998},
+        NOTE               = {In Camlp4 distribution}
+}
+
+@ARTICLE{dowek93,
+        AUTHOR             = {G. Dowek},
+        TITLE              = {{A Complete Proof Synthesis Method for the Cube of Type Systems}},
+        JOURNAL            = {Journal Logic Computation},
+        VOLUME             = {3},
+        NUMBER             = {3},
+        PAGES              = {287--315},
+        MONTH              = {June},
+        YEAR               = {1993}
+}
+
+@INPROCEEDINGS{manoury94,
+        AUTHOR             = {P. Manoury},
+        TITLE              = {{A User's Friendly Syntax to Define
+Recursive Functions as Typed $\lambda-$Terms}},
+        BOOKTITLE          = {{Types for Proofs and Programs, TYPES'94}},
+        SERIES             = {LNCS},
+        VOLUME             = {996},
+        MONTH              = jun,
+        YEAR               = {1994}
+}
+
+@TECHREPORT{maranget94,
+        AUTHOR             = {L. Maranget},
+        INSTITUTION        = {INRIA},
+        NUMBER             = {2385},
+        TITLE              = {{Two Techniques for Compiling Lazy Pattern Matching}},
+        YEAR               = {1994}
+}
+
+@INPROCEEDINGS{puel-suarez90,
+        AUTHOR             = {L.Puel and A. Su\'arez},
+        BOOKTITLE          = {{Conference Lisp and Functional Programming}},
+        SERIES             = {ACM},
+        PUBLISHER          = SV,
+        TITLE              = {{Compiling Pattern Matching by Term
+Decomposition}},
+        YEAR               = {1990}
+}
+
+@MASTERSTHESIS{saidi94,
+        AUTHOR             = {H. Saidi},
+        MONTH              = sep,
+        SCHOOL             = {DEA d'Informatique Fondamentale, Universit\'e Paris 7},
+        TITLE              = {R\'esolution d'\'equations dans le syst\`eme T
+ de G\"odel},
+        YEAR               = {1994}
+}
+
+@misc{streicher93semantical,
+  author = "T. Streicher",
+  title = "Semantical Investigations into Intensional Type Theory",
+  note = "Habilitationsschrift, LMU Munchen.",
+  year = "1993" }
+
+
+
+@Misc{Pcoq,
+  author =	 {Lemme Team},
+  title =	 {Pcoq a graphical user-interface for {Coq}},
+  note =	 {\url{http://www-sop.inria.fr/lemme/pcoq/}}
+}
+
+
+@Misc{ProofGeneral,
+  author =	 {David Aspinall},
+  title =	 {Proof General},
+  note =	 {\url{http://proofgeneral.inf.ed.ac.uk/}}
+}
+
+
+
+@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},
+        TITLE              = {Efficient  Compilation of Pattern Matching},
+        BOOKTITLE          = {The Implementation of Functional Programming
+Languages},
+        EDITOR             = {S.L. Peyton Jones},
+        PUBLISHER          = {Prentice-Hall},
+        YEAR               = {1987}
+}
+
+
+@COMMENT{cross-references, must be at end}
+
+@BOOK{Bastad92,
+        EDITOR             = {B. Nordstr\"om and K. Petersson and G. Plotkin},
+        PUBLISHER          = {Available by ftp at site ftp.inria.fr},
+        TITLE              = {Proceedings of the 1992 Workshop on Types for Proofs and Programs},
+        YEAR               = {1992}
+}
+
+@BOOK{Nijmegen93,
+        EDITOR             = {H. Barendregt and T. Nipkow},
+        PUBLISHER          = SV,
+        SERIES             = LNCS,
+        TITLE              = {Types for Proofs and Programs},
+        VOLUME             = {806},
+        YEAR               = {1994}
+}
+
diff --git a/doc/refman/coqdoc.tex b/doc/refman/coqdoc.tex
new file mode 100644
index 00000000..7862c5c3
--- /dev/null
+++ b/doc/refman/coqdoc.tex
@@ -0,0 +1,476 @@
+
+%\newcommand{\Coq}{\textsf{Coq}}
+\newcommand{\javadoc}{\textsf{javadoc}}
+\newcommand{\ocamldoc}{\textsf{ocamldoc}}
+\newcommand{\coqdoc}{\textsf{coqdoc}}
+\newcommand{\texmacs}{\TeX{}macs}
+\newcommand{\monurl}[1]{#1}
+%HEVEA\renewcommand{\monurl}[1]{\ahref{#1}{#1}}
+%HEVEA\newcommand{\lnot}{not}
+%HEVEA\newcommand{\lor}{or}
+%HEVEA\newcommand{\land}{\&}
+%%% attention : -- dans un argument de \texttt est affiché comme un
+%%% seul - d'où l'utilisation de la macro suivante
+\newcommand{\mm}{\symbol{45}\symbol{45}}
+
+
+\coqdoc\ is a documentation tool for the proof assistant
+\Coq, similar to \javadoc\ or \ocamldoc. 
+The task of \coqdoc\ is
+\begin{enumerate}
+\item to produce a nice \LaTeX\ and/or HTML document from the \Coq\ 
+  sources, readable for a human and not only for the proof assistant;
+\item to help the user navigating in his own (or third-party) sources.
+\end{enumerate}
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\subsection{Principles}
+
+Documentation is inserted into \Coq\ files as \emph{special comments}.  
+Thus your files will compile as usual, whether you use \coqdoc\ or not.
+\coqdoc\ presupposes that the given \Coq\ files are well-formed (at
+least lexically).  Documentation starts with
+\texttt{(**}, followed by a space, and ends with the pending \texttt{*)}. 
+The documentation format is inspired
+  by Todd~A.~Coram's \emph{Almost Free Text (AFT)} tool: it is mainly
+ASCII text with some syntax-light controls, described below.
+\coqdoc\ is robust: it shouldn't fail, whatever the input is. But
+remember: ``garbage in, garbage out''.
+
+\paragraph{\Coq\ material inside documentation.}
+\Coq\ material is quoted between the
+delimiters \texttt{[} and \texttt{]}. Square brackets may be nested,
+the inner ones being understood as being part of the quoted code (thus
+you can quote a term like $[x:T]u$ by writing
+\texttt{[[x:T]u]}). Inside quotations, the code is pretty-printed in
+the same way as it is in code parts.
+
+Pre-formatted vernacular is enclosed by \texttt{[[} and
+\texttt{]]}. The former must be followed by a newline and the latter
+must follow a newline.
+
+\paragraph{Pretty-printing.}
+\coqdoc\ uses different faces for identifiers and keywords.  
+The pretty-printing of \Coq\ tokens (identifiers or symbols) can be
+controlled using one of the following commands:
+\begin{alltt}
+(** printing \emph{token} %...\LaTeX...% #...HTML...# *)
+\end{alltt}
+or
+\begin{alltt}
+(** printing \emph{token} $...\LaTeX\ math...$ #...HTML...# *)
+\end{alltt}
+It gives the \LaTeX\ and HTML texts to be produced for the given \Coq\
+token. One of the \LaTeX\ or HTML text may be ommitted, causing the
+default pretty-printing to be used for this token.
+
+The printing for one token can be removed with
+\begin{alltt}
+(** remove printing \emph{token} *)
+\end{alltt}
+
+Initially, the pretty-printing table contains the following mapping:
+\begin{center}
+  \begin{tabular}{ll@{\qquad\qquad}ll@{\qquad\qquad}ll@{\qquad\qquad}}
+    \verb!->!            & $\rightarrow$   &
+    \verb!<-!            & $\leftarrow$    &
+    \verb|*|             & $\times$        \\
+    \verb|<=|            & $\le$           &
+    \verb|>=|            & $\ge$           &
+    \verb|=>|            & $\Rightarrow$   \\
+    \verb|<>|            & $\not=$         &
+    \verb|<->|           & $\leftrightarrow$ &
+    \verb!|-!            & $\vdash$        \\
+    \verb|\/|            & $\lor$          &
+    \verb|/\|            & $\land$         &
+    \verb|~|             & $\lnot$ 
+  \end{tabular}
+\end{center}
+Any of these can be overwritten or suppressed using the
+\texttt{printing} commands.
+
+Important note: the recognition of tokens is done by a (ocaml)lex
+automaton and thus applies the longest-match rule. For instance,
+\verb!->~! is recognized as a single token, where \Coq\ sees two
+tokens. It is the responsability of the user to insert space between
+tokens \emph{or} to give pretty-printing rules for the possible
+combinations, e.g. 
+\begin{verbatim}
+(** printing ->~ %\ensuremath{\rightarrow\lnot}% *)
+\end{verbatim}
+
+
+\paragraph{Sections.}
+Sections are introduced by 1 to 4 leading stars (i.e. at the beginning of the
+line). One star is a section, two stars a sub-section, etc.
+The section title is given on the remaining of the line.
+Example:
+\begin{verbatim}
+    (** * Well-founded relations
+  
+        In this section, we introduce...  *)
+\end{verbatim}
+
+
+%TODO \paragraph{Fonts.}
+
+
+\paragraph{Lists.}
+List items are introduced by 1 to 4 leading dashes.
+Deepness of the list is indicated by the number of dashes.
+List ends with a blank line.
+Example:
+\begin{verbatim}
+    This module defines
+        - the predecessor [pred]
+        - the addition [plus]
+        - order relations:
+          -- less or equal [le]
+          -- less [lt]
+\end{verbatim}
+
+\paragraph{Rules.}
+More than 4 leading dashes produce an horizontal rule.
+
+
+\paragraph{Escapings to \LaTeX\ and HTML.}
+Pure \LaTeX\ or HTML material can be inserted using the following
+escape sequences:
+\begin{itemize}
+\item \verb+$...LaTeX stuff...$+ inserts some \LaTeX\ material in math mode.
+  Simply discarded in HTML output.
+
+\item \verb+%...LaTeX stuff...%+ inserts some \LaTeX\ material.
+  Simply discarded in HTML output.
+
+\item \verb+#...HTML stuff...#+ inserts some HTML material. Simply
+  discarded in \LaTeX\ output.
+\end{itemize}
+
+
+\paragraph{Verbatim.} 
+Verbatim material is introduced by a leading \verb+<<+ and closed by
+\verb+>>+. Example:
+\begin{verbatim}
+Here is the corresponding caml code:
+<<
+  let rec fact n = 
+    if n <= 1 then 1 else n * fact (n-1)
+>>
+\end{verbatim}
+
+
+\paragraph{Hyperlinks.}
+Hyperlinks can be inserted into the HTML output, so that any
+identifier is linked to the place of its definition.
+
+In order to get hyperlinks you need to first compile your \Coq\ file
+using \texttt{coqc \mm{}dump-glob \emph{file}}; this appends 
+\Coq\ names resolutions done during the compilation to file
+\texttt{\emph{file}}. Take care of erasing this file, if any, when
+starting the whole compilation process.
+
+Then invoke \texttt{coqdoc \mm{}glob-from \emph{file}} to tell
+\coqdoc\ to look for name resolutions into the file \texttt{\emph{file}}.
+
+Identifiers from the \Coq\ standard library are linked to the \Coq\
+web site at \url{http://coq.inria.fr/library/}. This behavior can be
+changed using command line options \url{--no-externals} and
+\url{--coqlib}; see below.
+
+
+\paragraph{Hiding / Showing parts of the source.}
+Some parts of the source can be hidden using command line options
+\texttt{-g} and \texttt{-l} (see below), or using such comments:
+\begin{alltt}
+(* begin hide *)
+\emph{some Coq material}
+(* end hide *)
+\end{alltt}
+Conversely, some parts of the source which would be hidden can be
+shown using such comments: 
+\begin{alltt}
+(* begin show *)
+\emph{some Coq material}
+(* end show *)
+\end{alltt}
+The latter cannot be used around some inner parts of a proof, but can
+be used around a whole proof.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\subsection{Usage}
+
+\coqdoc\ is invoked on a shell command line as follows:
+\begin{displaymath}
+  \texttt{coqdoc }<\textit{options and files}>
+\end{displaymath}
+Any command line argument which is not an option is considered to be a
+file (even if it starts with a \verb!-!). \Coq\ files are identified
+by the suffixes \verb!.v! and \verb!.g! and \LaTeX\ files by the
+suffix \verb!.tex!. 
+
+\begin{description}
+\item[HTML output] ~\par
+  This is the default output.
+  One HTML file is created for each \Coq\ file given on the command line,
+  together with a file \texttt{index.html} (unless option
+  \texttt{-no-index} is passed). The HTML pages use a style sheet
+  named \texttt{style.css}. Such a file is distributed with \coqdoc.
+
+\item[\LaTeX\ output] ~\par
+  A single \LaTeX\ file is created, on standard output. It can be
+  redirected to a file with option \texttt{-o}. 
+  The order of files on the command line is kept in the final
+  document. \LaTeX\ files given on the command line are copied `as is'
+  in the final document .
+  DVI and PostScript can be produced directly with the options
+  \texttt{-dvi} and \texttt{-ps} respectively.
+
+\item[\texmacs\ output] ~\par
+  To translate the input files to \texmacs\ format, to be used by
+  the \texmacs\ Coq interface 
+  (see \url{http://www-sop.inria.fr/lemme/Philippe.Audebaud/tmcoq/}).
+\end{description}
+
+
+\subsubsection*{Command line options}
+
+
+\paragraph{Overall options}
+
+\begin{description}
+
+\item[\texttt{\mm{}html}] ~\par
+  
+  Select a HTML output.
+
+\item[\texttt{\mm{}latex}] ~\par
+  
+  Select a \LaTeX\ output.
+
+\item[\texttt{\mm{}dvi}] ~\par
+  
+  Select a DVI output.
+
+\item[\texttt{\mm{}ps}] ~\par
+  
+  Select a PostScript output.
+
+\item[\texttt{\mm{}texmacs}] ~\par
+  
+  Select a \texmacs\ output.
+
+\item[\texttt{-o }\textit{file}, \texttt{\mm{}output }\textit{file}] ~\par
+  
+  Redirect the output into the file `\textit{file}' (meaningless with
+  \texttt{-html}).
+
+\item[\texttt{-d }\textit{dir}, \texttt{\mm{}directory }\textit{dir}] ~\par
+
+  Output files into directory `\textit{dir}' instead of current
+  directory (option \texttt{-d} does not change the filename specified
+  with option \texttt{-o}, if any).
+
+\item[\texttt{-s }, \texttt{\mm{}short}] ~\par
+  
+  Do not insert titles for the files. The default behavior is to
+  insert a title like ``Library Foo'' for each file.
+
+\item[\texttt{-t }\textit{string}, 
+      \texttt{\mm{}title }\textit{string}] ~\par
+  
+  Set the document title.      
+
+\item[\texttt{\mm{}body-only}] ~\par
+
+  Suppress the header and trailer of the final document. Thus, you can
+  insert the resulting document into a larger one.
+
+\item[\texttt{-p} \textit{string}, \texttt{\mm{}preamble} \textit{string}]~\par
+
+  Insert some material in the \LaTeX\ preamble, right before
+  \verb!\begin{document}! (meaningless with \texttt{-html}).
+
+\item[\texttt{\mm{}vernac-file }\textit{file},
+      \texttt{\mm{}tex-file }\textit{file}] ~\par
+      
+      Considers the file `\textit{file}' respectively as a \verb!.v!
+      (or \verb!.g!) file or a \verb!.tex! file.
+
+\item[\texttt{\mm{}files-from }\textit{file}] ~\par
+
+  Read file names to process in file `\textit{file}' as if they were
+  given on the command line. Useful for program sources splitted in
+  several directories.
+  
+\item[\texttt{-q}, \texttt{\mm{}quiet}] ~\par
+
+  Be quiet. Do not print anything except errors.
+
+\item[\texttt{-h}, \texttt{\mm{}help}] ~\par
+
+  Give a short summary of the options and exit.
+
+\item[\texttt{-v}, \texttt{\mm{}version}] ~\par
+
+  Print the version and exit.
+
+\end{description}
+
+\paragraph{Index options} ~\par
+
+Default behavior is to build an index, for the HTML output only, into
+\texttt{index.html}.
+
+\begin{description}
+
+\item[\texttt{\mm{}no-index}] ~\par
+  
+  Do not output the index.
+
+\item[\texttt{\mm{}multi-index}] ~\par
+  
+  Generate one page for each category and each letter in the index,
+  together with a top page \texttt{index.html}.
+
+\end{description}
+
+\paragraph{Table of contents option} ~\par
+
+\begin{description}
+
+\item[\texttt{-toc}, \texttt{\mm{}table-of-contents}] ~\par
+
+  Insert a table of contents.
+  For a \LaTeX\ output, it inserts a \verb!\tableofcontents! at the
+  beginning of the document. For a HTML output, it builds a table of
+  contents into \texttt{toc.html}.
+
+\end{description}
+
+\paragraph{Hyperlinks options}
+\begin{description}
+
+\item[\texttt{\mm{}glob-from }\textit{file}] ~\par
+  
+  Make references using \Coq\ globalizations from file \textit{file}. 
+  (Such globalizations are obtained with \Coq\ option \texttt{-dump-glob}).
+
+\item[\texttt{\mm{}no-externals}] ~\par
+  
+  Do not insert links to the \Coq\ standard library.
+
+\item[\texttt{\mm{}coqlib }\textit{url}] ~\par
+
+  Set base URL for the \Coq\ standard library (default is 
+  \url{http://coq.inria.fr/library/}).
+
+\item[\texttt{-R }\textit{dir }\textit{coqdir}] ~\par
+
+  Map physical directory \textit{dir} to \Coq\ logical directory
+  \textit{coqdir} (similarly to \Coq\ option \texttt{-R}).
+
+  Note: option \texttt{-R} only has effect on the files
+  \emph{following} it on the command line, so you will probably need
+  to put this option first.
+
+\end{description}
+
+\paragraph{Contents options}
+\begin{description}
+
+\item[\texttt{-g}, \texttt{\mm{}gallina}] ~\par
+
+  Do not print proofs.
+
+\item[\texttt{-l}, \texttt{\mm{}light}] ~\par
+  
+  Light mode. Suppress proofs (as with \texttt{-g}) and the following commands:
+  \begin{itemize}
+  \item {}[\texttt{Recursive}] \texttt{Tactic Definition}
+  \item \texttt{Hint / Hints} 
+  \item \texttt{Require}
+  \item \texttt{Transparent / Opaque}
+  \item \texttt{Implicit Argument / Implicits}
+  \item \texttt{Section / Variable / Hypothesis / End}
+  \end{itemize}
+
+\end{description}
+The behavior of options \texttt{-g} and \texttt{-l} can be locally
+overridden using the \texttt{(* begin show *)} \dots\ \texttt{(* end
+  show *)} environment (see above).
+
+\paragraph{Language options} ~\par
+
+Default behavior is to assume ASCII 7 bits input files.
+
+\begin{description}
+
+\item[\texttt{-latin1}, \texttt{\mm{}latin1}] ~\par
+
+  Select ISO-8859-1 input files. It is equivalent to
+  \texttt{--inputenc latin1 --charset iso-8859-1}.
+
+\item[\texttt{-utf8}, \texttt{\mm{}utf8}] ~\par
+
+  Select UTF-8 (Unicode) input files. It is equivalent to
+  \texttt{--inputenc utf8 --charset utf-8}.
+  \LaTeX\ UTF-8 support can be found at
+ \url{http://www.ctan.org/tex-archive/macros/latex/contrib/supported/unicode/}.
+
+\item[\texttt{\mm{}inputenc} \textit{string}] ~\par
+
+  Give a \LaTeX\ input encoding, as an option to \LaTeX\ package
+  \texttt{inputenc}. 
+
+\item[\texttt{\mm{}charset} \textit{string}] ~\par
+
+  Specify the HTML character set, to be inserted in the HTML header.
+
+\end{description}
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\subsection{The coqdoc \LaTeX{} style file}
+\label{section:coqdoc.sty}
+
+In case you choose to produce a document without the default \LaTeX{}
+preamble (by using option \verb|--no-preamble|), then you must insert
+into your own preamble the command
+\begin{quote}
+  \verb|\usepackage{coqdoc}|
+\end{quote}
+Then you may alter the rendering of the document by
+redefining some macros:
+\begin{description}
+
+\item[\texttt{coqdockw}, \texttt{coqdocid}] ~ 
+  
+  The one-argument macros for typesetting keywords and identifiers.
+  Defaults are sans-serif for keywords and italic for identifiers.
+
+  For example, if you would like a slanted font for keywords, you
+  may insert  
+\begin{verbatim}
+     \renewcommand{\coqdockw}[1]{\textsl{#1}}
+\end{verbatim}
+  anywhere between \verb|\usepackage{coqdoc}| and
+  \verb|\begin{document}|. 
+
+\item[\texttt{coqdocmodule}] ~ 
+  
+  One-argument macro for typesetting the title of a \verb|.v| file.
+  Default is
+\begin{verbatim}
+\newcommand{\coqdocmodule}[1]{\section*{Module #1}}
+\end{verbatim}
+  and you may redefine it using \verb|\renewcommand|.
+
+\end{description}
+
+
diff --git a/doc/refman/coqide-queries.png b/doc/refman/coqide-queries.png
new file mode 100644
index 00000000..dea5626f
--- /dev/null
+++ b/doc/refman/coqide-queries.png
diff --git a/doc/refman/coqide.png b/doc/refman/coqide.png
new file mode 100644
index 00000000..a6a0f585
--- /dev/null
+++ b/doc/refman/coqide.png
diff --git a/doc/refman/cover.html b/doc/refman/cover.html
new file mode 100644
index 00000000..1d2700b1
--- /dev/null
+++ b/doc/refman/cover.html
@@ -0,0 +1,36 @@
+<HTML>
+
+<HEAD>
+<TITLE>Cover Page</TITLE>
+</HEAD>
+
+<BODY>
+
+<DIV ALIGN=center>
+<FONT SIZE=7>
+</FONT><FONT SIZE=7><B>
+&nbsp<P><P><P>
+The Coq Proof Assistant<BR>
+ Reference Manual<BR></B></FONT><FONT SIZE=7>
+</FONT>
+<BR><BR><FONT SIZE=5><B><BR></B></FONT><FONT SIZE=5><B>Version 8.0</B></FONT><FONT SIZE=5><B>
+</B></FONT><A NAME="text1"></A><A HREF="#note1"><SUP><FONT SIZE=2>1</FONT></SUP></A><FONT SIZE=5><B><BR><BR><BR><BR><BR><BR>
+</B></FONT><FONT SIZE=5><B>The Coq Development Team</B></FONT><FONT SIZE=5><B><BR></B></FONT><FONT SIZE=5><B>LogiCal Project</B></FONT><FONT SIZE=5><B><BR><BR><BR>
+</B></FONT></DIV><BR>
+<BR><BR><BR><BR><BR><BR>
+
+<DIV ALIGN=left>
+<FONT SIZE=4>V7.x © INRIA 1999-2004</FONT><BR>
+<FONT SIZE=4>V8.0 © INRIA 2004-2006</FONT><BR>
+This material may be distributed only subject to the terms and conditions set forth in the Open Publication License, v1.0 or later (the latest version is presently available at <A HREF="http://www.opencontent.org/openpub">http://www.opencontent.org/openpub</A>). Options A and B are not elected.
+</DIV>
+<BR>
+
+<HR WIDTH="50%" SIZE=1><DL><DT><A NAME="note1" HREF="toc.html#text1"><FONT SIZE=5>1</FONT></A><DD>This research was partly supported by IST working group ``Types''
+</DL>
+
+</BODY>
+
+</HTML></BODY>
+
+</HTML>
diff --git a/doc/refman/headers.tex b/doc/refman/headers.tex
new file mode 100644
index 00000000..21b3b6e8
--- /dev/null
+++ b/doc/refman/headers.tex
@@ -0,0 +1,102 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% File title.tex
+% Pretty Headers
+% And commands for multiple indexes
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\usepackage{fancyhdr}
+
+\setlength{\headheight}{14pt}
+
+\pagestyle{fancyplain}
+
+\newcommand{\coqfooter}{\tiny Coq Reference Manual, V\coqversion{}, \today}
+
+\cfoot{}
+\lfoot[{\coqfooter}]{}
+\rfoot[]{{\coqfooter}}
+
+\newcommand{\setheaders}[1]{\rhead[\fancyplain{}{\textbf{#1}}]{\fancyplain{}{\thepage}}\lhead[\fancyplain{}{\thepage}]{\fancyplain{}{\textbf{#1}}}}
+\newcommand{\defaultheaders}{\rhead[\fancyplain{}{\leftmark}]{\fancyplain{}{\thepage}}\lhead[\fancyplain{}{\thepage}]{\fancyplain{}{\rightmark}}}
+
+\renewcommand{\chaptermark}[1]{\markboth{{\bf \thechapter~#1}}{}}
+\renewcommand{\sectionmark}[1]{\markright{\thesection~#1}}
+%BEGIN LATEX
+\renewcommand{\contentsname}{%
+\protect\setheaders{Table of contents}Table of contents}
+\renewcommand{\bibname}{\protect\setheaders{Bibliography}%
+\protect\RefManCutCommand{BEGINBIBLIO=\thepage}%
+\protect\addcontentsline{toc}{chapter}{Bibliography}Bibliography}
+%END LATEX
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% For the Addendum table of contents
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\newcommand{\aauthor}[1]{{\LARGE \bf #1} \bigskip \bigskip \bigskip}
+\makeatletter
+%BEGIN LATEX
+\newcommand{\atableofcontents}{\section*{Contents}\@starttoc{atoc}}
+\newcommand{\achapter}[1]{
+  \chapter{#1}\addcontentsline{atoc}{chapter}{#1}}
+\newcommand{\asection}[1]{
+  \section{#1}\addcontentsline{atoc}{section}{#1}}
+\newcommand{\asubsection}[1]{
+  \subsection{#1}\addcontentsline{atoc}{subsection}{#1}}
+\newcommand{\asubsubsection}[1]{
+  \subsubsection{#1}\addcontentsline{atoc}{subsubsection}{#1}}
+%END LATEX
+%HEVEA \newcommand{\atableofcontents}{}
+%HEVEA \newcommand{\achapter}[1]{\chapter{#1}}
+%HEVEA \newcommand{\asection}{\section}
+%HEVEA \newcommand{\asubsection}{\subsection}
+%HEVEA \newcommand{\asubsubsection}{\subsubsection}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Reference-Manual.sh is generated to cut the Postscript
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%\@starttoc{sh}
+%BEGIN LATEX
+\newwrite\RefManCut@out%
+\immediate\openout\RefManCut@out\jobname.sh
+\newcommand{\RefManCutCommand}[1]{%
+\immediate\write\RefManCut@out{#1}}
+\newcommand{\RefManCutClose}{%
+\immediate\closeout\RefManCut@out}
+%END LATEX
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Commands for indexes
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\usepackage{index}
+\makeindex
+\newindex{tactic}{tacidx}{tacind}{%
+\protect\setheaders{Tactics Index}%
+\protect\addcontentsline{toc}{chapter}{Tactics Index}Tactics Index}
+
+\newindex{command}{comidx}{comind}{%
+\protect\setheaders{Vernacular Commands Index}%
+\protect\addcontentsline{toc}{chapter}{Vernacular Commands Index}%
+Vernacular Commands Index}
+
+\newindex{error}{erridx}{errind}{%
+\protect\setheaders{Index of Error Messages}%
+\protect\addcontentsline{toc}{chapter}{Index of Error Messages}Index of Error Messages}
+
+\renewindex{default}{idx}{ind}{%
+\protect\addcontentsline{toc}{chapter}{Global Index}%
+\protect\setheaders{Global Index}Global Index}
+
+\newcommand{\tacindex}[1]{%
+\index{#1@\texttt{#1}}\index[tactic]{#1@\texttt{#1}}}
+\newcommand{\comindex}[1]{%
+\index{#1@\texttt{#1}}\index[command]{#1@\texttt{#1}}}
+\newcommand{\errindex}[1]{\texttt{#1}\index[error]{#1}}
+\newcommand{\errindexbis}[2]{\texttt{#1}\index[error]{#2}}
+\newcommand{\ttindex}[1]{\index{#1@\texttt{#1}}}
+\makeatother
+
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "Reference-Manual"
+%%% End: 
diff --git a/doc/refman/hevea.sty b/doc/refman/hevea.sty
new file mode 100644
index 00000000..6d49aa8c
--- /dev/null
+++ b/doc/refman/hevea.sty
@@ -0,0 +1,78 @@
+% hevea  : hevea.sty
+% This is a very basic style file for latex document to be processed
+% with hevea. It contains definitions of LaTeX environment which are
+% processed in a special way by the translator. 
+%  Mostly :
+%     - latexonly, not processed by hevea, processed by latex.
+%     - htmlonly , the reverse.
+%     - rawhtml,  to include raw HTML in hevea output.
+%     - toimage, to send text to the image file.
+% The package also provides hevea logos, html related commands (ahref
+% etc.), void cutting and image commands.
+\NeedsTeXFormat{LaTeX2e}
+\ProvidesPackage{hevea}[2002/01/11]
+\RequirePackage{comment}
+\newif\ifhevea\heveafalse
+\@ifundefined{ifimagen}{\newif\ifimagen\imagenfalse}
+\makeatletter%
+\newcommand{\heveasmup}[2]{%
+\raise #1\hbox{$\m@th$%
+  \csname S@\f@size\endcsname
+  \fontsize\sf@size 0%
+  \math@fontsfalse\selectfont
+#2%
+}}%
+\DeclareRobustCommand{\hevea}{H\kern-.15em\heveasmup{.2ex}{E}\kern-.15emV\kern-.15em\heveasmup{.2ex}{E}\kern-.15emA}%
+\DeclareRobustCommand{\hacha}{H\kern-.15em\heveasmup{.2ex}{A}\kern-.15emC\kern-.1em\heveasmup{.2ex}{H}\kern-.15emA}%
+\DeclareRobustCommand{\html}{\protect\heveasmup{0.ex}{HTML}}
+%%%%%%%%% Hyperlinks hevea style
+\newcommand{\ahref}[2]{{#2}}
+\newcommand{\ahrefloc}[2]{{#2}}
+\newcommand{\aname}[2]{{#2}}
+\newcommand{\ahrefurl}[1]{\texttt{#1}}
+\newcommand{\footahref}[2]{#2\footnote{\texttt{#1}}}
+\newcommand{\mailto}[1]{\texttt{#1}}
+\newcommand{\imgsrc}[2][]{}
+\newcommand{\home}[1]{\protect\raisebox{-.75ex}{\char126}#1}
+\AtBeginDocument
+{\@ifundefined{url}
+{%url package is not loaded
+\let\url\ahref\let\oneurl\ahrefurl\let\footurl\footahref}
+{}}
+%% Void cutting instructions
+\newcounter{cuttingdepth}
+\newcommand{\tocnumber}{}
+\newcommand{\notocnumber}{}
+\newcommand{\cuttingunit}{}
+\newcommand{\cutdef}[2][]{}
+\newcommand{\cuthere}[2]{}
+\newcommand{\cutend}{}
+\newcommand{\htmlhead}[1]{}
+\newcommand{\htmlfoot}[1]{}
+\newcommand{\htmlprefix}[1]{}
+\newenvironment{cutflow}[1]{}{}
+\newcommand{\cutname}[1]{}
+\newcommand{\toplinks}[3]{}
+%%%% Html only
+\excludecomment{rawhtml}
+\newcommand{\rawhtmlinput}[1]{}
+\excludecomment{htmlonly}
+%%%% Latex only
+\newenvironment{latexonly}{}{}
+\newenvironment{verblatex}{}{}
+%%%% Image file stuff
+\def\toimage{\endgroup}
+\def\endtoimage{\begingroup\def\@currenvir{toimage}}
+\def\verbimage{\endgroup}
+\def\endverbimage{\begingroup\def\@currenvir{verbimage}}
+\newcommand{\imageflush}[1][]{}
+%%% Bgcolor definition
+\newsavebox{\@bgcolorbin}
+\newenvironment{bgcolor}[2][]
+  {\newcommand{\@mycolor}{#2}\begin{lrbox}{\@bgcolorbin}\vbox\bgroup}
+  {\egroup\end{lrbox}%
+   \begin{flushleft}%
+   \colorbox{\@mycolor}{\usebox{\@bgcolorbin}}%
+   \end{flushleft}}
+%%% Postlude
+\makeatother
diff --git a/doc/refman/index.html b/doc/refman/index.html
new file mode 100644
index 00000000..db19678f
--- /dev/null
+++ b/doc/refman/index.html
@@ -0,0 +1,29 @@
+<HTML>
+
+<BODY>
+
+<CENTER>
+
+<TABLE BORDER="0" CELLPADDING=10>
+<TR>
+<TD><CENTER><A HREF="cover.html" TARGET="UP"><FONT SIZE=2>Cover page</FONT></A></CENTER></TD>
+<TD><CENTER><A HREF="toc.html" TARGET="UP"><FONT SIZE=2>Table of contents</FONT></A></CENTER></TD>
+<TD><CENTER><A HREF="biblio.html" TARGET="UP"><FONT SIZE=2>
+Bibliography</FONT></A></CENTER></TD>
+<TD><CENTER><A HREF="general-index.html" TARGET="UP"><FONT SIZE=2>
+Global Index
+</FONT></A></CENTER></TD>
+<TD><CENTER><A HREF="tactic-index.html" TARGET="UP"><FONT SIZE=2>
+Tactics Index
+</FONT></A></CENTER></TD>
+<TD><CENTER><A HREF="command-index.html" TARGET="UP"><FONT SIZE=2>
+Vernacular Commands Index
+</FONT></A></CENTER></TD>
+<TD><CENTER><A HREF="error-index.html" TARGET="UP"><FONT SIZE=2>
+Index of Error Messages
+</FONT></A></CENTER></TD>
+</TABLE>
+
+</CENTER>
+
+</BODY></HTML>
\ No newline at end of file
diff --git a/doc/rt/RefMan-cover.tex b/doc/rt/RefMan-cover.tex
new file mode 100644
index 00000000..d881329a
--- /dev/null
+++ b/doc/rt/RefMan-cover.tex
@@ -0,0 +1,46 @@
+\documentstyle[RRcover]{book}
+        % L'utilisation du style `french' force le résumé français à
+        % apparaître en premier.
+
+\RRtitle{Manuel de r\'ef\'erence du syst\`eme Coq \\ version V7.1}
+\RRetitle{The Coq Proof Assistant \\ Reference Manual \\ Version 7.1
+\thanks
+{This research was partly supported by ESPRIT Basic Research
+Action ``Types'' and by the GDR ``Programmation'' co-financed by MRE-PRC and CNRS.}
+}
+\RRauthor{Bruno Barras, Samuel Boutin, Cristina Cornes,
+Judica\"el Courant, Jean-Christophe Filli\^atre, Eduardo Gim\'enez,
+Hugo Herbelin, G\'erard Huet, C\'esar Mu\~noz, Chetan Murthy,
+Catherine Parent, Christine Paulin-Mohring,
+Amokrane Sa{\"\i}bi, Benjamin Werner}
+\authorhead{}
+\titlehead{Coq V7.1 Reference Manual}
+\RRtheme{2}
+\RRprojet{Coq}
+\RRNo{0123456789}
+\RRdate{May 1997}
+%\RRpages{}
+\URRocq
+
+\RRresume{Coq est un syst\`eme permettant le d\'eveloppement et la
+v\'erification de preuves formelles dans une logique d'ordre
+sup\'erieure incluant un riche langage de d\'efinitions de fonctions.
+Ce document constitue le manuel de r\'ef\'erence de la version V7.1
+qui est distribu\'ee par ftp anonyme à l'adresse
+\url{ftp://ftp.inria.fr/INRIA/coq/}}
+
+\RRmotcle{Coq, Syst\`eme d'aide \`a la preuve, Preuves formelles,
+Calcul des Constructions Inductives}
+
+
+\RRabstract{Coq is a proof assistant based on a higher-order logic
+allowing powerful definitions of functions. 
+Coq V7.1 is available by anonymous
+ftp at \url{ftp://ftp.inria.fr/INRIA/coq/}}
+
+\RRkeyword{Coq, Proof Assistant, Formal Proofs, Calculus of Inductives
+Constructions}
+
+\begin{document}
+\makeRT
+\end{document}
diff --git a/doc/rt/Tutorial-cover.tex b/doc/rt/Tutorial-cover.tex
new file mode 100644
index 00000000..b747b812
--- /dev/null
+++ b/doc/rt/Tutorial-cover.tex
@@ -0,0 +1,48 @@
+\documentstyle[RRcover]{book}
+        % L'utilisation du style `french' force le résumé français à
+        % apparaître en premier.
+\RRetitle{
+The Coq Proof Assistant \\ A Tutorial \\ Version 7.1
+\thanks{This research was partly supported by ESPRIT Basic Research
+Action ``Types'' and by the GDR ``Programmation'' co-financed by MRE-PRC and CNRS.}
+}
+\RRtitle{Coq \\ Une introduction \\ V7.1 }
+\RRauthor{G\'erard Huet, Gilles Kahn and Christine Paulin-Mohring}
+\RRtheme{2}
+\RRprojet{{Coq
+\\[15pt]
+{INRIA Rocquencourt}
+{\hskip -5.25pt}
+~~{\bf ---}~~
+ \def\thefootnote{\arabic{footnote}\hss}
+{CNRS - ENS Lyon}
+\footnote[1]{LIP URA 1398 du CNRS,
+46 All\'ee d'Italie, 69364 Lyon CEDEX 07, France.}
+{\hskip -14pt}}}
+
+%\RRNo{0123456789}
+\RRNo{0204}
+\RRdate{Ao\^ut 1997}
+
+\URRocq
+\RRresume{Coq est un syst\`eme permettant le d\'eveloppement et la
+v\'erification de preuves formelles dans une logique d'ordre
+sup\'erieure incluant un riche langage de d\'efinitions de fonctions.
+Ce document constitue une introduction pratique \`a l'utilisation de
+la version V7.1 qui est distribu\'ee par ftp anonyme à l'adresse
+\url{ftp://ftp.inria.fr/INRIA/coq/}}
+
+\RRmotcle{Coq, Syst\`eme d'aide \`a la preuve, Preuves formelles, Calcul
+des Constructions Inductives}
+
+\RRabstract{Coq is a proof assistant based on a higher-order logic
+allowing powerful definitions of functions. This document is a
+tutorial for the version V7.1 of Coq. This version is available by
+anonymous ftp at \url{ftp://ftp.inria.fr/INRIA/coq/}}
+
+\RRkeyword{Coq, Proof Assistant, Formal Proofs, Calculus of Inductives
+Constructions}
+
+\begin{document}
+\makeRT
+\end{document}
diff --git a/doc/stdlib/Library.tex b/doc/stdlib/Library.tex
new file mode 100755
index 00000000..97748af6
--- /dev/null
+++ b/doc/stdlib/Library.tex
@@ -0,0 +1,62 @@
+\documentclass[11pt]{article}
+
+\usepackage[latin1]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage{fullpage}
+\usepackage{coqdoc}
+
+\input{../common/version}
+\input{../common/title}
+\input{../common/macros}
+
+\begin{document}
+ 
+\coverpage{The standard library}%
+{\ }
+{This material is distributed under the terms of the GNU Lesser
+General Public License Version 2.1.}
+
+\tableofcontents
+
+\newpage
+\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
+(the {\bf Init} library ; see the Reference Manual for a description
+of this library). It provides a set of modules directly available
+through the \verb!Require! command.
+
+The standard library is composed of the following subdirectories:
+\begin{description}
+  \item[Logic]  Classical logic and dependent equality
+  \item[Bool]   Booleans (basic functions and results)
+  \item[Arith]  Basic Peano arithmetic
+  \item[ZArith] Basic integer arithmetic
+  \item[Reals]  Classical Real Numbers and Analysis
+  \item[Lists]  Monomorphic and polymorphic lists (basic functions and
+                  results), Streams (infinite sequences defined 
+                  with co-inductive types)
+  \item[Sets]   Sets (classical, constructive, finite, infinite, power set,
+                  etc.)
+  \item[Relations] Relations (definitions and basic results).
+  \item[Sorting] Sorted list (basic definitions and heapsort
+                 correctness). 
+  \item[Wellfounded] Well-founded relations (basic results).
+  \item[IntMap]       Representation of finite sets by an efficient
+                     structure of map (trees indexed by binary integers).
+\end{description}
+
+
+Each of these subdirectories contains a set of modules, whose
+specifications (\gallina{} files) have
+been roughly, and automatically, pasted in the following pages. There
+is also a version of this document in HTML format on the WWW, which
+you can access from the \Coq\ home page at
+\texttt{http://coq.inria.fr/library}.
+
+\input{Library.coqdoc}
+
+\end{document}
+
+% $Id: Library.tex 8626 2006-03-14 15:01:00Z notin $ 
diff --git a/doc/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template
new file mode 100644
index 00000000..cbb8580d
--- /dev/null
+++ b/doc/stdlib/index-list.html.template
@@ -0,0 +1,339 @@
+<html>
+
+<head>
+<link rel="stylesheet" href="coqdoc.css" type="text/css">
+<title>The Coq Standard Library
+</head>
+
+<body>
+
+<H1>The Coq Standard Library</H1>
+
+<p>Here is a short description of the Coq standard library, which is
+distributed with the system.
+It provides a set of modules directly available 
+through the <tt>Require Import</tt> command.</p>
+
+<p>The standard library is composed of the following subdirectories:</p>
+
+<dl>
+  <dt> <b>Init</b>:
+    The core library (automatically loaded when starting Coq)
+  </dt>
+  <dd> 
+    theories/Init/Notations.v
+    theories/Init/Datatypes.v
+    theories/Init/Logic.v
+    theories/Init/Logic_Type.v
+    theories/Init/Peano.v
+    theories/Init/Specif.v
+    theories/Init/Tactics.v
+    theories/Init/Wf.v
+    (theories/Init/Prelude.v)
+  </dd>
+  
+  <dt> <b>Logic</b>:
+      Classical logic and dependent equality
+  </dt>
+  <dd>
+    theories/Logic/Classical_Pred_Set.v
+    theories/Logic/Classical_Pred_Type.v
+    theories/Logic/Classical_Prop.v
+    theories/Logic/Classical_Type.v
+    (theories/Logic/Classical.v)
+    theories/Logic/Decidable.v
+    theories/Logic/Eqdep_dec.v
+    theories/Logic/EqdepFacts.v
+    theories/Logic/Eqdep.v
+    theories/Logic/JMeq.v
+    theories/Logic/RelationalChoice.v
+    theories/Logic/ClassicalChoice.v
+    theories/Logic/ChoiceFacts.v
+    theories/Logic/ClassicalDescription.v
+    theories/Logic/ClassicalFacts.v
+    theories/Logic/Berardi.v
+    theories/Logic/Diaconescu.v
+    theories/Logic/Hurkens.v
+    theories/Logic/ProofIrrelevance.v
+    theories/Logic/ProofIrrelevanceFacts.v
+  </dd>
+    
+  <dt> <b>Arith</b>:
+    Basic Peano arithmetic
+  </dt>
+  <dd> 
+    theories/Arith/Le.v
+    theories/Arith/Lt.v
+    theories/Arith/Plus.v
+    theories/Arith/Minus.v
+    theories/Arith/Mult.v
+    theories/Arith/Gt.v
+    theories/Arith/Between.v
+    theories/Arith/Peano_dec.v
+    theories/Arith/Compare_dec.v
+    (theories/Arith/Arith.v)
+    theories/Arith/Min.v
+    theories/Arith/Max.v
+    theories/Arith/Compare.v
+    theories/Arith/Div2.v
+    theories/Arith/Div.v
+    theories/Arith/EqNat.v
+    theories/Arith/Euclid.v
+    theories/Arith/Even.v
+    theories/Arith/Bool_nat.v
+    theories/Arith/Factorial.v
+    theories/Arith/Wf_nat.v
+  </dd>
+    
+  <dt> <b>NArith</b>:
+    Binary positive integers
+  </dt>
+  <dd> 
+    theories/NArith/BinPos.v
+    theories/NArith/BinNat.v
+    (theories/NArith/NArith.v)
+    theories/NArith/Pnat.v
+  </dd>
+
+  <dt> <b>ZArith</b>:
+       Binary integers
+  </dt>
+  <dd> 
+    theories/ZArith/BinInt.v
+    theories/ZArith/Zorder.v
+    theories/ZArith/Zcompare.v
+    theories/ZArith/Znat.v
+    theories/ZArith/Zmin.v
+    theories/ZArith/Zmax.v
+    theories/ZArith/Zminmax.v
+    theories/ZArith/Zabs.v
+    theories/ZArith/Zeven.v
+    theories/ZArith/auxiliary.v
+    theories/ZArith/ZArith_dec.v
+    theories/ZArith/Zbool.v
+    theories/ZArith/Zmisc.v
+    theories/ZArith/Wf_Z.v
+    theories/ZArith/Zhints.v
+    (theories/ZArith/ZArith_base.v)
+    theories/ZArith/Zcomplements.v
+    theories/ZArith/Zsqrt.v
+    theories/ZArith/Zpower.v
+    theories/ZArith/Zdiv.v
+    theories/ZArith/Zlogarithm.v
+    (theories/ZArith/ZArith.v)
+    theories/ZArith/Zwf.v
+    theories/ZArith/Zbinary.v
+    theories/ZArith/Znumtheory.v
+  </dd>
+    
+  <dt> <b>Reals</b>:
+    Formalization of real numbers
+  </dt>
+  <dd> 
+    theories/Reals/Rdefinitions.v
+    theories/Reals/Raxioms.v
+    theories/Reals/RIneq.v
+    theories/Reals/DiscrR.v
+    (theories/Reals/Rbase.v)
+    theories/Reals/RList.v
+    theories/Reals/Ranalysis.v
+    theories/Reals/Rbasic_fun.v
+    theories/Reals/Rderiv.v
+    theories/Reals/Rfunctions.v
+    theories/Reals/Rgeom.v
+    theories/Reals/R_Ifp.v
+    theories/Reals/Rlimit.v
+    theories/Reals/Rseries.v
+    theories/Reals/Rsigma.v
+    theories/Reals/R_sqr.v
+    theories/Reals/Rtrigo_fun.v
+    theories/Reals/Rtrigo.v
+    theories/Reals/SplitAbsolu.v
+    theories/Reals/SplitRmult.v
+    theories/Reals/Alembert.v
+    theories/Reals/AltSeries.v
+    theories/Reals/ArithProp.v
+    theories/Reals/Binomial.v
+    theories/Reals/Cauchy_prod.v
+    theories/Reals/Cos_plus.v
+    theories/Reals/Cos_rel.v
+    theories/Reals/Exp_prop.v
+    theories/Reals/Integration.v
+    theories/Reals/MVT.v
+    theories/Reals/NewtonInt.v
+    theories/Reals/PSeries_reg.v
+    theories/Reals/PartSum.v
+    theories/Reals/R_sqrt.v
+    theories/Reals/Ranalysis1.v
+    theories/Reals/Ranalysis2.v
+    theories/Reals/Ranalysis3.v
+    theories/Reals/Ranalysis4.v
+    theories/Reals/Rcomplete.v
+    theories/Reals/RiemannInt.v
+    theories/Reals/RiemannInt_SF.v
+    theories/Reals/Rpower.v
+    theories/Reals/Rprod.v
+    theories/Reals/Rsqrt_def.v
+    theories/Reals/Rtopology.v
+    theories/Reals/Rtrigo_alt.v
+    theories/Reals/Rtrigo_calc.v
+    theories/Reals/Rtrigo_def.v
+    theories/Reals/Rtrigo_reg.v
+    theories/Reals/SeqProp.v
+    theories/Reals/SeqSeries.v
+    theories/Reals/Sqrt_reg.v
+    (theories/Reals/Reals.v)
+  </dd>
+    
+  <dt> <b>Bool</b>:
+       Booleans (basic functions and results)
+  </dt>
+  <dd> 
+    theories/Bool/Bool.v
+    theories/Bool/BoolEq.v
+    theories/Bool/DecBool.v
+    theories/Bool/IfProp.v
+    theories/Bool/Sumbool.v
+    theories/Bool/Zerob.v
+    theories/Bool/Bvector.v
+  </dd>
+    
+  <dt> <b>Lists</b>:
+    Polymorphic lists, Streams (infinite sequences)
+  </dt>
+  <dd> 
+    theories/Lists/List.v
+    theories/Lists/ListSet.v
+    theories/Lists/MonoList.v
+    theories/Lists/MoreList.v
+    theories/Lists/SetoidList.v
+    theories/Lists/Streams.v
+    theories/Lists/TheoryList.v
+  </dd>
+  
+  <dt> <b>Sets</b>:
+       Sets (classical, constructive, finite, infinite, powerset, etc.)
+  </dt>
+  <dd> 
+    theories/Sets/Classical_sets.v
+    theories/Sets/Constructive_sets.v
+    theories/Sets/Cpo.v
+    theories/Sets/Ensembles.v
+    theories/Sets/Finite_sets_facts.v
+    theories/Sets/Finite_sets.v
+    theories/Sets/Image.v
+    theories/Sets/Infinite_sets.v
+    theories/Sets/Integers.v
+    theories/Sets/Multiset.v
+    theories/Sets/Partial_Order.v
+    theories/Sets/Permut.v
+    theories/Sets/Powerset_Classical_facts.v
+    theories/Sets/Powerset_facts.v
+    theories/Sets/Powerset.v
+    theories/Sets/Relations_1_facts.v
+    theories/Sets/Relations_1.v
+    theories/Sets/Relations_2_facts.v
+    theories/Sets/Relations_2.v
+    theories/Sets/Relations_3_facts.v
+    theories/Sets/Relations_3.v
+    theories/Sets/Uniset.v
+  </dd>
+    
+  <dt> <b>Relations</b>:
+       Relations (definitions and basic results)
+  </dt>
+  <dd> 
+    theories/Relations/Relation_Definitions.v
+    theories/Relations/Relation_Operators.v
+    theories/Relations/Relations.v
+    theories/Relations/Operators_Properties.v
+    theories/Relations/Rstar.v
+    theories/Relations/Newman.v
+  </dd>
+    
+  <dt> <b>Wellfounded</b>:
+       Well-founded Relations
+  </dt>
+  <dd> 
+    theories/Wellfounded/Disjoint_Union.v
+    theories/Wellfounded/Inclusion.v
+    theories/Wellfounded/Inverse_Image.v
+    theories/Wellfounded/Lexicographic_Exponentiation.v
+    theories/Wellfounded/Lexicographic_Product.v
+    theories/Wellfounded/Transitive_Closure.v
+    theories/Wellfounded/Union.v
+    theories/Wellfounded/Wellfounded.v
+    theories/Wellfounded/Well_Ordering.v
+  </dd>
+    
+  <dt> <b>Sorting</b>:
+    Axiomatizations of sorts
+  </dt>
+  <dd> 
+    theories/Sorting/Heap.v
+    theories/Sorting/Permutation.v
+    theories/Sorting/Sorting.v
+  </dd>
+  
+  <dt> <b>Setoids</b>:
+  <dd> 
+    theories/Setoids/Setoid.v
+  </dd>
+    
+  <dt> <b>IntMap</b>:
+    Finite sets/maps as trees indexed by addresses
+  </dt>
+  <dd> 
+    theories/IntMap/Addr.v
+    theories/IntMap/Adist.v
+    theories/IntMap/Addec.v
+    theories/IntMap/Adalloc.v
+    theories/IntMap/Map.v
+    theories/IntMap/Fset.v
+    theories/IntMap/Mapaxioms.v
+    theories/IntMap/Mapiter.v
+    theories/IntMap/Mapcanon.v
+    theories/IntMap/Mapsubset.v
+    theories/IntMap/Lsort.v
+    theories/IntMap/Mapfold.v
+    theories/IntMap/Mapcard.v
+    theories/IntMap/Mapc.v
+    theories/IntMap/Maplists.v
+    theories/IntMap/Allmaps.v
+  </dd>
+    
+  <dt> <b>FSets</b>:
+    Modular implementation of finite sets/maps using lists
+  </dt>
+  <dd>
+    theories/FSets/DecidableType.v
+    theories/FSets/OrderedType.v
+    theories/FSets/FSetInterface.v
+    theories/FSets/FSetBridge.v
+    theories/FSets/FSetProperties.v
+    theories/FSets/FSetEqProperties.v
+    theories/FSets/FSetFacts.v
+    theories/FSets/FSetList.v
+    theories/FSets/FSet.v
+    theories/FSets/FMapInterface.v
+    theories/FSets/FMapList.v
+    theories/FSets/FMap.v
+    theories/FSets/FSetWeakInterface.v
+    theories/FSets/FSetWeakFacts.v
+    theories/FSets/FSetWeakList.v
+    theories/FSets/FSetWeak.v
+    theories/FSets/FMapWeakInterface.v
+    theories/FSets/FMapWeakList.v
+    theories/FSets/FMapWeak.v
+  </dd>
+
+  <dt> <b>Strings</b>
+    Implementation of string as list of ascii characters
+  </dt>
+  <dd>
+    theories/Strings/Ascii.v
+    theories/Strings/String.v
+  </dd>
+    
+  </dd>
+</dl>
diff --git a/doc/stdlib/index-trailer.html b/doc/stdlib/index-trailer.html
new file mode 100644
index 00000000..308b1d01
--- /dev/null
+++ b/doc/stdlib/index-trailer.html
@@ -0,0 +1,2 @@
+</body>
+</html>
diff --git a/doc/stdlib/make-library-files b/doc/stdlib/make-library-files
new file mode 100755
index 00000000..91e3cc3f
--- /dev/null
+++ b/doc/stdlib/make-library-files
@@ -0,0 +1,36 @@
+#!/bin/sh
+
+# Needs COQTOP and GALLINA set
+
+# On garde la liste de tous les *.v avec dates dans library.files.ls
+# Si elle a change depuis la derniere fois ou library.files n'existe pas
+# on fabrique des .g (si besoin) et la liste library.files dans 
+# l'ordre de ls -tr des *.vo
+# Ce dernier trie les fichiers dans l'ordre inverse de leur date de création
+# En supposant que make fait son boulot, ca fait un tri topologique du
+# graphe des dépendances
+
+LIBDIRS="Arith NArith ZArith Reals Logic Bool Lists IntMap Relations Sets Sorting Wellfounded Setoids"
+
+rm -f library.files.ls.tmp
+(cd $COQTOP/theories; find $LIBDIR -name "*.v" -ls) > library.files.ls.tmp
+if ! test -e library.files || ! cmp library.files.ls library.files.ls.tmp; then
+  mv -f library.files.ls.tmp library.files.ls
+  rm -f library.files; touch library.files
+  ABSOLUTE=`pwd`/library.files
+  cd $COQTOP/theories
+  echo $LIBDIRS
+  for rep in $LIBDIRS ; do
+    (cd $rep
+     echo $rep/intro.tex >> $ABSOLUTE
+     VOFILES=`ls -tr *.vo`
+     for file in $VOFILES ; do
+       VF=`basename $file \.vo`
+       if [ \( ! -e $VF.g \) -o \( $VF.v -nt $VF.g \) ] ; then
+          $GALLINA $VF.v
+       fi
+       echo $rep/$VF.g >> $ABSOLUTE
+     done
+    )
+  done
+fi
diff --git a/doc/stdlib/make-library-index b/doc/stdlib/make-library-index
new file mode 100755
index 00000000..ddbcd09f
--- /dev/null
+++ b/doc/stdlib/make-library-index
@@ -0,0 +1,35 @@
+#!/bin/sh
+
+# Instantiate links to library files in index template
+
+FILE=$1
+
+cp -f $FILE.template tmp
+echo -n Building file index-list.prehtml ...
+
+for i in ../theories/*; do
+    echo $i
+
+  d=`basename $i`
+  if [ "$d" != "Num" -a "$d" != "CVS" ]; then
+  for j in $i/*.v; do
+    b=`basename $j .v`
+    rm -f tmp2
+    grep -q theories/$d/$b.v tmp
+    a=$?
+    if [ $a = 0 ]; then
+      sed -e "s:theories/$d/$b.v:<a href=\"Coq.$d.$b.html\">$b</a>:g" tmp > tmp2
+      mv -f tmp2 tmp
+    else
+      echo Warning: theories/$d/$b.v is missing in the template file
+    fi
+  done
+  fi
+  rm -f tmp2
+  sed -e "s/#$d#//" tmp > tmp2
+  mv -f tmp2 tmp
+done
+a=`grep theories tmp`
+if [ $? = 0 ]; then echo Warning: extra files:; echo $a; fi
+mv tmp $FILE
+echo Done
diff --git a/doc/tools/Translator.tex b/doc/tools/Translator.tex
new file mode 100644
index 00000000..005ca9c0
--- /dev/null
+++ b/doc/tools/Translator.tex
@@ -0,0 +1,898 @@
+\ifx\pdfoutput\undefined   % si on est pas en pdflatex
+\documentclass[11pt,a4paper]{article}
+\else
+\documentclass[11pt,a4paper,pdftex]{article}
+\fi
+\usepackage[latin1]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage{pslatex}
+\usepackage{url}
+\usepackage{verbatim}
+\usepackage{amsmath}
+\usepackage{amssymb}
+\usepackage{array}
+\usepackage{fullpage}
+
+\title{Translation from Coq V7 to V8}
+\author{The Coq Development Team}
+
+%% Macros etc.
+\catcode`\_=13
+\let\subscr=_
+\def_{\ifmmode\sb\else\subscr\fi}
+
+\def\NT#1{\langle\textit{#1}\rangle}
+\def\NTL#1#2{\langle\textit{#1}\rangle_{#2}}
+%\def\TERM#1{\textsf{\bf #1}}
+\def\TERM#1{\texttt{#1}}
+\newenvironment{transbox}
+  {\begin{center}\tt\begin{tabular}{l|ll} \hfil\textrm{V7} & \hfil\textrm{V8} \\ \hline}
+  {\end{tabular}\end{center}}
+\def\TRANS#1#2
+  {\begin{tabular}[t]{@{}l@{}}#1\end{tabular} & 
+   \begin{tabular}[t]{@{}l@{}}#2\end{tabular} \\}
+\def\TRANSCOM#1#2#3
+  {\begin{tabular}[t]{@{}l@{}}#1\end{tabular} & 
+   \begin{tabular}[t]{@{}l@{}}#2\end{tabular} & #3 \\}
+
+%%
+%%
+%%
+\begin{document}
+\maketitle
+
+\section{Introduction}
+
+Coq version 8.0 is a major version and carries major changes: the
+concrete syntax was redesigned almost from scratch, and many notions
+of the libraries were renamed for uniformisation purposes. We felt
+that these changes could discourage users with large theories from
+switching to the new version.
+
+The goal of this document is to introduce these changes on simple
+examples (mainly the syntactic changes), and describe the automated
+tools to help moving to V8.0. Essentially, it consists of a translator
+that takes as input a Coq source file in old syntax and produces a
+file in new syntax and adapted to the new standard library. The main
+extra features of this translator is that it keeps comments, even
+those within expressions\footnote{The position of those comment might
+differ slightly since there is no exact matching of positions between
+old and new syntax.}.
+
+The document is organised as follows: first section describes the new
+syntax on simple examples. It is very translation-oriented. This
+should give users of older versions the flavour of the new syntax, and
+allow them to make translation manually on small
+examples. Section~\ref{Translation} explains how the translation
+process can be automatised for the most part (the boring one: applying
+similar changes over thousands of lines of code). We strongly advise
+users to follow these indications, in order to avoid many potential
+complications of the translation process.
+
+
+\section{The new syntax on examples}
+
+The goal of this section is to introduce to the new syntax of Coq on
+simple examples, rather than just giving the new grammar. It is
+strongly recommended to read first the definition of the new syntax
+(in the reference manual), but this document should also be useful for
+the eager user who wants to start with the new syntax quickly.
+
+The toplevel has an option {\tt -translate} which allows to
+interactively translate commands. This toplevel translator accepts a
+command, prints the translation on standard output (after a %
+\verb+New syntax:+ balise), executes the command, and waits for another
+command. The only requirements is that they should be syntactically
+correct, but they do not have to be well-typed.
+
+This interactive translator proved to be useful in two main
+usages. First as a ``debugger'' of the translation. Before the
+translation, it may help in spotting possible conflicts between the
+new syntax and user notations. Or when the translation fails for some
+reason, it makes it easy to find the exact reason why it failed and
+make attempts in fixing the problem.
+
+The second usage of the translator is when trying to make the first
+proofs in new syntax. Well trained users will automatically think
+their scripts in old syntax and might waste much time (and the
+intuition of the proof) if they have to search the translation in a
+document. Running a translator in the background will allow the user
+to instantly have the answer.
+
+The rest of this section is a description of all the aspects of the
+syntax that changed and how they were translated. All the examples
+below can be tested by entering the V7 commands in the toplevel
+translator.
+
+
+%%
+
+\subsection{Changes in lexical conventions w.r.t. V7}
+
+\subsubsection{Identifiers}
+
+The lexical conventions changed: \TERM{_} is not a regular identifier
+anymore. It is used in terms as a placeholder for subterms to be inferred
+at type-checking, and in patterns as a non-binding variable.
+
+Furthermore, only letters (Unicode letters), digits, single quotes and
+_ are allowed after the first character.
+
+\subsubsection{Quoted string}
+
+Quoted strings are used typically to give a filename (which may not
+be a regular identifier). As before they are written between double
+quotes ("). Unlike for V7, there is no escape character: characters
+are written normally except the double quote which is doubled.
+
+\begin{transbox}
+\TRANS{"abcd$\backslash\backslash$efg"}{"abcd$\backslash$efg"}
+\TRANS{"abcd$\backslash$"efg"}{"abcd""efg"}
+\end{transbox}
+
+
+\subsection{Main changes in terms w.r.t. V7}
+
+
+\subsubsection{Precedence of application}
+
+In the new syntax, parentheses are not really part of the syntax of
+application. The precedence of application (10) is tighter than all
+prefix and infix notations. It makes it possible to remove parentheses
+in many contexts.
+
+\begin{transbox}
+\TRANS{(A x)->(f x)=(g y)}{A x -> f x = g y}
+\TRANS{(f [x]x)}{f (fun x => x)}
+\end{transbox}
+
+
+\subsubsection{Arithmetics and scopes}
+
+The specialized notation for \TERM{Z} and \TERM{R} (introduced by
+symbols \TERM{`} and \TERM{``}) have disappeared. They have been
+replaced by the general notion of scope.
+
+\begin{center}
+\begin{tabular}{l|l|l}
+type & scope name & delimiter \\
+\hline
+types & type_scope & \TERM{type} \\
+\TERM{bool} & bool_scope & \\
+\TERM{nat} & nat_scope & \TERM{nat} \\
+\TERM{Z} & Z_scope & \TERM{Z} \\
+\TERM{R} & R_scope & \TERM{R} \\
+\TERM{positive} & positive_scope & \TERM{P}
+\end{tabular}
+\end{center}
+
+In order to use notations of arithmetics on \TERM{Z}, its scope must
+be opened with command \verb+Open Scope Z_scope.+ Another possibility
+is using the scope change notation (\TERM{\%}). The latter notation is
+to be used when notations of several scopes appear in the same
+expression.
+
+In examples below, scope changes are not needed if the appropriate scope
+has been opened. Scope \verb|nat_scope| is opened in the initial state of Coq.
+\begin{transbox}
+\TRANSCOM{`0+x=x+0`}{0+x=x+0}{\textrm{Z_scope}}
+\TRANSCOM{``0 + [if b then ``1`` else ``2``]``}{0 + if b then 1 else 2}{\textrm{R_scope}}
+\TRANSCOM{(0)}{0}{\textrm{nat_scope}}
+\end{transbox}
+
+Below is a table that tells which notation is available in which
+scope. The relative precedences and associativity of operators is the
+same as in usual mathematics. See the reference manual for more
+details. However, it is important to remember that unlike V7, the type
+operators for product and sum are left-associative, in order not to
+clash with arithmetic operators.
+
+\begin{center}
+\begin{tabular}{l|l}
+scope & notations \\
+\hline
+nat_scope & \texttt{+ - * < <= > >=} \\
+Z_scope & \texttt{+ - * / mod < <= > >= ?=} \\
+R_scope & \texttt{+ - * / < <= > >=} \\
+type_scope & \texttt{* +} \\
+bool_scope & \texttt{\&\& || -} \\
+list_scope & \texttt{:: ++}
+\end{tabular}
+\end{center}
+
+
+
+\subsubsection{Notation for implicit arguments}
+
+The explicitation of arguments is closer to the \emph{bindings}
+notation in tactics. Argument positions follow the argument names of
+the head constant. The example below assumes \verb+f+ is a function
+with two implicit dependent arguments named \verb+x+ and \verb+y+.
+\begin{transbox}
+\TRANS{f 1!t1 2!t2 t3}{f (x:=t1) (y:=t2) t3}
+\TRANS{!f t1 t2}{@f t1 t2}
+\end{transbox}
+
+
+\subsubsection{Inferred subterms}
+
+Subterms that can be automatically inferred by the type-checker is now
+written {\tt _}
+
+\begin{transbox}
+\TRANS{?}{_}
+\end{transbox}
+
+\subsubsection{Universal quantification}
+
+The universal quantification and dependent product types are now
+introduced by the \texttt{forall} keyword before the binders and a
+comma after the binders.
+
+The syntax of binders also changed significantly. A binder can simply be
+a name when its type can be inferred. In other cases, the name and the type
+of the variable are put between parentheses. When several consecutive
+variables have the same type, they can be grouped. Finally, if all variables
+have the same type, parentheses can be omitted.
+
+\begin{transbox}
+\TRANS{(x:A)B}{forall (x:~A), B ~~\textrm{or}~~ forall x:~A, B}
+\TRANS{(x,y:nat)P}{forall (x y :~nat), P ~~\textrm{or}~~ forall x y :~nat, P}
+\TRANS{(x,y:nat;z:A)P}{forall (x y :~nat) (z:A), P}
+\TRANS{(x,y,z,t:?)P}{forall x y z t, P}
+\TRANS{(x,y:nat;z:?)P}{forall (x y :~nat) z, P}
+\end{transbox}
+
+\subsubsection{Abstraction}
+
+The notation for $\lambda$-abstraction follows that of universal
+quantification. The binders are surrounded by keyword \texttt{fun}
+and \verb+=>+.
+
+\begin{transbox}
+\TRANS{[x,y:nat; z](f a b c)}{fun (x y:nat) z => f a b c}
+\end{transbox}
+
+
+\subsubsection{Pattern-matching}
+
+Beside the usage of the keyword pair \TERM{match}/\TERM{with} instead of
+\TERM{Cases}/\TERM{of}, the main change is the notation for the type of
+branches and return type. It is no longer written between \TERM{$<$ $>$} before
+the \TERM{Cases} keyword, but interleaved with the destructured objects.
+
+The idea is that for each destructured object, one may specify a
+variable name (after the \TERM{as} keyword) to tell how the branches
+types depend on this destructured objects (case of a dependent
+elimination), and also how they depend on the value of the arguments
+of the inductive type of the destructured objects (after the \TERM{in}
+keyword). The type of branches is then given after the keyword
+\TERM{return}, unless it can be inferred.
+
+Moreover, when the destructured object is a variable, one may use this
+variable in the return type.
+
+\begin{transbox}
+\TRANS{Cases n of\\~~ O => O \\| (S k) => (1) end}{match n with\\~~ 0 => 0 \\| S k => 1 end}
+\TRANS{Cases m n of \\~~0 0 => t \\| ... end}{match m, n with \\~~0, 0 => t \\| ... end}
+\TRANS{<[n:nat](P n)>Cases T of ... end}{match T as n return P n with ... end}
+\TRANS{<[n:nat][p:(even n)]\~{}(odd n)>Cases p of\\~~ ... \\end}{match p in even n return \~{} odd n with\\~~ ...\\end}
+\end{transbox}
+
+The annotations of the special pattern-matching operators
+(\TERM{if}/\TERM{then}/\TERM{else}) and \TERM{let()} also changed. The
+only restriction is that the destructuring \TERM{let} does not allow
+dependent case analysis.
+
+\begin{transbox}
+\TRANS{
+ \begin{tabular}{@{}l}
+ <[n:nat;x:(I n)](P n x)>if t then t1 \\
+ else t2
+ \end{tabular}}%
+{\begin{tabular}{@{}l}
+ if t as x in I n return P n x then t1 \\
+ else t2
+ \end{tabular}}
+\TRANS{<[n:nat](P n)>let (p,q) = t1 in t2}%
+{let (p,q) in I n return P n := t1 in t2}
+\end{transbox}
+
+
+\subsubsection{Fixpoints and cofixpoints}
+
+An simpler syntax for non-mutual fixpoints is provided, making it very close
+to the usual notation for non-recursive functions. The decreasing argument
+is now indicated by an annotation between curly braces, regardless of the
+binders grouping. The annotation can be omitted if the binders introduce only
+one variable. The type of the result can be omitted if inferable.
+
+\begin{transbox}
+\TRANS{Fix plus\{plus [n:nat] : nat -> nat :=\\~~ [m]...\}}{fix plus (n m:nat) \{struct n\}: nat := ...}
+\TRANS{Fix fact\{fact [n:nat]: nat :=\\
+~~Cases n of\\~~~~ O => (1) \\~~| (S k) => (mult n (fact k)) end\}}{fix fact
+  (n:nat) :=\\
+~~match n with \\~~~~0 => 1 \\~~| (S k) => n * fact k end}
+\end{transbox}
+
+There is a syntactic sugar for single fixpoints (defining one
+variable) associated to a local definition:
+
+\begin{transbox}
+\TRANS{let f := Fix f \{f [x:A] : T := M\} in\\(g (f y))}{let fix f (x:A) : T := M in\\g (f x)}
+\end{transbox}
+
+The same applies to cofixpoints, annotations are not allowed in that case.
+
+\subsubsection{Notation for type cast}
+
+\begin{transbox}
+\TRANS{O :: nat}{0 : nat}
+\end{transbox}
+
+\subsection{Main changes in tactics w.r.t. V7}
+
+The main change is that all tactic names are lowercase. This also holds for
+Ltac keywords.
+
+\subsubsection{Renaming of induction tactics}
+
+\begin{transbox}
+\TRANS{NewDestruct}{destruct}
+\TRANS{NewInduction}{induction}
+\TRANS{Induction}{simple induction}
+\TRANS{Destruct}{simple destruct}
+\end{transbox}
+
+\subsubsection{Ltac}
+
+Definitions of macros are introduced by \TERM{Ltac} instead of
+\TERM{Tactic Definition}, \TERM{Meta Definition} or \TERM{Recursive
+Definition}. They are considered recursive by default.
+
+\begin{transbox}
+\TRANS{Meta Definition my_tac t1 t2 := t1; t2.}%
+{Ltac my_tac t1 t2 := t1; t2.}
+\end{transbox}
+
+Rules of a match command are not between square brackets anymore.
+
+Context (understand a term with a placeholder) instantiation \TERM{inst}
+became \TERM{context}. Syntax is unified with subterm matching.
+
+\begin{transbox}
+\TRANS{Match t With [C[x=y]] -> Inst C[y=x]}%
+{match t with context C[x=y] => context C[y=x] end}
+\end{transbox}
+
+Arguments of macros use the term syntax. If a general Ltac expression
+is to be passed, it must be prefixed with ``{\tt ltac :}''. In other
+cases, when a \'{} was necessary, it is replaced by ``{\tt constr :}''
+
+\begin{transbox}
+\TRANS{my_tac '(S x)}{my_tac (S x)}
+\TRANS{my_tac (Let x=tac In x)}{my_tac ltac:(let x:=tac in x)}
+\TRANS{Let x = '[x](S (S x)) In Apply x}%
+{let x := constr:(fun x => S (S x)) in apply x}
+\end{transbox}
+
+{\tt Match Context With} is now called {\tt match goal with}. Its
+argument is an Ltac expression by default.
+
+
+\subsubsection{Named arguments of theorems ({\em bindings})}
+
+\begin{transbox}
+\TRANS{Apply thm with x:=t 1:=u}{apply thm with (x:=t) (1:=u)}
+\end{transbox}
+
+
+\subsubsection{Occurrences}
+
+To avoid ambiguity between a numeric literal and the optional
+occurrence numbers of this term, the occurrence numbers are put after
+the term itself and after keyword \TERM{as}.
+\begin{transbox}
+\TRANS{Pattern 1 2 (f x) 3 4 d y z}{pattern f x at 1 2, d at 3 4, y, z}
+\end{transbox}
+
+
+\subsubsection{{\tt LetTac} and {\tt Pose}}
+
+Tactic {\tt LetTac} was renamed into {\tt set}, and tactic {\tt Pose}
+was a particular case of {\tt LetTac} where the abbreviation is folded
+in the conclusion\footnote{There is a tactic called {\tt pose} in V8,
+but its behaviour is not to fold the abbreviation at all.}.
+
+\begin{transbox}
+\TRANS{LetTac x = t in H}{set (x := t) in H}
+\TRANS{Pose x := t}{set (x := t)}
+\end{transbox}
+
+{\tt LetTac} could be followed by a specification (called a clause) of
+the places where the abbreviation had to be folded (hypothese and/or
+conclusion). Clauses are the syntactic notion to denote in which parts
+of a goal a given transformation shold occur. Its basic notation is
+either \TERM{*} (meaning everywhere), or {\tt\textrm{\em hyps} |-
+\textrm{\em concl}} where {\em hyps} is either \TERM{*} (to denote all
+the hypotheses), or a comma-separated list of either hypothesis name,
+or {\tt (value of $H$)} or {\tt (type of $H$)}. Moreover, occurrences
+can be specified after every hypothesis after the {\TERM{at}}
+keyword. {\em concl} is either empty or \TERM{*}, and can be followed
+by occurences.
+
+\begin{transbox}
+\TRANS{in Goal}{in |- *}
+\TRANS{in H H1}{in H1, H2 |-}
+\TRANS{in H H1 ...}{in * |-}
+\TRANS{in H H1 Goal}{in H1, H2 |- *}
+\TRANS{in H H1 H2 ... Goal}{in *}
+\TRANS{in 1 2 H 3 4 H0 1 3 Goal}{in H at 1 2, H0 at 3 4 |- * at 1 3}
+\end{transbox}
+
+\subsection{Main changes in vernacular commands w.r.t. V7}
+
+
+\subsubsection{Require}
+
+The default behaviour of {\tt Require} is not to open the loaded
+module.
+
+\begin{transbox}
+\TRANS{Require Arith}{Require Import Arith}
+\end{transbox}
+
+\subsubsection{Binders}
+
+The binders of vernacular commands changed in the same way as those of
+fixpoints. This also holds for parameters of inductive definitions.
+
+
+\begin{transbox}
+\TRANS{Definition x [a:A] : T := M}{Definition x (a:A) : T := M}
+\TRANS{Inductive and [A,B:Prop]: Prop := \\~~conj : A->B->(and A B)}%
+      {Inductive and (A B:Prop): Prop := \\~~conj : A -> B -> and A B}
+\end{transbox}
+
+\subsubsection{Hints}
+
+Both {\tt Hints} and {\tt Hint} commands are beginning with {\tt Hint}.
+
+Command {\tt HintDestruct} has disappeared.
+
+
+The syntax of \emph{Extern} hints changed: the pattern and the tactic
+to be applied are separated by a {\tt =>}.
+\begin{transbox}
+\TRANS{Hint name := Resolve (f ? x)}%
+{Hint Resolve (f _ x)}
+\TRANS{Hint name := Extern 4 (toto ?) Apply lemma}%
+{Hint Extern 4 (toto _) => apply lemma}
+\TRANS{Hints Resolve x y z}{Hint Resolve x y z}
+\TRANS{Hints Resolve f : db1 db2}{Hint Resolve f : db1 db2}
+\TRANS{Hints Immediate x y z}{Hint Immediate x y z}
+\TRANS{Hints Unfold x y z}{Hint Unfold x y z}
+%% \TRANS{\begin{tabular}{@{}l}
+%%   HintDestruct Local Conclusion \\
+%%   ~~name (f ? ?) 3 [Apply thm]
+%%   \end{tabular}}%
+%% {\begin{tabular}{@{}l}
+%%  Hint Local Destuct name := \\
+%%  ~~3 Conclusion (f _ _) => apply thm
+%%  \end{tabular}}
+\end{transbox}
+
+
+\subsubsection{Implicit arguments}
+
+
+{\tt Set Implicit Arguments} changed its meaning in V8: the default is
+to turn implicit only the arguments that are {\em strictly} implicit
+(or rigid), i.e. that remains inferable whatever the other arguments
+are. For instance {\tt x} inferable from {\tt P x} is not strictly
+inferable since it can disappears if {\tt P} is instanciated by a term
+which erases {\tt x}.
+
+\begin{transbox}
+\TRANS{Set Implicit Arguments}%
+{\begin{tabular}{l}
+ Set Implicit Arguments. \\
+ Unset Strict Implicits.
+ \end{tabular}}
+\end{transbox}
+
+However, you may wish to adopt the new semantics of {\tt Set Implicit
+Arguments} (for instance because you think that the choice of
+arguments it sets implicit is more ``natural'' for you).
+
+
+\subsection{Changes in standard library}
+
+Many lemmas had their named changed to improve uniformity. The user
+generally do not have to care since the translators performs the
+renaming.
+
+  Type {\tt entier} from fast_integer.v is renamed into {\tt N} by the
+translator. As a consequence, user-defined objects of same name {\tt N}
+are systematically qualified even tough it may not be necessary.  The
+following table lists the main names with which the same problem
+arises:
+\begin{transbox}
+\TRANS{IF}{IF_then_else}
+\TRANS{ZERO}{Z0}
+\TRANS{POS}{Zpos}
+\TRANS{NEG}{Zneg}
+\TRANS{SUPERIEUR}{Gt}
+\TRANS{EGAL}{Eq}
+\TRANS{INFERIEUR}{Lt}
+\TRANS{add}{Pplus}
+\TRANS{true_sub}{Pminus}
+\TRANS{entier}{N}
+\TRANS{Un_suivi_de}{Ndouble_plus_one}
+\TRANS{Zero_suivi_de}{Ndouble}
+\TRANS{Nul}{N0}
+\TRANS{Pos}{Npos}
+\end{transbox}
+
+
+\subsubsection{Implicit arguments}
+
+%% Hugo: 
+Main definitions of standard library have now implicit
+arguments. These arguments are dropped in the translated files. This
+can exceptionally be a source of incompatibilities which has to be
+solved by hand (it typically happens for polymorphic functions applied
+to {\tt nil} or {\tt None}).
+%% preciser: avant ou apres trad ?
+
+\subsubsection{Logic about {\tt Type}}
+
+Many notations that applied to {\tt Set} have been extended to {\tt
+Type}, so several definitions in {\tt Type} are superseded by them.
+
+\begin{transbox}
+\TRANS{x==y}{x=y}
+\TRANS{(EXT x:Prop | Q)}{exists x:Prop, Q}
+\TRANS{identityT}{identity}
+\end{transbox}
+
+
+
+%% Doc of the translator
+\section{A guide to translation}
+\label{Translation}
+
+%%\subsection{Overview of the translation process}
+
+Here is a short description of the tools involved in the translation process:
+\begin{description}
+\item{\tt coqc -translate}
+is the automatic translator. It is a parser/pretty-printer. This means
+that the translation is made by parsing every command using a parser
+of old syntax, which is printed using the new syntax. Many efforts
+were made to preserve as much as possible of the quality of the
+presentation: it avoids expansion of syntax extensions, comments are
+not discarded and placed at the same place.
+\item{\tt translate-v8} (in the translation package) is a small
+shell-script that will help translate developments that compile with a
+Makefile with minimum requirements.
+\end{description}
+
+\subsection{Preparation to translation}
+
+This step is very important because most of work shall be done before
+translation. If a problem occurs during translation, it often means
+that you will have to modify the original source and restart the
+translation process. This also means that it is recommended not to
+edit the output of the translator since it would be overwritten if
+the translation has to be restarted.
+
+\subsubsection{Compilation with {\tt coqc -v7}}
+
+First of all, it is mandatory that files compile with the current
+version of Coq (8.0) with option {\tt -v7}. Translation is a
+complicated task that involves the full compilation of the
+development. If your development was compiled with older versions,
+first upgrade to Coq V8.0 with option {\tt -v7}. If you use a Makefile
+similar to those produced by {\tt coq\_makefile}, you probably just
+have to do
+
+{\tt make OPT="-opt -v7"} ~~~or~~~ {\tt make OPT="-byte -v7"}
+
+When the development compiles successfully, there are several changes
+that might be necessary for the translation. Essentially, this is
+about syntax extensions (see section below dedicated to porting syntax
+extensions). If you do not use such features, then you are ready to
+try and make the translation.
+
+\subsection{Translation}
+
+\subsubsection{The general case}
+
+The preferred way is to use script {\tt translate-v8} if your development
+is compiled by a Makefile with the following constraints:
+\begin{itemize}
+\item compilation is achieved by invoking make without specifying a target
+\item options are passed to Coq with make variable COQFLAGS that
+  includes variables OPT, COQLIBS, OTHERFLAGS and COQ_XML.
+\end{itemize}
+These constraints are met by the makefiles produced by {\tt coq\_makefile}
+
+Otherwise, modify your build program so as to pass option {\tt
+-translate} to program {\tt coqc}. The effect of this option is to
+ouptut the translated source of any {\tt .v} file in a file with
+extension {\tt .v8} located in the same directory than the original
+file.
+
+\subsubsection{What may happen during the translation}
+
+This section describes events that may happen during the
+translation and measures to adopt.
+
+These are the warnings that may arise during the translation, but they
+generally do not require any modification for the user:
+Warnings:
+\begin{itemize}
+\item {\tt Unable to detect if $id$ denotes a local definition}\\
+This is due to a semantic change in clauses. In a command such as {\tt
+simpl in H}, the old semantics were to perform simplification in the
+type of {\tt H}, or in its body if it is defined. With the new
+semantics, it is performed both in the type and the body (if any). It
+might lead to incompatibilities
+
+\item {\tt Forgetting obsolete module}\\
+Some modules have disappeared in V8.0 (new syntax). The user does not
+need to worry about it, since the translator deals with it.
+
+\item {\tt Replacing obsolete module}\\
+Same as before but with the module that were renamed. Here again, the
+translator deals with it.
+\end{itemize}
+
+\subsection{Verification of the translation}
+
+The shell-script {\tt translate-v8} also renames {\tt .v8} files into
+{\tt .v} files (older {\tt .v} files are put in a subdirectory called
+{\tt v7}) and tries to recompile them. To do so it invokes {\tt make}
+without option (which should cause the compilation using {\tt coqc}
+without particular option).
+
+If compilation fails at this stage, you should refrain from repairing
+errors manually on the new syntax, but rather modify the old syntax
+script and restart the translation. We insist on that because the
+problem encountered can show up in many instances (especially if the
+problem comes from a syntactic extension), and fixing the original
+sources (for instance the {\tt V8only} parts of notations) once will
+solve all occurrences of the problem.
+
+%%\subsubsection{Errors occurring after translation}
+%%Equality in {\tt Z} or {\tt R}...
+
+\subsection{Particular cases}
+
+\subsubsection{Lexical conventions}
+
+The definition of identifiers changed. Most of those changes are
+handled by the translator. They include:
+\begin{itemize}
+\item {\tt \_} is not an identifier anymore: it is tranlated to {\tt
+x\_}
+\item avoid clash with new keywords by adding a trailing {\tt \_}
+\end{itemize}
+
+If the choices made by translation is not satisfactory 
+or in the following cases:
+\begin{itemize}
+\item use of latin letters
+\item use of iso-latin characters in notations
+\end{itemize}
+the user should change his development prior to translation.
+
+\subsubsection{{\tt Case} and {\tt Match}}
+
+These very low-level case analysis are no longer supported. The
+translator tries hard to translate them into a user-friendly one, but
+it might lack type information to do so\footnote{The translator tries
+to typecheck terms before printing them, but it is not always possible
+to determine the context in which terms appearing in tactics
+live.}. If this happens, it is preferable to transform it manually
+before translation.
+
+\subsubsection{Syntax extensions with {\tt Grammar} and {\tt Syntax}}
+
+
+{\tt Grammar} and {\tt Syntax} are no longer supported. They
+should be replaced by an equivalent {\tt Notation} command and be
+processed as described above. Before attempting translation, users
+should verify that compilation with option {\tt -v7} succeeds.
+
+In the cases where {\tt Grammar} and {\tt Syntax} cannot be emulated
+by {\tt Notation}, users have to change manually they development as
+they wish to avoid the use of {\tt Grammar}. If this is not done, the
+translator will simply expand the notations and the output of the
+translator will use the regular Coq syntax.
+
+\subsubsection{Syntax extensions with {\tt Notation} and {\tt Infix}}
+
+These commands do not necessarily need to be changed.
+
+Some work will have to be done manually if the notation conflicts with
+the new syntax (for instance, using keywords like {\tt fun} or {\tt
+exists}, overloading of symbols of the old syntax, etc.) or if the
+precedences are not right.
+
+  Precedence levels are now from 0 to 200. In V8, the precedence and
+associativity of an operator cannot be redefined. Typical level are
+(refer to the chapter on notations in the Reference Manual for the
+full list):
+
+\begin{center}
+\begin{tabular}{|cll|}
+\hline
+Notation & Precedence & Associativity \\
+\hline
+\verb!_ <-> _! & 95 & no \\
+\verb!_ \/ _!  & 85 & right \\
+\verb!_ /\ _!  & 80 & right \\
+\verb!~ _!   & 75 & right \\
+\verb!_ = _!, \verb!_ <> _!, \verb!_ < _!, \verb!_ > _!,
+  \verb!_ <= _!, \verb!_ >= _!   & 70 & no \\
+\verb!_ + _!, \verb!_ - _!   & 50 & left \\
+\verb!_ * _!, \verb!_ / _!   & 40 & left \\
+\verb!- _!  & 35 & right \\
+\verb!_ ^ _!   & 30 & left \\
+\hline
+\end{tabular}
+\end{center}
+
+
+  By default, the translator keeps the associativity given in V7 while
+the levels are mapped according to the following table:
+ 
+\begin{center}
+\begin{tabular}{l|l|l}
+V7 level & mapped to & associativity \\
+\hline
+0 & 0 & no \\
+1 & 20 & left \\
+2 & 30 & right \\
+3 & 40 & left \\
+4 & 50 & left \\
+5 & 70 & no \\
+6 & 80 & right \\
+7 & 85 & right \\
+8 & 90 & right \\
+9 & 95 & no \\
+10 & 100 & left
+\end{tabular}
+\end{center}
+
+If this is OK, just simply apply the translator.
+
+
+\paragraph{Associativity conflict}
+
+  Since the associativity of the levels obtained by translating a V7
+level (as shown on table above) cannot be changed, you have to choose
+another level with a compatible associativity.
+
+  You can choose any level between 0 and 200, knowing that the
+standard operators are already set at the levels shown on the list
+above. 
+
+Assume you have a notation
+\begin{verbatim}
+Infix NONA 2 "=_S" my_setoid_eq.
+\end{verbatim}
+By default, the translator moves it to level 30 which is right
+associative, hence a conflict with the expected no associativity.
+
+To solve the problem, just add the "V8only" modifier to reset the
+level and enforce the associativity as follows:
+\begin{verbatim}
+Infix NONA 2 "=_S" my_setoid_eq V8only (at level 70, no associativity).
+\end{verbatim}
+The translator now knows that it has to translate "=_S" at level 70
+with no associativity.
+
+Remark: 70 is the "natural" level for relations, hence the choice of 70
+here, but any other level accepting a no-associativity would have been
+OK.
+
+Second example: assume you have a notation
+\begin{verbatim}
+Infix RIGHTA 1 "o" my_comp.
+\end{verbatim}
+By default, the translator moves it to level 20 which is left
+associative, hence a conflict with the expected right associativity.
+
+To solve the problem, just add the "V8only" modifier to reset the
+level and enforce the associativity as follows:
+\begin{verbatim}
+Infix RIGHTA 1 "o" my_comp V8only (at level 20, right associativity).
+\end{verbatim}
+The translator now knows that it has to translate "o" at level 20
+which has the correct "right associativity".
+
+Remark: we assumed here that the user wants a strong precedence for
+composition, in such a way, say, that "f o g + h" is parsed as
+"(f o g) + h". To get "o" binding less than the arithmetical operators,
+an appropriated level would have been close of 70, and below, e.g. 65.
+
+
+\paragraph{Conflict: notation hides another notation}
+
+Remark: use {\tt Print Grammar constr} in V8 to diagnose the overlap
+and see the section on factorization in the chapter on notations of
+the Reference Manual for hints on how to factorize.
+
+Example:
+\begin{verbatim}
+Notation "{ x }" := (my_embedding x) (at level 1).
+\end{verbatim}
+overlaps in V8 with notation \verb#{ x : A & P }# at level 0 and with
+x at level 99. The conflicts can be solved by left-factorizing the
+notation as follows:
+\begin{verbatim}
+Notation "{ x }" := (my_embedding x) (at level 1)
+  V8only (at level 0, x at level 99).
+\end{verbatim}
+
+\paragraph{Conflict: a notation conflicts with the V8 grammar}
+
+Again, use the {\tt V8only} modifier to tell the translator to
+automatically take in charge the new syntax.
+
+Example:
+\begin{verbatim}
+Infix 3 "@" app.
+\end{verbatim}
+Since {\tt @} is used in the new syntax for deactivating the implicit
+arguments, another symbol has to be used, e.g. {\tt @@}. This is done via
+the {\tt V8only} option as follows:
+\begin{verbatim}
+Infix 3 "@" app V8only "@@" (at level 40, left associativity).
+\end{verbatim}
+or, alternatively by
+\begin{verbatim}
+Notation "x @ y" := (app x y) (at level 3, left associativity)
+  V8only "x @@ y" (at level 40, left associativity).
+\end{verbatim}
+
+\paragraph{Conflict: my notation is already defined at another level
+  (or with another associativity)}
+
+In V8, the level and associativity of a given notation can no longer
+be changed. Then, either you adopt the standard reserved levels and
+associativity for this notation (as given on the list above) or you
+change your notation.
+\begin{itemize}
+\item To change the notation, follow the directions in the previous
+paragraph
+\item To adopt the standard level, just use {\tt V8only} without any
+argument.
+\end{itemize}
+
+Example:
+\begin{verbatim}
+Infix 6 "*" my_mult.
+\end{verbatim}
+is not accepted as such in V8. Write
+\begin{verbatim}
+Infix 6 "*" my_mult V8only.
+\end{verbatim}
+to tell the translator to use {\tt *} at the reserved level (i.e. 40
+with left associativity). Even better, use interpretation scopes (look
+at the Reference Manual).
+
+
+\subsubsection{Strict implicit arguments}
+
+In the case you want to adopt the new semantics of {\tt Set Implicit
+ Arguments} (only setting rigid arguments as implicit), add the option
+{\tt -strict-implicit} to the translator.
+
+Warning: changing the number of implicit arguments can break the
+notations.  Then use the {\tt V8only} modifier of {\tt Notation}.
+
+\end{document}
diff --git a/doc/tutorial/Tutorial.tex b/doc/tutorial/Tutorial.tex
new file mode 100755
index 00000000..7c840509
--- /dev/null
+++ b/doc/tutorial/Tutorial.tex
@@ -0,0 +1,1584 @@
+\documentclass[11pt,a4paper]{book}
+\usepackage[T1]{fontenc}
+\usepackage[latin1]{inputenc}
+\usepackage{pslatex}
+
+\input{../common/version.tex}
+\input{../common/macros.tex}
+\input{../common/title.tex}
+
+%\makeindex
+
+\begin{document}
+\coverpage{A Tutorial}{Gérard Huet, Gilles Kahn and Christine Paulin-Mohring}{}
+
+%\tableofcontents
+
+\chapter*{Getting started}
+
+\Coq\ is a Proof Assistant for a Logical Framework known as the Calculus
+of Inductive Constructions. It allows the interactive construction of
+formal proofs, and also the manipulation of functional programs 
+consistently with their specifications. It runs as a computer program
+on many architectures.
+%, and mainly on Unix machines. 
+It is available with a variety of user interfaces. The present
+document does not attempt to present a comprehensive view of all the
+possibilities of \Coq, but rather to present in the most elementary
+manner a tutorial on the basic specification language, called Gallina,
+in which formal axiomatisations may be developed, and on the main
+proof tools.  For more advanced information, the reader could refer to
+the \Coq{} Reference Manual or the \textit{Coq'Art}, a new book by Y.
+Bertot and P. Castéran on practical uses of the \Coq{} system.
+
+We assume here that the potential user has installed \Coq~ on his workstation,
+that he calls \Coq~ from a standard teletype-like shell window, and that
+he does not use any special interface.
+Instructions on installation procedures, as well as more comprehensive
+documentation, may be found in the standard distribution of \Coq,
+which may be obtained from \Coq{} web site \texttt{http://coq.inria.fr}.
+
+In the following, all examples preceded by the prompting sequence
+\verb:Coq < : represent user input, terminated by a period. The
+following lines usually show \Coq's answer as it appears on the users
+screen. The sequence of such examples is a valid \Coq~ session, unless
+otherwise specified. This version of the tutorial has been prepared 
+on a PC workstation running Linux.
+The standard invocation of \Coq\ delivers a message such as:
+
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+unix:~> coqtop
+Welcome to Coq 8.0 (Mar 2004)
+
+Coq < 
+\end{verbatim}
+\end{flushleft}
+\end{small}
+
+The first line gives a banner stating the precise version of \Coq~
+used. You should always return this banner when you report an
+anomaly to our hot-line \verb:coq-bugs@pauillac.inria.fr: or on our
+bug-tracking system~:\verb:http://coq.inria.fr/bin/coq-bugs:
+
+\chapter{Basic Predicate Calculus}
+
+\section{An overview of the specification language Gallina}
+
+A formal development in Gallina consists in a sequence of {\sl declarations}
+and {\sl definitions}. You may also send \Coq~ {\sl commands} which are
+not really part of the formal development, but correspond to information
+requests, or service routine invocations. For instance, the command:
+\begin{verbatim}
+Coq < Quit.
+\end{verbatim}
+terminates the current session.
+
+\subsection{Declarations}
+
+A declaration associates a {\sl name} with 
+a {\sl specification}. 
+A name corresponds roughly to an identifier in a programming
+language, i.e. to a string of letters, digits, and a few ASCII symbols like
+underscore (\verb"_") and prime (\verb"'"), starting with a letter. 
+We use case distinction, so that the names \verb"A" and \verb"a" are distinct.
+Certain strings are reserved as key-words of \Coq, and thus are forbidden 
+as user identifiers.
+
+A specification is a formal expression which classifies the notion which is
+being declared. There are basically three kinds of specifications: 
+{\sl logical propositions}, {\sl mathematical collections}, and
+{\sl abstract types}. They are classified by the three basic sorts
+of the system, called respectively \verb:Prop:, \verb:Set:, and
+\verb:Type:, which are themselves atomic abstract types.
+
+Every valid expression $e$ in Gallina is associated with a specification,
+itself a valid expression, called its {\sl type} $\tau(E)$. We write
+$e:\tau(E)$ for the judgment that $e$ is of type $E$. 
+%CP Le role de \tau n'est pas clair.
+You may request \Coq~ to return to you the type of a valid expression by using
+the command \verb:Check::
+
+\begin{coq_example}
+Check O.
+\end{coq_example}
+
+Thus we know that the identifier \verb:O: (the name `O', not to be
+confused with the numeral `0' which is not a proper identifier!) is
+known in the current context, and that its type is the specification 
+\verb:nat:. This specification is itself classified as a mathematical
+collection, as we may readily check:
+
+\begin{coq_example}
+Check nat.
+\end{coq_example}
+
+The specification \verb:Set: is an abstract type, one of the basic
+sorts of the Gallina language, whereas the notions $nat$ and $O$ are
+notions which are defined in the arithmetic prelude,
+automatically loaded when running the \Coq\ system.
+
+We start by introducing a so-called section name. The role of sections
+is to structure the modelisation by limiting the scope of parameters,
+hypotheses and definitions. It will also give a convenient way to
+reset part of the development.
+
+\begin{coq_example}
+Section Declaration.
+\end{coq_example}
+With what we already know, we may now enter in the system a declaration,
+corresponding to the informal mathematics {\sl let n be a natural
+  number}. 
+
+\begin{coq_example}
+Variable n : nat.
+\end{coq_example}
+
+If we want to translate a more precise statement, such as
+{\sl let n be a positive natural number},
+we have to add another declaration, which will declare explicitly the
+hypothesis \verb:Pos_n:, with specification the proper logical
+proposition:
+\begin{coq_example}
+Hypothesis Pos_n : (gt n 0).
+\end{coq_example}
+
+Indeed we may check that the relation \verb:gt: is known with the right type
+in the current context:
+
+\begin{coq_example}
+Check gt.
+\end{coq_example}
+
+which tells us that \verb:gt: is a function expecting two arguments of
+type \verb:nat: in order to build a logical proposition.
+What happens here is similar to what we are used to in a functional
+programming language: we may compose the (specification) type \verb:nat:
+with the (abstract) type \verb:Prop: of logical propositions through the
+arrow function constructor, in order to get a functional type
+\verb:nat->Prop::
+\begin{coq_example}
+Check (nat -> Prop).
+\end{coq_example}
+which may be composed again with \verb:nat: in order to obtain the
+type \verb:nat->nat->Prop: of binary relations over natural numbers.
+Actually \verb:nat->nat->Prop: is an abbreviation for 
+\verb:nat->(nat->Prop):. 
+
+Functional notions may be composed in the usual way. An expression $f$
+of type $A\ra B$ may be applied to an expression $e$ of type $A$ in order
+to form the expression $(f~e)$ of type $B$. Here we get that
+the expression \verb:(gt n): is well-formed of type \verb:nat->Prop:,
+and thus that the expression \verb:(gt n O):, which abbreviates
+\verb:((gt n) O):, is a well-formed proposition.
+\begin{coq_example}
+Check gt n O.
+\end{coq_example}
+
+\subsection{Definitions}
+
+The initial prelude contains a few arithmetic definitions:
+\verb:nat: is defined as a mathematical collection (type \verb:Set:), constants
+\verb:O:, \verb:S:, \verb:plus:, are defined as objects of types
+respectively \verb:nat:, \verb:nat->nat:, and \verb:nat->nat->nat:.
+You may introduce new definitions, which link a name to a well-typed value.
+For instance, we may introduce the constant \verb:one: as being defined
+to be equal to the successor of zero:
+\begin{coq_example}
+Definition one := (S O).
+\end{coq_example}
+We may optionally indicate the required type:
+\begin{coq_example}
+Definition two : nat := S one.
+\end{coq_example}
+
+Actually \Coq~ allows several possible syntaxes:
+\begin{coq_example}
+Definition three : nat := S two.
+\end{coq_example}
+
+Here is a way to define the doubling function, which expects an
+argument \verb:m: of type \verb:nat: in order to build its result as
+\verb:(plus m m)::
+
+\begin{coq_example}
+Definition double (m:nat) := plus m m.
+\end{coq_example}
+This definition introduces the constant \texttt{double} defined as the
+expression \texttt{fun m:nat => plus m m}.
+The abstraction introduced by \texttt{fun} is explained as follows. The expression
+\verb+fun x:A => e+ is well formed of type \verb+A->B+ in a context
+whenever the expression \verb+e+ is well-formed of type \verb+B+ in 
+the given context to which we add the declaration that \verb+x+
+is of type \verb+A+. Here \verb+x+ is a bound, or dummy variable in
+the expression \verb+fun x:A => e+. For instance we could as well have
+defined \verb:double: as \verb+fun n:nat => (plus n n)+.
+
+Bound (local) variables and free (global) variables may be mixed.
+For instance, we may define the function which adds the constant \verb:n:
+to its argument as
+\begin{coq_example}
+Definition add_n (m:nat) := plus m n.
+\end{coq_example}
+However, note that here we may not rename the formal argument $m$ into $n$
+without capturing the free occurrence of $n$, and thus changing the meaning
+of the defined notion.
+
+Binding operations are well known for instance in logic, where they
+are called quantifiers.  Thus we may universally quantify a
+proposition such as $m>0$ in order to get a universal proposition
+$\forall m\cdot m>0$. Indeed this operator is available in \Coq, with
+the following syntax: \verb+forall m:nat, gt m O+. Similarly to the
+case of the functional abstraction binding, we are obliged to declare
+explicitly the type of the quantified variable. We check:
+\begin{coq_example}
+Check (forall m:nat, gt m 0).
+\end{coq_example}
+We may clean-up the development by removing the contents of the
+current section:
+\begin{coq_example}
+Reset Declaration.
+\end{coq_example}
+
+\section{Introduction to the proof engine: Minimal Logic}
+
+In the following, we are going to consider various propositions, built
+from atomic propositions $A, B, C$. This may be done easily, by
+introducing these atoms as global variables declared of type \verb:Prop:.
+It is easy to declare several names with the same specification:
+\begin{coq_example}
+Section Minimal_Logic.
+Variables A B C : Prop.
+\end{coq_example}
+
+We shall consider simple implications, such as $A\ra B$, read as 
+``$A$ implies $B$''. Remark that we overload the arrow symbol, which
+has been used above as the functionality type constructor, and which
+may be used as well as propositional connective:
+\begin{coq_example}
+Check (A -> B).
+\end{coq_example}
+
+Let us now embark on a simple proof. We want to prove the easy tautology
+$((A\ra (B\ra C))\ra (A\ra B)\ra (A\ra C)$. 
+We enter the proof engine by the command
+\verb:Goal:, followed by the conjecture we want to verify:
+\begin{coq_example}
+Goal (A -> B -> C) -> (A -> B) -> A -> C.
+\end{coq_example}
+
+The system displays the current goal below a double line, local hypotheses
+(there are none initially) being displayed above the line. We call 
+the combination of local hypotheses with a goal a {\sl judgment}.
+%The new prompt \verb:Unnamed_thm <: indicates that.
+We are now in an inner 
+loop of the system, in proof mode. 
+New commands are available in this
+mode, such as {\sl tactics}, which are proof combining primitives.
+A tactic operates on the current goal by attempting to construct a proof
+of the corresponding judgment, possibly from proofs of some
+hypothetical judgments, which are then added to the current
+list of conjectured judgments.
+For instance, the \verb:intro: tactic is applicable to any judgment
+whose goal is an implication, by moving the proposition to the left
+of the application to the list of local hypotheses:
+\begin{coq_example}
+intro H.
+\end{coq_example}
+
+%{\bf Warning} to users of \Coq~ previous versions: The display of a sequent in
+%older versions of \Coq~ is inverse of this convention: the goal is displayed
+%above the double line, the hypotheses below.
+
+Several introductions may be done in one step:
+\begin{coq_example}
+intros H' HA.
+\end{coq_example}
+
+We notice that $C$, the current goal, may be obtained from hypothesis
+\verb:H:, provided the truth of $A$ and $B$ are established.
+The tactic \verb:apply: implements this piece of reasoning:
+\begin{coq_example}
+apply H.
+\end{coq_example}
+
+We are now in the situation where we have two judgments as conjectures
+that remain to be proved. Only the first is listed in full, for the
+others the system displays only the corresponding subgoal, without its
+local hypotheses list. Remark that \verb:apply: has kept the local
+hypotheses of its father judgment, which are still available for
+the judgments it generated.
+
+In order to solve the current goal, we just have to notice that it is
+exactly available as hypothesis $HA$:
+\begin{coq_example}
+exact HA.
+\end{coq_example}
+
+Now $H'$ applies:
+\begin{coq_example}
+apply H'.
+\end{coq_example}
+
+And we may now conclude the proof as before, with \verb:exact HA.:
+Actually, we may not bother with the name \verb:HA:, and just state that
+the current goal is solvable from the current local assumptions:
+\begin{coq_example}
+assumption.
+\end{coq_example}
+
+The proof is now finished. We may either discard it, by using the
+command \verb:Abort: which returns to the standard \Coq~ toplevel loop
+without further ado, or else save it as a lemma in the current context,
+under name say \verb:trivial_lemma::
+\begin{coq_example}
+Save trivial_lemma.
+\end{coq_example}
+
+As a comment, the system shows the proof script listing all tactic
+commands used in the proof. % ligne blanche apres exact HA??
+
+Let us redo the same proof with a few variations. First of all we may name
+the initial goal as a conjectured lemma:
+\begin{coq_example}
+Lemma distr_impl : (A -> B -> C) -> (A -> B) -> A -> C.
+\end{coq_example}
+
+%{\bf Warning} to users of \Coq~ older versions: In order to enter the proof
+%engine, at this point a dummy \verb:Goal.: command had to be typed in.
+
+Next, we may omit the names of local assumptions created by the introduction
+tactics, they can be automatically created by the proof engine as new
+non-clashing names.
+\begin{coq_example}
+intros.
+\end{coq_example}
+
+The \verb:intros: tactic, with no arguments, effects as many individual
+applications of \verb:intro: as is legal.
+
+Then, we may compose several tactics together in sequence, or in parallel,
+through {\sl tacticals}, that is tactic combinators. The main constructions
+are the following:
+\begin{itemize}
+\item $T_1 ; T_2$ (read $T_1$ then $T_2$) applies tactic $T_1$ to the current
+goal, and then tactic $T_2$ to all the subgoals generated by $T_1$.
+\item $T; [T_1 | T_2 | ... | T_n]$ applies tactic $T$ to the current
+goal, and then tactic $T_1$ to the first newly generated subgoal, 
+..., $T_n$ to the nth.
+\end{itemize}
+
+We may thus complete the proof of \verb:distr_impl: with one composite tactic:
+\begin{coq_example}
+apply H; [ assumption | apply H0; assumption ].
+\end{coq_example}
+
+Let us now save lemma \verb:distr_impl::
+\begin{coq_example}
+Save.
+\end{coq_example}
+
+Here \verb:Save: needs no argument, since we gave the name \verb:distr_impl: 
+in advance;
+it is however possible to override the given name by giving a different 
+argument to command \verb:Save:.
+
+Actually, such an easy combination of tactics \verb:intro:, \verb:apply:
+and \verb:assumption: may be found completely automatically by an automatic
+tactic, called \verb:auto:, without user guidance:
+\begin{coq_example}
+Lemma distr_imp : (A -> B -> C) -> (A -> B) -> A -> C.
+auto.
+\end{coq_example}
+
+This time, we do not save the proof, we just discard it with the \verb:Abort: 
+command:
+
+\begin{coq_example}
+Abort.
+\end{coq_example}
+
+At any point during a proof, we may use \verb:Abort: to exit the proof mode
+and go back to Coq's main loop. We may also use \verb:Restart: to restart
+from scratch the proof of the same lemma. We may also use \verb:Undo: to
+backtrack one step, and more generally \verb:Undo n: to
+backtrack n steps.
+
+We end this section by showing a useful command, \verb:Inspect n.:,
+which inspects the global \Coq~ environment, showing the last \verb:n: declared
+notions: % Attention ici ??
+\begin{coq_example}
+Inspect 3.
+\end{coq_example}
+
+The declarations, whether global parameters or axioms, are shown preceded by 
+\verb:***:; definitions and lemmas are stated with their specification, but
+their value (or proof-term) is omitted.
+
+\section{Propositional Calculus}
+
+\subsection{Conjunction}
+
+We have seen how \verb:intro: and \verb:apply: tactics could be combined
+in order to prove implicational statements. More generally, \Coq~ favors a style
+of reasoning, called {\sl Natural Deduction}, which decomposes reasoning into 
+so called {\sl introduction rules}, which tell how to prove a goal whose main 
+operator is a given propositional connective, and {\sl elimination rules},
+which tell how to use an hypothesis whose main operator is the propositional 
+connective. Let us show how to use these ideas for the propositional connectives
+\verb:/\: and \verb:\/:.
+
+\begin{coq_example}
+Lemma and_commutative : A /\ B -> B /\ A.
+intro.
+\end{coq_example}
+
+We make use of the conjunctive hypothesis \verb:H: with the \verb:elim: tactic,
+which breaks it into its components:
+\begin{coq_example}
+elim H.
+\end{coq_example}
+
+We now use the conjunction introduction tactic \verb:split:, which splits the 
+conjunctive goal into the two subgoals:
+\begin{coq_example}
+split.
+\end{coq_example}
+
+and the proof is now trivial. Indeed, the whole proof is obtainable as follows:
+\begin{coq_example}
+Restart.
+intro H; elim H; auto.
+Qed.
+\end{coq_example}
+
+The tactic \verb:auto: succeeded here because it knows as a hint the 
+conjunction introduction operator \verb+conj+
+\begin{coq_example}
+Check conj.
+\end{coq_example}
+
+Actually, the tactic \verb+Split+ is just an abbreviation for \verb+apply conj.+
+
+What we have just seen is that the \verb:auto: tactic is more powerful than
+just a simple application of local hypotheses; it tries to apply as well 
+lemmas which have been specified as hints. A 
+\verb:Hint Resolve: command registers a
+lemma as a hint to be used from now on by the \verb:auto: tactic, whose power 
+may thus be incrementally augmented.
+
+\subsection{Disjunction}
+
+In a similar fashion, let us consider disjunction:
+
+\begin{coq_example}
+Lemma or_commutative : A \/ B -> B \/ A.
+intro H; elim H.
+\end{coq_example}
+
+Let us prove the first subgoal in detail. We use \verb:intro: in order to
+be left to prove \verb:B\/A: from \verb:A::
+
+\begin{coq_example}
+intro HA.
+\end{coq_example}
+
+Here the hypothesis \verb:H: is not needed anymore. We could choose to
+actually erase it with the tactic \verb:clear:; in this simple proof it
+does not really matter, but in bigger proof developments it is useful to
+clear away unnecessary hypotheses which may clutter your screen.
+\begin{coq_example}
+clear H.
+\end{coq_example}
+
+The disjunction connective has two introduction rules, since \verb:P\/Q:
+may be obtained from \verb:P: or from \verb:Q:; the two corresponding
+proof constructors are called respectively \verb:or_introl: and
+\verb:or_intror:; they are applied to the current goal by tactics
+\verb:left: and \verb:right: respectively. For instance:
+\begin{coq_example}
+right.
+trivial.
+\end{coq_example}
+The tactic \verb:trivial: works like \verb:auto: with the hints
+database, but it only tries those tactics that can solve the goal in one
+step. 
+
+As before, all these tedious elementary steps may be performed automatically,
+as shown for the second symmetric case:
+
+\begin{coq_example}
+auto.
+\end{coq_example}
+
+However, \verb:auto: alone does not succeed in proving the full lemma, because
+it does not try any elimination step.
+It is a bit disappointing that \verb:auto: is not able to prove automatically 
+such a simple tautology. The reason is that we want to keep
+\verb:auto: efficient, so that it is always effective to use. 
+
+\subsection{Tauto}
+
+A complete tactic for propositional
+tautologies is indeed available in \Coq~ as the \verb:tauto: tactic. 
+%In order to get this facility, we have to import a library module 
+%called ``Dyckhoff'':
+\begin{coq_example}
+Restart.
+tauto.
+Qed.
+\end{coq_example}
+
+It is possible to inspect the actual proof tree constructed by \verb:tauto:,
+using a standard command of the system, which prints the value of any notion 
+currently defined in the context:
+\begin{coq_example}
+Print or_commutative.
+\end{coq_example}
+
+It is not easy to understand the notation for proof terms without a few
+explanations. The \texttt{fun} prefix, such as \verb+fun H:A\/B =>+, 
+corresponds
+to \verb:intro H:, whereas a subterm such as 
+\verb:(or_intror: \verb:B H0):
+corresponds to the sequence \verb:apply or_intror; exact H0:. 
+The generic combinator \verb:or_intror: needs to be instantiated by
+the two properties \verb:B: and \verb:A:. Because \verb:A: can be
+deduced from the type of \verb:H0:, only  \verb:B: is printed.
+The two instantiations are effected automatically by the tactic
+\verb:apply: when pattern-matching a goal. The specialist will of course
+recognize our proof term as a $\lambda$-term, used as notation for the
+natural deduction proof term through the Curry-Howard isomorphism. The
+naive user of \Coq~ may safely ignore these formal details.
+
+Let us exercise the \verb:tauto: tactic on a more complex example:
+\begin{coq_example}
+Lemma distr_and : A -> B /\ C -> (A -> B) /\ (A -> C).
+tauto.
+Qed.
+\end{coq_example}
+
+\subsection{Classical reasoning}
+
+\verb:tauto: always comes back with an answer. Here is an example where it 
+fails:
+\begin{coq_example}
+Lemma Peirce : ((A -> B) -> A) -> A.
+try tauto.
+\end{coq_example}
+
+Note the use of the \verb:Try: tactical, which does nothing if its tactic
+argument fails.
+
+This may come as a surprise to someone familiar with classical reasoning. 
+Peirce's lemma is true in Boolean logic, i.e. it evaluates to \verb:true: for 
+every truth-assignment to \verb:A: and \verb:B:. Indeed the double negation
+of Peirce's law may be proved in \Coq~ using \verb:tauto::
+\begin{coq_example}
+Abort.
+Lemma NNPeirce : ~ ~ (((A -> B) -> A) -> A).
+tauto.
+Qed.
+\end{coq_example}
+
+In classical logic, the double negation of a proposition is equivalent to this 
+proposition, but in the constructive logic of \Coq~ this is not so. If you 
+want to use classical logic in \Coq, you have to import explicitly the
+\verb:Classical: module, which will declare the axiom \verb:classic:
+of excluded middle, and classical tautologies such as de Morgan's laws.
+The \verb:Require: command is used to import a module from \Coq's library:
+\begin{coq_example}
+Require Import Classical.
+Check NNPP.
+\end{coq_example}
+
+and it is now easy (although admittedly not the most direct way) to prove
+a classical law such as Peirce's:
+\begin{coq_example}
+Lemma Peirce : ((A -> B) -> A) -> A.
+apply NNPP; tauto.
+Qed.
+\end{coq_example}
+
+Here is one more example of propositional reasoning, in the shape of
+a Scottish puzzle. A private club has the following rules:
+\begin{enumerate}
+\item Every non-scottish member wears red socks
+\item Every member wears a kilt or doesn't wear red socks
+\item The married members don't go out on Sunday
+\item A member goes out on Sunday if and only if he is Scottish
+\item Every member who wears a kilt is Scottish and married
+\item Every scottish member wears a kilt
+\end{enumerate}
+Now, we show that these rules are so strict that no one can be accepted.
+\begin{coq_example}
+Section club.
+Variables Scottish RedSocks WearKilt Married GoOutSunday : Prop.
+Hypothesis rule1 : ~ Scottish -> RedSocks.
+Hypothesis rule2 : WearKilt \/ ~ RedSocks.
+Hypothesis rule3 : Married -> ~ GoOutSunday.
+Hypothesis rule4 : GoOutSunday <-> Scottish.
+Hypothesis rule5 : WearKilt -> Scottish /\ Married.
+Hypothesis rule6 : Scottish -> WearKilt.
+Lemma NoMember : False.
+tauto.
+Qed.
+\end{coq_example}
+At that point \verb:NoMember: is a proof of the absurdity depending on
+hypotheses.
+We may end the section, in that case, the variables and hypotheses
+will be discharged, and the type of \verb:NoMember: will be
+generalised.
+
+\begin{coq_example}
+End club.
+Check NoMember.
+\end{coq_example}
+
+\section{Predicate Calculus}
+
+Let us now move into predicate logic, and first of all into first-order
+predicate calculus. The essence of predicate calculus is that to try to prove 
+theorems in the most abstract possible way, without using the definitions of 
+the mathematical notions, but by formal manipulations of uninterpreted 
+function and predicate symbols. 
+
+\subsection{Sections and signatures}
+
+Usually one works in some domain of discourse, over which range the individual 
+variables and function symbols. In \Coq~ we speak in a language with a rich 
+variety of types, so me may mix several domains of discourse, in our 
+multi-sorted language. For the moment, we just do a few exercises, over a 
+domain of discourse \verb:D: axiomatised as a \verb:Set:, and we consider two 
+predicate symbols  \verb:P: and \verb:R: over \verb:D:, of arities 
+respectively 1 and 2. Such abstract entities may be entered in the context
+as global variables. But we must be careful about the pollution of our
+global environment by such declarations. For instance, we have already 
+polluted our \Coq~ session by declaring the variables
+\verb:n:, \verb:Pos_n:, \verb:A:, \verb:B:, and \verb:C:. If we want to revert to the clean state of
+our initial session, we may use the \Coq~ \verb:Reset: command, which returns
+to the state just prior the given global notion as we did before to
+remove a section, or we may return to the initial state using~:
+\begin{coq_example}
+Reset Initial.
+\end{coq_example}
+
+We shall now declare a new \verb:Section:, which will allow us to define
+notions local to a well-delimited scope. We start by assuming a domain of
+discourse \verb:D:, and a binary relation \verb:R:  over \verb:D:: 
+\begin{coq_example}
+Section Predicate_calculus.
+Variable D : Set.
+Variable R : D -> D -> Prop.
+\end{coq_example}
+
+As a simple example of predicate calculus reasoning, let us assume
+that relation \verb:R: is symmetric and transitive, and let us show that
+\verb:R: is reflexive in any point \verb:x: which has an \verb:R: successor.
+Since we do not want to make the assumptions about \verb:R: global axioms of 
+a theory, but rather local hypotheses to a theorem, we open a specific
+section to this effect.
+\begin{coq_example}
+Section R_sym_trans.
+Hypothesis R_symmetric : forall x y:D, R x y -> R y x.
+Hypothesis R_transitive : forall x y z:D, R x y -> R y z -> R x z.
+\end{coq_example}
+
+Remark the syntax \verb+forall x:D,+ which stands for universal quantification
+$\forall x : D$.
+
+\subsection{Existential quantification}
+
+We now state our lemma, and enter proof mode.
+\begin{coq_example}
+Lemma refl_if : forall x:D, (exists y, R x y) -> R x x.
+\end{coq_example}
+
+Remark that the hypotheses which are local to the currently opened sections
+are listed as local hypotheses to the current goals.
+The rationale is that these hypotheses are going to be discharged, as we
+shall see, when we shall close the corresponding sections.
+
+Note the functional syntax for existential quantification. The existential
+quantifier is built from the operator \verb:ex:, which expects a 
+predicate as argument:
+\begin{coq_example}
+Check ex.
+\end{coq_example}
+and the notation \verb+(exists x:D, P x)+ is just concrete syntax for 
+\verb+(ex D (fun x:D => P x))+. 
+Existential quantification is handled in \Coq~ in a similar
+fashion to the connectives \verb:/\: and \verb:\/: : it is introduced by
+the proof combinator \verb:ex_intro:, which is invoked by the specific 
+tactic \verb:Exists:, and its elimination provides a witness \verb+a:D+ to
+\verb:P:, together with an assumption \verb+h:(P a)+ that indeed \verb+a+
+verifies \verb:P:. Let us see how this works on this simple example.
+\begin{coq_example}
+intros x x_Rlinked.
+\end{coq_example}
+
+Remark that \verb:intros: treats universal quantification in the same way
+as the premises of implications. Renaming of bound variables occurs
+when it is needed; for instance, had we started with \verb:intro y:,
+we would have obtained the goal:
+\begin{coq_eval}
+Undo.
+\end{coq_eval}
+\begin{coq_example}
+intro y.
+\end{coq_example}
+\begin{coq_eval}
+Undo.
+intros x x_Rlinked.
+\end{coq_eval}
+
+Let us now use the existential hypothesis \verb:x_Rlinked: to 
+exhibit an R-successor y of x. This is done in two steps, first with
+\verb:elim:, then with \verb:intros:
+
+\begin{coq_example}
+elim x_Rlinked.
+intros y Rxy.
+\end{coq_example}
+
+Now we want to use \verb:R_transitive:. The \verb:apply: tactic will know
+how to match \verb:x: with \verb:x:, and \verb:z: with \verb:x:, but needs
+help on how to instantiate \verb:y:, which appear in the hypotheses of
+\verb:R_transitive:, but not in its conclusion. We give the proper hint
+to \verb:apply: in a \verb:with: clause, as follows:
+\begin{coq_example}
+apply R_transitive with y.
+\end{coq_example}
+
+The rest of the proof is routine:
+\begin{coq_example}
+assumption.
+apply R_symmetric; assumption.
+\end{coq_example}
+\begin{coq_example*}
+Qed.
+\end{coq_example*}
+
+Let us now close the current section.
+\begin{coq_example}
+End R_sym_trans.
+\end{coq_example}
+
+Here \Coq's printout is a warning that all local hypotheses have been 
+discharged in the statement of \verb:refl_if:, which now becomes a general
+theorem in the first-order language declared in section 
+\verb:Predicate_calculus:. In this particular example, the use of section
+\verb:R_sym_trans: has not been really significant, since we could have
+instead stated theorem \verb:refl_if: in its general form, and done 
+basically the same proof, obtaining \verb:R_symmetric: and
+\verb:R_transitive: as local hypotheses by initial \verb:intros: rather
+than as global hypotheses in the context. But if we had pursued the
+theory by proving more theorems about relation \verb:R:,
+we would have obtained all general statements at the closing of the section,
+with minimal dependencies on the hypotheses of symmetry and transitivity.
+
+\subsection{Paradoxes of classical predicate calculus}
+
+Let us illustrate this feature by pursuing our \verb:Predicate_calculus:
+section with an enrichment of our language: we declare a unary predicate
+\verb:P: and a constant \verb:d::
+\begin{coq_example}
+Variable P :  D -> Prop.
+Variable d : D.
+\end{coq_example}
+
+We shall now prove a well-known fact from first-order logic: a universal 
+predicate is non-empty, or in other terms existential quantification 
+follows from universal quantification.
+\begin{coq_example}
+Lemma weird : (forall x:D, P x) ->  exists a, P a.
+ intro UnivP.
+\end{coq_example}
+
+First of all, notice the pair of parentheses around
+\verb+forall x:D, P x+ in
+the statement of lemma \verb:weird:.
+If we had omitted them, \Coq's parser would have interpreted the
+statement as a truly trivial fact, since we would 
+postulate an \verb:x: verifying \verb:(P x):. Here the situation is indeed
+more problematic. If we have some element in \verb:Set: \verb:D:, we may
+apply \verb:UnivP: to it and conclude, otherwise we are stuck. Indeed
+such an element \verb:d: exists, but this is just by virtue of our
+new signature. This points out a subtle difference between standard
+predicate calculus and \Coq. In standard first-order logic,
+the equivalent of lemma \verb:weird: always holds, 
+because such a rule is wired in the inference rules for quantifiers, the
+semantic justification being that the interpretation domain is assumed to
+be non-empty. Whereas in \Coq, where types are not assumed to be 
+systematically inhabited, lemma \verb:weird: only holds in signatures
+which allow the explicit construction of an element in the domain of
+the predicate. 
+
+Let us conclude the proof, in order to show the use of the \verb:Exists:
+tactic:
+\begin{coq_example}
+exists d; trivial.
+Qed.
+\end{coq_example}
+
+Another fact which illustrates the sometimes disconcerting rules of
+classical 
+predicate calculus is Smullyan's drinkers' paradox: ``In any non-empty
+bar, there is a person such that if she drinks, then everyone drinks''.
+We modelize the bar by Set \verb:D:, drinking by predicate \verb:P:.
+We shall need classical reasoning. Instead of loading the \verb:Classical:
+module as we did above, we just state the law of excluded middle as a
+local hypothesis schema at this point:
+\begin{coq_example}
+Hypothesis EM : forall A:Prop, A \/ ~ A.
+Lemma drinker :  exists x:D, P x -> forall x:D, P x.
+\end{coq_example}
+The proof goes by cases on whether or not
+there is someone who does not drink. Such reasoning by cases proceeds
+by invoking the excluded middle principle, via \verb:elim: of the
+proper instance of \verb:EM::
+\begin{coq_example}
+elim (EM (exists x, ~ P x)).
+\end{coq_example}
+
+We first look at the first case. Let Tom be the non-drinker:
+\begin{coq_example}
+intro Non_drinker; elim Non_drinker; intros Tom Tom_does_not_drink.
+\end{coq_example}
+
+We conclude in that case by considering Tom, since his drinking leads to
+a contradiction:
+\begin{coq_example}
+exists Tom; intro Tom_drinks.
+\end{coq_example}
+
+There are several ways in which we may eliminate a contradictory case;
+a simple one is to use the \verb:absurd: tactic as follows:
+\begin{coq_example}
+absurd (P Tom); trivial.
+\end{coq_example}
+
+We now proceed with the second case, in which actually any person will do;
+such a John Doe is given by the non-emptiness witness \verb:d::
+\begin{coq_example}
+intro No_nondrinker; exists d; intro d_drinks.
+\end{coq_example}
+
+Now we consider any Dick in the bar, and reason by cases according to its
+drinking or not:
+\begin{coq_example}
+intro Dick; elim (EM (P Dick)); trivial.
+\end{coq_example}
+
+The only non-trivial case is again treated by contradiction:
+\begin{coq_example}
+intro Dick_does_not_drink; absurd (exists x, ~ P x); trivial.
+exists Dick; trivial.
+Qed.
+\end{coq_example}
+
+Now, let us close the main section and look at the complete statements
+we proved:
+\begin{coq_example}
+End Predicate_calculus.
+Check refl_if.
+Check weird.
+Check drinker.
+\end{coq_example}
+
+Remark how the three theorems are completely generic in the most general 
+fashion;
+the domain \verb:D: is discharged in all of them, \verb:R: is discharged in
+\verb:refl_if: only, \verb:P: is discharged only in \verb:weird: and
+\verb:drinker:, along with the hypothesis that \verb:D: is inhabited. 
+Finally, the excluded middle hypothesis is discharged only in 
+\verb:drinker:.
+
+Note that the name \verb:d: has vanished as well from
+the statements of \verb:weird: and \verb:drinker:, 
+since \Coq's pretty-printer replaces
+systematically a quantification such as \verb+forall d:D, E+, where \verb:d:
+does not occur in \verb:E:, by the functional notation \verb:D->E:. 
+Similarly the name \verb:EM: does not appear in \verb:drinker:. 
+
+Actually, universal quantification, implication, 
+as well as function formation, are
+all special cases of one general construct of type theory called
+{\sl dependent product}. This is the mathematical construction 
+corresponding to an indexed family of functions. A function 
+$f\in \Pi x:D\cdot Cx$ maps an element $x$ of its domain $D$ to its
+(indexed) codomain $Cx$. Thus a proof of $\forall x:D\cdot Px$ is
+a function mapping an element $x$ of $D$ to a proof of proposition $Px$.
+
+
+\subsection{Flexible use of local assumptions}
+
+Very often during the course of a proof we want to retrieve a local
+assumption and reintroduce it explicitly in the goal, for instance
+in order to get a more general induction hypothesis. The tactic
+\verb:generalize: is what is needed here:
+
+\begin{coq_example}
+Section Predicate_Calculus.
+Variables P Q : nat -> Prop.
+Variable R :  nat -> nat -> Prop.
+Lemma PQR :
+ forall x y:nat, (R x x -> P x -> Q x) -> P x -> R x y -> Q x.
+intros.
+generalize H0.
+\end{coq_example}
+
+Sometimes it may be convenient to use a lemma, although we do not have
+a direct way to appeal to such an already proven fact. The tactic \verb:cut:
+permits to use the lemma at this point, keeping the corresponding proof
+obligation as a new subgoal:
+\begin{coq_example}
+cut (R x x); trivial.
+\end{coq_example}
+We clean the goal by doing an \verb:Abort: command.
+\begin{coq_example*}
+Abort.
+\end{coq_example*}
+
+
+\subsection{Equality}
+
+The basic equality provided in \Coq~ is Leibniz equality, noted infix like
+\verb+x=y+, when \verb:x: and \verb:y: are two expressions of
+type the same Set. The replacement of \verb:x: by \verb:y: in any
+term is effected by a variety of tactics, such as \verb:rewrite:
+and \verb:replace:. 
+
+Let us give a few examples of equality replacement. Let us assume that
+some arithmetic function \verb:f: is null in zero:
+\begin{coq_example}
+Variable f : nat -> nat.
+Hypothesis foo : f 0 = 0.
+\end{coq_example}
+
+We want to prove the following conditional equality:
+\begin{coq_example*}
+Lemma L1 : forall k:nat, k = 0 -> f k = k.
+\end{coq_example*}
+
+As usual, we first get rid of local assumptions with \verb:intro::
+\begin{coq_example}
+intros k E.
+\end{coq_example}
+
+Let us now use equation \verb:E: as a left-to-right rewriting:
+\begin{coq_example}
+rewrite E.
+\end{coq_example}
+This replaced both occurrences of \verb:k: by \verb:O:. 
+
+Now \verb:apply foo: will finish the proof:
+
+\begin{coq_example}
+apply foo.
+Qed.
+\end{coq_example}
+
+When one wants to rewrite an equality in a right to left fashion, we should
+use \verb:rewrite <- E: rather than \verb:rewrite E: or the equivalent
+\verb:rewrite -> E:. 
+Let us now illustrate the tactic \verb:replace:.
+\begin{coq_example}
+Hypothesis f10 : f 1 = f 0.
+Lemma L2 : f (f 1) = 0.
+replace (f 1) with 0.
+\end{coq_example}
+What happened here is that the replacement left the first subgoal to be
+proved, but another proof obligation was generated by the \verb:replace:
+tactic, as the second subgoal. The first subgoal is solved immediately
+by applying lemma \verb:foo:; the second one transitivity and then 
+symmetry of equality, for instance with tactics \verb:transitivity: and 
+\verb:symmetry::
+\begin{coq_example}
+apply foo.
+transitivity (f 0); symmetry; trivial.
+\end{coq_example}
+In case the equality $t=u$ generated by \verb:replace: $u$ \verb:with:
+$t$ is an assumption
+(possibly modulo symmetry), it will be automatically proved and the
+corresponding goal will not appear. For instance:
+\begin{coq_example}
+Restart.
+replace (f 0) with 0.
+rewrite f10; rewrite foo; trivial.
+Qed.
+\end{coq_example}
+
+\section{Using definitions}
+
+The development of mathematics does not simply proceed by logical 
+argumentation from first principles: definitions are used in an essential way.
+A formal development proceeds by a dual process of abstraction, where one
+proves abstract statements in predicate calculus, and use of definitions, 
+which in the contrary one instantiates general statements with particular 
+notions in order to use the structure of mathematical values for the proof of
+more specialised properties.
+
+\subsection{Unfolding definitions}
+
+Assume that we want to develop the theory of sets represented as characteristic
+predicates over some universe \verb:U:. For instance:
+%CP Une petite explication pour le codage de element ?
+\begin{coq_example}
+Variable U : Type.
+Definition set := U -> Prop.
+Definition element (x:U) (S:set) := S x.
+Definition subset (A B:set) := forall x:U, element x A -> element x B.
+\end{coq_example}
+
+Now, assume that we have loaded a module of general properties about
+relations over some abstract type \verb:T:, such as transitivity:
+
+\begin{coq_example}
+Definition transitive (T:Type) (R:T -> T -> Prop) :=
+  forall x y z:T, R x y -> R y z -> R x z.
+\end{coq_example}
+
+Now, assume that we want to prove that \verb:subset: is a \verb:transitive:
+relation. 
+\begin{coq_example}
+Lemma subset_transitive : transitive set subset.
+\end{coq_example}
+
+In order to make any progress, one needs to use the definition of
+\verb:transitive:. The \verb:unfold: tactic, which replaces all
+occurrences of a defined notion by its definition in the current goal,
+may be used here.
+\begin{coq_example}
+unfold transitive.
+\end{coq_example}
+
+Now, we must unfold \verb:subset::
+\begin{coq_example}
+unfold subset.
+\end{coq_example}
+Now, unfolding \verb:element: would be a mistake, because indeed a simple proof
+can be found by \verb:auto:, keeping \verb:element: an abstract predicate:
+\begin{coq_example}
+auto.
+\end{coq_example}
+
+Many variations on \verb:unfold: are provided in \Coq. For instance,
+we may selectively unfold one designated occurrence:
+\begin{coq_example}
+Undo 2.
+unfold subset at 2.
+\end{coq_example}
+
+One may also unfold a definition in a given local hypothesis, using the
+\verb:in: notation:
+\begin{coq_example}
+intros.
+unfold subset in H.
+\end{coq_example}
+
+Finally, the tactic \verb:red: does only unfolding of the head occurrence
+of the current goal:
+\begin{coq_example}
+red.
+auto.
+Qed.
+\end{coq_example}
+
+
+\subsection{Principle of proof irrelevance}
+
+Even though in principle the proof term associated with a verified lemma
+corresponds to a defined value of the corresponding specification, such
+definitions cannot be unfolded in \Coq: a lemma is considered an {\sl opaque}
+definition. This conforms to the mathematical tradition of {\sl proof
+irrelevance}: the proof of a logical proposition does not matter, and the
+mathematical justification of a logical development relies only on
+{\sl provability} of the lemmas used in the formal proof. 
+
+Conversely, ordinary mathematical definitions can be unfolded at will, they
+are {\sl transparent}. 
+%It is possible to enforce the reverse convention by
+%declaring a definition as {\sl opaque} or a lemma as {\sl transparent}.
+
+\chapter{Induction}
+
+\section{Data Types as Inductively Defined Mathematical Collections}
+
+All the notions which were studied until now pertain to traditional
+mathematical logic. Specifications of objects were abstract properties
+used in reasoning more or less constructively; we are now entering
+the realm of inductive types, which specify the existence of concrete
+mathematical constructions.
+
+\subsection{Booleans}
+
+Let us start with the collection of booleans, as they are specified
+in the \Coq's \verb:Prelude: module: 
+\begin{coq_example}
+Inductive bool :  Set := true | false.
+\end{coq_example}
+
+Such a declaration defines several objects at once. First, a new
+\verb:Set: is declared, with name \verb:bool:. Then the {\sl constructors}
+of this \verb:Set: are declared, called \verb:true: and \verb:false:.
+Those are analogous to introduction rules of the new Set \verb:bool:.
+Finally, a specific elimination rule for \verb:bool: is now available, which
+permits to reason by cases on \verb:bool: values. Three instances are
+indeed defined as new combinators in the global context: \verb:bool_ind:,
+a proof combinator corresponding to reasoning by cases,
+\verb:bool_rec:, an if-then-else programming construct,
+and \verb:bool_rect:, a similar combinator at the level of types.
+Indeed:
+\begin{coq_example}
+Check bool_ind.
+Check bool_rec.
+Check bool_rect.
+\end{coq_example}
+
+Let us for instance prove that every Boolean is true or false.
+\begin{coq_example}
+Lemma duality : forall b:bool, b = true \/ b = false.
+intro b.
+\end{coq_example}
+
+We use the knowledge that \verb:b: is a \verb:bool: by calling tactic
+\verb:elim:, which is this case will appeal to combinator \verb:bool_ind:
+in order to split the proof according to the two cases:
+\begin{coq_example}
+elim b.
+\end{coq_example}
+
+It is easy to conclude in each case:
+\begin{coq_example}
+left; trivial.
+right; trivial.
+\end{coq_example}
+
+Indeed, the whole proof can be done with the combination of the
+\verb:simple induction: tactic, which combines \verb:intro: and \verb:elim:,
+with good old \verb:auto::
+\begin{coq_example}
+Restart.
+simple induction b; auto.
+Qed.
+\end{coq_example}
+
+\subsection{Natural numbers}
+
+Similarly to Booleans, natural numbers are defined in the \verb:Prelude:
+module with constructors \verb:S: and \verb:O::
+\begin{coq_example}
+Inductive nat : Set :=
+  | O : nat
+  | S : nat -> nat.
+\end{coq_example}
+
+The elimination principles which are automatically generated are Peano's
+induction principle, and a recursion operator:
+\begin{coq_example}
+Check nat_ind.
+Check nat_rec.
+\end{coq_example}
+
+Let us start by showing how to program the standard primitive recursion
+operator \verb:prim_rec: from the more general \verb:nat_rec::
+\begin{coq_example}
+Definition prim_rec := nat_rec (fun i:nat => nat).
+\end{coq_example}
+
+That is, instead of computing for natural \verb:i: an element of the indexed
+\verb:Set: \verb:(P i):, \verb:prim_rec: computes uniformly an element of 
+\verb:nat:. Let us check the type of \verb:prim_rec::
+\begin{coq_example}
+Check prim_rec.
+\end{coq_example}
+
+Oops! Instead of the expected type \verb+nat->(nat->nat->nat)->nat->nat+ we
+get an apparently more complicated expression. Indeed the type of
+\verb:prim_rec: is equivalent by rule $\beta$ to its expected type; this may
+be checked in \Coq~ by command \verb:Eval Cbv Beta:, which $\beta$-reduces
+an expression to its {\sl normal form}:
+\begin{coq_example}
+Eval cbv beta in
+  ((fun _:nat => nat) O ->
+   (forall y:nat, (fun _:nat => nat) y -> (fun _:nat => nat) (S y)) ->
+   forall n:nat, (fun _:nat => nat) n).
+\end{coq_example}
+
+Let us now show how to program addition with primitive recursion:
+\begin{coq_example}
+Definition addition (n m:nat) := prim_rec m (fun p rec:nat => S rec) n.
+\end{coq_example}
+
+That is, we specify that \verb+(addition n m)+ computes by cases on \verb:n:
+according to its main constructor; when \verb:n = O:, we get \verb:m:;
+ when \verb:n = S p:, we get \verb:(S rec):, where \verb:rec: is the result
+of the recursive computation \verb+(addition p m)+. Let us verify it by
+asking \Coq~to compute for us say $2+3$:
+\begin{coq_example}
+Eval compute in (addition (S (S O)) (S (S (S O)))).
+\end{coq_example}
+
+Actually, we do not have to do all explicitly. {\Coq} provides a
+special syntax {\tt Fixpoint/match} for generic primitive recursion,
+and we could thus have defined directly addition as:
+
+\begin{coq_example}
+Fixpoint plus (n m:nat) {struct n} : nat :=
+  match n with
+  | O => m
+  | S p => S (plus p m)
+  end.
+\end{coq_example}
+
+For the rest of the session, we shall clean up what we did so far with 
+types \verb:bool: and \verb:nat:, in order to use the initial definitions
+given in \Coq's \verb:Prelude: module, and not to get confusing error
+messages due to our redefinitions. We thus revert to the state before
+our definition of \verb:bool: with the \verb:Reset: command:
+\begin{coq_example}
+Reset bool.
+\end{coq_example}
+
+
+\subsection{Simple proofs by induction}
+%CP  Pourquoi ne pas commencer par des preuves d'egalite entre termes
+%    convertibles. 
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+Let us now show how to do proofs by structural induction. We start with easy
+properties of the \verb:plus: function we just defined. Let us first
+show that $n=n+0$.
+\begin{coq_example}
+Lemma plus_n_O : forall n:nat, n = n + 0.
+intro n; elim n.
+\end{coq_example}
+
+What happened was that \verb:elim n:, in order to construct a \verb:Prop:
+(the initial goal) from a \verb:nat: (i.e. \verb:n:), appealed to the
+corresponding induction principle \verb:nat_ind: which we saw was indeed
+exactly Peano's induction scheme. Pattern-matching instantiated the 
+corresponding predicate \verb:P: to \verb+fun n:nat => n = n + 0+, and we get
+as subgoals the corresponding instantiations of the base case \verb:(P O): ,
+and of the inductive step \verb+forall y:nat, P y -> P (S y)+.
+In each case we get an instance of function \verb:plus: in which its second
+argument starts with a constructor, and is thus amenable to simplification
+by primitive recursion. The \Coq~tactic \verb:simpl: can be used for
+this purpose:
+\begin{coq_example}
+simpl.
+auto.
+\end{coq_example}
+
+We proceed in the same way for the base step:
+\begin{coq_example}
+simpl; auto.
+Qed.
+\end{coq_example}
+
+Here \verb:auto: succeeded, because it used as a hint lemma \verb:eq_S:,
+which say that successor preserves equality:
+\begin{coq_example}
+Check eq_S.
+\end{coq_example}
+
+Actually, let us see how to declare our lemma \verb:plus_n_O: as a hint
+to be used by \verb:auto::
+\begin{coq_example}
+Hint Resolve plus_n_O .
+\end{coq_example}
+
+We now proceed to the similar property concerning the other constructor
+\verb:S::
+\begin{coq_example}
+Lemma plus_n_S : forall n m:nat, S (n + m) = n + S m.
+\end{coq_example}
+
+We now go faster, remembering that tactic \verb:simple induction: does the
+necessary \verb:intros: before applying \verb:elim:. Factoring simplification
+and automation in both cases thanks to tactic composition, we prove this
+lemma in one line:
+\begin{coq_example}
+simple induction n; simpl; auto.
+Qed.
+Hint Resolve plus_n_S .
+\end{coq_example}
+
+Let us end this exercise with the commutativity of \verb:plus::
+
+\begin{coq_example}
+Lemma plus_com : forall n m:nat, n + m = m + n.
+\end{coq_example}
+
+Here we have a choice on doing an induction on \verb:n: or on \verb:m:, the
+situation being symmetric. For instance:
+\begin{coq_example}
+simple induction m; simpl; auto.
+\end{coq_example}
+
+Here \verb:auto: succeeded on the base case, thanks to our hint
+\verb:plus_n_O:, but the induction step requires rewriting, which
+\verb:auto: does not handle:
+
+\begin{coq_example}
+intros m' E; rewrite <- E; auto.
+Qed.
+\end{coq_example}
+
+\subsection{Discriminate}
+
+It is also possible to define new propositions by primitive recursion.
+Let us for instance define the predicate which discriminates between
+the constructors \verb:O: and \verb:S:: it computes to \verb:False: 
+when its argument is \verb:O:, and to \verb:True: when its argument is 
+of the form \verb:(S n)::
+\begin{coq_example}
+Definition Is_S (n:nat) := match n with
+                           | O => False
+                           | S p => True
+                           end.
+\end{coq_example}
+
+Now we may use the computational power of \verb:Is_S: in order to prove
+trivially that \verb:(Is_S (S n))::
+\begin{coq_example}
+Lemma S_Is_S : forall n:nat, Is_S (S n).
+simpl; trivial.
+Qed.
+\end{coq_example}
+
+But we may also use it to transform a \verb:False: goal into 
+\verb:(Is_S O):. Let us show a particularly important use of this feature;
+we want to prove that \verb:O: and \verb:S: construct different values, one
+of Peano's axioms:
+\begin{coq_example}
+Lemma no_confusion : forall n:nat, 0 <> S n.
+\end{coq_example}
+
+First of all, we replace negation by its definition, by reducing the
+goal with tactic \verb:red:; then we get contradiction by successive
+\verb:intros::
+\begin{coq_example}
+red; intros n H.
+\end{coq_example}
+
+Now we use our trick:
+\begin{coq_example}
+change (Is_S 0).
+\end{coq_example}
+
+Now we use equality in order to get a subgoal which computes out to 
+\verb:True:, which finishes the proof:
+\begin{coq_example}
+rewrite H; trivial.
+simpl; trivial.
+\end{coq_example}
+
+Actually, a specific tactic \verb:discriminate: is provided
+to produce mechanically such proofs, without the need for the user to define
+explicitly the relevant discrimination predicates:
+
+\begin{coq_example}
+Restart.
+intro n; discriminate.
+Qed.
+\end{coq_example}
+
+
+\section{Logic programming}
+
+In the same way as we defined standard data-types above, we
+may define inductive families, and for instance inductive predicates.
+Here is the definition of predicate $\le$ over type \verb:nat:, as
+given in \Coq's \verb:Prelude: module:
+\begin{coq_example*}
+Inductive le (n:nat) : nat -> Prop :=
+  | le_n : le n n
+  | le_S : forall m:nat, le n m -> le n (S m).
+\end{coq_example*}
+
+This definition introduces a new predicate \verb+le:nat->nat->Prop+,
+and the two constructors \verb:le_n: and \verb:le_S:, which are the
+defining clauses of \verb:le:. That is, we get not only the ``axioms''
+\verb:le_n: and \verb:le_S:, but also the converse property, that 
+\verb:(le n m): if and only if this statement can be obtained as a
+consequence of these defining clauses; that is, \verb:le: is the
+minimal predicate verifying clauses \verb:le_n: and \verb:le_S:. This is
+insured, as in the case of inductive data types, by an elimination principle,
+which here amounts to an induction principle \verb:le_ind:, stating this 
+minimality property:
+\begin{coq_example}
+Check le.
+Check le_ind.
+\end{coq_example}
+
+Let us show how proofs may be conducted with this principle.
+First we show that $n\le m \Rightarrow n+1\le m+1$:
+\begin{coq_example}
+Lemma le_n_S : forall n m:nat, le n m -> le (S n) (S m).
+intros n m n_le_m.
+elim n_le_m.
+\end{coq_example}
+
+What happens here is similar to the behaviour of \verb:elim: on natural
+numbers: it appeals to the relevant induction principle, here \verb:le_ind:,
+which generates the two subgoals, which may then be solved easily
+%as if ``backchaining'' the current goal
+with the help of the defining clauses of \verb:le:.
+\begin{coq_example}
+apply le_n; trivial.
+intros; apply le_S; trivial.
+\end{coq_example}
+
+Now we know that it is a good idea to give the defining clauses as hints,
+so that the proof may proceed with a simple combination of 
+\verb:induction: and \verb:auto:.
+\begin{coq_example}
+Restart.
+Hint Resolve le_n le_S .
+\end{coq_example}
+
+We have a slight problem however. We want to say ``Do an induction on
+hypothesis \verb:(le n m):'', but we have no explicit name for it. What we
+do in this case is to say ``Do an induction on the first unnamed hypothesis'',
+as follows.
+\begin{coq_example}
+simple induction 1; auto.
+Qed.
+\end{coq_example}
+
+Here is a more tricky problem. Assume we want to show that
+$n\le 0 \Rightarrow n=0$. This reasoning ought to follow simply from the
+fact that only the first defining clause of \verb:le: applies.
+\begin{coq_example} 
+Lemma tricky : forall n:nat, le n 0 -> n = 0.
+\end{coq_example}
+
+However, here trying something like \verb:induction 1: would lead
+nowhere (try it and see what happens). 
+An induction on \verb:n: would not be convenient either.
+What we must do here is analyse the definition of \verb"le" in order
+to match hypothesis \verb:(le n O): with the defining clauses, to find
+that only \verb:le_n: applies, whence the result. 
+This analysis may be performed by the ``inversion'' tactic
+\verb:inversion_clear: as follows:
+\begin{coq_example} 
+intros n H; inversion_clear H.
+trivial.
+Qed.
+\end{coq_example}
+
+\chapter{Modules}
+
+\section{Opening library modules}
+
+When you start \Coq~ without further requirements in the command line,
+you get a bare system with few libraries loaded.  As we saw, a standard
+prelude module provides the standard logic connectives, and a few
+arithmetic notions. If you want to load and open other modules from
+the library, you have to use the \verb"Require" command, as we saw for
+classical logic above. For instance, if you want more arithmetic
+constructions, you should request:
+\begin{coq_example*}
+Require Import Arith.
+\end{coq_example*}
+
+Such a command looks for a (compiled) module file \verb:Arith.vo: in
+the libraries registered by \Coq. Libraries inherit the structure of
+the file system of the operating system and are registered with the
+command \verb:Add LoadPath:. Physical directories are mapped to
+logical directories. Especially the standard library of \Coq~ is
+pre-registered as a library of name \verb=Coq=.  Modules have absolute
+unique names denoting their place in \Coq~ libraries.  An absolute
+name is a sequence of single identifiers separated by dots.  E.g. the
+module \verb=Arith= has full name \verb=Coq.Arith.Arith= and because
+it resides in eponym subdirectory \verb=Arith= of the standard
+library, it can be as well required by the command
+
+\begin{coq_example*}
+Require Import Coq.Arith.Arith.
+\end{coq_example*}
+
+This may be useful to avoid ambiguities if somewhere, in another branch
+of the libraries known by Coq, another module is also called
+\verb=Arith=. Notice that by default, when a library is registered,
+all its contents, and all the contents of its subdirectories recursively are
+visible and accessible by a short (relative) name as \verb=Arith=.
+Notice also that modules or definitions not explicitly registered in
+a library are put in a default library called \verb=Top=.
+
+The loading of a compiled file is quick, because the corresponding
+development is not type-checked again. 
+
+\section{Creating your own modules}
+
+You may create your own modules, by writing \Coq~ commands in a file,
+say \verb:my_module.v:. Such a module may be simply loaded in the current
+context, with command \verb:Load my_module:. It may also be compiled,
+%using the command \verb:Compile Module my_module: directly at the
+%\Coq~ toplevel, or else 
+in ``batch'' mode, using the UNIX command
+\verb:coqc:. Compiling the module \verb:my_module.v: creates a 
+file \verb:my_module.vo:{} that can be reloaded with command
+\verb:Require Import my_module:. 
+
+If a required module depends on other modules then the latters are
+automatically required beforehand. However their contents is not
+automatically visible.  If you want a module \verb=M= required in a
+module \verb=N= to be automatically visible when \verb=N= is required,
+you should use \verb:Require Export M: in your module \verb:N:.
+
+\section{Managing the context}
+
+It is often difficult to remember the names of all lemmas and
+definitions available in the current context, especially if large
+libraries have been loaded. A convenient \verb:SearchAbout: command
+is available to lookup all known facts 
+concerning a given predicate. For instance, if you want to know all the
+known lemmas about the less or equal relation, just ask:
+\begin{coq_example}
+SearchAbout le.
+\end{coq_example}
+Another command \verb:Search: displays only lemmas where the searched
+predicate appears at the head position in the conclusion.
+\begin{coq_example}
+Search le.
+\end{coq_example}
+
+A new and more convenient search tool is \textsf{SearchPattern}
+developed by Yves Bertot. It allows to find the theorems with a
+conclusion matching a given pattern, where \verb:\_: can be used in
+place of an arbitrary term. We remark in this example, that \Coq{}
+provides usual infix notations for arithmetic operators.
+
+\begin{coq_example}
+SearchPattern (_ + _ = _).
+\end{coq_example}
+
+% The argument to give is a type and it searches in the current context all
+% constants having the same type modulo certain notion of
+% \textit{isomorphism}. For example~:
+
+% \begin{coq_example}
+% Require Arith.
+% SearchIsos nat -> nat -> Prop.
+% SearchIsos (x,y,z:nat)(le x y) -> (le y z) -> (le x z).
+% \end{coq_example} 
+ 
+\section{Now you are on your own}
+
+This tutorial is necessarily incomplete. If you wish to pursue serious
+proving in \Coq, you should now get your hands on \Coq's Reference Manual,
+which contains a complete description of all the tactics we saw, 
+plus many more.
+You also should look in the library of developed theories which is distributed
+with \Coq, in order to acquaint yourself with various proof techniques.
+
+
+\end{document}
+
+% $Id: Tutorial.tex 8607 2006-02-23 14:21:14Z herbelin $ 
diff --git a/ide/blaster_window.ml b/ide/blaster_window.ml
index cca788c2..1b018015 100644
--- a/ide/blaster_window.ml
+++ b/ide/blaster_window.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: blaster_window.ml,v 1.5.2.1 2004/07/16 19:30:19 herbelin Exp $ *)
+(* $Id: blaster_window.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Gobject.Data
 open Ideutils
diff --git a/ide/command_windows.ml b/ide/command_windows.ml
index 42b65048..1f40e057 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,v 1.13.2.1 2004/07/16 19:30:19 herbelin Exp $ *)
+(* $Id: command_windows.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 class command_window () = 
   let window = GWindow.window 
diff --git a/ide/command_windows.mli b/ide/command_windows.mli
index 6028c818..3a5f0d60 100644
--- a/ide/command_windows.mli
+++ b/ide/command_windows.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: command_windows.mli,v 1.1.2.2 2005/01/21 17:21:33 herbelin Exp $ i*)
+(*i $Id: command_windows.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 class command_window :
   unit ->
diff --git a/ide/config_lexer.mll b/ide/config_lexer.mll
index 1c0720d1..7722e99a 100644
--- a/ide/config_lexer.mll
+++ b/ide/config_lexer.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: config_lexer.mll,v 1.4.2.1 2004/07/16 19:30:19 herbelin Exp $ *)
+(* $Id: config_lexer.mll 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 {
 
diff --git a/ide/config_parser.mly b/ide/config_parser.mly
index 48005efe..80cba27b 100644
--- a/ide/config_parser.mly
+++ b/ide/config_parser.mly
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (***********************************************************************/
 
-/* $Id: config_parser.mly,v 1.2.2.1 2004/07/16 19:30:20 herbelin Exp $ */
+/* $Id: config_parser.mly 5920 2004-07-16 20:01:26Z herbelin $ */
 
 %{
 
diff --git a/ide/coq.ico b/ide/coq.ico
index 390065bc..b99f6399 100644
--- a/ide/coq.ico
+++ b/ide/coq.ico
diff --git a/ide/coq.ml b/ide/coq.ml
index 31f9829b..31c2f792 100644
--- a/ide/coq.ml
+++ b/ide/coq.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coq.ml,v 1.38.2.2 2005/11/16 17:22:38 barras Exp $ *)
+(* $Id: coq.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 open Vernac
 open Vernacexpr
@@ -249,7 +249,7 @@ 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 (prterm_env_at_top env d))
+  (msg (pr_var_decl env a), msg (pr_lconstr_env_at_top env d))
 
 let prepare_hyps sigma env =
   assert (rel_context env = []);
@@ -263,7 +263,7 @@ 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 (prterm_env_at_top env g.evar_concl)))
+   (env, sigma, g.evar_concl, msg (pr_lconstr_env_at_top env g.evar_concl)))
 
 let get_current_goals () = 
     let pfts = get_pftreestate () in
@@ -280,7 +280,7 @@ let print_no_goal () =
     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 (Proof_trees.pr_subgoals_existential sigma gls)
+    msg (Printer.pr_subgoals sigma gls)
 
 
 type word_class = Normal | Kwd | Reserved
@@ -329,8 +329,8 @@ type reset_info = NoReset | Reset of Names.identifier * bool ref
 let compute_reset_info = function 
   | VernacDefinition (_, (_,id), DefineBody _, _) 
   | VernacBeginSection (_,id) 
-  | VernacDefineModule ((_,id), _, _, _) 
-  | VernacDeclareModule ((_,id), _, _, _)
+  | VernacDefineModule (_,(_,id), _, _, _) 
+  | VernacDeclareModule (_,(_,id), _, _)
   | VernacDeclareModuleType ((_,id), _, _)
   | VernacAssumption (_, (_,((_,id)::_,_))::_)
   | VernacInductive (_, ((_,id),_,_,_,_) :: _) ->
@@ -432,10 +432,8 @@ let make_cases s =
   let glob_ref = Nametab.locate qualified_name in
   match glob_ref with
     | Libnames.IndRef i -> 
-	let _,
-	{
-	  Declarations.mind_nparams = np ;
-	  Declarations.mind_consnames = carr ;
+	let {Declarations.mind_nparams = np},
+	{Declarations.mind_consnames = carr ;
 	 Declarations.mind_nf_lc = tarr } 
 	= Global.lookup_inductive i 
 	in
diff --git a/ide/coq.mli b/ide/coq.mli
index c1dfd847..eaa32068 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,v 1.14.2.3 2005/01/21 17:21:33 herbelin Exp $ i*)
+(*i $Id: coq.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 open Names
 open Term
diff --git a/ide/coq.png b/ide/coq.png
index 011203f7..2e5bdcd6 100644
--- a/ide/coq.png
+++ b/ide/coq.png
diff --git a/ide/coq2.ico b/ide/coq2.ico
index 36964902..bc1732fd 100755
--- a/ide/coq2.ico
+++ b/ide/coq2.ico
diff --git a/ide/coq_commands.ml b/ide/coq_commands.ml
index 1169d438..30d99f5b 100644
--- a/ide/coq_commands.ml
+++ b/ide/coq_commands.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coq_commands.ml,v 1.15.2.1 2004/07/16 19:30:20 herbelin Exp $ *)
+(* $Id: coq_commands.ml 7102 2005-06-03 13:14:27Z coq $ *)
 
 let commands = [
   [(* "Abort"; *)
@@ -22,6 +22,7 @@ let commands = [
    "Add Rec ML Path";
    "Add Ring A Aplus Amult Aone Azero Ainv Aeq T [ c1 ... cn ]. ";
    "Add Semi Ring A Aplus Amult Aone Azero Aeq T [ c1 ... cn ].";
+   "Add Relation";
    "Add Setoid";
    "Axiom";];
   [(* "Back"; *) ];
@@ -63,7 +64,7 @@ let commands = [
    "Hint Unfold";
    "Hypothesis";];
   ["Identity Coercion";
-   "Implicits";
+   "Implicit Arguments";
    "Inductive";
    "Infix";
    ];
@@ -173,6 +174,8 @@ let state_preserving = [
   "Print Module Type";
   "Print Modules";
   "Print Proof";
+  "Print Rewrite HintDb";
+  "Print Setoids";
   "Print Scope";
   "Print Scopes.";
   "Print Section";
@@ -196,6 +199,7 @@ let state_preserving = [
 
   "Show";
   "Show Conjectures";
+  "Show Existentials";
   "Show Implicits";
   "Show Intro";
   "Show Intros";
@@ -207,6 +211,9 @@ let state_preserving = [
   "Test Printing Let";
   "Test Printing Synth";
   "Test Printing Wildcard";
+
+  "Whelp Hint";
+  "Whelp Locate";
 ]
 
 
diff --git a/ide/coq_tactics.ml b/ide/coq_tactics.ml
index 4dd20b47..92d2de78 100644
--- a/ide/coq_tactics.ml
+++ b/ide/coq_tactics.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coq_tactics.ml,v 1.2.2.1 2004/07/16 19:30:20 herbelin Exp $ *)
+(* $Id: coq_tactics.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 let tactics = [
   "Abstract";
diff --git a/ide/coq_tactics.mli b/ide/coq_tactics.mli
index 962b4d27..05e233eb 100644
--- a/ide/coq_tactics.mli
+++ b/ide/coq_tactics.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coq_tactics.mli,v 1.1.2.2 2005/01/21 17:21:33 herbelin Exp $ i*)
+(*i $Id: coq_tactics.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 val tactics : string list
 
diff --git a/ide/coqide.ml b/ide/coqide.ml
index a8179fb9..d79ee950 100644
--- a/ide/coqide.ml
+++ b/ide/coqide.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqide.ml,v 1.99.2.6 2006/01/06 13:22:36 barras Exp $ *)
+(* $Id: coqide.ml 7644 2005-12-13 14:18:13Z narboux $ *)
 
 open Preferences
 open Vernacexpr
@@ -26,7 +26,6 @@ let (proof_view:GText.view option ref) = ref None
 let (_notebook:GPack.notebook option ref) = ref None
 let notebook () = out_some !_notebook
 
-
 (* Tabs contain the name of the edited file and 2 status informations: 
    Saved state + Focused proof buffer *)
 let decompose_tab w = 
@@ -252,7 +251,6 @@ let do_if_not_computing text f x =
     if Mutex.try_lock coq_computing 
     then 
       begin
-	prerr_endline ("Launching thread " ^ text);
 	let w = Blaster_window.blaster_window () in
 	if not (Mutex.try_lock w#lock) then begin 
 	  break ();
@@ -273,7 +271,7 @@ let do_if_not_computing text f x =
 	    Glib.Timeout.remove idle;
 	    prerr_endline "Releasing lock";
 	    Mutex.unlock coq_computing;
-	  with e -> 
+	  with e ->
 	    Glib.Timeout.remove idle;
 	    prerr_endline "Releasing lock (on error)";
 	    Mutex.unlock coq_computing;
@@ -283,6 +281,7 @@ let do_if_not_computing text f x =
     else 
       prerr_endline 
 	"Discarded order (computations are ongoing)" in
+  prerr_endline ("Launching thread " ^ text);
   ignore (Thread.create threaded_task ())
 
 let add_input_view tv = 
@@ -511,8 +510,8 @@ let update_on_end_of_proof id =
 let update_on_end_of_segment id =
   let lookup_section = function 
     | { ast = _, ( VernacBeginSection id'
-		 | VernacDefineModule (id',_,_,None)
-		 | VernacDeclareModule (id',_,_,None)
+		 | VernacDefineModule (_,id',_,_,None)
+		 | VernacDeclareModule (_,id',_,_)
 		 | VernacDeclareModuleType (id',_,None)); 
 	reset_info = Reset (_, r) } 
        when id = id' -> raise Exit
@@ -799,7 +798,7 @@ object(self)
 				 goal_nb
 				 (if goal_nb<=1 then "" else "s"));
 	  List.iter
-	    (fun ((_,_,_,(s,_)) as hyp) -> 
+	    (fun ((_,_,_,(s,_)) as _hyp) -> 
 	       proof_buffer#insert (s^"\n"))
 	    hyps;
 	  proof_buffer#insert (String.make 38 '_' ^ "(1/"^
@@ -944,37 +943,37 @@ object(self)
     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#set_message s;
-	 message_view#misc#draw None;
-	 if localize then 
-	   (match Util.option_app 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
+      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_app 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
+	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
+	let msg = read_stdout () in
+        sync display_output msg;
+        Some r
       end
     with e ->
       if show_error then sync display_error e;
@@ -1065,8 +1064,8 @@ object(self)
 	!push_info "Coq is computing";
 	input_view#set_editable false;
       end;
-      match self#find_phrase_starting_at self#get_start_of_input with
-        | None ->
+      match self#find_phrase_starting_at self#get_start_of_input with 
+	| None ->
 	    if do_highlight then begin
 	      input_view#set_editable true;
 	      !pop_info ();
@@ -1079,37 +1078,37 @@ object(self)
 	      prerr_endline "process_next_phrase : to_process applied";
 	    end;
 	    prerr_endline "process_next_phrase : getting phrase";
-	    Some((start,stop),start#get_slice ~stop) in
-    let remove_tag (start,stop) =
-      if do_highlight then begin
-	input_buffer#remove_tag_by_name ~start ~stop "to_process" ;
-	input_view#set_editable true;
-	!pop_info ();
-      end in
-    let mark_processed (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;
-      if (self#get_insert#compare) stop <= 0 then 
-	begin
-	  b#place_cursor stop;
-	  self#recenter_insert
-	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
-    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((start,stop),start#get_slice ~stop) in
+      let remove_tag (start,stop) =
+	if do_highlight then begin
+	  input_buffer#remove_tag_by_name ~start ~stop "to_process" ;
+	  input_view#set_editable true;
+	  !pop_info ();
+	end in
+      let mark_processed (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;
+	if (self#get_insert#compare) stop <= 0 then 
+	  begin
+	    b#place_cursor stop;
+	    self#recenter_insert
+	  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
+      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)
-    end
+      end
     
   method insert_this_phrase_on_success 
     show_output show_msg localize coqphrase insertphrase = 
@@ -1127,37 +1126,37 @@ object(self)
       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...
+      (*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
-	    | None -> ())
-	  | _ -> ())
-	with _ -> ()*) in
+	      | 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
+	      | 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
+      | Some ast -> sync mark_processed 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
@@ -1167,7 +1166,6 @@ object(self)
       input_buffer#apply_tag_by_name ~start ~stop "to_process";
       input_view#set_editable false) ();
     !push_info "Coq is computing";
-(*    process_pending ();*)
     (try 
        while ((stop#compare self#get_start_of_input>=0) 
 	      && (self#process_next_phrase false false false))
@@ -1199,8 +1197,8 @@ object(self)
         ) 
         processed_stack;
       Stack.clear processed_stack;
-      self#clear_message) ();
-    Coq.reset_initial ()
+      self#clear_message)();
+      Coq.reset_initial ()
 
 
   (* backtrack Coq to the phrase preceding iterator [i] *)
@@ -1250,9 +1248,9 @@ object(self)
 	   | None -> synchro () 
 	   | Some n -> try Pfedit.undo n with _ -> synchro ());
           sync (fun _ ->
-	    let start = if is_empty () then input_buffer#start_iter 
-	    else input_buffer#get_iter_at_mark (top ()).stop 
-	    in
+	    let start =
+              if is_empty () then input_buffer#start_iter 
+	      else input_buffer#get_iter_at_mark (top ()).stop in
 	    prerr_endline "Removing (long) processed tag...";
 	    input_buffer#remove_tag_by_name 
 	      ~start 
@@ -1347,6 +1345,7 @@ Please restart and report NOW.";
 
       
   method blaster () = 
+    
     ignore (Thread.create 
 	      (fun () ->  
 		 prerr_endline "Blaster called";
@@ -1354,7 +1353,6 @@ Please restart and report NOW.";
 		 if Mutex.try_lock c#lock then begin
 		   c#clear ();
 		   let current_gls = try get_current_goals () with _ -> [] in
-		   let gls_nb = List.length current_gls in
 		   
 		   let set_goal i (s,t) = 
 		     let gnb = string_of_int i in
@@ -1471,19 +1469,17 @@ Please restart and report NOW.";
       (input_view#event#connect#key_press self#active_keypress_handler);
     prerr_endline "CONNECTED active : ";
     print_id (out_some act_id);
-    let dir = (match 
-		 (out_some ((Vector.get input_views index).analyzed_view))
-		 #filename 
-	       with
-	       | None -> ()
-	       | Some f ->     
-		   if not (is_in_coq_path f) then 
-		     begin
-		       let dir = Filename.dirname f in
-		       ignore (Coq.interp false
-				 (Printf.sprintf "Add LoadPath \"%s\". "  dir))
-		     end)
-    in ()
+    match 
+      (out_some ((Vector.get input_views index).analyzed_view)) #filename 
+    with
+      | None -> ()
+      | Some f ->     
+	  if not (is_in_coq_path f) then 
+	    begin
+	      let dir = Filename.dirname f in
+	      ignore (Coq.interp false
+		(Printf.sprintf "Add LoadPath \"%s\". "  dir))
+	    end
 
       
       
@@ -1733,10 +1729,11 @@ let main files =
 	    ~title:"CoqIde" ()
   in
   (try
-    let icon_image = lib_ide_file "coq2.ico" in
+    let icon_image = lib_ide_file "coq.ico" in
     let icon = GdkPixbuf.from_file icon_image in
     w#set_icon (Some icon)
   with _ -> ());
+
   let vbox = GPack.vbox ~homogeneous:false ~packing:w#add () in
 
 
@@ -1822,7 +1819,7 @@ let main files =
   let load_f () = 	  
     match select_file ~title:"Load file" () with 
     | None -> ()
-    | (Some f) as fn -> load f
+    | Some f -> load f
   in
   ignore (load_m#connect#activate (load_f));
 
@@ -1896,7 +1893,7 @@ let main files =
   let saveall_f () = 
     Vector.iter
       (function 
-	 | {view = view ; analyzed_view = Some av} as full -> 
+	 | {view = view ; analyzed_view = Some av} -> 
 	     begin match av#filename with 
 	     | None -> ()
 	     | Some f ->
@@ -1919,7 +1916,7 @@ let main files =
   let revert_f () = 
     Vector.iter 
       (function 
-	   {view = view ; analyzed_view = Some av} as full -> 
+	   {view = view ; analyzed_view = Some av} -> 
 	     (try 
 		match av#filename,av#stats with 
 		| Some f,Some stats -> 
@@ -2054,21 +2051,19 @@ let main files =
 	      ignore (get_current_view()).view#clear_undo));
   ignore(edit_f#add_separator ());
   ignore(edit_f#add_item "Cut" ~key:GdkKeysyms._X ~callback:
-	   (do_if_not_computing "cut" (sync
-	      (fun () -> GtkSignal.emit_unit
+    (fun () -> GtkSignal.emit_unit
 		 (get_current_view()).view#as_view 
-		 GtkText.View.S.cut_clipboard))));
+		 GtkText.View.S.cut_clipboard));
   ignore(edit_f#add_item "Copy" ~key:GdkKeysyms._C ~callback:
 	   (fun () -> GtkSignal.emit_unit
 	      (get_current_view()).view#as_view 
 	      GtkText.View.S.copy_clipboard));
   ignore(edit_f#add_item "Paste" ~key:GdkKeysyms._V ~callback:
-	   (do_if_not_computing "paste" (sync 
 	      (fun () -> 
 		 try GtkSignal.emit_unit
 		   (get_current_view()).view#as_view 
 		   GtkText.View.S.paste_clipboard
-		 with _ -> prerr_endline "EMIT PASTE FAILED"))));
+		 with _ -> prerr_endline "EMIT PASTE FAILED"));
   ignore (edit_f#add_separator ());
 
 
@@ -2312,12 +2307,11 @@ let main files =
 *)
   
   ignore(edit_f#add_item "Complete Word" ~key:GdkKeysyms._slash ~callback:
-	 (do_if_not_computing "complete word" (sync 
 	    (fun () -> 
 	       ignore (
 		 let av = out_some ((get_current_view()).analyzed_view) in 
 		 av#complete_at_offset (av#get_insert)#offset
-	    )))));
+	    )));
 
   ignore(edit_f#add_separator ());
   (* external editor *)
@@ -2349,7 +2343,7 @@ let main files =
   let auto_save_f () = 
     Vector.iter 
       (function 
-	   {view = view ; analyzed_view = Some av} as full -> 
+	   {view = view ; analyzed_view = Some av} -> 
 	     (try 
 		av#auto_save
 	      with _ -> ())
@@ -2402,7 +2396,9 @@ let main files =
   in
 
   let do_or_activate f = 
-    do_if_not_computing "do_or_activate" (do_or_activate (fun av -> f av ; !pop_info();!push_info (Coq.current_status())))
+    do_if_not_computing "do_or_activate"
+      (do_or_activate
+        (fun av -> f av ; !pop_info();!push_info (Coq.current_status())))
   in
 
   let add_to_menu_toolbar text ~tooltip ?key ~callback icon = 
@@ -2472,7 +2468,8 @@ let main files =
     let analyzed_view = out_some current.analyzed_view in
     if analyzed_view#is_active then ignore (f analyzed_view)
   in
-  let do_if_active f = do_if_not_computing "do_if_active" (do_if_active_raw f) in
+  let do_if_active f =
+    do_if_not_computing "do_if_active" (do_if_active_raw f) in
 
 (*
   let blaster_i = 
@@ -2557,9 +2554,8 @@ let main files =
     in
     ignore (factory#add_item menu_text
 	      ~callback:
-	      (do_if_not_computing "simple template" (sync
 		 (fun () -> let {view = view } = get_current_view () in
-		  ignore (view#buffer#insert_interactive text)))))
+		  ignore (view#buffer#insert_interactive text)))
   in
   List.iter 
     (fun l -> 
@@ -2592,17 +2588,15 @@ let main files =
   in
   let add_complex_template (menu_text, text, offset, len, key) =
     (* Templates/Lemma *)
-    let callback = do_if_not_computing "complex template" (sync
-		     (fun () ->
-			let {view = view } = get_current_view () in
-			if view#buffer#insert_interactive text then begin
-			  let iter = view#buffer#get_iter_at_mark `INSERT in
-			  ignore (iter#nocopy#backward_chars offset);
-			  view#buffer#move_mark `INSERT iter;
-			  ignore (iter#nocopy#backward_chars len);
-			  view#buffer#move_mark `SEL_BOUND iter;
-			end))
-    in
+    let callback () =
+      let {view = view } = get_current_view () in
+      if view#buffer#insert_interactive text then begin
+	let iter = view#buffer#get_iter_at_mark `INSERT in
+	ignore (iter#nocopy#backward_chars offset);
+	view#buffer#move_mark `INSERT iter;
+	ignore (iter#nocopy#backward_chars len);
+	view#buffer#move_mark `SEL_BOUND iter;
+      end in
     ignore (templates_factory#add_item menu_text ~callback ?key)
   in
   add_complex_template 
@@ -2671,9 +2665,8 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
     in
     ignore (factory#add_item menu_text
 	      ~callback:
-	      (do_if_not_computing "simple template" (sync
 		 (fun () -> let {view = view } = get_current_view () in
-		  ignore (view#buffer#insert_interactive text)))))
+		  ignore (view#buffer#insert_interactive text)))
   in
 *)
   ignore (templates_factory#add_separator ());
@@ -2745,6 +2738,14 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 		   ~term 
 		   ())
   in
+  let _ = 
+    queries_factory#add_item "_Whelp Locate" 
+      ~callback:(fun () -> let term = get_current_word () in
+		 (Command_windows.command_window ())#new_command
+		 ~command:"Whelp Locate"
+		   ~term 
+		   ())
+  in
 
   (* Externals *)
   let externals_menu =  factory#add_submenu "_Compile" in
@@ -2954,21 +2955,23 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
   (* End of menu *)
 
   (* The vertical Separator between Scripts and Goals *)
-  let hb = GPack.paned `HORIZONTAL  ~border_width:3 ~packing:vbox#add () in
-  _notebook := Some (GPack.notebook ~scrollable:true 
-		       ~packing:hb#add1
+  let hb = GPack.paned `HORIZONTAL  ~border_width:5 ~packing:vbox#add () in
+  let fr_notebook = GBin.frame ~shadow_type:`IN ~packing:hb#add1 () in
+  _notebook := Some (GPack.notebook ~border_width:2 ~show_border:false ~scrollable:true 
+		       ~packing:fr_notebook#add
 		       ());
   let nb = notebook () in
-  let fr2 = GBin.frame ~shadow_type:`ETCHED_OUT ~packing:hb#add2 () in 
-  let hb2 = GPack.paned `VERTICAL  ~border_width:3 ~packing:fr2#add () in
+  let hb2 = GPack.paned `VERTICAL ~packing:hb#add2 () in
+  let fr_a = GBin.frame ~shadow_type:`IN ~packing:hb2#add () in
+  let fr_b = GBin.frame ~shadow_type:`IN ~packing:hb2#add () in
   let sw2 = GBin.scrolled_window 
 	      ~vpolicy:`AUTOMATIC 
 	      ~hpolicy:`AUTOMATIC
-	      ~packing:(hb2#add) () in
+	      ~packing:(fr_a#add) () in
   let sw3 = GBin.scrolled_window 
 	      ~vpolicy:`AUTOMATIC 
 	      ~hpolicy:`AUTOMATIC
-	      ~packing:(hb2#add) () in
+	      ~packing:(fr_b#add) () in
   let lower_hbox = GPack.hbox ~homogeneous:false ~packing:vbox#pack () in
   let status_bar = GMisc.statusbar ~packing:(lower_hbox#pack ~expand:true) () 
   in
@@ -3181,34 +3184,22 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
   let _ = tv3#set_editable false in
   let _ = GtkBase.Widget.add_events tv2#as_widget
 	    [`ENTER_NOTIFY;`POINTER_MOTION] in
-  let _ = tv2#event#connect#motion_notify
-	    ~callback:
-	    (fun e -> 
-	       (do_if_not_computing "motion notify" (sync
-		  (fun e -> 
-		     let win = match tv2#get_window `WIDGET with
-		       | None -> assert false
-		       | Some w -> w
-		     in
-		     let x,y = Gdk.Window.get_pointer_location win in
-		     let b_x,b_y = tv2#window_to_buffer_coords 
-				     ~tag:`WIDGET 
-				     ~x 
-				     ~y 
-		     in
-		     let it = tv2#get_iter_at_location ~x:b_x ~y:b_y in
-		     let tags = it#tags in
-		     List.iter 
-		       ( fun t ->
-			   ignore (GtkText.Tag.event 
-				     t#as_tag
-				     tv2#as_widget
-				     e 
-				     it#as_iter))
-		       tags;
-		     false)) e;
-	       false))
-  in
+  let _ =
+    tv2#event#connect#motion_notify
+      ~callback:
+      (fun e -> 
+	let win = match tv2#get_window `WIDGET with
+	  | None -> assert false
+	  | Some w -> w in
+	let x,y = Gdk.Window.get_pointer_location win in
+	let b_x,b_y = tv2#window_to_buffer_coords ~tag:`WIDGET ~x ~y in
+	let it = tv2#get_iter_at_location ~x:b_x ~y:b_y in
+	let tags = it#tags in
+	List.iter 
+	  (fun t ->
+	    ignore(GtkText.Tag.event t#as_tag tv2#as_widget e it#as_iter))
+	  tags;
+	false) in
   change_font := 
   (fun fd -> 
      tv2#misc#modify_font fd;
@@ -3219,7 +3210,7 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
   );
   let about (b:GText.buffer) =
     (try 
-       let image = lib_ide_file "coq.ico" in
+       let image = lib_ide_file "coq.png" in
        let startup_image = GdkPixbuf.from_file image in
        b#insert_pixbuf ~iter:b#start_iter 
 	 ~pixbuf:startup_image;
@@ -3333,6 +3324,26 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 
 ;;
 
+(* This function check every half of second if GeoProof has send 
+   something on his private clipboard *)
+
+let rec check_for_geoproof_input () = 
+  let cb_Dr = GData.clipboard (Gdk.Atom.intern "_GeoProof") in
+    while true do
+      Thread.delay 0.1;
+      let s = cb_Dr#text in
+	(match s with 
+	     Some s -> 
+	       if s <> "Ack" then
+		 (get_current_view()).view#buffer#insert (s^"\n");
+	       cb_Dr#set_text "Ack"
+	   | None -> ()
+	);
+	(* cb_Dr#clear does not work so i use : *)
+	(* cb_Dr#set_text "Ack" *) 
+    done
+
+
 let start () = 
   let files = Coq.init () in
   ignore_break ();
@@ -3351,9 +3362,10 @@ let start () =
   Command_windows.main ();
   Blaster_window.main 9;
   main files;
+  ignore (Thread.create check_for_geoproof_input ()); 
   while true do 
     try 
-      GtkThread.main ()
+      GtkThread.main ()	
     with
       | Sys.Break -> prerr_endline "Interrupted." ; flush stderr
       | e -> 
diff --git a/ide/coqide.mli b/ide/coqide.mli
index 553426f1..f904c730 100644
--- a/ide/coqide.mli
+++ b/ide/coqide.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coqide.mli,v 1.1.2.2 2005/01/21 17:21:33 herbelin Exp $ i*)
+(*i $Id: coqide.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 (* The CoqIde main module. The following function [start] will parse the
    command line, initialize the load path, load the input 
diff --git a/ide/extract_index.mll b/ide/extract_index.mll
index 4a8c37f1..152ad715 100644
--- a/ide/extract_index.mll
+++ b/ide/extract_index.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: extract_index.mll,v 1.2.2.1 2004/07/16 19:30:20 herbelin Exp $ *)
+(* $Id: extract_index.mll 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 {
   open Lexing 
diff --git a/ide/find_phrase.mll b/ide/find_phrase.mll
index 7b65bd94..1621e313 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,v 1.8.2.2 2004/10/15 14:50:13 coq Exp $ *)
+(* $Id: find_phrase.mll 6218 2004-10-15 14:27:04Z coq $ *)
 
 {
   exception Lex_error of string
@@ -36,10 +36,12 @@ rule next_phrase = parse
       length := !length + 1; 
       Buffer.add_string buff (Lexing.lexeme lexbuf);
       Buffer.contents buff}
-  | phrase_sep phrase_sep {
-      length := !length + 2; 
-      Buffer.add_string buff (Lexing.lexeme lexbuf);
-      next_phrase lexbuf}
+  | phrase_sep phrase_sep
+      { 
+	length := !length + 2; 
+	Buffer.add_string buff (Lexing.lexeme lexbuf);
+	next_phrase lexbuf
+      }
   | _ 
       { 
 	let c = Lexing.lexeme_char lexbuf 0 in 
diff --git a/ide/highlight.mll b/ide/highlight.mll
index e2a1d0cd..d68cb8a4 100644
--- a/ide/highlight.mll
+++ b/ide/highlight.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: highlight.mll,v 1.14.2.2 2004/11/27 14:41:43 herbelin Exp $ *)
+(* $Id: highlight.mll 6362 2004-11-27 14:39:35Z herbelin $ *)
 
 {
 
@@ -18,6 +18,33 @@
 
   let comment_start = ref 0
 
+  let is_keyword =
+    let h = Hashtbl.create 97 in
+    List.iter (fun s -> Hashtbl.add h s ())
+      [  "Add" ; "Defined" ; 
+	 "End" ; "Export" ; "Extraction" ; "Hint" ; "Hints" ;
+	 "Implicits" ; "Import" ; 
+	 "Infix" ; "Load" ; "match" ; "Module" ;
+	 "Proof" ; "Qed" ;
+	 "Require" ; "Save" ; "Scheme" ;
+	 "Section" ; "Unset" ;
+	 "Set" ; "Notation"
+      ];
+    Hashtbl.mem h
+
+  let is_declaration =
+    let h = Hashtbl.create 97 in
+    List.iter (fun s -> Hashtbl.add h s ())
+      [ "Lemma" ; "Axiom" ; "CoFixpoint" ; "Definition"  ;
+	"Fixpoint" ; "Hypothesis" ; 
+	"Hypotheses" ; "Axioms" ; "Parameters" ; "Subclass" ;
+	"Remark" ; "Fact" ; "Conjecture" ; "Let" ;
+	"CoInductive" ; "Record" ; "Structure" ;
+	"Inductive" ; "Parameter" ; "Theorem" ; 
+	"Variable" ; "Variables" 
+      ];
+    Hashtbl.mem h
+
 }
 
 let space = 
@@ -28,28 +55,22 @@ let identchar =
   ['$' 'A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9']
 let ident = firstchar identchar*
 
-let keyword = 
-  "Add" | "Defined" | 
-  "End" | "Export" | "Extraction" | "Hint" |
-  "Implicits" | "Import" | 
-  "Infix" | "Load" | "match" | "Module" | "Module Type" |
-  "Proof" | "Qed" |
-  "Require" | "Save" | "Scheme" |
-  "Section" | "Unset" |
-  "Set"  
-
 let declaration = 
   "Lemma" | "Axiom" | "CoFixpoint" | "Definition"  |
   "Fixpoint" | "Hypothesis" | 
-  "Hypotheses" | "Axioms" | "Parameters" | "Subclass" |
-  "Remark" | "Fact" | "Conjecture" | "Let" |
-  "CoInductive" | "Record" | "Structure" |
   "Inductive" | "Parameter" | "Theorem" | 
-  "Variable" | "Variables" 
+  "Variable" | "Variables" | "Declare" space+ "Module"
 
 rule next_order = parse
-  | "(*" { comment_start := lexeme_start lexbuf; comment lexbuf }
-  | keyword { lexeme_start lexbuf,lexeme_end lexbuf, "kwd" }
+  | "(*" 
+      { comment_start := lexeme_start lexbuf; comment lexbuf }
+  | "Module Type"
+      { lexeme_start lexbuf,lexeme_end lexbuf, "kwd" }
+  | ident as id 
+      { if is_keyword id then 
+	  lexeme_start lexbuf,lexeme_end lexbuf, "kwd" 
+	else
+	  next_order lexbuf }
   | declaration space+ ident (space* ',' space* ident)* 
             { lexeme_start lexbuf, lexeme_end lexbuf, "decl" } 
   | _    { next_order lexbuf}
diff --git a/ide/ideutils.ml b/ide/ideutils.ml
index dc3bcf71..5143358a 100644
--- a/ide/ideutils.ml
+++ b/ide/ideutils.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ideutils.ml,v 1.30.2.4 2006/01/06 15:40:37 barras Exp $ *)
+(* $Id: ideutils.ml 7609 2005-11-25 17:14:39Z barras $ *)
 
 
 open Preferences
@@ -34,9 +34,9 @@ let prerr_string s =
 
 let lib_ide_file f =
   let coqlib =
-    if !Options.boot then Coq_config.coqtop
-    else
-      System.getenv_else "COQLIB" Coq_config.coqlib in
+    System.getenv_else "COQLIB"
+      (if Coq_config.local || !Options.boot then Coq_config.coqtop
+       else Coq_config.coqlib) in
   Filename.concat (Filename.concat coqlib "ide") f
   
 let get_insert input_buffer = input_buffer#get_iter_at_mark `INSERT
@@ -61,17 +61,6 @@ let byte_offset_to_char_offset s byte_offset =
     byte_offset - !count_delta
   end
 
-let process_pending () =
-  prerr_endline "Pending process";()
-(*  try 
-    while Glib.Main.pending () do 
-      ignore (Glib.Main.iteration false)
-    done
-  with e -> 
-    prerr_endline "Pending problems : expect a crash very soon";
-    raise e
-*)
-
 let print_id id =
   prerr_endline ("GOT sig id :"^(string_of_int (Obj.magic id)))
 
@@ -225,6 +214,25 @@ let async =
 let sync = 
   if Sys.os_type = "Win32" then GtkThread.sync else (fun x -> x)
 
+let mutex text f =
+  let m = Mutex.create() in
+  fun x ->
+    if Mutex.try_lock m
+    then 
+      (try
+        prerr_endline ("Got lock on "^text);
+        f x;
+        Mutex.unlock m;
+        prerr_endline ("Released lock on "^text)
+      with e ->
+        Mutex.unlock m;
+        prerr_endline ("Released lock on "^text^" (on error)");
+        raise e)
+    else
+      prerr_endline
+        ("Discarded call for "^text^": computations ongoing")
+
+
 let stock_to_widget ?(size=`DIALOG) s = 
   let img = GMisc.image () 
   in img#set_stock s;
@@ -235,7 +243,8 @@ let rec print_list print fmt = function
   | [x] -> print fmt x
   | x :: r -> print fmt x; print_list print fmt r
 
-
+(* TODO: allow to report output as soon as it comes (user-fiendlier
+   for long commands like make...) *)
 let run_command f c =
   let result = Buffer.create 127 in
   let cin,cout,cerr = Unix.open_process_full c (Unix.environment ()) in
diff --git a/ide/ideutils.mli b/ide/ideutils.mli
index cbdaefb9..3af80f47 100644
--- a/ide/ideutils.mli
+++ b/ide/ideutils.mli
@@ -6,10 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ideutils.mli,v 1.6.2.4 2005/11/25 17:18:28 barras Exp $ i*)
+(*i $Id: ideutils.mli 7608 2005-11-25 17:09:25Z barras $ i*)
 
 val async : ('a -> unit) -> 'a -> unit
 val sync  : ('a -> 'b) -> 'a -> 'b
+
+(* avoid running two instances of a function concurrently *)
+val mutex : string -> ('a -> unit) -> 'a -> unit
+
 val browse : (string -> unit) -> string -> unit
 val browse_keyword : (string -> unit) -> string -> unit
 val byte_offset_to_char_offset : string -> int -> int
@@ -32,7 +36,6 @@ val prerr_endline : string -> unit
 val prerr_string : string -> unit
 val print_id : 'a -> unit
 
-val process_pending : unit -> unit
 val read_stdout : unit -> string
 val revert_timer : GMain.Timeout.id option ref
 val auto_save_timer : GMain.Timeout.id option ref
diff --git a/ide/preferences.ml b/ide/preferences.ml
index 8743b99b..8629fe8e 100644
--- a/ide/preferences.ml
+++ b/ide/preferences.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: preferences.ml,v 1.27.2.2 2004/07/16 19:30:20 herbelin Exp $ *)
+(* $Id: preferences.ml 7046 2005-05-20 07:38:25Z herbelin $ *)
 
 open Configwin
 open Printf
@@ -123,10 +123,7 @@ let (current:pref ref) =
     modifiers_valid = [`SHIFT; `CONTROL; `MOD1; `MOD4];
 
     
-    cmd_browse = 
-	 if Sys.os_type = "Win32"
-	 then "C:\\PROGRA~1\\INTERN~1\\IEXPLORE ", ""
-	 else "netscape -remote \"OpenURL(", ")\"";
+    cmd_browse = Options.browser_cmd_fmt;
     cmd_editor = 
 	 if Sys.os_type = "Win32"
 	 then "NOTEPAD ", ""
@@ -269,6 +266,13 @@ let load_pref () =
     prerr_endline ("Could not load preferences ("^
 		   (Printexc.to_string e)^").")
     
+let split_string_format s =
+  try 
+    let i = Util.string_index_from s 0 "%s" in
+    let pre = (String.sub s 0 i) in
+    let post = String.sub s (i+2) (String.length s - i - 2) in
+    pre,post
+  with Not_found -> s,""
 
 let configure () = 
   let cmd_coqc = 
@@ -439,40 +443,14 @@ let configure () =
 
   let cmd_editor = 
     string
-      ~f:(fun s -> 
-	    !current.cmd_editor <- 
-	    try 
-	      let i = String.index s '%' in
-	      let pre = (String.sub s 0 i) in
-	      if String.length s - 1 = i then 
-		pre,""
-	      else
-		let post = String.sub s (i+2) (String.length s - i - 2) in
-		prerr_endline pre;
-		prerr_endline post;
-		pre,post
-	    with Not_found -> s,""
-	    )
+      ~f:(fun s -> !current.cmd_editor <- split_string_format s)
       ~help:"(%s for file name)" 
       "External editor"
       ((fst !current.cmd_editor)^"%s"^(snd !current.cmd_editor))
   in    
   let cmd_browse = 
     string
-      ~f:(fun s -> 
-	    !current.cmd_browse <- 
-	    try 
-	      let i = String.index s '%' in
-	      let pre = (String.sub s 0 i) in
-	      if String.length s - 1 = i then 
-		pre,""
-	      else
-		let post = String.sub s (i+2) (String.length s - i - 2) in
-		prerr_endline pre;
-		prerr_endline post;
-		pre,post
-	    with Not_found -> s,""
-	    )
+      ~f:(fun s -> !current.cmd_browse <- split_string_format s)
       ~help:"(%s for url)" 
       "    Browser"
       ((fst !current.cmd_browse)^"%s"^(snd !current.cmd_browse))
diff --git a/ide/preferences.mli b/ide/preferences.mli
index 048707a3..25535aa4 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,v 1.8.2.2 2005/01/21 17:21:33 herbelin Exp $ i*)
+(*i $Id: preferences.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 type pref =
     {
diff --git a/ide/undo.ml b/ide/undo.ml
index 6f740667..f617d289 100644
--- a/ide/undo.ml
+++ b/ide/undo.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: undo.ml,v 1.8.2.2 2005/11/16 17:22:39 barras Exp $ *)
+(* $Id: undo.ml 7603 2005-11-23 17:21:53Z barras $ *)
 
 open GText
 open Ideutils
@@ -71,7 +71,6 @@ object(self)
 	      (self#buffer#insert_interactive ~iter s) or
 	      (Stack.push act history; false)
       in if r then begin
-	process_pending ();
 	let act = Stack.pop history in
 	Queue.push act redo;
 	Stack.push act nredo
@@ -107,8 +106,8 @@ object(self)
 		   Queue.iter (fun e -> Stack.push e history) redo;
 		   Queue.clear redo;
 		 end;
-		 let pos = it#offset in
-(*		 if Stack.is_empty history or 
+(*		 let pos = it#offset in
+		 if Stack.is_empty history or 
 		   s=" " or s="\t" or s="\n" or
 					(match Stack.top history with 
 					   | Insert(old,opos,olen) -> 
diff --git a/ide/undo_lablgtk_ge26.mli b/ide/undo_lablgtk_ge26.mli
index d81d08d5..b87f6559 100644
--- a/ide/undo_lablgtk_ge26.mli
+++ b/ide/undo_lablgtk_ge26.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: undo_lablgtk_ge26.mli,v 1.1.2.1 2005/11/18 16:37:28 herbelin Exp $ i*)
+(*i $Id: undo_lablgtk_ge26.mli 7580 2005-11-18 17:09:10Z herbelin $ i*)
 
 (* An undoable view class *)
 
diff --git a/ide/undo_lablgtk_lt26.mli b/ide/undo_lablgtk_lt26.mli
index 9c2176b0..ddee31d2 100644
--- a/ide/undo_lablgtk_lt26.mli
+++ b/ide/undo_lablgtk_lt26.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: undo_lablgtk_lt26.mli,v 1.1.2.1 2005/11/18 16:37:28 herbelin Exp $ i*)
+(*i $Id: undo_lablgtk_lt26.mli 7580 2005-11-18 17:09:10Z herbelin $ i*)
 
 (* An undoable view class *)
 
diff --git a/ide/utf8_convert.mll b/ide/utf8_convert.mll
index 4c88adc5..7e6484e1 100644
--- a/ide/utf8_convert.mll
+++ b/ide/utf8_convert.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: utf8_convert.mll,v 1.1.2.1 2004/07/16 19:30:21 herbelin Exp $ *)
+(* $Id: utf8_convert.mll 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 {
   open Lexing 
diff --git a/ide/utils/config_file.ml b/ide/utils/config_file.ml
new file mode 100644
index 00000000..30eb0111
--- /dev/null
+++ b/ide/utils/config_file.ml
@@ -0,0 +1,642 @@
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
+
+(* $Id: config_file.ml 8618 2006-03-08 11:44:47Z notin $ *)
+
+(* TODO *)
+(* section comments *)
+(* better obsoletes: no "{}", line cuts *)
+
+(* possible improvements: *)
+(* use lex/yacc instead of genlex to be more robust, efficient, allow arrays and other types, read comments. *)
+(* description and help, level (beginner/advanced/...) for each cp *)
+(* find an option from its name and group *)
+(* class hooks *)
+(* get the sections of a group / of a file *)
+(* read file format from inifiles and ConfigParser *)
+
+
+(* Read the mli before reading this file! *)
+
+
+(* ******************************************************************************** *)
+(* ******************************** misc utilities ******************************** *)
+(* ******************************************************************************** *)
+(* This code is intended to be usable without any dependencies. *)
+
+(* pipeline style, see for instance Raw.of_channel. *)
+let (|>) x f  = f x
+
+(* as List.assoc, but applies f to the element matching [key] and returns the list
+where this element has been replaced by the result of f. *)
+let rec list_assoc_remove key f = function
+  | [] -> raise Not_found
+  | (key',value) as elt :: tail ->
+      if key <> key'
+      then elt :: list_assoc_remove key f tail
+      else match f value with
+        | None -> tail
+        | Some a -> (key',a) :: tail
+
+(* reminiscent of String.concat. Same as [Queue.iter f1 queue]
+   but calls [f2 ()] between each calls to f1.
+   Does not call f2 before the first call nor after the last call to f2.
+   Could be more efficient with a richer module interface of Queue.
+*)
+let queue_iter_between f1 f2 queue =
+(*   let f flag elt = if flag then f2 (); (f1 elt:unit); true in *)
+  let f flag elt = if flag then f2 (); f1 elt; true in
+  ignore (Queue.fold f false queue)
+
+let list_iter_between f1 f2 = function
+    [] -> ()
+  | a::[] -> f1 a
+  | a::tail -> f1 a; List.iter (fun elt -> (f2 ():unit); f1 elt) tail
+(*   | a::tail -> f1 a; List.iter (fun elt -> f2 (); f1 elt) tail *)
+(* !! types ??? *)
+
+(* to ensure that strings will be parsed correctly by Genlex.
+It's more comfortable not to have quotes around the string, but sometimes it's necessary. *)
+exception Unsafe_string
+let safe_string s =
+  if s = ""
+  then "\"\""
+  else if (
+    try match s.[0] with
+      | 'a'..'z' | 'A'..'Z' ->
+          for i = 1 to String.length s - 1 do
+            match s.[i] with
+                'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> ()
+              | _ -> raise Unsafe_string
+          done;
+        false
+      | _ ->
+          try
+            string_of_int (int_of_string s) <> s ||
+            string_of_float (float_of_string s) <> s
+          with Failure "int_of_string" | Failure "float_of_string" -> true
+    with Unsafe_string -> true)
+  then Printf.sprintf "\"%s\"" (String.escaped s)
+  else s
+
+
+(* ******************************************************************************** *)
+(* ************************************* core ************************************* *)
+(* ******************************************************************************** *)
+
+module Raw = struct
+  type cp =
+    | String of string
+    | Int of int
+    | Float of float
+    | List of cp list
+    | Tuple of cp list
+    | Section of (string * cp) list
+
+(* code generated by
+camlp4 pa_o.cmo pa_op.cmo pr_o.cmo -- -o config_file_parser.ml -impl config_file_parser.ml4
+Unreadable on purpose, edit the file config_file_parser.ml4 rather than editing this (huge) lines. Then manually copy-paste here the content of config_file_parser.ml.
+Could be one day rewritten with ocamllex/yacc to be more robust, efficient, allow arrays, read comments...*)
+  module Parse = struct
+    let lexer = Genlex.make_lexer ["="; "{"; "}"; "["; "]"; ";"; "("; ")"; ","]
+    let rec file l (strm__ : _ Stream.t) = match try Some (ident strm__) with Stream.Failure -> None with Some id -> begin match Stream.peek strm__ with Some (Genlex.Kwd "=") -> Stream.junk strm__; let v = try value strm__ with Stream.Failure -> raise (Stream.Error "") in begin try file ((id, v) :: l) strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> raise (Stream.Error "") end | _ -> List.rev l
+    and value (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Kwd "{") -> Stream.junk strm__; let v = try file [] strm__ with Stream.Failure -> raise (Stream.Error "") in begin match Stream.peek strm__ with Some (Genlex.Kwd "}") -> Stream.junk strm__; Section v | _ -> raise (Stream.Error "") end | Some (Genlex.Ident s) -> Stream.junk strm__; String s | Some (Genlex.String s) -> Stream.junk strm__; String s | Some (Genlex.Int i) -> Stream.junk strm__; Int i | Some (Genlex.Float f) -> Stream.junk strm__; Float f | Some (Genlex.Char c) -> Stream.junk strm__; String (String.make 1 c) | Some (Genlex.Kwd "[") -> Stream.junk strm__; let v = try list [] strm__ with Stream.Failure -> raise (Stream.Error "") in List v | Some (Genlex.Kwd "(") -> Stream.junk strm__; let v = try list [] strm__ with Stream.Failure -> raise (Stream.Error "") in Tuple v | _ -> raise Stream.Failure
+    and ident (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Ident s) -> Stream.junk strm__; s | Some (Genlex.String s) -> Stream.junk strm__; s | _ -> raise Stream.Failure
+    and list l (strm__ : _ Stream.t) = match Stream.peek strm__ with Some (Genlex.Kwd ";") -> Stream.junk strm__; begin try list l strm__ with Stream.Failure -> raise (Stream.Error "") end | Some (Genlex.Kwd ",") -> Stream.junk strm__; begin try list l strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> match try Some (value strm__) with Stream.Failure -> None with Some v -> begin try list (v :: l) strm__ with Stream.Failure -> raise (Stream.Error "") end | _ -> match Stream.peek strm__ with Some (Genlex.Kwd "]") -> Stream.junk strm__; List.rev l | Some (Genlex.Kwd ")") -> Stream.junk strm__; List.rev l | _ -> raise Stream.Failure
+  end
+
+  open Format
+  (* formating convention: the caller has to open the box, close it and flush the output *)
+  (* remarks on Format:
+     set_margin impose un appel à set_max_indent
+     sprintf et bprintf sont flushées à chaque appel*)
+
+  (* pretty print a Raw.cp *)
+  let rec save formatter = function
+    | String s -> fprintf formatter "%s" (safe_string s) (* How can I cut lines and *)
+    | Int i -> fprintf formatter "%d" i             (* print backslashes just before the \n? *)
+    | Float f -> fprintf formatter "%g" f
+    | List l ->
+        fprintf formatter "[@[<b0>";
+        list_iter_between
+          (fun v -> fprintf formatter "@[<b2>"; save formatter v; fprintf formatter "@]")
+          (fun () -> fprintf formatter ";@ ")
+          l;
+        fprintf formatter "@]]"
+    | Tuple l ->
+        fprintf formatter "(@[<b0>";
+        list_iter_between
+          (fun v -> fprintf formatter "@[<b2>"; save formatter v; fprintf formatter "@]")
+          (fun () -> fprintf formatter ",@ ")
+          l;
+        fprintf formatter "@])"
+    | Section l ->
+        fprintf formatter "{@;<0 2>@[<hv0>";
+        list_iter_between
+          (fun (name,value) ->
+             fprintf formatter "@[<hov2>%s =@ @[<b2>" name;
+             save formatter value;
+             fprintf formatter "@]@]";)
+          (fun () -> fprintf formatter "@;<2 0>")
+          l;
+        fprintf formatter "@]}"
+
+(*   let to_string r = save str_formatter r; flush_str_formatter () *)
+  let to_channel out_channel r =
+    let f = formatter_of_out_channel out_channel in
+    fprintf f "@[<b2>"; save f r; fprintf f "@]@?"
+
+  let of_string s = s |> Stream.of_string |> Parse.lexer |> Parse.value
+
+  let of_channel in_channel =
+    let result = in_channel |> Stream.of_channel |> Parse.lexer |> Parse.file [] in
+    close_in in_channel;
+    result
+end
+
+(* print the given string in a way compatible with Format.
+   Truncate the lines when needed, indent the newlines.*)
+let print_help formatter =
+  String.iter (function
+   | ' ' -> Format.pp_print_space formatter ()
+   | '\n' -> Format.pp_force_newline formatter ()
+   | c -> Format.pp_print_char formatter c)
+
+type 'a wrappers = {
+ to_raw : 'a -> Raw.cp;
+ of_raw : Raw.cp -> 'a}
+
+class type ['a] cp = object
+(*   method private to_raw = wrappers.to_raw *)
+(*   method private of_raw = wrappers.of_raw *)
+(*   method private set_string s = s |> Raw.of_string |> self#of_raw |> self#set *)
+  method add_hook : ('a -> 'a -> unit) -> unit
+  method get : 'a
+  method get_default : 'a
+  method set : 'a -> unit
+  method reset : unit
+
+  method get_formatted : Format.formatter -> unit
+  method get_default_formatted : Format.formatter -> unit
+  method get_help_formatted : Format.formatter -> unit
+
+  method get_name : string list
+  method get_short_name : string option
+  method set_short_name : string -> unit
+  method get_help : string
+  method get_spec : Arg.spec
+
+  method set_raw : Raw.cp -> unit
+end
+
+type groupable_cp = <
+  get_name : string list;
+  get_short_name : string option;
+  get_help : string;
+
+  get_formatted : Format.formatter -> unit;
+  get_default_formatted : Format.formatter -> unit;
+  get_help_formatted : Format.formatter -> unit;
+  get_spec : Arg.spec;
+
+  reset : unit;
+  set_raw : Raw.cp -> unit; >
+
+exception Double_name
+exception Missing_cp of groupable_cp
+exception Wrong_type of (out_channel -> unit)
+
+(* Two exceptions to stop the iteration on queues. *)
+exception Found
+exception Found_cp of groupable_cp
+
+(* The data structure to store the cps.
+It's a tree, each node is a section, and a queue of sons with their name.
+Each leaf contains a cp. *)
+type 'a nametree =
+  | Immediate of 'a
+  | Subsection of ((string * 'a nametree) Queue.t)
+      (* this Queue must be nonempty for group.read.choose *)
+
+class group = object (self)
+  val mutable cps = Queue.create () (* hold all the added cps, in a nametree. *)
+
+  method add : 'a. 'a cp -> unit = fun original_cp ->
+    let cp = (original_cp :> groupable_cp) in
+    (* function called when we reach the end of the list cp#get_name. *)
+    let add_immediate name cp queue =
+      Queue.iter (fun (name',_) -> if name = name' then raise Double_name) queue;
+      Queue.push (name, Immediate cp) queue in
+    (* adds the cp with name [first_name::last_name] in section [section]. *)
+    let rec add_in_section section first_name last_name cp queue =
+      let sub_add = match last_name with (* what to do once we have find the correct section *)
+        | [] -> add_immediate first_name
+        | middle_name :: last_name -> add_in_section first_name middle_name last_name in
+      try
+        Queue.iter
+          (function
+             | name, Subsection subsection when name = section ->
+                 sub_add cp subsection; raise Found
+             | _ -> ())
+          queue;
+        let sub_queue = Queue.create () in
+        sub_add cp sub_queue;
+        Queue.push (section, Subsection sub_queue) queue
+      with Found -> () in
+    (match cp#get_name with
+      | [] -> failwith "empty name"
+      | first_name :: [] -> add_immediate first_name cp cps
+      | first_name :: middle_name :: last_name ->
+          add_in_section first_name middle_name last_name cp cps)
+
+  method write ?(with_help=true) filename =
+    let out_channel = open_out filename in
+    let formatter = Format.formatter_of_out_channel out_channel in
+    let print = Format.fprintf formatter in
+    print "@[<v>";
+    let rec save_queue formatter =
+      queue_iter_between
+        (fun (name,nametree) -> save_nametree name nametree)
+        (Format.pp_print_cut formatter)
+    and save_nametree name = function
+      | Immediate cp ->
+          if with_help && cp#get_help <> "" then
+            (print "@[<hov3>(* "; cp#get_help_formatted formatter;
+             print "@ *)@]@,");
+          Format.fprintf formatter "@[<hov2>%s =@ @[<b2>" (safe_string name);
+          cp#get_formatted formatter;
+          print "@]@]"
+      | Subsection queue ->
+          Format.fprintf formatter "%s = {@;<0 2>@[<v>" (safe_string name);
+          save_queue formatter queue;
+          print "@]@,}" in
+    save_queue formatter cps;
+    print "@]@."; close_out out_channel
+
+  method read ?obsoletes ?(no_default=false)
+      ?(on_type_error = fun groupable_cp raw_cp output filename in_channel ->
+          close_in in_channel;
+          Printf.eprintf
+            "Type error while loading configuration parameter %s from file %s.\n%!"
+            (String.concat "." groupable_cp#get_name) filename;
+          output stderr;
+          exit 1)
+      filename =
+    (* [filename] is created if it doesn't exist. In this case there is no need to read it. *)
+    match Sys.file_exists filename with false -> self#write filename | true ->
+    let in_channel = open_in filename in
+    (* what to do when a cp is missing: *)
+    let missing cp default = if no_default then raise (Missing_cp cp) else default in
+    (* returns a cp contained in the nametree queue, which must be nonempty *)
+    let choose queue =
+      let rec iter q = Queue.iter (function
+        | _, Immediate cp -> raise (Found_cp cp)
+        | _, Subsection q -> iter q) q in
+      try iter queue; failwith "choose" with Found_cp cp -> cp in
+    (* [set_and_remove raw_cps nametree] sets the cp of [nametree] to their value
+       defined in [raw_cps] and returns the remaining raw_cps. *)
+    let set_cp cp value =
+      try cp#set_raw value
+      with Wrong_type output -> on_type_error cp value output filename in_channel in
+    let rec set_and_remove raw_cps = function
+      | name, Immediate cp ->
+          (try list_assoc_remove name (fun value -> set_cp cp value; None) raw_cps
+           with Not_found -> missing cp raw_cps)
+      | name, Subsection queue ->
+          (try list_assoc_remove name
+             (function
+                | Raw.Section l ->
+                    (match remainings l queue with
+                       | [] -> None
+                       | l -> Some (Raw.Section l))
+                | r -> missing (choose queue) (Some r))
+             raw_cps
+           with Not_found -> missing (choose queue) raw_cps)
+    and remainings raw_cps queue = Queue.fold set_and_remove raw_cps queue in
+    let remainings = remainings (Raw.of_channel in_channel) cps in
+    (* Handling of cps defined in filename but not belonging to self. *)
+    if remainings <> [] then match obsoletes with
+      | Some filename ->
+          let out_channel =
+            open_out filename in
+(*             open_out_gen [Open_wronly; Open_creat; Open_append; Open_text] 0o666 filename in *)
+          let formatter = Format.formatter_of_out_channel out_channel in
+          Format.fprintf formatter "@[<v>";
+          Raw.save formatter (Raw.Section remainings);
+          Format.fprintf formatter "@]@.";
+          close_out out_channel
+      | None -> ()
+
+  method command_line_args ~section_separator =
+    let print = Format.fprintf Format.str_formatter in (* shortcut *)
+    let result = ref [] in let push x = result := x :: !result in
+    let rec iter = function
+      | _, Immediate cp ->
+          let key = "-" ^ String.concat section_separator cp#get_name in
+          let spec = cp#get_spec in
+          let doc = (
+            print "@[<hv5>";
+            Format.pp_print_as Format.str_formatter (String.length key +3) "";
+            if cp#get_help <> ""
+            then (print "@,@[<b2>"; cp#get_help_formatted Format.str_formatter; print "@]@ ")
+            else print "@,";
+            print "@[<hv>@[current:@;<1 2>@[<hov1>"; cp#get_formatted Format.str_formatter;
+            print "@]@],@ @[default:@;<1 2>@[<b2>"; cp#get_default_formatted Format.str_formatter;
+            print "@]@]@]@]";
+            Format.flush_str_formatter ()) in
+          (match cp#get_short_name with
+            | None -> ()
+            | Some short_name -> push ("-" ^ short_name,spec,""));
+          push (key,spec,doc)
+      | _, Subsection queue -> Queue.iter iter queue in
+    Queue.iter iter cps;
+    List.rev !result
+end
+
+
+(* Given wrappers for the type 'a, cp_custom_type defines a class 'a cp. *)
+class ['a] cp_custom_type wrappers
+  ?group:(group:group option) name ?short_name default help =
+object (self)
+  method private to_raw = wrappers.to_raw
+  method private of_raw = wrappers.of_raw
+
+  val mutable value = default
+    (* output *)
+  method get = value
+  method get_default = default
+  method get_formatted formatter = self#get |> self#to_raw |> Raw.save formatter
+  method get_default_formatted formatter = self#get_default |> self#to_raw |> Raw.save formatter
+    (* input *)
+  method set v = let v' = value in value <- v; self#exec_hooks v' v
+  method set_raw v = self#of_raw v |> self#set
+  method private set_string s = s |> Raw.of_string |> self#of_raw |> self#set
+  method reset = self#set self#get_default
+
+  (* name *)
+  val mutable shortname = short_name
+  method get_name = name
+  method get_short_name = shortname
+  method set_short_name s = shortname <- Some s
+
+  (* help *)
+  method get_help = help
+  method get_help_formatted formatter = print_help formatter self#get_help
+  method get_spec = Arg.String self#set_string
+
+  (* hooks *)
+  val mutable hooks = []
+  method add_hook f = hooks <- (f:'a->'a->unit) :: hooks
+  method private exec_hooks v' v = List.iter (fun f -> f v' v) hooks
+
+  initializer match group with Some g -> g#add (self :> 'a cp) | None -> ()
+end
+
+
+(* ******************************************************************************** *)
+(* ****************************** predefined classes ****************************** *)
+(* ******************************************************************************** *)
+
+let int_wrappers = {
+  to_raw = (fun v -> Raw.Int v);
+  of_raw = function
+    | Raw.Int v -> v
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.Int expected, got %a\n%!" Raw.to_channel r))}
+class int_cp ?group name ?short_name default help = object (self)
+  inherit [int] cp_custom_type int_wrappers ?group name ?short_name default help
+  method get_spec = Arg.Int self#set
+end
+
+let float_wrappers = {
+  to_raw = (fun v -> Raw.Float v);
+  of_raw = function
+    | Raw.Float v -> v
+    | Raw.Int v -> float v
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.Float expected, got %a\n%!" Raw.to_channel r))
+}
+class float_cp ?group name ?short_name default help = object (self)
+  inherit [float] cp_custom_type float_wrappers ?group name ?short_name default help
+  method get_spec = Arg.Float self#set
+end
+
+(* The Pervasives version is too restrictive *)
+let bool_of_string s =
+  match String.lowercase s with
+    | "false" | "no" | "n" | "0" -> false (* "0" and "1" aren't used. *)
+    | "true" | "yes" | "y" | "1" -> true
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.Bool expected, got %s\n%!" r))
+let bool_wrappers = {
+  to_raw = (fun v -> Raw.String (string_of_bool v));
+  of_raw = function
+    | Raw.String v -> bool_of_string v
+    | Raw.Int v -> v <> 0
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.Bool expected, got %a\n%!" Raw.to_channel r))
+}
+class bool_cp ?group name ?short_name default help = object (self)
+  inherit [bool] cp_custom_type bool_wrappers ?group name ?short_name default help
+  method get_spec = Arg.Bool self#set
+end
+
+let string_wrappers = {
+  to_raw = (fun v -> Raw.String v);
+  of_raw = function
+    | Raw.String v -> v
+    | Raw.Int v -> string_of_int v
+    | Raw.Float v -> string_of_float v
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.String expected, got %a\n%!" Raw.to_channel r))
+}
+class string_cp ?group name ?short_name default help = object (self)
+  inherit [string] cp_custom_type string_wrappers ?group name ?short_name default help
+  method private of_string s = s
+  method get_spec = Arg.String self#set
+end
+
+let list_wrappers wrappers = {
+  to_raw = (fun l -> Raw.List (List.map wrappers.to_raw l));
+  of_raw = function
+    | Raw.List l -> List.map wrappers.of_raw l
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.List expected, got %a\n%!" Raw.to_channel r))
+}
+class ['a] list_cp wrappers = ['a list] cp_custom_type (list_wrappers wrappers)
+
+let option_wrappers wrappers = {
+  to_raw = (function
+    | Some v -> wrappers.to_raw v
+    | None -> Raw.String "");
+  of_raw = function
+    | Raw.String s as v -> (
+        if s = "" || s = "None" then None
+        else if String.length s >= 5 && String.sub s 0 5 = "Some "
+        then Some (wrappers.of_raw (Raw.String (String.sub s 5 (String.length s -5))))
+        else Some (wrappers.of_raw v))
+    | r -> Some (wrappers.of_raw r)}
+class ['a] option_cp wrappers = ['a option] cp_custom_type (option_wrappers wrappers)
+
+let enumeration_wrappers enum =
+  let switched = List.map (fun (string,cons) -> cons,string) enum in
+  {to_raw = (fun v -> Raw.String (List.assq v switched));
+   of_raw = function
+     | Raw.String s ->
+         (try List.assoc s enum
+          with Not_found -> failwith (Printf.sprintf "%s isn't a known constructor" s))
+     | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw enumeration expected, got %a\n%!" Raw.to_channel r))
+}
+class ['a] enumeration_cp enum ?group name ?short_name default help = object (self)
+  inherit ['a] cp_custom_type (enumeration_wrappers enum)
+    ?group name ?short_name default help
+  method get_spec = Arg.Symbol (List.map fst enum, (fun s -> self#set (List.assoc s enum)))
+end
+
+let tuple2_wrappers wrapa wrapb = {
+  to_raw = (fun (a,b) -> Raw.Tuple [wrapa.to_raw a; wrapb.to_raw b]);
+  of_raw = function
+    | Raw.Tuple [a;b] -> wrapa.of_raw a, wrapb.of_raw b
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.Tuple 2 expected, got %a\n%!" Raw.to_channel r))
+}
+class ['a, 'b] tuple2_cp wrapa wrapb = ['a*'b] cp_custom_type (tuple2_wrappers wrapa wrapb)
+
+let tuple3_wrappers wrapa wrapb wrapc = {
+  to_raw = (fun (a,b,c) -> Raw.Tuple[wrapa.to_raw a; wrapb.to_raw b; wrapc.to_raw c]);
+  of_raw = function
+    | Raw.Tuple [a;b;c] -> wrapa.of_raw a, wrapb.of_raw b, wrapc.of_raw c
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.Tuple 3 expected, got %a\n%!" Raw.to_channel r))
+}
+class ['a,'b,'c] tuple3_cp wrapa wrapb wrapc =
+  ['a*'b*'c] cp_custom_type (tuple3_wrappers wrapa wrapb wrapc)
+
+let tuple4_wrappers wrapa wrapb wrapc wrapd = {
+  to_raw=(fun (a,b,c,d)->Raw.Tuple[wrapa.to_raw a;wrapb.to_raw b;wrapc.to_raw c;wrapd.to_raw d]);
+  of_raw = function
+    | Raw.Tuple [a;b;c;d] -> wrapa.of_raw a, wrapb.of_raw b, wrapc.of_raw c, wrapd.of_raw d
+    | r -> raise (Wrong_type (fun outchan -> Printf.fprintf outchan
+                                "Raw.Tuple 4 expected, got %a\n%!" Raw.to_channel r))
+}
+class ['a,'b,'c,'d] tuple4_cp wrapa wrapb wrapc wrapd =
+  ['a*'b*'c*'d] cp_custom_type (tuple4_wrappers wrapa wrapb wrapc wrapd)
+
+class string2_cp = [string,string] tuple2_cp string_wrappers string_wrappers
+(* class color_cp = string_cp *)
+class font_cp = string_cp
+class filename_cp = string_cp
+
+
+(* ******************************************************************************** *)
+(******************** Backward compatibility with module Options ****************** *)
+(* ******************************************************************************** *)
+
+type 'a option_class = 'a wrappers
+type 'a option_record = 'a cp
+type options_file = {mutable filename:string; group:group}
+
+let create_options_file filename = {filename = filename; group = new group}
+let set_options_file options_file filename = options_file.filename <- filename
+let load {filename=f; group = g} = g#read f
+let append {group=g} filename = g#read filename
+let save {filename=f; group = g} = g#write ~with_help:false f
+let save_with_help {filename=f; group = g} = g#write ~with_help:true f
+let define_option {group=group} name help option_class default =
+  (new cp_custom_type option_class ~group name default help)
+let option_hook cp f = cp#add_hook (fun _ _ -> f ())
+
+let  string_option = string_wrappers
+let   color_option = string_wrappers
+let    font_option = string_wrappers
+let     int_option =    int_wrappers
+let    bool_option =   bool_wrappers
+let   float_option =  float_wrappers
+let string2_option = tuple2_wrappers string_wrappers string_wrappers
+
+let option_option = option_wrappers
+let list_option = list_wrappers
+let sum_option = enumeration_wrappers
+let tuple2_option (a,b) = tuple2_wrappers a b
+let tuple3_option (a,b,c) = tuple3_wrappers a b c
+let tuple4_option (a,b,c,d) = tuple4_wrappers a b c d
+
+let ( !! ) cp = cp#get
+let ( =:= ) cp value = cp#set value
+
+let shortname cp = String.concat ":" cp#get_name
+let get_help cp = cp#get_help
+
+type option_value =
+  Module of option_module
+| StringValue of  string
+| IntValue of int
+| FloatValue of float
+| List of option_value list
+| SmallList of option_value list
+and option_module = (string * option_value) list
+
+let rec value_to_raw = function
+  | Module a -> Raw.Section (List.map (fun (name,value) -> name, value_to_raw value) a)
+  | StringValue a -> Raw.String a
+  | IntValue a -> Raw.Int a
+  | FloatValue a -> Raw.Float a
+  | List a -> Raw.List (List.map value_to_raw a)
+  | SmallList a -> Raw.Tuple (List.map value_to_raw a)
+let rec raw_to_value = function
+  | Raw.String a -> StringValue a
+  | Raw.Int a -> IntValue a
+  | Raw.Float a -> FloatValue a
+  | Raw.List a -> List (List.map raw_to_value a)
+  | Raw.Tuple a -> SmallList (List.map raw_to_value a)
+  | Raw.Section a -> Module (List.map (fun (name,value) -> name, raw_to_value value) a)
+
+let define_option_class _ of_option_value to_option_value =
+  {to_raw = (fun a -> a |> to_option_value |> value_to_raw);
+   of_raw = (fun a -> a |> raw_to_value |> of_option_value)}
+
+let to_value {to_raw = to_raw} a = a |> to_raw |> raw_to_value
+let from_value {of_raw = of_raw} a = a |> value_to_raw |> of_raw
+
+let of_value_w wrappers a = a |> value_to_raw |> wrappers.of_raw
+let to_value_w wrappers a = a |> wrappers.to_raw |> raw_to_value
+(* fancy indentation when finishing this stub code, not good style :-) *)
+let value_to_string : option_value -> string = of_value_w string_option
+let  string_to_value = to_value_w  string_option
+let value_to_int     = of_value_w     int_option
+let     int_to_value = to_value_w     int_option
+let value_to_bool    = of_value_w    bool_option
+let    bool_to_value = to_value_w    bool_option
+let value_to_float   = of_value_w   float_option
+let   float_to_value = to_value_w   float_option
+let value_to_string2 = of_value_w string2_option
+let string2_to_value = to_value_w string2_option
+let value_to_list of_value =
+  let wrapper = define_option_class "" of_value (fun _ -> failwith "value_to_list") in
+  of_value_w (list_option wrapper)
+let list_to_value to_value =
+  let wrapper = define_option_class "" (fun _ -> failwith "value_to_list") to_value in
+  to_value_w (list_option wrapper)
diff --git a/ide/utils/config_file.mli b/ide/utils/config_file.mli
new file mode 100644
index 00000000..b9c77682
--- /dev/null
+++ b/ide/utils/config_file.mli
@@ -0,0 +1,352 @@
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
+
+(**
+  This module implements a mechanism to handle configuration files.
+  A configuration file is defined as a set of [variable = value] lines,
+  where value can be
+    a simple string (types int, string, bool...),
+    a list of values between brackets (lists) or parentheses (tuples),
+    or a set of [variable = value] lines between braces.
+  The configuration file is automatically loaded and saved,
+  and configuration parameters are manipulated inside the program as easily as references.
+
+  Object implementation by Jean-Baptiste Rouquier.
+*)
+
+(** {1:lowlevelinterface Low level interface} *)
+(** Skip this section on a first reading... *)
+
+(** The type of cp freshly parsed from configuration file,
+not yet wrapped in their proper type. *)
+module Raw : sig
+  type cp =
+    | String of string (** base types, reproducing the tokens of Genlex *)
+    | Int of int
+    | Float of float
+    | List of cp list (** compound types *)
+    | Tuple of cp list
+    | Section of (string * cp) list
+
+  (** A parser. *)
+  val of_string : string -> cp
+
+  (** Used to print the values into a log file for instance. *)
+  val to_channel : out_channel -> cp -> unit
+end
+
+(** A type used to specialize polymorphics classes and define new classes.
+  {!Config_file.predefinedwrappers} are provided.
+ *)
+type 'a wrappers = { to_raw : 'a -> Raw.cp; of_raw : Raw.cp -> 'a; }
+
+(** An exception raised by {!Config_file.cp.set_raw}
+  when the argument doesn't have a suitable {!Config_file.Raw.cp} type.
+  The function explains the problem and flush the output.*)
+exception Wrong_type of (out_channel -> unit)
+
+(* (\** {2 Miscellaneous functions} *\) *)
+
+(* val bool_of_string : string -> bool *)
+
+(** {1 High level interface} *)
+(** {2 The two main classes} *)
+
+(** A Configuration Parameter, in short cp, ie
+  a value we can store in and read from a configuration file. *)
+class type ['a] cp = object
+  (** {1 Accessing methods} *)
+
+  method get : 'a
+  method set : 'a -> unit
+  method get_default : 'a
+  method get_help : string
+  method get_name : string list
+
+  (** Resets to the default value. *)
+  method reset : unit
+
+  (** {1 Miscellaneous} *)
+
+  (** All the hooks are executed each time the method set is called,
+    just after setting the new value.*)
+  method add_hook : ('a -> 'a -> unit) -> unit
+
+  (** Used to generate command line arguments in {!Config_file.group.command_line_args} *)
+  method set_short_name : string -> unit
+
+  (** [None] if no optional short_name was provided during object creation
+    and [set_short_name] was never called.*)
+  method get_short_name : string option
+
+  (** {1 Methods for internal use} *)
+
+  method get_formatted : Format.formatter -> unit
+  method get_default_formatted : Format.formatter -> unit
+  method get_help_formatted : Format.formatter -> unit
+
+  method get_spec : Arg.spec
+  method set_raw : Raw.cp -> unit
+end
+
+(** Unification over all possible ['a cp]:
+  contains the main methods of ['a cp] except the methods using the type ['a].
+  A [group] manipulates only [groupable_cp] for homogeneity. *)
+type groupable_cp = <
+  get_name : string list;
+  get_short_name : string option;
+  get_help : string;
+
+  get_formatted : Format.formatter -> unit;
+  get_default_formatted : Format.formatter -> unit;
+  get_help_formatted : Format.formatter -> unit;
+  get_spec : Arg.spec;
+
+  reset : unit;
+  set_raw : Raw.cp -> unit; >
+
+(** Raised in case a name is already used.
+  See {!Config_file.group.add} *)
+exception Double_name
+
+(** An exception possibly raised if we want to check that
+  every cp is defined in a configuration file.
+  See {!Config_file.group.read}.
+*)
+exception Missing_cp of groupable_cp
+
+(** A group of cps, that can be loaded and saved,
+or used to generate command line arguments.
+
+The basic usage is to have only one group and one configuration file,
+but this mechanism allows to have more,
+for instance to have another smaller group for the options to pass on the command line.
+*)
+class group : object
+  (** Adds a cp to the group.
+    Note that the type ['a] must be lost
+    to allow cps of different types to belong to the same group.
+    @raise Double_name if [cp#get_name] is already used. *)
+(*     method add : 'a cp -> 'a cp *)
+    method add : 'a cp -> unit
+
+    (**[write filename] saves all the cps into the configuration file [filename].*)
+    method write : ?with_help:bool -> string -> unit
+
+    (** [read filename] reads [filename]
+      and stores the values it specifies into the cps belonging to this group.
+      The file is created (and not read) if it doesn't exists.
+      In the default behaviour, no warning is issued
+      if not all cps are updated or if some values of [filename] aren't used.
+
+      If [obsoletes] is specified,
+      then prints in this file all the values that are
+      in [filename] but not in this group.
+      Those cps are likely to be erroneous or obsolete.
+      Opens this file only if there is something to write in it.
+
+      If [no_default] is [true], then raises [Missing_cp foo] if
+      the cp [foo] isn't defined in [filename] but belongs to this group.
+
+      [on_type_error groupable_cp value output filename in_channel]
+      is called if the file doesn't give suitable value
+      (string instead of int for instance, or a string not belonging to the expected enumeration)
+      for the cp [groupable_cp].
+      [value] is the value read from the file,
+      [output] is the argument of {!Config_file.Wrong_type},
+      [filename] is the same argument as the one given to read,
+      and [in_channel] refers to [filename] to allow a function to close it if needed.
+      Default behaviour is to print an error message and call [exit 1].
+*)
+    method read : ?obsoletes:string -> ?no_default:bool ->
+      ?on_type_error : (groupable_cp -> Raw.cp -> (out_channel -> unit) ->
+                          string -> in_channel -> unit) ->
+      string -> unit
+
+    (** Interface with module Arg.
+      @param section_separator the string used to concatenate the name of a cp,
+      to get the command line option name.
+      ["-"] is a good default.
+      @return a list that can be used with [Arg.parse] and [Arg.usage].*)
+    method command_line_args : section_separator:string -> (string * Arg.spec * string) list
+  end
+
+(** {2 Predefined cp classes} *)
+
+(** The last three non-optional arguments are always
+  [name] (of type string list), [default_value] and [help] (of type string).
+
+  [name] is the path to the cp: [["section";"subsection"; ...; "foo"]].
+  It can consists of a single element but must not be empty.
+
+  [short_name] will be added a "-" and used in
+  {!Config_file.group.command_line_args}.
+
+  [group], if provided, adds the freshly defined option to it
+  (something like [initializer group#add self]).
+
+  [help] needs not contain newlines, it will be automatically truncated where needed.
+  It is mandatory but can be [""].
+*)
+
+class int_cp : ?group:group -> string list -> ?short_name:string -> int -> string -> [int] cp
+class float_cp : ?group:group -> string list -> ?short_name:string -> float -> string -> [float] cp
+class bool_cp : ?group:group -> string list -> ?short_name:string -> bool -> string -> [bool] cp
+class string_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> [string] cp
+class ['a] list_cp : 'a wrappers -> ?group:group -> string list -> ?short_name:string -> 'a list -> string -> ['a list] cp
+class ['a] option_cp : 'a wrappers -> ?group:group -> string list -> ?short_name:string -> 'a option -> string -> ['a option] cp
+class ['a] enumeration_cp : (string * 'a) list -> ?group:group -> string list -> ?short_name:string -> 'a -> string -> ['a] cp
+class ['a, 'b] tuple2_cp : 'a wrappers -> 'b wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b -> string -> ['a * 'b] cp
+class ['a, 'b, 'c] tuple3_cp : 'a wrappers -> 'b wrappers -> 'c wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b * 'c -> string -> ['a * 'b * 'c] cp
+class ['a, 'b, 'c, 'd] tuple4_cp : 'a wrappers -> 'b wrappers -> 'c wrappers -> 'd wrappers -> ?group:group -> string list -> ?short_name:string -> 'a * 'b * 'c * 'd -> string -> ['a * 'b * 'c * 'd] cp
+class string2_cp : ?group:group -> string list -> ?short_name:string -> string * string -> string -> [string, string] tuple2_cp
+(* class color_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp *)
+class font_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp
+class filename_cp : ?group:group -> string list -> ?short_name:string -> string -> string -> string_cp
+
+(** {2:predefinedwrappers Predefined wrappers} *)
+
+val int_wrappers : int wrappers
+val float_wrappers : float wrappers
+val bool_wrappers : bool wrappers
+val string_wrappers : string wrappers
+val list_wrappers : 'a wrappers -> 'a list wrappers
+val option_wrappers : 'a wrappers -> 'a option wrappers
+
+(** If you have a [type suit = Spades | Hearts | Diamond | Clubs], then
+{[enumeration_wrappers ["spades",Spades; "hearts",Hearts; "diamond",Diamond; "clubs",Clubs]]}
+will allow you to use cp of this type.
+For sum types with not only constant constructors,
+you will need to define your own cp class. *)
+val enumeration_wrappers : (string * 'a) list -> 'a wrappers
+val tuple2_wrappers : 'a wrappers -> 'b wrappers -> ('a * 'b) wrappers
+val tuple3_wrappers : 'a wrappers -> 'b wrappers -> 'c wrappers -> ('a * 'b * 'c) wrappers
+val tuple4_wrappers : 'a wrappers -> 'b wrappers -> 'c wrappers -> 'd wrappers -> ('a * 'b * 'c * 'd) wrappers
+
+(** {2 Defining new cp classes} *)
+
+(** To define a new cp class, you just have to provide an implementation for the wrappers
+between your type [foo] and the type [Raw.cp].
+Once you have your wrappers [w], write
+{[class foo_cp = [foo] cp_custom_type w]}
+
+For further details, have a look at the commented .ml file,
+section "predefined cp classes".
+*)
+class ['a] cp_custom_type : 'a wrappers ->
+  ?group:group -> string list -> ?short_name:string -> 'a -> string -> ['a] cp
+
+
+(** {1 Backward compatibility}
+
+Deprecated.
+
+All the functions from the module Options are available, except:
+
+- [prune_file]: use [group#write ?obsoletes:"foo.ml"].
+- [smalllist_to_value], [smalllist_option]: use lists or tuples.
+- [get_class].
+- [class_hook]: hooks are local to a cp.
+  If you want hooks global to a class,
+  define a new class that inherit from {!Config_file.cp_custom_type}.
+- [set_simple_option], [get_simple_option], [simple_options], [simple_args]:
+  use {!Config_file.group.write}.
+- [set_option_hook]: use {!Config_file.cp.add_hook}.
+- [set_string_wrappers]: define a new class with {!Config_file.cp_custom_type}.
+
+The old configurations files are readable by this module.
+*)
+
+
+
+
+
+(**/**)
+type 'a option_class
+type 'a option_record
+type options_file
+
+val create_options_file : string -> options_file
+val set_options_file : options_file -> string -> unit
+val load : options_file -> unit
+val append : options_file -> string -> unit
+val save : options_file -> unit
+val save_with_help : options_file -> unit
+(* val define_option : options_file -> *)
+(*   string list ->  string -> 'a option_class -> 'a -> 'a option_record *)
+val option_hook : 'a option_record -> (unit -> unit) -> unit
+
+val string_option : string option_class
+val color_option : string option_class
+val font_option : string option_class
+val int_option : int option_class
+val bool_option : bool option_class
+val float_option : float option_class
+val string2_option : (string * string) option_class
+
+val option_option : 'a option_class -> 'a option option_class
+val list_option : 'a option_class -> 'a list option_class
+val sum_option : (string * 'a) list -> 'a option_class
+val tuple2_option :
+  'a option_class * 'b option_class -> ('a * 'b) option_class
+val tuple3_option : 'a option_class * 'b option_class * 'c option_class ->
+  ('a * 'b * 'c) option_class
+val tuple4_option :
+    'a option_class * 'b option_class * 'c option_class * 'd option_class ->
+  ('a * 'b * 'c * 'd) option_class
+
+val ( !! ) : 'a option_record -> 'a
+val ( =:= ) : 'a option_record -> 'a -> unit
+val shortname : 'a option_record -> string
+val get_help : 'a option_record -> string
+
+type option_value =
+  Module of option_module
+| StringValue of  string
+| IntValue of int
+| FloatValue of float
+| List of option_value list
+| SmallList of option_value list
+and option_module = (string * option_value) list
+
+val define_option_class :
+  string -> (option_value -> 'a) -> ('a -> option_value) -> 'a option_class
+
+val to_value : 'a option_class -> 'a -> option_value
+val from_value : 'a option_class -> option_value -> 'a
+
+val value_to_string : option_value -> string
+val string_to_value : string -> option_value
+val value_to_int : option_value -> int
+val int_to_value : int -> option_value
+val bool_of_string : string -> bool
+val value_to_bool : option_value -> bool
+val bool_to_value : bool -> option_value
+val value_to_float : option_value -> float
+val float_to_value : float -> option_value
+val value_to_string2 : option_value -> string * string
+val string2_to_value : string * string -> option_value
+val value_to_list : (option_value -> 'a) -> option_value -> 'a list
+val list_to_value : ('a -> option_value) -> 'a list -> option_value
diff --git a/ide/utils/configwin.ml b/ide/utils/configwin.ml
index de6a7c57..275d8616 100644
--- a/ide/utils/configwin.ml
+++ b/ide/utils/configwin.ml
@@ -1,26 +1,27 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
 
 type parameter_kind = Configwin_types.parameter_kind
 
@@ -35,10 +36,16 @@ type return_button =
   | Return_ok
   | Return_cancel
 
-module KeyOption = Configwin_types.KeyOption
+let string_to_key = Configwin_types.string_to_key
+let key_to_string = Configwin_types.key_to_string
+let key_cp_wrapper = Configwin_types.key_cp_wrapper
+class key_cp = Configwin_types.key_cp
+
 
 let string = Configwin_ihm.string
+let custom_string = Configwin_ihm.custom_string
 let text = Configwin_ihm.text
+let custom_text = Configwin_ihm.custom_text
 let strings = Configwin_ihm.strings
 let list = Configwin_ihm.list
 let bool = Configwin_ihm.bool
@@ -53,20 +60,20 @@ let hotkey = Configwin_ihm.hotkey
 let modifiers = Configwin_ihm.modifiers
 let html = Configwin_ihm.html
 
-let edit 
+let edit
     ?(apply=(fun () -> ()))
-    title ?(width=400) ?(height=400) 
-    conf_struct_list = 
+    title ?(width=400) ?(height=400)
+    conf_struct_list =
   Configwin_ihm.edit ~with_apply: true ~apply title ~width ~height conf_struct_list
 
 let get = Configwin_ihm.edit ~with_apply: false ~apply: (fun () -> ())
 
-let simple_edit 
+let simple_edit
     ?(apply=(fun () -> ()))
-    title ?width ?height 
+    title ?width ?height
     param_list = Configwin_ihm.simple_edit ~with_apply: true ~apply title ?width ?height param_list
 
-let simple_get = Configwin_ihm.simple_edit 
+let simple_get = Configwin_ihm.simple_edit
     ~with_apply: false ~apply: (fun () -> ())
 
 let box = Configwin_ihm.box
diff --git a/ide/utils/configwin.mli b/ide/utils/configwin.mli
index 078befc6..2d4dd4a7 100644
--- a/ide/utils/configwin.mli
+++ b/ide/utils/configwin.mli
@@ -1,26 +1,27 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
 
 (** This module is the interface of the Configwin library. *)
 
@@ -30,8 +31,8 @@
 type parameter_kind;;
 
 (** This type represents the structure of the configuration window. *)
-type configuration_structure = 
-  | Section of string * parameter_kind list 
+type configuration_structure =
+  | Section of string * parameter_kind list
        (** label of the section, parameters *)
   | Section_list of string * configuration_structure list
        (** label of the section, list of the sub sections *)
@@ -50,13 +51,20 @@ type return_button =
 	 on the apply button.*)
 
 
-(** {2 The key option class (to use with the {!Uoptions} library)} *)
+(** {2 The key option class (to use with the {!Config_file} library)} *)
 
-module KeyOption : sig
-  val string_to_key : string -> (Gdk.Tags.modifier list * int) 
-  val key_to_string : (Gdk.Tags.modifier list * int) -> string
-  val t : (Gdk.Tags.modifier list * int) Uoptions.option_class
-end
+val string_to_key : string -> Gdk.Tags.modifier list * int
+
+val key_to_string : Gdk.Tags.modifier list * int -> string
+
+val key_cp_wrapper : (Gdk.Tags.modifier list * int) Config_file.wrappers
+
+class key_cp :
+  ?group:Config_file.group ->
+  string list ->
+  ?short_name:string ->
+  Gdk.Tags.modifier list * int ->
+  string -> [Gdk.Tags.modifier list * int] Config_file.cp_custom_type
 
 (** {2 Functions to create parameters} *)
 
@@ -69,6 +77,13 @@ end
 val string : ?editable: bool -> ?expand: bool -> ?help: string ->
   ?f: (string -> unit) -> string -> string -> parameter_kind
 
+(** Same as {!Configwin.string} but for values which are not strings. *)
+val custom_string : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?f: ('a -> unit) ->
+    to_string: ('a -> string) ->
+      of_string: (string -> 'a) ->
+	string -> 'a -> parameter_kind
+
 (** [bool label value] creates a boolean parameter.
    @param editable indicate if the value is editable (default is [true]).
    @param help an optional help message.
@@ -88,12 +103,12 @@ val bool : ?editable: bool -> ?help: string ->
    always returning false.
 *)
 val strings : ?editable: bool -> ?help: string ->
-  ?f: (string list -> unit) -> 
+  ?f: (string list -> unit) ->
     ?eq: (string -> string -> bool) ->
-      ?add: (unit -> string list) -> 
+      ?add: (unit -> string list) ->
 	string -> string list -> parameter_kind
-	
-(** [list label f_strings value] creates a list parameter. 
+
+(** [list label f_strings value] creates a list parameter.
    [f_strings] is a function taking a value and returning a list
    of strings to display it. The list length should be the same for
    any value, and the same as the titles list length. The [value]
@@ -117,15 +132,15 @@ val strings : ?editable: bool -> ?help: string ->
    no color for any element.
 *)
 val list : ?editable: bool -> ?help: string ->
-  ?f: ('a list -> unit) -> 
+  ?f: ('a list -> unit) ->
     ?eq: ('a -> 'a -> bool) ->
       ?edit: ('a -> 'a) ->
-	?add: (unit -> 'a list) -> 
+	?add: (unit -> 'a list) ->
 	  ?titles: string list ->
 	    ?color: ('a -> string option) ->
-	      string -> 
+	      string ->
 		('a -> string list) ->
-		  'a list -> 
+		  'a list ->
 		    parameter_kind
 
 (** [color label value] creates a color parameter.
@@ -134,7 +149,7 @@ val list : ?editable: bool -> ?help: string ->
    @param help an optional help message.
    @param f the function called to apply the value (default function does nothing).
 *)
-val color : ?editable: bool -> ?expand: bool -> ?help: string -> 
+val color : ?editable: bool -> ?expand: bool -> ?help: string ->
   ?f: (string -> unit) -> string -> string -> parameter_kind
 
 (** [font label value] creates a font parameter.
@@ -143,7 +158,7 @@ val color : ?editable: bool -> ?expand: bool -> ?help: string ->
    @param help an optional help message.
    @param f the function called to apply the value (default function does nothing).
 *)
-val font : ?editable: bool -> ?expand: bool -> ?help: string -> 
+val font : ?editable: bool -> ?expand: bool -> ?help: string ->
   ?f: (string -> unit) -> string -> string -> parameter_kind
 
 (** [combo label choices value] creates a combo parameter.
@@ -156,8 +171,8 @@ val font : ?editable: bool -> ?expand: bool -> ?help: string ->
    @param blank_allowed indicate if the empty selection [""] is accepted
    (default is [false]).
 *)
-val combo : ?editable: bool -> ?expand: bool -> ?help: string -> 
-  ?f: (string -> unit) -> 
+val combo : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?f: (string -> unit) ->
     ?new_allowed: bool -> ?blank_allowed: bool ->
       string -> string list -> string -> parameter_kind
 
@@ -167,14 +182,21 @@ val combo : ?editable: bool -> ?expand: bool -> ?help: string ->
    @param help an optional help message.
    @param f the function called to apply the value (default function does nothing).
 *)
-val text : ?editable: bool -> ?expand: bool -> ?help: string -> 
+val text : ?editable: bool -> ?expand: bool -> ?help: string ->
   ?f: (string -> unit) -> string -> string -> parameter_kind
 
-(** Same as {!Configwin.text} but html bindings are available 
-   in the text widget. Use the [configwin_html_config] utility 
+(** Same as {!Configwin.text} but for values which are not strings. *)
+val custom_text : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?f: ('a -> unit) ->
+    to_string: ('a -> string) ->
+      of_string: (string -> 'a) ->
+	string -> 'a -> parameter_kind
+
+(** Same as {!Configwin.text} but html bindings are available
+   in the text widget. Use the [configwin_html_config] utility
    to edit your bindings.
 *)
-val html : ?editable: bool -> ?expand: bool -> ?help: string -> 
+val html : ?editable: bool -> ?expand: bool -> ?help: string ->
   ?f: (string -> unit) -> string -> string -> parameter_kind
 
 (** [filename label value] creates a filename parameter.
@@ -194,8 +216,8 @@ val filename : ?editable: bool -> ?expand: bool -> ?help: string ->
    is [Pervasives.(=)]. If you want to allow doubles in the list, give a function
    always returning false.
 *)
-val filenames : ?editable: bool -> ?help: string -> 
-  ?f: (string list -> unit) -> 
+val filenames : ?editable: bool -> ?help: string ->
+  ?f: (string list -> unit) ->
     ?eq: (string -> string -> bool) ->
       string -> string list -> parameter_kind
 
@@ -208,8 +230,8 @@ val filenames : ?editable: bool -> ?help: string ->
    is a tupe [(day,month,year)], where [month] is between [0] and [11]. The default
    function creates the string [year/month/day].
 *)
-val date : ?editable: bool -> ?expand: bool -> ?help: string -> 
-  ?f: ((int * int * int) -> unit) -> 
+val date : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?f: ((int * int * int) -> unit) ->
     ?f_string: ((int * int * int -> string)) ->
       string -> (int * int * int) -> parameter_kind
 
@@ -221,7 +243,7 @@ val date : ?editable: bool -> ?expand: bool -> ?help: string ->
    @param f the function called to apply the value (default function does nothing).
 *)
 val hotkey : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: ((Gdk.Tags.modifier list * int) -> unit) -> 
+  ?f: ((Gdk.Tags.modifier list * int) -> unit) ->
     string -> (Gdk.Tags.modifier list * int) -> parameter_kind
 
 val modifiers : ?editable: bool -> ?expand: bool -> ?help: string ->
@@ -229,7 +251,6 @@ val modifiers : ?editable: bool -> ?expand: bool -> ?help: string ->
   ?f: (Gdk.Tags.modifier list -> unit) -> 
     string -> Gdk.Tags.modifier list -> parameter_kind
 
-
 (** [custom box f expand] creates a custom parameter, with
    the given [box], the [f] function is called when the user
    wants to apply his changes, and [expand] indicates if the box
@@ -241,8 +262,8 @@ val custom : ?label: string -> GPack.box -> (unit -> unit) -> bool -> parameter_
 (** {2 Functions creating configuration windows and boxes} *)
 
 (** This function takes a configuration structure and creates a window
-   to configure the various parameters. 
-   @param apply this function is called when the apply button is clicked, after 
+   to configure the various parameters.
+   @param apply this function is called when the apply button is clicked, after
    giving new values to parameters.
 *)
 val edit :
@@ -263,9 +284,9 @@ val get :
   configuration_structure list ->
   return_button
 
-(** This function takes a list of parameter specifications and 
+(** This function takes a list of parameter specifications and
    creates a window to configure the various parameters.
-   @param apply this function is called when the apply button is clicked, after 
+   @param apply this function is called when the apply button is clicked, after
    giving new values to parameters.*)
 val simple_edit :
   ?apply: (unit -> unit) ->
@@ -274,7 +295,7 @@ val simple_edit :
   ?height:int ->
   parameter_kind list -> return_button
 
-(** This function takes a list of parameter specifications and 
+(** This function takes a list of parameter specifications and
    creates a window to configure the various parameters,
    without Apply button.*)
 val simple_get :
@@ -284,17 +305,14 @@ val simple_get :
   parameter_kind list -> return_button
 
 (** Create a [GPack.box] with the list of given parameters,
-   and the given list of buttons (defined by their label and callback).
-   Before calling the callback of a button, the [apply] function
-   of each parameter is called.
+   Return the box and the function to call to apply new values to parameters.
 *)
-val box : parameter_kind list -> 
-  (string * (unit -> unit)) list -> GPack.box
+val box : parameter_kind list -> GData.tooltips -> GPack.box * (unit -> unit)
 
 (** Create a [GPack.box] with the list of given configuration structure list,
    and the given list of buttons (defined by their label and callback).
    Before calling the callback of a button, the [apply] function
    of each parameter is called.
 *)
-val tabbed_box : configuration_structure list -> 
-  (string * (unit -> unit)) list -> GPack.box
+val tabbed_box : configuration_structure list ->
+  (string * (unit -> unit)) list -> GData.tooltips -> GPack.box
diff --git a/ide/utils/configwin_html_config.ml b/ide/utils/configwin_html_config.ml
index fc2913d1..fe39de0a 100644
--- a/ide/utils/configwin_html_config.ml
+++ b/ide/utils/configwin_html_config.ml
@@ -1,38 +1,39 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
 
 (** The HTML editor bindings configurator. *)
 
 module C = Configwin_ihm
 open Configwin_types
-open Uoptions
+open Config_file
 
-let simple_get = C.simple_edit 
+let simple_get = C.simple_edit
     ~with_apply: false ~apply: (fun () -> ())
 
 let params_hb hb =
-  let p_key = C.hotkey 
+  let p_key = C.hotkey
       ~f: (fun k -> hb.html_key <- k) Configwin_messages.mKey
       hb.html_key
   in
@@ -53,10 +54,10 @@ let edit_hb hb =
   hb
 
 let add () =
-  let hb = { html_key = KeyOption.string_to_key "C-a" ;
+  let hb = { html_key = Configwin_types.string_to_key "C-a" ;
 	     html_begin = "" ;
 	     html_end = "" ;
-	   } 
+	   }
   in
   match simple_get Configwin_messages.mAdd (params_hb hb) with
     Return_ok -> [hb]
@@ -66,18 +67,18 @@ let main () =
   ignore (GMain.Main.init ());
   let (ini, bindings) = C.html_config_file_and_option () in
   let param = C.list
-      ~f: (fun l -> bindings =:= l ; Uoptions.save_with_help ini)
+      ~f: (fun l -> bindings#set l ; ini#write Configwin_ihm.file_html_config )
       ~eq: (fun hb1 hb2 -> hb1.html_key = hb2.html_key)
       ~edit: edit_hb
       ~add: add
       ~titles: [ Configwin_messages.mKey ; Configwin_messages.html_begin ;
 		 Configwin_messages.html_end ]
       Configwin_messages.shortcuts
-      (fun hb -> [ KeyOption.key_to_string hb.html_key ;
+      (fun hb -> [ Configwin_types.key_to_string hb.html_key ;
 		   hb.html_begin ; hb.html_end ])
-      !!bindings
+      bindings#get
   in
-  ignore (simple_get ~width: 300 ~height: 400 
+  ignore (simple_get ~width: 300 ~height: 400
 	    Configwin_messages.html_config [param])
 
 let _ = main ()
diff --git a/ide/utils/configwin_ihm.ml b/ide/utils/configwin_ihm.ml
index 03ca706c..e9ba9789 100644
--- a/ide/utils/configwin_ihm.ml
+++ b/ide/utils/configwin_ihm.ml
@@ -1,68 +1,73 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
-
-(** This module contains the gui functions of Confgiwin.*)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
+
+(** This module contains the gui functions of Configwin.*)
 
 open Configwin_types
 
-module O = Uoptions
+module O = Config_file
 
-
-(** The file where the html config is. *)
 let file_html_config = Filename.concat Configwin_messages.home ".configwin_html"
-  
-(** Return the ini file for the html config, and the option for bindings. *)
+
+let debug = false
+let dbg = if debug then prerr_endline else (fun _ -> ())
+
+(** Return the config group for the html config file,
+   and the option for bindings. *)
 let html_config_file_and_option () =
-  let ini = O.create_options_file file_html_config in
-  let bindings = O.define_option ini ["bindings"]
-      ""
-      (O.list_option Configwin_types.Html_binding.t)
-      [ { html_key = KeyOption.string_to_key "A-b" ;
+  let ini = new O.group in
+  let bindings = new O.list_cp
+      Configwin_types.htmlbinding_cp_wrapper
+      ~group: ini
+      ["bindings"]
+      ~short_name: "bd"
+      [ { html_key = Configwin_types.string_to_key "A-b" ;
 	  html_begin = "<b>";
 	  html_end = "</b>" ;
 	} ;
-	{ html_key = KeyOption.string_to_key "A-i" ;
+	{ html_key = Configwin_types.string_to_key "A-i" ;
 	  html_begin = "<i>";
 	  html_end = "</i>" ;
-	} 
-      ]	
+	}
+      ]
+      ""
   in
-  O.load ini ;
+  ini#read file_html_config ;
   (ini, bindings)
 
-
 (** This variable contains the last directory where the user selected a file.*)
 let last_dir = ref "";;
 
 (** This function allows the user to select a file and returns the
-   selected file name. An optional function allows to change the 
+   selected file name. An optional function allows to change the
    behaviour of the ok button.
    A VOIR : mutli-selection ? *)
 let select_files ?dir
     ?(fok : (string -> unit) option)
     the_title =
-  let files = ref ([] : string list) in 
+  let files = ref ([] : string list) in
   let fs = GWindow.file_selection ~modal:true
       ~title: the_title () in
   (* we set the previous directory, if no directory is given *)
@@ -78,7 +83,7 @@ let select_files ?dir
       let _ = fs#set_filename !last_dir in
       ()
   );
- 
+
   let _ = fs # connect#destroy ~callback: GMain.Main.quit in
   let _ = fs # ok_button # connect#clicked ~callback:
       (match fok with
@@ -134,52 +139,55 @@ let select_date title (day,mon,year) =
    one to add items and one to remove the selected items.
    The class takes in parameter a function used to add items and
    a string list ref which is used to store the content of the clist.
-   At last, a title for the frame  is also in parameter, so that     
+   At last, a title for the frame  is also in parameter, so that
    each instance of the class creates a frame. *)
-class ['a] list_selection_box (listref : 'a list ref) 
+class ['a] list_selection_box
+    (listref : 'a list ref)
     titles_opt
     help_opt
     f_edit_opt
     f_strings
     f_color
     (eq : 'a -> 'a -> bool)
-    add_function title editable =
+    add_function title editable
+    (tt:GData.tooltips)
+    =
+  let _ = dbg "list_selection_box" in
   let wev = GBin.event_box () in
   let wf = GBin.frame ~label: title ~packing: wev#add () in
   let hbox = GPack.hbox ~packing: wf#add () in
   (* the scroll window and the clist *)
   let wscroll = GBin.scrolled_window
-      	~vpolicy: `AUTOMATIC
-	~hpolicy: `AUTOMATIC
-      ~packing: (hbox#pack ~expand: true) () 
+      ~vpolicy: `AUTOMATIC
+      ~hpolicy: `AUTOMATIC
+      ~packing: (hbox#pack ~expand: true) ()
   in
   let wlist = match titles_opt with
-    None -> 
+    None ->
       GList.clist ~selection_mode: `MULTIPLE
 	~titles_show: false
 	~packing: wscroll#add ()
-  | Some l -> 
-      GList.clist ~selection_mode: `MULTIPLE 
+  | Some l ->
+      GList.clist ~selection_mode: `MULTIPLE
 	~titles: l
 	~titles_show: true
 	~packing: wscroll#add ()
   in
-  let _ = 
+  let _ =
     match help_opt with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (wf#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wev#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wev#coerce
   in  (* the vbox for the buttons *)
   let vbox_buttons = GPack.vbox () in
-  let _ = 
+  let _ =
     if editable then
       let _ = hbox#pack ~expand: false vbox_buttons#coerce in
       ()
     else
-      () 
+      ()
   in
+  let _ = dbg "list_selection_box: wb_add" in
   let wb_add = GButton.button
       ~label: Configwin_messages.mAdd
       ~packing: (vbox_buttons#pack ~expand:false ~padding:2)
@@ -203,6 +211,7 @@ class ['a] list_selection_box (listref : 'a list ref)
       ~packing: (vbox_buttons#pack ~expand:false ~padding:2)
       ()
   in
+  let _ = dbg "list_selection_box: object(self)" in
   object (self)
     (** the list of selected rows *)
     val mutable list_select = []
@@ -216,17 +225,17 @@ class ['a] list_selection_box (listref : 'a list ref)
       (* insert the elements in the clist *)
       wlist#freeze ();
       wlist#clear ();
-      List.iter 
-	(fun ele -> 
+      List.iter
+	(fun ele ->
 	  ignore (wlist#append (f_strings ele));
 	  match f_color ele with
 	    None -> ()
 	  | Some c ->
 	      try wlist#set_row ~foreground: (`NAME c) (wlist#rows - 1)
 	      with _ -> ()
-	) 
+	)
 	!listref;
-      
+
       (match titles_opt with
 	None -> wlist#columns_autosize ()
       |	Some _ -> GToolbox.autosize_clist wlist);
@@ -280,10 +289,10 @@ class ['a] list_selection_box (listref : 'a list ref)
 
     initializer
       (** create the functions called when the buttons are clicked *)
-      let f_add () = 
+      let f_add () =
         (* get the files to add with the function provided *)
         let l = add_function () in
-        (* remove from the list the ones which are already in 
+        (* remove from the list the ones which are already in
            the listref, using the eq predicate *)
         let l2 = List.fold_left
             (fun acc -> fun ele ->
@@ -293,7 +302,7 @@ class ['a] list_selection_box (listref : 'a list ref)
                 acc @ [ele])
             !listref
             l
-        in    
+        in
         self#update l2
       in
       let f_remove () =
@@ -309,14 +318,19 @@ class ['a] list_selection_box (listref : 'a list ref)
         let new_list = iter 0 !listref in
         self#update new_list
       in
+      let _ = dbg "list_selection_box: connecting wb_add" in
       (* connect the functions to the buttons *)
       ignore (wb_add#connect#clicked f_add);
+      let _ = dbg "list_selection_box: connecting wb_remove" in
       ignore (wb_remove#connect#clicked f_remove);
+      let _ = dbg "list_selection_box: connecting wb_up" in
       ignore (wb_up#connect#clicked (fun () -> self#up_selected));
       (
        match f_edit_opt with
 	 None -> ()
-       | Some f -> ignore (wb_edit#connect#clicked (fun () -> self#edit_selected f))
+       | Some f ->
+	   let _ = dbg "list_selection_box: connecting wb_edit" in
+	   ignore (wb_edit#connect#clicked (fun () -> self#edit_selected f))
       );
       (* connect the selection and deselection of items in the clist *)
       let f_select ~row ~column ~event =
@@ -335,7 +349,9 @@ class ['a] list_selection_box (listref : 'a list ref)
             ()
       in
       (* connect the select and deselect events *)
+      let _ = dbg "list_selection_box: connecting select_row" in
       ignore(wlist#connect#select_row f_select);
+      let _ = dbg "list_selection_box: connecting unselect_row" in
       ignore(wlist#connect#unselect_row f_unselect);
 
       (* initialize the clist with the listref *)
@@ -344,7 +360,8 @@ class ['a] list_selection_box (listref : 'a list ref)
 
 
 (** This class is used to build a box for a string parameter.*)
-class string_param_box param =
+class string_param_box param (tt:GData.tooltips) =
+  let _ = dbg "string_param_box" in
   let hbox = GPack.hbox () in
   let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in
   let wl = GMisc.label ~text: param.string_label ~packing: wev#add () in
@@ -353,22 +370,20 @@ class string_param_box param =
       ~packing: (hbox#pack ~expand: param.string_expand ~padding: 2)
       ()
   in
-  let _ = 
+  let _ =
     match param.string_help with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (hbox#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wev#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wev#coerce
   in
-  let _ = we#set_text param.string_value in
+  let _ = we#set_text (param.string_to_string param.string_value) in
 
   object (self)
     (** This method returns the main box ready to be packed. *)
     method box = hbox#coerce
     (** This method applies the new value of the parameter. *)
     method apply =
-      let new_value = we#text in
+      let new_value = param.string_of_string we#text in
       if new_value <> param.string_value then
 	let _ = param.string_f_apply new_value in
 	param.string_value <- new_value
@@ -377,24 +392,23 @@ class string_param_box param =
   end ;;
 
 (** This class is used to build a box for a combo parameter.*)
-class combo_param_box param =
+class combo_param_box param (tt:GData.tooltips) =
+  let _ = dbg "combo_param_box" in
   let hbox = GPack.hbox () in
   let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in
   let wl = GMisc.label ~text: param.combo_label ~packing: wev#add () in
   let wc = GEdit.combo
       ~popdown_strings: param.combo_choices
       ~value_in_list: (not param.combo_new_allowed)
-(*      ~ok_if_empty: param.combo_blank_allowed*)
+      (* ~allow_empty: param.combo_blank_allowed *)
       ~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2)
       ()
   in
-  let _ = 
+  let _ =
     match param.combo_help with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (hbox#connect#destroy ~callback:tooltips#destroy);
-	tooltips#set_tip wev#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wev#coerce
   in
   let _ = wc#entry#set_editable param.combo_editable in
   let _ = wc#entry#set_text param.combo_value in
@@ -413,8 +427,9 @@ class combo_param_box param =
   end ;;
 
 (** Class used to pack a custom box. *)
-class custom_param_box param =
-  let top = 
+class custom_param_box param (tt:GData.tooltips) =
+  let _ = dbg "custom_param_box" in
+  let top =
     match param.custom_framed with
       None -> param.custom_box#coerce
     | Some l ->
@@ -428,40 +443,39 @@ class custom_param_box param =
   end
 
 (** This class is used to build a box for a color parameter.*)
-class color_param_box param =
+class color_param_box param (tt:GData.tooltips) =
+  let _ = dbg "color_param_box" in
   let v = ref param.color_value in
   let hbox = GPack.hbox () in
-  let wb = GButton.button ~label: param.color_label 
-      ~packing: (hbox#pack ~expand: false ~padding: 2) () 
+  let wb = GButton.button ~label: param.color_label
+      ~packing: (hbox#pack ~expand: false ~padding: 2) ()
   in
-  let w_test = GMisc.arrow 
+  let w_test = GMisc.arrow
       ~kind: `RIGHT
       ~shadow: `OUT
       ~width: 20
       ~height: 20
       ~packing: (hbox#pack ~expand: false ~padding: 2 )
-      () 
+      ()
   in
   let we = GEdit.entry
       ~editable: param.color_editable
       ~packing: (hbox#pack ~expand: param.color_expand ~padding: 2)
       ()
   in
-  let _ = 
+  let _ =
     match param.color_help with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (hbox#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wb#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wb#coerce
   in
   let set_color s =
     let style = w_test#misc#style#copy in
     (
-     try style#set_bg [ (`NORMAL, `NAME s) ; ]
+     try style#set_fg [ (`NORMAL, `NAME s) ; ]
      with _ -> ()
     );
-    w_test#misc#set_style style 
+    w_test#misc#set_style style;
   in
   let _ = set_color !v in
   let _ = we#set_text !v in
@@ -476,26 +490,25 @@ class color_param_box param =
     let wb_cancel = dialog#cancel_button in
     let _ = dialog#connect#destroy GMain.Main.quit in
     let _ = wb_ok#connect#clicked
-	(fun () -> 
-	  (* let color = dialog#colorsel#get_color in
-	  let r = int_of_float (ceil (color.Gtk.red *. 255.)) in
-	  let g = int_of_float (ceil (color.Gtk.green *. 255.)) in
-	  let b = int_of_float (ceil (color.Gtk.blue *. 255.)) in
-	  let s = Printf.sprintf "#%2X%2X%2X" r g b in
-	  let _ = 
+	(fun () ->
+(*	  let color = dialog#colorsel#color in
+	  let r = (Gdk.Color.red color) in
+	  let g = (Gdk.Color.green color)in
+	  let b = (Gdk.Color.blue color) in
+	  let s = Printf.sprintf "#%4X%4X%4X" r g b in
+	  let _ =
 	    for i = 1 to (String.length s) - 1 do
 	      if s.[i] = ' ' then s.[i] <- '0'
 	    done
 	  in
-	  we#set_text s ;
-	  set_color s;*)
+	  we#set_text s ; *)
 	  dialog#destroy ()
 	)
     in
     let _ = wb_cancel#connect#clicked dialog#destroy in
     GMain.Main.main ()
   in
-  let _ = 
+  let _ =
     if param.color_editable then ignore (wb#connect#clicked f_sel)
   in
 
@@ -510,27 +523,30 @@ class color_param_box param =
 	param.color_value <- new_value
       else
 	()
+
+    initializer
+      ignore (we#connect#changed (fun () -> set_color we#text));
+
   end ;;
 
 (** This class is used to build a box for a font parameter.*)
-class font_param_box param =
+class font_param_box param (tt:GData.tooltips) =
+  let _ = dbg "font_param_box" in
   let v = ref param.font_value in
   let hbox = GPack.hbox () in
-  let wb = GButton.button ~label: param.font_label 
-      ~packing: (hbox#pack ~expand: false ~padding: 2) () 
+  let wb = GButton.button ~label: param.font_label
+      ~packing: (hbox#pack ~expand: false ~padding: 2) ()
   in
   let we = GEdit.entry
       ~editable: false
       ~packing: (hbox#pack ~expand: param.font_expand ~padding: 2)
       ()
   in
-  let _ = 
+  let _ =
     match param.font_help with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (hbox#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wb#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wb#coerce
   in
   let set_entry_font font_opt =
     match font_opt with
@@ -538,7 +554,7 @@ class font_param_box param =
     | Some s ->
 	let style = we#misc#style#copy in
 	(
-	 try 
+	 try
 	   let font = Gdk.Font.load_fontset s in
 	   style#set_font font
 	 with _ -> ()
@@ -559,10 +575,10 @@ class font_param_box param =
     let wb_cancel = dialog#cancel_button in
     let _ = dialog#connect#destroy GMain.Main.quit in
     let _ = wb_ok#connect#clicked
-	(fun () -> 
-	  let font_opt = dialog#selection#font_name in
-(*	  we#set_text (match font_opt with None -> "" | Some s -> s) ;
-	  set_entry_font font_opt;*)
+	(fun () ->
+	  let font = dialog#selection#font_name in
+	  we#set_text font ;
+	  set_entry_font (Some font);
 	  dialog#destroy ()
 	)
     in
@@ -585,79 +601,89 @@ class font_param_box param =
   end ;;
 
 (** This class is used to build a box for a text parameter.*)
-class text_param_box param =
-  let hbox = GPack.hbox ~height: 100 () in
-  let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in
-  let wl = GMisc.label ~text: param.string_label ~packing: wev#add () in
+class text_param_box param (tt:GData.tooltips) =
+  let _ = dbg "text_param_box" in
+  let wf = GBin.frame ~label: param.string_label ~height: 100 () in
+  let wev = GBin.event_box ~packing: wf#add () in
   let wscroll = GBin.scrolled_window
       ~vpolicy: `AUTOMATIC
       ~hpolicy: `AUTOMATIC
-      ~packing: (hbox#pack ~expand: true ~padding: 2) () 
+      ~packing: wev#add ()
   in
-  let wt = GText.view ~packing:wscroll#add () in
-(*   let _ = wt#coerce#misc#set_size_request ~height:100 in *)
-  let _ = wt#set_editable param.string_editable in
-  let _ = 
+  let wview = GText.view
+      ~editable: param.string_editable
+      ~packing: wscroll#add
+      ()
+  in
+  let _ =
     match param.string_help with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (hbox#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wev#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wev#coerce
   in
-  let _ = wt#buffer#insert param.string_value in
+  let _ = dbg "text_param_box: buffer creation" in
+  let buffer = GText.buffer () in
 
+  let _ = wview#set_buffer buffer in
+  let _ = buffer#insert (param.string_to_string param.string_value) in
+  let _ = dbg "text_param_box: object(self)" in
   object (self)
-    val wt = wt
+    val wview = wview
     (** This method returns the main box ready to be packed. *)
-    method box = hbox#coerce
+    method box = wf#coerce
     (** This method applies the new value of the parameter. *)
     method apply =
-      let new_value = wt#buffer#get_text () in
-      if new_value <> param.string_value then
-	let _ = param.string_f_apply new_value in
-	param.string_value <- new_value
+      let v = param.string_of_string (buffer#get_text ()) in
+      if v <> param.string_value then
+	(
+	 dbg "apply new value !";
+	 let _ = param.string_f_apply v in
+	 param.string_value <- v
+	)
       else
 	()
   end ;;
 
 (** This class is used to build a box a html parameter. *)
-class html_param_box param =
+class html_param_box param (tt:GData.tooltips) =
+  let _ = dbg "html_param_box" in
   object (self)
-    inherit text_param_box param
+    inherit text_param_box param tt
 
     method private exec html_start html_end () =
-      let s,e = wt#buffer#selection_bounds in
-      if s#compare e = 0 then 
-	wt#buffer#insert (html_start^html_end)
-      else begin
-	ignore (wt#buffer#insert ~iter:e html_end);
-	ignore (wt#buffer#insert ~iter:s html_start);
-	wt#buffer#place_cursor 
-	  (e#forward_chars (String.length (html_start^html_end)))
-      end
+      let (i1,i2) = wview#buffer#selection_bounds in
+      let s = i1#get_text ~stop: i2 in
+      match s with
+	"" ->
+	  wview#buffer#insert (html_start^html_end)
+      |	_ ->
+	  ignore (wview#buffer#insert ~iter: i2 html_end);
+	  ignore (wview#buffer#insert ~iter: i1 html_start);
+	  wview#buffer#place_cursor ~where: i2
+
     initializer
+      dbg "html_param_box:initializer";
       let (_,html_bindings) = html_config_file_and_option () in
+      dbg "html_param_box:connecting key press events";
       let add_shortcut hb =
 	let (mods, k) = hb.html_key in
-	Okey.add wt ~mods k (self#exec hb.html_begin hb.html_end)
+	Okey.add wview ~mods k (self#exec hb.html_begin hb.html_end)
       in
-      List.iter add_shortcut (O.(!!) html_bindings)      
+      List.iter add_shortcut html_bindings#get;
+      dbg "html_param_box:end"
   end
 
 (** This class is used to build a box for a boolean parameter.*)
-class bool_param_box param =
+class bool_param_box param (tt:GData.tooltips) =
+  let _ = dbg "bool_param_box" in
   let wchk = GButton.check_button
       ~label: param.bool_label
       ()
   in
-  let _ = 
+  let _ =
     match param.bool_help with
       None -> ()
-    | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (wchk#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wchk#coerce ~text: help ~privat: help 
+    | Some help -> tt#set_tip ~text: help ~privat: help wchk#coerce
   in
   let _ = wchk#set_active param.bool_value in
   let _ = wchk#misc#set_sensitive param.bool_editable in
@@ -676,25 +702,24 @@ class bool_param_box param =
   end ;;
 
 (** This class is used to build a box for a file name parameter.*)
-class filename_param_box param =
+class filename_param_box param (tt:GData.tooltips) =
+  let _ = dbg "filename_param_box" in
   let hbox = GPack.hbox () in
-  let wb = GButton.button ~label: param.string_label 
-      ~packing: (hbox#pack ~expand: false ~padding: 2) () 
+  let wb = GButton.button ~label: param.string_label
+      ~packing: (hbox#pack ~expand: false ~padding: 2) ()
   in
   let we = GEdit.entry
       ~editable: param.string_editable
       ~packing: (hbox#pack ~expand: param.string_expand ~padding: 2)
       ()
   in
-  let _ = 
+  let _ =
     match param.string_help with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (hbox#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wb#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wb#coerce
   in
-  let _ = we#set_text param.string_value in
+  let _ = we#set_text (param.string_to_string param.string_value) in
 
   let f_click () =
     match select_files param.string_label with
@@ -703,7 +728,7 @@ class filename_param_box param =
     | f :: _ ->
         we#set_text f
   in
-  let _ = 
+  let _ =
     if param.string_editable then
       let _ = wb#connect#clicked f_click in
       ()
@@ -716,7 +741,7 @@ class filename_param_box param =
     method box = hbox#coerce
     (** This method applies the new value of the parameter. *)
     method apply =
-      let new_value = we#text in
+      let new_value = param.string_of_string we#text in
       if new_value <> param.string_value then
 	let _ = param.string_f_apply new_value in
 	param.string_value <- new_value
@@ -725,11 +750,12 @@ class filename_param_box param =
   end ;;
 
 (** This class is used to build a box for a hot key parameter.*)
-class hotkey_param_box param =
+class hotkey_param_box param (tt:GData.tooltips) =
+  let _ = dbg "hotkey_param_box" in
   let hbox = GPack.hbox () in
   let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in
-  let wl = GMisc.label ~text: param.hk_label 
-      ~packing: wev#add () 
+  let wl = GMisc.label ~text: param.hk_label
+      ~packing: wev#add ()
   in
   let we = GEdit.entry
       ~editable: false
@@ -737,15 +763,13 @@ class hotkey_param_box param =
       ()
   in
   let value = ref param.hk_value in
-  let _ = 
+  let _ =
     match param.hk_help with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (hbox#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wev#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wev#coerce
   in
-  let _ = we#set_text (KeyOption.key_to_string param.hk_value) in
+  let _ = we#set_text (Configwin_types.key_to_string param.hk_value) in
   let mods_we_dont_care = [`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK] in
   let capture ev =
     let key = GdkEvent.Key.keyval ev in
@@ -755,10 +779,10 @@ class hotkey_param_box param =
 	modifiers
     in
     value := (mods, key);
-    we#set_text (KeyOption.key_to_string !value);
+    we#set_text (Glib.Convert.locale_to_utf8 (Configwin_types.key_to_string !value));
     false
   in
-  let _ = 
+  let _ =
     if param.hk_editable then
       ignore (we#event#connect#key_press capture)
     else
@@ -798,7 +822,7 @@ class modifiers_param_box param =
 	ignore (hbox#connect#destroy ~callback: tooltips#destroy);
 	tooltips#set_tip wev#coerce ~text: help ~privat: help 
   in
-  let _ = we#set_text (KeyOption.modifiers_to_string param.md_value) in
+  let _ = we#set_text (Configwin_types.modifiers_to_string param.md_value) in
   let mods_we_care = param.md_allow in
   let capture ev =
     let modifiers = GdkEvent.Key.state ev in
@@ -807,7 +831,7 @@ class modifiers_param_box param =
 	modifiers
     in
     value := mods;
-    we#set_text (KeyOption.modifiers_to_string !value);
+    we#set_text (Configwin_types.modifiers_to_string !value);
     false
   in
   let _ = 
@@ -831,35 +855,35 @@ class modifiers_param_box param =
   end ;;
 
 (** This class is used to build a box for a date parameter.*)
-class date_param_box param =
+class date_param_box param (tt:GData.tooltips) =
+  let _ = dbg "date_param_box" in
   let v = ref param.date_value in
   let hbox = GPack.hbox () in
-  let wb = GButton.button ~label: param.date_label 
-      ~packing: (hbox#pack ~expand: false ~padding: 2) () 
+  let wb = GButton.button ~label: param.date_label
+      ~packing: (hbox#pack ~expand: false ~padding: 2) ()
   in
   let we = GEdit.entry
       ~editable: false
       ~packing: (hbox#pack ~expand: param.date_expand ~padding: 2)
       ()
   in
-  let _ = 
+
+  let _ =
     match param.date_help with
       None -> ()
     | Some help ->
-	let tooltips = GData.tooltips () in
-	ignore (hbox#connect#destroy ~callback: tooltips#destroy);
-	tooltips#set_tip wb#coerce ~text: help ~privat: help 
+	tt#set_tip ~text: help ~privat: help wb#coerce
   in
-  let _ = we#set_text (param.date_f_string param.date_value) in
 
+  let _ = we#set_text (param.date_f_string param.date_value) in
   let f_click () =
     match select_date param.date_label !v with
       None -> ()
-    | Some (y,m,d) -> 
+    | Some (y,m,d) ->
 	v := (d,m,y) ;
 	we#set_text (param.date_f_string (d,m,y))
   in
-  let _ = 
+  let _ =
     if param.date_editable then
       let _ = wb#connect#clicked f_click in
       ()
@@ -880,7 +904,8 @@ class date_param_box param =
   end ;;
 
 (** This class is used to build a box for a parameter whose values are a list.*)
-class ['a] list_param_box (param : 'a list_param) =
+class ['a] list_param_box (param : 'a list_param) (tt:GData.tooltips) =
+  let _ = dbg "list_param_box" in
   let listref = ref param.list_value in
   let frame_selection = new list_selection_box
       listref
@@ -891,8 +916,9 @@ class ['a] list_param_box (param : 'a list_param) =
       param.list_color
       param.list_eq
       param.list_f_add param.list_label param.list_editable
+      tt
   in
-      
+
   object (self)
     (** This method returns the main box ready to be packed. *)
     method box = frame_selection#box#coerce
@@ -902,75 +928,75 @@ class ['a] list_param_box (param : 'a list_param) =
       param.list_value <- !listref
   end ;;
 
-(** This class is used to build a box from a configuration structure 
+(** This class is used to build a box from a configuration structure
    and adds the page to the given notebook. *)
-class configuration_box conf_struct (notebook : GPack.notebook) =
+class configuration_box (tt:GData.tooltips) conf_struct (notebook : GPack.notebook) =
   (* we build different widgets, according to the conf_struct parameter *)
   let main_box = GPack.vbox () in
-  let (label, child_boxes) = 
+  let (label, child_boxes) =
     match conf_struct with
       Section (label, param_list) ->
 	let f parameter =
-	      match parameter with
-		String_param p ->
-		  let box = new string_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	Combo_param p ->
-		  let box = new combo_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	Text_param p ->
-		  let box = new text_param_box p in
-		  let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
-		  box
-	      | Bool_param p ->
-		  let box = new bool_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	Filename_param p ->
-		  let box = new filename_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	List_param f ->
-		  let box = f () in
-		  let _ = main_box#pack ~expand: true ~padding: 2 box#box in
-		  box
-	      |	Custom_param p ->
-		  let box = new custom_param_box p in
-		  let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in
-		  box
-	      |	Color_param p ->
-		  let box = new color_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	Font_param p ->
-		  let box = new font_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	Date_param p ->
-		  let box = new date_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	Hotkey_param p ->
-		  let box = new hotkey_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	Modifiers_param p ->
-		  let box = new modifiers_param_box p in
-		  let _ = main_box#pack ~expand: false ~padding: 2 box#box in
-		  box
-	      |	Html_param p ->
-		  let box = new html_param_box p in
-		  let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
-		  box
+	  match parameter with
+	    String_param p ->
+	      let box = new string_param_box p tt in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+	      box
+	  | Combo_param p ->
+	      let box = new combo_param_box p tt in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+	      box
+	  | Text_param p ->
+	      let box = new text_param_box p tt in
+	      let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
+	      box
+	  | Bool_param p ->
+	      let box = new bool_param_box p tt in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+	      box
+	  | Filename_param p ->
+	      let box = new filename_param_box p tt in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+	      box
+	  | List_param f ->
+	      let box = f tt in
+	      let _ = main_box#pack ~expand: true ~padding: 2 box#box in
+	      box
+	  | Custom_param p ->
+	      let box = new custom_param_box p tt in
+	      let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in
+	      box
+	  | Color_param p ->
+	      let box = new color_param_box p tt in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+	      box
+	  | Font_param p ->
+	      let box = new font_param_box p tt in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+	      box
+	  | Date_param p ->
+	      let box = new date_param_box p tt in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+	      box
+	  | Hotkey_param p ->
+	      let box = new hotkey_param_box p tt in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+	      box
+	  | Modifiers_param p ->
+	      let box = new modifiers_param_box p in
+	      let _ = main_box#pack ~expand: false ~padding: 2 box#box in
+		box
+	  | Html_param p ->
+	      let box = new html_param_box p tt in
+	      let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
+	      box
 	in
 	let list_children_boxes = List.map f param_list in
-	
+
 	(label, list_children_boxes)
 
     | Section_list (label, struct_list) ->
-	let wnote = GPack.notebook 
+	let wnote = GPack.notebook
             (*homogeneous_tabs: true*)
 	    ~scrollable: true
 	    ~show_tabs: true
@@ -980,15 +1006,15 @@ class configuration_box conf_struct (notebook : GPack.notebook) =
 	in
 	(* we create all the children boxes *)
 	let f structure =
-	  let new_box = new configuration_box structure wnote in
+	  let new_box = new configuration_box tt structure wnote in
 	  new_box
 	in
 	let list_child_boxes = List.map f struct_list in
 	(label, list_child_boxes)
-	
+
   in
   let page_label = GMisc.label ~text: label () in
-  let _ = notebook#append_page 
+  let _ = notebook#append_page
       ~tab_label: page_label#coerce
       main_box#coerce
   in
@@ -1008,9 +1034,9 @@ class configuration_box conf_struct (notebook : GPack.notebook) =
    Before calling the callback of a button, the [apply] function
    of each parameter is called.
 *)
-let tabbed_box conf_struct_list buttons =
+let tabbed_box conf_struct_list buttons tooltips =
   let vbox = GPack.vbox () in
-  let wnote = GPack.notebook 
+  let wnote = GPack.notebook
       (*homogeneous_tabs: true*)
       ~scrollable: true
       ~show_tabs: true
@@ -1018,18 +1044,19 @@ let tabbed_box conf_struct_list buttons =
       ~packing: (vbox#pack ~expand: true)
       ()
   in
-  let list_param_box = 
-    List.map (fun conf_struct -> new configuration_box conf_struct wnote)
+  let list_param_box =
+    List.map
+      (fun conf_struct -> new configuration_box tooltips conf_struct wnote)
       conf_struct_list
   in
-  let f_apply () = 
+  let f_apply () =
     List.iter (fun param_box -> param_box#apply) list_param_box  ;
   in
   let hbox_buttons = GPack.hbox ~packing: (vbox#pack ~expand: false ~padding: 4) () in
   let rec iter_buttons ?(grab=false) = function
       [] ->
         ()
-    | (label, callb) :: q ->    
+    | (label, callb) :: q ->
         let b = GButton.button ~label: label
             ~packing:(hbox_buttons#pack ~expand:true ~fill: true ~padding:4) ()
         in
@@ -1046,127 +1073,110 @@ let tabbed_box conf_struct_list buttons =
 
 (** This function takes a configuration structure list and creates a window
    to configure the various parameters. *)
-let edit ?(with_apply=true)  
+let edit ?(with_apply=true)
     ?(apply=(fun () -> ()))
-    title ?(width=400) ?(height=400) 
+    title ?(width=400) ?(height=400)
     conf_struct_list =
-  let return = ref Return_cancel in
-  let window = GWindow.window
-		 ~position:`CENTER
-      ~modal: true ~title: title
-      ~width: width ~height: height ()
-  in
-  let _ = window#connect#destroy ~callback: GMain.Main.quit in
-  let vbox = GPack.vbox ~packing: window#add () in
-  let wnote = GPack.notebook 
-      (*homogeneous_tabs: true*)
-      ~scrollable: true
-      ~show_tabs: true
-      ~tab_border: 3
-      ~packing: (vbox#pack ~expand: true)
-      ()
-  in
-  let list_param_box = 
-    List.map (fun conf_struct -> new configuration_box conf_struct wnote)
+  let dialog = GWindow.dialog
+    ~position:`CENTER
+    ~modal: true ~title: title
+    ~height ~width
+    ()
+  in
+  let tooltips = GData.tooltips () in
+  let wnote = GPack.notebook
+    (*homogeneous_tabs: true*)
+    ~scrollable: true
+    ~show_tabs: true
+    ~tab_border: 3
+    ~packing: (dialog#vbox#pack ~expand: true)
+    ()
+  in
+  let list_param_box =
+    List.map
+      (fun conf_struct -> new configuration_box tooltips conf_struct wnote)
       conf_struct_list
   in
+    
+    if with_apply then
+      dialog#add_button Configwin_messages.mApply `APPLY;
+    
+    dialog#add_button Configwin_messages.mOk `OK;
+    dialog#add_button Configwin_messages.mCancel `CANCEL;
+    
+    let f_apply () =
+      List.iter (fun param_box -> param_box#apply) list_param_box  ;
+      apply ()
+    in
+    let f_ok () =
+      List.iter (fun param_box -> param_box#apply) list_param_box  ;
+      Return_ok
+    in
+    let destroy () =
+      tooltips#destroy () ;
+      dialog#destroy ();
+    in
+    let rec iter rep =
+      try
+	match dialog#run () with
+	  | `APPLY  -> f_apply (); iter Return_apply
+	  | `OK -> destroy (); f_ok ()
+	  | _ -> destroy (); rep
+      with
+	  Failure s ->
+	    GToolbox.message_box "Error" s; iter rep
+	| e ->
+	    GToolbox.message_box "Error" (Printexc.to_string e); iter rep
+    in
+      iter Return_cancel
 
-  let hbox_buttons = GPack.hbox ~packing: (vbox#pack ~expand: false ~padding: 4) () in
-  let bApply = GButton.button
-		 ~stock:`APPLY
-		 ~label: Configwin_messages.mApply
-		 ()
-  in
-  if with_apply then hbox_buttons#pack ~expand: true ~padding: 3 bApply#coerce;
-  let bOk = GButton.button
-	      ~stock:`OK
-      ~label: Configwin_messages.mOk
-      ~packing: (hbox_buttons#pack ~expand: true ~padding: 3)
-      ()
-  in
-  let bCancel = GButton.button
-		  ~stock:`CANCEL
-      ~label: Configwin_messages.mCancel
-      ~packing: (hbox_buttons#pack ~expand: true ~padding: 3)
-      ()
-  in
-  (* we connect the click on the apply button *)
-  let f_apply () = 
-    List.iter (fun param_box -> param_box#apply) list_param_box  ;
-    apply ();
-    return := Return_apply
-  in
-  let _ = bApply#connect#clicked f_apply in
-  (* we connect the click on the ok button : the same than apply but we then close the window *)
-  let f_ok () = 
-    List.iter (fun param_box -> param_box#apply) list_param_box  ;
-    return := Return_ok ;
-    window#destroy () 
-  in
-  let _ = bOk#connect#clicked f_ok in
-  (* we connect the click on the cancel button : close the window *)
-  let f_cancel () = window#destroy () in
-  let _ = bCancel#connect#clicked f_cancel in
-
-  let _ = window#event#connect#key_press ~callback:
-	    (fun k -> if GdkEvent.Key.keyval k = GdkKeysyms._Escape then f_cancel ();false)
-  in
-  let _ = window#show () in
-  GMain.Main.main () ;
-  !return
-
-
-(** Create a vbox with the list of given parameters,
-   and the given list of buttons (defined by their label and callback).
-   Before calling the callback of a button, the [apply] function
-   of each parameter is called.
-*)
-let box param_list buttons =
+(** Create a vbox with the list of given parameters. *)
+let box param_list tt =
   let main_box = GPack.vbox  () in
   let f parameter =
     match parameter with
       String_param p ->
-	let box = new string_param_box p in
+	let box = new string_param_box p tt in
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | Combo_param p ->
-	let box = new combo_param_box p in
+	let box = new combo_param_box p tt in
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | Text_param p ->
-	let box = new text_param_box p in
+	let box = new text_param_box p tt in
 	let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
 	box
     | Bool_param p ->
-	let box = new bool_param_box p in
+	let box = new bool_param_box p tt in
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | Filename_param p ->
-	let box = new filename_param_box p in
+	let box = new filename_param_box p tt in
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | List_param f ->
-	let box = f () in
+	let box = f tt in
 	let _ = main_box#pack ~expand: true ~padding: 2 box#box in
 	box
     | Custom_param p ->
-	let box = new custom_param_box p in
+	let box = new custom_param_box p tt in
 	let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in
 	box
     | Color_param p ->
-	let box = new color_param_box p in
+	let box = new color_param_box p tt in
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | Font_param p ->
-	let box = new font_param_box p in
+	let box = new font_param_box p tt in
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | Date_param p ->
-	let box = new date_param_box p in
+	let box = new date_param_box p tt in
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | Hotkey_param p ->
-	let box = new hotkey_param_box p in
+	let box = new hotkey_param_box p tt in
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | Modifiers_param p ->
@@ -1174,70 +1184,61 @@ let box param_list buttons =
 	let _ = main_box#pack ~expand: false ~padding: 2 box#box in
 	box
     | Html_param p ->
-	let box = new html_param_box p in
+	let box = new html_param_box p tt in
 	let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in
 	box
   in
   let list_param_box = List.map f param_list in
-  let f_apply () = 
-    List.iter (fun param_box -> param_box#apply) list_param_box 
+  let f_apply () =
+    List.iter (fun param_box -> param_box#apply) list_param_box
   in
-  let hbox_buttons = GPack.hbox ~packing: (main_box#pack ~expand: false ~padding: 4) () in
-  let rec iter_buttons ?(grab=false) = function
-      [] ->
-        ()
-    | (label, callb) :: q ->    
-        let b = GButton.button ~label: label
-            ~packing:(hbox_buttons#pack ~expand:true ~fill: true ~padding:4) ()
-        in
-        ignore (b#connect#clicked ~callback:
-		  (fun () -> f_apply (); callb ()));
-        (* If it's the first button then give it the focus *)
-        if grab then b#grab_default ();
+  (main_box, f_apply)
 
-        iter_buttons q
+(** This function takes a list of parameter specifications and
+   creates a window to configure the various parameters.*)
+let simple_edit ?(with_apply=true)
+    ?(apply=(fun () -> ()))
+    title ?width ?height
+    param_list =
+  let dialog = GWindow.dialog
+      ~modal: true ~title: title
+      ?height ?width
+      ()
   in
-  iter_buttons ~grab: true buttons;
+  let tooltips = GData.tooltips () in
+  if with_apply then
+    dialog#add_button Configwin_messages.mApply `APPLY;
 
-  main_box
+  dialog#add_button Configwin_messages.mOk `OK;
+  dialog#add_button Configwin_messages.mCancel `CANCEL;
 
+  let (box, f_apply) = box param_list tooltips in
+  dialog#vbox#pack ~expand: true ~fill: true box#coerce;
 
-(** This function takes a list of parameter specifications and 
-   creates a window to configure the various parameters.*)
-let simple_edit ?(with_apply=true)  
-    ?(apply=(fun () -> ()))
-    title ?width ?height 
-    param_list =
-  let return = ref Return_cancel in
-  let window = GWindow.window ~modal: true ~title: title () in
-  let _ = match width, height with
-    None, None -> ()
-  | Some w, None -> window#misc#set_size_request ~width: w ()
-  | None, Some h -> window#misc#set_size_request ~height: h ()
-  | Some w, Some h -> window#misc#set_size_request ~width: w ~height: h ()
-  in
-  let _ = window#connect#destroy ~callback: GMain.Main.quit in
-  let buttons = 
-    (if with_apply then
-      [Configwin_messages.mApply, fun () -> apply (); return := Return_apply]
-    else
-      []
-    ) @ [
-	(Configwin_messages.mOk, fun () -> return := Return_ok ; window#destroy ()) ;
-	(Configwin_messages.mCancel, window#destroy) ;
-      ]	
+  let destroy () =
+    tooltips#destroy () ;
+    dialog#destroy ();
   in
-  let box = box param_list buttons in
-  window#add box#coerce;
-  let _ = window#show () in
-  GMain.Main.main () ;
-  !return
+  let rec iter rep =
+    try
+      match dialog#run () with
+      | `APPLY  -> f_apply (); apply (); iter Return_apply
+      | `OK -> f_apply () ; destroy () ; Return_ok
+      | _ -> destroy (); rep
+    with
+      Failure s ->
+	GToolbox.message_box "Error" s; iter rep
+    | e ->
+	GToolbox.message_box "Error" (Printexc.to_string e); iter rep
+  in
+  iter Return_cancel
+
 
 let edit_string l s =
   match GToolbox.input_string ~title: l ~text: s Configwin_messages.mValue with
     None -> s
   | Some s2 -> s2
-  
+
 (** Create a string param. *)
 let string ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
   String_param
@@ -1248,7 +1249,25 @@ let string ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
       string_editable = editable ;
       string_f_apply = f ;
       string_expand = expand ;
-    } 
+      string_to_string = (fun x -> x) ;
+      string_of_string = (fun x -> x) ;
+    }
+
+(** Create a custom string param. *)
+let custom_string ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) ~to_string ~of_string label v =
+  String_param
+    (Configwin_types.mk_custom_text_string_param
+       {
+	 string_label = label ;
+	 string_help = help ;
+	 string_value = v ;
+	 string_editable = editable ;
+	 string_f_apply = f ;
+	 string_expand = expand ;
+	 string_to_string = to_string;
+	 string_of_string = of_string ;
+       }
+    )
 
 (** Create a bool param. *)
 let bool ?(editable=true) ?help ?(f=(fun _ -> ())) label v =
@@ -1263,14 +1282,14 @@ let bool ?(editable=true) ?help ?(f=(fun _ -> ())) label v =
 
 (** Create a list param. *)
 let list ?(editable=true) ?help
-    ?(f=(fun (_:'a list) -> ())) 
+    ?(f=(fun (_:'a list) -> ()))
     ?(eq=Pervasives.(=))
     ?(edit:('a -> 'a) option)
     ?(add=(fun () -> ([] : 'a list)))
     ?titles ?(color=(fun (_:'a) -> (None : string option)))
     label (f_strings : 'a -> string list) v =
   List_param
-    (fun () ->
+    (fun tt ->
       Obj.magic
 	(new list_param_box
 	   {
@@ -1285,13 +1304,14 @@ let list ?(editable=true) ?help
 	     list_f_edit = edit ;
 	     list_f_add = add ;
 	     list_f_apply = f ;
-	   } 
+	   }
+	   tt
 	)
     )
 
 (** Create a strings param. *)
 let strings ?(editable=true) ?help
-    ?(f=(fun _ -> ())) 
+    ?(f=(fun _ -> ()))
     ?(eq=Pervasives.(=))
     ?(add=(fun () -> [])) label v =
   list ~editable ?help ~f ~eq ~edit: (edit_string label) ~add label (fun s -> [s]) v
@@ -1321,8 +1341,8 @@ let font ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
     }
 
 (** Create a combo param. *)
-let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) 
-    ?(new_allowed=false) 
+let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
+    ?(new_allowed=false)
     ?(blank_allowed=false) label choices v =
   Combo_param
     {
@@ -1338,7 +1358,7 @@ let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
     }
 
 (** Create a text param. *)
-let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = 
+let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
   Text_param
     {
       string_label = label ;
@@ -1347,10 +1367,28 @@ let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
       string_editable = editable ;
       string_f_apply = f ;
       string_expand = expand ;
-    } 
+      string_to_string = (fun x -> x) ;
+      string_of_string = (fun x -> x) ;
+    }
+
+(** Create a custom text param. *)
+let custom_text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) ~to_string ~of_string label v =
+  Text_param
+    (Configwin_types.mk_custom_text_string_param
+       {
+	 string_label = label ;
+	 string_help = help ;
+	 string_value = v ;
+	 string_editable = editable ;
+	 string_f_apply = f ;
+	 string_expand = expand ;
+	 string_to_string = to_string;
+	 string_of_string = of_string ;
+       }
+    )
 
 (** Create a html param. *)
-let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = 
+let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
   Html_param
     {
       string_label = label ;
@@ -1359,10 +1397,12 @@ let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
       string_editable = editable ;
       string_f_apply = f ;
       string_expand = expand ;
-    } 
+      string_to_string = (fun x -> x) ;
+      string_of_string = (fun x -> x) ;
+    }
 
 (** Create a filename param. *)
-let filename ?(editable=true) ?(expand=true)?help ?(f=(fun _ -> ())) label v = 
+let filename ?(editable=true) ?(expand=true)?help ?(f=(fun _ -> ())) label v =
   Filename_param
     {
       string_label = label ;
@@ -1371,17 +1411,19 @@ let filename ?(editable=true) ?(expand=true)?help ?(f=(fun _ -> ())) label v =
       string_editable = editable ;
       string_f_apply = f ;
       string_expand = expand ;
-    } 
+      string_to_string = (fun x -> x) ;
+      string_of_string = (fun x -> x) ;
+    }
 
 (** Create a filenames param.*)
-let filenames ?(editable=true) ?help ?(f=(fun _ -> ())) 
+let filenames ?(editable=true) ?help ?(f=(fun _ -> ()))
     ?(eq=Pervasives.(=))
     label v =
   let add () = select_files label in
-  list ~editable ?help ~f ~eq ~add label (fun s -> [s]) v
+  list ~editable ?help ~f ~eq ~add label (fun s -> [Glib.Convert.locale_to_utf8 s]) v
 
 (** Create a date param. *)
-let date ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) 
+let date ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
     ?(f_string=(fun(d,m,y)-> Printf.sprintf "%d/%d/%d" y (m+1) d))
     label v =
   Date_param
@@ -1393,7 +1435,7 @@ let date ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
       date_f_string = f_string ;
       date_f_apply = f ;
       date_expand = expand ;
-    } 
+    }
 
 (** Create a hot key param. *)
 let hotkey ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
@@ -1405,7 +1447,7 @@ let hotkey ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
       hk_editable = editable ;
       hk_f_apply = f ;
       hk_expand = expand ;
-    } 
+    }
 
 let modifiers 
   ?(editable=true) 
@@ -1432,4 +1474,4 @@ let custom ?label box f expand =
       custom_f_apply = f ;
       custom_expand = expand ;
       custom_framed = label ;
-    } 
+    }
diff --git a/ide/utils/configwin_keys.ml b/ide/utils/configwin_keys.ml
index 9c867845..e1d7f33b 100644
--- a/ide/utils/configwin_keys.ml
+++ b/ide/utils/configwin_keys.ml
@@ -1,26 +1,27 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
 
 (** Key codes
 
diff --git a/ide/utils/configwin_messages.ml b/ide/utils/configwin_messages.ml
index a6085138..f8984462 100644
--- a/ide/utils/configwin_messages.ml
+++ b/ide/utils/configwin_messages.ml
@@ -1,31 +1,32 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
 
 (** Module containing the messages of Configwin.*)
 
 let software = "Configwin";;
-let version = "1.3";;
+let version = "1.2";;
 
 let html_config = "Configwin bindings configurator for html parameters"
 
diff --git a/ide/utils/configwin_types.ml b/ide/utils/configwin_types.ml
index ee8ec70c..0def0b25 100644
--- a/ide/utils/configwin_types.ml
+++ b/ide/utils/configwin_types.ml
@@ -1,140 +1,148 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
 
 (** This module contains the types used in Configwin. *)
 
-open Uoptions
+open Config_file
 
-(** A module to define key options, with the {!Uoptions} module. *)
-module KeyOption = struct
-  let name_to_keysym = 
-    ("Button1", Configwin_keys.xk_Pointer_Button1) ::
-    ("Button2", Configwin_keys.xk_Pointer_Button2) ::
-    ("Button3", Configwin_keys.xk_Pointer_Button3) ::
-    ("Button4", Configwin_keys.xk_Pointer_Button4) ::
-    ("Button5", Configwin_keys.xk_Pointer_Button5) ::
-    Configwin_keys.name_to_keysym
-      
-  let string_to_key s =
-    let mask = ref [] in
-    let key = try
-      let pos = String.rindex s '-' in
-      for i = 0 to pos - 1 do 
-        let m = match s.[i] with
-          'C' -> `CONTROL
-        | 'S' -> `SHIFT
-        | 'L' -> `LOCK 
-        | 'M' -> `MOD1
-        | 'A' -> `MOD1
-        | '1' -> `MOD1
-        | '2' -> `MOD2
-        | '3' -> `MOD3
-        | '4' -> `MOD4
-        | '5' -> `MOD5
-        | _ -> 
-	    prerr_endline s;
-	    raise Not_found
-        in
-        mask := m :: !mask
-      done;
-      String.sub s (pos+1) (String.length s - pos - 1)
-    with _ -> 
-      s
-    in
-    try
-      !mask, List.assoc key name_to_keysym
-    with
-      e -> 
-	prerr_endline s;
-	raise e
-      
-  let key_to_string (m, k) =
-    let s = List.assoc k Configwin_keys.keysym_to_name in
-    match m with
-      [] -> s
-    | _ ->
-        let rec iter m s =
-          match m with
-            [] -> s
-          | c :: m ->
-              iter m ((
-                      match c with
-			`CONTROL -> "C"
-                      | `SHIFT -> "S"
-                      | `LOCK -> "L"
-                      | `MOD1 -> "A"
-                      | `MOD2 -> "2"
-                      | `MOD3 -> "3"
-                      | `MOD4 -> "4"
-                      | `MOD5 -> "5"
-                      | _  -> raise Not_found
-                     ) ^ s)
-        in
-        iter m ("-" ^ s)
+let name_to_keysym =
+  ("Button1", Configwin_keys.xk_Pointer_Button1) ::
+  ("Button2", Configwin_keys.xk_Pointer_Button2) ::
+  ("Button3", Configwin_keys.xk_Pointer_Button3) ::
+  ("Button4", Configwin_keys.xk_Pointer_Button4) ::
+  ("Button5", Configwin_keys.xk_Pointer_Button5) ::
+  Configwin_keys.name_to_keysym
+
+let string_to_key s =
+  let mask = ref [] in
+  let key = try
+    let pos = String.rindex s '-' in
+    for i = 0 to pos - 1 do
+      let m = match s.[i] with
+        'C' -> `CONTROL
+      | 'S' -> `SHIFT
+      | 'L' -> `LOCK
+      | 'M' -> `MOD1
+      | 'A' -> `MOD1
+      | '1' -> `MOD1
+      | '2' -> `MOD2
+      | '3' -> `MOD3
+      | '4' -> `MOD4
+      | '5' -> `MOD5
+      | _ ->
+	  prerr_endline s;
+	  raise Not_found
+      in
+      mask := m :: !mask
+    done;
+    String.sub s (pos+1) (String.length s - pos - 1)
+  with _ ->
+    s
+  in
+  try
+    !mask, List.assoc key name_to_keysym
+  with
+    e ->
+      prerr_endline s;
+      raise e
 
-  let modifiers_to_string m =
-    let rec iter m s =
-      match m with
+let key_to_string (m, k) =
+  let s = List.assoc k Configwin_keys.keysym_to_name in
+  match m with
+    [] -> s
+  | _ ->
+      let rec iter m s =
+        match m with
           [] -> s
         | c :: m ->
             iter m ((
-                      match c with
-			  `CONTROL -> "<ctrl>"
-			| `SHIFT -> "<shft>"
-			| `LOCK -> "<lock>"
-			| `MOD1 -> "<alt>"
-			| `MOD2 -> "<mod2>"
-			| `MOD3 -> "<mod3>"
-			| `MOD4 -> "<mod4>"
-			| `MOD5 -> "<mod5>"
-			| _  -> raise Not_found
-                    ) ^ s)
-    in
+                    match c with
+		      `CONTROL -> "C"
+                    | `SHIFT -> "S"
+                    | `LOCK -> "L"
+                    | `MOD1 -> "A"
+                    | `MOD2 -> "2"
+                    | `MOD3 -> "3"
+                    | `MOD4 -> "4"
+                    | `MOD5 -> "5"
+                    | _  -> raise Not_found
+                   ) ^ s)
+      in
+      iter m ("-" ^ s)
+
+let modifiers_to_string m =
+  let rec iter m s =
+    match m with
+        [] -> s
+      | c :: m ->
+          iter m ((
+                    match c with
+			`CONTROL -> "<ctrl>"
+		      | `SHIFT -> "<shft>"
+		      | `LOCK -> "<lock>"
+		      | `MOD1 -> "<alt>"
+		      | `MOD2 -> "<mod2>"
+		      | `MOD3 -> "<mod3>"
+		      | `MOD4 -> "<mod4>"
+		      | `MOD5 -> "<mod5>"
+		      | _  -> raise Not_found
+                  ) ^ s)
+  in
     iter m ""
-	  
-  let value_to_key v =
-    match v with
-      StringValue s -> string_to_key s
-    | _ -> 
-	prerr_endline "value_to_key";
-	raise Not_found
-	  
-  let key_to_value k =
-    StringValue (key_to_string k)
       
-  let (t : (Gdk.Tags.modifier list * int) option_class) = 
-    define_option_class "Key" value_to_key key_to_value
-end
+let value_to_key v =
+  match v with
+    Raw.String s -> string_to_key s
+  | _ ->
+      prerr_endline "value_to_key";
+      raise Not_found
+
+let key_to_value k =
+  Raw.String (key_to_string k)
+
+let key_cp_wrapper =
+  {
+    to_raw = key_to_value ;
+    of_raw = value_to_key ;
+  }
 
-(** This type represents a string or filename parameter. *)
-type string_param = {
+(** A class to define key options, with the {!Config_file} module. *)
+class key_cp =
+  [(Gdk.Tags.modifier list * int)] Config_file.cp_custom_type key_cp_wrapper
+
+(** This type represents a string or filename parameter, or
+   any other type, depending on the given conversion functions. *)
+type 'a string_param = {
     string_label : string; (** the label of the parameter *)
-    mutable string_value : string; (** the current value of the parameter *)
+    mutable string_value : 'a; (** the current value of the parameter *)
     string_editable : bool ; (** indicates if the value can be changed *)
-    string_f_apply : (string -> unit) ; (** the function to call to apply the new value of the parameter *)
+    string_f_apply : ('a -> unit) ; (** the function to call to apply the new value of the parameter *)
     string_help : string option ; (** optional help string *)
     string_expand : bool ; (** expand or not *)
+    string_to_string : 'a -> string ;
+    string_of_string : string -> 'a ;
   } ;;
 
 (** This type represents a boolean parameter. *)
@@ -214,14 +222,14 @@ type font_param = {
 
 type hotkey_param = {
     hk_label : string ; (** the label of the parameter *)
-    mutable hk_value : (Gdk.Tags.modifier list * int) ; 
+    mutable hk_value : (Gdk.Tags.modifier list * int) ;
              (** The value, as a list of modifiers and a key code *)
     hk_editable : bool ; (** indicates if the value can be changed *)
     hk_f_apply : ((Gdk.Tags.modifier list * int) -> unit) ;
              (** the function to call to apply the new value of the paramter *)
     hk_help : string option ; (** optional help string *)
     hk_expand : bool ; (** expand or not *)
-  } 
+  }
 
 type modifiers_param = {
     md_label : string ; (** the label of the parameter *)
@@ -235,13 +243,18 @@ type modifiers_param = {
     md_allow : Gdk.Tags.modifier list
   } 
 
+
+let mk_custom_text_string_param (a : 'a string_param) : string string_param =
+  Obj.magic a
+
+
 (** This type represents the different kinds of parameters. *)
 type parameter_kind =
-    String_param of string_param
-  | List_param of (unit -> <box: GObj.widget ; apply : unit>)
-  | Filename_param of string_param
+    String_param of string string_param
+  | List_param of (GData.tooltips -> <box: GObj.widget ; apply : unit>)
+  | Filename_param of string string_param
   | Bool_param of bool_param
-  | Text_param of string_param
+  | Text_param of string string_param
   | Combo_param of combo_param
   | Custom_param of custom_param
   | Color_param of color_param
@@ -249,7 +262,7 @@ type parameter_kind =
   | Font_param of font_param
   | Hotkey_param of hotkey_param
   | Modifiers_param of modifiers_param
-  | Html_param of string_param
+  | Html_param of string string_param
 ;;
 
 (** This type represents the structure of the configuration window. *)
@@ -273,27 +286,21 @@ type html_binding = {
     mutable html_key :  (Gdk.Tags.modifier list * int) ;
     mutable html_begin : string ;
     mutable html_end : string ;
-  } 
-
-module Html_binding = struct
-  let value_to_hb v =
-    match v with
-      List [StringValue hk ; StringValue debut; StringValue fin ]
-    | SmallList [StringValue hk ; StringValue debut; StringValue fin ] ->
-        { html_key = KeyOption.string_to_key hk ;
-	  html_begin = debut ;
-	  html_end = fin ;
-        }
-    | _ ->
-        prerr_endline "Html_binding.value_to_hb";
-        raise Not_found
+  }
 
-  let hb_to_value hb =
-    SmallList [ StringValue (KeyOption.key_to_string hb.html_key) ;
-                StringValue hb.html_begin ;
-                StringValue hb.html_end ;
-	      ]	
+let htmlbinding_cp_wrapper =
+  let w = Config_file.tuple3_wrappers
+      key_cp_wrapper
+      Config_file.string_wrappers
+      Config_file.string_wrappers
+  in
+  {
+    to_raw = (fun v -> w.to_raw (v.html_key, v.html_begin, v.html_end)) ;
+    of_raw =
+      (fun r -> let (k,b,e) = w.of_raw r in
+       { html_key = k ; html_begin = b ; html_end = e }
+      ) ;
+  }
 
-  let (t : html_binding option_class) =
-    define_option_class "html_binding" value_to_hb hb_to_value
-end
+class htmlbinding_cp =
+  [html_binding] Config_file.option_cp htmlbinding_cp_wrapper
diff --git a/ide/utils/okey.ml b/ide/utils/okey.ml
index 17e371f5..57939266 100644
--- a/ide/utils/okey.ml
+++ b/ide/utils/okey.ml
@@ -1,33 +1,34 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
 
 type modifier = Gdk.Tags.modifier
 
 type handler = {
     cond : (unit -> bool) ;
     cback : (unit -> unit) ;
-  } 
+  }
 
 type handler_spec = int * int * Gdk.keysym
       (** mods * mask * key *)
@@ -49,9 +50,9 @@ let int_of_modifier = function
 
 let print_modifier l =
   List.iter
-    (fun m -> 
+    (fun m ->
       print_string
-	(((function 
+	(((function
 	    `SHIFT -> "SHIFT"
 	  | `LOCK -> "LOCK"
 	  | `CONTROL -> "CONTROL"
@@ -69,11 +70,11 @@ let print_modifier l =
     )
     l;
   print_newline ()
-  
+
 let int_of_modifiers l =
   List.fold_left (fun acc -> fun m -> acc + (int_of_modifier m)) 0 l
 
-module H = 
+module H =
   struct
     type t = handler_spec * handler
     let equal (m,k) (mods, mask, key) =
@@ -85,7 +86,7 @@ module H =
     let find_handlers mods key l =
       List.map snd
         (List.filter
-	   (fun ((m,ma,k),_) -> equal (mods,key) (m,ma,k)) 
+	   (fun ((m,ma,k),_) -> equal (mods,key) (m,ma,k))
 	   l
 	)
 
@@ -97,23 +98,25 @@ let key_press w ev =
   let key = GdkEvent.Key.keyval ev in
   let modifiers = GdkEvent.Key.state ev in
   try
-    let (r : H.t list ref) = Hashtbl.find table w#get_oid in
+    let (r : H.t list ref) = Hashtbl.find table (Oo.id w) in
     let l = H.find_handlers (int_of_modifiers modifiers) key !r in
-    let b = ref true in
-    List.iter
-      (fun h ->
-	if h.cond () then
-	  (h.cback () ; b := false)
-	else
-	  ()
-      )
-      l;
-    !b
+    match l with
+      [] -> false
+    | _ ->
+	List.iter
+	  (fun h ->
+	    if h.cond () then
+	      try h.cback ()
+	      with e -> prerr_endline (Printexc.to_string e)
+	    else ()
+	  )
+	  l;
+	true
   with
     Not_found ->
-      true
+      false
 
-let associate_key_press w = 
+let associate_key_press w =
   ignore ((w#event#connect#key_press ~callback: (key_press w)) : GtkSignal.id)
 
 let default_modifiers = ref ([] : modifier list)
@@ -122,24 +125,25 @@ let default_mask = ref ([`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK] : modifier list)
 let set_default_modifiers l = default_modifiers := l
 let set_default_mask l = default_mask := l
 
-let remove_widget  (w : < event : GObj.event_ops ; get_oid : int ; ..>) () =
-  try 
-    let r = Hashtbl.find table w#get_oid in
+let remove_widget  (w : < event : GObj.event_ops ; ..>) () =
+  try
+    let r = Hashtbl.find table (Oo.id w) in
     r := []
-  with 
+  with
     Not_found ->
       ()
 
 let add1 ?(remove=false) w
-    ?(cond=(fun () -> true)) 
+    ?(cond=(fun () -> true))
     ?(mods= !default_modifiers)
     ?(mask= !default_mask)
     k callback =
+
   let r =
-    try Hashtbl.find table w#get_oid
-    with Not_found -> 
+    try Hashtbl.find table (Oo.id w)
+    with Not_found ->
       let r = ref [] in
-      Hashtbl.add table w#get_oid r;
+      Hashtbl.add table (Oo.id w) r;
       ignore (w#connect#destroy ~callback: (remove_widget w));
       associate_key_press w;
       r
@@ -147,7 +151,7 @@ let add1 ?(remove=false) w
   let n_mods = int_of_modifiers mods in
   let n_mask = lnot (int_of_modifiers mask) in
   let new_h = { cond = cond ; cback = callback } in
-  if remove then 
+  if remove then
     (
      let l = H.filter_with_mask n_mods n_mask k !r in
      r := ((n_mods, n_mask, k), new_h) :: l
@@ -156,30 +160,29 @@ let add1 ?(remove=false) w
     r := ((n_mods, n_mask, k), new_h) :: !r
 
 let add w
-    ?(cond=(fun () -> true)) 
+    ?(cond=(fun () -> true))
     ?(mods= !default_modifiers)
     ?(mask= !default_mask)
     k callback =
   add1 w ~cond ~mods ~mask k callback
 
 let add_list w
-    ?(cond=(fun () -> true)) 
+    ?(cond=(fun () -> true))
     ?(mods= !default_modifiers)
     ?(mask= !default_mask)
     k_list callback =
   List.iter (fun k -> add w ~cond ~mods ~mask k callback) k_list
 
 let set w
-    ?(cond=(fun () -> true)) 
+    ?(cond=(fun () -> true))
     ?(mods= !default_modifiers)
     ?(mask= !default_mask)
     k callback =
   add1 ~remove: true w ~cond ~mods ~mask k callback
 
 let set_list w
-    ?(cond=(fun () -> true)) 
+    ?(cond=(fun () -> true))
     ?(mods= !default_modifiers)
     ?(mask= !default_mask)
     k_list callback =
   List.iter (fun k -> set w ~cond ~mods ~mask k callback) k_list
-
diff --git a/ide/utils/okey.mli b/ide/utils/okey.mli
index a0effe72..c8d48389 100644
--- a/ide/utils/okey.mli
+++ b/ide/utils/okey.mli
@@ -1,26 +1,27 @@
-(**************************************************************************)
-(*                   Cameleon                                             *)
-(*                                                                        *)
-(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
-(*      en Automatique. All rights reserved.                              *)
-(*                                                                        *)
-(*      This program is free software; you can redistribute it and/or modify  *)
-(*      it under the terms of the GNU General Public License as published by  *)
-(*      the Free Software Foundation; either version 2 of the License, or  *)
-(*      any later version.                                                *)
-(*                                                                        *)
-(*      This program is distributed in the hope that it will be useful,   *)
-(*      but WITHOUT ANY WARRANTY; without even the implied warranty of    *)
-(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     *)
-(*      GNU General Public License for more details.                      *)
-(*                                                                        *)
-(*      You should have received a copy of the GNU General Public License  *)
-(*      along with this program; if not, write to the Free Software       *)
-(*      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA          *)
-(*      02111-1307  USA                                                   *)
-(*                                                                        *)
-(*      Contact: Maxence.Guesdon@inria.fr                                *)
-(**************************************************************************)
+(*********************************************************************************)
+(*                Cameleon                                                       *)
+(*                                                                               *)
+(*    Copyright (C) 2005 Institut National de Recherche en Informatique et       *)
+(*    en Automatique. All rights reserved.                                       *)
+(*                                                                               *)
+(*    This program is free software; you can redistribute it and/or modify       *)
+(*    it under the terms of the GNU Library General Public License as            *)
+(*    published by the Free Software Foundation; either version 2 of the         *)
+(*    License, or  any later version.                                            *)
+(*                                                                               *)
+(*    This program is distributed in the hope that it will be useful,            *)
+(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
+(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
+(*    GNU Library General Public License for more details.                       *)
+(*                                                                               *)
+(*    You should have received a copy of the GNU Library General Public          *)
+(*    License along with this program; if not, write to the Free Software        *)
+(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
+(*    02111-1307  USA                                                            *)
+(*                                                                               *)
+(*    Contact: Maxence.Guesdon@inria.fr                                          *)
+(*                                                                               *)
+(*********************************************************************************)
 
 (** Okey interface. 
 
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index 25167865..6442cb94 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: constrextern.ml,v 1.85.2.7 2006/01/05 12:00:35 herbelin Exp $ *)
+(* $Id: constrextern.ml 8675 2006-03-31 18:21:20Z herbelin $ *)
 
 (*i*)
 open Pp
@@ -25,7 +25,7 @@ open Topconstr
 open Rawterm
 open Pattern
 open Nametab
-open Symbols
+open Notation
 open Reserve
 (*i*)
 
@@ -54,7 +54,7 @@ let print_coercions = ref false
 (* This forces printing universe names of Type{.} *)
 let print_universes = ref false
 
-(* This suppresses printing of numeral and symbols *)
+(* This suppresses printing of primitive tokens (e.g. numeral) and symbols *)
 let print_no_symbol = ref false
 
 (* This governs printing of projections using the dot notation symbols *)
@@ -69,13 +69,6 @@ let with_universes f = Options.with_option print_universes f
 let without_symbols f = Options.with_option print_no_symbol f
 let with_meta_as_hole f = Options.with_option print_meta_as_hole f
 
-(* For the translator *)
-let temporary_implicits_out = ref []
-let set_temporary_implicits_out l = temporary_implicits_out := l
-let get_temporary_implicits_out id =
-  try List.assoc id !temporary_implicits_out
-  with Not_found -> []
-
 (**********************************************************************)
 (* Various externalisation functions *)
 
@@ -83,9 +76,13 @@ let insert_delimiters e = function
   | None -> e
   | Some sc -> CDelimiters (dummy_loc,sc,e)
 
-let insert_pat_delimiters e = function
-  | None -> e
-  | Some sc -> CPatDelimiters (dummy_loc,sc,e)
+let insert_pat_delimiters loc p = function
+  | None -> p
+  | Some sc -> CPatDelimiters (loc,sc,p)
+
+let insert_pat_alias loc p = function
+  | Anonymous -> p
+  | Name id -> CPatAlias (loc,p,id)
 
 (**********************************************************************)
 (* conversion of references                                           *)
@@ -96,8 +93,7 @@ let ids_of_ctxt ctxt =
        (function c -> match kind_of_term c with
 	  | Var id -> id
 	  | _ ->
-       error
-       "Termast: arbitrary substitution of references not yet implemented")
+       error "arbitrary substitution of references not implemented")
      ctxt)
 
 let idopt_of_name = function 
@@ -114,7 +110,7 @@ let extern_evar loc n =
 
 let raw_string_of_ref = function
   | ConstRef kn -> 
-      "CONST("^(string_of_kn kn)^")"
+      "CONST("^(string_of_con kn)^")"
   | IndRef (kn,i) ->
       "IND("^(string_of_kn kn)^","^(string_of_int i)^")"
   | ConstructRef ((kn,i),j) -> 
@@ -123,863 +119,8 @@ let raw_string_of_ref = function
   | VarRef id -> 
       "SECVAR("^(string_of_id id)^")"
 
-(* v7->v8 translation *)
-
-let name_app f = function
-  | Name id -> Name (f id)
-  | Anonymous -> Anonymous
-
-let rec translate_ident_string = function
-    (* translate keyword *)
-  | ("at" | "IF" | "forall" | "fun" | "match" | "fix" | "cofix" | "for" | "let"
-    | "if"  | "then" | "else" | "return" | "mod" | "where" 
-    | "exists" | "exists2" | "using" as s) ->
-      let s' = s^"_" in
-      msgerrnl
-      (str ("Warning: '"^
-          s^"' is now a keyword; it has been translated to '"^s'^"'"));
-      s'
-(* Le conflit est en fait surtout avec Eval dans Definition et c'est gere dans
-   Ppconstrnew
-  | "eval" as s ->
-      let s' = s^"_" in
-      msgerrnl
-      (str ("Warning: '"^
-          s^"' is a conflicting ident; it has been translated to '"^s'^"'"));
-      s'
-*)
-
-  (* avoid _ *)
-  | "_" -> 
-      msgerrnl (str 
-        "Warning: '_' is no longer an ident; it has been translated to 'x_'");
-      "x_"
-  (* avoid @ *)
-  | s when String.contains s '@' ->
-      let n = String.index s '@' in 
-      translate_ident_string
-      (String.sub s 0 n ^ "'at'" ^ String.sub s (n+1) (String.length s -n-1))
-  | s -> s
-
-let translate_ident id =
-  id_of_string (translate_ident_string (string_of_id id))
-
-let is_coq_root d =
-  let d = repr_dirpath d in d <> [] & string_of_id (list_last d) = "Coq"
-
-let is_dir dir s =
-  let d = repr_dirpath dir in
-  d <> [] & string_of_id (List.hd d) = s
-
-let is_module m = is_dir (Lib.library_dp()) m
-
-let bp = ["BinPos"]
-let bz = ["BinInt"]
-let bn = ["BinNat"]
-let pn = ["nat"]
-let zc = ["Zcompare"]
-let lo = ["Logic"]
-let da = ["Datatypes"]
-let zabs = ["Zabs"]
-let zo = ["Zorder"]
-let zn = ["Znat"]
-let wz = ["Wf_Z"]
-let mu = ["Mult"]
-let pl = ["Plus"]
-let mi = ["Minus"]
-let le = ["Le"]
-let gt = ["Gt"]
-let lt = ["Lt"]
-let be = ["Between"]
-let bo = ["Bool"]
-let c dir = 
-  let d = repr_dirpath dir in
-  if d = [] then [] else [string_of_id (List.hd d)]
-
-let translation_table = [
-  (* ZArith *)
-"double_moins_un", (bp,"Pdouble_minus_one");
-"double_moins_deux", (bp,"Pdouble_minus_two");
-"is_double_moins_un", (bp,"Psucc_o_double_minus_one_eq_xO");
-"double_moins_un_add_un_xI", (bp,"Pdouble_minus_one_o_succ_eq_xI");
-"add_un_Zs", (bz,"Zpos_succ_morphism");
-"entier", (bn,"N");
-"entier_of_Z", (bz,"Zabs_N");
-"Z_of_entier", (bz,"Z_of_N");
-"SUPERIEUR", (da,"Gt");
-"EGAL", (da,"Eq");
-"INFERIEUR", (da,"Lt");
-"add", (bp,"Pplus");
-"add_carry", (bp,"Pplus_carry");
-"add_assoc", (bp,"Pplus_assoc");
-"add_sym", (bp,"Pplus_comm");
-"add_x_x", (bp,"Pplus_diag");
-"add_carry_add", (bp,"Pplus_carry_plus");
-"simpl_add_r", (bp,"Pplus_reg_r");
-"simpl_add_l", (bp,"Pplus_reg_l");
-"simpl_add_carry_r", (bp,"Pplus_carry_reg_r");
-"simpl_add_carry_l", (bp,"Pplus_carry_reg_l");
-"simpl_times_r", (bp,"Pmult_reg_r");
-"simpl_times_l", (bp,"Pmult_reg_l");
-(*
-"xO_xI_add_double_moins_un", (bp,"xO_xI_plus_double_minus_one");
-*)
-"double_moins_un_plus_xO_double_moins_un",
-  (bp,"Pdouble_minus_one_plus_xO_double_minus_one");
-"add_xI_double_moins_un", (bp,"Pplus_xI_double_minus_one");
-"add_xO_double_moins_un", (bp,"Pplus_xO_double_minus_one");
-"iter_pos_add", (bp,"iter_pos_plus");
-"add_no_neutral", (bp,"Pplus_no_neutral");
-"add_carry_not_add_un", (bp,"Pplus_carry_no_neutral");
-"times_add_distr", (bp,"Pmult_plus_distr_l");
-"times_add_distr_l", (bp,"Pmult_plus_distr_r");
-"times_true_sub_distr", (bp,"Pmult_minus_distr_l");
-"times_sym", (bp,"Pmult_comm");
-"times_assoc", (bp,"Pmult_assoc");
-"times_convert", (bp,"nat_of_P_mult_morphism");
-"true_sub", (bp,"Pminus");
-"times_x_1", (bp,"Pmult_1_r");
-"times_x_double", (bp,"Pmult_xO_permute_r"); 
-   (* Changer en Pmult_xO_distrib_r_reverse *)
-"times_x_double_plus_one", (bp,"Pmult_xI_permute_r"); (* Changer ? *)
-"times_discr_xO_xI", (bp,"Pmult_xI_mult_xO_discr");
-"times_discr_xO", (bp,"Pmult_xO_discr");
-"times_one_inversion_l", (bp,"Pmult_1_inversion_l");
-"true_sub_convert", (bp,"nat_of_P_minus_morphism");
-"compare_true_sub_right", (bp,"Pcompare_minus_r");
-"compare_true_sub_left", (bp,"Pcompare_minus_l");
-"sub_add", (bp,"Pplus_minus" (* similar to le_plus_minus in Arith *));
-"sub_add_one", (bp,"Ppred_succ");
-"add_sub_one", (bp,"Psucc_pred");
-"add_un", (bp,"Psucc");
-"add_un_discr", (bp,"Psucc_discr");
-"add_un_not_un", (bp,"Psucc_not_one");
-"add_un_inj", (bp,"Psucc_inj");
-"xI_add_un_xO", (bp,"xI_succ_xO");
-"ZL12", (bp,"Pplus_one_succ_r");
-"ZL12bis", (bp,"Pplus_one_succ_l");
-"ZL13", (bp,"Pplus_carry_spec");
-      (* Changer en Pplus_succ_distrib_r_reverse ? *)
-"ZL14", (bp,"Pplus_succ_permute_r");
-      (* Changer en Plus_succ_distrib_l_reverse *)
-"ZL14bis", (bp,"Pplus_succ_permute_l");
-"sub_un", (bp,"Ppred");
-"sub_pos", (bp,"Pminus_mask");
-"sub_pos_x_x", (bp,"Pminus_mask_diag");
-(*"sub_pos_x_x", (bp,"Pminus_mask_diag");*)
-"sub_pos_SUPERIEUR", (bp,"Pminus_mask_Gt");
-"sub_neg", (bp,"Pminus_mask_carry");
-"Zdiv2_pos", (bp,"Pdiv2");
-"Pdiv2", (["Zbinary"],"Zdiv2_ge_compat");
-"ZERO", (bz,"Z0");
-"POS", (bz,"Zpos");
-"NEG", (bz,"Zneg");
-"Nul", (bn,"N0");
-"Pos", (bn,"Npos");
-"Un_suivi_de", (bn,"Ndouble_plus_one");
-"Zero_suivi_de", (bn,"Ndouble");
-"Un_suivi_de_mask", (bp,"Pdouble_plus_one_mask");
-"Zero_suivi_de_mask", (bp,"Pdouble_mask");
-"ZS", (bp,"double_eq_zero_inversion");
-"US", (bp,"double_plus_one_zero_discr");
-"USH", (bp,"double_plus_one_eq_one_inversion");
-"ZSH", (bp,"double_eq_one_discr");
-"ZPminus_add_un_permute", (bz,"ZPminus_succ_permute");
-"ZPminus_add_un_permute_Zopp", (bz,"ZPminus_succ_permute_opp");
-"ZPminus_double_moins_un_xO_add_un", (bz,"ZPminus_double_minus_one_xO_succ");
-"ZL1", (bp,"xO_succ_permute");  (* ?? *)
-"Zplus_assoc_r", (bz,"Zplus_assoc_reverse");
-"Zplus_sym", (bz,"Zplus_comm");
-"Zero_left", (bz,"Zplus_0_l");
-"Zero_right", (bz,"Zplus_0_r");
-"Zplus_n_O", (bz,"Zplus_0_r_reverse");
-"Zplus_unit_left", (bz,"Zplus_0_simpl_l");
-"Zplus_unit_right", (bz,"Zplus_0_simpl_l_reverse");
-"Zplus_Zopp_expand", (bz,"Zplus_opp_expand");
-"Zn_Sn", (bz,"Zsucc_discr");
-"Zs", (bz,"Zsucc");
-"Psucc_Zs", (bz,"Zpos_succ_permute");
-"Zs_pred", (bz,"Zsucc_pred");
-"Zpred_Sn", (bz,"Zpred_succ");
-"Zminus_n_O", (bz,"Zminus_0_l_reverse");
-"Zminus_n_n", (bz,"Zminus_diag_reverse");
-"Zminus_Sn_m", (bz,"Zminus_succ_l");
-"Zeq_Zminus", (bz,"Zeq_minus");
-"Zminus_Zeq", (bz,"Zminus_eq");
-"Zplus_minus", (bz,"Zplus_minus_eq");
-"Zminus_plus", (bz,"Zminus_plus");
-"Zminus_plus_simpl", (bz,"Zminus_plus_simpl_l_reverse");
-"Zminus_Zplus_compatible", (bz,"Zminus_plus_simpl_r");
-"Zle_plus_minus", (bz,"Zplus_minus");
-"Zopp_Zplus", (bz,"Zopp_plus_distr");
-"Zopp_Zopp", (bz,"Zopp_involutive");
-"Zopp_NEG", (bz,"Zopp_neg");
-"Zopp_Zdouble", (bz,"Zopp_double");
-"Zopp_Zdouble_plus_one", (bz,"Zopp_double_plus_one");
-"Zopp_Zdouble_minus_one", (bz,"Zopp_double_minus_one");
-"Zplus_inverse_r", (bz,"Zplus_opp_r");
-"Zplus_inverse_l", (bz,"Zplus_opp_l");
-"Zplus_S_n", (bz,"Zplus_succ_l");
-"Zplus_n_Sm", (bz,"Zplus_succ_r");
-"Zplus_Snm_nSm", (bz,"Zplus_succ_comm");
-"Zmult_assoc_r", (bz,"Zmult_assoc_reverse");
-"Zmult_sym", (bz,"Zmult_comm");
-"Zmult_eq", (bz,"Zmult_integral_l");
-"Zmult_zero", (bz,"Zmult_integral");
-"Zero_mult_left", (bz,"Zmult_0_l");
-"Zero_mult_right", (bz,"Zmult_0_r");
-"Zmult_1_n", (bz,"Zmult_1_l");
-"Zmult_n_1", (bz,"Zmult_1_r");
-"Zmult_n_O", (bz,"Zmult_0_r_reverse");
-"Zopp_one", (bz,"Zopp_eq_mult_neg_1");
-"Zopp_Zmult", (bz,"Zopp_mult_distr_l_reverse");
-"Zopp_Zmult_r", (bz,"Zopp_mult_distr_r");
-"Zopp_Zmult_l", (bz,"Zopp_mult_distr_l");
-"Zmult_Zopp_Zopp", (bz,"Zmult_opp_opp");
-"Zmult_Zopp_left", (bz,"Zmult_opp_comm");
-"Zmult_Zplus_distr", (bz,"Zmult_plus_distr_r");
-"Zmult_plus_distr", (bz,"Zmult_plus_distr_r");
-"Zmult_Zminus_distr_r", (bz,"Zmult_minus_distr_l");
-"Zmult_Zminus_distr_l", (bz,"Zmult_minus_distr_r");
-"Zcompare_Zplus_compatible", (zc,"Zcompare_plus_compat");
-"Zcompare_Zplus_compatible2", (zc,"Zplus_compare_compat");
-"Zcompare_Zmult_compatible", (zc,"Zcompare_mult_compat");
-"inject_nat", (bz,"Z_of_nat");
-"inject_nat_complete", (wz,"Z_of_nat_complete");
-"inject_nat_complete_inf", (wz,"Z_of_nat_complete_inf");
-"inject_nat_prop", (wz,"Z_of_nat_prop");
-"inject_nat_set", (wz,"Z_of_nat_set");
-"convert", (bp,"nat_of_P");
-"anti_convert", (bp,"P_of_succ_nat");
-"positive_to_nat", (bp,"Pmult_nat");
-"Zopp_intro", (bz,"Zopp_inj");
-"plus_iter_add", (bp,"plus_iter_eq_plus");
-"compare", (bp,"Pcompare");
-"iter_convert", (["Zmisc"],"iter_nat_of_P");
-"ZLSI", (bp,"Pcompare_Gt_Lt");
-"ZLIS", (bp,"Pcompare_Lt_Gt");
-"ZLII", (bp,"Pcompare_Lt_Lt");
-"ZLSS", (bp,"Pcompare_Gt_Gt");
-  (* Pnat *)
-"convert_intro", (pn,"nat_of_P_inj");
-"convert_add", (pn,"nat_of_P_plus_morphism");
-"convert_add_un", (pn,"Pmult_nat_succ_morphism");
-"cvt_add_un", (pn,"nat_of_P_succ_morphism");
-"convert_add_carry", (pn,"Pmult_nat_plus_carry_morphism");
-"compare_convert_O", (pn,"lt_O_nat_of_P");
-"add_verif", (pn,"Pmult_nat_l_plus_morphism");
-"ZL2", (pn,"Pmult_nat_r_plus_morphism");
-"compare_positive_to_nat_O", (pn,"le_Pmult_nat");
-(* Trop spécifique ?
-"ZL6", (pn,"Pmult_nat_plus_shift_morphism");
-*)
-"ZL15", (pn,"Pplus_carry_pred_eq_plus");
-"cvt_carry", (pn,"nat_of_P_plus_carry_morphism");
-"compare_convert1", (pn,"Pcompare_not_Eq");
-"compare_convert_INFERIEUR", (pn,"nat_of_P_lt_Lt_compare_morphism");
-"compare_convert_SUPERIEUR", (pn,"nat_of_P_gt_Gt_compare_morphism");
-"compare_convert_EGAL", (pn,"Pcompare_Eq_eq");
-"convert_compare_INFERIEUR", (pn,"nat_of_P_lt_Lt_compare_complement_morphism");
-"convert_compare_SUPERIEUR", (pn,"nat_of_P_gt_Gt_compare_complement_morphism");
-"convert_compare_EGAL", (pn,"Pcompare_refl");
-"bij1", (pn,"nat_of_P_o_P_of_succ_nat_eq_succ");
-"bij2", (pn,"P_of_succ_nat_o_nat_of_P_eq_succ");
-"bij3", (pn,"pred_o_P_of_succ_nat_o_nat_of_P_eq_id");
-  (* Zcompare *)
-"Zcompare_EGAL", (zc,"Zcompare_Eq_iff_eq");
-"Zcompare_EGAL_eq", (zc,"Zcompare_Eq_eq");
-"Zcompare_x_x", (zc,"Zcompare_refl");
-"Zcompare_et_un", (zc,"Zcompare_Gt_not_Lt");
-"Zcompare_trans_SUPERIEUR", (zc,"Zcompare_Gt_trans");
-"Zcompare_n_S", (zc,"Zcompare_succ_compat");
-"SUPERIEUR_POS", (zc,"Zcompare_Gt_spec");
-"Zcompare_ANTISYM", (zc,"Zcompare_Gt_Lt_antisym");
-"Zcompare_Zs_SUPERIEUR", (zc,"Zcompare_succ_Gt");
-"Zcompare_Zopp", (zc,"Zcompare_opp");
-"POS_inject", (zn,"Zpos_eq_Z_of_nat_o_nat_of_P");
-"absolu", (bz,"Zabs_nat");
-"absolu_lt", (zabs,"Zabs_nat_lt" (* "Zabs_nat_lt_morphism_pos" ? *));
-"Zeq_add_S", (bz,"Zsucc_inj");
-"Znot_eq_S", (bz,"Zsucc_inj_contrapositive");
-"Zeq_S", (bz,"Zsucc_eq_compat");
-"Zsimpl_plus_l", (bz,"Zplus_reg_l");
-"Zplus_simpl", (bz,"Zplus_eq_compat");
-"POS_gt_ZERO", (zo,"Zgt_pos_0");
-"ZERO_le_POS", (zo,"Zle_0_pos");
-"ZERO_le_inj", (zo,"Zle_0_nat");
-"NEG_lt_ZERO", (zo,"Zlt_neg_0");
-"Zlt_ZERO_pred_le_ZERO", (zo,"Zlt_0_le_0_pred");
-"POS_xI", (bz,"Zpos_xI");
-"POS_xO", (bz,"Zpos_xO");
-"NEG_xI", (bz,"Zneg_xI");
-"NEG_xO", (bz,"Zneg_xO");
-"POS_add", (bz,"Zpos_plus_distr");
-"NEG_add", (bz,"Zneg_plus_distr");
-  (* Z Orders *)
-"not_Zge", (zo,"Znot_ge_lt");
-"not_Zlt", (zo,"Znot_lt_ge");
-"not_Zle", (zo,"Znot_le_gt");
-"not_Zgt", (zo,"Znot_gt_le");
-"Zgt_not_sym", (zo,"Zgt_asym");
-"Zlt_not_sym", (zo,"Zlt_asym");
-"Zlt_n_n", (zo,"Zlt_irrefl");
-"Zgt_antirefl", (zo,"Zgt_irrefl");
-"Zgt_reg_l", (zo,"Zplus_gt_compat_l");
-"Zgt_reg_r", (zo,"Zplus_gt_compat_r");
-"Zlt_reg_l", (zo,"Zplus_lt_compat_l");
-"Zlt_reg_r", (zo,"Zplus_lt_compat_r");
-"Zle_reg_l", (zo,"Zplus_le_compat_l");
-"Zle_reg_r", (zo,"Zplus_le_compat_r");
-"Zlt_le_reg", (zo,"Zplus_lt_le_compat");
-"Zle_lt_reg", (zo,"Zplus_le_lt_compat");
-"Zle_plus_plus", (zo,"Zplus_le_compat");
-"Zlt_Zplus", (zo,"Zplus_lt_compat");
-"Zle_O_plus", (zo,"Zplus_le_0_compat");
-"Zle_mult_simpl", (zo,"Zmult_le_reg_r");
-"Zge_mult_simpl", (zo,"Zmult_ge_reg_r");
-"Zgt_mult_simpl", (zo,"Zmult_gt_reg_r");
-"Zsimpl_gt_plus_l", (zo,"Zplus_gt_reg_l");
-"Zsimpl_gt_plus_r", (zo,"Zplus_gt_reg_r");
-"Zsimpl_le_plus_l", (zo,"Zplus_le_reg_l");
-"Zsimpl_le_plus_r", (zo,"Zplus_le_reg_r");
-"Zsimpl_lt_plus_l", (zo,"Zplus_lt_reg_l");
-"Zsimpl_lt_plus_r", (zo,"Zplus_lt_reg_r");
-"Zlt_Zmult_right2", (zo,"Zmult_gt_0_lt_reg_r");
-"Zlt_Zmult_right", (zo,"Zmult_gt_0_lt_compat_r");
-"Zle_Zmult_right2", (zo,"Zmult_gt_0_le_reg_r");
-"Zle_Zmult_right", (zo,"Zmult_gt_0_le_compat_r");
-"Zgt_Zmult_right", (zo,"Zmult_gt_compat_r");
-"Zgt_Zmult_left", (zo,"Zmult_gt_compat_l");
-"Zlt_Zmult_left", (zo,"Zmult_gt_0_lt_compat_l");
-"Zcompare_Zmult_right", (zc,"Zmult_compare_compat_r");
-"Zcompare_Zmult_left", (zc,"Zmult_compare_compat_l");
-"Zplus_Zmult_2", (bz,"Zplus_diag_eq_mult_2");
-"Zmult_Sm_n", (bz,"Zmult_succ_l_reverse");
-"Zmult_n_Sm", (bz,"Zmult_succ_r_reverse");
-"Zmult_le", (zo,"Zmult_le_0_reg_r");
-"Zmult_reg_left", (bz,"Zmult_reg_l");
-"Zmult_reg_right", (bz,"Zmult_reg_r");
-"Zle_ZERO_mult", (zo,"Zmult_le_0_compat");
-"Zgt_ZERO_mult", (zo,"Zmult_gt_0_compat");
-"Zle_mult", (zo,"Zmult_gt_0_le_0_compat");
-"Zmult_lt", (zo,"Zmult_gt_0_lt_0_reg_r");
-"Zmult_gt", (zo,"Zmult_gt_0_reg_l");
-"Zle_Zmult_pos_right", (zo,"Zmult_le_compat_r");
-"Zle_Zmult_pos_left", (zo,"Zmult_le_compat_l");
-"Zge_Zmult_pos_right", (zo,"Zmult_ge_compat_r");
-"Zge_Zmult_pos_left", (zo,"Zmult_ge_compat_l");
-"Zge_Zmult_pos_compat", (zo,"Zmult_ge_compat");
-"Zlt_Zcompare", (zo,"Zlt_compare");
-"Zle_Zcompare", (zo,"Zle_compare");
-"Zgt_Zcompare", (zo,"Zgt_compare");
-"Zge_Zcompare", (zo,"Zge_compare");
-  (* ex-IntMap *)
-"convert_xH", (pn,"nat_of_P_xH");
-"convert_xO", (pn,"nat_of_P_xO");
-"convert_xI", (pn,"nat_of_P_xI");
-"positive_to_nat_mult", (pn,"Pmult_nat_mult_permute");
-"positive_to_nat_2", (pn,"Pmult_nat_2_mult_2_permute");
-"positive_to_nat_4", (pn,"Pmult_nat_4_mult_2_permute");
-  (* ZArith and Arith orders *)
-"Zle_refl", (zo,"Zeq_le");
-"Zle_n", (zo,"Zle_refl");
-"Zle_trans_S", (zo,"Zle_succ_le");
-"Zgt_trans_S", (zo,"Zge_trans_succ");
-"Zgt_S", (zo,"Zgt_succ_gt_or_eq");
-"Zle_Sn_n", (zo,"Znot_le_succ");
-"Zlt_n_Sn", (zo,"Zlt_succ");
-"Zlt_S", (zo,"Zlt_lt_succ");
-"Zlt_n_S", (zo,"Zsucc_lt_compat");
-"Zle_n_S", (zo,"Zsucc_le_compat");
-"Zgt_n_S", (zo,"Zsucc_gt_compat");
-"Zlt_S_n", (zo,"Zsucc_lt_reg");
-"Zgt_S_n", (zo,"Zsucc_gt_reg");
-"Zle_S_n", (zo,"Zsucc_le_reg");
-"Zle_0_plus", (zo,"Zplus_le_0_compat");
-"Zgt_Sn_n", (zo,"Zgt_succ");
-"Zgt_le_S", (zo,"Zgt_le_succ");
-"Zgt_S_le", (zo,"Zgt_succ_le");
-"Zle_S_gt", (zo,"Zlt_succ_gt");
-"Zle_gt_S", (zo,"Zlt_gt_succ");
-"Zgt_pred", (zo,"Zgt_succ_pred");
-"Zlt_pred", (zo,"Zlt_succ_pred");
-"Zgt0_le_pred", (zo,"Zgt_0_le_0_pred");
-"Z_O_1", (zo,"Zlt_0_1");
-"Zle_NEG_POS", (zo,"Zle_neg_pos");
-"Zle_n_Sn", (zo,"Zle_succ");
-"Zle_pred_n", (zo,"Zle_pred");
-"Zlt_pred_n_n", (zo,"Zlt_pred");
-"Zlt_le_S", (zo,"Zlt_le_succ");
-"Zlt_n_Sm_le", (zo,"Zlt_succ_le");
-"Zle_lt_n_Sm", (zo,"Zle_lt_succ");
-"Zle_le_S", (zo,"Zle_le_succ");
-"Zlt_minus", (zo,"Zlt_minus_simpl_swap");
-"le_trans_S", (le,"le_Sn_le");
-(* Znumtheory *)
-"Zdivide_Zmod", ([],"Zdivide_mod");
-"Zmod_Zdivide", ([],"Zmod_divide");
-"Zdivide_mult_left", ([],"Zmult_divide_compat_l");
-"Zdivide_mult_right", ([],"Zmult_divide_compat_r");
-"Zdivide_opp", ([],"Zdivide_opp_r");
-"Zdivide_opp_rev", ([],"Zdivide_opp_r_rev");
-"Zdivide_opp_left", ([],"Zdivide_opp_l");
-"Zdivide_opp_left_rev", ([],"Zdivide_opp_l_rev");
-"Zdivide_right", ([],"Zdivide_mult_r");
-"Zdivide_left", ([],"Zdivide_mult_l");
-"Zdivide_plus", ([],"Zdivide_plus_r");
-"Zdivide_minus", ([],"Zdivide_minus_l");
-"Zdivide_a_ab", ([],"Zdivide_factor_r");
-"Zdivide_a_ba", ([],"Zdivide_factor_l");
-(* Arith *)
-(* Peano.v
-"plus_n_O", ("plus_0_r_reverse");
-"plus_O_n", ("plus_0_l");
-*)
-"plus_assoc_l", (pl,"plus_assoc");
-"plus_assoc_r", (pl,"plus_assoc_reverse");
-"plus_sym", (pl,"plus_comm");
-"mult_sym", (mu,"mult_comm");
-"max_sym", (["Max"],"max_comm");
-"min_sym", (["Min"],"min_comm");
-"gt_not_sym", (gt,"gt_asym");
-"lt_not_sym", (lt,"lt_asym");
-"gt_antirefl", (gt,"gt_irrefl");
-"lt_n_n", (lt,"lt_irrefl");
-(* Trop utilisé dans CoqBook | "le_n" -> "le_refl"*)
-"simpl_plus_l", (pl,"plus_reg_l");
-"simpl_plus_r", (pl,"plus_reg_r");
-"fact_growing", (["Factorial"],"fact_le");
-"mult_assoc_l", (mu,"mult_assoc");
-"mult_assoc_r", (mu,"mult_assoc_reverse");
-"mult_plus_distr", (mu,"mult_plus_distr_r");
-"mult_plus_distr_r", (mu,"mult_plus_distr_l");
-"mult_minus_distr", (mu,"mult_minus_distr_r");
-"mult_1_n", (mu,"mult_1_l");
-"mult_n_1", (mu,"mult_1_r");
-(* Peano.v
-"mult_n_O", ("mult_O_r_reverse");
-"mult_n_Sm", ("mult_S_r_reverse");
-*)
-"mult_le", (mu,"mult_le_compat_l");
-"le_mult_right", (mu,"mult_le_compat_r");
-"le_mult_mult", (mu,"mult_le_compat");
-"mult_lt", (mu,"mult_S_lt_compat_l");
-"lt_mult_right", (mu,"mult_lt_compat_r");
-"mult_le_conv_1", (mu,"mult_S_le_reg_l");
-"exists", (be,"exists_between");
-"IHexists", ([],"IHexists_between");
-(* Peano.v
-"pred_Sn", ("pred_S");
-*)
-"inj_minus_aux", (mi,"not_le_minus_0");
-"minus_x_x", (mi,"minus_diag");
-"minus_plus_simpl", (mi,"minus_plus_simpl_l_reverse");
-"gt_reg_l", (gt,"plus_gt_compat_l");
-"le_reg_l", (pl,"plus_le_compat_l");
-"le_reg_r", (pl,"plus_le_compat_r");
-"lt_reg_l", (pl,"plus_lt_compat_l");
-"lt_reg_r", (pl,"plus_lt_compat_r");
-"le_plus_plus", (pl,"plus_le_compat");
-"le_lt_plus_plus", (pl,"plus_le_lt_compat");
-"lt_le_plus_plus", (pl,"plus_lt_le_compat");
-"lt_plus_plus", (pl,"plus_lt_compat");
-"plus_simpl_l", (pl,"plus_reg_l");
-"simpl_gt_plus_l", (pl,"plus_gt_reg_l");
-"simpl_le_plus_l", (pl,"plus_le_reg_l");
-"simpl_lt_plus_l", (pl,"plus_lt_reg_l");
-(* Noms sur le principe de ceux de Z
-"le_n_S", ("S_le_compat");
-"le_n_Sn", ("le_S");
-(*"le_O_n", ("??" *));
-"le_pred_n", ("le_pred");
-"le_trans_S", ("le_S_le");
-"le_S_n", ("S_le_reg");
-"le_Sn_O", ("not_le_S_O");
-"le_Sn_n", ("not_le_S");
-*)
-  (* Init *)
-"IF", (lo,"IF_then_else");
-  (* Lists *)
-"idempot_rev", (["List"],"rev_involutive");
-"forall", (["Streams"],"HereAndFurther");
-  (* Bool *)
-"orb_sym", (bo,"orb_comm");
-"andb_sym", (bo,"andb_comm");
-  (* Ring *)
-"SR_plus_sym", (["Ring_theory"],"SR_plus_comm");
-"SR_mult_sym", (["Ring_theory"],"SR_mult_comm");
-"Th_plus_sym", (["Ring_theory"],"Th_plus_comm");
-"Th_mul_sym", (["Ring_theory"],"Th_mult_comm");
-"SSR_plus_sym", (["Setoid_ring_theory"],"SSR_plus_comm");
-"SSR_mult_sym", (["Setoid_ring_theory"],"SSR_mult_comm");
-"STh_plus_sym", (["Setoid_ring_theory"],"STh_plus_comm");
-"STh_mul_sym", (["Setoid_ring_theory"],"STh_mult_comm");
-  (* Reals *)
-(*
-"Rabsolu", ("Rabs");
-"Rabsolu_pos_lt", ("Rabs_pos_lt");
-"Rabsolu_no_R0", ("Rabs_no_R0");
-"Rabsolu_Rabsolu", ("Rabs_Rabs");
-"Rabsolu_mult", ("Rabs_mult");
-"Rabsolu_triang", ("Rabs_triang");
-"Rabsolu_Ropp", ("Rabs_Ropp");
-"Rabsolu_right", ("Rabs_right");
-...
-"case_Rabsolu", ("case_Rabs");
-"Pow_Rabsolu", ("Pow_Rabs");
-...
-*)
-(* Raxioms *)
-"complet", ([],"completeness");
-"complet_weak", ([],"completeness_weak");
-"Rle_sym1", ([],"Rle_ge");
-"Rmin_sym", ([],"Rmin_comm");
-"Rplus_sym", ([],"Rplus_comm");
-"Rmult_sym", ([],"Rmult_comm");
-"Rsqr_times", ([],"Rsqr_mult");
-"sqrt_times", ([],"sqrt_mult");
-"Rmult_1l", ([],"Rmult_1_l");
-"Rplus_Ol", ([],"Rplus_0_l");
-"Rplus_Ropp_r", ([],"Rplus_opp_r");
-"Rmult_Rplus_distr", ([],"Rmult_plus_distr_l");
-"Rlt_antisym", ([],"Rlt_asym");
-(* RIneq *)
-"Rlt_antirefl", ([],"Rlt_irrefl");
-"Rlt_compatibility", ([],"Rplus_lt_compat_l");
-"Rgt_plus_plus_r", ([],"Rplus_gt_compat_l");
-"Rgt_r_plus_plus", ([],"Rplus_gt_reg_l");
-"Rge_plus_plus_r", ([],"Rplus_ge_compat_l");
-"Rge_r_plus_plus", ([],"Rplus_ge_reg_l");
-(* Si on en change un, il faut changer tous les autres R*_monotony *)
-"Rlt_monotony", ([],"Rmult_lt_compat_l");
-"Rlt_monotony_r", ([],"Rmult_lt_compat_r");
-"Rlt_monotony_contra", ([],"Rmult_lt_reg_l");
-(*"Rlt_monotony_rev", ([],"Rmult_lt_reg_l");*)
-"Rlt_anti_monotony", ([],"Rmult_lt_gt_compat_neg_l");
-"Rle_monotony", ([],"Rmult_le_compat_l");
-"Rle_monotony_r", ([],"Rmult_le_compat_r");
-"Rle_monotony_contra", ([],"Rmult_le_reg_l");
-"Rle_anti_monotony1", ([],"Rmult_le_compat_neg_l");
-"Rle_anti_monotony", ([],"Rmult_le_ge_compat_neg_l");
-"Rge_monotony", ([],"Rmult_ge_compat_r");
-"Rge_ge_eq", ([],"Rge_antisym");
-(* Le reste de RIneq *)
-"imp_not_Req", ([],"Rlt_dichotomy_converse");
-"Req_EM", ([],"Req_dec");
-"total_order", ([],"Rtotal_order");
-"not_Req", ([],"Rdichotomy");
-(* "Rlt_le" -> c dir,"Rlt_le_weak" ? *)
-"not_Rle", ([],"Rnot_le_lt");
-"not_Rge", ([],"Rnot_ge_lt");
-"Rlt_le_not", ([],"Rlt_not_le");
-"Rle_not", ([],"Rgt_not_le");
-"Rle_not_lt", ([],"Rle_not_lt");
-"Rlt_ge_not", ([],"Rlt_not_ge");
-"eq_Rle", ([],"Req_le");
-"eq_Rge", ([],"Req_ge");
-"eq_Rle_sym", ([],"Req_le_sym");
-"eq_Rge_sym", ([],"Req_ge_sym");
-(* "Rle_le_eq" -> ?   x<=y/\y<=x <-> x=y *)
-"Rlt_rew", ([],"Rlt_eq_compat");
-"total_order_Rlt", ([],"Rlt_dec");
-"total_order_Rle", ([],"Rle_dec");
-"total_order_Rgt", ([],"Rgt_dec");
-"total_order_Rge", ([],"Rge_dec");
-"total_order_Rlt_Rle", ([],"Rlt_le_dec");
-(* "Rle_or_lt" -> c dir,"Rle_or_lt"*)
-"total_order_Rle_Rlt_eq", ([],"Rle_lt_or_eq_dec");
-(* "inser_trans_R" -> c dir,"Rle_lt_inser_trans" ?*)
-(* "Rplus_ne" -> c dir,"Rplus_0_r_l" ? *)
-"Rplus_Or", ([],"Rplus_0_r");
-"Rplus_Ropp_l", ([],"Rplus_opp_l");
-"Rplus_Ropp", ([],"Rplus_opp_r_uniq");
-"Rplus_plus_r", ([],"Rplus_eq_compat_l");
-"r_Rplus_plus", ([],"Rplus_eq_reg_l");
-"Rplus_ne_i", ([],"Rplus_0_r_uniq");
-"Rmult_Or", ([],"Rmult_0_r");
-"Rmult_Ol", ([],"Rmult_0_l");
-(* "Rmult_ne" -> c dir,"Rmult_1_l_r" ? *)
-"Rmult_1r", ([],"Rmult_1_r");
-"Rmult_mult_r", ([],"Rmult_eq_compat_l");
-"r_Rmult_mult", ([],"Rmult_eq_reg_l");
-"without_div_Od", ([],"Rmult_integral");
-"without_div_Oi", ([],"Rmult_eq_0_compat");
-"without_div_Oi1", ([],"Rmult_eq_0_compat_r");
-"without_div_Oi2", ([],"Rmult_eq_0_compat_l");
-"without_div_O_contr", ([],"Rmult_neq_0_reg");
-"mult_non_zero", ([],"Rmult_integral_contrapositive");
-"Rmult_Rplus_distrl", ([],"Rmult_plus_distr_r");
-"Rsqr_O", ([],"Rsqr_0");
-"Rsqr_r_R0", ([],"Rsqr_0_uniq");
-"eq_Ropp", ([],"Ropp_eq_compat");
-"Ropp_O", ([],"Ropp_0");
-"eq_RoppO", ([],"Ropp_eq_0_compat");
-"Ropp_Ropp", ([],"Ropp_involutive");
-"Ropp_neq", ([],"Ropp_neq_0_compat");
-"Ropp_distr1", ([],"Ropp_plus_distr");
-"Ropp_mul1", ([],"Ropp_mult_distr_l_reverse");
-"Ropp_mul2", ([],"Rmult_opp_opp");
-"Ropp_mul3", ([],"Ropp_mult_distr_r_reverse");
-"minus_R0", ([],"Rminus_0_r");
-"Rminus_Ropp", ([],"Rminus_0_l");
-"Ropp_distr2", ([],"Ropp_minus_distr");
-"Ropp_distr3", ([],"Ropp_minus_distr'");
-"eq_Rminus", ([],"Rminus_diag_eq");
-"Rminus_eq", ([],"Rminus_diag_uniq");
-"Rminus_eq_right", ([],"Rminus_diag_uniq_sym");
-"Rplus_Rminus", ([],"Rplus_minus");
-(*
-"Rminus_eq_contra", ([],"Rminus_diag_neq");
-"Rminus_not_eq", ([],"Rminus_neq_diag_sym");
- "Rminus_not_eq_right" -> ?
-*)
-"Rminus_distr", ([],"Rmult_minus_distr_l");
-"Rinv_R1", ([],"Rinv_1");
-"Rinv_neq_R0", ([],"Rinv_neq_0_compat");
-"Rinv_Rinv", ([],"Rinv_involutive");
-"Rinv_Rmult", ([],"Rinv_mult_distr");
-"Ropp_Rinv", ([],"Ropp_inv_permute");
-(* "Rinv_r_simpl_r" -> OK ? *)
-(* "Rinv_r_simpl_l" -> OK ? *)
-(* "Rinv_r_simpl_m" -> OK ? *)
-"Rinv_Rmult_simpl", ([],"Rinv_mult_simpl"); (* ? *)
-"Rlt_compatibility_r", ([],"Rplus_lt_compat_r");
-"Rlt_anti_compatibility", ([],"Rplus_lt_reg_r");
-"Rle_compatibility", ([],"Rplus_le_compat_l");
-"Rle_compatibility_r", ([],"Rplus_le_compat_r");
-"Rle_anti_compatibility", ([],"Rplus_le_reg_l");
-(* "sum_inequa_Rle_lt" -> ? *)
-"Rplus_lt", ([],"Rplus_lt_compat");
-"Rplus_le", ([],"Rplus_le_compat");
-"Rplus_lt_le_lt", ([],"Rplus_lt_le_compat");
-"Rplus_le_lt_lt", ([],"Rplus_le_lt_compat");
-"Rgt_Ropp", ([],"Ropp_gt_lt_contravar");
-"Rlt_Ropp", ([],"Ropp_lt_gt_contravar");
-"Ropp_Rlt", ([],"Ropp_lt_cancel");  (* ?? *)
-"Rlt_Ropp1", ([],"Ropp_lt_contravar");
-"Rle_Ropp", ([],"Ropp_le_ge_contravar");
-"Ropp_Rle", ([],"Ropp_le_cancel");
-"Rle_Ropp1", ([],"Ropp_le_contravar");
-"Rge_Ropp", ([],"Ropp_ge_le_contravar");
-"Rlt_RO_Ropp", ([],"Ropp_0_lt_gt_contravar");
-"Rgt_RO_Ropp", ([],"Ropp_0_gt_lt_contravar");
-"Rle_RO_Ropp", ([],"Ropp_0_le_ge_contravar");
-"Rge_RO_Ropp", ([],"Ropp_0_ge_le_contravar");
-(* ... cf plus haut pour les lemmes intermediaires *)
-"Rle_Rmult_comp", ([],"Rmult_le_compat");
-   (* Expliciter que la contrainte est r2>0 dans r1<r2 et non 0<r1 ce
-      qui est plus général mais différent de Rmult_le_compat ? *)
-"Rmult_lt", ([],"Rmult_gt_0_lt_compat"); (* Hybride aussi *)
-"Rmult_lt_0", ([],"Rmult_ge_0_gt_0_lt_compat"); (* Un truc hybride *)
-(*
- "Rlt_minus" -> 
- "Rle_minus" -> 
- "Rminus_lt" -> 
- "Rminus_le" -> 
- "tech_Rplus" -> 
-*)
-"pos_Rsqr", ([],"Rle_0_sqr");
-"pos_Rsqr1", ([],"Rlt_0_sqr");
-"Rlt_R0_R1", ([],"Rlt_0_1");
-"Rle_R0_R1", ([],"Rle_0_1");
-"Rlt_Rinv", ([],"Rinv_0_lt_compat");
-"Rlt_Rinv2", ([],"Rinv_lt_0_compat");
-"Rinv_lt", ([],"Rinv_lt_contravar");
-"Rlt_Rinv_R1", ([],"Rinv_1_lt_contravar");
-"Rlt_not_ge", ([],"Rnot_lt_ge");
-"Rgt_not_le", ([],"Rnot_gt_le");
-(*
- "Rgt_ge" -> "Rgt_ge_weak" ?
-*)
-"Rlt_sym", ([],"Rlt_gt_iff");
-(* | "Rle_sym1" -> c dir,"Rle_ge" OK *)
-"Rle_sym2", ([],"Rge_le");
-"Rle_sym", ([],"Rle_ge_iff");
-(*
- "Rge_gt_trans" -> OK
- "Rgt_ge_trans" -> OK
- "Rgt_trans" -> OK
- "Rge_trans" -> OK
-*)
-"Rgt_RoppO", ([],"Ropp_lt_gt_0_contravar");
-"Rlt_RoppO", ([],"Ropp_gt_lt_0_contravar");
-"Rlt_r_plus_R1", ([],"Rle_lt_0_plus_1");
-"Rlt_r_r_plus_R1", ([],"Rlt_plus_1");
-(* "tech_Rgt_minus" -> ? *)
-(* OK, cf plus haut
-"Rgt_r_plus_plus", ([],"Rplus_gt_reg_l");
-"Rgt_plus_plus_r", ([],"Rplus_gt_compat_l");
-"Rge_plus_plus_r", ([],"Rplus_ge_compat_l");
-"Rge_r_plus_plus", ([],"Rplus_ge_reg_l");
-"Rge_monotony" ->  *)
-(*
- "Rgt_minus" -> 
- "minus_Rgt" -> 
- "Rge_minus" -> 
- "minus_Rge" -> 
-*)
-"Rmult_gt", ([],"Rmult_gt_0_compat");
-"Rmult_lt_pos", ([],"Rmult_lt_0_compat");  (* lt_0 ou 0_lt ?? *)
-"Rplus_eq_R0_l", ([],"Rplus_eq_0_l"); (* ? *)
-"Rplus_eq_R0", ([],"Rplus_eq_R0");
-"Rplus_Rsr_eq_R0_l", ([],"Rplus_sqr_eq_0_l");
-"Rplus_Rsr_eq_R0", ([],"Rplus_sqr_eq_0");
-(*
- "S_INR" -> 
- "S_O_plus_INR" -> 
- "plus_INR" -> 
- "minus_INR" -> 
- "mult_INR" -> 
- "lt_INR_0" -> 
- "lt_INR" -> 
- "INR_lt_1" -> 
- "INR_pos" -> 
- "pos_INR" -> 
- "INR_lt" -> 
- "le_INR" -> 
- "not_INR_O" -> 
- "not_O_INR" -> 
- "not_nm_INR" -> 
- "INR_eq" -> 
- "INR_le" -> 
- "not_1_INR" -> 
- "IZN" -> 
- "INR_IZR_INZ" -> 
- "plus_IZR_NEG_POS" -> 
- "plus_IZR" -> 
- "mult_IZR" -> 
- "Ropp_Ropp_IZR" -> 
- "Z_R_minus" -> 
- "lt_O_IZR" -> 
- "lt_IZR" -> 
- "eq_IZR_R0" -> 
- "eq_IZR" -> 
- "not_O_IZR" -> 
- "le_O_IZR" -> 
- "le_IZR" -> 
- "le_IZR_R1" -> 
- "IZR_ge" -> 
- "IZR_le" -> 
- "IZR_lt" -> 
- "one_IZR_lt1" -> 
- "one_IZR_r_R1" -> 
- "single_z_r_R1" -> 
- "tech_single_z_r_R1" -> 
- "prod_neq_R0" -> 
- "Rmult_le_pos" -> 
- "double" -> 
- "double_var" -> 
-*)
-"gt0_plus_gt0_is_gt0", ([],"Rplus_lt_0_compat");
-"ge0_plus_gt0_is_gt0", ([],"Rplus_le_lt_0_compat");
-"gt0_plus_ge0_is_gt0", ([],"Rplus_lt_le_0_compat");
-"ge0_plus_ge0_is_ge0", ([],"Rplus_le_le_0_compat");
-(*
- "plus_le_is_le" -> ?
- "plus_lt_is_lt" -> ?
-*)
-"Rmult_lt2", ([],"Rmult_le_0_lt_compat");
-(* "Rge_ge_eq" -> c dir,"Rge_antisym" OK *)
-]
-
-let translate_v7_string dir s =
-  try
-    let d,s' = List.assoc s translation_table in
-    (if d=[] then c dir else d),s'
-  with Not_found ->
-  (* Special cases *)
-  match s with
-  (* Init *)
-  | "relation" when is_module "Datatypes" or is_dir dir "Datatypes"
-      -> da,"comparison"
-  | "Op" when is_module "Datatypes" or is_dir dir "Datatypes"
-      -> da,"CompOpp"
-  (* BinPos *)
-  | "times" when not (is_module "Mapfold") -> bp,"Pmult"
-  (* Reals *)
-  | s when String.length s >= 7 & (String.sub s 0 7 = "Rabsolu") ->
-      c dir,
-      "Rabs"^(String.sub s 7 (String.length s - 7))
-  | s when String.length s >= 7 &
-      (String.sub s (String.length s - 7) 7 = "Rabsolu") -> c dir,
-      "R"^(String.sub s 0 (String.length s - 7))^"abs"
-  | s when String.length s >= 7 & 
-      let s' = String.sub s 0 7 in
-      (s' = "unicite" or s' = "unicity") -> c dir,
-      "uniqueness"^(String.sub s 7 (String.length s - 7))
-  | s when String.length s >= 3 &
-      let s' = String.sub s 0 3 in
-      s' = "gcd" -> c dir, "Zis_gcd"^(String.sub s 3 (String.length s - 3))
-  (* Default *)
-  | x -> [],x
-
-
-let id_of_v7_string s =
-  id_of_string (if !Options.v7 then s else snd (translate_v7_string empty_dirpath s))
-
-let v7_to_v8_dir_id dir id =
-  if Options.do_translate() then
-    let s = string_of_id id in
-    let dir',s =
-      if (is_coq_root (Lib.library_dp()) or is_coq_root dir)
-      then translate_v7_string dir s else [], s in
-    dir',id_of_string (translate_ident_string s)
-  else [],id
-
-let v7_to_v8_id id = snd (v7_to_v8_dir_id empty_dirpath id)
-
-let short_names =
-  List.map (fun x -> snd (snd x)) translation_table
-
-let is_new_name s =
-  Options.do_translate () &
-  (List.mem s short_names or
-  s = "comparison" or s = "CompOpp" or s = "Pmult" or
-  (String.length s >= 4 & String.sub s 0 4 = "Rabs") or
-  (String.length s >= 4 & String.sub s (String.length s - 3) 3 = "abs"
-                        & s.[0] = 'R') or
-  (String.length s >= 10 & String.sub s 0 10 = "uniqueness"))
-
-let v7_to_v8_dir fulldir dir =
-  if Options.do_translate () & dir <> empty_dirpath then
-    let update s =
-      let l = List.map string_of_id (repr_dirpath dir) in
-      make_dirpath (List.map id_of_string (s :: List.tl l))
-    in
-    let l = List.map string_of_id (repr_dirpath fulldir) in
-    if l = [ "List"; "Lists"; "Coq" ] then update "MonoList"
-    else if l = [ "PolyList"; "Lists"; "Coq" ] then update "List"
-    else dir
-  else dir
-
-let shortest_qualid_of_v7_global ctx ref =
-  let fulldir,_ = repr_path (sp_of_global ref) in
-  let dir,id = repr_qualid (shortest_qualid_of_global ctx ref) in
-  let dir',id = v7_to_v8_dir_id fulldir id in
-  let dir'' =
-    if dir' = [] then
-      (* A name that is not renamed *)
-      if dir = empty_dirpath & is_new_name (string_of_id id)
-      then 
-        (* An unqualified name that is not renamed but which coincides *)
-        (* with a new name: force qualification unless it is a variable *)
-        if fulldir <> empty_dirpath & not (is_coq_root fulldir)
-        then make_dirpath [List.hd (repr_dirpath fulldir)] 
-        else empty_dirpath
-      else v7_to_v8_dir fulldir dir
-    else
-      (* A stdlib name that has been renamed *)
-      try
-        let d,_ = repr_path (Nametab.full_name_cci (make_short_qualid id)) in
-        if not (is_coq_root d) then 
-          (* The user has defined id, then we qualify the new name *)
-          v7_to_v8_dir fulldir (make_dirpath (List.map id_of_string dir'))
-        else empty_dirpath
-      with Not_found -> v7_to_v8_dir fulldir dir in
-  make_qualid dir'' id
-
 let extern_reference loc vars r =
-  try Qualid (loc,shortest_qualid_of_v7_global vars r)
+  try Qualid (loc,shortest_qualid_of_global vars r)
   with Not_found ->
     (* happens in debugger *)
     Ident (loc,id_of_string (raw_string_of_ref r))
@@ -994,7 +135,7 @@ let rec check_same_pattern p1 p2 =
     | CPatCstr(_,c1,a1), CPatCstr(_,c2,a2) when c1=c2 ->
         List.iter2 check_same_pattern a1 a2
     | CPatAtom(_,r1), CPatAtom(_,r2) when r1=r2 -> ()
-    | CPatNumeral(_,i1), CPatNumeral(_,i2) when i1=i2 -> ()
+    | CPatPrim(_,i1), CPatPrim(_,i2) when i1=i2 -> ()
     | CPatDelimiters(_,s1,e1), CPatDelimiters(_,s2,e2) when s1=s2 ->
         check_same_pattern e1 e2
     | _ -> failwith "not same pattern"
@@ -1046,18 +187,15 @@ let rec check_same_type ty1 ty2 =
       List.iter2 (fun (_,pl1,r1) (_,pl2,r2) ->
         List.iter2 check_same_pattern pl1 pl2;
         check_same_type r1 r2) brl1 brl2
-  | COrderedCase(_,_,_,a1,bl1), COrderedCase(_,_,_,a2,bl2) ->
-      check_same_type a1 a2;
-      List.iter2 check_same_type bl1 bl2
   | CHole _, CHole _ -> ()
   | CPatVar(_,i1), CPatVar(_,i2) when i1=i2 -> ()
   | CSort(_,s1), CSort(_,s2) when s1=s2 -> ()
-  | CCast(_,a1,b1), CCast(_,a2,b2) ->
+  | CCast(_,a1,_,b1), CCast(_,a2,_,b2) ->
       check_same_type a1 a2;
       check_same_type b1 b2
   | CNotation(_,n1,e1), CNotation(_,n2,e2) when n1=n2 ->
       List.iter2 check_same_type e1 e2
-  | CNumeral(_,i1), CNumeral(_,i2) when i1=i2 -> ()
+  | CPrim(_,i1), CPrim(_,i2) when i1=i2 -> ()
   | CDelimiters(_,s1,e1), CDelimiters(_,s2,e2) when s1=s2 ->
       check_same_type e1 e2
   | _ when ty1=ty2 -> ()
@@ -1118,7 +256,7 @@ let rec same_raw c d =
       same_raw t1 t2; same_raw m1 m2
   | RCases(_,_,c1,b1), RCases(_,_,c2,b2) ->
       List.iter2
-        (fun (t1,{contents=(al1,oind1)}) (t2,{contents=(al2,oind2)}) ->
+        (fun (t1,(al1,oind1)) (t2,(al2,oind2)) ->
           same_raw t1 t2;
           if al1 <> al2 then failwith "RCases";
           option_iter2(fun (_,i1,nl1) (_,i2,nl2) ->
@@ -1126,9 +264,6 @@ let rec same_raw c d =
       List.iter2 (fun (_,_,pl1,b1) (_,_,pl2,b2) ->
         List.iter2 same_patt pl1 pl2;
         same_raw b1 b2) b1 b2
-  | ROrderedCase(_,_,_,c1,v1,_), ROrderedCase(_,_,_,c2,v2,_) ->
-      same_raw c1 c2;
-      array_iter2 same_raw v1 v2
   | RLetTuple(_,nl1,_,b1,c1), RLetTuple(_,nl2,_,b2,c2) ->
       if nl1<>nl2 then failwith "RLetTuple";
       same_raw b1 b2;
@@ -1147,8 +282,8 @@ let rec same_raw c d =
   | RSort(_,s1), RSort(_,s2) -> if s1<>s2 then failwith "RSort"
   | RHole _, _ -> ()
   | _, RHole _ -> ()
-  | RCast(_,c1,_),r2 -> same_raw c1 r2
-  | r1, RCast(_,c2,_) -> same_raw r1 c2
+  | RCast(_,c1,_,_),r2 -> same_raw c1 r2
+  | r1, RCast(_,c2,_,_) -> same_raw r1 c2
   | RDynamic(_,d1), RDynamic(_,d2) -> if d1<>d2 then failwith"RDynamic"
   | _ -> failwith "same_raw"
      
@@ -1174,7 +309,7 @@ and spaces ntn n =
   if n = String.length ntn then []
   else if ntn.[n] = ' ' then wildcards ntn (n+1) else spaces ntn (n+1)
 
-let expand_curly_brackets make_ntn ntn l =
+let expand_curly_brackets loc mknot ntn l =
   let ntn' = ref ntn in
   let rec expand_ntn i =
     function
@@ -1187,58 +322,45 @@ let expand_curly_brackets make_ntn ntn l =
             ntn' := 
               String.sub !ntn' 0 p ^ "_" ^ 
               String.sub !ntn' (p+5) (String.length !ntn' -p-5);
-            make_ntn "{ _ }" [a] end
+            mknot (loc,"{ _ }",[a]) end
           else a in
         a' :: expand_ntn (i+1) l in
   let l = expand_ntn 0 l in
   (* side effect *)
-  make_ntn !ntn' l
+  mknot (loc,!ntn',l)
 
-let make_notation loc ntn l =
-  if has_curly_brackets ntn
-  then expand_curly_brackets (fun n l -> CNotation (loc,n,l)) ntn l
-  else match ntn,l with
-    (* Special case to avoid writing "- 3" for e.g. (Zopp 3) *)
-    | "- _", [CNumeral(_,Bignat.POS p)] ->
-        CNotation (loc,ntn,[CNotation(loc,"( _ )",l)])
-    | _ -> CNotation (loc,ntn,l)
+let destPrim = function CPrim(_,t) -> Some t | _ -> None
+let destPatPrim = function CPatPrim(_,t) -> Some t | _ -> None
 
-let make_pat_notation loc ntn l =
+let make_notation_gen loc ntn mknot mkprim destprim l =
   if has_curly_brackets ntn
-  then expand_curly_brackets (fun n l -> CPatNotation (loc,n,l)) ntn l
-  else match ntn,l with
+  then expand_curly_brackets loc mknot ntn l
+  else match ntn,List.map destprim l with
     (* Special case to avoid writing "- 3" for e.g. (Zopp 3) *)
-    | "- _", [CPatNumeral(_,Bignat.POS p)] ->
-        CPatNotation (loc,ntn,[CPatNotation(loc,"( _ )",l)])
-    | _ -> CPatNotation (loc,ntn,l)
+    | "- _", [Some (Numeral p)] when Bigint.is_strictly_pos p ->
+        mknot (loc,ntn,[mknot (loc,"( _ )",l)])
+    | _ -> 
+	match decompose_notation_key ntn, l with
+	| [Terminal "-"; Terminal x], [] ->
+	    (try mkprim (loc, Numeral (Bigint.neg (Bigint.of_string x)))
+ 	     with _ -> mknot (loc,ntn,[]))
+	| [Terminal x], [] ->
+	    (try mkprim (loc, Numeral (Bigint.of_string x))
+ 	     with _ -> mknot (loc,ntn,[]))
+	| _ ->
+	    mknot (loc,ntn,l)
 
+let make_notation loc ntn l =
+  make_notation_gen loc ntn
+    (fun (loc,ntn,l) -> CNotation (loc,ntn,l))
+    (fun (loc,p) -> CPrim (loc,p))
+    destPrim l
 
-(*
-let rec cases_pattern_expr_of_constr_expr = function
-  | CRef r -> CPatAtom (dummy_loc,Some r)
-  | CHole loc -> CPatAtom (loc,None)
-  | CApp (loc,(proj,CRef c),l) when proj = None ->
-      let l,e = List.split l in
-      if not (List.for_all ((=) None) e) then
-	anomaly "Unexpected explicitation in pattern";
-      CPatCstr (loc,c,List.map cases_pattern_expr_of_constr_expr l)
-  | CNotation (loc,ntn,l) ->
-      CPatNotation (loc,ntn,List.map cases_pattern_expr_of_constr_expr l)
-  | CNumeral (loc,n) -> CPatNumeral (loc,n)
-  | CDelimiters (loc,s,e) -> 
-      CPatDelimiters (loc,s,cases_pattern_expr_of_constr_expr e)	
-  | _ -> anomaly "Constrextern: not a pattern"
-
-let rec rawconstr_of_cases_pattern = function
-  | PatVar (loc,Name id) -> RVar (loc,id)
-  | PatVar (loc,Anonymous) -> RHole (loc,InternalHole)
-  | PatCstr (loc,(ind,_ as c),args,_) -> 
-      let nparams = (snd (Global.lookup_inductive ind)).Declarations.mind_nparams in
-      let params = list_tabulate (fun _ -> RHole (loc,InternalHole)) nparams in
-      let args = params @ List.map rawconstr_of_cases_pattern args in
-      let f = RRef (loc,ConstructRef c) in
-      if args = [] then f else RApp (loc,f,args)
-*)
+let make_pat_notation loc ntn l =
+  make_notation_gen loc ntn
+    (fun (loc,ntn,l) -> CPatNotation (loc,ntn,l))
+    (fun (loc,p) -> CPatPrim (loc,p))
+    destPatPrim l
 
 let bind_env sigma var v =
   try
@@ -1251,10 +373,10 @@ let bind_env sigma var v =
 let rec match_cases_pattern metas sigma a1 a2 = match (a1,a2) with
   | r1, AVar id2 when List.mem id2 metas -> bind_env sigma id2 r1
   | PatVar (_,Anonymous), AHole _ -> sigma
-  | a, AHole _ when not(Options.do_translate()) -> sigma
+  | a, AHole _ -> sigma
   | PatCstr (loc,(ind,_ as r1),args1,Anonymous), _ ->
       let nparams =
-	(snd (Global.lookup_inductive ind)).Declarations.mind_nparams in
+	(fst (Global.lookup_inductive ind)).Declarations.mind_nparams in
       let l2 =
         match a2 with
 	  | ARef (ConstructRef r2) when r1 = r2 -> []
@@ -1281,32 +403,30 @@ let match_aconstr_cases_pattern c (metas_scl,pat) =
 let rec extern_cases_pattern_in_scope scopes vars pat =
   try 
     if !Options.raw_print or !print_no_symbol then raise No_match;
-    let (sc,n) = Symbols.uninterp_cases_numeral pat in
-    match Symbols.availability_of_numeral sc (make_current_scopes scopes) with
+    let (na,sc,p) = uninterp_prim_token_cases_pattern pat in
+    match availability_of_prim_token sc (make_current_scopes scopes) with
     | None -> raise No_match
     | Some key ->
-        let loc = pattern_loc pat in
-        insert_pat_delimiters (CPatNumeral (loc,n)) key
+      let loc = pattern_loc pat in
+      insert_pat_alias loc (insert_pat_delimiters loc (CPatPrim(loc,p)) key) na
   with No_match ->
   try 
     if !Options.raw_print or !print_no_symbol then raise No_match;
     extern_symbol_pattern scopes vars pat
-      (Symbols.uninterp_cases_pattern_notations pat)
+      (uninterp_cases_pattern_notations pat)
   with No_match ->
   match pat with
-  | PatVar (loc,Name id) -> CPatAtom (loc,Some (Ident (loc,v7_to_v8_id id)))
+  | PatVar (loc,Name id) -> CPatAtom (loc,Some (Ident (loc,id)))
   | PatVar (loc,Anonymous) -> CPatAtom (loc, None) 
   | PatCstr(loc,cstrsp,args,na) ->
       let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
       let p = CPatCstr
         (loc,extern_reference loc vars (ConstructRef cstrsp),args) in
-      (match na with
-	| Name id -> CPatAlias (loc,p,v7_to_v8_id id)
-	| Anonymous -> p)
+      insert_pat_alias loc p na
 	
 and extern_symbol_pattern (tmp_scope,scopes as allscopes) vars t = function
   | [] -> raise No_match
-  | (keyrule,pat,n as rule)::rules ->
+  | (keyrule,pat,n as _rule)::rules ->
       try
 	(* Check the number of arguments expected by the notation *)
 	let loc = match t,n with
@@ -1320,7 +440,7 @@ and extern_symbol_pattern (tmp_scope,scopes as allscopes) vars t = function
         match keyrule with
           | NotationRule (sc,ntn) ->
 	      let scopes' = make_current_scopes (tmp_scope, scopes) in
-	      (match Symbols.availability_of_notation (sc,ntn) scopes' with
+	      (match availability_of_notation (sc,ntn) scopes' with
                   (* Uninterpretation is not allowed in current context *)
               | None -> raise No_match
                   (* Uninterpretation is allowed in current context *)
@@ -1331,13 +451,16 @@ and extern_symbol_pattern (tmp_scope,scopes as allscopes) vars t = function
 		      extern_cases_pattern_in_scope 
 		        (scopt,List.fold_right push_scope scl scopes) vars c)
                       subst in
-		  insert_pat_delimiters (make_pat_notation loc ntn l) key)
+		  insert_pat_delimiters loc (make_pat_notation loc ntn l) key)
           | SynDefRule kn ->
 	      let qid = shortest_qualid_of_syndef vars kn in
- 	      CPatAtom (loc,Some (Qualid (loc, qid)))
+              CPatAtom (loc,Some (Qualid (loc, qid)))
       with
 	  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
+
 (**********************************************************************)
 (* Externalising applications *)
 
@@ -1354,24 +477,6 @@ let is_projection nargs = function
       with Not_found -> None)
   | _ -> None
 
-let is_nil = function
-  | [CRef ref] -> snd (repr_qualid (snd (qualid_of_reference ref))) = id_of_string "nil"
-  | _ -> false
-
-let stdlib_but_length args = function
-  | Some r -> 
-      let dir,id = repr_path (sp_of_global r) in
-      (is_coq_root (Lib.library_dp()) or is_coq_root dir)
-      && not (List.mem (string_of_id id) ["Zlength";"length"] && is_nil args)
-      && not (List.mem (string_of_id id) ["In"] && List.length args >= 2
-              && is_nil (List.tl args))
-  | None -> false
-
-let explicit_code imp q =
-  dummy_loc,
-  if !Options.v7 & not (Options.do_translate()) then ExplByPos q
-  else ExplByName (name_of_implicit imp)
-
 let is_hole = function CHole _ -> true | _ -> false
 
 let is_significant_implicit a impl tail =
@@ -1388,10 +493,12 @@ let explicitize loc inctx impl (cf,f) args =
           !Options.raw_print or
           (!print_implicits & !print_implicits_explicit_args) or 
 	  (is_significant_implicit a impl tail &
-	  (not (is_inferable_implicit inctx n imp) or
-	    (Options.do_translate() & not (stdlib_but_length args cf))))
+	  (not (is_inferable_implicit inctx n imp)))
 	in
-        if visible then (a,Some (explicit_code imp q)) :: tail else tail
+        if visible then 
+	  (a,Some (dummy_loc, ExplByName (name_of_implicit imp))) :: tail 
+	else
+	  tail
     | a::args, _::impl -> (a,None) :: exprec (q+1) (args,impl)
     | args, [] -> List.map (fun a -> (a,None)) args (*In case of polymorphism*)
     | [], _ -> [] in
@@ -1440,9 +547,7 @@ let rec extern_args extern scopes env args subscopes =
 
 let rec remove_coercions inctx = function
   | RApp (loc,RRef (_,r),args) as c
-      when
-        inctx &
-        not (!Options.raw_print or !print_coercions or Options.do_translate ())
+      when inctx & not (!Options.raw_print or !print_coercions)
       ->
       (try match Classops.hide_coercion r with
 	  | Some n when n < List.length args ->
@@ -1498,18 +603,18 @@ let rec share_fix_binders n rbl ty def =
 (* mapping rawterms to numerals (in presence of coercions, choose the *)
 (* one with no delimiter if possible)                                 *)
 
-let extern_possible_numeral scopes r =
+let extern_possible_prim_token scopes r =
   try
-    let (sc,n) = uninterp_numeral r in
-    match Symbols.availability_of_numeral sc (make_current_scopes scopes) with
+    let (sc,n) = uninterp_prim_token r in
+    match availability_of_prim_token sc (make_current_scopes scopes) with
     | None -> None
-    | Some key -> Some (insert_delimiters (CNumeral(loc_of_rawconstr r,n)) key)
+    | Some key -> Some (insert_delimiters (CPrim (loc_of_rawconstr r,n)) key)
   with No_match ->
     None
 
-let extern_optimal_numeral scopes r r' =
-  let c = extern_possible_numeral scopes r in
-  let c' = if r==r' then None else extern_possible_numeral scopes r' in
+let extern_optimal_prim_token scopes r r' =
+  let c = extern_possible_prim_token scopes r in
+  let c' = if r==r' then None else extern_possible_prim_token scopes r' in
   match c,c' with
   | Some n, (Some (CDelimiters _) | None) | _, Some n -> n
   | _ -> raise No_match
@@ -1521,17 +626,19 @@ let rec extern inctx scopes vars r =
   let r' = remove_coercions inctx r in
   try 
     if !Options.raw_print or !print_no_symbol then raise No_match;
-    extern_optimal_numeral scopes r r'
+    extern_optimal_prim_token scopes r r'
   with No_match ->
   try 
     if !Options.raw_print or !print_no_symbol then raise No_match;
-    extern_symbol scopes vars r' (Symbols.uninterp_notations r')
+    extern_symbol scopes vars r' (uninterp_notations r')
   with No_match -> match r' with
   | RRef (loc,ref) ->
-      extern_global loc (implicits_of_global_out ref)
+      extern_global loc (implicits_of_global ref)
         (extern_reference loc vars ref)
 
-  | RVar (loc,id) -> CRef (Ident (loc,v7_to_v8_id id))
+  | RVar (loc,id) -> CRef (Ident (loc,id))
+
+  | REvar (loc,n,None) when !print_meta_as_hole -> CHole loc
 
   | REvar (loc,n,_) -> (* we drop args *) extern_evar loc n
 
@@ -1540,50 +647,43 @@ let rec extern inctx scopes vars r =
   | RApp (loc,f,args) ->
       (match f with
 	 | RRef (rloc,ref) ->
-	     let subscopes = Symbols.find_arguments_scope ref in
+	     let subscopes = find_arguments_scope ref in
 	     let args =
 	       extern_args (extern true) (snd scopes) vars args subscopes in
-	     extern_app loc inctx (implicits_of_global_out ref)
+	     extern_app loc inctx (implicits_of_global ref)
                (Some ref,extern_reference rloc vars ref)
 	       args
-	 | RVar (rloc,id) -> (* useful for translation of inductive *)
-	     let args = List.map (sub_extern true scopes vars) args in
-	     extern_app loc inctx (get_temporary_implicits_out id)
-	       (None,Ident (rloc,v7_to_v8_id id))
-	       args
 	 | _       -> 
 	     explicitize loc inctx [] (None,sub_extern false scopes vars f)
                (List.map (sub_extern true scopes vars) args))
 
   | RProd (loc,Anonymous,t,c) ->
       (* Anonymous product are never factorized *)
-      CArrow (loc,extern_type scopes vars t, extern_type scopes vars c)
+      CArrow (loc,extern_typ scopes vars t, extern_typ scopes vars c)
 
   | RLetIn (loc,na,t,c) ->
-      let na = name_app translate_ident na in
       CLetIn (loc,(loc,na),sub_extern false scopes vars t,
               extern inctx scopes (add_vname vars na) c)
 
   | RProd (loc,na,t,c) ->
-      let t = extern_type scopes vars (anonymize_if_reserved na t) in
+      let t = extern_typ scopes vars (anonymize_if_reserved na t) in
       let (idl,c) = factorize_prod scopes (add_vname vars na) t c in
       CProdN (loc,[(dummy_loc,na)::idl,t],c)
 
   | RLambda (loc,na,t,c) ->
-      let t = extern_type scopes vars (anonymize_if_reserved na t) in
+      let t = extern_typ scopes vars (anonymize_if_reserved na t) in
       let (idl,c) = factorize_lambda inctx scopes (add_vname vars na) t c in
       CLambdaN (loc,[(dummy_loc,na)::idl,t],c)
 
-  | RCases (loc,(typopt,rtntypopt),tml,eqns) ->
-      let pred = option_app (extern_type scopes vars) typopt in
+  | RCases (loc,rtntypopt,tml,eqns) ->
       let vars' = 
 	List.fold_right (name_fold Idset.add)
 	  (cases_predicate_names tml) vars in
-      let rtntypopt' = option_app (extern_type scopes vars') !rtntypopt in
-      let tml = List.map (fun (tm,{contents=(na,x)}) ->
+      let rtntypopt' = option_app (extern_typ scopes vars') rtntypopt in
+      let tml = List.map (fun (tm,(na,x)) ->
         let na' = match na,tm with
             Anonymous, RVar (_,id) when 
-              !rtntypopt<>None & occur_rawconstr id (out_some !rtntypopt)
+              rtntypopt<>None & occur_rawconstr id (out_some rtntypopt)
               -> Some Anonymous
           | Anonymous, _ -> None
           | Name id, RVar (_,id') when id=id' -> None
@@ -1591,47 +691,24 @@ let rec extern inctx scopes vars r =
 	(sub_extern false scopes vars tm,
 	(na',option_app (fun (loc,ind,nal) ->
 	  let args = List.map (function
-	    | Anonymous -> RHole (dummy_loc,InternalHole) 
+	    | Anonymous -> RHole (dummy_loc,Evd.InternalHole) 
 	    | Name id -> RVar (dummy_loc,id)) nal in
 	  let t = RApp (dummy_loc,RRef (dummy_loc,IndRef ind),args) in
-	  (extern_type scopes vars t)) x))) tml in
-      let eqns = List.map (extern_eqn (typopt<>None) scopes vars) eqns in 
-      CCases (loc,(pred,rtntypopt'),tml,eqns)
-
-  | ROrderedCase (loc,cs,typopt,tm,bv,{contents = Some x}) ->
-      extern false scopes vars x
-
-  | ROrderedCase (loc,IfStyle,typopt,tm,bv,_) when Options.do_translate () ->
-      let rec strip_branches = function
-        | (RLambda (_,_,_,c1), RLambda (_,_,_,c2)) -> strip_branches (c1,c2)
-        | x -> x in
-      let c1,c2 = strip_branches (bv.(0),bv.(1)) in
-      msgerrnl (str "Warning: unable to ensure the correctness of the translation of an if-then-else");
-      let bv = Array.map (sub_extern (typopt<>None) scopes vars) [|c1;c2|] in
-      COrderedCase
-	(loc,IfStyle,option_app (extern_type scopes vars) typopt,
-         sub_extern false scopes vars tm,Array.to_list bv)
-      (* We failed type-checking If and to translate it to CIf *)
-      (* try to remove the dependances in branches anyway *)
-
-
-  | ROrderedCase (loc,cs,typopt,tm,bv,_) ->
-      let bv = Array.map (sub_extern (typopt<>None) scopes vars) bv in
-      COrderedCase
-	(loc,cs,option_app (extern_type scopes vars) typopt,
-         sub_extern false scopes vars tm,Array.to_list bv)
+	  (extern_typ scopes vars t)) x))) tml in
+      let eqns = List.map (extern_eqn (rtntypopt<>None) scopes vars) eqns in 
+      CCases (loc,rtntypopt',tml,eqns)
 
   | RLetTuple (loc,nal,(na,typopt),tm,b) ->
       CLetTuple (loc,nal,
         (option_app (fun _ -> na) typopt,
-         option_app (extern_type scopes (add_vname vars na)) typopt),
+         option_app (extern_typ scopes (add_vname vars na)) typopt),
         sub_extern false scopes vars tm,
         extern false scopes (List.fold_left add_vname vars nal) b)
 
   | RIf (loc,c,(na,typopt),b1,b2) ->
       CIf (loc,sub_extern false scopes vars c,
         (option_app (fun _ -> na) typopt,
-         option_app (extern_type scopes (add_vname vars na)) typopt),
+         option_app (extern_typ scopes (add_vname vars na)) typopt),
         sub_extern false scopes vars b1, sub_extern false scopes vars b2)
 
   | RRec (loc,fk,idv,blv,tyv,bv) ->
@@ -1640,17 +717,12 @@ let rec extern inctx scopes vars r =
 	 | RFix (nv,n) ->
 	     let listdecl = 
 	       Array.mapi (fun i fi ->
-                 let (bl,ty,def) =
-                   if Options.do_translate() then
-                     let n = List.fold_left
-                       (fun n (_,obd,_) -> if obd=None then n-1 else n)
-                       nv.(i) blv.(i) in
-                     share_fix_binders n (List.rev blv.(i)) tyv.(i) bv.(i)
-                   else blv.(i), tyv.(i), bv.(i) in
+                 let (bl,ty,def) = blv.(i), tyv.(i), bv.(i) in
                  let (ids,bl) = extern_local_binder scopes vars bl in
                  let vars0 = List.fold_right (name_fold Idset.add) ids vars in
                  let vars1 = List.fold_right (name_fold Idset.add) ids vars' in
-		 (fi,nv.(i), bl, extern_type scopes vars0 ty,
+		 let n, ro = fst nv.(i), extern_recursion_order scopes vars (snd nv.(i)) in
+		 (fi, (n, ro), bl, extern_typ scopes vars0 ty,
                   extern false scopes vars1 def)) idv
 	     in 
 	     CFix (loc,(loc,idv.(n)),Array.to_list listdecl)
@@ -1660,7 +732,7 @@ let rec extern inctx scopes vars r =
                  let (ids,bl) = extern_local_binder scopes vars blv.(i) in
                  let vars0 = List.fold_right (name_fold Idset.add) ids vars in
                  let vars1 = List.fold_right (name_fold Idset.add) ids vars' in
-		 (fi,bl,extern_type scopes vars0 tyv.(i),
+		 (fi,bl,extern_typ scopes vars0 tyv.(i),
                   sub_extern false scopes vars1 bv.(i))) idv
 	     in
 	     CCoFix (loc,(loc,idv.(n)),Array.to_list listdecl))
@@ -1674,30 +746,28 @@ let rec extern inctx scopes vars r =
 
   | RHole (loc,e) -> CHole loc
 
-  | RCast (loc,c,t) ->
-      CCast (loc,sub_extern true scopes vars c,extern_type scopes vars t)
+  | RCast (loc,c,k,t) ->
+      CCast (loc,sub_extern true scopes vars c,k,extern_typ scopes vars t)
 
   | RDynamic (loc,d) -> CDynamic (loc,d)
 
-and extern_type (_,scopes) = extern true (Some Symbols.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
   | RProd (loc,(Name id as na),ty,c)
-      when same aty (extern_type scopes vars (anonymize_if_reserved na ty))
+      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 *)
-	-> let id = translate_ident id in
-           let (nal,c) = factorize_prod scopes (Idset.add id vars) aty c in
+	-> let (nal,c) = factorize_prod scopes (Idset.add id vars) aty c in
            ((loc,Name id)::nal,c)
-  | c -> ([],extern_type scopes vars c)
+  | c -> ([],extern_typ scopes vars c)
 
 and factorize_lambda inctx scopes vars aty = function
   | RLambda (loc,na,ty,c)
-      when same aty (extern_type scopes vars (anonymize_if_reserved na ty))
+      when same aty (extern_typ scopes vars (anonymize_if_reserved na ty))
 	& not (occur_name na aty) (* To avoid na in ty' escapes scope *)
-	-> let na = name_app translate_ident na in
-           let (nal,c) =
+	-> let (nal,c) =
 	     factorize_lambda inctx scopes (add_vname vars na) aty c in
            ((loc,na)::nal,c)
   | c -> ([],sub_extern inctx scopes vars c)
@@ -1705,15 +775,13 @@ and factorize_lambda inctx scopes vars aty = function
 and extern_local_binder scopes vars = function
     [] -> ([],[])
   | (na,Some bd,ty)::l ->
-      let na = name_app translate_ident na in
       let (ids,l) =
         extern_local_binder scopes (name_fold Idset.add na vars) l in
       (na::ids,
        LocalRawDef((dummy_loc,na), extern false scopes vars bd) :: l)
       
   | (na,None,ty)::l ->
-      let na = name_app translate_ident na in
-      let ty = extern_type scopes vars (anonymize_if_reserved na ty) in
+      let ty = extern_typ scopes vars (anonymize_if_reserved na ty) in
       (match extern_local_binder scopes (name_fold Idset.add na vars) l with
           (ids,LocalRawAssum(nal,ty')::l)
             when same ty ty' &
@@ -1731,7 +799,7 @@ and extern_eqn inctx scopes vars (loc,ids,pl,c) =
 
 and extern_symbol (tmp_scope,scopes as allscopes) vars t = function
   | [] -> raise No_match
-  | (keyrule,pat,n as rule)::rules ->
+  | (keyrule,pat,n as _rule)::rules ->
       let loc = Rawterm.loc_of_rawconstr t in
       try
 	(* Adjusts to the number of arguments expected by the notation *)
@@ -1747,7 +815,7 @@ and extern_symbol (tmp_scope,scopes as allscopes) vars t = function
           match keyrule with
           | NotationRule (sc,ntn) ->
 	      let scopes' = make_current_scopes (tmp_scope, scopes) in
-	      (match Symbols.availability_of_notation (sc,ntn) scopes' with
+	      (match availability_of_notation (sc,ntn) scopes' with
                   (* Uninterpretation is not allowed in current context *)
               | None -> raise No_match
                   (* Uninterpretation is allowed in current context *)
@@ -1769,14 +837,16 @@ and extern_symbol (tmp_scope,scopes as allscopes) vars t = function
       with
 	  No_match -> extern_symbol allscopes vars t rules
 
-let extern_rawconstr vars c = 
-  extern false (None,Symbols.current_scopes()) vars c
+and extern_recursion_order scopes vars = function
+    RStructRec -> CStructRec
+  | RWfRec c -> CWfRec (extern true scopes vars c)
 
-let extern_rawtype vars c =
-  extern_type (None,Symbols.current_scopes()) vars c
 
-let extern_cases_pattern vars p = 
-  extern_cases_pattern_in_scope (None,Symbols.current_scopes()) vars p
+let extern_rawconstr vars c =
+  extern false (None,Notation.current_scopes()) vars c
+
+let extern_rawtype vars c =
+  extern_typ (None,Notation.current_scopes()) vars c
 
 (******************************************************************)
 (* Main translation function from constr -> constr_expr *)
@@ -1784,10 +854,10 @@ let extern_cases_pattern vars p =
 let loc = dummy_loc (* for constr and pattern, locations are lost *)
 
 let extern_constr_gen at_top scopt env t =
-  let vars = vars_of_env env in
   let avoid = if at_top then ids_of_context env else [] in
-  extern (not at_top) (scopt,Symbols.current_scopes()) vars
-    (Detyping.detype (at_top,env) avoid (names_of_rel_context env) t)
+  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
 
 let extern_constr_in_scope at_top scope env t =
   extern_constr_gen at_top (Some scope) env t
@@ -1795,13 +865,18 @@ let extern_constr_in_scope at_top scope env t =
 let extern_constr at_top env t =
   extern_constr_gen at_top None env t
 
+let extern_type at_top 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
+  extern_rawtype (vars_of_env env) r
+
 (******************************************************************)
 (* Main translation function from pattern -> constr_expr *)
 
-let rec raw_of_pat tenv env = function
+let rec raw_of_pat env = function
   | PRef ref -> RRef (loc,ref)
   | PVar id -> RVar (loc,id)
-  | PEvar (n,l) -> REvar (loc,n,Some (array_map_to_list (raw_of_pat tenv env) l))
+  | PEvar (n,l) -> REvar (loc,n,Some (array_map_to_list (raw_of_pat env) l))
   | PRel n ->
       let id = try match lookup_name_of_rel n env with
 	| Name id   -> id
@@ -1809,37 +884,41 @@ let rec raw_of_pat tenv env = function
 	    anomaly "rawconstr_of_pattern: index to an anonymous variable"
       with Not_found -> id_of_string ("[REL "^(string_of_int n)^"]") in
       RVar (loc,id)
-  | PMeta None -> RHole (loc,InternalHole)
+  | PMeta None -> RHole (loc,Evd.InternalHole)
   | PMeta (Some n) -> RPatVar (loc,(false,n))
   | PApp (f,args) ->
-      RApp (loc,raw_of_pat tenv env f,array_map_to_list (raw_of_pat tenv env) args)
+      RApp (loc,raw_of_pat env f,array_map_to_list (raw_of_pat env) args)
   | PSoApp (n,args) ->
       RApp (loc,RPatVar (loc,(true,n)),
-        List.map (raw_of_pat tenv env) args)
+        List.map (raw_of_pat env) args)
   | PProd (na,t,c) ->
-      RProd (loc,na,raw_of_pat tenv env t,raw_of_pat tenv (na::env) c)
+      RProd (loc,na,raw_of_pat env t,raw_of_pat (na::env) c)
   | PLetIn (na,t,c) ->
-      RLetIn (loc,na,raw_of_pat tenv env t, raw_of_pat tenv (na::env) c)
+      RLetIn (loc,na,raw_of_pat env t, raw_of_pat (na::env) c)
   | PLambda (na,t,c) ->
-      RLambda (loc,na,raw_of_pat tenv env t, raw_of_pat tenv (na::env) c)
-  | PCase ((_,(IfStyle|LetStyle as cs)),typopt,tm,bv) ->
-      ROrderedCase (loc,cs,option_app (raw_of_pat tenv env) typopt,
-         raw_of_pat tenv env tm,Array.map (raw_of_pat tenv env) bv, ref None)
+      RLambda (loc,na,raw_of_pat env t, raw_of_pat (na::env) c)
   | PCase ((_,cs),typopt,tm,[||]) ->
-      RCases (loc,(option_app (raw_of_pat tenv env) typopt,ref None (* TODO *)),
-         [raw_of_pat tenv env tm,ref (Anonymous,None)],[])
+      if typopt <> None then failwith "TODO: PCase to RCases";
+      RCases (loc,(*(option_app (raw_of_pat env) typopt,*)None,
+         [raw_of_pat env tm,(Anonymous,None)],[])
   | PCase ((Some ind,cs),typopt,tm,bv) ->
       let avoid = List.fold_right (name_fold (fun x l -> x::l)) env [] in
-      let k = (snd (lookup_mind_specif (Global.env()) ind)).Declarations.mind_nrealargs in
-      Detyping.detype_case false (raw_of_pat tenv env)(raw_of_eqn tenv env)
+      let mib,mip = lookup_mind_specif (Global.env()) ind in
+      let k = mip.Declarations.mind_nrealargs in
+      let nparams = mib.Declarations.mind_nparams in
+      let cstrnargs = mip.Declarations.mind_consnrealdecls in
+      Detyping.detype_case false (raw_of_pat env) (raw_of_eqns env)
 	(fun _ _ -> false (* lazy: don't try to display pattern with "if" *))
-	tenv avoid ind cs typopt k tm bv
+	avoid (ind,cs,nparams,cstrnargs,k) typopt tm bv
   | PCase _ -> error "Unsupported case-analysis while printing pattern"
-  | PFix f -> Detyping.detype (false,tenv) [] env (mkFix f)
-  | PCoFix c -> Detyping.detype (false,tenv) [] env (mkCoFix c)
+  | PFix f -> Detyping.detype false [] env (mkFix f)
+  | PCoFix c -> Detyping.detype false [] env (mkCoFix c)
   | PSort s -> RSort (loc,s)
 
-and raw_of_eqn tenv env constr construct_nargs branch =
+and raw_of_eqns env constructs consnargsl bl =
+  Array.to_list (array_map3 (raw_of_eqn env) constructs consnargsl bl)
+
+and raw_of_eqn env constr construct_nargs branch =
   let make_pat x env b ids =
     let avoid = List.fold_right (name_fold (fun x l -> x::l)) env [] in
     let id = next_name_away_with_default "x" x avoid in
@@ -1849,7 +928,7 @@ and raw_of_eqn tenv env constr construct_nargs branch =
     if n=0 then
       (dummy_loc, ids, 
        [PatCstr(dummy_loc, constr, List.rev patlist,Anonymous)],
-       raw_of_pat tenv env b)
+       raw_of_pat env b)
     else
       match b with
 	| PLambda (x,_,b) -> 
@@ -1865,6 +944,6 @@ and raw_of_eqn tenv env constr construct_nargs branch =
   in 
   buildrec [] [] env construct_nargs branch
 
-let extern_pattern tenv env pat =
-  extern true (None,Symbols.current_scopes()) Idset.empty
-    (raw_of_pat tenv env pat)
+let extern_constr_pattern env pat =
+  extern true (None,Notation.current_scopes()) Idset.empty
+    (raw_of_pat env pat)
diff --git a/interp/constrextern.mli b/interp/constrextern.mli
index 0dcdffeb..1fc44250 100644
--- a/interp/constrextern.mli
+++ b/interp/constrextern.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: constrextern.mli,v 1.11.2.3 2005/01/21 16:41:50 herbelin Exp $ i*)
+(*i $Id: constrextern.mli 7837 2006-01-11 09:47:32Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -20,13 +20,10 @@ open Nametab
 open Rawterm
 open Pattern
 open Topconstr
-open Symbols
+open Notation
 (*i*)
 
 (* v7->v8 translation *)
-val id_of_v7_string : string -> identifier
-val v7_to_v8_id : identifier -> identifier (* v7->v8 translation *)
-val shortest_qualid_of_v7_global : Idset.t -> global_reference -> qualid
 val check_same_type : constr_expr -> constr_expr -> unit
 
 (* Translation of pattern, cases pattern, rawterm and term into syntax
@@ -35,7 +32,7 @@ val check_same_type : constr_expr -> constr_expr -> unit
 val extern_cases_pattern : Idset.t -> cases_pattern -> cases_pattern_expr
 val extern_rawconstr : Idset.t -> rawconstr -> constr_expr
 val extern_rawtype : Idset.t -> rawconstr -> constr_expr
-val extern_pattern : env -> names_context -> constr_pattern -> constr_expr
+val extern_constr_pattern : names_context -> constr_pattern -> constr_expr
 
 (* If [b=true] in [extern_constr b env c] then the variables in the first 
    level of quantification clashing with the variables in [env] are renamed *)
@@ -43,6 +40,7 @@ val extern_pattern : env -> names_context -> constr_pattern -> constr_expr
 val extern_constr : bool -> env -> constr -> constr_expr
 val extern_constr_in_scope : bool -> scope_name -> env -> constr -> constr_expr
 val extern_reference : loc -> Idset.t -> global_reference -> reference
+val extern_type : bool -> env -> types -> constr_expr
 
 (* Printing options *)
 val print_implicits : bool ref
@@ -71,7 +69,3 @@ val without_symbols : ('a -> 'b) -> 'a -> 'b
 
 (* This prints metas as anonymous holes *)
 val with_meta_as_hole : ('a -> 'b) -> 'a -> 'b
-
-(* For v8 translation *)
-val set_temporary_implicits_out :
-  (identifier * Impargs.implicits_list) list -> unit
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index bacdb387..6fcd9d7a 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: constrintern.ml,v 1.58.2.7 2005/11/19 10:34:35 herbelin Exp $ *)
+(* $Id: constrintern.ml 8654 2006-03-22 15:36:58Z msozeau $ *)
 
 open Pp
 open Util
@@ -18,9 +18,10 @@ open Impargs
 open Rawterm
 open Pattern
 open Pretyping
+open Cases
 open Topconstr
 open Nametab
-open Symbols
+open Notation
 
 (* To interpret implicits and arg scopes of recursive variables in
    inductive types and recursive definitions *)
@@ -42,10 +43,6 @@ let for_grammar f x =
 
 let variables_bind = ref false
 
-(* For the translator *)
-let temporary_implicits_in = ref []
-let set_temporary_implicits_in l = temporary_implicits_in := l
-
 (**********************************************************************)
 (* Internalisation errors                                             *)
 
@@ -154,10 +151,8 @@ let add_glob loc ref =
   i*)
   let sp = Nametab.sp_of_global ref in
   let id = let _,id = repr_path sp in string_of_id id in
-  let dir = Lib.file_part ref in
-  if dir <> None then
-    let dp = string_of_dirpath (out_some dir) in
-    dump_string (Printf.sprintf "R%d %s.%s\n" (fst (unloc loc)) dp id)
+  let dp = string_of_dirpath (Lib.library_part ref) in
+  dump_string (Printf.sprintf "R%d %s.%s\n" (fst (unloc loc)) dp id)
 
 let loc_of_notation f loc args ntn =
   if args=[] or ntn.[0] <> '_' then fst (unloc loc)
@@ -166,20 +161,19 @@ let loc_of_notation f loc args ntn =
 let ntn_loc = loc_of_notation constr_loc
 let patntn_loc = loc_of_notation cases_pattern_loc
 
-let dump_notation_location =
-  fun pos ntn ((path,df),sc) ->
-    let rec next growing =
-      let loc = Lexer.location_function !token_number in
-      let (bp,_) = unloc loc in
-      if growing then if bp >= pos then loc else (incr token_number;next true)
-      else if bp = pos then loc
-      else if bp > pos then (decr token_number;next false)
-      else (incr token_number;next true) in
-    let loc = next (pos >= !last_pos) in
-    last_pos := pos;
-    let path = string_of_dirpath path in
-    let sc = match sc with Some sc -> " "^sc | None -> "" in
-    dump_string (Printf.sprintf "R%d %s \"%s\"%s\n" (fst (unloc loc)) path df sc)
+let dump_notation_location pos ((path,df),sc) =
+  let rec next growing =
+    let loc = Lexer.location_function !token_number in
+    let (bp,_) = unloc loc in
+    if growing then if bp >= pos then loc else (incr token_number;next true)
+    else if bp = pos then loc
+    else if bp > pos then (decr token_number;next false)
+    else (incr token_number;next true) in
+  let loc = next (pos >= !last_pos) in
+  last_pos := pos;
+  let path = string_of_dirpath path in
+  let sc = match sc with Some sc -> " "^sc | None -> "" in
+  dump_string (Printf.sprintf "R%d %s \"%s\"%s\n" (fst (unloc loc)) path df sc)
 
 (**********************************************************************)
 (* Contracting "{ _ }" in notations *)
@@ -249,15 +243,14 @@ let set_var_scope loc id (_,scopt,scopes) varscopes =
    [vars2] is the set of global variables, env is the set of variables
    abstracted until this point *)
 
-let intern_var (env,_,_ as genv) (ltacvars,vars2,vars3,_,impls) loc id =
+let intern_var (env,_,_ as genv) (ltacvars,vars2,vars3,(_,impls)) loc id =
   let (vars1,unbndltacvars) = ltacvars in
   (* Is [id] an inductive type potentially with implicit *)
   try
     let l,impl,argsc = List.assoc id impls in
     let l = List.map 
       (fun id -> CRef (Ident (loc,id)), Some (loc,ExplByName id)) l in
-    RVar (loc,id), impl, argsc,
-    (if !Options.v7 & !interning_grammar then [] else l)
+    RVar (loc,id), impl, argsc, l
   with Not_found ->
   (* Is [id] bound in current env or is an ltac var bound to constr *)
   if Idset.mem id env or List.mem id vars1
@@ -273,7 +266,7 @@ let intern_var (env,_,_ as genv) (ltacvars,vars2,vars3,_,impls) loc id =
   try
     match List.assoc id unbndltacvars with
       | None -> user_err_loc (loc,"intern_var",
-	  pr_id id ++ str " ist not bound to a term")
+	  str "variable " ++ pr_id id ++ str " should be bound to a term")
       | Some id0 -> Pretype_errors.error_var_not_found_loc loc id0
   with Not_found ->
   (* Is [id] a goal or section variable *)
@@ -287,7 +280,7 @@ let intern_var (env,_,_ as genv) (ltacvars,vars2,vars3,_,impls) loc id =
     (* [id] a goal variable *)
     RVar (loc,id), [], [], []
 
-let find_appl_head_data (_,_,_,_,impls) = function
+let find_appl_head_data (_,_,_,(_,impls)) = function
   | RRef (_,ref) as x -> x,implicits_of_global ref,find_arguments_scope ref,[]
   | x -> x,[],[],[]
 
@@ -320,13 +313,6 @@ let intern_reference env lvar = function
   | Qualid (loc, qid) ->
       find_appl_head_data lvar (intern_qualid loc qid)
   | Ident (loc, id) ->
-      (* For old ast syntax compatibility *)
-      if (string_of_id id).[0] = '$' then RVar (loc,id),[],[],[] else
-      (* End old ast syntax compatibility *)
-      (* Pour traduction des implicites d'inductifs et points-fixes *)
-      try RVar (loc,id), List.assoc id !temporary_implicits_in, [], []
-      with Not_found ->
-      (* Fin pour traduction *)
       try intern_var env lvar loc id
       with Not_found -> 
       try find_appl_head_data lvar (intern_qualid loc (make_short_qualid id))
@@ -336,10 +322,10 @@ let intern_reference env lvar = function
 	else raise e
 
 let interp_reference vars r =
-  let (r,_,_,_) = intern_reference (Idset.empty,None,[]) (vars,[],[],[],[]) r 
+  let r,_,_,_ = intern_reference (Idset.empty,None,[]) (vars,[],[],([],[])) r 
   in r
 
-let apply_scope_env (ids,_,scopes as env) = function
+let apply_scope_env (ids,_,scopes) = function
   | [] -> (ids,None,scopes), []
   | sc::scl -> (ids,sc,scopes), scl
 
@@ -357,6 +343,21 @@ let rec simple_adjust_scopes = function
 (**********************************************************************)
 (* Cases                                                              *)
 
+let product_of_cases_patterns ids idspl =
+  List.fold_right (fun (ids,pl) (ids',ptaill) ->
+    (ids@ids',
+    (* Cartesian prod of the or-pats for the nth arg and the tail args *)
+    List.flatten (
+    List.map (fun (subst,p) ->
+      List.map (fun (subst',ptail) -> (subst@subst',p::ptail)) ptaill) pl)))
+    idspl (ids,[[],[]])
+
+let simple_product_of_cases_patterns pl =
+  List.fold_right (fun pl ptaill ->
+    List.flatten (List.map (fun (subst,p) ->
+      List.map (fun (subst',ptail) -> (subst@subst',p::ptail)) ptaill) pl))
+    pl [[],[]]
+
 (* Check linearity of pattern-matching *)
 let rec has_duplicate = function 
   | [] -> None
@@ -372,32 +373,33 @@ let check_linearity lhs ids =
     | None ->
 	()
 
-(* Warns if some pattern variable starts with uppercase *)
-let check_uppercase loc ids =
-(* A quoi ça sert ? Pour l'extraction vers ML ? Maintenant elle est externe
-  let is_uppercase_var v =
-    match (string_of_id v).[0] with 'A'..'Z' -> true | _  -> false
-  in
-  let warning_uppercase loc uplid =
-    let vars = h 0 (prlist_with_sep pr_coma pr_id uplid) in
-    let (s1,s2) = if List.length uplid = 1 then (" ","s ") else ("s "," ") in
-    warn (str ("the variable"^s1) ++ vars ++
-	  str (" start"^s2^"with an upper case letter in pattern")) in
-  let uplid = List.filter is_uppercase_var ids in
-  if uplid <> [] then warning_uppercase loc uplid
-*)
-  ()
-
 (* Match the number of pattern against the number of matched args *)
 let check_number_of_pattern loc n l =
   let p = List.length l in
   if n<>p then raise (InternalisationError (loc,BadPatternsNumber (n,p)))
 
+let check_or_pat_variables loc ids idsl =
+  if List.exists ((<>) ids) idsl then
+    user_err_loc (loc, "", str 
+    "The components of this disjunctive pattern must bind the same variables")
+
+let check_constructor_length env loc cstr pl pl0 =
+  let n = List.length pl + List.length pl0 in
+  let nargs = Inductiveops.constructor_nrealargs env cstr in
+  let nhyps = Inductiveops.constructor_nrealhyps env cstr in
+  if n <> nargs && n <> nhyps (* i.e. with let's *) then
+    error_wrong_numarg_constructor_loc loc env cstr nargs
+
+let check_inductive_length env (loc,ind,nal) =
+  let n = Inductiveops.inductive_nargs env ind in
+  if n <> List.length nal then
+    error_wrong_numarg_inductive_loc loc env ind n
+
 (* Manage multiple aliases *)
 
   (* [merge_aliases] returns the sets of all aliases encountered at this
      point and a substitution mapping extra aliases to the first one *)
-let merge_aliases (ids,subst as aliases) id =
+let merge_aliases (ids,subst as _aliases) id =
   ids@[id], if ids=[] then subst else (id, List.hd ids)::subst
 
 let alias_of = function
@@ -414,13 +416,15 @@ let decode_patlist_value = function
   | CPatCstr (_,_,l) -> l
   | _ -> anomaly "Ill-formed list argument of notation"
 
-let rec subst_pat_iterator y t = function
+let rec subst_pat_iterator y t (subst,p) = match p with
   | PatVar (_,id) as x ->
-      if id = Name y then t else x
+      if id = Name y then t else [subst,x]
   | PatCstr (loc,id,l,alias) ->
-      PatCstr (loc,id,List.map (subst_pat_iterator y t) l,alias)
+      let l' = List.map (fun a -> (subst_pat_iterator y t ([],a))) l in
+      let pl = simple_product_of_cases_patterns l' in
+      List.map (fun (subst',pl) -> subst'@subst,PatCstr (loc,id,pl,alias)) pl
 
-let subst_cases_pattern loc aliases intern subst scopes a =
+let subst_cases_pattern loc (ids,asubst as aliases) intern subst scopes a =
   let rec aux aliases subst = function
   | AVar id ->
       begin
@@ -430,7 +434,7 @@ let subst_cases_pattern loc aliases intern subst scopes a =
 	  let (a,(scopt,subscopes)) = List.assoc id subst in
 	  intern (subscopes@scopes) ([],[]) scopt a
 	with Not_found -> 
-	  if id = ldots_var then [[],[]], PatVar (loc,Name id) else
+	  if id = ldots_var then [],[[], PatVar (loc,Name id)] else
 	  anomaly ("Unbound pattern notation variable: "^(string_of_id id))
 	  (*
 	  (* Happens for local notation joint with inductive/fixpoint defs *)
@@ -440,24 +444,28 @@ let subst_cases_pattern loc aliases intern subst scopes a =
 	  *)
       end
   | ARef (ConstructRef c) ->
-      [aliases], PatCstr (loc,c, [], alias_of aliases)
+      (ids,[asubst, PatCstr (loc,c, [], alias_of aliases)])
   | AApp (ARef (ConstructRef (ind,_ as c)),args) ->
-      let nparams = (snd (Global.lookup_inductive ind)).Declarations.mind_nparams in
+      let nparams = (fst (Global.lookup_inductive ind)).Declarations.mind_nparams in
       let _,args = list_chop nparams args in
-      let (idsl,pl) = List.split (List.map (aux ([],[]) subst) args) in
-      aliases::List.flatten idsl, PatCstr (loc,c,pl,alias_of aliases)
+      let idslpll = List.map (aux ([],[]) subst) args in
+      let ids',pll = product_of_cases_patterns ids idslpll in
+      let pl' = List.map (fun (subst,pl) -> 
+        subst,PatCstr (loc,c,pl,alias_of aliases)) pll in
+      ids', pl'
   | AList (x,_,iter,terminator,lassoc) ->
       (try 
         (* All elements of the list are in scopes (scopt,subscopes) *)
 	let (a,(scopt,subscopes)) = List.assoc x subst in
-        let idslt,termin = aux ([],[]) subst terminator in
+        let termin = aux ([],[]) subst terminator in
         let l = decode_patlist_value a in
         let idsl,v =
-	  List.fold_right (fun a (allidsl,t) -> 
-            let idsl,u = aux ([],[]) ((x,(a,(scopt,subscopes)))::subst) iter in
-            idsl::allidsl, subst_pat_iterator ldots_var t u)
-            (if lassoc then List.rev l else l) ([idslt],termin) in
-        aliases::List.flatten idsl, v
+	  List.fold_right (fun a (tids,t) -> 
+            let uids,u = aux ([],[]) ((x,(a,(scopt,subscopes)))::subst) iter in
+            let pll = List.map (subst_pat_iterator ldots_var t) u in
+            tids@uids, List.flatten pll)
+            (if lassoc then List.rev l else l) termin in
+        ids@idsl, v
       with Not_found -> 
           anomaly "Inconsistent substitution of recursive notation")
   | t -> user_err_loc (loc,"",str "Invalid notation for pattern")
@@ -476,7 +484,7 @@ let rec patt_of_rawterm loc cstr =
     | RApp (_,RApp(_,h,l1),l2) -> patt_of_rawterm loc (RApp(loc,h,l1@l2))
     | RApp (_,RRef(_,(ConstructRef c as x)),pl) ->
         if !dump then add_glob loc x;
-        let (_,mib) = Inductive.lookup_mind_specif (Global.env()) (fst c) in
+        let (mib,_) = Inductive.lookup_mind_specif (Global.env()) (fst c) in
         let npar = mib.Declarations.mind_nparams in
         let (params,args) =
           if List.length pl <= npar then (pl,[]) else
@@ -506,7 +514,7 @@ let find_constructor ref =
         let rec unf = function
           | ConstRef cst ->
 	      let v = Environ.constant_value (Global.env()) cst in
-              unf (reference_of_constr v)
+              unf (global_of_constr v)
           | ConstructRef c -> 
 	      if !dump then add_glob loc r; 
 	      c, []
@@ -524,7 +532,7 @@ let maybe_constructor ref =
     | InternalisationError _ -> VarPat (find_pattern_variable ref)
       (* patt var also exists globally but does not satisfy preconditions *)
     | (Environ.NotEvaluableConst _ | Not_found) ->
-        warn (str "pattern " ++ pr_reference ref ++
+        if_verbose msg_warning (str "pattern " ++ pr_reference ref ++
               str " is understood as a pattern variable");
         VarPat (find_pattern_variable ref)
 
@@ -533,48 +541,63 @@ let mustbe_constructor loc ref =
   with (Environ.NotEvaluableConst _ | Not_found) ->
     raise (InternalisationError (loc,NotAConstructor ref))
 
-let rec intern_cases_pattern scopes aliases tmp_scope = function
+let rec intern_cases_pattern genv scopes (ids,subst as aliases) tmp_scope = 
+  function
   | CPatAlias (loc, p, id) ->
       let aliases' = merge_aliases aliases id in
-      intern_cases_pattern scopes aliases' tmp_scope p
+      intern_cases_pattern genv scopes aliases' tmp_scope p
   | CPatCstr (loc, head, pl) ->
       let c,pl0 = mustbe_constructor loc head in
       let argscs =
 	simple_adjust_scopes (find_arguments_scope (ConstructRef c), pl) in
-      let (idsl,pl') =
-	List.split (List.map2 (intern_cases_pattern scopes ([],[])) argscs pl)
-      in
-      (aliases::(List.flatten idsl), PatCstr (loc,c,pl0@pl',alias_of aliases))
-  | CPatNotation (loc,"- _",[CPatNumeral(_,Bignat.POS p)]) ->
-      let scopes = option_cons tmp_scope scopes in
-      ([aliases],
-      Symbols.interp_numeral_as_pattern loc (Bignat.NEG p)
-        (alias_of aliases) scopes)
+      check_constructor_length genv loc c pl0 pl;
+      let idslpl =
+	List.map2 (intern_cases_pattern genv scopes ([],[])) argscs pl in
+      let (ids',pll) = product_of_cases_patterns ids idslpl in
+      let pl' = List.map (fun (subst,pl) ->
+        (subst, PatCstr (loc,c,pl0@pl,alias_of aliases))) pll in
+      ids',pl'
+  | CPatNotation (loc,"- _",[CPatPrim(_,Numeral p)]) 
+      when Bigint.is_strictly_pos p ->
+      let np = Numeral (Bigint.neg p) in
+      intern_cases_pattern genv scopes aliases tmp_scope (CPatPrim(loc,np))
   | CPatNotation (_,"( _ )",[a]) ->
-      intern_cases_pattern scopes aliases tmp_scope a
+      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) = Symbols.interp_notation loc ntn scopes in
-      if !dump then dump_notation_location (patntn_loc loc args ntn) ntn df;
+      let ((ids,c),df) = Notation.interp_notation loc ntn 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 subst scopes c
-  | CPatNumeral (loc, n) ->
+      subst_cases_pattern loc aliases (intern_cases_pattern genv) subst scopes 
+	c
+  | CPatPrim (loc, p) ->
       let scopes = option_cons tmp_scope scopes in
-      ([aliases],
-      Symbols.interp_numeral_as_pattern loc n (alias_of aliases) scopes)
+      let a = alias_of aliases in
+      let (c,df) = Notation.interp_prim_token_cases_pattern loc p a scopes in
+      if !dump then dump_notation_location (fst (unloc loc)) df;
+      (ids,[subst,c])
   | CPatDelimiters (loc, key, e) ->
-      intern_cases_pattern (find_delimiters_scope loc key::scopes)
+      intern_cases_pattern genv (find_delimiters_scope loc key::scopes)
         aliases None e
   | CPatAtom (loc, Some head) ->
       (match maybe_constructor head with
 	 | ConstrPat (c,args) ->
-	     ([aliases], PatCstr (loc,c,args,alias_of aliases))
+	     check_constructor_length genv loc c [] [];
+	     (ids,[subst, PatCstr (loc,c,args,alias_of aliases)])
 	 | VarPat id ->
-	     let aliases = merge_aliases aliases id in
-	     ([aliases], PatVar (loc,alias_of aliases)))
+	     let ids,subst = merge_aliases aliases id in
+	     (ids,[subst, PatVar (loc,alias_of (ids,subst))]))
   | CPatAtom (loc, None) ->
-      ([aliases], PatVar (loc,alias_of aliases))
+      (ids,[subst, PatVar (loc,alias_of aliases)])
+  | CPatOr (loc, pl) ->
+      assert (pl <> []);
+      let pl' = 
+	List.map (intern_cases_pattern genv scopes aliases tmp_scope) pl in
+      let (idsl,pl') = List.split pl' in
+      let ids = List.hd idsl in
+      check_or_pat_variables loc ids (List.tl idsl);
+      (ids,List.flatten pl')
 
 (**********************************************************************)
 (* Fix and CoFix                                                      *)
@@ -593,10 +616,10 @@ let locate_if_isevar loc na = function
       (try match na with
 	| Name id ->  Reserve.find_reserved_type id
 	| Anonymous -> raise Not_found 
-      with Not_found -> RHole (loc, BinderType na))
+      with Not_found -> RHole (loc, Evd.BinderType na))
   | x -> x
 
-let check_hidden_implicit_parameters id (_,_,_,indnames,_) =
+let check_hidden_implicit_parameters id (_,_,_,(indnames,_)) =
   if List.mem id indnames then
     errorlabstrm "" (str "A parameter or name of an inductive type " ++
     pr_id id ++ str " must not be used as a bound variable in the type \
@@ -624,8 +647,8 @@ let check_projection isproj nargs r =
   | RRef (loc, ref), Some _ ->
       (try
 	let n = Recordops.find_projection_nparams ref + 1 in
-	if nargs < n then 
-	  user_err_loc (loc,"",str "Projection has not enough parameters");
+	if nargs <> n then
+	  user_err_loc (loc,"",str "Projection has not the right number of explicit parameters");
       with Not_found -> 
 	user_err_loc
 	(loc,"",pr_global_env Idset.empty ref ++ str " is not a registered projection"))
@@ -633,12 +656,11 @@ let check_projection isproj nargs r =
   | _, None -> ()
 
 let get_implicit_name n imps =
-  if !Options.v7 then None
-  else Some (Impargs.name_of_implicit (List.nth imps (n-1)))
+  Some (Impargs.name_of_implicit (List.nth imps (n-1)))
 
 let set_hole_implicit i = function
-  | RRef (loc,r) -> (loc,ImplicitArg (r,i))
-  | RVar (loc,id) -> (loc,ImplicitArg (VarRef id,i))
+  | RRef (loc,r) -> (loc,Evd.ImplicitArg (r,i))
+  | RVar (loc,id) -> (loc,Evd.ImplicitArg (VarRef id,i))
   | _ -> anomaly "Only refs have implicits"
 
 let exists_implicit_name id =
@@ -679,18 +701,12 @@ let extract_explicit_arg imps args =
 (**********************************************************************)
 (* Syntax extensions                                                  *)
 
-let coerce_to_id = function
-  | CRef (Ident (_,id)) -> id 
-  | c ->
-      user_err_loc (constr_loc c, "subst_rawconstr",
-        str"This expression should be a simple identifier")
-
 let traverse_binder subst id (ids,tmpsc,scopes as env) =
   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 *)
-    let id' = coerce_to_id (fst (List.assoc id subst)) in
+    let _,id' = coerce_to_id (fst (List.assoc id subst)) in
     id', (Idset.add id' ids,tmpsc,scopes)
   with Not_found ->
     id, env
@@ -703,7 +719,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 (ids,_,scopes as _env) =
   function
   | AVar id ->
       begin
@@ -739,13 +755,13 @@ let rec subst_aconstr_in_rawconstr loc interp subst (ids,_,scopes as env) =
 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) = Symbols.interp_notation loc ntn scopes in
-  if !dump then dump_notation_location (ntn_loc loc args ntn) ntn df;
+  let ((ids,c),df) = Notation.interp_notation loc ntn 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
 
 let set_type_scope (ids,tmp_scope,scopes) =
-  (ids,Some Symbols.type_scope,scopes)
+  (ids,Some Notation.type_scope,scopes)
 
 let reset_tmp_scope (ids,tmp_scope,scopes) =
   (ids,None,scopes)
@@ -753,7 +769,7 @@ let reset_tmp_scope (ids,tmp_scope,scopes) =
 (**********************************************************************)
 (* Main loop                                                          *)
 
-let internalise sigma env allow_soapp lvar c =
+let internalise sigma globalenv env allow_soapp lvar c =
   let rec intern (ids,tmp_scope,scopes as env) = function
     | CRef ref as x ->
 	let (c,imp,subscopes,l) = intern_reference env lvar ref in
@@ -769,20 +785,30 @@ let internalise sigma env allow_soapp lvar c =
           with Not_found ->
 	    raise (InternalisationError (locid,UnboundFixName (false,iddef)))
 	in
-	let ids' = List.fold_right Idset.add lf ids in
         let idl = Array.map
-          (fun (id,n,bl,ty,bd) ->
-            let ((ids'',_,_),rbl) =
-              List.fold_left intern_local_binder (env,[]) bl in
-	    let ids''' = List.fold_right Idset.add lf ids'' in
-            (List.rev rbl,
-             intern_type (ids'',tmp_scope,scopes) ty,
-             intern (ids''',None,scopes) bd)) dl in
-	RRec (loc,RFix (Array.map (fun (_,n,_,_,_) -> n) dl,n),
+          (fun (id,(n,order),bl,ty,bd) ->
+	    let ro, ((ids',_,_),rbl) =
+	      (match order with
+		   CStructRec -> 
+		     RStructRec,
+		     List.fold_left intern_local_binder (env,[]) bl
+		 | CWfRec c -> 
+		     let before, after = list_chop (succ n) bl in
+		     let ((ids',_,_),rafter) =
+		       List.fold_left intern_local_binder (env,[]) after in
+		     let ro = RWfRec (intern (ids', tmp_scope, scopes) c) in
+		       ro, List.fold_left intern_local_binder (env,rafter) before)
+	    in
+	    let ids'' = List.fold_right Idset.add lf ids' in
+	     ((n, ro), List.rev rbl, 
+             intern_type (ids',tmp_scope,scopes) ty,
+             intern (ids'',None,scopes) bd)) dl in
+	RRec (loc,RFix 
+	      (Array.map (fun (ro,_,_,_) -> ro) idl,n),
               Array.of_list lf,
-              Array.map (fun (bl,_,_) -> bl) idl,
-              Array.map (fun (_,ty,_) -> ty) idl,
-              Array.map (fun (_,_,bd) -> bd) idl)
+              Array.map (fun (_,bl,_,_) -> bl) idl,
+              Array.map (fun (_,_,ty,_) -> ty) idl,
+              Array.map (fun (_,_,_,bd) -> bd) idl)
     | CCoFix (loc, (locid,iddef), dl) ->
         let lf = List.map (fun (id,_,_,_) -> id) dl in
         let dl = Array.of_list dl in
@@ -792,15 +818,14 @@ let internalise sigma env allow_soapp lvar c =
           with Not_found ->
 	    raise (InternalisationError (locid,UnboundFixName (true,iddef)))
 	in
-	let ids' = List.fold_right Idset.add lf ids in
         let idl = Array.map
           (fun (id,bl,ty,bd) ->
-            let ((ids'',_,_),rbl) =
+            let ((ids',_,_),rbl) =
               List.fold_left intern_local_binder (env,[]) bl in
-	    let ids''' = List.fold_right Idset.add lf ids'' in
+	    let ids'' = List.fold_right Idset.add lf ids' in
             (List.rev rbl,
-             intern_type (ids'',tmp_scope,scopes) ty,
-             intern (ids''',None,scopes) bd)) dl in
+             intern_type (ids',tmp_scope,scopes) ty,
+             intern (ids'',None,scopes) bd)) dl in
 	RRec (loc,RCoFix n,
               Array.of_list lf,
               Array.map (fun (bl,_,_) -> bl) idl,
@@ -819,15 +844,17 @@ let internalise sigma env allow_soapp lvar c =
     | CLetIn (loc,(_,na),c1,c2) ->
 	RLetIn (loc, na, intern (reset_tmp_scope env) c1,
           intern (push_name_env lvar env na) c2)
-    | CNotation (loc,"- _",[CNumeral(_,Bignat.POS p)]) ->
-        let scopes = option_cons tmp_scope scopes in
-        Symbols.interp_numeral loc (Bignat.NEG p) scopes
+    | CNotation (loc,"- _",[CPrim (_,Numeral p)])
+	when Bigint.is_strictly_pos p -> 
+	intern env (CPrim (loc,Numeral (Bigint.neg p)))
     | CNotation (_,"( _ )",[a]) -> intern env a
     | CNotation (loc,ntn,args) ->
         intern_notation intern env loc ntn args
-    | CNumeral (loc, n) ->
+    | CPrim (loc, p) ->
 	let scopes = option_cons tmp_scope scopes in
-	Symbols.interp_numeral loc n scopes
+	let c,df = Notation.interp_prim_token loc p scopes in
+	if !dump then dump_notation_location (fst (unloc loc)) df;
+	c
     | CDelimiters (loc, key, e) ->
 	intern (ids,None,find_delimiters_scope loc key::scopes) e
     | CAppExpl (loc, (isproj,ref), args) ->
@@ -847,26 +874,22 @@ let internalise sigma env allow_soapp lvar c =
                 let c = intern_notation intern env loc ntn [] in
                 find_appl_head_data lvar c
             | x -> (intern env f,[],[],[]) in
-	let args = intern_impargs c env impargs args_scopes (merge_impargs l args) in
+	let args = 
+	  intern_impargs c env impargs args_scopes (merge_impargs l args) in
 	check_projection isproj (List.length args) c;
 	(match c with 
           (* Now compact "(f args') args" *)
 	  | RApp (loc', f', args') -> RApp (join_loc loc' loc, f',args'@args)
 	  | _ -> RApp (loc, c, args))
-    | CCases (loc, (po,rtnpo), tms, eqns) ->
+    | CCases (loc, rtnpo, tms, eqns) ->
         let tms,env' = List.fold_right
           (fun citm (inds,env) ->
 	    let (tm,ind),nal = intern_case_item env citm in
-	    (tm,ref ind)::inds,List.fold_left (push_name_env lvar) env nal)
+	    (tm,ind)::inds,List.fold_left (push_name_env lvar) env nal)
 	  tms ([],env) in
         let rtnpo = option_app (intern_type env') rtnpo in
-	RCases (loc, (option_app (intern_type env) po, ref rtnpo), tms,
-		List.map (intern_eqn (List.length tms) env) eqns)
-    | COrderedCase (loc, tag, po, c, cl) ->
-	let env = reset_tmp_scope env in
-	ROrderedCase (loc, tag, option_app (intern_type env) po,
-	          intern env c,
-		  Array.of_list (List.map (intern env) cl),ref None)
+        let eqns' = List.map (intern_eqn (List.length tms) env) eqns in
+	RCases (loc, rtnpo, tms, List.flatten eqns')
     | CLetTuple (loc, nal, (na,po), b, c) ->
 	let env' = reset_tmp_scope env in
         let ((b',(na',_)),ids) = intern_case_item env' (b,(na,None)) in
@@ -881,58 +904,52 @@ let internalise sigma env allow_soapp lvar c =
         let p' = option_app (intern_type env'') po in
         RIf (loc, c', (na', p'), intern env b1, intern env b2)
     | CHole loc -> 
-	RHole (loc, QuestionMark)
+	RHole (loc, Evd.QuestionMark)
     | CPatVar (loc, n) when allow_soapp ->
 	RPatVar (loc, n)
-    | CPatVar (loc, (false,n)) when Options.do_translate () ->
-	RVar (loc, n)
-    | CPatVar (loc, (false,n as x)) ->
-        if List.mem n (fst (let (a,_,_,_,_) = lvar in a)) & !Options.v7 then
-	  RVar (loc, n)
-	else
-          error_unbound_patvar loc n
+    | CPatVar (loc, (false,n)) ->
+        error_unbound_patvar loc n
     | CPatVar (loc, _) ->
 	raise (InternalisationError (loc,NegativeMetavariable))
     | CEvar (loc, n) ->
 	REvar (loc, n, None)
     | CSort (loc, s) ->
 	RSort(loc,s)
-    | CCast (loc, c1, c2) ->
-	RCast (loc,intern env c1,intern_type env c2)
+    | CCast (loc, c1, k, c2) ->
+	RCast (loc,intern env c1,k,intern_type env c2)
 
     | CDynamic (loc,d) -> RDynamic (loc,d)
 
   and intern_type (ids,_,scopes) =
-    intern (ids,Some Symbols.type_scope,scopes)
+    intern (ids,Some Notation.type_scope,scopes)
 
   and intern_local_binder ((ids,ts,sc as env),bl) = function
-      LocalRawAssum(nal,ty) ->
-        let (loc,na) = List.hd nal in
-        (* TODO: fail if several names with different implicit types *)
-        let ty = locate_if_isevar loc na (intern_type env ty) in
+    | LocalRawAssum(nal,ty) ->
+	let (loc,na) = List.hd nal in
+	(* TODO: fail if several names with different implicit types *)
+	let ty = locate_if_isevar loc na (intern_type env ty) in
         List.fold_left
           (fun ((ids,ts,sc),bl) (_,na) ->
             ((name_fold Idset.add na ids,ts,sc), (na,None,ty)::bl))
           (env,bl) nal
     | LocalRawDef((loc,na),def) ->
         ((name_fold Idset.add na ids,ts,sc),
-         (na,Some(intern env def),RHole(loc,BinderType na))::bl)
-
-  and intern_eqn n (ids,tmp_scope,scopes as env) (loc,lhs,rhs) =
-	let (idsl_substl_list,pl) =
-	  List.split 
-	    (List.map (intern_cases_pattern scopes ([],[]) None) lhs) in
-	let idsl, substl = List.split (List.flatten idsl_substl_list) in
-	let eqn_ids = List.flatten idsl in
-	let subst = List.flatten substl in 
-	(* Linearity implies the order in ids is irrelevant *)
-	check_linearity lhs eqn_ids;
-	check_uppercase loc eqn_ids;
-	check_number_of_pattern loc n pl;
-	let rhs = replace_vars_constr_expr subst rhs in
-	List.iter message_redundant_alias subst;
-	let env_ids = List.fold_right Idset.add eqn_ids ids in
-	(loc, eqn_ids,pl,intern (env_ids,tmp_scope,scopes) rhs)
+         (na,Some(intern env def),RHole(loc,Evd.BinderType na))::bl)
+
+  and intern_eqn n (ids,tmp_scope,scopes as _env) (loc,lhs,rhs) =
+    let idsl_pll = 
+      List.map (intern_cases_pattern globalenv scopes ([],[]) None) lhs in
+
+    let eqn_ids,pll = product_of_cases_patterns [] idsl_pll in
+    (* Linearity implies the order in ids is irrelevant *)
+    check_linearity lhs eqn_ids;
+    check_number_of_pattern loc n (snd (List.hd pll));
+    let env_ids = List.fold_right Idset.add eqn_ids ids in
+    List.map (fun (subst,pl) ->
+      let rhs = replace_vars_constr_expr subst rhs in
+      List.iter message_redundant_alias subst;
+      let rhs' = intern (env_ids,tmp_scope,scopes) rhs in
+      (loc,eqn_ids,pl,rhs')) pll
 
   and intern_case_item (vars,_,scopes as env) (tm,(na,t)) =
     let tm' = intern env tm in
@@ -941,21 +958,23 @@ let internalise sigma env allow_soapp lvar c =
 	let tids = names_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
-	begin match t with
-	  | RRef (loc,IndRef ind) -> [],Some (loc,ind,[])
+	let (_,_,nal as indsign) =
+	  match t with
+	  | RRef (loc,IndRef ind) -> (loc,ind,[])
 	  | RApp (loc,RRef (_,IndRef ind),l) ->
 	      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
-	      nal, Some (loc,ind,nal)
-	  | _ -> error_bad_inductive_type (loc_of_rawconstr t)
-	end
+	      (loc,ind,nal)
+	  | _ -> error_bad_inductive_type (loc_of_rawconstr t) in
+	check_inductive_length globalenv indsign;
+	nal, Some indsign
     | None -> 
 	[], None in
     let na = match tm', na with
-      | RVar (_,id), None when Idset.mem id vars & not !Options.v7 -> Name id
+      | RVar (_,id), None when Idset.mem id vars -> Name id
       | _, None -> Anonymous
       | _, Some na -> na in
     (tm',(na,typ)), na::ids
@@ -1032,114 +1051,53 @@ let extract_ids env =
     (Termops.ids_of_rel_context (Environ.rel_context env))
     Idset.empty
 
-let interp_rawconstr_gen_with_implicits isarity sigma env (indpars,impls) allow_soapp ltacvar c =
-  let tmp_scope = if isarity then Some Symbols.type_scope else None in
-  internalise sigma (extract_ids env, tmp_scope,[])
-    allow_soapp (ltacvar,Environ.named_context env, [], indpars, impls) c
-
-let interp_rawconstr_gen isarity sigma env allow_soapp ltacvar c =
-  interp_rawconstr_gen_with_implicits isarity sigma env ([],[]) allow_soapp ltacvar c
-
-let interp_rawconstr sigma env c =
-  interp_rawconstr_gen false sigma env false ([],[]) c
-
-let interp_rawtype sigma env c =
-  interp_rawconstr_gen true sigma env false ([],[]) c
+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
+  internalise sigma env (extract_ids env, tmp_scope,[])
+    allow_soapp (ltacvars,Environ.named_context env, [], impls) c
 
-let interp_rawtype_with_implicits sigma env impls c =
-  interp_rawconstr_gen_with_implicits true sigma env impls false ([],[]) c
+let intern_constr sigma env c = intern_gen false sigma env c 
 
-let interp_rawconstr_with_implicits sigma env vars impls c =
-  interp_rawconstr_gen_with_implicits false sigma env ([],impls) false
-    (vars,[]) c
-
-(*
-(* The same as interp_rawconstr but with a list of variables which must not be
-   globalized *)
-
-let interp_rawconstr_wo_glob sigma env lvar c =
-  interp_rawconstr_gen sigma env [] (Some []) lvar c
-*)
+let intern_ltac isarity ltacvars sigma env c =
+  intern_gen isarity sigma env ~ltacvars:ltacvars c
 
 (*********************************************************************)
 (* Functions to parse and interpret constructions *)
 
-let interp_constr sigma env c =
-  understand sigma env (interp_rawconstr sigma env c)
-
-let interp_openconstr sigma env c =
-  understand_gen_tcc sigma env [] None (interp_rawconstr sigma env c)
-
-let interp_casted_openconstr sigma env c typ =
-  understand_gen_tcc sigma env [] (Some typ) (interp_rawconstr sigma env c)
-
-let interp_type sigma env c =
-  understand_type sigma env (interp_rawtype sigma env c)
-
-let interp_binder sigma env na t =
-  let t = interp_rawtype sigma env t in
-  understand_type sigma env (locate_if_isevar (loc_of_rawconstr t) na t)
-
-let interp_type_with_implicits sigma env impls c =
-  understand_type sigma env (interp_rawtype_with_implicits sigma env impls c)
+let interp_gen kind sigma env 
+               ?(impls=([],[])) ?(allow_soapp=false) ?(ltacvars=([],[]))
+               c =
+  Default.understand_gen kind sigma env 
+    (intern_gen (kind=IsType) ~impls ~allow_soapp ~ltacvars sigma env c)
 
-let judgment_of_rawconstr sigma env c =
-  understand_judgment sigma env (interp_rawconstr sigma env c)
-
-let type_judgment_of_rawconstr sigma env c =
-  understand_type_judgment sigma env (interp_rawconstr sigma env c)
-
-(* To retype a list of key*constr with undefined key *)
-let retype_list sigma env lst =
-  List.fold_right (fun (x,csr) a ->
-    try (x,Retyping.get_judgment_of env sigma csr)::a with
-    | Anomaly _ -> a) lst []
-
-(*  List.map (fun (x,csr) -> (x,Retyping.get_judgment_of env sigma csr)) lst*)
-
-type ltac_sign = 
-  identifier list * (identifier * identifier option) list
-
-type ltac_env = 
-  (identifier * Term.constr) list * (identifier * identifier option) list
+let interp_constr sigma env c =
+  interp_gen (OfType None) sigma env c 
 
-(* Interprets a constr according to two lists *)
-(* of instantiations (variables and metas)    *)
-(* Note: typ is retyped *)
-let interp_constr_gen sigma env (ltacvars,unbndltacvars) c exptyp =
-  let c = interp_rawconstr_gen false sigma env false
-    (List.map fst ltacvars,unbndltacvars) c in
-  let typs = retype_list sigma env ltacvars in
-  understand_gen sigma env typs exptyp c
+let interp_type sigma env ?(impls=([],[])) c =
+  interp_gen IsType sigma env ~impls c
 
-(*Interprets a casted constr according to two lists of instantiations
-  (variables and metas)*)
-let interp_openconstr_gen sigma env (ltacvars,unbndltacvars) c exptyp =
-  let c = interp_rawconstr_gen false sigma env false
-    (List.map fst ltacvars,unbndltacvars) c in
-  let typs = retype_list sigma env ltacvars in
-  understand_gen_tcc sigma env typs exptyp c
+let interp_casted_constr sigma env ?(impls=([],[])) c typ =
+  interp_gen (OfType (Some typ)) sigma env ~impls c 
 
-let interp_casted_constr sigma env c typ = 
-  understand_gen sigma env [] (Some typ) (interp_rawconstr sigma env c)
+let interp_open_constr sigma env c =
+  Default.understand_tcc sigma env (intern_constr sigma env c)
 
-let interp_casted_constr_with_implicits sigma env impls c typ =
-  understand_gen sigma env [] (Some typ) 
-    (interp_rawconstr_with_implicits sigma env [] impls c)
+let interp_constr_judgment sigma env c =
+  Default.understand_judgment sigma env (intern_constr sigma env c)
 
-let interp_constrpattern_gen sigma env ltacvar c =
-  let c = interp_rawconstr_gen false sigma env true (ltacvar,[]) c in
-  pattern_of_rawconstr c
+type ltac_sign = identifier list * unbound_ltac_var_map
 
 let interp_constrpattern sigma env c =
-  interp_constrpattern_gen sigma env [] c
+  pattern_of_rawconstr (intern_gen false sigma env ~allow_soapp:true c)
 
 let interp_aconstr impls vars a =
   let env = Global.env () in
   (* [vl] is intended to remember the scope of the free variables of [a] *)
   let vl = List.map (fun id -> (id,ref None)) vars in
-  let c = internalise Evd.empty (extract_ids env, None, [])
-    false (([],[]),Environ.named_context env,vl,[],impls) a in
+  let c = internalise Evd.empty (Global.env()) (extract_ids env, None, [])
+    false (([],[]),Environ.named_context env,vl,([],impls)) a in
   (* Translate and check that [c] has all its free variables bound in [vars] *)
   let a = aconstr_of_rawconstr vars c in
   (* Returns [a] and the ordered list of variables with their scopes *)
@@ -1148,6 +1106,33 @@ let interp_aconstr impls vars a =
     (fun (id,r) -> (id,match !r with None -> None,[] | Some (a,l) -> a,l)) vl,
   a
 
+(* Interpret binders and contexts  *)
+
+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)
+
+open Environ
+open Term
+
+let interp_context sigma env params = 
+  List.fold_left
+    (fun (env,params) d -> match d with
+      | LocalRawAssum ([_,na],(CHole _ as t)) ->
+	  let t = interp_binder sigma env na t in
+	  let d = (na,None,t) in
+	  (push_rel d env, d::params)
+      | LocalRawAssum (nal,t) ->
+	  let t = interp_type sigma 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 sigma 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 *)
 
@@ -1166,7 +1151,7 @@ let is_global id =
     false
 
 let global_reference id = 
-  constr_of_reference (locate_reference (make_short_qualid id))
+  constr_of_global (locate_reference (make_short_qualid id))
 
 let construct_reference ctx id =
   try
@@ -1175,5 +1160,5 @@ let construct_reference ctx id =
     global_reference id
 
 let global_reference_in_absolute_module dir id = 
-  constr_of_reference (Nametab.absolute_reference (Libnames.make_path dir id))
+  constr_of_global (Nametab.absolute_reference (Libnames.make_path dir id))
 
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index 06039da7..cdd87a7c 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,v 1.15.2.2 2005/01/21 16:41:50 herbelin Exp $ i*)
+(*i $Id: constrintern.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -17,9 +17,9 @@ open Environ
 open Libnames
 open Rawterm
 open Pattern
-open Coqast
 open Topconstr
 open Termops
+open Pretyping
 (*i*)
 
 (*s Translation from front abstract syntax of term to untyped terms (rawconstr)
@@ -34,73 +34,67 @@ open Termops
 *)
 
 (* To interpret implicits and arg scopes of recursive variables in
-   inductive types and recursive definitions *)
+   inductive types and recursive definitions; mention of a list of
+   implicits arguments in the ``rel'' part of [env]; the second
+   argument associates a list of implicit positions and scopes to
+   identifiers declared in the [rel_context] of [env] *)
+
 type var_internalisation_data =
     identifier list * Impargs.implicits_list * scope_name option list
 
 type implicits_env = (identifier * var_internalisation_data) list
 type full_implicits_env = identifier list * implicits_env
 
-type ltac_sign = 
-  identifier list * (identifier * identifier option) list
-
-type ltac_env = 
-  (identifier * constr) list * (identifier * identifier option) list
-
-(* Interprets global names, including syntactic defs and section variables *)
-val interp_rawconstr     : evar_map -> env -> constr_expr -> rawconstr
-val interp_rawconstr_gen : bool -> evar_map -> env -> 
-    bool -> ltac_sign -> constr_expr -> rawconstr
-
-(*s Composing the translation with typing *)
-val interp_constr        : evar_map -> env -> constr_expr -> constr
-val interp_casted_constr : evar_map -> env -> constr_expr -> types -> constr
-val interp_type          : evar_map -> env -> constr_expr -> types
-val interp_binder        : evar_map -> env -> name -> constr_expr -> types
-val interp_openconstr    : evar_map -> env -> constr_expr -> evar_map * constr
-val interp_casted_openconstr    :
-  evar_map -> env -> constr_expr -> constr -> evar_map * constr
-
-(* [interp_type_with_implicits] extends [interp_type] by allowing
-   implicits arguments in the ``rel'' part of [env]; the extra
-   argument associates a list of implicit positions to identifiers
-   declared in the [rel_context] of [env] *)
-val interp_type_with_implicits : 
-  evar_map -> env -> full_implicits_env -> constr_expr -> types
-
-val interp_casted_constr_with_implicits :
-  evar_map -> env -> implicits_env -> constr_expr -> types -> constr
-
-val interp_rawconstr_with_implicits :
-  evar_map -> env -> identifier list -> implicits_env -> constr_expr -> 
-    rawconstr
-
-(*s Build a judgement from *)
-val judgment_of_rawconstr : evar_map -> env -> constr_expr -> unsafe_judgment
-val type_judgment_of_rawconstr :
-  evar_map -> env -> constr_expr -> unsafe_type_judgment
-
-(* Interprets a constr according to two lists of instantiations (variables and
-  metas), possibly casting it*)
-val interp_constr_gen     :
-  evar_map -> env -> ltac_env -> constr_expr -> constr option -> constr
-
-(* Interprets a constr according to two lists of instantiations (variables and
-  metas), possibly casting it, and turning unresolved evar into metas*)
-val interp_openconstr_gen     :
-  evar_map -> env -> ltac_env ->
-    constr_expr -> constr option -> evar_map * constr
-
-(* Interprets constr patterns according to a list of instantiations
-  (variables)*)
-val interp_constrpattern_gen : evar_map -> env -> identifier list ->
-  constr_expr -> patvar list * constr_pattern
+type ltac_sign = identifier list * unbound_ltac_var_map
+
+(*s Internalisation performs interpretation of global names and notations *)
+
+val intern_constr : evar_map -> env -> constr_expr -> rawconstr
+
+val intern_gen : bool -> evar_map -> env ->
+  ?impls:full_implicits_env -> ?allow_soapp:bool -> ?ltacvars:ltac_sign ->
+  constr_expr -> rawconstr
+
+(*s Composing internalisation with pretyping *)
+
+(* Main interpretation function *)
+
+val interp_gen : typing_constraint -> evar_map -> env ->
+  ?impls:full_implicits_env -> ?allow_soapp:bool -> ?ltacvars:ltac_sign ->
+  constr_expr -> constr
+
+(* Particular instances *)
+
+val interp_constr : evar_map -> env -> 
+  constr_expr -> constr
+
+val interp_casted_constr : evar_map -> env -> ?impls:full_implicits_env -> 
+  constr_expr -> types -> constr
+
+val interp_type : evar_map -> env -> ?impls:full_implicits_env -> 
+  constr_expr -> types
+
+val interp_open_constr   : evar_map -> env -> constr_expr -> evar_map * constr
+
+(*s Build a judgment  *)
+
+val interp_constr_judgment : evar_map -> env -> constr_expr -> unsafe_judgment
+
+(* Interprets constr patterns *)
 
 val interp_constrpattern : 
   evar_map -> env -> constr_expr -> patvar list * constr_pattern
 
 val interp_reference : ltac_sign -> reference -> rawconstr
 
+(* Interpret binders *)
+
+val interp_binder  : evar_map -> env -> name -> constr_expr -> types
+
+(* Interpret contexts: returns extended env and context *)
+
+val interp_context : evar_map -> env -> local_binder list -> env * rel_context
+
 (* Locating references of constructions, possibly via a syntactic definition *)
 
 val locate_reference : qualid -> global_reference
@@ -110,6 +104,7 @@ val global_reference : identifier -> constr
 val global_reference_in_absolute_module : dir_path -> identifier -> constr
 
 (* Interprets into a abbreviatable constr *)
+
 val interp_aconstr : implicits_env -> identifier list -> constr_expr ->
   interpretation
 
@@ -120,7 +115,3 @@ val for_grammar : ('a -> 'b) -> 'a -> 'b
 type coqdoc_state
 val coqdoc_freeze : unit -> coqdoc_state
 val coqdoc_unfreeze : coqdoc_state -> unit
-
-(* For v8 translation *)
-val set_temporary_implicits_in :
-  (identifier * Impargs.implicits_list) list -> unit
diff --git a/interp/coqlib.ml b/interp/coqlib.ml
index 8ce9bfaf..afee83e8 100644
--- a/interp/coqlib.ml
+++ b/interp/coqlib.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqlib.ml,v 1.14.2.1 2004/07/16 19:30:22 herbelin Exp $ *)
+(* $Id: coqlib.ml 8688 2006-04-07 15:08:12Z msozeau $ *)
 
 open Util
 open Pp
@@ -16,19 +16,25 @@ open Libnames
 open Pattern
 open Nametab
 
+(************************************************************************)
+(* Generic functions to find Coq objects *)
+
+type message = string
+
 let make_dir l = make_dirpath (List.map id_of_string (List.rev l))
 
-let gen_reference locstr dir s =
-  let dir = make_dir ("Coq"::dir) in
-  let id = Constrextern.id_of_v7_string s in
-  let sp = Libnames.make_path dir id in
+let find_reference locstr dir s =
+  let sp = Libnames.make_path (make_dir dir) (id_of_string s) in
   try
     Nametab.absolute_reference sp
   with Not_found ->
     anomaly (locstr^": cannot find "^(string_of_path sp))
-    
-let gen_constant locstr dir s = 
-  constr_of_reference (gen_reference locstr dir s)
+
+let coq_reference locstr dir s = find_reference locstr ("Coq"::dir) s
+let coq_constant locstr dir s = constr_of_global (coq_reference locstr dir s)
+
+let gen_reference = coq_reference
+let gen_constant = coq_constant
 
 let list_try_find f = 
   let rec try_find_f = function
@@ -43,11 +49,11 @@ let has_suffix_in_dirs dirs ref =
 
 let gen_constant_in_modules locstr dirs s =
   let dirs = List.map make_dir dirs in
-  let id = Constrextern.id_of_v7_string s in
+  let id = id_of_string s in
   let all = Nametab.locate_all (make_short_qualid id) in
   let these = List.filter (has_suffix_in_dirs dirs) all in
   match these with
-    | [x] -> constr_of_reference x
+    | [x] -> constr_of_global x
     | [] ->
 	anomalylabstrm "" (str (locstr^": cannot find "^s^
 	" in module"^(if List.length dirs > 1 then "s " else " ")) ++
@@ -58,9 +64,27 @@ let gen_constant_in_modules locstr dirs s =
 	" in module"^(if List.length dirs > 1 then "s " else " ")) ++
 	prlist_with_sep pr_coma pr_dirpath dirs)
 
-let init_reference dir s=gen_reference "Coqlib" ("Init"::dir) s
 
-let init_constant dir s=gen_constant "Coqlib" ("Init"::dir) s  
+(* For tactics/commands requiring vernacular libraries *)
+
+let check_required_library d =
+  let d' = List.map id_of_string d in
+  let dir = make_dirpath (List.rev d') in
+  if not (Library.library_is_loaded dir) then
+(* Loading silently ...
+    let m, prefix = list_sep_last d' in
+    read_library 
+     (dummy_loc,make_qualid (make_dirpath (List.rev prefix)) m)
+*)
+(* or failing ...*)
+    error ("Library "^(list_last d)^" has to be required first")
+
+(************************************************************************)
+(* Specific Coq objects *)
+
+let init_reference dir s = gen_reference "Coqlib" ("Init"::dir) s
+
+let init_constant dir s = gen_constant "Coqlib" ("Init"::dir) s  
 
 let arith_dir = ["Coq";"Arith"]
 let arith_modules = [arith_dir]
@@ -91,22 +115,33 @@ let datatypes_module = make_dir ["Coq";"Init";"Datatypes"]
 let arith_module = make_dir ["Coq";"Arith";"Arith"]
 
 (* TODO: temporary hack *)
-let make_path dir id = Libnames.encode_kn dir id
+let make_kn dir id = Libnames.encode_kn dir id
 
-let nat_path = make_path datatypes_module (id_of_string "nat")
+(** Natural numbers *)
+let nat_kn = make_kn datatypes_module (id_of_string "nat")
+let nat_path = Libnames.make_path datatypes_module (id_of_string "nat")
 
-let glob_nat = IndRef (nat_path,0)
+let glob_nat = IndRef (nat_kn,0)
 
-let path_of_O = ((nat_path,0),1)
-let path_of_S = ((nat_path,0),2)
+let path_of_O = ((nat_kn,0),1)
+let path_of_S = ((nat_kn,0),2)
 let glob_O = ConstructRef path_of_O
 let glob_S = ConstructRef path_of_S
 
-let eq_path = make_path logic_module (id_of_string "eq")
-let eqT_path = make_path logic_module (id_of_string "eq")
+(** Booleans *)
+let bool_kn = make_kn datatypes_module (id_of_string "bool")
+
+let glob_bool = IndRef (bool_kn,0)
 
-let glob_eq = IndRef (eq_path,0)
-let glob_eqT = IndRef (eqT_path,0)
+let path_of_true = ((bool_kn,0),1)
+let path_of_false = ((bool_kn,0),2)
+let glob_true  = ConstructRef path_of_true
+let glob_false  = ConstructRef path_of_false
+
+(** Equality *)
+let eq_kn = make_kn logic_module (id_of_string "eq")
+
+let glob_eq = IndRef (eq_kn,0)
 
 type coq_sigma_data = {
   proj1 : constr;
@@ -131,6 +166,13 @@ let build_sigma_type () =
     intro = init_constant ["Specif"] "existT";
     typ = init_constant ["Specif"] "sigT" }
 
+let build_prod () =
+  { proj1 = init_constant ["Datatypes"] "fst";
+    proj2 = init_constant ["Datatypes"] "snd";
+    elim = init_constant ["Datatypes"] "prod_rec";
+    intro = init_constant ["Datatypes"] "pair";
+    typ = init_constant ["Datatypes"] "prod" }
+
 (* Equalities *)
 type coq_leibniz_eq_data = {
   eq   : constr;
@@ -160,9 +202,10 @@ let build_coq_eq_data () = {
   rrec = Some (Lazy.force coq_eq_rec);
   rect = Some (Lazy.force coq_eq_rect);
   congr = Lazy.force coq_eq_congr;
-  sym  = Lazy.force coq_eq_sym }
+  sym = Lazy.force coq_eq_sym }
 
 let build_coq_eq () = Lazy.force coq_eq_eq
+let build_coq_sym_eq () = Lazy.force coq_eq_sym
 let build_coq_f_equal2 () = Lazy.force coq_f_equal2
 
 (* Specif *)
@@ -170,56 +213,23 @@ let coq_sumbool  = lazy_init_constant ["Specif"] "sumbool"
 
 let build_coq_sumbool () = Lazy.force coq_sumbool
 
-(* Equality on Type *)
-
-let coq_eqT_eq = lazy_init_constant ["Logic"] "eq"
-let coq_eqT_refl = lazy_init_constant ["Logic"] "refl_equal"
-let coq_eqT_ind = lazy_init_constant ["Logic"] "eq_ind"
-let coq_eqT_congr =lazy_init_constant ["Logic"] "f_equal"
-let coq_eqT_sym  = lazy_init_constant ["Logic"] "sym_eq"
-
-let build_coq_eqT_data () = {
-  eq = Lazy.force coq_eqT_eq;
-  refl = Lazy.force coq_eqT_refl;
-  ind = Lazy.force coq_eqT_ind;
-  rrec = None;
-  rect = None;
-  congr = Lazy.force coq_eqT_congr;
-  sym  = Lazy.force coq_eqT_sym }
-
-let build_coq_eqT () = Lazy.force coq_eqT_eq
-let build_coq_sym_eqT () = Lazy.force coq_eqT_sym
-
 (* Equality on Type as a Type *)
-let coq_idT_eq = lazy_init_constant ["Datatypes"] "identity"
-let coq_idT_refl = lazy_init_constant ["Datatypes"] "refl_identity"
-let coq_idT_ind = lazy_init_constant ["Datatypes"] "identity_ind"
-let coq_idT_rec = lazy_init_constant ["Datatypes"] "identity_rec"
-let coq_idT_rect = lazy_init_constant ["Datatypes"] "identity_rect"
-let coq_idT_congr = lazy_init_constant ["Logic_Type"] "congr_id"
-let coq_idT_sym = lazy_init_constant ["Logic_Type"] "sym_id"
-
-let build_coq_idT_data () = {
-  eq = Lazy.force coq_idT_eq;
-  refl = Lazy.force coq_idT_refl;
-  ind = Lazy.force coq_idT_ind;
-  rrec = Some (Lazy.force coq_idT_rec);
-  rect = Some (Lazy.force coq_idT_rect);
-  congr = Lazy.force coq_idT_congr;
-  sym  = Lazy.force coq_idT_sym }
-
-let lazy_init_constant_v7 d id id7 =
-  if !Options.v7 then lazy_init_constant d id else 
-  lazy (anomaly
-   (id7^" does no longer exist in V8 new syntax, use "^id
-    ^" instead (probably an error in ML contributed code)"))
-
-(* Empty Type *)
-let coq_EmptyT = lazy_init_constant_v7 ["Logic"] "False" "EmptyT"
-
-(* Unit Type and its unique inhabitant *)
-let coq_UnitT  = lazy_init_constant_v7 ["Datatypes"] "unit" "UnitT"
-let coq_IT     = lazy_init_constant_v7 ["Datatypes"] "tt" "IT"
+let coq_identity_eq = lazy_init_constant ["Datatypes"] "identity"
+let coq_identity_refl = lazy_init_constant ["Datatypes"] "refl_identity"
+let coq_identity_ind = lazy_init_constant ["Datatypes"] "identity_ind"
+let coq_identity_rec = lazy_init_constant ["Datatypes"] "identity_rec"
+let coq_identity_rect = lazy_init_constant ["Datatypes"] "identity_rect"
+let coq_identity_congr = lazy_init_constant ["Logic_Type"] "congr_id"
+let coq_identity_sym = lazy_init_constant ["Logic_Type"] "sym_id"
+
+let build_coq_identity_data () = {
+  eq = Lazy.force coq_identity_eq;
+  refl = Lazy.force coq_identity_refl;
+  ind = Lazy.force coq_identity_ind;
+  rrec = Some (Lazy.force coq_identity_rec);
+  rect = Some (Lazy.force coq_identity_rect);
+  congr = Lazy.force coq_identity_congr;
+  sym = Lazy.force coq_identity_sym }
 
 (* The False proposition *)
 let coq_False  = lazy_init_constant ["Logic"] "False"
@@ -235,10 +245,6 @@ let coq_or = lazy_init_constant ["Logic"] "or"
 let coq_ex = lazy_init_constant ["Logic"] "ex"
 
 (* Runtime part *)
-let build_coq_EmptyT () = Lazy.force coq_EmptyT
-let build_coq_UnitT () = Lazy.force coq_UnitT
-let build_coq_IT ()    = Lazy.force coq_IT
-
 let build_coq_True ()  = Lazy.force coq_True
 let build_coq_I ()     = Lazy.force coq_I
 
@@ -248,47 +254,14 @@ let build_coq_and ()   = Lazy.force coq_and
 let build_coq_or ()   = Lazy.force coq_or
 let build_coq_ex ()   = Lazy.force coq_ex
 
-(****************************************************************************)
-(*                             Patterns                                     *)
-(* This needs to have interp_constrpattern available ... 
-
-let parse_constr s =
-  try 
-    Pcoq.parse_string Pcoq.Constr.constr_eoi s 
-  with Stdpp.Exc_located (_ , (Stream.Failure | Stream.Error _)) ->
-    error "Syntax error : not a construction"
-
-let parse_pattern s =
-  Constrintern.interp_constrpattern Evd.empty (Global.env()) (parse_constr s)
-let coq_eq_pattern =
-  lazy (snd (parse_pattern "(Coq.Init.Logic.eq ?1 ?2 ?3)"))
-let coq_eqT_pattern =
-  lazy (snd (parse_pattern "(Coq.Init.Logic.eq ?1 ?2 ?3)"))
-let coq_idT_pattern =
-  lazy (snd (parse_pattern "(Coq.Init.Logic_Type.identityT ?1 ?2 ?3)"))
-let coq_existS_pattern =
-  lazy (snd (parse_pattern "(Coq.Init.Specif.existS ?1 ?2 ?3 ?4)"))
-let coq_existT_pattern = 
-  lazy (snd (parse_pattern "(Coq.Init.Specif.existT ?1 ?2 ?3 ?4)"))
-let coq_not_pattern =
-  lazy (snd (parse_pattern "(Coq.Init.Logic.not ?)"))
-let coq_imp_False_pattern =
-  lazy (snd (parse_pattern "? -> Coq.Init.Logic.False"))
-let coq_imp_False_pattern =
-  lazy (snd (parse_pattern "? -> Coq.Init.Logic.False"))
-let coq_eqdec_partial_pattern =
-  lazy (snd (parse_pattern "(sumbool (eq ?1 ?2 ?3) ?4)"))
-let coq_eqdec_pattern =
-  lazy (snd (parse_pattern "(x,y:?1){<?1>x=y}+{~(<?1>x=y)}"))
-*)
-
 (* The following is less readable but does not depend on parsing *)
 let coq_eq_ref      = lazy (init_reference ["Logic"] "eq")
-let coq_eqT_ref     = coq_eq_ref
-let coq_idT_ref     = lazy (init_reference ["Datatypes"] "identity")
+let coq_identity_ref     = lazy (init_reference ["Datatypes"] "identity")
 let coq_existS_ref  = lazy (init_reference ["Specif"] "existS")
 let coq_existT_ref  = lazy (init_reference ["Specif"] "existT")
 let coq_not_ref     = lazy (init_reference ["Logic"] "not")
 let coq_False_ref   = lazy (init_reference ["Logic"] "False")
 let coq_sumbool_ref = lazy (init_reference ["Specif"] "sumbool")
 let coq_sig_ref = lazy (init_reference ["Specif"] "sig")
+let coq_or_ref     = lazy (init_reference ["Logic"] "or")
+
diff --git a/interp/coqlib.mli b/interp/coqlib.mli
index 3b377f29..c81d72de 100644
--- a/interp/coqlib.mli
+++ b/interp/coqlib.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coqlib.mli,v 1.5.2.3 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: coqlib.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
 
 (*i*)
 open Names
@@ -19,11 +19,29 @@ open Pattern
 (*s This module collects the global references, constructions and
     patterns of the standard library used in ocaml files *)
 
-(*s Some utilities, the first argument is used for error messages.
-    Must be used lazyly. s*)
+(*s [find_reference caller_message [dir;subdir;...] s] returns a global
+   reference to the name dir.subdir.(...).s; the corresponding module
+   must have been required or in the process of being compiled so that
+   it must be used lazyly; it raises an anomaly with the given message
+   if not found *)
 
-val gen_reference : string->string list -> string -> global_reference
-val gen_constant : string->string list -> string -> constr
+type message = string
+
+val find_reference : message -> string list -> string -> global_reference
+
+(* [coq_reference caller_message [dir;subdir;...] s] returns a
+   global reference to the name Coq.dir.subdir.(...).s *)
+
+val coq_reference : message -> string list -> string -> global_reference
+
+(* idem but return a term *)
+
+val coq_constant : message -> string list -> string -> constr
+
+(* Synonyms of [coq_constant] and [coq_reference] *)
+
+val gen_constant : message -> string list -> string -> constr
+val gen_reference :  message -> string list -> string -> global_reference
 
 (* Search in several modules (not prefixed by "Coq") *)
 val gen_constant_in_modules : string->string list list-> string -> constr
@@ -31,6 +49,9 @@ val arith_modules : string list list
 val zarith_base_modules : string list list
 val init_modules : string list list
 
+(* For tactics/commands requiring vernacular libraries *)
+val check_required_library : string list -> unit
+
 (*s Global references *)
 
 (* Modules *)
@@ -38,15 +59,22 @@ val logic_module : dir_path
 val logic_type_module : dir_path
 
 (* Natural numbers *)
+val nat_path : section_path
 val glob_nat : global_reference
 val path_of_O : constructor
 val path_of_S : constructor
 val glob_O : global_reference
 val glob_S : global_reference
 
+(* Booleans *)
+val glob_bool : global_reference
+val path_of_true : constructor
+val path_of_false : constructor
+val glob_true : global_reference
+val glob_false : global_reference
+
 (* Equality *)
 val glob_eq : global_reference
-val glob_eqT : global_reference
 
 (*s Constructions and patterns related to Coq initial state are unknown
    at compile time. Therefore, we can only provide methods to build
@@ -66,6 +94,8 @@ type coq_sigma_data = {
 
 val build_sigma_set : coq_sigma_data delayed
 val build_sigma_type : coq_sigma_data delayed
+(* Non-dependent pairs in Set from Datatypes *)
+val build_prod : coq_sigma_data delayed
 
 type coq_leibniz_eq_data = {
   eq   : constr;
@@ -77,20 +107,11 @@ type coq_leibniz_eq_data = {
   sym  : constr }
 
 val build_coq_eq_data : coq_leibniz_eq_data delayed
-val build_coq_eqT_data : coq_leibniz_eq_data delayed
-val build_coq_idT_data : coq_leibniz_eq_data delayed
+val build_coq_identity_data : coq_leibniz_eq_data delayed
 
-val build_coq_eq : constr delayed (* = [(build_coq_eq_data()).eq] *)
+val build_coq_eq       : constr delayed (* = [(build_coq_eq_data()).eq] *)
+val build_coq_sym_eq   : constr delayed (* = [(build_coq_eq_data()).sym] *)
 val build_coq_f_equal2 : constr delayed
-val build_coq_eqT : constr delayed
-val build_coq_sym_eqT : constr delayed
-
-(* Empty Type *)
-val build_coq_EmptyT : constr delayed
-
-(* Unit Type and its unique inhabitant *)
-val build_coq_UnitT : constr delayed
-val build_coq_IT : constr delayed
 
 (* Specif *)
 val build_coq_sumbool : constr delayed
@@ -116,11 +137,12 @@ val build_coq_or : constr delayed
 val build_coq_ex : constr delayed
 
 val coq_eq_ref : global_reference lazy_t
-val coq_eqT_ref : global_reference lazy_t
-val coq_idT_ref : global_reference lazy_t
+val coq_identity_ref : global_reference lazy_t
 val coq_existS_ref : global_reference lazy_t
 val coq_existT_ref : global_reference lazy_t
 val coq_not_ref : global_reference lazy_t
 val coq_False_ref : global_reference lazy_t
 val coq_sumbool_ref : global_reference lazy_t
 val coq_sig_ref : global_reference lazy_t
+
+val coq_or_ref : global_reference lazy_t
diff --git a/interp/genarg.ml b/interp/genarg.ml
index 7facebcc..511cf88a 100644
--- a/interp/genarg.ml
+++ b/interp/genarg.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: genarg.ml,v 1.9.2.2 2005/01/15 14:56:54 herbelin Exp $ *)
+(* $Id: genarg.ml 7879 2006-01-16 13:58:09Z herbelin $ *)
 
 open Pp
 open Util
@@ -26,16 +26,15 @@ type argument_type =
   | PreIdentArgType
   | IntroPatternArgType
   | IdentArgType
-  | HypArgType
+  | VarArgType
   | RefArgType
   (* Specific types *)
   | SortArgType
   | ConstrArgType
   | ConstrMayEvalArgType
   | QuantHypArgType
-  | TacticArgType
-  | OpenConstrArgType
-  | CastedOpenConstrArgType
+  | TacticArgType of int
+  | OpenConstrArgType of bool
   | ConstrWithBindingsArgType
   | BindingsArgType
   | RedExprArgType
@@ -70,15 +69,17 @@ type intro_pattern_expr =
   | IntroOrAndPattern of case_intro_pattern_expr
   | IntroWildcard
   | IntroIdentifier of identifier
+  | IntroAnonymous
 and case_intro_pattern_expr = intro_pattern_expr list list
 
 let rec pr_intro_pattern = function
   | IntroOrAndPattern pll -> pr_case_intro_pattern pll
   | IntroWildcard -> str "_"
   | IntroIdentifier id -> pr_id id
+  | IntroAnonymous -> str "?"
 
 and pr_case_intro_pattern = function
-  | [_::_ as pl] ->
+  | [pl] ->
       str "(" ++ hv 0 (prlist_with_sep pr_coma pr_intro_pattern pl) ++ str ")"
   | pll ->
       str "[" ++
@@ -117,9 +118,9 @@ let rawwit_ident = IdentArgType
 let globwit_ident = IdentArgType
 let wit_ident = IdentArgType
 
-let rawwit_var = HypArgType
-let globwit_var = HypArgType
-let wit_var = HypArgType
+let rawwit_var = VarArgType
+let globwit_var = VarArgType
+let wit_var = VarArgType
 
 let rawwit_ref = RefArgType
 let globwit_ref = RefArgType
@@ -141,17 +142,21 @@ let rawwit_constr_may_eval = ConstrMayEvalArgType
 let globwit_constr_may_eval = ConstrMayEvalArgType
 let wit_constr_may_eval = ConstrMayEvalArgType
 
-let rawwit_tactic = TacticArgType
-let globwit_tactic = TacticArgType
-let wit_tactic = TacticArgType
+let rawwit_tactic n = TacticArgType n
+let globwit_tactic n = TacticArgType n
+let wit_tactic n = TacticArgType n
 
-let rawwit_open_constr = OpenConstrArgType
-let globwit_open_constr = OpenConstrArgType
-let wit_open_constr = OpenConstrArgType
+let rawwit_open_constr_gen b = OpenConstrArgType b
+let globwit_open_constr_gen b = OpenConstrArgType b 
+let wit_open_constr_gen b = OpenConstrArgType b
 
-let rawwit_casted_open_constr = CastedOpenConstrArgType
-let globwit_casted_open_constr = CastedOpenConstrArgType
-let wit_casted_open_constr = CastedOpenConstrArgType
+let rawwit_open_constr = rawwit_open_constr_gen false
+let globwit_open_constr = globwit_open_constr_gen false
+let wit_open_constr = wit_open_constr_gen false
+
+let rawwit_casted_open_constr = rawwit_open_constr_gen true
+let globwit_casted_open_constr = globwit_open_constr_gen true
+let wit_casted_open_constr = wit_open_constr_gen true
 
 let rawwit_constr_with_bindings = ConstrWithBindingsArgType
 let globwit_constr_with_bindings = ConstrWithBindingsArgType
@@ -178,24 +183,24 @@ let out_gen t (t',o) = if t = t' then Obj.magic o else failwith "out_gen"
 let genarg_tag (s,_) = s
 
 let fold_list0 f = function
-  | (List0ArgType t as u, l) ->
+  | (List0ArgType t, l) ->
       List.fold_right (fun x -> f (in_gen t x)) (Obj.magic l)
   | _ -> failwith "Genarg: not a list0"
 
 let fold_list1 f = function
-  | (List1ArgType t as u, l) ->
+  | (List1ArgType t, l) ->
       List.fold_right (fun x -> f (in_gen t x)) (Obj.magic l)
   | _ -> failwith "Genarg: not a list1"
 
 let fold_opt f a = function
-  | (OptArgType t as u, l) ->
+  | (OptArgType t, l) ->
       (match Obj.magic l with
 	| None -> a
 	| Some x -> f (in_gen t x))
   | _ -> failwith "Genarg: not a opt"
 
 let fold_pair f = function
-  | (PairArgType (t1,t2) as u, l) ->
+  | (PairArgType (t1,t2), l) ->
       let (x1,x2) = Obj.magic l in
       f (in_gen t1 x1) (in_gen t2 x2)
   | _ -> failwith "Genarg: not a pair"
diff --git a/interp/genarg.mli b/interp/genarg.mli
index 967d5050..99de4ca4 100644
--- a/interp/genarg.mli
+++ b/interp/genarg.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: genarg.mli,v 1.9.2.4 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: genarg.mli 7879 2006-01-16 13:58:09Z herbelin $ i*)
 
 open Util
 open Names
@@ -32,6 +32,7 @@ type intro_pattern_expr =
   | IntroOrAndPattern of case_intro_pattern_expr
   | IntroWildcard
   | IntroIdentifier of identifier
+  | IntroAnonymous
 and case_intro_pattern_expr = intro_pattern_expr list list
 
 val pr_intro_pattern : intro_pattern_expr -> Pp.std_ppcmds
@@ -114,7 +115,7 @@ val wit_ident : (identifier,'co,'ta) abstract_argument_type
 
 val rawwit_var : (identifier located,'co,'ta) abstract_argument_type
 val globwit_var : (identifier located,'co,'ta) abstract_argument_type
-val wit_var : ('co,'co,'ta) abstract_argument_type
+val wit_var : (identifier,'co,'ta) abstract_argument_type
 
 val rawwit_ref : (reference,constr_expr,'ta) abstract_argument_type
 val globwit_ref : (global_reference located or_var,rawconstr_and_expr,'ta) abstract_argument_type
@@ -136,6 +137,10 @@ val rawwit_constr_may_eval : ((constr_expr,reference) may_eval,constr_expr,'ta)
 val globwit_constr_may_eval : ((rawconstr_and_expr,evaluable_global_reference and_short_name or_var) may_eval,rawconstr_and_expr,'ta) abstract_argument_type
 val wit_constr_may_eval : (constr,constr,'ta) abstract_argument_type
 
+val rawwit_open_constr_gen : bool -> (open_constr_expr,constr_expr,'ta) abstract_argument_type
+val globwit_open_constr_gen : bool -> (open_rawconstr,rawconstr_and_expr,'ta) abstract_argument_type
+val wit_open_constr_gen : bool -> (open_constr,constr,'ta) abstract_argument_type
+
 val rawwit_open_constr : (open_constr_expr,constr_expr,'ta) abstract_argument_type
 val globwit_open_constr : (open_rawconstr,rawconstr_and_expr,'ta) abstract_argument_type
 val wit_open_constr : (open_constr,constr,'ta) abstract_argument_type
@@ -157,9 +162,9 @@ val globwit_red_expr : ((rawconstr_and_expr,evaluable_global_reference and_short
 val wit_red_expr : ((constr,evaluable_global_reference) red_expr_gen,constr,'ta) abstract_argument_type
 
 (* TODO: transformer tactic en extra arg *)
-val rawwit_tactic : ('ta,constr_expr,'ta) abstract_argument_type
-val globwit_tactic : ('ta,rawconstr_and_expr,'ta) abstract_argument_type
-val wit_tactic : ('ta,constr,'ta) abstract_argument_type
+val rawwit_tactic : int -> ('ta,constr_expr,'ta) abstract_argument_type
+val globwit_tactic : int -> ('ta,rawconstr_and_expr,'ta) abstract_argument_type
+val wit_tactic : int -> ('ta,constr,'ta) abstract_argument_type
 
 val wit_list0 :
   ('a,'co,'ta) abstract_argument_type -> ('a list,'co,'ta) abstract_argument_type
@@ -227,16 +232,15 @@ type argument_type =
   | PreIdentArgType
   | IntroPatternArgType
   | IdentArgType
-  | HypArgType
+  | VarArgType
   | RefArgType
   (* Specific types *)
   | SortArgType
   | ConstrArgType
   | ConstrMayEvalArgType
   | QuantHypArgType
-  | TacticArgType
-  | OpenConstrArgType
-  | CastedOpenConstrArgType
+  | TacticArgType of int
+  | OpenConstrArgType of bool
   | ConstrWithBindingsArgType
   | BindingsArgType
   | RedExprArgType
@@ -268,4 +272,3 @@ val in_gen :
   ('a,'co,'ta) abstract_argument_type -> 'a -> ('co,'ta) generic_argument
 val out_gen :
   ('a,'co,'ta) abstract_argument_type -> ('co,'ta) generic_argument -> 'a 
-
diff --git a/interp/modintern.ml b/interp/modintern.ml
index 0929119c..71bd431d 100644
--- a/interp/modintern.ml
+++ b/interp/modintern.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: modintern.ml,v 1.2.2.1 2004/07/16 19:30:22 herbelin Exp $ *)
+(* $Id: modintern.ml 6582 2005-01-13 14:28:56Z sacerdot $ *)
 
 open Pp
 open Util
@@ -79,10 +79,10 @@ let lookup_modtype (loc,qid) =
 	Modops.error_not_a_modtype_loc loc (string_of_qualid qid)
 
 let transl_with_decl env = function 
-  | CWith_Module ((_,id),qid) ->
-      With_Module (id,lookup_module qid)
-  | CWith_Definition ((_,id),c) ->
-      With_Definition (id,interp_constr Evd.empty env c)
+  | CWith_Module ((_,fqid),qid) ->
+      With_Module (fqid,lookup_module qid)
+  | CWith_Definition ((_,fqid),c) ->
+      With_Definition (fqid,interp_constr Evd.empty env c)
 
 let rec interp_modtype env = function 
   | CMTEident qid ->
diff --git a/interp/modintern.mli b/interp/modintern.mli
index 050d9f94..844450ac 100644
--- a/interp/modintern.mli
+++ b/interp/modintern.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: modintern.mli,v 1.1.6.1 2004/07/16 19:30:22 herbelin Exp $ i*)
+(*i $Id: modintern.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Declarations
diff --git a/interp/symbols.ml b/interp/notation.ml
index d1abb084..cb996dfe 100644
--- a/interp/symbols.ml
+++ b/interp/notation.ml
@@ -6,13 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: symbols.ml,v 1.31.2.2 2004/11/17 09:33:38 herbelin Exp $ *)
+(* $Id: notation.ml 7984 2006-02-04 20:14:55Z herbelin $ *)
 
 (*i*)
 open Util
 open Pp
-open Bignat
+open Bigint
 open Names
+open Term
 open Nametab
 open Libnames
 open Summary
@@ -30,7 +31,7 @@ open Ppextend
     terms and patterns can be set; these interpreters are in permanent table
     [numeral_interpreter_tab]
   - a set of ML printers for expressions denoting numbers parsable in 
-    this scope (permanently declared in [Esyntax.primitive_printer_tab])
+    this scope
   - a set of interpretations for infix (more generally distfix) notations
   - an optional pair of delimiters which, when occurring in a syntactic
     expression, set this scope to be the current scope
@@ -41,20 +42,21 @@ open Ppextend
 
 type level = precedence * tolerability list
 type delimiters = string
+type notation_location = dir_path * string
 
 type scope = {
-  notations: (interpretation * (dir_path * string) * bool) Stringmap.t;
+  notations: (string, interpretation * notation_location) Gmap.t;
   delimiters: delimiters option
 }
 
 (* Uninterpreted notation map: notation -> level * dir_path *)
-let notation_level_map = ref Stringmap.empty
+let notation_level_map = ref Gmap.empty
 
 (* Scopes table: scope_name -> symbol_interpretation *)
-let scope_map = ref Stringmap.empty
+let scope_map = ref Gmap.empty
 
 let empty_scope = {
-  notations = Stringmap.empty;
+  notations = Gmap.empty;
   delimiters = None
 }
 
@@ -62,20 +64,20 @@ let default_scope = "" (* empty name, not available from outside *)
 let type_scope = "type_scope" (* special scope used for interpreting types *)
 
 let init_scope_map () =
-  scope_map := Stringmap.add default_scope empty_scope !scope_map;
-  scope_map := Stringmap.add type_scope empty_scope !scope_map
+  scope_map := Gmap.add default_scope empty_scope !scope_map;
+  scope_map := Gmap.add type_scope empty_scope !scope_map
 
 (**********************************************************************)
 (* Operations on scopes *)
 
 let declare_scope scope =
-  try let _ = Stringmap.find scope !scope_map in ()
+  try let _ = Gmap.find scope !scope_map in ()
   with Not_found ->
 (*    Options.if_verbose message ("Creating scope "^scope);*)
-    scope_map := Stringmap.add scope empty_scope !scope_map
+    scope_map := Gmap.add scope empty_scope !scope_map
 
 let find_scope scope =
-  try Stringmap.find scope !scope_map
+  try Gmap.find scope !scope_map
   with Not_found -> error ("Scope "^scope^" is not declared")
 
 let check_scope sc = let _ = find_scope sc in ()
@@ -93,9 +95,14 @@ let current_scopes () = !scope_stack
 (* TODO: push nat_scope, z_scope, ... in scopes summary *)
 
 (* Exportation of scopes *)
-let cache_scope (_,(local,op,sc)) =
+let open_scope i (_,(local,op,sc)) =
+  if i=1 then begin
   (match sc with Scope sc -> check_scope sc | _ -> ());
   scope_stack := if op then sc :: !scope_stack else list_except sc !scope_stack
+  end
+
+let cache_scope o =
+  open_scope 1 o
 
 let subst_scope (_,subst,sc) = sc
 
@@ -109,7 +116,7 @@ let export_scope (local,_,_ as x) = if local then None else Some x
 let (inScope,outScope) = 
   declare_object {(default_object "SCOPE") with
       cache_function = cache_scope;
-      open_function = (fun i o -> if i=1 then cache_scope o);
+      open_function = open_scope;
       subst_function = subst_scope;
       classify_function = classify_scope;
       export_function = export_scope }
@@ -121,10 +128,12 @@ let empty_scope_stack = []
 
 let push_scope sc scopes = Scope sc :: scopes
 
+let push_scopes = List.fold_right push_scope
+
 (**********************************************************************)
 (* Delimiters *)
 
-let delimiters_map = ref Stringmap.empty
+let delimiters_map = ref Gmap.empty
 
 let declare_delimiters scope key =
   let sc = find_scope scope in
@@ -134,15 +143,15 @@ let declare_delimiters scope key =
       warning ("Overwritting previous delimiting key "^old^" in scope "^scope)
   end;
   let sc = { sc with delimiters = Some key } in
-  scope_map := Stringmap.add scope sc !scope_map;
-  if Stringmap.mem key !delimiters_map then begin
-    let oldsc = Stringmap.find key !delimiters_map in
+  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)
   end;
-  delimiters_map := Stringmap.add key scope !delimiters_map
+  delimiters_map := Gmap.add key scope !delimiters_map
 
 let find_delimiters_scope loc key = 
-  try Stringmap.find key !delimiters_map
+  try Gmap.find key !delimiters_map
   with Not_found -> 
     user_err_loc 
     (loc, "find_delimiters", str ("Unknown scope delimiting key "^key))
@@ -162,7 +171,7 @@ type key =
 
 (* Scopes table : interpretation -> scope_name *)
 let notations_key_table = ref Gmapl.empty
-let numeral_key_table = Hashtbl.create 7
+let prim_token_key_table = Hashtbl.create 7
 
 let rawconstr_key = function
   | RApp (_,RRef (_,ref),_) -> RefKey ref
@@ -186,50 +195,66 @@ let pattern_key = function
 (**********************************************************************)
 (* Interpreting numbers (not in summary because functional objects)   *)
 
-type num_interpreter =
-    (loc -> bigint -> rawconstr)
-    * (loc -> bigint -> name -> cases_pattern) option
+type required_module = section_path * string list 
 
-type num_uninterpreter =
-    rawconstr list * (rawconstr -> bigint option)
-    * (cases_pattern -> bigint option) option
+type 'a prim_token_interpreter =
+    loc -> 'a -> rawconstr
 
-type required_module = global_reference * string list 
+type cases_pattern_status = bool (* true = use prim token in patterns *)
 
-let numeral_interpreter_tab =
-  (Hashtbl.create 7 : (scope_name,required_module*num_interpreter) Hashtbl.t)
+type 'a prim_token_uninterpreter =
+    rawconstr list * (rawconstr -> 'a option) * cases_pattern_status
 
-let declare_numeral_interpreter sc dir interp (patl,uninterp,uninterpc) =
+type internal_prim_token_interpreter =
+    loc -> prim_token -> required_module * (unit -> rawconstr)
+
+let prim_token_interpreter_tab =
+  (Hashtbl.create 7 : (scope_name, internal_prim_token_interpreter) Hashtbl.t)
+
+let add_prim_token_interpreter sc interp =
+  try 
+    let cont = Hashtbl.find prim_token_interpreter_tab sc in
+    Hashtbl.replace prim_token_interpreter_tab sc (interp cont)
+  with Not_found ->
+    let cont = (fun _loc _p -> raise Not_found) in
+    Hashtbl.add prim_token_interpreter_tab sc (interp cont)
+
+let declare_prim_token_interpreter sc interp (patl,uninterp,b) =
   declare_scope sc;
-  Hashtbl.add numeral_interpreter_tab sc (dir,interp);
-  List.iter
-    (fun pat -> Hashtbl.add numeral_key_table (rawconstr_key pat)
-      (sc,uninterp,uninterpc))
+  add_prim_token_interpreter sc interp;
+  List.iter (fun pat -> 
+      Hashtbl.add prim_token_key_table (rawconstr_key pat) (sc,uninterp,b))
     patl
 
-let check_required_module loc sc (ref,d) =
-  let d' = List.map id_of_string d in
-  let dir = make_dirpath (List.rev d') in
-  try let _ = sp_of_global ref in ()
+let mkNumeral n = Numeral n
+let mkString s = String s
+
+let delay dir int loc x = (dir, (fun () -> int loc x))
+
+let declare_numeral_interpreter sc dir interp (patl,uninterp,inpat) =
+  declare_prim_token_interpreter sc
+    (fun cont loc -> function Numeral n-> delay dir interp loc n | p -> cont loc p)
+    (patl, (fun r -> option_app mkNumeral (uninterp r)), inpat)
+
+let declare_string_interpreter sc dir interp (patl,uninterp,inpat) =
+  declare_prim_token_interpreter sc
+    (fun cont loc -> function String s -> delay dir interp loc s | p -> cont loc p)
+    (patl, (fun r -> option_app mkString (uninterp r)), inpat)
+
+let check_required_module loc sc (sp,d) =
+  try let _ = Nametab.absolute_reference sp in ()
   with Not_found ->
-    user_err_loc (loc,"numeral_interpreter",
-    str ("Cannot interpret numbers in "^sc^" without requiring first module "
+    user_err_loc (loc,"prim_token_interpreter",
+    str ("Cannot interpret in "^sc^" without requiring first module "
     ^(list_last d)))
 
-let lookup_numeral_interpreter loc = function
-  | Scope sc ->
-      let (dir,interpreter) = Hashtbl.find numeral_interpreter_tab sc in
-      check_required_module loc sc dir;
-      interpreter
-  | SingleNotation _ -> raise Not_found
-
 (* Look if some notation or numeral printer in [scope] can be used in
    the scope stack [scopes], and if yes, using delimiters or not *)
 
 let find_with_delimiters = function
   | None -> None
   | Some scope ->
-      match (Stringmap.find scope !scope_map).delimiters with
+      match (Gmap.find scope !scope_map).delimiters with
 	| Some key -> Some (Some scope, Some key)
 	| None -> None
 
@@ -257,48 +282,80 @@ let rec find_without_delimiters find (ntn_scope,ntn) = function
 (* Uninterpreted notation levels *)
 
 let declare_notation_level ntn level =
-  if not !Options.v7 & Stringmap.mem ntn !notation_level_map then
+  if Gmap.mem ntn !notation_level_map then
     error ("Notation "^ntn^" is already assigned a level");
-  notation_level_map := Stringmap.add ntn level !notation_level_map
+  notation_level_map := Gmap.add ntn level !notation_level_map
 
 let level_of_notation ntn =
-  Stringmap.find ntn !notation_level_map
+  Gmap.find ntn !notation_level_map
 
 (* The mapping between notations and their interpretation *)
 
-let declare_notation_interpretation ntn scopt pat df pp8only =
+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 Stringmap.mem ntn sc.notations && Options.is_verbose () then
+  if Gmap.mem ntn sc.notations && Options.is_verbose () then
     warning ("Notation "^ntn^" was already used"^
     (if scopt = None then "" else " in scope "^scope));
-  let sc = { sc with notations = Stringmap.add ntn (pat,df,pp8only) sc.notations } in
-  scope_map := Stringmap.add scope sc !scope_map;
+  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
 
 let declare_uninterpretation rule (metas,c as pat) =
   let (key,n) = aconstr_key c in
   notations_key_table := Gmapl.add key (rule,pat,n) !notations_key_table
 
-let rec find_interpretation f = function
-  | sce :: scopes ->
-      let scope = match sce with
-	| Scope s -> s 
-	| SingleNotation _ -> default_scope in
-      (try f scope
-      with Not_found -> find_interpretation f scopes)
+let rec find_interpretation find = function
   | [] -> raise Not_found
+  | sce :: scopes ->
+      let sc,sco = match sce with
+	| Scope sc -> sc, Some sc
+	| SingleNotation _ -> default_scope, None in
+      try
+	let (pat,df) = find sc in
+	pat,(df,sco)
+      with Not_found ->
+	find_interpretation find scopes
+
+let find_notation ntn sc =
+  Gmap.find ntn (find_scope sc).notations
+
+let notation_of_prim_token = function
+  | Numeral n when is_pos_or_zero n -> to_string n
+  | Numeral n -> "- "^(to_string (neg n))
+  | String _ -> raise Not_found
+
+let find_prim_token g loc p sc =
+  (* Try for a user-defined numerical notation *)
+  try
+    let (_,c),df = find_notation (notation_of_prim_token p) sc in
+    g (rawconstr_of_aconstr loc c),df
+  with Not_found ->
+  (* Try for a primitive numerical notation *)
+  let (spdir,interp) = Hashtbl.find prim_token_interpreter_tab sc loc p in
+  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
+  with Not_found ->
+    user_err_loc (loc,"interp_prim_token",
+    (match p with
+      | Numeral n -> str "No interpretation for numeral " ++ pr_bigint n
+      | String s -> str "No interpretation for string " ++ qs s))
+
+let interp_prim_token =
+  interp_prim_token_gen (fun x -> x)
+
+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 =
-  let f sc =
-    let scope = find_scope sc in
-    let (pat,df,pp8only) = Stringmap.find ntn scope.notations in
-    if pp8only then raise Not_found;
-    pat,(df,if sc = default_scope then None else Some sc) in
-  try find_interpretation f (List.fold_right push_scope scopes !scope_stack)
-  with Not_found -> 
+  try find_interpretation (find_notation ntn) (push_scopes scopes !scope_stack) 
+  with Not_found ->
     user_err_loc
-      (loc,"",str ("Unknown interpretation for notation \""^ntn^"\""))
+    (loc,"",str ("Unknown interpretation for notation \""^ntn^"\""))
 
 let uninterp_notations c =
   Gmapl.find (rawconstr_key c) !notations_key_table
@@ -308,47 +365,30 @@ let uninterp_cases_pattern_notations c =
 
 let availability_of_notation (ntn_scope,ntn) scopes =
   let f scope =
-    Stringmap.mem ntn (Stringmap.find scope !scope_map).notations in
+    Gmap.mem ntn (Gmap.find scope !scope_map).notations in
   find_without_delimiters f (ntn_scope,Some ntn) scopes
 
-let rec interp_numeral_gen loc f n = function
-  | scope :: scopes ->
-      (try f (lookup_numeral_interpreter loc scope)
-       with Not_found -> interp_numeral_gen loc f n scopes)
-  | [] ->
-      user_err_loc (loc,"interp_numeral",
-      str "No interpretation for numeral " ++ pr_bigint n)
-
-let interp_numeral loc n scopes =
-  interp_numeral_gen loc (fun x -> fst x loc n) n
-    (List.fold_right push_scope scopes !scope_stack)
-
-let interp_numeral_as_pattern loc n name scopes =
-  let f x = match snd x with
-    | None -> raise Not_found
-    | Some g -> g loc n name in
-  interp_numeral_gen loc f n (List.fold_right push_scope scopes !scope_stack)
-
-let uninterp_numeral c =
+let uninterp_prim_token c =
   try 
-    let (sc,numpr,_) = Hashtbl.find numeral_key_table (rawconstr_key c) in
+    let (sc,numpr,_) = Hashtbl.find prim_token_key_table (rawconstr_key c) in
     match numpr c with
       | None -> raise No_match
       | Some n -> (sc,n)
   with Not_found -> raise No_match
 
-let uninterp_cases_numeral c =
+let uninterp_prim_token_cases_pattern c =
   try 
-    match Hashtbl.find numeral_key_table (pattern_key c) with
-      | (_,_,None) -> raise No_match
-      | (sc,_,Some numpr) ->
-	  match numpr c with
-	    | None -> raise No_match
-	    | Some n -> (sc,n)
+    let k = cases_pattern_key c in
+    let (sc,numpr,b) = Hashtbl.find prim_token_key_table k in
+    if not b then raise No_match;
+    let na,c = rawconstr_of_closed_cases_pattern c in
+    match numpr c with
+      | None -> raise No_match
+      | Some n -> (na,sc,n)
   with Not_found -> raise No_match
 
-let availability_of_numeral printer_scope scopes =
-  let f scope = Hashtbl.mem numeral_interpreter_tab scope in
+let availability_of_prim_token printer_scope scopes =
+  let f scope = Hashtbl.mem prim_token_interpreter_tab scope in
   option_app snd (find_without_delimiters f (Some printer_scope,None) scopes)
 
 (* Miscellaneous *)
@@ -356,35 +396,10 @@ let availability_of_numeral printer_scope scopes =
 let exists_notation_in_scope scopt ntn r =
   let scope = match scopt with Some s -> s | None -> default_scope in
   try
-    let sc = Stringmap.find scope !scope_map in
-    let (r',_,pp8only) = Stringmap.find ntn sc.notations in
-    r' = r, pp8only
-  with Not_found -> false, false
-
-(* Special scopes associated to arguments of a global reference *)
-
-let arguments_scope = ref Refmap.empty
-
-let cache_arguments_scope (_,(r,scl)) =
-  List.iter (option_iter check_scope) scl;
-  arguments_scope := Refmap.add r scl !arguments_scope
-
-let subst_arguments_scope (_,subst,(r,scl)) = (subst_global subst r,scl)
-
-let (inArgumentsScope,outArgumentsScope) = 
-  declare_object {(default_object "ARGUMENTS-SCOPE") with
-      cache_function = cache_arguments_scope;
-      load_function = (fun _ o -> cache_arguments_scope o);
-      subst_function = subst_arguments_scope;
-      classify_function = (fun (_,o) -> Substitute o);
-      export_function = (fun x -> Some x) }
-
-let declare_arguments_scope r scl =
-  Lib.add_anonymous_leaf (inArgumentsScope (r,scl))
-
-let find_arguments_scope r =
-  try Refmap.find r !arguments_scope
-  with Not_found -> []
+    let sc = Gmap.find scope !scope_map in
+    let (r',_) = Gmap.find ntn sc.notations in
+    r' = r
+  with Not_found -> false
 
 (**********************************************************************)
 (* Mapping classes to scopes *)
@@ -401,8 +416,6 @@ let declare_class_scope sc cl =
 let find_class_scope cl =
   Gmap.find cl !class_scope_map
 
-open Term
-
 let find_class t =
   let t, _ = decompose_app (Reductionops.whd_betaiotazeta t) in
   match kind_of_term t with
@@ -413,6 +426,9 @@ let find_class t =
     | Sort _ -> CL_SORT
     |  _ -> raise Not_found
 
+(**********************************************************************)
+(* Special scopes associated to arguments of a global reference *)
+
 let rec compute_arguments_scope t =
   match kind_of_term (Reductionops.whd_betaiotazeta t) with
     | Prod (_,t,u) ->
@@ -421,6 +437,37 @@ let rec compute_arguments_scope t =
 	sc :: compute_arguments_scope u
     | _ -> []
 
+let arguments_scope = ref Refmap.empty
+
+let load_arguments_scope _ (_,(r,scl)) =
+  List.iter (option_iter check_scope) scl;
+  arguments_scope := Refmap.add r scl !arguments_scope
+
+let cache_arguments_scope o =
+  load_arguments_scope 1 o
+
+let subst_arguments_scope (_,subst,(r,scl)) = (fst (subst_global subst r),scl)
+
+let discharge_arguments_scope (r,_) =
+  match r with
+    | VarRef _ -> None
+    | _ -> Some (r,compute_arguments_scope (Global.type_of_global r))
+
+let (inArgumentsScope,outArgumentsScope) = 
+  declare_object {(default_object "ARGUMENTS-SCOPE") with
+      cache_function = cache_arguments_scope;
+      load_function = load_arguments_scope;
+      subst_function = subst_arguments_scope;
+      classify_function = (fun (_,o) -> Substitute o);
+      export_function = (fun x -> Some x) }
+
+let declare_arguments_scope r scl =
+  Lib.add_anonymous_leaf (inArgumentsScope (r,scl))
+
+let find_arguments_scope r =
+  try Refmap.find r !arguments_scope
+  with Not_found -> []
+
 let declare_ref_arguments_scope ref =
   let t = Global.type_of_global ref in
   declare_arguments_scope ref (compute_arguments_scope t)
@@ -478,36 +525,33 @@ let pr_scope_classes sc =
     hov 0 (str ("Bound to class"^(if List.tl l=[] then "" else "es")) ++
       spc() ++ prlist_with_sep spc pr_class l) ++ fnl()
 
-let rec rawconstr_of_aconstr () x =
-  rawconstr_of_aconstr_with_binders dummy_loc (fun id () -> (id,())) 
-    rawconstr_of_aconstr () x
-
 let pr_notation_info prraw ntn c =
-  str "\"" ++ str ntn ++ str "\" := " ++ prraw (rawconstr_of_aconstr () c)
+  str "\"" ++ str ntn ++ str "\" := " ++ 
+  prraw (rawconstr_of_aconstr dummy_loc c)
 
 let pr_named_scope prraw scope sc =
  (if scope = default_scope then
-   match Stringmap.fold (fun _ _ x -> x+1) sc.notations 0 with
+   match Gmap.fold (fun _ _ x -> x+1) sc.notations 0 with
      | 0 -> str "No lonely notation"
      | n -> str "Lonely notation" ++ (if n=1 then mt() else str"s")
   else 
     str "Scope " ++ str scope ++ fnl () ++ pr_delimiters_info sc.delimiters)
   ++ fnl ()
   ++ pr_scope_classes scope
-  ++ Stringmap.fold
-       (fun ntn ((_,r),(_,df),_) strm ->
+  ++ Gmap.fold
+       (fun ntn ((_,r),(_,df)) strm ->
 	 pr_notation_info prraw df r ++ fnl () ++ strm)
        sc.notations (mt ())
 
 let pr_scope prraw scope = pr_named_scope prraw scope (find_scope scope)
 
 let pr_scopes prraw =
- Stringmap.fold 
+ Gmap.fold 
    (fun scope sc strm -> pr_named_scope prraw scope sc ++ fnl () ++ strm)
    !scope_map (mt ())
 
 let rec find_default ntn = function
-  | Scope scope::_ when Stringmap.mem ntn (find_scope scope).notations ->
+  | Scope scope::_ when Gmap.mem ntn (find_scope scope).notations ->
       Some scope
   | SingleNotation ntn'::_ when ntn = ntn' -> Some default_scope
   | _::scopes -> find_default ntn scopes
@@ -531,9 +575,9 @@ let browse_notation ntn map =
     if String.contains ntn ' ' then (=) ntn
     else fun ntn' -> List.mem (Terminal ntn) (decompose_notation_key ntn') in
   let l =
-    Stringmap.fold 
+    Gmap.fold 
       (fun scope_name sc ->
-	Stringmap.fold (fun ntn ((_,r),df,_) l ->
+	Gmap.fold (fun ntn ((_,r),df) l ->
 	  if find ntn then (ntn,(scope_name,r,df))::l else l) sc.notations)
       map [] in
   let l = List.sort (fun x y -> Pervasives.compare (fst x) (fst y)) l in
@@ -560,8 +604,8 @@ let locate_notation prraw ntn =
 
 let collect_notation_in_scope scope sc known =
   assert (scope <> default_scope);
-  Stringmap.fold
-    (fun ntn ((_,r),(_,df),_) (l,known as acc) ->
+  Gmap.fold
+    (fun ntn ((_,r),(_,df)) (l,known as acc) ->
       if List.mem ntn known then acc else ((df,r)::l,ntn::known))
     sc.notations ([],known)
 
@@ -577,8 +621,8 @@ let collect_notations stack =
       | SingleNotation ntn ->
 	  if List.mem ntn knownntn then (all,knownntn)
 	  else
-	    let ((_,r),(_,df),_) =
-	      Stringmap.find ntn (find_scope default_scope).notations in
+	    let ((_,r),(_,df)) =
+	      Gmap.find ntn (find_scope default_scope).notations in
 	    let all' = match all with
 	      | (s,lonelyntn)::rest when s = default_scope ->
 		  (s,(df,r)::lonelyntn)::rest
@@ -614,13 +658,13 @@ type unparsing_rule = unparsing list * precedence
 
 (* Concrete syntax for symbolic-extension table *)
 let printing_rules = 
-  ref (Stringmap.empty : unparsing_rule Stringmap.t)
+  ref (Gmap.empty : (string,unparsing_rule) Gmap.t)
 
 let declare_notation_printing_rule ntn unpl =
-  printing_rules := Stringmap.add ntn unpl !printing_rules
+  printing_rules := Gmap.add ntn unpl !printing_rules
 
 let find_notation_printing_rule ntn =
-  try Stringmap.find ntn !printing_rules
+  try Gmap.find ntn !printing_rules
   with Not_found -> anomaly ("No printing rule found for "^ntn)
 
 (**********************************************************************)
@@ -644,13 +688,13 @@ let unfreeze (scm,nlm,scs,asc,dlm,fkm,pprules,clsc) =
 let init () =
   init_scope_map ();
 (*
-  scope_stack := Stringmap.empty
+  scope_stack := Gmap.empty
   arguments_scope := Refmap.empty
 *)
-  notation_level_map := Stringmap.empty;
-  delimiters_map := Stringmap.empty;
+  notation_level_map := Gmap.empty;
+  delimiters_map := Gmap.empty;
   notations_key_table := Gmapl.empty;
-  printing_rules := Stringmap.empty;
+  printing_rules := Gmap.empty;
   class_scope_map := Gmap.add CL_SORT "type_scope" Gmap.empty
 
 let _ = 
diff --git a/interp/symbols.mli b/interp/notation.mli
index 5401ae77..32ec7a96 100644
--- a/interp/symbols.mli
+++ b/interp/notation.mli
@@ -6,12 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: symbols.mli,v 1.22.2.3 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: notation.mli 7984 2006-02-04 20:14:55Z herbelin $ i*)
 
 (*i*)
 open Util
 open Pp
-open Bignat
+open Bigint
 open Names
 open Nametab
 open Libnames
@@ -50,36 +50,47 @@ val push_scope : scope_name -> scopes -> scopes
 val declare_delimiters : scope_name -> delimiters -> unit
 val find_delimiters_scope : loc -> delimiters -> scope_name
 
-(*s Declare and uses back and forth a numeral interpretation *)
+(*s Declare and uses back and forth an interpretation of primitive token *)
 
 (* A numeral interpreter is the pair of an interpreter for **integer**
    numbers in terms and an optional interpreter in pattern, if
    negative numbers are not supported, the interpreter must fail with
    an appropriate error message *)
 
-type num_interpreter =
-    (loc -> bigint -> rawconstr)
-    * (loc -> bigint -> name -> cases_pattern) option
+type notation_location = dir_path * string
+type required_module = section_path * string list 
+type cases_pattern_status = bool (* true = use prim token in patterns *)
 
-type num_uninterpreter =
-    rawconstr list * (rawconstr -> bigint option)
-    * (cases_pattern -> bigint option) option
+type 'a prim_token_interpreter =
+    loc -> 'a -> rawconstr
+
+type 'a prim_token_uninterpreter =
+    rawconstr list * (rawconstr -> 'a option) * cases_pattern_status
 
-type required_module = global_reference * string list 
 val declare_numeral_interpreter : scope_name -> required_module ->
-  num_interpreter -> num_uninterpreter -> unit
+  bigint prim_token_interpreter -> bigint prim_token_uninterpreter -> unit
+
+val declare_string_interpreter : scope_name -> required_module ->
+  string prim_token_interpreter -> string prim_token_uninterpreter -> unit
+
+(* Return the [term]/[cases_pattern] bound to a primitive token in a
+   given scope context*)
 
-(* Return the [term]/[cases_pattern] bound to a numeral in a given scope context*)
-val interp_numeral : loc -> bigint -> scope_name list -> rawconstr
-val interp_numeral_as_pattern : loc -> bigint -> name -> scope_name list ->
-  cases_pattern
+val interp_prim_token : loc -> prim_token -> scope_name list -> 
+  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)
 
-(* Return the numeral bound to a [term]/[cases_pattern]; raise [No_match] if no *)
-(* such numeral *)
-val uninterp_numeral : rawconstr -> scope_name * bigint
-val uninterp_cases_numeral : cases_pattern -> scope_name * bigint
+(* Return the primitive token associated to a [term]/[cases_pattern];
+   raise [No_match] if no such token *)
 
-val availability_of_numeral : scope_name -> scopes -> delimiters option option
+val uninterp_prim_token : 
+  rawconstr -> scope_name * prim_token
+val uninterp_prim_token_cases_pattern : 
+  cases_pattern -> name * scope_name * prim_token
+
+val availability_of_prim_token : 
+  scope_name -> scopes -> delimiters option option
 
 (*s Declare and interpret back and forth a notation *)
 
@@ -87,14 +98,15 @@ val availability_of_numeral : scope_name -> scopes -> delimiters option option
 type interp_rule =
   | NotationRule of scope_name option * notation
   | SynDefRule of kernel_name
+
 val declare_notation_interpretation : notation -> scope_name option ->
-      interpretation -> dir_path * string -> bool -> unit
+      interpretation -> notation_location -> unit
 
 val declare_uninterpretation : interp_rule -> interpretation -> unit
 
 (* Return the interpretation bound to a notation *)
 val interp_notation : loc -> notation -> scope_name list -> 
-      interpretation * ((dir_path * string) * scope_name option)
+      interpretation * (notation_location * scope_name option)
 
 (* Return the possible notations for a given term *)
 val uninterp_notations : rawconstr ->
@@ -103,23 +115,21 @@ val uninterp_cases_pattern_notations : cases_pattern ->
       (interp_rule * interpretation * int option) list
 
 (* 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; the second *)
-(* argument is a numeral printer if the *)
+(* 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 -> 
   (scope_name option * delimiters option) option
 
 (*s Declare and test the level of a (possibly uninterpreted) notation *)
 
-val declare_notation_level : notation -> level option * level -> unit
-val level_of_notation : notation -> level option * level 
-      (* raise [Not_found] if no level *)
+val declare_notation_level : notation -> level -> unit
+val level_of_notation : notation -> level (* raise [Not_found] if no level *)
 
 (*s** Miscellaneous *)
 
 (* Checks for already existing notations *)
 val exists_notation_in_scope : scope_name option -> notation ->
-      interpretation -> bool * bool
+      interpretation -> bool
 
 (* Declares and looks for scopes associated to arguments of a global ref *)
 val declare_arguments_scope: global_reference -> scope_name option list -> unit
@@ -157,4 +167,4 @@ val declare_notation_printing_rule : notation -> unparsing_rule -> unit
 val find_notation_printing_rule : notation -> unparsing_rule
 
 (**********************************************************************)
-(* Rem: printing rules for numerals are trivial *)
+(* Rem: printing rules for primitive token are canonical *)
diff --git a/interp/ppextend.ml b/interp/ppextend.ml
index 29fb7cc7..34e93624 100644
--- a/interp/ppextend.ml
+++ b/interp/ppextend.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ppextend.ml,v 1.4.2.1 2004/07/16 19:30:22 herbelin Exp $ *)
+(*i $Id: ppextend.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (*i*)
 open Pp
diff --git a/interp/ppextend.mli b/interp/ppextend.mli
index bc0a83ec..3d49c210 100644
--- a/interp/ppextend.mli
+++ b/interp/ppextend.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ppextend.mli,v 1.4.2.2 2005/01/21 16:41:50 herbelin Exp $ i*)
+(*i $Id: ppextend.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
 
 (*i*)
 open Pp
diff --git a/interp/reserve.ml b/interp/reserve.ml
index 72899676..476fd7e6 100644
--- a/interp/reserve.ml
+++ b/interp/reserve.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: reserve.ml,v 1.10.2.1 2004/07/16 19:30:22 herbelin Exp $ i*)
+(*i $Id: reserve.ml 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
 (* Reserved names *)
 
@@ -57,14 +57,11 @@ let rec unloc = function
   | RLambda (_,na,ty,c) -> RLambda (dummy_loc,na,unloc ty,unloc c)
   | RProd (_,na,ty,c) -> RProd (dummy_loc,na,unloc ty,unloc c)
   | RLetIn (_,na,b,c) -> RLetIn (dummy_loc,na,unloc b,unloc c)
-  | RCases (_,(tyopt,rtntypopt),tml,pl) ->
+  | RCases (_,rtntypopt,tml,pl) ->
       RCases (dummy_loc,
-        (option_app unloc tyopt,ref (option_app unloc !rtntypopt)),
+        (option_app unloc rtntypopt),
 	List.map (fun (tm,x) -> (unloc tm,x)) tml,
         List.map (fun (_,idl,p,c) -> (dummy_loc,idl,p,unloc c)) pl)
-  | ROrderedCase (_,b,tyopt,tm,bv,x) ->
-      ROrderedCase 
-      (dummy_loc,b,option_app unloc tyopt,unloc tm, Array.map unloc bv,x)
   | RLetTuple (_,nal,(na,po),b,c) ->
       RLetTuple (dummy_loc,nal,(na,option_app unloc po),unloc b,unloc c)
   | RIf (_,c,(na,po),b1,b2) ->
@@ -76,7 +73,7 @@ let rec unloc = function
               bl,
             Array.map unloc tyl,
             Array.map unloc bv)
-  | RCast (_,c,t) -> RCast (dummy_loc,unloc c,unloc t)
+  | RCast (_,c,k,t) -> RCast (dummy_loc,unloc c,k,unloc t)
   | RSort (_,x) -> RSort (dummy_loc,x)
   | RHole (_,x)  -> RHole (dummy_loc,x)
   | RRef (_,x) -> RRef (dummy_loc,x)
@@ -86,10 +83,9 @@ let rec unloc = function
 
 let anonymize_if_reserved na t = match na with
   | Name id as na ->
-      if !Options.v7 & id = id_of_string "_" then t else
       (try 
 	if unloc t = find_reserved_type id
-	then RHole (dummy_loc,BinderType na)
+	then RHole (dummy_loc,Evd.BinderType na)
 	else t
       with Not_found -> t)
   | Anonymous -> t
diff --git a/interp/reserve.mli b/interp/reserve.mli
index a79e2c25..13349ee9 100644
--- a/interp/reserve.mli
+++ b/interp/reserve.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: reserve.mli,v 1.2.2.1 2004/07/16 19:30:22 herbelin Exp $ i*)
+(*i $Id: reserve.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 open Util
 open Names
diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml
index ceda2b47..3389cd8a 100644
--- a/interp/syntax_def.ml
+++ b/interp/syntax_def.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: syntax_def.ml,v 1.6.2.2 2006/01/03 20:33:31 herbelin Exp $ *)
+(* $Id: syntax_def.ml 7779 2006-01-03 20:33:47Z herbelin $ *)
 
 open Util
 open Pp
@@ -39,21 +39,21 @@ let load_syntax_constant i ((sp,kn),(local,c,onlyparse)) =
   add_syntax_constant kn c;
   Nametab.push_syntactic_definition (Nametab.Until i) sp kn;
   if not onlyparse then
-    (* Declare it to be used as (long) name *)
-    Symbols.declare_uninterpretation (Symbols.SynDefRule kn) ([],c)
+    (* Declare it to be used as long name *)
+    Notation.declare_uninterpretation (Notation.SynDefRule kn) ([],c)
 
 let open_syntax_constant i ((sp,kn),(_,c,onlyparse)) =
   Nametab.push_syntactic_definition (Nametab.Exactly i) sp kn;
   if not onlyparse then
     (* Redeclare it to be used as (short) name in case an other (distfix)
        notation was declared inbetween *)
-    Symbols.declare_uninterpretation (Symbols.SynDefRule kn) ([],c)
+    Notation.declare_uninterpretation (Notation.SynDefRule kn) ([],c)
 
 let cache_syntax_constant d =
   load_syntax_constant 1 d
 
 let subst_syntax_constant ((sp,kn),subst,(local,c,onlyparse)) =
-  (local,subst_aconstr subst c,onlyparse)
+  (local,subst_aconstr subst [] c,onlyparse)
 
 let classify_syntax_constant (_,(local,_,_ as o)) =
   if local then Dispose else Substitute o
@@ -78,3 +78,15 @@ let rec set_loc loc _ a =
 
 let search_syntactic_definition loc kn =
   set_loc loc () (KNmap.find kn !syntax_table)
+
+exception BoundToASyntacticDefThatIsNotARef
+
+let locate_global qid =
+  match Nametab.extended_locate qid with
+  | TrueGlobal ref -> ref
+  | SyntacticDef kn -> 
+  match search_syntactic_definition dummy_loc kn with
+  | Rawterm.RRef (_,ref) -> ref
+  | _ -> 
+      errorlabstrm "" (pr_qualid qid ++ 
+        str " is bound to a notation that does not denote a reference")
diff --git a/interp/syntax_def.mli b/interp/syntax_def.mli
index 0aec03c2..ac7318b5 100644
--- a/interp/syntax_def.mli
+++ b/interp/syntax_def.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: syntax_def.mli,v 1.3.2.2 2004/07/16 19:30:23 herbelin Exp $ i*)
+(*i $Id: syntax_def.mli 7051 2005-05-20 15:45:51Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -23,3 +23,10 @@ val declare_syntactic_definition : bool -> identifier -> bool -> aconstr
 val search_syntactic_definition : loc -> kernel_name -> rawconstr
 
 
+(* [locate_global] locates global reference possibly following a chain of 
+   syntactic aliases; raise Not_found if not bound in the global env; 
+   raise an error if bound to a syntactic def that does not denote a
+   reference *)
+
+val locate_global : Libnames.qualid -> Libnames.global_reference
+
diff --git a/interp/topconstr.ml b/interp/topconstr.ml
index a2b6e8b7..82f74f40 100644
--- a/interp/topconstr.ml
+++ b/interp/topconstr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: topconstr.ml,v 1.35.2.3 2004/11/17 09:51:41 herbelin Exp $ *)
+(* $Id: topconstr.ml 8624 2006-03-13 17:38:17Z msozeau $ *)
 
 (*i*)
 open Pp
@@ -16,6 +16,7 @@ open Nameops
 open Libnames
 open Rawterm
 open Term
+open Mod_subst
 (*i*)
 
 (**********************************************************************)
@@ -36,20 +37,19 @@ type aconstr =
   | ALambda of name * aconstr * aconstr
   | AProd of name * aconstr * aconstr
   | ALetIn of name * aconstr * aconstr
-  | ACases of aconstr option * aconstr option *
+  | ACases of aconstr option *
       (aconstr * (name * (inductive * name list) option)) list *
       (identifier list * cases_pattern list * aconstr) list
-  | AOrderedCase of case_style * aconstr option * aconstr * aconstr array
   | ALetTuple of name list * (name * aconstr option) * aconstr * aconstr
   | AIf of aconstr * (name * aconstr option) * aconstr * aconstr
   | ASort of rawsort
-  | AHole of hole_kind
+  | AHole of Evd.hole_kind
   | APatVar of patvar
-  | ACast of aconstr * aconstr
+  | ACast of aconstr * cast_kind * aconstr
   
 let name_app f e = function
-  | Name id -> let (id, e) = f id e in (Name id, e)
-  | Anonymous -> Anonymous, e
+  | Name id -> let (id, e) = f id e in (e, Name id)
+  | Anonymous -> e,Anonymous
 
 let rec subst_rawvars l = function
   | RVar (_,id) as r -> (try List.assoc id l with Not_found -> r)
@@ -67,40 +67,44 @@ 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 na,e = name_app g e na in RLambda (loc,na,f e ty,f e c)
+      let e,na = name_app g e na in RLambda (loc,na,f e ty,f e c)
   | AProd (na,ty,c) ->
-      let na,e = name_app g e na in RProd (loc,na,f e ty,f e c)
+      let e,na = name_app g e na in RProd (loc,na,f e ty,f e c)
   | ALetIn (na,b,c) ->
-      let na,e = name_app g e na in RLetIn (loc,na,f e b,f e c)
-  | ACases (tyopt,rtntypopt,tml,eqnl) ->
-      let cases_predicate_names tml =
-	List.flatten (List.map (function
-	  | (tm,(na,None)) -> [na]
-	  | (tm,(na,Some (_,nal))) -> na::nal) tml) in
-      (* TODO: apply g to na (in fact not used) *)
-      let e' = List.fold_right
-	(fun na e -> snd (name_app g e na)) (cases_predicate_names tml) e in
+      let e,na = name_app 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,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
+	  e',Some (loc,ind,nal') in
+	let e',na' = name_app 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
-      RCases (loc,(option_app (f e) tyopt, ref (option_app (f e') rtntypopt)),
-        List.map (fun (tm,(na,x)) -> 
-	  (f e tm,ref (na,option_app (fun (x,y) -> (loc,x,y)) x))) tml,eqnl)
-  | AOrderedCase (b,tyopt,tm,bv) ->
-      ROrderedCase (loc,b,option_app (f e) tyopt,f e tm,Array.map (f e) bv,ref None)
+      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
+      RCases (loc,option_app (f e') rtntypopt,tml',eqnl')
   | ALetTuple (nal,(na,po),b,c) ->
-      let e,nal = list_fold_map (fun e na -> let (na,e) = name_app g e na in e,na) e nal in 
-      let na,e = name_app g e na in
+      let e,nal = list_fold_map (name_app g) e nal in 
+      let e,na = name_app g e na in
       RLetTuple (loc,nal,(na,option_app (f e) po),f e b,f e c)
   | AIf (c,(na,po),b1,b2) ->
-      let na,e = name_app g e na in
+      let e,na = name_app g e na in
       RIf (loc,f e c,(na,option_app (f e) po),f e b1,f e b2)
-  | ACast (c,t) -> RCast (loc,f e c,f e t)
+  | ACast (c,k,t) -> RCast (loc,f e c,k,f e t)
   | ASort x -> RSort (loc,x)
   | AHole x  -> RHole (loc,x)
   | APatVar n -> RPatVar (loc,(false,n))
   | ARef x -> RRef (loc,x)
 
+let rec rawconstr_of_aconstr loc x =
+  let rec 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
@@ -110,100 +114,6 @@ let rec subst_pat subst pat =
         if kn' == kn && cpl' == cpl then pat else
           PatCstr (loc,((kn',i),j),cpl',n)
 
-let rec subst_aconstr subst raw =
-  match raw with
-  | ARef ref -> 
-      let ref' = subst_global subst ref in 
-	if ref' == ref then raw else
-	  ARef ref'
-
-  | AVar _ -> raw
-
-  | AApp (r,rl) -> 
-      let r' = subst_aconstr subst r 
-      and rl' = list_smartmap (subst_aconstr subst) rl in
-	if r' == r && rl' == rl then raw else
-	  AApp(r',rl')
-
-  | AList (id1,id2,r1,r2,b) -> 
-      let r1' = subst_aconstr subst r1 and r2' = subst_aconstr subst 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 r1 and r2' = subst_aconstr subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  ALambda (n,r1',r2')
-
-  | AProd (n,r1,r2) -> 
-      let r1' = subst_aconstr subst r1 and r2' = subst_aconstr subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  AProd (n,r1',r2')
-
-  | ALetIn (n,r1,r2) -> 
-      let r1' = subst_aconstr subst r1 and r2' = subst_aconstr subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  ALetIn (n,r1',r2')
-
-  | ACases (ro,rtntypopt,rl,branches) -> 
-      let ro' = option_smartmap (subst_aconstr subst) ro 
-      and rtntypopt' = option_smartmap (subst_aconstr subst) rtntypopt
-      and rl' = list_smartmap
-        (fun (a,(n,signopt) as x) -> 
-	  let a' = subst_aconstr subst a in
-	  let signopt' = option_app (fun ((indkn,i),nal as z) ->
-	    let indkn' = subst_kn subst indkn in
-	    if indkn == indkn' then z else ((indkn',i),nal)) signopt in
-	  if a' == a && signopt' == signopt then x else (a',(n,signopt')))
-        rl
-      and branches' = list_smartmap 
-                        (fun (idl,cpl,r as branch) ->
-                           let cpl' = list_smartmap (subst_pat subst) cpl
-                           and r' = subst_aconstr subst r in
-                             if cpl' == cpl && r' == r then branch else
-                               (idl,cpl',r'))
-                        branches
-      in
-        if ro' == ro && rtntypopt == rtntypopt' &
-          rl' == rl && branches' == branches then raw else
-          ACases (ro',rtntypopt',rl',branches')
-
-  | AOrderedCase (b,ro,r,ra) -> 
-      let ro' = option_smartmap (subst_aconstr subst) ro
-      and r' = subst_aconstr subst r 
-      and ra' = array_smartmap (subst_aconstr subst) ra in
-	if ro' == ro && r' == r && ra' == ra then raw else
-	  AOrderedCase (b,ro',r',ra')
-
-  | ALetTuple (nal,(na,po),b,c) ->
-      let po' = option_smartmap (subst_aconstr subst) po
-      and b' = subst_aconstr subst b 
-      and c' = subst_aconstr subst c in
-	if po' == po && b' == b && c' == c then raw else
-	  ALetTuple (nal,(na,po'),b',c')
-
-  | AIf (c,(na,po),b1,b2) ->
-      let po' = option_smartmap (subst_aconstr subst) po
-      and b1' = subst_aconstr subst b1
-      and b2' = subst_aconstr subst b2 
-      and c' = subst_aconstr subst c in
-	if po' == po && b1' == b1 && b2' == b2 && c' == c then raw else
-	  AIf (c',(na,po'),b1',b2')
-
-  | APatVar _ | ASort _ -> raw
-
-  | AHole (ImplicitArg (ref,i)) ->
-      let ref' = subst_global subst ref in 
-	if ref' == ref then raw else
-	  AHole (ImplicitArg (ref',i))
-  | AHole (BinderType _ | QuestionMark | CasesType |
-      InternalHole | TomatchTypeParameter _) -> raw
-
-  | ACast (r1,r2) -> 
-      let r1' = subst_aconstr subst r1 and r2' = subst_aconstr subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  ACast (r1',r2')
-
 let add_name r = function
   | Anonymous -> ()
   | Name id -> r := id :: !r
@@ -222,9 +132,9 @@ let compare_rawconstr f t1 t2 = match t1,t2 with
       f ty1 ty2 & f c1 c2
   | RHole _, RHole _ -> true
   | RSort (_,s1), RSort (_,s2) -> s1 = s2
-  | (RLetIn _ | RCases _ | ROrderedCase _ | RRec _ | RDynamic _
+  | (RLetIn _ | RCases _ | RRec _ | RDynamic _
     | RPatVar _ | REvar _ | RLetTuple _ | RIf _ | RCast _),_
-  | _,(RLetIn _ | RCases _ | ROrderedCase _ | RRec _ | RDynamic _
+  | _,(RLetIn _ | RCases _ | RRec _ | RDynamic _
       | RPatVar _ | REvar _ | RLetTuple _ | RIf _ | RCast _)
       -> error "Unsupported construction in recursive notations"
   | (RRef _ | RVar _ | RApp _ | RLambda _ | RProd _ | RHole _ | RSort _), _
@@ -232,7 +142,7 @@ let compare_rawconstr f t1 t2 = match t1,t2 with
 
 let rec eq_rawconstr t1 t2 = compare_rawconstr eq_rawconstr t1 t2
 
-let discriminate_patterns nl l1 l2 =
+let discriminate_patterns foundvars nl l1 l2 =
   let diff = ref None in
   let rec aux n c1 c2 = match c1,c2 with
   | RVar (_,v1), RVar (_,v2) when v1<>v2 ->
@@ -245,42 +155,48 @@ let discriminate_patterns nl l1 l2 =
   let l = list_map2_i aux 0 l1 l2 in
   if not (List.for_all ((=) true) l) then
     error "Both ends of the recursive pattern differ";
-  !diff
+  match !diff with
+    | None ->  error "Both ends of the recursive pattern are the same"
+    | Some (x,y,_ as discr) ->
+	List.iter (fun id ->
+          if List.mem id !foundvars
+          then error "Variables used in the recursive part of a pattern are not allowed to occur outside of the recursive part";
+          foundvars := id::!foundvars) [x;y];
+	discr
 
 let aconstr_and_vars_of_rawconstr a =
   let found = ref [] in
-  let bound_binders = ref [] in
   let rec aux = function
-  | RVar (_,id) -> 
-      if not (List.mem id !bound_binders) then found := id::!found;
-      AVar id
+  | RVar (_,id) -> found := id::!found; AVar id
   | RApp (_,f,args) when has_ldots args -> make_aconstr_list f args 
+  | RApp (_,RVar (_,f),[RApp (_,t,[c]);d]) when f = ldots_var ->
+      (* Special case for alternative (recursive) notation of application *)
+      let x,y,lassoc = discriminate_patterns found 0 [c] [d] in
+      found := ldots_var :: !found; assert lassoc;
+      AList (x,y,AApp (AVar ldots_var,[AVar x]),aux t,lassoc)
   | RApp (_,g,args) -> AApp (aux g, List.map aux args)
-  | RLambda (_,na,ty,c) -> add_name bound_binders na; ALambda (na,aux ty,aux c)
-  | RProd (_,na,ty,c) -> add_name bound_binders na; AProd (na,aux ty,aux c)
-  | RLetIn (_,na,b,c) -> add_name bound_binders na; ALetIn (na,aux b,aux c)
-  | RCases (_,(tyopt,rtntypopt),tml,eqnl) ->
+  | RLambda (_,na,ty,c) -> add_name found na; ALambda (na,aux ty,aux c)
+  | 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) =
-        bound_binders := idl@(!bound_binders);
+        found := idl@(!found);
         (idl,pat,aux rhs) in
-      ACases (option_app aux tyopt,
-        option_app aux !rtntypopt,
-        List.map (fun (tm,{contents = (na,x)}) ->
-	  add_name bound_binders na;
+      ACases (option_app aux rtntypopt,
+        List.map (fun (tm,(na,x)) ->
+	  add_name found na;
 	  option_iter
-	    (fun (_,_,nl) -> List.iter (add_name bound_binders) nl) x;
+	    (fun (_,_,nl) -> List.iter (add_name found) nl) x;
           (aux tm,(na,option_app (fun (_,ind,nal) -> (ind,nal)) x))) tml,
         List.map f eqnl)
-  | ROrderedCase (_,b,tyopt,tm,bv,_) ->
-      AOrderedCase (b,option_app aux tyopt,aux tm, Array.map aux bv)
   | RLetTuple (loc,nal,(na,po),b,c) ->
-      add_name bound_binders na;
-      List.iter (add_name bound_binders) nal;
+      add_name found na;
+      List.iter (add_name found) nal;
       ALetTuple (nal,(na,option_app aux po),aux b,aux c)
   | RIf (loc,c,(na,po),b1,b2) ->
-      add_name bound_binders na;
+      add_name found na;
       AIf (aux c,(na,option_app aux po),aux b1,aux b2)
-  | RCast (_,c,t) -> ACast (aux c,aux t)
+  | RCast (_,c,k,t) -> ACast (aux c,k,aux t)
   | RSort (_,s) -> ASort s
   | RHole (_,w) -> AHole w
   | RRef (_,r) -> ARef r
@@ -300,13 +216,7 @@ allowed in abbreviatable expressions"
 	error "Both ends of the recursive pattern have different lengths";
       let ll2,l2' = list_chop nl l2 in
       let t = List.hd l2' and lr2 = List.tl l2' in
-      let discr = discriminate_patterns nl (ll1@lr1) (ll2@lr2) in
-      let x,y,order = match discr with Some z -> z | None -> 
-	error "Both ends of the recursive pattern are the same" in
-      List.iter (fun id ->
-        if List.mem id !bound_binders or List.mem id !found 
-        then error "Variables used in the recursive part of a pattern are not allowed to occur outside of the recursive part";
-        found := id::!found) [x;y];
+      let x,y,order = discriminate_patterns found nl (ll1@lr1) (ll2@lr2) in
       let iter =
         if order then RApp (loc,f2,ll2@RVar (loc,ldots_var)::lr2)
         else RApp (loc,f1,ll1@RVar (loc,ldots_var)::lr1) in
@@ -326,20 +236,126 @@ allowed in abbreviatable expressions"
   in
   let t = aux a in
   (* Side effect *)
-  t, !found, !bound_binders
+  t, !found
 
 let aconstr_of_rawconstr vars a =
-  let a,notbindingvars,binders = aconstr_and_vars_of_rawconstr a in
+  let a,foundvars = aconstr_and_vars_of_rawconstr a in
   let check_type x =
-    if not (List.mem x notbindingvars or List.mem x binders) then
+    if not (List.mem x foundvars) then
       error ((string_of_id x)^" is unbound in the right-hand-side") in
   List.iter check_type vars;
   a
 
+let aconstr_of_constr avoiding t =
+ aconstr_of_rawconstr [] (Detyping.detype false avoiding [] t)
+
+let rec subst_aconstr subst bound raw =
+  match raw with
+  | ARef ref -> 
+      let ref',t = subst_global subst ref in 
+	if ref' == ref then raw else
+	  aconstr_of_constr bound t
+
+  | AVar _ -> raw
+
+  | AApp (r,rl) -> 
+      let r' = subst_aconstr subst bound r 
+      and rl' = list_smartmap (subst_aconstr subst bound) rl in
+	if r' == r && rl' == rl then raw else
+	  AApp(r',rl')
+
+  | AList (id1,id2,r1,r2,b) -> 
+      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
+	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
+	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
+	if r1' == r1 && r2' == r2 then raw else
+	  ALetIn (n,r1',r2')
+
+  | ACases (rtntypopt,rl,branches) -> 
+      let rtntypopt' = option_smartmap (subst_aconstr subst bound) rtntypopt
+      and rl' = list_smartmap
+        (fun (a,(n,signopt) as x) -> 
+	  let a' = subst_aconstr subst bound a in
+	  let signopt' = option_app (fun ((indkn,i),nal as z) ->
+	    let indkn' = subst_kn subst indkn in
+	    if indkn == indkn' then z else ((indkn',i),nal)) signopt in
+	  if a' == a && signopt' == signopt then x else (a',(n,signopt')))
+        rl
+      and branches' = list_smartmap 
+                        (fun (idl,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'))
+                        branches
+      in
+        if rtntypopt' == rtntypopt && rtntypopt == rtntypopt' &
+          rl' == rl && branches' == branches then raw else
+          ACases (rtntypopt',rl',branches')
+
+  | ALetTuple (nal,(na,po),b,c) ->
+      let po' = option_smartmap (subst_aconstr subst bound) po
+      and b' = subst_aconstr subst bound b 
+      and c' = subst_aconstr subst bound c in
+	if po' == po && b' == b && c' == c then raw else
+	  ALetTuple (nal,(na,po'),b',c')
+
+  | AIf (c,(na,po),b1,b2) ->
+      let po' = option_smartmap (subst_aconstr subst bound) po
+      and b1' = subst_aconstr subst bound b1
+      and b2' = subst_aconstr subst bound b2 
+      and c' = subst_aconstr subst bound c in
+	if po' == po && b1' == b1 && b2' == b2 && c' == c then raw else
+	  AIf (c',(na,po'),b1',b2')
+
+  | APatVar _ | ASort _ -> raw
+
+  | AHole (Evd.ImplicitArg (ref,i)) ->
+      let ref',t = subst_global subst ref in 
+	if ref' == ref then raw else
+	  AHole (Evd.InternalHole)
+  | AHole (Evd.BinderType _ | Evd.QuestionMark | Evd.CasesType |
+      Evd.InternalHole | Evd.TomatchTypeParameter _) -> raw
+
+  | ACast (r1,k,r2) -> 
+      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')
+
+
 let encode_list_value l = RApp (dummy_loc,RVar (dummy_loc,ldots_var),l)
 
 (* Pattern-matching rawconstr and aconstr *)
 
+let abstract_return_type_context pi mklam tml rtno =
+  option_app (fun rtn ->
+    let nal =
+      List.flatten (List.map (fun (_,(na,t)) ->
+	match t with Some x -> (pi x)@[na] | None -> [na]) tml) in
+    List.fold_right mklam nal rtn)
+    rtno
+
+let abstract_return_type_context_rawconstr =
+  abstract_return_type_context pi3
+    (fun na c -> RLambda(dummy_loc,na,RHole(dummy_loc,Evd.InternalHole),c))
+
+let abstract_return_type_context_aconstr =
+  abstract_return_type_context snd
+    (fun na c -> ALambda(na,AHole Evd.InternalHole,c))
+
 let rec adjust_scopes = function
   | _,[] -> []
   | [],a::args -> (None,a) :: adjust_scopes ([],args)
@@ -366,6 +382,18 @@ let bind_env alp sigma var v =
     (* TODO: handle the case of multiple occs in different scopes *)
     (var,v)::sigma
 
+let match_opt f sigma t1 t2 = match (t1,t2) with
+  | None, None -> sigma
+  | Some t1, Some t2 -> f sigma t1 t2
+  | _ -> raise No_match
+
+let match_names metas (alp,sigma) na1 na2 = match (na1,na2) with
+  | (Name id1,Name id2) when List.mem id2 metas ->
+      alp, bind_env alp sigma id2 (RVar (dummy_loc,id1))
+  | (Name id1,Name id2) -> (id1,id2)::alp,sigma
+  | (Anonymous,Anonymous) -> alp,sigma
+  | _ -> 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
@@ -377,28 +405,34 @@ let rec match_ alp metas sigma a1 a2 = match (a1,a2) with
       when List.length l1 = List.length l2 ->
       match_alist alp metas sigma (f1::l1) (f2::l2) x iter termin lassoc
   | RLambda (_,na1,t1,b1), ALambda (na2,t2,b2) ->
-     match_binders alp metas (match_ alp metas sigma t1 t2) b1 b2 na1 na2
+     match_binders alp metas na1 na2 (match_ alp metas sigma t1 t2) b1 b2
   | RProd (_,na1,t1,b1), AProd (na2,t2,b2) ->
-     match_binders alp metas (match_ alp metas sigma t1 t2) b1 b2 na1 na2
+     match_binders alp metas na1 na2 (match_ alp metas sigma t1 t2) b1 b2
   | RLetIn (_,na1,t1,b1), ALetIn (na2,t2,b2) ->
-     match_binders alp metas (match_ alp metas sigma t1 t2) b1 b2 na1 na2
-  | RCases (_,(po1,rtno1),tml1,eqnl1), ACases (po2,rtno2,tml2,eqnl2) 
+     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 ->
-     let sigma = option_fold_left2 (match_ alp metas) sigma po1 po2 in
-     (* TODO: match rtno' with their contexts *)
-     let sigma = List.fold_left2 
+      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
+      let sigma = List.fold_left2 
        (fun s (tm1,_) (tm2,_) -> match_ alp metas s tm1 tm2) sigma tml1 tml2 in
-     List.fold_left2 (match_equations alp metas) sigma eqnl1 eqnl2
-  | ROrderedCase (_,st,po1,c1,bl1,_), AOrderedCase (st2,po2,c2,bl2) 
-      when Array.length bl1 = Array.length bl2 ->
-     let sigma = option_fold_left2 (match_ alp metas) sigma po1 po2 in
-     array_fold_left2 (match_ alp metas) (match_ alp metas sigma c1 c2) bl1 bl2
-  | RCast(_,c1,t1), ACast(c2,t2) ->
+      List.fold_left2 (match_equations alp metas) sigma eqnl1 eqnl2
+  | RIf (_,a1,(na1,to1),b1,c1), AIf (a2,(na2,to2),b2,c2) ->
+      let sigma = match_opt (match_binders alp metas na1 na2) sigma to1 to2 in
+      List.fold_left2 (match_ alp metas) sigma [a1;b1;c1] [a2;b2;c2]
+  | RLetTuple (_,nal1,(na1,to1),b1,c1), ALetTuple (nal2,(na2,to2),b2,c2) 
+      when List.length nal1 = List.length nal2 ->
+      let sigma = match_opt (match_binders alp metas na1 na2) sigma to1 to2 in
+      let sigma = match_ alp metas sigma b1 b2 in
+      let (alp,sigma) =
+	List.fold_left2 (match_names metas) (alp,sigma) nal1 nal2 in
+      match_ alp metas sigma c1 c2
+  | RCast(_,c1,_,t1), ACast(c2,_,t2) ->
       match_ alp metas (match_ alp metas sigma c1 c2) t1 t2
   | RSort (_,s1), ASort s2 when s1 = s2 -> sigma
   | RPatVar _, AHole _ -> (*Don't hide Metas, they bind in ltac*) raise No_match
-  | a, AHole _ when not(Options.do_translate()) -> sigma
-  | RHole _, AHole _ -> sigma
+  | a, AHole _ -> sigma
   | (RDynamic _ | RRec _ | REvar _), _ 
   | _,_ -> raise No_match
 
@@ -423,13 +457,9 @@ and match_alist alp metas sigma l1 l2 x iter termin lassoc =
   let tl,sigma = match_alist_tail alp metas sigma [t1] rest in
   (x,encode_list_value (if lassoc then List.rev tl else tl))::sigma
 
-and match_binders alp metas sigma b1 b2 na1 na2 = match (na1,na2) with
-  | (Name id1,Name id2) when List.mem id2 metas ->
-      let sigma = bind_env alp sigma id2 (RVar (dummy_loc,id1)) in 
-      match_ alp metas sigma b1 b2
-  | (Name id1,Name id2) -> match_ ((id1,id2)::alp) metas sigma b1 b2
-  | (Anonymous,Anonymous) -> match_  alp metas sigma b1 b2
-  | _ -> raise No_match
+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
@@ -461,12 +491,15 @@ type explicitation = ExplByPos of int | ExplByName of identifier
 
 type proj_flag = int option (* [Some n] = proj of the n-th visible argument *)
 
+type prim_token = Numeral of Bigint.bigint | String of string
+
 type cases_pattern_expr =
   | CPatAlias of loc * cases_pattern_expr * identifier
   | CPatCstr of loc * reference * cases_pattern_expr list
   | CPatAtom of loc * reference option
+  | CPatOr of loc * cases_pattern_expr list
   | CPatNotation of loc * notation * cases_pattern_expr list
-  | CPatNumeral of loc * Bignat.bigint
+  | CPatPrim of loc * prim_token
   | CPatDelimiters of loc * string * cases_pattern_expr
 
 type constr_expr =
@@ -480,11 +513,9 @@ type constr_expr =
   | CAppExpl of loc * (proj_flag * reference) * constr_expr list
   | CApp of loc * (proj_flag * constr_expr) * 
       (constr_expr * explicitation located option) list
-  | CCases of loc * (constr_expr option * constr_expr option) *
+  | CCases of loc * constr_expr option *
       (constr_expr * (name option * constr_expr option)) list *
       (loc * cases_pattern_expr list * constr_expr) list
-  | COrderedCase of loc * case_style * constr_expr option * constr_expr
-      * constr_expr list
   | CLetTuple of loc * name list * (name option * constr_expr option) *
       constr_expr * constr_expr
   | CIf of loc * constr_expr * (name option * constr_expr option)
@@ -493,14 +524,15 @@ type constr_expr =
   | CPatVar of loc * (bool * patvar)
   | CEvar of loc * existential_key
   | CSort of loc * rawsort
-  | CCast of loc * constr_expr * constr_expr
+  | CCast of loc * constr_expr * cast_kind * constr_expr
   | CNotation of loc * notation * constr_expr list
-  | CNumeral of loc * Bignat.bigint
+  | CPrim of loc * prim_token
   | CDelimiters of loc * string * constr_expr
   | CDynamic of loc * Dyn.t
 
+
 and fixpoint_expr =
-    identifier * int * local_binder list * constr_expr * constr_expr
+    identifier * (int * recursion_order_expr) * local_binder list * constr_expr * constr_expr
 
 and local_binder =
   | LocalRawDef of name located * constr_expr
@@ -509,6 +541,10 @@ and local_binder =
 and cofixpoint_expr =
     identifier * local_binder list * constr_expr * constr_expr
 
+and recursion_order_expr = 
+  | CStructRec
+  | CWfRec of constr_expr
+
 (***********************)
 (* For binders parsing *)
 
@@ -520,6 +556,9 @@ let rec local_binders_length = function
 let names_of_local_assums bl =
   List.flatten (List.map (function LocalRawAssum(l,_)->l|_->[]) bl)
 
+let names_of_local_binders bl =
+  List.flatten (List.map (function LocalRawAssum(l,_)->l|LocalRawDef(l,_)->[l]) bl)
+
 (**********************************************************************)
 (* Functions on constr_expr *)
 
@@ -535,16 +574,15 @@ let constr_loc = function
   | CAppExpl (loc,_,_) -> loc
   | CApp (loc,_,_) -> loc
   | CCases (loc,_,_,_) -> loc
-  | COrderedCase (loc,_,_,_,_) -> loc
   | CLetTuple (loc,_,_,_,_) -> loc
   | CIf (loc,_,_,_,_) -> loc
   | CHole loc -> loc
   | CPatVar (loc,_) -> loc
   | CEvar (loc,_) -> loc
   | CSort (loc,_) -> loc
-  | CCast (loc,_,_) -> loc
+  | CCast (loc,_,_,_) -> loc
   | CNotation (loc,_,_) -> loc
-  | CNumeral (loc,_) -> loc
+  | CPrim (loc,_) -> loc
   | CDelimiters (loc,_,_) -> loc
   | CDynamic _ -> dummy_loc
 
@@ -552,8 +590,9 @@ let cases_pattern_loc = function
   | CPatAlias (loc,_,_) -> loc
   | CPatCstr (loc,_,_) -> loc
   | CPatAtom (loc,_) -> loc
+  | CPatOr (loc,_) -> loc
   | CPatNotation (loc,_,_) -> loc
-  | CPatNumeral (loc,_) -> loc
+  | CPatPrim (loc,_) -> loc
   | CPatDelimiters (loc,_,_) -> loc
 
 let occur_var_constr_ref id = function
@@ -571,12 +610,12 @@ let rec occur_var_constr_expr id = function
   | 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
+  | 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 _ | CNumeral _ | CDynamic _ -> false
+  | CHole _ | CEvar _ | CPatVar _ | CSort _ | CPrim _ | CDynamic _ -> false
   | CCases (loc,_,_,_) 
-  | COrderedCase (loc,_,_,_,_) 
   | CLetTuple (loc,_,_,_,_) 
   | CIf (loc,_,_,_,_) 
   | CFix (loc,_,_) 
@@ -593,26 +632,45 @@ and occur_var_binders id b = function
 let mkIdentC id  = CRef (Ident (dummy_loc, id))
 let mkRefC r     = CRef r
 let mkAppC (f,l) = CApp (dummy_loc, (None,f), List.map (fun x -> (x,None)) l)
-let mkCastC (a,b)  = CCast (dummy_loc,a,b)
+let mkCastC (a,k,b)  = CCast (dummy_loc,a,k,b)
 let mkLambdaC (idl,a,b) = CLambdaN (dummy_loc,[idl,a],b)
 let mkLetInC (id,a,b)   = CLetIn (dummy_loc,id,a,b)
 let mkProdC (idl,a,b)   = CProdN (dummy_loc,[idl,a],b)
 
+let rec abstract_constr_expr c = function
+  | [] -> c
+  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,abstract_constr_expr c bl)
+  | LocalRawAssum (idl,t)::bl ->
+      List.fold_right (fun x b -> mkLambdaC([x],t,b)) idl
+      (abstract_constr_expr c bl)
+      
+let rec prod_constr_expr c = function
+  | [] -> c
+  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,prod_constr_expr c bl)
+  | LocalRawAssum (idl,t)::bl ->
+      List.fold_right (fun x b -> mkProdC([x],t,b)) idl
+      (prod_constr_expr c bl)
+
+let coerce_to_id = function
+  | CRef (Ident (loc,id)) -> (loc,id)
+  | a -> user_err_loc
+        (constr_loc a,"coerce_to_id",
+         str "This expression should be a simple identifier")
+
 (* Used in correctness and interface *)
 
 
 let names_of_cases_indtype =
-  let rec vars_of ids t =
-    match t with
-      (* We deal only with the regular cases *)
-      | CApp (_,_,l) -> List.fold_left (fun ids (a,_) -> vars_of ids a) [] l
-      | CRef (Ident (_,id)) -> id::ids
-      | CNotation (_,_,l)
-      (* assume the ntn is applicative and does not instantiate the head !! *)
-      | CAppExpl (_,_,l) -> List.fold_left vars_of [] l
-      | CDelimiters(_,_,c) -> vars_of ids c
-      | _ -> ids in
-  vars_of []
+  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
 
@@ -642,12 +700,12 @@ let map_constr_expr_with_binders f g e = function
   | CLambdaN (loc,bl,b) ->
       let (e,bl) = map_binders f g e bl in CLambdaN (loc,bl,f e b)
   | CLetIn (loc,na,a,b) -> CLetIn (loc,na,f e a,f (name_fold g (snd na) e) b)
-  | CCast (loc,a,b) -> CCast (loc,f e a,f e b)
+  | CCast (loc,a,k,b) -> CCast (loc,f e a,k,f e b)
   | CNotation (loc,n,l) -> CNotation (loc,n,List.map (f e) l)
   | CDelimiters (loc,s,a) -> CDelimiters (loc,s,f e a)
   | CHole _ | CEvar _ | CPatVar _ | CSort _ 
-  | CNumeral _ | CDynamic _ | CRef _ as x -> x
-  | CCases (loc,(po,rtnpo),a,bl) ->
+  | CPrim _ | CDynamic _ | CRef _ as x -> x
+  | 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' = 
@@ -660,10 +718,8 @@ let map_constr_expr_with_binders f g e = function
             indnal (option_fold_right (name_fold g) na e))
 	  a e
       in
-      CCases (loc,(option_app (f e) po, option_app (f e') rtnpo),
+      CCases (loc,option_app (f e') rtnpo,
          List.map (fun (tm,x) -> (f e tm,x)) a,bl)
-  | COrderedCase (loc,s,po,a,bl) ->
-      COrderedCase (loc,s,option_app (f e) po,f e a,List.map (f e) 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
@@ -698,8 +754,8 @@ let rec replace_vars_constr_expr l = function
 (* Concrete syntax for modules and modules types *)
 
 type with_declaration_ast = 
-  | CWith_Module of identifier located * qualid located
-  | CWith_Definition of identifier located * constr_expr
+  | CWith_Module of identifier list located * qualid located
+  | CWith_Definition of identifier list located * constr_expr
 
 type module_type_ast = 
   | CMTEident of qualid located
diff --git a/interp/topconstr.mli b/interp/topconstr.mli
index 54547352..2f4f667d 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,v 1.23.2.3 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: topconstr.mli 8624 2006-03-13 17:38:17Z msozeau $ i*)
 
 (*i*)
 open Pp
@@ -15,6 +15,7 @@ open Names
 open Libnames
 open Rawterm
 open Term
+open Mod_subst
 (*i*)
 
 (*s This is the subtype of rawconstr allowed in syntactic extensions *)
@@ -32,25 +33,28 @@ type aconstr =
   | ALambda of name * aconstr * aconstr
   | AProd of name * aconstr * aconstr
   | ALetIn of name * aconstr * aconstr
-  | ACases of aconstr option * aconstr option *
+  | ACases of aconstr option *
       (aconstr * (name * (inductive * name list) option)) list *
       (identifier list * cases_pattern list * aconstr) list
-  | AOrderedCase of case_style * aconstr option * aconstr * aconstr array
   | ALetTuple of name list * (name * aconstr option) * aconstr * aconstr
   | AIf of aconstr * (name * aconstr option) * aconstr * aconstr
   | ASort of rawsort
-  | AHole of hole_kind
+  | AHole of Evd.hole_kind
   | APatVar of patvar
-  | ACast of aconstr * aconstr
+  | ACast of aconstr * cast_kind * aconstr
 
 val rawconstr_of_aconstr_with_binders : loc -> 
   (identifier -> 'a -> identifier * 'a) ->
   ('a -> aconstr -> rawconstr) -> 'a -> aconstr -> rawconstr
 
-val subst_aconstr : Names.substitution -> aconstr -> aconstr
+val rawconstr_of_aconstr : loc -> aconstr -> rawconstr
+
+val subst_aconstr : substitution -> Names.identifier list -> aconstr -> aconstr
 
 val aconstr_of_rawconstr : identifier list -> rawconstr -> aconstr
 
+val eq_rawconstr : rawconstr -> rawconstr -> bool
+
 (* [match_aconstr metas] match a rawconstr against an aconstr with
    metavariables in [metas]; it raises [No_match] if the matching fails *)
 exception No_match
@@ -59,7 +63,7 @@ type scope_name = string
 type interpretation = 
     (identifier * (scope_name option * scope_name list)) list * aconstr
 
-val match_aconstr : (*i scope_name option -> i*) rawconstr -> interpretation ->
+val match_aconstr : rawconstr -> interpretation ->
       (rawconstr * (scope_name option * scope_name list)) list
 
 (*s Concrete syntax for terms *)
@@ -70,12 +74,15 @@ type explicitation = ExplByPos of int | ExplByName of identifier
 
 type proj_flag = int option (* [Some n] = proj of the n-th visible argument *)
 
+type prim_token = Numeral of Bigint.bigint | String of string
+
 type cases_pattern_expr =
   | CPatAlias of loc * cases_pattern_expr * identifier
   | CPatCstr of loc * reference * cases_pattern_expr list
   | CPatAtom of loc * reference option
+  | CPatOr of loc * cases_pattern_expr list
   | CPatNotation of loc * notation * cases_pattern_expr list
-  | CPatNumeral of loc * Bignat.bigint
+  | CPatPrim of loc * prim_token
   | CPatDelimiters of loc * string * cases_pattern_expr
 
 type constr_expr =
@@ -89,11 +96,9 @@ type constr_expr =
   | CAppExpl of loc * (proj_flag * reference) * constr_expr list
   | CApp of loc * (proj_flag * constr_expr) * 
         (constr_expr * explicitation located option) list
-  | CCases of loc * (constr_expr option * constr_expr option) *
+  | CCases of loc * constr_expr option *
       (constr_expr * (name option * constr_expr option)) list *
       (loc * cases_pattern_expr list * constr_expr) list
-  | COrderedCase of loc * case_style * constr_expr option * constr_expr
-      * constr_expr list
   | CLetTuple of loc * name list * (name option * constr_expr option) *
       constr_expr * constr_expr
   | CIf of loc * constr_expr * (name option * constr_expr option)
@@ -102,18 +107,22 @@ type constr_expr =
   | CPatVar of loc * (bool * patvar)
   | CEvar of loc * existential_key
   | CSort of loc * rawsort
-  | CCast of loc * constr_expr * constr_expr
+  | CCast of loc * constr_expr * cast_kind * constr_expr
   | CNotation of loc * notation * constr_expr list
-  | CNumeral of loc * Bignat.bigint
+  | CPrim of loc * prim_token
   | CDelimiters of loc * string * constr_expr
   | CDynamic of loc * Dyn.t
 
 and fixpoint_expr =
-    identifier * int * local_binder list * constr_expr * constr_expr
+    identifier * (int * recursion_order_expr) * local_binder list * constr_expr * constr_expr
 
 and cofixpoint_expr =
     identifier * local_binder list * constr_expr * constr_expr
 
+and recursion_order_expr = 
+  | CStructRec
+  | CWfRec of constr_expr
+
 and local_binder =
   | LocalRawDef of name located * constr_expr
   | LocalRawAssum of name located list * constr_expr
@@ -134,11 +143,16 @@ val names_of_cases_indtype : constr_expr -> identifier list
 val mkIdentC : identifier -> constr_expr
 val mkRefC : reference -> constr_expr
 val mkAppC : constr_expr * constr_expr list -> constr_expr
-val mkCastC : constr_expr * constr_expr -> constr_expr
+val mkCastC : constr_expr * cast_kind * constr_expr -> constr_expr
 val mkLambdaC : name located list * constr_expr * constr_expr -> constr_expr
 val mkLetInC : name located * constr_expr * constr_expr -> constr_expr
 val mkProdC : name located list * constr_expr * constr_expr -> constr_expr
 
+val coerce_to_id : constr_expr -> identifier located
+
+val abstract_constr_expr : constr_expr -> local_binder list -> constr_expr
+val prod_constr_expr : constr_expr -> local_binder list -> constr_expr
+
 (* For binders parsing *)
 
 (* Includes let binders *)
@@ -147,6 +161,9 @@ val local_binders_length : local_binder list -> int
 (* Does not take let binders into account *)
 val names_of_local_assums : local_binder list -> name located list
 
+(* With let binders *)
+val names_of_local_binders : local_binder list -> name located list
+
 (* Used in correctness and interface; absence of var capture not guaranteed *)
 (* in pattern-matching clauses and in binders of the form [x,y:T(x)] *)
 
@@ -157,8 +174,8 @@ val map_constr_expr_with_binders :
 (* Concrete syntax for modules and modules types *)
 
 type with_declaration_ast = 
-  | CWith_Module of identifier located * qualid located
-  | CWith_Definition of identifier located * constr_expr
+  | CWith_Module of identifier list located * qualid located
+  | CWith_Definition of identifier list located * constr_expr
 
 type module_type_ast = 
   | CMTEident of qualid located
diff --git a/kernel/byterun/coq_fix_code.c b/kernel/byterun/coq_fix_code.c
new file mode 100644
index 00000000..4616580d
--- /dev/null
+++ b/kernel/byterun/coq_fix_code.c
@@ -0,0 +1,166 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h> 
+#include "config.h"
+#include "misc.h"
+#include "mlvalues.h"
+#include "fail.h"
+#include "memory.h"
+#include "coq_instruct.h"
+#include "coq_fix_code.h"
+
+#ifdef THREADED_CODE
+char ** coq_instr_table;
+char * coq_instr_base;
+int arity[STOP+1];
+
+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[OFFSETCLOSURE0]=arity[OFFSETCLOSURE2]=arity[PUSHOFFSETCLOSUREM2]=
+    arity[PUSHOFFSETCLOSURE0]=arity[PUSHOFFSETCLOSURE2]=
+    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;
+  /* 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;
+  /* 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;
+}
+
+#endif /*  THREADED_CODE */
+
+
+void * coq_stat_alloc (asize_t sz)
+{
+  void * result = malloc (sz);
+  if (result == NULL) raise_out_of_memory ();
+  return result;
+}
+
+value coq_makeaccu (value i) {
+  code_t q;
+  code_t res = coq_stat_alloc(8);
+  q = res;
+  *q++ = VALINSTR(MAKEACCU);
+  *q = (opcode_t)Int_val(i);
+  return (value)res;
+}
+
+value coq_accucond (value i) {
+  code_t q;
+  code_t res = coq_stat_alloc(8);
+  q = res;
+  *q++ = VALINSTR(ACCUMULATECOND);
+  *q = (opcode_t)Int_val(i);
+  return (value)res;
+}
+
+value coq_pushpop (value i) {
+  code_t res;
+  int n;
+  n = Int_val(i);
+  if (n == 0) {
+    res = coq_stat_alloc(4);
+    *res = VALINSTR(STOP);
+    return (value)res;
+  }
+  else {
+    code_t q;
+    res = coq_stat_alloc(12);
+    q = res;
+    *q++ = VALINSTR(POP);
+    *q++ = (opcode_t)n;
+    *q = VALINSTR(STOP);
+    return (value)res;
+  }
+}
+
+value coq_is_accumulate_code(value code){
+  code_t q;
+  int res;
+  q = (code_t)code;
+  res = Is_instruction(q,ACCUMULATECOND) || Is_instruction(q,ACCUMULATE);
+  return Val_bool(res);
+}
+
+#ifdef ARCH_BIG_ENDIAN
+#define Reverse_32(dst,src) {                                               \
+  char * _p, * _q;							    \
+  char _a, _b;                                                              \
+  _p = (char *) (src);                                                      \
+  _q = (char *) (dst);                                                      \
+  _a = _p[0];                                                               \
+  _b = _p[1];                                                               \
+  _q[0] = _p[3];                                                            \
+  _q[1] = _p[2];                                                            \
+  _q[3] = _a;                                                               \
+  _q[2] = _b;                                                               \
+}
+#define COPY32(dst,src) Reverse_32(dst,src)
+#else
+#define COPY32(dst,src) (*dst=*src)
+#endif /* ARCH_BIG_ENDIAN */
+
+value coq_tcode_of_code (value code, value size) {
+  code_t p, q, res; 
+  asize_t len = (asize_t) Long_val(size);
+  res = coq_stat_alloc(len);
+  q = res;
+  len /= sizeof(opcode_t);
+  for (p = (code_t)code; p < (code_t)code + len; /*nothing*/) {  
+    opcode_t instr;
+    COPY32(&instr,p); 
+    p++;
+    if (instr < 0 || instr > STOP){
+      instr = STOP;
+    };
+    *q++ = VALINSTR(instr);
+    if (instr == SWITCH) {
+      uint32 i, sizes, const_size, block_size;
+      COPY32(q,p); p++;
+      sizes=*q++;
+      const_size = sizes & 0xFFFF;
+      block_size = sizes >> 16;
+      sizes = const_size + block_size;
+      for(i=0; i<sizes; i++) { COPY32(q,p); p++; q++; };
+    } else if (instr == CLOSUREREC) {
+      uint32 i, n;
+      COPY32(q,p); p++; /* ndefs */
+      n = 3 + 2*(*q);  /* ndefs, nvars, start, typlbls,lbls*/
+      q++;
+      for(i=1; i<n; i++) { COPY32(q,p); p++; q++; };
+    } else {
+      uint32 i, ar;
+      ar = arity[instr]; 
+      for(i=0; i<ar; i++) { COPY32(q,p); p++; q++; };
+    }
+  }
+  return (value)res;
+}
diff --git a/kernel/byterun/coq_fix_code.h b/kernel/byterun/coq_fix_code.h
new file mode 100644
index 00000000..035d5b9b
--- /dev/null
+++ b/kernel/byterun/coq_fix_code.h
@@ -0,0 +1,34 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+
+#ifndef _COQ_FIX_CODE_
+#define _COQ_FIX_CODE_
+
+#include "mlvalues.h"
+void * coq_stat_alloc (asize_t sz);
+
+#ifdef THREADED_CODE
+extern char ** coq_instr_table;
+extern char * coq_instr_base;
+void init_arity();
+#define VALINSTR(instr) ((opcode_t)(coq_instr_table[instr] - coq_instr_base))
+#else
+#define VALINSTR(instr) instr
+#endif /*  THREADED_CODE */
+
+#define Is_instruction(pc,instr) (*pc == VALINSTR(instr))
+
+value coq_tcode_of_code(value code, value len);
+value coq_makeaccu (value i);
+value coq_pushpop (value i);
+value coq_accucond (value i);
+value coq_is_accumulate_code(value code);
+#endif /* _COQ_FIX_CODE_ */
diff --git a/kernel/byterun/coq_gc.h b/kernel/byterun/coq_gc.h
new file mode 100644
index 00000000..2f085326
--- /dev/null
+++ b/kernel/byterun/coq_gc.h
@@ -0,0 +1,48 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+#ifndef _COQ_CAML_GC_
+#define _COQ_CAML_GC_
+#include "mlvalues.h"
+#include "alloc.h"
+
+typedef void (*scanning_action) (value, value *);
+
+
+CAMLextern char *young_ptr;
+CAMLextern char *young_limit;
+CAMLextern void (*scan_roots_hook) (scanning_action);
+CAMLextern void minor_collection (void);
+
+#define Caml_white (0 << 8)
+#define Caml_black (3 << 8)
+
+#define Make_header(wosize, tag, color)                                 \
+  (((header_t) (((header_t) (wosize) << 10)                             \
+		+ (color)                                               \
+		+ (tag_t) (tag)))   					\
+   )
+
+
+#define Alloc_small(result, wosize, tag) do{                            \
+  young_ptr -= Bhsize_wosize (wosize);                                  \
+  if (young_ptr < young_limit){                                         \
+    young_ptr += Bhsize_wosize (wosize);                                \
+    Setup_for_gc;                                                       \
+    minor_collection ();                                                \
+    Restore_after_gc;                                                   \
+    young_ptr -= Bhsize_wosize (wosize);                                \
+  }                                                                     \
+  Hd_hp (young_ptr) = Make_header ((wosize), (tag), Caml_black);        \
+  (result) = Val_hp (young_ptr);                                        \
+  }while(0) 
+
+
+#endif /*_COQ_CAML_GC_ */
diff --git a/kernel/byterun/coq_instruct.h b/kernel/byterun/coq_instruct.h
new file mode 100644
index 00000000..d3b07526
--- /dev/null
+++ b/kernel/byterun/coq_instruct.h
@@ -0,0 +1,39 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+#ifndef _COQ_INSTRUCT_
+#define _COQ_INSTRUCT_
+
+enum instructions {
+  ACC0, ACC1, ACC2, ACC3, ACC4, ACC5, ACC6, ACC7, ACC,
+  PUSH, 
+  PUSHACC0, PUSHACC1, PUSHACC2, PUSHACC3, PUSHACC4,
+  PUSHACC5, PUSHACC6, PUSHACC7, PUSHACC, 
+  POP,
+  ENVACC1, ENVACC2, ENVACC3, ENVACC4, ENVACC,
+  PUSHENVACC1, PUSHENVACC2, PUSHENVACC3, PUSHENVACC4, PUSHENVACC,
+  PUSH_RETADDR,
+  APPLY, APPLY1, APPLY2, APPLY3,
+  APPTERM, APPTERM1, APPTERM2, APPTERM3,
+  RETURN, RESTART, GRAB, GRABREC, COGRAB, 
+  CLOSURE, CLOSUREREC, 
+  OFFSETCLOSUREM2, OFFSETCLOSURE0, OFFSETCLOSURE2, OFFSETCLOSURE,
+  PUSHOFFSETCLOSUREM2, PUSHOFFSETCLOSURE0, PUSHOFFSETCLOSURE2, 
+  PUSHOFFSETCLOSURE,
+  GETGLOBAL, PUSHGETGLOBAL,
+  MAKEBLOCK, MAKEBLOCK1, MAKEBLOCK2, MAKEBLOCK3, 
+  MAKESWITCHBLOCK, MAKEACCU, MAKEPROD,
+  FORCE, SWITCH, PUSHFIELD,
+  CONST0, CONST1, CONST2, CONST3, CONSTINT,
+  PUSHCONST0, PUSHCONST1, PUSHCONST2, PUSHCONST3, PUSHCONSTINT,
+  ACCUMULATE, ACCUMULATECOND, STOP
+};
+
+#endif /* _COQ_INSTRUCT_ */
diff --git a/kernel/byterun/coq_interp.c b/kernel/byterun/coq_interp.c
new file mode 100644
index 00000000..8bfe78eb
--- /dev/null
+++ b/kernel/byterun/coq_interp.c
@@ -0,0 +1,974 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+/* The bytecode interpreter */
+
+#include <stdio.h>
+#include "coq_gc.h"
+#include "coq_instruct.h"
+#include "coq_fix_code.h"
+#include "coq_memory.h"  
+#include "coq_values.h"
+
+
+/* Registers for the abstract machine:
+        pc         the code pointer
+        sp         the stack pointer (grows downward)
+        accu       the accumulator
+        env        heap-allocated environment
+        trapsp     pointer to the current trap frame
+        extra_args number of extra arguments provided by the caller
+
+sp is a local copy of the global variable extern_sp. */
+
+
+
+/* Instruction decoding */
+
+
+#ifdef THREADED_CODE
+#  define Instruct(name) coq_lbl_##name: 
+#  if defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32)
+#    define coq_Jumptbl_base ((char *) &&coq_lbl_ACC0)
+#  else
+#    define coq_Jumptbl_base ((char *) 0)
+#    define coq_jumptbl_base ((char *) 0)
+#  endif
+#  ifdef DEBUG
+#    define Next goto next_instr
+#  else
+#    ifdef __ia64__
+#      define Next goto *(void *)(coq_jumptbl_base + *((uint32 *) pc)++)
+#    else
+#      define Next goto *(void *)(coq_jumptbl_base + *pc++)
+#    endif
+#  endif
+#else 
+#  define Instruct(name) case name:
+#  define Next break
+#endif 
+
+/* #define _COQ_DEBUG_ */
+
+#ifdef _COQ_DEBUG_ 
+#   define print_instr(s) /*if (drawinstr)*/ printf("%s\n",s)
+#   define print_int(i)   /*if (drawinstr)*/ printf("%d\n",i)
+# else 
+#   define print_instr(s) 
+#   define print_int(i) 
+#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; }
+
+
+/* Register optimization.
+   Some compilers underestimate the use of the local variables representing
+   the abstract machine registers, and don't put them in hardware registers,
+   which slows down the interpreter considerably.
+   For GCC, Xavier Leroy have hand-assigned hardware registers for 
+   several architectures.
+*/
+
+#if defined(__GNUC__) && !defined(DEBUG)
+#ifdef __mips__
+#define PC_REG asm("$16")
+#define SP_REG asm("$17")
+#define ACCU_REG asm("$18")
+#endif
+#ifdef __sparc__
+#define PC_REG asm("%l0")
+#define SP_REG asm("%l1")
+#define ACCU_REG asm("%l2")
+#endif
+#ifdef __alpha__
+#ifdef __CRAY__
+#define PC_REG asm("r9")
+#define SP_REG asm("r10")
+#define ACCU_REG asm("r11")
+#define JUMPTBL_BASE_REG asm("r12")
+#else
+#define PC_REG asm("$9")
+#define SP_REG asm("$10")
+#define ACCU_REG asm("$11")
+#define JUMPTBL_BASE_REG asm("$12")
+#endif
+#endif
+#ifdef __i386__
+#define PC_REG asm("%esi")
+#define SP_REG asm("%edi")
+#define ACCU_REG
+#endif
+#if defined(PPC) || defined(_POWER) || defined(_IBMR2)
+#define PC_REG asm("26")
+#define SP_REG asm("27")
+#define ACCU_REG asm("28")
+#endif
+#ifdef __hppa__
+#define PC_REG asm("%r18")
+#define SP_REG asm("%r17")
+#define ACCU_REG asm("%r16")
+#endif
+#ifdef __mc68000__
+#define PC_REG asm("a5")
+#define SP_REG asm("a4")
+#define ACCU_REG asm("d7")
+#endif
+#ifdef __arm__
+#define PC_REG asm("r9")
+#define SP_REG asm("r8")
+#define ACCU_REG asm("r7")
+#endif
+#ifdef __ia64__
+#define PC_REG asm("36")
+#define SP_REG asm("37")
+#define ACCU_REG asm("38")
+#define JUMPTBL_BASE_REG asm("39")
+#endif
+#endif
+
+/* The interpreter itself */
+
+value coq_interprete
+(code_t coq_pc, value coq_accu, value coq_env, long coq_extra_args)
+{
+  /*Declaration des variables */
+#ifdef PC_REG
+  register code_t pc PC_REG;
+  register value * sp SP_REG;
+  register value accu ACCU_REG;
+#else
+  register code_t pc;
+  register value * sp;
+  register value accu;
+#endif
+#if defined(THREADED_CODE) && defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32)
+#ifdef JUMPTBL_BASE_REG
+  register char * coq_jumptbl_base JUMPTBL_BASE_REG;
+#else
+  register char * coq_jumptbl_base;
+#endif
+#endif
+#ifdef THREADED_CODE
+  static void * coq_jumptable[] = {
+#    include "coq_jumptbl.h"
+  };
+#else 
+  opcode_t curr_instr;
+#endif
+    print_instr("Enter Interpreter");
+  if (coq_pc == NULL) {           /* Interpreter is initializing */
+    print_instr("Interpreter is initializing");
+#ifdef THREADED_CODE
+    coq_instr_table = (char **) coq_jumptable;
+    coq_instr_base = coq_Jumptbl_base;
+#endif
+    return Val_unit;
+  }
+#if defined(THREADED_CODE) && defined(ARCH_SIXTYFOUR) && !defined(ARCH_CODE32)
+  coq_jumptbl_base = coq_Jumptbl_base;
+#endif
+
+  /* Initialisation */
+  sp = coq_sp;
+  pc = coq_pc;
+  accu = coq_accu;
+#ifdef THREADED_CODE
+  goto *(void *)(coq_jumptbl_base + *pc++); /* Jump to the first instruction */
+#else
+  while(1) {
+    curr_instr = *pc++;
+    switch(curr_instr) {
+#endif
+/* Basic stack operations */
+      
+      Instruct(ACC0){
+	print_instr("ACC0");
+	accu = sp[0]; Next;
+      }
+      Instruct(ACC1){
+	print_instr("ACC1");
+	accu = sp[1]; Next;
+      }
+      Instruct(ACC2){
+	print_instr("ACC2");
+	accu = sp[2]; Next;
+      }
+      Instruct(ACC3){
+	print_instr("ACC3");
+	accu = sp[3]; Next;
+      }
+      Instruct(ACC4){
+	print_instr("ACC4");
+	accu = sp[4]; Next;
+      }
+      Instruct(ACC5){
+	print_instr("ACC5");
+	accu = sp[5]; Next;
+      }
+      Instruct(ACC6){
+	print_instr("ACC6");
+	accu = sp[6]; Next;
+      }
+      Instruct(ACC7){
+	print_instr("ACC7");
+        accu = sp[7]; Next;
+      }      
+      Instruct(PUSH){
+	print_instr("PUSH");
+	*--sp = accu; Next;
+      }
+      Instruct(PUSHACC0) {
+	print_instr("PUSHACC0");
+        *--sp = accu; Next;
+      }
+      Instruct(PUSHACC1){
+	print_instr("PUSHACC1");
+        *--sp = accu; accu = sp[1]; Next;
+      }
+      Instruct(PUSHACC2){
+	print_instr("PUSHACC2");
+        *--sp = accu; accu = sp[2]; Next;
+      }
+      Instruct(PUSHACC3){
+	print_instr("PUSHACC3");
+	*--sp = accu; accu = sp[3]; Next;
+      }
+      Instruct(PUSHACC4){
+	print_instr("PUSHACC4");
+	*--sp = accu; accu = sp[4]; Next;
+      }
+      Instruct(PUSHACC5){
+	print_instr("PUSHACC5");
+	*--sp = accu; accu = sp[5]; Next;
+      }
+      Instruct(PUSHACC6){
+	print_instr("PUSHACC5");
+	*--sp = accu; accu = sp[6]; Next;
+      }
+      Instruct(PUSHACC7){
+	print_instr("PUSHACC7");
+	*--sp = accu; accu = sp[7]; Next;
+      }
+      Instruct(PUSHACC){
+	print_instr("PUSHACC");
+	*--sp = accu;
+      }
+      /* Fallthrough */
+      
+      Instruct(ACC){
+	print_instr("ACC");
+	accu = sp[*pc++];
+        Next;
+      }
+      
+      Instruct(POP){
+	print_instr("POP");
+	sp += *pc++;
+	Next;
+      }
+      /* Access in heap-allocated environment */
+      
+      Instruct(ENVACC1){
+	print_instr("ENVACC1");
+	accu = Field(coq_env, 1); Next;
+      }
+      Instruct(ENVACC2){
+	print_instr("ENVACC2");
+	accu = Field(coq_env, 2); Next;
+      }
+      Instruct(ENVACC3){
+	print_instr("ENVACC3");
+	accu = Field(coq_env, 3); Next;
+      }
+      Instruct(ENVACC4){
+	print_instr("ENVACC4");
+	accu = Field(coq_env, 4); Next;
+      }
+      Instruct(PUSHENVACC1){
+	print_instr("PUSHENVACC1");
+	*--sp = accu; accu = Field(coq_env, 1); Next;
+      }
+      Instruct(PUSHENVACC2){
+	print_instr("PUSHENVACC2");
+	*--sp = accu; accu = Field(coq_env, 2); Next;
+      }
+      Instruct(PUSHENVACC3){
+	print_instr("PUSHENVACC3");
+	*--sp = accu; accu = Field(coq_env, 3); Next;
+      }
+      Instruct(PUSHENVACC4){
+	print_instr("PUSHENVACC4");
+	*--sp = accu; accu = Field(coq_env, 4); Next;
+      }
+      Instruct(PUSHENVACC){
+	print_instr("PUSHENVACC");
+	*--sp = accu;
+      }
+      /* Fallthrough */
+      Instruct(ENVACC){
+	print_instr("ENVACC");
+	accu = Field(coq_env, *pc++);
+        Next;
+      }
+      /* Function application */
+      
+      Instruct(PUSH_RETADDR) {
+	print_instr("PUSH_RETADDR");
+	sp -= 3;
+	sp[0] = (value) (pc + *pc);
+	sp[1] = coq_env;
+	sp[2] = Val_long(coq_extra_args);
+	coq_extra_args = 0;
+	pc++;
+	Next;
+      }
+      Instruct(APPLY) {
+	print_instr("APPLY");
+	coq_extra_args = *pc - 1;
+	pc = Code_val(accu);
+	coq_env = accu;
+	goto check_stacks;
+      }
+      Instruct(APPLY1) {
+	value arg1 = sp[0];
+	print_instr("APPLY1");
+	sp -= 3;
+	sp[0] = arg1;
+	sp[1] = (value)pc;
+	sp[2] = coq_env;
+	sp[3] = Val_long(coq_extra_args);
+	pc = Code_val(accu);
+	coq_env = accu;
+	coq_extra_args = 0;
+	goto check_stacks;
+      }
+      Instruct(APPLY2) {
+	value arg1 = sp[0];
+	value arg2 = sp[1];
+	print_instr("APPLY2");
+	sp -= 3;
+	sp[0] = arg1;
+	sp[1] = arg2;
+	sp[2] = (value)pc;
+	sp[3] = coq_env;
+	sp[4] = Val_long(coq_extra_args);
+	pc = Code_val(accu);
+	coq_env = accu;
+	coq_extra_args = 1;
+	goto check_stacks;
+      }
+      Instruct(APPLY3) {
+	value arg1 = sp[0];
+	value arg2 = sp[1];
+	value arg3 = sp[2];
+	print_instr("APPLY3");
+	sp -= 3;
+	sp[0] = arg1;
+	sp[1] = arg2;
+	sp[2] = arg3;
+	sp[3] = (value)pc;
+	sp[4] = coq_env;
+	sp[5] = Val_long(coq_extra_args);
+	pc = Code_val(accu);
+	coq_env = accu;
+	coq_extra_args = 2;
+	goto check_stacks;
+      }
+
+      Instruct(APPTERM) {
+	int nargs = *pc++;
+	int slotsize = *pc;
+	value * newsp;
+	int i;
+	print_instr("APPTERM");
+	/* Slide the nargs bottom words of the current frame to the top
+	   of the frame, and discard the remainder of the frame */
+	newsp = sp + slotsize - nargs;
+	for (i = nargs - 1; i >= 0; i--) newsp[i] = sp[i];
+	sp = newsp;
+	pc = Code_val(accu);
+	coq_env = accu;
+	coq_extra_args += nargs - 1;
+	goto check_stacks;
+      }
+      Instruct(APPTERM1) {
+	value arg1 = sp[0];
+	print_instr("APPTERM1");
+	sp = sp + *pc - 1;
+	sp[0] = arg1;
+	pc = Code_val(accu);
+	coq_env = accu;
+	goto check_stacks;
+      }
+      Instruct(APPTERM2) {
+	value arg1 = sp[0];
+	value arg2 = sp[1];
+	print_instr("APPTERM2");
+	sp = sp + *pc - 2;
+	sp[0] = arg1;
+	sp[1] = arg2;
+	pc = Code_val(accu);
+	coq_env = accu;
+	coq_extra_args += 1;
+	goto check_stacks;
+      }
+      Instruct(APPTERM3) {
+	value arg1 = sp[0];
+	value arg2 = sp[1];
+	value arg3 = sp[2];
+	print_instr("APPTERM3");
+	sp = sp + *pc - 3;
+	sp[0] = arg1;
+	sp[1] = arg2;
+	sp[2] = arg3;
+	pc = Code_val(accu);
+	coq_env = accu;
+	coq_extra_args += 2;
+	goto check_stacks;
+      }
+      
+      Instruct(RETURN) {
+	print_instr("RETURN");
+	sp += *pc++;
+	if (coq_extra_args > 0) {
+	  coq_extra_args--;
+	  pc = Code_val(accu);
+	  coq_env = accu;
+	} else {
+	  pc = (code_t)(sp[0]);
+	  coq_env = sp[1];
+	  coq_extra_args = Long_val(sp[2]);
+	  sp += 3;
+	}
+	Next;
+      }
+      
+      Instruct(RESTART) {
+	int num_args = Wosize_val(coq_env) - 2;
+	int i;
+	print_instr("RESTART");
+	sp -= num_args;
+	for (i = 0; i < num_args; i++) sp[i] = Field(coq_env, i + 2);
+	coq_env = Field(coq_env, 1);
+	coq_extra_args += num_args;
+	Next;
+      }
+      
+      Instruct(GRAB) {
+	int required = *pc++;
+	print_instr("GRAB");
+	/*	printf("GRAB %d\n",required); */
+	if (coq_extra_args >= required) {
+	  coq_extra_args -= required;
+	} else {
+	  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(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");
+	if (rec_pos <= coq_extra_args && !Is_accu(sp[rec_pos])) {
+	  pc++;/* On saute le Restart */
+	} else {
+	  if (coq_extra_args < rec_pos) {
+	    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; 
+	    sp += num_args;
+	    pc = (code_t)(sp[0]);
+	    coq_env = sp[1];
+	    coq_extra_args = Long_val(sp[2]);
+	    sp += 3;
+	  } else {
+	    /* L'argument recursif est un accumulateur */
+	    mlsize_t num_args, i;
+	    /* Construction du PF partiellement appliqué */ 
+	    Alloc_small(accu, rec_pos + 2, Closure_tag); 
+	    Field(accu, 1) = coq_env;
+	    for (i = 0; i < rec_pos; i++) Field(accu, i + 2) = sp[i];
+	    Code_val(accu) = pc;
+	    sp += rec_pos;
+	    *--sp = accu;
+	      /* Construction de l'atom */
+	    Alloc_small(accu, 2, ATOM_FIX_TAG);
+	    Field(accu,1) = sp[0];
+	    Field(accu,0)  = sp[1];
+	    sp++; sp[0] = accu;
+	      /* Construction de l'accumulateur */
+	    num_args = coq_extra_args - rec_pos;
+	    Alloc_small(accu, 2+num_args, Accu_tag);
+	    Code_val(accu) = accumulate;
+	    Field(accu,1) = sp[0]; sp++;
+	    for (i = 0; i < num_args;i++)Field(accu, i + 2) = sp[i];
+	    sp += num_args;
+	    pc = (code_t)(sp[0]);
+	    coq_env = sp[1];
+	    coq_extra_args = Long_val(sp[2]);
+	    sp += 3;
+	  }
+	}
+	Next;
+      }
+	
+      Instruct(CLOSURE) {
+	int nvars = *pc++;
+	int i;
+	print_instr("CLOSURE");
+	print_int(nvars);
+	if (nvars > 0) *--sp = accu;
+	Alloc_small(accu, 1 + nvars, Closure_tag);
+	Code_val(accu) = pc + *pc;
+	pc++;
+	for (i = 0; i < nvars; i++) Field(accu, i + 1) = sp[i];
+	sp += nvars;
+	Next;
+      }
+
+      Instruct(CLOSUREREC) {
+	int nfuncs = *pc++;
+	int nvars = *pc++;
+	int start = *pc++;
+	int i;
+	value * p;
+	print_instr("CLOSUREREC");
+	if (nvars > 0) *--sp = accu;
+	/* construction du vecteur de type */
+	Alloc_small(accu, nfuncs, 0);
+	for(i = 0; i < nfuncs; i++) {
+	  Field(accu,i) = (value)(pc+pc[i]);
+	}
+	pc += nfuncs;
+	*--sp=accu;
+	Alloc_small(accu, nfuncs * 2 + nvars, Closure_tag);
+	Field(accu, nfuncs * 2 + nvars - 1) = *sp++;
+	/* On remplie la partie pour les variables libres */
+	p = &Field(accu, nfuncs * 2 - 1);
+	for (i = 0; i < nvars; i++) {
+	  *p++ = *sp++;
+	}
+	p = &Field(accu, 0);
+	*p = (value) (pc + pc[0]);
+	p++;
+	for (i = 1; i < nfuncs; i++) {
+	  *p = Make_header(i * 2, Infix_tag, Caml_white);
+	  p++;                                /* color irrelevant. */
+	  *p = (value) (pc + pc[i]);
+	  p++;
+	}
+	pc += nfuncs;
+	accu = accu + 2 * start * sizeof(value);
+	Next;
+      }
+     
+      Instruct(PUSHOFFSETCLOSURE) {
+	print_instr("PUSHOFFSETCLOSURE");
+	*--sp = accu;
+      } /* fallthrough */
+      Instruct(OFFSETCLOSURE) {
+	print_instr("OFFSETCLOSURE");
+	accu = coq_env + *pc++ * sizeof(value); Next;
+      }
+      Instruct(PUSHOFFSETCLOSUREM2) {
+	print_instr("PUSHOFFSETCLOSUREM2");
+	*--sp = accu;
+      } /* fallthrough */
+      Instruct(OFFSETCLOSUREM2) {
+	print_instr("OFFSETCLOSUREM2");
+	accu = coq_env - 2 * sizeof(value); Next;
+      }
+      Instruct(PUSHOFFSETCLOSURE0) {
+	print_instr("PUSHOFFSETCLOSURE0");
+	*--sp = accu; 
+      }/* fallthrough */
+      Instruct(OFFSETCLOSURE0) {
+	print_instr("OFFSETCLOSURE0");
+	accu = coq_env; Next;
+      }
+      Instruct(PUSHOFFSETCLOSURE2){
+	print_instr("PUSHOFFSETCLOSURE2");
+	*--sp = accu; /* fallthrough */
+      }
+      Instruct(OFFSETCLOSURE2) {
+	print_instr("OFFSETCLOSURE2");
+	accu = coq_env + 2 * sizeof(value); Next;
+      }
+
+/* Access to global variables */
+
+      Instruct(PUSHGETGLOBAL) {
+	print_instr("PUSHGETGLOBAL");
+	*--sp = accu;
+      }
+      /* Fallthrough */
+      Instruct(GETGLOBAL){
+	print_instr("GETGLOBAL");
+	accu = Field(coq_global_data, *pc);
+        pc++;
+        Next;
+      }    
+
+/* Allocation of blocks */
+
+      Instruct(MAKEBLOCK) {
+	mlsize_t wosize = *pc++;
+	tag_t tag = *pc++;
+	mlsize_t i;
+	value block;
+	print_instr("MAKEBLOCK");
+	Alloc_small(block, wosize, tag);
+	Field(block, 0) = accu;
+	for (i = 1; i < wosize; i++) Field(block, i) = *sp++;
+	accu = block;
+	Next;
+      }
+      Instruct(MAKEBLOCK1) {
+	
+	tag_t tag = *pc++;
+	value block;
+	print_instr("MAKEBLOCK1");
+	Alloc_small(block, 1, tag);
+	Field(block, 0) = accu;
+	accu = block;
+	Next;
+      }
+      Instruct(MAKEBLOCK2) {
+	
+	tag_t tag = *pc++;
+	value block;
+	print_instr("MAKEBLOCK2");
+	Alloc_small(block, 2, tag);
+	Field(block, 0) = accu;
+	Field(block, 1) = sp[0];
+	sp += 1;
+	accu = block;
+	Next;
+      }
+      Instruct(MAKEBLOCK3) {
+	tag_t tag = *pc++;
+	value block;
+	print_instr("MAKEBLOCK3");
+	Alloc_small(block, 3, tag);
+	Field(block, 0) = accu;
+	Field(block, 1) = sp[0];
+	Field(block, 2) = sp[1];
+	sp += 2;
+	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);
+	if (Is_block(accu)) {
+	  long index = Tag_val(accu);
+	  print_instr("block");
+	  print_int(index);
+	  pc += pc[(sizes & 0xFFFF) + index];
+	} else {
+	  long index = Long_val(accu);
+	  print_instr("constant");
+	  print_int(index);
+	  pc += pc[index];
+	}
+	  Next;
+      }
+      Instruct(PUSHFIELD){
+	int i;
+	int size = *pc++;
+	print_instr("PUSHFIELD");
+	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++;
+	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;
+      }
+      Next;
+      /* Fall through CHECK_SIGNALS */
+
+/* Integer constants */
+
+      Instruct(CONST0){
+	print_instr("CONST0");
+	accu = Val_int(0); Next;}
+      Instruct(CONST1){
+	print_instr("CONST1");
+	accu = Val_int(1); Next;}
+      Instruct(CONST2){
+	print_instr("CONST2");
+	accu = Val_int(2); Next;}
+      Instruct(CONST3){
+	print_instr("CONST3");
+	accu = Val_int(3); Next;}
+      
+      Instruct(PUSHCONST0){
+	print_instr("PUSHCONST0");
+	*--sp = accu; accu = Val_int(0); Next;
+      }
+      Instruct(PUSHCONST1){
+	print_instr("PUSHCONST1");
+	*--sp = accu; accu = Val_int(1); Next;
+      }
+      Instruct(PUSHCONST2){
+	print_instr("PUSHCONST2");
+	*--sp = accu; accu = Val_int(2); Next;
+      }
+      Instruct(PUSHCONST3){
+	print_instr("PUSHCONST3");
+	*--sp = accu; accu = Val_int(3); Next;
+      }
+
+      Instruct(PUSHCONSTINT){
+	print_instr("PUSHCONSTINT");
+	*--sp = accu;
+      }
+      /* Fallthrough */
+      Instruct(CONSTINT) {
+	print_instr("CONSTINT");
+	accu = Val_int(*pc);
+	pc++;
+	Next;
+      }
+
+/* Debugging and machine control */
+
+      Instruct(STOP){
+	print_instr("STOP");
+	coq_sp = sp;
+	return accu;
+      }
+      
+      Instruct(ACCUMULATECOND) {
+	int i, num;
+	print_instr("ACCUMULATECOND");
+	num = *pc;
+	pc++;
+	if (Field(coq_global_boxed, num) == Val_false || coq_all_transp) {
+	  /*	  printf ("false\n");
+	    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);
+	  coq_env = Field(Field(accu,1),1);
+	  pc = Code_val(coq_env);
+	  accu = coq_env;
+	  /*	  printf ("end\n"); */
+	  Next;
+	};
+	/*	printf ("true\n"); */
+      }
+
+      Instruct(ACCUMULATE) {
+	mlsize_t i, size;
+	print_instr("ACCUMULATE");
+	size = Wosize_val(coq_env);
+	Alloc_small(accu, size + coq_extra_args + 1, Accu_tag);
+	for(i = 0; i < size; i++) Field(accu, i) = Field(coq_env, i);
+	for(i = size; i <= coq_extra_args + size; i++) 
+	  Field(accu, i) = *sp++;
+	pc = (code_t)(sp[0]);
+	coq_env = sp[1];
+	coq_extra_args = Long_val(sp[2]);
+	sp += 3;
+	Next;
+      }  
+            
+      Instruct(MAKEACCU) {
+	int i;
+	print_instr("MAKEACCU");
+	Alloc_small(accu, coq_extra_args + 3, Accu_tag);
+	Code_val(accu) = accumulate;
+	Field(accu,1) = Field(coq_atom_tbl, *pc);
+	for(i = 2; i < coq_extra_args + 3; i++) Field(accu, i) = *sp++;
+	pc = (code_t)(sp[0]);
+	coq_env = sp[1];
+	coq_extra_args = Long_val(sp[2]);
+	sp += 3;
+	Next;
+      }
+     
+      Instruct(MAKEPROD) {
+	print_instr("MAKEPROD");
+	*--sp=accu;
+	Alloc_small(accu,2,0);
+	Field(accu, 0) = sp[0];
+	Field(accu, 1) = sp[1];
+	sp += 2;
+	Next;
+      }
+      
+#ifndef THREADED_CODE
+    default:
+      /*fprintf(stderr, "%d\n", *pc);*/
+      failwith("Coq VM: Fatal error: bad opcode");
+    }
+  }
+#endif
+}
+
+value coq_push_ra(value tcode) { 
+  print_instr("push_ra");
+  coq_sp -= 3;
+  coq_sp[0] = (value) tcode;
+  coq_sp[1] = Val_unit;
+  coq_sp[2] = Val_long(0);
+  return Val_unit;
+}
+
+value coq_push_val(value v) {
+  print_instr("push_val");
+  *--coq_sp = v;
+  return Val_unit;
+}
+
+value coq_push_arguments(value args) {
+  int nargs,i;
+  nargs = Wosize_val(args) - 2;
+  coq_sp -= nargs;
+  print_instr("push_args");print_int(nargs);
+  for(i = 0; i < nargs; i++) coq_sp[i] = Field(args, i+2);
+  return Val_unit;
+}
+
+value coq_push_vstack(value stk) {
+  int len,i;
+  len = Wosize_val(stk);
+  coq_sp -= len;
+  print_instr("push_vstack");print_int(len);
+   for(i = 0; i < len; i++) coq_sp[i] = Field(stk,i);
+  return Val_unit;
+}
+
+value  coq_interprete_ml(value tcode, value a, value e, value ea) {
+  print_instr("coq_interprete");
+  return coq_interprete((code_t)tcode, a, e, Long_val(ea));
+   print_instr("end coq_interprete");
+}
+
+value coq_eval_tcode (value tcode, value e) {
+  return coq_interprete_ml(tcode, Val_unit, e, 0);
+}
diff --git a/kernel/byterun/coq_interp.h b/kernel/byterun/coq_interp.h
new file mode 100644
index 00000000..76e68944
--- /dev/null
+++ b/kernel/byterun/coq_interp.h
@@ -0,0 +1,23 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+
+value coq_push_ra(value tcode);
+
+value coq_push_val(value v);
+
+value coq_push_arguments(value args);
+
+value coq_push_vstack(value stk);
+
+value  coq_interprete_ml(value tcode, value a, value e, value ea);
+
+value coq_eval_tcode (value tcode, value e);
+
diff --git a/kernel/byterun/coq_memory.c b/kernel/byterun/coq_memory.c
new file mode 100644
index 00000000..db6aacb9
--- /dev/null
+++ b/kernel/byterun/coq_memory.c
@@ -0,0 +1,273 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+#include <stdio.h>
+#include <string.h> 
+#include "coq_gc.h"
+#include "coq_instruct.h"
+#include "coq_fix_code.h"
+#include "coq_memory.h"
+
+/* stack */
+
+value * coq_stack_low;
+value * coq_stack_high;
+value * coq_stack_threshold;
+asize_t coq_max_stack_size = Coq_max_stack_size;
+/* global_data */
+
+
+value coq_global_data;
+value coq_global_boxed;
+int coq_all_transp;
+value coq_atom_tbl;
+
+int drawinstr;
+/* interp state */
+
+long coq_saved_sp_offset;
+value * coq_sp;
+value forcable;
+/* Some predefined pointer code */ 
+code_t accumulate;
+
+/* functions over global environment */
+
+void coq_stat_free (void * blk)
+{
+  free (blk);
+}
+
+value coq_static_alloc(value size) /* ML */
+{
+  return (value) coq_stat_alloc((asize_t) Long_val(size));
+}
+
+value coq_static_free(value blk)  /* ML */
+{
+  coq_stat_free((void *) blk);
+  return Val_unit;
+}
+
+value accumulate_code(value unit) /* ML */
+{
+  return (value) accumulate;
+}
+
+static void (*coq_prev_scan_roots_hook) (scanning_action);
+
+static void coq_scan_roots(scanning_action action)
+{
+  register value * i;
+  /* Scan the global variables */
+  (*action)(coq_global_data, &coq_global_data);
+  (*action)(coq_global_boxed, &coq_global_boxed);
+  (*action)(coq_atom_tbl, &coq_atom_tbl);
+  /* Scan the stack */
+  for (i = coq_sp; i < coq_stack_high; i++) {
+    (*action) (*i, i);
+  };
+  /* Hook */
+  if (coq_prev_scan_roots_hook != NULL) (*coq_prev_scan_roots_hook)(action);
+
+
+}
+
+void init_coq_stack()
+{
+  coq_stack_low = (value *) coq_stat_alloc(Coq_stack_size);
+  coq_stack_high = coq_stack_low + Coq_stack_size / sizeof (value);
+  coq_stack_threshold = coq_stack_low + Coq_stack_threshold / sizeof(value);
+  coq_max_stack_size = Coq_max_stack_size;
+}  
+
+void init_coq_global_data(long requested_size)
+{
+  int i;
+  coq_global_data = alloc_shr(requested_size, 0);
+  for (i = 0; i < requested_size; i++) 
+    Field (coq_global_data, i) = Val_unit;
+}
+
+void init_coq_global_boxed(long requested_size)
+{
+  int i;
+  coq_global_boxed = alloc_shr(requested_size, 0);
+  for (i = 0; i < requested_size; i++) 
+    Field (coq_global_boxed, i) = Val_true;
+}
+
+void init_coq_atom_tbl(long requested_size){
+  int i;
+  coq_atom_tbl = alloc_shr(requested_size, 0);
+  for (i = 0; i < requested_size; i++) Field (coq_atom_tbl, i) = Val_unit;
+}
+
+void init_coq_interpreter()
+{
+  coq_sp = coq_stack_high;
+  coq_interprete(NULL, Val_unit, Val_unit, 0);
+}
+
+static int coq_vm_initialized = 0;
+
+value init_coq_vm(value unit) /* ML */
+{
+  int i;
+  if (coq_vm_initialized == 1) {
+    fprintf(stderr,"already open \n");fflush(stderr);}
+  else {
+    drawinstr=0;
+#ifdef THREADED_CODE   
+    init_arity();
+#endif /* THREADED_CODE */
+    /* Allocate the table of global and the stack */
+    init_coq_stack();
+    init_coq_global_data(Coq_global_data_Size);
+    init_coq_global_boxed(40);
+    init_coq_atom_tbl(40);
+    /* Initialing the interpreter */
+    coq_all_transp = 0;
+    forcable = Val_false;
+    init_coq_interpreter();
+    
+    /* Some predefined pointer code */
+    accumulate = (code_t) coq_stat_alloc(sizeof(opcode_t));
+    *accumulate = VALINSTR(ACCUMULATE);
+
+  /* Initialize GC */
+    if (coq_prev_scan_roots_hook == NULL)
+      coq_prev_scan_roots_hook = scan_roots_hook;
+    scan_roots_hook = coq_scan_roots;
+    coq_vm_initialized = 1;
+  } 
+  return Val_unit;;
+}
+
+void realloc_coq_stack(asize_t required_space)
+{
+  asize_t size;
+  value * new_low, * new_high, * new_sp;
+  value * p;
+  size = coq_stack_high - coq_stack_low;
+  do {
+    size *= 2;
+  } while (size < coq_stack_high - coq_sp + required_space);
+  new_low = (value *) coq_stat_alloc(size * sizeof(value));
+  new_high = new_low + size;
+
+#define shift(ptr) \
+    ((char *) new_high - ((char *) coq_stack_high - (char *) (ptr)))
+
+  new_sp = (value *) shift(coq_sp);
+  memmove((char *) new_sp,
+        (char *) coq_sp,
+        (coq_stack_high - coq_sp) * sizeof(value));
+  coq_stat_free(coq_stack_low);
+  coq_stack_low = new_low;
+  coq_stack_high = new_high;
+  coq_stack_threshold = coq_stack_low + Coq_stack_threshold / sizeof(value);
+  coq_sp = new_sp;
+#undef shift
+}
+
+value get_coq_global_data(value unit)                /* ML */
+{
+  return coq_global_data;
+}
+
+value get_coq_atom_tbl(value unit)                  /* ML */
+{
+  return coq_atom_tbl;
+}
+
+value get_coq_global_boxed(value unit)        /* ML */
+{
+  return coq_global_boxed;
+}
+
+value realloc_coq_global_data(value size)           /* ML */
+{
+  mlsize_t requested_size, actual_size, i;
+  value new_global_data;
+  requested_size = Long_val(size);
+  actual_size = Wosize_val(coq_global_data);
+  if (requested_size >= actual_size) {
+    requested_size = (requested_size + 0x100) & 0xFFFFFF00;
+    new_global_data = alloc_shr(requested_size, 0);
+    for (i = 0; i < actual_size; i++)
+      initialize(&Field(new_global_data, i), Field(coq_global_data, i));
+    for (i = actual_size; i < requested_size; i++){
+      Field (new_global_data, i) = Val_long (0);
+    }
+    coq_global_data = new_global_data;
+  }
+  return Val_unit;
+}
+
+value realloc_coq_global_boxed(value size)           /* ML */
+{
+  mlsize_t requested_size, actual_size, i;
+  value new_global_boxed;
+  requested_size = Long_val(size);
+  actual_size = Wosize_val(coq_global_boxed);
+  if (requested_size >= actual_size) {
+    requested_size = (requested_size + 0x100) & 0xFFFFFF00;
+    new_global_boxed = alloc_shr(requested_size, 0);
+    for (i = 0; i < actual_size; i++)
+      initialize(&Field(new_global_boxed, i), Field(coq_global_boxed, i));
+    for (i = actual_size; i < requested_size; i++)
+      Field (new_global_boxed, i) = Val_long (0);
+    coq_global_boxed = new_global_boxed;
+  }
+  return Val_unit;
+}
+
+value realloc_coq_atom_tbl(value size)            /* ML */
+{
+  mlsize_t requested_size, actual_size, i;
+  value new_atom_tbl;
+  requested_size = Long_val(size);
+  actual_size = Wosize_val(coq_atom_tbl);
+  if (requested_size >= actual_size) {
+    requested_size = (requested_size + 0x100) & 0xFFFFFF00;
+    new_atom_tbl = alloc_shr(requested_size, 0);
+    for (i = 0; i < actual_size; i++)
+      initialize(&Field(new_atom_tbl, i), Field(coq_atom_tbl, i));
+    for (i = actual_size; i < requested_size; i++)
+      Field (new_atom_tbl, i) = Val_long (0);
+    coq_atom_tbl = new_atom_tbl;
+  }
+  return Val_unit;
+}
+
+
+value coq_set_transp_value(value transp)
+{
+  coq_all_transp = (transp == Val_true);
+  return Val_unit;
+}
+
+value get_coq_transp_value(value unit)
+{
+  return Val_bool(coq_all_transp);
+}
+
+value coq_set_drawinstr(value unit)
+{
+  drawinstr = 1;
+  return Val_unit;
+}
+
+value coq_set_forcable (value unit)
+{
+  forcable = Val_true;
+  return Val_unit;
+}
diff --git a/kernel/byterun/coq_memory.h b/kernel/byterun/coq_memory.h
new file mode 100644
index 00000000..7c96e684
--- /dev/null
+++ b/kernel/byterun/coq_memory.h
@@ -0,0 +1,70 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+#ifndef _COQ_MEMORY_
+#define _COQ_MEMORY_
+
+#include "config.h"
+#include "fail.h"
+#include "misc.h"
+#include "memory.h"
+#include "mlvalues.h"
+
+
+#define Coq_stack_size (4096 * sizeof(value))
+#define Coq_stack_threshold (256 * sizeof(value))
+#define Coq_global_data_Size (4096 * sizeof(value))
+#define Coq_max_stack_size (256 * 1024)
+
+#define TRANSP 0
+#define BOXED 1
+
+/* stack */
+
+extern value * coq_stack_low;
+extern value * coq_stack_high;
+extern value * coq_stack_threshold;
+
+/* global_data */
+
+extern value coq_global_data;
+extern value coq_global_boxed;
+extern int coq_all_transp;
+extern value coq_atom_tbl;
+
+extern int drawinstr;
+/* interp state */
+
+extern value * coq_sp;
+extern value forcable;
+/* Some predefined pointer code */ 
+extern code_t accumulate;
+
+/* functions over global environment */
+
+value coq_static_alloc(value size);  /* ML */
+value coq_static_free(value string); /* ML */
+
+value init_coq_vm(value unit); /* ML */
+value re_init_coq_vm(value unit); /* ML */
+
+void  realloc_coq_stack(asize_t required_space); 
+value get_coq_global_data(value unit); /* ML */
+value realloc_coq_global_data(value size); /* ML */
+value get_coq_global_boxed(value unit);
+value realloc_coq_global_boxed(value size); /* ML */
+value get_coq_atom_tbl(value unit); /* ML */
+value realloc_coq_atom_tbl(value size); /* ML */
+value coq_set_transp_value(value transp); /* ML */
+value get_coq_transp_value(value unit); /* ML */
+#endif /* _COQ_MEMORY_ */
+
+
+value coq_set_drawinstr(value unit);
diff --git a/kernel/byterun/coq_values.c b/kernel/byterun/coq_values.c
new file mode 100644
index 00000000..baf3ab09
--- /dev/null
+++ b/kernel/byterun/coq_values.c
@@ -0,0 +1,69 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+#include <stdio.h>
+#include "coq_fix_code.h"
+#include "coq_instruct.h"
+#include "coq_memory.h"
+#include "coq_values.h"
+#include "memory.h"
+/* KIND OF VALUES */
+
+#define Setup_for_gc
+#define Restore_after_gc
+
+value coq_kind_of_closure(value v) {
+  opcode_t * c;
+  int res;
+  int is_app = 0;
+  c = Code_val(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);
+  return Val_int(0);
+}
+
+
+/* DESTRUCT ACCU */
+
+value coq_closure_arity(value clos) {
+  opcode_t * c = Code_val(clos);
+  if (Is_instruction(c,RESTART)) {
+    c++;
+    if (Is_instruction(c,GRAB)) return Val_int(3 + c[1] - Wosize_val(clos));
+    else { 
+      if (Wosize_val(clos) != 2) failwith("Coq Values : coq_closure_arity");
+      return Val_int(1);
+    }
+  }
+  if (Is_instruction(c,GRAB)) return Val_int(1 + c[1]);
+  return Val_int(1);
+}
+
+/* Fonction sur les  fix */
+
+value coq_offset(value v) {
+  if (Tag_val(v) == Closure_tag) return Val_int(0);
+  else return Val_long(-Wsize_bsize(Infix_offset_val(v)));
+}
+
+value coq_offset_closure(value v, value offset){
+  return (value)&Field(v, Int_val(offset));
+}
+
+value coq_offset_tcode(value code,value offset){
+  return((value)((code_t)code + Int_val(offset)));
+}
+
+value coq_int_tcode(value code, value offset) {
+  return Val_int(*((code_t) code + Int_val(offset)));
+}
diff --git a/kernel/byterun/coq_values.h b/kernel/byterun/coq_values.h
new file mode 100644
index 00000000..a186d62a
--- /dev/null
+++ b/kernel/byterun/coq_values.h
@@ -0,0 +1,28 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Coq Compiler                              */
+/*                                                                     */
+/*        Benjamin Gregoire, projets Logical and Cristal               */
+/*                        INRIA Rocquencourt                           */
+/*                                                                     */
+/*                                                                     */
+/***********************************************************************/
+
+#ifndef _COQ_VALUES_
+#define _COQ_VALUES_
+
+#include "alloc.h"
+#include "mlvalues.h"
+
+#define ATOM_FIX_TAG 3
+#define ATOM_SWITCH_TAG 4
+
+#define Accu_tag 0
+#define Default_tag 0
+
+/* Les blocs accumulate */
+#define Is_accu(v) (Is_block(v) && (Tag_val(v) == Accu_tag))
+
+#endif /* _COQ_VALUES_ */
+
+
diff --git a/kernel/cbytecodes.ml b/kernel/cbytecodes.ml
new file mode 100644
index 00000000..49955474
--- /dev/null
+++ b/kernel/cbytecodes.ml
@@ -0,0 +1,120 @@
+open Names
+open Term
+
+type tag = int 
+
+type structured_constant =
+  | Const_sorts of sorts
+  | Const_ind of inductive
+  | Const_b0 of tag                
+  | Const_bn of tag * structured_constant array
+
+type reloc_table = (tag * int) array 
+
+type annot_switch = 
+   {ci : case_info; rtbl : reloc_table; tailcall : bool}
+ 
+module Label = 
+  struct
+    type t = int
+    let no = -1
+    let counter = ref no
+    let create () = incr counter; !counter
+    let reset_label_counter () = counter := no 
+  end
+
+
+type instruction =
+  | Klabel of Label.t
+  | Kacc of int
+  | Kenvacc of int
+  | Koffsetclosure of int
+  | Kpush
+  | Kpop of int
+  | Kpush_retaddr of Label.t
+  | Kapply of int                       (*  number of arguments *)
+  | Kappterm of int * int               (* number of arguments, slot size *)
+  | Kreturn of int                      (* slot size *)
+  | Kjump
+  | 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 *)
+  | 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 
+  | Kstop
+  | Ksequence of bytecodes * bytecodes
+
+and bytecodes = instruction list
+
+type fv_elem = FVnamed of identifier | FVrel of int
+
+type fv = fv_elem array
+
+
+(* --- Pretty print *)
+open Format
+let rec instruction ppf = function
+  | Klabel lbl -> fprintf ppf "L%i:" lbl
+  | Kacc n -> fprintf ppf "\tacc %i" n
+  | Kenvacc n -> fprintf ppf "\tenvacc %i" n
+  | Koffsetclosure n -> fprintf ppf "\toffsetclosure %i" n
+  | Kpush -> fprintf ppf "\tpush"
+  | Kpop n -> fprintf ppf "\tpop %i" n
+  | Kpush_retaddr lbl -> fprintf ppf "\tpush_retaddr L%i" lbl
+  | Kapply n -> fprintf ppf "\tapply %i" n
+  | Kappterm(n, m) ->
+      fprintf ppf "\tappterm %i, %i" n m
+  | Kreturn n -> fprintf ppf "\treturn %i" n
+  | Kjump -> fprintf ppf "\tjump"
+  | 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) ->
+      fprintf ppf "\tclosurerec";
+      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;
+                   (* nb fv, init, lbl types, lbl bodies *)
+  | Kgetglobal id -> fprintf ppf "\tgetglobal %s" (Names.string_of_con id)
+  | Kconst cst ->
+      fprintf ppf "\tconst"
+  | Kmakeblock(n, m) ->
+      fprintf ppf "\tmakeblock %i, %i" n m
+  | 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
+  | Kstop -> fprintf ppf "\tstop"
+  | Ksequence (c1,c2) ->
+      fprintf ppf "%a@ %a" instruction_list c1 instruction_list c2 
+
+and instruction_list ppf = function
+    [] -> ()
+  | Klabel lbl :: il ->
+      fprintf ppf "L%i:%a" lbl instruction_list il
+  | instr :: il ->
+      fprintf ppf "%a@ %a" instruction instr instruction_list il
+ 
+let draw_instr c =
+  fprintf std_formatter "@[<v 0>%a@]" instruction_list c
diff --git a/kernel/cbytecodes.mli b/kernel/cbytecodes.mli
new file mode 100644
index 00000000..a996f750
--- /dev/null
+++ b/kernel/cbytecodes.mli
@@ -0,0 +1,61 @@
+open Names
+open Term
+
+type tag = int 
+
+type structured_constant =
+  | Const_sorts of sorts
+  | Const_ind of inductive
+  | Const_b0 of tag                
+  | Const_bn of tag * structured_constant array
+
+type reloc_table = (tag * int) array 
+
+type annot_switch = 
+   {ci : case_info; rtbl : reloc_table; tailcall : bool}
+
+module Label : 
+  sig
+    type t = int
+    val no : t
+    val create : unit -> t
+    val reset_label_counter : unit -> unit
+  end 
+
+type instruction =
+  | Klabel of Label.t
+  | Kacc of int
+  | Kenvacc of int
+  | Koffsetclosure of int
+  | Kpush
+  | Kpop of int
+  | Kpush_retaddr of Label.t
+  | Kapply of int                       (*  number of arguments *)
+  | Kappterm of int * int               (* number of arguments, slot size *)
+  | Kreturn of int                      (* slot size *)
+  | Kjump
+  | 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 *)
+  | 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 
+  | Kstop
+  | Ksequence of bytecodes * bytecodes
+
+and bytecodes = instruction list
+
+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
new file mode 100644
index 00000000..041e0795
--- /dev/null
+++ b/kernel/cbytegen.ml
@@ -0,0 +1,490 @@
+open Util
+open Names
+open Cbytecodes
+open Cemitcodes
+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 = []}
+
+let fv r = !(r.in_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) 
+
+(* [push_param ] ajoute les parametres de fonction dans la pile *)
+let push_param n sz r =
+  { r with
+    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 *)
+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} 
+
+let find_at el l = 
+  let rec aux n = function
+    | [] -> raise Not_found
+    | hd :: tl -> if hd = el then n else aux (n+1) tl
+  in aux 1 l
+
+let pos_named id r =
+  let env = !(r.in_env) in
+  let cid = FVnamed id in
+  try Kenvacc(r.offset + env.size - (find_at cid env.fv_rev))
+  with Not_found ->
+    let pos = env.size in
+    r.in_env := { size = pos+1; fv_rev =  cid:: env.fv_rev};
+    Kenvacc (r.offset + pos)
+
+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)
+
+
+(*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. *)
+
+let rec discard_dead_code cont = cont
+(*function
+    [] -> []
+  | (Klabel _ | Krestart ) :: _ as 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. *)
+
+let label_code = function
+  | Klabel lbl :: _ as cont -> (lbl, cont)
+  | cont -> let lbl = Label.create() in (lbl, Klabel lbl :: cont)
+
+(* Return a branch to the continuation. That is, an instruction that,
+   when executed, branches to the continuation or performs what the
+   continuation performs. We avoid generating branches to returns. *)
+
+let make_branch cont =
+  match cont with
+  | (Kreturn _ as return) :: cont' -> return, cont'
+  | Klabel lbl as b :: _ -> b, cont
+  | _ -> let b = Klabel(Label.create()) in b,b::cont
+
+(* Check if we're in tailcall position *)
+
+let rec is_tailcall = function
+  | Kreturn k :: _ -> Some k
+  | Klabel _ :: c -> is_tailcall c
+  | _ -> None
+
+(* Extention of the continuation ****)
+	
+(* Add a Kpop n instruction in front of a continuation *)
+let rec add_pop n = function
+  | Kpop m :: cont -> add_pop (n+m) cont
+  | Kreturn m:: cont -> Kreturn (n+m) ::cont
+  | cont -> if n = 0 then cont else Kpop n :: cont
+
+let add_grab arity lbl cont =
+  if arity = 1 then Klabel lbl :: cont
+  else Krestart :: Klabel lbl :: Kgrab (arity - 1) :: cont
+ 
+
+(* Environnement global *****)
+
+let global_env = ref empty_env
+
+let set_global_env env = global_env := env
+
+
+(* Code des fermetures ****)
+let fun_code = ref []
+
+let init_fun_code () = fun_code := []
+
+(* Compilation des constructeurs et des inductifs *)
+
+(* Inv : nparam + arity > 0 *)
+let code_construct tag nparams arity cont =
+  let f_cont =
+      add_pop nparams
+      (if arity = 0 then 
+	[Kconst (Const_b0 tag); Kreturn 0]
+       else [Kacc 0; Kpop 1; Kmakeblock(arity, tag); Kreturn 0])
+    in 
+    let lbl = Label.create() in
+    fun_code := [Ksequence (add_grab (nparams+arity) lbl f_cont,!fun_code)];
+    Kclosure(lbl,0) :: cont
+
+type block = 
+  | Bconstr of constr
+  | Bstrconst of structured_constant
+  | Bmakeblock of int * block array
+  | Bconstruct_app of int * int * int * block array
+                  (* tag , nparams, arity *)
+
+let get_strcst = function
+  | Bstrconst sc -> sc
+  | _ -> raise Not_found 
+
+let rec str_const c =
+  match kind_of_term c with
+  | Sort s -> Bstrconst (Const_sorts s)
+  | Cast(c,_,_) -> str_const c 
+  | App(f,args) -> 
+      begin
+	match kind_of_term f with
+	| Construct((kn,j),i) -> 
+	    let oib = lookup_mind kn !global_env in
+	    let oip = oib.mind_packets.(j) in
+	    let num,arity = oip.mind_reloc_tbl.(i-1) in
+	    let nparams = oib.mind_nparams in
+	    if nparams + arity = Array.length args then
+	      if arity = 0 then Bstrconst(Const_b0 num)
+	      else
+		let rargs = Array.sub args nparams arity in
+		let b_args = Array.map str_const rargs in
+		try 
+		  let sc_args = Array.map get_strcst b_args in
+		  Bstrconst(Const_bn(num, sc_args))
+		with Not_found ->
+		  Bmakeblock(num,b_args)
+	    else  
+	      let b_args = Array.map str_const args in
+	      Bconstruct_app(num, nparams, arity, b_args)
+	| _ -> Bconstr c
+      end
+  | Ind ind -> Bstrconst (Const_ind ind)
+  | Construct ((kn,j),i) ->  
+      let oib = lookup_mind kn !global_env in 
+      let oip = oib.mind_packets.(j) in
+      let num,arity = oip.mind_reloc_tbl.(i-1) in
+      let nparams = oib.mind_nparams in
+      if nparams + arity = 0 then Bstrconst(Const_b0 num)
+      else Bconstruct_app(num,nparams,arity,[||])
+  | _ -> Bconstr c
+
+(* compilation des applications *)
+let comp_args comp_expr reloc args sz cont =
+  let nargs_m_1 = Array.length args - 1 in  
+  let c = ref (comp_expr reloc args.(0) (sz + nargs_m_1) cont) in
+  for i = 1 to nargs_m_1 do
+    c := comp_expr reloc args.(i) (sz + nargs_m_1 - i) (Kpush :: !c)
+  done; 
+  !c
+  
+let comp_app comp_fun comp_arg reloc f args sz cont =
+  let nargs = Array.length args in
+  match is_tailcall cont with
+  | Some k -> 
+      comp_args comp_arg reloc args sz
+	(Kpush ::
+	 comp_fun reloc f (sz + nargs)
+	   (Kappterm(nargs, k + nargs) :: (discard_dead_code cont)))
+  | None ->
+      if nargs < 4 then
+	comp_args comp_arg reloc args sz
+	  (Kpush :: (comp_fun reloc f (sz+nargs) (Kapply nargs :: cont)))
+      else 
+	let lbl,cont1 = label_code cont in
+	Kpush_retaddr lbl ::
+	(comp_args comp_arg reloc args (sz + 3)
+	   (Kpush :: (comp_fun reloc f (sz+3+nargs) (Kapply nargs :: cont1))))
+
+(* Compilation des variables libres *)
+  
+let compile_fv_elem reloc fv sz cont =
+  match fv with
+  | FVrel i -> pos_rel i reloc sz :: cont
+  | FVnamed id -> pos_named id reloc :: cont
+
+(* compilation des constantes *)
+
+let rec get_allias env kn =
+  let tps = (lookup_constant kn env).const_body_code in
+  match Cemitcodes.force tps with
+  | BCallias kn' -> get_allias env kn'
+  | _ -> kn
+
+(* compilation des expressions *)
+ 
+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")
+ 
+  | Cast(c,_,_) -> compile_constr reloc c sz cont
+
+  | Rel i -> pos_rel i reloc sz :: cont
+  | Var id -> pos_named id reloc :: cont
+  | Const kn -> Kgetglobal (get_allias !global_env kn) :: cont
+  
+  | Sort _  | Ind _ | Construct _ ->
+      compile_str_cst reloc (str_const c) sz cont
+  
+  | LetIn(_,xb,_,body) ->
+      compile_constr reloc xb sz 
+	(Kpush :: 
+	(compile_constr (push_local sz reloc) body (sz+1) (add_pop 1 cont)))
+  | Prod(id,dom,codom) ->
+      let cont1 = 
+	Kpush :: compile_constr reloc dom (sz+1) (Kmakeprod :: cont) in
+      compile_constr reloc (mkLambda(id,dom,codom)) sz cont1
+  | Lambda _ ->
+      let params, body = decompose_lam c in
+      let arity = List.length params in
+      let r_fun = init_fun arity in
+      let lbl_fun = Label.create() in
+      let cont_fun = 
+	compile_constr r_fun body arity [Kreturn arity] in
+      fun_code := [Ksequence(add_grab arity lbl_fun cont_fun,!fun_code)];
+      let fv = fv r_fun in
+      compile_fv reloc fv.fv_rev sz (Kclosure(lbl_fun,fv.size) :: cont)
+ 
+  | App(f,args) -> 
+      begin 
+	match kind_of_term f with
+	| Construct _ -> compile_str_cst reloc (str_const c) sz cont
+	| _ -> comp_app compile_constr compile_constr reloc f args sz cont 
+      end
+  | Fix ((rec_args,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
+      for i = 0 to ndef - 1 do
+	let lbl,fcode = 
+	  label_code 
+	    (compile_constr rtype type_bodies.(i) 0 [Kstop]) in 
+	lbl_types.(i) <- lbl; 
+	fun_code := [Ksequence(fcode,!fun_code)]
+      done;
+      (* Compilation des corps *)
+      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 cont1 = 
+	  compile_constr rbody 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
+	fun_code := [Ksequence(fcode,!fun_code)]
+      done;
+      let fv = !rfv in
+      compile_fv reloc fv.fv_rev sz 
+	(Kclosurerec(fv.size,init,lbl_types,lbl_bodies) :: 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
+      for i = 0 to ndef - 1 do
+	let lbl,fcode = 
+	  label_code 
+	    (compile_constr rtype type_bodies.(i) 0 [Kstop]) in
+	lbl_types.(i) <- lbl; 
+	fun_code := [Ksequence(fcode,!fun_code)]
+      done;
+      (* Compilation des corps *)
+      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 lbl = Label.create () in
+
+	let cont1 = 
+	  compile_constr rbody body arity [Kreturn(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
+      done;
+      let fv = !rfv in
+      compile_fv reloc fv.fv_rev sz 
+	(Kclosurerec(fv.size,init,lbl_types,lbl_bodies) :: cont)
+  
+  | Case(ci,t,a,branchs) ->
+      let ind = ci.ci_ind in
+      let mib = lookup_mind (fst ind) !global_env in
+      let oib = mib.mind_packets.(snd ind) in
+      let tbl = oib.mind_reloc_tbl in
+      let lbl_consts = Array.create oib.mind_nb_constant Label.no in
+      let lbl_blocks = Array.create (oib.mind_nb_args+1) Label.no in
+      let branch1,cont = make_branch cont in
+      (* Compilation du type *)
+      let lbl_typ,fcode = 	
+	label_code (compile_constr reloc t sz [Kpop sz; Kstop])
+      in fun_code := [Ksequence(fcode,!fun_code)];
+      (* Compilation des branches *) 
+      let lbl_sw = Label.create () in
+      let sz_b,branch,is_tailcall =
+	match branch1 with 
+	| Kreturn k -> assert (k = sz); sz, branch1, true
+	| _ -> sz+3, Kjump, false
+      in
+      let annot = {ci = ci; rtbl = tbl; tailcall = is_tailcall} in
+     (* Compilation de la branche accumulate *)
+      let lbl_accu, code_accu = 
+	label_code(Kmakeswitchblock(lbl_typ,lbl_sw,annot,sz) :: branch::cont) 
+      in
+      lbl_blocks.(0) <- lbl_accu;
+      let c = ref code_accu in
+      (* Compilation des branches constructeurs *)
+      for i = 0 to Array.length tbl - 1 do
+	let tag, arity = tbl.(i) in
+	if arity = 0 then
+	  let lbl_b,code_b = 
+	    label_code(compile_constr reloc branchs.(i) sz_b (branch :: !c)) in
+	  lbl_consts.(tag) <- lbl_b; 
+	  c := code_b
+	else 
+	  let args, body = decompose_lam branchs.(i) in
+	  let nargs = List.length args in
+	  let lbl_b,code_b = 
+	    label_code(
+	    if nargs = arity then
+	      Kpushfield 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 :: 
+	      compile_constr reloc branchs.(i) (sz_b+arity)
+		(Kappterm(arity,sz_appterm) :: !c))
+	  in
+	  lbl_blocks.(tag) <- lbl_b;
+	  c := code_b
+      done;
+      c :=  Klabel lbl_sw :: Kswitch(lbl_consts,lbl_blocks) :: !c;
+      let code_sw = 
+	match branch1 with
+	| 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)
+      
+and compile_str_cst reloc sc sz cont =
+  match sc with
+  | Bconstr c -> compile_constr reloc c sz cont
+  | Bstrconst sc -> Kconst sc :: cont
+  | Bmakeblock(tag,args) ->
+      let nargs = Array.length args in
+      comp_args compile_str_cst reloc args sz (Kmakeblock(nargs,tag) :: cont)
+  | Bconstruct_app(tag,nparams,arity,args) ->
+      if Array.length args = 0 then code_construct tag nparams arity cont
+      else
+	comp_app 
+	  (fun _ _ _ cont -> code_construct tag nparams arity cont) 
+	  compile_str_cst reloc () args sz cont
+      
+let compile env c =
+  set_global_env env;
+  init_fun_code ();
+  Label.reset_label_counter ();
+  let reloc = empty () in
+  let init_code = compile_constr reloc c 0 [Kstop] in
+  let fv = List.rev (!(reloc.in_env).fv_rev) in
+  init_code,!fun_code, Array.of_list fv
+
+let compile_constant_body env body opaque boxed =
+  if opaque then BCconstant
+  else match body with
+  | None -> BCconstant
+  | Some sb ->
+      let body = Declarations.force sb in
+      if boxed then
+	let res = compile env body in
+	let to_patch = to_memory res in
+	BCdefined(true, to_patch)
+      else
+	match kind_of_term body with
+	| Const kn' -> BCallias (get_allias env kn')
+	| _ -> 
+	    let res = compile env body in
+	    let to_patch = to_memory res in
+	    BCdefined (false, to_patch)
+
diff --git a/kernel/cbytegen.mli b/kernel/cbytegen.mli
new file mode 100644
index 00000000..f761e4f6
--- /dev/null
+++ b/kernel/cbytegen.mli
@@ -0,0 +1,17 @@
+open Names
+open Cbytecodes
+open Cemitcodes 
+open Term
+open Declarations
+open Pre_env
+
+
+
+val compile : env -> constr -> bytecodes * bytecodes * fv
+                              (* init, fun, fv *)
+
+val compile_constant_body : 
+    env -> constr_substituted option -> bool -> bool -> body_code
+                                 (* opaque *) (* boxed *)
+
+
diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml
new file mode 100644
index 00000000..cccb1844
--- /dev/null
+++ b/kernel/cemitcodes.ml
@@ -0,0 +1,303 @@
+open Names
+open Term
+open Cbytecodes
+open Copcodes
+open Mod_subst
+
+(* Relocation information *)
+type reloc_info =
+  | Reloc_annot of annot_switch 
+  | Reloc_const of structured_constant
+  | Reloc_getglobal of constant
+
+type patch = reloc_info * int 
+
+let patch_int buff pos n =
+  String.unsafe_set buff pos (Char.unsafe_chr n);
+  String.unsafe_set buff (pos + 1) (Char.unsafe_chr (n asr 8));
+  String.unsafe_set buff (pos + 2) (Char.unsafe_chr (n asr 16));
+  String.unsafe_set buff (pos + 3) (Char.unsafe_chr (n asr 24))
+
+
+(* Buffering of bytecode *)
+
+let out_buffer = ref(String.create 1024)
+and out_position = ref 0
+
+let out_word b1 b2 b3 b4 =
+  let p = !out_position in
+  if p >= String.length !out_buffer then begin
+    let len = String.length !out_buffer in
+    let new_buffer = String.create (2 * len) in
+    String.blit !out_buffer 0 new_buffer 0 len;
+    out_buffer := new_buffer
+  end;
+  String.unsafe_set !out_buffer p (Char.unsafe_chr b1);
+  String.unsafe_set !out_buffer (p+1) (Char.unsafe_chr b2);
+  String.unsafe_set !out_buffer (p+2) (Char.unsafe_chr b3);
+  String.unsafe_set !out_buffer (p+3) (Char.unsafe_chr b4);
+  out_position := p + 4
+
+let out opcode =
+  out_word opcode 0 0 0
+
+let out_int n =
+  out_word n (n asr 8) (n asr 16) (n asr 24)
+
+(* Handling of local labels and backpatching *)
+
+type label_definition =
+    Label_defined of int
+  | Label_undefined of (int * int) list
+
+let label_table  = ref ([| |] : label_definition array)
+(* le ieme element de la table = Label_defined n signifie que l'on a 
+   deja rencontrer le label i et qu'il est a l'offset n.
+                               = Label_undefined l signifie que l'on a 
+   pas encore rencontrer ce label, le premier entier indique ou est l'entier 
+   a patcher dans la string, le deuxieme son origine  *)
+
+let extend_label_table needed =
+  let new_size = ref(Array.length !label_table) in
+  while needed >= !new_size do new_size := 2 * !new_size done;
+  let new_table = Array.create !new_size (Label_undefined []) in
+  Array.blit !label_table 0 new_table 0 (Array.length !label_table);
+  label_table := new_table
+
+let backpatch (pos, orig) =
+  let displ = (!out_position - orig) asr 2 in
+  !out_buffer.[pos] <- Char.unsafe_chr displ;
+  !out_buffer.[pos+1] <- Char.unsafe_chr (displ asr 8);
+  !out_buffer.[pos+2] <- Char.unsafe_chr (displ asr 16);
+  !out_buffer.[pos+3] <- Char.unsafe_chr (displ asr 24)
+
+let define_label lbl =
+  if lbl >= Array.length !label_table then extend_label_table lbl;
+  match (!label_table).(lbl) with
+    Label_defined _ ->
+      raise(Failure "CEmitcode.define_label")
+  | Label_undefined patchlist ->
+      List.iter backpatch patchlist;
+      (!label_table).(lbl) <- Label_defined !out_position
+
+let out_label_with_orig orig lbl =
+  if lbl >= Array.length !label_table then extend_label_table lbl;
+  match (!label_table).(lbl) with
+    Label_defined def ->
+      out_int((def - orig) asr 2)
+  | Label_undefined patchlist ->
+      if patchlist = [] then
+	(!label_table).(lbl) <-
+          Label_undefined((!out_position, orig) :: patchlist);
+      out_int 0
+
+let out_label l = out_label_with_orig !out_position l
+
+(* Relocation information *)
+
+let reloc_info = ref ([] : (reloc_info * int) list)
+
+let enter info =
+  reloc_info := (info, !out_position) :: !reloc_info
+
+let slot_for_const c =
+  enter (Reloc_const c);
+  out_int 0
+
+and slot_for_annot a =
+  enter (Reloc_annot a);
+  out_int 0
+
+and slot_for_getglobal id =
+  enter (Reloc_getglobal id);
+  out_int 0
+
+
+(* Emission of one instruction *)
+
+
+let emit_instr = function
+  | Klabel lbl -> define_label lbl
+  | Kacc n ->
+      if n < 8 then out(opACC0 + n) else (out opACC; out_int n)
+  | Kenvacc n ->
+      if n >= 1 && n <= 4
+      then out(opENVACC1 + n - 1)
+      else (out opENVACC; out_int n)
+  | Koffsetclosure ofs ->
+      if ofs = -2 || ofs = 0 || ofs = 2
+      then out (opOFFSETCLOSURE0 + ofs / 2)
+      else (out opOFFSETCLOSURE; out_int ofs)
+  | Kpush ->      
+      out opPUSH
+  | Kpop n ->      
+      out opPOP; out_int n
+  | Kpush_retaddr lbl -> 
+      out opPUSH_RETADDR; out_label lbl
+  | Kapply n ->
+      if n < 4 then out(opAPPLY1 + n - 1) else (out opAPPLY; out_int n)
+  | Kappterm(n, sz) ->
+      if n < 4 then (out(opAPPTERM1 + n - 1); out_int sz)
+               else (out opAPPTERM; out_int n; out_int sz)
+  | Kreturn n ->
+      out opRETURN; out_int n
+  | Kjump ->
+      out opRETURN; out_int 0
+  | Krestart ->
+      out opRESTART
+  | Kgrab n -> 
+      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) ->
+      out opCLOSUREREC;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)) -> 
+      if i >= 0 && i <= 3
+          then out (opCONST0 + i)
+          else (out opCONSTINT; out_int i) 
+  | Kconst c ->
+      out opGETGLOBAL; slot_for_const c
+  | Kmakeblock(n, t) ->
+      if n = 0 then raise (Invalid_argument "emit_instr : block size = 0")
+      else if n < 4 then (out(opMAKEBLOCK1 + n - 1); out_int t)
+      else (out opMAKEBLOCK; out_int n; out_int t)
+  | Kmakeprod ->
+      out opMAKEPROD
+  | Kmakeswitchblock(typlbl,swlbl,annot,sz) ->
+      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
+  | Kstop -> 
+      out opSTOP
+  | Ksequence _ -> raise (Invalid_argument "Cemitcodes.emit_instr")
+
+(* Emission of a list of instructions. Include some peephole optimization. *)
+
+let rec emit = function
+  | [] -> ()
+  (* Peephole optimizations *)
+  | Kpush :: Kacc n :: c ->
+      if n < 8 then out(opPUSHACC0 + n) else (out opPUSHACC; out_int n);
+      emit c
+  | Kpush :: Kenvacc n :: c -> 
+      if n >= 1 && n <= 4
+      then out(opPUSHENVACC1 + n - 1)
+      else (out opPUSHENVACC; out_int n);
+      emit c
+  | Kpush :: Koffsetclosure ofs :: c -> 
+      if ofs = -2 || ofs = 0 || ofs = 2
+      then out(opPUSHOFFSETCLOSURE0 + ofs / 2)
+      else (out opPUSHOFFSETCLOSURE; out_int ofs);
+      emit c
+  | Kpush :: Kgetglobal id :: c ->
+      out opPUSHGETGLOBAL; slot_for_getglobal id; emit c 
+  | Kpush :: Kconst (Const_b0 i) :: c -> 
+      if i >= 0 && i <= 3
+      then out (opPUSHCONST0 + i)
+      else (out opPUSHCONSTINT; out_int i);
+      emit c
+  | Kpush :: Kconst const :: c ->
+      out opPUSHGETGLOBAL; slot_for_const const;
+      emit c 
+  | Kpop n :: Kjump :: c ->
+      out opRETURN; out_int n; emit c
+  | Ksequence(c1,c2)::c ->
+      emit c1; emit c2;emit c
+  (* Default case *)
+  | instr :: c ->
+      emit_instr instr; emit c
+
+(* Initialization *)
+
+let init () =
+  out_position := 0;
+  label_table := Array.create 16 (Label_undefined []);
+  reloc_info := []
+
+type emitcodes = string
+
+let length = String.length
+
+type to_patch = emitcodes * (patch list) * fv
+
+(* Substitution *)
+let rec subst_strcst s sc =
+  match sc with
+  | Const_sorts _ | Const_b0 _ -> sc
+  | Const_bn(tag,args) -> Const_bn(tag,Array.map (subst_strcst s) args)
+  | Const_ind(ind) -> let kn,i = ind in Const_ind((subst_kn s kn, i))
+
+let subst_patch s (ri,pos) = 
+  match ri with
+  | Reloc_annot a ->
+      let (kn,i) = a.ci.ci_ind in
+      let ci = {a.ci with ci_ind = (subst_kn s kn,i)} in
+      (Reloc_annot {a with ci = ci},pos)
+  | Reloc_const sc -> (Reloc_const (subst_strcst s sc), pos)
+  | Reloc_getglobal kn -> (Reloc_getglobal (fst (subst_con s kn)), pos)
+
+let subst_to_patch s (code,pl,fv) = 
+  code,List.rev_map (subst_patch s) pl,fv
+
+type body_code =
+  | BCdefined of bool * to_patch
+  | BCallias of constant
+  | BCconstant
+
+let subst_body_code s = function
+  | BCdefined (b,tp) -> BCdefined (b,subst_to_patch s tp)
+  | BCallias kn -> BCallias (fst (subst_con s kn))
+  | BCconstant -> BCconstant
+
+type to_patch_substituted = body_code substituted
+
+let from_val = from_val
+
+let force = force subst_body_code
+
+let subst_to_patch_subst = subst_substituted 
+
+let is_boxed tps =
+  match force tps with
+  | BCdefined(b,_) -> b
+  | _ -> false
+
+let to_memory (init_code, fun_code, fv) =
+  init();
+  emit init_code;
+  emit fun_code;
+  let code = String.create !out_position in
+  String.unsafe_blit !out_buffer 0 code 0 !out_position;
+  let reloc = List.rev !reloc_info in
+  Array.iter (fun lbl -> 
+    (match lbl with
+      Label_defined _ -> assert true
+    | Label_undefined patchlist -> 
+	assert (patchlist = []))) !label_table;
+  (code, reloc, fv)
+
+
+
+
+
diff --git a/kernel/cemitcodes.mli b/kernel/cemitcodes.mli
new file mode 100644
index 00000000..ca6da65e
--- /dev/null
+++ b/kernel/cemitcodes.mli
@@ -0,0 +1,40 @@
+open Names
+open Cbytecodes
+
+type reloc_info =
+  | Reloc_annot of annot_switch 
+  | Reloc_const of structured_constant
+  | Reloc_getglobal of constant
+
+type patch = reloc_info * int 
+(* A virer *)
+val subst_patch : Mod_subst.substitution -> patch -> patch
+ 
+type emitcodes 
+
+val length : emitcodes -> int 
+
+val patch_int : emitcodes -> (*pos*)int -> int -> unit
+
+type to_patch = emitcodes * (patch list) * fv
+
+val subst_to_patch : Mod_subst.substitution -> to_patch -> to_patch
+
+type body_code =
+  | BCdefined of bool*to_patch
+  | BCallias of constant
+  | BCconstant
+
+
+type to_patch_substituted 
+
+val from_val : body_code -> to_patch_substituted 
+
+val force : to_patch_substituted -> body_code
+
+val is_boxed : to_patch_substituted -> bool
+
+val subst_to_patch_subst : Mod_subst.substitution -> to_patch_substituted -> to_patch_substituted
+
+val to_memory : bytecodes * bytecodes * fv -> to_patch
+               (* init code, fun code, fv *) 
diff --git a/kernel/closure.ml b/kernel/closure.ml
index 1a635ccf..8e16a922 100644
--- a/kernel/closure.ml
+++ b/kernel/closure.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: closure.ml,v 1.54.2.1 2004/07/16 19:30:23 herbelin Exp $ *)
+(* $Id: closure.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 open Util
 open Pp
@@ -16,7 +16,6 @@ open Declarations
 open Environ
 open Esubst
 
-
 let stats = ref false
 let share = ref true
 
@@ -52,10 +51,8 @@ let with_stats c =
   end else
     Lazy.force c
 
-type transparent_state = Idpred.t * KNpred.t
-
-let all_opaque = (Idpred.empty, KNpred.empty)
-let all_transparent = (Idpred.full, KNpred.full)
+let all_opaque = (Idpred.empty, Cpred.empty)
+let all_transparent = (Idpred.full, Cpred.full)
 
 module type RedFlagsSig = sig
   type reds
@@ -110,7 +107,7 @@ module RedFlags = (struct
     | DELTA -> { red with r_delta = true; r_const = all_transparent }
     | CONST kn ->
 	let (l1,l2) = red.r_const in
-	{ red with r_const = l1, KNpred.add kn l2 }
+	{ red with r_const = l1, Cpred.add kn l2 }
     | IOTA -> { red with r_iota = true }
     | ZETA -> { red with r_zeta = true }
     | VAR id ->
@@ -122,7 +119,7 @@ module RedFlags = (struct
     | DELTA -> { red with r_delta = false }
     | CONST kn ->
  	let (l1,l2) = red.r_const in
-	{ red with r_const = l1, KNpred.remove kn l2 }
+	{ red with r_const = l1, Cpred.remove kn l2 }
     | IOTA -> { red with r_iota = false }
     | ZETA -> { red with r_zeta = false }
     | VAR id ->
@@ -138,7 +135,7 @@ module RedFlags = (struct
     | BETA -> incr_cnt red.r_beta beta
     | CONST kn -> 
 	let (_,l) = red.r_const in
-	let c = KNpred.mem kn l in
+	let c = Cpred.mem kn l in
 	incr_cnt c delta
     | VAR id -> (* En attendant d'avoir des kn pour les Var *)
 	let (l,_) = red.r_const in
@@ -152,7 +149,7 @@ module RedFlags = (struct
   let red_get_const red =
     let p1,p2 = red.r_const in
     let (b1,l1) = Idpred.elements p1 in
-    let (b2,l2) = KNpred.elements p2 in
+    let (b2,l2) = Cpred.elements p2 in
     if b1=b2 then
       let l1' = List.map (fun x -> EvalVarRef x) l1 in
       let l2' = List.map (fun x -> EvalConstRef x) l2 in
@@ -326,11 +323,7 @@ fin obsolète **************)
  * instantiations (cbv or lazy) are.
  *)
 
-type table_key =
-  | ConstKey of constant
-  | VarKey of identifier
-  | FarRelKey of int
-   (* FarRel: index in the rel_context part of _initial_ environment *)
+type table_key = id_key
 
 type 'a infos = {
   i_flags : reds;
@@ -349,7 +342,7 @@ let ref_value_cache info ref =
   try
     let body =
       match ref with
-	| FarRelKey n ->
+	| RelKey n ->
 	    let (s,l) = info.i_rels in lift n (List.assoc (s-n) l)
 	| VarKey id -> List.assoc id info.i_vars
 	| ConstKey cst -> constant_value info.i_env cst
@@ -364,22 +357,22 @@ let ref_value_cache info ref =
 
 let defined_vars flags env =
 (*  if red_local_const (snd flags) then*)
-    fold_named_context 
-      (fun env (id,b,t) e ->
+    Sign.fold_named_context 
+      (fun (id,b,_) e ->
 	 match b with
 	   | None -> e
 	   | Some body -> (id, body)::e)
-      env ~init:[]
+       (named_context env) ~init:[]
 (*  else []*)
 
 let defined_rels flags env =
 (*  if red_local_const (snd flags) then*)
-  fold_rel_context 
-      (fun env (id,b,t) (i,subs) ->
+  Sign.fold_rel_context 
+      (fun (id,b,t) (i,subs) ->
 	 match b with
 	   | None -> (i+1, subs)
 	   | Some body -> (i+1, (i,body) :: subs))
-      env ~init:(0,[])
+      (rel_context env) ~init:(0,[])
 (*  else (0,[])*)
 
 
@@ -519,7 +512,7 @@ type fconstr = {
 and fterm =
   | FRel of int
   | FAtom of constr (* Metas and Sorts *)
-  | FCast of fconstr * fconstr
+  | FCast of fconstr * cast_kind * fconstr
   | FFlex of table_key
   | FInd of inductive
   | FConstruct of constructor
@@ -539,6 +532,8 @@ let fterm_of v = v.term
 let set_norm v = v.norm <- Norm
 let is_val v = v.norm = Norm
 
+let mk_atom c = {norm=Norm;term=FAtom c}
+
 (* Could issue a warning if no is still Red, pointing out that we loose
    sharing. *)
 let update v1 (no,t) =
@@ -553,7 +548,7 @@ let update v1 (no,t) =
    when the lift is 0. *)
 let rec lft_fconstr n ft =
   match ft.term with
-    | (FInd _|FConstruct _|FFlex(ConstKey _|VarKey _)|FAtom _) -> ft
+    | (FInd _|FConstruct _|FFlex(ConstKey _|VarKey _)) -> ft
     | FRel i -> {norm=Norm;term=FRel(i+n)}
     | FLambda(k,tys,f,e) -> {norm=Cstr; term=FLambda(k,tys,f,subs_shft(n,e))}
     | FFix(fx,e) -> {norm=Cstr; term=FFix(fx,subs_shft(n,e))}
@@ -573,7 +568,7 @@ let clos_rel e i =
     | Inl(n,mt) -> lift_fconstr n mt
     | Inr(k,None) -> {norm=Norm; term= FRel k}
     | Inr(k,Some p) ->
-        lift_fconstr (k-p) {norm=Norm;term=FFlex(FarRelKey p)}
+        lift_fconstr (k-p) {norm=Norm;term=FFlex(RelKey p)}
 
 (* since the head may be reducible, we might introduce lifts of 0 *)
 let compact_stack head stk =
@@ -608,10 +603,10 @@ let rec compact_constr (lg, subs as s) c k =
     | Evar(ev,v) ->
         let (v',s) = compact_vect s v k in
         if v==v' then c,s else mkEvar(ev,v'),s
-    | Cast(a,b) ->
+    | Cast(a,ck,b) ->
         let (a',s) = compact_constr s a k in
         let (b',s) = compact_constr s b k in
-        if a==a' && b==b' then c,s else mkCast(a',b'), s
+        if a==a' && b==b' then c,s else mkCast(a', ck, b'), s
     | App(f,v) ->
         let (f',s) = compact_constr s f k in
         let (v',s) = compact_vect s v k in
@@ -664,7 +659,7 @@ let optimise_closure env c =
     (env',c')
 
 let mk_lambda env t =
-(*  let (env,t) = optimise_closure env t in*)
+  let (env,t) = optimise_closure env t in
   let (rvars,t') = decompose_lam t in
   FLambda(List.length rvars, List.rev rvars, t', env)
 
@@ -698,9 +693,9 @@ let mk_clos_deep clos_fun env t =
   match kind_of_term t with
     | (Rel _|Ind _|Const _|Construct _|Var _|Meta _ | Sort _) ->
         mk_clos env t
-    | Cast (a,b) ->
+    | Cast (a,k,b) ->
         { norm = Red;
-          term = FCast (clos_fun env a, clos_fun env b)}
+          term = FCast (clos_fun env a, k, clos_fun env b)}
     | App (f,v) ->
         { norm = Red;
 	  term = FApp (clos_fun env f, Array.map (clos_fun env) v) }
@@ -730,15 +725,11 @@ let mk_clos2 = mk_clos_deep mk_clos
 let rec to_constr constr_fun lfts v =
   match v.term with
     | FRel i -> mkRel (reloc_rel i lfts)
-    | FFlex (FarRelKey p) -> mkRel (reloc_rel p lfts)
+    | FFlex (RelKey p) -> mkRel (reloc_rel p lfts)
     | FFlex (VarKey x) -> mkVar x
-    | FAtom c ->
-        (match kind_of_term c with
-          | Sort s -> mkSort s
-          | Meta m -> mkMeta m
-          | _ -> assert false)
-    | FCast (a,b) ->
-        mkCast (constr_fun lfts a, constr_fun lfts b)
+    | FAtom c -> exliftn lfts c
+    | FCast (a,k,b) ->
+        mkCast (constr_fun lfts a, k, constr_fun lfts b)
     | FFlex (ConstKey op) -> mkConst op
     | FInd op -> mkInd op
     | FConstruct op -> mkConstruct op
@@ -808,23 +799,23 @@ let rec fstrong unfreeze_fun lfts v =
   to_constr (fstrong unfreeze_fun) lfts (unfreeze_fun v)
 *)
 
-let rec zip zfun m stk =
+let rec zip m stk =
   match stk with
     | [] -> m
     | Zapp args :: s ->
         let args = Array.of_list args in
-        zip zfun {norm=neutr m.norm; term=FApp(m, Array.map zfun args)} s
+        zip {norm=neutr m.norm; term=FApp(m, args)} s
     | Zcase(ci,p,br)::s ->
-        let t = FCases(ci, zfun p, m, Array.map zfun br) in
-        zip zfun {norm=neutr m.norm; term=t} s
+        let t = FCases(ci, p, m, br) in
+        zip {norm=neutr m.norm; term=t} s
     | Zfix(fx,par)::s ->
-        zip zfun fx (par @ append_stack_list ([m], s))
+        zip fx (par @ append_stack_list ([m], s))
     | Zshift(n)::s ->
-        zip zfun (lift_fconstr n m) s
+        zip (lift_fconstr n m) s
     | Zupdate(rf)::s ->
-        zip zfun (update rf (m.norm,m.term)) s
+        zip (update rf (m.norm,m.term)) s
 
-let fapp_stack (m,stk) = zip (fun x -> x) m stk
+let fapp_stack (m,stk) = zip m stk
 
 (*********************************************************************)
 
@@ -849,7 +840,7 @@ let strip_update_shift_app head stk =
   let rec strip_rec rstk h depth = function
     | Zshift(k) as e :: s ->
         strip_rec (e::rstk) (lift_fconstr k h) (depth+k) s
-    | (Zapp args :: s) as stk ->
+    | (Zapp args :: s) ->
         strip_rec (Zapp args :: rstk)
           {norm=h.norm;term=FApp(h,Array.of_list args)} depth s
     | Zupdate(m)::s ->
@@ -892,7 +883,7 @@ let get_arg h stk =
 let rec get_args n tys f e stk =
   match stk with
       Zupdate r :: s ->
-        let hd = update r (Cstr,FLambda(n,tys,f,e)) in
+        let _hd = update r (Cstr,FLambda(n,tys,f,e)) in
         get_args n tys f e s
     | Zshift k :: s ->
         get_args n tys f (subs_shft (k,e)) s
@@ -985,7 +976,7 @@ let rec knh m stk =
         (match get_nth_arg m ri.(n) stk with
              (Some(pars,arg),stk') -> knh arg (Zfix(m,pars)::stk')
            | (None, stk') -> (m,stk'))
-    | FCast(t,_) -> knh t stk
+    | FCast(t,_,_) -> knh t stk
 (* cases where knh stops *)
     | (FFlex _|FLetIn _|FConstruct _|FEvar _|
        FCoFix _|FLambda _|FRel _|FAtom _|FInd _|FProd _) ->
@@ -999,7 +990,7 @@ and knht e t stk =
     | Case(ci,p,t,br) ->
         knht e t (Zcase(ci, mk_clos e p, mk_clos_vect e br)::stk)
     | Fix _ -> knh (mk_clos2 e t) stk
-    | Cast(a,b) -> knht e a stk
+    | Cast(a,_,_) -> knht e a stk
     | Rel n -> knh (clos_rel e n) stk
     | (Lambda _|Prod _|Construct _|CoFix _|Ind _|
        LetIn _|Const _|Var _|Evar _|Meta _|Sort _) ->
@@ -1023,8 +1014,8 @@ let rec knr info m stk =
       (match ref_value_cache info (VarKey id) with
           Some v -> kni info v stk
         | None -> (set_norm m; (m,stk)))
-  | FFlex(FarRelKey k) when red_set info.i_flags fDELTA ->
-      (match ref_value_cache info (FarRelKey k) with
+  | FFlex(RelKey k) when red_set info.i_flags fDELTA ->
+      (match ref_value_cache info (RelKey k) with
           Some v -> kni info v stk
         | None -> (set_norm m; (m,stk)))
   | FConstruct(ind,c) when red_set info.i_flags fIOTA ->
diff --git a/kernel/closure.mli b/kernel/closure.mli
index e58b91eb..706a089e 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,v 1.42.2.1 2004/07/16 19:30:24 herbelin Exp $ i*)
+(*i $Id: closure.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Pp
@@ -27,7 +27,7 @@ val with_stats: 'a Lazy.t -> 'a
   Rem: reduction of a Rel/Var bound to a term is Delta, but reduction of 
   a LetIn expression is Letin reduction *)
 
-type transparent_state = Idpred.t * KNpred.t
+
 
 val all_opaque      : transparent_state
 val all_transparent : transparent_state
@@ -82,13 +82,8 @@ val betadeltaiotanolet : reds
 
 val unfold_red : evaluable_global_reference -> reds
 
-(************************************************************************)
-
-type table_key =
-  | ConstKey of constant
-  | VarKey of identifier
-  | FarRelKey of int
-   (* FarRel: index in the [rel_context] part of {\em initial} environment *)
+(***********************************************************************)
+type table_key = id_key
 
 type 'a infos
 val ref_value_cache: 'a infos -> table_key -> 'a option
@@ -120,6 +115,7 @@ val stack_args_size : 'a stack -> int
 val app_stack : constr * constr stack -> constr
 val stack_tail : int -> 'a stack -> 'a stack
 val stack_nth : 'a stack -> int -> 'a
+val zip_term : ('a -> constr) -> constr -> 'a stack -> constr
 
 (************************************************************************)
 (*s Lazy reduction. *)
@@ -134,7 +130,7 @@ type fconstr
 type fterm =
   | FRel of int
   | FAtom of constr (* Metas and Sorts *)
-  | FCast of fconstr * fconstr
+  | FCast of fconstr * cast_kind * fconstr 
   | FFlex of table_key
   | FInd of inductive
   | FConstruct of constructor
@@ -159,6 +155,8 @@ val fterm_of : fconstr -> fterm
 val term_of_fconstr : fconstr -> constr
 val destFLambda :
   (fconstr subs -> constr -> fconstr) -> fconstr -> name * fconstr * fconstr
+(* mk_atom: prevents a term from being evaluated *)
+val mk_atom : constr -> fconstr
 
 (* Global and local constant cache *)
 type clos_infos
diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml
index dba373ce..4c692308 100644
--- a/kernel/conv_oracle.ml
+++ b/kernel/conv_oracle.ml
@@ -6,18 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: conv_oracle.ml,v 1.2.8.2 2004/07/16 19:30:24 herbelin Exp $ *)
+(* $Id: conv_oracle.ml 6303 2004-11-16 12:37:40Z sacerdot $ *)
 
 open Names
-open Closure
 
 (* Opaque constants *)
-let cst_transp = ref KNpred.full
+let cst_transp = ref Cpred.full
 
-let set_opaque_const kn = cst_transp := KNpred.remove kn !cst_transp
-let set_transparent_const kn = cst_transp := KNpred.add kn !cst_transp
+let set_opaque_const kn = cst_transp := Cpred.remove kn !cst_transp
+let set_transparent_const kn = cst_transp := Cpred.add kn !cst_transp
 
-let is_opaque_cst kn = not (KNpred.mem kn !cst_transp)
+let is_opaque_cst kn = not (Cpred.mem kn !cst_transp)
 
 (* Opaque variables *)
 let var_transp = ref Idpred.full
@@ -31,13 +30,13 @@ let is_opaque_var kn = not (Idpred.mem kn !var_transp)
 let is_opaque = function
   | ConstKey cst -> is_opaque_cst cst
   | VarKey id -> is_opaque_var id
-  | FarRelKey _ -> false
+  | RelKey _ -> false
 
 (* Unfold the first only if it is not opaque and the second is opaque *)
 let oracle_order k1 k2 = is_opaque k2 & not (is_opaque k1)
 
 (* summary operations *)
-
-let init() = (cst_transp := KNpred.full; var_transp := Idpred.full)
+type transparent_state = Idpred.t * Cpred.t
+let init() = (cst_transp := Cpred.full; var_transp := Idpred.full)
 let freeze () = (!var_transp, !cst_transp)
 let unfreeze (vo,co) = (cst_transp := co; var_transp := vo)
diff --git a/kernel/conv_oracle.mli b/kernel/conv_oracle.mli
index 8d0c12bb..966edd1d 100644
--- a/kernel/conv_oracle.mli
+++ b/kernel/conv_oracle.mli
@@ -6,16 +6,16 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: conv_oracle.mli,v 1.3.8.3 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: conv_oracle.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 open Names
-open Closure
+
 
 (* Order on section paths for unfolding.
    If [oracle_order kn1 kn2] is true, then unfold kn1 first.
    Note: the oracle does not introduce incompleteness, it only
    tries to postpone unfolding of "opaque" constants. *)
-val oracle_order : table_key -> table_key -> bool
+val oracle_order : 'a tableKey -> 'a tableKey -> bool
 
 (* Changing the oracle *)
 val set_opaque_const      : constant -> unit
diff --git a/kernel/cooking.ml b/kernel/cooking.ml
index d69efe3a..a6aa2a8e 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,v 1.17.8.1 2004/07/16 19:30:24 herbelin Exp $ i*)
+(*i $Id: cooking.ml 6748 2005-02-18 22:17:50Z herbelin $ i*)
 
 open Pp
 open Util
@@ -19,154 +19,110 @@ open Reduction
 
 (*s Cooking the constants. *)
 
-type 'a modification =
-  | NOT_OCCUR
-  | DO_ABSTRACT of 'a * constr array
-  | DO_REPLACE of constant_body
+type work_list = identifier array Cmap.t * identifier array KNmap.t
 
-type work_list =
-    (constant * constant modification) list
-    * (inductive * inductive modification) list
-    * (constructor * constructor modification) list
+let dirpath_prefix p = match repr_dirpath p with
+  | [] -> anomaly "dirpath_prefix: empty dirpath"
+  | _::l -> make_dirpath l
 
-type recipe = {
-  d_from : constant_body;
-  d_abstract : identifier list;
-  d_modlist : work_list }
+let pop_kn kn =
+  let (mp,dir,l) = Names.repr_kn kn in
+  Names.make_kn mp (dirpath_prefix dir) l
+
+let pop_con con = 
+  let (mp,dir,l) = Names.repr_con con in
+  Names.make_con mp (dirpath_prefix dir) l
+
+type my_global_reference =
+  | ConstRef of constant
+  | IndRef of inductive
+  | ConstructRef of constructor
+
+let cache = (Hashtbl.create 13 : (my_global_reference, constr) Hashtbl.t)
+
+let clear_cooking_sharing () = Hashtbl.clear cache
+
+let share r (cstl,knl) =
+  try Hashtbl.find cache r
+  with Not_found ->
+  let f,l =
+    match r with
+    | IndRef (kn,i) -> 
+	mkInd (pop_kn kn,i), KNmap.find kn knl
+    | ConstructRef ((kn,i),j) -> 
+	mkConstruct ((pop_kn kn,i),j), KNmap.find kn knl
+    | ConstRef cst ->
+	mkConst (pop_con cst), Cmap.find cst cstl in
+  let c = mkApp (f, Array.map mkVar l) in
+  Hashtbl.add cache r c;
+  (* has raised Not_found if not in work_list *)
+  c
 
-let failure () =
-  anomalylabstrm "generic__modify_opers"
-    (str"An oper which was never supposed to appear has just appeared" ++
-     spc () ++ str"Either this is in system code, and you need to" ++ spc () ++
-     str"report this error," ++ spc () ++
-     str"Or you are using a user-written tactic which calls" ++ spc () ++
-     str"generic__modify_opers, in which case the user-written code" ++
-     spc () ++ str"is broken - this function is an internal system" ++
-     spc () ++ str"for internal system use only")
-
-let modify_opers replfun (constl,indl,cstrl) =
+let update_case_info ci modlist =
+  try
+    let ind, n = 
+      match kind_of_term (share (IndRef ci.ci_ind) modlist) with
+      | App (f,l) -> (destInd f, Array.length l)
+      | Ind ind -> ind, 0
+      | _ -> assert false in
+    { ci with ci_ind = ind; ci_npar = ci.ci_npar + n }
+  with Not_found ->
+    ci
+
+let empty_modlist = (Cmap.empty, KNmap.empty)
+
+let expmod_constr modlist c =
   let rec substrec c =
-    let c' = map_constr substrec c in
-    match kind_of_term c' with
+    match kind_of_term c with
       | Case (ci,p,t,br) ->
+	  map_constr substrec (mkCase (update_case_info ci modlist,p,t,br))
+
+      | Ind ind ->
 	  (try
-	     match List.assoc ci.ci_ind indl with
-	       | DO_ABSTRACT (ind,abs_vars) ->
-		   let n' = Array.length abs_vars + ci.ci_npar in
-                   let ci' = { ci with
-                               ci_ind = ind;
-                               ci_npar = n' } in
-		   mkCase (ci',p,t,br)
-	       | _ -> raise Not_found
-	   with
-	     | Not_found -> c')
-
-      | Ind spi ->
-	  (try
-	     (match List.assoc spi indl with
-		| NOT_OCCUR -> failure ()
-		| DO_ABSTRACT (oper',abs_vars) ->
-                    mkApp (mkInd oper', abs_vars)
-		| DO_REPLACE _ -> assert false)
+	    share (IndRef ind) modlist
 	   with 
-	     | Not_found -> c')
-
-      | Construct spi ->
+	    | Not_found -> map_constr substrec c)
+	  
+      | Construct cstr ->
 	  (try
-	     (match List.assoc spi cstrl with
-		| NOT_OCCUR -> failure ()
-		| DO_ABSTRACT (oper',abs_vars) ->
-		    mkApp (mkConstruct oper', abs_vars)
-		| DO_REPLACE _ -> assert false)
+	    share (ConstructRef cstr) modlist
 	   with 
-	     | Not_found -> c')
-
-      | Const kn ->
+	    | Not_found -> map_constr substrec c)
+	  
+      | Const cst ->
 	  (try
-	     (match List.assoc kn constl with
-		| NOT_OCCUR -> failure ()
-		| DO_ABSTRACT (oper',abs_vars) ->
-		    mkApp (mkConst oper', abs_vars)
-		| DO_REPLACE cb -> substrec (replfun (kn,cb)))
+	    share (ConstRef cst) modlist
 	   with 
-	     | Not_found -> c')
-  
-    | _ -> c'
-  in 
-  if (constl,indl,cstrl) = ([],[],[]) then fun x -> x else substrec
+	    | Not_found -> map_constr substrec c)
+
+  | _ -> map_constr substrec c
 
-let expmod_constr modlist c =
-  let simpfun = 
-    if modlist = ([],[],[]) then fun x -> x else nf_betaiota in
-  let expfun (kn,cb) = 
-    if cb.const_opaque then
-      errorlabstrm "expmod_constr"
-	(str"Cannot unfold the value of " ++
-        str(string_of_kn kn) ++ spc () ++
-        str"You cannot declare local lemmas as being opaque" ++ spc () ++
-        str"and then require that theorems which use them" ++ spc () ++
-        str"be transparent");
-    match cb.const_body with
-      | Some body -> Declarations.force body
-      | None -> assert false
-  in
-  let c' = modify_opers expfun modlist c in
-  match kind_of_term c' with
-    | Cast (value,typ) -> mkCast (simpfun value,simpfun typ)
-    | _ -> simpfun c'
-
-let expmod_type modlist c =
-  type_app (expmod_constr modlist) c
-
-let abstract_constant ids_to_abs hyps (body,typ) =
-  let abstract_once_typ ((hyps,typ) as sofar) id =
-    match hyps with
-      | (hyp,c,t as decl)::rest when hyp = id ->
-	  let typ' = mkNamedProd_wo_LetIn decl typ in
-	  (rest, typ')
-      | _ -> 
-	  sofar
-  in
-  let abstract_once_body ((hyps,body) as sofar) id =
-    match hyps with
-      | (hyp,c,t as decl)::rest when hyp = id ->
-	  let body' = mkNamedLambda_or_LetIn decl body in
-	  (rest, body')
-      | _ -> 
-	  sofar
-  in
-  let (_,typ') =
-    List.fold_left abstract_once_typ (hyps,typ) ids_to_abs 
-  in
-  let body' = match body with
-      None -> None
-    | Some l_body -> 
-	Some (Declarations.from_val
-		(let body = Declarations.force l_body in
-		 let (_,body') = 
-		   List.fold_left abstract_once_body (hyps,body) ids_to_abs
-		 in
-		   body'))
   in
-    (body',typ')
+  if modlist = empty_modlist then c
+  else under_outer_cast nf_betaiota (substrec c)
+
+let abstract_constant_type =
+   List.fold_left (fun c d -> mkNamedProd_wo_LetIn d c)
+
+let abstract_constant_body =
+  List.fold_left (fun c d -> mkNamedLambda_or_LetIn d c)
+
+type recipe = {
+  d_from : constant_body;
+  d_abstract : named_context;
+  d_modlist : work_list }
+
+let on_body f = 
+  option_app (fun c -> Declarations.from_val (f (Declarations.force c)))
 
 let cook_constant env r =
   let cb = r.d_from in
-  let typ = expmod_type r.d_modlist cb.const_type in
-  let body = 
-    option_app 
-      (fun lconstr -> 
-	 Declarations.from_val 
-	   (expmod_constr r.d_modlist (Declarations.force lconstr))) 
-      cb.const_body
-  in
-  let hyps =
-    Sign.fold_named_context
-      (fun d ctxt ->
-        Sign.add_named_decl
-          (map_named_declaration (expmod_constr r.d_modlist) d)
-          ctxt)
-      cb.const_hyps
-      ~init:empty_named_context in
-  let body,typ = abstract_constant r.d_abstract hyps (body,typ) in
-  (body, typ, cb.const_constraints, cb.const_opaque)
+  let hyps = Sign.map_named_context (expmod_constr r.d_modlist) r.d_abstract in
+  let body =
+    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 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 54526e99..7b51ac0c 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,v 1.9.8.1 2004/07/16 19:30:24 herbelin Exp $ i*)
+(*i $Id: cooking.mli 6748 2005-02-18 22:17:50Z herbelin $ i*)
 
 open Names
 open Term
@@ -16,27 +16,22 @@ open Univ
 
 (*s Cooking the constants. *)
 
-type 'a modification =
-  | NOT_OCCUR
-  | DO_ABSTRACT of 'a * constr array
-  | DO_REPLACE of constant_body
-
-type work_list =
-    (constant * constant modification) list
-    * (inductive * inductive modification) list
-    * (constructor * constructor modification) list
+type work_list = identifier array Cmap.t * identifier array KNmap.t
 
 type recipe = {
   d_from : constant_body;
-  d_abstract : identifier list;
+  d_abstract : Sign.named_context;
   d_modlist : work_list }
 
 val cook_constant :
-  env -> recipe -> constr_substituted option * constr * constraints * bool
+  env -> recipe -> 
+    constr_substituted option * constr * constraints * bool * bool
 
 (*s Utility functions used in module [Discharge]. *)
 
 val expmod_constr : work_list -> constr -> constr
-val expmod_type : work_list -> types -> types
+
+val clear_cooking_sharing : unit -> unit
+
 
 
diff --git a/kernel/csymtable.ml b/kernel/csymtable.ml
new file mode 100644
index 00000000..fc2d0925
--- /dev/null
+++ b/kernel/csymtable.ml
@@ -0,0 +1,179 @@
+open Names
+open Term
+open Vm
+open Cemitcodes
+open Cbytecodes
+open Declarations
+open Pre_env
+open Cbytegen
+
+
+external tcode_of_code : emitcodes -> int -> tcode = "coq_tcode_of_code"
+external free_tcode : tcode -> unit = "coq_static_free"
+external eval_tcode : tcode -> values array -> values = "coq_eval_tcode"
+ 
+(*******************)
+(* Linkage du code *)
+(*******************)
+
+(* Table des globaux *)
+
+(* [global_data] contient les valeurs des constantes globales 
+   (axiomes,definitions), les annotations des switch et les structured 
+   constant *)
+external global_data : unit -> values array = "get_coq_global_data"
+
+(* [realloc_global_data n] augmente de n la taille de [global_data] *)
+external realloc_global_data : int -> unit = "realloc_coq_global_data"
+
+let check_global_data n =
+  if n >= Array.length (global_data()) then realloc_global_data n
+  
+let num_global = ref 0
+
+let set_global v = 
+  let n = !num_global in
+  check_global_data n;
+  (global_data()).(n) <- v;
+  incr num_global;
+  n
+
+(* [global_transp],[global_boxed] contiennent les valeurs des 
+   definitions gelees. Les deux versions sont maintenues en //. 
+   [global_transp] contient la version transparente.
+   [global_boxed] contient la version gelees. *)
+
+external global_boxed : unit -> bool array = "get_coq_global_boxed"
+
+(* [realloc_global_data n] augmente de n la taille de [global_data] *)
+external realloc_global_boxed : int -> unit = "realloc_coq_global_boxed"
+
+let check_global_boxed n =
+  if n >= Array.length (global_boxed()) then realloc_global_boxed n
+  
+let num_boxed = ref 0
+
+let boxed_tbl = Hashtbl.create 53
+
+let cst_opaque = ref Cpred.full
+
+let is_opaque kn = Cpred.mem kn !cst_opaque
+
+let set_global_boxed kn v = 
+  let n = !num_boxed in
+  check_global_boxed n;
+  (global_boxed()).(n) <- (is_opaque kn);
+  Hashtbl.add boxed_tbl kn n ;
+  incr num_boxed;
+  set_global (val_of_constant_def n kn v)
+
+(* table pour les structured_constant et les annotations des switchs *)
+
+let str_cst_tbl = Hashtbl.create 31
+    (* (structured_constant * int) Hashtbl.t*)
+
+let annot_tbl = Hashtbl.create 31
+    (* (annot_switch * int) Hashtbl.t  *)
+
+(*************************************************************)
+(*** Mise a jour des valeurs des variables et des constantes *)
+(*************************************************************)
+
+exception NotEvaluated
+
+let key rk =
+  match !rk with
+  | Some k -> k
+  | _ -> raise NotEvaluated
+
+(************************)
+(* traduction des patch *)
+
+(* slot_for_*, calcul la valeur de l'objet, la place
+   dans la table global, rend sa position dans la table *)
+ 
+let slot_for_str_cst key =
+  try Hashtbl.find str_cst_tbl key 
+  with Not_found -> 
+    let n = set_global (val_of_str_const key) in
+    Hashtbl.add str_cst_tbl key n;
+    n
+
+let slot_for_annot key =
+  try Hashtbl.find annot_tbl key 
+  with Not_found -> 
+    let n =  set_global (Obj.magic key) in
+    Hashtbl.add annot_tbl key n;
+    n
+
+let rec slot_for_getglobal env kn =
+  let (cb,rk) = lookup_constant_key kn env in
+  try key rk
+  with NotEvaluated ->
+    let pos =
+      match Cemitcodes.force cb.const_body_code with
+      | BCdefined(boxed,(code,pl,fv)) -> 
+	let v = eval_to_patch env (code,pl,fv) in
+  	if boxed then set_global_boxed kn v 
+	else set_global v 
+    | BCallias kn' -> slot_for_getglobal env kn' 
+    | BCconstant -> set_global (val_of_constant kn) in
+    rk := Some pos;
+    pos
+
+and slot_for_fv env fv=
+  match fv with
+  | FVnamed id -> 
+      let nv = lookup_named_val id env in
+      begin
+	match !nv with
+	| VKvalue v -> v
+	| VKaxiom id ->
+	    let v = val_of_named id in
+	    nv := VKvalue v; v
+	| VKdef c ->
+	    let v = val_of_constr (env_of_named id env) c in
+	    nv := VKvalue v; v
+      end
+  | FVrel i ->
+      let rv = lookup_rel_val i env in
+      begin
+	match !rv with
+	| VKvalue v -> v
+	| VKaxiom k ->
+	    let v = val_of_rel k in
+	    rv := VKvalue v; v
+	| VKdef c ->
+	    let v = val_of_constr (env_of_rel i env) c in
+	    rv := VKvalue v; v
+      end
+ 
+and eval_to_patch env (buff,pl,fv) = 
+  let patch = function
+    | Reloc_annot a, pos -> patch_int buff pos (slot_for_annot a)
+    | Reloc_const sc, pos -> patch_int buff pos (slot_for_str_cst sc)
+    | Reloc_getglobal kn, pos -> 
+	patch_int buff pos (slot_for_getglobal env kn)
+  in 
+  List.iter patch pl;
+  let vm_env = Array.map (slot_for_fv env) fv in 
+  let tc = tcode_of_code buff (length buff) in
+  eval_tcode tc vm_env
+
+and val_of_constr env c = 
+  let (_,fun_code,_ as ccfv) = 
+    try compile env c 
+    with e -> print_string "can not compile \n";Format.print_flush();raise e in
+  eval_to_patch env (to_memory ccfv)
+ 
+let set_transparent_const kn =
+  cst_opaque := Cpred.remove kn !cst_opaque;
+  List.iter (fun n -> (global_boxed()).(n) <- false) 
+    (Hashtbl.find_all boxed_tbl kn)
+
+let set_opaque_const kn =
+  cst_opaque := Cpred.add kn !cst_opaque;
+  List.iter (fun n -> (global_boxed()).(n) <- true) 
+    (Hashtbl.find_all boxed_tbl kn)
+
+
diff --git a/kernel/csymtable.mli b/kernel/csymtable.mli
new file mode 100644
index 00000000..2640a4df
--- /dev/null
+++ b/kernel/csymtable.mli
@@ -0,0 +1,8 @@
+open Names
+open Term
+open Pre_env
+
+val val_of_constr : env -> constr -> values 
+
+val set_opaque_const      : constant -> unit
+val set_transparent_const : constant -> unit
diff --git a/kernel/declarations.ml b/kernel/declarations.ml
index ac2c52cc..33d9959c 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,v 1.31.2.2 2005/11/29 21:40:51 letouzey Exp $ i*)
+(*i $Id: declarations.ml 8653 2006-03-22 09:41:17Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -14,40 +14,33 @@ open Names
 open Univ
 open Term
 open Sign
+open Mod_subst
 (*i*)
 
 (* This module defines the types of global declarations. This includes
    global constants/axioms and mutual inductive definitions *)
 
-(*s Constants (internal representation) (Definition/Axiom) *)
+type engagement = ImpredicativeSet
+
 
-type subst_internal = 
-  | Constr of constr 
-  | LazyConstr of substitution * constr
+(*s Constants (internal representation) (Definition/Axiom) *)
 
-type constr_substituted = subst_internal ref
+type constr_substituted = constr substituted
 
-let from_val c = ref (Constr c)
+let from_val = from_val
 
-let force cs = match !cs with
-    Constr c -> c
-  | LazyConstr (subst,c) -> 
-      let c' = subst_mps subst c in
-	cs := Constr c';
-	c'
+let force = force subst_mps 
 
-let subst_constr_subst subst cs = match !cs with
-    Constr c -> ref (LazyConstr (subst,c))
-  | LazyConstr (subst',c) -> 
-      let subst'' = join subst' subst in
-	ref (LazyConstr (subst'',c))
+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_constraints : constraints;
-  const_opaque : bool }
+    const_hyps : section_context; (* New: younger hyp at top *)
+    const_body : constr_substituted option;
+    const_type : types;  
+    const_body_code : Cemitcodes.to_patch_substituted;
+   (* const_type_code : Cemitcodes.to_patch; *)
+    const_constraints : constraints;
+    const_opaque : bool }
 
 (*s Inductive types (internal representation with redundant
     information). *)
@@ -82,72 +75,140 @@ let recarg_length p j =
 
 let subst_wf_paths sub p = Rtree.smartmap (subst_recarg sub) p
 
-(* [mind_typename] is the name of the inductive; [mind_arity] is
-   the arity generalized over global parameters; [mind_lc] is the list
-   of types of constructors generalized over global parameters and
-   relative to the global context enriched with the arities of the
-   inductives *) 
+(**********************************************************************)
+(* Representation of mutual inductive types in the kernel             *)
+(*
+   Inductive I1 (params) : U1 := c11 : T11 | ... | c1p1 : T1p1
+   ...
+   with      In (params) : Un := cn1 : Tn1 | ... | cnpn : Tnpn
+*)
 
 type one_inductive_body = {
-  mind_typename : identifier;
-  mind_nparams : int;
-  mind_params_ctxt : rel_context;
-  mind_nrealargs : int;
-  mind_nf_arity : types;
-  mind_user_arity : types;
-  mind_sort : sorts;
-  mind_kelim : sorts_family list;
-  mind_consnames : identifier array;
-  mind_nf_lc : types array; (* constrs and arity with pre-expanded ccl *)
-  mind_user_lc : types array;
-  mind_recargs : wf_paths;
- }
+
+(* Primitive datas *)
+
+ (* Name of the type: [Ii] *)
+    mind_typename : identifier;
+
+ (* Arity of [Ii] with parameters: [forall params, Ui] *)
+    mind_user_arity : types;
+
+ (* Names of the constructors: [cij] *)
+    mind_consnames : identifier array;
+
+ (* Types of the constructors with parameters: [forall params, Tij],
+    where the Ik are replaced by de Bruijn index in the context
+    I1:forall params, U1 ..  In:forall params, Un *)
+    mind_user_lc : types array;
+
+(* Derived datas *)
+
+ (* Head normalized arity so that the conclusion is a sort *)
+    mind_nf_arity : types;
+
+ (* Number of expected real arguments of the type (no let, no params) *)
+    mind_nrealargs : int;
+
+ (* Conclusion of the arity *)
+    mind_sort : sorts;
+
+ (* List of allowed elimination sorts *)
+    mind_kelim : sorts_family list;
+
+ (* Head normalized constructor types so that their conclusion is atomic *)
+    mind_nf_lc : types array;
+
+ (* Length of the signature of the constructors (with let, w/o params) *)
+    mind_consnrealdecls : int array;
+
+ (* Signature of recursive arguments in the constructors *)
+    mind_recargs : wf_paths;
+
+(* Datas for bytecode compilation *)
+
+ (* number of constant constructor *)
+    mind_nb_constant : int;
+
+ (* number of no constant constructor *)
+    mind_nb_args : int;
+
+    mind_reloc_tbl :  Cbytecodes.reloc_table; 
+  }
 
 type mutual_inductive_body = {
-  mind_record : bool;
-  mind_finite : bool;
-  mind_ntypes : int;
-  mind_hyps : section_context;
-  mind_packets : one_inductive_body array;
-  mind_constraints : constraints;
-  mind_equiv : kernel_name option
- }
+
+  (* The component of the mutual inductive block *)
+    mind_packets : one_inductive_body array;
+
+  (* Whether the inductive type has been declared as a record *)
+    mind_record : bool;
+
+  (* Whether the type is inductive or coinductive *)
+    mind_finite : bool;
+
+  (* Number of types in the block *)
+    mind_ntypes : int;
+
+  (* Section hypotheses on which the block depends *)
+    mind_hyps : section_context;
+
+  (* Number of expected parameters *)
+    mind_nparams : int;
+
+  (* Number of recursively uniform (i.e. ordinary) parameters *)
+    mind_nparams_rec : int;
+
+  (* The context of parameters (includes let-in declaration) *)
+    mind_params_ctxt : rel_context;
+
+  (* Universes constraints enforced by the inductive declaration *)
+    mind_constraints : constraints;
+
+  (* Source of the inductive block when aliased in a module *)
+    mind_equiv : kernel_name option
+  }
 
 (* TODO: should be changed to non-coping after Term.subst_mps *)
-let subst_const_body sub cb = 
-  { const_body = option_app (subst_constr_subst sub) cb.const_body;
-    const_type = type_app (Term.subst_mps sub) cb.const_type;
+let subst_const_body sub cb = {
     const_hyps = (assert (cb.const_hyps=[]); []);
+    const_body = option_app (subst_constr_subst sub) cb.const_body;
+    const_type = type_app (subst_mps 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;
-    const_opaque = cb.const_opaque}
-  
+    const_opaque = cb.const_opaque } 
+
 let subst_mind_packet sub mbp = 
   { mind_consnames = mbp.mind_consnames;
+    mind_consnrealdecls = mbp.mind_consnrealdecls;
     mind_typename = mbp.mind_typename;
     mind_nf_lc = 
-      array_smartmap (type_app (Term.subst_mps sub)) mbp.mind_nf_lc;
-    mind_nf_arity = type_app (Term.subst_mps sub) mbp.mind_nf_arity;
+      array_smartmap (type_app (subst_mps sub)) mbp.mind_nf_lc;
+    mind_nf_arity = type_app (subst_mps sub) mbp.mind_nf_arity;
     mind_user_lc = 
-      array_smartmap (type_app (Term.subst_mps sub)) mbp.mind_user_lc;
-    mind_user_arity = type_app (Term.subst_mps sub) mbp.mind_user_arity;
+      array_smartmap (type_app (subst_mps sub)) mbp.mind_user_lc;
+    mind_user_arity = type_app (subst_mps sub) mbp.mind_user_arity;
     mind_sort = mbp.mind_sort;
     mind_nrealargs = mbp.mind_nrealargs;
     mind_kelim = mbp.mind_kelim;
-    mind_nparams = mbp.mind_nparams;
-    mind_params_ctxt = 
-      map_rel_context (Term.subst_mps sub) mbp.mind_params_ctxt;
-    mind_recargs = subst_wf_paths sub mbp.mind_recargs (*wf_paths*);
-}
+    mind_recargs = subst_wf_paths sub mbp.mind_recargs (*wf_paths*); 
+    mind_nb_constant = mbp.mind_nb_constant;
+    mind_nb_args = mbp.mind_nb_args;
+    mind_reloc_tbl = mbp.mind_reloc_tbl }
+
 
 let subst_mind sub mib = 
   { mind_record = mib.mind_record ; 
     mind_finite = mib.mind_finite ;
     mind_ntypes = mib.mind_ntypes ;
     mind_hyps = (assert (mib.mind_hyps=[]); []) ;
+    mind_nparams = mib.mind_nparams;
+    mind_nparams_rec = mib.mind_nparams_rec;
+    mind_params_ctxt = 
+      map_rel_context (subst_mps sub) mib.mind_params_ctxt;
     mind_packets = array_smartmap (subst_mind_packet sub) mib.mind_packets ;
     mind_constraints = mib.mind_constraints ;
-    mind_equiv = option_app (subst_kn sub) mib.mind_equiv;
-}
+    mind_equiv = option_app (subst_kn sub) mib.mind_equiv }
 
 
 (*s Modules: signature component specifications, module types, and
@@ -171,7 +232,6 @@ and module_specification_body =
       msb_equiv : module_path option; 
       msb_constraints : constraints }
 
-
 type structure_elem_body = 
   | SEBconst of constant_body
   | SEBmind of mutual_inductive_body
@@ -193,3 +253,4 @@ and module_body =
       mod_type : module_type_body;
       mod_equiv : module_path option;
       mod_constraints : constraints }
+
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index 6cff3936..7ad953e5 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -6,20 +6,25 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: declarations.mli,v 1.33.2.3 2005/11/29 21:40:51 letouzey Exp $ i*)
+(*i $Id: declarations.mli 8653 2006-03-22 09:41:17Z herbelin $ i*)
 
 (*i*)
 open Names
 open Univ
 open Term
+open Cemitcodes
 open Sign
+open Mod_subst
 (*i*)
 
 (* This module defines the internal representation of global
    declarations. This includes global constants/axioms, mutual
    inductive definitions, modules and module types *)
 
-(*s Constants (Definition/Axiom) *)
+type engagement = ImpredicativeSet
+
+(**********************************************************************)
+(*s Representation of constants (Definition/Axiom)                    *)
 
 type constr_substituted
 
@@ -27,16 +32,18 @@ val from_val : constr -> constr_substituted
 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_constraints : constraints;
-  const_opaque : bool }
+    const_hyps : section_context; (* New: younger hyp at top *)
+    const_body : constr_substituted option;
+    const_type : types;  
+    const_body_code : to_patch_substituted;
+   (*i const_type_code : to_patch;i*)
+    const_constraints : constraints;
+    const_opaque : bool }
 
 val subst_const_body : substitution -> constant_body -> constant_body
 
-(*s Inductive types (internal representation with redundant
-    information). *)
+(**********************************************************************)
+(*s Representation of mutual inductive types in the kernel            *)
 
 type recarg = 
   | Norec 
@@ -55,41 +62,102 @@ val recarg_length : wf_paths -> int -> int
 
 val subst_wf_paths : substitution -> wf_paths -> wf_paths
 
-(* [mind_typename] is the name of the inductive; [mind_arity] is
-   the arity generalized over global parameters; [mind_lc] is the list
-   of types of constructors generalized over global parameters and
-   relative to the global context enriched with the arities of the
-   inductives *) 
+(*
+\begin{verbatim}
+   Inductive I1 (params) : U1 := c11 : T11 | ... | c1p1 : T1p1
+   ...
+   with      In (params) : Un := cn1 : Tn1 | ... | cnpn : Tnpn
+\end{verbatim}
+*)
 
 type one_inductive_body = {
-  mind_typename : identifier;
-  mind_nparams : int;
-  mind_params_ctxt : rel_context;
-  mind_nrealargs : int;
-  mind_nf_arity : types;
-  mind_user_arity : types;
-  mind_sort : sorts;
-  mind_kelim : sorts_family list;
-  mind_consnames : identifier array;
-  mind_nf_lc : types array; (* constrs and arity with pre-expanded ccl *)
-  mind_user_lc : types array;
-  mind_recargs : wf_paths;
- }
+
+(* Primitive datas *)
+
+ (* Name of the type: [Ii] *)
+    mind_typename : identifier;
+
+ (* Arity of [Ii] with parameters: [forall params, Ui] *)
+    mind_user_arity : types;
+
+ (* Names of the constructors: [cij] *)
+    mind_consnames : identifier array;
+
+ (* Types of the constructors with parameters: [forall params, Tij],
+    where the Ik are replaced by de Bruijn index in the context
+    I1:forall params, U1 ..  In:forall params, Un *)
+    mind_user_lc : types array;
+
+(* Derived datas *)
+
+ (* Head normalized arity so that the conclusion is a sort *)
+    mind_nf_arity : types;
+
+ (* Number of expected real arguments of the type (no let, no params) *)
+    mind_nrealargs : int;
+
+ (* Conclusion of the arity *)
+    mind_sort : sorts;
+
+ (* List of allowed elimination sorts *)
+    mind_kelim : sorts_family list;
+
+ (* Head normalized constructor types so that their conclusion is atomic *)
+    mind_nf_lc : types array;
+
+ (* Length of the signature of the constructors (with let, w/o params) *)
+    mind_consnrealdecls : int array;
+
+ (* Signature of recursive arguments in the constructors *)
+    mind_recargs : wf_paths;
+
+(* Datas for bytecode compilation *)
+
+ (* number of constant constructor *)
+    mind_nb_constant : int;
+
+ (* number of no constant constructor *)
+    mind_nb_args : int;
+
+    mind_reloc_tbl :  Cbytecodes.reloc_table; 
+  }
 
 type mutual_inductive_body = {
-  mind_record : bool;
-  mind_finite : bool;
-  mind_ntypes : int;
-  mind_hyps : section_context;
-  mind_packets : one_inductive_body array;
-  mind_constraints : constraints;
-  mind_equiv : kernel_name option;
- }
 
+  (* The component of the mutual inductive block *)
+    mind_packets : one_inductive_body array;
 
-val subst_mind : substitution -> mutual_inductive_body -> mutual_inductive_body
+  (* Whether the inductive type has been declared as a record *)
+    mind_record : bool;
+
+  (* Whether the type is inductive or coinductive *)
+    mind_finite : bool;
+
+  (* Number of types in the block *)
+    mind_ntypes : int;
 
+  (* Section hypotheses on which the block depends *)
+    mind_hyps : section_context;
+
+  (* Number of expected parameters *)
+    mind_nparams : int;
+
+  (* Number of recursively uniform (i.e. ordinary) parameters *)
+    mind_nparams_rec : int;
+
+  (* The context of parameters (includes let-in declaration) *)
+    mind_params_ctxt : rel_context;
+
+  (* Universes constraints enforced by the inductive declaration *)
+    mind_constraints : constraints;
+
+  (* Source of the inductive block when aliased in a module *)
+    mind_equiv : kernel_name option
+  }
+
+val subst_mind : substitution -> mutual_inductive_body -> mutual_inductive_body
 
+(**********************************************************************)
 (*s Modules: signature component specifications, module types, and
   module declarations *)
 
diff --git a/kernel/entries.ml b/kernel/entries.ml
index a3d3d336..56b198c3 100644
--- a/kernel/entries.ml
+++ b/kernel/entries.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: entries.ml,v 1.3.8.2 2005/11/29 21:40:51 letouzey Exp $ i*)
+(*i $Id: entries.ml 8647 2006-03-18 15:33:09Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -32,9 +32,9 @@ type local_entry =
 
 (* Assume the following definition in concrete syntax:
 \begin{verbatim}
-Inductive I1 [x1:X1;...;xn:Xn] : A1 := c11 : T11 | ... | c1n1 : T1n1
+Inductive I1 (x1:X1) ... (xn:Xn) : A1 := c11 : T11 | ... | c1n1 : T1n1
 ...
-with  Ip [x1:X1;...;xn:Xn] : Ap := cp1 : Tp1 | ... | cpnp : Tpnp.
+with      Ip (x1:X1) ... (xn:Xn) : Ap := cp1 : Tp1 | ... | cpnp : Tpnp.
 \end{verbatim}
 then, in $i^{th}$ block, [mind_entry_params] is [[xn:Xn;...;x1:X1]];
 [mind_entry_arity] is [Ai], defined in context [[[x1:X1;...;xn:Xn]];
@@ -42,7 +42,6 @@ then, in $i^{th}$ block, [mind_entry_params] is [[xn:Xn;...;x1:X1]];
 *)
 
 type one_inductive_entry = {
-  mind_entry_params : (identifier * local_entry) list;
   mind_entry_typename : identifier;
   mind_entry_arity : constr;
   mind_entry_consnames : identifier list;
@@ -51,6 +50,7 @@ type one_inductive_entry = {
 type mutual_inductive_entry = {
   mind_entry_record : bool;
   mind_entry_finite : bool;
+  mind_entry_params : (identifier * local_entry) list;
   mind_entry_inds : one_inductive_entry list }
 
 
@@ -59,7 +59,8 @@ type mutual_inductive_entry = {
 type definition_entry = {
   const_entry_body   : constr;
   const_entry_type   : types option;
-  const_entry_opaque : bool }
+  const_entry_opaque : bool;
+  const_entry_boxed  : bool}
 
 type parameter_entry = types
 
@@ -84,8 +85,8 @@ and module_type_entry =
 and module_signature_entry = (label * specification_entry) list
 
 and with_declaration = 
-    With_Module of identifier * module_path
-  | With_Definition of identifier * constr
+    With_Module of identifier list * module_path
+  | With_Definition of identifier list * constr
 
 and module_expr = 
     MEident of module_path
diff --git a/kernel/entries.mli b/kernel/entries.mli
index e9bc420e..b9a95d44 100644
--- a/kernel/entries.mli
+++ b/kernel/entries.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: entries.mli,v 1.3.8.2 2005/11/29 21:40:51 letouzey Exp $ i*)
+(*i $Id: entries.mli 8647 2006-03-18 15:33:09Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -32,9 +32,9 @@ type local_entry =
 
 (* Assume the following definition in concrete syntax:
 \begin{verbatim}
-Inductive I1 [x1:X1;...;xn:Xn] : A1 := c11 : T11 | ... | c1n1 : T1n1
+Inductive I1 (x1:X1) ... (xn:Xn) : A1 := c11 : T11 | ... | c1n1 : T1n1
 ...
-with  Ip [x1:X1;...;xn:Xn] : Ap := cp1 : Tp1 | ... | cpnp : Tpnp.
+with      Ip (x1:X1) ... (xn:Xn) : Ap := cp1 : Tp1 | ... | cpnp : Tpnp.
 \end{verbatim}
 then, in $i^{th}$ block, [mind_entry_params] is [[xn:Xn;...;x1:X1]];
 [mind_entry_arity] is [Ai], defined in context [[[x1:X1;...;xn:Xn]];
@@ -42,7 +42,6 @@ then, in $i^{th}$ block, [mind_entry_params] is [[xn:Xn;...;x1:X1]];
 *)
 
 type one_inductive_entry = {
-  mind_entry_params : (identifier * local_entry) list;
   mind_entry_typename : identifier;
   mind_entry_arity : constr;
   mind_entry_consnames : identifier list;
@@ -51,15 +50,16 @@ type one_inductive_entry = {
 type mutual_inductive_entry = {
   mind_entry_record : bool;
   mind_entry_finite : bool;
+  mind_entry_params : (identifier * local_entry) list;
   mind_entry_inds : one_inductive_entry list }
 
-
 (*s Constants (Definition/Axiom) *)
 
 type definition_entry = {
   const_entry_body   : constr;
   const_entry_type   : types option;
-  const_entry_opaque : bool }
+  const_entry_opaque : bool;
+  const_entry_boxed  : bool }
 
 type parameter_entry = types
 
@@ -84,8 +84,8 @@ and module_type_entry =
 and module_signature_entry = (label * specification_entry) list
 
 and with_declaration = 
-    With_Module of identifier * module_path
-  | With_Definition of identifier * constr
+    With_Module of identifier list * module_path
+  | With_Definition of identifier list * constr
 
 and module_expr = 
     MEident of module_path
diff --git a/kernel/environ.ml b/kernel/environ.ml
index ec3c903d..77d77118 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: environ.ml,v 1.89.2.1 2004/07/16 19:30:25 herbelin Exp $ *)
+(* $Id: environ.ml 7830 2006-01-10 22:45:28Z herbelin $ *)
 
 open Util
 open Names
@@ -14,49 +14,25 @@ open Sign
 open Univ
 open Term
 open Declarations
+open Pre_env
+open Csymtable
 
 (* The type of environments. *)
 
-type checksum = int
+type named_context_val = Pre_env.named_context_val
 
-type compilation_unit_name = dir_path * checksum
+type env = Pre_env.env
 
-type global = Constant | Inductive
+let pre_env env = env
 
-type engagement = ImpredicativeSet
+let empty_named_context_val = empty_named_context_val
 
-type globals = {
-  env_constants : constant_body KNmap.t;
-  env_inductives : mutual_inductive_body KNmap.t;
-  env_modules : module_body MPmap.t;
-  env_modtypes : module_type_body KNmap.t }
-
-type stratification = {
-  env_universes : universes;
-  env_engagement : engagement option
-}
-
-type env = {
-  env_globals        : globals;
-  env_named_context  : named_context;
-  env_rel_context    : rel_context;
-  env_stratification : stratification }
-
-let empty_env = { 
-  env_globals = {
-    env_constants = KNmap.empty;
-    env_inductives = KNmap.empty;
-    env_modules = MPmap.empty;
-    env_modtypes = KNmap.empty };
-  env_named_context = empty_named_context;
-  env_rel_context = empty_rel_context;
-  env_stratification = {
-    env_universes = initial_universes;
-    env_engagement = None } }
+let empty_env = empty_env
 
 let engagement env = env.env_stratification.env_engagement
 let universes env = env.env_stratification.env_universes
 let named_context env = env.env_named_context
+let named_context_val env = env.env_named_context,env.env_named_vals
 let rel_context env = env.env_rel_context
 
 let empty_context env = 
@@ -75,68 +51,109 @@ let evaluable_rel n env =
   with Not_found -> 
     false
 
-let push_rel d env =
-  { env with
-      env_rel_context = add_rel_decl d env.env_rel_context }
+let nb_rel env = env.env_nb_rel
+
+let push_rel = push_rel
 
 let push_rel_context ctxt x = Sign.fold_rel_context push_rel ctxt ~init:x
+    
 let push_rec_types (lna,typarray,_) env =
   let ctxt =
     array_map2_i
       (fun i na t -> (na, None, type_app (lift i) t)) lna typarray in
   Array.fold_left (fun e assum -> push_rel assum e) env ctxt
-
+    
 let reset_rel_context env =
   { env with
-      env_rel_context = empty_rel_context }
+    env_rel_context = empty_rel_context;
+    env_rel_val = [];
+    env_nb_rel = 0 }
 
 let fold_rel_context f env ~init =
-  snd (Sign.fold_rel_context
-	 (fun d (env,e) -> (push_rel d env, f env d e))
-         (rel_context env) ~init:(reset_rel_context env,init))
-
+  let rec fold_right env =
+    match env.env_rel_context with
+    | [] -> init
+    | rd::rc ->
+	let env = 
+	  { env with
+	    env_rel_context = rc;
+	    env_rel_val = List.tl env.env_rel_val;
+	    env_nb_rel = env.env_nb_rel - 1 } in
+	f env rd (fold_right env) 
+  in fold_right env
 
 (* Named context *)
-let lookup_named id env =
-  Sign.lookup_named id env.env_named_context
 
-(* A local const is evaluable if it is defined and not opaque *)
-let evaluable_named id env =
-  try 
-    match lookup_named id env with
-        (_,Some _,_) -> true
-      | _ -> false
-  with Not_found -> 
-    false
+let named_context_of_val = fst
 
-let push_named d env =
-  { env with
-      env_named_context = Sign.add_named_decl d env.env_named_context }
+(* [map_named_val f ctxt] apply [f] to the body and the type of
+   each declarations.
+   *** /!\ ***   [f t] should be convertible with t *)  
+let map_named_val f (ctxt,ctxtv) = 
+  let ctxt =
+    List.map (fun (id,body,typ) -> (id, option_app f body, f typ)) ctxt in
+  (ctxt,ctxtv)
 
-let reset_context env =
-  { env with
-      env_named_context = empty_named_context;
-      env_rel_context = empty_rel_context }
+let empty_named_context = empty_named_context 
 
-let reset_with_named_context ctxt env =
-  { env with
-      env_named_context = ctxt;
-      env_rel_context = empty_rel_context }
+let push_named = push_named
+let push_named_context_val = push_named_context_val
+
+let val_of_named_context ctxt =
+  List.fold_right push_named_context_val ctxt empty_named_context_val
+
+
+let lookup_named id env = Sign.lookup_named id env.env_named_context
+let lookup_named_val id (ctxt,_) = Sign.lookup_named id ctxt
+
+let eq_named_context_val c1 c2 =
+   c1 == c2 || named_context_of_val c1 = named_context_of_val c2
+
+(* A local const is evaluable if it is defined  *)
+
+let named_type id env =
+  let (_,_,t) = lookup_named id env in t
 
+let named_body id env =
+  let (_,b,_) = lookup_named id env in b
+
+let evaluable_named id env =
+  try 
+    match named_body id env with
+    |Some _      -> true
+    | _          -> false
+  with Not_found -> false
+      
+let reset_with_named_context (ctxt,ctxtv) env =
+  { env with
+    env_named_context = ctxt;
+    env_named_vals = ctxtv;
+    env_rel_context = empty_rel_context;
+    env_rel_val = [];
+    env_nb_rel = 0 }
+
+let reset_context = reset_with_named_context empty_named_context_val
+ 
 let fold_named_context f env ~init =
-  snd (Sign.fold_named_context
-	 (fun d (env,e) -> (push_named d env, f env d e))
-         (named_context env) ~init:(reset_context env,init))
+  let rec fold_right env =
+    match env.env_named_context with
+    | [] -> init
+    | d::ctxt ->
+	let env = 
+	  reset_with_named_context (ctxt,List.tl env.env_named_vals) env in
+	f env d (fold_right env) 
+  in fold_right env
 
 let fold_named_context_reverse f ~init env =
-  Sign.fold_named_context_reverse f ~init:init (named_context env) 
-
+  Sign.fold_named_context_reverse f ~init:init (named_context env)
+ 
 (* Global constants *)
-let lookup_constant kn env =
-  KNmap.find kn env.env_globals.env_constants
 
-let add_constant kn cb env =
-  let new_constants = KNmap.add kn cb env.env_globals.env_constants in
+let lookup_constant = lookup_constant
+
+let add_constant kn cs env =
+  let new_constants = 
+    Cmap.add kn (cs,ref None) env.env_globals.env_constants in
   let new_globals = 
     { env.env_globals with 
 	env_constants = new_constants } in 
@@ -168,8 +185,7 @@ let evaluable_constant cst env =
   with Not_found | NotEvaluableConst _ -> false
 
 (* Mutual Inductives *)
-let lookup_mind kn env =
-  KNmap.find kn env.env_globals.env_inductives
+let lookup_mind = lookup_mind
 
 let add_mind kn mib env =
   let new_inds = KNmap.add kn mib env.env_globals.env_inductives in
@@ -253,7 +269,6 @@ let keep_hyps env needed =
     (named_context env)
     ~init:empty_named_context
 
-
 (* Modules *)
 
 let add_modtype ln mtb env = 
@@ -293,3 +308,61 @@ type unsafe_type_judgment = {
   utj_val : constr;
   utj_type : sorts }
 
+(*s Compilation of global declaration *)
+
+let compile_constant_body = Cbytegen.compile_constant_body  
+
+(*s Special functions for the refiner (logic.ml) *)
+
+let clear_hyps ids check (ctxt,vals) =
+  let ctxt,vals,rmv = 
+    List.fold_right2 (fun (id,_,_ as d) v (ctxt,vals,rmv) ->
+      if List.mem id ids then (ctxt,vals,id::rmv)
+      else begin
+	check rmv d;
+	(d::ctxt,v::vals,rmv)
+      end) ctxt vals ([],[],[])
+  in ((ctxt,vals),rmv)
+
+exception Hyp_not_found
+
+let rec apply_to_hyp (ctxt,vals) id f =
+  let rec aux rtail ctxt vals =
+    match ctxt, vals with
+    | (idc,c,ct as d)::ctxt, v::vals ->
+	if idc = id then
+	  (f ctxt d rtail)::ctxt, v::vals
+	else 
+	  let ctxt',vals' = aux (d::rtail) ctxt vals in
+	  d::ctxt', v::vals'
+    | [],[] -> raise Hyp_not_found
+    | _, _ -> assert false
+  in aux [] ctxt vals
+
+let rec apply_to_hyp_and_dependent_on (ctxt,vals) id f g =
+  let rec aux ctxt vals =
+    match ctxt,vals with
+    | (idc,c,ct as d)::ctxt, v::vals ->
+	if idc = id then
+	  let sign = ctxt,vals in
+	  push_named_context_val (f d sign) sign 
+	else 
+	  let (ctxt,vals as sign) = aux ctxt vals in
+	  push_named_context_val (g d sign) sign
+    | [],[] -> raise Hyp_not_found
+    | _,_ -> assert false
+  in aux ctxt vals
+
+let insert_after_hyp (ctxt,vals) id d check =
+  let rec aux ctxt vals =
+    match  ctxt, vals with
+    | (idc,c,ct)::ctxt', v::vals' ->
+	if idc = id then begin
+	  check ctxt; 
+	  push_named_context_val d (ctxt,vals) 
+	end else 
+	  let ctxt,vals = aux ctxt vals in
+	  d::ctxt, v::vals
+    | [],[] -> raise Hyp_not_found
+    | _, _ -> assert false
+  in aux ctxt vals
diff --git a/kernel/environ.mli b/kernel/environ.mli
index a2a66cb7..701159da 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,v 1.66.2.2 2005/01/21 16:41:49 herbelin Exp $ i*)
+(*i $Id: environ.mli 7640 2005-12-05 10:16:24Z gregoire $ i*)
 
 (*i*)
 open Names
@@ -22,21 +22,30 @@ open Sign
 
 (* Environments have the following components:
    - a context for de Bruijn variables
+   - a context for de Bruijn variables vm values
    - a context for section variables and goal assumptions
+   - a context for section variables and goal assumptions vm values 
    - a context for global constants and axioms
    - a context for inductive definitions
    - a set of universe constraints
    - a flag telling if Set is, can be, or cannot be set impredicative *)
 
+
+
+
 type env
+val pre_env : env -> Pre_env.env
+
+type named_context_val
+val eq_named_context_val : named_context_val -> named_context_val -> bool
 
 val empty_env : env
 
 val universes     : env -> Univ.universes
 val rel_context   : env -> rel_context
 val named_context : env -> named_context
+val named_context_val : env -> named_context_val
 
-type engagement = ImpredicativeSet
 
 val engagement    : env -> engagement option
 
@@ -45,6 +54,7 @@ val empty_context : env -> bool
 
 (************************************************************************)
 (*s Context of de Bruijn variables ([rel_context]) *)
+val nb_rel           : env -> int 
 val push_rel         : rel_declaration -> env -> env
 val push_rel_context :     rel_context -> env -> env
 val push_rec_types   : rec_declaration -> env -> env
@@ -60,14 +70,35 @@ val fold_rel_context :
 
 (************************************************************************)
 (* Context of variables (section variables and goal assumptions) *)
+
+val named_context_of_val : named_context_val -> named_context
+val val_of_named_context : named_context -> named_context_val
+val empty_named_context_val : named_context_val
+
+
+(* [map_named_val f ctxt] apply [f] to the body and the type of
+   each declarations.
+   *** /!\ ***   [f t] should be convertible with t *)  
+val map_named_val : 
+   (constr -> constr) -> named_context_val -> named_context_val
+
 val push_named : named_declaration -> env -> env
+val push_named_context_val  : 
+    named_declaration -> named_context_val -> named_context_val
+
+
 
 (* Looks up in the context of local vars referred by names ([named_context]) *)
 (* raises [Not_found] if the identifier is not found *)
-val lookup_named    : variable -> env -> named_declaration
-val evaluable_named : variable -> env -> bool
 
+val lookup_named     : variable -> env -> named_declaration
+val lookup_named_val : variable -> named_context_val -> named_declaration
+val evaluable_named  : variable -> env -> bool
+val named_type : variable -> env -> types
+val named_body : variable -> env -> constr option
+ 
 (*s Recurrence on [named_context]: older declarations processed first *)
+
 val fold_named_context :
   (env -> named_declaration -> 'a -> 'a) -> env -> init:'a -> 'a
 
@@ -78,7 +109,7 @@ val fold_named_context_reverse :
 (* This forgets named and rel contexts *)
 val reset_context : env -> env
 (* This forgets rel context and sets a new named context *)
-val reset_with_named_context : named_context -> env -> env
+val reset_with_named_context : named_context_val -> env -> env
 
 (************************************************************************)
 (*s Global constants *)
@@ -87,6 +118,7 @@ val add_constant : constant -> constant_body -> env -> env
 
 (* Looks up in the context of global constant names *)
 (* raises [Not_found] if the required path is not found *)
+
 val lookup_constant    : constant -> env -> constant_body
 val evaluable_constant : constant -> env -> bool
 
@@ -153,7 +185,35 @@ type unsafe_type_judgment = {
   utj_type : sorts }
 
 
+(*s Compilation of global declaration *)
+
+val compile_constant_body : 
+    env -> constr_substituted option -> bool -> bool -> Cemitcodes.body_code
+                                 (* opaque *) (* boxed *)
+
+(*s Functions for proofs/logic.ml *)
+val clear_hyps : 
+    variable list -> (variable list -> named_declaration -> unit) -> 
+      named_context_val -> named_context_val * variable list
+
+exception Hyp_not_found
 
+(* [apply_to_hyp sign id f] split [sign] into [tail::(id,_,_)::head] and
+   return [tail::(f head (id,_,_) (rev tail))::head].
+   the value associated to id should not change *)
 
+val apply_to_hyp : named_context_val -> variable -> 
+  (named_context -> named_declaration -> named_context -> named_declaration) ->
+    named_context_val
 
+(* [apply_to_hyp_and_dependent_on sign id f g] split [sign] into
+   [tail::(id,_,_)::head] and
+   return [(g tail)::(f (id,_,_))::head]. *)
+val apply_to_hyp_and_dependent_on : named_context_val -> variable ->
+  (named_declaration -> named_context_val -> named_declaration) ->
+    (named_declaration -> named_context_val -> named_declaration) ->
+      named_context_val
 
+val insert_after_hyp : named_context_val -> variable ->
+  named_declaration -> 
+    (named_context -> unit) -> named_context_val
diff --git a/kernel/esubst.ml b/kernel/esubst.ml
index 38db01fc..0a3f4578 100644
--- a/kernel/esubst.ml
+++ b/kernel/esubst.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: esubst.ml,v 1.4.2.1 2004/07/16 19:30:25 herbelin Exp $ *)
+(* $Id: esubst.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Util
 
diff --git a/kernel/esubst.mli b/kernel/esubst.mli
index 2fe981f7..39fbbede 100644
--- a/kernel/esubst.mli
+++ b/kernel/esubst.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: esubst.mli,v 1.3.2.2 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: esubst.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 (*s Compact representation of explicit relocations. \\
    [ELSHFT(l,n)] == lift of [n], then apply [lift l].
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index 0b1d49f5..a3fc0db4 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: indtypes.ml,v 1.59.2.4 2005/12/30 15:58:59 barras Exp $ *)
+(* $Id: indtypes.ml 8653 2006-03-22 09:41:17Z herbelin $ *)
 
 open Util
 open Names
@@ -26,14 +26,14 @@ let weaker_noccur_between env x nvars t =
   if noccur_between x nvars t then Some t
   else
    let t' = whd_betadeltaiota env t in
-   if noccur_between x nvars t then Some t'
+   if noccur_between x nvars t' then Some t'
    else None
 
 (************************************************************************)
 (* Various well-formedness check for inductive declarations            *)
 
+(* Errors related to inductive constructions *)
 type inductive_error =
-  (* These are errors related to inductive constructions in this module *)
   | NonPos of env * constr * constr
   | NotEnoughArgs of env * constr * constr
   | NotConstructor of env * constr * constr
@@ -43,10 +43,6 @@ type inductive_error =
   | SameNamesOverlap of identifier list
   | NotAnArity of identifier
   | BadEntry
-  (* These are errors related to recursors building in Indrec *)
-  | NotAllowedCaseAnalysis of bool * sorts * inductive
-  | BadInduction of bool * identifier * sorts
-  | NotMutualInScheme
 
 exception InductiveError of inductive_error
 
@@ -141,7 +137,7 @@ let rec infos_and_sort env t =
 	let logic = not (is_info_type env varj) in
 	let small = Term.is_small varj.utj_type in
 	(logic,small) :: (infos_and_sort env1 c2)
-    | Cast (c,_) -> infos_and_sort env c
+    | Cast (c,_,_) -> infos_and_sort env c
     | _ -> []
 
 let small_unit constrsinfos =
@@ -175,19 +171,19 @@ let type_one_constructor env_ar_par params arsort c =
 
   (infos, full_cstr_type, cst2)
 
-let infer_constructor_packet env_ar params arsort vc =
+let infer_constructor_packet env_ar params arsort lc =
   let env_ar_par = push_rel_context params env_ar in
   let (constrsinfos,jlc,cst) = 
     List.fold_right
       (fun c (infosl,l,cst) ->
-	 let (infos,ct,cst') =
+	 let (infos,ct,cst') = 
 	   type_one_constructor env_ar_par params arsort c in
 	 (infos::infosl,ct::l, Constraint.union cst cst'))
-      vc
+      lc
       ([],[],Constraint.empty) in
-  let vc' = Array.of_list jlc in
+  let lc' = Array.of_list jlc in
   let issmall,isunit = small_unit constrsinfos in
-  (issmall,isunit,vc', cst)
+  (issmall,isunit,lc',cst)
 
 (* Type-check an inductive definition. Does not check positivity
    conditions. *)
@@ -196,16 +192,15 @@ let typecheck_inductive env mie =
   (* Check unicity of names *)
   mind_check_names mie;
   mind_check_arities env mie;
-  (* We first type params and arity of each inductive definition *)
+         (* Params are typed-checked here *)
+  let params = mie.mind_entry_params in
+  let env_params, params, cstp = infer_local_decls env params in
+  (* We first type arity of each inductive definition *)
   (* This allows to build the environment of arities and to share *)
   (* the set of constraints *)
   let cst, arities, rev_params_arity_list =
     List.fold_left
       (fun (cst,arities,l) ind ->
-         (* Params are typed-checked here *)
-	 let params = ind.mind_entry_params in
-	 let env_params, params, cst1 =
-           infer_local_decls env params in
          (* Arities (without params) are typed-checked here *)
 	 let arity, cst2 =
            infer_type env_params ind.mind_entry_arity in
@@ -215,10 +210,10 @@ let typecheck_inductive env mie =
 	    upper universe will be generated *)
 	 let id = ind.mind_entry_typename in
 	 let full_arity = it_mkProd_or_LetIn arity.utj_val params in
-	 Constraint.union cst (Constraint.union cst1 cst2),
+	 Constraint.union cst cst2,
 	 Sign.add_rel_decl (Name id, None, full_arity) arities,
          (params, id, full_arity, arity.utj_val)::l)
-      (Constraint.empty,empty_rel_context,[])
+      (cstp,empty_rel_context,[])
       mie.mind_entry_inds in
 
   let env_arities = push_rel_context arities env in
@@ -234,13 +229,13 @@ let typecheck_inductive env mie =
 	 let (issmall,isunit,lc',cst') =
 	   infer_constructor_packet env_arities params arsort lc in
 	 let consnames = ind.mind_entry_consnames in
-	 let ind' = (params,id,full_arity,consnames,issmall,isunit,lc')
+	 let ind' = (id,full_arity,consnames,issmall,isunit,lc')
 	 in
 	 (ind'::inds, Constraint.union cst cst'))
       mie.mind_entry_inds
       params_arity_list
       ([],cst) in
-  (env_arities, Array.of_list inds, cst)
+  (env_arities, params, Array.of_list inds, cst)
 
 (************************************************************************)
 (************************************************************************)
@@ -276,13 +271,18 @@ let explain_ind_err ntyp env0 nbpar c err =
 	raise (InductiveError 
 		 (NonPar (env,c',n,mkRel (nbpar-n+1), mkRel (l+nbpar))))
 
+let failwith_non_pos n ntypes c =
+  for k = n to n + ntypes - 1 do
+    if not (noccurn k c) then raise (IllFormedInd (LocalNonPos (k-n+1)))
+  done
+
 let failwith_non_pos_vect n ntypes v =
-  for i = 0 to Array.length v - 1 do
-    for k = n to n + ntypes - 1 do
-      if not (noccurn k v.(i)) then raise (IllFormedInd (LocalNonPos (k-n+1)))
-    done
-  done;
-  anomaly "failwith_non_pos_vect: some k in [n;n+ntypes-1] should occur in v"
+  Array.iter (failwith_non_pos n ntypes) v;
+  anomaly "failwith_non_pos_vect: some k in [n;n+ntypes-1] should occur"
+
+let failwith_non_pos_list n ntypes l =
+  List.iter (failwith_non_pos n ntypes) l;
+  anomaly "failwith_non_pos_list: some k in [n;n+ntypes-1] should occur"
 
 (* Check the inductive type is called with the expected parameters *)
 let check_correct_par (env,n,ntypes,_) hyps l largs =
@@ -303,6 +303,26 @@ let check_correct_par (env,n,ntypes,_) hyps l largs =
   if not (array_for_all (noccur_between n ntypes) largs') then 
     failwith_non_pos_vect n ntypes largs'
 
+(* Computes the maximum number of recursive parameters : 
+    the first parameters which are constant in recursive arguments 
+    n is the current depth, nmr is the maximum number of possible 
+    recursive parameters *)
+
+let compute_rec_par (env,n,_,_) hyps nmr largs = 
+if nmr = 0 then 0 else
+(* start from 0, hyps will be in reverse order *)
+  let (lpar,_) = list_chop nmr largs in
+  let rec find k index = 
+      function 
+	  ([],_) -> nmr
+	| (_,[]) -> assert false (* |hyps|>=nmr *)
+	| (lp,(_,Some _,_)::hyps) -> find k (index-1) (lp,hyps)
+	| (p::lp,_::hyps) ->
+       ( match kind_of_term (whd_betadeltaiota env p) with
+	  | Rel w when w = index -> find (k+1) (index-1) (lp,hyps)
+          | _ -> k)
+  in find 0 (n-1) (lpar,List.rev hyps)
+
 (* This removes global parameters of the inductive types in lc (for
    nested inductive types only ) *)
 let abstract_mind_lc env ntyps npars lc = 
@@ -326,9 +346,10 @@ let ienv_push_var (env, n, ntypes, lra) (x,a,ra) =
 
 let ienv_push_inductive (env, n, ntypes, ra_env) (mi,lpar) =
   let auxntyp = 1 in
+  let specif = lookup_mind_specif env mi in
   let env' =
     push_rel (Anonymous,None,
-              hnf_prod_applist env (type_of_inductive env mi) lpar) env in
+              hnf_prod_applist env (type_of_inductive 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
@@ -336,46 +357,50 @@ let ienv_push_inductive (env, n, ntypes, ra_env) (mi,lpar) =
   let newidx = n + auxntyp in
   (env', newidx, ntypes, ra_env')
 
+let array_min nmr a = if nmr = 0 then 0 else
+  Array.fold_left (fun k (nmri,_) -> min k nmri) nmr a
+
 (* The recursive function that checks positivity and builds the list
    of recursive arguments *)
 let check_positivity_one (env, _,ntypes,_ as ienv) hyps i indlc =
-  let nparams = rel_context_length hyps in
+  let lparams = rel_context_length hyps in
+  let nmr = rel_context_nhyps hyps in
   (* check the inductive types occur positively in [c] *)
-  let rec check_pos (env, n, ntypes, ra_env as ienv) c = 
+  let rec check_pos (env, n, ntypes, ra_env as ienv) nmr c = 
     let x,largs = decompose_app (whd_betadeltaiota env c) in
     match kind_of_term x with
       | Prod (na,b,d) ->
 	  assert (largs = []);
           (match weaker_noccur_between env n ntypes b with
-              None -> raise (IllFormedInd (LocalNonPos n));
+              None -> failwith_non_pos_list n ntypes [b]
             | Some b ->
-	        check_pos (ienv_push_var ienv (na, b, mk_norec)) d)
+	        check_pos (ienv_push_var ienv (na, b, mk_norec)) nmr d)
       | Rel k ->
-          let (ra,rarg) =
-            try List.nth ra_env (k-1)
-            with Failure _ | Invalid_argument _ -> (Norec,mk_norec) in
-          (match ra with
-              Mrec _ -> check_correct_par ienv hyps (k-n+1) largs
-            | _ ->
-                if not (List.for_all (noccur_between n ntypes) largs)
-	        then raise (IllFormedInd (LocalNonPos n)));
-          rarg
+           (try let (ra,rarg) = List.nth ra_env (k-1) in 
+		let nmr1 =
+	       (match ra with
+                 Mrec _ -> compute_rec_par ienv hyps nmr largs
+		  |  _ -> nmr)
+		in 
+		  if not (List.for_all (noccur_between n ntypes) largs)
+	          then failwith_non_pos_list n ntypes largs
+		  else (nmr1,rarg)
+            with Failure _ | Invalid_argument _ -> (nmr,mk_norec))
       | Ind ind_kn ->
           (* If the inductive type being defined appears in a
              parameter, then we have an imbricated type *)
-          if List.for_all (noccur_between n ntypes) largs then mk_norec
-          else check_positive_imbr ienv (ind_kn, largs)
+          if List.for_all (noccur_between n ntypes) largs then (nmr,mk_norec)
+          else check_positive_imbr ienv nmr (ind_kn, largs)
       | err -> 
 	  if noccur_between n ntypes x &&
              List.for_all (noccur_between n ntypes) largs 
-	  then mk_norec
-	  else raise (IllFormedInd (LocalNonPos n))
+	  then (nmr,mk_norec)
+	  else failwith_non_pos_list n ntypes (x::largs)
 
-  (* accesses to the environment are not factorised, but does it worth
-     it? *)
-  and check_positive_imbr (env,n,ntypes,ra_env as ienv) (mi, largs) =
+  (* accesses to the environment are not factorised, but is it worth? *)
+  and check_positive_imbr (env,n,ntypes,ra_env as ienv) nmr (mi, largs) =
     let (mib,mip) = lookup_mind_specif env mi in
-    let auxnpar = mip.mind_nparams in
+    let auxnpar = mib.mind_nparams_rec in
     let (lpar,auxlargs) =
       try list_chop auxnpar largs 
       with Failure _ -> raise (IllFormedInd (LocalNonPos n)) in 
@@ -393,31 +418,34 @@ let check_positivity_one (env, _,ntypes,_ as ienv) hyps i indlc =
     let (env',_,_,_ as ienv') = ienv_push_inductive ienv (mi,lpar) in
     (* Parameters expressed in env' *)
     let lpar' = List.map (lift auxntyp) lpar in
-    let irecargs = 
+    let irecargs_nmr = 
       (* fails if the inductive type occurs non positively *)
       (* when substituted *) 
       Array.map 
 	(function c -> 
 	  let c' = hnf_prod_applist env' c lpar' in 
-	  check_constructors ienv' false c') 
+	  check_constructors ienv' false nmr c') 
 	auxlcvect
+    in
+    let irecargs = Array.map snd irecargs_nmr
+    and nmr' = array_min nmr irecargs_nmr
     in 
-    (Rtree.mk_rec [|mk_paths (Imbr mi) irecargs|]).(0)
+    (nmr',(Rtree.mk_rec [|mk_paths (Imbr mi) irecargs|]).(0))
   
   (* check the inductive types occur positively in the products of C, if
      check_head=true, also check the head corresponds to a constructor of
      the ith type *) 
 
-  and check_constructors ienv check_head c = 
-    let rec check_constr_rec (env,n,ntypes,ra_env as ienv) lrec c = 
+  and check_constructors ienv check_head nmr c = 
+    let rec check_constr_rec (env,n,ntypes,ra_env as ienv) nmr lrec c = 
       let x,largs = decompose_app (whd_betadeltaiota env c) in
       match kind_of_term x with
 
         | Prod (na,b,d) -> 
 	    assert (largs = []);
-            let recarg = check_pos ienv b in 
+            let nmr',recarg = check_pos ienv nmr b in 
             let ienv' = ienv_push_var ienv (na,b,mk_norec) in
-	    check_constr_rec ienv' (recarg::lrec) d
+	    check_constr_rec ienv' nmr' (recarg::lrec) d
 
 	| hd ->
 	    if check_head then
@@ -428,32 +456,39 @@ let check_positivity_one (env, _,ntypes,_ as ienv) hyps i indlc =
 	    else
 	      if not (List.for_all (noccur_between n ntypes) largs)
               then raise (IllFormedInd (LocalNonPos n));
-	    List.rev lrec
-    in check_constr_rec ienv [] c
+	    (nmr,List.rev lrec)
+    in check_constr_rec ienv nmr [] c
   in
-  mk_paths (Mrec i)
-    (Array.map
+  let irecargs_nmr =
+     Array.map
       (fun c ->
-        let c = body_of_type c in
-        let sign, rawc = mind_extract_params nparams c in
-        let env' = push_rel_context sign env in
+        let _,rawc = mind_extract_params lparams c in
         try
-	  check_constructors ienv true rawc
+	  check_constructors ienv true nmr rawc
         with IllFormedInd err -> 
-	  explain_ind_err (ntypes-i) env nparams c err)
-      indlc)
+	  explain_ind_err (ntypes-i) env lparams c err)
+      indlc
+  in
+  let irecargs = Array.map snd irecargs_nmr
+  and nmr' = array_min nmr irecargs_nmr
+  in (nmr', mk_paths (Mrec i) irecargs)
 
-let check_positivity env_ar inds =
+let check_positivity env_ar params inds =
   let ntypes = Array.length inds in
   let lra_ind =
     List.rev (list_tabulate (fun j -> (Mrec j, Rtree.mk_param j)) ntypes) in
-  let check_one i (params,_,_,_,_,_,lc) =
-    let nparams = rel_context_length params in
+  let lparams = rel_context_length params in
+  let nmr = rel_context_nhyps params in
+  let check_one i (_,_,_,_,_,lc) =
     let ra_env =
-      list_tabulate (fun _ -> (Norec,mk_norec)) nparams @ lra_ind in
-    let ienv = (env_ar, 1+nparams, ntypes, ra_env) in
-    check_positivity_one ienv params i lc in
-  Rtree.mk_rec (Array.mapi check_one inds)
+      list_tabulate (fun _ -> (Norec,mk_norec)) lparams @ lra_ind in
+    let ienv = (env_ar, 1+lparams, ntypes, ra_env) in
+    check_positivity_one ienv params i lc 
+  in
+  let irecargs_nmr = Array.mapi check_one inds in 
+  let irecargs = Array.map snd irecargs_nmr
+  and nmr' = array_min nmr irecargs_nmr
+  in (nmr',Rtree.mk_rec irecargs)
 
 
 (************************************************************************)
@@ -480,67 +515,77 @@ let allowed_sorts env issmall isunit = function
       if issmall then all_sorts
       else impredicative_sorts
   | Prop Null -> 
-(* Added InType which is derivable :when the type is unit and small *)
-(* unit+small types have all elimination 
-   In predicative system, the 
-   other inductive definitions have only Prop elimination.
-   In impredicative system, large unit type have also Set elimination
-*)   if isunit then 
-	if issmall then all_sorts
-	else if Environ.engagement env = None 
-        then logical_sorts else impredicative_sorts
+(* 29/1/02: added InType which is derivable when the type is unit and small *)
+      if isunit then all_sorts
       else logical_sorts
 
-let build_inductive env env_ar record finite inds recargs cst =
+let fold_inductive_blocks f =
+  Array.fold_left (fun acc (_,ar,_,_,_,lc) -> f (Array.fold_left f acc lc) ar)
+
+let used_section_variables env inds =
+  let ids = fold_inductive_blocks
+    (fun l c -> Idset.union (Environ.global_vars_set env c) l)
+      Idset.empty inds in
+  keep_hyps env ids
+
+let build_inductive env env_ar params isrecord isfinite inds nmr recargs cst =
   let ntypes = Array.length inds in
   (* Compute the set of used section variables *)
-  let ids = 
-    Array.fold_left 
-      (fun acc (_,_,ar,_,_,_,lc) -> 
-	 Idset.union (Environ.global_vars_set env (body_of_type ar))
-	   (Array.fold_left
-	      (fun acc c ->
-                Idset.union (global_vars_set env (body_of_type c)) acc)
-	      acc
-	      lc))
-      Idset.empty inds in
-  let hyps = keep_hyps env ids in
+  let hyps =  used_section_variables env inds in
+  let nparamargs = rel_context_nhyps params in
   (* Check one inductive *)
-  let build_one_packet (params,id,ar,cnames,issmall,isunit,lc) recarg =
+  let build_one_packet (id,ar,cnames,issmall,isunit,lc) recarg =
     (* Arity in normal form *)
-    let nparamargs = rel_context_nhyps params in
     let (ar_sign,ar_sort) = dest_arity env ar in
-    let nf_ar =
-      if isArity (body_of_type ar) then ar
-      else it_mkProd_or_LetIn (mkSort ar_sort) ar_sign in
+    let nf_ar = if isArity ar then ar else mkArity (ar_sign,ar_sort) in
     (* Type of constructors in normal form *)
     let splayed_lc = Array.map (dest_prod_assum env_ar) lc in
-    let nf_lc =
-      array_map2 (fun (d,b) c -> it_mkProd_or_LetIn b d) splayed_lc lc in
+    let nf_lc = Array.map (fun (d,b) -> it_mkProd_or_LetIn b d) splayed_lc in
     let nf_lc = if nf_lc = lc then lc else nf_lc in
+    let consnrealargs =
+      Array.map (fun (d,_) -> rel_context_length d - rel_context_length params)
+	splayed_lc in
     (* Elimination sorts *)
     let isunit = isunit && ntypes = 1 && (not (is_recursive recargs.(0))) in
     let kelim = allowed_sorts env issmall isunit ar_sort in
+    let nconst, nblock = ref 0, ref 0 in 
+    let transf num =
+      let arity = List.length (dest_subterms recarg).(num) in
+      if arity = 0 then 
+	let p  = (!nconst, 0) in
+	incr nconst; p
+      else 
+	let p = (!nblock + 1, arity) in
+	incr nblock; p
+     (* les tag des constructeur constant commence a 0,
+	les tag des constructeur non constant a 1 (0 => accumulator) *)
+    in 
+    let rtbl = Array.init (List.length cnames) transf in
     (* Build the inductive packet *)
     { mind_typename = id;
-      mind_nparams = nparamargs;
-      mind_params_ctxt = params;
       mind_user_arity  = ar;
       mind_nf_arity = nf_ar;
       mind_nrealargs = rel_context_nhyps ar_sign - nparamargs;
       mind_sort = ar_sort;
       mind_kelim = kelim;
       mind_consnames = Array.of_list cnames;
+      mind_consnrealdecls = consnrealargs;
       mind_user_lc = lc;
       mind_nf_lc = nf_lc;
-      mind_recargs = recarg;
+      mind_recargs = recarg;    
+      mind_nb_constant = !nconst;
+      mind_nb_args = !nblock;
+      mind_reloc_tbl = rtbl;
     } in
   let packets = array_map2 build_one_packet inds recargs in
   (* Build the mutual inductive *)
-  { mind_record = record;
+  { mind_record = isrecord;
     mind_ntypes = ntypes;
-    mind_finite = finite;
+    mind_finite = isfinite;
     mind_hyps = hyps;
+    mind_nparams = nparamargs;
+    mind_nparams_rec = nmr;  
+    mind_params_ctxt = params;
     mind_packets = packets;
     mind_constraints = cst;
     mind_equiv = None;
@@ -551,10 +596,9 @@ let build_inductive env env_ar record finite inds recargs cst =
 
 let check_inductive env mie =
   (* First type-check the inductive definition *)
-  let (env_arities, inds, cst) = typecheck_inductive env mie in
+  let (env_ar, params, inds, cst) = typecheck_inductive env mie in
   (* Then check positivity conditions *)
-  let recargs = check_positivity env_arities inds in
+  let (nmr,recargs) = check_positivity env_ar params inds in
   (* Build the inductive packets *)
-  build_inductive env env_arities mie.mind_entry_record mie.mind_entry_finite 
-    inds recargs cst
-
+  build_inductive env env_ar params mie.mind_entry_record mie.mind_entry_finite 
+    inds nmr recargs cst
diff --git a/kernel/indtypes.mli b/kernel/indtypes.mli
index f5e6d047..67d11f56 100644
--- a/kernel/indtypes.mli
+++ b/kernel/indtypes.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: indtypes.mli,v 1.23.8.1 2004/07/16 19:30:25 herbelin Exp $ i*)
+(*i $Id: indtypes.mli 7660 2005-12-17 21:13:48Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -22,8 +22,8 @@ open Typeops
 (*s The different kinds of errors that may result of a malformed inductive
   definition. *)
 
+(* Errors related to inductive constructions *)
 type inductive_error =
-  (* These are errors related to inductive constructions in this module *)
   | NonPos of env * constr * constr
   | NotEnoughArgs of env * constr * constr
   | NotConstructor of env * constr * constr
@@ -33,10 +33,6 @@ type inductive_error =
   | SameNamesOverlap of identifier list
   | NotAnArity of identifier
   | BadEntry
-  (* These are errors related to recursors building in Indrec *)
-  | NotAllowedCaseAnalysis of bool * sorts * inductive
-  | BadInduction of bool * identifier * sorts
-  | NotMutualInScheme
 
 exception InductiveError of inductive_error
 
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 07e9b8ea..736f4da1 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: inductive.ml,v 1.74.2.2 2004/07/16 19:30:25 herbelin Exp $ *)
+(* $Id: inductive.ml 8673 2006-03-29 21:21:52Z herbelin $ *)
 
 open Util
 open Names
@@ -18,6 +18,8 @@ open Environ
 open Reduction
 open Type_errors
 
+type mind_specif = mutual_inductive_body * one_inductive_body
+
 (* raise Not_found if not an inductive type *)
 let lookup_mind_specif env (kn,tyi) =
   let mib = Environ.lookup_mind kn env in
@@ -57,13 +59,10 @@ let ind_subst mind mib =
 (* Instantiate inductives in constructor type *)
 let constructor_instantiate mind mib c =
   let s = ind_subst mind mib in
-  type_app (substl s) c
+  substl s c
 
-(* Instantiate the parameters of the inductive type *)
-(* TODO: verify the arg of LetIn correspond to the value in the
-   signature ? *)
-let instantiate_params t args sign =
-  let fail () =
+let instantiate_params full t args sign =
+  let fail () = 
     anomaly "instantiate_params: type, ctxt and args mismatch" in
   let (rem_args, subs, ty) =
     Sign.fold_rel_context
@@ -71,38 +70,134 @@ let instantiate_params t args sign =
         match (copt, largs, kind_of_term ty) with
           | (None, a::args, Prod(_,_,t)) -> (args, a::subs, t)
           | (Some b,_,LetIn(_,_,_,t))    -> (largs, (substl subs b)::subs, t)
-	  | _                            -> fail())
+	  | (_,[],_)                -> if full then fail() else ([], subs, ty)
+	  | _                       -> fail ())
       sign
       ~init:(args,[],t) 
   in
   if rem_args <> [] then fail();
-  type_app (substl subs) ty
+  substl subs ty
+
+let instantiate_partial_params = instantiate_params false
 
-let full_inductive_instantiate mip params t =
-  instantiate_params t params mip.mind_params_ctxt
+let full_inductive_instantiate mib params t =
+  instantiate_params true t params mib.mind_params_ctxt
 
-let full_constructor_instantiate (((mind,_),mib,mip),params) =
+let full_constructor_instantiate (((mind,_),mib,_),params) =
   let inst_ind = constructor_instantiate mind mib in
   (fun t ->
-    instantiate_params (inst_ind t) params mip.mind_params_ctxt)
+    instantiate_params true (inst_ind t) params mib.mind_params_ctxt)
 
 (************************************************************************)
 (************************************************************************)
 
 (* Functions to build standard types related to inductive *)
 
+(* For each inductive type of a block that is of level u_i, we have
+   the constraints that u_i >= v_i where v_i is the type level of the
+   types of the constructors of this inductive type. Each v_i depends
+   of some of the u_i and of an extra (maybe non variable) universe,
+   say w_i. Typically, for three inductive types, we could have
+
+   u1,u2,u3,w1 <= u1
+   u1       w2 <= u2
+      u2,u3,w3 <= u3
+
+   From this system of inequations, we shall deduce
+
+   w1,w2,w3 <= u1
+   w1,w2 <= u2
+   w1,w2,w3 <= u3
+*)   
+
+let number_of_inductives mib = Array.length mib.mind_packets
+let number_of_constructors mip = Array.length mip.mind_consnames
+
+(* 
+Computing the actual sort of an applied or partially applied inductive type:
+
+I_i: forall uniformparams:utyps, forall otherparams:otyps, Type(a)
+uniformargs : utyps 
+otherargs : otyps
+I_1:forall ...,s_1;...I_n:forall ...,s_n |- sort(C_kj(uniformargs)) = s_kj
+s'_k = max(..s_kj..)
+merge(..s'_k..) = ..s''_k..
+--------------------------------------------------------------------
+Gamma |- I_i uniformargs otherargs : phi(s''_i)
+
+where
+
+- if p=0, phi() = Prop
+- if p=1, phi(s) = s
+- if p<>1, phi(s) = sup(Set,s)
+
+Remark: Set (predicative) is encoded as Type(0)
+*)
+
+let find_constraint levels level_bounds i nci =
+  if nci = 0 then mk_Prop
+  else
+    let level_bounds' = solve_constraints_system levels level_bounds in
+    let level = level_bounds'.(i) in
+    if nci = 1 & is_empty_universe level then mk_Prop
+    else if Univ.is_base level then mk_Set else Type level
+
+let find_inductive_level env (mib,mip) (_,i) levels level_bounds =
+  find_constraint levels level_bounds i (number_of_constructors mip)
+
+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 constructor_instances env (mib,mip) (_,i) args =
+  let nargs = Array.length args in
+  let args = Array.to_list args in
+  let uargs = 
+    if nargs > mib.mind_nparams_rec then
+      fst (list_chop mib.mind_nparams_rec args)
+    else args in
+  let arities =
+    Array.map (fun mip -> destArity mip.mind_nf_arity) mib.mind_packets in
+  (* Compute the minimal type *)
+  let levels = Array.init 
+    (number_of_inductives mib) (fun _ -> fresh_local_univ ()) in
+  let arities = list_tabulate (fun i -> 
+    let ctx,s = arities.(i) in
+    let s = match s with Type _ -> Type (levels.(i)) | s -> s in
+    (Name mib.mind_packets.(i).mind_typename,None,mkArity (ctx,s)))
+    (number_of_inductives mib) in
+             (* Remark: all arities are closed hence no need for lift *)
+  let env_ar = push_rel_context (List.rev arities) env in
+  let uargs = List.map (lift (number_of_inductives mib)) uargs in
+  let lc =
+    Array.map (fun mip ->
+        Array.map (fun c -> 
+	    instantiate_partial_params c uargs mib.mind_params_ctxt)
+          mip.mind_nf_lc)
+      mib.mind_packets in
+  env_ar, lc, levels
+
+let is_small_inductive (mip,mib) = is_small (snd (destArity mib.mind_nf_arity))
+
+let max_inductive_sort v =
+  let v = Array.map (function
+    | Type u -> u
+    | _ -> anomaly "Only type levels when computing the minimal sort of an inductive type") v in
+  Univ.sup_array v
+
 (* Type of an inductive type *)
 
-let type_of_inductive env i =
-  let (_,mip) = lookup_mind_specif env i in
-  mip.mind_user_arity
+let type_of_inductive (_,mip) = mip.mind_user_arity
 
 (************************************************************************)
 (* Type of a constructor *)
 
-let type_of_constructor env cstr =
+let type_of_constructor cstr (mib,mip) =
   let ind = inductive_of_constructor cstr in
-  let (mib,mip) = lookup_mind_specif env ind in
   let specif = mip.mind_user_lc in
   let i = index_of_constructor cstr in
   let nconstr = Array.length mip.mind_consnames in
@@ -113,8 +208,8 @@ let arities_of_specif kn (mib,mip) =
   let specif = mip.mind_nf_lc in
   Array.map (constructor_instantiate kn mib) specif
 
-let arities_of_constructors env ind = 
-  arities_of_specif (fst ind) (lookup_mind_specif env ind)
+let arities_of_constructors ind specif = 
+  arities_of_specif (fst ind) specif
 
 
 
@@ -149,23 +244,28 @@ let local_rels ctxt =
   rels
 
 (* Get type of inductive, with parameters instantiated *)
-let get_arity mip params =
+let get_arity mib mip params =
   let arity = mip.mind_nf_arity in
-  destArity (full_inductive_instantiate mip params arity)
+  destArity (full_inductive_instantiate mib params arity)
 
-let build_dependent_inductive ind mip params =
-  let arsign,_ = get_arity mip params in
+let rel_list n m = 
+  let rec reln l p = 
+    if p>m then l else reln (mkRel(n+p)::l) (p+1)
+  in 
+  reln [] 1
+
+let build_dependent_inductive ind mib mip params =
   let nrealargs = mip.mind_nrealargs in
   applist 
-    (mkInd ind, (List.map (lift nrealargs) params)@(local_rels arsign))
+    (mkInd ind, (List.map (lift nrealargs) params)@(rel_list 0 nrealargs))
 
 
 (* This exception is local *)
 exception LocalArity of (constr * constr * arity_error) option
 
-let is_correct_arity env c pj ind mip params = 
+let is_correct_arity env c pj ind mib mip params = 
   let kelim = mip.mind_kelim in
-  let arsign,s = get_arity mip params in
+  let arsign,s = get_arity mib mip params in
   let nodep_ar = it_mkProd_or_LetIn (mkSort s) arsign in
   let rec srec env pt t u =
     let pt' = whd_betadeltaiota env pt in
@@ -181,7 +281,9 @@ let is_correct_arity env c pj ind mip params =
           let ksort = match kind_of_term k with
             | Sort s -> family_of_sort s 
 	    | _ -> raise (LocalArity None) in
-	  let dep_ind = build_dependent_inductive ind mip params in
+
+	  let dep_ind = build_dependent_inductive ind mib mip params
+	  in 
           let univ =
             try conv env a1 dep_ind
             with NotConvertible -> raise (LocalArity None) in
@@ -225,7 +327,7 @@ let build_branches_type ind mib mip params dep p =
     let (args,ccl) = decompose_prod_assum typi in
     let nargs = rel_context_length args in
     let (_,allargs) = decompose_app ccl in
-    let (lparams,vargs) = list_chop mip.mind_nparams allargs in
+    let (lparams,vargs) = list_chop mib.mind_nparams allargs in
     let cargs =
       if dep then
         let cstr = ith_constructor_of_inductive ind (i+1) in
@@ -245,10 +347,10 @@ let build_case_type dep p c realargs =
 
 let type_case_branches env (ind,largs) pj c =
   let (mib,mip) = lookup_mind_specif env ind in 
-  let nparams = mip.mind_nparams in
+  let nparams = mib.mind_nparams in
   let (params,realargs) = list_chop nparams largs in
   let p = pj.uj_val in
-  let (dep,univ) = is_correct_arity env c pj ind mip params in
+  let (dep,univ) = is_correct_arity env c pj ind mib mip params in
   let lc = build_branches_type ind mib mip params dep p in
   let ty = build_case_type dep p c realargs in
   (lc, ty, univ)
@@ -257,11 +359,22 @@ let type_case_branches env (ind,largs) pj c =
 (************************************************************************)
 (* Checking the case annotation is relevent *)
 
+let rec inductive_kn_equiv env kn1 kn2 =
+  match (lookup_mind kn1 env).mind_equiv with
+    | Some kn1' -> inductive_kn_equiv env kn2 kn1'
+    | None -> match (lookup_mind kn2 env).mind_equiv with
+        | Some kn2' -> inductive_kn_equiv env kn2' kn1
+	| None -> false
+
+let inductive_equiv env (kn1,i1) (kn2,i2) =
+  i1=i2 & inductive_kn_equiv env kn1 kn2
+
 let check_case_info env indsp ci =
   let (mib,mip) = lookup_mind_specif env indsp in
   if
     (indsp <> ci.ci_ind) or
-    (mip.mind_nparams <> ci.ci_npar)
+    (mib.mind_nparams <> ci.ci_npar) or
+    (mip.mind_consnrealdecls <> ci.ci_cstr_nargs)
   then raise (TypeError(env,WrongCaseInfo(indsp,ci)))
 
 (************************************************************************)
@@ -416,7 +529,7 @@ let inductive_of_fix env recarg body =
    subterm_specif env c ind 
 
    subterm_specif should test if [c] (building objects of inductive
-   type [ind], not necassarily the same as that of the recursive
+   type [ind], not necessarily the same as that of the recursive
    argument) is a subterm of the recursive argument of the fixpoint we
    are checking and fails with Not_found if not. In case it is, it
    should send its recursive specification (i.e. on which arguments we
@@ -584,7 +697,6 @@ let check_one_fix renv recpos def =
       | Fix ((recindxs,i),(_,typarray,bodies as recdef)) ->
           List.for_all (check_rec_call renv) l &&
           array_for_all (check_rec_call renv) typarray && 
-	  let nbfix = Array.length typarray in
           let decrArg = recindxs.(i) in
           let renv' = push_fix_renv renv recdef in 
           if (List.length l < (decrArg+1)) then
@@ -604,7 +716,7 @@ let check_one_fix renv recpos def =
                 bodies in
             array_for_all (fun b -> b) ok_vect
 
-      | Const kn as c -> 
+      | Const kn -> 
           (try List.for_all (check_rec_call renv) l
            with (FixGuardError _ ) as e ->
              if evaluable_constant kn renv.env then 
@@ -614,7 +726,7 @@ let check_one_fix renv recpos def =
 
       (* The cases below simply check recursively the condition on the
          subterms *)
-      | Cast (a,b) -> 
+      | Cast (a,_, b) -> 
           List.for_all (check_rec_call renv) (a::b::l)
 
       | Lambda (x,a,b) ->
@@ -668,8 +780,8 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
     or bodynum >= nbfix
   then anomaly "Ill-formed fix term";
   let fixenv = push_rec_types recdef env in
-  let raise_err i err =
-    error_ill_formed_rec_body fixenv err names i in
+  let raise_err env i err =
+    error_ill_formed_rec_body env err names i in
   (* Check the i-th definition with recarg k *)
   let find_ind i k def = 
     if k < 0 then anomaly "negative recarg position";
@@ -684,18 +796,19 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
                 (* get the inductive type of the fixpoint *)
                 let (mind, _) = 
                   try find_inductive env a 
-                  with Not_found -> raise_err i RecursionNotOnInductiveType in
+                  with Not_found ->
+		    raise_err env i (RecursionNotOnInductiveType a) in
                 (mind, (env', b))
 	      else check_occur env' (n+1) b
             else anomaly "check_one_fix: Bad occurrence of recursive call"
-        | _ -> raise_err i NotEnoughAbstractionInFixBody in
+        | _ -> raise_err env i NotEnoughAbstractionInFixBody in
     check_occur fixenv 1 def in
   (* Do it on every fixpoint *)
   let rv = array_map2_i find_ind nvect bodies in
   (Array.map fst rv, Array.map snd rv)
 
 
-let check_fix env ((nvect,_),(names,_,bodies as recdef) as fix) =
+let check_fix env ((nvect,_),(names,_,bodies as _recdef) as fix) =
   let (minds, rdef) = inductive_of_mutfix env fix in
   for i = 0 to Array.length bodies - 1 do
     let (fenv,body) = rdef.(i) in
@@ -760,7 +873,7 @@ let check_one_cofix env nbfix def deftype =
             let lra =vlra.(i-1) in 
             let mI = inductive_of_constructor cstr_kn in
 	    let (mib,mip) = lookup_mind_specif env mI in
-            let realargs = list_skipn mip.mind_nparams args in
+            let realargs = list_skipn mib.mind_nparams args in
             let rec process_args_of_constr = function
               | (t::lr), (rar::lrar) -> 
                   if rar = mk_norec then
diff --git a/kernel/inductive.mli b/kernel/inductive.mli
index 04345621..e60f909e 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,v 1.57.8.2 2005/01/21 16:41:49 herbelin Exp $ i*)
+(*i $Id: inductive.mli 8673 2006-03-29 21:21:52Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -28,24 +28,24 @@ val find_rectype     : env -> types -> inductive * constr list
 val find_inductive   : env -> types -> inductive * constr list
 val find_coinductive : env -> types -> inductive * constr list
 
+type mind_specif = mutual_inductive_body * one_inductive_body
+
 (*s Fetching information in the environment about an inductive type.
     Raises [Not_found] if the inductive type is not found. *)
-val lookup_mind_specif :
-  env -> inductive -> mutual_inductive_body * one_inductive_body
+val lookup_mind_specif : env -> inductive -> mind_specif
 
 (*s Functions to build standard types related to inductive *)
 
-val type_of_inductive    : env -> inductive -> types
+val type_of_inductive : mind_specif -> types
 
 (* Return type as quoted by the user *)
-val type_of_constructor  : env -> constructor -> types
+val type_of_constructor : constructor -> mind_specif -> types
 
 (* Return constructor types in normal form *)
-val arities_of_constructors : env -> inductive -> types array
+val arities_of_constructors : inductive -> mind_specif -> types array
 
 (* Transforms inductive specification into types (in nf) *)
-val arities_of_specif : mutual_inductive -> 
-  mutual_inductive_body * one_inductive_body -> types array 
+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:
@@ -69,3 +69,17 @@ val scrape_mind : env -> mutual_inductive -> mutual_inductive
 (*s Guard conditions for fix and cofix-points. *)
 val check_fix : env -> fixpoint -> unit
 val check_cofix : env -> cofixpoint -> unit
+
+(*s Support for sort-polymorphic inductive types *)
+
+val constructor_instances : env -> mind_specif -> inductive -> 
+  constr array -> env * types array array * universe array
+
+val set_inductive_level : env -> sorts -> types -> types
+
+val find_inductive_level : env -> mind_specif -> inductive -> 
+  universe array -> universe array -> sorts
+
+val is_small_inductive : mind_specif -> bool
+
+val max_inductive_sort : sorts array -> universe
diff --git a/kernel/make-opcodes b/kernel/make-opcodes
new file mode 100644
index 00000000..c8f573c6
--- /dev/null
+++ b/kernel/make-opcodes
@@ -0,0 +1,2 @@
+$1=="enum" {n=0; next; }
+           {for (i = 1; i <= NF; i++) {printf("let op%s = %d\n", $i, n++);}}
diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml
new file mode 100644
index 00000000..6d2064bf
--- /dev/null
+++ b/kernel/mod_subst.ml
@@ -0,0 +1,260 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: mod_subst.ml 7538 2005-11-08 17:14:52Z herbelin $ *)
+
+open Pp
+open Util
+open Names
+open Term
+
+(* WARNING: not every constant in the associative list domain used to exist
+   in the environment. This allows a simple implementation of the join
+   operation. However, iterating over the associative list becomes a non-sense
+*)
+type resolver = (constant * constr option) list
+
+let make_resolver resolve = resolve
+
+let apply_opt_resolver resolve kn =
+ match resolve with
+    None -> None
+  | Some resolve ->
+     try List.assoc kn resolve with Not_found -> assert false
+
+type substitution_domain = MSI of mod_self_id | MBI of mod_bound_id
+
+let string_of_subst_domain = function
+   MSI msid -> debug_string_of_msid msid
+ | MBI mbid -> debug_string_of_mbid mbid
+
+module Umap = Map.Make(struct 
+			 type t = substitution_domain
+			 let compare = Pervasives.compare
+		       end)
+
+type substitution = (module_path * resolver option) Umap.t
+
+let empty_subst = Umap.empty
+
+let add_msid msid mp =
+  Umap.add (MSI msid) (mp,None)
+let add_mbid mbid mp resolve =
+  Umap.add (MBI mbid) (mp,resolve)
+
+let map_msid msid mp = add_msid msid mp empty_subst
+let map_mbid mbid mp resolve = add_mbid mbid mp resolve empty_subst
+
+let list_contents sub = 
+  let one_pair uid (mp,_) l =
+    (string_of_subst_domain uid, string_of_mp mp)::l
+  in
+    Umap.fold one_pair sub []
+
+let debug_string_of_subst sub = 
+  let l = List.map (fun (s1,s2) -> s1^"|->"^s2) (list_contents sub) in
+    "{" ^ String.concat "; " l ^ "}"
+
+let debug_pr_subst sub = 
+  let l = list_contents sub in
+  let f (s1,s2) = hov 2 (str s1 ++ spc () ++ str "|-> " ++ str s2) 
+  in
+    str "{" ++ hov 2 (prlist_with_sep pr_coma f l) ++ str "}" 
+
+let subst_mp0 sub mp = (* 's like subst *)
+ let rec aux mp =
+  match mp with
+    | MPself sid -> 
+        let mp',resolve = Umap.find (MSI sid) sub in
+         mp',resolve
+    | MPbound bid ->
+        let mp',resolve = Umap.find (MBI bid) sub in
+         mp',resolve
+    | MPdot (mp1,l) -> 
+	let mp1',resolve = aux mp1 in
+	 MPdot (mp1',l),resolve
+    | _ -> raise Not_found
+ in
+  try Some (aux mp) with Not_found -> None
+
+let subst_mp sub mp =
+ match subst_mp0 sub mp with
+    None -> mp
+  | Some (mp',_) -> mp'
+
+
+let subst_kn0 sub kn =
+ let mp,dir,l = repr_kn kn in
+  match subst_mp0 sub mp with
+     Some (mp',_) ->
+      Some (make_kn mp' dir l)
+   | None -> None
+
+let subst_kn sub kn =
+ match subst_kn0 sub kn with
+    None -> kn
+  | Some kn' -> kn'
+
+let subst_con sub con =
+ let mp,dir,l = repr_con con in
+  match subst_mp0 sub mp with
+     None -> con,mkConst con
+   | Some (mp',resolve) ->
+      let con' = make_con mp' dir l in
+       match apply_opt_resolver resolve con with
+          None -> con',mkConst con'
+        | Some t -> con',t
+
+(* Here the semantics is completely unclear.
+   What does "Hint Unfold t" means when "t" is a parameter?
+   Does the user mean "Unfold X.t" or does she mean "Unfold y"
+   where X.t is later on instantiated with y? I choose the first
+   interpretation (i.e. an evaluable reference is never expanded). *)
+let subst_evaluable_reference subst = function
+  | EvalVarRef id -> EvalVarRef id
+  | EvalConstRef kn -> EvalConstRef (fst (subst_con subst kn))
+
+(* 
+This should be rewritten to prevent duplication of constr's when not
+necessary.
+For now, it uses map_constr and is rather ineffective
+*)
+
+let rec map_kn f f' c = 
+  let func = map_kn f f' in
+    match kind_of_term c with
+      | Const kn -> f' kn
+      | Ind (kn,i) -> 
+         (match f kn with
+             None -> c
+           | Some kn' ->
+	      mkInd (kn',i))
+      | Construct ((kn,i),j) -> 
+         (match f kn with
+             None -> c
+           | Some kn' ->
+	      mkConstruct ((kn',i),j))
+      | Case (ci,p,c,l) ->
+	  let ci' =
+           { ci with
+              ci_ind =
+               let (kn,i) = ci.ci_ind in
+                match f kn with None -> ci.ci_ind | Some kn' -> kn',i } in
+	  mkCase (ci', func p, func c, array_smartmap func l) 
+      | _ -> map_constr func c
+
+let subst_mps sub = 
+  map_kn (subst_kn0 sub) (fun con -> snd (subst_con sub con))
+
+let rec replace_mp_in_mp mpfrom mpto mp =
+  match mp with
+    | _ when mp = mpfrom -> mpto
+    | MPdot (mp1,l) -> 
+	let mp1' = replace_mp_in_mp mpfrom mpto mp1 in
+	  if mp1==mp1' then mp
+	  else MPdot (mp1',l)
+    | _ -> mp
+
+let replace_mp_in_con mpfrom mpto kn =
+ let mp,dir,l = repr_con kn in
+  let mp'' = replace_mp_in_mp mpfrom mpto mp in
+    if mp==mp'' then kn
+    else make_con mp'' dir l
+
+exception BothSubstitutionsAreIdentitySubstitutions
+exception ChangeDomain of resolver
+
+let join (subst1 : substitution) (subst2 : substitution) = 
+  let apply_subst (sub : substitution) key (mp,resolve) =
+   let mp',resolve' =
+    match subst_mp0 sub mp with
+       None -> mp, None
+     | Some (mp',resolve') -> mp',resolve' in
+   let resolve'' : resolver option =
+    try
+     let res =
+      match resolve with
+         Some res -> res
+       | None ->
+          match resolve' with
+             None -> raise BothSubstitutionsAreIdentitySubstitutions
+           | Some res -> raise (ChangeDomain res)
+     in
+      Some
+       (List.map
+         (fun (kn,topt) ->
+           kn,
+           match topt with
+              None ->
+               (match key with
+                   MSI msid ->
+                    let kn' = replace_mp_in_con (MPself msid) mp kn in
+                     apply_opt_resolver resolve' kn'
+                 | MBI mbid ->
+                    let kn' = replace_mp_in_con (MPbound mbid) mp kn in
+                     apply_opt_resolver resolve' kn')
+            | Some t -> Some (subst_mps sub t)) res)
+    with
+       BothSubstitutionsAreIdentitySubstitutions -> None
+     | ChangeDomain res ->
+        Some
+         ((List.map
+            (fun (kn,topt) ->
+              let key' =
+               match key with
+                  MSI msid -> MPself msid
+                | MBI mbid -> MPbound mbid in
+              (* let's replace mp with key in kn *)
+              let kn' = replace_mp_in_con mp key' kn in
+               kn',topt)) res)
+   in
+    mp',resolve'' in
+  let subst = Umap.mapi (apply_subst subst2) subst1 in
+  Umap.fold Umap.add subst2 subst
+
+let rec occur_in_path uid path =
+ match uid,path with
+  | MSI sid,MPself sid' -> sid = sid'
+  | MBI bid,MPbound bid' -> bid = bid'
+  | _,MPdot (mp1,_) -> occur_in_path uid mp1
+  | _ -> false
+    
+let occur_uid uid sub = 
+  let check_one uid' (mp,_) =
+    if uid = uid' || occur_in_path uid mp then raise Exit
+  in
+    try 
+      Umap.iter check_one sub;
+      false
+    with Exit -> true
+
+let occur_msid uid = occur_uid (MSI uid)
+let occur_mbid uid = occur_uid (MBI uid)
+    
+type 'a lazy_subst =
+  | LSval of 'a
+  | LSlazy of substitution * 'a
+	
+type 'a substituted = 'a lazy_subst ref
+      
+let from_val a = ref (LSval a)
+    
+let force fsubst r = 
+  match !r with
+  | LSval a -> a
+  | LSlazy(s,a) -> 
+      let a' = fsubst s a in
+      r := LSval a';
+      a' 
+
+let subst_substituted s r =
+  match !r with
+  | LSval a -> ref (LSlazy(s,a))
+  | LSlazy(s',a) ->
+      let s'' = join s' s in
+      ref (LSlazy(s'',a))
diff --git a/kernel/mod_subst.mli b/kernel/mod_subst.mli
new file mode 100644
index 00000000..a7915a24
--- /dev/null
+++ b/kernel/mod_subst.mli
@@ -0,0 +1,80 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: mod_subst.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
+
+(*s [Mod_subst] *)
+
+open Names
+open Term
+
+type resolver
+type substitution
+
+val make_resolver :  (constant * constr option) list -> resolver
+
+val empty_subst : substitution
+
+val add_msid : 
+  mod_self_id -> module_path -> substitution -> substitution
+val add_mbid : 
+  mod_bound_id -> module_path -> resolver option -> substitution -> substitution
+
+val map_msid :
+  mod_self_id -> module_path -> substitution
+val map_mbid :
+  mod_bound_id -> module_path -> resolver option -> substitution
+
+(* sequential composition: 
+   [substitute (join sub1 sub2) t = substitute sub2 (substitute sub1 t)]
+*)
+val join : substitution -> substitution -> substitution
+
+type 'a substituted
+val from_val : 'a -> 'a substituted
+val force : (substitution -> 'a -> 'a) -> 'a substituted -> 'a
+val subst_substituted : substitution -> 'a substituted -> 'a substituted
+
+(*i debugging *)
+val debug_string_of_subst : substitution -> string
+val debug_pr_subst : substitution -> Pp.std_ppcmds
+(*i*)
+
+(* [subst_mp sub mp] guarantees that whenever the result of the
+   substitution is structutally equal [mp], it is equal by pointers 
+   as well [==] *) 
+
+val subst_mp : 
+  substitution -> module_path -> module_path
+
+val subst_kn :
+  substitution -> kernel_name -> kernel_name
+
+val subst_con :
+  substitution -> constant -> constant * constr
+
+(* Here the semantics is completely unclear.
+   What does "Hint Unfold t" means when "t" is a parameter?
+   Does the user mean "Unfold X.t" or does she mean "Unfold y"
+   where X.t is later on instantiated with y? I choose the first
+   interpretation (i.e. an evaluable reference is never expanded). *)
+val subst_evaluable_reference :
+  substitution -> evaluable_global_reference -> evaluable_global_reference
+
+(* [replace_mp_in_con mp mp' con] replaces [mp] with [mp'] in [con] *)
+val replace_mp_in_con : module_path -> module_path -> constant -> constant
+
+(* [subst_mps sub c] performs the substitution [sub] on all kernel
+   names appearing in [c] *)
+val subst_mps : substitution -> constr -> constr
+
+(* [occur_*id id sub] returns true iff [id] occurs in [sub] 
+   on either side *)
+
+val occur_msid : mod_self_id -> substitution -> bool
+val occur_mbid : mod_bound_id -> substitution -> bool
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index 5e8c7001..a8aff184 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,v 1.11.2.1 2004/07/16 19:30:26 herbelin Exp $ i*)
+(*i $Id: mod_typing.ml 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 open Util
 open Names
@@ -17,6 +17,7 @@ open Environ
 open Term_typing
 open Modops
 open Subtyping
+open Mod_subst
 
 exception Not_path
 
@@ -65,8 +66,9 @@ and merge_with env mtb with_decl =
     | MTBsig(msid,sig_b) -> msid,sig_b 
     | _ -> error_signature_expected mtb
   in
-  let id = match with_decl with 
-    | With_Definition (id,_) | With_Module (id,_) -> id
+  let id,idl = match with_decl with 
+    | With_Definition (id::idl,_) | With_Module (id::idl,_) -> id,idl
+    | With_Definition ([],_) | With_Module ([],_) -> assert false
   in
   let l = label_of_id id in
     try
@@ -74,7 +76,9 @@ and merge_with env mtb with_decl =
       let before = List.rev rev_before in
       let env' = Modops.add_signature (MPself msid) before env in
       let new_spec = match with_decl with
-	| With_Definition (id,c) -> 
+        | With_Definition ([],_)
+        | With_Module ([],_) -> assert false
+	| With_Definition ([id],c) -> 
 	    let cb = match spec with
 		SPBconst cb -> cb
 	      | _ -> error_not_a_constant l
@@ -88,21 +92,25 @@ and merge_with env mtb with_decl =
 		      let cst = 
 			Constraint.union 
 			  (Constraint.union cb.const_constraints cst1)
-			  cst2
-		      in
+			  cst2 in
+                      let body = Some (Declarations.from_val j.uj_val) in
 			SPBconst {cb with 
-				    const_body = 
-				      Some (Declarations.from_val j.uj_val);
-				    const_constraints = cst}
+				    const_body = body;
+			            const_body_code = Cemitcodes.from_val
+                        (compile_constant_body env' body false false);
+                                    const_constraints = cst}
 		  | Some b -> 
 		      let cst1 = Reduction.conv env' c (Declarations.force b) in
 		      let cst = Constraint.union cb.const_constraints cst1 in
+                      let body = Some (Declarations.from_val c) in
 			SPBconst {cb with 
-				    const_body = Some (Declarations.from_val c);
-				    const_constraints = cst}
+				    const_body = body;
+				    const_body_code = Cemitcodes.from_val
+                        (compile_constant_body env' body false false);
+                                    const_constraints = cst}
 	      end	
 (* and what about msid's ????? Don't they clash ? *)
-	| With_Module (id, mp) ->
+	| With_Module ([id], mp) ->
 	    let old = match spec with
 		SPBmodule msb -> msb
 	      | _ -> error_not_a_module (string_of_label l)
@@ -133,6 +141,29 @@ and merge_with env mtb with_decl =
 	       msb_constraints = Constraint.union old.msb_constraints cst }
 	    in
 	      SPBmodule msb
+	| With_Definition (_::_,_)
+        | With_Module (_::_,_) -> 
+	    let old = match spec with
+		SPBmodule msb -> msb
+	      | _ -> error_not_a_module (string_of_label l)
+	    in
+	      begin
+		match old.msb_equiv with
+                   None ->
+                    let new_with_decl = match with_decl with
+                       With_Definition (_,c) -> With_Definition (idl,c)
+                     | With_Module (_,c) -> With_Module (idl,c) in
+                    let modtype = 
+                     merge_with env' old.msb_modtype new_with_decl in
+                    let msb =
+	              {msb_modtype = modtype; 
+	               msb_equiv = None; 
+	               msb_constraints = old.msb_constraints }
+	            in
+	             SPBmodule msb
+                 | Some mp ->
+                    error_a_generative_module_expected l
+              end
       in
 	MTBsig(msid,  before@(l,new_spec)::after)
     with
@@ -143,13 +174,14 @@ and translate_entry_list env msid is_definition sig_e =
   let mp = MPself msid in
   let do_entry env (l,e) = 
     let kn = make_kn mp empty_dirpath l in
+    let con = make_con mp empty_dirpath l in
     match e with
       | SPEconst ce ->
-	  let cb = translate_constant env ce in
+	  let cb = translate_constant env con ce in
 	    begin match cb.const_hyps with
 	      |	(_::_) -> error_local_context (Some l)
 	      | [] ->
-		  add_constant kn cb env, (l, SEBconst cb), (l, SPBconst cb)
+		  add_constant con cb env, (l, SEBconst cb), (l, SPBconst cb)
 	    end
       | SPEmind mie -> 
 	  let mib = translate_mind env mie in
@@ -253,8 +285,13 @@ and translate_mexpr env mexpr = match mexpr with
 	  | Not_path -> error_application_to_not_path mexpr
 	      (* place for nondep_supertype *)
       in
+       let resolve = Modops.resolver_of_environment farg_id farg_b mp env in
 	MEBapply(feb,meb,cst),
-	subst_modtype (map_mbid farg_id mp) fbody_b
+        (* This is the place where the functor formal parameter is
+           substituted by the given argument to compute the type of the
+           functor application. *)
+	subst_modtype
+         (map_mbid farg_id mp (Some resolve)) fbody_b
   | MEstruct (msid,structure) ->
       let structure,signature = translate_entry_list env msid true structure in
 	MEBstruct (msid,structure),
diff --git a/kernel/mod_typing.mli b/kernel/mod_typing.mli
index fdf39c56..706c617c 100644
--- a/kernel/mod_typing.mli
+++ b/kernel/mod_typing.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: mod_typing.mli,v 1.2.8.2 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: mod_typing.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 (*i*)
 open Declarations
@@ -19,6 +19,8 @@ val translate_modtype : env -> module_type_entry -> module_type_body
 
 val translate_module : env -> module_entry -> module_body
 
+val translate_mexpr : env -> module_expr -> module_expr_body * module_type_body
+
 val add_modtype_constraints : env -> module_type_body -> env
 
 val add_module_constraints : env -> module_body -> env
diff --git a/kernel/modops.ml b/kernel/modops.ml
index 84845af5..3d041c6c 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,v 1.12.2.1 2004/07/16 19:30:26 herbelin Exp $ i*)
+(*i $Id: modops.ml 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Util
@@ -17,6 +17,7 @@ open Term
 open Declarations
 open Environ
 open Entries
+open Mod_subst
 (*i*)
 
 let error_existing_label l = 
@@ -66,6 +67,11 @@ let error_not_a_constant l =
 let error_with_incorrect l =
   error ("Incorrect constraint for label \""^(string_of_label l)^"\"")
 
+let error_a_generative_module_expected l =
+  error ("The module " ^ string_of_label l ^ " is not generative. Only " ^
+         "component of generative modules can be changed using the \"with\" " ^
+         "construct.")
+
 let error_local_context lo = 
   match lo with
       None -> 
@@ -123,6 +129,9 @@ let rec check_modpath_equiv env mp1 mp2 =
 
 
 let rec subst_modtype sub = function
+    (* This is the case in which I am substituting a whole module.
+       For instance "Module M(X). Module N := X. End M". When I apply
+       M to M' I must substitute M' for X in "Module N := X". *)
   | MTBident ln -> MTBident (subst_kn sub ln)
   | MTBfunsig (arg_id, arg_b, body_b) ->
       if occur_mbid arg_id sub then failwith "capture";
@@ -148,23 +157,77 @@ and subst_signature sub sign =
 
 and subst_module sub mb =
   let mtb' = subst_modtype sub mb.msb_modtype in
+  (* This is similar to the previous case. In this case we have
+     a module M in a signature that is knows to be equivalent to a module M'
+     (because the signature is "K with Module M := M'") and we are substituting
+     M' with some M''. *)
   let mpo' = option_smartmap (subst_mp sub) mb.msb_equiv in
     if mtb'==mb.msb_modtype && mpo'==mb.msb_equiv then mb else
       { msb_modtype=mtb'; 
 	msb_equiv=mpo'; 
 	msb_constraints=mb.msb_constraints}
 
-
 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 and then delta-expands
+   the obtained constants according to env *)
+let resolver_of_environment mbid modtype mp env =
+ let constants = constants_of_modtype env (MPbound mbid) modtype in
+ let resolve =
+  List.map
+   (fun (con,expecteddef) ->
+     let con' = replace_mp_in_con (MPbound mbid) mp con in
+     let constr =
+      try
+       if expecteddef.Declarations.const_body <> None then
+        (* Do not expand constants that already have a body in the
+           expected type (i.e. only parameters/axioms in the module type
+           are expanded). In the few examples we have this seems to
+           be the more reasonable behaviour for the user. *)
+        None
+       else
+        let constant = lookup_constant con' env in
+         if constant.Declarations.const_opaque then
+          None
+         else
+          option_app Declarations.force
+           constant.Declarations.const_body
+      with Not_found -> error_no_such_label (con_label con')
+     in
+      con,constr
+   ) 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 = 
   let add_one env (l,elem) =
     let kn = make_kn mp empty_dirpath l in
+    let con = make_con mp empty_dirpath l in
       match elem with
-	| SPBconst cb -> Environ.add_constant kn cb env
+	| SPBconst cb -> Environ.add_constant con cb env
 	| SPBmind mib -> Environ.add_mind kn mib env
 	| SPBmodule mb -> 
 	    add_module (MPdot (mp,l)) (module_body_of_spec mb) env 
@@ -180,7 +243,6 @@ and add_module mp mb env =
       | MTBident _ -> anomaly "scrape_modtype does not work!"
       | MTBsig (msid,sign) -> 
 	  add_signature mp (subst_signature_msid msid mp sign) env
-
       | MTBfunsig _ -> env
 
 
@@ -189,11 +251,13 @@ let strengthen_const env mp l cb =
   | false, Some _ -> cb
   | true, Some _ 
   | _, None -> 
-      let const = mkConst (make_kn mp empty_dirpath l) in 
+      let const = mkConst (make_con mp empty_dirpath l) in 
       let const_subs = Some (Declarations.from_val const) in
 	{cb with 
       	   const_body = const_subs;
-	   const_opaque = false
+	   const_opaque = false;
+           const_body_code = Cemitcodes.from_val
+             (compile_constant_body env const_subs false false)
 	}
 
 let strengthen_mind env mp l mib = match mib.mind_equiv with
@@ -243,3 +307,4 @@ and strengthen_sig env msid sign mp = match sign with
 	item::rest'
 
 let strengthen env mtb mp = strengthen_mtb env mp mtb
+
diff --git a/kernel/modops.mli b/kernel/modops.mli
index cca2d315..371860f5 100644
--- a/kernel/modops.mli
+++ b/kernel/modops.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: modops.mli,v 1.7.6.2 2005/01/21 16:41:50 herbelin Exp $ i*)
+(*i $Id: modops.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -15,6 +15,7 @@ open Univ
 open Environ
 open Declarations
 open Entries
+open Mod_subst
 (*i*)
 
 (* Various operations on modules and module types *)
@@ -91,6 +92,11 @@ val error_not_a_constant : label -> 'a
 
 val error_with_incorrect : label -> 'a
 
+val error_a_generative_module_expected : label -> 'a
+
 val error_local_context : label option -> 'a
 
 val error_circular_with_module : identifier -> 'a
+
+val resolver_of_environment :
+ mod_bound_id -> module_type_body -> module_path -> env -> resolver
diff --git a/kernel/names.ml b/kernel/names.ml
index df3a012f..4c8cf7bb 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: names.ml,v 1.53.2.1 2004/07/16 19:30:26 herbelin Exp $ *)
+(* $Id: names.ml 7834 2006-01-11 00:15:01Z herbelin $ *)
 
 open Pp
 open Util
@@ -19,13 +19,7 @@ let id_ord = Pervasives.compare
 
 let id_of_string s = String.copy s
 
-let map_ident id =
-  if Options.do_translate() then
-    match id with
-        "fix" -> "Fix"
-      | _ -> id
-  else id
-let string_of_id id = String.copy (map_ident id)
+let string_of_id id = String.copy id
 
 (* Hash-consing of identifier *)
 module Hident = Hashcons.Make(
@@ -138,74 +132,6 @@ end
 module MPset = Set.Make(MPord)
 module MPmap = Map.Make(MPord)
 
-
-(* this is correct under the condition that bound and struct
-   identifiers can never be identical (i.e. get the same stamp)! *) 
-
-type substitution = module_path Umap.t
-
-let empty_subst = Umap.empty
-
-let add_msid = Umap.add 
-let add_mbid = Umap.add
-
-let map_msid msid mp = add_msid msid mp empty_subst
-let map_mbid mbid mp = add_msid mbid mp empty_subst
-
-let list_contents sub = 
-  let one_pair uid mp l =
-    (string_of_uid uid, string_of_mp mp)::l
-  in
-    Umap.fold one_pair sub []
-
-let debug_string_of_subst sub = 
-  let l = List.map (fun (s1,s2) -> s1^"|->"^s2) (list_contents sub) in
-    "{" ^ String.concat "; " l ^ "}"
-
-let debug_pr_subst sub = 
-  let l = list_contents sub in
-  let f (s1,s2) = hov 2 (str s1 ++ spc () ++ str "|-> " ++ str s2) 
-  in
-    str "{" ++ hov 2 (prlist_with_sep pr_coma f l) ++ str "}" 
-
-let rec subst_mp sub mp = (* 's like subst *)
-  match mp with
-    | MPself sid -> 
-	(try Umap.find sid sub with Not_found -> mp)
-    | MPbound bid ->
-	(try Umap.find bid sub with Not_found -> mp)
-    | MPdot (mp1,l) -> 
-	let mp1' = subst_mp sub mp1 in
-	  if mp1==mp1' then 
-	    mp
-	  else
-	    MPdot (mp1',l)
-    | _ -> mp
-
-let join subst1 subst2 = 
-  let subst = Umap.map (subst_mp subst2) subst1 in
-  Umap.fold Umap.add subst2 subst
-
-let rec occur_in_path uid = function
-  | MPself sid -> sid = uid
-  | MPbound bid -> bid = uid
-  | MPdot (mp1,_) -> occur_in_path uid mp1
-  | _ -> false
-    
-let occur_uid uid sub = 
-  let check_one uid' mp =
-    if uid = uid' || occur_in_path uid mp then raise Exit
-  in
-    try 
-      Umap.iter check_one sub;
-      false
-    with Exit -> true
-
-let occur_msid = occur_uid
-let occur_mbid = occur_uid
-
-
-
 (* Kernel names *)
 
 type kernel_name = module_path * dir_path * label
@@ -225,11 +151,6 @@ let string_of_kn (mp,dir,l) =
 let pr_kn kn = str (string_of_kn kn)
 
 
-let subst_kn sub (mp,dir,l as kn) = 
-  let mp' = subst_mp sub mp in
-    if mp==mp' then kn else (mp',dir,l)
-
-
 let kn_ord kn1 kn2 = 
     let mp1,dir1,l1 = kn1 in
     let mp2,dir2,l2 = kn2 in
@@ -252,7 +173,9 @@ end
 module KNmap = Map.Make(KNord)
 module KNpred = Predicate.Make(KNord)
 module KNset = Set.Make(KNord)
-
+module Cmap = KNmap
+module Cpred = KNpred
+module Cset = KNset
 
 let default_module_name = id_of_string "If you see this, it's a bug"
 
@@ -267,11 +190,35 @@ type mutual_inductive = kernel_name
 type inductive = mutual_inductive * int
 type constructor = inductive * int
 
+let constant_of_kn kn = kn
+let make_con mp dir l = (mp,dir,l)
+let repr_con con = con
+let string_of_con = string_of_kn
+let con_label = label
+let pr_con = pr_kn
+let con_modpath = modpath
+
 let ith_mutual_inductive (kn,_) i = (kn,i)
 let ith_constructor_of_inductive ind i = (ind,i)
 let inductive_of_constructor (ind,i) = ind
 let index_of_constructor (ind,i) = i
 
+module InductiveOrdered = struct
+  type t = inductive
+  let compare (spx,ix) (spy,iy) = 
+    let c = ix - iy in if c = 0 then KNord.compare spx spy else c
+end
+
+module Indmap = Map.Make(InductiveOrdered)
+
+module ConstructorOrdered = struct
+  type t = constructor
+  let compare (indx,ix) (indy,iy) = 
+    let c = ix - iy in if c = 0 then InductiveOrdered.compare indx indy else c
+end
+
+module Constrmap = Map.Make(ConstructorOrdered)
+
 (* Better to have it here that in closure, since used in grammar.cma *)
 type evaluable_global_reference =
   | EvalVarRef of identifier
@@ -352,4 +299,24 @@ let hcons_names () =
   let huniqid = Hashcons.simple_hcons Huniqid.f (hstring,hdir) in
   let hmod = Hashcons.simple_hcons Hmod.f (hdir,huniqid,hstring) in
   let hkn = Hashcons.simple_hcons Hkn.f (hmod,hdir,hstring) in
-  (hkn,hdir,hname,hident,hstring)
+  (hkn,hkn,hdir,hname,hident,hstring)
+
+
+(*******)
+
+type transparent_state = Idpred.t * Cpred.t
+
+type 'a tableKey =
+  | ConstKey of constant
+  | VarKey of identifier
+  | RelKey of 'a 
+
+
+type inv_rel_key = int (* index in the [rel_context] part of environment
+			  starting by the end, {\em inverse} 
+			  of de Bruijn indice *)
+
+type id_key = inv_rel_key tableKey
+
+
+
diff --git a/kernel/names.mli b/kernel/names.mli
index 07c19841..5b0a7a30 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: names.mli,v 1.46.6.1 2004/07/16 19:30:26 herbelin Exp $ i*)
+(*i $Id: names.mli 6736 2005-02-18 20:49:04Z herbelin $ i*)
 
 (*s Identifiers *)
 
@@ -83,45 +83,6 @@ val string_of_mp : module_path -> string
 module MPset : Set.S with type elt = module_path
 module MPmap : Map.S with type key = module_path
 
-
-(*s Substitutions *)
-
-type substitution
-
-val empty_subst : substitution
-
-val add_msid : 
-  mod_self_id -> module_path -> substitution -> substitution
-val add_mbid : 
-  mod_bound_id -> module_path -> substitution -> substitution
-
-val map_msid : mod_self_id -> module_path -> substitution
-val map_mbid : mod_bound_id -> module_path -> substitution
-
-(* sequential composition: 
-   [substitute (join sub1 sub2) t = substitute sub2 (substitute sub1 t)]
-*)
-val join : substitution -> substitution -> substitution
-
-(*i debugging *)
-val debug_string_of_subst : substitution -> string
-val debug_pr_subst : substitution -> Pp.std_ppcmds
-(*i*)
-
-(* [subst_mp sub mp] guarantees that whenever the result of the
-   substitution is structutally equal [mp], it is equal by pointers 
-   as well [==] *) 
-
-val subst_mp : 
-  substitution -> module_path -> module_path
-
-(* [occur_*id id sub] returns true iff [id] occurs in [sub] 
-   on either side *)
-
-val occur_msid : mod_self_id -> substitution -> bool
-val occur_mbid : mod_bound_id -> substitution -> bool
-     
-
 (* Name of the toplevel structure *)
 val initial_msid : mod_self_id
 val initial_path : module_path (* [= MPself initial_msid] *)
@@ -142,7 +103,6 @@ val label : kernel_name -> label
 
 val string_of_kn : kernel_name -> string
 val pr_kn : kernel_name -> Pp.std_ppcmds
-val subst_kn : substitution -> kernel_name -> kernel_name
 
 
 module KNset  : Set.S with type elt = kernel_name
@@ -153,13 +113,27 @@ module KNmap  : Map.S with type key = kernel_name
 (*s Specific paths for declarations *)
 
 type variable = identifier
-type constant = kernel_name
+type constant
 type mutual_inductive = kernel_name
 (* Beware: first inductive has index 0 *)
 type inductive = mutual_inductive * int
 (* Beware: first constructor has index 1 *)
 type constructor = inductive * int
 
+module Cmap  : Map.S with type key = constant
+module Cpred  : Predicate.S with type elt = constant
+module Cset  : Set.S with type elt = constant
+module Indmap : Map.S with type key = inductive
+module Constrmap : Map.S with type key = constructor
+
+val constant_of_kn : kernel_name -> constant
+val make_con : module_path -> dir_path -> label -> constant
+val repr_con : constant -> module_path * dir_path * label
+val string_of_con : constant -> string
+val con_label : constant -> label
+val con_modpath : constant -> module_path
+val pr_con : constant -> Pp.std_ppcmds
+
 val ith_mutual_inductive : inductive -> int -> inductive
 val ith_constructor_of_inductive : inductive -> int -> constructor
 val inductive_of_constructor : constructor -> inductive
@@ -172,5 +146,22 @@ type evaluable_global_reference =
 
 (* Hash-consing *)
 val hcons_names : unit ->
+  (constant -> constant) *
   (kernel_name -> kernel_name) * (dir_path -> dir_path) *
   (name -> name) * (identifier -> identifier) * (string -> string)
+
+
+(******)
+
+type 'a tableKey =
+  | ConstKey of constant
+  | VarKey of identifier
+  | RelKey of 'a 
+
+type transparent_state = Idpred.t * Cpred.t
+
+type inv_rel_key = int (* index in the [rel_context] part of environment
+			  starting by the end, {\em inverse} 
+			  of de Bruijn indice *)
+
+type id_key = inv_rel_key tableKey
diff --git a/kernel/pre_env.ml b/kernel/pre_env.ml
new file mode 100644
index 00000000..5a45c167
--- /dev/null
+++ b/kernel/pre_env.ml
@@ -0,0 +1,146 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: pre_env.ml 7642 2005-12-06 08:56:29Z gregoire $ *)
+
+open Util
+open Names
+open Sign
+open Univ
+open Term
+open Declarations
+
+(* The type of environments. *)
+
+
+type key = int option ref 
+
+type constant_key = constant_body * key
+ 
+type globals = {
+  env_constants : constant_key Cmap.t;
+  env_inductives : mutual_inductive_body KNmap.t;
+  env_modules : module_body MPmap.t;
+  env_modtypes : module_type_body KNmap.t }
+
+type stratification = {
+  env_universes : universes;
+  env_engagement : engagement option
+}
+
+type 'a val_kind =   
+  | VKvalue of values
+  | VKaxiom of 'a
+  | VKdef of constr
+
+type 'a lazy_val = 'a val_kind ref
+
+type rel_val = inv_rel_key lazy_val
+
+type named_val = identifier lazy_val
+
+type named_vals = (identifier * named_val) list
+
+type env = {
+  env_globals       : globals;
+  env_named_context : named_context;
+  env_named_vals    : named_vals;
+  env_rel_context   : rel_context;
+  env_rel_val       : rel_val list;
+  env_nb_rel        : int;
+  env_stratification : stratification }
+
+type named_context_val = named_context * named_vals
+
+let empty_named_context_val = [],[]
+
+let empty_env = { 
+  env_globals = {
+    env_constants = Cmap.empty;
+    env_inductives = KNmap.empty;
+    env_modules = MPmap.empty;
+    env_modtypes = KNmap.empty };
+  env_named_context = empty_named_context;
+  env_named_vals = [];
+  env_rel_context = empty_rel_context;
+  env_rel_val = [];
+  env_nb_rel = 0;
+  env_stratification = {
+    env_universes = initial_universes;
+    env_engagement = None } }
+
+
+(* Rel context *)
+
+let nb_rel env = env.env_nb_rel
+
+let push_rel d env =
+  let _,body,_ = d in
+  let rval =
+    match body with
+    | None -> ref (VKaxiom env.env_nb_rel)
+    | Some c -> ref (VKdef c)
+  in     
+  { env with
+    env_rel_context = add_rel_decl d env.env_rel_context;
+    env_rel_val = rval :: env.env_rel_val;
+    env_nb_rel = env.env_nb_rel + 1 }
+ 
+let lookup_rel_val n env =
+  try List.nth env.env_rel_val (n - 1)
+  with _ -> raise Not_found
+    
+let env_of_rel n env =
+  { env with
+    env_rel_context = Util.list_skipn n env.env_rel_context;
+    env_rel_val = Util.list_skipn n env.env_rel_val;
+    env_nb_rel = env.env_nb_rel - n
+  }
+
+(* Named context *)
+
+let push_named_context_val d (ctxt,vals) =
+  let id,body,_ = d in
+  let rval =
+    match body with
+    | None -> ref (VKaxiom id)
+    | Some c -> ref (VKdef c)
+  in Sign.add_named_decl d ctxt, (id,rval)::vals
+
+exception ASSERT of Sign.rel_context
+
+let push_named d env = 
+(*  if not (env.env_rel_context = []) then raise (ASSERT env.env_rel_context);
+  assert (env.env_rel_context = []); *)
+  let id,body,_ = d in
+  let rval =
+    match body with
+    | None -> ref (VKaxiom id)
+    | Some c -> ref (VKdef c)
+  in
+  { env with  
+    env_named_context = Sign.add_named_decl d env.env_named_context;
+    env_named_vals =  (id,rval):: env.env_named_vals }
+
+let lookup_named_val id env =
+   snd(List.find (fun (id',_) -> id = id') env.env_named_vals)
+  
+(* Warning all the names should be different *)
+let env_of_named id env = env
+ 
+(* Global constants *)
+
+let lookup_constant_key kn env =
+  Cmap.find kn env.env_globals.env_constants
+
+let lookup_constant kn env =
+  fst (Cmap.find kn env.env_globals.env_constants)
+
+(* Mutual Inductives *)
+let lookup_mind kn env =
+  KNmap.find kn env.env_globals.env_inductives
diff --git a/kernel/pre_env.mli b/kernel/pre_env.mli
new file mode 100644
index 00000000..be74decf
--- /dev/null
+++ b/kernel/pre_env.mli
@@ -0,0 +1,86 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: pre_env.mli 7642 2005-12-06 08:56:29Z gregoire $ *)
+
+open Util
+open Names
+open Sign
+open Univ
+open Term
+open Declarations
+
+(* The type of environments. *)
+
+
+type key = int option ref 
+
+type constant_key = constant_body * key
+ 
+type globals = {
+  env_constants : constant_key Cmap.t;
+  env_inductives : mutual_inductive_body KNmap.t;
+  env_modules : module_body MPmap.t;
+  env_modtypes : module_type_body KNmap.t }
+
+type stratification = {
+  env_universes : universes;
+  env_engagement : engagement option
+}
+
+type 'a val_kind =   
+  | VKvalue of values
+  | VKaxiom of 'a
+  | VKdef of constr
+
+type 'a lazy_val = 'a val_kind ref
+
+type rel_val = inv_rel_key lazy_val
+
+type named_val = identifier lazy_val
+
+type named_vals = (identifier * named_val) list
+
+type env = {
+  env_globals       : globals;
+  env_named_context : named_context;
+  env_named_vals    : named_vals;
+  env_rel_context   : rel_context;
+  env_rel_val       : rel_val list;
+  env_nb_rel        : int;
+  env_stratification : stratification }
+
+type named_context_val = named_context * named_vals
+
+val empty_named_context_val : named_context_val
+
+val empty_env : env
+
+(* Rel context *)
+
+val nb_rel         : env -> int
+val push_rel       : rel_declaration -> env -> env
+val lookup_rel_val : int -> env -> rel_val
+val env_of_rel     : int -> env -> env       
+(* Named context *)
+
+val push_named_context_val  : 
+    named_declaration -> named_context_val -> named_context_val
+val push_named       : named_declaration -> env -> env
+val lookup_named_val : identifier -> env -> named_val
+val env_of_named     : identifier -> env -> env  
+(* Global constants *)
+
+
+val lookup_constant_key : constant -> env -> constant_key
+val lookup_constant : constant -> env -> constant_body
+
+(* Mutual Inductives *)
+val lookup_mind : mutual_inductive -> env -> mutual_inductive_body
+
+
diff --git a/kernel/reduction.ml b/kernel/reduction.ml
index 5428a40d..6477078a 100644
--- a/kernel/reduction.ml
+++ b/kernel/reduction.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: reduction.ml,v 1.91.2.1 2004/07/16 19:30:26 herbelin Exp $ *)
+(* $Id: reduction.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 open Util
 open Names
@@ -317,16 +317,15 @@ and convert_vect infos lft1 lft2 v1 v2 cuniv =
     fold 0 cuniv
   else raise NotConvertible
 
-
+let clos_fconv cv_pb env t1 t2 =
+  let infos = create_clos_infos betaiotazeta env in
+  ccnv cv_pb infos ELID ELID (inject t1) (inject t2) Constraint.empty
 
 let fconv cv_pb env t1 t2 =
-  if eq_constr t1 t2 then 
-    Constraint.empty
-  else
-    let infos = create_clos_infos betaiotazeta env in
-    ccnv cv_pb infos ELID ELID (inject t1) (inject t2)
-      Constraint.empty
+  if eq_constr t1 t2 then Constraint.empty
+  else clos_fconv cv_pb env t1 t2
 
+let conv_cmp = fconv
 let conv = fconv CONV
 let conv_leq = fconv CUMUL
 
@@ -341,6 +340,30 @@ let conv_leq_vecti env v1 v2 =
     v1
     v2
 
+(* option for conversion *)
+
+let vm_conv = ref fconv
+let set_vm_conv f = vm_conv := f
+let vm_conv cv_pb env t1 t2 = 
+  try 
+    !vm_conv cv_pb env t1 t2
+  with Not_found | Invalid_argument _ ->
+      (* If compilation fails, fall-back to closure conversion *)
+      clos_fconv cv_pb env t1 t2
+  
+
+let default_conv = ref fconv 
+
+let set_default_conv f = default_conv := f
+
+let default_conv cv_pb env t1 t2 = 
+  try 
+    !default_conv cv_pb env t1 t2
+  with Not_found | Invalid_argument _ ->
+      (* If compilation fails, fall-back to closure conversion *)
+      clos_fconv cv_pb env t1 t2
+  
+let default_conv_leq = default_conv CUMUL
 (*
 let convleqkey = Profile.declare_profile "Kernel_reduction.conv_leq";;
 let conv_leq env t1 t2 =
@@ -393,7 +416,7 @@ let dest_prod_assum env =
     | LetIn (x,b,t,c) ->
         let d = (x,Some b,t) in
 	prodec_rec (push_rel d env) (Sign.add_rel_decl d l) c
-    | Cast (c,_)    -> prodec_rec env l c
+    | Cast (c,_,_)    -> prodec_rec env l c
     | _               -> l,rty
   in
   prodec_rec env Sign.empty_rel_context
diff --git a/kernel/reduction.mli b/kernel/reduction.mli
index c516ea70..a68e8697 100644
--- a/kernel/reduction.mli
+++ b/kernel/reduction.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: reduction.mli,v 1.56.8.1 2004/07/16 19:30:26 herbelin Exp $ i*)
+(*i $Id: reduction.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Term
@@ -29,13 +29,28 @@ exception NotConvertible
 exception NotConvertibleVect of int
 type 'a conversion_function = env -> 'a -> 'a -> Univ.constraints
 
+type conv_pb = CONV | CUMUL
+
+val sort_cmp : 
+    conv_pb -> sorts -> sorts -> Univ.constraints -> Univ.constraints
+
 val conv_sort      : sorts conversion_function
 val conv_sort_leq  : sorts conversion_function
 
-val conv           : types conversion_function
+val conv_cmp       : conv_pb -> constr conversion_function
+
+val conv           : constr conversion_function
 val conv_leq       : types conversion_function
 val conv_leq_vecti : types array conversion_function
 
+(* option for conversion *)
+val set_vm_conv : (conv_pb -> types conversion_function) -> unit
+val vm_conv : conv_pb -> types conversion_function
+
+val set_default_conv : (conv_pb -> types conversion_function) -> unit
+val default_conv     : conv_pb -> types conversion_function
+val default_conv_leq : types conversion_function
+
 (************************************************************************)
 
 (* Builds an application node, reducing beta redexes it may produce. *) 
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 0f8c0d54..34071182 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,v 1.76.2.2 2005/11/23 14:46:08 barras Exp $ *)
+(* $Id: safe_typing.ml 7602 2005-11-23 15:10:16Z barras $ *)
 
 open Util
 open Names
@@ -132,15 +132,15 @@ let hcons_constant_body cb =
 
 let add_constant dir l decl senv =
   check_label l senv.labset;
-  let cb = match decl with 
-      ConstantEntry ce -> translate_constant senv.env ce
+  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 r in
-        if dir = empty_dirpath then hcons_constant_body cb else cb
+	let cb = translate_recipe senv.env kn r in
+	if dir = empty_dirpath then hcons_constant_body cb else cb
   in
-(*  let cb = if dir = empty_dirpath then hcons_constant_body cb else cb in*)
   let env' = Environ.add_constraints cb.const_constraints senv.env in
-  let kn = make_kn senv.modinfo.modpath dir l in
   let env'' = Environ.add_constant kn cb env' in
   kn, { old = senv.old;
 	env = env'';
@@ -417,7 +417,6 @@ let check_engagement env c =
 let set_engagement c senv =
   {senv with env = Environ.set_engagement c senv.env}
 
-
 (* Libraries = Compiled modules *)
 
 type compiled_library = 
@@ -517,7 +516,7 @@ let import (dp,mb,depends,engmt) digest senv =
 	  loads = (mp,mb)::senv.loads }
 
 
-(** Remove the body of opaque constants in modules *)
+(* Remove the body of opaque constants in modules *)
  
 let rec lighten_module mb =
   { mb with
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index b973fcde..148a9d9d 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: safe_typing.mli,v 1.33.2.2 2005/11/23 14:46:08 barras Exp $ i*)
+(*i $Id: safe_typing.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Names
@@ -28,7 +28,6 @@ type safe_environment
 val env_of_safe_env : safe_environment -> Environ.env
 
 val empty_environment : safe_environment
-
 val is_empty : safe_environment -> bool
 
 (* Adding and removing local declarations (Local or Variables) *)
@@ -46,7 +45,7 @@ type global_declaration =
 
 val add_constant : 
   dir_path -> label -> global_declaration -> safe_environment -> 
-      kernel_name * safe_environment
+      constant * safe_environment
 
 (* Adding an inductive type *)
 val add_mind : 
@@ -68,7 +67,7 @@ val add_constraints :
   Univ.constraints -> safe_environment -> safe_environment
 
 (* Settin the strongly constructive or classical logical engagement *)
-val set_engagement : Environ.engagement -> safe_environment -> safe_environment
+val set_engagement : engagement -> safe_environment -> safe_environment
 
 
 (*s Interactive module functions *)
diff --git a/kernel/sign.ml b/kernel/sign.ml
index a4b2a2ea..7caf667f 100644
--- a/kernel/sign.ml
+++ b/kernel/sign.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: sign.ml,v 1.37.2.1 2004/07/16 19:30:26 herbelin Exp $ *)
+(* $Id: sign.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 open Names
 open Util
@@ -53,13 +53,11 @@ let empty_rel_context = []
 
 let add_rel_decl d ctxt = d::ctxt
 
-let lookup_rel n sign =
-  let rec lookrec = function
-    | (1, decl :: _) -> decl
-    | (n, _ :: sign) -> lookrec (n-1,sign)
-    | (_, [])        -> raise Not_found
-  in 
-  lookrec (n,sign)
+let rec lookup_rel n sign =
+  match n, sign with
+  | 1, decl :: _ -> decl
+  | n, _ :: sign -> lookup_rel (n-1) sign
+  | _, []        -> raise Not_found
 
 let rel_context_length = List.length
 
@@ -73,7 +71,7 @@ let rel_context_nhyps hyps =
 let fold_rel_context f l ~init:x = List.fold_right f l x
 let fold_rel_context_reverse f ~init:x l = List.fold_left f x l
 
-let map_rel_context f l = 
+let map_context f l =
   let map_decl (n, body_o, typ as decl) =
     let body_o' = option_smartmap f body_o in
     let typ' = f typ in
@@ -82,6 +80,9 @@ let map_rel_context f l =
   in
     list_smartmap map_decl l
 
+let map_rel_context = map_context
+let map_named_context = map_context
+
 (* Push named declarations on top of a rel context *)
 (* Bizarre. Should be avoided. *)
 let push_named_to_rel_context hyps ctxt =
@@ -121,7 +122,7 @@ let destArity =
     match kind_of_term c with
     | Prod (x,t,c)    -> prodec_rec ((x,None,t)::l) c
     | LetIn (x,b,t,c) -> prodec_rec ((x,Some b,t)::l) c
-    | Cast (c,_)      -> prodec_rec l c
+    | Cast (c,_,_)      -> prodec_rec l c
     | Sort s          -> l,s
     | _               -> anomaly "destArity: not an arity"
   in 
@@ -133,7 +134,7 @@ let rec isArity c =
   match kind_of_term c with
   | Prod (_,_,c)    -> isArity c
   | LetIn (_,b,_,c) -> isArity (subst1 b c)
-  | Cast (c,_)      -> isArity c
+  | Cast (c,_,_)      -> isArity c
   | Sort _          -> true
   | _               -> false
 
@@ -144,7 +145,7 @@ let decompose_prod_assum =
     match kind_of_term c with
     | Prod (x,t,c)    -> prodec_rec (add_rel_decl (x,None,t) l) c
     | LetIn (x,b,t,c) -> prodec_rec (add_rel_decl (x,Some b,t) l) c
-    | Cast (c,_)      -> prodec_rec l c
+    | Cast (c,_,_)      -> prodec_rec l c
     | _               -> l,c
   in 
   prodec_rec empty_rel_context
@@ -156,7 +157,7 @@ let decompose_lam_assum =
     match kind_of_term c with
     | Lambda (x,t,c)  -> lamdec_rec (add_rel_decl (x,None,t) l) c
     | LetIn (x,b,t,c) -> lamdec_rec (add_rel_decl (x,Some b,t) l) c
-    | Cast (c,_)      -> lamdec_rec l c
+    | Cast (c,_,_)      -> lamdec_rec l c
     | _               -> l,c
   in 
   lamdec_rec empty_rel_context
@@ -171,7 +172,7 @@ let decompose_prod_n_assum n =
     else match kind_of_term c with 
     | Prod (x,t,c)    -> prodec_rec (add_rel_decl (x,None,t) l) (n-1) c
     | LetIn (x,b,t,c) -> prodec_rec (add_rel_decl (x,Some b,t) l) (n-1) c
-    | Cast (c,_)      -> prodec_rec l n c
+    | Cast (c,_,_)      -> prodec_rec l n c
     | c -> error "decompose_prod_n_assum: not enough assumptions"
   in 
   prodec_rec empty_rel_context n
@@ -186,7 +187,7 @@ let decompose_lam_n_assum n =
     else match kind_of_term c with 
     | Lambda (x,t,c)  -> lamdec_rec (add_rel_decl (x,None,t) l) (n-1) c
     | LetIn (x,b,t,c) -> lamdec_rec (add_rel_decl (x,Some b,t) l) (n-1) c
-    | Cast (c,_)      -> lamdec_rec l n c
+    | Cast (c,_,_)      -> lamdec_rec l n c
     | c -> error "decompose_lam_n_assum: not enough abstractions"
   in 
   lamdec_rec empty_rel_context n 
diff --git a/kernel/sign.mli b/kernel/sign.mli
index 3f0549cc..4a90302b 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,v 1.40.2.1 2004/07/16 19:30:26 herbelin Exp $ i*)
+(*i $Id: sign.mli 6737 2005-02-18 20:49:43Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -62,6 +62,9 @@ val fold_rel_context_reverse :
 (*s Map function of [rel_context] *)
 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 Term constructors *)
 
 val it_mkLambda_or_LetIn : constr -> rel_context -> constr
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index 835226fb..94251d90 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,v 1.11.2.2 2005/11/29 21:40:52 letouzey Exp $ i*)
+(*i $Id: subtyping.ml 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Util
@@ -18,6 +18,8 @@ open Environ
 open Reduction
 open Inductive
 open Modops
+open Mod_subst
+open Entries
 (*i*)
 
 (* This local type is used to subtype a constant with a constructor or
@@ -26,7 +28,6 @@ open Modops
 
 type namedobject = 
   | Constant of constant_body
-  | Mind of mutual_inductive_body
   | IndType of inductive * mutual_inductive_body
   | IndConstr of constructor * mutual_inductive_body
   | Module of module_specification_body
@@ -40,31 +41,27 @@ let add_nameobjects_of_mib ln mib map =
     let ip = (ln,j) in
     let map = 
       array_fold_right_i 
-	(fun i id map -> Idmap.add id (IndConstr ((ip,i), mib)) map)
-	oib.mind_consnames
-	map
+      (fun i id map ->
+        Labmap.add (label_of_id id) (IndConstr((ip,i+1), mib)) map)
+      oib.mind_consnames
+      map
     in
-      Idmap.add oib.mind_typename (IndType (ip, mib)) map
+      Labmap.add (label_of_id oib.mind_typename) (IndType (ip, mib)) map
   in
     array_fold_right_i add_nameobjects_of_one mib.mind_packets map
 
+
 (* creates namedobject map for the whole signature *)
 
-let make_label_map msid list = 
+let make_label_map mp list = 
   let add_one (l,e) map = 
-    let obj = 
-      match e with
-	| SPBconst cb -> Constant cb
-	| SPBmind mib -> Mind mib
-	| SPBmodule mb -> Module mb
-	| SPBmodtype mtb -> Modtype mtb
-    in
-(*    let map = match obj with
-      | Mind mib -> 
-	  add_nameobjects_of_mib (make_ln (MPself msid) l) mib map
-      | _ -> map
-    in *)
-      Labmap.add l obj map
+   let add_map obj = Labmap.add l obj map in
+   match e with
+    | SPBconst cb -> add_map (Constant cb)
+    | SPBmind mib ->
+       add_nameobjects_of_mib (make_kn mp empty_dirpath l) mib map
+    | SPBmodule mb -> add_map (Module mb)
+    | SPBmodtype mtb -> add_map (Modtype mtb)
   in
     List.fold_right add_one list Labmap.empty
 
@@ -81,8 +78,7 @@ let check_inductive cst env msid1 l info1 mib2 spec2 =
   let check_conv cst f = check_conv_error error cst f in
   let mib1 = 
     match info1 with
-      | Mind mib -> mib
-    (*  | IndType (_,mib) -> mib   we will enable this later*)
+      | IndType ((_,0), mib) -> mib
       | _ -> error ()
   in
   let check_packet cst p1 p2 =
@@ -118,8 +114,8 @@ let check_inductive cst env msid1 l info1 mib2 spec2 =
 	    && Array.length mib2.mind_packets >= 1);
 
        (* TODO: we should allow renaming of parameters at least ! *)
-  check (fun mib -> mib.mind_packets.(0).mind_nparams);
-  check (fun mib -> mib.mind_packets.(0).mind_params_ctxt); 
+  check (fun mib -> mib.mind_nparams);
+  check (fun mib -> mib.mind_params_ctxt); 
 
   begin 
     match mib2.mind_equiv with
@@ -133,32 +129,19 @@ let check_inductive cst env msid1 l info1 mib2 spec2 =
 	    if kn1 <> kn2 then error ()
   end;
   (* we check that records and their field names are preserved. *)
-  (* To stay compatible, we don't fail but only issue a warning. *)
-  if mib1.mind_record <> mib2.mind_record then begin
-    let sid = string_of_id mib1.mind_packets.(0).mind_typename in 
-    Pp.warning 
-      (sid^": record is implemented as an inductive type or conversely.\n"^
-	 "Beware that extraction cannot handle this situation.\n")
-  end; 
+  check (fun mib -> mib.mind_record);
   if mib1.mind_record then begin 
     let rec names_prod_letin t = match kind_of_term t with 
       | Prod(n,_,t) -> n::(names_prod_letin t)
       | LetIn(n,_,_,t) -> n::(names_prod_letin t)
-      | Cast(t,_) -> names_prod_letin t
+      | Cast(t,_,_) -> names_prod_letin t
       | _ -> []
     in 
     assert (Array.length mib1.mind_packets = 1);
     assert (Array.length mib2.mind_packets = 1);
     assert (Array.length mib1.mind_packets.(0).mind_user_lc = 1); 
     assert (Array.length mib2.mind_packets.(0).mind_user_lc = 1); 
-    let fields1 = names_prod_letin mib1.mind_packets.(0).mind_user_lc.(0)
-    and fields2 = names_prod_letin mib2.mind_packets.(0).mind_user_lc.(0) in  
-    if fields1 <> fields2 then 
-      let sid = string_of_id mib1.mind_packets.(0).mind_typename in 
-      Pp.warning 
-	(sid^": record has different field names in its signature and "^
-	   "implemantation.\n"^
-	   "Beware that extraction cannot handle this situation.\n");
+    check (fun mib -> names_prod_letin mib.mind_packets.(0).mind_user_lc.(0));
   end;
   (* we first check simple things *)
   let cst = 
@@ -173,23 +156,43 @@ let check_inductive cst env msid1 l info1 mib2 spec2 =
 let check_constant cst env msid1 l info1 cb2 spec2 = 
   let error () = error_not_match l spec2 in
   let check_conv cst f = check_conv_error error cst f in
-  let cb1 = 
-    match info1 with
-      | Constant cb -> cb
-      | _ -> error ()
-  in 
-    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
-    match cb2.const_body with
-      | None -> cst
-      | Some lc2 ->
-	  let c2 = Declarations.force lc2 in
-	  let c1 = match cb1.const_body with
-	    | Some lc1 -> Declarations.force lc1
-	    | None -> mkConst (make_kn (MPself msid1) empty_dirpath l)
-	  in
-	    check_conv cst conv env c1 c2
+  match info1 with
+   | 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 con = make_con (MPself msid1) empty_dirpath l in
+      let cst =
+       match cb2.const_body with
+         | None -> cst
+         | Some lc2 ->
+	     let c2 = Declarations.force lc2 in
+	     let c1 = match cb1.const_body with
+	       | Some lc1 -> Declarations.force lc1
+	       | None -> mkConst con
+	     in
+	       check_conv cst conv env c1 c2
+      in
+       cst
+   | IndType ((kn,i),mind1) ->
+      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.") ;
+      assert (mind1.mind_hyps=[] && cb2.const_hyps=[]) ;
+      if cb2.const_body <> None then error () ;
+      let arity1 = mind1.mind_packets.(i).mind_user_arity in
+       check_conv cst conv_leq env arity1 cb2.const_type
+   | IndConstr (((kn,i),j) as cstr,mind1) ->
+      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.") ;
+      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
+   | _ -> error ()
 	      
 let rec check_modules cst env msid1 l msb1 msb2 =
   let mp = (MPdot(MPself msid1,l)) in
@@ -206,11 +209,11 @@ let rec check_modules cst env msid1 l msb1 msb2 =
   cst
 	
 
-and check_signatures cst env' (msid1,sig1) (msid2,sig2') = 
+and check_signatures cst env (msid1,sig1) (msid2,sig2') = 
   let mp1 = MPself msid1 in
-  let env = add_signature mp1 sig1 env' in 
+  let env = add_signature mp1 sig1 env in 
   let sig2 = subst_signature_msid msid2 mp1 sig2' in
-  let map1 = make_label_map msid1 sig1 in
+  let map1 = make_label_map mp1 sig1 in
   let check_one_body cst (l,spec2) = 
     let info1 = 
       try 
@@ -241,10 +244,10 @@ and check_signatures cst env' (msid1,sig1) (msid2,sig2') =
     List.fold_left check_one_body cst sig2
     
 and check_modtypes cst env mtb1 mtb2 equiv = 
-  if mtb1==mtb2 then (); (* just in case  :) *)
+  if mtb1==mtb2 then cst else (* just in case  :) *)
   let mtb1' = scrape_modtype env mtb1 in
   let mtb2' = scrape_modtype env mtb2 in
-    if mtb1'==mtb2' then ();
+    if mtb1'==mtb2' then cst else
     match mtb1', mtb2' with
       | MTBsig (msid1,list1), 
 	MTBsig (msid2,list2) -> 
@@ -257,15 +260,17 @@ and check_modtypes cst env mtb1 mtb2 equiv =
 	MTBfunsig (arg_id2,arg_t2,body_t2) ->
 	  let cst = check_modtypes cst env arg_t2 arg_t1 equiv in 
 	    (* contravariant *)
-	  let env' = 
+	  let env = 
 	    add_module (MPbound arg_id2) (module_body_of_type arg_t2) env 
 	  in
 	  let body_t1' = 
+            (* since we are just checking well-typedness we do not need
+               to expand any constant. Hence the identity resolver. *)
 	    subst_modtype 
-	      (map_mbid arg_id1 (MPbound arg_id2)) 
+              (map_mbid arg_id1 (MPbound arg_id2) None)
 	      body_t1
 	  in
-	  check_modtypes cst env' body_t1' body_t2 equiv
+	  check_modtypes cst env body_t1' body_t2 equiv
       | MTBident _ , _ -> anomaly "Subtyping: scrape failed"
       | _ , MTBident _ -> anomaly "Subtyping: scrape failed"
       | _ , _ -> error_incompatible_modtypes mtb1 mtb2
diff --git a/kernel/subtyping.mli b/kernel/subtyping.mli
index af09dafc..8bc25464 100644
--- a/kernel/subtyping.mli
+++ b/kernel/subtyping.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: subtyping.mli,v 1.2.8.1 2004/07/16 19:30:26 herbelin Exp $ i*)
+(*i $Id: subtyping.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Univ
diff --git a/kernel/term.ml b/kernel/term.ml
index 30e73e4f..7060d000 100644
--- a/kernel/term.ml
+++ b/kernel/term.ml
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: term.ml,v 1.95.2.1 2004/07/16 19:30:26 herbelin Exp $ *)
+(* $Id: term.ml 8049 2006-02-16 10:42:18Z coq $ *)
 
-(* This module instanciates the structure of generic deBruijn terms to Coq *)
+(* This module instantiates the structure of generic deBruijn terms to Coq *)
 
 open Util
 open Pp
@@ -21,6 +21,8 @@ open Esubst
 type existential_key = int
 type metavariable = int
 
+(* This defines the strategy to use for verifiying a Cast *)
+
 (* This defines Cases annotations *)
 type pattern_source = DefaultPat of int | RegularPat
 type case_style = LetStyle | IfStyle | MatchStyle | RegularStyle
@@ -31,6 +33,7 @@ type case_printing =
 type case_info =
   { ci_ind        : inductive;
     ci_npar       : int;
+    ci_cstr_nargs : int array; (* number of real args of each constructor *)
     ci_pp_info    : case_printing (* not interpreted by the kernel *)
   }
 
@@ -56,6 +59,8 @@ let family_of_sort = function
 (*       Constructions as implemented                               *)
 (********************************************************************)
 
+type cast_kind = VMcast | DEFAULTcast 
+
 (* [constr array] is an instance matching definitional [named_context] in
    the same order (i.e. last argument first) *)
 type 'constr pexistential = existential_key * 'constr array
@@ -74,7 +79,7 @@ type ('constr, 'types) kind_of_term =
   | Meta      of metavariable
   | Evar      of 'constr pexistential
   | Sort      of sorts
-  | Cast      of 'constr * 'types
+  | Cast      of 'constr * cast_kind * 'types
   | Prod      of name * 'types * 'types
   | Lambda    of name * 'types * 'constr
   | LetIn     of name * 'constr * 'types * 'constr
@@ -89,14 +94,14 @@ type ('constr, 'types) kind_of_term =
 (* Experimental *)
 type ('constr, 'types) kind_of_type =
   | SortType   of sorts
-  | CastType   of 'types * 'types
+  | CastType   of 'types * 'types 
   | ProdType   of name * 'types * 'types
   | LetInType  of name * 'constr * 'types * 'types
   | AtomicType of 'constr * 'constr array
 
 let kind_of_type = function
   | Sort s -> SortType s
-  | Cast (c,t) -> CastType (c, t)
+  | Cast (c,_,t) -> CastType (c, t)
   | Prod (na,t,c) -> ProdType (na, t, c)
   | LetIn (na,b,t,c) -> LetInType (na, b, t, c)
   | App (c,l) -> AtomicType (c, l)
@@ -123,7 +128,7 @@ let comp_term t1 t2 =
   | Meta m1, Meta m2 -> m1 == m2
   | Var id1, Var id2 -> id1 == id2
   | Sort s1, Sort s2 -> s1 == s2
-  | Cast (c1,t1), Cast (c2,t2) -> c1 == c2 & t1 == t2
+  | Cast (c1,_,t1), Cast (c2,_,t2) -> c1 == c2 & t1 == t2
   | Prod (n1,t1,c1), Prod (n2,t2,c2) -> n1 == n2 & t1 == t2 & c1 == c2
   | Lambda (n1,t1,c1), Lambda (n2,t2,c2) -> n1 == n2 & t1 == t2 & c1 == c2
   | LetIn (n1,b1,t1,c1), LetIn (n2,b2,t2,c2) ->
@@ -148,19 +153,19 @@ let comp_term t1 t2 =
       & array_for_all2 (==) bl1 bl2
   | _ -> false
 
-let hash_term (sh_rec,(sh_sort,sh_kn,sh_na,sh_id)) t =
+let hash_term (sh_rec,(sh_sort,sh_con,sh_kn,sh_na,sh_id)) t =
   match t with
   | Rel _ -> t
   | Meta x -> Meta x
   | Var x -> Var (sh_id x)
   | Sort s -> Sort (sh_sort s)
-  | Cast (c,t) -> Cast (sh_rec c, sh_rec t)
+  | Cast (c, k, t) -> Cast (sh_rec c, k, (sh_rec t))
   | Prod (na,t,c) -> Prod (sh_na na, sh_rec t, sh_rec c)
   | Lambda (na,t,c) -> Lambda (sh_na na, sh_rec t, sh_rec c)
   | LetIn (na,b,t,c) -> LetIn (sh_na na, sh_rec b, sh_rec t, sh_rec c)
   | App (c,l) -> App (sh_rec c, Array.map sh_rec l)
   | Evar (e,l) -> Evar (e, Array.map sh_rec l)
-  | Const c -> Const (sh_kn c)
+  | Const c -> Const (sh_con c)
   | Ind (kn,i) -> Ind (sh_kn kn,i)
   | Construct ((kn,i),j) -> Construct ((sh_kn kn,i),j)
   | Case (ci,p,c,bl) -> (* TO DO: extract ind_kn *)
@@ -179,15 +184,16 @@ module Hconstr =
     struct
       type t = constr
       type u = (constr -> constr) *
-               ((sorts -> sorts) * (kernel_name -> kernel_name)
-		* (name -> name) * (identifier -> identifier))
+               ((sorts -> sorts) * (constant -> constant) *
+               (kernel_name -> kernel_name) * (name -> name) *
+               (identifier -> identifier))
       let hash_sub = hash_term
       let equal = comp_term
       let hash = Hashtbl.hash
     end)
 
-let hcons_term (hsorts,hkn,hname,hident) =
-  Hashcons.recursive_hcons Hconstr.f (hsorts,hkn,hname,hident)
+let hcons_term (hsorts,hcon,hkn,hname,hident) =
+  Hashcons.recursive_hcons Hconstr.f (hsorts,hcon,hkn,hname,hident)
 
 (* Constructs a DeBrujin index with number n *)
 let rels =
@@ -206,11 +212,12 @@ let mkVar id = Var id
 let mkSort s = Sort s
 
 (* Constructs the term t1::t2, i.e. the term t1 casted with the type t2 *)
-(* (that means t2 is declared as the type of t1) *)
-let mkCast (t1,t2) =
+(* (that means t2 is declared as the type of t1) 
+   [s] is the strategy to use when *)
+let mkCast (t1,k2,t2) =
   match t1 with
-    | Cast (t,_) -> Cast (t,t2)
-    | _ -> Cast (t1,t2)
+  | Cast (c,k1, _) when k1 = k2 -> Cast (c,k1,t2)
+  | _ -> Cast (t1,k2,t2)
 
 (* Constructs the product (x:t1)t2 *)
 let mkProd (x,t1,t2) = Prod (x,t1,t2)
@@ -225,7 +232,7 @@ let mkLetIn (x,c1,t,c2) = LetIn (x,c1,t,c2)
 (* We ensure applicative terms have at least one argument and the
    function is not itself an applicative term *)
 let mkApp (f, a) = 
-  if a=[||] then f else
+  if Array.length a = 0 then f else
     match f with
       | App (g, cl) -> App (g, Array.append cl a)
       | _ -> App (f, a)
@@ -309,22 +316,22 @@ let destSort c = match kind_of_term c with
 
 let rec isprop c = match kind_of_term c with
   | Sort (Prop _) -> true
-  | Cast (c,_) -> isprop c
+  | Cast (c,_,_) -> isprop c
   | _ -> false
 
 let rec is_Prop c = match kind_of_term c with
   | Sort (Prop Null) -> true
-  | Cast (c,_) -> is_Prop c
+  | Cast (c,_,_) -> is_Prop c
   | _ -> false
 
 let rec is_Set c = match kind_of_term c with
   | Sort (Prop Pos) -> true
-  | Cast (c,_) -> is_Set c
+  | Cast (c,_,_) -> is_Set c
   | _ -> false
 
 let rec is_Type c = match kind_of_term c with
   | Sort (Type _) -> true
-  | Cast (c,_) -> is_Type c
+  | Cast (c,_,_) -> is_Type c
   | _ -> false
 
 let isType = function
@@ -344,10 +351,11 @@ let isEvar c = match kind_of_term c with Evar _ -> true | _ -> false
 
 (* Destructs a casted term *)
 let destCast c = match kind_of_term c with 
-  | Cast (t1, t2) -> (t1,t2)
+  | Cast (t1,k,t2) -> (t1,k,t2)
   | _ -> invalid_arg "destCast"
 
-let isCast c = match kind_of_term c with Cast (_,_) -> true | _ -> false
+let isCast c = match kind_of_term c with Cast _ -> true | _ -> false
+
 
 (* Tests if a de Bruijn index *)
 let isRel c = match kind_of_term c with Rel _ -> true | _ -> false
@@ -374,12 +382,16 @@ let destLetIn c = match kind_of_term c with
   | _ -> invalid_arg "destProd"
 
 (* Destructs an application *)
-let destApplication c = match kind_of_term c with
+let destApp c = match kind_of_term c with
   | App (f,a) -> (f, a)
   | _ -> invalid_arg "destApplication"
 
+let destApplication = destApp
+
 let isApp c = match kind_of_term c with App _ -> true | _ -> false
 
+let isProd c = match kind_of_term c with | Prod(_) -> true | _ -> false
+
 (* Destructs a constant *)
 let destConst c = match kind_of_term c with
   | Const kn -> kn
@@ -423,24 +435,41 @@ let destCoFix c = match kind_of_term c with
   | _ -> invalid_arg "destCoFix"
 
 (******************************************************************)
+(* Cast management                                                *)
+(******************************************************************)
+
+let rec strip_outer_cast c = match kind_of_term c with
+  | Cast (c,_,_) -> strip_outer_cast c
+  | _ -> c
+
+(* Fonction spéciale qui laisse les cast clés sous les Fix ou les Case *)
+
+let under_outer_cast f c =  match kind_of_term c with
+  | Cast (b,k,t) -> mkCast (f b, k, f t)
+  | _ -> f c
+
+let rec under_casts f c = match kind_of_term c with
+  | Cast (c,k,t) -> mkCast (under_casts f c, k, t)
+  | _            -> f c
+
+(******************************************************************)
 (* Flattening and unflattening of embedded applications and casts *)
 (******************************************************************)
 
-(* flattens application lists *)
+(* flattens application lists throwing casts in-between *)
 let rec collapse_appl c = match kind_of_term c with
   | App (f,cl) -> 
-      let rec collapse_rec f cl2 = match kind_of_term f with
+      let rec collapse_rec f cl2 =
+        match kind_of_term (strip_outer_cast f) with
 	| App (g,cl1) -> collapse_rec g (Array.append cl1 cl2)
-	| Cast (c,_) when isApp c -> collapse_rec c cl2
-	| _ -> if cl2 = [||] then f else mkApp (f,cl2)
-      in 
+	| _ -> mkApp (f,cl2)
+      in
       collapse_rec f cl
   | _ -> c
 
-let rec decompose_app c =
-  match kind_of_term (collapse_appl c) with
+let decompose_app c =
+  match kind_of_term c with
     | App (f,cl) -> (f, Array.to_list cl)
-    | Cast (c,t) -> decompose_app c
     | _ -> (c,[])
 
 (* strips head casts and flattens head applications *)
@@ -448,11 +477,11 @@ let rec strip_head_cast c = match kind_of_term c with
   | App (f,cl) -> 
       let rec collapse_rec f cl2 = match kind_of_term f with
 	| App (g,cl1) -> collapse_rec g (Array.append cl1 cl2)
-	| Cast (c,_) -> collapse_rec c cl2
-	| _ -> if cl2 = [||] then f else mkApp (f,cl2)
+	| Cast (c,_,_) -> collapse_rec c cl2
+	| _ -> if Array.length cl2 = 0 then f else mkApp (f,cl2)
       in 
       collapse_rec f cl
-  | Cast (c,t) -> strip_head_cast c
+  | Cast (c,_,_) -> strip_head_cast c
   | _ -> c
 
 (****************************************************************************)
@@ -466,7 +495,7 @@ let rec strip_head_cast c = match kind_of_term c with
 let fold_constr 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
+  | 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
@@ -487,7 +516,7 @@ let fold_constr f acc c = match kind_of_term c with
 let iter_constr f c = match kind_of_term c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> ()
-  | Cast (c,t) -> f c; f t
+  | Cast (c,_,t) -> f c; f t
   | Prod (_,t,c) -> f t; f c
   | Lambda (_,t,c) -> f t; f c
   | LetIn (_,b,t,c) -> f b; f t; f c
@@ -506,7 +535,7 @@ let iter_constr f c = match kind_of_term c with
 let iter_constr_with_binders g f n c = match kind_of_term c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> ()
-  | Cast (c,t) -> f n c; f n t
+  | Cast (c,_,t) -> f n c; f n t
   | Prod (_,t,c) -> f n t; f (g n) c
   | Lambda (_,t,c) -> f n t; f (g n) c
   | LetIn (_,b,t,c) -> f n b; f n t; f (g n) c
@@ -527,7 +556,7 @@ let iter_constr_with_binders g f n c = match kind_of_term c with
 let map_constr f c = match kind_of_term c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> c
-  | Cast (c,t) -> mkCast (f c, f t)
+  | Cast (c,k,t) -> mkCast (f c, k, f t)
   | Prod (na,t,c) -> mkProd (na, f t, f c)
   | Lambda (na,t,c) -> mkLambda (na, f t, f c)
   | LetIn (na,b,t,c) -> mkLetIn (na, f b, f t, f c)
@@ -548,7 +577,7 @@ let map_constr f c = match kind_of_term c with
 let map_constr_with_binders g f l c = match kind_of_term c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> c
-  | Cast (c,t) -> mkCast (f l c, f l t)
+  | Cast (c,k,t) -> mkCast (f l c, k, f l t)
   | Prod (na,t,c) -> mkProd (na, f l t, f (g l) c)
   | Lambda (na,t,c) -> mkLambda (na, f l t, f (g l) c)
   | LetIn (na,b,t,c) -> mkLetIn (na, f l b, f l t, f (g l) c)
@@ -573,8 +602,8 @@ let compare_constr f t1 t2 =
   | Meta m1, Meta m2 -> m1 = m2
   | Var id1, Var id2 -> id1 = id2
   | Sort s1, Sort s2 -> s1 = s2
-  | Cast (c1,_), _ -> f c1 t2
-  | _, Cast (c2,_) -> f t1 c2
+  | Cast (c1,_,_), _ -> f c1 t2
+  | _, Cast (c2,_,_) -> f t1 c2
   | Prod (_,t1,c1), Prod (_,t2,c2) -> f t1 t2 & f c1 c2
   | Lambda (_,t1,c1), Lambda (_,t2,c2) -> f t1 t2 & f c1 c2
   | LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) -> f b1 b2 & f t1 t2 & f c1 c2
@@ -605,6 +634,8 @@ let compare_constr f t1 t2 =
 
 type types = constr
 
+type strategy = types option 
+
 let type_app f tt = f tt
 
 let body_of_type ty = ty
@@ -671,7 +702,7 @@ let noccur_with_meta n m term =
     | Rel p -> if n<=p & p<n+m then raise LocalOccur
     | App(f,cl) ->
 	(match kind_of_term f with
-           | Cast (c,_) when isMeta c -> ()
+           | Cast (c,_,_) when isMeta c -> ()
            | Meta _ -> ()
 	   | _ -> iter_constr_with_binders succ occur_rec n c)
     | Evar (_, _) -> ()
@@ -746,7 +777,7 @@ let substl laml =
   substn_many (Array.map make_substituend (Array.of_list laml)) 0
 let subst1 lam = substl [lam]
 
-let substl_decl laml (id,bodyopt,typ as d) =
+let substl_decl laml (id,bodyopt,typ) =
   match bodyopt with
     | None -> (id,None,substl laml typ)
     | Some body -> (id, Some (substl laml body), type_app (substl laml) typ)
@@ -789,32 +820,6 @@ let substn_vars p vars =
 
 let subst_vars = substn_vars 1
 
-(* 
-map_kn : (kernel_name -> kernel_name) -> constr -> constr
-
-This should be rewritten to prevent duplication of constr's when not
-necessary.
-For now, it uses map_constr and is rather ineffective
-*)
-
-let rec map_kn f c = 
-  let func = map_kn f in
-    match kind_of_term c with
-      | Const kn -> 
-	  mkConst (f kn)
-      | Ind (kn,i) -> 
-	  mkInd (f kn,i)
-      | Construct ((kn,i),j) -> 
-	  mkConstruct ((f kn,i),j)
-      | Case (ci,p,c,l) ->
-	  let ci' = { ci with ci_ind = let (kn,i) = ci.ci_ind in f kn, i } in
-	  mkCase (ci', func p, func c, array_smartmap func l) 
-      | _ -> map_constr func c
-
-let subst_mps sub = 
-  map_kn (subst_kn sub)
-
-
 (*********************)
 (* Term constructors *)
 (*********************)
@@ -965,20 +970,6 @@ let mkCoFix = mkCoFix
 let implicit_sort = Type (make_univ(make_dirpath[id_of_string"implicit"],0))
 let mkImplicit = mkSort implicit_sort
 
-let rec strip_outer_cast c = match kind_of_term c with
-  | Cast (c,_) -> strip_outer_cast c
-  | _ -> c
-
-(* Fonction spéciale qui laisse les cast clés sous les Fix ou les Case *)
-
-let under_outer_cast f c =  match kind_of_term c with
-  | Cast (b,t) -> mkCast (f b,f t)
-  | _ -> f c
-
-let rec under_casts f c = match kind_of_term c with
-  | Cast (c,t) -> mkCast (under_casts f c, t)
-  | _            -> f c
-
 (***************************)
 (* Other term constructors *)
 (***************************)
@@ -1027,7 +1018,7 @@ let rec to_lambda n prod =
   else 
     match kind_of_term prod with 
       | Prod (na,ty,bd) -> mkLambda (na,ty,to_lambda (n-1) bd)
-      | Cast (c,_) -> to_lambda n c
+      | Cast (c,_,_) -> to_lambda n c
       | _   -> errorlabstrm "to_lambda" (mt ())                      
 
 let rec to_prod n lam =
@@ -1036,7 +1027,7 @@ let rec to_prod n lam =
   else   
     match kind_of_term lam with 
       | Lambda (na,ty,bd) -> mkProd (na,ty,to_prod (n-1) bd)
-      | Cast (c,_) -> to_prod n c
+      | Cast (c,_,_) -> to_prod n c
       | _   -> errorlabstrm "to_prod" (mt ())                      
 	    
 (* pseudo-reduction rule:
@@ -1066,7 +1057,7 @@ let prod_applist t nL = List.fold_left prod_app t nL
 let decompose_prod = 
   let rec prodec_rec l c = match kind_of_term c with
     | Prod (x,t,c) -> prodec_rec ((x,t)::l) c
-    | Cast (c,_)   -> prodec_rec l c
+    | Cast (c,_,_)   -> prodec_rec l c
     | _              -> l,c
   in 
   prodec_rec []
@@ -1076,7 +1067,7 @@ let decompose_prod =
 let decompose_lam = 
   let rec lamdec_rec l c = match kind_of_term c with
     | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) c
-    | Cast (c,_)     -> lamdec_rec l c
+    | Cast (c,_,_)     -> lamdec_rec l c
     | _                -> l,c
   in 
   lamdec_rec []
@@ -1089,7 +1080,7 @@ let decompose_prod_n n =
     if n=0 then l,c 
     else match kind_of_term c with 
       | Prod (x,t,c) -> prodec_rec ((x,t)::l) (n-1) c
-      | Cast (c,_)   -> prodec_rec l n c
+      | Cast (c,_,_)   -> prodec_rec l n c
       | _ -> error "decompose_prod_n: not enough products"
   in 
   prodec_rec [] n 
@@ -1102,7 +1093,7 @@ let decompose_lam_n n =
     if n=0 then l,c 
     else match kind_of_term c with 
       | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) (n-1) c
-      | Cast (c,_)     -> lamdec_rec l n c
+      | Cast (c,_,_)     -> lamdec_rec l n c
       | _ -> error "decompose_lam_n: not enough abstractions"
   in 
   lamdec_rec [] n 
@@ -1112,7 +1103,7 @@ let decompose_lam_n n =
 let nb_lam = 
   let rec nbrec n c = match kind_of_term c with
     | Lambda (_,_,c) -> nbrec (n+1) c
-    | Cast (c,_) -> nbrec n c
+    | Cast (c,_,_) -> nbrec n c
     | _ -> n
   in 
   nbrec 0
@@ -1121,7 +1112,7 @@ let nb_lam =
 let nb_prod = 
   let rec nbrec n c = match kind_of_term c with
     | Prod (_,_,c) -> nbrec (n+1) c
-    | Cast (c,_) -> nbrec n c
+    | Cast (c,_,_) -> nbrec n c
     | _ -> n
   in 
   nbrec 0
@@ -1137,6 +1128,7 @@ let nb_prod =
 let rec eq_constr m n = 
   (m==n) or
   compare_constr eq_constr m n
+
 let eq_constr m n = eq_constr m n (* to avoid tracing a recursive fun *)
 
 (*******************)
@@ -1177,10 +1169,18 @@ module Hsorts =
 
 let hsort = Hsorts.f
 
-let hcons_constr (hkn,hdir,hname,hident,hstr) =
+let hcons_constr (hcon,hkn,hdir,hname,hident,hstr) =
   let hsortscci = Hashcons.simple_hcons hsort hcons1_univ in
-  let hcci = hcons_term (hsortscci,hkn,hname,hident) in
+  let hcci = hcons_term (hsortscci,hcon,hkn,hname,hident) in
   let htcci = Hashcons.simple_hcons Htype.f (hcci,hsortscci) in
   (hcci,htcci)
 
 let (hcons1_constr, hcons1_types) = hcons_constr (hcons_names())
+
+
+(*******)
+(* Type of abstract machine values *)
+type values
+
+
+
diff --git a/kernel/term.mli b/kernel/term.mli
index a5e5c081..0eccd170 100644
--- a/kernel/term.mli
+++ b/kernel/term.mli
@@ -6,12 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: term.mli,v 1.101.2.1 2004/07/16 19:30:26 herbelin Exp $ i*)
+(*i $Id: term.mli 8049 2006-02-16 10:42:18Z coq $ i*)
 
 (*i*)
 open Names
 (*i*)
 
+
 (*s The sorts of CCI. *)
 
 type contents = Pos | Null
@@ -49,6 +50,7 @@ type case_printing =
 type case_info =
   { ci_ind        : inductive;
     ci_npar       : int;
+    ci_cstr_nargs : int array; (* number of real args of each constructor *)
     ci_pp_info    : case_printing (* not interpreted by the kernel *)
   }
 
@@ -99,9 +101,13 @@ val mkProp : types
 val mkSet  : types
 val mkType : Univ.universe -> types
 
+
+(* This defines the strategy to use for verifiying a Cast *)
+type cast_kind = VMcast | DEFAULTcast 
+
 (* Constructs the term [t1::t2], i.e. the term $t_1$ casted with the 
    type $t_2$ (that means t2 is declared as the type of t1). *)
-val mkCast : constr * types -> constr
+val mkCast : constr * cast_kind * constr -> constr
 
 (* Constructs the product [(x:t1)t2] *)
 val mkProd : name * types * types -> types
@@ -192,7 +198,7 @@ type ('constr, 'types) kind_of_term =
   | Meta      of metavariable
   | Evar      of 'constr pexistential
   | Sort      of sorts
-  | Cast      of 'constr * 'types
+  | Cast      of 'constr * cast_kind * 'types
   | Prod      of name * 'types * 'types
   | Lambda    of name * 'types * 'constr
   | LetIn     of name * 'constr * 'types * 'constr
@@ -213,7 +219,7 @@ val kind_of_term : constr -> (constr, types) kind_of_term
 (* Experimental *)
 type ('constr, 'types) kind_of_type =
   | SortType   of sorts
-  | CastType   of 'types * 'types
+  | CastType   of 'types * 'types 
   | ProdType   of name * 'types * 'types
   | LetInType  of name * 'constr * 'types * 'types
   | AtomicType of 'constr * 'constr array
@@ -230,6 +236,7 @@ val isMeta : constr -> bool
 val isSort : constr -> bool
 val isCast : constr -> bool
 val isApp : constr -> bool
+val isProd : constr -> bool
 val isConst : constr -> bool
 val isConstruct : constr -> bool
 
@@ -258,7 +265,7 @@ val destVar : constr -> identifier
 val destSort : constr -> sorts
 
 (* Destructs a casted term *)
-val destCast : constr -> constr * types
+val destCast : constr -> constr * cast_kind * constr
 
 (* Destructs the product $(x:t_1)t_2$ *)
 val destProd : types -> name * types * types
@@ -270,8 +277,12 @@ val destLambda : constr -> name * types * constr
 val destLetIn : constr -> name * constr * types * constr
 
 (* Destructs an application *)
+val destApp : constr -> constr * constr array
+
+(* Obsolete synonym of destApp *)
 val destApplication : constr -> constr * constr array
-(* ... removing casts *)
+
+(* Decompose any term as an applicative term; the list of args can be empty *)
 val decompose_app : constr -> constr * constr list
 
 (* Destructs a constant *)
@@ -410,6 +421,9 @@ val strip_outer_cast : constr -> constr
 (* Apply a function letting Casted types in place *)
 val under_casts : (constr -> constr) -> constr -> constr
 
+(* Apply a function under components of Cast if any *)
+val under_outer_cast : (constr -> constr) -> constr -> constr
+
 (*s Occur checks *)
 
 (* [closed0 M] is true iff [M] is a (deBruijn) closed term *)
@@ -460,11 +474,6 @@ val subst_vars : identifier list -> constr -> constr
 val substn_vars : int -> identifier list -> constr -> constr
 
 
-(* [subst_mps sub c] performs the substitution [sub] on all kernel
-   names appearing in [c] *)
-val subst_mps : substitution -> constr -> constr
-
-
 (*s Functionals working on the immediate subterm of a construction *)
 
 (* [fold_constr f acc c] folds [f] on the immediate subterms of [c]
@@ -512,6 +521,7 @@ val compare_constr : (constr -> constr -> bool) -> constr -> constr -> bool
 (*********************************************************************)
 
 val hcons_constr:
+  (constant -> constant) *
   (kernel_name -> kernel_name) *
   (dir_path -> dir_path) *
   (name -> name) *
@@ -523,3 +533,7 @@ val hcons_constr:
 
 val hcons1_constr : constr -> constr
 val hcons1_types : types -> types
+
+(**************************************)
+
+type values
diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml
index 5347583f..fde5fa25 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,v 1.5.6.1 2004/07/16 19:30:27 herbelin Exp $ *)
+(* $Id: term_typing.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 open Util
 open Names
@@ -26,15 +26,9 @@ let constrain_type env j cst1 = function
   | None -> j.uj_type, cst1
   | Some t -> 
       let (tj,cst2) = infer_type env t in
-      let cst3 =
-	try conv_leq env j.uj_type tj.utj_val
-	with NotConvertible -> error_actual_type env j tj.utj_val in
-      let typ = 
-        if t = tj.utj_val then t else
-          (error "Kernel built a type different from its input\n";
-           flush stdout; tj.utj_val) in
-      typ, Constraint.union (Constraint.union cst1 cst2) cst3
-
+      let (_,cst3) = judge_of_cast env j DEFAULTcast tj in
+      assert (t = tj.utj_val);
+      t, Constraint.union (Constraint.union cst1 cst2) cst3
 
 let translate_local_def env (b,topt) =
   let (j,cst) = infer env b in
@@ -85,33 +79,38 @@ let infer_declaration env dcl =
   | DefinitionEntry c ->
       let (j,cst) = infer env c.const_entry_body in
       let (typ,cst) = constrain_type env j cst c.const_entry_type in
-      Some (Declarations.from_val j.uj_val), typ, cst, c.const_entry_opaque
+      Some (Declarations.from_val j.uj_val), typ, cst,
+        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
+      None, Typeops.assumption_of_judgment env j, cst, false, false
 
-let build_constant_declaration env (body,typ,cst,op) =
-  let ids = match body with 
+let build_constant_declaration env kn (body,typ,cst,op,boxed) =
+  let ids =
+    match body with 
     | None -> global_vars_set env typ
     | Some b ->
         Idset.union 
 	  (global_vars_set env (Declarations.force b)) 
-	  (global_vars_set env typ) 
+	  (global_vars_set env typ)
   in
+  let tps = Cemitcodes.from_val (compile_constant_body env body op boxed) in
   let hyps = keep_hyps env ids in
-    { const_body = body;
+    { const_hyps = hyps;
+      const_body = body;
       const_type = typ;
-      const_hyps = hyps;
+      const_body_code = tps;
+     (* const_type_code = to_patch env typ;*)
       const_constraints = cst;
       const_opaque = op }
 
 (*s Global and local constant declaration. *)
 
-let translate_constant env ce =
-  build_constant_declaration env (infer_declaration env ce)
+let translate_constant env kn ce =
+  build_constant_declaration env kn (infer_declaration env ce)
 
-let translate_recipe env r = 
-  build_constant_declaration env (Cooking.cook_constant env r)
+let translate_recipe env kn r = 
+  build_constant_declaration env kn (Cooking.cook_constant env r)
 
 (* Insertion of inductive types. *)
 
diff --git a/kernel/term_typing.mli b/kernel/term_typing.mli
index 67d479ba..cf111b6b 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,v 1.2.8.1 2004/07/16 19:30:27 herbelin Exp $ i*)
+(*i $Id: term_typing.mli 6245 2004-10-20 13:50:08Z barras $ i*)
 
 (*i*)
 open Names
@@ -24,11 +24,11 @@ val translate_local_def : env -> constr * types option ->
 
 val translate_local_assum : env -> types ->
   types * Univ.constraints
-
-val translate_constant : env -> constant_entry -> constant_body
+ 
+val translate_constant : env -> constant -> constant_entry -> constant_body
 
 val translate_mind : 
   env -> mutual_inductive_entry -> mutual_inductive_body
 
 val translate_recipe : 
-  env -> Cooking.recipe -> constant_body
+  env -> constant -> Cooking.recipe -> constant_body
diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml
index c3d4726f..3807ecdb 100644
--- a/kernel/type_errors.ml
+++ b/kernel/type_errors.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: type_errors.ml,v 1.31.2.1 2004/07/16 19:30:27 herbelin Exp $ *)
+(* $Id: type_errors.ml 8673 2006-03-29 21:21:52Z herbelin $ *)
 
 open Names
 open Term
@@ -19,7 +19,7 @@ open Reduction
 type guard_error =
   (* Fixpoints *)
   | NotEnoughAbstractionInFixBody
-  | RecursionNotOnInductiveType
+  | RecursionNotOnInductiveType of constr
   | RecursionOnIllegalTerm of int * constr * int list * int list
   | NotEnoughArgumentsForFixCall of int
   (* CoFixpoints *)
@@ -103,7 +103,7 @@ let error_cant_apply_not_functional env rator randl =
   raise (TypeError (env, CantApplyNonFunctional (rator,randl)))
 
 let error_cant_apply_bad_type env t rator randl =
-  raise(TypeError (env, CantApplyBadType (t,rator,randl)))
+  raise (TypeError (env, CantApplyBadType (t,rator,randl)))
 
 let error_ill_formed_rec_body env why lna i =
   raise (TypeError (env, IllFormedRecBody (why,lna,i)))
diff --git a/kernel/type_errors.mli b/kernel/type_errors.mli
index 2e8a7138..c56b174b 100644
--- a/kernel/type_errors.mli
+++ b/kernel/type_errors.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: type_errors.mli,v 1.36.2.1 2004/07/16 19:30:27 herbelin Exp $ i*)
+(*i $Id: type_errors.mli 6019 2004-08-06 18:15:24Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -21,7 +21,7 @@ open Environ
 type guard_error =
   (* Fixpoints *)
   | NotEnoughAbstractionInFixBody
-  | RecursionNotOnInductiveType
+  | RecursionNotOnInductiveType of constr
   | RecursionOnIllegalTerm of int * constr * int list * int list
   | NotEnoughArgumentsForFixCall of int
   (* CoFixpoints *)
diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index 66b2e24d..779a427a 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: typeops.ml,v 1.89.2.1 2004/07/16 19:30:28 herbelin Exp $ *)
+(* $Id: typeops.ml 8673 2006-03-29 21:21:52Z herbelin $ *)
 
 open Util
 open Names
@@ -19,11 +19,24 @@ open Entries
 open Reduction
 open Inductive
 open Type_errors
-
+  
+let conv = default_conv CONV
+let conv_leq = default_conv CUMUL
+
+let conv_leq_vecti env v1 v2 =
+  array_fold_left2_i 
+    (fun i c t1 t2 ->
+      let c' =
+        try default_conv CUMUL env t1 t2 
+        with NotConvertible -> raise (NotConvertibleVect i) in
+      Constraint.union c c')
+    Constraint.empty
+    v1
+    v2
 
 (* This should be a type (a priori without intension to be an assumption) *)
 let type_judgment env j =
-  match kind_of_term(whd_betadeltaiota env (body_of_type j.uj_type)) with
+  match kind_of_term(whd_betadeltaiota env j.uj_type) with
     | Sort s -> {utj_val = j.uj_val; utj_type = s }
     | _ -> error_not_type env j
 
@@ -34,11 +47,9 @@ let assumption_of_judgment env j =
   with TypeError _ ->
     error_assumption env j
 
-(*
-let aojkey = Profile.declare_profile "assumption_of_judgment";;
-let assumption_of_judgment env j
-  = Profile.profile2 aojkey 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 *)
@@ -49,11 +60,11 @@ let assumption_of_judgment env j
 (* Prop and Set *)
 
 let judge_of_prop =
-  { uj_val = body_of_type mkProp;
+  { uj_val = mkProp;
     uj_type = mkSort type_0 }
 
 let judge_of_set =
-  { uj_val = body_of_type mkSet;
+  { uj_val = mkSet;
     uj_type = mkSort type_0 }
 
 let judge_of_prop_contents = function
@@ -64,7 +75,7 @@ let judge_of_prop_contents = function
 
 let judge_of_type u =
   let uu = super u in
-  { uj_val = body_of_type (mkType u);
+  { uj_val = mkType u;
     uj_type = mkType uu }
 
 (*s Type of a de Bruijn index. *)
@@ -77,30 +88,23 @@ let judge_of_relative env n =
   with Not_found -> 
     error_unbound_rel env n
 
-(*
-let relativekey = Profile.declare_profile "judge_of_relative";;
-let judge_of_relative env n =
-  Profile.profile2 relativekey judge_of_relative env n;;
-*)
-
 (* Type of variables *)
 let judge_of_variable env id =
   try
-    let (_,_,ty) = lookup_named id env in
+    let ty = named_type id env in
     make_judge (mkVar id) ty
   with Not_found -> 
     error_unbound_var env id
 
 (* Management of context of variables. *)
 
-(* Checks if a context of variable can be instanciated by the
+(* Checks if a context of variable can be instantiated by the
    variables of the current env *)
 (* TODO: check order? *)
 let rec check_hyps_inclusion env sign =
-  let env_sign = named_context env in
   Sign.fold_named_context
     (fun (id,_,ty1) () ->
-      let (_,_,ty2) = Sign.lookup_named id env_sign in
+      let ty2 = named_type id env in
       if not (eq_constr ty2 ty1) then
         error "types do not match")
     sign
@@ -108,7 +112,6 @@ let rec check_hyps_inclusion env sign =
 
 
 let check_args env c hyps =
-  let hyps' = named_context env in
   try check_hyps_inclusion env hyps
   with UserError _ | Not_found ->
     error_reference_variables env c
@@ -132,12 +135,6 @@ let judge_of_constant env cst =
     check_args env constr ce.const_hyps in 
   make_judge constr (constant_type env cst)
 
-(*
-let tockey = Profile.declare_profile "type_of_constant";;
-let type_of_constant env c 
-  = Profile.profile3 tockey type_of_constant env c;;
-*)
-
 (* Type of a lambda-abstraction. *)
 
 (* [judge_of_abstraction env name var j] implements the rule
@@ -203,9 +200,11 @@ let sort_of_product env domsort rangsort =
           rangsort
         else
           (* Rule is (Type_i,Set,Type_i) in the Set-predicative calculus *)
-          domsort
+          Type (sup u1 base_univ)
     (* Product rule (Prop,Type_i,Type_i) *)
-    | (Prop _,  Type _)  -> rangsort
+    | (Prop Pos,  Type u2)  -> Type (sup base_univ u2)
+    (* Product rule (Prop,Type_i,Type_i) *)
+    | (Prop Null, Type _)  -> rangsort
     (* Product rule (Type_i,Type_i,Type_i) *) 
     | (Type u1, Type u2) -> Type (sup u1 u2)
 
@@ -231,11 +230,14 @@ let judge_of_product env name t1 t2 =
          env |- c:typ2
 *)
 
-let judge_of_cast env cj tj =
+let judge_of_cast env cj k tj =
   let expected_type = tj.utj_val in
   try 
-    let cst = conv_leq env cj.uj_type expected_type in
-    { uj_val = mkCast (j_val cj, expected_type);
+    let cst = 
+      match k with
+      | VMcast -> vm_conv CUMUL env cj.uj_type expected_type
+      | DEFAULTcast -> conv_leq env cj.uj_type expected_type in
+    { uj_val = mkCast (cj.uj_val, k, expected_type);
       uj_type = expected_type },
     cst
   with NotConvertible ->
@@ -249,13 +251,8 @@ let judge_of_inductive env i =
     let (kn,_) = i in
     let mib = lookup_mind kn env in
     check_args env constr mib.mind_hyps in 
-  make_judge constr (type_of_inductive env i)
-
-(*
-let toikey = Profile.declare_profile "judge_of_inductive";;
-let judge_of_inductive env i
-  = Profile.profile2 toikey judge_of_inductive env i;;
-*)
+  let specif = lookup_mind_specif env i in
+  make_judge constr (type_of_inductive specif)
 
 (* Constructors. *)
 
@@ -265,21 +262,16 @@ let judge_of_constructor env c =
     let ((kn,_),_) = c in
     let mib = lookup_mind kn env in
     check_args env constr mib.mind_hyps in 
-  make_judge constr (type_of_constructor env c)
-
-(*
-let tockey = Profile.declare_profile "judge_of_constructor";;
-let judge_of_constructor env cstr
-  = Profile.profile2 tockey judge_of_constructor env cstr;;
-*)
+  let specif = lookup_mind_specif env (inductive_of_constructor c) in
+  make_judge constr (type_of_constructor c specif)
 
 (* Case. *)
 
-let check_branch_types env cj (lft,explft) = 
-  try conv_leq_vecti env lft explft
+let check_branch_types env cj (lfj,explft) = 
+  try conv_leq_vecti env (Array.map j_type lfj) explft
   with
       NotConvertibleVect i ->
-        error_ill_formed_branch env cj.uj_val i lft.(i) explft.(i)
+        error_ill_formed_branch env cj.uj_val i lfj.(i).uj_type explft.(i)
     | Invalid_argument _ ->
         error_number_branches env cj (Array.length explft)
 
@@ -290,20 +282,12 @@ let judge_of_case env ci pj cj lfj =
   let _ = check_case_info env (fst indspec) ci in
   let (bty,rslty,univ) =
     type_case_branches env indspec pj cj.uj_val in
-  let (_,kind) = dest_arity env pj.uj_type in
-  let lft = Array.map j_type lfj in
-  let univ' = check_branch_types env cj (lft,bty) in
+  let univ' = check_branch_types env cj (lfj,bty) in
   ({ uj_val  = mkCase (ci, (*nf_betaiota*) pj.uj_val, cj.uj_val,
                        Array.map j_val lfj);
      uj_type = rslty },
   Constraint.union univ univ')
 
-(*
-let tocasekey = Profile.declare_profile "judge_of_case";;
-let judge_of_case env ci pj cj lfj
-  = Profile.profile6 tocasekey judge_of_case env ci pj cj lfj;;
-*)
-
 (* Fixpoints. *)
 
 (* Checks the type of a general (co)fixpoint, i.e. without checking *)
@@ -313,9 +297,7 @@ let type_fixpoint env lna lar vdefj =
   let lt = Array.length vdefj in
   assert (Array.length lar = lt);
   try
-    conv_leq_vecti env
-      (Array.map (fun j -> body_of_type j.uj_type) vdefj)
-      (Array.map (fun ty -> lift lt ty) lar)
+    conv_leq_vecti env (Array.map j_type vdefj) (Array.map (fun ty -> lift lt ty) lar)
   with NotConvertibleVect i ->
     error_ill_typed_rec_body env i lna vdefj lar
 
@@ -354,8 +336,12 @@ let rec execute env cstr cu =
     | App (f,args) ->
 	let (j,cu1) = execute env f cu in
         let (jl,cu2) = execute_array env args cu1 in
-	univ_combinator cu2
-	  (judge_of_apply env j jl)
+	let (j',cu) = univ_combinator cu2 (judge_of_apply env j jl) in
+	if isInd f then
+	  (* Sort-polymorphism of inductive types *)
+	  adjust_inductive_level env (destInd f) args (j',cu)
+	else
+	  (j',cu)
 	    
     | Lambda (name,c1,c2) -> 
         let (varj,cu1) = execute_type env c1 cu in
@@ -372,16 +358,17 @@ let rec execute env cstr cu =
     | LetIn (name,c1,c2,c3) ->
         let (j1,cu1) = execute env c1 cu in
         let (j2,cu2) = execute_type env c2 cu1 in
-        let (_,cu3) = univ_combinator cu2 (judge_of_cast env j1 j2) in
+        let (_,cu3) = 
+	  univ_combinator cu2 (judge_of_cast env j1 DEFAULTcast j2) in
         let env1 = push_rel (name,Some j1.uj_val,j2.utj_val) env in
         let (j',cu4) = execute env1 c3 cu3 in
         (judge_of_letin env name j1 j2 j', cu4)
 	  
-    | Cast (c,t) ->
+    | Cast (c,k, t) ->
         let (cj,cu1) = execute env c cu in
         let (tj,cu2) = execute_type env t cu1 in
 	univ_combinator cu2
-          (judge_of_cast env cj tj)
+          (judge_of_cast env cj k tj)
 
     (* Inductive types *)
     | Ind ind ->
@@ -430,27 +417,32 @@ and execute_recdef env (names,lar,vdef) i cu =
   univ_combinator cu2
     ((lara.(i),(names,lara,vdefv)),cst)
 
-and execute_array env v cu =
-  let (jl,cu1) = execute_list env (Array.to_list v) cu in
-  (Array.of_list jl, cu1)
-
-and execute_list env l cu =
-  match l with
-  | [] -> 
-      ([], cu)
-  | c::r -> 
-      let (j,cu1) = execute env c cu in 
-      let (jr,cu2) = execute_list env r cu1 in
-      (j::jr, cu2)
+and execute_array env = array_fold_map' (execute env)
+
+and execute_list env = list_fold_map' (execute env) 
+
+and adjust_inductive_level env ind args (j,cu) =
+  let specif = lookup_mind_specif env ind in
+  if is_small_inductive specif then
+    (* No polymorphism *)
+    (j,cu)
+  else
+    (* Retyping constructor with the actual arguments *)
+    let env',llc,ls0 = constructor_instances env specif ind args in
+    let (llj,cu1) = array_fold_map' (execute_array env') llc cu in
+    let ls =
+      Array.map (fun lj ->
+	max_inductive_sort (Array.map (sort_judgment env) lj)) llj
+    in
+    let s = find_inductive_level env specif ind ls0 ls in
+    (on_judgment_type (set_inductive_level env s) j, cu1)
 
 (* Derived functions *)
 let infer env constr =
   let (j,(cst,_)) =
     execute env constr (Constraint.empty, universes env) in
-  let j = if j.uj_val = constr then { j with uj_val = constr } else
-    (error "Kernel built a body different from its input\n";
-     flush stdout; j) in
-  (j, cst)
+  assert (j.uj_val = constr);
+  ({ j with uj_val = constr }, cst)
 
 let infer_type env constr =
   let (j,(cst,_)) =
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index ffe9d861..34ecd103 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,v 1.44.8.1 2004/07/16 19:30:28 herbelin Exp $ i*)
+(*i $Id: typeops.mli 8673 2006-03-29 21:21:52Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -33,6 +33,8 @@ 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
@@ -69,8 +71,8 @@ val judge_of_letin :
 
 (*s Type of a cast. *)
 val judge_of_cast :
-  env -> unsafe_judgment -> unsafe_type_judgment
-    -> unsafe_judgment * constraints
+  env -> unsafe_judgment -> cast_kind -> unsafe_type_judgment ->
+    unsafe_judgment * constraints
 
 (*s Inductive types. *)
 
diff --git a/kernel/univ.ml b/kernel/univ.ml
index 5e9fbd81..23e50282 100644
--- a/kernel/univ.ml
+++ b/kernel/univ.ml
@@ -6,29 +6,41 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: univ.ml,v 1.17.10.3 2005/09/08 12:27:46 herbelin Exp $ *)
+(* $Id: univ.ml 8673 2006-03-29 21:21:52Z herbelin $ *)
 
-(* Universes are stratified by a partial ordering $\ge$.
+(* Universes are stratified by a partial ordering $\le$.
    Let $\~{}$ be the associated equivalence. We also have a strict ordering
-   $>$ between equivalence classes, and we maintain that $>$ is acyclic,
-   and contained in $\ge$ in the sense that $[U]>[V]$ implies $U\ge V$.
+   $<$ between equivalence classes, and we maintain that $<$ is acyclic,
+   and contained in $\le$ in the sense that $[U]<[V]$ implies $U\le V$.
 
    At every moment, we have a finite number of universes, and we
-   maintain the ordering in the presence of assertions $U>V$ and $U\ge V$.
+   maintain the ordering in the presence of assertions $U<V$ and $U\le V$.
 
    The equivalence $\~{}$ is represented by a tree structure, as in the
-   union-find algorithm. The assertions $>$ and $\ge$ are represented by
+   union-find algorithm. The assertions $<$ and $\le$ are represented by
    adjacency lists *)
 
 open Pp
 open Util
 
+(* An algebraic universe [universe] is either a universe variable
+   [universe_level] or a formal universe known to be greater than some
+   universe variables and strictly greater than some (other) universe
+   variables
+
+   Universes variables denote universes initially present in the term
+   to type-check and non variable algebraic universes denote the
+   universes inferred while type-checking: it is either the successor
+   of a universe present in the initial term to type-check or the
+   maximum of two algebraic universes
+ *)
+
 type universe_level =
-    { u_mod : Names.dir_path;
-      u_num : int }
+  | Base
+  | Level of Names.dir_path * int
 
 type universe =
-  | Variable of universe_level
+  | Atom of universe_level
   | Max of universe_level list * universe_level list
   
 module UniverseOrdered = struct
@@ -36,61 +48,60 @@ module UniverseOrdered = struct
   let compare = Pervasives.compare
 end
 
-let string_of_univ_level u =
-  Names.string_of_dirpath u.u_mod^"."^string_of_int u.u_num
+let string_of_univ_level = function
+  | Base -> "0"
+  | Level (d,n) -> Names.string_of_dirpath d^"."^string_of_int n
 
-let make_univ (m,n) = Variable { u_mod=m; u_num=n }
-
-let string_of_univ = function
-  | Variable u -> string_of_univ_level u
-  | Max (gel,gtl) -> 
-      "max("^
-      (String.concat ","
-	 ((List.map string_of_univ_level gel)@
-	  (List.map (fun u -> "("^(string_of_univ_level u)^")+1") gtl)))^")"
+let make_univ (m,n) = Atom (Level (m,n))
 
 let pr_uni_level u = str (string_of_univ_level u)
 
 let pr_uni = function
-  | Variable u -> 
+  | Atom u -> 
       pr_uni_level u
+  | Max ([],[Base]) ->
+      int 1
   | Max (gel,gtl) ->
-      str "max(" ++ 
-      prlist_with_sep pr_coma pr_uni_level gel ++
-      (if gel <> [] & gtl <> [] then pr_coma () else mt ()) ++
-      prlist_with_sep pr_coma
-	(fun x -> str "(" ++ pr_uni_level x ++ str ")+1") gtl ++
+      str "max(" ++ hov 0
+       (prlist_with_sep pr_coma pr_uni_level gel ++
+	  (if gel <> [] & gtl <> [] then pr_coma () else mt ()) ++
+	prlist_with_sep pr_coma
+	  (fun x -> str "(" ++ pr_uni_level x ++ str ")+1") gtl) ++
       str ")"
 
-(* Returns a fresh universe, juste above u. Does not create new universes
-   for Type_0 (the sort of Prop and Set).
+(* Returns the formal universe that lies juste above the universe variable u.
    Used to type the sort u. *)
 let super = function
-  | Variable u -> 
+  | Atom u -> 
       Max ([],[u])
   | Max _ ->
-      anomaly ("Cannot take the successor of a non variable universes\n"^
+      anomaly ("Cannot take the successor of a non variable universes:\n"^
                "(maybe a bugged tactic)")
 
-(* returns the least upper bound of universes u and v. If they are not
-   constrained, then a new universe is created.
+(* Returns the formal universe that is greater than the universes u and v.
    Used to type the products. *)
-let sup u v = 
+let sup u v =
   match u,v with
-    | Variable u, Variable v -> Max ((if u = v then [u] else [u;v]),[])
-    | Variable u, Max (gel,gtl) -> Max (list_add_set u gel,gtl)
-    | Max (gel,gtl), Variable v -> Max (list_add_set v gel,gtl)
+    | Atom u, Atom v -> if u = v then Atom u else Max ([u;v],[])
+    | u, Max ([],[]) -> u
+    | Max ([],[]), v -> v
+    | Atom u, Max (gel,gtl) -> Max (list_add_set u gel,gtl)
+    | Max (gel,gtl), Atom v -> Max (list_add_set v gel,gtl)
     | Max (gel,gtl), Max (gel',gtl') ->
-	Max (list_union gel gel',list_union gtl gtl')
+	let gel'' = list_union gel gel' in
+	let gtl'' = list_union gtl gtl' in
+	Max (list_subtract gel'' gtl'',gtl'')
+
+let sup_array ls = Array.fold_right sup ls (Max ([],[]))
 
 (* Comparison on this type is pointer equality *)
 type canonical_arc =
-    { univ: universe_level; gt: universe_level list; ge: universe_level list }
+    { univ: universe_level; lt: universe_level list; le: universe_level list }
 
-let terminal u = {univ=u; gt=[]; ge=[]}
+let terminal u = {univ=u; lt=[]; le=[]}
 
-(* A universe is either an alias for another one, or a canonical one,
-   for which we know the universes that are smaller *)
+(* A universe_level is either an alias for another one, or a canonical one,
+   for which we know the universes that are above *)
 type univ_entry =
     Canonical of canonical_arc
   | Equiv of universe_level * universe_level
@@ -111,15 +122,23 @@ let declare_univ u g =
   else
     g
 
-(* When typing Prop and Set, there is no constraint on the level,
-   hence the definition of prop_univ *)
+(* The level of Set *)
+let base_univ = Atom Base
+
+let is_base = function
+  | Atom Base -> true
+  | Max ([Base],[]) -> warning "Non canonical Set"; true
+  | u -> false
+
+(* When typing [Prop] and [Set], there is no constraint on the level,
+   hence the definition of [prop_univ], the type of [Prop] *)
 
 let initial_universes = UniverseMap.empty
-let prop_univ = Max ([],[])
+let prop_univ = Max ([],[Base])
 
-(* Every universe has a unique canonical arc representative *)
+(* Every universe_level has a unique canonical arc representative *)
 
-(* repr : universes -> universe -> canonical_arc *)
+(* repr : universes -> universe_level -> canonical_arc *)
 (* canonical representative : we follow the Equiv links *)
 let repr g u = 
   let rec repr_rec u =
@@ -136,30 +155,30 @@ let repr g u =
 
 let can g = List.map (repr g)
 
-(* transitive closure : we follow the Greater links *)
+(* transitive closure : we follow the Less links *)
 
 (* collect : canonical_arc -> canonical_arc list * canonical_arc list *)
-(* collect u = (V,W) iff V={v canonical | u>v} W={w canonical | u>=w}-V *)
-(* i.e. collect does the transitive closure of what is known about u *)
-let collect g arcu = 
-  let rec coll_rec gt ge = function
-    | [],[] -> (gt, list_subtractq ge gt)
-    | arcv::gt', ge' ->
-	if List.memq arcv gt then 
-	  coll_rec gt ge (gt',ge')
+(* collect u = (V,W) iff V={v canonical | u<v} W={w canonical | u<=w}-V *)
+(* i.e. collect does the transitive upward closure of what is known about u *)
+let collect g arcu =
+  let rec coll_rec lt le = function
+    | [],[] -> (lt, list_subtractq le lt)
+    | arcv::lt', le' ->
+	if List.memq arcv lt then 
+	  coll_rec lt le (lt',le')
 	else
-          coll_rec (arcv::gt) ge ((can g (arcv.gt@arcv.ge))@gt',ge')
-    | [], arcw::ge' -> 
-	if (List.memq arcw gt) or (List.memq arcw ge) then 
-	  coll_rec gt ge ([],ge')
+          coll_rec (arcv::lt) le ((can g (arcv.lt@arcv.le))@lt',le')
+    | [], arcw::le' -> 
+	if (List.memq arcw lt) or (List.memq arcw le) then 
+	  coll_rec lt le ([],le')
 	else
-          coll_rec gt (arcw::ge) (can g arcw.gt, (can g arcw.ge)@ge')
+          coll_rec lt (arcw::le) (can g arcw.lt, (can g arcw.le)@le')
   in 
   coll_rec [] [] ([],[arcu])
 
-(* reprgeq : canonical_arc -> canonical_arc list *)
-(* All canonical arcv such that arcu>=arcc with arcv#arcu *)
-let reprgeq g arcu =
+(* reprleq : canonical_arc -> canonical_arc list *)
+(* All canonical arcv such that arcu<=arcv with arcv#arcu *)
+let reprleq g arcu =
   let rec searchrec w = function
     | [] -> w
     | v :: vl ->
@@ -169,17 +188,17 @@ let reprgeq g arcu =
         else 
 	  searchrec (arcv :: w) vl
   in 
-  searchrec [] arcu.ge
+  searchrec [] arcu.le
 
 
-(* between : universe -> canonical_arc -> canonical_arc list *)
-(* between u v = {w|u>=w>=v, w canonical}          *)     
+(* between : universe_level -> canonical_arc -> canonical_arc list *)
+(* between u v = {w|u<=w<=v, w canonical}          *)     
 (* between is the most costly operation *)
 
 let between g u arcv = 
-  (* good are all w | u >= w >= v  *)
-  (* bad are all w | u >= w ~>= v *)
-    (* find good and bad nodes in {w | u >= w} *)
+  (* good are all w | u <= w <= v  *)
+  (* bad are all w | u <= w ~<= v *)
+    (* find good and bad nodes in {w | u <= w} *)
     (* explore b u = (b or "u is good") *)
   let rec explore ((good, bad, b) as input) arcu =
     if List.memq arcu good then
@@ -187,12 +206,12 @@ let between g u arcv =
     else if List.memq arcu bad then
       input    (* (good, bad, b or false) *)
     else 
-      let childs = reprgeq g arcu in 
-	(* are any children of u good ? *)
-      let good, bad, b_childs = 
-	List.fold_left explore (good, bad, false) childs 
+      let leq = reprleq g arcu in 
+	(* is some universe >= u good ? *)
+      let good, bad, b_leq = 
+	List.fold_left explore (good, bad, false) leq
       in
-	if b_childs then
+	if b_leq then
 	  arcu::good, bad, true (* b or true *)
 	else 
 	  good, arcu::bad, b    (* b or false *)
@@ -200,64 +219,64 @@ let between g u arcv =
   let good,_,_ = explore ([arcv],[],false) (repr g u) in
     good
       
-(* We assume  compare(u,v) = GE with v canonical (see compare below).
+(* We assume  compare(u,v) = LE with v canonical (see compare below).
    In this case List.hd(between g u v) = repr u
    Otherwise, between g u v = [] 
  *)
 
 
-type order = EQ | GT | GE | NGE
+type order = EQ | LT | LE | NLE
 
-(* compare : universe -> universe -> order *)
+(* compare : universe_level -> universe_level -> order *)
 let compare g u v = 
   let arcu = repr g u 
   and arcv = repr g v in
   if arcu==arcv then 
     EQ
   else 
-    let (gt,geq) = collect g arcu in
-    if List.memq arcv gt then 
-      GT
-    else if List.memq arcv geq then 
-      GE
+    let (lt,leq) = collect g arcu in
+    if List.memq arcv lt then 
+      LT
+    else if List.memq arcv leq then 
+      LE
     else 
-      NGE
+      NLE
 
 (* Invariants : compare(u,v) = EQ <=> compare(v,u) = EQ
-                compare(u,v) = GT or GE => compare(v,u) = NGE
-                compare(u,v) = NGE => compare(v,u) = NGE or GE or GT
+                compare(u,v) = LT or LE => compare(v,u) = NLE
+                compare(u,v) = NLE => compare(v,u) = NLE or LE or LT
 
-   Adding u>=v is consistent iff compare(v,u) # GT 
-    and then it is redundant iff compare(u,v) # NGE
-   Adding u>v is consistent iff compare(v,u) = NGE 
-    and then it is redundant iff compare(u,v) = GT *)
+   Adding u>=v is consistent iff compare(v,u) # LT 
+    and then it is redundant iff compare(u,v) # NLE
+   Adding u>v is consistent iff compare(v,u) = NLE 
+    and then it is redundant iff compare(u,v) = LT *)
 
 
-(* setgt : universe -> universe -> unit *)
+(* setlt : universe_level -> universe_level -> unit *)
 (* forces u > v *)
-let setgt g u v =
+let setlt g u v =
   let arcu = repr g u in
-  enter_arc {arcu with gt=v::arcu.gt} g
+  enter_arc {arcu with lt=v::arcu.lt} g
 
-(* checks that non-redondant *)
-let setgt_if g u v = match compare g u v with
-  | GT -> g
-  | _ -> setgt g u v
+(* checks that non-redundant *)
+let setlt_if g u v = match compare g u v with
+  | LT -> g
+  | _ -> setlt g u v
 
-(* setgeq : universe -> universe -> unit *)
+(* setleq : universe_level -> universe_level -> unit *)
 (* forces u >= v *)
-let setgeq g u v =
+let setleq g u v =
   let arcu = repr g u in
-  enter_arc {arcu with ge=v::arcu.ge} g
+  enter_arc {arcu with le=v::arcu.le} g
 
 
-(* checks that non-redondant *)
-let setgeq_if g u v = match compare g u v with
-  | NGE -> setgeq g u v
+(* checks that non-redundant *)
+let setleq_if g u v = match compare g u v with
+  | NLE -> setleq g u v
   | _ -> g
 
-(* merge : universe -> universe -> unit *)
-(* we assume  compare(u,v) = GE *)
+(* merge : universe_level -> universe_level -> unit *)
+(* we assume  compare(u,v) = LE *)
 (* merge u v  forces u ~ v with repr u as canonical repr *)
 let merge g u v =
   match between g u (repr g v) with
@@ -265,23 +284,23 @@ let merge g u v =
                  (* redirected to it *)
 	let redirect (g,w,w') arcv =
  	  let g' = enter_equiv_arc arcv.univ arcu.univ g in
- 	  (g',list_unionq arcv.gt w,arcv.ge@w') 
+ 	  (g',list_unionq arcv.lt w,arcv.le@w') 
 	in
 	let (g',w,w') = List.fold_left redirect (g,[],[]) v in
-	let g'' = List.fold_left (fun g -> setgt_if g arcu.univ) g' w in
-	let g''' = List.fold_left (fun g -> setgeq_if g arcu.univ) g'' w' in
+	let g'' = List.fold_left (fun g -> setlt_if g arcu.univ) g' w in
+	let g''' = List.fold_left (fun g -> setleq_if g arcu.univ) g'' w' in
 	g'''
     | [] -> anomaly "Univ.between"
 
-(* merge_disc : universe -> universe -> unit *)
-(* we assume  compare(u,v) = compare(v,u) = NGE *)
+(* merge_disc : universe_level -> universe_level -> unit *)
+(* we assume  compare(u,v) = compare(v,u) = NLE *)
 (* merge_disc u v  forces u ~ v with repr u as canonical repr *)
 let merge_disc g u v =
   let arcu = repr g u in
   let arcv = repr g v in
   let g' = enter_equiv_arc arcv.univ arcu.univ g in
-  let g'' = List.fold_left (fun g -> setgt_if g arcu.univ) g' arcv.gt in
-  let g''' = List.fold_left (fun g -> setgeq_if g arcu.univ) g'' arcv.ge in
+  let g'' = List.fold_left (fun g -> setlt_if g arcu.univ) g' arcv.lt in
+  let g''' = List.fold_left (fun g -> setleq_if g arcu.univ) g'' arcv.le in
   g'''
 
 (* Universe inconsistency: error raised when trying to enforce a relation
@@ -291,55 +310,55 @@ exception UniverseInconsistency
 
 let error_inconsistency () = raise UniverseInconsistency
 
-(* enforcegeq : universe -> universe -> unit *)
-(* enforcegeq u v will force u>=v if possible, will fail otherwise *)
-let enforce_univ_geq u v g =
+(* enforce_univ_leq : universe_level -> universe_level -> unit *)
+(* enforce_univ_leq u v will force u<=v if possible, will fail otherwise *)
+let enforce_univ_leq u v g =
   let g = declare_univ u g in
   let g = declare_univ v g in
   match compare g u v with
-    | NGE -> 
+    | NLE -> 
 	(match compare g v u with
-           | GT -> error_inconsistency()
-           | GE -> merge g v u
-           | NGE -> setgeq g u v
+           | LT -> error_inconsistency()
+           | LE -> merge g v u
+           | NLE -> setleq g u v
            | EQ -> anomaly "Univ.compare")
     | _ -> g
 
-(* enforceq : universe -> universe -> unit *)
-(* enforceq u v will force u=v if possible, will fail otherwise *)
+(* enforc_univ_eq : universe_level -> universe_level -> unit *)
+(* enforc_univ_eq u v will force u=v if possible, will fail otherwise *)
 let enforce_univ_eq u v g =
   let g = declare_univ u g in
   let g = declare_univ v g in
   match compare g u v with
     | EQ -> g
-    | GT -> error_inconsistency()
-    | GE -> merge g u v
-    | NGE -> 
+    | LT -> error_inconsistency()
+    | LE -> merge g u v
+    | NLE -> 
 	(match compare g v u with
-           | GT -> error_inconsistency()
-           | GE -> merge g v u
-           | NGE -> merge_disc g u v
+           | LT -> error_inconsistency()
+           | LE -> merge g v u
+           | NLE -> merge_disc g u v
            | EQ -> anomaly "Univ.compare")
 
-(* enforcegt u v will force u>v if possible, will fail otherwise *)
-let enforce_univ_gt u v g =
+(* enforce_univ_lt u v will force u<v if possible, will fail otherwise *)
+let enforce_univ_lt u v g =
   let g = declare_univ u g in
   let g = declare_univ v g in
   match compare g u v with
-    | GT -> g
-    | GE -> setgt g u v
+    | LT -> g
+    | LE -> setlt g u v
     | EQ -> error_inconsistency()
-    | NGE -> 
+    | NLE -> 
 	(match compare g v u with
-           | NGE -> setgt g u v
+           | NLE -> setlt g u v
            | _ -> error_inconsistency())
 
 (*
 let enforce_univ_relation g = function 
   | Equiv (u,v) -> enforce_univ_eq u v g
-  | Canonical {univ=u; gt=gt; ge=ge} ->
-      let g' = List.fold_right (enforce_univ_gt u) gt g in
-      List.fold_right (enforce_univ_geq u) ge g'
+  | Canonical {univ=u; lt=lt; le=le} ->
+      let g' = List.fold_right (enforce_univ_lt u) lt g in
+      List.fold_right (enforce_univ_leq u) le g'
 *)
 
 (* Merging 2 universe graphs *)
@@ -351,14 +370,14 @@ let merge_universes sp u1 u2 =
 
 (* Constraints and sets of consrtaints. *)
 
-type constraint_type = Gt | Geq | Eq
+type constraint_type = Lt | Leq | Eq
 
 type univ_constraint = universe_level * constraint_type * universe_level
 
 let enforce_constraint cst g =
   match cst with
-    | (u,Gt,v) -> enforce_univ_gt u v g
-    | (u,Geq,v) -> enforce_univ_geq u v g
+    | (u,Lt,v) -> enforce_univ_lt u v g
+    | (u,Leq,v) -> enforce_univ_leq u v g
     | (u,Eq,v) -> enforce_univ_eq u v g
 
 
@@ -373,25 +392,84 @@ type constraints = Constraint.t
 type constraint_function = 
     universe -> universe -> constraints -> constraints
 
-let enforce_gt u v c = Constraint.add (u,Gt,v) c
+let constraint_add_leq v u c =
+  if v = Base then c else Constraint.add (v,Leq,u) c
 
 let enforce_geq u v c =
-  match u with
-    | Variable u -> (match v with
-	| Variable v -> Constraint.add (u,Geq,v) c
-	| Max (l1, l2) ->
-	    let d = List.fold_right (fun v -> Constraint.add (u,Geq,v)) l1 c in
-	    List.fold_right (fun v -> Constraint.add (u,Gt,v)) l2 d) 
-    | Max _ -> anomaly "A universe bound can only be a variable"
+  match u, v with
+  | Atom u, Atom v -> constraint_add_leq v u c
+  | Atom u, Max (gel,gtl) ->
+      let d = List.fold_right (fun v -> constraint_add_leq v u) gel c in
+      List.fold_right (fun v -> Constraint.add (v,Lt,u)) gtl d
+  | _ -> anomaly "A universe bound can only be a variable"
 
 let enforce_eq u v c =
   match (u,v) with
-    | Variable u, Variable v -> Constraint.add (u,Eq,v) c
+    | Atom u, Atom v -> Constraint.add (u,Eq,v) c
     | _ -> anomaly "A universe comparison can only happen between variables"
 
 let merge_constraints c g =
   Constraint.fold enforce_constraint c g
 
+(**********************************************************************)
+(* Tools for sort-polymorphic inductive types                         *)
+
+(* Temporary inductive type levels *)
+
+let fresh_level =
+  let n = ref 0 in fun () -> incr n; Level (Names.make_dirpath [],!n)
+
+let fresh_local_univ () = Atom (fresh_level ())
+
+(* Miscellaneous functions to remove or test local univ assumed to
+   occur only in the le constraints *)
+
+let make_max = function
+  | ([u],[]) -> Atom u
+  | (le,lt) -> Max (le,lt)
+
+let remove_constraint u = function
+  | Atom u' as x -> if u = u' then Max ([],[]) else x
+  | Max (le,lt) -> make_max (list_remove u le,lt)
+
+let is_empty_universe = function
+  | Max ([],[]) -> true
+  | _ -> false
+
+let is_direct_constraint u = function
+  | Atom u' -> u = u'
+  | Max (le,lt) -> List.mem u le
+
+(* 
+   Solve a system of universe constraint of the form
+
+   u_s11, ..., u_s1p1, w1 <= u1
+   ...
+   u_sn1, ..., u_snpn, wn <= un
+
+where 
+
+  - the ui (1 <= i <= n) are universe variables,
+  - the sjk select subsets of the ui for each equations, 
+  - the wi are arbitrary complex universes that do not mention the ui.
+*)
+
+let solve_constraints_system levels level_bounds =
+  let levels = 
+    Array.map (function Atom u -> u | _ -> anomaly "expects Atom") levels in
+  let v = Array.copy level_bounds in
+  let nind = Array.length v in
+  for i=0 to nind-1 do
+    for j=0 to nind-1 do
+      if i<>j & is_direct_constraint levels.(j) v.(i) then
+	v.(i) <- sup v.(i) v.(j)
+    done;
+    for j=0 to nind-1 do
+      v.(i) <- remove_constraint levels.(j) v.(i)
+    done
+  done;
+  v
+
 (* Pretty-printing *)
 
 let num_universes g =
@@ -400,19 +478,19 @@ let num_universes g =
 let num_edges g =
   let reln_len = function
     | Equiv _ -> 1
-    | Canonical {gt=gt;ge=ge} -> List.length gt + List.length ge
+    | Canonical {lt=lt;le=le} -> List.length lt + List.length le
   in
   UniverseMap.fold (fun _ a n -> n + (reln_len a)) g 0
     
 let pr_arc = function 
-  | Canonical {univ=u; gt=[]; ge=[]} ->
+  | Canonical {univ=u; lt=[]; le=[]} ->
       mt ()
-  | Canonical {univ=u; gt=gt; ge=ge} ->
+  | Canonical {univ=u; lt=lt; le=le} ->
       pr_uni_level u ++ str " " ++
       v 0
-        (prlist_with_sep pr_spc (fun v -> str "> " ++ pr_uni_level v) gt ++
-	(if ge <> [] & gt <> [] then spc () else mt ()) ++
-         prlist_with_sep pr_spc (fun v -> str ">= " ++ pr_uni_level v) ge) ++
+        (prlist_with_sep pr_spc (fun v -> str "< " ++ pr_uni_level v) lt ++
+	 (if lt <> [] & le <> [] then spc () else mt()) ++
+         prlist_with_sep pr_spc (fun v -> str "<= " ++ pr_uni_level v) le) ++
       fnl ()
   | Equiv (u,v) -> 
       pr_uni_level u  ++ str " = " ++ pr_uni_level v ++ fnl ()
@@ -426,44 +504,48 @@ let pr_universes g =
 
 let dump_universes output g = 
   let dump_arc _ = function
-    | Canonical {univ=u; gt=gt; ge=ge} -> 
+    | Canonical {univ=u; lt=lt; le=le} -> 
 	let u_str = string_of_univ_level u in
 	  List.iter 
 	    (fun v -> 
 	       Printf.fprintf output "%s > %s ;\n" u_str
 		 (string_of_univ_level v)) 
-	    gt;
+	    lt;
 	  List.iter 
 	    (fun v -> 
 	       Printf.fprintf output "%s >= %s ;\n" u_str
 		 (string_of_univ_level v)) 
-	    ge
+	    le
     | Equiv (u,v) ->
 	Printf.fprintf output "%s = %s ;\n"
 	  (string_of_univ_level u) (string_of_univ_level v)
   in
     UniverseMap.iter dump_arc g 
 
+(* Hash-consing *)
+
 module Huniv =
   Hashcons.Make(
     struct
       type t = universe
       type u = Names.dir_path -> Names.dir_path
-      let hash_aux hdir u = { u with u_mod=hdir u.u_mod }
+      let hash_aux hdir = function
+	| Base -> Base
+	| Level (d,n) -> Level (hdir d,n)
       let hash_sub hdir = function
-	| Variable u -> Variable (hash_aux hdir u)
+	| Atom u -> Atom (hash_aux hdir u)
 	| Max (gel,gtl) ->
 	    Max (List.map (hash_aux hdir) gel, List.map (hash_aux hdir) gtl)
       let equal u v =
 	match u, v with
-	  | Variable u, Variable v -> u == v
+	  | Atom u, Atom v -> u == v
 	  | Max (gel,gtl), Max (gel',gtl') ->
-	      (List.for_all2 (==) gel gel') && (List.for_all2 (==) gtl gtl')
+	      (list_for_all2eq (==) gel gel') &&
+              (list_for_all2eq (==) gtl gtl')
 	  | _ -> false
       let hash = Hashtbl.hash
     end)
 
 let hcons1_univ u =
-  let _,hdir,_,_,_ = Names.hcons_names() in
+  let _,_,hdir,_,_,_ = Names.hcons_names() in
   Hashcons.simple_hcons Huniv.f hdir u
-
diff --git a/kernel/univ.mli b/kernel/univ.mli
index e15971eb..f39f05d9 100644
--- a/kernel/univ.mli
+++ b/kernel/univ.mli
@@ -6,20 +6,27 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: univ.mli,v 1.21.14.1 2004/07/16 19:30:28 herbelin Exp $ i*)
+(*i $Id: univ.mli 8673 2006-03-29 21:21:52Z herbelin $ i*)
 
 (* Universes. *)
 
 type universe
 
+val base_univ : universe
 val prop_univ : universe
 val make_univ : Names.dir_path * int -> universe
 
+val is_base : universe -> bool
+
 (* The type of a universe *)
 val super : universe -> universe
+
 (* The max of 2 universes *)
 val sup   : universe -> universe -> universe
 
+(* The max of an array of universes *)
+val sup_array : universe array -> universe
+
 (*s Graphs of universes. *)
 
 type universes
@@ -47,13 +54,20 @@ exception UniverseInconsistency
 
 val merge_constraints : constraints -> universes -> universes
 
+(*s Support for sort-polymorphic inductive types *)
+
+val fresh_local_univ : unit -> universe
+
+val solve_constraints_system : universe array -> universe array -> 
+  universe array
+
+val is_empty_universe : universe -> bool
+
 (*s Pretty-printing of universes. *)
 
 val pr_uni : universe -> Pp.std_ppcmds
 val pr_universes : universes -> Pp.std_ppcmds
 
-val string_of_univ : universe -> string
-
 (*s Dumping to a file *)
 
 val dump_universes : out_channel -> universes -> unit
diff --git a/kernel/vconv.ml b/kernel/vconv.ml
new file mode 100644
index 00000000..f038c04f
--- /dev/null
+++ b/kernel/vconv.ml
@@ -0,0 +1,555 @@
+open Names
+open Declarations
+open Term
+open Environ
+open Conv_oracle
+open Reduction 
+open Closure
+open Vm
+open Csymtable 
+open Univ
+
+let val_of_constr env c =
+  val_of_constr (pre_env env) c
+
+(* Test la structure des piles *)
+
+let compare_zipper z1 z2 =
+  match z1, z2 with
+  | Zapp args1, Zapp args2 -> nargs args1 = nargs args2
+  | Zfix _, Zfix _ -> true 
+  | Zswitch _, Zswitch _ -> true
+  | _ , _ -> false
+
+let rec compare_stack stk1 stk2 =
+  match stk1, stk2 with
+  | [], [] -> true
+  | z1::stk1, z2::stk2 ->
+      if compare_zipper z1 z2 then compare_stack stk1 stk2
+      else false
+  | _, _ -> false 
+
+(* Conversion *)
+let conv_vect fconv vect1 vect2 cu =
+  let n = Array.length vect1 in
+  if n = Array.length vect2 then
+    let rcu = ref cu in
+    for i = 0 to n - 1 do
+      rcu := fconv vect1.(i) vect2.(i) !rcu
+    done;
+    !rcu
+  else raise NotConvertible
+
+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 
+    
+and conv_whd pb k whd1 whd2 cu =  
+  match whd1, whd2 with
+  | Vsort s1, Vsort s2 -> sort_cmp pb s1 s2 cu 
+  | Vprod p1, Vprod p2 ->
+      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)
+  | Vconstr_const i1, Vconstr_const i2 -> 
+      if i1 = i2 then cu else raise NotConvertible 
+  | Vconstr_block b1, Vconstr_block b2 ->
+      let sz = bsize b1 in
+      if btag b1 = btag b2 && sz = bsize b2 then
+	let rcu = ref cu in
+	for i = 0 to sz - 1 do
+	  rcu := conv_val CONV k (bfield b1 i) (bfield b2 i) !rcu
+	done;
+	!rcu
+      else raise NotConvertible
+  | Vatom_stk(a1,stk1), Vatom_stk(a2,stk2) -> 
+      conv_atom pb k a1 stk1 a2 stk2 cu
+  | _, Vatom_stk(Aiddef(_,v),stk) -> 
+      conv_whd pb k whd1 (force_whd v stk) cu
+  | Vatom_stk(Aiddef(_,v),stk), _ -> 
+      conv_whd pb k (force_whd v stk) whd2 cu
+  | _, _ -> raise NotConvertible
+
+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
+	conv_stack k stk1 stk2 cu
+      else raise NotConvertible
+  | Aid ik1, Aid ik2 -> 
+      if ik1 = ik2 && compare_stack stk1 stk2 then 
+	conv_stack k stk1 stk2 cu 
+      else raise NotConvertible
+  | Aiddef(ik1,v1), Aiddef(ik2,v2) ->
+      begin
+	try
+	  if ik1 = ik2 && compare_stack stk1 stk2 then
+	    conv_stack k stk1 stk2 cu 
+	  else raise NotConvertible
+	with NotConvertible ->
+	  if oracle_order ik1 ik2 then             
+            conv_whd pb k (whd_stack v1 stk1) (Vatom_stk(a2,stk2)) cu
+          else conv_whd pb k (Vatom_stk(a1,stk1)) (whd_stack v2 stk2) cu
+      end
+  | Aiddef(ik1,v1), _ ->
+      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 =
+  match stk1, stk2 with
+  | [], [] -> 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
+      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
+	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
+	done;
+	conv_stack k stk1 stk2 !rcu
+      else raise NotConvertible
+  | _, _ -> raise NotConvertible
+
+and conv_fun pb k f1 f2 cu =
+  if f1 == f2 then cu
+  else
+    let arity,b1,b2 = decompose_vfun2 k f1 f2 in
+    conv_val pb (k+arity) b1 b2 cu
+
+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 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
+    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 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
+    else raise NotConvertible
+
+and conv_arguments k args1 args2 cu =
+  if args1 == args2 then cu
+  else
+    let n = nargs args1 in
+    if n = nargs args2 then
+      let rcu = ref cu in
+      for i = 0 to n - 1 do
+	rcu := conv_val CONV k (arg args1 i) (arg args2 i) !rcu
+      done;
+      !rcu
+    else raise NotConvertible
+
+let rec conv_eq pb t1 t2 cu =
+  if t1 == t2 then cu 
+  else
+    match kind_of_term t1, kind_of_term t2 with
+    | Rel n1, Rel n2 -> 
+	if n1 = n2 then cu else raise NotConvertible
+    | Meta m1, Meta m2 ->
+	if m1 = m2 then cu else raise NotConvertible
+    | Var id1, Var id2 -> 
+	if id1 = id2 then cu else raise NotConvertible
+    | Sort s1, Sort s2 -> sort_cmp pb s1 s2 cu
+    | Cast (c1,_,_), _ -> conv_eq pb c1 t2 cu
+    | _, Cast (c2,_,_) -> conv_eq pb t1 c2 cu
+    | Prod (_,t1,c1), Prod (_,t2,c2) -> 
+	conv_eq pb c1 c2 (conv_eq CONV t1 t2 cu)
+    | Lambda (_,t1,c1), Lambda (_,t2,c2) -> conv_eq CONV c1 c2 cu
+    | LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) -> 
+	conv_eq pb c1 c2 (conv_eq CONV b1 b2 cu)
+    | App (c1,l1), App (c2,l2) ->
+	conv_eq_vect l1 l2 (conv_eq CONV c1 c2 cu)
+    | Evar (e1,l1), Evar (e2,l2) ->
+	if e1 = e2 then conv_eq_vect l1 l2 cu
+	else raise NotConvertible
+    | Const c1, Const c2 -> 
+	if c1 = c2 then cu else raise NotConvertible
+    | Ind c1, Ind c2 -> 
+	if c1 = c2 then cu else raise NotConvertible
+    | Construct c1, Construct c2 -> 
+	if c1 = c2 then cu else raise NotConvertible
+    | Case (_,p1,c1,bl1), Case (_,p2,c2,bl2) ->
+	let pcu = conv_eq CONV p1 p2 cu in
+	let ccu = conv_eq CONV c1 c2 pcu in
+	conv_eq_vect bl1 bl2 ccu
+    | Fix (ln1,(_,tl1,bl1)), Fix (ln2,(_,tl2,bl2)) ->
+	if ln1 = ln2 then conv_eq_vect tl1 tl2 (conv_eq_vect bl1 bl2 cu)
+	else raise NotConvertible
+    | CoFix(ln1,(_,tl1,bl1)), CoFix(ln2,(_,tl2,bl2)) ->	
+	if ln1 = ln2 then conv_eq_vect tl1 tl2 (conv_eq_vect bl1 bl2 cu)
+	else raise NotConvertible
+    | _ -> raise NotConvertible
+
+and conv_eq_vect vt1 vt2 cu =
+  let len = Array.length vt1 in
+  if len = Array.length vt2 then
+    let rcu = ref cu in
+    for i = 0 to len-1 do
+      rcu := conv_eq CONV vt1.(i) vt2.(i) !rcu
+    done; !rcu
+  else raise NotConvertible
+      
+let vconv pb env t1 t2 =
+  let cu =
+    try conv_eq pb t1 t2 Constraint.empty
+    with NotConvertible ->
+      infos := create_clos_infos betaiotazeta env;
+      let v1 = val_of_constr env t1 in
+      let v2 = val_of_constr env t2 in
+      let cu = conv_val pb (nb_rel env) v1 v2 Constraint.empty in
+      cu
+  in cu
+    
+let _ = Reduction.set_vm_conv vconv
+
+let use_vm = ref false
+
+let set_use_vm b =
+  use_vm := b;
+  if b then Reduction.set_default_conv vconv
+  else Reduction.set_default_conv Reduction.conv_cmp
+      
+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 (_,mip) = Inductive.lookup_mind_specif env ind in
+  mip.mind_nf_arity
+
+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 mip.mind_nf_arity (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
new file mode 100644
index 00000000..4aed5d05
--- /dev/null
+++ b/kernel/vconv.mli
@@ -0,0 +1,46 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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*)
+open Names
+open Term
+open Environ
+open Reduction
+(*i*)
+
+(***********************************************************************)
+(*s conversion functions *)
+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
+
+  
diff --git a/kernel/vm.ml b/kernel/vm.ml
new file mode 100644
index 00000000..c8be979e
--- /dev/null
+++ b/kernel/vm.ml
@@ -0,0 +1,601 @@
+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))
+
+let accu_tag = 0
+
+(*******************************************)
+(* Initalisation de la machine abstraite ***)
+(*******************************************)
+
+external init_vm : unit -> unit = "init_coq_vm"
+
+let _ = init_vm ()
+
+external transp_values : unit -> bool = "get_coq_transp_value"
+external set_transp_values : bool -> unit = "coq_set_transp_value"
+
+(*******************************************)
+(* Le code machine  ************************)
+(*******************************************)
+
+type tcode 
+let tcode_of_obj v = ((obj v):tcode)
+let fun_code v = tcode_of_obj (field (repr v) 0)
+
+external mkAccuCode : int -> tcode = "coq_makeaccu"
+external mkPopStopCode : int -> tcode = "coq_pushpop"
+external mkAccuCond : int -> tcode = "coq_accucond"
+
+external offset_tcode : tcode -> int -> tcode = "coq_offset_tcode"
+external int_tcode : tcode -> int -> int = "coq_int_tcode"
+
+external accumulate : unit -> tcode = "accumulate_code"
+let accumulate = accumulate ()
+
+external is_accumulate : tcode -> bool = "coq_is_accumulate_code"
+
+let popstop_tbl =  ref (Array.init 30 mkPopStopCode) 
+
+let popstop_code i =
+  let len = Array.length !popstop_tbl in
+  if i < len then !popstop_tbl.(i) 
+  else
+    begin
+      popstop_tbl :=
+	Array.init (i+10)
+	  (fun j -> if j < len then !popstop_tbl.(j) else mkPopStopCode j);
+      !popstop_tbl.(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] *)
+(*              ^                         *)
+
+(* Products *)
+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 vfix
+
+(* [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 vstack = values array
+
+type vm_env 
+
+type vswitch = {
+    sw_type_code : tcode; 
+    sw_code : tcode; 
+    sw_annot : annot_switch;
+    sw_stk : vstack;
+    sw_env : vm_env
+  } 
+
+(* Ne pas changer ce type sans modifier le code C *)
+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
+  | Zswitch of vswitch
+
+type stack = zipper list
+
+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
+  | 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)
+
+external kind_of_closure : 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)
+    else 
+      let tag = tag o in
+      if tag = accu_tag then
+	if is_accumulate (fun_code o) then whd_accu (obj o) []
+	else 
+	  if size o = 1 then Vsort(obj (field o 0))
+	  else Vprod(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)
+	
+
+
+(************************************************)
+(* La machine abstraite *************************)
+(************************************************)
+
+
+(* gestion de la pile *)
+external push_ra : tcode -> unit = "coq_push_ra"
+external push_val : values -> unit = "coq_push_val"
+external push_arguments : arguments -> unit = "coq_push_arguments"
+external push_vstack : vstack -> unit = "coq_push_vstack"
+
+
+(* interpreteur *)
+external interprete : tcode -> values -> vm_env -> int -> values =
+  "coq_interprete_ml"
+
+let apply_arguments vf vargs =
+  let n = nargs vargs in
+  if n = 0 then vf 
+  else
+   begin
+     push_ra stop;
+     push_arguments vargs;
+     interprete (fun_code vf) vf (magic vf) (n - 1)
+   end
+
+let apply_vstack vf vstk =
+  let n = Array.length vstk in
+  if n = 0 then vf
+  else 
+    begin
+      push_ra stop;
+      push_vstack vstk;
+      interprete (fun_code vf) vf (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
+
+let is_accu v = 
+  is_block (repr v) && tag (repr v) = accu_tag && 
+  fun_code v == accumulate 
+
+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 
+
+let rec force_whd v stk =
+  match whd_stack v stk with
+  | Vatom_stk(Aiddef(_,v),stk) -> force_whd v stk
+  | res -> res
+
+	  
+
+(* Function *)
+external closure_arity : vfun -> int = "coq_closure_arity"
+
+(* [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))
+
+let body_of_vfun k vf =
+  let vargs = mkrel_vstack k 1 in
+  apply_vstack (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);
+  let vargs = mkrel_vstack k arity in
+  let v1 = apply_vstack (magic vf1) vargs in
+  let v2 = apply_vstack (magic vf2) vargs in
+  arity, v1, v2
+    
+  
+(* Fix *)
+external atom_rel : unit -> atom array = "get_coq_atom_tbl"
+external realloc_atom_rel : int -> unit = "realloc_coq_atom_tbl"
+
+let relaccu_tbl =  
+  let atom_rel = atom_rel() in
+  let len = Array.length atom_rel in
+  for i = 0 to len - 1 do atom_rel.(i) <- Aid (RelKey i) done;
+  ref (Array.init len mkAccuCode) 
+
+let relaccu_code i =
+  let len = Array.length !relaccu_tbl in
+  if i < len then !relaccu_tbl.(i) 
+  else
+    begin
+      realloc_atom_rel i;
+      let atom_rel = atom_rel () in
+      let nl = Array.length atom_rel in
+      for j = len to nl - 1 do atom_rel.(j) <- Aid(RelKey j) done;
+      relaccu_tbl :=
+	Array.init nl
+	  (fun j -> if j < len then !relaccu_tbl.(j) else mkAccuCode j);
+      !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
+  (* Construction de l' environnement des corps des points fixes *)
+  let e = dup (repr fb) in
+  for i = 0 to ndef - 1 do
+    set_field e (2 * i) (repr (relaccu_code (k + i)))
+  done;
+  let fix_body i =
+    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
+
+ 
+(* 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
+  for i = 0 to ndef - 1 do
+    set_field e (2 * i) (repr (relaccu_code (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 case_info sw = sw.sw_annot.ci
+    
+let type_of_switch sw = 
+  push_vstack sw.sw_stk;
+  interprete sw.sw_type_code crasy_val sw.sw_env 0 
+    
+let branch_arg k (tag,arity) = 
+  if arity = 0 then  ((magic tag):values)
+  else
+    let b = new_block tag arity in
+    for i = 0 to arity - 1 do
+      set_field b i (repr (val_of_rel (k+i)))
+    done;
+    val_of_obj b
+  
+      
+let branch_of_switch k sw =
+  let eval_branch (_,arity as ta) =
+    let arg = branch_arg k ta in
+    let v = apply_switch sw arg in
+    (arity, v)
+  in 
+  Array.map eval_branch sw.sw_annot.rtbl
+    
+
+    
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/kernel/vm.mli b/kernel/vm.mli
new file mode 100644
index 00000000..b5fd9b9d
--- /dev/null
+++ b/kernel/vm.mli
@@ -0,0 +1,109 @@
+open Names
+open Term
+open Cbytecodes
+open Cemitcodes
+
+
+val set_drawinstr : unit -> unit
+
+val transp_values : unit -> bool
+val set_transp_values : bool -> unit
+(* le code machine *)
+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 zipper =
+  | Zapp of arguments
+  | Zfix of vfix_app
+  | 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 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
+  | Vconstr_const of int
+  | Vconstr_block of vblock
+  | Vatom_stk of atom * stack
+
+(* Constructors *)
+val val_of_str_const : structured_constant -> values
+
+val val_of_rel : int -> values 
+val val_of_rel_def : int -> values -> values 
+
+val val_of_named : identifier -> values
+val val_of_named_def : identifier -> values -> values
+
+val val_of_constant : constant -> values 
+val val_of_constant_def : int -> constant -> values -> values
+
+(* Destructors *)
+val whd_val : values -> whd
+
+(* 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 check_fix : vfix -> vfix -> bool
+val bodies_of_fix : int -> vfix -> vfun array
+val types_of_fix : vfix -> values array
+(* CoFix *)
+val cofix : vcofix_app -> vcofix
+val args_of_cofix : vcofix_app -> arguments
+val cofix_init : vcofix -> int 
+val cofix_ndef : vcofix -> int
+val check_cofix : vcofix -> vcofix -> bool
+val bodies_of_cofix : int -> vcofix -> values array
+val types_of_cofix : vcofix -> values array
+(* Block *)
+val btag : vblock -> int
+val bsize : vblock -> int
+val bfield : vblock -> int -> values
+(* Switch *)
+val eq_tbl : 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
+val force_whd : values -> stack -> whd
+
+
diff --git a/lib/bigint.ml b/lib/bigint.ml
new file mode 100644
index 00000000..5bcceb5c
--- /dev/null
+++ b/lib/bigint.ml
@@ -0,0 +1,392 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: bigint.ml 7305 2005-08-19 19:51:02Z letouzey $ *)
+
+(*i*)
+open Pp
+(*i*)
+
+(***************************************************)
+(* Basic operations on (unbounded) integer numbers *)
+(***************************************************)
+
+(* An integer is canonically represented as an array of k-digits blocs.
+
+   0 is represented by the empty array and -1 by the singleton [|-1|].
+   The first bloc is in the range ]0;10^k[ for positive numbers. 
+   The first bloc is in the range ]-10^k;-1[ for negative ones. 
+   All other blocs are numbers in the range [0;10^k[.
+
+   Negative numbers are represented using 2's complementation. For instance,
+   with 4-digits blocs, [-9655;6789] denotes -96543211
+*)
+
+(* The base is a power of 10 in order to facilitate the parsing and printing
+   of numbers in digital notation.
+
+   All functions, to the exception of to_string and of_string should work
+   with an arbitrary base, even if not a power of 10.
+
+   In practice, we set k=4 so that no overflow in ocaml machine words
+   (i.e. the interval [-2^30;2^30-1]) occur when multiplying two
+   numbers less than (10^k)
+*)
+
+(* The main parameters *)
+
+let size =
+  let rec log10 n = if n < 10 then 0 else 1 + log10 (n / 10) in
+  (log10 max_int) / 2
+
+let format_size =
+  (* How to parametrize a printf format *)
+  if size = 4 then Printf.sprintf "%04d"
+  else fun n ->
+    let rec aux j l n =
+      if j=size then l else aux (j+1) (string_of_int (n mod 10) :: l) (n/10)
+    in String.concat "" (aux 0 [] n)
+
+(* The base is 10^size *)
+let base =
+  let rec exp10 = function 0 -> 1 | n -> 10 * exp10 (n-1) in exp10 size
+
+(* Basic numbers *)
+let zero = [||]
+let neg_one = [|-1|]
+
+(* Sign of an integer *)
+let is_strictly_neg n = n<>[||] && n.(0) < 0
+let is_strictly_pos n = n<>[||] && n.(0) > 0
+let is_neg_or_zero n = n=[||] or n.(0) < 0
+let is_pos_or_zero n = n=[||] or n.(0) > 0
+
+let normalize_pos n =
+  let k = ref 0 in
+  while !k < Array.length n & n.(!k) = 0 do incr k done;
+  Array.sub n !k (Array.length n - !k)
+
+let normalize_neg n =
+  let k = ref 1 in
+  while !k < Array.length n & n.(!k) = base - 1 do incr k done;
+  let n' = Array.sub n !k (Array.length n - !k) in
+  if Array.length n' = 0 then [|-1|] else (n'.(0) <- n'.(0) - base; n')
+
+let rec normalize n =
+  if Array.length n = 0 then n else 
+    if n.(0) = -1 then normalize_neg n else normalize_pos n
+
+let neg m =
+  if m = zero then zero else
+  let n = Array.copy m in
+  let i = ref (Array.length m - 1) in
+  while !i > 0 & n.(!i) = 0 do decr i done;
+  if !i > 0 then begin
+    n.(!i) <- base - n.(!i); decr i;
+    while !i > 0 do n.(!i) <- base - 1 - n.(!i); decr i done;
+    n.(0) <- - n.(0) - 1;
+    if n.(0) < -1 then (n.(0) <- n.(0) + base; Array.append [| -1 |] n) else
+    if n.(0) = - base then (n.(0) <- 0; Array.append [| -1 |] n)
+    else normalize n
+  end else (n.(0) <- - n.(0); n)
+
+let push_carry r j =
+  let j = ref j in
+  while !j > 0 & r.(!j) < 0 do
+    r.(!j) <- r.(!j) + base; decr j; r.(!j) <- r.(!j) - 1
+  done;
+  while !j > 0 & r.(!j) >= base do
+    r.(!j) <- r.(!j) - base; decr j; r.(!j) <- r.(!j) + 1
+  done;
+  if r.(0) >= base then (r.(0) <- r.(0) - base; Array.append [| 1 |] r)
+  else if r.(0) < -base then (r.(0) <- r.(0) + 2*base; Array.append [| -2 |] r)
+  else if r.(0) = -base then (r.(0) <- 0; Array.append [| -1 |] r)
+  else normalize r
+
+let add_to r a j =
+  if a = zero then r else begin
+  for i = Array.length r - 1 downto j+1 do
+    r.(i) <- r.(i) + a.(i-j);
+    if r.(i) >= base then (r.(i) <- r.(i) - base; r.(i-1) <- r.(i-1) + 1)
+  done;
+  r.(j) <- r.(j) + a.(0);
+  push_carry r j
+  end
+
+let add n m =
+  let d = Array.length n - Array.length m in
+  if d > 0 then add_to (Array.copy n) m d else add_to (Array.copy m) n (-d)
+
+let sub_to r a j =
+  if a = zero then r else begin
+  for i = Array.length r - 1 downto j+1 do
+    r.(i) <- r.(i) - a.(i-j);
+    if r.(i) < 0 then (r.(i) <- r.(i) + base; r.(i-1) <- r.(i-1) - 1)
+  done;
+  r.(j) <- r.(j) - a.(0);
+  push_carry r j
+  end
+
+let sub n m =
+  let d = Array.length n - Array.length m in
+  if d >= 0 then sub_to (Array.copy n) m d
+  else let r = neg m in add_to r n (Array.length r - Array.length n)
+
+let rec mult m n =
+  if m = zero or n = zero then zero else
+  let l = Array.length m + Array.length n in
+  let r = Array.create l 0 in
+  for i = Array.length m - 1 downto 0 do
+    for j = Array.length n - 1 downto 0 do
+      let p = m.(i) * n.(j) + r.(i+j+1) in
+      let (q,s) =
+        if p < 0
+        then (p + 1) / base - 1, (p + 1) mod base + base - 1
+        else p / base, p mod base in
+      r.(i+j+1) <- s;
+      if q <> 0 then r.(i+j) <- r.(i+j) + q;
+    done
+  done;
+  normalize r
+
+let rec less_than_same_size m n i j =
+  i < Array.length m &&
+  (m.(i) < n.(j) or (m.(i) = n.(j) && less_than_same_size m n (i+1) (j+1)))
+
+let less_than m n =
+  if is_strictly_neg m then
+    is_pos_or_zero n or Array.length m > Array.length n
+      or (Array.length m = Array.length n && less_than_same_size m n 0 0)
+  else
+    is_strictly_pos n && (Array.length m < Array.length n or
+    (Array.length m = Array.length n && less_than_same_size m n 0 0))
+
+let equal m n = (m = n)
+  
+let less_or_equal_than m n = equal m n or less_than m n
+
+let less_than_shift_pos k m n =
+  (Array.length m - k < Array.length n)
+  or (Array.length m - k = Array.length n && less_than_same_size m n k 0)
+
+let rec can_divide k m d i =
+  (i = Array.length d) or
+  (m.(k+i) > d.(i)) or
+  (m.(k+i) = d.(i) && can_divide k m d (i+1))
+
+(* computes m - d * q * base^(|m|-k) in-place on positive numbers *)
+let sub_mult m d q k =
+  if q <> 0 then
+  for i = Array.length d - 1 downto 0 do
+    let v = d.(i) * q in
+    m.(k+i) <- m.(k+i) - v mod base;
+    if m.(k+i) < 0 then (m.(k+i) <- m.(k+i) + base; m.(k+i-1) <- m.(k+i-1) -1);
+    if v >= base then m.(k+i-1) <- m.(k+i-1) - v / base;
+  done
+
+let euclid m d =
+  let isnegm, m =
+    if is_strictly_neg m then (-1),neg m else 1,Array.copy m in
+  let isnegd, d = if is_strictly_neg d then (-1),neg d else 1,d in
+  if d = zero then raise Division_by_zero;
+  let q,r = 
+    if less_than m d then (zero,m) else
+    let ql = Array.length m - Array.length d in
+    let q = Array.create (ql+1) 0 in
+    let i = ref 0 in
+    while not (less_than_shift_pos !i m d) do
+      if m.(!i)=0 then incr i else
+      if can_divide !i m d 0 then begin
+        let v = 
+          if Array.length d > 1 && d.(0) <> m.(!i) then
+            (m.(!i) * base + m.(!i+1)) / (d.(0) * base + d.(1) + 1)
+          else
+            m.(!i) / d.(0) in
+        q.(!i) <- q.(!i) + v;
+	sub_mult m d v !i
+      end else begin
+        let v = (m.(!i) * base + m.(!i+1)) / (d.(0) + 1) in
+        q.(!i) <- q.(!i) + v / base;
+	sub_mult m d (v / base) !i;
+        q.(!i+1) <- q.(!i+1) + v mod base;
+	if q.(!i+1) >= base then
+	  (q.(!i+1) <- q.(!i+1)-base; q.(!i) <- q.(!i)+1);
+	sub_mult m d (v mod base) (!i+1)
+      end
+    done;
+    (normalize q, normalize m) in
+  (if isnegd * isnegm = -1 then neg q else q),
+  (if isnegm = -1 then neg r else r)
+
+(* Parsing/printing ordinary 10-based numbers *)
+
+let of_string s =
+  let isneg = String.length s > 1 & s.[0] = '-' in
+  let n = if isneg then 1 else 0 in
+  let d = ref n in
+  while !d < String.length s && s.[!d] = '0' do incr d done;
+  if !d = String.length s then zero else
+  let r = (String.length s - !d) mod size in
+  let h = String.sub s (!d) r in
+  if !d = String.length s - 1 && isneg && h="1" then neg_one else
+  let e = if h<>"" then 1 else 0 in 
+  let l = (String.length s - !d) / size in
+  let a = Array.create (l + e + n) 0 in
+  if isneg then begin
+    a.(0) <- (-1); 
+    let carry = ref 0 in
+    for i=l downto 1 do
+      let v = int_of_string (String.sub s ((i-1)*size + !d +r) size)+ !carry in
+      if v <> 0 then (a.(i+e)<- base - v; carry := 1) else carry := 0
+    done;
+    if e=1 then a.(1) <- base - !carry - int_of_string h;
+  end
+  else begin
+    if e=1 then a.(0) <- int_of_string h;
+    for i=1 to l do
+      a.(i+e-1) <- int_of_string (String.sub s ((i-1)*size + !d + r) size)
+    done
+  end;
+  a
+
+let to_string_pos sgn n =
+   if Array.length n = 0 then "0" else
+     sgn ^
+     String.concat ""
+      (string_of_int n.(0) :: List.map format_size (List.tl (Array.to_list n)))
+
+let to_string n =
+  if is_strictly_neg n then to_string_pos "-" (neg n)
+  else to_string_pos "" n
+
+(******************************************************************)
+(* Optimized operations on (unbounded) integer numbers            *)
+(* integers smaller than base are represented as machine integers *)
+(******************************************************************)
+
+type bigint = Obj.t
+
+let ints_of_int n =
+  if n >= base then [| n / base; n mod base |]
+  else if n <= - base then [| n / base - 1; n mod base + base |]
+  else if n = 0 then [| |] else [| n |]
+
+let big_of_int n =
+  if n >= base then Obj.repr [| n / base; n mod base |]
+  else if n <= - base then Obj.repr [| n / base - 1; n mod base + base |]
+  else Obj.repr n
+
+let big_of_ints n =
+  let n = normalize n in
+  if n = zero then Obj.repr 0 else
+  if Array.length n = 1 then Obj.repr n.(0) else
+  Obj.repr n
+
+let coerce_to_int = (Obj.magic : Obj.t -> int)
+let coerce_to_ints = (Obj.magic : Obj.t -> int array)
+
+let ints_of_z n =
+  if Obj.is_int n then ints_of_int (coerce_to_int n)
+  else coerce_to_ints n
+
+let app_pair f (m, n) =
+  (f m, f n)
+
+let add m n =
+  if Obj.is_int m & Obj.is_int n 
+  then big_of_int (coerce_to_int m + coerce_to_int n)
+  else big_of_ints (add (ints_of_z m) (ints_of_z n))
+
+let sub m n =
+  if Obj.is_int m & Obj.is_int n
+  then big_of_int (coerce_to_int m - coerce_to_int n)
+  else big_of_ints (sub (ints_of_z m) (ints_of_z n))
+
+let mult m n =
+  if Obj.is_int m & Obj.is_int n
+  then big_of_int (coerce_to_int m * coerce_to_int n)
+  else big_of_ints (mult (ints_of_z m) (ints_of_z n))
+
+let euclid m n =
+  if Obj.is_int m & Obj.is_int n 
+  then app_pair big_of_int 
+    (coerce_to_int m / coerce_to_int n, coerce_to_int m mod coerce_to_int n)
+  else app_pair big_of_ints (euclid (ints_of_z m) (ints_of_z n))
+
+let less_than m n =
+  if Obj.is_int m & Obj.is_int n
+  then coerce_to_int m < coerce_to_int n
+  else less_than (ints_of_z m) (ints_of_z n)
+
+let neg n =
+  if Obj.is_int n then big_of_int (- (coerce_to_int n))
+  else big_of_ints (neg (ints_of_z n))
+
+let of_string m = big_of_ints (of_string m)
+let to_string m = to_string (ints_of_z m)
+
+let zero = big_of_int 0
+let one = big_of_int 1
+let sub_1 n = sub n one
+let add_1 n = add n one
+let two = big_of_int 2
+let neg_two = big_of_int (-2)
+let mult_2 n = add n n
+let is_zero n = n=zero
+
+let div2_with_rest n =
+  let (q,b) = euclid n two in
+  (q, b = one)
+
+let is_strictly_neg n = is_strictly_neg (ints_of_z n)
+let is_strictly_pos n = is_strictly_pos (ints_of_z n)
+let is_neg_or_zero n = is_neg_or_zero (ints_of_z n)
+let is_pos_or_zero n = is_pos_or_zero (ints_of_z n)
+
+let pr_bigint n = str (to_string n)
+
+(* Testing suite *)
+
+let check () =
+  let numbers = [
+  "1";"2";"99";"100";"101";"9999";"10000";"10001";
+  "999999";"1000000";"1000001";"99999999";"100000000";"100000001";
+  "1234";"5678";"12345678";"987654321";
+  "-1";"-2";"-99";"-100";"-101";"-9999";"-10000";"-10001";
+  "-999999";"-1000000";"-1000001";"-99999999";"-100000000";"-100000001";
+  "-1234";"-5678";"-12345678";"-987654321";"0"
+  ]
+  in
+  let eucl n m =
+    let n' = abs_float n and m' = abs_float m in
+    let q' = floor (n' /. m') in let r' = n' -. m' *. q' in
+    (if n *. m < 0. & q' <> 0. then -. q' else q'),
+    (if n < 0. then -. r' else r') in
+  let round f = floor (abs_float f +. 0.5) *. (if f < 0. then -1. else 1.) in
+  let i = ref 0 in
+  let compare op n n' =
+    incr i;
+    let s = Printf.sprintf "%30s" (to_string n) in
+    let s' = Printf.sprintf "% 30.0f" (round n') in
+    if s <> s' then Printf.printf "%s: %s <> %s\n" op s s' in
+List.iter (fun a -> List.iter (fun b ->  
+  let n = of_string a and m = of_string b in
+  let n' = float_of_string a and m' = float_of_string b in
+  let a = add n m and a' = n' +. m' in
+  let s = sub n m and s' = n' -. m' in
+  let p = mult n m and p' = n' *. m' in
+  let q,r = try euclid n m with Division_by_zero -> zero,zero
+  and q',r' = eucl n' m' in
+  compare "+" a a';
+  compare "-" s s';
+  compare "*" p p';
+  compare "/" q q';
+  compare "%" r r') numbers) numbers;
+  Printf.printf "%i tests done\n" !i
+
+
diff --git a/lib/bigint.mli b/lib/bigint.mli
new file mode 100644
index 00000000..7a835a49
--- /dev/null
+++ b/lib/bigint.mli
@@ -0,0 +1,45 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: bigint.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
+
+(*i*)
+open Pp
+(*i*)
+
+(* Arbitrary large integer numbers *)
+
+type bigint
+
+val of_string : string -> bigint
+val to_string : bigint -> string
+
+val zero : bigint
+val one : bigint
+val two : bigint
+
+val div2_with_rest : bigint -> bigint * bool (* true=odd; false=even *)
+val add_1 : bigint -> bigint
+val sub_1 : bigint -> bigint
+val mult_2 : bigint -> bigint
+
+val add : bigint -> bigint -> bigint
+val sub : bigint -> bigint -> bigint
+val mult : bigint -> bigint -> bigint
+val euclid : bigint -> bigint -> bigint * bigint
+
+val less_than : bigint -> bigint -> bool
+val equal : bigint -> bigint -> bool
+
+val is_strictly_pos : bigint -> bool
+val is_strictly_neg : bigint -> bool
+val is_pos_or_zero : bigint -> bool
+val is_neg_or_zero : bigint -> bool
+val neg : bigint -> bigint
+
+val pr_bigint : bigint -> std_ppcmds
diff --git a/lib/bignat.ml b/lib/bignat.ml
deleted file mode 100644
index 583a027f..00000000
--- a/lib/bignat.ml
+++ /dev/null
@@ -1,116 +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        *)
-(************************************************************************)
-
-(* $Id: bignat.ml,v 1.5.6.1 2004/07/16 19:30:29 herbelin Exp $ *)
-
-(*i*)
-open Pp
-(*i*)
-
-(* Arbitrary big natural numbers *)
-
-type bignat = int array
-
-let digits =            8
-let base =      100000000 (* let enough room for multiplication by 2 *)
-let base_div_2 = 50000000
-let base_to_string x = Printf.sprintf "%08d" x
-
-let of_string s =
-  let a = Array.create (String.length s / digits + 1) 0 in
-  let r = String.length s mod digits in
-  if r<>0 then a.(0) <- int_of_string (String.sub s 0 r);
-  for i = 1 to String.length s / digits do
-    a.(i) <- int_of_string (String.sub s ((i-1)*digits+r) digits)
-  done;
-  a
-
-let rec to_string s =
-  if s = [||] then "0" else
-    if s.(0) = 0 then to_string (Array.sub s 1 (Array.length s - 1))
-    else 
-      String.concat ""
-        ((string_of_int (s.(0)))
-        ::(List.tl (Array.to_list (Array.map base_to_string s))))
-  
-let is_nonzero a =
-  let b = ref false in Array.iter (fun x -> b := x <> 0 || !b) a; !b
-
-let zero = [|0|]
-let one = [|1|]
-
-let is_one a =
-  let rec leading_zero i = i<0 || (a.(i) = 0 && leading_zero (i-1)) in
-  (a.(Array.length a - 1) = 1) && leading_zero (Array.length a - 2)
-      
-let div2_with_rest n =
-  let len = Array.length n in
-  let q = Array.create len 0 in
-  for i = 0 to len - 2 do
-    q.(i) <- q.(i) + n.(i) / 2; q.(i + 1) <- base_div_2 * (n.(i) mod 2)
-  done;
-  q.(len - 1) <- q.(len - 1) + n.(len - 1) / 2;
-  q, (n.(len - 1) mod 2) = 1
-
-let add_1 n =
-  let m = Array.copy n
-  and i = ref (Array.length n - 1) in
-  while !i >= 0 && m.(!i) = base-1 do
-    m.(!i) <- 0; decr i; 
-  done;
-  if !i < 0 then begin
-    m.(0) <- 0; Array.concat [[| 1 |]; m] 
-  end else begin
-    m.(!i) <- m.(!i) + 1; m
-  end
-
-let sub_1 n =
-  if is_nonzero n then
-    let m = Array.copy n
-    and i = ref (Array.length n - 1) in
-    while m.(!i) = 0 && !i > 0 do
-      m.(!i) <- base-1; decr i;
-    done;
-    m.(!i) <- m.(!i) - 1;
-    m
-  else n
-
-let rec mult_2 n =
-  let m = Array.copy n in
-  m.(Array.length n - 1) <- 2 * m.(Array.length n - 1);
-  for i = Array.length n - 2 downto 0 do
-    m.(i) <- 2 * m.(i);
-    if m.(i + 1) >= base then begin
-      m.(i + 1) <- m.(i + 1) - base; m.(i) <- m.(i) + 1 
-    end
-  done;
-  if m.(0) >= base then begin
-    m.(0) <- m.(0) - base; Array.concat [[| 1 |]; m] 
-  end else 
-    m
-
-let less_than m n =
-  let lm = ref 0 in
-  while !lm < Array.length m && m.(!lm) = 0 do incr lm done;
-  let ln = ref 0 in
-  while !ln < Array.length n && n.(!ln) = 0 do incr ln done;
-  let um = Array.length m - !lm and un = Array.length n - !ln in
-  let rec lt d =
-    d < um && (m.(!lm+d) < n.(!ln+d) || (m.(!lm+d) = n.(!ln+d) && lt (d+1)))
-  in
-  (um < un) || (um = un && lt 0)
-
-type bigint = POS of bignat | NEG of bignat
-
-let pr_bigint = function
-  | POS n -> str (to_string n)
-  | NEG n -> str "-" ++ str (to_string n)
-
-let bigint_to_string = function
-  | POS n -> to_string n
-  | NEG n -> "-" ^ (to_string n);;
diff --git a/lib/bignat.mli b/lib/bignat.mli
deleted file mode 100644
index 860bcf29..00000000
--- a/lib/bignat.mli
+++ /dev/null
@@ -1,37 +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: bignat.mli,v 1.4.6.3 2005/01/21 17:14:11 herbelin Exp $ i*)
-
-(*i*)
-open Pp
-(*i*)
-
-(* Arbitrary big natural numbers *)
-
-type bignat
-
-val of_string : string -> bignat
-val to_string : bignat -> string
-
-val is_nonzero : bignat -> bool
-val zero : bignat
-val one : bignat
-val is_one : bignat -> bool
-val div2_with_rest : bignat -> bignat * bool (* true=odd; false=even *)
-
-val add_1 : bignat -> bignat
-val sub_1 : bignat -> bignat (* Remark: [sub_1 0]=0 *)
-val mult_2 : bignat -> bignat
-
-val less_than : bignat -> bignat -> bool
-
-type bigint = POS of bignat | NEG of bignat
-
-val bigint_to_string : bigint -> string
-val pr_bigint : bigint -> std_ppcmds
diff --git a/lib/bstack.ml b/lib/bstack.ml
index d4b995fb..b86dccf9 100644
--- a/lib/bstack.ml
+++ b/lib/bstack.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: bstack.ml,v 1.3.2.1 2004/07/16 19:30:29 herbelin Exp $ *)
+(* $Id: bstack.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* Queues of a given length *)
 
diff --git a/lib/bstack.mli b/lib/bstack.mli
index 617f7df1..f018d155 100644
--- a/lib/bstack.mli
+++ b/lib/bstack.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: bstack.mli,v 1.4.2.1 2004/07/16 19:30:29 herbelin Exp $ i*)
+(*i $Id: bstack.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Bounded stacks. If the depth is [None], then there is no depth limit. *)
 
diff --git a/lib/dyn.ml b/lib/dyn.ml
index 63f00365..94979835 100644
--- a/lib/dyn.ml
+++ b/lib/dyn.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: dyn.ml,v 1.3.16.1 2004/07/16 19:30:29 herbelin Exp $ *)
+(* $Id: dyn.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Util
 
diff --git a/lib/dyn.mli b/lib/dyn.mli
index 7f46c7e6..86a1560a 100644
--- a/lib/dyn.mli
+++ b/lib/dyn.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: dyn.mli,v 1.3.16.1 2004/07/16 19:30:29 herbelin Exp $ i*)
+(*i $Id: dyn.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Dynamics. Use with extreme care. Not for kids. *)
 
diff --git a/lib/edit.ml b/lib/edit.ml
index 5020ef5c..03420992 100644
--- a/lib/edit.ml
+++ b/lib/edit.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: edit.ml,v 1.8.2.1 2004/07/16 19:30:29 herbelin Exp $ *)
+(* $Id: edit.ml 6947 2005-04-20 16:18:41Z coq $ *)
 
 open Pp
 open Util
@@ -84,6 +84,28 @@ let undo e n =
 	  errorlabstrm "Edit.undo" (str"Undo stack exhausted");
         repeat n Bstack.pop bs
 
+(* Return the depth of the focused proof of [e] stack, this is used to
+   put informations in coq prompt (in emacs mode). *)
+let depth e =
+  match e.focus with
+    | None -> invalid_arg "Edit.depth"
+    | Some d ->
+	let (bs,_) = Hashtbl.find e.buf d in
+	Bstack.depth bs
+
+(* Undo focused proof of [e] to reach depth [n] *)
+let undo_todepth e n =
+  match e.focus with
+    | None -> 
+	if n <> 0 
+	then errorlabstrm "Edit.undo_todepth" (str"No proof in progress")
+	else () (* if there is no proof in progress, then n must be zero *)
+    | Some d ->
+	let (bs,_) = Hashtbl.find e.buf d in
+	if Bstack.depth bs < n then
+	  errorlabstrm "Edit.undo_todepth" (str"Undo stack would be exhausted");
+        repeat (Bstack.depth bs - n) Bstack.pop bs
+
 let create e (d,b,c,udepth) =
   if Hashtbl.mem e.buf d then
     errorlabstrm "Edit.create" 
diff --git a/lib/edit.mli b/lib/edit.mli
index edf0f67b..ab82c1f9 100644
--- a/lib/edit.mli
+++ b/lib/edit.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: edit.mli,v 1.5.2.1 2004/07/16 19:30:29 herbelin Exp $ i*)
+(*i $Id: edit.mli 6947 2005-04-20 16:18:41Z coq $ i*)
 
 (* The type of editors.
  * An editor is a finite map, ['a -> 'b], which knows how to apply
@@ -54,3 +54,10 @@ val delete : ('a,'b,'c) t -> 'a -> unit
 val dom : ('a,'b,'c) t -> 'a list
 
 val clear : ('a,'b,'c) t -> unit
+
+(* [depth e] Returns the depth of the focused proof stack of [e], this
+   is used to put informations in coq prompt (in emacs mode). *)
+val depth : ('a,'b,'c) t -> int
+
+(* [undo_todepth e n] Undoes focused proof of [e] to reach depth [n] *)
+val undo_todepth : ('a,'b,'c) t -> int -> unit
diff --git a/lib/explore.ml b/lib/explore.ml
index 2eaabef8..7e6de0c4 100644
--- a/lib/explore.ml
+++ b/lib/explore.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: explore.ml,v 1.3.16.1 2004/07/16 19:30:29 herbelin Exp $ i*)
+(*i $Id: explore.ml 6066 2004-09-06 22:54:50Z barras $ i*)
 
 open Format
 
@@ -37,6 +37,7 @@ module Make = functor(S : SearchProblem) -> struct
     if S.success s then s else depth_first_many (S.branching s)
   and depth_first_many = function
     | [] -> raise Not_found
+    | [s] -> depth_first s
     | s :: l -> try depth_first s with Not_found -> depth_first_many l
 
   let debug_depth_first s = 
@@ -44,8 +45,8 @@ module Make = functor(S : SearchProblem) -> struct
       pp_position p; S.pp s;
       if S.success s then s else explore_many 1 p (S.branching s)
     and explore_many i p = function
-      | [] -> 
-	  raise Not_found
+      | [] -> raise Not_found
+      | [s] -> explore (i::p) s
       | s :: l -> 
 	  try explore (i::p) s with Not_found -> explore_many (succ i) p l
     in
@@ -67,10 +68,8 @@ module Make = functor(S : SearchProblem) -> struct
 
   let breadth_first s = 
     let rec explore q =
-      try 
-	let (s, q') = pop q in enqueue q' (S.branching s)
-      with Empty ->
-	raise Not_found
+      let (s, q') = try pop q with Empty -> raise Not_found in
+      enqueue q' (S.branching s)
     and enqueue q = function
       | [] -> explore q
       | s :: l -> if S.success s then s else enqueue (push s q) l
@@ -79,11 +78,8 @@ module Make = functor(S : SearchProblem) -> struct
 
   let debug_breadth_first s = 
     let rec explore q =
-      try 
-	let ((p,s), q') = pop q in 
-	enqueue 1 p q' (S.branching s)
-      with Empty ->
-	raise Not_found
+      let ((p,s), q') = try pop q with Empty -> raise Not_found in 
+      enqueue 1 p q' (S.branching s)
     and enqueue i p q = function
       | [] -> 
 	  explore q
diff --git a/lib/explore.mli b/lib/explore.mli
index 1236f06b..07f95e8a 100644
--- a/lib/explore.mli
+++ b/lib/explore.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: explore.mli,v 1.2.16.1 2004/07/16 19:30:29 herbelin Exp $ i*)
+(*i $Id: explore.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*s Search strategies. *)
 
diff --git a/lib/gmap.ml b/lib/gmap.ml
index e5d41034..884305d9 100644
--- a/lib/gmap.ml
+++ b/lib/gmap.ml
@@ -5,10 +5,10 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: gmap.ml,v 1.3.16.1 2004/07/16 19:30:29 herbelin Exp $ *)
+(* $Id: gmap.ml 7925 2006-01-24 23:20:39Z herbelin $ *)
 
 (* Maps using the generic comparison function of ocaml. Code borrowed from
-   the ocaml standard library. *)
+   the ocaml standard library (Copyright 1996, INRIA). *)
 
     type ('a,'b) t =
         Empty
@@ -57,7 +57,7 @@
     let rec add x data = function
         Empty ->
           Node(Empty, x, data, Empty, 1)
-      | Node(l, v, d, r, h) as t ->
+      | Node(l, v, d, r, h) ->
           let c = Pervasives.compare x v in
           if c = 0 then
             Node(l, x, data, r, h)
@@ -81,17 +81,28 @@
           let c = Pervasives.compare x v in
           c = 0 || mem x (if c < 0 then l else r)
 
-    let rec merge t1 t2 =
+    let rec min_binding = function
+        Empty -> raise Not_found
+      | Node(Empty, x, d, r, _) -> (x, d)
+      | Node(l, x, d, r, _) -> min_binding l
+
+    let rec remove_min_binding = function
+        Empty -> invalid_arg "Map.remove_min_elt"
+      | Node(Empty, x, d, r, _) -> r
+      | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r
+
+    let merge t1 t2 =
       match (t1, t2) with
         (Empty, t) -> t
       | (t, Empty) -> t
-      | (Node(l1, v1, d1, r1, h1), Node(l2, v2, d2, r2, h2)) ->
-          bal l1 v1 d1 (bal (merge r1 l2) v2 d2 r2)
+      | (_, _) ->
+          let (x, d) = min_binding t2 in
+          bal t1 x d (remove_min_binding t2)
 
     let rec remove x = function
         Empty ->
           Empty
-      | Node(l, v, d, r, h) as t ->
+      | Node(l, v, d, r, h) ->
           let c = Pervasives.compare x v in
           if c = 0 then
             merge l r
@@ -109,6 +120,9 @@
         Empty               -> Empty
       | Node(l, v, d, r, h) -> Node(map f l, v, f d, map f r, h)
 
+    (* Maintien de fold_right par compatibilité (changé en fold_left dans
+       ocaml-3.09.0) *)
+
     let rec fold f m accu =
       match m with
         Empty -> accu
diff --git a/lib/gmap.mli b/lib/gmap.mli
index 7415a395..79958fab 100644
--- a/lib/gmap.mli
+++ b/lib/gmap.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: gmap.mli,v 1.4.16.1 2004/07/16 19:30:29 herbelin Exp $ i*)
+(*i $Id: gmap.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Maps using the generic comparison function of ocaml. Same interface as
    the module [Map] from the ocaml standard library. *)
diff --git a/lib/gmapl.ml b/lib/gmapl.ml
index 5eb4e110..0974909d 100644
--- a/lib/gmapl.ml
+++ b/lib/gmapl.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: gmapl.ml,v 1.2.16.2 2006/01/03 20:31:16 herbelin Exp $ *)
+(* $Id: gmapl.ml 7780 2006-01-03 20:33:53Z herbelin $ *)
 
 open Util
 
diff --git a/lib/gmapl.mli b/lib/gmapl.mli
index f8855ae4..db8f4358 100644
--- a/lib/gmapl.mli
+++ b/lib/gmapl.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: gmapl.mli,v 1.4.16.1 2004/07/16 19:30:30 herbelin Exp $ i*)
+(*i $Id: gmapl.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Maps from ['a] to lists of ['b]. *)
 
diff --git a/lib/gset.ml b/lib/gset.ml
index 5ea2f82b..e90386a0 100644
--- a/lib/gset.ml
+++ b/lib/gset.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: gset.ml,v 1.2.16.1 2004/07/16 19:30:30 herbelin Exp $ *)
+(* $Id: gset.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* Sets using the generic comparison function of ocaml. Code borrowed from
    the ocaml standard library. *)
diff --git a/lib/gset.mli b/lib/gset.mli
index 32d798cc..0f14368f 100644
--- a/lib/gset.mli
+++ b/lib/gset.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: gset.mli,v 1.3.16.1 2004/07/16 19:30:30 herbelin Exp $ i*)
+(*i $Id: gset.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Sets using the generic comparison function of ocaml. Same interface as
    the module [Set] from the ocaml standard library. *)
diff --git a/lib/hashcons.ml b/lib/hashcons.ml
index 5f083459..50be0ec4 100644
--- a/lib/hashcons.ml
+++ b/lib/hashcons.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: hashcons.ml,v 1.3.16.1 2004/07/16 19:30:30 herbelin Exp $ *)
+(* $Id: hashcons.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* Hash consing of datastructures *)
 
diff --git a/lib/hashcons.mli b/lib/hashcons.mli
index 2e32323a..f1e55ba1 100644
--- a/lib/hashcons.mli
+++ b/lib/hashcons.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: hashcons.mli,v 1.5.16.1 2004/07/16 19:30:30 herbelin Exp $ i*)
+(*i $Id: hashcons.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Generic hash-consing. *)
 
diff --git a/lib/heap.ml b/lib/heap.ml
index f0db2943..92aa0070 100644
--- a/lib/heap.ml
+++ b/lib/heap.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: heap.ml,v 1.1.2.1 2004/07/16 19:30:30 herbelin Exp $ *)
+(* $Id: heap.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (*s Heaps *)
 
diff --git a/lib/heap.mli b/lib/heap.mli
index 46e72728..d351edd0 100644
--- a/lib/heap.mli
+++ b/lib/heap.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: heap.mli,v 1.1.2.2 2005/01/21 17:14:11 herbelin Exp $ i*)
+(*i $Id: heap.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 (* Heaps *)
 
diff --git a/lib/options.ml b/lib/options.ml
index b5c5efda..0d934922 100644
--- a/lib/options.ml
+++ b/lib/options.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: options.ml,v 1.27.2.1 2004/07/16 19:30:30 herbelin Exp $ *)
+(* $Id: options.ml 7740 2005-12-26 20:07:21Z herbelin $ *)
 
 open Util
 
@@ -23,8 +23,6 @@ let debug = ref false
 
 let print_emacs = ref false
 
-let emacs_str s = if !print_emacs then s else "" 
-
 let term_quality = ref false
 
 let xml_export = ref false
@@ -33,22 +31,11 @@ let dont_load_proofs = ref false
 
 let raw_print = ref false
 
-let v7 =
-  let transl = array_exists ((=) "-translate") Sys.argv in
-  let v7 = array_exists ((=) "-v7") Sys.argv in
-  let v8 = array_exists ((=) "-v8") Sys.argv in
-  if v8 & transl then error "Options -translate and -v8 are incompatible";
-  if v8 & v7 then error "Options -v7 and -v8 are incompatible";
-  ref (v7 or transl)
-
-let v7_only = ref false
-
 (* Translate *)
 let translate = ref false
-let make_translate f = translate := f; v7 := f; ()
+let make_translate f = translate := f
 let do_translate () = !translate
 let translate_file = ref false
-let translate_strict_impargs = ref true
 
 (* True only when interning from pp*new.ml *)
 let translate_syntax = ref false
@@ -73,6 +60,8 @@ let silently f x =
 let if_silent f x = if !silent then f x
 let if_verbose f x = if not !silent then f x
 
+let hash_cons_proofs = ref true
+
 (* The number of printed hypothesis in a goal *)
 
 let print_hyps_limit = ref (None : int option)
@@ -105,3 +94,30 @@ let dump_it () =
   end
 
 let _ = at_exit dump_it
+
+(* Options for the virtual machine *)
+
+let boxed_definitions = ref true
+let set_boxed_definitions b = boxed_definitions := b
+let boxed_definitions _ = !boxed_definitions 
+ 
+(* Options for external tools *)
+
+let browser_cmd_fmt =
+ try
+  let coq_netscape_remote_var = "COQREMOTEBROWSER" in
+  let coq_netscape_remote = Sys.getenv coq_netscape_remote_var in
+  let i = Util.string_index_from coq_netscape_remote 0 "%s" in
+  let pre = String.sub coq_netscape_remote 0 i in
+  let post = String.sub coq_netscape_remote (i + 2)
+              (String.length coq_netscape_remote - (i + 2)) in
+   if Util.string_string_contains ~where:post ~what:"%s" then
+    error ("The environment variable \"" ^
+           coq_netscape_remote_var ^
+           "\" must contain exactly one placeholder \"%s\".")
+   else pre,post
+ with
+  Not_found ->
+   if Sys.os_type = "Win32"
+   then "C:\\PROGRA~1\\INTERN~1\\IEXPLORE ", ""
+   else "netscape -remote \"OpenURL(", ")\""
diff --git a/lib/options.mli b/lib/options.mli
index 731b7da4..1a5444a4 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,v 1.25.2.1 2004/07/16 19:30:30 herbelin Exp $ i*)
+(*i $Id: options.mli 7740 2005-12-26 20:07:21Z herbelin $ i*)
 
 (* Global options of the system. *)
 
@@ -17,7 +17,6 @@ val batch_mode : bool ref
 val debug : bool ref
 
 val print_emacs : bool ref
-val emacs_str : string -> string
 
 val term_quality : bool ref
 
@@ -27,15 +26,11 @@ val dont_load_proofs : bool ref
 
 val raw_print : bool ref
 
-val v7 : bool ref
-val v7_only : bool ref
-
 val translate : bool ref
 val make_translate : bool -> unit
 val do_translate : unit -> bool
 val translate_file : bool ref
 val translate_syntax : bool ref
-val translate_strict_impargs : bool ref
 
 val make_silent : bool -> unit
 val is_silent : unit -> bool
@@ -44,6 +39,8 @@ val silently : ('a -> 'b) -> 'a -> 'b
 val if_silent : ('a -> unit) -> 'a -> unit
 val if_verbose : ('a -> unit) -> 'a -> unit
 
+val hash_cons_proofs : bool ref
+
 (* Temporary activate an option ('c must be an atomic type) *)
 val with_option : bool ref -> ('a -> 'b) -> 'a -> 'b
 
@@ -60,3 +57,14 @@ val dump : bool ref
 val dump_into_file : string -> unit
 val dump_string : string -> unit
 
+(* Options for the virtual machine *)
+
+val set_boxed_definitions : bool -> unit
+val boxed_definitions : unit -> bool
+
+(* Options for external tools *)
+
+(* Returns head and tail of printf string format *)
+(* ocaml doesn't allow not applied formats *)
+val browser_cmd_fmt : string * string
+ 
diff --git a/lib/pp.ml4 b/lib/pp.ml4
index 25ab9ce8..e7ba9869 100644
--- a/lib/pp.ml4
+++ b/lib/pp.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pp.ml4,v 1.5.2.1 2004/07/16 19:30:30 herbelin Exp $ *)
+(* $Id: pp.ml4 7751 2005-12-28 12:58:53Z herbelin $ *)
 
 open Pp_control
 
@@ -122,17 +122,17 @@ let int n = str (string_of_int n)
 let real r = str (string_of_float r)
 let bool b = str (string_of_bool b)
 
+(* In new syntax only double quote char is escaped by repeating it *)
 let rec escape_string s =
   let rec escape_at s i =
     if i<0 then s
-    else if s.[i] == '\\' || s.[i] == '"' then
-      let s' = String.sub s 0 i^"\\"^String.sub s i (String.length s - i) in
+    else if s.[i] == '"' then
+      let s' = String.sub s 0 i^"\""^String.sub s i (String.length s - i) in
       escape_at s' (i-1)
     else escape_at s (i-1) in
   escape_at s (String.length s - 1)
 
-
-let qstring s = str ("\""^(escape_string s)^"\"")
+let qstring s = str ("\""^escape_string s^"\"")
 let qs = qstring
 
 (* boxing commands *)
@@ -183,7 +183,6 @@ let rec pr_com ft s =
 
 (* pretty printing functions *)
 let pp_dirs ft = 
-  let maxbox = (get_gp ft).max_depth in
   let pp_open_box = function
     | Pp_hbox n   -> Format.pp_open_hbox ft ()
     | Pp_vbox n   -> Format.pp_open_vbox ft n
diff --git a/lib/pp.mli b/lib/pp.mli
index 417ea107..88deb6d2 100644
--- a/lib/pp.mli
+++ b/lib/pp.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pp.mli,v 1.8.2.1 2004/07/16 19:30:30 herbelin Exp $ i*)
+(*i $Id: pp.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Pp_control
diff --git a/lib/pp_control.ml b/lib/pp_control.ml
index 85303f74..7632d736 100644
--- a/lib/pp_control.ml
+++ b/lib/pp_control.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pp_control.ml,v 1.8.2.1 2004/07/16 19:30:31 herbelin Exp $ *)
+(* $Id: pp_control.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* Parameters of pretty-printing *)
 
diff --git a/lib/pp_control.mli b/lib/pp_control.mli
index 3588847d..7e25e561 100644
--- a/lib/pp_control.mli
+++ b/lib/pp_control.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pp_control.mli,v 1.7.2.1 2004/07/16 19:30:31 herbelin Exp $ i*)
+(*i $Id: pp_control.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Parameters of pretty-printing. *)
 
diff --git a/lib/predicate.ml b/lib/predicate.ml
index 1eaa20ce..93b74463 100644
--- a/lib/predicate.ml
+++ b/lib/predicate.ml
@@ -10,7 +10,7 @@
 (*                                                                     *)
 (************************************************************************)
 
-(* $Id: predicate.ml,v 1.1.14.1 2004/07/16 19:30:31 herbelin Exp $ *)
+(* $Id: predicate.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* Sets over ordered types *)
 
diff --git a/lib/predicate.mli b/lib/predicate.mli
index 2dc7d85c..85596fea 100644
--- a/lib/predicate.mli
+++ b/lib/predicate.mli
@@ -1,5 +1,5 @@
 
-(*i $Id: predicate.mli,v 1.1.14.1 2005/01/21 17:14:11 herbelin Exp $ i*)
+(*i $Id: predicate.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 (* Module [Pred]: sets over infinite ordered types with complement. *)
 
diff --git a/lib/profile.ml b/lib/profile.ml
index f55388f8..dd7e977e 100644
--- a/lib/profile.ml
+++ b/lib/profile.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: profile.ml,v 1.13.16.1 2004/07/16 19:30:31 herbelin Exp $ *)
+(* $Id: profile.ml 7538 2005-11-08 17:14:52Z herbelin $ *)
 
 open Gc
 
@@ -259,9 +259,9 @@ let time_overhead_B_C () =
   for i=1 to loops do
     try
       dummy_last_alloc := get_alloc ();
-      let r = dummy_f dummy_x in
-      let dw = dummy_spent_alloc () in
-      let dt = get_time () in
+      let _r = dummy_f dummy_x in
+      let _dw = dummy_spent_alloc () in
+      let _dt = get_time () in
       ()
     with _ -> assert false
   done;
@@ -328,7 +328,7 @@ let close_profile print =
 	outside.owntime <- outside.owntime + t;
 	ajoute_ownalloc outside dw;
 	ajoute_totalloc outside dw;
-	if List.length !prof_table <> 0 then begin
+	if !prof_table <> [] then begin
 	  let ov_bc = time_overhead_B_C () (* B+C overhead *) in
 	  let ov_ad = time_overhead_A_D () (* A+D overhead *) in
 	  let adjust (n,e) = (n, adjust_time ov_bc ov_ad e) in
diff --git a/lib/profile.mli b/lib/profile.mli
index e8ce8994..0937e9e3 100644
--- a/lib/profile.mli
+++ b/lib/profile.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: profile.mli,v 1.7.16.2 2005/01/21 17:14:11 herbelin Exp $ i*)
+(*i $Id: profile.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 (*s This program is a small time and allocation profiler for Objective Caml *)
 
diff --git a/lib/rtree.ml b/lib/rtree.ml
index 53cc372f..ab689be1 100644
--- a/lib/rtree.ml
+++ b/lib/rtree.ml
@@ -6,16 +6,16 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: rtree.ml,v 1.2.8.1 2004/07/16 19:30:31 herbelin Exp $ i*)
+(*i $Id: rtree.ml 8648 2006-03-18 15:37:14Z herbelin $ i*)
 
 
 (* Type of regular trees:
    - Param denotes tree variables (like de Bruijn indices)
-   - Node denotes the usual tree node, labelles with 'a
+   - Node denotes the usual tree node, labelled with 'a
    - Rec(j,v1..vn) introduces infinite tree. It denotes
      v(j+1) with parameters 0..n-1 replaced by
      Rec(0,v1..vn)..Rec(n-1,v1..vn) respectively.
-     Parameters n and higher denote parameters globals to the
+     Parameters n and higher denote parameters global to the
      current Rec node (as usual in de Bruijn binding system)
  *)
 type 'a t =
diff --git a/lib/rtree.mli b/lib/rtree.mli
index 79b57586..7be96652 100644
--- a/lib/rtree.mli
+++ b/lib/rtree.mli
@@ -6,10 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: rtree.mli,v 1.2.8.2 2005/01/21 16:41:52 herbelin Exp $ i*)
+(*i $Id: rtree.mli 7493 2005-11-02 22:12:16Z mohring $ i*)
 
 (* Type of regular tree with nodes labelled by values of type 'a *)
-type 'a t
+
+type 'a t 
 
 (* Building trees *)
 (* build a recursive call *) 
diff --git a/lib/stamps.ml b/lib/stamps.ml
index 1697c309..0f481516 100644
--- a/lib/stamps.ml
+++ b/lib/stamps.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: stamps.ml,v 1.2.16.1 2004/07/16 19:30:31 herbelin Exp $ *)
+(* $Id: stamps.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 let new_stamp = 
   let stamp_ctr = ref 0 in
diff --git a/lib/stamps.mli b/lib/stamps.mli
index 36f238b9..6fa3077f 100644
--- a/lib/stamps.mli
+++ b/lib/stamps.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: stamps.mli,v 1.3.16.1 2004/07/16 19:30:31 herbelin Exp $ i*)
+(*i $Id: stamps.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Time stamps. *)
 
diff --git a/lib/system.ml b/lib/system.ml
index 9bbcc308..fb3cf7b5 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: system.ml,v 1.31.8.3 2006/01/10 17:06:23 barras Exp $ *)
+(* $Id: system.ml 7603 2005-11-23 17:21:53Z barras $ *)
 
 open Pp
 open Util
@@ -34,7 +34,7 @@ let rec expand_atom s i =
   then expand_atom s (i+1)
   else i
 
-let rec expand_macros b s i =
+let rec expand_macros s i =
   let l = String.length s in
   if i=l then s else
     match s.[i] with
@@ -42,9 +42,7 @@ let rec expand_macros b s i =
 	  let n = expand_atom s (i+1) in
 	  let v = safe_getenv (String.sub s (i+1) (n-i-1)) in
 	  let s = (String.sub s 0 i)^v^(String.sub s n (l-n)) in
-	  expand_macros false s (i + String.length v)
-      | '/' ->
-	  expand_macros true s (i+1)
+	  expand_macros s (i + String.length v)
       | '~' ->
 	  let n = expand_atom s (i+1) in
 	  let v =
@@ -52,44 +50,16 @@ let rec expand_macros b s i =
 	    else (getpwnam (String.sub s (i+1) (n-i-1))).pw_dir
 	  in
 	  let s = v^(String.sub s n (l-n)) in
-	  expand_macros false s (String.length v)
-      | c -> expand_macros false s (i+1)
+	  expand_macros s (String.length v)
+      | c -> expand_macros s (i+1)
 
-let glob s = expand_macros true s 0
+let glob s = expand_macros s 0
 
 (* Files and load path. *)
 
 type physical_path = string
 type load_path = physical_path list
 
-(* Hints to partially detects if two paths refer to the same repertory *)
-let rec remove_path_dot p = 
-  let curdir = Filename.concat Filename.current_dir_name "" in (* Unix: "./" *)
-  let n = String.length curdir in
-  if String.length p > n && String.sub p 0 n = curdir then
-    remove_path_dot (String.sub p n (String.length p - n))
-  else
-    p
-
-let strip_path p =
-  let cwd = Filename.concat (Sys.getcwd ()) "" in (* Unix: "`pwd`/" *)
-  let n = String.length cwd in
-  if String.length p > n && String.sub p 0 n = cwd then
-    remove_path_dot (String.sub p n (String.length p - n))
-  else
-    remove_path_dot p
-
-let canonical_path_name p =
-  let current = Sys.getcwd () in
-  try 
-    Sys.chdir p;
-    let p' = Sys.getcwd () in
-    Sys.chdir current;
-    p'
-  with Sys_error _ ->
-    (* We give up to find a canonical name and just simplify it... *)
-    strip_path p
-
 (* All subdirectories, recursively *)
 
 let exists_dir dir =
@@ -214,6 +184,61 @@ let extern_intern magic suffix =
   in 
   (extern_state,intern_state)
 
+(* Communication through files with another executable *)
+
+let connect writefun readfun com =
+  let name = Filename.basename com in
+  let tmp_to = Filename.temp_file ("coq-"^name^"-in") ".xml" in
+  let tmp_from = Filename.temp_file ("coq-"^name^"-out") ".xml" in
+  let ch_to_in,ch_to_out =
+    try open_in tmp_to, open_out tmp_to
+    with Sys_error s -> error ("Cannot set connection to "^com^"("^s^")") in
+  let ch_from_in,ch_from_out = 
+    try open_in tmp_from, open_out tmp_from
+    with Sys_error s ->
+      close_out ch_to_out; close_in ch_to_in; 
+      error ("Cannot set connection from "^com^"("^s^")") in
+  writefun ch_to_out;
+  close_out ch_to_out;
+  let pid = 
+    let ch_to' = Unix.descr_of_in_channel ch_to_in in
+    let ch_from' = Unix.descr_of_out_channel ch_from_out in
+    try Unix.create_process com [||] ch_to' ch_from' Unix.stdout
+    with Unix.Unix_error (err,_,_) ->
+      close_in ch_to_in; close_in ch_from_in; close_out ch_from_out;
+      unlink tmp_from; unlink tmp_to;
+      error ("Cannot execute "^com^"("^(Unix.error_message err)^")") in
+  close_in ch_to_in;
+  close_out ch_from_out;
+  (match snd (Unix.waitpid [] pid) with
+    | Unix.WEXITED 127 -> error (com^": cannot execute")
+    | Unix.WEXITED 0 -> ()
+    | _ -> error (com^" exited abnormally"));
+  let a = readfun ch_from_in in
+  close_in ch_from_in;
+  unlink tmp_from;
+  unlink tmp_to;
+  a
+
+let run_command converter f c =
+  let result = Buffer.create 127 in
+  let cin,cout,cerr = Unix.open_process_full c (Unix.environment ()) in
+  let buff = String.make 127 ' ' in
+  let buffe = String.make 127 ' ' in
+  let n = ref 0 in
+  let ne = ref 0 in
+
+  while n:= input cin buff 0 127 ; ne := input cerr buffe 0 127 ; 
+    !n+ !ne <> 0
+  do 
+    let r = converter (String.sub buff 0 !n) in 
+    f r;
+    Buffer.add_string result r;
+    let r = converter (String.sub buffe 0 !ne) in 
+    f r;
+    Buffer.add_string result r 
+  done;
+  (Unix.close_process_full (cin,cout,cerr),  Buffer.contents result)
 
 (* Time stamps. *)
 
diff --git a/lib/system.mli b/lib/system.mli
index dc172b70..ea463732 100644
--- a/lib/system.mli
+++ b/lib/system.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: system.mli,v 1.17.16.3 2006/01/10 17:06:23 barras Exp $ i*)
+(*i $Id: system.mli 7603 2005-11-23 17:21:53Z barras $ i*)
 
 (*s Files and load paths. Load path entries remember the original root
     given by the user. For efficiency, we keep the full path (field
@@ -16,8 +16,6 @@
 type physical_path = string
 type load_path = physical_path list
 
-val canonical_path_name : string -> physical_path
-
 val all_subdirs : unix_path:string -> (physical_path * string list) list
 val is_in_path : load_path -> string -> bool
 val where_in_path : load_path -> string -> physical_path * string
@@ -48,6 +46,18 @@ val raw_extern_intern : int -> string ->
 val extern_intern : 
   int -> string -> (string -> 'a -> unit) * (load_path -> string -> 'a)
 
+(*s Sending/receiving once with external executable *)
+
+val connect : (out_channel -> unit) -> (in_channel -> 'a) -> string -> 'a 
+
+(*s [run_command converter f com] launches command [com], and returns
+    the contents of stdout and stderr that have been processed with
+    [converter]; the processed contents of stdout and stderr is also
+    passed to [f] *)
+
+val run_command : (string -> string) -> (string -> unit) -> string -> 
+  Unix.process_status * string
+
 (*s Time stamps. *)
 
 type time
@@ -56,5 +66,3 @@ val process_time : unit -> float * float
 val get_time : unit -> time
 val time_difference : time -> time -> float (* in seconds *)
 val fmt_time_difference : time -> time -> Pp.std_ppcmds
-
-
diff --git a/lib/tlm.ml b/lib/tlm.ml
index 23021be4..2939e91a 100644
--- a/lib/tlm.ml
+++ b/lib/tlm.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tlm.ml,v 1.3.16.1 2004/07/16 19:30:31 herbelin Exp $ *)
+(* $Id: tlm.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 type ('a,'b) t = Node of 'b Gset.t * ('a, ('a,'b) t) Gmap.t
 
diff --git a/lib/tlm.mli b/lib/tlm.mli
index a3011932..982bb5ed 100644
--- a/lib/tlm.mli
+++ b/lib/tlm.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tlm.mli,v 1.5.16.1 2004/07/16 19:30:31 herbelin Exp $ i*)
+(*i $Id: tlm.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Tries. This module implements a data structure [('a,'b) t] mapping lists
    of values of type ['a] to sets (as lists) of values of type ['b]. *)
diff --git a/lib/util.ml b/lib/util.ml
index b5470e58..2e6e1279 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -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        *)
-(************************************************************************)
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
 
-(* $Id: util.ml,v 1.84.2.3 2004/07/29 15:00:04 herbelin Exp $ *)
+(* $Id: util.ml 8672 2006-03-29 21:06:33Z herbelin $ *)
 
 open Pp
 
@@ -32,8 +32,9 @@ type 'a located = loc * 'a
 let anomaly_loc (loc,s,strm) = Stdpp.raise_with_loc loc (Anomaly (s,strm))
 let user_err_loc (loc,s,strm) = Stdpp.raise_with_loc loc (UserError (s,strm))
 let invalid_arg_loc (loc,s) = Stdpp.raise_with_loc loc (Invalid_argument s)
-let join_loc (deb1,_ as loc1) (_,fin2 as loc2) = 
-  if loc1 = dummy_loc or loc2 = dummy_loc then dummy_loc else (deb1,fin2)
+let join_loc loc1 loc2 =
+  if loc1 = dummy_loc or loc2 = dummy_loc then dummy_loc
+  else (fst loc1, snd loc2)
 
 (* Like Exc_located, but specifies the outermost file read, the filename
    associated to the location of the error, and the error itself. *)
@@ -98,6 +99,8 @@ let string_string_contains ~where ~what =
   with
       Not_found -> false
 
+let plural n s = if n>1 then s^"s" else s
+
 (* string parsing *)
 
 let parse_loadpath s =
@@ -118,10 +121,6 @@ module Stringset = Set.Make(struct type t = string let compare = compare end)
 
 module Stringmap = Map.Make(struct type t = string let compare = compare end)
 
-let stringmap_to_list m = Stringmap.fold (fun s y l -> (s,y)::l) m []
-
-let stringmap_dom m = Stringmap.fold (fun s _ l -> s::l) m []
-
 (* Lists *)
 
 let list_add_set x l = if List.mem x l then l else x::l
@@ -251,6 +250,13 @@ let list_for_all_i p =
 
 let list_except x l = List.filter (fun y -> not (x = y)) l
 
+let list_remove = list_except (* Alias *)
+
+let rec list_remove_first a = function
+  | b::l when a = b -> l
+  | b::l -> b::list_remove_first a l
+  | [] -> raise Not_found
+
 let list_for_all2eq f l1 l2 = try List.for_all2 f l1 l2 with Failure _ -> false
 
 let list_map_i f = 
@@ -362,12 +368,12 @@ let list_share_tails l1 l2 =
 
 let list_join_map f l = List.flatten (List.map f l)
 
-let rec list_fold_map f e = function 
+let rec list_fold_map f e = function
   |  []  -> (e,[])
-  |  h::t -> 
+  |  h::t ->
        let e',h' = f e h in
        let e'',t' = list_fold_map f e' t in
-	 e'',h'::t'
+         e'',h'::t'
 
 (* (* tail-recursive version of the above function *)
 let list_fold_map f e l = 
@@ -379,6 +385,10 @@ let list_fold_map f e l =
     (e',List.rev lrev)
 *)
 
+(* The same, based on fold_right, with the effect accumulated on the right *)
+let list_fold_map' f l e =
+  List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e)
+
 let list_map_assoc f = List.map (fun (x,a) -> (x,f a))
 
 (* Arrays *)
@@ -596,6 +606,20 @@ let array_map_left_pair f a g b =
     r, s
   end
 
+let pure_functional = false
+
+let array_fold_map' f v e =
+if pure_functional then
+  let (l,e) =
+    Array.fold_right 
+      (fun x (l,e) -> let (y,e) = f x e in (y::l,e))
+      v ([],e) in
+  (Array.of_list l,e)
+else
+  let e' = ref e in
+  let v' = Array.map (fun x -> let (y,e) = f x !e' in e' := e; y) v in
+  (v',!e')
+
 (* Matrices *)
 
 let matrix_transpose mat =
@@ -693,6 +717,8 @@ let pr_str = str
 let pr_coma () = str "," ++ spc ()
 let pr_semicolon () = str ";" ++ spc ()
 let pr_bar () = str "|" ++ spc ()
+let pr_arg pr x = spc () ++ pr x
+let pr_opt pr = function None -> mt () | Some x -> pr_arg pr x
 
 let pr_ord n =
   let suff = match n mod 10 with 1 -> "st" | 2 -> "nd" | _ -> "th" in
diff --git a/lib/util.mli b/lib/util.mli
index 19f05ea4..f77aa6b4 100644
--- a/lib/util.mli
+++ b/lib/util.mli
@@ -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        *)
-(************************************************************************)
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
 
-(*i $Id: util.mli,v 1.84.2.2 2004/07/16 20:43:46 herbelin Exp $ i*)
+(*i $Id: util.mli 8672 2006-03-29 21:06:33Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -68,16 +68,13 @@ val explode : string -> string list
 val implode : string list -> string
 val string_index_from : string -> int -> string -> int
 val string_string_contains : where:string -> what:string -> bool
+val plural : int -> string -> string
 
 val parse_loadpath : string -> string list
 
 module Stringset : Set.S with type elt = string
-
 module Stringmap : Map.S with type key = string
 
-val stringmap_to_list : 'a Stringmap.t -> (string * 'a) list 
-val stringmap_dom : 'a Stringmap.t -> string list
-
 (*s Lists. *)
 
 val list_add_set : 'a -> 'a list -> 'a list
@@ -109,6 +106,8 @@ val list_fold_right_and_left :
     ('a -> 'b -> 'b list -> 'a) -> 'b list -> 'a -> 'a
 val list_for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
 val list_except : 'a -> 'a list -> 'a list
+val list_remove : 'a -> 'a list -> 'a list
+val list_remove_first : 'a -> 'a list -> 'a list
 val list_for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
 val list_sep_last : 'a list -> 'a * 'a list
 val list_try_find_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b
@@ -130,8 +129,8 @@ val list_share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
 val list_join_map : ('a -> 'b list) -> 'a list -> 'b list
 (* [list_fold_map f e_0 [l_1...l_n] = e_n,[k_1...k_n]]
    where [(e_i,k_i)=f e_{i-1} l_i] *)
-val list_fold_map : 
-  ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list 
+val list_fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+val list_fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
 val list_map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
 
 (*s Arrays. *)
@@ -170,6 +169,7 @@ val array_map3 :
 val array_map_left : ('a -> 'b) -> 'a array -> 'b array
 val array_map_left_pair : ('a -> 'b) -> 'a array -> ('c -> 'd) -> 'c array ->
   'b array * 'd array
+val array_fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
 
 (*s Matrices *)
 
@@ -223,6 +223,8 @@ val pr_coma : unit -> std_ppcmds
 val pr_semicolon : unit -> std_ppcmds
 val pr_bar : unit -> std_ppcmds
 val pr_ord : int -> std_ppcmds
+val pr_arg : ('a -> std_ppcmds) -> 'a -> std_ppcmds
+val pr_opt : ('a -> std_ppcmds) -> 'a option -> std_ppcmds
 
 val prlist : ('a -> std_ppcmds) -> 'a list -> std_ppcmds
 val prvecti : (int -> 'a -> std_ppcmds) -> 'a array -> std_ppcmds
diff --git a/library/decl_kinds.ml b/library/decl_kinds.ml
index a030284c..af54df2f 100644
--- a/library/decl_kinds.ml
+++ b/library/decl_kinds.ml
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: decl_kinds.ml,v 1.6.2.1 2004/07/16 19:30:33 herbelin Exp $ *)
+(* $Id: decl_kinds.ml 7944 2006-01-29 16:01:32Z herbelin $ *)
+
+open Util
 
 (* Informal mathematical status of declarations *)
 
@@ -14,23 +16,32 @@ type locality_flag = (*bool (* local = true; global = false *)*)
   | Local
   | Global
 
-(* Kinds used at parsing time *)
+type boxed_flag = bool
 
 type theorem_kind =
   | Theorem
   | Lemma
   | Fact
   | Remark
+  | Property
+  | Proposition
+  | Corollary
 
 type definition_object_kind =
   | Definition
   | Coercion
   | SubClass
   | CanonicalStructure
+  | Example
+  | Fixpoint
+  | CoFixpoint
+  | Scheme
+  | StructureComponent
+  | IdentityCoercion
 
 type strength = locality_flag (* For compatibility *)
 
-type type_as_formula_kind = Definitional | Logical | Conjectural
+type assumption_object_kind = Definitional | Logical | Conjectural
 
 (* [assumption_kind] 
 
@@ -40,36 +51,51 @@ type type_as_formula_kind = Definitional | Logical | Conjectural
    Logical      |  Hypothesis | Axiom
 
 *)
-type assumption_kind = locality_flag * type_as_formula_kind
+type assumption_kind = locality_flag * assumption_object_kind
 
-type definition_kind = locality_flag * definition_object_kind
+type definition_kind = locality_flag * boxed_flag * definition_object_kind
 
 (* Kinds used in proofs *)
 
-type global_goal_kind =
-  | DefinitionBody
+type goal_object_kind =
+  | DefinitionBody of definition_object_kind
   | Proof of theorem_kind
 
-type goal_kind =
-  | IsGlobal of global_goal_kind
-  | IsLocal
+type goal_kind = locality_flag * goal_object_kind
 
 (* Kinds used in library *)
 
-type local_theorem_kind = LocalStatement
-
-type 'a mathematical_kind =
-  | IsAssumption of type_as_formula_kind
-  | IsDefinition
-  | IsConjecture
-  | IsProof of 'a
-
-type global_kind = theorem_kind mathematical_kind
-type local_kind = local_theorem_kind mathematical_kind
+type logical_kind =
+  | IsAssumption of assumption_object_kind
+  | IsDefinition of definition_object_kind
+  | IsProof of theorem_kind
 
 (* Utils *)
 
-let theorem_kind_of_goal_kind = function
-  | DefinitionBody -> IsDefinition
+let logical_kind_of_goal_kind = function
+  | DefinitionBody d -> IsDefinition d
   | Proof s -> IsProof s
 
+let string_of_theorem_kind = function
+  | Theorem -> "Theorem"
+  | Lemma -> "Lemma"
+  | Fact -> "Fact"
+  | Remark -> "Remark"
+  | Property -> "Property"
+  | Proposition -> "Proposition"
+  | Corollary -> "Corollary"
+
+let string_of_definition_kind (l,boxed,d) =
+  match (l,d) with
+  | Local, Coercion -> "Coercion Local"
+  | Global, Coercion -> "Coercion"
+  | Local, Definition -> "Let"
+  | Global, Definition -> if boxed then "Boxed Definition" else "Definition"
+  | Local, SubClass -> "Local SubClass"
+  | Global, SubClass -> "SubClass"
+  | Global, CanonicalStructure -> "Canonical Structure"
+  | Global, Example -> "Example"
+  | Local, (CanonicalStructure|Example) ->
+      anomaly "Unsupported local definition kind"
+  | _, (StructureComponent|Scheme|CoFixpoint|Fixpoint|IdentityCoercion)
+      -> anomaly "Internal definition kind"
diff --git a/library/declare.ml b/library/declare.ml
index cfa8890a..b1e55c20 100644
--- a/library/declare.ml
+++ b/library/declare.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: declare.ml,v 1.128.2.2 2005/11/29 21:40:52 letouzey Exp $ *)
+(* $Id: declare.ml 7941 2006-01-28 23:07:59Z herbelin $ *)
 
 open Pp
 open Util
@@ -31,11 +31,7 @@ open Decl_kinds
 
 (**********************************************)
 
-(* For [DischargeAt (dir,n)], [dir] is the minimum prefix that a
-   construction keeps in its name (if persistent), or the section name
-   beyond which it is discharged (if volatile); the integer [n]
-   (useful only for persistent constructions), is the length of the section
-   part in [dir] *)
+(* Strength *)
 
 open Nametab
 
@@ -47,9 +43,9 @@ let string_of_strength = function
   | Global -> "(global)"
 
 (* XML output hooks *)
-let xml_declare_variable = ref (fun sp -> ())
-let xml_declare_constant = ref (fun sp -> ())
-let xml_declare_inductive = ref (fun sp -> ())
+let xml_declare_variable = ref (fun (sp:object_name) -> ())
+let xml_declare_constant = ref (fun (sp:bool * constant)-> ())
+let xml_declare_inductive = ref (fun (sp:bool * object_name) -> ())
 
 let if_xml f x = if !Options.xml_export then f x else ()
 
@@ -63,25 +59,28 @@ type section_variable_entry =
   | SectionLocalDef of constr * types option * bool (* opacity *)
   | SectionLocalAssum of types
 
-type variable_declaration = dir_path * section_variable_entry * local_kind
+type variable_declaration = dir_path * section_variable_entry * logical_kind
 
 type checked_section_variable =
   | CheckedSectionLocalDef of constr * types * Univ.constraints * bool
   | CheckedSectionLocalAssum of types * Univ.constraints
 
 type checked_variable_declaration = 
-    dir_path * checked_section_variable * local_kind
+    dir_path * checked_section_variable * logical_kind
 
 let vartab = ref (Idmap.empty : checked_variable_declaration Idmap.t)
 
 let _ = Summary.declare_summary "VARIABLE"
-	  { Summary.freeze_function = (fun () -> !vartab);
-	    Summary.unfreeze_function = (fun ft -> vartab := ft);
-	    Summary.init_function = (fun () -> vartab := Idmap.empty);
-	    Summary.survive_module = false;
-	    Summary.survive_section = false }
-
-let cache_variable ((sp,_),(id,(p,d,mk))) =
+  { Summary.freeze_function = (fun () -> !vartab);
+    Summary.unfreeze_function = (fun ft -> vartab := ft);
+    Summary.init_function = (fun () -> vartab := Idmap.empty);
+    Summary.survive_module = false;
+    Summary.survive_section = false }
+
+let cache_variable ((sp,_),o) =
+  match o with
+  | Inl cst -> Global.add_constraints cst
+  | Inr (id,(p,d,mk)) ->
   (* Constr raisonne sur les noms courts *)
   if Idmap.mem id !vartab then
     errorlabstrm "cache_variable" (pr_id id ++ str " already exists");
@@ -95,36 +94,38 @@ let cache_variable ((sp,_),(id,(p,d,mk))) =
         let (_,bd,ty) = Global.lookup_named id in
         CheckedSectionLocalDef (out_some bd,ty,cst,opaq) in
   Nametab.push (Nametab.Until 1) (restrict_path 0 sp) (VarRef id);
+  add_section_variable id;
+  Dischargedhypsmap.set_discharged_hyps sp [];
   vartab := Idmap.add id (p,vd,mk) !vartab
 
+let get_variable_constraints id = 
+  match pi2 (Idmap.find id !vartab) with
+  | CheckedSectionLocalDef (c,ty,cst,opaq) -> cst
+  | CheckedSectionLocalAssum (ty,cst) -> cst
+
+let discharge_variable (_,o) = match o with
+  | Inr (id,_) -> Some (Inl (get_variable_constraints id))
+  | Inl _ -> Some o
+
 let (in_variable, out_variable) =
   declare_object { (default_object "VARIABLE") with
     cache_function = cache_variable;
+    discharge_function = discharge_variable;
     classify_function = (fun _ -> Dispose) }
 
-let declare_variable_common id obj =
-  let oname = add_leaf id (in_variable (id,obj)) in
-  declare_var_implicits id;
-  Symbols.declare_ref_arguments_scope (VarRef id);
-  oname
-
 (* for initial declaration *)
 let declare_variable id obj =
-  let (sp,kn as oname) = declare_variable_common id obj in
+  let oname = add_leaf id (in_variable (Inr (id,obj))) in
+  declare_var_implicits id;
+  Notation.declare_ref_arguments_scope (VarRef id);
   !xml_declare_variable oname;
-  Dischargedhypsmap.set_discharged_hyps sp [];
   oname
 
-(* when coming from discharge: no xml output *)
-let redeclare_variable id discharged_hyps obj =
-  let oname = declare_variable_common id obj in
-  Dischargedhypsmap.set_discharged_hyps (fst oname) discharged_hyps
-
 (* Globals: constants and parameters *)
 
-type constant_declaration = constant_entry * global_kind
+type constant_declaration = constant_entry * logical_kind
 
-let csttab = ref (Spmap.empty : global_kind Spmap.t)
+let csttab = ref (Spmap.empty : logical_kind Spmap.t)
 
 let _ = Summary.declare_summary "CONSTANT"
 	  { Summary.freeze_function = (fun () -> !csttab);
@@ -133,37 +134,56 @@ let _ = Summary.declare_summary "CONSTANT"
 	    Summary.survive_module = false;
 	    Summary.survive_section = false }
 
-let cache_constant ((sp,kn),(cdt,kind)) =
-  (if Idmap.mem (basename sp) !vartab then
-    errorlabstrm "cache_constant" 
-      (pr_id (basename sp) ++ str " already exists"));
-  (if Nametab.exists_cci sp then
-    let (_,id) = repr_path sp in
-    errorlabstrm "cache_constant" (pr_id id ++ str " already exists"));
-  let _,dir,_ = repr_kn kn in
-  let kn' = Global.add_constant dir (basename sp) cdt in
-    if kn' <> kn then
-      anomaly "Kernel and Library names do not match";
-  Nametab.push (Nametab.Until 1) sp (ConstRef kn);
-  csttab := Spmap.add sp kind !csttab
-
 (* At load-time, the segment starting from the module name to the discharge *)
 (* section (if Remark or Fact) is needed to access a construction *)
-let load_constant i ((sp,kn),(_,kind)) =
-  (if Nametab.exists_cci sp then
-    let (_,id) = repr_path sp in
-    errorlabstrm "cache_constant" (pr_id id ++ str " already exists"));
-  csttab := Spmap.add sp kind !csttab;
-  Nametab.push (Nametab.Until i) sp (ConstRef kn)
+let load_constant i ((sp,kn),(_,_,_,kind)) =
+  if Nametab.exists_cci sp then
+    errorlabstrm "cache_constant" 
+      (pr_id (basename sp) ++ str " already exists");
+  Nametab.push (Nametab.Until i) sp (ConstRef (constant_of_kn kn));
+  csttab := Spmap.add sp kind !csttab
 
 (* Opening means making the name without its module qualification available *)
 let open_constant i ((sp,kn),_) =
-  Nametab.push (Nametab.Exactly i) sp (ConstRef kn)
+  Nametab.push (Nametab.Exactly i) sp (ConstRef (constant_of_kn 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
+
+(*s Registration as global tables and rollback. *)
+
+open Cooking
+
+let discharged_hyps kn sechyps =
+  let (_,dir,_) = repr_kn kn in
+  let args = array_map_to_list destVar (instance_from_named_context sechyps) in
+  List.rev (List.map (Libnames.make_path dir) args)
+
+let discharge_constant ((sp,kn),(cdt,dhyps,imps,kind)) =
+  let con = constant_of_kn kn in
+  let cb = Global.lookup_constant con in
+  let (repl1,_ as repl) = replacement_context () in
+  let sechyps = section_segment (ConstRef con) in
+  let recipe = { d_from=cb; d_modlist=repl; d_abstract=sechyps } in
+  Some (GlobalRecipe recipe,(discharged_hyps kn sechyps)@dhyps,imps,kind)
 
 (* Hack to reduce the size of .vo: we keep only what load/open needs *)
 let dummy_constant_entry = ConstantEntry (ParameterEntry mkProp)
 
-let dummy_constant (ce,mk) = dummy_constant_entry,mk
+let dummy_constant (ce,_,imps,mk) = dummy_constant_entry,[],imps,mk
 
 let export_constant cst = Some (dummy_constant cst)
 
@@ -176,40 +196,43 @@ let (in_constant, out_constant) =
     open_function = open_constant;
     classify_function = classify_constant;
     subst_function = ident_subst_function;
+    discharge_function = discharge_constant;
     export_function = export_constant } 
 
 let hcons_constant_declaration = function
-  | DefinitionEntry ce ->
+  | DefinitionEntry ce when !Options.hash_cons_proofs ->
       let (hcons1_constr,_) = hcons_constr (hcons_names()) in
       DefinitionEntry
        { const_entry_body = hcons1_constr ce.const_entry_body;
 	 const_entry_type = option_app hcons1_constr ce.const_entry_type;
-         const_entry_opaque = ce.const_entry_opaque }
+         const_entry_opaque = ce.const_entry_opaque; 
+         const_entry_boxed = ce.const_entry_boxed }
   | cd -> cd
 
-let declare_constant_common id discharged_hyps (cd,kind) =
-  let (sp,kn as oname) = add_leaf id (in_constant (cd,kind)) in
-  declare_constant_implicits kn;
-  Symbols.declare_ref_arguments_scope (ConstRef kn);
-  Dischargedhypsmap.set_discharged_hyps sp discharged_hyps;
-  oname
+let declare_constant_common id dhyps (cd,kind) =
+  let imps = implicits_flags () in
+  let (sp,kn) = add_leaf id (in_constant (cd,dhyps,imps,kind)) in
+  let kn = constant_of_kn kn in
+  kn
 
 let declare_constant_gen internal id (cd,kind) =
   let cd = hcons_constant_declaration cd in
-  let oname = declare_constant_common id [] (ConstantEntry cd,kind) in
-  !xml_declare_constant (internal,oname);
-  oname
+  let kn = declare_constant_common id [] (ConstantEntry cd,kind) in
+  !xml_declare_constant (internal,kn);
+  kn
 
 let declare_internal_constant = declare_constant_gen true
 let declare_constant = declare_constant_gen false
 
-(* when coming from discharge *)
-let redeclare_constant id discharged_hyps (cd,kind) =
-  let _ = declare_constant_common id discharged_hyps (GlobalRecipe cd,kind) in
-  ()
-
 (* Inductives. *)
 
+let declare_inductive_argument_scopes kn mie =
+  list_iter_i (fun i {mind_entry_consnames=lc} ->
+    Notation.declare_ref_arguments_scope (IndRef (kn,i));
+    for j=1 to List.length lc do
+      Notation.declare_ref_arguments_scope (ConstructRef ((kn,i),j));
+    done) mie.mind_entry_inds
+
 let inductive_names sp kn mie =
   let (dp,_) = repr_path sp in
   let names, _ = 
@@ -230,39 +253,44 @@ let inductive_names sp kn mie =
       ([], 0) mie.mind_entry_inds
   in names
 
-
 let check_exists_inductive (sp,_) =
   (if Idmap.mem (basename sp) !vartab then
-    errorlabstrm "cache_inductive" 
+    errorlabstrm ""
       (pr_id (basename sp) ++ str " already exists"));
   if Nametab.exists_cci sp then
     let (_,id) = repr_path sp in
-    errorlabstrm "cache_inductive" (pr_id id ++ str " already exists")
+    errorlabstrm "" (pr_id id ++ str " already exists")
 
-let cache_inductive ((sp,kn),mie) =
-  let names = inductive_names sp kn mie in
-  List.iter check_exists_inductive names;
-  let _,dir,_ = repr_kn kn in
-  let kn' = Global.add_mind dir (basename sp) mie in
-    if kn' <> kn then
-      anomaly "Kernel and Library names do not match";
-
-  List.iter 
-    (fun (sp, ref) -> Nametab.push (Nametab.Until 1) sp ref)
-    names
-
-let load_inductive i ((sp,kn),mie) =
+let load_inductive i ((sp,kn),(_,_,mie)) =
   let names = inductive_names sp kn mie in
   List.iter check_exists_inductive names;
   List.iter (fun (sp, ref) -> Nametab.push (Nametab.Until i) sp ref) names
 
-let open_inductive i ((sp,kn),mie) =
+let open_inductive i ((sp,kn),(_,_,mie)) =
   let names = inductive_names sp kn mie in
-(*  List.iter (fun (sp, ref) -> Nametab.push 0 (restrict_path 0 sp) ref) names*)
   List.iter (fun (sp, ref) -> Nametab.push (Nametab.Exactly i) sp ref) names
 
+let cache_inductive ((sp,kn),(dhyps,imps,mie)) =
+  let names = inductive_names sp kn mie in
+  List.iter check_exists_inductive names;
+  let id = basename sp in
+  let _,dir,_ = repr_kn kn in
+  let kn' = Global.add_mind dir id mie in
+  assert (kn'=kn);
+  add_section_kn kn (Global.lookup_mind kn').mind_hyps;
+  Dischargedhypsmap.set_discharged_hyps sp dhyps;
+  with_implicits imps declare_mib_implicits kn;
+  declare_inductive_argument_scopes kn mie;
+  List.iter (fun (sp, ref) -> Nametab.push (Nametab.Until 1) sp ref) names
+
+let discharge_inductive ((sp,kn),(dhyps,imps,mie)) =
+  let mie = Global.lookup_mind kn in
+  let repl = replacement_context () in
+  let sechyps = section_segment (IndRef (kn,0)) in
+  Some (discharged_hyps kn sechyps,imps,
+        Discharge.process_inductive sechyps repl mie)
+
 let dummy_one_inductive_entry mie = {
-  mind_entry_params = [];
   mind_entry_typename = mie.mind_entry_typename;
   mind_entry_arity = mkProp;
   mind_entry_consnames = mie.mind_entry_consnames;
@@ -270,10 +298,11 @@ let dummy_one_inductive_entry mie = {
 }
 
 (* Hack to reduce the size of .vo: we keep only what load/open needs *)
-let dummy_inductive_entry m = {
+let dummy_inductive_entry (_,imps,m) = ([],imps,{
+  mind_entry_params = [];
   mind_entry_record = false;
   mind_entry_finite = true;
-  mind_entry_inds = List.map dummy_one_inductive_entry m.mind_entry_inds }
+  mind_entry_inds = List.map dummy_one_inductive_entry m.mind_entry_inds })
 
 let export_inductive x = Some (dummy_inductive_entry x)
 
@@ -284,38 +313,19 @@ let (in_inductive, out_inductive) =
     open_function = open_inductive;
     classify_function = (fun (_,a) -> Substitute (dummy_inductive_entry a));
     subst_function = ident_subst_function;
+    discharge_function = discharge_inductive;
     export_function = export_inductive } 
 
-let declare_inductive_argument_scopes kn mie =
-  list_iter_i (fun i {mind_entry_consnames=lc} ->
-    Symbols.declare_ref_arguments_scope (IndRef (kn,i));
-    for j=1 to List.length lc do
-      Symbols.declare_ref_arguments_scope (ConstructRef ((kn,i),j));
-    done) mie.mind_entry_inds
-
-let declare_inductive_common mie =
-  let id = match mie.mind_entry_inds with
-    | ind::_ -> ind.mind_entry_typename
-    | [] -> anomaly "cannot declare an empty list of inductives"
-  in
-  let oname = add_leaf id (in_inductive mie) in
-  declare_mib_implicits (snd oname);
-  declare_inductive_argument_scopes (snd oname) mie;
-  oname
-
 (* for initial declaration *)
 let declare_mind isrecord mie =
-  let (sp,kn as oname) = declare_inductive_common mie in
-  Dischargedhypsmap.set_discharged_hyps sp [] ;
+  let imps = implicits_flags () in
+  let id = match mie.mind_entry_inds with
+    | ind::_ -> ind.mind_entry_typename
+    | [] -> anomaly "cannot declare an empty list of inductives" in
+  let oname = add_leaf id (in_inductive ([],imps,mie)) in
   !xml_declare_inductive (isrecord,oname);
   oname
 
-(* when coming from discharge: no xml output *)
-let redeclare_inductive discharged_hyps mie =
- let oname = declare_inductive_common mie in
- Dischargedhypsmap.set_discharged_hyps (fst oname) discharged_hyps ;
- oname
-
 (*s Test and access functions. *)
 
 let is_constant sp = 
@@ -330,12 +340,6 @@ let get_variable id =
     | CheckedSectionLocalDef (c,ty,cst,opaq) -> (id,Some c,ty)
     | CheckedSectionLocalAssum (ty,cst) -> (id,None,ty)
 
-let get_variable_with_constraints id = 
-  let (p,x,_) = Idmap.find id !vartab in
-  match x with
-    | CheckedSectionLocalDef (c,ty,cst,opaq) -> ((id,Some c,ty),cst)
-    | CheckedSectionLocalAssum (ty,cst) -> ((id,None,ty),cst)
-
 let variable_strength _ = Local
 
 let find_section_variable id =
@@ -351,8 +355,10 @@ let variable_kind id =
   pi3 (Idmap.find id !vartab)
 
 let clear_proofs sign =
-  List.map
-    (fun (id,c,t as d) -> if variable_opacity id then (id,None,t) else d) sign
+  List.fold_right
+    (fun (id,c,t as d) signv -> 
+      let d = if variable_opacity id then (id,None,t) else d in
+      Environ.push_named_context_val d signv) sign Environ.empty_named_context_val
 
 (* Global references. *)
 
@@ -378,12 +384,6 @@ let mind_oper_of_id sp id mib =
 	   mip.mind_consnames)
     mib.mind_packets
 
-let context_of_global_reference = function
-  | VarRef id -> []
-  | ConstRef sp -> (Global.lookup_constant sp).const_hyps
-  | IndRef (sp,_) -> (Global.lookup_mind sp).mind_hyps
-  | ConstructRef ((sp,_),_) -> (Global.lookup_mind sp).mind_hyps
-
 let last_section_hyps dir =
   fold_named_context
     (fun (id,_,_) sec_ids ->
diff --git a/library/declare.mli b/library/declare.mli
index 968be059..938bfd06 100644
--- a/library/declare.mli
+++ b/library/declare.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: declare.mli,v 1.74.2.1 2004/07/16 19:30:35 herbelin Exp $ i*)
+(*i $Id: declare.mli 7941 2006-01-28 23:07:59Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -36,42 +36,29 @@ type section_variable_entry =
   | SectionLocalDef of constr * types option * bool (* opacity *)
   | SectionLocalAssum of types
 
-type variable_declaration = dir_path * section_variable_entry * local_kind
+type variable_declaration = dir_path * section_variable_entry * logical_kind
 
 val declare_variable : variable -> variable_declaration -> object_name
 
-(* Declaration from Discharge *)
-val redeclare_variable :
- variable -> Dischargedhypsmap.discharged_hyps -> variable_declaration -> unit
-
 (* Declaration of global constructions *)
 (* i.e. Definition/Theorem/Axiom/Parameter/... *)
 
-type constant_declaration = constant_entry * global_kind
+type constant_declaration = constant_entry * logical_kind
 
 (* [declare_constant id cd] declares a global declaration
    (constant/parameter) with name [id] in the current section; it returns
    the full path of the declaration *)
-val declare_constant : identifier -> constant_declaration -> object_name
+val declare_constant :
+ identifier -> constant_declaration -> constant
 
 val declare_internal_constant :
-  identifier -> constant_declaration -> object_name
-
-val redeclare_constant :
- identifier -> Dischargedhypsmap.discharged_hyps -> 
-      Cooking.recipe * global_kind -> unit
+  identifier -> constant_declaration -> constant
 
 (* [declare_mind me] declares a block of inductive types with
    their constructors in the current section; it returns the path of
    the whole block (boolean must be true iff it is a record) *)
 val declare_mind : bool -> mutual_inductive_entry -> object_name
 
-(* Declaration from Discharge *)
-val redeclare_inductive :
- Dischargedhypsmap.discharged_hyps -> mutual_inductive_entry -> object_name
-
-val out_inductive : Libobject.obj -> mutual_inductive_entry 
-
 val strength_min : strength * strength -> strength
 val string_of_strength : strength -> string
 
@@ -79,24 +66,20 @@ val string_of_strength : strength -> string
 
 val is_constant : section_path -> bool
 val constant_strength : section_path -> strength
-val constant_kind : section_path -> global_kind
+val constant_kind : section_path -> logical_kind
 
-val out_variable : Libobject.obj -> identifier * variable_declaration
 val get_variable : variable -> named_declaration
-val get_variable_with_constraints : 
-  variable -> named_declaration * Univ.constraints
 val variable_strength : variable -> strength 
-val variable_kind : variable -> local_kind
+val variable_kind : variable -> logical_kind
 val find_section_variable : variable -> section_path
 val last_section_hyps : dir_path -> identifier list
-val clear_proofs : named_context -> named_context
+val clear_proofs : named_context -> Environ.named_context_val
 
 (*s Global references *)
 
-val context_of_global_reference : global_reference -> section_context
 val strength_of_global : global_reference -> strength
 
 (* hooks for XML output *)
 val set_xml_declare_variable : (object_name -> unit) -> unit
-val set_xml_declare_constant : (bool * object_name -> unit) -> unit
+val set_xml_declare_constant : (bool * constant -> unit) -> unit
 val set_xml_declare_inductive : (bool * object_name -> unit) -> unit
diff --git a/library/declaremods.ml b/library/declaremods.ml
index 2e8fb0a7..3b2196a5 100644
--- a/library/declaremods.ml
+++ b/library/declaremods.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: declaremods.ml,v 1.18.2.2 2005/12/30 11:08:56 herbelin Exp $ i*)
+(*i $Id: declaremods.ml 7720 2005-12-24 00:25:55Z herbelin $ i*)
 
 open Pp
 open Util
@@ -17,6 +17,7 @@ open Libnames
 open Libobject
 open Lib
 open Nametab
+open Mod_subst
 
 (* modules and components *)
 
@@ -372,19 +373,25 @@ let (in_modtype,out_modtype) =
 
 
 
-let replace_module_object id (subst, mbids, msid, lib_stack) modobjs =
+let rec replace_module_object idl (subst, mbids, msid, lib_stack) modobjs =
   if mbids<>[] then 
     error "Unexpected functor objects"
   else
-    let rec replace_id = function 
-      | [] -> [] 
-      | (id',obj)::tail when id = id' ->
+    let rec replace_idl = function 
+      | _,[] -> [] 
+      | id::idl,(id',obj)::tail when id = id' ->
 	  if object_tag obj = "MODULE" then
-	    (id, in_module (None,modobjs,None))::tail
+           (match idl with
+               [] -> (id, in_module (None,modobjs,None))::tail
+             | _ ->
+               let (_,substobjs,_) = out_module obj in
+                let substobjs' = replace_module_object idl substobjs modobjs in
+                 (id, in_module (None,substobjs',None))::tail
+           )
 	  else error "MODULE expected!"
-      | lobj::tail -> lobj::replace_id tail
+      | idl,lobj::tail -> lobj::replace_idl (idl,tail)
     in
-      (subst, mbids, msid, replace_id lib_stack)
+      (subst, mbids, msid, replace_idl (idl,lib_stack))
 
 let abstract_substobjs mbids1 (subst, mbids2, msid, lib_stack) =
   (subst, mbids1@mbids2, msid, lib_stack)
@@ -396,10 +403,10 @@ let rec get_modtype_substobjs = function
       let (subst, mbids, msid, objs) = get_modtype_substobjs mte in
 	(subst, mbid::mbids, msid, objs)
   | MTEwith (mty, With_Definition _) -> get_modtype_substobjs mty
-  | MTEwith (mty, With_Module (id,mp)) -> 
+  | MTEwith (mty, With_Module (idl,mp)) -> 
       let substobjs = get_modtype_substobjs mty in
       let modobjs = MPmap.find mp !modtab_substobjs in
-	replace_module_object id substobjs modobjs
+	replace_module_object idl substobjs modobjs
   | MTEsig (msid,_) -> 
       todo "Anonymous module types"; (empty_subst, [], msid, [])
 
@@ -449,7 +456,7 @@ let intern_args interp_modtype (env,oldargs) (idl,arg) =
     in
     env, List.map (fun mbid -> mbid,mty) mbids :: oldargs
       
-let start_module interp_modtype id args res_o =
+let start_module interp_modtype export id args res_o =
   let fs = Summary.freeze_summaries () in
   let env = Global.env () in
   let env,arg_entries_revlist = 
@@ -481,7 +488,7 @@ let start_module interp_modtype id args res_o =
 
   let mbids = List.map fst arg_entries in
   openmod_info:=(mbids,res_entry_o,sub_body_o);
-  let prefix = Lib.start_module id mp fs in
+  let prefix = Lib.start_module export id mp fs in
   Nametab.push_dir (Nametab.Until 1) (fst prefix) (DirOpenModule prefix);
   Lib.add_frozen_state ()
 
@@ -565,7 +572,6 @@ let library_cache = Hashtbl.create 17
 
 let register_library dir cenv objs digest =
   let mp = MPfile dir in
-  let prefix = dir, (mp, empty_dirpath) in
   let substobjs, objects =
     try 
       ignore(Global.lookup_module mp);
@@ -697,21 +703,25 @@ let declare_modtype interp_modtype id args mty =
   ignore (add_leaf id (in_modtype (Some entry, substobjs)))
 			       
 
-
-let rec get_module_substobjs = function
+let rec get_module_substobjs env = function
   | MEident mp -> MPmap.find mp !modtab_substobjs 
   | MEfunctor (mbid,mty,mexpr) ->
-      let (subst, mbids, msid, objs) = 
-	get_module_substobjs mexpr 
-      in
+       let (subst, mbids, msid, objs) = get_module_substobjs env mexpr in
 	(subst, mbid::mbids, msid, objs)
   | MEstruct (msid,_) ->
       (empty_subst, [], msid, [])
   | MEapply (mexpr, MEident mp) ->
-      let (subst, mbids, msid, objs) = get_module_substobjs mexpr in
+      let feb,ftb = Mod_typing.translate_mexpr env mexpr in
+      let ftb = Modops.scrape_modtype env ftb in
+      let farg_id, farg_b, fbody_b = Modops.destr_functor ftb in
+      let (subst, mbids, msid, objs) = get_module_substobjs env mexpr in
 	(match mbids with
 	   | mbid::mbids ->
-	       (add_mbid mbid mp subst, mbids, msid, objs)
+              let resolve =
+               Modops.resolver_of_environment farg_id farg_b mp env in
+               (* application outside the kernel, only for substitutive
+                  objects (that are all non-logical objects) *)
+	       (add_mbid mbid mp (Some resolve) subst, mbids, msid, objs)
 	   | [] -> match mexpr with
 	       | MEident _ | MEstruct _ -> error "Application of a non-functor"
 	       | _ -> error "Application of a functor with too few arguments")
@@ -757,7 +767,7 @@ let declare_module interp_modtype interp_modexpr id args mty_o mexpr_o =
   let substobjs =
     match entry with
       | {mod_entry_type = Some mte} -> get_modtype_substobjs mte
-      | {mod_entry_expr = Some mexpr} -> get_module_substobjs mexpr
+      | {mod_entry_expr = Some mexpr} -> get_module_substobjs env mexpr
       | _ -> anomaly "declare_module: No type, no body ..."
   in
     Summary.unfreeze_summaries fs;
@@ -772,23 +782,7 @@ let declare_module interp_modtype interp_modexpr id args mty_o mexpr_o =
 
 (*s Iterators. *)
 
-let fold_all_segments insec f x =
-  let acc' = 
-    MPmap.fold 
-      (fun _ (prefix,objects) acc -> 
-	 let apply_obj acc (id,obj) = f acc (make_oname prefix id) obj in
-	   List.fold_left apply_obj acc objects)
-      !modtab_objects x
-  in
-  let rec apply_node acc = function
-    | sp, Leaf o -> f acc sp o
-    | _, ClosedSection (_,_,seg) -> 
-	if insec then List.fold_left apply_node acc seg else acc
-    | _ -> acc
-  in
-    List.fold_left apply_node acc' (Lib.contents_after None)
-
-let iter_all_segments insec f =
+let iter_all_segments f =
   let _ = 
     MPmap.iter 
       (fun _ (prefix,objects) -> 
@@ -798,13 +792,11 @@ let iter_all_segments insec f =
   in
   let rec apply_node = function
     | sp, Leaf o -> f sp o
-    | _, ClosedSection (_,_,seg) -> if insec then List.iter apply_node seg
     | _ -> ()
   in
     List.iter apply_node (Lib.contents_after None)
 
 
-
 let debug_print_modtab _ =
   let pr_seg = function
     | [] -> str "[]"
@@ -816,5 +808,3 @@ let debug_print_modtab _ =
   in
   let modules = MPmap.fold pr_modinfo !modtab_objects (mt ()) in
     hov 0 modules
-
-
diff --git a/library/declaremods.mli b/library/declaremods.mli
index f896310a..481809fc 100644
--- a/library/declaremods.mli
+++ b/library/declaremods.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: declaremods.mli,v 1.8.2.2 2005/01/21 16:41:50 herbelin Exp $ i*)
+(*i $Id: declaremods.mli 6758 2005-02-20 18:13:28Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -43,9 +43,8 @@ val declare_module :
   'modexpr option -> unit
  
 val start_module : (env -> 'modtype -> module_type_entry) -> 
-  identifier -> 
-  (identifier located list * 'modtype) list -> ('modtype * bool) option -> 
-  unit
+  bool option -> identifier -> (identifier located list * 'modtype) list ->
+   ('modtype * bool) option -> unit
 
 val end_module : identifier -> unit
 
@@ -97,14 +96,12 @@ val really_import_module : module_path -> unit
 val import_module : bool -> module_path -> unit
 
 
-(*s [fold_all_segments] and [iter_all_segments] iterate over all
-    segments, the modules' segments first and then the current
-    segment. Modules are presented in an arbitrary order. The given
-    function is applied to all leaves (together with their section
-    path). The boolean indicates if we must enter closed sections. *)
+(*s [iter_all_segments] iterate over all segments, the modules'
+    segments first and then the current segment. Modules are presented
+    in an arbitrary order. The given function is applied to all leaves
+    (together with their section path). *)
 
-val fold_all_segments : bool -> ('a -> object_name -> obj -> 'a) -> 'a -> 'a
-val iter_all_segments : bool -> (object_name -> obj -> unit) -> unit
+val iter_all_segments : (object_name -> obj -> unit) -> unit
 
 
 val debug_print_modtab : unit -> Pp.std_ppcmds
diff --git a/library/dischargedhypsmap.ml b/library/dischargedhypsmap.ml
index 59a01d81..2a3abda8 100644
--- a/library/dischargedhypsmap.ml
+++ b/library/dischargedhypsmap.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: dischargedhypsmap.ml,v 1.3.2.1 2004/07/16 19:30:35 herbelin Exp $ *)
+(* $Id: dischargedhypsmap.ml 6748 2005-02-18 22:17:50Z herbelin $ *)
 
 open Util
 open Libnames
@@ -24,13 +24,16 @@ type discharged_hyps = section_path list
 
 let discharged_hyps_map = ref Spmap.empty
 
-let cache_discharged_hyps_map (_,(sp,hyps)) = 
+let load_discharged_hyps_map _ (_,(sp,hyps)) = 
   discharged_hyps_map := Spmap.add sp hyps !discharged_hyps_map
 
+let cache_discharged_hyps_map o =
+  load_discharged_hyps_map 1 o
+
 let (in_discharged_hyps_map, _) =
   declare_object { (default_object "DISCHARGED-HYPS-MAP") with
     cache_function = cache_discharged_hyps_map;
-    load_function = (fun _ -> cache_discharged_hyps_map);
+    load_function = load_discharged_hyps_map;
     export_function = (fun x -> Some x) }
 
 let set_discharged_hyps sp hyps =
diff --git a/library/dischargedhypsmap.mli b/library/dischargedhypsmap.mli
index 8851e5a3..9a3259ce 100644
--- a/library/dischargedhypsmap.mli
+++ b/library/dischargedhypsmap.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: dischargedhypsmap.mli,v 1.2.8.1 2004/07/16 19:30:35 herbelin Exp $ i*)
+(*i $Id: dischargedhypsmap.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Libnames
diff --git a/library/global.ml b/library/global.ml
index 8694d7af..b4d3a7ff 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: global.ml,v 1.43.2.2 2005/11/23 14:46:17 barras Exp $ *)
+(* $Id: global.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 open Util
 open Names
@@ -39,6 +39,7 @@ let _ =
 
 let universes () = universes (env())
 let named_context () = named_context (env())
+let named_context_val () = named_context_val (env())
 
 let push_named_assum a =
   let (cst,env) = push_named_assum a !global_env in
@@ -134,14 +135,14 @@ let env_of_context hyps =
 open Libnames
 
 let type_of_reference env = function
-  | VarRef id -> let (_,_,t) = Environ.lookup_named id env in t
+  | VarRef id -> Environ.named_type id env 
   | ConstRef c -> Environ.constant_type env c
-  | IndRef ind -> Inductive.type_of_inductive env ind
-  | ConstructRef cstr -> Inductive.type_of_constructor env cstr
+  | IndRef ind ->
+     let specif = Inductive.lookup_mind_specif env ind in
+      Inductive.type_of_inductive specif
+  | ConstructRef cstr ->
+     let specif =
+      Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
+       Inductive.type_of_constructor cstr specif
 
 let type_of_global t = type_of_reference (env ()) t
-
-
-(*let get_kn dp l = 
-  make_kn (current_modpath !global_env) dp l
-*)
diff --git a/library/global.mli b/library/global.mli
index 007986d1..278b9e65 100644
--- a/library/global.mli
+++ b/library/global.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: global.mli,v 1.40.2.2 2005/11/23 14:46:17 barras Exp $ i*)
+(*i $Id: global.mli 7899 2006-01-20 16:35:03Z barras $ i*)
 
 (*i*)
 open Names
@@ -29,7 +29,10 @@ open Safe_typing
 val safe_env : unit -> safe_environment
 val env : unit -> Environ.env
 
+val env_is_empty : unit -> bool
+
 val universes : unit -> universes
+val named_context_val : unit -> Environ.named_context_val
 val named_context : unit -> Sign.named_context
 
 val env_is_empty : unit -> bool
@@ -42,7 +45,7 @@ val push_named_def   : (identifier * constr * types option) -> Univ.constraints
   functions verify that given names match those generated by kernel *)
 
 val add_constant : 
-  dir_path -> identifier -> global_declaration -> kernel_name
+  dir_path -> identifier -> global_declaration -> constant
 val add_mind        : 
   dir_path -> identifier -> mutual_inductive_entry -> kernel_name
 
@@ -51,7 +54,7 @@ val add_modtype     : identifier -> module_type_entry -> kernel_name
 
 val add_constraints : constraints -> unit
 
-val set_engagement : Environ.engagement -> unit
+val set_engagement : engagement -> unit
 
 (*s Interactive modules and module types *)
 (* Both [start_*] functions take the [dir_path] argument to create a 
@@ -93,5 +96,5 @@ val import : compiled_library -> Digest.t -> module_path
  * environment and a given context. *)
   
 val type_of_global : Libnames.global_reference -> types
-val env_of_context : Sign.named_context -> Environ.env
+val env_of_context : Environ.named_context_val -> Environ.env
 
diff --git a/library/goptions.ml b/library/goptions.ml
index bcb4fb79..c220544c 100644
--- a/library/goptions.ml
+++ b/library/goptions.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: goptions.ml,v 1.22.2.1 2004/07/16 19:30:35 herbelin Exp $ *)
+(* $Id: goptions.ml 6304 2004-11-16 15:49:08Z sacerdot $ *)
 
 (* This module manages customization parameters at the vernacular level     *)
 
@@ -17,6 +17,7 @@ open Names
 open Libnames
 open Term
 open Nametab
+open Mod_subst
 
 (****************************************************************************)
 (* 0- Common things                                                         *)
diff --git a/library/goptions.mli b/library/goptions.mli
index bbf5357a..16744ec4 100644
--- a/library/goptions.mli
+++ b/library/goptions.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: goptions.mli,v 1.10.6.1 2004/07/16 19:30:35 herbelin Exp $ i*)
+(*i $Id: goptions.mli 6304 2004-11-16 15:49:08Z sacerdot $ i*)
 
 (* This module manages customization parameters at the vernacular level     *)
 
@@ -59,6 +59,7 @@ open Names
 open Libnames
 open Term
 open Nametab
+open Mod_subst
 (*i*)
 
 (*s Things common to tables and options. *)
diff --git a/library/impargs.ml b/library/impargs.ml
index 8a9429a4..08ae2aa5 100644
--- a/library/impargs.ml
+++ b/library/impargs.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: impargs.ml,v 1.59.2.1 2004/07/16 19:30:35 herbelin Exp $ *)
+(* $Id: impargs.ml 8672 2006-03-29 21:06:33Z herbelin $ *)
 
 open Util
 open Names
@@ -27,63 +27,44 @@ open Topconstr
 
 (* les implicites sont stricts par défaut en v8 *)
 let implicit_args = ref false
-let strict_implicit_args = ref (not !Options.v7)
+let strict_implicit_args = ref true
 let contextual_implicit_args = ref false
 
-let implicit_args_out = ref false
-let strict_implicit_args_out = ref true
-let contextual_implicit_args_out = ref false
-
 let make_implicit_args flag =
-  implicit_args := flag;
-  if not !Options.v7_only then implicit_args_out := flag;
-  if !Options.translate_strict_impargs then
-    strict_implicit_args_out := not flag
+  implicit_args := flag
 
 let make_strict_implicit_args flag =
-  strict_implicit_args := flag;
-  if not !Options.v7_only then strict_implicit_args_out := flag
+  strict_implicit_args := flag
 
 let make_contextual_implicit_args flag =
-  contextual_implicit_args := flag;
-  if not !Options.v7_only then contextual_implicit_args_out := flag
+  contextual_implicit_args := flag
 
 let is_implicit_args () = !implicit_args
-let is_implicit_args_out () = !implicit_args_out
 let is_strict_implicit_args () = !strict_implicit_args
 let is_contextual_implicit_args () = !contextual_implicit_args
 
-type implicits_flags = (bool * bool * bool) * (bool * bool * bool)
+type implicits_flags = bool * bool * bool
+
+let implicits_flags () = 
+  (!implicit_args, !strict_implicit_args, !contextual_implicit_args)
 
-let with_implicits ((a,b,c),(d,e,g)) f x =
+let with_implicits (a,b,c) f x =
   let oa = !implicit_args in
   let ob = !strict_implicit_args in
   let oc = !contextual_implicit_args in
-  let od = !implicit_args_out in
-  let oe = !strict_implicit_args_out in
-  let og = !contextual_implicit_args_out in
   try 
     implicit_args := a;
     strict_implicit_args := b;
     contextual_implicit_args := c;
-    implicit_args_out := d;
-    strict_implicit_args_out := e;
-    contextual_implicit_args_out := g;
     let rslt = f x in 
     implicit_args := oa;
     strict_implicit_args := ob;
     contextual_implicit_args := oc;
-    implicit_args_out := od;
-    strict_implicit_args_out := oe;
-    contextual_implicit_args_out := og;
     rslt
   with e -> begin
     implicit_args := oa;
     strict_implicit_args := ob;
     contextual_implicit_args := oc;
-    implicit_args_out := od;
-    strict_implicit_args_out := oe;
-    contextual_implicit_args_out := og;
     raise e
   end
 
@@ -135,7 +116,7 @@ let update pos rig (na,st) =
       | Some (DepFlexAndRigid (fpos,rpos) as x) ->
           if argument_less (pos,fpos) or pos=fpos then DepRigid pos else
           if argument_less (pos,rpos) then DepFlexAndRigid (fpos,pos) else x
-      | Some (DepFlex fpos as x) ->
+      | Some (DepFlex fpos) ->
           if argument_less (pos,fpos) or pos=fpos then DepRigid pos
           else DepFlexAndRigid (fpos,pos)
       | Some Manual -> assert false
@@ -213,13 +194,9 @@ let compute_implicits_gen strict contextual env t =
 	Array.to_list v
     | _ -> []
 
-let compute_implicits output env t =
-  let strict =
-    (not output & !strict_implicit_args) or
-    (output & !strict_implicit_args_out) in 
-  let contextual =
-    (not output & !contextual_implicit_args) or
-    (output & !contextual_implicit_args_out) in
+let compute_implicits env t =
+  let strict = !strict_implicit_args in
+  let contextual = !contextual_implicit_args in
   let l = compute_implicits_gen strict contextual env t in
   List.map (function
     | (Name id, Some imp) -> Some (id,imp)
@@ -267,20 +244,11 @@ type implicits =
   | No_impl
 
 let auto_implicits env ty =
-  let impl = 
-    if !implicit_args then
-      let l = compute_implicits false env ty in
-      Impl_auto (!strict_implicit_args,!contextual_implicit_args,l)
-    else
-      No_impl in
-  if Options.do_translate () then
-    impl, 
-    if !implicit_args_out then 
-      (let l = compute_implicits true env ty in
-      Impl_auto (!strict_implicit_args_out,!contextual_implicit_args_out,l))
-    else No_impl
-  else 
-    impl, impl
+  if !implicit_args then
+    let l = compute_implicits env ty in
+    Impl_auto (!strict_implicit_args,!contextual_implicit_args,l)
+  else
+    No_impl
 
 let list_of_implicits = function 
   | Impl_auto (_,_,l) -> l
@@ -289,7 +257,7 @@ let list_of_implicits = function
 
 (*s Constants. *)
 
-let constants_table = ref KNmap.empty
+let constants_table = ref Cmap.empty
 
 let compute_constant_implicits kn =
   let env = Global.env () in
@@ -297,7 +265,7 @@ let compute_constant_implicits kn =
   auto_implicits env (body_of_type cb.const_type)
 
 let constant_implicits sp =
-  try KNmap.find sp !constants_table with Not_found -> No_impl,No_impl
+  try Cmap.find sp !constants_table with Not_found -> No_impl
 
 (*s Inductives and constructors. Their implicit arguments are stored
    in an array, indexed by the inductive number, of pairs $(i,v)$ where
@@ -326,10 +294,11 @@ let compute_mib_implicits kn =
   Array.mapi imps_one_inductive mib.mind_packets
 
 let inductive_implicits indp =
-  try Indmap.find indp !inductives_table with Not_found -> No_impl,No_impl
+  try Indmap.find indp !inductives_table with Not_found -> No_impl
 
 let constructor_implicits consp =
-  try Constrmap.find consp !constructors_table with Not_found -> No_impl,No_impl
+  try Constrmap.find consp !constructors_table with Not_found -> No_impl
+
 (*s Variables. *)
 
 let var_table = ref Idmap.empty
@@ -340,7 +309,17 @@ let compute_var_implicits id =
   auto_implicits env ty
 
 let var_implicits id = 
-  try Idmap.find id !var_table with Not_found -> No_impl,No_impl
+  try Idmap.find id !var_table with Not_found -> No_impl
+
+(* Implicits of a global reference. *)
+
+let compute_global_implicits = function
+  | VarRef id -> compute_var_implicits id
+  | ConstRef kn -> compute_constant_implicits kn
+  | IndRef (kn,i) -> 
+      let ((_,imps),_) = (compute_mib_implicits kn).(i) in imps
+  | ConstructRef ((kn,i),j) -> 
+      let (_,cimps) = (compute_mib_implicits kn).(i) in snd cimps.(j-1)
 
 (* Caching implicits *)
 
@@ -349,16 +328,19 @@ let cache_implicits_decl (r,imps) =
   | VarRef id -> 
       var_table := Idmap.add id imps !var_table
   | ConstRef kn ->
-      constants_table := KNmap.add kn imps !constants_table
+      constants_table := Cmap.add kn imps !constants_table
   | IndRef indp ->
       inductives_table := Indmap.add indp imps !inductives_table;
   | ConstructRef consp -> 
       constructors_table := Constrmap.add consp imps !constructors_table
 
-let cache_implicits (_,l) = List.iter cache_implicits_decl l
+let load_implicits _ (_,l) = List.iter cache_implicits_decl l
+
+let cache_implicits o =
+  load_implicits 1 o
 
 let subst_implicits_decl subst (r,imps as o) =
-  let r' = subst_global subst r in if r==r' then o else (r',imps)
+  let r' = fst (subst_global subst r) in if r==r' then o else (r',imps)
 
 let subst_implicits (_,subst,l) =
   list_smartmap (subst_implicits_decl subst) l
@@ -366,40 +348,27 @@ let subst_implicits (_,subst,l) =
 let (in_implicits, _) =
   declare_object {(default_object "IMPLICITS") with 
     cache_function = cache_implicits;
-    load_function = (fun _ -> cache_implicits);
+    load_function = load_implicits;
     subst_function = subst_implicits;
     classify_function = (fun (_,x) -> Substitute x);
     export_function = (fun x -> Some x) }
 
-(* Implicits of a global reference. *)
-
-let compute_global_implicits = function
-  | VarRef id -> compute_var_implicits id
-  | ConstRef kn -> compute_constant_implicits kn
-  | IndRef (kn,i) -> 
-      let ((_,imps),_) = (compute_mib_implicits kn).(i) in imps
-  | ConstructRef ((kn,i),j) -> 
-      let (_,cimps) = (compute_mib_implicits kn).(i) in snd cimps.(j-1)
-
 let declare_implicits_gen r = 
   add_anonymous_leaf (in_implicits [r,compute_global_implicits r])
 
 let declare_implicits r =
   with_implicits
-    ((true,!strict_implicit_args,!contextual_implicit_args),
-     (true,!strict_implicit_args_out,!contextual_implicit_args_out))
+    (true,!strict_implicit_args,!contextual_implicit_args)
     declare_implicits_gen r
 
 let declare_var_implicits id =
-  if !implicit_args or !implicit_args_out then
-    declare_implicits_gen (VarRef id)
+  if !implicit_args then declare_implicits_gen (VarRef id)
 
 let declare_constant_implicits kn =
-  if !implicit_args or !implicit_args_out then
-    declare_implicits_gen (ConstRef kn)
+  if !implicit_args then declare_implicits_gen (ConstRef kn)
 
 let declare_mib_implicits kn =
-  if !implicit_args or !implicit_args_out then
+  if !implicit_args then
   let imps = compute_mib_implicits kn in
   let imps = array_map_to_list
     (fun (ind,cstrs) -> ind::(Array.to_list cstrs)) imps in
@@ -412,28 +381,10 @@ let implicits_of_global_gen = function
   | ConstructRef csp ->	constructor_implicits csp
 
 let implicits_of_global r =
-  let (imp_in,imp_out) = implicits_of_global_gen r in
-  list_of_implicits imp_in
-
-let implicits_of_global_out r =
-  let (imp_in,imp_out) = implicits_of_global_gen r in
-  list_of_implicits imp_out
+  list_of_implicits (implicits_of_global_gen r)
 
 (* Declare manual implicits *)
 
-(*
-let check_range n = function
-  | loc,ExplByPos i ->
-      if i<1 or i>n then error ("Bad argument number: "^(string_of_int i))
-  | loc,ExplByName id ->
-()
-*)
-
-let rec list_remove a = function
-  | b::l when a = b -> l
-  | b::l -> b::list_remove a l
-  | [] -> raise Not_found
-
 let set_implicit id imp =
   Some (id,match imp with None -> Manual | Some imp -> imp)
 
@@ -443,15 +394,13 @@ let declare_manual_implicits r l =
   let n = List.length autoimps in
   if not (list_distinct l) then 
     error ("Some parameters are referred more than once");
-(*  List.iter (check_range n) l;*)
-(*  let l = List.sort (-) l in*)
   (* Compare with automatic implicits to recover printing data and names *)
   let rec merge k l = function
     | (Name id,imp)::imps ->
 	let l',imp =
-	  try list_remove (ExplByPos k) l, set_implicit id imp
+	  try list_remove_first (ExplByPos k) l, set_implicit id imp
 	  with Not_found ->
-	  try list_remove (ExplByName id) l, set_implicit id imp
+	  try list_remove_first (ExplByName id) l, set_implicit id imp
 	  with Not_found ->
 	  l, None in
 	imp :: merge (k+1) l' imps
@@ -470,8 +419,6 @@ let declare_manual_implicits r l =
 		(str "Cannot set implicit argument number " ++ int i ++
 		 str ": it has no name") in
   let l = Impl_manual (merge 1 l autoimps) in
-  let (_,oimp_out) = implicits_of_global_gen r in
-  let l = l, if !Options.v7_only then oimp_out else l in
   add_anonymous_leaf (in_implicits [r,l])
 
 (* Tests if declared implicit *)
@@ -481,11 +428,11 @@ let test = function
   | Impl_auto (s,c,_) -> true,s,c
 
 let test_if_implicit find a =
-  try let b,c = find a in test b, test c
-  with Not_found -> (false,false,false),(false,false,false)
+  try let b = find a in test b
+  with Not_found -> (false,false,false)
     
 let is_implicit_constant sp =
-  test_if_implicit (KNmap.find sp) !constants_table
+  test_if_implicit (Cmap.find sp) !constants_table
 
 let is_implicit_inductive_definition indp =
   test_if_implicit (Indmap.find (indp,0)) !inductives_table
@@ -496,7 +443,7 @@ let is_implicit_var id =
 (*s Registration as global tables *)
 
 let init () =
-  constants_table := KNmap.empty;
+  constants_table := Cmap.empty;
   inductives_table := Indmap.empty;
   constructors_table := Constrmap.empty;
   var_table := Idmap.empty
@@ -518,34 +465,3 @@ let _ =
       Summary.init_function = init;
       Summary.survive_module = false;
       Summary.survive_section = false }
-
-(* Remark: flags implicit_args, contextual_implicit_args
-   are synchronized by the general options mechanism - see Vernacentries *)
-
-let init () =
-  (* strict_implicit_args_out must be not !Options.v7 
-     but init is done before parsing *)
-  strict_implicit_args:=not !Options.v7;
-  implicit_args_out:=false;
-  (* strict_implicit_args_out needs to be not !Options.v7 or
-     Options.do_translate() but init is done before parsing *)
-  strict_implicit_args_out:=true;
-  contextual_implicit_args_out:=false
-
-let freeze () =
-  (!strict_implicit_args,
-   !implicit_args_out,!strict_implicit_args_out,!contextual_implicit_args_out)
-
-let unfreeze (b,d,e,f) =
-  strict_implicit_args := b;
-  implicit_args_out := d;
-  strict_implicit_args_out := e;
-  contextual_implicit_args_out := f
-
-let _ = 
-  Summary.declare_summary "implicits-out-options"
-    { Summary.freeze_function = freeze;
-      Summary.unfreeze_function = unfreeze;
-      Summary.init_function = init;
-      Summary.survive_module = false;
-      Summary.survive_section = true }
diff --git a/library/impargs.mli b/library/impargs.mli
index 8db04ee7..671d195c 100644
--- a/library/impargs.mli
+++ b/library/impargs.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: impargs.mli,v 1.26.2.1 2004/07/16 19:30:35 herbelin Exp $ i*)
+(*i $Id: impargs.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -43,7 +43,7 @@ val positions_of_implicits : implicits_list -> int list
 
 (* Computation of the positions of arguments automatically inferable
    for an object of the given type in the given env *)
-val compute_implicits : bool -> env -> types -> implicits_list
+val compute_implicits : env -> types -> implicits_list
 
 (*s Computation of implicits (done using the global environment). *)
 
@@ -64,6 +64,4 @@ val is_implicit_var : variable -> implicits_flags
 
 val implicits_of_global : global_reference -> implicits_list
 
-(* For translator *)
-val implicits_of_global_out : global_reference -> implicits_list
-val is_implicit_args_out : unit -> bool
+val implicits_flags : unit -> implicits_flags
diff --git a/library/lib.ml b/library/lib.ml
index c46634f4..ee553cad 100644
--- a/library/lib.ml
+++ b/library/lib.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: lib.ml,v 1.63.2.4 2005/11/04 09:02:38 herbelin Exp $ *)
+(* $Id: lib.ml 7710 2005-12-23 10:16:42Z herbelin $ *)
 
 open Pp
 open Util
@@ -21,11 +21,10 @@ open Summary
 type node = 
   | Leaf of obj
   | CompilingLibrary of object_prefix
-  | OpenedModule of object_prefix * Summary.frozen
+  | OpenedModule of bool option * object_prefix * Summary.frozen
   | OpenedModtype of object_prefix * Summary.frozen
   | OpenedSection of object_prefix * Summary.frozen
-  (* bool is to tell if the section must be opened automatically *)
-  | ClosedSection of bool * dir_path * library_segment
+  | ClosedSection
   | FrozenState of Summary.frozen
 
 and library_entry = object_name * node
@@ -51,7 +50,7 @@ let subst_objects prefix subst seg =
 let classify_segment seg =
   let rec clean ((substl,keepl,anticipl) as acc) = function
     | (_,CompilingLibrary _) :: _ | [] -> acc
-    | ((sp,kn as oname),Leaf o) as node :: stk -> 
+    | ((sp,kn as oname),Leaf o) :: stk -> 
 	let id = id_of_label (label kn) in
 	  (match classify_object (oname,o) with 
 	     | Dispose -> clean acc stk
@@ -61,7 +60,7 @@ let classify_segment seg =
 		 clean ((id,o')::substl, keepl, anticipl) stk
 	     | Anticipate o' ->
 		 clean (substl, keepl, o'::anticipl) stk)
-    | (oname,ClosedSection _ as item) :: stk -> clean acc stk
+    | (oname,ClosedSection) :: stk -> clean acc stk
     | (_,OpenedSection _) :: _ -> error "there are still opened sections"
     | (_,OpenedModule _) :: _ -> error "there are still opened modules"
     | (_,OpenedModtype _) :: _ -> error "there are still opened module types"
@@ -105,6 +104,10 @@ let make_kn id =
   let mp,dir = current_prefix () in
     Names.make_kn mp dir (label_of_id id)
 
+let make_con id = 
+  let mp,dir = current_prefix () in
+    Names.make_con mp dir (label_of_id id)
+
 
 let make_oname id = make_path id, make_kn id
 
@@ -121,7 +124,7 @@ let sections_are_opened () =
 let recalc_path_prefix () =
   let rec recalc = function
     | (sp, OpenedSection (dir,_)) :: _ -> dir
-    | (sp, OpenedModule (dir,_)) :: _ -> dir
+    | (sp, OpenedModule (_,dir,_)) :: _ -> dir
     | (sp, OpenedModtype (dir,_)) :: _ -> dir
     | (sp, CompilingLibrary dir) :: _ -> dir
     | _::l -> recalc l
@@ -180,6 +183,8 @@ let add_absolutely_named_leaf sp obj =
   add_entry sp (Leaf obj)
 
 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);
@@ -211,29 +216,13 @@ let is_something_opened = function
   | (_,OpenedModtype _) -> true
   | _ -> false
 
-let export_segment seg =
-  let rec clean acc = function
-    | (_,CompilingLibrary _) :: _ | [] -> acc
-    | (oname,Leaf o) as node :: stk ->
-	(match export_object o with
-	   | None -> clean acc stk
-	   | Some o' -> clean ((oname,Leaf o') :: acc) stk)
-    | (oname,ClosedSection _ as item) :: stk -> clean (item :: acc) stk
-    | (_,OpenedSection _) :: _ -> error "there are still opened sections"
-    | (_,OpenedModule _) :: _ -> error "there are still opened modules"
-    | (_,OpenedModtype _) :: _ -> error "there are still opened module types"
-    | (_,FrozenState _) :: stk -> clean acc stk
-  in
-    clean [] seg
-
-
-let start_module id mp nametab = 
+let start_module export id mp nametab = 
   let dir = extend_dirpath (fst !path_prefix) id in
   let prefix = dir,(mp,empty_dirpath) in
   let oname = make_path id, make_kn id in
   if Nametab.exists_module dir then
     errorlabstrm "open_module" (pr_id id ++ str " already exists") ;
-  add_entry oname (OpenedModule (prefix,nametab));
+  add_entry oname (OpenedModule (export,prefix,nametab));
   path_prefix := prefix;
   prefix
 (*  add_frozen_state () must be called in declaremods *)
@@ -241,7 +230,7 @@ let start_module id mp nametab =
 let end_module id = 
   let oname,nametab = 
     try match find_entry_p is_something_opened with
-      | oname,OpenedModule (_,nametab) -> 
+      | oname,OpenedModule (_,_,nametab) -> 
 	  let sp = fst oname in
 	  let id' = basename sp in
 	  if id<>id' then error "this is not the last opened module"; 
@@ -379,6 +368,70 @@ let is_module () =
 (* Returns the most recent OpenedThing node *)
 let what_is_opened () = find_entry_p is_something_opened
 
+(* Discharge tables *)
+
+let sectab =
+  ref ([] : (identifier list *
+             (identifier array Cmap.t * identifier array KNmap.t) *
+             (Sign.named_context Cmap.t * Sign.named_context KNmap.t)) list)
+
+let add_section () =
+  sectab := ([],(Cmap.empty,KNmap.empty),(Cmap.empty,KNmap.empty)) :: !sectab
+
+let add_section_variable id =
+  match !sectab with
+    | [] -> () (* because (Co-)Fixpoint temporarily uses local vars *)
+    | (vars,repl,abs)::sl -> sectab := (id::vars,repl,abs)::sl
+
+let rec extract_hyps = function
+  | (id::idl,(id',_,_ as d)::hyps) when id=id' -> d :: extract_hyps (idl,hyps)
+  | (id::idl,hyps) -> extract_hyps (idl,hyps)
+  | [], _ -> []
+
+let add_section_replacement f g hyps =
+  match !sectab with
+  | [] -> ()
+  | (vars,exps,abs)::sl ->
+    let sechyps = extract_hyps (vars,hyps) in
+    let args = Sign.instance_from_named_context (List.rev sechyps) in
+    sectab := (vars,f (Array.map Term.destVar args) exps,g sechyps abs)::sl
+	
+let add_section_kn kn =
+  let f = (fun x (l1,l2) -> (l1,KNmap.add kn x l2)) in
+  add_section_replacement f f
+
+let add_section_constant kn =
+  let f = (fun x (l1,l2) -> (Cmap.add kn x l1,l2)) in
+  add_section_replacement f f
+
+let replacement_context () = pi2 (List.hd !sectab)
+
+let section_segment = function
+  | VarRef id ->
+      []
+  | ConstRef con -> 
+      Cmap.find con (fst (pi3 (List.hd !sectab)))
+  | IndRef (kn,_) | ConstructRef ((kn,_),_) ->
+      KNmap.find kn (snd (pi3 (List.hd !sectab)))
+
+let section_instance r =
+  Sign.instance_from_named_context (List.rev (section_segment r))
+
+let init () = sectab := []
+let freeze () = !sectab
+let unfreeze s = sectab := s
+
+let _ = 
+  Summary.declare_summary "section-context"
+    { Summary.freeze_function = freeze;
+      Summary.unfreeze_function = unfreeze;
+      Summary.init_function = init;
+      Summary.survive_module = false;
+      Summary.survive_section = false }
+
+(*************)
+(* Sections. *)
+
 (* XML output hooks *)
 let xml_open_section = ref (fun id -> ())
 let xml_close_section = ref (fun id -> ())
@@ -386,8 +439,6 @@ let xml_close_section = ref (fun id -> ())
 let set_xml_open_section f = xml_open_section := f
 let set_xml_close_section f = xml_close_section := f
 
-(* Sections. *)
-
 let open_section id =
   let olddir,(mp,oldsec) = !path_prefix in
   let dir = extend_dirpath olddir id in
@@ -401,12 +452,19 @@ let open_section id =
   Nametab.push_dir (Nametab.Until 1) dir (DirOpenSection prefix);
   path_prefix := prefix;
   if !Options.xml_export then !xml_open_section id;
-  prefix
+  add_section ()
 
 
 (* Restore lib_stk and summaries as before the section opening, and
    add a ClosedSection object. *)
-let close_section ~export id =
+
+let discharge_item = function
+  | ((sp,_ as oname),Leaf lobj) ->
+      option_app (fun o -> (basename sp,o)) (discharge_object (oname,lobj))
+  | _ ->
+      None
+
+let close_section id =
   let oname,fs = 
     try match find_entry_p is_something_opened with
       | oname,OpenedSection (_,fs) -> 
@@ -417,25 +475,26 @@ let close_section ~export id =
     with Not_found ->
       error "no opened section"
   in
-  let (after,_,before) = split_lib oname in
+  let (secdecls,_,before) = split_lib oname in
   lib_stk := before;
-  let prefix = !path_prefix in
+  let full_olddir = fst !path_prefix in
   pop_path_prefix ();
-  let closed_sec = 
-    ClosedSection (export, (fst prefix), export_segment after)
-  in
-  let name = make_path id, make_kn id in
-  add_entry name closed_sec;
+  add_entry (make_oname id) ClosedSection;
   if !Options.xml_export then !xml_close_section id;
-  (prefix, after, fs)
+  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. *)
 
 let recache_decl = function
   | (sp, Leaf o) -> cache_object (sp,o)
+  | (_,OpenedSection _) -> add_section ()
   | _ -> ()
 
-
 let recache_context ctx =
   List.iter recache_decl ctx
 
@@ -463,7 +522,7 @@ let reset_name (loc,id) =
 
 let is_mod_node = function 
   | OpenedModule _ | OpenedModtype _ | OpenedSection _ 
-  | ClosedSection _ -> true 
+  | ClosedSection -> true 
   | Leaf o -> let t = object_tag o in t = "MODULE" || t = "MODULE TYPE"
   | _ -> false
 
@@ -471,7 +530,7 @@ let is_mod_node = function
    the same name *) 
 
 let reset_mod (loc,id) =
-  let (ent,before) = 
+  let (_,before) = 
     try
       find_split_p (fun (sp,node) -> 
                     let (_,spi) = repr_path (fst sp) in id = spi 
@@ -489,15 +548,29 @@ let reset_mod (loc,id) =
   recache_context after
 
 
-let point_obj =
-  let (f,_) = declare_object {(default_object "DOT") with
-				classify_function = (fun _ -> Dispose)} in
-    f()
+let (inLabel,outLabel) =
+  declare_object {(default_object "DOT") with
+				classify_function = (fun _ -> Dispose)}
 
-let mark_end_of_command () =
-  match !lib_stk with
-      (_,Leaf o)::_ when object_tag o = "DOT" -> ()
-    | _ -> add_anonymous_leaf point_obj
+let mark_end_of_command, current_command_label, set_command_label =
+  let n = ref 0 in
+  (fun () ->
+    match !lib_stk with
+        (_,Leaf o)::_ when object_tag o = "DOT" -> ()
+      | _ -> incr n;add_anonymous_leaf (inLabel !n)),
+  (fun () -> !n),
+  (fun x -> n:=x)
+
+let rec reset_label_stk n stk =
+  match stk with
+      (sp,Leaf o)::tail when object_tag o = "DOT" && n = outLabel o -> sp
+    | _::tail -> reset_label_stk n tail
+    | [] -> error "Unknown state number"
+
+let reset_label n = 
+  let res = reset_label_stk n !lib_stk in
+  set_command_label (n-1); (* forget state numbers after n only if reset succeeded *)
+  reset_to res
 
 let rec back_stk n stk =
   match stk with
@@ -543,6 +616,7 @@ let reset_initial () =
 	  | (_,[_,FrozenState fs as hd],before) ->
 	      lib_stk := hd::before;
 	      recalc_path_prefix ();
+			set_command_label 0;
 	      unfreeze_summaries fs
 	  | _ -> assert false
 	end
@@ -564,14 +638,39 @@ let library_part ref =
 	(* Theorem/Lemma outside its outer section of definition *)
 	dir
 
+(************************)
+(* Discharging names *)
+
+let pop_kn kn =
+  let (mp,dir,l) = Names.repr_kn kn in
+  Names.make_kn mp (dirpath_prefix dir) l
+
+let pop_con con = 
+  let (mp,dir,l) = Names.repr_con con in
+  Names.make_con mp (dirpath_prefix dir) l
+
+let con_defined_in_sec kn = 
+  let _,dir,_ = repr_con kn in
+  dir <> empty_dirpath && fst (split_dirpath dir) = snd (current_prefix ())
+
+let defined_in_sec kn = 
+  let _,dir,_ = repr_kn kn in
+  dir <> empty_dirpath && fst (split_dirpath dir) = snd (current_prefix ())
+
+let discharge_global = function
+  | ConstRef kn when con_defined_in_sec kn ->
+      ConstRef (pop_con kn)
+  | IndRef (kn,i) when defined_in_sec kn ->
+      IndRef (pop_kn kn,i)
+  | ConstructRef ((kn,i),j) when defined_in_sec kn ->
+      ConstructRef ((pop_kn kn,i),j)
+  | r -> r
+
+let discharge_kn kn = 
+  if defined_in_sec kn then pop_kn kn else kn
 
-let rec file_of_mp = function
-  | MPfile dir -> Some dir
-  | MPself _ -> Some (library_dp ())
-  | MPbound _ -> None
-  | MPdot (mp,_) -> file_of_mp mp
+let discharge_con cst = 
+  if con_defined_in_sec cst then pop_con cst else cst
 
-let file_part = function
-  | VarRef id -> anomaly "TODO";
-  | ConstRef kn | ConstructRef ((kn,_),_) | IndRef (kn,_) -> 
-      file_of_mp (modpath kn)
+let discharge_inductive (kn,i) =
+  (discharge_kn kn,i)
diff --git a/library/lib.mli b/library/lib.mli
index aa874470..22b6b6d8 100644
--- a/library/lib.mli
+++ b/library/lib.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: lib.mli,v 1.41.2.3 2005/01/21 16:41:50 herbelin Exp $ i*)
+(*i $Id: lib.mli 6758 2005-02-20 18:13:28Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -14,6 +14,7 @@ open Names
 open Libnames
 open Libobject
 open Summary
+open Mod_subst
 (*i*)
 
 (*s This module provides a general mechanism to keep a trace of all operations
@@ -23,10 +24,10 @@ open Summary
 type node = 
   | Leaf of obj
   | CompilingLibrary of object_prefix
-  | OpenedModule of object_prefix * Summary.frozen
+  | OpenedModule of bool option * object_prefix * Summary.frozen
   | OpenedModtype of object_prefix * Summary.frozen
   | OpenedSection of object_prefix * Summary.frozen
-  | ClosedSection of bool * dir_path * library_segment
+  | ClosedSection
   | FrozenState of Summary.frozen
 
 and library_segment = (object_name * node) list
@@ -65,7 +66,8 @@ val add_leaves : identifier -> obj list -> object_name
 
 val add_frozen_state : unit -> unit
 val mark_end_of_command : unit -> unit
-
+val current_command_label : unit -> int
+val reset_label : int -> unit
 
 (*s The function [contents_after] returns the current library segment, 
   starting from a given section path. If not given, the entire segment
@@ -82,6 +84,7 @@ val make_path : identifier -> section_path
 (* Kernel-side names *)
 val current_prefix : unit -> module_path * dir_path
 val make_kn : identifier -> kernel_name
+val make_con : identifier -> constant
 
 (* Are we inside an opened section *)
 val sections_are_opened : unit -> bool
@@ -99,7 +102,7 @@ val what_is_opened : unit -> object_name * node
 (*s Modules and module types *)
 
 val start_module : 
-  module_ident -> module_path -> Summary.frozen -> object_prefix
+  bool option -> module_ident -> module_path -> Summary.frozen -> object_prefix
 val end_module : module_ident 
   -> object_name * object_prefix * Summary.frozen * library_segment
 
@@ -121,15 +124,10 @@ val library_dp : unit -> dir_path
 (* Extract the library part of a name even if in a section *)
 val library_part : global_reference -> dir_path
 
-(* Extract the library part of a name if not in a functor *)
-val file_part : global_reference -> dir_path option
-
 (*s Sections *)
 
-val open_section : identifier -> object_prefix
-
-val close_section : export:bool -> identifier -> 
-  object_prefix * library_segment * Summary.frozen
+val open_section : identifier -> unit
+val close_section : identifier -> unit
 
 (*s Backtracking (undo). *)
 
@@ -157,3 +155,24 @@ val reset_initial : unit -> unit
 (* XML output hooks *)
 val set_xml_open_section : (identifier -> unit) -> unit
 val set_xml_close_section : (identifier -> unit) -> unit
+
+
+(*s Section management for discharge *)
+
+val section_segment : global_reference -> Sign.named_context
+val section_instance : global_reference -> Term.constr array
+
+val add_section_variable : identifier -> unit
+val add_section_constant : constant -> Sign.named_context -> unit
+val add_section_kn : kernel_name -> Sign.named_context -> unit
+val replacement_context : unit ->
+  (identifier array Cmap.t * identifier array KNmap.t)
+
+(*s Discharge: decrease the section level if in the current section *)
+
+val discharge_kn :  kernel_name -> kernel_name
+val discharge_con : constant -> constant
+val discharge_global : global_reference -> global_reference
+val discharge_inductive : inductive -> inductive
+
+
diff --git a/library/libnames.ml b/library/libnames.ml
index 16f5a917..536a382d 100644
--- a/library/libnames.ml
+++ b/library/libnames.ml
@@ -6,13 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: libnames.ml,v 1.11.2.1 2004/07/16 19:30:35 herbelin Exp $ i*)
+(*i $Id: libnames.ml 7052 2005-05-20 15:54:50Z herbelin $ i*)
 
 open Pp
 open Util
 open Names
 open Nameops
 open Term
+open Mod_subst
 
 type global_reference =
   | VarRef of variable
@@ -21,30 +22,34 @@ type global_reference =
   | ConstructRef of constructor
 
 let subst_global subst ref = match ref with
-  | VarRef _ -> ref
+  | VarRef var -> ref, mkVar var
   | ConstRef kn ->
-      let kn' = subst_kn subst kn in if kn==kn' then ref else
-          ConstRef kn'
+     let kn',t = subst_con subst kn in
+      if kn==kn' then ref, mkConst kn else ConstRef kn', t
   | IndRef (kn,i) ->
-      let kn' = subst_kn subst kn in if kn==kn' then ref else
-          IndRef(kn',i)
+      let kn' = subst_kn subst kn in
+      if kn==kn' then ref, mkInd (kn,i) else IndRef(kn',i), mkInd (kn',i)
   | ConstructRef ((kn,i),j) ->
-      let kn' = subst_kn subst kn in if kn==kn' then ref else
-          ConstructRef ((kn',i),j)
+      let kn' = subst_kn subst kn in 
+      if kn==kn' then ref, mkConstruct ((kn,i),j)
+      else ConstructRef ((kn',i),j), mkConstruct ((kn',i),j)
 
-let reference_of_constr c = match kind_of_term c with
+let global_of_constr c = match kind_of_term c with
   | Const sp -> ConstRef sp
   | Ind ind_sp -> IndRef ind_sp
   | Construct cstr_cp -> ConstructRef cstr_cp
   | Var id -> VarRef id
   |  _ -> raise Not_found
 
-let constr_of_reference = function
+let constr_of_global = function
   | VarRef id -> mkVar id
   | ConstRef sp -> mkConst sp
   | ConstructRef sp -> mkConstruct sp
   | IndRef sp -> mkInd sp
 
+let constr_of_reference = constr_of_global
+let reference_of_constr = global_of_constr
+
 module RefOrdered =
   struct
     type t = global_reference
@@ -54,24 +59,8 @@ module RefOrdered =
 module Refset = Set.Make(RefOrdered)
 module Refmap = Map.Make(RefOrdered)
 
-module InductiveOrdered = struct
-  type t = inductive
-  let compare (spx,ix) (spy,iy) = 
-    let c = ix - iy in if c = 0 then compare spx spy else c
-end
-
-module Indmap = Map.Make(InductiveOrdered)
-
 let inductives_table = ref Indmap.empty
 
-module ConstructorOrdered = struct
-  type t = constructor
-  let compare (indx,ix) (indy,iy) = 
-    let c = ix - iy in if c = 0 then InductiveOrdered.compare indx indy else c
-end
-
-module Constrmap = Map.Make(ConstructorOrdered)
-
 (**********************************************)
 
 let pr_dirpath sl = (str (string_of_dirpath sl))
@@ -188,18 +177,10 @@ type extended_global_reference =
   | TrueGlobal of global_reference
   | SyntacticDef of kernel_name
 
-let subst_ext subst glref = match glref with
-  | TrueGlobal ref -> 
-      let ref' = subst_global subst ref in
-	if ref' == ref then glref else
-	  TrueGlobal ref'
-  | SyntacticDef kn ->
-      let kn' = subst_kn subst kn in
-	if kn' == kn then glref else
-	  SyntacticDef kn'
-
 let encode_kn dir id = make_kn (MPfile dir) empty_dirpath (label_of_id id)
 
+let encode_con dir id = make_con (MPfile dir) empty_dirpath (label_of_id id)
+
 let decode_kn kn = 
   let mp,sec_dir,l = repr_kn kn in
     match mp,(repr_dirpath sec_dir) with
@@ -207,6 +188,13 @@ let decode_kn kn =
       | _ , [] -> anomaly "MPfile expected!"
       | _ -> anomaly "Section part should be empty!"
 
+let decode_con kn = 
+  let mp,sec_dir,l = repr_con kn in
+    match mp,(repr_dirpath sec_dir) with
+	MPfile dir,[] -> (dir,id_of_label l)
+      | _ , [] -> anomaly "MPfile expected!"
+      | _ -> anomaly "Section part should be empty!"
+
 (*s qualified names *)
 type qualid = section_path
 
@@ -267,3 +255,4 @@ let pr_reference = function
 let loc_of_reference = function
   | Qualid (loc,qid) -> loc
   | Ident (loc,id) -> loc
+
diff --git a/library/libnames.mli b/library/libnames.mli
index a6055428..06595e81 100644
--- a/library/libnames.mli
+++ b/library/libnames.mli
@@ -6,13 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: libnames.mli,v 1.8.2.2 2005/01/21 16:41:51 herbelin Exp $ i*)
+(*i $Id: libnames.mli 7052 2005-05-20 15:54:50Z herbelin $ i*)
 
 (*i*)
 open Pp
 open Util
 open Names
 open Term
+open Mod_subst
 (*i*)
 
 (*s Global reference is a kernel side type for all references together *)
@@ -22,21 +23,22 @@ type global_reference =
   | IndRef of inductive
   | ConstructRef of constructor
 
-val subst_global : substitution -> global_reference -> global_reference
+val subst_global : substitution -> global_reference -> global_reference * constr
 
 (* Turn a global reference into a construction *)
-val constr_of_reference : global_reference -> constr
+val constr_of_global : global_reference -> constr
+
+(* Turn a construction denoting a global reference into a global reference;
+   raise [Not_found] if not a global reference *)
+val global_of_constr : constr -> global_reference
 
-(* Turn a construction denoting a global into a reference;
-   raise [Not_found] if not a global *)
+(* Obsolete synonyms for constr_of_global and global_of_constr *)
+val constr_of_reference : global_reference -> constr
 val reference_of_constr : constr -> global_reference
 
 module Refset : Set.S with type elt = global_reference 
 module Refmap : Map.S with type key = global_reference
 
-module Indmap : Map.S with type key = inductive
-module Constrmap : Map.S with type key = constructor
-
 (*s Dirpaths *)
 val pr_dirpath : dir_path -> Pp.std_ppcmds
 
@@ -82,13 +84,12 @@ type extended_global_reference =
   | TrueGlobal of global_reference
   | SyntacticDef of kernel_name
 
-val subst_ext : 
-  substitution -> extended_global_reference -> extended_global_reference
-
 (*s Temporary function to brutally form kernel names from section paths *)
 
 val encode_kn : dir_path -> identifier -> kernel_name
 val decode_kn : kernel_name -> dir_path * identifier
+val encode_con : dir_path -> identifier -> constant
+val decode_con : constant -> dir_path * identifier
 
 
 (*s A [qualid] is a partially qualified ident; it includes fully
diff --git a/library/libobject.ml b/library/libobject.ml
index 2e531e05..708c19b1 100644
--- a/library/libobject.ml
+++ b/library/libobject.ml
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: libobject.ml,v 1.8.8.1 2004/07/16 19:30:35 herbelin Exp $ *)
+(* $Id: libobject.ml 6748 2005-02-18 22:17:50Z herbelin $ *)
 
 open Util
 open Names
 open Libnames
+open Mod_subst
 
 (* The relax flag is used to make it possible to load files while ignoring
    failures to incorporate some objects.  This can be useful when one
@@ -35,6 +36,7 @@ type 'a object_declaration = {
   open_function : int -> object_name * 'a -> unit;
   classify_function : object_name * 'a -> 'a substitutivity;
   subst_function : object_name * substitution * 'a -> 'a;
+  discharge_function : object_name * 'a -> 'a option;
   export_function : 'a -> 'a option }
 
 let yell s = anomaly s
@@ -47,6 +49,7 @@ let default_object s = {
   subst_function = (fun _ -> 
     yell ("The object "^s^" does not know how to substitute!"));
   classify_function = (fun (_,obj) -> Keep obj);
+  discharge_function = (fun _ -> None);
   export_function = (fun _ -> None)} 
 
 
@@ -71,6 +74,7 @@ type dynamic_object_declaration = {
   dyn_open_function : int -> object_name * obj -> unit;
   dyn_subst_function : object_name * substitution * obj -> obj;
   dyn_classify_function : object_name * obj -> obj substitutivity;
+  dyn_discharge_function : object_name * obj -> obj option;
   dyn_export_function : obj -> obj option }
 
 let object_tag lobj = Dyn.tag lobj
@@ -103,6 +107,11 @@ let declare_object odecl =
 	| Anticipate (obj) -> Anticipate (infun obj)
     else 
       anomaly "somehow we got the wrong dynamic object in the classifyfun"
+  and discharge (oname,lobj) = 
+    if Dyn.tag lobj = na then 
+      option_app infun (odecl.discharge_function (oname,outfun lobj))
+    else 
+      anomaly "somehow we got the wrong dynamic object in the dischargefun"
   and exporter lobj = 
     if Dyn.tag lobj = na then 
       option_app infun (odecl.export_function (outfun lobj))
@@ -115,6 +124,7 @@ let declare_object odecl =
                              dyn_open_function = opener;
 			     dyn_subst_function = substituter;
 			     dyn_classify_function = classifier;
+			     dyn_discharge_function = discharge;
                              dyn_export_function = exporter };
   (infun,outfun)
 
@@ -153,5 +163,8 @@ let subst_object ((_,_,lobj) as node) =
 let classify_object ((_,lobj) as node) = 
   apply_dyn_fun Dispose (fun d -> d.dyn_classify_function node) lobj
 
+let discharge_object ((_,lobj) as node) = 
+  apply_dyn_fun None (fun d -> d.dyn_discharge_function node) lobj
+
 let export_object lobj =
   apply_dyn_fun None (fun d -> d.dyn_export_function lobj) lobj
diff --git a/library/libobject.mli b/library/libobject.mli
index b9070f5d..88a12db9 100644
--- a/library/libobject.mli
+++ b/library/libobject.mli
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: libobject.mli,v 1.9.8.2 2005/01/21 16:41:51 herbelin Exp $ i*)
+(*i $Id: libobject.mli 6748 2005-02-18 22:17:50Z herbelin $ i*)
 
 (*i*)
 open Names
 open Libnames
+open Mod_subst
 (*i*)
 
 (* [Libobject] declares persistent objects, given with methods:
@@ -69,6 +70,7 @@ type 'a object_declaration = {
   open_function : int -> object_name * 'a -> unit;
   classify_function : object_name * 'a -> 'a substitutivity;
   subst_function : object_name * substitution * 'a -> 'a;
+  discharge_function : object_name * 'a -> 'a option;
   export_function : 'a -> 'a option }
 
 (* The default object is a "Keep" object with empty methods. 
@@ -102,4 +104,5 @@ val open_object : int -> object_name * obj -> unit
 val subst_object : object_name * substitution * obj -> obj
 val classify_object : object_name * obj -> obj substitutivity
 val export_object : obj -> obj option
+val discharge_object : object_name * obj -> obj option
 val relax : bool -> unit
diff --git a/library/library.ml b/library/library.ml
index aaed4545..760b6f07 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: library.ml,v 1.79.2.5 2006/01/10 17:06:23 barras Exp $ *)
+(* $Id: library.ml 7732 2005-12-26 13:51:24Z herbelin $ *)
 
 open Pp
 open Util
@@ -25,30 +25,57 @@ open Declaremods
 
 type logical_path = dir_path
 
-let load_path = ref ([],[] : System.physical_path list * logical_path list)
+let load_paths = ref ([],[] : System.physical_path list * logical_path list)
 
-let get_load_path () = fst !load_path
+let get_load_paths () = fst !load_paths
+
+(* Hints to partially detects if two paths refer to the same repertory *)
+let rec remove_path_dot p = 
+  let curdir = Filename.concat Filename.current_dir_name "" in (* Unix: "./" *)
+  let n = String.length curdir in
+  if String.length p > n && String.sub p 0 n = curdir then
+    remove_path_dot (String.sub p n (String.length p - n))
+  else
+    p
+
+let strip_path p =
+  let cwd = Filename.concat (Sys.getcwd ()) "" in (* Unix: "`pwd`/" *)
+  let n = String.length cwd in
+  if String.length p > n && String.sub p 0 n = cwd then
+    remove_path_dot (String.sub p n (String.length p - n))
+  else
+    remove_path_dot p
+
+let canonical_path_name p =
+  let current = Sys.getcwd () in
+  try 
+    Sys.chdir p;
+    let p' = Sys.getcwd () in
+    Sys.chdir current;
+    p'
+  with Sys_error _ ->
+    (* We give up to find a canonical name and just simplify it... *)
+    strip_path p
 
 
 let find_logical_path phys_dir = 
-  let phys_dir = System.canonical_path_name phys_dir in
-  match list_filter2 (fun p d -> p = phys_dir) !load_path with
+  let phys_dir = canonical_path_name phys_dir in
+  match list_filter2 (fun p d -> p = phys_dir) !load_paths with
   | _,[dir] -> dir
   | _,[] -> Nameops.default_root_prefix
   | _,l -> anomaly ("Two logical paths are associated to "^phys_dir)
 
-let remove_path dir =
-  let dir = System.canonical_path_name dir in
-  load_path := list_filter2 (fun p d -> p <> dir) !load_path
+let remove_load_path dir =
+  load_paths := list_filter2 (fun p d -> p <> dir) !load_paths
 
-let add_load_path_entry (phys_path,coq_path) =
-  let phys_path = System.canonical_path_name phys_path in
-  match list_filter2 (fun p d -> p = phys_path) !load_path with
+let add_load_path (phys_path,coq_path) =
+  let phys_path = canonical_path_name phys_path in
+  match list_filter2 (fun p d -> p = phys_path) !load_paths with
   | _,[dir] ->
       if coq_path <> dir 
         (* If this is not the default -I . to coqtop *)
         && not
-        (phys_path = System.canonical_path_name Filename.current_dir_name
+        (phys_path = canonical_path_name Filename.current_dir_name
          && coq_path = Nameops.default_root_prefix)
       then
 	begin
@@ -58,19 +85,19 @@ let add_load_path_entry (phys_path,coq_path) =
 	    ^(string_of_dirpath dir)
 	    ^("\nIt is remapped to "^(string_of_dirpath coq_path)));
              flush_all ());
-	  remove_path phys_path;
-	  load_path := (phys_path::fst !load_path, coq_path::snd !load_path)
+	  remove_load_path phys_path;
+	  load_paths := (phys_path::fst !load_paths, coq_path::snd !load_paths)
 	end
   | _,[] ->
-      load_path := (phys_path :: fst !load_path, coq_path :: snd !load_path)
+      load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths)
   | _ -> anomaly ("Two logical paths are associated to "^phys_path)
 
 let physical_paths (dp,lp) = dp
 
-let load_path_of_logical_path dir =
-  fst (list_filter2 (fun p d -> d = dir) !load_path)
+let load_paths_of_dir_path dir =
+  fst (list_filter2 (fun p d -> d = dir) !load_paths)
 
-let get_full_load_path () = List.combine (fst !load_path) (snd !load_path)
+let get_full_load_paths () = List.combine (fst !load_paths) (snd !load_paths)
 
 (************************************************************************)
 (*s Modules on disk contain the following informations (after the magic 
@@ -97,7 +124,7 @@ type library_t = {
   library_imports : compilation_unit_name list;
   library_digest : Digest.t }
 
-module CompilingLibraryOrdered = 
+module LibraryOrdered = 
   struct
     type t = dir_path
     let compare d1 d2 =
@@ -105,12 +132,12 @@ module CompilingLibraryOrdered =
         (List.rev (repr_dirpath d1)) (List.rev (repr_dirpath d2))
   end
 
-module CompilingLibraryMap = Map.Make(CompilingLibraryOrdered)
+module LibraryMap = Map.Make(LibraryOrdered)
 
-(* This is a map from names to libraries *)
-let libraries_table = ref CompilingLibraryMap.empty
+(* This is a map from names to loaded libraries *)
+let libraries_table = ref LibraryMap.empty
 
-(* These are the _ordered_ lists of loaded, imported and exported libraries *)
+(* These are the _ordered_ sets of loaded, imported and exported libraries *)
 let libraries_loaded_list = ref []
 let libraries_imports_list = ref []
 let libraries_exports_list = ref []
@@ -128,7 +155,7 @@ let unfreeze (mt,mo,mi,me) =
   libraries_exports_list := me
 
 let init () =
-  libraries_table := CompilingLibraryMap.empty;
+  libraries_table := LibraryMap.empty;
   libraries_loaded_list := [];
   libraries_imports_list := [];
   libraries_exports_list := []
@@ -141,18 +168,20 @@ let _ =
       Summary.survive_module = false;
       Summary.survive_section = false }
 
-let find_library s =
-  CompilingLibraryMap.find s !libraries_table
+(* various requests to the tables *)
 
-let try_find_library s =
-  try find_library s
+let find_library dir =
+  LibraryMap.find dir !libraries_table
+
+let try_find_library dir =
+  try find_library dir
   with Not_found ->
-    error ("Unknown library " ^ (string_of_dirpath s))
+    error ("Unknown library " ^ (string_of_dirpath dir))
 
-let library_full_filename m = (find_library m).library_filename
+let library_full_filename dir = (find_library dir).library_filename
 
 let library_is_loaded dir =
-  try let _ = CompilingLibraryMap.find dir !libraries_table in true
+  try let _ = find_library dir in true
   with Not_found -> false
 
 let library_is_opened dir = 
@@ -176,7 +205,7 @@ let register_loaded_library m =
     | m'::_ as l when m'.library_name = m.library_name -> l
     | m'::l' -> m' :: aux l' in
   libraries_loaded_list := aux !libraries_loaded_list;
-  libraries_table := CompilingLibraryMap.add m.library_name m !libraries_table
+  libraries_table := LibraryMap.add m.library_name m !libraries_table
 
   (* ... while if a library is imported/exported several time, then
      only the last occurrence is really needed - though the imported
@@ -198,10 +227,8 @@ let register_open_library export m =
 (************************************************************************)
 (*s Opening libraries *)
 
-(*s [open_library s] opens a library. The library [s] and all
-  libraries needed by [s] are assumed to be already loaded. When
-  opening [s] we recursively open all the libraries needed by [s]
-  and tagged [exported]. *)
+(* [open_library export explicit m] opens library [m] if not already
+   opened _or_ if explicitly asked to be (re)opened *)
 
 let eq_lib_name m1 m2 = m1.library_name = m2.library_name
 
@@ -219,7 +246,10 @@ let open_library export explicit_libs m =
     if export then 
       libraries_exports_list := remember_last_of_each !libraries_exports_list m
 
-let open_libraries export modl = 
+(* open_libraries recursively open a list of libraries but opens only once 
+   a library that is re-exported many times *)
+
+let open_libraries export modl =
   let to_open_list = 
     List.fold_left
       (fun l m ->
@@ -261,77 +291,94 @@ let (in_import, out_import) =
 
 
 (************************************************************************)
-(*s Loading from disk to cache (preparation phase) *)
-
-let vo_magic_number7 = 07993 (* V8.0pl3 final old syntax *)
-let vo_magic_number8 = 08003 (* V8.0pl3 final new syntax *)
+(*s Low-level interning/externing of libraries to files *)
 
-let (raw_extern_library7, raw_intern_library7) =
-  System.raw_extern_intern vo_magic_number7 ".vo"
-
-let (raw_extern_library8, raw_intern_library8) =
-  System.raw_extern_intern vo_magic_number8 ".vo"
+(*s Loading from disk to cache (preparation phase) *)
 
-let raw_intern_library a =
-  if !Options.v7 then
-    try raw_intern_library7 a
-    with System.Bad_magic_number fname ->
-      let _= raw_intern_library8 a in
-      error "Inconsistent compiled files: you probably want to use Coq in new syntax and remove the option -v7 or -translate"
-  else
-    try raw_intern_library8 a
-    with System.Bad_magic_number fname ->
-      let _= raw_intern_library7 a in
-      error "Inconsistent compiled files: you probably want to use Coq in old syntax by setting options -v7 or -translate"
+let vo_magic_number = 08003 (* V8.0 final new syntax + new params in ind *)
 
-let raw_extern_library =
-  if !Options.v7 then raw_extern_library7 else raw_extern_library8
+let (raw_extern_library, raw_intern_library) =
+  System.raw_extern_intern vo_magic_number ".vo"
 
-(* cache for loaded libraries *)
-let compunit_cache = ref CompilingLibraryMap.empty
+let with_magic_number_check f a =
+  try f a
+  with System.Bad_magic_number fname ->
+    errorlabstrm "with_magic_number_check"
+    (str"file " ++ str fname ++ spc () ++ str"has bad magic number." ++
+    spc () ++ str"It is corrupted" ++ spc () ++
+    str"or was compiled with another version of Coq.")
 
-let _ = 
-  Summary.declare_summary "MODULES-CACHE"
-    { Summary.freeze_function = (fun () -> !compunit_cache);
-      Summary.unfreeze_function = (fun cu -> compunit_cache := cu);
-      Summary.init_function = 
-	(fun () -> compunit_cache := CompilingLibraryMap.empty);
-      Summary.survive_module = true;
-      Summary.survive_section = true }
-
-(*s [load_library s] loads the library [s] from the disk, and [find_library s]
-   returns the library of name [s], loading it if necessary. 
-   The boolean [doexp] specifies if we open the libraries which are declared
-   exported in the dependencies (it is [true] at the highest level;
-   then same value as for caller is reused in recursive loadings). *)
+(************************************************************************)
+(*s Locate absolute or partially qualified library names in the path *)
 
 exception LibUnmappedDir
 exception LibNotFound
 type library_location = LibLoaded | LibInPath
 
 let locate_absolute_library dir =
-  (* Look if loaded in current environment *)
-  try
-    let m = CompilingLibraryMap.find dir !libraries_table in
-    (dir, m.library_filename)
-  with Not_found ->
-  (* Look if in loadpath *)
+  (* Search in loadpath *)
+  let pref, base = split_dirpath dir in
+  let loadpath = load_paths_of_dir_path pref in
+  if loadpath = [] then raise LibUnmappedDir;
   try
-    let pref, base = split_dirpath dir in
-    let loadpath = load_path_of_logical_path pref in
-    if loadpath = [] then raise LibUnmappedDir;
     let name = (string_of_id base)^".vo" in
     let _, file = System.where_in_path loadpath name in
     (dir, file)
-  with Not_found ->  raise LibNotFound
+  with Not_found ->
+  (* Last chance, removed from the file system but still in memory *)
+  try
+    (dir, library_full_filename dir)
+  with Not_found ->
+    raise LibNotFound
 
-let with_magic_number_check f a =
-  try f a
-  with System.Bad_magic_number fname ->
-    errorlabstrm "with_magic_number_check"
-    (str"file " ++ str fname ++ spc () ++ str"has bad magic number." ++
-    spc () ++ str"It is corrupted" ++ spc () ++
-    str"or was compiled with another version of Coq.")
+let locate_qualified_library qid =
+  try
+    (* Search library in loadpath *)
+    let dir, base = repr_qualid qid in 
+    let loadpath =
+      if repr_dirpath dir = [] then get_load_paths ()
+      else 
+        (* we assume dir is an absolute dirpath *)
+	load_paths_of_dir_path dir
+    in
+    if loadpath = [] then raise LibUnmappedDir;
+    let name =  (string_of_id base)^".vo" in
+    let path, file = System.where_in_path loadpath name in
+    let dir = extend_dirpath (find_logical_path path) base in
+    (* Look if loaded *)
+    try 
+      (LibLoaded, dir, library_full_filename dir)      
+    with Not_found ->
+      (LibInPath, dir, file)
+  with Not_found -> raise LibNotFound
+
+let explain_locate_library_error qid = function
+  | LibUnmappedDir ->
+      let prefix, _ = repr_qualid qid in
+      errorlabstrm "load_absolute_library_from"
+      (str "Cannot load " ++ pr_qualid qid ++ str ":" ++ spc () ++ 
+      str "no physical path bound to" ++ spc () ++ pr_dirpath prefix ++ fnl ())
+  | LibNotFound ->
+      errorlabstrm "load_absolute_library_from"
+      (str"Cannot find library " ++ pr_qualid qid ++ str" in loadpath")
+  | e -> raise e
+
+let try_locate_absolute_library dir =
+  try
+    locate_absolute_library dir
+  with e ->
+    explain_locate_library_error (qualid_of_dirpath dir) e
+
+let try_locate_qualified_library (loc,qid) =
+  try
+    let (_,dir,f) = locate_qualified_library qid in
+    dir,f
+  with e -> 
+    explain_locate_library_error qid e
+
+
+(************************************************************************)
+(* Internalise libraries *)
 
 let lighten_library m = 
   if !Options.dont_load_proofs then lighten_library m else m
@@ -352,55 +399,35 @@ let intern_from_file f =
   close_in ch;
   mk_library md f digest
 
-let rec intern_library (dir, f) =
-  try
-    (* Look if in the current logical environment *)
-    CompilingLibraryMap.find dir !libraries_table
+let rec intern_library needed (dir, f) =
+  (* Look if in the current logical environment *)
+  try find_library dir, needed
   with Not_found ->
-  try
-    (* Look if already loaded in cache and consequently its dependencies *)
-    CompilingLibraryMap.find dir !compunit_cache
+  (* Look if already listed and consequently its dependencies too *)
+  try List.assoc dir needed, needed
   with Not_found ->
-    (* [dir] is an absolute name which matches [f] which must be in loadpath *)
-    let m = intern_from_file f in
-    if dir <> m.library_name then
-      errorlabstrm "load_physical_library"
-	(str ("The file " ^ f ^ " contains library") ++ spc () ++
-	 pr_dirpath m.library_name ++ spc () ++ str "and not library" ++
-         spc() ++ pr_dirpath dir);
-    intern_and_cache_library dir m
-
-and intern_and_cache_library dir m =
-  compunit_cache := CompilingLibraryMap.add dir m !compunit_cache;
-  try
-    List.iter (intern_mandatory_library dir) m.library_deps;
-    m
-  with e ->
-    compunit_cache := CompilingLibraryMap.remove dir !compunit_cache; 
-    raise e
+  (* [dir] is an absolute name which matches [f] which must be in loadpath *)
+  let m = intern_from_file f in
+  if dir <> m.library_name then
+    errorlabstrm "load_physical_library"
+      (str ("The file " ^ f ^ " contains library") ++ spc () ++
+       pr_dirpath m.library_name ++ spc () ++ str "and not library" ++
+       spc() ++ pr_dirpath dir);
+  m, intern_library_deps needed dir m
 
-and intern_mandatory_library caller (dir,d) =
-  let m = intern_absolute_library_from dir in
+and intern_library_deps needed dir m =
+  (dir,m)::List.fold_left (intern_mandatory_library dir) needed m.library_deps
+
+and intern_mandatory_library caller needed (dir,d) =
+  let m,needed = intern_library needed (try_locate_absolute_library dir) in
   if d <> m.library_digest then
     error ("compiled library "^(string_of_dirpath caller)^
 	   " makes inconsistent assumptions over library "
-	   ^(string_of_dirpath dir))
-
-and intern_absolute_library_from dir =
-  try
-    intern_library (locate_absolute_library dir)
-  with
-  | LibUnmappedDir ->
-      let prefix, dir = fst (split_dirpath dir), string_of_dirpath dir in
-      errorlabstrm "load_absolute_library_from"
-      (str ("Cannot load "^dir^":") ++ spc () ++ 
-      str "no physical path bound to" ++ spc () ++ pr_dirpath prefix ++ fnl ())
-  | LibNotFound ->
-      errorlabstrm "load_absolute_library_from"
-      (str"Cannot find library " ++ pr_dirpath dir ++ str" in loadpath")
-  | e -> raise e
+	   ^(string_of_dirpath dir));
+  needed
 
-let rec_intern_library mref = let _ = intern_library mref in ()
+let rec_intern_library needed mref =
+  let _,needed = intern_library needed mref in needed
 
 let check_library_short_name f dir = function
   | Some id when id <> snd (split_dirpath dir) ->
@@ -416,55 +443,18 @@ let rec_intern_by_filename_only id f =
   check_library_short_name f m.library_name id;
   (* We check no other file containing same library is loaded *)
   try
-    let m' = CompilingLibraryMap.find m.library_name !libraries_table in
+    let m' = find_library m.library_name in
     Options.if_verbose warning 
       ((string_of_dirpath m.library_name)^" is already loaded from file "^
        m'.library_filename);
-    m.library_name
+    m.library_name, []
   with Not_found ->
-    let m = intern_and_cache_library m.library_name m in
-    m.library_name
-
-let locate_qualified_library qid =
-  try
-    (* Search library in loadpath *)
-    let dir, base = repr_qualid qid in 
-    let loadpath =
-      if repr_dirpath dir = [] then get_load_path ()
-      else 
-        (* we assume dir is an absolute dirpath *)
-	load_path_of_logical_path dir
-    in
-    if loadpath = [] then raise LibUnmappedDir;
-    let name =  (string_of_id base)^".vo" in
-    let path, file = System.where_in_path loadpath name in
-    let dir = extend_dirpath (find_logical_path path) base in
-    (* Look if loaded *)
-    try 
-      (LibLoaded, dir, library_full_filename dir)      
-    with Not_found ->
-      (LibInPath, dir, file)
-  with Not_found -> raise LibNotFound
-
-let rec_intern_qualified_library (loc,qid) =
-  try
-    let (_,dir,f) = locate_qualified_library qid in
-    rec_intern_library (dir,f);
-    dir
-  with
-  | LibUnmappedDir ->
-      let prefix, id = repr_qualid qid in
-      user_err_loc (loc, "rec_intern_qualified_library",
-        str ("Cannot load "^(string_of_id id)^":") ++ spc () ++ 
-        str "no physical path bound to" ++ spc () ++ pr_dirpath prefix ++
-        fnl ())
-  | LibNotFound ->
-      user_err_loc (loc, "rec_intern_qualified_library",
-        str"Cannot find library " ++ pr_qualid qid ++ str" in loadpath")
+    let needed = intern_library_deps [] m.library_name m in
+    m.library_name, needed
 
 let rec_intern_library_from_file idopt f =
   (* A name is specified, we have to check it contains library id *)
-  let _, f = System.find_file_in_path (get_load_path ()) (f^".vo") in
+  let _, f = System.find_file_in_path (get_load_paths ()) (f^".vo") in
   rec_intern_by_filename_only idopt f
 
 (**********************************************************************)
@@ -472,8 +462,11 @@ let rec_intern_library_from_file idopt f =
     operation. It is performed as follows:
 
   preparation phase: (functions require_library* ) the library and its 
-    dependencies are read from to disk to the compunit_cache 
-    (using intern_* )
+    dependencies are read from to disk (using intern_* )
+    [they are read from disk to ensure that at section/module
+     discharging time, the physical library referred to outside the
+     section/module is the one that was used at type-checking time in
+     the section/module]
 
   execution phase: (through add_leaf and cache_require)
     the library is loaded in the environment and Nametab, the objects are 
@@ -487,117 +480,83 @@ let rec_intern_library_from_file idopt f =
 
 type library_reference = dir_path list * bool option
 
-let string_of_library (_,dir,_) = string_of_id (List.hd (repr_dirpath dir))
+let register_library (dir,m) =
+  Declaremods.register_library
+    m.library_name 
+    m.library_compiled 
+    m.library_objects 
+    m.library_digest;
+  register_loaded_library m
 
-let rec load_library dir =
-  try
-    (* Look if loaded in current env (and consequently its dependencies) *)
-    CompilingLibraryMap.find dir !libraries_table
-  with Not_found ->
-    (* [dir] is an absolute name matching [f] which must be in loadpath *)
-    let m =
-      try CompilingLibraryMap.find dir !compunit_cache
-      with Not_found ->
-        anomaly ((string_of_dirpath dir)^" should be in cache")
-    in
-    List.iter (fun (dir,_) -> ignore (load_library dir)) m.library_deps;
-    Declaremods.register_library
-      m.library_name 
-      m.library_compiled 
-      m.library_objects 
-      m.library_digest;
-    register_loaded_library m;
-    m
-
-let cache_require (_,(modl,export)) =
-  let ml = list_map_left load_library modl in
-  match export with
-    | None -> ()
-    | Some export -> open_libraries export ml
-
-let load_require  _ (_,(modl,_)) =
-  ignore(list_map_left load_library modl)
+  (* [needed] is the ordered list of libraries not already loaded *)
+let cache_require (_,(needed,modl,export)) =
+  List.iter register_library needed;
+  option_iter (fun exp -> open_libraries exp (List.map find_library modl))
+    export
+
+let load_require  _ (_,(needed,modl,_)) =
+  List.iter register_library needed
 
   (* keeps the require marker for closed section replay but removes
      OS dependent fields from .vo files for cross-platform compatibility *)
-let export_require (l,e) = Some (l,e)
+let export_require (_,l,e) = Some ([],l,e)
+
+let discharge_require (_,o) = Some o
 
 let (in_require, out_require) =
   declare_object {(default_object "REQUIRE") with
        cache_function = cache_require;
        load_function = load_require;
        export_function = export_require;
+       discharge_function = discharge_require;
        classify_function = (fun (_,o) -> Anticipate o) }
 
+(* Require libraries, import them if [export <> None], mark them for export
+   if [export = Some true] *)
+
+(* read = require without opening *)
+
 let xml_require = ref (fun d -> ())
 let set_xml_require f = xml_require := f
 
-let require_library spec qidl export =
-(*
-  if sections_are_opened () && Options.verbose () then
-    warning ("Objets of "^(string_of_library modref)^
-             " not surviving sections (e.g. Grammar \nand Hints)\n"^
-             "will be removed at the end of the section");
-*)
-  let modrefl = List.map rec_intern_qualified_library qidl in
+let require_library qidl export =
+  let modrefl = List.map try_locate_qualified_library qidl in
+  let needed = List.rev (List.fold_left rec_intern_library [] modrefl) in
+  let modrefl = List.map fst modrefl in
     if Lib.is_modtype () || Lib.is_module () then begin
-      add_anonymous_leaf (in_require (modrefl,None));
-      List.iter
-	(fun dir ->
-	   add_anonymous_leaf (in_import (dir, export)))
-	modrefl
+      add_anonymous_leaf (in_require (needed,modrefl,None));
+      option_iter (fun exp ->
+	List.iter (fun dir -> add_anonymous_leaf (in_import(dir,exp))) modrefl)
+	export
     end
     else
-      add_anonymous_leaf (in_require (modrefl,Some export));
+      add_anonymous_leaf (in_require (needed,modrefl,export));
   if !Options.xml_export then List.iter !xml_require modrefl;
   add_frozen_state ()
 
-let require_library_from_file spec idopt file export =
-  let modref = rec_intern_library_from_file idopt file in
-    if Lib.is_modtype () || Lib.is_module () then begin
-      add_anonymous_leaf (in_require ([modref],None));
-      add_anonymous_leaf (in_import (modref, export))
-    end
-    else
-      add_anonymous_leaf (in_require ([modref],Some export));
-    if !Options.xml_export then !xml_require modref;
-    add_frozen_state ()
-
-
-(* read = require without opening *)
-
-let read_library qid =
-  let modref = rec_intern_qualified_library qid in
-  add_anonymous_leaf (in_require ([modref],None));
-  if !Options.xml_export then !xml_require modref;
-  add_frozen_state ()
-
-let read_library_from_file f =
-  let _, f = System.find_file_in_path (get_load_path ()) (f^".vo") in
-  let modref = rec_intern_by_filename_only None f in
-  add_anonymous_leaf (in_require ([modref],None));
+let require_library_from_file idopt file export =
+  let modref,needed = rec_intern_library_from_file idopt file in
+  let needed = List.rev needed in
+  if Lib.is_modtype () || Lib.is_module () then begin
+    add_anonymous_leaf (in_require (needed,[modref],None));
+    option_iter (fun exp -> add_anonymous_leaf (in_import (modref,exp)))
+      export
+  end
+  else
+    add_anonymous_leaf (in_require (needed,[modref],export));
   if !Options.xml_export then !xml_require modref;
   add_frozen_state ()
 
-
-(* called at end of section *)
-
-let reload_library modrefl =
-  add_anonymous_leaf (in_require modrefl);
-  add_frozen_state ()
-
-
-
 (* the function called by Vernacentries.vernac_import *)
 
-let import_library export (loc,qid) =
+let import_module export (loc,qid) =
   try
     match Nametab.locate_module qid with
 	MPfile dir -> 
 	  if Lib.is_modtype () || Lib.is_module () || not export then
 	    add_anonymous_leaf (in_import (dir, export))
 	  else
-	    add_anonymous_leaf (in_require ([dir], Some export))
+	    add_anonymous_leaf (in_require ([],[dir], Some export))
       | mp ->
 	  import_module export mp
   with
@@ -607,27 +566,30 @@ let import_library export (loc,qid) =
 	 str ((string_of_qualid qid)^" is not a module"))
   
 (************************************************************************)
-(*s [save_library s] saves the library [m] to the disk. *)
+(*s Initializing the compilation of a library. *)
 
 let start_library f = 
   let _,longf = 
-    System.find_file_in_path (get_load_path ()) (f^".v") in
+    System.find_file_in_path (get_load_paths ()) (f^".v") in
   let ldir0 = find_logical_path (Filename.dirname longf) in
   let id = id_of_string (Filename.basename f) in
   let ldir = extend_dirpath ldir0 id in
   Declaremods.start_library ldir;
   ldir,longf
 
+(************************************************************************)
+(*s [save_library dir] ends library [dir] and save it to the disk. *)
+
 let current_deps () =
   List.map (fun m -> (m.library_name, m.library_digest)) !libraries_loaded_list
 
 let current_reexports () =
   List.map (fun m -> m.library_name) !libraries_exports_list
 
-let save_library_to s f =
-  let cenv, seg = Declaremods.end_library s in
+let save_library_to dir f =
+  let cenv, seg = Declaremods.end_library dir in
   let md = { 
-    md_name = s;
+    md_name = dir;
     md_compiled = cenv;
     md_objects = seg;
     md_deps = current_deps ();
@@ -641,33 +603,7 @@ let save_library_to s f =
     close_out ch
   with e -> (warning ("Removed file "^f');close_out ch; Sys.remove f'; raise e)
 
-(*s Pretty-printing of libraries state. *)
- 
-(* this function is not used... *)
-let fmt_libraries_state () =
-  let opened = opened_libraries ()
-  and loaded = loaded_libraries () in
-  (str "Imported (open) Modules: " ++
-     prlist_with_sep pr_spc pr_dirpath opened ++ fnl () ++
-     str "Loaded Modules: " ++
-     prlist_with_sep pr_spc pr_dirpath loaded ++ fnl ())
-
-
-(*s For tactics/commands requiring vernacular libraries *)
-
-let check_required_library d =
-  let d' = List.map id_of_string d in
-  let dir = make_dirpath (List.rev d') in
-  if not (library_is_loaded dir) then
-(* Loading silently ...
-    let m, prefix = list_sep_last d' in
-    read_library 
-     (dummy_loc,make_qualid (make_dirpath (List.rev prefix)) m)
-*)
-(* or failing ...*)
-    error ("Library "^(list_last d)^" has to be required first")
-
-
+(************************************************************************)
 (*s Display the memory use of a library. *)
 
 open Printf
diff --git a/library/library.mli b/library/library.mli
index 18be1671..f7620682 100644
--- a/library/library.mli
+++ b/library/library.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: library.mli,v 1.23.2.1 2004/07/16 19:30:36 herbelin Exp $ i*)
+(*i $Id: library.mli 6748 2005-02-18 22:17:50Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -15,65 +15,58 @@ open Libnames
 open Libobject
 (*i*)
 
-(*s This module is the heart of the library. It provides low level
-  functions to load, open and save libraries. Libraries are saved
-  onto the disk with checksums (obtained with the [Digest] module),
-  which are checked at loading time to prevent inconsistencies
-  between files written at various dates. It also provides a high
-  level function [require] which corresponds to the vernacular
-  command [Require]. *)
+(*s This module provides functions to load, open and save
+  libraries. Libraries correspond to the subclass of modules that
+  coincide with a file on disk (the ".vo" files). Libraries on the
+  disk comes with checksums (obtained with the [Digest] module), which
+  are checked at loading time to prevent inconsistencies between files
+  written at various dates.
+*)
+
+(*s Require = load in the environment + open (if the optional boolean
+    is not [None]); mark also for export if the boolean is [Some true] *)
+val require_library : qualid located list -> bool option -> unit
+val require_library_from_file :
+  identifier option -> System.physical_path -> bool option -> unit
+
+(*s Open a module (or a library); if the boolean is true then it's also
+   an export otherwise just a simple import *)
+val import_module : bool -> qualid located -> unit
 
-val read_library : qualid located -> unit
+(*s Start the compilation of a library *)
+val start_library : string -> dir_path * string
 
-val read_library_from_file : System.physical_path -> unit
+(*s End the compilation of a library and save it to a ".vo" file *)
+val save_library_to : dir_path -> string -> unit
 
-(* [import_library true qid] = [export qid] *)
- 
-val import_library : bool -> qualid located -> unit
+(*s Interrogate the status of libraries *)
 
+  (* - Tell if a library is loaded or opened *)
 val library_is_loaded : dir_path -> bool
 val library_is_opened : dir_path -> bool
 
+  (* - Tell which libraries are loaded or imported *)
 val loaded_libraries : unit -> dir_path list
 val opened_libraries : unit -> dir_path list
 
-val fmt_libraries_state : unit -> Pp.std_ppcmds
-
-(*s Require. The command [require_library spec m file export] loads and opens
-  a library [m]. [file] specifies the filename, if not [None]. [spec]
-  specifies to look for a specification ([true]) or for an implementation
-  ([false]), if not [None]. And [export] specifies if the library must be 
-  exported. *)
-
-val require_library :
-  bool option -> qualid located list -> bool -> unit
-
-val require_library_from_file :
-  bool option -> identifier option -> System.physical_path -> bool -> unit
-
-val set_xml_require : (dir_path -> unit) -> unit
-
-(*s [save_library_to s f] saves the current environment as a library [s]
-  in the file [f]. *)
-
-val start_library : string -> dir_path * string
-val save_library_to : dir_path -> string -> unit
-
-(* [library_full_filename] returns the full filename of a loaded library. *)
-
+  (* - Return the full filename of a loaded library. *)
 val library_full_filename : dir_path -> string
 
+(*s Hook for the xml exportation of libraries *)
+val set_xml_require : (dir_path -> unit) -> unit
 
-(*s Global load path *)
-type logical_path = dir_path
+(*s Global load paths: a load path is a physical path in the file
+    system; to each load path is associated a Coq [dir_path] (the "logical"
+    path of the physical path) *)
 
-val get_load_path : unit -> System.physical_path list
-val get_full_load_path : unit -> (System.physical_path * logical_path) list
-val add_load_path_entry : System.physical_path * logical_path -> unit
-val remove_path : System.physical_path -> unit
-val find_logical_path : System.physical_path -> logical_path
-val load_path_of_logical_path : dir_path -> System.physical_path list
+val get_load_paths : unit -> System.physical_path list
+val get_full_load_paths : unit -> (System.physical_path * dir_path) list
+val add_load_path : System.physical_path * dir_path -> unit
+val remove_load_path : System.physical_path -> unit
+val find_logical_path : System.physical_path -> dir_path
+val load_paths_of_dir_path : dir_path -> System.physical_path list
 
+(*s Locate a library in the load paths *)
 exception LibUnmappedDir
 exception LibNotFound
 type library_location = LibLoaded | LibInPath
@@ -81,14 +74,5 @@ type library_location = LibLoaded | LibInPath
 val locate_qualified_library :
   qualid -> library_location * dir_path * System.physical_path
 
-
-val check_required_library : string list -> unit
-
-(*s Displays the memory use of a library. *)
+(*s Statistics: display the memory use of a library. *)
 val mem : dir_path -> Pp.std_ppcmds
-
-(* For discharge *)
-type library_reference
-
-val out_require : Libobject.obj -> library_reference
-val reload_library : library_reference -> unit
diff --git a/library/nameops.ml b/library/nameops.ml
index 35b707a7..6db5f75d 100644
--- a/library/nameops.ml
+++ b/library/nameops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: nameops.ml,v 1.21.2.2 2004/10/12 10:12:31 herbelin Exp $ *)
+(* $Id: nameops.ml 6205 2004-10-12 10:13:15Z herbelin $ *)
 
 open Pp
 open Util
@@ -16,6 +16,10 @@ open Names
 
 let pr_id id = str (string_of_id id)
 
+let pr_name = function
+  | Anonymous -> str "_"
+  | Name id -> pr_id id
+
 let wildcard = id_of_string "_"
 
 (* Utilities *)
diff --git a/library/nameops.mli b/library/nameops.mli
index 71dbf040..9d1722d4 100644
--- a/library/nameops.mli
+++ b/library/nameops.mli
@@ -6,12 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: nameops.mli,v 1.12.2.3 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: nameops.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
 
 open Names
 
 (* Identifiers and names *)
 val pr_id : identifier -> Pp.std_ppcmds
+val pr_name : name -> Pp.std_ppcmds
+
 val wildcard : identifier
 
 val make_ident : string -> int option -> identifier
diff --git a/library/nametab.ml b/library/nametab.ml
index 4bd0cb3f..96280e8b 100755..100644
--- a/library/nametab.ml
+++ b/library/nametab.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: nametab.ml,v 1.48.2.2 2005/11/21 09:16:27 herbelin Exp $ *)
+(* $Id: nametab.ml 8642 2006-03-17 10:09:02Z notin $ *)
 
 open Util
 open Pp
@@ -96,7 +96,7 @@ struct
      [push_exactly] to [Exactly vis] and [push_tree] chooses the right one*)
 
   let rec push_until uname o level (current,dirmap) = function
-    | modid :: path as dir ->
+    | modid :: path ->
 	let mc = 
 	  try ModIdmap.find modid dirmap
 	  with Not_found -> (Nothing, ModIdmap.empty)
@@ -135,7 +135,7 @@ struct
 
 
 let rec push_exactly uname o level (current,dirmap) = function
-  | modid :: path as dir ->
+  | modid :: path ->
       let mc = 
 	try ModIdmap.find modid dirmap
 	with Not_found -> (Nothing, ModIdmap.empty)
diff --git a/library/nametab.mli b/library/nametab.mli
index 4cea1d40..a05b7415 100755
--- a/library/nametab.mli
+++ b/library/nametab.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: nametab.mli,v 1.43.2.3 2005/11/21 09:16:27 herbelin Exp $ i*)
+(*i $Id: nametab.mli 7596 2005-11-21 09:17:07Z herbelin $ i*)
 
 (*i*)
 open Util
diff --git a/library/states.ml b/library/states.ml
index 7a7f1e06..3bb37a4d 100644
--- a/library/states.ml
+++ b/library/states.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: states.ml,v 1.8.14.1 2004/07/16 19:30:36 herbelin Exp $ *)
+(* $Id: states.ml 6692 2005-02-06 13:03:51Z herbelin $ *)
 
 open System
 
@@ -24,7 +24,7 @@ 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_path ()) s))
+  (fun s -> set_state (raw_intern (Library.get_load_paths ()) s))
 
 (* Rollback. *)
 
diff --git a/library/states.mli b/library/states.mli
index 70018180..eff046ef 100644
--- a/library/states.mli
+++ b/library/states.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: states.mli,v 1.6.16.1 2004/07/16 19:30:36 herbelin Exp $ i*)
+(*i $Id: states.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*s States of the system. In that module, we provide functions to get
   and set the state of the whole system. Internally, it is done by
diff --git a/library/summary.ml b/library/summary.ml
index fc88350a..455ee264 100644
--- a/library/summary.ml
+++ b/library/summary.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: summary.ml,v 1.7.2.1 2004/07/16 19:30:36 herbelin Exp $ *)
+(* $Id: summary.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Util
diff --git a/library/summary.mli b/library/summary.mli
index 7e691f0b..ba527bdf 100644
--- a/library/summary.mli
+++ b/library/summary.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: summary.mli,v 1.8.2.1 2004/07/16 19:30:36 herbelin Exp $ i*)
+(*i $Id: summary.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* This module registers the declaration of global tables, which will be kept
    in synchronization during the various backtracks of the system. *)
diff --git a/man/coqdoc.1 b/man/coqdoc.1
index c325d221..4a2fddee 100644
--- a/man/coqdoc.1
+++ b/man/coqdoc.1
@@ -1,4 +1,4 @@
-.TH coqdoc 1 "February, 2002"
+.TH coqdoc 1 "December, 2005"
 
 .SH NAME
 coqdoc \- A documentation tool for the Coq proof assistant
@@ -22,12 +22,158 @@ See the Coq reference manual for documentation (url below).
 
 .SH OPTIONS
 
+.SS Overall options
+
 .TP
-.B \-h
+.BI \-h
 Help. Will give you the complete list of options accepted by coqdoc.
+.TP
+.B \-\-html
+Select a HTML output.
+.TP
+.B \-\-latex
+Select a LATEX output.
+.TP
+.B \-\-dvi
+Select a DVI output.
+.TP
+.B \-\-ps
+Select a PostScript output.
+.TP
+.B \-\-texmacs
+Select a TeXmacs output.
+.TP
+.BI \-o \ file, \-\-output \ file
+Redirect the output into the file 
+.I file.
+.TP
+.BI \-d \ dir, \ \-\-directory \ dir
+Output files into directory 
+.I dir 
+instead of current directory (option
+-d does not change the filename specified with option -o, if any).
+.TP
+.B \-s, \ \-\-short
+Do not insert titles for the files. The default behavior is to insert
+a title like ``Library Foo'' for each file.
+.TP
+.BI \-t \ string, \ \-\-title \ string
+Set the document title.
+.TP
+.B \-\-body\-only
+Suppress the header and trailer of the final document. Thus, you can
+insert the resulting document into a larger one.
+.TP
+.BI \-p \ string, \ \-\-preamble \ string
+Insert some material in the LATEX preamble, right before \\begin{document} (meaningless with -html).
+.TP
+.BI \-\-vernac\-file \ file, \ \-\-tex\-file \ file
+Considers the file `file' respectively as a .v (or .g) file or a .tex file.
+.TP
+.BI \-\-files\-from \ file
+Read file names to process in file `file' as if they were given on the
+command line. Useful for program sources splitted in several
+directories.
+.TP
+.B \-q, \ \-\-quiet
+Be quiet. Do not print anything except errors.
+.TP
+.B \-h, \ \-\-help
+Give a short summary of the options and exit.
+.TP
+.BI
+\-v, \ \-\-version
+Print the version and exit.
+
+.SS Index options
+
+Default behavior is to build an index, for the HTML output only, into
+index.html.
+
+.TP
+.B \-\-no\-index
+Do not output the index.
+.TP
+.B \-\-multi\-index
+Generate one page for each category and each letter in the index,
+together with a top page index.html.
+
+.SS Table of contents option
+ 
+.TP
+.B \-toc, \ \-\-table\-of\-contents
+Insert a table of contents. For a LATEX output, it inserts a
+\\tableofcontents at the beginning of the document. For a HTML output,
+it builds a table of contents into toc.html.
+
+.SS Hyperlinks options
+
+.TP
+.B \-\-glob\-from \ file
+Make references using Coq globalizations from file file. (Such
+globalizations are obtained with Coq option -dump-glob).
+
+.TP
+.B \-\-no\-externals
+Do not insert links to the Coq standard library.
+
+.TP
+.BI \-\-coqlib \ url
+Set base URL for the Coq standard library (default is http://coq.inria.fr/library/).
+
+.TP
+.BI -R \ dir \  coqdir
+Map physical directory dir to Coq logical directory coqdir (similarly
+to Coq option -R).
+.B Note: 
+option -R only has effect on the files following it on the command
+line, so you will probably need to put this option first.
+
+.SS Contents options
+
+.TP
+.B -g, \ --gallina
+Do not print proofs.
+
+.TP
+.B -l, \ --light
+Light mode. Suppress proofs (as with -g) and the following commands:
+
+        * [Recursive] Tactic Definition
+        * Hint / Hints
+        * Require
+        * Transparent / Opaque
+        * Implicit Argument / Implicits
+        * Section / Variable / Hypothesis / End 
+
+The behavior of options -g and -l can be locally overridden using the (* begin show *) ... (* end show *) environment (see above).
+
+.SS Language options
+ 
+Default behavior is to assume ASCII 7 bits input files.
+
+.TP 
+.B -latin1, \ --latin1
+Select ISO-8859-1 input files. It is equivalent to --inputenc latin1
+--charset iso-8859-1.
+
+.TP 
+.B -utf8, \ --utf8
+Select UTF-8 (Unicode) input files. It is equivalent to --inputenc
+utf8 --charset utf-8. LATEX UTF-8 support can be found at
+http://www.ctan.org/tex-archive/macros/latex/contrib/supported/unicode/.
+
+.TP 
+.BI --inputenc \ string
+Give a LATEX input encoding, as an option to LATEX package inputenc.
+
+.TP
+.BI --charset string
+Specify the HTML character set, to be inserted in the HTML header.
 
 
 .SH SEE ALSO
 
 .I
-The Coq web site: http://coq.inria.fr/
+The Coq Reference Manual from http://coq.inria.fr/
+
diff --git a/parsing/argextend.ml4 b/parsing/argextend.ml4
index e6d9f99d..650afe17 100644
--- a/parsing/argextend.ml4
+++ b/parsing/argextend.ml4
@@ -6,12 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: argextend.ml4,v 1.9.2.4 2005/01/15 14:56:53 herbelin Exp $ *)
+(* $Id: argextend.ml4 7739 2005-12-26 17:08:16Z herbelin $ *)
 
 open Genarg
 open Q_util
 open Q_coqast
-open Ast
 
 let join_loc (deb1,_) (_,fin2) = (deb1,fin2)
 let loc = Util.dummy_loc
@@ -25,16 +24,15 @@ let rec make_rawwit loc = function
   | PreIdentArgType -> <:expr< Genarg.rawwit_pre_ident >>
   | IntroPatternArgType -> <:expr< Genarg.rawwit_intro_pattern >>
   | IdentArgType -> <:expr< Genarg.rawwit_ident >>
-  | HypArgType -> <:expr< Genarg.rawwit_var >>
+  | VarArgType -> <:expr< Genarg.rawwit_var >>
   | RefArgType -> <:expr< Genarg.rawwit_ref >>
   | SortArgType -> <:expr< Genarg.rawwit_sort >>
   | ConstrArgType -> <:expr< Genarg.rawwit_constr >>
   | ConstrMayEvalArgType -> <:expr< Genarg.rawwit_constr_may_eval >>
   | QuantHypArgType -> <:expr< Genarg.rawwit_quant_hyp >>
-  | TacticArgType -> <:expr< Genarg.rawwit_tactic >>
+  | TacticArgType n -> <:expr< Genarg.rawwit_tactic $mlexpr_of_int n$ >>
   | RedExprArgType -> <:expr< Genarg.rawwit_red_expr >>
-  | OpenConstrArgType -> <:expr< Genarg.rawwit_open_constr >>
-  | CastedOpenConstrArgType -> <:expr< Genarg.rawwit_casted_open_constr >>
+  | OpenConstrArgType b -> <:expr< Genarg.rawwit_open_constr_gen $mlexpr_of_bool b$ >>
   | ConstrWithBindingsArgType -> <:expr< Genarg.rawwit_constr_with_bindings >>
   | BindingsArgType -> <:expr< Genarg.rawwit_bindings >>
   | List0ArgType t -> <:expr< Genarg.wit_list0 $make_rawwit loc t$ >>
@@ -52,16 +50,15 @@ let rec make_globwit loc = function
   | PreIdentArgType -> <:expr< Genarg.globwit_pre_ident >>
   | IntroPatternArgType -> <:expr< Genarg.globwit_intro_pattern >>
   | IdentArgType -> <:expr< Genarg.globwit_ident >>
-  | HypArgType -> <:expr< Genarg.globwit_var >>
+  | VarArgType -> <:expr< Genarg.globwit_var >>
   | RefArgType -> <:expr< Genarg.globwit_ref >>
   | QuantHypArgType -> <:expr< Genarg.globwit_quant_hyp >>
   | SortArgType -> <:expr< Genarg.globwit_sort >>
   | ConstrArgType -> <:expr< Genarg.globwit_constr >>
   | ConstrMayEvalArgType -> <:expr< Genarg.globwit_constr_may_eval >>
-  | TacticArgType -> <:expr< Genarg.globwit_tactic >>
+  | TacticArgType n -> <:expr< Genarg.globwit_tactic  $mlexpr_of_int n$ >>
   | RedExprArgType -> <:expr< Genarg.globwit_red_expr >>
-  | OpenConstrArgType -> <:expr< Genarg.globwit_open_constr >>
-  | CastedOpenConstrArgType -> <:expr< Genarg.globwit_casted_open_constr >>
+  | OpenConstrArgType b -> <:expr< Genarg.globwit_open_constr_gen $mlexpr_of_bool b$ >>
   | ConstrWithBindingsArgType -> <:expr< Genarg.globwit_constr_with_bindings >>
   | BindingsArgType -> <:expr< Genarg.globwit_bindings >>
   | List0ArgType t -> <:expr< Genarg.wit_list0 $make_globwit loc t$ >>
@@ -79,16 +76,15 @@ let rec make_wit loc = function
   | PreIdentArgType -> <:expr< Genarg.wit_pre_ident >>
   | IntroPatternArgType -> <:expr< Genarg.wit_intro_pattern >>
   | IdentArgType -> <:expr< Genarg.wit_ident >>
-  | HypArgType -> <:expr< Genarg.wit_var >>
+  | VarArgType -> <:expr< Genarg.wit_var >>
   | RefArgType -> <:expr< Genarg.wit_ref >>
   | QuantHypArgType -> <:expr< Genarg.wit_quant_hyp >>
   | SortArgType -> <:expr< Genarg.wit_sort >>
   | ConstrArgType -> <:expr< Genarg.wit_constr >>
   | ConstrMayEvalArgType -> <:expr< Genarg.wit_constr_may_eval >>
-  | TacticArgType -> <:expr< Genarg.wit_tactic >>
+  | TacticArgType n -> <:expr< Genarg.wit_tactic $mlexpr_of_int n$ >>
   | RedExprArgType -> <:expr< Genarg.wit_red_expr >>
-  | OpenConstrArgType -> <:expr< Genarg.wit_open_constr >>
-  | CastedOpenConstrArgType -> <:expr< Genarg.wit_casted_open_constr >>
+  | OpenConstrArgType b -> <:expr< Genarg.wit_open_constr_gen $mlexpr_of_bool b$ >>
   | ConstrWithBindingsArgType -> <:expr< Genarg.wit_constr_with_bindings >>
   | BindingsArgType -> <:expr< Genarg.wit_bindings >>
   | List0ArgType t -> <:expr< Genarg.wit_list0 $make_wit loc t$ >>
@@ -105,7 +101,8 @@ let make_act loc act pil =
     | Some (p, t) :: tl ->
 	<:expr<
           Gramext.action 
-            (fun $lid:p$ -> let _ = in_gen $make_rawwit loc t$ $lid:p$ in $make tl$)
+            (fun $lid:p$ ->
+               let _ = Genarg.in_gen $make_rawwit loc t$ $lid:p$ in $make tl$)
         >> in
   make (List.rev pil)
 
@@ -113,22 +110,34 @@ let make_rule loc (prods,act) =
   let (symbs,pil) = List.split prods in
   <:expr< ($mlexpr_of_list (fun x -> x) symbs$,$make_act loc act pil$) >>
 
-let declare_tactic_argument for_v8 loc s typ pr f g h rawtyppr globtyppr cl =
-  let interp = match f with
-    | None -> <:expr< Tacinterp.interp_genarg >>
-    | Some f -> <:expr< $lid:f$>> in
-  let glob = match g with
-    | None -> <:expr< Tacinterp.intern_genarg >>
-    | Some f -> <:expr< $lid:f$>> in
-  let substitute = match h with
-    | None -> <:expr< Tacinterp.subst_genarg >>
-    | Some f -> <:expr< $lid:f$>> in
+let declare_tactic_argument loc s typ pr f g h rawtyppr globtyppr cl =
   let rawtyp, rawpr = match rawtyppr with
     | None -> typ,pr
     | Some (t,p) -> t,p in
   let globtyp, globpr = match globtyppr with
     | None -> typ,pr
     | Some (t,p) -> t,p in
+  let glob = match g with
+    | None ->
+	<:expr< fun e x ->
+          out_gen $make_globwit loc typ$
+            (Tacinterp.intern_genarg e
+               (Genarg.in_gen $make_rawwit loc rawtyp$ x)) >>
+    | Some f -> <:expr< $lid:f$>> in
+  let interp = match f with
+    | None -> 
+	<:expr< fun ist gl x ->
+          out_gen $make_wit loc typ$
+            (Tacinterp.interp_genarg ist gl
+               (Genarg.in_gen $make_globwit loc globtyp$ x)) >>
+    | Some f -> <:expr< $lid:f$>> in
+  let substitute = match h with
+    | None -> 
+	<:expr< fun s x ->
+          out_gen $make_globwit loc globtyp$
+	    (Tacinterp.subst_genarg s
+               (Genarg.in_gen $make_globwit loc globtyp$ x)) >>
+    | Some f -> <:expr< $lid:f$>> in
   let se = mlexpr_of_string s in
   let wit = <:expr< $lid:"wit_"^s$ >> in
   let rawwit = <:expr< $lid:"rawwit_"^s$ >> in
@@ -141,36 +150,22 @@ let declare_tactic_argument for_v8 loc s typ pr f g h rawtyppr globtyppr cl =
       value $lid:s$ = Pcoq.create_generic_entry $se$ $rawwit$;
       Tacinterp.add_interp_genarg $se$
         ((fun e x ->
-          (in_gen $globwit$
-             (out_gen $make_globwit loc typ$
-          	($glob$ e
-         	  (in_gen $make_rawwit loc rawtyp$
-	             (out_gen $rawwit$ x)))))),
+          (Genarg.in_gen $globwit$ ($glob$ e (out_gen $rawwit$ x)))),
         (fun ist gl x ->
-          (in_gen $wit$
-             (out_gen $make_wit loc typ$
-          	($interp$ ist gl
-         	  (in_gen $make_globwit loc rawtyp$
-	             (out_gen $globwit$ x)))))),
+          (Genarg.in_gen $wit$ ($interp$ ist gl (out_gen $globwit$ x)))),
         (fun subst x ->
-          (in_gen $globwit$
-             (out_gen $make_globwit loc typ$
-          	($substitute$ subst
-         	  (in_gen $make_globwit loc rawtyp$
-	             (out_gen $globwit$ x)))))));
+          (Genarg.in_gen $globwit$ ($substitute$ subst (out_gen $globwit$ x)))));
       Pcoq.Gram.extend ($lid:s$ : Pcoq.Gram.Entry.e 'a) None 
         [(None, None, $rules$)];
       Pptactic.declare_extra_genarg_pprule
-        $mlexpr_of_bool for_v8$
         ($rawwit$, $lid:rawpr$)
         ($globwit$, $lid:globpr$)
         ($wit$, $lid:pr$);
     end
   >>
 
-let declare_vernac_argument for_v8 loc s cl =
+let declare_vernac_argument loc s cl =
   let se = mlexpr_of_string s in
-  let typ = ExtraArgType s in
   let rawwit = <:expr< $lid:"rawwit_"^s$ >> in
   let rules = mlexpr_of_list (make_rule loc) (List.rev cl) in
   <:str_item<
@@ -238,40 +233,17 @@ EXTEND
         "END" ->
 	  if String.capitalize s = s then
 	    failwith "Argument entry names must be lowercase";
-         declare_tactic_argument true loc s typ pr f g h rawtyppr globtyppr l
+         declare_tactic_argument loc s typ pr f g h rawtyppr globtyppr l
       | "VERNAC"; "ARGUMENT"; "EXTEND"; s = [ UIDENT | LIDENT ];
         OPT "|"; l = LIST1 argrule SEP "|";
         "END" ->
 	  if String.capitalize s = s then
 	    failwith "Argument entry names must be lowercase";
-         declare_vernac_argument true loc s l
-      | "V7"; "ARGUMENT"; "EXTEND"; s = [ UIDENT | LIDENT ];
-        "TYPED"; "AS"; typ = argtype;
-        "PRINTED"; "BY"; pr = LIDENT;
-        f = OPT [ "INTERPRETED"; "BY"; f = LIDENT -> f ];
-        g = OPT [ "GLOBALIZED"; "BY"; f = LIDENT -> f ];
-        h = OPT [ "SUBSTITUTED"; "BY"; f = LIDENT -> f ];
-        rawtyppr =
-          OPT [ "GLOB_TYPED"; "AS"; t = argtype; 
-                "GLOB_PRINTED"; "BY"; pr = LIDENT -> (t,pr) ];
-        globtyppr =
-          OPT [ "GLOB_TYPED"; "AS"; t = argtype; 
-                "GLOB_PRINTED"; "BY"; pr = LIDENT -> (t,pr) ];
-        OPT "|"; l = LIST1 argrule SEP "|";
-        "END" ->
-	  if String.capitalize s = s then
-	    failwith "Argument entry names must be lowercase";
-         declare_tactic_argument false loc s typ pr f g h rawtyppr globtyppr l
-      | "V7"; "VERNAC"; "ARGUMENT"; "EXTEND"; s = [ UIDENT | LIDENT ];
-        OPT "|"; l = LIST1 argrule SEP "|";
-        "END" ->
-	  if String.capitalize s = s then
-	    failwith "Argument entry names must be lowercase";
-         declare_vernac_argument false loc s l ] ]
+         declare_vernac_argument loc s l ] ]
   ;
   argtype:
-    [ "2" RIGHTA
-      [ e1 = argtype; "*"; e2 = NEXT -> PairArgType (e1, e2) ]
+    [ "2" 
+      [ e1 = argtype; "*"; e2 = argtype -> PairArgType (e1, e2) ]
     | "1"
       [ e = argtype; LIDENT "list" -> List0ArgType e
       | e = argtype; LIDENT "option" -> OptArgType e ]
@@ -288,7 +260,8 @@ EXTEND
       | s = STRING ->
 	  if String.length s > 0 && Util.is_letter s.[0] then
 	    Pcoq.lexer.Token.using ("", s);
-        (<:expr< (Gramext.Stoken (Extend.terminal $str:s$)) >>, None)
+        (<:expr< (Gramext.Stoken (Lexer.terminal $str:s$)) >>, None)
     ] ]
   ;
   END
+
diff --git a/parsing/ast.ml b/parsing/ast.ml
deleted file mode 100755
index b2a30f9c..00000000
--- a/parsing/ast.ml
+++ /dev/null
@@ -1,600 +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        *)
-(************************************************************************)
-
-(* $Id: ast.ml,v 1.29.2.1 2004/07/16 19:30:37 herbelin Exp $ *)
-
-open Pp
-open Util
-open Names
-open Libnames
-open Coqast
-open Topconstr
-open Genarg
-
-let isMeta s = String.length s <> 0 & s.[0]='$'
-
-let loc = function
-  | Node (loc,_,_) -> loc
-  | Nvar (loc,_) -> loc
-  | Nmeta (loc,_) -> loc
-  | Slam (loc,_,_) -> loc
-  | Smetalam (loc,_,_) -> loc
-  | Num (loc,_) -> loc
-  | Id (loc,_) -> loc
-  | Str (loc,_) -> loc
-  | Path (loc,_) -> loc
-  | Dynamic (loc,_) -> loc
-
-(* patterns of ast *)
-type astpat =
-  | Pquote of t
-  | Pmeta of string * tok_kind
-  | Pnode of string * patlist
-  | Pslam of identifier option * astpat
-  | Pmeta_slam of string * astpat
-
-and patlist =
-  | Pcons of astpat * patlist
-  | Plmeta of string
-  | Pnil
-
-and tok_kind = Tnum | Tid | Tstr | Tpath | Tvar | Tany | Tlist
-
-type pat =
-  | AstListPat of patlist
-  | PureAstPat of astpat
-
-(* building a node with dummy location *)
-
-let ope(op,l) = Node(dummy_loc,op,l)
-let slam(idl,b) = Slam(dummy_loc,idl,b)
-let ide s = Id(dummy_loc,s)
-let nvar s = Nvar(dummy_loc,s)
-let num n = Num(dummy_loc,n)
-let string s = Str(dummy_loc,s)
-let path sl = Path(dummy_loc,sl)
-let dynamic d = Dynamic(dummy_loc,d)
-
-let rec set_loc loc = function
-  | Node(_,op,al) -> Node(loc, op, List.map (set_loc loc) al)
-  | Slam(_,idl,b) -> Slam(loc,idl, set_loc loc b)
-  | Smetalam(_,idl,b) -> Smetalam(loc,idl, set_loc loc b)
-  | Nvar(_,s) -> Nvar(loc,s)
-  | Nmeta(_,s) -> Nmeta(loc,s)
-  | Id(_,s) -> Id(loc,s)
-  | Str(_,s) -> Str(loc,s)
-  | Num(_,s) -> Num(loc,s)
-  | Path(_,sl) -> Path(loc,sl)
-  | Dynamic(_,d) -> Dynamic(loc,d)
-
-let path_section loc sp = Coqast.Path(loc, sp)
-
-let section_path sp = sp
-
-(* ast destructors *)
-let num_of_ast = function
-  | Num(_,n) -> n
-  | ast -> invalid_arg_loc (loc ast, "Ast.num_of_ast")
-
-let nvar_of_ast = function
-  | Nvar(_,s) -> s
-  | ast -> invalid_arg_loc (loc ast, "Ast.nvar_of_ast")
-
-let meta_of_ast = function
-  | Nmeta(_,s) -> s
-  | ast -> invalid_arg_loc (loc ast, "Ast.nvar_of_ast")
-
-let id_of_ast =  function
-  | Id(_,s) -> s
-  | ast -> invalid_arg_loc (loc ast, "Ast.nvar_of_ast")
-
-(* semantic actions of grammar rules *)
-type act =
-  | Act of constr_expr
-  | ActCase of act * (pat * act) list
-  | ActCaseList of act * (pat * act) list
-
-(* values associated to variables *)
-(*
-type typed_ast =
-  | AstListNode of Coqast.t list
-  | PureAstNode of Coqast.t
-*)
-type typed_ast =
-  | AstListNode of Coqast.t list
-  | PureAstNode of Coqast.t
-
-type ast_action_type = ETast | ETastl
-
-type dynamic_grammar =
-  | ConstrNode of constr_expr
-  | CasesPatternNode of cases_pattern_expr
-
-type grammar_action =
-  | SimpleAction of loc * dynamic_grammar
-  | CaseAction of
-      loc * grammar_action * ast_action_type * (t list * grammar_action) list
-
-type env = (string * typed_ast) list
-
-let string_of_dirpath = function
-  | [] -> "<empty>"
-  | sl ->
-      String.concat "." (List.map string_of_id (List.rev sl))
-
-let pr_id id = str (string_of_id id)
-
-let print_kn kn =
-  let (mp,dp,l) = repr_kn kn in
-  let dpl = repr_dirpath dp in
-  str (string_of_mp mp) ++ str "." ++
-  prlist_with_sep (fun _ -> str".") pr_id dpl ++
-  str (string_of_label l)
-
-(* Pretty-printing *)
-let rec print_ast ast =
-  match ast with
-    | Num(_,n) -> int n
-    | Str(_,s) -> qs s
-    | Path(_,sl) -> print_kn sl
-    | Id (_,s) -> str "{" ++ str s ++ str "}"
-    | Nvar(_,s) -> pr_id s
-    | Nmeta(_,s) -> str s
-    | Node(_,op,l) ->
-        hov 3 (str "(" ++ str op ++ spc () ++ print_astl l ++ str ")")
-    | Slam(_,None,ast) -> hov 1 (str "[<>]" ++ print_ast ast)
-    | Slam(_,Some x,ast) ->
-        hov 1
-          (str "[" ++ pr_id x ++ str "]" ++ cut () ++ 
-	   print_ast ast)
-    | Smetalam(_,id,ast) -> hov 1 (str id ++ print_ast ast)
-    | Dynamic(_,d) ->
-	hov 0 (str "<dynamic: " ++ str (Dyn.tag d) ++ str ">")
-
-and print_astl astl =
-  prlist_with_sep pr_spc print_ast astl
-
-let print_ast_cast = function
-  | Tany -> (mt ())
-  | Tvar -> (str":var")
-  | Tid -> (str":id")
-  | Tstr -> (str":str")
-  | Tpath -> (str":path")
-  | Tnum -> (str":num")
-  | Tlist -> (str":list")
-
-let rec print_astpat = function
-  | Pquote ast -> 
-      str"'" ++ print_ast ast 
-  | Pmeta(s,tk) -> 
-      str s ++ print_ast_cast tk 
-  | Pmeta_slam(s,b) ->
-      hov 1 (str "[" ++ str s ++ str"]" ++ cut () ++ print_astpat b)
-  | Pnode(op,al) ->
-      hov 2 (str"("  ++ str op ++ spc () ++ print_astlpat al ++ str")" )
-  | Pslam(None,b) -> 
-      hov 1 (str"[<" ++ cut () ++ print_astpat b)
-  | Pslam(Some id,b) ->
-      hov 1
-        (str"[" ++ str(string_of_id id) ++ str"]" ++ cut () ++ print_astpat b)
-
-and print_astlpat = function
-  | Pnil -> mt ()
-  | Pcons(h,Pnil) -> hov 1 (print_astpat h)
-  | Pcons(h,t) -> hov 1 (print_astpat h ++ spc () ++ print_astlpat t)
-  | Plmeta(s) -> str"| " ++ str s
-
-
-let print_val = function
-  | PureAstNode a -> print_ast a
-  | AstListNode al -> 
-      hov 1 (str"[" ++ prlist_with_sep pr_spc print_ast al ++ str"]")
-
-(* Ast values environments *)
-
-let grammar_type_error (loc,s) =
-  anomaly_loc (loc,s,(str"grammar type error: " ++ str s))
-
-
-(* Coercions enforced by the user *)
-let check_cast loc a k =
-  match (k,a) with
-    | (Tany, _) -> ()
-    | (Tid, Id _) -> ()
-    | (Tvar, Nvar _) -> ()
-    | (Tpath, Path _) -> ()
-    | (Tstr, Str _) -> ()
-    | (Tnum, Num _) -> ()
-    | (Tlist, _) -> grammar_type_error (loc,"Ast.cast_val")
-    | _ -> user_err_loc (loc,"Ast.cast_val",
-                         (str"cast _" ++ print_ast_cast k ++ str"failed"))
-
-let rec coerce_to_var = function
-  | Nvar(_,id) as var -> var
-  | Nmeta(_,id) as var -> var
-  | Node(_,"QUALID",[Nvar(_,id) as var]) -> var
-  | ast -> user_err_loc
-        (loc ast,"Ast.coerce_to_var",
-         (str"This expression should be a simple identifier"))
-
-let coerce_to_id_ast a = match coerce_to_var a with
-  | Nvar (_,id) -> id
-  | ast -> user_err_loc
-        (loc ast,"Ast.coerce_to_id",
-         str"This expression should be a simple identifier")
-
-let coerce_to_id = function
-  | CRef (Ident (loc,id)) -> (loc,id)
-  | a -> user_err_loc
-        (constr_loc a,"Ast.coerce_to_id",
-         str"This expression should be a simple identifier")
-
-let coerce_reference_to_id = function
-  | Ident (_,id) -> id
-  | Qualid (loc,_) ->
-      user_err_loc (loc, "Ast.coerce_reference_to_id",
-        str"This expression should be a simple identifier")
-
-let coerce_global_to_id = coerce_reference_to_id
-
-(* Pattern-matching on ast *)
-
-let env_assoc_value loc v env =
-  try 
-    List.assoc v env
-  with Not_found -> 
-    anomaly_loc
-      (loc,"Ast.env_assoc_value",
-       (str"metavariable " ++ str v ++ str" is unbound"))
-
-let env_assoc_list sigma (loc,v) =
-  match env_assoc_value loc v sigma with
-    | AstListNode al -> al
-    | PureAstNode a -> [a]
-
-let env_assoc sigma k (loc,v) =
-  match env_assoc_value loc v sigma with
-    | PureAstNode a -> check_cast loc a k; a
-    | _ -> grammar_type_error (loc,"Ast.env_assoc: "^v^" is an ast list")
-
-let env_assoc_nvars sigma (dloc,v) =
-  match env_assoc_value dloc v sigma with
-    | AstListNode al -> List.map coerce_to_id_ast al
-    | PureAstNode ast -> [coerce_to_id_ast ast]
-
-let build_lams dloc idl ast =
-  List.fold_right (fun id lam -> Slam(dloc,Some id,lam)) idl ast
-
-(* Alpha-conversion *)
-	  
-let rec alpha_var id1 id2 = function
-  | (i1,i2)::_ when i1=id1 -> i2 = id2
-  | (i1,i2)::_ when i2=id2 -> i1 = id1
-  | _::idl -> alpha_var id1 id2 idl
-  | [] -> id1 = id2
-
-let rec alpha alp a1 a2 =
-  match (a1,a2) with
-    | (Node(_,op1,tl1),Node(_,op2,tl2)) ->
-        (op1 = op2) & (List.length tl1 = List.length tl2)
-        & (List.for_all2 (alpha alp) tl1 tl2)
-    | (Nvar(_,id1),Nvar(_,id2)) -> alpha_var id1 id2 alp
-    | (Slam(_,None,body1),Slam(_,None,body2)) -> alpha alp body1 body2
-    | (Slam(_,Some s1,body1),Slam(_,Some s2,body2)) ->
-        alpha ((s1,s2)::alp) body1 body2
-    | (Id(_,s1),Id(_,s2)) -> s1=s2
-    | (Str(_,s1),Str(_,s2)) -> s1=s2
-    | (Num(_,n1),Num(_,n2)) -> n1=n2
-    | (Path(_,sl1),Path(_,sl2)) -> sl1=sl2
-    | ((Smetalam _ | Nmeta _ | Dynamic _), _) -> false
-    | (_, (Smetalam _ | Nmeta _ | Dynamic _)) -> false
-    | _ -> false
-
-let alpha_eq (a1,a2)= alpha [] a1 a2
-
-let alpha_eq_val (x,y) = x = y
-(*
-let alpha_eq_val = function
-  | (Vast a1, Vast a2) -> alpha_eq (a1,a2)
-  | (Vastlist al1, Vastlist al2) ->
-      (List.length al1 = List.length al2)
-      & List.for_all2 (fun x y -> alpha_eq (x,y)) al1 al2
-  | _ ->  false
-*)
-
-exception No_match of string
-
-let no_match_loc (loc,s) = Stdpp.raise_with_loc loc (No_match s)
-
-(* Binds value v to variable var. If var is already bound, checks if
-   its value is alpha convertible with v. This allows non-linear patterns.
-
-   Important note: The Metavariable $_ is a special case; it cannot be
-   bound, which is like _ in the ML matching. *)
-
-let bind_env sigma var v =
-  if var = "$_" then 
-    sigma
-  else
-    try
-      let vvar = List.assoc var sigma in
-      if alpha_eq_val (v,vvar) then sigma
-      else raise (No_match "Ast.bind_env: values do not match")
-    with Not_found -> 
-      (var,v)::sigma
-
-let bind_env_ast sigma var ast =
-  try 
-    bind_env sigma var (PureAstNode ast)
-  with e -> 
-    Stdpp.raise_with_loc (loc ast) e
-
-let alpha_define sigma loc ps s =
-  try 
-    let _ = List.assoc ps sigma in sigma
-  with Not_found ->
-    if ps = "$_" then sigma else (ps, PureAstNode(Nvar(loc,s)))::sigma
-
-
-(* Match an ast with an ast pattern. Returns the new environnement. *)
-
-let rec amatch alp sigma spat ast =
-  match (spat,ast) with
-    | (Pquote a, _) ->
-        if alpha alp a ast then 
-	  sigma
-        else 
-	  no_match_loc (loc ast,"quote does not match")
-    | (Pmeta(pv,Tany), _) -> bind_env_ast sigma pv ast
-    | (Pmeta(pv,Tvar), Nvar _) -> bind_env_ast sigma pv ast
-    | (Pmeta(pv,Tid), Id _) -> bind_env_ast sigma pv ast
-    | (Pmeta(pv,Tnum), Num _) -> bind_env_ast sigma pv ast
-    | (Pmeta(pv,Tstr), Str _) -> bind_env_ast sigma pv ast
-    | (Pmeta(pv,Tpath), Path _) -> bind_env_ast sigma pv ast
-    | (Pmeta(pv,Tlist),_) -> grammar_type_error (loc ast,"Ast.amatch")
-    | (Pmeta_slam(pv,pb), Slam(loc, Some s, b)) ->
-        amatch alp (bind_env_ast sigma pv (Nvar(loc,s))) pb b
-    | (Pmeta_slam(pv,pb), Slam(loc, None, b)) ->
-        amatch alp (bind_env_ast sigma pv (Nvar(loc,id_of_string "_"))) pb b
-    | (Pmeta_slam(pv,pb), Smetalam(loc, s, b)) ->
-	anomaly "amatch: match a pattern with an open ast"
-    | (Pnode(nodp,argp), Node(loc,op,args)) when nodp = op ->
-        (try amatchl alp sigma argp args
-         with e -> Stdpp.raise_with_loc loc e)
-    | (Pslam(None,bp), Slam(_,None,b)) -> amatch alp sigma bp b
-    | (Pslam(Some ps,bp), Slam(_,Some s,b)) -> amatch ((ps,s)::alp) sigma bp b
-    | _ -> no_match_loc (loc ast, "Ast.amatch")
-
-and amatchl alp sigma spatl astl =
-  match (spatl,astl) with
-    | (Pnil, []) -> sigma
-    | (Pcons(pat,patl), ast::asttl) ->
-        amatchl alp (amatch alp sigma pat ast) patl asttl
-    | (Plmeta pv, _) -> bind_env sigma pv (AstListNode astl)
-    | _ -> raise (No_match "Ast.amatchl")
-
-let ast_match = amatch []
-
-let typed_ast_match env p a = match (p,a) with
-  | PureAstPat p, PureAstNode a -> amatch [] env p a
-  | AstListPat pl, AstListNode al -> amatchl [] env pl al
-  | _ -> failwith "Ast.typed_ast_match: TODO"
-
-let astl_match = amatchl []
-
-let first_match pat_of_fun env ast sl =
-  let rec aux = function
-    | [] -> None
-    | h::t ->
-        (try Some (h, ast_match env (pat_of_fun h) ast)
-         with (No_match _| Stdpp.Exc_located (_,No_match _)) -> aux t)
-  in 
-  aux sl
-
-let find_all_matches pat_of_fun env ast sl =
-  let rec aux = function
-    | [] -> []
-    | (h::t) ->
-        let l = aux t in
-        (try (h, ast_match env (pat_of_fun h) ast)::l
-         with (No_match _| Stdpp.Exc_located (_,No_match _)) -> l)
-  in 
-  aux sl
-
-let first_matchl patl_of_fun env astl sl =
-  let rec aux = function
-    | [] -> None
-    | (h::t) ->
-        (try Some (h, astl_match env (patl_of_fun h) astl)
-         with (No_match _| Stdpp.Exc_located (_,No_match _)) -> aux t)
-  in 
-  aux sl
-    
-let bind_patvar env loc v etyp =
-  try
-    if List.assoc v env = etyp then 
-      env
-    else 
-      user_err_loc
-	(loc,"Ast.bind_patvar",
-	 (str"variable " ++ str v ++
-            str" is bound several times with different types"))
-  with Not_found -> 
-    if v="$_" then env else (v,etyp)::env
-      
-let make_astvar env loc v cast =
-  let env' = bind_patvar env loc v ETast in
-  (Pmeta(v,cast), env')
-
-(* Note: no metavar in operator position. necessary ? *)
-let rec pat_of_ast env ast =
-  match ast with
-    | Nmeta(loc,pv) -> make_astvar env loc pv Tany
-(* Obsolète
-    | Id(loc,pv) when isMeta pv -> make_astvar env loc pv Tid
-*)
-    | Smetalam(loc,s,a) ->
-        let senv = bind_patvar env loc s ETast in
-        let (pa,env') = pat_of_ast senv a in
-        (Pmeta_slam(s, pa), env')
-    | Node(_,"$VAR",[Nmeta(loc,pv)]) ->
-        make_astvar env loc pv Tvar
-    | Node(_,"$ID",[Nmeta(loc,pv)]) ->
-        make_astvar env loc pv Tid
-    | Node(_,"$NUM",[Nmeta(loc,pv)]) ->
-        make_astvar env loc pv Tnum
-    | Node(_,"$STR",[Nmeta(loc,pv)]) ->
-        make_astvar env loc pv Tstr
-    | Node(_,"$PATH",[Nmeta(loc,pv)]) ->
-        make_astvar env loc pv Tpath
-    | Node(_,"$QUOTE",[qast]) -> (Pquote (set_loc dummy_loc qast), env)
-
-   (* This may occur when the meta is not textual but bound by coerce_to_id*)
-    | Slam(loc,Some id,b) when isMeta (string_of_id id) ->
-	let s = string_of_id id in
-        let senv = bind_patvar env loc s ETast in
-        let (pb,env') = pat_of_ast senv b in
-        (Pmeta_slam(s, pb), env')
-
-    | Slam(_,os,b) ->
-        let (pb,env') = pat_of_ast env b in
-        (Pslam(os,pb), env')
-    | Node(loc,op,_) when isMeta op ->
-        user_err_loc(loc,"Ast.pat_of_ast",
-                     (str"no patvar in operator position."))
-    | Node(_,op,args) ->
-        let (pargs, env') = patl_of_astl env args in
-        (Pnode(op,pargs), env')
-(* Compatibility with new parsing mode *)
-    | Nvar(loc,id) when (string_of_id id).[0] = '$' -> make_astvar env loc (string_of_id id) Tany
-    | (Path _|Num _|Id _|Str _ |Nvar _) -> (Pquote (set_loc dummy_loc ast), env)
-    | Dynamic(loc,_) ->
-        invalid_arg_loc(loc,"pat_of_ast: dynamic")
-	  
-and patl_of_astl env astl =
-  match astl with
-    | [Node(_,"$LIST",[Nmeta(loc,pv)])] ->
-        let penv = bind_patvar env loc pv ETastl in
-        (Plmeta pv, penv)
-    | [] -> (Pnil,env)
-    | ast::asttl ->
-        let (p1,env1) = pat_of_ast env ast in
-        let (ptl,env2) = patl_of_astl env1 asttl in
-        (Pcons (p1,ptl), env2)
-
-type entry_env = (string * ast_action_type) list
-	
-let to_pat = pat_of_ast
-
-(* Substitution *)
-
-(* Locations in quoted ast are wrong (they refer to the right hand
-   side of a grammar rule). A default location dloc is used whenever
-   we create an ast constructor. Locations in the binding list are trusted. *)
-
-(* For old ast printer *)
-let rec pat_sub dloc sigma pat =
-  match pat with
-    | Pmeta(pv,c) -> env_assoc sigma c (dloc,pv) 
-    | Pmeta_slam(pv,p) ->
-        let idl = env_assoc_nvars sigma (dloc,pv) in
-        build_lams dloc idl (pat_sub dloc sigma p)
-    | Pquote a -> set_loc dloc a
-    | Pnode(op,pl) -> Node(dloc, op, patl_sub dloc sigma pl)
-    | Pslam(os,p) -> Slam(dloc, os, pat_sub dloc sigma p)
-	  
-and patl_sub dloc sigma pl =
-  match pl with
-    | Pnil -> 
-	[]
-    | Plmeta pv -> 
-	env_assoc_list sigma (dloc,pv)
-    | Pcons(Pmeta(pv,Tlist), ptl) ->
-        (env_assoc_list sigma (dloc,pv))@(patl_sub dloc sigma ptl)
-    | Pcons(p1,ptl) -> 
-	(pat_sub dloc sigma p1)::(patl_sub dloc sigma ptl)
-
-(* Converting and checking free meta-variables *)
-
-(* For old ast printer *)
-let type_of_meta env loc pv =
-  try 
-    List.assoc pv env
-  with Not_found ->
-    user_err_loc (loc,"Ast.type_of_meta",
-                  (str"variable " ++ str pv ++ str" is unbound"))
-
-(* For old ast printer *)
-let check_ast_meta env loc pv =
-  match type_of_meta env loc pv with
-    | ETast -> ()
-    | _ ->
-	user_err_loc (loc,"Ast.check_ast_meta",
-                      (str"variable " ++ str pv ++ str" is not of ast type"))
-
-(* For old ast printer *)
-let rec val_of_ast env = function
-  | Nmeta(loc,pv) -> 
-      check_ast_meta env loc pv;
-      Pmeta(pv,Tany)
-  | Node(_,"$QUOTE",[qast]) -> Pquote (set_loc dummy_loc qast)
-  | Smetalam(loc,s,a) ->
-    let _ = type_of_meta env loc s in (* ids are coerced to id lists *)
-    Pmeta_slam(s, val_of_ast env a)
-  | (Path _|Num _|Id _|Str _|Nvar _ as ast) -> Pquote (set_loc dummy_loc ast)
-  | Slam(_,os,b) -> Pslam(os, val_of_ast env b)
-  | Node(loc,op,_) when isMeta op ->
-      user_err_loc(loc,"Ast.val_of_ast",
-                   (str"no patvar in operator position."))
-  | Node(_,op,args) -> Pnode(op, vall_of_astl env args)
-  | Dynamic(loc,_) ->
-      invalid_arg_loc(loc,"val_of_ast: dynamic")
-	  
-and vall_of_astl env = function
-  | (Node(loc,"$LIST",[Nmeta(locv,pv)]))::asttl ->
-      if type_of_meta env locv pv = ETastl then
-	if asttl = [] then 
-	  Plmeta pv
-	else 
-	  Pcons(Pmeta(pv,Tlist), vall_of_astl env asttl)
-      else
-	user_err_loc
-	  (loc,"Ast.vall_of_astl",
-	    str"variable " ++ str pv ++ str" is not a List")
-  | ast::asttl -> Pcons (val_of_ast env ast, vall_of_astl env asttl)
-  | [] -> Pnil
-
-(* For old ast printer *)
-let rec occur_var_ast s = function
-  | Node(_,"QUALID",_::_::_) -> false
-  | Node(_,"QUALID",[Nvar(_,s2)]) -> s = s2
-  | Nvar(_,s2) -> s = s2
-  | Node(loc,op,args) -> List.exists (occur_var_ast s) args
-  | Smetalam _ | Nmeta _ -> anomaly "occur_var: metas should not occur here"
-  | Slam(_,sopt,body) -> (Some s <> sopt) & occur_var_ast s body
-  | Id _ | Str _ | Num _ | Path _ -> false
-  | Dynamic _ -> (* Hum... what to do here *) false
-
-
-(**********************************************************************)
-(* Object substitution in modules *)
-
-let rec subst_astpat subst = function
-  | Pquote a -> Pquote (subst_ast subst a)
-  | Pmeta _ as p -> p
-  | Pnode (s,pl) -> Pnode (s,subst_astpatlist subst pl)
-  | Pslam (ido,p) -> Pslam (ido,subst_astpat subst p)
-  | Pmeta_slam (s,p) -> Pmeta_slam (s,subst_astpat subst p)
-
-and subst_astpatlist subst = function
-  | Pcons (p,pl) -> Pcons (subst_astpat subst p, subst_astpatlist subst pl)
-  | (Plmeta _ | Pnil) as pl -> pl
-
-let subst_pat subst = function
-  | AstListPat pl -> AstListPat (subst_astpatlist subst pl)
-  | PureAstPat p -> PureAstPat (subst_astpat subst p)
diff --git a/parsing/ast.mli b/parsing/ast.mli
deleted file mode 100755
index 7bc0b607..00000000
--- a/parsing/ast.mli
+++ /dev/null
@@ -1,123 +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: ast.mli,v 1.17.2.1 2004/07/16 19:30:37 herbelin Exp $ i*)
-
-(*i*)
-open Pp
-open Util
-open Names
-open Libnames
-open Coqast
-open Topconstr
-open Genarg
-(*i*)
-
-(* Abstract syntax trees. *)
-
-val loc : Coqast.t -> loc
-
-(* ast constructors with dummy location *)
-val ope : string * Coqast.t list -> Coqast.t
-val slam : identifier option * Coqast.t -> Coqast.t
-val nvar : identifier -> Coqast.t
-val ide : string -> Coqast.t
-val num : int -> Coqast.t
-val string : string -> Coqast.t
-val path : kernel_name -> Coqast.t
-val dynamic : Dyn.t -> Coqast.t
-
-val set_loc : loc -> Coqast.t -> Coqast.t
-
-val path_section : loc -> kernel_name -> Coqast.t
-val section_path : kernel_name -> kernel_name
-
-(* ast destructors *)
-val num_of_ast : Coqast.t -> int
-val id_of_ast : Coqast.t -> string
-val nvar_of_ast : Coqast.t -> identifier
-val meta_of_ast : Coqast.t -> string
-
-(* patterns of ast *)
-type astpat =
-  | Pquote of t
-  | Pmeta of string * tok_kind
-  | Pnode of string * patlist
-  | Pslam of identifier option * astpat
-  | Pmeta_slam of string * astpat
-
-and patlist =
-  | Pcons of astpat * patlist
-  | Plmeta of string
-  | Pnil
-
-and tok_kind = Tnum | Tid | Tstr | Tpath | Tvar | Tany | Tlist
-
-type pat =
-  | AstListPat of patlist
-  | PureAstPat of astpat
-
-(* semantic actions of grammar rules *)
-type act =
-  | Act of constr_expr
-  | ActCase of act * (pat * act) list
-  | ActCaseList of act * (pat * act) list
-
-(* values associated to variables *)
-type typed_ast =
-  | AstListNode of Coqast.t list
-  | PureAstNode of Coqast.t
-
-type ast_action_type = ETast | ETastl
-
-type dynamic_grammar =
-  | ConstrNode of constr_expr
-  | CasesPatternNode of cases_pattern_expr
-
-type grammar_action =
-  | SimpleAction of loc * dynamic_grammar
-  | CaseAction of
-      loc * grammar_action * ast_action_type * (t list * grammar_action) list
-
-type env = (string * typed_ast) list
-
-val coerce_to_id : constr_expr -> identifier located
-
-val coerce_global_to_id : reference -> identifier
-val coerce_reference_to_id : reference -> identifier
-
-exception No_match of string
-
-val isMeta : string -> bool
-
-val print_ast : Coqast.t -> std_ppcmds
-val print_astl : Coqast.t list -> std_ppcmds
-val print_astpat : astpat -> std_ppcmds
-val print_astlpat : patlist -> std_ppcmds
-
-(* Meta-syntax operations: matching and substitution *)
-
-type entry_env = (string * ast_action_type) list
-
-val grammar_type_error : loc * string -> 'a
- 
-(* Converting and checking free meta-variables *)
-
-(* For old ast printer *)
-val pat_sub : loc -> env -> astpat -> Coqast.t
-val val_of_ast : entry_env -> Coqast.t -> astpat
-val alpha_eq : Coqast.t * Coqast.t -> bool
-val alpha_eq_val : typed_ast * typed_ast -> bool
-val occur_var_ast : identifier -> Coqast.t -> bool
-val find_all_matches : ('a -> astpat) -> env -> t -> 'a list -> ('a * env) list
-val first_matchl : ('a -> patlist) -> env -> Coqast.t list -> 'a list ->
-  ('a * env) option
-val to_pat : entry_env -> Coqast.t -> (astpat * entry_env)
-
-(* Object substitution in modules *)
-val subst_astpat : Names.substitution -> astpat -> astpat
diff --git a/parsing/coqast.ml b/parsing/coqast.ml
deleted file mode 100644
index 0f447766..00000000
--- a/parsing/coqast.ml
+++ /dev/null
@@ -1,123 +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        *)
-(************************************************************************)
-
-(* $Id: coqast.ml,v 1.9.6.1 2004/07/16 19:30:37 herbelin Exp $ *)
-
-(*i*)
-open Util
-open Names
-open Libnames
-(*i*)
-
-type t =
-  | Node of loc * string * t list
-  | Nmeta of loc * string
-  | Nvar of loc * identifier
-  | Slam of loc * identifier option * t
-  | Smetalam of loc * string * t
-  | Num of loc * int
-  | Str of loc * string
-  | Id of loc * string
-  | Path of loc * kernel_name
-  | Dynamic of loc * Dyn.t
-
-type the_coq_ast = t
-
-let subst_meta bl ast =
-  let rec aux = function
-    | Node (_,"META", [Num(_, n)]) -> List.assoc n bl
-    | Node(loc, node_name, args) -> 
-	Node(loc, node_name, List.map aux args)
-    | Slam(loc, var, arg) -> Slam(loc, var, aux arg)
-    | Smetalam(loc, var, arg) -> Smetalam(loc, var, aux arg)
-    | other -> other
-  in 
-  aux ast
-
-let rec collect_metas = function
-  | Node (_,"META", [Num(_, n)]) -> [n]
-  | Node(_, _, args) -> List.concat (List.map collect_metas args)
-  | Slam(loc, var, arg) -> collect_metas arg
-  | Smetalam(loc, var, arg) -> collect_metas arg
-  | _ -> []
-
-(* Hash-consing *)
-module Hloc = Hashcons.Make(
-  struct
-    type t = loc
-    type u = unit
-    let equal (b1,e1) (b2,e2) = b1=b2 & e1=e2
-    let hash_sub () x = x
-    let hash = Hashtbl.hash
-  end)
-
-module Hast = Hashcons.Make(
-  struct
-    type t = the_coq_ast
-    type u = 
-	(the_coq_ast -> the_coq_ast) *
-	((loc -> loc) * (string -> string)
-	 * (identifier -> identifier) * (kernel_name -> kernel_name))
-    let hash_sub (hast,(hloc,hstr,hid,hsp)) = function
-      | Node(l,s,al) -> Node(hloc l, hstr s, List.map hast al)
-      | Nmeta(l,s) -> Nmeta(hloc l, hstr s)
-      | Nvar(l,s) -> Nvar(hloc l, hid s)
-      | Slam(l,None,t) -> Slam(hloc l, None, hast t)
-      | Slam(l,Some s,t) -> Slam(hloc l, Some (hid s), hast t)
-      | Smetalam(l,s,t) -> Smetalam(hloc l, hstr s, hast t)
-      | Num(l,n) -> Num(hloc l, n)
-      | Id(l,s) -> Id(hloc l, hstr s)
-      | Str(l,s) -> Str(hloc l, hstr s)
-      | Path(l,d) -> Path(hloc l, hsp d)
-      | Dynamic(l,d) -> Dynamic(hloc l, d)
-    let equal a1 a2 =
-      match (a1,a2) with
-        | (Node(l1,s1,al1), Node(l2,s2,al2)) ->
-            (l1==l2 & s1==s2 & List.length al1 = List.length al2)
-            & List.for_all2 (==) al1 al2
-        | (Nmeta(l1,s1), Nmeta(l2,s2)) -> l1==l2 & s1==s2
-        | (Nvar(l1,s1), Nvar(l2,s2)) -> l1==l2 & s1==s2
-        | (Slam(l1,None,t1), Slam(l2,None,t2)) -> l1==l2 & t1==t2
-        | (Slam(l1,Some s1,t1), Slam(l2,Some s2,t2)) ->l1==l2 & s1==s2 & t1==t2
-        | (Smetalam(l1,s1,t1), Smetalam(l2,s2,t2)) -> l1==l2 & s1==s2 & t1==t2
-        | (Num(l1,n1), Num(l2,n2)) -> l1==l2 & n1=n2
-        | (Id(l1,s1), Id(l2,s2)) -> l1==l2 & s1==s2
-        | (Str(l1,s1),Str(l2,s2)) -> l1==l2 & s1==s2
-        | (Path(l1,d1), Path(l2,d2)) -> (l1==l2 & d1==d2)
-        | _ -> false
-    let hash = Hashtbl.hash
-  end)
-
-let hcons_ast (hstr,hid,hpath) =
-  let hloc = Hashcons.simple_hcons Hloc.f () in
-  let hast = Hashcons.recursive_hcons Hast.f (hloc,hstr,hid,hpath) in
-  (hast,hloc)
-
-let rec subst_ast subst ast = match ast with
-  | Node (l,s,astl) ->
-      let astl' = Util.list_smartmap (subst_ast subst) astl in
-	if astl' == astl then ast else
-	  Node (l,s,astl')
-  | Slam (l,ido,ast1) ->
-      let ast1' = subst_ast subst ast1 in
-	if ast1' == ast1 then ast else
-	  Slam (l,ido,ast1')
-  | Smetalam (l,s,ast1) ->
-      let ast1' = subst_ast subst ast1 in
-	if ast1' == ast1 then ast else
-	  Smetalam (l,s,ast1')
-  | Path (loc,kn) -> 
-      let kn' = Names.subst_kn subst kn in
-	if kn' == kn then ast else
-	  Path(loc,kn')
-  | Nmeta _
-  | Nvar _ -> ast
-  | Num _
-  | Str _
-  | Id _
-  | Dynamic _ -> ast
diff --git a/parsing/coqast.mli b/parsing/coqast.mli
deleted file mode 100644
index 0b1138f2..00000000
--- a/parsing/coqast.mli
+++ /dev/null
@@ -1,51 +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: coqast.mli,v 1.10.6.2 2005/01/21 16:42:36 herbelin Exp $ i*)
-
-(*i*)
-open Util
-open Names
-open Libnames
-(*i*)
-
-(* Abstract syntax trees. *)
-
-type t =
-  | Node of loc * string * t list
-  | Nmeta of loc * string
-  | Nvar of loc * identifier
-  | Slam of loc * identifier option * t
-  | Smetalam of loc * string * t
-  | Num of loc * int
-  | Str of loc * string
-  | Id of loc * string
-  | Path of loc * kernel_name
-  | Dynamic of loc * Dyn.t
-
-(* returns the list of metas occuring in the ast *)
-val collect_metas : t -> int list
-
-(* [subst_meta bl ast]: for each binding [(i,c_i)] in [bl], 
-   replace the metavar [?i] by [c_i] in [ast] *)
-val subst_meta : (int * t) list -> t -> t
-
-(* hash-consing function *)
-val hcons_ast: 
-  (string -> string) * (Names.identifier -> Names.identifier)
-  * (kernel_name -> kernel_name)
-  -> (t -> t) * (loc -> loc)
-
-val subst_ast: Names.substitution -> t -> t
-
-(*i
-val map_tactic_expr : (t -> t) -> (tactic_expr -> tactic_expr) -> tactic_expr -> tactic_expr
-val fold_tactic_expr :
-  ('a -> t -> 'a) -> ('a -> tactic_expr -> 'a) -> 'a -> tactic_expr -> 'a
-val iter_tactic_expr : (tactic_expr -> unit) -> tactic_expr -> unit
-i*)
diff --git a/parsing/egrammar.ml b/parsing/egrammar.ml
index 09889d40..c723175c 100644
--- a/parsing/egrammar.ml
+++ b/parsing/egrammar.ml
@@ -6,64 +6,31 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: egrammar.ml,v 1.48.2.4 2005/12/23 22:16:46 herbelin Exp $ *)
+(* $Id: egrammar.ml 7762 2005-12-30 10:55:33Z herbelin $ *)
 
 open Pp
 open Util
-open Ppextend
-open Extend
 open Pcoq
+open Extend
 open Topconstr
-open Ast
 open Genarg
 open Libnames
 open Nameops
-
-(* State of the grammar extensions *)
-
-type notation_grammar = 
-    int * Gramext.g_assoc option * notation * prod_item list * int list option
-
-type all_grammar_command =
-  | Notation of (precedence * tolerability list) * notation_grammar
-  | Grammar of grammar_command
-  | TacticGrammar of
-      (string * (string * grammar_production list) * 
-      (Names.dir_path * Tacexpr.raw_tactic_expr))
-      list * (string * Genarg.argument_type list *
-              (string * Pptactic.grammar_terminals)) list
-
-let subst_all_grammar_command subst = function
-  | Notation _ -> anomaly "Notation not in GRAMMAR summary"
-  | Grammar gc -> Grammar (subst_grammar_command subst gc)
-  | TacticGrammar (g,p) -> TacticGrammar (g,p) (* TODO ... *)
-
-let (grammar_state : all_grammar_command list ref) = ref []
-
+open Tacexpr
+open Names
+open Vernacexpr
 
 (**************************************************************************)
-(* Interpretation of the right hand side of grammar rules *)
-
-(* When reporting errors, we add the name of the grammar rule that failed *)
-let specify_name name e =
-  match e with
-    | UserError(lab,strm) ->
-        UserError(lab, (str"during interpretation of grammar rule " ++
-                          str name ++ str"," ++ spc () ++ strm))
-    | Anomaly(lab,strm) ->
-        Anomaly(lab, (str"during interpretation of grammar rule " ++
-                        str name ++ str"," ++ spc () ++ strm))
-    | Failure s ->
-        Failure("during interpretation of grammar rule "^name^", "^s)
-    | e -> e
-
-(* Translation of environments: a production
+(*  
+ * --- Note on the mapping of grammar productions to camlp4 actions ---
+ *  
+ * Translation of environments: a production
  *   [ nt1(x1) ... nti(xi) ] -> act(x1..xi)
  * is written (with camlp4 conventions):
  *   (fun vi -> .... (fun v1 -> act(v1 .. vi) )..)
  * where v1..vi are the values generated by non-terminals nt1..nti.
  * Since the actions are executed by substituting an environment,
- * make_act builds the following closure:
+ * the make_*_action family build the following closure:
  *
  *      ((fun env ->
  *          (fun vi -> 
@@ -77,11 +44,18 @@ let specify_name name e =
  *         [])
  *)
 
-open Names
+(**********************************************************************)
+(** Declare Notations grammar rules                                   *)
+
+type prod_item =
+  | Term of Token.pattern
+  | NonTerm of constr_production_entry * 
+      (Names.identifier * constr_production_entry) option
 
 type 'a action_env = (identifier * 'a) list
 
-let make_act (f : loc -> constr_expr action_env -> constr_expr) pil =
+let make_constr_action
+  (f : loc -> constr_expr action_env -> constr_expr) pil =
   let rec make (env : constr_expr action_env) = function
     | [] ->
 	Gramext.action (fun loc -> f loc env)
@@ -95,8 +69,8 @@ let make_act (f : loc -> constr_expr action_env -> constr_expr) pil =
         Gramext.action (fun (v:identifier) ->
 	  make ((p,CRef (Ident (dummy_loc,v))) :: env) tl)
     | Some (p, ETBigint) :: tl -> (* non-terminal *)
-        Gramext.action (fun (v:Bignat.bigint) ->
-	  make ((p,CNumeral (dummy_loc,v)) :: env) tl)
+        Gramext.action (fun (v:Bigint.bigint) ->
+	  make ((p,CPrim (dummy_loc,Numeral v)) :: env) tl)
     | Some (p, ETConstrList _) :: tl ->
         Gramext.action (fun (v:constr_expr list) ->
           let dummyid = Ident (dummy_loc,id_of_string "") in
@@ -105,7 +79,7 @@ let make_act (f : loc -> constr_expr action_env -> constr_expr) pil =
 	failwith "Unexpected entry of type cases pattern" in
   make [] (List.rev pil)
 
-let make_act_in_cases_pattern (* For Notations *)
+let make_cases_pattern_action
   (f : loc -> cases_pattern_expr action_env -> cases_pattern_expr) pil =
   let rec make (env : cases_pattern_expr action_env) = function
     | [] ->
@@ -121,8 +95,8 @@ let make_act_in_cases_pattern (* For Notations *)
         Gramext.action (fun (v:identifier) ->
 	  make ((p,CPatAtom (dummy_loc,Some (Ident (dummy_loc,v)))) :: env) tl)
     | Some (p, ETBigint) :: tl -> (* non-terminal *)
-        Gramext.action (fun (v:Bignat.bigint) ->
-	  make ((p,CPatNumeral (dummy_loc,v)) :: env) tl)
+        Gramext.action (fun (v:Bigint.bigint) ->
+	  make ((p,CPatPrim (dummy_loc,Numeral v)) :: env) tl)
     | Some (p, ETConstrList _) :: tl ->
         Gramext.action (fun (v:cases_pattern_expr list) ->
           let dummyid = Ident (dummy_loc,id_of_string "") in
@@ -131,183 +105,37 @@ let make_act_in_cases_pattern (* For Notations *)
 	failwith "Unexpected entry of type cases pattern or other" in
   make [] (List.rev pil)
 
-(* For V7 Grammar only *)
-let make_cases_pattern_act
-  (f : loc -> cases_pattern_expr action_env -> cases_pattern_expr) pil =
-  let rec make (env : cases_pattern_expr action_env) = function
-    | [] ->
-	Gramext.action (fun loc -> f loc env)
-    | None :: tl -> (* parse a non-binding item *)
-        Gramext.action (fun _ -> make env tl)
-    | Some (p, ETPattern) :: tl -> (* non-terminal *)
-        Gramext.action (fun v -> make ((p,v) :: env) tl)
-    | Some (p, ETReference) :: tl -> (* non-terminal *)
-	Gramext.action (fun v -> make ((p,CPatAtom(dummy_loc,Some v)) :: env)
-	  tl)
-    | Some (p, ETBigint) :: tl -> (* non-terminal *)
-	Gramext.action (fun v -> make ((p,CPatNumeral(dummy_loc,v)) :: env) tl)
-    | Some (p, (ETConstrList _ | ETIdent | ETConstr _ | ETOther _)) :: tl ->
-	error "ident and constr entry not admitted in patterns cases syntax extensions" in
-  make [] (List.rev pil)
-
-(* Grammar extension command. Rules are assumed correct.
- * Type-checking of grammar rules is done during the translation of
- * ast to the type grammar_command.  We only check that the existing
- * entries have the type assumed in the grammar command (these types
- * annotations are added when type-checking the command, function
- * Extend.of_ast) *)
-
-let symbol_of_prod_item univ assoc from forpat = function
+let make_constr_prod_item univ assoc from forpat = function
   | Term tok -> (Gramext.Stoken tok, None)
   | NonTerm (nt, ovar) ->
       let eobj = symbol_of_production assoc from forpat nt in
       (eobj, ovar)
 
-let coerce_to_id = function
-  | CRef (Ident (_,id)) -> id 
-  | c ->
-      user_err_loc (constr_loc c, "subst_rawconstr",
-        str"This expression should be a simple identifier")
-
-let coerce_to_ref = function
-  | CRef r -> r
-  | c ->
-      user_err_loc (constr_loc c, "subst_rawconstr",
-        str"This expression should be a simple reference")
-
-let subst_ref loc subst id =
-  try coerce_to_ref (List.assoc id subst) with Not_found -> Ident (loc,id)
-
-let subst_pat_id loc subst id =
-  try List.assoc id subst
-  with Not_found -> CPatAtom (loc,Some (Ident (loc,id)))
-
-let subst_id subst id =
-  try coerce_to_id (List.assoc id subst) with Not_found -> id
-
-(*
-let subst_cases_pattern_expr a loc subs =
-  let rec subst = function
-  | CPatAlias (_,p,x) -> CPatAlias (loc,subst p,x)
-    (* No subst in compound pattern ? *)
-  | CPatCstr (_,ref,pl) -> CPatCstr (loc,ref,List.map subst pl)
-  | CPatAtom (_,Some (Ident (_,id))) -> subst_pat_id loc subs id
-  | CPatAtom (_,x) -> CPatAtom (loc,x)
-  | CPatNotation (_,ntn,l) -> CPatNotation 
-  | CPatNumeral (_,n) -> CPatNumeral (loc,n)
-  | CPatDelimiters (_,key,p) -> CPatDelimiters (loc,key,subst p)
-  in subst a
-*)
-
-let subst_constr_expr a loc subs =
-  let rec subst = function
-  | CRef (Ident (_,id)) ->
-      (try List.assoc id subs with Not_found -> CRef (Ident (loc,id)))
-  (* Temporary: no robust treatment of substituted binders *)
-  | CLambdaN (_,[],c) -> subst c
-  | CLambdaN (_,([],t)::bl,c) -> subst (CLambdaN (loc,bl,c))
-  | CLambdaN (_,((_,na)::bl,t)::bll,c) -> 
-      let na = name_app (subst_id subs) na in
-      CLambdaN (loc,[[loc,na],subst t], subst (CLambdaN (loc,(bl,t)::bll,c)))
-  | CProdN (_,[],c) -> subst c
-  | CProdN (_,([],t)::bl,c) -> subst (CProdN (loc,bl,c))
-  | CProdN (_,((_,na)::bl,t)::bll,c) -> 
-      let na = name_app (subst_id subs) na in
-      CProdN (loc,[[loc,na],subst t], subst (CProdN (loc,(bl,t)::bll,c)))
-  | CLetIn (_,(_,na),b,c) ->
-      let na = name_app (subst_id subs) na in
-      CLetIn (loc,(loc,na),subst b,subst c)
-  | CArrow (_,a,b) -> CArrow (loc,subst a,subst b)
-  | CAppExpl (_,(p,Ident (_,id)),l) ->
-      CAppExpl (loc,(p,subst_ref loc subs id),List.map subst l) 
-  | CAppExpl (_,r,l) -> CAppExpl (loc,r,List.map subst l) 
-  | CApp (_,(p,a),l) ->
-      CApp (loc,(p,subst a),List.map (fun (a,i) -> (subst a,i)) l)
-  | CCast (_,a,b) -> CCast (loc,subst a,subst b)
-  | CNotation (_,n,l) -> CNotation (loc,n,List.map subst l)
-  | CDelimiters (_,s,a) -> CDelimiters (loc,s,subst a)
-  | CHole _ | CEvar _ | CPatVar _ | CSort _ 
-  | CNumeral _ | CDynamic _ | CRef _ as x -> x
-  | CCases (_,(po,rtntypo),a,bl) ->
-      (* TODO: apply g on the binding variables in pat... *)
-      let bl = List.map (fun (_,pat,rhs) -> (loc,pat,subst rhs)) bl in
-      CCases (loc,(option_app subst po,option_app subst rtntypo),
-        List.map (fun (tm,x) -> subst tm,x) a,bl)
-  | COrderedCase (_,s,po,a,bl) ->
-      COrderedCase (loc,s,option_app subst po,subst a,List.map subst bl)
-  | CLetTuple (_,nal,(na,po),a,b) ->
-      let na = option_app (name_app (subst_id subs)) na in
-      let nal = List.map (name_app (subst_id subs)) nal in
-      CLetTuple (loc,nal,(na,option_app subst po),subst a,subst b)
-  | CIf (_,c,(na,po),b1,b2) ->
-      let na = option_app (name_app (subst_id subs)) na in
-      CIf (loc,subst c,(na,option_app subst po),subst b1,subst b2)
-  | CFix (_,id,dl) ->
-      CFix (loc,id,List.map (fun (id,n,bl, t,d) ->
-        (id,n,
-         List.map(function
-             LocalRawAssum(nal,ty) -> LocalRawAssum(nal,subst ty)
-           | LocalRawDef(na,def) -> LocalRawDef(na,subst def)) bl,
-         subst t,subst d)) dl)
-  | CCoFix (_,id,dl) ->
-      CCoFix (loc,id,List.map (fun (id,bl,t,d) ->
-        (id,
-         List.map(function
-             LocalRawAssum(nal,ty) -> LocalRawAssum(nal,subst ty)
-           | LocalRawDef(na,def) -> LocalRawDef(na,subst def)) bl,
-         subst t,subst d)) dl)
-  in subst a
-
-(* For V7 Grammar only *)
-let make_rule univ assoc etyp rule =
-  if not !Options.v7 then anomaly "No Grammar in new syntax";
-  let pil = List.map (symbol_of_prod_item univ assoc etyp false) rule.gr_production in
+let extend_constr entry (n,assoc,pos,p4assoc,name) mkact (forpat,pt) =
+  let univ = get_univ "constr" in
+  let pil = List.map (make_constr_prod_item univ assoc n forpat) pt in
   let (symbs,ntl) = List.split pil in
-  let act = match etyp with
-    | ETPattern ->
-        (* Ugly *)
-        let f loc env = match rule.gr_action, env with
-          | CRef (Ident(_,p)), [p',a] when p=p' -> a
-          | CDelimiters (_,s,CRef (Ident(_,p))), [p',a] when p=p' ->
-	      CPatDelimiters (loc,s,a)
-          | _ -> error "Unable to handle this grammar extension of pattern" in
-	make_cases_pattern_act f ntl
-    | ETConstrList _ | ETIdent | ETBigint | ETReference -> error "Cannot extend"
-    | ETConstr _ | ETOther _ -> 
-	make_act (subst_constr_expr rule.gr_action) ntl in
-  (symbs, act)
+  grammar_extend entry pos [(name, p4assoc, [symbs, mkact ntl])]
 
-(* Rules of a level are entered in reverse order, so that the first rules
-   are applied before the last ones *)
-(* For V7 Grammar only *)
-let extend_entry univ (te, etyp, pos, name, ass, p4ass, rls) =
-  let rules = List.rev (List.map (make_rule univ ass etyp) rls) in
-  grammar_extend te pos [(name, p4ass, rules)]
-
-(* Defines new entries. If the entry already exists, check its type *)
-let define_entry univ {ge_name=typ; gl_assoc=ass; gl_rules=rls} =
-  let e,lev,keepassoc = get_constr_entry false typ in
-  let pos,p4ass,name = find_position false keepassoc ass lev in
-  (e,typ,pos,name,ass,p4ass,rls)
-
-(* Add a bunch of grammar rules. Does not check if it is well formed *)
-(* For V7 Grammar only *)
-let extend_grammar_rules gram =
-  let univ = get_univ gram.gc_univ in
-  let tl = List.map (define_entry univ) gram.gc_entries in
-  List.iter (extend_entry univ) tl
-
-(* Add a grammar rules for tactics *)
-type grammar_tactic_production =
-  | TacTerm of string
-  | TacNonTerm of loc * (Gram.te Gramext.g_symbol * argument_type) * string option
+let extend_constr_notation (n,assoc,ntn,rule) =
+  (* Add the notation in constr *)
+  let mkact loc env = CNotation (loc,ntn,List.map snd env) in
+  let (e,level,keepassoc) = get_constr_entry false (ETConstr (n,())) in
+  let pos,p4assoc,name = find_position false keepassoc assoc level in
+  extend_constr e (ETConstr(n,()),assoc,pos,p4assoc,name)
+    (make_constr_action mkact) (false,rule);
+  (* Add the notation in cases_pattern *)
+  let mkact loc env = CPatNotation (loc,ntn,List.map snd env) in
+  let (e,level,keepassoc) = get_constr_entry true (ETConstr (n,())) in
+  let pos,p4assoc,name = find_position true keepassoc assoc level in
+  extend_constr e (ETConstr (n,()),assoc,pos,p4assoc,name)
+    (make_cases_pattern_action mkact) (true,rule)
 
-let make_prod_item = function
-  | TacTerm s -> (Gramext.Stoken (Extend.terminal s), None)
-  | TacNonTerm (_,(nont,t), po) ->
-      (nont, option_app (fun p -> (p,t)) po)
+(**********************************************************************)
+(** Making generic actions in type generic_argument                   *)
 
-let make_gen_act f pil =
+let make_generic_action
+  (f:loc -> ('b * raw_generic_argument) list -> 'a) pil =
   let rec make env = function
     | [] -> 
 	Gramext.action (fun loc -> f loc env)
@@ -317,73 +145,77 @@ let make_gen_act f pil =
         Gramext.action (fun v -> make ((p,in_generic t v) :: env) tl) in
   make [] (List.rev pil)
 
-let extend_constr entry (n,assoc,pos,p4assoc,name) make_act (forpat,pt) =
-  let univ = get_univ "constr" in
-  let pil = List.map (symbol_of_prod_item univ assoc n forpat) pt in
-  let (symbs,ntl) = List.split pil in
-  let act = make_act ntl in
-  grammar_extend entry pos [(name, p4assoc, [symbs, act])]
-
-let extend_constr_notation (n,assoc,ntn,rule,permut) =
-  let mkact =
-    match permut with
-        None -> (fun loc env -> CNotation (loc,ntn,List.map snd env))
-      | Some p -> (fun loc env ->
-          CNotation (loc,ntn,List.map (fun i -> snd (List.nth env i)) p)) in
-  let (e,level,keepassoc) = get_constr_entry false (ETConstr (n,())) in
-  let pos,p4assoc,name = find_position false keepassoc assoc level in
-  extend_constr e (ETConstr(n,()),assoc,pos,p4assoc,name)
-    (make_act mkact) (false,rule);
-  if not !Options.v7 then
-  let mkact loc env = CPatNotation (loc,ntn,List.map snd env) in
-  let (e,level,keepassoc) = get_constr_entry true (ETConstr (n,())) in
-  let pos,p4assoc,name = find_position true keepassoc assoc level in
-  extend_constr e (ETConstr (n,()),assoc,pos,p4assoc,name)
-    (make_act_in_cases_pattern mkact) (true,rule)
-    
-(* These grammars are not a removable *)
-let make_rule univ f g (s,pt) =
-  let hd = Gramext.Stoken ("IDENT", s) in
-  let pil = (hd,None) :: List.map g pt in
-  let (symbs,ntl) = List.split pil in
-  let act = make_gen_act f ntl in
+let make_rule univ f g pt =
+  let (symbs,ntl) = List.split (List.map g pt) in
+  let act = make_generic_action f ntl in
   (symbs, act)
 
+(**********************************************************************)
+(** Grammar extensions declared at ML level                           *) 
+
+type grammar_tactic_production =
+  | TacTerm of string
+  | TacNonTerm of
+      loc * (Gram.te Gramext.g_symbol * argument_type) * string option
+
+let make_prod_item = function
+  | TacTerm s -> (Gramext.Stoken (Lexer.terminal s), None)
+  | TacNonTerm (_,(nont,t), po) -> (nont, option_app (fun p -> (p,t)) po)
+
+(* Tactic grammar extensions *)
+
 let tac_exts = ref []
 let get_extend_tactic_grammars () = !tac_exts
 
 let extend_tactic_grammar s gl =
   tac_exts := (s,gl) :: !tac_exts;
   let univ = get_univ "tactic" in
-  let make_act loc l = Tacexpr.TacExtend (loc,s,List.map snd l) in
-  let rules = List.map (make_rule univ make_act make_prod_item) gl in
+  let mkact loc l = Tacexpr.TacExtend (loc,s,List.map snd l) in
+  let rules = List.map (make_rule univ mkact make_prod_item) gl in
   Gram.extend Tactic.simple_tactic None [(None, None, List.rev rules)]
 
+(* Vernac grammar extensions *)
+
 let vernac_exts = ref []
 let get_extend_vernac_grammars () = !vernac_exts
 
 let extend_vernac_command_grammar s gl =
   vernac_exts := (s,gl) :: !vernac_exts;
   let univ = get_univ "vernac" in
-  let make_act loc l = Vernacexpr.VernacExtend (s,List.map snd l) in
-  let rules = List.map (make_rule univ make_act make_prod_item) gl in
+  let mkact loc l = VernacExtend (s,List.map snd l) in
+  let rules = List.map (make_rule univ mkact make_prod_item) gl in
   Gram.extend Vernac_.command None [(None, None, List.rev rules)]
 
-let rec interp_entry_name u s =
+(**********************************************************************)
+(** Grammar declaration for Tactic Notation (Coq level)               *) 
+
+(* Interpretation of the grammar entry names *)
+
+let find_index s t =
+  let t,n = repr_ident (id_of_string t) in
+  if s <> t or n = None then raise Not_found;
+  out_some n
+
+let rec interp_entry_name up_level u 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 u (String.sub s 3 (l-8)) in
+    let t, g = interp_entry_name up_level u (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 u (String.sub s 0 (l-5)) in
+    let t, g = interp_entry_name up_level u (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 u (String.sub s 0 (l-4)) in
+    let t, g = interp_entry_name up_level u (String.sub s 0 (l-4)) in
     OptArgType t, Gramext.Sopt g
   else
+    try 
+      let i = find_index "tactic" s in
+      TacticArgType i, 
+      if i=up_level then Gramext.Sself else
+      if 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 = 
-    if !Options.v7 then get_entry (get_univ u) s
-    else
       (* Qualified entries are no longer in use *)
       try get_entry (get_univ "tactic") s
       with _ -> 
@@ -396,31 +228,61 @@ let rec interp_entry_name u s =
     let t = type_of_typed_entry e in
     t,Gramext.Snterm (Pcoq.Gram.Entry.obj o)
 
-let qualified_nterm current_univ = function
-  | NtQual (univ, en) -> if !Options.v7 then (univ, en) else assert false
-  | NtShort en -> (current_univ, en)
-
-let make_vprod_item univ = function
-  | VTerm s -> (Gramext.Stoken (Extend.terminal s), None)
+let make_vprod_item n univ = function
+  | VTerm s -> (Gramext.Stoken (Lexer.terminal s), None)
   | VNonTerm (loc, nt, po) ->
-      let (u,nt) = qualified_nterm univ nt in
-      let (etyp, e) = interp_entry_name u nt in
+      let (etyp, e) = interp_entry_name n univ nt in
       e, option_app (fun p -> (p,etyp)) po
 
-let add_tactic_entries gl =
+let get_tactic_entry n =
+  if n = 0 then
+    weaken_entry Tactic.simple_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))
+
+(* Declaration of the tactic grammar rule *)
+
+let head_is_ident = function VTerm _::_ -> true | _ -> false
+
+let add_tactic_entry (key,lev,prods,tac) =
   let univ = get_univ "tactic" in
-  let make_act s tac loc l = Tacexpr.TacAlias (loc,s,l,tac) in
-  let f (s,l,tac) =
-    make_rule univ (make_act s tac) (make_vprod_item "tactic") l in
-  let rules = List.map f gl in
+  let entry, pos = get_tactic_entry lev in
+  let mkprod = make_vprod_item lev "tactic" in
+  let rules = 
+    if lev = 0 then begin
+      if not (head_is_ident prods) then
+	error "Notation for simple tactic must start with an identifier";
+      let mkact s tac loc l =
+	(TacAlias(loc,s,l,tac):raw_atomic_tactic_expr) in
+      make_rule univ (mkact key tac) mkprod prods
+    end
+    else
+      let mkact s tac loc l = 
+	(TacAtom(loc,TacAlias(loc,s,l,tac)):raw_tactic_expr) in
+      make_rule univ (mkact key tac) mkprod prods in
   let _ = find_position true true None None (* to synchronise with remove *) in
-  grammar_extend Tactic.simple_tactic None [(None, None, List.rev rules)]
+  grammar_extend entry pos [(None, None, List.rev [rules])]
+
+(**********************************************************************)
+(** State of the grammar extensions                                   *)
+
+type notation_grammar = 
+    int * Gramext.g_assoc option * notation * prod_item list
+
+type all_grammar_command =
+  | Notation of Notation.level * notation_grammar
+  | TacticGrammar of
+      (string * int * grammar_production list * 
+        (Names.dir_path * Tacexpr.glob_tactic_expr))
+
+let (grammar_state : all_grammar_command list ref) = ref []
 
 let extend_grammar gram =
   (match gram with
   | Notation (_,a) -> extend_constr_notation a
-  | Grammar g -> extend_grammar_rules g
-  | TacticGrammar (l,_) -> add_tactic_entries l);
+  | TacticGrammar g -> add_tactic_entry g);
   grammar_state := gram :: !grammar_state
 
 let reset_extend_grammars_v8 () =
@@ -428,12 +290,12 @@ let reset_extend_grammars_v8 () =
   let tv = List.rev !vernac_exts in
   tac_exts := [];
   vernac_exts := [];
-  List.iter (fun (s,gl) -> extend_tactic_grammar s gl) te;
+  List.iter (fun (s,gl) -> print_string ("Resinstalling "^s); flush stdout; extend_tactic_grammar s gl) te;
   List.iter (fun (s,gl) -> extend_vernac_command_grammar s gl) tv
 
 let recover_notation_grammar ntn prec =
   let l = map_succeed (function
-    | Notation (prec',(_,_,ntn',_,_ as x)) when prec = prec' & ntn = ntn' -> x
+    | Notation (prec',(_,_,ntn',_ as x)) when prec = prec' & ntn = ntn' -> x
     | _ -> failwith "") !grammar_state in
   assert (List.length l = 1);
   List.hd l
@@ -453,11 +315,7 @@ let factorize_grams l1 l2 =
 let number_of_entries gcl =
   List.fold_left
     (fun n -> function
-      | Notation _ -> 
-          if !Options.v7 then n + 1
-	  else n + 2 (* 1 for operconstr, 1 for pattern *)
-      | Grammar gc ->
-          n + (List.length gc.gc_entries)
+      | Notation _ -> n + 2 (* 1 for operconstr, 1 for pattern *)
       | TacticGrammar _ -> n + 1)
     0 gcl
 
diff --git a/parsing/egrammar.mli b/parsing/egrammar.mli
index ade91453..31247044 100644
--- a/parsing/egrammar.mli
+++ b/parsing/egrammar.mli
@@ -6,54 +6,62 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: egrammar.mli,v 1.14.2.6 2005/12/23 22:16:46 herbelin Exp $ i*)
+(*i $Id: egrammar.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
 (*i*)
 open Util
 open Topconstr
-open Ast
-open Coqast
+open Pcoq
+open Extend
 open Vernacexpr
 open Ppextend
-open Extend
 open Rawterm
+open Mod_subst
 (*i*)
 
+(** Mapping of grammar productions to camlp4 actions
+    Used for Coq-level Notation and Tactic Notation, 
+    and for ML-level tactic and vernac extensions
+ *)
+
+type prod_item =
+  | Term of Token.pattern
+  | NonTerm of constr_production_entry * 
+      (Names.identifier * constr_production_entry) option
+
 type notation_grammar = 
-    int * Gramext.g_assoc option * notation * prod_item list * int list option
+    int * Gramext.g_assoc option * notation * prod_item list
 
 type all_grammar_command =
   | Notation of (precedence * tolerability list) * notation_grammar
-  | Grammar of grammar_command
   | TacticGrammar of
-      (string * (string * grammar_production list) * 
-      (Names.dir_path * Tacexpr.raw_tactic_expr))
-      list * (string * Genarg.argument_type list *
-              (string * Pptactic.grammar_terminals)) list
+      (string * int * grammar_production list * 
+        (Names.dir_path * Tacexpr.glob_tactic_expr))
 
 val extend_grammar : all_grammar_command -> unit
 
 (* Add grammar rules for tactics *)
+
 type grammar_tactic_production =
   | TacTerm of string
-  | TacNonTerm of loc * (Token.t Gramext.g_symbol * Genarg.argument_type) * string option
+  | TacNonTerm of
+      loc * (Token.t Gramext.g_symbol * Genarg.argument_type) * string option
 
 val extend_tactic_grammar :
-  string -> (string * grammar_tactic_production list) list -> unit
+  string -> grammar_tactic_production list list -> unit
 
 val extend_vernac_command_grammar :
-  string -> (string * grammar_tactic_production list) list -> unit
-
+  string -> grammar_tactic_production list list -> unit
+(*
 val get_extend_tactic_grammars :
- unit -> (string * (string * grammar_tactic_production list) list) list
+ unit -> (string * grammar_tactic_production list list) list
+*)
 val get_extend_vernac_grammars :
- unit -> (string * (string * grammar_tactic_production list) list) list
+ unit -> (string * grammar_tactic_production list list) list
+(*
 val reset_extend_grammars_v8 : unit -> unit
-
-val subst_all_grammar_command :
-  Names.substitution -> all_grammar_command -> all_grammar_command
-
-val interp_entry_name : string -> string -> 
+*)
+val interp_entry_name : int -> string -> string -> 
   entry_type * Token.t Gramext.g_symbol
 
 val recover_notation_grammar :
diff --git a/parsing/esyntax.ml b/parsing/esyntax.ml
deleted file mode 100644
index 6a4758ab..00000000
--- a/parsing/esyntax.ml
+++ /dev/null
@@ -1,276 +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        *)
-(************************************************************************)
-
-(* $Id: esyntax.ml,v 1.21.2.1 2004/07/16 19:30:37 herbelin Exp $ *)
-
-open Pp
-open Util
-open Names
-open Libnames
-open Coqast
-open Ast
-open Extend
-open Ppextend
-open Names
-open Nametab
-open Topconstr
-open Symbols
- 
-(*** Syntax keys ***)
-
-(* We define keys for ast and astpats. This is a kind of hash
- * function.  An ast may have several keys, but astpat only one. The
- * idea is that if an ast A matches a pattern P, then the key of P
- * is in the set of keys of A. Thus, we can split the syntax entries
- * according to the key of the pattern. *)
-
-type key =
-  | Cst of Names.constant (* keys for global constants rules *)
-  | SecVar of Names.variable
-  | Ind of Names.inductive
-  | Cstr of Names.constructor
-  | Nod of string      (* keys for other constructed asts rules *)
-  | Oth                (* key for other syntax rules *)
-  | All     (* key for catch-all rules (i.e. with a pattern such as $x .. *)
-
-let warning_verbose = ref true
-
-let ast_keys = function
-  | Node(_,"APPLIST", Node(_,"CONST", [Path (_,sl)]) ::_) ->
-      [Cst sl; Nod "APPLIST"; All]
-  | Node(_,"APPLIST", Node(_,"SECVAR", [Nvar (_,s)]) ::_) ->
-      [SecVar s; Nod "APPLIST"; All]
-  | Node(_,"APPLIST", Node(_,"MUTIND", [Path (_,sl); Num (_,tyi)]) ::_) ->
-      [Ind (sl,tyi); Nod "APPLIST"; All]
-  | Node(_,"APPLIST", Node(_,"MUTCONSTRUCT",
-			   [Path (_,sl); Num (_,tyi); Num (_,i)]) ::_) ->
-      [Cstr ((sl,tyi),i); Nod "APPLIST"; All]
-  | Node(_,s,_) -> [Nod s; All]
-  | _ -> [Oth; All]
-
-let spat_key astp =
-  match astp with
-    | Pnode("APPLIST",
-            Pcons(Pnode("CONST",
-                        Pcons(Pquote(Path (_,sl)),_)), _))
-      -> Cst sl
-    | Pnode("APPLIST",
-            Pcons(Pnode("SECVAR",
-                        Pcons(Pquote(Nvar (_,s)),_)), _))
-      -> SecVar s
-    | Pnode("APPLIST",
-            Pcons(Pnode("MUTIND",
-                        Pcons(Pquote(Path (_,sl)),
-			      Pcons(Pquote(Num (_,tyi)),_))), _))
-      -> Ind (sl,tyi)
-    | Pnode("APPLIST",
-            Pcons(Pnode("MUTCONSTRUCT",
-                        Pcons(Pquote(Path (_,sl)),
-			      Pcons(Pquote(Num (_,tyi)),
-				    Pcons(Pquote(Num (_,i)),_)))), _))
-      -> Cstr ((sl,tyi),i)
-    | Pnode(na,_) -> Nod na
-    | Pquote ast -> List.hd (ast_keys ast)
-    | Pmeta _ -> All
-    | _ -> Oth
-
-let se_key se = spat_key se.syn_astpat
-
-(** Syntax entry tables (state of the pretty_printer) **)
-let from_name_table = ref Gmap.empty
-let from_key_table = ref Gmapl.empty
-
-(* Summary operations *)
-type frozen_t = (string * string, astpat syntax_entry) Gmap.t * 
-                (string * key, astpat syntax_entry) Gmapl.t
-
-let freeze () =
-  (!from_name_table, !from_key_table)
-
-let unfreeze (fnm,fkm) =
-  from_name_table := fnm;
-  from_key_table := fkm
-
-let init () =
-  from_name_table := Gmap.empty;
-  from_key_table := Gmapl.empty
-
-let find_syntax_entry whatfor gt =
-  let gt_keys = ast_keys gt in
-  let entries =
-    List.flatten
-      (List.map (fun k -> Gmapl.find (whatfor,k) !from_key_table) gt_keys)
-  in 
-  find_all_matches (fun se -> se.syn_astpat) [] gt entries
-
-let remove_with_warning name =
-  if Gmap.mem name !from_name_table then begin
-    let se = Gmap.find name !from_name_table in
-    let key = (fst name, se_key se) in
-    if !warning_verbose then
-      (Options.if_verbose
-    	warning ("overriding syntax rule "^(fst name)^":"^(snd name)^"."));
-    from_name_table := Gmap.remove name !from_name_table;
-    from_key_table := Gmapl.remove key se !from_key_table
-  end
-
-let add_rule whatfor se =
-  let name = (whatfor,se.syn_id) in
-  let key = (whatfor, se_key se) in
-  remove_with_warning name;
-  from_name_table := Gmap.add name se !from_name_table;
-  from_key_table := Gmapl.add key se !from_key_table
-
-let add_ppobject {sc_univ=wf;sc_entries=sel} = List.iter (add_rule wf) sel
-
-
-(* Pretty-printing machinery *)
-
-type std_printer = Coqast.t -> std_ppcmds
-type unparsing_subfunction = string -> tolerability option -> std_printer
-type primitive_printer = Coqast.t -> std_ppcmds option
-
-(* Module of primitive printers *)
-module Ppprim =
-  struct
-    type t = std_printer -> std_printer
-    let tab = ref ([] : (string * t) list)
-    let map a = List.assoc a !tab
-    let add (a,ppr) = tab := (a,ppr)::!tab
-  end
-
-(**********************************************************************)
-(* Primitive printers (e.g. for numerals)                             *)
-
-(* This is the map associating to a printer the scope it belongs to   *)
-(* and its ML code                                                    *)
-
-let primitive_printer_tab = 
-  ref (Stringmap.empty : (scope_name * primitive_printer) Stringmap.t)
-let declare_primitive_printer s sc pp =
-  primitive_printer_tab := Stringmap.add s (sc,pp) !primitive_printer_tab
-let lookup_primitive_printer s =
-  Stringmap.find s !primitive_printer_tab
-
-(* Register the primitive printer for "token". It is not used in syntax/PP*.v,
- * but any ast matching no PP rule is printed with it. *)
-(*
-let _ = declare_primitive_printer "token" token_printer
-*)
-
-(* A printer for the tokens. *)
-let token_printer stdpr = function
-  | (Id _ | Num _ | Str _ | Path _ as ast) -> print_ast ast
-  | a -> stdpr a
-
-(* Unused ??
-(* A primitive printer to do "print as" (to specify a length for a string) *)
-let print_as_printer = function
-  | Node (_, "AS", [Num(_,n); Str(_,s)]) -> Some (stras (n,s))
-  | ast                                  -> None
-
-let _ = declare_primitive_printer "print_as" default_scope print_as_printer
-*)
-
-(* Handle infix symbols *)
-
-let pr_parenthesis inherited se strm =
-  if tolerable_prec inherited se.syn_prec then
-    strm
-  else 
-    (str"(" ++ strm ++ str")")
-    
-let print_delimiters inh se strm = function
-  | None -> pr_parenthesis inh se strm
-  | Some key ->
-      let left = "'"^key^":" and right = "'" in
-      let lspace =
-	if is_letter (left.[String.length left -1]) then str " " else mt () in
-      let rspace =
-        let c = right.[0] in
-	if is_ident_tail c then str " " else mt () in
-      hov 0 (str left ++ lspace ++ strm ++ rspace ++ str right)
-
-(* Print the syntax entry. In the unparsing hunks, the tokens are
- * printed using the token_printer, unless another primitive printer
- * is specified. *)
-
-let print_syntax_entry sub_pr scopes env se = 
-  let rec print_hunk rule_prec scopes = function
-    | PH(e,externpr,reln) ->
-	let node = Ast.pat_sub dummy_loc env e in
-	let printer =
-	  match externpr with (* May branch to an other printer *)
-	    | Some c ->
-                (try (* Test for a primitive printer *) Ppprim.map c
-                with Not_found -> token_printer)
-	    | _ -> token_printer in
-	printer (sub_pr scopes (Some(rule_prec,reln))) node
-    | RO s -> str s
-    | UNP_TAB -> tab ()
-    | UNP_FNL -> fnl ()
-    | UNP_BRK(n1,n2) -> brk(n1,n2)
-    | UNP_TBRK(n1,n2) -> tbrk(n1,n2)
-    | UNP_BOX (b,sub) -> ppcmd_of_box b (prlist (print_hunk rule_prec scopes) sub)
-    | UNP_SYMBOLIC _ -> anomaly "handled by call_primitive_parser"
-  in 
-  prlist (print_hunk se.syn_prec scopes) se.syn_hunks
-
-let call_primitive_parser rec_pr otherwise inherited scopes (se,env) =
-  try (
-  match se.syn_hunks with
-    | [PH(e,Some c,reln)] ->
-	  (* Test for a primitive printer; may raise Not_found *)
-	  let sc,pr = lookup_primitive_printer c in
-	  (* Look if scope [sc] associated to this printer is OK *)
-	  (match Symbols.availability_of_numeral sc scopes with
-	    | None -> otherwise ()
-	    | Some key ->
-	        (* We can use this printer *)
-	        let node = Ast.pat_sub dummy_loc env e in
-	        match pr node with
-		  | Some strm -> print_delimiters inherited se strm key
-		  | None -> otherwise ())
-    | [UNP_SYMBOLIC (sc,pat,sub)] ->
-	(match Symbols.availability_of_notation (sc,pat) scopes with
-	  | None -> otherwise ()
-	  | Some (scopt,key) ->
-	      print_delimiters inherited se
-		(print_syntax_entry rec_pr
-		  (option_fold_right Symbols.push_scope scopt scopes) env 
-		  {se with syn_hunks = [sub]}) key)
-    | _ ->
-	pr_parenthesis inherited se (print_syntax_entry rec_pr scopes env se)
-  )
-  with Not_found -> (* To handle old style printer *)
-	pr_parenthesis inherited se (print_syntax_entry rec_pr scopes env se)
-
-(* [genprint whatfor dflt inhprec ast] prints out the ast of
- * 'universe' whatfor. If the term is not matched by any
- * pretty-printing rule, then it will call dflt on it, which is
- * responsible for printing out the term (usually #GENTERM...).
- * In the case of tactics and commands, dflt also prints 
- * global constants basenames. *)
-
-let genprint dflt whatfor inhprec ast =
-  let rec rec_pr scopes inherited gt =
-    let entries = find_syntax_entry whatfor gt in
-    let rec test_rule = function
-      | se_env::rules ->
-	  call_primitive_parser
-	    rec_pr 
-	    (fun () -> test_rule rules) 
-	    inherited scopes se_env
-      | [] -> dflt gt (* No rule found *)
-    in test_rule entries
-  in
-  try 
-    rec_pr (Symbols.current_scopes ()) inhprec ast
-  with
-    | Failure _ -> (str"<PP failure: " ++ dflt ast ++ str">")
-    | Not_found -> (str"<PP search failure: " ++ dflt ast ++ str">")
diff --git a/parsing/esyntax.mli b/parsing/esyntax.mli
deleted file mode 100644
index 88d1a0e2..00000000
--- a/parsing/esyntax.mli
+++ /dev/null
@@ -1,61 +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: esyntax.mli,v 1.10.2.2 2005/01/21 16:42:36 herbelin Exp $ i*)
-
-(*i*)
-open Pp
-open Extend
-open Symbols
-open Ppextend
-open Topconstr
-(*i*)
-
-(* Syntax entry tables. *)
-
-type frozen_t
-
-(* pretty-printer summary operations *)
-val init : unit -> unit
-val freeze : unit -> frozen_t
-val unfreeze : frozen_t -> unit
-
-(* Search and add a PP rule for an ast in the summary *)
-val find_syntax_entry :
-  string -> Coqast.t -> (Ast.astpat syntax_entry * Ast.env) list
-val add_rule : string -> Ast.astpat syntax_entry -> unit
-val add_ppobject : Ast.astpat syntax_command -> unit
-val warning_verbose : bool ref
-
-(* Pretty-printing *)
-
-type std_printer = Coqast.t -> std_ppcmds
-type unparsing_subfunction = string -> tolerability option -> std_printer
-type primitive_printer = Coqast.t -> std_ppcmds option
-
-(* Module of constr primitive printers [old style - no scope] *)
-module Ppprim :
-  sig
-    type t = std_printer -> std_printer
-    val add : string * t -> unit
-  end
-
-val declare_primitive_printer : 
-  string -> scope_name -> primitive_printer -> unit
-
-(*i
-val declare_infix_symbol : Libnames.section_path -> string -> unit
-i*)
-
-(* Generic printing functions *) 
-(*i
-val token_printer: std_printer -> std_printer
-val print_syntax_entry : 
-  string -> unparsing_subfunction -> Ast.env -> Ast.astpat syntax_entry -> std_ppcmds
-i*)
-val genprint : std_printer -> unparsing_subfunction
diff --git a/parsing/extend.ml b/parsing/extend.ml
index 2778de44..f4c98291 100644
--- a/parsing/extend.ml
+++ b/parsing/extend.ml
@@ -7,21 +7,23 @@
 (************************************************************************)
 
 
-(*i $Id: extend.ml,v 1.20.2.1 2004/07/16 19:30:37 herbelin Exp $ i*)
+(*i $Id: extend.ml 7761 2005-12-30 10:52:19Z herbelin $ i*)
 
 open Util
 open Pp
 open Gramext
 open Names
-open Ast
 open Ppextend
 open Topconstr
 open Genarg
 
-type entry_type = argument_type
+(**********************************************************************)
+(* constr entry keys                                                  *)
+
+type side = Left | Right
 
 type production_position =
-  | BorderProd of bool * Gramext.g_assoc option  (* true=left; false=right *)
+  | BorderProd of side * Gramext.g_assoc option  (* true=left; false=right *)
   | InternalProd
 
 type production_level =
@@ -37,54 +39,13 @@ type ('lev,'pos) constr_entry_key =
 
 type constr_production_entry =
     (production_level,production_position) constr_entry_key
-type constr_entry = (int,unit) constr_entry_key
-type simple_constr_production_entry = (production_level,unit) constr_entry_key
-
-type nonterm_prod =
-  | ProdList0 of nonterm_prod
-  | ProdList1 of nonterm_prod * Token.pattern list
-  | ProdOpt of nonterm_prod
-  | ProdPrimitive of constr_production_entry
-
-type prod_item =
-  | Term of Token.pattern
-  | NonTerm of constr_production_entry *
-      (Names.identifier * constr_production_entry) option
-
-type grammar_rule = {
-  gr_name : string; 
-  gr_production : prod_item list; 
-  gr_action : constr_expr }
-
-type grammar_entry = { 
-  ge_name : constr_entry;
-  gl_assoc : Gramext.g_assoc option;
-  gl_rules : grammar_rule list }
-
-type grammar_command = { 
-  gc_univ : string; 
-  gc_entries : grammar_entry list }
-
-type grammar_associativity = Gramext.g_assoc option
+type constr_entry =
+    (int,unit) constr_entry_key
+type simple_constr_production_entry =
+    (production_level,unit) constr_entry_key
 
 (**********************************************************************)
-(* Globalisation and type-checking of Grammar actions *)
-
-type entry_context = identifier list
-
-open Rawterm
-open Libnames
-
-let globalizer = ref (fun _ _ -> CHole dummy_loc)
-let set_constr_globalizer f = globalizer := f
-
-let act_of_ast vars = function
-  | SimpleAction (loc,ConstrNode a) -> !globalizer vars a
-  | SimpleAction (loc,CasesPatternNode a) -> 
-      failwith "TODO:act_of_ast: cases_pattern"
-  | CaseAction _ -> failwith "case/let not supported"
-
-let to_act_check_vars = act_of_ast
+(* syntax modifiers                                                   *)
 
 type syntax_modifier =
   | SetItemLevel of string list * production_level
@@ -94,285 +55,3 @@ type syntax_modifier =
   | SetOnlyParsing
   | SetFormat of string located
 
-type nonterm =
-  | NtShort of string
-  | NtQual of string * string
-type grammar_production =
-  | VTerm of string
-  | VNonTerm of loc * nonterm * Names.identifier option
-type raw_grammar_rule = string * grammar_production list * grammar_action
-type raw_grammar_entry = string * grammar_associativity * raw_grammar_rule list
-
-(* No kernel names in Grammar's *)
-let subst_constr_expr _ a = a
-
-let subst_grammar_rule subst gr =
-  { gr with gr_action = subst_constr_expr subst gr.gr_action }
-
-let subst_grammar_entry subst ge =
-  { ge with gl_rules = List.map (subst_grammar_rule subst) ge.gl_rules }
-
-let subst_grammar_command subst gc =
-  { gc with gc_entries = List.map (subst_grammar_entry subst) gc.gc_entries }
-
-
-(*s Terminal symbols interpretation *)
-
-let is_ident_not_keyword s =
-  match s.[0] with
-    | 'a'..'z' | 'A'..'Z' | '_' -> not (Lexer.is_keyword s)
-    | _ -> false
-
-let is_number s =
-  match s.[0] with
-    | '0'..'9' -> true
-    | _ -> false
-
-let strip s =
-  let len =
-    let rec loop i len =
-      if i = String.length s then len
-      else if s.[i] == ' ' then loop (i + 1) len
-      else loop (i + 1) (len + 1)
-    in
-    loop 0 0
-  in
-  if len == String.length s then s
-  else
-    let s' = String.create len in
-    let rec loop i i' =
-      if i == String.length s then s'
-      else if s.[i] == ' ' then loop (i + 1) i'
-      else begin s'.[i'] <- s.[i]; loop (i + 1) (i' + 1) end
-    in
-    loop 0 0
-
-let terminal s =
-  let s = strip s in
-  if s = "" then failwith "empty token";
-  if is_ident_not_keyword s then ("IDENT", s)
-  else if is_number s then ("INT", s)
-  else ("", s)
-
-(*s Non-terminal symbols interpretation *)
-
-(* For compatibility *)
-let warn nt nt' =
-  warning ("'"^nt^"' grammar entry is obsolete; use name '"^nt'^"' instead");
-  nt'
-
-let rename_command_entry nt =
-  if String.length nt >= 7 & String.sub nt 0 7 = "command"
-  then warn nt ("constr"^(String.sub nt 7 (String.length nt - 7)))
-  else if nt = "lcommand" then warn nt "lconstr"
-  else if nt = "lassoc_command4" then warn nt "lassoc_constr4"
-  else nt
-
-(* This translates constr0, constr1, ... level into camlp4 levels of constr *)
-
-let explicitize_prod_entry inj pos univ nt =
-  if univ = "prim" & nt = "var" then ETIdent else
-  if univ = "prim" & nt = "bigint" then ETBigint else
-  if univ <> "constr" then ETOther (univ,nt) else
-  match nt with
-  | "constr0" -> ETConstr (inj 0,pos)
-  | "constr1" -> ETConstr (inj 1,pos)
-  | "constr2" -> ETConstr (inj 2,pos)
-  | "constr3" -> ETConstr (inj 3,pos)
-  | "lassoc_constr4" -> ETConstr (inj 4,pos)
-  | "constr5" -> ETConstr (inj 5,pos)
-  | "constr6" -> ETConstr (inj 6,pos)
-  | "constr7" -> ETConstr (inj 7,pos)
-  | "constr8" -> ETConstr (inj 8,pos)
-  | "constr" when !Options.v7 -> ETConstr (inj 8,pos)
-  | "constr9" -> ETConstr (inj 9,pos)
-  | "constr10" | "lconstr" -> ETConstr (inj 10,pos)
-  | "pattern" -> ETPattern
-  | "ident" -> ETIdent
-  | "global" -> ETReference
-  | _ -> ETOther (univ,nt)
-
-let explicitize_entry = explicitize_prod_entry (fun x -> x) ()
-
-(* Express border sub entries in function of the from level and an assoc *)
-(* We're cheating: not necessarily the same assoc on right and left *)
-let clever_explicitize_prod_entry pos univ from en =
-  let t = explicitize_prod_entry (fun x -> NumLevel x) pos univ en in
-  match from with
-    | ETConstr (from,()) ->
-	(match t with
-	  | ETConstr (n,BorderProd (left,None))
-              when (n=NumLevel from & left) ->
-	      ETConstr (n,BorderProd (left,Some Gramext.LeftA))
-	  | ETConstr (NumLevel n,BorderProd (left,None))
-              when (n=from-1 & not left) ->
-	      ETConstr
-                (NumLevel (n+1),BorderProd (left,Some Gramext.LeftA))
-	  | ETConstr (NumLevel n,BorderProd (left,None))
-              when (n=from-1 & left) ->
-	      ETConstr
-                (NumLevel (n+1),BorderProd (left,Some Gramext.RightA))
-	  | ETConstr (n,BorderProd (left,None))
-              when (n=NumLevel from & not left) ->
-	      ETConstr (n,BorderProd (left,Some Gramext.RightA))
-	  | t -> t)
-    | _ -> t
-
-let qualified_nterm current_univ pos from = function
-  | NtQual (univ, en) ->
-      clever_explicitize_prod_entry pos univ from en
-  | NtShort en ->
-      clever_explicitize_prod_entry pos current_univ from en
-
-let check_entry check_entry_type = function
-  | ETOther (u,n) -> check_entry_type (u,n)
-  | _ -> ()
-
-let nterm loc (((check_entry_type,univ),from),pos) nont =
-  let typ = qualified_nterm univ pos from nont in
-  check_entry check_entry_type typ;
-  typ
-
-let prod_item univ env = function
-  | VTerm s -> env, Term (terminal s)
-  | VNonTerm (loc, nt, Some p) ->
-     let typ = nterm loc univ nt in
-      (p :: env, NonTerm (typ, Some (p,typ)))
-  | VNonTerm (loc, nt, None) ->
-      let typ = nterm loc univ nt in 
-      env, NonTerm (typ, None)
-
-let rec prod_item_list univ penv pil current_pos =
-  match pil with
-    | [] -> [], penv
-    | pi :: pitl ->
-	let pos = if pitl=[] then (BorderProd (false,None)) else current_pos in
-	let (env, pic) = prod_item (univ,pos) penv pi in
-	let (pictl, act_env) = prod_item_list univ env pitl InternalProd in
-        (pic :: pictl, act_env)
-
-let gram_rule univ (name,pil,act) =
-  let (pilc, act_env) = prod_item_list univ [] pil (BorderProd (true,None)) in
-  let a = to_act_check_vars act_env act in
-  { gr_name = name; gr_production = pilc; gr_action = a }
-
-let border = function
-  | NonTerm (ETConstr(_,BorderProd (_,a)),_) :: _ -> a
-  | _ -> None
-
-let clever_assoc ass g =
-  if g.gr_production <> [] then
-    (match border g.gr_production, border (List.rev g.gr_production) with
-      | Some LeftA, Some RightA -> ass (* Untractable; we cheat *)
-      | Some LeftA, _ -> Some LeftA
-      | _, Some RightA -> Some RightA
-      | _ -> Some NonA)
-  else ass
-
-let gram_entry univ (nt, ass, rl) =
-  let from = explicitize_entry (snd univ) nt in
-  let l = List.map (gram_rule (univ,from)) rl in
-  let ass = List.fold_left clever_assoc ass l in
-  { ge_name = from;
-    gl_assoc = ass;
-    gl_rules = l }
-
-let interp_grammar_command univ ge entryl =
-  { gc_univ = univ;
-    gc_entries = List.map (gram_entry (ge,univ)) entryl }
-
-(* unparsing objects *)
-
-type 'pat unparsing_hunk = 
-  | PH of 'pat * string option * parenRelation
-  | RO of string
-  | UNP_BOX of ppbox * 'pat unparsing_hunk list
-  | UNP_BRK of int * int
-  | UNP_TBRK of int * int
-  | UNP_TAB
-  | UNP_FNL
-  | UNP_SYMBOLIC of string option * string * 'pat unparsing_hunk
-
-let rec subst_hunk subst_pat subst hunk = match hunk with
-  | PH (pat,so,pr) ->
-      let pat' = subst_pat subst pat in
-	if pat'==pat then hunk else
-	  PH (pat',so,pr)
-  | RO _ -> hunk
-  | UNP_BOX (ppbox, hunkl) ->
-      let hunkl' = list_smartmap (subst_hunk subst_pat subst) hunkl in
-	if hunkl' == hunkl then hunk else
-	  UNP_BOX (ppbox, hunkl')
-  | UNP_BRK _
-  | UNP_TBRK _
-  | UNP_TAB
-  | UNP_FNL -> hunk
-  | UNP_SYMBOLIC (s1, s2, pat) ->
-      let pat' = subst_hunk subst_pat subst pat in
-	if pat' == pat then hunk else
-	  UNP_SYMBOLIC (s1, s2, pat')
-
-(* Checks if the precedence of the parent printer (None means the
-   highest precedence), and the child's one, follow the given
-   relation. *)
-
-let tolerable_prec oparent_prec_reln child_prec =
-  match oparent_prec_reln with
-    | Some (pprec, L) -> child_prec < pprec
-    | Some (pprec, E) -> child_prec <= pprec
-    | Some (_, Prec level) -> child_prec <= level
-    | _ -> true
-
-type 'pat syntax_entry = {
-  syn_id : string;
-  syn_prec: precedence;
-  syn_astpat : 'pat;
-  syn_hunks : 'pat unparsing_hunk list }
-
-let subst_syntax_entry subst_pat subst sentry = 
-  let syn_astpat' = subst_pat subst sentry.syn_astpat in
-  let syn_hunks' = list_smartmap (subst_hunk subst_pat subst) sentry.syn_hunks 
-  in
-    if syn_astpat' == sentry.syn_astpat 
-      && syn_hunks' == sentry.syn_hunks then sentry 
-    else
-      { sentry with
-	  syn_astpat = syn_astpat' ;
-	  syn_hunks = syn_hunks' ;
-      }
-      
-type 'pat syntax_command = { 
-  sc_univ : string; 
-  sc_entries : 'pat syntax_entry list }
-
-let subst_syntax_command subst_pat subst scomm = 
-  let sc_entries' = 
-    list_smartmap (subst_syntax_entry subst_pat subst) scomm.sc_entries 
-  in
-    if sc_entries' == scomm.sc_entries then scomm else
-      { scomm with sc_entries = sc_entries' }
-      
-type syntax_rule = string * Coqast.t * Coqast.t unparsing_hunk list
-type raw_syntax_entry = precedence * syntax_rule list
-
-let rec interp_unparsing env = function
-  | PH (ast,ext,pr) -> PH (Ast.val_of_ast env ast,ext,pr)
-  | UNP_BOX (b,ul) -> UNP_BOX (b,List.map (interp_unparsing env) ul)
-  | UNP_BRK _ | RO _ | UNP_TBRK _ | UNP_TAB | UNP_FNL as x -> x
-  | UNP_SYMBOLIC (x,y,u) -> UNP_SYMBOLIC (x,y,interp_unparsing env u)
-
-let rule_of_ast univ prec (s,spat,unp) =
-  let (astpat,meta_env) = Ast.to_pat [] spat in
-  let hunks = List.map (interp_unparsing meta_env) unp in
-  { syn_id = s;
-    syn_prec = prec;
-    syn_astpat = astpat;
-    syn_hunks = hunks }
-
-let level_of_ast univ (prec,rl) = List.map (rule_of_ast univ prec) rl
-
-let interp_syntax_entry univ sel =
-  { sc_univ = univ;
-    sc_entries = List.flatten (List.map (level_of_ast univ) sel)}
-
-
diff --git a/parsing/extend.mli b/parsing/extend.mli
index c5417649..80de7108 100644
--- a/parsing/extend.mli
+++ b/parsing/extend.mli
@@ -6,23 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: extend.mli,v 1.19.2.2 2005/01/21 16:42:37 herbelin Exp $ i*)
+(*i $Id: extend.mli 7761 2005-12-30 10:52:19Z herbelin $ i*)
 
-(*i*)
-open Pp
 open Util
-open Names
-open Ast
-open Coqast
-open Ppextend
-open Topconstr
-open Genarg
-(*i*)
 
-type entry_type = argument_type
+(**********************************************************************)
+(* constr entry keys                                                  *)
+
+type side = Left | Right
 
 type production_position =
-  | BorderProd of bool * Gramext.g_assoc option  (* true=left; false=right *)
+  | BorderProd of side * Gramext.g_assoc option  (* true=left; false=right *)
   | InternalProd
 
 type production_level =
@@ -38,41 +32,13 @@ type ('lev,'pos) constr_entry_key =
 
 type constr_production_entry =
     (production_level,production_position) constr_entry_key
-type constr_entry = (int,unit) constr_entry_key
-type simple_constr_production_entry = (production_level,unit) constr_entry_key
-
-type nonterm_prod =
-  | ProdList0 of nonterm_prod
-  | ProdList1 of nonterm_prod * Token.pattern list
-  | ProdOpt of nonterm_prod
-  | ProdPrimitive of constr_production_entry
-
-type prod_item =
-  | Term of Token.pattern
-  | NonTerm of constr_production_entry * 
-      (Names.identifier * constr_production_entry) option
-
-type grammar_rule = {
-  gr_name : string; 
-  gr_production : prod_item list; 
-  gr_action : constr_expr }
-
-type grammar_entry = { 
-  ge_name : constr_entry;
-  gl_assoc : Gramext.g_assoc option;
-  gl_rules : grammar_rule list }
-
-type grammar_command = { 
-  gc_univ : string; 
-  gc_entries : grammar_entry list }
-
-type grammar_associativity = Gramext.g_assoc option
+type constr_entry =
+    (int,unit) constr_entry_key
+type simple_constr_production_entry =
+    (production_level,unit) constr_entry_key
 
-(* Globalisation and type-checking of Grammar actions *)
-type entry_context = identifier list
-
-val set_constr_globalizer : 
-  (entry_context -> constr_expr -> constr_expr) -> unit
+(**********************************************************************)
+(* syntax modifiers                                                   *)
 
 type syntax_modifier =
   | SetItemLevel of string list * production_level
@@ -82,73 +48,3 @@ type syntax_modifier =
   | SetOnlyParsing
   | SetFormat of string located
 
-type nonterm =
-  | NtShort of string
-  | NtQual of string * string
-type grammar_production =
-  | VTerm of string
-  | VNonTerm of loc * nonterm * Names.identifier option
-type raw_grammar_rule = string * grammar_production list * grammar_action
-type raw_grammar_entry = string * grammar_associativity * raw_grammar_rule list
-
-val terminal : string -> string * string
-
-val rename_command_entry : string -> string
-
-val explicitize_entry : string -> string -> constr_entry
-
-val subst_grammar_command : 
-  Names.substitution -> grammar_command -> grammar_command
-
-(* unparsing objects *)
-
-type 'pat unparsing_hunk = 
-  | PH of 'pat * string option * parenRelation
-  | RO of string
-  | UNP_BOX of ppbox * 'pat unparsing_hunk list
-  | UNP_BRK of int * int
-  | UNP_TBRK of int * int
-  | UNP_TAB
-  | UNP_FNL
-  | UNP_SYMBOLIC of string option * string * 'pat unparsing_hunk
-
-(*i
-val subst_unparsing_hunk : 
-  Names.substitution -> (Names.substitution -> 'pat -> 'pat) -> 
-  'pat unparsing_hunk -> 'pat unparsing_hunk
-i*)
-
-(* Checks if the precedence of the parent printer (None means the
-   highest precedence), and the child's one, follow the given
-   relation. *)
-
-val tolerable_prec : tolerability option -> precedence -> bool
-
-type 'pat syntax_entry = {
-  syn_id : string;
-  syn_prec: precedence;
-  syn_astpat : 'pat;
-  syn_hunks : 'pat unparsing_hunk list }
-
-val subst_syntax_entry : 
-  (Names.substitution -> 'pat -> 'pat) -> 
-  Names.substitution -> 'pat syntax_entry -> 'pat syntax_entry
-
-
-type 'pat syntax_command = { 
-  sc_univ : string; 
-  sc_entries : 'pat syntax_entry list }
-
-val subst_syntax_command : 
-  (Names.substitution -> 'pat -> 'pat) -> 
-  Names.substitution -> 'pat syntax_command -> 'pat syntax_command
-
-type syntax_rule = string * Coqast.t * Coqast.t unparsing_hunk list
-type raw_syntax_entry = precedence * syntax_rule list
-
-val interp_grammar_command :
-  string -> (string * string -> unit) -> 
-      raw_grammar_entry list -> grammar_command
-
-val interp_syntax_entry :
-  string -> raw_syntax_entry list -> Ast.astpat syntax_command
diff --git a/parsing/g_ascii_syntax.ml b/parsing/g_ascii_syntax.ml
new file mode 100644
index 00000000..e6324e00
--- /dev/null
+++ b/parsing/g_ascii_syntax.ml
@@ -0,0 +1,81 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+open Pp
+open Util
+open Names
+open Pcoq
+open Rawterm
+open Topconstr
+open Libnames
+open Coqlib
+open Bigint
+
+exception Non_closed_ascii
+
+let make_dir l = make_dirpath (List.map id_of_string (List.rev l))
+let make_kn dir id = Libnames.encode_kn (make_dir dir) (id_of_string id)
+let make_path dir id = Libnames.make_path (make_dir dir) (id_of_string id)
+
+let ascii_module = ["Coq";"Strings";"Ascii"]
+
+let ascii_path = make_path ascii_module "ascii"
+
+let ascii_kn = make_kn ascii_module "ascii"
+let path_of_Ascii = ((ascii_kn,0),1)
+let static_glob_Ascii  = ConstructRef path_of_Ascii
+
+let make_reference id = find_reference "Ascii interpretation" ascii_module id
+let glob_Ascii = lazy (make_reference "Ascii")
+
+open Lazy
+
+let interp_ascii dloc p =
+  let rec aux n p = 
+     if n = 0 then [] else
+     let mp = p mod 2 in
+     RRef (dloc,if mp = 0 then glob_false else glob_true)
+     :: (aux (n-1) (p/2)) in
+  RApp (dloc,RRef(dloc,force glob_Ascii), aux 8 p)
+
+let interp_ascii_string dloc s =
+  let p = 
+    if String.length s = 1 then int_of_char s.[0]
+    else
+      if String.length s = 3 & is_digit s.[0] & is_digit s.[1] & is_digit s.[2]
+      then int_of_string s
+      else
+	user_err_loc (dloc,"interp_ascii_string",
+	  str "Expects a single character or a three-digits ascii code") in
+  interp_ascii dloc p
+
+let uninterp_ascii r =
+  let rec uninterp_bool_list n = function
+    | [] when n = 0 -> 0
+    | RRef (_,k)::l when k = glob_true  -> 1+2*(uninterp_bool_list (n-1)  l)
+    | RRef (_,k)::l when k = glob_false -> 2*(uninterp_bool_list (n-1) l)
+    | _ -> raise Non_closed_ascii in
+  try 
+    let rec aux = function
+    | RApp (_,RRef (_,k),l) when k = force glob_Ascii -> uninterp_bool_list 8 l
+    | _ -> raise Non_closed_ascii in
+    Some (aux r)
+  with 
+   Non_closed_ascii -> None
+
+let make_ascii_string n =
+  if n>=32 && n<=126 then String.make 1 (char_of_int n)
+  else Printf.sprintf "%03d" n
+
+let uninterp_ascii_string r = option_app make_ascii_string (uninterp_ascii r)
+
+let _ =
+  Notation.declare_string_interpreter "char_scope"
+    (ascii_path,ascii_module)
+    interp_ascii_string
+    ([RRef (dummy_loc,static_glob_Ascii)], uninterp_ascii_string, true)
diff --git a/parsing/g_basevernac.ml4 b/parsing/g_basevernac.ml4
deleted file mode 100644
index c4badbc3..00000000
--- a/parsing/g_basevernac.ml4
+++ /dev/null
@@ -1,524 +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        *)
-(************************************************************************)
-
-(* $Id: g_basevernac.ml4,v 1.83.2.2 2004/07/16 19:30:37 herbelin Exp $ *)
-
-open Coqast
-open Extend
-open Ppextend
-open Vernacexpr
-open Pcoq
-open Vernac_
-open Goptions
-open Constr
-open Prim
-
-let vernac_kw =
-  [ "Quit"; "Load"; "Compile"; "Fixpoint"; "CoFixpoint";
-    "Definition"; "Inductive"; "CoInductive"; 
-    "Theorem"; "Variable"; "Axiom"; "Parameter"; "Hypothesis";
-    "."; ">->" ]
-let _ = 
-  if !Options.v7 then
-    List.iter (fun s -> Lexer.add_token ("",s)) vernac_kw
-
-let class_rawexpr = Gram.Entry.create "vernac:class_rawexpr"
-let lstring = Gram.Entry.create "lstring"
-
-
-if !Options.v7 then
-GEXTEND Gram
-  GLOBAL: class_rawexpr;
-
-  class_rawexpr:
-    [ [ IDENT "FUNCLASS" -> FunClass
-      | IDENT "SORTCLASS" -> SortClass
-      | qid = global -> RefClass qid ] ]
-  ;
-END;
-
-if !Options.v7 then
-GEXTEND Gram
-  GLOBAL: command lstring;
-
-  lstring:
-    [ [ s = STRING -> s ] ]
-  ;
-  comment:
-    [ [ c = constr -> CommentConstr c
-      | s = STRING -> CommentString s
-      | n = natural -> CommentInt n ] ]
-  ;
-  command:
-    [ [ IDENT "Comments"; l = LIST0 comment -> VernacComments l
-
-      (* System directory *)
-      | IDENT "Pwd" -> VernacChdir None
-      | IDENT "Cd" -> VernacChdir None
-      | IDENT "Cd"; dir = lstring -> VernacChdir (Some dir)
-
-      (* Toplevel control *)
-      | IDENT "Drop" -> VernacToplevelControl Drop
-      | IDENT "ProtectedLoop" -> VernacToplevelControl ProtectedLoop
-      | "Quit" -> VernacToplevelControl Quit
-
-      (* Dump of the universe graph - to file or to stdout *) 
-      | IDENT "Dump"; IDENT "Universes"; fopt = OPT lstring ->
-	  VernacPrint (PrintUniverses fopt)
-
-      | IDENT "Locate"; l = locatable -> VernacLocate l
-
-      (* Managing load paths *)
-      | IDENT "Add"; IDENT "LoadPath"; dir = lstring; alias = as_dirpath ->
-	  VernacAddLoadPath (false, dir, alias)
-      | IDENT "Add"; IDENT "Rec"; IDENT "LoadPath"; dir = lstring; 
-	  alias = as_dirpath -> VernacAddLoadPath (true, dir, alias)
-      | IDENT "Remove"; IDENT "LoadPath"; dir = lstring ->
-	  VernacRemoveLoadPath dir
-
-       (* For compatibility *)
-      | IDENT "AddPath"; dir = lstring; alias = as_dirpath ->
-	  VernacAddLoadPath (false, dir, alias)
-      | IDENT "AddRecPath"; dir = lstring; alias = as_dirpath ->
-	  VernacAddLoadPath (true, dir, alias)
-      | IDENT "DelPath"; dir = lstring ->
-	  VernacRemoveLoadPath dir
-
-      (* Printing (careful factorization of entries) *)
-      | IDENT "Print"; p = printable -> VernacPrint p
-      | IDENT "Print"; qid = global -> VernacPrint (PrintName qid)
-      | IDENT "Print" -> VernacPrint PrintLocalContext 
-      | IDENT "Print"; IDENT "Module"; "Type"; qid = global -> 
-	  VernacPrint (PrintModuleType qid)
-      | IDENT "Print"; IDENT "Module"; qid = global -> 
-	  VernacPrint (PrintModule qid)
-      | IDENT "Inspect"; n = natural -> VernacPrint (PrintInspect n)
-      | IDENT "About"; qid = global -> VernacPrint (PrintAbout qid)
-
-      (* Searching the environment *)
-      | IDENT "Search"; qid = global; l = in_or_out_modules -> 
-	  VernacSearch (SearchHead qid, l)
-      | IDENT "SearchPattern"; c = constr_pattern; l = in_or_out_modules ->
-	  VernacSearch (SearchPattern c, l)
-      | IDENT "SearchRewrite"; c = constr_pattern; l = in_or_out_modules ->
-	  VernacSearch (SearchRewrite c, l)
-      | IDENT "SearchAbout"; 
-	  sl = [ "["; l = LIST1 [ r = global -> SearchRef r
-                                  | s = lstring -> SearchString s ]; "]" -> l 
-   		 | qid = global -> [SearchRef qid] ];
-	  l = in_or_out_modules -> 
-	  VernacSearch (SearchAbout sl, l)
-
-      (* TODO: rapprocher Eval et Check *)
-      | IDENT "Eval"; r = Tactic.red_expr; "in";
-	  c = constr -> VernacCheckMayEval (Some r, None, c)
-      | IDENT "Check"; c = constr ->
-	  VernacCheckMayEval (None, None, c)
-      | "Type"; c = constr -> VernacGlobalCheck c      (* pas dans le RefMan *)
-
-      | IDENT "Add"; IDENT "ML"; IDENT "Path"; dir = lstring ->
-	  VernacAddMLPath (false, dir)
-      | IDENT "Add"; IDENT "Rec"; IDENT "ML"; IDENT "Path"; dir = lstring ->
-	  VernacAddMLPath (true, dir)
-(*
-      | IDENT "SearchIsos"; c = constr -> VernacSearch (SearchIsos c)
-*)
-
-      (* Pour intervenir sur les tables de paramètres *)
-
-      | "Set"; table = IDENT; field = IDENT; v = option_value ->
-  	  VernacSetOption (SecondaryTable (table,field),v)
-      | "Set"; table = IDENT; field = IDENT; lv = LIST1 option_ref_value ->
-  	  VernacAddOption (SecondaryTable (table,field),lv)
-      | "Set"; table = IDENT; field = IDENT ->
-  	  VernacSetOption (SecondaryTable (table,field),BoolValue true)
-      | IDENT "Unset"; table = IDENT; field = IDENT ->
-  	  VernacUnsetOption (SecondaryTable (table,field))
-      | IDENT "Unset"; table = IDENT; field = IDENT; lv = LIST1 option_ref_value ->
-  	  VernacRemoveOption (SecondaryTable (table,field),lv)
-      | "Set"; table = IDENT; value = option_value ->
-  	  VernacSetOption (PrimaryTable table, value)
-      | "Set"; table = IDENT ->
-  	  VernacSetOption (PrimaryTable table, BoolValue true)
-      | IDENT "Unset"; table = IDENT ->
-  	  VernacUnsetOption (PrimaryTable table)
-
-      | IDENT "Print"; IDENT "Table"; table = IDENT; field = IDENT ->
-	  VernacPrintOption (SecondaryTable (table,field))
-      | IDENT "Print"; IDENT "Table"; table = IDENT ->
-	  VernacPrintOption (PrimaryTable table)
-
-      | IDENT "Add"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
-        -> VernacAddOption (SecondaryTable (table,field), v)
-
-      (* Un value global ci-dessous va être caché par un field au dessus! *)
-      | IDENT "Add"; table = IDENT; v = LIST1 option_ref_value ->
-          VernacAddOption (PrimaryTable table, v)
-
-      | IDENT "Test"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
-        -> VernacMemOption (SecondaryTable (table,field), v)
-      | IDENT "Test"; table = IDENT; field = IDENT ->
-          VernacPrintOption (SecondaryTable (table,field))
-      | IDENT "Test"; table = IDENT; v = LIST1 option_ref_value ->
-          VernacMemOption (PrimaryTable table, v)
-      | IDENT "Test"; table = IDENT ->
-          VernacPrintOption (PrimaryTable table)
-
-      | 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) ] ]
-  ;
-  printable:
-    [ [ IDENT "Term"; qid = global -> PrintOpaqueName qid
-      | IDENT "All" -> PrintFullContext
-      | IDENT "Section"; s = global -> PrintSectionContext s
-      | IDENT "Grammar"; uni = IDENT; ent = IDENT ->
-          (* This should be in "syntax" section but is here for factorization*)
-	  PrintGrammar (uni, ent)
-      | IDENT "LoadPath" -> PrintLoadPath
-      | IDENT "Modules" -> PrintModules
-
-      | IDENT "ML"; IDENT "Path" -> PrintMLLoadPath
-      | IDENT "ML"; IDENT "Modules" -> PrintMLModules
-      | IDENT "Graph" -> PrintGraph
-      | IDENT "Classes" ->  PrintClasses
-      | IDENT "Coercions" -> PrintCoercions
-      | IDENT "Coercion"; IDENT "Paths"; s = class_rawexpr; t = class_rawexpr
-         -> PrintCoercionPaths (s,t)
-      | IDENT "Tables" -> PrintTables
-      | "Proof"; qid = global -> PrintOpaqueName qid
-      | IDENT "Hint" -> PrintHintGoal
-      | IDENT "Hint"; qid = global -> PrintHint qid
-      | IDENT "Hint"; "*" -> PrintHintDb
-      | IDENT "HintDb"; s = IDENT -> PrintHintDbName s
-      | IDENT "Scopes" -> PrintScopes
-      | IDENT "Scope"; s = IDENT -> PrintScope s
-      | IDENT "Visibility"; s = OPT IDENT -> PrintVisibility s
-      | IDENT "Implicit"; qid = global -> PrintImplicit qid ] ]
-  ;
-  locatable:
-    [ [ qid = global -> LocateTerm qid
-      | IDENT "File"; f = lstring -> LocateFile f
-      | IDENT "Library"; qid = global -> LocateLibrary  qid
-      | s = lstring -> LocateNotation s ] ]
-  ;
-  option_value:
-    [ [ n  = integer   -> IntValue n
-      | s  = lstring    -> StringValue s ] ]
-  ;
-  option_ref_value:
-    [ [ id = global   -> QualidRefValue id
-      | s  = lstring   -> StringRefValue s ] ]
-  ;
-  as_dirpath:
-    [ [ d = OPT [ "as"; d = dirpath -> d ] -> d ] ]
-  ;
-  in_or_out_modules:
-    [ [ IDENT "inside"; l = LIST1 global -> SearchInside l
-      | IDENT "outside"; l = LIST1 global -> SearchOutside l
-      | -> SearchOutside [] ] ]
-  ;
-END
-
-(* Grammar extensions *)
-
-(* automatic translation of levels *)
-let adapt_level n =
-  if n >= 10 then n*10 else
-    [| 0; 20; 30; 40; 50; 70; 80; 85; 90; 95; 100|].(n)
-
-let map_modl = function
-  | SetItemLevel(ids,NumLevel n) -> SetItemLevel(ids,NumLevel (adapt_level n))
-  | SetLevel n -> SetLevel(adapt_level n)
-  | m -> m
-	  
-if !Options.v7 then
-GEXTEND Gram
-  GLOBAL: syntax;
-
-  univ:
-  [ [ univ = IDENT ->
-        set_default_action_parser (parser_type_from_name univ); univ ] ]
-  ;
-  syntax:
-   [ [ IDENT "Token"; s = lstring ->
-       Pp.warning "Token declarations are now useless"; VernacNop
-
-     | IDENT "Grammar"; IDENT "tactic"; IDENT "simple_tactic";
-        OPT [ ":"; IDENT "tactic" ]; ":=";
-        OPT "|"; tl = LIST0 grammar_tactic_rule SEP "|" -> 
-	  VernacTacticGrammar tl
-
-     | IDENT "Grammar"; u = univ;
-         tl = LIST1 grammar_entry SEP "with" -> 
-	   VernacGrammar (rename_command_entry u,tl)
-
-     | IDENT "Syntax"; u = univ; el = LIST1 syntax_entry SEP ";" ->
-         VernacSyntax (u,el)
-
-     | IDENT "Uninterpreted"; IDENT "Notation"; local = locality; s = lstring; 
-	 modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
-         (s8,mv8) =
-             [IDENT "V8only";
-              s8=OPT lstring;
-              mv8=OPT["(";mv8=LIST1 syntax_modifier SEP ","; ")" -> mv8] ->
-                (s8,mv8)
-             | -> (None,None)] ->
-               let s8 = match s8 with Some s -> s | _ -> s in
-               let mv8 = match mv8 with
-                   Some mv8 -> mv8
-                 | _ -> List.map map_modl modl in
-	       VernacSyntaxExtension (local,Some (s,modl),Some(s8,mv8))
-
-     | IDENT "Uninterpreted"; IDENT "V8Notation"; local = locality; s = lstring; 
-	 modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ] ->
-	   VernacSyntaxExtension (local,None,Some(s,modl))
-
-     | IDENT "Open"; local = locality; IDENT "Scope"; 
-	 sc = IDENT -> VernacOpenCloseScope (local,true, sc)
-
-     | IDENT "Close"; local = locality; IDENT "Scope"; 
-	 sc = IDENT -> VernacOpenCloseScope (local,false,sc)
-
-     | IDENT "Delimits"; IDENT "Scope"; sc = IDENT; "with"; key = IDENT ->
-	 VernacDelimiters (sc,key)
-
-     | IDENT "Bind"; IDENT "Scope"; sc = IDENT; "with"; 
-       refl = LIST1 class_rawexpr -> VernacBindScope (sc,refl)
-
-     | IDENT "Arguments"; IDENT "Scope"; qid = global;
-         "["; scl = LIST0 opt_scope; "]" -> VernacArgumentsScope (qid,scl)
-
-     | IDENT "Infix"; local = locality; a = entry_prec; n = OPT natural;
-         op = lstring; 
-         p = global;
-         modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
-	 sc = OPT [ ":"; sc = IDENT -> sc];
-         mv8 =
-              [IDENT "V8only";
-               a8=entry_prec;
-               n8=OPT natural;
-	       op8=OPT lstring;
-               mv8=["("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> []]
-		->
-		 (match (a8,n8,mv8,op8) with
-		   | None,None,[],None -> None
-		   | _,_,mv8,_ ->
-		       Some(op8,Metasyntax.merge_modifiers a8 n8 mv8))
-              | -> (* Means: rules are based on V7 rules *)
-		  Some (None,[]) ] ->
-		let mv = Metasyntax.merge_modifiers a n modl in
-		let v8 = Util.option_app (function (op8,mv8) ->
-		  let op8 = match op8 with None -> op | Some op -> op in
-		  let mv8 =
-		    if mv8=[] then
-		      let mv8 = List.map map_modl mv in
-		      let mv8 =	if List.for_all
-			(function SetLevel _ -> false | _ -> true) mv8
-		      then SetLevel 10 :: mv8 else mv8 in
-		      let mv8 = if List.for_all
-			(function SetAssoc _ -> false | _ -> true) mv8
-		      then SetAssoc Gramext.LeftA :: mv8 else mv8 in
-		      mv8
-		  else mv8 in
-		  (op8,mv8)) mv8 in
-		VernacInfix (local,(op,mv),p,v8,sc)
-     | IDENT "Distfix"; local = locality; a = entry_prec; n = natural; 
-	   s = lstring; p = global; sc = OPT [ ":"; sc = IDENT -> sc ] ->
-             let (a,s,c) = Metasyntax.translate_distfix a s p in
-	     let mv = Some(s,[SetLevel n;SetAssoc a]) in
-             VernacNotation (local,c,mv,mv,sc)
-(*
-	     VernacDistfix (local,a,n,s,p,sc)
-*)
-     | IDENT "Notation"; local = locality; id = ident; ":="; c = constr;
-         b = [ "("; IDENT "only"; IDENT "parsing"; ")" -> true | -> false ] ->
-	 VernacSyntacticDefinition (id,c,local,b)
-     | IDENT "Notation"; local = locality; s = lstring; ":="; c = constr;
-         modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
-	 sc = OPT [ ":"; sc = IDENT -> sc ];
-         (s8,mv8) =
-             [IDENT "V8only";
-              s8=OPT lstring;
-              mv8=OPT["(";mv8=LIST1 syntax_modifier SEP ","; ")" -> mv8] ->
-		(s8,mv8)
-             | -> (* Means: rules are based on V7 rules *)
-		 None, Some [] ] ->
-	       let smv8 = match s8,mv8 with
-		 | None, None -> None   (* = only interpretation *)
-		 | Some s8, None -> Some (s8,[]) (* = only interp, new s *)
-		 | None, Some [] -> Some (s,List.map map_modl modl) (*like v7*)
-		 | None, Some mv8 -> Some (s,mv8) (* s like v7 *)
-		 | Some s8, Some mv8 -> Some (s8,mv8) in
-               VernacNotation (local,c,Some(s,modl),smv8,sc)
-     | IDENT "V8Notation"; local = locality; s = lstring; ":="; c = constr;
-         modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
-	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
-         VernacNotation (local,c,None,Some(s,modl),sc)
-
-     | IDENT "V8Infix"; local = locality; op8 = lstring; p = global;
-         modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
-	 sc = OPT [ ":"; sc = IDENT -> sc] ->
-           let mv8 = Metasyntax.merge_modifiers None None modl in
-           VernacInfix (local,("",[]),p,Some (op8,mv8),sc)
-
-     (* "Print" "Grammar" should be here but is in "command" entry in order 
-        to factorize with other "Print"-based vernac entries *)
-  ] ]
-  ;
-  locality:
-    [ [ IDENT "Local" -> true | -> false ] ]
-  ;
-  level:
-    [ [ IDENT "level"; n = natural -> NumLevel n
-      | IDENT "next"; IDENT "level" -> NextLevel ] ]
-  ;
-  syntax_modifier:
-    [ [ x = IDENT; IDENT "at"; lev = level -> SetItemLevel ([x],lev)
-      | x = IDENT; ","; l = LIST1 IDENT SEP ","; IDENT "at"; lev = level ->
-          SetItemLevel (x::l,lev)
-      | IDENT "at"; IDENT "level"; n = natural -> SetLevel n
-      | IDENT "left"; IDENT "associativity" -> SetAssoc Gramext.LeftA
-      | IDENT "right"; IDENT "associativity" -> SetAssoc Gramext.RightA
-      | IDENT "no"; IDENT "associativity" -> SetAssoc Gramext.NonA
-      | x = IDENT; typ = syntax_extension_type -> SetEntryType (x,typ)
-      | IDENT "only"; IDENT "parsing" -> SetOnlyParsing
-      | IDENT "format"; s = [s = lstring -> (loc,s)] -> SetFormat s ] ]
-  ;
-  syntax_extension_type:
-    [ [ IDENT "ident" -> ETIdent | IDENT "global" -> ETReference
-      | IDENT "bigint" -> ETBigint
-      | i=IDENT -> ETOther ("constr",i)
-    ] ]
-  ;
-  opt_scope:
-    [ [ IDENT "_" -> None | sc = IDENT -> Some sc ] ]
-  ;
-  (* Syntax entries for Grammar. Only grammar_entry is exported *)
-  grammar_entry:
-    [[ nont = IDENT; set_entry_type; ":=";
-       ep = entry_prec; OPT "|"; rl = LIST0 grammar_rule SEP "|" ->
-	 (rename_command_entry nont,ep,rl) ]]
-  ;
-  entry_prec:
-    [[ IDENT "LEFTA" -> Some Gramext.LeftA
-     | IDENT "RIGHTA" -> Some Gramext.RightA
-     | IDENT "NONA" -> Some Gramext.NonA
-     | -> None ]]
-  ;
-  grammar_tactic_rule:
-    [[ name = rule_name; "["; s = lstring; pil = LIST0 production_item; "]";
-       "->"; "["; t = Tactic.tactic; "]"  -> (name, (s,pil), t) ]]
-  ;
-  grammar_rule:
-    [[ name = rule_name; "["; pil = LIST0 production_item; "]"; "->";
-       a = action -> (name, pil, a) ]]
-  ;
-  rule_name:
-    [[ name = IDENT -> name ]]
-  ;
-  production_item:
-    [[ s = lstring -> VTerm s
-     | nt = non_terminal; po = OPT [ "("; p = METAIDENT; ")" -> p ] ->
-         match po with
-           | Some p -> VNonTerm (loc,nt,Some (Names.id_of_string p))
-           | _ -> VNonTerm (loc,nt,None) ]]
-  ;
-  non_terminal:
-    [[ u = IDENT; ":"; nt = IDENT ->
-        NtQual(rename_command_entry u, rename_command_entry nt)
-     | nt = IDENT -> NtShort (rename_command_entry nt) ]]
-  ;
-
-
-  (* Syntax entries for Syntax. Only syntax_entry is exported *)
-  syntax_entry:
-    [ [ IDENT "level"; p = precedence; ":";
-	OPT "|"; rl = LIST1 syntax_rule SEP "|" -> (p,rl) ] ]
-  ;
-  syntax_rule:
-    [ [ nm = IDENT; "["; s = astpat; "]"; "->"; u = unparsing -> (nm,s,u) ] ]
-  ;
-  precedence:
-    [ [ a = natural -> a
-(*      | "["; a1 = natural; a2 = natural; a3 = natural; "]" -> (a1,a2,a3)*)
-    ] ]
-  ;
-  unparsing:
-    [ [ "["; ll = LIST0 next_hunks; "]" -> ll ] ]
-  ;
-  next_hunks:
-    [ [ IDENT "FNL" -> UNP_FNL
-      | IDENT "TAB" -> UNP_TAB
-      | c = lstring -> RO c
-      | "[";
-        x =
-          [ b = box; ll = LIST0 next_hunks -> UNP_BOX (b,ll)
-          | n = natural; m = natural -> UNP_BRK (n, m)
-          | IDENT "TBRK"; n = natural; m = natural -> UNP_TBRK (n, m) ];
-        "]" -> x
-      | e = Prim.ast; oprec = OPT [ ":"; pr = paren_reln_or_extern -> pr ] ->
-          match oprec with
-	    | Some (ext,pr) -> PH (e,ext,pr)
-            | None -> PH (e,None,Any)
- ]]
-  ;
-  box:
-    [ [ "<"; bk = box_kind; ">" -> bk ] ]
-  ;
-  box_kind:
-    [ [ IDENT "h"; n = natural -> PpHB n
-      | IDENT "v"; n = natural -> PpVB n
-      | IDENT "hv"; n = natural -> PpHVB n
-      | IDENT "hov"; n = natural -> PpHOVB n
-      | IDENT "t" -> PpTB ] ]
-  ;
-  paren_reln_or_extern:
-    [ [ IDENT "L" -> None, L
-      | IDENT "E" -> None, E
-      | pprim = lstring; precrec = OPT [ ":"; p = precedence -> p ] ->
-	  match precrec with
-	    | Some p -> Some pprim, Prec p
-            | None -> Some pprim, Any ] ]
-  ;
-  (* meta-syntax entries *)
-  astpat:
-    [ [ "<<" ; a = Prim.ast; ">>" -> a 
-      | a = Constr.constr -> 
-	  Termast.ast_of_rawconstr 
-	  (Constrintern.interp_rawconstr Evd.empty (Global.env()) a)
-    ] ]
-  ; 
-  action:
-    [ [ IDENT "let"; p = Prim.astlist; et = set_internal_entry_type;
-        "="; e1 = action; "in"; e = action -> Ast.CaseAction (loc,e1,et,[p,e])
-      | IDENT "case"; a = action; et = set_internal_entry_type; "of";
-        cl = LIST1 case SEP "|"; IDENT "esac" -> Ast.CaseAction (loc,a,et,cl)
-      | "["; a = default_action_parser; "]" -> Ast.SimpleAction (loc,a) ] ]
-  ;
-  case:
-    [[ p = Prim.astlist; "->"; a = action -> (p,a) ]]
-  ;
-  set_internal_entry_type:
-    [[ ":"; IDENT "ast"; IDENT "list" -> Ast.ETastl
-     | [ ":"; IDENT "ast" -> () | -> () ] -> Ast.ETast ]]
-  ;
-  set_entry_type:
-    [[ ":"; et = entry_type -> set_default_action_parser et
-     | -> () ]]
-  ;
-  entry_type:
-    [[ IDENT "ast"; IDENT "list" -> Util.error "type ast list no longer supported"
-     | IDENT "ast" -> Util.error "type ast no longer supported"
-     | IDENT "constr" -> ConstrParser
-     | IDENT "pattern" -> CasesPatternParser
-     | IDENT "tactic" -> assert false
-     | IDENT "vernac" -> Util.error "vernac extensions no longer supported" ] ]
-  ;
-END
diff --git a/parsing/g_cases.ml4 b/parsing/g_cases.ml4
deleted file mode 100644
index b952305d..00000000
--- a/parsing/g_cases.ml4
+++ /dev/null
@@ -1,73 +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        *)
-(************************************************************************)
-
-(* $Id: g_cases.ml4,v 1.27.2.1 2004/07/16 19:30:38 herbelin Exp $ *)
-
-open Pcoq
-open Constr
-open Topconstr
-open Term
-open Libnames
-
-open Prim
-
-let pair loc =
-  Qualid (loc, Libnames.qualid_of_string "Coq.Init.Datatypes.pair")
-
-if !Options.v7 then
-GEXTEND Gram
-  GLOBAL: operconstr pattern;
-
-  pattern:
-    [ [ r = Prim.reference -> CPatAtom (loc,Some r)
-      | IDENT "_" -> CPatAtom (loc,None)
-      (* Hack to parse syntax "(n)" as a natural number *)
-      | "("; G_constr.test_int_rparen; n = bigint; ")" ->
-	  (* Delimiter "N" moved to "nat" in V7 *)
-          CPatDelimiters (loc,"nat",CPatNumeral (loc,n))
-      | "("; p = compound_pattern; ")" -> p
-      | n = bigint -> CPatNumeral (loc,n)
-      | "'"; G_constr.test_ident_colon; key = IDENT; ":"; c = pattern; "'" -> 
-          CPatDelimiters (loc,key,c)
-    ] ]
-  ;
-  compound_pattern:
-    [ [ p = pattern ; lp = LIST1 pattern ->
-        (match p with
-          | CPatAtom (_, Some r) -> CPatCstr (loc, r, lp)
-          | _ -> Util.user_err_loc 
-              (loc, "compound_pattern", Pp.str "Constructor expected"))
-      | p = pattern; "as"; id = base_ident ->
-	  CPatAlias (loc, p, id)
-      | p1 = pattern; ","; p2 = pattern ->
-	  CPatCstr (loc, pair loc, [p1; p2])
-      | p = pattern -> p ] ]
-  ;
-  equation:
-    [ [ lhs = LIST1 pattern; "=>"; rhs = operconstr LEVEL "9" -> (loc,lhs,rhs) ] ]
-  ;
-  ne_eqn_list:
-    [ [ leqn = LIST1 equation SEP "|" -> leqn ] ]
-  ;
-  operconstr: LEVEL "1"
-    [ [ "<"; p = annot; ">"; "Cases"; lc = LIST1 constr; "of";
-        OPT "|"; eqs = ne_eqn_list; "end" ->
-          let lc = List.map (fun c -> c,(None,None)) lc in
-	  CCases (loc, (Some p,None), lc, eqs)
-      | "Cases"; lc = LIST1 constr; "of";
-	OPT "|"; eqs = ne_eqn_list; "end" ->
-          let lc = List.map (fun c -> c,(None,None)) lc in
-	  CCases (loc, (None,None), lc, eqs)
-      | "<"; p = annot; ">"; "Cases"; lc = LIST1 constr; "of"; "end" ->
-          let lc = List.map (fun c -> c,(None,None)) lc in
-	  CCases (loc, (Some p,None), lc, [])
-      | "Cases"; lc = LIST1 constr; "of"; "end" -> 
-          let lc = List.map (fun c -> c,(None,None)) lc in
-	  CCases (loc, (None,None), lc, []) ] ]
-  ;
-END;
diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4
index 80dc69f1..9f7f7304 100644
--- a/parsing/g_constr.ml4
+++ b/parsing/g_constr.ml4
@@ -6,129 +6,129 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_constr.ml4,v 1.52.2.2 2004/11/17 12:48:35 herbelin Exp $ *)
+(* $Id: g_constr.ml4 8624 2006-03-13 17:38:17Z msozeau $ *)
 
 open Pcoq
 open Constr
+open Prim
 open Rawterm
 open Term
 open Names
 open Libnames
-open Prim
 open Topconstr
 
-(* Initialize the lexer *)
+open Util
+
 let constr_kw =
-  [ "Cases"; "of"; "with"; "end"; "as"; "in"; "Prop"; "Set"; "Type";
-    ":"; "("; ")"; "["; "]"; "{"; "}"; ","; ";"; "->"; "="; ":="; "!";
-    "::"; "<:"; ":<"; "=>"; "<"; ">"; "|"; "?"; "/";
-    "<->"; "\\/"; "/\\"; "`"; "``"; "&"; "*"; "+"; "@"; "^"; "#"; "-";
-    "~"; "'"; "<<"; ">>"; "<>"; ".."
-  ]
-let _ =
-  if !Options.v7 then
-  List.iter (fun s -> Lexer.add_token ("",s)) constr_kw
-(* "let" is not a keyword because #Core#let.cci would not parse.
-   Is it still accurate ? *)
+  [ "forall"; "fun"; "match"; "fix"; "cofix"; "with"; "in"; "for"; 
+    "end"; "as"; "let"; "if"; "then"; "else"; "return";
+    "Prop"; "Set"; "Type"; ".("; "_"; ".." ]
 
+let _ = List.iter (fun s -> Lexer.add_token("",s)) constr_kw
 
-let coerce_to_var = function
-  | CRef (Ident (_,id)) -> id
-  | ast -> Util.user_err_loc
-        (constr_loc ast,"Ast.coerce_to_var",
-         (Pp.str"This expression should be a simple identifier"))
+let mk_cast = function
+    (c,(_,None)) -> c
+  | (c,(_,Some ty)) -> CCast(join_loc (constr_loc c) (constr_loc ty), c, DEFAULTcast,ty)
 
-let coerce_to_name = function
-  | CRef (Ident (loc,id)) -> (loc, Name id)
-  | ast -> Util.user_err_loc
-        (constr_loc ast,"Ast.coerce_to_var",
-         (Pp.str"This expression should be a simple identifier"))
+let mk_lam = function
+    ([],c) -> c
+  | (bl,c) -> CLambdaN(constr_loc c, bl,c)
 
-let set_loc loc = function
-  | CRef(Ident(_,i)) -> CRef(Ident(loc,i))
-  | CRef(Qualid(_,q)) -> CRef(Qualid(loc,q))
-  | CFix(_,x,a) -> CFix(loc,x,a)
-  | CCoFix(_,x,a) -> CCoFix(loc,x,a)
-  | CArrow(_,a,b) -> CArrow(loc,a,b)
-  | CProdN(_,bl,a) -> CProdN(loc,bl,a)
-  | CLambdaN(_,bl,a) -> CLambdaN(loc,bl,a)
-  | CLetIn(_,x,a,b) -> CLetIn(loc,x,a,b)
-  | CAppExpl(_,f,a) -> CAppExpl(loc,f,a)
-  | CApp(_,f,a) -> CApp(loc,f,a)
-  | CCases(_,p,a,br) -> CCases(loc,p,a,br)
-  | COrderedCase(_,s,p,a,br) -> COrderedCase(loc,s,p,a,br)
-  | CLetTuple(_,ids,p,a,b) -> CLetTuple(loc,ids,p,a,b)
-  | CIf(_,e,p,a,b) -> CIf(loc,e,p,a,b)
-  | CHole _ -> CHole loc
-  | CPatVar(_,v) -> CPatVar(loc,v)
-  | CEvar(_,ev) -> CEvar(loc,ev)
-  | CSort(_,s) -> CSort(loc,s)
-  | CCast(_,a,b) -> CCast(loc,a,b)
-  | CNotation(_,n,l) -> CNotation(loc,n,l)
-  | CNumeral(_,i) -> CNumeral(loc,i)
-  | CDelimiters(_,s,e) -> CDelimiters(loc,s,e)
-  | CDynamic(_,d) -> CDynamic(loc,d)
+let loc_of_binder_let = function
+  | LocalRawAssum ((loc,_)::_,_)::_ -> loc
+  | LocalRawDef ((loc,_),_)::_ -> loc
+  | _ -> dummy_loc
 
-open Util
+let rec mkCProdN loc bll c =
+  match bll with
+  | LocalRawAssum ((loc1,_)::_ as idl,t) :: bll -> 
+      CProdN (loc,[idl,t],mkCProdN (join_loc loc1 loc) bll c)
+  | LocalRawDef ((loc1,_) as id,b) :: bll -> 
+      CLetIn (loc,id,b,mkCProdN (join_loc loc1 loc) bll c)
+  | [] -> c
+  | LocalRawAssum ([],_) :: bll -> mkCProdN loc bll c
 
-let rec abstract_constr loc c = function
+let rec mkCLambdaN loc bll c =
+  match bll with
+  | LocalRawAssum ((loc1,_)::_ as idl,t) :: bll -> 
+      CLambdaN (loc,[idl,t],mkCLambdaN (join_loc loc1 loc) bll c)
+  | LocalRawDef ((loc1,_) as id,b) :: bll -> 
+      CLetIn (loc,id,b,mkCLambdaN (join_loc loc1 loc) bll c)
   | [] -> c
-  | LocalRawDef ((loc',x),b)::bl ->
-      CLetIn (join_loc loc' loc, (loc', x), b, abstract_constr loc c bl)
-  | LocalRawAssum (nal,t)::bl ->
-      let loc' = join_loc (fst (List.hd nal)) loc in
-      CLambdaN(loc', [nal, t], abstract_constr loc c bl)
+  | LocalRawAssum ([],_) :: bll -> mkCLambdaN loc bll c
 
-(* Hack to parse "(n)" as nat without conflicts with the (useless) *)
-(* admissible notation "(n)" *)
-let test_int_rparen =
-  Gram.Entry.of_parser "test_int_rparen"
-    (fun strm ->
-      match Stream.npeek 1 strm with
-        | [("INT", _)] ->
-            begin match Stream.npeek 2 strm with
-              | [_; ("", ")")] -> ()
-              | _ -> raise Stream.Failure
-            end
-        | _ -> raise Stream.Failure)
+let rec index_and_rec_order_of_annot loc bl ann =
+  match names_of_local_assums bl,ann with
+    | [_], (None, r) -> 0, r
+    | lids, (Some x, ro) ->
+        let ids = List.map snd lids in
+        (try list_index (snd x) ids - 1, ro
+        with Not_found ->
+          user_err_loc(fst x,"index_of_annot", Pp.str"no such fix variable"))
+    | _ -> user_err_loc(loc,"index_of_annot",
+      Pp.str "cannot guess decreasing argument of fix")
 
-(* Hack to parse "n" at level 0 without conflicting with "n!" at level 91 *)
-(* admissible notation "(n)" *)
-let test_int_bang =
-  Gram.Entry.of_parser "test_int_bang"
-    (fun strm ->
-      match Stream.npeek 1 strm with
-        | [("INT", n)] ->
-            begin match Stream.npeek 2 strm with
-              | [_; ("", "!")] -> ()
-              | _ -> raise Stream.Failure
-            end
-        | _ -> raise Stream.Failure)
+let mk_fixb (id,bl,ann,body,(loc,tyc)) =
+  let n,ro = index_and_rec_order_of_annot (fst id) bl ann in
+  let ty = match tyc with
+      Some ty -> ty
+    | None -> CHole loc in
+  (snd id,(n,ro),bl,ty,body)
+
+let mk_cofixb (id,bl,ann,body,(loc,tyc)) =
+  let _ = option_app (fun (aloc,_) ->
+    Util.user_err_loc
+      (aloc,"Constr:mk_cofixb",
+       Pp.str"Annotation forbidden in cofix expression")) (fst ann) in
+  let ty = match tyc with
+      Some ty -> ty
+    | None -> CHole loc in
+  (snd id,bl,ty,body)
+
+let mk_fix(loc,kw,id,dcls) =
+  if kw then 
+    let fb = List.map mk_fixb dcls in
+    CFix(loc,id,fb)
+  else
+    let fb = List.map mk_cofixb dcls in
+    CCoFix(loc,id,fb)
+
+let mk_single_fix (loc,kw,dcl) =
+  let (id,_,_,_,_) = dcl in mk_fix(loc,kw,id,[dcl])
 
-(* Hack to parse "`id:...`" at level 0 without conflicting with
-   "`...`" from ZArith *)
-let test_ident_colon =
-  Gram.Entry.of_parser "test_ident_colon"
+let binder_constr =
+  create_constr_entry (get_univ "constr") "binder_constr"
+
+(* Hack to parse "(x:=t)" as an explicit argument without conflicts with the *)
+(* admissible notation "(x t)" *)
+let lpar_id_coloneq =
+  Gram.Entry.of_parser "test_lpar_id_coloneq"
     (fun strm ->
       match Stream.npeek 1 strm with
-        | [("IDENT", _)] ->
-            begin match Stream.npeek 2 strm with
-              | [_; ("", ":")] -> ()
-              | _ -> raise Stream.Failure
-            end
+        | [("","(")] ->
+            (match Stream.npeek 2 strm with
+	      | [_; ("IDENT",s)] ->
+                  (match Stream.npeek 3 strm with
+                    | [_; _; ("", ":=")] ->
+                        Stream.junk strm; Stream.junk strm; Stream.junk strm;
+                        Names.id_of_string s
+	            | _ -> raise Stream.Failure)
+              | _ -> raise Stream.Failure)
         | _ -> raise Stream.Failure)
 
 
-if !Options.v7 then
 GEXTEND Gram
-  GLOBAL: operconstr lconstr constr sort global constr_pattern Constr.ident annot
-          (*ne_name_comma_list*);
+  GLOBAL: binder_constr lconstr constr operconstr sort global
+  constr_pattern lconstr_pattern Constr.ident binder binder_let pattern;
   Constr.ident:
     [ [ id = Prim.ident -> id
 
       (* This is used in quotations and Syntax *)
       | id = METAIDENT -> id_of_string id ] ]
   ;
+  Prim.name:
+    [ [ "_" -> (loc, Anonymous) ] ]
+  ;
   global:
     [ [ r = Prim.reference -> r
 
@@ -138,231 +138,197 @@ GEXTEND Gram
   constr_pattern:
     [ [ c = constr -> c ] ]
   ;
-  ne_constr_list:
-    [ [ cl = LIST1 constr -> cl ] ]
+  lconstr_pattern:
+    [ [ c = lconstr -> c ] ]
   ;
   sort:
     [ [ "Set"  -> RProp Pos
       | "Prop" -> RProp Null
       | "Type" -> RType None ] ]
   ;
-  constr:
-    [ [ c = operconstr LEVEL "8" -> c ] ]
-  ;
   lconstr:
-    [ [ c = operconstr LEVEL "10" -> c ] ]
+    [ [ c = operconstr LEVEL "200" -> c ] ]
+  ;
+  constr:
+    [ [ c = operconstr LEVEL "9" -> c ] ]
   ;
   operconstr:
-    [ "10" RIGHTA
-      [ "!"; f = global; args = LIST0 (operconstr LEVEL "9") ->
-          CAppExpl (loc, (None,f), args)
-(*
-      | "!"; f = global; "with"; b = binding_list ->
-	  <:ast< (APPLISTWITH $f $b) >>
-*)
-      | f = operconstr; args = LIST1 constr91 -> CApp (loc, (None,f), args) ]
-    | "9" RIGHTA
-      [ c1 = operconstr; "::"; c2 = operconstr LEVEL "9" -> CCast (loc, c1, c2) ]
-    | "8" RIGHTA
-      [ c1 = operconstr; "->"; c2 = operconstr LEVEL "8"-> CArrow (loc, c1, c2) ]
-    | "1" RIGHTA
-      [ "<"; p = annot; ">"; IDENT "Match"; c = constr; "with";
-        cl = LIST0 constr; "end" ->
-	  COrderedCase (loc, MatchStyle, Some p, c, cl)
-      | "<"; p = annot; ">"; IDENT "Case"; c = constr; "of";
-        cl = LIST0 constr; "end" ->
-	  COrderedCase (loc, RegularStyle, Some p, c, cl)
-      | IDENT "Case"; c = constr; "of"; cl = LIST0 constr; "end" ->
-          COrderedCase (loc, RegularStyle, None, c, cl)
-      | IDENT "Match"; c = constr; "with"; cl = LIST1 constr; "end" ->
-          COrderedCase (loc, MatchStyle, None, c, cl)
-      | IDENT "let"; "("; b = ne_name_comma_list; ")"; "=";
-        c = constr; "in"; c1 = constr ->
-          (* TODO: right loc *)
-	  COrderedCase
-            (loc, LetStyle, None, c, [CLambdaN (loc, [b, CHole loc], c1)])
-      | IDENT "let"; na = name; "="; c = opt_casted_constr; 
-	"in"; c1 = constr ->
-          CLetIn (loc, na, c, c1)
-      | IDENT "if"; c1 = constr;
-        IDENT "then"; c2 = constr;
-        IDENT "else"; c3 = constr ->
-	  COrderedCase (loc, IfStyle, None, c1, [c2; c3])
-      | "<"; p = annot; ">";
-        IDENT "let"; "("; b = ne_name_comma_list; ")"; "="; c = constr; 
-        "in"; c1 = constr ->
-          (* TODO: right loc *)
-	  COrderedCase (loc, LetStyle, Some p, c,
-            [CLambdaN (loc, [b, CHole loc], c1)])
-      | "<"; p = annot; ">";
-        IDENT "if"; c1 = constr;
-        IDENT "then"; c2 = constr; 
-        IDENT "else"; c3 = constr ->
-	  COrderedCase (loc, IfStyle, Some p, c1, [c2; c3])
-      | ".."; c = operconstr LEVEL "0"; ".." ->
+    [ "200" RIGHTA
+      [ c = binder_constr -> c ]
+    | "100" RIGHTA
+      [ c1 = operconstr; ":"; c2 = binder_constr -> CCast(loc,c1,DEFAULTcast,c2)
+      | c1 = operconstr; ":"; c2 = SELF -> CCast(loc,c1,DEFAULTcast,c2) ]
+    | "99" RIGHTA [ ]
+    | "90" RIGHTA
+      [ c1 = operconstr; "->"; c2 = binder_constr -> CArrow(loc,c1,c2)
+      | c1 = operconstr; "->"; c2 = SELF -> CArrow(loc,c1,c2)]
+    | "10" LEFTA
+      [ f=operconstr; args=LIST1 appl_arg -> CApp(loc,(None,f),args)
+      | "@"; f=global; args=LIST0 NEXT -> CAppExpl(loc,(None,f),args) ]
+    | "9"
+        [ ".."; c = operconstr LEVEL "0"; ".." ->
           CAppExpl (loc,(None,Ident (loc,Topconstr.ldots_var)),[c]) ]
-    | "0" RIGHTA
-      [ "?" -> CHole loc
-      | "?"; n = Prim.natural -> CPatVar (loc, (false,Pattern.patvar_of_int n))
-      | bll = binders; c = constr -> abstract_constr loc c bll
-      (* Hack to parse syntax "(n)" as a natural number *)
-      | "("; test_int_rparen; n = bigint; ")" ->
-	  (* Delimiter "N" moved to "nat" in V7 *)
-          CDelimiters (loc,"nat",CNumeral (loc,n))
-      | "("; lc1 = lconstr; ":"; c = constr; (bl,body) = product_tail ->
-          let id = coerce_to_name lc1 in
-	  CProdN (loc, ([id], c)::bl, body)
-(* TODO: Syntaxe (_:t...)t et (_,x...)t *)
-      | "("; lc1 = lconstr; ","; lc2 = lconstr; ":"; c = constr;
-        (bl,body) = product_tail ->
-          let id1 = coerce_to_name lc1 in
-          let id2 = coerce_to_name lc2 in
-	  CProdN (loc, ([id1; id2], c)::bl, body)
-      | "("; lc1 = lconstr; ","; lc2 = lconstr; ",";
-        idl = ne_name_comma_list; ":"; c = constr; (bl,body) = product_tail ->
-          let id1 = coerce_to_name lc1 in
-          let id2 = coerce_to_name lc2 in
-	  CProdN (loc, (id1::id2::idl, c)::bl, body)
-      | "("; lc1 = lconstr; ")" ->
-          if Options.do_translate() then set_loc loc lc1 else lc1
-      | "("; lc1 = lconstr; ")"; "@"; "["; cl = ne_constr_list; "]" ->
-	  (match lc1 with
-	    | CPatVar (loc2,(false,n)) -> 
-                CApp (loc,(None,CPatVar (loc2, (true,n))), List.map (fun c -> c, None) cl)
-	    | _ ->
-	    Util.error "Second-order pattern-matching expects a head metavariable")
-      | IDENT "Fix"; id = identref; "{"; fbinders = fixbinders; "}" ->
-	  CFix (loc, id, fbinders)
-      | IDENT "CoFix"; id = identref; "{"; fbinders = cofixbinders; "}" ->
-	  CCoFix (loc, id, fbinders)
-      | IDENT "Prefix" ; "(" ;  s = STRING ; cl = LIST0 constr ; ")" ->
-	  CNotation(loc, s, cl)
-      | s = sort -> CSort (loc, s)
-      | v = global -> CRef v
-      | n = bigint -> CNumeral (loc,n)
-      | "!"; f = global -> CAppExpl (loc,(None,f),[])
-      | "'"; test_ident_colon; key = IDENT; ":"; c = constr; "'" -> 
-	  (* Delimiter "N" implicitly moved to "nat" in V7 *)
-	  let key = if key = "N" then "nat" else key in
-	  let key = if key = "P" then "positive" else key in
-	  let key = if key = "T" then "type" else key in
-	  CDelimiters (loc,key,c) ] ]
+    | "1" LEFTA
+      [ c=operconstr; ".("; f=global; args=LIST0 appl_arg; ")" ->
+	CApp(loc,(Some (List.length args+1),CRef f),args@[c,None])
+      | c=operconstr; ".("; "@"; f=global;
+        args=LIST0 (operconstr LEVEL "9"); ")" ->
+        CAppExpl(loc,(Some (List.length args+1),f),args@[c]) 
+      | c=operconstr; "%"; key=IDENT -> CDelimiters (loc,key,c) ]
+    | "0"
+      [ c=atomic_constr -> c
+      | c=match_constr -> c
+      | "("; c = operconstr LEVEL "200"; ")" ->
+          (match c with
+              CPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
+                CNotation(loc,"( _ )",[c])
+            | _ -> c) ] ]
   ;
-  constr91:
-    [ [ test_int_bang; n = INT; "!"; c = operconstr LEVEL "9" ->
-        (c, Some (loc,ExplByPos (int_of_string n)))
-      | c = operconstr LEVEL "9" -> (c, None) ] ]
+  binder_constr:
+    [ [ "forall"; bl = binder_list; ","; c = operconstr LEVEL "200" ->
+          mkCProdN loc bl c
+      | "fun"; bl = binder_list; "=>"; c = operconstr LEVEL "200" ->
+          mkCLambdaN loc bl c
+      | "let"; id=name; bl = LIST0 binder_let; ty = type_cstr; ":=";
+        c1 = operconstr LEVEL "200"; "in"; c2 = operconstr LEVEL "200" ->
+          let loc1 = loc_of_binder_let bl in
+          CLetIn(loc,id,mkCLambdaN loc1 bl (mk_cast(c1,ty)),c2)
+      | "let"; fx = single_fix; "in"; c = operconstr LEVEL "200" ->
+          let fixp = mk_single_fix fx in
+          let (li,id) = match fixp with
+              CFix(_,id,_) -> id
+            | CCoFix(_,id,_) -> id
+            | _ -> assert false in
+          CLetIn(loc,(li,Name id),fixp,c)
+      | "let"; lb = ["("; l=LIST0 name SEP ","; ")" -> l | "()" -> []];
+	  po = return_type;
+	  ":="; c1 = operconstr LEVEL "200"; "in";
+          c2 = operconstr LEVEL "200" ->
+          CLetTuple (loc,List.map snd lb,po,c1,c2)
+      | "if"; c=operconstr LEVEL "200"; po = return_type;
+	"then"; b1=operconstr LEVEL "200";
+        "else"; b2=operconstr LEVEL "200" ->
+          CIf (loc, c, po, b1, b2)
+      | c=fix_constr -> c ] ]
   ;
-  (* annot and product_annot_tail are hacks to forbid concrete syntax *)
-  (* ">" (e.g. for gt, Zgt, ...) in annotations *)
-  annot:
-    [ RIGHTA
-      [ bll = binders; c = annot -> abstract_constr loc c bll 
-      | "("; lc1 = lconstr; ":"; c = constr; (bl,body) = product_annot_tail ->
-          let id = coerce_to_name lc1 in
-	  CProdN (loc, ([id], c)::bl, body)
-      | "("; lc1 = lconstr; ","; lc2 = lconstr; ":"; c = constr;
-        (bl,body) = product_annot_tail ->
-          let id1 = coerce_to_name lc1 in
-          let id2 = coerce_to_name lc2 in
-	  CProdN (loc, ([id1; id2], c)::bl, body)
-      | "("; lc1 = lconstr; ","; lc2 = lconstr; ",";
-        idl = ne_name_comma_list; ":"; c = constr;
-	(bl,body) = product_annot_tail ->
-          let id1 = coerce_to_name lc1 in
-          let id2 = coerce_to_name lc2 in
-	  CProdN (loc, (id1::id2::idl, c)::bl, body)
-      | "("; lc1 = lconstr; ")" -> lc1
-      | c1 = annot; "->"; c2 = annot -> CArrow (loc, c1, c2) ]
-    | RIGHTA 
-      [ c1 = annot; "\\/"; c2 = annot -> CNotation (loc, "_ \\/ _", [c1;c2]) ]
-    | RIGHTA
-      [ c1 = annot; "/\\"; c2 = annot -> CNotation (loc, "_ /\\ _", [c1;c2]) ]
-    | RIGHTA
-      [ "~"; c = SELF -> CNotation (loc, "~ _", [c]) ]
-    | RIGHTA
-      [ c1 = SELF; "=="; c2 = NEXT -> CNotation (loc, "_ == _", [c1;c2]) ]
-    | RIGHTA
-      [ c1 = SELF; "="; c2 = NEXT -> CNotation (loc, "_ = _", [c1;c2]) ]
-    | [ c = operconstr LEVEL "4L" -> c ] ]
+  appl_arg:
+    [ [ id = lpar_id_coloneq; c=lconstr; ")" ->
+	  (c,Some (loc,ExplByName id))
+      | c=constr -> (c,None) ] ]
   ;
-  product_annot_tail:
-    [ [ ";"; idl = ne_name_comma_list; ":"; c = constr;
-        (bl,c2) = product_annot_tail -> ((idl, c)::bl, c2)
-      | ";"; idl = ne_name_comma_list; (bl,c2) = product_annot_tail ->
-          ((idl, CHole (fst (List.hd idl)))::bl, c2)
-      | ")"; c = annot -> ([], c) ] ]
+  atomic_constr:
+    [ [ g=global -> CRef g
+      | s=sort -> CSort (loc,s)
+      | n=INT -> CPrim (loc, Numeral (Bigint.of_string n))
+      | s=string -> CPrim (loc, String s)
+      | "_" -> CHole loc
+      | "?"; id=ident -> CPatVar(loc,(false,id)) ] ]
   ;
-  ne_name_comma_list:
-    [ [ nal = LIST1 name SEP "," -> nal ] ]
+  fix_constr:
+    [ [ fx1=single_fix -> mk_single_fix fx1
+      | (_,kw,dcl1)=single_fix; "with"; dcls=LIST1 fix_decl SEP "with";
+        "for"; id=identref ->
+          mk_fix(loc,kw,id,dcl1::dcls)
+    ] ]
   ;
-  name_comma_list_tail:
-    [ [ ","; idl = ne_name_comma_list -> idl
-      | -> [] ] ]
+  single_fix:
+    [ [ kw=fix_kw; dcl=fix_decl -> (loc,kw,dcl) ] ]
   ;
-  opt_casted_constr:
-    [ [ c = constr;  ":"; t = constr -> CCast (loc, c, t)
-      | c = constr -> c ] ]
+  fix_kw:
+    [ [ "fix" -> true
+      | "cofix" -> false ] ]
   ;
-  vardecls:
-    [ [ na = name; nal = name_comma_list_tail; c = type_option ->
-          LocalRawAssum (na::nal,c)
-      | na = name; "="; c = opt_casted_constr ->
-          LocalRawDef (na, c)
-      | na = name; ":="; c = opt_casted_constr ->
-          LocalRawDef (na, c)
-
-      (* This is used in quotations *)
-      | id = METAIDENT; c = type_option -> LocalRawAssum ([loc, Name (id_of_string id)], c)
-    ] ]
+  fix_decl:
+    [ [ id=identref; bl=LIST0 binder_let; ann=fixannot; ty=type_cstr; ":=";
+        c=operconstr LEVEL "200" -> (id,bl,ann,c,ty) ] ]
   ;
-  ne_vardecls_list:
-    [ [ id = vardecls; ";"; idl = ne_vardecls_list -> id :: idl
-      | id = vardecls -> [id] ] ]
+  fixannot:
+    [ [ "{"; IDENT "struct"; id=name; "}" -> (Some id, CStructRec)
+      | "{"; IDENT "wf"; id=name; rel=lconstr; "}" -> (Some id, CWfRec rel)
+      | ->  (None, CStructRec)
+      ] ]
   ;
-  binders:
-    [ [ "["; bl = ne_vardecls_list; "]" -> bl ] ]
+  match_constr:
+    [ [ "match"; ci=LIST1 case_item SEP ","; ty=OPT case_type; "with";
+        br=branches; "end" -> CCases(loc,ty,ci,br) ] ]
   ;
-  simple_params:
-    [ [ idl = LIST1 name SEP ","; ":"; c = constr -> (idl, c)
-      | idl = LIST1 name SEP "," -> (idl, CHole loc)
-    ] ]
+  case_item:
+    [ [ c=operconstr LEVEL "100"; p=pred_pattern -> (c,p) ] ]
   ;
-  simple_binders:
-    [ [ "["; bll = LIST1 simple_params SEP ";"; "]" -> bll ] ]
+  pred_pattern:
+    [ [ ona = OPT ["as"; id=name -> snd id];
+        ty = OPT ["in"; t=lconstr -> t] -> (ona,ty) ] ]
   ;
-  ne_simple_binders_list:
-    [ [ bll = LIST1 simple_binders -> List.flatten bll ] ]
+  case_type:
+    [ [ "return"; ty = operconstr LEVEL "100" -> ty ] ]
   ;
-  type_option:
-    [ [ ":"; c = constr -> c 
-      | -> CHole loc ] ]
+  return_type:
+    [ [ a = OPT [ na = OPT["as"; id=name -> snd id];
+                  ty = case_type -> (na,ty) ] -> 
+        match a with 
+          | None -> None, None
+          | Some (na,t) -> (na, Some t)
+    ] ]
   ;
-  fixbinder:
-    [ [ id = base_ident; "/"; recarg = natural; ":"; type_ = constr;
-        ":="; def = constr ->
-          (id, recarg-1, [], type_, def)
-      | id = base_ident; bl = ne_simple_binders_list; ":"; type_ = constr;
-	":="; def = constr ->
-          let ni = List.length (List.flatten (List.map fst bl)) -1 in
-          let bl = List.map (fun(nal,ty)->LocalRawAssum(nal,ty)) bl in
-	  (id, ni, bl, type_, def) ] ]
+  branches:
+    [ [ OPT"|"; br=LIST0 eqn SEP "|" -> br ] ]
   ;
-  fixbinders:
-    [ [ fbs = LIST1 fixbinder SEP "with" -> fbs ] ]
+  eqn:
+    [ [ pl = LIST1 pattern SEP ","; "=>"; rhs = lconstr -> (loc,pl,rhs) ] ]
   ;
-  cofixbinder:
-    [ [ id = base_ident; ":"; type_ = constr; ":="; def = constr ->
-          (id, [],type_, def) ] ]
+  pattern:
+    [ "200" RIGHTA [ ]
+    | "100" LEFTA
+      [ p = pattern; "|"; pl = LIST1 pattern SEP "|" -> CPatOr (loc,p::pl) ]
+    | "99" RIGHTA [ ]
+    | "10" LEFTA
+      [ p = pattern; lp = LIST1 (pattern LEVEL "0") ->
+        (match p with
+          | CPatAtom (_, Some r) -> CPatCstr (loc, r, lp)
+          | _ -> Util.user_err_loc 
+              (cases_pattern_loc p, "compound_pattern",
+               Pp.str "Constructor expected"))
+      | p = pattern; "as"; id = ident ->
+	  CPatAlias (loc, p, id)
+      | c = pattern; "%"; key=IDENT -> 
+          CPatDelimiters (loc,key,c) ]
+    | "0"
+      [ r = Prim.reference -> CPatAtom (loc,Some r)
+      | "_" -> CPatAtom (loc,None)
+      | "("; p = pattern LEVEL "200"; ")" ->
+          (match p with
+              CPatPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
+                CPatNotation(loc,"( _ )",[p])
+            | _ -> p)
+      | n = INT -> CPatPrim (loc, Numeral (Bigint.of_string n))
+      | s = string -> CPatPrim (loc, String s) ] ]
+  ;
+  binder_list:
+    [ [ idl=LIST1 name; bl=LIST0 binder_let -> 
+          LocalRawAssum (idl,CHole loc)::bl
+      | idl=LIST1 name; ":"; c=lconstr -> 
+          [LocalRawAssum (idl,c)]
+      | "("; idl=LIST1 name; ":"; c=lconstr; ")"; bl=LIST0 binder_let ->
+          LocalRawAssum (idl,c)::bl ] ]
+  ;
+  binder_let:
+    [ [ id=name ->
+          LocalRawAssum ([id],CHole loc)
+      | "("; id=name; idl=LIST1 name; ":"; c=lconstr; ")" -> 
+          LocalRawAssum (id::idl,c)
+      | "("; id=name; ":"; c=lconstr; ")" -> 
+          LocalRawAssum ([id],c)
+      | "("; id=name; ":="; c=lconstr; ")" ->
+          LocalRawDef (id,c)
+      | "("; id=name; ":"; t=lconstr; ":="; c=lconstr; ")" -> 
+          LocalRawDef (id,CCast (join_loc (constr_loc t) loc,c,DEFAULTcast,t))
+    ] ]
   ;
-  cofixbinders:
-    [ [ fbs = LIST1 cofixbinder SEP "with" -> fbs ] ]
+  binder:
+    [ [ id=name -> ([id],CHole loc)
+      | "("; idl=LIST1 name; ":"; c=lconstr; ")" -> (idl,c) ] ]
   ;
-  product_tail:
-    [ [ ";"; idl = ne_name_comma_list; ":"; c = constr;
-        (bl,c2) = product_tail -> ((idl, c)::bl, c2)
-      | ";"; idl = ne_name_comma_list; (bl,c2) = product_tail ->
-          ((idl, CHole (fst (List.hd idl)))::bl, c2)
-      | ")"; c = constr -> ([], c) ] ]
+  type_cstr:
+    [ [ c=OPT [":"; c=lconstr -> c] -> (loc,c) ] ]
   ;
-END;;
+  END;;
diff --git a/parsing/g_constrnew.ml4 b/parsing/g_constrnew.ml4
deleted file mode 100644
index fe579e98..00000000
--- a/parsing/g_constrnew.ml4
+++ /dev/null
@@ -1,338 +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        *)
-(************************************************************************)
-
-(* $Id: g_constrnew.ml4,v 1.41.2.4 2005/09/21 14:47:33 herbelin Exp $ *)
-
-open Pcoq
-open Constr
-open Prim
-open Rawterm
-open Term
-open Names
-open Libnames
-open Topconstr
-
-open Util
-
-let constr_kw =
-  [ "forall"; "fun"; "match"; "fix"; "cofix"; "with"; "in"; "for"; 
-    "end"; "as"; "let"; "if"; "then"; "else"; "return";
-    "Prop"; "Set"; "Type"; ".("; "_"; ".." ]
-
-let _ = 
-  if not !Options.v7 then
-    List.iter (fun s -> Lexer.add_token("",s)) constr_kw
-
-(* For Correctness syntax; doesn't work if in psyntax (freeze pb?)  *)
-let _ = Lexer.add_token ("","!")
-
-let mk_cast = function
-    (c,(_,None)) -> c
-  | (c,(_,Some ty)) -> CCast(join_loc (constr_loc c) (constr_loc ty), c, ty)
-
-let mk_lam = function
-    ([],c) -> c
-  | (bl,c) -> CLambdaN(constr_loc c, bl,c)
-
-let mk_match (loc,cil,rty,br) =
-  CCases(loc,(None,rty),cil,br)
-
-let loc_of_binder_let = function
-  | LocalRawAssum ((loc,_)::_,_)::_ -> loc
-  | LocalRawDef ((loc,_),_)::_ -> loc
-  | _ -> dummy_loc
-
-let rec mkCProdN loc bll c =
-  match bll with
-  | LocalRawAssum ((loc1,_)::_ as idl,t) :: bll -> 
-      CProdN (loc,[idl,t],mkCProdN (join_loc loc1 loc) bll c)
-  | LocalRawDef ((loc1,_) as id,b) :: bll -> 
-      CLetIn (loc,id,b,mkCProdN (join_loc loc1 loc) bll c)
-  | [] -> c
-  | LocalRawAssum ([],_) :: bll -> mkCProdN loc bll c
-
-let rec mkCLambdaN loc bll c =
-  match bll with
-  | LocalRawAssum ((loc1,_)::_ as idl,t) :: bll -> 
-      CLambdaN (loc,[idl,t],mkCLambdaN (join_loc loc1 loc) bll c)
-  | LocalRawDef ((loc1,_) as id,b) :: bll -> 
-      CLetIn (loc,id,b,mkCLambdaN (join_loc loc1 loc) bll c)
-  | [] -> c
-  | LocalRawAssum ([],_) :: bll -> mkCLambdaN loc bll c
-
-let rec index_of_annot loc bl ann =
-  match names_of_local_assums bl,ann with
-    | [_], None -> 0
-    | lids, Some x ->
-        let ids = List.map snd lids in
-        (try list_index (snd x) ids - 1
-        with Not_found ->
-          user_err_loc(fst x,"index_of_annot", Pp.str"no such fix variable"))
-    | _ -> user_err_loc(loc,"index_of_annot",
-      Pp.str "cannot guess decreasing argument of fix")
-
-let mk_fixb (id,bl,ann,body,(loc,tyc)) =
-  let n = index_of_annot (fst id) bl ann in
-  let ty = match tyc with
-      Some ty -> ty
-    | None -> CHole loc in
-  (snd id,n,bl,ty,body)
-
-let mk_cofixb (id,bl,ann,body,(loc,tyc)) =
-  let _ = option_app (fun (aloc,_) ->
-    Util.user_err_loc
-      (aloc,"Constr:mk_cofixb",
-       Pp.str"Annotation forbidden in cofix expression")) ann in
-  let ty = match tyc with
-      Some ty -> ty
-    | None -> CHole loc in
-  (snd id,bl,ty,body)
-
-let mk_fix(loc,kw,id,dcls) =
-  if kw then 
-    let fb = List.map mk_fixb dcls in
-    CFix(loc,id,fb)
-  else
-    let fb = List.map mk_cofixb dcls in
-    CCoFix(loc,id,fb)
-
-let mk_single_fix (loc,kw,dcl) =
-  let (id,_,_,_,_) = dcl in mk_fix(loc,kw,id,[dcl])
-
-let binder_constr =
-  create_constr_entry (get_univ "constr") "binder_constr"
-
-(* Hack to parse "(x:=t)" as an explicit argument without conflicts with the *)
-(* admissible notation "(x t)" *)
-let lpar_id_coloneq =
-  Gram.Entry.of_parser "test_lpar_id_coloneq"
-    (fun strm ->
-      match Stream.npeek 1 strm with
-        | [("","(")] ->
-            (match Stream.npeek 2 strm with
-	      | [_; ("IDENT",s)] ->
-                  (match Stream.npeek 3 strm with
-                    | [_; _; ("", ":=")] ->
-                        Stream.junk strm; Stream.junk strm; Stream.junk strm;
-                        Names.id_of_string s
-	            | _ -> raise Stream.Failure)
-              | _ -> raise Stream.Failure)
-        | _ -> raise Stream.Failure)
-
-
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: binder_constr lconstr constr operconstr sort global
-  constr_pattern lconstr_pattern Constr.ident binder binder_let pattern;
-  Constr.ident:
-    [ [ id = Prim.ident -> id
-
-      (* This is used in quotations and Syntax *)
-      | id = METAIDENT -> id_of_string id ] ]
-  ;
-  Prim.name:
-    [ [ "_" -> (loc, Anonymous) ] ]
-  ;
-  Prim.ast:
-    [ [ "_" -> Coqast.Nvar(loc,id_of_string"_") ] ]
-  ;
-  global:
-    [ [ r = Prim.reference -> r
-
-      (* This is used in quotations *)
-      | id = METAIDENT -> Ident (loc,id_of_string id) ] ]
-  ;
-  constr_pattern:
-    [ [ c = constr -> c ] ]
-  ;
-  lconstr_pattern:
-    [ [ c = lconstr -> c ] ]
-  ;
-  sort:
-    [ [ "Set"  -> RProp Pos
-      | "Prop" -> RProp Null
-      | "Type" -> RType None ] ]
-  ;
-  lconstr:
-    [ [ c = operconstr LEVEL "200" -> c ] ]
-  ;
-  constr:
-    [ [ c = operconstr LEVEL "9" -> c ] ]
-  ;
-  operconstr:
-    [ "200" RIGHTA
-      [ c = binder_constr -> c ]
-    | "100" RIGHTA
-      [ c1 = operconstr; ":"; c2 = binder_constr -> CCast(loc,c1,c2)
-      | c1 = operconstr; ":"; c2 = SELF -> CCast(loc,c1,c2) ]
-    | "99" RIGHTA [ ]
-    | "90" RIGHTA
-      [ c1 = operconstr; "->"; c2 = binder_constr -> CArrow(loc,c1,c2)
-      | c1 = operconstr; "->"; c2 = SELF -> CArrow(loc,c1,c2)]
-    | "10" LEFTA
-      [ f=operconstr; args=LIST1 appl_arg -> CApp(loc,(None,f),args)
-      | "@"; f=global; args=LIST0 NEXT -> CAppExpl(loc,(None,f),args) ]
-    | "9"
-        [ ".."; c = operconstr LEVEL "0"; ".." ->
-          CAppExpl (loc,(None,Ident (loc,Topconstr.ldots_var)),[c]) ]
-    | "1" LEFTA
-      [ c=operconstr; ".("; f=global; args=LIST0 appl_arg; ")" ->
-	CApp(loc,(Some (List.length args+1),CRef f),args@[c,None])
-      | c=operconstr; ".("; "@"; f=global;
-        args=LIST0 (operconstr LEVEL "9"); ")" ->
-        CAppExpl(loc,(Some (List.length args+1),f),args@[c]) 
-      | c=operconstr; "%"; key=IDENT -> CDelimiters (loc,key,c) ]
-    | "0"
-      [ c=atomic_constr -> c
-      | c=match_constr -> c
-      | "("; c = operconstr LEVEL "200"; ")" ->
-          (match c with
-              CNumeral(_,Bignat.POS _) -> CNotation(loc,"( _ )",[c])
-            | _ -> c) ] ]
-  ;
-  binder_constr:
-    [ [ "forall"; bl = binder_list; ","; c = operconstr LEVEL "200" ->
-          mkCProdN loc bl c
-      | "fun"; bl = binder_list; "=>"; c = operconstr LEVEL "200" ->
-          mkCLambdaN loc bl c
-      | "let"; id=name; bl = LIST0 binder_let; ty = type_cstr; ":=";
-        c1 = operconstr LEVEL "200"; "in"; c2 = operconstr LEVEL "200" ->
-          let loc1 = loc_of_binder_let bl in
-          CLetIn(loc,id,mkCLambdaN loc1 bl (mk_cast(c1,ty)),c2)
-      | "let"; fx = single_fix; "in"; c = operconstr LEVEL "200" ->
-          let fixp = mk_single_fix fx in
-          let (li,id) = match fixp with
-              CFix(_,id,_) -> id
-            | CCoFix(_,id,_) -> id
-            | _ -> assert false in
-          CLetIn(loc,(li,Name id),fixp,c)
-      | "let"; lb = ["("; l=LIST0 name SEP ","; ")" -> l | "()" -> []];
-	  po = return_type;
-	  ":="; c1 = operconstr LEVEL "200"; "in";
-          c2 = operconstr LEVEL "200" ->
-          CLetTuple (loc,List.map snd lb,po,c1,c2)
-      | "if"; c=operconstr LEVEL "200"; po = return_type;
-	"then"; b1=operconstr LEVEL "200";
-        "else"; b2=operconstr LEVEL "200" ->
-          CIf (loc, c, po, b1, b2)
-      | c=fix_constr -> c ] ]
-  ;
-  appl_arg:
-    [ [ id = lpar_id_coloneq; c=lconstr; ")" ->
-	  (c,Some (loc,ExplByName id))
-      | c=constr -> (c,None) ] ]
-  ;
-  atomic_constr:
-    [ [ g=global -> CRef g
-      | s=sort -> CSort(loc,s)
-      | n=INT -> CNumeral (loc,Bignat.POS (Bignat.of_string n))
-      | "_" -> CHole loc
-      | "?"; id=ident -> CPatVar(loc,(false,id)) ] ]
-  ;
-  fix_constr:
-    [ [ fx1=single_fix -> mk_single_fix fx1
-      | (_,kw,dcl1)=single_fix; "with"; dcls=LIST1 fix_decl SEP "with";
-        "for"; id=identref ->
-          mk_fix(loc,kw,id,dcl1::dcls)
-    ] ]
-  ;
-  single_fix:
-    [ [ kw=fix_kw; dcl=fix_decl -> (loc,kw,dcl) ] ]
-  ;
-  fix_kw:
-    [ [ "fix" -> true
-      | "cofix" -> false ] ]
-  ;
-  fix_decl:
-    [ [ id=identref; bl=LIST0 binder_let; ann=fixannot; ty=type_cstr; ":=";
-        c=operconstr LEVEL "200" -> (id,bl,ann,c,ty) ] ]
-  ;
-  fixannot:
-    [ [ "{"; IDENT "struct"; id=name; "}" -> Some id
-      | -> None ] ]
-  ;
-  match_constr:
-    [ [ "match"; ci=LIST1 case_item SEP ","; ty=OPT case_type; "with";
-        br=branches; "end" -> mk_match (loc,ci,ty,br) ] ]
-  ;
-  case_item:
-    [ [ c=operconstr LEVEL "100"; p=pred_pattern -> (c,p) ] ]
-  ;
-  pred_pattern:
-    [ [ ona = OPT ["as"; id=name -> snd id];
-        ty = OPT ["in"; t=lconstr -> t] -> (ona,ty) ] ]
-  ;
-  case_type:
-    [ [ "return"; ty = operconstr LEVEL "100" -> ty ] ]
-  ;
-  return_type:
-    [ [ a = OPT [ na = OPT["as"; id=name -> snd id];
-                  ty = case_type -> (na,ty) ] -> 
-        match a with 
-          | None -> None, None
-          | Some (na,t) -> (na, Some t)
-    ] ]
-  ;
-  branches:
-    [ [ OPT"|"; br=LIST0 eqn SEP "|" -> br ] ]
-  ;
-  eqn:
-    [ [ pl = LIST1 pattern SEP ","; "=>"; rhs = lconstr -> (loc,pl,rhs) ] ]
-  ;
-  pattern:
-    [ "200" RIGHTA [ ]
-    | "99" RIGHTA [ ]
-    | "10" LEFTA
-      [ p = pattern ; lp = LIST1 (pattern LEVEL "0") ->
-        (match p with
-          | CPatAtom (_, Some r) -> CPatCstr (loc, r, lp)
-          | _ -> Util.user_err_loc 
-              (cases_pattern_loc p, "compound_pattern",
-               Pp.str "Constructor expected"))
-      | p = pattern; "as"; id = base_ident ->
-	  CPatAlias (loc, p, id)
-      | c = pattern; "%"; key=IDENT -> 
-          CPatDelimiters (loc,key,c) ]
-    | "0"
-      [ r = Prim.reference -> CPatAtom (loc,Some r)
-      | "_" -> CPatAtom (loc,None)
-      | "("; p = pattern LEVEL "200"; ")" ->
-          (match p with
-              CPatNumeral(_,Bignat.POS _) -> CPatNotation(loc,"( _ )",[p])
-            | _ -> p)
-      | n = INT -> CPatNumeral (loc,Bignat.POS(Bignat.of_string n)) ] ]
-  ;
-  binder_list:
-    [ [ idl=LIST1 name; bl=LIST0 binder_let -> 
-          LocalRawAssum (idl,CHole loc)::bl
-      | idl=LIST1 name; ":"; c=lconstr -> 
-          [LocalRawAssum (idl,c)]
-      | "("; idl=LIST1 name; ":"; c=lconstr; ")"; bl=LIST0 binder_let ->
-          LocalRawAssum (idl,c)::bl ] ]
-  ;
-  binder_let:
-    [ [ id=name ->
-          LocalRawAssum ([id],CHole loc)
-      | "("; id=name; idl=LIST1 name; ":"; c=lconstr; ")" -> 
-          LocalRawAssum (id::idl,c)
-      | "("; id=name; ":"; c=lconstr; ")" -> 
-          LocalRawAssum ([id],c)
-      | "("; id=name; ":="; c=lconstr; ")" ->
-          LocalRawDef (id,c)
-      | "("; id=name; ":"; t=lconstr; ":="; c=lconstr; ")" -> 
-          LocalRawDef (id,CCast (join_loc (constr_loc t) loc,c,t))
-    ] ]
-  ;
-  binder:
-    [ [ id=name -> ([id],CHole loc)
-      | "("; idl=LIST1 name; ":"; c=lconstr; ")" -> (idl,c) ] ]
-  ;
-  type_cstr:
-    [ [ c=OPT [":"; c=lconstr -> c] -> (loc,c) ] ]
-  ;
-  END;;
diff --git a/parsing/g_ltac.ml4 b/parsing/g_ltac.ml4
index 7349a6f8..6ed22c7e 100644
--- a/parsing/g_ltac.ml4
+++ b/parsing/g_ltac.ml4
@@ -6,16 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_ltac.ml4,v 1.28.2.2 2004/07/16 19:30:38 herbelin Exp $ *)
+(* $Id: g_ltac.ml4 8129 2006-03-05 09:05:12Z herbelin $ *)
 
 open Pp
 open Util
-open Ast
 open Topconstr
 open Rawterm
 open Tacexpr
 open Vernacexpr
-open Ast
 open Pcoq
 open Prim
 open Tactic
@@ -37,163 +35,156 @@ let arg_of_expr = function
     TacArg a -> a
   | e -> Tacexp (e:raw_tactic_expr)
     
+let tacarg_of_expr = function
+  | TacArg (Reference r) -> TacCall (dummy_loc,r,[])
+  | TacArg a -> a
+  | e -> Tacexp (e:raw_tactic_expr)
+
 (* Tactics grammar rules *)
 
-if !Options.v7 then
 GEXTEND Gram
-  GLOBAL: tactic Vernac_.command tactic_arg;
+  GLOBAL: tactic Vernac_.command tactic_expr tactic_arg constr_may_eval;
 
-(*
-  GLOBAL: tactic_atom tactic_atom0 tactic_expr input_fun;
-*)
+  tactic_expr:
+    [ "5" LEFTA
+      [ 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) ]
+    | "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" ->
+          TacMatchContext (b,false,mrl)
+      | b = match_key; IDENT "reverse"; IDENT "goal"; "with";
+        mrl = match_context_list; "end" ->
+          TacMatchContext (b,true,mrl)
+      |	b = match_key; c = tactic_expr; "with"; mrl = match_list; "end" ->
+          TacMatch (b,c,mrl)
+      | IDENT "first" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
+	  TacFirst l
+      | IDENT "solve" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
+	  TacSolve l
+      | IDENT "complete" ; ta = tactic_expr -> TacComplete ta
+      | IDENT "idtac"; l = LIST0 message_token -> TacId l
+      | IDENT "fail"; n = [ n = int_or_var -> n | -> fail_default_value ];
+	  l = LIST0 message_token -> TacFail (n,l)
+      | IDENT "external"; com = STRING; req = STRING; la = LIST1 tactic_arg ->
+	  TacArg (TacExternal (loc,com,req,la))
+      | st = simple_tactic -> TacAtom (loc,st)
+      | a = may_eval_arg -> TacArg(a)
+      | IDENT "constr"; ":"; c = Constr.constr ->
+          TacArg(ConstrMayEval(ConstrTerm c))
+      | IDENT "ipattern"; ":"; ipat = simple_intropattern -> 
+	  TacArg(IntroPattern ipat)
+      | r = reference; la = LIST1 tactic_arg ->
+          TacArg(TacCall (loc,r,la))
+      | r = reference -> TacArg (Reference r) ]
+    | "0"
+      [ "("; a = tactic_expr; ")" -> a
+      | a = tactic_atom -> TacArg a ] ]
+  ;
+  (* Tactic arguments *)
+  tactic_arg:
+    [ [ IDENT "ltac"; ":"; a = tactic_expr LEVEL "0" -> tacarg_of_expr a
+      | IDENT "ipattern"; ":"; ipat = simple_intropattern -> IntroPattern ipat
+      | a = may_eval_arg -> a
+      | r = reference -> Reference r
+      | a = tactic_atom -> a
+      | c = Constr.constr -> ConstrMayEval (ConstrTerm c) ] ]
+  ;
+  may_eval_arg:
+    [ [ c = constr_eval -> ConstrMayEval c
+      | IDENT "fresh"; s = OPT STRING -> TacFreshId s ] ]
+  ;
+  constr_eval:
+    [ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
+          ConstrEval (rtc,c)
+      | IDENT "context"; id = identref; "["; c = Constr.lconstr; "]" ->
+          ConstrContext (id,c)
+      | IDENT "type"; IDENT "of"; c = Constr.constr ->
+          ConstrTypeOf c ] ]
+  ;
+  constr_may_eval: (* For extensions *)
+    [ [ c = constr_eval -> c
+      | c = Constr.constr -> ConstrTerm c ] ]
+  ;
+  tactic_atom:
+    [ [ id = METAIDENT -> MetaIdArg (loc,id)
+      | "()" -> TacVoid ] ]
+  ;
+  match_key:
+    [ [ "match" -> false ] ]
+  ;
   input_fun:
-    [ [ l = base_ident -> Some l
-      | "()" -> None ] ]
+    [ [ "_" -> None 
+      | l = ident -> Some l ] ]
   ;
   let_clause:
-    [ [ id = identref; "="; te = tactic_letarg -> LETCLAUSE (id, None, te)
-      | id = base_ident; ":"; c = Constr.constr; ":="; "Proof" ->
-          LETTOPCLAUSE (id, c)
-      | id = identref; ":"; c = constrarg; ":="; te = tactic_letarg ->
-          LETCLAUSE (id, Some (TacArg(ConstrMayEval c)), te)
-      |	id = base_ident; ":"; c = Constr.constr ->
-	  LETTOPCLAUSE (id, c) ] ]
+    [ [ id = identref; ":="; te = tactic_expr ->
+          LETCLAUSE (id, None, arg_of_expr te)
+      | id = identref; args = LIST1 input_fun; ":="; te = tactic_expr ->
+          LETCLAUSE (id, None, arg_of_expr (TacFun(args,te))) ] ]
   ;
   rec_clause:
-    [ [ name = identref; it = LIST1 input_fun; "->"; body = tactic_expr ->
+    [ [ name = identref; it = LIST1 input_fun; ":="; body = tactic_expr ->
           (name,(it,body)) ] ]
   ;
   match_pattern:
-    [ [ id = Constr.constr_pattern; "["; pc = Constr.constr_pattern; "]" ->
-        let (_,s) = coerce_to_id id in Subterm (Some s, pc)
-      | "["; pc = Constr.constr_pattern; "]" -> Subterm (None,pc)
-      | pc = Constr.constr_pattern -> Term pc ] ]
+    [ [ IDENT "context";  oid = OPT Constr.ident;
+          "["; pc = Constr.lconstr_pattern; "]" ->
+        Subterm (oid, pc)
+      | pc = Constr.lconstr_pattern -> Term pc ] ]
   ;
   match_hyps:
     [ [ na = name; ":"; mp =  match_pattern -> Hyp (na, mp) ] ]
   ;
   match_context_rule:
-    [ [ "["; largs = LIST0 match_hyps SEP ";"; "|-"; mp = match_pattern; "]";
-        "->"; te = tactic_expr -> Pat (largs, mp, te)
-      | IDENT "_"; "->"; te = tactic_expr -> All te ] ]
+    [ [ largs = LIST0 match_hyps SEP ","; "|-"; mp = match_pattern;
+        "=>"; te = tactic_expr -> Pat (largs, mp, te)
+      | "["; largs = LIST0 match_hyps SEP ","; "|-"; mp = match_pattern;
+        "]"; "=>"; te = tactic_expr -> Pat (largs, mp, te)
+      | "_"; "=>"; te = tactic_expr -> All te ] ]
   ;
   match_context_list:
     [ [ mrl = LIST1 match_context_rule SEP "|" -> mrl
       | "|"; mrl = LIST1 match_context_rule SEP "|" -> mrl ] ]
   ;
   match_rule:
-    [ [ "["; mp = match_pattern; "]"; "->"; te = tactic_expr -> Pat ([],mp,te)
-      | IDENT "_"; "->"; te = tactic_expr -> All te ] ]
+    [ [ mp = match_pattern; "=>"; te = tactic_expr -> Pat ([],mp,te)
+      | "_"; "=>"; te = tactic_expr -> All te ] ]
   ;
   match_list:
     [ [ mrl = LIST1 match_rule SEP "|" -> mrl
       | "|"; mrl = LIST1 match_rule SEP "|" -> mrl ] ]
   ;
-  tactic_expr:
-    [ [ ta = tactic_expr5 -> ta ] ]
-  ;
-  tactic_expr5:
-    [ [ ta0 = tactic_expr5; ";"; ta1 = tactic_expr4 -> TacThen (ta0, ta1)
-      | ta = tactic_expr5; ";"; "["; lta = LIST0 tactic_expr SEP "|"; "]" ->
-          TacThens (ta, lta)
-      | y = tactic_expr4 -> y ] ]
-  ;
-  tactic_expr4:
-    [ [ ta = tactic_expr3 -> ta ] ]
-  ;
-  tactic_expr3:
-    [ [ IDENT "Try"; ta = tactic_expr3 -> TacTry ta
-      | IDENT "Do"; n = int_or_var; ta = tactic_expr3 -> TacDo (n,ta)
-      | IDENT "Repeat"; ta = tactic_expr3 -> TacRepeat ta
-      | IDENT "Progress"; ta = tactic_expr3 -> TacProgress ta
-      | IDENT "Info"; tc = tactic_expr3 -> TacInfo tc
-      | ta = tactic_expr2 -> ta ] ]
-  ;
-  tactic_expr2:
-    [ [ ta0 = tactic_atom; "Orelse"; ta1 = tactic_expr3 -> TacOrelse (ta0,ta1)
-      | ta = tactic_atom -> ta ] ]
-  ;
-  tactic_atom:
-    [ [ IDENT "Fun"; it = LIST1 input_fun ; "->"; body = tactic_expr ->
-          TacFun (it,body)
-      | IDENT "Rec"; rc = rec_clause ->
-	  warning "'Rec f ...' is obsolete; use 'Rec f ... In f' instead";
-	  TacLetRecIn ([rc],TacArg (Reference (Libnames.Ident (fst rc))))
-      | IDENT "Rec"; rc = rec_clause; rcl = LIST0 rec_clause SEP "And";
-	  [IDENT "In" | "in"]; body = tactic_expr -> TacLetRecIn (rc::rcl,body)
-      | IDENT "Let"; llc = LIST1 let_clause SEP "And"; IDENT "In";
-          u = tactic_expr -> TacLetIn (make_letin_clause loc llc,u)
-
-      | IDENT "Match"; IDENT "Context"; IDENT "With"; mrl = match_context_list
-        -> TacMatchContext (false,mrl)
-      | IDENT "Match"; IDENT "Reverse"; IDENT "Context"; IDENT "With"; mrl = match_context_list
-        -> TacMatchContext (true,mrl)
-      |	IDENT "Match"; c = constrarg; IDENT "With"; mrl = match_list ->
-        TacMatch (TacArg(ConstrMayEval c),mrl)
-(*To do: put Abstract in Refiner*)
-      | IDENT "Abstract"; tc = tactic_expr -> TacAbstract (tc,None)
-      | IDENT "Abstract"; tc = tactic_expr; "using";  s = base_ident ->
-          TacAbstract (tc,Some s)
-(*End of To do*)
-      | IDENT "First" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
-	  TacFirst l
-      | IDENT "Solve" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
-	  TacSolve l
-      | IDENT "Idtac" ; s = [ s = STRING -> s | -> ""] -> TacId s
-      | IDENT "Fail"; n = [ n = int_or_var -> n | -> fail_default_value ];
-	  s = [ s = STRING -> s | -> ""] -> TacFail (n,s)
-      | st = simple_tactic -> TacAtom (loc,st)
-      | "("; a = tactic_expr; ")" -> a
-      | a = tactic_arg -> TacArg a
-    ] ]
-  ;
-  (* Tactic arguments *)
-  tactic_arg:
-    [ [ ta = tactic_arg1 -> ta ] ]
-  ;
-  tactic_letarg:
-    (* Cannot be merged with tactic_arg1, since then "In"/"And" are 
-       parsed as lqualid! *)
-    [ [ IDENT "Eval"; rtc = red_expr; "in"; c = Constr.constr ->
-	  ConstrMayEval (ConstrEval (rtc,c))
-      | IDENT "Inst"; id = identref; "["; c = Constr.constr; "]" ->
-	  ConstrMayEval (ConstrContext (id,c))
-      | IDENT "Check"; c = Constr.constr ->
-	  ConstrMayEval (ConstrTypeOf c)
-      | IDENT "FreshId"; s = OPT STRING -> TacFreshId s
-      | IDENT "ipattern"; ":"; ipat = simple_intropattern -> IntroPattern ipat
-      | r = reference -> Reference r
-      | ta = tactic_arg0 -> ta ] ]
-  ;
-  tactic_arg1:
-    [ [ IDENT "Eval"; rtc = red_expr; "in"; c = Constr.constr ->
-	  ConstrMayEval (ConstrEval (rtc,c))
-      | IDENT "Inst"; id = identref; "["; c = Constr.constr; "]" ->
-	  ConstrMayEval (ConstrContext (id,c))
-      | IDENT "Check"; c = Constr.constr ->
-	  ConstrMayEval (ConstrTypeOf c)
-      | IDENT "FreshId"; s = OPT STRING -> TacFreshId s
-      | IDENT "ipattern"; ":"; ipat = simple_intropattern -> IntroPattern ipat
-      | r = reference; la = LIST1 tactic_arg0 -> TacCall (loc,r,la)
-      | r = reference -> Reference r
-      | ta = tactic_arg0 -> ta ] ]
-  ;
-  tactic_arg0:
-    [ [ "("; a = tactic_expr; ")" -> arg_of_expr a
-      | "()" -> TacVoid
-      | r = reference -> Reference r
-      | n = integer -> Integer n
-      | id = METAIDENT -> MetaIdArg (loc,id)
-      |	"?" -> ConstrMayEval (ConstrTerm (CHole loc))
-      | "?"; n = natural -> ConstrMayEval (ConstrTerm (CPatVar (loc,(false,Pattern.patvar_of_int n))))
-      |	"'"; c = Constr.constr -> ConstrMayEval (ConstrTerm c) ] ]
+  message_token:
+    [ [ id = identref -> MsgIdent (AI id)
+      | s = STRING -> MsgString s
+      | n = integer -> MsgInt n ] ]
   ;
 
   (* Definitions for tactics *)
-  deftok:
-    [ [ IDENT "Meta"
-      | IDENT "Tactic" ] ]
-  ;
   tacdef_body:
     [ [ name = identref; it=LIST1 input_fun; ":="; body = tactic_expr ->
 	  (name, TacFun (it, body))
@@ -204,10 +195,8 @@ GEXTEND Gram
     [ [ tac = tactic_expr -> tac ] ]
   ;
   Vernac_.command: 
-    [ [ deftok; "Definition"; b = tacdef_body ->
-          VernacDeclareTacticDefinition (false, [b])
-      | IDENT "Recursive"; deftok; "Definition"; 
-        l = LIST1 tacdef_body SEP "And" ->
+    [ [ IDENT "Ltac";
+        l = LIST1 tacdef_body SEP "with" ->
           VernacDeclareTacticDefinition (true, l) ] ]
   ;
   END
diff --git a/parsing/g_ltacnew.ml4 b/parsing/g_ltacnew.ml4
deleted file mode 100644
index 7492ac8c..00000000
--- a/parsing/g_ltacnew.ml4
+++ /dev/null
@@ -1,195 +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        *)
-(************************************************************************)
-
-(* $Id: g_ltacnew.ml4,v 1.22.2.3 2005/06/21 15:31:12 herbelin Exp $ *)
-
-open Pp
-open Util
-open Ast
-open Topconstr
-open Rawterm
-open Tacexpr
-open Vernacexpr
-open Ast
-open Pcoq
-open Prim
-open Tactic
-
-type let_clause_kind =
-  | LETTOPCLAUSE of Names.identifier * constr_expr
-  | LETCLAUSE of
-      (Names.identifier Util.located * raw_tactic_expr option * raw_tactic_arg)
-
-let fail_default_value = Genarg.ArgArg 0
-
-let out_letin_clause loc = function
-  | LETTOPCLAUSE _ -> user_err_loc (loc, "", (str "Syntax Error"))
-  | LETCLAUSE (id,c,d) -> (id,c,d)
-
-let make_letin_clause loc = List.map (out_letin_clause loc)
-
-let arg_of_expr = function
-    TacArg a -> a
-  | e -> Tacexp (e:raw_tactic_expr)
-    
-(* Tactics grammar rules *)
-
-let tactic_expr = Gram.Entry.create "tactic:tactic_expr"
-
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: tactic Vernac_.command tactic_expr tactic_arg constr_may_eval;
-
-  tactic_expr:
-    [ "5" LEFTA
-      [ ta0 = tactic_expr; ";"; ta1 = tactic_expr -> TacThen (ta0, ta1)
-      | ta = tactic_expr; ";"; "["; lta = LIST0 tactic_expr SEP "|"; "]" ->
-          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 = base_ident ->
-          TacAbstract (tc,Some s) ]
-(*End of To do*)
-    | "2" RIGHTA
-      [ 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)
-      | "match"; IDENT "goal"; "with"; mrl = match_context_list; "end" ->
-          TacMatchContext (false,mrl)
-      | "match"; IDENT "reverse"; IDENT "goal"; "with";
-        mrl = match_context_list; "end" ->
-          TacMatchContext (true,mrl)
-      |	"match"; c = tactic_expr; "with"; mrl = match_list; "end" ->
-          TacMatch (c,mrl)
-      | IDENT "first" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
-	  TacFirst l
-      | IDENT "solve" ; "["; l = LIST0 tactic_expr SEP "|"; "]" ->
-	  TacSolve l
-      | IDENT "idtac"; s = [ s = STRING -> s | -> ""] -> TacId s		
-      | IDENT "fail"; n = [ n = int_or_var -> n | -> fail_default_value ];
-	  s = [ s = STRING -> s | -> ""] -> TacFail (n,s)
-      | st = simple_tactic -> TacAtom (loc,st)
-      | a = may_eval_arg -> TacArg(a)
-      | IDENT "constr"; ":"; c = Constr.constr ->
-          TacArg(ConstrMayEval(ConstrTerm c))
-      | IDENT "ipattern"; ":"; ipat = simple_intropattern -> 
-	  TacArg(IntroPattern ipat)
-      | r = reference; la = LIST1 tactic_arg ->
-          TacArg(TacCall (loc,r,la))
-      | r = reference -> TacArg (Reference r) ]
-    | "0"
-      [ "("; a = tactic_expr; ")" -> a
-      | a = tactic_atom -> TacArg a ] ]
-  ;
-  (* Tactic arguments *)
-  tactic_arg:
-    [ [ IDENT "ltac"; ":"; a = tactic_expr LEVEL "0" -> arg_of_expr a
-      | IDENT "ipattern"; ":"; ipat = simple_intropattern -> IntroPattern ipat
-      | a = may_eval_arg -> a
-      | a = tactic_atom -> a
-      | c = Constr.constr -> ConstrMayEval (ConstrTerm c) ] ]
-  ;
-  may_eval_arg:
-    [ [ c = constr_eval -> ConstrMayEval c
-      | IDENT "fresh"; s = OPT STRING -> TacFreshId s ] ]
-  ;
-  constr_eval:
-    [ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
-	  ConstrEval (rtc,c)
-      | IDENT "context"; id = identref; "["; c = Constr.lconstr; "]" ->
-	  ConstrContext (id,c)
-      | IDENT "type"; IDENT "of"; c = Constr.constr ->
-	  ConstrTypeOf c ] ]
-  ;
-  constr_may_eval: (* For extensions *)
-    [ [ c = constr_eval -> c
-      | c = Constr.constr -> ConstrTerm c ] ]
-  ;
-  tactic_atom:
-    [ [ id = METAIDENT -> MetaIdArg (loc,id)
-      | r = reference -> Reference r
-      | "()" -> TacVoid ] ]
-  ;
-  input_fun:
-    [ [ "_" -> None 
-      | l = base_ident -> Some l ] ]
-  ;
-  let_clause:
-    [ [ id = identref; ":="; te = tactic_expr ->
-          LETCLAUSE (id, None, arg_of_expr te)
-      | id = identref; args = LIST1 input_fun; ":="; te = tactic_expr ->
-          LETCLAUSE (id, None, arg_of_expr (TacFun(args,te))) ] ]
-  ;
-  rec_clause:
-    [ [ name = identref; it = LIST1 input_fun; ":="; body = tactic_expr ->
-          (name,(it,body)) ] ]
-  ;
-  match_pattern:
-    [ [ IDENT "context";  oid = OPT Constr.ident;
-          "["; pc = Constr.lconstr_pattern; "]" ->
-        Subterm (oid, pc)
-      | pc = Constr.lconstr_pattern -> Term pc ] ]
-  ;
-  match_hyps:
-    [ [ na = name; ":"; mp =  match_pattern -> Hyp (na, mp) ] ]
-  ;
-  match_context_rule:
-    [ [ largs = LIST0 match_hyps SEP ","; "|-"; mp = match_pattern;
-        "=>"; te = tactic_expr -> Pat (largs, mp, te)
-      | "["; largs = LIST0 match_hyps SEP ","; "|-"; mp = match_pattern;
-        "]"; "=>"; te = tactic_expr -> Pat (largs, mp, te)
-      | "_"; "=>"; te = tactic_expr -> All te ] ]
-  ;
-  match_context_list:
-    [ [ mrl = LIST1 match_context_rule SEP "|" -> mrl
-      | "|"; mrl = LIST1 match_context_rule SEP "|" -> mrl ] ]
-  ;
-  match_rule:
-    [ [ mp = match_pattern; "=>"; te = tactic_expr -> Pat ([],mp,te)
-      | "_"; "=>"; te = tactic_expr -> All te ] ]
-  ;
-  match_list:
-    [ [ mrl = LIST1 match_rule SEP "|" -> mrl
-      | "|"; mrl = LIST1 match_rule SEP "|" -> mrl ] ]
-  ;
-
-  (* Definitions for tactics *)
-(*
-  deftok:
-    [ [ IDENT "Meta"
-      | IDENT "Tactic" ] ]
-  ;
-*)
-  tacdef_body:
-    [ [ name = identref; it=LIST1 input_fun; ":="; body = tactic_expr ->
-	  (name, TacFun (it, body))
-      | name = identref; ":="; body = tactic_expr ->
-	  (name, body) ] ]
-  ;
-  tactic:
-    [ [ tac = tactic_expr -> tac ] ]
-  ;
-  Vernac_.command: 
-    [ [ IDENT "Ltac";
-        l = LIST1 tacdef_body SEP "with" ->
-          VernacDeclareTacticDefinition (true, l) ] ]
-  ;
-  END
diff --git a/parsing/g_minicoq.ml4 b/parsing/g_minicoq.ml4
index dd4ef517..ed8dda5c 100644
--- a/parsing/g_minicoq.ml4
+++ b/parsing/g_minicoq.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_minicoq.ml4,v 1.17.6.1 2004/07/16 19:30:38 herbelin Exp $ *)
+(* $Id: g_minicoq.ml4 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Util
diff --git a/parsing/g_minicoq.mli b/parsing/g_minicoq.mli
index e19b1163..345d9575 100644
--- a/parsing/g_minicoq.mli
+++ b/parsing/g_minicoq.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: g_minicoq.mli,v 1.8.16.1 2004/07/16 19:30:39 herbelin Exp $ i*)
+(*i $Id: g_minicoq.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Pp
diff --git a/parsing/g_module.ml4 b/parsing/g_module.ml4
deleted file mode 100644
index 0b542608..00000000
--- a/parsing/g_module.ml4
+++ /dev/null
@@ -1,47 +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        *)
-(************************************************************************)
-
-(* $Id: g_module.ml4,v 1.6.2.1 2004/07/16 19:30:39 herbelin Exp $ *) 
-
-open Pp
-open Ast
-open Pcoq
-open Prim
-open Module
-open Util
-open Topconstr
-
-(* Grammar rules for module expressions and types *)
-
-if !Options.v7 then
-GEXTEND Gram
-  GLOBAL: module_expr module_type;
- 
-  module_expr:
-    [ [ qid = qualid -> CMEident qid
-      | me1 = module_expr; me2 = module_expr -> CMEapply (me1,me2)
-      | "("; me = module_expr; ")" -> me
-(* ... *)
-      ] ]
-  ;
-
-  with_declaration:
-    [ [ "Definition"; id = identref; ":="; c = Constr.constr ->
-          CWith_Definition (id,c)
-      | IDENT "Module"; id = identref; ":="; qid = qualid ->
-	  CWith_Module (id,qid)
-      ] ]
-  ;
-  
-  module_type:
-    [ [ qid = qualid -> CMTEident qid
-(* ... *)
-      | mty = module_type; "with"; decl = with_declaration -> 
-	  CMTEwith (mty,decl) ] ]
-  ;
-END
diff --git a/parsing/g_natsyntax.ml b/parsing/g_natsyntax.ml
index 46ef81f3..f764bc28 100644
--- a/parsing/g_natsyntax.ml
+++ b/parsing/g_natsyntax.ml
@@ -6,112 +6,21 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_natsyntax.ml,v 1.19.2.2 2004/09/08 13:47:51 herbelin Exp $ *)
+(* $Id: g_natsyntax.ml 7988 2006-02-04 20:28:29Z herbelin $ *)
 
-(* This file to allow writing (3) for (S (S (S O))) 
-   and still write (S y) for (S y) *)
+(* This file defines the printer for natural numbers in [nat] *)
 
+(*i*)
 open Pcoq
 open Pp
 open Util
 open Names
-open Coqast
-open Ast
 open Coqlib
-open Termast
-open Extend
-
-let ast_O = ast_of_ref glob_O
-let ast_S = ast_of_ref glob_S
-
-(* For example, (nat_of_string "3") is <<(S (S (S O)))>> *)
-let nat_of_int n dloc =
-  let ast_O = set_loc dloc ast_O in
-  let ast_S = set_loc dloc ast_S in
-  let rec mk_nat n =
-    if n <= 0 then 
-      ast_O
-    else 
-      Node(dloc,"APPLIST", [ast_S; mk_nat (n-1)])
-  in 
-  mk_nat n
-
-let pat_nat_of_int n dloc =
-  let ast_O = set_loc dloc ast_O in
-  let ast_S = set_loc dloc ast_S in
-  let rec mk_nat n =
-    if n <= 0 then 
-      ast_O
-    else 
-      Node(dloc,"PATTCONSTRUCT", [ast_S; mk_nat (n-1)])
-  in 
-  mk_nat n
-
-let nat_of_string s dloc = 
-  nat_of_int (int_of_string s) dloc
-
-let pat_nat_of_string s dloc = 
-  pat_nat_of_int (int_of_string s) dloc
-    
-exception Non_closed_number
-
-let rec int_of_nat_rec astS astO p =
-  match p with
-    | Node (_,"APPLIST", [b; a]) when alpha_eq(b,astS) ->
-	(int_of_nat_rec astS astO a)+1
-    | a when alpha_eq(a,astO) -> 1  
-          (***** YES, 1, non 0 ... to print the successor of p *)
-    | _ -> raise Non_closed_number
-	  
-let int_of_nat p =
-  try 
-    Some (int_of_nat_rec ast_S ast_O p)
-  with
-    Non_closed_number -> None
-
-let pr_S a = hov 0 (str "S" ++ brk (1,1) ++ a)
-
-let rec pr_external_S std_pr = function
-  | Node (l,"APPLIST", [b; a]) when alpha_eq (b,ast_S) ->
-      str"(" ++ pr_S (pr_external_S std_pr a) ++ str")"
-  | p -> std_pr p
-
-(* Declare the primitive printer *)
-
-(* Prints not p, but the SUCCESSOR of p !!!!! *)
-let nat_printer std_pr p =
-  match (int_of_nat p) with
-    | Some i -> str "(" ++ str (string_of_int i) ++ str ")"
-    | None -> str "(" ++ pr_S (pr_external_S std_pr p) ++ str ")"
-
-let _ = Esyntax.Ppprim.add ("nat_printer", nat_printer)
-(*
-(* Declare the primitive parser *)
-
-let unat = create_univ_if_new "nat"
-
-let number = create_constr_entry unat "number" 
-let pat_number = create_constr_entry unat "pat_number"
- 
-let _ = 
-  Gram.extend number None
-    [None, None,
-     [[Gramext.Stoken ("INT", "")],
-      Gramext.action nat_of_string]]
-
-let _ = 
-  Gram.extend pat_number None
-    [None, None,
-     [[Gramext.Stoken ("INT", "")],
-      Gramext.action pat_nat_of_string]]
-*)
-
-(*i*)
 open Rawterm
 open Libnames
-open Bignat
+open Bigint
 open Coqlib
-open Symbols
+open Notation
 open Pp
 open Util
 open Names
@@ -122,8 +31,7 @@ open Names
 (* For example, (nat_of_string "3") is <<(S (S (S O)))>> *)
 
 let nat_of_int dloc n =
-  match n with
-  | POS n ->
+  if is_pos_or_zero n then begin
       if less_than (of_string "5000") n & Options.is_verbose () then begin
 	warning ("You may experience stack overflow and segmentation fault\
                   \nwhile parsing numbers in nat greater than 5000");
@@ -132,30 +40,17 @@ let nat_of_int dloc n =
       let ref_O = RRef (dloc, glob_O) in
       let ref_S = RRef (dloc, glob_S) in
       let rec mk_nat acc n =
-	if is_nonzero n then 
+	if n <> zero then 
 	  mk_nat (RApp (dloc,ref_S, [acc])) (sub_1 n)
 	else 
 	  acc
       in 
       mk_nat ref_O n
-  | NEG n ->
+    end
+  else
       user_err_loc (dloc, "nat_of_int",
         str "Cannot interpret a negative number as a number of type nat")
 
-let pat_nat_of_int dloc n name =
-  match n with
-  | POS n -> 
-      let rec mk_nat n name =
-	if is_nonzero n then 
-	  PatCstr (dloc,path_of_S,[mk_nat (sub_1 n) Anonymous],name)
-	else 
-	  PatCstr (dloc,path_of_O,[],name)
-      in 
-      mk_nat n name
-  | NEG n ->
-      user_err_loc (dloc, "pat_nat_of_int",
-        str "Unable to interpret a negative number in type nat")
-
 (************************************************************************)
 (* Printing via scopes *)
 
@@ -168,19 +63,7 @@ let rec int_of_nat = function
 	  
 let uninterp_nat p =
   try 
-    Some (POS (int_of_nat p))
-  with
-    Non_closed_number -> None
-
-let rec int_of_nat_pattern = function
-  | PatCstr (_,s,[a],_) when ConstructRef s = glob_S ->
-      add_1 (int_of_nat_pattern a)
-  | PatCstr (_,z,[],_) when ConstructRef z = glob_O -> zero
-  | _ -> raise Non_closed_number
-	  
-let uninterp_nat_pattern p =
-  try 
-    Some (POS (int_of_nat_pattern p))
+    Some (int_of_nat p)
   with
     Non_closed_number -> None
 
@@ -188,42 +71,7 @@ let uninterp_nat_pattern p =
 (* Declare the primitive parsers and printers *)
 
 let _ =
-  Symbols.declare_numeral_interpreter "nat_scope"
-    (glob_nat,["Coq";"Init";"Datatypes"])
-    (nat_of_int,Some pat_nat_of_int)
-    ([RRef (dummy_loc,glob_S); RRef (dummy_loc,glob_O)], uninterp_nat, None)
-
-(************************************************************************)
-(* Old ast printing *)
-
-open Coqast
-open Ast
-open Termast
-
-let _ = if !Options.v7 then
-let ast_O = ast_of_ref glob_O in
-let ast_S = ast_of_ref glob_S in
-
-let rec int_of_nat = function
-  | Node (_,"APPLIST", [b; a]) when alpha_eq(b,ast_S) -> (int_of_nat a) + 1
-  | a when alpha_eq(a,ast_O) -> 0
-  | _ -> raise Non_closed_number
-in
-(* Prints not p, but the SUCCESSOR of p !!!!! *)
-let nat_printer_S p =
-  try 
-    Some (int (int_of_nat p + 1))
-  with
-    Non_closed_number -> None
-in
-let nat_printer_O _ =
-  Some (int 0)
-in
-(* Declare the primitive printers *)
-let _ =
-  Esyntax.declare_primitive_printer "nat_printer_S" "nat_scope" nat_printer_S
-in
-let _ = 
-  Esyntax.declare_primitive_printer "nat_printer_O" "nat_scope" nat_printer_O
-in
-()
+  Notation.declare_numeral_interpreter "nat_scope"
+    (nat_path,["Coq";"Init";"Datatypes"])
+    nat_of_int
+    ([RRef (dummy_loc,glob_S); RRef (dummy_loc,glob_O)], uninterp_nat, true)
diff --git a/parsing/g_natsyntax.mli b/parsing/g_natsyntax.mli
index 1471aed2..174be771 100644
--- a/parsing/g_natsyntax.mli
+++ b/parsing/g_natsyntax.mli
@@ -6,6 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: g_natsyntax.mli,v 1.3.16.1 2004/07/16 19:30:39 herbelin Exp $ i*)
+(*i $Id: g_natsyntax.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Nice syntax for naturals. *)
diff --git a/parsing/g_natsyntaxnew.mli b/parsing/g_natsyntaxnew.mli
index 50d38133..97fb8791 100644
--- a/parsing/g_natsyntaxnew.mli
+++ b/parsing/g_natsyntaxnew.mli
@@ -6,6 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: g_natsyntaxnew.mli,v 1.1.2.1 2004/07/16 19:30:39 herbelin Exp $ i*)
+(*i $Id: g_natsyntaxnew.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Nice syntax for naturals. *)
diff --git a/parsing/g_prim.ml4 b/parsing/g_prim.ml4
index ce6d4e2f..d5ca5e0c 100644
--- a/parsing/g_prim.ml4
+++ b/parsing/g_prim.ml4
@@ -6,133 +6,89 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: g_prim.ml4,v 1.22.2.2 2004/07/16 19:30:39 herbelin Exp $ i*)
+(*i $Id: g_prim.ml4 7922 2006-01-23 19:11:11Z herbelin $ i*)
 
-open Coqast
 open Pcoq
 open Names
 open Libnames
 open Topconstr
-open Prim
 
-let _ = reset_all_grammars()
+let prim_kw = ["{"; "}"; "["; "]"; "("; ")"; "'"]
+let _ = List.iter (fun s -> Lexer.add_token("",s)) prim_kw
 
+open Prim
 open Nametab
-let local_id_of_string = id_of_string
-let local_make_dirpath = make_dirpath
-let local_make_qualid l id' = make_qualid (local_make_dirpath l) id'
-let local_make_short_qualid id = make_short_qualid id
-let local_make_posint = int_of_string
-let local_make_negint n = - int_of_string n
-let local_make_path l a = encode_kn (local_make_dirpath l) a
-let local_make_binding loc a b =
-  match a with
-    | Nvar (_,id) -> Slam(loc,Some id,b)
-    | Nmeta (_,s) -> Smetalam(loc,s,b)
-    | _ -> failwith "Slam expects a var or a metavar"
-let local_append l id = l@[id]
 
-GEXTEND Gram
-  GLOBAL: ident natural integer bigint string preident ast
-    astlist qualid reference dirpath identref name base_ident var hyp;
+let local_make_qualid l id = make_qualid (make_dirpath l) id
 
- (* Compatibility: Prim.var is a synonym of Prim.ident *)
-  var:
-    [ [ id = ident -> id ] ]
-  ;
-  hyp:
-    [ [ id = ident -> id ] ]
-  ;
-  metaident:
-    [ [ s = METAIDENT -> Nmeta (loc,s) ] ]
-  ;
+GEXTEND Gram
+  GLOBAL: 
+    bigint natural integer identref name ident var preident
+    fullyqualid qualid reference dirpath
+    ne_string string;
   preident:
     [ [ s = IDENT -> s ] ]
   ;
-  base_ident:
-    [ [ s = IDENT -> local_id_of_string s ] ]
-  ;
-  name:
-    [ [ IDENT "_" -> (loc, Anonymous)
-      | id = base_ident -> (loc, Name id) ] ]
-  ;
-  identref:
-    [ [ id = base_ident -> (loc,id) ] ]
-  ;
   ident:
-    [ [ id = base_ident -> id ] ]
+    [ [ s = IDENT -> id_of_string s ] ]
   ;
-  natural:
-    [ [ i = INT -> local_make_posint i ] ]
+  var: (* as identref, but interpret as a term identifier in ltac *)
+    [ [ id = ident -> (loc,id) ] ]
   ;
-  bigint:
-    [ [ i = INT -> Bignat.POS (Bignat.of_string i)
-      | "-"; i = INT -> Bignat.NEG (Bignat.of_string i) ] ]
-  ;
-  integer:
-    [ [ i = INT      -> local_make_posint i
-      | "-"; i = INT -> local_make_negint i ] ]
+  identref:
+    [ [ id = ident -> (loc,id) ] ]
   ;
   field:
-    [ [ s = FIELD -> local_id_of_string s ] ]
-  ;
-  dirpath:
-    [ [ id = base_ident; l = LIST0 field ->
-        local_make_dirpath (local_append l id) ] ]
+    [ [ s = FIELD -> id_of_string s ] ]
   ;
   fields:
-    [ [ id = field; (l,id') = fields -> (local_append l id,id')
+    [ [ id = field; (l,id') = fields -> (l@[id],id')
       | id = field -> ([],id)
       ] ]
   ;
+  fullyqualid:
+    [ [ id = ident; (l,id')=fields -> loc,id::List.rev (id'::l)
+      | id = ident -> loc,[id]
+      ] ]
+  ;
   basequalid:
-    [ [ id = base_ident; (l,id')=fields -> local_make_qualid (local_append l id) id'
-      | id = base_ident -> local_make_short_qualid id
+    [ [ id = ident; (l,id')=fields -> local_make_qualid (l@[id]) id'
+      | id = ident -> make_short_qualid id
       ] ]
   ;
-  qualid:
-    [ [ qid = basequalid -> loc, qid ] ]
+  name:
+    [ [ IDENT "_" -> (loc, Anonymous)
+      | id = ident -> (loc, Name id) ] ]
   ;
   reference:
-    [ [ id = base_ident; (l,id') = fields ->
-        Qualid (loc, local_make_qualid (local_append l id) id')
-      | id = base_ident -> Ident (loc,id)
+    [ [ id = ident; (l,id') = fields ->
+        Qualid (loc, local_make_qualid (l@[id]) id')
+      | id = ident -> Ident (loc,id)
       ] ]
   ;
+  qualid:
+    [ [ qid = basequalid -> loc, qid ] ]
+  ;
+  ne_string:
+    [ [ s = STRING -> 
+        if s="" then Util.user_err_loc(loc,"",Pp.str"Empty string"); s
+    ] ]
+  ;
+  dirpath:
+    [ [ id = ident; l = LIST0 field ->
+        make_dirpath (l@[id]) ] ]
+  ;
   string:
     [ [ s = STRING -> s ] ]
   ;
-  astpath:
-    [ [ id = base_ident; (l,a) = fields ->
-          Path(loc, local_make_path (local_append l id) a)
-      | id = base_ident -> Nvar(loc, id)
-      ] ]
+  integer:
+    [ [ i = INT      -> int_of_string i
+      | "-"; i = INT -> - int_of_string i ] ]
   ;
-  (* ast *)
-  ast:
-    [ [ id = metaident -> id
-      | p = astpath -> p
-      | s = INT -> Num(loc, local_make_posint s)
-      | s = STRING -> Str(loc, s)
-      | "{"; s = METAIDENT; "}" -> Id(loc,s)
-      | "("; nname = IDENT; l = LIST0 ast; ")" -> Node(loc,nname,l)
-      | "("; METAIDENT "$LIST"; id = metaident; ")" -> Node(loc,"$LIST",[id])
-      | "("; METAIDENT "$STR"; id = metaident; ")" -> Node(loc,"$STR",[id])
-      | "("; METAIDENT "$VAR"; id = metaident; ")" -> Node(loc,"$VAR",[id])
-      | "("; METAIDENT "$ID"; id = metaident; ")" -> Node(loc,"$ID",[id])
-      | "("; METAIDENT "$ABSTRACT"; l = LIST0 ast;")"->Node(loc,"$ABSTRACT",l)
-      | "("; METAIDENT "$PATH"; id = metaident; ")" -> Node(loc,"$PATH",[id])
-      | "("; METAIDENT "$NUM"; id = metaident; ")" -> Node(loc,"$NUM",[id])
-      | "["; "<>"; "]"; b = ast -> Slam(loc,None,b)
-      | "["; a = ast; "]"; b = ast -> local_make_binding loc a b
-
-(*
-      | "["; ido = astidoption; "]"; b = ast -> Slam(loc,ido,b)
-      | "["; id = METAIDENT; "]"; b = ast -> Smetalam(loc,id,b)
-*)
-      | "'"; a = ast -> Node(loc,"$QUOTE",[a]) ] ]
-  ;
-  astlist:
-    [ [ l = LIST0 ast -> l ] ]
+  natural:
+    [ [ i = INT -> int_of_string i ] ]
+  ;
+  bigint: (* Negative numbers are dealt with specially *)
+    [ [ i = INT -> (Bigint.of_string i) ] ]
   ;
 END
diff --git a/parsing/g_primnew.ml4 b/parsing/g_primnew.ml4
deleted file mode 100644
index c1875634..00000000
--- a/parsing/g_primnew.ml4
+++ /dev/null
@@ -1,84 +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: g_primnew.ml4,v 1.4.2.2 2004/07/16 19:30:39 herbelin Exp $ i*)
-
-open Coqast
-open Pcoq
-open Names
-open Libnames
-open Topconstr
-
-let _ =
-  if not !Options.v7 then
-    Pcoq.reset_all_grammars()
-let _ =
-  if not !Options.v7 then
-  let f = Gram.Unsafe.clear_entry in
-  f Prim.bigint;
-  f Prim.qualid;
-  f Prim.ast;
-  f Prim.reference
-
-let prim_kw = ["{"; "}"; "["; "]"; "("; ")"; "<>"; "<<"; ">>"; "'"]
-let _ = 
-  if not !Options.v7 then
-    List.iter (fun s -> Lexer.add_token("",s)) prim_kw
-
-open Prim
-
-open Nametab
-let local_id_of_string = id_of_string
-let local_make_dirpath = make_dirpath
-let local_make_qualid l id' = make_qualid (local_make_dirpath l) id'
-let local_make_short_qualid id = make_short_qualid id
-let local_make_posint = int_of_string
-let local_make_negint n = - int_of_string n
-let local_make_path l a = encode_kn (local_make_dirpath l) a
-let local_make_binding loc a b =
-  match a with
-    | Nvar (_,id) -> Slam(loc,Some id,b)
-    | Nmeta (_,s) -> Smetalam(loc,s,b)
-    | _ -> failwith "Slam expects a var or a metavar"
-let local_append l id = l@[id]
-
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: bigint qualid reference ne_string;
-  field:
-    [ [ s = FIELD -> local_id_of_string s ] ]
-  ;
-  fields:
-    [ [ id = field; (l,id') = fields -> (local_append l id,id')
-      | id = field -> ([],id)
-      ] ]
-  ;
-  basequalid:
-    [ [ id = base_ident; (l,id')=fields ->
-          local_make_qualid (local_append l id) id'
-      | id = base_ident -> local_make_short_qualid id
-      ] ]
-  ;
-  reference:
-    [ [ id = base_ident; (l,id') = fields ->
-        Qualid (loc, local_make_qualid (local_append l id) id')
-      | id = base_ident -> Ident (loc,id)
-      ] ]
-  ;
-  qualid:
-    [ [ qid = basequalid -> loc, qid ] ]
-  ;
-  ne_string:
-    [ [ s = STRING -> 
-        if s="" then Util.user_err_loc(loc,"",Pp.str"Empty string"); s
-    ] ]
-  ;
-  bigint: (* Negative numbers are dealt with specially *)
-    [ [ i = INT -> Bignat.POS (Bignat.of_string i) ] ]
-  ;
-END
diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4
index 5262b785..886b33e2 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,v 1.33.2.1 2004/07/16 19:30:39 herbelin Exp $ *)
+(* $Id: g_proofs.ml4 7936 2006-01-28 18:36:54Z herbelin $ *)
 
 open Pcoq
 open Pp
@@ -18,10 +18,9 @@ open Vernacexpr
 open Prim
 open Constr
 
-let thm_token = Gram.Entry.create "vernac:thm_token"
+let thm_token = G_vernac.thm_token
 
 (* Proof commands *)
-if !Options.v7 then
 GEXTEND Gram
   GLOBAL: command;
 
@@ -35,27 +34,29 @@ GEXTEND Gram
     | ":"; l = LIST1 IDENT -> l ] ]
   ;
   command:
-    [ [ IDENT "Goal"; c = Constr.constr -> VernacGoal c
-      | "Proof" -> VernacProof (Tacexpr.TacId "")
-      | "Proof"; "with"; ta = tactic -> VernacProof ta
+    [ [ IDENT "Goal"; c = lconstr -> VernacGoal c
+      | IDENT "Proof" -> VernacProof (Tacexpr.TacId [])
+      | IDENT "Proof"; "with"; ta = tactic -> VernacProof ta
       | IDENT "Abort" -> VernacAbort None
       | IDENT "Abort"; IDENT "All" -> VernacAbortAll
       | IDENT "Abort"; id = identref -> VernacAbort (Some id)
+      | IDENT "Existential"; n = natural; c = constr_body ->
+	  VernacSolveExistential (n,c)
       | IDENT "Admitted" -> VernacEndProof Admitted
-      | "Qed" -> VernacEndProof (Proved (true,None))
+      | IDENT "Qed" -> VernacEndProof (Proved (true,None))
       | IDENT "Save" -> VernacEndProof (Proved (true,None))
-      | IDENT "Defined" -> VernacEndProof (Proved (false,None))
-      |	IDENT "Defined"; id=identref -> 
-	  VernacEndProof (Proved (false,Some (id,None)))
       | IDENT "Save"; tok = thm_token; id = identref ->
 	  VernacEndProof (Proved (true,Some (id,Some tok)))
       | IDENT "Save"; id = identref ->
 	  VernacEndProof (Proved (true,Some (id,None)))
+      | IDENT "Defined" -> VernacEndProof (Proved (false,None))
+      |	IDENT "Defined"; id=identref -> 
+	  VernacEndProof (Proved (false,Some (id,None)))
       | IDENT "Suspend" -> VernacSuspend
       | IDENT "Resume" -> VernacResume None
       | IDENT "Resume"; id = identref -> VernacResume (Some id)
       | IDENT "Restart" -> VernacRestart
-      | "Proof"; c = Constr.constr -> VernacExactProof c
+      | IDENT "Proof"; c = lconstr -> VernacExactProof c
       | IDENT "Undo" -> VernacUndo 1
       | IDENT "Undo"; n = natural -> VernacUndo n
       | IDENT "Focus" -> VernacFocus None
@@ -63,20 +64,20 @@ GEXTEND Gram
       | IDENT "Unfocus" -> VernacUnfocus
       | IDENT "Show" -> VernacShow (ShowGoal None)
       | IDENT "Show"; n = natural -> VernacShow (ShowGoal (Some n))
-      | IDENT "Show"; IDENT "Implicits"; n = natural ->
-	  VernacShow (ShowGoalImplicitly (Some n))
-      | IDENT "Show"; IDENT "Implicits" -> VernacShow (ShowGoalImplicitly None)
+      | IDENT "Show"; IDENT "Implicit"; IDENT "Arguments"; n = OPT natural ->
+	  VernacShow (ShowGoalImplicitly n)
       | IDENT "Show"; IDENT "Node" -> VernacShow ShowNode
       | IDENT "Show"; IDENT "Script" -> VernacShow ShowScript
       | IDENT "Show"; IDENT "Existentials" -> VernacShow ShowExistentials
       | IDENT "Show"; IDENT "Tree" -> VernacShow ShowTree
       | IDENT "Show"; IDENT "Conjectures" -> VernacShow ShowProofNames
-      | IDENT "Show"; "Proof" -> VernacShow ShowProof
+      | IDENT "Show"; IDENT "Proof" -> VernacShow ShowProof
       | IDENT "Show"; IDENT "Intro" -> VernacShow (ShowIntros false)
       | IDENT "Show"; IDENT "Intros" -> VernacShow (ShowIntros true)
-      | IDENT "Explain"; "Proof"; l = LIST0 integer ->
+      | IDENT "Show"; IDENT "Match"; id = identref -> VernacShow (ShowMatch id)
+      | IDENT "Explain"; IDENT "Proof"; l = LIST0 integer ->
 	  VernacShow (ExplainProof l)
-      | IDENT "Explain"; "Proof"; IDENT "Tree"; l = LIST0 integer -> 
+      | IDENT "Explain"; IDENT "Proof"; IDENT "Tree"; l = LIST0 integer -> 
 	  VernacShow (ExplainTree l)
       | IDENT "Go"; n = natural -> VernacGo (GoTo n)
       | IDENT "Go"; IDENT "top" -> VernacGo GoTop
@@ -84,26 +85,13 @@ GEXTEND Gram
       | IDENT "Go"; IDENT "next" -> VernacGo GoNext
       | IDENT "Guarded" -> VernacCheckGuard
 (* Hints for Auto and EAuto *)
-
-      | IDENT "HintDestruct"; 
-	  local = locality;
-          dloc = destruct_location;
-          id  = base_ident;
-          hyptyp = Constr.constr_pattern;
-          pri = natural;
-          "["; tac = tactic; "]" -> 
-	    VernacHints(local,[],HintsDestruct (id,pri,dloc,hyptyp,tac))
-
-      | IDENT "Hint"; local = locality; hintname = base_ident; 
-	  dbnames = opt_hintbases; ":="; h = hint
-          -> VernacHints (local,dbnames, h hintname)
-	  
-      | IDENT "Hints"; local = locality; 
-	  (dbnames,h) = hints -> VernacHints (local,dbnames, h)
+      | IDENT "Hint"; local = locality; h = hint;
+        dbnames = opt_hintbases ->
+	  VernacHints (local,dbnames, h)
 	  
 
 (*This entry is not commented, only for debug*)
-      | IDENT "PrintConstr"; c = Constr.constr -> 
+      | IDENT "PrintConstr"; c = constr -> 
 	  VernacExtend ("PrintConstr",
 	    [Genarg.in_gen Genarg.rawwit_constr c])
       ] ];
@@ -112,24 +100,23 @@ GEXTEND Gram
     [ [ IDENT "Local" -> true | -> false ] ]
   ;
   hint:
-    [ [ IDENT "Resolve"; c = Constr.constr -> fun name -> HintsResolve [Some name, c]
-      | IDENT "Immediate"; c = Constr.constr -> fun name -> HintsImmediate [Some name, c]
-      | IDENT "Unfold"; qid = global -> fun name -> HintsUnfold [Some name,qid]
-      | IDENT "Constructors"; c = global -> fun n ->
-          HintsConstructors (Some n,[c])
-      | IDENT "Extern"; n = natural; c = Constr.constr ; tac = tactic ->
-	  fun name -> HintsExtern (Some name,n,c,tac) ] ]
-  ;
-  hints:
-    [ [ IDENT "Resolve"; l = LIST1 global; dbnames = opt_hintbases ->
-         (dbnames, 
-	  HintsResolve
-	    (List.map (fun qid -> (None, CAppExpl(loc,(None,qid),[]))) l))
-      | IDENT "Immediate"; l = LIST1 global; dbnames = opt_hintbases ->
-        (dbnames, 
-	 HintsImmediate
-	   (List.map (fun qid-> (None, CAppExpl (loc,(None,qid),[]))) l))
-      | IDENT "Unfold"; l = LIST1 global; dbnames = opt_hintbases ->
-        (dbnames, HintsUnfold (List.map (fun qid -> (None,qid)) l)) ] ]
+    [ [ IDENT "Resolve"; lc = LIST1 constr -> HintsResolve lc
+      | IDENT "Immediate"; lc = LIST1 constr -> HintsImmediate lc
+      | IDENT "Unfold"; lqid = LIST1 global -> HintsUnfold lqid
+      | IDENT "Constructors"; lc = LIST1 global -> HintsConstructors lc
+      | IDENT "Extern"; n = natural; c = constr_pattern ; "=>";
+          tac = tactic ->
+	  HintsExtern (n,c,tac)
+      | IDENT "Destruct"; 
+          id = ident; ":=";
+          pri = natural;
+          dloc = destruct_location;
+          hyptyp = constr_pattern;
+          "=>"; tac = tactic ->
+            HintsDestruct(id,pri,dloc,hyptyp,tac) ] ]
     ;
-  END
+  constr_body:
+    [ [ ":="; c = lconstr -> c
+      | ":"; t = lconstr; ":="; c = lconstr -> CCast(loc,c,Term.DEFAULTcast,t) ] ]
+  ;
+END
diff --git a/parsing/g_proofsnew.ml4 b/parsing/g_proofsnew.ml4
deleted file mode 100644
index 04bf7a8b..00000000
--- a/parsing/g_proofsnew.ml4
+++ /dev/null
@@ -1,126 +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        *)
-(************************************************************************)
-
-(* $Id: g_proofsnew.ml4,v 1.9.2.1 2004/07/16 19:30:39 herbelin Exp $ *)
-
-open Pcoq
-open Pp
-open Tactic
-open Util
-open Vernac_
-open Topconstr
-open Vernacexpr
-open Prim
-open Constr
-
-let thm_token = G_vernacnew.thm_token
-
-(* Proof commands *)
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: command;
-
-  destruct_location :
-  [ [ IDENT "Conclusion"  -> Tacexpr.ConclLocation ()
-    | discard = [ IDENT "Discardable" -> true | -> false ]; "Hypothesis"
-	-> Tacexpr.HypLocation discard ] ]
-  ;
-  opt_hintbases:
-  [ [ -> []
-    | ":"; l = LIST1 IDENT -> l ] ]
-  ;
-  command:
-    [ [ IDENT "Goal"; c = Constr.lconstr -> VernacGoal c
-      | IDENT "Proof" -> VernacNop
-      | IDENT "Proof"; "with"; ta = tactic -> VernacProof ta
-      | IDENT "Abort" -> VernacAbort None
-      | IDENT "Abort"; IDENT "All" -> VernacAbortAll
-      | IDENT "Abort"; id = identref -> VernacAbort (Some id)
-      | IDENT "Existential"; n = natural; c = constr_body ->
-	  VernacSolveExistential (n,c)
-      | IDENT "Admitted" -> VernacEndProof Admitted
-      | IDENT "Qed" -> VernacEndProof (Proved (true,None))
-      | IDENT "Save" -> VernacEndProof (Proved (true,None))
-      | IDENT "Save"; tok = thm_token; id = identref ->
-	  VernacEndProof (Proved (true,Some (id,Some tok)))
-      | IDENT "Save"; id = identref ->
-	  VernacEndProof (Proved (true,Some (id,None)))
-      | IDENT "Defined" -> VernacEndProof (Proved (false,None))
-      |	IDENT "Defined"; id=identref -> 
-	  VernacEndProof (Proved (false,Some (id,None)))
-      | IDENT "Suspend" -> VernacSuspend
-      | IDENT "Resume" -> VernacResume None
-      | IDENT "Resume"; id = identref -> VernacResume (Some id)
-      | IDENT "Restart" -> VernacRestart
-      | IDENT "Proof"; c = Constr.lconstr -> VernacExactProof c
-      | IDENT "Undo" -> VernacUndo 1
-      | IDENT "Undo"; n = natural -> VernacUndo n
-      | IDENT "Focus" -> VernacFocus None
-      | IDENT "Focus"; n = natural -> VernacFocus (Some n)
-      | IDENT "Unfocus" -> VernacUnfocus
-      | IDENT "Show" -> VernacShow (ShowGoal None)
-      | IDENT "Show"; n = natural -> VernacShow (ShowGoal (Some n))
-      | IDENT "Show"; IDENT "Implicit"; IDENT "Arguments"; n = OPT natural ->
-	  VernacShow (ShowGoalImplicitly n)
-      | IDENT "Show"; IDENT "Node" -> VernacShow ShowNode
-      | IDENT "Show"; IDENT "Script" -> VernacShow ShowScript
-      | IDENT "Show"; IDENT "Existentials" -> VernacShow ShowExistentials
-      | IDENT "Show"; IDENT "Tree" -> VernacShow ShowTree
-      | IDENT "Show"; IDENT "Conjectures" -> VernacShow ShowProofNames
-      | IDENT "Show"; IDENT "Proof" -> VernacShow ShowProof
-      | IDENT "Show"; IDENT "Intro" -> VernacShow (ShowIntros false)
-      | IDENT "Show"; IDENT "Intros" -> VernacShow (ShowIntros true)
-      | IDENT "Explain"; IDENT "Proof"; l = LIST0 integer ->
-	  VernacShow (ExplainProof l)
-      | IDENT "Explain"; IDENT "Proof"; IDENT "Tree"; l = LIST0 integer -> 
-	  VernacShow (ExplainTree l)
-      | IDENT "Go"; n = natural -> VernacGo (GoTo n)
-      | IDENT "Go"; IDENT "top" -> VernacGo GoTop
-      | IDENT "Go"; IDENT "prev" -> VernacGo GoPrev
-      | IDENT "Go"; IDENT "next" -> VernacGo GoNext
-      | IDENT "Guarded" -> VernacCheckGuard
-(* Hints for Auto and EAuto *)
-      | IDENT "Hint"; local = locality; h = hint;
-        dbnames = opt_hintbases ->
-	  VernacHints (local,dbnames, h)
-	  
-
-(*This entry is not commented, only for debug*)
-      | IDENT "PrintConstr"; c = Constr.constr -> 
-	  VernacExtend ("PrintConstr",
-	    [Genarg.in_gen Genarg.rawwit_constr c])
-      ] ];
-
-  locality:
-    [ [ IDENT "Local" -> true | -> false ] ]
-  ;
-  hint:
-    [ [ IDENT "Resolve"; lc = LIST1 Constr.constr ->
-          HintsResolve (List.map (fun c -> (None, c)) lc)
-      | IDENT "Immediate"; lc = LIST1 Constr.constr ->
-          HintsImmediate (List.map (fun c -> (None,c)) lc)
-      | IDENT "Unfold"; lqid = LIST1 global ->
-          HintsUnfold (List.map (fun g -> (None,g)) lqid)
-      | IDENT "Constructors"; lc = LIST1 global ->
-          HintsConstructors (None,lc)
-      | IDENT "Extern"; n = natural; c = Constr.constr_pattern ; "=>";
-          tac = tactic ->
-	  HintsExtern (None,n,c,tac)
-      | IDENT"Destruct"; 
-          id = base_ident; ":=";
-          pri = natural;
-          dloc = destruct_location;
-          hyptyp = Constr.constr_pattern;
-          "=>"; tac = tactic ->
-            HintsDestruct(id,pri,dloc,hyptyp,tac) ] ]
-    ;
-  constr_body:
-    [ [ ":="; c = lconstr -> c
-      | ":"; t = lconstr; ":="; c = lconstr -> CCast(loc,c,t) ] ]
-  ;
-END
diff --git a/parsing/g_rsyntax.ml b/parsing/g_rsyntax.ml
index 8f5aad33..45647903 100644
--- a/parsing/g_rsyntax.ml
+++ b/parsing/g_rsyntax.ml
@@ -6,215 +6,47 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Coqast
-open Ast
 open Pp
 open Util
 open Names
 open Pcoq
-open Extend
 open Topconstr
 open Libnames
 
-(**********************************************************************)
-(* Parsing with Grammar                                               *)
-(**********************************************************************)
-
-let get_r_sign loc =
-  let mkid id =
-    mkRefC (Qualid (loc,Libnames.make_short_qualid id))
-  in
-  ((mkid (id_of_string "R0"),
-    mkid (id_of_string "R1"),
-    mkid (id_of_string "Rplus"),
-    mkid (id_of_string "Rmult"),
-    mkid (id_of_string "NRplus"),
-    mkid (id_of_string "NRmult")))
-
-let get_r_sign_ast loc =
-  let mkid id =
-    Termast.ast_of_ref (Nametab.locate (Libnames.make_short_qualid id))
-  in
-  ((mkid (id_of_string "R0"),
-    mkid (id_of_string "R1"),
-    mkid (id_of_string "Rplus"), 
-    mkid (id_of_string "Rmult"),
-    mkid (id_of_string "NRplus"),
-    mkid (id_of_string "NRmult")))
-
-(* We have the following interpretation:
-  [| 0 |] = 0
-  [| 1 |] = 1
-  [| 2 |] = 1 + 1
-  [| 3 |] = 1 + (1 + 1)
-  [| 2n |] = 2 * [| n |]         for n >= 2
-  [| 2n+1 |] = 1 + 2 * [| n |]   for n >= 2
-  [| -n |] = - [| n |]           for n >= 0
-*)
-
-let int_decomp n = 
-let div2 k = 
-let x = k mod 2 in
-let y = k - x in (x,y/2) in
-let rec list_ch m =
-if m< 2 then [m]
-else let (x1,x2) = div2 m in x1::(list_ch x2)
-in list_ch n
-
-let _ = if !Options.v7 then
-let r_of_int n dloc =
-  let (a0,a1,plus,mult,_,_) = get_r_sign dloc in
-  let list_ch = int_decomp n in
-  let a2 = mkAppC (plus, [a1; a1]) in
-  let rec mk_r l =
-    match l with
-    | [] -> failwith "Error r_of_int"
-    | [a] -> if a=1 then a1 else a0
-    | [a;b] -> if a==1 then mkAppC (plus, [a1; a2]) else a2
-    | a::l' -> if a=1 then mkAppC (plus, [a1; mkAppC (mult, [a2; mk_r l'])]) else mkAppC (mult, [a2; mk_r l'])
-  in mk_r list_ch
-in
-let r_of_string s dloc = 
-  r_of_int (int_of_string s) dloc
-in
-let rsyntax_create name =
-  let e =
-    Pcoq.create_constr_entry (Pcoq.get_univ "rnatural") name in
-  Pcoq.Gram.Unsafe.clear_entry e;
-  e
-in
-let rnumber = rsyntax_create "rnumber"
-in
-let _ = 
-  Gram.extend rnumber None
-    [None, None,
-     [[Gramext.Stoken ("INT", "")],
-      Gramext.action r_of_string]]
-in ()
-
-(**********************************************************************)
-(* Old ast printing                                                   *)
-(**********************************************************************)
-
 exception Non_closed_number
 
-let _ = if !Options.v7 then
-let int_of_r p =
-  let (a0,a1,plus,mult,_,_) = get_r_sign_ast dummy_loc in
-  let rec int_of_r_rec p = 
-    match p with
-  | Node (_,"APPLIST", [b;a;c]) when alpha_eq(b,plus) & alpha_eq(a,a1) & alpha_eq(c,a1) -> 2
-  | Node (_,"APPLIST", [b;a;c]) when alpha_eq(b,plus) & alpha_eq(a,a1) ->
-      (match c with
-      |	Node (_,"APPLIST", [e;d;f]) when alpha_eq(e,mult) -> 1 + int_of_r_rec c
-      |	Node (_,"APPLIST", [e;d;f]) when alpha_eq(e,plus) & alpha_eq(d,a1) & alpha_eq(f,a1) -> 3
-      |	_ -> raise Non_closed_number)
-  | Node (_,"APPLIST", [b;a;c]) when alpha_eq(b,mult) ->
-      (match a with
-      |	Node (_,"APPLIST", [e;d;f]) when alpha_eq(e,plus) & alpha_eq(d,a1) & alpha_eq(f,a1) ->
-	  (match c with
-	  | g when alpha_eq(g,a1) -> raise Non_closed_number
-	  | g when alpha_eq(g,a0) -> raise Non_closed_number
-	  | _ -> 2 * int_of_r_rec c)
-      |	_ -> raise Non_closed_number)
-  | a when alpha_eq(a,a0) -> 0
-  | a when alpha_eq(a,a1) -> 1
-  | _ -> raise Non_closed_number in
-  try 
-    Some (int_of_r_rec p)
-  with
-    Non_closed_number -> None
-in
-let replace_plus p = 
-  let (_,_,_,_,astnrplus,_) = get_r_sign_ast dummy_loc in
-  ope ("REXPR",[ope("APPLIST",[astnrplus;p])])
-in
-let replace_mult p = 
-  let (_,_,_,_,_,astnrmult) = get_r_sign_ast dummy_loc in
-  ope ("REXPR",[ope("APPLIST",[astnrmult;p])])
-in
-let rec r_printer_odd std_pr p =
-  let (_,a1,plus,_,_,_) = get_r_sign_ast dummy_loc in
-  match (int_of_r (ope("APPLIST",[plus;a1;p]))) with
-    | Some i -> str (string_of_int i)
-    | None -> std_pr (replace_plus p)
-in
-let rec r_printer_odd_outside std_pr p =
-  let (_,a1,plus,_,_,_) = get_r_sign_ast dummy_loc in
-  match (int_of_r (ope("APPLIST",[plus;a1;p]))) with
-    | Some i -> str"``" ++ str (string_of_int i) ++ str"``"
-    | None -> std_pr (replace_plus p)
-in
-let rec r_printer_even std_pr p =
-  let (_,a1,plus,mult,_,_) = get_r_sign_ast dummy_loc in
-  match (int_of_r (ope("APPLIST",[mult;(ope("APPLIST",[plus;a1;a1]));p]))) with
-    | Some i -> str (string_of_int i)
-    | None -> std_pr (replace_mult p)
-in
-let rec r_printer_even_outside std_pr p =
-  let (_,a1,plus,mult,_,_) = get_r_sign_ast dummy_loc in
-  match (int_of_r (ope("APPLIST",[mult;(ope("APPLIST",[plus;a1;a1]));p]))) with
-    | Some i -> str"``" ++ str (string_of_int i) ++ str"``"
-    | None -> std_pr (replace_mult p)
-in
-let _ = Esyntax.Ppprim.add ("r_printer_odd", r_printer_odd) in
-let _ = Esyntax.Ppprim.add ("r_printer_odd_outside", r_printer_odd_outside) in
-let _ = Esyntax.Ppprim.add ("r_printer_even", r_printer_even) in
-let _ = Esyntax.Ppprim.add ("r_printer_even_outside", r_printer_even_outside)
-in ()
-
 (**********************************************************************)
 (* Parsing R via scopes                                               *)
 (**********************************************************************)
 
 open Libnames
 open Rawterm
-open Bignat
+open Bigint
 
 let make_dir l = make_dirpath (List.map id_of_string (List.rev l))
 let rdefinitions = make_dir ["Coq";"Reals";"Rdefinitions"]
+let make_path dir id = Libnames.make_path dir (id_of_string id)
+
+let r_path = make_path rdefinitions "R"
 
 (* TODO: temporary hack *)
-let make_path dir id = Libnames.encode_kn dir (id_of_string id)
+let make_path dir id = Libnames.encode_con dir (id_of_string id)
 
-let glob_R = ConstRef (make_path rdefinitions "R")
+let r_kn = make_path rdefinitions "R"
+let glob_R = ConstRef r_kn
 let glob_R1 = ConstRef (make_path rdefinitions "R1")
 let glob_R0 = ConstRef (make_path rdefinitions "R0")
 let glob_Ropp = ConstRef (make_path rdefinitions "Ropp")
 let glob_Rplus = ConstRef (make_path rdefinitions "Rplus")
 let glob_Rmult = ConstRef (make_path rdefinitions "Rmult")
 
-(* V7 *)
-let r_of_posint dloc n =
-  let ref_R0 = RRef (dloc, glob_R0) in
-  let ref_R1 = RRef (dloc, glob_R1) in
-  let ref_Rplus = RRef (dloc, glob_Rplus) in
-  let ref_Rmult = RRef (dloc, glob_Rmult) in
-  let a2 = RApp(dloc, ref_Rplus, [ref_R1; ref_R1]) in
-  let list_ch = int_decomp n in
-  let rec mk_r l =
-    match l with
-    | [] -> failwith "Error r_of_posint"
-    | [a] -> if a=1 then ref_R1 else ref_R0
-    | a::[b] -> if a==1 then RApp (dloc, ref_Rplus, [ref_R1; a2]) else a2
-    | a::l' -> if a=1 then RApp (dloc, ref_Rplus, [ref_R1; RApp (dloc, ref_Rmult, [a2; mk_r l'])]) else RApp (dloc, ref_Rmult, [a2; mk_r l'])
-  in mk_r list_ch
-
-(* int_of_string o bigint_to_string : temporary hack ... *)
-(* utiliser les bigint de caml ? *)
-let r_of_int2 dloc z =
-  match z with
-  | NEG n -> RApp (dloc, RRef(dloc,glob_Ropp), [r_of_posint dloc (int_of_string (bigint_to_string (POS n)))]) 
-  | POS n -> r_of_posint dloc (int_of_string (bigint_to_string z))
-
-(* V8 *)
 let two = mult_2 one
 let three = add_1 two
 let four = mult_2 two
 
 (* Unary representation of strictly positive numbers *)
 let rec small_r dloc n =
-  if is_one n then RRef (dloc, glob_R1)
+  if equal one n then RRef (dloc, glob_R1)
   else RApp(dloc,RRef (dloc,glob_Rplus),
             [RRef (dloc, glob_R1);small_r dloc (sub_1 n)])
 
@@ -227,12 +59,13 @@ let r_of_posint dloc n =
       let (q,r) = div2_with_rest n in
       let b = RApp(dloc,RRef(dloc,glob_Rmult),[r2;r_of_pos q]) in
       if r then RApp(dloc,RRef(dloc,glob_Rplus),[r1;b]) else b in
-  if is_nonzero n then r_of_pos n else RRef(dloc,glob_R0)
+  if n <> zero then r_of_pos n else RRef(dloc,glob_R0)
 
 let r_of_int dloc z =
-  match z with
-  | NEG n -> RApp (dloc, RRef(dloc,glob_Ropp), [r_of_posint dloc n]) 
-  | POS n -> r_of_posint dloc n
+  if is_strictly_neg z then
+    RApp (dloc, RRef(dloc,glob_Ropp), [r_of_posint dloc (neg z)]) 
+  else
+    r_of_posint dloc z
 
 (**********************************************************************)
 (* Printing R via scopes                                              *)
@@ -268,8 +101,11 @@ in
 bignat_of_r
 
 let bigint_of_r = function
-  | RApp (_,RRef (_,o), [a]) when o = glob_Ropp -> NEG (bignat_of_r a)
-  | a -> POS (bignat_of_r a)
+  | RApp (_,RRef (_,o), [a]) when o = glob_Ropp ->
+      let n = bignat_of_r a in
+      if n = zero then raise Non_closed_number;
+      neg n
+  | a -> bignat_of_r a
 
 let uninterp_r p =
   try
@@ -277,56 +113,11 @@ let uninterp_r p =
   with Non_closed_number ->
     None
 
-let _ = Symbols.declare_numeral_interpreter "R_scope"
-  (glob_R,["Coq";"Reals";"Rdefinitions"])
-  ((if !Options.v7 then r_of_int2 else r_of_int),None)
+let _ = Notation.declare_numeral_interpreter "R_scope"
+  (r_path,["Coq";"Reals";"Rdefinitions"])
+  r_of_int
   ([RRef(dummy_loc,glob_Ropp);RRef(dummy_loc,glob_R0);
-    RRef(dummy_loc,glob_Rplus);RRef(dummy_loc,glob_Rmult);RRef(dummy_loc,glob_R1)],
+    RRef(dummy_loc,glob_Rplus);RRef(dummy_loc,glob_Rmult);
+    RRef(dummy_loc,glob_R1)],
     uninterp_r,
-    None)
-
-(************************************************************************)
-(* Old ast printers via scope *)
-
-let _ = if !Options.v7 then
-let bignat_of_pos p =
-  let (_,one,plus,_,_,_) = get_r_sign_ast dummy_loc in
-  let rec transl = function
-    | Node (_,"APPLIST",[p; o; a]) when alpha_eq(p,plus) & alpha_eq(o,one)
-        -> add_1(transl a)
-    | a when alpha_eq(a,one) -> Bignat.one
-    | _ -> raise Non_closed_number
-  in transl p
-in
-let bignat_option_of_pos p =
-  try 
-    Some (bignat_of_pos p)
-  with Non_closed_number -> 
-    None
-in
-let r_printer_Rplus1 p =
-  match bignat_option_of_pos p with
-    | Some n -> Some (str (Bignat.to_string (add_1 n)))
-    | None -> None
-in
-let r_printer_Ropp p =
-  match bignat_option_of_pos p with
-    | Some n -> Some (str "-" ++ str (Bignat.to_string n))
-    | None -> None
-in
-let r_printer_R1 _ =
-  Some (int 1)
-in
-let r_printer_R0 _ =
-  Some (int 0)
-in
-(* Declare pretty-printers for integers *)
-let _ =
-  Esyntax.declare_primitive_printer "r_printer_Ropp" "R_scope" (r_printer_Ropp)
-in let _ =
-  Esyntax.declare_primitive_printer "r_printer_Rplus1" "R_scope" (r_printer_Rplus1)
-in let _ =
-  Esyntax.declare_primitive_printer "r_printer_R1" "R_scope" (r_printer_R1)
-in let _ =
-  Esyntax.declare_primitive_printer "r_printer_R0" "R_scope" r_printer_R0
-in ()
+    false)
diff --git a/parsing/g_string_syntax.ml b/parsing/g_string_syntax.ml
new file mode 100644
index 00000000..6d879fb2
--- /dev/null
+++ b/parsing/g_string_syntax.ml
@@ -0,0 +1,67 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+open Pp
+open Util
+open Names
+open Pcoq
+open Libnames
+open Topconstr
+open G_ascii_syntax
+open Rawterm
+open Coqlib
+
+exception Non_closed_string
+
+(* make a string term from the string s *)
+
+let string_module = ["Coq";"Strings";"String"]
+
+let string_path = make_path string_module "string"
+
+let string_kn = make_kn string_module "string"
+let static_glob_EmptyString  = ConstructRef ((string_kn,0),1)
+let static_glob_String  = ConstructRef ((string_kn,0),2)
+
+let make_reference id = find_reference "String interpretation" string_module id
+let glob_String = lazy (make_reference "String")
+let glob_EmptyString = lazy (make_reference "EmptyString")
+
+open Lazy
+
+let interp_string dloc s =
+  let le = String.length s in
+  let rec aux n = 
+     if n = le then RRef (dloc, force glob_EmptyString) else
+     RApp (dloc,RRef (dloc, force glob_String),
+       [interp_ascii dloc (int_of_char s.[n]); aux (n+1)])
+  in aux 0
+
+let uninterp_string r =
+  try 
+    let b = Buffer.create 16 in
+    let rec aux = function
+    | RApp (_,RRef (_,k),[a;s]) when k = force glob_String ->
+	(match uninterp_ascii a with
+	  | Some c -> Buffer.add_char b (Char.chr c); aux s
+	  | _ -> raise Non_closed_string)
+    | RRef (_,z) when z = force glob_EmptyString ->
+	Some (Buffer.contents b)
+    | _ ->
+	raise Non_closed_string
+    in aux r
+  with 
+   Non_closed_string -> None
+
+let _ =
+  Notation.declare_string_interpreter "string_scope"
+    (string_path,["Coq";"Strings";"String"])
+    interp_string
+    ([RRef (dummy_loc,static_glob_String); 
+      RRef (dummy_loc,static_glob_EmptyString)],
+     uninterp_string, true)
diff --git a/parsing/g_tactic.ml4 b/parsing/g_tactic.ml4
index fd64defc..1974d8bc 100644
--- a/parsing/g_tactic.ml4
+++ b/parsing/g_tactic.ml4
@@ -6,75 +6,124 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_tactic.ml4,v 1.83.2.5 2005/05/15 12:47:04 herbelin Exp $ *)
+(* $Id: g_tactic.ml4 8651 2006-03-21 21:54:43Z jforest $ *)
 
 open Pp
-open Ast
 open Pcoq
 open Util
 open Tacexpr
 open Rawterm
 open Genarg
+open Topconstr
+
+let compute = Cbv all_flags
+
+let tactic_kw = [ "->"; "<-" ]
+let _ = List.iter (fun s -> Lexer.add_token("",s)) tactic_kw
+
+(* Hack to parse "(x:=t)" as an explicit argument without conflicts with the *)
+(* admissible notation "(x t)" *)
+let lpar_id_coloneq =
+  Gram.Entry.of_parser "lpar_id_coloneq"
+    (fun strm ->
+      match Stream.npeek 1 strm with
+        | [("","(")] ->
+            (match Stream.npeek 2 strm with
+              | [_; ("IDENT",s)] ->
+                  (match Stream.npeek 3 strm with
+	            | [_; _; ("", ":=")] ->
+                        Stream.junk strm; Stream.junk strm; Stream.junk strm;
+                        Names.id_of_string s
+	            | _ -> raise Stream.Failure)
+	      | _ -> raise Stream.Failure)
+	| _ -> raise Stream.Failure)
+
+(* idem for (x:=t) and (1:=t) *)
+let test_lpar_idnum_coloneq =
+  Gram.Entry.of_parser "test_lpar_idnum_coloneq"
+    (fun strm ->
+      match Stream.npeek 1 strm with
+        | [("","(")] ->
+            (match Stream.npeek 2 strm with
+              | [_; (("IDENT"|"INT"),_)] ->
+                  (match Stream.npeek 3 strm with
+                    | [_; _; ("", ":=")] -> ()
+                    | _ -> raise Stream.Failure)
+              | _ -> raise Stream.Failure)
+        | _ -> raise Stream.Failure)
+
+(* idem for (x:t) *)
+let lpar_id_colon =
+  Gram.Entry.of_parser "lpar_id_colon"
+    (fun strm ->
+      match Stream.npeek 1 strm with
+        | [("","(")] ->
+            (match Stream.npeek 2 strm with
+              | [_; ("IDENT",id)] ->
+                  (match Stream.npeek 3 strm with
+                    | [_; _; ("", ":")] ->
+                        Stream.junk strm; Stream.junk strm; Stream.junk strm;
+                        Names.id_of_string id
+                    | _ -> raise Stream.Failure)
+              | _ -> raise Stream.Failure)
+        | _ -> raise Stream.Failure)
+
+let guess_lpar_ipat s strm =
+  match Stream.npeek 1 strm with
+    | [("","(")] ->
+        (match Stream.npeek 2 strm with
+          | [_; ("",("("|"["))] -> ()
+          | [_; ("IDENT",_)] ->
+              (match Stream.npeek 3 strm with
+                | [_; _; ("", s')] when s = s' -> ()
+                | _ -> raise Stream.Failure)
+          | _ -> raise Stream.Failure)
+    | _ -> raise Stream.Failure
+
+let guess_lpar_coloneq =
+  Gram.Entry.of_parser "guess_lpar_coloneq" (guess_lpar_ipat ":=")
+
+let guess_lpar_colon =
+  Gram.Entry.of_parser "guess_lpar_colon" (guess_lpar_ipat ":")
+
 open Constr
 open Prim
 open Tactic
 
-let tactic_kw =
-  [ "using"; "Orelse"; "Proof"; "Qed"; "And"; "()"; "|-" ]
-let _ =
-  if !Options.v7 then
-    List.iter (fun s -> Lexer.add_token ("",s)) tactic_kw
+let mk_fix_tac (loc,id,bl,ann,ty) =
+  let n =
+    match bl,ann with
+        [([_],_)], None -> 1
+      | _, Some x ->
+          let ids = List.map snd (List.flatten (List.map fst bl)) in
+          (try list_index (snd x) ids
+          with Not_found -> error "no such fix variable")
+      | _ -> error "cannot guess decreasing argument of fix" in
+  (id,n,CProdN(loc,bl,ty))
 
-(* Functions overloaded by quotifier *)
+let mk_cofix_tac (loc,id,bl,ann,ty) =
+  let _ = option_app (fun (aloc,_) ->
+    Util.user_err_loc
+      (aloc,"Constr:mk_cofix_tac",
+       Pp.str"Annotation forbidden in cofix expression")) ann in
+  (id,CProdN(loc,bl,ty))
 
+(* Functions overloaded by quotifier *)
 let induction_arg_of_constr c =
-  try ElimOnIdent (Topconstr.constr_loc c,snd (coerce_to_id c))
+  try ElimOnIdent (constr_loc c,snd(coerce_to_id c))
   with _ -> ElimOnConstr c
 
-let local_compute = [FBeta;FIota;FDeltaBut [];FZeta]
-
-let error_oldelim _ = error "OldElim no longer supported"
-
-let join_to_constr loc c2 = (fst loc), snd (Topconstr.constr_loc c2)
-
 (* Auxiliary grammar rules *)
 
-if !Options.v7 then
 GEXTEND Gram
-  GLOBAL: simple_tactic constrarg bindings constr_with_bindings 
-  quantified_hypothesis red_expr int_or_var castedopenconstr open_constr
+  GLOBAL: simple_tactic constr_with_bindings quantified_hypothesis
+  bindings red_expr int_or_var open_constr casted_open_constr 
   simple_intropattern;
 
   int_or_var:
     [ [ n = integer  -> Genarg.ArgArg n
       | id = identref -> Genarg.ArgVar id ] ]
   ;
-  autoarg_depth:
-  [ [ n = OPT natural -> n ] ]
-  ;
-  autoarg_adding:
-  [ [ IDENT "Adding" ; "["; l = LIST1 global; "]" -> l | -> [] ] ]
-  ;
-  autoarg_destructing:
-  [ [ IDENT "Destructing" -> true | -> false ] ]
-  ;
-  autoarg_usingTDB:
-  [ [ "Using"; "TDB"  -> true | -> false ] ]
-  ;
-  autoargs:
-  [ [ a0 = autoarg_depth; l = autoarg_adding; 
-      a2 = autoarg_destructing; a3 = autoarg_usingTDB -> (a0,l,a2,a3) ] ]
-  ;
-  (* Either an hypothesis or a ltac ref (variable or pattern patvar) *)
-  id_or_ltac_ref:
-    [ [ id = base_ident -> AI (loc,id)
-      | "?"; n = natural -> AI (loc,Pattern.patvar_of_int n) ] ]
-  ;
-  (* Either a global ref or a ltac ref (variable or pattern patvar) *)
-  global_or_ltac_ref:
-    [ [ qid = global -> qid
-      | "?"; n = natural -> Libnames.Ident (loc,Pattern.patvar_of_int n) ] ]
-  ;
   (* An identifier or a quotation meta-variable *)
   id_or_meta:
     [ [ id = identref -> AI id 
@@ -88,18 +137,10 @@ GEXTEND Gram
       |	id = METAIDENT -> MetaId (loc,id)
       ] ]
   ;
-  constrarg:
-    [ [ IDENT "Inst"; id = identref; "["; c = constr; "]" ->
-        ConstrContext (id, c)
-      | IDENT "Eval"; rtc = Tactic.red_expr; "in"; c = constr ->
-        ConstrEval (rtc,c) 
-      | IDENT "Check"; c = constr -> ConstrTypeOf c
-      | c = constr -> ConstrTerm c ] ]
-  ;
   open_constr:
     [ [ c = constr -> ((),c) ] ]
-   ;
-  castedopenconstr:
+  ;
+  casted_open_constr:
     [ [ c = constr -> ((),c) ] ]
   ;
   induction_arg:
@@ -108,40 +149,45 @@ GEXTEND Gram
     ] ]
   ;
   quantified_hypothesis:
-    [ [ id = base_ident -> NamedHyp id
+    [ [ id = ident -> NamedHyp id
       | n = natural -> AnonHyp n ] ]
   ;
   conversion:
-    [ [ nl = LIST1 integer; c1 = constr; "with"; c2 = constr ->
-         (Some (nl,c1), c2)
-      |	c1 = constr; "with"; c2 = constr -> (Some ([],c1), c2)
-      | c = constr -> (None, c) ] ]
+    [ [ c = constr -> (None, c)
+      | c1 = constr; "with"; c2 = constr -> (Some ([],c1), c2)
+      | c1 = constr; "at"; nl = LIST1 integer; "with"; c2 = constr ->
+	  (Some (nl,c1), c2) ] ]
+  ;
+  occurrences:
+    [ [ "at"; nl = LIST1 integer -> nl
+      | -> [] ] ]
   ;
   pattern_occ:
-    [ [ nl = LIST0 integer; c = constr -> (nl,c) ] ]
+    [ [ c = constr; nl = occurrences -> (nl,c) ] ]
+  ;
+  unfold_occ:
+    [ [ c = global; nl = occurrences -> (nl,c) ] ]
   ;
   intropatterns:
     [ [ l = LIST0 simple_intropattern -> l ]]
   ;
   simple_intropattern:
     [ [ "["; tc = LIST1 intropatterns SEP "|" ; "]" -> IntroOrAndPattern tc
-      | "("; tc = LIST1 simple_intropattern SEP "," ; ")" -> IntroOrAndPattern [tc]
-      | IDENT "_" -> IntroWildcard
-      | id = base_ident -> IntroIdentifier id
+      | "("; tc = LIST0 simple_intropattern SEP "," ; ")" -> IntroOrAndPattern [tc]
+      | "()" -> IntroOrAndPattern [[]]
+      | "_" -> IntroWildcard
+      | "?" -> IntroAnonymous
+      | id = ident -> IntroIdentifier id
       ] ]
   ;
   simple_binding:
-    [ [ id = base_ident; ":="; c = constr -> (loc, NamedHyp id, c)
-      | n = natural; ":="; c = constr -> (loc, AnonHyp n, c) ] ]
+    [ [ "("; id = ident; ":="; c = lconstr; ")" -> (loc, NamedHyp id, c)
+      | "("; n = natural; ":="; c = lconstr; ")" -> (loc, AnonHyp n, c) ] ]
   ;
   bindings:
-    [ [ c1 = constr; ":="; c2 = constr; bl = LIST0 simple_binding ->
-          ExplicitBindings
-            ((join_to_constr loc c2,NamedHyp (snd(coerce_to_id c1)), c2) :: bl)
-      | n = natural; ":="; c = constr; bl = LIST0 simple_binding ->
-	  ExplicitBindings ((join_to_constr loc c,AnonHyp n, c) :: bl)
-      | c1 = constr; bl = LIST0 constr ->
-	  ImplicitBindings (c1 :: bl) ] ]
+    [ [ test_lpar_idnum_coloneq; bl = LIST1 simple_binding ->
+          ExplicitBindings bl
+      | bl = LIST1 constr -> ImplicitBindings bl ] ]
   ;
   constr_with_bindings:
     [ [ c = constr; l = with_bindings -> (c, l) ] ]
@@ -149,222 +195,246 @@ GEXTEND Gram
   with_bindings:
     [ [ "with"; bl = bindings -> bl | -> NoBindings ] ]
   ;
-  unfold_occ:
-    [ [ nl = LIST0 integer; c = global_or_ltac_ref -> (nl,c) ] ]
-  ;
   red_flag:
-    [ [ IDENT "Beta" -> FBeta
-      | IDENT "Delta" -> FDeltaBut []
-      | IDENT "Iota" -> FIota
-      | IDENT "Zeta" -> FZeta
-      | IDENT "Delta"; "["; idl = LIST1 global_or_ltac_ref; "]" -> FConst idl
-      | IDENT "Delta"; "-"; "["; idl = LIST1 global_or_ltac_ref; "]" -> FDeltaBut idl
+    [ [ IDENT "beta" -> FBeta
+      | IDENT "delta" -> FDeltaBut []
+      | IDENT "iota" -> FIota
+      | IDENT "zeta" -> FZeta
+      | IDENT "delta"; "["; idl = LIST1 global; "]" -> FConst idl
+      | IDENT "delta"; "-"; "["; idl = LIST1 global; "]" -> FDeltaBut idl
     ] ]
   ;
   red_tactic:
-    [ [ IDENT "Red" -> Red false
-      | IDENT "Hnf" -> Hnf
-      | IDENT "Simpl"; po = OPT pattern_occ -> Simpl po
-      | IDENT "Cbv"; s = LIST1 red_flag -> Cbv (make_red_flag s)
-      | IDENT "Lazy"; s = LIST1 red_flag -> Lazy (make_red_flag s)
-      | IDENT "Compute" -> Cbv (make_red_flag [FBeta;FIota;FDeltaBut [];FZeta])
-      | IDENT "Unfold"; ul = LIST1 unfold_occ -> Unfold ul
-      | IDENT "Fold"; cl = LIST1 constr -> Fold cl
-      | IDENT "Pattern"; pl = LIST1 pattern_occ -> Pattern pl ] ]
+    [ [ IDENT "red" -> Red false
+      | IDENT "hnf" -> Hnf
+      | IDENT "simpl"; po = OPT pattern_occ -> Simpl po
+      | IDENT "cbv"; s = LIST1 red_flag -> Cbv (make_red_flag s)
+      | IDENT "lazy"; s = LIST1 red_flag -> Lazy (make_red_flag s)
+      | IDENT "compute" -> compute
+      | IDENT "vm_compute" -> CbvVm
+      | IDENT "unfold"; ul = LIST1 unfold_occ SEP "," -> Unfold ul
+      | IDENT "fold"; cl = LIST1 constr -> Fold cl
+      | IDENT "pattern"; pl = LIST1 pattern_occ SEP","-> Pattern pl ] ]
   ;
   (* This is [red_tactic] including possible extensions *)
   red_expr:
-    [ [ IDENT "Red" -> Red false
-      | IDENT "Hnf" -> Hnf
-      | IDENT "Simpl"; po = OPT pattern_occ -> Simpl po
-      | IDENT "Cbv"; s = LIST1 red_flag -> Cbv (make_red_flag s)
-      | IDENT "Lazy"; s = LIST1 red_flag -> Lazy (make_red_flag s)
-      | IDENT "Compute" -> Cbv (make_red_flag [FBeta;FIota;FDeltaBut [];FZeta])
-      | IDENT "Unfold"; ul = LIST1 unfold_occ -> Unfold ul
-      | IDENT "Fold"; cl = LIST1 constr -> Fold cl
-      | IDENT "Pattern"; pl = LIST1 pattern_occ -> Pattern pl
+    [ [ IDENT "red" -> Red false
+      | IDENT "hnf" -> Hnf
+      | IDENT "simpl"; po = OPT pattern_occ -> Simpl po
+      | IDENT "cbv"; s = LIST1 red_flag -> Cbv (make_red_flag s)
+      | IDENT "lazy"; s = LIST1 red_flag -> Lazy (make_red_flag s)
+      | IDENT "compute" -> compute
+      | IDENT "vm_compute" -> CbvVm
+      | IDENT "unfold"; ul = LIST1 unfold_occ -> Unfold ul
+      | IDENT "fold"; cl = LIST1 constr -> Fold cl
+      | IDENT "pattern"; pl = LIST1 pattern_occ -> Pattern pl
       | s = IDENT -> ExtraRedExpr s ] ]
   ;
   hypident:
-    [ [ id = id_or_meta -> id,[],(InHyp,ref None)
-      | "("; "Type"; "of"; id = id_or_meta; ")" ->
-          id,[],(InHypTypeOnly,ref None)
+    [ [ id = id_or_meta ->
+          id,InHyp
+      | "("; IDENT "type"; IDENT "of"; id = id_or_meta; ")" ->
+	  id,InHypTypeOnly
+      | "("; IDENT "value"; IDENT "of"; id = id_or_meta; ")" ->
+	  id,InHypValueOnly
     ] ]
   ;
+  hypident_occ:
+    [ [ (id,l)=hypident; occs=occurrences -> (id,occs,l) ] ]
+  ;
   clause:
-    [ [ "in"; idl = LIST1 hypident ->
-        {onhyps=Some idl;onconcl=false; concl_occs=[]}
-      | -> {onhyps=Some[];onconcl=true;concl_occs=[]} ] ]
+    [ [ "in"; "*"; occs=occurrences ->
+        {onhyps=None;onconcl=true;concl_occs=occs}
+      | "in"; "*"; "|-"; (b,occs)=concl_occ ->
+          {onhyps=None; onconcl=b; concl_occs=occs}
+      | "in"; hl=LIST0 hypident_occ SEP","; "|-"; (b,occs)=concl_occ ->
+          {onhyps=Some hl; onconcl=b; concl_occs=occs}
+      | "in"; hl=LIST0 hypident_occ SEP"," ->
+          {onhyps=Some hl; onconcl=false; concl_occs=[]}
+      | -> {onhyps=Some[];onconcl=true; concl_occs=[]} ] ]
+  ;
+  concl_occ:
+    [ [ "*"; occs = occurrences -> (true,occs)
+      | -> (false, []) ] ]
   ;
   simple_clause:
     [ [ "in"; idl = LIST1 id_or_meta -> idl
       | -> [] ] ]
   ;
-  pattern_occ_hyp_tail_list:
-    [ [ pl = pattern_occ_hyp_list -> pl
-      | -> {onhyps=Some[];onconcl=false; concl_occs=[]} ] ]
-  ;
-  pattern_occ_hyp_list:
-    [ [ nl = LIST1 natural; IDENT "Goal" ->
-          {onhyps=Some[];onconcl=true;concl_occs=nl}
-      | nl = LIST1 natural; id = id_or_meta; cls = pattern_occ_hyp_tail_list
-        -> {cls with
-            onhyps=option_app(fun l -> (id,nl,(InHyp,ref None))::l)
-              cls.onhyps} 
-      | IDENT "Goal" -> {onhyps=Some[];onconcl=true;concl_occs=[]}
-      | id = id_or_meta; cls = pattern_occ_hyp_tail_list ->
-         {cls with
-          onhyps=option_app(fun l -> (id,[],(InHyp,ref None))::l)
-            cls.onhyps} ] ]
-  ;
-  clause_pattern:
-    [ [ "in"; p = pattern_occ_hyp_list -> p 
-      | -> {onhyps=None; onconcl=true; concl_occs=[] } ] ]
-  ;
   fixdecl:
-    [ [ id = base_ident; "/"; n = natural; ":"; c = constr -> (id,n,c) ] ]
+    [ [ "("; id = ident; bl=LIST0 Constr.binder; ann=fixannot;
+        ":"; ty=lconstr; ")" -> (loc,id,bl,ann,ty) ] ]
   ;
-  cofixdecl:
-    [ [ id = base_ident; ":"; c = constr -> (id,c) ] ]
+  fixannot:
+    [ [ "{"; IDENT "struct"; id=name; "}" -> Some id
+      | -> None ] ]
   ;
   hintbases:
     [ [ "with"; "*" -> None
       | "with"; l = LIST1 IDENT -> Some l
       | -> Some [] ] ]
   ;
+  auto_using:
+    [ [ "using"; l = LIST1 constr SEP "," -> l
+      | -> [] ] ]
+  ;
   eliminator:
     [ [ "using"; el = constr_with_bindings -> el ] ]
   ;
   with_names:
-    [ [ "as"; ipat = simple_intropattern -> Some ipat | -> None ] ]
+    [ [ "as"; ipat = simple_intropattern -> ipat | -> IntroAnonymous ] ]
+  ;
+  by_tactic:
+    [ [ IDENT "by"; tac = tactic -> TacComplete tac | -> TacId [] ] ]
   ;
   simple_tactic:
     [ [ 
       (* Basic tactics *)
-        IDENT "Intros"; IDENT "until"; id = quantified_hypothesis -> 
+        IDENT "intros"; IDENT "until"; id = quantified_hypothesis -> 
 	  TacIntrosUntil id
-      | IDENT "Intros"; pl = intropatterns -> TacIntroPattern pl
-      | IDENT "Intro"; id = base_ident; IDENT "after"; id2 = identref ->
+      | IDENT "intros"; pl = intropatterns -> TacIntroPattern pl
+      | IDENT "intro"; id = ident; IDENT "after"; id2 = identref ->
 	  TacIntroMove (Some id, Some id2)
-      | IDENT "Intro"; IDENT "after"; id2 = identref ->
+      | IDENT "intro"; IDENT "after"; id2 = identref ->
 	  TacIntroMove (None, Some id2)
-      | IDENT "Intro"; id = base_ident -> TacIntroMove (Some id,None)
-      | IDENT "Intro" -> TacIntroMove (None, None)
+      | IDENT "intro"; id = ident -> TacIntroMove (Some id, None)
+      | IDENT "intro" -> TacIntroMove (None, None)
 
-      | IDENT "Assumption" -> TacAssumption
-      | IDENT "Exact"; c = constr -> TacExact c
+      | IDENT "assumption" -> TacAssumption
+      | IDENT "exact"; c = constr -> TacExact c
+      | IDENT "exact_no_check"; c = constr -> TacExactNoCheck c
 
-      | IDENT "Apply"; cl = constr_with_bindings -> TacApply cl
-      | IDENT "Elim"; cl = constr_with_bindings; el = OPT eliminator ->
+      | IDENT "apply"; cl = constr_with_bindings -> TacApply cl
+      | IDENT "elim"; cl = constr_with_bindings; el = OPT eliminator ->
           TacElim (cl,el)
-      | IDENT "OldElim"; c = constr ->
-	  (* TacOldElim c *) error_oldelim ()
-      | IDENT "ElimType"; c = constr -> TacElimType c
-      | IDENT "Case"; cl = constr_with_bindings -> TacCase cl
-      | IDENT "CaseType"; c = constr -> TacCaseType c
-      | IDENT "Fix"; n = natural -> TacFix (None,n)
-      | IDENT "Fix"; id = base_ident; n = natural -> TacFix (Some id,n)
-      | IDENT "Fix"; id = base_ident; n = natural; "with"; fd = LIST0 fixdecl ->
-	  TacMutualFix (id,n,fd)
-      | IDENT "Cofix" -> TacCofix None
-      | IDENT "Cofix"; id = base_ident -> TacCofix (Some id)
-      | IDENT "Cofix"; id = base_ident; "with"; fd = LIST0 cofixdecl ->
-	  TacMutualCofix (id,fd)
-
-      | IDENT "Cut"; c = constr -> TacCut c
-      | IDENT "Assert"; c = constr -> TacTrueCut (Names.Anonymous,c)
-      | IDENT "Assert"; c = constr; ":"; t = constr ->
-          TacTrueCut (Names.Name (snd(coerce_to_id c)),t)
-      | IDENT "Assert"; c = constr; ":="; b = constr ->
-          TacForward (false,Names.Name (snd (coerce_to_id c)),b)
-      | IDENT "Pose"; c = constr; ":="; b = constr ->
-	  TacForward (true,Names.Name (snd(coerce_to_id c)),b)
-      | IDENT "Pose"; b = constr -> TacForward (true,Names.Anonymous,b)
-      | IDENT "Generalize"; lc = LIST1 constr -> TacGeneralize lc
-      | IDENT "Generalize"; IDENT "Dependent"; c = constr -> TacGeneralizeDep c
-      | IDENT "LetTac"; (_,na) = name; ":="; c = constr; p = clause_pattern
-        -> TacLetTac (na,c,p)
-      | IDENT "Instantiate"; n = natural; c = constr; cls = clause -> 
-	    TacInstantiate (n,c,cls)
-      | IDENT "Specialize"; n = OPT natural; lcb = constr_with_bindings ->
+      | IDENT "elimtype"; c = constr -> TacElimType c
+      | IDENT "case"; cl = constr_with_bindings -> TacCase cl
+      | IDENT "casetype"; c = constr -> TacCaseType c
+      | "fix"; n = natural -> TacFix (None,n)
+      | "fix"; id = ident; n = natural -> TacFix (Some id,n)
+      | "fix"; id = ident; n = natural; "with"; fd = LIST1 fixdecl ->
+	  TacMutualFix (id,n,List.map mk_fix_tac fd)
+      | "cofix" -> TacCofix None
+      | "cofix"; id = ident -> TacCofix (Some id)
+      | "cofix"; id = ident; "with"; fd = LIST1 fixdecl ->
+	  TacMutualCofix (id,List.map mk_cofix_tac fd)
+
+      | IDENT "pose"; id = lpar_id_coloneq; b = lconstr; ")" ->
+	  TacLetTac (Names.Name id,b,nowhere)
+      | IDENT "pose"; b = constr ->
+	  TacLetTac (Names.Anonymous,b,nowhere)
+      | IDENT "set"; id = lpar_id_coloneq; c = lconstr; ")"; p = clause ->
+	  TacLetTac (Names.Name id,c,p)
+      | IDENT "set"; c = constr; p = clause ->
+          TacLetTac (Names.Anonymous,c,p)
+
+      (* Begin compatibility *)
+      | IDENT "assert"; id = lpar_id_coloneq; c = lconstr; ")" -> 
+	  TacAssert (None,IntroIdentifier id,c)
+      | IDENT "assert"; id = lpar_id_colon; c = lconstr; ")"; tac=by_tactic -> 
+	  TacAssert (Some tac,IntroIdentifier id,c)
+      (* End compatibility *)
+
+      | IDENT "assert"; c = constr; ipat = with_names; tac = by_tactic ->
+	  TacAssert (Some tac,ipat,c)
+      | IDENT "pose"; IDENT "proof"; c = lconstr; ipat = with_names ->
+	  TacAssert (None,ipat,c)
+
+      | IDENT "cut"; c = constr -> TacCut c
+      | IDENT "generalize"; lc = LIST1 constr -> TacGeneralize lc
+      | IDENT "generalize"; IDENT "dependent"; c = constr -> TacGeneralizeDep c
+    (*  | IDENT "instantiate"; "("; n = natural; ":="; c = lconstr; ")"; "in";
+	  hid = hypident ->
+	    let (id,(hloc,_)) = hid in
+              TacInstantiate (n,c,HypLocation (id,hloc))
+      | IDENT "instantiate"; "("; n = natural; ":="; c = lconstr; ")" ->
+            TacInstantiate (n,c,ConclLocation ()) *)
+
+      | IDENT "specialize"; n = OPT natural; lcb = constr_with_bindings ->
 	  TacSpecialize (n,lcb)
-      | IDENT "LApply"; c = constr -> TacLApply c
+      | IDENT "lapply"; c = constr -> TacLApply c
 
       (* Derived basic tactics *)
-      | IDENT "Induction"; h = quantified_hypothesis -> TacSimpleInduction (h,ref [])
-      | IDENT "NewInduction"; c = induction_arg; el = OPT eliminator;
-          ids = with_names -> TacNewInduction (c,el,(ids,ref []))
-      | IDENT "Double"; IDENT "Induction"; h1 = quantified_hypothesis;
+      | IDENT "simple"; IDENT"induction"; h = quantified_hypothesis ->
+          TacSimpleInduction h
+      | IDENT "induction"; lc = LIST1 induction_arg; ids = with_names; 
+	  el = OPT eliminator -> TacNewInduction (lc,el,ids)
+      | IDENT "double"; IDENT "induction"; h1 = quantified_hypothesis;
 	  h2 = quantified_hypothesis -> TacDoubleInduction (h1,h2)
-      | IDENT "Destruct"; h = quantified_hypothesis -> TacSimpleDestruct h
-      | IDENT "NewDestruct"; c = induction_arg; el = OPT eliminator; 
-          ids = with_names -> TacNewDestruct (c,el,(ids,ref []))
-      | IDENT "Decompose"; IDENT "Record" ; c = constr -> TacDecomposeAnd c
-      | IDENT "Decompose"; IDENT "Sum"; c = constr -> TacDecomposeOr c
-      | IDENT "Decompose"; "["; l = LIST1 global_or_ltac_ref; "]"; c = constr
+      | IDENT "simple"; IDENT"destruct"; h = quantified_hypothesis ->
+          TacSimpleDestruct h
+      | IDENT "destruct"; lc = LIST1 induction_arg; ids = with_names; 
+	  el = OPT eliminator -> TacNewDestruct (lc,el,ids)
+      | IDENT "decompose"; IDENT "record" ; c = constr -> TacDecomposeAnd c
+      | IDENT "decompose"; IDENT "sum"; c = constr -> TacDecomposeOr c
+      | IDENT "decompose"; "["; l = LIST1 global; "]"; c = constr
         -> TacDecompose (l,c)
 
       (* Automation tactic *)
-      | IDENT "Trivial"; db = hintbases -> TacTrivial db
-      | IDENT "Auto"; n = OPT int_or_var; db = hintbases -> TacAuto (n, db)
-
-      | IDENT "AutoTDB"; n = OPT natural -> TacAutoTDB n
-      | IDENT "CDHyp"; id = identref -> TacDestructHyp (true,id)
-      | IDENT "DHyp";  id = identref -> TacDestructHyp (false,id)
-      | IDENT "DConcl"  -> TacDestructConcl
-      | IDENT "SuperAuto"; l = autoargs -> TacSuperAuto l
-      | IDENT "Auto"; n = OPT int_or_var; IDENT "Decomp"; p = OPT natural ->
+      | IDENT "trivial"; lems = auto_using; db = hintbases ->
+	  TacTrivial (lems,db)
+      | IDENT "auto"; n = OPT int_or_var; lems = auto_using; db = hintbases ->
+	  TacAuto (n,lems,db)
+
+(* Obsolete since V8.0
+      | IDENT "autotdb"; n = OPT natural -> TacAutoTDB n
+      | IDENT "cdhyp"; id = identref -> TacDestructHyp (true,id)
+      | IDENT "dhyp";  id = identref -> TacDestructHyp (false,id)
+      | IDENT "dconcl"  -> TacDestructConcl
+      | IDENT "superauto"; l = autoargs -> TacSuperAuto l
+*)
+      | IDENT "auto"; n = OPT int_or_var; IDENT "decomp"; p = OPT natural ->
 	  TacDAuto (n, p)
 
       (* Context management *)
-      | IDENT "Clear"; l = LIST1 id_or_ltac_ref -> TacClear l
-      | IDENT "ClearBody"; l = LIST1 id_or_ltac_ref -> TacClearBody l
-      | IDENT "Move"; id1 = id_or_ltac_ref; IDENT "after"; 
-	  id2 = id_or_ltac_ref -> TacMove (true,id1,id2)
-      | IDENT "Rename"; id1 = id_or_ltac_ref; IDENT "into"; 
-	  id2 = id_or_ltac_ref -> TacRename (id1,id2)
+      | IDENT "clear"; "-"; l = LIST1 id_or_meta -> TacClear (true, l)
+      | IDENT "clear"; l = LIST0 id_or_meta -> TacClear (l=[], l)
+      | IDENT "clearbody"; l = LIST1 id_or_meta -> TacClearBody l
+      | IDENT "move"; id1 = id_or_meta; IDENT "after"; id2 = id_or_meta -> 
+	  TacMove (true,id1,id2)
+      | IDENT "rename"; id1 = id_or_meta; IDENT "into"; id2 = id_or_meta -> 
+	  TacRename (id1,id2)
 
       (* Constructors *)
-      | IDENT "Left"; bl = with_bindings -> TacLeft bl
-      | IDENT "Right"; bl = with_bindings -> TacRight bl
-      | IDENT "Split"; bl = with_bindings -> TacSplit (false,bl)
-      | IDENT "Exists"; bl = bindings -> TacSplit (true,bl)
-      | IDENT "Exists" -> TacSplit (true,NoBindings)
-      | IDENT "Constructor"; n = num_or_meta; l = with_bindings ->
+      | IDENT "left"; bl = with_bindings -> TacLeft bl
+      | IDENT "right"; bl = with_bindings -> TacRight bl
+      | IDENT "split"; bl = with_bindings -> TacSplit (false,bl)
+      | "exists"; bl = bindings -> TacSplit (true,bl)
+      | "exists" -> TacSplit (true,NoBindings)
+      | IDENT "constructor"; n = num_or_meta; l = with_bindings ->
 	  TacConstructor (n,l)
-      | IDENT "Constructor"; t = OPT tactic -> TacAnyConstructor t
+      | IDENT "constructor"; t = OPT tactic -> TacAnyConstructor t
 
       (* Equivalence relations *)
-      | IDENT "Reflexivity" -> TacReflexivity
-      | IDENT "Symmetry"; cls = clause -> TacSymmetry cls
-      | IDENT "Transitivity"; c = constr -> TacTransitivity c
+      | IDENT "reflexivity" -> TacReflexivity
+      | IDENT "symmetry"; cls = clause -> TacSymmetry cls
+      | IDENT "transitivity"; c = constr -> TacTransitivity c
 
       (* Equality and inversion *)
-      | IDENT "Dependent"; k =
-	  [ IDENT "Simple"; IDENT "Inversion" -> SimpleInversion
-	  | IDENT "Inversion" -> FullInversion
-	  | IDENT "Inversion_clear" -> FullInversionClear ];
+      | IDENT "dependent"; k =
+	  [ IDENT "simple"; IDENT "inversion" -> SimpleInversion
+	  | IDENT "inversion" -> FullInversion
+	  | IDENT "inversion_clear" -> FullInversionClear ];
 	  hyp = quantified_hypothesis; 
 	  ids = with_names; co = OPT ["with"; c = constr -> c] ->
 	    TacInversion (DepInversion (k,co,ids),hyp)
-      | IDENT "Simple"; IDENT "Inversion";
+      | IDENT "simple"; IDENT "inversion";
 	  hyp = quantified_hypothesis; ids = with_names; cl = simple_clause ->
 	    TacInversion (NonDepInversion (SimpleInversion, cl, ids), hyp)
-      | IDENT "Inversion"; 
+      | IDENT "inversion"; 
 	  hyp = quantified_hypothesis; ids = with_names; cl = simple_clause ->
 	    TacInversion (NonDepInversion (FullInversion, cl, ids), hyp)
-      | IDENT "Inversion_clear"; 
+      | IDENT "inversion_clear"; 
 	  hyp = quantified_hypothesis; ids = with_names; cl = simple_clause ->
 	    TacInversion (NonDepInversion (FullInversionClear, cl, ids), hyp)
-      | IDENT "Inversion"; hyp = quantified_hypothesis; 
+      | IDENT "inversion"; hyp = quantified_hypothesis; 
 	  "using"; c = constr; cl = simple_clause ->
 	    TacInversion (InversionUsing (c,cl), hyp)
 
       (* Conversion *)
       | r = red_tactic; cl = clause -> TacReduce (r, cl)
       (* Change ne doit pas s'appliquer dans un Definition t := Eval ... *)
-      | IDENT "Change"; (oc,c) = conversion; cl = clause -> TacChange (oc,c,cl)
-
+      | IDENT "change"; (oc,c) = conversion; cl = clause -> TacChange (oc,c,cl)
     ] ]
   ;
 END;;
diff --git a/parsing/g_tacticnew.ml4 b/parsing/g_tacticnew.ml4
deleted file mode 100644
index 5ffd2fd7..00000000
--- a/parsing/g_tacticnew.ml4
+++ /dev/null
@@ -1,405 +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        *)
-(************************************************************************)
-
-(* $Id: g_tacticnew.ml4,v 1.35.2.7 2005/05/15 12:47:05 herbelin Exp $ *)
-
-open Pp
-open Ast
-open Pcoq
-open Util
-open Tacexpr
-open Rawterm
-open Genarg
-
-let compute = Cbv all_flags
-
-let tactic_kw =
-  [ "->"; "<-" ]
-let _ = 
-  if not !Options.v7 then
-    List.iter (fun s -> Lexer.add_token("",s)) tactic_kw
-
-(* Hack to parse "(x:=t)" as an explicit argument without conflicts with the *)
-(* admissible notation "(x t)" *)
-let lpar_id_coloneq =
-  Gram.Entry.of_parser "lpar_id_coloneq"
-    (fun strm ->
-      match Stream.npeek 1 strm with
-        | [("","(")] ->
-            (match Stream.npeek 2 strm with
-              | [_; ("IDENT",s)] ->
-                  (match Stream.npeek 3 strm with
-	            | [_; _; ("", ":=")] ->
-                        Stream.junk strm; Stream.junk strm; Stream.junk strm;
-                        Names.id_of_string s
-	            | _ -> raise Stream.Failure)
-	      | _ -> raise Stream.Failure)
-	| _ -> raise Stream.Failure)
-
-(* idem for (x:=t) and (1:=t) *)
-let test_lpar_idnum_coloneq =
-  Gram.Entry.of_parser "test_lpar_idnum_coloneq"
-    (fun strm ->
-      match Stream.npeek 1 strm with
-        | [("","(")] ->
-            (match Stream.npeek 2 strm with
-              | [_; (("IDENT"|"INT"),_)] ->
-                  (match Stream.npeek 3 strm with
-                    | [_; _; ("", ":=")] -> ()
-                    | _ -> raise Stream.Failure)
-              | _ -> raise Stream.Failure)
-        | _ -> raise Stream.Failure)
-
-(* idem for (x:t) *)
-let lpar_id_colon =
-  Gram.Entry.of_parser "lpar_id_colon"
-    (fun strm ->
-      match Stream.npeek 1 strm with
-        | [("","(")] ->
-            (match Stream.npeek 2 strm with
-              | [_; ("IDENT",id)] ->
-                  (match Stream.npeek 3 strm with
-                    | [_; _; ("", ":")] ->
-                        Stream.junk strm; Stream.junk strm; Stream.junk strm;
-                        Names.id_of_string id
-                    | _ -> raise Stream.Failure)
-              | _ -> raise Stream.Failure)
-        | _ -> raise Stream.Failure)
-
-open Constr
-open Prim
-open Tactic
-
-let mk_fix_tac (loc,id,bl,ann,ty) =
-  let n =
-    match bl,ann with
-        [([_],_)], None -> 1
-      | _, Some x ->
-          let ids = List.map snd (List.flatten (List.map fst bl)) in
-          (try list_index (snd x) ids
-          with Not_found -> error "no such fix variable")
-      | _ -> error "cannot guess decreasing argument of fix" in
-  (id,n,Topconstr.CProdN(loc,bl,ty))
-
-let mk_cofix_tac (loc,id,bl,ann,ty) =
-  let _ = option_app (fun (aloc,_) ->
-    Util.user_err_loc
-      (aloc,"Constr:mk_cofix_tac",
-       Pp.str"Annotation forbidden in cofix expression")) ann in
-  (id,Topconstr.CProdN(loc,bl,ty))
-
-(* Functions overloaded by quotifier *)
-let induction_arg_of_constr c =
-  try ElimOnIdent (Topconstr.constr_loc c,snd(coerce_to_id c))
-  with _ -> ElimOnConstr c
-
-let local_compute = [FBeta;FIota;FDeltaBut [];FZeta]
-
-let error_oldelim _ = error "OldElim no longer supported"
-
-let join_to_constr loc c2 = (fst loc), snd (Topconstr.constr_loc c2)
-
-(* Auxiliary grammar rules *)
-
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: simple_tactic constr_with_bindings quantified_hypothesis
-  bindings red_expr int_or_var open_constr castedopenconstr 
-  simple_intropattern;
-
-  int_or_var:
-    [ [ n = integer  -> Genarg.ArgArg n
-      | id = identref -> Genarg.ArgVar id ] ]
-  ;
-  (* An identifier or a quotation meta-variable *)
-  id_or_meta:
-    [ [ id = identref -> AI id 
-
-      (* This is used in quotations *)
-      | id = METAIDENT -> MetaId (loc,id) ] ]
-  ;
-  (* A number or a quotation meta-variable *)
-  num_or_meta:
-    [ [ n = integer -> AI n
-      |	id = METAIDENT -> MetaId (loc,id)
-      ] ]
-  ;
-  open_constr:
-    [ [ c = constr -> ((),c) ] ]
-   ;
-  castedopenconstr:
-    [ [ c = constr -> ((),c) ] ]
-  ;
-  induction_arg:
-    [ [ n = natural -> ElimOnAnonHyp n
-      | c = constr -> induction_arg_of_constr c
-    ] ]
-  ;
-  quantified_hypothesis:
-    [ [ id = base_ident -> NamedHyp id
-      | n = natural -> AnonHyp n ] ]
-  ;
-  conversion:
-    [ [ c = constr -> (None, c)
-      | c1 = constr; "with"; c2 = constr -> (Some ([],c1), c2)
-      | c1 = constr; "at"; nl = LIST1 integer; "with"; c2 = constr ->
-	  (Some (nl,c1), c2) ] ]
-  ;
-  occurrences:
-    [ [ "at"; nl = LIST1 integer -> nl
-      | -> [] ] ]
-  ;
-  pattern_occ:
-    [ [ c = constr; nl = occurrences -> (nl,c) ] ]
-  ;
-  unfold_occ:
-    [ [ c = global; nl = occurrences -> (nl,c) ] ]
-  ;
-  intropatterns:
-    [ [ l = LIST0 simple_intropattern -> l ]]
-  ;
-  simple_intropattern:
-    [ [ "["; tc = LIST1 intropatterns SEP "|" ; "]" -> IntroOrAndPattern tc
-      | "("; tc = LIST1 simple_intropattern SEP "," ; ")" -> IntroOrAndPattern [tc]
-      | "_" -> IntroWildcard
-      | id = base_ident -> IntroIdentifier id
-      ] ]
-  ;
-  simple_binding:
-    [ [ "("; id = base_ident; ":="; c = lconstr; ")" -> (loc, NamedHyp id, c)
-      | "("; n = natural; ":="; c = lconstr; ")" -> (loc, AnonHyp n, c) ] ]
-  ;
-  bindings:
-    [ [ test_lpar_idnum_coloneq; bl = LIST1 simple_binding ->
-          ExplicitBindings bl
-      | bl = LIST1 constr -> ImplicitBindings bl ] ]
-  ;
-  constr_with_bindings:
-    [ [ c = constr; l = with_bindings -> (c, l) ] ]
-  ;
-  with_bindings:
-    [ [ "with"; bl = bindings -> bl | -> NoBindings ] ]
-  ;
-  red_flag:
-    [ [ IDENT "beta" -> FBeta
-      | IDENT "delta" -> FDeltaBut []
-      | IDENT "iota" -> FIota
-      | IDENT "zeta" -> FZeta
-      | IDENT "delta"; "["; idl = LIST1 global; "]" -> FConst idl
-      | IDENT "delta"; "-"; "["; idl = LIST1 global; "]" -> FDeltaBut idl
-    ] ]
-  ;
-  red_tactic:
-    [ [ IDENT "red" -> Red false
-      | IDENT "hnf" -> Hnf
-      | IDENT "simpl"; po = OPT pattern_occ -> Simpl po
-      | IDENT "cbv"; s = LIST1 red_flag -> Cbv (make_red_flag s)
-      | IDENT "lazy"; s = LIST1 red_flag -> Lazy (make_red_flag s)
-      | IDENT "compute" -> compute
-      | IDENT "unfold"; ul = LIST1 unfold_occ SEP "," -> Unfold ul
-      | IDENT "fold"; cl = LIST1 constr -> Fold cl
-      | IDENT "pattern"; pl = LIST1 pattern_occ SEP","-> Pattern pl ] ]
-  ;
-  (* This is [red_tactic] including possible extensions *)
-  red_expr:
-    [ [ IDENT "red" -> Red false
-      | IDENT "hnf" -> Hnf
-      | IDENT "simpl"; po = OPT pattern_occ -> Simpl po
-      | IDENT "cbv"; s = LIST1 red_flag -> Cbv (make_red_flag s)
-      | IDENT "lazy"; s = LIST1 red_flag -> Lazy (make_red_flag s)
-      | IDENT "compute" -> compute
-      | IDENT "unfold"; ul = LIST1 unfold_occ -> Unfold ul
-      | IDENT "fold"; cl = LIST1 constr -> Fold cl
-      | IDENT "pattern"; pl = LIST1 pattern_occ -> Pattern pl
-      | s = IDENT; OPT [ (* compat V8.0pl1 *) constr ] -> ExtraRedExpr s ] ]
-  ;
-  hypident:
-    [ [ id = id_or_meta -> id,(InHyp,ref None)
-      | "("; IDENT "type"; IDENT "of"; id = id_or_meta; ")" ->
-          id,(InHypTypeOnly,ref None)
-      | "("; IDENT "value"; IDENT "of"; id = id_or_meta; ")" ->
-          id,(InHypValueOnly,ref None)
-    ] ]
-  ;
-  hypident_occ:
-    [ [ (id,l)=hypident; occs=occurrences -> (id,occs,l) ] ]
-  ;
-  clause:
-    [ [ "in"; "*"; occs=occurrences ->
-        {onhyps=None;onconcl=true;concl_occs=occs}
-      | "in"; "*"; "|-"; (b,occs)=concl_occ ->
-          {onhyps=None; onconcl=b; concl_occs=occs}
-      | "in"; hl=LIST0 hypident_occ SEP","; "|-"; (b,occs)=concl_occ ->
-          {onhyps=Some hl; onconcl=b; concl_occs=occs}
-      | "in"; hl=LIST0 hypident_occ SEP"," ->
-          {onhyps=Some hl; onconcl=false; concl_occs=[]}
-      | -> {onhyps=Some[];onconcl=true; concl_occs=[]} ] ]
-  ;
-  concl_occ:
-    [ [ "*"; occs = occurrences -> (true,occs)
-      | -> (false, []) ] ]
-  ;
-  simple_clause:
-    [ [ "in"; idl = LIST1 id_or_meta -> idl
-      | -> [] ] ]
-  ;
-  fixdecl:
-    [ [ "("; id = base_ident; bl=LIST0 Constr.binder; ann=fixannot;
-        ":"; ty=lconstr; ")" -> (loc,id,bl,ann,ty) ] ]
-  ;
-  fixannot:
-    [ [ "{"; IDENT "struct"; id=name; "}" -> Some id
-      | -> None ] ]
-  ;
-  hintbases:
-    [ [ "with"; "*" -> None
-      | "with"; l = LIST1 IDENT -> Some l
-      | -> Some [] ] ]
-  ;
-  eliminator:
-    [ [ "using"; el = constr_with_bindings -> el ] ]
-  ;
-  with_names:
-    [ [ "as"; ipat = simple_intropattern -> Some ipat | -> None ] ]
-  ;
-  simple_tactic:
-    [ [ 
-      (* Basic tactics *)
-        IDENT "intros"; IDENT "until"; id = quantified_hypothesis -> 
-	  TacIntrosUntil id
-      | IDENT "intros"; pl = intropatterns -> TacIntroPattern pl
-      | IDENT "intro"; id = base_ident; IDENT "after"; id2 = identref ->
-	  TacIntroMove (Some id, Some id2)
-      | IDENT "intro"; IDENT "after"; id2 = identref ->
-	  TacIntroMove (None, Some id2)
-      | IDENT "intro"; id = base_ident -> TacIntroMove (Some id, None)
-      | IDENT "intro" -> TacIntroMove (None, None)
-
-      | IDENT "assumption" -> TacAssumption
-      | IDENT "exact"; c = constr -> TacExact c
-
-      | IDENT "apply"; cl = constr_with_bindings -> TacApply cl
-      | IDENT "elim"; cl = constr_with_bindings; el = OPT eliminator ->
-          TacElim (cl,el)
-      | IDENT "elimtype"; c = constr -> TacElimType c
-      | IDENT "case"; cl = constr_with_bindings -> TacCase cl
-      | IDENT "casetype"; c = constr -> TacCaseType c
-      | "fix"; n = natural -> TacFix (None,n)
-      | "fix"; id = base_ident; n = natural -> TacFix (Some id,n)
-      | "fix"; id = base_ident; n = natural; "with"; fd = LIST1 fixdecl ->
-	  TacMutualFix (id,n,List.map mk_fix_tac fd)
-      | "cofix" -> TacCofix None
-      | "cofix"; id = base_ident -> TacCofix (Some id)
-      | "cofix"; id = base_ident; "with"; fd = LIST1 fixdecl ->
-	  TacMutualCofix (id,List.map mk_cofix_tac fd)
-
-      | IDENT "cut"; c = constr -> TacCut c
-      | IDENT "assert"; id = lpar_id_colon; t = lconstr; ")" ->
-          TacTrueCut (Names.Name id,t)
-      | IDENT "assert"; id = lpar_id_coloneq; b = lconstr; ")" ->
-          TacForward (false,Names.Name id,b)
-      | IDENT "assert"; c = constr -> TacTrueCut (Names.Anonymous,c)
-      | IDENT "pose"; id = lpar_id_coloneq; b = lconstr; ")" ->
-	  TacForward (true,Names.Name id,b)
-      | IDENT "pose"; b = constr -> TacForward (true,Names.Anonymous,b)
-      | IDENT "generalize"; lc = LIST1 constr -> TacGeneralize lc
-      | IDENT "generalize"; IDENT "dependent"; c = constr ->
-          TacGeneralizeDep c
-      | IDENT "set"; id = lpar_id_coloneq; c = lconstr; ")";
-          p = clause -> TacLetTac (Names.Name id,c,p)
-      | IDENT "set"; c = constr; p = clause ->
-          TacLetTac (Names.Anonymous,c,p)
-      | IDENT "instantiate"; "("; n = natural; ":="; c = lconstr; ")";
-	  cls = clause ->
-            TacInstantiate (n,c,cls)
-	    
-      | IDENT "specialize"; n = OPT natural; lcb = constr_with_bindings ->
-	  TacSpecialize (n,lcb)
-      | IDENT "lapply"; c = constr -> TacLApply c
-
-      (* Derived basic tactics *)
-      | IDENT "simple"; IDENT"induction"; h = quantified_hypothesis ->
-          TacSimpleInduction (h,ref [])
-      | IDENT "induction"; c = induction_arg; ids = with_names; 
-	  el = OPT eliminator -> TacNewInduction (c,el,(ids,ref []))
-      | IDENT "double"; IDENT "induction"; h1 = quantified_hypothesis;
-	  h2 = quantified_hypothesis -> TacDoubleInduction (h1,h2)
-      | IDENT "simple"; IDENT"destruct"; h = quantified_hypothesis ->
-          TacSimpleDestruct h
-      | IDENT "destruct"; c = induction_arg; ids = with_names; 
-	  el = OPT eliminator -> TacNewDestruct (c,el,(ids,ref []))
-      | IDENT "decompose"; IDENT "record" ; c = constr -> TacDecomposeAnd c
-      | IDENT "decompose"; IDENT "sum"; c = constr -> TacDecomposeOr c
-      | IDENT "decompose"; "["; l = LIST1 global; "]"; c = constr
-        -> TacDecompose (l,c)
-
-      (* Automation tactic *)
-      | IDENT "trivial"; db = hintbases -> TacTrivial db
-      | IDENT "auto"; n = OPT int_or_var; db = hintbases -> TacAuto (n, db)
-
-(* Obsolete since V8.0
-      | IDENT "autotdb"; n = OPT natural -> TacAutoTDB n
-      | IDENT "cdhyp"; id = identref -> TacDestructHyp (true,id)
-      | IDENT "dhyp";  id = identref -> TacDestructHyp (false,id)
-      | IDENT "dconcl"  -> TacDestructConcl
-      | IDENT "superauto"; l = autoargs -> TacSuperAuto l
-*)
-      | IDENT "auto"; n = OPT int_or_var; IDENT "decomp"; p = OPT natural ->
-	  TacDAuto (n, p)
-
-      (* Context management *)
-      | IDENT "clear"; l = LIST1 id_or_meta -> TacClear l
-      | IDENT "clearbody"; l = LIST1 id_or_meta -> TacClearBody l
-      | IDENT "move"; id1 = id_or_meta; IDENT "after"; id2 = id_or_meta -> 
-	  TacMove (true,id1,id2)
-      | IDENT "rename"; id1 = id_or_meta; IDENT "into"; id2 = id_or_meta -> 
-	  TacRename (id1,id2)
-
-      (* Constructors *)
-      | IDENT "left"; bl = with_bindings -> TacLeft bl
-      | IDENT "right"; bl = with_bindings -> TacRight bl
-      | IDENT "split"; bl = with_bindings -> TacSplit (false,bl)
-      | "exists"; bl = bindings -> TacSplit (true,bl)
-      | "exists" -> TacSplit (true,NoBindings)
-      | IDENT "constructor"; n = num_or_meta; l = with_bindings ->
-	  TacConstructor (n,l)
-      | IDENT "constructor"; t = OPT tactic -> TacAnyConstructor t
-
-      (* Equivalence relations *)
-      | IDENT "reflexivity" -> TacReflexivity
-      | IDENT "symmetry"; cls = clause -> TacSymmetry cls
-      | IDENT "transitivity"; c = constr -> TacTransitivity c
-
-      (* Equality and inversion *)
-      | IDENT "dependent"; k =
-	  [ IDENT "simple"; IDENT "inversion" -> SimpleInversion
-	  | IDENT "inversion" -> FullInversion
-	  | IDENT "inversion_clear" -> FullInversionClear ];
-	  hyp = quantified_hypothesis; 
-	  ids = with_names; co = OPT ["with"; c = constr -> c] ->
-	    TacInversion (DepInversion (k,co,ids),hyp)
-      | IDENT "simple"; IDENT "inversion";
-	  hyp = quantified_hypothesis; ids = with_names; cl = simple_clause ->
-	    TacInversion (NonDepInversion (SimpleInversion, cl, ids), hyp)
-      | IDENT "inversion"; 
-	  hyp = quantified_hypothesis; ids = with_names; cl = simple_clause ->
-	    TacInversion (NonDepInversion (FullInversion, cl, ids), hyp)
-      | IDENT "inversion_clear"; 
-	  hyp = quantified_hypothesis; ids = with_names; cl = simple_clause ->
-	    TacInversion (NonDepInversion (FullInversionClear, cl, ids), hyp)
-      | IDENT "inversion"; hyp = quantified_hypothesis; 
-	  "using"; c = constr; cl = simple_clause ->
-	    TacInversion (InversionUsing (c,cl), hyp)
-
-      (* Conversion *)
-      | r = red_tactic; cl = clause -> TacReduce (r, cl)
-      (* Change ne doit pas s'appliquer dans un Definition t := Eval ... *)
-      | IDENT "change"; (oc,c) = conversion; cl = clause -> TacChange (oc,c,cl)
-    ] ]
-  ;
-END;;
diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4
index 87183e18..18a424a8 100644
--- a/parsing/g_vernac.ml4
+++ b/parsing/g_vernac.ml4
@@ -6,35 +6,39 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_vernac.ml4,v 1.93.2.3 2004/10/12 10:11:28 herbelin Exp $ *)
+(* $Id: g_vernac.ml4 8624 2006-03-13 17:38:17Z msozeau $ *)
+(*i camlp4deps: "parsing/grammar.cma" i*)
 
+open Pp
+open Util
 open Names
 open Topconstr
 open Vernacexpr
 open Pcoq
-open Pp
 open Tactic
-open Util
-open Constr
-open Vernac_
-open Prim
 open Decl_kinds
-
 open Genarg
+open Extend
+open Ppextend
+open Goptions
 
-let evar_constr loc = CHole loc
+open Prim
+open Constr
+open Vernac_
+open Module
 
-let class_rawexpr = G_basevernac.class_rawexpr
-let thm_token = G_proofs.thm_token
+let vernac_kw = [ ";"; ","; ">->"; ":<"; "<:"; "where"; "at" ]
+let _ = List.iter (fun s -> Lexer.add_token ("",s)) vernac_kw
 
 (* Rem: do not join the different GEXTEND into one, it breaks native *)
 (* compilation on PowerPC and Sun architectures *)
 
-let filter_com (b,e) =
-  let (b,e) = unloc (b,e) in
-  Pp.comments := List.filter (fun ((b',e'),s) -> b'<b || e'>e) !Pp.comments 
+let check_command = Gram.Entry.create "vernac:check_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"
 
-if !Options.v7 then
+let no_hook _ _ = ()
 GEXTEND Gram
   GLOBAL: vernac gallina_ext;
   vernac:
@@ -44,163 +48,121 @@ GEXTEND Gram
       | g = gallina_ext; "." -> g
       | c = command; "." -> c 
       | c = syntax; "." -> c
-      | n = natural; ":"; tac = Tactic.tactic; "." -> VernacSolve (n,tac,true) 
-      | n = natural; ":"; tac = Tactic.tactic; "!!" -> VernacSolve (n,tac,false)
-      | n = natural; ":"; v = check_command; "." -> v (Some n)
-      | "["; l = vernac_list_tail -> VernacList l
-
-      (* For translation from V7 to V8 *)
-      | IDENT "V7only"; v = vernac ->
-          filter_com loc; VernacV7only v
-      | IDENT "V8only"; v = vernac -> VernacV8only v
-
-(*
-      (* This is for "Grammar vernac" rules *)
-      | id = METAIDENT -> VernacVar (Names.id_of_string id)
-*)
+      | "["; l = LIST1 located_vernac; "]"; "." -> VernacList l
     ] ]
   ;
-    
-  check_command:
-    [ [ IDENT "Eval"; r = Tactic.red_expr; "in"; c = constr ->
-          fun g -> VernacCheckMayEval (Some r, g, c)
-      | IDENT "Check"; c = constr ->
-	  fun g -> VernacCheckMayEval (None, g, c) ] ]
-  ;
   vernac: FIRST
     [ [ IDENT "Time"; v = vernac  -> VernacTime v ] ]
   ;
   vernac: LAST
-    [ [ tac = Tactic.tactic; "." -> VernacSolve (1,tac,true)
-      | tac = Tactic.tactic; "!!" -> VernacSolve (1,tac,false)
-      | IDENT "Existential"; n = natural; c = constr_body ->
-	  VernacSolveExistential (n,c)
-    ] ]
-  ;
-  constr_body:
-    [ [ ":="; c = constr; ":"; t = constr -> CCast(loc,c,t)
-      | ":"; t = constr; ":="; c = constr -> CCast(loc,c,t)
-      | ":="; c = constr -> c ] ]
+    [ [ gln = OPT[n=natural; ":" -> n];
+        tac = subgoal_command -> tac gln ] ]
   ;
-  vernac_list_tail:
-    [ [ v = located_vernac; l = vernac_list_tail -> v :: l
-      | "]"; "." -> [] ] ]
+  subgoal_command:
+    [ [ c = check_command; "." -> c
+      | tac = Tactic.tactic;
+        use_dft_tac = [ "." -> false | "..." -> true ] ->
+          (fun g ->
+            let g = match g with Some gl -> gl | _ -> 1 in
+            VernacSolve(g,tac,use_dft_tac)) ] ]
   ;
   located_vernac:
     [ [ v = vernac -> loc, v ] ]
   ;
 END
 
+
 let test_plurial_form = function
-  | [_,([_],_)] ->
+  | [(_,([_],_))] ->
       Options.if_verbose warning
-      "Keywords Variables/Hypotheses/Parameters expect more than one assumption"
+   "Keywords Variables/Hypotheses/Parameters expect more than one assumption"
   | _ -> ()
 
+let no_coercion loc (c,x) =
+  if c then Util.user_err_loc
+    (loc,"no_coercion",Pp.str"no coercion allowed here");
+  x
+
 (* Gallina declarations *)
-if !Options.v7 then
 GEXTEND Gram
-  GLOBAL: gallina gallina_ext thm_token;
+  GLOBAL: gallina gallina_ext thm_token def_body;
 
+  gallina:
+      (* Definition, Theorem, Variable, Axiom, ... *)
+    [ [ thm = thm_token; id = identref; bl = LIST0 binder_let; ":";
+        c = lconstr ->
+          VernacStartTheoremProof (thm, id, (bl, c), false, no_hook)
+      | stre = assumption_token; bl = assum_list -> 
+	  VernacAssumption (stre, bl)
+      | stre = assumptions_token; bl = assum_list ->
+	  test_plurial_form bl;
+	  VernacAssumption (stre, bl)
+      | IDENT "Boxed";"Definition";id = identref; b = def_body -> 
+	  VernacDefinition ((Global,true,Definition), id, b, no_hook)
+      | IDENT "Unboxed";"Definition";id = identref; b = def_body -> 
+	  VernacDefinition ((Global,false,Definition), id, b, no_hook)
+      | (f,d) = def_token; id = identref; b = def_body -> 
+          VernacDefinition (d, id, b, f)
+      (* Gallina inductive declarations *)
+      | f = finite_token;
+        indl = LIST1 inductive_definition SEP "with" ->
+          VernacInductive (f,indl)
+      | IDENT "Boxed";"Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
+          VernacFixpoint (recs,true)
+      | IDENT "Unboxed";"Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
+          VernacFixpoint (recs,false)
+       | "Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
+          VernacFixpoint (recs,Options.boxed_definitions())
+      | "CoFixpoint"; corecs = LIST1 corec_definition SEP "with" ->
+          VernacCoFixpoint (corecs,false)
+      | IDENT "Scheme"; l = LIST1 scheme SEP "with" -> VernacScheme l ] ]
+  ;
+  gallina_ext:
+    [ [ b = record_token; oc = opt_coercion; name = identref;
+        ps = LIST0 binder_let; ":";
+	s = lconstr; ":="; cstr = OPT identref; "{";
+        fs = LIST0 record_field SEP ";"; "}" ->
+	  VernacRecord (b,(oc,name),ps,s,cstr,fs)
+(* Non port�é ?
+      | f = finite_token; s = csort; id = identref;
+        indpar = LIST0 simple_binder; ":="; lc = constructor_list -> 
+          VernacInductive (f,[id,None,indpar,s,lc])
+*)
+    ] ]
+  ;
   thm_token:
     [ [ "Theorem" -> Theorem
       | IDENT "Lemma" -> Lemma
       | IDENT "Fact" -> Fact
-      | IDENT "Remark" -> Remark ] ]
+      | IDENT "Remark" -> Remark
+      | IDENT "Corollary" -> Corollary
+      | IDENT "Proposition" -> Proposition
+      | IDENT "Property" -> Property ] ]
   ;
   def_token:
-    [ [ "Definition" -> (fun _ _ -> ()), (Global, Definition)
-      | IDENT "Local" -> (fun _ _ -> ()), (Local, Definition)
-      | IDENT "SubClass"  -> Class.add_subclass_hook, (Global, SubClass)
+    [ [ "Definition" -> 
+	no_hook, (Global, Options.boxed_definitions(), Definition)
+      | IDENT "Let" -> 
+	no_hook, (Local, Options.boxed_definitions(), Definition)
+      | IDENT "Example" -> 
+	no_hook, (Global, Options.boxed_definitions(), Example)
+      | IDENT "SubClass"  -> Class.add_subclass_hook, (Global, false, SubClass)
       | IDENT "Local"; IDENT "SubClass"  ->
-	  Class.add_subclass_hook, (Local, SubClass) ] ] 
+          Class.add_subclass_hook, (Local, false, SubClass) ] ] 
   ;
   assumption_token:
     [ [ "Hypothesis" -> (Local, Logical)
       | "Variable" -> (Local, Definitional)
       | "Axiom" -> (Global, Logical)
       | "Parameter" -> (Global, Definitional)
-      | IDENT "Conjecture" -> (Global,Conjectural) ] ]
+      | IDENT "Conjecture" -> (Global, Conjectural) ] ]
   ;
   assumptions_token:
     [ [ IDENT "Hypotheses" -> (Local, Logical)
       | IDENT "Variables" -> (Local, Definitional)
+      | IDENT "Axioms" -> (Global, Logical)
       | IDENT "Parameters" -> (Global, Definitional) ] ]
   ;
-  of_type_with_opt_coercion:
-    [ [ ":>" -> true
-      | ":"; ">" -> true
-      | ":" -> false ] ]
-  ;
-  params:
-    [ [ idl = LIST1 identref SEP ","; coe = of_type_with_opt_coercion; 
-        c = constr -> (coe,(idl,c))
-    ] ]
-  ;
-  ne_params_list:
-    [ [ ll = LIST1 params SEP ";" -> ll ] ]
-  ;
-  name_comma_list_tail:
-    [ [ ","; nal = LIST1 name SEP "," -> nal | -> [] ] ]
-  ;
-  ident_comma_list_tail:
-    [ [ ","; nal = LIST1 identref SEP "," -> nal | -> [] ] ]
-  ;
-  decl_notation:
-    [ [ "where"; ntn = STRING; ":="; c = constr; 
-         scopt = OPT [ ":"; sc = IDENT -> sc] -> (ntn,c,scopt) ] ]
-  ;
-  type_option:
-    [ [ ":"; c = constr -> c 
-      | -> evar_constr loc ] ]
-  ;
-  opt_casted_constr:
-    [ [ c = constr;  ":"; t = constr -> CCast(loc,c,t)
-      | c = constr -> c ] ]
-  ;
-  vardecls:
-    [ [ na = name; nal = name_comma_list_tail; c = type_option
-          -> LocalRawAssum (na::nal,c)
-      | na = name; "="; c = opt_casted_constr ->
-          LocalRawDef (na,c)
-      | na = name; ":="; c = opt_casted_constr ->
-          LocalRawDef (na,c)
-    ] ]
-  ;
-  binders:
-    [ [ "["; bl = LIST1 vardecls SEP ";"; "]" -> bl ] ]
-  ;
-  binders_list:
-    [ [ bls = LIST0 binders -> List.flatten bls ] ]
-  ;
-  reduce:
-    [ [ IDENT "Eval"; r = Tactic.red_expr; "in" -> Some r
-      | -> None ] ]
-  ;
-  def_body:
-    [ [ bl = binders_list; ":="; red = reduce; c = constr; ":"; t = constr ->
-          DefineBody (bl, red, c, Some t)
-      | bl = binders_list; ":"; t = constr; ":="; red = reduce; c = constr ->
-          DefineBody (bl, red, c, Some t)
-      | bl = binders_list; ":="; red = reduce; c = constr ->
-          DefineBody (bl, red, c, None)
-      | bl = binders_list; ":"; t = constr ->
-          ProveBody (bl, t) ] ]
-  ;
-  gallina:
-    (* Definition, Theorem, Variable, Axiom, ... *)
-    [ [ thm = thm_token; id = identref; bl = binders_list; ":"; c = constr ->
-         VernacStartTheoremProof (thm, id, (bl, c), false, (fun _ _ -> ()))
-      | (f,d) = def_token; id = identref; b = def_body -> 
-          VernacDefinition (d, id, b, f)
-      | stre = assumption_token; bl = ne_params_list -> 
-	  VernacAssumption (stre, bl)
-      | stre = assumptions_token; bl = ne_params_list ->
-	  test_plurial_form bl;
-	  VernacAssumption (stre, bl)
-      ] ]
-  ;
-  (* Gallina inductive declarations *)
   finite_token:
     [ [ "Inductive" -> true
       | "CoInductive" -> false ] ]
@@ -208,192 +170,250 @@ GEXTEND Gram
   record_token:
     [ [ IDENT "Record" -> true | IDENT "Structure" -> false ] ]
   ;
-  constructor:
-    [ [ idl = LIST1 identref SEP ","; coe = of_type_with_opt_coercion;
-        c = constr -> List.map (fun id -> (coe,(id,c))) idl ] ]
-  ;
-  constructor_list:
-    [ [ "|"; l = LIST1 constructor SEP "|" -> List.flatten l
-      | l = LIST1 constructor SEP "|" -> List.flatten l
-      |  -> [] ] ]
-  ;
-  block_old_style:
-    [ [ ind = oneind_old_style; "with"; indl = block_old_style -> ind :: indl
-      | ind = oneind_old_style -> [ind] ] ]
+  (* Simple definitions *)
+  def_body:
+    [ [ bl = LIST0 binder_let; ":="; red = reduce; c = lconstr ->
+      (match c with
+          CCast(_,c,k,t) -> DefineBody (bl, red, c, Some t)
+        | _ -> DefineBody (bl, red, c, None))
+      | bl = LIST0 binder_let; ":"; t = lconstr; ":="; red = reduce; c = lconstr ->
+          DefineBody (bl, red, c, Some t)
+      | bl = LIST0 binder_let; ":"; t = lconstr ->
+          ProveBody (bl, t) ] ]
   ;
-  oneind_old_style:
-    [ [ id = identref; ":"; c = constr; ":="; lc = constructor_list ->
-          (id,c,lc) ] ]
+  reduce:
+    [ [ IDENT "Eval"; r = Tactic.red_expr; "in" -> Some r
+      | -> None ] ]
   ;
-  oneind:
-    [ [ id = identref; indpar = simple_binders_list; ":"; c = constr; 
-        ":="; lc = constructor_list; ntn = OPT decl_notation ->
+  decl_notation:
+    [ [ OPT [ "where"; ntn = ne_string; ":="; c = constr; 
+         scopt = OPT [ ":"; sc = IDENT -> sc] -> (ntn,c,scopt) ] ] ]
+    ;
+  (* Inductives and records *)
+  inductive_definition:
+    [ [ id = identref; indpar = LIST0 binder_let; ":"; c = lconstr; 
+        ":="; lc = constructor_list; ntn = decl_notation ->
 	  (id,ntn,indpar,c,lc) ] ]
   ;
-  simple_binders_list:
-    [ [ bl = ne_simple_binders_list -> bl
+  constructor_list:
+    [ [ "|"; l = LIST1 constructor SEP "|" -> l
+      | l = LIST1 constructor SEP "|" -> l
       |  -> [] ] ]
   ;
+(*
+  csort:
+    [ [ s = sort -> CSort (loc,s) ] ]
+  ;
+*)
   opt_coercion:
     [ [ ">" -> true
       |  -> false ] ]
   ;
-  onescheme:
-    [ [ id = identref; ":="; dep = dep; ind = global; IDENT "Sort";
-        s = sort -> (id,dep,ind,s) ] ]
-  ;
-  schemes:
-    [ [ recl = LIST1 onescheme SEP "with" -> recl ] ]
-  ;
-  dep:
-    [ [ IDENT "Induction"; IDENT "for" -> true
-      | IDENT "Minimality"; IDENT "for" -> false ] ]
+  (* (co)-fixpoints *)
+  rec_definition:
+    [ [ id = ident; bl = LIST1 binder_let;
+        annot = rec_annotation; type_ = type_cstr; 
+	":="; def = lconstr; ntn = decl_notation ->
+          let names = List.map snd (names_of_local_assums bl) in
+          let ni =
+            match fst annot with
+                Some id ->
+                  (try list_index (Name id) names - 1
+                  with Not_found ->  Util.user_err_loc
+                      (loc,"Fixpoint",
+                       Pp.str "No argument named " ++ Nameops.pr_id id))
+              | None -> 
+                  if List.length names > 1 then
+                    Util.user_err_loc
+                      (loc,"Fixpoint",
+                       Pp.str "the recursive argument needs to be specified");
+                  0 in
+	  ((id, (ni, snd annot), bl, type_, def),ntn) ] ]
+  ;
+  corec_definition:
+    [ [ id = ident; bl = LIST0 binder_let; c = type_cstr; ":=";
+        def = lconstr ->
+          (id,bl,c ,def) ] ]
+  ;
+  rec_annotation:
+    [ [ "{"; IDENT "struct"; id=IDENT; "}" -> (Some (id_of_string id), CStructRec)
+      | "{"; IDENT "wf"; id=IDENT; rel=lconstr; "}" -> (Some (id_of_string id), CWfRec rel) 
+      | ->  (None, CStructRec)
+      ] ]
   ;
-  onerec:
-    [ [ id = base_ident; bl = ne_fix_binders; ":"; type_ = constr;
-        ":="; def = constr; ntn = OPT decl_notation ->
-          let ni = List.length (List.flatten (List.map fst bl)) - 1 in
-          let bl = List.map (fun(nal,ty)->LocalRawAssum(nal,ty)) bl in
-	  ((id, ni, bl, type_, def), ntn) ] ]
+  type_cstr:
+    [ [ ":"; c=lconstr -> c 
+      | -> CHole loc ] ]
   ;
-  specifrec:
-    [ [ l = LIST1 onerec SEP "with" -> l ] ]
+  (* Inductive schemes *)
+  scheme:
+    [ [ id = identref; ":="; dep = dep_scheme; "for"; ind = global;
+        IDENT "Sort"; s = sort ->
+          (id,dep,ind,s) ] ]
   ;
-  onecorec:
-    [ [ id = base_ident; ":"; c = constr; ":="; def = constr ->
-          (id,[],c,def) ] ]
+  dep_scheme:
+    [ [ IDENT "Induction" -> true
+      | IDENT "Minimality" -> false ] ]
   ;
-  specifcorec:
-    [ [ l = LIST1 onecorec SEP "with" -> l ] ]
+  (* Various Binders *)
+(*
+  (* ... without coercions *)
+  binder_nodef:
+    [ [ b = binder_let ->
+      (match b with
+          LocalRawAssum(l,ty) -> (l,ty)
+        | LocalRawDef _ ->
+            Util.user_err_loc
+              (loc,"fix_param",Pp.str"defined binder not allowed here")) ] ]
   ;
+*)
+  (* ... with coercions *)
   record_field:
-    [ [ id = name; oc = of_type_with_opt_coercion; t = constr ->
-          (oc,AssumExpr (id,t))
-      | id = name; oc = of_type_with_opt_coercion; t = constr;
-	":="; b = constr ->
-	  (oc,DefExpr (id,b,Some t))
-      | id = name; ":="; b = constr ->
-	  (false,DefExpr (id,b,None)) ] ]
-  ;
-  fields:
-    [ [ fs = LIST0 record_field SEP ";" -> fs ] ]
-  ;
-  simple_binders:
-    [ [ "["; bll = LIST1 vardecls SEP ";"; "]" -> bll ] ]
-  ;
-  ne_simple_binders_list:
-    [ [ bll = LIST1 simple_binders -> (List.flatten bll) ] ]
-  ;
-  fix_params:
-    [ [ idl = LIST1 name SEP ","; ":"; c = constr -> (idl, c)
-      | idl = LIST1 name SEP "," -> (idl, evar_constr dummy_loc)
-    ] ]
-  ;
-  fix_binders:
-    [ [ "["; bll = LIST1 fix_params SEP ";"; "]" -> bll ] ]
-  ;
-  ne_fix_binders:
-    [ [ bll = LIST1 fix_binders -> List.flatten bll ] ]
+    [ [ id = name -> (false,AssumExpr(id,CHole loc))
+      | id = name; oc = of_type_with_opt_coercion; t = lconstr ->
+         (oc,AssumExpr (id,t))
+      | id = name; oc = of_type_with_opt_coercion;
+             t = lconstr; ":="; b = lconstr -> (oc,DefExpr (id,b,Some t))
+      | id = name; ":="; b = lconstr ->
+         match b with
+             CCast(_,b,_,t) -> (false,DefExpr(id,b,Some t))
+           | _ -> (false,DefExpr(id,b,None)) ] ]
+  ;
+  assum_list:
+    [ [ bl = LIST1 assum_coe -> bl | b = simple_assum_coe -> [b] ] ]
+  ;
+  assum_coe:
+    [ [ "("; a = simple_assum_coe; ")" -> a ] ]
+  ;
+  simple_assum_coe:
+    [ [ idl = LIST1 identref; oc = of_type_with_opt_coercion; c = lconstr -> 
+        (oc,(idl,c)) ] ]
   ;
-  rec_constructor:
-    [ [ c = identref -> Some c
-      |  -> None ] ]
-  ;
-  gallina_ext:
-    [ [ IDENT "Mutual"; bl = ne_simple_binders_list ; f = finite_token;
-        indl = block_old_style ->
-	  let indl' = List.map (fun (id,ar,c) -> (id,None,bl,ar,c)) indl in
-	  VernacInductive (f,indl')
-      | b = record_token; oc = opt_coercion; name = identref;
-	ps = simple_binders_list; ":";
-	s = constr; ":="; c = rec_constructor; "{"; fs = fields; "}" ->
-	  VernacRecord (b,(oc,name),ps,s,c,fs)
-    ] ]
-  ;
-  gallina:
-    [ [ IDENT "Mutual"; f = finite_token; indl = LIST1 oneind SEP "with" ->
-          VernacInductive (f,indl)
-      | f = finite_token; indl = LIST1 oneind SEP "with" ->
-          VernacInductive (f,indl)
-      | "Fixpoint"; recs = specifrec -> VernacFixpoint recs
-      | "CoFixpoint"; corecs = specifcorec -> VernacCoFixpoint corecs
-      | IDENT "Scheme"; l = schemes -> VernacScheme l
-      | f = finite_token; s = csort; id = identref;
-	indpar = simple_binders_list; ":="; lc = constructor_list -> 
-          VernacInductive (f,[id,None,indpar,s,lc]) ] ]
+  constructor:
+    [ [ id = identref; l = LIST0 binder_let; 
+        coe = of_type_with_opt_coercion; c = lconstr ->
+	  (coe,(id,G_constr.mkCProdN loc l c))
+      | id = identref; l = LIST0 binder_let ->
+	  (false,(id,G_constr.mkCProdN loc l (CHole loc))) ] ]
   ;
-  csort:
-    [ [ s = sort -> CSort (loc,s) ] ]
+  of_type_with_opt_coercion:
+    [ [ ":>" -> true
+      | ":"; ">" -> true
+      | ":" -> false ] ]
   ;
+END
+
+
+(* Modules and Sections *)
+GEXTEND Gram
+  GLOBAL: gallina_ext module_expr module_type;
+
   gallina_ext:
-    [ [ 
-(* Sections *)
-	IDENT "Section"; id = identref -> VernacBeginSection id
-      | IDENT "Chapter"; id = identref -> VernacBeginSection id ] ]
-  ;
-  module_vardecls:
-    [ [ id = identref; idl = ident_comma_list_tail; ":";
-        mty = Module.module_type -> (id::idl,mty) ] ]
+    [ [ (* Interactive module declaration *)
+        IDENT "Module"; export = export_token; id = identref; 
+	bl = LIST0 module_binder; mty_o = OPT of_module_type; 
+	mexpr_o = OPT is_module_expr ->
+	  VernacDefineModule (export, id, bl, mty_o, mexpr_o)
+	  
+      | IDENT "Module"; "Type"; id = identref; 
+	bl = LIST0 module_binder; mty_o = OPT is_module_type ->
+	  VernacDeclareModuleType (id, bl, mty_o)
+	  
+      | IDENT "Declare"; IDENT "Module"; export = export_token; id = identref; 
+	bl = LIST0 module_binder; mty_o = of_module_type ->
+	  VernacDeclareModule (export, id, bl, mty_o)
+      (* Section beginning *)
+      | IDENT "Section"; id = identref -> VernacBeginSection id
+      | IDENT "Chapter"; id = identref -> VernacBeginSection id
+
+      (* This end a Section a Module or a Module Type *)
+      | IDENT "End"; id = identref -> VernacEndSegment id
+
+      (* Requiring an already compiled module *)
+      | IDENT "Require"; export = export_token; specif = specif_token;
+        qidl = LIST1 global ->
+          VernacRequire (export, specif, qidl)
+      | IDENT "Require"; export = export_token; specif = specif_token;
+        filename = ne_string -> 
+	  VernacRequireFrom (export, specif, filename)
+      | IDENT "Import"; qidl = LIST1 global -> VernacImport (false,qidl)
+      | IDENT "Export"; qidl = LIST1 global -> VernacImport (true,qidl) ] ]
   ;
-  module_binders:
-    [ [ "["; bl = LIST1 module_vardecls SEP ";"; "]" -> bl ] ]
+  export_token:
+    [ [ IDENT "Import" -> Some false
+      | IDENT "Export" -> Some true
+      |  -> None ] ]
   ;
-  module_binders_list:
-    [ [ bls = LIST0 module_binders -> List.flatten bls ] ]
+  specif_token:
+    [ [ IDENT "Implementation" -> Some false
+      | IDENT "Specification" -> Some true
+      |  -> None ] ]
   ;
   of_module_type:
-    [ [ ":"; mty = Module.module_type -> (mty, true) 
-      | "<:"; mty = Module.module_type -> (mty, false) ] ]
+    [ [ ":"; mty = module_type -> (mty, true) 
+      | "<:"; mty = module_type -> (mty, false) ] ]
   ;
   is_module_type:
-    [ [ ":="; mty = Module.module_type -> mty ] ]
+    [ [ ":="; mty = module_type -> mty ] ]
   ;
   is_module_expr:
-    [ [ ":="; mexpr = Module.module_expr -> mexpr ] ]
+    [ [ ":="; mexpr = module_expr -> mexpr ] ]
   ;
-  gallina_ext:
-    [ [ 
-	  (* Interactive module declaration *)
-	IDENT "Module"; id = identref; 
-	bl = module_binders_list; mty_o = OPT of_module_type; 
-	mexpr_o = OPT is_module_expr ->
-	  VernacDefineModule (id, bl, mty_o, mexpr_o)
-	  
-      | IDENT "Module"; "Type"; id = identref; 
-	bl = module_binders_list; mty_o = OPT is_module_type ->
-	  VernacDeclareModuleType (id, bl, mty_o)
-	  
-      | IDENT "Declare"; IDENT "Module"; id = identref; 
-	bl = module_binders_list; mty_o = OPT of_module_type; 
-	mexpr_o = OPT is_module_expr ->
-	  VernacDeclareModule (id, bl, mty_o, mexpr_o)
 
-	  (* This end a Section a Module or a Module Type *)
+  (* Module binder  *)
+  module_binder:
+    [ [ "("; export = export_token; idl = LIST1 identref; ":";
+         mty = module_type; ")" -> (export,idl,mty) ] ]
+  ;
 
-      | IDENT "End"; id = identref -> VernacEndSegment id
+  (* Module expressions *)
+  module_expr:
+    [ [ qid = qualid -> CMEident qid
+      | me1 = module_expr; me2 = module_expr -> CMEapply (me1,me2)
+      | "("; me = module_expr; ")" -> me
+(* ... *)
+      ] ]
+  ;
+  with_declaration:
+    [ [ "Definition"; fqid = fullyqualid; ":="; c = Constr.lconstr ->
+          CWith_Definition (fqid,c)
+      | IDENT "Module"; fqid = fullyqualid; ":="; qid = qualid ->
+	  CWith_Module (fqid,qid)
+      ] ]
+  ;
+  module_type:
+    [ [ qid = qualid -> CMTEident qid
+(* ... *)
+      | mty = module_type; "with"; decl = with_declaration -> 
+	  CMTEwith (mty,decl) ] ]
+  ;
+END
 
+(* Extensions: implicits, coercions, etc. *)   
+GEXTEND Gram
+  GLOBAL: gallina_ext;
 
-(* Transparent and Opaque *)
-      | IDENT "Transparent"; l = LIST1 global -> VernacSetOpacity (false, l)
+  gallina_ext:
+    [ [ (* Transparent and Opaque *)
+        IDENT "Transparent"; l = LIST1 global -> VernacSetOpacity (false, l)
       | IDENT "Opaque"; l = LIST1 global -> VernacSetOpacity (true, l)
 
-(* Canonical structure *)
+      (* Canonical structure *)
       | IDENT "Canonical"; IDENT "Structure"; qid = global ->
 	  VernacCanonical qid
       | IDENT "Canonical"; IDENT "Structure"; qid = global; d = def_body ->
-          let s = Ast.coerce_global_to_id qid in
+          let s = coerce_global_to_id qid in
 	  VernacDefinition 
-	    ((Global,CanonicalStructure),(dummy_loc,s),d,Recordobj.add_object_hook)
-      (* Rem: LOBJECT, OBJCOERCION, LOBJCOERCION have been removed
-         (they were unused and undocumented) *)
+	    ((Global,false,CanonicalStructure),(dummy_loc,s),d,
+	     (fun _ -> Recordops.declare_canonical_structure))
 
-(* Coercions *)
+      (* Coercions *)
       | IDENT "Coercion"; qid = global; d = def_body ->
-          let s = Ast.coerce_global_to_id qid in
-	  VernacDefinition ((Global,Coercion),(dummy_loc,s),d,Class.add_coercion_hook)
+          let s = coerce_global_to_id qid in
+	  VernacDefinition ((Global,false,Coercion),(dummy_loc,s),d,Class.add_coercion_hook)
       | IDENT "Coercion"; IDENT "Local"; qid = global; d = def_body ->
-           let s = Ast.coerce_global_to_id qid in
-	  VernacDefinition ((Local,Coercion),(dummy_loc,s),d,Class.add_coercion_hook)
+           let s = coerce_global_to_id qid in
+	  VernacDefinition ((Local,false,Coercion),(dummy_loc,s),d,Class.add_coercion_hook)
       | IDENT "Identity"; IDENT "Coercion"; IDENT "Local"; f = identref;
          ":"; s = class_rawexpr; ">->"; t = class_rawexpr -> 
 	   VernacIdentityCoercion (Local, f, s, t)
@@ -406,114 +426,230 @@ GEXTEND Gram
       | IDENT "Coercion"; qid = global; ":"; s = class_rawexpr; ">->";
          t = class_rawexpr ->
 	  VernacCoercion (Global, qid, s, t)
-      | IDENT "Class"; IDENT "Local"; c = global ->
-	  Pp.warning "Class is obsolete"; VernacNop
-      | IDENT "Class"; c = global ->
-	  Pp.warning "Class is obsolete"; VernacNop
 
-(* Implicit *)
-(*
-      | IDENT "Syntactic"; "Definition"; id = identref; ":="; c = constr;
-         n = OPT [ "|"; n = natural -> n ] ->
-	   VernacSyntacticDefinition (id,c,n)
-*)
-      | IDENT "Syntactic"; "Definition"; id = ident; ":="; c = constr;
-         n = OPT [ "|"; n = natural -> n ] ->
-	   let c = match n with
-	     | Some n ->
-		 let l = list_tabulate (fun _ -> (CHole (loc),None)) n in
-		 CApp (loc,(None,c),l)
-	     | None -> c in
-	   VernacSyntacticDefinition (id,c,false,true)
-      | IDENT "Implicits"; qid = global; "["; l = LIST0 natural; "]" ->
-	  let l = List.map (fun n -> ExplByPos n) l in
-	  VernacDeclareImplicits (qid,Some l)
-      | IDENT "Implicits"; qid = global -> VernacDeclareImplicits (qid,None)
-
-      | IDENT "Implicit"; ["Variable"; "Type" | IDENT "Variables"; "Type"];
-	   idl = LIST1 identref SEP ","; ":"; c = constr -> VernacReserve (idl,c)
-
-      (* For compatibility *)
-      | IDENT "Implicit"; IDENT "Arguments"; IDENT "On" ->
-	  VernacSetOption
-	    (Goptions.SecondaryTable ("Implicit","Arguments"), BoolValue true)
-      | IDENT "Implicit"; IDENT "Arguments"; IDENT "Off" ->
-	  VernacSetOption
-	    (Goptions.SecondaryTable ("Implicit","Arguments"), BoolValue false)
-  ] ]
+      (* Implicit *)
+      | IDENT "Implicit"; IDENT "Arguments"; qid = global; 
+         pos = OPT [ "["; l = LIST0 ident; "]" -> l ] ->
+	   let pos = option_app (List.map (fun id -> ExplByName id)) pos in
+	   VernacDeclareImplicits (qid,pos)
+
+      | IDENT "Implicit"; ["Type" | IDENT "Types"];
+	   idl = LIST1 identref; ":"; c = lconstr -> VernacReserve (idl,c) ] ]
   ;
 END
 
-(* Modules management *)   
-if !Options.v7 then
 GEXTEND Gram
-  GLOBAL: command;
+  GLOBAL: command check_command class_rawexpr;
 
-  export_token:
-    [ [ IDENT "Import" -> false
-      | IDENT "Export" -> true
-      |  -> false ] ]
-  ;
-  specif_token:
-    [ [ IDENT "Implementation" -> Some false
-      | IDENT "Specification" -> Some true
-      |  -> None ] ]
-  ;
   command:
-    [ [ "Load"; verbosely = [ IDENT "Verbose" -> true | -> false ];
-	s = [ s = STRING -> s | s = IDENT -> s ] ->
+    [ [ IDENT "Comments"; l = LIST0 comment -> VernacComments l
+
+      (* System directory *)
+      | IDENT "Pwd" -> VernacChdir None
+      | IDENT "Cd" -> VernacChdir None
+      | IDENT "Cd"; dir = ne_string -> VernacChdir (Some dir)
+
+      (* Toplevel control *)
+      | IDENT "Drop" -> VernacToplevelControl Drop
+      | IDENT "ProtectedLoop" -> VernacToplevelControl ProtectedLoop
+      | IDENT "Quit" -> VernacToplevelControl Quit
+
+      | IDENT "Load"; verbosely = [ IDENT "Verbose" -> true | -> false ];
+	s = [ s = ne_string -> s | s = IDENT -> s ] ->
 	  VernacLoad (verbosely, s)
-(*      | "Compile";
-	verbosely =
-          [ IDENT "Verbose" -> "Verbose"
-          | -> "" ];
-	IDENT "Module";
-	only_spec =
-          [ IDENT "Specification" -> "Specification"
-          | -> "" ];
-	mname = [ s = STRING -> s | s = IDENT -> s ];
-	fname = OPT [ s = STRING -> s | s = IDENT -> s ] -> ExtraVernac
-          let fname = match fname with Some s -> s | None -> mname in
-            <:ast< (CompileFile ($STR $verbosely) ($STR $only_spec)
-                      ($STR $mname) ($STR $fname))>>
-*)
-      | IDENT "Read"; IDENT "Module"; qidl = LIST1 global ->
-	  VernacRequire (None, None, qidl)
-      | IDENT "Require"; export = export_token; specif = specif_token;
-        qidl = LIST1 global -> VernacRequire (Some export, specif, qidl)
-(*      | IDENT "Require"; export = export_token; specif = specif_token;
-        id = identref; filename = STRING -> 
-	  VernacRequireFrom (export, specif, id, filename) *)
-      | IDENT "Require"; export = export_token; specif = specif_token;
-        filename = STRING -> 
-	  VernacRequireFrom (Some export, specif, filename)
-      | IDENT "Declare"; IDENT "ML"; IDENT "Module"; l = LIST1 STRING ->
+      | IDENT "Declare"; IDENT "ML"; IDENT "Module"; l = LIST1 ne_string ->
 	  VernacDeclareMLModule l
-      | IDENT "Import"; qidl = LIST1 global -> VernacImport (false,qidl)
-      | IDENT "Export"; qidl = LIST1 global -> VernacImport (true,qidl)
-  ] 
-]
+
+      (* Dump of the universe graph - to file or to stdout *) 
+      | IDENT "Dump"; IDENT "Universes"; fopt = OPT ne_string ->
+	  VernacPrint (PrintUniverses fopt)
+
+      | IDENT "Locate"; l = locatable -> VernacLocate l
+
+      (* Managing load paths *)
+      | IDENT "Add"; IDENT "LoadPath"; dir = ne_string; alias = as_dirpath ->
+	  VernacAddLoadPath (false, dir, alias)
+      | IDENT "Add"; IDENT "Rec"; IDENT "LoadPath"; dir = ne_string; 
+	  alias = as_dirpath -> VernacAddLoadPath (true, dir, alias)
+      | IDENT "Remove"; IDENT "LoadPath"; dir = ne_string ->
+	  VernacRemoveLoadPath dir
+
+       (* For compatibility *)
+      | IDENT "AddPath"; dir = ne_string; "as"; alias = as_dirpath ->
+	  VernacAddLoadPath (false, dir, alias)
+      | IDENT "AddRecPath"; dir = ne_string; "as"; alias = as_dirpath ->
+	  VernacAddLoadPath (true, dir, alias)
+      | IDENT "DelPath"; dir = ne_string ->
+	  VernacRemoveLoadPath dir
+
+      (* Type-Checking (pas dans le refman) *)
+      | "Type"; c = lconstr -> VernacGlobalCheck c
+
+      (* Printing (careful factorization of entries) *)
+      | IDENT "Print"; p = printable -> VernacPrint p
+      | IDENT "Print"; qid = global -> VernacPrint (PrintName qid)
+      | IDENT "Print"; IDENT "Module"; "Type"; qid = global -> 
+	  VernacPrint (PrintModuleType qid)
+      | IDENT "Print"; IDENT "Module"; qid = global -> 
+	  VernacPrint (PrintModule qid)
+      | IDENT "Inspect"; n = natural -> VernacPrint (PrintInspect n)
+      | IDENT "About"; qid = global -> VernacPrint (PrintAbout qid)
+
+      (* Searching the environment *)
+      | IDENT "Search"; qid = global; l = in_or_out_modules -> 
+	  VernacSearch (SearchHead qid, l)
+      | IDENT "SearchPattern"; c = constr_pattern; l = in_or_out_modules ->
+	  VernacSearch (SearchPattern c, l)
+      | IDENT "SearchRewrite"; c = constr_pattern; l = in_or_out_modules ->
+	  VernacSearch (SearchRewrite c, l)
+      | IDENT "SearchAbout"; 
+	  sl = [ "["; l = LIST1 [ r = global -> SearchRef r
+                                | s = ne_string -> SearchString s ]; "]" -> l 
+   		 | qid = global -> [SearchRef qid] ];
+	  l = in_or_out_modules -> 
+	  VernacSearch (SearchAbout sl, l)
+
+      | IDENT "Add"; IDENT "ML"; IDENT "Path"; dir = ne_string ->
+	  VernacAddMLPath (false, dir)
+      | IDENT "Add"; IDENT "Rec"; IDENT "ML"; IDENT "Path"; dir = ne_string ->
+	  VernacAddMLPath (true, dir)
+
+      (* Pour intervenir sur les tables de param�ètres *)
+      | "Set"; table = IDENT; field = IDENT; v = option_value ->
+  	  VernacSetOption (SecondaryTable (table,field),v)
+      | "Set"; table = IDENT; field = IDENT; lv = LIST1 option_ref_value ->
+  	  VernacAddOption (SecondaryTable (table,field),lv)
+      | "Set"; table = IDENT; field = IDENT ->
+  	  VernacSetOption (SecondaryTable (table,field),BoolValue true)
+      | IDENT "Unset"; table = IDENT; field = IDENT ->
+  	  VernacUnsetOption (SecondaryTable (table,field))
+      | IDENT "Unset"; table = IDENT; field = IDENT; lv = LIST1 option_ref_value ->
+  	  VernacRemoveOption (SecondaryTable (table,field),lv)
+      | "Set"; table = IDENT; value = option_value ->
+  	  VernacSetOption (PrimaryTable table, value)
+      | "Set"; table = IDENT ->
+  	  VernacSetOption (PrimaryTable table, BoolValue true)
+      | IDENT "Unset"; table = IDENT ->
+  	  VernacUnsetOption (PrimaryTable table)
+
+      | IDENT "Print"; IDENT "Table"; table = IDENT; field = IDENT ->
+	  VernacPrintOption (SecondaryTable (table,field))
+      | IDENT "Print"; IDENT "Table"; table = IDENT ->
+	  VernacPrintOption (PrimaryTable table)
+
+      | IDENT "Add"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
+        -> VernacAddOption (SecondaryTable (table,field), v)
+
+      (* Un value global ci-dessous va �être cach�é par un field au dessus! *)
+      | IDENT "Add"; table = IDENT; v = LIST1 option_ref_value ->
+          VernacAddOption (PrimaryTable table, v)
+
+      | IDENT "Test"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
+        -> VernacMemOption (SecondaryTable (table,field), v)
+      | IDENT "Test"; table = IDENT; field = IDENT ->
+          VernacPrintOption (SecondaryTable (table,field))
+      | IDENT "Test"; table = IDENT; v = LIST1 option_ref_value ->
+          VernacMemOption (PrimaryTable table, v)
+      | IDENT "Test"; table = IDENT ->
+          VernacPrintOption (PrimaryTable table)
+
+      | 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) ] ]
   ;
-END
+  check_command: (* TODO: rapprocher Eval et Check *)
+    [ [ IDENT "Eval"; r = Tactic.red_expr; "in"; c = lconstr ->
+          fun g -> VernacCheckMayEval (Some r, g, c)
+      | IDENT "Check"; c = lconstr ->
+	  fun g -> VernacCheckMayEval (None, g, c) ] ]
+  ;
+  printable:
+    [ [ IDENT "Term"; qid = global -> PrintName qid
+      | IDENT "All" -> PrintFullContext
+      | IDENT "Section"; s = global -> PrintSectionContext s
+      | IDENT "Grammar"; ent = IDENT ->
+          (* This should be in "syntax" section but is here for factorization*)
+	  PrintGrammar ("", ent)
+      | IDENT "LoadPath" -> PrintLoadPath
+      | IDENT "Modules" -> PrintModules
 
-if !Options.v7 then
-GEXTEND Gram
-  GLOBAL: command;
+      | IDENT "ML"; IDENT "Path" -> PrintMLLoadPath
+      | IDENT "ML"; IDENT "Modules" -> PrintMLModules
+      | IDENT "Graph" -> PrintGraph
+      | IDENT "Classes" ->  PrintClasses
+      | IDENT "Ltac"; qid = global -> PrintLtac qid
+      | IDENT "Coercions" -> PrintCoercions
+      | IDENT "Coercion"; IDENT "Paths"; s = class_rawexpr; t = class_rawexpr
+         -> PrintCoercionPaths (s,t)
+      | IDENT "Canonical"; IDENT "Projections" -> PrintCanonicalConversions
+      | IDENT "Tables" -> PrintTables
+(* Obsolete: was used for cooking V6.3 recipes ??
+      | IDENT "Proof"; qid = global -> PrintOpaqueName qid
+*)
+      | IDENT "Hint" -> PrintHintGoal
+      | IDENT "Hint"; qid = global -> PrintHint qid
+      | IDENT "Hint"; "*" -> PrintHintDb
+      | IDENT "HintDb"; s = IDENT -> PrintHintDbName s
+      | "Rewrite"; IDENT "HintDb"; s = IDENT -> PrintRewriteHintDbName s
+      | IDENT "Setoids" -> PrintSetoids
+      | IDENT "Scopes" -> PrintScopes
+      | IDENT "Scope"; s = IDENT -> PrintScope s
+      | IDENT "Visibility"; s = OPT IDENT -> PrintVisibility s
+      | IDENT "Implicit"; qid = global -> PrintImplicit qid ] ]
+  ;
+  class_rawexpr:
+    [ [ IDENT "Funclass" -> FunClass
+      | IDENT "Sortclass" -> SortClass
+      | qid = global -> RefClass qid ] ]
+  ;
+  locatable:
+    [ [ qid = global -> LocateTerm qid
+      | IDENT "File"; f = ne_string -> LocateFile f
+      | IDENT "Library"; qid = global -> LocateLibrary qid
+      | IDENT "Module"; qid = global -> LocateModule qid
+      | s = ne_string -> LocateNotation s ] ]
+  ;
+  option_value:
+    [ [ n  = integer   -> IntValue n
+      | s  = STRING    -> StringValue s ] ]
+  ;
+  option_ref_value:
+    [ [ id = global   -> QualidRefValue id
+      | s  = STRING   -> StringRefValue s ] ]
+  ;
+  as_dirpath:
+    [ [ d = OPT [ "as"; d = dirpath -> d ] -> d ] ]
+  ;
+  in_or_out_modules:
+    [ [ IDENT "inside"; l = LIST1 global -> SearchInside l
+      | IDENT "outside"; l = LIST1 global -> SearchOutside l
+      | -> SearchOutside [] ] ]
+  ;
+  comment:
+    [ [ c = constr -> CommentConstr c
+      | s = STRING -> CommentString s
+      | n = natural -> CommentInt n ] ]
+  ;
+END;
 
+GEXTEND Gram
   command:
     [ [ 
-
 (* State management *)
         IDENT "Write"; IDENT "State"; s = IDENT -> VernacWriteState s
-      | IDENT "Write"; IDENT "State"; s = STRING -> VernacWriteState s
+      | IDENT "Write"; IDENT "State"; s = ne_string -> VernacWriteState s
       | IDENT "Restore"; IDENT "State"; s = IDENT -> VernacRestoreState s
-      | IDENT "Restore"; IDENT "State"; s = STRING -> VernacRestoreState s
+      | IDENT "Restore"; IDENT "State"; s = ne_string -> VernacRestoreState s
 
 (* Resetting *)
       | IDENT "Reset"; id = identref -> VernacResetName id
       | IDENT "Reset"; IDENT "Initial" -> VernacResetInitial
       | IDENT "Back" -> VernacBack 1
       | IDENT "Back"; n = natural -> VernacBack n
+      | IDENT "BackTo"; n = natural -> VernacBackTo n
+      | IDENT "Backtrack"; n = natural ; m = natural ; p = natural -> 
+	  VernacBacktrack (n,m,p)
 
 (* Tactic Debugger *)
       |	IDENT "Debug"; IDENT "On" -> VernacDebug true
@@ -522,3 +658,86 @@ GEXTEND Gram
  ] ];
     END
 ;;
+
+(* Grammar extensions *)
+	  
+GEXTEND Gram
+  GLOBAL: syntax;
+
+  syntax:
+   [ [ IDENT "Open"; local = locality; IDENT "Scope"; sc = IDENT -> 
+         VernacOpenCloseScope (local,true,sc)
+
+     | IDENT "Close"; local = locality; IDENT "Scope"; sc = IDENT -> 
+         VernacOpenCloseScope (local,false,sc)
+
+     | IDENT "Delimit"; IDENT "Scope"; sc = IDENT; "with"; key = IDENT ->
+	 VernacDelimiters (sc,key)
+
+     | IDENT "Bind"; IDENT "Scope"; sc = IDENT; "with"; 
+       refl = LIST1 class_rawexpr -> VernacBindScope (sc,refl)
+
+     | IDENT "Arguments"; IDENT "Scope"; qid = global;
+         "["; scl = LIST0 opt_scope; "]" -> VernacArgumentsScope (qid,scl)
+
+     | IDENT "Infix"; local = locality;
+	 op = ne_string; ":="; p = global; 
+         modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
+	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
+         VernacInfix (local,(op,modl),p,sc)
+     | IDENT "Notation"; local = locality; id = ident; ":="; c = constr;
+	 b = [ "("; IDENT "only"; IDENT "parsing"; ")" -> true | -> false ] ->
+           VernacSyntacticDefinition (id,c,local,b)
+     | IDENT "Notation"; local = locality; s = ne_string; ":="; c = constr;
+         modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
+	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
+           VernacNotation (local,c,(s,modl),sc)
+
+     | IDENT "Tactic"; IDENT "Notation"; n = tactic_level; 
+	 pil = LIST1 production_item; ":="; t = Tactic.tactic
+         -> VernacTacticNotation (n,pil,t)
+
+     | IDENT "Reserved"; IDENT "Notation"; local = locality; s = ne_string; 
+	 l = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ]
+	 -> VernacSyntaxExtension (local,(s,l))
+
+     (* "Print" "Grammar" should be here but is in "command" entry in order 
+        to factorize with other "Print"-based vernac entries *)
+  ] ]
+  ;
+  tactic_level:
+    [ [ "("; "at"; IDENT "level"; n = natural; ")" -> n | -> 0 ] ]
+  ;
+  locality:
+    [ [ IDENT "Local" -> true | -> false ] ]
+  ;
+  level:
+    [ [ IDENT "level"; n = natural -> NumLevel n
+      | IDENT "next"; IDENT "level" -> NextLevel ] ]
+  ;
+  syntax_modifier:
+    [ [ x = IDENT; "at"; lev = level -> SetItemLevel ([x],lev)
+      | x = IDENT; ","; l = LIST1 IDENT SEP ","; "at"; 
+        lev = level -> SetItemLevel (x::l,lev)
+      | "at"; IDENT "level"; n = natural -> SetLevel n
+      | IDENT "left"; IDENT "associativity" -> SetAssoc Gramext.LeftA
+      | IDENT "right"; IDENT "associativity" -> SetAssoc Gramext.RightA
+      | IDENT "no"; IDENT "associativity" -> SetAssoc Gramext.NonA
+      | x = IDENT; typ = syntax_extension_type -> SetEntryType (x,typ)
+      | IDENT "only"; IDENT "parsing" -> SetOnlyParsing
+      | IDENT "format"; s = [s = STRING -> (loc,s)] -> SetFormat s ] ]
+  ;
+  syntax_extension_type:
+    [ [ IDENT "ident" -> ETIdent | IDENT "global" -> ETReference
+      | IDENT "bigint" -> ETBigint
+    ] ]
+  ;
+  opt_scope:
+    [ [ "_" -> None | sc = IDENT -> Some sc ] ]
+  ;
+  production_item:
+    [ [ s = ne_string -> VTerm s
+      | nt = IDENT; po = OPT [ "("; p = ident; ")" -> p ] -> 
+	  VNonTerm (loc,nt,po) ] ]
+  ;
+END
diff --git a/parsing/g_vernacnew.ml4 b/parsing/g_vernacnew.ml4
deleted file mode 100644
index 976cc259..00000000
--- a/parsing/g_vernacnew.ml4
+++ /dev/null
@@ -1,728 +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        *)
-(************************************************************************)
-
-(* $Id: g_vernacnew.ml4,v 1.63.2.2 2004/10/12 10:10:29 herbelin Exp $ *)
-
-open Pp
-open Util
-open Names
-open Coqast
-open Topconstr
-open Vernacexpr
-open Pcoq
-open Tactic
-open Decl_kinds
-open Genarg
-open Extend
-open Ppextend
-open Goptions
-
-open Prim
-open Constr
-open Vernac_
-open Module
-
-
-let vernac_kw = [ ";"; ","; ">->"; ":<"; "<:"; "where"; "at" ]
-let _ = 
-  if not !Options.v7 then
-    List.iter (fun s -> Lexer.add_token ("",s)) vernac_kw
-
-(* Rem: do not join the different GEXTEND into one, it breaks native *)
-(* compilation on PowerPC and Sun architectures *)
-
-let check_command = Gram.Entry.create "vernac:check_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"
-
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: vernac gallina_ext;
-  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         *)
-    [ [ g = gallina; "." -> g 
-      | g = gallina_ext; "." -> g
-      | c = command; "." -> c 
-      | c = syntax; "." -> c
-      | "["; l = LIST1 located_vernac; "]"; "." -> VernacList l
-    ] ]
-  ;
-  vernac: FIRST
-    [ [ IDENT "Time"; v = vernac  -> VernacTime v ] ]
-  ;
-  vernac: LAST
-    [ [ gln = OPT[n=natural; ":" -> n];
-        tac = subgoal_command -> tac gln ] ]
-  ;
-  subgoal_command:
-    [ [ c = check_command; "." -> c
-      | tac = Tactic.tactic;
-        use_dft_tac = [ "." -> false | "..." -> true ] ->
-          (fun g ->
-            let g = match g with Some gl -> gl | _ -> 1 in
-            VernacSolve(g,tac,use_dft_tac)) ] ]
-  ;
-  located_vernac:
-    [ [ v = vernac -> loc, v ] ]
-  ;
-END
-
-
-let test_plurial_form = function
-  | [(_,([_],_))] ->
-      Options.if_verbose warning
-   "Keywords Variables/Hypotheses/Parameters expect more than one assumption"
-  | _ -> ()
-
-let no_coercion loc (c,x) =
-  if c then Util.user_err_loc
-    (loc,"no_coercion",Pp.str"no coercion allowed here");
-  x
-
-(* Gallina declarations *)
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: gallina gallina_ext thm_token def_body;
-
-  gallina:
-      (* Definition, Theorem, Variable, Axiom, ... *)
-    [ [ thm = thm_token; id = identref; bl = LIST0 binder_let; ":";
-        c = lconstr ->
-          VernacStartTheoremProof (thm, id, (bl, c), false, (fun _ _ -> ()))
-      | (f,d) = def_token; id = identref; b = def_body -> 
-          VernacDefinition (d, id, b, f)
-      | stre = assumption_token; bl = assum_list -> 
-	  VernacAssumption (stre, bl)
-      | stre = assumptions_token; bl = assum_list ->
-	  test_plurial_form bl;
-	  VernacAssumption (stre, bl)
-      (* Gallina inductive declarations *)
-      | f = finite_token;
-        indl = LIST1 inductive_definition SEP "with" ->
-          VernacInductive (f,indl)
-      | "Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
-          VernacFixpoint recs
-      | "CoFixpoint"; corecs = LIST1 corec_definition SEP "with" ->
-          VernacCoFixpoint corecs
-      | IDENT "Scheme"; l = LIST1 scheme SEP "with" -> VernacScheme l ] ]
-  ;
-  gallina_ext:
-    [ [ b = record_token; oc = opt_coercion; name = identref;
-        ps = LIST0 binder_let; ":";
-	s = lconstr; ":="; cstr = OPT identref; "{";
-        fs = LIST0 record_field SEP ";"; "}" ->
-	  VernacRecord (b,(oc,name),ps,s,cstr,fs)
-(* Non port�é ?
-      | f = finite_token; s = csort; id = identref;
-        indpar = LIST0 simple_binder; ":="; lc = constructor_list -> 
-          VernacInductive (f,[id,None,indpar,s,lc])
-*)
-    ] ]
-  ;
-  thm_token:
-    [ [ "Theorem" -> Theorem
-      | IDENT "Lemma" -> Lemma
-      | IDENT "Fact" -> Fact
-      | IDENT "Remark" -> Remark ] ]
-  ;
-  def_token:
-    [ [ "Definition" -> (fun _ _ -> ()), (Global, Definition)
-      | IDENT "Let" -> (fun _ _ -> ()), (Local, Definition)
-      | IDENT "SubClass"  -> Class.add_subclass_hook, (Global, SubClass)
-      | IDENT "Local"; IDENT "SubClass"  ->
-          Class.add_subclass_hook, (Local, SubClass) ] ] 
-  ;
-  assumption_token:
-    [ [ "Hypothesis" -> (Local, Logical)
-      | "Variable" -> (Local, Definitional)
-      | "Axiom" -> (Global, Logical)
-      | "Parameter" -> (Global, Definitional)
-      | IDENT "Conjecture" -> (Global, Conjectural) ] ]
-  ;
-  assumptions_token:
-    [ [ IDENT "Hypotheses" -> (Local, Logical)
-      | IDENT "Variables" -> (Local, Definitional)
-      | IDENT "Axioms" -> (Global, Logical)
-      | IDENT "Parameters" -> (Global, Definitional) ] ]
-  ;
-  finite_token:
-    [ [ "Inductive" -> true
-      | "CoInductive" -> false ] ]
-  ;
-  record_token:
-    [ [ IDENT "Record" -> true | IDENT "Structure" -> false ] ]
-  ;
-  (* Simple definitions *)
-  def_body:
-    [ [ bl = LIST0 binder_let; ":="; red = reduce; c = lconstr ->
-      (match c with
-          CCast(_,c,t) -> DefineBody (bl, red, c, Some t)
-        | _ -> DefineBody (bl, red, c, None))
-      | bl = LIST0 binder_let; ":"; t = lconstr; ":="; red = reduce; c = lconstr ->
-          DefineBody (bl, red, c, Some t)
-      | bl = LIST0 binder_let; ":"; t = lconstr ->
-          ProveBody (bl, t) ] ]
-  ;
-  reduce:
-    [ [ IDENT "Eval"; r = Tactic.red_expr; "in" -> Some r
-      | -> None ] ]
-  ;
-  decl_notation:
-    [ [ OPT [ "where"; ntn = ne_string; ":="; c = constr; 
-         scopt = OPT [ ":"; sc = IDENT -> sc] -> (ntn,c,scopt) ] ] ]
-    ;
-  (* Inductives and records *)
-  inductive_definition:
-    [ [ id = identref; indpar = LIST0 binder_let; ":"; c = lconstr; 
-        ":="; lc = constructor_list; ntn = decl_notation ->
-	  (id,ntn,indpar,c,lc) ] ]
-  ;
-  constructor_list:
-    [ [ "|"; l = LIST1 constructor SEP "|" -> l
-      | l = LIST1 constructor SEP "|" -> l
-      |  -> [] ] ]
-  ;
-(*
-  csort:
-    [ [ s = sort -> CSort (loc,s) ] ]
-  ;
-*)
-  opt_coercion:
-    [ [ ">" -> true
-      |  -> false ] ]
-  ;
-  (* (co)-fixpoints *)
-  rec_definition:
-    [ [ id = base_ident; bl = LIST1 binder_let;
-        annot = OPT rec_annotation; type_ = type_cstr; 
-	":="; def = lconstr; ntn = decl_notation ->
-          let names = List.map snd (names_of_local_assums bl) in
-          let ni =
-            match annot with
-                Some id ->
-                  (try list_index (Name id) names - 1
-                  with Not_found ->  Util.user_err_loc
-                      (loc,"Fixpoint",
-                       Pp.str "No argument named " ++ Nameops.pr_id id))
-              | None -> 
-                  if List.length names > 1 then
-                    Util.user_err_loc
-                      (loc,"Fixpoint",
-                       Pp.str "the recursive argument needs to be specified");
-                  0 in
-	  ((id, ni, bl, type_, def),ntn) ] ]
-  ;
-  corec_definition:
-    [ [ id = base_ident; bl = LIST0 binder_let; c = type_cstr; ":=";
-        def = lconstr ->
-          (id,bl,c ,def) ] ]
-  ;
-  rec_annotation:
-    [ [ "{"; IDENT "struct"; id=IDENT; "}" -> id_of_string id ] ]
-  ;
-  type_cstr:
-    [ [ ":"; c=lconstr -> c 
-      | -> CHole loc ] ]
-  ;
-  (* Inductive schemes *)
-  scheme:
-    [ [ id = identref; ":="; dep = dep_scheme; "for"; ind = global;
-        IDENT "Sort"; s = sort ->
-          (id,dep,ind,s) ] ]
-  ;
-  dep_scheme:
-    [ [ IDENT "Induction" -> true
-      | IDENT "Minimality" -> false ] ]
-  ;
-  (* Various Binders *)
-(*
-  (* ... without coercions *)
-  binder_nodef:
-    [ [ b = binder_let ->
-      (match b with
-          LocalRawAssum(l,ty) -> (l,ty)
-        | LocalRawDef _ ->
-            Util.user_err_loc
-              (loc,"fix_param",Pp.str"defined binder not allowed here")) ] ]
-  ;
-*)
-  (* ... with coercions *)
-  record_field:
-    [ [ id = name -> (false,AssumExpr(id,CHole loc))
-      | id = name; oc = of_type_with_opt_coercion; t = lconstr ->
-         (oc,AssumExpr (id,t))
-      | id = name; oc = of_type_with_opt_coercion;
-             t = lconstr; ":="; b = lconstr -> (oc,DefExpr (id,b,Some t))
-      | id = name; ":="; b = lconstr ->
-         match b with
-             CCast(_,b,t) -> (false,DefExpr(id,b,Some t))
-           | _ -> (false,DefExpr(id,b,None)) ] ]
-  ;
-  assum_list:
-    [ [ bl = LIST1 assum_coe -> bl | b = simple_assum_coe -> [b] ] ]
-  ;
-  assum_coe:
-    [ [ "("; a = simple_assum_coe; ")" -> a ] ]
-  ;
-  simple_assum_coe:
-    [ [ idl = LIST1 identref; oc = of_type_with_opt_coercion; c = lconstr -> 
-        (oc,(idl,c)) ] ]
-  ;
-  constructor:
-    [ [ id = identref; l = LIST0 binder_let; 
-        coe = of_type_with_opt_coercion; c = lconstr ->
-	  (coe,(id,G_constrnew.mkCProdN loc l c))
-      | id = identref; l = LIST0 binder_let ->
-	  (false,(id,G_constrnew.mkCProdN loc l (CHole loc))) ] ]
-  ;
-  of_type_with_opt_coercion:
-    [ [ ":>" -> true
-      | ":"; ">" -> true
-      | ":" -> false ] ]
-  ;
-END
-
-
-(* Modules and Sections *)
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: gallina_ext module_expr module_type;
-
-  gallina_ext:
-    [ [ (* Interactive module declaration *)
-	IDENT "Module"; id = identref; 
-	bl = LIST0 module_binder; mty_o = OPT of_module_type; 
-	mexpr_o = OPT is_module_expr ->
-	  VernacDefineModule (id, bl, mty_o, mexpr_o)
-	  
-      | IDENT "Module"; "Type"; id = identref; 
-	bl = LIST0 module_binder; mty_o = OPT is_module_type ->
-	  VernacDeclareModuleType (id, bl, mty_o)
-	  
-      | IDENT "Declare"; IDENT "Module"; id = identref; 
-	bl = LIST0 module_binder; mty_o = OPT of_module_type; 
-	mexpr_o = OPT is_module_expr ->
-	  VernacDeclareModule (id, bl, mty_o, mexpr_o)
-      (* Section beginning *)
-      | IDENT "Section"; id = identref -> VernacBeginSection id
-      | IDENT "Chapter"; id = identref -> VernacBeginSection id
-
-      (* This end a Section a Module or a Module Type *)
-      | IDENT "End"; id = identref -> VernacEndSegment id
-
-      (* Requiring an already compiled module *)
-      | IDENT "Require"; export = export_token; specif = specif_token;
-        qidl = LIST1 global ->
-          VernacRequire (export, specif, qidl)
-      | IDENT "Require"; export = export_token; specif = specif_token;
-        filename = ne_string -> 
-	  VernacRequireFrom (export, specif, filename)
-      | IDENT "Import"; qidl = LIST1 global -> VernacImport (false,qidl)
-      | IDENT "Export"; qidl = LIST1 global -> VernacImport (true,qidl) ] ]
-  ;
-  export_token:
-    [ [ IDENT "Import" -> Some false
-      | IDENT "Export" -> Some true
-      |  -> None ] ]
-  ;
-  specif_token:
-    [ [ IDENT "Implementation" -> Some false
-      | IDENT "Specification" -> Some true
-      |  -> None ] ]
-  ;
-  of_module_type:
-    [ [ ":"; mty = module_type -> (mty, true) 
-      | "<:"; mty = module_type -> (mty, false) ] ]
-  ;
-  is_module_type:
-    [ [ ":="; mty = module_type -> mty ] ]
-  ;
-  is_module_expr:
-    [ [ ":="; mexpr = module_expr -> mexpr ] ]
-  ;
-
-  (* Module binder  *)
-  module_binder:
-    [ [ "("; idl = LIST1 identref; ":"; mty = module_type; ")" ->
-          (idl,mty) ] ]
-  ;
-
-  (* Module expressions *)
-  module_expr:
-    [ [ qid = qualid -> CMEident qid
-      | me1 = module_expr; me2 = module_expr -> CMEapply (me1,me2)
-      | "("; me = module_expr; ")" -> me
-(* ... *)
-      ] ]
-  ;
-  with_declaration:
-    [ [ "Definition"; id = identref; ":="; c = Constr.lconstr ->
-          CWith_Definition (id,c)
-      | IDENT "Module"; id = identref; ":="; qid = qualid ->
-	  CWith_Module (id,qid)
-      ] ]
-  ;
-  module_type:
-    [ [ qid = qualid -> CMTEident qid
-(* ... *)
-      | mty = module_type; "with"; decl = with_declaration -> 
-	  CMTEwith (mty,decl) ] ]
-  ;
-END
-
-(* Extensions: implicits, coercions, etc. *)   
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: gallina_ext;
-
-  gallina_ext:
-    [ [ (* Transparent and Opaque *)
-        IDENT "Transparent"; l = LIST1 global -> VernacSetOpacity (false, l)
-      | IDENT "Opaque"; l = LIST1 global -> VernacSetOpacity (true, l)
-
-      (* Canonical structure *)
-      | IDENT "Canonical"; IDENT "Structure"; qid = global ->
-	  VernacCanonical qid
-      | IDENT "Canonical"; IDENT "Structure"; qid = global; d = def_body ->
-          let s = Ast.coerce_global_to_id qid in
-	  VernacDefinition 
-	    ((Global,CanonicalStructure),(dummy_loc,s),d,Recordobj.add_object_hook)
-
-      (* Coercions *)
-      | IDENT "Coercion"; qid = global; d = def_body ->
-          let s = Ast.coerce_global_to_id qid in
-	  VernacDefinition ((Global,Coercion),(dummy_loc,s),d,Class.add_coercion_hook)
-      | IDENT "Coercion"; IDENT "Local"; qid = global; d = def_body ->
-           let s = Ast.coerce_global_to_id qid in
-	  VernacDefinition ((Local,Coercion),(dummy_loc,s),d,Class.add_coercion_hook)
-      | IDENT "Identity"; IDENT "Coercion"; IDENT "Local"; f = identref;
-         ":"; s = class_rawexpr; ">->"; t = class_rawexpr -> 
-	   VernacIdentityCoercion (Local, f, s, t)
-      | IDENT "Identity"; IDENT "Coercion"; f = identref; ":";
-         s = class_rawexpr; ">->"; t = class_rawexpr -> 
-	   VernacIdentityCoercion (Global, f, s, t)
-      | IDENT "Coercion"; IDENT "Local"; qid = global; ":";
-	 s = class_rawexpr; ">->"; t = class_rawexpr -> 
-	  VernacCoercion (Local, qid, s, t)
-      | IDENT "Coercion"; qid = global; ":"; s = class_rawexpr; ">->";
-         t = class_rawexpr ->
-	  VernacCoercion (Global, qid, s, t)
-
-      (* Implicit *)
-      | IDENT "Implicit"; IDENT "Arguments"; qid = global; 
-         pos = OPT [ "["; l = LIST0 ident; "]" -> l ] ->
-	   let pos = option_app (List.map (fun id -> ExplByName id)) pos in
-	   VernacDeclareImplicits (qid,pos)
-
-      | IDENT "Implicit"; ["Type" | IDENT "Types"];
-	   idl = LIST1 identref; ":"; c = lconstr -> VernacReserve (idl,c) ] ]
-  ;
-END
-
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: command check_command class_rawexpr;
-
-  command:
-    [ [ IDENT "Comments"; l = LIST0 comment -> VernacComments l
-
-      (* System directory *)
-      | IDENT "Pwd" -> VernacChdir None
-      | IDENT "Cd" -> VernacChdir None
-      | IDENT "Cd"; dir = ne_string -> VernacChdir (Some dir)
-
-      (* Toplevel control *)
-      | IDENT "Drop" -> VernacToplevelControl Drop
-      | IDENT "ProtectedLoop" -> VernacToplevelControl ProtectedLoop
-      | IDENT "Quit" -> VernacToplevelControl Quit
-
-      | IDENT "Load"; verbosely = [ IDENT "Verbose" -> true | -> false ];
-	s = [ s = ne_string -> s | s = IDENT -> s ] ->
-	  VernacLoad (verbosely, s)
-      | 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)
-
-      | IDENT "Locate"; l = locatable -> VernacLocate l
-
-      (* Managing load paths *)
-      | IDENT "Add"; IDENT "LoadPath"; dir = ne_string; alias = as_dirpath ->
-	  VernacAddLoadPath (false, dir, alias)
-      | IDENT "Add"; IDENT "Rec"; IDENT "LoadPath"; dir = ne_string; 
-	  alias = as_dirpath -> VernacAddLoadPath (true, dir, alias)
-      | IDENT "Remove"; IDENT "LoadPath"; dir = ne_string ->
-	  VernacRemoveLoadPath dir
-
-       (* For compatibility *)
-      | IDENT "AddPath"; dir = ne_string; "as"; alias = as_dirpath ->
-	  VernacAddLoadPath (false, dir, alias)
-      | IDENT "AddRecPath"; dir = ne_string; "as"; alias = as_dirpath ->
-	  VernacAddLoadPath (true, dir, alias)
-      | IDENT "DelPath"; dir = ne_string ->
-	  VernacRemoveLoadPath dir
-
-      (* Type-Checking (pas dans le refman) *)
-      | "Type"; c = lconstr -> VernacGlobalCheck c
-
-      (* Printing (careful factorization of entries) *)
-      | IDENT "Print"; p = printable -> VernacPrint p
-      | IDENT "Print"; qid = global -> VernacPrint (PrintName qid)
-      | IDENT "Print"; IDENT "Module"; "Type"; qid = global -> 
-	  VernacPrint (PrintModuleType qid)
-      | IDENT "Print"; IDENT "Module"; qid = global -> 
-	  VernacPrint (PrintModule qid)
-      | IDENT "Inspect"; n = natural -> VernacPrint (PrintInspect n)
-      | IDENT "About"; qid = global -> VernacPrint (PrintAbout qid)
-
-      (* Searching the environment *)
-      | IDENT "Search"; qid = global; l = in_or_out_modules -> 
-	  VernacSearch (SearchHead qid, l)
-      | IDENT "SearchPattern"; c = constr_pattern; l = in_or_out_modules ->
-	  VernacSearch (SearchPattern c, l)
-      | IDENT "SearchRewrite"; c = constr_pattern; l = in_or_out_modules ->
-	  VernacSearch (SearchRewrite c, l)
-      | IDENT "SearchAbout"; 
-	  sl = [ "["; l = LIST1 [ r = global -> SearchRef r
-                                | s = ne_string -> SearchString s ]; "]" -> l 
-   		 | qid = global -> [SearchRef qid] ];
-	  l = in_or_out_modules -> 
-	  VernacSearch (SearchAbout sl, l)
-
-      | IDENT "Add"; IDENT "ML"; IDENT "Path"; dir = ne_string ->
-	  VernacAddMLPath (false, dir)
-      | IDENT "Add"; IDENT "Rec"; IDENT "ML"; IDENT "Path"; dir = ne_string ->
-	  VernacAddMLPath (true, dir)
-
-      (* Pour intervenir sur les tables de param�ètres *)
-      | "Set"; table = IDENT; field = IDENT; v = option_value ->
-  	  VernacSetOption (SecondaryTable (table,field),v)
-      | "Set"; table = IDENT; field = IDENT; lv = LIST1 option_ref_value ->
-  	  VernacAddOption (SecondaryTable (table,field),lv)
-      | "Set"; table = IDENT; field = IDENT ->
-  	  VernacSetOption (SecondaryTable (table,field),BoolValue true)
-      | IDENT "Unset"; table = IDENT; field = IDENT ->
-  	  VernacUnsetOption (SecondaryTable (table,field))
-      | IDENT "Unset"; table = IDENT; field = IDENT; lv = LIST1 option_ref_value ->
-  	  VernacRemoveOption (SecondaryTable (table,field),lv)
-      | "Set"; table = IDENT; value = option_value ->
-  	  VernacSetOption (PrimaryTable table, value)
-      | "Set"; table = IDENT ->
-  	  VernacSetOption (PrimaryTable table, BoolValue true)
-      | IDENT "Unset"; table = IDENT ->
-  	  VernacUnsetOption (PrimaryTable table)
-
-      | IDENT "Print"; IDENT "Table"; table = IDENT; field = IDENT ->
-	  VernacPrintOption (SecondaryTable (table,field))
-      | IDENT "Print"; IDENT "Table"; table = IDENT ->
-	  VernacPrintOption (PrimaryTable table)
-
-      | IDENT "Add"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
-        -> VernacAddOption (SecondaryTable (table,field), v)
-
-      (* Un value global ci-dessous va �être cach�é par un field au dessus! *)
-      | IDENT "Add"; table = IDENT; v = LIST1 option_ref_value ->
-          VernacAddOption (PrimaryTable table, v)
-
-      | IDENT "Test"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
-        -> VernacMemOption (SecondaryTable (table,field), v)
-      | IDENT "Test"; table = IDENT; field = IDENT ->
-          VernacPrintOption (SecondaryTable (table,field))
-      | IDENT "Test"; table = IDENT; v = LIST1 option_ref_value ->
-          VernacMemOption (PrimaryTable table, v)
-      | IDENT "Test"; table = IDENT ->
-          VernacPrintOption (PrimaryTable table)
-
-      | 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) ] ]
-  ;
-  check_command: (* TODO: rapprocher Eval et Check *)
-    [ [ IDENT "Eval"; r = Tactic.red_expr; "in"; c = lconstr ->
-          fun g -> VernacCheckMayEval (Some r, g, c)
-      | IDENT "Check"; c = lconstr ->
-	  fun g -> VernacCheckMayEval (None, g, c) ] ]
-  ;
-  printable:
-    [ [ IDENT "Term"; qid = global -> PrintName qid
-      | IDENT "All" -> PrintFullContext
-      | IDENT "Section"; s = global -> PrintSectionContext s
-      | IDENT "Grammar"; ent = IDENT ->
-          (* This should be in "syntax" section but is here for factorization*)
-	  PrintGrammar ("", ent)
-      | IDENT "LoadPath" -> PrintLoadPath
-      | IDENT "Modules" -> PrintModules
-
-      | IDENT "ML"; IDENT "Path" -> PrintMLLoadPath
-      | IDENT "ML"; IDENT "Modules" -> PrintMLModules
-      | IDENT "Graph" -> PrintGraph
-      | IDENT "Classes" ->  PrintClasses
-      | IDENT "Coercions" -> PrintCoercions
-      | IDENT "Coercion"; IDENT "Paths"; s = class_rawexpr; t = class_rawexpr
-         -> PrintCoercionPaths (s,t)
-      | IDENT "Tables" -> PrintTables
-(* Obsolete: was used for cooking V6.3 recipes ??
-      | IDENT "Proof"; qid = global -> PrintOpaqueName qid
-*)
-      | IDENT "Hint" -> PrintHintGoal
-      | IDENT "Hint"; qid = global -> PrintHint qid
-      | IDENT "Hint"; "*" -> PrintHintDb
-      | IDENT "HintDb"; s = IDENT -> PrintHintDbName s
-      | IDENT "Scopes" -> PrintScopes
-      | IDENT "Scope"; s = IDENT -> PrintScope s
-      | IDENT "Visibility"; s = OPT IDENT -> PrintVisibility s
-      | IDENT "Implicit"; qid = global -> PrintImplicit qid ] ]
-  ;
-  class_rawexpr:
-    [ [ IDENT "Funclass" -> FunClass
-      | IDENT "Sortclass" -> SortClass
-      | qid = global -> RefClass qid ] ]
-  ;
-  locatable:
-    [ [ qid = global -> LocateTerm qid
-      | IDENT "File"; f = ne_string -> LocateFile f
-      | IDENT "Library"; qid = global -> LocateLibrary  qid
-      | s = ne_string -> LocateNotation s ] ]
-  ;
-  option_value:
-    [ [ n  = integer   -> IntValue n
-      | s  = STRING    -> StringValue s ] ]
-  ;
-  option_ref_value:
-    [ [ id = global   -> QualidRefValue id
-      | s  = STRING   -> StringRefValue s ] ]
-  ;
-  as_dirpath:
-    [ [ d = OPT [ "as"; d = dirpath -> d ] -> d ] ]
-  ;
-  in_or_out_modules:
-    [ [ IDENT "inside"; l = LIST1 global -> SearchInside l
-      | IDENT "outside"; l = LIST1 global -> SearchOutside l
-      | -> SearchOutside [] ] ]
-  ;
-  comment:
-    [ [ c = constr -> CommentConstr c
-      | s = STRING -> CommentString s
-      | n = natural -> CommentInt n ] ]
-  ;
-END;
-
-if not !Options.v7 then
-GEXTEND Gram
-  command:
-    [ [ 
-(* State management *)
-        IDENT "Write"; IDENT "State"; s = IDENT -> VernacWriteState s
-      | IDENT "Write"; IDENT "State"; s = ne_string -> VernacWriteState s
-      | IDENT "Restore"; IDENT "State"; s = IDENT -> VernacRestoreState s
-      | IDENT "Restore"; IDENT "State"; s = ne_string -> VernacRestoreState s
-
-(* Resetting *)
-      | IDENT "Reset"; id = identref -> VernacResetName id
-      | IDENT "Reset"; IDENT "Initial" -> VernacResetInitial
-      | IDENT "Back" -> VernacBack 1
-      | IDENT "Back"; n = natural -> VernacBack n
-
-(* Tactic Debugger *)
-      |	IDENT "Debug"; IDENT "On" -> VernacDebug true
-      |	IDENT "Debug"; IDENT "Off" -> VernacDebug false
-
- ] ];
-    END
-;;
-
-(* Grammar extensions *)
-	  
-if not !Options.v7 then
-GEXTEND Gram
-  GLOBAL: syntax;
-
-  syntax:
-   [ [ IDENT "Open"; local = locality; IDENT "Scope"; sc = IDENT -> 
-         VernacOpenCloseScope (local,true,sc)
-
-     | IDENT "Close"; local = locality; IDENT "Scope"; sc = IDENT -> 
-         VernacOpenCloseScope (local,false,sc)
-
-     | IDENT "Delimit"; IDENT "Scope"; sc = IDENT; "with"; key = IDENT ->
-	 VernacDelimiters (sc,key)
-
-     | IDENT "Bind"; IDENT "Scope"; sc = IDENT; "with"; 
-       refl = LIST1 class_rawexpr -> VernacBindScope (sc,refl)
-
-     | IDENT "Arguments"; IDENT "Scope"; qid = global;
-         "["; scl = LIST0 opt_scope; "]" -> VernacArgumentsScope (qid,scl)
-
-     | IDENT "Infix"; local = locality;
-	 op = ne_string; ":="; p = global; 
-         modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
-	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
-         VernacInfix (local,(op,modl),p,None,sc)
-     | IDENT "Notation"; local = locality; id = ident; ":="; c = constr;
-	 b = [ "("; IDENT "only"; IDENT "parsing"; ")" -> true | -> false ] ->
-           VernacSyntacticDefinition (id,c,local,b)
-     | IDENT "Notation"; local = locality; s = ne_string; ":="; c = constr;
-         modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
-	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
-           VernacNotation (local,c,Some(s,modl),None,sc)
-
-     | IDENT "Tactic"; IDENT "Notation"; s = ne_string; 
-	 pil = LIST0 production_item; ":="; t = Tactic.tactic -> 
-	   VernacTacticGrammar ["",(s,pil),t]
-
-     | IDENT "Reserved"; IDENT "Notation"; local = locality; s = ne_string; 
-	 l = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ]
-	 -> VernacSyntaxExtension (local,Some(s,l),None)
-
-     (* "Print" "Grammar" should be here but is in "command" entry in order 
-        to factorize with other "Print"-based vernac entries *)
-  ] ]
-  ;
-  locality:
-    [ [ IDENT "Local" -> true | -> false ] ]
-  ;
-  level:
-    [ [ IDENT "level"; n = natural -> NumLevel n
-      | IDENT "next"; IDENT "level" -> NextLevel ] ]
-  ;
-  syntax_modifier:
-    [ [ x = IDENT; "at"; lev = level -> SetItemLevel ([x],lev)
-      | x = IDENT; ","; l = LIST1 IDENT SEP ","; "at"; 
-        lev = level -> SetItemLevel (x::l,lev)
-      | "at"; IDENT "level"; n = natural -> SetLevel n
-      | IDENT "left"; IDENT "associativity" -> SetAssoc Gramext.LeftA
-      | IDENT "right"; IDENT "associativity" -> SetAssoc Gramext.RightA
-      | IDENT "no"; IDENT "associativity" -> SetAssoc Gramext.NonA
-      | x = IDENT; typ = syntax_extension_type -> SetEntryType (x,typ)
-      | IDENT "only"; IDENT "parsing" -> SetOnlyParsing
-      | IDENT "format"; s = [s = STRING -> (loc,s)] -> SetFormat s ] ]
-  ;
-  syntax_extension_type:
-    [ [ IDENT "ident" -> ETIdent | IDENT "global" -> ETReference
-      | IDENT "bigint" -> ETBigint
-    ] ]
-  ;
-  opt_scope:
-    [ [ "_" -> None | sc = IDENT -> Some sc ] ]
-  ;
-  production_item:
-    [[ s = ne_string -> VTerm s
-     | nt = IDENT; po = OPT [ "("; p = ident; ")" -> p ] ->
-	 VNonTerm (loc,NtShort nt,po) ]]
-  ;
-END
-
-(* Reinstall tactic and vernac extensions *)
-let _ = 
-  if not !Options.v7 then
-    Egrammar.reset_extend_grammars_v8()
diff --git a/parsing/g_xml.ml4 b/parsing/g_xml.ml4
new file mode 100644
index 00000000..b4580750
--- /dev/null
+++ b/parsing/g_xml.ml4
@@ -0,0 +1,247 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: g_xml.ml4 8624 2006-03-13 17:38:17Z msozeau $ *)
+
+open Pp
+open Util
+open Names
+open Term
+open Pcoq
+open Rawterm
+open Genarg
+open Tacexpr
+open Libnames
+
+open Nametab
+
+(* Generic xml parser without raw data *)
+
+type attribute = string * (loc * string)
+type xml = XmlTag of loc * string * attribute list * xml list
+
+let check_tags loc otag ctag =
+  if otag <> ctag then
+    user_err_loc (loc,"",str "closing xml tag " ++ str ctag ++ 
+      str "does not match open xml tag " ++ str otag)
+
+let xml_eoi = (Gram.Entry.create "xml_eoi" : xml Gram.Entry.e)
+
+GEXTEND Gram
+  GLOBAL: xml_eoi;
+
+  xml_eoi:
+    [ [ x = xml; EOI -> x ] ]
+  ;
+  xml:
+    [ [ "<"; otag = IDENT; attrs = LIST0 attr; ">"; l = LIST1 xml;
+        "<"; "/"; ctag = IDENT; ">"  ->
+	  check_tags loc otag ctag;
+	  XmlTag (loc,ctag,attrs,l)
+      | "<"; tag = IDENT; attrs = LIST0 attr; "/"; ">" ->
+	  XmlTag (loc,tag,attrs,[])
+    ] ]
+  ;
+  attr:
+    [ [ name = IDENT; "="; data = STRING -> (name, (loc, data)) ] ]
+  ;
+END
+
+(* Interpreting attributes *)
+
+let nmtoken (loc,a) =
+  try int_of_string a
+  with Failure _ -> user_err_loc (loc,"",str "nmtoken expected")
+  
+let interp_xml_attr_qualid = function
+  | "uri", s -> qualid_of_string s
+  | _ -> error "Ill-formed xml attribute"
+
+let get_xml_attr s al = 
+  try List.assoc s al
+  with Not_found -> error ("No attribute "^s)
+
+(* Interpreting specific attributes *)
+
+let ident_of_cdata (loc,a) = id_of_string a
+
+let uri_of_data s =
+  let n = String.index s ':' in
+  let p = String.index s '.' in
+  let s = String.sub s (n+2) (p-n-2) in
+  for i=0 to String.length s - 1 do if s.[i]='/' then s.[i]<-'.' done;
+  qualid_of_string s
+
+let constant_of_cdata (loc,a) = Nametab.locate_constant (uri_of_data a)
+
+let global_of_cdata (loc,a) = Nametab.locate (uri_of_data a)
+
+let inductive_of_cdata a = match global_of_cdata a with
+    | IndRef (kn,_) -> kn
+    | _ -> failwith "kn"
+
+let ltacref_of_cdata (loc,a) = (loc,locate_tactic (uri_of_data a))
+
+let sort_of_cdata (loc,a) = match a with
+  | "Prop" -> RProp Null
+  | "Set" -> RProp Pos
+  | "Type" -> RType None
+  | _ -> user_err_loc (loc,"",str "sort expected")
+
+let get_xml_sort al = sort_of_cdata (get_xml_attr "value" al)
+
+let get_xml_inductive_kn al = inductive_of_cdata (get_xml_attr "uri" al)
+
+let get_xml_constant al = constant_of_cdata (get_xml_attr "uri" al)
+
+let get_xml_inductive al =
+  (get_xml_inductive_kn al, nmtoken (get_xml_attr "noType" al))
+
+let get_xml_constructor al =
+  (get_xml_inductive al, nmtoken (get_xml_attr "noConstr" al))
+
+let get_xml_name al =
+  try Name (ident_of_cdata (List.assoc "binder" al))
+  with Not_found -> Anonymous
+
+let get_xml_ident al = ident_of_cdata (get_xml_attr "binder" al)
+
+let get_xml_noFun al = nmtoken (get_xml_attr "noFun" al)
+
+(* Interpreting constr as a rawconstr *)
+
+let rec interp_xml_constr = function
+  | XmlTag (loc,"REL",al,[]) ->
+      RVar (loc, get_xml_ident al)
+  | XmlTag (loc,"VAR",al,[]) -> failwith ""
+  | XmlTag (loc,"LAMBDA",al,[x1;x2]) ->
+      let na,t = interp_xml_decl x1 in
+      RLambda (loc, na, t, interp_xml_target x2)
+  | XmlTag (loc,"PROD",al,[x1;x2]) ->
+      let na,t = interp_xml_decl x1 in
+      RProd (loc, na, t, interp_xml_target x2)
+  | XmlTag (loc,"LETIN",al,[x1;x2]) ->
+      let na,t = interp_xml_def x1 in
+      RLetIn (loc, na, t, interp_xml_target x2) 
+  | XmlTag (loc,"APPLY",_,x::xl) ->
+      RApp (loc, interp_xml_constr x, List.map interp_xml_constr xl)
+  | XmlTag (loc,"META",al,xl) ->
+      failwith "META: TODO"
+  | XmlTag (loc,"CONST",al,[]) ->
+      RRef (loc, ConstRef (get_xml_constant al))
+  | XmlTag (loc,"MUTCASE",al,x::y::yl) -> (* BUGGE *)
+      failwith "XML MUTCASE TO DO";
+(*
+      ROrderedCase (loc,RegularStyle,Some (interp_xml_patternsType x),
+      interp_xml_inductiveTerm y,
+      Array.of_list (List.map interp_xml_pattern yl),
+      ref None)
+*)
+  | XmlTag (loc,"MUTIND",al,[]) ->
+      RRef (loc, IndRef (get_xml_inductive al))
+  | XmlTag (loc,"MUTCONSTRUCT",al,[]) ->
+      RRef (loc, ConstructRef (get_xml_constructor al))
+  | XmlTag (loc,"FIX",al,xl) ->
+      let li,lnct = List.split (List.map interp_xml_FixFunction xl) in
+      let ln,lc,lt = list_split3 lnct in
+      RRec (loc, RFix (Array.of_list li, get_xml_noFun al), Array.of_list ln, [||], Array.of_list lc, Array.of_list lt)
+  | XmlTag (loc,"COFIX",al,xl) ->
+      let ln,lc,lt = list_split3 (List.map interp_xml_CoFixFunction xl) in
+      RRec (loc, RCoFix (get_xml_noFun al), Array.of_list ln, [||], Array.of_list lc, Array.of_list lt)
+  | XmlTag (loc,"CAST",al,[x1;x2]) ->
+      RCast (loc, interp_xml_term x1, DEFAULTcast, interp_xml_type x2)
+  | XmlTag (loc,"SORT",al,[]) ->
+      RSort (loc, get_xml_sort al)
+  | XmlTag (loc,s,_,_) -> user_err_loc (loc,"", str "Unexpected tag " ++ str s)
+
+and interp_xml_tag s = function
+  | XmlTag (loc,tag,al,xl) when tag=s -> (loc,al,xl)
+  | XmlTag (loc,tag,_,_) -> user_err_loc (loc, "", 
+    str "Expect tag " ++ str s ++ str " but find " ++ str s)
+
+and interp_xml_constr_alias s x =
+  match interp_xml_tag s x with
+    | (_,_,[x]) -> interp_xml_constr x
+    | (loc,_,_) -> 
+        user_err_loc (loc,"",str "wrong number of arguments (expect one)")
+
+and interp_xml_term x = interp_xml_constr_alias "term" x
+and interp_xml_type x = interp_xml_constr_alias "type" x
+and interp_xml_target x = interp_xml_constr_alias "target" x
+and interp_xml_body x = interp_xml_constr_alias "body" x
+and interp_xml_pattern x = interp_xml_constr_alias "pattern" x
+and interp_xml_patternsType x = interp_xml_constr_alias "patternsType" x
+and interp_xml_inductiveTerm x = interp_xml_constr_alias "inductiveTerm" x
+
+and interp_xml_decl_alias s x =
+  match interp_xml_tag s x with
+    | (_,al,[x]) -> (get_xml_name al, interp_xml_constr x)
+    | (loc,_,_) -> 
+        user_err_loc (loc,"",str "wrong number of arguments (expect one)")
+
+and interp_xml_def x = interp_xml_decl_alias "def" x
+and interp_xml_decl x = interp_xml_decl_alias "decl" x
+
+and interp_xml_recursionOrder x =
+  let (loc, al, l) = interp_xml_tag "RecursionOrder" x in
+  let (locs, s) = get_xml_attr "type" al in
+    match s with
+	"Structural" -> 
+	  (match l with [] -> RStructRec
+	     | _ -> user_err_loc (loc, "", str "wrong number of arguments (expected none)"))
+      | "WellFounded" -> 
+	  (match l with
+	       [c] -> RWfRec (interp_xml_type c)
+	     | _ -> user_err_loc (loc, "", str "wrong number of arguments (expected one)"))
+      | _ ->
+          user_err_loc (locs,"",str "invalid recursion order")
+
+
+and interp_xml_FixFunction x =
+  match interp_xml_tag "FixFunction" x with
+  | (loc,al,[x1;x2;x3]) ->
+      ((nmtoken (get_xml_attr "recIndex" al),
+	interp_xml_recursionOrder x1),
+       (get_xml_ident al, interp_xml_type x2, interp_xml_body x3))
+  | (loc,al,[x1;x2]) -> (* For backwards compatibility *)
+      ((nmtoken (get_xml_attr "recIndex" al), RStructRec),
+       (get_xml_ident al, interp_xml_type x1, interp_xml_body x2))
+  | (loc,_,_) -> 
+        user_err_loc (loc,"",str "wrong number of arguments (expect one)")
+
+and interp_xml_CoFixFunction x =
+  match interp_xml_tag "CoFixFunction" x with
+  | (loc,al,[x1;x2]) ->
+      (get_xml_ident al, interp_xml_type x1, interp_xml_body x2)
+    | (loc,_,_) -> 
+        user_err_loc (loc,"",str "wrong number of arguments (expect one)")
+
+(* Interpreting tactic argument *)
+
+let rec (interp_xml_tactic_expr : xml -> glob_tactic_expr) = function
+  | XmlTag (loc,"TACARG",[],[x]) ->
+      TacArg (interp_xml_tactic_arg x)
+  | _ -> error "Ill-formed xml tree"
+
+and interp_xml_tactic_arg = function
+  | XmlTag (loc,"TERM",[],[x]) ->
+      ConstrMayEval (ConstrTerm (interp_xml_constr x,None))
+  | XmlTag (loc,"CALL",al,xl) ->
+      let ltacref = ltacref_of_cdata (get_xml_attr "uri" al) in
+      TacCall(loc,ArgArg ltacref,List.map interp_xml_tactic_arg xl)
+(*
+  | XmlTag (loc,"TACTIC",[],[x]) ->
+      Tacexp (interp_xml_tactic_expr x)
+  | _ -> error "Ill-formed xml tree"
+*)
+  | XmlTag (loc,s,_,_) -> user_err_loc (loc,"", str "Unexpected tag " ++ str s)
+
+let parse_tactic_arg ch =
+  interp_xml_tactic_arg
+    (Pcoq.Gram.Entry.parse xml_eoi
+        (Pcoq.Gram.parsable (Stream.of_channel ch)))
diff --git a/parsing/g_zsyntax.ml b/parsing/g_zsyntax.ml
index 2d8d2ddd..554040d1 100644
--- a/parsing/g_zsyntax.ml
+++ b/parsing/g_zsyntax.ml
@@ -6,148 +6,18 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_zsyntax.ml,v 1.16.2.2 2004/11/10 13:00:44 herbelin Exp $ *)
+(* $Id: g_zsyntax.ml 7988 2006-02-04 20:28:29Z herbelin $ *)
 
-open Coqast
 open Pcoq
 open Pp
 open Util
 open Names
-open Ast
-open Extend
 open Topconstr
 open Libnames
-open Bignat
-
-(**********************************************************************)
-(* V7 parsing via Grammar *)
-
-let get_z_sign loc =
-  let mkid id =
-    mkRefC (Qualid (loc,Libnames.make_short_qualid id))
-  in
-  ((mkid (id_of_string "xI"),
-    mkid (id_of_string "xO"),
-    mkid (id_of_string "xH")),
-   (mkid (id_of_string "ZERO"), 
-    mkid (id_of_string "POS"),
-    mkid (id_of_string "NEG")))
-
-let pos_of_bignat xI xO xH x =
-  let rec pos_of x =
-    match div2_with_rest x with
-      | (q, true) when is_nonzero q -> mkAppC (xI, [pos_of q])
-      | (q, false) -> mkAppC (xO, [pos_of q])
-      | (_, true) -> xH
-  in 
-  pos_of x
-    
-let z_of_string pos_or_neg s dloc = 
-  let ((xI,xO,xH),(aZERO,aPOS,aNEG)) = get_z_sign dloc in
-  let v = Bignat.of_string s in
-  if is_nonzero v then
-    if pos_or_neg then
-      mkAppC (aPOS, [pos_of_bignat xI xO xH v])
-    else 
-      mkAppC (aNEG, [pos_of_bignat xI xO xH v])
-  else 
-    aZERO
-
-(* Declare the primitive parser with Grammar and without the scope mechanism *)
-let zsyntax_create name =
-  let e =
-    Pcoq.create_constr_entry (Pcoq.get_univ "znatural") name in
-  Pcoq.Gram.Unsafe.clear_entry e;
-  e
-
-let number = zsyntax_create "number" 
-
-let negnumber = zsyntax_create "negnumber"
- 
-let _ =
-  Gram.extend number None
-    [None, None,
-     [[Gramext.Stoken ("INT", "")],
-      Gramext.action (z_of_string true)]]
-    
-let _ =
-  Gram.extend negnumber None
-    [None, None,
-     [[Gramext.Stoken ("INT", "")],
-      Gramext.action (z_of_string false)]]
-
-(**********************************************************************)
-(* Old v7 ast printing *)
-
-open Coqlib
+open Bigint
 
 exception Non_closed_number
 
-let get_z_sign_ast loc =
-  let ast_of_id id = 
-    Termast.ast_of_ref
-      (reference_of_constr
-	(gen_constant_in_modules "Z-printer" zarith_base_modules id))
-  in
-  ((ast_of_id "xI",
-    ast_of_id "xO",
-    ast_of_id "xH"),
-   (ast_of_id "ZERO", 
-    ast_of_id "POS",
-    ast_of_id "NEG"))
-
-let _ = if !Options.v7 then
-let rec bignat_of_pos c1 c2 c3 p =
-  match p with
-    | Node (_,"APPLIST", [b; a]) when alpha_eq(b,c1) ->
-        mult_2 (bignat_of_pos c1 c2 c3 a)
-    | Node (_,"APPLIST", [b; a]) when alpha_eq(b,c2) ->
-        add_1 (mult_2 (bignat_of_pos c1 c2 c3 a))
-    | a when alpha_eq(a,c3) -> Bignat.one
-    | _ -> raise Non_closed_number
-in
-let bignat_option_of_pos xI xO xH p =
-  try 
-    Some (bignat_of_pos xO xI xH p)
-  with Non_closed_number -> 
-    None
-in
-let pr_pos a = hov 0 (str "POS" ++ brk (1,1) ++ a) in
-let pr_neg a = hov 0 (str "NEG" ++ brk (1,1) ++ a) in
-
-let inside_printer posneg std_pr p =
-  let ((xI,xO,xH),_) = get_z_sign_ast dummy_loc in
-  match (bignat_option_of_pos xI xO xH p) with
-    | Some n -> 
-	if posneg then 
-	  (str (Bignat.to_string n))
-	else 
-	  (str "(-" ++ str (Bignat.to_string n) ++ str ")")
-    | None -> 
-	let pr = if posneg then pr_pos else pr_neg in
-	str "(" ++ pr (std_pr (ope("ZEXPR",[p]))) ++ str ")"
-in
-let outside_zero_printer std_pr p = str "`0`"
-in
-let outside_printer posneg std_pr p =
-  let ((xI,xO,xH),_) = get_z_sign_ast dummy_loc in
-  match (bignat_option_of_pos xI xO xH p) with
-    | Some n -> 
-	if posneg then 
-	  (str "`" ++ str (Bignat.to_string n) ++ str "`")
-	else 
-	  (str "`-" ++ str (Bignat.to_string n) ++ str "`")
-      | None -> 
-	  let pr = if posneg then pr_pos else pr_neg in
-	  str "(" ++ pr (std_pr p) ++ str ")"
-in
-(* For printing with Syntax and without the scope mechanism *)
-let _ = Esyntax.Ppprim.add ("positive_printer", (outside_printer true)) in
-let _ = Esyntax.Ppprim.add ("negative_printer", (outside_printer false)) in
-let _ = Esyntax.Ppprim.add ("positive_printer_inside", (inside_printer true))in
-let _ = Esyntax.Ppprim.add ("negative_printer_inside", (inside_printer false))
-in ()
-
 (**********************************************************************)
 (* Parsing positive via scopes                                        *)
 (**********************************************************************)
@@ -156,16 +26,19 @@ open Libnames
 open Rawterm
 let make_dir l = make_dirpath (List.map id_of_string (List.rev l))
 let positive_module = ["Coq";"NArith";"BinPos"]
+let make_path dir id = Libnames.make_path (make_dir dir) (id_of_string id)
+
+let positive_path = make_path positive_module "positive"
 
 (* TODO: temporary hack *)
-let make_path dir id = Libnames.encode_kn dir id
-
-let positive_path = 
-  make_path (make_dir positive_module) (id_of_string "positive")
-let glob_positive = IndRef (positive_path,0)
-let path_of_xI = ((positive_path,0),1)
-let path_of_xO = ((positive_path,0),2)
-let path_of_xH = ((positive_path,0),3)
+let make_kn dir id = Libnames.encode_kn dir id
+
+let positive_kn = 
+  make_kn (make_dir positive_module) (id_of_string "positive")
+let glob_positive = IndRef (positive_kn,0)
+let path_of_xI = ((positive_kn,0),1)
+let path_of_xO = ((positive_kn,0),2)
+let path_of_xH = ((positive_kn,0),3)
 let glob_xI = ConstructRef path_of_xI
 let glob_xO = ConstructRef path_of_xO
 let glob_xH = ConstructRef path_of_xH
@@ -177,34 +50,18 @@ let pos_of_bignat dloc x =
   let rec pos_of x =
     match div2_with_rest x with
       | (q,false) -> RApp (dloc, ref_xO,[pos_of q])
-      | (q,true) when is_nonzero q -> RApp (dloc,ref_xI,[pos_of q])
+      | (q,true) when q <> zero -> RApp (dloc,ref_xI,[pos_of q])
       | (q,true) -> ref_xH
   in 
   pos_of x
 
-let interp_positive dloc = function
-  | POS n when is_nonzero n -> pos_of_bignat dloc n
-  | _ ->
-      user_err_loc (dloc, "interp_positive",
-        str "Only strictly positive numbers in type \"positive\"!")
-
-let rec pat_pos_of_bignat dloc x name =
-  match div2_with_rest x with
-    | (q,false) -> 
-        PatCstr (dloc,path_of_xO,[pat_pos_of_bignat dloc q Anonymous],name)
-    | (q,true) when is_nonzero q -> 
-        PatCstr (dloc,path_of_xI,[pat_pos_of_bignat dloc q Anonymous],name)
-    | (q,true) ->
-        PatCstr (dloc,path_of_xH,[],name)
-
 let error_non_positive dloc = 
   user_err_loc (dloc, "interp_positive",
-    str "No non-positive numbers in type \"positive\"!")
+    str "Only strictly positive numbers in type \"positive\"")
 
-let pat_interp_positive dloc = function
-  | NEG n -> error_non_positive dloc
-  | POS n ->
-     if is_nonzero n then pat_pos_of_bignat dloc n else error_non_positive dloc
+let interp_positive dloc n =
+  if is_strictly_pos n then pos_of_bignat dloc n
+  else error_non_positive dloc
 
 (**********************************************************************)
 (* Printing positive via scopes                                       *)
@@ -213,12 +70,12 @@ let pat_interp_positive dloc = function
 let rec bignat_of_pos = function
   | RApp (_, RRef (_,b),[a]) when b = glob_xO -> mult_2(bignat_of_pos a)
   | RApp (_, RRef (_,b),[a]) when b = glob_xI -> add_1(mult_2(bignat_of_pos a))
-  | RRef (_, a) when a = glob_xH -> Bignat.one
+  | RRef (_, a) when a = glob_xH -> Bigint.one
   | _ -> raise Non_closed_number
 
 let uninterp_positive p =
   try 
-    Some (POS (bignat_of_pos p))
+    Some (bignat_of_pos p)
   with Non_closed_number -> 
     None
 
@@ -226,61 +83,49 @@ let uninterp_positive p =
 (* Declaring interpreters and uninterpreters for positive *)
 (************************************************************************)
 
-let _ = Symbols.declare_numeral_interpreter "positive_scope"
-  (glob_positive,positive_module)
-  (interp_positive,Some pat_interp_positive)
-  ([RRef (dummy_loc, glob_xI); 
+let _ = Notation.declare_numeral_interpreter "positive_scope"
+  (positive_path,positive_module)
+  interp_positive
+  ([RRef (dummy_loc, glob_xI);
     RRef (dummy_loc, glob_xO); 
     RRef (dummy_loc, glob_xH)],
    uninterp_positive,
-   None)
+   true)
 
 (**********************************************************************)
 (* Parsing N via scopes                                               *)
 (**********************************************************************)
 
 let binnat_module = ["Coq";"NArith";"BinNat"]
-let n_path = make_path (make_dir binnat_module)
-  (id_of_string (if !Options.v7 then "entier" else "N"))
-let glob_n = IndRef (n_path,0)
-let path_of_N0 = ((n_path,0),1)
-let path_of_Npos = ((n_path,0),2)
+let n_kn = make_kn (make_dir binnat_module) (id_of_string "N")
+let glob_n = IndRef (n_kn,0)
+let path_of_N0 = ((n_kn,0),1)
+let path_of_Npos = ((n_kn,0),2)
 let glob_N0 = ConstructRef path_of_N0
 let glob_Npos = ConstructRef path_of_Npos
 
-let n_of_posint dloc pos_or_neg n = 
-  if is_nonzero n then
+let n_path = make_path binnat_module "N"
+
+let n_of_binnat dloc pos_or_neg n = 
+  if n <> zero then
     RApp(dloc, RRef (dloc,glob_Npos), [pos_of_bignat dloc n])
   else 
     RRef (dloc, glob_N0)
 
-let n_of_int dloc n =
-  match n with
-  | POS n -> n_of_posint dloc true n 
-  | NEG n -> 
-      user_err_loc (dloc, "",
-        str "No negative number in type N")
-
-let pat_n_of_binnat dloc n name = 
-  if is_nonzero n then
-    PatCstr (dloc, path_of_Npos, [pat_pos_of_bignat dloc n Anonymous], name)
-  else 
-    PatCstr (dloc, path_of_N0, [], name)
+let error_negative dloc =
+  user_err_loc (dloc, "interp_N", str "No negative numbers in type \"N\"")
 
-let pat_n_of_int dloc n name =
-  match n with
-  | POS n -> pat_n_of_binnat dloc n name
-  | NEG n ->
-      user_err_loc (dloc, "",
-        str "No negative number in type N")
+let n_of_int dloc n =
+  if is_pos_or_zero n then n_of_binnat dloc true n
+  else error_negative dloc
 
 (**********************************************************************)
 (* Printing N via scopes                                              *)
 (**********************************************************************)
 
 let bignat_of_n = function
-  | RApp (_, RRef (_,b),[a]) when b = glob_Npos -> POS (bignat_of_pos a)
-  | RRef (_, a) when a = glob_N0 -> POS (Bignat.zero)
+  | RApp (_, RRef (_,b),[a]) when b = glob_Npos -> bignat_of_pos a
+  | RRef (_, a) when a = glob_N0 -> Bigint.zero
   | _ -> raise Non_closed_number
 
 let uninterp_n p =
@@ -290,60 +135,45 @@ let uninterp_n p =
 (************************************************************************)
 (* Declaring interpreters and uninterpreters for N *)
 
-let _ = Symbols.declare_numeral_interpreter "N_scope"
-  (glob_n,binnat_module)
-  (n_of_int,Some pat_n_of_int)
+let _ = Notation.declare_numeral_interpreter "N_scope"
+  (n_path,binnat_module)
+  n_of_int
   ([RRef (dummy_loc, glob_N0); 
     RRef (dummy_loc, glob_Npos)],
   uninterp_n,
-  None)
+  true)
    
 (**********************************************************************)
 (* Parsing Z via scopes                                               *)
 (**********************************************************************)
 
-let fast_integer_module = ["Coq";"ZArith";"BinInt"]
-let z_path = make_path (make_dir fast_integer_module) (id_of_string "Z")
-let glob_z = IndRef (z_path,0)
-let path_of_ZERO = ((z_path,0),1)
-let path_of_POS = ((z_path,0),2)
-let path_of_NEG = ((z_path,0),3)
+let binint_module = ["Coq";"ZArith";"BinInt"]
+let z_path = make_path binint_module "Z"
+let z_kn = make_kn (make_dir binint_module) (id_of_string "Z")
+let glob_z = IndRef (z_kn,0)
+let path_of_ZERO = ((z_kn,0),1)
+let path_of_POS = ((z_kn,0),2)
+let path_of_NEG = ((z_kn,0),3)
 let glob_ZERO = ConstructRef path_of_ZERO
 let glob_POS = ConstructRef path_of_POS
 let glob_NEG = ConstructRef path_of_NEG
 
-let z_of_posint dloc pos_or_neg n = 
-  if is_nonzero n then
-    let sgn = if pos_or_neg then glob_POS else glob_NEG in
+let z_of_int dloc n = 
+  if n <> zero then
+    let sgn, n =
+      if is_pos_or_zero n then glob_POS, n else glob_NEG, Bigint.neg n in
     RApp(dloc, RRef (dloc,sgn), [pos_of_bignat dloc n])
   else 
     RRef (dloc, glob_ZERO)
 
-let z_of_int dloc z =
-  match z with
-  | POS n -> z_of_posint dloc true n 
-  | NEG n -> z_of_posint dloc false n 
-
-let pat_z_of_posint dloc pos_or_neg n name = 
-  if is_nonzero n then
-    let sgn = if pos_or_neg then path_of_POS else path_of_NEG in
-    PatCstr (dloc, sgn, [pat_pos_of_bignat dloc n Anonymous], name)
-  else 
-    PatCstr (dloc, path_of_ZERO, [], name)
-
-let pat_z_of_int dloc n name =
-  match n with
-  | POS n -> pat_z_of_posint dloc true n name
-  | NEG n -> pat_z_of_posint dloc false n name
-
 (**********************************************************************)
 (* Printing Z via scopes                                              *)
 (**********************************************************************)
 
 let bigint_of_z = function
-  | RApp (_, RRef (_,b),[a]) when b = glob_POS -> POS (bignat_of_pos a)
-  | RApp (_, RRef (_,b),[a]) when b = glob_NEG -> NEG (bignat_of_pos a)
-  | RRef (_, a) when a = glob_ZERO -> POS (Bignat.zero)
+  | RApp (_, RRef (_,b),[a]) when b = glob_POS -> bignat_of_pos a
+  | RApp (_, RRef (_,b),[a]) when b = glob_NEG -> Bigint.neg (bignat_of_pos a)
+  | RRef (_, a) when a = glob_ZERO -> Bigint.zero
   | _ -> raise Non_closed_number
 
 let uninterp_z p =
@@ -354,56 +184,11 @@ let uninterp_z p =
 (************************************************************************)
 (* Declaring interpreters and uninterpreters for Z *)
 
-let _ = Symbols.declare_numeral_interpreter "Z_scope"
-  (glob_z,fast_integer_module)
-  (z_of_int,Some pat_z_of_int)
+let _ = Notation.declare_numeral_interpreter "Z_scope"
+  (z_path,binint_module)
+  z_of_int
   ([RRef (dummy_loc, glob_ZERO); 
     RRef (dummy_loc, glob_POS); 
     RRef (dummy_loc, glob_NEG)],
   uninterp_z,
-  None)
-   
-(************************************************************************)
-(* Old V7 ast Printers *)
-
-open Esyntax
-
-let _ = if !Options.v7 then
-let bignat_of_pos p =
-  let ((xI,xO,xH),_) = get_z_sign_ast dummy_loc in
-  let c1 = xO in
-  let c2 = xI in
-  let c3 = xH in
-  let rec transl = function
-    | Node (_,"APPLIST",[b; a]) when alpha_eq(b,c1) -> mult_2(transl a)
-    | Node (_,"APPLIST",[b; a]) when alpha_eq(b,c2) -> add_1(mult_2(transl a))
-    | a when alpha_eq(a,c3) -> Bignat.one
-    | _ -> raise Non_closed_number
-  in transl p
-in
-let bignat_option_of_pos p =
-  try 
-    Some (bignat_of_pos p)
-  with Non_closed_number -> 
-    None
-in
-let z_printer posneg p =
-  match bignat_option_of_pos p with
-    | Some n -> 
-	if posneg then 
-	  Some (str (Bignat.to_string n))
-	else 
-	  Some (str "-" ++ str (Bignat.to_string n))
-    | None -> None
-in
-let z_printer_ZERO _ =
-  Some (int 0)
-in
-(* Declare pretty-printers for integers *)
-let _ =
-  declare_primitive_printer "z_printer_POS" "Z_scope" (z_printer true) in
-let _ =
-  declare_primitive_printer "z_printer_NEG" "Z_scope" (z_printer false) in
-let _ =
-  declare_primitive_printer "z_printer_ZERO" "Z_scope" z_printer_ZERO in
-()
+  true)
diff --git a/parsing/g_zsyntax.mli b/parsing/g_zsyntax.mli
index 6a7aeb14..11e0b6ac 100644
--- a/parsing/g_zsyntax.mli
+++ b/parsing/g_zsyntax.mli
@@ -6,6 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: g_zsyntax.mli,v 1.6.6.1 2004/07/16 19:30:39 herbelin Exp $ i*)
+(*i $Id: g_zsyntax.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Nice syntax for integers. *)
diff --git a/parsing/g_zsyntaxnew.mli b/parsing/g_zsyntaxnew.mli
index 51bb6d41..5168722e 100644
--- a/parsing/g_zsyntaxnew.mli
+++ b/parsing/g_zsyntaxnew.mli
@@ -6,6 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: g_zsyntaxnew.mli,v 1.1.2.1 2004/07/16 19:30:39 herbelin Exp $ i*)
+(*i $Id: g_zsyntaxnew.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Nice syntax for integers. *)
diff --git a/parsing/lexer.ml4 b/parsing/lexer.ml4
index bf5f3bfe..6119b86e 100644
--- a/parsing/lexer.ml4
+++ b/parsing/lexer.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: lexer.ml4,v 1.24.2.6 2004/07/16 20:51:12 herbelin Exp $ i*)
+(*i $Id: lexer.ml4 7870 2006-01-15 20:29:09Z herbelin $ i*)
 
 open Pp
 open Token
@@ -82,23 +82,22 @@ let check_ident str =
   let rec loop_id = parser
     | [< ' ('$' | 'a'..'z' | 'A'..'Z' | '0'..'9' | ''' | '_'); s >] ->
         loop_id s
-    (* Greek utf-8 letters [CE80-CEBF and CF80-CFBF] (CE=206; BF=191) *)
-    | [< ' ('\206' | '\207'); ' ('\128'..'\191'); s >] -> loop_id s
-    | [< ''\226'; 'c2; 'c3; s >] ->
+    (* utf-8 Greek letters U0380-03FF *)
+    | [< ' ('\xCE' | '\xCF'); ' ('\x80'..'\xBF'); s >] -> loop_id s
+    | [< ''\xE2'; 'c2; 'c3; s >] ->
 	  (match c2, c3 with
-	      (* utf8 letter-like unicode 2100-214F *) 
-	    | (('\132', '\128'..'\191') | ('\133', '\128'..'\143')) ->
+	      (* utf-8 letter-like U2100-214F *)
+	    | ( ('\x84', '\x80'..'\xBF')
+	      | ('\x85', '\x80'..'\x8F')
+	      (* utf-8 subscript U2080-2089 *) 
+	      | ('\x82', '\x80'..'\x89')) ->
                 loop_id s 
-		(* utf8 symbols (see [parse_226_tail]) *)
-	    | (('\134'..'\143' | '\152'..'\155' | '\159'
-               | '\164'..'\171'),_) ->
+	      (* utf-8 symbols (see [parse_226_tail]) *)
+	    | (('\x86'..'\x8F' | '\x94'..'\x9B'
+               | '\xA4'..'\xA5' | '\xA8'..'\xAB'),_) ->
 		bad_token str
-	    | _ -> (* default to iso 8859-1 "â" *)
-		if !Options.v7 then loop_id [< 'c2; 'c3; s >]
-                else bad_token str)
-	(* iso 8859-1 accentuated letters *)
-    | [< ' ('\192'..'\214' | '\216'..'\246' | '\248'..'\255'); s >] ->
-        if !Options.v7 then loop_id s else bad_token str
+	    | _ -> 
+		bad_token str)
     | [< _ = Stream.empty >] -> ()
     | [< >] -> bad_token str
   in
@@ -170,27 +169,26 @@ let get_buff len = String.sub !buff 0 len
 
 (* The classical lexer: idents, numbers, quoted strings, comments *)
 
-let rec ident_tail len strm =
-  if !Options.v7 then
-    match strm with parser
-      | [< ' ('a'..'z' | 'A'..'Z' | '0'..'9' | ''' | '_' | '@' as c); s >] ->
-          ident_tail (store len c) s
-      (* Greek utf-8 letters [CE80-CEBF and CF80-CFBF] (CE=206; BF=191) *)
-      | [< ' ('\206' | '\207' as c1); ' ('\128'..'\191' as c2) ; s >] ->
-          ident_tail (store (store len c1) c2) s
-      (* iso 8859-1 accentuated letters *)
-      | [< ' ('\192'..'\214' | '\216'..'\246' | '\248'..'\255' as c); s >] -> 
-          ident_tail (store len c) s
-      | [< >] -> len
-  else
-    match strm with parser
-      | [< ' ('a'..'z' | 'A'..'Z' | '0'..'9' | ''' | '_' as c); s >] ->
-          ident_tail (store len c) s
-      (* Greek utf-8 letters [CE80-CEBF and CF80-CFBF] (CE=206; BF=191) *)
-      | [< ' ('\206' | '\207' as c1); ' ('\128'..'\191' as c2) ; s >] ->
-          ident_tail (store (store len c1) c2) s
-      | [< >] -> len
-
+let rec ident_tail len = parser
+  | [< ' ('a'..'z' | 'A'..'Z' | '0'..'9' | ''' | '_' as c); s >] ->
+      ident_tail (store len c) s
+  (* utf-8 Greek letters U0380-03FF *)
+  | [< ' ('\xCE' | '\xCF' as c1); ' ('\x80'..'\xBF' as c2) ; s >] ->
+      ident_tail (store (store len c1) c2) s
+  | [< s >] ->
+      match Stream.peek s with
+      | Some '\xE2' -> 
+	  (match List.tl (Stream.npeek 3 s) with
+	    (* utf-8 subscript U2080-2089 *) 
+	  | ['\x82' as c2; ('\x80'..'\x89' as c3)]
+	    (* utf-8 letter-like U2100-214F part 1 *)
+	  | ['\x84' as c2; ('\x80'..'\xBF' as c3)]
+	    (* utf-8 letter-like U2100-214F part 2 *)
+	  | ['\x85' as c2; ('\x80'..'\x8F' as c3)] ->
+	    Stream.junk s; Stream.junk s; Stream.junk s;
+	    ident_tail (store (store (store len '\xE2') c2) c3) s
+	  | _ -> len)
+      | _ -> len
 
 let rec number len = parser
   | [< ' ('0'..'9' as c); s >] -> number (store len c) s
@@ -198,21 +196,11 @@ let rec number len = parser
 
 let escape len c = store len c
 
-let rec string_v8 bp len = parser
+let rec string bp len = parser
   | [< ''"'; esc=(parser [<''"' >] -> true | [< >] -> false); s >] ->
-      if esc then string_v8 bp (store len '"') s else len
-  | [< 'c; s >] -> string_v8 bp (store len c) s 
-  | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_string
-
-let rec string_v7 bp len = parser
-  | [< ''"' >] -> len
-  | [< ''\\'; c = (parser [< ' ('"' | '\\' as c) >] -> c | [< >] -> '\\'); s >]
-     -> string_v7 bp (escape len c) s
+      if esc then string bp (store len '"') s else len
+  | [< 'c; s >] -> string bp (store len c) s 
   | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_string
-  | [< 'c; s >] -> string_v7 bp (store len c) s 
-
-let string bp len s =
-  if !Options.v7 then string_v7 bp len s else string_v8 bp len s
 
 (* Hook for exporting comment into xml theory files *)
 let xml_output_comment = ref (fun _ -> ())
@@ -293,14 +281,14 @@ let rec comment bp = parser bp2
        s >] -> comment bp s
   | [< ''*';
        _ = parser
-         | [< '')' >] ep -> push_string "*)";
+         | [< '')' >] -> push_string "*)";
          | [< s >] -> real_push_char '*'; comment bp s >] -> ()
   | [< ''"'; s >] ->
       if Options.do_translate() then (push_string"\"";comm_string bp2 s)
       else ignore (string bp2 0 s);
       comment bp s
   | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_comment
-  | [< '_ as z; s >] ep -> real_push_char z; comment bp s
+  | [< 'z; s >] -> real_push_char z; comment bp s
 
 (* Parse a special token, using the [token_tree] *)
 
@@ -334,100 +322,81 @@ type token_226_tail =
   | TokSymbol of string option
   | TokIdent of string
 
+(* 1110xxxx 10yyyyzz 10zztttt utf-8 codes for xxxx=0010 *)
 let parse_226_tail tk = parser
-  | [< ''\132' as c2; ' ('\128'..'\191' as c3);
-      (* utf8 letter-like unicode 2100-214F *)
-      len = ident_tail (store (store (store 0 '\226') c2) c3) >] ->
+  | [< ''\x82' as c2; ' ('\x80'..'\x89' as c3);
+      (* utf-8 subscript U2080-2089 *) 
+      len = ident_tail (store (store (store 0 '\xE2') c2) c3) >] ->
+      TokIdent (get_buff len) 
+  | [< ''\x84' as c2; ' ('\x80'..'\xBF' as c3);
+      (* utf-8 letter-like U2100-214F part 1 *)
+      len = ident_tail (store (store (store 0 '\xE2') c2) c3) >] ->
       TokIdent (get_buff len) 
-  | [< ''\133' as c2; ' ('\128'..'\143' as c3);
-      (* utf8 letter-like unicode 2100-214F *)
-      len = ident_tail (store (store (store 0 '\226') c2) c3) >] ->
+  | [< ''\x85' as c2; ' ('\x80'..'\x8F' as c3);
+      (* utf-8 letter-like U2100-214F part 2 *)
+      len = ident_tail (store (store (store 0 '\xE2') c2) c3) >] ->
       TokIdent (get_buff len) 
-  | [< ' ('\134'..'\143' | '\152'..'\155' | '\159' 
-         | '\164'..'\171' as c2); 'c3;
-      (* utf8 arrows A unicode 2190-21FF *)
-      (* utf8 mathematical operators unicode 2200-22FF *)
-      (* utf8 miscellaneous technical unicode 2300-23FF *)
-      (* utf8 miscellaneous symbols unicode 2600-26FF *)
-      (* utf8 Miscellaneous Mathematical Symbols-A unicode 27C0-27DF *)
-      (* utf8 Supplemental Arrows-A unicode 27E0-27FF *)
-      (* utf8 Supplemental Arrows-B unicode 2900-297F *)
-      (* utf8 Miscellaneous Mathematical Symbols-B unicode 2980-29FF *)
-      (* utf8 mathematical operators unicode 2A00-2AFF *)
+  | [< ' ('\x86'..'\x8F' | '\x94'..'\x9B' | '\xA4'..'\xA5' 
+         | '\xA8'..'\xAB' as c2); 'c3;
+      (* utf-8 arrows A U2190-21FF *)
+      (* utf-8 mathematical operators U2200-22FF *)
+      (* utf-8 miscellaneous technical U2300-23FF *)
+      (* utf-8 box drawing U2500-257F has ceiling, etc. *)
+      (* utf-8 block elements U2580-259F *)
+      (* utf-8 geom. shapes U25A0-25FF (has triangles, losange, etc) *)
+      (* utf-8 miscellaneous symbols U2600-26FF *)
+      (* utf-8 arrows B U2900-297F *)
+      (* utf-8 mathematical operators U2A00-2AFF *)
       t = special (progress_special c3 (progress_special c2 
-	(progress_special '\226' tk))) >] ->
+	(progress_special '\xE2' tk))) >] ->
       TokSymbol t
-  | [< len = ident_tail (store 0 '\226') >] ->
-      TokIdent (get_buff len)
-
+  | [< '_; '_ >] ->
+      (* Unsupported utf-8 code *)
+      TokSymbol None
 
 (* Parse what follows a dot *)
-let parse_after_dot bp c strm =
-  if !Options.v7 then 
-    match strm with parser
-	 | [< ' ('_' | 'a'..'z' | 'A'..'Z' as c);
-              len = ident_tail (store 0 c) >] ->
-	     ("FIELD", get_buff len)
-	 (* Greek utf-8 letters [CE80-CEBF and CF80-CFBF] (CE=206; BF=191) *)
-	 | [< ' ('\206' | '\207' as c1); ' ('\128'..'\191' as c2); 
-	   len = ident_tail (store (store 0 c1) c2) >] ->
-	     ("FIELD", get_buff len)
-         (* utf-8 mathematical symbols have format E2 xx xx [E2=226] *)
-	 | [< ''\226' as c1; t = parse_226_tail 
-	     (progress_special '.' (Some !token_tree)) >] ep ->
-	     (match t with
-	       | TokSymbol (Some t) -> ("", t)
-	       | TokSymbol None -> err (bp, ep) Undefined_token
-	       | TokIdent t -> ("FIELD", t))
-	 (* iso 8859-1 accentuated letters *)
-	 | [< ' ('\192'..'\214' | '\216'..'\246' | '\248'..'\255' as c);
-	   len = ident_tail (store 0 c) >] ->
-	     ("FIELD", get_buff len)
-	 | [< (t,_) = process_chars bp c >] -> t
-  else
-    match strm with parser
-	 | [< ' ('a'..'z' | 'A'..'Z' | '_' as c);
-              len = ident_tail (store 0 c) >] ->
-	     ("FIELD", get_buff len)
-	 (* Greek utf-8 letters [CE80-CEBF and CF80-CFBF] (CE=206; BF=191) *)
-	 | [< ' ('\206' | '\207' as c1); ' ('\128'..'\191' as c2); 
-	   len = ident_tail (store (store 0 c1) c2) >] ->
-	     ("FIELD", get_buff len)
-         (* utf-8 mathematical symbols have format E2 xx xx [E2=226] *)
-	 | [< ''\226' as c1; t = parse_226_tail 
-	     (progress_special '.' (Some !token_tree)) >] ep ->
-	     (match t with
-	       | TokSymbol (Some t) -> ("", t)
-	       | TokSymbol None -> err (bp, ep) Undefined_token
-	       | TokIdent t -> ("FIELD", t))
-	 | [< (t,_) = process_chars bp c >] -> t
+let parse_after_dot bp c = parser
+  | [< ' ('a'..'z' | 'A'..'Z' | '_' as c);
+    len = ident_tail (store 0 c) >] ->
+      ("FIELD", get_buff len)
+  (* utf-8 Greek letters U0380-03FF *)
+  | [< ' ('\xCE' | '\xCF' as c1); ' ('\x80'..'\xBF' as c2); 
+    len = ident_tail (store (store 0 c1) c2) >] ->
+      ("FIELD", get_buff len)
+  (* utf-8 mathematical symbols have format E2 xx xx [E2=226] *)
+  | [< ''\xE2'; t = parse_226_tail 
+      (progress_special '.' (Some !token_tree)) >] ep ->
+      (match t with
+	| TokSymbol (Some t) -> ("", t)
+	| TokSymbol None -> err (bp, ep) Undefined_token
+	| TokIdent t -> ("FIELD", t))
+  | [< (t,_) = process_chars bp c >] -> t
 
 
 (* Parse a token in a char stream *)
 
 let rec next_token = parser bp
-  | [< '' ' | '\t' | '\n' |'\r' as c; s >] ep ->
+  | [< '' ' | '\t' | '\n' |'\r' as c; s >] ->
       comm_loc bp; push_char c; next_token s
   | [< ''$'; len = ident_tail (store 0 '$') >] ep -> 
       comment_stop bp;
       (("METAIDENT", get_buff len), (bp,ep))
   | [< ''.' as c; t = parse_after_dot bp c >] ep ->
       comment_stop bp;
-      if !Options.v7 & t=("",".") then between_com := true;
       (t, (bp,ep))
   | [< ' ('a'..'z' | 'A'..'Z' | '_' as c);
        len = ident_tail (store 0 c) >] ep ->
       let id = get_buff len in 
       comment_stop bp;
       (try ("", find_keyword id) with Not_found -> ("IDENT", id)), (bp, ep)
-  (* Greek utf-8 letters [CE80-CEBF and CF80-CFBF] (CE=206; BF=191) *)
-  | [< ' ('\206' | '\207' as c1); ' ('\128'..'\191' as c2); 
+  (* utf-8 Greek letters U0380-03FF [CE80-CEBF and CF80-CFBF] *)
+  | [< ' ('\xCE' | '\xCF' as c1); ' ('\x80'..'\xBF' as c2); 
 	   len = ident_tail (store (store 0 c1) c2) >] ep ->
       let id = get_buff len in
       comment_stop bp;
       (try ("", find_keyword id) with Not_found -> ("IDENT", id)), (bp, ep)
   (* utf-8 mathematical symbols have format E2 xx xx [E2=226] *)
-  | [< ''\226' as c1; t = parse_226_tail (Some !token_tree) >] ep ->
+  | [< ''\xE2'; t = parse_226_tail (Some !token_tree) >] ep ->
       comment_stop bp;
       (match t with
 	| TokSymbol (Some t) -> ("", t), (bp, ep)
@@ -435,21 +404,6 @@ let rec next_token = parser bp
 	| TokIdent id ->
 	    (try ("", find_keyword id) with Not_found -> ("IDENT", id)),
 	    (bp, ep))
-  (* iso 8859-1 accentuated letters *)
-  | [< ' ('\192'..'\214' | '\216'..'\246' | '\248'..'\255' as c) ; s >] ->
-      if !Options.v7 then
-	begin
-	  match s with parser
-	      [< len = ident_tail (store 0 c) >] ep ->
-		let id = get_buff len in
-		comment_stop bp;
-		(try ("", find_keyword id) with Not_found -> ("IDENT", id)), (bp, ep)
-	end
-      else
-	begin
-	  match s with parser
-	      [< t = process_chars bp c >] -> comment_stop bp; t
-	end
   | [< ' ('0'..'9' as c); len = number (store 0 c) >] ep ->
       comment_stop bp;
       (("INT", get_buff len), (bp, ep))
@@ -537,3 +491,41 @@ let tparse (p_con, p_prm) =
   else
     (parser [< '(con, prm) when con = p_con && prm = p_prm >] -> prm)
   i*)
+
+(* Terminal symbols interpretation *)
+
+let is_ident_not_keyword s =
+  match s.[0] with
+    | 'a'..'z' | 'A'..'Z' | '_' -> not (is_keyword s)
+    | _ -> false
+
+let is_number s =
+  match s.[0] with
+    | '0'..'9' -> true
+    | _ -> false
+
+let strip s =
+  let len =
+    let rec loop i len =
+      if i = String.length s then len
+      else if s.[i] == ' ' then loop (i + 1) len
+      else loop (i + 1) (len + 1)
+    in
+    loop 0 0
+  in
+  if len == String.length s then s
+  else
+    let s' = String.create len in
+    let rec loop i i' =
+      if i == String.length s then s'
+      else if s.[i] == ' ' then loop (i + 1) i'
+      else begin s'.[i'] <- s.[i]; loop (i + 1) (i' + 1) end
+    in
+    loop 0 0
+
+let terminal s =
+  let s = strip s in
+  if s = "" then failwith "empty token";
+  if is_ident_not_keyword s then ("IDENT", s)
+  else if is_number s then ("INT", s)
+  else ("", s)
diff --git a/parsing/lexer.mli b/parsing/lexer.mli
index 133bca65..f1ab6446 100644
--- a/parsing/lexer.mli
+++ b/parsing/lexer.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: lexer.mli,v 1.20.2.2 2004/07/16 19:30:39 herbelin Exp $ i*)
+(*i $Id: lexer.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
 open Pp
 open Util
@@ -48,3 +48,5 @@ val com_state: unit -> com_state
 val restore_com_state: com_state -> unit
 
 val set_xml_output_comment : (string -> unit) -> unit
+
+val terminal : string -> string * string
diff --git a/parsing/pcoq.ml4 b/parsing/pcoq.ml4
index a8922536..d743fffa 100644
--- a/parsing/pcoq.ml4
+++ b/parsing/pcoq.ml4
@@ -6,19 +6,18 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pcoq.ml4,v 1.80.2.4 2005/06/21 15:31:12 herbelin Exp $ i*)
+(*i $Id: pcoq.ml4 7826 2006-01-09 22:00:34Z herbelin $ i*)
 
 open Pp
 open Util
 open Names
+open Extend
 open Libnames
 open Rawterm
 open Topconstr
-open Ast
 open Genarg
 open Tacexpr
 open Ppextend
-open Extend
 
 (* The lexer of Coq *)
 
@@ -52,7 +51,7 @@ let grammar_delete e rls =
        List.iter (fun (pil,_) -> G.delete_rule e pil) (List.rev lev))
     (List.rev rls)
 
-(* grammar_object is the superclass of all grammar entry *)
+(* grammar_object is the superclass of all grammar entries *)
 module type Gramobj =
 sig
   type grammar_object
@@ -65,8 +64,9 @@ struct
   let weaken_entry e = Obj.magic e
 end
 
+type entry_type = argument_type
 type grammar_object = Gramobj.grammar_object
-type typed_entry = entry_type * grammar_object G.Entry.e
+type typed_entry = argument_type * grammar_object G.Entry.e
 let in_typed_entry t e = (t,Gramobj.weaken_entry e)
 let type_of_typed_entry (t,e) = t
 let object_of_typed_entry (t,e) = e
@@ -182,7 +182,6 @@ let create_univ s =
 
 let uprim   = create_univ "prim"
 let uconstr = create_univ "constr"
-let umodule = create_univ "module"
 let utactic = create_univ "tactic"
 let uvernac = create_univ "vernac"
 
@@ -311,10 +310,7 @@ module Prim =
     let reference = make_gen_entry uprim rawwit_ref "reference"
 
     (* parsed like ident but interpreted as a term *)
-    let hyp = gec_gen rawwit_ident "hyp"
-
-    (* synonym of hyp/ident (before semantics split) for v7 compatibility *)
-    let var = gec_gen rawwit_ident "var"
+    let var = gec_gen rawwit_var "var"
 
     let name = Gram.Entry.create "Prim.name"
     let identref = Gram.Entry.create "Prim.identref"
@@ -323,16 +319,11 @@ module Prim =
     let base_ident = Gram.Entry.create "Prim.base_ident"
 
     let qualid = Gram.Entry.create "Prim.qualid"
+    let fullyqualid = Gram.Entry.create "Prim.fullyqualid"
     let dirpath = Gram.Entry.create "Prim.dirpath"
 
     let ne_string = Gram.Entry.create "Prim.ne_string"
 
-    (* For old ast printer *)
-    let astpat = Gram.Entry.create "Prim.astpat"
-    let ast = Gram.Entry.create "Prim.ast"
-    let astlist = Gram.Entry.create "Prim.astlist"
-    let ast_eoi = eoi_entry ast
-    let astact = Gram.Entry.create "Prim.astact"
   end
 
 
@@ -372,15 +363,14 @@ module Tactic =
     (* Entries that can be refered via the string -> Gram.Entry.e table *)
     (* Typically for tactic user extensions *)
     let open_constr = 
-      make_gen_entry utactic rawwit_open_constr "open_constr"
-    let castedopenconstr = 
-      make_gen_entry utactic rawwit_casted_open_constr "castedopenconstr"
+      make_gen_entry utactic (rawwit_open_constr_gen false) "open_constr"
+    let casted_open_constr =
+      make_gen_entry utactic (rawwit_open_constr_gen true) "casted_open_constr"
     let constr_with_bindings =
       make_gen_entry utactic rawwit_constr_with_bindings "constr_with_bindings"
     let bindings =
       make_gen_entry utactic rawwit_bindings "bindings"
-(*v7*) let constrarg = make_gen_entry utactic rawwit_constr_may_eval "constrarg"
-(*v8*) let constr_may_eval = make_gen_entry utactic rawwit_constr_may_eval "constr_may_eval"
+    let constr_may_eval = make_gen_entry utactic rawwit_constr_may_eval "constr_may_eval"
     let quantified_hypothesis =
       make_gen_entry utactic rawwit_quant_hyp "quantified_hypothesis"
     let int_or_var = make_gen_entry utactic rawwit_int_or_var "int_or_var"
@@ -390,10 +380,14 @@ module Tactic =
 
     (* Main entries for ltac *)
     let tactic_arg = Gram.Entry.create "tactic:tactic_arg"
-    let tactic = make_gen_entry utactic rawwit_tactic "tactic"
+    let tactic_expr = Gram.Entry.create "tactic:tactic_expr"
+
+    let tactic_main_level = 5
+    let tactic = make_gen_entry utactic (rawwit_tactic tactic_main_level) "tactic"
 
     (* Main entry for quotations *)
     let tactic_eoi = eoi_entry tactic
+
   end
 
 
@@ -411,32 +405,6 @@ module Vernac_ =
     let vernac_eoi = eoi_entry vernac
   end
 
-
-(* Prim is not re-initialized *)
-let reset_all_grammars () =
-  let f = Gram.Unsafe.clear_entry in
-  List.iter f
-    [Constr.constr;Constr.operconstr;Constr.lconstr;Constr.annot;
-     Constr.constr_pattern;Constr.lconstr_pattern];
-  f Constr.ident; f Constr.global; f Constr.sort; f Constr.pattern;
-  f Module.module_expr; f Module.module_type;
-  f Tactic.simple_tactic;
-  f Tactic.castedopenconstr;
-  f Tactic.constr_with_bindings;
-  f Tactic.bindings;
-  f Tactic.constrarg;
-  f Tactic.quantified_hypothesis;
-  f Tactic.int_or_var;
-  f Tactic.red_expr;
-  f Tactic.tactic_arg;
-  f Tactic.tactic;
-  f Vernac_.gallina;
-  f Vernac_.gallina_ext;
-  f Vernac_.command;
-  f Vernac_.syntax;
-  f Vernac_.vernac;
-  Lexer.init()
-
 let main_entry = Gram.Entry.create "vernac"
 
 GEXTEND Gram
@@ -445,88 +413,6 @@ GEXTEND Gram
   ;
 END
 
-(* Quotations *)
-
-open Prim
-open Constr
-open Tactic
-open Vernac_
-
-(* current file and toplevel/vernac.ml *)
-let globalizer = ref (fun x -> failwith "No globalizer")
-let set_globalizer f = globalizer := f
-
-let define_ast_quotation default s (e:Coqast.t G.Entry.e) =
-  (if default then
-    GEXTEND Gram
-      ast: [ [ "<<"; c = e; ">>" -> c ] ];
-     (* Uncomment this to keep compatibility with old grammar syntax
-     constr: [ [ "<<"; c = e; ">>" -> c ] ];
-     vernac: [ [ "<<"; c = e; ">>" -> c ] ];
-     tactic: [ [ "<<"; c = e; ">>" -> c ] ];
-     *)
-   END);
-  (GEXTEND Gram
-     GLOBAL: ast constr command tactic;
-     ast:
-       [ [ "<:"; IDENT $s$; ":<"; c = e; ">>" -> c ] ];
-     (* Uncomment this to keep compatibility with old grammar syntax
-     constr:
-       [ [ "<:"; IDENT $s$; ":<"; c = e; ">>" -> c ] ];
-     command:
-       [ [ "<:"; IDENT $s$; ":<"; c = e; ">>" -> c ] ];
-     tactic:
-       [ [ "<:"; IDENT $s$; ":<"; c = e; ">>" -> c ] ];
-     *)
-   END)
-
-(*
-let _ = define_ast_quotation false "ast" ast in ()
-*)
-
-let dynconstr = Gram.Entry.create "Constr.dynconstr"
-let dyncasespattern = Gram.Entry.create "Constr.dyncasespattern"
-
-GEXTEND Gram
-  dynconstr:
-  [ [ a = Constr.constr -> ConstrNode a 
-    (* For compatibility *)
-    | "<<"; a = Constr.lconstr; ">>" -> ConstrNode a ] ]
-  ;
-  dyncasespattern: [ [ a = Constr.pattern -> CasesPatternNode a ] ];
-END
-
-(**********************************************************************)
-(* The following is to dynamically set the parser in Grammar actions  *)
-(* and Syntax pattern, according to the universe of the rule defined  *)
-
-type parser_type =
-  | ConstrParser
-  | CasesPatternParser
-
-let default_action_parser_ref = ref dynconstr
-
-let get_default_action_parser () = !default_action_parser_ref
-
-let entry_type_of_parser =  function
-  | ConstrParser -> Some ConstrArgType
-  | CasesPatternParser -> failwith "entry_type_of_parser: cases_pattern, TODO"
-
-let parser_type_from_name =  function
-  | "constr" -> ConstrParser
-  | "cases_pattern" -> CasesPatternParser
-  | "tactic" -> assert false
-  | "vernac" -> error "No longer supported"
-  | s -> ConstrParser
-
-let set_default_action_parser = function
-  | ConstrParser  -> default_action_parser_ref := dynconstr
-  | CasesPatternParser  -> default_action_parser_ref := dyncasespattern
-
-let default_action_parser =
-  Gram.Entry.of_parser "default_action_parser" 
-    (fun strm -> Gram.Entry.parse_token (get_default_action_parser ()) strm)
-
 (**********************************************************************)
 (* This determines (depending on the associativity of the current
    level and on the expected associativity) if a reference to constr_n is
@@ -536,24 +422,9 @@ let default_action_parser =
    translated in camlp4 into "constr" without level) or to another level
    (to be translated into "constr LEVEL n") *)
 
-let assoc_level = function
-  | Some Gramext.LeftA when !Options.v7 -> "L"
-  | _ -> ""
-
-let constr_level = function
-  | n,assoc -> (string_of_int n)^(assoc_level assoc)
-
-let constr_level2 = function
-  | n,assoc -> (string_of_int n)^(assoc_level (Some assoc))
-
-let default_levels_v7 =
-  [10,Gramext.RightA;
-   9,Gramext.RightA;
-   8,Gramext.RightA;
-   1,Gramext.RightA;
-   0,Gramext.RightA]
+let constr_level = string_of_int
 
-let default_levels_v8 =
+let default_levels =
   [200,Gramext.RightA;
    100,Gramext.RightA;
    99,Gramext.RightA;
@@ -563,20 +434,16 @@ let default_levels_v8 =
    1,Gramext.LeftA;
    0,Gramext.RightA]
 
-let default_pattern_levels_v8 =
+let default_pattern_levels =
   [10,Gramext.LeftA;
    0,Gramext.RightA]
 
 let level_stack = 
-  ref 
-    [if !Options.v7 then (default_levels_v7, default_levels_v7)
-     else (default_levels_v8, default_pattern_levels_v8)]
+  ref [(default_levels, default_pattern_levels)]
 
 (* At a same level, LeftA takes precedence over RightA and NoneA *)
 (* In case, several associativity exists for a level, we make two levels, *)
 (* first LeftA, then RightA and NoneA together *)
-exception Found of Gramext.g_assoc
-
 open Ppextend
 
 let admissible_assoc = function
@@ -599,48 +466,35 @@ let error_level_assoc p current expected =
      pr_assoc expected ++ str " associative")
 
 let find_position forpat other assoc lev =
-  let default = if !Options.v7 then Some (10,Gramext.RightA) else None in
   let ccurrent,pcurrent as current = List.hd !level_stack in 
   match lev with
   | None ->
       level_stack := current :: !level_stack;
       None, (if other then assoc else None), None
   | Some n ->
-      if !Options.v7 & n = 8 & assoc = Some Gramext.LeftA then 
-	error "Left associativity not allowed at level 8";
-      let after = ref default in
+      let after = ref None in
       let rec add_level q = function
-        | (p,_ as pa)::l when p > n -> pa :: add_level (Some pa) l
-        | (p,a as pa)::l as l' when p = n ->
-	    if admissible_assoc (a,assoc) then raise (Found a);
-	    (* No duplication of levels in v8 *)
-	    if not !Options.v7 then error_level_assoc p a (out_some assoc);
-	    (* Maybe this was (p,Left) and p occurs a second time *)
-	    if a = Gramext.LeftA then
-	      match l with
-		| (p,a)::_ as l' when p = n -> raise (Found a)
-		| _ -> after := Some pa; pa::(n,create_assoc assoc)::l
-	    else
-	      (* This was not (p,LeftA) hence assoc is RightA *)
-	      (after := q; (n,create_assoc assoc)::l')
-	| l ->
-	    after := q; (n,create_assoc assoc)::l
+        | (p,_ as pa)::l when p > n -> pa :: add_level (Some p) l
+        | (p,a)::l when p = n ->
+	    if admissible_assoc (a,assoc) then raise Exit;
+	    error_level_assoc p a (out_some assoc)
+	| l -> after := q; (n,create_assoc assoc)::l
       in
       try
 	(* Create the entry *)
 	let updated =
-	  if forpat then (ccurrent, add_level default pcurrent)
-	  else (add_level default ccurrent, pcurrent) in
+	  if forpat then (ccurrent, add_level None pcurrent)
+	  else (add_level None ccurrent, pcurrent) in
         level_stack := updated:: !level_stack;
 	let assoc = create_assoc assoc in
 	(if !after = None then Some Gramext.First
-	else Some (Gramext.After (constr_level2 (out_some !after)))),
-	Some assoc, Some (constr_level2 (n,assoc))
+	else Some (Gramext.After (constr_level (out_some !after)))),
+	Some assoc, Some (constr_level n)
       with
-          Found a ->
+          Exit ->
             level_stack := current :: !level_stack;
 	    (* Just inherit the existing associativity and name (None) *)
-	    Some (Gramext.Level (constr_level2 (n,a))), None, None
+	    Some (Gramext.Level (constr_level n)), None, None
 
 let remove_levels n =
   level_stack := list_skipn n !level_stack
@@ -663,19 +517,19 @@ let adjust_level assoc from = function
   | (NumLevel n,BorderProd (_,None)) -> Some (Some (n,true))
 (* Compute production name on the right side *)
   (* If NonA or LeftA on the right-hand side, set to NEXT *)
-  | (NumLevel n,BorderProd (false,Some (Gramext.NonA|Gramext.LeftA))) ->
+  | (NumLevel n,BorderProd (Right,Some (Gramext.NonA|Gramext.LeftA))) ->
       Some None
   (* If RightA on the right-hand side, set to the explicit (current) level *)
-  | (NumLevel n,BorderProd (false,Some Gramext.RightA)) ->
+  | (NumLevel n,BorderProd (Right,Some Gramext.RightA)) ->
       Some (Some (n,true))
 (* Compute production name on the left side *)
   (* If NonA on the left-hand side, adopt the current assoc ?? *)
-  | (NumLevel n,BorderProd (true,Some Gramext.NonA)) -> None
+  | (NumLevel n,BorderProd (Left,Some Gramext.NonA)) -> None
   (* If the expected assoc is the current one, set to SELF *)
-  | (NumLevel n,BorderProd (true,Some a)) when a = camlp4_assoc assoc ->
+  | (NumLevel n,BorderProd (Left,Some a)) when a = camlp4_assoc assoc ->
       None
   (* Otherwise, force the level, n or n-1, according to expected assoc *)
-  | (NumLevel n,BorderProd (true,Some a)) ->
+  | (NumLevel n,BorderProd (Left,Some a)) ->
       if a = Gramext.LeftA then Some (Some (n,true)) else Some None
   (* None means NEXT *)
   | (NextLevel,_) -> Some None
@@ -686,39 +540,11 @@ let adjust_level assoc from = function
 	| ETConstr (p,()) -> Some (Some (n,n=p))
 	| _ -> Some (Some (n,false))
 
-(*
-  (* If NonA on the right-hand side, set to NEXT *)
-  | (n,BorderProd (false,Some Gramext.NonA)) -> Some None
-  (* If NonA on the left-hand side, adopt the current assoc ?? *)
-  | (n,BorderProd (true,Some Gramext.NonA)) -> None
-  (* Associativity is None means force the level *)
-  | (n,BorderProd (_,None)) -> Some (Some (n,true))
-  (* If left assoc at a left level, set NEXT on the right *)
-  | (n,BorderProd (false,Some (Gramext.LeftA as a)))
-      when Gramext.LeftA = camlp4_assoc assoc -> Some None
-  (* If right or none assoc expected is the current assoc, set explicit 
-     level on the right side *)
-  | (n,BorderProd (false,Some a)) when a = camlp4_assoc assoc ->
-      Some (Some (n,true))
-  (* If the expected assoc is the current one, SELF on the left sides *)
-  | (n,BorderProd (true,Some a)) when a = camlp4_assoc assoc -> None
-  (* Otherwise, force the level, n or n-1, according to expected assoc *)
-  | (n,BorderProd (left,Some a)) ->
-      if (left & a = Gramext.LeftA) or ((not left) & a = Gramext.RightA)
-      then Some (Some (n,true)) else Some (Some (n-1,false))
-(*  | (8,InternalProd) -> None (* Or (Some 8) for factorization ? *)*)
-  | (n,InternalProd) ->
-      match from with
-	| ETConstr (p,()) when p = n+1 -> Some None
-	| ETConstr (p,()) -> Some (Some (n,n=p))
-	| _ -> Some (Some (n,false))
-*)
-
 let compute_entry allow_create adjust forpat = function
   | ETConstr (n,q) ->
       (if forpat then weaken_entry Constr.pattern
        else weaken_entry Constr.operconstr),
-      (if forpat & !Options.v7 then None else adjust (n,q)), false
+      adjust (n,q), false
   | ETIdent -> weaken_entry Constr.ident, None, false
   | ETBigint -> weaken_entry Prim.bigint, None, false
   | ETReference -> weaken_entry Constr.global, None, false
@@ -734,42 +560,22 @@ let compute_entry allow_create adjust forpat = function
       object_of_typed_entry e, None, true
 
 (* This computes the name of the level where to add a new rule *)
-let get_constr_entry forpat en =
-  match en with
-      ETConstr(200,()) when not !Options.v7 & not forpat ->
-	snd (get_entry (get_univ "constr") "binder_constr"),
-        None,
-        false
-    | _ -> compute_entry true (fun (n,()) -> Some n) forpat en
+let get_constr_entry forpat = function
+  | ETConstr(200,()) when not forpat ->
+      weaken_entry Constr.binder_constr, None, false
+  | e ->
+      compute_entry true (fun (n,()) -> Some n) forpat e
 
 (* This computes the name to give to a production knowing the name and
    associativity of the level where it must be added *)
 let get_constr_production_entry ass from forpat en =
-  (* first 2 cases to help factorisation *)
-  match en with
-    | ETConstr (NumLevel 10,q) when !Options.v7 & not forpat ->
-        weaken_entry Constr.lconstr, None, false
-(*
-    | ETConstr (8,q) when !Options.v7 ->
-        weaken_entry Constr.constr, None, false
-*)
-    | _ -> compute_entry false (adjust_level ass from) forpat en
-
-let constr_prod_level assoc cur lev =
-  if !Options.v7 then
-    if cur then constr_level (lev,assoc) else
-      match lev with
-	| 4 when !Options.v7 -> "4L"
-	| n -> string_of_int n
-  else
-    (* No duplication L/R of levels in v8 *)
-    constr_level (lev,assoc)
+  compute_entry false (adjust_level ass from) forpat en
 
 let is_self from e =
   match from, e with
       ETConstr(n,()), ETConstr(NumLevel n',
-        BorderProd(false, _ (* Some(Gramext.NonA|Gramext.LeftA) *))) -> false
-    | ETConstr(n,()), ETConstr(NumLevel n',BorderProd(true,_)) -> n=n'
+        BorderProd(Right, _ (* Some(Gramext.NonA|Gramext.LeftA) *))) -> false
+    | ETConstr(n,()), ETConstr(NumLevel n',BorderProd(Left,_)) -> n=n'
     | (ETIdent,ETIdent | ETReference, ETReference | ETBigint,ETBigint
       | ETPattern, ETPattern) -> true
     | ETOther(s1,s2), ETOther(s1',s2') -> s1=s1' & s2=s2'
@@ -778,15 +584,14 @@ let is_self from e =
 let is_binder_level from e =
   match from, e with
       ETConstr(200,()),
-      ETConstr(NumLevel 200,(BorderProd(false,_)|InternalProd)) ->
-        not !Options.v7
+      ETConstr(NumLevel 200,(BorderProd(Right,_)|InternalProd)) -> true
     | _ -> false
 
 let rec symbol_of_production assoc from forpat typ =
   if is_binder_level from typ then
-    let eobj = snd (get_entry (get_univ "constr") "operconstr") in
-    Gramext.Snterml (Gram.Entry.obj eobj,"200")
-  else if is_self from typ then Gramext.Sself
+    Gramext.Snterml (Gram.Entry.obj Constr.operconstr,"200")
+  else if is_self from typ then
+    Gramext.Sself
   else
     match typ with
     | ETConstrList (typ',[]) ->
@@ -803,4 +608,15 @@ let rec symbol_of_production assoc from forpat typ =
       | (eobj,None,_) -> Gramext.Snterm (Gram.Entry.obj eobj)
       | (eobj,Some None,_) -> Gramext.Snext
       | (eobj,Some (Some (lev,cur)),_) -> 
-          Gramext.Snterml (Gram.Entry.obj eobj,constr_prod_level assoc cur lev)
+          Gramext.Snterml (Gram.Entry.obj eobj,constr_level lev)
+
+(*****************************)
+(* Coercions between entries *)
+
+let coerce_reference_to_id = function
+  | Ident (_,id) -> id
+  | Qualid (loc,_) ->
+      user_err_loc (loc, "coerce_reference_to_id",
+        str "This expression should be a simple identifier")
+
+let coerce_global_to_id = coerce_reference_to_id
diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli
index 15a2c2cc..fe6fd083 100644
--- a/parsing/pcoq.mli
+++ b/parsing/pcoq.mli
@@ -6,18 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pcoq.mli,v 1.63.2.3 2005/06/21 15:31:12 herbelin Exp $ i*)
+(*i $Id: pcoq.mli 7826 2006-01-09 22:00:34Z herbelin $ i*)
 
 open Util
 open Names
 open Rawterm
-open Ast
+open Extend
 open Genarg
 open Topconstr
 open Tacexpr
 open Vernacexpr
 open Libnames
-open Extend
 
 (* The lexer and parser of Coq. *)
 
@@ -25,21 +24,23 @@ val lexer : Token.lexer
 
 module Gram : Grammar.S with type te = Token.t
 
+(* The superclass of all grammar entries *)
 type grammar_object
+
+(* The type of typed grammar objects *)
 type typed_entry
 
-val type_of_typed_entry : typed_entry -> Extend.entry_type
+type entry_type = argument_type
+
+val type_of_typed_entry : typed_entry -> entry_type
 val object_of_typed_entry : typed_entry -> grammar_object Gram.Entry.e
 val weaken_entry : 'a Gram.Entry.e -> grammar_object Gram.Entry.e
 
 val get_constr_entry :
   bool -> constr_entry -> grammar_object Gram.Entry.e * int option * bool
 
-val symbol_of_production : Gramext.g_assoc option -> constr_entry ->
-  bool -> constr_production_entry -> Token.t Gramext.g_symbol
-
 val grammar_extend :
-  'a Gram.Entry.e -> Gramext.position option ->
+  grammar_object Gram.Entry.e -> Gramext.position option ->
     (string option * Gramext.g_assoc option *
      (Token.t Gramext.g_symbol list * Gramext.g_action) list) list
     -> unit
@@ -80,22 +81,6 @@ val create_generic_entry : string -> ('a, constr_expr,raw_tactic_expr) abstract_
 val get_generic_entry : string -> grammar_object Gram.Entry.e
 val get_generic_entry_type : string * gram_universe -> string -> Genarg.argument_type
 
-type parser_type =
-  | ConstrParser
-  | CasesPatternParser
-
-val entry_type_of_parser : parser_type -> entry_type option
-val parser_type_from_name : string -> parser_type
-
-(* Quotations in ast parser *)
-val define_ast_quotation : bool -> string -> (Coqast.t Gram.Entry.e) -> unit
-val set_globalizer : (constr_expr -> Coqast.t) -> unit
-
-(* The default parser for actions in grammar rules *)
-
-val default_action_parser : dynamic_grammar Gram.Entry.e
-val set_default_action_parser : parser_type -> unit
-
 (* The main entry: reads an optional vernac command *)
 
 val main_entry : (loc * vernac_expr) option Gram.Entry.e
@@ -113,20 +98,15 @@ module Prim :
     val identref : identifier located Gram.Entry.e
     val base_ident : identifier Gram.Entry.e
     val natural : int Gram.Entry.e
-    val bigint : Bignat.bigint Gram.Entry.e
+    val bigint : Bigint.bigint Gram.Entry.e
     val integer : int Gram.Entry.e
     val string : string Gram.Entry.e
     val qualid : qualid located Gram.Entry.e
+    val fullyqualid : identifier list located Gram.Entry.e
     val reference : reference Gram.Entry.e
     val dirpath : dir_path Gram.Entry.e
     val ne_string : string Gram.Entry.e
-    val hyp : identifier Gram.Entry.e
-    (* v7 only entries *)
-    val astpat: typed_ast Gram.Entry.e
-    val ast : Coqast.t Gram.Entry.e
-    val astlist : Coqast.t list Gram.Entry.e
-    val ast_eoi : Coqast.t Gram.Entry.e
-    val var : identifier Gram.Entry.e
+    val var : identifier located Gram.Entry.e
   end
 
 module Constr :
@@ -157,17 +137,18 @@ module Tactic :
   sig
     open Rawterm
     val open_constr : open_constr_expr Gram.Entry.e
-    val castedopenconstr : open_constr_expr Gram.Entry.e
+    val casted_open_constr : open_constr_expr Gram.Entry.e
     val constr_with_bindings : constr_expr with_bindings Gram.Entry.e
     val bindings : constr_expr bindings Gram.Entry.e
-(*v7*) val constrarg : (constr_expr,reference) may_eval Gram.Entry.e
-(*v8*) val constr_may_eval : (constr_expr,reference) may_eval Gram.Entry.e
+    val constr_may_eval : (constr_expr,reference) may_eval Gram.Entry.e
     val quantified_hypothesis : quantified_hypothesis Gram.Entry.e
     val int_or_var : int or_var Gram.Entry.e
     val red_expr : raw_red_expr Gram.Entry.e
     val simple_tactic : raw_atomic_tactic_expr Gram.Entry.e
     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 tactic_main_level : int
     val tactic : raw_tactic_expr Gram.Entry.e
     val tactic_eoi : raw_tactic_expr Gram.Entry.e
   end
@@ -183,7 +164,10 @@ module Vernac_ :
     val vernac_eoi : vernac_expr Gram.Entry.e
   end
 
-val reset_all_grammars : unit -> unit
+(* Binding entry names to campl4 entries *)
+
+val symbol_of_production : Gramext.g_assoc option -> constr_entry ->
+  bool -> constr_production_entry -> Token.t Gramext.g_symbol
 
 (* Registering/resetting the level of an entry *)
 
@@ -192,3 +176,5 @@ val find_position :
     Gramext.position option * Gramext.g_assoc option * string option
 
 val remove_levels : int -> unit 
+
+val coerce_global_to_id : reference -> identifier
diff --git a/parsing/ppconstr.ml b/parsing/ppconstr.ml
index ddf008cb..a43463c6 100644
--- a/parsing/ppconstr.ml
+++ b/parsing/ppconstr.ml
@@ -6,44 +6,64 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ppconstr.ml,v 1.32.2.2 2004/12/29 10:17:11 herbelin Exp $ *)
+(* $Id: ppconstr.ml 8624 2006-03-13 17:38:17Z msozeau $ *)      
 
 (*i*)
-open Ast
 open Util
 open Pp
 open Nametab
 open Names
 open Nameops
 open Libnames
-open Coqast
 open Ppextend
 open Topconstr
 open Term
 open Pattern
+open Rawterm
+open Constrextern
+open Termops
 (*i*)
 
+let sep_p = fun _ -> str"."
+let sep_v = fun _ -> str"," ++ spc()
+let sep_pp = fun _ -> str":"
+let sep_bar = fun _ -> spc() ++ str"| "
+let pr_tight_coma () = str "," ++ cut ()
+
 let latom = 0
-let lannot = 1
-let lprod = 8 (* not 1 because the scope extends to 8 on the right *)
-let llambda = 8 (* not 1 *)
-let lif = 8 (* not 1 *)
-let lletin = 8 (* not 1 *)
-let lcases = 1
-let larrow = 8
-let lcast = 9
+let lannot = 100
+let lprod = 200
+let llambda = 200
+let lif = 200
+let lletin = 200
+let lfix = 200
+let larrow = 90
+let lcast = 100
+let larg = 9
 let lapp = 10
-let ltop = (8,E)
+let lposint = 0
+let lnegint = 35 (* must be consistent with Notation "- x" *)
+let ltop = (200,E)
+let lproj = 1
+let lsimple = (1,E)
+
+let prec_less child (parent,assoc) =
+  if parent < 0 && child = lprod then true
+  else
+    let parent = abs parent in
+    match assoc with
+      | E -> (<=) child parent
+      | L -> (<) child parent
+      | Prec n -> child<=n
+      | Any -> true
 
-let prec_less child (parent,assoc) = match assoc with
-  | E -> child <= parent
-  | L -> child < parent
-  | Prec n -> child <= n
-  | Any -> true
+let prec_of_prim_token = function
+  | Numeral p -> if Bigint.is_pos_or_zero p then lposint else lnegint
+  | String _ -> latom
 
 let env_assoc_value v env =
   try List.nth env (v-1)
-  with Not_found -> anomaly "Inconsistent environment for pretty-print rule"
+  with Not_found -> anomaly ("Inconsistent environment for pretty-print rule")
 
 let decode_constrlist_value = function
   | CAppExpl (_,_,l) -> l
@@ -54,7 +74,7 @@ let decode_patlist_value = function
   | CPatCstr (_,_,l) -> l
   | _ -> anomaly "Ill-formed list argument of notation"
 
-open Symbols
+open Notation
 
 let rec print_hunk n decode pr env = function
   | UnpMetaVar (e,prec) -> pr (n,prec) (env_assoc_value e env)
@@ -73,315 +93,596 @@ let pr_notation = pr_notation_gen decode_constrlist_value
 let pr_patnotation = pr_notation_gen decode_patlist_value
 
 let pr_delimiters key strm =
-  let left = "'"^key^":" and right = "'" in
-  let lspace =
-    if is_letter (left.[String.length left -1]) then str " " else mt () in
-  let rspace =
-    let c = right.[0] in
-    if is_letter c or is_digit c or c = '\'' then str " " else mt () in
-  str left ++ lspace ++ strm ++ rspace ++ str right
+  strm ++ str ("%"^key)
 
-open Rawterm
+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
+    comment b ++ pr x ++ comment e
+  else pr x
+
+let pr_com_at n =
+  if Options.do_translate() && n <> 0 then comment n 
+  else mt()
+
+let pr_with_comments loc pp = pr_located (fun x -> x) (loc,pp)
 
-let pr_opt pr = function
+let pr_sep_com sep f c = pr_with_comments (constr_loc c) (sep() ++ f c)
+
+let pr_optc pr = function
   | None -> mt ()
-  | Some x -> spc () ++ pr x
+  | Some x -> pr_sep_com spc pr x
 
-let pr_universe u = str "<univ>"
+let pr_universe = Univ.pr_uni 
 
 let pr_sort = function
   | RProp Term.Null -> str "Prop"
   | RProp Term.Pos -> str "Set"
   | RType u -> str "Type" ++ pr_opt pr_universe u
 
-let pr_explicitation = function
-  | None -> mt ()
-  | Some (_,ExplByPos n) -> int n ++ str "!"
-  | Some (_,ExplByName n) -> anomaly "Argument made explicit by name"
+let pr_id = pr_id
+let pr_name = pr_name
+let pr_qualid = pr_qualid
 
 let pr_expl_args pr (a,expl) =
-  pr_explicitation expl ++ pr (lapp,L) a
+  match expl with
+  | None -> pr (lapp,L) a
+  | Some (_,ExplByPos n) ->
+      anomaly("Explicitation by position not implemented")
+  | Some (_,ExplByName id) -> 
+      str "(" ++ pr_id id ++ str ":=" ++ pr ltop a ++ str ")"
 
 let pr_opt_type pr = function
   | CHole _ -> mt ()
-  | t -> str ":" ++ pr ltop t
-
-let pr_tight_coma () = str "," ++ cut ()
+  | t -> cut () ++ str ":" ++ pr t
 
-let pr_name = function
-  | Anonymous -> str "_"
-  | Name id -> pr_id id
-
-let pr_located pr (loc,x) = pr x
+let pr_opt_type_spc pr = function
+  | CHole _ -> mt ()
+  | t ->  str " :" ++ pr_sep_com (fun()->brk(1,2)) (pr ltop) t
+
+let pr_lident (b,_ as loc,id) =
+  if loc <> dummy_loc then
+    let (b,_) = unloc loc in
+    pr_located pr_id (make_loc (b,b+String.length(string_of_id id)),id)
+  else pr_id id
+
+let pr_lname = function
+    (loc,Name id) -> pr_lident (loc,id)
+  | lna -> pr_located pr_name lna
+
+let pr_or_var pr = function
+  | Genarg.ArgArg x -> pr x
+  | Genarg.ArgVar (loc,s) -> pr_lident (loc,s)
+
+let pr_prim_token = function
+  | Numeral n -> Bigint.pr_bigint n
+  | String s -> qs s
+
+let las = lapp
+let lpator = 100
+
+let rec pr_patt sep inh p =
+  let (strm,prec) = match p with
+  | CPatAlias (_,p,id) ->
+      pr_patt mt (las,E) p ++ str " as " ++ pr_id id, las
+  | CPatCstr (_,c,[]) -> pr_reference c, latom
+  | CPatCstr (_,c,args) ->
+      pr_reference c ++ prlist (pr_patt spc (lapp,L)) args, lapp
+  | CPatAtom (_,None) -> str "_", latom
+  | CPatAtom (_,Some r) -> pr_reference r, latom
+  | CPatOr (_,pl) ->
+      hov 0 (prlist_with_sep pr_bar (pr_patt spc (lpator,L)) pl), lpator
+  | CPatNotation (_,"( _ )",[p]) ->
+      pr_patt (fun()->str"(") (max_int,E) p ++ str")", latom
+  | CPatNotation (_,s,env) -> pr_patnotation (pr_patt mt) s env
+  | 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
+  pr_with_comments loc
+    (sep() ++ if prec_less prec inh then strm else surround strm)
+
+let pr_patt = pr_patt mt
+
+
+let pr_eqn pr (loc,pl,rhs) =
+  spc() ++ hov 4
+    (pr_with_comments loc
+      (str "| " ++
+      hov 0 (prlist_with_sep sep_v (pr_patt ltop) pl ++ str " =>") ++
+      pr_sep_com spc (pr ltop) rhs))
+
+let begin_of_binder = function
+    LocalRawDef((loc,_),_) -> fst (unloc loc)
+  | LocalRawAssum((loc,_)::_,_) -> fst (unloc loc)
+  | _ -> assert false
+
+let begin_of_binders = function
+  | b::_ -> begin_of_binder b
+  | _ -> 0
+
+let pr_binder many pr (nal,t) =
+  match t with
+  | CHole _ -> prlist_with_sep spc pr_lname nal
+  | _ ->
+    let s = prlist_with_sep spc pr_lname nal ++ str" : " ++ pr t in
+    hov 1 (if many then surround s else s)
+
+let pr_binder_among_many pr_c = function
+  | LocalRawAssum (nal,t) ->
+      pr_binder true pr_c (nal,t)
+  | LocalRawDef (na,c) ->
+      let c,topt = match c with
+        | CCast(_,c,_,t) -> c, t
+        | _ -> c, CHole dummy_loc in
+      hov 1 (surround
+        (pr_lname na ++ pr_opt_type pr_c topt ++
+         str":=" ++ cut() ++ pr_c c))
+
+let pr_undelimited_binders pr_c =
+  prlist_with_sep spc (pr_binder_among_many pr_c)
+
+let pr_delimited_binders kw pr_c bl =
+  let n = begin_of_binders bl in
+  match bl with
+  | [LocalRawAssum (nal,t)] ->
+      pr_com_at n ++ kw() ++ pr_binder false pr_c (nal,t)
+  | LocalRawAssum _ :: _ as bdl ->
+      pr_com_at n ++ kw() ++ pr_undelimited_binders pr_c bdl
+  | _ -> assert false
 
 let pr_let_binder pr x a =
-  hov 0 (hov 0 (pr_name x ++ brk(0,1) ++ str ":=") ++ brk(0,1) ++ pr ltop a)
-
-let pr_binder pr (nal,t) =
-  hov 0 (
-    prlist_with_sep pr_tight_coma (pr_located pr_name) nal ++
-    pr_opt_type pr t)
-
-let pr_binders pr bl =
-  hv 0 (prlist_with_sep pr_semicolon (pr_binder pr) bl)
-
-let pr_local_binder pr = function
-    LocalRawAssum(nal,t) -> pr_binder pr (nal,t)
-  | LocalRawDef((_,na),t) -> pr_let_binder pr na t
-
-let pr_local_binders pr bl =
-  hv 0 (prlist_with_sep pr_semicolon (pr_local_binder pr) bl)
-
-let pr_global vars ref = pr_global_env vars ref
-
-let rec pr_lambda_tail pr bll = function
-  | CLambdaN (_,bl,a) ->
-      pr_lambda_tail pr (bll ++ pr_semicolon() ++ pr_binders pr bl) a
-  | CLetIn (_,x,a,b) ->
-      pr_lambda_tail pr (bll ++ pr_semicolon() ++ pr_let_binder pr (snd x) a) b
-  | a ->
-      bll, pr ltop a
-
-let rec pr_prod_tail pr bll = function
-  | CProdN (_,bl,a) ->
-      pr_prod_tail pr (bll ++ pr_semicolon () ++ pr_binders pr bl) a
-  | a -> bll, pr ltop a
-
-let pr_recursive_decl pr id binders t c =
-  pr_id id ++ binders ++
-  brk (1,2) ++ str ": " ++ pr ltop t ++ str " :=" ++
-  brk (1,2) ++ pr ltop c
-
+  hov 0 (hov 0 (pr_name x ++ brk(0,1) ++ str ":=") ++
+         pr_sep_com (fun () -> brk(0,1)) (pr ltop) a)
+
+let rec extract_prod_binders = function
+(*  | CLetIn (loc,na,b,c) as x ->
+      let bl,c = extract_prod_binders c in
+      if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
+  | CProdN (loc,[],c) ->
+      extract_prod_binders c
+  | CProdN (loc,(nal,t)::bl,c) ->
+      let bl,c = extract_prod_binders (CProdN(loc,bl,c)) in
+      LocalRawAssum (nal,t) :: bl, c
+  | c -> [], c
+
+let rec extract_lam_binders = function
+(*  | CLetIn (loc,na,b,c) as x ->
+      let bl,c = extract_lam_binders c in
+      if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
+  | CLambdaN (loc,[],c) ->
+      extract_lam_binders c
+  | CLambdaN (loc,(nal,t)::bl,c) ->
+      let bl,c = extract_lam_binders (CLambdaN(loc,bl,c)) in
+      LocalRawAssum (nal,t) :: bl, c
+  | c -> [], c
+    
 let split_lambda = function
   | CLambdaN (loc,[[na],t],c) -> (na,t,c)
   | CLambdaN (loc,([na],t)::bl,c) -> (na,t,CLambdaN(loc,bl,c))
   | CLambdaN (loc,(na::nal,t)::bl,c) -> (na,t,CLambdaN(loc,(nal,t)::bl,c))
   | _ -> anomaly "ill-formed fixpoint body"
 
-let split_product = function
-  | CArrow (loc,t,c) -> ((loc,Anonymous),t,c)
-  | CProdN (loc,[[na],t],c) -> (na,t,c)
-  | CProdN (loc,([na],t)::bl,c) -> (na,t,CProdN(loc,bl,c))
-  | CProdN (loc,(na::nal,t)::bl,c) -> (na,t,CProdN(loc,(nal,t)::bl,c))
+let rename na na' t c =
+  match (na,na') with
+    | (_,Name id), (_,Name id') -> (na',t,replace_vars_constr_expr [id,id'] c)
+    | (_,Name id), (_,Anonymous) -> (na,t,c)
+    | _ -> (na',t,c)
+  
+let split_product na' = function
+  | CArrow (loc,t,c) -> (na',t,c)
+  | CProdN (loc,[[na],t],c) -> rename na na' t c
+  | CProdN (loc,([na],t)::bl,c) -> rename na na' t (CProdN(loc,bl,c))
+  | CProdN (loc,(na::nal,t)::bl,c) ->
+      rename na na' t (CProdN(loc,(nal,t)::bl,c))
   | _ -> anomaly "ill-formed fixpoint body"
 
-let concat_binder na t = function
-  | [] -> [[na],t]
-  | (nal,u)::bl' as bl -> if t=u then (na::nal,t)::bl' else ([na],t)::bl
+let merge_binders (na1,ty1) cofun (na2,ty2) codom =
+  let na =
+    match snd na1, snd na2 with
+        Anonymous, Name id ->
+          if occur_var_constr_expr id cofun then
+            failwith "avoid capture"
+          else na2
+      | Name id, Anonymous ->
+          if occur_var_constr_expr id codom then
+            failwith "avoid capture"
+          else na1
+      | Anonymous, Anonymous -> na1
+      | Name id1, Name id2 ->
+          if id1 <> id2 then failwith "not same name" else na1 in
+  let ty =
+    match ty1, ty2 with
+        CHole _, _ -> ty2
+      | _, CHole _ -> ty1
+      | _ ->
+          Constrextern.check_same_type ty1 ty2;
+          ty2 in
+  (LocalRawAssum ([na],ty), codom)
+            
+let rec strip_domain bvar cofun c =
+  match c with
+    | CArrow(loc,a,b) ->
+        merge_binders bvar cofun ((dummy_loc,Anonymous),a) b
+    | CProdN(loc,[([na],ty)],c') ->
+        merge_binders bvar cofun (na,ty) c'
+    | CProdN(loc,([na],ty)::bl,c') ->
+        merge_binders bvar cofun (na,ty) (CProdN(loc,bl,c'))
+    | CProdN(loc,(na::nal,ty)::bl,c') ->
+        merge_binders bvar cofun (na,ty) (CProdN(loc,(nal,ty)::bl,c'))
+    | _ -> failwith "not a product"
+
+(* Note: binder sharing is lost *)
+let rec strip_domains (nal,ty) cofun c =
+  match nal with
+      [] -> assert false
+    | [na] ->
+        let bnd, c' = strip_domain (na,ty) cofun c in
+        ([bnd],None,c')
+    | na::nal ->
+        let f = CLambdaN(dummy_loc,[(nal,ty)],cofun) in
+        let bnd, c1 = strip_domain (na,ty) f c in
+        (try
+          let bl, rest, c2 = strip_domains (nal,ty) cofun c1 in
+          (bnd::bl, rest, c2)
+        with Failure _ -> ([bnd],Some (nal,ty), c1))
+
+(* Re-share binders *)
+let rec factorize_binders = function
+  | ([] | [_] as l) -> l
+  | LocalRawAssum (nal,ty) as d :: (LocalRawAssum (nal',ty')::l as l') ->
+      (try
+	let _ = Constrextern.check_same_type ty ty' in
+	factorize_binders (LocalRawAssum (nal@nal',ty)::l)
+      with _ ->
+	d :: factorize_binders l')
+  | d :: l -> d :: factorize_binders l
+
+(* Extract lambdas when a type constraint occurs *)
+let rec extract_def_binders c ty =
+  match c with
+    | CLambdaN(loc,bvar::lams,b) ->
+        (try
+          let f = CLambdaN(loc,lams,b) in
+          let bvar', rest, ty' = strip_domains bvar f ty in
+          let c' =
+            match rest, lams with
+                None,[] -> b
+              | None, _ -> f
+              | Some bvar,_ -> CLambdaN(loc,bvar::lams,b) in
+          let (bl,c2,ty2) = extract_def_binders c' ty' in
+          (factorize_binders (bvar'@bl), c2, ty2)
+        with Failure _ ->
+          ([],c,ty))
+    | _ -> ([],c,ty)
 
 let rec split_fix n typ def =
   if n = 0 then ([],typ,def)
   else
     let (na,_,def) = split_lambda def in
-    let (_,t,typ) = split_product typ in
+    let (na,t,typ) = split_product na typ in
     let (bl,typ,def) = split_fix (n-1) typ def in
-    (concat_binder na t bl,typ,def)
-
-let pr_fixdecl pr (id,n,bl,t,c) =
-  pr_recursive_decl pr id 
-    (brk (1,2) ++ str "[" ++ pr_local_binders pr bl ++ str "]") t c
+    (LocalRawAssum ([na],t)::bl,typ,def)
+
+let pr_recursive_decl pr pr_dangling dangling_with_for id bl annot t c =
+  let pr_body =
+    if dangling_with_for then pr_dangling else pr in
+  pr_id id ++ str" " ++
+  hov 0 (pr_undelimited_binders (pr ltop) bl ++ annot) ++
+  pr_opt_type_spc pr t ++ str " :=" ++
+  pr_sep_com (fun () -> brk(1,2)) (pr_body ltop) c
+
+let pr_fixdecl pr prd dangling_with_for (id,(n,ro),bl,t,c) =
+  let annot =
+    let ids = names_of_local_assums bl in
+      match ro with
+	  CStructRec ->
+	    if List.length ids > 1 then 
+	      spc() ++ str "{struct " ++ pr_name (snd (List.nth ids n)) ++ str"}"
+	    else mt() 
+	| CWfRec c ->
+	    spc () ++ str "{wf " ++ pr lsimple c ++ pr_name (snd (List.nth ids n)) ++ str"}"
+  in
+    pr_recursive_decl pr prd dangling_with_for id bl annot t c
 
-let pr_cofixdecl pr (id,bl,t,c) =
-  let  b =
-    if bl=[] then mt() else
-      brk(1,2) ++ str"[" ++ pr_local_binders pr bl ++ str "]" in
-  pr_recursive_decl pr id b t c
+let pr_cofixdecl pr prd dangling_with_for (id,bl,t,c) =
+  pr_recursive_decl pr prd dangling_with_for id bl (mt()) t c
 
-let pr_recursive fix pr_decl id = function
+let pr_recursive pr_decl id = function
   | [] -> anomaly "(co)fixpoint with no definition"
-  | d1::dl ->
-      hov 0 (
-	str fix ++ spc () ++ pr_id id ++ brk (1,2) ++ str "{" ++
-	(v 0 (
-	  (hov 0 (pr_decl d1)) ++
-	  (prlist (fun fix -> fnl () ++ hov 0 (str "with" ++ pr_decl fix))
-	    dl))) ++
-	str "}")
+  | [d1] -> pr_decl false d1
+  | dl ->
+      prlist_with_sep (fun () -> fnl() ++ str "with ")
+        (pr_decl true) dl ++
+      fnl() ++ str "for " ++ pr_id id
+
+let is_var id = function
+  | CRef (Ident (_,id')) when id=id' -> true
+  | _ -> false
+
+let tm_clash = function
+  | (CRef (Ident (_,id)), Some (CApp (_,_,nal))) 
+      when List.exists (function CRef (Ident (_,id')),_ -> id=id' | _ -> false)
+	nal
+      -> Some id
+  | (CRef (Ident (_,id)), Some (CAppExpl (_,_,nal))) 
+      when List.exists (function CRef (Ident (_,id')) -> id=id' | _ -> false)
+	nal
+      -> Some id
+  | _ -> None
+
+let pr_case_item pr (tm,(na,indnalopt)) =
+  hov 0 (pr (lcast,E) tm ++
+(*
+  (match na with
+    | Name id when not (is_var id tm) -> spc () ++ str "as " ++  pr_id id
+    | Anonymous when tm_clash (tm,indnalopt) <> None ->
+	(* hide [tm] name to avoid conflicts *)
+	spc () ++ str "as _" (* ++ pr_id (out_some (tm_clash (tm,indnalopt)))*)
+    | _ -> mt ()) ++
+*)
+  (match na with (* Decision of printing "_" or not moved to constrextern.ml *)
+    | Some na -> spc () ++ str "as " ++  pr_name na
+    | None -> mt ()) ++
+  (match indnalopt with
+    | None -> mt ()
+(*
+    | Some (_,ind,nal) ->
+        spc () ++ str "in " ++ 
+        hov 0 (pr_reference ind ++ prlist (pr_arg pr_name) nal))
+*)
+    | Some t -> spc () ++ str "in " ++ pr lsimple t))
 
-let pr_fix pr = pr_recursive "Fix" (pr_fixdecl pr)
-let pr_cofix pr = pr_recursive "CoFix" (pr_cofixdecl pr)
+let pr_case_type pr po =
+  match po with
+    | None | Some (CHole _) -> mt()
+    | Some p ->
+        spc() ++ hov 2 (str "return" ++ pr_sep_com spc (pr lsimple) p)
 
-let rec pr_arrow pr = function
-  | CArrow (_,a,b) -> pr (larrow,L) a ++ cut () ++ str "->" ++ pr_arrow pr b
-  | a -> pr (larrow,E) a
+let pr_return_type pr po = pr_case_type pr po
 
-let pr_annotation pr = function
-  | None -> mt ()
-  | Some t -> str "<" ++ pr ltop t ++ str ">" ++ brk (0,2)
-
-let rec pr_cases_pattern _inh = function
-  | CPatAlias (_,p,x) ->
-      pr_cases_pattern _inh p ++ spc () ++ str "as" ++ spc () ++ pr_id x
-  | CPatCstr (_,c,[]) -> pr_reference c
-  | CPatCstr (_,c,pl) ->
-      hov 0 (
-	str "(" ++ pr_reference c ++ spc () ++ 
-	prlist_with_sep spc (pr_cases_pattern _inh) pl ++ str ")")
-  | CPatAtom (_,Some c) -> pr_reference c
-  | CPatAtom (_,None) -> str "_"
-  | CPatNotation (_,"( _ )",[p]) ->
-      str"("++ pr_cases_pattern _inh p ++ str")"
-  | CPatNotation (_,s,env) -> fst (pr_patnotation pr_cases_pattern s env)
-  | CPatNumeral (_,n) -> Bignat.pr_bigint n
-  | CPatDelimiters (_,key,p) -> pr_delimiters key (pr_cases_pattern _inh p)
-
-let pr_cases_pattern = pr_cases_pattern (0,E) (* level unused *)
-
-let pr_eqn pr (_,patl,rhs) =
-  hov 0 (
-    prlist_with_sep spc pr_cases_pattern patl ++ spc () ++
-    str "=>" ++
-    brk (1,1) ++ pr ltop rhs) ++ spc ()
-
-let pr_cases pr (po,_) tml eqns =
-  hov 0 (
-    pr_annotation pr po ++
-    hv 0 (
-      hv 0 (
-	str "Cases" ++ brk (1,2) ++
-	prlist_with_sep spc (fun (tm,_) -> pr ltop tm) tml ++ spc() ++ str "of") ++ brk(1,2) ++
-      prlist_with_sep (fun () -> str "| ") (pr_eqn pr) eqns ++
-      str "end"))
+let pr_simple_return_type pr na po =
+  (match na with
+    | Some (Name id) ->
+        spc () ++ str "as " ++  pr_id id
+    | _ -> mt ()) ++
+  pr_case_type pr po
 
 let pr_proj pr pr_app a f l =
-  hov 0 (pr (latom,E) a ++ cut() ++ str ".(" ++ pr_app pr f l ++ str ")")
+  hov 0 (pr lsimple a ++ cut() ++ str ".(" ++ pr_app pr f l ++ str ")")
 
-let pr_explapp pr f l =
-  hov 0 (
-    str "!" ++ pr_reference f ++ 
-    prlist (fun a -> brk (1,1) ++ pr (lapp,L) a) l)
+let pr_appexpl pr f l =
+      hov 2 (
+	str "@" ++ pr_reference f ++
+	prlist (pr_sep_com spc (pr (lapp,L))) l)
 
 let pr_app pr a l =
-  hov 0 (
-    pr (lapp,L) a ++ 
-    prlist (fun a -> brk (1,1) ++ pr_expl_args pr a) l)
+  hov 2 (
+    pr (lapp,L) a  ++ 
+    prlist (fun a -> spc () ++ pr_expl_args pr a) l)
 
-let rec pr inherited a =
+let rec pr sep inherited a =
   let (strm,prec) = match a with
   | CRef r -> pr_reference r, latom
-  | CFix (_,id,fix) -> pr_fix pr (snd id) fix, latom
-  | CCoFix (_,id,cofix) -> pr_cofix pr (snd id) cofix, latom
-  | CArrow _ -> hv 0 (pr_arrow pr a), larrow
-  | CProdN (_,bl,a) ->
-      let bll, a = pr_prod_tail pr (mt()) a in
-      hv 1 (
-	hv 1 (str "(" ++ pr_binders pr bl ++ bll ++ str ")") ++
-	brk (0,1) ++ a), lprod
-  | CLambdaN (_,bl,a) ->
-      let bll, a = pr_lambda_tail pr (mt()) a in
-      hv 1 (
-	hv 1 (str "[" ++ pr_binders pr bl ++ bll ++ str "]") ++
-      brk (0,1) ++ a), llambda
-  | CLetIn (_,x,a,b) ->
-      let bll, b = pr_lambda_tail pr (mt()) b in
-      hv 1 (
-	hv 1 (str "[" ++ pr_let_binder pr (snd x) a ++ bll ++ str "]") ++
-	brk (0,1) ++ b), lletin
-  | CAppExpl (_,((* V7 don't know about projections *)_,f),l) ->
-      pr_explapp pr f l, lapp
-  | CApp (_,(_,a),l) ->
-      pr_app pr a l, lapp
-  | CCases (_,po,tml,eqns) ->
-      pr_cases pr po tml eqns, lcases
-  | COrderedCase (_,IfStyle,po,c,[b1;b2]) ->
-      (* On force les parenthèses autour d'un "if" sous-terme (même si le
-	 parsing est lui plus tolérant) *)
+  | CFix (_,id,fix) ->
+      hov 0 (str"fix " ++
+             pr_recursive
+               (pr_fixdecl (pr mt) (pr_dangling_with_for mt)) (snd id) fix),
+      lfix
+  | CCoFix (_,id,cofix) ->
+      hov 0 (str "cofix " ++
+             pr_recursive
+              (pr_cofixdecl (pr mt) (pr_dangling_with_for mt)) (snd id) cofix),
+      lfix
+  | CArrow (_,a,b) ->
+      hov 0 (pr mt (larrow,L) a ++ str " ->" ++
+             pr (fun () ->brk(1,0)) (-larrow,E) b),
+      larrow
+  | CProdN _ ->
+      let (bl,a) = extract_prod_binders a in
       hov 0 (
-	pr_annotation pr po ++
-	hv 0 (
-	  str "if " ++ pr ltop c ++ spc () ++
-	  hov 0 (str "then" ++ brk (1,1) ++ pr ltop b1) ++ spc () ++
-	  hov 0 (str "else" ++ brk (1,1) ++ pr ltop b2))), lif
-  | CLetTuple _ | CIf _ ->
-      error "Let tuple not supported in v7"
-
-  | COrderedCase (_,(MatchStyle|RegularStyle as style),po,c,bl) ->
+	hov 2 (pr_delimited_binders (fun () -> str"forall" ++ spc())
+                 (pr mt ltop) bl) ++
+        str "," ++ pr spc ltop a),
+      lprod
+  | CLambdaN _ ->
+      let (bl,a) = extract_lam_binders a in
       hov 0 (
-	hov 0 (
-	pr_annotation pr po ++
+        hov 2 (pr_delimited_binders (fun () -> str"fun" ++ spc())
+                 (pr mt ltop) bl) ++
+
+        str " =>" ++ pr spc ltop a),
+      llambda
+  | CLetIn (_,(_,Name x),(CFix(_,(_,x'),[_])|CCoFix(_,(_,x'),[_]) as fx), b)
+      when x=x' ->
+      hv 0 (
+        hov 2 (str "let " ++ pr mt ltop fx ++ str " in") ++
+        pr spc ltop b),
+      lletin
+  | CLetIn (_,x,a,b) ->
+      hv 0 (
+        hov 2 (str "let " ++ pr_lname x ++ str " :=" ++
+               pr spc ltop a ++ str " in") ++
+        pr spc ltop b),
+      lletin
+  | CAppExpl (_,(Some i,f),l) ->
+      let l1,l2 = list_chop i l in
+      let c,l1 = list_sep_last l1 in
+      let p = pr_proj (pr mt) pr_appexpl c f l1 in
+      if l2<>[] then
+	p ++ prlist (pr spc (lapp,L)) l2, lapp
+      else
+	p, lproj
+  | CAppExpl (_,(None,Ident (_,var)),[t])
+  | CApp (_,(_,CRef(Ident(_,var))),[t,None])
+        when var = Topconstr.ldots_var ->
+      hov 0 (str ".." ++ pr spc (latom,E) t ++ spc () ++ str ".."), larg
+  | CAppExpl (_,(None,f),l) -> pr_appexpl (pr mt) f l, lapp
+  | CApp (_,(Some i,f),l) ->
+      let l1,l2 = list_chop i l in
+      let c,l1 = list_sep_last l1 in
+      assert (snd c = None);
+      let p = pr_proj (pr mt) pr_app (fst c) f l1 in
+      if l2<>[] then 
+	p ++ prlist (fun a -> spc () ++ pr_expl_args (pr mt) a) l2, lapp
+      else
+	p, lproj
+  | CApp (_,(None,a),l) -> pr_app (pr mt) a l, lapp
+  | CCases (_,rtntypopt,c,eqns) ->
+      v 0
+        (hv 0 (str "match" ++ brk (1,2) ++
 	  hov 0 (
-	    str (if style=RegularStyle then "Case" else "Match") ++ 
-	    brk (1,1) ++ pr ltop c ++ spc () ++
-	    str (if style=RegularStyle then "of" else "with") ++
-	    brk (1,3) ++
-	    fnl () ++ hov 0 (prlist (fun b -> pr ltop b ++ fnl ()) bl) ++
-	    str "end"))), lcases
-  | COrderedCase (_,_,_,_,_) -> 
-      anomaly "malformed if or destructuring let"
-  | CHole _ -> str "?", latom
-(*
-  | CEvar (_,n) -> str "?" ++ int n, latom
-*)
+	    prlist_with_sep sep_v
+              (pr_case_item (pr_dangling_with_for mt)) c
+            ++ pr_case_type (pr_dangling_with_for mt) rtntypopt) ++
+	spc () ++ str "with") ++
+        prlist (pr_eqn (pr mt)) eqns ++ spc() ++ str "end"),
+      latom
+  | CLetTuple (_,nal,(na,po),c,b) ->
+      hv 0 (
+        str "let " ++
+	hov 0 (str "(" ++
+               prlist_with_sep sep_v pr_name nal ++
+               str ")" ++
+	       pr_simple_return_type (pr mt) na po ++ str " :=" ++
+               pr spc ltop c ++ str " in") ++
+        pr spc ltop b),
+      lletin
+  | CIf (_,c,(na,po),b1,b2) ->
+      (* On force les parenthèses autour d'un "if" sous-terme (même si le
+	 parsing est lui plus tolérant) *)
+      hv 0 (
+	hov 1 (str "if " ++ pr mt ltop c ++ pr_simple_return_type (pr mt) na po) ++
+	spc () ++
+	hov 0 (str "then" ++ pr (fun () -> brk (1,1)) ltop b1) ++ spc () ++
+	hov 0 (str "else" ++ pr (fun () -> brk (1,1)) ltop b2)),
+      lif
+     
+  | CHole _ -> str "_", latom
   | CEvar (_,n) -> str (Evd.string_of_existential n), latom
   | CPatVar (_,(_,p)) -> str "?" ++ pr_patvar p, latom
   | CSort (_,s) -> pr_sort s, latom
-  | CCast (_,a,b) ->
-      hv 0 (pr (lcast,L) a ++ cut () ++ str "::" ++ pr (lcast,E) b), lcast
+  | CCast (_,a,_,b) ->
+      hv 0 (pr mt (lcast,L) a ++ cut () ++ str ":" ++ pr mt (-lcast,E) b),
+      lcast
   | CNotation (_,"( _ )",[t]) ->
-      str"("++ pr (max_int,E) t ++ str")", latom
-  | CNotation (_,s,env) -> pr_notation pr s env
-  | CNumeral (_,p) -> Bignat.pr_bigint p, latom
-  | CDelimiters (_,sc,a) -> pr_delimiters sc (pr ltop a), latom
+      pr (fun()->str"(") (max_int,L) t ++ str")", latom
+  | CNotation (_,s,env) -> pr_notation (pr mt) s env
+  | CPrim (_,p) -> pr_prim_token p, prec_of_prim_token p
+  | CDelimiters (_,sc,a) -> pr_delimiters sc (pr mt lsimple a), 1
   | CDynamic _ -> str "<dynamic>", latom
   in
-  if prec_less prec inherited then strm
-  else str"(" ++ strm ++ str")"
-  
-let pr_constr = pr ltop
-
-let pr_pattern = pr_constr
-
-let pr_qualid qid = str (string_of_qualid qid)
-
-open Rawterm
-
-let pr_arg pr x = spc () ++ pr x
+  let loc = constr_loc a in
+  pr_with_comments loc
+    (sep() ++ if prec_less prec inherited then strm else surround strm)
+
+and pr_dangling_with_for sep inherited a =
+  match a with
+  | (CFix (_,_,[_])|CCoFix(_,_,[_])) -> pr sep (latom,E) a
+  | _ -> pr sep inherited a
+
+let pr = pr mt
+
+let rec strip_context n iscast t =
+  if n = 0 then
+    [], if iscast then match t with CCast (_,c,_,_) -> c | _ -> t else t
+  else match t with
+    | CLambdaN (loc,(nal,t)::bll,c) ->
+	let n' = List.length nal in
+	if n' > n then
+	  let nal1,nal2 = list_chop n nal in
+	  [LocalRawAssum (nal1,t)], CLambdaN (loc,(nal2,t)::bll,c)
+	else
+	let bl', c = strip_context (n-n') iscast
+	  (if bll=[] then c else CLambdaN (loc,bll,c)) in
+	LocalRawAssum (nal,t) :: bl', c 
+    | CProdN (loc,(nal,t)::bll,c) ->
+	let n' = List.length nal in
+	if n' > n then
+	  let nal1,nal2 = list_chop n nal in
+	  [LocalRawAssum (nal1,t)], CProdN (loc,(nal2,t)::bll,c)
+	else
+	let bl', c = strip_context (n-n') iscast
+	  (if bll=[] then c else CProdN (loc,bll,c)) in
+	LocalRawAssum (nal,t) :: bl', c 
+    | CArrow (loc,t,c) ->
+	let bl', c = strip_context (n-1) iscast c in
+	LocalRawAssum ([loc,Anonymous],t) :: bl', c 
+    | CCast (_,c,_,_) -> strip_context n false c
+    | CLetIn (_,na,b,c) -> 
+	let bl', c = strip_context (n-1) iscast c in
+	LocalRawDef (na,b) :: bl', c
+    | _ -> anomaly "strip_context"
+
+let pr_constr_expr c = pr lsimple c
+let pr_lconstr_expr c = pr ltop c
+let pr_pattern_expr c = pr lsimple c
+let pr_cases_pattern_expr = pr_patt ltop
+
+let pr_binders = pr_undelimited_binders (pr ltop)
+
+let pr_pattern_occ prc = function
+    ([],c) -> prc c
+  | (nl,c) -> hov 1 (prc c ++ spc() ++ str"at " ++
+                     hov 0 (prlist_with_sep spc int nl))
+
+let pr_unfold_occ pr_ref = function
+    ([],qid) -> pr_ref qid
+  | (nl,qid) -> hov 1 (pr_ref qid ++ spc() ++ str"at " ++
+                       hov 0 (prlist_with_sep spc int nl))
 
 let pr_red_flag pr r =
-  (if r.rBeta then pr_arg str "Beta" else mt ()) ++
-  (if r.rIota then pr_arg str "Iota" else mt ()) ++
-  (if r.rZeta then pr_arg str "Zeta" else mt ()) ++
+  (if r.rBeta then pr_arg str "beta" else mt ()) ++
+  (if r.rIota then pr_arg str "iota" else mt ()) ++
+  (if r.rZeta then pr_arg str "zeta" else mt ()) ++
   (if r.rConst = [] then
-     if r.rDelta then pr_arg str "Delta"
+     if r.rDelta then pr_arg str "delta"
      else mt ()
    else
-     pr_arg str "Delta" ++ (if r.rDelta then str "-" else mt ()) ++
+     pr_arg str "delta " ++ (if r.rDelta then str "-" else mt ()) ++
      hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]"))
 
 open Genarg
 
-let pr_occurrences prc (nl,c) = prlist (fun n -> int n ++ spc ()) nl ++ prc c
+let pr_metaid id = str"?" ++ pr_id id
 
-let pr_red_expr (pr_constr,pr_ref) = function
-  | Red false -> str "Red"
-  | Hnf -> str "Hnf"
-  | Simpl o -> str "Simpl" ++ pr_opt (pr_occurrences pr_constr) o
+let pr_red_expr (pr_constr,pr_lconstr,pr_ref) = function
+  | Red false -> str "red"
+  | Hnf -> str "hnf"
+  | Simpl o -> str "simpl" ++ pr_opt (pr_pattern_occ pr_constr) o  
   | Cbv f ->
       if f = {rBeta=true;rIota=true;rZeta=true;rDelta=true;rConst=[]} then
-	str "Compute"
+	str "compute"
       else
-	hov 1 (str "Cbv" ++ spc () ++ pr_red_flag pr_ref f)
+	hov 1 (str "cbv" ++ pr_red_flag pr_ref f)
   | Lazy f -> 
-      hov 1 (str "Lazy" ++ spc () ++ pr_red_flag pr_ref f)
+      hov 1 (str "lazy" ++ pr_red_flag pr_ref f)
   | Unfold l ->
-      hov 1 (str "Unfold" ++
-        prlist (fun (nl,qid) ->
-	  prlist (pr_arg int) nl ++ spc () ++ pr_ref qid) l)
-  | Fold l -> hov 1 (str "Fold" ++ prlist (pr_arg pr_constr) l)
-  | Pattern l -> hov 1 (str "Pattern " ++ prlist (pr_occurrences pr_constr) l)
+      hov 1 (str "unfold" ++ spc() ++
+             prlist_with_sep pr_coma (pr_unfold_occ pr_ref) l)
+  | Fold l -> hov 1 (str "fold" ++ prlist (pr_arg pr_constr) l)
+  | Pattern l ->
+      hov 1 (str "pattern" ++
+        pr_arg (prlist_with_sep pr_coma (pr_pattern_occ pr_constr)) l)
+        
   | Red true -> error "Shouldn't be accessible from user"
   | ExtraRedExpr s -> str s
+  | CbvVm -> str "vm_compute"
 
-let rec pr_may_eval pr pr2 = function
+let rec pr_may_eval test prc prlc pr2 = function
   | ConstrEval (r,c) ->
       hov 0
-        (str "Eval" ++ brk (1,1) ++ pr_red_expr (pr,pr2) r ++
-	 spc () ++ str "in" ++ brk (1,1) ++ pr c)
+        (str "eval" ++ brk (1,1) ++
+         pr_red_expr (prc,prlc,pr2) r ++
+	 str " in" ++ spc() ++ prc c)
   | ConstrContext ((_,id),c) ->
       hov 0
-	(str "Inst " ++ brk (1,1) ++ pr_id id ++ spc () ++
-	 str "[" ++ pr c ++ str "]")
-  | ConstrTypeOf c -> hov 0 (str "Check " ++ brk (1,1) ++ pr c)
-  | ConstrTerm c -> pr c
+	(str "context " ++ pr_id id ++ spc () ++
+	 str "[" ++ prlc c ++ str "]")
+  | ConstrTypeOf c -> hov 1 (str "type of" ++ spc() ++ prc c)
+  | ConstrTerm c when test c -> h 0 (str "(" ++ prc c ++ str ")")
+  | ConstrTerm c -> prc c
 
-let pr_rawconstr c = pr_constr (Constrextern.extern_rawconstr Idset.empty c)
+let pr_may_eval a = pr_may_eval (fun _ -> false) a
diff --git a/parsing/ppconstr.mli b/parsing/ppconstr.mli
index 039cd745..7441f130 100644
--- a/parsing/ppconstr.mli
+++ b/parsing/ppconstr.mli
@@ -1,3 +1,4 @@
+
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
 (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
@@ -5,8 +6,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-
-(*i $Id: ppconstr.mli,v 1.7.2.2 2005/01/21 17:19:37 herbelin Exp $ i*)
+ 
+(*i $Id: ppconstr.mli 7907 2006-01-21 11:03:29Z herbelin $ i*)
 
 open Pp
 open Environ
@@ -14,28 +15,55 @@ open Term
 open Libnames
 open Pcoq
 open Rawterm
-open Extend
-open Coqast
 open Topconstr
 open Names
 open Util
+open Genarg
+
+val extract_lam_binders :
+  constr_expr -> local_binder list * constr_expr
+val extract_prod_binders :
+  constr_expr -> local_binder list * constr_expr
+val extract_def_binders :
+  constr_expr -> constr_expr ->
+  local_binder list * constr_expr * constr_expr
+val split_fix :
+  int -> constr_expr -> constr_expr -> 
+  local_binder list *  constr_expr * constr_expr
+
+val prec_less : int -> int * Ppextend.parenRelation -> bool
+ 
+val pr_tight_coma : unit -> std_ppcmds
 
-val split_fix : int -> constr_expr -> constr_expr -> 
-  (name located list * constr_expr) list * constr_expr * constr_expr
+val pr_located : ('a -> std_ppcmds) -> 'a located -> std_ppcmds
+val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
+val pr_metaid : identifier -> std_ppcmds
 
-val pr_global : Idset.t -> global_reference -> std_ppcmds
+val pr_lident : identifier located -> std_ppcmds
+val pr_lname : name located -> std_ppcmds
 
-val pr_opt : ('a -> std_ppcmds) -> 'a option -> std_ppcmds
+val pr_with_comments : loc -> std_ppcmds -> std_ppcmds
+val pr_com_at : int -> std_ppcmds
+val pr_sep_com :
+  (unit -> std_ppcmds) ->
+  (constr_expr -> std_ppcmds) ->
+  constr_expr -> std_ppcmds
+
+val pr_id : identifier -> std_ppcmds
 val pr_name : name -> std_ppcmds
 val pr_qualid : qualid -> std_ppcmds
+
 val pr_red_expr :
-  ('a -> std_ppcmds) * ('b -> std_ppcmds) ->
+  ('a -> std_ppcmds) * ('a -> std_ppcmds) *  ('b -> std_ppcmds) ->
     ('a,'b) red_expr_gen -> std_ppcmds
-val pr_occurrences : ('a -> std_ppcmds) -> 'a occurrences -> std_ppcmds
+val pr_may_eval :
+  ('a -> std_ppcmds) -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) ->
+    ('a,'b) may_eval -> std_ppcmds
 
 val pr_sort : rawsort -> std_ppcmds
-val pr_pattern : Tacexpr.pattern_expr -> std_ppcmds
-val pr_constr : constr_expr -> std_ppcmds
-val pr_cases_pattern : cases_pattern_expr -> std_ppcmds
-val pr_may_eval : ('a -> std_ppcmds) -> ('b -> std_ppcmds) -> ('a,'b) may_eval -> std_ppcmds
-val pr_rawconstr : rawconstr -> std_ppcmds
+
+val pr_binders : local_binder list -> std_ppcmds
+val pr_pattern_expr : Tacexpr.pattern_expr -> std_ppcmds
+val pr_constr_expr : constr_expr -> std_ppcmds
+val pr_lconstr_expr : constr_expr -> std_ppcmds
+val pr_cases_pattern_expr : cases_pattern_expr -> std_ppcmds
diff --git a/parsing/pptactic.ml b/parsing/pptactic.ml
index 4103ea00..e6c12f4f 100644
--- a/parsing/pptactic.ml
+++ b/parsing/pptactic.ml
@@ -6,69 +6,64 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pptactic.ml,v 1.54.2.5 2005/12/23 22:16:46 herbelin Exp $ *)
+(* $Id: pptactic.ml 8651 2006-03-21 21:54:43Z jforest $ *)
 
 open Pp
 open Names
 open Nameops
 open Util
-open Extend
 open Tacexpr
 open Rawterm
 open Topconstr
 open Genarg
 open Libnames
 open Pattern
+open Ppextend
+open Ppconstr
+open Printer
 
-let pr_red_expr = Ppconstr.pr_red_expr
-let pr_may_eval = Ppconstr.pr_may_eval
-let pr_sort = Ppconstr.pr_sort
-let pr_global x =
-  if Options.do_translate () then (* for pr_gen *)
-    Ppconstrnew.pr_global Idset.empty x
-  else
-    Ppconstr.pr_global Idset.empty x
-let pr_name = Ppconstr.pr_name
-let pr_opt = Ppconstr.pr_opt
-let pr_occurrences = Ppconstr.pr_occurrences
+let pr_global x = Nametab.pr_global_env Idset.empty x
 
 type grammar_terminals = string option list
 
   (* Extensions *)
-let prtac_tab_v7 = Hashtbl.create 17
 let prtac_tab = Hashtbl.create 17
 
-let declare_extra_tactic_pprule for_v8 s (tags,prods) =
-  Hashtbl.add prtac_tab_v7 (s,tags) prods;
-  if for_v8 then Hashtbl.add prtac_tab (s,tags) prods
+let declare_extra_tactic_pprule (s,tags,prods) =
+  Hashtbl.add prtac_tab (s,tags) prods
 
-let exists_extra_tactic_pprule s tags = Hashtbl.mem prtac_tab_v7 (s,tags)
+let exists_extra_tactic_pprule s tags = Hashtbl.mem prtac_tab (s,tags)
 
 type 'a raw_extra_genarg_printer =
-    (constr_expr -> std_ppcmds) -> (raw_tactic_expr -> std_ppcmds) ->
-      'a -> std_ppcmds
+    (constr_expr -> std_ppcmds) -> 
+    (constr_expr -> std_ppcmds) -> 
+    (tolerability -> raw_tactic_expr -> std_ppcmds) ->
+    'a -> std_ppcmds
+
 type 'a glob_extra_genarg_printer =
-    (rawconstr_and_expr -> std_ppcmds) -> (glob_tactic_expr -> std_ppcmds) ->
-      'a -> std_ppcmds
+    (rawconstr_and_expr -> std_ppcmds) ->
+    (rawconstr_and_expr -> std_ppcmds) ->
+    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
+    'a -> std_ppcmds
+
 type 'a extra_genarg_printer =
-    (Term.constr -> std_ppcmds) -> (glob_tactic_expr -> std_ppcmds) ->
-      'a -> std_ppcmds
+    (Term.constr -> std_ppcmds) -> 
+    (Term.constr -> std_ppcmds) -> 
+    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
+    'a -> std_ppcmds
 
-let genarg_pprule_v7 = ref Stringmap.empty
 let genarg_pprule = ref Stringmap.empty
 
-let declare_extra_genarg_pprule for_v8 (rawwit, f) (globwit, g) (wit, h) =
+let declare_extra_genarg_pprule (rawwit, f) (globwit, g) (wit, h) =
   let s = match unquote wit with
     | ExtraArgType s -> s 
     | _ -> error
 	"Can declare a pretty-printing rule only for extra argument types"
   in
-  let f prc prtac x = f prc prtac (out_gen rawwit x) in
-  let g prc prtac x = g prc prtac (out_gen globwit x) in
-  let h prc prtac x = h prc prtac (out_gen wit x) in
-  genarg_pprule_v7 := Stringmap.add s (f,g,h) !genarg_pprule_v7;
-  if for_v8 then
-    genarg_pprule := Stringmap.add s (f,g,h) !genarg_pprule 
+  let f prc prlc prtac x = f prc prlc prtac (out_gen rawwit x) in
+  let g prc prlc prtac x = g prc prlc prtac (out_gen globwit x) in
+  let h prc prlc prtac x = h prc prlc prtac (out_gen wit x) in
+  genarg_pprule := Stringmap.add s (f,g,h) !genarg_pprule
 
 let pr_arg pr x = spc () ++ pr x
 
@@ -84,14 +79,10 @@ let pr_and_short_name pr (c,_) = pr c
 
 let pr_located pr (loc,x) = pr x
 
-let pr_ltac_constant sp = pr_qualid (Nametab.shortest_qualid_of_tactic sp)
-
 let pr_evaluable_reference = function 
   | EvalVarRef id -> pr_id id
   | EvalConstRef sp -> pr_global (Libnames.ConstRef sp)
 
-let pr_inductive ind = pr_global (Libnames.IndRef ind)
-
 let pr_quantified_hypothesis = function
   | AnonHyp n -> int n
   | NamedHyp id -> pr_id id 
@@ -108,12 +99,7 @@ let pr_bindings prc prlc = function
       prlist_with_sep spc prc l
   | ExplicitBindings l ->
       brk (1,1) ++ str "with" ++ brk (1,1) ++ 
-        prlist_with_sep spc
-          (fun b -> if Options.do_translate () or not !Options.v7 then
-	    str"(" ++ pr_binding prlc b ++ str")" 
-	   else
-	    pr_binding prc b)
-        l
+        prlist_with_sep spc (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
   | NoBindings -> mt ()
 
 let pr_bindings_no_with prc prlc = function
@@ -122,21 +108,11 @@ let pr_bindings_no_with prc prlc = function
       prlist_with_sep spc prc l
   | ExplicitBindings l ->
       brk (1,1) ++ 
-        prlist_with_sep spc
-          (fun b -> if Options.do_translate () or not !Options.v7 then
-	    str"(" ++ pr_binding prlc b ++ str")" 
-	   else
-	    pr_binding prc b)
-        l
+        prlist_with_sep spc (fun b -> str"(" ++ pr_binding prlc b ++ str")") l
   | NoBindings -> mt ()
 
 let pr_with_bindings prc prlc (c,bl) =
-  if Options.do_translate () then
-    (* translator calls pr_with_bindings on rawconstr: we cast it! *)
-    let bl' = Ppconstrnew.translate_with_bindings (fst (Obj.magic c) : rawconstr) bl in
-    prc c ++ hv 0 (pr_bindings prc prlc bl')
-  else
-    prc c ++ hv 0 (pr_bindings prc prlc bl)
+  prc c ++ hv 0 (pr_bindings prc prlc bl)
 
 let pr_with_constr prc = function
   | None -> mt ()
@@ -146,109 +122,10 @@ let pr_with_names = function
   | None -> mt ()
   | Some ipat -> spc () ++ hov 1 (str "as" ++ spc () ++ pr_intro_pattern ipat)
 
-let pr_hyp_location pr_id = function
-  | id, _, (InHyp,_) -> spc () ++ pr_id id
-  | id, _, (InHypTypeOnly,_) ->
-      spc () ++ str "(Type of " ++ pr_id id ++ str ")"
-  | id, _, _ -> error "Unsupported hyp location in v7"
-
-let pr_clause pr_id = function
-  | [] -> mt ()
-  | l -> spc () ++ hov 0 (str "in" ++ prlist (pr_hyp_location pr_id) l)
-
-
-let pr_clauses pr_id cls =
-  match cls with
-      { onhyps = Some l; onconcl = false } ->
-        spc () ++ hov 0 (str "in" ++ prlist (pr_hyp_location pr_id) l)
-    | { onhyps = Some []; onconcl = true } -> mt()
-    | _ -> error "this clause has both hypothesis and conclusion"
-
-let pr_simple_clause pr_id = function
-  | [] -> mt ()
-  | l -> spc () ++
-      hov 0 (str "in" ++ spc () ++ prlist_with_sep spc pr_id l)
-
-let pr_clause_pattern pr_id cls =
-  pr_opt
-    (prlist (fun (id,occs,_) ->
-      prlist (pr_arg int) occs ++ spc () ++ pr_id id)) cls.onhyps ++
-  if cls.onconcl then
-    prlist (pr_arg int) cls.concl_occs ++ spc() ++ str"Goal"
-  else mt()
-
-let pr_subterms pr occl =
-  hov 0 (pr_occurrences pr occl ++ spc () ++ str "with")
-
-let pr_induction_arg prc = function
-  | ElimOnConstr c -> prc c
-  | ElimOnIdent (_,id) -> pr_id id
-  | ElimOnAnonHyp n -> int n
-
-let pr_induction_kind = function
-  | SimpleInversion -> str "Simple Inversion"
-  | FullInversion -> str "Inversion"
-  | FullInversionClear -> str "Inversion_clear"
-
-let pr_match_pattern pr_pat = function
-  | Term a -> pr_pat a
-  | Subterm (None,a) -> str "[" ++ pr_pat a ++ str "]"
-  | Subterm (Some id,a) -> pr_id id ++ str "[" ++ pr_pat a ++ str "]"
-
-let pr_match_hyps pr_pat = function
-  | Hyp ((_,na),mp) -> pr_name na ++ str ":" ++ pr_match_pattern pr_pat mp
-
-let pr_match_rule m pr_pat pr = function
-  | Pat ([],mp,t) when m ->
-      str "[" ++ pr_match_pattern pr_pat mp ++ str "]"
-      ++ spc () ++ str "->" ++ brk (1,2) ++ pr t
-  | Pat (rl,mp,t) ->
-      str "[" ++ prlist_with_sep pr_semicolon
-                   (pr_match_hyps pr_pat) rl ++ spc () ++ 
-      str "|-" ++ spc () ++ pr_match_pattern pr_pat mp ++ spc () ++ str "]" ++
-      spc () ++ str "->" ++ brk (1,2) ++ pr t
-  | All t -> str "_" ++ spc () ++ str "->" ++ brk (1,2) ++ pr t
-
-let pr_funvar = function
-  | None -> spc () ++ str "()"
-  | Some id -> spc () ++ pr_id id
-
-let pr_let_clause k pr = function
-  | ((_,id),None,t) -> hv 0(str k ++ pr_id id ++ str " =" ++ brk (1,1) ++ pr t)
-  | ((_,id),Some c,t) -> str "TODO(LETCLAUSE)"
-
-let pr_let_clauses pr = function
-  | hd::tl ->
-      hv 0
-        (pr_let_clause "Let " pr hd ++
-         prlist (fun t -> spc () ++ pr_let_clause "And " pr t) tl)
-  | [] -> anomaly "LetIn must declare at least one binding"
-
-let pr_rec_clause pr ((_,id),(l,t)) =
-  pr_id id ++ prlist pr_funvar l ++ str "->" ++ spc () ++ pr t
-
-let pr_rec_clauses pr l = 
-  prlist_with_sep (fun () -> fnl () ++ str "And ") (pr_rec_clause pr) l
-
-let pr_hintbases = function
-  | None -> spc () ++ str "with *"
-  | Some [] -> mt ()
-  | Some l ->
-      spc () ++ str "with" ++ hv 0 (prlist (fun s -> spc () ++ str s) l)
-
-let pr_autoarg_adding = function
-  | [] -> mt ()
-  | l ->
-      spc () ++ str "Adding [" ++
-        hv 0 (prlist_with_sep spc pr_reference l) ++ str "]"
-
-let pr_autoarg_destructing = function
-  | true -> spc () ++ str "Destructing"
-  | false -> mt ()
-
-let pr_autoarg_usingTDB = function
-  | true -> spc () ++ str "Using TDB"
-  | false -> mt ()
+let rec pr_message_token prid = function
+  | MsgString s -> qs s
+  | MsgInt n -> int n
+  | MsgIdent id -> prid id
 
 let rec pr_raw_generic prc prlc prtac prref x =
   match Genarg.genarg_tag x with
@@ -259,24 +136,20 @@ let rec pr_raw_generic prc prlc prtac prref x =
   | PreIdentArgType -> pr_arg str (out_gen rawwit_pre_ident x)
   | IntroPatternArgType -> pr_arg pr_intro_pattern 
       (out_gen rawwit_intro_pattern x)
-  | IdentArgType -> pr_arg pr_id ((*Constrextern.v7_to_v8_id*) (out_gen rawwit_ident x))
-  | HypArgType -> pr_arg
-      (pr_located (fun id -> pr_id (Constrextern.v7_to_v8_id id))) (out_gen rawwit_var x)
+  | IdentArgType -> pr_arg pr_id (out_gen rawwit_ident x)
+  | VarArgType -> pr_arg (pr_located pr_id) (out_gen rawwit_var x)
   | RefArgType -> pr_arg prref (out_gen rawwit_ref x)
   | SortArgType -> pr_arg pr_sort (out_gen rawwit_sort x)
   | ConstrArgType -> pr_arg prc (out_gen rawwit_constr x)
   | ConstrMayEvalArgType ->
-      pr_arg (pr_may_eval prc prref)
+      pr_arg (pr_may_eval prc prlc prref)
         (out_gen rawwit_constr_may_eval x)
   | QuantHypArgType ->
       pr_arg pr_quantified_hypothesis (out_gen rawwit_quant_hyp x)
   | RedExprArgType ->
-      pr_arg (pr_red_expr 
-        (prc,prref)) (out_gen rawwit_red_expr x)
-  | TacticArgType -> pr_arg prtac (out_gen rawwit_tactic x)
-  | OpenConstrArgType -> pr_arg prc (snd (out_gen rawwit_open_constr x))
-  | CastedOpenConstrArgType ->
-      pr_arg prc (snd (out_gen rawwit_casted_open_constr x))
+      pr_arg (pr_red_expr (prc,prlc,prref)) (out_gen rawwit_red_expr x)
+  | TacticArgType n -> pr_arg (prtac (n,E)) (out_gen (rawwit_tactic n) x)
+  | OpenConstrArgType b -> pr_arg prc (snd (out_gen (rawwit_open_constr_gen b) x))
   | ConstrWithBindingsArgType -> 
       pr_arg (pr_with_bindings prc prlc) (out_gen rawwit_constr_with_bindings x)
   | BindingsArgType -> 
@@ -293,10 +166,7 @@ let rec pr_raw_generic prc prlc prtac prref x =
             pr_raw_generic prc prlc prtac prref b)
 	  x)
   | ExtraArgType s -> 
-      let tab =
-	if Options.do_translate() or not !Options.v7 then !genarg_pprule
-        else !genarg_pprule_v7 in
-      try pi1 (Stringmap.find s tab) prc prtac x
+      try pi1 (Stringmap.find s !genarg_pprule) prc prlc prtac x
       with Not_found -> str " [no printer for " ++ str s ++ str "] "
 
 
@@ -309,23 +179,22 @@ let rec pr_glob_generic prc prlc prtac x =
   | PreIdentArgType -> pr_arg str (out_gen globwit_pre_ident x)
   | IntroPatternArgType ->
       pr_arg pr_intro_pattern (out_gen globwit_intro_pattern x)
-  | IdentArgType -> pr_arg pr_id ((*Constrextern.v7_to_v8_id*) (out_gen globwit_ident x))
-  | HypArgType -> pr_arg (pr_located (fun id -> pr_id (Constrextern.v7_to_v8_id id))) (out_gen globwit_var x)
+  | IdentArgType -> pr_arg pr_id (out_gen globwit_ident x)
+  | VarArgType -> pr_arg (pr_located pr_id) (out_gen globwit_var x)
   | RefArgType -> pr_arg (pr_or_var (pr_located pr_global)) (out_gen globwit_ref x)
   | SortArgType -> pr_arg pr_sort (out_gen globwit_sort x)
   | ConstrArgType -> pr_arg prc (out_gen globwit_constr x)
   | ConstrMayEvalArgType ->
-      pr_arg (pr_may_eval prc
+      pr_arg (pr_may_eval prc prlc
         (pr_or_var (pr_and_short_name pr_evaluable_reference))) (out_gen globwit_constr_may_eval x)
   | QuantHypArgType ->
       pr_arg pr_quantified_hypothesis (out_gen globwit_quant_hyp x)
   | RedExprArgType ->
       pr_arg (pr_red_expr 
-        (prc,pr_or_var (pr_and_short_name pr_evaluable_reference))) (out_gen globwit_red_expr x)
-  | TacticArgType -> pr_arg prtac (out_gen globwit_tactic x)
-  | OpenConstrArgType -> pr_arg prc (snd (out_gen globwit_open_constr x))
-  | CastedOpenConstrArgType ->
-      pr_arg prc (snd (out_gen globwit_casted_open_constr x))
+        (prc,prlc,pr_or_var (pr_and_short_name pr_evaluable_reference)))
+        (out_gen globwit_red_expr x)
+  | TacticArgType n -> pr_arg (prtac (n,E)) (out_gen (globwit_tactic n) x)
+  | OpenConstrArgType b -> pr_arg prc (snd (out_gen (globwit_open_constr_gen b) x))
   | ConstrWithBindingsArgType -> 
       pr_arg (pr_with_bindings prc prlc) (out_gen globwit_constr_with_bindings x)
   | BindingsArgType -> 
@@ -342,10 +211,7 @@ let rec pr_glob_generic prc prlc prtac x =
             pr_glob_generic prc prlc prtac b)
 	  x)
   | ExtraArgType s -> 
-      let tab =
-	if Options.do_translate() or not !Options.v7 then !genarg_pprule
-        else !genarg_pprule_v7 in
-      try pi2 (Stringmap.find s tab) prc prtac x
+      try pi2 (Stringmap.find s !genarg_pprule) prc prlc prtac x
       with Not_found -> str " [no printer for " ++ str s ++ str "] "
 
 open Closure
@@ -359,8 +225,8 @@ let rec pr_generic prc prlc prtac x =
   | PreIdentArgType -> pr_arg str (out_gen wit_pre_ident x)
   | IntroPatternArgType -> 
       pr_arg pr_intro_pattern (out_gen wit_intro_pattern x)
-  | IdentArgType -> pr_arg pr_id (Constrextern.v7_to_v8_id (out_gen wit_ident x))
-  | HypArgType -> pr_arg prc (out_gen wit_var x)
+  | IdentArgType -> pr_arg pr_id (out_gen wit_ident x)
+  | VarArgType -> pr_arg pr_id (out_gen wit_var x)
   | RefArgType -> pr_arg pr_global (out_gen wit_ref x)
   | SortArgType -> pr_arg prc (Term.mkSort (out_gen wit_sort x))
   | ConstrArgType -> pr_arg prc (out_gen wit_constr x)
@@ -369,11 +235,10 @@ let rec pr_generic prc prlc prtac x =
   | QuantHypArgType ->
       pr_arg pr_quantified_hypothesis (out_gen wit_quant_hyp x)
   | RedExprArgType ->
-      pr_arg (pr_red_expr (prc,pr_evaluable_reference)) (out_gen wit_red_expr x)
-  | TacticArgType -> pr_arg prtac (out_gen wit_tactic x)
-  | OpenConstrArgType -> pr_arg prc (snd (out_gen wit_open_constr x))
-  | CastedOpenConstrArgType ->
-      pr_arg prc (snd (out_gen wit_casted_open_constr x))
+      pr_arg (pr_red_expr (prc,prlc,pr_evaluable_reference)) 
+        (out_gen wit_red_expr x)
+  | TacticArgType n -> pr_arg (prtac (n,E)) (out_gen (wit_tactic n) x)
+  | OpenConstrArgType b -> pr_arg prc (snd (out_gen (wit_open_constr_gen b) x))
   | ConstrWithBindingsArgType -> 
       pr_arg (pr_with_bindings prc prlc) (out_gen wit_constr_with_bindings x)
   | BindingsArgType -> 
@@ -390,10 +255,7 @@ let rec pr_generic prc prlc prtac x =
             pr_generic prc prlc prtac b)
 	  x)
   | ExtraArgType s -> 
-      let tab = 
-	if Options.do_translate() or not !Options.v7 then !genarg_pprule
-        else !genarg_pprule_v7 in
-      try pi3 (Stringmap.find s tab) prc prtac x
+      try pi3 (Stringmap.find s !genarg_pprule) prc prlc prtac x
       with Not_found -> str " [no printer for " ++ str s ++ str "]"
 
 let rec pr_tacarg_using_rule pr_gen = function
@@ -402,364 +264,735 @@ let rec pr_tacarg_using_rule pr_gen = function
   | [], [] -> mt ()
   | _ -> failwith "Inconsistent arguments of extended tactic"
 
-let pr_extend_gen prgen s l =
-  let tab = 
-    if Options.do_translate() or not !Options.v7 then prtac_tab
-    else prtac_tab_v7
-  in
+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
-    (* Hack pour les syntaxes changeant non uniformément en passant a la V8 *)
-    let s =
-      let n = String.length s in
-      if Options.do_translate() & n > 2 & String.sub s (n-2) 2 = "v7"
-      then String.sub s 0 (n-2) ^ "v8"
-      else s in
-    let (s,pl) = Hashtbl.find tab (s,tags) in
-    str s ++ pr_tacarg_using_rule prgen (pl,l)
+    let (lev',pl) = Hashtbl.find prtac_tab (s,tags) in
+    let p = pr_tacarg_using_rule prgen (pl,l) in
+    if lev' > lev then surround p else p
   with Not_found ->
     str s ++ prlist prgen l ++ str " (* Generic printer *)"
 
-let make_pr_tac (pr_tac,pr_tac0,pr_constr,pr_pat,pr_cst,pr_ind,pr_ref,pr_ident,pr_extend) =
+let pr_raw_extend prc prlc prtac = 
+  pr_extend_gen (pr_raw_generic prc prlc prtac pr_reference)
+let pr_glob_extend prc prlc prtac =
+  pr_extend_gen (pr_glob_generic prc prlc prtac)
+let pr_extend prc prlc prtac =
+  pr_extend_gen (pr_generic prc prlc prtac)
+
+(**********************************************************************)
+(* The tactic printer                                                 *)
+
+let sep_v = fun _ -> str"," ++ spc()
+
+let strip_prod_binders_expr n ty =
+  let rec strip_ty acc n ty =
+    match ty with
+        Topconstr.CProdN(_,bll,a) ->
+          let nb =
+            List.fold_left (fun i (nal,_) -> i + List.length nal) 0 bll in
+          if nb >= n then (List.rev (bll@acc), a)
+          else strip_ty (bll@acc) (n-nb) a
+      | Topconstr.CArrow(_,a,b) ->
+          if n=1 then
+            (List.rev (([(dummy_loc,Anonymous)],a)::acc), b)
+          else strip_ty (([(dummy_loc,Anonymous)],a)::acc) (n-1) b
+      | _ -> error "Cannot translate fix tactic: not enough products" in
+  strip_ty [] n ty
+
+let pr_ltac_or_var pr = function
+  | ArgArg x -> pr x
+  | ArgVar (loc,id) -> pr_with_comments loc (pr_id id)
+
+let pr_arg pr x = spc () ++ pr x
+
+let pr_ltac_constant sp =
+  pr_qualid (Nametab.shortest_qualid_of_tactic sp)
+
+let pr_evaluable_reference_env env = function 
+  | EvalVarRef id -> pr_id id
+  | EvalConstRef sp -> 
+      Nametab.pr_global_env (Termops.vars_of_env env) (Libnames.ConstRef sp)
+
+let pr_inductive env ind =
+  Nametab.pr_global_env (Termops.vars_of_env env) (Libnames.IndRef ind)
+
+let pr_quantified_hypothesis = function
+  | AnonHyp n -> int n
+  | NamedHyp id -> pr_id id 
+
+let pr_quantified_hypothesis_arg h = spc () ++ pr_quantified_hypothesis h
+
+let pr_esubst prc l =
+  let pr_qhyp = function
+      (_,AnonHyp n,c) -> str "(" ++ int n ++ str" := " ++ prc c ++ str ")"
+    | (_,NamedHyp id,c) ->
+        str "(" ++ pr_id id ++ str" := " ++ prc c ++ str ")"
+  in
+  prlist_with_sep spc pr_qhyp l
+
+let pr_bindings_gen for_ex prlc prc = function
+  | ImplicitBindings l ->
+      spc () ++
+      hv 2 ((if for_ex then mt() else str "with" ++ spc ()) ++
+            prlist_with_sep spc prc l)
+  | ExplicitBindings l ->
+      spc () ++
+      hv 2 ((if for_ex then mt() else str "with" ++ spc ()) ++
+            pr_esubst prlc l)
+  | NoBindings -> mt ()
+
+let pr_bindings prlc prc = pr_bindings_gen false prlc prc
+
+let pr_with_bindings prlc prc (c,bl) =
+  hov 1 (prc c ++ pr_bindings prlc prc bl)
+
+let pr_with_constr prc = function
+  | None -> mt ()
+  | Some c -> spc () ++ hov 1 (str "with" ++ spc () ++ prc c)
+
+let pr_with_names = function
+  | IntroAnonymous -> mt ()
+  | ipat -> spc () ++ hov 1 (str "as" ++ spc () ++ pr_intro_pattern ipat)
+
+let pr_pose prlc prc na c = match na with
+  | Anonymous -> spc() ++ prc c
+  | Name id -> spc() ++ surround (pr_id id ++ str " :=" ++ spc() ++ prlc c)
+
+let pr_assertion _prlc prc ipat c = match ipat with
+(* Use this "optimisation" or use only the general case ?
+  | IntroIdentifier id ->
+      spc() ++ surround (pr_intro_pattern ipat ++ str " :" ++ spc() ++ prlc c)
+*)
+  | ipat ->
+      spc() ++ prc c ++ pr_with_names ipat
+
+let pr_assumption prlc prc ipat c = match ipat with
+(* Use this "optimisation" or use only the general case ?
+  | IntroIdentifier id ->
+      spc() ++ surround (pr_intro_pattern ipat ++ str " :" ++ spc() ++ prlc c)
+*)
+  | ipat ->
+      spc() ++ prc c ++ pr_with_names ipat
+
+let pr_by_tactic prt = function
+  | TacId [] -> mt ()
+  | tac -> spc() ++ str "by " ++ prt tac
+
+let pr_occs pp = function
+    [] -> pp
+  | nl -> hov 1 (pp ++ spc() ++ str"at " ++
+                 hov 0 (prlist_with_sep spc int nl))
+
+let pr_hyp_location pr_id = function
+  | id, occs, InHyp -> spc () ++ pr_occs (pr_id id) occs
+  | id, occs, InHypTypeOnly ->
+      spc () ++ pr_occs (str "(type of " ++ pr_id id ++ str ")") occs
+  | id, occs, InHypValueOnly ->
+      spc () ++ pr_occs (str "(value of " ++ pr_id id ++ str ")") occs
+
+let pr_in pp = spc () ++ hov 0 (str "in" ++ pp)
+
+let pr_simple_clause pr_id = function
+  | [] -> mt ()
+  | l -> pr_in (spc () ++ prlist_with_sep spc pr_id l)
+
+let pr_clauses pr_id = function
+    { onhyps=None; onconcl=true; concl_occs=nl } ->
+      pr_in (pr_occs (str " *") nl)
+  | { onhyps=None; onconcl=false } -> pr_in (str " * |-")
+  | { onhyps=Some l; onconcl=true; concl_occs=nl } -> 
+      pr_in (prlist_with_sep (fun () -> str",") (pr_hyp_location pr_id) l
+             ++ pr_occs (str" |- *") nl)
+  | { onhyps=Some l; onconcl=false } ->
+      pr_in (prlist_with_sep (fun()->str",") (pr_hyp_location pr_id) l)
+
+let pr_clause_pattern pr_id = function
+  | (None, []) -> mt ()
+  | (glopt,l) ->
+      str " in" ++
+      prlist
+        (fun (id,nl) -> prlist (pr_arg int) nl 
+	  ++ spc () ++ pr_id id) l ++
+        pr_opt (fun nl -> prlist_with_sep spc int nl ++ str " Goal") glopt
+
+let pr_induction_arg prc = function
+  | ElimOnConstr c -> prc c
+  | ElimOnIdent (loc,id) -> pr_with_comments loc (pr_id id)
+  | ElimOnAnonHyp n -> int n
+
+let pr_induction_kind = function
+  | SimpleInversion -> str "simple inversion"
+  | FullInversion -> str "inversion"
+  | FullInversionClear -> str "inversion_clear"
+
+let pr_lazy lz = if lz then str "lazy " else mt ()
+
+let pr_match_pattern pr_pat = function
+  | Term a -> pr_pat a
+  | Subterm (None,a) -> str "context [" ++ pr_pat a ++ str "]"
+  | Subterm (Some id,a) ->
+      str "context " ++ pr_id id ++ str "[" ++ pr_pat a ++ str "]"
+
+let pr_match_hyps pr_pat = function
+  | Hyp (nal,mp) -> pr_lname nal ++ str ":" ++ pr_match_pattern pr_pat mp
+
+let pr_match_rule m pr pr_pat = function
+  | Pat ([],mp,t) when m ->
+      pr_match_pattern pr_pat mp ++
+      spc () ++ str "=>" ++ brk (1,4) ++ pr t
+  | Pat (rl,mp,t) ->
+      prlist_with_sep (fun () -> str",") (pr_match_hyps pr_pat) rl ++
+      spc () ++ str "|-" ++ spc () ++ pr_match_pattern pr_pat mp ++ spc () ++
+      str "=>" ++ brk (1,4) ++ pr t
+  | All t -> str "_" ++ spc () ++ str "=>" ++ brk (1,4) ++ pr t
+
+let pr_funvar = function
+  | None -> spc () ++ str "_"
+  | Some id -> spc () ++ pr_id id
+
+let pr_let_clause k pr = function
+  | (id,None,t) ->
+      hov 0 (str k ++ pr_lident id ++ str " :=" ++ brk (1,1) ++
+             pr (TacArg t))
+  | (id,Some c,t) ->
+      hv 0 (str k ++ pr_lident id ++ str" :" ++ brk(1,2) ++
+      pr c ++
+      str " :=" ++ brk (1,1) ++ pr (TacArg t))
+
+let pr_let_clauses pr = function
+  | hd::tl ->
+      hv 0
+        (pr_let_clause "let " pr hd ++
+         prlist (fun t -> spc () ++ pr_let_clause "with " pr t) tl)
+  | [] -> anomaly "LetIn must declare at least one binding"
+
+let pr_rec_clause pr (id,(l,t)) =
+  hov 0
+    (pr_lident id ++ prlist pr_funvar l ++ str " :=") ++ spc () ++ pr t
+
+let pr_rec_clauses pr l = 
+  prlist_with_sep (fun () -> fnl () ++ str "with ") (pr_rec_clause pr) l
+
+let pr_seq_body pr tl =
+  hv 0 (str "[ " ++
+        prlist_with_sep (fun () -> spc () ++ str "| ") pr tl ++
+        str " ]")
+
+let pr_hintbases = function
+  | None -> spc () ++ str "with *"
+  | Some [] -> mt ()
+  | Some l ->
+      spc () ++ hov 2 (str "with" ++ prlist (fun s -> spc () ++ str s) l)
+
+let pr_auto_using prc = function
+  | [] -> mt ()
+  | l -> spc () ++ 
+      hov 2 (str "using" ++ spc () ++ prlist_with_sep pr_coma prc l)
+
+let pr_autoarg_adding = function
+  | [] -> mt ()
+  | l ->
+      spc () ++ str "adding [" ++
+        hv 0 (prlist_with_sep spc pr_reference l) ++ str "]"
+
+let pr_autoarg_destructing = function
+  | true -> spc () ++ str "destructing"
+  | false -> mt ()
+
+let pr_autoarg_usingTDB = function
+  | true -> spc () ++ str "using tdb"
+  | false -> mt ()
+
+let rec pr_tacarg_using_rule pr_gen = function
+  | Egrammar.TacTerm s :: l, al -> spc () ++ str s ++ pr_tacarg_using_rule pr_gen (l,al)
+  | Egrammar.TacNonTerm _ :: l, a :: al -> pr_gen a ++ pr_tacarg_using_rule pr_gen (l,al)
+  | [], [] -> mt ()
+  | _ -> failwith "Inconsistent arguments of extended tactic"
+
+let pr_then () = str ";"
 
-let pr_bindings = pr_bindings pr_constr pr_constr in
-let pr_bindings_no_with = pr_bindings_no_with pr_constr pr_constr in
-let pr_with_bindings = pr_with_bindings pr_constr pr_constr in
-let pr_eliminator cb = str "using" ++ pr_arg (pr_with_bindings) cb in
-let pr_constrarg c = spc () ++ pr_constr c in
+let ltop = (5,E)
+let lseq = 5
+let ltactical = 3
+let lorelse = 2
+let llet = 1
+let lfun = 1
+let lcomplete = 1
+let labstract = 3
+let lmatch = 1
+let latom = 0
+let lcall = 1
+let leval = 1
+let ltatom = 1
+
+let level_of (n,p) = match p with E -> n | L -> n-1 | Prec n -> n | Any -> lseq
+
+open Closure
+
+let make_pr_tac 
+  (pr_tac_level,pr_constr,pr_lconstr,pr_pat,
+   pr_cst,pr_ind,pr_ref,pr_ident,
+   pr_extend,strip_prod_binders) =
+
+let pr_bindings env =
+  pr_bindings (pr_lconstr env) (pr_constr env) in
+let pr_ex_bindings env =
+  pr_bindings_gen true (pr_lconstr env) (pr_constr env) in
+let pr_with_bindings env =
+  pr_with_bindings (pr_lconstr env) (pr_constr env) in
+let pr_eliminator env cb =
+  str "using" ++ pr_arg (pr_with_bindings env) cb in
+let pr_extend env =
+  pr_extend (pr_constr env) (pr_lconstr env) (pr_tac_level env) in
+let pr_red_expr env = 
+  pr_red_expr (pr_constr env,pr_lconstr env,pr_cst env) in
+
+let pr_constrarg env c = spc () ++ pr_constr env c in
+let pr_lconstrarg env c = spc () ++ pr_lconstr env c in
 let pr_intarg n = spc () ++ int n in
 
+let pr_binder_fix env (nal,t) =
+(*  match t with
+  | CHole _ -> spc() ++ prlist_with_sep spc (pr_lname) nal
+  | _ ->*)
+    let s =
+      prlist_with_sep spc (pr_lname) nal ++ str ":" ++
+      pr_lconstr env t in
+    spc() ++ hov 1 (str"(" ++ s ++ str")") in
+
+let pr_fix_tac env (id,n,c) =
+  let rec set_nth_name avoid n = function
+      (nal,ty)::bll ->
+        if n <= List.length nal then
+          match list_chop (n-1) nal with
+              _, (_,Name id) :: _ -> id, (nal,ty)::bll
+            | bef, (loc,Anonymous) :: aft ->
+                let id = next_ident_away_from (id_of_string"y") avoid in
+                id, ((bef@(loc,Name id)::aft, ty)::bll)
+            | _ -> assert false
+        else
+          let (id,bll') = set_nth_name avoid (n-List.length nal) bll in
+          (id,(nal,ty)::bll')
+    | [] -> assert false in
+  let (bll,ty) = strip_prod_binders n c in
+  let names =
+    List.fold_left
+      (fun ln (nal,_) -> List.fold_left
+          (fun ln na -> match na with (_,Name id) -> id::ln | _ -> ln)
+          ln nal)
+      [] bll in
+  let idarg,bll = set_nth_name names n bll in
+  let annot =
+    if List.length names = 1 then mt()
+    else spc() ++ str"{struct " ++ pr_id idarg ++ str"}" in
+  hov 1 (str"(" ++ pr_id id ++ 
+        prlist (pr_binder_fix env) bll ++ annot ++ str" :" ++
+        pr_lconstrarg env ty ++ str")") in
+(*  spc() ++
+  hov 0 (pr_id id ++ pr_intarg n ++ str":" ++ pr_constrarg
+    env c)
+*)
+let pr_cofix_tac env (id,c) =
+  hov 1 (str"(" ++ pr_id id ++ str" :" ++ pr_lconstrarg env c ++ str")") in
+
   (* Printing tactics as arguments *)
-let rec pr_atom0 = function
-  | TacIntroPattern [] -> str "Intros"
-  | TacIntroMove (None,None) -> str "Intro"
-  | TacAssumption -> str "Assumption"
-  | TacAnyConstructor None -> str "Constructor"
-  | TacTrivial (Some []) -> str "Trivial"
-  | TacAuto (None,Some []) -> str "Auto"
-  | TacAutoTDB None -> str "AutoTDB"
-  | TacDestructConcl -> str "DConcl"
-  | TacReflexivity -> str "Reflexivity"
-  | t -> str "(" ++ pr_atom1 t ++ str ")"
+let rec pr_atom0 env = function
+  | TacIntroPattern [] -> str "intros"
+  | TacIntroMove (None,None) -> str "intro"
+  | TacAssumption -> str "assumption"
+  | TacAnyConstructor None -> str "constructor"
+  | TacTrivial ([],Some []) -> str "trivial"
+  | TacAuto (None,[],Some []) -> str "auto"
+  | TacReflexivity -> str "reflexivity"
+  | t -> str "(" ++ pr_atom1 env t ++ str ")"
 
   (* Main tactic printer *)
-and pr_atom1 = function
-  | TacExtend (_,s,l) -> pr_extend pr_constr pr_constr pr_tac s l
-  | TacAlias (_,s,l,_) ->
-      pr_extend pr_constr pr_constr pr_tac s (List.map snd l)
+and pr_atom1 env = function
+  | TacAutoTDB _ | TacDestructHyp _ | TacDestructConcl
+  | TacSuperAuto _ | TacExtend (_,
+    ("GTauto"|"GIntuition"|"TSimplif"|
+     "LinearIntuition"),_) ->
+      errorlabstrm "Obsolete V8" (str "Tactic is not ported to V8.0")
+  | TacExtend (loc,s,l) ->
+      pr_with_comments loc (pr_extend env 1 s l)
+  | TacAlias (loc,s,l,_) ->
+      pr_with_comments loc (pr_extend env 1 s (List.map snd l))
 
   (* Basic tactics *)
-  | TacIntroPattern [] as t -> pr_atom0 t
+  | TacIntroPattern [] as t -> pr_atom0 env t
   | TacIntroPattern (_::_ as p) -> 
-      hov 1 (str "Intros" ++ spc () ++ prlist_with_sep spc pr_intro_pattern p)
+      hov 1 (str "intros" ++ spc () ++ prlist_with_sep spc pr_intro_pattern p)
   | TacIntrosUntil h ->
-      hv 1 (str "Intros until" ++ pr_arg pr_quantified_hypothesis h)
-  | TacIntroMove (None,None) as t -> pr_atom0 t
-  | TacIntroMove (Some id1,None) -> str "Intro " ++ pr_id id1
-  | TacIntroMove (ido1,Some (_,id2)) ->
+      hv 1 (str "intros until" ++ pr_arg pr_quantified_hypothesis h)
+  | TacIntroMove (None,None) as t -> pr_atom0 env t
+  | TacIntroMove (Some id1,None) -> str "intro " ++ pr_id id1
+  | TacIntroMove (ido1,Some id2) ->
       hov 1
-      (str "Intro" ++ pr_opt pr_id ido1 ++ spc () ++ str "after " ++ pr_id id2)
-  | TacAssumption as t -> pr_atom0 t
-  | TacExact c -> hov 1 (str "Exact" ++ pr_arg pr_constr c)
-  | TacApply cb -> hov 1 (str "Apply" ++ spc () ++ pr_with_bindings cb)
+      (str "intro" ++ pr_opt pr_id ido1 ++ spc () ++ str "after " ++
+       pr_lident id2)
+  | TacAssumption as t -> pr_atom0 env t
+  | TacExact c -> hov 1 (str "exact" ++ pr_constrarg env c)
+  | TacExactNoCheck c -> hov 1 (str "exact_no_check" ++ pr_constrarg env c)
+  | TacApply cb -> hov 1 (str "apply" ++ spc () ++ pr_with_bindings env cb)
   | TacElim (cb,cbo) ->
-      hov 1 (str "Elim" ++ pr_arg pr_with_bindings cb ++ 
-        pr_opt pr_eliminator cbo)
-  | TacElimType c -> hov 1 (str "ElimType" ++ pr_arg pr_constr c)
-  | TacCase cb -> hov 1 (str "Case" ++ spc () ++ pr_with_bindings cb)
-  | TacCaseType c -> hov 1 (str "CaseType" ++ pr_arg pr_constr c)
-  | TacFix (ido,n) -> hov 1 (str "Fix" ++ pr_opt pr_id ido ++ pr_intarg n)
+      hov 1 (str "elim" ++ pr_arg (pr_with_bindings env) cb ++ 
+        pr_opt (pr_eliminator env) cbo)
+  | TacElimType c -> hov 1 (str "elimtype" ++ pr_constrarg env c)
+  | TacCase cb -> hov 1 (str "case" ++ spc () ++ pr_with_bindings env cb)
+  | TacCaseType c -> hov 1 (str "casetype" ++ pr_constrarg env c)
+  | TacFix (ido,n) -> hov 1 (str "fix" ++ pr_opt pr_id ido ++ pr_intarg n)
   | TacMutualFix (id,n,l) ->
-      hov 1 (str "Fix" ++ spc () ++ pr_id id ++ pr_intarg n ++ spc () ++
-        hov 0 (str "with" ++ brk (1,1) ++
-          prlist_with_sep spc
-	    (fun (id,n,c) ->
-	      spc () ++ pr_id id ++ pr_intarg n ++ pr_arg pr_constr c)
-	  l))
-  | TacCofix ido -> hov 1 (str "Cofix" ++ pr_opt pr_id ido)
+      hov 1 (str "fix" ++ spc () ++ pr_id id ++ pr_intarg n ++ spc() ++
+             str"with " ++ prlist_with_sep spc (pr_fix_tac env) l)
+  | TacCofix ido -> hov 1 (str "cofix" ++ pr_opt pr_id ido)
   | TacMutualCofix (id,l) ->
-      hov 1 (str "Cofix" ++ spc () ++ pr_id id ++ spc () ++
-        hov 0 (str "with" ++ brk (1,1) ++
-          prlist (fun (id,c) -> spc () ++ pr_id id ++ pr_arg pr_constr c)
-	  l))
-  | TacCut c -> hov 1 (str "Cut" ++ pr_arg pr_constr c)
-  | TacTrueCut (Anonymous,c) -> 
-      hov 1 (str "Assert" ++ pr_arg pr_constr c)
-  | TacTrueCut (Name id,c) -> 
-      hov 1 (str "Assert" ++ spc () ++ pr_id id ++ str ":" ++ pr_constr c)
-  | TacForward (false,na,c) ->
-      hov 1 (str "Assert" ++ pr_arg pr_name na ++ str ":=" ++ pr_constr c)
-  | TacForward (true,na,c) ->
-      hov 1 (str "Pose" ++ pr_arg pr_name na ++ str ":=" ++ pr_constr c)
+      hov 1 (str "cofix" ++ spc () ++ pr_id id ++ spc() ++
+             str"with " ++ prlist_with_sep spc (pr_cofix_tac env) l)
+  | TacCut c -> hov 1 (str "cut" ++ pr_constrarg env c)
+  | TacAssert (Some tac,ipat,c) -> 
+      hov 1 (str "assert" ++ 
+             pr_assumption (pr_lconstr env) (pr_constr env) ipat c ++ 
+             pr_by_tactic (pr_tac_level env ltop) tac)
+  | TacAssert (None,ipat,c) -> 
+      hov 1 (str "pose proof" ++
+             pr_assertion (pr_lconstr env) (pr_constr env) ipat c)
   | TacGeneralize l ->
-      hov 1 (str "Generalize" ++ spc () ++ prlist_with_sep spc pr_constr l)
+      hov 1 (str "generalize" ++ spc () ++
+             prlist_with_sep spc (pr_constr env) l)
   | TacGeneralizeDep c ->
-      hov 1 (str "Generalize" ++ spc () ++ str "Dependent" ++ spc () ++
-      pr_constr c)
+      hov 1 (str "generalize" ++ spc () ++ str "dependent" ++
+             pr_constrarg env c)
+  | TacLetTac (na,c,cl) when cl = nowhere ->
+      hov 1 (str "pose" ++ pr_pose (pr_lconstr env) (pr_constr env) na c)
   | TacLetTac (na,c,cl) ->
-      let pcl = match cl with
-          {onhyps=None;onconcl=true;concl_occs=[]} -> mt()
-        | _ -> pr_clauses pr_ident cl in
-      hov 1 (str "LetTac" ++ spc () ++ pr_name na ++ str ":=" ++
-             pr_constr c ++ pcl)
-  | TacInstantiate (n,c,cls) ->
-      hov 1 (str "Instantiate" ++ pr_arg int n ++ pr_arg pr_constr c ++ 
-	     pr_clauses pr_ident cls)
+      hov 1 (str "set" ++ pr_pose (pr_lconstr env) (pr_constr env) na c ++
+             pr_clauses pr_ident cl)
+(*  | TacInstantiate (n,c,ConclLocation ()) ->
+      hov 1 (str "instantiate" ++ spc() ++
+             hov 1 (str"(" ++ pr_arg int n ++ str" :=" ++
+                    pr_lconstrarg env c ++ str ")" ))
+  | TacInstantiate (n,c,HypLocation (id,hloc)) ->
+      hov 1 (str "instantiate" ++ spc() ++
+             hov 1 (str"(" ++ pr_arg int n ++ str" :=" ++
+                    pr_lconstrarg env c ++ str ")" ) 
+	     ++ str "in" ++ pr_hyp_location pr_ident (id,[],(hloc,ref None)))
+*)
   (* Derived basic tactics *)
-  | TacSimpleInduction (h,_) ->
-      hov 1 (str "Induction" ++ pr_arg pr_quantified_hypothesis h)
-  | TacNewInduction (h,e,(ids,_)) ->
-      hov 1 (str "NewInduction" ++ spc () ++ pr_induction_arg pr_constr h ++
-        pr_opt pr_eliminator e ++ pr_with_names ids)
+  | TacSimpleInduction h ->
+      hov 1 (str "simple induction" ++ pr_arg pr_quantified_hypothesis h)
+  | TacNewInduction (h,e,ids) ->
+      hov 1 (str "induction" ++ spc () ++
+	     prlist_with_sep spc (pr_induction_arg (pr_constr env)) h ++
+             pr_opt (pr_eliminator env) e)
   | TacSimpleDestruct h ->
-      hov 1 (str "Destruct" ++ pr_arg pr_quantified_hypothesis h)
-  | TacNewDestruct (h,e,(ids,_)) ->
-      hov 1 (str "NewDestruct" ++ spc () ++ pr_induction_arg pr_constr h ++
-        pr_opt pr_eliminator e ++ pr_with_names ids)
+      hov 1 (str "simple destruct" ++ pr_arg pr_quantified_hypothesis h)
+  | TacNewDestruct (h,e,ids) ->
+      hov 1 (str "destruct" ++ spc () ++
+             prlist_with_sep spc (pr_induction_arg (pr_constr env)) h ++ 
+	     pr_with_names ids ++
+             pr_opt (pr_eliminator env) e)
   | TacDoubleInduction (h1,h2) ->
       hov 1
-        (str "Double Induction" ++ 
+        (str "double induction" ++  
          pr_arg pr_quantified_hypothesis h1 ++
  	 pr_arg pr_quantified_hypothesis h2)
   | TacDecomposeAnd c ->
-      hov 1 (str "Decompose Record" ++ pr_arg pr_constr c)
+      hov 1 (str "decompose record" ++ pr_constrarg env c)
   | TacDecomposeOr c ->
-      hov 1 (str "Decompose Sum" ++ pr_arg pr_constr c)
+      hov 1 (str "decompose sum" ++ pr_constrarg env c)
   | TacDecompose (l,c) ->
-      hov 1 (str "Decompose" ++ spc () ++
-        hov 0 (str "[" ++ prlist_with_sep spc pr_ind l
-	  ++ str "]" ++ pr_arg pr_constr c))
+      hov 1 (str "decompose" ++ spc () ++
+        hov 0 (str "[" ++ prlist_with_sep spc (pr_ind env) l
+	  ++ str "]" ++ pr_constrarg env c))
   | TacSpecialize (n,c) ->
-      hov 1 (str "Specialize" ++ pr_opt int n ++ pr_with_bindings c)
+      hov 1 (str "specialize" ++ spc () ++ pr_opt int n ++ 
+             pr_with_bindings env c)
   | TacLApply c -> 
-      hov 1 (str "LApply" ++ pr_constr c)
+      hov 1 (str "lapply" ++ pr_constrarg env c)
 
   (* Automation tactics *)
-  | TacTrivial (Some []) as x -> pr_atom0 x
-  | TacTrivial db -> hov 0 (str "Trivial" ++ pr_hintbases db)
-  | TacAuto (None,Some []) as x -> pr_atom0 x
-  | TacAuto (n,db) ->
-      hov 0 (str "Auto" ++ pr_opt (pr_or_var int) n ++ pr_hintbases db)
-  | TacAutoTDB None as x -> pr_atom0 x
-  | TacAutoTDB (Some n) -> hov 0 (str "AutoTDB" ++ spc () ++ int n)
-  | TacDestructHyp (true,(_,id)) -> hov 0 (str "CDHyp" ++ spc () ++ pr_id id)
-  | TacDestructHyp (false,(_,id)) -> hov 0 (str "DHyp" ++ spc () ++ pr_id id)
-  | TacDestructConcl as x -> pr_atom0 x
-  | TacSuperAuto (n,l,b1,b2) ->
-      hov 1 (str "SuperAuto" ++ pr_opt int n ++ pr_autoarg_adding l ++ 
-             pr_autoarg_destructing b1 ++ pr_autoarg_usingTDB b2)
+  | TacTrivial ([],Some []) as x -> pr_atom0 env x
+  | TacTrivial (lems,db) ->
+      hov 0 (str "trivial" ++ 
+             pr_auto_using (pr_constr env) lems ++ pr_hintbases db)
+  | TacAuto (None,[],Some []) as x -> pr_atom0 env x
+  | TacAuto (n,lems,db) ->
+      hov 0 (str "auto" ++ pr_opt (pr_or_var int) n ++ 
+             pr_auto_using (pr_constr env) lems ++ pr_hintbases db)
   | TacDAuto (n,p) ->
-      hov 1 (str "Auto" ++ pr_opt (pr_or_var int) n ++ str "Decomp" ++ 
-      pr_opt int p)
+      hov 1 (str "auto" ++ pr_opt (pr_or_var int) n ++ str "decomp" ++ pr_opt int p)
 
   (* Context management *)
-  | TacClear l ->
-      hov 1 (str "Clear" ++ spc () ++ prlist_with_sep spc pr_ident l)
+  | TacClear (keep,l) ->
+      hov 1 (str "clear" ++ spc () ++ (if keep then str "- " else mt ()) ++
+             prlist_with_sep spc pr_ident l)
   | TacClearBody l ->
-      hov 1 (str "ClearBody" ++ spc () ++ prlist_with_sep spc pr_ident l)
+      hov 1 (str "clearbody" ++ spc () ++ prlist_with_sep spc pr_ident l)
   | TacMove (b,id1,id2) ->
       (* Rem: only b = true is available for users *)
       assert b;
       hov 1
-        (str "Move" ++ brk (1,1) ++ pr_ident id1 ++ spc () ++ 
+        (str "move" ++ brk (1,1) ++ pr_ident id1 ++ spc () ++ 
 	 str "after" ++ brk (1,1) ++ pr_ident id2)
   | TacRename (id1,id2) ->
       hov 1
-        (str "Rename" ++ brk (1,1) ++ pr_ident id1 ++ spc () ++ 
+        (str "rename" ++ brk (1,1) ++ pr_ident id1 ++ spc () ++ 
 	 str "into" ++ brk (1,1) ++ pr_ident id2)
 
   (* Constructors *)
-  | TacLeft l -> hov 1 (str "Left" ++ pr_bindings l)
-  | TacRight l -> hov 1 (str "Right" ++ pr_bindings l)
-  | TacSplit (_,l) -> hov 1 (str "Split" ++ pr_bindings l)
+  | TacLeft l -> hov 1 (str "left" ++ pr_bindings env l)
+  | TacRight l -> hov 1 (str "right" ++ pr_bindings env l)
+  | TacSplit (false,l) -> hov 1 (str "split" ++ pr_bindings env l)
+  | TacSplit (true,l) -> hov 1 (str "exists" ++ pr_ex_bindings env l)
   | TacAnyConstructor (Some t) ->
-      hov 1 (str "Constructor" ++ pr_arg pr_tac0 t)
-  | TacAnyConstructor None as t -> pr_atom0 t
+      hov 1 (str "constructor" ++ pr_arg (pr_tac_level env (latom,E)) t)
+  | TacAnyConstructor None as t -> pr_atom0 env t
   | TacConstructor (n,l) ->
-      hov 1 (str "Constructor" ++ pr_or_metaid pr_intarg n ++ pr_bindings l)
+      hov 1 (str "constructor" ++ pr_or_metaid pr_intarg n ++ pr_bindings env l)
 
   (* Conversion *)  
   | TacReduce (r,h) ->
-      hov 1 (pr_red_expr (pr_constr,pr_cst) r ++ pr_clauses pr_ident h)
-  | TacChange (occl,c,h) ->
-      hov 1 (str "Change" ++ pr_opt (pr_subterms pr_constr) occl ++ 
-        brk (1,1) ++ pr_constr c ++ pr_clauses pr_ident h)
+      hov 1 (pr_red_expr env r ++
+             pr_clauses pr_ident h)
+  | TacChange (occ,c,h) ->
+      hov 1 (str "change" ++ brk (1,1) ++
+      (match occ with
+          None -> mt()
+        | Some([],c1) -> hov 1 (pr_constr env c1 ++ spc() ++ str "with ")
+        | Some(ocl,c1) ->
+            hov 1 (pr_constr env c1 ++ spc() ++
+	           str "at " ++ prlist_with_sep spc int ocl) ++ spc() ++
+	           str "with ") ++
+      pr_constr env c ++ pr_clauses pr_ident h)
 
   (* Equivalence relations *)
-  | TacReflexivity as x -> pr_atom0 x
-  | TacSymmetry cls -> str "Symmetry " ++ pr_clauses pr_ident cls
-  | TacTransitivity c -> str "Transitivity" ++ pr_arg pr_constr c
+  | TacReflexivity as x -> pr_atom0 env x
+  | TacSymmetry cls -> str "symmetry " ++ pr_clauses pr_ident cls
+  | TacTransitivity c -> str "transitivity" ++ pr_constrarg env c
 
   (* Equality and inversion *)
   | TacInversion (DepInversion (k,c,ids),hyp) ->
-      hov 1 (str "Dependent " ++ pr_induction_kind k ++ 
+      hov 1 (str "dependent " ++ pr_induction_kind k ++ spc () ++
       pr_quantified_hypothesis hyp ++
-      pr_with_names ids ++ pr_with_constr pr_constr c)
+      pr_with_names ids ++ pr_with_constr (pr_constr env) c)
   | TacInversion (NonDepInversion (k,cl,ids),hyp) ->
       hov 1 (pr_induction_kind k ++ spc () ++
       pr_quantified_hypothesis hyp ++
       pr_with_names ids ++ pr_simple_clause pr_ident cl)
   | TacInversion (InversionUsing (c,cl),hyp) ->
-      hov 1 (str "Inversion" ++ spc() ++ pr_quantified_hypothesis hyp ++ 
-      str "using" ++ spc () ++ pr_constr c ++ 
+      hov 1 (str "inversion" ++ spc() ++ pr_quantified_hypothesis hyp ++ 
+      spc () ++ str "using" ++ spc () ++ pr_constr env c ++ 
       pr_simple_clause pr_ident cl)
 
-and pr_tactic_seq_body tl = 
-  hv 0 (str "[ " ++
-        prlist_with_sep (fun () -> spc () ++ str "| ") prtac tl ++ str " ]")
-
-  (* Strictly closed atomic tactic expressions *)
-and pr0 = function
-  | TacFirst tl -> str "First" ++ spc () ++ pr_tactic_seq_body tl
-  | TacSolve tl -> str "Solve" ++ spc () ++ pr_tactic_seq_body tl
-  | TacId "" -> str "Idtac" 
-  | TacFail (ArgArg 0,"") -> str "Fail"
-  | TacAtom (_,t) -> pr_atom0 t
-  | TacArg c -> pr_tacarg c
-  | t -> str "(" ++ prtac t ++ str ")"
-
-  (* Semi-closed atomic tactic expressions *)
-and pr1 = function
-  | TacAtom (_,t) -> pr_atom1 t
-  | TacId s -> str "Idtac \"" ++ str s ++ str "\""	
-  | TacFail (ArgArg 0,s) -> str "Fail \"" ++ str s ++ str "\""
-  | TacFail (n,"") -> str "Fail " ++ pr_or_var int n
-  | TacFail (n,s) -> str "Fail " ++ pr_or_var int n ++ str " \"" ++ str s ++ str "\""
-  | t -> pr0 t
-
-  (* Orelse tactic expressions (printed as if parsed associating on the right
-     though the semantics is purely associative) *)
-and pr2 = function
-  | TacOrelse (t1,t2) ->
-      hov 1 (pr1 t1 ++ str " Orelse" ++ brk (1,1) ++ pr3 t2)
-  | t -> pr1 t
-
-  (* Non closed prefix tactic expressions *)
-and pr3 = function
-  | TacTry t -> hov 1 (str "Try" ++ spc () ++ pr3 t)
-  | TacDo (n,t) -> hov 1 (str "Do " ++ pr_or_var int n ++ spc () ++ pr3 t)
-  | TacRepeat t -> hov 1 (str "Repeat" ++ spc () ++ pr3 t)
-  | TacProgress t -> hov 1 (str "Progress" ++ spc () ++ pr3 t)
-  | TacInfo t -> hov 1 (str "Info" ++ spc () ++ pr3 t)
-  | t -> pr2 t
-
-and pr4 = function
-  | t -> pr3 t
-
-  (* THEN and THENS tactic expressions (printed as if parsed
-     associating on the left though the semantics is purely associative) *)
-and pr5 = function
-  | TacThens (t,tl) -> 
-      hov 1 (pr5 t ++ str ";" ++ spc () ++ pr_tactic_seq_body tl)
-  | TacThen (t1,t2) ->
-      hov 1 (pr5 t1 ++ str ";" ++ spc () ++ pr4 t2)
-  | t -> pr4 t
-
-  (* Ltac tactic expressions *)
-and pr6 = function
-  |(TacAtom _
-  | TacThen _
-  | TacThens _
-  | TacFirst _
-  | TacSolve _
-  | TacTry _
-  | TacOrelse _
-  | TacDo _
-  | TacRepeat _
-  | TacProgress _
-  | TacId _
-  | TacFail _
-  | TacInfo _) as t -> pr5 t
-
-  | TacAbstract (t,None) -> str "Abstract " ++ pr6 t
+in
+
+let rec pr_tac env inherited tac =
+  let (strm,prec) = match tac with
+  | TacAbstract (t,None) ->
+      str "abstract " ++ pr_tac env (labstract,L) t, labstract
   | TacAbstract (t,Some s) -> 
       hov 0
-       (str "Abstract " ++ pr6 t ++ spc () ++ str "using" ++ spc () ++ pr_id s)
+       (str "abstract (" ++ pr_tac env (labstract,L) t ++ str")" ++ spc () ++
+        str "using " ++ pr_id s),
+      labstract
   | TacLetRecIn (l,t) -> 
       hv 0
-        (str "Rec " ++ pr_rec_clauses prtac l ++
-        spc () ++ str "In" ++ fnl () ++ prtac t)
+        (str "let rec " ++ pr_rec_clauses (pr_tac env ltop) l ++ str " in" ++
+         fnl () ++ pr_tac env (llet,E) t),
+      llet
   | TacLetIn (llc,u) ->
       v 0
-       (hv 0 (pr_let_clauses pr_tacarg0 llc ++ spc () ++ str "In") ++ fnl () ++ prtac u)
-  | TacMatch (t,lrul) ->
-      hov 0 (str "Match" ++ spc () ++ pr6 t ++ spc()
-        ++ str "With"
+       (hv 0 (pr_let_clauses (pr_tac env ltop) llc
+       ++ str " in") ++
+       fnl () ++ pr_tac env (llet,E) u),
+      llet
+  | TacMatch (lz,t,lrul) ->
+      hov 0 (pr_lazy lz ++ str "match " ++ pr_tac env ltop t ++ str " with"
         ++ prlist
-	  (fun r -> fnl () ++ str "|" ++ spc () ++
-            pr_match_rule true pr_pat prtac r)
-	lrul)
-  | TacMatchContext (lr,lrul) ->
-      hov 0 (
-	str (if lr then "Match Reverse Context With" else "Match Context With")
+	  (fun r -> fnl () ++ str "| " ++
+            pr_match_rule true (pr_tac env ltop) pr_pat r)
+	lrul
+        ++ fnl() ++ str "end"),
+      lmatch
+  | TacMatchContext (lz,lr,lrul) ->
+      hov 0 (pr_lazy lz ++ 
+	str (if lr then "match reverse goal with" else "match goal with")
 	++ prlist
-	  (fun r -> fnl () ++ str "|" ++ spc () ++
-            pr_match_rule false pr_pat prtac r)
-	lrul)
+	  (fun r -> fnl () ++ str "| " ++
+            pr_match_rule false (pr_tac env ltop) pr_pat r)
+	lrul
+        ++ fnl() ++ str "end"),
+      lmatch
   | TacFun (lvar,body) ->
-      hov 0 (str "Fun" ++
-        prlist pr_funvar lvar ++ spc () ++ str "->" ++ spc () ++ prtac body)
-
-  | TacArg c -> pr_tacarg c
-
-and pr_tacarg0 = function
-  | TacDynamic (_,t) -> str ("<dynamic ["^(Dyn.tag t)^"]>")
-  | MetaIdArg (_,s) -> str ("$" ^ s)
-  | IntroPattern ipat -> pr_intro_pattern ipat
+(*      let env = List.fold_right (option_fold_right Idset.add) lvar env in*)
+      hov 2 (str "fun" ++
+        prlist pr_funvar lvar ++ str " =>" ++ spc () ++
+        pr_tac env (lfun,E) body),
+      lfun
+  | TacThens (t,tl) -> 
+      hov 1 (pr_tac env (lseq,E) t ++ pr_then () ++ spc () ++
+             pr_seq_body (pr_tac env ltop) tl),
+      lseq
+  | TacThen (t1,t2) ->
+      hov 1 (pr_tac env (lseq,E) t1 ++ pr_then () ++ spc () ++
+             pr_tac env (lseq,L) t2),
+      lseq
+  | TacTry t ->
+      hov 1 (str "try" ++ spc () ++ pr_tac env (ltactical,E) t),
+      ltactical
+  | TacDo (n,t) ->
+      hov 1 (str "do " ++ pr_or_var int n ++ spc () ++ 
+             pr_tac env (ltactical,E) t),
+      ltactical
+  | TacRepeat t ->
+      hov 1 (str "repeat" ++ spc () ++ pr_tac env (ltactical,E) t),
+      ltactical
+  | TacProgress t ->
+      hov 1 (str "progress" ++ spc () ++ pr_tac env (ltactical,E) t),
+      ltactical
+  | TacInfo t ->
+      hov 1 (str "info" ++ spc () ++ pr_tac env (ltactical,E) t),
+      ltactical
+  | TacOrelse (t1,t2) ->
+      hov 1 (pr_tac env (lorelse,L) t1 ++ str " ||" ++ brk (1,1) ++
+             pr_tac env (lorelse,E) t2),
+      lorelse
+  | TacFail (n,l) -> 
+      str "fail" ++ (if n=ArgArg 0 then mt () else pr_arg (pr_or_var int) n) ++
+      prlist (pr_arg (pr_message_token pr_ident)) l, latom
+  | TacFirst tl ->
+      str "first" ++ spc () ++ pr_seq_body (pr_tac env ltop) tl, llet
+  | TacSolve tl ->
+      str "solve" ++ spc () ++ pr_seq_body (pr_tac env ltop) tl, llet
+  | TacComplete t ->
+      str "complete" ++ spc () ++ pr_tac env (lcomplete,E) t, lcomplete
+  | TacId l ->
+      str "idtac" ++ prlist (pr_arg (pr_message_token pr_ident)) l, latom
+  | TacAtom (loc,TacAlias (_,s,l,_)) ->
+      pr_with_comments loc
+        (pr_extend env (level_of inherited) s (List.map snd l)),
+      latom
+  | TacAtom (loc,t) ->
+      pr_with_comments loc (hov 1 (pr_atom1 env t)), ltatom
+  | TacArg(Tacexp e) -> pr_tac_level env (latom,E) e, latom
+  | TacArg(ConstrMayEval (ConstrTerm c)) ->
+      str "constr:" ++ pr_constr env c, latom
+  | TacArg(ConstrMayEval c) ->
+      pr_may_eval (pr_constr env) (pr_lconstr env) (pr_cst env) c, leval
+  | TacArg(TacFreshId sopt) -> str "fresh" ++ pr_opt qs sopt, latom
+  | TacArg(Integer n) -> int n, latom
+  | TacArg(TacCall(loc,f,l)) ->
+      pr_with_comments loc
+        (hov 1 (pr_ref f ++ spc () ++
+         prlist_with_sep spc (pr_tacarg env) l)),
+      lcall
+  | TacArg a -> pr_tacarg env a, latom
+  in
+  if prec_less prec inherited then strm
+  else str"(" ++ strm ++ str")"
+
+and pr_tacarg env = function
+  | TacDynamic (loc,t) ->
+      pr_with_comments loc (str ("<dynamic ["^(Dyn.tag t)^"]>"))
+  | MetaIdArg (loc,s) -> pr_with_comments loc (str ("$" ^ s))
+  | IntroPattern ipat -> str "ipattern:" ++ pr_intro_pattern ipat
   | TacVoid -> str "()"
   | Reference r -> pr_ref r
-  | ConstrMayEval (ConstrTerm c) -> str "'" ++ pr_constr c
-  | ConstrMayEval c -> pr_may_eval pr_constr pr_cst c
-  | Integer n -> int n
-  | TacFreshId sopt -> str "FreshId" ++ pr_opt qstring sopt
-  | (TacCall _ | Tacexp _) as t -> str "(" ++ pr_tacarg1 t ++ str ")"
-
-and pr_tacarg1 = function
-  | TacCall (_,f,l) ->
-      hov 0 (pr_ref f ++ spc () ++ prlist_with_sep spc pr_tacarg0 l)
-  | Tacexp t -> pr_tac t
-  | t -> pr_tacarg0 t
-
-and pr_tacarg x = pr_tacarg1 x
-
-and prtac x = pr6 x
-
-in (prtac,pr0,pr_match_rule false pr_pat pr_tac)
-
-let pr_raw_extend prc prlc prtac = 
-  pr_extend_gen (pr_raw_generic prc prlc prtac Ppconstrnew.pr_reference)
-let pr_glob_extend prc prlc prtac =
-  pr_extend_gen (pr_glob_generic prc prlc prtac)
-let pr_extend prc prlc prtac =
-  pr_extend_gen (pr_generic prc prlc prtac)
+  | ConstrMayEval c ->
+      pr_may_eval (pr_constr env) (pr_lconstr env) (pr_cst env) c
+  | TacFreshId sopt -> str "fresh" ++ pr_opt qs sopt
+  | TacExternal (_,com,req,la) ->
+      str "external" ++ spc() ++ qs com ++ spc() ++ qs req ++ 
+      spc() ++ prlist_with_sep spc (pr_tacarg env) la
+  | (TacCall _|Tacexp _|Integer _) as a ->
+      str "ltac:" ++ pr_tac env (latom,E) (TacArg a)
+
+in (pr_tac, pr_match_rule)
+
+let strip_prod_binders_rawterm n (ty,_) =
+  let rec strip_ty acc n ty =
+    if n=0 then (List.rev acc, (ty,None)) else
+      match ty with
+          Rawterm.RProd(loc,na,a,b) ->
+            strip_ty (([dummy_loc,na],(a,None))::acc) (n-1) b
+        | _ -> error "Cannot translate fix tactic: not enough products" in
+  strip_ty [] n ty
+
+let strip_prod_binders_constr n ty =
+  let rec strip_ty acc n ty =
+    if n=0 then (List.rev acc, ty) else
+      match Term.kind_of_term ty with
+          Term.Prod(na,a,b) ->
+            strip_ty (([dummy_loc,na],a)::acc) (n-1) b
+        | _ -> error "Cannot translate fix tactic: not enough products" in
+  strip_ty [] n ty
+
+let drop_env f _env = f
+
+let rec raw_printers =
+    (pr_raw_tactic_level, 
+     drop_env pr_constr_expr,
+     drop_env pr_lconstr_expr,
+     pr_pattern_expr,
+     drop_env pr_reference,
+     drop_env pr_reference,
+     pr_reference,
+     pr_or_metaid pr_lident,
+     pr_raw_extend,
+     strip_prod_binders_expr)
+
+and pr_raw_tactic_level env n (t:raw_tactic_expr) =
+  fst (make_pr_tac raw_printers) env n t
+
+and pr_raw_match_rule env t =
+  snd (make_pr_tac raw_printers) env t
 
 let pr_and_constr_expr pr (c,_) = pr c
 
 let rec glob_printers =
-    (pr_glob_tactic, 
-     pr_glob_tactic0,
-     pr_and_constr_expr Printer.pr_rawterm,
-     Printer.pr_pattern,
-     pr_or_var (pr_and_short_name pr_evaluable_reference),
-     pr_or_var pr_inductive,
-     pr_or_var (pr_located pr_ltac_constant),
-     pr_located pr_id,
-     pr_glob_extend)
-
-and pr_glob_tactic (t:glob_tactic_expr) = pi1 (make_pr_tac glob_printers) t
-
-and pr_glob_tactic0 t = pi2 (make_pr_tac glob_printers) t
-
-and pr_glob_match_context t = pi3 (make_pr_tac glob_printers) t
-
-let (pr_tactic,_,_) =
+    (pr_glob_tactic_level, 
+     (fun env -> pr_and_constr_expr (pr_rawconstr_env env)),
+     (fun env -> pr_and_constr_expr (pr_lrawconstr_env env)),
+     (fun c -> pr_constr_pattern_env (Global.env()) c),
+     (fun env -> pr_or_var (pr_and_short_name (pr_evaluable_reference_env env))),
+     (fun env -> pr_or_var (pr_inductive env)),
+     pr_ltac_or_var (pr_located pr_ltac_constant),
+     pr_lident,
+     pr_glob_extend,
+     strip_prod_binders_rawterm)
+
+and pr_glob_tactic_level env n (t:glob_tactic_expr) =
+  fst (make_pr_tac glob_printers) env n t
+
+and pr_glob_match_rule env t =
+  snd (make_pr_tac glob_printers) env t
+
+let ((pr_tactic_level:Environ.env -> tolerability -> Proof_type.tactic_expr -> std_ppcmds),_) =
   make_pr_tac
-    (pr_glob_tactic,
-     pr_glob_tactic0,
-     Printer.prterm,
-     Printer.pr_pattern,
-     pr_evaluable_reference,
+    (pr_glob_tactic_level,
+     pr_constr_env,
+     pr_lconstr_env,
+     pr_constr_pattern,
+     pr_evaluable_reference_env,
      pr_inductive,
      pr_ltac_constant,
      pr_id,
-     pr_extend)
+     pr_extend,
+     strip_prod_binders_constr)
+
+let pr_raw_tactic env = pr_raw_tactic_level env ltop
+let pr_glob_tactic env = pr_glob_tactic_level env ltop
+let pr_tactic env = pr_tactic_level env ltop
+
+let _ = Tactic_debug.set_tactic_printer
+  (fun x -> pr_glob_tactic (Global.env()) x)
+
+let _ = Tactic_debug.set_match_pattern_printer
+  (fun env hyp -> pr_match_pattern (pr_constr_pattern_env env) hyp)
+
+let _ = Tactic_debug.set_match_rule_printer
+  (fun rl ->
+    pr_match_rule false (pr_glob_tactic (Global.env())) pr_constr_pattern rl)
diff --git a/parsing/pptactic.mli b/parsing/pptactic.mli
index 5c3035ba..ccdf3776 100644
--- a/parsing/pptactic.mli
+++ b/parsing/pptactic.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pptactic.mli,v 1.9.2.3 2005/12/23 22:16:46 herbelin Exp $ i*)
+(*i $Id: pptactic.mli 7937 2006-01-28 19:58:11Z herbelin $ i*)
 
 open Pp
 open Genarg
@@ -15,27 +15,33 @@ open Pretyping
 open Proof_type
 open Topconstr
 open Rawterm
+open Ppextend
+open Environ
 
 val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
 val pr_or_metaid : ('a -> std_ppcmds) -> 'a or_metaid -> std_ppcmds
 val pr_and_short_name : ('a -> std_ppcmds) -> 'a and_short_name -> std_ppcmds
-val pr_located : ('a -> std_ppcmds) -> 'a Util.located -> std_ppcmds
 
 type 'a raw_extra_genarg_printer =
-    (constr_expr -> std_ppcmds) -> (raw_tactic_expr -> std_ppcmds) ->
-      'a -> std_ppcmds
+    (constr_expr -> std_ppcmds) -> 
+    (constr_expr -> std_ppcmds) -> 
+    (tolerability -> raw_tactic_expr -> std_ppcmds) ->
+    'a -> std_ppcmds
 
 type 'a glob_extra_genarg_printer =
-    (rawconstr_and_expr -> std_ppcmds) -> (glob_tactic_expr -> std_ppcmds) ->
-      'a -> std_ppcmds
+    (rawconstr_and_expr -> std_ppcmds) ->
+    (rawconstr_and_expr -> std_ppcmds) ->
+    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
+    'a -> std_ppcmds
 
 type 'a extra_genarg_printer =
-    (Term.constr -> std_ppcmds) -> (glob_tactic_expr -> std_ppcmds) ->
-      'a -> std_ppcmds
+    (Term.constr -> std_ppcmds) -> 
+    (Term.constr -> std_ppcmds) -> 
+    (tolerability -> glob_tactic_expr -> std_ppcmds) ->
+    'a -> std_ppcmds
 
   (* if the boolean is false then the extension applies only to old syntax *)
 val declare_extra_genarg_pprule : 
-  bool ->
   ('c raw_abstract_argument_type * 'c raw_extra_genarg_printer) ->
   ('a glob_abstract_argument_type * 'a glob_extra_genarg_printer) ->
   ('b closed_abstract_argument_type * 'b extra_genarg_printer) -> unit
@@ -43,44 +49,42 @@ val declare_extra_genarg_pprule :
 type grammar_terminals = string option list
 
   (* if the boolean is false then the extension applies only to old syntax *)
-val declare_extra_tactic_pprule : bool -> string -> 
-  argument_type list * (string * grammar_terminals) -> unit
+val declare_extra_tactic_pprule : 
+  string * argument_type list * (int * grammar_terminals) -> unit
 
 val exists_extra_tactic_pprule : string -> argument_type list -> bool
 
-val pr_match_pattern : ('a -> std_ppcmds) -> 'a match_pattern -> std_ppcmds
-
-val pr_match_rule : bool -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) ->
-  ('a,'b) match_rule -> std_ppcmds
-
-val pr_glob_tactic : glob_tactic_expr -> std_ppcmds
-
-val pr_tactic : Proof_type.tactic_expr -> std_ppcmds
-
-val pr_glob_generic:
-  (rawconstr_and_expr -> std_ppcmds) -> 
-  (rawconstr_and_expr -> std_ppcmds) -> 
-  (glob_tactic_expr -> std_ppcmds) ->
-    glob_generic_argument -> std_ppcmds
-
 val pr_raw_generic : 
   (constr_expr -> std_ppcmds) ->
   (constr_expr -> std_ppcmds) ->
-  (raw_tactic_expr -> std_ppcmds) ->
+  (tolerability -> raw_tactic_expr -> std_ppcmds) ->
   (Libnames.reference -> std_ppcmds) ->
     (constr_expr, raw_tactic_expr) generic_argument ->
       std_ppcmds
 
 val pr_raw_extend:
   (constr_expr -> std_ppcmds) -> (constr_expr -> std_ppcmds) ->
-  (raw_tactic_expr -> std_ppcmds) -> string ->
-    raw_generic_argument list -> std_ppcmds
+  (tolerability -> raw_tactic_expr -> std_ppcmds) -> int ->
+    string -> raw_generic_argument list -> std_ppcmds
 
 val pr_glob_extend:
   (rawconstr_and_expr -> std_ppcmds) -> (rawconstr_and_expr -> std_ppcmds) ->
-  (glob_tactic_expr -> std_ppcmds) -> string ->
-    glob_generic_argument list -> std_ppcmds
+  (tolerability -> glob_tactic_expr -> std_ppcmds) -> int ->
+    string -> glob_generic_argument list -> std_ppcmds
 
 val pr_extend :
   (Term.constr -> std_ppcmds) -> (Term.constr -> std_ppcmds) ->
-  (glob_tactic_expr -> std_ppcmds) -> string -> closed_generic_argument list -> std_ppcmds
+  (tolerability -> glob_tactic_expr -> std_ppcmds) -> int ->
+    string -> closed_generic_argument list -> std_ppcmds
+
+val pr_raw_tactic : env -> raw_tactic_expr -> std_ppcmds
+
+val pr_raw_tactic_level : env -> tolerability -> raw_tactic_expr -> std_ppcmds
+ 
+val pr_glob_tactic : env -> glob_tactic_expr -> std_ppcmds
+
+val pr_tactic : env -> Proof_type.tactic_expr -> std_ppcmds
+
+val pr_hintbases : string list option -> std_ppcmds
+
+val pr_auto_using : ('constr -> std_ppcmds) -> 'constr list -> std_ppcmds
diff --git a/translate/ppvernacnew.ml b/parsing/ppvernac.ml
index 2e921c4e..0b6e5771 100644
--- a/translate/ppvernacnew.ml
+++ b/parsing/ppvernac.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ppvernacnew.ml,v 1.95.2.4 2005/12/23 22:16:56 herbelin Exp $ *)  
+(* $Id: ppvernac.ml 8624 2006-03-13 17:38:17Z msozeau $ *)  
 
 open Pp
 open Names
@@ -15,20 +15,18 @@ open Nametab
 open Util
 open Extend
 open Vernacexpr
-open Ppconstrnew
-open Pptacticnew
+open Ppconstr
+open Pptactic
 open Rawterm
-open Coqast
 open Genarg
 open Pcoq
-open Ast
 open Libnames
 open Ppextend
 open Topconstr
 open Decl_kinds
 open Tacinterp
 
-let pr_spc_type = pr_sep_com spc pr_type
+let pr_spc_lconstr = pr_sep_com spc pr_lconstr_expr
 
 let pr_lident (b,_ as loc,id) =
   if loc <> dummy_loc then
@@ -36,56 +34,42 @@ let pr_lident (b,_ as loc,id) =
     pr_located pr_id (make_loc (b,b+String.length(string_of_id id)),id)
   else pr_id id
 
+let string_of_fqid fqid =
+ String.concat "." (List.map string_of_id fqid)
+
+let pr_fqid fqid = str (string_of_fqid fqid)
+
+let pr_lfqid (_,_ as loc,fqid) =
+  if loc <> dummy_loc then
+   let (b,_) = unloc loc in
+    pr_located pr_fqid (make_loc (b,b+String.length(string_of_fqid fqid)),fqid)
+  else
+   pr_fqid fqid
+
 let pr_lname = function
     (loc,Name id) -> pr_lident (loc,id)
   | lna -> pr_located pr_name lna
 
-let pr_ltac_id id = Nameops.pr_id (id_of_ltac_v7_id id)
-
-let pr_module r =
-  let update_ref s = match r with
-    | Ident (loc,_) ->
-        Ident (loc,id_of_string s)
-    | Qualid (loc,qid) ->
-        Qualid (loc,make_qualid (fst (repr_qualid qid)) (id_of_string s)) in
-  let dir =
-    try
-      Nametab.full_name_module (snd (qualid_of_reference r))
-    with _ -> 
-    try
-      pi2 (Library.locate_qualified_library (snd (qualid_of_reference r)))
-    with _ -> 
-      errorlabstrm "" (str"Translator cannot find " ++ Libnames.pr_reference r)
-  in
-  let r = match List.rev (List.map string_of_id (repr_dirpath dir)) with
-    | [ "Coq"; "Lists"; "List" ] -> update_ref "MonoList"
-    | [ "Coq"; "Lists"; "PolyList" ] -> update_ref "List"
-    | _ -> r in
-  Libnames.pr_reference r
-
-let pr_import_module =
-  (* We assume List is never imported with "Import" ... *)
-  Libnames.pr_reference
-
-let pr_reference = Ppconstrnew.pr_reference
+let pr_ltac_id = Nameops.pr_id
+
+let pr_module = Libnames.pr_reference
+
+let pr_import_module = Libnames.pr_reference
 
 let sep_end () = str"."
 
 (* Warning: [pr_raw_tactic] globalises and fails if globalisation fails *)
-(*
-let pr_raw_tactic_env l env t = 
-  Pptacticnew.pr_raw_tactic env t
-*)
+
 let pr_raw_tactic_env l env t = 
-  Pptacticnew.pr_glob_tactic env (Tacinterp.glob_tactic_env l env t)
+  pr_glob_tactic env (Tacinterp.glob_tactic_env l env t)
 
 let pr_gen env t =
-  Pptactic.pr_raw_generic (Ppconstrnew.pr_constr_env env)
-    (Ppconstrnew.pr_lconstr_env env)
-    (Pptacticnew.pr_raw_tactic env) pr_reference t
+  pr_raw_generic 
+    pr_constr_expr
+    pr_lconstr_expr
+    (pr_raw_tactic_level env) pr_reference t
 
-let pr_raw_tactic tac =
-  pr_raw_tactic_env [] (Global.env()) tac
+let pr_raw_tactic tac = pr_raw_tactic (Global.env()) tac
 
 let rec extract_signature = function
   | [] -> []
@@ -94,8 +78,8 @@ let rec extract_signature = function
 
 let rec match_vernac_rule tys = function
     [] -> raise Not_found
-  | (s,pargs)::rls ->
-      if extract_signature pargs = tys then (s,pargs)
+  | pargs::rls ->
+      if extract_signature pargs = tys then pargs
       else match_vernac_rule tys rls
 
 let sep = fun _ -> spc()
@@ -129,24 +113,19 @@ let pr_set_entry_type = function
   | ETBigint -> str "bigint"
   | ETConstrList _ -> failwith "Internal entry type"
 
-let pr_non_terminal = function
-  | NtQual (u,nt) -> (* no more qualified entries *) str nt
-  | NtShort "constrarg" -> str "constr"
-  | NtShort nt -> str nt
-
 let strip_meta id =
   let s = string_of_id id in
   if s.[0]='$' then id_of_string (String.sub s 1 (String.length s - 1))
   else id
 
 let pr_production_item = function
-  | VNonTerm (loc,nt,Some p) -> pr_non_terminal nt ++ str"(" ++ pr_id (strip_meta p) ++ str")"
-  | VNonTerm (loc,nt,None) -> pr_non_terminal nt
-  | VTerm s -> qsnew s
+  | VNonTerm (loc,nt,Some p) -> str nt ++ str"(" ++ pr_id (strip_meta p) ++ str")"
+  | VNonTerm (loc,nt,None) -> str nt
+  | VTerm s -> qs s
 
 let pr_comment pr_c = function
   | CommentConstr c -> pr_c c
-  | CommentString s -> qsnew s
+  | CommentString s -> qs s
   | CommentInt n -> int n
 
 let pr_in_out_modules = function
@@ -156,7 +135,7 @@ let pr_in_out_modules = function
 
 let pr_search_about = function
   | SearchRef r -> pr_reference r
-  | SearchString s -> qsnew s
+  | SearchString s -> qs s
 
 let pr_search a b pr_p = match a with
   | SearchHead qid -> str"Search" ++ spc() ++ pr_reference qid ++ pr_in_out_modules b
@@ -177,7 +156,7 @@ let pr_class_rawexpr = function
 
 let pr_option_ref_value = function
   | QualidRefValue id -> pr_reference id
-  | StringRefValue s -> qsnew s
+  | StringRefValue s -> qs s
 
 let pr_printoption a b = match a with
   | Goptions.PrimaryTable table -> str table ++ pr_opt (prlist_with_sep sep pr_option_ref_value) b
@@ -202,24 +181,17 @@ let pr_opt_hintbases l = match l with
 
 let pr_hints local db h pr_c pr_pat = 
   let opth = pr_opt_hintbases db  in
-  let pr_aux = function
-    | CAppExpl (_,(_,qid),[]) -> pr_reference qid
-    | _ -> mt () in
   let pph =
     match h with
     | HintsResolve l ->
-        str "Resolve " ++
-        prlist_with_sep sep pr_c (List.map snd l)
+        str "Resolve " ++ prlist_with_sep sep pr_c l
     | HintsImmediate l ->
-        str"Immediate" ++ spc() ++
-        prlist_with_sep sep pr_c (List.map snd l)
+        str"Immediate" ++ spc() ++ prlist_with_sep sep pr_c l
     | HintsUnfold l ->
-        str "Unfold " ++
-	prlist_with_sep sep pr_reference (List.map snd l)
-    | HintsConstructors (n,c) ->
-        str"Constructors" ++ spc() ++
-        prlist_with_sep spc pr_reference c
-    | HintsExtern (name,n,c,tac) ->
+        str "Unfold " ++ prlist_with_sep sep pr_reference l
+    | HintsConstructors c ->
+        str"Constructors" ++ spc() ++ prlist_with_sep spc pr_reference c
+    | HintsExtern (n,c,tac) ->
         str "Extern" ++ spc() ++ int n ++ spc() ++ pr_pat c ++ str" =>" ++
         spc() ++ pr_raw_tactic tac
     | HintsDestruct(name,i,loc,c,tac) ->
@@ -232,9 +204,9 @@ let pr_hints local db h pr_c pr_pat =
 let pr_with_declaration pr_c = function
   | CWith_Definition (id,c) ->
       let p = pr_c c in
-      str"Definition" ++ spc() ++ pr_lident id ++ str" := " ++ p
+      str"Definition" ++ spc() ++ pr_lfqid id ++ str" := " ++ p
   | CWith_Module (id,qid) ->
-      str"Module" ++ spc() ++ pr_lident id ++ str" := " ++
+      str"Module" ++ spc() ++ pr_lfqid id ++ str" := " ++
       pr_located pr_qualid qid
 
 let rec pr_module_type pr_c = function
@@ -248,7 +220,12 @@ let pr_of_module_type prc (mty,b) =
   str (if b then ":" else "<:") ++
   pr_module_type prc mty
 
-let pr_module_vardecls pr_c (idl,mty) =
+let pr_require_token = function
+  | Some true -> str "Export "
+  | Some false -> str "Import "
+  | None -> mt()
+
+let pr_module_vardecls pr_c (export,idl,mty) =
   let m = pr_module_type pr_c mty in
   (* Update the Nametab for interpreting the body of module/modtype *)
   let lib_dir = Lib.library_dp() in
@@ -258,7 +235,8 @@ let pr_module_vardecls pr_c (idl,mty) =
        Modintern.interp_modtype (Global.env()) mty]) idl;
   (* Builds the stream *)
   spc() ++
-  hov 1 (str"(" ++ prlist_with_sep spc pr_lident idl ++ str":" ++ m ++ str")")
+  hov 1 (str"(" ++ pr_require_token export ++
+   prlist_with_sep spc pr_lident idl ++ str":" ++ m ++ str")")
 
 let pr_module_binders l pr_c = 
   (* Effet de bord complexe pour garantir la declaration des noms des
@@ -277,26 +255,13 @@ let rec pr_module_expr = function
       pr_module_expr me1 ++ spc() ++
       hov 1 (str"(" ++ pr_module_expr me2 ++ str")")
 
-(*
-let pr_opt_casted_constr pr_c = function
-  | CCast (loc,c,t) -> pr_c c ++ str":" ++ pr_c t
-  | _ as c -> pr_c c
-*)
-
 let pr_type_option pr_c = function
   | CHole loc -> mt()
   | _ as c -> brk(0,2) ++ str":" ++ pr_c c
 
-let without_translation f x =
-  let old = Options.do_translate () in
-  let oldv7 = !Options.v7 in
-  Options.make_translate false;
-  try let r = f x in Options.make_translate old; Options.v7:=oldv7; r
-  with e -> Options.make_translate old; Options.v7:=oldv7; raise e
-
 let pr_decl_notation prc =
   pr_opt (fun (ntn,c,scopt) -> fnl () ++
-    str "where " ++ qsnew ntn ++ str " := " ++ without_translation prc c ++
+    str "where " ++ qs ntn ++ str " := " ++ prc c ++
     pr_opt (fun sc -> str ": " ++ str sc) scopt)
 
 let pr_vbinders l =
@@ -306,7 +271,6 @@ let pr_binders_arg =
   pr_ne_sep spc pr_binders
 
 let pr_and_type_binders_arg bl =
-  let bl, _ = pr_lconstr_env_n (Global.env()) false bl (CHole dummy_loc) in
   pr_binders_arg bl
 
 let pr_onescheme (id,dep,ind,s) =
@@ -359,16 +323,7 @@ let pr_ne_params_list pr_c l =
   prlist_with_sep pr_semicolon (pr_params pr_c)
 *)
 
-let pr_thm_token = function
-  | Theorem -> str"Theorem"
-  | Lemma -> str"Lemma"
-  | Fact -> str"Fact"
-  | Remark -> str"Remark"
-
-let pr_require_token = function
-  | Some true -> str " Export"
-  | Some false -> str " Import"
-  | None -> mt()
+let pr_thm_token k = str (string_of_theorem_kind k)
 
 let pr_syntax_modifier = function
   | SetItemLevel (l,NextLevel) ->
@@ -383,23 +338,19 @@ let pr_syntax_modifier = function
   | SetAssoc Gramext.NonA -> str"no associativity"
   | SetEntryType (x,typ) -> str x ++ spc() ++ pr_set_entry_type typ
   | SetOnlyParsing -> str"only parsing"
-  | SetFormat s -> str"format " ++ pr_located qsnew s
+  | SetFormat s -> str"format " ++ pr_located qs s
 
 let pr_syntax_modifiers = function
   | [] -> mt()
   | l -> spc() ++ 
       hov 1 (str"(" ++ prlist_with_sep sep_v2 pr_syntax_modifier l ++ str")")
 
-let pr_grammar_tactic_rule (name,(s,pil),t) =
-(*
-  hov 0 (
-  (* str name ++ spc() ++ *)
-  hov 0 (str"[" ++ qsnew s ++ spc() ++
-  prlist_with_sep sep pr_production_item pil ++ str"]") ++
-  spc() ++ hov 0 (str"->" ++ spc() ++ str"[" ++ pr_raw_tactic t ++ str"]"))
-*)
-  hov 2 (str "Tactic Notation" ++ spc() ++ 
-    hov 0 (qsnew s ++ spc() ++ prlist_with_sep sep pr_production_item pil ++
+let print_level n =
+  if n <> 0 then str " (at level " ++ int n ++ str ")" else mt ()
+
+let pr_grammar_tactic_rule n (_,pil,t) =
+  hov 2 (str "Tactic Notation" ++ print_level n ++ spc() ++ 
+    hov 0 (prlist_with_sep sep pr_production_item pil ++
     spc() ++ str":=" ++ spc() ++ pr_raw_tactic t))
 
 let pr_box b = let pr_boxkind = function
@@ -413,38 +364,10 @@ in str"<" ++ pr_boxkind b ++ str">"
 let pr_paren_reln_or_extern = function
   | None,L -> str"L"
   | None,E -> str"E"
-  | Some pprim,Any -> qsnew pprim
-  | Some pprim,Prec p -> qsnew pprim ++ spc() ++ str":" ++ spc() ++ int p
+  | Some pprim,Any -> qs pprim
+  | Some pprim,Prec p -> qs pprim ++ spc() ++ str":" ++ spc() ++ int p
   | _ -> mt()
 
-let rec pr_next_hunks = function 
-  | UNP_FNL -> str"FNL"
-  | UNP_TAB -> str"TAB"
-  | RO c -> qsnew c
-  | UNP_BOX (b,ll) -> str"[" ++ pr_box b ++ prlist_with_sep sep pr_next_hunks ll ++ str"]"
-  | UNP_BRK (n,m) -> str"[" ++ int n ++ spc() ++ int m ++ str"]"
-  | UNP_TBRK (n,m) -> str"[ TBRK" ++ int n ++ spc() ++ int m ++ str"]"
-  | PH (e,None,_) -> print_ast e
-  | PH (e,Some ext,pr) -> print_ast e ++ spc() ++ str":" ++ spc() ++ pr_paren_reln_or_extern (Some ext,pr)
-  | UNP_SYMBOLIC _ -> mt()
-
-let pr_unparsing u =
-  str "[ " ++ prlist_with_sep sep pr_next_hunks u ++ str " ]"
-
-let pr_astpat a = str"<<" ++ print_ast a ++ str">>"
-
-let pr_syntax_rule (nm,s,u) = str nm ++ spc() ++ str"[" ++ pr_astpat s ++ str"]" ++ spc() ++ str"->" ++ spc() ++ pr_unparsing u
-
-let pr_syntax_entry (p,rl) =
-  str"level" ++ spc() ++ int p ++ str" :" ++ fnl() ++
-  prlist_with_sep (fun _ -> fnl() ++ str"| ") pr_syntax_rule rl
-
-let pr_vernac_solve (i,env,tac,deftac) =
-  (if i = 1 then mt() else int i ++ str ": ") ++
-  Pptacticnew.pr_glob_tactic env tac
-  ++ (try if deftac & Pfedit.get_end_tac() <> None then str ".." else mt ()
-      with UserError _|Stdpp.Exc_located _ -> mt())
-
 (**************************************)
 (* Pretty printer for vernac commands *)
 (**************************************)
@@ -465,6 +388,8 @@ let rec pr_vernac = function
   | VernacAbort id -> str"Abort" ++ pr_opt pr_lident id
   | VernacResume id -> str"Resume" ++ pr_opt pr_lident id
   | VernacUndo i -> if i=1 then str"Undo" else str"Undo" ++ pr_intarg i
+  | VernacBacktrack (i,j,k) -> 
+      str "Backtrack" ++  spc() ++ prlist_with_sep sep int [i;j;k]
   | VernacFocus i -> str"Focus" ++ pr_opt int i
   | VernacGo g -> 
       let pr_goable = function
@@ -484,6 +409,7 @@ let rec pr_vernac = function
 	| ShowTree -> str"Show Tree"
 	| ShowProofNames -> str"Show Conjectures"
 	| ShowIntros b -> str"Show " ++ (if b then str"Intros" else str"Intro")
+	| ShowMatch id -> str"Show Match " ++ pr_lident id
 	| 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
@@ -494,10 +420,11 @@ let rec pr_vernac = function
   | VernacResetName id -> str"Reset" ++ spc() ++ pr_lident id
   | VernacResetInitial -> str"Reset Initial"
   | VernacBack i -> if i=1 then str"Back" else str"Back" ++ pr_intarg i
+  | VernacBackTo i -> str"BackTo" ++ pr_intarg i
 
   (* State management *)
-  | VernacWriteState s -> str"Write State" ++ spc () ++ qsnew s
-  | VernacRestoreState s -> str"Restore State" ++ spc() ++ qsnew s
+  | VernacWriteState s -> str"Write State" ++ spc () ++ qs s
+  | VernacRestoreState s -> str"Restore State" ++ spc() ++ qs s
 
   (* Control *)
   | VernacList l ->
@@ -505,28 +432,12 @@ let rec pr_vernac = function
              prlist (fun v -> pr_located pr_vernac v ++ sep_end () ++ fnl()) l
              ++ spc() ++ str"]") 
   | VernacLoad (f,s) -> str"Load" ++ if f then (spc() ++ str"Verbose"
-  ++ spc()) else spc()  ++ qsnew s
+  ++ spc()) else spc()  ++ qs s
   | VernacTime v -> str"Time" ++ spc() ++ pr_vernac v
   | VernacVar id -> pr_lident id
   
   (* Syntax *) 
-  | VernacGrammar _ -> 
-      msgerrnl (str"Warning : constr Grammar is discontinued; use Notation");
-      str"(* <Warning> : Grammar is replaced by Notation *)"
-  | VernacTacticGrammar l ->
-      prlist_with_sep (fun () -> sep_end() ++ fnl()) pr_grammar_tactic_rule l
-(*
-      hov 1 (str"Grammar tactic simple_tactic :=" ++ spc() ++ prlist_with_sep (fun _ -> brk(1,1) ++ str"|") pr_grammar_tactic_rule l) (***)
-*)      
-  | VernacSyntax (u,el) ->
-      msgerrnl (str"Warning : Syntax is discontinued; use Notation");
-      str"(* <Warning> : Syntax is discontinued" ++ 
-(*
-      fnl () ++
-      hov 1 (str"Syntax " ++ str u ++ spc() ++
-      prlist_with_sep sep_v2 pr_syntax_entry el) ++ 
-*)
-      str " *)"
+  | VernacTacticNotation (n,r,e) -> pr_grammar_tactic_rule n ("",r,e)
   | VernacOpenCloseScope (local,opening,sc) ->
       str (if opening then "Open " else "Close ") ++ pr_locality local ++
       str "Scope" ++ spc() ++ str sc
@@ -540,81 +451,48 @@ let rec pr_vernac = function
       |	None -> str"_"
       |	Some sc -> str sc in 
     str"Arguments Scope" ++ spc() ++ pr_reference q ++ spc() ++ str"[" ++ prlist_with_sep sep pr_opt_scope scl ++ str"]"
-  | VernacInfix (local,(s,_),q,ov8,sn) -> (* A Verifier *)
-      let s,mv8 = match ov8 with Some smv8 -> smv8 | None -> (s,[]) in
+  | VernacInfix (local,(s,mv),q,sn) -> (* A Verifier *)
       hov 0 (hov 0 (str"Infix " ++ pr_locality local
-      ++ qsnew s ++ str " :=" ++ spc() ++ pr_reference q) ++
-      pr_syntax_modifiers mv8 ++
+      ++ qs s ++ str " :=" ++ spc() ++ pr_reference q) ++
+      pr_syntax_modifiers mv ++
       (match sn with
     | None -> mt()
     | Some sc -> spc() ++ str":" ++ spc() ++ str sc))
-  | VernacDistfix (local,a,p,s,q,sn) ->
-      hov 0 (str"Distfix " ++ pr_locality local ++ pr_entry_prec a ++ int p
-        ++ spc() ++ qsnew s ++ spc() ++ pr_reference q ++ (match sn with
-    | None -> mt()
-    | Some sc -> spc() ++ str":" ++ spc() ++ str sc))
-  | VernacNotation (local,c,sl,mv8,opt) ->
-      let (s,l) = match mv8 with
-          None -> fst (out_some sl), []
-        | Some ml -> ml in
+  | VernacNotation (local,c,(s,l),opt) ->
       let ps =
 	let n = String.length s in
 	if n > 2 & s.[0] = '\'' & s.[n-1] = '\'' 
 	then
           let s' = String.sub s 1 (n-2) in
-          if String.contains s' '\'' then qsnew s else str s'
-	else qsnew s in
+          if String.contains s' '\'' then qs s else str s'
+	else qs s in
       hov 2( str"Notation" ++ spc() ++ pr_locality local ++ ps ++
       str " :=" ++ pr_constrarg c ++ pr_syntax_modifiers l ++
       (match opt with
         | None -> mt()
         | Some sc -> str" :" ++ spc() ++ str sc))
-  | VernacSyntaxExtension (local,sl,mv8) ->
-      let (s,l) = match mv8 with
-          None -> out_some sl
-        | Some ml -> ml in
-      str"Reserved Notation" ++ spc() ++ pr_locality local ++ qsnew s ++
+  | VernacSyntaxExtension (local,(s,l)) ->
+      str"Reserved Notation" ++ spc() ++ pr_locality local ++ qs s ++
       pr_syntax_modifiers l
 
   (* Gallina *)
   | VernacDefinition (d,id,b,f) -> (* A verifier... *)
-      let pr_def_token = function
-        | Local, Coercion -> str"Coercion Local"
-        | Global, Coercion -> str"Coercion"
-        | Local, Definition -> str"Let"
-        | Global, Definition -> str"Definition"
-        | Local, SubClass -> str"Local SubClass"
-        | Global, SubClass -> str"SubClass"
-        | Global, CanonicalStructure -> str"Canonical Structure"
-        | Local, CanonicalStructure ->
-	   anomaly "Don't know how to translate a local canonical structure" in
+      let pr_def_token dk = str (string_of_definition_kind dk) in
       let pr_reduce = function
         | None -> mt()
         | Some r ->
             str"Eval" ++ spc() ++
             pr_red_expr (pr_constr, pr_lconstr, pr_reference) r ++
             str" in" ++ spc() in
-      let mkLambdaCit = List.fold_right (fun (x,a) b -> mkLambdaC(x,a,b)) in
-      let mkProdCit = List.fold_right (fun (x,a) b -> mkProdC(x,a,b)) in
       let pr_def_body = function
-        | DefineBody (bl,red,c,d) ->
-            let (bl2,body,ty) = match d with
-              | None ->
-                  let bl2,body = extract_lam_binders c in
-                  (bl2,body,mt())
-              | Some ty ->
-                  let bl2,body,ty' = extract_def_binders c ty in
-                  (bl2,CCast (dummy_loc,body,ty'),
-                   spc() ++ str":" ++
-                   pr_sep_com spc
-                     (pr_type_env_n (Global.env()) (bl@bl2)) ty') in
-	    let iscast = d <> None in
-            let bindings,ppred =
-	      pr_lconstr_env_n (Global.env()) iscast (bl@bl2) body in
-            (pr_binders_arg bindings,ty,Some (pr_reduce red ++ ppred))
+        | DefineBody (bl,red,body,d) ->
+            let ty = match d with
+              | None -> mt()
+              | Some ty -> spc() ++ str":" ++ pr_spc_lconstr ty
+	    in
+            (pr_binders_arg bl,ty,Some (pr_reduce red ++ pr_lconstr body))
         | ProveBody (bl,t) ->
-            (pr_and_type_binders_arg bl, str" :" ++ pr_spc_type t, None)
-      in
+            (pr_binders_arg bl, str" :" ++ pr_spc_lconstr t, None) in
       let (binds,typ,c) = pr_def_body b in
       hov 2 (pr_def_token d ++ spc() ++ pr_lident id ++ binds ++ typ ++
       (match c with
@@ -626,7 +504,7 @@ let rec pr_vernac = function
       (match bl with
         | [] -> mt()
         | _ -> pr_binders bl ++ spc())
-      ++ str":" ++ pr_spc_type (rename_bound_variables (snd id) c))
+      ++ str":" ++ pr_spc_lconstr c)
   | VernacEndProof Admitted -> str"Admitted"
   | VernacEndProof (Proved (opac,o)) -> (match o with
     | None -> if opac then str"Qed" else str"Defined"
@@ -636,75 +514,16 @@ let rec pr_vernac = function
   | VernacExactProof c ->
       hov 2 (str"Proof" ++ pr_lconstrarg c)
   | VernacAssumption (stre,l) ->
+      let n = List.length (List.flatten (List.map fst (List.map snd l))) in
       hov 2
-        (pr_assumption_token (List.length l > 1) stre ++ spc() ++ 
-	 pr_ne_params_list pr_type l)
+        (pr_assumption_token (n > 1) stre ++ spc() ++ 
+	 pr_ne_params_list pr_lconstr_expr l)
   | VernacInductive (f,l) ->
 
-      (* Copie simplifiée de command.ml pour recalculer les implicites, *)
-      (* les notations, et le contexte d'evaluation *)
-      let lparams = match l with [] -> assert false | (_,_,la,_,_)::_ -> la in
-      let nparams = local_binders_length lparams
-      and sigma = Evd.empty 
-      and env0 = Global.env() in
-      let (env_params,params) =
-	List.fold_left
-	  (fun (env,params) d -> match d with
-	    | LocalRawAssum (nal,t) ->
-		let t = Constrintern.interp_type sigma env t in
-		let ctx = list_map_i (fun i (_,na) -> (na,None,Term.lift i t)) 0 nal
-		in let ctx = List.rev ctx in
-		(Environ.push_rel_context ctx env, ctx@params)
-	    | LocalRawDef ((_,na),c) ->
-		let c = Constrintern.judgment_of_rawconstr sigma env c in
-		let d = (na, Some c.Environ.uj_val, c.Environ.uj_type) in
-		(Environ.push_rel d env,d::params))
-	  (env0,[]) lparams in
-
-      let (ind_env,ind_impls,arityl) =
-        List.fold_left
-          (fun (env, ind_impls, arl) ((_,recname), _, _, arityc, _) ->
-            let arity = Constrintern.interp_type sigma env_params arityc in
-	    let fullarity = Termops.it_mkProd_or_LetIn arity params in
-	    let env' = Termops.push_rel_assum (Name recname,fullarity) env in
-	    let impls = 
-	      if Impargs.is_implicit_args()
-	      then Impargs.compute_implicits false env_params fullarity
-	      else [] in
-	    (env', (recname,impls)::ind_impls, (arity::arl)))
-          (env0, [], []) l
-      in
-      let lparnames = List.map (fun (na,_,_) -> na) params in
-      let notations = 
-	List.fold_right (fun (_,ntnopt,_,_,_) l ->option_cons ntnopt l) l [] in
-      let ind_env_params = Environ.push_rel_context params ind_env in
-
-      let lparnames = List.map (fun (na,_,_) -> na) params in
-      let impl = List.map
-	(fun ((_,recname),_,_,arityc,_) ->
-	  let arity = Constrintern.interp_type sigma env_params arityc in
-	  let fullarity =
-            Termops.prod_it arity (List.map (fun (id,_,ty) -> (id,ty)) params)
-	  in
-	  let impl_in =
-	    if Impargs.is_implicit_args()
-	    then Impargs.compute_implicits false env_params fullarity
-	    else [] in
-	  let impl_out =
-	    if Impargs.is_implicit_args_out()
-	    then Impargs.compute_implicits true env_params fullarity
-	    else [] in
-	  (recname,impl_in,impl_out)) l in
-      let impls_in = List.map (fun (id,a,_) -> (id,a)) impl in
-      let impls_out = List.map (fun (id,_,a) -> (id,a)) impl in
-      Constrintern.set_temporary_implicits_in impls_in;
-      Constrextern.set_temporary_implicits_out impls_out;
-      (* Fin calcul implicites *)
-
       let pr_constructor (coe,(id,c)) =
         hov 2 (pr_lident id ++ str" " ++
                (if coe then str":>" else str":") ++
-                pr_sep_com spc (pr_type_env_n ind_env_params []) c) in
+                pr_spc_lconstr c) in
       let pr_constructor_list l = match l with
         | [] -> mt()
         | _ ->
@@ -716,64 +535,21 @@ let rec pr_vernac = function
 	hov 0 (
           str key ++ spc() ++
           pr_lident id ++ pr_and_type_binders_arg indpar ++ spc() ++ str":" ++ 
-	  spc() ++ pr_type s ++ 
+	  spc() ++ pr_lconstr_expr s ++ 
 	  str" :=") ++ pr_constructor_list lc ++ 
 	pr_decl_notation pr_constr ntn in
 
-      (* Copie simplifiée de command.ml pour déclarer les notations locales *)
-      List.iter (fun (df,c,scope) ->
- 	Metasyntax.add_notation_interpretation df [] c scope) notations;
-
       hov 1 (pr_oneind (if f then "Inductive" else "CoInductive") (List.hd l))
       ++ 
       (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l))
 
 
-  | VernacFixpoint recs ->
-
-      (* Copie simplifiée de command.ml pour recalculer les implicites *)
-      (* les notations, et le contexte d'evaluation *)
-      let sigma = Evd.empty
-      and env0 = Global.env() in
-      let notations = 
-	List.fold_right (fun (_,ntnopt) l -> option_cons ntnopt l) recs [] in
-      let impl = List.map
-        (fun ((recname,_, bl, arityc,_),_) -> 
-          let arity =
-            Constrintern.interp_type sigma env0
-              (prod_constr_expr arityc bl) in
-	  let impl_in =
-	    if Impargs.is_implicit_args()
-	    then Impargs.compute_implicits false env0 arity
-	    else [] in
-	  let impl_out =
-	    if Impargs.is_implicit_args_out()
-	    then Impargs.compute_implicits true env0 arity
-	    else [] in
-	  (recname,impl_in,impl_out)) recs in
-      let impls_in = List.map (fun (id,a,_) -> (id,a)) impl in
-      let impls_out = List.map (fun (id,_,a) -> (id,a)) impl in
-      Constrintern.set_temporary_implicits_in impls_in;
-      Constrextern.set_temporary_implicits_out impls_out;
-
-      (* Copie simplifiée de command.ml pour déclarer les notations locales *)
-      List.iter (fun (df,c,scope) ->
-	Metasyntax.add_notation_interpretation df [] c None) notations;
-
-      let rec_sign = 
-        List.fold_left 
-          (fun env ((recname,_,bl,arityc,_),_) -> 
-            let arity =
-              Constrintern.interp_type sigma env0
-                (prod_constr_expr arityc bl) in
-            Environ.push_named (recname,None,arity) env)
-          (Global.env()) recs in
-      
+  | VernacFixpoint (recs,b) ->
       let name_of_binder = function
         | LocalRawAssum (nal,_) -> nal
         | LocalRawDef (_,_) -> [] in
       let pr_onerec = function
-        | (id,n,bl,type_,def),ntn ->
+        | (id,(n,ro),bl,type_,def),ntn ->
             let (bl',def,type_) =
               if Options.do_translate() then extract_def_binders def type_
               else ([],def,type_) in
@@ -785,29 +561,33 @@ let rec pr_vernac = function
                 warn (str "non-printable fixpoint \""++pr_id id++str"\"");
                 Anonymous in
             let annot =
-              if List.length ids > 1 then 
-                spc() ++ str "{struct " ++ pr_name name ++ str"}"
-              else mt() in
-	    let bl,ppc =
-              pr_lconstr_env_n rec_sign true bl (CCast(dummy_loc,def,type_)) in
+	      match (ro : Topconstr.recursion_order_expr) with
+		  CStructRec -> 
+		    if List.length ids > 1 then 
+                      spc() ++ str "{struct " ++ pr_name name ++ str"}"
+		    else mt()
+		| CWfRec c -> spc() ++ str "{wf " ++ pr_name name ++ spc() ++ pr_lconstr_expr c ++ str"}"
+	    in
             pr_id id ++ pr_binders_arg bl ++ annot ++ spc()
-            ++ pr_type_option (fun c -> spc() ++ pr_type c) type_
-            ++ str" :=" ++ brk(1,1) ++ ppc ++ 
+            ++ pr_type_option (fun c -> spc() ++ pr_lconstr_expr c) type_
+            ++ str" :=" ++ brk(1,1) ++ pr_lconstr def ++ 
 	    pr_decl_notation pr_constr ntn
       in
-      hov 1 (str"Fixpoint" ++ spc() ++
+      let start = if b then "Boxed Fixpoint" else "Fixpoint" in
+      hov 1 (str start ++ spc() ++
         prlist_with_sep (fun _ -> fnl() ++ fnl() ++ str"with ") pr_onerec recs)
 
-  | VernacCoFixpoint corecs ->
+  | VernacCoFixpoint (corecs,b) ->
       let pr_onecorec (id,bl,c,def) =
         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_type c ++
+        spc() ++ pr_lconstr_expr c ++
         str" :=" ++ brk(1,1) ++ pr_lconstr def in
-      hov 1 (str"CoFixpoint" ++ spc() ++
+      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)  
   | VernacScheme l ->
       hov 2 (str"Scheme" ++ spc() ++
@@ -819,20 +599,20 @@ let rec pr_vernac = function
         | (oc,AssumExpr (id,t)) ->
             hov 1 (pr_lname id ++
             (if oc then str" :>" else str" :") ++ spc() ++
-            pr_type t)
+            pr_lconstr_expr t)
         | (oc,DefExpr(id,b,opt)) -> (match opt with
 	    | Some t ->
                 hov 1 (pr_lname id ++
                 (if oc then str" :>" else str" :") ++ spc() ++
-                pr_type t ++ str" :=" ++ pr_lconstr b)
+                pr_lconstr_expr t ++ str" :=" ++ pr_lconstr b)
 	    | None ->
                 hov 1 (pr_lname id ++ str" :=" ++ spc() ++
                 pr_lconstr b)) in
       hov 2
         (str (if b then "Record" else "Structure") ++
          (if oc then str" > " else str" ") ++ pr_lident name ++ 
-          pr_and_type_binders_arg ps ++ str" :" ++ spc() ++ pr_type s ++ 
-	  str" := " ++
+          pr_and_type_binders_arg ps ++ str" :" ++ spc() ++ 
+	  pr_lconstr_expr s ++ str" := " ++
          (match c with
            | None -> mt()
            | Some sc -> pr_lident sc) ++
@@ -841,7 +621,7 @@ let rec pr_vernac = function
   | VernacBeginSection id -> hov 2 (str"Section" ++ spc () ++ pr_lident id)
   | VernacEndSegment id -> hov 2 (str"End" ++ spc() ++ pr_lident id)
   | VernacRequire (exp,spe,l) -> hov 2
-      (str "Require" ++ pr_require_token exp ++ spc() ++
+      (str "Require" ++ spc() ++ pr_require_token exp ++
       (match spe with
       |	None -> mt()
       |	Some flag ->
@@ -866,16 +646,17 @@ let rec pr_vernac = function
 	spc() ++ pr_class_rawexpr c2)
 
   (* Modules and Module Types *)
-  | VernacDefineModule (m,bl,ty,bd) ->
+  | VernacDefineModule (export,m,bl,ty,bd) ->
       let b = pr_module_binders_list bl pr_lconstr in 
-      hov 2 (str"Module " ++ pr_lident m ++ b ++
+      hov 2 (str"Module" ++ spc() ++ pr_require_token export ++
+             pr_lident m ++ b ++
              pr_opt (pr_of_module_type pr_lconstr) ty ++
              pr_opt (fun me -> str ":= " ++ pr_module_expr me) bd)
-  | VernacDeclareModule (id,bl,m1,m2) ->
+  | VernacDeclareModule (export,id,bl,m1) ->
       let b = pr_module_binders_list bl pr_lconstr in 
-      hov 2 (str"Declare Module " ++ pr_lident id ++ b ++
-             pr_opt (pr_of_module_type pr_lconstr) m1 ++
-             pr_opt (fun me -> str ":= " ++ pr_module_expr me) m2)
+      hov 2 (str"Declare Module" ++ spc() ++ pr_require_token export ++
+             pr_lident id ++ b ++
+             pr_of_module_type pr_lconstr m1)
   | VernacDeclareModuleType (id,bl,m) ->
       let b = pr_module_binders_list bl pr_lconstr in 
       hov 2 (str"Module Type " ++ pr_lident id ++ b ++
@@ -883,39 +664,35 @@ let rec pr_vernac = function
 
   (* Solving *)
   | VernacSolve (i,tac,deftac) ->
-      (* Normally shunted by vernac.ml *)
-      let env =
-        try snd (Pfedit.get_goal_context i)
-        with UserError _ -> Global.env() in
-      let tac = 
-	Options.with_option Options.translate_syntax 
-	  (Constrintern.for_grammar (Tacinterp.glob_tactic_env [] env)) tac in
-      pr_vernac_solve (i,env,tac,deftac)
+      (if i = 1 then mt() else int i ++ str ": ") ++
+      pr_raw_tactic tac
+      ++ (try if deftac & Pfedit.get_end_tac() <> None then str ".." else mt ()
+      with UserError _|Stdpp.Exc_located _ -> mt())
 
   | VernacSolveExistential (i,c) ->
       str"Existential " ++ int i ++ pr_lconstrarg c
 
   (* Auxiliary file and library management *)
   | VernacRequireFrom (exp,spe,f) -> hov 2
-      (str"Require " ++ pr_require_token exp ++ spc() ++
+      (str"Require" ++ spc() ++ pr_require_token exp ++
       (match spe with
         | None -> mt()
         | Some false -> str"Implementation" ++ spc()
         | Some true -> str"Specification" ++ spc ()) ++
-      qsnew f)
+      qs f)
   | VernacAddLoadPath (fl,s,d) -> hov 2
       (str"Add" ++
        (if fl then str" Rec " else spc()) ++
-       str"LoadPath" ++ spc() ++ qsnew s ++
+       str"LoadPath" ++ spc() ++ qs s ++
        (match d with 
          | None -> mt()
          | Some dir -> spc() ++ str"as" ++ spc() ++ pr_dirpath dir)) 
-  | VernacRemoveLoadPath s -> str"Remove LoadPath" ++ qsnew s
+  | VernacRemoveLoadPath s -> str"Remove LoadPath" ++ qs s
   | VernacAddMLPath (fl,s) ->
-      str"Add" ++ (if fl then str" Rec " else spc()) ++ str"ML Path" ++ qsnew s
+      str"Add" ++ (if fl then str" Rec " else spc()) ++ str"ML Path" ++ qs s
   | VernacDeclareMLModule l ->
-      hov 2 (str"Declare ML Module" ++ spc() ++ prlist_with_sep sep qsnew l)
-  | VernacChdir s -> str"Cd" ++ pr_opt qsnew s
+      hov 2 (str"Declare ML Module" ++ spc() ++ prlist_with_sep sep qs l)
+  | VernacChdir s -> str"Cd" ++ pr_opt qs s
 
   (* Commands *)
   | VernacDeclareTacticDefinition (rc,l) ->
@@ -940,7 +717,7 @@ let rec pr_vernac = function
 	    (* Rec by default *) str "Ltac ") ++
         prlist_with_sep (fun () -> fnl() ++ str"with ") pr_tac_body l)
   | VernacHints (local,dbnames,h) ->
-      pr_hints local dbnames h pr_constr pr_pattern
+      pr_hints local dbnames h pr_constr pr_pattern_expr
   | VernacSyntacticDefinition (id,c,local,onlyparsing) ->
       hov 2
         (str"Notation " ++ pr_locality local ++ pr_id id ++ str" :=" ++
@@ -957,30 +734,11 @@ let rec pr_vernac = function
   | VernacReserve (idl,c) ->
       hov 1 (str"Implicit Type" ++
         str (if List.length idl > 1 then "s " else " ") ++
-        prlist_with_sep spc pr_lident idl ++ str " :" ++ spc () ++ pr_type c)
+        prlist_with_sep spc pr_lident idl ++ str " :" ++ spc () ++
+        pr_lconstr c)
   | VernacSetOpacity (fl,l) ->
       hov 1 ((if fl then str"Opaque" else str"Transparent") ++
              spc() ++ prlist_with_sep sep pr_reference l)
-
-  | VernacSetOption (Goptions.SecondaryTable ("Implicit","Arguments"),BoolValue true) -> 
-      str"Set Implicit Arguments" 
-      ++
-      (if !Options.translate_strict_impargs then
-	sep_end () ++ fnl () ++ str"Unset Strict Implicit"
-      else mt ())
-  | VernacUnsetOption (Goptions.SecondaryTable ("Implicit","Arguments"))
-  | VernacSetOption (Goptions.SecondaryTable ("Implicit","Arguments"),BoolValue false) -> 
-      (if !Options.translate_strict_impargs then
-	str"Set Strict Implicit" ++ sep_end () ++ fnl ()
-      else mt ())
-      ++
-      str"Unset Implicit Arguments" 
-
-  | VernacSetOption (Goptions.SecondaryTable (a,"Implicits"),BoolValue true) ->
-      str("Set "^a^" Implicit")
-  | VernacUnsetOption (Goptions.SecondaryTable (a,"Implicits")) -> 
-      str("Unset "^a^" Implicit")
-
   | VernacUnsetOption na ->
       hov 1 (str"Unset" ++ spc() ++ pr_printoption na None)
   | VernacSetOption (na,v) -> hov 2 (str"Set" ++ spc() ++ pr_set_option na v)
@@ -1013,34 +771,37 @@ let rec pr_vernac = function
 	| PrintMLModules -> str"Print ML Modules"
 	| PrintGraph -> str"Print Graph"
 	| PrintClasses -> str"Print Classes"
+	| PrintLtac qid -> str"Print Ltac" ++ spc() ++ pr_reference qid
 	| PrintCoercions -> str"Print Coercions"
 	| PrintCoercionPaths (s,t) -> str"Print Coercion Paths" ++ spc() ++ pr_class_rawexpr s ++ spc() ++ pr_class_rawexpr t
+	| PrintCanonicalConversions -> str"Print Canonical Structures"
 	| PrintTables -> str"Print Tables"
 	| PrintOpaqueName qid -> str"Print Term" ++ spc() ++ pr_reference qid
 	| PrintHintGoal -> str"Print Hint"
 	| PrintHint qid -> str"Print Hint" ++ spc() ++ pr_reference qid
 	| PrintHintDb -> str"Print Hint *"
 	| PrintHintDbName s -> str"Print HintDb" ++ spc() ++ str s
+	| PrintRewriteHintDbName s -> str"Print Rewrite HintDb" ++ spc() ++ str s
 	| PrintUniverses fopt -> str"Dump Universes" ++ pr_opt str fopt
 	| PrintName qid -> str"Print" ++ spc()  ++ pr_reference qid
-	| PrintLocalContext -> assert false
-            (* str"Print" *) 
 	| PrintModuleType qid -> str"Print Module Type" ++ spc() ++ pr_reference qid
 	| PrintModule qid -> str"Print Module" ++ spc() ++ pr_reference qid
 	| PrintInspect n -> str"Inspect" ++ spc() ++ int n
+  | PrintSetoids -> str"Print Setoids"
 	| PrintScopes -> str"Print Scopes"
 	| PrintScope s -> str"Print Scope" ++ spc() ++ str s 
 	| PrintVisibility s -> str"Print Visibility" ++ pr_opt str s 
 	| PrintAbout qid -> str"About" ++ spc()  ++ pr_reference qid
 	| PrintImplicit qid -> str"Print Implicit" ++ spc()  ++ pr_reference qid
       in pr_printable p
-  | VernacSearch (sea,sea_r) -> pr_search sea sea_r pr_pattern
-  | VernacLocate loc ->
+  | VernacSearch (sea,sea_r) -> pr_search sea sea_r pr_pattern_expr
+  | VernacLocate loc -> 
       let pr_locate =function
 	| LocateTerm qid ->  pr_reference qid
-	| LocateFile f -> str"File" ++ spc() ++ qsnew f
+	| LocateFile f -> str"File" ++ spc() ++ qs f
 	| LocateLibrary qid -> str"Library" ++ spc () ++ pr_module qid
-	| LocateNotation s -> qsnew s
+	| LocateModule qid -> str"Module" ++ spc () ++ pr_module qid
+	| LocateNotation s -> qs s
       in str"Locate" ++ spc() ++ pr_locate loc
   | VernacComments l ->
       hov 2
@@ -1052,8 +813,6 @@ let rec pr_vernac = function
 
   (* For extension *)
   | VernacExtend (s,c) -> pr_extend s c
-  | VernacV7only _ -> mt()
-  | VernacV8only com -> pr_vernac com
   | VernacProof Tacexpr.TacId _ -> str "Proof"
   | VernacProof te -> str "Proof with" ++ spc() ++ pr_raw_tactic te 
 
@@ -1062,18 +821,8 @@ and pr_extend s cl =
     try pr_gen (Global.env()) a
     with Failure _ -> str ("<error in "^s^">") in
   try
-    (* Hack pour les syntaxes changeant non uniformément en passant a la V8 *)
-    let s =
-      let n = String.length s in
-      if Options.do_translate() & n > 2 & String.sub s (n-2) 2 = "V7"
-      then String.sub s 0 (n-2) ^ "V8"
-      else s in
-    (* "Hint Rewrite in using" changes the order of its args in v8 !! *)
-    let cl = match s, cl with
-      | "HintRewriteV8", [a;b;c;d] -> [a;b;d;c]
-      | _ -> cl in
     let rls = List.assoc s (Egrammar.get_extend_vernac_grammars()) in
-    let (hd,rl) = match_vernac_rule (List.map Genarg.genarg_tag cl) rls in
+    let rl = match_vernac_rule (List.map Genarg.genarg_tag cl) rls in
     let (pp,_) =
       List.fold_left
         (fun (strm,args) pi ->
@@ -1082,45 +831,11 @@ and pr_extend s cl =
                 (strm ++ pr_gen (Global.env()) (List.hd args),
                 List.tl args)
             | Egrammar.TacTerm s -> (strm ++ spc() ++ str s, args))
-        (str hd,cl) rl in
+        (mt(),cl) rl in
     hov 1 pp
-    ++ (if s = "Correctness" then sep_end () ++ fnl() ++ str "Proof" else mt())
   with Not_found ->
     hov 1 (str ("TODO("^s) ++ prlist_with_sep sep pr_arg cl ++ str ")")
 
 in pr_vernac
 
-let pr_vernac = make_pr_vernac Ppconstrnew.pr_constr Ppconstrnew.pr_lconstr
-
-let pr_vernac = function
-  | VernacRequire (_,_,[Ident(_,r)]) when
-      (* Obsolete modules *)
-      List.mem (string_of_id r)
-	["Refine"; "Inv"; "Equality"; "EAuto"; "AutoRewrite"; "EqDecide"; 
-         "Xml"; "Extraction"; "Tauto"; "Setoid_replace";"Elimdep";
-	 "DatatypesSyntax"; "LogicSyntax"; "Logic_TypeSyntax";
-	 "SpecifSyntax"; "PeanoSyntax"; "TypeSyntax"; "PolyListSyntax";
-	 "Zsyntax"] ->
-      warning ("Forgetting obsolete module "^(string_of_id r));
-      mt()
-  | VernacRequire (exp,spe,[Ident(_,r)]) when
-      (* Renamed modules *)
-      List.mem (string_of_id r) ["zarith_aux";"fast_integer"] ->
-      warning ("Replacing obsolete module "^(string_of_id r)^" with ZArith");
-	(str "Require" ++ pr_require_token exp ++ spc() ++
-	(match spe with
-	  | None -> mt()
-	  | Some flag ->
-	      (if flag then str"Specification" else str"Implementation") ++
-	      spc ()) ++
-	str "ZArith.")
-  | VernacImport (false,[Libnames.Ident (_,a)]) when
-      (* Pour ceux qui ont utilisé la couche "Import *_scope" de compat *)
-      let a = Names.string_of_id a in
-      a = "nat_scope" or a = "Z_scope" or a = "R_scope" -> mt()
-  | VernacSyntax _  | VernacGrammar _ as x -> pr_vernac x
-  | VernacPrint PrintLocalContext -> 
-      warning ("\"Print.\" is discontinued");
-      mt ()
-  | x -> pr_vernac x ++ sep_end ()
-
+let pr_vernac v = make_pr_vernac pr_constr_expr pr_lconstr_expr v ++ sep_end ()
diff --git a/translate/ppvernacnew.mli b/parsing/ppvernac.mli
index 4506b811..21d983f5 100644
--- a/translate/ppvernacnew.mli
+++ b/parsing/ppvernac.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: ppvernacnew.mli,v 1.3.2.2 2005/01/21 17:17:20 herbelin Exp $ i*)
+(*i $Id: ppvernac.mli 7744 2005-12-27 09:16:06Z herbelin $ i*)
 
 open Pp
 open Genarg
@@ -15,13 +15,10 @@ open Names
 open Nameops
 open Nametab
 open Util
-open Extend
 open Ppconstr
 open Pptactic
 open Rawterm
-open Coqast
 open Pcoq
-open Ast
 open Libnames
 open Ppextend
 open Topconstr
@@ -29,6 +26,3 @@ open Topconstr
 val sep_end : unit -> std_ppcmds
 
 val pr_vernac : vernac_expr -> std_ppcmds
-
-val pr_vernac_solve : 
-  int * Environ.env * Tacexpr.glob_tactic_expr * bool -> std_ppcmds
diff --git a/parsing/prettyp.ml b/parsing/prettyp.ml
index 1505745c..a22f5796 100644
--- a/parsing/prettyp.ml
+++ b/parsing/prettyp.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: prettyp.ml,v 1.50.2.2 2005/11/21 09:16:28 herbelin Exp $ *)
+(* $Id: prettyp.ml 7938 2006-01-28 22:03:33Z herbelin $ *)
 
 open Pp
 open Util
@@ -20,7 +20,6 @@ open Inductiveops
 open Sign
 open Reduction
 open Environ
-open Instantiate
 open Declare
 open Impargs
 open Libobject
@@ -28,6 +27,7 @@ open Printer
 open Printmod
 open Libnames
 open Nametab
+open Recordops
 
 (*********************)
 (** Basic printing   *)
@@ -58,8 +58,7 @@ let print_impl_args_by_name = function
       str" are implicit" ++ fnl()
 
 let print_impl_args l = 
-  if !Options.v7 then print_impl_args_by_pos (positions_of_implicits l)
-  else print_impl_args_by_name (List.filter is_status_implicit l)
+  print_impl_args_by_name (List.filter is_status_implicit l)
 
 (*********************)
 (** Printing Scopes  *)
@@ -71,7 +70,7 @@ let print_ref reduce ref =
       let ctx,ccl = Reductionops.splay_prod_assum (Global.env()) Evd.empty typ
       in it_mkProd_or_LetIn ccl ctx 
     else typ in
-  hov 0 (pr_global ref ++ str " :" ++ spc () ++ prtype typ) ++ fnl ()
+  hov 0 (pr_global ref ++ str " :" ++ spc () ++ pr_ltype typ) ++ fnl ()
 
 let print_argument_scopes = function
   | [Some sc] -> str"Argument scope is [" ++ str sc ++ str"]" ++ fnl()
@@ -89,9 +88,32 @@ let need_expansion impl ref =
   impl <> [] & let _,lastimpl = list_chop nprods impl in
   List.filter is_status_implicit lastimpl <> []
 
+type opacity =
+  | FullyOpaque
+  | TransparentMaybeOpacified of bool
+
+let opacity env = function
+  | VarRef v when pi2 (Environ.lookup_named v env) <> None -> 
+      Some (TransparentMaybeOpacified (Conv_oracle.is_opaque_var v))
+  | ConstRef cst ->
+      let cb = Environ.lookup_constant cst env in
+      if cb.const_body = None then None
+      else if cb.const_opaque then Some FullyOpaque
+      else Some (TransparentMaybeOpacified (Conv_oracle.is_opaque_cst cst))
+  | _ -> None
+
+let print_opacity ref =
+  match opacity (Global.env()) ref with
+    | None -> mt ()
+    | Some s -> pr_global ref ++ str " is " ++ 
+        str (match s with
+          | FullyOpaque -> "opaque"
+          | TransparentMaybeOpacified true -> "basically transparent but considered opaque for reduction"
+          | TransparentMaybeOpacified false -> "transparent") ++ fnl()
+    
 let print_name_infos ref =
   let impl = implicits_of_global ref in
-  let scopes = Symbols.find_arguments_scope ref in
+  let scopes = Notation.find_arguments_scope ref in
   let type_for_implicit = 
     if need_expansion impl ref then
       (* Need to reduce since implicits are computed with products flattened *)
@@ -127,7 +149,7 @@ let print_inductive_implicit_args =
 
 let print_inductive_argument_scopes =
   print_args_data_of_inductive_ids 
-    Symbols.find_arguments_scope ((<>) None) print_argument_scopes
+    Notation.find_arguments_scope ((<>) None) print_argument_scopes
 
 (*********************)
 (* "Locate" commands *)
@@ -160,8 +182,7 @@ let pr_located_qualid = function
 	| VarRef _ -> "Variable" in
       str ref_str ++ spc () ++ pr_sp (Nametab.sp_of_global ref)
   | Syntactic kn ->
-      str (if !Options.v7 then "Syntactic Definition" else "Notation") ++ 
-      spc () ++ pr_sp (Nametab.sp_of_syntactic_definition kn)
+      str "Notation" ++ spc () ++ pr_sp (Nametab.sp_of_syntactic_definition kn)
   | Dir dir ->
       let s,dir = match dir with
 	| DirOpenModule (dir,_) -> "Open Module", dir
@@ -180,9 +201,9 @@ let print_located_qualid ref =
   let (loc,qid) = qualid_of_reference ref in
   let module N = Nametab in
   let expand = function
-    | TrueGlobal ref -> 
+    | TrueGlobal ref ->
 	Term ref, N.shortest_qualid_of_global Idset.empty ref
-    | SyntacticDef kn -> 
+    | SyntacticDef kn ->
 	Syntactic kn, N.shortest_qualid_of_syndef Idset.empty kn in
   match List.map expand (N.extended_locate_all qid) with
     | [] -> 
@@ -196,7 +217,7 @@ let print_located_qualid ref =
 	(fun (o,oqid) ->
 	  hov 2 (pr_located_qualid o ++
 	  (if oqid <> qid then
-	    spc() ++ str "(visible as " ++ pr_qualid oqid ++ str")"
+	    spc() ++ str "(shorter name to refer to it in current context is " ++ pr_qualid oqid ++ str")"
 	  else
 	    mt ()))) l
 
@@ -204,8 +225,8 @@ let print_located_qualid ref =
 (**** Printing declarations and judgments *)
 
 let print_typed_value_in_env env (trm,typ) =
-  (prterm_env env trm ++ fnl () ++
-     str "     : " ++ prtype_env env typ ++ fnl ())
+  (pr_lconstr_env env trm ++ fnl () ++
+     str "     : " ++ pr_ltype_env env typ ++ fnl ())
 
 let print_typed_value x = print_typed_value_in_env (Global.env ()) x
 
@@ -218,20 +239,20 @@ let print_safe_judgment env j =
   print_typed_value_in_env env (trm, typ)
     
 (* To be improved; the type should be used to provide the types in the
-   abstractions. This should be done recursively inside prterm, so that
+   abstractions. This should be done recursively inside pr_lconstr, so that
    the pretty-print of a proposition (P:(nat->nat)->Prop)(P [u]u)
    synthesizes the type nat of the abstraction on u *)
 
 let print_named_def name body typ =
-  let pbody = prterm body in
-  let ptyp = prtype typ in
+  let pbody = pr_lconstr body in
+  let ptyp = pr_ltype typ in
   (str "*** [" ++ str name ++ str " " ++
      hov 0 (str ":=" ++ brk (1,2) ++ pbody ++ spc () ++
 	      str ":" ++ brk (1,2) ++ ptyp) ++
 	   str "]" ++ fnl ())
 
 let print_named_assum name typ =
-  (str "*** [" ++ str name ++ str " : " ++ prtype typ ++ str "]" ++ fnl ())
+  (str "*** [" ++ str name ++ str " : " ++ pr_ltype typ ++ str "]" ++ fnl ())
 
 let print_named_decl (id,c,typ) =
   let s = string_of_id id in
@@ -246,25 +267,19 @@ let assumptions_for_print lna =
 (* *)
 
 let print_params env params =
-  if List.length params = 0 then 
-    (mt ()) 
-  else
-    if !Options.v7 then
-      (str "[" ++ pr_rel_context env params ++ str "]" ++ brk(1,2))
-    else 
-      (pr_rel_context env params ++ brk(1,2))
+  if params = [] then mt () else pr_rel_context env params ++ brk(1,2)
 
 let print_constructors envpar names types =
   let pc =
     prlist_with_sep (fun () -> brk(1,0) ++ str "| ")
-      (fun (id,c) -> pr_id id ++ str " : " ++ prterm_env envpar c)
+      (fun (id,c) -> pr_id id ++ str " : " ++ pr_lconstr_env envpar c)
       (Array.to_list (array_map2 (fun n t -> (n,t)) names types))
   in 
   hv 0 (str "  " ++ pc)
 
 let build_inductive sp tyi =
   let (mib,mip) = Global.lookup_inductive (sp,tyi) in
-  let params = mip.mind_params_ctxt 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 mip.mind_user_arity args in
@@ -280,7 +295,7 @@ let print_one_inductive (sp,tyi) =
   let envpar = push_rel_context params env in
   hov 0 (
     pr_global (IndRef (sp,tyi)) ++ brk(1,4) ++ print_params env params ++
-    str ": " ++ prterm_env envpar arity ++ str " :=") ++
+    str ": " ++ pr_lconstr_env envpar arity ++ str " :=") ++
   brk(0,2) ++ print_constructors envpar cstrnames cstrtypes
 
 let pr_mutual_inductive finite indl =
@@ -304,11 +319,11 @@ let print_section_variable sp =
   print_name_infos (VarRef sp)
 
 let print_body = function
-  | Some lc  -> prterm (Declarations.force lc)
+  | Some lc  -> pr_lconstr (Declarations.force lc)
   | None -> (str"<no body>")
 
 let print_typed_body (val_0,typ) =
-  (print_body val_0 ++ fnl () ++ str "     : " ++ prtype typ ++ fnl ())
+  (print_body val_0 ++ fnl () ++ str "     : " ++ pr_ltype typ ++ fnl ())
 
 let print_constant with_values sep sp =
   let cb = Global.lookup_constant sp in
@@ -318,11 +333,11 @@ let print_constant with_values sep sp =
     match val_0 with 
     | None -> 
 	str"*** [ " ++ 
-	print_basename sp ++ str " : " ++ cut () ++ prtype typ ++ 
+	print_basename sp ++ str " : " ++ cut () ++ pr_ltype typ ++ 
 	str" ]" ++ fnl ()
     | _ -> 
 	print_basename sp ++ str sep ++ cut () ++
-	(if with_values then print_typed_body (val_0,typ) else prtype typ) ++
+	(if with_values then print_typed_body (val_0,typ) else pr_ltype typ) ++
 	fnl ())
 
 let print_constant_with_infos sp =
@@ -333,17 +348,18 @@ let print_inductive sp = (print_mutual sp)
 let print_syntactic_def sep kn =
   let qid = Nametab.shortest_qualid_of_syndef Idset.empty kn in
   let c = Syntax_def.search_syntactic_definition dummy_loc kn in 
-  (str (if !Options.v7 then "Syntactic Definition " else "Notation ")
-   ++ pr_qualid qid ++ str sep ++ 
-  Constrextern.without_symbols pr_rawterm c ++ fnl ())
+  str "Notation " ++ pr_qualid qid ++ str sep ++ 
+  Constrextern.without_symbols pr_lrawconstr c ++ fnl ()
 
 let print_leaf_entry with_values sep ((sp,kn as oname),lobj) =
   let tag = object_tag lobj in
   match (oname,tag) with
     | (_,"VARIABLE") ->
-	Some (print_section_variable (basename sp))
+	(* Outside sections, VARIABLES still exist but only with universes 
+           constraints *)
+	(try Some(print_section_variable (basename sp)) with Not_found -> None)
     | (_,"CONSTANT") ->
-	Some (print_constant with_values sep kn)
+	Some (print_constant with_values sep (constant_of_kn kn))
     | (_,"INDUCTIVE") ->
 	Some (print_inductive kn)
     | (_,"MODULE") ->
@@ -369,7 +385,7 @@ let rec print_library_entry with_values ent =
 	print_leaf_entry with_values sep (oname,lobj)
     | (oname,Lib.OpenedSection (dir,_)) -> 
         Some (str " >>>>>>> Section " ++ pr_name oname)
-    | (oname,Lib.ClosedSection _) -> 
+    | (oname,Lib.ClosedSection) -> 
         Some (str " >>>>>>> Closed Section " ++ pr_name oname)
     | (_,Lib.CompilingLibrary (dir,_)) ->
 	Some (str " >>>>>>> Library " ++ pr_dirpath dir)
@@ -419,9 +435,9 @@ let read_sec_context r =
     with Not_found ->
       user_err_loc (loc,"read_sec_context", str "Unknown section") in
   let rec get_cxt in_cxt = function
-    | ((_,Lib.OpenedSection ((dir',_),_)) as hd)::rest ->
+    | (_,Lib.OpenedSection ((dir',_),_) as hd)::rest ->
         if dir = dir' then (hd::in_cxt) else get_cxt (hd::in_cxt) rest
-    | ((_,Lib.ClosedSection (_,_,ctxt)) as hd)::rest ->
+    | (_,Lib.ClosedSection)::rest ->
         error "Cannot print the contents of a closed section"
     | [] -> []
     | hd::rest -> get_cxt (hd::in_cxt) rest 
@@ -474,9 +490,7 @@ let print_name ref =
       "print_name" (pr_qualid qid ++ spc () ++ str "not a defined object")
 
 let print_opaque_name qid = 
-  let sigma = Evd.empty in
   let env = Global.env () in
-  let sign = Global.named_context () in
   match global qid with
     | ConstRef cst ->
 	let cb = Global.lookup_constant cst in
@@ -487,19 +501,21 @@ let print_opaque_name qid =
     | IndRef (sp,_) ->
         print_mutual sp
     | ConstructRef cstr -> 
-	let ty = Inductive.type_of_constructor env cstr in
+	let ty = Inductiveops.type_of_constructor env cstr in
 	print_typed_value (mkConstruct cstr, ty)
     | VarRef id ->
         let (_,c,ty) = lookup_named id env in 
 	print_named_decl (id,c,ty)
 
 let print_about ref = 
-  let sigma = Evd.empty in
   let k = locate_any_name ref in
   begin match k with
-  | Term ref -> print_ref false ref ++ print_name_infos ref
-  | Syntactic kn -> print_syntactic_def " := " kn
-  | Dir _ | ModuleType _ | Undefined _ -> mt () end
+  | Term ref -> 
+      print_ref false ref ++ print_name_infos ref ++ print_opacity ref
+  | Syntactic kn ->
+      print_syntactic_def " := " kn
+  | Dir _ | ModuleType _ | Undefined _ ->
+      mt () end
   ++
   hov 0 (str "Expands to: " ++ pr_located_qualid k)
 
@@ -512,38 +528,6 @@ let print_impargs ref =
   (if has_impl then print_impl_args impl 
    else (str "No implicit arguments" ++ fnl ()))
 
-let print_local_context () =
-  let env = Lib.contents_after None in
-  let rec print_var_rec = function 
-    | [] -> (mt ())
-    | (oname,Lib.Leaf lobj)::rest ->
-	if "VARIABLE" = object_tag lobj then
-          let d = get_variable (basename (fst oname)) in 
-	  (print_var_rec rest ++
-             print_named_decl d)
-	else 
-	  print_var_rec rest
-    | _::rest -> print_var_rec rest
-
-  and print_last_const = function
-    | (oname,Lib.Leaf lobj)::rest -> 
-        (match object_tag lobj with
-           | "CONSTANT" -> 
-	       let kn = snd oname in
-               let {const_body=val_0;const_type=typ} = 
-		 Global.lookup_constant kn in
-		 (print_last_const rest ++
-                  print_basename kn ++str" = " ++
-                  print_typed_body (val_0,typ))
-           | "INDUCTIVE" -> 
-	       let kn = snd oname in
-               (print_last_const rest ++print_mutual kn ++ fnl ())
-           | "VARIABLE" ->  (mt ())
-           | _          ->  print_last_const rest)
-    | _ -> (mt ())
-  in 
-  (print_var_rec env ++  print_last_const env)
-
 let unfold_head_fconst = 
   let rec unfrec k = match kind_of_term k with
     | Const cst -> constant_value (Global.env ()) cst 
@@ -563,17 +547,17 @@ let inspect depth =
 
 open Classops
 
-let print_coercion_value v = prterm (get_coercion_value v)
+let print_coercion_value v = pr_lconstr (get_coercion_value v)
 
 let print_class i =
   let cl,_ = class_info_from_index i in
   pr_class cl
   
 let print_path ((i,j),p) = 
-  (str"[" ++ 
-     prlist_with_sep pr_semicolon print_coercion_value p ++
-     str"] : " ++ print_class i ++ str" >-> " ++
-     print_class j)
+  hov 2 (
+    str"[" ++ hov 0 (prlist_with_sep pr_semicolon print_coercion_value p) ++
+    str"] : ") ++
+  print_class i ++ str" >-> " ++ print_class j
 
 let _ = Classops.install_path_printer print_path
 
@@ -604,4 +588,9 @@ let print_path_between cls clt =
   in
   print_path ((i,j),p)
 
+let print_canonical_projections () =
+  prlist_with_sep pr_fnl (fun ((r1,r2),o) -> 
+    pr_global r2 ++ str " <- " ++ pr_global r1 ++ str " ( " ++ pr_lconstr o.o_DEF ++ str " )")
+    (canonical_projections ())
+
 (*************************************************************************)
diff --git a/parsing/prettyp.mli b/parsing/prettyp.mli
index c8471330..13c11db7 100644
--- a/parsing/prettyp.mli
+++ b/parsing/prettyp.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: prettyp.mli,v 1.12.2.1 2004/07/16 19:30:40 herbelin Exp $ i*)
+(*i $Id: prettyp.mli 7740 2005-12-26 20:07:21Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -42,7 +42,6 @@ val build_inductive : mutual_inductive -> int ->
 val print_mutual : mutual_inductive -> std_ppcmds
 val print_name : reference -> std_ppcmds
 val print_opaque_name : reference -> std_ppcmds
-val print_local_context : unit -> std_ppcmds
 val print_about : reference -> std_ppcmds
 val print_impargs : reference -> std_ppcmds
 
@@ -57,6 +56,7 @@ val print_graph : unit -> std_ppcmds
 val print_classes : unit -> std_ppcmds
 val print_coercions : unit -> std_ppcmds
 val print_path_between : Classops.cl_typ -> Classops.cl_typ -> std_ppcmds
+val print_canonical_projections : unit -> std_ppcmds
 
 val inspect : int -> std_ppcmds
 
diff --git a/parsing/printer.ml b/parsing/printer.ml
index dfacc764..82676b79 100644
--- a/parsing/printer.ml
+++ b/parsing/printer.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: printer.ml,v 1.58.2.1 2004/07/16 19:30:40 herbelin Exp $ *)
+(* $Id: printer.ml 7855 2006-01-12 08:21:57Z herbelin $ *)
 
 open Pp
 open Util
@@ -18,139 +18,100 @@ open Sign
 open Environ
 open Global
 open Declare
-open Coqast
-open Ast
-open Termast
 open Libnames
-open Extend
 open Nametab
 open Ppconstr
+open Evd
+open Proof_type
+open Refiner
+open Pfedit
+open Ppconstr
+open Constrextern
 
 let emacs_str s = if !Options.print_emacs then s else "" 
 
 (**********************************************************************)
-(* Old Ast printing *)
-
-let constr_syntax_universe = "constr"
-(* This is starting precedence for printing constructions or tactics *)
-(* Level 9 means no parentheses except for applicative terms (at level 10) *)
-let constr_initial_prec_v7 = Some (9,Ppextend.L)
-let constr_initial_prec = Some (200,Ppextend.E)
-
-let dfltpr ast = (str"#GENTERM " ++ print_ast ast);;
-
-let global_const_name kn =
-  try pr_global Idset.empty (ConstRef kn)
-  with Not_found -> (* May happen in debug *)
-    (str ("CONST("^(string_of_kn kn)^")"))
-
-let global_var_name id =
-  try pr_global Idset.empty (VarRef id)
-  with Not_found -> (* May happen in debug *)
-    (str ("SECVAR("^(string_of_id id)^")"))
-
-let global_ind_name (kn,tyi) =
-  try pr_global Idset.empty (IndRef (kn,tyi))
-  with Not_found -> (* May happen in debug *)
-    (str ("IND("^(string_of_kn kn)^","^(string_of_int tyi)^")"))
-
-let global_constr_name ((kn,tyi),i) =
-  try pr_global Idset.empty (ConstructRef ((kn,tyi),i))
-  with Not_found -> (* May happen in debug *)
-    (str ("CONSTRUCT("^(string_of_kn kn)^","^(string_of_int tyi)
-		  ^","^(string_of_int i)^")"))
-
-let globpr gt = match gt with
-  | Nvar(_,s) -> (pr_id s)
-  | Node(_,"EVAR", [Num (_,ev)]) -> (str ("?" ^ (string_of_int ev)))
-  | Node(_,"CONST",[Path(_,sl)]) ->
-      global_const_name (section_path sl)
-  | Node(_,"SECVAR",[Nvar(_,s)]) ->
-      global_var_name s
-  | Node(_,"MUTIND",[Path(_,sl); Num(_,tyi)]) ->
-      global_ind_name (section_path sl, tyi)
-  | Node(_,"MUTCONSTRUCT",[Path(_,sl); Num(_,tyi); Num(_,i)]) ->
-      global_constr_name ((section_path sl, tyi), i)
-  | Dynamic(_,d) ->
-    if (Dyn.tag d) = "constr" then (str"<dynamic [constr]>")
-    else dfltpr gt
-  | gt -> dfltpr gt
-
-
-let wrap_exception = function
-    Anomaly (s1,s2) ->
-      warning ("Anomaly ("^s1^")"); pp s2;
-      str"<PP error: non-printable term>"
-  | Failure _ | UserError _ | Not_found ->
-      str"<PP error: non-printable term>"
-  | s -> raise s
-
-let gentermpr_fail gt =
-  let prec =
-    if !Options.v7 then constr_initial_prec_v7 else constr_initial_prec in
-  Esyntax.genprint globpr constr_syntax_universe prec gt
-
-let gentermpr gt =
-  try gentermpr_fail gt
-  with s -> wrap_exception s
+(** Terms                                                             *)
 
-(**********************************************************************)
-(* Generic printing: choose old or new printers *)
+  (* [at_top] means ids of env must be avoided in bound variables *)
+let pr_constr_core at_top env t =
+  pr_constr_expr (extern_constr at_top env t)
+let pr_lconstr_core at_top env t =
+  pr_lconstr_expr (extern_constr at_top env t)
+
+let pr_lconstr_env_at_top env = pr_lconstr_core true env
+let pr_lconstr_env env = pr_lconstr_core false env
+let pr_constr_env env = pr_constr_core false env
+
+  (* NB do not remove the eta-redexes! Global.env() has side-effects... *)
+let pr_lconstr t = pr_lconstr_env (Global.env()) t
+let pr_constr t = pr_constr_env (Global.env()) t
+
+let pr_type_core at_top env t =
+  pr_constr_expr (extern_type at_top env t)
+let pr_ltype_core at_top env t =
+  pr_lconstr_expr (extern_type at_top env t)
+
+let pr_ltype_env_at_top env = pr_ltype_core true env
+let pr_ltype_env env = pr_ltype_core false env
+let pr_type_env env = pr_type_core false env
+
+let pr_ltype t = pr_ltype_env (Global.env()) t
+let pr_type t = pr_type_env (Global.env()) t
+
+let pr_ljudge_env env j =
+  (pr_lconstr_env env j.uj_val, pr_lconstr_env env j.uj_type)
+
+let pr_ljudge j = pr_ljudge_env (Global.env()) j
+
+let pr_lrawconstr_env env c =
+  pr_lconstr_expr (extern_rawconstr (vars_of_env env) c)
+let pr_rawconstr_env env c = 
+  pr_constr_expr (extern_rawconstr (vars_of_env env) c)
+
+let pr_lrawconstr c =
+  pr_lconstr_expr (extern_rawconstr Idset.empty c)
+let pr_rawconstr c =
+  pr_constr_expr (extern_rawconstr Idset.empty c)
 
-(* [at_top] means ids of env must be avoided in bound variables *)
-let gentermpr_core at_top env t =
-  if !Options.v7 then gentermpr (Termast.ast_of_constr at_top env t)
-  else Ppconstrnew.pr_lconstr (Constrextern.extern_constr at_top env t)
 let pr_cases_pattern t =
-  if !Options.v7 then gentermpr (Termast.ast_of_cases_pattern t)
-  else Ppconstrnew.pr_cases_pattern
-    (Constrextern.extern_cases_pattern Idset.empty t)
-let pr_pattern_env tenv env t =
-  if !Options.v7 then gentermpr (Termast.ast_of_pattern tenv env t)
-  else Ppconstrnew.pr_constr
-    (Constrextern.extern_pattern tenv env t)
+  pr_cases_pattern_expr (extern_cases_pattern Idset.empty t)
+
+let pr_constr_pattern_env env c =
+  pr_constr_expr (extern_constr_pattern (names_of_rel_context env) c)
+let pr_constr_pattern t =
+  pr_constr_expr (extern_constr_pattern empty_names_context t)
+
+let _ = Termops.set_print_constr pr_lconstr_env
 
 (**********************************************************************)
-(* Derived printers *)
-  
-let prterm_env_at_top env = gentermpr_core true env
-let prterm_env env = gentermpr_core false env
-let prtype_env env typ = prterm_env env typ
-let prjudge_env env j =
-  (prterm_env env j.uj_val, prterm_env env j.uj_type)
-
-(* NB do not remove the eta-redexes! Global.env() has side-effects... *)
-let prterm t = prterm_env (Global.env()) t
-let prtype t = prtype_env (Global.env()) t
-let prjudge j = prjudge_env (Global.env()) j
-
-let pr_constant env cst = prterm_env env (mkConst cst)
-let pr_existential env ev = prterm_env env (mkEvar ev)
-let pr_inductive env ind = prterm_env env (mkInd ind)
-let pr_constructor env cstr = prterm_env env (mkConstruct cstr)
-let pr_global = pr_global Idset.empty
-
-let pr_rawterm t =
-  if !Options.v7 then gentermpr (Termast.ast_of_rawconstr t)
-  else Ppconstrnew.pr_lconstr (Constrextern.extern_rawconstr Idset.empty t)
-
-open Pattern
-let pr_ref_label = function (* On triche sur le contexte *)
-  | ConstNode sp -> pr_constant (Global.env()) sp
-  | IndNode sp -> pr_inductive (Global.env()) sp
-  | CstrNode sp -> pr_constructor (Global.env()) sp
-  | VarNode id -> pr_id id
-
-let pr_pattern t = pr_pattern_env (Global.env()) empty_names_context t
+(* Global references *)
+
+let pr_global_env = pr_global_env
+let pr_global = pr_global_env Idset.empty
+
+let pr_constant env cst = pr_global_env (vars_of_env env) (ConstRef cst)
+let pr_existential env ev = pr_lconstr_env env (mkEvar ev)
+let pr_inductive env ind = pr_lconstr_env env (mkInd ind)
+let pr_constructor env cstr = pr_lconstr_env env (mkConstruct cstr)
+
+let pr_evaluable_reference ref =
+ let ref' = match ref with
+  | EvalConstRef const -> ConstRef const
+  | EvalVarRef sp -> VarRef sp in
+ pr_global ref'
+
+(**********************************************************************)
+(* Contexts and declarations                                          *)
 
 let pr_var_decl env (id,c,typ) =
   let pbody = match c with
     | None ->  (mt ())
     | Some c ->
 	(* Force evaluation *) 
-	let pb = prterm_env env c in
+	let pb = pr_lconstr_env env c in
 	(str" := " ++ pb ++ cut () ) in
-  let pt = prtype_env env typ in
+  let pt = pr_ltype_env env typ in
   let ptyp = (str" : " ++ pt) in
   (pr_id id ++ hov 0 (pbody ++ ptyp))
 
@@ -159,9 +120,9 @@ let pr_rel_decl env (na,c,typ) =
     | None -> mt ()
     | Some c ->
 	(* Force evaluation *) 
-	let pb = prterm_env env c in
+	let pb = pr_lconstr_env env c in
 	(str":=" ++ spc () ++ pb ++ spc ()) in
-  let ptyp = prtype_env env typ in
+  let ptyp = pr_ltype_env env typ in
   match na with
   | Anonymous -> hov 0 (str"<>" ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
   | Name id -> hov 0 (pr_id id ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
@@ -177,22 +138,25 @@ let pr_named_context_of env =
 	  (fun env d pps -> pps ++ ws 2 ++ pr_var_decl env d)
           env ~init:(mt ()))
 
+let pr_named_context env ne_context = 
+  hv 0 (Sign.fold_named_context
+	  (fun d pps -> pps ++ ws 2 ++ pr_var_decl env d)
+          ne_context ~init:(mt ()))
+
 let pr_rel_context env rel_context =
   let rec prec env = function
     | [] -> (mt ()) 
-    | [b] -> 
-	if !Options.v7 then pr_rel_decl env b
-	else str "(" ++ pr_rel_decl env b ++ str")"
+    | [b] -> str "(" ++ pr_rel_decl env b ++ str")"
     | b::rest ->
         let pb = pr_rel_decl env b in
         let penvtl = prec (push_rel b env) rest in
-	if !Options.v7 then
-          (pb ++ str";" ++ spc () ++ penvtl)
-	else 
-          (str "(" ++ pb ++ str")" ++ spc () ++ penvtl)
+        str "(" ++ pb ++ str")" ++ spc () ++ penvtl
   in 
   hov 0 (prec env (List.rev rel_context))
 
+let pr_rel_context_of env =
+  pr_rel_context env (rel_context env)
+
 (* Prints an env (variables and de Bruijn). Separator: newline *)
 let pr_context_unlimited env =
   let sign_env =
@@ -247,3 +211,168 @@ let pr_context_limit n env =
 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 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 ()
+
+(* 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
+
+(* display evar type: a context and a type *)
+let pr_evgl_sign gl = 
+  let ps = pr_named_context_of (evar_env gl) in
+  let pc = pr_lconstr gl.evar_concl in
+  hov 0 (str"["  ++ ps ++ spc () ++ str"|- "  ++ pc ++ str"]")
+
+(* Print an enumerated list of existential variables *)
+let rec pr_evars_int i = function
+  | [] -> (mt ())
+  | (ev,evd)::rest ->
+      let pegl = pr_evgl_sign evd in 
+      let pei = pr_evars_int (i+1) rest in
+      (hov 0 (str "Existential " ++ int i ++ str " =" ++ spc () ++
+              str (string_of_existential ev)  ++ str " : " ++ pegl)) ++ 
+      fnl () ++ pei
+
+let pr_subgoal n =
+  let rec prrec p = function
+    | [] -> error "No such goal"
+    | g::rest ->
+       	if p = 1 then
+          let pg = pr_goal g in
+          v 0 (str "subgoal " ++ int n ++ str " is:" ++ cut () ++ pg)
+       	else 
+	  prrec (p-1) rest
+  in 
+  prrec n
+
+(* Print open subgoals. Checks for uninstantiated existential variables *)
+let pr_subgoals 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))
+  | [g] ->
+      let pg = pr_goal g in
+      v 0 (str ("1 "^"subgoal") ++cut () ++ pg)
+  | g1::rest ->
+      let rec pr_rec n = function
+        | [] -> (mt ())
+        | g::rest ->
+            let pc = pr_concl n g in
+            let prest = pr_rec (n+1) rest in
+            (cut () ++ pc ++ prest) 
+      in
+      let pg1 = pr_goal g1 in
+      let prest = pr_rec 2 rest in
+      v 0 (int(List.length rest+1) ++ str" subgoals" ++ cut () 
+	   ++ pg1 ++ prest ++ fnl ())
+
+
+let pr_subgoals_of_pfts pfts = 
+  let gls = fst (Refiner.frontier (proof_of_pftreestate pfts)) in 
+  let sigma = (top_goal_of_pftreestate pfts).sigma in
+  pr_subgoals sigma gls
+
+let pr_open_subgoals () =
+  let pfts = get_pftreestate () in
+  match focus() with
+    | 0 -> 
+	pr_subgoals_of_pfts pfts
+    | n -> 
+	let pf = proof_of_pftreestate pfts in
+	let gls = fst (frontier pf) in 
+	assert (n > List.length gls);
+	if List.length gls < 2 then 
+	  pr_subgoal n gls
+	else 
+	  v 0 (int(List.length gls) ++ str" subgoals" ++ cut () ++
+	  pr_subgoal n gls)
+
+let pr_nth_open_subgoal n =
+  let pf = proof_of_pftreestate (get_pftreestate ()) in
+  pr_subgoal n (fst (frontier pf))
+
+(* Elementary tactics *)
+
+let pr_prim_rule = function
+  | Intro id -> 
+      str"intro " ++ pr_id id
+	
+  | Intro_replacing id -> 
+      (str"intro replacing "  ++ pr_id id)
+	
+  | Cut (b,id,t) ->
+      if b then
+        (str"assert " ++ pr_constr t)
+      else
+        (str"cut " ++ pr_constr t ++ str ";[intro " ++ pr_id id ++ str "|idtac]")
+	
+  | FixRule (f,n,[]) ->
+      (str"fix " ++ pr_id f ++ str"/" ++ int n)
+      
+  | FixRule (f,n,others) -> 
+      let rec print_mut = function
+	| (f,n,ar)::oth -> 
+           pr_id f ++ str"/" ++ int n ++ str" : " ++ pr_lconstr ar ++ print_mut oth
+        | [] -> mt () in
+      (str"fix " ++ pr_id f ++ str"/" ++ int n ++
+         str" with " ++ print_mut others)
+
+  | Cofix (f,[]) ->
+      (str"cofix " ++ pr_id f)
+
+  | Cofix (f,others) ->
+      let rec print_mut = function
+	| (f,ar)::oth ->
+	  (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
+      
+  | Convert_concl (c,_) ->
+      (str"change "  ++ pr_constr c)
+      
+  | Convert_hyp (id,None,t) ->
+      (str"change "  ++ pr_constr t  ++ spc ()  ++ str"in "  ++ pr_id id)
+
+  | Convert_hyp (id,Some c,t) ->
+      (str"change "  ++ pr_constr c  ++ spc ()  ++ str"in "
+       ++ pr_id id ++ str" (type of "  ++ pr_id id ++ str ")")
+      
+  | Thin ids ->
+      (str"clear "  ++ prlist_with_sep pr_spc pr_id ids)
+      
+  | ThinBody ids ->
+      (str"clearbody "  ++ prlist_with_sep pr_spc pr_id ids)
+      
+  | Move (withdep,id1,id2) ->
+      (str (if withdep then "dependent " else "") ++
+	 str"move "  ++ pr_id id1 ++ str " after " ++ pr_id id2)
+
+  | Rename (id1,id2) ->
+      (str "rename " ++ pr_id id1 ++ str " into " ++ pr_id id2)
+
+(* Backwards compatibility *)
+
+let prterm = pr_lconstr
+
diff --git a/parsing/printer.mli b/parsing/printer.mli
index c44be124..66471d41 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,v 1.26.2.2 2005/01/21 16:42:37 herbelin Exp $ i*)
+(*i $Id: printer.mli 7855 2006-01-12 08:21:57Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -19,42 +19,82 @@ open Rawterm
 open Pattern
 open Nametab
 open Termops
+open Evd
+open Proof_type
+open Rawterm
 (*i*)
 
 (* These are the entry points for printing terms, context, tac, ... *)
-(*i
-val gentacpr  : Tacexpr.raw_tactic_expr -> std_ppcmds
-i*)
-
-val prterm_env      : env -> constr -> std_ppcmds
-val prterm_env_at_top : env -> constr -> std_ppcmds
-val prterm          : constr -> std_ppcmds
-val prtype_env      : env -> types -> std_ppcmds
-val prtype          : types -> std_ppcmds
-val prjudge_env     :
-  env -> Environ.unsafe_judgment -> std_ppcmds * std_ppcmds
-val prjudge         : Environ.unsafe_judgment -> std_ppcmds * std_ppcmds
-
-val pr_rawterm       : Rawterm.rawconstr -> std_ppcmds
-val pr_cases_pattern : Rawterm.cases_pattern -> std_ppcmds
-
-val pr_constant     : env -> constant -> std_ppcmds
-val pr_existential  : env -> existential -> std_ppcmds
-val pr_constructor  : env -> constructor -> std_ppcmds
-val pr_inductive    : env -> inductive -> std_ppcmds
-val pr_global       : global_reference -> std_ppcmds
-val pr_ref_label    : constr_label -> std_ppcmds
-val pr_pattern      : constr_pattern -> std_ppcmds
-val pr_pattern_env  : env -> names_context -> constr_pattern -> std_ppcmds
-
-val pr_ne_context_of : std_ppcmds -> env -> std_ppcmds
-
-val pr_var_decl     : env -> named_declaration -> std_ppcmds
-val pr_rel_decl     : env -> rel_declaration -> std_ppcmds
-
-val pr_named_context_of : env -> std_ppcmds
-val pr_rel_context  : env -> rel_context -> std_ppcmds
-val pr_context_of   : env -> std_ppcmds
-
-val emacs_str       : string -> string
 
+(* Terms *)
+
+val pr_lconstr_env         : env -> constr -> std_ppcmds
+val pr_lconstr_env_at_top  : env -> constr -> std_ppcmds
+val pr_lconstr             : constr -> std_ppcmds
+
+val pr_constr_env          : env -> constr -> std_ppcmds
+val pr_constr              : constr -> std_ppcmds
+
+val pr_ltype_env           : env -> types -> std_ppcmds
+val pr_ltype               : types -> std_ppcmds
+
+val pr_type_env            : env -> types -> std_ppcmds
+val pr_type                : types -> std_ppcmds
+
+val pr_ljudge_env          : env -> unsafe_judgment -> std_ppcmds * std_ppcmds
+val pr_ljudge              : unsafe_judgment -> std_ppcmds * std_ppcmds
+
+val pr_lrawconstr_env      : env -> rawconstr -> std_ppcmds
+val pr_lrawconstr          : rawconstr -> std_ppcmds
+
+val pr_rawconstr_env       : env -> rawconstr -> std_ppcmds
+val pr_rawconstr           : rawconstr -> std_ppcmds
+
+val pr_constr_pattern_env  : env -> constr_pattern -> std_ppcmds
+val pr_constr_pattern      : constr_pattern -> std_ppcmds
+
+val pr_cases_pattern       : cases_pattern -> std_ppcmds
+
+(* Printing global references using names as short as possible *)
+
+val pr_global_env          : Idset.t -> global_reference -> std_ppcmds
+val pr_global              : global_reference -> std_ppcmds
+
+val pr_constant            : env -> constant -> std_ppcmds
+val pr_existential         : env -> existential -> std_ppcmds
+val pr_constructor         : env -> constructor -> std_ppcmds
+val pr_inductive           : env -> inductive -> std_ppcmds
+val pr_evaluable_reference : evaluable_global_reference -> std_ppcmds
+
+(* Contexts *)
+
+val pr_ne_context_of       : std_ppcmds -> env -> std_ppcmds
+
+val pr_var_decl            : env -> named_declaration -> std_ppcmds
+val pr_rel_decl            : env -> rel_declaration -> std_ppcmds
+
+val pr_named_context       : env -> named_context -> std_ppcmds
+val pr_named_context_of    : env -> std_ppcmds
+val pr_rel_context         : env -> rel_context -> std_ppcmds
+val pr_rel_context_of      : env -> std_ppcmds
+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_subgoal             : int -> goal list -> std_ppcmds
+
+val pr_open_subgoals       : unit -> std_ppcmds
+val pr_nth_open_subgoal    : int -> std_ppcmds
+val pr_evars_int           : int -> (evar * evar_info) list -> std_ppcmds
+
+val pr_prim_rule           : prim_rule -> std_ppcmds
+
+(* Emacs/proof general support *)
+
+val emacs_str              : string -> string
+
+(* Backwards compatibility *)
+
+val prterm                 : constr -> std_ppcmds (* = pr_lconstr *)
diff --git a/parsing/q_constr.ml4 b/parsing/q_constr.ml4
new file mode 100644
index 00000000..768bc45c
--- /dev/null
+++ b/parsing/q_constr.ml4
@@ -0,0 +1,124 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: g_constr.ml4,v 1.58 2005/12/30 10:55:32 herbelin Exp $ *)
+
+open Rawterm
+open Term
+open Names
+open Pattern
+open Q_util
+open Util
+open Pcaml
+
+let loc = dummy_loc
+let dloc = <:expr< Util.dummy_loc >>
+
+let apply_ref f l = 
+  <:expr< 
+    Rawterm.RApp ($dloc$, Rawterm.RRef ($dloc$, Lazy.force $f$), $mlexpr_of_list (fun x -> x) l$)
+  >>
+
+EXTEND
+  GLOBAL: expr;
+  expr:
+    [ [ "PATTERN"; "["; c = constr; "]" ->
+      <:expr< snd (Pattern.pattern_of_rawconstr $c$) >> ] ]
+  ;
+  sort:
+    [ [ "Set"  -> RProp Pos
+      | "Prop" -> RProp Null
+      | "Type" -> RType None ] ]
+  ;
+  ident:
+    [ [ s = string -> <:expr< Names.id_of_string $str:s$ >> ] ]
+  ;
+  name:
+    [ [ "_" -> <:expr< Anonymous >> | id = ident -> <:expr< Name $id$ >> ] ]
+  ;
+  string:
+    [ [ UIDENT | LIDENT ] ]
+  ;
+  constr:
+    [ "200" RIGHTA
+      [ LIDENT "forall"; id = ident; ":"; c1 = constr; ","; c2 = constr ->
+        <:expr< Rawterm.RProd ($dloc$,Name $id$,$c1$,$c2$) >>
+      | "fun"; id = ident; ":"; c1 = constr; "=>"; c2 = constr ->
+        <:expr< Rawterm.RLambda ($dloc$,Name $id$,$c1$,$c2$) >>
+      | "let"; id = ident; ":="; c1 = constr; "in"; c2 = constr ->
+        <:expr< Rawterm.RLetin ($dloc$,Name $id$,$c1$,$c2$) >>
+      (* fix todo *)
+      ]
+    | "100" RIGHTA
+      [ c1 = constr; ":"; c2 = SELF -> 
+        <:expr< Rawterm.RCast($dloc$,$c1$,DEFAULTcast,$c2$) >> ]
+    | "90" RIGHTA
+      [ c1 = constr; "->"; c2 = SELF -> 
+        <:expr< Rawterm.RProd ($dloc$,Anonymous,$c1$,$c2$) >> ]
+    | "75" RIGHTA
+      [ "~"; c = constr -> 
+        apply_ref <:expr< coq_not_ref >> [c] ]
+    | "70" RIGHTA
+      [ c1 = constr; "="; c2 = NEXT; ":>"; t = NEXT ->
+        apply_ref <:expr< coq_eq_ref >> [t;c1;c2] ]
+    | "10" LEFTA
+      [ f = constr; args = LIST1 NEXT ->
+        let args = mlexpr_of_list (fun x -> x) args in
+        <:expr< Rawterm.RApp ($dloc$,$f$,$args$) >> ]
+    | "0"
+      [ s = sort -> <:expr< Rawterm.RSort ($dloc$,s) >>
+      | id = ident -> <:expr< Rawterm.RVar ($dloc$,$id$) >>
+      | "_" -> <:expr< Rawterm.RHole ($dloc$,QuestionMark) >>
+      | "?"; id = ident -> <:expr< Rawterm.RPatVar($dloc$,(False,$id$)) >>
+      | "{"; c1 = constr; "}"; "+"; "{"; c2 = constr; "}" ->
+          apply_ref <:expr< coq_sumbool_ref >> [c1;c2]
+      | "%"; e = string -> <:expr< Rawterm.RRef ($dloc$,Lazy.force $lid:e$) >>
+      | c = match_constr -> c
+      | "("; c = constr LEVEL "200"; ")" -> c ] ]
+  ;
+  match_constr:
+    [ [ "match"; c = constr LEVEL "100"; (ty,nal) = match_type;
+        "with"; OPT"|"; br = LIST0 eqn SEP "|"; "end" -> 
+          let br = mlexpr_of_list (fun x -> x) br in
+     <:expr< Rawterm.RCases ($dloc$,$ty$,[($c$,$nal$)],$br$) >> 
+    ] ]
+  ;
+  match_type:
+    [ [ "as"; id = ident; "in"; ind = LIDENT; nal = LIST0 name;  
+        "return"; ty = constr LEVEL "100" -> 
+          let nal = mlexpr_of_list (fun x -> x) nal in
+          <:expr< Some $ty$ >>, 
+          <:expr< (Name $id$, Some ($dloc$,$lid:ind$,$nal$)) >> 
+      | -> <:expr< None >>, <:expr< (Anonymous, None) >> ] ]
+  ;
+  eqn:
+    [ [ (lid,pl) = pattern; "=>"; rhs = constr -> 
+        let lid = mlexpr_of_list (fun x -> x) lid in
+        <:expr< ($dloc$,$lid$,[$pl$],$rhs$) >> 
+    ] ]
+  ;
+  pattern: 
+    [ [ "%"; e = string; lip = LIST0 patvar ->
+        let lp = mlexpr_of_list (fun (_,x) -> x) lip in
+        let lid = List.flatten (List.map fst lip) in
+        lid, <:expr< Rawterm.PatCstr ($dloc$,$lid:e$,$lp$,Anonymous) >>
+      | p = patvar -> p
+      | "("; p = pattern; ")" -> p ] ]
+  ;
+  patvar:
+    [ [ "_" -> [], <:expr< Rawterm.PatVar ($dloc$,Anonymous) >> 
+      | id = ident -> [id], <:expr< Rawterm.PatVar ($dloc$,Name $id$) >> 
+    ] ]
+  ;
+  END;;
+
+(* Example 
+open Coqlib
+let a = PATTERN [ match ?X with %path_of_S n => n | %path_of_O => ?X end ]
+*)
+
diff --git a/parsing/q_coqast.ml4 b/parsing/q_coqast.ml4
index e8e1830a..35801f73 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,v 1.47.2.6 2005/05/15 12:47:05 herbelin Exp $ *)
+(* $Id: q_coqast.ml4 8651 2006-03-21 21:54:43Z jforest $ *)
 
 open Util
 open Names
@@ -21,7 +21,7 @@ let purge_str s =
 
 let anti loc x =
   let e =
-    let loc = 
+    let loc =
       ifdef OCAML_308 then
         loc
       else
@@ -30,87 +30,6 @@ let anti loc x =
   in
   <:expr< $anti:e$ >>
 
-(* [mlexpr_of_ast] contributes to translate g_*.ml4 files into g_*.ppo *)
-(* This is where $id's (and macros) in ast are translated in ML variables *)
-(* which will bind their actual ast value *)
-
-let rec mlexpr_of_ast = function
-  | Coqast.Nmeta (loc, id) -> anti loc id
-  | Coqast.Id (loc, id) when is_meta id -> <:expr< Coqast.Id loc $anti loc id$ >>
-  | Coqast.Node (_, "$VAR", [Coqast.Nmeta (loc, x)]) ->
-      <:expr< let s = $anti loc x$ in
-      if String.length s > 0 && String.sub s 0 1 = "$" then
-	failwith "Wrong ast: $VAR should not be bound to a meta variable"
-      else
-	Coqast.Nvar loc (Names.id_of_string s) >>
-  | Coqast.Node (_, "$PATH", [Coqast.Nmeta (loc, x)]) ->
-      <:expr< Coqast.Path loc $anti loc x$ >>
-  | Coqast.Node (_, "$ID", [Coqast.Nmeta (loc, x)]) ->
-      <:expr< Coqast.Id loc $anti loc x$ >>
-  | Coqast.Node (_, "$STR", [Coqast.Nmeta (loc, x)]) ->
-      <:expr< Coqast.Str loc $anti loc x$ >>
-(* Obsolète
-  | Coqast.Node _ "$SLAM" [Coqast.Nmeta loc idl; y] ->
-      <:expr<
-      List.fold_right (Pcoq.slam_ast loc) $anti loc idl$ $mlexpr_of_ast y$ >>
-*)
-  | Coqast.Node (loc, "$ABSTRACT", [Coqast.Str (_, s); x; y]) ->
-      let x = mlexpr_of_ast x in
-      let y = mlexpr_of_ast y in
-      <:expr< Ast.abstract_binders_ast loc $str:s$ $x$ $y$ >>
-  | Coqast.Node (loc, nn, al) ->
-      let e = expr_list_of_ast_list al in
-      <:expr< Coqast.Node loc $str:nn$ $e$ >>
-  | Coqast.Nvar (loc, id) ->
-      <:expr< Coqast.Nvar loc (Names.id_of_string $str:Names.string_of_id id$) >>
-  | Coqast.Slam (loc, None, a) ->
-      <:expr< Coqast.Slam loc None $mlexpr_of_ast a$ >>
-  | Coqast.Smetalam (loc, s, a) ->
-      <:expr< 
-      match $anti loc s$ with
-	[ Coqast.Nvar _ id -> Coqast.Slam loc (Some id) $mlexpr_of_ast a$
-	| Coqast.Nmeta _ s -> Coqast.Smetalam loc s $mlexpr_of_ast a$
-	| _ -> failwith "Slam expects a var or a metavar" ] >>
-  | Coqast.Slam (loc, Some s, a) ->
-      let se = <:expr< Names.id_of_string $str:Names.string_of_id s$ >> in
-      <:expr< Coqast.Slam loc (Some $se$) $mlexpr_of_ast a$ >>
-  | Coqast.Num (loc, i) -> <:expr< Coqast.Num loc $int:string_of_int i$ >>
-  | Coqast.Id (loc, id) -> <:expr< Coqast.Id loc $str:id$ >>
-  | Coqast.Str (loc, str) -> <:expr< Coqast.Str loc $str:str$ >>
-  | Coqast.Path (loc, kn) ->
-      let l,a = Libnames.decode_kn kn in
-      let mlexpr_of_modid id =
-	<:expr< Names.id_of_string $str:string_of_id id$ >> in
-      let e = List.map mlexpr_of_modid (repr_dirpath l) in
-      let e = expr_list_of_var_list e in
-      <:expr< Coqast.Path loc (Libnames.encode_kn (Names.make_dirpath $e$)
-                (Names.id_of_string $str:Names.string_of_id a$)) >> 
-  | Coqast.Dynamic (_, _) ->
-      failwith "Q_Coqast: dynamic: not implemented"
-
-and expr_list_of_ast_list al =
-  List.fold_right
-    (fun a e2 -> match a with
-       | (Coqast.Node (_, "$LIST", [Coqast.Nmeta (locv, pv)])) ->
-           let e1 = anti locv pv in
-           let loc = (fst(MLast.loc_of_expr e1), snd(MLast.loc_of_expr e2)) in
-	     if e2 = (let loc = dummy_loc in <:expr< [] >>)
-	     then <:expr< $e1$ >>
-	     else <:expr< ( $lid:"@"$ $e1$ $e2$) >>
-       | _ ->
-           let e1 = mlexpr_of_ast a in
-           let loc = (fst(MLast.loc_of_expr e1), snd(MLast.loc_of_expr e2)) in
-	   <:expr< [$e1$ :: $e2$] >> )
-    al (let loc = dummy_loc in <:expr< [] >>)
-
-and expr_list_of_var_list sl =
-  let loc = dummy_loc in
-  List.fold_right
-    (fun e1 e2 ->
-       let loc = (fst (MLast.loc_of_expr e1), snd (MLast.loc_of_expr e2)) in
-       <:expr< [$e1$ :: $e2$] >>)
-    sl <:expr< [] >>
-
 (* We don't give location for tactic quotation! *)
 let loc = dummy_loc
 
@@ -139,6 +58,7 @@ let mlexpr_of_reference = function
 let mlexpr_of_intro_pattern = function
   | Genarg.IntroOrAndPattern _ -> failwith "mlexpr_of_intro_pattern: TODO"
   | Genarg.IntroWildcard -> <:expr< Genarg.IntroWildcard >>
+  | Genarg.IntroAnonymous -> <:expr< Genarg.IntroAnonymous >>
   | Genarg.IntroIdentifier id ->
       <:expr< Genarg.IntroIdentifier (mlexpr_of_ident $dloc$ id) >>
 
@@ -165,12 +85,12 @@ let mlexpr_of_hyp = mlexpr_of_or_metaid (mlexpr_of_located mlexpr_of_ident)
 let mlexpr_of_occs = mlexpr_of_list mlexpr_of_int
 
 let mlexpr_of_hyp_location = function
-  | id, occs, (Tacexpr.InHyp,_) ->
-      <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, (Tacexpr.InHyp, ref None)) >>
-  | id, occs, (Tacexpr.InHypTypeOnly,_) ->
-      <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, (Tacexpr.InHypTypeOnly, ref None)) >>
-  | id, occs, (Tacexpr.InHypValueOnly,_) ->
-      <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, (Tacexpr.InHypValueOnly,ref None)) >>
+  | id, occs, Tacexpr.InHyp ->
+      <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, Tacexpr.InHyp) >>
+  | id, occs, Tacexpr.InHypTypeOnly ->
+      <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, Tacexpr.InHypTypeOnly) >>
+  | id, occs, Tacexpr.InHypValueOnly ->
+      <:expr< ($mlexpr_of_hyp id$, $mlexpr_of_occs occs$, Tacexpr.InHypValueOnly) >>
 
 let mlexpr_of_clause cl =
   <:expr< {Tacexpr.onhyps=
@@ -179,13 +99,6 @@ let mlexpr_of_clause cl =
            Tacexpr.onconcl= $mlexpr_of_bool cl.Tacexpr.onconcl$;
            Tacexpr.concl_occs= $mlexpr_of_occs cl.Tacexpr.concl_occs$} >>
 
-(*
-let mlexpr_of_red_mode = function
-  | Closure.UNIFORM -> <:expr< Closure.UNIFORM >>
-  | Closure.SIMPL -> <:expr< Closure.SIMPL >>
-  | Closure.WITHBACK -> <:expr< Closure.WITHBACK >>
-*)
-
 let mlexpr_of_red_flags {
   Rawterm.rBeta = bb;
   Rawterm.rIota = bi;
@@ -218,7 +131,6 @@ let rec mlexpr_of_constr = function
   | Topconstr.CAppExpl (loc,a,l) -> <:expr< Topconstr.CAppExpl $dloc$ $mlexpr_of_pair (mlexpr_of_option mlexpr_of_int) mlexpr_of_reference a$ $mlexpr_of_list mlexpr_of_constr l$ >>
   | Topconstr.CApp (loc,a,l) -> <:expr< Topconstr.CApp $dloc$ $mlexpr_of_pair (mlexpr_of_option mlexpr_of_int) mlexpr_of_constr a$ $mlexpr_of_list (mlexpr_of_pair mlexpr_of_constr (mlexpr_of_option (mlexpr_of_located mlexpr_of_explicitation))) l$ >>
   | Topconstr.CCases (loc,_,_,_) -> failwith "mlexpr_of_constr: TODO"
-  | Topconstr.COrderedCase (loc,_,_,_,_) -> failwith "mlexpr_of_constr: TODO"
   | Topconstr.CHole loc -> <:expr< Topconstr.CHole $dloc$ >>
   | Topconstr.CNotation(_,ntn,l) ->
       <:expr< Topconstr.CNotation $dloc$ $mlexpr_of_string ntn$
@@ -248,6 +160,7 @@ let mlexpr_of_red_expr = function
   | Rawterm.Pattern l ->
       let f = mlexpr_of_list mlexpr_of_occ_constr in
       <:expr< Rawterm.Pattern $f l$ >>
+  | Rawterm.CbvVm -> <:expr< Rawterm.CbvVm >>
   | Rawterm.ExtraRedExpr s ->
       <:expr< Rawterm.ExtraRedExpr $mlexpr_of_string s$ >>
 
@@ -259,15 +172,14 @@ let rec mlexpr_of_argtype loc = function
   | Genarg.PreIdentArgType -> <:expr< Genarg.PreIdentArgType >>
   | Genarg.IntroPatternArgType -> <:expr< Genarg.IntroPatternArgType >>
   | Genarg.IdentArgType -> <:expr< Genarg.IdentArgType >>
-  | Genarg.HypArgType -> <:expr< Genarg.HypArgType >>
+  | Genarg.VarArgType -> <:expr< Genarg.VarArgType >>
   | Genarg.StringArgType -> <:expr< Genarg.StringArgType >>
   | Genarg.QuantHypArgType -> <:expr< Genarg.QuantHypArgType >>
-  | Genarg.OpenConstrArgType -> <:expr< Genarg.OpenConstrArgType >>
-  | Genarg.CastedOpenConstrArgType -> <:expr< Genarg.CastedOpenConstrArgType >>
+  | Genarg.OpenConstrArgType b -> <:expr< Genarg.OpenConstrArgType $mlexpr_of_bool b$ >>
   | Genarg.ConstrWithBindingsArgType -> <:expr< Genarg.ConstrWithBindingsArgType >>
   | Genarg.BindingsArgType -> <:expr< Genarg.BindingsArgType >>
   | Genarg.RedExprArgType -> <:expr< Genarg.RedExprArgType >>
-  | Genarg.TacticArgType -> <:expr< Genarg.TacticArgType >>
+  | Genarg.TacticArgType n -> <:expr< Genarg.TacticArgType $mlexpr_of_int n$ >>
   | Genarg.SortArgType -> <:expr< Genarg.SortArgType >>
   | Genarg.ConstrArgType -> <:expr< Genarg.ConstrArgType >>
   | Genarg.ConstrMayEvalArgType -> <:expr< Genarg.ConstrMayEvalArgType >>
@@ -335,6 +247,11 @@ let mlexpr_of_match_rule f = function
   | Tacexpr.Pat (l,mp,t) -> <:expr< Tacexpr.Pat $mlexpr_of_list mlexpr_of_match_context_hyps l$ $mlexpr_of_match_pattern mp$ $f t$ >>
   | Tacexpr.All t -> <:expr< Tacexpr.All $f t$ >>
 
+let mlexpr_of_message_token = function
+  | Tacexpr.MsgString s -> <:expr< Tacexpr.MsgString $str:s$ >>
+  | Tacexpr.MsgInt n -> <:expr< Tacexpr.MsgInt $mlexpr_of_int n$ >>
+  | Tacexpr.MsgIdent id -> <:expr< Tacexpr.MsgIdent $mlexpr_of_hyp id$ >>
+
 let rec mlexpr_of_atomic_tactic = function
   (* Basic tactics *)
   | Tacexpr.TacIntroPattern pl ->
@@ -350,6 +267,8 @@ let rec mlexpr_of_atomic_tactic = function
       <:expr< Tacexpr.TacAssumption >>
   | Tacexpr.TacExact c ->
       <:expr< Tacexpr.TacExact $mlexpr_of_constr c$ >>
+  | Tacexpr.TacExactNoCheck c ->
+      <:expr< Tacexpr.TacExactNoCheck $mlexpr_of_constr c$ >>
   | Tacexpr.TacApply cb ->
       <:expr< Tacexpr.TacApply $mlexpr_of_constr_with_binding cb$ >>
   | Tacexpr.TacElim (cb,cbo) ->
@@ -384,11 +303,10 @@ let rec mlexpr_of_atomic_tactic = function
 
   | Tacexpr.TacCut c ->
       <:expr< Tacexpr.TacCut $mlexpr_of_constr c$ >>
-  | Tacexpr.TacTrueCut (na,c) ->
-      let na = mlexpr_of_name na in
-      <:expr< Tacexpr.TacTrueCut $na$ $mlexpr_of_constr c$ >>
-  | Tacexpr.TacForward (b,na,c) ->
-      <:expr< Tacexpr.TacForward $mlexpr_of_bool b$ $mlexpr_of_name na$ $mlexpr_of_constr c$ >>
+  | Tacexpr.TacAssert (t,ipat,c) ->
+      let ipat = mlexpr_of_intro_pattern ipat in
+      <:expr< Tacexpr.TacAssert $mlexpr_of_option mlexpr_of_tactic t$ $ipat$ 
+	      $mlexpr_of_constr c$ >>
   | Tacexpr.TacGeneralize cl ->
       <:expr< Tacexpr.TacGeneralize $mlexpr_of_list mlexpr_of_constr cl$ >>
   | Tacexpr.TacGeneralizeDep c ->
@@ -399,23 +317,25 @@ let rec mlexpr_of_atomic_tactic = function
       <:expr< Tacexpr.TacLetTac $na$ $mlexpr_of_constr c$ $cl$ >>
 
   (* Derived basic tactics *)
-  | Tacexpr.TacSimpleInduction (h,_) ->
-      <:expr< Tacexpr.TacSimpleInduction ($mlexpr_of_quantified_hypothesis h$,ref []) >>
-  | Tacexpr.TacNewInduction (c,cbo,ids) ->
+  | Tacexpr.TacSimpleInduction h ->
+      <:expr< Tacexpr.TacSimpleInduction ($mlexpr_of_quantified_hypothesis h$) >>
+  | Tacexpr.TacNewInduction (cl,cbo,ids) ->
       let cbo = mlexpr_of_option mlexpr_of_constr_with_binding cbo in
-      let ids = mlexpr_of_option mlexpr_of_intro_pattern (fst ids) in
-      <:expr< Tacexpr.TacNewInduction $mlexpr_of_induction_arg c$ $cbo$ ($ids$,ref [])>>
+      let ids = mlexpr_of_intro_pattern ids in
+(*       let ids = mlexpr_of_option mlexpr_of_intro_pattern ids in *)
+(*       <:expr< Tacexpr.TacNewInduction $mlexpr_of_induction_arg c$ $cbo$ $ids$>> *)
+      <:expr< Tacexpr.TacNewInduction $mlexpr_of_list mlexpr_of_induction_arg cl$ $cbo$ $ids$>>
   | Tacexpr.TacSimpleDestruct h ->
       <:expr< Tacexpr.TacSimpleDestruct $mlexpr_of_quantified_hypothesis h$ >>
   | Tacexpr.TacNewDestruct (c,cbo,ids) ->
       let cbo = mlexpr_of_option mlexpr_of_constr_with_binding cbo in
-      let ids = mlexpr_of_option mlexpr_of_intro_pattern (fst ids) in
-      <:expr< Tacexpr.TacNewDestruct $mlexpr_of_induction_arg c$ $cbo$ ($ids$,ref []) >>
+      let ids = mlexpr_of_intro_pattern ids in
+      <:expr< Tacexpr.TacNewDestruct $mlexpr_of_list mlexpr_of_induction_arg c$ $cbo$ $ids$ >>
 
   (* Context management *)
-  | Tacexpr.TacClear l ->
+  | Tacexpr.TacClear (b,l) ->
       let l = mlexpr_of_list (mlexpr_of_hyp) l in
-      <:expr< Tacexpr.TacClear $l$ >>
+      <:expr< Tacexpr.TacClear $mlexpr_of_bool b$ $l$ >>
   | Tacexpr.TacClearBody l ->
       let l = mlexpr_of_list (mlexpr_of_hyp) l in
       <:expr< Tacexpr.TacClearBody $l$ >>
@@ -453,15 +373,15 @@ let rec mlexpr_of_atomic_tactic = function
   | Tacexpr.TacTransitivity c -> <:expr< Tacexpr.TacTransitivity $mlexpr_of_constr c$ >>
 
   (* Automation tactics *)
-  | Tacexpr.TacAuto (n,l) ->
+  | Tacexpr.TacAuto (n,lems,l) ->
       let n = mlexpr_of_option (mlexpr_of_or_var mlexpr_of_int) n in
+      let lems = mlexpr_of_list mlexpr_of_constr lems in
       let l = mlexpr_of_option (mlexpr_of_list mlexpr_of_string) l in
-      <:expr< Tacexpr.TacAuto $n$ $l$ >>
-(*
-  | Tacexpr.TacTrivial l ->
+      <:expr< Tacexpr.TacAuto $n$ $lems$ $l$ >>
+  | Tacexpr.TacTrivial (lems,l) ->
       let l = mlexpr_of_option (mlexpr_of_list mlexpr_of_string) l in
-      <:expr< Tacexpr.TacTrivial $l$ >>
-*)
+      let lems = mlexpr_of_list mlexpr_of_constr lems in
+      <:expr< Tacexpr.TacTrivial $lems$ $l$ >>
 
 (*
   | Tacexpr.TacExtend (s,l) ->
@@ -492,8 +412,10 @@ and mlexpr_of_tactic : (Tacexpr.raw_tactic_expr -> MLast.expr) = function
       <:expr< Tacexpr.TacRepeat $mlexpr_of_tactic t$ >>
   | Tacexpr.TacProgress t ->
       <:expr< Tacexpr.TacProgress $mlexpr_of_tactic t$ >>
-  | Tacexpr.TacId s -> <:expr< Tacexpr.TacId $str:s$ >>
-  | Tacexpr.TacFail (n,s) -> <:expr< Tacexpr.TacFail $mlexpr_of_or_var mlexpr_of_int n$ $str:s$ >>
+  | Tacexpr.TacId l -> 
+      <:expr< Tacexpr.TacId $mlexpr_of_list mlexpr_of_message_token l$ >>
+  | Tacexpr.TacFail (n,l) ->
+      <:expr< Tacexpr.TacFail $mlexpr_of_or_var mlexpr_of_int n$ $mlexpr_of_list mlexpr_of_message_token l$ >>
 (*
   | Tacexpr.TacInfo t -> TacInfo (loc,f t)
 
@@ -507,12 +429,14 @@ and mlexpr_of_tactic : (Tacexpr.raw_tactic_expr -> MLast.expr) = function
 	  (mlexpr_of_option mlexpr_of_tactic)
 	  mlexpr_of_tactic_arg in
       <:expr< Tacexpr.TacLetIn $mlexpr_of_list f l$ $mlexpr_of_tactic t$ >>
-  | Tacexpr.TacMatch (t,l) ->
+  | Tacexpr.TacMatch (lz,t,l) ->
       <:expr< Tacexpr.TacMatch
+        $mlexpr_of_bool lz$
         $mlexpr_of_tactic t$
         $mlexpr_of_list (mlexpr_of_match_rule mlexpr_of_tactic) l$>>
-  | Tacexpr.TacMatchContext (lr,l) ->
+  | Tacexpr.TacMatchContext (lz,lr,l) ->
       <:expr< Tacexpr.TacMatchContext 
+        $mlexpr_of_bool lz$
         $mlexpr_of_bool lr$
         $mlexpr_of_list (mlexpr_of_match_rule mlexpr_of_tactic) l$>>
 (*
@@ -539,14 +463,6 @@ and mlexpr_of_tactic_arg = function
       <:expr< Tacexpr.Reference $mlexpr_of_reference r$ >>
   | _ -> failwith "mlexpr_of_tactic_arg: TODO"
 
-let f e =
-  let ee s =
-    mlexpr_of_ast (Pcoq.Gram.Entry.parse e
-                     (Pcoq.Gram.parsable (Stream.of_string s)))
-  in
-  let ep s = patt_of_expr (ee s) in
-  Quotation.ExAst (ee, ep)
-
 let fconstr e =
   let ee s =
     mlexpr_of_constr (Pcoq.Gram.Entry.parse e
@@ -566,6 +482,4 @@ let ftac e =
 let _ = 
   Quotation.add "constr" (fconstr Pcoq.Constr.constr_eoi);
   Quotation.add "tactic" (ftac Pcoq.Tactic.tactic_eoi);
-(*  Quotation.add "vernac" (f Pcoq.Vernac_.vernac_eoi);*)
-(*  Quotation.add "ast" (f Pcoq.Prim.ast_eoi);*)
   Quotation.default := "constr"
diff --git a/parsing/q_util.ml4 b/parsing/q_util.ml4
index b3f5393c..07b23972 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,v 1.2.2.2 2004/07/16 19:30:41 herbelin Exp $ *)
+(* $Id: q_util.ml4 7732 2005-12-26 13:51:24Z herbelin $ *)
 
 (* This file defines standard combinators to build ml expressions *)
 
@@ -66,3 +66,39 @@ let mlexpr_of_string s = <:expr< $str:s$ >>
 let mlexpr_of_option f = function
   | None -> <:expr< None >>
   | Some e -> <:expr< Some $f e$ >>
+
+open Vernacexpr
+open Pcoq
+open Genarg
+
+let rec interp_entry_name loc 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 loc (String.sub s 3 (l-8)) in
+    List1ArgType t, <:expr< Gramext.Slist1 $g$ >>
+  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
+    List0ArgType t, <:expr< Gramext.Slist0 $g$ >>
+  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
+    OptArgType t, <:expr< Gramext.Sopt $g$ >>
+  else
+    let s = if s = "hyp" then "var" else s in
+    let t, se =
+      match Pcoq.entry_type (Pcoq.get_univ "prim") s with
+	| Some _ as x -> x, <:expr< Prim. $lid:s$ >>
+	| None -> 
+      match Pcoq.entry_type (Pcoq.get_univ "constr") s with
+	| Some _ as x -> x, <:expr< Constr. $lid:s$ >>
+	| None -> 
+      match Pcoq.entry_type (Pcoq.get_univ "tactic") s with
+	| Some _ as x -> x, <:expr< Tactic. $lid:s$ >>
+	| None -> None, <:expr< $lid:s$ >> in
+    let t =
+      match t with
+	| Some t -> t
+	| None ->
+(*	    Pp.warning_with Pp_control.err_ft
+            ("Unknown primitive grammar entry: "^s);*)
+	    ExtraArgType s
+    in t, <:expr< Gramext.Snterm (Pcoq.Gram.Entry.obj $se$) >>
diff --git a/parsing/q_util.mli b/parsing/q_util.mli
index a2c22bc3..d31b217c 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,v 1.2.2.1 2004/07/16 19:30:41 herbelin Exp $ i*)
+(*i $Id: q_util.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
 val patt_of_expr : MLast.expr -> MLast.patt
 
@@ -28,3 +28,4 @@ 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
diff --git a/parsing/search.ml b/parsing/search.ml
index a3d6e000..995aa953 100644
--- a/parsing/search.ml
+++ b/parsing/search.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: search.ml,v 1.30.2.1 2004/07/16 19:30:41 herbelin Exp $ *)
+(* $Id: search.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 open Pp
 open Util
@@ -17,7 +17,6 @@ open Rawterm
 open Declarations
 open Libobject
 open Declare
-open Coqast
 open Environ
 open Pattern
 open Matching
@@ -34,27 +33,26 @@ open Nametab
 
 let print_constructors indsp fn env nconstr =
   for i = 1 to nconstr do
-    fn (ConstructRef (indsp,i)) env (Inductive.type_of_constructor env (indsp,i))
+    fn (ConstructRef (indsp,i)) env (Inductiveops.type_of_constructor env (indsp,i))
   done
 
 let rec head_const c = match kind_of_term c with
   | Prod (_,_,d) -> head_const d
   | LetIn (_,_,_,d) -> head_const d
   | App (f,_)   -> head_const f
-  | Cast (d,_)   -> head_const d
+  | Cast (d,_,_)   -> head_const d
   | _            -> c
 
 (* General search, restricted to head constant if [only_head] *)
 
 let gen_crible refopt (fn : global_reference -> env -> constr -> unit) =
   let env = Global.env () in
-  let imported = Library.opened_libraries() in
   let crible_rec (sp,_) lobj = match object_tag lobj with
     | "VARIABLE" ->
 	(try 
 	   let (idc,_,typ) = get_variable (basename sp) in 
            if refopt = None
-	     || head_const typ = constr_of_reference (out_some refopt)
+	     || head_const typ = constr_of_global (out_some refopt)
 	   then
 	     fn (VarRef idc) env typ
 	 with Not_found -> (* we are in a section *) ())
@@ -62,7 +60,7 @@ let gen_crible refopt (fn : global_reference -> env -> constr -> unit) =
 	let kn = locate_constant (qualid_of_sp sp) in
 	let {const_type=typ} = Global.lookup_constant kn in
         if refopt = None
-	  || head_const typ = constr_of_reference (out_some refopt)
+	  || head_const typ = constr_of_global (out_some refopt)
 	then
 	  fn (ConstRef kn) env typ
     | "INDUCTIVE" -> 
@@ -80,7 +78,7 @@ let gen_crible refopt (fn : global_reference -> env -> constr -> unit) =
     | _ -> ()
   in 
   try 
-    Declaremods.iter_all_segments false crible_rec
+    Declaremods.iter_all_segments crible_rec
   with Not_found -> 
     ()
 
@@ -104,7 +102,7 @@ let constr_to_section_path c = match kind_of_term c with
 let xor a b = (a or b) & (not (a & b))
 
 let plain_display ref a c =
-  let pc = prterm_env a c in
+  let pc = pr_lconstr_env a c in
   let pr = pr_global ref in
   msg (hov 2 (pr ++ str":" ++ spc () ++ pc) ++ fnl ())
 
@@ -210,7 +208,7 @@ type glob_search_about_item =
   | GlobSearchString of string
 
 let search_about_item (itemref,typ) = function
-  | GlobSearchRef ref -> Termops.occur_term (constr_of_reference ref) typ
+  | GlobSearchRef ref -> Termops.occur_term (constr_of_global ref) typ
   | GlobSearchString s -> string_string_contains (name_of_reference itemref) s
 
 let raw_search_about filter_modules display_function l =
diff --git a/parsing/search.mli b/parsing/search.mli
index 62ba865d..8ee708bc 100644
--- a/parsing/search.mli
+++ b/parsing/search.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: search.mli,v 1.16.2.1 2004/07/16 19:30:41 herbelin Exp $ i*)
+(*i $Id: search.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 open Pp
 open Names
diff --git a/parsing/tacextend.ml4 b/parsing/tacextend.ml4
index bbacd013..48a124a7 100644
--- a/parsing/tacextend.ml4
+++ b/parsing/tacextend.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacextend.ml4,v 1.10.2.2 2004/07/16 19:30:41 herbelin Exp $ *)
+(* $Id: tacextend.ml4 7732 2005-12-26 13:51:24Z herbelin $ *)
 
 open Genarg
 open Q_util
@@ -36,6 +36,8 @@ let rec make_when loc = function
       <:expr< Genarg.genarg_tag $lid:p$ = $t$ && $l$ >>
   | _::l -> make_when loc l
 
+let is_tactic_arg = function TacticArgType _ -> true | _ -> false
+
 let rec make_let e = function
   | [] -> e
   | TacNonTerm(loc,t,_,Some p)::l ->
@@ -45,13 +47,13 @@ let rec make_let e = function
       let v = 
         (* Special case for tactics which must be stored in algebraic
            form to avoid marshalling closures and to be reprinted *)
-        if t = TacticArgType then
+        if is_tactic_arg t then
           <:expr< ($v$, Tacinterp.eval_tactic $v$) >>
         else v in
       <:expr< let $lid:p$ = $v$ in $e$ >>
   | _::l -> make_let e l
 
-let add_clause s (_,pt,e) l =
+let add_clause s (pt,e) l =
   let p = make_patt pt in
   let w = Some (make_when (MLast.loc_of_expr e) pt) in
   (p, w, make_let e pt)::l
@@ -62,7 +64,7 @@ let rec extract_signature = function
   | _::l -> extract_signature l
 
 let check_unicity s l =
-  let l' = List.map (fun (_,l,_) -> extract_signature l) l in
+  let l' = List.map (fun (l,_) -> extract_signature l) l in
   if not (Util.list_distinct l') then
     Pp.warning_with Pp_control.err_ft
       ("Two distinct rules of tactic entry "^s^" have the same\n"^
@@ -82,7 +84,7 @@ let rec make_args = function
 
 let rec make_eval_tactic e = function
   | [] -> e
-  | TacNonTerm(loc,TacticArgType,_,Some p)::l ->
+  | TacNonTerm(loc,TacticArgType _,_,Some p)::l ->
       let loc = join_loc loc (MLast.loc_of_expr e) in
       let e = make_eval_tactic e l in
         (* Special case for tactics which must be stored in algebraic
@@ -106,11 +108,8 @@ let mlexpr_terminals_of_grammar_production = function
   | TacTerm s -> <:expr< Some $mlexpr_of_string s$ >>
   | TacNonTerm (loc,nt,g,sopt) -> <:expr< None >>
 
-let mlexpr_of_semi_clause =
-  mlexpr_of_pair mlexpr_of_string (mlexpr_of_list mlexpr_of_grammar_production)
-
 let mlexpr_of_clause =
-  mlexpr_of_list (fun (a,b,c) -> mlexpr_of_semi_clause (a,b))
+  mlexpr_of_list (fun (a,b) -> mlexpr_of_list mlexpr_of_grammar_production a)
 
 let rec make_tags loc = function
   | [] -> <:expr< [] >>
@@ -121,44 +120,13 @@ let rec make_tags loc = function
       <:expr< [ $t$ :: $l$ ] >>
   | _::l -> make_tags loc l
 
-let make_one_printing_rule (s,pt,e) =
+let make_one_printing_rule se (pt,e) =
+  let level = mlexpr_of_int 0 in (* only level 0 supported here *)
   let loc = MLast.loc_of_expr e in
   let prods = mlexpr_of_list mlexpr_terminals_of_grammar_production pt in
-  <:expr< ($make_tags loc pt$, ($str:s$, $prods$)) >>
+  <:expr< ($se$, $make_tags loc pt$, ($level$, $prods$)) >>
 
-let make_printing_rule = mlexpr_of_list make_one_printing_rule
-
-let new_tac_ext (s,cl) =
-  (String.lowercase s, List.map 
-    (fun (s,l,e) ->
-      (String.lowercase s, List.map
-        (function TacTerm s -> TacTerm (String.lowercase s)
-          | t -> t) l,
-        e))
-    cl)
-
-let declare_tactic_v7 loc s cl =
-  let pp = make_printing_rule cl in
-  let gl = mlexpr_of_clause cl in
-  let hide_tac (_,p,e) =
-    (* reste a definir les fonctions cachees avec des noms frais *)
-    let stac = let s = "h_"^s in s.[2] <- Char.lowercase s.[2]; s in
-    let e = 
-      make_fun
-        <:expr<
-          Refiner.abstract_extended_tactic $mlexpr_of_string s$ $make_args p$ $make_eval_tactic e p$
-        >>
-      p in
-    <:str_item< value $lid:stac$ = $e$ >>
-  in
-  let se = mlexpr_of_string s in
-  <:str_item<
-    declare
-      open Pcoq;
-      Egrammar.extend_tactic_grammar $se$ $gl$;
-      List.iter (Pptactic.declare_extra_tactic_pprule False $se$) $pp$;
-    end
-  >>
+let make_printing_rule se = mlexpr_of_list (make_one_printing_rule se)
 
 let rec contains_epsilon = function
   | List0ArgType _ -> true
@@ -167,89 +135,50 @@ let rec contains_epsilon = function
   | PairArgType(t1,t2) -> contains_epsilon t1 && contains_epsilon t2
   | ExtraArgType("hintbases") -> true
   | _ -> false
-let is_atomic =
-  List.for_all
-    (function
-        TacTerm _ -> false
-      | TacNonTerm(_,t,_,_) -> contains_epsilon t)
+let is_atomic = function
+  | TacTerm s :: l when 
+      List.for_all (function
+          TacTerm _ -> false
+	| TacNonTerm(_,t,_,_) -> contains_epsilon t) l
+	-> [s]
+  | _ -> []
 
 let declare_tactic loc s cl =
-  let (s',cl') = new_tac_ext (s,cl) in
-  let pp' = make_printing_rule cl' in
-  let gl' = mlexpr_of_clause cl' in
-  let se' = mlexpr_of_string s' in
-  let pp = make_printing_rule cl in
+  let se = mlexpr_of_string s in
+  let pp = make_printing_rule se cl in
   let gl = mlexpr_of_clause cl in
-  let hide_tac (_,p,e) =
+  let hide_tac (p,e) =
     (* reste a definir les fonctions cachees avec des noms frais *)
-    let stac = "h_"^s' in
+    let stac = "h_"^s in
     let e = 
       make_fun
         <:expr<
-          Refiner.abstract_extended_tactic $mlexpr_of_string s'$ $make_args p$ $make_eval_tactic e p$
+          Refiner.abstract_extended_tactic $mlexpr_of_string s$ $make_args p$ $make_eval_tactic e p$
         >>
       p in
     <:str_item< value $lid:stac$ = $e$ >>
   in
-  let hidden = if List.length cl = 1 then List.map hide_tac cl' else [] in
-  let se = mlexpr_of_string s in
+  let hidden = if List.length cl = 1 then List.map hide_tac cl else [] in
   let atomic_tactics =
-    mlexpr_of_list (fun (s,_,_) -> mlexpr_of_string s)
-      (List.filter (fun (_,al,_) -> is_atomic al) cl') in
+    mlexpr_of_list mlexpr_of_string
+      (List.flatten (List.map (fun (al,_) -> is_atomic al) cl)) in
   <:str_item<
     declare
       open Pcoq;
       declare $list:hidden$ end;
       try
-        let _=Refiner.add_tactic $se'$ (fun [ $list:make_clauses s' cl'$ ]) in
+        let _=Refiner.add_tactic $se$ (fun [ $list:make_clauses s cl$ ]) in
         List.iter
           (fun s -> Tacinterp.add_primitive_tactic s
               (Tacexpr.TacAtom($default_loc$,
                  Tacexpr.TacExtend($default_loc$,s,[]))))
           $atomic_tactics$
       with e -> Pp.pp (Cerrors.explain_exn e);
-      if Options.v7.val then Egrammar.extend_tactic_grammar $se'$ $gl$
-      else Egrammar.extend_tactic_grammar $se'$ $gl'$;
-      List.iter (Pptactic.declare_extra_tactic_pprule True $se'$) $pp'$;
-      List.iter (Pptactic.declare_extra_tactic_pprule False $se'$) $pp$;
+      Egrammar.extend_tactic_grammar $se$ $gl$;
+      List.iter Pptactic.declare_extra_tactic_pprule $pp$;
     end
   >>
 
-open Vernacexpr
-open Pcoq
-
-let rec interp_entry_name loc 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 loc (String.sub s 3 (l-8)) in
-    List1ArgType t, <:expr< Gramext.Slist1 $g$ >>
-  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
-    List0ArgType t, <:expr< Gramext.Slist0 $g$ >>
-  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
-    OptArgType t, <:expr< Gramext.Sopt $g$ >>
-  else
-    
-    let t, se =
-      match Pcoq.entry_type (Pcoq.get_univ "prim") s with
-	| Some _ as x -> x, <:expr< Prim. $lid:s$ >>
-	| None -> 
-      match Pcoq.entry_type (Pcoq.get_univ "constr") s with
-	| Some _ as x -> x, <:expr< Constr. $lid:s$ >>
-	| None -> 
-      match Pcoq.entry_type (Pcoq.get_univ "tactic") s with
-	| Some _ as x -> x, <:expr< Tactic. $lid:s$ >>
-	| None -> None, <:expr< $lid:s$ >> in
-    let t =
-      match t with
-	| Some t -> t
-	| None ->
-(*	    Pp.warning_with Pp_control.err_ft
-            ("Unknown primitive grammar entry: "^s);*)
-	    ExtraArgType s
-    in t, <:expr< Gramext.Snterm (Pcoq.Gram.Entry.obj $se$) >>
-
 open Pcaml
 
 EXTEND
@@ -258,24 +187,23 @@ EXTEND
     [ [ "TACTIC"; "EXTEND"; s = [ UIDENT | LIDENT ];
         OPT "|"; l = LIST1 tacrule SEP "|";
         "END" ->
-         declare_tactic loc s l
-      | "V7"; "TACTIC"; "EXTEND"; s = [ UIDENT | LIDENT ];
-        OPT "|"; l = LIST1 tacrule SEP "|";
-        "END" ->
-         declare_tactic_v7 loc s l ] ]
+         declare_tactic loc s l ] ]
   ;
   tacrule:
-    [ [ "["; s = STRING; l = LIST0 tacargs; "]"; "->"; "["; e = Pcaml.expr; "]"
-        ->
-       if s = "" then Util.user_err_loc (loc,"",Pp.str "Tactic name is empty");
-       (s,l,e)
+    [ [ "["; l = LIST1 tacargs; "]"; "->"; "["; e = Pcaml.expr; "]"
+        -> 
+	  if match List.hd l with TacNonTerm _ -> true | _ -> false then
+	    (* En attendant la syntaxe de tacticielles *)
+	    failwith "Tactic syntax must start with an identifier";
+	  (l,e)
     ] ]
   ;
   tacargs:
     [ [ e = LIDENT; "("; s = LIDENT; ")" ->
-        let t, g = interp_entry_name loc e in
+        let t, g = Q_util.interp_entry_name loc e in
         TacNonTerm (loc, t, g, Some s)
       | s = STRING ->
+	if s = "" then Util.user_err_loc (loc,"",Pp.str "Empty terminal");
         TacTerm s
     ] ]
   ;
diff --git a/parsing/tactic_printer.ml b/parsing/tactic_printer.ml
new file mode 100644
index 00000000..3584e375
--- /dev/null
+++ b/parsing/tactic_printer.ml
@@ -0,0 +1,141 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: tactic_printer.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
+
+open Pp
+open Util
+open Sign
+open Evd
+open Tacexpr
+open Proof_type
+open Proof_trees
+open Logic
+open Printer
+
+let pr_tactic = function
+  | TacArg (Tacexp t) ->
+      (*top tactic from tacinterp*)
+      Pptactic.pr_glob_tactic (Global.env()) t
+  | t -> 
+      Pptactic.pr_tactic (Global.env()) t
+
+let pr_rule = function
+  | Prim r -> hov 0 (pr_prim_rule r)
+  | Tactic (texp,_) -> hov 0 (pr_tactic texp)
+  | 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"
+
+(* Does not print change of evars *)
+let pr_rule_dot = function 
+  | Change_evars -> mt ()
+  | r -> pr_rule r ++ str"."
+
+exception Different
+
+(* We remove from the var context of env what is already in osign *)
+let thin_sign osign sign =
+  Sign.fold_named_context
+    (fun (id,c,ty as d) sign ->
+       try 
+	 if Sign.lookup_named id osign = (id,c,ty) then sign
+	 else raise Different
+       with Not_found | Different -> Environ.push_named_context_val d 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' = thin_sign osign hyps in
+  match pf.ref with
+    | None -> 
+	hov 0 (pr_goal {evar_hyps=hyps'; evar_concl=cl; evar_body=body})
+    | Some(r,spfl) ->
+    	hov 0 
+	  (hov 0 (pr_goal {evar_hyps=hyps'; evar_concl=cl; evar_body=body}) ++
+	   spc () ++ str" BY " ++
+	   hov 0 (pr_rule r) ++ fnl () ++
+	   str"  " ++
+	   hov 0 (prlist_with_sep pr_fnl (print_proof sigma hyps) spfl)
+)
+	  
+let pr_change gl = 
+  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
+  match pf.ref with
+    | None ->
+        (if nochange then 
+	  (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)
+
+(* printed by Show Script command *)
+let print_treescript nochange sigma _osign pf =
+  let rec aux top pf =
+    match pf.ref with
+    | None ->
+        if nochange then 
+	  (str"<Your Tactic Text here>") 
+	else 
+	  (pr_change pf.goal)
+    | 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)
+  in hov 0 (aux true pf)
+
+let rec print_info_script sigma osign pf =
+  let {evar_hyps=sign; evar_concl=cl} = pf.goal in
+  match pf.ref with
+    | None -> (mt ())
+    | Some(Change_evars,[spf]) ->
+        print_info_script sigma osign spf
+    | Some(r,spfl) ->
+        (pr_rule r ++ 
+           match spfl with
+             | [pf1] ->
+                 if pf1.ref = None then 
+		   (str "." ++ fnl ())
+                 else 
+		   (str";" ++ brk(1,3) ++
+		      print_info_script sigma 
+		      (Environ.named_context_of_val sign) pf1)
+             | _ -> (str"." ++ fnl () ++
+                       prlist_with_sep pr_fnl
+                         (print_info_script sigma 
+			    (Environ.named_context_of_val sign)) spfl))
+
+let format_print_info_script sigma osign pf = 
+  hov 0 (print_info_script sigma osign pf)
+    
+let print_subscript sigma sign pf = 
+  if is_tactic_proof pf then 
+    format_print_info_script sigma sign (subproof_of_proof pf)
+  else 
+    format_print_info_script sigma sign pf
+
+let _ = Refiner.set_info_printer print_subscript
+
diff --git a/translate/pptacticnew.mli b/parsing/tactic_printer.mli
index b49b9e56..db5dd794 100644
--- a/translate/pptacticnew.mli
+++ b/parsing/tactic_printer.mli
@@ -5,26 +5,23 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: pptacticnew.mli,v 1.6.2.3 2005/01/21 17:17:20 herbelin Exp $ i*)
 
+(*i $Id: tactic_printer.mli 6113 2004-09-17 20:28:19Z barras $ i*)
+
+(*i*)
 open Pp
-open Genarg
+open Sign
+open Evd
 open Tacexpr
 open Proof_type
-open Topconstr
-open Names
-
-val qsnew : string -> std_ppcmds
-
-val pr_intro_pattern : intro_pattern_expr -> std_ppcmds
-
-val pr_raw_tactic : Environ.env -> raw_tactic_expr -> std_ppcmds
- 
-val pr_glob_tactic : Environ.env -> glob_tactic_expr -> std_ppcmds
-
-val pr_tactic : Environ.env -> Proof_type.tactic_expr -> std_ppcmds
-
-val id_of_ltac_v7_id : identifier -> identifier
+(*i*)
 
+(* These are the entry points for tactics, proof trees, ... *)
 
+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
+val print_treescript :
+  bool -> evar_map -> named_context -> proof_tree -> std_ppcmds
diff --git a/parsing/termast.ml b/parsing/termast.ml
deleted file mode 100644
index 47e45d42..00000000
--- a/parsing/termast.ml
+++ /dev/null
@@ -1,503 +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        *)
-(************************************************************************)
-
-(* $Id: termast.ml,v 1.78.2.1 2004/07/16 19:30:42 herbelin Exp $ *)
-
-open Pp
-open Util
-open Univ
-open Names
-open Nameops
-open Term
-open Termops
-open Inductive
-open Sign
-open Environ
-open Libnames
-open Declare
-open Impargs
-open Coqast
-open Ast
-open Rawterm
-open Pattern
-open Nametab
-
-(* In this file, we translate rawconstr to ast, in order to print constr *)
-
-(**********************************************************************)
-(* Parametrization                                                    *)
-open Constrextern
-(*
-(* This governs printing of local context of references *)
-let print_arguments = ref false
-
-(* If true, prints local context of evars, whatever print_arguments *)
-let print_evar_arguments = ref false
-*)
-
-(* This forces printing of cast nodes *)
-let print_casts = ref true
-
-(*
-(* This governs printing of implicit arguments.  When
-   [print_implicits] is on then [print_implicits_explicit_args] tells
-   how implicit args are printed. If on, implicit args are printed
-   prefixed by "!" otherwise the function and not the arguments is
-   prefixed by "!" *)
-let print_implicits = ref false
-*)
-let print_implicits_explicit_args = ref false
-
-(*
-(* This forces printing of coercions *)
-let print_coercions = ref false
-
-(* This forces printing universe names of Type{.} *)
-let print_universes = ref false
-
-
-let with_option o f x =
-  let old = !o in o:=true;
-  try let r = f x in o := old; r
-  with e -> o := old; raise e
-
-let with_arguments f = with_option print_arguments f
-let with_casts f = with_option print_casts f
-let with_implicits f = with_option print_implicits f
-let with_coercions f = with_option print_coercions f
-let with_universes f = with_option print_universes f
-*)
-(**********************************************************************)
-(* conversion of references                                           *)
-
-let ids_of_ctxt ctxt =
-  Array.to_list
-    (Array.map
-       (function c -> match kind_of_term c with
-	  | Var id -> id
-	  | _ ->
-       error
-       "Termast: arbitrary substitution of references not yet implemented")
-     ctxt)
-
-let ast_of_ident id = nvar id
-
-let ast_of_name = function 
-  | Name id -> nvar id
-  | Anonymous -> nvar wildcard
-
-let idopt_of_name = function 
-  | Name id -> Some id
-  | Anonymous -> None
-
-let ast_of_binders bl =
-  List.map (fun (nal,isdef,ty) ->
-    if isdef then ope("LETBINDER",ty::List.map ast_of_name nal)
-    else ope("BINDER",ty::List.map ast_of_name nal)) bl
-
-let ast_type_of_binder bl t =
-  List.fold_right (fun (nal,isdef,ty) ast ->
-    if isdef then
-      ope("LETIN",[ty;slam(idopt_of_name (List.hd nal),ast)])
-    else
-      ope("PROD",[ty;List.fold_right
-        (fun na ast -> slam(idopt_of_name na,ast)) nal ast]))
-    bl t
-
-let ast_body_of_binder bl t =
-  List.fold_right (fun (nal,isdef,ty) ast ->
-    if isdef then
-      ope("LETIN",[ty;slam(idopt_of_name (List.hd nal),ast)])
-    else
-      ope("LAMBDA",[ty;List.fold_right
-        (fun na ast -> slam(idopt_of_name na,ast)) nal ast]))
-    bl t
-
-let ast_of_constant_ref sp =
-  ope("CONST", [path_section dummy_loc sp])
-
-let ast_of_existential_ref ev =
-(*
-  let ev = 
-    try int_of_string (string_of_id ev)
-    with _ -> warning "cannot find existential variable number"; 0 in
-*)
-  ope("EVAR", [num ev])
-
-let ast_of_constructor_ref ((sp,tyi),n) =
-  ope("MUTCONSTRUCT",[path_section dummy_loc sp; num tyi; num n])
-
-let ast_of_inductive_ref (sp,tyi) =
-  ope("MUTIND", [path_section dummy_loc sp; num tyi])
-
-let ast_of_section_variable_ref s =
-  ope("SECVAR", [nvar s])
-
-let ast_of_qualid p =
-  let dir, s = repr_qualid p in
-  let args = List.map nvar ((List.rev(repr_dirpath dir))@[s]) in
-  ope ("QUALID", args)
-
-let ast_of_ref = function
-  | ConstRef sp -> ast_of_constant_ref sp
-  | IndRef sp -> ast_of_inductive_ref sp
-  | ConstructRef sp -> ast_of_constructor_ref sp
-  | VarRef id -> ast_of_section_variable_ref id
-
-(**********************************************************************)
-(* conversion of patterns                                             *)
-
-let rec ast_of_cases_pattern = function   (* loc is thrown away for printing *)
-  | PatVar (loc,Name id) -> nvar id
-  | PatVar (loc,Anonymous) -> nvar wildcard
-  | PatCstr(loc,cstrsp,args,Name id) ->
-      let args = List.map ast_of_cases_pattern args in
-      ope("PATTAS",
-	  [nvar id;
-	   ope("PATTCONSTRUCT", (ast_of_constructor_ref cstrsp)::args)])
-  | PatCstr(loc,cstrsp,args,Anonymous) ->
-      ope("PATTCONSTRUCT",
-	  (ast_of_constructor_ref cstrsp)
-	  :: List.map ast_of_cases_pattern args)
-	
-let ast_dependent na aty =
-  match na with
-    | Name id -> occur_var_ast id aty
-    | Anonymous -> false
-
-let decompose_binder = function
-  | RProd(_,na,ty,c) -> Some (BProd,na,ty,c)
-  | RLambda(_,na,ty,c) -> Some (BLambda,na,ty,c)
-  | RLetIn(_,na,b,c) -> Some (BLetIn,na,b,c)
-  | _ -> None
-
-(* Implicit args indexes are in ascending order *)
-let explicitize impl args =
-  let n = List.length args in
-  let rec exprec q = function
-    | a::args, imp::impl when is_status_implicit imp ->
-        let tail = exprec (q+1) (args,impl) in
-        let visible =
-          (!print_implicits & !print_implicits_explicit_args)
-          or not (is_inferable_implicit false n imp) in
-        if visible then ope("EXPL", [num q; a]) :: tail else tail
-    | a::args, _::impl -> a :: exprec (q+1) (args,impl)
-    | args, [] -> args  (* In case of polymorphism *)
-    | [], _ -> []
-  in exprec 1 (args,impl)
-
-let rec skip_coercion dest_ref (f,args as app) =
-  if !print_coercions then app
-  else
-    try
-      match dest_ref f with
-	| Some r ->
-	    (match Classops.hide_coercion r with
-	       | Some n ->
-		   if n >= List.length args then app
-		   else (* We skip a coercion *)
-		     let fargs = list_skipn n args in
-	       	     skip_coercion dest_ref (List.hd fargs,List.tl fargs)
-	       | None -> app)
-	| None -> app
-    with Not_found -> app
-
-let ast_of_app impl f args =
-  if !print_implicits & not !print_implicits_explicit_args then 
-    ope("APPLISTEXPL", f::args)
-  else
-    let args = explicitize impl args in
-    if args = [] then f else ope("APPLIST", f::args)
-
-let rec ast_of_raw = function
-  | RRef (_,ref) -> ast_of_ref ref
-  | RVar (_,id) -> ast_of_ident id
-  | REvar (_,n,_) -> (* we drop args *) ast_of_existential_ref n
-  | RPatVar (_,(_,n)) -> ope("META",[ast_of_ident n])
-  | RApp (_,f,args) ->
-      let (f,args) =
-	skip_coercion (function RRef(_,r) -> Some r | _ -> None) (f,args) in
-      let astf = ast_of_raw f in
-      let astargs = List.map ast_of_raw args in
-      (match f with 
-	 | RRef (_,ref) -> ast_of_app (implicits_of_global ref) astf astargs
-	 | _       -> ast_of_app [] astf astargs)
-
-  | RProd (_,Anonymous,t,c) ->
-      (* Anonymous product are never factorized *)
-      ope("ARROW",[ast_of_raw t; slam(None,ast_of_raw c)])
-
-  | RLetIn (_,na,t,c) ->
-      ope("LETIN",[ast_of_raw t; slam(idopt_of_name na,ast_of_raw c)])
-
-  | RProd (_,na,t,c) ->
-      let (n,a) = factorize_binder 1 BProd na (ast_of_raw t) c in
-      (* PROD et PRODLIST doivent être distingués à cause du cas *)
-      (* non dépendant, pour isoler l'implication; peut-être un *)
-      (* constructeur ARROW serait-il plus justifié ? *) 
-      let tag = if n=1 then "PROD" else "PRODLIST" in
-      ope(tag,[ast_of_raw t;a])
-
-  | RLambda (_,na,t,c) ->
-      let (n,a) = factorize_binder 1 BLambda na (ast_of_raw t) c in
-      (* LAMBDA et LAMBDALIST se comportent pareil ... Non ! *)
-      (* Pour compatibilité des theories, il faut LAMBDALIST partout *)
-      ope("LAMBDALIST",[ast_of_raw t;a])
-
-  | RCases (_,(typopt,_),tml,eqns) ->
-      let pred = ast_of_rawopt typopt in
-      let tag = "CASES" in
-      let asttomatch =
-	ope("TOMATCH", List.map (fun (tm,_) -> ast_of_raw tm) tml) in
-      let asteqns = List.map ast_of_eqn eqns in 
-      ope(tag,pred::asttomatch::asteqns)
-	
-  | ROrderedCase (_,LetStyle,typopt,tm,[|bv|],_) ->
-      let nvar' = function Anonymous -> nvar wildcard | Name id -> nvar id in
-      let rec f l = function
-        | RLambda (_,na,RHole _,c) -> f (nvar' na :: l) c
-        | RLetIn (_,na,RHole _,c) -> f (nvar' na :: l) c
-        | c -> List.rev l, ast_of_raw c in
-      let l,c = f [] bv in
-      let eqn = ope ("EQN", [c;ope ("PATTCONSTRUCT",(nvar wildcard)::l)]) in
-      ope ("FORCELET",[(ast_of_rawopt typopt);(ast_of_raw tm);eqn])
-
-  | ROrderedCase (_,st,typopt,tm,bv,_) ->
-      let tag = match st with
-	| IfStyle -> "FORCEIF"
-	| RegularStyle -> "CASE"
-	| MatchStyle | LetStyle -> "MATCH"
-      in
-
-      (* warning "Old Case syntax"; *)
-      ope(tag,(ast_of_rawopt typopt)
-	    ::(ast_of_raw tm)
-	    ::(Array.to_list (Array.map ast_of_raw bv)))
-
-  | RLetTuple _ | RIf _ ->
-      error "Let tuple not supported in v7"
-
-  | RRec (_,fk,idv,blv,tyv,bv) ->
-      let alfi = Array.map ast_of_ident idv in
-      (match fk with
-	 | RFix (nv,n) ->
-             let rec split_lambda binds = function
-	       | (0, t) -> (List.rev binds,ast_of_raw t)
-	       | (n, RLetIn (_,na,b,c)) ->
-		   let bind = ope("LETBINDER",[ast_of_raw b;ast_of_name na]) in
-		   split_lambda (bind::binds) (n,c)
-	       | (n, RLambda (_,na,t,b)) ->
-		   let bind = ope("BINDER",[ast_of_raw t;ast_of_name na]) in
-		   split_lambda (bind::binds) (n-1,b)
-	       | _ -> anomaly "ast_of_rawconst: ill-formed fixpoint body" in
-	     let rec split_product = function
-	       | (0, t) -> ast_of_raw t
-	       | (n, RLetIn (_,na,_,c)) -> split_product (n,c)
-	       | (n, RProd (_,na,t,b)) -> split_product (n-1,b)
-	       | _ -> anomaly "ast_of_rawconst: ill-formed fixpoint type" in
-	     let listdecl = 
-	       Array.mapi
-		 (fun i fi ->
-                   if List.length blv.(i) >= nv.(i)+1 then
-                     let (oldfixp,factb) = list_chop (nv.(i)+1) blv.(i) in
-                     let bl = factorize_local_binder oldfixp in
-                     let factb = factorize_local_binder factb in
-                     let asttyp = ast_type_of_binder factb
-                       (ast_of_raw tyv.(i)) in
-                     let astdef = ast_body_of_binder factb
-                       (ast_of_raw bv.(i)) in
-                     ope("FDECL",[fi;ope("BINDERS",ast_of_binders bl);
-                                  asttyp; astdef])
-                   else
-                     let n = nv.(i)+1 - List.length blv.(i) in
-		     let (lparams,astdef) =
-                       split_lambda [] (n,bv.(i)) in
-                     let bl = factorize_local_binder blv.(i) in
-                     let lparams = ast_of_binders bl @ lparams in
-		     let asttyp = split_product (n,tyv.(i)) in
-		     ope("FDECL",
-		         [fi; ope ("BINDERS",lparams); 
-		          asttyp; astdef]))
-		 alfi
-	     in 
-	     ope("FIX", alfi.(n)::(Array.to_list listdecl))
-	 | RCoFix n -> 
-	     let listdecl =
-               Array.mapi 
-		 (fun i fi ->
-                   let bl = factorize_local_binder blv.(i) in
-                   let asttyp = ast_type_of_binder bl (ast_of_raw tyv.(i)) in
-                   let astdef = ast_body_of_binder bl (ast_of_raw bv.(i)) in
-		   ope("CFDECL",[fi; asttyp; astdef]))
-		 alfi
-	     in 
-	     ope("COFIX", alfi.(n)::(Array.to_list listdecl)))
-
-  | RSort (_,s) ->
-      (match s with
-	 | RProp Null -> ope("PROP",[])
-	 | RProp Pos -> ope("SET",[])
-	 | RType (Some u) when !print_universes -> ope("TYPE",[ide(Univ.string_of_univ u)])
-	 | RType _ -> ope("TYPE",[]))
-  | RHole _ -> ope("ISEVAR",[])
-  | RCast (_,c,t) -> ope("CAST",[ast_of_raw c;ast_of_raw t])
-  | RDynamic (loc,d) -> Dynamic (loc,d)
-	
-and ast_of_eqn (_,ids,pl,c) =
-  ope("EQN", (ast_of_raw c)::(List.map ast_of_cases_pattern pl))
-
-and ast_of_rawopt = function
-  | None -> (string "SYNTH")
-  | Some p -> ast_of_raw p
-
-and factorize_binder n oper na aty c =
-  let (p,body) = match decompose_binder c with
-    | Some (oper',na',ty',c')
-	when (oper = oper') & (aty = ast_of_raw ty')
-	  & not (ast_dependent na aty) (* To avoid na in ty' escapes scope *)
-	  & not (na' = Anonymous & oper = BProd)
-	  -> factorize_binder (n+1) oper na' aty c'
-    | _ -> (n,ast_of_raw c)
-  in
-  (p,slam(idopt_of_name na, body))
-
-and factorize_local_binder = function
-    [] -> []
-  | (na,Some bd,ty)::l ->
-      ([na],true,ast_of_raw bd) :: factorize_local_binder l
-  | (na,None,ty)::l ->
-      let ty = ast_of_raw ty in
-      (match factorize_local_binder l with
-          (lna,false,ty') :: l when ty=ty' ->
-            (na::lna,false,ty') :: l
-        | l -> ([na],false,ty) :: l)
-
-
-let ast_of_rawconstr = ast_of_raw
-
-(******************************************************************)
-(* Main translation function from constr -> ast *)
-       
-let ast_of_constr at_top env t =
-  let t' =
-    if !print_casts then t
-    else Reductionops.local_strong strip_outer_cast t in
-  let avoid = if at_top then ids_of_context env else [] in
-  ast_of_raw 
-    (Detyping.detype (at_top,env) avoid (names_of_rel_context env) t')
-
-let ast_of_constant env sp =
-  let a = ast_of_constant_ref sp in
-  a
-
-let ast_of_existential env (ev,ids) =
-  let a = ast_of_existential_ref ev in
-  if !print_arguments or !print_evar_arguments then
-    ope("INSTANCE",a::(array_map_to_list (ast_of_constr false env) ids))
-  else a
-
-let ast_of_constructor env cstr_sp =
-  let a = ast_of_constructor_ref cstr_sp in
-  a
-
-let ast_of_inductive env ind_sp =
-  let a = ast_of_inductive_ref ind_sp in
-  a
-
-let decompose_binder_pattern = function
-  | PProd(na,ty,c) -> Some (BProd,na,ty,c)
-  | PLambda(na,ty,c) -> Some (BLambda,na,ty,c)
-  | PLetIn(na,b,c) -> Some (BLetIn,na,b,c)
-  | _ -> None
-
-let rec ast_of_pattern tenv env = function
-  | PRef ref -> ast_of_ref ref
-
-  | PVar id -> ast_of_ident id
-
-  | PEvar (n,_) -> ast_of_existential_ref n
-
-  | PRel n ->
-      (try match lookup_name_of_rel n env with
-	 | Name id   -> ast_of_ident id
-	 | Anonymous ->
-	     anomaly "ast_of_pattern: index to an anonymous variable"
-       with Not_found ->
-	 nvar (id_of_string ("[REL "^(string_of_int n)^"]")))
-
-  | PApp (f,args) ->
-      let (f,args) = 
-	skip_coercion (function PRef r -> Some r | _ -> None)
-	  (f,Array.to_list args) in
-      let astf = ast_of_pattern tenv env f in
-      let astargs = List.map (ast_of_pattern tenv env) args in
-      (match f with 
-	 | PRef ref -> ast_of_app (implicits_of_global ref) astf astargs
-	 | _        -> ast_of_app [] astf astargs)
-
-  | PSoApp (n,args) ->
-      ope("SOAPP",(ope ("META",[ast_of_ident n])):: 
-		  (List.map (ast_of_pattern tenv env) args))
-
-  | PLetIn (na,b,c) ->
-      let c' = ast_of_pattern tenv (add_name na env) c in
-      ope("LETIN",[ast_of_pattern tenv env b;slam(idopt_of_name na,c')])
-		
-  | PProd (Anonymous,t,c) ->
-      ope("PROD",[ast_of_pattern tenv env t;
-                  slam(None,ast_of_pattern tenv env c)])
-  | PProd (na,t,c) ->
-      let env' = add_name na env in
-      let (n,a) =
-	factorize_binder_pattern tenv env' 1 BProd na
-          (ast_of_pattern tenv env t) c in
-      (* PROD et PRODLIST doivent être distingués à cause du cas *)
-      (* non dépendant, pour isoler l'implication; peut-être un *)
-      (* constructeur ARROW serait-il plus justifié ? *) 
-      let tag = if n=1 then "PROD" else "PRODLIST" in
-      ope(tag,[ast_of_pattern tenv env t;a])
-  | PLambda (na,t,c) ->
-      let env' = add_name na env in
-      let (n,a) =
-	factorize_binder_pattern tenv env' 1 BLambda na
-          (ast_of_pattern tenv env t) c in
-      (* LAMBDA et LAMBDALIST se comportent pareil *)
-      let tag = if n=1 then "LAMBDA" else "LAMBDALIST" in
-      ope(tag,[ast_of_pattern tenv env t;a])
-
-  | PCase (st,typopt,tm,bv) ->
-      warning "Old Case syntax";
-      ope("MUTCASE",(ast_of_patopt tenv env typopt)
-	    ::(ast_of_pattern tenv env tm)
-	    ::(Array.to_list (Array.map (ast_of_pattern tenv env) bv)))
-
-  | PSort s ->
-      (match s with
-	 | RProp Null -> ope("PROP",[])
-	 | RProp Pos -> ope("SET",[])
-	 | RType _ -> ope("TYPE",[]))
-
-  | PMeta (Some n) -> ope("META",[ast_of_ident n])
-  | PMeta None -> ope("ISEVAR",[])
-  | PFix f -> ast_of_raw (Detyping.detype (false,tenv) [] env (mkFix f))
-  | PCoFix c -> ast_of_raw (Detyping.detype (false,tenv) [] env (mkCoFix c))
-	
-and ast_of_patopt tenv env = function
-  | None -> (string "SYNTH")
-  | Some p -> ast_of_pattern tenv env p
-
-and factorize_binder_pattern tenv env n oper na aty c =
-  let (p,body) = match decompose_binder_pattern c with
-    | Some (oper',na',ty',c')
-	when (oper = oper') & (aty = ast_of_pattern tenv env ty')
-	  & not (na' = Anonymous & oper = BProd)
-	  ->
-	factorize_binder_pattern tenv (add_name na' env) (n+1) oper na' aty c'
-    | _ -> (n,ast_of_pattern tenv env c)
-  in
-  (p,slam(idopt_of_name na, body))
diff --git a/parsing/termast.mli b/parsing/termast.mli
deleted file mode 100644
index c66e8f0f..00000000
--- a/parsing/termast.mli
+++ /dev/null
@@ -1,55 +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: termast.mli,v 1.24.2.1 2004/07/16 19:30:42 herbelin Exp $ i*)
-
-(*i*)
-open Names
-open Term
-open Termops
-open Sign
-open Environ
-open Libnames
-open Nametab
-open Rawterm
-open Pattern
-(*i*)
-
-(* Translation of pattern, cases pattern, rawterm and term into syntax
-   trees for printing *)
-
-val ast_of_cases_pattern : cases_pattern -> Coqast.t
-val ast_of_rawconstr : rawconstr -> Coqast.t
-val ast_of_pattern : env -> names_context -> constr_pattern -> Coqast.t
-
-(* If [b=true] in [ast_of_constr b env c] then the variables in the first 
-   level of quantification clashing with the variables in [env] are renamed *)
-
-val ast_of_constr : bool -> env -> constr -> Coqast.t
-
-val ast_of_constant     : env -> constant -> Coqast.t
-val ast_of_existential  : env -> existential -> Coqast.t
-val ast_of_constructor  : env -> constructor -> Coqast.t
-val ast_of_inductive    : env -> inductive -> Coqast.t
-val ast_of_ref          : global_reference -> Coqast.t
-val ast_of_qualid       : qualid -> Coqast.t
-
-(*i Now in constrextern.mli
-val print_implicits : bool ref
-val print_casts : bool ref
-val print_arguments : bool ref
-val print_evar_arguments : bool ref
-val print_coercions : bool ref
-val print_universes : bool ref
-
-val with_casts : ('a -> 'b) -> 'a -> 'b
-val with_implicits : ('a -> 'b) -> 'a -> 'b
-val with_arguments : ('a -> 'b) -> 'a -> 'b
-val with_coercions : ('a -> 'b) -> 'a -> 'b
-val with_universes : ('a -> 'b) -> 'a -> 'b
-i*)
diff --git a/parsing/vernacextend.ml4 b/parsing/vernacextend.ml4
index bdc1ea66..af0d6781 100644
--- a/parsing/vernacextend.ml4
+++ b/parsing/vernacextend.ml4
@@ -6,12 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: vernacextend.ml4,v 1.5.2.2 2004/07/16 19:30:42 herbelin Exp $ *)
+(* $Id: vernacextend.ml4 7732 2005-12-26 13:51:24Z herbelin $ *)
 
 open Genarg
 open Q_util
 open Q_coqast
-open Ast
 open Argextend
 
 let join_loc (deb1,_) (_,fin2) = (deb1,fin2)
@@ -81,11 +80,8 @@ let mlexpr_of_grammar_production = function
 
 let mlexpr_of_clause =
   mlexpr_of_list
-    (fun (a,b,c) ->
-      (mlexpr_of_pair
-	mlexpr_of_string
-	(mlexpr_of_list mlexpr_of_grammar_production)
-	(a,b)))
+    (fun (a,b,c) -> 
+      mlexpr_of_list mlexpr_of_grammar_production (VernacTerm a::b))
 
 let declare_command loc s cl =
   let gl = mlexpr_of_clause cl in
@@ -99,40 +95,6 @@ let declare_command loc s cl =
     end
   >>
 
-open Vernacexpr
-open Pcoq
-
-let rec interp_entry_name loc 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 loc (String.sub s 3 (l-8)) in
-    List1ArgType t, <:expr< Gramext.Slist1 $g$ >>
-  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
-    List0ArgType t, <:expr< Gramext.Slist0 $g$ >>
-  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
-    OptArgType t, <:expr< Gramext.Sopt $g$ >>
-  else
-    let t, se = 
-      match Pcoq.entry_type (Pcoq.get_univ "prim") s with
-	| Some _ as x -> x, <:expr< Prim. $lid:s$ >>
-	| None ->
-      match Pcoq.entry_type (Pcoq.get_univ "constr") s with
-	| Some _ as x -> x, <:expr< Constr. $lid:s$ >>
-	| None -> 
-      match Pcoq.entry_type (Pcoq.get_univ "tactic") s with
-	| Some _ as x -> x, <:expr< Tactic. $lid:s$ >>
-	| None -> None, <:expr< $lid:s$ >> in
-    let t =
-      match t with
-	| Some t -> t
-	| None ->
-(*	    Pp.warning_with Pp_control.err_ft
-            ("Unknown primitive grammar entry: "^s);*)
-	    ExtraArgType s
-    in t, <:expr< Gramext.Snterm (Pcoq.Gram.Entry.obj $se$) >>
-
 open Pcaml
 
 EXTEND
@@ -152,7 +114,7 @@ EXTEND
   ;
   args:
     [ [ e = LIDENT; "("; s = LIDENT; ")" ->
-        let t, g = 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 4aff508f..a32aaf45 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: cases.ml,v 1.111.2.5 2005/04/29 16:31:03 herbelin Exp $ *)
+(* $Id: cases.ml 8693 2006-04-10 12:05:05Z msozeau $ *)
 
 open Util
 open Names
@@ -33,6 +33,7 @@ type pattern_matching_error =
   | BadPattern of constructor * constr
   | BadConstructor of constructor * inductive
   | WrongNumargConstructor of constructor * int
+  | WrongNumargInductive of inductive * int
   | WrongPredicateArity of constr * constr * constr
   | NeedsInversion of constr * constr
   | UnusedClause of cases_pattern list
@@ -50,8 +51,11 @@ let error_bad_pattern_loc loc cstr ind =
 let error_bad_constructor_loc loc cstr ind =
   raise_pattern_matching_error (loc, Global.env(), BadConstructor (cstr,ind))
 
-let error_wrong_numarg_constructor_loc loc c n =
-  raise_pattern_matching_error (loc, Global.env(), WrongNumargConstructor (c,n))
+let error_wrong_numarg_constructor_loc loc env c n =
+  raise_pattern_matching_error (loc, env, WrongNumargConstructor(c,n))
+
+let error_wrong_numarg_inductive_loc loc env c n =
+  raise_pattern_matching_error (loc, env, WrongNumargInductive(c,n))
 
 let error_wrong_predicate_arity_loc loc env c n1 n2 =
   raise_pattern_matching_error (loc, env, WrongPredicateArity (c,n1,n2))
@@ -59,107 +63,18 @@ let error_wrong_predicate_arity_loc loc env c n1 n2 =
 let error_needs_inversion env x t =
   raise (PatternMatchingError (env, NeedsInversion (x,t)))
 
-(*********************************************************************)
-(* A) Typing old cases                                               *)
-(* This was previously in Indrec but creates existential holes       *)
-
-let mkExistential isevars env loc = new_isevar isevars env loc (new_Type ())
-
-let norec_branch_scheme env isevars cstr =
-  let rec crec env = function
-    | d::rea -> mkProd_or_LetIn d (crec (push_rel d env) rea)
-    | [] -> mkExistential isevars env (dummy_loc, InternalHole) in 
-  crec env (List.rev cstr.cs_args)
-
-let rec_branch_scheme env isevars (sp,j) recargs cstr =
-  let rec crec env (args,recargs) = 
-    match args, recargs with 
-      | (name,None,c as d)::rea,(ra::reca) -> 
-	  let d =
- 	    match dest_recarg ra with 
-	      | Mrec k when k=j ->
-		  let t = mkExistential isevars env (dummy_loc, InternalHole)
-		  in
-		  mkArrow t
-		    (crec (push_rel (Anonymous,None,t) env)
-		       (List.rev (lift_rel_context 1 (List.rev rea)),reca))
-              | _ -> crec (push_rel d env) (rea,reca) in
-          mkProd (name,  c, d)
-
-      | (name,Some b,c as d)::rea, reca -> 
-	  mkLetIn (name,b, c,crec (push_rel d env) (rea,reca))
-      | [],[] -> mkExistential isevars env (dummy_loc, InternalHole)
-      | _ -> anomaly "rec_branch_scheme"
-  in 
-  crec env (List.rev cstr.cs_args,recargs) 
-    
-let branch_scheme env isevars isrec indf =
-  let (ind,params) = dest_ind_family indf in
-  let (mib,mip) = Inductive.lookup_mind_specif env ind in
-  let cstrs = get_constructors env indf in 
-  if isrec then
-    array_map2
-      (rec_branch_scheme env isevars ind)
-      (dest_subterms mip.mind_recargs) cstrs
-  else 
-    Array.map (norec_branch_scheme env isevars) cstrs
-
-(******************************************************)
-(* B) Building ML like case expressions without types *)
-
-let concl_n env sigma = 
-  let rec decrec m c = if m = 0 then (nf_evar sigma c) else 
-    match kind_of_term (whd_betadeltaiota env sigma c) with
-      | Prod (n,_,c_0) -> decrec (m-1) c_0
-      | _                -> failwith "Typing.concl_n"
-  in 
-  decrec
-
-let count_rec_arg j = 
-  let rec crec i = function 
-    | [] -> i 
-    | ra::l ->
-        (match dest_recarg ra with
-            Mrec k -> crec (if k=j then (i+1) else i) l
-          | _ -> crec i l)
-  in 
-  crec 0
-
-(* if arity of mispec is (p_bar:P_bar)(a_bar:A_bar)s where p_bar are the
- * K parameters. Then then build_notdep builds the predicate
- * [a_bar:A'_bar](lift k pred) 
- * where A'_bar = A_bar[p_bar <- globargs] *)
-
-let build_dep_pred env sigma indf pred =
-  let arsign,_ = get_arity env indf in
-  let psign = (Anonymous,None,build_dependent_inductive env indf)::arsign in
-  let nar = List.length psign in
-  it_mkLambda_or_LetIn_name env (lift nar pred) psign
-
-type ml_case_error =
-  | MlCaseAbsurd
-  | MlCaseDependent
-
-exception NotInferable of ml_case_error
-
-
-let pred_case_ml env sigma isrec (IndType (indf,realargs)) (i,ft) =
-  let pred =
-    let (ind,params) = dest_ind_family indf in
-    let (mib,mip) = Inductive.lookup_mind_specif env ind in
-    let recargs = dest_subterms mip.mind_recargs in
-    if Array.length recargs = 0 then raise (NotInferable MlCaseAbsurd);
-    let recargi = recargs.(i) in
-    let j = snd ind in (* index of inductive *)
-    let nbrec = if isrec then count_rec_arg j recargi else 0 in
-    let nb_arg = List.length (recargs.(i)) + nbrec in
-    let pred = Evarutil.refresh_universes (concl_n env sigma nb_arg ft) in
-    if noccur_between 1 nb_arg pred then 
-      lift (-nb_arg) pred
-    else 
-      raise (NotInferable MlCaseDependent)
-  in
-  build_dep_pred env sigma indf pred  
+module type S = sig
+  val compile_cases :
+    loc ->
+    (type_constraint -> env -> rawconstr -> unsafe_judgment) *    
+      Evd.evar_defs ref ->
+    type_constraint -> 
+    env ->
+    rawconstr option *
+      (rawconstr * (name * (loc * inductive * name list) option)) list *
+      (loc * identifier list * cases_pattern list * rawconstr) list ->
+    unsafe_judgment
+end
 
 (************************************************************************)
 (*            Pattern-matching compilation (Cases)                      *)
@@ -259,8 +174,8 @@ type tomatch_stack = tomatch_status list
 
 (* The type [predicate_signature] types the terms to match and the rhs:
 
-   - [PrLetIn (names,dep,pred)] types a pushed term ([Pushed]), 
-     if dep<>Anonymous, the term is dependent, let n=|names|, if 
+   - [PrLetIn (names,dep,pred)] types a pushed term ([Pushed]),
+     if dep<>Anonymous, the term is dependent, let n=|names|, if
      n<>0 then the type of the pushed term is necessarily an
      inductive with n real arguments. Otherwise, it may be
      non inductive, or inductive without real arguments, or inductive
@@ -376,7 +291,7 @@ let push_history_pattern n current cont =
 *)
 type pattern_matching_problem =
     { env      : env;
-      isevars  : evar_defs;
+      isevars  : Evd.evar_defs ref;
       pred     : predicate_signature option;
       tomatch  : tomatch_stack;
       history  : pattern_continuation;
@@ -388,64 +303,67 @@ type pattern_matching_problem =
  * A few functions to infer the inductive type from the patterns instead of *
  * checking that the patterns correspond to the ind. type of the            *
  * destructurated object. Allows type inference of examples like            *
- *  [n]Cases n of O => true | _ => false end                                *
+ *  match n with O => true | _ => false end                                 *
+ *  match x in I with C => true | _ => false end                            *
  *--------------------------------------------------------------------------*)
 
 (* Computing the inductive type from the matrix of patterns *)
 
+(* We use the "in I" clause to coerce the terms to match and otherwise
+   use the constructor to know in which type is the matching problem
+
+   Note that insertion of coercions inside nested patterns is done
+   each time the matrix is expanded *)
+
 let rec find_row_ind = function
     [] -> None
   | PatVar _ :: l -> find_row_ind l
   | PatCstr(loc,c,_,_) :: _ -> Some (loc,c)
 
-exception NotCoercible
-
-let inh_coerce_to_ind isevars env tmloc ty tyi =
-  let (mib,mip) = Inductive.lookup_mind_specif env tyi in
-  let (ntys,_) = splay_prod env (evars_of isevars) mip.mind_nf_arity in
+let inductive_template isevars env tmloc ind =
+  let (mib,mip) = Inductive.lookup_mind_specif env ind in
+  let (ntys,_) = splay_prod env (Evd.evars_of !isevars) mip.mind_nf_arity in
   let hole_source = match tmloc with 
-    | Some loc -> fun i -> (loc, TomatchTypeParameter (tyi,i))
-    | None -> fun _ -> (dummy_loc, InternalHole) in
+    | Some loc -> fun i -> (loc, Evd.TomatchTypeParameter (ind,i))
+    | None -> fun _ -> (dummy_loc, Evd.InternalHole) in
    let (evarl,_) =
     List.fold_right
       (fun (na,ty) (evl,n) ->
-	(new_isevar isevars env (hole_source n) (substl evl ty))::evl,n+1)
+	(e_new_evar isevars env ~src:(hole_source n) (substl evl ty))::evl,n+1)
       ntys ([],1) in
-  let expected_typ = applist (mkInd tyi,evarl) in
+   applist (mkInd ind,List.rev evarl)
+
+let inh_coerce_to_ind isevars env ty tyi =
+  let expected_typ = inductive_template isevars env None tyi in
      (* devrait être indifférent d'exiger leq ou pas puisque pour 
         un inductif cela doit être égal *)
-  if the_conv_x_leq env isevars expected_typ ty then ty
-  else raise NotCoercible
-
-(* We do the unification for all the rows that contain
- * constructor patterns. This is what we do at the higher level of patterns.
- * For nested patterns, we do this unif when we ``expand'' the matrix, and we
- * use the function above.
- *)
-
-let unify_tomatch_with_patterns isevars env tmloc typ = function
-  | Some (cloc,(cstr,_ as c)) ->
-      (let tyi = inductive_of_constructor c in
-       try 
-	 let indtyp = inh_coerce_to_ind isevars env tmloc typ tyi in
-	 IsInd (typ,find_rectype env (evars_of isevars) typ)
-       with NotCoercible ->
-	 (* 2 cases : Not the right inductive or not an inductive at all *)
-	 try
-	   IsInd (typ,find_rectype env (evars_of isevars) typ)
-             (* will try to coerce later in check_and_adjust_constructor.. *)
-	 with Not_found ->
-	   NotInd (None,typ))
-	     (* error will be detected in check_all_variables *)
-  | None -> 
-      try IsInd (typ,find_rectype env (evars_of isevars) typ)
-      with Not_found -> NotInd (None,typ)
-
-let coerce_row typing_fun isevars env cstropt tomatch =
-  let j = typing_fun empty_tycon env tomatch in
-  let typ = body_of_type j.uj_type in
-  let loc = loc_of_rawconstr tomatch in
-  let t = unify_tomatch_with_patterns isevars env (Some loc) typ cstropt in
+  let _ = e_cumul env isevars expected_typ ty in ()
+
+let unify_tomatch_with_patterns isevars env typ tm =
+  match find_row_ind tm with
+    | None -> NotInd (None,typ)
+    | Some (_,(ind,_)) ->
+	inh_coerce_to_ind isevars env typ ind;
+	try IsInd (typ,find_rectype env (Evd.evars_of !isevars) typ)
+	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)) =
+  let loc = Some (loc_of_rawconstr tomatch) in
+  let tycon = find_tomatch_tycon isevars env loc (indopt,cstropt) in
+  let j = typing_fun tycon env tomatch in
+  let typ = nf_evar (Evd.evars_of !isevars) j.uj_type in
+  let t = 
+    try IsInd (typ,find_rectype env (Evd.evars_of !isevars) typ)
+    with Not_found -> NotInd (None,typ) in
   (j.uj_val,t)
 
 let coerce_to_indtype typing_fun isevars env matx tomatchl =
@@ -458,11 +376,53 @@ let coerce_to_indtype typing_fun isevars env matx tomatchl =
 (************************************************************************)
 (* Utils *)
 
+let mkExistential env ?(src=(dummy_loc,Evd.InternalHole)) isevars =
+  e_new_evar isevars env ~src:src (new_Type ())
+
+let evd_comb2 f isevars x y =
+  let (evd',y) = f !isevars x y in
+  isevars := evd';
+  y
+
+
+module Cases_F(Coercion : Coercion.S) : S = struct
+
+let adjust_tomatch_to_pattern pb ((current,typ),deps) =
+  (* Ideally, we could find a common inductive type to which both the
+     term to match and the patterns coerce *)
+  (* In practice, we coerce the term to match if it is not already an
+     inductive type and it is not dependent; moreover, we use only 
+     the first pattern type and forget about the others *)
+  let typ = match typ with IsInd (t,_) -> t | NotInd (_,t) -> t in
+  let typ =
+    try IsInd (typ,find_rectype pb.env (Evd.evars_of !(pb.isevars)) typ)
+    with Not_found -> NotInd (None,typ) in
+  let tomatch = ((current,typ),deps) in
+  match typ with
+  | NotInd (None,typ) ->
+      let tm1 = List.map (fun eqn -> List.hd eqn.patterns) pb.mat in
+      (match find_row_ind tm1 with
+	| None -> tomatch
+	| Some (_,(ind,_)) ->
+	    let indt = inductive_template pb.isevars pb.env None ind in
+	    let current =
+	      if deps = [] & isEvar typ then
+	      (* Don't insert coercions if dependent; only solve evars *)
+		let _ = e_cumul pb.env pb.isevars indt typ in
+		current
+	      else
+		(evd_comb2 (Coercion.inh_conv_coerce_to dummy_loc pb.env)
+		  pb.isevars (make_judge current typ) (mk_tycon_type indt)).uj_val in
+	    let sigma = Evd.evars_of !(pb.isevars) in
+	    let typ = IsInd (indt,find_rectype pb.env sigma indt) in
+	    ((current,typ),deps))
+  | _ -> tomatch
+
    (* extract some ind from [t], possibly coercing from constructors in [tm] *)
 let to_mutind env isevars tm c t =
-  match c with
-    | Some body -> NotInd (c,t)
-    | None -> unify_tomatch_with_patterns isevars env None t (find_row_ind tm)
+(*  match c with
+    | Some body -> *) NotInd (c,t)
+(*    | None -> unify_tomatch_with_patterns isevars env t tm*)
 
 let type_of_tomatch = function
   | IsInd (t,_) -> t
@@ -558,7 +518,8 @@ let check_and_adjust_constructor ind cstrs = function
 	    let args' = adjust_local_defs loc (args, List.rev ci.cs_args)
 	    in PatCstr (loc, cstr, args', alias)
 	  with NotAdjustable ->
-	    error_wrong_numarg_constructor_loc loc cstr nb_args_constr
+	    error_wrong_numarg_constructor_loc loc (Global.env())
+	      cstr nb_args_constr
       else
 	(* Try to insert a coercion *)
 	try
@@ -715,11 +676,11 @@ let lift_tomatch_stack n = liftn_tomatch_stack n 1
 (* Some heuristics to get names for variables pushed in pb environment *)
 (* Typical requirement:
 
-   [Cases y of (S (S x)) => x | x => x end] should be compiled into
-   [Cases y of O => y | (S n) => Cases n of O => y | (S x) => x end end]
+   [match y with (S (S x)) => x | x => x end] should be compiled into
+   [match y with O => y | (S n) => match n with O => y | (S x) => x end end]
 
-   and [Cases y of (S (S n)) => n | n => n end] into 
-   [Cases y of O => y | (S n0) => Cases n0 of O => y | (S n) => n end end]
+   and [match y with (S (S n)) => n | n => n end] into 
+   [match y with O => y | (S n0) => match n0 with O => y | (S n) => n end end]
 
   i.e. user names should be preserved and created names should not
   interfere with user names *)
@@ -782,7 +743,6 @@ let build_aliases_context env sigma names allpats pats =
 	let newallpats =
 	  List.map2 (fun l1 l2 -> List.hd l2::l1) newallpats oldallpats in
 	let oldallpats = List.map List.tl oldallpats in
-	let u = Retyping.get_type_of env sigma deppat in
 	let decl = (na,Some deppat,t) in
 	let a = (deppat,nondeppat,d,t) in
 	insert (push_rel decl env) (decl::sign1) ((na,a)::sign2) (n+1) 
@@ -869,10 +829,10 @@ the following n+1 equations:
 
 Some hints:
 
-- Clearly, if xij occurs in Ti, then, a "Cases z of (Ci xi1..xipi) => ..."
+- Clearly, if xij occurs in Ti, then, a "match z with (Ci xi1..xipi) => ..."
   should be inserted somewhere in Ti.
 
-- If T is undefined, an easy solution is to insert a "Cases z of (Ci
+- If T is undefined, an easy solution is to insert a "match z with (Ci
   xi1..xipi) => ..." in front of each Ti
 
 - Otherwise, T1..Tn and T must be step by step unified, if some of them
@@ -902,7 +862,7 @@ let shift_operator k = function OpLambda _ | OpProd _ -> k+1 | _ -> k
 
 let reloc_operator (k,n) = function OpRel p when p > k -> 
 let rec unify_clauses k pv =
-  let pv'= Array.map (fun (n,sign,_,p) -> n,splay_constr (whd_betaiotaevar (push_rels (List.rev sign) env) (evars_of isevars)) p) pv in
+  let pv'= Array.map (fun (n,sign,_,p) -> n,splay_constr (whd_betaiotaevar (push_rels (List.rev sign) env) (Evd.evars_of isevars)) p) pv in
   let n1,op1 = let (n1,(op1,args1)) = pv'.(0) in n1,op1 in
   if Array.for_all (fun (ni,(opi,_)) -> eq_operator_lift k (n1,ni) (op1,opi)) pv'
   then
@@ -918,28 +878,30 @@ let abstract_conclusion typ cs =
   lam_it p sign
 
 let infer_predicate loc env isevars typs cstrs indf =
-  let (mis,_) = dest_ind_family indf in
   (* Il faudra substituer les isevars a un certain moment *)
   if Array.length cstrs = 0 then (* "TODO4-3" *)
     error "Inference of annotation for empty inductive types not implemented"
   else
     (* Empiric normalization: p may depend in a irrelevant way on args of the*)
-    (* cstr as in [c:{_:Alpha & Beta}] Cases c of (existS a b)=>(a,b) end *)
+    (* cstr as in [c:{_:Alpha & Beta}] match c with (existS a b)=>(a,b) end *)
     let typs =
-      Array.map (local_strong (whd_betaevar empty_env (evars_of isevars))) typs
+      Array.map (local_strong (whd_betaevar empty_env (Evd.evars_of !isevars))) typs
     in
     let eqns = array_map2 prepare_unif_pb typs cstrs in
     (* First strategy: no dependencies at all *)
-(*    let (cclargs,_,typn) = eqns.(mis_nconstr mis -1) in*)
+(*
+    let (mis,_) = dest_ind_family indf in
+    let (cclargs,_,typn) = eqns.(mis_nconstr mis -1) in
+*)
     let (sign,_) = get_arity env indf in
     let mtyp =
       if array_exists is_Type typs then
 	(* Heuristic to avoid comparison between non-variables algebric univs*)
 	new_Type ()
       else
-	mkExistential isevars env (loc, CasesType)
+	mkExistential env ~src:(loc, Evd.CasesType) isevars
     in
-    if array_for_all (fun (_,_,typ) -> the_conv_x_leq env isevars typ mtyp) eqns
+    if array_for_all (fun (_,_,typ) -> e_cumul env isevars typ mtyp) eqns
     then
       (* Non dependent case -> turn it into a (dummy) dependent one *)
       let sign = (Anonymous,None,build_dependent_inductive env indf)::sign in
@@ -980,7 +942,7 @@ let rec map_predicate f k = function
 let rec noccurn_predicate k = function
   | PrCcl ccl -> noccurn k ccl
   | PrProd pred -> noccurn_predicate (k+1) pred
-  | PrLetIn ((names,dep as tm),pred) ->
+  | PrLetIn ((names,dep),pred) ->
       let k' = List.length names + (if dep<>Anonymous then 1 else 0) in
       noccurn_predicate (k+k') pred
 
@@ -1066,8 +1028,8 @@ let abstract_predicate env sigma indf cur tms = function
          args or not, we lift it to make room for [sign] *)
       (* Even if not intrinsically dep, we move the predicate into a dep one *)
       let sign,k =
-        if names = [] & n <> 1 then 
-          (* Real args were not considered *) 
+        if names = [] & n <> 1 then
+          (* Real args were not considered *)
           (if dep<>Anonymous then
             ((let (_,c,t) = List.hd sign in (dep,c,t)::List.tl sign),n-1)
           else
@@ -1106,7 +1068,7 @@ let expand_arg n alreadydep (na,t) deps (k,pred) =
 (*****************************************************************************)
 (* pred = [X:=realargs;x:=c]P types the following problem:                   *)
 (*                                                                           *)
-(*  Gamma |- Cases Pushed(c:I(realargs)) rest of...end: pred                 *)
+(*  Gamma |- match Pushed(c:I(realargs)) rest with...end: pred               *)
 (*                                                                           *)
 (* where the branch with constructor Ci:(x1:T1)...(xn:Tn)->I(realargsi)      *)
 (* is considered. Assume each Ti is some Ii(argsi).                          *)
@@ -1114,7 +1076,7 @@ let expand_arg n alreadydep (na,t) deps (k,pred) =
 (*                                                                           *)
 (* pred' = [X1:=rargs1,x1:=x1']...[Xn:=rargsn,xn:=xn'](P[X:=realargsi;x:=e]) *)
 (*                                                                           *)
-(* s.t Gamma,x1'..xn' |- Cases Pushed(x1')..Pushed(xn') rest of...end: pred' *)
+(* s.t Gamma,x1'..xn' |- match Pushed(x1')..Pushed(xn') rest with..end :pred'*)
 (*                                                                           *)
 (*****************************************************************************)
 let specialize_predicate tomatchs deps cs = function
@@ -1141,7 +1103,7 @@ let find_predicate loc env isevars p typs cstrs current
   (IndType (indf,realargs)) tms =
   let (dep,pred) =
     match p with
-      | Some p -> abstract_predicate env (evars_of isevars) indf current tms p
+      | Some p -> abstract_predicate env (Evd.evars_of !isevars) indf current tms p
       | None -> infer_predicate loc env isevars typs cstrs indf in
   let typ = whd_beta (applist (pred, realargs)) in
   if dep then
@@ -1191,7 +1153,7 @@ let group_equations pb mind current cstrs mat =
 		 let rest = {rest with tag = lower_pattern_status rest.tag} in
 		 brs.(i-1) <- (args, rest) :: brs.(i-1)
 	       done
-	   | PatCstr (loc,((_,i) as cstr),args,_) as pat ->
+	   | PatCstr (loc,((_,i)),args,_) ->
 	       (* This is a regular clause *)
 	       only_default := false;
 	       brs.(i-1) <- (args,rest) :: brs.(i-1)) mat () in
@@ -1240,8 +1202,6 @@ let build_branch current deps pb eqns const_info =
     else 
       DepAlias
   in
-  let partialci =
-    applist (mkConstruct const_info.cs_cstr, const_info.cs_params) in
   let history = 
     push_history_pattern const_info.cs_nargs
       (AliasConstructor const_info.cs_cstr)
@@ -1324,10 +1284,8 @@ let rec compile pb =
     | (Abstract d)::rest -> compile_generalization pb d rest
     | [] -> build_leaf pb
 
-and match_current pb ((current,typ as ct),deps) =
-  let tm1 = List.map (fun eqn -> List.hd eqn.patterns) pb.mat in
-  let (_,c,t) = mkDeclTomatch Anonymous typ in
-  let typ = to_mutind pb.env pb.isevars tm1 c t in
+and match_current pb tomatch =
+  let ((current,typ as ct),deps) = adjust_tomatch_to_pattern pb tomatch in
   match typ with
     | NotInd (_,typ) ->
 	check_all_variables typ pb.mat;
@@ -1336,10 +1294,10 @@ and match_current pb ((current,typ as ct),deps) =
 	let mind,_ = dest_ind_family indf in
 	let cstrs = get_constructors pb.env indf in
 	let eqns,onlydflt = group_equations pb mind current cstrs pb.mat in
-	if (cstrs <> [||] or not (initial_history pb.history)) & onlydflt then
+	if (Array.length cstrs <> 0 or pb.mat <> []) & onlydflt  then
 	  compile (shift_problem ct pb)
 	else
-          let constraints = Array.map (solve_constraints indt) cstrs in
+          let _constraints = Array.map (solve_constraints indt) cstrs in
 
 	  (* We generalize over terms depending on current term to match *)
 	  let pb = generalize_problem pb current deps in
@@ -1381,7 +1339,7 @@ and compile_generalization pb d rest =
 and compile_alias pb (deppat,nondeppat,d,t) rest =
   let history = simplify_history pb.history in
   let sign, newenv, mat =
-    insert_aliases pb.env (evars_of pb.isevars) (deppat,nondeppat,d,t) pb.mat in
+    insert_aliases pb.env (Evd.evars_of !(pb.isevars)) (deppat,nondeppat,d,t) pb.mat in
   let n = List.length sign in
 
   (* We had Gamma1; x:current; Gamma2 |- tomatch(x) and we rebind x to get *)
@@ -1436,7 +1394,7 @@ let rename_env subst env =
 
 let is_dependent_indtype = function
   | NotInd _ -> false
-  | IsInd (_, IndType(_,realargs)) -> List.length realargs <> 0
+  | IsInd (_, IndType(_,realargs)) -> realargs <> []
 
 let prepare_initial_alias_eqn isdep tomatchl eqn =
   let (subst, pats) = 
@@ -1444,7 +1402,7 @@ let prepare_initial_alias_eqn isdep tomatchl eqn =
     (fun pat (tm,tmtyp) (subst, stripped_pats) ->
        match alias_of_pat pat with
 	 | Anonymous -> (subst, pat::stripped_pats)
-	 | Name idpat as na ->
+	 | Name idpat ->
 	     match kind_of_term tm with
 	       | Rel n when not (is_dependent_indtype tmtyp) & not isdep
 		   -> (n, idpat)::subst, (unalias_pat pat::stripped_pats)
@@ -1531,7 +1489,7 @@ let extract_predicate_conclusion isdep tomatchl pred =
     if n=0 then (l,p) else
     match kind_of_term p with
       | Lambda (na,_,c) -> decomp_lam_force (n-1) (na::l) c
-      | _ -> (* eta-expansion *) 
+      | _ -> (* eta-expansion *)
           let na = Name (id_of_string "x") in
           decomp_lam_force (n-1) (na::l) (applist (lift 1 p, [mkRel 1])) in
   let rec buildrec allnames p = function
@@ -1543,7 +1501,7 @@ let extract_predicate_conclusion isdep tomatchl pred =
                 (* adjust to a sign containing the NotInd's *)
                 if isdep then lift 1 p else p in
               let names = if isdep then [Anonymous] else [] in
-              buildrec (names::allnames) p ltm 
+              buildrec (names::allnames) p ltm
 	  | Some n ->
               let n = if isdep then n+1 else n in
               let names,p = decomp_lam_force n [] p in
@@ -1590,30 +1548,32 @@ let set_arity_signature dep n arsign tomatchl pred x =
   decomp_block [] pred (tomatchl,arsign)
 
 let prepare_predicate_from_tycon loc dep env isevars tomatchs c =
-  let cook (n, l, signs) = function
+  let cook (n, l, env, signs) = function
     | c,IsInd (_,IndType(indf,realargs)) ->
 	let indf' = lift_inductive_family n indf in
-	let arsign = make_arity_signature env dep indf' in
+	let sign = make_arity_signature env dep indf' in
 	let p = List.length realargs in
 	if dep then
-	  (n + p + 1, c::(List.rev realargs)@l, arsign::signs)
+	  (n + p + 1, c::(List.rev realargs)@l, push_rels sign env,sign::signs)
 	else
-	  (n + p, (List.rev realargs)@l, arsign::signs)
+	  (n + p, (List.rev realargs)@l, push_rels sign env,sign::signs)
     | c,NotInd _ ->
-	(n, l, []::signs) in
-  let n, allargs, signs = List.fold_left cook (0, [], []) tomatchs in
-  let env = List.fold_right push_rels signs env in
+	(n, l, env, []::signs) in
+  let n, allargs, env, signs = List.fold_left cook (0, [], env, []) tomatchs in
+  let names = List.rev (List.map (List.map pi1) signs) in
   let allargs =
-    List.map (fun c -> lift n (nf_betadeltaiota env (evars_of isevars) c)) allargs in
+    List.map (fun c -> lift n (nf_betadeltaiota env (Evd.evars_of !isevars) c)) allargs in
   let rec build_skeleton env c =
     (* Don't put into normal form, it has effects on the synthesis of evars *)
  (* let c = whd_betadeltaiota env (evars_of isevars) c in *)
     (* We turn all subterms possibly dependent into an evar with maximum ctxt*)
     if isEvar c or List.exists (eq_constr c) allargs then
-      mkExistential isevars env (loc, CasesType)
+      e_new_evar isevars env  ~src:(loc, Evd.CasesType)
+        (Retyping.get_type_of env (Evd.evars_of !isevars) c)
     else
-      map_constr_with_full_binders push_rel build_skeleton env c in
- List.rev (List.map (List.map pi1) signs), build_skeleton env (lift n c)
+      map_constr_with_full_binders push_rel build_skeleton env c 
+  in
+    names, build_skeleton env (lift n c)
   
 (* Here, [pred] is assumed to be in the context built from all *)
 (* realargs and terms to match *)
@@ -1629,7 +1589,7 @@ let build_initial_predicate isdep allnames pred =
             if dependent (mkRel (nar-n')) pred then pred, 1, 1
             else liftn (-1) (nar-n') pred, 0, 1
           else pred, 0, 0 in
-        let na = 
+        let na =
           if p=1 then
             let na = List.hd names in
             if na = Anonymous then
@@ -1637,11 +1597,11 @@ let build_initial_predicate isdep allnames pred =
               Name (id_of_string "x") (*Hum*)
             else na
           else Anonymous in
-	PrLetIn ((names',na), buildrec (n'+user_p) pred lnames)
+        PrLetIn ((names',na), buildrec (n'+user_p) pred lnames)
   in buildrec 0 pred allnames
 
 let extract_arity_signature env0 tomatchl tmsign =
-  let get_one_sign n tm {contents = (na,t)} =
+  let get_one_sign n tm (na,t) =
     match tm with
       | NotInd (bo,typ) -> 
 	  (match t with
@@ -1659,9 +1619,10 @@ let extract_arity_signature env0 tomatchl tmsign =
 		  let nparams = List.length params in
 		  if ind <> ind' then
 		    user_err_loc (loc,"",str "Wrong inductive type");
-		  if List.length nal <> nparams + nrealargs then
-		    user_err_loc (loc,"",
-		    str "Wrong number of arguments for inductive type");
+		  let nindargs = nparams + nrealargs in
+		  (* Normally done at interning time *)
+		  if List.length nal <> nindargs then
+		    error_wrong_numarg_inductive_loc loc env0 ind' nindargs;
 		  let parnal,realnal = list_chop nparams nal in
 		  if List.exists ((<>) Anonymous) parnal then
 		    user_err_loc (loc,"",
@@ -1679,101 +1640,74 @@ let extract_arity_signature env0 tomatchl tmsign =
     | _ -> assert false
   in List.rev (buildrec 0 (tomatchl,tmsign))
 
+let inh_conv_coerce_to_tycon loc env isevars j tycon =
+  match tycon with
+    | Some p ->
+	let (evd',j) = Coercion.inh_conv_coerce_to loc env !isevars j p in
+          isevars := evd';
+          j
+    | None -> j
+
+
 (* Builds the predicate. If the predicate is dependent, its context is
  * made of 1+nrealargs assumptions for each matched term in an inductive
  * type and 1 assumption for each term not _syntactically_ in an
  * inductive type.
 
- * V7 case: determines whether the multiple case is dependent or not
- * - if its arity is made of nrealargs assumptions for each matched
- * term in an inductive type and nothing for terms not _syntactically_
- * in an inductive type, then it is non dependent
- * - if its arity is made of 1+nrealargs assumptions for each matched
- * term in an inductive type and nothing for terms not _syntactically_
- * in an inductive type, then it is dependent and needs an adjustement
- * to fulfill the criterion above that terms not in an inductive type
- * counts for 1 in the dependent case
-
- * V8 case: each matched terms are independently considered dependent
- * or not
+ * Each matched terms are independently considered dependent or not.
 
- * A type constraint but no annotation case: it is assumed non dependent
+ * A type constraint but no annotation case: it is assumed non dependent.
  *)
 
 let prepare_predicate loc typing_fun isevars env tomatchs sign tycon = function
-  (* No type annotation at all *)
-  | (None,{contents = None}) ->
+  (* No type annotation *)
+  | None ->
       (match tycon with
-       | None -> None
-       | Some t ->
-	 let names,pred = prepare_predicate_from_tycon loc false env isevars tomatchs t in
-	 Some (build_initial_predicate false names pred))
-
-  (* v8 style type annotation *)
-  | (None,{contents = Some rtntyp}) ->
-
+       | Some (None, t) ->
+	   let names,pred = 
+	     prepare_predicate_from_tycon loc false env isevars tomatchs t 
+	   in Some (build_initial_predicate false names pred)
+       | _ -> None)
+
+  (* Some type annotation *)
+  | Some rtntyp ->
       (* We extract the signature of the arity *)
-      let arsigns = extract_arity_signature env tomatchs sign in
-      let env = List.fold_right push_rels arsigns env in
-      let allnames = List.rev (List.map (List.map pi1) arsigns) in
-      let predccl = (typing_fun (mk_tycon (new_Type ())) env rtntyp).uj_val in
-      Some (build_initial_predicate true allnames predccl)
-
-  (* v7 style type annotation; set the v8 annotation by side effect *)
-  | (Some pred,x) ->
-      let loc = loc_of_rawconstr pred in
-      let dep, n, predj =
-	let isevars_copy = evars_of isevars in
-        (* We first assume the predicate is non dependent *)
-	let ndep_arity = build_expected_arity env isevars false tomatchs in
-        try
-	  false, nb_prod ndep_arity, typing_fun (mk_tycon ndep_arity) env pred
-	with PretypeError _ | TypeError _ |
-	    Stdpp.Exc_located (_,(PretypeError _ | TypeError _)) ->
-        evars_reset_evd isevars_copy isevars;
-        (* We then assume the predicate is dependent *)
-	let dep_arity = build_expected_arity env isevars true tomatchs in
-	try
-	  true, nb_prod dep_arity, typing_fun (mk_tycon dep_arity) env pred
-	with PretypeError _ | TypeError _ |
-	  Stdpp.Exc_located (_,(PretypeError _ | TypeError _)) ->
-        evars_reset_evd isevars_copy isevars;
-        (* Otherwise we attempt to type it without constraints, possibly *)
-        (* failing with an error message; it may also be well-typed *)
-	(* but fails to satisfy arity constraints in case_dependent *)
-        let predj = typing_fun empty_tycon env pred in
-	error_wrong_predicate_arity_loc
-	  loc env predj.uj_val ndep_arity dep_arity
+      let arsign = extract_arity_signature env tomatchs sign in
+      let env = List.fold_right push_rels arsign env in
+      let allnames = List.rev (List.map (List.map pi1) arsign) in
+      let predcclj = typing_fun (mk_tycon (new_Type ())) env rtntyp in
+      let _ = 
+	option_app (fun tycon -> 
+		      isevars := Coercion.inh_conv_coerces_to loc env !isevars predcclj.uj_val tycon)
+	  tycon
       in
-      let ln,predccl= extract_predicate_conclusion dep tomatchs predj.uj_val in
-      set_arity_signature dep n sign tomatchs pred x;
-      Some (build_initial_predicate dep ln predccl)
-
+      let predccl = (j_nf_isevar !isevars predcclj).uj_val in      
+	Some (build_initial_predicate true allnames predccl)
 
 (**************************************************************************)
 (* Main entry of the matching compilation                                 *)
-
-let compile_cases loc (typing_fun,isevars) tycon env (predopt, tomatchl, eqns)=
-
+  
+let compile_cases loc (typing_fun, isevars) (tycon : Evarutil.type_constraint) env (predopt, tomatchl, eqns)=
+  
   (* We build the matrix of patterns and right-hand-side *)
   let matx = matx_of_eqns env tomatchl eqns in
-
+    
   (* We build the vector of terms to match consistently with the *)
   (* constructors found in patterns *)
-  let rawtms, tmsign = List.split tomatchl in
-  let tomatchs = coerce_to_indtype typing_fun isevars env matx rawtms in
-
+  let tomatchs = coerce_to_indtype typing_fun isevars env matx tomatchl in
+    
   (* We build the elimination predicate if any and check its consistency *)
   (* with the type of arguments to match *)
+  let tmsign = List.map snd tomatchl in
   let pred = prepare_predicate loc typing_fun isevars env tomatchs tmsign tycon predopt in
-
+    
   (* We deal with initial aliases *)
   let matx = prepare_initial_aliases (known_dependent pred) tomatchs matx in 
-
+    
   (* We push the initial terms to match and push their alias to rhs' envs *)
   (* names of aliases will be recovered from patterns (hence Anonymous here) *)
   let initial_pushed = List.map (fun tm -> Pushed (tm,[])) tomatchs in
- 
+    
   let pb =
     { env      = env;
       isevars  = isevars;
@@ -1783,12 +1717,10 @@ let compile_cases loc (typing_fun,isevars) tycon env (predopt, tomatchl, eqns)=
       mat      = matx;
       caseloc  = loc;
       typing_function = typing_fun } in
-  
+    
   let _, j = compile pb in
-
-  (* We check for unused patterns *)
-  List.iter (check_unused_pattern env) matx;
+    (* We check for unused patterns *)
+    List.iter (check_unused_pattern env) matx;
+    inh_conv_coerce_to_tycon loc env isevars j tycon
+end
   
-  match tycon with
-    | Some p ->	Coercion.inh_conv_coerce_to loc env isevars j p
-    | None -> j
diff --git a/pretyping/cases.mli b/pretyping/cases.mli
index 1d2f9025..5919c42a 100644
--- a/pretyping/cases.mli
+++ b/pretyping/cases.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: cases.mli,v 1.22.2.2 2004/07/16 19:30:43 herbelin Exp $ i*)
+(*i $Id: cases.mli 8654 2006-03-22 15:36:58Z msozeau $ i*)
 
 (*i*)
 open Util
@@ -23,6 +23,7 @@ type pattern_matching_error =
   | BadPattern of constructor * constr
   | BadConstructor of constructor * inductive
   | WrongNumargConstructor of constructor * int
+  | WrongNumargInductive of inductive * int
   | WrongPredicateArity of constr * constr * constr
   | NeedsInversion of constr * constr
   | UnusedClause of cases_pattern list
@@ -31,26 +32,23 @@ type pattern_matching_error =
 
 exception PatternMatchingError of env * pattern_matching_error
 
-(*s Used for old cases in pretyping *)
+val error_wrong_numarg_constructor_loc : loc -> env -> constructor -> int -> 'a
 
-val branch_scheme : 
-  env -> evar_defs -> bool -> inductive_family -> constr array
-
-type ml_case_error =
-  | MlCaseAbsurd
-  | MlCaseDependent
-
-exception NotInferable of ml_case_error
-
-val pred_case_ml : (* raises [NotInferable] if not inferable *)
-  env -> evar_map -> bool -> inductive_type -> int * types -> constr 
+val error_wrong_numarg_inductive_loc : loc -> env -> inductive -> int -> 'a
 
 (*s Compilation of pattern-matching. *)
 
-val compile_cases :
-  loc -> (type_constraint -> env -> rawconstr -> unsafe_judgment)
-  * evar_defs -> type_constraint -> env ->
-      (rawconstr option * rawconstr option ref) *
-      (rawconstr * (name * (loc * inductive * name list) option) ref) list *
-    (loc * identifier list * cases_pattern list * rawconstr) list ->
+module type S = sig
+  val compile_cases :
+    loc ->
+    (type_constraint -> env -> rawconstr -> unsafe_judgment) *    
+      evar_defs ref ->
+    type_constraint -> 
+    env ->
+    rawconstr option *
+      (rawconstr * (name * (loc * inductive * name list) option)) list *
+      (loc * identifier list * cases_pattern list * rawconstr) list ->
     unsafe_judgment
+end
+
+module Cases_F(C : Coercion.S) : S
diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml
index 88f59ded..33166ba8 100644
--- a/pretyping/cbv.ml
+++ b/pretyping/cbv.ml
@@ -6,16 +6,16 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: cbv.ml,v 1.12.2.1 2004/07/16 19:30:44 herbelin Exp $ *)
+(* $Id: cbv.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 open Util
 open Pp
 open Term
 open Names
 open Environ
-open Instantiate
 open Univ
 open Evd
+open Conv_oracle
 open Closure
 open Esubst
 
@@ -92,7 +92,7 @@ let contract_cofixp env (i,(_,_,bds as bodies)) =
   subst_bodies_from_i 0 env, bds.(i)
 
 let make_constr_ref n = function
-  | FarRelKey p -> mkRel (n+p)
+  | RelKey p -> mkRel (n+p)
   | VarKey id -> mkVar id
   | ConstKey cst -> mkConst cst
 
@@ -128,7 +128,7 @@ let stack_app appl stack =
 open RedFlags
 
 let red_set_ref flags = function
-  | FarRelKey _ -> red_set flags fDELTA
+  | RelKey _ -> red_set flags fDELTA
   | VarKey id -> red_set flags (fVAR id)
   | ConstKey sp -> red_set flags (fCONST sp)
 
@@ -186,7 +186,7 @@ let rec norm_head info env t stack =
       let nargs = Array.map (cbv_stack_term info TOP env) args in
       norm_head info env head (stack_app (Array.to_list nargs) stack)
   | Case (ci,p,c,v) -> norm_head info env c (CASE(p,v,ci,env,stack))
-  | Cast (ct,_) -> norm_head info env ct stack
+  | Cast (ct,_,_) -> norm_head info env ct stack
 
   (* constants, axioms
    * the first pattern is CRUCIAL, n=0 happens very often:
@@ -196,7 +196,7 @@ let rec norm_head info env t stack =
         | Inl (0,v)      -> strip_appl v stack
         | Inl (n,v)      -> strip_appl (shift_value n v) stack
         | Inr (n,None)   -> (VAL(0, mkRel n), stack)
-        | Inr (n,Some p) -> norm_head_ref (n-p) info env stack (FarRelKey p))
+        | Inr (n,Some p) -> norm_head_ref (n-p) info env stack (RelKey p))
 
   | Var id -> norm_head_ref 0 info env stack (VarKey id)
 
diff --git a/pretyping/cbv.mli b/pretyping/cbv.mli
index bf8e03b3..dfdf12dd 100644
--- a/pretyping/cbv.mli
+++ b/pretyping/cbv.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: cbv.mli,v 1.6.14.1 2004/07/16 19:30:44 herbelin Exp $ i*)
+(*i $Id: cbv.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Names
diff --git a/pretyping/classops.ml b/pretyping/classops.ml
index 2d8fb951..b6cce031 100755..100644
--- a/pretyping/classops.ml
+++ b/pretyping/classops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: classops.ml,v 1.48.2.1 2004/07/16 19:30:44 herbelin Exp $ *)
+(* $Id: classops.ml 8642 2006-03-17 10:09:02Z notin $ *)
 
 open Util
 open Pp
@@ -21,6 +21,7 @@ open Term
 open Termops
 open Rawterm
 open Decl_kinds
+open Mod_subst
 
 (* usage qque peu general: utilise aussi dans record *)
 
@@ -35,14 +36,14 @@ type cl_typ =
   | CL_IND of inductive
 
 type cl_info_typ = {
-  cl_strength : strength;
   cl_param : int
 }
 
 type coe_typ = global_reference
 
 type coe_info_typ = {
-  coe_value : unsafe_judgment;
+  coe_value : constr;
+  coe_type : types;
   coe_strength : strength;
   coe_is_identity : bool;
   coe_param : int }
@@ -91,11 +92,7 @@ let unfreeze (fcl,fco,fig) =
 (* ajout de nouveaux "objets" *)
 
 let add_new_class cl s =
-  try
-    let n,s' = Bijint.revmap cl !class_tab in
-    if s.cl_strength = Global & s'.cl_strength <> Global then
-      class_tab := Bijint.replace n cl s !class_tab
-  with Not_found ->
+  if not (Bijint.mem cl !class_tab) then
     class_tab := Bijint.add cl s !class_tab
 
 let add_new_coercion coe s = 
@@ -106,11 +103,19 @@ let add_new_path x y =
 
 let init () =
   class_tab:= Bijint.empty; 
-  add_new_class CL_FUN  { cl_param = 0; cl_strength = Global };
-  add_new_class CL_SORT { cl_param = 0; cl_strength = Global };
+  add_new_class CL_FUN  { cl_param = 0 };
+  add_new_class CL_SORT { cl_param = 0 };
   coercion_tab:= Gmap.empty;
   inheritance_graph:= Gmap.empty
 
+let _ = 
+  Summary.declare_summary "inh_graph"
+    { Summary.freeze_function = freeze;
+      Summary.unfreeze_function = unfreeze;
+      Summary.init_function = init;
+      Summary.survive_module = false;
+      Summary.survive_section = false }
+
 let _ = init()
 
 (* class_info : cl_typ -> int * cl_info_typ *)
@@ -146,80 +151,44 @@ let lookup_pattern_path_between (s,t) =
     (fun coe ->
        let c, _ =
 	 Reductionops.whd_betadeltaiota_stack (Global.env()) Evd.empty 
-	   coe.coe_value.uj_val
+	   coe.coe_value
        in 
        match kind_of_term c with
 	 | Construct sp -> (sp, coe.coe_param)
 	 | _ -> raise Not_found) l
 
+(* find_class_type : constr -> cl_typ * int *)
+
+let find_class_type t =
+  let t', args = decompose_app (Reductionops.whd_betaiotazeta t) in
+  match kind_of_term t' with
+    | Var id -> CL_SECVAR id, args
+    | Const sp -> CL_CONST sp, args
+    | Ind ind_sp -> CL_IND ind_sp, args
+    | Prod (_,_,_) -> CL_FUN, []
+    | Sort _ -> CL_SORT, []
+    |  _ -> raise Not_found
+
 
 let subst_cl_typ subst ct = match ct with
     CL_SORT
   | CL_FUN
   | CL_SECVAR _ -> ct
   | CL_CONST kn -> 
-      let kn' = subst_kn subst kn in 
+      let kn',t = subst_con subst kn in 
 	if kn' == kn then ct else
-	  CL_CONST kn'
+         fst (find_class_type t)
   | CL_IND (kn,i) ->
       let kn' = subst_kn subst kn in 
 	if kn' == kn then ct else
 	  CL_IND (kn',i)
 
-let subst_coe_typ = subst_global
-
-let subst_coe_info subst info = 
-  let jud = info.coe_value in
-  let val' = subst_mps subst (j_val jud) in
-  let type' = subst_mps subst (j_type jud) in
-    if val' == j_val jud && type' == j_type jud then info else
-      {info with coe_value = make_judge val' type'}
-
-(* library, summary *)
-
-(*val inClass : (cl_typ * cl_info_typ) -> Libobject.object = <fun>
- val outClass : Libobject.object -> (cl_typ * cl_info_typ) = <fun> *)
-
-let cache_class (_,(x,y)) = add_new_class x y
-
-let subst_class (_,subst,(ct,ci as obj)) = 
-  let ct' = subst_cl_typ subst ct in
-    if ct' == ct then obj else
-      (ct',ci)
-
-let (inClass,outClass) =
-  declare_object {(default_object "CLASS") with 
-		    load_function = (fun _ o -> cache_class o);
-                    cache_function = cache_class;
-		    subst_function = subst_class;
-		    classify_function = (fun (_,x) -> Substitute x); 
-		    export_function = (function x -> Some x)  }
-
-let declare_class (cl,stre,p) = 
-  Lib.add_anonymous_leaf (inClass ((cl,{ cl_strength = stre; cl_param = p })))
-   
-let _ = 
-  Summary.declare_summary "inh_graph"
-    { Summary.freeze_function = freeze;
-      Summary.unfreeze_function = unfreeze;
-      Summary.init_function = init;
-      Summary.survive_module = false;
-      Summary.survive_section = false }
+(*CSC: here we should change the datatype for coercions: it should be possible
+       to declare any term as a coercion *)
+let subst_coe_typ subst t = fst (subst_global subst t)
 
 (* classe d'un terme *)
 
-(* find_class_type : constr -> cl_typ * int *)
-
-let find_class_type t =
-  let t', args = decompose_app (Reductionops.whd_betaiotazeta t) in
-  match kind_of_term t' with
-    | Var id -> CL_SECVAR id, args
-    | Const sp -> CL_CONST sp, args
-    | Ind ind_sp -> CL_IND ind_sp, args
-    | Prod (_,_,_) -> CL_FUN, []
-    | Sort _ -> CL_SORT, []
-    |  _ -> raise Not_found
-
 (* class_of : Term.constr -> int *)
 
 let class_of env sigma t = 
@@ -241,8 +210,8 @@ let inductive_class_of ind = fst (class_info (CL_IND ind))
 let class_args_of c = snd (decompose_app c)
 
 let string_of_class = function
-  | CL_FUN -> if !Options.v7 then "FUNCLASS" else "Funclass"
-  | CL_SORT -> if !Options.v7 then "SORTCLASS" else "Sortclass"
+  | CL_FUN -> "Funclass"
+  | CL_SORT -> "Sortclass"
   | CL_CONST sp ->
       string_of_qualid (shortest_qualid_of_global Idset.empty (ConstRef sp))
   | CL_IND sp ->
@@ -254,7 +223,8 @@ let pr_class x = str (string_of_class x)
 
 (* coercion_value : coe_index -> unsafe_judgment * bool *)
 
-let coercion_value { coe_value = j; coe_is_identity = b } = (j,b)
+let coercion_value { coe_value = c; coe_type = t; coe_is_identity = b } =
+  (make_judge c t, b)
 
 (* pretty-print functions are now in Pretty *)
 (* rajouter une coercion dans le graphe *)
@@ -319,49 +289,81 @@ let add_coercion_in_graph (ic,source,target) =
   if (!ambig_paths <> []) && is_verbose () then 
     ppnl (message_ambig !ambig_paths)
 
-type coercion = coe_typ * coe_info_typ * cl_typ * cl_typ
+type coercion = coe_typ * strength * bool * cl_typ * cl_typ * int
+
+(* Calcul de l'arité d'une classe *)
 
-let cache_coercion (_,(coe,xf,cls,clt)) =
+let reference_arity_length ref =
+  let t = Global.type_of_global ref in
+  List.length (fst (Reductionops.splay_arity (Global.env()) Evd.empty t))
+
+let class_params = function
+  | CL_FUN | CL_SORT -> 0
+  | CL_CONST sp -> reference_arity_length (ConstRef sp)
+  | CL_SECVAR sp -> reference_arity_length (VarRef sp)
+  | CL_IND sp  -> reference_arity_length (IndRef sp)
+
+(* add_class : cl_typ -> strength option -> bool -> unit *)
+
+let add_class cl =
+  add_new_class cl { cl_param = class_params cl }
+
+let load_coercion i (_,(coe,stre,isid,cls,clt,ps)) =
+  add_class cls;
+  add_class clt;
   let is,_ = class_info cls in
   let it,_ = class_info clt in
+  let xf = 
+    { coe_value = constr_of_global coe;
+      coe_type = Global.type_of_global coe;
+      coe_strength = stre;
+      coe_is_identity = isid;
+      coe_param = ps } in
   add_new_coercion coe xf;
   add_coercion_in_graph (xf,is,it)
 
-let subst_coercion (_,subst,(coe,xf,cls,clt as obj)) =
+let cache_coercion o =
+  load_coercion 1 o
+
+let subst_coercion (_,subst,(coe,stre,isid,cls,clt,ps as obj)) =
   let coe' = subst_coe_typ subst coe in
-  let xf' = subst_coe_info subst xf in
   let cls' = subst_cl_typ subst cls in
   let clt' = subst_cl_typ subst clt in
-    if coe' == coe && xf' == xf && cls' == cls & clt' == clt then obj else
-      (coe',xf',cls',clt')
-      
-    
-(* val inCoercion : coercion -> Libobject.object 
-   val outCoercion : Libobject.object -> coercion *)
+    if coe' == coe && cls' == cls & clt' == clt then obj else
+      (coe',stre,isid,cls',clt',ps)
+
+let discharge_cl = function
+  | CL_CONST kn -> CL_CONST (Lib.discharge_con kn)
+  | CL_IND ind -> CL_IND (Lib.discharge_inductive ind)
+  | cl -> cl
+
+let discharge_coercion (_,(coe,stre,isid,cls,clt,ps)) =
+  if stre = Local then None else 
+    let n = try Array.length (Lib.section_instance coe) with Not_found -> 0 in
+    Some (Lib.discharge_global coe,
+          stre,
+	  isid,
+          discharge_cl cls,
+	  discharge_cl clt,
+          n + ps)
 
 let (inCoercion,outCoercion) =
   declare_object {(default_object "COERCION") with 
-		    load_function = (fun _ o -> cache_coercion o);
-                    cache_function = cache_coercion;
-		    subst_function = subst_coercion;
-		    classify_function = (fun (_,x) -> Substitute x); 
-                    export_function = (function x -> Some x)  }
-
-let declare_coercion coef v stre ~isid ~src:cls ~target:clt ~params:ps =
-  Lib.add_anonymous_leaf
-    (inCoercion
-       (coef,
-	 { coe_value = v;
-	   coe_strength = stre;
-	   coe_is_identity = isid;
-	   coe_param = ps },
-	cls, clt))
+    load_function = load_coercion;
+    cache_function = cache_coercion;
+    subst_function = subst_coercion;
+    classify_function = (fun (_,x) -> Substitute x);
+    discharge_function = discharge_coercion;
+    export_function = (function x -> Some x)  }
+
+let declare_coercion coef stre ~isid ~src:cls ~target:clt ~params:ps =
+  Lib.add_anonymous_leaf (inCoercion (coef,stre,isid,cls,clt,ps))
 
 let coercion_strength v = v.coe_strength
 let coercion_identity v = v.coe_is_identity
 
 (* For printing purpose *)
-let get_coercion_value v = v.coe_value.uj_val
+let get_coercion_value v = v.coe_value
 
 let classes () = Bijint.dom !class_tab
 let coercions () = Gmap.rng !coercion_tab
diff --git a/pretyping/classops.mli b/pretyping/classops.mli
index f846a9e5..276b14d1 100644
--- a/pretyping/classops.mli
+++ b/pretyping/classops.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: classops.mli,v 1.30.2.1 2004/07/16 19:30:44 herbelin Exp $ i*)
+(*i $Id: classops.mli 6748 2005-02-18 22:17:50Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -15,6 +15,7 @@ open Term
 open Evd
 open Environ
 open Nametab
+open Mod_subst
 (*i*)
 
 (*s This is the type of class kinds *)
@@ -29,7 +30,6 @@ val subst_cl_typ : substitution -> cl_typ -> cl_typ
 
 (* This is the type of infos for declared classes *)
 type cl_info_typ = {
-  cl_strength : strength;
   cl_param : int }
 
 (* This is the type of coercion kinds *)
@@ -47,9 +47,6 @@ type coe_index
 (* This is the type of paths from a class to another *)
 type inheritance_path = coe_index list
 
-(*s [declare_class] adds a class to the set of declared classes *)
-val declare_class : cl_typ * strength * int -> unit
-
 (*s Access to classes infos *)
 val class_info : cl_typ -> (cl_index * cl_info_typ)
 val class_exists : cl_typ -> bool
@@ -69,7 +66,7 @@ val class_args_of : constr -> constr list
 
 (*s [declare_coercion] adds a coercion in the graph of coercion paths *)
 val declare_coercion : 
-  coe_typ -> unsafe_judgment -> strength -> isid:bool ->
+  coe_typ -> strength -> isid:bool ->
       src:cl_typ -> target:cl_typ -> params:int -> unit
 
 (*s Access to coercions infos *)
@@ -84,19 +81,6 @@ val lookup_path_to_sort_from : cl_index -> inheritance_path
 val lookup_pattern_path_between :
   cl_index * cl_index -> (constructor * int) list
 
-(*i Pour le discharge *)
-type coercion = coe_typ * coe_info_typ * cl_typ * cl_typ
-
-open Libobject
-val inClass : (cl_typ * cl_info_typ) -> Libobject.obj
-val outClass : Libobject.obj -> (cl_typ * cl_info_typ)
-val inCoercion : coercion -> Libobject.obj
-val outCoercion : Libobject.obj -> coercion
-val coercion_strength : coe_info_typ -> strength
-val coercion_identity : coe_info_typ -> bool
-val coercion_params : coe_info_typ -> int
-(*i*)
-
 (*i Crade *)
 open Pp
 val install_path_printer : 
diff --git a/pretyping/clenv.ml b/pretyping/clenv.ml
new file mode 100644
index 00000000..0b88b14b
--- /dev/null
+++ b/pretyping/clenv.ml
@@ -0,0 +1,435 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: clenv.ml 8688 2006-04-07 15:08:12Z msozeau $ *)
+
+open Pp
+open Util
+open Names
+open Nameops
+open Term
+open Termops
+open Sign
+open Environ
+open Evd
+open Reduction
+open Reductionops
+open Rawterm
+open Pattern
+open Tacexpr
+open Tacred
+open Pretype_errors
+open Evarutil
+open Unification
+open Mod_subst
+
+(* *)
+let w_coerce env c ctyp target evd =
+  let j = make_judge c ctyp in
+  let (evd',j') = Coercion.Default.inh_conv_coerce_to dummy_loc env evd j (mk_tycon_type target) in
+  (evd',j'.uj_val)
+
+let pf_env gls = Global.env_of_context gls.it.evar_hyps
+let pf_type_of gls c  = Typing.type_of (pf_env gls) gls.sigma c
+let pf_hnf_constr gls c = hnf_constr (pf_env gls) gls.sigma c
+let pf_concl gl = gl.it.evar_concl
+
+(******************************************************************)
+(* Clausal environments *)
+
+type clausenv = {
+  templenv : env;
+  env      : evar_defs;
+  templval : constr freelisted;
+  templtyp : constr freelisted }
+
+let cl_env ce = ce.templenv
+let cl_sigma ce = evars_of ce.env
+
+let subst_clenv sub clenv = 
+  { templval = map_fl (subst_mps sub) clenv.templval;
+    templtyp = map_fl (subst_mps sub) clenv.templtyp;
+    env = subst_evar_defs sub clenv.env;
+    templenv = clenv.templenv }
+
+let clenv_nf_meta clenv c = nf_meta clenv.env c
+let clenv_meta_type clenv mv = Typing.meta_type clenv.env mv
+let clenv_value clenv = meta_instance clenv.env clenv.templval
+let clenv_type clenv = meta_instance clenv.env clenv.templtyp
+
+
+let clenv_hnf_constr ce t = hnf_constr (cl_env ce) (cl_sigma ce) t
+
+let clenv_get_type_of ce c =
+  let metamap =
+    List.map 
+      (function
+	 | (n,Clval(_,_,typ)) -> (n,typ.rebus)
+         | (n,Cltyp (_,typ))    -> (n,typ.rebus))
+      (meta_list ce.env) in
+  Retyping.get_type_of_with_meta (cl_env ce) (cl_sigma ce) metamap c
+
+let clenv_environments evd bound c =
+  let rec clrec (e,metas) n c =
+    match n, kind_of_term c with
+      | (Some 0, _) -> (e, List.rev metas, c)
+      | (n, Cast (c,_,_)) -> clrec (e,metas) n c
+      | (n, Prod (na,c1,c2)) ->
+	  let mv = new_meta () in
+	  let dep = dependent (mkRel 1) c2 in
+	  let na' = if dep then na else Anonymous in
+	  let e' = meta_declare mv c1 ~name:na' e in
+	  clrec (e', (mkMeta mv)::metas) (option_app ((+) (-1)) n)
+	    (if dep then (subst1 (mkMeta mv) c2) else c2)
+      | (n, LetIn (na,b,_,c)) ->
+	  clrec (e,metas) (option_app ((+) (-1)) n) (subst1 b c)
+      | (n, _) -> (e, List.rev metas, c)
+  in 
+  clrec (evd,[]) bound c
+
+let clenv_environments_evars env evd bound c =
+  let rec clrec (e,ts) n c =
+    match n, kind_of_term c with
+      | (Some 0, _) -> (e, List.rev ts, c)
+      | (n, Cast (c,_,_)) -> clrec (e,ts) n c
+      | (n, Prod (na,c1,c2)) ->
+          let e',constr = Evarutil.new_evar e env c1 in
+	  let dep = dependent (mkRel 1) c2 in
+	  clrec (e', constr::ts) (option_app ((+) (-1)) n)
+	    (if dep then (subst1 constr c2) else c2)
+      | (n, LetIn (na,b,_,c)) ->
+	  clrec (e,ts) (option_app ((+) (-1)) n) (subst1 b c)
+      | (n, _) -> (e, List.rev ts, c)
+  in 
+  clrec (evd,[]) bound c
+
+let mk_clenv_from_n gls n (c,cty) =
+  let evd = create_evar_defs gls.sigma in
+  let (env,args,concl) = clenv_environments evd n cty in
+  { templval = mk_freelisted (match args with [] -> c | _ -> applist (c,args));
+    templtyp = mk_freelisted concl;
+    env = env;
+    templenv = Global.env_of_context gls.it.evar_hyps }
+
+let mk_clenv_from gls = mk_clenv_from_n gls None
+
+let mk_clenv_rename_from gls (c,t) = 
+  mk_clenv_from gls (c,rename_bound_var (pf_env gls) [] t)
+
+let mk_clenv_rename_from_n gls n (c,t) = 
+  mk_clenv_from_n gls n (c,rename_bound_var (pf_env gls) [] t)
+
+let mk_clenv_type_of gls t = mk_clenv_from gls (t,pf_type_of gls t)
+
+(******************************************************************)
+
+(* [mentions clenv mv0 mv1] is true if mv1 is defined and mentions
+ * mv0, or if one of the free vars on mv1's freelist mentions
+ * mv0 *)
+
+let mentions clenv mv0 =
+  let rec menrec mv1 =
+    mv0 = mv1 ||
+    let mlist =
+      try (meta_fvalue clenv.env mv1).freemetas
+      with Anomaly _ | Not_found -> Metaset.empty in
+    meta_exists menrec mlist
+  in menrec
+
+let clenv_defined clenv mv = meta_defined clenv.env mv
+
+let error_incompatible_inst clenv mv  =
+  let na = meta_name clenv.env mv in
+  match na with
+      Name id ->
+        errorlabstrm "clenv_assign"
+          (str "An incompatible instantiation has already been found for " ++ 
+           pr_id id)
+    | _ ->
+        anomaly "clenv_assign: non dependent metavar already assigned"
+
+(* TODO: replace by clenv_unify (mkMeta mv) rhs ? *)		      
+let clenv_assign mv rhs clenv =
+  let rhs_fls = mk_freelisted rhs in 
+  if meta_exists (mentions clenv mv) rhs_fls.freemetas then
+    error "clenv_assign: circularity in unification";
+  try
+    if meta_defined clenv.env mv then
+      if not (eq_constr (meta_fvalue clenv.env mv).rebus rhs) then
+        error_incompatible_inst clenv mv
+      else
+	clenv
+    else {clenv with env = meta_assign mv rhs_fls.rebus clenv.env}
+  with Not_found -> 
+    error "clenv_assign: undefined meta"
+
+
+let clenv_wtactic f clenv = {clenv with env = f clenv.env }
+
+
+(* [clenv_dependent hyps_only clenv]
+ * returns a list of the metavars which appear in the template of clenv,
+ * and which are dependent, This is computed by taking the metavars in cval,
+ * in right-to-left order, and collecting the metavars which appear
+ * in their types, and adding in all the metavars appearing in the
+ * type of clenv.
+ * If [hyps_only] then metavariables occurring in the type are _excluded_ *)
+
+(* collects all metavar occurences, in left-to-right order, preserving
+ * repetitions and all. *)
+
+let collect_metas c = 
+  let rec collrec acc c =
+    match kind_of_term c with
+      | Meta mv -> mv::acc
+      | _         -> fold_constr collrec acc c
+  in
+  List.rev (collrec [] c)
+
+(* [clenv_metavars clenv mv]
+ * returns a list of the metavars which appear in the type of
+ * the metavar mv.  The list is unordered. *)
+
+let clenv_metavars clenv mv = (meta_ftype clenv mv).freemetas
+
+let dependent_metas clenv mvs conclmetas =
+  List.fold_right
+    (fun mv deps ->
+       Metaset.union deps (clenv_metavars clenv.env mv))
+    mvs conclmetas
+
+let clenv_dependent hyps_only clenv =
+  let mvs = collect_metas (clenv_value clenv) in
+  let ctyp_mvs = (mk_freelisted (clenv_type clenv)).freemetas in
+  let deps = dependent_metas clenv mvs ctyp_mvs in
+  List.filter
+    (fun mv -> Metaset.mem mv deps &&
+               not (hyps_only && Metaset.mem mv ctyp_mvs))
+    mvs
+
+let clenv_missing ce = clenv_dependent true ce
+
+(******************************************************************)
+
+let clenv_unify allow_K cv_pb t1 t2 clenv =
+  { clenv with env = w_unify allow_K clenv.templenv cv_pb t1 t2 clenv.env }
+
+let clenv_unique_resolver allow_K clause gl =
+  clenv_unify allow_K CUMUL (clenv_type clause) (pf_concl gl) clause 
+
+
+(* [clenv_pose_dependent_evars clenv]
+ * For each dependent evar in the clause-env which does not have a value,
+ * pose a value for it by constructing a fresh evar.  We do this in
+ * left-to-right order, so that every evar's type is always closed w.r.t.
+ * metas. *)
+let clenv_pose_dependent_evars clenv =
+  let dep_mvs = clenv_dependent false clenv in
+  List.fold_left
+    (fun clenv mv ->
+      let ty = clenv_meta_type clenv mv in
+      let (evd,evar) = new_evar clenv.env (cl_env clenv) ty in
+      clenv_assign mv evar {clenv with env=evd})
+    clenv
+    dep_mvs
+
+let evar_clenv_unique_resolver clenv gls =
+  clenv_pose_dependent_evars (clenv_unique_resolver false clenv gls)
+
+
+(******************************************************************)
+
+let connect_clenv gls clenv =
+  { clenv with
+    env = evars_reset_evd gls.sigma clenv.env;
+    templenv = Global.env_of_context gls.it.evar_hyps }
+
+(* [clenv_fchain mv clenv clenv']
+ *
+ * Resolves the value of "mv" (which must be undefined) in clenv to be
+ * the template of clenv' be the value "c", applied to "n" fresh
+ * metavars, whose types are chosen by destructing "clf", which should
+ * be a clausale forme generated from the type of "c".  The process of
+ * 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.  *)
+let clenv_fchain mv clenv nextclenv =
+  (* Add the metavars of [nextclenv] to [clenv], with their name-environment *)
+  let clenv' =
+    { templval = clenv.templval;
+      templtyp = clenv.templtyp;
+      env = meta_merge clenv.env nextclenv.env;
+      templenv = nextclenv.templenv } in
+  (* unify the type of the template of [nextclenv] with the type of [mv] *)
+  let clenv'' =
+    clenv_unify true CUMUL
+      (clenv_nf_meta clenv' nextclenv.templtyp.rebus)
+      (clenv_meta_type clenv' mv)
+      clenv' in
+  (* assign the metavar *)
+  let clenv''' =
+    clenv_assign mv (clenv_nf_meta clenv' nextclenv.templval.rebus) clenv''
+  in 
+  clenv'''
+
+(***************************************************************)
+(* Bindings *)
+
+type arg_bindings = (int * constr) list
+
+(* [clenv_independent clenv]
+ * returns a list of metavariables which appear in the term cval,
+ * and which are not dependent.  That is, they do not appear in
+ * the types of other metavars which are in cval, nor in the type
+ * of cval, ctyp. *)
+
+let clenv_independent clenv =
+  let mvs = collect_metas (clenv_value clenv) in
+  let ctyp_mvs = (mk_freelisted (clenv_type clenv)).freemetas in
+  let deps = dependent_metas clenv mvs ctyp_mvs in
+  List.filter (fun mv -> not (Metaset.mem mv deps)) mvs
+
+let meta_of_binder clause loc b t mvs =
+  match b with
+    | NamedHyp s ->
+	if List.exists (fun (_,b',_) -> b=b') t then 
+	  errorlabstrm "clenv_match_args" 
+	    (str "The variable " ++ pr_id s ++ 
+	     str " occurs more than once in binding");
+        meta_with_name clause.env s
+    | AnonHyp n ->
+	if List.exists (fun (_,b',_) -> b=b') t then
+	  errorlabstrm "clenv_match_args"
+	    (str "The position " ++ int n ++
+	    str " occurs more than once in binding");
+	try List.nth mvs (n-1)
+	with (Failure _|Invalid_argument _) ->
+          errorlabstrm "clenv_match_args" (str "No such binder")
+
+let error_already_defined b =
+  match b with
+      NamedHyp id ->
+        errorlabstrm "clenv_match_args"
+          (str "Binder name \"" ++ pr_id id ++
+           str"\" already defined with incompatible value")
+    | AnonHyp n ->
+        anomalylabstrm "clenv_match_args"
+          (str "Position " ++ int n ++ str" already defined")
+
+let clenv_match_args s clause =
+  let mvs = clenv_independent clause in 
+  let rec matchrec clause = function
+    | [] -> clause
+    | (loc,b,c)::t ->
+	let k = meta_of_binder clause loc b t mvs in
+        if meta_defined clause.env k then
+          if eq_constr (meta_fvalue clause.env k).rebus c then
+            matchrec clause t
+          else error_already_defined b
+        else
+	  let k_typ = clenv_hnf_constr clause (clenv_meta_type clause k)
+	    (* nf_betaiota was before in type_of - useful to reduce
+               types like (x:A)([x]P u) *)
+	  and c_typ =
+            clenv_hnf_constr clause
+              (nf_betaiota (clenv_get_type_of clause c)) in
+	  let cl =
+	    (* Try to infer some Meta/Evar from the type of [c] *)
+	    try clenv_assign k c (clenv_unify true CUMUL c_typ k_typ clause)
+	    with e when precatchable_exception e ->
+	      (* Try to coerce to the type of [k]; cannot merge with the
+	         previous case because Coercion does not handle Meta *)
+              let (_,c') = w_coerce (cl_env clause) c c_typ k_typ clause.env in
+	      try clenv_unify true CONV (mkMeta k) c' clause
+	      with PretypeError (env,CannotUnify (m,n)) ->
+	        Stdpp.raise_with_loc loc
+ 	          (PretypeError (env,CannotUnifyBindingType (m,n)))
+	  in matchrec cl t
+  in 
+  matchrec clause s
+
+
+let clenv_constrain_with_bindings bl clause =
+  if bl = [] then 
+    clause 
+  else 
+    let all_mvs = collect_metas clause.templval.rebus in
+    let rec matchrec clause = function
+      | []       -> clause
+      | (n,c)::t ->
+          let k = 
+            (try
+              if n > 0 then 
+		List.nth all_mvs (n-1)
+              else if n < 0 then 
+		List.nth (List.rev all_mvs) (-n-1)
+              else error "clenv_constrain_with_bindings" 
+            with Failure _ ->
+              errorlabstrm "clenv_constrain_with_bindings"
+                (str"Clause did not have " ++ int n ++ str"-th" ++
+                str" absolute argument")) in
+	  let k_typ = nf_betaiota (clenv_meta_type clause k) in
+	  let c_typ = nf_betaiota (clenv_get_type_of clause c) in 
+	  matchrec
+            (clenv_assign k c (clenv_unify true CUMUL c_typ k_typ clause)) t
+    in 
+    matchrec clause bl
+
+
+(* not exported: maybe useful ? *)
+let clenv_constrain_dep_args hyps_only clause = function
+  | [] -> clause 
+  | mlist ->
+      let occlist = clenv_dependent hyps_only clause in
+      if List.length occlist = List.length mlist then
+	List.fold_left2
+          (fun clenv k c ->
+	    try
+	      let k_typ =
+                clenv_hnf_constr clause (clenv_meta_type clause k) in
+	      let c_typ =
+                clenv_hnf_constr clause (clenv_get_type_of clause c) in
+              (* faire quelque chose avec le sigma retourne ? *)
+	      let (_,c') = w_coerce (cl_env clenv) c c_typ k_typ clenv.env in
+	      clenv_unify true CONV (mkMeta k) c' clenv
+	    with _ ->
+              clenv_unify true CONV (mkMeta k) c clenv)
+          clause occlist mlist
+      else 
+	error ("Not the right number of missing arguments (expected "
+	       ^(string_of_int (List.length occlist))^")")
+
+let clenv_constrain_missing_args mlist clause =
+  clenv_constrain_dep_args true clause mlist
+
+
+(****************************************************************)
+(* Clausal environment for an application *)
+
+let make_clenv_binding_gen 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
+  | 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
+
+(****************************************************************)
+(* Pretty-print *)
+
+let pr_clenv clenv =
+  h 0
+    (str"TEMPL: " ++ print_constr clenv.templval.rebus ++
+     str" : " ++ print_constr clenv.templtyp.rebus ++ fnl () ++
+     pr_evar_defs clenv.env)
diff --git a/pretyping/clenv.mli b/pretyping/clenv.mli
new file mode 100644
index 00000000..f585dfea
--- /dev/null
+++ b/pretyping/clenv.mli
@@ -0,0 +1,117 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(*i $Id: clenv.mli 7659 2005-12-17 21:07:17Z herbelin $ i*)
+
+(*i*)
+open Util
+open Names
+open Term
+open Sign
+open Environ
+open Evd
+open Evarutil
+open Mod_subst
+(*i*)
+
+(***************************************************************)
+(* The Type of Constructions clausale environments. *)
+
+(* [templenv] is the typing context
+ * [env] is the mapping from metavar and evar numbers to their types
+ *       and values.
+ * [templval] is the template which we are trying to fill out.
+ * [templtyp] is its type.
+ * [namenv] is a mapping from metavar numbers to names, for
+ *          use in instantiating metavars by name.
+ *)
+type clausenv = {
+  templenv : env;
+  env      : evar_defs;
+  templval : constr freelisted;
+  templtyp : constr freelisted }
+
+(* Substitution is not applied on templenv (because [subst_clenv] is
+   applied only on hints which typing env is overwritten by the
+   goal env) *)
+val subst_clenv : substitution -> clausenv -> clausenv
+
+(* subject of clenv (instantiated) *)
+val clenv_value     : clausenv -> constr
+(* type of clenv (instantiated) *)
+val clenv_type      : clausenv -> types
+(* substitute resolved metas *)
+val clenv_nf_meta   : clausenv -> constr -> constr
+(* type of a meta in clenv context *)
+val clenv_meta_type : clausenv -> metavariable -> types
+
+val mk_clenv_from : evar_info sigma -> constr * types -> clausenv
+val mk_clenv_from_n :
+  evar_info sigma -> int option -> constr * types -> clausenv
+val mk_clenv_rename_from : evar_info sigma -> constr * types -> clausenv
+val mk_clenv_rename_from_n :
+  evar_info sigma -> int option -> constr * types -> clausenv
+val mk_clenv_type_of : evar_info sigma -> constr -> clausenv
+
+(***************************************************************)
+(* linking of clenvs *)
+
+val connect_clenv : evar_info sigma -> clausenv -> clausenv
+val clenv_fchain : metavariable -> clausenv -> clausenv -> clausenv
+
+(***************************************************************)
+(* Unification with clenvs *)
+
+(* Unifies two terms in a clenv. The boolean is [allow_K] (see [Unification]) *)
+val clenv_unify : 
+  bool -> conv_pb -> constr -> constr -> clausenv -> clausenv
+
+(* unifies the concl of the goal with the type of the clenv *)
+val clenv_unique_resolver :
+  bool -> clausenv -> evar_info sigma -> clausenv
+
+(* same as above ([allow_K=false]) but replaces remaining metas
+   with fresh evars *)
+val evar_clenv_unique_resolver :
+  clausenv -> evar_info sigma -> clausenv
+
+(***************************************************************)
+(* Bindings *)
+
+(* bindings where the key is the position in the template of the
+   clenv (dependent or not). Positions can be negative meaning to
+   start from the rightmost argument of the template. *)
+type arg_bindings = (int * constr) list
+
+val clenv_independent : clausenv -> metavariable list
+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
+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 *)
+val make_clenv_binding_apply :
+  evar_info sigma -> int -> constr * constr -> constr Rawterm.bindings ->
+   clausenv
+val make_clenv_binding :
+  evar_info sigma -> constr * constr -> constr Rawterm.bindings -> clausenv
+
+(* other stuff *)
+val clenv_environments :
+ evar_defs -> int option -> types -> evar_defs * constr list * types
+val clenv_environments_evars :
+ env -> evar_defs -> int option -> types -> evar_defs * constr list * types
+
+(***************************************************************)
+(* Pretty-print *)
+val pr_clenv : clausenv -> Pp.std_ppcmds
+
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml
index be78eb2c..e01dac47 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,v 1.38.6.2 2005/11/29 21:40:52 letouzey Exp $ *)
+(* $Id: coercion.ml 8695 2006-04-10 16:33:52Z msozeau $ *)
 
 open Util
 open Names
@@ -19,189 +19,248 @@ open Recordops
 open Evarutil
 open Evarconv
 open Retyping
+open Evd
 
-(* Typing operations dealing with coercions *)
-
-let class_of1 env sigma t = class_of env sigma (nf_evar sigma t)
-
-(* Here, funj is a coercion therefore already typed in global context *)
-let apply_coercion_args env argl funj =
-  let rec apply_rec acc typ = function
-    | [] -> { uj_val = applist (j_val funj,argl);
-              uj_type = typ }
-    | h::restl ->
-    (* On devrait pouvoir s'arranger pour qu'on n'ait pas à faire hnf_constr *)
-  	match kind_of_term (whd_betadeltaiota env Evd.empty typ) with
-	  | Prod (_,c1,c2) -> 
-              (* Typage garanti par l'appel à app_coercion*)
-	      apply_rec (h::acc) (subst1 h c2) restl
-	  | _ -> anomaly "apply_coercion_args"
-  in 
-  apply_rec [] funj.uj_type argl
-
-exception NoCoercion
-
-(* appliquer le chemin de coercions de patterns p *)
-
-let apply_pattern_coercion loc pat p =
-  List.fold_left
-    (fun pat (co,n) ->
-       let f i = if i<n then Rawterm.PatVar (loc, Anonymous) else pat in
-       Rawterm.PatCstr (loc, co, list_tabulate f (n+1), Anonymous))
-    pat p
-
-(* raise Not_found if no coercion found *)
-let inh_pattern_coerce_to loc pat ind1 ind2 =
-  let i1 = inductive_class_of ind1 in
-  let i2 = inductive_class_of ind2 in
-  let p = lookup_pattern_path_between (i1,i2) in
-  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
-           (fun (ja,typ_cl) i -> 
-              let fv,isid = coercion_value i in
-              let argl = (class_args_of typ_cl)@[ja.uj_val] in
-              let jres = apply_coercion_args env argl fv in
-              (if isid then 
-		 { uj_val = ja.uj_val; uj_type = jres.uj_type }
-               else 
-		 jres),
-	      jres.uj_type)
-           (hj,typ_cl) p)
-  with _ -> anomaly "apply_coercion"
-
-let inh_app_fun env isevars j = 
-  let t = whd_betadeltaiota env (evars_of isevars) j.uj_type in
-  match kind_of_term t with
-    | Prod (_,_,_) -> j
-    | Evar ev when not (is_defined_evar isevars ev) ->
-	let t = define_evar_as_arrow isevars ev in
-	{ uj_val = j.uj_val; uj_type = t }
-    | _ ->
-       	(try
- 	   let t,i1 = class_of1 env (evars_of isevars) j.uj_type in
-      	   let p = lookup_path_to_fun_from i1 in
-           apply_coercion env p j t
-	 with Not_found -> j)
-
-let inh_tosort_force env isevars j =
-  try
-    let t,i1 = class_of1 env (evars_of isevars) j.uj_type in
-    let p = lookup_path_to_sort_from i1 in
-    apply_coercion env p j t 
-  with Not_found -> 
-    j
-
-let inh_coerce_to_sort env isevars j =
-  let typ = whd_betadeltaiota env (evars_of isevars) j.uj_type in
-  match kind_of_term typ with
-    | Sort s -> { utj_val = j.uj_val; utj_type = s }
-    | Evar ev when not (is_defined_evar isevars ev) ->
-	let s = define_evar_as_sort isevars ev in
-	{ utj_val = j.uj_val; utj_type = s }
-    | _ ->
-        let j1 = inh_tosort_force env isevars j in 
-	type_judgment env (j_nf_evar (evars_of isevars) j1) 
-
-let inh_coerce_to_fail env isevars c1 hj =
-  let hj' =
-    try 
-      let t1,i1 = class_of1 env (evars_of isevars) c1 in
-      let t2,i2 = class_of1 env (evars_of isevars) hj.uj_type in
-      let p = lookup_path_between (i2,i1) in
-      apply_coercion env p hj t2
-    with Not_found -> raise NoCoercion 
-  in
-  if the_conv_x_leq env isevars hj'.uj_type c1 then 
-    hj'
-  else
-    raise NoCoercion
-
-let rec inh_conv_coerce_to_fail env isevars hj c1 =
-  let {uj_val = v; uj_type = t} = hj in
-  if the_conv_x_leq env isevars t c1 then hj
-  else 
-    try 
-      inh_coerce_to_fail env isevars c1 hj
-    with NoCoercion ->  (* try ... with _ -> ... is BAD *)
-      (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' = whd_betadeltaiota env (evars_of isevars) v in
-             if (match kind_of_term v' with
-                   | Lambda (_,v1,v2) ->
-                       the_conv_x env isevars v1 u1 (* leq v1 u1? *)
-                   | _  -> false)
-             then 
-	       let (x,v1,v2) = destLambda v' in
-               let env1 = push_rel (x,None,v1) env in
-               let h2 = inh_conv_coerce_to_fail env1 isevars 
-			  {uj_val = v2; uj_type = t2 } u2 in
-               { uj_val = mkLambda (x, v1, h2.uj_val);
-                 uj_type = mkProd (x, v1, h2.uj_type) }
-             else 
-               (* 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 h1 =
-		 inh_conv_coerce_to_fail env1 isevars
-		   {uj_val = mkRel 1; uj_type = (lift 1 u1) }
-                   (lift 1 t1) in
-               let h2 = inh_conv_coerce_to_fail env1 isevars
-			 { uj_val = mkApp (lift 1 v, [|h1.uj_val|]);
-                           uj_type = subst1 h1.uj_val t2 }
-                          u2
-	       in
-               { uj_val = mkLambda (name, u1, h2.uj_val);
-                 uj_type = mkProd (name, u1, h2.uj_type) }
-	 | _ -> 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 t =
-  let cj' = 
+module type S = sig
+  (*s Coercions. *)
+  
+  (* [inh_app_fun env isevars j] coerces [j] to a function; i.e. it
+     inserts a coercion into [j], if needed, in such a way it gets as
+     type a product; it returns [j] if no coercion is applicable *)
+  val inh_app_fun :
+    env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_judgment
+    
+  (* [inh_coerce_to_sort env isevars j] coerces [j] to a type; i.e. it
+     inserts a coercion into [j], if needed, in such a way it gets as
+     type a sort; it fails if no coercion is applicable *)
+  val inh_coerce_to_sort : loc ->
+    env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_type_judgment
+    
+  (* [inh_conv_coerce_to loc env isevars j t] coerces [j] to an object of type 
+     [t]; i.e. it inserts a coercion into [j], if needed, in such a way [t] and
+     [j.uj_type] are convertible; it fails if no coercion is applicable *)
+  val inh_conv_coerce_to : loc -> 
+    env -> evar_defs -> unsafe_judgment -> type_constraint_type -> evar_defs * unsafe_judgment
+    
+
+  (* [inh_conv_coerces_to loc env isevars t t'] checks if an object of type [t]
+     is coercible to an object of type [t'] adding evar constraints if needed;
+     it fails if no coercion exists *)
+  val inh_conv_coerces_to : loc -> 
+    env -> evar_defs -> types -> type_constraint_type -> evar_defs
+
+  (* [inh_pattern_coerce_to loc env isevars pat ind1 ind2] coerces the Cases
+     pattern [pat] typed in [ind1] into a pattern typed in [ind2];
+     raises [Not_found] if no coercion found *)
+  val inh_pattern_coerce_to :
+    loc  -> Rawterm.cases_pattern -> inductive -> inductive -> Rawterm.cases_pattern
+end
+
+module Default = struct
+  (* Typing operations dealing with coercions *)
+  exception NoCoercion
+
+  let class_of1 env sigma t = class_of env sigma (nf_evar sigma t)
+
+  (* Here, funj is a coercion therefore already typed in global context *)
+  let apply_coercion_args env argl funj =
+    let rec apply_rec acc typ = function
+      | [] -> { uj_val = applist (j_val funj,argl);
+		uj_type = typ }
+      | h::restl ->
+	  (* On devrait pouvoir s'arranger pour qu'on n'ait pas à faire hnf_constr *)
+  	  match kind_of_term (whd_betadeltaiota env Evd.empty typ) with
+	    | Prod (_,c1,c2) -> 
+		(* Typage garanti par l'appel à app_coercion*)
+		apply_rec (h::acc) (subst1 h c2) restl
+	    | _ -> anomaly "apply_coercion_args"
+    in 
+      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) ->
+	 let f i = if i<n then Rawterm.PatVar (loc, Anonymous) else pat in
+	   Rawterm.PatCstr (loc, co, list_tabulate f (n+1), Anonymous))
+      pat p
+
+  (* raise Not_found if no coercion found *)
+  let inh_pattern_coerce_to loc pat ind1 ind2 =
+    let i1 = inductive_class_of ind1 in
+    let i2 = inductive_class_of ind2 in
+    let p = lookup_pattern_path_between (i1,i2) in
+      apply_pattern_coercion loc pat p
+
+  (* appliquer le chemin de coercions p à hj *)
+
+  let apply_coercion env p hj typ_cl =
     try 
-      inh_conv_coerce_to_fail env isevars cj t
-    with NoCoercion ->
-      let sigma = evars_of isevars in
-      error_actual_type_loc loc env sigma cj t
-  in
-  { uj_val = cj'.uj_val; uj_type = t }
-
-(* [inh_apply_rel_list loc env isevars args f tycon] tries to type [(f
-   args)] of type [tycon] (if any) by inserting coercions in front of
-   each arg$_i$, if necessary *)
-
-let inh_apply_rel_list apploc env isevars argjl (funloc,funj) tycon =
-  let rec apply_rec env n resj = function
-    | [] -> resj
-    | (loc,hj)::restjl ->
-        let sigma = evars_of isevars in
-	let resj = inh_app_fun env isevars resj in
-        let ntyp = whd_betadeltaiota env sigma resj.uj_type in
-      	match kind_of_term ntyp with
-          | Prod (na,c1,c2) ->
-              let hj' =
+      fst (List.fold_left
+             (fun (ja,typ_cl) i -> 
+		let fv,isid = coercion_value i in
+		let argl = (class_args_of typ_cl)@[ja.uj_val] in
+		let jres = apply_coercion_args env argl fv in
+		  (if isid then 
+		     { uj_val = ja.uj_val; uj_type = jres.uj_type }
+		   else 
+		     jres),
+		jres.uj_type)
+             (hj,typ_cl) p)
+    with _ -> anomaly "apply_coercion"
+
+  let inh_app_fun env isevars j = 
+    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) ->
+	    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 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 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))
+    with Not_found ->
+      error_not_a_type_loc loc env (evars_of isevars) j
+
+  let inh_coerce_to_sort loc env isevars j =
+    let typ = whd_betadeltaiota env (evars_of isevars) j.uj_type in
+      match kind_of_term typ with
+	| Sort s -> (isevars,{ utj_val = j.uj_val; utj_type = s })
+	| Evar ev when not (is_defined_evar isevars ev) ->
+	    let (isevars',s) = define_evar_as_sort isevars ev in
+	      (isevars',{ utj_val = j.uj_val; utj_type = s })
+	| _ ->
+	    inh_tosort_force loc env isevars j
+
+  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 p = lookup_path_between (i2,i1) in
+	  match v with
+	      Some v -> 
+		let j = apply_coercion env p {uj_val = v; uj_type = t} t2 in
+		  Some j.uj_val, j.uj_type
+	    | None -> None, t
+      with Not_found -> raise NoCoercion 
+    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_app (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_app (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_app (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_app (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
+	None ->
+	  let (evd', val', type') = 
+	    try 
+	      inh_conv_coerce_to_fail loc env isevars (Some cj.uj_val) cj.uj_type t
+	    with NoCoercion ->
+	      let sigma = evars_of isevars in
+		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 })
+      | Some (init, cur) -> (isevars, cj)
+      
+    let inh_conv_coerces_to loc env (isevars : evar_defs) t (abs, t') = isevars
+      (* Still problematic, as it changes unification 
+      let nabsinit, nabs = 
+	match abs with
+	    None -> 0, 0
+	  | Some (init, cur) -> init, cur
+      in
+	try 
+	  let (rels, rng) = 
+	    (* a little more effort to get products is needed *) 
+	    try decompose_prod_n nabs t
+	    with _ -> 
+	      if !Options.debug then
+		msg_warning (str "decompose_prod_n failed");
+	      raise (Invalid_argument "Coercion.inh_conv_coerces_to")
+	  in
+	    (* The final range free variables must have been replaced by evars, we accept only that evars
+	       in rng are applied to free vars. *)
+	    if noccur_with_meta 0 (succ nabsinit) rng then (
+	      let env', t, t' = 
+		let env' = List.fold_right (fun (n, t) env -> push_rel (n, None, t) env) rels env in
+		  env', rng, lift nabs t'
+	      in
 		try 
-		  inh_conv_coerce_to_fail env isevars hj c1
+		  pi1 (inh_conv_coerce_to_fail loc env' isevars None t t')
 		with NoCoercion ->
-                  error_cant_apply_bad_type_loc apploc env sigma
-		    (1,c1,hj.uj_type) resj (List.map snd restjl) in
-	      let newresj =
-      		{ uj_val = applist (j_val resj, [j_val hj']);
-		  uj_type = subst1 hj'.uj_val c2 } in
-	      apply_rec (push_rel (na,None,c1) env) (n+1) newresj restjl
-          | _ ->
-              error_cant_apply_not_functional_loc 
-		(join_loc funloc loc) env sigma resj
-                (List.map snd restjl)
-  in 
-  apply_rec env 1 funj argjl
-
+		  isevars) (* Maybe not enough information to unify *)
+	      (*let sigma = evars_of isevars in
+		error_cannot_coerce env' sigma (t, t'))*)
+	    else isevars
+	with Invalid_argument _ -> isevars	  *)
+end
diff --git a/pretyping/coercion.mli b/pretyping/coercion.mli
index 658844eb..f675beff 100644
--- a/pretyping/coercion.mli
+++ b/pretyping/coercion.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coercion.mli,v 1.20.14.2 2004/07/16 19:30:44 herbelin Exp $ i*)
+(*i $Id: coercion.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
 
 (*i*)
 open Util
@@ -19,28 +19,38 @@ open Evarutil
 open Rawterm
 (*i*)
 
-(*s Coercions. *)
+module type S = sig
+  (*s Coercions. *)
+  
+  (* [inh_app_fun env isevars j] coerces [j] to a function; i.e. it
+     inserts a coercion into [j], if needed, in such a way it gets as
+     type a product; it returns [j] if no coercion is applicable *)
+  val inh_app_fun :
+    env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_judgment
+    
+  (* [inh_coerce_to_sort env isevars j] coerces [j] to a type; i.e. it
+     inserts a coercion into [j], if needed, in such a way it gets as
+     type a sort; it fails if no coercion is applicable *)
+  val inh_coerce_to_sort : loc ->
+    env -> evar_defs -> unsafe_judgment -> evar_defs * unsafe_type_judgment
+    
+  (* [inh_conv_coerce_to loc env isevars j t] coerces [j] to an object of type 
+     [t]; i.e. it inserts a coercion into [j], if needed, in such a way [t] and
+     [j.uj_type] are convertible; it fails if no coercion is applicable *)
+  val inh_conv_coerce_to : loc -> 
+    env -> evar_defs -> unsafe_judgment -> type_constraint_type -> evar_defs * unsafe_judgment
 
-(* [inh_app_fun env isevars j] coerces [j] to a function; i.e. it
-   inserts a coercion into [j], if needed, in such a way it gets as
-   type a product; it returns [j] if no coercion is applicable *)
-val inh_app_fun :
-  env -> evar_defs -> unsafe_judgment -> unsafe_judgment
+  (* [inh_conv_coerces_to loc env isevars t t'] checks if an object of type [t]
+     is coercible to an object of type [t'] adding evar constraints if needed;
+     it fails if no coercion exists *)
+  val inh_conv_coerces_to : loc -> 
+    env -> evar_defs -> types -> type_constraint_type -> evar_defs
+   
+  (* [inh_pattern_coerce_to loc env isevars pat ind1 ind2] coerces the Cases
+     pattern [pat] typed in [ind1] into a pattern typed in [ind2];
+     raises [Not_found] if no coercion found *)
+  val inh_pattern_coerce_to :
+    loc  -> cases_pattern -> inductive -> inductive -> cases_pattern
+end
 
-(* [inh_coerce_to_sort env isevars j] coerces [j] to a type; i.e. it
-   inserts a coercion into [j], if needed, in such a way it gets as
-   type a sort; it fails if no coercion is applicable *)
-val inh_coerce_to_sort :
-  env -> evar_defs -> unsafe_judgment -> unsafe_type_judgment
-
-(* [inh_conv_coerce_to loc env isevars j t] coerces [j] to an object of type 
-   [t]; i.e. it inserts a coercion into [j], if needed, in such a way [t] and
-   [j.uj_type] are convertible; it fails if no coercion is applicable *)
-val inh_conv_coerce_to : loc -> 
-  env -> evar_defs -> unsafe_judgment -> constr -> unsafe_judgment
-
-(* [inh_pattern_coerce_to loc env isevars pat ind1 ind2] coerces the Cases
-   pattern [pat] typed in [ind1] into a pattern typed in [ind2];
-   raises [Not_found] if no coercion found *)
-val inh_pattern_coerce_to :
-  loc  -> cases_pattern -> inductive -> inductive -> cases_pattern
+module Default : S
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index 040a185e..3f2aed34 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: detyping.ml,v 1.75.2.5 2005/09/06 14:30:41 herbelin Exp $ *)
+(* $Id: detyping.ml 8624 2006-03-13 17:38:17Z msozeau $ *)
 
 open Pp
 open Util
@@ -23,6 +23,10 @@ open Nameops
 open Termops
 open Libnames
 open Nametab
+open Evd
+open Mod_subst
+
+let dl = dummy_loc
 
 (****************************************************************************)
 (* Tools for printing of Cases                                              *)
@@ -130,11 +134,21 @@ let synthetize_type () = !synth_type_value
 
 let _ = declare_bool_option 
 	  { optsync  = true;
-	    optname  = "synthesizability";
+	    optname  = "pattern matching return type synthesizability";
 	    optkey   = SecondaryTable ("Printing","Synth");
 	    optread  = synthetize_type;
 	    optwrite = (:=) synth_type_value }
 
+let reverse_matching_value = ref true
+let reverse_matching () = !reverse_matching_value
+
+let _ = declare_bool_option 
+	  { optsync  = true;
+	    optname  = "pattern-matching reversibility";
+	    optkey   = SecondaryTable ("Printing","Matching");
+	    optread  = reverse_matching;
+	    optwrite = (:=) reverse_matching_value }
+
 (* Auxiliary function for MutCase printing *)
 (* [computable] tries to tell if the predicate typing the result is inferable*)
 
@@ -175,7 +189,7 @@ let lookup_name_as_renamed env t s =
 	       if id=s then (Some n) 
 	       else lookup avoid' (add_name (Name id) env_names) (n+1) c'
 	   | (Anonymous,avoid')    -> lookup avoid' env_names (n+1) (pop c'))
-    | Cast (c,_) -> lookup avoid env_names n c
+    | Cast (c,_,_) -> lookup avoid env_names n c
     | _ -> None
   in lookup (ids_of_named_context (named_context env)) empty_names_context 1 t
 
@@ -189,10 +203,65 @@ let lookup_index_as_renamed env t n =
 	  (match concrete_name true [] empty_names_context name c' with
              | (Name _,_) -> lookup n (d+1) c'
              | (Anonymous,_) -> if n=1 then Some d else lookup (n-1) (d+1) c')
-    | Cast (c,_) -> lookup n d c
+    | Cast (c,_,_) -> lookup n d c
     | _ -> None
   in lookup n 1 t
 
+(**********************************************************************)
+(* Fragile algorithm to reverse pattern-matching compilation          *)
+
+let update_name na ((_,e),c) =
+  match na with
+  | Name _ when force_wildcard () & noccurn (list_index na e) c ->
+      Anonymous
+  | _ ->
+      na
+
+let rec decomp_branch n nal b (avoid,env as e) c =
+  if n=0 then (List.rev nal,(e,c))
+  else
+    let na,c,f =
+      match kind_of_term (strip_outer_cast c) with
+	| Lambda (na,_,c) -> na,c,concrete_let_name
+	| LetIn (na,_,_,c) -> na,c,concrete_name
+	| _ -> 
+	    Name (id_of_string "x"),(applist (lift 1 c, [mkRel 1])), 
+	    concrete_name in
+    let na',avoid' = f b avoid env na c in
+    decomp_branch (n-1) (na'::nal) b (avoid',add_name na' env) c
+
+let rec build_tree na isgoal e ci cl =
+  let mkpat n rhs pl = PatCstr(dl,(ci.ci_ind,n+1),pl,update_name na rhs) in
+  let cnl = ci.ci_cstr_nargs in
+  List.flatten
+    (list_tabulate (fun i -> contract_branch isgoal e (cnl.(i),mkpat i,cl.(i)))
+       (Array.length cl))
+
+and align_tree nal isgoal (e,c as rhs) = match nal with
+  | [] -> [[],rhs]
+  | na::nal ->
+    match kind_of_term c with
+    | Case (ci,_,c,cl) when c = mkRel (list_index na (snd e)) ->
+	let clauses = build_tree na isgoal e ci cl in
+	List.flatten
+          (List.map (fun (pat,rhs) ->
+	      let lines = align_tree nal isgoal rhs in
+	      List.map (fun (hd,rest) -> pat::hd,rest) lines) 
+	    clauses)
+    | _ ->
+	let pat = PatVar(dl,update_name na rhs) in
+	let mat = align_tree nal isgoal rhs in
+	List.map (fun (hd,rest) -> pat::hd,rest) mat
+
+and contract_branch isgoal e (cn,mkpat,b) =
+  let nal,rhs = decomp_branch cn [] isgoal e b in
+  let mat = align_tree nal isgoal rhs in
+  List.map (fun (hd,rhs) -> (mkpat rhs hd,rhs)) mat
+
+(**********************************************************************)
+(* Transform internal representation of pattern-matching into list of *)
+(* clauses                                                            *)
+
 let is_nondep_branch c n =
   try
     let _,ccl = decompose_lam_n_assum n c in
@@ -208,26 +277,17 @@ let extract_nondep_branches test c b n =
       | _ -> assert false in
   if test c n then Some (strip n b) else None
 
-let detype_case computable detype detype_eqn testdep
-    tenv avoid indsp st p k c bl =
+let detype_case computable detype detype_eqns testdep avoid data p c bl =
+  let (indsp,st,nparams,consnargsl,k) = data in
   let synth_type = synthetize_type () in
   let tomatch = detype c in
-
-  (* Find constructors arity *)
-  let (mib,mip) = Inductive.lookup_mind_specif tenv indsp in
-  let get_consnarg j = 
-    let typi = mis_nf_constructor_type (indsp,mib,mip) (j+1) in
-    let _,t = decompose_prod_n_assum (List.length mip.mind_params_ctxt) typi in
-    List.rev (fst (decompose_prod_assum t)) in
-  let consnargs = Array.init (Array.length mip.mind_consnames) get_consnarg in
-  let consnargsl = Array.map List.length consnargs in
-  let alias, aliastyp, newpred, pred = 
-    if (not !Options.raw_print) & synth_type & computable & bl <> [||] then
-      Anonymous, None, None, None
+  let alias, aliastyp, pred= 
+    if (not !Options.raw_print) & synth_type & computable & Array.length bl<>0 
+    then 
+      Anonymous, None, None
     else
-      let p = option_app detype p in
-      match p with
-        | None -> Anonymous, None, None, None
+      match option_app detype p with
+        | None -> Anonymous, None, None
         | Some p ->
             let decompose_lam k c =
               let rec lamdec_rec l avoid k c =
@@ -237,10 +297,10 @@ let detype_case computable detype detype_eqn testdep
                   | c -> 
                       let x = next_ident_away (id_of_string "x") avoid in
                       lamdec_rec ((Name x)::l) (x::avoid) (k-1)
-                        (let a = RVar (dummy_loc,x) in
+                        (let a = RVar (dl,x) in
                           match c with
                           | RApp (loc,p,l) -> RApp (loc,p,l@[a])
-                          | _ -> (RApp (dummy_loc,c,[a])))
+                          | _ -> (RApp (dl,c,[a])))
               in 
               lamdec_rec [] [] k c in
             let nl,typ = decompose_lam k p in
@@ -250,13 +310,12 @@ let detype_case computable detype detype_eqn testdep
 	    let aliastyp =
 	      if List.for_all ((=) Anonymous) nl then None
 	      else 
-		let pars = list_tabulate (fun _ -> Anonymous) mip.mind_nparams
-		in Some (dummy_loc,indsp,pars@nl) in
-            n, aliastyp, Some typ, Some p
+		let pars = list_tabulate (fun _ -> Anonymous) nparams in
+		Some (dl,indsp,pars@nl) in
+            n, aliastyp, Some typ
   in
   let constructs = Array.init (Array.length bl) (fun i -> (indsp,i+1)) in
-  let eqnv = array_map3 detype_eqn constructs consnargsl bl in
-  let eqnl = Array.to_list eqnv in
+  let eqnl = detype_eqns constructs consnargsl bl in
   let tag =
     try 
       if !Options.raw_print then
@@ -268,12 +327,10 @@ let detype_case computable detype detype_eqn testdep
       else 
 	st
     with Not_found -> st
-  in 
-  if tag = RegularStyle then
-    RCases (dummy_loc,(pred,ref newpred),[tomatch,ref (alias,aliastyp)],eqnl)
-  else
-    let bl' = Array.map detype bl in
-    if not !Options.v7 && tag = LetStyle && aliastyp = None then
+  in
+  match tag with
+  | LetStyle when aliastyp = None -> 
+      let bl' = Array.map detype bl in
       let rec decomp_lam_force n avoid l p =
 	if n = 0 then (List.rev l,p) else
           match p with
@@ -285,91 +342,75 @@ let detype_case computable detype detype_eqn testdep
 		let x = Nameops.next_ident_away (id_of_string "x") avoid in
 		decomp_lam_force (n-1) (x::avoid) (Name x :: l) 
                   (* eta-expansion *)
-                  (let a = RVar (dummy_loc,x) in
+                  (let a = RVar (dl,x) in
                   match p with
                     | RApp (loc,p,l) -> RApp (loc,p,l@[a])
-                    | _ -> (RApp (dummy_loc,p,[a]))) in
+                    | _ -> (RApp (dl,p,[a]))) in
       let (nal,d) = decomp_lam_force consnargsl.(0) avoid [] bl'.(0) in
-      RLetTuple (dummy_loc,nal,(alias,newpred),tomatch,d)
-    else
-    let nondepbrs =
-      array_map3 (extract_nondep_branches testdep) bl bl' consnargsl in
-    if not !Options.v7 && tag = IfStyle && aliastyp = None
-      && array_for_all ((<>) None) nondepbrs then
-      RIf (dummy_loc,tomatch,(alias,newpred),
-           out_some nondepbrs.(0),out_some nondepbrs.(1))
-    else if !Options.v7 then
-      let rec remove_type avoid args c =
-	match c,args with
-          | RLambda (loc,na,t,c), _::args ->
-              let h = RHole (dummy_loc,BinderType na) in
-              RLambda (loc,na,h,remove_type avoid args c)
-          | RLetIn (loc,na,b,c), _::args ->
-              RLetIn (loc,na,b,remove_type avoid args c)
-          | c, (na,None,t)::args ->
-              let id = next_name_away_with_default "x" na avoid in
-              let h = RHole (dummy_loc,BinderType na) in
-              let c = remove_type (id::avoid) args
-		(RApp (dummy_loc,c,[RVar (dummy_loc,id)])) in
-              RLambda (dummy_loc,Name id,h,c)
-          | c, (na,Some b,t)::args ->
-              let h = RHole (dummy_loc,BinderType na) in
-              let avoid = name_fold (fun x l -> x::l) na avoid in
-              RLetIn (dummy_loc,na,h,remove_type avoid args c)
-          | c, [] -> c in
-      let bl' = array_map2 (remove_type avoid) consnargs bl' in
-      ROrderedCase (dummy_loc,tag,pred,tomatch,bl',ref None)
-    else
-      RCases(dummy_loc,(pred,ref newpred),[tomatch,ref (alias,aliastyp)],eqnl)
-
-
-let rec detype tenv avoid env t =
+      RLetTuple (dl,nal,(alias,pred),tomatch,d)
+  | IfStyle when aliastyp = None ->
+      let bl' = Array.map detype bl in
+      let nondepbrs =
+	array_map3 (extract_nondep_branches testdep) bl bl' consnargsl in
+      if array_for_all ((<>) None) nondepbrs then
+	RIf (dl,tomatch,(alias,pred),
+             out_some nondepbrs.(0),out_some nondepbrs.(1))
+      else
+	RCases (dl,pred,[tomatch,(alias,aliastyp)],eqnl)
+  | _ ->
+      RCases (dl,pred,[tomatch,(alias,aliastyp)],eqnl)
+
+(**********************************************************************)
+(* Main detyping function                                             *)
+
+let rec detype isgoal avoid env t =
   match kind_of_term (collapse_appl t) with
     | Rel n ->
       (try match lookup_name_of_rel n env with
-	 | Name id   -> RVar (dummy_loc, id)
+	 | Name id   -> RVar (dl, id)
 	 | Anonymous -> anomaly "detype: index to an anonymous variable"
        with Not_found ->
 	 let s = "_UNBOUND_REL_"^(string_of_int n)
-	 in RVar (dummy_loc, id_of_string s))
+	 in RVar (dl, id_of_string s))
     | Meta n ->
 	(* Meta in constr are not user-parsable and are mapped to Evar *)
-	REvar (dummy_loc, n, None)
+	REvar (dl, n, None)
     | Var id ->
 	(try
-	  let _ = Global.lookup_named id in RRef (dummy_loc, VarRef id)
+	  let _ = Global.lookup_named id in RRef (dl, VarRef id)
 	 with _ ->
-	  RVar (dummy_loc, id))
-    | Sort (Prop c) -> RSort (dummy_loc,RProp c)
-    | Sort (Type u) -> RSort (dummy_loc,RType (Some u))
-    | Cast (c1,c2) ->
-	RCast(dummy_loc,detype tenv avoid env c1,
-              detype tenv avoid env c2)
-    | Prod (na,ty,c) -> detype_binder tenv BProd avoid env na ty c
-    | Lambda (na,ty,c) -> detype_binder tenv BLambda avoid env na ty c
-    | LetIn (na,b,_,c) -> detype_binder tenv BLetIn avoid env na b c
+	  RVar (dl, id))
+    | Sort (Prop c) -> RSort (dl,RProp c)
+    | Sort (Type u) -> RSort (dl,RType (Some u))
+    | Cast (c1,k,c2) ->
+	RCast(dl,detype isgoal avoid env c1, k,
+              detype isgoal avoid env c2)
+    | Prod (na,ty,c) -> detype_binder isgoal BProd avoid env na ty c
+    | Lambda (na,ty,c) -> detype_binder isgoal BLambda avoid env na ty c
+    | LetIn (na,b,_,c) -> detype_binder isgoal BLetIn avoid env na b c
     | App (f,args) ->
-	RApp (dummy_loc,detype tenv avoid env f,
-              array_map_to_list (detype tenv avoid env) args)
-    | Const sp -> RRef (dummy_loc, ConstRef sp)
+	RApp (dl,detype isgoal avoid env f,
+              array_map_to_list (detype isgoal avoid env) args)
+    | Const sp -> RRef (dl, ConstRef sp)
     | Evar (ev,cl) ->
-        REvar (dummy_loc, ev, 
-               Some (List.map (detype tenv avoid env) (Array.to_list cl)))
+        REvar (dl, ev, 
+               Some (List.map (detype isgoal avoid env) (Array.to_list cl)))
     | Ind ind_sp ->
-	RRef (dummy_loc, IndRef ind_sp)
+	RRef (dl, IndRef ind_sp)
     | Construct cstr_sp ->
-	RRef (dummy_loc, ConstructRef cstr_sp)
-    | Case (annot,p,c,bl) ->
-	let comp = computable p (annot.ci_pp_info.ind_nargs) in
-	let ind = annot.ci_ind in
-	let st = annot.ci_pp_info.style in
-	detype_case comp (detype tenv avoid env) (detype_eqn tenv avoid env)
-	  is_nondep_branch
-	  (snd tenv) avoid ind st (Some p) annot.ci_pp_info.ind_nargs c bl
-    | Fix (nvn,recdef) -> detype_fix tenv avoid env nvn recdef
-    | CoFix (n,recdef) -> detype_cofix tenv avoid env n recdef
-
-and detype_fix tenv avoid env (vn,_ as nvn) (names,tys,bodies) =
+	RRef (dl, ConstructRef cstr_sp)
+    | Case (ci,p,c,bl) ->
+	let comp = computable p (ci.ci_pp_info.ind_nargs) in
+	detype_case comp (detype isgoal avoid env)
+	  (detype_eqns isgoal avoid env ci comp)
+	  is_nondep_branch avoid 
+	  (ci.ci_ind,ci.ci_pp_info.style,ci.ci_npar,
+	   ci.ci_cstr_nargs,ci.ci_pp_info.ind_nargs)
+	  (Some p) c bl
+    | Fix (nvn,recdef) -> detype_fix isgoal avoid env nvn recdef
+    | CoFix (n,recdef) -> detype_cofix isgoal avoid env n recdef
+
+and detype_fix isgoal avoid env (vn,_ as nvn) (names,tys,bodies) =
   let def_avoid, def_env, lfi =
     Array.fold_left
       (fun (avoid, env, l) na ->
@@ -378,14 +419,14 @@ and detype_fix tenv avoid env (vn,_ as nvn) (names,tys,bodies) =
       (avoid, env, []) names in
   let n = Array.length tys in
   let v = array_map3
-    (fun c t i -> share_names tenv (i+1) [] def_avoid def_env c (lift n t))
+    (fun c t i -> share_names isgoal (i+1) [] def_avoid def_env c (lift n t))
     bodies tys vn in
-  RRec(dummy_loc,RFix nvn,Array.of_list (List.rev lfi),
+  RRec(dl,RFix (Array.map (fun i -> i, RStructRec) (fst nvn), snd nvn),Array.of_list (List.rev lfi),
        Array.map (fun (bl,_,_) -> bl) v,
        Array.map (fun (_,_,ty) -> ty) v,
        Array.map (fun (_,bd,_) -> bd) v)
 
-and detype_cofix tenv avoid env n (names,tys,bodies) =
+and detype_cofix isgoal avoid env n (names,tys,bodies) =
   let def_avoid, def_env, lfi =
     Array.fold_left
       (fun (avoid, env, l) na ->
@@ -394,19 +435,14 @@ and detype_cofix tenv avoid env n (names,tys,bodies) =
       (avoid, env, []) names in
   let ntys = Array.length tys in
   let v = array_map2
-    (fun c t -> share_names tenv 0 [] def_avoid def_env c (lift ntys t))
+    (fun c t -> share_names isgoal 0 [] def_avoid def_env c (lift ntys t))
     bodies tys in
-  RRec(dummy_loc,RCoFix n,Array.of_list (List.rev lfi),
+  RRec(dl,RCoFix n,Array.of_list (List.rev lfi),
        Array.map (fun (bl,_,_) -> bl) v,
        Array.map (fun (_,_,ty) -> ty) v,
        Array.map (fun (_,bd,_) -> bd) v)
 
-and share_names tenv n l avoid env c t =
-  if !Options.v7 && n=0 then
-    let c = detype tenv avoid env c in
-    let t = detype tenv avoid env t in
-    (List.rev l,c,t)
-  else
+and share_names isgoal n l avoid env c t =
   match kind_of_term c, kind_of_term t with
     (* factorize even when not necessary to have better presentation *)
     | Lambda (na,t,c), Prod (na',t',c') ->
@@ -414,47 +450,57 @@ and share_names tenv n l avoid env c t =
             Name _, _ -> na
           | _, Name _ -> na'
           | _ -> na in 
-        let t = detype tenv avoid env t in
+        let t = detype isgoal avoid env t in
 	let id = next_name_away na avoid in 
         let avoid = id::avoid and env = add_name (Name id) env in
-        share_names tenv (n-1) ((Name id,None,t)::l) avoid env c c'
+        share_names isgoal (n-1) ((Name id,None,t)::l) avoid env c c'
     (* May occur for fix built interactively *)
     | LetIn (na,b,t',c), _ when n > 0 ->
-        let t' = detype tenv avoid env t' in
-        let b = detype tenv avoid env b in
+        let t' = detype isgoal avoid env t' in
+        let b = detype isgoal avoid env b in
 	let id = next_name_away na avoid in 
         let avoid = id::avoid and env = add_name (Name id) env in
-        share_names tenv n ((Name id,Some b,t')::l) avoid env c t
+        share_names isgoal n ((Name id,Some b,t')::l) avoid env c t
     (* Only if built with the f/n notation or w/o let-expansion in types *)
     | _, LetIn (_,b,_,t) when n > 0 ->
-	share_names tenv n l avoid env c (subst1 b t)
+	share_names isgoal n l avoid env c (subst1 b t)
     (* If it is an open proof: we cheat and eta-expand *)
     | _, Prod (na',t',c') when n > 0 ->
-        let t' = detype tenv avoid env t' in
+        let t' = detype isgoal avoid env t' in
 	let id = next_name_away na' avoid in 
         let avoid = id::avoid and env = add_name (Name id) env in
         let appc = mkApp (lift 1 c,[|mkRel 1|]) in
-        share_names tenv (n-1) ((Name id,None,t')::l) avoid env appc c'
+        share_names isgoal (n-1) ((Name id,None,t')::l) avoid env appc c'
     (* If built with the f/n notation: we renounce to share names *)
     | _ ->
         if n>0 then warning "Detyping.detype: cannot factorize fix enough";
-        let c = detype tenv avoid env c in
-        let t = detype tenv avoid env t in
+        let c = detype isgoal avoid env c in
+        let t = detype isgoal avoid env t in
         (List.rev l,c,t)
 
-and detype_eqn tenv avoid env constr construct_nargs branch =
+and detype_eqns isgoal avoid env ci computable constructs consnargsl bl =
+  try
+    if !Options.raw_print or not (reverse_matching ()) then raise Exit;
+    let mat = build_tree Anonymous isgoal (avoid,env) ci bl in
+    List.map (fun (pat,((avoid,env),c)) -> (dl,[],[pat],detype isgoal avoid env c))
+      mat
+  with _ ->
+    Array.to_list
+      (array_map3 (detype_eqn isgoal avoid env) constructs consnargsl bl)
+
+and detype_eqn isgoal avoid env constr construct_nargs branch =
   let make_pat x avoid env b ids =
     if force_wildcard () & noccurn 1 b then
-      PatVar (dummy_loc,Anonymous),avoid,(add_name Anonymous env),ids
-    else
+      PatVar (dl,Anonymous),avoid,(add_name Anonymous env),ids
+    else 
       let id = next_name_away_with_default "x" x avoid in
-      PatVar (dummy_loc,Name id),id::avoid,(add_name (Name id) env),id::ids
+      PatVar (dl,Name id),id::avoid,(add_name (Name id) env),id::ids
   in
   let rec buildrec ids patlist avoid env n b =
     if n=0 then
-      (dummy_loc, ids, 
-       [PatCstr(dummy_loc, constr, List.rev patlist,Anonymous)],
-       detype tenv avoid env b)
+      (dl, ids, 
+       [PatCstr(dl, constr, List.rev patlist,Anonymous)],
+       detype isgoal avoid env b)
     else
       match kind_of_term b with
 	| Lambda (x,_,b) -> 
@@ -465,7 +511,7 @@ and detype_eqn tenv avoid env constr construct_nargs branch =
 	    let pat,new_avoid,new_env,new_ids = make_pat x avoid env b ids in
             buildrec new_ids (pat::patlist) new_avoid new_env (n-1) b
 
-	| Cast (c,_) ->    (* Oui, il y a parfois des cast *)
+	| Cast (c,_,_) ->    (* Oui, il y a parfois des cast *)
 	    buildrec ids patlist avoid env n c
 
 	| _ -> (* eta-expansion : n'arrivera plus lorsque tous les
@@ -479,14 +525,123 @@ and detype_eqn tenv avoid env constr construct_nargs branch =
   in 
   buildrec [] [] avoid env construct_nargs branch
 
-and detype_binder tenv bk avoid env na ty c =
+and detype_binder isgoal bk avoid env na ty c =
   let na',avoid' =
     if bk = BLetIn then
-      concrete_let_name (fst tenv) avoid env na c
+      concrete_let_name isgoal avoid env na c
     else
-      concrete_name (fst tenv) avoid env na c in
-  let r =  detype tenv avoid' (add_name na' env) c in
+      concrete_name isgoal avoid env na c in
+  let r =  detype isgoal avoid' (add_name na' env) c in
   match bk with
-    | BProd -> RProd (dummy_loc, na',detype tenv avoid env ty, r)
-    | BLambda -> RLambda (dummy_loc, na',detype tenv avoid env ty, r)
-    | BLetIn -> RLetIn (dummy_loc, na',detype tenv avoid env ty, r)
+  | BProd -> RProd (dl, na',detype isgoal avoid env ty, r)
+  | BLambda -> RLambda (dl, na',detype isgoal avoid env ty, r)
+  | BLetIn -> RLetIn (dl, na',detype isgoal avoid env ty, r)
+
+(**********************************************************************)
+(* Module substitution: relies on detyping                            *)
+
+let rec subst_cases_pattern 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_cases_pattern subst) cpl in
+	if kn' == kn && cpl' == cpl then pat else
+	  PatCstr (loc,((kn',i),j),cpl',n)
+
+let rec subst_rawconstr subst raw = 
+  match raw with
+  | RRef (loc,ref) -> 
+      let ref',t = subst_global subst ref in 
+	if ref' == ref then raw else
+         detype false [] [] t
+
+  | RVar _ -> raw
+  | REvar _ -> raw
+  | RPatVar _ -> raw
+
+  | RApp (loc,r,rl) -> 
+      let r' = subst_rawconstr subst r 
+      and rl' = list_smartmap (subst_rawconstr subst) rl in
+	if r' == r && rl' == rl then raw else
+	  RApp(loc,r',rl')
+
+  | RLambda (loc,n,r1,r2) -> 
+      let r1' = subst_rawconstr subst r1 and r2' = subst_rawconstr subst r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  RLambda (loc,n,r1',r2')
+
+  | RProd (loc,n,r1,r2) -> 
+      let r1' = subst_rawconstr subst r1 and r2' = subst_rawconstr subst r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  RProd (loc,n,r1',r2')
+
+  | RLetIn (loc,n,r1,r2) -> 
+      let r1' = subst_rawconstr subst r1 and r2' = subst_rawconstr subst r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  RLetIn (loc,n,r1',r2')
+
+  | RCases (loc,rtno,rl,branches) -> 
+      let rtno' = option_smartmap (subst_rawconstr subst) rtno
+      and rl' = list_smartmap (fun (a,x as y) ->
+        let a' = subst_rawconstr subst a in
+        let (n,topt) = x in 
+        let topt' = option_smartmap
+          (fun (loc,(sp,i),x as t) ->
+            let sp' = subst_kn subst sp in
+            if sp == sp' then t else (loc,(sp',i),x)) topt in
+        if a == a' && topt == topt' then y else (a',(n,topt'))) rl
+      and branches' = list_smartmap 
+			(fun (loc,idl,cpl,r as branch) ->
+			   let cpl' =
+			     list_smartmap (subst_cases_pattern subst) cpl
+			   and r' = subst_rawconstr subst r in
+			     if cpl' == cpl && r' == r then branch else
+			       (loc,idl,cpl',r'))
+			branches
+      in
+	if rtno' == rtno && rl' == rl && branches' == branches then raw else
+	  RCases (loc,rtno',rl',branches')
+
+  | RLetTuple (loc,nal,(na,po),b,c) ->
+      let po' = option_smartmap (subst_rawconstr subst) po
+      and b' = subst_rawconstr subst b 
+      and c' = subst_rawconstr subst c in
+	if po' == po && b' == b && c' == c then raw else
+          RLetTuple (loc,nal,(na,po'),b',c')
+      
+  | RIf (loc,c,(na,po),b1,b2) ->
+      let po' = option_smartmap (subst_rawconstr subst) po
+      and b1' = subst_rawconstr subst b1 
+      and b2' = subst_rawconstr subst b2 
+      and c' = subst_rawconstr subst c in
+	if c' == c & po' == po && b1' == b1 && b2' == b2 then raw else
+          RIf (loc,c',(na,po'),b1',b2')
+
+  | RRec (loc,fix,ida,bl,ra1,ra2) -> 
+      let ra1' = array_smartmap (subst_rawconstr subst) ra1
+      and ra2' = array_smartmap (subst_rawconstr subst) ra2 in
+      let bl' = array_smartmap
+        (list_smartmap (fun (na,obd,ty as dcl) ->
+          let ty' = subst_rawconstr subst ty in
+          let obd' = option_smartmap (subst_rawconstr subst) obd in
+          if ty'==ty & obd'==obd then dcl else (na,obd',ty')))
+        bl in
+	if ra1' == ra1 && ra2' == ra2 && bl'==bl then raw else
+	  RRec (loc,fix,ida,bl',ra1',ra2')
+
+  | RSort _ -> raw
+
+  | RHole (loc,ImplicitArg (ref,i)) ->
+      let ref',_ = subst_global subst ref in 
+	if ref' == ref then raw else
+	  RHole (loc,InternalHole)
+  | RHole (loc, (BinderType _ | QuestionMark | CasesType |
+      InternalHole | TomatchTypeParameter _)) -> raw
+
+  | RCast (loc,r1,k,r2) -> 
+      let r1' = subst_rawconstr subst r1 and r2' = subst_rawconstr subst r2 in
+	if r1' == r1 && r2' == r2 then raw else
+	  RCast (loc,r1',k,r2')
+
+  | RDynamic _ -> raw
diff --git a/pretyping/detyping.mli b/pretyping/detyping.mli
index c2a70928..0b35728c 100644
--- a/pretyping/detyping.mli
+++ b/pretyping/detyping.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: detyping.mli,v 1.13.2.2 2004/07/16 19:30:44 herbelin Exp $ i*)
+(*i $Id: detyping.mli 7881 2006-01-16 14:03:05Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -16,20 +16,27 @@ open Sign
 open Environ
 open Rawterm
 open Termops
+open Mod_subst
 (*i*)
 
-(* [detype env avoid nenv c] turns [c], typed in [env], into a rawconstr. *)
-(* De Bruijn indexes are turned to bound names, avoiding names in [avoid] *)
+val subst_cases_pattern : substitution -> cases_pattern -> cases_pattern
 
-val detype : bool * env -> identifier list -> names_context -> constr -> 
-  rawconstr
+val subst_rawconstr : substitution -> rawconstr -> rawconstr
+
+(* [detype isgoal avoid ctx c] turns a closed [c], into a rawconstr *)
+(* de Bruijn indexes are turned to bound names, avoiding names in [avoid] *)
+(* [isgoal] tells if naming must avoid global-level synonyms as intro does *)
+(* [ctx] gives the names of the free variables *)
+
+val detype : bool -> identifier list -> names_context -> constr -> rawconstr
 
 val detype_case : 
   bool -> ('a -> rawconstr) ->
-  (constructor -> int -> 'a -> loc * identifier list * cases_pattern list *
-    rawconstr) -> ('a -> int -> bool) ->
-    env -> identifier list -> inductive -> case_style ->
-      'a option -> int -> 'a -> 'a array -> rawconstr
+  (constructor array -> int array -> 'a array -> 
+    (loc * identifier list * cases_pattern list * rawconstr) list) ->
+  ('a -> int -> bool) ->
+  identifier list -> inductive * case_style * int * int array * int ->
+    'a option -> 'a -> 'a array -> rawconstr
 
 (* look for the index of a named var or a nondep var as it is renamed *)
 val lookup_name_as_renamed  : env -> constr -> identifier -> int option
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 2264f82b..2b04b693 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -6,20 +6,21 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evarconv.ml,v 1.44.6.3 2005/11/29 21:40:52 letouzey Exp $ *)
+(* $Id: evarconv.ml 8111 2006-03-02 17:23:41Z herbelin $ *)
 
 open Util
 open Names
 open Term
+open Reduction
 open Reductionops
 open Closure
-open Instantiate
 open Environ
 open Typing
 open Classops
 open Recordops 
 open Evarutil
 open Libnames
+open Evd
 
 type flex_kind_of_term =
   | Rigid of constr 
@@ -69,7 +70,7 @@ let evar_apprec_nobeta env isevars stack c =
     let (t,stack as s') = apprec_nobeta env (evars_of isevars) s in
     match kind_of_term t with
       | Evar (n,_ as ev) when Evd.is_defined (evars_of isevars) n ->
-	  aux (existential_value (evars_of isevars) ev, stack)
+	  aux (Evd.existential_value (evars_of isevars) ev, stack)
       | _ -> (t, list_of_stack stack)
   in aux (c, append_stack (Array.of_list stack) empty_stack)
 *)
@@ -77,10 +78,10 @@ let evar_apprec_nobeta env isevars stack c =
 let evar_apprec env isevars stack c =
   let sigma = evars_of isevars in
   let rec aux s =
-    let (t,stack as s') = Reductionops.apprec env sigma s in
+    let (t,stack) = Reductionops.apprec env sigma s in
     match kind_of_term t with
       | Evar (n,_ as ev) when Evd.is_defined sigma n ->
-	  aux (existential_value sigma ev, stack)
+	  aux (Evd.existential_value sigma ev, stack)
       | _ -> (t, list_of_stack stack)
   in aux (c, append_stack (Array.of_list stack) empty_stack)
 
@@ -99,11 +100,11 @@ let apprec_nohdbeta env isevars c =
      (t2 us2) = (cstr us)
      extra_args1 = extra_args2
 
-   by finding a record R and an object c := [xs:bs](Build_R a1..am v1..vn)
+   by finding a record R and an object c := [xs:bs](Build_R params v1..vn)
    with vi = (cstr us), for which we know that the i-th projection proji
    satisfies
 
-      (proji params c) = (cstr us)
+      (proji params (c xs)) = (cstr us)
 
    Rem: such objects, usable for conversion, are defined in the objdef
    table; practically, it amounts to "canonically" equip t2 into a
@@ -112,10 +113,10 @@ let apprec_nohdbeta env isevars c =
 
 let check_conv_record (t1,l1) (t2,l2) =
   try
-    let proji = reference_of_constr t1 in
-    let cstr = reference_of_constr t2 in
+    let proji = global_of_constr t1 in
+    let cstr = global_of_constr t2 in
     let { o_DEF = c; o_TABS = bs; o_TPARAMS = params; o_TCOMPS = us } = 
-      objdef_info (proji, cstr) in
+      lookup_canonical_conversion (proji, cstr) in
     let params1, c1, extra_args1 =
       match list_chop (List.length params) l1 with 
 	| params1, c1::extra_args1 -> params1, c1, extra_args1
@@ -126,9 +127,47 @@ let check_conv_record (t1,l1) (t2,l2) =
     raise Not_found
 
 
-(* Precondition: one of the terms of the pb is an uninstanciated evar,
+(* Precondition: one of the terms of the pb is an uninstantiated evar,
  * possibly applied to arguments. *)
 
+let rec ise_try isevars = function
+    [] -> assert false
+  | [f] -> f isevars
+  | f1::l ->
+      let (isevars',b) = f1 isevars in
+      if b then (isevars',b) else ise_try isevars l
+
+let ise_and isevars l =
+  let rec ise_and i = function
+      [] -> assert false
+    | [f] -> f i
+    | f1::l ->
+        let (i',b) = f1 i in
+        if b then  ise_and i' l else (isevars,false) in
+  ise_and isevars l
+
+let ise_list2 isevars f l1 l2 =
+  let rec ise_list2 i l1 l2 =
+    match l1,l2 with
+        [], [] -> (i, true)
+      | [x], [y] -> f i x y
+      | x::l1, y::l2 ->
+          let (i',b) = f i x y in
+          if b then ise_list2 i' l1 l2 else (isevars,false)
+      | _ -> (isevars, false) in
+  ise_list2 isevars l1 l2
+
+let ise_array2 isevars f v1 v2 =
+  let rec allrec i = function
+    | -1 -> (i,true)
+    | n ->
+        let (i',b) = f i v1.(n) v2.(n) in
+        if b then allrec i' (n-1) else (isevars,false)
+  in 
+  let lv1 = Array.length v1 in
+  if lv1 = Array.length v2 then allrec isevars (pred lv1) 
+  else (isevars,false)
+
 let rec evar_conv_x env isevars pbty term1 term2 = 
   let sigma = evars_of isevars in
   let term1 = whd_castappevar sigma term1 in
@@ -138,15 +177,15 @@ let rec evar_conv_x env isevars pbty term1 term2 =
     true
   else 
 *)
-  (* Maybe convertible but since reducing can erase evars which [evar_apprec]*)
-  (* could have found, we do it only if the terms are free of evar  *)
-  (not (has_undefined_isevars isevars term1) &
-   not (has_undefined_isevars isevars term2) &
-   is_fconv pbty env (evars_of isevars) term1 term2) 
-  or
-  if ise_undefined isevars term1 then
+  (* Maybe convertible but since reducing can erase evars which [evar_apprec]
+     could have found, we do it only if the terms are free of evar.
+     Note: incomplete heuristic... *)
+  if is_ground_term isevars term1 && is_ground_term isevars term2 &
+     is_fconv pbty env (evars_of isevars) term1 term2 then
+      (isevars,true)
+  else if is_undefined_evar isevars term1 then
     solve_simple_eqn evar_conv_x env isevars (pbty,destEvar term1,term2)
-  else if ise_undefined isevars term2 then
+  else if is_undefined_evar isevars term2 then
     solve_simple_eqn evar_conv_x env isevars (pbty,destEvar term2,term1)
   else 
     let (t1,l1) = apprec_nohdbeta env isevars term1 in
@@ -154,7 +193,7 @@ let rec evar_conv_x env isevars pbty term1 term2 =
     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 isevars (pbty,applist(t1,l1),applist(t2,l2)); true)
+      (add_conv_pb (pbty,applist(t1,l1),applist(t2,l2)) isevars, true)
     else 
       evar_eqappr_x env isevars pbty (t1,l1) (t2,l2)
 
@@ -162,67 +201,81 @@ and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
   (* Evar must be undefined since we have whd_ised *)
   match (flex_kind_of_term term1 l1, flex_kind_of_term term2 l2) with
     | Flexible (sp1,al1 as ev1), Flexible (sp2,al2 as ev2) ->
-	let f1 () =
+	let f1 i =
 	  if List.length l1 > List.length l2 then 
             let (deb1,rest1) = list_chop (List.length l1-List.length l2) l1 in
-            solve_simple_eqn evar_conv_x env isevars 
-	      (pbty,ev2,applist(term1,deb1))
-            & list_for_all2eq (evar_conv_x env isevars CONV) rest1 l2
+            ise_and i
+              [(fun i -> solve_simple_eqn evar_conv_x env i
+	        (pbty,ev2,applist(term1,deb1)));
+              (fun i -> ise_list2 i
+                  (fun i -> evar_conv_x env i CONV) rest1 l2)]
 	  else
 	    let (deb2,rest2) = list_chop (List.length l2-List.length l1) l2 in
-	    solve_simple_eqn evar_conv_x env isevars
-	      (pbty,ev1,applist(term2,deb2))
-            & list_for_all2eq (evar_conv_x env isevars CONV) l1 rest2
-	and f2 () =
-          (sp1 = sp2)
-	  & (array_for_all2 (evar_conv_x env isevars CONV) al1 al2)  
-	  & (list_for_all2eq (evar_conv_x env isevars CONV) l1 l2)
+            ise_and i
+              [(fun i -> solve_simple_eqn evar_conv_x env i
+	          (pbty,ev1,applist(term2,deb2)));
+              (fun i -> ise_list2 i
+                  (fun i -> evar_conv_x env i CONV) l1 rest2)]
+	and f2 i =
+          if sp1 = sp2 then
+            ise_and i
+            [(fun i -> ise_array2 i
+                (fun i -> evar_conv_x env i CONV) al1 al2);
+             (fun i -> ise_list2 i
+                 (fun i -> evar_conv_x env i CONV) l1 l2)]
+          else (i,false)
 	in 
 	ise_try isevars [f1; f2]
 
     | Flexible ev1, MaybeFlexible flex2 ->
-	let f1 () =
-	  (List.length l1 <= List.length l2) &
-	  let (deb2,rest2) = list_chop (List.length l2-List.length l1) l2 in
-          (* First compare extra args for better failure message *)
-          list_for_all2eq (evar_conv_x env isevars CONV) l1 rest2 &
-	  evar_conv_x env isevars pbty term1 (applist(term2,deb2))
-	and f4 () =
+	let f1 i =
+          if List.length l1 <= List.length l2 then
+	    let (deb2,rest2) =
+              list_chop (List.length l2-List.length l1) l2 in
+            ise_and i
+              (* 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 -> evar_conv_x env i pbty term1 (applist(term2,deb2)))]
+          else (i,false)
+	and f4 i =
 	  match eval_flexible_term env flex2 with
 	    | Some v2 ->
-		evar_eqappr_x env isevars pbty
-		  appr1 (evar_apprec env isevars l2 v2)
-	    | None -> false
+		evar_eqappr_x env i pbty appr1 (evar_apprec env i l2 v2)
+	    | None -> (i,false)
 	in 
 	ise_try isevars [f1; f4]
 
     | MaybeFlexible flex1, Flexible ev2 ->
-	let f1 () =
-       	  (List.length l2 <= List.length l1) &
-       	  let (deb1,rest1) = list_chop (List.length l1-List.length l2) l1 in
-          (* First compare extra args for better failure message *)
-          list_for_all2eq (evar_conv_x env isevars CONV) rest1 l2 &
-	  evar_conv_x env isevars pbty (applist(term1,deb1)) term2
-	and f4 () =
+	let f1 i =
+       	  if List.length l2 <= List.length l1 then
+            let (deb1,rest1) = list_chop (List.length l1-List.length l2) l1 in
+            ise_and i
+            (* 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 -> evar_conv_x env i pbty (applist(term1,deb1)) term2)]
+          else (i,false)
+	and f4 i =
 	  match eval_flexible_term env flex1 with
 	    | Some v1 ->
-		evar_eqappr_x env isevars pbty
-		  (evar_apprec env isevars l1 v1) appr2
-	    | None -> false
+		evar_eqappr_x env i pbty (evar_apprec env i l1 v1) appr2
+	    | None -> (i,false)
 	in 
 	ise_try isevars [f1; f4]
 
     | MaybeFlexible flex1, MaybeFlexible flex2 ->
-	let f2 () =
-          (flex1 = flex2)
-	  & (List.length l1 = List.length l2)
-	  & (list_for_all2eq (evar_conv_x env isevars CONV) l1 l2)
-	and f3 () =
-	  (try conv_record env isevars 
+	let f2 i =
+          if flex1 = flex2 then
+            ise_list2 i (fun i -> evar_conv_x env i CONV) l1 l2
+          else (i,false)
+	and f3 i =
+	  (try conv_record env i
              (try check_conv_record appr1 appr2
 	      with Not_found -> check_conv_record appr2 appr1)
-           with _ -> false)
-	and f4 () =
+(* TODO: remove this _ !!! *)
+           with _ -> (i,false))
+	and f4 i =
           (* heuristic: unfold second argument first, exception made
              if the first argument is a beta-redex (expand a constant
              only if necessary) *)
@@ -232,87 +285,98 @@ and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
               | _ -> eval_flexible_term env flex2 in
 	  match val2 with
 	    | Some v2 ->
-		evar_eqappr_x env isevars pbty
-		  appr1 (evar_apprec env isevars l2 v2)
+		evar_eqappr_x env i pbty appr1 (evar_apprec env i l2 v2)
 	    | None ->
 		match eval_flexible_term env flex1 with
 		  | Some v1 ->
-		      evar_eqappr_x env isevars pbty
-			(evar_apprec env isevars l1 v1) appr2
-		  | None -> false
+		      evar_eqappr_x env i pbty (evar_apprec env i l1 v1) appr2
+		  | None -> (i,false)
 	in 
 	ise_try isevars [f2; f3; f4]
 
     | Flexible ev1, Rigid _ ->
-       	(List.length l1 <= List.length l2) &
-       	let (deb2,rest2) = list_chop (List.length l2-List.length l1) l2 in
-        (* First compare extra args for better failure message *)
-        list_for_all2eq (evar_conv_x env isevars CONV) l1 rest2 &
-	solve_simple_eqn evar_conv_x env isevars
-	  (pbty,ev1,applist(term2,deb2))
-
+       	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)
     | Rigid _, Flexible ev2 ->
-       	(List.length l2 <= List.length l1) &
-       	let (deb1,rest1) = list_chop (List.length l1-List.length l2) l1 in
-        (* First compare extra args for better failure message *)
-        list_for_all2eq (evar_conv_x env isevars CONV) rest1 l2 &
-	solve_simple_eqn evar_conv_x env isevars
-	  (pbty,ev2,applist(term1,deb1))
-        
+        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)
 
     | MaybeFlexible flex1, Rigid _ ->
-	let f3 () =
-	  (try conv_record env isevars (check_conv_record appr1 appr2)
-           with _ -> false)
-	and f4 () =
+	let f3 i =
+	  (try conv_record env i (check_conv_record appr1 appr2)
+           with _ -> (i,false))
+	and f4 i =
 	  match eval_flexible_term env flex1 with
 	    | Some v1 ->
- 		evar_eqappr_x env isevars pbty
-		  (evar_apprec env isevars l1 v1) appr2
-	    | None -> false
+ 		evar_eqappr_x env i pbty (evar_apprec env i l1 v1) appr2
+	    | None -> (i,false)
 	in 
 	ise_try isevars [f3; f4]
 	     
     | Rigid _ , MaybeFlexible flex2 -> 
-	let f3 () = 
-	  (try (conv_record env isevars (check_conv_record appr2 appr1))
-           with _ -> false)
-	and f4 () =
+	let f3 i = 
+	  (try (conv_record env i (check_conv_record appr2 appr1))
+           with _ -> (i,false))
+	and f4 i =
 	  match eval_flexible_term env flex2 with
 	    | Some v2 ->
- 		evar_eqappr_x env isevars pbty
-		  appr1 (evar_apprec env isevars l2 v2)
-	    | None -> false
+ 		evar_eqappr_x env i pbty appr1 (evar_apprec env i l2 v2)
+	    | None -> (i,false)
 	in 
 	ise_try isevars [f3; f4]
 
     | Rigid c1, Rigid c2 -> match kind_of_term c1, kind_of_term c2 with
 	  
-	| Cast (c1,_), _ -> evar_eqappr_x env isevars pbty (c1,l1) appr2
+	| Cast (c1,_,_), _ -> evar_eqappr_x env isevars pbty (c1,l1) appr2
 
-	| _, Cast (c2,_) -> evar_eqappr_x env isevars pbty appr1 (c2,l2)
+	| _, Cast (c2,_,_) -> evar_eqappr_x env isevars pbty appr1 (c2,l2)
 
-	| Sort s1, Sort s2 when l1=[] & l2=[] -> base_sort_cmp pbty s1 s2
+	| Sort s1, Sort s2 when l1=[] & l2=[] ->
+            (isevars,base_sort_cmp pbty s1 s2)
 
 	| Lambda (na,c1,c'1), Lambda (_,c2,c'2) when l1=[] & l2=[] -> 
-	    evar_conv_x env isevars CONV c1 c2
-	    & 
-	    (let c = nf_evar (evars_of isevars) c1 in
-             evar_conv_x (push_rel (na,None,c) env) isevars CONV c'1 c'2)
+            ise_and isevars
+              [(fun i -> evar_conv_x env i CONV c1 c2);
+               (fun i ->
+                 let c = nf_evar (evars_of i) c1 in
+                 evar_conv_x (push_rel (na,None,c) env) i CONV c'1 c'2)]
 
 	| LetIn (na,b1,t1,c'1), LetIn (_,b2,_,c'2) ->
-	    let f1 () =
-	      evar_conv_x env isevars CONV b1 b2
-	      & 
-              (let b = nf_evar (evars_of isevars) b1 in
-	       let t = nf_evar (evars_of isevars) t1 in
-               evar_conv_x (push_rel (na,Some b,t) env) isevars pbty c'1 c'2)
-	      & (List.length l1 = List.length l2)
-	      & (List.for_all2 (evar_conv_x env isevars CONV) l1 l2)
-	    and f2 () =
-              let appr1 = evar_apprec env isevars l1 (subst1 b1 c'1)
-              and appr2 = evar_apprec env isevars l2 (subst1 b2 c'2)
-	      in evar_eqappr_x env isevars pbty appr1 appr2
+	    let f1 i =
+              ise_and i
+                [(fun i -> evar_conv_x env i CONV b1 b2);
+                 (fun i ->
+                   let b = nf_evar (evars_of i) b1 in
+	           let t = nf_evar (evars_of i) t1 in
+                   evar_conv_x (push_rel (na,Some b,t) env) i pbty c'1 c'2);
+                 (fun i -> ise_list2 i
+                     (fun i -> evar_conv_x env i CONV) l1 l2)]
+	    and f2 i =
+              let appr1 = evar_apprec env i l1 (subst1 b1 c'1)
+              and appr2 = evar_apprec env i l2 (subst1 b2 c'2)
+	      in evar_eqappr_x env i pbty appr1 appr2
 	    in 
 	    ise_try isevars [f1; f2]
 
@@ -325,71 +389,102 @@ and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
             in evar_eqappr_x env isevars pbty appr1 appr2
 
 	| Prod (n,c1,c'1), Prod (_,c2,c'2) when l1=[] & l2=[] -> 
-            evar_conv_x env isevars CONV c1 c2
-            & 
-	    (let c = nf_evar (evars_of isevars) c1 in
-	     evar_conv_x (push_rel (n,None,c) env) isevars pbty c'1 c'2)
+            ise_and isevars
+              [(fun i -> evar_conv_x env i CONV c1 c2);
+               (fun i ->
+ 	         let c = nf_evar (evars_of i) c1 in
+	         evar_conv_x (push_rel (n,None,c) env) i pbty c'1 c'2)]
 
 	| Ind sp1, Ind sp2 ->
-	    sp1=sp2
-            & list_for_all2eq (evar_conv_x env isevars CONV) l1 l2
-             
+	    if sp1=sp2 then
+              ise_list2 isevars (fun i -> evar_conv_x env i CONV) l1 l2
+            else (isevars, false)
+
 	| Construct sp1, Construct sp2 ->
-	    sp1=sp2
-            & list_for_all2eq (evar_conv_x env isevars CONV) l1 l2
+	    if sp1=sp2 then
+              ise_list2 isevars (fun i -> evar_conv_x env i CONV) l1 l2
+            else (isevars, false)
 
 	| Case (_,p1,c1,cl1), Case (_,p2,c2,cl2) ->
-	    evar_conv_x env isevars CONV p1 p2
-	    & evar_conv_x env isevars CONV c1 c2
-	    & (array_for_all2 (evar_conv_x env isevars CONV) cl1 cl2)
-	    & (list_for_all2eq (evar_conv_x env isevars CONV) l1 l2)
+            ise_and isevars
+              [(fun i -> evar_conv_x env i CONV p1 p2);
+               (fun i -> evar_conv_x env i CONV c1 c2);
+	       (fun i -> ise_array2 i
+                   (fun i -> evar_conv_x env i CONV) cl1 cl2);
+               (fun i -> ise_list2 i (fun i -> evar_conv_x env i CONV) l1 l2)]
 
 	| Fix (li1,(_,tys1,bds1 as recdef1)), Fix (li2,(_,tys2,bds2)) ->
-	    li1=li2
-	    & (array_for_all2 (evar_conv_x env isevars CONV) tys1 tys2)
-	    & (array_for_all2
-		 (evar_conv_x (push_rec_types recdef1 env) isevars CONV)
-		 bds1 bds2)
-	    & (list_for_all2eq (evar_conv_x env isevars CONV) l1 l2)
-	     
+            if li1=li2 then
+              ise_and isevars
+                [(fun i -> ise_array2 i
+                    (fun i -> evar_conv_x env i CONV) tys1 tys2);
+                 (fun i -> ise_array2 i
+		     (fun i -> evar_conv_x (push_rec_types recdef1 env) i CONV)
+		     bds1 bds2);
+	         (fun i -> ise_list2 i
+                     (fun i -> evar_conv_x env i CONV) l1 l2)]
+	    else (isevars,false)
 	| CoFix (i1,(_,tys1,bds1 as recdef1)), CoFix (i2,(_,tys2,bds2)) ->
-	    i1=i2 
-	    & (array_for_all2 (evar_conv_x env isevars CONV) tys1 tys2)
-	    & (array_for_all2
-		 (evar_conv_x (push_rec_types recdef1 env) isevars CONV)
-		 bds1 bds2)
-	    & (list_for_all2eq (evar_conv_x env isevars CONV) l1 l2)
-
-	| (Meta _ | Lambda _), _ -> false
-	| _, (Meta _ | Lambda _) -> false
-
-	| (Ind _ | Construct _ | Sort _ | Prod _), _ -> false
-	| _, (Ind _ | Construct _ | Sort _ | Prod _) -> false
+            if i1=i2  then
+              ise_and isevars
+                [(fun i -> ise_array2 i
+                    (fun i -> evar_conv_x env i CONV) tys1 tys2);
+                 (fun i -> ise_array2 i
+		     (fun i -> evar_conv_x (push_rec_types recdef1 env) i CONV)
+		     bds1 bds2);
+                 (fun i -> ise_list2 i
+                     (fun i -> evar_conv_x env i CONV) l1 l2)]
+            else (isevars,false)
+
+	| (Meta _ | Lambda _), _ -> (isevars,false)
+	| _, (Meta _ | Lambda _) -> (isevars,false)
+
+	| (Ind _ | Construct _ | Sort _ | Prod _), _ -> (isevars,false)
+	| _, (Ind _ | Construct _ | Sort _ | Prod _) -> (isevars,false)
 
 	| (App _ | Case _ | Fix _ | CoFix _), 
-	  (App _ | Case _ | Fix _ | CoFix _) -> false
+	  (App _ | Case _ | Fix _ | CoFix _) -> (isevars,false)
 
 	| (Rel _ | Var _ | Const _ | Evar _), _ -> assert false
 	| _, (Rel _ | Var _ | Const _ | Evar _) -> assert false
 
 and conv_record env isevars (c,bs,(params,params1),(us,us2),(ts,ts1),c1) = 
-  let ks =
+  let (isevars',ks) =
     List.fold_left
-      (fun ks b ->
-	 let dloc = (dummy_loc,Rawterm.InternalHole) in
-	 (new_isevar isevars env dloc (substl ks b)) :: ks)
-      [] bs
+      (fun (i,ks) b ->
+	 let dloc = (dummy_loc,InternalHole) in
+         let (i',ev) = new_evar i env ~src:dloc (substl ks b) in
+	 (i', ev :: ks))
+      (isevars,[]) bs
   in
-  (list_for_all2eq 
-     (fun u1 u -> evar_conv_x env isevars CONV u1 (substl ks u))
-     us2 us)
-  &
-  (list_for_all2eq 
-     (fun x1 x -> evar_conv_x env isevars CONV x1 (substl ks x))
-     params1 params)
-  & (list_for_all2eq (evar_conv_x env isevars CONV) ts ts1)
-  & (evar_conv_x env isevars CONV c1 (applist (c,(List.rev ks))))
+  ise_and isevars'
+    [(fun i ->
+      ise_list2 i
+        (fun i u1 u -> evar_conv_x env i CONV u1 (substl ks u))
+        us2 us);
+     (fun i ->
+       ise_list2 i
+         (fun i x1 x -> evar_conv_x env i CONV x1 (substl ks x))
+         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 the_conv_x     env isevars t1 t2 = evar_conv_x env isevars CONV  t1 t2
-let the_conv_x_leq env isevars t1 t2 = evar_conv_x env isevars CUMUL t1 t2
+let the_conv_x     env t1 t2 isevars =
+  match evar_conv_x env isevars CONV  t1 t2 with
+      (evd',true) -> evd'
+    | _ -> raise Reduction.NotConvertible
+
+let the_conv_x_leq env t1 t2 isevars =
+  match evar_conv_x env isevars CUMUL t1 t2 with
+      (evd', true) -> evd'
+    | _ -> raise Reduction.NotConvertible
  
+let e_conv env isevars t1 t2 =
+  match evar_conv_x env !isevars CONV t1 t2 with
+      (evd',true) -> isevars := evd'; true
+    | _ -> false
+
+let e_cumul env isevars t1 t2 =
+  match evar_conv_x env !isevars CUMUL t1 t2 with
+      (evd',true) -> isevars := evd'; true
+    | _ -> false
diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli
index 8785d855..a6f5b489 100644
--- a/pretyping/evarconv.mli
+++ b/pretyping/evarconv.mli
@@ -6,23 +6,30 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: evarconv.mli,v 1.11.14.1 2004/07/16 19:30:44 herbelin Exp $ i*)
+(*i $Id: evarconv.mli 6109 2004-09-15 16:50:56Z barras $ i*)
 
 (*i*)
 open Term
 open Sign
 open Environ
 open Reductionops
-open Evarutil
+open Evd
 (*i*)
 
-val the_conv_x : env -> evar_defs -> constr -> constr -> bool
+(* returns exception Reduction.NotConvertible if not unifiable *)
+val the_conv_x     : env -> constr -> constr -> evar_defs -> evar_defs
+val the_conv_x_leq : env -> constr -> constr -> evar_defs -> evar_defs
 
-val the_conv_x_leq : env -> evar_defs -> constr -> constr -> bool
+(* The same function resolving evars by side-effect and 
+   catching the exception *)
+val e_conv  : env -> evar_defs ref -> constr -> constr -> bool
+val e_cumul : env -> evar_defs ref -> constr -> constr -> bool
 
 (*i For debugging *)
-val evar_conv_x : env -> evar_defs -> conv_pb -> constr -> constr -> bool
+val evar_conv_x :
+  env -> evar_defs -> conv_pb -> constr -> constr -> evar_defs * bool
 val evar_eqappr_x : 
   env -> evar_defs ->
-    conv_pb -> constr * constr list -> constr * constr list -> bool
+    conv_pb -> constr * constr list -> constr * constr list ->
+      evar_defs * bool
 (*i*)
diff --git a/pretyping/evarutil.ml b/pretyping/evarutil.ml
index 4337c0fc..aeaaefef 100644
--- a/pretyping/evarutil.ml
+++ b/pretyping/evarutil.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evarutil.ml,v 1.64.2.5 2004/12/09 14:45:38 herbelin Exp $ *)
+(* $Id: evarutil.ml 8695 2006-04-10 16:33:52Z msozeau $ *)
 
 open Util
 open Pp
@@ -18,9 +18,7 @@ open Termops
 open Sign
 open Environ
 open Evd
-open Instantiate
 open Reductionops
-open Indrec
 open Pretype_errors
 
 
@@ -50,7 +48,7 @@ let whd_castappevar_stack sigma c =
     match kind_of_term c with
       | Evar (ev,args) when Evd.in_dom sigma ev & Evd.is_defined sigma ev -> 
 	  whrec (existential_value sigma (ev,args), l)
-      | Cast (c,_) -> whrec (c, l)
+      | Cast (c,_,_) -> whrec (c, l)
       | App (f,args) -> whrec (f, Array.fold_right (fun a l -> a::l) args l)
       | _ -> s
   in 
@@ -64,207 +62,121 @@ let jl_nf_evar = Pretype_errors.jl_nf_evar
 let jv_nf_evar = Pretype_errors.jv_nf_evar
 let tj_nf_evar = Pretype_errors.tj_nf_evar
 
-(**********************)
-(* Creating new evars *)
-(**********************)
-
-let evar_env evd = Global.env_of_context evd.evar_hyps
-
-(* Generator of existential names *)
-let new_evar =
-  let evar_ctr = ref 0 in
-  fun () -> incr evar_ctr; existential_of_int !evar_ctr
-
-let make_evar_instance env =
-  fold_named_context
-    (fun env (id, b, _) l -> (*if b=None then*) mkVar id :: l (*else l*))
-    env ~init:[]
+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}
 
-(* create an untyped existential variable *)
-let new_evar_in_sign env =
-  let ev = new_evar () in
-  mkEvar (ev, Array.of_list (make_evar_instance env))
+let nf_evars evm = Evd.fold (fun ev evi evm' -> Evd.add evm' ev (nf_evar_info evm evi))
+		     evm Evd.empty
 
-(*------------------------------------*
- * functional operations on evar sets *
- *------------------------------------*)
+let nf_evar_defs isevars = Evd.evars_reset_evd (nf_evars (Evd.evars_of isevars)) isevars
 
-(* All ids of sign must be distincts! *)
-let new_isevar_sign env sigma typ instance =
-  let sign = named_context env in
-  if not (list_distinct (ids_of_named_context sign)) then 
-    error "new_isevar_sign: two vars have the same name";
-  let newev = new_evar() in
-  let info = { evar_concl = typ; evar_hyps = sign; 
-	       evar_body = Evar_empty } in
-  (Evd.add sigma newev info, mkEvar (newev,Array.of_list instance))
+let nf_isevar isevars = nf_evar (Evd.evars_of isevars)
+let j_nf_isevar isevars = j_nf_evar (Evd.evars_of isevars)
+let jl_nf_isevar isevars = jl_nf_evar (Evd.evars_of isevars)
+let jv_nf_isevar isevars = jv_nf_evar (Evd.evars_of isevars)
+let tj_nf_isevar isevars = tj_nf_evar (Evd.evars_of isevars)
 
-(* We don't try to guess in which sort the type should be defined, since
-   any type has type Type. May cause some trouble, but not so far... *)
-let new_Type () = mkType (new_univ ())
-
-let new_Type_sort () = Type (new_univ ())
+(**********************)
+(* Creating new metas *)
+(**********************)
 
-let judge_of_new_Type () = Typeops.judge_of_type (new_univ ())
-(*
-let new_Type () = mkType dummy_univ
-
-let new_Type_sort () = Type dummy_univ
-
-let judge_of_new_Type () = 
-  { uj_val = mkSort (Type dummy_univ);
-    uj_type = mkSort (Type dummy_univ) }
-*)
-
-(* This refreshes universes in types; works only for inferred types (i.e. for
-   types of the form (x1:A1)...(xn:An)B with B a sort or an atom in
-   head normal form) *)
-let refresh_universes t =
-  let modified = ref false in
-  let rec refresh t = match kind_of_term t with
-    | Sort (Type _) -> modified := true; new_Type ()
-    | Prod (na,u,v) -> mkProd (na,u,refresh v)
-    | _ -> t in
-  let t' = refresh t in
-  if !modified then t' else t
+(* Generator of metavariables *)
+let new_meta =
+  let meta_ctr = ref 0 in
+  fun () -> incr meta_ctr; !meta_ctr
 
-(* Declaring any type to be in the sort Type shouldn't be harmful since
-   cumulativity now includes Prop and Set in Type. *)
-let new_type_var env sigma =
-  let instance = make_evar_instance env in
-  new_isevar_sign env sigma (new_Type ()) instance
-
-let split_evar_to_arrow sigma (ev,args) =
-  let evd = Evd.map sigma ev in
-  let evenv = evar_env evd in
-  let (sigma1,dom) = new_type_var evenv sigma in
-  let hyps = evd.evar_hyps in
-  let nvar = next_ident_away (id_of_string "x") (ids_of_named_context hyps) in
-  let newenv = push_named (nvar, None, dom) evenv in
-  let (sigma2,rng) = new_type_var newenv sigma1 in
-  let x = named_hd newenv dom Anonymous in
-  let prod = mkProd (x, dom, subst_var nvar rng) in
-  let sigma3 = Evd.define sigma2 ev prod in
-  let evdom = fst (destEvar dom), args in
-  let evrng =
-    fst (destEvar rng), array_cons (mkRel 1) (Array.map (lift 1) args) in
-  let prod' = mkProd (x, mkEvar evdom, mkEvar evrng) in
-  (sigma3,prod', evdom, evrng)
+let mk_new_meta () = mkMeta(new_meta())
 
-(* Redefines an evar with a smaller context (i.e. it may depend on less
- * variables) such that c becomes closed.
- * Example: in [x:?1; y:(list ?2)] <?3>x=y /\ x=(nil bool)
- * ?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. *)
+let collect_evars emap c =
+  let rec collrec acc c =
+    match kind_of_term c with
+      | Evar (k,_) ->
+	  if Evd.in_dom emap k & not (Evd.is_defined emap k) then k::acc
+	  else (* No recursion on the evar instantiation *) acc
+      | _         ->
+	  fold_constr collrec acc c in
+  list_uniquize (collrec [] c)
+
+let push_dependent_evars sigma emap =
+  Evd.fold (fun ev {evar_concl = ccl} (sigma',emap') ->
+    List.fold_left 
+      (fun (sigma',emap') ev -> 
+	(Evd.add sigma' ev (Evd.map emap' ev),Evd.rmv emap' ev))
+      (sigma',emap') (collect_evars emap' ccl))
+    emap (sigma,emap)
+    
+(* replaces a mapping of existentials into a mapping of metas.
+   Problem if an evar appears in the type of another one (pops anomaly) *)
+let evars_to_metas sigma (emap, c) =
+  let sigma',emap' = push_dependent_evars sigma emap in
+  let change_exist evar =
+    let ty = nf_betaiota (nf_evar emap (existential_type emap evar)) in
+    let n = new_meta() in
+    mkCast (mkMeta n, DEFAULTcast, ty) in
+  let rec replace c =
+    match kind_of_term c with
+        Evar (k,_ as ev) when Evd.in_dom emap' k -> change_exist ev
+      | _ -> map_constr replace c in
+  (sigma', replace c)
+
+(* The list of non-instantiated existential declarations *)
+
+let non_instantiated sigma = 
+  let listev = to_list sigma in
+  List.fold_left 
+    (fun l (ev,evd) -> 
+       if evd.evar_body = Evar_empty then 
+	 ((ev,nf_evar_info sigma evd)::l) else l)
+    [] listev
+
+(*************************************)
+(* Metas *)
+
+let meta_value evd mv = 
+  let rec valrec mv =
+    try
+      let b = meta_fvalue evd mv in
+      instance
+        (List.map (fun mv' -> (mv',valrec mv')) (Metaset.elements b.freemetas))
+        b.rebus
+    with Anomaly _ | Not_found -> 
+      mkMeta mv
+  in 
+  valrec mv
 
-let do_restrict_hyps sigma ev args =
-  let args = Array.to_list args in
-  let evd = Evd.map sigma ev in
-  let env = evar_env evd in
-  let hyps = evd.evar_hyps in
-  let (sign,ncargs) = list_filter2 (fun _ a -> closed0 a) (hyps,args) in
-  let env' = reset_with_named_context sign env in
-  let (sigma',nc) = new_isevar_sign env' sigma evd.evar_concl ncargs in
-  let nc = refresh_universes nc in (* needed only if nc is an inferred type *)
-  let sigma'' = Evd.define sigma' ev nc in
-  (sigma'', nc)
+let meta_instance env b =
+  let c_sigma =
+    List.map 
+      (fun mv -> (mv,meta_value env mv)) (Metaset.elements b.freemetas)
+  in 
+  instance c_sigma b.rebus
 
+let nf_meta env c = meta_instance env (mk_freelisted c)
 
+(**********************)
+(* Creating new evars *)
+(**********************)
 
+(* Generator of existential names *)
+let new_untyped_evar =
+  let evar_ctr = ref 0 in
+  fun () -> incr evar_ctr; existential_of_int !evar_ctr
 
 (*------------------------------------*
- * operations on the evar constraints *
+ * functional operations on evar sets *
  *------------------------------------*)
 
-type evar_constraint = conv_pb * constr * constr
-type evar_defs =
-    { mutable evars : Evd.evar_map;
-      mutable conv_pbs : evar_constraint list;
-      mutable history : (existential_key * (loc * Rawterm.hole_kind)) list }
-
-let create_evar_defs evd = { evars=evd; conv_pbs=[]; history=[] }
-let evars_of d = d.evars
-let evars_reset_evd evd d = d.evars <- evd
-let add_conv_pb d pb = d.conv_pbs <- pb::d.conv_pbs
-let evar_source ev d =
-  try List.assoc ev d.history
-  with Failure _ -> (dummy_loc, Rawterm.InternalHole)
-
-(* ise_try [f1;...;fn] tries fi() for i=1..n, restoring the evar constraints
- * when fi returns false or an exception. Returns true if one of the fi
- * returns true, and false if every fi return false (in the latter case,
- * the evar constraints are restored).
- *)
-let ise_try isevars l =
-  let u = isevars.evars in
-  let rec test = function
-      [] -> isevars.evars <- u; false
-    | f::l ->
- 	  (try f() with reraise -> isevars.evars <- u; raise reraise)
-       or (isevars.evars <- u; test l)
-  in test l
-
-
-
-(* say if the section path sp corresponds to an existential *)
-let ise_in_dom isevars sp = Evd.in_dom isevars.evars sp
-
-(* map the given section path to the enamed_declaration *)
-let ise_map isevars sp = Evd.map isevars.evars sp
-
-(* define the existential of section path sp as the constr body *)
-let ise_define isevars sp body =
-  let body = refresh_universes body in (* needed only if an inferred type *)
-  isevars.evars <- Evd.define isevars.evars sp body
-
-let is_defined_evar isevars (n,_) = Evd.is_defined isevars.evars n
-
-(* Does k corresponds to an (un)defined existential ? *)
-let ise_undefined isevars c = match kind_of_term c with
-  | Evar ev -> not (is_defined_evar isevars ev)
-  | _ -> false
-
-let need_restriction isevars args = not (array_for_all closed0 args)
-    
-
-(* We try to instanciate the evar assuming the body won't depend
- * on arguments that are not Rels or Vars, or appearing several times.
- *)
-(* 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
- * false. The problem is that we won't get the right error message.
- *)
-
-let real_clean env isevars ev args rhs =
-  let subst = List.map (fun (x,y) -> (y,mkVar x)) (filter_unique args) in
-  let rec subs 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)
-      | Evar (ev,args) ->
-	  let args' = Array.map (subs k) args in
-	  if need_restriction isevars args' then
-	    if Evd.is_defined isevars.evars ev then 
-	      subs k (existential_value isevars.evars (ev,args'))
-	    else begin
-	      let (sigma,rc) = do_restrict_hyps isevars.evars ev args' in
-	      isevars.evars <- sigma;
-              isevars.history <- 
-                (fst (destEvar rc),evar_source ev isevars)::isevars.history;
-	      rc
-	    end
-	  else
-	    mkEvar (ev,args')
-      | Var _ -> (try List.assoc t subst with Not_found -> t)
-      | _ -> map_constr_with_binders succ subs k t
-  in
-  let body = subs 0 rhs in
-  if not (closed0 body)
-  then error_not_clean env isevars.evars ev body (evar_source ev isevars);
-  body
+(* All ids of sign must be distincts! *)
+let new_evar_instance sign evd typ ?(src=(dummy_loc,InternalHole)) instance =
+  let ctxt = named_context_of_val sign in
+  assert (List.length instance = named_context_length ctxt); 
+  if not (list_distinct (ids_of_named_context ctxt)) then 
+    anomaly "new_evar_instance: two vars have the same name";
+  let newev = new_untyped_evar() in
+  (evar_declare sign newev typ ~src:src evd,
+   mkEvar (newev,Array.of_list instance))
 
 let make_evar_instance_with_rel env =
   let n = rel_context_length (rel_context env) in
@@ -279,7 +191,7 @@ let make_evar_instance_with_rel env =
 
 let make_subst env args =
   snd (fold_named_context
-    (fun env (id,b,c) (args,l as g) ->
+    (fun env (id,b,c) (args,l) ->
        match b, args with
 	 | (* None *) _ , a::rest -> (rest, (id,a)::l)
 (*	 | Some _, _ -> g*)
@@ -290,28 +202,175 @@ let make_subst env args =
 (* Converting the env into the sign of the evar to define *)
 
 let push_rel_context_to_named_context env =
-  let sign0 = named_context env in
-  let (subst,_,sign) =
+  let (subst,_,env) =
   Sign.fold_rel_context
-    (fun (na,c,t) (subst,avoid,sign) ->
+    (fun (na,c,t) (subst,avoid,env) ->
        let na = if na = Anonymous then Name(id_of_string"_") else na in
        let id = next_name_away na avoid in
        ((mkVar id)::subst,
         id::avoid,
-	add_named_decl (id,option_app (substl subst) c,
+	push_named (id,option_app (substl subst) c,
                         type_app (substl subst) t)
-	  sign))
-    (rel_context env) ~init:([],ids_of_named_context sign0,sign0)
-  in (subst, reset_with_named_context sign env)
+	  env))
+    (rel_context env) ~init:([],ids_of_named_context (named_context env),env)
+  in (subst, (named_context_val env))
 
-let new_isevar isevars env src typ =
-  let subst,env' = push_rel_context_to_named_context env in
+let new_evar evd env ?(src=(dummy_loc,InternalHole)) typ =
+  let subst,sign = push_rel_context_to_named_context env in
   let typ' = substl subst typ in
   let instance = make_evar_instance_with_rel env in
-  let (sigma',evar) = new_isevar_sign env' isevars.evars typ' instance in
-  isevars.evars <- sigma';
-  isevars.history <- (fst (destEvar evar),src)::isevars.history;
-  evar
+  new_evar_instance sign evd typ' ~src:src instance
+
+(* The same using side-effect *)
+let e_new_evar evd env ?(src=(dummy_loc,InternalHole)) ty =
+  let (evd',ev) = new_evar !evd env ~src:src ty in
+  evd := evd';
+  ev
+
+(*------------------------------------*
+ * operations on the evar constraints *
+ *------------------------------------*)
+
+(* Pb: defined Rels and Vars should not be considered as a pattern... *)
+let is_pattern inst =
+  let rec is_hopat l = function
+      [] -> true
+    | t :: tl ->
+        (isRel t or isVar t) && not (List.mem t l) && is_hopat (t::l) tl in
+  is_hopat [] (Array.to_list inst)
+
+let evar_well_typed_body evd ev evi body =
+  try
+    let env = evar_env evi in
+    let ty = evi.evar_concl in
+    Typing.check env (evars_of evd) body ty;
+    true
+  with e ->
+    pperrnl
+      (str "Ill-typed evar instantiation: " ++ fnl() ++
+       pr_evar_defs evd ++ fnl() ++
+       str "----> " ++ int ev ++ str " := " ++
+       print_constr body);
+    false
+
+let strict_inverse = false
+
+let inverse_instance env isevars ev evi inst rhs =
+  let subst = make_subst (evar_env evi) (Array.to_list inst) in
+  let subst = List.map (fun (x,y) -> (y,mkVar x)) subst in
+  let evd = ref isevars in
+  let error () = 
+    error_not_clean env (evars_of !evd) ev rhs (evar_source ev !evd) 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 ->
+               if rigid then error()
+               else if strict_inverse then
+                 failwith "cannot solve pb yet"
+               else t)
+      | Var id ->
+          (try List.assoc t subst
+           with Not_found ->
+             if rigid then error()
+             else if
+               not strict_inverse &&
+               List.exists (fun (id',_,_) -> id=id') (evar_context evi)
+             then
+               failwith "cannot solve pb yet"
+             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
+	    let args' = Array.map (subs false k) args in
+	    mkEvar (ev,args')
+      | _ -> map_constr_with_binders succ (subs rigid) k t in
+  let body = subs true 0 (nf_evar (evars_of isevars) rhs) in
+  (!evd,body)
+
+
+let is_defined_equation env evd (ev,inst) rhs =
+  is_pattern inst &&
+  not (occur_evar ev rhs) &&
+  try
+    let evi = Evd.map (evars_of evd) ev in
+    let (evd',body) = inverse_instance env evd ev evi inst rhs in
+    evar_well_typed_body evd' ev evi body
+  with Failure _ -> false
+
+
+(* Redefines an evar with a smaller context (i.e. it may depend on less
+ * variables) such that c becomes closed.
+ * Example: in [x:?1; y:(list ?2)] <?3>x=y /\ x=(nil bool)
+ * ?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. *)
+
+let do_restrict_hyps evd ev args =
+  let args = Array.to_list args in
+  let evi = Evd.map (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
+  (* 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
+  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)
+
+(* We try to instantiate the evar assuming the body won't depend
+ * on arguments that are not Rels or Vars, or appearing several times.
+ *)
+(* 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
+ * false. The problem is that we won't get the right error message.
+ *)
+
+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 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)
+      | Evar (ev,args) ->
+          if Evd.is_defined_evar !evd (ev,args) then
+            subs rigid k (existential_value (evars_of !evd) (ev,args))
+          else
+	    let args' = Array.map (subs false k) args in
+	    if need_restriction !evd args' then
+              do_restrict_hyps evd ev args'
+	    else
+	      mkEvar (ev,args')
+      | Var id ->
+          (try List.assoc t subst
+           with Not_found ->
+             if
+               not rigid 
+		 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
+  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);
+  (!evd,body)
 
 (* [evar_define] solves the problem lhs = rhs when lhs is an uninstantiated
  * evar, i.e. tries to find the body ?sp for lhs=mkEvar (sp,args)
@@ -331,30 +390,56 @@ let new_isevar isevars env src typ =
  * ?1 would be instantiated by (le y y) but y is not in the scope of ?1
  *)
 
-let evar_define env isevars (ev,argsv) rhs =
+(* env needed for error messages... *)
+let evar_define env (ev,argsv) rhs isevars =
   if occur_evar ev rhs
   then error_occur_check env (evars_of isevars) ev rhs;
   let args = Array.to_list argsv in 
-  let evd = ise_map isevars ev in
+  let evi = Evd.map (evars_of isevars) ev in
   (* the bindings to invert *)
-  let worklist = make_subst (evar_env evd) args in
-  let body = real_clean env isevars ev worklist rhs in
-  ise_define isevars ev body;
-  [ev]
+  let worklist = make_subst (evar_env evi) args in
+  let (isevars',body) = real_clean env isevars ev evi worklist rhs in
+  if occur_meta body then error "Meta cannot occur in evar body"
+  else
+    (* needed only if an inferred type *)
+    let body = refresh_universes body in
+(* Cannot strictly type instantiations since the unification algorithm
+ * does not unifies applications from left to right.
+ * e.g problem f x == g y yields x==y and f==g (in that order) 
+ * Another problem is that type variables are evars of type Type
+   let _ =
+      try
+        let env = evar_env evi in
+        let ty = evi.evar_concl in
+        Typing.check env (evars_of isevars') body ty
+      with e ->
+        pperrnl
+          (str "Ill-typed evar instantiation: " ++ fnl() ++
+           pr_evar_defs isevars' ++ fnl() ++
+           str "----> " ++ int ev ++ str " := " ++
+           print_constr body);
+        raise e in*)
+    let isevars'' = Evd.evar_define ev body isevars' in
+    isevars'',[ev]
+
+
 
 (*-------------------*)
 (* Auxiliary functions for the conversion algorithms modulo evars
  *)
 
-let has_undefined_isevars isevars t = 
-  try let _ = local_strong (whd_ise isevars.evars) t in false
+let has_undefined_evars isevars t = 
+  try let _ = local_strong (whd_ise (evars_of isevars)) t in false
   with Uninstantiated_evar _ -> true
 
+let is_ground_term isevars t =
+  not (has_undefined_evars isevars t)
+
 let head_is_evar isevars = 
   let rec hrec k = match kind_of_term k with
-    | Evar (n,_)   -> not (Evd.is_defined isevars.evars n)
+    | Evar n   -> not (Evd.is_defined_evar isevars n)
     | App (f,_) -> hrec f
-    | Cast (c,_) -> hrec c
+    | Cast (c,_,_) -> hrec c
     | _ -> false
   in 
   hrec 
@@ -362,7 +447,7 @@ let head_is_evar isevars =
 let rec is_eliminator c = match kind_of_term c with
   | App _    -> true
   | Case _ -> true
-  | Cast (c,_) -> is_eliminator c
+  | Cast (c,_,_) -> is_eliminator c
   | _ -> false
 
 let head_is_embedded_evar isevars c =
@@ -373,7 +458,7 @@ let head_evar =
     | Evar (ev,_)       -> ev
     | Case (_,_,c,_) -> hrec c
     | App (c,_)        -> hrec c
-    | Cast (c,_)        -> hrec c
+    | Cast (c,_,_)        -> hrec c
     | _                   -> failwith "headconstant"
   in 
   hrec 
@@ -410,75 +495,70 @@ let status_changed lev (pbty,t1,t2) =
   with Failure _ ->
     try List.mem (head_evar t2) lev with Failure _ -> false
 
-let get_changed_pb isevars lev =
-  let (pbs,pbs1) = 
-    List.fold_left
-      (fun (pbs,pbs1) pb ->
-    	 if status_changed lev pb then 
-	   (pb::pbs,pbs1)
-         else 
-	   (pbs,pb::pbs1))
-      ([],[])
-      isevars.conv_pbs
-  in
-  isevars.conv_pbs <- pbs1;
-  pbs
-
 (* Solve pbs (?i x1..xn) = (?i y1..yn) which arises often in fixpoint
  * definitions. We try to unify the xi with the yi pairwise. The pairs
  * that don't unify are discarded (i.e. ?i is redefined so that it does not
  * depend on these args). *)
 
 let solve_refl conv_algo env isevars ev argsv1 argsv2 =
-  if argsv1 = argsv2 then [] else
-  let evd = Evd.map isevars.evars ev in
-  let hyps = evd.evar_hyps in
-  let (_,rsign) = 
+  if argsv1 = argsv2 then (isevars,[]) else
+  let evd = Evd.map (evars_of isevars) ev in
+  let hyps = evar_context evd in
+  let (isevars',_,rsign) = 
     array_fold_left2
-      (fun (sgn,rsgn) a1 a2 ->
-	 if conv_algo env isevars CONV a1 a2 then 
-	   (List.tl sgn, add_named_decl (List.hd sgn) rsgn)
+      (fun (isevars,sgn,rsgn) a1 a2 ->
+        let (isevars',b) = conv_algo env isevars Reduction.CONV a1 a2 in
+	 if b then 
+	   (isevars',List.tl sgn, add_named_decl (List.hd sgn) rsgn)
 	 else 
-	   (List.tl  sgn, rsgn))
-      (hyps,[]) argsv1 argsv2 
+	   (isevars,List.tl  sgn, rsgn))
+      (isevars,hyps,[]) argsv1 argsv2 
   in
   let nsign = List.rev rsign in
-  let nargs = (Array.of_list (List.map mkVar (ids_of_named_context nsign))) in
-  let newev = new_evar () in
-  let info = { evar_concl = evd.evar_concl; evar_hyps = nsign;
-	       evar_body = Evar_empty } in
-  isevars.evars <-
-    Evd.define (Evd.add isevars.evars newev info) ev (mkEvar (newev,nargs));
-  isevars.history <- (newev,evar_source ev isevars)::isevars.history;
-  [ev]
+  let (evd',newev) =
+    let env =
+      Sign.fold_named_context push_named nsign ~init:(reset_context env) in
+    new_evar isevars env ~src:(evar_source ev isevars) evd.evar_concl in
+  let evd'' = Evd.evar_define ev newev evd' in
+  evd'', [ev]
 
 
 (* Tries to solve problem t1 = t2.
- * Precondition: t1 is an uninstanciated evar
+ * Precondition: t1 is an uninstantiated evar
  * Returns an optional list of evars that were instantiated, or None
  * if the problem couldn't be solved. *)
 
 (* Rq: uncomplete algorithm if pbty = CONV_X_LEQ ! *)
 let solve_simple_eqn conv_algo env isevars (pbty,(n1,args1 as ev1),t2) =
-  let t2 = nf_evar isevars.evars t2 in
-  let lsp = match kind_of_term t2 with
-    | Evar (n2,args2 as ev2)
-        when not (Evd.is_defined isevars.evars n2) ->
-	if n1 = n2 then
-	  solve_refl conv_algo env isevars n1 args1 args2
-	else
-	  if Array.length args1 < Array.length args2 then 
-	    evar_define env isevars ev2 (mkEvar ev1)
-	  else 
-	    evar_define env isevars ev1 t2
-    | _ ->
-	evar_define env isevars ev1 t2 in
-  let pbs = get_changed_pb isevars lsp in
-  List.for_all (fun (pbty,t1,t2) -> conv_algo env isevars pbty t1 t2) pbs
+  try
+    let t2 = nf_evar (evars_of isevars) t2 in
+    let (isevars,lsp) = match kind_of_term t2 with
+      | Evar (n2,args2 as ev2) ->
+	  if n1 = n2 then
+	    solve_refl conv_algo env isevars n1 args1 args2
+	  else
+            (try evar_define env ev1 t2 isevars
+            with e when precatchable_exception e ->
+              evar_define env ev2 (mkEvar ev1) isevars)
+(*	    if Array.length args1 < Array.length args2 then
+	      evar_define env ev2 (mkEvar ev1) isevars
+	    else 
+	      evar_define env ev1 t2 isevars*)
+      | _ ->
+	  evar_define env ev1 t2 isevars in
+    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)
+      pbs
+  with e when precatchable_exception e ->
+    (isevars,false)
 
 (* Operations on value/type constraints *)
 
-type type_constraint = constr option
+type type_constraint_type = (int * int) option * constr
+type type_constraint = type_constraint_type option
+
 type val_constraint = constr option
 
 (* Old comment...
@@ -498,8 +578,14 @@ type val_constraint = constr option
 (* The empty type constraint *)
 let empty_tycon = None
 
+let mk_tycon_type c = (None, c)
+let mk_abstr_tycon_type n c = (Some (n, n), c) (* First component is initial abstraction, second
+						  is current abstraction *)
+
 (* Builds a type constraint *)
-let mk_tycon ty = Some ty
+let mk_tycon ty = Some (mk_tycon_type ty)
+
+let mk_abstr_tycon n ty = Some (mk_abstr_tycon_type n ty)
 
 (* Constrains the value of a type *)
 let empty_valcon = None
@@ -509,41 +595,98 @@ let mk_valcon c = Some c
 
 (* Refining an evar to a product or a sort *)
 
-let refine_evar_as_arrow isevars ev =
-  let (sigma,prod,evdom,evrng) = split_evar_to_arrow isevars.evars ev in
-  evars_reset_evd sigma isevars;
-  let hst = evar_source (fst ev) isevars in
-  isevars.history <- (fst evrng,hst)::(fst evdom, hst)::isevars.history;
-  (prod,evdom,evrng)
+(* Declaring any type to be in the sort Type shouldn't be harmful since
+   cumulativity now includes Prop and Set in Type...
+   It is, but that's not too bad *)
+let define_evar_as_abstraction abs evd (ev,args) =
+  let evi = Evd.map (evars_of evd) ev in
+  let evenv = evar_env evi in
+  let (evd1,dom) = new_evar evd evenv (new_Type()) in
+  let nvar =
+    next_ident_away (id_of_string "x")
+      (ids_of_named_context (evar_context evi)) in
+  let newenv = push_named (nvar, None, dom) evenv in
+  let (evd2,rng) =
+    new_evar evd1 newenv ~src:(evar_source ev evd1) (new_Type()) in
+  let prod = abs (Name nvar, dom, subst_var nvar rng) in
+  let evd3 = Evd.evar_define ev prod evd2 in
+  let evdom = fst (destEvar dom), args in
+  let evrng =
+    fst (destEvar rng), array_cons (mkRel 1) (Array.map (lift 1) args) in
+  let prod' = abs (Name nvar, mkEvar evdom, mkEvar evrng) in
+  (evd3,prod')
+
+let define_evar_as_arrow evd (ev,args) =
+  define_evar_as_abstraction (fun t -> mkProd t) evd (ev,args)
 
-let define_evar_as_arrow isevars ev =
-  let (prod,_,_) = refine_evar_as_arrow isevars ev in
-  prod
+let define_evar_as_lambda evd (ev,args) =
+  define_evar_as_abstraction (fun t -> mkLambda t) evd (ev,args)
 
 let define_evar_as_sort isevars (ev,args) =
   let s = new_Type () in
-  let sigma' = Evd.define isevars.evars ev s in
-  evars_reset_evd sigma' isevars;
-  destSort s
+  Evd.evar_define ev s isevars, destSort s
+
 
+(* We don't try to guess in which sort the type should be defined, since
+   any type has type Type. May cause some trouble, but not so far... *)
+
+let judge_of_new_Type () = Typeops.judge_of_type (new_univ ())
 
 (* Propagation of constraints through application and abstraction:
    Given a type constraint on a functional term, returns the type
    constraint on its domain and codomain. If the input constraint is
    an evar instantiate it with the product of 2 new evars. *)
 
-let split_tycon loc env isevars = function
-  | None -> Anonymous,None,None
-  | Some c ->
-      let sigma = evars_of isevars in
-      let t = whd_betadeltaiota env sigma c in
+let split_tycon loc env isevars tycon = 
+  let rec real_split c = 
+    let sigma = evars_of isevars in
+    let t = whd_betadeltaiota env sigma c in
       match kind_of_term t with
-        | Prod (na,dom,rng) -> na, Some dom, Some rng
-	| Evar (n,_ as ev) when not (Evd.is_defined isevars.evars n) ->
-	    let (_,evdom,evrng) = refine_evar_as_arrow isevars ev in
-	    Anonymous, Some (mkEvar evdom), Some (mkEvar evrng)
+	| Prod (na,dom,rng) -> isevars, (na, dom, rng)
+	| Evar ev when not (Evd.is_defined_evar isevars ev) ->
+	    let (isevars',prod) = define_evar_as_arrow isevars ev in
+	    let (_,dom,rng) = destProd prod in
+	      isevars',(Anonymous, dom, rng)
 	| _ -> error_not_product_loc loc env sigma c
+  in
+    match tycon with
+      | None -> isevars,(Anonymous,None,None)
+      | Some (abs, c) ->
+	  (match abs with
+	       None -> 
+		 let isevars', (n, dom, rng) = real_split c in
+		   isevars', (n, mk_tycon dom, mk_tycon rng)
+	     | Some (init, cur) ->
+		 if cur = 0 then 
+		   let isevars', (x, dom, rng) = real_split c in
+		     isevars, (Anonymous, 
+			       Some (Some (init, 0), dom), 
+			       Some (Some (init, 0), rng))
+		 else
+		   isevars, (Anonymous, None, Some (Some (init, pred cur), c)))
+
+let valcon_of_tycon x = 
+  match x with
+    | Some (None, t) -> Some t
+    | _ -> None
+	
+let lift_abstr_tycon_type n (abs, t) =
+  match abs with 
+      None -> raise (Invalid_argument "lift_abstr_tycon_type: not an abstraction")
+    | Some (init, abs) ->
+	let abs' = abs + n in 
+	  if abs' < 0 then raise (Invalid_argument "lift_abstr_tycon_type")
+	  else (Some (init, abs'), t)
+
+let lift_tycon_type n (abs, t) = (abs, lift n t)
+let lift_tycon n = option_app (lift_tycon_type n)
+
+let pr_tycon_type env (abs, t) =
+  match abs with 
+      None -> Termops.print_constr_env env t
+    | Some (init, cur) -> str "Abstract (" ++ int init ++ str ","  ++ int cur ++ str ") " ++ Termops.print_constr_env env t
+	
+let pr_tycon env = function
+    None -> str "None"
+  | Some t -> pr_tycon_type env t
 
-let valcon_of_tycon x = x
-
-let lift_tycon = option_app (lift 1)
diff --git a/pretyping/evarutil.mli b/pretyping/evarutil.mli
index 011d2a92..7429cd16 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,v 1.33.2.2 2004/07/16 19:30:44 herbelin Exp $ i*)
+(*i $Id: evarutil.mli 8695 2006-04-10 16:33:52Z msozeau $ i*)
 
 (*i*)
 open Util
@@ -21,77 +21,132 @@ open Reductionops
 
 (*s This modules provides useful functions for unification modulo evars *)
 
-(* [whd_ise] raise [Uninstantiated_evar] if an evar remains uninstantiated; *)
-(* *[whd_evar]* and *[nf_evar]* leave uninstantiated evar as is *)
+(***********************************************************)
+(* Metas *)
 
-val nf_evar :  evar_map -> constr -> constr
-val j_nf_evar :  evar_map -> unsafe_judgment -> unsafe_judgment
-val jl_nf_evar :
-   evar_map -> unsafe_judgment list -> unsafe_judgment list
-val jv_nf_evar :
-   evar_map -> unsafe_judgment array -> unsafe_judgment array
-val tj_nf_evar :
-   evar_map -> unsafe_type_judgment -> unsafe_type_judgment
+(* [new_meta] is a generator of unique meta variables *)
+val new_meta : unit -> metavariable
+val mk_new_meta : unit -> constr
 
-(* Replacing all evars *)
-exception Uninstantiated_evar of existential_key
-val whd_ise :  evar_map -> constr -> constr
-val whd_castappevar :  evar_map -> constr -> constr
+(* [new_untyped_evar] is a generator of unique evar keys *)
+val new_untyped_evar : unit -> existential_key
+
+(***********************************************************)
+(* Creating a fresh evar given their type and context *)
+val new_evar :
+  evar_defs -> env -> ?src:loc * hole_kind -> types -> evar_defs * constr
+(* the same with side-effects *)
+val e_new_evar :
+  evar_defs ref -> env -> ?src:loc * hole_kind -> types -> constr
+
+(* Create a fresh evar in a context different from its definition context:
+   [new_evar_instance sign evd ty inst] creates a new evar of context
+   [sign] and type [ty], [inst] is a mapping of the evar context to
+   the context where the evar should occur. This means that the terms 
+   of [inst] are typed in the occurrence context and their type (seen
+   as a telescope) is [sign] *)
+val new_evar_instance :
+ named_context_val -> evar_defs -> types -> ?src:loc * hole_kind ->
+   constr list -> evar_defs * constr
 
-(* Creating new existential variables *)
-val new_evar : unit -> evar
-val new_evar_in_sign : env -> constr
+(***********************************************************)
+(* Instanciate evars *)
 
-val evar_env :  evar_info -> env
+(* suspicious env ? *)
+val evar_define :
+  env -> existential -> constr -> evar_defs -> evar_defs * evar list
 
-type evar_defs
-val evars_of :  evar_defs ->  evar_map
-val create_evar_defs :  evar_map ->  evar_defs
-val evars_reset_evd :  evar_map ->  evar_defs -> unit
-val evar_source : existential_key -> evar_defs -> loc * hole_kind
 
-type evar_constraint = conv_pb * constr * constr
-val add_conv_pb :  evar_defs -> evar_constraint -> unit
+(***********************************************************)
+(* Evars/Metas switching... *)
 
-val is_defined_evar :  evar_defs -> existential -> bool
-val ise_try :  evar_defs -> (unit -> bool) list -> bool
-val ise_undefined :  evar_defs -> constr -> bool
-val has_undefined_isevars :  evar_defs -> constr -> bool
+(* [evars_to_metas] generates new metavariables for each non dependent
+   existential and performs the replacement in the given constr; it also
+   returns the evar_map extended with dependent evars *)
+val evars_to_metas : evar_map -> open_constr -> (evar_map * constr)
 
-val new_isevar_sign :
- Environ.env -> Evd.evar_map -> Term.constr -> Term.constr list ->
-  Evd.evar_map * Term.constr
+val non_instantiated : evar_map -> (evar * evar_info) list
 
-val new_isevar :  evar_defs -> env -> loc * hole_kind -> constr -> constr
+(***********************************************************)
+(* Unification utils *)
 
+val is_ground_term :  evar_defs -> constr -> bool
 val is_eliminator : constr -> bool
 val head_is_embedded_evar :  evar_defs -> constr -> bool
 val solve_simple_eqn :
-  (env ->  evar_defs -> conv_pb -> constr -> constr -> bool)
-  -> env ->  evar_defs -> conv_pb * existential * constr -> bool
+  (env ->  evar_defs -> conv_pb -> constr -> constr -> evar_defs * bool)
+  -> env ->  evar_defs -> conv_pb * existential * constr ->
+    evar_defs * bool
 
-val define_evar_as_arrow : evar_defs -> existential -> types
-val define_evar_as_sort : evar_defs -> existential -> sorts
+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
 
+(***********************************************************)
 (* Value/Type constraints *)
 
-val new_Type_sort : unit -> sorts
-val new_Type : unit -> constr
 val judge_of_new_Type : unit -> unsafe_judgment
-val refresh_universes : types -> types
 
-type type_constraint = constr option
+type type_constraint_type = (int * int) option * constr
+type type_constraint = type_constraint_type option
+
 type val_constraint = constr option
 
 val empty_tycon : type_constraint
+val mk_tycon_type : constr -> type_constraint_type
+val mk_abstr_tycon_type : int -> constr -> type_constraint_type
 val mk_tycon : constr -> type_constraint
+val mk_abstr_tycon : int -> constr -> type_constraint
 val empty_valcon : val_constraint
 val mk_valcon : constr -> val_constraint
 
 val split_tycon :
   loc -> env ->  evar_defs -> type_constraint -> 
-    name * type_constraint * type_constraint
+    evar_defs * (name * type_constraint * type_constraint)
 
 val valcon_of_tycon : type_constraint -> val_constraint
 
-val lift_tycon : type_constraint -> type_constraint
+val lift_abstr_tycon_type : int -> type_constraint_type -> type_constraint_type
+
+val lift_tycon_type : int -> type_constraint_type -> type_constraint_type
+val lift_tycon : int -> type_constraint -> type_constraint
+
+(***********************************************************)
+
+(* [whd_ise] raise [Uninstantiated_evar] if an evar remains uninstantiated; *)
+(* *[whd_evar]* and *[nf_evar]* leave uninstantiated evar as is *)
+
+val nf_evar :  evar_map -> constr -> constr
+val j_nf_evar :  evar_map -> unsafe_judgment -> unsafe_judgment
+val jl_nf_evar :
+   evar_map -> unsafe_judgment list -> unsafe_judgment list
+val jv_nf_evar :
+   evar_map -> unsafe_judgment array -> unsafe_judgment array
+val tj_nf_evar :
+   evar_map -> unsafe_type_judgment -> unsafe_type_judgment
+
+val nf_evar_info : evar_map -> evar_info -> evar_info
+val nf_evars : evar_map -> evar_map
+
+(* Same for evar defs *)
+val nf_isevar :  evar_defs -> constr -> constr
+val j_nf_isevar :  evar_defs -> unsafe_judgment -> unsafe_judgment
+val jl_nf_isevar :
+   evar_defs -> unsafe_judgment list -> unsafe_judgment list
+val jv_nf_isevar :
+   evar_defs -> unsafe_judgment array -> unsafe_judgment array
+val tj_nf_isevar :
+   evar_defs -> unsafe_type_judgment -> unsafe_type_judgment
+
+val nf_evar_defs : evar_defs -> evar_defs
+
+(* Replacing all evars *)
+exception Uninstantiated_evar of existential_key
+val whd_ise :  evar_map -> constr -> constr
+val whd_castappevar :  evar_map -> constr -> constr
+
+(*********************************************************************)
+(* debug pretty-printer: *)
+
+val pr_tycon_type : env -> type_constraint_type -> Pp.std_ppcmds
+val pr_tycon : env -> type_constraint -> Pp.std_ppcmds
diff --git a/pretyping/evd.ml b/pretyping/evd.ml
index 7a3e7c02..c9f771c9 100644
--- a/pretyping/evd.ml
+++ b/pretyping/evd.ml
@@ -6,12 +6,18 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evd.ml,v 1.3.2.1 2004/07/16 19:30:44 herbelin Exp $ *)
+(* $Id: evd.ml 8688 2006-04-07 15:08:12Z msozeau $ *)
 
+open Pp
 open Util
 open Names
+open Nameops
 open Term
+open Termops
 open Sign
+open Environ
+open Libnames
+open Mod_subst
 
 (* The type of mappings for existential variables *)
 
@@ -23,12 +29,20 @@ type evar_body =
 
 type evar_info = {
   evar_concl : constr;
-  evar_hyps : named_context;
+  evar_hyps : named_context_val;
   evar_body : evar_body}
 
+let evar_context evi = named_context_of_val evi.evar_hyps
+
+let eq_evar_info ei1 ei2 =
+  ei1 == ei2 || 
+    eq_constr ei1.evar_concl ei2.evar_concl && 
+    eq_named_context_val (ei1.evar_hyps) (ei2.evar_hyps) &&
+    ei1.evar_body = ei2.evar_body
+
 module Evarmap = Intmap
 
-type evar_map = evar_info Evarmap.t
+type evar_map1 = evar_info Evarmap.t
 
 let empty = Evarmap.empty
 
@@ -38,28 +52,21 @@ let map evc k = Evarmap.find k evc
 let rmv evc k = Evarmap.remove k evc
 let remap evc k i = Evarmap.add k i evc
 let in_dom evc k = Evarmap.mem k evc
+let fold = Evarmap.fold
 
 let add evd ev newinfo =  Evarmap.add ev newinfo evd
 
 let define evd ev body = 
-  let oldinfo = map evd ev in
+  let oldinfo =
+    try map 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
+      evar_body = Evar_defined body} in
   match oldinfo.evar_body with
     | Evar_empty -> Evarmap.add ev newinfo evd
-    | _ -> anomaly "cannot define an isevar twice"
-
-(* The list of non-instantiated existential declarations *)
-
-let non_instantiated sigma = 
-  let listev = to_list sigma in
-  List.fold_left 
-    (fun l ((ev,evd) as d) -> 
-       if evd.evar_body = Evar_empty then (d::l) else l)
-    [] listev
+    | _ -> anomaly "Evd.define: cannot define an isevar twice"
     
 let is_evar sigma ev = in_dom sigma ev
 
@@ -68,7 +75,490 @@ let is_defined sigma ev =
   not (info.evar_body = Evar_empty)
 
 let evar_body ev = ev.evar_body
+let evar_env evd = Global.env_of_context evd.evar_hyps
 
 let string_of_existential ev = "?" ^ string_of_int ev
 
 let existential_of_int ev = ev
+
+(*******************************************************************)
+(* Formerly Instantiate module *)
+
+let is_id_inst inst =
+  let is_id (id,c) = match kind_of_term c with
+    | Var id' -> id = id'
+    | _ -> false
+  in
+  List.for_all is_id inst
+
+(* Vérifier que les instances des let-in sont compatibles ?? *)
+let instantiate_sign_including_let sign args =
+  let rec instrec = function
+    | ((id,b,_) :: sign, c::args) -> (id,c) :: (instrec (sign,args))
+    | ([],[])                        -> []
+    | ([],_) | (_,[]) ->
+    anomaly "Signature and its instance do not match"
+  in 
+  instrec (sign,args)
+
+let instantiate_evar sign c args =
+  let inst = instantiate_sign_including_let sign args in
+  if is_id_inst inst then
+    c
+  else
+    replace_vars inst c
+
+(* Existentials. *)
+
+let existential_type sigma (n,args) =
+  let info =
+    try map sigma n
+    with Not_found ->
+      anomaly ("Evar "^(string_of_existential n)^" was not declared") in
+  let hyps = evar_context info in
+  instantiate_evar hyps info.evar_concl (Array.to_list args)
+
+exception NotInstantiatedEvar
+
+let existential_value sigma (n,args) =
+  let info = map sigma n in
+  let hyps = evar_context info in
+  match evar_body info with
+    | Evar_defined c ->
+	instantiate_evar hyps c (Array.to_list args)
+    | Evar_empty ->
+	raise NotInstantiatedEvar
+
+let existential_opt_value sigma ev =
+  try Some (existential_value sigma ev)
+  with NotInstantiatedEvar -> None
+
+(*******************************************************************)
+(*                Constraints for sort variables                   *)
+(*******************************************************************)
+
+type sort_var = Univ.universe
+
+type sort_constraint =
+  | DefinedSort of sorts (* instantiated sort var *)
+  | SortVar of sort_var list * sort_var list (* (leq,geq) *)
+  | EqSort of sort_var
+
+module UniverseOrdered = struct
+  type t = Univ.universe
+  let compare = Pervasives.compare
+end
+module UniverseMap = Map.Make(UniverseOrdered)
+
+type sort_constraints = sort_constraint UniverseMap.t
+
+let rec canonical_find u scstr =
+  match UniverseMap.find u scstr with
+      EqSort u' -> canonical_find u' scstr
+    | c -> (u,c)
+
+let whd_sort_var scstr t =
+  match kind_of_term t with
+      Sort(Type u) ->
+        (try
+          match canonical_find u scstr with
+              _, DefinedSort s -> mkSort s
+            | _ -> t
+        with Not_found -> t)
+    | _ -> t
+
+let rec set_impredicative u s scstr =
+  match UniverseMap.find u scstr with
+    | DefinedSort s' ->
+        if family_of_sort s = family_of_sort s' then scstr
+        else failwith "sort constraint inconsistency"
+    | EqSort u' ->
+        UniverseMap.add u (DefinedSort s) (set_impredicative u' s scstr)
+    | SortVar(_,ul) ->
+        (* also set sorts lower than u as impredicative *)
+        UniverseMap.add u (DefinedSort s)
+          (List.fold_left (fun g u' -> set_impredicative u' s g) scstr ul)
+
+let rec set_predicative u s scstr =
+  match UniverseMap.find u scstr with
+    | DefinedSort s' ->
+        if family_of_sort s = family_of_sort s' then scstr
+        else failwith "sort constraint inconsistency"
+    | EqSort u' ->
+        UniverseMap.add u (DefinedSort s) (set_predicative u' s scstr)
+    | SortVar(ul,_) ->
+        UniverseMap.add u (DefinedSort s)
+          (List.fold_left (fun g u' -> set_impredicative u' s g) scstr ul)
+
+let var_of_sort = function
+    Type u -> u
+  | _ -> assert false
+
+let is_sort_var s scstr =
+  match s with
+      Type u ->
+        (try
+          match canonical_find u scstr with
+              _, DefinedSort _ -> false
+            | _ -> true
+        with Not_found -> false)
+    | _ -> false
+
+let new_sort_var cstr =
+  let u = Termops.new_univ() in
+  (u, UniverseMap.add u (SortVar([],[])) cstr)
+
+
+let set_leq_sort (u1,(leq1,geq1)) (u2,(leq2,geq2)) scstr =
+  let rec search_rec (is_b, betw, not_betw) u1 =
+    if List.mem u1 betw then (true, betw, not_betw)
+    else if List.mem u1 not_betw then (is_b, betw, not_betw)
+    else if u1 = u2 then (true, u1::betw,not_betw) else
+      match UniverseMap.find u1 scstr with
+          EqSort u1' -> search_rec (is_b,betw,not_betw) u1'
+        | SortVar(leq,_) ->
+            let (is_b',betw',not_betw') = 
+              List.fold_left search_rec (false,betw,not_betw) leq in
+            if is_b' then (true, u1::betw', not_betw')
+            else (false, betw', not_betw')
+        | DefinedSort _ -> (false,betw,u1::not_betw) in
+  let (is_betw,betw,_) = search_rec (false, [], []) u1 in
+  if is_betw then
+    UniverseMap.add u1 (SortVar(leq1@leq2,geq1@geq2))
+      (List.fold_left
+        (fun g u -> UniverseMap.add u (EqSort u1) g) scstr betw)
+  else
+    UniverseMap.add u1 (SortVar(u2::leq1,geq1))
+      (UniverseMap.add u2 (SortVar(leq2, u1::geq2)) scstr)
+
+let set_leq s1 s2 scstr =
+  let u1 = var_of_sort s1 in
+  let u2 = var_of_sort s2 in
+  let (cu1,c1) = canonical_find u1 scstr in
+  let (cu2,c2) = canonical_find u2 scstr in
+  if cu1=cu2 then scstr
+  else
+    match c1,c2 with
+        (EqSort _, _ | _, EqSort _) -> assert false
+      | SortVar(leq1,geq1), SortVar(leq2,geq2) ->
+          set_leq_sort (cu1,(leq1,geq1)) (cu2,(leq2,geq2)) scstr
+      | _, DefinedSort(Prop _ as s) -> set_impredicative u1 s scstr
+      | _, DefinedSort(Type _) -> scstr
+      | DefinedSort(Type _ as s), _ -> set_predicative u2 s scstr
+      | DefinedSort(Prop _), _ -> scstr
+
+let set_sort_variable s1 s2 scstr =
+  let u = var_of_sort s1 in
+  match s2 with
+      Prop _ -> set_impredicative u s2 scstr
+    | Type _ -> set_predicative u s2 scstr
+
+let pr_sort_cstrs g =
+  let l = UniverseMap.fold (fun u c l -> (u,c)::l) g [] in
+  str "SORT CONSTRAINTS:" ++ fnl() ++
+  prlist_with_sep fnl (fun (u,c) ->
+    match c with
+        EqSort u' -> Univ.pr_uni u ++ str" == " ++ Univ.pr_uni u'
+      | DefinedSort s -> Univ.pr_uni u ++ str " := " ++ print_sort s
+      | SortVar(leq,geq) ->
+          str"[" ++ hov 0 (prlist_with_sep spc Univ.pr_uni geq) ++
+          str"] <= "++ Univ.pr_uni u ++ brk(0,0) ++ str"<= [" ++
+          hov 0 (prlist_with_sep spc Univ.pr_uni leq) ++ str"]")
+    l
+
+type evar_map = evar_map1 * sort_constraints
+let empty = empty, UniverseMap.empty
+let add (sigma,sm) k v = (add sigma k v, sm)
+let dom (sigma,_) = dom sigma
+let map (sigma,_) = map sigma
+let rmv (sigma,sm) k = (rmv sigma k, sm)
+let remap (sigma,sm) k v = (remap sigma k v, sm)
+let in_dom (sigma,_) = in_dom sigma
+let to_list (sigma,_) = to_list sigma
+let fold f (sigma,_) = fold f sigma
+let define (sigma,sm) k v = (define sigma k v, sm)
+let is_evar (sigma,_) = is_evar sigma
+let is_defined (sigma,_) = is_defined sigma
+let existential_value (sigma,_) = existential_value sigma
+let existential_type (sigma,_) = existential_type sigma
+let existential_opt_value (sigma,_) = existential_opt_value sigma
+
+(*******************************************************************)
+type open_constr = evar_map * constr
+
+(*******************************************************************)
+(* The type constructor ['a sigma] adds an evar map to an object of
+  type ['a] *)
+type 'a sigma = {
+  it : 'a ;
+  sigma : evar_map}
+ 
+let sig_it x = x.it
+let sig_sig x = x.sigma
+ 
+(*******************************************************************)
+(* Metamaps *)
+
+(*******************************************************************)
+(*            Constraints for existential variables                *)
+(*******************************************************************)
+
+type 'a freelisted = {
+  rebus : 'a;
+  freemetas : Intset.t }
+
+(* Collects all metavars appearing in a constr *)
+let metavars_of c =
+  let rec collrec acc c =
+    match kind_of_term c with
+      | Meta mv -> Intset.add mv acc
+      | _         -> fold_constr collrec acc c
+  in
+  collrec Intset.empty c
+
+let mk_freelisted c =
+  { rebus = c; freemetas = metavars_of c }
+
+let map_fl f cfl = { cfl with rebus=f cfl.rebus }
+
+
+(* Clausal environments *)
+
+type clbinding =
+  | Cltyp of name * constr freelisted
+  | Clval of name * constr freelisted * constr freelisted
+
+let map_clb f = function
+  | Cltyp (na,cfl) -> Cltyp (na,map_fl f cfl)
+  | Clval (na,cfl1,cfl2) -> Clval (na,map_fl f cfl1,map_fl f cfl2)
+
+(* name of defined is erased (but it is pretty-printed) *)
+let clb_name = function
+    Cltyp(na,_) -> (na,false)
+  | Clval (na,_,_) -> (na,true)
+
+(***********************)
+                                                                               
+module Metaset = Intset
+                                                                               
+let meta_exists p s = Metaset.fold (fun x b -> b || (p x)) s false
+
+module Metamap = Intmap
+
+let metamap_to_list m =
+  Metamap.fold (fun n v l -> (n,v)::l) m []
+ 
+(*************************)
+(* Unification state *)
+
+type hole_kind =
+  | ImplicitArg of global_reference * (int * identifier option)
+  | BinderType of name
+  | QuestionMark
+  | CasesType
+  | InternalHole
+  | TomatchTypeParameter of inductive * int
+
+type conv_pb = Reduction.conv_pb
+type evar_constraint = conv_pb * constr * constr
+type evar_defs =
+    { evars : evar_map;
+      conv_pbs : evar_constraint list;
+      history : (existential_key * (loc * hole_kind)) list;
+      metas : clbinding Metamap.t }
+
+let subst_evar_defs sub evd =
+  { evd with
+    conv_pbs =
+      List.map (fun (k,t1,t2) ->(k,subst_mps sub t1,subst_mps sub t2))
+        evd.conv_pbs;
+    metas = Metamap.map (map_clb (subst_mps sub)) evd.metas }
+
+let create_evar_defs sigma =
+  { evars=sigma; conv_pbs=[]; history=[]; metas=Metamap.empty }
+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 evar_source ev d =
+  try List.assoc ev d.history
+  with Not_found -> (dummy_loc, InternalHole)
+
+(* define the existential of section path sp as the constr body *)
+let evar_define sp body isevars =
+  {isevars with evars = define isevars.evars sp body}
+
+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};
+    history = (evn,src)::evd.history }
+
+let is_defined_evar isevars (n,_) = is_defined isevars.evars n
+
+(* Does k corresponds to an (un)defined existential ? *)
+let is_undefined_evar isevars c = match kind_of_term c with
+  | Evar ev -> not (is_defined_evar isevars ev)
+  | _ -> false
+
+let undefined_evars isevars = 
+  let evd = 
+    fold (fun ev evi sigma -> if evi.evar_body = Evar_empty then 
+	    add sigma ev evi else sigma) 
+      isevars.evars empty
+  in 
+    { isevars with evars = evd }
+
+(* extracts conversion problems that satisfy predicate p *)
+(* Note: conv_pbs not satisying p are stored back in reverse order *)
+let get_conv_pbs isevars p =
+  let (pbs,pbs1) = 
+    List.fold_left
+      (fun (pbs,pbs1) pb ->
+    	 if p pb then 
+	   (pb::pbs,pbs1)
+         else 
+	   (pbs,pb::pbs1))
+      ([],[])
+      isevars.conv_pbs
+  in
+  {isevars with conv_pbs = pbs1},
+  pbs
+
+
+(**********************************************************)
+(* Sort variables *)
+
+let new_sort_variable (sigma,sm) =
+  let (u,scstr) = new_sort_var sm in
+  (Type u,(sigma,scstr))
+let is_sort_variable (_,sm) s =
+  is_sort_var s sm
+let whd_sort_variable (_,sm) t = whd_sort_var sm t
+let set_leq_sort_variable (sigma,sm) u1 u2 =
+  (sigma, set_leq u1 u2 sm)
+let define_sort_variable (sigma,sm) u s =
+  (sigma, set_sort_variable u s sm)
+let pr_sort_constraints (_,sm) = pr_sort_cstrs sm
+
+(**********************************************************)
+(* Accessing metas *)
+
+let meta_list evd = metamap_to_list evd.metas
+
+let meta_defined evd mv =
+  match Metamap.find mv evd.metas with
+    | Clval _ -> true
+    | Cltyp _ -> false
+ 
+let meta_fvalue evd mv =
+  match Metamap.find mv evd.metas with
+    | Clval(_,b,_) -> b
+    | Cltyp _ -> anomaly "meta_fvalue: meta has no value"
+           
+let meta_ftype evd mv =
+  match Metamap.find mv evd.metas with
+    | Cltyp (_,b) -> b
+    | Clval(_,_,b) -> b
+ 
+let meta_declare mv v ?(name=Anonymous) evd =
+  { evd with metas = Metamap.add mv (Cltyp(name,mk_freelisted v)) evd.metas }
+  
+let meta_assign mv v evd =
+  match Metamap.find mv evd.metas with
+      Cltyp(na,ty) ->
+        { evd with
+          metas = Metamap.add mv (Clval(na,mk_freelisted v, ty)) evd.metas }
+    | _ -> anomaly "meta_assign: already defined"
+
+(* If the meta is defined then forget its name *)
+let meta_name evd mv =
+  try
+    let (na,def) = clb_name (Metamap.find mv evd.metas) in
+    if def then Anonymous else na
+  with Not_found -> Anonymous
+
+let meta_with_name evd id =
+  let na = Name id in
+  let (mvl,mvnodef) =
+    Metamap.fold
+      (fun n clb (l1,l2 as l) ->
+        let (na',def) = clb_name clb in
+        if na = na' then if def then (n::l1,l2) else (n::l1,n::l2)
+        else l)
+      evd.metas ([],[]) in
+  match mvnodef, mvl with
+    | _,[]  -> 
+	errorlabstrm "Evd.meta_with_name"
+          (str"No such bound variable " ++ pr_id id)
+    | ([n],_|_,[n]) -> 
+	n
+    | _  -> 
+	errorlabstrm "Evd.meta_with_name"
+          (str "Binder name \"" ++ pr_id id ++
+           str"\" occurs more than once in clause")
+
+
+let meta_merge evd1 evd2 =
+  {evd2 with
+    metas = List.fold_left (fun m (n,v) -> Metamap.add n v m) 
+      evd2.metas (metamap_to_list evd1.metas) }
+
+
+(**********************************************************)
+(* Pretty-printing *)
+
+let pr_meta_map mmap =
+  let pr_name = function
+      Name id -> str"[" ++ pr_id id ++ str"]"
+    | _ -> mt() in
+  let pr_meta_binding = function
+    | (mv,Cltyp (na,b)) ->
+      	hov 0 
+	  (pr_meta mv ++ pr_name na ++ str " : " ++
+           print_constr b.rebus ++ fnl ())
+    | (mv,Clval(na,b,_)) ->
+      	hov 0 
+	  (pr_meta mv ++ pr_name na ++ str " := " ++
+           print_constr b.rebus ++ fnl ())
+  in
+  prlist pr_meta_binding (metamap_to_list mmap)
+
+let pr_idl idl = prlist_with_sep pr_spc pr_id idl
+
+let pr_evar_info evi =
+  let phyps = pr_idl (List.rev (ids_of_named_context (evar_context evi))) in
+  let pty = print_constr evi.evar_concl in
+  let pb =
+    match evi.evar_body with
+      | Evar_empty -> mt ()
+      | Evar_defined c -> spc() ++ str"=> "  ++ print_constr c
+  in
+  hov 2 (str"["  ++ phyps ++ spc () ++ str"|- "  ++ pty ++ pb ++ str"]")
+
+let pr_evar_map sigma =
+  h 0 
+    (prlist_with_sep pr_fnl
+      (fun (ev,evi) ->
+        h 0 (str(string_of_existential ev)++str"=="++ pr_evar_info evi))
+      (to_list sigma))
+
+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
+  let pp_met =
+    if evd.metas = Metamap.empty then mt() else
+      str"METAS:"++brk(0,1)++pr_meta_map evd.metas in
+  v 0 (pp_evm ++ cstrs ++ pp_met)
diff --git a/pretyping/evd.mli b/pretyping/evd.mli
index f66667aa..40ecce6e 100644
--- a/pretyping/evd.mli
+++ b/pretyping/evd.mli
@@ -6,12 +6,15 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: evd.mli,v 1.3.2.1 2004/07/16 19:30:44 herbelin Exp $ i*)
+(*i $Id: evd.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
 
 (*i*)
+open Util
 open Names
 open Term
 open Sign
+open Libnames
+open Mod_subst
 (*i*)
 
 (* The type of mappings for existential variables.
@@ -28,9 +31,11 @@ type evar_body =
 
 type evar_info = {
   evar_concl : constr;
-  evar_hyps : named_context;
+  evar_hyps : Environ.named_context_val;
   evar_body : evar_body}
 
+val eq_evar_info : evar_info -> evar_info -> bool
+val evar_context : evar_info -> named_context
 type evar_map
 
 val empty : evar_map
@@ -43,15 +48,127 @@ val rmv : evar_map -> evar -> evar_map
 val remap : evar_map -> evar -> evar_info -> evar_map
 val in_dom : evar_map -> evar -> bool
 val to_list : evar_map -> (evar * evar_info) list
+val fold : (evar -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a
 
 val define : evar_map -> evar -> constr -> evar_map
 
-val non_instantiated : evar_map -> (evar * evar_info) list
 val is_evar : evar_map -> evar -> bool
 
 val is_defined : evar_map -> evar -> bool
 
 val evar_body : evar_info -> evar_body
+val evar_env :  evar_info -> Environ.env
 
 val string_of_existential : evar -> string
 val existential_of_int : int -> evar
+
+(*s [existential_value sigma ev] raises [NotInstantiatedEvar] if [ev] has
+    no body and [Not_found] if it does not exist in [sigma] *)
+
+exception NotInstantiatedEvar
+val existential_value : evar_map -> existential -> constr
+val existential_type : evar_map -> existential -> types
+val existential_opt_value : evar_map -> existential -> constr option
+
+(*********************************************************************)
+(* constr with holes *)
+type open_constr = evar_map * constr
+
+(*********************************************************************)
+(* The type constructor ['a sigma] adds an evar map to an object of
+  type ['a] *)
+type 'a sigma = {
+  it : 'a ;
+  sigma : evar_map}
+
+val sig_it  : 'a sigma -> 'a
+val sig_sig : 'a sigma -> evar_map
+
+(*********************************************************************)
+(* Meta map *)
+
+module Metaset : Set.S with type elt = metavariable
+
+val meta_exists : (metavariable -> bool) -> Metaset.t -> bool
+
+type 'a freelisted = {
+  rebus : 'a;
+  freemetas : Metaset.t }
+
+val mk_freelisted : constr -> constr freelisted
+val map_fl : ('a -> 'b) -> 'a freelisted -> 'b freelisted
+
+type clbinding =
+  | Cltyp of name * constr freelisted
+  | Clval of name * constr freelisted * constr freelisted
+
+val map_clb : (constr -> constr) -> clbinding -> clbinding
+
+(*********************************************************************)
+(* Unification state *)
+type evar_defs
+
+(* Substitution is not applied to the [evar_map] *)
+val subst_evar_defs : substitution -> evar_defs -> evar_defs
+
+(* create an [evar_defs] with empty meta map: *)
+val create_evar_defs : evar_map -> evar_defs
+val evars_of         : evar_defs -> evar_map
+val evars_reset_evd  : evar_map ->  evar_defs -> evar_defs
+
+(* Evars *)
+type hole_kind =
+  | ImplicitArg of global_reference * (int * identifier option)
+  | BinderType of name
+  | QuestionMark
+  | CasesType
+  | InternalHole
+  | TomatchTypeParameter of inductive * int
+val is_defined_evar :  evar_defs -> existential -> bool
+val is_undefined_evar :  evar_defs -> constr -> bool
+val undefined_evars : evar_defs -> evar_defs
+val evar_declare :
+  Environ.named_context_val -> evar -> types -> ?src:loc * hole_kind ->
+  evar_defs -> evar_defs
+val evar_define : evar -> constr -> evar_defs -> evar_defs
+val evar_source : existential_key -> evar_defs -> loc * hole_kind
+
+(* Unification constraints *)
+type conv_pb = Reduction.conv_pb
+type evar_constraint = conv_pb * constr * constr
+val add_conv_pb :  evar_constraint -> evar_defs -> evar_defs
+val get_conv_pbs : evar_defs -> (evar_constraint -> bool) -> 
+  evar_defs * evar_constraint list
+
+(* Metas *)
+val meta_list : evar_defs -> (metavariable * clbinding) list
+val meta_defined : evar_defs -> metavariable -> bool
+(* [meta_fvalue] raises [Not_found] if meta not in map or [Anomaly] if
+   meta has no value *)  
+val meta_fvalue    : evar_defs -> metavariable -> constr freelisted
+val meta_ftype     : evar_defs -> metavariable -> constr freelisted
+val meta_name      : evar_defs -> metavariable -> name
+val meta_with_name : evar_defs -> identifier -> metavariable
+val meta_declare   :
+  metavariable -> types -> ?name:name -> evar_defs -> evar_defs
+val meta_assign    : metavariable -> constr -> evar_defs -> evar_defs
+
+(* [meta_merge evd1 evd2] returns [evd2] extended with the metas of [evd1] *)
+val meta_merge : evar_defs -> evar_defs -> evar_defs
+
+(**********************************************************)
+(* Sort variables *)
+
+val new_sort_variable : evar_map -> sorts * evar_map
+val is_sort_variable : evar_map -> sorts -> bool
+val whd_sort_variable : evar_map -> constr -> constr
+val set_leq_sort_variable : evar_map -> sorts -> sorts -> evar_map
+val define_sort_variable : evar_map -> sorts -> sorts -> evar_map
+
+(*********************************************************************)
+(* debug pretty-printer: *)
+
+val pr_evar_info : evar_info -> Pp.std_ppcmds
+val pr_evar_map  : evar_map -> Pp.std_ppcmds
+val pr_evar_defs : evar_defs -> Pp.std_ppcmds
+val pr_sort_constraints : evar_map -> Pp.std_ppcmds
diff --git a/pretyping/indrec.ml b/pretyping/indrec.ml
index 0b9283ae..a587dd20 100644
--- a/pretyping/indrec.ml
+++ b/pretyping/indrec.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: indrec.ml,v 1.20.2.3 2004/07/16 19:30:44 herbelin Exp $ *)
+(* $Id: indrec.ml 7662 2005-12-17 22:03:35Z herbelin $ *)
 
 open Pp
 open Util
@@ -19,14 +19,21 @@ open Declarations
 open Entries
 open Inductive
 open Inductiveops
-open Instantiate
 open Environ
 open Reductionops
 open Typeops
 open Type_errors
-open Indtypes (* pour les erreurs *)
 open Safe_typing
 open Nametab
+open Sign
+
+(* Errors related to recursors building *)
+type recursion_scheme_error =
+  | NotAllowedCaseAnalysis of bool * sorts * inductive
+  | BadInduction of bool * identifier * sorts
+  | NotMutualInScheme
+
+exception RecursionSchemeError of recursion_scheme_error
 
 let make_prod_dep dep env = if dep then prod_name env else mkProd
 let mkLambda_string s t c = mkLambda (Name (id_of_string s), t, c)
@@ -42,18 +49,18 @@ let mkLambda_string s t c = mkLambda (Name (id_of_string s), t, c)
    lifter les paramètres globaux *)
 
 let mis_make_case_com depopt env sigma (ind,mib,mip) kind =
-  let lnamespar = mip.mind_params_ctxt in
+  let lnamespar = mib.mind_params_ctxt in
   let dep = match depopt with 
     | None -> mip.mind_sort <> (Prop Null)
     | Some d -> d
   in
   if not (List.exists ((=) kind) mip.mind_kelim) then
     raise
-      (InductiveError
+      (RecursionSchemeError
 	 (NotAllowedCaseAnalysis
 	    (dep,(new_sort_in_family kind),ind)));
 
-  let nbargsprod = mip.mind_nrealargs + 1 in
+  let ndepar = mip.mind_nrealargs + 1 in
 
   (* Pas génant car env ne sert pas à typer mais juste à renommer les Anonym *)
   (* mais pas très joli ... (mais manque get_sort_of à ce niveau) *)
@@ -65,22 +72,28 @@ let mis_make_case_com depopt env sigma (ind,mib,mip) kind =
   let rec add_branch env k = 
     if k = Array.length mip.mind_consnames then
       let nbprod = k+1 in
-      let indf = make_ind_family(ind,extended_rel_list nbprod lnamespar) in
-      let lnamesar,_ = get_arity env indf in
+
+      let indf' = lift_inductive_family nbprod indf in
+      let arsign,_ = get_arity env indf' in
+      let depind = build_dependent_inductive env indf' in
+      let deparsign = (Anonymous,None,depind)::arsign in
+
       let ci = make_default_case_info env RegularStyle ind in
-      let depind = build_dependent_inductive env indf in
-      let deparsign = (Anonymous,None,depind)::lnamesar in
-      let p =
-      it_mkLambda_or_LetIn_name env'
-          (appvect
-            (mkRel ((if dep then nbargsprod else mip.mind_nrealargs) + nbprod),
-            if dep then extended_rel_vect 0 deparsign
-            else extended_rel_vect 0 lnamesar))
-          (if dep then deparsign else lnamesar) in
+      let pbody =
+        appvect
+          (mkRel (ndepar + nbprod),
+           if dep then extended_rel_vect 0 deparsign
+           else extended_rel_vect 1 arsign) in
+      let p = 
+	it_mkLambda_or_LetIn_name env'
+	  ((if dep then mkLambda_name env' else mkLambda)
+	   (Anonymous,depind,pbody))
+          arsign
+      in
       it_mkLambda_or_LetIn_name env'
-       	(mkCase (ci, lift nbargsprod p,
+       	(mkCase (ci, lift ndepar p,
 		     mkRel 1,
-		     rel_vect nbargsprod k))
+		     rel_vect ndepar k))
        	deparsign
     else
       let cs = lift_constructor (k+1) constrs.(k) in
@@ -186,7 +199,7 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
   let c = it_mkProd_or_LetIn base cs.cs_args in
   process_constr env 0 c recargs nhyps []
 
-let make_rec_branch_arg env sigma (nparams,fvect,decF) f cstr recargs = 
+let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs = 
   let process_pos env fk  =
     let rec prec env i hyps p =
       let p',largs = whd_betadeltaiota_nolet_stack env sigma p in
@@ -198,7 +211,7 @@ let make_rec_branch_arg env sigma (nparams,fvect,decF) f cstr recargs =
 	    let d = (n,Some b,t) in
 	    mkLetIn (n,b,t,prec (push_rel d env) (i+1) (d::hyps) c)
      	| Ind _ -> 
-            let realargs = list_skipn nparams largs
+            let realargs = list_skipn nparrec largs
             and arg = appvect (mkRel (i+1),extended_rel_vect 0 hyps) in 
             applist(lift i fk,realargs@[arg])
      	| _ -> assert false
@@ -239,10 +252,24 @@ let make_rec_branch_arg env sigma (nparams,fvect,decF) f cstr recargs =
   in
   process_constr env 0 f (List.rev cstr.cs_args, recargs)
 
+
+(* Cut a context ctx in 2 parts (ctx1,ctx2) with ctx1 containing k 
+   variables *)
+let context_chop k ctx = 
+  let rec chop_aux acc = function
+    | (0, l2) -> (List.rev acc, l2)
+    | (n, ((_,Some _,_ as h)::t)) -> chop_aux (h::acc) (n, t)
+    | (n, (h::t)) -> chop_aux (h::acc) (pred n, t)
+    | (_, []) -> failwith "context_chop"
+  in chop_aux [] (k,ctx)
+
+
 (* Main function *)
-let mis_make_indrec env sigma listdepkind (ind,mib,mip) =
-  let nparams = mip.mind_nparams in
-  let lnamespar = mip.mind_params_ctxt in
+let mis_make_indrec env sigma listdepkind mib =
+  let nparams = mib.mind_nparams in
+  let nparrec = mib. mind_nparams_rec in
+  let lnonparrec,lnamesparrec = 
+    context_chop (nparams-nparrec) mib.mind_params_ctxt in
   let nrec = List.length listdepkind in
   let depPvec =
     Array.create mib.mind_ntypes (None : (bool * constr) option) in 
@@ -257,6 +284,11 @@ let mis_make_indrec env sigma listdepkind (ind,mib,mip) =
     assign nrec listdepkind in 
   let recargsvec =
     Array.map (fun mip -> mip.mind_recargs) mib.mind_packets in
+ (* recarg information for non recursive parameters *)
+  let rec recargparn l n = 
+    if n = 0 then l else recargparn (mk_norec::l) (n-1) 
+  in
+  let recargpar = recargparn [] (nparams-nparrec) in
   let make_one_rec p =
     let makefix nbconstruct =
       let rec mrec i ln ltyp ldef = function
@@ -267,59 +299,86 @@ let mis_make_indrec env sigma listdepkind (ind,mib,mip) =
 
             (* arity in the context of the fixpoint, i.e.
                 P1..P_nrec f1..f_nbconstruct *)
-	    let args = extended_rel_list (nrec+nbconstruct) lnamespar in
+	    let args = extended_rel_list (nrec+nbconstruct) lnamesparrec in
 	    let indf = make_ind_family(indi,args) in
-	    let lnames,_ = get_arity env indf in
 
-	    let nar = mipi.mind_nrealargs in
-	    let dect = nar+nrec+nbconstruct in
+	    let arsign,_ = get_arity env indf in
+	    let depind = build_dependent_inductive env indf in
+	    let deparsign = (Anonymous,None,depind)::arsign in
+	    
+	    let nonrecpar = rel_context_length lnonparrec in
+	    let larsign = rel_context_length deparsign in
+	    let ndepar = larsign - nonrecpar in
+	    let dect = larsign+nrec+nbconstruct in
 
-	    let branches = 
               (* constructors in context of the Cases expr, i.e.
-                 P1..P_nrec f1..f_nbconstruct F_1..F_nrec a_1..a_nar x:I *)
-	      let args' = extended_rel_list (dect+nrec+1) lnamespar in
-              let indf' = make_ind_family(indi,args') in
+         P1..P_nrec f1..f_nbconstruct F_1..F_nrec a_1..a_nar x:I *)
+	    let args' = extended_rel_list (dect+nrec) lnamesparrec in
+	    let args'' = extended_rel_list ndepar lnonparrec in
+            let indf' = make_ind_family(indi,args'@args'') in
+
+	    let branches = 
 	      let constrs = get_constructors env indf' in
-	      let vecfi = rel_vect (dect+1-i-nctyi) nctyi in
+	      let fi = rel_vect (dect-i-nctyi) nctyi in
+	      let vecfi = Array.map 
+			    (fun f -> appvect (f,extended_rel_vect ndepar lnonparrec))
+			    fi 
+	      in
 	      array_map3
-		(make_rec_branch_arg env sigma (nparams,depPvec,nar+1))
-                vecfi constrs (dest_subterms recargsvec.(tyi)) in
+		(make_rec_branch_arg env sigma 
+		   (nparrec,depPvec,larsign))
+                vecfi constrs (dest_subterms recargsvec.(tyi)) 
+	    in
+
 	    let j = (match depPvec.(tyi) with 
 		       | Some (_,c) when isRel c -> destRel c 
-		       | _ -> assert false) in
+		       | _ -> assert false) 
+	    in
+
+	      (* Predicate in the context of the case *)
+
+	    let depind' = build_dependent_inductive env indf' in
+	    let arsign',_ = get_arity env indf' in
+	    let deparsign' = (Anonymous,None,depind')::arsign' in
+
+	    let pargs =
+	      let nrpar = extended_rel_list (2*ndepar) lnonparrec 
+	      and nrar = if dep then extended_rel_list 0 deparsign'
+	      else extended_rel_list 1 arsign'
+	      in nrpar@nrar
+
+	    in
+
+		(* body of i-th component of the mutual fixpoint *)
 	    let deftyi = 
 	      let ci = make_default_case_info env RegularStyle indi in
-	      let indf' = lift_inductive_family nrec indf in
-	      let depind = build_dependent_inductive env indf' in
-	      let lnames' = Termops.lift_rel_context nrec lnames in
-	      let p =
-		let arsign =
-		  if dep then (Anonymous,None,depind)::lnames' else lnames' in
-		it_mkLambda_or_LetIn_name env
-		  (appvect
-		    (mkRel ((if dep then 1 else 0) + dect + j),
-		    extended_rel_vect 0 arsign)) arsign
+	      let concl = applist (mkRel (dect+j+ndepar),pargs) in 
+	      let pred =
+		it_mkLambda_or_LetIn_name env 
+		  ((if dep then mkLambda_name env else mkLambda)
+		   (Anonymous,depind',concl))
+		  arsign'
 	      in
 	      it_mkLambda_or_LetIn_name env
-		(lambda_create env
-		  (depind,mkCase (ci, lift (nar+1) p, mkRel 1, branches)))
-		lnames'
+		(mkCase (ci, pred, 
+		             mkRel 1,
+			     branches))
+		(lift_rel_context nrec deparsign)
 	    in
-	    let typtyi = 
-	      let ind = build_dependent_inductive env indf in
-	      it_mkProd_or_LetIn_name env
-		(prod_create env
-		   (ind,
-		    (if dep then 
-		       let ext_lnames = (Anonymous,None,ind)::lnames in
-		       let args = extended_rel_list 0 ext_lnames in
-		       applist (mkRel (nbconstruct+nar+j+1), args)
-		     else
-		       let args = extended_rel_list 1 lnames in
-		       applist (mkRel (nbconstruct+nar+j+1), args))))
-          	lnames
-	    in 
-	    mrec (i+nctyi) (nar::ln) (typtyi::ltyp) (deftyi::ldef) rest
+
+	    (* type of i-th component of the mutual fixpoint *)
+
+	    let typtyi =
+	    let concl = 
+	      let pargs = if dep then extended_rel_vect 0 deparsign
+	      else extended_rel_vect 1 arsign
+	      in appvect (mkRel (nbconstruct+ndepar+nonrecpar+j),pargs)
+	    in it_mkProd_or_LetIn_name env
+		concl
+		deparsign
+	    in
+	    mrec (i+nctyi) (rel_context_nhyps arsign ::ln) (typtyi::ltyp) 
+                 (deftyi::ldef) rest
         | [] -> 
 	    let fixn = Array.of_list (List.rev ln) in
             let fixtyi = Array.of_list (List.rev ltyp) in
@@ -327,7 +386,7 @@ let mis_make_indrec env sigma listdepkind (ind,mib,mip) =
             let names = Array.create nrec (Name(id_of_string "F")) in
 	    mkFix ((fixn,p),(names,fixtyi,fixdef))
       in 
-      mrec 0 [] [] [] 
+	      mrec 0 [] [] [] 
     in 
     let rec make_branch env i = function 
       | (indi,mibi,mipi,dep,_)::rest ->
@@ -338,8 +397,8 @@ let mis_make_indrec env sigma listdepkind (ind,mib,mip) =
 	      make_branch env (i+j) rest 
 	    else 
 	      let recarg = (dest_subterms recargsvec.(tyi)).(j) in
-	      let vargs = extended_rel_list (nrec+i+j) lnamespar in
-	      let indf = (indi, vargs) in
+	      let recarg = recargpar@recarg in
+	      let vargs = extended_rel_list (nrec+i+j) lnamesparrec in
 	      let cs = get_constructor (indi,mibi,mipi,vargs) (j+1) in
 	      let p_0 =
 		type_rec_branch
@@ -353,23 +412,28 @@ let mis_make_indrec env sigma listdepkind (ind,mib,mip) =
     in 
     let rec put_arity env i = function 
       | (indi,_,_,dep,kinds)::rest -> 
-	  let indf = make_ind_family (indi,extended_rel_list i lnamespar) in
+	  let indf = make_ind_family (indi,extended_rel_list i lnamesparrec) in
 	  let typP = make_arity env dep indf (new_sort_in_family kinds) in
 	  mkLambda_string "P" typP
 	    (put_arity (push_rel (Anonymous,None,typP) env) (i+1) rest)
       | [] -> 
 	  make_branch env 0 listdepkind 
     in 
+
+      (* Body on make_one_rec *)
     let (indi,mibi,mipi,dep,kind) = List.nth listdepkind p in
-    let env' = push_rel_context lnamespar env in
+
     if mis_is_recursive_subset
       (List.map (fun (indi,_,_,_,_) -> snd indi) listdepkind)
       mipi.mind_recargs
     then 
-      it_mkLambda_or_LetIn_name env (put_arity env' 0 listdepkind) lnamespar
+    let env' = push_rel_context lnamesparrec env in
+      it_mkLambda_or_LetIn_name env (put_arity env' 0 listdepkind) 
+	lnamesparrec
     else 
       mis_make_case_com (Some dep) env sigma (indi,mibi,mipi) kind 
   in 
+      (* Body of mis_make_indrec *)
   list_tabulate make_one_rec nrec
 
 (**********************************************************************)
@@ -385,20 +449,21 @@ let make_case_gen env   = make_case_com None env
 
 
 (**********************************************************************)
-(* [instanciate_indrec_scheme s rec] replace the sort of the scheme
+(* [instantiate_indrec_scheme s rec] replace the sort of the scheme
    [rec] by [s] *)
 
 let change_sort_arity sort = 
   let rec drec a = match kind_of_term a with
-    | Cast (c,t) -> drec c 
+    | Cast (c,_,_) -> drec c 
     | Prod (n,t,c) -> mkProd (n, t, drec c)
+    | LetIn (n,b,t,c) -> mkLetIn (n,b, t, drec c)
     | Sort _ -> mkSort sort
     | _ -> assert false
   in 
   drec 
 
 (* [npar] is the number of expected arguments (then excluding letin's) *)
-let instanciate_indrec_scheme sort =
+let instantiate_indrec_scheme sort =
   let rec drec npar elim =
     match kind_of_term elim with
       | Lambda (n,t,c) -> 
@@ -407,13 +472,13 @@ let instanciate_indrec_scheme sort =
 	  else 
 	    mkLambda (n, t, drec (npar-1) c)
       | LetIn (n,b,t,c) -> mkLetIn (n,b,t,drec npar c)
-      | _ -> anomaly "instanciate_indrec_scheme: wrong elimination type"
+      | _ -> anomaly "instantiate_indrec_scheme: wrong elimination type"
   in
   drec
 
 (* Change the sort in the type of an inductive definition, builds the
    corresponding eta-expanded term *)
-let instanciate_type_indrec_scheme sort npars term =
+let instantiate_type_indrec_scheme sort npars term =
   let rec drec np elim =
     match kind_of_term elim with
       | Prod (n,t,c) -> 
@@ -426,22 +491,27 @@ let instanciate_type_indrec_scheme sort npars term =
 	    mkProd (n, t, c'), mkLambda (n, t, term')
       | LetIn (n,b,t,c) -> let c',term' = drec np c in
            mkLetIn (n,b,t,c'), mkLetIn (n,b,t,term') 
-      | _ -> anomaly "instanciate_type_indrec_scheme: wrong elimination type"
+      | _ -> anomaly "instantiate_type_indrec_scheme: wrong elimination type"
   in
   drec npars
 
 (**********************************************************************)
 (* Interface to build complex Scheme *)
+(* Check inductive types only occurs once 
+(otherwise we obtain a meaning less scheme) *)
 
 let check_arities listdepkind = 
-  List.iter 
-    (function (indi,mibi,mipi,dep,kind) -> 
+  let _ = List.fold_left
+    (fun ln ((_,ni),mibi,mipi,dep,kind) -> 
        let id = mipi.mind_typename  in
        let kelim = mipi.mind_kelim in
-       if not (List.exists ((=) kind) kelim) then
-	 raise
-	   (InductiveError (BadInduction (dep, id, new_sort_in_family kind))))
-    listdepkind
+       if not (List.exists ((=) kind) kelim) then raise
+	 (RecursionSchemeError (BadInduction (dep,id,new_sort_in_family kind)))
+       else if List.mem ni ln then raise
+	 (RecursionSchemeError NotMutualInScheme)
+       else ni::ln)
+	    [] listdepkind
+  in true
 
 let build_mutual_indrec env sigma = function 
   | (mind,mib,mip,dep,s)::lrecspec ->
@@ -455,18 +525,18 @@ let build_mutual_indrec env sigma = function
                 let (mibi',mipi') = lookup_mind_specif env mind' in
 		(mind',mibi',mipi',dep',s') 
 	      else 
-		raise (InductiveError NotMutualInScheme))
+		raise (RecursionSchemeError NotMutualInScheme))
 	   lrecspec)
       in
       let _ = check_arities listdepkind in 
-      mis_make_indrec env sigma listdepkind (mind,mib,mip)
+      mis_make_indrec env sigma listdepkind mib
   | _ -> anomaly "build_indrec expects a non empty list of inductive types"
 
 let build_indrec env sigma ind =
   let (mib,mip) = lookup_mind_specif env ind in
   let kind = family_of_sort mip.mind_sort in
   let dep = kind <> InProp in
-  List.hd (mis_make_indrec env sigma [(ind,mib,mip,dep,kind)] (ind,mib,mip))
+  List.hd (mis_make_indrec env sigma [(ind,mib,mip,dep,kind)] mib)
 
 (**********************************************************************)
 (* To handle old Case/Match syntax in Pretyping                       *)
@@ -483,7 +553,6 @@ let type_rec_branches recursive env sigma indt p c =
   let tyi = snd ind in
   let init_depPvec i = if i = tyi then Some(true,p) else None in
   let depPvec = Array.init mib.mind_ntypes init_depPvec in
-  let vargs = Array.of_list params in
   let constructors = get_constructors env indf in
   let lft =
     array_map2
@@ -513,14 +582,14 @@ let lookup_eliminator ind_sp s =
   let id = add_suffix ind_id (elimination_suffix s) in
   (* Try first to get an eliminator defined in the same section as the *)
   (* inductive type *)
-  let ref = ConstRef (make_kn mp dp (label_of_id id)) in
+  let ref = ConstRef (make_con mp dp (label_of_id id)) in
   try 
     let _ = sp_of_global ref in
-    constr_of_reference ref
+    constr_of_global ref
   with Not_found ->
   (* Then try to get a user-defined eliminator in some other places *)
   (* using short name (e.g. for "eq_rec") *)
-  try constr_of_reference (Nametab.locate (make_short_qualid id))
+  try constr_of_global (Nametab.locate (make_short_qualid id))
   with Not_found ->
     errorlabstrm "default_elim"
       (str "Cannot find the elimination combinator " ++
@@ -541,7 +610,7 @@ let lookup_eliminator ind_sp s =
   with Not_found ->
   (* Then try to get a user-defined eliminator in some other places *)
   (* using short name (e.g. for "eq_rec") *)
-    try constr_of_reference (Nametab.locate (make_short_qualid id))
+    try constr_of_global (Nametab.locate (make_short_qualid id))
     with Not_found ->
       errorlabstrm "default_elim"
 	(str "Cannot find the elimination combinator " ++
diff --git a/pretyping/indrec.mli b/pretyping/indrec.mli
index f6f76706..e5eb07f5 100644
--- a/pretyping/indrec.mli
+++ b/pretyping/indrec.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: indrec.mli,v 1.6.2.1 2004/07/16 19:30:45 herbelin Exp $ i*)
+(*i $Id: indrec.mli 7660 2005-12-17 21:13:48Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -17,7 +17,16 @@ open Environ
 open Evd
 (*i*)
 
-(* Eliminations. *)
+(* Errors related to recursors building *)
+
+type recursion_scheme_error =
+  | NotAllowedCaseAnalysis of bool * sorts * inductive
+  | BadInduction of bool * identifier * sorts
+  | NotMutualInScheme
+
+exception RecursionSchemeError of recursion_scheme_error
+
+(** Eliminations *)
 
 (* These functions build elimination predicate for Case tactic *)
 
@@ -29,11 +38,11 @@ val make_case_gen : env -> evar_map -> inductive -> sorts_family -> constr
    of the inductive) *)
 
 val build_indrec : env -> evar_map -> inductive -> constr
-val instanciate_indrec_scheme : sorts -> int -> constr -> constr
-val instanciate_type_indrec_scheme : sorts -> int -> constr -> types ->
+val instantiate_indrec_scheme : sorts -> int -> constr -> constr
+val instantiate_type_indrec_scheme : sorts -> int -> constr -> types ->
   constr * types
 
-(* This builds complex [Scheme] *)
+(** Complex recursion schemes [Scheme] *)
 
 val build_mutual_indrec : 
   env -> evar_map ->
@@ -41,7 +50,7 @@ val build_mutual_indrec :
     * bool * sorts_family) list
     -> constr list
 
-(* These are for old Case/Match typing *)
+(** Old Case/Match typing *)
 
 val type_rec_branches : bool -> env -> evar_map -> inductive_type
   -> constr -> constr -> constr array * constr
@@ -50,7 +59,11 @@ val make_rec_branch_arg :
     int * ('b * constr) option array * int ->
     constr -> constructor_summary -> wf_paths list -> constr
 
-(* *)
+(** Recursor names utilities *)
+
 val lookup_eliminator : inductive -> sorts_family -> constr
 val elimination_suffix : sorts_family -> string
 val make_elimination_ident : identifier -> sorts_family -> identifier
+
+
+
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index c33a261b..57d966f1 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: inductiveops.ml,v 1.14.2.2 2004/12/29 12:15:00 herbelin Exp $ *)
+(* $Id: inductiveops.ml 8653 2006-03-22 09:41:17Z herbelin $ *)
 
 open Util
 open Names
@@ -18,6 +18,24 @@ open Declarations
 open Environ
 open Reductionops
 
+(* The following three functions are similar to the ones defined in
+   Inductive, but they expect an env *)
+
+let type_of_inductive env ind =
+ let specif = Inductive.lookup_mind_specif env ind in
+  Inductive.type_of_inductive specif
+
+(* Return type as quoted by the user *)
+let type_of_constructor env cstr =
+ let specif =
+  Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
+ Inductive.type_of_constructor cstr specif
+
+(* Return constructor types in normal form *)
+let arities_of_constructors env ind =
+ let specif = Inductive.lookup_mind_specif env ind in
+  Inductive.arities_of_constructors ind specif
+
 (* [inductive_family] = [inductive_instance] applied to global parameters *)
 type inductive_family = inductive * constr list
 
@@ -73,6 +91,7 @@ let mis_nf_constructor_type (ind,mib,mip) j =
   substl (list_tabulate make_Ik ntypes) specif.(j-1)
 
 (* Arity of constructors excluding parameters and local defs *)
+
 let mis_constr_nargs indsp =
   let (mib,mip) = Global.lookup_inductive indsp in
   let recargs = dest_subterms mip.mind_recargs in
@@ -87,7 +106,21 @@ let mis_constr_nargs_env env (kn,i) =
 let mis_constructor_nargs_env env ((kn,i),j) =
   let mib = Environ.lookup_mind kn env in
   let mip = mib.mind_packets.(i) in 
-  recarg_length mip.mind_recargs j + mip.mind_nparams
+  recarg_length mip.mind_recargs j + mib.mind_nparams
+
+let constructor_nrealargs env (ind,j) =
+  let (_,mip) = Inductive.lookup_mind_specif env ind in
+  recarg_length mip.mind_recargs j
+
+let constructor_nrealhyps env (ind,j) =
+  let (mib,mip) = Inductive.lookup_mind_specif env ind in
+  mip.mind_consnrealdecls.(j-1)
+
+(* Length of arity (w/o local defs) *)
+
+let inductive_nargs env ind =
+  let (mib,mip) = Inductive.lookup_mind_specif env ind in
+  mip.mind_nrealargs + rel_context_nhyps mib.mind_params_ctxt
 
 (* Annotation for cases *)
 let make_case_info env ind style pats_source =
@@ -97,7 +130,8 @@ let make_case_info env ind style pats_source =
       style     = style;
       source    = pats_source } in
   { ci_ind     = ind;
-    ci_npar    = mip.mind_nparams;
+    ci_npar    = mib.mind_nparams;
+    ci_cstr_nargs = mip.mind_consnrealdecls;
     ci_pp_info = print_info }
 
 let make_default_case_info env style ind =
@@ -122,6 +156,7 @@ let lift_constructor n cs = {
   cs_args = lift_rel_context n cs.cs_args;
   cs_concl_realargs = Array.map (liftn n (cs.cs_nargs+1)) cs.cs_concl_realargs
 }
+(* Accept less parameters than in the signature *)
 
 let instantiate_params t args sign =
   let rec inst s t = function
@@ -133,17 +168,17 @@ let instantiate_params t args sign =
 	(match kind_of_term t with
 	   | LetIn(_,_,_,t) -> inst ((substl s b)::s) t (ctxt,args)
 	   | _ -> anomaly"instantiate_params: type, ctxt and args mismatch")
-    | [], [] -> substl s t
+    | _, [] -> substl s t
     | _ -> anomaly"instantiate_params: type, ctxt and args mismatch"
   in inst [] t (List.rev sign,args)
 
 let get_constructor (ind,mib,mip,params) j =
   assert (j <= Array.length mip.mind_consnames);
   let typi = mis_nf_constructor_type (ind,mib,mip) j in
-  let typi = instantiate_params typi params mip.mind_params_ctxt in
+  let typi = instantiate_params typi params mib.mind_params_ctxt in
   let (args,ccl) = decompose_prod_assum typi in
   let (_,allargs) = decompose_app ccl in
-  let vargs = list_skipn mip.mind_nparams allargs in
+  let vargs = list_skipn (List.length params) allargs in
   { cs_cstr = ith_constructor_of_inductive ind j;
     cs_params = params;
     cs_nargs = rel_context_length args;
@@ -175,8 +210,7 @@ let build_dependent_constructor cs =
 
 let build_dependent_inductive env ((ind, params) as indf) =
   let arsign,_ = get_arity env indf in
-  let (mib,mip) = Inductive.lookup_mind_specif env ind in
-  let nrealargs = mip.mind_nrealargs in
+  let nrealargs = List.length arsign in
   applist 
     (mkInd ind,
      (List.map (lift nrealargs) params)@(extended_rel_list 0 arsign))
@@ -189,7 +223,7 @@ let make_arity_signature env dep indf =
     (* We need names everywhere *)
     name_context env
       ((Anonymous,None,build_dependent_inductive env indf)::arsign)
-      (* Costly: would be better to name one for all at definition time *)
+      (* Costly: would be better to name once for all at definition time *)
   else
     (* No need to enforce names *)
     arsign
@@ -225,7 +259,7 @@ let find_rectype env sigma c =
   match kind_of_term t with
     | Ind ind ->
         let (mib,mip) = Inductive.lookup_mind_specif env ind in
-        let (par,rargs) = list_chop mip.mind_nparams l in
+        let (par,rargs) = list_chop mib.mind_nparams l in
         IndType((ind, par),rargs)
     | _ -> raise Not_found
 
@@ -247,59 +281,60 @@ let find_coinductive env sigma c =
 
 
 (***********************************************)
-(* find appropriate names for pattern variables. Useful in the
-   Case tactic. *)
+(* find appropriate names for pattern variables. Useful in the Case
+   and Inversion (case_then_using et case_nodep_then_using) tactics. *)
 
-let is_dep_predicate env kelim pred nodep_ar = 
-  let rec srec env pval pt nodep_ar =
-    let pt' = whd_betadeltaiota env Evd.empty pt in
+let is_predicate_explicitly_dep env pred nodep_ar = 
+  let rec srec env pval nodep_ar =
     let pv' = whd_betadeltaiota env Evd.empty pval in
-    match kind_of_term pv', kind_of_term pt', kind_of_term nodep_ar with
-      | Lambda (na,t,b), Prod (_,_,a), Prod (_,_,a') ->
-	  srec (push_rel_assum (na,t) env) b a a'
-      | _,              Prod (na,t,a), Prod (_,_,a') ->
-	  srec (push_rel_assum (na,t) env) (lift 1 pv') a a'
-      | Lambda (_,_,b), Prod (_,_,_), _ -> (*dependent (mkRel 1) b*) true
-      | _, Prod (_,_,_), _ -> true
-      | _ -> false in 
-  srec env pred.uj_val pred.uj_type nodep_ar
-
-let is_dependent_elimination_predicate env pred indf =
-  let (ind,params) = indf in
-  let (_,mip) = Inductive.lookup_mind_specif env ind in
-  let kelim = mip.mind_kelim in
-  let arsign,s = get_arity env indf in
-  let glob_t = it_mkProd_or_LetIn (mkSort s) arsign in
-  is_dep_predicate env kelim pred glob_t
-
-let is_dep_arity env kelim predty nodep_ar = 
-  let rec srec pt nodep_ar =
-    let pt' = whd_betadeltaiota env Evd.empty pt in
-    match kind_of_term pt', kind_of_term nodep_ar with
-      | Prod (_,a1,a2), Prod (_,a1',a2') -> srec a2 a2'
-      | Prod (_,a1,a2), _ -> true
-      | _ -> false in 
-  srec predty nodep_ar
-
-let is_dependent_elimination env predty indf =
-  let (ind,params) = indf in
-  let (_,mip) = Inductive.lookup_mind_specif env ind in
-  let kelim = mip.mind_kelim in
+    match kind_of_term pv', kind_of_term nodep_ar with
+      | Lambda (na,t,b), Prod (_,_,a') ->
+	  srec (push_rel_assum (na,t) env) b a'
+      | Lambda (na,_,_), _ ->
+
+       (* The following code has impact on the introduction names
+	  given by the tactics "case" and "inversion": when the
+	  elimination is not dependent, "case" uses Anonymous for
+	  inductive types in Prop and names created by mkProd_name for
+	  inductive types in Set/Type while "inversion" uses anonymous
+	  for inductive types both in Prop and Set/Type !!
+
+	  Previously, whether names were created or not relied on
+	  whether the predicate created in Indrec.make_case_com had a
+	  dependent arity or not. To avoid different predicates
+	  printed the same in v8, all predicates built in indrec.ml
+	  got a dependent arity (Aug 2004). The new way to decide
+	  whether names have to be created or not is to use an
+	  Anonymous or Named variable to enforce the expected
+	  dependency status (of course, Anonymous implies non
+	  dependent, but not conversely).
+
+          At the end, this is only to preserve the compatibility: a
+          check whether the predicate is actually dependent or not
+          would indeed be more natural! *)
+
+	  na <> Anonymous
+
+      | _ -> anomaly "Non eta-expanded dep-expanded \"match\" predicate"
+  in
+  srec env pred nodep_ar
+
+let is_elim_predicate_explicitly_dependent env pred indf =
   let arsign,s = get_arity env indf in
   let glob_t = it_mkProd_or_LetIn (mkSort s) arsign in
-  is_dep_arity env kelim predty glob_t
+  is_predicate_explicitly_dep env pred glob_t
 
 let set_names env n brty =
   let (ctxt,cl) = decompose_prod_n_assum n brty in
   it_mkProd_or_LetIn_name env cl ctxt
 
 let set_pattern_names env ind brv =
-  let (_,mip) = Inductive.lookup_mind_specif env ind in
+  let (mib,mip) = Inductive.lookup_mind_specif env ind in
   let arities =
     Array.map
       (fun c ->
         rel_context_length (fst (decompose_prod_assum c)) -
-        mip.mind_nparams)
+        mib.mind_nparams)
       mip.mind_nf_lc in
   array_map2 (set_names env) arities brv
 
@@ -308,8 +343,8 @@ let type_case_branches_with_names env indspec pj c =
   let (ind,args) = indspec in
   let (lbrty,conclty,_) = Inductive.type_case_branches env indspec pj c in
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
-  let params = list_firstn mip.mind_nparams args in
-  if is_dependent_elimination_predicate env pj (ind,params) then
+  let params = list_firstn mib.mind_nparams args in
+  if is_elim_predicate_explicitly_dependent env pj.uj_val (ind,params) then
     (set_pattern_names env ind lbrty, conclty)
   else (lbrty, conclty)
 
@@ -342,11 +377,15 @@ let control_only_guard env =
 	Array.iter control_rec tys;
 	Array.iter control_rec bds;
     | Case(_,p,c,b) -> control_rec p;control_rec c;Array.iter control_rec b
-    | Evar (_,cl)         -> Array.iter control_rec cl
+    | Evar (_,cl)        -> Array.iter control_rec cl
     | App (c,cl)         -> control_rec c; Array.iter control_rec cl
-    | Cast (c1,c2)       -> control_rec c1; control_rec c2
+    | Cast (c1,_, c2)  -> control_rec c1; control_rec c2
     | Prod (_,c1,c2)     -> control_rec c1; control_rec c2
     | Lambda (_,c1,c2)   -> control_rec c1; control_rec c2
     | LetIn (_,c1,c2,c3) -> control_rec c1; control_rec c2; control_rec c3
   in 
   control_rec 
+
+let subst_inductive subst (kn,i as ind) = 
+  let kn' = Mod_subst.subst_kn subst kn in
+  if kn == kn' then ind else (kn',i)
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index 8cfa9b3c..2993eed3 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,v 1.10.2.3 2005/01/21 17:19:37 herbelin Exp $ i*)
+(*i $Id: inductiveops.mli 7955 2006-01-30 22:56:15Z herbelin $ i*)
 
 open Names
 open Term
@@ -14,6 +14,17 @@ open Declarations
 open Environ
 open Evd
 
+(* The following three functions are similar to the ones defined in
+   Inductive, but they expect an env *)
+
+val type_of_inductive    : env -> inductive -> types
+
+(* Return type as quoted by the user *)
+val type_of_constructor  : env -> constructor -> types
+
+(* Return constructor types in normal form *)
+val arities_of_constructors : env -> inductive -> types array
+
 (* An inductive type with its parameters *)
 type inductive_family
 val make_ind_family : inductive * constr list -> inductive_family
@@ -46,6 +57,11 @@ val mis_constr_nargs_env : env -> inductive -> int array
 
 val mis_constructor_nargs_env : env -> constructor -> int
 
+val constructor_nrealargs : env -> constructor -> int
+val constructor_nrealhyps : env -> constructor -> int
+
+val inductive_nargs : env -> inductive -> int
+
 type constructor_summary = {
   cs_cstr : constructor;
   cs_params : constr list;
@@ -74,9 +90,6 @@ val find_inductive   : env -> evar_map -> constr -> inductive * constr list
 val find_coinductive : env -> evar_map -> constr -> inductive * constr list
 
 (********************)
-(* Determines if a case predicate type corresponds to dependent elimination *)
-val is_dependent_elimination :
-  env -> types -> inductive_family -> bool
 
 (* Builds the case predicate arity (dependent or not) *)
 val arity_of_case_predicate :
@@ -91,3 +104,5 @@ val make_default_case_info : env -> case_style -> inductive -> case_info
 
 (********************)
 val control_only_guard : env -> types -> unit
+
+val subst_inductive : Mod_subst.substitution -> inductive -> inductive
diff --git a/pretyping/instantiate.ml b/pretyping/instantiate.ml
deleted file mode 100644
index 702cdfea..00000000
--- a/pretyping/instantiate.ml
+++ /dev/null
@@ -1,68 +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        *)
-(************************************************************************)
-
-(* $Id: instantiate.ml,v 1.3.2.1 2004/07/16 19:30:45 herbelin Exp $ *)
-
-open Pp
-open Util
-open Names
-open Term
-open Sign
-open Evd
-open Declarations
-open Environ
-
-let is_id_inst inst =
-  let is_id (id,c) = match kind_of_term c with
-    | Var id' -> id = id'
-    | _ -> false
-  in
-  List.for_all is_id inst
-
-(* Vérifier que les instances des let-in sont compatibles ?? *)
-let instantiate_sign_including_let sign args =
-  let rec instrec = function
-    | ((id,b,_) :: sign, c::args) -> (id,c) :: (instrec (sign,args))
-    | ([],[])                        -> []
-    | ([],_) | (_,[]) ->
-    anomaly "Signature and its instance do not match"
-  in 
-  instrec (sign,args)
-
-let instantiate_evar sign c args =
-  let inst = instantiate_sign_including_let sign args in
-  if is_id_inst inst then
-    c
-  else
-    replace_vars inst c
-
-(* Existentials. *)
-
-let existential_type sigma (n,args) =
-  let info =
-    try Evd.map sigma n
-    with Not_found ->
-      anomaly ("Evar "^(string_of_existential n)^" was not declared") in
-  let hyps = info.evar_hyps in
-  instantiate_evar hyps info.evar_concl (Array.to_list args)
-
-exception NotInstantiatedEvar
-
-let existential_value sigma (n,args) =
-  let info = Evd.map sigma n in
-  let hyps = info.evar_hyps in
-  match evar_body info with
-    | Evar_defined c ->
-	instantiate_evar hyps c (Array.to_list args)
-    | Evar_empty ->
-	raise NotInstantiatedEvar
-
-let existential_opt_value sigma ev =
-  try Some (existential_value sigma ev)
-  with NotInstantiatedEvar -> None
-
diff --git a/pretyping/instantiate.mli b/pretyping/instantiate.mli
deleted file mode 100644
index 44c4d579..00000000
--- a/pretyping/instantiate.mli
+++ /dev/null
@@ -1,25 +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: instantiate.mli,v 1.2.14.1 2004/07/16 19:30:45 herbelin Exp $ i*)
-
-(*i*)
-open Names
-open Term
-open Evd
-open Sign
-open Environ
-(*i*)
-
-(*s [existential_value sigma ev] raises [NotInstantiatedEvar] if [ev] has
-no body and [Not_found] if it does not exist in [sigma] *)
-
-exception NotInstantiatedEvar
-val existential_value : evar_map -> existential -> constr
-val existential_type : evar_map -> existential -> types
-val existential_opt_value : evar_map -> existential -> constr option
diff --git a/pretyping/matching.ml b/pretyping/matching.ml
index bdab3b5b..5ee245b5 100644
--- a/pretyping/matching.ml
+++ b/pretyping/matching.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: matching.ml,v 1.3.2.1 2004/07/16 19:30:45 herbelin Exp $ *)
+(* $Id: matching.ml 7970 2006-02-01 15:09:07Z herbelin $ *)
 
 (*i*)
 open Util
@@ -89,11 +89,15 @@ let matches_core convert allow_partial_app pat c =
 
       | PMeta (Some n), m ->
 	  let depth = List.length stk in
-	  let frels = Intset.elements (free_rels cT) in
-          if List.for_all (fun i -> i > depth) frels then
-	    constrain (n,lift (-depth) cT) sigma
-          else 
-	    raise PatternMatchingFailure
+          if depth = 0 then
+            (* Optimisation *)
+            constrain (n,cT) sigma
+          else
+	    let frels = Intset.elements (free_rels cT) in
+            if List.for_all (fun i -> i > depth) frels then
+	      constrain (n,lift (-depth) cT) sigma
+            else 
+	      raise PatternMatchingFailure
 
       | PMeta None, m -> sigma
 
@@ -101,7 +105,7 @@ let matches_core convert allow_partial_app pat c =
 
       | PVar v1, Var v2 when v1 = v2 -> sigma
 
-      | PRef ref, _ when constr_of_reference ref = cT -> sigma
+      | PRef ref, _ when constr_of_global ref = cT -> sigma
 
       | PRel n1, Rel n2 when n1 = n2 -> sigma
 
@@ -109,6 +113,9 @@ let matches_core convert allow_partial_app pat c =
 
       | PSort (RType _), Sort (Type _) -> sigma
 
+      | PApp (PApp (h, a1), a2), _ ->
+          sorec stk sigma (PApp(h,Array.append a1 a2)) t
+
       | PApp (PMeta (Some n),args1), App (c2,args2) when allow_partial_app ->
           let p = Array.length args2 - Array.length args1 in
           if p>=0 then
@@ -139,7 +146,7 @@ let matches_core convert allow_partial_app pat c =
 
       | PRef (ConstRef _ as ref), _ when convert <> None ->
 	  let (env,evars) = out_some convert in
-	  let c = constr_of_reference ref in
+	  let c = constr_of_global ref in
 	  if is_conv env evars c cT then sigma
 	  else raise PatternMatchingFailure
 
@@ -176,15 +183,15 @@ let special_meta = (-1)
 (* Tries to match a subterm of [c] with [pat] *)
 let rec sub_match nocc pat c =
   match kind_of_term c with
-  | Cast (c1,c2) ->
+  | Cast (c1,k,c2) ->
     (try authorized_occ nocc ((matches pat c), mkMeta special_meta) with
     | PatternMatchingFailure ->
       let (lm,lc) = try_sub_match nocc pat [c1] in
-      (lm,mkCast (List.hd lc, c2))
+      (lm,mkCast (List.hd lc, k,c2))
     | NextOccurrence nocc ->
       let (lm,lc) = try_sub_match (nocc - 1) pat [c1] in
-      (lm,mkCast (List.hd lc, c2)))
-  | Lambda (x,c1,c2) ->
+      (lm,mkCast (List.hd lc, k,c2)))
+ | Lambda (x,c1,c2) ->
     (try authorized_occ nocc ((matches pat c), mkMeta special_meta) with
     | PatternMatchingFailure ->
       let (lm,lc) = try_sub_match nocc pat [c1;c2] in
@@ -242,6 +249,10 @@ and try_sub_match nocc pat lc =
       | NextOccurrence nocc -> try_sub_match_rec nocc pat (lacc@[c]) tl) in
   try_sub_match_rec nocc pat [] lc
 
+let match_subterm nocc pat c =
+  try sub_match nocc pat c
+  with NextOccurrence _ -> raise PatternMatchingFailure
+
 let is_matching pat n =
   try let _ = matches pat n in true
   with PatternMatchingFailure -> false
diff --git a/pretyping/matching.mli b/pretyping/matching.mli
index 2f666880..e6065c68 100644
--- a/pretyping/matching.mli
+++ b/pretyping/matching.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: matching.mli,v 1.3.2.2 2005/01/21 16:42:37 herbelin Exp $ i*)
+(*i $Id: matching.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -39,11 +39,10 @@ val is_matching : constr_pattern -> constr -> bool
 
 val matches_conv :env -> Evd.evar_map -> constr_pattern -> constr -> patvar_map
 
-(* To skip to the next occurrence *)
-exception NextOccurrence of int
-
-(* Tries to match a **closed** subterm of [c] with [pat] *)
-val sub_match : int -> constr_pattern -> constr -> patvar_map * constr
+(* [match_subterm n pat c] returns the substitution and the context
+   corresponding to the [n+1]th **closed** subterm of [c] matching [pat];
+   It raises PatternMatchingFailure if no such matching exists *)
+val match_subterm : int -> constr_pattern -> constr -> patvar_map * constr
 
 (* [is_matching_conv env sigma pat c] tells if [c] matches against [pat]
    up to conversion for constants in patterns *)
diff --git a/pretyping/pattern.ml b/pretyping/pattern.ml
index f58a12c6..390b884c 100644
--- a/pretyping/pattern.ml
+++ b/pretyping/pattern.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pattern.ml,v 1.24.2.2 2004/11/26 17:51:52 herbelin Exp $ *)
+(* $Id: pattern.ml 7732 2005-12-26 13:51:24Z herbelin $ *)
 
 open Util
 open Names
@@ -17,18 +17,13 @@ open Rawterm
 open Environ
 open Nametab
 open Pp
+open Mod_subst
 
 (* Metavariables *)
 
 type patvar_map = (patvar * constr) list
-let patvar_of_int n =
-  let p = if !Options.v7 & not (Options.do_translate ()) then "?" else "X"
-  in
-  Names.id_of_string (p ^ string_of_int n)
 let pr_patvar = pr_id
 
-let patvar_of_int_v7 n = Names.id_of_string ("?" ^ string_of_int n)
-
 (* Patterns *)
 
 type constr_pattern =
@@ -62,57 +57,6 @@ let rec occur_meta_pattern = function
   | PMeta _ | PSoApp _ -> true
   | PEvar _ | PVar _ | PRef _ | PRel _ | PSort _ | PFix _ | PCoFix _ -> false
 
-let rec subst_pattern subst pat = match pat with
-  | PRef ref ->
-      let ref' = subst_global subst ref in
-	if ref' == ref then pat else 
-	  PRef ref'
-  | PVar _ 
-  | PEvar _
-  | PRel _ -> pat
-  | PApp (f,args) ->
-      let f' = subst_pattern subst f in 
-      let args' = array_smartmap (subst_pattern subst) args in
-	if f' == f && args' == args then pat else
-	  PApp (f',args')
-  | PSoApp (i,args) ->
-      let args' = list_smartmap (subst_pattern subst) args in
-	if args' == args then pat else
-	  PSoApp (i,args')
-  | PLambda (name,c1,c2) ->
-      let c1' = subst_pattern subst c1 in
-      let c2' = subst_pattern subst c2 in
-	if c1' == c1 && c2' == c2 then pat else
-	  PLambda (name,c1',c2')
-  | PProd (name,c1,c2) ->
-      let c1' = subst_pattern subst c1 in
-      let c2' = subst_pattern subst c2 in
-	if c1' == c1 && c2' == c2 then pat else
-	  PProd (name,c1',c2')
-  | PLetIn (name,c1,c2) ->
-      let c1' = subst_pattern subst c1 in
-      let c2' = subst_pattern subst c2 in
-	if c1' == c1 && c2' == c2 then pat else
-	  PLetIn (name,c1',c2')
-  | PSort _ 
-  | PMeta _ -> pat
-  | PCase (cs,typ, c, branches) -> 
-      let typ' = option_smartmap (subst_pattern subst) typ in 
-      let c' = subst_pattern subst c in
-      let branches' = array_smartmap (subst_pattern subst) branches in
-	if typ' == typ && c' == c && branches' == branches then pat else
-	  PCase(cs,typ', c', branches') 
-  | PFix fixpoint ->
-      let cstr = mkFix fixpoint in
-      let fixpoint' = destFix (subst_mps subst cstr) in
-	if fixpoint' == fixpoint then pat else
-	  PFix fixpoint'
-  | PCoFix cofixpoint ->
-      let cstr = mkCoFix cofixpoint in
-      let cofixpoint' = destCoFix (subst_mps subst cstr) in
-	if cofixpoint' == cofixpoint then pat else
-	  PCoFix cofixpoint'
-
 type constr_label =
   | ConstNode of constant
   | IndNode of inductive
@@ -121,33 +65,14 @@ type constr_label =
 
 exception BoundPattern;;
 
-let label_of_ref = function
-  | ConstRef sp     -> ConstNode sp
-  | IndRef sp       -> IndNode sp
-  | ConstructRef sp -> CstrNode sp
-  | VarRef id       -> VarNode id
-
-let ref_of_label = function
-  | ConstNode sp     -> ConstRef sp
-  | IndNode sp       -> IndRef sp
-  | CstrNode sp      -> ConstructRef sp
-  | VarNode id       -> VarRef id
-
-let subst_label subst cstl = 
-  let ref = ref_of_label cstl in
-  let ref' = subst_global subst ref in
-    if ref' == ref then cstl else
-      label_of_ref ref'
-      
-  
 let rec head_pattern_bound t =
   match t with
     | PProd (_,_,b)  -> head_pattern_bound b 
     | PLetIn (_,_,b) -> head_pattern_bound b 
     | PApp (c,args)  -> head_pattern_bound c
     | PCase (_,p,c,br) -> head_pattern_bound c
-    | PRef r         -> label_of_ref r
-    | PVar id        -> VarNode id
+    | PRef r         -> r
+    | PVar id        -> VarRef id
     | PEvar _ | PRel _ | PMeta _ | PSoApp _  | PSort _ | PFix _
 	-> raise BoundPattern
     (* Perhaps they were arguments, but we don't beta-reduce *)
@@ -155,10 +80,10 @@ let rec head_pattern_bound t =
     | PCoFix _ -> anomaly "head_pattern_bound: not a type"
 
 let head_of_constr_reference c = match kind_of_term c with
-  | Const sp -> ConstNode sp
-  | Construct sp -> CstrNode sp
-  | Ind sp -> IndNode sp
-  | Var id -> VarNode id
+  | Const sp -> ConstRef sp
+  | Construct sp -> ConstructRef sp
+  | Ind sp -> IndRef sp
+  | Var id -> VarRef id
   | _ -> anomaly "Not a rigid reference"
 
 let rec pattern_of_constr t =
@@ -168,7 +93,7 @@ let rec pattern_of_constr t =
     | Var id -> PVar id
     | Sort (Prop c) -> PSort (RProp c)
     | Sort (Type _) -> PSort (RType None)
-    | Cast (c,_)      -> pattern_of_constr c
+    | Cast (c,_,_)      -> pattern_of_constr c
     | LetIn (na,c,_,b) -> PLetIn (na,pattern_of_constr c,pattern_of_constr b)
     | Prod (na,c,b)   -> PProd (na,pattern_of_constr c,pattern_of_constr b)
     | Lambda (na,c,b) -> PLambda (na,pattern_of_constr c,pattern_of_constr b)
@@ -198,9 +123,61 @@ let rec inst lvar = function
   (* Non recursive *)
   | (PEvar _ | PRel _ | PRef _  | PSort _  | PMeta _ as x) -> x 
   (* Bound to terms *)
-  | (PFix _ | PCoFix _ as r) ->
+  | (PFix _ | PCoFix _) ->
       error ("Not instantiable pattern")
 
+let rec subst_pattern subst pat = match pat with
+  | PRef ref ->
+      let ref',t = subst_global subst ref in
+	if ref' == ref then pat else
+	 pattern_of_constr t
+  | PVar _ 
+  | PEvar _
+  | PRel _ -> pat
+  | PApp (f,args) ->
+      let f' = subst_pattern subst f in 
+      let args' = array_smartmap (subst_pattern subst) args in
+	if f' == f && args' == args then pat else
+	  PApp (f',args')
+  | PSoApp (i,args) ->
+      let args' = list_smartmap (subst_pattern subst) args in
+	if args' == args then pat else
+	  PSoApp (i,args')
+  | PLambda (name,c1,c2) ->
+      let c1' = subst_pattern subst c1 in
+      let c2' = subst_pattern subst c2 in
+	if c1' == c1 && c2' == c2 then pat else
+	  PLambda (name,c1',c2')
+  | PProd (name,c1,c2) ->
+      let c1' = subst_pattern subst c1 in
+      let c2' = subst_pattern subst c2 in
+	if c1' == c1 && c2' == c2 then pat else
+	  PProd (name,c1',c2')
+  | PLetIn (name,c1,c2) ->
+      let c1' = subst_pattern subst c1 in
+      let c2' = subst_pattern subst c2 in
+	if c1' == c1 && c2' == c2 then pat else
+	  PLetIn (name,c1',c2')
+  | PSort _ 
+  | PMeta _ -> pat
+  | PCase (cs,typ, c, branches) -> 
+      let typ' = option_smartmap (subst_pattern subst) typ in 
+      let c' = subst_pattern subst c in
+      let branches' = array_smartmap (subst_pattern subst) branches in
+	if typ' == typ && c' == c && branches' == branches then pat else
+	  PCase(cs,typ', c', branches') 
+  | PFix fixpoint ->
+      let cstr = mkFix fixpoint in
+      let fixpoint' = destFix (subst_mps subst cstr) in
+	if fixpoint' == fixpoint then pat else
+	  PFix fixpoint'
+  | PCoFix cofixpoint ->
+      let cstr = mkCoFix cofixpoint in
+      let cofixpoint' = destCoFix (subst_mps subst cstr) in
+	if cofixpoint' == cofixpoint then pat else
+	  PCoFix cofixpoint'
+
+
 let instantiate_pattern = inst
 
 let rec pat_of_raw metas vars = function
@@ -230,30 +207,25 @@ let rec pat_of_raw metas vars = function
       PSort s
   | RHole _ ->
       PMeta None
-  | RCast (_,c,t) ->
+  | RCast (_,c,_,t) ->
       Options.if_verbose
         Pp.warning "Cast not taken into account in constr pattern";
       pat_of_raw metas vars c
-  | ROrderedCase (_,st,po,c,br,_) ->
-      PCase ((None,st),option_app (pat_of_raw metas vars) po,
-             pat_of_raw metas vars c,
-             Array.map (pat_of_raw metas vars) br)
   | RIf (_,c,(_,None),b1,b2) ->
       PCase ((None,IfStyle),None, pat_of_raw metas vars c,
              [|pat_of_raw metas vars b1; pat_of_raw metas vars b2|])
-  | RCases (loc,(po,_),[c,_],brs) ->
+  | RCases (loc,None,[c,_],brs) ->
       let sp =
 	match brs with
 	  | (_,_,[PatCstr(_,(ind,_),_,_)],_)::_ -> Some ind
 	  | _ -> None in
-      (* When po disappears: switch to rtn type *)
-      PCase ((sp,Term.RegularStyle),option_app (pat_of_raw metas vars) po,
+      PCase ((sp,Term.RegularStyle),None,
              pat_of_raw metas vars c,
              Array.init (List.length brs)
 	       (pat_of_raw_branch loc metas vars sp brs))
   | r ->
       let loc = loc_of_rawconstr r in
-      user_err_loc (loc,"pattern_of_rawconstr", Pp.str "Not supported pattern")
+      user_err_loc (loc,"pattern_of_rawconstr", Pp.str "Pattern not supported")
 
 and pat_of_raw_branch loc metas vars ind brs i =
   let bri = List.filter
diff --git a/pretyping/pattern.mli b/pretyping/pattern.mli
index cf0d4528..25a57ed2 100644
--- a/pretyping/pattern.mli
+++ b/pretyping/pattern.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pattern.mli,v 1.17.2.1 2004/07/16 19:30:45 herbelin Exp $ i*)
+(*i $Id: pattern.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -17,6 +17,7 @@ open Environ
 open Libnames
 open Nametab
 open Rawterm
+open Mod_subst
 (*i*)
 
 (* Pattern variables *)
@@ -24,10 +25,6 @@ open Rawterm
 type patvar_map = (patvar * constr) list
 val pr_patvar : patvar -> std_ppcmds
 
-(* Only for v7 parsing/printing *)
-val patvar_of_int : int -> patvar
-val patvar_of_int_v7 : int -> patvar
-
 (* Patterns *)
 
 type constr_pattern =
@@ -51,28 +48,18 @@ val occur_meta_pattern : constr_pattern -> bool
 
 val subst_pattern : substitution -> constr_pattern -> constr_pattern
 
-type constr_label =
-  | ConstNode of constant
-  | IndNode of inductive
-  | CstrNode of constructor
-  | VarNode of identifier
-
-val label_of_ref : global_reference -> constr_label
-
-val subst_label : substitution -> constr_label -> constr_label
-
 exception BoundPattern
 
 (* [head_pattern_bound t] extracts the head variable/constant of the
    type [t] or raises [BoundPattern] (even if a sort); it raises an anomaly
    if [t] is an abstraction *)
 
-val head_pattern_bound : constr_pattern -> constr_label
+val head_pattern_bound : constr_pattern -> global_reference
 
 (* [head_of_constr_reference c] assumes [r] denotes a reference and
    returns its label; raises an anomaly otherwise *)
 
-val head_of_constr_reference : Term.constr -> constr_label
+val head_of_constr_reference : Term.constr -> global_reference
 
 (* [pattern_of_constr c] translates a term [c] with metavariables into
    a pattern; currently, no destructor (Cases, Fix, Cofix) and no
diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml
index fee1522f..48295c92 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,v 1.25.2.2 2004/07/16 19:30:45 herbelin Exp $ *)
+(* $Id: pretype_errors.ml 8688 2006-04-07 15:08:12Z msozeau $ *)
 
 open Util
 open Stdpp
@@ -24,8 +24,12 @@ type pretype_error =
   | CantFindCaseType of constr
   (* Unification *)
   | OccurCheck of existential_key * constr
-  | NotClean of existential_key * constr * hole_kind
-  | UnsolvableImplicit of hole_kind
+  | NotClean of existential_key * constr * Evd.hole_kind
+  | UnsolvableImplicit of Evd.hole_kind
+  | CannotUnify of constr * constr
+  | CannotUnifyBindingType of constr * constr
+  | CannotGeneralize of constr
+  | NoOccurrenceFound of constr
   (* Pretyping *)
   | VarNotFound of identifier
   | UnexpectedType of constr * constr
@@ -33,6 +37,12 @@ type pretype_error =
 
 exception PretypeError of env * pretype_error
 
+let precatchable_exception = function
+  | Util.UserError _ | TypeError _ | PretypeError _
+  | Stdpp.Exc_located(_,(Util.UserError _ | TypeError _ |
+    Nametab.GlobalizationError _ | PretypeError _)) -> true
+  | _ -> false
+
 let nf_evar = Reductionops.nf_evar
 let j_nf_evar sigma j = 
   { uj_val = nf_evar sigma j.uj_val;
@@ -43,7 +53,7 @@ let tj_nf_evar sigma {utj_val=v;utj_type=t} =
   {utj_val=type_app (nf_evar sigma) v;utj_type=t}
 
 let env_ise sigma env =
-  let sign = named_context env in
+  let sign = named_context_val env in
   let ctxt = rel_context env in
   let env0 = reset_with_named_context sign env in
   Sign.fold_rel_context
@@ -126,6 +136,9 @@ let error_ill_typed_rec_body_loc loc env sigma i na jl tys =
      IllTypedRecBody (i,na,jv_nf_evar sigma jl,
                       Array.map (nf_evar sigma) tys))
 
+let error_not_a_type_loc loc env sigma j =
+  raise_located_type_error (loc, env, sigma, NotAType (j_nf_evar sigma j))
+
 (*s Implicit arguments synthesis errors. It is hard to find
     a precise location. *)
 
@@ -141,6 +154,12 @@ let error_not_clean env sigma ev c (loc,k) =
 let error_unsolvable_implicit loc env sigma e =
   raise_with_loc loc (PretypeError (env_ise sigma env, UnsolvableImplicit e))
 
+let error_cannot_unify env sigma (m,n) =
+  raise (PretypeError (env_ise sigma env,CannotUnify (m,n)))
+
+let error_cannot_coerce env sigma (m,n) =
+  raise (PretypeError (env_ise sigma env,CannotUnify (m,n)))
+
 (*s Ml Case errors *)
 
 let error_cant_find_case_type_loc loc env sigma expr =
diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli
index ebeff99d..3c78d48d 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,v 1.25.2.3 2004/07/16 19:30:45 herbelin Exp $ i*)
+(*i $Id: pretype_errors.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
 
 (*i*)
 open Pp
@@ -26,8 +26,12 @@ type pretype_error =
   | CantFindCaseType of constr
   (* Unification *)
   | OccurCheck of existential_key * constr
-  | NotClean of existential_key * constr * hole_kind
-  | UnsolvableImplicit of hole_kind
+  | NotClean of existential_key * constr * Evd.hole_kind
+  | UnsolvableImplicit of Evd.hole_kind
+  | CannotUnify of constr * constr
+  | CannotUnifyBindingType of constr * constr
+  | CannotGeneralize of constr
+  | NoOccurrenceFound of constr
   (* Pretyping *)
   | VarNotFound of identifier
   | UnexpectedType of constr * constr
@@ -35,6 +39,8 @@ type pretype_error =
 
 exception PretypeError of env * pretype_error
 
+val precatchable_exception : exn -> bool
+
 (* Presenting terms without solved evars *)
 val nf_evar :  Evd.evar_map -> constr -> constr
 val j_nf_evar :  Evd.evar_map -> unsafe_judgment -> unsafe_judgment
@@ -73,14 +79,22 @@ val error_ill_typed_rec_body_loc :
   loc -> env ->  Evd.evar_map ->
       int -> name array -> unsafe_judgment array -> types array -> 'b
 
+val error_not_a_type_loc :
+  loc -> env -> Evd.evar_map -> unsafe_judgment -> 'b
+
+val error_cannot_coerce : env -> Evd.evar_map -> constr * constr -> 'b
+
 (*s Implicit arguments synthesis errors *)
 
 val error_occur_check : env ->  Evd.evar_map -> existential_key -> constr -> 'b
 
 val error_not_clean :
-  env ->  Evd.evar_map -> existential_key -> constr -> loc * hole_kind -> 'b
+  env -> Evd.evar_map -> existential_key -> constr -> loc * Evd.hole_kind -> 'b
+
+val error_unsolvable_implicit :
+  loc -> env -> Evd.evar_map -> Evd.hole_kind -> 'b
 
-val error_unsolvable_implicit : loc -> env -> Evd.evar_map -> hole_kind -> 'b
+val error_cannot_unify : env -> Evd.evar_map -> constr * constr -> 'b
 
 (*s Ml Case errors *)
 
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index bb0e74bb..2d1e297f 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pretyping.ml,v 1.123.2.5 2005/11/29 21:40:52 letouzey Exp $ *)
+(* $Id: pretyping.ml 8695 2006-04-10 16:33:52Z msozeau $ *)
 
 open Pp
 open Util
@@ -20,6 +20,7 @@ open Environ
 open Type_errors
 open Typeops
 open Libnames
+open Nameops
 open Classops
 open List
 open Recordops 
@@ -27,86 +28,18 @@ open Evarutil
 open Pretype_errors
 open Rawterm
 open Evarconv
-open Coercion
 open Pattern
 open Dyn
 
+type typing_constraint = OfType of types option | IsType
+type var_map = (identifier * unsafe_judgment) list
+type unbound_ltac_var_map = (identifier * identifier option) list
 
 (************************************************************************)
 (* This concerns Cases *)
 open Declarations
 open Inductive
 open Inductiveops
-open Instantiate
-
-let lift_context n l = 
-  let k = List.length l in 
-  list_map_i (fun i (name,c) -> (name,liftn n (k-i) c)) 0 l
-
-let transform_rec loc env sigma (pj,c,lf) indt = 
-  let p = pj.uj_val in
-  let (indf,realargs) = dest_ind_type indt in
-  let (ind,params) = dest_ind_family indf in
-  let (mib,mip) = lookup_mind_specif env ind in
-  let recargs = mip.mind_recargs in
-  let mI = mkInd ind in
-  let ci = make_default_case_info env (if Options.do_translate() then RegularStyle else MatchStyle) ind in
-  let nconstr = Array.length mip.mind_consnames in
-  if Array.length lf <> nconstr then 
-    (let cj = {uj_val=c; uj_type=mkAppliedInd indt} in
-     error_number_branches_loc loc env sigma cj nconstr);
-  let tyi = snd ind in
-  if mis_is_recursive_subset [tyi] recargs then
-    let dep =
-      is_dependent_elimination env (nf_evar sigma pj.uj_type) indf in 
-    let init_depFvec i = if i = tyi then Some(dep,mkRel 1) else None in
-    let depFvec = Array.init mib.mind_ntypes init_depFvec in
-    (* build now the fixpoint *)
-    let lnames,_ = get_arity env indf in
-    let nar = List.length lnames in
-    let nparams = mip.mind_nparams in
-    let constrs = get_constructors env (lift_inductive_family (nar+2) indf) in
-    let branches = 
-      array_map3
-	(fun f t reca -> 
-	   whd_beta
-             (Indrec.make_rec_branch_arg env sigma
-                (nparams,depFvec,nar+1)
-                f t reca))
-        (Array.map (lift (nar+2)) lf) constrs (dest_subterms recargs) 
-    in 
-    let deffix = 
-      it_mkLambda_or_LetIn_name env
-	(lambda_create env
-	   (applist (mI,List.append (List.map (lift (nar+1)) params)
-                       (extended_rel_list 0 lnames)),
-            mkCase (ci, lift (nar+2) p, mkRel 1, branches)))
-        (lift_rel_context 1 lnames) 
-    in
-    if noccurn 1 deffix then 
-      whd_beta (applist (pop deffix,realargs@[c]))
-    else
-      let ind = applist (mI,(List.append 
-			     (List.map (lift nar) params)
-			     (extended_rel_list 0 lnames))) in
-      let typPfix = 
-	it_mkProd_or_LetIn_name env
-	  (prod_create env 
-	     (ind,
-	      (if dep then
-		 let ext_lnames = (Anonymous,None,ind)::lnames in
-		 let args = extended_rel_list 0 ext_lnames in
-		 whd_beta (applist (lift (nar+1) p, args))
-	       else
-		 let args = extended_rel_list 1 lnames in
-		 whd_beta (applist (lift (nar+1) p, args)))))
-          lnames in
-      let fix =
-        mkFix (([|nar|],0),
-	       ([|Name(id_of_string "F")|],[|typPfix|],[|deffix|])) in
-      applist (fix,realargs@[c])
-  else
-    mkCase (ci, p, c, lf)
 
 (************************************************************************)
 
@@ -114,909 +47,667 @@ let transform_rec loc env sigma (pj,c,lf) indt =
 let ((constr_in : constr -> Dyn.t),
      (constr_out : Dyn.t -> constr)) = create "constr"
 
-let mt_evd = Evd.empty
-
-let vect_lift_type = Array.mapi (fun i t -> type_app (lift i) t)
-
-(* Utilisé pour inférer le prédicat des Cases *)
-(* Semble exagérement fort *)
-(* Faudra préférer une unification entre les types de toutes les clauses *)
-(* et autoriser des ? à rester dans le résultat de l'unification *)
-
-let evar_type_fixpoint loc env isevars lna lar vdefj =
-  let lt = Array.length vdefj in 
-    if Array.length lar = lt then 
-      for i = 0 to lt-1 do 
-        if not (the_conv_x_leq env isevars
-		  (vdefj.(i)).uj_type
-		  (lift lt lar.(i))) then
-          error_ill_typed_rec_body_loc loc env (evars_of isevars)
-            i lna vdefj lar
-      done
-
-let check_branches_message loc env isevars c (explft,lft) = 
-  for i = 0 to Array.length explft - 1 do
-    if not (the_conv_x_leq env isevars lft.(i) explft.(i)) then 
-      let sigma = evars_of isevars in
-      error_ill_formed_branch_loc loc env sigma c i lft.(i) explft.(i)
-  done
-
-(* coerce to tycon if any *)
-let inh_conv_coerce_to_tycon loc env isevars j = function
-   | None -> j
-   | Some typ -> inh_conv_coerce_to loc env isevars j typ
-
-let push_rels vars env = List.fold_right push_rel vars env
-
-(*
-let evar_type_case isevars env ct pt lft p c =
-  let (mind,bty,rslty) = type_case_branches env (evars_of isevars) ct pt p c
-  in check_branches_message isevars env (c,ct) (bty,lft); (mind,rslty)
-*)
-
-let strip_meta id = (* For Grammar v7 compatibility *)
-  let s = string_of_id id in
-  if s.[0]='$' then id_of_string (String.sub s 1 (String.length s - 1))
-  else id
-
-let pretype_id loc env (lvar,unbndltacvars) id =
-  let id = strip_meta id in (* May happen in tactics defined by Grammar *)
-  try
-    let (n,typ) = lookup_rel_id id (rel_context env) in
-    { uj_val  = mkRel n; uj_type = type_app (lift n) typ }
-  with Not_found ->
-  try
-    List.assoc id lvar
-  with Not_found ->
-  try
-    let (_,_,typ) = lookup_named id env in
-    { uj_val  = mkVar id; uj_type = typ }
-  with Not_found ->
-  try (* To build a nicer ltac error message *)
-    match List.assoc id unbndltacvars with
-      | None -> user_err_loc (loc,"",
-	  str (string_of_id id ^ " ist not bound to a term"))
-      | Some id0 -> Pretype_errors.error_var_not_found_loc loc id0
-  with Not_found ->
-    error_var_not_found_loc loc id
-
-(* make a dependent predicate from an undependent one *)
-
-let make_dep_of_undep env (IndType (indf,realargs)) pj =
-  let n = List.length realargs in
-  let rec decomp n p =
-    if n=0 then p else
-      match kind_of_term p with
-	| Lambda (_,_,c) -> decomp (n-1) c
-	| _ -> decomp (n-1) (applist (lift 1 p, [mkRel 1])) 
-  in
-  let sign,s = decompose_prod_n n pj.uj_type in
-  let ind = build_dependent_inductive env indf in
-  let s' = mkProd (Anonymous, ind, s) in
-  let ccl = lift 1 (decomp n pj.uj_val) in
-  let ccl' = mkLambda (Anonymous, ind, ccl) in
-  {uj_val=lam_it ccl' sign; uj_type=prod_it s' sign} 
-
-(*************************************************************************)
-(* Main pretyping function                                               *)
-
-let pretype_ref isevars env ref = 
-  let c = constr_of_reference ref in
-  make_judge c (Retyping.get_type_of env Evd.empty c)
-
-let pretype_sort = function
-  | RProp c -> judge_of_prop_contents c
-  | RType _ -> judge_of_new_Type ()
-
-(* [pretype tycon env isevars lvar lmeta cstr] attempts to type [cstr] *)
-(* in environment [env], with existential variables [(evars_of isevars)] and *)
-(* the type constraint tycon *)
-let rec pretype tycon env isevars lvar = function
-
-  | RRef (loc,ref) ->
-      inh_conv_coerce_to_tycon loc env isevars
-	(pretype_ref isevars env ref)
-	tycon
-
-  | RVar (loc, id) ->
-      inh_conv_coerce_to_tycon loc env isevars
-	(pretype_id loc env lvar id)
-	tycon
-
-  | REvar (loc, ev, instopt) ->
-      (* Ne faudrait-il pas s'assurer que hyps est bien un
-      sous-contexte du contexte courant, et qu'il n'y a pas de Rel "caché" *)
-      let hyps = (Evd.map (evars_of isevars) ev).evar_hyps in
-      let args = match instopt with
-        | None -> instance_from_named_context hyps
-        | Some inst -> failwith "Evar subtitutions not implemented" in
-      let c = mkEvar (ev, args) in
-      let j = (Retyping.get_judgment_of env (evars_of isevars) c) in
-      inh_conv_coerce_to_tycon loc env isevars j tycon
-
-  | RPatVar (loc,(someta,n)) -> 
-      anomaly "Found a pattern variable in a rawterm to type"
-	   
-  | RHole (loc,k) ->
-      (match tycon with
-	 | Some ty ->
-	     { uj_val = new_isevar isevars env (loc,k) ty; uj_type = ty }
-	 | None -> error_unsolvable_implicit loc env (evars_of isevars) k)
-
-  | RRec (loc,fixkind,names,bl,lar,vdef) ->
-      let rec type_bl env ctxt = function
-          [] -> ctxt
-        | (na,None,ty)::bl ->
-            let ty' = pretype_type empty_valcon env isevars lvar ty in
-            let dcl = (na,None,ty'.utj_val) in
-            type_bl (push_rel dcl env) (add_rel_decl dcl ctxt) bl
-        | (na,Some bd,ty)::bl ->
-            let ty' = pretype_type empty_valcon env isevars lvar ty in
-            let bd' = pretype (mk_tycon ty'.utj_val) env isevars lvar ty in
-            let dcl = (na,Some bd'.uj_val,ty'.utj_val) in
-            type_bl (push_rel dcl env) (add_rel_decl dcl ctxt) bl in
-      let ctxtv = Array.map (type_bl env empty_rel_context) bl in
-      let larj =
-        array_map2
-          (fun e ar ->
-            pretype_type empty_valcon (push_rel_context e env) isevars lvar ar)
-          ctxtv lar in
-      let lara = Array.map (fun a -> a.utj_val) larj in
-      let ftys = array_map2 (fun e a -> it_mkProd_or_LetIn a e) ctxtv lara in
-      let nbfix = Array.length lar in
-      let names = Array.map (fun id -> Name id) names in
-      (* Note: bodies are not used by push_rec_types, so [||] is safe *)
-      let newenv = push_rec_types (names,ftys,[||]) env in
-      let vdefj =
-	array_map2_i 
-	  (fun i ctxt def ->
-            (* we lift nbfix times the type in tycon, because of
-	     * the nbfix variables pushed to newenv *)
-            let (ctxt,ty) =
-              decompose_prod_n_assum (rel_context_length ctxt)
-                (lift nbfix ftys.(i)) in
-            let nenv = push_rel_context ctxt newenv in
-            let j = pretype (mk_tycon ty) nenv isevars lvar def in
-            { uj_val = it_mkLambda_or_LetIn j.uj_val ctxt;
-              uj_type = it_mkProd_or_LetIn j.uj_type ctxt })
-          ctxtv vdef in
-      evar_type_fixpoint loc env isevars names ftys vdefj;
-      let fixj =
-	match fixkind with
-	  | RFix (vn,i as vni) ->
-	      let fix = (vni,(names,ftys,Array.map j_val vdefj)) in
-	      (try check_fix env fix with e -> Stdpp.raise_with_loc loc e);
-	      make_judge (mkFix fix) ftys.(i)
-	  | RCoFix i -> 
-	      let cofix = (i,(names,ftys,Array.map j_val vdefj)) in
-	      (try check_cofix env cofix with e -> Stdpp.raise_with_loc loc e);
-	      make_judge (mkCoFix cofix) ftys.(i) in
-      inh_conv_coerce_to_tycon loc env isevars fixj tycon
-
-  | RSort (loc,s) ->
-      inh_conv_coerce_to_tycon loc env isevars (pretype_sort s) tycon
-
-  | RApp (loc,f,args) -> 
-      let fj = pretype empty_tycon env isevars lvar f in
-      let floc = loc_of_rawconstr f in
-      let rec apply_rec env n resj = function
-	| [] -> resj
-	| c::rest ->
-	    let argloc = loc_of_rawconstr c in
-	    let resj = inh_app_fun env isevars resj in
-            let resty =
-              whd_betadeltaiota env (evars_of isevars) resj.uj_type in
-      	    match kind_of_term resty with
-	      | Prod (na,c1,c2) ->
-		  let hj = pretype (mk_tycon c1) env isevars lvar c in
-		  let newresj =
-      		    { uj_val = applist (j_val resj, [j_val hj]);
-		      uj_type = subst1 hj.uj_val c2 } in
-		  apply_rec env (n+1) newresj rest
-
-	      | _ ->
-		  let hj = pretype empty_tycon env isevars lvar c in
-		  error_cant_apply_not_functional_loc 
-		    (join_loc floc argloc) env (evars_of isevars)
-	      	    resj [hj]
-
-      in let resj = apply_rec env 1 fj args in
-      (*
-	let apply_one_arg (floc,tycon,jl) c =
-	let (dom,rng) = split_tycon floc env isevars tycon in
-	let cj = pretype dom env isevars lvar c in
-	let rng_tycon = option_app (subst1 cj.uj_val) rng in
-	let argloc = loc_of_rawconstr c in
-	(join_loc floc argloc,rng_tycon,(argloc,cj)::jl)  in
-	let _,_,jl =
-	List.fold_left apply_one_arg (floc,mk_tycon j.uj_type,[]) args in
-	let jl = List.rev jl in
-	let resj = inh_apply_rel_list loc env isevars jl (floc,j) tycon in
-      *)
-      inh_conv_coerce_to_tycon loc env isevars resj tycon
-
-  | RLambda(loc,name,c1,c2)      ->
-      let (name',dom,rng) = split_tycon loc env isevars tycon in
-      let dom_valcon = valcon_of_tycon dom in
-      let j = pretype_type dom_valcon env isevars lvar c1 in
-      let var = (name,None,j.utj_val) in
-      let j' = pretype rng (push_rel var env) isevars lvar c2 in 
-      judge_of_abstraction env name j j'
-
-  | RProd(loc,name,c1,c2)        ->
-      let j = pretype_type empty_valcon env isevars lvar c1 in
-      let var = (name,j.utj_val) in
-      let env' = push_rel_assum var env in
-      let j' = pretype_type empty_valcon env' isevars lvar c2 in
-      let resj =
-	try judge_of_product env name j j'
-	with TypeError _ as e -> Stdpp.raise_with_loc loc e in
-      inh_conv_coerce_to_tycon loc env isevars resj tycon
-	
-  | RLetIn(loc,name,c1,c2)      ->
-      let j = pretype empty_tycon env isevars lvar c1 in
-      let t = Evarutil.refresh_universes j.uj_type in
-      let var = (name,Some j.uj_val,t) in
-        let tycon = option_app (lift 1) tycon in
-      let j' = pretype tycon (push_rel var env) isevars lvar c2 in
-      { uj_val = mkLetIn (name, j.uj_val, t, j'.uj_val) ;
-	uj_type = type_app (subst1 j.uj_val) j'.uj_type }
-
-  | RLetTuple (loc,nal,(na,po),c,d) ->
-      let cj = pretype empty_tycon env isevars lvar c in
-      let (IndType (indf,realargs) as indt) = 
-	try find_rectype env (evars_of isevars) cj.uj_type
-	with Not_found ->
-	  let cloc = loc_of_rawconstr c in
-	  error_case_not_inductive_loc cloc env (evars_of isevars) cj 
-      in
-      let cstrs = get_constructors env indf in
-      if Array.length cstrs <> 1 then
-        user_err_loc (loc,"",str "Destructing let is only for inductive types with one constructor");
-      let cs = cstrs.(0) in
-      if List.length nal <> cs.cs_nargs then
-        user_err_loc (loc,"", str "Destructing let on this type expects " ++ int cs.cs_nargs ++ str " variables");
-      let fsign = List.map2 (fun na (_,c,t) -> (na,c,t))
-        (List.rev nal) cs.cs_args in
-      let env_f = push_rels fsign env in
-      (* Make dependencies from arity signature impossible *)
-      let arsgn,_ = get_arity env indf in
-      let arsgn = List.map (fun (_,b,t) -> (Anonymous,b,t)) arsgn in
-      let psign = (na,None,build_dependent_inductive env indf)::arsgn in
-      let nar = List.length arsgn in
-      (match po with
-	 | 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 psign = make_arity_signature env true indf in (* with names *)
-	     let p = it_mkLambda_or_LetIn ccl psign in
-             let inst = 
-	       (Array.to_list cs.cs_concl_realargs)
-	       @[build_dependent_constructor cs] in
-	     let lp = lift cs.cs_nargs p in
-             let fty = hnf_lam_applist env (evars_of isevars) lp inst in
-	     let fj = pretype (mk_tycon fty) env_f isevars lvar d in
-	     let f = it_mkLambda_or_LetIn fj.uj_val fsign in
-	     let v =
-	       let mis,_ = dest_ind_family indf in
-	       let ci = make_default_case_info env LetStyle mis in
-	       mkCase (ci, p, cj.uj_val,[|f|]) in 
-             let cs = build_dependent_constructor cs in
-	     { uj_val = v; uj_type = substl (realargs@[cj.uj_val]) ccl }
-
-	 | None -> 
-             let tycon = option_app (lift 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 =
-               if noccur_between 1 cs.cs_nargs ccl then
-                 lift (- cs.cs_nargs) ccl 
-               else
-                 error_cant_find_case_type_loc loc env (evars_of isevars) 
-                   cj.uj_val in
-             let p = it_mkLambda_or_LetIn (lift (nar+1) ccl) psign in
-	     let v =
-	       let mis,_ = dest_ind_family indf in
-	       let ci = make_default_case_info env LetStyle mis in
-	       mkCase (ci, p, cj.uj_val,[|f|] ) 
-	     in
-	     { uj_val = v; uj_type = ccl })
-
-  (* Special Case for let constructions to avoid exponential behavior *)      
-  | ROrderedCase (loc,st,po,c,[|f|],xx) when st <> MatchStyle ->
-      let cj = pretype empty_tycon env isevars lvar c in
-      let (IndType (indf,realargs) as indt) = 
-	try find_rectype env (evars_of isevars) cj.uj_type
-	with Not_found ->
-	  let cloc = loc_of_rawconstr c in
-	  error_case_not_inductive_loc cloc env (evars_of isevars) cj 
-      in
-      let j = match po with
-	 | Some p ->
-             let pj = pretype empty_tycon env isevars lvar p in
-             let dep = is_dependent_elimination env pj.uj_type indf in
-             let ar =
-               arity_of_case_predicate env indf dep (Type (new_univ())) in
-             let _ = the_conv_x_leq env isevars pj.uj_type ar in
-	     let pj = j_nf_evar (evars_of isevars) pj in
-	     let pj = if dep then pj else make_dep_of_undep env indt pj in
-	     let (bty,rsty) = 
-	       Indrec.type_rec_branches 
-		 false env (evars_of isevars) indt pj.uj_val cj.uj_val 
-	     in
-	     if Array.length bty <> 1 then
-	       error_number_branches_loc 
-		 loc env (evars_of isevars) cj (Array.length bty);
-	     let fj = 
-	       let tyc = bty.(0) in 
-	       pretype (mk_tycon tyc) env isevars lvar f 
-	     in
-	     let fv = j_val fj in
-	     let ft = fj.uj_type in
-	     check_branches_message loc env isevars cj.uj_val (bty,[|ft|]);
-	     let v =
-	       let mis,_ = dest_ind_family indf in
-	       let ci = make_default_case_info env st mis in
-	       mkCase (ci, (nf_betaiota pj.uj_val), cj.uj_val,[|fv|])
-	     in 
-	     { uj_val = v;  uj_type = rsty }
-
-	 | None -> 
-             (* get type information from type of branches *)
-	     let expbr = Cases.branch_scheme env isevars false indf in
-	     if Array.length expbr <> 1 then
-	       error_number_branches_loc loc env (evars_of isevars) 
-		 cj (Array.length expbr);
-             let expti = expbr.(0) in
-	     let fj = pretype (mk_tycon expti) env isevars lvar f in
-	     let use_constraint () =
-               (* get type information from constraint *)
-               (* warning: if the constraint comes from an evar type, it *)
-               (* may be Type while Prop or Set would be expected *)
-	       match tycon with
-		 | Some pred ->
-		     let arsgn = make_arity_signature env true indf in
-                     let pred = lift (List.length arsgn) pred in
-  		     let pred = 
-                       it_mkLambda_or_LetIn (nf_evar (evars_of isevars) pred)
-			 arsgn in
-                     false, pred
-	         | None ->
-                     let sigma = evars_of isevars in
-                     error_cant_find_case_type_loc loc env sigma cj.uj_val
-	     in
-             let ok, p =
-	       try
-		 let pred = 
-		   Cases.pred_case_ml 
-		     env (evars_of isevars) false indt (0,fj.uj_type) 
-		 in 
-		 if has_undefined_isevars isevars pred then
-		   use_constraint ()
-		 else
-		   true, pred
-	       with Cases.NotInferable _ ->
-		 use_constraint ()
-	     in 
-	     let p = nf_evar (evars_of isevars) p in
-	     let (bty,rsty) =
-	       Indrec.type_rec_branches
-		 false env (evars_of isevars) indt p cj.uj_val 
-	     in
-	     let _ = option_app (the_conv_x_leq env isevars rsty) tycon in
-	     let fj = 
-	       if ok then fj 
-	       else pretype (mk_tycon bty.(0)) env isevars lvar f 
-	     in
-	     let fv = fj.uj_val in
-	     let ft = fj.uj_type in
-	     let v =
-	       let mis,_ = dest_ind_family indf in
-	       let ci = make_default_case_info env st mis in
-	       mkCase (ci, (nf_betaiota p), cj.uj_val,[|fv|] ) 
-	     in
-	     { uj_val = v; uj_type = rsty } in
-
-      (* Build the LetTuple form for v8 *)
-      let c =
-        let (ind,params) = dest_ind_family indf in
-        let rtntypopt, indnalopt = match po with
-          | None -> None, (Anonymous,None)
-          | Some p ->
-              let pj = pretype empty_tycon env isevars lvar p in
-              let dep = is_dependent_elimination env pj.uj_type indf in
-              let rec decomp_lam_force n avoid l p =
-                (* avoid is not exhaustive ! *)
-                if n = 0 then (List.rev l,p,avoid) else
-                  match p with
-                    | RLambda (_,(Name id as na),_,c) -> 
-                        decomp_lam_force (n-1) (id::avoid) (na::l) c
-                    | RLambda (_,(Anonymous as na),_,c) ->
-                        decomp_lam_force (n-1) avoid (na::l) c
-                    | _ ->
-                        let x = Nameops.next_ident_away (id_of_string "x") avoid in
-                        decomp_lam_force (n-1) (x::avoid) (Name x :: l) 
-                          (* eta-expansion *)
-                          (RApp (dummy_loc,p, [RVar (dummy_loc,x)])) in
-              let (nal,p,avoid) = 
-                decomp_lam_force (List.length realargs) [] [] p in
-              let na,rtntyp,_ = 
-                if dep then decomp_lam_force 1 avoid [] p
-                else [Anonymous],p,[] in
-              let intyp =
-                if List.for_all
-                  (function
-                    | Anonymous -> true
-                    | Name id -> not (occur_rawconstr id rtntyp)) nal
-                then (* No dependency in realargs *)
-                  None
-                else
-                  let args = List.map (fun _ -> Anonymous) params @ nal in
-                  Some (dummy_loc,ind,args) in
-              (Some rtntyp,(List.hd na,intyp)) in
-        let cs = (get_constructors env indf).(0) in
-        match indnalopt with
-          | (na,None) -> (* Represented as a let *)
-              let rec decomp_lam_force n avoid l p =
-                if n = 0 then (List.rev l,p) else
-                  match p with
-                    | RLambda (_,(Name id as na),_,c) -> 
-                        decomp_lam_force (n-1) (id::avoid) (na::l) c
-                    | RLambda (_,(Anonymous as na),_,c) -> 
-                        decomp_lam_force (n-1) avoid (na::l) c
-                    | _ ->
-                        let x = Nameops.next_ident_away (id_of_string "x") avoid in
-                        decomp_lam_force (n-1) (x::avoid) (Name x :: l) 
-                          (* eta-expansion *)
-                          (let a = RVar (dummy_loc,x) in
-                          match p with
-                            | RApp (loc,p,l) -> RApp (loc,p,l@[a])
-                            | _ -> (RApp (dummy_loc,p,[a]))) in
-              let (nal,d) = decomp_lam_force cs.cs_nargs [] [] f in
-              RLetTuple (loc,nal,(na,rtntypopt),c,d)
-          | _ -> (* Represented as a match *)
-            let detype_eqn constr construct_nargs branch =
-              let name_cons = function 
-                | Anonymous -> fun l -> l
-                | Name id -> fun l -> id::l in
-              let make_pat na avoid b ids =
-                PatVar (dummy_loc,na),
-                name_cons na avoid,name_cons na ids
-              in
-              let rec buildrec ids patlist avoid n b =
-                if n=0 then
-                  (dummy_loc, ids, 
-                  [PatCstr(dummy_loc, constr, List.rev patlist,Anonymous)],
-                  b)
-                else
-                  match b with
-	            | RLambda (_,x,_,b) -> 
-	                let pat,new_avoid,new_ids = make_pat x avoid b ids in
-                        buildrec new_ids (pat::patlist) new_avoid (n-1) b
-                          
-	            | RLetIn (_,x,_,b) -> 
-	                let pat,new_avoid,new_ids = make_pat x avoid b ids in
-                        buildrec new_ids (pat::patlist) new_avoid (n-1) b
-                          
-	            | RCast (_,c,_) ->    (* Oui, il y a parfois des cast *)
-	                buildrec ids patlist avoid n c
-                        
-	            | _ -> (* eta-expansion *)
-                        (* nommage de la nouvelle variable *)
-                        let id = Nameops.next_ident_away (id_of_string "x") avoid in
-	                let new_b = RApp (dummy_loc, b, [RVar(dummy_loc,id)])in
-                        let pat,new_avoid,new_ids =
-	                  make_pat (Name id) avoid new_b ids in
-	                buildrec new_ids (pat::patlist) new_avoid (n-1) new_b
-	                  
-              in 
-              buildrec [] [] [] construct_nargs branch in
-            let eqn = detype_eqn (ind,1) cs.cs_nargs f in
-            RCases (loc,(po,ref rtntypopt),[c,ref indnalopt],[eqn])
-      in
-      xx := Some c;
-      (* End building the v8 syntax *)
-      j
+(** Miscellaneous interpretation functions *)
+  
+let interp_sort = function
+  | RProp c -> Prop c
+  | RType _ -> new_Type_sort ()
+      
+let interp_elimination_sort = function
+  | RProp Null -> InProp
+  | RProp Pos  -> InSet
+  | RType _ -> InType
 
-  | RIf (loc,c,(na,po),b1,b2) ->
-      let cj = pretype empty_tycon env isevars lvar c in
-      let (IndType (indf,realargs) as indt) = 
-	try find_rectype env (evars_of isevars) cj.uj_type
+module type S = 
+sig
+
+  module Cases : Cases.S
+  
+  (* Allow references to syntaxically inexistent variables (i.e., if applied on an inductive) *)
+  val allow_anonymous_refs : bool ref
+
+  (* Generic call to the interpreter from rawconstr to open_constr, leaving
+     unresolved holes as evars and returning the typing contexts of
+     these evars. Work as [understand_gen] for the rest. *)
+  
+  val understand_tcc :
+    evar_map -> env -> ?expected_type:types -> rawconstr -> open_constr
+
+  val understand_tcc_evars :
+    evar_defs ref -> env -> typing_constraint -> rawconstr -> constr
+    
+  (* More general entry point with evars from ltac *)
+    
+  (* Generic call to the interpreter from rawconstr to constr, failing
+     unresolved holes in the rawterm cannot be instantiated.
+     
+     In [understand_ltac sigma env ltac_env constraint c],
+     
+     sigma : initial set of existential variables (typically dependent subgoals)
+     ltac_env : partial substitution of variables (used for the tactic language)
+     constraint : tell if interpreted as a possibly constrained term or a type 
+  *)
+    
+  val understand_ltac :
+    evar_map -> env -> var_map * unbound_ltac_var_map ->
+    typing_constraint -> rawconstr -> evar_defs * constr
+    
+  (* Standard call to get a constr from a rawconstr, resolving implicit args *)
+    
+  val understand : evar_map -> env -> ?expected_type:Term.types ->
+    rawconstr -> constr
+    
+  (* Idem but the rawconstr is intended to be a type *)
+    
+  val understand_type : evar_map -> env -> rawconstr -> constr
+    
+  (* A generalization of the two previous case *)
+    
+  val understand_gen : typing_constraint -> evar_map -> env -> 
+    rawconstr -> constr
+    
+  (* Idem but returns the judgment of the understood term *)
+    
+  val understand_judgment : evar_map -> env -> rawconstr -> unsafe_judgment
+
+  (* Idem but do not fail on unresolved evars *)
+
+  val understand_judgment_tcc : evar_defs ref -> env -> rawconstr -> unsafe_judgment
+
+  (*i*)
+  (* Internal of Pretyping...
+   * Unused outside, but useful for debugging
+   *)
+  val pretype : 
+    type_constraint -> env -> evar_defs ref -> 
+    var_map * (identifier * identifier option) list ->
+    rawconstr -> unsafe_judgment
+    
+  val pretype_type : 
+    val_constraint -> env -> evar_defs ref ->
+    var_map * (identifier * identifier option) list ->
+    rawconstr -> unsafe_type_judgment
+
+  val pretype_gen :
+    evar_defs ref -> env -> 
+    var_map * (identifier * identifier option) list ->
+    typing_constraint -> rawconstr -> constr
+
+    (*i*)
+end
+
+module Pretyping_F (Coercion : Coercion.S) = struct
+
+  module Cases = Cases.Cases_F(Coercion)
+
+  (* Allow references to syntaxically inexistent variables (i.e., if applied on an inductive) *)
+  let allow_anonymous_refs = ref false
+
+  let evd_comb0 f isevars =
+    let (evd',x) = f !isevars in
+      isevars := evd';
+      x
+
+  let evd_comb1 f isevars x =
+    let (evd',y) = f !isevars x in
+      isevars := evd';
+      y
+
+  let evd_comb2 f isevars x y =
+    let (evd',z) = f !isevars x y in
+      isevars := evd';
+      z
+
+  let evd_comb3 f isevars x y z =
+    let (evd',t) = f !isevars x y z in
+      isevars := evd';
+      t
+	
+  let mt_evd = Evd.empty
+    
+  let vect_lift_type = Array.mapi (fun i t -> type_app (lift i) t)
+      
+  (* Utilisé pour inférer le prédicat des Cases *)
+  (* Semble exagérement fort *)
+  (* Faudra préférer une unification entre les types de toutes les clauses *)
+  (* et autoriser des ? à rester dans le résultat de l'unification *)
+  
+  let evar_type_fixpoint loc env isevars lna lar vdefj =
+    let lt = Array.length vdefj in 
+      if Array.length lar = lt then 
+	for i = 0 to lt-1 do 
+          if not (e_cumul env isevars (vdefj.(i)).uj_type
+		    (lift lt lar.(i))) then
+            error_ill_typed_rec_body_loc loc env (evars_of !isevars)
+              i lna vdefj lar
+	done
+
+  let check_branches_message loc env isevars c (explft,lft) = 
+    for i = 0 to Array.length explft - 1 do
+      if not (e_cumul env isevars lft.(i) explft.(i)) then 
+	let sigma = evars_of !isevars in
+	  error_ill_formed_branch_loc loc env sigma c i lft.(i) explft.(i)
+    done
+
+  (* coerce to tycon if any *)
+  let inh_conv_coerce_to_tycon loc env isevars j = function
+    | None -> j
+    | Some t -> evd_comb2 (Coercion.inh_conv_coerce_to loc env) isevars j t
+
+  let push_rels vars env = List.fold_right push_rel vars env
+
+  (*
+    let evar_type_case isevars env ct pt lft p c =
+    let (mind,bty,rslty) = type_case_branches env (evars_of isevars) ct pt p c
+    in check_branches_message isevars env (c,ct) (bty,lft); (mind,rslty)
+  *)
+
+  let strip_meta id = (* For Grammar v7 compatibility *)
+    let s = string_of_id id in
+      if s.[0]='$' then id_of_string (String.sub s 1 (String.length s - 1))
+      else id
+
+  let pretype_id loc env (lvar,unbndltacvars) id =
+    let id = strip_meta id in (* May happen in tactics defined by Grammar *)
+      try
+	let (n,typ) = lookup_rel_id id (rel_context env) in
+	  { uj_val  = mkRel n; uj_type = type_app (lift n) typ }
+      with Not_found ->
+	try
+	  List.assoc id lvar
 	with Not_found ->
-	  let cloc = loc_of_rawconstr c in
-	  error_case_not_inductive_loc cloc env (evars_of isevars) cj in
-      let cstrs = get_constructors env indf in 
-      if Array.length cstrs <> 2 then
-        user_err_loc (loc,"",
-	  str "If is only for inductive types with two constructors");
-
-      (* Make dependencies from arity signature impossible *)
-      let arsgn,_ = get_arity env indf in
-      let arsgn = List.map (fun (_,b,t) -> (Anonymous,b,t)) arsgn in
-      let nar = List.length arsgn in
-      let psign = (na,None,build_dependent_inductive env indf)::arsgn in
-      let pred,p = match po with
-	| 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 pred = it_mkLambda_or_LetIn ccl psign in
-	    pred, lift (- nar) (beta_applist (pred,[cj.uj_val]))
-	| None -> 
-	    let p = match tycon with
-	    | Some ty -> ty
-	    | None -> new_isevar isevars env (loc,InternalHole) (new_Type ())
+	  try
+	    let (_,_,typ) = lookup_named id env in
+	      { uj_val  = mkVar id; uj_type = typ }
+	  with Not_found ->
+	    try (* To build a nicer ltac error message *)
+	      match List.assoc id unbndltacvars with
+		| None -> user_err_loc (loc,"",
+					str "variable " ++ pr_id id ++ str " should be bound to a term")
+		| Some id0 -> Pretype_errors.error_var_not_found_loc loc id0
+	    with Not_found ->
+	      error_var_not_found_loc loc id
+
+  (* make a dependent predicate from an undependent one *)
+
+  let make_dep_of_undep env (IndType (indf,realargs)) pj =
+    let n = List.length realargs in
+    let rec decomp n p =
+      if n=0 then p else
+	match kind_of_term p with
+	  | Lambda (_,_,c) -> decomp (n-1) c
+	  | _ -> decomp (n-1) (applist (lift 1 p, [mkRel 1])) 
+    in
+    let sign,s = decompose_prod_n n pj.uj_type in
+    let ind = build_dependent_inductive env indf in
+    let s' = mkProd (Anonymous, ind, s) in
+    let ccl = lift 1 (decomp n pj.uj_val) in
+    let ccl' = mkLambda (Anonymous, ind, ccl) in
+      {uj_val=lam_it ccl' sign; uj_type=prod_it s' sign} 
+
+  (*************************************************************************)
+  (* Main pretyping function                                               *)
+
+  let pretype_ref isevars env ref = 
+    let c = constr_of_global ref in
+      make_judge c (Retyping.get_type_of env Evd.empty c)
+
+  let pretype_sort = function
+    | RProp c -> judge_of_prop_contents c
+    | RType _ -> judge_of_new_Type ()
+
+  (* [pretype tycon env isevars lvar lmeta cstr] attempts to type [cstr] *)
+  (* in environment [env], with existential variables [(evars_of isevars)] and *)
+  (* the type constraint tycon *)
+  let rec pretype (tycon : type_constraint) env isevars lvar = function
+    | RRef (loc,ref) ->
+	inh_conv_coerce_to_tycon loc env isevars
+	  (pretype_ref isevars env ref)
+	  tycon
+
+    | RVar (loc, id) ->
+	inh_conv_coerce_to_tycon loc env isevars
+	  (pretype_id loc env lvar id)
+	  tycon
+
+    | REvar (loc, ev, instopt) ->
+	(* Ne faudrait-il pas s'assurer que hyps est bien un
+	   sous-contexte du contexte courant, et qu'il n'y a pas de Rel "caché" *)
+	let hyps = evar_context (Evd.map (evars_of !isevars) ev) in
+	let args = match instopt with
+          | None -> instance_from_named_context hyps
+          | Some inst -> failwith "Evar subtitutions not implemented" in
+	let c = mkEvar (ev, args) in
+	let j = (Retyping.get_judgment_of env (evars_of !isevars) c) in
+	  inh_conv_coerce_to_tycon loc env isevars j tycon
+
+    | RPatVar (loc,(someta,n)) -> 
+	anomaly "Found a pattern variable in a rawterm to type"
+	  
+    | RHole (loc,k) ->
+	let ty =
+          match tycon with 
+            | Some (None, ty) -> ty
+            | None | Some _ ->
+		e_new_evar isevars env ~src:(loc,InternalHole) (new_Type ()) in
+	  { uj_val = e_new_evar isevars env ~src:(loc,k) ty; uj_type = ty }
+
+    | RRec (loc,fixkind,names,bl,lar,vdef) ->
+	let rec type_bl env ctxt = function
+            [] -> ctxt
+          | (na,None,ty)::bl ->
+              let ty' = pretype_type empty_valcon env isevars lvar ty in
+              let dcl = (na,None,ty'.utj_val) in
+		type_bl (push_rel dcl env) (add_rel_decl dcl ctxt) bl
+          | (na,Some bd,ty)::bl ->
+              let ty' = pretype_type empty_valcon env isevars lvar ty in
+              let bd' = pretype (mk_tycon ty'.utj_val) env isevars lvar ty in
+              let dcl = (na,Some bd'.uj_val,ty'.utj_val) in
+		type_bl (push_rel dcl env) (add_rel_decl dcl ctxt) bl in
+	let ctxtv = Array.map (type_bl env empty_rel_context) bl in
+	let larj =
+          array_map2
+            (fun e ar ->
+               pretype_type empty_valcon (push_rel_context e env) isevars lvar ar)
+            ctxtv lar in
+	let lara = Array.map (fun a -> a.utj_val) larj in
+	let ftys = array_map2 (fun e a -> it_mkProd_or_LetIn a e) ctxtv lara in
+	let nbfix = Array.length lar in
+	let names = Array.map (fun id -> Name id) names in
+	  (* Note: bodies are not used by push_rec_types, so [||] is safe *)
+	let newenv = push_rec_types (names,ftys,[||]) env in
+	let vdefj =
+	  array_map2_i 
+	    (fun i ctxt def ->
+               (* we lift nbfix times the type in tycon, because of
+		* the nbfix variables pushed to newenv *)
+               let (ctxt,ty) =
+		 decompose_prod_n_assum (rel_context_length ctxt)
+                   (lift nbfix ftys.(i)) in
+               let nenv = push_rel_context ctxt newenv in
+               let j = pretype (mk_tycon ty) nenv isevars lvar def in
+		 { uj_val = it_mkLambda_or_LetIn j.uj_val ctxt;
+		   uj_type = it_mkProd_or_LetIn j.uj_type ctxt })
+            ctxtv vdef in
+	  evar_type_fixpoint loc env isevars names ftys vdefj;
+	  let fixj =
+	    match fixkind with
+	      | RFix (vn,i) ->
+		  let fix = ((Array.map fst vn, i),(names,ftys,Array.map j_val vdefj)) in
+		    (try check_fix env fix with e -> Stdpp.raise_with_loc loc e);
+		    make_judge (mkFix fix) ftys.(i)
+	      | RCoFix i -> 
+		  let cofix = (i,(names,ftys,Array.map j_val vdefj)) in
+		    (try check_cofix env cofix with e -> Stdpp.raise_with_loc loc e);
+		    make_judge (mkCoFix cofix) ftys.(i) in
+	    inh_conv_coerce_to_tycon loc env isevars fixj tycon
+
+    | RSort (loc,s) ->
+	inh_conv_coerce_to_tycon loc env isevars (pretype_sort s) tycon
+
+    | RApp (loc,f,args) -> 
+	let length = List.length args in	 
+	let ftycon = 
+	  match tycon with
+	      None -> None
+	    | Some (None, ty) -> mk_abstr_tycon length ty
+	    | Some (Some (init, cur), ty) ->
+		Some (Some (length + init, length + cur), ty)
+	in
+	let fj = pretype empty_tycon env isevars lvar f in
+ 	let floc = loc_of_rawconstr f in
+	let rec apply_rec env n resj tycon = function
+	  | [] -> resj
+	  | c::rest ->
+	      let argloc = loc_of_rawconstr c in
+	      let resj = evd_comb1 (Coercion.inh_app_fun env) isevars resj in
+              let resty = whd_betadeltaiota env (evars_of !isevars) resj.uj_type in
+      		match kind_of_term resty with
+		  | 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
+		      let tycon = 
+			option_app 
+			  (fun (abs, ty) ->
+			     match abs with
+				 None ->
+				   isevars := Coercion.inh_conv_coerces_to loc env !isevars typ'
+				     (abs, ty);
+				   (abs, ty)
+			       | Some (init, cur) ->
+				   isevars := Coercion.inh_conv_coerces_to loc env !isevars typ' 
+				     (abs, ty);
+				   (Some (init, pred cur), ty))
+			  tycon
+		      in 
+			apply_rec env (n+1) 
+			  { uj_val = nf_isevar !isevars value;
+			    uj_type = nf_isevar !isevars typ' }
+			  (option_app (fun (abs, c) -> abs, nf_isevar !isevars c) tycon) rest
+
+		  | _ ->
+		      let hj = pretype empty_tycon env isevars lvar c in
+			error_cant_apply_not_functional_loc 
+			  (join_loc floc argloc) env (evars_of !isevars)
+	      		  resj [hj]
+	in
+	let ftycon = option_app (lift_abstr_tycon_type (-1)) ftycon in
+	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 ->
+	      let sigma = evars_of !isevars in
+	      let t = Retyping.type_of_applied_inductive 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 *)
+	  | _ -> resj in
+	inh_conv_coerce_to_tycon loc env isevars resj tycon
+
+    | RLambda(loc,name,c1,c2)      ->
+	let (name',dom,rng) = evd_comb1 (split_tycon loc env) isevars tycon in
+	let dom_valcon = valcon_of_tycon dom in
+	let j = pretype_type dom_valcon env isevars lvar c1 in
+	let var = (name,None,j.utj_val) in
+	let j' = pretype rng (push_rel var env) isevars lvar c2 in 
+	  judge_of_abstraction env name j j'
+
+    | RProd(loc,name,c1,c2)        ->
+	let j = pretype_type empty_valcon env isevars lvar c1 in
+	let var = (name,j.utj_val) in
+	let env' = push_rel_assum var env in
+	let j' = pretype_type empty_valcon env' isevars lvar c2 in
+	let resj =
+	  try judge_of_product env name j j'
+	  with TypeError _ as e -> Stdpp.raise_with_loc loc e in
+	  inh_conv_coerce_to_tycon loc env isevars resj tycon
+	    
+    | RLetIn(loc,name,c1,c2)      ->
+	let j = pretype empty_tycon env isevars lvar c1 in
+	let t = refresh_universes j.uj_type in
+	let var = (name,Some j.uj_val,t) in
+        let tycon = lift_tycon 1 tycon in
+	let j' = pretype tycon (push_rel var env) isevars lvar c2 in
+	  { uj_val = mkLetIn (name, j.uj_val, t, j'.uj_val) ;
+	    uj_type = subst1 j.uj_val j'.uj_type }
+
+    | RLetTuple (loc,nal,(na,po),c,d) ->
+	let cj = pretype empty_tycon env isevars lvar c in
+	let (IndType (indf,realargs)) = 
+	  try find_rectype env (evars_of !isevars) cj.uj_type
+	  with Not_found ->
+	    let cloc = loc_of_rawconstr c in
+	      error_case_not_inductive_loc cloc env (evars_of !isevars) cj 
+	in
+	let cstrs = get_constructors env indf in
+	  if Array.length cstrs <> 1 then
+            user_err_loc (loc,"",str "Destructing let is only for inductive types with one constructor");
+	  let cs = cstrs.(0) in
+	    if List.length nal <> cs.cs_nargs then
+              user_err_loc (loc,"", str "Destructing let on this type expects " ++ int cs.cs_nargs ++ str " variables");
+	    let fsign = List.map2 (fun na (_,c,t) -> (na,c,t))
+              (List.rev nal) cs.cs_args in
+	    let env_f = push_rels fsign env in
+	      (* Make dependencies from arity signature impossible *)
+	    let arsgn =
+	      let arsgn,_ = get_arity env indf in
+		if not !allow_anonymous_refs then
+		  List.map (fun (_,b,t) -> (Anonymous,b,t)) arsgn
+		else arsgn
 	    in
-	    it_mkLambda_or_LetIn (lift (nar+1) p) psign, p in
-      let f cs b =
-	let n = rel_context_length cs.cs_args in
-	let pi = liftn n 2 pred in
-	let pi = beta_applist (pi, [build_dependent_constructor cs]) in
-	let csgn = List.map (fun (_,b,t) -> (Anonymous,b,t)) cs.cs_args in
-	let env_c = push_rels csgn env in 
-	let bj = pretype (Some pi) env_c isevars lvar b in
-	it_mkLambda_or_LetIn bj.uj_val cs.cs_args in
-      let b1 = f cstrs.(0) b1 in
-      let b2 = f cstrs.(1) b2 in
-      let pred = nf_evar (evars_of isevars) pred in
-      let p = nf_evar (evars_of isevars) p in
-      let v =
-	let mis,_ = dest_ind_family indf in
-	let ci = make_default_case_info env IfStyle mis in
-	mkCase (ci, pred, cj.uj_val, [|b1;b2|])
-      in
-      { uj_val = v; uj_type = p }
-
-  | ROrderedCase (loc,st,po,c,lf,x) ->
-      let isrec = (st = MatchStyle) in
-      let cj = pretype empty_tycon env isevars lvar c in
-      let (IndType (indf,realargs) as indt) = 
-	try find_rectype env (evars_of isevars) cj.uj_type
-	with Not_found ->
-	  let cloc = loc_of_rawconstr c in
-	  error_case_not_inductive_loc cloc env (evars_of isevars) cj in
-      let (dep,pj) = match po with
-	| Some p ->
-            let pj = pretype empty_tycon env isevars lvar p in
-            let dep = is_dependent_elimination env pj.uj_type indf in
-            let ar =
-              arity_of_case_predicate env indf dep (Type (new_univ())) in
-            let _ = the_conv_x_leq env isevars pj.uj_type ar in
-            (dep, pj)
-	| None -> 
-            (* get type information from type of branches *)
-	    let expbr = Cases.branch_scheme env isevars isrec indf in
-	    let rec findtype i =
-	      if i >= Array.length lf
-	      then
-                (* get type information from constraint *)
-                (* warning: if the constraint comes from an evar type, it *)
-                (* may be Type while Prop or Set would be expected *)
-	        match tycon with
-		  | Some pred ->
-		      let arsgn = make_arity_signature env true indf in
-                      let pred = lift (List.length arsgn) pred in
-  		      let pred = 
-			it_mkLambda_or_LetIn (nf_evar (evars_of isevars) pred)
-			  arsgn in
-                      (true, 
-                       Retyping.get_judgment_of env (evars_of isevars) pred)
-	          | None ->
-                      let sigma = evars_of isevars in
-                      error_cant_find_case_type_loc loc env sigma cj.uj_val
-	      else
-		try
-		  let expti = expbr.(i) in
-		  let fj =
-		    pretype (mk_tycon expti) env isevars lvar lf.(i) in
-		  let pred = 
-		    Cases.pred_case_ml (* eta-expanse *)
-                      env (evars_of isevars) isrec indt (i,fj.uj_type) in
-		  if has_undefined_isevars isevars pred then findtype (i+1)
-		  else 
-		    let pty =
-                      Retyping.get_type_of env (evars_of isevars) pred in
-		    let pj = { uj_val = pred; uj_type = pty } in
-(*
-                    let _ = option_app (the_conv_x_leq env isevars pred) tycon
-                    in
-*)
-                    (true,pj)
-		with Cases.NotInferable _ -> findtype (i+1) in
-	    findtype 0 
-      in
-      let pj = j_nf_evar (evars_of isevars) pj in
-      let pj = if dep then pj else make_dep_of_undep env indt pj in
-      let (bty,rsty) =
-	Indrec.type_rec_branches
-          isrec env (evars_of isevars) indt pj.uj_val cj.uj_val in
-      let _ = option_app (the_conv_x_leq env isevars rsty) tycon in
-      if Array.length bty <> Array.length lf then
-	error_number_branches_loc loc env (evars_of isevars) 
-	  cj (Array.length bty)
-      else
-	let lfj =
-	  array_map2
-            (fun tyc f -> pretype (mk_tycon tyc) env isevars lvar f) bty
-            lf in
-	let lfv = Array.map j_val lfj in
-	let lft = Array.map (fun j -> j.uj_type) lfj in
-	check_branches_message loc env isevars cj.uj_val (bty,lft);
-	let v =
-	  if isrec
-	  then 
-	    transform_rec loc env (evars_of isevars)(pj,cj.uj_val,lfv) indt
-	  else
+	    let psign = (na,None,build_dependent_inductive env indf)::arsgn in
+	    let nar = List.length arsgn in
+	      (match po with
+		 | 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 psign = make_arity_signature env true indf in (* with names *)
+		     let p = it_mkLambda_or_LetIn ccl psign in
+		     let inst = 
+		       (Array.to_list cs.cs_concl_realargs)
+		       @[build_dependent_constructor cs] in
+		     let lp = lift cs.cs_nargs p in
+		     let fty = hnf_lam_applist env (evars_of !isevars) lp inst in
+		     let fj = pretype (mk_tycon fty) env_f isevars lvar d in
+		     let f = it_mkLambda_or_LetIn fj.uj_val fsign in
+		     let v =
+		       let mis,_ = dest_ind_family indf in
+		       let ci = make_default_case_info env LetStyle mis in
+			 mkCase (ci, p, cj.uj_val,[|f|]) in 
+		       { uj_val = v; uj_type = substl (realargs@[cj.uj_val]) ccl }
+
+		 | None -> 
+		     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 =
+		       if noccur_between 1 cs.cs_nargs ccl then
+			 lift (- cs.cs_nargs) ccl 
+		       else
+			 error_cant_find_case_type_loc loc env (evars_of !isevars) 
+			   cj.uj_val in
+		     let p = it_mkLambda_or_LetIn (lift (nar+1) ccl) psign in
+		     let v =
+		       let mis,_ = dest_ind_family indf in
+		       let ci = make_default_case_info env LetStyle mis in
+			 mkCase (ci, p, cj.uj_val,[|f|] ) 
+		     in
+		       { uj_val = v; uj_type = ccl })
+
+    | RIf (loc,c,(na,po),b1,b2) ->
+	let cj = pretype empty_tycon env isevars lvar c in
+	let (IndType (indf,realargs)) = 
+	  try find_rectype env (evars_of !isevars) cj.uj_type
+	  with Not_found ->
+	    let cloc = loc_of_rawconstr c in
+	      error_case_not_inductive_loc cloc env (evars_of !isevars) cj in
+	let cstrs = get_constructors env indf in 
+	  if Array.length cstrs <> 2 then
+            user_err_loc (loc,"",
+			  str "If is only for inductive types with two constructors");
+
+	  let arsgn = 
+	    let arsgn,_ = get_arity env indf in
+	      if not !allow_anonymous_refs then
+		(* Make dependencies from arity signature impossible *)
+		List.map (fun (_,b,t) -> (Anonymous,b,t)) arsgn 
+	      else arsgn
+	  in
+	  let nar = List.length arsgn in
+	  let psign = (na,None,build_dependent_inductive env indf)::arsgn in
+	  let pred,p = match po with
+	    | 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 pred = it_mkLambda_or_LetIn ccl psign in
+		let typ = lift (- nar) (beta_applist (pred,[cj.uj_val])) in
+		let jtyp = inh_conv_coerce_to_tycon loc env isevars {uj_val = pred;
+								     uj_type = typ} tycon 
+		in
+		  jtyp.uj_val, jtyp.uj_type
+	    | None -> 
+		let p = match tycon with
+		  | Some (None, ty) -> ty
+		  | None | Some _ ->
+                      e_new_evar isevars env ~src:(loc,InternalHole) (new_Type ())
+		in
+		  it_mkLambda_or_LetIn (lift (nar+1) p) psign, p in
+	  let pred = nf_evar (evars_of !isevars) pred in
+	  let p = nf_evar (evars_of !isevars) p in
+	 (*   msgnl (str "Pred is: " ++ Termops.print_constr_env env pred);*)
+	  let f cs b =
+	    let n = rel_context_length cs.cs_args in
+	    let pi = lift n pred in (* liftn n 2 pred ? *)
+	    let pi = beta_applist (pi, [build_dependent_constructor cs]) in
+	    let csgn = 
+	      if not !allow_anonymous_refs then
+		List.map (fun (_,b,t) -> (Anonymous,b,t)) cs.cs_args 
+	      else 
+		List.map 
+		  (fun (n, b, t) ->
+		     match n with
+                         Name _ -> (n, b, t)
+                       | Anonymous -> (Name (id_of_string "H"), b, t))
+		cs.cs_args
+	    in
+	    let env_c = push_rels csgn env in 
+(* 	      msgnl (str "Pi is: " ++ Termops.print_constr_env env_c pi); *)
+	    let bj = pretype (mk_tycon pi) env_c isevars lvar b in
+	      it_mkLambda_or_LetIn bj.uj_val cs.cs_args in
+	  let b1 = f cstrs.(0) b1 in
+	  let b2 = f cstrs.(1) b2 in
+	  let v =
 	    let mis,_ = dest_ind_family indf in
-	    let ci = make_default_case_info env st mis in
-	    mkCase (ci, (nf_betaiota pj.uj_val), cj.uj_val,
-                       Array.map (fun j-> j.uj_val) lfj)
-	in
-        (* Build the Cases form for v8 *)
-        let c =
-          let (ind,params) = dest_ind_family indf in
-          let (mib,mip) = lookup_mind_specif env ind in
-          let recargs = mip.mind_recargs in
-          let mI = mkInd ind in
-          let nconstr = Array.length mip.mind_consnames in
-          let tyi = snd ind in
-          if isrec && mis_is_recursive_subset [tyi] recargs then
-            Some (Detyping.detype (false,env)
-	      (ids_of_context env) (names_of_rel_context env)
-              (nf_evar (evars_of isevars) v))
-	  else
-	    (* Translate into a "match ... with" *)
-            let rtntypopt, indnalopt = match po with
-              | None -> None, (Anonymous,None)
-              | Some p ->
-                  let rec decomp_lam_force n avoid l p =
-                    (* avoid is not exhaustive ! *)
-                    if n = 0 then (List.rev l,p,avoid) else
-                      match p with
-                        | RLambda (_,(Name id as na),_,c) -> 
-                            decomp_lam_force (n-1) (id::avoid) (na::l) c
-                        | RLambda (_,(Anonymous as na),_,c) ->
-                            decomp_lam_force (n-1) avoid (na::l) c
-                        | _ ->
-                            let x = Nameops.next_ident_away (id_of_string "x") avoid in
-                            decomp_lam_force (n-1) (x::avoid) (Name x :: l) 
-                              (* eta-expansion *)
-                              (RApp (dummy_loc,p, [RVar (dummy_loc,x)])) in
-                  let (nal,p,avoid) = 
-                    decomp_lam_force (List.length realargs) [] [] p in
-                  let na,rtntyopt,_ = 
-                    if dep then decomp_lam_force 1 avoid [] p
-                    else [Anonymous],p,[] in
-		  let intyp =
-		    if nal=[] then None else
-                      let args = List.map (fun _ -> Anonymous) params @ nal in
-		      Some (dummy_loc,ind,args) in
-                  (Some rtntyopt,(List.hd na,intyp)) in
-	    let rawbranches =
-	      array_map3 (fun bj b cstr ->
-		let rec strip n r = if n=0 then r else
-		  match r with
-		    | RLambda (_,_,_,t) -> strip (n-1) t
-		    | RLetIn (_,_,_,t) -> strip (n-1) t
-		    | _ -> assert false in
-		let n = rel_context_length cstr.cs_args in
-		try
-		  let _,ccl = decompose_lam_n_assum n bj.uj_val in
-		  if noccur_between 1 n ccl then Some (strip n b) else None
-		with _ -> (* Not eta-expanded or not reduced *) None)
-		lfj lf (get_constructors env indf) in
-	    if st = IfStyle & snd indnalopt = None 
-	       & rawbranches.(0) <> None && rawbranches.(1) <> None then
-	      (* Translate into a "if ... then ... else" *)
-	      (* TODO: translate into a "if" even if po is dependent *)
-	      Some (RIf (loc,c,(fst indnalopt,rtntypopt),
-	          out_some rawbranches.(0),out_some rawbranches.(1)))
-	    else
-            let detype_eqn constr construct_nargs branch =
-              let name_cons = function 
-                | Anonymous -> fun l -> l
-                | Name id -> fun l -> id::l in
-              let make_pat na avoid b ids =
-                PatVar (dummy_loc,na),
-                name_cons na avoid,name_cons na ids
-              in
-              let rec buildrec ids patlist avoid n b =
-                if n=0 then
-                  (dummy_loc, ids, 
-                  [PatCstr(dummy_loc, constr, List.rev patlist,Anonymous)],
-                  b)
-                else
-                  match b with
-	            | RLambda (_,x,_,b) -> 
-	                let pat,new_avoid,new_ids = make_pat x avoid b ids in
-                        buildrec new_ids (pat::patlist) new_avoid (n-1) b
-                          
-	            | RLetIn (_,x,_,b) -> 
-	                let pat,new_avoid,new_ids = make_pat x avoid b ids in
-                        buildrec new_ids (pat::patlist) new_avoid (n-1) b
-                          
-	            | RCast (_,c,_) ->    (* Oui, il y a parfois des cast *)
-	                buildrec ids patlist avoid n c
-                        
-	            | _ -> (* eta-expansion *)
-                        (* nommage de la nouvelle variable *)
-                        let id = Nameops.next_ident_away (id_of_string "x") avoid in
-	                let new_b = RApp (dummy_loc, b, [RVar(dummy_loc,id)])in
-                        let pat,new_avoid,new_ids =
-	                  make_pat (Name id) avoid new_b ids in
-	                buildrec new_ids (pat::patlist) new_avoid (n-1) new_b
-	                  
-              in 
-              buildrec [] [] [] construct_nargs branch in
-            let (mib,mip) = Inductive.lookup_mind_specif (Global.env()) ind in
-            let get_consnarg j = 
-              let typi = mis_nf_constructor_type (ind,mib,mip) (j+1) in
-              let _,t = decompose_prod_n_assum mip.mind_nparams typi in
-              List.rev (fst (decompose_prod_assum t)) in
-            let consnargs = Array.init (Array.length mip.mind_consnames) get_consnarg in
-            let consnargsl = Array.map List.length consnargs in
-            let constructs = Array.init (Array.length lf) (fun i -> (ind,i+1)) in
-            let eqns = array_map3 detype_eqn constructs consnargsl lf in
-            Some (RCases (loc,(po,ref rtntypopt),[c,ref indnalopt],Array.to_list eqns)) in
-        x := c;
-        (* End build the Cases form for v8 *)
-	{ uj_val = v;
-	  uj_type = rsty }
-
-  | RCases (loc,po,tml,eqns) ->
-      Cases.compile_cases loc
-	((fun vtyc env -> pretype vtyc env isevars lvar),isevars)
-	tycon env (* loc *) (po,tml,eqns)
-
-  | RCast(loc,c,t) ->
-      let tj = pretype_type empty_tycon env isevars lvar t in
-      let cj = pretype (mk_tycon tj.utj_val) env isevars lvar c in
-      (* User Casts are for helping pretyping, experimentally not to be kept*)
-      (* ... except for Correctness *)
-      let v = mkCast (cj.uj_val, tj.utj_val) in
-      let cj = { uj_val = v; uj_type = tj.utj_val } in
-      inh_conv_coerce_to_tycon loc env isevars cj tycon
-
-  | RDynamic (loc,d) ->
-    if (tag d) = "constr" then
-      let c = constr_out d in
-      let j = (Retyping.get_judgment_of env (evars_of isevars) c) in
+	    let ci = make_default_case_info env IfStyle mis in
+	      mkCase (ci, pred, cj.uj_val, [|b1;b2|])
+	  in
+	    { uj_val = v; uj_type = p }
+
+    | RCases (loc,po,tml,eqns) ->
+	Cases.compile_cases loc
+	  ((fun vtyc env -> pretype vtyc env isevars lvar),isevars)
+	  tycon env (* loc *) (po,tml,eqns)
+
+    | RCast(loc,c,k,t) ->
+	let tj = pretype_type empty_valcon env isevars lvar t in
+	let cj = pretype (mk_tycon tj.utj_val) env isevars lvar c in
+	  (* User Casts are for helping pretyping, experimentally not to be kept*)
+	  (* ... except for Correctness *)
+	let v = mkCast (cj.uj_val, k, tj.utj_val) in
+	let cj = { uj_val = v; uj_type = tj.utj_val } in
+	  inh_conv_coerce_to_tycon loc env isevars cj tycon
+
+    | RDynamic (loc,d) ->
+	if (tag d) = "constr" then
+	  let c = constr_out d in
+	  let j = (Retyping.get_judgment_of env (evars_of !isevars) c) in
+	    j
+	      (*inh_conv_coerce_to_tycon loc env isevars j tycon*)
+	else
+	  user_err_loc (loc,"pretype",(str "Not a constr tagged Dynamic"))
+
+  (* [pretype_type valcon env isevars lvar c] coerces [c] into a type *)
+  and pretype_type valcon env isevars lvar = function
+    | RHole loc ->
+	(match valcon with
+	   | Some v ->
+               let s =
+		 let sigma = evars_of !isevars in
+		 let t = Retyping.get_type_of env sigma v in
+		   match kind_of_term (whd_betadeltaiota env sigma t) with
+                     | Sort s -> s
+                     | Evar v when is_Type (existential_type sigma v) -> 
+			 evd_comb1 (define_evar_as_sort) isevars v
+                     | _ -> anomaly "Found a type constraint which is not a type"
+               in
+		 { utj_val = v;
+		   utj_type = s }
+	   | None ->
+	       let s = new_Type_sort () in
+		 { utj_val = e_new_evar isevars env ~src:loc (mkSort s);
+		   utj_type = s})
+    | c ->
+	let j = pretype empty_tycon env isevars lvar c in
+	let loc = loc_of_rawconstr c in
+	let tj = evd_comb1 (Coercion.inh_coerce_to_sort loc env) isevars j in
+	  match valcon with
+	    | None -> tj
+	    | Some v ->
+		if e_cumul env isevars v tj.utj_val then tj
+		else
+		  error_unexpected_type_loc
+                    (loc_of_rawconstr c) env (evars_of !isevars) tj.utj_val v
+
+  let pretype_gen isevars env lvar kind c =
+    let c' = match kind with
+      | OfType exptyp ->
+	  let tycon = match exptyp with None -> empty_tycon | Some t -> mk_tycon t in
+	    (pretype tycon env isevars lvar c).uj_val
+      | IsType ->
+	  (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.in_dom sigma ev);
+	    if not (Evd.in_dom 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...
+  *)
+
+  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
+      check_evars env sigma isevars (mkCast(j.uj_val,DEFAULTcast, j.uj_type));
       j
-      (*inh_conv_coerce_to_tycon loc env isevars j tycon*)
-    else
-      user_err_loc (loc,"pretype",(str "Not a constr tagged Dynamic"))
-
-(* [pretype_type valcon env isevars lvar c] coerces [c] into a type *)
-and pretype_type valcon env isevars lvar = function
-  | RHole loc ->
-      (match valcon with
-	 | Some v ->
-             let s =
-               let sigma = evars_of isevars in
-               let t = Retyping.get_type_of env sigma v in
-               match kind_of_term (whd_betadeltaiota env sigma t) with
-                 | Sort s -> s
-                 | Evar v when is_Type (existential_type sigma v) -> 
-                     define_evar_as_sort isevars v
-                 | _ -> anomaly "Found a type constraint which is not a type"
-             in
-	     { utj_val = v;
-	       utj_type = s }
-	 | None ->
-	     let s = new_Type_sort () in
-	     { utj_val = new_isevar isevars env loc (mkSort s);
-	       utj_type = s})
-  | c ->
-      let j = pretype empty_tycon env isevars lvar c in
-      let tj = inh_coerce_to_sort env isevars j in
-      match valcon with
-	| None -> tj
-	| Some v ->
-	    if the_conv_x_leq env isevars v tj.utj_val then tj
-	    else
-	      error_unexpected_type_loc
-                (loc_of_rawconstr c) env (evars_of isevars) tj.utj_val v
-
-
-let unsafe_infer tycon isevars env lvar constr =
-  let j = pretype tycon env isevars lvar constr in
-  j_nf_evar (evars_of isevars) j
-
-let unsafe_infer_type valcon isevars env lvar constr =
-  let tj = pretype_type valcon env isevars lvar constr in
-  tj_nf_evar (evars_of isevars) tj
-
-(* If fail_evar is false, [process_evars] builds a meta_map with the
-   unresolved Evar that were not in initial sigma; otherwise it fail
-   on the first unresolved Evar not already in the initial sigma. *)
-(* [fail_evar] says how to process unresolved evars:
- *   true -> raise an error message
- *   false -> convert them into new Metas (casted with their type)
- *)
-(* assumes the defined existentials have been replaced in c (should be
-   done in unsafe_infer and unsafe_infer_type) *)
-let check_evars fail_evar 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 as k) ->
-          assert (Evd.in_dom sigma ev);
-	  if not (Evd.in_dom initial_sigma ev) then
-	    (if fail_evar 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
-
-(* 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...
-*)
-
-(* constr with holes *)
-type open_constr = evar_map * constr
-
-let ise_resolve_casted_gen fail_evar sigma env lvar typ c =
-  let isevars = create_evar_defs sigma in
-  let j = unsafe_infer (mk_tycon typ) isevars env lvar c in
-  check_evars fail_evar env sigma isevars (mkCast(j.uj_val,j.uj_type));
-  (evars_of isevars, j)
-
-let ise_resolve_casted sigma env typ c =
-  ise_resolve_casted_gen true sigma env ([],[]) typ c
-
-(* Raw calls to the unsafe inference machine: boolean says if we must fail
-   on unresolved evars, or replace them by Metas; the unsafe_judgment list
-   allows us to extend env with some bindings *)
-let ise_infer_gen fail_evar sigma env lvar exptyp c =
-  let tycon = match exptyp with None -> empty_tycon | Some t -> mk_tycon t in
-  let isevars = create_evar_defs sigma in
-  let j = unsafe_infer tycon isevars env lvar c in
-  check_evars fail_evar env sigma isevars (mkCast(j.uj_val,j.uj_type));
-  (evars_of isevars, j)
-
-let ise_infer_type_gen fail_evar sigma env lvar c =
-  let isevars = create_evar_defs sigma in
-  let tj = unsafe_infer_type empty_valcon isevars env lvar c in
-  check_evars fail_evar env sigma isevars tj.utj_val;
-  (evars_of isevars, tj)
 
-type var_map = (identifier * unsafe_judgment) list
+  let understand_judgment_tcc isevars env c =
+    let j = pretype empty_tycon env isevars ([],[]) c in
+    let sigma = evars_of !isevars in
+    let j = j_nf_evar sigma j in
+      j
 
-let understand_judgment sigma env c =
-  snd (ise_infer_gen true sigma env ([],[]) None c)
+  (* Raw calls to the unsafe inference machine: boolean says if we must
+     fail on unresolved evars; the unsafe_judgment list allows us to
+     extend env with some bindings *)
 
-let understand_type_judgment sigma env c =
-  snd (ise_infer_type_gen true sigma env ([],[]) c)
+  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
+      if fail_evar then check_evars env sigma isevars c;
+      !isevars, c
 
-let understand sigma env c =
-  let _, c = ise_infer_gen true sigma env ([],[]) None c in
-  c.uj_val
+  (** Entry points of the high-level type synthesis algorithm *)
 
-let understand_type sigma env c =
-  let _,c = ise_infer_type_gen true sigma env ([],[]) c in
-  c.utj_val
+  let understand_gen kind sigma env c =
+    snd (ise_pretype_gen true sigma env ([],[]) kind c)
 
-let understand_gen_ltac sigma env lvar ~expected_type:exptyp c =
-  let _, c = ise_infer_gen true sigma env lvar exptyp c in
-  c.uj_val
+  let understand sigma env ?expected_type:exptyp c =
+    snd (ise_pretype_gen true sigma env ([],[]) (OfType exptyp) c)
 
-let understand_gen sigma env lvar ~expected_type:exptyp c =
-  let _, c = ise_infer_gen true sigma env (lvar,[]) exptyp c in
-  c.uj_val
+  let understand_type sigma env c =
+    snd (ise_pretype_gen true sigma env ([],[]) IsType c)
 
-let understand_gen_tcc sigma env lvar exptyp c =
-  let metamap, c = ise_infer_gen false sigma env (lvar,[]) exptyp c in
-  metamap, c.uj_val
+  let understand_ltac sigma env lvar kind c =
+    ise_pretype_gen false sigma env lvar kind c
+      
+  let understand_tcc_evars isevars env kind c =
+    pretype_gen isevars env ([],[]) kind c
 
-let interp_sort = function
-  | RProp c -> Prop c
-  | RType _ -> new_Type_sort ()
+  let understand_tcc sigma env ?expected_type:exptyp c =
+    let ev, t = ise_pretype_gen false sigma env ([],[]) (OfType exptyp) c in
+      Evd.evars_of ev, t
+end
 
-let interp_elimination_sort = function
-  | RProp Null -> InProp
-  | RProp Pos  -> InSet
-  | RType _ -> InType
+module Default : S = Pretyping_F(Coercion.Default)
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index 4357e504..7bb8c374 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,v 1.28.2.1 2004/07/16 19:30:46 herbelin Exp $ i*)
+(*i $Id: pretyping.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
 
 (*i*)
 open Names
@@ -18,69 +18,97 @@ open Rawterm
 open Evarutil
 (*i*)
 
-type var_map = (identifier * unsafe_judgment) list
-
-(* constr with holes *)
-type open_constr = evar_map * constr
-
-
-(* Generic call to the interpreter from rawconstr to constr, failing
-   unresolved holes in the rawterm cannot be instantiated.
-
-   In [understand_gen sigma env varmap typopt raw],
-
-   sigma : initial set of existential variables (typically dependent subgoals)
-   varmap : partial subtitution of variables (used for the tactic language)
-   metamap : partial subtitution of meta (used for the tactic language)
-   typopt : is not None, this is the expected type for raw (used to define evars)
-*)
-val understand_gen :
-  evar_map -> env -> var_map
-    -> expected_type:(constr option) -> rawconstr -> constr
+type typing_constraint = OfType of types option | IsType
 
-val understand_gen_ltac :
-  evar_map -> env -> var_map * (identifier * identifier option) list
-    -> expected_type:(constr option) -> rawconstr -> constr
-
-(* Generic call to the interpreter from rawconstr to constr, turning
-   unresolved holes into metas. Returns also the typing context of
-   these metas. Work as [understand_gen] for the rest. *)
-val understand_gen_tcc :
-  evar_map -> env -> var_map
-    -> constr option -> rawconstr -> open_constr
-
-(* Standard call to get a constr from a rawconstr, resolving implicit args *)
-val understand : evar_map -> env -> rawconstr -> constr
+type var_map = (identifier * unsafe_judgment) list
+type unbound_ltac_var_map = (identifier * identifier option) list
+
+module type S = 
+sig
+
+  module Cases : Cases.S
+    
+  (* Allow references to syntaxically inexistent variables (i.e., if applied on an inductive) *)
+  val allow_anonymous_refs : bool ref
+
+  (* Generic call to the interpreter from rawconstr to open_constr, leaving
+     unresolved holes as evars and returning the typing contexts of
+     these evars. Work as [understand_gen] for the rest. *)
+  
+  val understand_tcc :
+    evar_map -> env -> ?expected_type:types -> rawconstr -> open_constr
+    
+  val understand_tcc_evars :
+    evar_defs ref -> env -> typing_constraint -> rawconstr -> constr
+
+  (* More general entry point with evars from ltac *)
+    
+  (* Generic call to the interpreter from rawconstr to constr, failing
+     unresolved holes in the rawterm cannot be instantiated.
+     
+     In [understand_ltac sigma env ltac_env constraint c],
+     
+     sigma : initial set of existential variables (typically dependent subgoals)
+     ltac_env : partial substitution of variables (used for the tactic language)
+     constraint : tell if interpreted as a possibly constrained term or a type 
+  *)
+    
+  val understand_ltac :
+    evar_map -> env -> var_map * unbound_ltac_var_map ->
+    typing_constraint -> rawconstr -> evar_defs * constr
+    
+  (* Standard call to get a constr from a rawconstr, resolving implicit args *)
+    
+  val understand : evar_map -> env -> ?expected_type:Term.types ->
+    rawconstr -> constr
+    
+  (* Idem but the rawconstr is intended to be a type *)
+    
+  val understand_type : evar_map -> env -> rawconstr -> constr
+    
+  (* A generalization of the two previous case *)
+    
+  val understand_gen : typing_constraint -> evar_map -> env -> 
+    rawconstr -> constr
+    
+  (* Idem but returns the judgment of the understood term *)
+    
+  val understand_judgment : evar_map -> env -> rawconstr -> unsafe_judgment
+
+  (* Idem but do not fail on unresolved evars *)
+  val understand_judgment_tcc : evar_defs ref -> env -> rawconstr -> unsafe_judgment
+
+       
+  (*i*)
+  (* Internal of Pretyping...
+   *)
+  val pretype : 
+    type_constraint -> env -> evar_defs ref -> 
+    var_map * (identifier * identifier option) list ->
+    rawconstr -> unsafe_judgment
+    
+  val pretype_type : 
+    val_constraint -> env -> evar_defs ref ->
+    var_map * (identifier * identifier option) list ->
+    rawconstr -> unsafe_type_judgment
 
-(* Idem but the rawconstr is intended to be a type *)
-val understand_type : evar_map -> env -> rawconstr -> constr
+  val pretype_gen :
+    evar_defs ref -> env -> 
+    var_map * (identifier * identifier option) list ->
+    typing_constraint -> rawconstr -> constr
 
-(* Idem but returns the judgment of the understood term *)
-val understand_judgment : evar_map -> env -> rawconstr -> unsafe_judgment
+  (*i*)
+    
+end
 
-(* Idem but returns the judgment of the understood type *)
-val understand_type_judgment : evar_map -> env -> rawconstr 
-  -> unsafe_type_judgment
+module Pretyping_F (C : Coercion.S) : S
+module Default : S
 
 (* To embed constr in rawconstr *)
+  
 val constr_in : constr -> Dyn.t
 val constr_out : Dyn.t -> constr
 
-(*i*)
-(* Internal of Pretyping...
- * Unused outside, but useful for debugging
- *)
-val pretype : 
-  type_constraint -> env -> evar_defs -> 
-    var_map * (identifier * identifier option) list ->
-    rawconstr -> unsafe_judgment
-
-val pretype_type : 
-  val_constraint -> env -> evar_defs ->
-    var_map * (identifier * identifier option) list ->
-    rawconstr -> unsafe_type_judgment
-(*i*)
-
-val interp_sort : rawsort -> sorts
-
+val interp_sort : rawsort -> sorts  
 val interp_elimination_sort : rawsort -> sorts_family
+
diff --git a/pretyping/rawterm.ml b/pretyping/rawterm.ml
index ef4a4670..5d177326 100644
--- a/pretyping/rawterm.ml
+++ b/pretyping/rawterm.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: rawterm.ml,v 1.43.2.4 2004/12/29 10:17:10 herbelin Exp $ *)
+(* $Id: rawterm.ml 8624 2006-03-13 17:38:17Z msozeau $ *)
 
 (*i*)
 open Util
@@ -15,6 +15,7 @@ open Sign
 open Term
 open Libnames
 open Nametab
+open Evd
 (*i*)
 
 (* Untyped intermediate terms, after ASTs and before constr. *)
@@ -33,8 +34,6 @@ type patvar = identifier
 
 type rawsort = RProp of Term.contents | RType of Univ.universe option
 
-type fix_kind = RFix of (int array * int) | RCoFix of int
-
 type binder_kind = BProd | BLambda | BLetIn
 
 type quantified_hypothesis = AnonHyp of int | NamedHyp of identifier
@@ -48,14 +47,6 @@ type 'a bindings =
 
 type 'a with_bindings = 'a * 'a bindings
 
-type hole_kind =
-  | ImplicitArg of global_reference * (int * identifier option)
-  | BinderType of name
-  | QuestionMark
-  | CasesType
-  | InternalHole
-  | TomatchTypeParameter of inductive * int
-
 type rawconstr = 
   | RRef of (loc * global_reference)
   | RVar of (loc * identifier)
@@ -65,11 +56,9 @@ type rawconstr =
   | RLambda of loc * name * rawconstr * rawconstr
   | RProd of loc * name * rawconstr * rawconstr
   | RLetIn of loc * name * rawconstr * rawconstr
-  | RCases of loc * (rawconstr option * rawconstr option ref) *
-      (rawconstr * (name * (loc * inductive * name list) option) ref) list * 
+  | RCases of loc * rawconstr option *
+      (rawconstr * (name * (loc * inductive * name list) option)) list * 
       (loc * identifier list * cases_pattern list * rawconstr) list
-  | ROrderedCase of loc * case_style * rawconstr option * rawconstr * 
-      rawconstr array * rawconstr option ref
   | RLetTuple of loc * name list * (name * rawconstr option) * 
       rawconstr * rawconstr
   | RIf of loc * rawconstr * (name * rawconstr option) * rawconstr * rawconstr
@@ -77,15 +66,19 @@ type rawconstr =
       rawconstr array * rawconstr array
   | RSort of loc * rawsort
   | RHole of (loc * hole_kind)
-  | RCast of loc * rawconstr * rawconstr
+  | RCast of loc * rawconstr * cast_kind * rawconstr
   | RDynamic of loc * Dyn.t
 
 and rawdecl = name * rawconstr option * rawconstr
 
+and fix_recursion_order = RStructRec | RWfRec of rawconstr
+
+and fix_kind = RFix of ((int * fix_recursion_order) array * int) | RCoFix of int
+
 let cases_predicate_names tml =
   List.flatten (List.map (function
-    | (tm,{contents=(na,None)}) -> [na]
-    | (tm,{contents=(na,Some (_,_,nal))}) -> na::nal) tml)
+    | (tm,(na,None)) -> [na]
+    | (tm,(na,Some (_,_,nal))) -> na::nal) tml)
 
 (*i - if PRec (_, names, arities, bodies) is in env then arities are
    typed in env too and bodies are typed in env enriched by the
@@ -104,12 +97,10 @@ let map_rawconstr f = function
   | RLambda (loc,na,ty,c) -> RLambda (loc,na,f ty,f c)
   | RProd (loc,na,ty,c) -> RProd (loc,na,f ty,f c)
   | RLetIn (loc,na,b,c) -> RLetIn (loc,na,f b,f c)
-  | RCases (loc,(tyopt,rtntypopt),tml,pl) ->
-      RCases (loc,(option_app f tyopt,ref (option_app f !rtntypopt)),
+  | RCases (loc,rtntypopt,tml,pl) ->
+      RCases (loc,option_app f rtntypopt,
         List.map (fun (tm,x) -> (f tm,x)) tml,
         List.map (fun (loc,idl,p,c) -> (loc,idl,p,f c)) pl)
-  | ROrderedCase (loc,b,tyopt,tm,bv,x) ->
-      ROrderedCase (loc,b,option_app f tyopt,f tm, Array.map f bv,ref (option_app f !x))
   | RLetTuple (loc,nal,(na,po),b,c) ->
       RLetTuple (loc,nal,(na,option_app f po),f b,f c)
   | RIf (loc,c,(na,po),b1,b2) ->
@@ -117,7 +108,7 @@ let map_rawconstr f = function
   | RRec (loc,fk,idl,bl,tyl,bv) ->
       RRec (loc,fk,idl,Array.map (List.map (map_rawdecl f)) bl,
             Array.map f tyl,Array.map f bv)
-  | RCast (loc,c,t) -> RCast (loc,f c,f t)
+  | RCast (loc,c,k,t) -> RCast (loc,f c,k,f t)
   | (RSort _ | RHole _ | RRef _ | REvar _ | RPatVar _ | RDynamic _) as x -> x
   
 
@@ -147,8 +138,6 @@ let map_rawconstr_with_binders_loc loc g f e = function
       let h (_,idl,p,c) = (loc,idl,p,f (List.fold_right g' idl e) c) in
       RCases
 	(loc,option_app (f e) tyopt,List.map (f e) tml, List.map h pl)
-  | ROrderedCase (_,b,tyopt,tm,bv) ->
-      ROrderedCase (loc,b,option_app (f e) tyopt,f e tm,Array.map (f e) bv)
   | RRec (_,fk,idl,tyl,bv) ->
       let idl',e' = fold_ident g idl e in
       RRec (loc,fk,idl',Array.map (f e) tyl,Array.map (f e') bv)
@@ -168,12 +157,10 @@ let occur_rawconstr id =
     | RLambda (loc,na,ty,c) -> (occur ty) or ((na <> Name id) & (occur c))
     | RProd (loc,na,ty,c) -> (occur ty) or ((na <> Name id) & (occur c))
     | RLetIn (loc,na,b,c) -> (occur b) or ((na <> Name id) & (occur c))
-    | RCases (loc,(tyopt,rtntypopt),tml,pl) ->
-	(occur_option tyopt) or (occur_option !rtntypopt)
+    | RCases (loc,rtntypopt,tml,pl) ->
+	(occur_option rtntypopt)
         or (List.exists (fun (tm,_) -> occur tm) tml)
 	or (List.exists occur_pattern pl)
-    | ROrderedCase (loc,b,tyopt,tm,bv,_) -> 
-	(occur_option tyopt) or (occur tm) or (array_exists occur bv)
     | RLetTuple (loc,nal,rtntyp,b,c) -> 
 	occur_return_type rtntyp id
         or (occur b) or (not (List.mem (Name id) nal) & (occur c))
@@ -191,7 +178,7 @@ let occur_rawconstr id =
                 (na=Name id or not(occur_fix bl)) in
           occur_fix bl)
           idl bl tyl bv)
-    | RCast (loc,c,t) -> (occur c) or (occur t)
+    | RCast (loc,c,_,t) -> (occur c) or (occur t)
     | (RSort _ | RHole _ | RRef _ | REvar _ | RPatVar _ | RDynamic _) -> false
 
   and occur_pattern (loc,idl,p,c) = not (List.mem id idl) & (occur c)
@@ -202,119 +189,6 @@ let occur_rawconstr id =
 
   in occur
 
-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_raw subst raw = 
-  match raw with
-  | RRef (loc,ref) -> 
-      let ref' = subst_global subst ref in 
-	if ref' == ref then raw else
-	  RRef (loc,ref')
-
-  | RVar _ -> raw
-  | REvar _ -> raw
-  | RPatVar _ -> raw
-
-  | RApp (loc,r,rl) -> 
-      let r' = subst_raw subst r 
-      and rl' = list_smartmap (subst_raw subst) rl in
-	if r' == r && rl' == rl then raw else
-	  RApp(loc,r',rl')
-
-  | RLambda (loc,n,r1,r2) -> 
-      let r1' = subst_raw subst r1 and r2' = subst_raw subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  RLambda (loc,n,r1',r2')
-
-  | RProd (loc,n,r1,r2) -> 
-      let r1' = subst_raw subst r1 and r2' = subst_raw subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  RProd (loc,n,r1',r2')
-
-  | RLetIn (loc,n,r1,r2) -> 
-      let r1' = subst_raw subst r1 and r2' = subst_raw subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  RLetIn (loc,n,r1',r2')
-
-  | RCases (loc,(ro,rtno),rl,branches) -> 
-      let ro' = option_smartmap (subst_raw subst) ro 
-      and rtno' = ref (option_smartmap (subst_raw subst) !rtno)
-      and rl' = list_smartmap (fun (a,x as y) ->
-        let a' = subst_raw subst a in
-        let (n,topt) = !x in 
-        let topt' = option_smartmap
-          (fun (loc,(sp,i),x as t) ->
-            let sp' = subst_kn subst sp in
-            if sp == sp' then t else (loc,(sp',i),x)) topt in
-        if a == a' && topt == topt' then y else (a',ref (n,topt'))) rl
-      and branches' = list_smartmap 
-			(fun (loc,idl,cpl,r as branch) ->
-			   let cpl' = list_smartmap (subst_pat subst) cpl
-			   and r' = subst_raw subst r in
-			     if cpl' == cpl && r' == r then branch else
-			       (loc,idl,cpl',r'))
-			branches
-      in
-	if ro' == ro && rl' == rl && branches' == branches then raw else
-	  RCases (loc,(ro',rtno'),rl',branches')
-
-  | ROrderedCase (loc,b,ro,r,ra,x) -> 
-      let ro' = option_smartmap (subst_raw subst) ro
-      and r' = subst_raw subst r 
-      and ra' = array_smartmap (subst_raw subst) ra in
-	if ro' == ro && r' == r && ra' == ra then raw else
-	  ROrderedCase (loc,b,ro',r',ra',x)
-
-  | RLetTuple (loc,nal,(na,po),b,c) ->
-      let po' = option_smartmap (subst_raw subst) po
-      and b' = subst_raw subst b 
-      and c' = subst_raw subst c in
-	if po' == po && b' == b && c' == c then raw else
-          RLetTuple (loc,nal,(na,po'),b',c')
-      
-  | RIf (loc,c,(na,po),b1,b2) ->
-      let po' = option_smartmap (subst_raw subst) po
-      and b1' = subst_raw subst b1 
-      and b2' = subst_raw subst b2 
-      and c' = subst_raw subst c in
-	if c' == c & po' == po && b1' == b1 && b2' == b2 then raw else
-          RIf (loc,c',(na,po'),b1',b2')
-
-  | RRec (loc,fix,ida,bl,ra1,ra2) -> 
-      let ra1' = array_smartmap (subst_raw subst) ra1
-      and ra2' = array_smartmap (subst_raw subst) ra2 in
-      let bl' = array_smartmap
-        (list_smartmap (fun (na,obd,ty as dcl) ->
-          let ty' = subst_raw subst ty in
-          let obd' = option_smartmap (subst_raw subst) obd in
-          if ty'==ty & obd'==obd then dcl else (na,obd',ty')))
-        bl in
-	if ra1' == ra1 && ra2' == ra2 && bl'==bl then raw else
-	  RRec (loc,fix,ida,bl',ra1',ra2')
-
-  | RSort _ -> raw
-
-  | RHole (loc,ImplicitArg (ref,i)) ->
-      let ref' = subst_global subst ref in 
-	if ref' == ref then raw else
-	  RHole (loc,ImplicitArg (ref',i))
-  | RHole (loc, (BinderType _ | QuestionMark | CasesType |
-      InternalHole | TomatchTypeParameter _)) -> raw
-
-  | RCast (loc,r1,r2) -> 
-      let r1' = subst_raw subst r1 and r2' = subst_raw subst r2 in
-	if r1' == r1 && r2' == r2 then raw else
-	  RCast (loc,r1',r2')
-
-  | RDynamic _ -> raw
-
 let loc_of_rawconstr = function
   | RRef (loc,_) -> loc
   | RVar (loc,_) -> loc
@@ -325,15 +199,47 @@ let loc_of_rawconstr = function
   | RProd (loc,_,_,_) -> loc
   | RLetIn (loc,_,_,_) -> loc
   | RCases (loc,_,_,_) -> loc
-  | ROrderedCase (loc,_,_,_,_,_) -> loc
   | RLetTuple (loc,_,_,_,_) -> loc
   | RIf (loc,_,_,_,_) -> loc
   | RRec (loc,_,_,_,_,_) -> loc
   | RSort (loc,_) -> loc
   | RHole (loc,_) -> loc
-  | RCast (loc,_,_) -> loc
+  | RCast (loc,_,_,_) -> loc
   | RDynamic (loc,_) -> loc
 
+(**********************************************************************)
+(* Conversion from rawconstr to cases pattern, if possible            *)
+
+let rec cases_pattern_of_rawconstr na = function
+  | RVar (loc,id) when na<>Anonymous ->
+      (* Unable to manage the presence of both an alias and a variable *)
+      raise Not_found
+  | RVar (loc,id) -> PatVar (loc,Name id)
+  | RHole (loc,_) -> PatVar (loc,na)
+  | RRef (loc,ConstructRef cstr) ->
+      PatCstr (loc,cstr,[],na)
+  | RApp (loc,RRef (_,ConstructRef cstr),l) ->
+      PatCstr (loc,cstr,List.map (cases_pattern_of_rawconstr Anonymous) l,na)
+  | _ -> raise Not_found
+
+(* Turn a closed cases pattern into a rawconstr *)
+let rec rawconstr_of_closed_cases_pattern_aux = function
+  | PatCstr (loc,cstr,[],Anonymous) ->
+      RRef (loc,ConstructRef cstr)
+  | PatCstr (loc,cstr,l,Anonymous) ->
+      let ref = RRef (loc,ConstructRef cstr) in
+      RApp (loc,ref, List.map rawconstr_of_closed_cases_pattern_aux l)
+  | _ -> raise Not_found
+
+let rawconstr_of_closed_cases_pattern = function
+  | PatCstr (loc,cstr,l,na) ->
+      na,rawconstr_of_closed_cases_pattern_aux (PatCstr (loc,cstr,l,Anonymous))
+  | _ ->
+      raise Not_found
+
+(**********************************************************************)
+(* Reduction expressions                                              *)
+
 type 'a raw_red_flag = {
   rBeta : bool;
   rIota : bool;
@@ -357,6 +263,7 @@ type ('a,'b) red_expr_gen =
   | Fold of 'a list
   | Pattern of 'a occurrences list
   | ExtraRedExpr of string
+  | CbvVm
 
 type ('a,'b) may_eval =
   | ConstrTerm of 'a
diff --git a/pretyping/rawterm.mli b/pretyping/rawterm.mli
index 97e11af6..22317b5f 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,v 1.47.2.5 2005/01/21 16:42:37 herbelin Exp $ i*)
+(*i $Id: rawterm.mli 8624 2006-03-13 17:38:17Z msozeau $ i*)
 
 (*i*)
 open Util
@@ -31,8 +31,6 @@ type patvar = identifier
 
 type rawsort = RProp of Term.contents | RType of Univ.universe option
 
-type fix_kind = RFix of (int array * int) | RCoFix of int
-
 type binder_kind = BProd | BLambda | BLetIn
 
 type quantified_hypothesis = AnonHyp of int | NamedHyp of identifier
@@ -46,14 +44,6 @@ type 'a bindings =
 
 type 'a with_bindings = 'a * 'a bindings
 
-type hole_kind =
-  | ImplicitArg of global_reference * (int * identifier option)
-  | BinderType of name
-  | QuestionMark
-  | CasesType
-  | InternalHole
-  | TomatchTypeParameter of inductive * int
-
 type rawconstr = 
   | RRef of (loc * global_reference)
   | RVar of (loc * identifier)
@@ -63,26 +53,27 @@ type rawconstr =
   | RLambda of loc * name * rawconstr * rawconstr
   | RProd of loc * name * rawconstr * rawconstr
   | RLetIn of loc * name * rawconstr * rawconstr
-  | RCases of loc * (rawconstr option * rawconstr option ref) *
-      (rawconstr * (name * (loc * inductive * name list) option) ref) list * 
+  | RCases of loc * rawconstr option *
+      (rawconstr * (name * (loc * inductive * name list) option)) list * 
       (loc * identifier list * cases_pattern list * rawconstr) list
-  | ROrderedCase of loc * case_style * rawconstr option * rawconstr * 
-      rawconstr array * rawconstr option ref
   | RLetTuple of loc * name list * (name * rawconstr option) * 
       rawconstr * rawconstr
   | RIf of loc * rawconstr * (name * rawconstr option) * rawconstr * rawconstr
   | RRec of loc * fix_kind * identifier array * rawdecl list array *
       rawconstr array * rawconstr array
   | RSort of loc * rawsort
-  | RHole of (loc * hole_kind)
-  | RCast of loc * rawconstr * rawconstr
+  | RHole of (loc * Evd.hole_kind)
+  | RCast of loc * rawconstr * cast_kind * rawconstr
   | RDynamic of loc * Dyn.t
 
 and rawdecl = name * rawconstr option * rawconstr
 
+and fix_recursion_order = RStructRec | RWfRec of rawconstr
+
+and fix_kind = RFix of ((int * fix_recursion_order) array * int) | RCoFix of int
+
 val cases_predicate_names : 
-  (rawconstr * (name * (loc * inductive * name list) option) ref) list ->
-      name list
+  (rawconstr * (name * (loc * inductive * name list) option)) list -> name list
 
 (*i - if PRec (_, names, arities, bodies) is in env then arities are
    typed in env too and bodies are typed in env enriched by the
@@ -107,7 +98,18 @@ val occur_rawconstr : identifier -> rawconstr -> bool
 
 val loc_of_rawconstr : rawconstr -> loc
 
-val subst_raw : Names.substitution -> rawconstr -> rawconstr
+(**********************************************************************)
+(* Conversion from rawconstr to cases pattern, if possible            *)
+
+(* Take the current alias as parameter, raise Not_found if *)
+(* translation is impossible *)
+
+val cases_pattern_of_rawconstr : name -> rawconstr -> cases_pattern
+
+val rawconstr_of_closed_cases_pattern : cases_pattern -> name * rawconstr
+
+(**********************************************************************)
+(* Reduction expressions                                              *)
 
 type 'a raw_red_flag = {
   rBeta : bool;
@@ -131,6 +133,7 @@ type ('a,'b) red_expr_gen =
   | Fold of 'a list
   | Pattern of 'a occurrences list
   | ExtraRedExpr of string
+  | CbvVm
 
 type ('a,'b) may_eval =
   | ConstrTerm of 'a
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml
index 3e73cfee..87997d99 100755..100644
--- a/pretyping/recordops.ml
+++ b/pretyping/recordops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: recordops.ml,v 1.26.2.2 2005/11/29 21:40:52 letouzey Exp $ *)
+(* $Id: recordops.ml 8642 2006-03-17 10:09:02Z notin $ *)
 
 open Util
 open Pp
@@ -19,133 +19,199 @@ open Typeops
 open Libobject
 open Library
 open Classops
+open Mod_subst
 
-(*s Une structure S est un type inductif non récursif à un seul
-   constructeur (de nom par défaut Build_S) *)
+(*s A structure S is a non recursive inductive type with a single
+   constructor (the name of which defaults to Build_S) *)
 
 (* Table des structures: le nom de la structure (un [inductive]) donne
    le nom du constructeur, le nombre de paramètres et pour chaque
-   argument réels du constructeur, le noms de la projection
-   correspondante, si valide *)
+   argument réel du constructeur, le nom de la projection
+   correspondante, si valide, et un booléen disant si c'est une vraie
+   projection ou bien une fonction constante (associée à un LetIn) *)
 
 type struc_typ = {
   s_CONST : identifier; 
   s_PARAM : int;
+  s_PROJKIND : bool list;
   s_PROJ : constant option list }
 
 let structure_table = ref (Indmap.empty : struc_typ Indmap.t)
-let projection_table = ref KNmap.empty
+let projection_table = ref Cmap.empty
 
 let option_fold_right f p e = match p with Some a -> f a e | None -> e
 
-let cache_structure (_,(ind,struc)) =
+let load_structure i (_,(ind,id,kl,projs)) =
+  let n = (fst (Global.lookup_inductive ind)).Declarations.mind_nparams in
+  let struc =
+    { s_CONST = id; s_PARAM = n; s_PROJ = projs; s_PROJKIND = kl } in
   structure_table := Indmap.add ind struc !structure_table;
   projection_table := 
-    List.fold_right (option_fold_right (fun proj -> KNmap.add proj struc))
-      struc.s_PROJ !projection_table
+    List.fold_right (option_fold_right (fun proj -> Cmap.add proj struc))
+      projs !projection_table
 
-let subst_structure (_,subst,((kn,i),struc as obj)) = 
+let cache_structure o =
+  load_structure 1 o
+
+let subst_structure (_,subst,((kn,i),id,kl,projs as obj)) = 
   let kn' = subst_kn subst kn in
-  let proj' = list_smartmap 
-		(option_smartmap (subst_kn subst)) 
-		struc.s_PROJ 
+  let projs' =
+   (* invariant: struc.s_PROJ is an evaluable reference. Thus we can take *)
+   (* the first component of subst_con.                                   *)
+   list_smartmap 
+     (option_smartmap (fun kn -> fst (subst_con subst kn)))
+    projs
   in
-    if proj' == struc.s_PROJ && kn' == kn then obj else
-      (kn',i),{struc with s_PROJ = proj'}
+    if projs' == projs && kn' == kn then obj else
+      ((kn',i),id,kl,projs')
+
+let discharge_structure (_,(ind,id,kl,projs)) =
+  Some (Lib.discharge_inductive ind, id, kl,
+        List.map (option_app Lib.discharge_con) projs)
 
 let (inStruc,outStruc) =
   declare_object {(default_object "STRUCTURE") with 
-                    cache_function = cache_structure;
-		    load_function = (fun _ o -> cache_structure o);
-                    subst_function = subst_structure;
-		    classify_function = (fun (_,x) -> Substitute x);
-		    export_function = (function x -> Some x)  }
+    cache_function = cache_structure;
+    load_function = load_structure;
+    subst_function = subst_structure;
+    classify_function = (fun (_,x) -> Substitute x);
+    discharge_function = discharge_structure;
+    export_function = (function x -> Some x) }
 
-let add_new_struc (s,c,n,l) = 
-  Lib.add_anonymous_leaf (inStruc (s,{s_CONST=c;s_PARAM=n;s_PROJ=l}))
+let declare_structure (s,c,_,kl,pl) = 
+  Lib.add_anonymous_leaf (inStruc (s,c,kl,pl))
 
-let find_structure indsp = Indmap.find indsp !structure_table
+let lookup_structure indsp = Indmap.find indsp !structure_table
 
 let find_projection_nparams = function
-  | ConstRef cst -> (KNmap.find cst !projection_table).s_PARAM
+  | ConstRef cst -> (Cmap.find cst !projection_table).s_PARAM
   | _ -> raise Not_found
 
-(*s Un "object" est une fonction construisant une instance d'une structure *)
+
+(************************************************************************)
+(*s A canonical structure declares "canonical" conversion hints between *)
+(*  the effective components of a structure and the projections of the  *)
+(*  structure *)
 
 (* Table des definitions "object" : pour chaque object c,
 
   c := [x1:B1]...[xk:Bk](Build_R a1...am t1...t_n)
 
-  avec ti = (ci ui1...uir)
+  If ti has the form (ci ui1...uir) where ci is a global reference and
+if the corresponding projection Li of the structure R is defined, one
+declare a "conversion" between ci and Li
+
+    x1:B1..xk:Bk |- (Li a1..am (c x1..xk)) =_conv (ci ui1...uir)
 
-  Pour tout ci, et Li, la ième projection de la structure R (si
-  définie), on déclare une "coercion"
+that maps the pair (Li,ci) to the following data
 
     o_DEF = c
     o_TABS = B1...Bk
     o_PARAMS = a1...am
     o_TCOMP = ui1...uir
+
 *)
 
 type obj_typ = {
   o_DEF : constr;
-  o_TABS : constr list;    (* dans l'ordre *)
-  o_TPARAMS : constr list; (* dans l'ordre *)
-  o_TCOMPS : constr list } (* dans l'ordre *)
-
-let subst_obj subst obj =
-  let o_DEF' = subst_mps subst obj.o_DEF in
-  let o_TABS' = list_smartmap (subst_mps subst) obj.o_TABS in    
-  let o_TPARAMS' = list_smartmap (subst_mps subst) obj.o_TPARAMS in 
-  let o_TCOMPS' = list_smartmap (subst_mps subst) obj.o_TCOMPS in 
-    if o_DEF' == obj.o_DEF
-      && o_TABS' == obj.o_TABS    
-      && o_TPARAMS' == obj.o_TPARAMS 
-      && o_TCOMPS' == obj.o_TCOMPS 
-    then 
-      obj
-    else
-      { o_DEF = o_DEF' ;
-	o_TABS = o_TABS' ;    
-	o_TPARAMS = o_TPARAMS' ; 
-	o_TCOMPS = o_TCOMPS' }
+  o_TABS : constr list;    (* ordered *)
+  o_TPARAMS : constr list; (* ordered *)
+  o_TCOMPS : constr list } (* ordered *)
 
 let object_table =
   (ref [] : ((global_reference * global_reference) * obj_typ) list ref)
 
-let cache_object (_,x) = object_table := x :: (!object_table)
-
-let subst_object (_,subst,((r1,r2),o as obj)) = 
-  let r1' = subst_global subst r1 in
-  let r2' = subst_global subst r2 in
-  let o' = subst_obj subst o in
-    if r1' == r1 && r2' == r2 && o' == o then obj else
-      (r1',r2'),o'
-
-let (inObjDef,outObjDef) =
-  declare_object {(default_object "OBJDEF") with 
-		    open_function = (fun i o -> if i=1 then cache_object o);
-                    cache_function = cache_object;
-		    subst_function = subst_object;
-		    classify_function = (fun (_,x) -> Substitute x);
-                    export_function = (function x -> Some x) }
-
-let add_new_objdef (o,c,la,lp,l) =
-  try 
-    let _ = List.assoc o !object_table in ()
-  with Not_found -> 
-    Lib.add_anonymous_leaf
-      (inObjDef (o,{o_DEF=c;o_TABS=la;o_TPARAMS=lp;o_TCOMPS=l}))
-
-let cache_objdef1 (_,sp) = ()
-
-let (inObjDef1,outObjDef1) =
-  declare_object {(default_object "OBJDEF1") with 
-		    open_function = (fun i o -> if i=1 then cache_objdef1 o);
-                    cache_function = cache_objdef1;
-                    export_function = (function x -> Some x) }
-
-let objdef_info o = List.assoc o !object_table
+let canonical_projections () = !object_table
+
+let keep_true_projections projs kinds =
+  map_succeed (function (p,true) -> p | _ -> failwith "")
+    (List.combine projs kinds)
+
+(* Intended to always success *)
+let compute_canonical_projections (con,ind) =
+  let v = mkConst con in
+  let c = Environ.constant_value (Global.env()) con in
+  let lt,t = Reductionops.splay_lambda (Global.env()) Evd.empty c in
+  let lt = List.rev (List.map snd lt) in
+  let args = snd (decompose_app t) in
+  let { s_PARAM = p; s_PROJ = lpj; s_PROJKIND = kl } = lookup_structure ind in
+  let params, projs = list_chop p args in
+  let lpj = keep_true_projections lpj kl in
+  let lps = List.combine lpj projs in
+  let comp =
+    List.fold_left
+      (fun l (spopt,t) -> (* comp=components *)
+	 match spopt with
+           | Some proji_sp ->
+	       let c, args = decompose_app t in
+	       (try (ConstRef proji_sp, global_of_constr c, args) :: l
+                with Not_found -> l)
+	   | _ -> l)
+      [] lps in
+  List.map (fun (refi,c,argj) ->
+    (refi,c),{o_DEF=v; o_TABS=lt; o_TPARAMS=params; o_TCOMPS=argj})
+    comp
+
+let open_canonical_structure i (_,o) =
+  if i=1 then
+    let lo = compute_canonical_projections o in
+    List.iter (fun (o,_ as x) ->
+      if not (List.mem_assoc o !object_table) then
+	object_table := x :: (!object_table)) lo
+
+let cache_canonical_structure o =
+  open_canonical_structure 1 o
+
+let subst_canonical_structure (_,subst,(cst,ind as obj)) =
+  (* invariant: cst is an evaluable reference. Thus we can take *)
+  (* the first component of subst_con.                                   *)
+  let cst' = fst (subst_con subst cst) in
+  let ind' = Inductiveops.subst_inductive subst ind in
+  if cst' == cst & ind' == ind then obj else (cst',ind')
+
+let discharge_canonical_structure (_,(cst,ind)) =
+  Some (Lib.discharge_con cst,Lib.discharge_inductive ind)
+
+let (inCanonStruc,outCanonStruct) =
+  declare_object {(default_object "CANONICAL-STRUCTURE") with 
+    open_function = open_canonical_structure;
+    cache_function = cache_canonical_structure;
+    subst_function = subst_canonical_structure;
+    classify_function = (fun (_,x) -> Substitute x);
+    discharge_function = discharge_canonical_structure;
+    export_function = (function x -> Some x) }
+
+let add_canonical_structure x = Lib.add_anonymous_leaf (inCanonStruc x)
+
+(*s High-level declaration of a canonical structure *)
+
+let error_not_structure ref =
+  errorlabstrm "object_declare"
+    (Nameops.pr_id (id_of_global ref) ++ str" is not a structure object")
+
+let check_and_decompose_canonical_structure ref =
+  let sp = match ref with ConstRef sp -> sp | _ -> error_not_structure ref in
+  let env = Global.env () in
+  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
+    | App (f,args) -> f,args
+    | _ -> error_not_structure ref in
+  let indsp = match kind_of_term f with
+    | Construct (indsp,1) -> indsp
+    | _ -> error_not_structure ref in
+  let s = try lookup_structure indsp with Not_found -> error_not_structure ref in
+  if s.s_PARAM + List.length s.s_PROJ > Array.length args then
+    error_not_structure ref;
+  (sp,indsp)
+
+let declare_canonical_structure ref =
+  add_canonical_structure (check_and_decompose_canonical_structure ref)
+
+let outCanonicalStructure x = fst (outCanonStruct x)
+
+let lookup_canonical_conversion o = List.assoc o !object_table
 
 let freeze () =
   !structure_table, !projection_table, !object_table
@@ -154,7 +220,7 @@ let unfreeze (s,p,o) =
   structure_table := s; projection_table := p; object_table := o
 
 let init () =
-  structure_table := Indmap.empty; projection_table := KNmap.empty;
+  structure_table := Indmap.empty; projection_table := Cmap.empty;
   object_table:=[]
 
 let _ = init()
diff --git a/pretyping/recordops.mli b/pretyping/recordops.mli
index a458b7b3..1e061dc6 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,v 1.15.2.2 2005/11/29 21:40:52 letouzey Exp $ i*)
+(*i $Id: recordops.mli 6748 2005-02-18 22:17:50Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -18,34 +18,36 @@ open Libobject
 open Library
 (*i*)
 
+(*s A structure S is a non recursive inductive type with a single
+   constructor (the name of which defaults to Build_S) *)
+
 type struc_typ = {
   s_CONST : identifier; 
   s_PARAM : int;
+  s_PROJKIND : bool list;
   s_PROJ : constant option list }
 
-val add_new_struc : 
-  inductive * identifier * int * constant option list -> unit
+val declare_structure : 
+  inductive * identifier * int * bool list * constant option list -> unit
 
-(* [find_structure isp] returns the infos associated to inductive path
+(* [lookup_structure isp] returns the infos associated to inductive path
    [isp] if it corresponds to a structure, otherwise fails with [Not_found] *)
-val find_structure : inductive -> struc_typ
+val lookup_structure : inductive -> struc_typ
 
 (* raise [Not_found] if not a projection *)
 val find_projection_nparams : global_reference -> int
 
+(*s A canonical structure declares "canonical" conversion hints between *)
+(*  the effective components of a structure and the projections of the  *)
+(*  structure *)
+
 type obj_typ = {
   o_DEF : constr;
-  o_TABS : constr list; (* dans l'ordre *)
-  o_TPARAMS : constr list; (* dans l'ordre *)
-  o_TCOMPS : constr list } (* dans l'ordre *)
+  o_TABS : constr list;    (* ordered *)
+  o_TPARAMS : constr list; (* ordered *)
+  o_TCOMPS : constr list } (* ordered *)
                
-val objdef_info : (global_reference * global_reference) -> obj_typ
-val add_new_objdef : 
-  (global_reference * global_reference) * Term.constr * Term.constr list *
-  Term.constr list * Term.constr list -> unit
-
-
-val inStruc : inductive * struc_typ -> obj
-val outStruc : obj -> inductive * struc_typ
-val inObjDef1 : kernel_name -> obj
-val outObjDef1 : obj -> kernel_name
+val lookup_canonical_conversion : (global_reference * global_reference) -> obj_typ
+val declare_canonical_structure : global_reference -> unit
+val canonical_projections : unit -> 
+  ((global_reference * global_reference) * obj_typ) list
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index a030dcf2..b590f743 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: reductionops.ml,v 1.6.2.2 2004/07/16 19:30:46 herbelin Exp $ *)
+(* $Id: reductionops.ml 8708 2006-04-14 08:13:02Z jforest $ *)
 
 open Pp
 open Util
@@ -17,7 +17,6 @@ open Univ
 open Evd
 open Declarations
 open Environ
-open Instantiate
 open Closure
 open Esubst
 open Reduction
@@ -48,7 +47,7 @@ type local_state_reduction_function = state -> state
 let rec whd_state (x, stack as s) =
   match kind_of_term x with
     | App (f,cl) -> whd_state (f, append_stack cl stack)
-    | Cast (c,_)  -> whd_state (c, stack)
+    | Cast (c,_,_)  -> whd_state (c, stack)
     | _             -> s
 
 let appterm_of_stack (f,s) = (f,list_of_stack s)
@@ -189,7 +188,7 @@ let contract_cofix (bodynum,(types,names,bodies as typedbodies)) =
 
 let reduce_mind_case mia =
   match kind_of_term mia.mconstr with
-    | Construct (ind_sp,i as cstr_sp) ->
+    | Construct (ind_sp,i) ->
 (*	let ncargs = (fst mia.mci).(i-1) in*)
 	let real_cargs = list_skipn mia.mci.ci_npar mia.mcargs in
         applist (mia.mlf.(i-1),real_cargs)
@@ -255,7 +254,7 @@ let rec whd_state_gen flags env sigma =
 	     | Some  body -> whrec (body, stack)
 	     | None -> s)
       | LetIn (_,b,_,c) when red_zeta flags -> stacklam whrec [b] c stack
-      | Cast (c,_) -> whrec (c, stack)
+      | Cast (c,_,_) -> whrec (c, stack)
       | App (f,cl)  -> whrec (f, append_stack cl stack)
       | Lambda (na,t,c) ->
           (match decomp_stack stack with
@@ -300,7 +299,7 @@ let local_whd_state_gen flags =
   let rec whrec (x, stack as s) =
     match kind_of_term x with
       | LetIn (_,b,_,c) when red_zeta flags -> stacklam whrec [b] c stack
-      | Cast (c,_) -> whrec (c, stack)
+      | Cast (c,_,_) -> whrec (c, stack)
       | App (f,cl)  -> whrec (f, append_stack cl stack)
       | Lambda (_,_,c) ->
           (match decomp_stack stack with
@@ -339,6 +338,7 @@ let local_whd_state_gen flags =
   in 
   whrec
 
+
 (* 1. Beta Reduction Functions *)
 
 let whd_beta_state = local_whd_state_gen beta
@@ -427,12 +427,14 @@ let whd_betadeltaiota_nolet env sigma x =
 (* Replacing defined evars for error messages *)
 let rec whd_evar sigma c =
   match kind_of_term c with
-    | Evar (ev,args) when Evd.in_dom sigma ev & Evd.is_defined sigma ev ->
-	whd_evar sigma (Instantiate.existential_value sigma (ev,args))
+    | Evar (ev,args)
+        when Evd.in_dom sigma ev & Evd.is_defined sigma ev ->
+	whd_evar sigma (Evd.existential_value sigma (ev,args))
+    | Sort s when is_sort_variable sigma s -> whd_sort_variable sigma c
     | _ -> collapse_appl c
 
-let nf_evar sigma =
-  local_strong (whd_evar sigma)
+let nf_evar evd =
+  local_strong (whd_evar evd)
 
 (* lazy reduction functions. The infos must be created for each term *)
 let clos_norm_flags flgs env sigma t =
@@ -443,6 +445,120 @@ let nf_betaiota = clos_norm_flags Closure.betaiota empty_env Evd.empty
 let nf_betadeltaiota env sigma =
   clos_norm_flags Closure.betadeltaiota env sigma
 
+
+(* Attention reduire un beta-redexe avec un argument qui n'est pas 
+   une variable, peut changer enormement le temps de conversion lors
+   du type checking :
+     (fun x => x + x) M
+*)
+let nf_betaiotaevar_preserving_vm_cast env sigma t = 
+  let push decl (env,subst) = 
+    (Environ.push_rel decl env, Esubst.subs_lift subst) in
+  let cons decl v (env, subst) = (push_rel decl env, Esubst.subs_cons (v,subst)) in
+
+  let app_stack t (f, stack) = 
+    let t' = app_stack (f,stack) in
+    match kind_of_term t, kind_of_term t' with
+      | App(f,args), App(f',args') when f == f' && array_for_all2 (==) args args' -> t
+      | _ -> t'
+  in
+  let rec whrec (env, subst as es) (t, stack as s) =
+    match kind_of_term t with
+      | Rel i -> 
+	  let t' = 
+	    match Esubst.expand_rel i subst with
+	      | Inl (k,e) -> lift k e
+	      | Inr (k,None) -> mkRel k
+	      | Inr (k, Some p) -> lift (k-p) (mkRel p) (*??????? == mkRel k !  Julien *)
+                           (* Est correct ??? *)
+	  in
+	  if t = t' then s else t', stack
+      | Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _ -> s
+      | Evar (e,al) -> 
+	  let al' = Array.map (norm es) al in
+	  begin match existential_opt_value sigma (e,al') with
+	    | Some body -> whrec (env,Esubst.ESID 0) (body, stack) (**** ????? ****)
+	    | None ->
+		if array_for_all2 (==) al al' then s else (mkEvar (e, al'), stack)
+	  end
+      | Cast (c,VMcast,t) ->
+	  let c' = norm es c in
+	  let t' = norm es t in 
+	  if c == c' && t == t' then s
+	  else (mkCast(c',VMcast,t'),stack)
+      | Cast (c,DEFAULTcast,_) ->
+	  whrec es (c, stack)
+
+      | Prod (na,t,c) ->
+	  let t' = norm es t in
+	  let c' = norm (push (na, None, t') es) c in
+	  if t==t' && c==c' then s else (mkProd (na, t', c'), stack)
+
+      | Lambda (na,t,c) ->
+          begin match decomp_stack stack with
+            | Some (a,m) -> 
+		begin match kind_of_term a with
+		  | Rel i when not (evaluable_rel i env) ->
+                      whrec (cons (na,None,t) a es) (c, m)
+		  | Var id when  not (evaluable_named id env)->
+                      whrec (cons (na,None,t) a es) (c, m)
+		  | _ -> 
+		      let t' = norm es t in
+		      let c' = norm (push (na, None, t') es) c in
+		      if t == t' && c == c' then s
+		      else mkLambda (na, t', c'), stack
+		end
+            | _ -> 
+		let t' = norm es t in 
+		let c' =  norm (push (na, None, t') es) c  in 
+		if t == t' && c == c' then s 
+		else mkLambda(na,t',c'),stack
+		
+	  end
+      | LetIn (na,b,t,c) ->
+	  let b' = norm es b in
+	  let t' = norm es t in
+	  let c' = norm (push (na, Some b', t') es) c in
+	  if b==b' && t==t' && c==c' then s 
+	  else mkLetIn (na, b', t', c'), stack
+
+      | App (f,cl)  -> 
+          let cl' = Array.map (norm es) cl in
+          whrec es (f, append_stack cl' stack)
+
+      | Case (ci,p,d,lf) ->
+          let (c,cargs) = whrec es (d, empty_stack) in
+          if reducible_mind_case c then
+            whrec es (reduce_mind_case
+                     {mP=p; mconstr=c; mcargs=list_of_stack cargs;
+		      mci=ci; mlf=lf}, stack)
+          else     
+	    let p' = norm es p in
+	    let d' = app_stack d (c,cargs) in 
+	    let lf' = Array.map (norm es) lf in
+	    if p==p' && d==d' && array_for_all2 (==) lf lf' then s 
+	    else (mkCase (ci, p', d', lf'), stack)
+      | Fix (ln,(lna,tl,bl)) ->
+	  let tl' = Array.map (norm es) tl in
+	  let es' =
+            array_fold_left2 (fun es na t -> push (na,None,t) es) es lna tl' in
+	  let bl' = Array.map (norm es') bl in
+	  if array_for_all2 (==) tl tl' && array_for_all2 (==) bl bl'
+	  then s
+	  else (mkFix (ln,(lna,tl',bl')), stack)
+      | CoFix(ln,(lna,tl,bl)) ->
+	  let tl' = Array.map (norm es) tl in
+	  let es' =
+            array_fold_left2 (fun es na t -> push (na,None,t) es) es lna tl in
+	  let bl' = Array.map (norm es') bl in
+	  if array_for_all2 (==) tl tl' && array_for_all2 (==) bl bl'
+	  then s
+	  else (mkCoFix (ln,(lna,tl',bl')), stack)
+
+  and norm es t = app_stack t (whrec es (t,empty_stack)) in
+  norm (env, Esubst.ESID 0) t
+
+
 (* lazy weak head reduction functions *)
 let whd_flags flgs env sigma t =
   whd_val (create_clos_infos flgs env) (inject (nf_evar sigma t))
@@ -462,10 +578,6 @@ let fhnf_apply info k h a = Profile.profile4 fakey fhnf_apply info k h a;;
 
 type conversion_test = constraints -> constraints
 
-type conv_pb = 
-  | CONV 
-  | CUMUL
-
 let pb_is_equal pb = pb = CONV
 
 let pb_equal = function
@@ -515,22 +627,22 @@ let plain_instance s c =
   let rec irec u = match kind_of_term u with
     | Meta p -> (try List.assoc p s with Not_found -> u)
     | App (f,l) when isCast f ->
-        let (f,t) = destCast f in
+        let (f,_,t) = destCast f in
         let l' = Array.map irec l in 
         (match kind_of_term f with
-          | Meta p ->
-              (* Don't flatten application nodes: this is used to extract a
-                 proof-term from a proof-tree and we want to keep the structure
-                 of the proof-tree *)
-              (try let g = List.assoc p s in
-              match kind_of_term g with
-                | App _ -> 
-                    let h = id_of_string "H" in
-                    mkLetIn (Name h,g,t,mkApp(mkRel 1,Array.map (lift 1) l'))
-                | _ -> mkApp (g,l')
-              with Not_found -> mkApp (f,l'))
-          | _ -> mkApp (irec f,l'))
-    | Cast (m,_) when isMeta m ->
+        | Meta p ->
+	    (* Don't flatten application nodes: this is used to extract a
+               proof-term from a proof-tree and we want to keep the structure
+               of the proof-tree *)
+	    (try let g = List.assoc p s in
+	    match kind_of_term g with
+            | App _ -> 
+                let h = id_of_string "H" in
+                mkLetIn (Name h,g,t,mkApp(mkRel 1,Array.map (lift 1) l'))
+            | _ -> mkApp (g,l')
+	    with Not_found -> mkApp (f,l'))
+        | _ -> mkApp (irec f,l'))	
+    | Cast (m,_,_) when isMeta m ->
 	(try List.assoc (destMeta m) s with Not_found -> u)
     | _ -> map_constr irec u
   in 
@@ -580,17 +692,28 @@ let splay_prod env sigma =
   in 
   decrec env []
 
+let splay_lambda env sigma = 
+  let rec decrec env m c =
+    let t = whd_betadeltaiota env sigma c in
+    match kind_of_term t with
+      | Lambda (n,a,c0) ->
+	  decrec (push_rel (n,None,a) env)
+	    ((n,a)::m) c0
+      | _ -> m,t
+  in 
+  decrec env []
+
 let splay_prod_assum env sigma = 
   let rec prodec_rec env l c =
     let t = whd_betadeltaiota_nolet env sigma c in
-    match kind_of_term c with
+    match kind_of_term t with
     | Prod (x,t,c)  ->
 	prodec_rec (push_rel (x,None,t) env)
 	  (Sign.add_rel_decl (x, None, t) l) c
     | LetIn (x,b,t,c) ->
 	prodec_rec (push_rel (x, Some b, t) env)
 	  (Sign.add_rel_decl (x, Some b, t) l) c
-    | Cast (c,_)    -> prodec_rec env l c
+    | Cast (c,_,_)    -> prodec_rec env l c
     | _               -> l,t
   in
   prodec_rec env Sign.empty_rel_context
@@ -613,6 +736,13 @@ let decomp_n_prod env sigma n =
   in 
   decrec env n Sign.empty_rel_context
 
+exception NotASort
+
+let decomp_sort env sigma t =
+  match kind_of_term (whd_betadeltaiota env sigma t) with
+  | Sort s -> s
+  | _ -> raise NotASort
+
 (* One step of approximation *)
 
 let rec apprec env sigma s =
@@ -715,3 +845,27 @@ let is_info_type env sigma t =
   (s = Prop Pos) ||
   (s <> Prop Null && 
    try info_arity env sigma t.utj_val with IsType -> true)
+
+(*************************************)
+(* Metas *)
+
+let meta_value evd mv = 
+  let rec valrec mv =
+    try
+      let b = meta_fvalue evd mv in
+      instance
+        (List.map (fun mv' -> (mv',valrec mv')) (Metaset.elements b.freemetas))
+        b.rebus
+    with Anomaly _ | Not_found -> 
+      mkMeta mv
+  in 
+  valrec mv
+
+let meta_instance env b =
+  let c_sigma =
+    List.map 
+      (fun mv -> (mv,meta_value env mv)) (Metaset.elements b.freemetas)
+  in 
+  instance c_sigma b.rebus
+
+let nf_meta env c = meta_instance env (mk_freelisted c)
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index 65cdd5cd..ff55cc0e 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,v 1.8.2.2 2004/07/16 19:30:46 herbelin Exp $ i*)
+(*i $Id: reductionops.mli 8708 2006-04-14 08:13:02Z jforest $ i*)
 
 (*i*)
 open Names
@@ -63,6 +63,7 @@ val nf_betaiota : local_reduction_function
 val nf_betadeltaiota : reduction_function
 val nf_evar : evar_map -> constr -> constr
 
+val nf_betaiotaevar_preserving_vm_cast : reduction_function
 (* Lazy strategy, weak head reduction *)
 val whd_evar :  evar_map -> constr -> constr
 val whd_beta : local_reduction_function
@@ -111,6 +112,10 @@ val whd_betadeltaiotaeta_stack :  stack_reduction_function
 val whd_betadeltaiotaeta_state :  state_reduction_function
 val whd_betadeltaiotaeta :  reduction_function
 
+
+
+
+
 val beta_applist : constr * constr list -> constr
 
 val hnf_prod_app     : env ->  evar_map -> constr -> constr -> constr
@@ -121,12 +126,14 @@ val hnf_lam_appvect  : env ->  evar_map -> constr -> constr array -> constr
 val hnf_lam_applist  : env ->  evar_map -> constr -> constr list -> constr
 
 val splay_prod : env ->  evar_map -> constr -> (name * constr) list * constr
+val splay_lambda : env ->  evar_map -> constr -> (name * constr) list * constr
 val splay_arity : env ->  evar_map -> constr -> (name * constr) list * sorts
 val sort_of_arity : env -> constr -> sorts
 val decomp_n_prod : 
   env ->  evar_map -> int -> constr -> Sign.rel_context * constr
 val splay_prod_assum :
   env ->  evar_map -> constr -> Sign.rel_context * constr
+val decomp_sort : env -> evar_map -> types -> sorts
 
 type 'a miota_args = {
   mP      : constr;     (* the result type *)
@@ -162,10 +169,6 @@ val reduce_fix : local_state_reduction_function -> fixpoint
 
 type conversion_test = constraints -> constraints
 
-type conv_pb = 
-  | CONV 
-  | CUMUL
-
 val pb_is_equal : conv_pb -> bool
 val pb_equal : conv_pb -> conv_pb
 
@@ -188,3 +191,7 @@ val instance : (metavariable * constr) list -> constr -> constr
 val hnf : env -> 'a evar_map -> constr -> constr * constr list
 i*)
 val apprec :  state_reduction_function
+
+(*s Meta-related reduction functions *)
+val meta_instance : evar_defs -> constr freelisted -> constr
+val nf_meta       : evar_defs -> constr -> constr
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 061382f7..32da4cea 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -6,22 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: retyping.ml,v 1.43.2.1 2004/07/16 19:30:46 herbelin Exp $ *)
+(* $Id: retyping.ml 8673 2006-03-29 21:21:52Z herbelin $ *)
 
 open Util
 open Term
 open Inductive
+open Inductiveops
 open Names
 open Reductionops
 open Environ
 open Typeops
 open Declarations
-open Instantiate
-
-let outsort env sigma t =
-  match kind_of_term (whd_betadeltaiota env sigma t) with
-    | Sort s -> s
-    | _ -> anomaly "Retyping: found a type of type which is not a sort"
 
 let rec subst_type env sigma typ = function
   | [] -> typ
@@ -38,9 +33,9 @@ let rec subst_type env sigma typ = function
 let sort_of_atomic_type env sigma ft args =
   let rec concl_of_arity env ar =
     match kind_of_term (whd_betadeltaiota env sigma ar) with
-      | Prod (na, t, b) -> concl_of_arity (push_rel (na,None,t) env) b
-      | Sort s -> s
-      | _ -> outsort env sigma (subst_type env sigma ft (Array.to_list args))
+    | Prod (na, t, b) -> concl_of_arity (push_rel (na,None,t) env) b
+    | Sort s -> s
+    | _ -> decomp_sort env sigma (subst_type env sigma ft (Array.to_list args))
   in concl_of_arity env ft
 
 let typeur sigma metamap =
@@ -61,7 +56,7 @@ let typeur sigma metamap =
     | Const c ->
         let cb = lookup_constant c env in
         body_of_type cb.const_type
-    | Evar ev -> existential_type sigma ev
+    | 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)
     | Case (_,p,c,lf) ->
@@ -78,15 +73,18 @@ 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)->
+    | App(f,args) when isInd f ->
+	let t = type_of_applied_inductive env (destInd f) args in
+        strip_outer_cast (subst_type env sigma t (Array.to_list args))
+    | App(f,args) ->
         strip_outer_cast
           (subst_type env sigma (type_of env f) (Array.to_list args))
-    | Cast (c,t) -> t
+    | Cast (c,_, t) -> t
     | Sort _ | Prod _ -> mkSort (sort_of env cstr)
 
   and sort_of env t = 
     match kind_of_term t with
-    | Cast (c,s) when isSort s -> destSort s
+    | Cast (c,_, s) when isSort s -> destSort s
     | Sort (Prop c) -> type_0
     | Sort (Type u) -> Type (Univ.super u)
     | Prod (name,t,c2) ->
@@ -95,16 +93,21 @@ let typeur sigma metamap =
           | Prop _, (Prop Pos as s) -> s
           | Type _, (Prop Pos as s) when
               Environ.engagement env = Some ImpredicativeSet -> s
-          | Type _ as s, Prop Pos -> s
-	  | _, (Type u2 as s) -> s (*Type Univ.dummy_univ*))
+          | Type u1, Prop Pos -> Type (Univ.sup u1 Univ.base_univ)
+	  | 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_applied_inductive env (destInd 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 _ ->
         anomaly "sort_of: Not a type (1)"
-    | _ -> outsort env sigma (type_of env t)
+    | _ -> decomp_sort env sigma (type_of env t)
 
   and sort_family_of env t =
     match kind_of_term t with
-    | Cast (c,s) when isSort s -> family_of_sort (destSort s)
+    | Cast (c,_, s) when isSort s -> family_of_sort (destSort s)
     | Sort (Prop c) -> InType
     | Sort (Type u) -> InType
     | Prod (name,t,c2) -> sort_family_of (push_rel (name,None,t) env) c2
@@ -112,16 +115,31 @@ let typeur sigma metamap =
        family_of_sort (sort_of_atomic_type env sigma (type_of env f) args)
     | Lambda _ | Fix _ | Construct _ ->
         anomaly "sort_of: Not a type (1)"
-    | _ -> family_of_sort (outsort env sigma (type_of env t))
+    | _ -> family_of_sort (decomp_sort env sigma (type_of env t))
+
+  and type_of_applied_inductive env ind args =
+    let specif = lookup_mind_specif env ind in
+    let t = Inductive.type_of_inductive specif in
+    if is_small_inductive specif then
+      (* No polymorphism *)
+      t
+    else
+      (* Retyping constructor with the actual arguments *)
+      let env',llc,ls0 = constructor_instances env specif ind args in
+      let lls = Array.map (Array.map (sort_of env')) llc in
+      let ls = Array.map max_inductive_sort lls in
+      set_inductive_level env (find_inductive_level env specif ind ls0 ls) t
 
-  in type_of, sort_of, sort_family_of
+  in type_of, sort_of, sort_family_of, type_of_applied_inductive
 
-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 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_applied_inductive env sigma ind args =
+  let _,_,_,f = typeur sigma [] in f env ind args
 
 let get_type_of_with_meta env sigma metamap = 
-  let f,_,_ = typeur sigma metamap in f env
+  let f,_,_,_ = typeur sigma metamap in f env
 
 (* Makes an assumption from a constr *)
 let get_assumption_of env evc c = c
diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli
index f29ac8d8..7adec66b 100644
--- a/pretyping/retyping.mli
+++ b/pretyping/retyping.mli
@@ -6,15 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: retyping.mli,v 1.16.2.1 2004/07/16 19:30:46 herbelin Exp $ i*)
+(*i $Id: retyping.mli 8673 2006-03-29 21:21:52Z herbelin $ i*)
 
 (*i*)
 open Names
 open Term
 open Evd
 open Environ
-open Pattern
-open Termops
 (*i*)
 
 (* This family of functions assumes its constr argument is known to be
@@ -23,14 +21,18 @@ open Termops
    either produces a wrong result or raise an anomaly. Use with care.
    It doesn't handle predicative universes too. *)
 
-val get_type_of : env -> evar_map -> constr -> constr
+val get_type_of : env -> evar_map -> constr -> types
 val get_sort_of : env -> evar_map -> types -> sorts
 val get_sort_family_of : env -> evar_map -> types -> sorts_family
 
-val get_type_of_with_meta : env -> evar_map -> metamap -> constr -> constr
+val get_type_of_with_meta :
+  env -> evar_map -> Termops.metamap -> constr -> types
 
 (* Makes an assumption from a constr *)
 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_applied_inductive : env -> evar_map -> inductive -> 
+  constr array -> types
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index e8bde1f3..88af6290 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacred.ml,v 1.75.2.7 2005/11/02 13:18:43 herbelin Exp $ *)
+(* $Id: tacred.ml 8003 2006-02-07 22:11:50Z herbelin $ *)
 
 open Pp
 open Util
@@ -20,39 +20,26 @@ open Inductive
 open Environ
 open Reductionops
 open Closure
-open Instantiate
 open Cbv
 open Rawterm
 
-exception Elimconst
-exception Redelimination
+(* Errors *)
 
-let set_opaque_const = Conv_oracle.set_opaque_const
-let set_transparent_const sp =
-  let cb = Global.lookup_constant sp in
-  if cb.const_body <> None & cb.const_opaque then
-    errorlabstrm "set_transparent_const"
-      (str "Cannot make" ++ spc () ++ 
-         Nametab.pr_global_env Idset.empty (ConstRef sp) ++
-         spc () ++ str "transparent because it was declared opaque.");
-  Conv_oracle.set_transparent_const sp
+type reduction_tactic_error = 
+    InvalidAbstraction of env * constr * (env * Type_errors.type_error)
 
-let set_opaque_var      = Conv_oracle.set_opaque_var
-let set_transparent_var = Conv_oracle.set_transparent_var
+exception ReductionTacticError of reduction_tactic_error
 
-let _ = 
-  Summary.declare_summary "Transparent constants and variables"
-    { Summary.freeze_function = Conv_oracle.freeze;
-      Summary.unfreeze_function = Conv_oracle.unfreeze;
-      Summary.init_function = Conv_oracle.init;
-      Summary.survive_module = false;
-      Summary.survive_section = false }
+(* Evaluable reference *)
+
+exception Elimconst
+exception Redelimination
 
 let is_evaluable env ref =
   match ref with
       EvalConstRef kn ->
         let (ids,kns) = Conv_oracle.freeze() in
-        KNpred.mem kn kns &
+        Cpred.mem kn kns &
         let cb = Environ.lookup_constant kn env in
         cb.const_body <> None & not cb.const_opaque
     | EvalVarRef id ->
@@ -84,7 +71,7 @@ let destEvalRef c = match kind_of_term c with
   | Var id  -> EvalVar id
   | Rel n -> EvalRel n
   | Evar ev -> EvalEvar ev
-  | _ -> anomaly "Not an evaluable reference"
+  | _ -> anomaly "Not an unfoldable reference"
 
 let reference_opt_value sigma env = function
   | EvalConst cst -> constant_opt_value env cst
@@ -94,7 +81,7 @@ let reference_opt_value sigma env = function
   | EvalRel n ->
       let (_,v,_) = lookup_rel n env in
       option_app (lift n) v
-  | EvalEvar ev -> existential_opt_value sigma ev
+  | EvalEvar ev -> Evd.existential_opt_value sigma ev
 
 exception NotEvaluable
 let reference_value sigma env c =
@@ -145,17 +132,21 @@ let _ =
       Summary.survive_module = false;
       Summary.survive_section = false }
 
-
 (* Check that c is an "elimination constant"
-   [xn:An]..[x1:A1](<P>MutCase (Rel i) of f1..fk end g1 ..gp)
-   or [xn:An]..[x1:A1](Fix(f|t) (Rel i1) ..(Rel ip)) 
-    with i1..ip distinct variables not occuring in t 
-   keep relevenant information ([i1,Ai1;..;ip,Aip],n,b)
-   with b = true in case of a fixpoint in order to compute 
-   an equivalent of Fix(f|t)[xi<-ai] as 
-   [yip:Bip]..[yi1:Bi1](F bn..b1) 
-   == [yip:Bip]..[yi1:Bi1](Fix(f|t)[xi<-ai] (Rel 1)..(Rel p))
-   with bj=aj if j<>ik and bj=(Rel c) and Bic=Aic[xn..xic-1 <- an..aic-1] *)
+
+   either [xn:An]..[x1:A1](<P>Case (Rel i) of f1..fk end g1 ..gp)
+
+   or     [xn:An]..[x1:A1](Fix(f|t) (Rel i1) ..(Rel ip))
+          with i1..ip distinct variables not occuring in t 
+
+   In the second case, keep relevenant information ([i1,Ai1;..;ip,Aip],n)
+   in order to compute an equivalent of Fix(f|t)[xi<-ai] as 
+
+      [yip:Bip]..[yi1:Bi1](F bn..b1) 
+   == [yip:Bip]..[yi1:Bi1](Fix(f|t)[xi<-ai] (Rel p)..(Rel 1))
+
+   with bj=aj if j<>ik and bj=(Rel c) and Bic=Aic[xn..xic-1 <- an..aic-1]
+*)
 
 let check_fix_reversibility labs args ((lv,i),(_,tys,bds)) =
   let n = List.length labs in
@@ -199,8 +190,8 @@ let invert_name labs l na0 env sigma ref = function
 	  | EvalRel _ | EvalEvar _ -> None
 	  | EvalVar id' -> Some (EvalVar id)
 	  | EvalConst kn ->
-	      let (mp,dp,_) = repr_kn kn in
-	      Some (EvalConst (make_kn mp dp (label_of_id id))) in
+	      let (mp,dp,_) = repr_con kn in
+	      Some (EvalConst (make_con mp dp (label_of_id id))) in
 	match refi with
 	  | None -> None
 	  | Some ref ->
@@ -242,7 +233,7 @@ let compute_consteval_mutual_fix sigma env ref =
     match kind_of_term c' with
       | Lambda (na,t,g) when l=[] ->
 	  srec (push_rel (na,None,t) env) (minarg+1) (t::labs) ref g
-      | Fix ((lv,i),(names,_,_) as fix) ->
+      | Fix ((lv,i),(names,_,_)) ->
 	  (* Last known constant wrapping Fix is ref = [labs](Fix l) *)
 	  (match compute_consteval_direct sigma env ref with
 	     | NotAnElimination -> (*Above const was eliminable but this not!*)
@@ -294,43 +285,49 @@ let rev_firstn_liftn fn ln =
   in 
   rfprec fn []
 
-(*  EliminationFix ([(yi1,Ti1);...;(yip,Tip)],n) means f is some
-   [y1:T1,...,yn:Tn](Fix(..) yi1 ... yip);
-   f is applied to largs and we need for recursive calls to build
-   [x1:Ti1',...,xp:Tip'](f a1..a(n-p) yi1 ... yip) 
-   where a1...an are the n first arguments of largs and Tik' is Tik[yil=al]
-   To check ... *)
+(* If f is bound to EliminationFix (n',infos), then n' is the minimal
+   number of args for starting the reduction and infos is
+   (nbfix,[(yi1,Ti1);...;(yip,Tip)],n) indicating that f converts
+   to some [y1:T1,...,yn:Tn](Fix(..) yip .. yi1) where we can remark that
+   yij = Rel(n+1-j)
+
+   f is applied to largs and we need for recursive calls to build the function
+      g := [xp:Tip',...,x1:Ti1'](f a1 ... an)
+
+   s.t. (g u1 ... up) reduces to (Fix(..) u1 ... up)
+
+   This is made possible by setting 
+      a_k:=z_j    if k=i_j
+      a_k:=y_k    otherwise
+
+   The type Tij' is Tij[yn..yi(j-1)..y1 <- ai(j-1)..a1]
+*)
+
+let x = Name (id_of_string "x")
 
 let make_elim_fun (names,(nbfix,lv,n)) largs =
-  let labs = list_firstn n (list_of_stack largs) in
+  let lu = list_firstn n (list_of_stack largs) in
   let p = List.length lv in
-  let ylv = List.map fst lv in
-  let la' = list_map_i 
-	      (fun q aq ->
-		 try (mkRel (p+1-(list_index (n-q) ylv))) 
-		 with Not_found -> aq) 0
-              (List.map (lift p) labs) 
+  let lyi = List.map fst lv in
+  let la =
+    list_map_i (fun q aq -> 
+      (* k from the comment is q+1 *) 
+      try mkRel (p+1-(list_index (n-q) lyi))
+      with Not_found -> aq)
+      0 (List.map (lift p) lu) 
   in 
   fun i ->
     match names.(i) with
       | None -> None
-      | Some ref -> Some (
-(*    let fi =
-      if nbfix = 1 then
-	mkEvalRef ref
-      else
-	match ref with
-	  | EvalConst (sp,args) ->
-	      mkConst (make_path (dirpath sp) id (kind_of_path sp),args)
-	  | _ -> anomaly "elimination of local fixpoints not implemented"
-    in
-*)
-      list_fold_left_i 
-	(fun i c (k,a) -> 
-	   mkLambda (Name(id_of_string"x"),
-		     substl (rev_firstn_liftn (n-k) (-i) la') a,
-		     c))
-	1 (applistc (mkEvalRef ref) la') (List.rev lv))
+      | Some ref ->
+          let body = applistc (mkEvalRef ref) la in
+          let g = 
+            list_fold_left_i (fun q (* j from comment is n+1-q *) c (ij,tij) ->
+              let subst = List.map (lift (-q)) (list_firstn (n-ij) la) in
+              let tij' = substl (List.rev subst) tij in
+	      mkLambda (x,tij',c)
+            ) 1 body (List.rev lv)
+          in Some g
 
 (* [f] is convertible to [Fix(recindices,bodynum),bodyvect)] make 
    the reduction using this extra information *)
@@ -372,7 +369,7 @@ let contract_cofix_use_function f (bodynum,(_,names,bodies as typedbodies)) =
 
 let reduce_mind_case_use_function func env mia =
   match kind_of_term mia.mconstr with 
-    | Construct(ind_sp,i as cstr_sp) ->
+    | Construct(ind_sp,i) ->
 	let real_cargs = list_skipn mia.mci.ci_npar mia.mcargs in
 	applist (mia.mlf.(i-1), real_cargs)
     | CoFix (_,(names,_,_) as cofix) ->
@@ -380,8 +377,8 @@ let reduce_mind_case_use_function func env mia =
 	  match names.(i) with 
 	    | Name id ->
                 if isConst func then
-		  let (mp,dp,_) = repr_kn (destConst func) in
-		  let kn = make_kn mp dp (label_of_id id) in
+		  let (mp,dp,_) = repr_con (destConst func) in
+		  let kn = make_con mp dp (label_of_id id) in
 		  (match constant_opt_value env kn with
 		    | None -> None
 		    | Some _ -> Some (mkConst kn))
@@ -452,7 +449,7 @@ let rec red_elim_const env sigma ref largs =
 and construct_const env sigma = 
   let rec hnfstack (x, stack as s) =
     match kind_of_term x with
-      | Cast (c,_) -> hnfstack (c, stack)
+      | Cast (c,_,_) -> hnfstack (c, stack)
       | App (f,cl) -> hnfstack (f, append_stack cl stack)
       | Lambda (id,t,c) ->
           (match decomp_stack stack with 
@@ -491,7 +488,7 @@ and construct_const env sigma =
 
 (* Red reduction tactic: reduction to a product *)
 
-let internal_red_product env sigma c = 
+let try_red_product env sigma c = 
   let simpfun = clos_norm_flags betaiotazeta env sigma in
   let rec redrec env x =
     match kind_of_term x with
@@ -506,7 +503,7 @@ let internal_red_product env sigma c =
                         let stack' = stack_assign stack recargnum recarg' in
                         simpfun (app_stack (f,stack')))
              | _ -> simpfun (appvect (redrec env f, l)))
-      | Cast (c,_) -> redrec env c
+      | Cast (c,_,_) -> redrec env c
       | Prod (x,a,b) -> mkProd (x, a, redrec (push_rel (x,None,a) env) b)
       | LetIn (x,a,b,t) -> redrec env (subst1 a t)
       | Case (ci,p,d,lf) -> simpfun (mkCase (ci,p,redrec env d,lf))
@@ -521,11 +518,9 @@ let internal_red_product env sigma c =
   in redrec env c
 
 let red_product env sigma c = 
-  try internal_red_product env sigma c
+  try try_red_product env sigma c
   with Redelimination -> error "Not reducible"
 
-(* Hnf reduction tactic: *)
-
 let hnf_constr env sigma c = 
   let rec redrec (x, largs as s) =
     match kind_of_term x with
@@ -536,7 +531,7 @@ let hnf_constr env sigma c =
 		 stacklam redrec [a] c rest)
       | LetIn (n,b,t,c) -> stacklam redrec [b] c largs
       | App (f,cl)   -> redrec (f, append_stack cl largs)
-      | Cast (c,_) -> redrec (c, largs)
+      | Cast (c,_,_) -> redrec (c, largs)
       | Case (ci,p,c,lf) ->
           (try
              redrec 
@@ -577,7 +572,7 @@ let whd_nf env sigma c =
 		 stacklam nf_app [a1] c2 rest)
       | LetIn (n,b,t,c) -> stacklam nf_app [b] c stack
       | App (f,cl) -> nf_app (f, append_stack cl stack)
-      | Cast (c,_) -> nf_app (c, stack)
+      | Cast (c,_,_) -> nf_app (c, stack)
       | Case (ci,p,d,lf) ->
           (try
              nf_app (special_red_case sigma env nf_app (ci,p,d,lf), stack)
@@ -598,9 +593,6 @@ let whd_nf env sigma c =
 
 let nf env sigma c = strong whd_nf env sigma c
 
-let is_reference c = 
-  try let r = reference_of_constr c in true with _ -> false
-
 let is_head c t =
   match kind_of_term t with
     | App (f,_) -> f = c
@@ -609,7 +601,6 @@ let is_head c t =
 let contextually byhead (locs,c) f env sigma t =
   let maxocc = List.fold_right max locs 0 in
   let pos = ref 1 in
-  let check = ref true in
   let except = List.exists (fun n -> n<0) locs in
   if except & (List.exists (fun n -> n>=0) locs) 
   then error "mixing of positive and negative occurences"
@@ -626,7 +617,7 @@ let contextually byhead (locs,c) f env sigma t =
 	f env sigma t
       else if byhead then
 	(* find other occurrences of c in t; TODO: ensure left-to-right *)
-        let (f,l) = destApplication t in
+        let (f,l) = destApp t in
 	mkApp (f, array_map_left (traverse envc) l)
       else
 	t
@@ -637,7 +628,7 @@ let contextually byhead (locs,c) f env sigma t =
   in
   let t' = traverse (env,c) t in
   if locs <> [] & List.exists (fun o -> o >= !pos or o <= - !pos) locs then
-    errorlabstrm "contextually" (str "Too few occurences");
+    error_invalid_occurrence locs;
   t'
 
 (* linear bindings (following pretty-printer) of the value of name in c.
@@ -652,7 +643,7 @@ let rec substlin env name n ol c =
           with
 	      NotEvaluableConst _ ->
 		errorlabstrm "substlin"
-		  (pr_kn kn ++ str " is not a defined constant")
+		  (pr_con kn ++ str " is not a defined constant")
         else 
 	  ((n+1), ol, c)
 
@@ -701,7 +692,7 @@ let rec substlin env name n ol c =
                let (n2,ol2,c2') = substlin env name n1 ol1 c2 in
                (n2,ol2,mkProd (na,c1',c2')))
 	
-    | Case (ci,p,d,llf) -> 
+    | Case (ci,p,d,llf) ->
         let rec substlist nn oll = function
           | []     -> (nn,oll,[])
           | f::lfe ->
@@ -712,24 +703,25 @@ let rec substlin env name n ol c =
                      let (nn2,oll2,lfe') = substlist nn1 oll1 lfe in
                      (nn2,oll2,f'::lfe'))
 	in
-	let (n1,ol1,p') = substlin env name n ol p in  (* ATTENTION ERREUR *)
-        (match ol1 with                                 (* si P pas affiche *)
-           | [] -> (n1,[],mkCase (ci, p', d, llf))
+	(* p is printed after d in v8 syntax *)
+	let (n1,ol1,d') = substlin env name n ol d in
+        (match ol1 with
+           | [] -> (n1,[],mkCase (ci, p, d', llf))
            | _  ->
-               let (n2,ol2,d') = substlin env name n1 ol1 d in
+               let (n2,ol2,p') = substlin env name n1 ol1 p in
                (match ol2 with
 		  | [] -> (n2,[],mkCase (ci, p', d', llf))
 		  | _  -> 
 	              let (n3,ol3,lf') = substlist n2 ol2 (Array.to_list llf)
                       in (n3,ol3,mkCase (ci, p', d', Array.of_list lf'))))
         
-    | Cast (c1,c2)   ->
+    | Cast (c1,k,c2)   ->
         let (n1,ol1,c1') = substlin env name n ol c1 in
         (match ol1 with 
-           | [] -> (n1,[],mkCast (c1',c2))
-           | _  ->
-               let (n2,ol2,c2') = substlin env name n1 ol1 c2 in
-               (n2,ol2,mkCast (c1',c2')))
+           | [] -> (n1,[],mkCast (c1',k,c2))
+           | _  -> 
+	       let (n2,ol2,c2') = substlin env name n1 ol1 c2 in
+               (n2,ol2,mkCast (c1',k,c2')))
 
     | Fix _ -> 
         (warning "do not consider occurrences inside fixpoints"; (n,ol,c))
@@ -764,8 +756,8 @@ let unfoldoccs env sigma (occl,name) c =
           | (_,[],uc) -> nf_betaiota uc
           | (1,_,_) ->
               error ((string_of_evaluable_ref env name)^" does not occur")
-          | _ -> error ("bad occurrence numbers of "
-			^(string_of_evaluable_ref env name))
+          | (_,l,_) ->
+	      error_invalid_occurrence l
 
 (* Unfold reduction tactic: *)
 let unfoldn loccname env sigma c = 
@@ -797,78 +789,29 @@ let compute = cbv_betadeltaiota
 (* gives [na:ta]c' such that c converts to ([na:ta]c' a), abstracting only
  * the specified occurrences. *)
 
-let abstract_scheme env sigma (locc,a) t =
+let abstract_scheme env sigma (locc,a) c =
   let ta = Retyping.get_type_of env sigma a in
   let na = named_hd env ta Anonymous in
   if occur_meta ta then error "cannot find a type for the generalisation";
   if occur_meta a then 
-    mkLambda (na,ta,t)
+    mkLambda (na,ta,c)
   else 
-    mkLambda (na, ta,subst_term_occ locc a t)
-
+    mkLambda (na,ta,subst_term_occ locc a c)
 
 let pattern_occs loccs_trm env sigma c =
   let abstr_trm = List.fold_right (abstract_scheme env sigma) loccs_trm c in
-  let _ = Typing.type_of env sigma abstr_trm in
-  applist(abstr_trm, List.map snd loccs_trm)
-
-(* Generic reduction: reduction functions used in reduction tactics *)
-
-type red_expr = (constr, evaluable_global_reference) red_expr_gen
-
-open RedFlags
-
-let make_flag_constant = function
-  | EvalVarRef id -> fVAR id
-  | EvalConstRef sp -> fCONST sp
-
-let make_flag f =
-  let red = no_red in
-  let red = if f.rBeta then red_add red fBETA else red in
-  let red = if f.rIota then red_add red fIOTA else red in
-  let red = if f.rZeta then red_add red fZETA else red in
-  let red =
-    if f.rDelta then (* All but rConst *)
-        let red = red_add red fDELTA in
-        let red = red_add_transparent red (Conv_oracle.freeze ()) in
-	List.fold_right
-	  (fun v red -> red_sub red (make_flag_constant v))
-	  f.rConst red
-    else (* Only rConst *)
-        let red = red_add_transparent (red_add red fDELTA) all_opaque in
-	List.fold_right
-	  (fun v red -> red_add red (make_flag_constant v))
-	  f.rConst red
-  in red
-
-let red_expr_tab = ref Stringmap.empty
-
-let declare_red_expr s f =
-  try 
-    let _ = Stringmap.find s !red_expr_tab in
-    error ("There is already a reduction expression of name "^s)
-  with Not_found ->
-    red_expr_tab := Stringmap.add s f !red_expr_tab
-
-let reduction_of_redexp = function
-  | Red internal -> if internal then internal_red_product else red_product
-  | Hnf -> hnf_constr
-  | Simpl (Some (_,c as lp)) -> contextually (is_reference c) lp nf
-  | Simpl None -> nf
-  | Cbv f -> cbv_norm_flags (make_flag f)
-  | Lazy f -> clos_norm_flags (make_flag f)
-  | Unfold ubinds -> unfoldn ubinds
-  | Fold cl -> fold_commands cl
-  | Pattern lp -> pattern_occs lp
-  | ExtraRedExpr s ->
-      (try Stringmap.find s !red_expr_tab
-      with Not_found -> error("unknown user-defined reduction \""^s^"\""))
+  try
+    let _ = Typing.type_of env sigma abstr_trm in
+    applist(abstr_trm, List.map snd loccs_trm)
+  with Type_errors.TypeError (env',t) ->
+    raise (ReductionTacticError (InvalidAbstraction (env,abstr_trm,(env',t))))
+
 (* Used in several tactics. *)
 
 exception NotStepReducible
 
 let one_step_reduce env sigma c = 
-  let rec redrec (x, largs as s) =
+  let rec redrec (x, largs) =
     match kind_of_term x with
       | Lambda (n,t,c)  ->
           (match decomp_stack largs with
@@ -885,7 +828,7 @@ let one_step_reduce env sigma c =
 	  (match reduce_fix (whd_betadeltaiota_state env sigma) fix largs with
              | Reduced s' -> s'
 	     | NotReducible -> raise NotStepReducible)
-      | Cast (c,_) -> redrec (c,largs)
+      | Cast (c,_,_) -> redrec (c,largs)
       | _ when isEvalRef env x ->
 	  let ref =
             try destEvalRef x
@@ -940,14 +883,14 @@ let reduce_to_ref_gen allow_product env sigma ref t =
 	       (str"Not an induction object of atomic type")
       | _ ->
 	  try 
-	    if reference_of_constr c = ref 
+	    if global_of_constr c = ref 
 	    then it_mkProd_or_LetIn t l
 	    else raise Not_found
 	  with Not_found ->
           try 
 	    let t' = nf_betaiota (one_step_reduce env sigma t) in 
 	    elimrec env t' l
-          with NotStepReducible -> 
+          with NotStepReducible ->
 	    errorlabstrm ""
 	    (str "Not a statement of conclusion " ++ 
 	     Nametab.pr_global_env Idset.empty ref)
diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli
index 7998a8fd..a5468435 100644
--- a/pretyping/tacred.mli
+++ b/pretyping/tacred.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tacred.mli,v 1.21.2.2 2005/01/21 16:42:37 herbelin Exp $ i*)
+(*i $Id: tacred.mli 8003 2006-02-07 22:11:50Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -18,15 +18,23 @@ open Closure
 open Rawterm
 (*i*)
 
+type reduction_tactic_error = 
+    InvalidAbstraction of env * constr * (env * Type_errors.type_error)
+
+exception ReductionTacticError of reduction_tactic_error
+
 (*s Reduction functions associated to tactics. \label{tacred} *)
 
 val is_evaluable : env -> evaluable_global_reference -> bool
 
 exception Redelimination
 
-(* Red (raise Redelimination if nothing reducible) *)
+(* Red (raise user error if nothing reducible) *)
 val red_product : reduction_function
 
+(* Red (raise Redelimination if nothing reducible) *)
+val try_red_product : reduction_function
+
 (* Hnf *)
 val hnf_constr :  reduction_function
 
@@ -69,17 +77,5 @@ val reduce_to_quantified_ref :
 val reduce_to_atomic_ref :
   env ->  evar_map -> Libnames.global_reference -> types -> types
 
-type red_expr = (constr, evaluable_global_reference) red_expr_gen
-
 val contextually : bool -> constr occurrences -> reduction_function
   -> reduction_function
-val reduction_of_redexp : red_expr -> reduction_function
-
-val declare_red_expr : string -> reduction_function -> unit
-
-(* Opaque and Transparent commands. *)
-val set_opaque_const      : constant -> unit
-val set_transparent_const : constant -> unit
-
-val set_opaque_var      : identifier -> unit
-val set_transparent_var : identifier -> unit
diff --git a/pretyping/termops.ml b/pretyping/termops.ml
index 8f12ca62..89de5537 100644
--- a/pretyping/termops.ml
+++ b/pretyping/termops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: termops.ml,v 1.29.2.1 2004/07/16 19:30:46 herbelin Exp $ *)
+(* $Id: termops.ml 8003 2006-02-07 22:11:50Z herbelin $ *)
 
 open Pp
 open Util
@@ -35,60 +35,116 @@ let pr_name = function
   | Anonymous -> str "_"
 
 let pr_sp sp = str(string_of_kn sp)
+let pr_con sp = str(string_of_con sp)
 
-let rec print_constr c = match kind_of_term c with
+let rec pr_constr c = match kind_of_term c with
   | Rel n -> str "#"++int n
   | Meta n -> str "Meta(" ++ int n ++ str ")"
   | Var id -> pr_id id
   | Sort s -> print_sort s
-  | Cast (c,t) -> hov 1 
-      (str"(" ++ print_constr c ++ cut() ++
-       str":" ++ print_constr t ++ str")")
+  | Cast (c,_, t) -> hov 1 
+      (str"(" ++ pr_constr c ++ cut() ++
+       str":" ++ pr_constr t ++ str")")
   | Prod (Name(id),t,c) -> hov 1
-      (str"forall " ++ pr_id id ++ str":" ++ print_constr t ++ str"," ++
-       spc() ++ print_constr c)
+      (str"forall " ++ pr_id id ++ str":" ++ pr_constr t ++ str"," ++
+       spc() ++ pr_constr c)
   | Prod (Anonymous,t,c) -> hov 0
-      (str"(" ++ print_constr t ++ str " ->" ++ spc() ++
-       print_constr c ++ str")")
+      (str"(" ++ pr_constr t ++ str " ->" ++ spc() ++
+       pr_constr c ++ str")")
   | Lambda (na,t,c) -> hov 1
       (str"fun " ++ pr_name na ++ str":" ++
-       print_constr t ++ str" =>" ++ spc() ++ print_constr c)
+       pr_constr t ++ str" =>" ++ spc() ++ pr_constr c)
   | LetIn (na,b,t,c) -> hov 0
-      (str"let " ++ pr_name na ++ str":=" ++ print_constr b ++
-       str":" ++ brk(1,2) ++ print_constr t ++ cut() ++
-       print_constr c)
+      (str"let " ++ pr_name na ++ str":=" ++ pr_constr b ++
+       str":" ++ brk(1,2) ++ pr_constr t ++ cut() ++
+       pr_constr c)
   | App (c,l) ->  hov 1
-      (str"(" ++ print_constr c ++ spc() ++
-       prlist_with_sep spc print_constr (Array.to_list l) ++ str")")
+      (str"(" ++ pr_constr c ++ spc() ++
+       prlist_with_sep spc pr_constr (Array.to_list l) ++ str")")
   | Evar (e,l) -> hov 1
       (str"Evar#" ++ int e ++ str"{" ++
-       prlist_with_sep spc print_constr (Array.to_list l) ++str"}")
-  | Const c -> str"Cst(" ++ pr_sp c ++ str")"
+       prlist_with_sep spc pr_constr (Array.to_list l) ++str"}")
+  | Const c -> str"Cst(" ++ pr_con c ++ str")"
   | Ind (sp,i) -> str"Ind(" ++ pr_sp sp ++ str"," ++ int i ++ str")"
   | Construct ((sp,i),j) ->
       str"Constr(" ++ pr_sp sp ++ str"," ++ int i ++ str"," ++ int j ++ str")"
   | Case (ci,p,c,bl) -> v 0
-      (hv 0 (str"<"++print_constr p++str">"++ cut() ++ str"Case " ++
-             print_constr c ++ str"of") ++ cut() ++
-       prlist_with_sep (fun _ -> brk(1,2)) print_constr (Array.to_list bl) ++
+      (hv 0 (str"<"++pr_constr p++str">"++ cut() ++ str"Case " ++
+             pr_constr c ++ str"of") ++ cut() ++
+       prlist_with_sep (fun _ -> brk(1,2)) pr_constr (Array.to_list bl) ++
       cut() ++ str"end")
   | Fix ((t,i),(lna,tl,bl)) ->
       let fixl = Array.mapi (fun i na -> (na,t.(i),tl.(i),bl.(i))) lna in
       hov 1
         (str"fix " ++ int i ++ spc() ++  str"{" ++
          v 0 (prlist_with_sep spc (fun (na,i,ty,bd) ->
-           pr_name na ++ str"/" ++ int i ++ str":" ++ print_constr ty ++
-           cut() ++ str":=" ++ print_constr bd) (Array.to_list fixl)) ++
+           pr_name na ++ str"/" ++ int i ++ str":" ++ pr_constr ty ++
+           cut() ++ str":=" ++ pr_constr bd) (Array.to_list fixl)) ++
          str"}")
   | CoFix(i,(lna,tl,bl)) ->
       let fixl = Array.mapi (fun i na -> (na,tl.(i),bl.(i))) lna in
       hov 1
         (str"cofix " ++ int i ++ spc() ++  str"{" ++
          v 0 (prlist_with_sep spc (fun (na,ty,bd) ->
-           pr_name na ++ str":" ++ print_constr ty ++
-           cut() ++ str":=" ++ print_constr bd) (Array.to_list fixl)) ++
+           pr_name na ++ str":" ++ pr_constr ty ++
+           cut() ++ str":=" ++ pr_constr bd) (Array.to_list fixl)) ++
          str"}")
 
+let term_printer = ref (fun _ -> pr_constr)
+let print_constr_env t = !term_printer t
+let print_constr t = !term_printer (Global.env()) t
+let set_print_constr f = term_printer := f
+
+let pr_var_decl env (id,c,typ) =
+  let pbody = match c with
+    | None ->  (mt ())
+    | Some c ->
+	(* Force evaluation *) 
+	let pb = print_constr_env env c in
+	  (str" := " ++ pb ++ cut () ) in
+  let pt = print_constr_env env typ in
+  let ptyp = (str" : " ++ pt) in
+    (pr_id id ++ hov 0 (pbody ++ ptyp))
+
+let pr_rel_decl env (na,c,typ) =
+  let pbody = match c with
+    | None -> mt ()
+    | Some c ->
+	(* Force evaluation *) 
+	let pb = print_constr_env env c in
+	  (str":=" ++ spc () ++ pb ++ spc ()) in
+  let ptyp = print_constr_env env typ in
+    match na with
+      | Anonymous -> hov 0 (str"<>" ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
+      | Name id -> hov 0 (pr_id id ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
+
+let print_named_context env =
+  hv 0 (fold_named_context
+	  (fun env d pps -> 
+	    pps ++ ws 2 ++ pr_var_decl env d)
+          env ~init:(mt ()))
+
+let print_rel_context env = 
+  hv 0 (fold_rel_context
+	  (fun env d pps -> pps ++ ws 2 ++ pr_rel_decl env d)
+          env ~init:(mt ()))
+    
+let print_env env =
+  let sign_env =
+    fold_named_context
+      (fun env d pps ->
+         let pidt =  pr_var_decl env d in
+	 (pps ++ fnl () ++ pidt))
+      env ~init:(mt ()) 
+  in
+  let db_env =
+    fold_rel_context
+      (fun env d pps ->
+         let pnat = pr_rel_decl env d in (pps ++ fnl () ++ pnat))
+      env ~init:(mt ())
+  in 
+    (sign_env ++ db_env)
+    
 (*let current_module = ref empty_dirpath
 
 let set_module m = current_module := m*)
@@ -98,6 +154,20 @@ let new_univ =
   (fun sp ->
     incr univ_gen; 
     Univ.make_univ (Lib.library_dp(),!univ_gen))
+let new_Type () = mkType (new_univ ())
+let new_Type_sort () = Type (new_univ ())
+
+(* This refreshes universes in types; works only for inferred types (i.e. for
+   types of the form (x1:A1)...(xn:An)B with B a sort or an atom in
+   head normal form) *)
+let refresh_universes t =
+  let modified = ref false in
+  let rec refresh t = match kind_of_term t with
+    | Sort (Type _) -> modified := true; new_Type ()
+    | Prod (na,u,v) -> mkProd (na,u,refresh v)
+    | _ -> t in
+  let t' = refresh t in
+  if !modified then t' else t
 
 let new_sort_in_family = function 
   | InProp -> mk_Prop
@@ -185,6 +255,8 @@ let it_named_context_quantifier f ~init =
 let it_mkNamedProd_or_LetIn = it_named_context_quantifier mkNamedProd_or_LetIn
 let it_mkNamedLambda_or_LetIn = it_named_context_quantifier mkNamedLambda_or_LetIn
 
+let it_mkNamedProd_wo_LetIn = it_named_context_quantifier mkNamedProd_wo_LetIn
+
 (* *)
 
 (* strips head casts and flattens head applications *)
@@ -192,11 +264,11 @@ let rec strip_head_cast c = match kind_of_term c with
   | App (f,cl) -> 
       let rec collapse_rec f cl2 = match kind_of_term f with
 	| App (g,cl1) -> collapse_rec g (Array.append cl1 cl2)
-	| Cast (c,_) -> collapse_rec c cl2
-	| _ -> if cl2 = [||] then f else mkApp (f,cl2)
+	| Cast (c,_,_) -> collapse_rec c cl2
+	| _ -> if Array.length cl2 = 0 then f else mkApp (f,cl2)
       in 
       collapse_rec f cl
-  | Cast (c,t) -> strip_head_cast c
+  | Cast (c,_,_) -> strip_head_cast c
   | _ -> c
 
 (* [map_constr_with_named_binders g f l c] maps [f l] on the immediate
@@ -208,7 +280,7 @@ let rec strip_head_cast c = match kind_of_term c with
 let map_constr_with_named_binders g f l c = match kind_of_term c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> c
-  | Cast (c,t) -> mkCast (f l c, f l t)
+  | Cast (c,k,t) -> mkCast (f l c, k, f l t)
   | Prod (na,t,c) -> mkProd (na, f l t, f (g na l) c)
   | Lambda (na,t,c) -> mkLambda (na, f l t, f (g na l) c)
   | LetIn (na,b,t,c) -> mkLetIn (na, f l b, f l t, f (g na l) c)
@@ -243,7 +315,7 @@ let fold_rec_types g (lna,typarray,_) e =
 let map_constr_with_binders_left_to_right g f l c = match kind_of_term c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> c
-  | Cast (c,t) -> let c' = f l c in mkCast (c', f l t)
+  | Cast (c,k,t) -> let c' = f l c in mkCast (c',k,f l t)
   | Prod (na,t,c) ->
       let t' = f l t in
       mkProd (na, t', f (g (na,None,t) l) c)
@@ -263,7 +335,9 @@ let map_constr_with_binders_left_to_right g f l c = match kind_of_term c with
       mkApp (hd, [| f l a |])
   | Evar (e,al) -> mkEvar (e, array_map_left (f l) al)
   | Case (ci,p,c,bl) ->
-      let p' = f l p in let c' = f l c in
+      (* In v8 concrete syntax, predicate is after the term to match! *)
+      let c' = f l c in
+      let p' = f l p in
       mkCase (ci, p', c', array_map_left (f l) bl)
   | Fix (ln,(lna,tl,bl as fx)) ->
       let l' = fold_rec_types g fx l in
@@ -278,10 +352,10 @@ let map_constr_with_binders_left_to_right g f l c = match kind_of_term c with
 let map_constr_with_full_binders g f l cstr = match kind_of_term cstr with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> cstr
-  | Cast (c,t) -> 
+  | Cast (c,k, t) -> 
       let c' = f l c in
       let t' = f l t in
-      if c==c' && t==t' then cstr else mkCast (c', t')
+      if c==c' && t==t' then cstr else mkCast (c', k, t')
   | Prod (na,t,c) ->
       let t' = f l t in
       let c' = f (g (na,None,t) l) c in
@@ -335,7 +409,7 @@ let map_constr_with_full_binders g f l cstr = match kind_of_term cstr with
 let fold_constr_with_binders g f n acc c = match kind_of_term c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> acc
-  | Cast (c,t) -> f n (f n acc c) t
+  | Cast (c,_, t) -> f n (f n acc c) t
   | Prod (_,t,c) -> f (g n) (f n acc t) c
   | Lambda (_,t,c) -> f (g n) (f n acc t) c
   | LetIn (_,b,t,c) -> f (g n) (f n (f n acc b) t) c
@@ -359,7 +433,7 @@ let fold_constr_with_binders g f n acc c = match kind_of_term c with
 let iter_constr_with_full_binders g f l c = match kind_of_term c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> ()
-  | Cast (c,t) -> f l c; f l t
+  | Cast (c,_, t) -> f l c; f l t
   | Prod (na,t,c) -> f l t; f (g (na,None,t) l) c
   | Lambda (na,t,c) -> f l t; f (g (na,None,t) l) c
   | LetIn (na,b,t,c) -> f l b; f l t; f (g (na,Some b,t) l) c
@@ -541,10 +615,14 @@ let replace_term = replace_term_gen eq_constr
    bindings is done. The list may contain only negative occurrences
    that will not be substituted. *)
 
+let error_invalid_occurrence l =
+  errorlabstrm ""
+    (str ("Invalid occurrence " ^ plural (List.length l) "number" ^": ") ++ 
+     prlist_with_sep spc int l)
+
 let subst_term_occ_gen locs occ c t =
   let maxocc = List.fold_right max locs 0 in
   let pos = ref occ in
-  let check = ref true in
   let except = List.exists (fun n -> n<0) locs in
   if except & (List.exists (fun n -> n>=0) locs) 
   then error "mixing of positive and negative occurences"
@@ -573,8 +651,8 @@ let subst_term_occ locs c t =
     t
   else 
     let (nbocc,t') = subst_term_occ_gen locs 1 c t in
-    if List.exists (fun o -> o >= nbocc or o <= -nbocc) locs then
-      errorlabstrm "subst_term_occ" (str "Too few occurences");
+    let rest = List.filter (fun o -> o >= nbocc or o <= -nbocc) locs in
+    if rest <> [] then error_invalid_occurrence rest;
     t'
 
 let subst_term_occ_decl locs c (id,bodyopt,typ as d) =
@@ -588,8 +666,8 @@ let subst_term_occ_decl locs c (id,bodyopt,typ as d) =
 	else 
 	  let (nbocc,body') = subst_term_occ_gen locs 1 c body in
 	  let (nbocc',t') = subst_term_occ_gen locs nbocc c typ in
-	  if List.exists (fun o -> o >= nbocc' or o <= -nbocc') locs then
-	    errorlabstrm "subst_term_occ_decl" (str "Too few occurences");
+	  let rest = List.filter (fun o -> o >= nbocc' or o <= -nbocc') locs in
+	  if rest <> [] then error_invalid_occurrence rest;
 	  (id,Some body',t')
 
 
@@ -626,10 +704,10 @@ let hdchar env c =
     | Prod (_,_,c)       -> hdrec (k+1) c
     | Lambda (_,_,c)     -> hdrec (k+1) c
     | LetIn (_,_,_,c)    -> hdrec (k+1) c
-    | Cast (c,_)         -> hdrec k c
+    | Cast (c,_,_)         -> hdrec k c
     | App (f,l)         -> hdrec k f
     | Const kn       ->
-	let c = lowercase_first_char (id_of_label (label kn)) in
+	let c = lowercase_first_char (id_of_label (con_label kn)) in
 	if c = "?" then "y" else c
     | Ind ((kn,i) as x) ->
 	if i=0 then 
@@ -667,8 +745,11 @@ let named_hd env a = function
 
 let named_hd_type env a = named_hd env (body_of_type a)
 
-let prod_name   env (n,a,b) = mkProd (named_hd_type env a n, a, b)
-let lambda_name env (n,a,b) = mkLambda (named_hd_type env a n, a, b)
+let mkProd_name   env (n,a,b) = mkProd (named_hd_type env a n, a, b)
+let mkLambda_name env (n,a,b) = mkLambda (named_hd_type env a n, a, b)
+
+let lambda_name = mkLambda_name
+let prod_name = mkProd_name
 
 let prod_create   env (a,b) = mkProd (named_hd_type env a Anonymous, a, b)
 let lambda_create env (a,b) =  mkLambda (named_hd_type env a Anonymous, a, b)
@@ -714,6 +795,7 @@ let ids_of_rel_context sign =
   Sign.fold_rel_context
     (fun (na,_,_) l -> match na with Name id -> id::l | Anonymous -> l)
     sign ~init:[]
+
 let ids_of_named_context sign =
   Sign.fold_named_context (fun (id,_,_) idl -> id::idl) sign ~init:[]
 
@@ -721,6 +803,7 @@ let ids_of_context env =
   (ids_of_rel_context (rel_context env))
   @ (ids_of_named_context (named_context env))
 
+
 let names_of_rel_context env =
   List.map (fun (na,_,_) -> na) (rel_context env)
 
@@ -734,7 +817,6 @@ let rec is_imported_modpath = function
 
 let is_imported_ref = function
   | VarRef _ -> false
-  | ConstRef kn 
   | IndRef (kn,_)
   | ConstructRef ((kn,_),_) 
 (*  | ModTypeRef ln  *) -> 
@@ -742,6 +824,8 @@ let is_imported_ref = function
 (*  | ModRef mp ->
       is_imported_modpath mp
 *)
+  | ConstRef kn ->
+      let (mp,_,_) = repr_con kn in is_imported_modpath mp
 
 let is_global id =
   try 
@@ -751,7 +835,7 @@ let is_global id =
     false
 
 let is_section_variable id =
-  try let _ = Sign.lookup_named id (Global.named_context()) in true
+  try let _ = Global.lookup_named id in true
   with Not_found -> false
 
 let next_global_ident_from allow_secvar id avoid = 
@@ -861,7 +945,7 @@ let eta_eq_constr =
 
 (* iterator on rel context *)
 let process_rel_context f env =
-  let sign = named_context env in
+  let sign = named_context_val env in
   let rels = rel_context env in
   let env0 = reset_with_named_context sign env in
   Sign.fold_rel_context f rels ~init:env0
@@ -933,6 +1017,6 @@ let rec rename_bound_var env l c =
   | Prod (Anonymous,c1,c2) ->
         let env' = push_rel (Anonymous,None,c1) env in
         mkProd (Anonymous, c1, rename_bound_var env' l c2)
-  | Cast (c,t) -> mkCast (rename_bound_var env l c, t)
+  | Cast (c,k,t) -> mkCast (rename_bound_var env l c, k,t)
   | x -> c
 
diff --git a/pretyping/termops.mli b/pretyping/termops.mli
index 22bd0aba..5f8b5376 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,v 1.21.2.3 2005/01/21 17:19:37 herbelin Exp $ i*)
+(*i $Id: termops.mli 8003 2006-02-07 22:11:50Z herbelin $ i*)
 
 open Util
 open Pp
@@ -16,14 +16,24 @@ open Sign
 open Environ
 
 (* Universes *)
-(*i val set_module : Names.dir_path -> unit i*)
 val new_univ : unit -> Univ.universe
 val new_sort_in_family : sorts_family -> sorts
+val new_Type : unit -> types
+val new_Type_sort : unit -> sorts
+val refresh_universes : types -> types
 
-(* iterators on terms *)
+(* printers *)
 val print_sort : sorts -> std_ppcmds
 val print_sort_family : sorts_family -> std_ppcmds
-val print_constr : constr -> std_ppcmds
+(* debug printer: do not use to display terms to the casual user... *)
+val set_print_constr : (env -> constr -> std_ppcmds) -> unit
+val print_constr     : constr -> std_ppcmds
+val print_constr_env : env -> constr -> std_ppcmds
+val print_named_context : env -> std_ppcmds
+val print_rel_context : env -> std_ppcmds
+val print_env : env -> std_ppcmds
+
+(* iterators on terms *)
 val prod_it : init:types -> (name * types) list -> types
 val lam_it : init:constr -> (name * types) list -> constr
 val rel_vect : int -> int -> constr array
@@ -43,6 +53,7 @@ val it_named_context_quantifier :
   (named_declaration -> 'a -> 'a) -> init:'a -> named_context -> 'a
 val it_mkNamedProd_or_LetIn   : init:types -> named_context -> types
 val it_mkNamedLambda_or_LetIn : init:constr -> named_context -> constr
+val it_mkNamedProd_wo_LetIn   : init:types -> named_context -> types
 
 (**********************************************************************)
 (* Generic iterators on constr                                        *)
@@ -113,6 +124,8 @@ val subst_term_occ : int list -> constr -> types -> types
 val subst_term_occ_decl :
   int list -> constr -> named_declaration -> named_declaration
 
+val error_invalid_occurrence : int list -> 'a
+
 (* Alternative term equalities *)
 val eta_reduce_head : constr -> constr
 val eta_eq_constr : constr -> constr -> bool
@@ -126,8 +139,14 @@ val id_of_name_using_hdchar :
   env -> types -> name -> identifier
 val named_hd : env -> types -> name -> name
 val named_hd_type : env -> types -> name -> name
-val prod_name : env -> name * types * types -> constr
+
+val mkProd_name : env -> name * types * types -> types
+val mkLambda_name : env -> name * types * constr -> constr
+
+(* Deprecated synonyms of [mkProd_name] and [mkLambda_name] *)
+val prod_name : env -> name * types * types -> types
 val lambda_name : env -> name * types * constr -> constr
+
 val prod_create : env -> types * types -> constr
 val lambda_create : env -> types * constr -> constr
 val name_assumption : env -> rel_declaration -> rel_declaration
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index a84cd612..be922c7d 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: typing.ml,v 1.32.6.2 2004/07/16 19:30:46 herbelin Exp $ *)
+(* $Id: typing.ml 8673 2006-03-29 21:21:52Z herbelin $ *)
 
 open Util
 open Names
@@ -16,68 +16,67 @@ open Reductionops
 open Type_errors
 open Pretype_errors
 open Inductive
+open Inductiveops
 open Typeops
+open Evd
+
+let meta_type env mv =
+  let ty =
+    try Evd.meta_ftype env mv
+    with Not_found -> error ("unknown meta ?"^string_of_int mv) in
+  meta_instance env ty
 
 let vect_lift = Array.mapi lift
 let vect_lift_type = Array.mapi (fun i t -> type_app (lift i) t)
 
-type 'a mach_flags = {
-  fix : bool;
-  nocheck : bool }
-
 (* The typing machine without information, without universes but with
    existential variables. *)
 
-let assumption_of_judgment env sigma j =
-  assumption_of_judgment env (j_nf_evar sigma j)
-
-let type_judgment env sigma j =
-  type_judgment env (j_nf_evar sigma j)
-
-
-let rec execute mf env sigma cstr =
+(* cstr must be in n.f. w.r.t. evars and execute returns a judgement
+   where both the term and type are in n.f. *)
+let rec execute env evd cstr =
   match kind_of_term cstr with
     | Meta n ->
-	error "execute: found a non-instanciated goal"
+        { uj_val = cstr; uj_type = nf_evar (evars_of evd) (meta_type evd n) }
 
     | Evar ev ->
-	let ty = Instantiate.existential_type sigma ev in
-	let jty = execute mf env sigma ty in
-	let jty = assumption_of_judgment env sigma jty in
+        let sigma = Evd.evars_of evd in
+	let ty = Evd.existential_type sigma ev in
+	let jty = execute env evd (nf_evar (evars_of evd) ty) in
+	let jty = assumption_of_judgment env jty in
 	{ uj_val = cstr; uj_type = jty }
 	
     | Rel n -> 
-	judge_of_relative env n
+	j_nf_evar (evars_of evd) (judge_of_relative env n)
 
     | Var id -> 
-        judge_of_variable env id
+        j_nf_evar (evars_of evd) (judge_of_variable env id)
 	  
     | Const c ->
-        make_judge cstr (constant_type env c)
+        make_judge cstr (nf_evar (evars_of evd) (constant_type env c))
 	  
     | Ind ind ->
-	make_judge cstr (type_of_inductive env ind)
+	make_judge cstr (nf_evar (evars_of evd) (type_of_inductive env ind))
 	  
     | Construct cstruct -> 
-	make_judge cstr (type_of_constructor env cstruct)
-	  
+	make_judge cstr
+          (nf_evar (evars_of evd) (type_of_constructor env cstruct))
+
     | Case (ci,p,c,lf) ->
-        let cj = execute mf env sigma c in
-        let pj = execute mf env sigma p in
-        let lfj = execute_array mf env sigma lf in
+        let cj = execute env evd c in
+        let pj = execute env evd p in
+        let lfj = execute_array env evd lf in
         let (j,_) = judge_of_case env ci pj cj lfj in
         j
   
     | Fix ((vn,i as vni),recdef) ->
-        if (not mf.fix) && array_exists (fun n -> n < 0) vn then
-          error "General Fixpoints not allowed";
-        let (_,tys,_ as recdef') = execute_recdef mf env sigma recdef in
+        let (_,tys,_ as recdef') = execute_recdef env evd recdef in
 	let fix = (vni,recdef') in
         check_fix env fix;
 	make_judge (mkFix fix) tys.(i)
 	  
     | CoFix (i,recdef) ->
-        let (_,tys,_ as recdef') = execute_recdef mf env sigma recdef in
+        let (_,tys,_ as recdef') = execute_recdef env evd recdef in
         let cofix = (i,recdef') in
         check_cofix env cofix;
 	make_judge (mkCoFix cofix) tys.(i)
@@ -89,86 +88,105 @@ let rec execute mf env sigma cstr =
 	judge_of_type u
 	  
     | App (f,args) ->
-	let j = execute mf env sigma f in
-        let jl = execute_array mf env sigma args in
+	let j = execute env evd f in
+        let jl = execute_array env evd args in
 	let (j,_) = judge_of_apply env j jl in
-	j
+	if isInd f then
+	  (* Sort-polymorphism of inductive types *)
+	  adjust_inductive_level env evd (destInd f) args j
+	else
+	  j
 	    
     | Lambda (name,c1,c2) -> 
-        let j = execute mf env sigma c1 in
-	let var = type_judgment env sigma j in
+        let j = execute env evd c1 in
+	let var = type_judgment env j in
 	let env1 = push_rel (name,None,var.utj_val) env in
-        let j' = execute mf env1 sigma c2 in 
+        let j' = execute env1 evd c2 in 
         judge_of_abstraction env1 name var j'
 	  
     | Prod (name,c1,c2) ->
-        let j = execute mf env sigma c1 in
-        let varj = type_judgment env sigma j in
+        let j = execute env evd c1 in
+        let varj = type_judgment env j in
 	let env1 = push_rel (name,None,varj.utj_val) env in
-        let j' = execute mf env1 sigma c2 in
-        let varj' = type_judgment env1 sigma j' in
+        let j' = execute env1 evd c2 in
+        let varj' = type_judgment env1 j' in
 	judge_of_product env name varj varj'
 
      | LetIn (name,c1,c2,c3) ->
-        let j1 = execute mf env sigma c1 in
-        let j2 = execute mf env sigma c2 in
-        let j2 = type_judgment env sigma j2 in
-        let _ =  judge_of_cast env j1 j2 in
+        let j1 = execute env evd c1 in
+        let j2 = execute env evd c2 in
+        let j2 = type_judgment env j2 in
+        let _ =  judge_of_cast env j1 DEFAULTcast j2 in
         let env1 = push_rel (name,Some j1.uj_val,j2.utj_val) env in
-        let j3 = execute mf env1 sigma c3 in
+        let j3 = execute env1 evd c3 in
         judge_of_letin env name j1 j2 j3
   
-    | Cast (c,t) ->
-        let cj = execute mf env sigma c in
-        let tj = execute mf env sigma t in
-	let tj = type_judgment env sigma tj in
-        let j, _ = judge_of_cast env cj tj in
+    | Cast (c,k,t) ->
+        let cj = execute env evd c in
+        let tj = execute env evd t in
+	let tj = type_judgment env tj in
+        let j, _ = judge_of_cast env cj k tj in
 	j
 
-and execute_recdef mf env sigma (names,lar,vdef) =
-  let larj = execute_array mf env sigma lar in
-  let lara = Array.map (assumption_of_judgment env sigma) larj in
+and execute_recdef env evd (names,lar,vdef) =
+  let larj = execute_array env evd lar in
+  let lara = Array.map (assumption_of_judgment env) larj in
   let env1 = push_rec_types (names,lara,vdef) env in
-  let vdefj = execute_array mf env1 sigma vdef in
+  let vdefj = execute_array env1 evd vdef in
   let vdefv = Array.map j_val vdefj in
   let _ = type_fixpoint env1 names lara vdefj in
   (names,lara,vdefv)
 
-and execute_array mf env sigma v =
-  let jl = execute_list mf env sigma (Array.to_list v) in
-  Array.of_list jl
-
-and execute_list mf env sigma = function
-  | [] -> 
-      []
-  | c::r -> 
-      let j = execute mf env sigma c in 
-      let jr = execute_list mf env sigma r in
-      j::jr
-
-
-let safe_machine env sigma constr = 
-  let mf = { fix = false; nocheck = false } in
-  execute mf env sigma constr
-
-let unsafe_machine env sigma constr =
-  let mf = { fix = false; nocheck = true } in
-  execute mf env sigma constr
+and execute_array env evd = Array.map (execute env evd)
+
+and execute_list env evd = List.map (execute env evd)
+
+and adjust_inductive_level env evd ind args j =
+  let specif = lookup_mind_specif env ind in
+  if is_small_inductive specif then
+    (* No polymorphism *)
+    j
+  else
+    (* Retyping constructor with the actual arguments *)
+    let env',llc,ls0 = constructor_instances env specif ind args in
+    let llj = Array.map (execute_array env' evd) llc in
+    let ls =
+      Array.map (fun lj ->
+	let ls =
+	  Array.map (fun c -> decomp_sort env (evars_of evd) c.uj_type) lj
+	in
+	max_inductive_sort ls) llj
+    in
+    let s = find_inductive_level env specif ind ls0 ls in
+    on_judgment_type (set_inductive_level env s) j
+
+let mcheck env evd c t =
+  let sigma = Evd.evars_of evd in
+  let j = execute env evd (nf_evar sigma c) in
+  if not (is_conv_leq env sigma j.uj_type t) then
+    error_actual_type env j (nf_evar sigma t)
 
 (* Type of a constr *)
-
-let type_of env sigma c = 
-  let j = safe_machine env sigma c in 
+ 
+let mtype_of env evd c =
+  let j = execute env evd (nf_evar (evars_of evd) c) in
   (* No normalization: it breaks Pattern! *)
   (*nf_betaiota*) (body_of_type j.uj_type)
 
-(* The typed type of a judgment. *)
+let msort_of env evd c =
+  let j = execute env evd (nf_evar (evars_of evd) c) in
+  let a = type_judgment env j in
+  a.utj_type
 
-let execute_type env sigma constr = 
-  let j = execute { fix=false; nocheck=true } env sigma constr in
-  assumption_of_judgment env sigma j
+let type_of env sigma c =
+  mtype_of env (Evd.create_evar_defs sigma) c
+let sort_of env sigma c =
+  msort_of env (Evd.create_evar_defs sigma) c
+let check env sigma c   =
+  mcheck env (Evd.create_evar_defs sigma) c
 
-let execute_rec_type env sigma constr = 
-  let j = execute { fix=false; nocheck=false } env sigma constr in
-  assumption_of_judgment env sigma j
+(* The typed type of a judgment. *)
 
+let mtype_of_type env evd constr =
+  let j = execute env evd (nf_evar (evars_of evd) constr) in
+  assumption_of_judgment env j
diff --git a/pretyping/typing.mli b/pretyping/typing.mli
index 4ea74dcd..c9d7d572 100644
--- a/pretyping/typing.mli
+++ b/pretyping/typing.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: typing.mli,v 1.7.14.1 2004/07/16 19:30:47 herbelin Exp $ i*)
+(*i $Id: typing.mli 6113 2004-09-17 20:28:19Z barras $ i*)
 
 (*i*)
 open Term
@@ -17,11 +17,18 @@ open Evd
 (* This module provides the typing machine with existential variables
    (but without universes). *)
 
-val unsafe_machine : env -> evar_map -> constr -> unsafe_judgment
-
-val type_of : env -> evar_map -> constr -> constr
-
-val execute_type : env -> evar_map -> constr -> types
-
-val execute_rec_type : env -> evar_map -> constr -> types
-
+(* Typecheck a term and return its type *)
+val type_of : env -> evar_map -> constr -> types
+(* Typecheck a type and return its sort *)
+val sort_of : env -> evar_map -> types -> sorts
+(* Typecheck a term has a given type (assuming the type is OK *)
+val check   : env -> evar_map -> constr -> types -> unit
+ 
+(* The same but with metas... *)
+val mtype_of : env -> evar_defs -> constr -> types
+val msort_of : env -> evar_defs -> types -> sorts
+val mcheck   : env -> evar_defs -> constr -> types -> unit
+val meta_type : evar_defs -> metavariable -> types
+ 
+(* unused typing function... *)
+val mtype_of_type : env -> evar_defs -> types -> types
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
new file mode 100644
index 00000000..e51f5e0e
--- /dev/null
+++ b/pretyping/unification.ml
@@ -0,0 +1,471 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: unification.ml 7113 2005-06-05 17:13:06Z barras $ *)
+
+open Pp
+open Util
+open Names
+open Nameops
+open Term
+open Termops
+open Sign
+open Environ
+open Evd
+open Reduction
+open Reductionops
+open Rawterm
+open Pattern
+open Evarutil
+open Pretype_errors
+
+(* if lname_typ is [xn,An;..;x1,A1] and l is a list of terms,
+   gives [x1:A1]..[xn:An]c' such that c converts to ([x1:A1]..[xn:An]c' l) *)
+
+let abstract_scheme env c l lname_typ =
+  List.fold_left2 
+    (fun t (locc,a) (na,_,ta) ->
+       let na = match kind_of_term a with Var id -> Name id | _ -> na in
+       if occur_meta ta then error "cannot find a type for the generalisation"
+       else if occur_meta a then lambda_name env (na,ta,t)
+       else lambda_name env (na,ta,subst_term_occ locc a t))
+    c
+    (List.rev l)
+    lname_typ
+
+let abstract_list_all env sigma typ c l =
+  let ctxt,_ = decomp_n_prod env sigma (List.length l) typ in
+  let p = abstract_scheme env c (List.map (function a -> [],a) l) ctxt in 
+  try 
+    if is_conv_leq env sigma (Typing.type_of env sigma p) typ then p
+    else error "abstract_list_all"
+  with UserError _ ->
+    raise (PretypeError (env,CannotGeneralize typ))
+
+
+(*******************************)
+
+(* Unification à l'ordre 0 de m et n: [unify_0 env sigma cv_pb m n]
+   renvoie deux listes:
+
+   metasubst:(int*constr)list    récolte les instances des (Meta k)
+   evarsubst:(constr*constr)list récolte les instances des (Const "?k")
+
+   Attention : pas d'unification entre les différences instances d'une
+   même meta ou evar, il peut rester des doublons *)
+
+(* Unification order: *)
+(* Left to right: unifies first argument and then the other arguments *)
+(*let unify_l2r x = List.rev x
+(* Right to left: unifies last argument and then the other arguments *)
+let unify_r2l x = x
+
+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
+    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
+
+  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)
+
+
+(* Unification
+ *
+ * Procedure:
+ * (1) The function [unify mc wc M N] produces two lists:
+ *     (a) a list of bindings Meta->RHS
+ *     (b) a list of bindings EVAR->RHS
+ *
+ * The Meta->RHS bindings cannot themselves contain
+ * meta-vars, so they get applied eagerly to the other
+ * bindings.  This may or may not close off all RHSs of
+ * the EVARs.  For each EVAR whose RHS is closed off,
+ * we can just apply it, and go on.  For each which
+ * is not closed off, we need to do a mimick step -
+ * in general, we have something like:
+ *
+ *      ?X == (c e1 e2 ... ei[Meta(k)] ... en)
+ *
+ * so we need to do a mimick step, converting ?X
+ * into
+ *
+ *      ?X -> (c ?z1 ... ?zn)
+ *
+ * of the proper types.  Then, we can decompose the
+ * equation into
+ *
+ *      ?z1 --> e1
+ *          ...
+ *      ?zi --> ei[Meta(k)]
+ *          ...
+ *      ?zn --> en
+ *
+ * and keep on going.  Whenever we find that a R.H.S.
+ * is closed, we can, as before, apply the constraint
+ * directly.  Whenever we find an equation of the form:
+ *
+ *      ?z -> Meta(n)
+ *
+ * we can reverse the equation, put it into our metavar
+ * substitution, and keep going.
+ *
+ * The most efficient mimick possible is, for each
+ * Meta-var remaining in the term, to declare a
+ * new EVAR of the same type.  This is supposedly
+ * determinable from the clausale form context -
+ * we look up the metavar, take its type there,
+ * and apply the metavar substitution to it, to
+ * close it off.  But this might not always work,
+ * since other metavars might also need to be resolved. *)
+
+let applyHead env evd n c  = 
+  let rec apprec n c cty evd =
+    if n = 0 then 
+      (evd, c)
+    else 
+      match kind_of_term (whd_betadeltaiota env (evars_of evd) cty) with
+        | Prod (_,c1,c2) ->
+            let (evd',evar) = Evarutil.new_evar evd env c1 in
+	    apprec (n-1) (mkApp(c,[|evar|])) (subst1 evar c2) evd'
+	| _ -> error "Apply_Head_Then"
+  in 
+  apprec n c (Typing.type_of env (evars_of evd) c) evd
+
+let is_mimick_head f =
+  match kind_of_term f with
+      (Const _|Var _|Rel _|Construct _|Ind _) -> true
+    | _ -> false
+ 
+(* [w_merge env sigma b metas evars] merges common instances in metas
+   or in evars, possibly generating new unification problems; if [b]
+   is true, unification of types of metas is required *)
+
+let w_merge env with_types mod_delta metas evars evd =
+  let ty_metas = ref [] in
+  let ty_evars = ref [] in
+  let rec w_merge_rec evd metas evars =
+    match (evars,metas) with
+      | ([], []) -> evd
+
+      | ((lhs,rhs)::t, metas) ->
+      (match kind_of_term rhs with
+
+	| Meta k -> w_merge_rec evd ((k,lhs)::metas) t
+
+	| krhs ->
+        (match kind_of_term lhs with
+
+	  | Evar (evn,_ as ev) ->
+    	      if is_defined_evar evd ev then
+		let (metas',evars') =
+                  unify_0 env (evars_of evd) CONV mod_delta rhs lhs in
+		w_merge_rec evd (metas'@metas) (evars'@t)
+    	      else begin
+		let rhs' = 
+		  if occur_meta rhs then subst_meta metas rhs else rhs 
+		in
+		if occur_evar evn rhs' then
+                  error "w_merge: recursive equation";
+                match krhs with
+		  | App (f,cl) when is_mimick_head f ->
+		      (try 
+		        w_merge_rec (fst (evar_define env ev rhs' evd)) metas t
+		      with ex when precatchable_exception ex ->
+                        let evd' =
+                          mimick_evar evd mod_delta f (Array.length cl) evn in
+			w_merge_rec evd' metas evars)
+                  | _ ->
+                      (* ensure tail recursion in non-mimickable case! *)
+		      w_merge_rec (fst (evar_define env ev rhs' evd)) metas t
+	      end
+
+	  | _ -> anomaly "w_merge_rec"))
+
+      | ([], (mv,n)::t) ->
+    	  if meta_defined evd mv then
+            let (metas',evars') =
+              unify_0 env (evars_of evd) CONV mod_delta
+               (meta_fvalue evd mv).rebus n in
+            w_merge_rec evd (metas'@t) evars'
+    	  else
+            begin
+	      if with_types (* or occur_meta mvty *) then
+	        (let mvty = Typing.meta_type evd mv in
+		try 
+                  let sigma = evars_of evd in
+                  (* why not typing with the metamap ? *)
+		  let nty = Typing.type_of env sigma (nf_meta evd n) in
+		  let (mc,ec) = unify_0 env sigma CUMUL mod_delta nty mvty in
+                  ty_metas := mc @ !ty_metas;
+                  ty_evars := ec @ !ty_evars
+		with e when precatchable_exception e -> ());
+              let evd' = meta_assign mv n evd in
+	      w_merge_rec evd' t []
+            end
+
+  and mimick_evar evd mod_delta hdc nargs sp =
+    let ev = Evd.map (evars_of evd) sp in
+    let sp_env = Global.env_of_context ev.evar_hyps in
+    let (evd', c) = applyHead sp_env evd nargs hdc in
+    let (mc,ec) =
+      unify_0 sp_env (evars_of evd') CUMUL mod_delta
+        (Retyping.get_type_of sp_env (evars_of evd') c) ev.evar_concl in
+    let evd'' = w_merge_rec evd' mc ec in
+    if (evars_of evd') == (evars_of evd'')
+    then Evd.evar_define sp c evd''
+    else Evd.evar_define sp (Evarutil.nf_evar (evars_of evd'') c) evd'' in
+
+  (* merge constraints *)
+  let evd' = w_merge_rec evd metas evars in
+  if with_types then
+    (* merge constraints about types: if they fail, don't worry *)
+    try w_merge_rec evd' !ty_metas !ty_evars
+    with e when precatchable_exception e -> evd'
+  else
+    evd'
+
+(* [w_unify env evd M N]
+   performs a unification of M and N, generating a bunch of
+   unification constraints in the process.  These constraints
+   are processed, one-by-one - they may either generate new
+   bindings, or, if there is already a binding, new unifications,
+   which themselves generate new constraints.  This continues
+   until we get failure, or we run out of constraints.
+   [clenv_typed_unify M N clenv] expects in addition that expected
+   types of metavars are unifiable with the types of their instances    *)
+
+let w_unify_core_0 env with_types cv_pb mod_delta m n evd =
+  let (mc,ec) = unify_0 env (evars_of evd) cv_pb mod_delta m n in 
+  w_merge env with_types mod_delta mc ec evd
+
+let w_unify_0 env = w_unify_core_0 env false
+let w_typed_unify env = w_unify_core_0 env true
+
+
+(* takes a substitution s, an open term op and a closed term cl
+   try to find a subterm of cl which matches op, if op is just a Meta
+   FAIL because we cannot find a binding *)
+
+let iter_fail f a =
+  let n = Array.length a in 
+  let rec ffail i =
+    if i = n then error "iter_fail" 
+    else
+      try f a.(i) 
+      with ex when precatchable_exception ex -> ffail (i+1)
+  in ffail 0
+
+(* Tries to find an instance of term [cl] in term [op].
+   Unifies [cl] to every subterm of [op] until it finds a match.
+   Fails if no match is found *)
+let w_unify_to_subterm env ?(mod_delta=true) (op,cl) evd =
+  let rec matchrec cl =
+    let cl = strip_outer_cast cl in
+    (try 
+       if closed0 cl 
+       then w_unify_0 env CONV mod_delta op cl evd,cl
+       else error "Bound 1"
+     with ex when precatchable_exception ex ->
+       (match kind_of_term cl with 
+	  | App (f,args) ->
+	      let n = Array.length args in
+	      assert (n>0);
+	      let c1 = mkApp (f,Array.sub args 0 (n-1)) in
+	      let c2 = args.(n-1) in
+	      (try 
+		 matchrec c1
+	       with ex when precatchable_exception ex -> 
+		 matchrec c2)
+          | Case(_,_,c,lf) -> (* does not search in the predicate *)
+	       (try 
+		 matchrec c
+	       with ex when precatchable_exception ex -> 
+		 iter_fail matchrec lf)
+	  | LetIn(_,c1,_,c2) -> 
+	       (try 
+		 matchrec c1
+	       with ex when precatchable_exception ex -> 
+		 matchrec c2)
+
+	  | Fix(_,(_,types,terms)) -> 
+	       (try 
+		 iter_fail matchrec types
+	       with ex when precatchable_exception ex -> 
+		 iter_fail matchrec terms)
+	
+	  | CoFix(_,(_,types,terms)) -> 
+	       (try 
+		 iter_fail matchrec types
+	       with ex when precatchable_exception ex -> 
+		 iter_fail matchrec terms)
+
+          | Prod (_,t,c) ->
+	      (try 
+		 matchrec t 
+	       with ex when precatchable_exception ex -> 
+		 matchrec c)
+          | Lambda (_,t,c) ->
+	      (try 
+		 matchrec t 
+	       with ex when precatchable_exception ex -> 
+		 matchrec c)
+          | _ -> error "Match_subterm")) 
+  in 
+  try matchrec cl
+  with ex when precatchable_exception ex ->
+    raise (PretypeError (env,NoOccurrenceFound op))
+
+let w_unify_to_subterm_list env mod_delta allow_K oplist t evd = 
+  List.fold_right 
+    (fun op (evd,l) ->
+      if isMeta op then
+	if allow_K then (evd,op::l)
+	else error "Match_subterm"
+      else if occur_meta op then
+        let (evd',cl) =
+          try 
+	    (* This is up to delta for subterms w/o metas ... *)
+	    w_unify_to_subterm env ~mod_delta (strip_outer_cast op,t) evd
+          with PretypeError (env,NoOccurrenceFound _) when allow_K -> (evd,op)
+        in 
+	(evd',cl::l)
+      else if allow_K or dependent op t then
+	(evd,op::l)
+      else
+	(* This is not up to delta ... *)
+	raise (PretypeError (env,NoOccurrenceFound op)))
+    oplist 
+    (evd,[])
+
+let secondOrderAbstraction env mod_delta allow_K typ (p, oplist) evd =
+  let sigma = evars_of evd in
+  let (evd',cllist) =
+    w_unify_to_subterm_list env mod_delta allow_K oplist typ evd in
+  let typp = Typing.meta_type evd' p in
+  let pred = abstract_list_all env sigma typp typ cllist in
+  w_unify_0 env CONV mod_delta (mkMeta p) pred evd'
+
+let w_unify2 env mod_delta allow_K cv_pb ty1 ty2 evd =
+  let c1, oplist1 = whd_stack ty1 in
+  let c2, oplist2 = whd_stack ty2 in
+  match kind_of_term c1, kind_of_term c2 with
+    | Meta p1, _ ->
+        (* Find the predicate *)
+	let evd' =
+          secondOrderAbstraction env mod_delta allow_K ty2 (p1,oplist1) evd in 
+        (* Resume first order unification *)
+	w_unify_0 env cv_pb mod_delta (nf_meta evd' ty1) ty2 evd'
+    | _, Meta p2 ->
+        (* Find the predicate *)
+	let evd' =
+          secondOrderAbstraction env mod_delta allow_K ty1 (p2, oplist2) evd in 
+        (* Resume first order unification *)
+	w_unify_0 env cv_pb mod_delta ty1 (nf_meta evd' ty2) evd'
+    | _ -> error "w_unify2"
+
+
+(* The unique unification algorithm works like this: If the pattern is
+   flexible, and the goal has a lambda-abstraction at the head, then
+   we do a first-order unification.
+
+   If the pattern is not flexible, then we do a first-order
+   unification, too.
+
+   If the pattern is flexible, and the goal doesn't have a
+   lambda-abstraction head, then we second-order unification. *)
+
+(* We decide here if first-order or second-order unif is used for Apply *)
+(* We apply a term of type (ai:Ai)C and try to solve a goal C'          *)
+(* The type C is in clenv.templtyp.rebus with a lot of Meta to solve    *)
+
+(* 3-4-99 [HH] New fo/so choice heuristic :
+   In case we have to unify (Meta(1) args) with ([x:A]t args')
+   we first try second-order unification and if it fails first-order.
+   Before, second-order was used if the type of Meta(1) and [x:A]t was
+   convertible and first-order otherwise. But if failed if e.g. the type of
+   Meta(1) had meta-variables in it. *)
+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
+
diff --git a/pretyping/unification.mli b/pretyping/unification.mli
new file mode 100644
index 00000000..6be530be
--- /dev/null
+++ b/pretyping/unification.mli
@@ -0,0 +1,33 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(*i $Id: unification.mli 6142 2004-09-27 19:33:01Z sacerdot $ i*)
+
+(*i*)
+open Term
+open Environ
+open Evd
+(*i*)
+
+(* The "unique" unification fonction *)
+val w_unify :
+  bool -> env -> conv_pb -> ?mod_delta:bool -> constr -> constr -> evar_defs -> evar_defs
+
+(* [w_unify_to_subterm env (c,t) m] performs unification of [c] with a
+   subterm of [t]. Constraints are added to [m] and the matched
+   subterm of [t] is also returned. *)
+val w_unify_to_subterm :
+  env -> ?mod_delta:bool -> constr * constr -> evar_defs -> evar_defs * constr
+
+(*i This should be in another module i*)
+
+(* [abstract_list_all env sigma t c l]                     *)
+(* abstracts the terms in l over c to get a term of type t *)
+(* (exported for inv.ml) *)
+val abstract_list_all :
+  env -> evar_map -> constr -> constr -> constr list -> constr
diff --git a/proofs/clenv.ml b/proofs/clenv.ml
deleted file mode 100644
index 999bb651..00000000
--- a/proofs/clenv.ml
+++ /dev/null
@@ -1,1175 +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        *)
-(************************************************************************)
-
-(* $Id: clenv.ml,v 1.97.2.4 2004/12/06 12:59:11 herbelin Exp $ *)
-
-open Pp
-open Util
-open Names
-open Nameops
-open Term
-open Termops
-open Sign
-open Instantiate
-open Environ
-open Evd
-open Proof_type
-open Refiner
-open Proof_trees
-open Logic
-open Reductionops
-open Tacmach
-open Evar_refiner
-open Rawterm
-open Pattern
-open Tacexpr
-
-(* if lname_typ is [xn,An;..;x1,A1] and l is a list of terms,
-   gives [x1:A1]..[xn:An]c' such that c converts to ([x1:A1]..[xn:An]c' l) *)
-
-let abstract_scheme env c l lname_typ =
-  List.fold_left2 
-    (fun t (locc,a) (na,_,ta) ->
-       let na = match kind_of_term a with Var id -> Name id | _ -> na in
-       if occur_meta ta then error "cannot find a type for the generalisation"
-       else if occur_meta a then lambda_name env (na,ta,t)
-       else lambda_name env (na,ta,subst_term_occ locc a t))
-    c
-    (List.rev l)
-    lname_typ
-
-let abstract_list_all env sigma typ c l =
-  let ctxt,_ = decomp_n_prod env sigma (List.length l) typ in
-  let p = abstract_scheme env c (List.map (function a -> [],a) l) ctxt in 
-  try 
-    if is_conv_leq env sigma (Typing.type_of env sigma p) typ then p
-    else error "abstract_list_all"
-  with UserError _ ->
-    raise (RefinerError (CannotGeneralize typ))
-
-(* Generator of metavariables *)
-let new_meta =
-  let meta_ctr = ref 0 in
-  fun () -> incr meta_ctr; !meta_ctr
-
-(* replaces a mapping of existentials into a mapping of metas.
-   Problem if an evar appears in the type of another one (pops anomaly) *)
-let exist_to_meta sigma (emap, c) =
-  let metamap = ref [] in
-  let change_exist evar =
-    let ty = nf_betaiota (nf_evar emap (existential_type emap evar)) in
-    let n = new_meta() in
-    metamap := (n, ty) :: !metamap;
-    mkCast (mkMeta n, ty) in
-  let rec replace c =
-    match kind_of_term c with
-        Evar (k,_ as ev) when not (Evd.in_dom sigma k) -> change_exist ev
-      | _ -> map_constr replace c in
-  (!metamap, replace c)
-
-module Metaset = Intset
-
-module Metamap = Intmap
-
-let meta_exists p s = Metaset.fold (fun x b -> (p x) || b) s false
-
-let metamap_in_dom x m =
-  try let _ = Metamap.find x m in true with Not_found -> false
-
-let metamap_to_list m =
-  Metamap.fold (fun n v l -> (n,v)::l) m []
-
-let metamap_inv m b = 
-  Metamap.fold (fun n v l -> if v = b then n::l else l) m []
-
-type 'a freelisted = {
-  rebus : 'a;
-  freemetas : Metaset.t }
-
-(* collects all metavar occurences, in left-to-right order, preserving
- * repetitions and all. *)
-
-let collect_metas c = 
-  let rec collrec acc c =
-    match kind_of_term c with
-      | Meta mv -> mv::acc
-      | _         -> fold_constr collrec acc c
-  in
-  List.rev (collrec [] c)
-
-let metavars_of c =  
-  let rec collrec acc c =
-    match kind_of_term c with
-      | Meta mv -> Metaset.add mv acc
-      | _         -> fold_constr collrec acc c
-  in 
-  collrec Metaset.empty c
-
-let mk_freelisted c =
-  { rebus = c; freemetas = metavars_of c }
-
-
-(* Clausal environments *)
-
-type clbinding = 
-  | Cltyp of constr freelisted
-  | Clval of constr freelisted * constr freelisted
-
-type 'a clausenv = {
-  templval : constr freelisted;
-  templtyp : constr freelisted;
-  namenv : identifier Metamap.t;
-  env : clbinding Metamap.t;
-  hook : 'a }
-
-type wc = named_context sigma
-
-
-(* [mentions clenv mv0 mv1] is true if mv1 is defined and mentions
- * mv0, or if one of the free vars on mv1's freelist mentions
- * mv0 *)
-
-let mentions clenv mv0 = 
-  let rec menrec mv1 =
-    try
-     (match Metamap.find mv1 clenv.env with
-	 | Clval (b,_) -> 
-	     Metaset.mem mv0 b.freemetas || meta_exists menrec b.freemetas
-	 | Cltyp _ -> false)
-    with Not_found -> 
-      false
-  in 
-  menrec
-
-(* Creates a new clause-environment, whose template has a given
- * type, CTY.  This is not all that useful, since not very often
- * does one know the type of the clause - one usually only has
- * a clause which one wants to backchain thru. *)
-
-let mk_clenv wc cty =
-  let mv = new_meta () in
-  let cty_fls = mk_freelisted cty in 
-  { templval = mk_freelisted (mkMeta mv);
-    templtyp = cty_fls;
-    namenv = Metamap.empty;
-    env =  Metamap.add mv (Cltyp cty_fls) Metamap.empty ;
-    hook = wc }
-  
-let clenv_environments bound c =
-  let rec clrec (ne,e,metas) n c =
-    match n, kind_of_term c with
-      | (Some 0, _) -> (ne, e, List.rev metas, c)
-      | (n, Cast (c,_)) -> clrec (ne,e,metas) n c
-      | (n, Prod (na,c1,c2)) ->
-	  let mv = new_meta () in
-	  let dep = dependent (mkRel 1) c2 in
-	  let ne' =
-	    if dep then
-              match na with
-		| Anonymous -> ne
-		| Name id ->
-		    if metamap_in_dom mv ne then begin
-		      warning ("Cannot put metavar "^(string_of_meta mv)^
-			       " in name-environment twice");
-		      ne
-		    end else 
-		      Metamap.add mv id ne
-            else 
-	      ne 
-	  in
-	  let e' = Metamap.add mv (Cltyp (mk_freelisted c1)) e in 
-	  clrec (ne',e', (mkMeta mv)::metas) (option_app ((+) (-1)) n)
-	    (if dep then (subst1 (mkMeta mv) c2) else c2)
-      | (n, LetIn (na,b,_,c)) ->
-	  clrec (ne,e,metas) (option_app ((+) (-1)) n) (subst1 b c)
-      | (n, _) -> (ne, e, List.rev metas, c)
-  in 
-  clrec (Metamap.empty,Metamap.empty,[]) bound c
-
-let mk_clenv_from_n wc n (c,cty) =
-  let (namenv,env,args,concl) = clenv_environments n cty in
-  { templval = mk_freelisted (match args with [] -> c | _ -> applist (c,args));
-    templtyp = mk_freelisted concl;
-    namenv = namenv;
-    env = env;
-    hook = wc }
-
-let mk_clenv_from wc = mk_clenv_from_n wc None
-
-let map_fl f cfl = { cfl with rebus=f cfl.rebus }
-
-let map_clb f = function
-  | Cltyp cfl -> Cltyp (map_fl f cfl)
-  | Clval (cfl1,cfl2) -> Clval (map_fl f cfl1,map_fl f cfl2)
-
-let subst_clenv f sub clenv = 
-  { templval = map_fl (subst_mps sub) clenv.templval;
-    templtyp = map_fl (subst_mps sub) clenv.templtyp;
-    namenv = clenv.namenv;
-    env = Metamap.map (map_clb (subst_mps sub)) clenv.env;
-    hook = f sub clenv.hook }
-
-let connect_clenv wc clenv = { clenv with hook = wc }
-
-(* Was used in wcclausenv.ml
-(* Changes the head of a clenv with (templ,templty) *)
-let clenv_change_head (templ,templty) clenv =
-  { templval = mk_freelisted templ;
-    templtyp = mk_freelisted templty;
-    namenv   = clenv.namenv;
-    env      = clenv.env;
-    hook     = clenv.hook }
-*)
-
-let mk_clenv_hnf_constr_type_of wc t =
-  mk_clenv_from wc (t,w_hnf_constr wc (w_type_of wc t))
-
-let mk_clenv_rename_from wc (c,t) = 
-  mk_clenv_from wc (c,rename_bound_var (w_env wc) [] t)
-
-let mk_clenv_rename_from_n wc n (c,t) = 
-  mk_clenv_from_n wc n (c,rename_bound_var (w_env wc) [] t)
-    
-let mk_clenv_rename_type_of wc t =
-  mk_clenv_from wc (t,rename_bound_var (w_env wc) [] (w_type_of wc t))
-    
-let mk_clenv_rename_hnf_constr_type_of wc t =
-  mk_clenv_from wc
-    (t,rename_bound_var (w_env wc) [] (w_hnf_constr wc (w_type_of wc t)))
-
-let mk_clenv_type_of wc t = mk_clenv_from wc (t,w_type_of wc t)
-			      
-let clenv_assign mv rhs clenv =
-  let rhs_fls = mk_freelisted rhs in 
-  if meta_exists (mentions clenv mv) rhs_fls.freemetas then
-    error "clenv__assign: circularity in unification";
-  try
-    (match Metamap.find mv clenv.env with
-       | Clval (fls,ty) ->
-	   if not (eq_constr fls.rebus rhs) then
-	     try 
-	       (* Streams are lazy, force evaluation of id to catch Not_found*)
-	       let id = Metamap.find mv clenv.namenv in
-	       errorlabstrm "clenv_assign"
-		 (str "An incompatible instantiation has already been found for " ++ 
-		    pr_id id)
-	     with Not_found ->
-	       anomaly "clenv_assign: non dependent metavar already assigned"
-	   else
-	     clenv
-       | Cltyp bty -> 
-	   { templval = clenv.templval;
-	     templtyp = clenv.templtyp;
-	     namenv = clenv.namenv;
-	     env = Metamap.add mv (Clval (rhs_fls,bty)) clenv.env;
-	     hook = clenv.hook })
-  with Not_found -> 
-    error "clenv_assign"
-
-let clenv_val_of clenv mv = 
-  let rec valrec mv =
-    try
-      (match Metamap.find mv clenv.env with
-	 | Cltyp _ -> mkMeta mv
-	 | Clval(b,_) ->
-	     instance (List.map (fun mv' -> (mv',valrec mv')) 
-			       (Metaset.elements b.freemetas)) b.rebus)
-    with Not_found -> 
-      mkMeta mv
-  in 
-  valrec mv
-
-let clenv_instance clenv b =
-  let c_sigma =
-    List.map 
-      (fun mv -> (mv,clenv_val_of clenv mv)) (Metaset.elements b.freemetas)
-  in 
-  instance c_sigma b.rebus
-    
-let clenv_instance_term clenv c =
-  clenv_instance clenv (mk_freelisted c)
-
-
-(* This function put casts around metavariables whose type could not be
- * infered by the refiner, that is head of applications, predicates and
- * subject of Cases.
- * Does check that the casted type is closed. Anyway, the refiner would
- * fail in this case... *)
-
-let clenv_cast_meta clenv = 
-  let rec crec u =
-    match kind_of_term u with
-      | App _ | Case _ -> crec_hd u
-      | Cast (c,_) when isMeta c -> u
-      | _  -> map_constr crec u
-	    
-  and crec_hd u =
-    match kind_of_term (strip_outer_cast u) with
-      | Meta mv ->
-	  (try 
-	     match Metamap.find mv clenv.env with
-               | Cltyp b ->
-		   let b' = clenv_instance clenv b in 
-		   if occur_meta b' then u else mkCast (mkMeta mv, b')
-	       | Clval(_) -> u
-	   with Not_found -> 
-	     u)
-      | App(f,args) -> mkApp (crec_hd f, Array.map crec args)
-      | Case(ci,p,c,br) ->
-	  mkCase (ci, crec_hd p, crec_hd c, Array.map crec br)
-      | _ -> u
-  in 
-  crec
-
-
-(* [clenv_pose (na,mv,cty) clenv]
- * returns a new clausenv which has added to it the metavar MV,
- * with type CTY.  the name NA, if it is not ANONYMOUS, will
- * be entered into the name-map, as a way of accessing the new
- * metavar. *)
-
-let clenv_pose (na,mv,cty) clenv =
-  { templval = clenv.templval;
-    templtyp = clenv.templtyp;
-    env = Metamap.add mv (Cltyp (mk_freelisted cty)) clenv.env;
-    namenv = (match na with
-		| Anonymous -> clenv.namenv
-		| Name id -> Metamap.add mv id clenv.namenv);
-    hook = clenv.hook }
-
-let clenv_defined clenv mv =
-  match Metamap.find mv clenv.env with
-    | Clval _ -> true
-    | Cltyp _ -> false
-
-let clenv_value clenv mv =
-  match Metamap.find mv clenv.env with
-    | Clval(b,_) -> b
-    | Cltyp _ -> failwith "clenv_value"
-	  
-let clenv_type clenv mv =
-  match Metamap.find mv clenv.env with
-    | Cltyp b -> b
-    | Clval(_,b) -> b
-	  
-let clenv_template clenv = clenv.templval
-
-let clenv_template_type clenv = clenv.templtyp
-
-let clenv_instance_value clenv mv =
-  clenv_instance clenv (clenv_value clenv mv)
-    
-let clenv_instance_type clenv mv =
-  clenv_instance clenv (clenv_type clenv mv)
-    
-let clenv_instance_template clenv =
-  clenv_instance clenv (clenv_template clenv)
-    
-let clenv_instance_template_type clenv =
-  clenv_instance clenv (clenv_template_type clenv)
-    
-let clenv_wtactic wt clenv =
-  { templval = clenv.templval;
-    templtyp = clenv.templtyp;
-    namenv = clenv.namenv;
-    env = clenv.env;
-    hook = wt clenv.hook }
-
-let clenv_type_of ce c =
-  let metamap =
-    List.map 
-      (function
-	 | (n,Clval(_,typ)) -> (n,typ.rebus)
-         | (n,Cltyp typ)    -> (n,typ.rebus))
-      (metamap_to_list ce.env)
-  in
-    Retyping.get_type_of_with_meta (w_env ce.hook) (w_Underlying ce.hook) metamap c
-
-let clenv_instance_type_of ce c =
-  clenv_instance ce (mk_freelisted (clenv_type_of ce c))
-
-
-
-(* Unification à l'ordre 0 de m et n: [unify_0 mc wc m n] renvoie deux listes:
-
-   metasubst:(int*constr)list    récolte les instances des (Meta k)
-   evarsubst:(constr*constr)list récolte les instances des (Const "?k")
-
-   Attention : pas d'unification entre les différences instances d'une
-   même meta ou evar, il peut rester des doublons *)
-
-(* Unification order: *)
-(* Left to right: unifies first argument and then the other arguments *)
-(*let unify_l2r x = List.rev x
-(* Right to left: unifies last argument and then the other arguments *)
-let unify_r2l x = x
-
-let sort_eqns = unify_r2l
-*)
-
-let unify_0 cv_pb wc m n =
-  let env = w_env wc
-  and sigma = w_Underlying wc in
-  let trivial_unify pb substn m n =
-    if (not(occur_meta m)) & is_fconv pb env sigma m n then substn
-    else error_cannot_unify (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 catchable_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
-
-  in
-  if (not(occur_meta m)) & is_fconv cv_pb env sigma m n then 
-    ([],[])
-  else 
-    let (mc,ec) = unirec_rec cv_pb ([],[]) m n in
-    ((*sort_eqns*) mc, (*sort_eqns*) ec)
-
-
-(* Unification
- *
- * Procedure:
- * (1) The function [unify mc wc M N] produces two lists:
- *     (a) a list of bindings Meta->RHS
- *     (b) a list of bindings EVAR->RHS
- *
- * The Meta->RHS bindings cannot themselves contain
- * meta-vars, so they get applied eagerly to the other
- * bindings.  This may or may not close off all RHSs of
- * the EVARs.  For each EVAR whose RHS is closed off,
- * we can just apply it, and go on.  For each which
- * is not closed off, we need to do a mimick step -
- * in general, we have something like:
- *
- *      ?X == (c e1 e2 ... ei[Meta(k)] ... en)
- *
- * so we need to do a mimick step, converting ?X
- * into
- *
- *      ?X -> (c ?z1 ... ?zn)
- *
- * of the proper types.  Then, we can decompose the
- * equation into
- *
- *      ?z1 --> e1
- *          ...
- *      ?zi --> ei[Meta(k)]
- *          ...
- *      ?zn --> en
- *
- * and keep on going.  Whenever we find that a R.H.S.
- * is closed, we can, as before, apply the constraint
- * directly.  Whenever we find an equation of the form:
- *
- *      ?z -> Meta(n)
- *
- * we can reverse the equation, put it into our metavar
- * substitution, and keep going.
- *
- * The most efficient mimick possible is, for each
- * Meta-var remaining in the term, to declare a
- * new EVAR of the same type.  This is supposedly
- * determinable from the clausale form context -
- * we look up the metavar, take its type there,
- * and apply the metavar substitution to it, to
- * close it off.  But this might not always work,
- * since other metavars might also need to be resolved. *)
-
-let applyHead n c wc = 
-  let rec apprec n c cty wc =
-    if n = 0 then 
-      (wc,c)
-    else 
-      match kind_of_term (w_whd_betadeltaiota wc cty) with
-        | Prod (_,c1,c2) ->
-	    let evar = Evarutil.new_evar_in_sign (w_env wc) in
-            let (evar_n, _) = destEvar evar in
-	    (compose 
-	       (apprec (n-1) (applist(c,[evar])) (subst1 evar c2))
-	       (w_Declare evar_n c1))
-	    wc
-	| _ -> error "Apply_Head_Then"
-  in 
-  apprec n c (w_type_of wc c) wc
-
-let is_mimick_head f =
-  match kind_of_term f with
-      (Const _|Var _|Rel _|Construct _|Ind _) -> true
-    | _ -> false
-
-let rec mimick_evar hdc nargs sp wc =
-  let evd = Evd.map wc.sigma sp in
-  let wc' = extract_decl sp wc in
-  let (wc'', c) = applyHead nargs hdc wc' in
-  let (mc,ec) = unify_0 CONV wc'' (w_type_of wc'' c) (evd.evar_concl) in
-  let (wc''',_) = w_resrec mc ec wc'' in
-    if wc'== wc'''
-    then w_Define sp c wc
-    else  
-      let wc'''' = restore_decl sp evd wc''' in
-	w_Define sp (Evarutil.nf_evar wc''''.sigma c) {it = wc.it ; sigma = wc''''.sigma}
-
-and w_Unify cv_pb m n wc =
-  let (mc',ec') = unify_0 cv_pb wc m n in 
-  w_resrec mc' ec' wc
-
-and w_resrec metas evars wc =
-  match evars with
-    | [] -> (wc,metas)
-
-    | (lhs,rhs) :: t ->
-    match kind_of_term rhs with
-
-      | Meta k -> w_resrec ((k,lhs)::metas) t wc
-
-      | krhs ->
-      match kind_of_term lhs with
-
-	| Evar (evn,_) ->
-	    if w_defined_evar wc evn then
-	      let (wc',metas') = w_Unify CONV rhs lhs wc in 
-	      w_resrec (metas@metas') t wc'
-	    else
-	      (try 
-		 w_resrec metas t (w_Define evn rhs wc)
-               with ex when catchable_exception ex ->
-		 (match krhs with
-             	    | App (f,cl) when is_mimick_head f ->
-			let wc' = mimick_evar f (Array.length cl) evn wc in
-			w_resrec metas evars wc'
-		    | _ -> raise ex (*error "w_Unify" *)))
-	| _ -> anomaly "w_resrec"
-
-
-(* [unifyTerms] et [unify] ne semble pas gérer les Meta, en
-   particulier ne semblent pas vérifier que des instances différentes
-   d'une même Meta sont compatibles. D'ailleurs le "fst" jette les metas
-   provenant de w_Unify. (Utilisé seulement dans prolog.ml) *)
-
-(* let unifyTerms m n = walking (fun wc -> fst (w_Unify CONV m n [] wc)) *)
-let unifyTerms m n gls = 
-  tclIDTAC {it = gls.it; 
-	    sigma = (get_gc (fst (w_Unify CONV m n (Refiner.project_with_focus gls))))}
-
-let unify m gls =
-  let n = pf_concl gls in unifyTerms m n gls
-
-(* [clenv_merge b metas evars clenv] merges common instances in metas
-   or in evars, possibly generating new unification problems; if [b]
-   is true, unification of types of metas is required *)
-
-let clenv_merge with_types metas evars clenv =
-  let ty_metas = ref [] in
-  let ty_evars = ref [] in
-  let rec clenv_resrec metas evars clenv =
-    match (evars,metas) with
-      | ([], []) -> clenv
-
-      | ((lhs,rhs)::t, metas) ->
-      (match kind_of_term rhs with
-
-	| Meta k -> clenv_resrec ((k,lhs)::metas) t clenv
-
-	| krhs ->
-        (match kind_of_term lhs with
-
-	  | Evar (evn,_) ->
-    	      if w_defined_evar clenv.hook evn then
-		let (metas',evars') = unify_0 CONV clenv.hook rhs lhs in
-		clenv_resrec (metas'@metas) (evars'@t) clenv
-    	      else begin
-		let rhs' = 
-		  if occur_meta rhs then subst_meta metas rhs else rhs 
-		in
-		if occur_evar evn rhs' then error "w_Unify";
-		try 
-		  clenv_resrec metas t 
-		    (clenv_wtactic (w_Define evn rhs') clenv) 
-		with ex when catchable_exception ex ->
-		  (match krhs with
-		     | App (f,cl) when is_mimick_head f ->
-			 clenv_resrec metas evars 
-			   (clenv_wtactic
-			      (mimick_evar f (Array.length cl) evn)
-			      clenv)
-           	     | _ -> raise ex (********* error "w_Unify" *))
-	      end
-
-	  | _ -> anomaly "clenv_resrec"))
-
-      | ([], (mv,n)::t) ->
-    	  if clenv_defined clenv mv then
-            let (metas',evars') =
-              unify_0 CONV clenv.hook (clenv_value clenv mv).rebus n in
-            clenv_resrec (metas'@t) evars' clenv
-    	  else
-            begin
-	      if with_types (* or occur_meta mvty *) then
-	        (let mvty = clenv_instance_type clenv mv in
-		try 
-		  let nty = clenv_type_of clenv 
-			      (clenv_instance clenv (mk_freelisted n)) in
-		  let (mc,ec) = unify_0 CUMUL clenv.hook nty mvty in
-                  ty_metas := mc @ !ty_metas;
-                  ty_evars := ec @ !ty_evars
-		with e when Logic.catchable_exception e -> ());
-	      clenv_resrec t [] (clenv_assign mv n clenv)
-            end in
-  (* merge constraints *)
-  let clenv' = clenv_resrec metas evars clenv in
-  if with_types then
-    (* merge constraints about types: if they fail, don't worry *)
-    try clenv_resrec !ty_metas !ty_evars clenv'
-    with e when Logic.catchable_exception e -> clenv'
-  else clenv'
-
-(* [clenv_unify M N clenv]
-   performs a unification of M and N, generating a bunch of
-   unification constraints in the process.  These constraints
-   are processed, one-by-one - they may either generate new
-   bindings, or, if there is already a binding, new unifications,
-   which themselves generate new constraints.  This continues
-   until we get failure, or we run out of constraints.
-   [clenv_typed_unify M N clenv] expects in addition that expected
-   types of metavars are unifiable with the types of their instances    *)
-
-let clenv_unify_core_0 with_types cv_pb m n clenv =
-  let (mc,ec) = unify_0 cv_pb clenv.hook m n in 
-  clenv_merge with_types mc ec clenv
-
-let clenv_unify_0 = clenv_unify_core_0 false
-let clenv_typed_unify = clenv_unify_core_0 true
-
-
-(* takes a substitution s, an open term op and a closed term cl
-   try to find a subterm of cl which matches op, if op is just a Meta
-   FAIL because we cannot find a binding *)
-
-let iter_fail f a =
-  let n = Array.length a in 
-  let rec ffail i =
-    if i = n then error "iter_fail" 
-    else
-      try f a.(i) 
-      with ex when catchable_exception ex -> ffail (i+1)
-  in ffail 0
-
-(* Tries to find an instance of term [cl] in term [op].
-   Unifies [cl] to every subterm of [op] until it finds a match.
-   Fails if no match is found *)
-let unify_to_subterm clause (op,cl) =
-  let rec matchrec cl =
-    let cl = strip_outer_cast cl in
-    (try 
-       if closed0 cl 
-       then clenv_unify_0 CONV op cl clause,cl
-       else error "Bound 1"
-     with ex when catchable_exception ex ->
-       (match kind_of_term cl with 
-	  | App (f,args) ->
-	      let n = Array.length args in
-	      assert (n>0);
-	      let c1 = mkApp (f,Array.sub args 0 (n-1)) in
-	      let c2 = args.(n-1) in
-	      (try 
-		 matchrec c1
-	       with ex when catchable_exception ex -> 
-		 matchrec c2)
-          | Case(_,_,c,lf) -> (* does not search in the predicate *)
-	       (try 
-		 matchrec c
-	       with ex when catchable_exception ex -> 
-		 iter_fail matchrec lf)
-	  | LetIn(_,c1,_,c2) -> 
-	       (try 
-		 matchrec c1
-	       with ex when catchable_exception ex -> 
-		 matchrec c2)
-
-	  | Fix(_,(_,types,terms)) -> 
-	       (try 
-		 iter_fail matchrec types
-	       with ex when catchable_exception ex -> 
-		 iter_fail matchrec terms)
-	
-	  | CoFix(_,(_,types,terms)) -> 
-	       (try 
-		 iter_fail matchrec types
-	       with ex when catchable_exception ex -> 
-		 iter_fail matchrec terms)
-
-          | Prod (_,t,c) ->
-	      (try 
-		 matchrec t 
-	       with ex when catchable_exception ex -> 
-		 matchrec c)
-          | Lambda (_,t,c) ->
-	      (try 
-		 matchrec t 
-	       with ex when catchable_exception ex -> 
-		 matchrec c)
-          | _ -> error "Match_subterm")) 
-  in 
-  try matchrec cl
-  with ex when catchable_exception ex ->
-    raise (RefinerError (NoOccurrenceFound op))
-
-let unify_to_subterm_list allow_K clause oplist t = 
-  List.fold_right 
-    (fun op (clause,l) ->
-      if isMeta op then
-	if allow_K then (clause,op::l)
-	else error "Match_subterm"
-      else if occur_meta op then
-        let (clause',cl) =
-          try 
-	    (* This is up to delta for subterms w/o metas ... *)
-	    unify_to_subterm clause (strip_outer_cast op,t)
-          with RefinerError (NoOccurrenceFound _) when allow_K -> (clause,op)
-        in 
-	(clause',cl::l)
-      else if not allow_K & not (dependent op t) then
-	(* This is not up to delta ... *)
-	raise (RefinerError (NoOccurrenceFound op))
-      else
-	(clause,op::l))
-    oplist 
-    (clause,[])
-
-let secondOrderAbstraction allow_K typ (p, oplist) clause =
-  let env = w_env clause.hook in
-  let sigma = w_Underlying clause.hook in
-  let (clause',cllist) = unify_to_subterm_list allow_K clause oplist typ in
-  let typp = clenv_instance_type clause' p in 
-  let pred = abstract_list_all env sigma typp typ cllist in
-  clenv_unify_0 CONV (mkMeta p) pred clause'
-
-let clenv_unify2 allow_K cv_pb ty1 ty2 clause =
-  let c1, oplist1 = whd_stack ty1 in
-  let c2, oplist2 = whd_stack ty2 in
-  match kind_of_term c1, kind_of_term c2 with
-    | Meta p1, _ ->
-        (* Find the predicate *)
-	let clause' =
-          secondOrderAbstraction allow_K ty2 (p1,oplist1) clause in 
-        (* Resume first order unification *)
-	clenv_unify_0 cv_pb (clenv_instance_term clause' ty1) ty2 clause'
-    | _, Meta p2 ->
-        (* Find the predicate *)
-	let clause' =
-          secondOrderAbstraction allow_K ty1 (p2, oplist2) clause in 
-        (* Resume first order unification *)
-	clenv_unify_0 cv_pb ty1 (clenv_instance_term clause' ty2) clause'
-    | _ -> error "clenv_unify2"
-
-
-(* The unique unification algorithm works like this: If the pattern is
-   flexible, and the goal has a lambda-abstraction at the head, then
-   we do a first-order unification.
-
-   If the pattern is not flexible, then we do a first-order
-   unification, too.
-
-   If the pattern is flexible, and the goal doesn't have a
-   lambda-abstraction head, then we second-order unification. *)
-
-(* We decide here if first-order or second-order unif is used for Apply *)
-(* We apply a term of type (ai:Ai)C and try to solve a goal C'          *)
-(* The type C is in clenv.templtyp.rebus with a lot of Meta to solve    *)
-
-(* 3-4-99 [HH] New fo/so choice heuristic :
-   In case we have to unify (Meta(1) args) with ([x:A]t args')
-   we first try second-order unification and if it fails first-order.
-   Before, second-order was used if the type of Meta(1) and [x:A]t was
-   convertible and first-order otherwise. But if failed if e.g. the type of
-   Meta(1) had meta-variables in it. *)
-let clenv_unify allow_K cv_pb ty1 ty2 clenv =
-  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 
-	   clenv_typed_unify cv_pb ty1 ty2 clenv
-	 with ex when catchable_exception ex -> 
-	   try 
-	     clenv_unify2 allow_K cv_pb ty1 ty2 clenv
-	   with RefinerError (NoOccurrenceFound c) as e -> raise e
-	     | ex when catchable_exception ex -> 
-	     error "Cannot solve a second-order unification problem")
-
-     (* Second order case *)
-     | (Meta _, true, _, _ | _, _, Meta _, true) -> 
-	(try 
-	   clenv_unify2 allow_K cv_pb ty1 ty2 clenv
-	with RefinerError (NoOccurrenceFound c) as e -> raise e
-	  | ex when catchable_exception ex -> 
-          try 
-	     clenv_typed_unify cv_pb ty1 ty2 clenv
-          with ex when catchable_exception ex -> 
-             error "Cannot solve a second-order unification problem")
-
-     (* General case: try first order *)
-     | _ -> clenv_unify_0 cv_pb ty1 ty2 clenv
-
-
-(* [clenv_bchain mv clenv' clenv]
- *
- * Resolves the value of "mv" (which must be undefined) in clenv to be
- * the template of clenv' be the value "c", applied to "n" fresh
- * metavars, whose types are chosen by destructing "clf", which should
- * be a clausale forme generated from the type of "c".  The process of
- * 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.  *)
-
-let clenv_bchain mv subclenv clenv =
-  (* Add the metavars of [subclenv] to [clenv], with their name-environment *)
-  let clenv' =
-    { templval = clenv.templval;
-      templtyp = clenv.templtyp;
-      namenv =
-	List.fold_left (fun ne (mv,id) ->
-			  if clenv_defined subclenv mv then 
-			    ne
-			  else if metamap_in_dom mv ne then begin
-			    warning ("Cannot put metavar "^(string_of_meta mv)^
-				     " in name-environment twice");
-			    ne
-			  end else 
-			    Metamap.add mv id ne)
-          clenv.namenv (metamap_to_list subclenv.namenv);
-      env = List.fold_left (fun m (n,v) -> Metamap.add n v m) 
-	       clenv.env (metamap_to_list subclenv.env);
-      hook = clenv.hook } 
-  in
-  (* unify the type of the template of [subclenv] with the type of [mv] *)
-  let clenv'' =
-    clenv_unify true CUMUL
-      (clenv_instance clenv' (clenv_template_type subclenv))
-      (clenv_instance_type clenv' mv)
-      clenv' 
-  in
-  (* assign the metavar *)
-  let clenv''' =
-    clenv_assign mv (clenv_instance clenv' (clenv_template subclenv)) clenv''
-  in 
-  clenv'''
-
-
-(* swaps the "hooks" in [clenv1] and [clenv2], so we can then use
-   backchain to hook them together *)
-
-let clenv_swap clenv1 clenv2 =
-  let clenv1' = { templval = clenv1.templval;
-		  templtyp = clenv1.templtyp;
-		  namenv = clenv1.namenv;
-		  env = clenv1.env;
-		  hook = clenv2.hook} 
-  and clenv2' = { templval = clenv2.templval;
-		  templtyp = clenv2.templtyp;
-		  namenv = clenv2.namenv;
-		  env = clenv2.env;
-		  hook = clenv1.hook}
-  in 
-  (clenv1',clenv2')
-
-let clenv_fchain mv nextclenv clenv =
-  let (clenv',nextclenv') = clenv_swap clenv nextclenv in 
-  clenv_bchain mv clenv' nextclenv'
-
-let clenv_refine kONT clenv gls =
-  tclTHEN
-    (kONT clenv.hook) 
-    (refine (clenv_instance_template clenv)) gls
-
-let clenv_refine_cast kONT clenv gls =
-  tclTHEN
-    (kONT clenv.hook) 
-    (refine (clenv_cast_meta clenv (clenv_instance_template clenv)))
-    gls
-
-(* [clenv_metavars clenv mv]
- * returns a list of the metavars which appear in the type of
- * the metavar mv.  The list is unordered. *)
-
-let clenv_metavars clenv mv =
-  match Metamap.find mv clenv.env with
-    | Clval(_,b) -> b.freemetas
-    | Cltyp b -> b.freemetas
-
-let clenv_template_metavars clenv = clenv.templval.freemetas
-
-(* [clenv_dependent hyps_only clenv]
- * returns a list of the metavars which appear in the template of clenv,
- * and which are dependent, This is computed by taking the metavars in cval,
- * in right-to-left order, and collecting the metavars which appear
- * in their types, and adding in all the metavars appearing in the
- * type of clenv.
- * If [hyps_only] then metavariables occurring in the type are _excluded_ *)
-
-let dependent_metas clenv mvs conclmetas =
-  List.fold_right
-    (fun mv deps ->
-       Metaset.union deps (clenv_metavars clenv mv))
-    mvs conclmetas
-
-let clenv_dependent hyps_only clenv =
-  let mvs = collect_metas (clenv_instance_template clenv) in
-  let ctyp_mvs = metavars_of (clenv_instance_template_type clenv) in
-  let deps = dependent_metas clenv mvs ctyp_mvs in
-  List.filter
-    (fun mv -> Metaset.mem mv deps && not (hyps_only && Metaset.mem mv ctyp_mvs))
-    mvs
-
-let clenv_missing c = clenv_dependent true c
-
-(* [clenv_independent clenv]
- * returns a list of metavariables which appear in the term cval,
- * and which are not dependent.  That is, they do not appear in
- * the types of other metavars which are in cval, nor in the type
- * of cval, ctyp. *)
-
-let clenv_independent clenv =
-  let mvs = collect_metas (clenv_instance_template clenv) in
-  let ctyp_mvs = metavars_of (clenv_instance_template_type clenv) in
-  let deps = dependent_metas clenv mvs ctyp_mvs in
-  List.filter (fun mv -> not (Metaset.mem mv deps)) mvs
-
-let w_coerce wc c ctyp target =
-  let j = make_judge c ctyp in
-  let env = w_env wc in
-  let isevars = Evarutil.create_evar_defs (w_Underlying wc) in
-  let j' = Coercion.inh_conv_coerce_to dummy_loc env isevars j target in
-  (* faire quelque chose avec isevars ? *)
-  j'.uj_val
-
-let clenv_constrain_dep_args hyps_only clause = function
-  | [] -> clause 
-  | mlist ->
-      let occlist = clenv_dependent hyps_only clause in
-      if List.length occlist = List.length mlist then
-	List.fold_left2
-          (fun clenv k c ->
-	    let wc = clause.hook in
-	    try
-	      let k_typ = w_hnf_constr wc (clenv_instance_type clause k) in
-	      let c_typ = w_hnf_constr wc (w_type_of wc c) in
-	      let c' = w_coerce wc c c_typ k_typ in
-	      clenv_unify true CONV (mkMeta k) c' clenv
-	    with _ ->
-              clenv_unify true CONV (mkMeta k) c clenv)
-          clause occlist mlist
-      else 
-	error ("Not the right number of missing arguments (expected "
-	       ^(string_of_int (List.length occlist))^")")
-
-let clenv_constrain_missing_args mlist clause =
-  clenv_constrain_dep_args true clause mlist
-
-let clenv_lookup_name clenv id =
-  match metamap_inv clenv.namenv id with
-    | []  -> 
-	errorlabstrm "clenv_lookup_name"
-          (str"No such bound variable " ++ pr_id id)
-    | [n] -> 
-	n
-    |  _  -> 
-	 anomaly "clenv_lookup_name: a name occurs more than once in clause"
-
-let clenv_match_args s clause =
-  let mvs = clenv_independent clause in 
-  let rec matchrec clause = function
-    | [] -> clause
-    | (loc,b,c)::t ->
-	let k =
-	  match b with
-            | NamedHyp s ->
-		if List.exists (fun (_,b',_) -> b=b') t then 
-		  errorlabstrm "clenv_match_args" 
-		    (str "The variable " ++ pr_id s ++ 
-		    str " occurs more than once in binding")
-		else
-		  clenv_lookup_name clause s
-	    | AnonHyp n ->
-		if List.exists (fun (_,b',_) -> b=b') t then
-		  errorlabstrm "clenv_match_args"
-		    (str "The position " ++ int n ++
-		    str " occurs more than once in binding");
-		try 
-		  List.nth mvs (n-1)
-		with (Failure _|Invalid_argument _) ->
-                  errorlabstrm "clenv_match_args" (str "No such binder")
-	in
-	let k_typ = w_hnf_constr clause.hook (clenv_instance_type clause k)
-	(* nf_betaiota was before in type_of - useful to reduce types like *)
-	(* (x:A)([x]P u) *)
-	and c_typ = w_hnf_constr clause.hook
-          (nf_betaiota (w_type_of clause.hook c)) in
-	let cl =
-	  (* Try to infer some Meta/Evar from the type of [c] *)
-	  try 
-            clenv_assign k c (clenv_unify true CUMUL c_typ k_typ clause)
-	  with _ ->
-	  (* Try to coerce to the type of [k]; cannot merge with the
-	     previous case because Coercion does not handle Meta *)
-          let c' = w_coerce clause.hook c c_typ k_typ in
-	  try clenv_unify true CONV (mkMeta k) c' clause
-	  with RefinerError (CannotUnify (m,n)) ->
-	    Stdpp.raise_with_loc loc
- 	      (RefinerError (CannotUnifyBindingType (m,n)))
-	in matchrec cl t
-  in 
-  matchrec clause s
-
-type arg_bindings = (int * constr) list
-
-let clenv_constrain_with_bindings bl clause =
-  if bl = [] then 
-    clause 
-  else 
-    let all_mvs = collect_metas (clenv_template clause).rebus in
-    let rec matchrec clause = function
-      | []       -> clause
-      | (n,c)::t ->
-          let k = 
-            (try
-              if n > 0 then 
-		List.nth all_mvs (n-1)
-              else if n < 0 then 
-		List.nth (List.rev all_mvs) (-n-1)
-              else error "clenv_constrain_with_bindings" 
-            with Failure _ ->
-              errorlabstrm "clenv_constrain_with_bindings"
-                (str"Clause did not have " ++ int n ++ str"-th" ++
-                str" absolute argument")) in
-	  let env = Global.env () in
-	  let sigma = Evd.empty in
-	  let k_typ = nf_betaiota (clenv_instance_type clause k) in
-	  let c_typ = nf_betaiota (w_type_of clause.hook c) in 
-	  matchrec
-            (clenv_assign k c (clenv_unify true CUMUL c_typ k_typ clause)) t
-    in 
-    matchrec clause bl
-
-
-(* [clenv_pose_dependent_evars clenv]
- * For each dependent evar in the clause-env which does not have a value,
- * pose a value for it by constructing a fresh evar.  We do this in
- * left-to-right order, so that every evar's type is always closed w.r.t.
- * metas. *)
-
-let clenv_pose_dependent_evars clenv =
-  let dep_mvs = clenv_dependent false clenv in
-  List.fold_left
-    (fun clenv mv ->
-       let evar = Evarutil.new_evar_in_sign (w_env clenv.hook) in
-       let (evar_n,_) = destEvar evar in
-       let tY = clenv_instance_type clenv mv in
-       let clenv' = clenv_wtactic (w_Declare evar_n tY) clenv in
-       clenv_assign mv evar clenv')
-    clenv
-    dep_mvs
-
-(***************************)
-
-let clenv_unique_resolver allow_K clause gl =
-  clenv_unify allow_K CUMUL
-    (clenv_instance_template_type clause) (pf_concl gl) clause 
-
-let res_pf kONT clenv gls =
-  clenv_refine kONT (clenv_unique_resolver false clenv gls) gls
-    
-let res_pf_cast kONT clenv gls =
-  clenv_refine_cast kONT (clenv_unique_resolver false clenv gls) gls
-
-let elim_res_pf kONT clenv allow_K gls =
-  clenv_refine_cast kONT (clenv_unique_resolver allow_K clenv gls) gls
-
-let elim_res_pf_THEN_i kONT clenv tac gls =  
-  let clenv' = (clenv_unique_resolver true clenv gls) in
-  tclTHENLASTn (clenv_refine kONT clenv') (tac clenv') gls
-
-let e_res_pf kONT clenv gls =
-  clenv_refine kONT
-    (clenv_pose_dependent_evars (clenv_unique_resolver false clenv gls)) gls
-
-(* Clausal environment for an application *)
-
-let make_clenv_binding_gen n wc (c,t) = function
-  | ImplicitBindings largs ->
-      let clause = mk_clenv_from_n wc n (c,t) in
-      clenv_constrain_dep_args (n <> None) clause largs
-  | ExplicitBindings lbind ->
-      let clause = mk_clenv_rename_from_n wc n (c,t) in
-      clenv_match_args lbind clause
-  | NoBindings ->
-      mk_clenv_from_n wc 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
-
-open Printer
-
-let pr_clenv clenv =
-  let pr_name mv =
-    try 
-      let id = Metamap.find mv clenv.namenv in
-      (str"[" ++ pr_id id ++ str"]")
-    with Not_found -> (mt ())
-  in
-  let pr_meta_binding = function
-    | (mv,Cltyp b) ->
-      	hov 0 
-	  (pr_meta mv ++ pr_name mv ++ str " : " ++ prterm b.rebus ++ fnl ())
-    | (mv,Clval(b,_)) ->
-      	hov 0 
-	  (pr_meta mv ++ pr_name mv ++ str " := " ++ prterm b.rebus ++ fnl ())
-  in
-  (str"TEMPL: " ++ prterm clenv.templval.rebus ++
-     str" : " ++ prterm clenv.templtyp.rebus ++ fnl () ++
-     (prlist pr_meta_binding (metamap_to_list clenv.env)))
diff --git a/proofs/clenv.mli b/proofs/clenv.mli
deleted file mode 100644
index 737fbea3..00000000
--- a/proofs/clenv.mli
+++ /dev/null
@@ -1,142 +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: clenv.mli,v 1.32.2.2 2005/01/21 16:41:51 herbelin Exp $ i*)
-
-(*i*)
-open Util
-open Names
-open Term
-open Sign
-open Proof_type
-(*i*)
-
-(* [new_meta] is a generator of unique meta variables *)
-val new_meta : unit -> metavariable
-
-(* [exist_to_meta] generates new metavariables for each existential
-   and performs the replacement in the given constr *)
-val exist_to_meta :
-  Evd.evar_map -> Pretyping.open_constr -> (Termops.metamap * constr)
-
-(* The Type of Constructions clausale environments. *)
-
-module Metaset : Set.S with type elt = metavariable
-
-module Metamap : Map.S with type key = metavariable
-
-type 'a freelisted = {
-  rebus : 'a;
-  freemetas : Metaset.t }
-
-type clbinding = 
-  | Cltyp of constr freelisted
-  | Clval of constr freelisted * constr freelisted
-
-type 'a clausenv = {
-  templval : constr freelisted;
-  templtyp : constr freelisted;
-  namenv : identifier Metamap.t;
-  env : clbinding Metamap.t;
-  hook : 'a }
-
-type wc = named_context sigma (* for a better reading of the following *)
-
-(* [templval] is the template which we are trying to fill out.
- * [templtyp] is its type.
- * [namenv] is a mapping from metavar numbers to names, for
- *          use in instanciating metavars by name.
- * [env] is the mapping from metavar numbers to their types
- *       and values.
- * [hook] is the pointer to the current walking context, for
- *        integrating existential vars and metavars. *)
-
-val collect_metas : constr -> metavariable list
-val mk_clenv : 'a -> constr -> 'a clausenv
-val mk_clenv_from : 'a -> constr * constr -> 'a clausenv
-val mk_clenv_from_n : 'a -> int option -> constr * constr -> 'a clausenv
-val mk_clenv_rename_from : wc -> constr * constr -> wc clausenv
-val mk_clenv_rename_from_n : wc -> int option -> constr * constr -> wc clausenv
-val mk_clenv_hnf_constr_type_of : wc -> constr -> wc clausenv
-val mk_clenv_type_of : wc -> constr -> wc clausenv
-
-val subst_clenv : (substitution -> 'a -> 'a) -> 
-  substitution -> 'a clausenv -> 'a clausenv
-
-val connect_clenv : wc -> 'a clausenv -> wc clausenv
-(*i Was used in wcclausenv.ml
-val clenv_change_head : constr * constr -> 'a clausenv -> 'a clausenv
-i*)
-val clenv_assign : metavariable -> constr -> 'a clausenv -> 'a clausenv
-val clenv_instance_term : wc clausenv -> constr -> constr
-val clenv_pose : name * metavariable * constr -> 'a clausenv -> 'a clausenv
-val clenv_template : 'a clausenv -> constr freelisted
-val clenv_template_type : 'a clausenv -> constr freelisted
-val clenv_instance_type : wc clausenv -> metavariable -> constr
-val clenv_instance_template : wc clausenv -> constr
-val clenv_instance_template_type : wc clausenv -> constr
-val clenv_type_of : wc clausenv -> constr -> constr
-val clenv_fchain : metavariable -> 'a clausenv -> wc clausenv -> wc clausenv
-val clenv_bchain : metavariable -> 'a clausenv -> wc clausenv -> wc clausenv
-
-(* Unification with clenv *)
-type arg_bindings = (int * constr) list
-
-val unify_0 : 
-  Reductionops.conv_pb -> wc -> constr -> constr 
-    -> Termops.metamap * (constr * constr) list
-val clenv_unify : 
-  bool -> Reductionops.conv_pb -> constr -> constr ->
-  wc clausenv -> wc clausenv
-val clenv_match_args :
-  constr Rawterm.explicit_bindings -> wc clausenv -> wc clausenv
-val clenv_constrain_with_bindings : arg_bindings -> wc clausenv -> wc clausenv
-
-(* Bindings *)
-val clenv_independent : wc clausenv -> metavariable list
-val clenv_missing : 'a clausenv -> metavariable list
-val clenv_constrain_missing_args : (* Used in user contrib Lannion *)
-  constr list -> wc clausenv -> wc clausenv
-(*i
-val clenv_constrain_dep_args : constr list -> wc clausenv -> wc clausenv
-i*)
-val clenv_lookup_name : 'a clausenv -> identifier -> metavariable
-val clenv_unique_resolver : bool -> wc clausenv -> goal sigma -> wc clausenv
-
-val make_clenv_binding_apply :
-  wc -> int -> constr * constr -> types Rawterm.bindings -> wc clausenv
-val make_clenv_binding :
-  wc -> constr * constr -> types Rawterm.bindings -> wc clausenv
-
-(* Tactics *)
-val unify : constr -> tactic
-val clenv_refine : (wc -> tactic) -> wc clausenv -> tactic
-val res_pf      : (wc -> tactic) -> wc clausenv -> tactic
-val res_pf_cast : (wc -> tactic) -> wc clausenv -> tactic
-val elim_res_pf : (wc -> tactic) -> wc clausenv -> bool -> tactic
-val e_res_pf : (wc -> tactic) -> wc clausenv -> tactic
-val elim_res_pf_THEN_i : 
-  (wc -> tactic) -> wc clausenv -> (wc clausenv -> tactic array) -> tactic
-
-(* Pretty-print *)
-val pr_clenv : 'a clausenv -> Pp.std_ppcmds
-
-(* Exported for debugging *)
-val unify_to_subterm : 
-  wc clausenv -> constr * constr -> wc clausenv * constr
-val unify_to_subterm_list : 
-  bool -> wc clausenv -> constr list -> constr -> wc clausenv * constr list
-val clenv_typed_unify :
-  Reductionops.conv_pb -> constr -> constr -> wc clausenv -> wc clausenv
-
-(*i This should be in another module i*)
-
-(* [abstract_list_all env sigma t c l]                     *)
-(* abstracts the terms in l over c to get a term of type t *)
-val abstract_list_all :
-  Environ.env -> Evd.evar_map -> constr -> constr -> constr list -> constr
diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml
new file mode 100644
index 00000000..71538614
--- /dev/null
+++ b/proofs/clenvtac.ml
@@ -0,0 +1,97 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: clenvtac.ml 8023 2006-02-10 18:34:51Z coq $ *)
+
+open Pp
+open Util
+open Names
+open Nameops
+open Term
+open Termops
+open Sign
+open Environ
+open Evd
+open Evarutil
+open Proof_type
+open Refiner
+open Proof_trees
+open Logic
+open Reduction
+open Reductionops
+open Tacmach
+open Evar_refiner
+open Rawterm
+open Pattern
+open Tacexpr
+open Clenv
+
+    
+(* This function put casts around metavariables whose type could not be
+ * infered by the refiner, that is head of applications, predicates and
+ * subject of Cases.
+ * Does check that the casted type is closed. Anyway, the refiner would
+ * fail in this case... *)
+
+let clenv_cast_meta clenv = 
+  let rec crec u =
+    match kind_of_term u with
+      | App _ | Case _ -> crec_hd u
+      | Cast (c,_,_) when isMeta c -> u
+      | _  -> map_constr crec u
+	    
+  and crec_hd u =
+    match kind_of_term (strip_outer_cast u) with
+      | Meta mv ->
+	  (try 
+            let b = Typing.meta_type clenv.env mv in
+	    if occur_meta b then u
+            else mkCast (mkMeta mv, DEFAULTcast, b)
+	  with Not_found -> u)
+      | App(f,args) -> mkApp (crec_hd f, Array.map crec args)
+      | Case(ci,p,c,br) ->
+	  mkCase (ci, crec_hd p, crec_hd c, Array.map crec br)
+      | _ -> u
+  in 
+  crec
+
+let clenv_refine clenv gls =
+  tclTHEN
+    (tclEVARS (evars_of clenv.env)) 
+    (refine (clenv_cast_meta clenv (clenv_value clenv)))
+    gls
+
+
+let res_pf clenv ?(allow_K=false) gls =
+  clenv_refine (clenv_unique_resolver allow_K clenv gls) gls
+
+let elim_res_pf_THEN_i clenv tac gls =  
+  let clenv' = (clenv_unique_resolver true clenv gls) in
+  tclTHENLASTn (clenv_refine clenv') (tac clenv') gls
+
+
+let e_res_pf clenv gls =
+  clenv_refine (evar_clenv_unique_resolver clenv gls) gls
+
+
+
+
+(* [unifyTerms] et [unify] ne semble pas gérer les Meta, en
+   particulier ne semblent pas vérifier que des instances différentes
+   d'une même Meta sont compatibles. D'ailleurs le "fst" jette les metas
+   provenant de w_Unify. (Utilisé seulement dans prolog.ml) *)
+
+(* let unifyTerms m n = walking (fun wc -> fst (w_Unify CONV m n [] wc)) *)
+let unifyTerms m n gls = 
+  let env = pf_env gls in
+  let evd = create_evar_defs (project gls) in
+  let evd' = Unification.w_unify false env CONV m n evd in
+  tclIDTAC {it = gls.it; sigma = evars_of evd'}
+
+let unify m gls =
+  let n = pf_concl gls in unifyTerms m n gls
diff --git a/contrib7/correctness/ProgInt.v b/proofs/clenvtac.mli
index 0ca830c2..505826fa 100644
--- a/contrib7/correctness/ProgInt.v
+++ b/proofs/clenvtac.mli
@@ -6,14 +6,21 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
+(*i $Id: clenvtac.mli 6099 2004-09-12 11:38:09Z barras $ i*)
 
-(* $Id: ProgInt.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
+(*i*)
+open Util
+open Names
+open Term
+open Sign
+open Evd
+open Clenv
+open Proof_type
+(*i*)
 
-Require Export ZArith.
-Require Export ZArith_dec.
-
-Theorem Znotzero : (x:Z){`x<>0`}+{`x=0`}.
-Proof.
-Intro x. Elim (Z_eq_dec x `0`) ; Auto.
-Save.
+(* Tactics *)
+val unify : constr -> tactic
+val clenv_refine : clausenv -> tactic
+val res_pf : clausenv -> ?allow_K:bool -> tactic
+val e_res_pf : clausenv -> tactic
+val elim_res_pf_THEN_i : clausenv -> (clausenv -> tactic array) -> tactic
diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml
index ac4dd43a..4ee8001c 100644
--- a/proofs/evar_refiner.ml
+++ b/proofs/evar_refiner.ml
@@ -6,183 +6,44 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evar_refiner.ml,v 1.36.2.2 2004/08/03 21:37:27 herbelin Exp $ *)
+(* $Id: evar_refiner.ml 8654 2006-03-22 15:36:58Z msozeau $ *)
 
-open Pp
 open Util
 open Names
 open Term
-open Environ
 open Evd
 open Sign
-open Reductionops
-open Typing
-open Instantiate
-open Tacred
 open Proof_trees
-open Proof_type
-open Logic
 open Refiner
-open Tacexpr
-open Nameops
-
-
-type wc = named_context sigma (* for a better reading of the following *)
-
-let rc_of_pfsigma sigma = rc_of_gc sigma.sigma sigma.it.goal
-let rc_of_glsigma sigma = rc_of_gc sigma.sigma sigma.it
-
-type w_tactic = named_context sigma -> named_context sigma
-
-let startWalk gls =
-  let evc = project_with_focus gls in
-  (evc,
-   (fun wc' gls' ->
-      if not !Options.debug or (gls.it = gls'.it) then
-(*        if Intset.equal (get_lc gls.it) (get_focus (ids_it wc')) then*)
-          tclIDTAC {it=gls'.it; sigma = (get_gc wc')}
-(*        else
-          (local_Constraints (get_focus (ids_it wc'))
-             {it=gls'.it; sigma = get_gc (ids_it wc')})*)
-      else error "Walking"))
-
-let extract_decl sp evc =
-  let evdmap = evc.sigma in
-  let evd = Evd.map evdmap sp in 
-    { it = evd.evar_hyps;
-      sigma = Evd.rmv evdmap sp }
-
-let restore_decl sp evd evc =
-  (rc_add evc (sp,evd))
-
-
-(* [w_Focusing sp wt wc]
- *
- * Focuses the walking context WC onto the declaration SP, given that
- * this declaration is UNDEFINED.  Then, it runs the walking_tactic,
- * WT, on this new context.  When the result is returned, we recover
- * the resulting focus (access list) and restore it to SP's declaration.
- *
- * It is an error to cause SP to change state while we are focused on it. *)
-
-(* let w_Focusing_THEN sp (wt : 'a result_w_tactic) (wt' : 'a -> w_tactic)
-                       (wc : named_context sigma) =
-  let hyps  = wc.it
-  and evd   = Evd.map wc.sigma sp in
-  let (wc' : named_context sigma) = extract_decl sp wc in
-  let (wc'',rslt) = wt wc' in 
-(*  if not (ids_eq wc wc'') then error "w_saving_focus"; *)
-  if wc'==wc'' then 
-    wt' rslt wc
-  else 
-    let wc''' = restore_decl sp evd wc'' in 
-    wt' rslt {it = hyps; sigma = wc'''.sigma} *)
-      
-let w_add_sign (id,t) (wc : named_context sigma) =
-  { it = Sign.add_named_decl (id,None,t) wc.it;
-    sigma = wc.sigma }
-
-let w_Focus sp wc = extract_decl sp wc
-
-let w_Underlying wc = wc.sigma
-let w_whd wc c      = Evarutil.whd_castappevar (w_Underlying wc) c
-let w_type_of wc c  =
-  type_of (Global.env_of_context wc.it) wc.sigma c
-let w_env     wc    = get_env wc
-let w_hyps    wc    = named_context (get_env wc)
-let w_defined_evar wc k      = Evd.is_defined (w_Underlying wc) k
-let w_const_value wc         = constant_value (w_env wc)
-let w_conv_x wc m n          = is_conv (w_env wc) (w_Underlying wc) m n
-let w_whd_betadeltaiota wc c = whd_betadeltaiota (w_env wc) (w_Underlying wc) c
-let w_hnf_constr wc c        = hnf_constr (w_env wc) (w_Underlying wc) c
-
-
-let w_Declare sp ty (wc : named_context sigma) =
-  let _ = w_type_of wc ty in (* Utile ?? *)
-  let sign = get_hyps wc in
-  let newdecl = mk_goal sign ty in 
-  ((rc_add wc (sp,newdecl)): named_context sigma)
-
-let w_Define sp c wc =
-  let spdecl = Evd.map (w_Underlying wc) sp in
-  let cty = 
-    try 
-      w_type_of (w_Focus sp wc) (mkCast (c,spdecl.evar_concl))
-    with 
-	Not_found -> error "Instantiation contains unlegal variables"
-      | (Type_errors.TypeError (e, Type_errors.UnboundVar v))-> 
-      errorlabstrm "w_Define"
-      (str "Cannot use variable " ++ pr_id v ++ str " to define " ++ 
-       str (string_of_existential sp))
-  in 
-  match spdecl.evar_body with
-    | Evar_empty ->
-    	let spdecl' = { evar_hyps = spdecl.evar_hyps;
-                       	evar_concl = spdecl.evar_concl;
-                       	evar_body = Evar_defined c }
-    	in 
-	  Proof_trees.rc_add wc (sp,spdecl')
-    | _ -> error "define_evar"
-
 
 (******************************************)
 (* Instantiation of existential variables *)
 (******************************************)
 
-(* The instantiate tactic *)
+(* w_tactic pour instantiate *) 
 
-let evars_of evc c = 
-  let rec evrec acc c =
-    match kind_of_term c with
-    | Evar (n, _) when Evd.in_dom evc n -> c :: acc
-    | _ -> fold_constr evrec acc c
-  in 
-  evrec [] c
+let w_refine env ev rawc evd =
+  if Evd.is_defined (evars_of evd) ev then 
+    error "Instantiate called on already-defined evar";
+  let e_info = Evd.map (evars_of evd) ev in
+  let env = Evd.evar_env e_info in
+  let sigma,typed_c = 
+    Pretyping.Default.understand_tcc (evars_of evd) env 
+      ~expected_type:e_info.evar_concl rawc in
+  evar_define ev typed_c (evars_reset_evd sigma evd)
 
-let instantiate n c ido gl = 
-  let wc = Refiner.project_with_focus gl in
-  let evl = 
-    match ido with
-	None -> evars_of wc.sigma gl.it.evar_concl 
-      | Some (id,_,_) -> 
-	  let (_,_,typ)=Sign.lookup_named id gl.it.evar_hyps in
-	    evars_of wc.sigma typ in
-    if List.length evl < n then error "not enough evars";
-    let (n,_) as k = destEvar (List.nth evl (n-1)) in 
-      if Evd.is_defined wc.sigma n then 
-	error "Instantiate called on already-defined evar";
-      let wc' = w_Define n c wc in 
-	tclIDTAC {it = gl.it ; sigma = wc'.sigma}
-
-let pfic gls c =
-  let evc = gls.sigma in 
-  Constrintern.interp_constr evc (Global.env_of_context gls.it.evar_hyps) c
-
-(*
-let instantiate_tac = function
-  | [Integer n; Command com] ->
-      (fun gl -> instantiate n (pfic gl com) gl)
-  | [Integer n; Constr c] ->
-      (fun gl -> instantiate n c gl)
-  | _ -> invalid_arg "Instantiate called with bad arguments"
-*)
-
-(* vernac command existential *)
+(* vernac command Existential *)
 
 let instantiate_pf_com n com pfts = 
   let gls = top_goal_of_pftreestate pfts in
-  let wc = project_with_focus gls in
-  let sigma = (w_Underlying wc) in 
-  let (sp,evd) = 
+  let sigma = gls.sigma in 
+  let (sp,evi) (* as evc *) = 
     try
-      List.nth (Evd.non_instantiated sigma) (n-1) 
+      List.nth (Evarutil.non_instantiated sigma) (n-1) 
     with Failure _ -> 
-      error "not so many uninstantiated existential variables"
-      | Invalid_argument _ -> error "incorrect existential variable index"
-  in 
-  let c = Constrintern.interp_constr sigma (Evarutil.evar_env evd) com in     
-  let wc' = w_Define sp c wc in
-  let newgc = (w_Underlying wc') in
-  change_constraints_pftreestate newgc pfts
-
-
+      error "not so many uninstantiated existential variables" in 
+  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
+  change_constraints_pftreestate (evars_of evd') pfts
diff --git a/proofs/evar_refiner.mli b/proofs/evar_refiner.mli
index d57e1b84..9880f2f0 100644
--- a/proofs/evar_refiner.mli
+++ b/proofs/evar_refiner.mli
@@ -6,52 +6,21 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: evar_refiner.mli,v 1.28.2.2 2005/01/21 16:41:51 herbelin Exp $ i*)
+(*i $Id: evar_refiner.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
 
 (*i*)
 open Names
 open Term
-open Sign
 open Environ
 open Evd
 open Refiner
-open Proof_type
 (*i*)
 
-type wc = named_context sigma (* for a better reading of the following *)
-
 (* Refinement of existential variables. *)
 
-val rc_of_pfsigma : proof_tree sigma -> wc
-val rc_of_glsigma : goal sigma -> wc
-
-(* A [w_tactic] is a tactic which modifies the a set of evars of which
-   a goal depend, either by instantiating one, or by declaring a new
-   dependent goal *)
-type w_tactic = wc -> wc
-
-val startWalk : goal sigma -> wc * (wc -> tactic)
-
-val extract_decl : evar -> w_tactic
-val restore_decl : evar -> evar_info -> w_tactic
-val w_Declare    : evar -> types -> w_tactic
-val w_Define     : evar -> constr -> w_tactic
-
-val w_Underlying : wc -> evar_map
-val w_env        : wc -> env
-val w_hyps       : wc -> named_context
-val w_whd        : wc -> constr -> constr
-val w_type_of    : wc -> constr -> constr
-val w_add_sign   : (identifier * types) -> w_tactic
+val w_refine :  env -> evar -> Rawterm.rawconstr  -> evar_defs -> evar_defs
 
-val w_whd_betadeltaiota : wc -> constr -> constr
-val w_hnf_constr        : wc -> constr -> constr
-val w_conv_x            : wc -> constr -> constr -> bool
-val w_const_value       : wc -> constant -> constr
-val w_defined_evar      : wc -> existential_key -> bool
+val instantiate_pf_com :
+  int -> Topconstr.constr_expr -> pftreestate -> pftreestate
 
-val instantiate : int -> constr -> identifier Tacexpr.gsimple_clause -> tactic
-(*i
-val instantiate_tac : tactic_arg list -> tactic
-i*)
-val instantiate_pf_com : int -> Topconstr.constr_expr -> pftreestate -> pftreestate
+(* the instantiate tactic was moved to [tactics/evar_tactics.ml] *) 
diff --git a/proofs/logic.ml b/proofs/logic.ml
index cefeb8ae..1f79d73c 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: logic.ml,v 1.80.2.5 2005/12/17 21:15:52 herbelin Exp $ *)
+(* $Id: logic.ml 8696 2006-04-11 07:05:50Z herbelin $ *)
 
 open Pp
 open Util
@@ -25,7 +25,6 @@ open Proof_trees
 open Proof_type
 open Typeops
 open Type_errors
-open Coqast
 open Retyping
 open Evarutil
  
@@ -40,114 +39,72 @@ type refiner_error =
   | NonLinearProof of constr
 
   (* Errors raised by the tactics *)
-  | CannotUnify of constr * constr
-  | CannotUnifyBindingType of constr * constr
-  | CannotGeneralize of constr
   | IntroNeedsProduct
   | DoesNotOccurIn of constr * identifier
-  | NoOccurrenceFound of constr
 
 exception RefinerError of refiner_error
 
 open Pretype_errors
 
-let catchable_exception = function
-  | Util.UserError _ | TypeError _ | RefinerError _
-  | Stdpp.Exc_located(_,(Util.UserError _ | TypeError _ | RefinerError _ |
-    Nametab.GlobalizationError _ | PretypeError (_,VarNotFound _) | 
-    Indtypes.InductiveError (Indtypes.NotAllowedCaseAnalysis _ ))) -> true
+let rec catchable_exception = function
+  | Stdpp.Exc_located(_,e) -> catchable_exception e
+  | Util.UserError _ | TypeError _ 
+  | RefinerError _ | Indrec.RecursionSchemeError _
+  | Nametab.GlobalizationError _ | PretypeError (_,VarNotFound _)
+  (* unification errors *)
+  | PretypeError(_,(CannotUnify _|CannotGeneralize _|NoOccurrenceFound _|
+      CannotUnifyBindingType _|NotClean _)) -> true
   | _ -> false
 
-let error_cannot_unify (m,n) =
-  raise (RefinerError (CannotUnify (m,n)))
-
 (* Tells if the refiner should check that the submitted rules do not
    produce invalid subgoals *)
 let check = ref false
-
-let without_check tac gl =
-  let c = !check in
-  check := false;
-  try let r = tac gl in check := c; r with e -> check := c; raise e
-
 let with_check = Options.with_option check
-   
+
 (************************************************************************)
 (************************************************************************)
 (* Implementation of the structural rules (moving and deleting
    hypotheses around) *)
 
-let check_clear_forward cleared_ids used_ids whatfor =
-  if !check && cleared_ids<>[] then
-    Idset.iter
-      (fun id' ->
-        if List.mem id' cleared_ids then
-          error (string_of_id id'^" is used in "^whatfor))
-      used_ids
-
 (* The Clear tactic: it scans the context for hypotheses to be removed
    (instead of iterating on the list of identifier to be removed, which
    forces the user to give them in order). *)
 let clear_hyps ids gl =
   let env = Global.env() in
-  let (nhyps,rmv) =
-    Sign.fold_named_context
-      (fun (id,c,ty as d) (hyps,rmv) ->
-        if List.mem id ids then
-          (hyps,id::rmv)
-        else begin
-          check_clear_forward rmv (global_vars_set_of_decl env d)
-            ("hypothesis "^string_of_id id);
-          (add_named_decl d hyps, rmv)
-        end)
-      gl.evar_hyps
-      ~init:(empty_named_context,[]) in
+  let (nhyps,cleared_ids) =
+    let fcheck cleared_ids (id,_,_ as d)  =
+      if !check && cleared_ids<>[] then
+	Idset.iter
+	  (fun id' ->
+            if List.mem id' cleared_ids then
+              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
   let ncl = gl.evar_concl in
-  check_clear_forward rmv (global_vars_set env ncl) "conclusion";
+  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
 
 (* The ClearBody tactic *)
 
 (* [apply_to_hyp sign id f] splits [sign] into [tail::[id,_,_]::head] and
-   returns [tail::(f head (id,_,_) tail)] *)
+   returns [tail::(f head (id,_,_) (rev tail))] *)
 let apply_to_hyp sign id f =
-  let found = ref false in
-  let sign' =
-    fold_named_context_both_sides
-      (fun head (idc,c,ct as d) tail ->
-	 if idc = id then begin
-	   found := true; f head d tail
-	 end else 
-	   add_named_decl d head)
-      sign ~init:empty_named_context
-  in
-  if (not !check) || !found then sign' else error "No such assumption"
-
-(* Same but with whole environment *)
-let apply_to_hyp2 env id f =
-  let found = ref false in
-  let env' =
-    fold_named_context_both_sides
-      (fun env (idc,c,ct as d) tail ->
-	 if idc = id then begin
-	   found := true; f env d tail
-	 end else 
-	   push_named d env)
-      (named_context env) ~init:(reset_context env)
-  in
-  if (not !check) || !found then env' else error "No such assumption"
+  try apply_to_hyp sign id f 
+  with Hyp_not_found -> 
+    if !check then error "No such assumption"
+    else sign
 
 let apply_to_hyp_and_dependent_on sign id f g =
-  let found = ref false in
-  let sign =
-    Sign.fold_named_context
-      (fun (idc,_,_ as d) oldest ->
-         if idc = id then (found := true; add_named_decl (f d) oldest)
-         else if !found then add_named_decl (g d) oldest
-         else add_named_decl d oldest)
-      sign ~init:empty_named_context
-  in
-  if (not !check) || !found then sign else error "No such assumption"
+  try apply_to_hyp_and_dependent_on sign id f g 
+  with Hyp_not_found -> 
+    if !check then error "No such assumption"
+    else sign
 
 let check_typability env sigma c =
   if !check then let _ = type_of env sigma c in () 
@@ -162,26 +119,24 @@ let recheck_typability (what,id) env sigma t =
       ("The correctness of "^s^" relies on the body of "^(string_of_id id))
   
 let remove_hyp_body env sigma id =
-  apply_to_hyp2 env id
-    (fun env (_,c,t) tail ->
-       match c with
-         | None -> error ((string_of_id id)^" is not a local definition")
-         | Some c ->
-             let env' = push_named (id,None,t) env in
-             if !check then 
-               ignore
-                 (Sign.fold_named_context 
-                    (fun (id',c,t as d) env'' ->
-                       (match c with
-                          | None -> 
-                              recheck_typability (Some id',id) env'' sigma t
-                          | Some b ->
-                              let b' = mkCast (b,t) in
-                              recheck_typability (Some id',id) env'' sigma b');
-                       push_named d env'')
-                    (List.rev tail) ~init:env');
-             env')
-
+  let sign =
+    apply_to_hyp_and_dependent_on (named_context_val env) id
+      (fun (_,c,t) _ ->
+	match c with
+	| None -> error ((string_of_id id)^" is not a local definition")
+	| Some c ->(id,None,t))
+      (fun (id',c,t as d) sign ->
+	(if !check then
+	  begin 
+	    let env = reset_with_named_context sign env in
+	    match c with
+	    | None ->  recheck_typability (Some id',id) env sigma t
+	    | Some b ->
+		let b' = mkCast (b,DEFAULTcast, t) in
+		recheck_typability (Some id',id) env sigma b'
+	  end;d))
+  in
+  reset_with_named_context sign env 
 
 (* Auxiliary functions for primitive MOVE tactic
  *
@@ -231,9 +186,16 @@ let move_after with_dep toleft (left,(idfrom,_,_ as declfrom),right) hto =
 	  moverec first' middle' right
   in
   if toleft then 
-    List.rev_append (moverec [] [declfrom] left) right
+    let right = 
+      List.fold_right push_named_context_val right empty_named_context_val in
+    List.fold_left (fun sign d -> push_named_context_val d sign)
+      right (moverec [] [declfrom] left) 
   else 
-    List.rev_append left (moverec [] [declfrom] right)
+    let right = 
+      List.fold_right push_named_context_val
+	(moverec [] [declfrom] right) empty_named_context_val in
+    List.fold_left (fun sign d -> push_named_context_val d sign)
+      right left
 
 let check_backward_dependencies sign d =
   if not (Idset.for_all
@@ -255,8 +217,8 @@ let check_forward_dependencies id tail =
 
 let rename_hyp id1 id2 sign =
   apply_to_hyp_and_dependent_on sign id1
-    (fun (_,b,t) -> (id2,b,t))
-    (map_named_declaration (replace_vars [id1,mkVar id2]))
+    (fun (_,b,t) _ -> (id2,b,t))
+    (fun d _ -> map_named_declaration (replace_vars [id1,mkVar id2]) d)
 
 let replace_hyp sign id d =
   apply_to_hyp sign id
@@ -264,13 +226,17 @@ let replace_hyp sign id d =
        if !check then
 	 (check_backward_dependencies sign d;
 	  check_forward_dependencies id tail);
-       add_named_decl d sign)
+       d)
 
+(* why we dont check that id does not appear in tail ??? *)
 let insert_after_hyp sign id d =
-  apply_to_hyp sign id
-    (fun sign d' _ ->
-       if !check then check_backward_dependencies sign d;
-       add_named_decl d (add_named_decl d' sign))
+  try 
+    insert_after_hyp sign id d 
+      (fun sign ->
+	if !check then check_backward_dependencies sign d)
+  with Hyp_not_found ->
+    if !check then error "No such assumption"
+    else sign
 
 (************************************************************************)
 (************************************************************************)
@@ -282,7 +248,7 @@ variables only in Application and Case *)
 let collect_meta_variables c = 
   let rec collrec acc c = match kind_of_term c with
     | Meta mv -> mv::acc
-    | Cast(c,_) -> collrec acc c
+    | Cast(c,_,_) -> collrec acc c
     | (App _| Case _) -> fold_constr collrec acc c
     | _ -> acc
   in 
@@ -311,13 +277,17 @@ let rec mk_refgoals sigma goal goalacc conclty trm =
           raise (RefinerError (OccurMetaGoal conclty));
 	(mk_goal hyps (nf_betaiota conclty))::goalacc, conclty
 
-    | Cast (t,ty) ->
+    | Cast (t,_, ty) ->
 	check_typability env sigma ty;
 	check_conv_leq_goal env sigma trm ty conclty;
 	mk_refgoals sigma goal goalacc ty t
 
     | App (f,l) ->
-	let (acc',hdty) = mk_hdgoals sigma goal goalacc f in
+	let (acc',hdty) =
+	  if isInd f & not (array_exists occur_meta l) (* we could be finer *)
+	  then (goalacc,type_of_applied_inductive env sigma (destInd f) l)
+	  else mk_hdgoals sigma goal goalacc f
+	in
 	let (acc'',conclty') =
 	  mk_arggoals sigma goal acc' hdty (Array.to_list l) in
 	check_conv_leq_goal env sigma trm conclty' conclty;
@@ -346,12 +316,20 @@ and mk_hdgoals sigma goal goalacc trm =
   let env = evar_env goal in
   let hyps = goal.evar_hyps in
   match kind_of_term trm with
-    | Cast (c,ty) when isMeta c ->
+    | Cast (c,_, ty) when isMeta c ->
 	check_typability env sigma ty;
 	(mk_goal hyps (nf_betaiota ty))::goalacc,ty
 
+    | Cast (t,_, ty) ->
+	check_typability env sigma ty;
+	mk_refgoals sigma goal goalacc ty t
+
     | App (f,l) ->
-	let (acc',hdty) = mk_hdgoals sigma goal goalacc f in
+	let (acc',hdty) = 
+	  if isInd f & not (array_exists occur_meta l) (* we could be finer *)
+	  then (goalacc,type_of_applied_inductive env sigma (destInd f) l)
+	  else mk_hdgoals sigma goal goalacc f
+	in
 	mk_arggoals sigma goal acc' hdty (Array.to_list l)
 
     | Case (_,p,c,lf) ->
@@ -397,16 +375,13 @@ let error_use_instantiate () =
 
 let convert_hyp sign sigma (id,b,bt as d) =
   apply_to_hyp sign id
-    (fun sign (_,c,ct) _ ->
+    (fun _ (_,c,ct) _ ->
        let env = Global.env_of_context sign in
        if !check && not (is_conv env sigma bt ct) then
-	 (* Just a warning in V8.0bugfix for compatibility *)
-	 msgnl (str "Compatibility warning: Hazardeous change of the type of " ++ pr_id id ++ 
-	       str " (not well-typed in current signature)");
+	 error ("Incorrect change of the type of "^(string_of_id id));
        if !check && not (option_compare (is_conv env sigma) b c) then
-	 msgnl (str "Compatibility warning: Hazardeous change of the body of " ++ pr_id id ++
-	       str " (not well-typed in current signature)");
-       add_named_decl d sign)
+	 error ("Incorrect change of the body of "^(string_of_id id));
+       d)
 
 
 (************************************************************************)
@@ -420,18 +395,18 @@ let prim_refiner r sigma goal =
   match r with
     (* Logical rules *)
     | Intro id ->
-    	if !check && mem_named_context id sign then
+    	if !check && mem_named_context id (named_context_of_val sign) then
 	  error "New variable is already declared";
         (match kind_of_term (strip_outer_cast cl) with
 	   | Prod (_,c1,b) ->
 	       if occur_meta c1 then error_use_instantiate();
-	       let sg = mk_goal (add_named_decl (id,None,c1) sign)
+	       let sg = mk_goal (push_named_context_val (id,None,c1) sign)
 			  (subst1 (mkVar id) b) in
 	       [sg]
 	   | LetIn (_,c1,t1,b) ->
 	       if occur_meta c1 or occur_meta t1 then error_use_instantiate();
 	       let sg =
-		 mk_goal (add_named_decl (id,Some c1,t1) sign)
+		 mk_goal (push_named_context_val (id,Some c1,t1) sign)
 		   (subst1 (mkVar id) b) in
 	       [sg]
 	   | _ ->
@@ -453,11 +428,11 @@ let prim_refiner r sigma goal =
 	       raise (RefinerError IntroNeedsProduct))
 	
     | Cut (b,id,t) ->
-    	if !check && mem_named_context id sign then
+    	if !check && mem_named_context id (named_context_of_val sign) then
 	  error "New variable is already declared";
         if occur_meta t then error_use_instantiate();
         let sg1 = mk_goal sign (nf_betaiota t) in
-        let sg2 = mk_goal (add_named_decl (id,None,t) sign) cl in
+        let sg2 = mk_goal (push_named_context_val (id,None,t) sign) cl in
         if b then [sg1;sg2] else [sg2;sg1]  
 
     | FixRule (f,n,rest) ->
@@ -481,9 +456,9 @@ let prim_refiner r sigma goal =
 	      if not (sp=sp') then 
 		error ("fixpoints should be on the same " ^ 
 		       "mutual inductive declaration");
-	      if !check && mem_named_context f sign then 
+	      if !check && mem_named_context f (named_context_of_val sign) then
 		error "name already used in the environment";
-	      mk_sign (add_named_decl (f,None,ar) sign) oth
+	      mk_sign (push_named_context_val (f,None,ar) sign) oth
 	  | [] -> 
 	      List.map (fun (_,_,c) -> mk_goal sign c) all
 	in 
@@ -506,11 +481,11 @@ let prim_refiner r sigma goal =
         let rec mk_sign sign = function 
           | (f,ar)::oth ->
 	      (try
-                (let _ = Sign.lookup_named f sign in
+                (let _ = lookup_named_val f sign in
                 error "name already used in the environment")
               with
               |	Not_found ->
-                  mk_sign (add_named_decl (f,None,ar) sign) oth)
+                  mk_sign (push_named_context_val (f,None,ar) sign) oth)
 	  | [] -> List.map (fun (_,c) -> mk_goal sign c) all
      	in 
 	mk_sign sign all
@@ -523,7 +498,7 @@ let prim_refiner r sigma goal =
 	sgl
 
     (* Conversion rules *)
-    | Convert_concl cl' ->
+    | Convert_concl (cl',_) ->
 	check_typability env sigma cl';
 	if (not !check) || is_conv_leq env sigma cl' cl then
           let sg = mk_goal sign cl' in
@@ -544,18 +519,20 @@ let prim_refiner r sigma goal =
           if !check then recheck_typability (None,id) env' sigma cl;
           env'
 	in
-	let sign' = named_context (List.fold_left clear_aux env ids) in
+	let sign' = named_context_val (List.fold_left clear_aux env ids) in
      	let sg = mk_goal sign' cl in
      	[sg]
 
     | Move (withdep, hfrom, hto) ->
-  	let (left,right,declfrom,toleft) = split_sign hfrom hto sign in
+  	let (left,right,declfrom,toleft) = 
+	  split_sign hfrom hto (named_context_of_val sign) in
   	let hyps' = 
 	  move_after withdep toleft (left,declfrom,right) hto in
   	[mk_goal hyps' cl]
 
     | Rename (id1,id2) ->
-        if !check & id1 <> id2 & List.mem id2 (ids_of_named_context sign) then
+        if !check & id1 <> id2 &&
+	  List.mem id2 (ids_of_named_context (named_context_of_val sign)) then
           error ((string_of_id id2)^" is already used");
         let sign' = rename_hyp id1 id2 sign in
         let cl' = replace_vars [id1,mkVar id2] cl in
@@ -566,15 +543,39 @@ let prim_refiner r sigma goal =
 (* Extracting a proof term from the proof tree *)
 
 (* Util *)
+
+type variable_proof_status = ProofVar | SectionVar of identifier
+
+type proof_variable = name * variable_proof_status
+
+let subst_proof_vars = 
+  let rec aux p vars =
+    let _,subst =
+      List.fold_left (fun (n,l) var ->
+        let t = match var with
+          | Anonymous,_ -> l
+          | Name id, ProofVar -> (id,mkRel n)::l
+          | Name id, SectionVar id' -> (id,mkVar id')::l in
+        (n+1,t)) (p,[]) vars
+    in replace_vars (List.rev subst)
+  in aux 1
+         
 let rec rebind id1 id2 = function
-  | [] -> []
-  | id::l -> 
-      if id = id1 then id2::l else
+  | [] -> [Name id2,SectionVar id1]
+  | (na,_ as x)::l -> 
+      if na = Name id1 then (Name id2,ProofVar)::l else
         let l' = rebind id1 id2 l in
-        if id = id2 then
-          (* TODO: find a more elegant way to hide a variable *)
-          (id_of_string "_@")::l'
-        else id::l'
+        if na = Name id2 then (Anonymous,ProofVar)::l' else x::l'
+
+let add_proof_var id vl = (Name id,ProofVar)::vl
+
+let proof_variable_index x = 
+  let rec aux n = function
+    | (Name id,ProofVar)::l when x = id -> n
+    | _::l ->  aux (n+1) l
+    | [] -> raise Not_found
+  in 
+  aux 1
 
 let prim_extractor subfun vl pft =
   let cl = pft.goal.evar_concl in
@@ -582,61 +583,64 @@ let prim_extractor subfun vl pft =
     | Some (Prim (Intro id), [spf]) ->
 	(match kind_of_term (strip_outer_cast cl) with
 	   | Prod (_,ty,_) ->
-	       let cty = subst_vars vl ty in
-	       mkLambda (Name id, cty, subfun (id::vl) spf)
+	       let cty = subst_proof_vars vl ty in
+	       mkLambda (Name id, cty, subfun (add_proof_var id vl) spf)
 	   | LetIn (_,b,ty,_) ->
-	       let cb = subst_vars vl b in
-	       let cty = subst_vars vl ty in
-	       mkLetIn (Name id, cb, cty, subfun (id::vl) spf)
+	       let cb = subst_proof_vars vl b in
+	       let cty = subst_proof_vars vl ty in
+	       mkLetIn (Name id, cb, cty, subfun (add_proof_var id vl) spf)
 	   | _ -> error "incomplete proof!")
 	
     | Some (Prim (Intro_replacing id),[spf]) ->
 	(match kind_of_term (strip_outer_cast cl) with
 	   | Prod (_,ty,_) ->
-	       let cty = subst_vars vl ty in
-	       mkLambda (Name id, cty, subfun (id::vl) spf)
+	       let cty = subst_proof_vars vl ty in
+	       mkLambda (Name id, cty, subfun (add_proof_var id vl) spf)
 	   | LetIn (_,b,ty,_) ->
-	       let cb = subst_vars vl b in
-	       let cty = subst_vars vl ty in
-	       mkLetIn (Name id, cb, cty, subfun (id::vl) spf)
+	       let cb = subst_proof_vars vl b in
+	       let cty = subst_proof_vars vl ty in
+	       mkLetIn (Name id, cb, cty, subfun (add_proof_var id vl) spf)
 	   | _ -> error "incomplete proof!")
 
     | Some (Prim (Cut (b,id,t)),[spf1;spf2]) ->
         let spf1, spf2 = if b then spf1, spf2 else spf2, spf1 in
-	mkLetIn (Name id,subfun vl spf1,subst_vars vl t,subfun (id::vl) spf2)
+	mkLetIn (Name id,subfun vl spf1,subst_proof_vars vl t,
+                 subfun (add_proof_var id vl) spf2)
 
     | Some (Prim (FixRule (f,n,others)),spfl) ->
 	let all = Array.of_list ((f,n,cl)::others) in
-	let lcty = Array.map (fun (_,_,ar) -> subst_vars vl ar) all in
+	let lcty = Array.map (fun (_,_,ar) -> subst_proof_vars vl ar) all in
 	let names = Array.map (fun (f,_,_) -> Name f) all in
 	let vn = Array.map (fun (_,n,_) -> n-1) all in
-	let newvl = List.fold_left (fun vl (id,_,_)->(id::vl)) (f::vl)others in
+	let newvl = List.fold_left (fun vl (id,_,_) -> add_proof_var id vl)
+          (add_proof_var f vl) others in
 	let lfix = Array.map (subfun newvl) (Array.of_list spfl) in
 	mkFix ((vn,0),(names,lcty,lfix))	
 
     | Some (Prim (Cofix (f,others)),spfl) ->
 	let all = Array.of_list ((f,cl)::others) in
-	let lcty = Array.map (fun (_,ar) -> subst_vars vl ar) all in
+	let lcty = Array.map (fun (_,ar) -> subst_proof_vars vl ar) all in
 	let names  = Array.map (fun (f,_) -> Name f) all in
-	let newvl = List.fold_left (fun vl (id,_)->(id::vl)) (f::vl) others in 
+	let newvl = List.fold_left (fun vl (id,_)-> add_proof_var id vl)
+          (add_proof_var f vl) others in 
 	let lfix = Array.map (subfun newvl) (Array.of_list spfl) in
 	mkCoFix (0,(names,lcty,lfix))
 	  
     | Some (Prim (Refine c),spfl) ->
 	let mvl = collect_meta_variables c in
 	let metamap = List.combine mvl (List.map (subfun vl) spfl) in
-	let cc = subst_vars vl c in 
+	let cc = subst_proof_vars vl c in 
 	plain_instance metamap cc
 
     (* Structural and conversion rules do not produce any proof *)
-    | Some (Prim (Convert_concl _),[pf]) ->
-	subfun vl pf
-	
+    | Some (Prim (Convert_concl (t,k)),[pf]) ->
+	if k = DEFAULTcast then subfun vl pf
+	else mkCast (subfun vl pf,k,subst_proof_vars vl cl)
     | Some (Prim (Convert_hyp _),[pf]) ->
 	subfun vl pf
 
     | Some (Prim (Thin _),[pf]) ->
-     (* No need to make ids Anonymous in vl: subst_vars take the more recent *)
+     (* No need to make ids Anon in vl: subst_proof_vars take the most recent*)
 	subfun vl pf
 	
     | Some (Prim (ThinBody _),[pf]) ->
@@ -652,133 +656,3 @@ let prim_extractor subfun vl pft =
 
     | None-> error "prim_extractor handed incomplete proof"
 	  
-(* Pretty-printer *)
-
-open Printer
-
-let prterm x = prterm_env (Global.env()) x
-
-let pr_prim_rule_v7 = function
-  | Intro id -> 
-      str"Intro " ++ pr_id id
-	
-  | Intro_replacing id -> 
-      (str"intro replacing "  ++ pr_id id)
-	
-  | Cut (b,id,t) ->
-      if b then
-        (str"Assert " ++ prterm t)
-      else
-        (str"Cut " ++ prterm t ++ str ";[Intro " ++ pr_id id ++ str "|Idtac]")
-	
-  | FixRule (f,n,[]) ->
-      (str"Fix " ++ pr_id f ++ str"/" ++ int n)
-      
-  | FixRule (f,n,others) -> 
-      let rec print_mut = function
-	| (f,n,ar)::oth -> 
-           pr_id f ++ str"/" ++ int n ++ str" : " ++ prterm ar ++ print_mut oth
-        | [] -> mt () in
-      (str"Fix " ++ pr_id f ++ str"/" ++ int n ++
-         str" with " ++ print_mut others)
-
-  | Cofix (f,[]) ->
-      (str"Cofix " ++ pr_id f)
-
-  | Cofix (f,others) ->
-      let rec print_mut = function
-	| (f,ar)::oth ->
-	  (pr_id f ++ str" : " ++ prterm 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 prterm c
-      
-  | Convert_concl c ->
-      (str"Change "  ++ prterm c)
-      
-  | Convert_hyp (id,None,t) ->
-      (str"Change "  ++ prterm t  ++ spc ()  ++ str"in "  ++ pr_id id)
-
-  | Convert_hyp (id,Some c,t) ->
-      (str"Change "  ++ prterm c  ++ spc ()  ++ str"in "
-       ++ pr_id id ++ str" (Type of "  ++ pr_id id ++ str ")")
-      
-  | Thin ids ->
-      (str"Clear "  ++ prlist_with_sep pr_spc pr_id ids)
-      
-  | ThinBody ids ->
-      (str"ClearBody "  ++ prlist_with_sep pr_spc pr_id ids)
-      
-  | Move (withdep,id1,id2) ->
-      (str (if withdep then "Dependent " else "") ++
-	 str"Move "  ++ pr_id id1 ++ str " after " ++ pr_id id2)
-
-  | Rename (id1,id2) ->
-      (str "Rename " ++ pr_id id1 ++ str " into " ++ pr_id id2)
-
-let pr_prim_rule_v8 = function
-  | Intro id -> 
-      str"intro " ++ pr_id id
-	
-  | Intro_replacing id -> 
-      (str"intro replacing "  ++ pr_id id)
-	
-  | Cut (b,id,t) ->
-      if b then
-        (str"assert " ++ prterm t)
-      else
-        (str"cut " ++ prterm t ++ str ";[intro " ++ pr_id id ++ str "|idtac]")
-	
-  | FixRule (f,n,[]) ->
-      (str"fix " ++ pr_id f ++ str"/" ++ int n)
-      
-  | FixRule (f,n,others) -> 
-      let rec print_mut = function
-	| (f,n,ar)::oth -> 
-           pr_id f ++ str"/" ++ int n ++ str" : " ++ prterm ar ++ print_mut oth
-        | [] -> mt () in
-      (str"fix " ++ pr_id f ++ str"/" ++ int n ++
-         str" with " ++ print_mut others)
-
-  | Cofix (f,[]) ->
-      (str"cofix " ++ pr_id f)
-
-  | Cofix (f,others) ->
-      let rec print_mut = function
-	| (f,ar)::oth ->
-	  (pr_id f ++ str" : " ++ prterm 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 prterm c
-      
-  | Convert_concl c ->
-      (str"change "  ++ prterm c)
-      
-  | Convert_hyp (id,None,t) ->
-      (str"change "  ++ prterm t  ++ spc ()  ++ str"in "  ++ pr_id id)
-
-  | Convert_hyp (id,Some c,t) ->
-      (str"change "  ++ prterm c  ++ spc ()  ++ str"in "
-       ++ pr_id id ++ str" (type of "  ++ pr_id id ++ str ")")
-      
-  | Thin ids ->
-      (str"clear "  ++ prlist_with_sep pr_spc pr_id ids)
-      
-  | ThinBody ids ->
-      (str"clearbody "  ++ prlist_with_sep pr_spc pr_id ids)
-      
-  | Move (withdep,id1,id2) ->
-      (str (if withdep then "dependent " else "") ++
-	 str"move "  ++ pr_id id1 ++ str " after " ++ pr_id id2)
-
-  | Rename (id1,id2) ->
-      (str "rename " ++ pr_id id1 ++ str " into " ++ pr_id id2)
-
-let pr_prim_rule t =
-  if! Options.v7 then pr_prim_rule_v7 t else pr_prim_rule_v8 t
diff --git a/proofs/logic.mli b/proofs/logic.mli
index 7eef22bd..ab65b1d5 100644
--- a/proofs/logic.mli
+++ b/proofs/logic.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: logic.mli,v 1.27.6.1 2004/07/16 19:30:49 herbelin Exp $ i*)
+(*i $Id: logic.mli 8107 2006-03-01 17:34:36Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -20,7 +20,6 @@ open Proof_type
 (* This suppresses check done in [prim_refiner] for the tactic given in
    argument; works by side-effect *)
 
-val without_check : tactic -> tactic
 val with_check    : tactic -> tactic
 
 (* [without_check] respectively means:\\
@@ -37,9 +36,13 @@ val with_check    : tactic -> tactic
 
 val prim_refiner : prim_rule -> evar_map -> goal -> goal list
 
+type proof_variable
+
 val prim_extractor :
-  (identifier list -> proof_tree -> constr)
-  -> identifier list -> proof_tree -> constr
+  (proof_variable list -> proof_tree -> constr)
+  -> proof_variable list -> proof_tree -> constr
+
+val proof_variable_index : identifier -> proof_variable list -> int
 
 (*s Refiner errors. *)
 
@@ -54,20 +57,9 @@ type refiner_error =
   | NonLinearProof of constr
 
   (*i Errors raised by the tactics i*)
-  | CannotUnify of constr * constr
-  | CannotUnifyBindingType of constr * constr
-  | CannotGeneralize of constr
   | IntroNeedsProduct
   | DoesNotOccurIn of constr * identifier
-  | NoOccurrenceFound of constr
 
 exception RefinerError of refiner_error
 
-val error_cannot_unify : constr * constr -> 'a
-
 val catchable_exception : exn -> bool
-
-
-(*s Pretty-printer. *)
-
-val pr_prim_rule   : prim_rule -> Pp.std_ppcmds
diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml
index f53ea870..fa6f8c37 100644
--- a/proofs/pfedit.ml
+++ b/proofs/pfedit.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pfedit.ml,v 1.47.2.1 2004/07/16 19:30:49 herbelin Exp $ *)
+(* $Id: pfedit.ml 6947 2005-04-20 16:18:41Z coq $ *)
 
 open Pp
 open Util
@@ -19,7 +19,7 @@ open Entries
 open Environ
 open Evd
 open Typing
-open Tacmach
+open Refiner
 open Proof_trees
 open Tacexpr
 open Proof_type
@@ -33,7 +33,6 @@ open Safe_typing
 
 type proof_topstate = {
   mutable top_end_tac : tactic option;
-  top_hyps : named_context * named_context;
   top_goal : goal;
   top_strength : Decl_kinds.goal_kind;
   top_hook : declaration_hook }
@@ -175,6 +174,21 @@ let undo n =
   with (Invalid_argument "Edit.undo") ->
     errorlabstrm "Pfedit.undo" (str"No focused proof" ++ msg_proofs true)
 
+(* Undo current focused proof to reach depth [n]. This is used in
+   [vernac_backtrack]. *)
+let undo_todepth n =
+  try 
+    Edit.undo_todepth proof_edits n
+  with (Invalid_argument "Edit.undo") ->
+    errorlabstrm "Pfedit.undo" (str"No focused proof" ++ msg_proofs true)
+
+(* Return the depth of the current focused proof stack, this is used
+   to put informations in coq prompt (in emacs mode). *)
+let current_proof_depth() = 
+  try
+    Edit.depth proof_edits
+  with (Invalid_argument "Edit.depth") -> -1
+
 (*********************************************************************)
 (*                  Proof cooking                                    *)
 (*********************************************************************)
@@ -192,7 +206,8 @@ let cook_proof () =
   (ident,
    ({ const_entry_body = pfterm;
       const_entry_type = Some concl;
-      const_entry_opaque = true },
+      const_entry_opaque = true;
+      const_entry_boxed = false},
     strength, ts.top_hook))
 
 let current_proof_statement () = 
@@ -231,7 +246,6 @@ let start_proof na str sign concl hook =
   let top_goal = mk_goal sign concl in
   let ts = { 
     top_end_tac = None;
-    top_hyps = (sign,empty_named_context);
     top_goal = top_goal;
     top_strength = str;
     top_hook = hook}
@@ -274,11 +288,11 @@ let common_ancestor l1 l2 =
       
 let rec traverse_up = function
   | 0 -> (function pf -> pf)
-  | n -> (function pf -> Tacmach.traverse 0 (traverse_up (n - 1) pf))
+  | n -> (function pf -> Refiner.traverse 0 (traverse_up (n - 1) pf))
 
 let rec traverse_down = function
   | [] -> (function pf -> pf)
-  | n::l -> (function pf -> Tacmach.traverse n (traverse_down l pf))
+  | n::l -> (function pf -> Refiner.traverse n (traverse_down l pf))
 
 let traverse_to path =
   let up_and_down path pfs =
@@ -305,29 +319,3 @@ 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
-
-(** Printers *)
-
-let pr_subgoals_of_pfts pfts = 
-  let gls = fst (Refiner.frontier (proof_of_pftreestate pfts)) in 
-  let sigma = project (top_goal_of_pftreestate pfts) in
-  pr_subgoals_existential sigma gls
-
-let pr_open_subgoals () =
-  let pfts = get_pftreestate () in
-  match focus() with
-    | 0 -> 
-	pr_subgoals_of_pfts pfts
-    | n -> 
-	let pf = proof_of_pftreestate pfts in
-	let gls = fst (frontier pf) in 
-	assert (n > List.length gls);
-	if List.length gls < 2 then 
-	  pr_subgoal n gls
-	else 
-	  v 0 (int(List.length gls) ++ str" subgoals" ++ cut () ++
-	  pr_subgoal n gls)
-
-let pr_nth_open_subgoal n =
-  let pf = proof_of_pftreestate (get_pftreestate ()) in
-  pr_subgoal n (fst (frontier pf))
diff --git a/proofs/pfedit.mli b/proofs/pfedit.mli
index e95881ba..ca379d2e 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,v 1.35.2.1 2004/07/16 19:30:49 herbelin Exp $ i*)
+(*i $Id: pfedit.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Util
@@ -57,6 +57,14 @@ val delete_all_proofs : unit -> unit
 
 val undo : int -> unit
 
+(* Same as undo, but undoes the current proof stack to reach depth
+   [n]. This is used in [vernac_backtrack]. *)
+val undo_todepth : int -> unit
+
+(* Returns the depth of the current focused proof stack, this is used
+   to put informations in coq prompt (in emacs mode). *)
+val current_proof_depth: unit -> int
+
 (* [set_undo (Some n)] sets the size of the ``undo'' stack; [set_undo None]
    sets the size to the default value (12) *)
 
@@ -68,7 +76,7 @@ val get_undo : unit -> int option
     declare the built constructions as a coercion or a setoid morphism) *)
 
 val start_proof : 
-  identifier -> goal_kind -> named_context -> constr
+  identifier -> goal_kind -> named_context_val -> constr
     -> declaration_hook -> unit
 
 (* [restart_proof ()] restarts the current focused proof from the beginning
@@ -176,8 +184,3 @@ val traverse_prev_unproven : unit -> unit
    proof and goal management, as it is done, for instance in pcoq *)
 val traverse_to : int list -> unit
 val mutate : (pftreestate -> pftreestate) -> unit
-
-(** Printers *)
-
-val pr_open_subgoals    : unit -> std_ppcmds
-val pr_nth_open_subgoal : int -> std_ppcmds
diff --git a/proofs/proof_trees.ml b/proofs/proof_trees.ml
index aaf54a36..7e299b89 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,v 1.53.2.1 2004/07/16 19:30:49 herbelin Exp $ *)
+(* $Id: proof_trees.ml 6113 2004-09-17 20:28:19Z barras $ *)
 
 open Closure
 open Util
@@ -66,29 +66,6 @@ let is_tactic_proof pf = match pf.ref with
   | _ -> false
 
 
-(*******************************************************************)
-(*            Constraints for existential variables                *)
-(*******************************************************************)
-
-(* A readable constraint is a global constraint plus a focus set
-   of existential variables and a signature. *)
-
-(* Functions on readable constraints *)
-			     
-let mt_evcty gc = 
-  { it = empty_named_context; sigma = gc }
-
-let rc_of_gc evds gl = 
-  { it = gl.evar_hyps; sigma = evds }
-
-let rc_add evc (k,v) = 
-  { it  = evc.it;
-    sigma = Evd.add evc.sigma k v }
-
-let get_hyps  evc = evc.it
-let get_env   evc = Global.env_of_context evc.it
-let get_gc    evc = evc.sigma
-
 let pf_lookup_name_as_renamed env ccl s =
   Detyping.lookup_name_as_renamed env ccl s
 
@@ -100,154 +77,12 @@ let pf_lookup_index_as_renamed env ccl n =
 (*********************************************************************)
 
 open Pp
-open Printer
 
-(* Il faudrait parametrer toutes les pr_term, term_env, etc. par la
-  strategie de renommage choisie pour Termast (en particulier, il
-  faudrait pouvoir etre sur que lookup_as_renamed qui est utilisé par
-  Intros Until fonctionne exactement comme on affiche le but avec
-  term_env *)
-
-let pf_lookup_name_as_renamed hyps ccl s =
-  Detyping.lookup_name_as_renamed hyps ccl s
-
-let pf_lookup_index_as_renamed ccl n =
-  Detyping.lookup_index_as_renamed ccl n
-
-let pr_idl idl = prlist_with_sep pr_spc pr_id idl
-
-let pr_goal g =
+let db_pr_goal g =
   let env = evar_env g in
-  let penv = pr_context_of env in
-  let pc = prterm_env_at_top env g.evar_concl in
+  let penv = print_named_context env in
+  let pc = print_constr_env 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 pr_concl n g =
-  let env = evar_env g in
-  let pc = prterm_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
-
-(* print the subgoals but write Subtree proved! even in case some existential 
-   variables remain unsolved, pr_subgoals_existential is a safer version 
-   of pr_subgoals *)
-
-let pr_subgoals = function
-  | [] -> (str"Proof completed." ++ fnl ())
-  | [g] ->
-      let pg = pr_goal g in v 0 (str ("1 "^"subgoal") ++cut () ++ pg)
-  | g1::rest ->
-      let rec pr_rec n = function
-        | [] -> (mt ())
-        | g::rest ->
-            let pg = pr_concl n g in
-            let prest = pr_rec (n+1) rest in
-            (cut () ++ pg ++ prest) 
-      in
-      let pg1 = pr_goal g1 in
-      let pgr = pr_rec 2 rest in
-      v 0 (int(List.length rest+1) ++ str" subgoals" ++ cut () ++ pg1 ++ pgr)
-
-let pr_subgoal n =
-  let rec prrec p = function
-    | [] -> error "No such goal"
-    | g::rest ->
-       	if p = 1 then
-          let pg = pr_goal g in
-          v 0 (str "subgoal " ++ int n ++ str " is:" ++ cut () ++ pg)
-       	else 
-	  prrec (p-1) rest
-  in 
-  prrec n
-
-let pr_seq evd = 
-  let env = evar_env evd
-  and cl = evd.evar_concl
-  in
-  let pdcl = pr_named_context_of env in
-  let pcl = prterm_env_at_top env cl in
-  hov 0 (pdcl  ++ spc ()  ++ hov 0 (str"|- "  ++ pcl))
-
-let prgl gl =
-  let pgl = pr_seq gl in
-  (str"["  ++ pgl  ++ str"]"  ++ spc ())
-
-let pr_evgl gl =
-  let phyps = pr_idl (List.rev (ids_of_named_context gl.evar_hyps)) in
-  let pc = prterm gl.evar_concl in
-  hov 0 (str"["  ++ phyps ++ spc () ++ str"|- "  ++ pc ++ str"]")
-
-let pr_evgl_sign gl = 
-  let ps = pr_named_context_of (evar_env gl) in
-  let pc = prterm gl.evar_concl in
-  hov 0 (str"["  ++ ps ++ spc () ++ str"|- "  ++ pc ++ str"]")
-
-(*  evd.evgoal.lc seems to be printed twice *)
-let pr_decl evd =
-  let pevgl = pr_evgl evd in
-  let pb =
-    match evd.evar_body with
-      | Evar_empty -> (fnl ())
-      | Evar_defined c -> let pc = prterm c in (str" => "  ++ pc ++  fnl ())
-  in
-  h 0 (pevgl ++ pb)
-
-let pr_evd evd = 
-  prlist_with_sep pr_fnl
-    (fun (ev,evd) ->
-       let pe = pr_decl evd in 
-       h 0 (str (string_of_existential ev)  ++ str"=="  ++ pe))
-    (Evd.to_list evd)
-    
-let pr_decls decls = pr_evd decls
-		       
-let pr_evc evc =
-  let pe = pr_evd evc.sigma in
-  (pe)
-
-let pr_evars = 
-  prlist_with_sep pr_fnl
-    (fun (ev,evd) ->
-       let pegl = pr_evgl_sign evd in 
-       (str (string_of_existential ev) ++ str " : " ++ pegl))
-
-(* Print an enumerated list of existential variables *)
-let rec pr_evars_int i = function
-  | [] -> (mt ())
-  | (ev,evd)::rest ->
-      let pegl = pr_evgl_sign evd in 
-      let pei = pr_evars_int (i+1) rest in
-      (hov 0 (str "Existential " ++ int i ++ str " =" ++ spc () ++
-              str (string_of_existential ev)  ++ str " : " ++ pegl)) ++ 
-      fnl () ++ pei
-
-(* Equivalent to pr_subgoals but start from the prooftree and 
-   check for uninstantiated existential variables *)
-
-let pr_subgoals_existential sigma = function 
-  | [] -> 
-      let exl = Evd.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))
-  | [g] ->
-      let pg = pr_goal g in
-      v 0 (str ("1 "^"subgoal") ++cut () ++ pg)
-  | g1::rest ->
-      let rec pr_rec n = function
-        | [] -> (mt ())
-        | g::rest ->
-            let pc = pr_concl n g in
-            let prest = pr_rec (n+1) rest in
-            (cut () ++ pc ++ prest) 
-      in
-      let pg1 = pr_goal g1 in
-      let prest = pr_rec 2 rest in
-      v 0 (int(List.length rest+1) ++ str" subgoals" ++ cut () 
-	   ++ pg1 ++ prest ++ fnl ())
diff --git a/proofs/proof_trees.mli b/proofs/proof_trees.mli
index c31d5207..cbf91c8a 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,v 1.27.2.1 2004/07/16 19:30:49 herbelin Exp $ i*)
+(*i $Id: proof_trees.mli 7639 2005-12-02 10:01:15Z gregoire $ 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 -> constr -> goal
+val mk_goal : named_context_val -> constr -> goal
 
 val rule_of_proof     : proof_tree -> rule
 val ref_of_proof      : proof_tree -> (rule * proof_tree list)
@@ -33,16 +33,6 @@ val is_complete_proof : proof_tree -> bool
 val is_leaf_proof     : proof_tree -> bool
 val is_tactic_proof   : proof_tree -> bool
 
-(*s A readable constraint is a global constraint plus a focus set
-    of existential variables and a signature. *)
-
-val rc_of_gc  : evar_map -> goal -> named_context sigma
-val rc_add    : named_context sigma -> existential_key * goal -> 
-  named_context sigma
-val get_hyps  : named_context sigma -> named_context
-val get_env   : named_context sigma -> env
-val get_gc    : named_context sigma -> evar_map
-
 val pf_lookup_name_as_renamed  : env -> constr -> identifier -> int option
 val pf_lookup_index_as_renamed : env -> constr -> int -> int option
 
@@ -53,16 +43,4 @@ val pf_lookup_index_as_renamed : env -> constr -> int -> int option
 open Pp
 (*i*)
 
-val pr_goal      : goal -> std_ppcmds
-val pr_subgoals  : goal list -> std_ppcmds
-val pr_subgoal   : int -> goal list -> std_ppcmds
-
-val pr_decl      : goal -> std_ppcmds
-val pr_decls     : evar_map -> std_ppcmds
-val pr_evc       : named_context sigma -> std_ppcmds
-
-val prgl         : goal -> std_ppcmds
-val pr_seq       : goal -> std_ppcmds
-val pr_evars     : (existential_key * goal) list -> std_ppcmds
-val pr_evars_int : int -> (existential_key * goal) list -> std_ppcmds
-val pr_subgoals_existential : evar_map -> goal list -> std_ppcmds
+val db_pr_goal : goal -> std_ppcmds
diff --git a/proofs/proof_type.ml b/proofs/proof_type.ml
index cbed5e27..009e9d5b 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,v 1.29.2.1 2004/07/16 19:30:49 herbelin Exp $ *)
+(*i $Id: proof_type.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 (*i*)
 open Environ
@@ -32,19 +32,13 @@ type prim_rule =
   | FixRule of identifier * int * (identifier * int * constr) list
   | Cofix of identifier * (identifier * constr) list
   | Refine of constr
-  | Convert_concl of types
+  | Convert_concl of types * cast_kind
   | Convert_hyp of named_declaration
   | Thin of identifier list
   | ThinBody of identifier list
   | Move of bool * identifier * identifier
   | Rename of identifier * identifier
 
-
-(* Signature useful to define the tactic type *)
-type 'a sigma = { 
-  it : 'a ; 
-  sigma : evar_map }
-
 (*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
diff --git a/proofs/proof_type.mli b/proofs/proof_type.mli
index 42606552..0e42dcba 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,v 1.33.2.1 2004/07/16 19:30:49 herbelin Exp $ i*)
+(*i $Id: proof_type.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Environ
@@ -32,7 +32,7 @@ type prim_rule =
   | FixRule of identifier * int * (identifier * int * constr) list
   | Cofix of identifier * (identifier * constr) list
   | Refine of constr
-  | Convert_concl of types
+  | Convert_concl of types * cast_kind 
   | Convert_hyp of named_declaration
   | Thin of identifier list
   | ThinBody of identifier list
@@ -67,12 +67,6 @@ type prim_rule =
 \end{verbatim}
 *)
 
-(* The type constructor ['a sigma] adds an evar map to an object of
-  type ['a] (see below the form of a [goal sigma] *)
-type 'a sigma = { 
-  it : 'a ; 
-  sigma : evar_map}
-
 (*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
diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml
new file mode 100644
index 00000000..8b3b5f5f
--- /dev/null
+++ b/proofs/redexpr.ml
@@ -0,0 +1,112 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: redexpr.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
+
+open Pp
+open Util
+open Names
+open Term
+open Declarations
+open Libnames
+open Rawterm
+open Reductionops
+open Tacred
+open Closure
+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
+
+
+let set_opaque_const sp = 
+  Conv_oracle.set_opaque_const sp;
+  Csymtable.set_opaque_const sp
+
+let set_transparent_const sp =
+  let cb = Global.lookup_constant sp in
+  if cb.const_body <> None & cb.const_opaque then
+    errorlabstrm "set_transparent_const"
+      (str "Cannot make" ++ spc () ++ 
+         Nametab.pr_global_env Idset.empty (ConstRef sp) ++
+         spc () ++ str "transparent because it was declared opaque.");
+  Conv_oracle.set_transparent_const sp;
+  Csymtable.set_transparent_const sp
+
+let set_opaque_var      = Conv_oracle.set_opaque_var
+let set_transparent_var = Conv_oracle.set_transparent_var
+
+let _ = 
+  Summary.declare_summary "Transparent constants and variables"
+    { Summary.freeze_function = Conv_oracle.freeze;
+      Summary.unfreeze_function = Conv_oracle.unfreeze;
+      Summary.init_function = Conv_oracle.init;
+      Summary.survive_module = false;
+      Summary.survive_section = false }
+
+
+(* Generic reduction: reduction functions used in reduction tactics *)
+
+type red_expr = (constr, evaluable_global_reference) red_expr_gen
+
+
+let make_flag_constant = function
+  | EvalVarRef id -> fVAR id
+  | EvalConstRef sp -> fCONST sp
+
+let make_flag f =
+  let red = no_red in
+  let red = if f.rBeta then red_add red fBETA else red in
+  let red = if f.rIota then red_add red fIOTA else red in
+  let red = if f.rZeta then red_add red fZETA else red in
+  let red =
+    if f.rDelta then (* All but rConst *)
+        let red = red_add red fDELTA in
+        let red = red_add_transparent red (Conv_oracle.freeze ()) in
+	List.fold_right
+	  (fun v red -> red_sub red (make_flag_constant v))
+	  f.rConst red
+    else (* Only rConst *)
+        let red = red_add_transparent (red_add red fDELTA) all_opaque in
+	List.fold_right
+	  (fun v red -> red_add red (make_flag_constant v))
+	  f.rConst red
+  in red
+
+let is_reference c = 
+  try let _ref = global_of_constr c in true with _ -> false
+
+let red_expr_tab = ref Stringmap.empty
+
+let declare_red_expr s f =
+  try 
+    let _ = Stringmap.find s !red_expr_tab in
+    error ("There is already a reduction expression of name "^s)
+  with Not_found ->
+    red_expr_tab := Stringmap.add s f !red_expr_tab
+
+let reduction_of_red_expr = function
+  | Red internal -> 
+      if internal then (try_red_product,DEFAULTcast) 
+      else (red_product,DEFAULTcast)
+  | Hnf -> (hnf_constr,DEFAULTcast)
+  | Simpl (Some (_,c as lp)) -> 
+      (contextually (is_reference c) lp nf,DEFAULTcast)
+  | Simpl None -> (nf,DEFAULTcast)
+  | Cbv f -> (cbv_norm_flags (make_flag f),DEFAULTcast)
+  | Lazy f -> (clos_norm_flags (make_flag f),DEFAULTcast)
+  | Unfold ubinds -> (unfoldn ubinds,DEFAULTcast)
+  | Fold cl -> (fold_commands cl,DEFAULTcast)
+  | Pattern lp -> (pattern_occs lp,DEFAULTcast)
+  | ExtraRedExpr s ->
+      (try (Stringmap.find s !red_expr_tab,DEFAULTcast)
+      with Not_found -> error("unknown user-defined reduction \""^s^"\""))
+  | CbvVm -> (cbv_vm ,VMcast)
diff --git a/proofs/redexpr.mli b/proofs/redexpr.mli
new file mode 100644
index 00000000..c442b16e
--- /dev/null
+++ b/proofs/redexpr.mli
@@ -0,0 +1,35 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: redexpr.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
+
+open Names
+open Term
+open Closure
+open Rawterm
+open Reductionops
+
+
+type red_expr = (constr, evaluable_global_reference) red_expr_gen
+
+val reduction_of_red_expr : red_expr -> reduction_function * cast_kind
+(* [true] if we should use the vm to verify the reduction *)
+
+val declare_red_expr : string -> reduction_function -> unit
+
+(* Opaque and Transparent commands. *)
+val set_opaque_const      : constant -> unit
+val set_transparent_const : constant -> unit
+
+val set_opaque_var      : identifier -> unit
+val set_transparent_var : identifier -> unit
+
+
+
+(* call by value normalisation function using the virtual machine *)
+val cbv_vm : reduction_function
diff --git a/proofs/refiner.ml b/proofs/refiner.ml
index 785e6dd4..2b878d37 100644
--- a/proofs/refiner.ml
+++ b/proofs/refiner.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: refiner.ml,v 1.67.2.3 2005/11/04 08:59:30 herbelin Exp $ *)
+(* $Id: refiner.ml 8708 2006-04-14 08:13:02Z jforest $ *)
 
 open Pp
 open Util
@@ -17,12 +17,10 @@ open Evd
 open Sign
 open Environ
 open Reductionops
-open Instantiate
 open Type_errors
 open Proof_trees
 open Proof_type
 open Logic
-open Printer
 
 type transformation_tactic = proof_tree -> (goal list * validation)
 
@@ -30,10 +28,7 @@ let hypotheses gl = gl.evar_hyps
 let conclusion gl = gl.evar_concl
 
 let sig_it x = x.it
-let sig_sig x = x.sigma
-
-
-let project_with_focus gls = rc_of_gc (gls.sigma) (gls.it)
+let project x = x.sigma
 
 let pf_status pf = pf.open_subgoals
 
@@ -43,6 +38,11 @@ let on_open_proofs f pf = if is_complete pf then pf else f pf
 
 let and_status = List.fold_left (+) 0
 
+(* Getting env *)
+
+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
+
 (* 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 *)
@@ -51,13 +51,9 @@ let norm_goal sigma gl =
   let ncl = red_fun gl.evar_concl in
   let ngl =
     { evar_concl = ncl;
-      evar_hyps =
-      Sign.fold_named_context 
-        (fun (d,b,ty) sign ->
-          add_named_decl (d, option_app red_fun b, red_fun ty) sign)
-        gl.evar_hyps ~init:empty_named_context;
+      evar_hyps = map_named_val red_fun gl.evar_hyps; 
       evar_body = gl.evar_body} in
-  if ngl = gl then None else Some ngl
+  if Evd.eq_evar_info ngl gl then None else Some ngl
 
 
 (* [mapshape [ l1 ; ... ; lk ] [ v1 ; ... ; vk ] [ p_1 ; .... ; p_(l1+...+lk) ]]
@@ -85,7 +81,7 @@ let rec frontier p =
 	([p.goal],
 	 (fun lp' -> 
 	    let p' = List.hd lp' in
-            if p'.goal = p.goal then 
+            if Evd.eq_evar_info p'.goal p.goal then 
 	      p'
             else 
 	      errorlabstrm "Refiner.frontier"
@@ -105,7 +101,7 @@ let rec frontier_map_rec f n p =
   match p.ref with
     | None -> 
         let p' = f p in
-        if p'.goal == p.goal || p'.goal = p.goal then p'
+        if Evd.eq_evar_info p'.goal p.goal then p'
         else 
 	  errorlabstrm "Refiner.frontier_map"
             (str"frontier_map was handed back a ill-formed proof.")
@@ -131,7 +127,7 @@ let rec frontier_mapi_rec f i p =
   match p.ref with
     | None -> 
         let p' = f i p in
-        if p'.goal == p.goal || p'.goal = p.goal then p'
+        if Evd.eq_evar_info p'.goal p.goal then p'
         else 
 	  errorlabstrm "Refiner.frontier_mapi"
             (str"frontier_mapi was handed back a ill-formed proof.")
@@ -189,7 +185,7 @@ let lookup_tactic s =
 (* refiner r is a tactic applying the rule r *)
 
 let check_subproof_connection gl spfl =
-  list_for_all2eq (fun g pf -> g=pf.goal) 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
@@ -255,12 +251,6 @@ let vernac_tactic (s,args) =
   let tacfun = lookup_tactic s args in
   abstract_extended_tactic s args tacfun
 
-(* [rc_of_pfsigma : proof sigma -> readable_constraints] *)
-let rc_of_pfsigma sigma = rc_of_gc sigma.sigma sigma.it.goal
-
-(* [rc_of_glsigma : proof sigma -> readable_constraints] *)
-let rc_of_glsigma sigma = rc_of_gc sigma.sigma sigma.it
-
 (* [extract_open_proof : proof_tree -> constr * (int * constr) list]
   takes a (not necessarly complete) proof and gives a pair (pfterm,obl)
   where pfterm is the constr corresponding to the proof
@@ -292,13 +282,13 @@ let extract_open_proof sigma pf =
 	let visible_rels =
           map_succeed
             (fun id ->
-               try let n = list_index id vl in (n,id)
+               try let n = proof_variable_index id vl in (n,id)
 	       with Not_found -> failwith "caught")
-            (ids_of_named_context goal.evar_hyps) in
+            (ids_of_named_context (named_context_of_val goal.evar_hyps)) in
 	let sorted_rels =
 	  Sort.list (fun (n1,_) (n2,_) -> n1 > n2 ) visible_rels in
         let sorted_env =
-          List.map (fun (n,id) -> (n,Sign.lookup_named id goal.evar_hyps))
+          List.map (fun (n,id) -> (n,lookup_named_val id goal.evar_hyps))
             sorted_rels in
 	let abs_concl =
           List.fold_right (fun (_,decl) c -> mkNamedProd_or_LetIn decl c)
@@ -308,7 +298,7 @@ let extract_open_proof sigma pf =
 	open_obligations := (meta,abs_concl):: !open_obligations;
 	applist (mkMeta meta, List.map (fun (n,_) -> mkRel n) inst) 
 	  
-    | _ -> anomaly "Bug : a case has been forgotten in proof_extractor"
+    | _ -> anomaly "Bug: a case has been forgotten in proof_extractor"
   in
   let pfterm = proof_extractor [] pf in
   (pfterm, List.rev !open_obligations)
@@ -345,17 +335,13 @@ let tclIDTAC gls = (goal_goal_list gls, idtac_valid)
 
 (* the message printing identity tactic *)
 let tclIDTAC_MESSAGE s gls = 
-  if s = "" then tclIDTAC gls
-  else 
-    begin
-      msgnl (str ("Idtac says : "^s)); tclIDTAC gls
-    end
+  msg (hov 0 s); tclIDTAC gls
 
 (* General failure tactic *)
 let tclFAIL_s s gls = errorlabstrm "Refiner.tclFAIL_s" (str s)
 
 (* A special exception for levels for the Fail tactic *)
-exception FailError of int * string
+exception FailError of int * std_ppcmds
 
 (* The Fail tactic *)
 let tclFAIL lvl s g = raise (FailError (lvl,s))
@@ -469,7 +455,7 @@ let rec tclTHENLIST = function
 
 (* various progress criterions *)
 let same_goal gl subgoal = 
-  (hypotheses subgoal) = (hypotheses gl) &
+  eq_named_context_val (hypotheses subgoal) (hypotheses gl) &&
   eq_constr (conclusion subgoal) (conclusion gl)
 
 
@@ -774,15 +760,16 @@ let extract_pftreestate pts =
       (str"Cannot extract from a proof-tree in which we have descended;" ++
          spc () ++ str"Please ascend to the root");
   let pfterm,subgoals = extract_open_pftreestate pts in
-  let exl = Evd.non_instantiated pts.tpfsigma in 
+  let exl = Evarutil.non_instantiated pts.tpfsigma in
   if subgoals <> [] or exl <> [] then
-   errorlabstrm "extract_proof"
-   (if subgoals <> [] then 
-     str "Attempt to save an incomplete proof"
-    else
-      str "Attempt to save a proof with existential variables still non-instantiated");
+    errorlabstrm "extract_proof"
+      (if subgoals <> [] then
+        str "Attempt to save an incomplete proof"
+      else
+        str "Attempt to save a proof with existential variables still non-instantiated");
   let env = Global.env_of_context pts.tpf.goal.evar_hyps in
-  strong whd_betaiotaevar env pts.tpfsigma pfterm
+  nf_betaiotaevar_preserving_vm_cast env pts.tpfsigma pfterm
+  (* strong whd_betaiotaevar env pts.tpfsigma pfterm *)
   (***
   local_strong (Evarutil.whd_ise (ts_it pts.tpfsigma)) pfterm
   ***)
@@ -894,136 +881,21 @@ let rec top_of_tree pts =
   if is_top_pftreestate pts then pts else top_of_tree(traverse 0 pts)
 
 
-(* Pretty-printers. *)
+(* Change evars *)
+let tclEVARS sigma gls = tclIDTAC {gls with sigma=sigma}
 
-open Pp
+(* Pretty-printers. *)
 
-let pr_tactic = function
-  | Tacexpr.TacArg (Tacexpr.Tacexp t) ->
-      if !Options.v7 then
-	Pptactic.pr_glob_tactic t (*top tactic from tacinterp*)
-      else
-	Pptacticnew.pr_glob_tactic (Global.env()) t
-  | t -> 
-      if !Options.v7 then
-	Pptactic.pr_tactic t
-      else
-	Pptacticnew.pr_tactic (Global.env()) t
-
-let pr_rule = function
-  | Prim r -> hov 0 (pr_prim_rule r)
-  | Tactic (texp,_) -> hov 0 (pr_tactic texp)
-  | 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"
-
-(* Does not print change of evars *)
-let pr_rule_dot = function 
-  | Change_evars -> mt ()
-  | r -> pr_rule r ++ str"."
-
-exception Different
-
-(* We remove from the var context of env what is already in osign *)
-let thin_sign osign sign =
-  Sign.fold_named_context
-    (fun (id,c,ty as d) sign ->
-       try 
-	 if Sign.lookup_named id osign = (id,c,ty) then sign
-	 else raise Different
-       with Not_found | Different -> add_named_decl d sign)
-    sign ~init:empty_named_context
-
-let rec print_proof sigma osign pf =
-  let {evar_hyps=hyps; evar_concl=cl; 
-       evar_body=body} = pf.goal in
-  let hyps' = thin_sign osign hyps in
-  match pf.ref with
-    | None -> 
-	hov 0 (pr_seq {evar_hyps=hyps'; evar_concl=cl; evar_body=body})
-    | Some(r,spfl) ->
-    	hov 0 
-	  (hov 0 (pr_seq {evar_hyps=hyps'; evar_concl=cl; evar_body=body}) ++
-	   spc () ++ str" BY " ++
-	   hov 0 (pr_rule r) ++ fnl () ++
-	   str"  " ++
-	   hov 0 (prlist_with_sep pr_fnl (print_proof sigma hyps) spfl)
-)
-	  
-let pr_change gl = 
-  (str"Change " ++ prterm_env (Global.env()) gl.evar_concl ++ str".")
-
-let rec print_script nochange sigma osign pf =
-  let {evar_hyps=sign; evar_concl=cl} = pf.goal in
-  match pf.ref with
-    | None ->
-        (if nochange then 
-	  (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)
-
-let print_treescript nochange sigma _osign pf =
-  let rec aux top pf =
-    let {evar_hyps=sign; evar_concl=cl} = pf.goal in
-    match pf.ref with
-    | None ->
-        if nochange then 
-	  (str"<Your Tactic Text here>") 
-	else 
-	  (pr_change pf.goal)
-    | 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)
-  in hov 0 (aux true pf)
-
-let rec print_info_script sigma osign pf =
-  let {evar_hyps=sign; evar_concl=cl} = pf.goal in
-  match pf.ref with
-    | None -> (mt ())
-    | Some(Change_evars,[spf]) ->
-        print_info_script sigma osign spf
-    | Some(r,spfl) ->
-        (pr_rule r ++ 
-           match spfl with
-             | [pf1] ->
-                 if pf1.ref = None then 
-		   (str "." ++ fnl ())
-                 else 
-		   (str";" ++ brk(1,3) ++
-		      print_info_script sigma sign pf1)
-             | _ -> (str"." ++ fnl () ++
-                       prlist_with_sep pr_fnl
-                         (print_info_script sigma sign) spfl))
-
-let format_print_info_script sigma osign pf = 
-  hov 0 (print_info_script sigma osign pf)
-    
-let print_subscript sigma sign pf = 
-  if is_tactic_proof pf then 
-    format_print_info_script sigma sign (subproof_of_proof pf)
-  else 
-    format_print_info_script sigma sign pf
+let pp_info = ref (fun _ _ _ -> assert false)
+let set_info_printer f = pp_info := f
 
 let tclINFO (tac : tactic) gls = 
   let (sgl,v) as res = tac gls in 
   begin try 
     let pf = v (List.map leaf (sig_it sgl)) in
-    let sign = (sig_it gls).evar_hyps in
+    let sign = named_context_of_val (sig_it gls).evar_hyps in
     msgnl (hov 0 (str" == " ++
-                  print_subscript (sig_sig gls) sign pf))
+                  !pp_info (project gls) sign pf))
   with e when catchable_exception e -> 
     msgnl (hov 0 (str "Info failed to apply validation"))
   end;
diff --git a/proofs/refiner.mli b/proofs/refiner.mli
index f6f2082e..417ddbcd 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,v 1.31.2.2 2005/01/21 16:41:51 herbelin Exp $ i*)
+(*i $Id: refiner.mli 7911 2006-01-21 11:18:36Z herbelin $ i*)
 
 (*i*)
 open Term
@@ -20,9 +20,10 @@ open Tacexpr
 (* The refiner (handles primitive rules and high-level tactics). *)
 
 val sig_it  : 'a sigma -> 'a
-val sig_sig : 'a sigma -> evar_map
+val project : 'a sigma -> evar_map
 
-val project_with_focus : goal sigma -> named_context sigma
+val pf_env  : goal sigma -> Environ.env
+val pf_hyps : goal sigma -> named_context
 
 val unpackage : 'a sigma -> evar_map ref * 'a
 val repackage : evar_map ref -> 'a -> 'a sigma
@@ -65,8 +66,10 @@ val frontier_mapi :
 
 (* [tclIDTAC] is the identity tactic without message printing*)
 val tclIDTAC          : tactic
-val tclIDTAC_MESSAGE  : string -> tactic
+val tclIDTAC_MESSAGE  : Pp.std_ppcmds -> tactic
 
+(* [tclEVARS sigma] changes the current evar map *)
+val tclEVARS : evar_map -> tactic
 
 (* [tclTHEN tac1 tac2 gls] applies the tactic [tac1] to [gls] and applies
    [tac2] to every resulting subgoals *)
@@ -120,7 +123,7 @@ val tclTHENLASTn    : tactic -> tactic array -> tactic
 val tclTHENFIRSTn   : tactic -> tactic array -> tactic
 
 (* A special exception for levels for the Fail tactic *)
-exception FailError of int * string
+exception FailError of int * Pp.std_ppcmds
 
 val tclORELSE        : tactic -> tactic -> tactic
 val tclREPEAT        : tactic -> tactic
@@ -131,7 +134,7 @@ val tclTRY           : tactic -> tactic
 val tclTHENTRY       : tactic -> tactic -> tactic
 val tclCOMPLETE      : tactic -> tactic
 val tclAT_LEAST_ONCE : tactic -> tactic
-val tclFAIL          : int -> string -> tactic
+val tclFAIL          : int -> Pp.std_ppcmds -> tactic
 val tclDO            : int -> tactic -> tactic
 val tclPROGRESS      : tactic -> tactic
 val tclWEAK_PROGRESS : tactic -> tactic
@@ -199,11 +202,5 @@ val change_constraints_pftreestate
 (*i*)
 open Pp
 (*i*)
-
-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
-val print_treescript :
-  bool -> evar_map -> named_context -> proof_tree -> std_ppcmds
+val set_info_printer :
+  (evar_map -> named_context -> proof_tree -> Pp.std_ppcmds) -> unit
diff --git a/proofs/tacexpr.ml b/proofs/tacexpr.ml
index cd8d34db..aff6b944 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,v 1.33.2.3 2005/05/15 12:47:04 herbelin Exp $ i*)
+(*i $Id: tacexpr.ml 8651 2006-03-21 21:54:43Z jforest $ i*)
 
 open Names
 open Topconstr
@@ -20,6 +20,7 @@ open Pattern
 type 'a or_metaid = AI of 'a | MetaId of loc * string
 
 type direction_flag = bool (* true = Left-to-right    false = right-to-right *)
+type lazy_flag = bool      (* true = lazy             false = eager *)
 
 type raw_red_flag =
   | FBeta
@@ -55,8 +56,7 @@ type hyp_location_flag = (* To distinguish body and type of local defs *)
   | InHypTypeOnly
   | InHypValueOnly
 
-type 'a raw_hyp_location = 
-    'a * int list * (hyp_location_flag * hyp_location_flag option ref)
+type 'a raw_hyp_location = 'a * int list * hyp_location_flag
 
 type 'a induction_arg =
   | ElimOnConstr of 'a
@@ -69,12 +69,17 @@ type inversion_kind =
   | FullInversionClear
 
 type ('c,'id) inversion_strength =
-  | NonDepInversion of inversion_kind * 'id list * intro_pattern_expr option
-  | DepInversion of inversion_kind * 'c option * intro_pattern_expr option
+  | NonDepInversion of inversion_kind * 'id list * intro_pattern_expr
+  | DepInversion of inversion_kind * 'c option * intro_pattern_expr
   | InversionUsing of 'c * 'id list
 
 type ('a,'b) location = HypLocation of 'a | ConclLocation of 'b
 
+type 'id message_token =
+  | MsgString of string
+  | MsgInt of int
+  | MsgIdent of 'id
+
 type 'id gsimple_clause = ('id raw_hyp_location) option
 (* onhyps:
      [None] means *on every hypothesis*
@@ -84,6 +89,8 @@ type 'id gclause =
     onconcl : bool;
     concl_occs :int list }
 
+let nowhere = {onhyps=Some[]; onconcl=false; concl_occs=[]}
+
 let simple_clause_of = function
     { onhyps = Some[scl]; onconcl = false } -> Some scl
   | { onhyps = Some []; onconcl = true; concl_occs=[] } -> None
@@ -112,6 +119,7 @@ type ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_atomic_tactic_expr =
   | TacIntroMove of identifier option * identifier located option
   | TacAssumption
   | TacExact of 'constr
+  | TacExactNoCheck of 'constr
   | TacApply of 'constr with_bindings
   | TacElim of 'constr with_bindings * 'constr with_bindings option
   | TacElimType of 'constr
@@ -122,20 +130,19 @@ type ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_atomic_tactic_expr =
   | TacCofix of identifier option
   | TacMutualCofix of identifier * (identifier * 'constr) list
   | TacCut of 'constr
-  | TacTrueCut of name * 'constr 
-  | TacForward of bool * name * 'constr
+  | TacAssert of 'tac option * intro_pattern_expr * 'constr
   | TacGeneralize of 'constr list
   | TacGeneralizeDep of 'constr
   | TacLetTac of name * 'constr * 'id gclause
-  | TacInstantiate of int * 'constr * 'id gclause
+(*  | TacInstantiate of int * 'constr * (('id * hyp_location_flag,unit) location) *)
 
   (* Derived basic tactics *)
-  | TacSimpleInduction of (quantified_hypothesis * (bool ref * intro_pattern_expr list ref list) list ref)
-  | TacNewInduction of 'constr induction_arg * 'constr with_bindings option
-      * (intro_pattern_expr option * (bool ref * intro_pattern_expr list ref list) list ref)
+  | TacSimpleInduction of quantified_hypothesis
+  | TacNewInduction of 'constr induction_arg list * 'constr with_bindings option
+      * intro_pattern_expr
   | TacSimpleDestruct of quantified_hypothesis
-  | TacNewDestruct of 'constr induction_arg * 'constr with_bindings option
-      * (intro_pattern_expr option * (bool ref * intro_pattern_expr list ref list) list ref)
+  | TacNewDestruct of 'constr induction_arg list * 'constr with_bindings option
+      * intro_pattern_expr
 
   | TacDoubleInduction of quantified_hypothesis * quantified_hypothesis
   | TacDecomposeAnd of 'constr
@@ -145,8 +152,8 @@ type ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_atomic_tactic_expr =
   | TacLApply of 'constr
 
   (* Automation tactics *)
-  | TacTrivial of string list option
-  | TacAuto of int or_var option * string list option
+  | TacTrivial of 'constr list * string list option
+  | TacAuto of int or_var option * 'constr list * string list option
   | TacAutoTDB of int option
   | TacDestructHyp of (bool * identifier located)
   | TacDestructConcl
@@ -154,7 +161,7 @@ type ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_atomic_tactic_expr =
   | TacDAuto of int or_var option * int option
 
   (* Context management *)
-  | TacClear of 'id list
+  | TacClear of bool * 'id list
   | TacClearBody of 'id list
   | TacMove of bool * 'id * 'id
   | TacRename of 'id * 'id
@@ -185,13 +192,14 @@ type ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_atomic_tactic_expr =
   (* For syntax extensions *)
   | TacAlias of loc * string *
       (identifier * ('constr,'tac) generic_argument) list
-      * (dir_path * 'tac)
+      * (dir_path * glob_tactic_expr)
 
 and ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr =
   | TacAtom of loc * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_atomic_tactic_expr
   | TacThen of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
   | TacThens of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr list
   | TacFirst of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr list
+  | TacComplete of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
   | TacSolve of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr list
   | TacTry of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
   | TacOrelse of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
@@ -199,14 +207,13 @@ and ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr =
   | TacRepeat of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
   | TacProgress of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
   | TacAbstract of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr * identifier option
-  | TacId of string
-  | TacFail of int or_var * string
+  | TacId of 'id message_token list
+  | TacFail of int or_var * 'id message_token list
   | TacInfo of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
-
   | TacLetRecIn of (identifier located * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_fun_ast) list * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
   | TacLetIn of (identifier located * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr option * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_arg) list * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr
-  | TacMatch of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr * ('pat,('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr) match_rule list
-  | TacMatchContext of direction_flag * ('pat,('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr) match_rule list
+  | TacMatch of lazy_flag * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr * ('pat,('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr) match_rule list
+  | TacMatchContext of lazy_flag * direction_flag * ('pat,('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_expr) match_rule list
   | TacFun of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_fun_ast
   | TacArg of ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_arg
 
@@ -224,9 +231,21 @@ and ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_arg =
   | Integer        of int
   | TacCall        of loc *
       '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
   | Tacexp of 'tac
 
+(* Globalized tactics *)
+and glob_tactic_expr =
+    (rawconstr_and_expr,
+     constr_pattern,
+     evaluable_global_reference and_short_name or_var,
+     inductive or_var,
+     ltac_constant located or_var,
+     identifier located,
+     glob_tactic_expr) gen_tactic_expr
+
 type raw_tactic_expr =
     (constr_expr,
      pattern_expr,
@@ -259,16 +278,6 @@ type raw_generic_argument =
 
 type raw_red_expr = (constr_expr, reference) red_expr_gen
 
-(* Globalized tactics *)
-type glob_tactic_expr =
-    (rawconstr_and_expr,
-     constr_pattern,
-     evaluable_global_reference and_short_name or_var,
-     inductive or_var,
-     ltac_constant located or_var,
-     identifier located,
-     glob_tactic_expr) gen_tactic_expr
-
 type glob_atomic_tactic_expr =
     (rawconstr_and_expr,
      constr_pattern,
@@ -283,8 +292,8 @@ type glob_tactic_arg =
      constr_pattern,
      evaluable_global_reference and_short_name or_var,
      inductive or_var,
-     ltac_constant located,
-     identifier located or_var,
+     ltac_constant located or_var,
+     identifier located,
      glob_tactic_expr) gen_tactic_arg
 
 type glob_generic_argument =
diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml
index 0e3a49b0..b426f75d 100644
--- a/proofs/tacmach.ml
+++ b/proofs/tacmach.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacmach.ml,v 1.61.2.1 2004/07/16 19:30:50 herbelin Exp $ *)
+(* $Id: tacmach.ml 7682 2005-12-21 15:06:11Z herbelin $ *)
 
 open Util
 open Names
@@ -14,11 +14,11 @@ open Nameops
 open Sign
 open Term
 open Termops
-open Instantiate
 open Environ
 open Reductionops
 open Evd
 open Typing
+open Redexpr
 open Tacred
 open Proof_trees
 open Proof_type
@@ -32,7 +32,7 @@ let re_sig it gc = { it = it; sigma = gc }
 (* Operations for handling terms under a local typing context *)
 (**************************************************************)
 
-type 'a sigma   = 'a Proof_type.sigma;;
+type 'a sigma   = 'a Evd.sigma;;
 type validation = Proof_type.validation;;
 type tactic     = Proof_type.tactic;;
 
@@ -40,10 +40,10 @@ let unpackage = Refiner.unpackage
 let repackage = Refiner.repackage
 let apply_sig_tac = Refiner.apply_sig_tac
 
-let sig_it     = Refiner.sig_it
-let project    = Refiner.sig_sig
-let pf_env gls = Global.env_of_context (sig_it gls).evar_hyps
-let pf_hyps gls = (sig_it gls).evar_hyps
+let sig_it   = Refiner.sig_it
+let project  = Refiner.project
+let pf_env   = Refiner.pf_env
+let pf_hyps  = Refiner.pf_hyps
 
 let pf_concl gls = (sig_it gls).evar_concl
 let pf_hyps_types gls  =
@@ -79,10 +79,6 @@ let pf_interp_constr gls c =
   let evc = project gls in 
   Constrintern.interp_constr evc (pf_env gls) c
 
-let pf_interp_openconstr gls c =
-  let evc = project gls in 
-  Constrintern.interp_openconstr evc (pf_env gls) c
-
 let pf_interp_type gls c =
   let evc = project gls in 
   Constrintern.interp_type evc (pf_env gls) c
@@ -91,12 +87,8 @@ let pf_global gls id = Constrintern.construct_reference (pf_hyps gls) id
 
 let pf_parse_const gls = compose (pf_global gls) id_of_string
 
-let pf_execute gls =
-  let evc = project gls in 
-  Typing.unsafe_machine (pf_env gls) evc
-
-let pf_reduction_of_redexp gls re c = 
-  reduction_of_redexp re (pf_env gls) (project gls) c 
+let pf_reduction_of_red_expr gls re c = 
+  (fst (reduction_of_red_expr re)) (pf_env gls) (project gls) c 
 
 let pf_apply f gls = f (pf_env gls) (project gls)
 let pf_reduce = pf_apply
@@ -119,7 +111,8 @@ let pf_reduce_to_atomic_ind     = pf_reduce reduce_to_atomic_ind
 
 let hnf_type_of gls = compose (pf_whd_betadeltaiota gls) (pf_type_of gls)
 
-let pf_check_type gls c1 c2 = ignore (pf_type_of gls (mkCast (c1, c2)))
+let pf_check_type gls c1 c2 = 
+  ignore (pf_type_of gls (mkCast (c1, DEFAULTcast, c2)))
 
 (************************************)
 (* Tactics handling a list of goals *)
@@ -194,8 +187,8 @@ let internal_cut_rev_no_check id t gl =
 let refine_no_check c gl = 
   refiner (Prim (Refine c)) gl
 
-let convert_concl_no_check c gl = 
-  refiner (Prim (Convert_concl c)) gl
+let convert_concl_no_check c sty gl = 
+  refiner (Prim (Convert_concl (c,sty))) gl
 
 let convert_hyp_no_check d gl =
   refiner (Prim (Convert_hyp d)) gl
@@ -221,9 +214,11 @@ let mutual_cofix f others gl =
   with_check (refiner (Prim (Cofix (f,others)))) gl
     
 let rename_bound_var_goal gls =
-  let { evar_hyps = sign; evar_concl = cl } as gl = sig_it gls in 
-  let ids = ids_of_named_context sign in
-  convert_concl_no_check (rename_bound_var (Global.env()) ids cl) gls
+  let { evar_hyps = sign; evar_concl = cl } = sig_it gls in 
+  let ids = ids_of_named_context (named_context_of_val sign) in
+  convert_concl_no_check 
+    (rename_bound_var (Global.env()) ids cl) DEFAULTcast gls 
+
 
 
 (* Versions with consistency checks *)
@@ -233,7 +228,7 @@ let intro_replacing id = with_check (intro_replacing_no_check id)
 let internal_cut d t     = with_check (internal_cut_no_check d t)
 let internal_cut_rev d t = with_check (internal_cut_rev_no_check d t)
 let refine c           = with_check (refine_no_check c)
-let convert_concl d    = with_check (convert_concl_no_check d)
+let convert_concl d sty = with_check (convert_concl_no_check d sty)
 let convert_hyp d      = with_check (convert_hyp_no_check d)
 let thin l             = with_check (thin_no_check l)
 let thin_body c        = with_check (thin_body_no_check c)
@@ -243,7 +238,6 @@ let rename_hyp id id'  = with_check (rename_hyp_no_check id id')
 (* Pretty-printers *)
 
 open Pp
-open Printer
 open Tacexpr
 open Rawterm
 
@@ -252,9 +246,9 @@ let rec pr_list f = function
   | a::l1 -> (f a) ++ pr_list f l1
 
 let pr_gls gls =
-  hov 0 (pr_decls (sig_sig gls) ++ fnl () ++ pr_seq (sig_it gls))
+  hov 0 (pr_evar_map (sig_sig gls) ++ fnl () ++ db_pr_goal (sig_it gls))
 
 let pr_glls glls =
-  hov 0 (pr_decls (sig_sig glls) ++ fnl () ++
-         prlist_with_sep pr_fnl pr_seq (sig_it glls))
+  hov 0 (pr_evar_map (sig_sig glls) ++ fnl () ++
+         prlist_with_sep pr_fnl db_pr_goal (sig_it glls))
   
diff --git a/proofs/tacmach.mli b/proofs/tacmach.mli
index 2990567e..9352cb5d 100644
--- a/proofs/tacmach.mli
+++ b/proofs/tacmach.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tacmach.mli,v 1.50.2.2 2005/01/21 16:41:52 herbelin Exp $ i*)
+(*i $Id: tacmach.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
 
 (*i*)
 open Names
@@ -18,14 +18,14 @@ open Reduction
 open Proof_trees
 open Proof_type
 open Refiner
-open Tacred
+open Redexpr
 open Tacexpr
 open Rawterm
 (*i*)
 
 (* Operations for handling terms under a local typing context. *)
 
-type 'a sigma   = 'a Proof_type.sigma;;
+type 'a sigma   = 'a Evd.sigma;;
 type validation = Proof_type.validation;;
 type tactic     = Proof_type.tactic;;
 
@@ -51,7 +51,6 @@ val pf_global             : goal sigma -> identifier -> constr
 val pf_parse_const        : goal sigma -> string -> constr
 val pf_type_of            : goal sigma -> constr -> types
 val pf_check_type         : goal sigma -> constr -> types -> unit
-val pf_execute            : goal sigma -> constr -> unsafe_judgment
 val hnf_type_of           : goal sigma -> constr -> types
 
 val pf_interp_constr      : goal sigma -> Topconstr.constr_expr -> constr
@@ -63,7 +62,7 @@ val pf_get_hyp_typ        : goal sigma -> identifier -> types
 val pf_get_new_id  : identifier      -> goal sigma -> identifier
 val pf_get_new_ids : identifier list -> goal sigma -> identifier list
 
-val pf_reduction_of_redexp : goal sigma -> red_expr -> constr -> constr
+val pf_reduction_of_red_expr : goal sigma -> red_expr -> constr -> constr
 
 
 val pf_apply : (env -> evar_map -> 'a) -> goal sigma -> 'a
@@ -120,9 +119,6 @@ val top_of_tree             : pftreestate -> pftreestate
 val change_constraints_pftreestate :
   evar_map -> pftreestate -> pftreestate
 
-(*i
-val vernac_tactic : string * tactic_arg list -> tactic
-i*)
 (*s The most primitive tactics. *)
 
 val refiner                   : rule -> tactic
@@ -131,7 +127,7 @@ val intro_replacing_no_check  : identifier -> tactic
 val internal_cut_no_check     : identifier -> types -> tactic
 val internal_cut_rev_no_check : identifier -> types -> tactic
 val refine_no_check           : constr -> tactic
-val convert_concl_no_check    : types -> tactic
+val convert_concl_no_check    : types -> cast_kind -> tactic
 val convert_hyp_no_check      : named_declaration -> tactic
 val thin_no_check             : identifier list -> tactic
 val thin_body_no_check        : identifier list -> tactic
@@ -149,10 +145,7 @@ val intro_replacing  : identifier -> tactic
 val internal_cut     : identifier -> types -> tactic
 val internal_cut_rev : identifier -> types -> tactic
 val refine           : constr -> tactic
-val convert_concl    : constr -> tactic
-val convert_hyp      : named_declaration -> tactic
-val thin             : identifier list -> tactic
-val convert_concl    : types -> tactic
+val convert_concl    : types -> cast_kind -> tactic
 val convert_hyp      : named_declaration -> tactic
 val thin             : identifier list -> tactic
 val thin_body        : identifier list -> tactic
@@ -173,11 +166,6 @@ val tactic_list_tactic : tactic_list -> tactic
 val tclFIRSTLIST       : tactic_list list -> tactic_list
 val tclIDTAC_list      : tactic_list
 
-(*s Pretty-printing functions. *)
-
-(*i*)
-open Pp
-(*i*)
-
-val pr_gls    : goal sigma -> std_ppcmds
-val pr_glls   : goal list sigma -> std_ppcmds
+(*s Pretty-printing functions (debug only). *)
+val pr_gls    : goal sigma -> Pp.std_ppcmds
+val pr_glls   : goal list sigma -> Pp.std_ppcmds
diff --git a/proofs/tactic_debug.ml b/proofs/tactic_debug.ml
index 1fa1101d..43807872 100644
--- a/proofs/tactic_debug.ml
+++ b/proofs/tactic_debug.ml
@@ -6,17 +6,18 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Ast
 open Names
 open Constrextern
 open Pp
-open Pptactic
-open Printer
 open Tacexpr
 open Termops
 
-let pr_glob_tactic x =
-  (if !Options.v7 then pr_glob_tactic else Pptacticnew.pr_glob_tactic (Global.env())) x
+let prtac = ref (fun _ -> assert false)
+let set_tactic_printer f = prtac := f
+let prmatchpatt = ref (fun _ _ -> assert false)
+let set_match_pattern_printer f = prmatchpatt := f
+let prmatchrl = ref (fun _ -> assert false)
+let set_match_rule_printer f = prmatchrl := f
 
 (* This module intends to be a beginning of debugger for tactic expressions.
    Currently, it is quite simple and we can hope to have, in the future, a more
@@ -32,7 +33,7 @@ let explain_logic_error = ref (fun e -> mt())
 
 (* Prints the goal *)
 let db_pr_goal g =
-  msgnl (str "Goal:" ++ fnl () ++ Proof_trees.pr_goal (Tacmach.sig_it g))
+  msgnl (str "Goal:" ++ fnl () ++ Proof_trees.db_pr_goal (Refiner.sig_it g))
 
 (* Prints the commands *)
 let help () =
@@ -46,7 +47,7 @@ let help () =
 let goal_com g tac =
   begin
     db_pr_goal g;
-    msg (str "Going to execute:" ++ fnl () ++ pr_glob_tactic tac ++ fnl ())
+    msg (str "Going to execute:" ++ fnl () ++ !prtac tac ++ fnl ())
   end
 
 (* Gives the number of a run command *)
@@ -107,15 +108,14 @@ let debug_prompt lev g tac f =
 (* Prints a constr *)
 let db_constr debug env c =
   if debug <> DebugOff & !skip = 0 then
-    msgnl (str "Evaluated term: " ++ prterm_env env c)
+    msgnl (str "Evaluated term: " ++ print_constr_env env c)
 
 (* Prints the pattern rule *)
 let db_pattern_rule debug num r =
   if debug <> DebugOff & !skip = 0 then
   begin
     msgnl (str "Pattern rule " ++ int num ++ str ":");
-    msgnl (str "|" ++ spc () ++ 
-      pr_match_rule false Printer.pr_pattern pr_glob_tactic r)
+    msgnl (str "|" ++ spc () ++ !prmatchrl r)
   end
 
 (* Prints the hypothesis pattern identifier if it exists *)
@@ -128,12 +128,12 @@ let db_matched_hyp debug env (id,c) ido =
   if debug <> DebugOff & !skip = 0 then
     msgnl (str "Hypothesis " ++
            str ((Names.string_of_id id)^(hyp_bound ido)^
-                " has been matched: ") ++ prterm_env env c)
+                " has been matched: ") ++ print_constr_env env c)
 
 (* Prints the matched conclusion *)
 let db_matched_concl debug env c =
   if debug <> DebugOff & !skip = 0 then
-    msgnl (str "Conclusion has been matched: " ++ prterm_env env c)
+    msgnl (str "Conclusion has been matched: " ++ print_constr_env env c)
 
 (* Prints a success message when the goal has been matched *)
 let db_mc_pattern_success debug =
@@ -142,18 +142,16 @@ let db_mc_pattern_success debug =
            str "Let us execute the right-hand side part..." ++ fnl())
 
 let pp_match_pattern env = function
-  | Term c -> Term (extern_pattern env (names_of_rel_context env) c)
+  | Term c -> Term (extern_constr_pattern (names_of_rel_context env) c)
   | Subterm (o,c) ->
-    Subterm (o,(extern_pattern env (names_of_rel_context env) c))
+    Subterm (o,(extern_constr_pattern (names_of_rel_context env) c))
 
 (* Prints a failure message for an hypothesis pattern *)
 let db_hyp_pattern_failure debug env (na,hyp) =
   if debug <> DebugOff & !skip = 0 then
     msgnl (str ("The pattern hypothesis"^(hyp_bound na)^
                 " cannot match: ") ++
-           pr_match_pattern
-             (Printer.pr_pattern_env env (names_of_rel_context env))
-             hyp)
+           !prmatchpatt env hyp)
 
 (* Prints a matching failure message for a rule *)
 let db_matching_failure debug =
@@ -164,10 +162,10 @@ let db_matching_failure debug =
 (* Prints an evaluation failure message for a rule *)
 let db_eval_failure debug s =
   if debug <> DebugOff & !skip = 0 then
-    let s = if s="" then "no message" else "message \""^s^"\"" in
+    let s = str "message \"" ++ s ++ str "\"" in
     msgnl 
       (str "This rule has failed due to \"Fail\" tactic (" ++
-       str s ++ str ", level 0)!" ++ fnl() ++ str "Let us try the next one...")
+       s ++ str ", level 0)!" ++ fnl() ++ str "Let us try the next one...")
 
 (* Prints a logic failure message for a rule *)
 let db_logic_failure debug err =
diff --git a/proofs/tactic_debug.mli b/proofs/tactic_debug.mli
index 9ab263c4..fc1b6120 100644
--- a/proofs/tactic_debug.mli
+++ b/proofs/tactic_debug.mli
@@ -6,10 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tactic_debug.mli,v 1.12.2.1 2004/07/16 19:30:50 herbelin Exp $ i*)
+(*i $Id: tactic_debug.mli 7911 2006-01-21 11:18:36Z herbelin $ i*)
 
 open Environ
 open Pattern
+open Evd
 open Proof_type
 open Names
 open Tacexpr
@@ -19,6 +20,13 @@ open Term
    Currently, it is quite simple and we can hope to have, in the future, a more
    complete panel of commands dedicated to a proof assistant framework *)
 
+val set_tactic_printer : (glob_tactic_expr ->Pp.std_ppcmds) -> unit
+val set_match_pattern_printer :
+  (env -> constr_pattern match_pattern -> Pp.std_ppcmds) -> unit
+val set_match_rule_printer :
+  ((constr_pattern,glob_tactic_expr) match_rule -> Pp.std_ppcmds) ->
+    unit
+
 (* Debug information *)
 type debug_info =
   | DebugOn of int
@@ -53,7 +61,7 @@ val db_hyp_pattern_failure :
 val db_matching_failure : debug_info -> unit
 
 (* Prints an evaluation failure message for a rule *)
-val db_eval_failure : debug_info -> string -> unit
+val db_eval_failure : debug_info -> Pp.std_ppcmds -> unit
 
 (* An exception handler *)
 val explain_logic_error: (exn -> Pp.std_ppcmds) ref
diff --git a/scripts/coqc.ml b/scripts/coqc.ml
index 34025ec9..676e9e51 100644
--- a/scripts/coqc.ml
+++ b/scripts/coqc.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqc.ml,v 1.25.2.3 2004/09/04 10:34:56 herbelin Exp $ *)
+(* $Id: coqc.ml 7747 2005-12-28 10:28:41Z herbelin $ *)
 
 (* Afin de rendre Coq plus portable, ce programme Caml remplace le script
    coqc. 
@@ -148,10 +148,15 @@ let parse_args () =
 	    | []        -> usage ()
 	end
     | "-R" as o :: s :: t :: rem -> parse (cfiles,t::s::o::args) rem
-    | ("-notactics"|"-debug"|"-nolib"|"-batch"|"-nois"
+
+    | ("-notactics"|"-debug"|"-nolib"
+      | "-debugVM"|"-alltransp"|"-VMno"
+      |"-batch"|"-nois"
       |"-q"|"-full"|"-profile"|"-just-parsing"|"-echo" |"-unsafe"|"-quiet"
-      |"-silent"|"-m"|"-xml"|"-v7"|"-v8"|"-translate"|"-strict-implicit"
-      |"-dont-load-proofs"|"-impredicative-set" as o) :: rem ->
+      |"-silent"|"-m"|"-xml"|"-v7"|"-v8"|"-translate" |"-strict-implicit"
+      |"-dont-load-proofs"|"-impredicative-set"|"-vm" 
+      | "-unboxed-values" | "-unboxed-definitions" | "-draw-vm-instr" 
+	  as o) :: rem ->
 	parse (cfiles,o::args) rem
     | ("-v"|"--version") :: _ ->
         Usage.version ()
diff --git a/scripts/coqmktop.ml b/scripts/coqmktop.ml
index ccb06769..dec302e7 100644
--- a/scripts/coqmktop.ml
+++ b/scripts/coqmktop.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqmktop.ml,v 1.28.2.2 2005/11/04 08:20:57 herbelin Exp $ *)
+(* $Id: coqmktop.ml 7538 2005-11-08 17:14:52Z herbelin $ *)
 
 (* coqmktop is a script to link Coq, analogous to ocamlmktop.
    The command line contains options specific to coqmktop, options for the
@@ -19,49 +19,26 @@ open Unix
 (* 1. Core objects *)
 let ocamlobjs = ["unix.cma"]
 let dynobjs = ["dynlink.cma"]
-let camlp4objs = [(*"odyl.cma"; "camlp4.cma";*) "gramlib.cma"]
-let configobjs = ["coq_config.cmo"]
-let libobjs = ocamlobjs @ camlp4objs @ configobjs
+let camlp4objs = ["gramlib.cma"]
+let libobjs = ocamlobjs @ camlp4objs
 
 let spaces = Str.regexp "[ \t\n]+"
-let split_cmo l = Str.split spaces l
+let split_list l = Str.split spaces l
 
-let lib = split_cmo Tolink.lib 
-let kernel = split_cmo Tolink.kernel
-let library = split_cmo Tolink.library 
-let pretyping = split_cmo Tolink.pretyping 
-let interp = split_cmo Tolink.interp
-let parsing = split_cmo Tolink.parsing 
-let proofs = split_cmo Tolink.proofs 
-let tactics = split_cmo Tolink.tactics 
-let toplevel = split_cmo Tolink.toplevel 
-let highparsing = split_cmo Tolink.highparsing 
-let highparsingnew = split_cmo Tolink.highparsingnew
-let ide = split_cmo Tolink.ide 
+let copts     = split_list Tolink.copts
+let core_objs = split_list Tolink.core_objs
+let core_libs = split_list Tolink.core_libs
+let ide       = split_list Tolink.ide 
 
-let core_objs = 
-  libobjs @ lib @ kernel @ library @ pretyping @ interp @ parsing @ 
-  proofs @ tactics
-
-let core_libs = 
-  libobjs @ [ "lib/lib.cma" ; "kernel/kernel.cma" ; "library/library.cma" ;
-  "pretyping/pretyping.cma" ; "interp/interp.cma" ; "parsing/parsing.cma" ;
-  "proofs/proofs.cma" ; "tactics/tactics.cma" ]
-
-(* 3. Files only in coqsearchisos (if option -searchisos is used) *)
-let coqsearch = ["version_searchisos.cmo"; "cmd_searchisos_line.cmo"]
-
-(* 4. Toplevel objects *)
-let camlp4objs =
-  ["camlp4_top.cma"; "pa_o.cmo"; "pa_op.cmo"; "pa_extend.cmo"; "q_util.cmo"; "q_coqast.cmo" ]
-let topobjs = camlp4objs
+(* 3. Toplevel objects *)
+let camlp4topobjs =
+  ["camlp4_top.cma"; "pa_o.cmo"; "pa_op.cmo"; "pa_extend.cmo"]
+let topobjs = camlp4topobjs
 
 let gramobjs = []
 let notopobjs = gramobjs
 
-(* 5. High-level tactics objects *)
-let hightactics = 
- (split_cmo Tolink.hightactics) @ (split_cmo Tolink.contrib) 
+(* 4. High-level tactics objects *)
 
 (* environment *)
 let src_coqtop = ref Coq_config.coqtop
@@ -73,7 +50,7 @@ let coqide     = ref false
 let echo       = ref false
 
 let src_dirs () = 
-  [ []; [ "config" ]; [ "toplevel" ] ] @
+  [ []; ["kernel";"byterun"]; [ "config" ]; [ "toplevel" ] ] @
   if !coqide then [[ "ide" ]] else []
 
 let includes () = 
@@ -89,8 +66,10 @@ let native_suffix f =
     (Filename.chop_suffix f ".cmo") ^ ".cmx"
   else if Filename.check_suffix f ".cma" then 
     (Filename.chop_suffix f ".cma") ^ ".cmxa"
-  else 
-    failwith ("File "^f^" has not extension .cmo or .cma")
+  else  
+    if Filename.check_suffix f ".a" then f 
+    else
+      failwith ("File "^f^" has not extension .cmo, .cma or .a")
 
 (* Transforms a file name in the corresponding Caml module name. *)
 let rem_ext_regexpr = Str.regexp "\\(.*\\)\\.\\(cm..?\\|ml\\)"
@@ -102,7 +81,6 @@ let module_of_file name =
 (* Build the list of files to link and the list of modules names *)
 let files_to_link userfiles =
   let dyn_objs = if not !opt then dynobjs else [] in
-  let command_objs = if !searchisos then coqsearch else [] in
   let toplevel_objs =
     if !top then topobjs else if !opt then notopobjs else [] in
   let ide_objs = if !coqide then 
@@ -114,17 +92,8 @@ let files_to_link userfiles =
      "ide/ide.cma" ]
   else [] 
   in
-  let objs = 
-    core_objs @ dyn_objs @ toplevel @ highparsing @ highparsingnew @ 
-    command_objs @ hightactics @ toplevel_objs @ ide_objs
-  and libs =
-    core_libs @ dyn_objs @ 
-    [ "toplevel/toplevel.cma" ; "parsing/highparsing.cma" ;
-      "parsing/highparsingnew.cma" ] @ 
-    command_objs @ [ "tactics/hightactics.cma" ; "contrib/contrib.cma" ] @
-    toplevel_objs @ 
-    ide_libs      
-  in
+  let objs = dyn_objs @ libobjs @ core_objs @ toplevel_objs @ ide_objs
+  and libs = dyn_objs @ libobjs @ core_libs @ toplevel_objs @ ide_libs in
   let objstolink,libstolink =
     if !opt then 
       ((List.map native_suffix objs) @ userfiles,
@@ -183,8 +152,6 @@ let parse_args () =
     | "-opt" :: rem -> opt := true ; parse (op,fl) rem
     | "-full" :: rem -> full := true ; parse (op,fl) rem
     | "-top" :: rem -> top := true ; parse (op,fl) rem
-    | "-searchisos" :: rem ->
-        searchisos := true; parse (op,fl) rem
     | "-ide" :: rem ->
         coqide := true; parse (op,fl) rem
     | "-v8" :: rem -> parse (op,fl) rem
@@ -199,7 +166,8 @@ let parse_args () =
         parse ((List.rev(List.flatten (List.map (fun d -> ["-I";d])
 					 (all_subdirs a))))@op,fl) rem
     | "-R" :: [] -> usage ()
-    | ("-compact"|"-g"|"-p"|"-thread" as o) :: rem -> parse (o::op,fl) rem
+    | ("-noassert"|"-compact"|"-g"|"-p"|"-thread" as o) :: rem ->
+        parse (o::op,fl) rem
     | ("-h"|"--help") :: _ -> usage ()
     | f :: rem ->
 	if Filename.check_suffix f ".ml" 
@@ -230,7 +198,6 @@ let clean file =
 let all_modules_in_dir dir =
   try
     let lst = ref []
-    and stg = ref ""
     and dh = Unix.opendir dir in
     try
       while true do
@@ -331,11 +298,12 @@ let main () =
   (* the list of the loaded modules *)
   let main_file = create_tmp_main_file modules in
   try
-    let args = options @ (includes ()) @ tolink @ dynlink @ [ main_file ] in
+    let args =
+      options @ (includes ()) @ copts @ tolink @ dynlink @ [ main_file ] in
     (* add topstart.cmo explicitly because we shunted ocamlmktop wrapper *)
     let args = if !top then args @ [ "topstart.cmo" ] else args in
     (* Now, with the .cma, we MUST use the -linkall option *)
-    let command = String.concat " " ((prog^" -linkall")::args) in
+    let command = String.concat " " (prog::args) in
     if !echo then 
       begin 
 	print_endline command; 
diff --git a/syntax/PPCases.v b/syntax/PPCases.v
deleted file mode 100644
index d0f75dcf..00000000
--- a/syntax/PPCases.v
+++ /dev/null
@@ -1,96 +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        *)
-(************************************************************************)
-
-(* $Id: PPCases.v,v 1.11.6.1 2004/07/16 19:30:51 herbelin Exp $ *)
-
-Syntax constr
-  level 8:
-    tomatch_cons [ << (TOMATCH $c1 ($LIST $cl)) >> ]
-      -> [ $c1:L [1 0] (TOMATCH ($LIST $cl)) ]
-  | tomatch_one [ << (TOMATCH $c1) >> ] -> [$c1:L]
-  ;
-
-  level 10:
-    as_patt [ << (PATTAS $var $patt) >> ] -> [$patt:L" as "$var]
-  ;
-
-  level 0:
-    ne_pattlist_nil  [ << (PATTLIST) >> ] -> [ ]
-  | ne_pattlist_cons [ << (PATTLIST $patt ($LIST $lpatt)) >> ]
-      -> [$patt:E " " (PATTLIST ($LIST $lpatt))]
-  ;
-
-  level 8:
-    equation [ << (EQN $rhs ($LIST $lhs)) >> ]
-      -> [ [<hov 0> (PATTLIST ($LIST $lhs)) "=> " [0 1] $rhs:E] ]
-  ;
- 
-  level 0:
-    bar_eqnlist_nil [ << (BAREQNLIST) >> ] -> [ ]
-  | bar_eqnlist_cons [ << (BAREQNLIST $eqn ($LIST $leqn)) >> ]
-      -> [ "| " $eqn [1 0] (BAREQNLIST ($LIST $leqn)) ]
-  | bar_eqnlist_one [ << (BAREQNLIST $eqn) >> ]
-      -> [ "| " $eqn ]
-  ;
-
-  level 10:
-    pattconstruct [ << (PATTCONSTRUCT $C $D ($LIST $T)) >> ] ->
-	 [(APPLIST $C $D ($LIST $T))]
-  ;
-
-  level 0:
-    pattconstructatomic [ << (PATTCONSTRUCT $C) >> ] -> [ $C:E ]
-  ;
-
-  level 8:
-
-    cases_exp_none [ << (CASES $pred $tomatch) >> ]
-      -> [ [<hov 0> (ELIMPRED $pred)
-              [<hv 0> "Cases"[1 2] $tomatch:E [1 0] "of"] [1 0] "end"] ]
-
-  | cases_exp_one [ << (CASES $pred $tomatch $eqn) >> ]
-      -> [ [<hov 0> (ELIMPRED $pred)
-              [<hv 0> [<hv 0> "Cases"[1 2] $tomatch:E [1 0] "of"] [1 2]
-                     $eqn [1 0]
-                     "end"] ] ]
-
-  | cases_exp_many [ << (CASES $pred $tomatch $eqn1 $eqn2 ($LIST $eqns)) >> ]
-      -> [ [<hov 0> (ELIMPRED $pred)
-              [<v 0> [<hv 0> "Cases"[1 2] $tomatch:E [1 0] "of"] [1 2]
-                     $eqn1 [1 0]
-                     (BAREQNLIST $eqn2 ($LIST $eqns)) [1 0]
-                     "end"] ] ]
-
-  (* "level" indifférent pour ce qui suit *)
-  | let_binder_var [ << (LETBINDER ($VAR $id)) >> ] -> [ $id ]
-  | let_binder_app 
-	[<<(LETBINDER (PATTCONSTRUCT $toforget ($VAR $id) ($LIST $vars)))>>]
-      -> [ "(" $id (LETBINDERTAIL ($LIST $vars)) ")" ]
- 
-  | let_binder_tail_nil  [ << (LETBINDERTAIL) >> ] -> [ ]
-  | let_binder_tail_cons [ << (LETBINDERTAIL $var ($LIST $vars)) >> ]
-      -> [ "," [1 0] $var (LETBINDERTAIL ($LIST $vars)) ]
-
-  ;
-
-  (* On force les parenthèses autour d'un "if" sous-terme (même si le
-     parsing est lui plus tolérant) *)
-  level 10:
-    boolean_cases [ << (FORCEIF $pred $tomatch $c1 $c2) >> ]
-      -> [ [<hov 0> (ELIMPRED $pred)
-              [<hv 0> "if " [<hov 0> $tomatch:L ]
-                      [1 0] [<hov 0> "then" [1 1] $c1:L ]
-                      [1 0] [<hov 0> "else" [1 1] $c2:L ] ] ] ]
-
-  | let_cases [ << (FORCELET $pred $tomatch (EQN $c $pat)) >> ]
-      -> [ [<hov 0> (ELIMPRED $pred)
-              [<hv 0> "let " [<hov 0> (LETBINDER $pat) ] " ="
-                      [1 1] [<hov 0> $tomatch:L ] ]
-              [1 0] "in " [<hov 0> $c:L ] ] ]
-.
-
diff --git a/syntax/PPConstr.v b/syntax/PPConstr.v
deleted file mode 100755
index a4374c86..00000000
--- a/syntax/PPConstr.v
+++ /dev/null
@@ -1,264 +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        *)
-(************************************************************************)
-
-(* $Id: PPConstr.v,v 1.25.2.1 2004/07/16 19:30:51 herbelin Exp $ *)
-
-(* Syntax for the Calculus of Constructions. *)
-
-Syntax constr
-  level 0:
-    ne_command_listcons [ << (NECOMMANDLIST $c1 ($LIST $cl)) >> ]
-       -> [ $c1 [1 0] (NECOMMANDLIST ($LIST $cl)) ]
-  | ne_command_listone [ << (NECOMMANDLIST $c1) >> ] -> [ $c1 ]
-  ;
-
-(* Things parsed in binder *)
-(* ======================= *)
-
-  level 0:
-    idbindercons [ << (IDBINDER ($VAR $id) ($LIST $L)) >> ] ->
-       [ $id ","[0 0] (IDBINDER ($LIST $L))]
-  | idbinderone  [ << (IDBINDER ($VAR $id)) >> ] -> [$id]
-  | idbindernil  [ << (IDBINDER) >> ] -> [ ]
-
-  | binderscons [ << (BINDERS (BINDER $c ($LIST $id)) ($LIST $b)) >> ] ->
-       [ [<hv 0> [<hov 0> (IDBINDER ($LIST $id))] ":"
-                 [0 1] $c:E] ";"[1 0]
-         (BINDERS ($LIST $b))  ]
-  | bindersone  [ << (BINDERS (BINDER $c ($LIST $id))) >> ] -> 
-       [ [<hov 0> (IDBINDER ($LIST $id))] ":" $c:E ]
-
-  | letbindercons [ << (BINDERS (LETBINDER $c $id) ($LIST $b)) >> ] ->
-       [ [<hov 0> id ":=" [0 1] $c:E ";" [1 0] (BINDERS ($LIST $b)) ] ]
-  | letbinderone  [ << (BINDERS (LETBINDER $c $id)) >> ] -> 
-       [ [<hov 0> id ":=" [0 1] $c:E ] ]
-  ;
-
-
-(* Things parsed in command0 *)
-  level 0:
-    prop [ Prop ] -> ["Prop"]
-  | set  [ Set ]  -> ["Set"]
-  | type [ Type ] -> ["Type"]
-  | type_sp [ << (TYPE $id) >> ] -> ["Type" $id]
-(* Note: Atomic constants (Nvar, CONST, MUTIND, MUTCONSTRUCT) are printed in
-   Printer to know if they must be qualified or not (and previously to
-   deal with the duality CCI/FW) *)
-
-  | evar [ ? ] -> ["?"]
-  | meta [ << (META $n) >> ] -> [ $n ]
-  | implicit [ << (IMPLICIT) >> ] -> ["<Implicit>"]
-  | indice [ << (REL ($NUM $n)) >> ] -> ["<Unbound ref: " $n ">"]
-  | instantiation [ << (INSTANCE $a ($LIST $l)) >> ] ->
-	 [ $a "{" (CONTEXT ($LIST $l)) "}"]
-  | instantiation_nil [ << (CONTEXT) >> ] -> [ ]
-  | instantiation_one [ << (CONTEXT $a) >> ] -> [ $a ]
-  | instantiation_many [ << (CONTEXT $a $b ($LIST $l)) >> ] ->
-	 [ (CONTEXT $b ($LIST $l)) ";" $a ]
-  | qualid [ << (QUALID $id ($LIST $l)) >> ] -> [ $id (FIELDS ($LIST $l)) ]
-  | fieldsnil [ << (FIELDS) >> ] -> [ ]
-  | fieldscons [ << (FIELDS $id ($LIST $l)) >> ] ->
-	 [ "." $id (FIELDS ($LIST $l)) ]
-  ;
-
-(* Things parsed in command1 *)
-  level 1:
-    soap [ << (SOAPP $lc1 ($LIST $cl)) >> ]
-      -> [ [<hov 0> "(" $lc1 ")@[" (NECOMMANDLIST ($LIST $cl)) "]"] ]
-
-  (* For debug *)
-  | abstpatnamed [ << [$id1]$c >> ] -> [ [<hov 0> "<<" $id1 ">>" [0 1] $c:E ] ]
-  | abstpatanon  [ << [ <> ]$c >> ] -> [ [<hov 0> "<<_>>" [0 1] $c:E ] ]
-  ;
-
-(* Things parsed in command2 *)
-
-(* Things parsed in command3 *)
-
-(* Things parsed in command4 *)
-
-(* Things parsed in command5 *)
-
-(* Things parsed in command6 *)
-
-(* Things parsed in command7 *)
-
-(* Things parsed in command8 *)
-  level 8:
-    lambda [ << (LAMBDA $Dom [$x]$Body) >> ]
-     -> [(LAMBOX (BINDERS (BINDER $Dom $x)) $Body)]
-  | lambda_anon [ << (LAMBDA $Dom [<>]$Body) >> ]
-     -> [(LAMBOX (BINDERS (BINDER $Dom _)) $Body)]
-  | lambdalist  [ << (LAMBDALIST $c [$x]$body) >> ]
-     -> [(LAMLBOX (BINDERS) $c (IDS $x) $body)]
-  | lambdalist_anon  [ << (LAMBDALIST $c [<>]$body) >> ]
-     -> [(LAMLBOX (BINDERS) $c (IDS _) $body)]
-
-  | formated_lambda [ << (LAMBOX $pbi $t) >> ]
-     -> [ [<hov 0> "[" [<hv 0> $pbi] "]" [0 1] $t:E ] ]
-
-  | lambda_cons [<<(LAMBOX (BINDERS ($LIST $acc)) (LAMBDA $Dom [$x]$body))>>]
-      -> [(LAMBOX (BINDERS ($LIST $acc) (BINDER $Dom $x)) $body) ]
-  | lambda_cons_anon
-      [ << (LAMBOX (BINDERS ($LIST $acc)) (LAMBDA $Dom [<>]$body)) >> ]
-      -> [(LAMBOX (BINDERS ($LIST $acc) (BINDER $Dom _)) $body)]
-  | lambdal_start [ << (LAMBOX $pbi (LAMBDALIST $Dom $Body)) >> ]
-      -> [(LAMLBOX $pbi $Dom (IDS) $Body)]
-
-  | lambdal_end [<<(LAMLBOX (BINDERS ($LIST $acc)) $c (IDS ($LIST $ids)) $t)>>]
-      -> [(LAMBOX (BINDERS ($LIST $acc) (BINDER $c ($LIST $ids))) $t)]
-  | lambdal_cons_anon [ << (LAMLBOX $pbi $c (IDS ($LIST $ids)) [<>]$body) >> ]
-      -> [(LAMLBOX $pbi $c (IDS ($LIST $ids) _) $body)]
-  | lambdal_cons [ << (LAMLBOX $pbi $c (IDS ($LIST $ids)) [$id]$body) >> ]
-      -> [(LAMLBOX $pbi $c (IDS ($LIST $ids) $id) $body)]
-
-  | pi [ << (PROD $A [$x]$B) >> ] -> [ (PRODBOX (BINDERS) (PROD $A [$x]$B)) ]
-  | prodlist  [ << (PRODLIST $c $b) >> ]
-       -> [(PRODBOX (BINDERS) (PRODLIST $c $b))]
-
-  | formated_prod [ << (PRODBOX $pbi $t) >> ]
-     -> [ [<hov 0> "(" [<hov 0> $pbi] ")" [0 1] $t:E ] ]
-
-  | prod_cons
-      [ << (PRODBOX (BINDERS ($LIST $acc)) (PROD $Dom [$x]$body)) >> ]
-      -> [(PRODBOX (BINDERS ($LIST $acc) (BINDER $Dom $x)) $body)]
-  | prodl_start_cons [ << (PRODBOX $pbi (PRODLIST $Dom $Body)) >> ]
-      -> [(PRODLBOX $pbi $Dom (IDS) $Body)]
-
-  | prodl_end [<<(PRODLBOX (BINDERS ($LIST $acc)) $c (IDS ($LIST $ids)) $t)>>]
-      -> [(PRODBOX (BINDERS ($LIST $acc) (BINDER $c ($LIST $ids))) $t)]
-  | prodl_cons_anon [ << (PRODLBOX $pbi $c (IDS ($LIST $ids)) [<>]$body) >> ]
-      -> [(PRODLBOX $pbi $c (IDS ($LIST $ids) _) $body)]
-  | prodl_cons [ << (PRODLBOX $pbi $c (IDS ($LIST $ids)) [$id]$body) >> ]
-      -> [(PRODLBOX $pbi $c (IDS ($LIST $ids) $id) $body)]
-
-
-  | arrow [ << (ARROW $A [<>]$B) >> ] ->
-       [ [<hv 0> $A:L " ->" [0 0] (ARROWBOX $B) ] ]
-  | arrow_stop [ << (ARROWBOX $c) >> ] -> [ $c:E ]
-  | arrow_again [ << (ARROWBOX (PROD $A [<>]$B)) >> ] ->
-	 [ $A:L " ->" [0 0] (ARROWBOX $B) ]
-
-(* These are synonymous *)
-(* redundant
-  | let [ [$x = $M]$N ] -> [ [<hov 0> "[" $x "=" $M:E "]" [0 1] $N:E ] ]
-*)
-  | letin [ << (LETIN $A [$x]$B) >> ] -> [ [ <hov 0> "[" $x ":=" [0 1] $A:E "]" [0 1] $B:E ] ]
-  | letincast [ << (LETIN (CAST $A $C) [$x]$B) >> ] -> [ [ <hov 0> "[" $x ":=" [0 1] $A:E ":" $C:E "]" [0 1] $B:E ] ]
-  ;
-
-(* Things parsed in command9 *)
-  level 9:
-    cast [ << (CAST $C $T) >> ] -> [ [<hv 0> $C:L [0 0] "::" $T:E] ]
-  ;
-
-(* Things parsed in command10 *)
-  level 10:
-    app_cons [ << (APPLIST $H ($LIST $T)) >> ]
-                 -> [ [<hov 0>  $H:E  (APPTAIL ($LIST $T)):E ] ]
-
-  | app_imp  [ << (APPLISTEXPL $H ($LIST $T)) >> ]
-                 -> [ [<hov 0>  "!" $H:E (APPTAIL ($LIST $T)):E ] ]
-
-(*
-  | app_imp  [ << (APPLISTEXPL $H ($LIST $T)) >> ]
-                 -> [ (APPLISTIMPL (ACC $H) ($LIST $T)):E ]
-
-  | app_imp_arg  [ << (APPLISTIMPL (ACC ($LIST $AC)) $a ($LIST $T)) >> ]
-        -> [ (APPLISTIMPL (ACC ($LIST $AC) $a) ($LIST $T)):E ]
-
-  | app_imp_imp_arg  [ << (APPLISTIMPL $AC (EXPL $_ $_) ($LIST $T)) >> ]
-       -> [ (APPLISTIMPL $AC ($LIST $T)):E ]
-
-  | app_imp_last [ << (APPLISTIMPL (ACC ($LIST $A)) $T) >> ]
-         -> [ (APPLIST ($LIST $A) $T):E ]
-*)
-
-  | apptailcons [ << (APPTAIL $H ($LIST $T)) >> ]
-	 -> [ [1 1] $H:L  (APPTAIL ($LIST $T)):E ]
-  | apptailnil [ << (APPTAIL) >> ] -> [ ]
-
-(* Implicits *)
-  | apptailcons1  [ << (APPTAIL (EXPL $n $c1) ($LIST $T)) >> ]
-         -> [ [1 1] $n "!" $c1:E  (APPTAIL ($LIST $T)):E ]
-  ;
-(*
-  level 8:
-    arg_implicit [ << (EXPL ($NUM $n) $c1) >> ] -> [ $n "!" $c1:L ]
-(*  | arg_implicit1 [(EXPL "EX" ($NUM $n) $c1)] -> [ $n "!" $c1:L ]
-  | fun_explicit [ << (EXPL $f) >> ] -> [ $f ]*)
-  ;
-*)
-
-  level 8:
-  recterm [ << (MATCH $P $c ($LIST $BL)) >> ] ->
-     [ [<hov 0> [<hov 0> (ELIMPRED $P)
-    		 [0 2] [<hov 0> "Match" [1 1] $c:E  [1 0] "with" ]]
-	         [1 3] [<hov 0> (MATCHBRANCHES ($LIST $BL)):E ] "end"] ]
-
-  | matchbranchescons [ << (MATCHBRANCHES $B ($LIST $T)) >> ]
-       -> [ [<hov 0> [<hov 0> $B:E ] FNL] (MATCHBRANCHES ($LIST $T)):E ]
-  | matchbranchesnil [ << (MATCHBRANCHES) >> ] -> [ ]
-
-  | caseterm [ << (CASE $P $c ($LIST $BL)) >> ] ->
-     [ [<hov 0> [<hov 0> (ELIMPRED $P)
-                  [0 2][<hov 0> "Case" [1 1] $c:E  [1 0] "of" ]]
-                  [1 3][<hov 0> (MATCHBRANCHES ($LIST $BL)):E ] "end"] ]
-
-  | ifterm [ << (IF $P $c $b1 $b2) >> ] ->
-     [ (FORCEIF $P $c (EQN $b1 JUNK) (EQN $b2 JUNK)):E ]
-
-  | letterm [ << (LET $P $c (LAMBDALIST $_ $b)) >> ] ->
-     [ (LETSLAM $P $c $b) ]
-  | letslamend [ << (LETSLAM $P $c $b ($LIST $IDL))>> ] ->
-     [ (FORCELET $P $c (EQN $b (PATTCONSTRUCT JUNK ($LIST $IDL)))):E ]
-  | letslam [ << (LETSLAM $P $c [$ID]$b ($LIST $IDL))>> ] ->
-     [ (LETSLAM $P $c $b ($LIST $IDL) $ID) ]
-  | letslamanon [ << (LETSLAM $P $c [<>]$b ($LIST $IDL))>> ] ->
-     [ (LETSLAM $P $c $b ($LIST $IDL) _) ]
-
-  | elim_pred      [ << (ELIMPRED $pred) >> ]          -> [ "<" $pred:E ">" [0 2] ]
-  | elim_pred_xtra [ << (ELIMPRED "SYNTH") >> ] -> [ ]
-  ;
-
-  level 0:
-    fix [ << (FIX $f $def ($LIST $lfs)) >> ] ->
-      [ [<hov 0> "Fix " $f
-           [0 2] "{" [<v 0> [<hov 0> $def]
-                            (FIXDECLS ($LIST $lfs)) ] "}"] ]
-
-  | cofix [ << (COFIX $f $def ($LIST $lfs)) >> ] ->
-      [ [<hov 0> "CoFix " $f
-           [0 2] "{" [<v 0> [<hov 0> $def]
-                            (FIXDECLS ($LIST $lfs)) ] "}"] ]
-
-  | nofixdefs [ << (FIXDECLS) >> ] -> [ ]
-  | fixdefs [ << (FIXDECLS $def1 ($LIST $defs)) >> ] ->
-      [ FNL [<hov 0> "with " $def1] (FIXDECLS ($LIST $defs)) ]
-  ;
-
-  level 8:
-    onefixnumdecl [ << (NUMFDECL $f ($NUM $x) $A $t) >> ] ->
-      [ $f "/" $x " :"
-        [1 2] $A:E " :="
-        [1 2] $t:E ]
-  | onefixdecl [ << (FDECL $f (BINDERS ($LIST $l)) $A $t) >> ] ->
-      [ $f
-        [1 2] "[" [<hv 0> (BINDERS ($LIST $l))] "]"
-        [1 2] ": " $A:E " :="
-        [1 2] $t:E ]
-  | onecofixdecl [ << (CFDECL $f $A $t) >> ] ->
-      [ $f " : "
-        [1 2] $A:E " :="
-        [1 2] $t:E ]
-  ;
-
-  level 8:
-    evalconstr [ << (EVAL $c $r) >> ] ->
-	 [ [<hv 0> "Eval" [1 1] $r [1 0] "in" [1 1] $c:E ] ].
-
diff --git a/tactics/auto.ml b/tactics/auto.ml
index d7130f35..d5e5e556 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: auto.ml,v 1.63.2.3 2005/05/15 12:47:04 herbelin Exp $ *)
+(* $Id: auto.ml 7937 2006-01-28 19:58:11Z herbelin $ *)
 
 open Pp
 open Util
@@ -15,6 +15,7 @@ open Nameops
 open Term
 open Termops
 open Sign
+open Environ
 open Inductive
 open Evd
 open Reduction
@@ -38,21 +39,21 @@ open Library
 open Printer
 open Declarations
 open Tacexpr
+open Mod_subst
 
 (****************************************************************************)
 (*            The Type of Constructions Autotactic Hints                    *)
 (****************************************************************************)
 
 type auto_tactic = 
-  | Res_pf     of constr * unit clausenv (* Hint Apply *)
-  | ERes_pf    of constr * unit clausenv (* Hint EApply *)
+  | Res_pf     of constr * clausenv (* Hint Apply *)
+  | ERes_pf    of constr * clausenv (* Hint EApply *)
   | Give_exact of constr                  
-  | Res_pf_THEN_trivial_fail of constr * unit clausenv (* Hint Immediate *)
-  | Unfold_nth of global_reference       (* Hint Unfold *)
+  | Res_pf_THEN_trivial_fail of constr * clausenv (* Hint Immediate *)
+  | Unfold_nth of evaluable_global_reference       (* Hint Unfold *)
   | Extern     of glob_tactic_expr       (* Hint Extern *) 
 
 type pri_auto_tactic = { 
-  hname : identifier;    (* name of the hint *)
   pri  : int;            (* A number between 0 and 4, 4 = lower priority *)
   pat  : constr_pattern option; (* A pattern for the concl of the Goal *)
   code : auto_tactic     (* the tactic to apply when the concl matches pat *)
@@ -103,7 +104,7 @@ let lookup_tacs (hdc,c) (l,l',dn) =
 
 
 module Constr_map = Map.Make(struct 
-			       type t = constr_label
+			       type t = global_reference
 			       let compare = Pervasives.compare 
 			     end)
 
@@ -134,24 +135,28 @@ module Hint_db = struct
 
 end
 
-type frozen_hint_db_table = Hint_db.t Stringmap.t 
+module Hintdbmap = Gmap
 
-type hint_db_table = Hint_db.t Stringmap.t ref
+type frozen_hint_db_table = (string,Hint_db.t) Hintdbmap.t 
+
+type hint_db_table = (string,Hint_db.t) Hintdbmap.t ref
 
 type hint_db_name = string
 
-let searchtable = (ref Stringmap.empty : hint_db_table)
+let searchtable = (ref Hintdbmap.empty : hint_db_table)
 
 let searchtable_map name = 
-  Stringmap.find name !searchtable
+  Hintdbmap.find name !searchtable
 let searchtable_add (name,db) = 
-  searchtable := Stringmap.add name db !searchtable
+  searchtable := Hintdbmap.add name db !searchtable
+let current_db_names () =
+  Hintdbmap.dom !searchtable
 
 (**************************************************************************)
 (*                       Definition of the summary                        *)
 (**************************************************************************)
 
-let init     () = searchtable := Stringmap.empty
+let init     () = searchtable := Hintdbmap.empty
 let freeze   () = !searchtable
 let unfreeze fs = searchtable := fs
 
@@ -177,21 +182,25 @@ let try_head_pattern c =
   try head_pattern_bound c
   with BoundPattern -> error "Bound head variable"
 
-let make_exact_entry name (c,cty) =
+let make_exact_entry (c,cty) =
   let cty = strip_outer_cast cty in
   match kind_of_term cty with
     | Prod (_,_,_) -> 
 	failwith "make_exact_entry"
     | _ ->
 	(head_of_constr_reference (List.hd (head_constr cty)),
-	   { hname=name; pri=0; pat=None; code=Give_exact c })
+	   { 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};
+   sigma=Evd.empty}
 
-let make_apply_entry env sigma (eapply,verbose) name (c,cty) =
+let make_apply_entry env sigma (eapply,verbose) (c,cty) =
   let cty = hnf_constr env sigma cty in
   match kind_of_term cty with
     | Prod _ ->
-        let ce = mk_clenv_from () (c,cty) in
-	let c' = (clenv_template_type ce).rebus in
+        let ce = mk_clenv_from dummy_goal (c,cty) in
+	let c' = clenv_type ce in
 	let pat = Pattern.pattern_of_constr c' in
         let hd = (try head_pattern_bound pat
                   with BoundPattern -> failwith "make_apply_entry") in
@@ -199,72 +208,66 @@ let make_apply_entry env sigma (eapply,verbose) name (c,cty) =
         in 
 	if eapply & (nmiss <> 0) then begin
           if verbose then 
-	    if !Options.v7 then
-	    warn (str "the hint: EApply " ++ prterm c ++
-		    str " will only be used by EAuto")
-	    else
-	    warn (str "the hint: eapply " ++ prterm c ++
-		    str " will only be used by eauto"); 
+	    warn (str "the hint: eapply " ++ pr_lconstr c ++
+		  str " will only be used by eauto"); 
           (hd,
-           { hname = name;
-	     pri = nb_hyp cty + nmiss;
+           { pri = nb_hyp cty + nmiss;
              pat = Some pat;
-             code = ERes_pf(c,ce) })
+             code = ERes_pf(c,{ce with templenv=empty_env}) })
         end else 
 	  (hd,
-           { hname = name;
-	     pri = nb_hyp cty;
+           { pri = nb_hyp cty;
              pat = Some pat;
-             code = Res_pf(c,ce) })
+             code = Res_pf(c,{ce with templenv=empty_env}) })
     | _ -> failwith "make_apply_entry"
  
 (* eap is (e,v) with e=true if eapply and v=true if verbose 
    c is a constr
    cty is the type of constr *)
 
-let make_resolves env sigma name eap (c,cty) =
+let make_resolves env sigma eap c =
+  let cty = type_of env sigma c in
   let ents = 
     map_succeed 
-      (fun f -> f name (c,cty)) 
-      [make_exact_entry; make_apply_entry env sigma eap]
+      (fun f -> f (c,cty)) 
+      [make_exact_entry; make_apply_entry env sigma (eap,Options.is_verbose())]
   in 
-  if ents = [] then 
-    errorlabstrm "Hint" (prterm c ++ spc () ++ str "cannot be used as a hint");
+  if ents = [] then
+    errorlabstrm "Hint" 
+      (pr_lconstr c ++ spc() ++ str"cannot be used as a hint");
   ents
 
+
 (* used to add an hypothesis to the local hint database *)
 let make_resolve_hyp env sigma (hname,_,htyp) = 
   try
-    [make_apply_entry env sigma (true, false) hname
+    [make_apply_entry env sigma (true, false)
        (mkVar hname,  htyp)]
   with 
     | Failure _ -> []
     | e when Logic.catchable_exception e -> anomaly "make_resolve_hyp"
 
 (* REM : in most cases hintname = id *)
-let make_unfold (hintname, ref) =
-  (Pattern.label_of_ref ref,
-   { hname = hintname;
-     pri = 4;
+let make_unfold (ref, eref) =
+  (ref,
+   { pri = 4;
      pat = None;
-     code = Unfold_nth ref })
+     code = Unfold_nth eref })
 
-let make_extern name pri pat tacast = 
+let make_extern pri pat tacast = 
   let hdconstr = try_head_pattern pat in 
   (hdconstr,
-   { hname = name;
-     pri=pri;
+   { pri=pri;
      pat = Some pat;
      code= Extern tacast })
 
-let make_trivial env sigma (name,c) =
+let make_trivial env sigma c =
   let t = hnf_constr env sigma (type_of env sigma c) in
   let hd = head_of_constr_reference (List.hd (head_constr t)) in
-  let ce = mk_clenv_from () (c,t) in
-  (hd, { hname = name;
-	       pri=1;
-               pat = Some (Pattern.pattern_of_constr (clenv_template_type ce).rebus);
-               code=Res_pf_THEN_trivial_fail(c,ce) })
+  let ce = mk_clenv_from dummy_goal (c,t) in
+  (hd, { pri=1;
+         pat = Some (Pattern.pattern_of_constr (clenv_type ce));
+         code=Res_pf_THEN_trivial_fail(c,{ce with templenv=empty_env}) })
 
 open Vernacexpr
 
@@ -291,7 +294,7 @@ let forward_subst_tactic =
 let set_extern_subst_tactic f = forward_subst_tactic := f
 
 let subst_autohint (_,subst,(local,name,hintlist as obj)) = 
-  let trans_clenv clenv = Clenv.subst_clenv (fun _ a -> a) subst clenv in
+  let trans_clenv clenv = Clenv.subst_clenv subst clenv in
   let trans_data data code = 	      
     { data with
 	pat = option_smartmap (subst_pattern subst) data.pat ;
@@ -299,29 +302,32 @@ let subst_autohint (_,subst,(local,name,hintlist as obj)) =
     }
   in
   let subst_hint (lab,data as hint) =
-    let lab' = subst_label subst lab in
+    let lab',elab' = subst_global subst lab in
+    let lab' =
+     try head_of_constr_reference (List.hd (head_constr_bound elab' []))
+     with Tactics.Bound -> lab' in
     let data' = match data.code with
       | Res_pf (c, clenv) ->
-	  let c' = Term.subst_mps subst c in
+	  let c' = subst_mps subst c in
 	    if c==c' then data else
 	      trans_data data (Res_pf (c', trans_clenv clenv))
       | ERes_pf (c, clenv) ->
-	  let c' = Term.subst_mps subst c in
+	  let c' = subst_mps subst c in
 	    if c==c' then data else
 	      trans_data data (ERes_pf (c', trans_clenv clenv))
       | Give_exact c ->
-	  let c' = Term.subst_mps subst c in
+	  let c' = subst_mps subst c in
 	    if c==c' then data else
 	      trans_data data (Give_exact c')
       | Res_pf_THEN_trivial_fail (c, clenv) ->
-	  let c' = Term.subst_mps subst c in
+	  let c' = subst_mps subst c in
 	    if c==c' then data else
 	      let code' = Res_pf_THEN_trivial_fail (c', trans_clenv clenv) in
 		trans_data data code'
       | Unfold_nth ref -> 
-	  let ref' = subst_global subst ref in
-	    if ref==ref' then data else
-	      trans_data data (Unfold_nth ref')
+          let ref' = subst_evaluable_reference subst ref in
+           if ref==ref' then data else
+	    trans_data data (Unfold_nth ref')
       | Extern tac ->
 	  let tac' = !forward_subst_tactic subst tac in
 	    if tac==tac' then data else
@@ -353,19 +359,12 @@ let (inAutoHint,outAutoHint) =
 (*                     The "Hint" vernacular command                      *)
 (**************************************************************************)
 let add_resolves env sigma clist local dbnames =
-  List.iter 
+  List.iter
     (fun dbname ->
        Lib.add_anonymous_leaf
 	 (inAutoHint
 	    (local,dbname,
-     	     List.flatten
-	       (List.map
-		  (fun (name,c) -> 
-		     let ty = type_of env sigma c in
-		     let verbose = Options.is_verbose() in
-		       make_resolves env sigma name (true,verbose) (c,ty)) clist
-	       )
-	    )))
+     	     List.flatten (List.map (make_resolves env sigma true) clist))))
     dbnames
 
 
@@ -376,12 +375,9 @@ let add_unfolds l local dbnames =
     dbnames
 
 
-let add_extern name pri (patmetas,pat) tacast local dbname =
+let add_extern pri (patmetas,pat) tacast local dbname =
   (* We check that all metas that appear in tacast have at least
      one occurence in the left pattern pat *)
-(* TODO
-  let tacmetas = Coqast.collect_metas tacast in
-*)
   let tacmetas = [] in
   match (list_subtract tacmetas patmetas) with
     | i::_ ->
@@ -389,10 +385,10 @@ let add_extern name pri (patmetas,pat) tacast local dbname =
 	  (str "The meta-variable ?" ++ pr_patvar i ++ str" is not bound")
     | []  ->
 	Lib.add_anonymous_leaf
-	  (inAutoHint(local,dbname, [make_extern name pri pat tacast]))
+	  (inAutoHint(local,dbname, [make_extern pri pat tacast]))
 
-let add_externs name pri pat tacast local dbnames = 
-  List.iter (add_extern name pri pat tacast local) dbnames
+let add_externs pri pat tacast local dbnames = 
+  List.iter (add_extern pri pat tacast local) dbnames
 
 let add_trivials env sigma l local dbnames =
   List.iter
@@ -408,53 +404,39 @@ let set_extern_intern_tac f = forward_intern_tac := f
 
 let add_hints local dbnames0 h =
   let dbnames = if dbnames0 = [] then ["core"] else dbnames0 in
+  let env = Global.env() and sigma = Evd.empty in
+  let f = Constrintern.interp_constr sigma env in
   match h with
   | HintsResolve lhints ->	
-      let env = Global.env() and sigma = Evd.empty in
-      let f (n,c) =
-	let c = Constrintern.interp_constr sigma env c in
-	let n = match n with
-	  | None -> (*id_of_global (reference_of_constr c)*)
-              id_of_string "<anonymous hint>"
-	  | Some n -> n in
-	(n,c) in
       add_resolves env sigma (List.map f lhints) local dbnames
   | HintsImmediate lhints ->
-      let env = Global.env() and sigma = Evd.empty in
-      let f (n,c) = 
-	let c = Constrintern.interp_constr sigma env c in
-	let n = match n with
-	  | None -> (*id_of_global (reference_of_constr c)*)
-              id_of_string "<anonymous hint>"
-	  | Some n -> n in
-	(n,c) in
       add_trivials env sigma (List.map f lhints) local dbnames
   | HintsUnfold lhints ->
-      let f (n,locqid) =
-	let r = Nametab.global locqid in
-	let n = match n with
-	  | None -> id_of_global r
-	  | Some n -> n in
-	(n,r) in
+      let f qid =
+	let r = Nametab.global qid in
+        let r' = match r with
+         | ConstRef c -> EvalConstRef c
+         | VarRef c -> EvalVarRef c
+         | _ -> 
+           errorlabstrm "evalref_of_ref"
+            (str "Cannot coerce" ++ spc () ++ pr_global r ++ spc () ++
+             str "to an evaluable reference")
+        in
+	 (r,r') in
       add_unfolds (List.map f lhints) local dbnames
-  | HintsConstructors (hintname, lqid) ->
+  | HintsConstructors lqid ->
       let add_one qid =
         let env = Global.env() and sigma = Evd.empty in
         let isp = global_inductive qid in
         let consnames = (snd (Global.lookup_inductive isp)).mind_consnames in
         let lcons = list_tabulate
           (fun i -> mkConstruct (isp,i+1)) (Array.length consnames) in
-        let lcons = List.map2
-          (fun id c -> (id,c)) (Array.to_list consnames) lcons in
         add_resolves env sigma lcons local dbnames in
       List.iter add_one lqid
-  | HintsExtern (hintname, pri, patcom, tacexp) ->
-      let hintname = match hintname with
-          Some h -> h
-        | _ -> id_of_string "<anonymous hint>" in
+  | HintsExtern (pri, patcom, tacexp) ->
       let pat =	Constrintern.interp_constrpattern Evd.empty (Global.env()) patcom in
       let tacexp = !forward_intern_tac (fst pat) tacexp in
-      add_externs hintname pri pat tacexp local dbnames
+      add_externs pri pat tacexp local dbnames
   | HintsDestruct(na,pri,loc,pat,code) ->
       if dbnames0<>[] then
         warn (str"Database selection not implemented for destruct hints");
@@ -465,25 +447,15 @@ let add_hints local dbnames0 h =
 (**************************************************************************)
 
 let fmt_autotactic =
-  if !Options.v7 then
-  function
-  | Res_pf (c,clenv) -> (str"Apply " ++ prterm c)
-  | ERes_pf (c,clenv) -> (str"EApply " ++ prterm c)
-  | Give_exact c -> (str"Exact " ++ prterm c)
-  | Res_pf_THEN_trivial_fail (c,clenv) -> 
-      (str"Apply " ++ prterm c ++ str" ; Trivial")
-  | Unfold_nth c -> (str"Unfold " ++  pr_global c)
-  | Extern tac -> (str "Extern " ++ Pptactic.pr_glob_tactic tac)
-  else
   function
-  | Res_pf (c,clenv) -> (str"apply " ++ prterm c)
-  | ERes_pf (c,clenv) -> (str"eapply " ++ prterm c)
-  | Give_exact c -> (str"exact " ++ prterm c)
+  | Res_pf (c,clenv) -> (str"apply " ++ pr_lconstr c)
+  | ERes_pf (c,clenv) -> (str"eapply " ++ pr_lconstr c)
+  | Give_exact c -> (str"exact " ++ pr_lconstr c)
   | Res_pf_THEN_trivial_fail (c,clenv) -> 
-      (str"apply " ++ prterm c ++ str" ; trivial")
-  | Unfold_nth c -> (str"unfold " ++  pr_global c)
+      (str"apply " ++ pr_lconstr c ++ str" ; trivial")
+  | Unfold_nth c -> (str"unfold " ++  pr_evaluable_reference c)
   | Extern tac -> 
-      (str "(external) " ++ Pptacticnew.pr_glob_tactic (Global.env()) tac)
+      (str "(external) " ++ Pptactic.pr_glob_tactic (Global.env()) tac)
 
 let fmt_hint v =
   (fmt_autotactic v.code ++ str"(" ++ int v.pri ++ str")" ++ spc ())
@@ -498,20 +470,20 @@ let fmt_hints_db (name,db,hintlist) =
 
 (* Print all hints associated to head c in any database *)
 let fmt_hint_list_for_head c = 
-  let dbs = stringmap_to_list !searchtable in
+  let dbs = Hintdbmap.to_list !searchtable in
   let valid_dbs = 
     map_succeed 
       (fun (name,db) -> (name,db,Hint_db.map_all c db)) 
       dbs 
   in
   if valid_dbs = [] then 
-    (str "No hint declared for :" ++ pr_ref_label c)
+    (str "No hint declared for :" ++ pr_global c)
   else 
     hov 0 
-      (str"For " ++ pr_ref_label c ++ str" -> " ++ fnl () ++
+      (str"For " ++ pr_global c ++ str" -> " ++ fnl () ++
 	 hov 0 (prlist fmt_hints_db valid_dbs))
 
-let fmt_hint_ref ref = fmt_hint_list_for_head (label_of_ref ref)
+let fmt_hint_ref ref = fmt_hint_list_for_head ref
 
 (* Print all hints associated to head id in any database *)
 let print_hint_ref ref =  ppnl(fmt_hint_ref ref)
@@ -523,7 +495,7 @@ let fmt_hint_term cl =
       | [] -> assert false 
     in
     let hd = head_of_constr_reference hdc in
-    let dbs = stringmap_to_list !searchtable in
+    let dbs = Hintdbmap.to_list !searchtable in
     let valid_dbs = 
       if occur_existential cl then 
 	map_succeed 
@@ -556,7 +528,7 @@ let print_hint_db db =
   Hint_db.iter 
     (fun head hintlist ->
        msg (hov 0 
-	      (str "For " ++ pr_ref_label head ++ str " -> " ++
+	      (str "For " ++ pr_global head ++ str " -> " ++
 		 fmt_hint_list hintlist)))
     db
 
@@ -568,7 +540,7 @@ let print_hint_db_by_name dbname =
   
 (* displays all the hints of all databases *)
 let print_searchtable () =
-  Stringmap.iter
+  Hintdbmap.iter
     (fun name db ->
        msg (str "In the database " ++ str name ++ fnl ());
        print_hint_db db)
@@ -588,19 +560,18 @@ let priority l = List.map snd (List.filter (fun (pr,_) -> pr = 0) l)
 (* Try unification with the precompiled clause, then use registered Apply *)
 
 let unify_resolve (c,clenv) gls = 
-  let (wc,kONT) = startWalk gls in
-  let clenv' = connect_clenv wc clenv in
+  let clenv' = connect_clenv gls clenv in
   let _ = clenv_unique_resolver false clenv' gls in  
   h_simplest_apply c gls
 
 (* builds a hint database from a constr signature *)
 (* typically used with (lid, ltyp) = pf_hyps_types <some goal> *)
 
-let make_local_hint_db g = 
+let make_local_hint_db lems g =
   let sign = pf_hyps g in
-  let hintlist = list_map_append (make_resolve_hyp (pf_env g) (project g)) sign
-  in Hint_db.add_list hintlist Hint_db.empty
-
+  let hintlist = list_map_append (pf_apply make_resolve_hyp g) sign in
+  let hintlist' = list_map_append (pf_apply make_resolves g true) lems in
+  Hint_db.add_list hintlist' (Hint_db.add_list hintlist Hint_db.empty)
 
 (* Serait-ce possible de compiler d'abord la tactique puis de faire la
    substitution sans passer par bdize dont l'objectif est de préparer un
@@ -654,7 +625,7 @@ and my_find_search db_list local_db hdc concl =
       	(local_db::db_list)
   in
   List.map 
-    (fun ({pri=b; pat=p; code=t} as patac) -> 
+    (fun {pri=b; pat=p; code=t} -> 
        (b,
 	match t with
 	  | Res_pf (term,cl)  -> unify_resolve (term,cl)
@@ -664,7 +635,7 @@ and my_find_search db_list local_db hdc concl =
 	      tclTHEN 
 		(unify_resolve (term,cl)) 
 		(trivial_fail_db db_list local_db)
-	  | Unfold_nth c -> unfold_constr c
+	  | Unfold_nth c -> unfold_in_concl [[],c]
 	  | Extern tacast -> 
 	      conclPattern concl (out_some p) tacast))
     tacl
@@ -677,32 +648,30 @@ and trivial_resolve db_list local_db cl =
   with Bound | Not_found -> 
     []
 
-let trivial dbnames gl =
+let trivial lems dbnames gl =
   let db_list = 
     List.map
       (fun x -> 
 	 try 
 	   searchtable_map x
 	 with Not_found -> 
-	   if !Options.v7 then
-	     error ("Trivial: "^x^": No such Hint database")
-	   else
-	     error ("trivial: "^x^": No such Hint database"))
+	   error ("trivial: "^x^": No such Hint database"))
       ("core"::dbnames) 
   in
-  tclTRY (trivial_fail_db db_list (make_local_hint_db gl)) gl 
+  tclTRY (trivial_fail_db db_list (make_local_hint_db lems gl)) gl 
     
-let full_trivial gl =
-  let dbnames = stringmap_dom !searchtable in
+let full_trivial lems gl =
+  let dbnames = Hintdbmap.dom !searchtable in
   let dbnames = list_subtract dbnames ["v62"] in
   let db_list = List.map (fun x -> searchtable_map x) dbnames in
-  tclTRY (trivial_fail_db db_list (make_local_hint_db gl)) gl
+  tclTRY (trivial_fail_db db_list (make_local_hint_db lems gl)) gl
 
-let gen_trivial = function
-  | None -> full_trivial
-  | Some l -> trivial l
+let gen_trivial lems = function
+  | None -> full_trivial lems
+  | Some l -> trivial lems l
 
-let h_trivial l = Refiner.abstract_tactic (TacTrivial l) (gen_trivial l)
+let h_trivial lems l =
+  Refiner.abstract_tactic (TacTrivial (lems,l)) (gen_trivial lems l)
 
 (**************************************************************************)
 (*                       The classical Auto tactic                        *)
@@ -760,7 +729,7 @@ let rec search_gen decomp n db_list local_db extra_sign goal =
 	   try 
 	     [make_apply_entry (pf_env g') (project g')
 		(true,false) 
-		hid (mkVar hid, htyp)]
+		(mkVar hid, htyp)]
 	   with Failure _ -> [] 
 	 in
          search_gen decomp n db_list (Hint_db.add_list hintl local_db) [d] g') 
@@ -778,44 +747,41 @@ let rec search_gen decomp n db_list local_db extra_sign goal =
 let search = search_gen 0
 
 let default_search_depth = ref 5
-			     
-let auto n dbnames gl = 
+
+let auto n lems dbnames gl =
   let db_list = 
     List.map
       (fun x -> 
 	 try 
 	   searchtable_map x
 	 with Not_found -> 
-	   if !Options.v7 then
-	     error ("Auto: "^x^": No such Hint database")
-	   else
-	     error ("auto: "^x^": No such Hint database"))
+	   error ("auto: "^x^": No such Hint database"))
       ("core"::dbnames) 
   in
   let hyps = pf_hyps gl in
-  tclTRY (search n db_list (make_local_hint_db gl) hyps) gl
+  tclTRY (search n db_list (make_local_hint_db lems gl) hyps) gl
 
-let default_auto = auto !default_search_depth []
+let default_auto = auto !default_search_depth [] []
 
-let full_auto n gl = 
-  let dbnames = stringmap_dom !searchtable in
+let full_auto n lems gl = 
+  let dbnames = Hintdbmap.dom !searchtable in
   let dbnames = list_subtract dbnames ["v62"] in
   let db_list = List.map (fun x -> searchtable_map x) dbnames in
   let hyps = pf_hyps gl in
-  tclTRY (search n db_list (make_local_hint_db gl) hyps) gl
+  tclTRY (search n db_list (make_local_hint_db lems gl) hyps) gl
   
-let default_full_auto gl = full_auto !default_search_depth gl
+let default_full_auto gl = full_auto !default_search_depth [] gl
 
-let gen_auto n dbnames =
+let gen_auto n lems dbnames =
   let n = match n with None -> !default_search_depth | Some n -> n in
   match dbnames with
-  | None -> full_auto n
-  | Some l -> auto n l
+  | None -> full_auto n lems
+  | Some l -> auto n lems l
 
 let inj_or_var = option_app (fun n -> Genarg.ArgArg n)
 
-let h_auto n l =
-  Refiner.abstract_tactic (TacAuto (inj_or_var n,l)) (gen_auto n l)
+let h_auto n lems l =
+  Refiner.abstract_tactic (TacAuto (inj_or_var n,lems,l)) (gen_auto n lems l)
 
 (**************************************************************************)
 (*                  The "destructing Auto" from Eduardo                   *)
@@ -830,7 +796,7 @@ let default_search_decomp = ref 1
 let destruct_auto des_opt n gl = 
   let hyps = pf_hyps gl in
   search_gen des_opt n [searchtable_map "core"] 
-    (make_local_hint_db gl) hyps gl
+    (make_local_hint_db [] gl) hyps gl
     
 let dautomatic des_opt n = tclTRY (destruct_auto des_opt n)
 
@@ -842,13 +808,21 @@ let dauto = function
   | Some n, Some p -> dautomatic p n
   | None, Some p   -> dautomatic p !default_search_depth
 
-let h_dauto (n,p) = 
+let h_dauto (n,p) =
   Refiner.abstract_tactic (TacDAuto (inj_or_var n,p)) (dauto (n,p))
 
 (***************************************)
 (*** A new formulation of Auto *********)
 (***************************************)
 
+let make_resolve_any_hyp env sigma (id,_,ty) =
+  let ents = 
+    map_succeed
+      (fun f -> f (mkVar id,ty)) 
+      [make_exact_entry; make_apply_entry env sigma (true,false)]
+  in 
+  ents
+
 type autoArguments =
   | UsingTDB       
   | Destructing   
@@ -869,7 +843,7 @@ let compileAutoArg contac = function
 		 then 
 		   tclTHENSEQ [simplest_elim (mkVar id); clear [id]; contac] 
                  else 
-		   tclFAIL 0 ((string_of_id id)^"is not a conjunction"))
+		   tclFAIL 0 (pr_id id ++ str" is not a conjunction"))
 	     ctx) g)
   | UsingTDB ->  
       (tclTHEN  
@@ -888,10 +862,7 @@ let rec super_search n db_list local_db argl goal =
      ::
      (tclTHEN intro 
         (fun g -> 
-	   let (hid,_,htyp) = pf_last_hyp g in
-	   let hintl =
-	     make_resolves (pf_env g) (project g)
-	       hid (true,false) (mkVar hid, htyp) in
+	   let hintl = pf_apply make_resolve_any_hyp g (pf_last_hyp g) in
 	   super_search n db_list (Hint_db.add_list hintl local_db)
 	     argl g))
      ::
@@ -910,8 +881,8 @@ let search_superauto n to_add argl g =
       (fun (id,c) -> add_named_decl (id, None, pf_type_of g c))
       to_add empty_named_context in
   let db0 = list_map_append (make_resolve_hyp (pf_env g) (project g)) sigma in
-  let db = Hint_db.add_list db0 (make_local_hint_db g) in
-  super_search n [Stringmap.find "core" !searchtable] db argl g
+  let db = Hint_db.add_list db0 (make_local_hint_db [] g) in
+  super_search n [Hintdbmap.find "core" !searchtable] db argl g
 
 let superauto n to_add argl  = 
   tclTRY (tclCOMPLETE (search_superauto n to_add argl))
@@ -921,7 +892,7 @@ let default_superauto g = superauto !default_search_depth [] [] g
 let interp_to_add gl locqid =
   let r = Nametab.global locqid in
   let id = id_of_global r in
-  (next_ident_away id (pf_ids_of_hyps gl), constr_of_reference r)
+  (next_ident_away id (pf_ids_of_hyps gl), constr_of_global r)
 
 let gen_superauto nopt l a b gl =
   let n = match nopt with Some n -> n | None -> !default_search_depth in
diff --git a/tactics/auto.mli b/tactics/auto.mli
index ec8c0d71..ecd20f0d 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: auto.mli,v 1.22.2.2 2005/01/21 16:41:52 herbelin Exp $ i*)
+(*i $Id: auto.mli 7937 2006-01-28 19:58:11Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -21,20 +21,20 @@ open Environ
 open Evd
 open Libnames
 open Vernacexpr
+open Mod_subst
 (*i*)
   
 type auto_tactic = 
-  | Res_pf     of constr * unit clausenv    (* Hint Apply *)
-  | ERes_pf    of constr * unit clausenv    (* Hint EApply *)
+  | Res_pf     of constr * clausenv    (* Hint Apply *)
+  | ERes_pf    of constr * clausenv    (* Hint EApply *)
   | Give_exact of constr                  
-  | Res_pf_THEN_trivial_fail of constr * unit clausenv (* Hint Immediate *)
-  | Unfold_nth of global_reference          (* Hint Unfold *)
+  | Res_pf_THEN_trivial_fail of constr * clausenv (* Hint Immediate *)
+  | Unfold_nth of evaluable_global_reference          (* Hint Unfold *)
   | Extern     of Tacexpr.glob_tactic_expr   (* Hint Extern *)
 
 open Rawterm
 
 type pri_auto_tactic = { 
-  hname : identifier;     (* name of the hint *)
   pri   : int;            (* A number between 0 and 4, 4 = lower priority *)
   pat   : constr_pattern option; (* A pattern for the concl of the Goal *)
   code  : auto_tactic;    (* the tactic to apply when the concl matches pat *)
@@ -48,19 +48,19 @@ module Hint_db :
   sig
     type t
     val empty : t
-    val find : constr_label -> t -> search_entry
-    val map_all : constr_label -> t -> pri_auto_tactic list
-    val map_auto : constr_label * constr -> t -> pri_auto_tactic list
-    val add_one : constr_label * pri_auto_tactic -> t -> t
-    val add_list : (constr_label * pri_auto_tactic) list -> t -> t
-    val iter : (constr_label -> stored_data list -> unit) -> t -> unit
+    val find : global_reference -> t -> search_entry
+    val map_all : global_reference -> t -> pri_auto_tactic list
+    val map_auto : global_reference * constr -> t -> pri_auto_tactic list
+    val add_one : global_reference * pri_auto_tactic -> t -> t
+    val add_list : (global_reference * pri_auto_tactic) list -> t -> t
+    val iter : (global_reference -> stored_data list -> unit) -> t -> unit
   end
 
-type frozen_hint_db_table = Hint_db.t Stringmap.t
+type hint_db_name = string
 
-type hint_db_table = Hint_db.t Stringmap.t ref
+val searchtable_map : hint_db_name -> Hint_db.t
 
-type hint_db_name = string
+val current_db_names : unit -> hint_db_name list
 
 val add_hints : locality_flag -> hint_db_name list -> hints -> unit
 
@@ -72,25 +72,20 @@ val print_hint_ref : global_reference -> unit
 
 val print_hint_db_by_name : hint_db_name -> unit
 
-val searchtable : hint_db_table
-
 (* [make_exact_entry hint_name (c, ctyp)]. 
-   [hint_name] is the name of then hint;
    [c] is the term given as an exact proof to solve the goal;
    [ctyp] is the type of [hc]. *)
 
-val make_exact_entry :
-  identifier -> constr * constr -> constr_label * pri_auto_tactic
+val make_exact_entry : constr * constr -> global_reference * pri_auto_tactic
 
-(* [make_apply_entry (eapply,verbose) name (c,cty)].
+(* [make_apply_entry (eapply,verbose) (c,cty)].
    [eapply] is true if this hint will be used only with EApply;
-   [name] is the name of then hint;
    [c] is the term given as an exact proof to solve the goal;
    [cty] is the type of [hc]. *)
 
 val make_apply_entry :
-  env -> evar_map -> bool * bool -> identifier -> constr * constr
-      -> constr_label * pri_auto_tactic
+  env -> evar_map -> bool * bool -> constr * constr
+      -> global_reference * pri_auto_tactic
 
 (* A constr which is Hint'ed will be:
    (1) used as an Exact, if it does not start with a product
@@ -100,8 +95,8 @@ val make_apply_entry :
        has missing arguments. *)
 
 val make_resolves :
-  env -> evar_map -> identifier -> bool * bool -> constr * constr -> 
-    (constr_label * pri_auto_tactic) list
+  env -> evar_map -> bool -> constr -> 
+      (global_reference * pri_auto_tactic) list
 
 (* [make_resolve_hyp hname htyp].
    used to add an hypothesis to the local hint database;
@@ -110,13 +105,13 @@ val make_resolves :
 
 val make_resolve_hyp : 
   env -> evar_map -> named_declaration ->
-      (constr_label * pri_auto_tactic) list
+      (global_reference * pri_auto_tactic) list
 
-(* [make_extern name pri pattern tactic_expr] *)
+(* [make_extern pri pattern tactic_expr] *)
 
 val make_extern :
-  identifier -> int -> constr_pattern -> Tacexpr.glob_tactic_expr
-      -> constr_label * pri_auto_tactic
+  int -> constr_pattern -> Tacexpr.glob_tactic_expr
+      -> global_reference * pri_auto_tactic
 
 val set_extern_interp :
   (patvar_map -> Tacexpr.glob_tactic_expr -> tactic) -> unit
@@ -126,20 +121,20 @@ val set_extern_intern_tac :
   -> unit
 
 val set_extern_subst_tactic :
-  (Names.substitution -> Tacexpr.glob_tactic_expr -> Tacexpr.glob_tactic_expr)
+  (substitution -> Tacexpr.glob_tactic_expr -> Tacexpr.glob_tactic_expr)
   -> unit
 
 (* Create a Hint database from the pairs (name, constr).
    Useful to take the current goal hypotheses as hints *)
 
-val make_local_hint_db : goal sigma -> Hint_db.t
+val make_local_hint_db : constr list -> goal sigma -> Hint_db.t
 
 val priority : (int * 'a) list -> 'a list
 
 val default_search_depth : int ref
 
 (* Try unification with the precompiled clause, then use registered Apply *)
-val unify_resolve : (constr * unit clausenv) -> tactic
+val unify_resolve : (constr * clausenv) -> tactic
 
 (* [ConclPattern concl pat tacast]:
    if the term concl matches the pattern pat, (in sense of 
@@ -150,29 +145,29 @@ val conclPattern : constr -> constr_pattern -> Tacexpr.glob_tactic_expr -> tacti
 
 (* The Auto tactic *)
 
-val auto : int -> hint_db_name list -> tactic
+val auto : int -> constr list -> hint_db_name list -> tactic
 
 (* auto with default search depth and with the hint database "core" *)
 val default_auto : tactic
 
 (* auto with all hint databases except the "v62" compatibility database *)
-val full_auto : int -> tactic
+val full_auto : int -> constr list -> tactic
 
 (* auto with default search depth and with all hint databases 
    except the "v62" compatibility database *)
 val default_full_auto : tactic
 
 (* The generic form of auto (second arg [None] means all bases) *)
-val gen_auto : int option -> hint_db_name list option -> tactic
+val gen_auto : int option -> constr list -> hint_db_name list option -> tactic
 
 (* The hidden version of auto *)
-val h_auto   : int option -> hint_db_name list option -> tactic
+val h_auto   : int option -> constr list -> hint_db_name list option -> tactic
 
 (* Trivial *)
-val trivial : hint_db_name list -> tactic
-val gen_trivial : hint_db_name list option -> tactic
-val full_trivial : tactic
-val h_trivial : hint_db_name list option -> tactic
+val trivial : constr list -> hint_db_name list -> tactic
+val gen_trivial : constr list -> hint_db_name list option -> tactic
+val full_trivial : constr list -> tactic
+val h_trivial : constr list -> hint_db_name list option -> tactic
 
 val fmt_autotactic : auto_tactic -> Pp.std_ppcmds
 
diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
index 5706e134..ceeb4763 100644
--- a/tactics/autorewrite.ml
+++ b/tactics/autorewrite.ml
@@ -6,8 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Ast
-open Coqast
+(* $Id: autorewrite.ml 8114 2006-03-02 18:09:27Z herbelin $ *)
+
 open Equality
 open Hipattern
 open Names
@@ -20,9 +20,11 @@ open Term
 open Util
 open Vernacinterp
 open Tacexpr
+open Mod_subst
 
 (* Rewriting rules *)
-type rew_rule = constr * bool * glob_tactic_expr
+(* the type is the statement of the lemma constr. Used to elim duplicates. *)
+type rew_rule = constr * types * bool * glob_tactic_expr
 
 (* Summary and Object declaration *)
 let rewtab =
@@ -39,10 +41,25 @@ let _ =
       Summary.survive_module = false;
       Summary.survive_section   = false }
 
+let print_rewrite_hintdb bas =
+ try
+  let hints = Stringmap.find bas !rewtab in
+   ppnl (str "Database " ++ str bas ++ (Pp.cut ()) ++
+    prlist_with_sep Pp.cut
+     (fun (c,typ,d,t) ->
+       str (if d then "rewrite -> " else "rewrite <- ") ++
+       Printer.pr_lconstr c ++ str " of type " ++ Printer.pr_lconstr typ ++
+       str " then use tactic " ++ 
+       Pptactic.pr_glob_tactic (Global.env()) t) hints)
+ with
+  Not_found -> 
+   errorlabstrm "AutoRewrite" 
+     (str ("Rewriting base "^(bas)^" does not exist"))
+
 type raw_rew_rule = constr * bool * raw_tactic_expr
 
 (* Applies all the rules of one base *)
-let one_base tac_main bas =
+let one_base general_rewrite_maybe_in tac_main bas =
   let lrul = 
     try 
       Stringmap.find bas !rewtab
@@ -50,24 +67,75 @@ let one_base tac_main bas =
       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
+  let lrul = List.map (fun (c,_,b,t) -> (c,b,Tacinterp.eval_tactic t)) lrul in
     tclREPEAT_MAIN (tclPROGRESS (List.fold_left (fun tac (csr,dir,tc) ->
       tclTHEN tac
         (tclREPEAT_MAIN 
-	  (tclTHENSFIRSTn (general_rewrite dir csr) [|tac_main|] tc)))
+	  (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 tac_main bas)) tclIDTAC lbas))
+       tclTHEN tac (one_base general_rewrite tac_main bas)) tclIDTAC lbas))
+
+let autorewrite_in id tac_main lbas 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 id = ref id in
+  let to_be_cleared = ref false in
+   fun dir cstr gl ->
+    let last_hyp_id =
+     match (Environ.named_context_of_val gl.Evd.it.Evd.evar_hyps) with
+        (last_hyp_id,_,_)::_ -> last_hyp_id
+      | _ -> (* even the hypothesis id is missing *)
+             error ("No such hypothesis : " ^ (string_of_id !id))
+    in
+    let gl' = general_rewrite_in dir !id cstr gl in
+    let gls = (fst gl').Evd.it in
+    match gls with
+       g::_ ->
+        (match Environ.named_context_of_val g.Evd.evar_hyps with
+            (lastid,_,_)::_ ->
+              if last_hyp_id <> lastid then
+               begin
+                let gl'' =
+                  if !to_be_cleared then
+                   tclTHEN (fun _ -> gl') (tclTRY (clear [!id])) gl
+                  else gl' in
+                id := lastid ;
+                to_be_cleared := true ;
+                gl''
+               end
+              else
+               begin
+                to_be_cleared := false ;
+                gl'
+               end
+          | _ -> assert false) (* there must be at least an hypothesis *)
+     | _ -> assert false (* rewriting cannot complete a proof *)
+ in
+  tclREPEAT_MAIN (tclPROGRESS
+    (List.fold_left (fun tac bas -> 
+       tclTHEN tac (one_base general_rewrite_in tac_main bas)) tclIDTAC lbas))
+   gl
 
 (* Functions necessary to the library object declaration *)
 let cache_hintrewrite (_,(rbase,lrl)) =
   let l = 
     try 
-      lrl @ Stringmap.find rbase !rewtab
+      let oldl = Stringmap.find rbase !rewtab in
+      let lrl =
+       List.map
+        (fun (c,dummy,b,t) ->
+          (* here we substitute the dummy value with the right one *)
+          c,Typing.type_of (Global.env ()) Evd.empty c,b,t) lrl in
+      (List.filter
+          (fun (_,typ,_,_) ->
+            not (List.exists (fun (_,typ',_,_) -> Term.eq_constr typ typ') oldl)
+          ) lrl) @ oldl
     with
       | Not_found -> lrl
   in
@@ -76,11 +144,16 @@ let cache_hintrewrite (_,(rbase,lrl)) =
 let export_hintrewrite x = Some x
 
 let subst_hintrewrite (_,subst,(rbase,list as node)) = 
-  let subst_first (cst,b,t as pair) = 
-    let cst' = Term.subst_mps subst cst in
+  let subst_first (cst,typ,b,t as pair) = 
+    let cst' = subst_mps subst cst in
+    let typ' =
+     (* here we do not have the environment and Global.env () is not the
+        one where cst' lives in. Thus we can just put a dummy value and
+        override it in cache_hintrewrite *)
+     typ (* dummy value, it will be recomputed by cache_hintrewrite *) in
     let t' = Tacinterp.subst_tactic subst t in
-      if cst == cst' & t == t' then pair else
-	(cst',b,t)
+      if cst == cst' && t == t' then pair else
+	(cst',typ',b,t')
   in
   let list' = list_smartmap subst_first list in
     if list' == list then node else
@@ -100,5 +173,10 @@ let (in_hintrewrite,out_hintrewrite)=
 
 (* To add rewriting rules to a base *)
 let add_rew_rules base lrul =
-  let lrul = List.rev_map (fun (c,b,t) -> (c,b,Tacinterp.glob_tactic t)) lrul in
-  Lib.add_anonymous_leaf (in_hintrewrite (base,lrul))
+  let lrul =
+   List.rev_map
+    (fun (c,b,t) ->
+      (c,mkProp (* dummy value *), b,Tacinterp.glob_tactic t)
+    ) lrul
+  in
+   Lib.add_anonymous_leaf (in_hintrewrite (base,lrul))
diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli
index e97cde83..47d3c86a 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,v 1.5.10.1 2004/07/16 19:30:52 herbelin Exp $ i*)
+(*i $Id: autorewrite.mli 7034 2005-05-18 19:30:44Z sacerdot $ i*)
 
 (*i*)
 open Tacmach
@@ -20,3 +20,6 @@ val add_rew_rules : string -> raw_rew_rule list -> unit
 
 (* The AutoRewrite tactic *)
 val autorewrite : tactic -> string list -> tactic
+val autorewrite_in : Names.identifier -> tactic -> string list -> tactic
+
+val print_rewrite_hintdb : string -> unit
diff --git a/tactics/btermdn.ml b/tactics/btermdn.ml
index c5cdd540..f0b23b8d 100644
--- a/tactics/btermdn.ml
+++ b/tactics/btermdn.ml
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: btermdn.ml,v 1.5.16.1 2004/07/16 19:30:52 herbelin Exp $ *)
+(* $Id: btermdn.ml 6427 2004-12-07 17:41:10Z sacerdot $ *)
 
 open Term
 open Termdn
 open Pattern
+open Libnames
 
 (* Discrimination nets with bounded depth.
    See the module dn.ml for further explanations.
@@ -34,7 +35,7 @@ let bounded_constr_val_discr (t,depth) =
       | None -> None
       | Some (c,l) -> Some(c,List.map (fun c -> (c,depth-1)) l)
 
-type 'a t = (constr_label,constr_pattern * int,'a) Dn.t
+type 'a t = (global_reference,constr_pattern * int,'a) Dn.t
 
 let create = Dn.create
 
diff --git a/tactics/btermdn.mli b/tactics/btermdn.mli
index fe247495..1ac33557 100644
--- a/tactics/btermdn.mli
+++ b/tactics/btermdn.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: btermdn.mli,v 1.8.16.1 2004/07/16 19:30:52 herbelin Exp $ i*)
+(*i $Id: btermdn.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Term
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index c9d0ead5..0f274aae 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: contradiction.ml,v 1.3.2.1 2004/07/16 19:30:52 herbelin Exp $ *)
+(* $Id: contradiction.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Util
 open Term
diff --git a/tactics/contradiction.mli b/tactics/contradiction.mli
index 90ec101c..d94a1ef2 100644
--- a/tactics/contradiction.mli
+++ b/tactics/contradiction.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: contradiction.mli,v 1.2.2.1 2004/07/16 19:30:52 herbelin Exp $ i*)
+(*i $Id: contradiction.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Names
diff --git a/tactics/dhyp.ml b/tactics/dhyp.ml
index fb672d0b..511e0950 100644
--- a/tactics/dhyp.ml
+++ b/tactics/dhyp.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: dhyp.ml,v 1.30.2.1 2004/07/16 19:30:52 herbelin Exp $ *)
+(* $Id: dhyp.ml 7732 2005-12-26 13:51:24Z herbelin $ *)
 
 (* Chet's comments about this tactic :
  
@@ -129,7 +129,6 @@ open Libobject
 open Library
 open Pattern
 open Matching
-open Ast
 open Pcoq
 open Tacexpr
 open Libnames
@@ -266,11 +265,10 @@ let match_dpat dp cls gls =
     | ({onhyps=lo;onconcl=false},HypLocation(_,hypd,concld)) ->
         let hl = match lo with
             Some l -> l
-          | None -> List.map (fun id -> (id,[],(InHyp,ref None)))
-                     (pf_ids_of_hyps gls) in
+          | None -> List.map (fun id -> (id,[],InHyp)) (pf_ids_of_hyps gls) in
         if not
           (List.for_all
-            (fun (id,_,(hl,_)) ->
+            (fun (id,_,hl) ->
               let cltyp = pf_get_hyp_typ gls id in
               let cl = pf_concl gls in
               (hl=InHyp) &
diff --git a/tactics/dhyp.mli b/tactics/dhyp.mli
index a0cef679..630092f0 100644
--- a/tactics/dhyp.mli
+++ b/tactics/dhyp.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: dhyp.mli,v 1.8.2.1 2004/07/16 19:30:52 herbelin Exp $ i*)
+(*i $Id: dhyp.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Names
diff --git a/tactics/dn.ml b/tactics/dn.ml
index 55116831..ab908ff9 100644
--- a/tactics/dn.ml
+++ b/tactics/dn.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: dn.ml,v 1.5.16.1 2004/07/16 19:30:52 herbelin Exp $ *)
+(* $Id: dn.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* This file implements the basic structure of what Chet called
    ``discrimination nets''. If my understanding is right, it serves
diff --git a/tactics/dn.mli b/tactics/dn.mli
index a54007d8..f8efd053 100644
--- a/tactics/dn.mli
+++ b/tactics/dn.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: dn.mli,v 1.4.16.1 2004/07/16 19:30:52 herbelin Exp $ i*)
+(*i $Id: dn.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Discrimination nets. *)
 
diff --git a/tactics/eauto.ml4 b/tactics/eauto.ml4
index 31d79948..457f8318 100644
--- a/tactics/eauto.ml4
+++ b/tactics/eauto.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: eauto.ml4,v 1.11.2.1 2004/07/16 19:30:52 herbelin Exp $ *)
+(* $Id: eauto.ml4 7991 2006-02-05 22:56:16Z herbelin $ *)
 
 open Pp
 open Util
@@ -32,7 +32,7 @@ open Rawterm
 
 let e_give_exact c gl = let t1 = (pf_type_of gl c) and t2 = pf_concl gl in 
   if occur_existential t1 or occur_existential t2 then 
-     tclTHEN (unify t1) (exact_check c) gl
+     tclTHEN (Clenvtac.unify t1) (exact_check c) gl
   else exact_check c gl
 
 let assumption id = e_give_exact (mkVar id)
@@ -40,19 +40,19 @@ let assumption id = e_give_exact (mkVar id)
 let e_assumption gl = 
   tclFIRST (List.map assumption (pf_ids_of_hyps gl)) gl
 
+TACTIC EXTEND eassumption
+| [ "eassumption" ] -> [ e_assumption ]
+END
+
 let e_resolve_with_bindings_tac  (c,lbind) gl = 
-  let (wc,kONT) = startWalk gl in
-  let t = w_hnf_constr wc (w_type_of wc c) in 
-  let clause = make_clenv_binding_apply wc (-1) (c,t) lbind in 
-  e_res_pf kONT clause 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 
+  Clenvtac.e_res_pf clause gl
 
 let e_resolve_constr c gls = e_resolve_with_bindings_tac (c,NoBindings) gls
 			     
-(* V8 TACTIC EXTEND eexact
+TACTIC EXTEND eexact
 | [ "eexact" constr(c) ] -> [ e_give_exact c ]
-END*)
-TACTIC EXTEND Eexact
-| [ "EExact" constr(c) ] -> [ e_give_exact c ]
 END
 
 let e_give_exact_constr = h_eexact
@@ -62,11 +62,8 @@ let registered_e_assumption gl =
               (pf_ids_of_hyps gl)) gl
 
 (* This automatically define h_eApply (among other things) *)
-(*V8 TACTIC EXTEND eapply
-  [ "eapply" constr_with_bindings(c) ] -> [ e_resolve_with_bindings_tac c ]
-END*)
 TACTIC EXTEND eapply
-  [ "EApply" constr_with_bindings(c) ] -> [ e_resolve_with_bindings_tac c ]
+  [ "eapply" constr_with_bindings(c) ] -> [ e_resolve_with_bindings_tac c ]
 END
 
 let vernac_e_resolve_constr c = h_eapply (c,NoBindings)
@@ -75,8 +72,7 @@ let e_constructor_tac boundopt i lbind gl =
     let cl = pf_concl gl in 
   let (mind,redcl) = pf_reduce_to_quantified_ind gl cl in 
   let nconstr =
-    Array.length (snd (Global.lookup_inductive mind)).mind_consnames
-  and sigma   = project gl in
+    Array.length (snd (Global.lookup_inductive mind)).mind_consnames in
   if i=0 then error "The constructors are numbered starting from 1";
   if i > nconstr then error "Not enough constructors";
   begin match boundopt with 
@@ -87,7 +83,8 @@ let e_constructor_tac boundopt i lbind gl =
   end;
   let cons = mkConstruct (ith_constructor_of_inductive mind i) in
   let apply_tac = e_resolve_with_bindings_tac (cons,lbind) in
-  (tclTHENLIST [convert_concl_no_check redcl; intros; apply_tac]) gl
+  (tclTHENLIST [convert_concl_no_check redcl DEFAULTcast
+; intros; apply_tac]) gl
 
 let e_one_constructor i = e_constructor_tac None i
 
@@ -107,33 +104,30 @@ let e_right = e_constructor_tac (Some 2) 2
 let e_split = e_constructor_tac (Some 1) 1
 
 (* This automatically define h_econstructor (among other things) *)
-(*V8 TACTIC EXTEND eapply
-  [ "econstructor" integer(n) with_bindings(c) ] -> [ e_constructor_tac None n c ]
-END*)
 TACTIC EXTEND econstructor
-  [ "EConstructor" integer(n) "with" bindings(c) ] -> [ e_constructor_tac None n c ]
-  | [ "EConstructor" integer(n) ] -> [ e_constructor_tac None n NoBindings ]
-  | [ "EConstructor" tactic_opt(t) ] -> [ e_any_constructor (option_app Tacinterp.eval_tactic t) ] 
+  [ "econstructor" integer(n) "with" bindings(c) ] -> [ e_constructor_tac None n c ]
+| [ "econstructor" integer(n) ] -> [ e_constructor_tac None n NoBindings ]
+| [ "econstructor" tactic_opt(t) ] -> [ e_any_constructor (option_app Tacinterp.eval_tactic t) ] 
       END
 
 TACTIC EXTEND eleft
-  [ "ELeft" "with" bindings(l) ] -> [e_left l]
-  | [ "ELeft"] -> [e_left NoBindings]
+  [ "eleft" "with" bindings(l) ] -> [e_left l]
+| [ "eleft"] -> [e_left NoBindings]
 END
 
 TACTIC EXTEND eright
-  [ "ERight" "with" bindings(l) ] -> [e_right l]
-  | [ "ERight" ] -> [e_right NoBindings]
+  [ "eright" "with" bindings(l) ] -> [e_right l]
+| [ "eright" ] -> [e_right NoBindings]
 END
 
 TACTIC EXTEND esplit
-  [ "ESplit" "with" bindings(l) ] -> [e_split l]
-  | [ "ESplit"] -> [e_split NoBindings]
+  [ "esplit" "with" bindings(l) ] -> [e_split l]
+| [ "esplit"] -> [e_split NoBindings]
 END
 
 
 TACTIC EXTEND eexists
-  [ "EExists" bindings(l) ] -> [e_split l]
+  [ "eexists" bindings(l) ] -> [e_split l]
 END
 
 
@@ -162,29 +156,10 @@ let prolog_tac l n gl =
   with UserError ("Refiner.tclFIRST",_) ->
     errorlabstrm "Prolog.prolog" (str "Prolog failed")
 
-(* V8 TACTIC EXTEND prolog
+TACTIC EXTEND prolog
 | [ "prolog" "[" constr_list(l) "]" int_or_var(n) ] -> [ prolog_tac l n ]
-END*)
-TACTIC EXTEND Prolog
-| [ "Prolog" "[" constr_list(l) "]" int_or_var(n) ] -> [ prolog_tac l n ]
 END
 
-(*
-let vernac_prolog =
-  let uncom = function
-    | Constr c -> c
-    | _ -> assert false
-  in
-  let gentac = 
-    hide_tactic "Prolog"
-      (function
-	 | (Integer n) :: al -> prolog_tac (List.map uncom al) n
-	 | _ -> assert false)
-  in 
-  fun coms n -> 
-    gentac ((Integer n) :: (List.map (fun com -> (Constr com)) coms))
-*)
-
 open Auto
 
 (***************************************************************************)
@@ -192,8 +167,7 @@ open Auto
 (***************************************************************************)
 
 let unify_e_resolve  (c,clenv) gls = 
-  let (wc,kONT) = startWalk gls in
-  let clenv' = connect_clenv wc clenv in
+  let clenv' = connect_clenv gls clenv in
   let _ = clenv_unique_resolver false clenv' gls in
   vernac_e_resolve_constr c gls
 
@@ -219,7 +193,7 @@ and e_my_find_search db_list local_db hdc concl =
       list_map_append (Hint_db.map_auto (hdc,concl)) (local_db::db_list)
   in 
   let tac_of_hint = 
-    fun ({pri=b; pat = p; code=t} as patac) -> 
+    fun {pri=b; pat = p; code=t} -> 
       (b, 
        let tac =
 	 match t with
@@ -229,7 +203,7 @@ and e_my_find_search db_list local_db hdc concl =
 	   | Res_pf_THEN_trivial_fail (term,cl) ->
                tclTHEN (unify_e_resolve (term,cl)) 
 		 (e_trivial_fail_db db_list local_db)
-	   | Unfold_nth c -> unfold_constr c
+	   | Unfold_nth c -> unfold_in_concl [[],c]
 	   | Extern tacast -> conclPattern concl 
 	       (out_some p) tacast
        in 
@@ -309,7 +283,7 @@ module SearchProblem = struct
 	  filter_tactics s.tacres
 	    (List.map 
 	       (fun id -> (e_give_exact_constr (mkVar id),
-			   (str "Exact" ++ spc () ++ pr_id id)))
+			   (str "exact" ++ spc () ++ pr_id id)))
 	       (pf_ids_of_hyps g))
 	in
 	List.map (fun (res,pp) -> { depth = s.depth; tacres = res;
@@ -327,7 +301,7 @@ module SearchProblem = struct
 	     { depth = s.depth; tacres = res; 
 	       last_tactic = pp; dblist = s.dblist;
 	       localdb = ldb :: List.tl s.localdb })
-	  (filter_tactics s.tacres [Tactics.intro,(str "Intro")])
+	  (filter_tactics s.tacres [Tactics.intro,(str "intro")])
       in
       let rec_tacs = 
 	let l = 
@@ -380,33 +354,32 @@ let e_breadth_search debug n db_list local_db gl =
     s.SearchProblem.tacres
   with Not_found -> error "EAuto: breadth first search failed"
 
-let e_search_auto debug (in_depth,p) db_list gl = 
-  let local_db = make_local_hint_db gl in 
+let e_search_auto debug (in_depth,p) lems db_list gl = 
+  let local_db = make_local_hint_db lems gl in 
   if in_depth then 
     e_depth_search debug p db_list local_db gl
   else 
     e_breadth_search debug p db_list local_db gl
 
-let eauto debug np dbnames = 
+let eauto debug np lems dbnames =
   let db_list =
     List.map
       (fun x -> 
-	 try Stringmap.find x !searchtable
+	 try searchtable_map x
 	 with Not_found -> error ("EAuto: "^x^": No such Hint database"))
       ("core"::dbnames) 
   in
-  tclTRY (e_search_auto debug np db_list)
+  tclTRY (e_search_auto debug np lems db_list)
 
-let full_eauto debug n gl = 
-  let dbnames = stringmap_dom !searchtable in
+let full_eauto debug n lems gl = 
+  let dbnames = current_db_names () in
   let dbnames =  list_subtract dbnames ["v62"] in
-  let db_list = List.map (fun x -> Stringmap.find x !searchtable) dbnames in
-  let local_db = make_local_hint_db gl in
-  tclTRY (e_search_auto debug n db_list) gl
+  let db_list = List.map searchtable_map dbnames in
+  tclTRY (e_search_auto debug n lems db_list) gl
 
-let gen_eauto d np = function
-  | None -> full_eauto d np
-  | Some l -> eauto d np l
+let gen_eauto d np lems = function
+  | None -> full_eauto d np lems
+  | Some l -> eauto d np lems l
 
 let make_depth = function
   | None -> !default_search_depth 
@@ -422,10 +395,7 @@ open Genarg
 
 (* Hint bases *)
 
-let pr_hintbases _prc _prt = function 
-  | None -> str " with *"
-  | Some [] -> mt ()
-  | Some l -> str " with " ++ Util.prlist_with_sep spc str l
+let pr_hintbases _prc _prlc _prt = Pptactic.pr_hintbases
 
 ARGUMENT EXTEND hintbases
   TYPED AS preident_list_opt
@@ -435,14 +405,26 @@ ARGUMENT EXTEND hintbases
 | [ ] -> [ Some [] ]
 END
 
-TACTIC EXTEND EAuto
-| [ "EAuto" int_or_var_opt(n) int_or_var_opt(p) hintbases(db) ] ->
-    [ gen_eauto false (make_dimension n p) db ]
-END
+let pr_constr_coma_sequence prc _ _ = prlist_with_sep pr_coma prc
 
-V7 TACTIC EXTEND EAutodebug
-| [ "EAutod" int_or_var_opt(n) int_or_var_opt(p) hintbases(db) ] ->
-    [ gen_eauto true (make_dimension n p) db ]
+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
+
+TACTIC EXTEND eauto
+| [ "eauto" int_or_var_opt(n) int_or_var_opt(p) auto_using(lems) 
+    hintbases(db) ] ->
+    [ gen_eauto false (make_dimension n p) lems db ]
+END
diff --git a/tactics/eauto.mli b/tactics/eauto.mli
index c3084e65..4621088e 100644
--- a/tactics/eauto.mli
+++ b/tactics/eauto.mli
@@ -10,9 +10,13 @@
 open Term
 open Proof_type
 open Tacexpr
+open Auto
+open Topconstr
 (*i*)
 
-val rawwit_hintbases : string list option raw_abstract_argument_type
+val rawwit_hintbases : hint_db_name list option raw_abstract_argument_type
+
+val rawwit_auto_using : constr_expr list raw_abstract_argument_type
 
 val e_assumption : tactic
 
@@ -23,3 +27,7 @@ val e_resolve_constr :  constr -> tactic
 val vernac_e_resolve_constr :  constr -> tactic
 
 val e_give_exact_constr : constr -> tactic
+
+val gen_eauto : bool -> bool * int -> constr list -> 
+  hint_db_name list option -> tactic
+
diff --git a/tactics/elim.ml b/tactics/elim.ml
index 5573f9ea..2e079567 100644
--- a/tactics/elim.ml
+++ b/tactics/elim.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: elim.ml,v 1.37.2.1 2004/07/16 19:30:53 herbelin Exp $ *)
+(* $Id: elim.ml 7538 2005-11-08 17:14:52Z herbelin $ *)
 
 open Pp
 open Util
@@ -181,7 +181,6 @@ let double_ind h1 h2 gls =
     if abs_i < abs_j then (abs_i,abs_j) else
     if abs_i > abs_j then (abs_j,abs_i) else
       error "Both hypotheses are the same" in
-  let cl = pf_concl gls in 
   (tclTHEN (tclDO abs_i intro)
      (onLastHyp
        	(fun id ->
diff --git a/tactics/elim.mli b/tactics/elim.mli
index a891cd9d..d01d3027 100644
--- a/tactics/elim.mli
+++ b/tactics/elim.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: elim.mli,v 1.10.2.1 2004/07/16 19:30:53 herbelin Exp $ i*)
+(*i $Id: elim.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Names
diff --git a/tactics/eqdecide.ml4 b/tactics/eqdecide.ml4
index 8edfcb3e..9cbc549f 100644
--- a/tactics/eqdecide.ml4
+++ b/tactics/eqdecide.ml4
@@ -14,7 +14,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: eqdecide.ml4,v 1.6.2.1 2004/07/16 19:30:53 herbelin Exp $ *)
+(* $Id: eqdecide.ml4 8652 2006-03-22 08:27:14Z herbelin $ *)
 
 open Util
 open Names
@@ -46,11 +46,11 @@ open Coqlib
    2. Try discrimination to solve those goals where x and y has
       been introduced by different constructors.
    3. If x and y have been introduced by the same constructor,
-      then analyse one by one the correspoing pairs of arguments.
+      then analyse one by one the corresponding pairs of arguments.
       If they are equal, rewrite one into the other. If they are
       not, derive a contradiction from the injectiveness of the
       constructor. 
-   4. Once all the arguments have been rewritten, solve the left half 
+   4. Once all the arguments have been rewritten, solve the remaining half 
       of the disjunction by reflexivity.
 
    Eduardo Gimenez (30/3/98).
@@ -58,35 +58,36 @@ open Coqlib
 
 let clear_last = (tclLAST_HYP (fun c -> (clear [destVar c])))
 
-let mkBranches = 
+let choose_eq eqonleft = 
+  if eqonleft then h_simplest_left else h_simplest_right
+let choose_noteq eqonleft =
+  if eqonleft then h_simplest_right else h_simplest_left
+
+let mkBranches c1 c2 = 
   tclTHENSEQ
-    [intro; 
-     tclLAST_HYP h_simplest_elim;
-     clear_last;
-     intros ;
+    [generalize [c2];
+     h_simplest_elim c1;
+     intros;
      tclLAST_HYP h_simplest_case;
      clear_last;
      intros]
 
-let solveRightBranch  = 
-  tclTHEN h_simplest_right
+let solveNoteqBranch side = 
+  tclTHEN (choose_noteq side)
     (tclTHEN (intro_force true)
       (onLastHyp (fun id -> Extratactics.h_discrHyp (Rawterm.NamedHyp id))))
 
-let h_solveRightBranch =
-  Refiner.abstract_extended_tactic "solveRightBranch" [] solveRightBranch
-
-(*
-let h_solveRightBranch =
-  hide_atomic_tactic "solveRightBranch" solveRightBranch
-*)
+let h_solveNoteqBranch side =
+  Refiner.abstract_extended_tactic "solveNoteqBranch" [] 
+    (solveNoteqBranch side)
 
 (* Constructs the type {c1=c2}+{~c1=c2} *)
 
-let mkDecideEqGoal rectype c1 c2 g = 
+let mkDecideEqGoal eqonleft op rectype c1 c2 g = 
   let equality    = mkApp(build_coq_eq(), [|rectype; c1; c2|]) in
   let disequality = mkApp(build_coq_not (), [|equality|]) in
-  mkApp(build_coq_sumbool (), [|equality; disequality |])
+  if eqonleft then mkApp(op, [|equality; disequality |])
+  else mkApp(op, [|disequality; equality |])
 
 
 (* Constructs the type (x1,x2:R){x1=x2}+{~x1=x2} *)
@@ -97,42 +98,45 @@ let mkGenDecideEqGoal rectype g =
   and yname    = next_ident_away (id_of_string "y") hypnames in
   (mkNamedProd xname rectype 
      (mkNamedProd yname rectype 
-        (mkDecideEqGoal rectype (mkVar xname) (mkVar yname) g)))
+        (mkDecideEqGoal true (build_coq_sumbool ())
+          rectype (mkVar xname) (mkVar yname) g)))
 
-let eqCase  tac = 
+let eqCase tac = 
   (tclTHEN intro  
   (tclTHEN (tclLAST_HYP Extratactics.h_rewriteLR)
   (tclTHEN clear_last 
   tac)))
 
-let diseqCase = 
+let diseqCase eqonleft =
   let diseq  = id_of_string "diseq" in
   let absurd = id_of_string "absurd" in 
   (tclTHEN (intro_using diseq)
-  (tclTHEN  h_simplest_right
+  (tclTHEN (choose_noteq eqonleft)
   (tclTHEN  red_in_concl
   (tclTHEN  (intro_using absurd)
   (tclTHEN  (h_simplest_apply (mkVar diseq))
   (tclTHEN  (Extratactics.h_injHyp (Rawterm.NamedHyp absurd))
-            full_trivial))))))
+            (full_trivial [])))))))
 
-let solveArg a1 a2 tac  g = 
+let solveArg eqonleft op a1 a2 tac g = 
   let rectype = pf_type_of g a1 in
-  let decide  = mkDecideEqGoal rectype a1 a2 g in  
-  (tclTHENS
-     (h_elim_type decide) 
-     [(eqCase tac);diseqCase;default_auto]) g
+  let decide  = mkDecideEqGoal eqonleft op rectype a1 a2 g in
+  let subtacs = 
+    if eqonleft then [eqCase tac;diseqCase eqonleft;default_auto] 
+    else [diseqCase eqonleft;eqCase tac;default_auto] in
+  (tclTHENS (h_elim_type decide) subtacs) g
 
-let solveLeftBranch rectype g =
+let solveEqBranch rectype g =
   try
-    let (lhs,rhs) = match_eqdec_partial (pf_concl g) in
+    let (eqonleft,op,lhs,rhs,_) = match_eqdec (pf_concl g) in
     let (mib,mip) = Global.lookup_inductive rectype in
-    let nparams   = mip.mind_nparams in
+    let nparams   = mib.mind_nparams in
     let getargs l = list_skipn nparams (snd (decompose_app l)) in
     let rargs   = getargs rhs
     and largs   = getargs lhs in 
     List.fold_right2 
-      solveArg largs rargs (tclTHEN h_simplest_left h_reflexivity) g
+      (solveArg eqonleft op) largs rargs
+      (tclTHEN (choose_eq eqonleft) h_reflexivity) g
   with PatternMatchingFailure -> error "Unexpected conclusion!"
 
 (* The tactic Decide Equality *)
@@ -143,31 +147,33 @@ let hd_app c = match kind_of_term c with
 
 let decideGralEquality g =
   try
-    let typ = match_eqdec (pf_concl g) in
+    let eqonleft,_,c1,c2,typ = match_eqdec (pf_concl g) in
     let headtyp = hd_app (pf_compute g typ) in
     let rectype =
       match kind_of_term headtyp with
         | Ind mi -> mi
 	| _ -> error "This decision procedure only works for inductive objects"
-    in 
+    in
     (tclTHEN
-      mkBranches 
-      (tclORELSE h_solveRightBranch (solveLeftBranch rectype))) g
+      (mkBranches c1 c2)
+      (tclORELSE (h_solveNoteqBranch eqonleft) (solveEqBranch rectype)))
+    g
   with PatternMatchingFailure ->
-    error "The goal does not have the expected form"
+    error "The goal must be of the form {x<>y}+{x=y} or {x=y}+{x<>y}"
 
+let decideEqualityGoal = tclTHEN intros decideGralEquality
 
 let decideEquality c1 c2 g = 
   let rectype = (pf_type_of g c1) in     
   let decide  = mkGenDecideEqGoal rectype g in  
-  (tclTHENS (cut decide) [default_auto;decideGralEquality]) g
+  (tclTHENS (cut decide) [default_auto;decideEqualityGoal]) g
 
 
 (* The tactic Compare *)
 
 let compare c1 c2 g = 
   let rectype = pf_type_of g c1 in
-  let decide  = mkDecideEqGoal rectype c1 c2 g in  
+  let decide  = mkDecideEqGoal true (build_coq_sumbool ()) rectype c1 c2 g in  
   (tclTHENS (cut decide) 
             [(tclTHEN  intro 
              (tclTHEN (tclLAST_HYP simplest_case)
@@ -177,12 +183,11 @@ let compare c1 c2 g =
 
 (* User syntax *)
 
-TACTIC EXTEND DecideEquality
-  [ "Decide" "Equality" constr(c1) constr(c2) ] -> [ decideEquality c1 c2 ]
-| [ "Decide" "Equality" ] -> [ decideGralEquality ]
+TACTIC EXTEND decide_equality
+  [ "decide" "equality" constr(c1) constr(c2) ] -> [ decideEquality c1 c2 ]
+| [ "decide" "equality" ] -> [ decideEqualityGoal ]
 END
 
-TACTIC EXTEND Compare
-| [ "Compare" constr(c1) constr(c2) ] -> [ compare c1 c2 ]
+TACTIC EXTEND compare
+| [ "compare" constr(c1) constr(c2) ] -> [ compare c1 c2 ]
 END
-
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 994abb9d..be79c348 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: equality.ml,v 1.120.2.4 2004/11/21 22:24:09 herbelin Exp $ *)
+(* $Id: equality.ml 8677 2006-04-02 17:05:59Z herbelin $ *)
 
 open Pp
 open Util
@@ -20,7 +20,6 @@ open Inductiveops
 open Environ
 open Libnames
 open Reductionops
-open Instantiate
 open Typeops
 open Typing
 open Retyping
@@ -40,6 +39,7 @@ open Coqlib
 open Vernacexpr
 open Setoid_replace
 open Declarations
+open Indrec
 
 (* Rewriting tactics *)
 
@@ -48,10 +48,28 @@ open Declarations
    with type (A:<sort>)(x:A)(P:A->Prop)(P x)->(y:A)(eqname A y x)->(P y).
    If another equality myeq is introduced, then corresponding theorems
    myeq_ind_r, myeq_rec_r and myeq_rect_r have to be proven. See below.
-   -- Eduardo (19/8/97
+   -- Eduardo (19/8/97)
 *)
 
-let general_rewrite_bindings lft2rgt (c,l) gl =
+let general_s_rewrite_clause = function
+  | None -> general_s_rewrite
+  | Some id -> general_s_rewrite_in id
+
+(* Ad hoc asymmetric general_elim_clause *)
+let general_elim_clause cls c elim = match cls with
+  | None ->
+      (* was tclWEAK_PROGRESS which only fails for tactics generating one 
+         subgoal and did not fail for useless conditional rewritings generating
+         an extra condition *)
+      tclNOTSAMEGOAL (general_elim c elim ~allow_K:false)
+  | Some id ->
+      general_elim_in id c elim 
+
+let elimination_sort_of_clause = function
+  | None -> elimination_sort_of_goal
+  | Some id -> elimination_sort_of_hyp id
+
+let general_rewrite_bindings_clause cls lft2rgt (c,l) gl =
   let ctype = pf_type_of gl c in 
   let env = pf_env gl in
   let sigma = project gl in 
@@ -59,21 +77,27 @@ let general_rewrite_bindings lft2rgt (c,l) gl =
   match match_with_equation t with
     | None -> 
 	if l = NoBindings
-	then general_s_rewrite lft2rgt c gl
+	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 = Indrec.elimination_suffix (elimination_sort_of_goal gl)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 =
-	  if lft2rgt then
-            pf_global gl (id_of_string (hdcncls^suffix^"_r"))
-          else
-	    pf_global gl (id_of_string (hdcncls^suffix))
+	  try pf_global gl (id_of_string rwr_thm)
+          with Not_found ->
+            error ("Cannot find rewrite principle "^rwr_thm)
         in 
-	tclNOTSAMEGOAL (general_elim (c,l) (elim,NoBindings) ~allow_K:false) gl
-   (* was tclWEAK_PROGRESS which only fails for tactics generating one subgoal 
-      and did not fail for useless conditional rewritings generating an
-      extra condition *)
+	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)
+
+let general_rewrite_bindings_in l2r id =
+  general_rewrite_bindings_clause (Some id) l2r
+let general_rewrite_in l2r id c = 
+  general_rewrite_bindings_clause (Some id) l2r (c,NoBindings)
 
 (* Conditional rewriting, the success of a rewriting is related 
    to the resolution of the conditions by a given tactic *)
@@ -82,73 +106,69 @@ let conditional_rewrite lft2rgt tac (c,bl) =
   tclTHENSFIRSTn (general_rewrite_bindings lft2rgt (c,bl))
     [|tclIDTAC|] (tclCOMPLETE tac)
 
-let general_rewrite lft2rgt c = general_rewrite_bindings lft2rgt (c,NoBindings)
-
 let rewriteLR_bindings = general_rewrite_bindings true
 let rewriteRL_bindings = general_rewrite_bindings false
 
 let rewriteLR = general_rewrite true
 let rewriteRL = general_rewrite false
 
-(* The Rewrite in tactic *)
-let general_rewrite_in lft2rgt id (c,l) gl =
-  let ctype = pf_type_of gl c in 
-  let env = pf_env gl in
-  let sigma = project gl in 
-  let _,t = splay_prod env sigma ctype in
-  match match_with_equation t with
-    | None -> (* Do not deal with setoids yet *) 
-        error "The term provided does not end with an equation" 
-    | Some (hdcncl,_) -> 
-        let hdcncls = string_of_inductive hdcncl in 
-	let suffix =
-          Indrec.elimination_suffix (elimination_sort_of_hyp id gl) in
-        let rwr_thm =
-          if lft2rgt then hdcncls^suffix else hdcncls^suffix^"_r" 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_in id (c,l) (elim,NoBindings) gl
-
-let rewriteLRin = general_rewrite_in true
-let rewriteRLin = general_rewrite_in false
+let rewriteLRin_bindings = general_rewrite_bindings_in true
+let rewriteRLin_bindings = general_rewrite_bindings_in false
 
 let conditional_rewrite_in lft2rgt id tac (c,bl) = 
-  tclTHENSFIRSTn (general_rewrite_in lft2rgt id (c,bl))
+  tclTHENSFIRSTn (general_rewrite_bindings_in lft2rgt id (c,bl))
     [|tclIDTAC|] (tclCOMPLETE tac)
 
 let rewriteRL_clause = function
   | None -> rewriteRL_bindings
-  | Some id -> rewriteRLin id
+  | Some id -> rewriteRLin_bindings id
 
 (* Replacing tactics *)
 
-(* eqt,sym_eqt : equality on Type and its symmetry theorem
+(* eq,sym_eq : equality on Type and its symmetry theorem
    c2 c1 : c1 is to be replaced by c2
    unsafe : If true, do not check that c1 and c2 are convertible
+   tac : Used to prove the equality c1 = c2 
    gl : goal *)
 
-let abstract_replace clause c2 c1 unsafe gl =
+let abstract_replace clause c2 c1 unsafe tac gl =
   let t1 = pf_type_of gl c1 
   and t2 = pf_type_of gl c2 in
   if unsafe or (pf_conv_x gl t1 t2) then
-    let e = (build_coq_eqT_data ()).eq in
-    let sym = (build_coq_eqT_data ()).sym in
+    let e = build_coq_eq () in
+    let sym = build_coq_sym_eq () in
     let eq = applist (e, [t1;c1;c2]) in
     tclTHENS (assert_tac false Anonymous eq)
       [onLastHyp (fun id -> 
 	tclTHEN 
 	  (tclTRY (rewriteRL_clause clause (mkVar id,NoBindings)))
 	  (clear [id]));
-       tclORELSE assumption 
-	(tclTRY (tclTHEN (apply sym) assumption))] gl
+       tclFIRST
+	 [assumption;
+	  tclTHEN (apply sym) assumption;
+	  tclTRY (tclCOMPLETE tac)
+	 ]
+      ] gl
   else
     error "terms does not have convertible types"
 
-let replace c2 c1 gl = abstract_replace None c2 c1 false gl
 
-let replace_in id c2 c1 gl = abstract_replace (Some id) c2 c1 false 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_by c2 c1 tac gl = abstract_replace None c2 c1 false tac gl
+
+let replace_in_by id c2 c1 tac gl = abstract_replace (Some id) c2 c1 false 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
 
 (* End of Eduardo's code. The rest of this file could be improved
    using the functions match_with_equation, etc that I defined
@@ -156,24 +176,8 @@ let replace_in id c2 c1 gl = abstract_replace (Some id) c2 c1 false gl
    -- Eduardo (19/8/97)
 *)
 
-(* Tactics for equality reasoning with the "eq"  or "eqT"
-   relation This code  will work with any equivalence relation which 
-   is substitutive *)
-
-(* Patterns *)
-
-let build_coq_eq eq = eq.eq
-let build_ind eq = eq.ind
-let build_rect eq = 
-  match eq.rect with
-    | None -> assert false
-    | Some c -> c
-	  
-(*********** List of constructions depending of the initial state *)
-
-let find_eq_pattern aritysort sort = 
-  (* "eq" now accept arguments in Type and elimination to Type *)
-  Coqlib.build_coq_eq ()
+(* Tactics for equality reasoning with the "eq" relation. This code
+   will work with any equivalence relation which is substitutive *)
 
 (* [find_positions t1 t2]
 
@@ -317,7 +321,7 @@ let discriminable env sigma t1 t2 =
    the continuation then constructs the case-split.
  *)
 let descend_then sigma env head dirn =
-  let IndType (indf,_) as indt =
+  let IndType (indf,_) =
     try find_rectype env sigma (get_type_of env sigma head)
     with Not_found -> assert false in
   let ind,_ = dest_ind_family indf in
@@ -360,7 +364,7 @@ let descend_then sigma env head dirn =
    giving [True], and all the rest giving False. *)
 
 let construct_discriminator sigma env dirn c sort =
-  let (IndType(indf,_) as indt) =
+  let IndType(indf,_) =
     try find_rectype env sigma (type_of env sigma c)
     with Not_found ->
        (* one can find Rel(k) in case of dependent constructors 
@@ -395,8 +399,7 @@ let rec build_discriminator sigma env dirn c sort = function
 	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 _,arsort = get_arity env indf in
-      let nparams = mip.mind_nparams  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 = build_discriminator sigma cnum_env dirn newc sort l  in
@@ -420,7 +423,7 @@ let gen_absurdity id gl =
 let discrimination_pf e (t,t1,t2) discriminator lbeq gls =
   let i           = build_coq_I () in
   let absurd_term = build_coq_False () in
-  let eq_elim     = build_ind lbeq in
+  let eq_elim     = lbeq.ind in
   (applist (eq_elim, [t;t1;mkNamedLambda e t discriminator;i;t2]), absurd_term)
 
 exception NotDiscriminable
@@ -437,7 +440,6 @@ let discrEq (lbeq,(t,t1,t2)) id gls =
 	 let e_env = push_named (e,None,t) env in
 	 let discriminator =
 	   build_discriminator sigma e_env dirn (mkVar e) sort cpath in
-	 let (indt,_) = find_mrectype env sigma t in 
 	 let (pf, absurd_term) =
 	   discrimination_pf e (t,t1,t2) discriminator lbeq gls 
 	 in
@@ -457,22 +459,16 @@ let onEquality tac id gls =
       errorlabstrm "" (pr_id id ++ str": not a primitive equality") 
   in tac eq id gls
 
-let check_equality tac id gls =
-  let eqn = pf_whd_betadeltaiota gls (pf_get_hyp_typ gls id) in
+let onNegatedEquality tac gls =
+  let ccl = pf_concl gls in
   let eq =
-    try find_eq_data_decompose eqn
+    try match kind_of_term (hnf_constr (pf_env gls) (project gls) ccl) with
+      | Prod (_,t,u) when is_empty_type u ->
+          find_eq_data_decompose (pf_whd_betadeltaiota gls t)
+      | _ -> raise PatternMatchingFailure
     with PatternMatchingFailure ->
-      errorlabstrm "" (str "The goal should negate an equality")
-  in tac eq id gls
-
-let onNegatedEquality tac gls =
-   if is_matching_not (pf_concl gls) then
-     (tclTHEN (tclTHEN hnf_in_concl intro) (onLastHyp(check_equality tac))) gls
-   else if is_matching_imp_False (pf_concl gls)then
-     (tclTHEN intro (onLastHyp (check_equality tac))) gls
-  else
-    errorlabstrm "extract_negated_equality_then"
-      (str"The goal should negate an equality")
+      errorlabstrm "" (str "Not a negated primitive equality")
+  in tclTHEN introf (onLastHyp (tac eq)) gls
 
 let discrSimpleClause = function
   | None -> onNegatedEquality discrEq
@@ -577,33 +573,34 @@ let minimal_free_rels env sigma (c,cty) =
 
  *)
 
-let sig_clausal_form env sigma sort_of_ty siglen ty (dFLT,dFLTty) =
+let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
   let { intro = exist_term } = find_sigma_data sort_of_ty in 
-  let isevars = Evarutil.create_evar_defs sigma in
+  let isevars = ref (Evd.create_evar_defs sigma) in
   let rec sigrec_clausal_form siglen p_i =
     if siglen = 0 then
-      if Evarconv.the_conv_x_leq env isevars dFLTty p_i then
+      (* is the default value typable with the expected type *)
+      let dflt_typ = type_of env sigma dflt in
+      if Evarconv.e_cumul env isevars dflt_typ p_i then
 	(* the_conv_x had a side-effect on isevars *)
-	dFLT
+	dflt
       else
 	error "Cannot solve an unification problem"
     else
       let (a,p_i_minus_1) = match whd_beta_stack p_i with
 	| (_sigS,[a;p]) -> (a,p)
  	| _ -> anomaly "sig_clausal_form: should be a sigma type" in
-      let ev = Evarutil.new_isevar isevars env (dummy_loc,InternalHole)
-	(Evarutil.new_Type ()) in
+      let ev = Evarutil.e_new_evar isevars env a in
       let rty = beta_applist(p_i_minus_1,[ev]) in
       let tuple_tail = sigrec_clausal_form (siglen-1) rty in
       match
-	Instantiate.existential_opt_value (Evarutil.evars_of isevars) 
+	Evd.existential_opt_value (Evd.evars_of !isevars) 
 	(destEvar ev)
       with
 	| Some w -> applist(exist_term,[a;p_i_minus_1;w;tuple_tail])
 	| None -> anomaly "Not enough components to build the dependent tuple"
   in
   let scf = sigrec_clausal_form siglen ty in
-  Evarutil.nf_evar (Evarutil.evars_of isevars) scf
+  Evarutil.nf_evar (Evd.evars_of !isevars) scf
 
 (* The problem is to build a destructor (a generalization of the
    predecessor) which, when applied to a term made of constructors
@@ -675,25 +672,23 @@ let make_iterated_tuple env sigma dflt (z,zty) =
   let dfltval = sig_clausal_form env sigma sort_of_zty n tuplety dflt in
   (tuple,tuplety,dfltval)
 
-let rec build_injrec sigma env (t1,t2) c = function
-  | [] ->
-      make_iterated_tuple env sigma (t1,type_of env sigma t1)
-        (c,type_of env sigma c)
+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 = mip.mind_nparams 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 (t1,t2) newc l
+      	build_injrec sigma cnum_env dflt newc l
       in
       (kont subval (dfltval,tuplety),
        tuplety,dfltval)
 
-let build_injector sigma env (t1,t2) c cpath =
-  let (injcode,resty,_) = build_injrec sigma env (t1,t2) c cpath in
+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 =
@@ -702,7 +697,7 @@ let try_delta_expand env sigma t =
     match kind_of_term c with
       | Construct _ -> whdt
       | App (f,_)  -> hd_rec f
-      | Cast (c,_) -> hd_rec c
+      | Cast (c,_,_) -> hd_rec c
       | _  -> t
   in 
   hd_rec whdt 
@@ -730,7 +725,8 @@ let injEq (eq,(t,t1,t2)) id gls =
 	    (fun (cpath,t1_0,t2_0) ->
 	      try 
 		let (injbody,resty) =
-		  build_injector sigma e_env (t1_0,t2_0) (mkVar e) cpath in
+                  (* 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 ->
@@ -794,7 +790,8 @@ let decompEqThen ntac (lbeq,(t,t1,t2)) id gls =
 	    map_succeed
 	      (fun (cpath,t1_0,t2_0) ->
 		 let (injbody,resty) =
-		   build_injector sigma e_env (t1_0,t2_0) (mkVar e) cpath in
+                  (* 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)
@@ -833,67 +830,37 @@ let swap_equands gls eqn =
 let swapEquandsInConcl gls =
   let (lbeq,(t,e1,e2)) = find_eq_data_decompose (pf_concl gls) in
   let sym_equal = lbeq.sym in
-  refine (applist(sym_equal,[t;e2;e1;mkMeta (Clenv.new_meta())])) gls
+  refine (applist(sym_equal,[t;e2;e1;Evarutil.mk_new_meta()])) gls
 
 let swapEquandsInHyp id gls =
-  ((tclTHENS (cut_replacing id (swap_equands gls (pf_get_hyp_typ gls id)))
-      ([tclIDTAC;
-      	(tclTHEN (swapEquandsInConcl) (exact_no_check (mkVar id)))]))) gls
+  cut_replacing id (swap_equands gls (pf_get_hyp_typ gls id))
+    (tclTHEN swapEquandsInConcl) gls
 
 (* find_elim determines which elimination principle is necessary to
-   eliminate lbeq on sort_of_gl. It yields the boolean true wether
-   it is a dependent elimination principle (as idT.rect) and false
-   otherwise *)
+   eliminate lbeq on sort_of_gl.
+   This is somehow an artificial choice as we could take eq_rect in
+   all cases (eq_ind - and eq_rec - are instances of eq_rect) [HH 2/4/06].
+*)
 
-let find_elim  sort_of_gl  lbeq =
+let find_elim sort_of_gl lbeq =
   match kind_of_term sort_of_gl  with
-    | Sort(Prop Null)  (* Prop *)  -> (lbeq.ind, false)  
-    | Sort(Prop Pos)   (* Set *)   ->  
-	(match lbeq.rrec with
-           | Some eq_rec -> (eq_rec, false) 
-	   | None -> errorlabstrm "find_elim"
-		 (str "this type of elimination is not allowed"))
-    | _ (* Type *) -> 
+    | Sort(Prop Null)  (* Prop *)  -> lbeq.ind
+    | _ (* Set/Type *) -> 
         (match lbeq.rect with
-           | Some eq_rect -> (eq_rect, true) 
+           | Some eq_rect -> eq_rect
            | None -> errorlabstrm "find_elim"
-		 (str "this type of elimination is not allowed"))
-
-(* builds a predicate [e:t][H:(lbeq t e t1)](body e)
-   to be used as an argument for equality dependent elimination principle:
-   Preconditon: dependent body (mkRel 1) *)
-
-let build_dependent_rewrite_predicate (t,t1,t2) body lbeq gls =
-  let e = pf_get_new_id  (id_of_string "e") gls in 
-  let h = pf_get_new_id  (id_of_string "HH") gls in 
-  let eq_term = lbeq.eq in
-  (mkNamedLambda e t 
-     (mkNamedLambda h (applist (eq_term, [t;t1;(mkRel 1)])) 
-        (lift 1 body))) 
-
-(* builds a predicate [e:t](body e) ???
-   to be used as an argument for equality non-dependent elimination principle:
-   Preconditon: dependent body (mkRel 1) *)
+		 (str "this type of substitution is not allowed"))
 
-let build_non_dependent_rewrite_predicate (t,t1,t2) body gls =
-  lambda_create (pf_env gls) (t,body)
+(* Refine from [|- P e2] to [|- P e1] and [|- e1=e2:>t] (body is P (Rel 1)) *)
 
 let bareRevSubstInConcl lbeq body (t,e1,e2) gls =
-  let (eq_elim,dep) =
-    try 
-      find_elim (pf_type_of gls (pf_concl gls)) lbeq  
-    with e when catchable_exception e -> 
-      errorlabstrm "RevSubstIncConcl"
-        (str "this type of substitution is not allowed")  
-  in 
-  let p =
-    if dep then
-      (build_dependent_rewrite_predicate (t,e1,e2)  body lbeq gls)
-    else
-      (build_non_dependent_rewrite_predicate (t,e1,e2)  body  gls)
-  in
-  refine (applist(eq_elim,[t;e1;p;mkMeta(Clenv.new_meta());
-                           e2;mkMeta(Clenv.new_meta())])) gls
+  (* find substitution scheme *)
+  let eq_elim = find_elim (pf_type_of gls (pf_concl gls)) lbeq in
+  (* build substitution predicate *)
+  let p = lambda_create (pf_env gls) (t,body) in
+  (* apply substitution scheme *)
+  refine (applist(eq_elim,[t;e1;p;Evarutil.mk_new_meta();
+                           e2;Evarutil.mk_new_meta()])) gls
 
 (* [subst_tuple_term dep_pair B]
 
@@ -925,8 +892,7 @@ let bareRevSubstInConcl lbeq body (t,e1,e2) gls =
 let decomp_tuple_term env c t = 
   let rec decomprec inner_code ex exty =
     try
-      let {proj1 = p1; proj2 = p2 },(a,p,car,cdr) =
-	find_sigma_data_decompose ex in
+      let {proj1=p1; proj2=p2},(a,p,car,cdr) = find_sigma_data_decompose ex in
       let car_code = applist (p1,[a;p;inner_code])
       and cdr_code = applist (p2,[a;p;inner_code]) in
       let cdrtyp = beta_applist (p,[car]) in
@@ -942,48 +908,41 @@ let subst_tuple_term env sigma dep_pair b =
   let abst_B =
     List.fold_right
       (fun (e,t) body -> lambda_create env (t,subst_term e body)) e_list b in
-  let app_B = applist(abst_B,proj_list) in app_B
+  applist(abst_B,proj_list)
     
-(* |- (P e2)
-     BY RevSubstInConcl (eq T e1 e2)
-     |- (P e1)
-     |- (eq T e1 e2)
- *)
-(* Redondant avec Replace ! *)
+(* Comme "replace" mais decompose les egalites dependantes *)
 
-let substInConcl_RL eqn gls =
-  let (lbeq,(t,e1,e2)) = find_eq_data_decompose eqn in
-  let body = subst_tuple_term (pf_env gls) (project gls) e2 (pf_concl gls) in
+let cutSubstInConcl_RL eqn gls =
+  let (lbeq,(t,e1,e2 as eq)) = find_eq_data_decompose eqn in
+  let body = pf_apply subst_tuple_term gls e2 (pf_concl gls) in
   assert (dependent (mkRel 1) body);
-  bareRevSubstInConcl lbeq body (t,e1,e2) gls
+  bareRevSubstInConcl lbeq body eq gls
 
 (* |- (P e1)
-     BY SubstInConcl (eq T e1 e2)
+     BY CutSubstInConcl_LR (eq T e1 e2)
      |- (P e2)
      |- (eq T e1 e2)
  *)
-let substInConcl_LR eqn gls =
-  (tclTHENS (substInConcl_RL (swap_equands gls eqn))
+let cutSubstInConcl_LR eqn gls =
+  (tclTHENS (cutSubstInConcl_RL (swap_equands gls eqn))
      ([tclIDTAC;
        swapEquandsInConcl])) gls
 
-let substInConcl l2r = if l2r then substInConcl_LR else substInConcl_RL
+let cutSubstInConcl l2r =if l2r then cutSubstInConcl_LR else cutSubstInConcl_RL
 
-let substInHyp_LR eqn id gls =
-  let (lbeq,(t,e1,e2)) = find_eq_data_decompose eqn in 
-  let body = subst_term e1 (pf_get_hyp_typ gls id) in
-  if not (dependent (mkRel 1) body) then errorlabstrm  "SubstInHyp" (mt ());
-  (tclTHENS (cut_replacing id (subst1 e2 body))
-     ([tclIDTAC;
-       (tclTHENS (bareRevSubstInConcl lbeq body (t,e1,e2))
-          ([exact_no_check (mkVar id);tclIDTAC]))])) gls
+let cutSubstInHyp_LR eqn id gls =
+  let (lbeq,(t,e1,e2 as eq)) = find_eq_data_decompose eqn in 
+  let body = pf_apply subst_tuple_term gls e1 (pf_get_hyp_typ gls id) in
+  assert (dependent (mkRel 1) body);
+  cut_replacing id (subst1 e2 body)
+    (tclTHENFIRST (bareRevSubstInConcl lbeq body eq)) gls
 
-let substInHyp_RL eqn id gls =
-  (tclTHENS (substInHyp_LR (swap_equands gls eqn) id)
+let cutSubstInHyp_RL eqn id gls =
+  (tclTHENS (cutSubstInHyp_LR (swap_equands gls eqn) id)
      ([tclIDTAC;
        swapEquandsInConcl])) gls
 
-let substInHyp l2r = if l2r then substInHyp_LR else substInHyp_RL
+let cutSubstInHyp l2r = if l2r then cutSubstInHyp_LR else cutSubstInHyp_RL
 
 let try_rewrite tac gls =
   try 
@@ -996,77 +955,51 @@ let try_rewrite tac gls =
           (str "Cannot find a well-typed generalization of the goal that" ++
              str " makes the proof progress")
 
-let subst l2r eqn cls gls =
+let cutSubstClause l2r eqn cls gls =
   match cls with
-    | None ->    substInConcl l2r eqn gls
-    | Some id -> substInHyp l2r eqn id gls
+    | None ->    cutSubstInConcl l2r eqn gls
+    | Some id -> cutSubstInHyp l2r eqn id gls
 
-(* |- (P a)
- * SubstConcl_LR a=b 
- *  |- (P b)
- *  |- a=b
- *)
+let cutRewriteClause l2r eqn cls = try_rewrite (cutSubstClause l2r eqn cls)
+let cutRewriteInHyp l2r eqn id = cutRewriteClause l2r eqn (Some id)
+let cutRewriteInConcl l2r eqn = cutRewriteClause l2r eqn None
 
-let substConcl l2r eqn gls = try_rewrite (subst l2r eqn None) gls
-let substConcl_LR = substConcl true
+let substClause l2r c cls gls =
+  let eq = pf_type_of gls c in
+  tclTHENS (cutSubstClause l2r eq cls) [tclIDTAC; exact_no_check c] gls
 
-(* id:(P a) |- G
- * SubstHyp a=b id
- *  id:(P b) |- G
- *  id:(P a) |-a=b
-*)
+let rewriteClause l2r c cls = try_rewrite (substClause l2r c cls)
+let rewriteInHyp l2r c id = rewriteClause l2r c (Some id)
+let rewriteInConcl l2r c = rewriteClause l2r c None
 
-let hypSubst l2r id cls gls =
-  onClauses (function
-    | None -> 
-	(tclTHENS (substInConcl l2r (pf_get_hyp_typ gls id))
-	   ([tclIDTAC; exact_no_check (mkVar id)]))
-    | Some (hypid,_,_) -> 
-	(tclTHENS (substInHyp l2r (pf_get_hyp_typ gls id) hypid)
-	   ([tclIDTAC;exact_no_check (mkVar id)])))
-    cls gls
+(* Renaming scheme correspondence new name (old name)
 
-let hypSubst_LR = hypSubst true
+      give equality                    give proof of equality
 
-(* id:a=b |- (P a)
- * HypSubst id.
- *  id:a=b |- (P b)
- *)
-let substHypInConcl l2r id gls = try_rewrite (hypSubst l2r id onConcl) gls
-let substHypInConcl_LR = substHypInConcl true
+    / cutSubstClause (subst)          substClause (HypSubst on hyp)
+raw | cutSubstInHyp (substInHyp)      substInHyp (none)
+    \ cutSubstInConcl (substInConcl)  substInConcl (none) 
 
-(* id:a=b H:(P a) |- G
-   SubstHypInHyp id H.
-    id:a=b H:(P b) |- G
-*)
-(* |- (P b)
-   SubstConcl_RL a=b
-     |- (P a)
-     |- a=b
-*)
-let substConcl_RL = substConcl false
+    / cutRewriteClause (none)         rewriteClause (none)
+user| cutRewriteInHyp (substHyp)      rewriteInHyp (none)
+    \ cutRewriteInConcl (substConcl)  rewriteInConcl (substHypInConcl on hyp)
 
-(* id:(P b) |-G
-   SubstHyp_RL a=b id 
-      id:(P a) |- G
-      |- a=b  
+raw = raise typing error or PatternMatchingFailure
+user = raise user error specific to rewrite
 *)
-let substHyp l2r eqn id gls = try_rewrite (subst l2r eqn (Some id)) gls
-let substHyp_RL = substHyp false
 
+(* Summary of obsolete forms
+let substInConcl = cutSubstInConcl
+let substInHyp = cutSubstInHyp
+let hypSubst l2r id = substClause l2r (mkVar id)
+let hypSubst_LR = hypSubst true
 let hypSubst_RL = hypSubst false
-
-(* id:a=b |- (P b)
- * HypSubst id.
- * id:a=b |- (P a)
- *)
-let substHypInConcl_RL = substHypInConcl false
-
-(* id:a=b H:(P b) |- G
-   SubstHypInHyp id H.
-    id:a=b H:(P a) |- G
+let substHypInConcl l2r id = rewriteInConcl l2r (mkVar id)
+let substConcl = cutRewriteInConcl
+let substHyp = cutRewriteInHyp
 *)
 
+(**********************************************************************)
 (* Substitutions tactics (JCF) *)
 
 let unfold_body x gl =
@@ -1077,13 +1010,12 @@ let unfold_body x gl =
       | _ -> errorlabstrm "unfold_body"
           (pr_id x ++ str" is not a defined hypothesis") in
   let aft = afterHyp x gl in
-  let hl = List.fold_right
-    (fun (y,yval,_) cl -> (y,[],(InHyp,ref None)) :: cl) aft [] in
+  let hl = List.fold_right (fun (y,yval,_) cl -> (y,[],InHyp) :: cl) aft [] in
   let xvar = mkVar x in
   let rfun _ _ c = replace_term xvar xval c in
   tclTHENLIST
     [tclMAP (fun h -> reduct_in_hyp rfun h) hl;
-     reduct_in_concl rfun] gl
+     reduct_in_concl (rfun,DEFAULTcast)] gl
 
 
 
@@ -1135,8 +1067,10 @@ let subst_one x gl =
   let introtac = function
       (id,None,_) -> intro_using id
     | (id,Some hval,htyp) ->
-        forward true (Name id) (mkCast(replace_term varx rhs hval,
-                                       replace_term varx rhs htyp)) in
+        letin_tac true (Name id)
+	  (mkCast(replace_term varx rhs hval,DEFAULTcast,
+	          replace_term varx rhs htyp)) nowhere
+  in
   let need_rewrite = dephyps <> [] || depconcl in
   tclTHENLIST 
     ((if need_rewrite then
@@ -1181,7 +1115,7 @@ let rewrite_assumption_cond_in faildir hyp gl =
       | [] -> error "No such assumption"
       | (id,_,t)::rest -> 
 	  (try let dir = faildir t gl in 
-	       general_rewrite_in dir hyp ((mkVar id),NoBindings) gl
+	       general_rewrite_in dir hyp (mkVar id) gl
 	   with Failure _ | UserError _ ->  arec rest)
    in arec (pf_hyps gl)
 
@@ -1216,3 +1150,6 @@ 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 _ = Setoid_replace.register_replace replace
+let _ = Setoid_replace.register_general_rewrite general_rewrite
diff --git a/tactics/equality.mli b/tactics/equality.mli
index ab439c39..3e4bfed7 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,v 1.26.2.1 2004/07/16 19:30:53 herbelin Exp $ i*)
+(*i $Id: equality.mli 8651 2006-03-21 21:54:43Z jforest $ i*)
 
 (*i*)
 open Names
@@ -24,24 +24,34 @@ open Tacexpr
 open Rawterm
 (*i*)
 
-val find_eq_pattern : sorts -> sorts -> constr
-
 val general_rewrite_bindings : bool -> constr with_bindings -> tactic
 val general_rewrite          : bool -> constr -> tactic
-val rewriteLR_bindings       : constr with_bindings -> tactic
-val rewriteRL_bindings       : constr with_bindings -> tactic
 
+(* Obsolete, use [general_rewrite_bindings l2r]
+[val rewriteLR_bindings       : constr with_bindings -> tactic]
+[val rewriteRL_bindings       : constr with_bindings -> tactic]
+*)
+
+(* Equivalent to [general_rewrite l2r] *)
 val rewriteLR   : constr -> tactic
 val rewriteRL   : constr  -> tactic
 
+(* Warning: old [general_rewrite_in] is now [general_rewrite_bindings_in] *)
+
+val general_rewrite_bindings_in :
+  bool -> identifier -> constr with_bindings -> tactic
+val general_rewrite_in          :
+  bool -> identifier -> constr -> tactic
+
 val conditional_rewrite : bool -> tactic -> constr with_bindings -> tactic
-val general_rewrite_in : bool -> identifier -> constr with_bindings -> tactic
 val conditional_rewrite_in :
   bool -> identifier -> tactic -> constr with_bindings -> 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 discr        : identifier -> tactic
 val discrConcl   : tactic
 val discrClause  : clause -> tactic
@@ -55,15 +65,38 @@ val dEq : quantified_hypothesis option -> tactic
 val dEqThen : (int -> tactic) -> quantified_hypothesis option -> tactic
 
 val make_iterated_tuple : 
-  env -> evar_map -> (constr * constr) -> (constr * constr) 
-    -> constr * constr * constr
+  env -> evar_map -> constr -> (constr * types) -> constr * constr * constr
 
+(* The family cutRewriteIn expect an equality statement *)
+val cutRewriteInHyp : bool -> types -> identifier -> tactic
+val cutRewriteInConcl : bool -> constr -> tactic
+
+(* The family rewriteIn expect the proof of an equality *)
+val rewriteInHyp : bool -> constr -> identifier -> tactic
+val rewriteInConcl : bool -> constr -> tactic
+
+(* Expect the proof of an equality; fails with raw internal errors *)
+val substClause : bool -> constr -> identifier option -> tactic
+
+(*
+(* [substHypInConcl l2r id] is obsolete: use [rewriteInConcl l2r (mkVar id)] *)
 val substHypInConcl : bool -> identifier -> tactic
+
+(* [substConcl] is an obsolete synonym for [cutRewriteInConcl] *)
 val substConcl : bool -> constr -> tactic
-val substHyp : bool -> constr -> identifier -> tactic
 
-val hypSubst_LR : identifier -> clause -> tactic
-val hypSubst_RL : identifier -> clause -> tactic
+(* [substHyp] is an obsolete synonym of [cutRewriteInHyp] *)
+val substHyp : bool -> types -> identifier -> tactic
+*)
+
+(* Obsolete, use [rewriteInConcl lr (mkVar id)] in concl
+              or [rewriteInHyp lr (mkVar id) (Some hyp)] in hyp
+   (which, if they fail, raise only UserError, not PatternMatchingFailure)
+   or [substClause lr (mkVar id) None]
+   or [substClause lr (mkVar id) (Some hyp)]
+[val hypSubst_LR : identifier -> clause -> tactic]
+[val hypSubst_RL : identifier -> clause -> tactic]
+*)
 
 val discriminable : env -> evar_map -> constr -> constr -> bool
 
diff --git a/tactics/evar_tactics.ml b/tactics/evar_tactics.ml
new file mode 100644
index 00000000..73f88206
--- /dev/null
+++ b/tactics/evar_tactics.ml
@@ -0,0 +1,75 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: evar_tactics.ml 7875 2006-01-16 09:55:24Z herbelin $ *)
+
+open Term
+open Util
+open Evar_refiner
+open Tacmach
+open Tacexpr
+open Proof_type
+open Evd
+open Sign
+open Termops
+
+(* The instantiate tactic *)
+
+let evar_list evc c = 
+  let rec evrec acc c =
+    match kind_of_term c with
+    | Evar (n, _) when Evd.in_dom evc n -> c :: acc
+    | _ -> fold_constr evrec acc c
+  in 
+    evrec [] c
+
+let instantiate n rawc ido gl = 
+  let sigma = gl.sigma in
+  let evl = 
+    match ido with
+	ConclLocation () -> evar_list sigma gl.it.evar_concl 
+      | HypLocation (id,hloc) ->
+	  let decl = Environ.lookup_named_val id gl.it.evar_hyps in
+	    match hloc with
+		InHyp ->  
+		  (match decl with 
+		       (_,None,typ) -> evar_list sigma typ
+		     | _ -> error 
+			 "please be more specific : in type or value ?")
+	      | InHypTypeOnly ->
+		  let (_, _, typ) = decl in evar_list sigma typ
+	      | InHypValueOnly ->
+		  (match decl with 
+		       (_,Some body,_) -> evar_list sigma body
+		     | _ -> error "not a let .. in  hypothesis") in
+    if List.length evl < n then
+      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
+    Refiner.tclEVARS (evars_of evd') gl
+	
+(*
+let pfic gls c =
+  let evc = gls.sigma in 
+  Constrintern.interp_constr evc (Global.env_of_context gls.it.evar_hyps) c
+
+let instantiate_tac = function
+  | [Integer n; Command com] ->
+      (fun gl -> instantiate n (pfic gl com) gl)
+  | [Integer n; Constr c] ->
+      (fun gl -> instantiate n c gl)
+  | _ -> invalid_arg "Instantiate called with bad arguments"
+*)
+
+let let_evar name typ gls =
+  let evd = Evd.create_evar_defs gls.sigma in
+  let evd',evar = Evarutil.new_evar evd (pf_env gls) typ in
+  Refiner.tclTHEN (Refiner.tclEVARS (evars_of evd'))
+    (Tactics.letin_tac true name evar nowhere) gls
+ 
diff --git a/theories7/Init/Prelude.v b/tactics/evar_tactics.mli
index 2752f462..dbf7db31 100755..100644
--- a/theories7/Init/Prelude.v
+++ b/tactics/evar_tactics.mli
@@ -6,11 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Prelude.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+(*i $Id: evar_tactics.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
-Require Export Notations.
-Require Export Logic.
-Require Export Datatypes.
-Require Export Specif.
-Require Export Peano.
-Require Export Wf.
+open Tacmach
+open Names
+open Tacexpr
+
+val instantiate : int -> Rawterm.rawconstr -> 
+  (identifier * hyp_location_flag, unit) location -> tactic
+
+(*i
+val instantiate_tac : tactic_arg list -> tactic
+i*)
+
+val let_evar : name -> Term.types -> tactic
diff --git a/tactics/extraargs.ml4 b/tactics/extraargs.ml4
index 34348834..ca1e43cb 100644
--- a/tactics/extraargs.ml4
+++ b/tactics/extraargs.ml4
@@ -8,24 +8,118 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: extraargs.ml4,v 1.5.2.1 2004/07/16 19:30:53 herbelin Exp $ *)
+(* $Id: extraargs.ml4 7841 2006-01-11 11:24:54Z herbelin $ *)
 
 open Pp
 open Pcoq
 open Genarg
+open Names
+open Tacexpr
+open Tacinterp
 
 (* Rewriting orientation *)
 
 let _ = Metasyntax.add_token_obj "<-"
 let _ = Metasyntax.add_token_obj "->"
 
-let pr_orient _prc _prt = function
+let pr_orient _prc _prlc _prt = function
   | true -> Pp.mt ()
   | false -> Pp.str " <-"
 
+
 ARGUMENT EXTEND orient TYPED AS bool PRINTED BY pr_orient
 | [ "->" ] -> [ true ]
 | [ "<-" ] -> [ false ]
 | [ ] -> [ true ]
 END
 
+(* For Setoid rewrite *)
+let pr_morphism_signature _ _ _ = Setoid_replace.pr_morphism_signature
+
+ARGUMENT EXTEND morphism_signature
+ TYPED AS morphism_signature
+ PRINTED BY pr_morphism_signature
+  | [ constr(out) ] -> [ [],out ]
+  | [ constr(c) "++>" morphism_signature(s) ] ->
+       [ let l,out = s in (Some true,c)::l,out ]
+  | [ constr(c) "-->" morphism_signature(s) ] ->
+       [ let l,out = s in (Some false,c)::l,out ]
+  | [ constr(c) "==>" morphism_signature(s) ] ->
+       [ let l,out = s in (None,c)::l,out ]
+END
+
+let pr_gen prc _prlc _prtac c = prc c
+
+let pr_rawc _prc _prlc _prtac raw = Printer.pr_rawconstr raw
+
+let interp_raw _ _ (t,_) = t
+
+let glob_raw = Tacinterp.intern_constr
+
+let subst_raw = Tacinterp.subst_rawconstr_and_expr
+
+ARGUMENT EXTEND raw
+    TYPED AS rawconstr
+    PRINTED BY pr_rawc
+     
+     INTERPRETED BY interp_raw	
+     GLOBALIZED BY glob_raw
+     SUBSTITUTED BY subst_raw
+     
+     RAW_TYPED AS constr_expr
+     RAW_PRINTED BY pr_gen
+     
+     GLOB_TYPED AS rawconstr_and_expr
+     GLOB_PRINTED BY pr_gen
+  [ lconstr(c) ] -> [ c ]
+END
+
+type 'id gen_place= ('id * hyp_location_flag,unit) location
+
+type loc_place = identifier Util.located gen_place
+type place = identifier gen_place
+
+let pr_gen_place pr_id = function
+    ConclLocation () -> Pp.mt ()
+  | HypLocation (id,InHyp) -> str "in " ++ pr_id id
+  | HypLocation (id,InHypTypeOnly) -> 
+      str "in (Type of " ++ pr_id id ++ str ")"
+  | HypLocation (id,InHypValueOnly) -> 
+      str "in (Value of " ++ pr_id id ++ str ")"
+
+let pr_loc_place _ _ _ = pr_gen_place (fun (_,id) -> Nameops.pr_id id)
+let pr_place _ _ _ = pr_gen_place Nameops.pr_id
+
+let intern_place ist = function
+    ConclLocation () -> ConclLocation ()
+  | HypLocation (id,hl) -> HypLocation (intern_hyp ist id,hl)
+
+let interp_place ist gl = function
+    ConclLocation () -> ConclLocation ()
+  | HypLocation (id,hl) -> HypLocation (interp_hyp ist gl id,hl)
+
+let subst_place subst pl = pl 
+
+ARGUMENT EXTEND hloc
+    TYPED AS place
+    PRINTED BY pr_place
+    INTERPRETED BY interp_place
+    GLOBALIZED BY intern_place
+    SUBSTITUTED BY subst_place
+    RAW_TYPED AS loc_place
+    RAW_PRINTED BY pr_loc_place
+    GLOB_TYPED AS loc_place
+    GLOB_PRINTED BY pr_loc_place
+  [ ] -> 
+    [ ConclLocation () ]
+  |  [ "in" "|-" "*" ] -> 
+    [ ConclLocation () ]
+| [ "in" ident(id) ] ->
+    [ HypLocation ((Util.dummy_loc,id),InHyp) ]
+| [ "in" "(" "Type" "of" ident(id) ")" ] -> 
+    [ HypLocation ((Util.dummy_loc,id),InHypTypeOnly) ]
+| [ "in" "(" "Value" "of" ident(id) ")" ] -> 
+    [ HypLocation ((Util.dummy_loc,id),InHypValueOnly) ]
+   
+ END
+
diff --git a/tactics/extraargs.mli b/tactics/extraargs.mli
index 2b4746ae..004fef02 100644
--- a/tactics/extraargs.mli
+++ b/tactics/extraargs.mli
@@ -6,13 +6,36 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: extraargs.mli,v 1.3.2.2 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: extraargs.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 open Tacexpr
 open Term
+open Names
 open Proof_type
 open Topconstr
+open Rawterm
 
 val rawwit_orient : bool raw_abstract_argument_type
 val wit_orient : bool closed_abstract_argument_type
 val orient : bool Pcoq.Gram.Entry.e
+
+val rawwit_morphism_signature :
+ Setoid_replace.morphism_signature raw_abstract_argument_type
+val wit_morphism_signature :
+ Setoid_replace.morphism_signature closed_abstract_argument_type
+val morphism_signature :
+ Setoid_replace.morphism_signature Pcoq.Gram.Entry.e
+
+val rawwit_raw : constr_expr raw_abstract_argument_type
+val wit_raw : rawconstr closed_abstract_argument_type
+val raw : constr_expr Pcoq.Gram.Entry.e
+
+type 'id gen_place= ('id * hyp_location_flag,unit) location
+
+type loc_place = identifier Util.located gen_place
+type place = identifier gen_place
+
+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
+
diff --git a/tactics/extratactics.ml4 b/tactics/extratactics.ml4
index 237f0a0d..a9ee65d7 100644
--- a/tactics/extratactics.ml4
+++ b/tactics/extratactics.ml4
@@ -8,122 +8,194 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: extratactics.ml4,v 1.21.2.2 2004/11/15 11:06:49 herbelin Exp $ *)
+(* $Id: extratactics.ml4 8651 2006-03-21 21:54:43Z jforest $ *)
 
 open Pp
 open Pcoq
 open Genarg
 open Extraargs
+open Mod_subst
+open Names
 
 (* Equality *)
 open Equality
 
-TACTIC EXTEND Rewrite
-  [ "Rewrite" orient(b) constr_with_bindings(c) ] -> [general_rewrite_bindings b c]
+TACTIC EXTEND rewrite
+| [ "rewrite" orient(b) constr_with_bindings(c) ] ->
+    [general_rewrite_bindings b c]
 END
 
-TACTIC EXTEND RewriteIn
- [ "Rewrite" orient(b) constr_with_bindings(c) "in" hyp(h) ] ->
- [general_rewrite_in b h c]
+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)
 
-TACTIC EXTEND Replace
-  [ "Replace" constr(c1) "with" constr(c2) ] -> [ replace c1 c2 ]
+(* Julien: Mise en commun des differentes version de replace with in by 
+   TODO: améliorer l'affichage et deplacer dans extraargs
+
+*)
+
+
+let pr_by_arg_tac prc _ _ opt_c = 
+  match opt_c with 
+    | None -> mt ()
+    | Some c -> spc () ++ hov 2 (str "by" ++ spc ()  )
+
+(* Julien Forest: on voudrait pouvoir passer la loc mais je 
+n'ai pas reussi 
+*)
+
+let pr_in_arg_hyp  = 
+fun prc _ _ opt_c->
+  match opt_c with 
+    | None -> mt ()
+    | Some c -> 
+	spc () ++ hov 2 (str "by" ++ spc () ++ 
+			   Pptactic.pr_or_var (fun _ -> mt ()) 
+			   (ArgVar(Util.dummy_loc,c))
+			)
+
+
+
+
+ARGUMENT EXTEND by_arg_tac
+  TYPED AS tactic_opt
+  PRINTED BY pr_by_arg_tac
+| [ "by" tactic(c) ] -> [ Some c ]
+| [ ] -> [ None ]
+END
+ 
+ARGUMENT EXTEND in_arg_hyp
+  TYPED AS ident_opt
+  PRINTED BY pr_in_arg_hyp
+| [ "in" int_or_var(c) ] -> 
+    [ match c with
+	| ArgVar(_,c) ->  Some (c)
+	| _ -> Util.error "in must be used with an identifier" 
+    ]
+| [ ] -> [ 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_app Tacinterp.eval_tactic tac)  ]
 END
 
-TACTIC EXTEND ReplaceIn
-  [ "Replace" constr(c1) "with" constr(c2) "in" hyp(h) ] ->
+(* 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 Replacetermleft
-  [ "Replace" "->" constr(c)  ] -> [ replace_term_left c ]
+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) ]
+END
+
+*)
+
+TACTIC EXTEND replace_term_left
+  [ "replace" "->" constr(c)  ] -> [ replace_term_left c ]
 END
 
-TACTIC EXTEND Replacetermright
-  [ "Replace" "<-" constr(c)  ] -> [ replace_term_right c ]
+TACTIC EXTEND replace_term_right
+  [ "replace" "<-" constr(c)  ] -> [ replace_term_right c ]
 END
 
-TACTIC EXTEND Replaceterm
-  [ "Replace" constr(c)  ] -> [ replace_term c ]
+TACTIC EXTEND replace_term
+  [ "replace" constr(c)  ] -> [ replace_term c ]
 END
 
-TACTIC EXTEND ReplacetermInleft
-  [ "Replace"  "->" constr(c) "in" hyp(h) ]
+TACTIC EXTEND replace_term_in_left
+  [ "replace"  "->" constr(c) "in" hyp(h) ]
   -> [ replace_term_in_left c h ]
 END
 
-TACTIC EXTEND ReplacetermInright
-  [ "Replace"  "<-" constr(c) "in" hyp(h) ]
+TACTIC EXTEND replace_term_in_right
+  [ "replace"  "<-" constr(c) "in" hyp(h) ]
   -> [ replace_term_in_right c h ]
 END
 
-TACTIC EXTEND ReplacetermIn
-  [ "Replace" constr(c) "in" hyp(h) ]
+TACTIC EXTEND replace_term_in
+  [ "replace" constr(c) "in" hyp(h) ]
   -> [ replace_term_in c h ]
 END
 
-TACTIC EXTEND DEq
-  [ "Simplify_eq" quantified_hypothesis_opt(h) ] -> [ dEq h ]
+TACTIC EXTEND simplify_eq
+  [ "simplify_eq" quantified_hypothesis_opt(h) ] -> [ dEq h ]
 END
 
-TACTIC EXTEND Discriminate
-  [ "Discriminate" quantified_hypothesis_opt(h) ] -> [ discr_tac h ]
+TACTIC EXTEND discriminate
+  [ "discriminate" quantified_hypothesis_opt(h) ] -> [ discr_tac h ]
 END
 
 let h_discrHyp id = h_discriminate (Some id)
 
-TACTIC EXTEND Injection
-  [ "Injection" quantified_hypothesis_opt(h) ] -> [ injClause h ]
+TACTIC EXTEND injection
+  [ "injection" quantified_hypothesis_opt(h) ] -> [ injClause h ]
 END
 
 let h_injHyp id = h_injection (Some id)
 
-TACTIC EXTEND ConditionalRewrite
-  [ "Conditional" tactic(tac) "Rewrite" orient(b) constr_with_bindings(c) ]
+TACTIC EXTEND conditional_rewrite
+| [ "conditional" tactic(tac) "rewrite" orient(b) constr_with_bindings(c) ]
     -> [ conditional_rewrite b (snd tac) c ]
-END
-
-TACTIC EXTEND ConditionalRewriteIn
-  [ "Conditional" tactic(tac) "Rewrite" orient(b) constr_with_bindings(c)
+| [ "conditional" tactic(tac) "rewrite" orient(b) constr_with_bindings(c)
     "in" hyp(h) ]
     -> [ conditional_rewrite_in b h (snd tac) c ]
 END
 
-TACTIC EXTEND DependentRewrite
-| [ "Dependent" "Rewrite" orient(b) hyp(id) ] -> [ substHypInConcl b id ]
-| [ "CutRewrite" orient(b) constr(eqn) ] -> [ substConcl b eqn ]
-| [ "CutRewrite" orient(b) constr(eqn) "in" hyp(id) ]
-      -> [ substHyp b eqn id ]
+TACTIC EXTEND dependent_rewrite
+| [ "dependent" "rewrite" orient(b) constr(c) ] -> [ rewriteInConcl b c ]
+| [ "dependent" "rewrite" orient(b) constr(c) "in" hyp(id) ]
+    -> [ rewriteInHyp b c id ]
+END
+
+TACTIC EXTEND cut_rewrite
+| [ "cutrewrite" orient(b) constr(eqn) ] -> [ cutRewriteInConcl b eqn ]
+| [ "cutrewrite" orient(b) constr(eqn) "in" hyp(id) ]
+    -> [ cutRewriteInHyp b eqn id ]
 END
 
 (* Contradiction *)
 open Contradiction
 
-TACTIC EXTEND Absurd
- [ "Absurd" constr(c) ] -> [ absurd c ]
+TACTIC EXTEND absurd
+ [ "absurd" constr(c) ] -> [ absurd c ]
 END
 
-TACTIC EXTEND Contradiction
- [ "Contradiction" constr_with_bindings_opt(c) ] -> [ contradiction c ]
+TACTIC EXTEND contradiction
+ [ "contradiction" constr_with_bindings_opt(c) ] -> [ contradiction c ]
 END
 
 (* AutoRewrite *)
 
 open Autorewrite
-TACTIC EXTEND AutorewriteV7
-  [ "AutoRewrite" "[" ne_preident_list(l) "]" ] ->
-    [ autorewrite Refiner.tclIDTAC l ]
-| [ "AutoRewrite" "[" ne_preident_list(l) "]" "using" tactic(t) ] ->
-    [ autorewrite (snd t) l ]
-END
-TACTIC EXTEND AutorewriteV8
-  [ "AutoRewrite" "with" ne_preident_list(l) ] ->
+
+TACTIC EXTEND autorewrite
+  [ "autorewrite" "with" ne_preident_list(l) ] ->
     [ autorewrite Refiner.tclIDTAC l ]
-| [ "AutoRewrite" "with" ne_preident_list(l) "using" tactic(t) ] ->
+| [ "autorewrite" "with" ne_preident_list(l) "using" tactic(t) ] ->
     [ autorewrite (snd t) l ]
+| [ "autorewrite" "with" ne_preident_list(l) "in" ident(id) ] ->
+    [ autorewrite_in id Refiner.tclIDTAC l ]
+| [ "autorewrite" "with" ne_preident_list(l) "in" ident(id) "using" tactic(t) ] ->
+    [ autorewrite_in id (snd t) l ]
 END
 
 let add_rewrite_hint name ort t lcsr =
@@ -131,19 +203,9 @@ let add_rewrite_hint name ort t lcsr =
   let f c = Constrintern.interp_constr sigma env c, ort, t in
   add_rew_rules name (List.map f lcsr)
 
-(* V7 *)
-VERNAC COMMAND EXTEND HintRewriteV7
-  [ "Hint" "Rewrite" orient(o) "[" ne_constr_list(l) "]" "in" preident(b) ] ->
-  [ add_rewrite_hint b o (Tacexpr.TacId "") l ]
-| [ "Hint" "Rewrite" orient(o) "[" ne_constr_list(l) "]" "in" preident(b)
-    "using" tactic(t) ] ->
-  [ add_rewrite_hint b o t l ]
-END
-
-(* V8 *)
-VERNAC COMMAND EXTEND HintRewriteV8
+VERNAC COMMAND EXTEND HintRewrite
   [ "Hint" "Rewrite" orient(o) ne_constr_list(l) ":" preident(b) ] ->
-  [ add_rewrite_hint b o (Tacexpr.TacId "") l ]
+  [ add_rewrite_hint b o (Tacexpr.TacId []) l ]
 | [ "Hint" "Rewrite" orient(o) ne_constr_list(l) "using" tactic(t)
     ":" preident(b) ] ->
   [ add_rewrite_hint b o t l ]
@@ -154,8 +216,8 @@ END
 
 open Refine
 
-TACTIC EXTEND Refine
-  [ "Refine" castedopenconstr(c) ] -> [ refine c ]
+TACTIC EXTEND refine
+  [ "refine" casted_open_constr(c) ] -> [ refine c ]
 END
 
 let refine_tac = h_refine
@@ -164,18 +226,81 @@ let refine_tac = h_refine
 
 open Setoid_replace
 
-TACTIC EXTEND SetoidReplace
-  [ "Setoid_replace" constr(c1) "with" constr(c2) ]
-  -> [ setoid_replace c1 c2 None]
+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 ]
+END
+
+TACTIC EXTEND setoid_rewrite
+   [ "setoid_rewrite" orient(b) constr(c) ]
+   -> [ general_s_rewrite b c ~new_goals:[] ]
+ | [ "setoid_rewrite" orient(b) constr(c) "generate" "side" "conditions" constr_list(l) ]
+   -> [ general_s_rewrite b c ~new_goals:l ]
+ | [ "setoid_rewrite" orient(b) constr(c) "in" hyp(h) ] ->
+      [ general_s_rewrite_in h b c ~new_goals:[] ]
+ | [ "setoid_rewrite" orient(b) constr(c) "in" hyp(h) "generate" "side" "conditions" constr_list(l) ] ->
+      [ general_s_rewrite_in h b c ~new_goals:l ]
+END
+
+VERNAC COMMAND EXTEND AddSetoid1
+  [ "Add" "Setoid" constr(a) constr(aeq) constr(t) "as" ident(n) ] ->
+   [ add_setoid n a aeq t ]
+| [ "Add" "Morphism" constr(m) ":" ident(n) ] ->
+   [ new_named_morphism n m None ]
+| [ "Add" "Morphism" constr(m) "with" "signature" morphism_signature(s) "as" ident(n) ] ->
+   [ new_named_morphism n m (Some s)]
+END
+
+VERNAC COMMAND EXTEND AddRelation1
+  [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(t) "symmetry" "proved" "by" constr(t') "as" ident(n) ] ->
+   [ add_relation n a aeq (Some t) (Some t') None ]
+| [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(t)  "as" ident(n) ] ->
+   [ add_relation n a aeq (Some t) None None ]
+| [ "Add" "Relation" constr(a) constr(aeq)  "as" ident(n) ] ->
+   [ add_relation n a aeq None None None ]
+END
+
+VERNAC COMMAND EXTEND AddRelation2
+  [ "Add" "Relation" constr(a) constr(aeq) "symmetry" "proved" "by" constr(t') "as" ident(n) ] ->
+   [ add_relation n a aeq None (Some t') None ]
+| [ "Add" "Relation" constr(a) constr(aeq) "symmetry" "proved" "by" constr(t') "transitivity" "proved" "by" constr(t'')  "as" ident(n) ] ->
+   [ add_relation n a aeq None (Some t') (Some t'') ]
 END
 
-TACTIC EXTEND SetoidRewrite
-  [ "Setoid_rewrite" orient(b) constr(c) ] -> [ general_s_rewrite b c ]
+VERNAC COMMAND EXTEND AddRelation3
+  [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(t) "transitivity" "proved" "by" constr(t') "as" ident(n) ] ->
+   [ add_relation n a aeq (Some t) None (Some t') ]
+| [ "Add" "Relation" constr(a) constr(aeq) "reflexivity" "proved" "by" constr(t) "symmetry" "proved" "by" constr(t') "transitivity" "proved" "by" constr(t'') "as" ident(n) ] ->
+   [ add_relation n a aeq (Some t) (Some t') (Some t'') ]
+| [ "Add" "Relation" constr(a) constr(aeq) "transitivity" "proved" "by" constr(t) "as" ident(n) ] ->
+   [ add_relation n a aeq None None (Some t) ]
 END
 
-VERNAC COMMAND EXTEND AddSetoid
-| [ "Add" "Setoid" constr(a) constr(aeq) constr(t) ] -> [ add_setoid a aeq t ]
-| [ "Add" "Morphism" constr(m) ":" ident(s) ] -> [ new_named_morphism s m ]
+TACTIC EXTEND setoid_symmetry
+   [ "setoid_symmetry" ] -> [ setoid_symmetry ]
+ | [ "setoid_symmetry" "in" ident(n) ] -> [ setoid_symmetry_in n ]
+END
+
+TACTIC EXTEND setoid_reflexivity
+   [ "setoid_reflexivity" ] -> [ setoid_reflexivity ]
+END
+
+TACTIC EXTEND setoid_transitivity
+   [ "setoid_transitivity" constr(t) ] -> [ setoid_transitivity t ]
 END
 
 (* Inversion lemmas (Leminv) *)
@@ -226,11 +351,28 @@ END
 
 (* Subst *)
 
-TACTIC EXTEND Subst
-| [ "Subst" ne_var_list(l) ] -> [ subst l ]
-| [ "Subst" ] -> [ subst_all ]
+TACTIC EXTEND subst
+| [ "subst" ne_var_list(l) ] -> [ subst l ]
+| [ "subst" ] -> [ subst_all ]
+END
+
+open Evar_tactics
+
+(* evar creation *)
+
+TACTIC EXTEND evar
+  [ "evar" "(" ident(id) ":" constr(typ) ")" ] -> [ let_evar (Name id) typ ]
+| [ "evar" constr(typ) ] -> [ let_evar Anonymous typ ]
+END
+
+open Tacexpr
+
+TACTIC EXTEND instantiate
+  [ "instantiate" "(" integer(i) ":=" raw(c) ")" hloc(hl) ] ->
+    [instantiate i c hl  ]
 END
 
+
 (** Nijmegen "step" tactic for setoid rewriting *)
 
 open Tacticals
@@ -257,7 +399,7 @@ let step left x tac =
   let l =
     List.map (fun lem ->
       tclTHENLAST
-      (apply_with_bindings (constr_of_reference lem, ImplicitBindings [x]))
+      (apply_with_bindings (lem, ImplicitBindings [x]))
         tac)
       !(if left then transitivity_left_table else transitivity_right_table)
   in
@@ -271,7 +413,7 @@ let cache_transitivity_lemma (_,(left,lem)) =
   else
     transitivity_right_table := lem :: !transitivity_right_table
   
-let subst_transitivity_lemma (_,subst,(b,ref)) = (b,subst_global subst ref)
+let subst_transitivity_lemma (_,subst,(b,ref)) = (b,subst_mps subst ref)
 
 let (inTransitivity,_) =
   declare_object {(default_object "TRANSITIVITY-STEPS") with
@@ -303,27 +445,33 @@ let _ =
 
 (* Main entry points *)
 
-let add_transitivity_lemma left ref =
-  add_anonymous_leaf (inTransitivity (left,Nametab.global ref))
+let add_transitivity_lemma left lem =
+ let lem' = Constrintern.interp_constr Evd.empty (Global.env ()) lem in
+  add_anonymous_leaf (inTransitivity (left,lem'))
 
 (* Vernacular syntax *)
 
-TACTIC EXTEND Stepl
-| ["Stepl" constr(c) "by" tactic(tac) ] -> [ step true c (snd tac) ]
-| ["Stepl" constr(c) ] -> [ step true c tclIDTAC ]
+TACTIC EXTEND stepl
+| ["stepl" constr(c) "by" tactic(tac) ] -> [ step true c (snd tac) ]
+| ["stepl" constr(c) ] -> [ step true c tclIDTAC ]
 END
 
-TACTIC EXTEND Stepr
-| ["Stepr" constr(c) "by" tactic(tac) ] -> [ step false c (snd tac) ]
-| ["Stepr" constr(c) ] -> [ step false c tclIDTAC ]
+TACTIC EXTEND stepr
+| ["stepr" constr(c) "by" tactic(tac) ] -> [ step false c (snd tac) ]
+| ["stepr" constr(c) ] -> [ step false c tclIDTAC ]
 END
 
 VERNAC COMMAND EXTEND AddStepl
-| [ "Declare" "Left" "Step" global(id) ] ->
-    [ add_transitivity_lemma true id ]
+| [ "Declare" "Left" "Step" constr(t) ] ->
+    [ add_transitivity_lemma true t ]
 END
 
 VERNAC COMMAND EXTEND AddStepr
-| [ "Declare" "Right" "Step" global(id) ] ->
-    [ add_transitivity_lemma false id ]
+| [ "Declare" "Right" "Step" constr(t) ] ->
+    [ add_transitivity_lemma false t ]
+END
+
+VERNAC COMMAND EXTEND ImplicitTactic
+| [ "Declare" "Implicit" "Tactic" tactic(tac) ] ->
+    [ Tacinterp.declare_implicit_tactic (Tacinterp.interp tac) ]
 END
diff --git a/tactics/extratactics.mli b/tactics/extratactics.mli
index 78a94190..d0034ca5 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,v 1.3.10.2 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: extratactics.mli 8651 2006-03-21 21:54:43Z jforest $ i*)
 
 open Names
 open Term
@@ -18,3 +18,23 @@ val h_injHyp : quantified_hypothesis -> tactic
 val h_rewriteLR : constr -> 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 option Tacexpr.raw_abstract_argument_type
+val in_arg_hyp: identifier option Pcoq.Gram.Entry.e
+
+
+
+val rawwit_by_arg_tac :
+  (Tacexpr.raw_tactic_expr option, Topconstr.constr_expr,
+   Tacexpr.raw_tactic_expr)
+  Genarg.abstract_argument_type
+  
+val by_arg_tac : Tacexpr.raw_tactic_expr option Pcoq.Gram.Entry.e
diff --git a/tactics/hiddentac.ml b/tactics/hiddentac.ml
index f35c624b..1fe1c51e 100644
--- a/tactics/hiddentac.ml
+++ b/tactics/hiddentac.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: hiddentac.ml,v 1.21.2.1 2004/07/16 19:30:53 herbelin Exp $ *)
+(* $Id: hiddentac.ml 7875 2006-01-16 09:55:24Z herbelin $ *)
 
 open Term
 open Proof_type
@@ -28,6 +28,7 @@ let h_intro x        = h_intro_move (Some x) None
 let h_intros_until x = abstract_tactic (TacIntrosUntil x) (intros_until x)
 let h_assumption     = abstract_tactic TacAssumption assumption
 let h_exact c        = abstract_tactic (TacExact c) (exact_check c)
+let h_exact_no_check c = abstract_tactic (TacExactNoCheck c) (exact_no_check c)
 let h_apply cb       = abstract_tactic (TacApply cb) (apply_with_bindings cb)
 let h_elim cb cbo    = abstract_tactic (TacElim (cb,cbo)) (elim cb cbo)
 let h_elim_type c    = abstract_tactic (TacElimType c) (elim_type c)
@@ -41,15 +42,14 @@ let h_mutual_cofix id l =
   abstract_tactic (TacMutualCofix (id,l)) (mutual_cofix id l)
 
 let h_cut c          = abstract_tactic (TacCut c) (cut c)
-let h_true_cut na c = abstract_tactic (TacTrueCut (na,c)) (true_cut na c)
-let h_forward b na c = abstract_tactic (TacForward (b,na,c)) (forward b na c)
 let h_generalize cl  = abstract_tactic (TacGeneralize cl) (generalize cl)
 let h_generalize_dep c = abstract_tactic (TacGeneralizeDep c)(generalize_dep c)
 let h_let_tac na c cl =
   abstract_tactic (TacLetTac (na,c,cl)) (letin_tac true na c cl)
-let h_instantiate n c cls = 
-  abstract_tactic (TacInstantiate (n,c,cls))
-    (Evar_refiner.instantiate n c (simple_clause_of cls))
+let h_instantiate n c ido = 
+(Evar_tactics.instantiate n c ido)
+  (* abstract_tactic (TacInstantiate (n,c,cls))
+    (Evar_refiner.instantiate n c (simple_clause_of cls)) *)
 
 (* Derived basic tactics *)
 let h_simple_induction h =
@@ -64,7 +64,8 @@ let h_specialize n d = abstract_tactic (TacSpecialize (n,d)) (new_hyp n d)
 let h_lapply c = abstract_tactic (TacLApply c) (cut_and_apply c)
 
 (* Context management *)
-let h_clear l = abstract_tactic (TacClear l) (clear l)
+let h_clear b l = abstract_tactic (TacClear (b,l))
+  ((if b then keep else clear) l)
 let h_clear_body l = abstract_tactic (TacClearBody l) (clear_body l)
 let h_move dep id1 id2 =
   abstract_tactic (TacMove (dep,id1,id2)) (move_hyp dep id1 id2)
diff --git a/tactics/hiddentac.mli b/tactics/hiddentac.mli
index 1b37291c..bfab1f45 100644
--- a/tactics/hiddentac.mli
+++ b/tactics/hiddentac.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: hiddentac.mli,v 1.19.2.2 2005/01/21 16:41:52 herbelin Exp $ i*)
+(*i $Id: hiddentac.mli 8651 2006-03-21 21:54:43Z jforest $ i*)
 
 (*i*)
 open Names
@@ -29,6 +29,7 @@ val h_intros_until    : quantified_hypothesis -> tactic
 
 val h_assumption      : tactic
 val h_exact           : constr -> tactic
+val h_exact_no_check  : constr -> tactic
 
 val h_apply           : constr with_bindings -> tactic
 
@@ -45,25 +46,22 @@ val h_mutual_cofix    : identifier -> (identifier * constr) list -> tactic
 val h_cofix           : identifier option -> tactic
 
 val h_cut             : constr -> tactic 
-val h_true_cut        : name -> constr -> tactic 
 val h_generalize      : constr list -> tactic 
 val h_generalize_dep  : constr -> tactic 
-val h_forward         : bool -> name -> constr -> tactic 
 val h_let_tac         : name -> constr -> Tacticals.clause -> tactic
-val h_instantiate     : int -> constr -> Tacticals.clause -> tactic
+val h_instantiate     : int -> Rawterm.rawconstr ->
+  (identifier * hyp_location_flag, unit) location -> tactic
 
 (* Derived basic tactics *)
 
-val h_simple_induction   : quantified_hypothesis * (bool ref * intro_pattern_expr list ref list) list ref -> tactic
+val h_simple_induction   : quantified_hypothesis -> tactic
 val h_simple_destruct    : quantified_hypothesis -> tactic
 val h_new_induction   :
-  constr induction_arg -> constr with_bindings option ->
-  intro_pattern_expr option * (bool ref * intro_pattern_expr list ref list) list ref
-  -> tactic
+  constr induction_arg list -> constr with_bindings option ->
+  intro_pattern_expr -> tactic
 val h_new_destruct    :
-  constr induction_arg -> constr with_bindings option -> 
-  intro_pattern_expr option * (bool ref * intro_pattern_expr list ref list) list ref
-  -> tactic
+  constr induction_arg list -> constr with_bindings option -> 
+  intro_pattern_expr -> tactic
 val h_specialize      : int option -> constr with_bindings -> tactic
 val h_lapply          : constr -> tactic
 
@@ -71,16 +69,13 @@ val h_lapply          : constr -> tactic
 
 
 (* Context management *)
-val h_clear           : identifier list -> tactic
+val h_clear           : bool -> identifier list -> tactic
 val h_clear_body      : identifier list -> tactic
 val h_move            : bool -> identifier -> identifier -> tactic
 val h_rename          : identifier -> identifier -> tactic
 
 
 (* Constructors *)
-(*i
-val h_any_constructor : tactic -> tactic
-i*)
 val h_constructor     : int -> constr bindings -> tactic
 val h_left            : constr bindings -> tactic
 val h_right           : constr bindings -> tactic
@@ -92,7 +87,7 @@ val h_simplest_right  : tactic
 
 
 (* Conversion *)
-val h_reduce          : Tacred.red_expr -> Tacticals.clause -> tactic
+val h_reduce          : Redexpr.red_expr -> Tacticals.clause -> tactic
 val h_change          :
   constr occurrences option -> constr -> Tacticals.clause -> tactic
 
diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml4
index 0ada5a06..64a0e0f1 100644
--- a/tactics/hipattern.ml
+++ b/tactics/hipattern.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: hipattern.ml,v 1.29.2.1 2004/07/16 19:30:53 herbelin Exp $ *)
+(*i camlp4deps: "parsing/grammar.cma parsing/q_constr.cmo" i*)
+
+(* $Id: hipattern.ml4 8652 2006-03-22 08:27:14Z herbelin $ *)
 
 open Pp
 open Util
@@ -40,7 +42,6 @@ type 'a matching_function = constr -> 'a option
 type testing_function  = constr -> bool
 
 let mkmeta n = Nameops.make_ident "X" (Some n)
-let mkPMeta n = PMeta (Some (mkmeta n))
 let meta1 = mkmeta 1
 let meta2 = mkmeta 2
 let meta3 = mkmeta 3
@@ -120,7 +121,7 @@ let match_with_unit_type t =
         let constr_types = mip.mind_nf_lc in 
         let nconstr = Array.length mip.mind_consnames in
         let zero_args c =
-          nb_prod c = mip.mind_nparams in  
+          nb_prod c = mib.mind_nparams in  
 	if nconstr = 1 && array_for_all zero_args constr_types then 
 	  Some hdapp
         else 
@@ -133,21 +134,9 @@ let is_unit_type t = op2bool (match_with_unit_type t)
    inductive binary relation R, so that R has only one constructor
    establishing its reflexivity.  *)
 
-(* ["(A : ?)(x:A)(? A x x)"] and ["(x : ?)(? x x)"] *)
-let x = Name (id_of_string "x")
-let y = Name (id_of_string "y")
-let name_A = Name (id_of_string "A")
-let coq_refl_rel1_pattern =
-  PProd
-    (name_A, PMeta None,
-    PProd (x, PRel 1, PApp (PMeta None, [|PRel 2; PRel 1; PRel 1|])))
-let coq_refl_rel2_pattern =
-  PProd (x, PMeta None, PApp (PMeta None, [|PRel 1; PRel 1|]))
-
-let coq_refl_reljm_pattern =
-PProd
-    (name_A, PMeta None,
-    PProd (x, PRel 1, PApp (PMeta None, [|PRel 2; PRel 1; PRel 2;PRel 1|])))
+let coq_refl_rel1_pattern  = PATTERN [ forall A:_, forall x:A, _ A x x ]
+let coq_refl_rel2_pattern  = PATTERN [ forall x:_, _ x x ]
+let coq_refl_reljm_pattern = PATTERN [ forall A:_, forall x:A, _ A x A x ]
 
 let match_with_equation t =
   let (hdapp,args) = decompose_app t in
@@ -168,9 +157,8 @@ let match_with_equation t =
 
 let is_equation t = op2bool (match_with_equation  t)
 
-(* ["(?1 -> ?2)"] *)
-let imp a b = PProd (Anonymous, a, b)
-let coq_arrow_pattern = imp (mkPMeta 1) (mkPMeta 2)
+let coq_arrow_pattern = PATTERN [ ?X1 -> ?X2 ]
+
 let match_arrow_pattern t =
   match matches coq_arrow_pattern t with
     | [(m1,arg);(m2,mind)] -> assert (m1=meta1 & m2=meta2); (arg, mind)
@@ -213,11 +201,11 @@ let match_with_nodep_ind t =
       | Ind ind  -> 
           let (mib,mip) = Global.lookup_inductive ind in
 	    if Array.length (mib.mind_packets)>1 then None else
-	      let nodep_constr = has_nodep_prod_after mip.mind_nparams in
+	      let nodep_constr = has_nodep_prod_after mib.mind_nparams in
 		if array_for_all nodep_constr mip.mind_nf_lc then
 		  let params=
 		    if mip.mind_nrealargs=0 then args else
-		      fst (list_chop mip.mind_nparams args) in
+		      fst (list_chop mib.mind_nparams args) in
 		    Some (hdapp,params,mip.mind_nrealargs)
 		else 
 		  None
@@ -233,7 +221,7 @@ let match_with_sigma_type t=
           if (Array.length (mib.mind_packets)=1) &&
 	    (mip.mind_nrealargs=0) &&
 	    (Array.length mip.mind_consnames=1) &&
-	    has_nodep_prod_after (mip.mind_nparams+1) mip.mind_nf_lc.(0) then
+	    has_nodep_prod_after (mib.mind_nparams+1) mip.mind_nf_lc.(0) then
 	      (*allowing only 1 existential*) 
 	      Some (hdapp,args)
 	  else 
@@ -252,12 +240,10 @@ let rec first_match matcher = function
 
 (*** Equality *)
 
-(* Patterns "(eq ?1 ?2 ?3)", "(eqT ?1 ?2 ?3)" and "(idT ?1 ?2 ?3)" *)
-let coq_eq_pattern_gen eq = 
-  lazy (PApp(PRef (Lazy.force eq), [|mkPMeta 1;mkPMeta 2;mkPMeta 3|]))
+(* Patterns "(eq ?1 ?2 ?3)" and "(identity ?1 ?2 ?3)" *)
+let coq_eq_pattern_gen eq = lazy PATTERN [ %eq ?X1 ?X2 ?X3 ]
 let coq_eq_pattern = coq_eq_pattern_gen coq_eq_ref
-(*let coq_eqT_pattern = coq_eq_pattern_gen coq_eqT_ref*)
-let coq_idT_pattern = coq_eq_pattern_gen coq_idT_ref
+let coq_identity_pattern = coq_eq_pattern_gen coq_identity_ref
 
 let match_eq eqn eq_pat =
   match matches (Lazy.force eq_pat) eqn with
@@ -268,8 +254,7 @@ let match_eq eqn eq_pat =
 
 let equalities =
   [coq_eq_pattern, build_coq_eq_data;
-(*   coq_eqT_pattern, build_coq_eqT_data;*)
-   coq_idT_pattern, build_coq_idT_data]
+   coq_identity_pattern, build_coq_identity_data]
 
 let find_eq_data_decompose eqn = (* fails with PatternMatchingFailure *)
   first_match (match_eq eqn) equalities
@@ -293,14 +278,13 @@ let dest_nf_eq gls eqn =
 (*** Sigma-types *)
 
 (* Patterns "(existS ?1 ?2 ?3 ?4)" and "(existT ?1 ?2 ?3 ?4)" *)
-let coq_ex_pattern_gen ex =
-  lazy(PApp(PRef (Lazy.force ex), [|mkPMeta 1;mkPMeta 2;mkPMeta 3;mkPMeta 4|]))
+let coq_ex_pattern_gen ex = lazy PATTERN [ %ex ?X1 ?X2 ?X3 ?X4 ]
 let coq_existS_pattern = coq_ex_pattern_gen coq_existS_ref
 let coq_existT_pattern = coq_ex_pattern_gen coq_existT_ref
 
 let match_sigma ex ex_pat =
   match matches (Lazy.force ex_pat) ex with
-    | [(m1,a);(m2,p);(m3,car);(m4,cdr)] as l ->
+    | [(m1,a);(m2,p);(m3,car);(m4,cdr)] ->
 	assert (m1=meta1 & m2=meta2 & m3=meta3 & m4=meta4);
 	(a,p,car,cdr)
     | _ ->
@@ -312,8 +296,7 @@ let find_sigma_data_decompose ex = (* fails with PatternMatchingFailure *)
      coq_existT_pattern, build_sigma_type]
 
 (* Pattern "(sig ?1 ?2)" *)
-let coq_sig_pattern = 
-  lazy (PApp (PRef (Lazy.force coq_sig_ref), [| (mkPMeta 1); (mkPMeta 2) |]))
+let coq_sig_pattern = lazy PATTERN [ %coq_sig_ref ?X1 ?X2 ]
 
 let match_sigma t =
   match matches (Lazy.force coq_sig_pattern) t with
@@ -324,43 +307,47 @@ let is_matching_sigma t = is_matching (Lazy.force coq_sig_pattern) t
 
 (*** Decidable equalities *)
 
-(* Pattern "(sumbool (eq ?1 ?2 ?3) ?4)" *)
-let coq_eqdec_partial_pattern =
-  lazy
-    (PApp
-       (PRef (Lazy.force coq_sumbool_ref),
-	[| Lazy.force coq_eq_pattern; (mkPMeta 4) |]))
+(* The expected form of the goal for the tactic Decide Equality *)
 
-let match_eqdec_partial t =
-  match matches (Lazy.force coq_eqdec_partial_pattern) t with
-    | [_; (_,lhs); (_,rhs); _] -> (lhs,rhs)
-    | _ -> anomaly "Unexpected pattern"
+(* Pattern "{<?1>x=y}+{~(<?1>x=y)}" *)
+(* i.e. "(sumbool (eq ?1 x y) ~(eq ?1 x y))" *)
 
-(* The expected form of the goal for the tactic Decide Equality *)
+let coq_eqdec_inf_pattern =
+ lazy PATTERN [ { ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 } ]
+
+let coq_eqdec_inf_rev_pattern =
+ lazy PATTERN [ { ~ ?X2 = ?X3 :> ?X1 } + { ?X2 = ?X3 :> ?X1 } ]
 
-(* Pattern "(x,y:?1){<?1>x=y}+{~(<?1>x=y)}" *)
-(* i.e. "(x,y:?1)(sumbool (eq ?1 x y) ~(eq ?1 x y))" *)
-let x = Name (id_of_string "x")
-let y = Name (id_of_string "y")
 let coq_eqdec_pattern =
-  lazy
-    (PProd (x, (mkPMeta 1), PProd (y, (mkPMeta 1), 
-    PApp (PRef (Lazy.force coq_sumbool_ref),
-	  [| PApp (PRef (Lazy.force coq_eq_ref),
-		   [| (mkPMeta 1); PRel 2; PRel 1 |]);
-	     PApp (PRef (Lazy.force coq_not_ref), 
-		   [|PApp (PRef (Lazy.force coq_eq_ref),
- 			   [| (mkPMeta 1); PRel 2; PRel 1 |])|]) |]))))
+ lazy PATTERN [ %coq_or_ref (?X2 = ?X3 :> ?X1) (~ ?X2 = ?X3 :> ?X1) ]
+
+let coq_eqdec_rev_pattern =
+ lazy PATTERN [ %coq_or_ref (~ ?X2 = ?X3 :> ?X1) (?X2 = ?X3 :> ?X1) ]
+
+let op_or = coq_or_ref
+let op_sum = coq_sumbool_ref
 
 let match_eqdec t =
-  match matches (Lazy.force coq_eqdec_pattern) t with
-    | [(_,typ)] -> typ
-    | _ -> anomaly "Unexpected pattern"
+  let eqonleft,op,subst =
+    try true,op_sum,matches (Lazy.force coq_eqdec_inf_pattern) t
+    with PatternMatchingFailure -> 
+    try false,op_sum,matches (Lazy.force coq_eqdec_inf_rev_pattern) t
+    with PatternMatchingFailure -> 
+    try true,op_or,matches (Lazy.force coq_eqdec_pattern) t
+    with PatternMatchingFailure -> 
+        false,op_or,matches (Lazy.force coq_eqdec_rev_pattern) t in
+  match subst with
+  | [(_,typ);(_,c1);(_,c2)] -> 
+      eqonleft, Libnames.constr_of_global (Lazy.force op), c1, c2, typ
+  | _ -> anomaly "Unexpected pattern"
 
 (* Patterns "~ ?" and "? -> False" *)
-let coq_not_pattern = lazy(PApp(PRef (Lazy.force coq_not_ref), [|PMeta None|]))
-let coq_imp_False_pattern =
-  lazy (imp (PMeta None) (PRef (Lazy.force coq_False_ref)))
+let coq_not_pattern = lazy PATTERN [ ~ _ ]
+let coq_imp_False_pattern = lazy PATTERN [ _ -> %coq_False_ref ]
 
 let is_matching_not t = is_matching (Lazy.force coq_not_pattern) t
 let is_matching_imp_False t = is_matching (Lazy.force coq_imp_False_pattern) t
+
+(* Remark: patterns that have references to the standard library must
+   be evaluated lazily (i.e. at the time they are used, not a the time
+   coqtop starts) *)
diff --git a/tactics/hipattern.mli b/tactics/hipattern.mli
index 7e2aa8f2..1627a8ca 100644
--- a/tactics/hipattern.mli
+++ b/tactics/hipattern.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: hipattern.mli,v 1.13.2.1 2004/07/16 19:30:53 herbelin Exp $ i*)
+(*i $Id: hipattern.mli 8652 2006-03-22 08:27:14Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -37,8 +37,6 @@ open Proof_trees
    intersection of the free-rels of the term and the current stack be
    contained in the arguments of the application *)
 
-val is_imp_term : constr -> bool
-
 (*s I implemented the following functions which test whether a term [t]
    is an inductive but non-recursive type, a general conjuction, a
    general disjunction, or a type with no constructors.
@@ -98,7 +96,7 @@ val is_sigma_type           : testing_function
 
 open Coqlib
 
-(* Match terms [(eq A t u)], [(eqT A t u)] or [(identityT A t u)] *)
+(* Match terms [(eq A t u)] or [(identity A t u)] *)
 (* Returns associated lemmas and [A,t,u] *)
 val find_eq_data_decompose : constr -> 
   coq_leibniz_eq_data * (constr * constr * constr)
@@ -113,11 +111,9 @@ val match_sigma : constr -> constr * constr
 
 val is_matching_sigma : constr -> bool
 
-(* Match a term of the form [{x=y}+{_}], returns [x] and [y] *)
-val match_eqdec_partial : constr -> constr * constr
-
-(* Match a term of the form [(x,y:t){x=y}+{~x=y}], returns [t] *)
-val match_eqdec : constr -> constr
+(* Match a decidable equality judgement (e.g [{t=u:>T}+{~t=u}]), returns
+   [t,u,T] and a boolean telling if equality is on the left side *)
+val match_eqdec : constr -> bool * constr * constr * constr * constr
 
 (* Match an equality up to conversion; returns [(eq,t1,t2)] in normal form *)
 open Proof_type
diff --git a/tactics/inv.ml b/tactics/inv.ml
index e4bab195..c48a90ac 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: inv.ml,v 1.53.2.3 2005/09/08 12:28:00 herbelin Exp $ *)
+(* $Id: inv.ml 7880 2006-01-16 13:59:08Z herbelin $ *)
 
 open Pp
 open Util
@@ -46,13 +46,13 @@ let collect_meta_variables c =
 
 let check_no_metas clenv ccl =
   if occur_meta ccl then
-    let metas = List.map (fun n -> Metamap.find n clenv.namenv)
-		  (collect_meta_variables ccl) in
+    let metas = List.filter (fun na -> na<>Anonymous)
+      (List.map (Evd.meta_name clenv.env) (collect_meta_variables ccl)) in
     errorlabstrm "inversion" 
       (str ("Cannot find an instantiation for variable"^
 	       (if List.length metas = 1 then " " else "s ")) ++
-	 prlist_with_sep pr_coma pr_id metas
-	 (* ajouter "in " ++ prterm ccl mais il faut le bon contexte *))
+	 prlist_with_sep pr_coma pr_name metas
+	 (* ajouter "in " ++ pr_lconstr ccl mais il faut le bon contexte *))
 
 let var_occurs_in_pf gl id =
   let env = pf_env gl in
@@ -88,8 +88,7 @@ let var_occurs_in_pf gl id =
 type inversion_status = Dep of constr option | NoDep
 
 let compute_eqn env sigma n i ai =
-  (ai,get_type_of env sigma ai),
-  (mkRel (n-i),get_type_of env sigma (mkRel (n-i)))
+  (ai, (mkRel (n-i),get_type_of env sigma (mkRel (n-i))))
 
 let make_inv_predicate env sigma indf realargs id status concl =
   let nrealargs = List.length realargs in
@@ -112,7 +111,7 @@ let make_inv_predicate env sigma indf realargs id status concl =
               | None ->
 		let sort = get_sort_of env sigma concl in
 		let p = make_arity env true indf sort in
-		abstract_list_all env sigma p concl (realargs@[mkVar id]) in
+		Unification.abstract_list_all env sigma p concl (realargs@[mkVar id]) in
 	  let hyps,bodypred = decompose_lam_n_assum (nrealargs+1) pred in
 	  (* We lift to make room for the equations *)
 	  (hyps,lift nrealargs bodypred)
@@ -128,14 +127,13 @@ let make_inv_predicate env sigma indf realargs id status concl =
    In any case, we carry along the rest of pairs *)
   let rec build_concl eqns n = function
     | [] -> (prod_it concl eqns,n)
-    | ((ai,ati),(xi,ti))::restlist ->
+    | (ai,(xi,ti))::restlist ->
         let (lhs,eqnty,rhs) =
           if closed0 ti then 
 	    (xi,ti,ai)
           else 
-	    make_iterated_tuple env' sigma (ai,ati) (xi,ti)
+	    make_iterated_tuple env' sigma ai (xi,ti)
 	in
-        let sort = get_sort_of env sigma concl in 
         let eq_term = Coqlib.build_coq_eq () in
         let eqn = applist (eq_term ,[eqnty;lhs;rhs]) in 
 	build_concl ((Anonymous,lift n eqn)::eqns) (n+1) restlist
@@ -306,17 +304,16 @@ let remember_first_eq id x = if !x = None then x := Some id
    a rewrite rule. It erases the clause which is given as input *)
 
 let projectAndApply thin id eqname names depids gls =
-  let env = pf_env gls in
-  let clearer id =
-    if thin then clear [id] else (remember_first_eq id eqname; tclIDTAC) in
-  let subst_hyp_LR id = tclTHEN (tclTRY(hypSubst_LR id onConcl)) (clearer id) in
-  let subst_hyp_RL id = tclTHEN (tclTRY(hypSubst_RL id onConcl)) (clearer id) in
+  let subst_hyp l2r id =
+    tclTHEN (tclTRY(rewriteInConcl l2r (mkVar id)))
+      (if thin then clear [id] else (remember_first_eq id eqname; tclIDTAC))
+  in
   let substHypIfVariable tac id gls =
     let (t,t1,t2) = Hipattern.dest_nf_eq gls (pf_get_hyp_typ gls id) in
     match (kind_of_term t1, kind_of_term t2) with
-      | Var id1, _ -> generalizeRewriteIntros (subst_hyp_LR id) depids id1 gls
-      | _, Var id2 -> generalizeRewriteIntros (subst_hyp_RL id) depids id2 gls
-      | _ -> tac id gls
+    | Var id1, _ -> generalizeRewriteIntros (subst_hyp true id) depids id1 gls
+    | _, Var id2 -> generalizeRewriteIntros (subst_hyp false id) depids id2 gls
+    | _ -> tac id gls
   in
   let deq_trailer id neqns =
     tclTHENSEQ 
@@ -326,7 +323,7 @@ let projectAndApply thin id eqname names depids gls =
 	   (intro_move idopt None)
 	   (* try again to substitute and if still not a variable after *)
 	   (* decomposition, arbitrarily try to rewrite RL !? *)
-	   (tclTRY (onLastHyp (substHypIfVariable subst_hyp_RL))))
+	   (tclTRY (onLastHyp (substHypIfVariable (subst_hyp false)))))
 	 names);
        (if names = [] then clear [id] else tclIDTAC)]
   in
@@ -380,6 +377,8 @@ let rewrite_equations_gene othin neqns ba gl =
 let rec get_names allow_conj = function
   | IntroWildcard ->
       error "Discarding pattern not allowed for inversion equations"
+  | IntroAnonymous ->
+      error "Anonymous pattern not allowed for inversion equations"
   | IntroOrAndPattern [l] -> 
       if allow_conj then
 	if l = [] then (None,[]) else
@@ -401,7 +400,6 @@ let rewrite_equations othin neqns names ba gl =
   let (depids,nodepids) = split_dep_and_nodep ba.assums gl in
   let rewrite_eqns =
     let first_eq = ref None in
-    let update id = if !first_eq = None then first_eq := Some id in
     match othin with
       | Some thin ->
           tclTHENSEQ
@@ -446,12 +444,11 @@ let rewrite_equations_tac (gene, othin) id neqns names ba =
 let raw_inversion inv_kind indbinding id status names gl =
   let env = pf_env gl and sigma = project gl in
   let c = mkVar id in
-  let (wc,kONT) = startWalk gl in
   let t = strong_prodspine (pf_whd_betadeltaiota gl) (pf_type_of gl c) in
-  let indclause = mk_clenv_from wc (c,t) in
+  let indclause = mk_clenv_from gl (c,t) in
   let indclause' = clenv_constrain_with_bindings indbinding indclause in
-  let newc = clenv_instance_template indclause' in
-  let ccl = clenv_instance_template_type indclause' in
+  let newc = clenv_value indclause' in
+  let ccl = clenv_type indclause' in
   check_no_metas indclause' ccl;
   let IndType (indf,realargs) =
     try find_rectype env sigma ccl
@@ -477,7 +474,7 @@ let raw_inversion inv_kind indbinding id status names gl =
         (fun id ->
            (tclTHEN
               (apply_term (mkVar id)
-                 (list_tabulate (fun _ -> mkMeta(Clenv.new_meta())) neqns))
+                 (list_tabulate (fun _ -> Evarutil.mk_new_meta()) neqns))
               reflexivity))])
   gl
 
@@ -524,15 +521,15 @@ open Tacexpr
 
 let inv k = inv_gen false k NoDep
 
-let half_inv_tac id  = inv SimpleInversion None (NamedHyp id)
-let inv_tac id       = inv FullInversion None (NamedHyp id)
-let inv_clear_tac id = inv FullInversionClear None (NamedHyp id)
+let half_inv_tac id  = inv SimpleInversion IntroAnonymous (NamedHyp id)
+let inv_tac id       = inv FullInversion IntroAnonymous (NamedHyp id)
+let inv_clear_tac id = inv FullInversionClear IntroAnonymous (NamedHyp id)
 
 let dinv k c = inv_gen false k (Dep c)
 
-let half_dinv_tac id  = dinv SimpleInversion None None (NamedHyp id)
-let dinv_tac id       = dinv FullInversion None None (NamedHyp id)
-let dinv_clear_tac id = dinv FullInversionClear None None (NamedHyp id)
+let half_dinv_tac id  = dinv SimpleInversion None IntroAnonymous (NamedHyp id)
+let dinv_tac id       = dinv FullInversion None IntroAnonymous (NamedHyp id)
+let dinv_clear_tac id = dinv FullInversionClear None IntroAnonymous (NamedHyp id)
 
 (* InvIn will bring the specified clauses into the conclusion, and then
  * perform inversion on the named hypothesis.  After, it will intro them
diff --git a/tactics/inv.mli b/tactics/inv.mli
index e19d8232..bd38d08f 100644
--- a/tactics/inv.mli
+++ b/tactics/inv.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: inv.mli,v 1.10.2.1 2004/07/16 19:30:53 herbelin Exp $ i*)
+(*i $Id: inv.mli 7880 2006-01-16 13:59:08Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -21,19 +21,19 @@ type inversion_status = Dep of constr option | NoDep
 
 val inv_gen :
   bool -> inversion_kind -> inversion_status ->
-    intro_pattern_expr option -> quantified_hypothesis -> tactic
+    intro_pattern_expr -> quantified_hypothesis -> tactic
 val invIn_gen :
-  inversion_kind -> intro_pattern_expr option -> identifier list -> 
+  inversion_kind -> intro_pattern_expr -> identifier list -> 
     quantified_hypothesis -> tactic
 
 val inv_clause :
-  inversion_kind -> intro_pattern_expr option -> identifier list ->
+  inversion_kind -> intro_pattern_expr -> identifier list ->
     quantified_hypothesis -> tactic
 
-val inv : inversion_kind -> intro_pattern_expr option ->
+val inv : inversion_kind -> intro_pattern_expr ->
   quantified_hypothesis -> tactic
 
-val dinv : inversion_kind -> constr option -> intro_pattern_expr option ->
+val dinv : inversion_kind -> constr option -> intro_pattern_expr ->
   quantified_hypothesis -> tactic
 
 val half_inv_tac : identifier -> tactic
diff --git a/tactics/leminv.ml b/tactics/leminv.ml
index 1be465f5..7974ce56 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: leminv.ml,v 1.41.2.1 2004/07/16 19:30:54 herbelin Exp $ *)
+(* $Id: leminv.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 open Pp
 open Util
@@ -40,7 +40,7 @@ let not_work_message = "tactic fails to build the inversion lemma, may be becaus
 
 let no_inductive_inconstr env constr =
   (str "Cannot recognize an inductive predicate in " ++ 
-     prterm_env env constr ++
+     pr_lconstr_env env constr ++
      str "." ++ spc () ++ str "If there is one, may be the structure of the arity" ++
      spc () ++ str "or of the type of constructors" ++ spc () ++
      str "is hidden by constant definitions.")
@@ -216,7 +216,7 @@ let inversion_scheme env sigma t sort dep_option inv_op =
     errorlabstrm "lemma_inversion"
     (str"Computed inversion goal was not closed in initial signature");
   *)
-  let invSign = named_context invEnv in
+  let invSign = named_context_val invEnv in
   let pfs = mk_pftreestate (mk_goal invSign invGoal) in
   let pfs = solve_pftreestate (tclTHEN intro (onLastHyp inv_op)) pfs in
   let (pfterm,meta_types) = extract_open_pftreestate pfs in
@@ -245,9 +245,11 @@ let add_inversion_lemma name env sigma t sort dep inv_op =
   let invProof = inversion_scheme env sigma t sort dep inv_op in
   let _ = 
     declare_constant name
-    (DefinitionEntry { const_entry_body = invProof;
-                     const_entry_type = None;
-                     const_entry_opaque = false }, 
+    (DefinitionEntry 
+       { const_entry_body = invProof;
+         const_entry_type = None;
+         const_entry_opaque = false;
+	 const_entry_boxed = true && (Options.boxed_definitions())}, 
      IsProof Lemma)
   in ()
 
@@ -256,13 +258,15 @@ let add_inversion_lemma name env sigma t sort dep inv_op =
 (* inv_op = Inv (derives de complete inv. lemma)
  * inv_op = InvNoThining (derives de semi inversion lemma) *)
 
-let inversion_lemma_from_goal n na id sort dep_option inv_op =
+let inversion_lemma_from_goal n na (loc,id) sort dep_option inv_op =
   let pts = get_pftreestate() in
   let gl = nth_goal_of_pftreestate n pts in
-  let t = pf_get_hyp_typ gl id in
+  let t = 
+    try pf_get_hyp_typ gl id
+    with Not_found -> Pretype_errors.error_var_not_found_loc loc id in
   let env = pf_env gl and sigma = project gl in
-  let fv = global_vars env t in
 (* Pourquoi ??? 
+  let fv = global_vars env t in
   let thin_ids = thin_ids (hyps,fv) in
   if not(list_subset thin_ids fv) then
     errorlabstrm "lemma_inversion"
@@ -287,15 +291,14 @@ let add_inversion_lemma_exn na com comsort bool tac =
 
 let lemInv id c gls =
   try
-    let (wc,kONT) = startWalk gls in
-    let clause = mk_clenv_type_of wc c in
+    let clause = mk_clenv_type_of gls c in
     let clause = clenv_constrain_with_bindings [(-1,mkVar id)] clause in
-    elim_res_pf kONT clause true gls
+    Clenvtac.res_pf clause ~allow_K:true gls
   with 
     |  UserError (a,b) -> 
 	 errorlabstrm "LemInv" 
 	   (str "Cannot refine current goal with the lemma " ++ 
-	      prterm_env (Global.env()) c) 
+	      pr_lconstr_env (Global.env()) c) 
 
 let lemInv_gen id c = try_intros_until (fun id -> lemInv id c) id
 
diff --git a/tactics/leminv.mli b/tactics/leminv.mli
index 6617edf2..3e12f770 100644
--- a/tactics/leminv.mli
+++ b/tactics/leminv.mli
@@ -1,4 +1,4 @@
-
+open Util
 open Names
 open Term
 open Rawterm
@@ -12,7 +12,7 @@ val lemInv_clause :
   quantified_hypothesis -> constr -> identifier list -> tactic
 
 val inversion_lemma_from_goal :
-  int -> identifier -> identifier -> sorts -> bool ->
+  int -> identifier -> identifier located -> sorts -> bool ->
     (identifier -> tactic) -> unit
 val add_inversion_lemma_exn :
   identifier -> constr_expr -> rawsort -> bool -> (identifier -> tactic) ->
diff --git a/tactics/nbtermdn.ml b/tactics/nbtermdn.ml
index bd4fb60e..0867d220 100644
--- a/tactics/nbtermdn.ml
+++ b/tactics/nbtermdn.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: nbtermdn.ml,v 1.7.16.1 2004/07/16 19:30:54 herbelin Exp $ *)
+(* $Id: nbtermdn.ml 6427 2004-12-07 17:41:10Z sacerdot $ *)
 
 open Util
 open Names
@@ -14,6 +14,7 @@ open Term
 open Libobject
 open Library
 open Pattern
+open Libnames
 
 (* Named, bounded-depth, term-discrimination nets.
    Implementation:
@@ -28,11 +29,11 @@ open Pattern
 
 type ('na,'a) t = {
   mutable table : ('na,constr_pattern * 'a) Gmap.t;
-  mutable patterns : (constr_label option,'a Btermdn.t) Gmap.t }
+  mutable patterns : (global_reference option,'a Btermdn.t) Gmap.t }
 
 type ('na,'a) frozen_t = 
     ('na,constr_pattern * 'a) Gmap.t
-    * (constr_label option,'a Btermdn.t) Gmap.t
+    * (global_reference option,'a Btermdn.t) Gmap.t
 
 let create () =
   { table = Gmap.empty;
diff --git a/tactics/nbtermdn.mli b/tactics/nbtermdn.mli
index 90656619..579b24d4 100644
--- a/tactics/nbtermdn.mli
+++ b/tactics/nbtermdn.mli
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: nbtermdn.mli,v 1.8.16.1 2004/07/16 19:30:54 herbelin Exp $ i*)
+(*i $Id: nbtermdn.mli 6427 2004-12-07 17:41:10Z sacerdot $ i*)
 
 (*i*)
 open Term
 open Pattern
+open Libnames
 (*i*)
 
 (* Named, bounded-depth, term-discrimination nets. *)
@@ -34,4 +35,4 @@ val freeze : ('na,'a) t -> ('na,'a) frozen_t
 val unfreeze : ('na,'a) frozen_t -> ('na,'a) t -> unit
 val empty : ('na,'a) t -> unit
 val to2lists : ('na,'a) t -> ('na * (constr_pattern * 'a)) list * 
-                             (constr_label option * 'a Btermdn.t) list
+                             (global_reference option * 'a Btermdn.t) list
diff --git a/tactics/refine.ml b/tactics/refine.ml
index 4a2fb01b..712e1f81 100644
--- a/tactics/refine.ml
+++ b/tactics/refine.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: refine.ml,v 1.34.2.2 2004/07/16 19:30:54 herbelin Exp $ *)
+(* $Id: refine.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 (* JCF -- 6 janvier 1998  EXPERIMENTAL *)
 
@@ -66,12 +66,12 @@ and  sg_proofs       = (term_with_holes option) list
 (* pour debugger *)
 
 let rec pp_th (TH(c,mm,sg)) =
-  (str"TH=[ " ++ hov 0 (prterm c ++ fnl () ++
+  (str"TH=[ " ++ hov 0 (pr_lconstr c ++ fnl () ++
 			      (* pp_mm mm ++ fnl () ++ *)
 			   pp_sg sg) ++ str "]")
 and pp_mm l =
   hov 0 (prlist_with_sep (fun _ -> (fnl ())) 
-	   (fun (n,c) -> (int n ++ str" --> " ++ prterm c)) l)
+	   (fun (n,c) -> (int n ++ str" --> " ++ pr_lconstr c)) l)
 and pp_sg sg =
   hov 0 (prlist_with_sep (fun _ -> (fnl ()))
 	   (function None -> (str"None") | Some th -> (pp_th th)) sg)
@@ -89,72 +89,71 @@ and pp_sg sg =
  *  meta_map correspond à celui des buts qui seront engendrés par le refine.
  *)
 
-let replace_by_meta env gmm = function
+let replace_by_meta env = function
   | TH (m, mm, sgp) when isMeta (strip_outer_cast m) -> m,mm,sgp
   | (TH (c,mm,_)) as th ->
-      let n = Clenv.new_meta() in
+      let n = Evarutil.new_meta() in
       let m = mkMeta n in
       (* quand on introduit une mv on calcule son type *)
       let ty = match kind_of_term c with
 	| Lambda (Name id,c1,c2) when isCast c2 ->
-	    mkNamedProd id c1 (snd (destCast c2))
+	    let _,_,t = destCast c2 in mkNamedProd id c1 t
 	| Lambda (Anonymous,c1,c2) when isCast c2 ->
-	    mkArrow c1 (snd (destCast c2))
+	    let _,_,t = destCast c2 in mkArrow c1 t
 	| _ -> (* (App _ | Case _) -> *)
-	    Retyping.get_type_of_with_meta env Evd.empty (gmm@mm) c
+	    Retyping.get_type_of_with_meta env Evd.empty mm c
 	(*
 	| Fix ((_,j),(v,_,_)) ->
 	    v.(j) (* en pleine confiance ! *)
 	| _ -> invalid_arg "Tcc.replace_by_meta (TO DO)" 
         *)
       in
-      mkCast (m,ty),[n,ty],[Some th]
+      mkCast (m,DEFAULTcast, ty),[n,ty],[Some th]
 
 exception NoMeta
 
-let replace_in_array env gmm a =
+let replace_in_array keep_length env a =
   if array_for_all (function (TH (_,_,[])) -> true | _ -> false) a then
     raise NoMeta;
   let a' = Array.map (function
-			| (TH (c,mm,[])) -> c,mm,[]
-			| th -> replace_by_meta env gmm th) a 
+			| (TH (c,mm,[])) when not keep_length -> c,mm,[]
+			| th -> replace_by_meta env th) a 
   in
-  let v' = Array.map (fun (x,_,_) -> x) a' in
-  let mm = Array.fold_left (@) [] (Array.map (fun (_,x,_) -> x) a') in
-  let sgp = Array.fold_left (@) [] (Array.map (fun (_,_,x) -> x) a') in
+  let v' = Array.map pi1 a' in
+  let mm = Array.fold_left (@) [] (Array.map pi2 a') in
+  let sgp = Array.fold_left (@) [] (Array.map pi3 a') in
   v',mm,sgp
     
 let fresh env n =
   let id = match n with Name x -> x | _ -> id_of_string "_" in
   next_global_ident_away true id (ids_of_named_context (named_context env))
 
-let rec compute_metamap env gmm c = match kind_of_term c with
+let rec compute_metamap env c = match kind_of_term c with
   (* le terme est directement une preuve *)
   | (Const _ | Evar _ | Ind _ | Construct _ |
     Sort _ | Var _ | Rel _) -> 
       TH (c,[],[])
+
   (* le terme est une mv => un but *)
   | Meta n ->
-      (* 
-      Pp.warning (Printf.sprintf ("compute_metamap: MV(%d) sans type !\n") n);
-      let ty = Retyping.get_type_of_with_meta env Evd.empty lmeta c in 
-      *)
       TH (c,[],[None])
-  | Cast (m,ty) when isMeta m -> 
+
+  | Cast (m,_, ty) when isMeta m -> 
       TH (c,[destMeta m,ty],[None])
 
+
   (* abstraction => il faut décomposer si le terme dessous n'est pas pur
    *    attention : dans ce cas il faut remplacer (Rel 1) par (Var x)
    *    où x est une variable FRAICHE *)
   | Lambda (name,c1,c2) ->
       let v = fresh env name in
       let env' = push_named (v,None,c1) env in
-      begin match compute_metamap env' gmm (subst1 (mkVar v) c2) with
+      begin match compute_metamap env' (subst1 (mkVar v) c2) with
 	(* terme de preuve complet *)
 	| TH (_,_,[]) -> TH (c,[],[])
 	(* terme de preuve incomplet *)    
 	| th ->
-	    let m,mm,sgp = replace_by_meta env' gmm th in
+	    let m,mm,sgp = replace_by_meta env' th in
 	    TH (mkLambda (Name v,c1,m), mm, sgp)
       end
 
@@ -163,21 +162,21 @@ let rec compute_metamap env gmm c = match kind_of_term c with
 	error "Refine: body of let-in cannot contain existentials";
       let v = fresh env name in
       let env' = push_named (v,Some c1,t1) env in
-      begin match compute_metamap env' gmm (subst1 (mkVar v) c2) with
+      begin match compute_metamap env' (subst1 (mkVar v) c2) with
 	(* terme de preuve complet *)
 	| TH (_,_,[]) -> TH (c,[],[])
 	(* terme de preuve incomplet *)    
 	| th ->
-	    let m,mm,sgp = replace_by_meta env' gmm th in
+	    let m,mm,sgp = replace_by_meta env' th in
 	    TH (mkLetIn (Name v,c1,t1,m), mm, sgp)
       end
 
   (* 4. Application *)
   | App (f,v) ->
-      let a = Array.map (compute_metamap env gmm) (Array.append [|f|] v) in
+      let a = Array.map (compute_metamap env) (Array.append [|f|] v) in
       begin
 	try
-	  let v',mm,sgp = replace_in_array env gmm a in
+	  let v',mm,sgp = replace_in_array false env a in
           let v'' = Array.sub v' 1 (Array.length v) in
           TH (mkApp(v'.(0), v''),mm,sgp)
 	with NoMeta ->
@@ -188,10 +187,10 @@ let rec compute_metamap env gmm c = match kind_of_term c with
       (* bof... *)
       let nbr = Array.length v in
       let v = Array.append [|p;cc|] v in
-      let a = Array.map (compute_metamap env gmm) v in
+      let a = Array.map (compute_metamap env) v in
       begin
 	try
-	  let v',mm,sgp = replace_in_array env gmm a in
+	  let v',mm,sgp = replace_in_array false env a in
 	  let v'' = Array.sub v' 2 nbr in
 	  TH (mkCase (ci,v'.(0),v'.(1),v''),mm,sgp)
 	with NoMeta ->
@@ -205,12 +204,12 @@ let rec compute_metamap env gmm c = match kind_of_term c with
       let fi' = Array.map (fun id -> Name id) vi in
       let env' = push_named_rec_types (fi',ai,v) env in
       let a = Array.map
-		(compute_metamap env' gmm)
+		(compute_metamap env')
 		(Array.map (substl (List.map mkVar (Array.to_list vi))) v) 
       in
       begin
 	try
-	  let v',mm,sgp = replace_in_array env' gmm a in
+	  let v',mm,sgp = replace_in_array true env' a in
 	  let fix = mkFix ((ni,i),(fi',ai,v')) in
 	  TH (fix,mm,sgp)
 	with NoMeta ->
@@ -218,7 +217,7 @@ let rec compute_metamap env gmm c = match kind_of_term c with
       end
 	      
   (* Cast. Est-ce bien exact ? *)
-  | Cast (c,t) -> compute_metamap env gmm c
+  | Cast (c,_,t) -> compute_metamap env c
       (*let TH (c',mm,sgp) = compute_metamap sign c in
 	TH (mkCast (c',t),mm,sgp) *)
       
@@ -235,12 +234,12 @@ let rec compute_metamap env gmm c = match kind_of_term c with
       let fi' = Array.map (fun id -> Name id) vi in
       let env' = push_named_rec_types (fi',ai,v) env in
       let a = Array.map
-		(compute_metamap env' gmm)
+		(compute_metamap env')
 		(Array.map (substl (List.map mkVar (Array.to_list vi))) v) 
       in
       begin
 	try
-	  let v',mm,sgp = replace_in_array env' gmm a in
+	  let v',mm,sgp = replace_in_array true env' a in
 	  let cofix = mkCoFix (i,(fi',ai,v')) in
 	  TH (cofix,mm,sgp)
 	with NoMeta ->
@@ -253,14 +252,14 @@ let rec compute_metamap env gmm c = match kind_of_term c with
  *  Réalise le 3. ci-dessus
  *)
 
-let rec tcc_aux subst (TH (c,mm,sgp) as th) gl =
+let rec tcc_aux subst (TH (c,mm,sgp) as _th) gl =
   let c = substl subst c in
   match (kind_of_term c,sgp) with
     (* mv => sous-but : on ne fait rien *)
     | Meta _ , _ ->
 	tclIDTAC gl
 
-    | Cast (c,_), _ when isMeta c ->
+    | Cast (c,_,_), _ when isMeta c ->
 	tclIDTAC gl
 	  
     (* terme pur => refine *)
@@ -339,8 +338,8 @@ let rec tcc_aux subst (TH (c,mm,sgp) as th) gl =
 
 let refine oc gl =
   let sigma = project gl in
-  let env = pf_env gl in
-  let (gmm,c) = Clenv.exist_to_meta sigma oc in
-  let th = compute_metamap env gmm c in
-  tcc_aux [] th gl
-
+  let (sigma,c) = Evarutil.evars_to_metas sigma oc in
+  (* Relies on Cast's put on Meta's by evars_to_metas, because it is otherwise 
+     complicated to update meta types when passing through a binder *)
+  let th = compute_metamap (pf_env gl) c in
+  tclTHEN (Refiner.tclEVARS sigma) (tcc_aux [] th) gl
diff --git a/tactics/refine.mli b/tactics/refine.mli
index e053aea6..aae1f5e1 100644
--- a/tactics/refine.mli
+++ b/tactics/refine.mli
@@ -6,9 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: refine.mli,v 1.7.2.1 2004/07/16 19:30:55 herbelin Exp $ i*)
+(*i $Id: refine.mli 6099 2004-09-12 11:38:09Z barras $ i*)
 
-open Term
 open Tacmach
 
-val refine : Pretyping.open_constr -> tactic
+val refine : Evd.open_constr -> tactic
diff --git a/tactics/setoid_replace.ml b/tactics/setoid_replace.ml
index 74b062e0..a6331927 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,v 1.31.2.1 2004/07/16 19:30:55 herbelin Exp $ *)
+(* $Id: setoid_replace.ml 8683 2006-04-05 15:47:39Z letouzey $ *)
 
 open Tacmach
 open Proof_type
@@ -22,6 +22,8 @@ open Util
 open Pp
 open Printer
 open Environ
+open Clenv
+open Unification
 open Tactics 
 open Tacticals
 open Vernacexpr
@@ -29,106 +31,365 @@ open Safe_typing
 open Nametab
 open Decl_kinds
 open Constrintern
-
-type setoid =
-    { set_a : constr;
-      set_aeq : constr;
-      set_th : constr
+open Mod_subst
+
+let replace = ref (fun _ _ -> assert false)
+let register_replace f = replace := f
+
+let general_rewrite = ref (fun _ _ -> assert false)
+let register_general_rewrite f = general_rewrite := f
+
+(* util function; it should be in util.mli *)
+let prlist_with_sepi sep elem =
+ let rec aux n =
+  function
+   | []   -> mt ()
+   | [h]  -> elem n h
+   | h::t ->
+      let e = elem n h and s = sep() and r = aux (n+1) t in
+      e ++ s ++ r
+ in
+  aux 1
+
+type relation =
+   { rel_a: constr ;
+     rel_aeq: constr;
+     rel_refl: constr option;
+     rel_sym: constr option;
+     rel_trans : constr option;
+     rel_quantifiers_no: int  (* it helps unification *);
+     rel_X_relation_class: constr;
+     rel_Xreflexive_relation_class: constr
+   }
+
+type 'a relation_class =
+   Relation of 'a            (* the rel_aeq of the relation or the relation   *)
+ | Leibniz of constr option  (* the carrier (if eq is partially instantiated) *)
+
+type 'a morphism =
+    { args : (bool option * 'a relation_class) list;
+      output : 'a relation_class;
+      lem : constr;
+      morphism_theory : constr
     }
 
-type morphism =
-    { lem : constr;
-      profil : bool list;
-      arg_types : constr list;
-      lem2 : constr option
+type funct =
+    { f_args : constr list;
+      f_output : constr
     }
 
+type morphism_class =
+   ACMorphism of relation morphism
+ | ACFunction of funct
+
+let subst_mps_in_relation_class subst =
+ function
+    Relation  t -> Relation  (subst_mps subst t)
+  | Leibniz t -> Leibniz (option_app (subst_mps subst) t) 
+
+let subst_mps_in_argument_class subst (variance,rel) =
+ variance, subst_mps_in_relation_class subst rel
+
+let constr_relation_class_of_relation_relation_class =
+ function
+    Relation relation -> Relation relation.rel_aeq
+  | Leibniz t -> Leibniz t
+ 
+
 let constr_of c = Constrintern.interp_constr Evd.empty (Global.env()) c
 
 let constant dir s = Coqlib.gen_constant "Setoid_replace" ("Setoids"::dir) s
-
-let global_constant dir s =Coqlib.gen_constant "Setoid_replace" ("Init"::dir) s
+let gen_constant dir s = Coqlib.gen_constant "Setoid_replace" dir s
+let reference dir s = Coqlib.gen_reference "Setoid_replace" ("Setoids"::dir) s
+let eval_reference dir s = EvalConstRef (destConst (constant dir s))
+let eval_init_reference dir s = EvalConstRef (destConst (gen_constant ("Init"::dir) s))
 
 let current_constant id =
   try
     global_reference id
   with Not_found ->
-    anomaly ("Setoid: cannot find "^(string_of_id id))
-
-(* Setoid_theory *)
-
-let coq_Setoid_Theory = lazy(constant ["Setoid"] "Setoid_Theory")
-
-let coq_seq_refl = lazy(constant ["Setoid"] "Seq_refl")
-let coq_seq_sym = lazy(constant ["Setoid"] "Seq_sym")
-let coq_seq_trans = lazy(constant ["Setoid"] "Seq_trans")
-
-let coq_fleche = lazy(constant ["Setoid"] "fleche")
-
-(* Coq constants *)
+    anomaly ("Setoid: cannot find " ^ (string_of_id id))
 
-let coqeq = lazy(global_constant ["Logic"] "eq")
+(* From Setoid.v *)
 
-let coqconj = lazy(global_constant ["Logic"] "conj")
-let coqand = lazy(global_constant ["Logic"] "and")
-let coqproj1 = lazy(global_constant ["Logic"] "proj1")
-let coqproj2 = lazy(global_constant ["Logic"] "proj2")
-
-(************************* Table of declared setoids **********************)
+let coq_reflexive =
+ lazy(gen_constant ["Relations"; "Relation_Definitions"] "reflexive")
+let coq_symmetric =
+ lazy(gen_constant ["Relations"; "Relation_Definitions"] "symmetric")
+let coq_transitive =
+ lazy(gen_constant ["Relations"; "Relation_Definitions"] "transitive")
+let coq_relation =
+ lazy(gen_constant ["Relations"; "Relation_Definitions"] "relation")
 
+let coq_Relation_Class = lazy(constant ["Setoid"] "Relation_Class")
+let coq_Argument_Class = lazy(constant ["Setoid"] "Argument_Class")
+let coq_Setoid_Theory = lazy(constant ["Setoid"] "Setoid_Theory")
+let coq_Morphism_Theory = lazy(constant ["Setoid"] "Morphism_Theory")
+let coq_Build_Morphism_Theory= lazy(constant ["Setoid"] "Build_Morphism_Theory")
+let coq_Compat = lazy(constant ["Setoid"] "Compat")
 
-(* Setoids are stored in a table which is synchronised with the Reset mechanism. *)
+let coq_AsymmetricReflexive = lazy(constant ["Setoid"] "AsymmetricReflexive")
+let coq_SymmetricReflexive = lazy(constant ["Setoid"] "SymmetricReflexive")
+let coq_SymmetricAreflexive = lazy(constant ["Setoid"] "SymmetricAreflexive")
+let coq_AsymmetricAreflexive = lazy(constant ["Setoid"] "AsymmetricAreflexive")
+let coq_Leibniz = lazy(constant ["Setoid"] "Leibniz")
 
-module Cmap = Map.Make(struct type t = constr let compare = compare end)
+let coq_RAsymmetric = lazy(constant ["Setoid"] "RAsymmetric")
+let coq_RSymmetric = lazy(constant ["Setoid"] "RSymmetric")
+let coq_RLeibniz = lazy(constant ["Setoid"] "RLeibniz")
 
-let setoid_table = ref Gmap.empty
+let coq_ASymmetric = lazy(constant ["Setoid"] "ASymmetric")
+let coq_AAsymmetric = lazy(constant ["Setoid"] "AAsymmetric")
 
-let setoid_table_add (s,th) = setoid_table := Gmap.add s th !setoid_table
-let setoid_table_find s = Gmap.find s !setoid_table
-let setoid_table_mem s = Gmap.mem s !setoid_table
+let coq_seq_refl = lazy(constant ["Setoid"] "Seq_refl")
+let coq_seq_sym = lazy(constant ["Setoid"] "Seq_sym")
+let coq_seq_trans = lazy(constant ["Setoid"] "Seq_trans")
 
-let subst_setoid subst setoid = 
-  let set_a' = subst_mps subst setoid.set_a in
-  let set_aeq' = subst_mps subst setoid.set_aeq in
-  let set_th' = subst_mps subst setoid.set_th in
-    if set_a' == setoid.set_a
-      && set_aeq' == setoid.set_aeq
-      && set_th' == setoid.set_th
+let coq_variance = lazy(constant ["Setoid"] "variance")
+let coq_Covariant = lazy(constant ["Setoid"] "Covariant")
+let coq_Contravariant = lazy(constant ["Setoid"] "Contravariant")
+let coq_Left2Right = lazy(constant ["Setoid"] "Left2Right")
+let coq_Right2Left = lazy(constant ["Setoid"] "Right2Left")
+let coq_MSNone = lazy(constant ["Setoid"] "MSNone")
+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_equality_morphism_of_asymmetric_areflexive_transitive_relation =
+ lazy(constant ["Setoid"]
+  "equality_morphism_of_asymmetric_areflexive_transitive_relation")
+let coq_equality_morphism_of_symmetric_areflexive_transitive_relation =
+ lazy(constant ["Setoid"]
+  "equality_morphism_of_symmetric_areflexive_transitive_relation")
+let coq_equality_morphism_of_asymmetric_reflexive_transitive_relation =
+ lazy(constant ["Setoid"]
+  "equality_morphism_of_asymmetric_reflexive_transitive_relation")
+let coq_equality_morphism_of_symmetric_reflexive_transitive_relation =
+ lazy(constant ["Setoid"]
+  "equality_morphism_of_symmetric_reflexive_transitive_relation")
+let coq_make_compatibility_goal =
+ lazy(constant ["Setoid"] "make_compatibility_goal")
+let coq_make_compatibility_goal_eval_ref =
+ lazy(eval_reference ["Setoid"] "make_compatibility_goal")
+let coq_make_compatibility_goal_aux_eval_ref =
+ lazy(eval_reference ["Setoid"] "make_compatibility_goal_aux")
+
+let coq_App = lazy(constant ["Setoid"] "App")
+let coq_ToReplace = lazy(constant ["Setoid"] "ToReplace")
+let coq_ToKeep = lazy(constant ["Setoid"] "ToKeep")
+let coq_ProperElementToKeep = lazy(constant ["Setoid"] "ProperElementToKeep")
+let coq_fcl_singl = lazy(constant ["Setoid"] "fcl_singl")
+let coq_fcl_cons = lazy(constant ["Setoid"] "fcl_cons")
+
+let coq_setoid_rewrite = lazy(constant ["Setoid"] "setoid_rewrite")
+let coq_proj1 = lazy(gen_constant ["Init"; "Logic"] "proj1")
+let coq_proj2 = lazy(gen_constant ["Init"; "Logic"] "proj2")
+let coq_unit = lazy(gen_constant ["Init"; "Datatypes"] "unit")
+let coq_tt = lazy(gen_constant ["Init"; "Datatypes"] "tt")
+let coq_eq = lazy(gen_constant ["Init"; "Logic"] "eq")
+
+let coq_morphism_theory_of_function =
+ lazy(constant ["Setoid"] "morphism_theory_of_function")
+let coq_morphism_theory_of_predicate =
+ lazy(constant ["Setoid"] "morphism_theory_of_predicate")
+let coq_relation_of_relation_class =
+ lazy(eval_reference ["Setoid"] "relation_of_relation_class")
+let coq_directed_relation_of_relation_class =
+ lazy(eval_reference ["Setoid"] "directed_relation_of_relation_class")
+let coq_interp = lazy(eval_reference ["Setoid"] "interp")
+let coq_Morphism_Context_rect2 =
+ lazy(eval_reference ["Setoid"] "Morphism_Context_rect2")
+let coq_iff = lazy(gen_constant ["Init";"Logic"] "iff")
+let coq_impl = lazy(constant ["Setoid"] "impl")
+
+
+(************************* Table of declared relations **********************)
+
+
+(* Relations are stored in a table which is synchronised with the Reset mechanism. *)
+
+let relation_table = ref Gmap.empty
+
+let relation_table_add (s,th) = relation_table := Gmap.add s th !relation_table
+let relation_table_find s = Gmap.find s !relation_table
+let relation_table_mem s = Gmap.mem s !relation_table
+
+let prrelation s =
+ str "(" ++ pr_lconstr s.rel_a ++ str "," ++ pr_lconstr s.rel_aeq ++ str ")"
+
+let prrelation_class =
+ function
+    Relation eq  ->
+     (try prrelation (relation_table_find eq)
+      with Not_found ->
+       str "[[ Error: " ++ pr_lconstr eq ++
+        str " is not registered as a relation ]]")
+  | Leibniz (Some ty) -> pr_lconstr ty
+  | Leibniz None -> str "_"
+
+let prmorphism_argument_gen prrelation (variance,rel) =
+ prrelation rel ++
+  match variance with
+     None -> str " ==> "
+   | Some true -> str " ++> "
+   | Some false -> str " --> "
+
+let prargument_class = prmorphism_argument_gen prrelation_class
+
+let pr_morphism_signature (l,c) =
+ prlist (prmorphism_argument_gen Ppconstr.pr_constr_expr) l ++
+  Ppconstr.pr_constr_expr c
+
+let prmorphism k m =
+  pr_lconstr k ++ str ": " ++
+  prlist prargument_class m.args ++
+  prrelation_class m.output
+
+
+(* A function that gives back the only relation_class on a given carrier *)
+(*CSC: this implementation is really inefficient. I should define a new
+  map to make it efficient. However, is this really worth of? *)
+let default_relation_for_carrier ?(filter=fun _ -> true) a =
+ let rng = Gmap.rng !relation_table in
+ match List.filter (fun ({rel_a=rel_a} as r) -> rel_a = a && filter r) rng with
+    [] -> Leibniz (Some a)
+  | relation::tl ->
+     if tl <> [] then
+      ppnl
+       (str "Warning: There are several relations on the carrier \"" ++
+         pr_lconstr a ++ str "\". The relation " ++ prrelation relation ++
+         str " is chosen.") ;
+     Relation relation
+
+let find_relation_class rel =
+ try Relation (relation_table_find rel)
+ with
+  Not_found ->
+   let rel = Reduction.whd_betadeltaiota (Global.env ()) rel in
+   match kind_of_term rel with
+    | App (eq,[|ty|]) when eq_constr eq (Lazy.force coq_eq) -> Leibniz (Some ty)
+    | _ when eq_constr rel (Lazy.force coq_eq) -> Leibniz None
+    | _ -> raise Not_found
+
+let coq_iff_relation = lazy (find_relation_class (Lazy.force coq_iff))
+let coq_impl_relation = lazy (find_relation_class (Lazy.force coq_impl))
+
+let relation_morphism_of_constr_morphism =
+ let relation_relation_class_of_constr_relation_class =
+  function
+     Leibniz t -> Leibniz t
+   | Relation aeq ->
+      Relation (try relation_table_find aeq with Not_found -> assert false)
+ in
+  function mor ->
+   let args' =
+    List.map
+     (fun (variance,rel) ->
+       variance, relation_relation_class_of_constr_relation_class rel
+     ) mor.args in
+   let output' = relation_relation_class_of_constr_relation_class mor.output in
+    {mor with args=args' ; output=output'}
+
+let subst_relation subst relation = 
+  let rel_a' = subst_mps subst relation.rel_a in
+  let rel_aeq' = subst_mps subst relation.rel_aeq in
+  let rel_refl' = option_app (subst_mps subst) relation.rel_refl in
+  let rel_sym' = option_app (subst_mps subst) relation.rel_sym in
+  let rel_trans' = option_app (subst_mps subst) relation.rel_trans in
+  let rel_X_relation_class' = subst_mps subst relation.rel_X_relation_class in
+  let rel_Xreflexive_relation_class' =
+   subst_mps subst relation.rel_Xreflexive_relation_class
+  in
+    if rel_a' == relation.rel_a
+      && rel_aeq' == relation.rel_aeq
+      && rel_refl' == relation.rel_refl
+      && rel_sym' == relation.rel_sym
+      && rel_trans' == relation.rel_trans
+      && rel_X_relation_class' == relation.rel_X_relation_class
+      && rel_Xreflexive_relation_class'==relation.rel_Xreflexive_relation_class
     then
-      setoid
+      relation
     else
-      { set_a = set_a' ;
-	set_aeq = set_aeq' ;
-	set_th = set_th' ;
+      { rel_a = rel_a' ;
+        rel_aeq = rel_aeq' ;
+        rel_refl = rel_refl' ;
+        rel_sym = rel_sym';
+        rel_trans = rel_trans';
+        rel_quantifiers_no = relation.rel_quantifiers_no;
+        rel_X_relation_class = rel_X_relation_class';
+        rel_Xreflexive_relation_class = rel_Xreflexive_relation_class'
       }
       
-let equiv_list () = List.map (fun x -> x.set_aeq) (Gmap.rng !setoid_table)
+let equiv_list () = List.map (fun x -> x.rel_aeq) (Gmap.rng !relation_table)
 
 let _ = 
-  Summary.declare_summary "setoid-table"
-    { Summary.freeze_function = (fun () -> !setoid_table);
-      Summary.unfreeze_function = (fun t -> setoid_table := t);
-      Summary.init_function = (fun () -> setoid_table := Gmap .empty);
+  Summary.declare_summary "relation-table"
+    { Summary.freeze_function = (fun () -> !relation_table);
+      Summary.unfreeze_function = (fun t -> relation_table := t);
+      Summary.init_function = (fun () -> relation_table := Gmap .empty);
       Summary.survive_module = false;
       Summary.survive_section = false }
 
-(* Declare a new type of object in the environment : "setoid-theory". *)
-
-let (setoid_to_obj, obj_to_setoid)=
-  let cache_set (_,(s, th)) = setoid_table_add (s,th)
+(* Declare a new type of object in the environment : "relation-theory". *)
+
+let (relation_to_obj, obj_to_relation)=
+  let cache_set (_,(s, th)) =
+   let th' =
+    if relation_table_mem s then
+     begin
+      let old_relation = relation_table_find s in
+       let th' =
+        {th with rel_sym =
+          match th.rel_sym with
+             None -> old_relation.rel_sym
+           | Some t -> Some t} in
+        ppnl
+         (str "Warning: The relation " ++ prrelation th' ++
+          str " is redeclared. The new declaration" ++
+           (match th'.rel_refl with
+              None -> str ""
+            | Some t -> str " (reflevity proved by " ++ pr_lconstr t) ++
+           (match th'.rel_sym with
+               None -> str ""
+             | Some t ->
+                (if th'.rel_refl = None then str " (" else str " and ") ++
+                str "symmetry proved by " ++ pr_lconstr t) ++
+           (if th'.rel_refl <> None && th'.rel_sym <> None then
+             str ")" else str "") ++
+           str " replaces the old declaration" ++
+           (match old_relation.rel_refl with
+              None -> str ""
+            | Some t -> str " (reflevity proved by " ++ pr_lconstr t) ++
+           (match old_relation.rel_sym with
+               None -> str ""
+             | Some t ->
+                (if old_relation.rel_refl = None then
+                  str " (" else str " and ") ++
+                str "symmetry proved by " ++ pr_lconstr t) ++
+           (if old_relation.rel_refl <> None && old_relation.rel_sym <> None
+            then str ")" else str "") ++
+           str ".");
+        th'
+     end
+    else
+     th
+   in
+    relation_table_add (s,th')
   and subst_set (_,subst,(s,th as obj)) =
     let s' = subst_mps subst s in
-    let th' = subst_setoid subst th in
+    let th' = subst_relation subst th in
       if s' == s && th' == th then obj else
-	(s',th')
+        (s',th')
   and export_set x = Some x 
   in 
-    declare_object {(default_object "setoid-theory") with
-		      cache_function = cache_set;
-		      open_function = (fun i o -> if i=1 then cache_set o);
-		      subst_function = subst_set;
-		      classify_function = (fun (_,x) -> Substitute x);
-		      export_function = export_set}
+    declare_object {(default_object "relation-theory") with
+                      cache_function = cache_set;
+                      load_function = (fun i o -> cache_set o);
+                      subst_function = subst_set;
+                      classify_function = (fun (_,x) -> Substitute x);
+                      export_function = export_set}
 
 (******************************* Table of declared morphisms ********************)
 
@@ -136,24 +397,56 @@ let (setoid_to_obj, obj_to_setoid)=
 
 let morphism_table = ref Gmap.empty
 
-let morphism_table_add (m,c) = morphism_table := Gmap.add m c !morphism_table
 let morphism_table_find m = Gmap.find m !morphism_table
-let morphism_table_mem m = Gmap.mem m !morphism_table
+let morphism_table_add (m,c) =
+ let old =
+  try
+   morphism_table_find m
+  with
+   Not_found -> []
+ in
+  try
+   let old_morph =
+    List.find
+     (function mor -> mor.args = c.args && mor.output = c.output) old
+   in
+    ppnl
+     (str "Warning: The morphism " ++ prmorphism m old_morph ++
+      str " is redeclared. " ++
+      str "The new declaration whose compatibility is proved by " ++
+       pr_lconstr c.lem ++ str " replaces the old declaration whose" ++
+       str " compatibility was proved by " ++
+       pr_lconstr old_morph.lem ++ str ".")
+  with
+   Not_found -> morphism_table := Gmap.add m (c::old) !morphism_table
+
+let default_morphism ?(filter=fun _ -> true) m =
+  match List.filter filter (morphism_table_find m) with
+      [] -> raise Not_found
+    | m1::ml ->
+        if ml <> [] then
+          ppnl
+            (str "Warning: There are several morphisms associated to \"" ++
+            pr_lconstr m ++ str"\". Morphism " ++ prmorphism m m1 ++
+            str " is randomly chosen.");
+        relation_morphism_of_constr_morphism m1
 
 let subst_morph subst morph = 
   let lem' = subst_mps subst morph.lem in
-  let arg_types' = list_smartmap (subst_mps subst) morph.arg_types in
-  let lem2' = option_smartmap (subst_mps subst) morph.lem2 in
+  let args' = list_smartmap (subst_mps_in_argument_class subst) morph.args in
+  let output' = subst_mps_in_relation_class subst morph.output in
+  let morphism_theory' = subst_mps subst morph.morphism_theory in
     if lem' == morph.lem
-      && arg_types' == morph.arg_types
-      && lem2' == morph.lem2
+      && args' == morph.args
+      && output' == morph.output
+      && morphism_theory' == morph.morphism_theory
     then
       morph
     else
-      { lem = lem' ;
-	profil = morph.profil ;
-	arg_types = arg_types' ;
-	lem2 = lem2' ;
+      { args = args' ;
+        output = output' ;
+        lem = lem' ;
+        morphism_theory = morphism_theory'
       }
 
 
@@ -173,139 +466,42 @@ let (morphism_to_obj, obj_to_morphism)=
     let m' = subst_mps subst m in
     let c' = subst_morph subst c in
       if m' == m && c' == c then obj else
-	(m',c')
+        (m',c')
   and export_set x = Some x 
   in 
     declare_object {(default_object "morphism-definition") with
-		      cache_function = cache_set;
-		      open_function = (fun i o -> if i=1 then cache_set o);
-		      subst_function = subst_set;
-		      classify_function = (fun (_,x) -> Substitute x);
-		      export_function = export_set}
-
-(************************** Adding a setoid to the database *********************)
-
-(* Find the setoid theory associated with a given type A.
-This implies that only one setoid theory can be declared for
-a given type A. *)
-
-let find_theory a =
-  try 
-    setoid_table_find a 
-  with Not_found ->
-    errorlabstrm "Setoid" 
-      (str "No Declared Setoid Theory for " ++
-	 prterm a ++ fnl () ++
-	 str "Use Add Setoid to declare it")
-    
-(* Add a Setoid to the database after a type verification. *)
-
-let eq_lem_common_sign env a eq =
-  let na = named_hd env a Anonymous in
-  let ne = named_hd env eq Anonymous in
-  [(ne,None,mkApp (eq, [|(mkRel 3);(mkRel 2)|]));
-   (ne,None,mkApp (eq, [|(mkRel 4);(mkRel 3)|]));
-   (na,None,a);(na,None,a);(na,None,a);(na,None,a)]
-
-(* Proof of (a,b,c,d:A)(eq a b)->(eq c d)->(eq a c)->(eq b d) *)
-let eq_lem_proof env a eq sym trans = 
-  let sign = eq_lem_common_sign env a eq in
-  let ne = named_hd env eq Anonymous in
-  let sign = (ne,None,mkApp (eq, [|(mkRel 6);(mkRel 4)|]))::sign in
-  let ccl = mkApp (eq, [|(mkRel 6);(mkRel 4)|]) in
-  let body =
-    mkApp (trans,
-      [|(mkRel 6);(mkRel 7);(mkRel 4);
-        (mkApp (sym, [|(mkRel 7);(mkRel 6);(mkRel 3)|]));
-	  (mkApp (trans,
-	    [|(mkRel 7);(mkRel 5);(mkRel 4);(mkRel 1);(mkRel 2)|]))|]) in
-  let p = it_mkLambda_or_LetIn body sign in
-  let t = it_mkProd_or_LetIn ccl sign in
-  (p,t)
-
-(* Proof of (a,b,c,d:A)(eq a b)->(eq c d)->((eq a c)<->(eq b d)) *)
-let eq_lem2_proof env a eq sym trans =
-  let sign = eq_lem_common_sign env a eq in
-  let ccl1 =
-    mkArrow
-      (mkApp (eq, [|(mkRel 6);(mkRel 4)|]))
-      (mkApp (eq, [|(mkRel 6);(mkRel 4)|])) in
-  let ccl2 =
-    mkArrow
-      (mkApp (eq, [|(mkRel 5);(mkRel 3)|]))
-      (mkApp (eq, [|(mkRel 7);(mkRel 5)|])) in
-  let ccl = mkApp (Lazy.force coqand, [|ccl1;ccl2|]) in
-  let body =
-    mkApp ((Lazy.force coqconj),
-    [|ccl1;ccl2;
-      lambda_create env
-	(mkApp (eq, [|(mkRel 6);(mkRel 4)|]),
-	(mkApp (trans,
-	  [|(mkRel 6);(mkRel 7);(mkRel 4);
-	    (mkApp (sym, [|(mkRel 7);(mkRel 6);(mkRel 3)|]));
-	    (mkApp (trans,
-	      [|(mkRel 7);(mkRel 5);(mkRel 4);(mkRel 1);(mkRel 2)|]))|])));
-      lambda_create env
-        (mkApp (eq, [|(mkRel 5);(mkRel 3)|]),
-        (mkApp (trans,
-          [|(mkRel 7);(mkRel 6);(mkRel 5);(mkRel 3);
-            (mkApp (trans,
-              [|(mkRel 6);(mkRel 4);(mkRel 5);(mkRel 1);
-                (mkApp (sym, [|(mkRel 5);(mkRel 4);(mkRel 2)|]))|]))|])))|])
-  in
-  let p = it_mkLambda_or_LetIn body sign in
-  let t = it_mkProd_or_LetIn ccl sign in
-  (p,t)
-
-let gen_eq_lem_name =
-  let i = ref 0 in
-    function () -> 
-      incr i;
-      make_ident "setoid_eq_ext" (Some !i)
-
-let add_setoid a aeq th =
-  if setoid_table_mem a 
-  then errorlabstrm "Add Setoid"
-    (str "A Setoid Theory is already declared for " ++ prterm a)
-  else let env = Global.env () in
-    if (is_conv env Evd.empty (Typing.type_of env Evd.empty th)
-	  (mkApp ((Lazy.force coq_Setoid_Theory), [| a; aeq |])))
-    then (Lib.add_anonymous_leaf 
-	    (setoid_to_obj 
-	       (a, { set_a = a;
-		     set_aeq = aeq;
-		     set_th = th}));
-	  let sym = mkApp ((Lazy.force coq_seq_sym), [|a; aeq; th|]) in
-	  let trans = mkApp ((Lazy.force coq_seq_trans), [|a; aeq; th|]) in
-	  let (eq_morph, eq_morph_typ) = eq_lem_proof env a aeq sym trans in
-	  let (eq_morph2, eq_morph2_typ) = eq_lem2_proof env a aeq sym trans in
-	    Options.if_verbose ppnl (prterm a ++str " is registered as a setoid");
-	    let eq_ext_name = gen_eq_lem_name () in 
-	    let eq_ext_name2 = gen_eq_lem_name () in 
-	    let _ = Declare.declare_constant eq_ext_name
-		      ((DefinitionEntry {const_entry_body = eq_morph; 
-		                       const_entry_type = Some eq_morph_typ;
-                                       const_entry_opaque = true}),
-		       IsProof Lemma) in
-	    let _ = Declare.declare_constant eq_ext_name2
-		      ((DefinitionEntry {const_entry_body = eq_morph2; 
-				       const_entry_type = Some eq_morph2_typ;
-                                       const_entry_opaque = true}),
-		       IsProof Lemma) in
-	    let eqmorph = (current_constant eq_ext_name) in
-	    let eqmorph2 = (current_constant eq_ext_name2) in
-	      (Lib.add_anonymous_leaf
-		 (morphism_to_obj (aeq, 
-				   { lem = eqmorph;
-				     profil = [true; true];
-				     arg_types = [a;a];
-				     lem2 = (Some eqmorph2)})));
-	      Options.if_verbose ppnl (prterm aeq ++str " is registered as a morphism"))
-    else errorlabstrm "Add Setoid" (str "Not a valid setoid theory")
-
-(* The vernac command "Add Setoid" *)
-let add_setoid a aeq th =
-  add_setoid (constr_of a) (constr_of aeq) (constr_of th)
+                      cache_function = cache_set;
+                      load_function = (fun i o -> cache_set o);
+                      subst_function = subst_set;
+                      classify_function = (fun (_,x) -> Substitute x);
+                      export_function = export_set}
+
+(************************** Printing relations and morphisms **********************)
+
+let print_setoids () =
+  Gmap.iter
+   (fun k relation ->
+     assert (k=relation.rel_aeq) ;
+     ppnl (str"Relation " ++ prrelation relation ++ str";" ++
+      (match relation.rel_refl with
+          None -> str ""
+        | Some t -> str" reflexivity proved by " ++ pr_lconstr t) ++
+      (match relation.rel_sym with
+          None -> str ""
+        | Some t -> str " symmetry proved by " ++ pr_lconstr t) ++
+      (match relation.rel_trans with
+          None -> str ""
+        | Some t -> str " transitivity proved by " ++ pr_lconstr t)))
+   !relation_table ;
+  Gmap.iter
+   (fun k l ->
+     List.iter
+      (fun ({lem=lem} as mor) ->
+        ppnl (str "Morphism " ++ prmorphism k mor ++
+        str ". Compatibility proved by " ++
+        pr_lconstr lem ++ str "."))
+      l) !morphism_table
+;;
 
 (***************** Adding a morphism to the database ****************************)
 
@@ -314,8 +510,8 @@ let add_setoid a aeq th =
 
 let edited = ref Gmap.empty
 
-let new_edited id m profil = 
-  edited := Gmap.add id (m,profil)  !edited
+let new_edited id m = 
+  edited := Gmap.add id m !edited
 
 let is_edited id =
   Gmap.mem id !edited
@@ -326,361 +522,1435 @@ let no_more_edited id =
 let what_edited id =
   Gmap.find id !edited
 
-let check_is_dependent t n =
-  let rec aux t i n =
-    if (i<n)
-    then (dependent (mkRel i) t) || (aux t (i+1) n)
-    else false
-  in aux t 0 n
-
-let gen_lem_name m = match kind_of_term m with 
-  | Var id -> add_suffix id "_ext"
-  | Const kn -> add_suffix (id_of_label (label kn)) "_ext"
-  | Ind (kn, i) -> add_suffix (id_of_label (label kn)) ((string_of_int i)^"_ext")
-  | Construct ((kn,i),j) -> add_suffix
-      (id_of_label (label kn)) ((string_of_int i)^(string_of_int j)^"_ext")
-  | _ -> errorlabstrm "New Morphism" (str "The term " ++ prterm m ++ str "is not a known name")
-
-let gen_lemma_tail m lisset body n =
-  let l = (List.length lisset) in
-  let a1 = Array.create l (mkRel 0) in
-  let a2 = Array.create l (mkRel 0) in
-  let rec aux i n = function
-    | true::q -> 
-	a1.(i) <- (mkRel n);
-	a2.(i) <- (mkRel (n-1));
-	aux (i+1) (n-2) q
-    | false::q ->
-	a1.(i) <- (mkRel n);
-	a2.(i) <- (mkRel n);
-	aux (i+1) (n-1) q
-    | [] -> () in 
-    aux 0 n lisset;
-    if (eq_constr body mkProp)
-    then mkArrow (mkApp (m,a1)) (lift 1 (mkApp (m, a2)))
-    else if (setoid_table_mem body)
-    then mkApp ((setoid_table_find body).set_aeq, [|(mkApp (m, a1)); (mkApp (m, a2))|])
-    else mkApp ((Lazy.force coqeq), [|body; (mkApp (m, a1)); (mkApp (m, a2))|])
-
-let gen_lemma_middle m larg lisset body n =
-  let rec aux la li i n = match (la, li) with
-    | ([], []) -> gen_lemma_tail m lisset body n
-    | (t::q, true::lq) -> 
-	mkArrow (mkApp ((setoid_table_find t).set_aeq, 
-			[|(mkRel i); (mkRel (i-1))|])) (aux q lq (i-1) (n+1))
-    | (t::q, false::lq) -> aux q lq (i-1) n
-    | _ -> assert false
-  in aux larg lisset n n
-
-let gen_compat_lemma env m body larg lisset = 
-  let rec aux la li n = match (la, li) with
-    | (t::q, true::lq) -> 
-	prod_create env (t,(prod_create env (t, (aux q lq (n+2)))))
-    | (t::q, false::lq) -> 
-	prod_create env (t, (aux q lq (n+1)))
-    | ([],[]) -> gen_lemma_middle m larg lisset body n
-    | _ -> assert false
-  in aux larg lisset 0
-
-let new_morphism m id hook =
-  if morphism_table_mem m
-  then errorlabstrm "New Morphism"
-    (str "The term " ++ prterm m ++ str " is already declared as a morphism")
-  else 
-    let env = Global.env() in
-    let typeofm = (Typing.type_of env Evd.empty m) in
-    let typ = (nf_betaiota typeofm) in  (* nf_bdi avant, mais bug *)
-    let (argsrev, body) = (decompose_prod typ) in
-    let args = (List.rev argsrev) in
-      if (args=[])
-      then errorlabstrm "New Morphism"
-	(str "The term " ++ prterm m ++ str " is not a product")
-      else if (check_is_dependent typ (List.length args))
-      then  errorlabstrm "New Morphism"
-	(str "The term " ++ prterm m ++ str " should not be a dependent product")
-      else (
-	let args_t = (List.map snd args) in
-	let poss = (List.map setoid_table_mem args_t) in
-	let lem = (gen_compat_lemma env m body args_t poss) in
-	new_edited id m poss;
-	Pfedit.start_proof id (IsGlobal (Proof Lemma)) 
-	  (Declare.clear_proofs (Global.named_context ()))
-	  lem hook;
-	(Options.if_verbose msg (Pfedit.pr_open_subgoals ())))
-
-let rec sub_bool l1 n = function
-  | [] -> []
-  | true::q -> ((List.hd l1), n)::(sub_bool (List.tl l1) (n-2) q)
-  | false::q -> (sub_bool (List.tl l1) (n-1) q)
-
-let gen_lemma_iff_tail m mext larg lisset n k =
-  let a1 = Array.create k (mkRel 0) in
-  let a2 = Array.create k (mkRel 0) in
-  let nb = List.length lisset in
-  let b1 = Array.create nb (mkRel 0) in
-  let b2 = Array.create nb (mkRel 0) in
-  let rec aux i j = function
-    |[] -> ()
-    |true::q ->
-       (a1.(i) <- (mkRel j);
-	a1.(i+1) <- (mkRel (j-1));
-	a2.(i) <- (mkRel (j-1));
-	a2.(i+1) <- (mkRel j);
-	aux (i+2) (j-2) q)
-    |false::q ->
-       (a1.(i) <- (mkRel j);
-	a2.(i) <- (mkRel j);
-	aux (i+1) (j-1) q) in
-  let rec aux2 i j = function
-    | (t,p)::q -> 
-	let th = (setoid_table_find t).set_th
-	and equiv = (setoid_table_find t).set_aeq in
-	  a1.(i) <- (mkRel j);
-	  a2.(i) <- mkApp ((Lazy.force coq_seq_sym),
-			   [|t; equiv; th; (mkRel p); (mkRel (p-1)); (mkRel j)|]);
-	  aux2 (i+1) (j-1) q
-    | [] -> () in
-  let rec aux3 i j = function
-    | true::q -> 
-	b1.(i) <- (mkRel j);
-	b2.(i) <- (mkRel (j-1));
-	aux3 (i+1) (j-2) q
-    | false::q ->
-	b1.(i) <- (mkRel j);
-	b2.(i) <- (mkRel j);
-	aux3 (i+1) (j-1) q
-    | [] -> () in 
-    aux 0 k lisset;
-    aux2 n (k-n) (sub_bool larg k lisset);
-    aux3 0 k lisset;
-    mkApp ((Lazy.force coqconj),
-	   [|(mkArrow (mkApp (m,b1)) (lift 1 (mkApp (m, b2))));
-	     (mkArrow (mkApp (m,b2)) (lift 1 (mkApp (m, b1))));
-	     (mkApp (mext, a1));(mkApp (mext, a2))|])
-
-let gen_lemma_iff_middle env m mext larg lisset n =
-  let rec aux la li i k = match (la, li) with
-    | ([], []) -> gen_lemma_iff_tail m mext larg lisset n k
-    | (t::q, true::lq) -> 
-	lambda_create env ((mkApp ((setoid_table_find t).set_aeq, [|(mkRel i); (mkRel (i-1))|])),
-			   (aux q lq (i-1) (k+1)))
-    | (t::q, false::lq) -> aux q lq (i-1) k
-    | _ -> assert false
-  in aux larg lisset n n
-
-let gen_lem_iff env m mext larg lisset =
-  let rec aux la li n = match (la, li) with
-    | (t::q, true::lq) -> 
-	lambda_create env (t,(lambda_create env (t, (aux q lq (n+2)))))
-    | (t::q, false::lq) -> 
-	lambda_create env (t, (aux q lq (n+1)))
-    | ([],[]) -> gen_lemma_iff_middle env m mext larg lisset n
-    | _ -> assert false
-  in aux larg lisset 0
-
-let add_morphism lem_name (m,profil) =
-  if morphism_table_mem m
-  then errorlabstrm "New Morphism"
-    (str "The term " ++ prterm m ++ str " is already declared as a morpism")
-  else 
-    let env = Global.env() in
-    let mext = (current_constant lem_name) in
-    let typeofm = (Typing.type_of env Evd.empty m) in
-    let typ = (nf_betaiota typeofm) in
-    let (argsrev, body) = (decompose_prod typ) in
-    let args = List.rev argsrev in
-    let args_t = (List.map snd args) in
-    let poss = (List.map setoid_table_mem args_t) in
-    let _ = assert (poss=profil) in
-      (if (eq_constr body mkProp)
-       then
-	 (let lem_2 = gen_lem_iff env m mext args_t poss in
-	  let lem2_name = add_suffix lem_name "2" in
-	  let _ = Declare.declare_constant lem2_name
-		    ((DefinitionEntry {const_entry_body = lem_2; 
-				     const_entry_type = None;
-                                     const_entry_opaque = true}),
-		     IsProof Lemma) in
-	  let lem2 = (current_constant lem2_name) in
-	    (Lib.add_anonymous_leaf
-	       (morphism_to_obj (m, 
-				 { lem = mext;
-				   profil = poss;
-				   arg_types = args_t;
-				   lem2 = (Some lem2)})));
-	    Options.if_verbose message ((string_of_id lem2_name) ^ " is defined"))
+(* also returns the triple (args_ty_quantifiers_rev,real_args_ty,real_output)
+   where the args_ty and the output are delifted *)
+let check_is_dependent n args_ty output =
+ let m = List.length args_ty - n in
+ let args_ty_quantifiers, args_ty = Util.list_chop n args_ty in
+  let rec aux m t =
+   match kind_of_term t with
+      Prod (n,s,t) when m > 0 ->
+       if not (dependent (mkRel 1) t) then
+        let args,out = aux (m - 1) (subst1 (mkRel 1) (* dummy *) t) in
+         s::args,out
+       else
+        errorlabstrm "New Morphism"
+         (str "The morphism is not a quantified non dependent product.")
+    | _ -> [],t
+  in
+   let ty = compose_prod (List.rev args_ty) output in
+   let args_ty, output = aux m ty in
+   List.rev args_ty_quantifiers, args_ty, output
+
+let cic_relation_class_of_X_relation typ value =
+ function
+    {rel_a=rel_a; rel_aeq=rel_aeq; rel_refl=Some refl; rel_sym=None} ->
+     mkApp ((Lazy.force coq_AsymmetricReflexive),
+      [| typ ; value ; rel_a ; rel_aeq; refl |])
+  | {rel_a=rel_a; rel_aeq=rel_aeq; rel_refl=Some refl; rel_sym=Some sym} ->
+     mkApp ((Lazy.force coq_SymmetricReflexive),
+      [| typ ; rel_a ; rel_aeq; sym ; refl |])
+  | {rel_a=rel_a; rel_aeq=rel_aeq; rel_refl=None; rel_sym=None} ->
+     mkApp ((Lazy.force coq_AsymmetricAreflexive),
+      [| typ ; value ; rel_a ; rel_aeq |])
+  | {rel_a=rel_a; rel_aeq=rel_aeq; rel_refl=None; rel_sym=Some sym} ->
+     mkApp ((Lazy.force coq_SymmetricAreflexive),
+      [| typ ; rel_a ; rel_aeq; sym |])
+
+let cic_relation_class_of_X_relation_class typ value =
+ function
+    Relation {rel_X_relation_class=x_relation_class} ->
+     mkApp (x_relation_class, [| typ ; value |])
+  | Leibniz (Some t) ->
+     mkApp ((Lazy.force coq_Leibniz), [| typ ; t |])
+  | Leibniz None -> assert false
+
+
+let cic_precise_relation_class_of_relation =
+ function
+    {rel_a=rel_a; rel_aeq=rel_aeq; rel_refl=Some refl; rel_sym=None} ->
+      mkApp ((Lazy.force coq_RAsymmetric), [| rel_a ; rel_aeq; refl |])
+  | {rel_a=rel_a; rel_aeq=rel_aeq; rel_refl=Some refl; rel_sym=Some sym} ->
+      mkApp ((Lazy.force coq_RSymmetric), [| rel_a ; rel_aeq; sym ; refl |])
+  | {rel_a=rel_a; rel_aeq=rel_aeq; rel_refl=None; rel_sym=None} ->
+      mkApp ((Lazy.force coq_AAsymmetric), [| rel_a ; rel_aeq |])
+  | {rel_a=rel_a; rel_aeq=rel_aeq; rel_refl=None; rel_sym=Some sym} ->
+      mkApp ((Lazy.force coq_ASymmetric), [| rel_a ; rel_aeq; sym |])
+
+let cic_precise_relation_class_of_relation_class =
+ function
+    Relation
+     {rel_aeq=rel_aeq; rel_Xreflexive_relation_class=lem; rel_refl=rel_refl }
+     ->
+      rel_aeq,lem,not(rel_refl=None)
+  | Leibniz (Some t) ->
+     mkApp ((Lazy.force coq_eq), [| t |]),
+      mkApp ((Lazy.force coq_RLeibniz), [| t |]), true
+  | Leibniz None -> assert false
+
+let cic_relation_class_of_relation_class rel =
+ cic_relation_class_of_X_relation_class
+  (Lazy.force coq_unit) (Lazy.force coq_tt) rel
+
+let cic_argument_class_of_argument_class (variance,arg) =
+ let coq_variant_value =
+  match variance with
+     None -> (Lazy.force coq_Covariant) (* dummy value, it won't be used *)
+   | Some true -> (Lazy.force coq_Covariant)
+   | Some false -> (Lazy.force coq_Contravariant)
+ in
+  cic_relation_class_of_X_relation_class (Lazy.force coq_variance)
+   coq_variant_value arg
+
+let cic_arguments_of_argument_class_list args =
+ let rec aux =
+  function
+     [] -> assert false
+   | [last] ->
+      mkApp ((Lazy.force coq_singl), [| Lazy.force coq_Argument_Class; last |])
+   | he::tl ->
+      mkApp ((Lazy.force coq_cons),
+       [| Lazy.force coq_Argument_Class; he ; aux tl |])
+ in
+  aux (List.map cic_argument_class_of_argument_class args)
+
+let gen_compat_lemma_statement quantifiers_rev output args m =
+ let output = cic_relation_class_of_relation_class output in
+ let args = cic_arguments_of_argument_class_list args in
+  args, output,
+   compose_prod quantifiers_rev
+    (mkApp ((Lazy.force coq_make_compatibility_goal), [| args ; output ; m |]))
+
+let morphism_theory_id_of_morphism_proof_id id =
+ id_of_string (string_of_id id ^ "_morphism_theory")
+
+(* apply_to_rels c [l1 ; ... ; ln] returns (c Rel1 ... reln) *)
+let apply_to_rels c l =
+ if l = [] then c
+ else
+  let len = List.length l in
+   applistc c (Util.list_map_i (fun i _ -> mkRel (len - i)) 0 l)
+
+let apply_to_relation subst rel =
+ if Array.length subst = 0 then rel
+ else
+  let new_quantifiers_no = rel.rel_quantifiers_no - Array.length subst in
+   assert (new_quantifiers_no >= 0) ;
+   { rel_a = mkApp (rel.rel_a, subst) ;
+     rel_aeq = mkApp (rel.rel_aeq, subst) ;
+     rel_refl = option_app (fun c -> mkApp (c,subst)) rel.rel_refl ; 
+     rel_sym = option_app (fun c -> mkApp (c,subst)) rel.rel_sym;
+     rel_trans = option_app (fun c -> mkApp (c,subst)) rel.rel_trans;
+     rel_quantifiers_no = new_quantifiers_no;
+     rel_X_relation_class = mkApp (rel.rel_X_relation_class, subst);
+     rel_Xreflexive_relation_class =
+      mkApp (rel.rel_Xreflexive_relation_class, subst) }
+
+let add_morphism lemma_infos mor_name (m,quantifiers_rev,args,output) =
+ let lem =
+  match lemma_infos with
+     None ->
+      (* the Morphism_Theory object has already been created *)
+      let applied_args =
+       let len = List.length quantifiers_rev in
+       let subst =
+        Array.of_list
+         (Util.list_map_i (fun i _ -> mkRel (len - i)) 0 quantifiers_rev)
+       in
+        List.map
+         (fun (v,rel) ->
+           match rel with
+              Leibniz (Some t) ->
+               assert (subst=[||]);
+               v, Leibniz (Some t)
+            | Leibniz None ->
+               assert (Array.length subst = 1);
+               v, Leibniz (Some (subst.(0)))
+            | Relation rel -> v, Relation (apply_to_relation subst rel)) args
+      in
+       compose_lam quantifiers_rev
+        (mkApp (Lazy.force coq_Compat,
+          [| cic_arguments_of_argument_class_list applied_args;
+             cic_relation_class_of_relation_class output;
+             apply_to_rels (current_constant mor_name) quantifiers_rev |]))
+   | Some (lem_name,argsconstr,outputconstr) ->
+      (* only the compatibility has been proved; we need to declare the
+         Morphism_Theory object *)
+     let mext = current_constant lem_name in
+     ignore (
+      Declare.declare_internal_constant mor_name
+       (DefinitionEntry
+         {const_entry_body =
+           compose_lam quantifiers_rev
+            (mkApp ((Lazy.force coq_Build_Morphism_Theory),
+              [| argsconstr; outputconstr; apply_to_rels m quantifiers_rev ;
+                  apply_to_rels mext quantifiers_rev |]));
+          const_entry_type = None;
+          const_entry_opaque = false;
+          const_entry_boxed = Options.boxed_definitions()},
+	IsDefinition Definition)) ;
+     mext 
+ in
+  let mmor = current_constant mor_name in
+  let args_constr =
+   List.map
+    (fun (variance,arg) ->
+      variance, constr_relation_class_of_relation_relation_class arg) args in
+  let output_constr = constr_relation_class_of_relation_relation_class output in
+   Lib.add_anonymous_leaf
+    (morphism_to_obj (m, 
+      { args = args_constr;
+        output = output_constr;
+        lem = lem;
+        morphism_theory = mmor }));
+   Options.if_verbose ppnl (pr_lconstr m ++ str " is registered as a morphism")   
+
+(* first order matching with a bit of conversion *)
+let unify_relation_carrier_with_type env rel t =
+ let raise_error quantifiers_no =
+  errorlabstrm "New Morphism"
+   (str "One morphism argument or its output has type " ++ pr_lconstr t ++
+    str " but the signature requires an argument of type \"" ++
+    pr_lconstr rel.rel_a ++ str " " ++ prvect_with_sep pr_spc (fun _ -> str  "?")
+     (Array.make quantifiers_no 0) ++ str "\"") in
+ let args =
+  match kind_of_term t with
+     App (he',args') ->
+      let argsno = Array.length args' - rel.rel_quantifiers_no in
+      let args1 = Array.sub args' 0 argsno in
+      let args2 = Array.sub args' argsno rel.rel_quantifiers_no in
+       if is_conv env Evd.empty rel.rel_a (mkApp (he',args1)) then
+        args2
        else
-	 (Lib.add_anonymous_leaf
-	    (morphism_to_obj (m, 
-			      { lem = mext;
-				profil = poss;
-				arg_types = args_t;
-				lem2 = None}))));
-      Options.if_verbose ppnl (prterm m ++str " is registered as a morphism")   
-let morphism_hook stre ref =
+        raise_error rel.rel_quantifiers_no
+   | _  ->
+     if rel.rel_quantifiers_no = 0 && is_conv env Evd.empty rel.rel_a t then
+      [||] 
+     else
+      begin
+        let evars,args,instantiated_rel_a =
+         let ty = Typing.type_of env Evd.empty rel.rel_a in
+         let evd = Evd.create_evar_defs Evd.empty in
+         let evars,args,concl =
+          Clenv.clenv_environments_evars env evd
+           (Some rel.rel_quantifiers_no) ty
+         in
+          evars, args,
+          nf_betaiota
+           (match args with [] -> rel.rel_a | _ -> applist (rel.rel_a,args))
+        in
+         let evars' =
+          w_unify true (*??? or false? *) env Reduction.CONV (*??? or cumul? *)
+           ~mod_delta:true (*??? or true? *) t instantiated_rel_a evars in
+         let args' =
+          List.map (Reductionops.nf_evar (Evd.evars_of evars')) args
+         in
+          Array.of_list args'
+      end
+ in
+  apply_to_relation args rel
+
+let unify_relation_class_carrier_with_type env rel t =
+ match rel with
+    Leibniz (Some t') ->
+     if is_conv env Evd.empty t t' then
+      rel
+     else
+      errorlabstrm "New Morphism"
+       (str "One morphism argument or its output has type " ++ pr_lconstr t ++
+        str " but the signature requires an argument of type " ++
+        pr_lconstr t')
+  | Leibniz None -> Leibniz (Some t)
+  | Relation rel -> Relation (unify_relation_carrier_with_type env rel t)
+
+(* first order matching with a bit of conversion *)
+(* Note: the type checking operations performed by the function could  *)
+(* be done once and for all abstracting the morphism structure using   *)
+(* the quantifiers. Would the new structure be more suited than the    *)
+(* existent one for other tasks to? (e.g. pretty printing would expose *)
+(* much more information: is it ok or is it too much information?)     *)
+let unify_morphism_with_arguments gl (c,av)
+     {args=args; output=output; lem=lem; morphism_theory=morphism_theory} t
+=
+ let al = Array.to_list av in
+ let argsno = List.length args in
+ let quantifiers,al' = Util.list_chop (List.length al - argsno) al in
+ let quantifiersv = Array.of_list quantifiers in
+ let c' = mkApp (c,quantifiersv) in
+ if dependent t c' then None else (
+  (* these are pf_type_of we could avoid *)
+  let al'_type = List.map (Tacmach.pf_type_of gl) al' in
+  let args' =
+   List.map2
+    (fun (var,rel) ty ->
+      var,unify_relation_class_carrier_with_type (pf_env gl) rel ty)
+    args al'_type in
+  (* this is another pf_type_of we could avoid *)
+  let ty = Tacmach.pf_type_of gl (mkApp (c,av)) in
+  let output' = unify_relation_class_carrier_with_type (pf_env gl) output ty in
+  let lem' = mkApp (lem,quantifiersv) in
+  let morphism_theory' = mkApp (morphism_theory,quantifiersv) in
+   Some
+    ({args=args'; output=output'; lem=lem'; morphism_theory=morphism_theory'},
+     c',Array.of_list al'))
+
+let new_morphism m signature id hook =
+ if Nametab.exists_cci (Lib.make_path id) or is_section_variable id then
+  errorlabstrm "New Morphism" (pr_id id ++ str " already exists")
+ else
+  let env = Global.env() in
+  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
+  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
+  in
+   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 =
+    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 =
+    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
+    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
+    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
+
+let morphism_hook _ ref =
   let pf_id = id_of_global ref in
+  let mor_id = morphism_theory_id_of_morphism_proof_id pf_id in
+  let (m,quantifiers_rev,args,argsconstr,output,outputconstr) =
+   what_edited pf_id in
   if (is_edited pf_id)
   then 
-    (add_morphism pf_id (what_edited pf_id); no_more_edited pf_id)
+   begin
+    add_morphism (Some (pf_id,argsconstr,outputconstr)) mor_id
+     (m,quantifiers_rev,args,output) ;
+    no_more_edited pf_id
+   end
+
+type morphism_signature =
+ (bool option * Topconstr.constr_expr) list * Topconstr.constr_expr
+
+let new_named_morphism id m sign =
+ let sign =
+  match sign with
+     None -> None
+   | Some (args,out) ->
+      Some
+       (List.map (fun (variance,ty) -> variance, constr_of ty) args,
+        constr_of out)
+ in
+  new_morphism (constr_of m) sign id morphism_hook
+
+(************************** Adding a relation to the database *********************)
+
+let check_a env a =
+ let typ = Typing.type_of env Evd.empty a in
+ let a_quantifiers_rev,_ = Reduction.dest_arity env typ in
+  a_quantifiers_rev
+
+let check_eq env a_quantifiers_rev a aeq =
+ let typ =
+  Sign.it_mkProd_or_LetIn
+   (mkApp ((Lazy.force coq_relation),[| apply_to_rels a a_quantifiers_rev |]))
+   a_quantifiers_rev in
+ if
+  not
+   (is_conv env Evd.empty (Typing.type_of env Evd.empty aeq) typ)
+ then
+  errorlabstrm "Add Relation Class"
+   (pr_lconstr aeq ++ str " should have type (" ++ pr_lconstr typ ++ str ")")
+
+let check_property env a_quantifiers_rev a aeq strprop coq_prop t =
+ if
+  not
+   (is_conv env Evd.empty (Typing.type_of env Evd.empty t)
+    (Sign.it_mkProd_or_LetIn
+     (mkApp ((Lazy.force coq_prop),
+       [| apply_to_rels a   a_quantifiers_rev ;
+          apply_to_rels aeq a_quantifiers_rev |])) a_quantifiers_rev))
+ then
+  errorlabstrm "Add Relation Class"
+   (str "Not a valid proof of " ++ str strprop ++ str ".")
+
+let check_refl env a_quantifiers_rev a aeq refl =
+ check_property env a_quantifiers_rev a aeq "reflexivity" coq_reflexive refl
+
+let check_sym env a_quantifiers_rev a aeq sym =
+ check_property env a_quantifiers_rev a aeq "symmetry" coq_symmetric sym
+
+let check_trans env a_quantifiers_rev a aeq trans =
+ check_property env a_quantifiers_rev a aeq "transitivity" coq_transitive trans
+
+let check_setoid_theory env a_quantifiers_rev a aeq th =
+ if
+  not
+   (is_conv env Evd.empty (Typing.type_of env Evd.empty th)
+    (Sign.it_mkProd_or_LetIn
+     (mkApp ((Lazy.force coq_Setoid_Theory),
+       [| apply_to_rels a   a_quantifiers_rev ;
+          apply_to_rels aeq a_quantifiers_rev |])) a_quantifiers_rev))
+ then
+  errorlabstrm "Add Relation Class"
+   (str "Not a valid proof of symmetry")
+
+let int_add_relation id a aeq refl sym trans =
+ let env = Global.env () in
+ let a_quantifiers_rev = check_a env a in
+  check_eq env a_quantifiers_rev a aeq  ;
+  option_iter (check_refl env a_quantifiers_rev a aeq) refl ;
+  option_iter (check_sym env a_quantifiers_rev a aeq) sym ;
+  option_iter (check_trans env a_quantifiers_rev a aeq) trans ;
+  let quantifiers_no = List.length a_quantifiers_rev in
+  let aeq_rel =
+   { rel_a = a;
+     rel_aeq = aeq;
+     rel_refl = refl;
+     rel_sym = sym;
+     rel_trans = trans;
+     rel_quantifiers_no = quantifiers_no;
+     rel_X_relation_class = mkProp; (* dummy value, overwritten below *)
+     rel_Xreflexive_relation_class = mkProp (* dummy value, overwritten below *)
+   } in
+  let x_relation_class =
+   let subst =
+    let len = List.length a_quantifiers_rev in
+    Array.of_list
+     (Util.list_map_i (fun i _ -> mkRel (len - i + 2)) 0 a_quantifiers_rev) in
+   cic_relation_class_of_X_relation
+    (mkRel 2) (mkRel 1) (apply_to_relation subst aeq_rel) in
+  let _ =
+   Declare.declare_internal_constant id
+    (DefinitionEntry
+      {const_entry_body =
+        Sign.it_mkLambda_or_LetIn x_relation_class
+         ([ Name (id_of_string "v"),None,mkRel 1;
+            Name (id_of_string "X"),None,mkType (Termops.new_univ ())] @
+            a_quantifiers_rev);
+       const_entry_type = None;
+       const_entry_opaque = false;
+       const_entry_boxed = Options.boxed_definitions()},
+      IsDefinition Definition) in
+  let id_precise = id_of_string (string_of_id id ^ "_precise_relation_class") in
+  let xreflexive_relation_class =
+   let subst =
+    let len = List.length a_quantifiers_rev in
+    Array.of_list
+     (Util.list_map_i (fun i _ -> mkRel (len - i)) 0 a_quantifiers_rev)
+   in
+    cic_precise_relation_class_of_relation (apply_to_relation subst aeq_rel) in
+  let _ =
+   Declare.declare_internal_constant id_precise
+    (DefinitionEntry
+      {const_entry_body =
+        Sign.it_mkLambda_or_LetIn xreflexive_relation_class a_quantifiers_rev;
+       const_entry_type = None;
+       const_entry_opaque = false;
+       const_entry_boxed = Options.boxed_definitions() },
+      IsDefinition Definition) in
+  let aeq_rel =
+   { aeq_rel with
+      rel_X_relation_class = current_constant id;
+      rel_Xreflexive_relation_class = current_constant id_precise } in
+  Lib.add_anonymous_leaf (relation_to_obj (aeq, aeq_rel)) ;
+  Options.if_verbose ppnl (pr_lconstr aeq ++ str " is registered as a relation");
+  match trans with
+     None -> ()
+   | Some trans ->
+      let mor_name = id_of_string (string_of_id id ^ "_morphism") in
+      let a_instance = apply_to_rels a a_quantifiers_rev in
+      let aeq_instance = apply_to_rels aeq a_quantifiers_rev in
+      let sym_instance =
+       option_app (fun x -> apply_to_rels x a_quantifiers_rev) sym in
+      let refl_instance =
+       option_app (fun x -> apply_to_rels x a_quantifiers_rev) refl in
+      let trans_instance = apply_to_rels trans a_quantifiers_rev in
+      let aeq_rel_class_and_var1, aeq_rel_class_and_var2, lemma, output =
+       match sym_instance, refl_instance with
+          None, None ->
+           (Some false, Relation aeq_rel),
+           (Some true, Relation aeq_rel),
+            mkApp
+             ((Lazy.force
+                coq_equality_morphism_of_asymmetric_areflexive_transitive_relation),
+              [| a_instance ; aeq_instance ; trans_instance |]),
+            Lazy.force coq_impl_relation
+        | None, Some refl_instance ->
+           (Some false, Relation aeq_rel),
+           (Some true, Relation aeq_rel),
+            mkApp
+             ((Lazy.force
+                coq_equality_morphism_of_asymmetric_reflexive_transitive_relation),
+              [| a_instance ; aeq_instance ; refl_instance ; trans_instance |]),
+            Lazy.force coq_impl_relation
+        | Some sym_instance, None ->
+           (None, Relation aeq_rel),
+           (None, Relation aeq_rel),
+            mkApp
+             ((Lazy.force
+                coq_equality_morphism_of_symmetric_areflexive_transitive_relation),
+              [| a_instance ; aeq_instance ; sym_instance ; trans_instance |]),
+            Lazy.force coq_iff_relation
+        | Some sym_instance, Some refl_instance ->
+           (None, Relation aeq_rel),
+           (None, Relation aeq_rel),
+            mkApp
+             ((Lazy.force
+                coq_equality_morphism_of_symmetric_reflexive_transitive_relation),
+              [| a_instance ; aeq_instance ; refl_instance ; sym_instance ;
+                 trans_instance |]),
+            Lazy.force coq_iff_relation in
+      let _ =
+       Declare.declare_internal_constant mor_name
+        (DefinitionEntry
+          {const_entry_body = Sign.it_mkLambda_or_LetIn lemma a_quantifiers_rev;
+           const_entry_type = None;
+           const_entry_opaque = false;
+          const_entry_boxed = Options.boxed_definitions()},
+          IsDefinition Definition)
+      in
+       let a_quantifiers_rev =
+        List.map (fun (n,b,t) -> assert (b = None); n,t) a_quantifiers_rev in
+       add_morphism None mor_name
+        (aeq,a_quantifiers_rev,[aeq_rel_class_and_var1; aeq_rel_class_and_var2],
+          output)
+
+(* The vernac command "Add Relation ..." *)
+let add_relation id a aeq refl sym trans =
+ int_add_relation id (constr_of a) (constr_of aeq) (option_app constr_of refl)
+  (option_app constr_of sym) (option_app constr_of trans)
+
+(************************ Add Setoid ******************************************)
+
+(* The vernac command "Add Setoid" *)
+let add_setoid id a aeq th =
+ let a = constr_of a in
+ let aeq = constr_of aeq in
+ let th = constr_of th in
+ let env = Global.env () in
+ let a_quantifiers_rev = check_a env a in
+  check_eq env a_quantifiers_rev a aeq  ;
+  check_setoid_theory env a_quantifiers_rev a aeq  th ;
+   let a_instance = apply_to_rels a a_quantifiers_rev in
+   let aeq_instance = apply_to_rels aeq a_quantifiers_rev in
+   let th_instance = apply_to_rels th a_quantifiers_rev in
+   let refl =
+    Sign.it_mkLambda_or_LetIn
+     (mkApp ((Lazy.force coq_seq_refl),
+       [| a_instance; aeq_instance; th_instance |])) a_quantifiers_rev in
+   let sym =
+    Sign.it_mkLambda_or_LetIn
+     (mkApp ((Lazy.force coq_seq_sym),
+       [| a_instance; aeq_instance; th_instance |])) a_quantifiers_rev in
+   let trans =
+    Sign.it_mkLambda_or_LetIn
+     (mkApp ((Lazy.force coq_seq_trans),
+       [| a_instance; aeq_instance; th_instance |])) a_quantifiers_rev in
+   int_add_relation id a aeq (Some refl) (Some sym) (Some trans)
 
-let new_named_morphism id m = new_morphism (constr_of m) id morphism_hook
 
 (****************************** The tactic itself *******************************)
 
+type direction =
+   Left2Right
+ | Right2Left
+
+let prdirection =
+ function
+    Left2Right -> str "->"
+  | Right2Left -> str "<-"
+
 type constr_with_marks =
-  | MApp of constr_with_marks array 
-  | Toreplace
-  | Tokeep
-  | Mimp of constr_with_marks * constr_with_marks
+  | MApp of constr * morphism_class * constr_with_marks array * direction
+  | ToReplace
+  | ToKeep of constr * relation relation_class * direction
 
 let is_to_replace = function
-  | Tokeep -> false
-  | Toreplace -> true
-  | MApp _ -> true
-  | Mimp _ -> true
+ | ToKeep _ -> false
+ | ToReplace -> true
+ | MApp _ -> true
 
 let get_mark a = 
   Array.fold_left (||) false (Array.map is_to_replace a)
 
-let rec mark_occur t in_c =
-  if (eq_constr t in_c) then Toreplace else
+let cic_direction_of_direction =
+ function
+    Left2Right -> Lazy.force coq_Left2Right
+  | Right2Left -> Lazy.force coq_Right2Left
+
+let opposite_direction =
+ function
+    Left2Right -> Right2Left
+  | Right2Left -> Left2Right
+
+let direction_of_constr_with_marks hole_direction =
+ function
+    MApp (_,_,_,dir) -> cic_direction_of_direction dir
+  | ToReplace -> hole_direction
+  | ToKeep (_,_,dir) -> cic_direction_of_direction dir
+
+type argument =
+   Toapply of constr         (* apply the function to the argument *)
+ | Toexpand of name * types  (* beta-expand the function w.r.t. an argument
+                                of this type *)
+let beta_expand c args_rev =
+ let rec to_expand =
+  function
+     [] -> []
+   | (Toapply _)::tl -> to_expand tl
+   | (Toexpand (name,s))::tl -> (name,s)::(to_expand tl) in
+ let rec aux n =
+  function
+     [] -> []
+   | (Toapply arg)::tl -> arg::(aux n tl)
+   | (Toexpand _)::tl -> (mkRel n)::(aux (n + 1) tl)
+ in
+  compose_lam (to_expand args_rev)
+   (mkApp (c, Array.of_list (List.rev (aux 1 args_rev))))
+
+exception Optimize (* used to fall-back on the tactic for Leibniz equality *)
+
+let relation_class_that_matches_a_constr caller_name new_goals hypt =
+ let (heq, hargs) = decompose_app hypt in
+ let rec get_all_but_last_two =
+  function
+     []
+   | [_] ->
+      errorlabstrm caller_name (pr_lconstr hypt ++
+       str " is not a registered relation.")
+   | [_;_] -> []
+   | he::tl -> he::(get_all_but_last_two tl) in
+ let all_aeq_args = get_all_but_last_two hargs in
+ let rec find_relation l subst =
+  let aeq = mkApp (heq,(Array.of_list l)) in
+  try
+   let rel = find_relation_class aeq in
+   match rel,new_goals with
+      Leibniz _,[] ->
+       assert (subst = []);
+       raise Optimize (* let's optimize the proof term size *)
+    | Leibniz (Some _), _ ->
+       assert (subst = []);
+       rel
+    | Leibniz None, _ ->
+       (* for well-typedness reasons it should have been catched by the
+          previous guard in the previous iteration. *)
+       assert false
+    | Relation rel,_ -> Relation (apply_to_relation (Array.of_list subst) rel)
+  with Not_found ->
+   if l = [] then
+    errorlabstrm caller_name
+     (pr_lconstr (mkApp (aeq, Array.of_list all_aeq_args)) ++
+      str " is not a registered relation.")
+   else
+    let last,others = Util.list_sep_last l in
+    find_relation others (last::subst)
+ in
+  find_relation all_aeq_args []
+
+(* rel1 is a subrelation of rel2 whenever 
+    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
+   useful generalization that does not go against the original spirit of
+   the tactic.
+*)
+let subrelation gl rel1 rel2 =
+ match rel1,rel2 with
+    Relation {rel_aeq=rel_aeq1}, Relation {rel_aeq=rel_aeq2} ->
+     Tacmach.pf_conv_x gl rel_aeq1 rel_aeq2
+  | Leibniz (Some t1), Leibniz (Some t2) ->
+     Tacmach.pf_conv_x gl t1 t2
+  | Leibniz None, _
+  | _, Leibniz None -> assert false
+(* This is the commented out case (see comment above)
+  | Leibniz (Some t1), Relation {rel_a=t2; rel_refl = Some _} ->
+     Tacmach.pf_conv_x gl t1 t2
+*)
+  | _,_ -> false
+
+(* this function returns the list of new goals opened by a constr_with_marks *)
+let rec collect_new_goals =
+ function
+   MApp (_,_,a,_) -> List.concat (List.map collect_new_goals (Array.to_list a))
+ | ToReplace
+ | ToKeep (_,Leibniz _,_)
+ | ToKeep (_,Relation {rel_refl=Some _},_) -> []
+ | ToKeep (c,Relation {rel_aeq=aeq; rel_refl=None},_) -> [mkApp(aeq,[|c ; c|])]
+
+(* two marked_constr are equivalent if they produce the same set of new goals *)
+let marked_constr_equiv_or_more_complex to_marked_constr gl c1 c2 =
+  let glc1 = collect_new_goals (to_marked_constr c1) in
+  let glc2 = collect_new_goals (to_marked_constr c2) in
+   List.for_all (fun c -> List.exists (fun c' -> pf_conv_x gl c c') glc1) glc2
+
+let pr_new_goals i c =
+ let glc = collect_new_goals c in
+  str " " ++ int i ++ str ") side conditions:" ++
+   (if glc = [] then str " no side conditions"
+    else
+     (pr_fnl () ++ str "   " ++
+       prlist_with_sep (fun () -> str "\n   ")
+        (fun c -> str " ... |- " ++ pr_lconstr c) glc))
+
+(* given a list of constr_with_marks, it returns the list where
+   constr_with_marks than open more goals than simpler ones in the list
+   are got rid of *)
+let elim_duplicates gl to_marked_constr =
+ let rec aux =
+  function
+     [] -> []
+   | he:: tl ->
+      if List.exists
+          (marked_constr_equiv_or_more_complex to_marked_constr gl he) tl
+      then aux tl
+      else he::aux tl
+ in
+  aux
+
+let filter_superset_of_new_goals gl new_goals l =
+ List.filter
+  (fun (_,_,c) ->
+    List.for_all
+     (fun g -> List.exists (pf_conv_x gl g) (collect_new_goals c)) new_goals) l
+
+(* given the array of lists [| l1 ; ... ; ln |] it returns the list of arrays
+   [ c1 ; ... ; cn ] that is the cartesian product of the sets l1, ..., ln *)
+let cartesian_product gl a =
+ let rec aux =
+  function
+     [] -> assert false
+   | [he] -> List.map (fun e -> [e]) he
+   | he::tl ->
+      let tl' = aux tl in
+       List.flatten
+        (List.map (function e -> List.map (function l -> e :: l) tl') he)
+ in
+  List.map Array.of_list
+   (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 =
+  if eq_constr t in_c then
+   if input_direction = output_direction
+   && subrelation gl input_relation output_relation then
+    [ToReplace]
+   else []
+  else
     match kind_of_term in_c with
       | App (c,al) -> 
-	  let a = Array.map (mark_occur t) al
-	  in if (get_mark a) then (MApp a) else Tokeep
+         let mors_and_cs_and_als =
+          let mors_and_cs_and_als =
+           let morphism_table_find c =
+            try morphism_table_find c with Not_found -> [] in
+           let rec aux acc =
+            function
+               [] ->
+                let c' = mkApp (c, Array.of_list acc) in
+                let al' = [||] in
+                List.map (fun m -> m,c',al') (morphism_table_find c')
+             | (he::tl) as l ->
+                let c' = mkApp (c, Array.of_list acc) in
+                let al' = Array.of_list l in
+                let acc' = acc @ [he] in
+                 (List.map (fun m -> m,c',al') (morphism_table_find c')) @
+                  (aux acc' tl)
+           in
+            aux [] (Array.to_list al) in
+          let mors_and_cs_and_als =
+           List.map
+            (function (m,c,al) ->
+              relation_morphism_of_constr_morphism m, c, al)
+             mors_and_cs_and_als in
+          let mors_and_cs_and_als =
+           List.fold_left
+            (fun l (m,c,al) ->
+              match unify_morphism_with_arguments gl (c,al) m t with
+                 Some res -> res::l
+               | None -> l
+            ) [] mors_and_cs_and_als
+          in
+           List.filter
+            (fun (mor,_,_) -> subrelation gl mor.output output_relation)
+            mors_and_cs_and_als
+         in
+          (* First we look for well typed morphisms *)
+          let res_mors =
+           List.fold_left
+            (fun res (mor,c,al) ->
+              let a =
+               let arguments = Array.of_list mor.args in
+               let apply_variance_to_direction default_dir =
+                function
+                   None -> default_dir
+                 | Some true -> output_direction
+                 | Some false -> opposite_direction output_direction
+               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)
+                 ) al arguments
+              in
+               let a' = cartesian_product gl a in
+                (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
+            ) [] 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
+               the requirement when the arguments to be replaced are
+               bound by non-dependent products only. *)
+            let typeofc = Tacmach.pf_type_of gl c in
+            let typ = nf_betaiota typeofc in
+            let rec find_non_dependent_function env c c_args_rev typ f_args_rev
+                     a_rev
+            =
+             function
+                [] ->
+                 if a_rev = [] then
+                  [ToKeep (in_c,output_relation,output_direction)]
+                 else
+                  let a' =
+                   cartesian_product gl (Array.of_list (List.rev a_rev))
+                  in
+                   List.fold_left
+                    (fun res a ->
+                      if not (get_mark a) then
+                       (ToKeep (in_c,output_relation,output_direction))::res
+                      else
+                       let err =
+                        match output_relation with
+                           Leibniz (Some typ') when pf_conv_x gl typ typ' ->
+                            false
+                         | Leibniz None -> assert false
+                         | _ when output_relation = Lazy.force coq_iff_relation
+                             -> false
+                         | _ -> true
+                       in
+                        if err then res
+                        else
+                         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
+                    ) [] a'
+              | (he::tl) as a->
+                 let typnf = Reduction.whd_betadeltaiota env typ in
+                  match kind_of_term typnf with
+                    Cast (typ,_,_) ->
+                     find_non_dependent_function env c c_args_rev typ
+                      f_args_rev a_rev a
+                  | 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
+                     if he = [] then []
+                     else
+                      let he0 = List.hd he in
+                      begin
+                       match noccurn 1 t, he0 with
+                          _, ToKeep (arg,_,_) ->
+                           (* invariant: if he0 = ToKeep (t,_,_) then every
+                              element in he is = ToKeep (t,_,_) *)
+                           assert
+                            (List.for_all
+                              (function
+                                  ToKeep(arg',_,_) when pf_conv_x gl arg arg' ->
+                                    true
+                                | _ -> false) he) ;
+                           (* generic product, to keep *)
+                           find_non_dependent_function
+                            env' c ((Toapply arg)::c_args_rev)
+                            (subst1 arg t) f_args_rev a_rev tl
+                        | true, _ ->
+                           (* non-dependent product, to replace *)
+                           find_non_dependent_function
+                            env' c ((Toexpand (name,s))::c_args_rev)
+                             (lift 1 t) (s::f_args_rev) (he::a_rev) tl
+                        | false, _ ->
+                           (* dependent product, to replace *)
+                           (* This limitation is due to the reflexive
+                             implementation and it is hard to lift *)
+                           errorlabstrm "Setoid_replace"
+                            (str "Cannot rewrite in the argument of a " ++
+                             str "dependent product. If you need this " ++
+                             str "feature, please report to the author.")
+                      end
+                  | _ -> assert false
+            in
+             find_non_dependent_function (Tacmach.pf_env gl) c [] typ [] []
+              (Array.to_list al)
+          in
+           elim_duplicates gl identity (res_functions @ res_mors)
       | Prod (_, c1, c2) -> 
-	  if (dependent (mkRel 1) c2)
-	  then Tokeep
-	  else 
-	    let c1m = mark_occur t c1 in
-	    let c2m = mark_occur t c2 in
-	      if ((is_to_replace c1m)||(is_to_replace c2m))
-	      then (Mimp (c1m, c2m))
-	      else Tokeep
-      | _ -> Tokeep
-
-let create_args ca ma bl c1 c2 = 
-  let rec aux i = function
-    | [] -> []
-    | true::q -> 
-	if (is_to_replace ma.(i)) 
-	then (replace_term c1 c2 ca.(i))::ca.(i)::(aux (i+1) q)
-	else ca.(i)::ca.(i)::(aux (i+1) q)
-    | false::q -> ca.(i)::(aux (i+1) q)
+          if (dependent (mkRel 1) c2)
+          then
+           errorlabstrm "Setoid_replace"
+            (str "Cannot rewrite in the type of a variable bound " ++
+             str "in a dependent product.")
+          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 |]))
+      | _ ->
+        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)]
+ in
+  let aux2 output_relation output_direction =
+   List.map
+    (fun res -> output_relation,output_direction,res)
+     (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 *)
+   (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
+  let res' = filter_superset_of_new_goals gl new_goals res in
+  match res' with
+     [] when res = [] ->
+      errorlabstrm "Setoid_rewrite"
+       (str "Either the term " ++ pr_lconstr t ++ str " that must be " ++
+        str "rewritten occurs in a covariant position or the goal is not " ++
+        str "made of morphism applications only. You can replace only " ++
+        str "occurrences that are in a contravariant position and such that " ++
+        str "the context obtained by abstracting them is made of morphism " ++
+        str "applications only.")
+   | [] ->
+      errorlabstrm "Setoid_rewrite"
+       (str "No generated set of side conditions is a superset of those " ++
+        str "requested by the user. The generated sets of side conditions " ++
+        str "are: " ++
+         pr_fnl () ++
+         prlist_with_sepi pr_fnl
+          (fun i (_,_,mc) -> pr_new_goals i mc) res)
+   | [he] -> he
+   | he::_ ->
+      ppnl
+       (str "Warning: The application of the tactic is subject to one of " ++
+        str "the \nfollowing set of side conditions that the user needs " ++
+        str "to prove:" ++
+         pr_fnl () ++
+         prlist_with_sepi pr_fnl
+          (fun i (_,_,mc) -> pr_new_goals i mc) res' ++ pr_fnl () ++
+         str "The first set is randomly chosen. Use the syntax " ++
+         str "\"setoid_rewrite ... generate side conditions ...\" to choose " ++
+         str "a different set.") ;
+      he
+
+let cic_morphism_context_list_of_list hole_relation hole_direction out_direction
+=
+ let check =
+  function
+     (None,dir,dir') -> 
+      mkApp ((Lazy.force coq_MSNone), [| dir ; dir' |])
+   | (Some true,dir,dir') ->
+      assert (dir = dir');
+      mkApp ((Lazy.force coq_MSCovariant), [| dir |])
+   | (Some false,dir,dir') ->
+      assert (dir <> dir');
+      mkApp ((Lazy.force coq_MSContravariant), [| dir |]) in
+ let rec aux =
+  function
+     [] -> assert false
+   | [(variance,out),(value,direction)] ->
+      mkApp ((Lazy.force coq_singl), [| Lazy.force coq_Argument_Class ; out |]),
+      mkApp ((Lazy.force coq_fcl_singl),
+       [| hole_relation; hole_direction ; out ;
+          direction ; out_direction ;
+          check (variance,direction,out_direction) ; value |])
+   | ((variance,out),(value,direction))::tl ->
+      let outtl, valuetl = aux tl in
+       mkApp ((Lazy.force coq_cons),
+        [| Lazy.force coq_Argument_Class ; out ; outtl |]),
+       mkApp ((Lazy.force coq_fcl_cons),
+        [| hole_relation ; hole_direction ; out ; outtl ;
+           direction ; out_direction ;
+           check (variance,direction,out_direction) ;
+           value ; valuetl |])
+ in aux
+
+let rec cic_type_nelist_of_list =
+ function
+    [] -> assert false
+  | [value] ->
+      mkApp ((Lazy.force coq_singl), [| mkType (Termops.new_univ ()) ; value |])
+  | value::tl ->
+     mkApp ((Lazy.force coq_cons),
+      [| mkType (Termops.new_univ ()); value; cic_type_nelist_of_list tl |])
+
+let syntactic_but_representation_of_marked_but hole_relation hole_direction =
+ let rec aux out (rel_out,precise_out,is_reflexive) =
+  function
+     MApp (f, m, args, direction) ->
+      let direction = cic_direction_of_direction direction in
+      let morphism_theory, relations =
+       match m with
+          ACMorphism { args = args ; morphism_theory = morphism_theory } ->
+           morphism_theory,args
+        | ACFunction { f_args = f_args ; f_output = f_output } ->
+           let mt =
+            if eq_constr out (cic_relation_class_of_relation_class
+              (Lazy.force coq_iff_relation))
+            then
+              mkApp ((Lazy.force coq_morphism_theory_of_predicate),
+               [| cic_type_nelist_of_list f_args; f|])
+            else
+              mkApp ((Lazy.force coq_morphism_theory_of_function),
+               [| cic_type_nelist_of_list f_args; f_output; f|])
+           in
+            mt,List.map (fun x -> None,Leibniz (Some x)) f_args in
+      let cic_relations =
+       List.map
+        (fun (variance,r) ->
+          variance,
+          r,
+          cic_relation_class_of_relation_class r,
+          cic_precise_relation_class_of_relation_class r
+        ) relations in
+      let cic_args_relations,argst =
+       cic_morphism_context_list_of_list hole_relation hole_direction direction
+        (List.map2
+         (fun (variance,trel,t,precise_t) v ->
+           (variance,cic_argument_class_of_argument_class (variance,trel)),
+             (aux t precise_t v,
+               direction_of_constr_with_marks hole_direction v)
+         ) cic_relations (Array.to_list args))
+      in
+       mkApp ((Lazy.force coq_App),
+        [|hole_relation ; hole_direction ;
+          cic_args_relations ; out ; direction ;
+          morphism_theory ; argst|])
+   | ToReplace ->
+      mkApp ((Lazy.force coq_ToReplace), [| hole_relation ; hole_direction |])
+   | ToKeep (c,_,direction) ->
+      let direction = cic_direction_of_direction direction in
+       if is_reflexive then
+        mkApp ((Lazy.force coq_ToKeep),
+         [| hole_relation ; hole_direction ; precise_out ; direction ; c |])
+       else
+        let c_is_proper =
+         let typ = mkApp (rel_out, [| c ; c |]) in
+          mkCast (Evarutil.mk_new_meta (),DEFAULTcast, typ)
+        in
+         mkApp ((Lazy.force coq_ProperElementToKeep),
+          [| hole_relation ; hole_direction; precise_out ;
+             direction; c ; c_is_proper |])
+ in aux
+
+let apply_coq_setoid_rewrite hole_relation prop_relation c1 c2 (direction,h)
+ prop_direction m
+=
+ let hole_relation = cic_relation_class_of_relation_class hole_relation in
+ let hyp,hole_direction = h,cic_direction_of_direction direction in
+ let cic_prop_relation = cic_relation_class_of_relation_class prop_relation in
+ let precise_prop_relation =
+  cic_precise_relation_class_of_relation_class prop_relation
+ in
+  mkApp ((Lazy.force coq_setoid_rewrite),
+   [| hole_relation ; hole_direction ; cic_prop_relation ;
+      prop_direction ; c1 ; c2 ;
+      syntactic_but_representation_of_marked_but hole_relation hole_direction
+       cic_prop_relation precise_prop_relation m ; hyp |])
+
+let check_evar_map_of_evars_defs evd =
+ let metas = Evd.meta_list evd in
+ let check_freemetas_is_empty rebus =
+  Evd.Metaset.iter
+   (fun m ->
+     if Evd.meta_defined evd m then () else
+      raise (Logic.RefinerError (Logic.OccurMetaGoal rebus)))
+ in
+  List.iter
+   (fun (_,binding) ->
+     match binding with
+        Evd.Cltyp (_,{Evd.rebus=rebus; Evd.freemetas=freemetas}) ->
+         check_freemetas_is_empty rebus freemetas
+      | Evd.Clval (_,{Evd.rebus=rebus1; Evd.freemetas=freemetas1},
+                 {Evd.rebus=rebus2; Evd.freemetas=freemetas2}) ->
+         check_freemetas_is_empty rebus1 freemetas1 ;
+         check_freemetas_is_empty rebus2 freemetas2
+   ) metas
+
+(* For a correct meta-aware "rewrite in", we split unification 
+   apart from the actual rewriting (Pierre L, 05/04/06) *)
+   
+(* [unification_rewrite] searchs a match for [c1] in [but] and then 
+   returns the modified objects (in particular [c1] and [c2]) *)  
+
+let unification_rewrite c1 c2 cl but gl = 
+  let (env',c1) =
+    try
+      (* ~mod_delta:false to allow to mark occurences that must not be
+         rewritten simply by replacing them with let-defined definitions
+         in the context *)
+      w_unify_to_subterm ~mod_delta:false (pf_env gl) (c1,but) cl.env
+    with
+	Pretype_errors.PretypeError _ ->
+	  (* ~mod_delta:true to make Ring work (since it really
+             exploits conversion) *)
+	  w_unify_to_subterm ~mod_delta:true (pf_env gl) (c1,but) cl.env
   in
-    aux 0 bl
-
-
-let res_tac c a hyp =
-  let sa = setoid_table_find a in
-  let fin = match hyp with
-    | None -> Auto.full_trivial
-    | Some h -> 
-	tclORELSE (tclTHEN (tclTRY (apply h)) (tclFAIL 0 "")) 
-	(tclORELSE (tclTHEN (tclTRY (tclTHEN (apply (mkApp ((Lazy.force coq_seq_sym), [|sa.set_a; sa.set_aeq; sa.set_th|]))) (apply h))) (tclFAIL 0 ""))
-	   Auto.full_trivial) in
-    tclORELSE (tclTHEN (tclTRY (apply (mkApp ((Lazy.force coq_seq_refl), [|sa.set_a; sa.set_aeq; sa.set_th;c|])))) (tclFAIL 0 ""))
-      (tclORELSE assumption
-	 (tclORELSE (tclTHEN (tclTRY (apply (mkApp ((Lazy.force coq_seq_sym), [|sa.set_a; sa.set_aeq; sa.set_th|])))) assumption)
-	    fin))
-
-let id_res_tac c a = 
-  let sa = setoid_table_find a in
-    (tclTRY (apply (mkApp ((Lazy.force coq_seq_refl), [|sa.set_a; sa.set_aeq; sa.set_th; c|]))))
-
-(* An exception to catchs errors *)
-
-exception Nothing_found of constr;;
-
-let rec create_tac_list i a al c1 c2 hyp args_t = function
-  | [] -> []
-  | false::q -> create_tac_list (i+1) a al c1 c2 hyp args_t q
-  | true::q -> 
-      if (is_to_replace a.(i))
-      then (zapply false al.(i) a.(i) c1 c2 hyp)::(create_tac_list (i+1) a al c1 c2 hyp args_t q)
-      else (id_res_tac al.(i) (List.nth args_t i))::(create_tac_list (i+1) a al c1 c2 hyp args_t q)
-(*      else tclIDTAC::(create_tac_list (i+1) a al c1 c2 hyp q) *)
-
-and zapply is_r gl gl_m c1 c2 hyp glll = (match ((kind_of_term gl), gl_m) with
-  | ((App (c,al)),(MApp a)) -> (
-      try 
-	let m = morphism_table_find c in
-	let args = Array.of_list (create_args al a m.profil c1 c2) in
-	  if is_r
-	  then tclTHENS (apply (mkApp (m.lem, args)))
-	    ((create_tac_list 0 a al c1 c2 hyp m.arg_types m.profil)@[tclIDTAC])
- 	  else (match m.lem2 with
-		  | None -> 
-		      tclTHENS (apply (mkApp (m.lem, args))) (create_tac_list 0 a al c1 c2 hyp m.arg_types m.profil)
-		  | Some xom -> 
-		      tclTHENS (apply (mkApp (xom, args))) (create_tac_list 0 a al c1 c2 hyp m.arg_types m.profil))
-      with Not_found -> errorlabstrm "Setoid_replace" 
-	  (str "The term " ++ prterm c ++ str " has not been declared as a morphism"))
-  | ((Prod (_,hh, cc)),(Mimp (hhm, ccm))) ->
-      let al = [|hh; cc|] in
-      let a = [|hhm; ccm|] in
-      let fleche_constr = (Lazy.force coq_fleche) in
-      let fleche_cp = destConst fleche_constr in
-      let new_concl = (mkApp (fleche_constr, al)) in
-	if is_r 
-	then
-	  let m = morphism_table_find fleche_constr in
-	  let args = Array.of_list (create_args al a m.profil c1 c2) in  
-	    tclTHEN (change_in_concl None new_concl)
-	      (tclTHENS (apply (mkApp (m.lem, args)))
-		 ((create_tac_list 0 a al c1 c2 hyp m.arg_types m.profil)@[unfold_constr (ConstRef fleche_cp)]))
-(*		 ((create_tac_list 0 a al c1 c2 hyp m.arg_types m.profil)@[tclIDTAC])) *)
-	else (zapply is_r new_concl (MApp a) c1 c2 hyp)
-(*      let args = Array.of_list (create_args [|hh; cc|] [|hhm; ccm|] [true;true] c1 c2) in
-	if is_r
-	then tclTHENS (apply (mkApp ((Lazy.force coq_fleche_ext), args)))
-	  ((create_tac_list 0 [|hhm; ccm|] [|hh; cc|] c1 c2 hyp [mkProp; mkProp] [true;true])@[tclIDTAC])
-	else tclTHENS (apply (mkApp ((Lazy.force coq_fleche_ext2), args)))
-	  ((create_tac_list 0 [|hhm; ccm|] [|hh; cc|] c1 c2 hyp [mkProp; mkProp] [true;true])@[tclIDTAC])
-*)
-  | (_, Toreplace) -> 
-      if is_r 
-      then (match hyp with
-	      | None -> errorlabstrm "Setoid_replace"
-		  (str "You should use the tactic Replace here")
-	      | Some h ->
-		  let hypt = pf_type_of glll h in
-		  let (heq, hargs) = decompose_app hypt in
-		  let rec get_last_two = function
-		    | [c1;c2] -> (c1, c2)
-		    | x::y::z -> get_last_two (y::z)
-		    | _ -> assert false in
-		  let (hc1,hc2) = get_last_two hargs in
-		    if c1 = hc1
-		    then 				     
-		      apply (mkApp (Lazy.force coqproj2,[|(mkArrow hc1 hc2);(mkArrow hc2 hc1);h|]))
-		    else 
-		      apply (mkApp (Lazy.force coqproj1,[|(mkArrow hc1 hc2);(mkArrow hc2 hc1);h|]))
-	   )
-      else (res_tac gl (pf_type_of glll gl) hyp) (* tclORELSE Auto.full_trivial tclIDTAC *)
-  | (_, Tokeep) -> (match hyp with 
-		      | None -> errorlabstrm "Setoid_replace"
-			  (str "No replacable occurence of " ++ prterm c1 ++ str " found")
-		      | Some _ ->errorlabstrm "Setoid_replace"
-			  (str "No rewritable occurence of " ++ prterm c1 ++ str " found"))
-  | _ -> anomaly ("Bug in Setoid_replace")) glll
-
-let setoid_replace c1 c2 hyp gl =
-  let but = (pf_concl gl) in
-    (zapply true but (mark_occur c1 but) c1 c2 hyp) gl
-
-let general_s_rewrite lft2rgt c gl =
-  let ctype = pf_type_of gl c in
-  let (equiv, args) = decompose_app ctype in
-  let rec get_last_two = function
-    | [c1;c2] -> (c1, c2)
-    | x::y::z -> get_last_two (y::z)
-    | _ -> error "The term provided is not an equivalence" in 
-  let (c1,c2) = get_last_two args in
-    if lft2rgt
-    then setoid_replace c1 c2 (Some c) gl
-    else setoid_replace c2 c1 (Some c) gl
-
-let setoid_rewriteLR = general_s_rewrite true
-
-let setoid_rewriteRL = general_s_rewrite false
+  let cl' = {cl with env = env' } in
+  let c2 = Clenv.clenv_nf_meta cl' c2 in
+  check_evar_map_of_evars_defs env' ;
+  env',Clenv.clenv_value cl', c1, c2
+
+(* no unification is performed in this function. [sigma] is the 
+ substitution obtained from an earlier unification. *)
+
+let relation_rewrite_no_unif c1 c2 hyp ~new_goals sigma gl = 
+  let but = pf_concl gl in 
+  try
+   let input_relation =
+    relation_class_that_matches_a_constr "Setoid_rewrite"
+     new_goals (Typing.mtype_of (pf_env gl) sigma (snd hyp)) in
+   let output_relation,output_direction,marked_but =
+    mark_occur gl ~new_goals c1 but input_relation (fst hyp) in
+   let cic_output_direction = cic_direction_of_direction output_direction in
+   let if_output_relation_is_iff gl =
+    let th =
+     apply_coq_setoid_rewrite input_relation output_relation c1 c2 hyp
+      cic_output_direction marked_but
+    in
+     let new_but = Termops.replace_term c1 c2 but in
+     let hyp1,hyp2,proj =
+      match output_direction with
+         Right2Left -> new_but, but, Lazy.force coq_proj1
+       | Left2Right -> but, new_but, Lazy.force coq_proj2
+     in
+     let impl1 = mkProd (Anonymous, hyp2, lift 1 hyp1) in
+     let impl2 = mkProd (Anonymous, hyp1, lift 1 hyp2) in
+      let th' = mkApp (proj, [|impl2; impl1; th|]) in
+       Tactics.refine
+        (mkApp (th',[|mkCast (Evarutil.mk_new_meta(), DEFAULTcast, new_but)|]))
+	gl in
+   let if_output_relation_is_if gl =
+    let th =
+     apply_coq_setoid_rewrite input_relation output_relation c1 c2 hyp
+      cic_output_direction marked_but
+    in
+     let new_but = Termops.replace_term c1 c2 but in
+      Tactics.refine
+       (mkApp (th, [|mkCast (Evarutil.mk_new_meta(), DEFAULTcast, new_but)|]))
+       gl in
+   if output_relation = (Lazy.force coq_iff_relation) then
+     if_output_relation_is_iff gl
+   else
+     if_output_relation_is_if gl
+  with
+    Optimize ->
+      !general_rewrite (fst hyp = Left2Right) (snd hyp) gl
+
+let relation_rewrite c1 c2 (input_direction,cl) ~new_goals gl =
+ let (sigma,cl,c1,c2) = unification_rewrite c1 c2 cl (pf_concl gl) gl in 
+ relation_rewrite_no_unif c1 c2 (input_direction,cl) ~new_goals sigma gl 
+
+let analyse_hypothesis gl c =
+ let ctype = pf_type_of gl c in
+ let eqclause  = Clenv.make_clenv_binding gl (c,ctype) Rawterm.NoBindings in
+ let (equiv, args) = decompose_app (Clenv.clenv_type eqclause) in
+ let rec split_last_two = function
+   | [c1;c2] -> [],(c1, c2)
+   | x::y::z ->
+      let l,res = split_last_two (y::z) in x::l, res
+   | _ -> error "The term provided is not an equivalence" in
+ let others,(c1,c2) = split_last_two args in
+  eqclause,mkApp (equiv, Array.of_list others),c1,c2
+
+let general_s_rewrite lft2rgt c ~new_goals gl =
+  let eqclause,_,c1,c2 = analyse_hypothesis gl c in
+  if lft2rgt then 
+    relation_rewrite c1 c2 (Left2Right,eqclause) ~new_goals gl
+  else 
+    relation_rewrite c2 c1 (Right2Left,eqclause) ~new_goals gl
+
+let relation_rewrite_in id c1 c2 (direction,eqclause) ~new_goals gl = 
+ let hyp = pf_type_of gl (mkVar id) in
+ (* first, we find a match for c1 in the hyp *)
+ let (sigma,cl,c1,c2) = unification_rewrite c1 c2 eqclause hyp gl in 
+ (* since we will actually rewrite in the opposite direction, we also need
+    to replace every occurrence of c2 (resp. c1) in hyp with something that
+    is convertible but not syntactically equal. To this aim we introduce a
+    let-in and then we will use the intro tactic to get rid of it *)
+ let let_in_abstract t in_t =
+  let t' = lift 1 t in
+  let in_t' = lift 1 in_t in
+   mkLetIn (Anonymous,t,pf_type_of gl t,subst_term t' in_t') in
+ let mangled_new_hyp = Termops.replace_term c1 c2 (let_in_abstract c2 hyp) in
+ let new_hyp = Termops.replace_term c1 c2 hyp in 
+ let oppdir = opposite_direction direction in 
+ cut_replacing id new_hyp
+   (tclTHENLAST
+      (tclTHEN (change_in_concl None mangled_new_hyp)
+         (tclTHEN intro
+            (relation_rewrite_no_unif c2 c1 (oppdir,cl) ~new_goals sigma))))
+   gl
+
+let general_s_rewrite_in id lft2rgt c ~new_goals gl =
+  let eqclause,_,c1,c2 = analyse_hypothesis gl c in
+  if lft2rgt then 
+    relation_rewrite_in id c1 c2 (Left2Right,eqclause) ~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
+  let relation =
+   match relation with
+      Some rel ->
+       (try
+         match find_relation_class rel with
+            Relation sa -> sa
+          | Leibniz _ -> raise Optimize
+        with
+         Not_found ->
+          errorlabstrm "Setoid_rewrite"
+           (pr_lconstr rel ++ str " is not a registered relation."))
+    | None ->
+       match default_relation_for_carrier (pf_type_of gl c1) with
+          Relation sa -> sa
+        | Leibniz _ -> raise Optimize
+  in
+   let eq_left_to_right = mkApp (relation.rel_aeq, [| c1 ; c2 |]) in
+   let eq_right_to_left = mkApp (relation.rel_aeq, [| c2 ; c1 |]) in
+   let replace dir eq =
+    tclTHENS (assert_tac false Anonymous eq)
+      [onLastHyp (fun id ->
+        tclTHEN
+          (general_s_rewrite dir (mkVar id) ~new_goals)
+          (clear [id]));
+       Tacticals.tclIDTAC]
+   in
+    tclORELSE
+     (replace true eq_left_to_right) (replace false eq_right_to_left) gl
+ with
+  Optimize -> (!replace c1 c2) 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
+
+(* [setoid_]{reflexivity,symmetry,transitivity} tactics *)
+
+let setoid_reflexivity gl =
+ try
+  let relation_class =
+   relation_class_that_matches_a_constr "Setoid_reflexivity"
+    [] (pf_concl gl) in
+  match relation_class with
+     Leibniz _ -> assert false (* since [] is empty *)
+   | Relation rel ->
+      match rel.rel_refl with
+         None ->
+          errorlabstrm "Setoid_reflexivity"
+           (str "The relation " ++ prrelation rel ++ str " is not reflexive.")
+       | Some refl -> apply refl gl
+ with
+  Optimize -> reflexivity gl
+
+let setoid_symmetry gl =
+ try
+  let relation_class =
+   relation_class_that_matches_a_constr "Setoid_symmetry"
+    [] (pf_concl gl) in
+  match relation_class with
+     Leibniz _ -> assert false (* since [] is empty *)
+   | Relation rel ->
+      match rel.rel_sym with
+         None ->
+          errorlabstrm "Setoid_symmetry"
+           (str "The relation " ++ prrelation rel ++ str " is not symmetric.")
+       | Some sym -> apply sym gl
+ with
+  Optimize -> symmetry gl
+
+let setoid_symmetry_in id gl =
+ let new_hyp =
+  let _,he,c1,c2 = analyse_hypothesis gl (mkVar id) in
+   mkApp (he, [| c2 ; c1 |])
+ in
+ cut_replacing id new_hyp (tclTHEN setoid_symmetry) gl
+
+let setoid_transitivity c gl =
+ try
+  let relation_class =
+   relation_class_that_matches_a_constr "Setoid_transitivity"
+    [] (pf_concl gl) in
+  match relation_class with
+     Leibniz _ -> assert false (* since [] is empty *)
+   | Relation rel ->
+      let ctyp = pf_type_of gl c in
+      let rel' = unify_relation_carrier_with_type (pf_env gl) rel ctyp in
+       match rel'.rel_trans with
+          None ->
+           errorlabstrm "Setoid_transitivity"
+            (str "The relation " ++ prrelation rel ++ str " is not transitive.")
+        | Some trans ->
+           let transty = nf_betaiota (pf_type_of gl trans) in
+           let argsrev, _ =
+            Reductionops.decomp_n_prod (pf_env gl) Evd.empty 2 transty in
+           let binder =
+            match List.rev argsrev with
+               _::(Name n2,None,_)::_ -> Rawterm.NamedHyp n2
+             | _ -> assert false
+           in
+            apply_with_bindings
+             (trans, Rawterm.ExplicitBindings [ dummy_loc, binder, c ]) gl
+ with
+  Optimize -> transitivity c gl
+;;
+
+Tactics.register_setoid_reflexivity setoid_reflexivity;;
+Tactics.register_setoid_symmetry setoid_symmetry;;
+Tactics.register_setoid_symmetry_in setoid_symmetry_in;;
+Tactics.register_setoid_transitivity setoid_transitivity;;
diff --git a/tactics/setoid_replace.mli b/tactics/setoid_replace.mli
index 854fa478..5dc691a9 100644
--- a/tactics/setoid_replace.mli
+++ b/tactics/setoid_replace.mli
@@ -6,22 +6,72 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: setoid_replace.mli,v 1.3.6.2 2005/01/21 17:14:11 herbelin Exp $ i*)
+(*i $Id: setoid_replace.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
 
 open Term
 open Proof_type
 open Topconstr
+open Names
+
+type relation =
+   { rel_a: constr ;
+     rel_aeq: constr;
+     rel_refl: constr option;
+     rel_sym: constr option;
+     rel_trans : constr option;
+     rel_quantifiers_no: int  (* it helps unification *);
+     rel_X_relation_class: constr;
+     rel_Xreflexive_relation_class: constr
+   }
+
+type 'a relation_class =
+   Relation of 'a    (* the [rel_aeq] of the relation or the relation*)
+ | Leibniz of constr option  (* the [carrier] (if [eq] is partially instantiated)*)
+
+type 'a morphism =
+    { args : (bool option * 'a relation_class) list;
+      output : 'a relation_class;
+      lem : constr;
+      morphism_theory : constr
+    }
+
+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_general_rewrite : (bool -> constr -> tactic) -> unit
+
+val print_setoids : unit -> unit
 
 val equiv_list : unit -> constr list
+val default_relation_for_carrier :
+  ?filter:(relation -> bool) -> types -> relation relation_class 
+(* [default_morphism] raises [Not_found] *)
+val default_morphism :
+  ?filter:(constr morphism -> bool) -> constr -> relation morphism
 
-val setoid_replace : constr -> constr -> constr option -> tactic
+val setoid_replace :
+ constr option -> constr -> constr -> new_goals:constr list -> tactic
+val setoid_replace_in :
+ identifier -> constr option -> constr -> constr -> new_goals:constr list ->
+  tactic
 
-val setoid_rewriteLR : constr -> tactic
+val general_s_rewrite : bool -> constr -> new_goals:constr list -> tactic
+val general_s_rewrite_in :
+ identifier -> bool -> constr -> new_goals:constr list -> tactic
 
-val setoid_rewriteRL : constr -> tactic
+val setoid_reflexivity : tactic
+val setoid_symmetry : tactic
+val setoid_symmetry_in : identifier -> tactic
+val setoid_transitivity : constr -> tactic
 
-val general_s_rewrite : bool -> constr -> tactic
+val add_relation :
+ Names.identifier -> constr_expr -> constr_expr -> constr_expr option ->
+  constr_expr option -> constr_expr option -> unit
 
-val add_setoid : constr_expr -> constr_expr -> constr_expr -> unit
+val add_setoid :
+ Names.identifier -> constr_expr -> constr_expr -> constr_expr -> unit
 
-val new_named_morphism : Names.identifier -> constr_expr -> unit
+val new_named_morphism :
+ Names.identifier -> constr_expr -> morphism_signature option -> unit
diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml
index 245b5a5b..e2487c4e 100644
--- a/tactics/tacinterp.ml
+++ b/tactics/tacinterp.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacinterp.ml,v 1.84.2.11 2005/11/04 09:01:27 herbelin Exp $ *)
+(* $Id: tacinterp.ml 8654 2006-03-22 15:36:58Z msozeau $ *)
 
 open Constrintern
 open Closure
@@ -32,7 +32,6 @@ open Refiner
 open Tacmach
 open Tactic_debug
 open Topconstr
-open Ast
 open Term
 open Termops
 open Tacexpr
@@ -41,11 +40,12 @@ open Typing
 open Hiddentac
 open Genarg
 open Decl_kinds
-
-let strip_meta id = (* For Grammar v7 compatibility *)
-  let s = string_of_id id in
-  if s.[0]='$' then id_of_string (String.sub s 1 (String.length s - 1))
-  else id
+open Mod_subst
+open Printer
+open Inductiveops
+open Syntax_def
+open Pretyping
+open Pretyping.Default
 
 let error_syntactic_metavariables_not_allowed loc =
   user_err_loc 
@@ -115,8 +115,8 @@ let pr_value env = function
   | VVoid -> str "()"
   | VInteger n -> int n
   | VIntroPattern ipat -> pr_intro_pattern ipat
-  | VConstr c -> Printer.prterm_env env c
-  | VConstr_context c -> Printer.prterm_env env c
+  | VConstr c -> pr_lconstr_env env c
+  | VConstr_context c -> pr_lconstr_env env c
   | (VTactic _ | VRTactic _ | VFun _ | VRec _) -> str "<fun>"
 
 (* Transforms a named_context into a (string * constr) list *)
@@ -126,7 +126,7 @@ let make_hyps = List.map (fun (id,_,typ) -> (id, typ))
 let constr_of_id env id = 
   construct_reference (Environ.named_context env) id
 
-(* To embed several objects in Coqast.t *)
+(* To embed tactics *)
 let ((tactic_in : (interp_sign -> raw_tactic_expr) -> Dyn.t),
      (tactic_out : Dyn.t -> (interp_sign -> raw_tactic_expr))) =
   create "tactic"
@@ -155,42 +155,18 @@ let valueOut = function
   | ast ->
     anomalylabstrm "valueOut" (str "Not a Dynamic ast: ")
 
-(* To embed constr in Coqast.t *)
-let constrIn t = CDynamic (dummy_loc,Pretyping.constr_in t)
+(* To embed constr *)
+let constrIn t = CDynamic (dummy_loc,constr_in t)
 let constrOut = function
   | CDynamic (_,d) ->
     if (Dyn.tag d) = "constr" then
-      Pretyping.constr_out d
+      constr_out d
     else
       anomalylabstrm "constrOut" (str "Dynamic tag should be constr")
   | ast ->
     anomalylabstrm "constrOut" (str "Not a Dynamic ast")
-let loc = dummy_loc
-
-(* Table of interpretation functions *)
-let interp_tab =
-  (Hashtbl.create 17 : (string , interp_sign -> Coqast.t -> value) Hashtbl.t)
 
-(* Adds an interpretation function *)
-let interp_add (ast_typ,interp_fun) =
-  try
-    Hashtbl.add interp_tab ast_typ interp_fun
-  with
-      Failure _ ->
-        errorlabstrm "interp_add"
-          (str "Cannot add the interpretation function for " ++ str ast_typ ++            str " twice")
-
-(* Adds a possible existing interpretation function *)
-let overwriting_interp_add (ast_typ,interp_fun) =
-  if Hashtbl.mem interp_tab ast_typ then
-  begin
-    Hashtbl.remove interp_tab ast_typ;
-    warning ("Overwriting definition of tactic interpreter command " ^ ast_typ)
-  end;
-  Hashtbl.add interp_tab ast_typ interp_fun
-
-(* Finds the interpretation function corresponding to a given ast type *)
-let look_for_interp = Hashtbl.find interp_tab
+let loc = dummy_loc
 
 (* Globalizes the identifier *)
 
@@ -203,7 +179,7 @@ let find_reference env qid =
 
 let coerce_to_reference env = function
   | VConstr c ->
-      (try reference_of_constr c
+      (try global_of_constr c
       with Not_found -> invalid_arg_loc (loc, "Not a reference"))
   | v -> errorlabstrm "coerce_to_reference"
       (str "The value" ++ spc () ++ pr_value env v ++ 
@@ -220,7 +196,7 @@ let coerce_to_evaluable_ref env c =
     | VConstr c when isConst c -> EvalConstRef (destConst c)
     | VConstr c when isVar c -> EvalVarRef (destVar c)
     | VIntroPattern (IntroIdentifier id)
-        when Environ.evaluable_named id env -> EvalVarRef id
+	when Environ.evaluable_named id env -> EvalVarRef id
     | _ -> error_not_evaluable (pr_value env c)
   in
   if not (Tacred.is_evaluable env ev) then
@@ -232,10 +208,10 @@ let coerce_to_inductive = function
   | x ->
       try
 	let r = match x with
-	  | VConstr c -> reference_of_constr c
+	  | VConstr c -> global_of_constr c
 	  | _ -> failwith "" in
 	errorlabstrm "coerce_to_inductive"
-          (Printer.pr_global r ++ str " is not an inductive type")
+          (pr_global r ++ str " is not an inductive type")
       with _ ->
 	errorlabstrm "coerce_to_inductive"
           (str "Found an argument which should be an inductive type")
@@ -244,14 +220,12 @@ let coerce_to_inductive = function
 (* Table of "pervasives" macros tactics (e.g. auto, simpl, etc.) *)
 let atomic_mactab = ref Idmap.empty
 let add_primitive_tactic s tac =
-  (if not !Options.v7 then
-    let id = id_of_string s in
-    atomic_mactab := Idmap.add id tac !atomic_mactab)
+  let id = id_of_string s in
+  atomic_mactab := Idmap.add id tac !atomic_mactab
 
 let _ =
-  if not !Options.v7 then
-    (let nocl = {onhyps=Some[];onconcl=true; concl_occs=[]} in
-    List.iter
+  let nocl = {onhyps=Some[];onconcl=true; concl_occs=[]} in
+  List.iter
       (fun (s,t) -> add_primitive_tactic s (TacAtom(dummy_loc,t)))
       [ "red", TacReduce(Red false,nocl);
         "hnf", TacReduce(Hnf,nocl);
@@ -261,8 +235,8 @@ let _ =
         "intros", TacIntroPattern [];
         "assumption", TacAssumption;
         "cofix", TacCofix None;
-        "trivial", TacTrivial None;
-        "auto", TacAuto(None,None);
+        "trivial", TacTrivial ([],None);
+        "auto", TacAuto(None,[],None);
         "left", TacLeft NoBindings;
         "right", TacRight NoBindings;
         "split", TacSplit(false,NoBindings);
@@ -270,12 +244,12 @@ let _ =
         "reflexivity", TacReflexivity;
         "symmetry", TacSymmetry nocl
       ];
-    List.iter
+  List.iter
       (fun (s,t) -> add_primitive_tactic s t)
-      [ "idtac",TacId "";
-        "fail", TacFail(ArgArg 0,"");
+      [ "idtac",TacId [];
+        "fail", TacFail(ArgArg 0,[]);
         "fresh", TacArg(TacFreshId None)
-      ])
+      ]
  
 let lookup_atomic id = Idmap.find id !atomic_mactab
 let is_atomic id = Idmap.mem id !atomic_mactab
@@ -312,7 +286,7 @@ type interp_genarg_type =
   (glob_sign -> raw_generic_argument -> glob_generic_argument) *
   (interp_sign -> goal sigma -> glob_generic_argument -> 
     closed_generic_argument) *
-  (Names.substitution -> glob_generic_argument -> glob_generic_argument)
+  (substitution -> glob_generic_argument -> glob_generic_argument)
 
 let extragenargtab =
   ref (Gmap.empty : (string,interp_genarg_type) Gmap.t)
@@ -326,10 +300,12 @@ let lookup_genarg_glob   id = let (f,_,_) = lookup_genarg id in f
 let lookup_interp_genarg id = let (_,f,_) = lookup_genarg id in f
 let lookup_genarg_subst  id = let (_,_,f) = lookup_genarg id in f
 
-(* Unboxes VRec *)
-let unrec = function
+(* Dynamically check that an argument is a tactic, possibly unboxing VRec *)
+let coerce_to_tactic loc id = function
   | VRec v -> !v
-  | a -> a
+  | VTactic _ | VFun _ | VRTactic _ as a -> a
+  | _ -> user_err_loc 
+  (loc, "", str "variable " ++  pr_id id ++ str " should be bound to a tactic")
 
 (*****************)
 (* Globalization *)
@@ -381,7 +357,6 @@ let adjust_loc loc = if !strict_check then dummy_loc else loc
 
 (* Globalize a name which must be bound -- actually just check it is bound *)
 let intern_hyp ist (loc,id as locid) =
-  let (_,env) = get_current_context () in
   if not !strict_check then
     locid
   else if find_ident id ist then
@@ -392,28 +367,18 @@ 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
-  | ArgVar locid as x -> ArgVar (intern_hyp ist locid)
+  | ArgVar locid -> ArgVar (intern_hyp ist locid)
   | ArgArg n as x -> x
 
 let intern_inductive ist = function
   | Ident (loc,id) when find_var id ist -> ArgVar (loc,id)
   | r -> ArgArg (Nametab.global_inductive r)
 
-exception NotSyntacticRef
-
-let locate_reference qid =
-  match Nametab.extended_locate qid with
-    | TrueGlobal ref -> ref
-    | SyntacticDef kn -> 
-	match Syntax_def.search_syntactic_definition loc kn with
-	  | Rawterm.RRef (_,ref) -> ref
-	  | _ -> raise NotSyntacticRef
-
 let intern_global_reference ist = function
-  | Ident (loc,id) as r when find_var id ist -> ArgVar (loc,id)
+  | Ident (loc,id) when find_var id ist -> ArgVar (loc,id)
   | r -> 
       let loc,qid = qualid_of_reference r in
-      try ArgArg (loc,locate_reference qid)
+      try ArgArg (loc,locate_global qid)
       with _ -> 
 	error_global_not_found_loc loc qid
 
@@ -438,13 +403,12 @@ let intern_constr_reference strict ist = function
       RVar (loc,id), None
   | r ->
       let loc,qid = qualid_of_reference r in
-      RRef (loc,locate_reference qid), if strict then None else Some (CRef r)
+      RRef (loc,locate_global qid), if strict then None else Some (CRef r)
 
 let intern_reference strict ist r =
   (try Reference (intern_tac_ref ist r)
    with Not_found ->
-     (try
-       ConstrMayEval (ConstrTerm (intern_constr_reference strict ist r))
+     (try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist r))
       with Not_found ->
         (match r with
           | Ident (loc,id) when is_atomic id -> Tacexp (lookup_atomic id)
@@ -453,13 +417,18 @@ let intern_reference strict ist r =
               let (loc,qid) = qualid_of_reference r in
               error_global_not_found_loc loc qid)))
 
+let intern_message_token ist = function
+  | (MsgString _ | MsgInt _ as x) -> x
+  | MsgIdent id -> MsgIdent (intern_hyp_or_metaid ist id)
+
+let intern_message ist = List.map (intern_message_token ist)
+
 let rec intern_intro_pattern lf ist = function
   | IntroOrAndPattern l ->
       IntroOrAndPattern (intern_case_intro_pattern lf ist l)
-  | IntroWildcard ->
-      IntroWildcard
   | IntroIdentifier id ->
       IntroIdentifier (intern_ident lf ist id)
+  | IntroWildcard | IntroAnonymous as x -> x
 
 and intern_case_intro_pattern lf ist =
   List.map (List.map (intern_intro_pattern lf ist))
@@ -469,19 +438,16 @@ let intern_quantified_hypothesis ist x =
      statically check the existence of a quantified hyp); thus nothing to do *)
   x
 
-let intern_constr {ltacvars=lfun; gsigma=sigma; genv=env} c =
+let intern_constr_gen isarity {ltacvars=lfun; gsigma=sigma; genv=env} c =
   let warn = if !strict_check then fun x -> x else Constrintern.for_grammar in
   let c' = 
-    warn (Constrintern.interp_rawconstr_gen false sigma env 
-      false (fst lfun,[])) c in
-  begin if Options.do_translate () then try
-      (* Try to infer old case and type annotations *)
-      let _ = Pretyping.understand_gen_tcc sigma env [] None c' in 
-      (* msgerrnl (str "Typage tactique OK");*)
-      ()
-    with e -> (*msgerrnl (str "Warning: can't type tactic");*) () end;
+    warn (Constrintern.intern_gen isarity ~ltacvars:(fst lfun,[]) sigma env) c
+  in
   (c',if !strict_check then None else Some c)
 
+let intern_constr = intern_constr_gen false
+let intern_type = intern_constr_gen true
+
 (* Globalize bindings *)
 let intern_binding ist (loc,b,c) =
   (loc,intern_quantified_hypothesis ist b,intern_constr ist c)
@@ -504,7 +470,7 @@ let intern_clause_pattern ist (l,occl) =
 let intern_induction_arg ist = function
   | ElimOnConstr c -> ElimOnConstr (intern_constr ist c)
   | ElimOnAnonHyp n as x -> x
-  | ElimOnIdent (loc,id) as x ->
+  | ElimOnIdent (loc,id) ->
       if !strict_check then
 	(* If in a defined tactic, no intros-until *)
 	ElimOnConstr (intern_constr ist (CRef (Ident (dummy_loc,id))))
@@ -513,14 +479,14 @@ let intern_induction_arg ist = function
 
 (* Globalizes a reduction expression *)
 let intern_evaluable ist = function
-  | Ident (loc,id) as r when find_ltacvar id ist -> ArgVar (loc,id)
+  | Ident (loc,id) when find_ltacvar id ist -> ArgVar (loc,id)
   | Ident (_,id) when
       (not !strict_check & find_hyp id ist) or find_ctxvar id ist ->
       ArgArg (EvalVarRef id, None)
   | r ->
       let loc,qid = qualid_of_reference r in
       try
-	let e = match locate_reference qid with
+	let e = match locate_global qid with
 	  | ConstRef c -> EvalConstRef c
 	  | VarRef c -> EvalVarRef c
 	  | _ -> error_not_evaluable (pr_reference r) in
@@ -529,7 +495,6 @@ let intern_evaluable ist = function
 	  | _ -> None in
         ArgArg (e,short_name)
       with
-	| NotSyntacticRef -> error_not_evaluable (pr_reference r)
 	| Not_found ->
 	match r with 
 	  | Ident (loc,id) when not !strict_check ->
@@ -550,15 +515,16 @@ let intern_redexp ist = function
   | Lazy f -> Lazy (intern_flag ist f)
   | Pattern l -> Pattern (List.map (intern_constr_occurrence ist) l)
   | Simpl o -> Simpl (option_app (intern_constr_occurrence ist) o)
-  | (Red _ | Hnf | ExtraRedExpr _ as r) -> r
+  | (Red _ | Hnf | ExtraRedExpr _ | CbvVm as r ) -> r
+  
 
 let intern_inversion_strength lf ist = function
   | NonDepInversion (k,idl,ids) ->
       NonDepInversion (k,List.map (intern_hyp_or_metaid ist) idl,
-      option_app (intern_intro_pattern lf ist) ids)
+      intern_intro_pattern lf ist ids)
   | DepInversion (k,copt,ids) ->
       DepInversion (k, option_app (intern_constr ist) copt,
-      option_app (intern_intro_pattern lf ist) ids)
+      intern_intro_pattern lf ist ids)
   | InversionUsing (c,idl) ->
       InversionUsing (intern_constr ist c, List.map (intern_hyp_or_metaid ist) idl)
 
@@ -566,10 +532,15 @@ let intern_inversion_strength lf ist = function
 let intern_hyp_location ist (id,occs,hl) =
   (intern_hyp ist (skip_metaid id), occs, hl)
 
+let interp_constrpattern_gen sigma env ltacvar c =
+  let c = intern_gen false ~allow_soapp:true ~ltacvars:(ltacvar,[])
+                     sigma env c in
+  pattern_of_rawconstr c
+
 (* Reads a pattern *)
 let intern_pattern evc env lfun = function
   | Subterm (ido,pc) ->
-      let (metas,pat) = interp_constrpattern_gen evc env lfun pc  in
+      let (metas,pat) = interp_constrpattern_gen evc env lfun pc in
       ido, metas, Subterm (ido,pat)
   | Term pc ->
       let (metas,pat) = interp_constrpattern_gen evc env lfun pc  in
@@ -582,6 +553,24 @@ let intern_constr_may_eval ist = function
   | ConstrTypeOf c -> ConstrTypeOf (intern_constr ist c)
   | ConstrTerm c -> ConstrTerm (intern_constr ist c)
 
+(* External tactics *)
+let print_xml_term = ref (fun _ -> failwith "print_xml_term unset")
+let declare_xml_printer f = print_xml_term := f
+
+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 _ ->
+      error "Only externing of terms is implemented"
+
+let extern_request ch req gl la =
+  output_string ch "<REQUEST req=\""; output_string ch req;
+  output_string ch "\">\n";
+  List.iter (pf_apply (extern_tacarg ch) gl) la;
+  output_string ch "</REQUEST>\n"
+
 (* Reads the hypotheses of a Match Context rule *)
 let rec intern_match_context_hyps evc env lfun = function
   | (Hyp ((_,na) as locna,mp))::tl ->
@@ -615,7 +604,6 @@ let extract_let_names lrc =
       name::l)
     lrc []
 
-
 let clause_app f = function
     { onhyps=None; onconcl=b;concl_occs=nl } ->
       { onhyps=None; onconcl=b; concl_occs=nl }
@@ -634,39 +622,46 @@ let rec intern_atomic lf ist x =
           option_app (intern_hyp ist) ido')
   | TacAssumption -> TacAssumption
   | TacExact c -> TacExact (intern_constr ist c)
+  | TacExactNoCheck c -> TacExactNoCheck (intern_constr ist c)
   | TacApply cb -> TacApply (intern_constr_with_bindings ist cb)
   | TacElim (cb,cbo) ->
       TacElim (intern_constr_with_bindings ist cb,
                option_app (intern_constr_with_bindings ist) cbo)
-  | TacElimType c -> TacElimType (intern_constr ist c)
+  | TacElimType c -> TacElimType (intern_type ist c)
   | TacCase cb -> TacCase (intern_constr_with_bindings ist cb)
-  | TacCaseType c -> TacCaseType (intern_constr ist c)
+  | TacCaseType c -> TacCaseType (intern_type ist c)
   | TacFix (idopt,n) -> TacFix (option_app (intern_ident lf ist) idopt,n)
   | TacMutualFix (id,n,l) ->
-      let f (id,n,c) = (intern_ident lf ist id,n,intern_constr ist c) in
+      let f (id,n,c) = (intern_ident lf ist id,n,intern_type ist c) in
       TacMutualFix (intern_ident lf ist id, n, List.map f l)
   | TacCofix idopt -> TacCofix (option_app (intern_ident lf ist) idopt)
   | TacMutualCofix (id,l) ->
-      let f (id,c) = (intern_ident lf ist id,intern_constr ist c) in
+      let f (id,c) = (intern_ident lf ist id,intern_type ist c) in
       TacMutualCofix (intern_ident lf ist id, List.map f l)
-  | TacCut c -> TacCut (intern_constr ist c)
-  | TacTrueCut (na,c) ->
-      TacTrueCut (intern_name lf ist na, intern_constr ist c)
-  | TacForward (b,na,c) ->
-      TacForward (b,intern_name lf ist na,intern_constr ist c)
+  | TacCut c -> TacCut (intern_type ist c)
+  | TacAssert (otac,ipat,c) ->
+      TacAssert (option_app (intern_tactic ist) otac,
+                 intern_intro_pattern lf ist ipat,
+                 intern_constr_gen (otac<>None) ist c)
   | TacGeneralize cl -> TacGeneralize (List.map (intern_constr ist) cl)
   | TacGeneralizeDep c -> TacGeneralizeDep (intern_constr ist c)
   | TacLetTac (na,c,cls) ->
       let na = intern_name lf ist na in
       TacLetTac (na,intern_constr ist c,
                  (clause_app (intern_hyp_location ist) cls))
-  | TacInstantiate (n,c,cls) -> 
+(*  | TacInstantiate (n,c,idh) -> 
       TacInstantiate (n,intern_constr ist c,
-		      (clause_app (intern_hyp_location ist) cls))
+		      (match idh with
+			   ConclLocation () -> ConclLocation ()
+			 | HypLocation (id,hloc) -> 
+			      HypLocation(intern_hyp_or_metaid ist id,hloc))) 
+*)
 
   (* Automation tactics *)
-  | TacTrivial l -> TacTrivial l
-  | TacAuto (n,l) -> TacAuto (option_app (intern_int_or_var ist) n,l)
+  | TacTrivial (lems,l) -> TacTrivial (List.map (intern_constr ist) lems,l)
+  | TacAuto (n,lems,l) ->
+      TacAuto (option_app (intern_int_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
@@ -674,18 +669,18 @@ let rec intern_atomic lf ist x =
   | TacDAuto (n,p) -> TacDAuto (option_app (intern_int_or_var ist) n,p)
 
   (* Derived basic tactics *)
-  | TacSimpleInduction (h,ids) ->
-      TacSimpleInduction (intern_quantified_hypothesis ist h,ids)
-  | TacNewInduction (c,cbo,(ids,ids')) ->
-      TacNewInduction (intern_induction_arg ist c,
+  | TacSimpleInduction h ->
+      TacSimpleInduction (intern_quantified_hypothesis ist h)
+  | TacNewInduction (lc,cbo,ids) ->
+      TacNewInduction (List.map (intern_induction_arg ist) lc,
                option_app (intern_constr_with_bindings ist) cbo,
-               (option_app (intern_intro_pattern lf ist) ids,ids'))
+               (intern_intro_pattern lf ist ids))
   | TacSimpleDestruct h ->
       TacSimpleDestruct (intern_quantified_hypothesis ist h)
-  | TacNewDestruct (c,cbo,(ids,ids')) ->
-      TacNewDestruct (intern_induction_arg ist c,
+  | TacNewDestruct (c,cbo,ids) ->
+      TacNewDestruct (List.map (intern_induction_arg ist) c,
                option_app (intern_constr_with_bindings ist) cbo,
-	       (option_app (intern_intro_pattern lf ist) ids,ids'))
+	       (intern_intro_pattern lf ist ids))
   | TacDoubleInduction (h1,h2) ->
       let h1 = intern_quantified_hypothesis ist h1 in
       let h2 = intern_quantified_hypothesis ist h2 in
@@ -698,7 +693,7 @@ let rec intern_atomic lf ist x =
   | TacLApply c -> TacLApply (intern_constr ist c)
 
   (* Context management *)
-  | TacClear l -> TacClear (List.map (intern_hyp_or_metaid ist) l)
+  | TacClear (b,l) -> TacClear (b,List.map (intern_hyp_or_metaid ist) l)
   | TacClearBody l -> TacClearBody (List.map (intern_hyp_or_metaid ist) l)
   | TacMove (dep,id1,id2) ->
     TacMove (dep,intern_hyp_or_metaid ist id1,intern_hyp_or_metaid ist id2)
@@ -734,21 +729,13 @@ let rec intern_atomic lf ist x =
       let _ = lookup_tactic opn in
       TacExtend (adjust_loc loc,opn,List.map (intern_genarg ist) l)
   | TacAlias (loc,s,l,(dir,body)) ->
-      let (l1,l2) = ist.ltacvars in
-      let ist' = { ist with ltacvars = ((List.map fst l)@l1,l2) } in
-      let l = List.map (fun (id,a) -> (strip_meta id,intern_genarg ist a)) l in
-      try TacAlias (loc,s,l,(dir,intern_tactic ist' body))
+      let l = List.map (fun (id,a) -> (id,intern_genarg ist a)) l in
+      try TacAlias (loc,s,l,(dir,body))
       with e -> raise (locate_error_in_file (string_of_dirpath dir) e)
 
 and intern_tactic ist tac = (snd (intern_tactic_seq ist tac) : glob_tactic_expr)
 
 and intern_tactic_seq ist = function
-  (* Traducteur v7->v8 *)
-  | TacAtom (_,TacReduce (Unfold [_,Ident (_,id)],_))
-      when string_of_id id = "INZ" & !Options.translate_syntax
-        -> ist.ltacvars, (TacId "")
-  (* Fin traducteur v7->v8 *)
-
   | TacAtom (loc,t) ->
       let lf = ref ist.ltacvars in
       let t = intern_atomic lf ist t in
@@ -767,12 +754,13 @@ and intern_tactic_seq ist = function
       let (l1,l2) = ist.ltacvars in
       let ist' = { ist with ltacvars = ((extract_let_names l)@l1,l2) } in
       ist.ltacvars, TacLetIn (l,intern_tactic ist' u)
-  | TacMatchContext (lr,lmr) ->
-      ist.ltacvars, TacMatchContext(lr, intern_match_rule ist lmr)
-  | TacMatch (c,lmr) ->
-      ist.ltacvars, TacMatch (intern_tactic ist c,intern_match_rule ist lmr)
-  | TacId _ as x -> ist.ltacvars, x
-  | TacFail (n,x) -> ist.ltacvars, TacFail (intern_int_or_var ist n,x)
+  | TacMatchContext (lz,lr,lmr) ->
+      ist.ltacvars, TacMatchContext(lz,lr, intern_match_rule ist lmr)
+  | TacMatch (lz,c,lmr) ->
+      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)
   | TacProgress tac -> ist.ltacvars, TacProgress (intern_tactic ist tac)
   | TacAbstract (tac,s) -> ist.ltacvars, TacAbstract (intern_tactic ist tac,s)
   | TacThen (t1,t2) ->
@@ -793,6 +781,7 @@ and intern_tactic_seq ist = function
       ist.ltacvars, TacOrelse (intern_tactic ist tac1,intern_tactic ist tac2)
   | TacFirst l -> ist.ltacvars, TacFirst (List.map (intern_tactic ist) l)
   | TacSolve l -> ist.ltacvars, TacSolve (List.map (intern_tactic ist) l)
+  | TacComplete tac -> ist.ltacvars, TacComplete (intern_tactic ist tac)
   | TacArg a -> ist.ltacvars, TacArg (intern_tacarg true ist a)
 
 and intern_tactic_fun ist (var,body) = 
@@ -811,13 +800,14 @@ and intern_tacarg strict ist = function
   | MetaIdArg (loc,s) ->
       (* $id can occur in Grammar tactic... *)
       let id = id_of_string s in
-      if find_ltacvar id ist or Options.do_translate()
-      then Reference (ArgVar (adjust_loc loc,strip_meta id))
+      if find_ltacvar id ist then Reference (ArgVar (adjust_loc loc,id))
       else error_syntactic_metavariables_not_allowed loc
   | TacCall (loc,f,l) ->
       TacCall (loc,
         intern_tactic_reference ist f,
         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
   | Tacexp t -> Tacexp (intern_tactic ist t)
   | TacDynamic(loc,t) as x ->
@@ -858,7 +848,7 @@ and intern_genarg ist x =
   | IdentArgType ->
       let lf = ref ([],[]) in
       in_gen globwit_ident(intern_ident lf ist (out_gen rawwit_ident x))
-  | HypArgType ->
+  | VarArgType ->
       in_gen globwit_var (intern_hyp ist (out_gen rawwit_var x))
   | RefArgType ->
       in_gen globwit_ref (intern_global_reference ist (out_gen rawwit_ref x))
@@ -874,14 +864,12 @@ and intern_genarg ist x =
         (intern_quantified_hypothesis ist (out_gen rawwit_quant_hyp x))
   | RedExprArgType ->
       in_gen globwit_red_expr (intern_redexp ist (out_gen rawwit_red_expr x))
-  | TacticArgType ->
-      in_gen globwit_tactic (intern_tactic ist (out_gen rawwit_tactic x))
-  | OpenConstrArgType ->
-      in_gen globwit_open_constr
-      ((),intern_constr ist (snd (out_gen rawwit_open_constr x)))
-  | CastedOpenConstrArgType ->
-      in_gen globwit_casted_open_constr 
-        ((),intern_constr ist (snd (out_gen rawwit_casted_open_constr x)))
+  | TacticArgType n ->
+      in_gen (globwit_tactic n) (intern_tactic ist
+	(out_gen (rawwit_tactic n) x))
+  | OpenConstrArgType b ->
+      in_gen (globwit_open_constr_gen b)
+        ((),intern_constr ist (snd (out_gen (rawwit_open_constr_gen b) x)))
   | ConstrWithBindingsArgType ->
       in_gen globwit_constr_with_bindings
         (intern_constr_with_bindings ist (out_gen rawwit_constr_with_bindings x))
@@ -952,21 +940,12 @@ let rec read_match_rule evc env lfun = function
   | [] -> []
 
 (* For Match Context and Match *)
-exception No_match
 exception Not_coherent_metas
-exception Eval_fail of string
-
-let is_failure = function
-  | FailError _ | Stdpp.Exc_located (_,FailError _) -> true
-  | _ -> false
+exception Eval_fail of std_ppcmds
 
 let is_match_catchable = function
-  | No_match | Eval_fail _ -> true
-  | e -> is_failure e or Logic.catchable_exception e
-
-let hack_fail_level_shift = ref 0
-let hack_fail_level n =
-  if n >= !hack_fail_level_shift then n - !hack_fail_level_shift else 0
+  | PatternMatchingFailure | Eval_fail _ -> true
+  | e -> Logic.catchable_exception e
 
 (* Verifies if the matched list is coherent with respect to lcm *)
 let rec verify_metas_coherence gl lcm = function
@@ -977,17 +956,9 @@ let rec verify_metas_coherence gl lcm = function
       raise Not_coherent_metas
   | [] -> []
 
-(* Tries to match a pattern and a constr *)
-let apply_matching pat csr =
-  try
-    (matches pat csr)
-  with
-     PatternMatchingFailure -> raise No_match
-
 (* Tries to match one hypothesis pattern with a list of hypotheses *)
 let apply_one_mhyp_context ist env gl lmatch (hypname,pat) (lhyps,nocc) =
   let get_id_couple id = function
-(*    | Name idpat -> [idpat,VIdentifier id]*)
     | Name idpat -> [idpat,VConstr (mkVar id)]
     | Anonymous -> [] in
   let rec apply_one_mhyp_context_rec nocc = function
@@ -1002,18 +973,18 @@ let apply_one_mhyp_context ist env gl lmatch (hypname,pat) (lhyps,nocc) =
             apply_one_mhyp_context_rec 0 tl)
       | Subterm (ic,t) ->
         (try
-          let (lm,ctxt) = sub_match nocc t hyp in
+          let (lm,ctxt) = match_subterm nocc t hyp in
           let lmeta = verify_metas_coherence gl lmatch lm in
           ((get_id_couple id hypname)@(give_context ctxt ic),
 	   lmeta,(id,hyp),(hyps,nocc + 1))
          with
-         | NextOccurrence _ ->
+         | PatternMatchingFailure ->
              apply_one_mhyp_context_rec 0 tl
          | Not_coherent_metas ->
              apply_one_mhyp_context_rec (nocc + 1) hyps))
     | [] ->
         db_hyp_pattern_failure ist.debug env (hypname,pat);
-        raise No_match
+        raise PatternMatchingFailure
       in
   apply_one_mhyp_context_rec nocc lhyps
 
@@ -1022,7 +993,7 @@ let constr_to_id loc = function
   | _ -> invalid_arg_loc (loc, "Not an identifier")
 
 let constr_to_qid loc c =
-  try shortest_qualid_of_global Idset.empty (reference_of_constr c)
+  try shortest_qualid_of_global Idset.empty (global_of_constr c)
   with _ -> invalid_arg_loc (loc, "Not a global reference")
 
 (* Debug reference *)
@@ -1038,7 +1009,7 @@ let get_debug () = !debug
 let interp_ident ist id =
   try match List.assoc id ist.lfun with
   | VIntroPattern (IntroIdentifier id) -> id
-  | VConstr c as v when isVar c ->
+  | VConstr c when isVar c ->
       (* This happends e.g. in definitions like "Tac H = Clear H; Intro H" *)
       (* c is then expected not to belong to the proof context *)
       (* would be checkable if env were known from interp_ident *)
@@ -1047,10 +1018,17 @@ let interp_ident ist id =
          str ") should have been bound to an identifier")
   with Not_found -> id
 
+let interp_hint_base ist s =
+  try match List.assoc (id_of_string s) ist.lfun with
+  | VIntroPattern (IntroIdentifier id) -> string_of_id id
+  | _ -> user_err_loc(loc,"", str "An ltac name (" ++ str s ++
+         str ") should have been bound to a hint base name")
+  with Not_found -> s
+
 let interp_intro_pattern_var ist id =
   try match List.assoc id ist.lfun with
   | VIntroPattern ipat -> ipat
-  | VConstr c as v when isVar c ->
+  | VConstr c when isVar c ->
       (* This happends e.g. in definitions like "Tac H = Clear H; Intro H" *)
       (* c is then expected not to belong to the proof context *)
       (* would be checkable if env were known from interp_ident *)
@@ -1078,7 +1056,7 @@ let is_variable env id =
   List.mem id (ids_of_named_context (Environ.named_context env))
 
 let variable_of_value env = function
-  | VConstr c as v when isVar c -> destVar c
+  | VConstr c when isVar c -> destVar c
   | VIntroPattern (IntroIdentifier id) when is_variable env id -> id
   | _ -> raise Not_found
 
@@ -1088,8 +1066,8 @@ let id_of_Identifier = variable_of_value
 (* Extract a constr from a value, if any *)
 let constr_of_VConstr = constr_of_value
 
-(* Interprets an variable *)
-let interp_var ist gl (loc,id) =
+(* Interprets a bound variable (especially an existing hypothesis) *)
+let interp_hyp ist gl (loc,id) =
   (* Look first in lfun for a value coercible to a variable *)
   try 
     let v = List.assoc id ist.lfun in
@@ -1104,9 +1082,6 @@ let interp_var ist gl (loc,id) =
   else
     user_err_loc (loc,"eval_variable",pr_id id ++ str " not found")
 
-(* Interprets an existing hypothesis (i.e. a declared variable) *)
-let interp_hyp = interp_var
-
 let interp_name ist = function
   | Anonymous -> Anonymous
   | Name id -> Name (interp_ident ist id)
@@ -1124,13 +1099,13 @@ let interp_clause_pattern ist gl (l,occl) =
 (* Interprets a qualified name *)
 let interp_reference ist env = function
   | ArgArg (_,r) -> r
-  | ArgVar (loc,id) -> coerce_to_reference env (unrec (List.assoc id ist.lfun))
+  | ArgVar (loc,id) -> coerce_to_reference env (List.assoc id ist.lfun)
 
 let pf_interp_reference ist gl = interp_reference ist (pf_env gl)
 
 let interp_inductive ist = function
   | ArgArg r -> r
-  | ArgVar (_,id) -> coerce_to_inductive (unrec (List.assoc id ist.lfun))
+  | ArgVar (_,id) -> coerce_to_inductive (List.assoc id ist.lfun)
 
 let interp_evaluable ist env = function
   | ArgArg (r,Some (loc,id)) ->
@@ -1143,8 +1118,7 @@ let interp_evaluable ist env = function
 	  | EvalConstRef _ -> r
 	  | _ -> Pretype_errors.error_var_not_found_loc loc id)
   | ArgArg (r,None) -> r
-  | ArgVar (_,id) -> 
-      coerce_to_evaluable_ref env (unrec (List.assoc id ist.lfun))
+  | ArgVar (_,id) -> coerce_to_evaluable_ref env (List.assoc id ist.lfun)
 
 (* Interprets an hypothesis name *)
 let interp_hyp_location ist gl (id,occs,hl) = (interp_hyp ist gl id,occs,hl)
@@ -1175,61 +1149,110 @@ let rec intropattern_ids = function
   | IntroIdentifier id -> [id]
   | IntroOrAndPattern ll -> 
       List.flatten (List.map intropattern_ids (List.flatten ll))
-  | IntroWildcard -> []
+  | IntroWildcard | IntroAnonymous -> []
 
 let rec extract_ids = function
   | (id,VIntroPattern ipat)::tl -> intropattern_ids ipat @ extract_ids tl
   | _::tl -> extract_ids tl
   | [] -> []
 
+(* To retype a list of key*constr with undefined key *)
 let retype_list sigma env lst =
   List.fold_right (fun (x,csr) a ->
     try (x,Retyping.get_judgment_of env sigma csr)::a with
     | Anomaly _ -> a) lst []
 
-let interp_casted_constr ocl ist sigma env (c,ce) =
-  let (l1,l2) = constr_list ist env in
-  let tl1 = retype_list sigma env l1 in
-  let csr = 
-    match ce with
-    | None ->
-	Pretyping.understand_gen_ltac sigma env (tl1,l2) ocl c
-      (* If at toplevel (ce<>None), the error can be due to an incorrect
-         context at globalization time: we retype with the now known
-         intros/lettac/inversion hypothesis names *)
-    | Some c -> interp_constr_gen sigma env (l1,l2) c ocl
-  in
-  db_constr ist.debug env csr;
-  csr
+(*  List.map (fun (x,csr) -> (x,Retyping.get_judgment_of env sigma csr)) lst*)
 
-let interp_constr ist sigma env c =
-  interp_casted_constr None ist sigma env c
+let implicit_tactic = ref None
+
+let declare_implicit_tactic tac = implicit_tactic := Some tac
+
+open Evd
+
+let solvable_by_tactic env evi (ev,args) src = 
+  match (!implicit_tactic, src) with
+  | Some tac, (ImplicitArg _ | QuestionMark)
+      when 
+	Environ.named_context_of_val evi.evar_hyps = 
+	Environ.named_context env ->
+      let id = id_of_string "H" in
+      start_proof id (Local,Proof Lemma) evi.evar_hyps evi.evar_concl
+	(fun _ _ -> ());
+      begin
+	try
+	  by (tclCOMPLETE tac);
+	  let _,(const,_,_) = cook_proof () in 
+	  delete_current_proof (); const.const_entry_body
+	with e when Logic.catchable_exception e -> 
+	  delete_current_proof();
+	  raise Exit
+      end
+  | _ -> raise Exit
+
+let solve_remaining_evars env initial_sigma evars c =
+  let isevars = ref evars in
+  let rec proc_rec c =
+    match kind_of_term (Reductionops.whd_evar (evars_of !isevars) c) with
+      | Evar (ev,args as k) when not (Evd.in_dom initial_sigma ev) ->
+            let (loc,src) = evar_source ev !isevars in
+	    let sigma = evars_of !isevars in
+	    (try 
+	      let evi = Evd.map sigma ev in
+	      let c = solvable_by_tactic env evi k src in
+	      isevars := Evd.evar_define ev c !isevars;
+	      c
+	    with Exit ->
+	      Pretype_errors.error_unsolvable_implicit loc env sigma src)
+      | _ -> map_constr proc_rec c      
+  in
+  map_constr proc_rec c
 
-(* Interprets an open constr expression casted by the current goal *)
-let pf_interp_openconstr_gen casted ist gl (c,ce) =
-  let sigma = project gl in
-  let env = pf_env gl in
-  let (ltacvars,l) = constr_list ist env in
+let interp_gen kind ist sigma env (c,ce) =
+  let (ltacvars,unbndltacvars) = constr_list ist env in
   let typs = retype_list sigma env ltacvars in
-  let ocl = if casted then Some (pf_concl gl) else None in
-  match ce with
-  | None ->
-      Pretyping.understand_gen_tcc sigma env typs ocl c
+  let c = match ce with
+  | None -> c
     (* If at toplevel (ce<>None), the error can be due to an incorrect
        context at globalization time: we retype with the now known
        intros/lettac/inversion hypothesis names *)
-  | Some c -> interp_openconstr_gen sigma env (ltacvars,l) c ocl
+  | Some c ->
+      let ltacdata = (List.map fst ltacvars,unbndltacvars) in
+      intern_gen (kind = IsType) ~ltacvars:ltacdata sigma env c in
+  understand_ltac sigma env (typs,unbndltacvars) kind c
+
+(* Interprets a constr and solve remaining evars with default tactic *)
+let interp_econstr kind ist sigma env cc =
+  let evars,c = interp_gen kind ist sigma env cc in
+  let csr = solve_remaining_evars env sigma evars c in
+  db_constr ist.debug env csr;
+  csr
+
+(* Interprets an open constr *)
+let interp_open_constr ccl ist sigma env cc =
+  let isevars,c = interp_gen (OfType ccl) ist sigma env cc in
+  (evars_of isevars,c)
+
+let interp_constr = interp_econstr (OfType None)
+
+let interp_type = interp_econstr IsType
+
+(* Interprets a constr expression casted by the current goal *)
+let pf_interp_casted_constr ist gl cc =
+  interp_econstr (OfType (Some (pf_concl gl))) ist (project gl) (pf_env gl) cc
 
-let pf_interp_casted_openconstr = pf_interp_openconstr_gen true
-let pf_interp_openconstr = pf_interp_openconstr_gen false
+(* Interprets an open constr expression *)
+let pf_interp_open_constr casted ist gl cc =
+  let cl = if casted then Some (pf_concl gl) else None in
+  interp_open_constr cl ist (project gl) (pf_env gl) cc
 
 (* Interprets a constr expression *)
 let pf_interp_constr ist gl =
   interp_constr ist (project gl) (pf_env gl)
 
-(* Interprets a constr expression casted by the current goal *)
-let pf_interp_casted_constr ist gl c =
-  interp_casted_constr (Some(pf_concl gl)) ist (project gl) (pf_env gl) c
+(* 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) =
@@ -1249,14 +1272,14 @@ let redexp_interp ist sigma env = function
   | Lazy f -> Lazy (interp_flag ist env f)
   | Pattern l -> Pattern (List.map (interp_pattern ist sigma env) l)
   | Simpl o -> Simpl (option_app (interp_pattern ist sigma env) o)
-  | (Red _ | Hnf | ExtraRedExpr _ as r) -> r
+  | (Red _ |  Hnf | ExtraRedExpr _ | CbvVm as r) -> r
 
 let pf_redexp_interp ist gl = redexp_interp ist (project gl) (pf_env gl)
 
 let interp_may_eval f ist gl = function
   | ConstrEval (r,c) ->
       let redexp = pf_redexp_interp ist gl  r in
-      pf_reduction_of_redexp gl redexp (f ist gl c)
+      pf_reduction_of_red_expr gl redexp (f ist gl c)
   | ConstrContext ((loc,s),c) ->
       (try
 	let ic = f ist gl c
@@ -1277,10 +1300,31 @@ let interp_constr_may_eval ist gl c =
     csr
   end
 
+let message_of_value = function
+  | VVoid -> str "()"
+  | VInteger n -> int n
+  | VIntroPattern ipat -> pr_intro_pattern ipat
+  | VConstr_context c | VConstr c -> pr_constr c
+  | VRec _ | VTactic _ | VRTactic _ | VFun _ -> str "<tactic>"
+
+let rec interp_message ist = function
+  | [] -> mt()
+  | MsgString s :: l -> pr_arg str s ++ interp_message ist l
+  | MsgInt n :: l -> pr_arg int n ++ interp_message ist l
+  | MsgIdent (_,id) :: l ->
+      let v =
+	try List.assoc id ist.lfun
+	with Not_found -> user_err_loc (loc,"",pr_id id ++ str " not found") in
+      pr_arg message_of_value v ++ interp_message ist l
+
+let rec interp_message_nl ist = function
+  | [] -> mt()
+  | l -> interp_message ist l ++ fnl()
+
 let rec interp_intro_pattern ist = function
   | IntroOrAndPattern l -> IntroOrAndPattern (interp_case_intro_pattern ist l)
-  | IntroWildcard -> IntroWildcard
   | IntroIdentifier id -> interp_intro_pattern_var ist id
+  | IntroWildcard | IntroAnonymous as x -> x
 
 and interp_case_intro_pattern ist =
   List.map (List.map (interp_intro_pattern ist))
@@ -1335,8 +1379,8 @@ let rec val_interp ist gl (tac:glob_tactic_expr) =
   | TacLetIn (l,u) ->
       let addlfun = interp_letin ist gl l in
       val_interp { ist with lfun=addlfun@ist.lfun } gl u
-  | TacMatchContext (lr,lmr) -> interp_match_context ist gl lr lmr 
-  | TacMatch (c,lmr) -> interp_match ist gl c lmr
+  | TacMatchContext (lz,lr,lmr) -> interp_match_context ist gl lz lr lmr 
+  | TacMatch (lz,c,lmr) -> interp_match ist gl lz c lmr
   | TacArg a -> interp_tacarg ist gl a
   (* Delayed evaluation *)
   | t -> VTactic (dummy_loc,eval_tactic ist t)
@@ -1349,13 +1393,10 @@ let rec val_interp ist gl (tac:glob_tactic_expr) =
 
 and eval_tactic ist = function
   | TacAtom (loc,t) -> fun gl -> catch_error loc (interp_atomic ist gl t) gl
-  | TacFun (it,body) -> assert false
-  | TacLetRecIn (lrc,u) -> assert false
-  | TacLetIn (l,u) -> assert false
-  | TacMatchContext _ -> assert false
-  | TacMatch (c,lmr) -> assert false
-  | TacId s -> tclIDTAC_MESSAGE s
-  | TacFail (n,s) -> tclFAIL (hack_fail_level (interp_int_or_var ist n)) s
+  | TacFun _ | TacLetRecIn _ | TacLetIn _ -> assert false
+  | TacMatchContext _ | TacMatch _ -> assert false
+  | TacId s -> tclIDTAC_MESSAGE (interp_message_nl ist s)
+  | TacFail (n,s) -> tclFAIL (interp_int_or_var ist n) (interp_message ist s)
   | TacProgress tac -> tclPROGRESS (interp_tactic ist tac)
   | TacAbstract (tac,s) -> Tactics.tclABSTRACT s (interp_tactic ist tac)
   | TacThen (t1,t2) -> tclTHEN (interp_tactic ist t1) (interp_tactic ist t2)
@@ -1369,26 +1410,32 @@ and eval_tactic ist = function
         tclORELSE (interp_tactic ist tac1) (interp_tactic ist tac2)
   | TacFirst l -> tclFIRST (List.map (interp_tactic ist) l)
   | TacSolve l -> tclSOLVE (List.map (interp_tactic ist) l)
+  | TacComplete tac -> tclCOMPLETE (interp_tactic ist tac)
   | TacArg a -> assert false
 
-and interp_ltac_reference isapplied ist gl = function
-  | ArgVar (loc,id) -> unrec (List.assoc id ist.lfun)
+and interp_ltac_reference isapplied mustbetac ist gl = function
+  | ArgVar (loc,id) ->
+      let v = List.assoc id ist.lfun in
+      if mustbetac then coerce_to_tactic loc id v else v
   | ArgArg (loc,r) ->
       let v = val_interp {lfun=[];debug=ist.debug} gl (lookup r) in
       if isapplied then v else locate_tactic_call loc v
 
 and interp_tacarg ist gl = function
   | TacVoid -> VVoid
-  | Reference r -> interp_ltac_reference false ist gl r
+  | Reference r -> interp_ltac_reference false false ist gl r
   | Integer n -> VInteger n
   | IntroPattern ipat -> VIntroPattern ipat
   | ConstrMayEval c -> VConstr (interp_constr_may_eval ist gl c)
   | MetaIdArg (loc,id) -> assert false
+  | TacCall (loc,r,[]) -> interp_ltac_reference false true ist gl r
   | TacCall (loc,f,l) ->
-      let fv = interp_ltac_reference true ist gl f
+      let fv = interp_ltac_reference true true ist gl f
       and largs = List.map (interp_tacarg ist gl) l in
       List.iter check_is_value largs;
       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
@@ -1406,7 +1453,7 @@ and interp_tacarg ist gl = function
       else if tg = "value" then
         value_out t
       else if tg = "constr" then
-        VConstr (Pretyping.constr_out t)
+        VConstr (constr_out t)
       else
         anomaly_loc (loc, "Tacinterp.val_interp",
           (str "Unknown dynamic: <" ++ str (Dyn.tag t) ++ str ">"))
@@ -1435,10 +1482,10 @@ and tactic_of_value vle g =
   | _ -> raise NotTactic
 
 (* Evaluation with FailError catching *)
-and eval_with_fail ist tac goal =
+and eval_with_fail ist is_lazy goal tac =
   try
     (match val_interp ist goal tac with
-    | VTactic (loc,tac) -> VRTactic (catch_error loc tac goal)
+    | VTactic (loc,tac) when not is_lazy -> VRTactic (catch_error loc tac goal)
     | a -> a)
   with
     | Stdpp.Exc_located (_,FailError (0,s)) | FailError (0,s) ->
@@ -1478,8 +1525,8 @@ and interp_letin ist gl = function
       with Not_found ->
       try
 	let t = tactic_of_value v in
-	let ndc = Environ.named_context env in
-	start_proof id IsLocal ndc typ (fun _ _ -> ());
+	let ndc = Environ.named_context_val env in
+	start_proof id (Local,Proof Lemma) ndc typ (fun _ _ -> ());
 	by t;
 	let (_,({const_entry_body = pft},_,_)) = cook_proof () in
 	delete_proof (dummy_loc,id);
@@ -1488,23 +1535,15 @@ and interp_letin ist gl = function
 	delete_proof (dummy_loc,id);
 	errorlabstrm "Tacinterp.interp_letin"
           (str "Term or fully applied tactic expected in Let")
-    in (id,VConstr (mkCast (csr,typ)))::(interp_letin ist gl tl)
+    in (id,VConstr (mkCast (csr,DEFAULTcast, typ)))::(interp_letin ist gl tl)
 
 (* Interprets the Match Context expressions *)
-and interp_match_context ist g lr lmr =
+and interp_match_context ist g lz lr lmr =
   let rec apply_goal_sub ist env goal nocc (id,c) csr mt mhyps hyps =
-    try
-      let (lgoal,ctxt) = sub_match nocc c csr in
-      let lctxt = give_context ctxt id in
-      if mhyps = [] then
-	let lgoal = List.map (fun (id,c) -> (id,VConstr c)) lgoal in
-        eval_with_fail { ist with lfun=lgoal@lctxt@ist.lfun } mt goal
-      else
-        apply_hyps_context ist env goal mt lctxt lgoal mhyps hyps
-    with
-    | e when is_failure e -> raise e
-    | NextOccurrence _ -> raise No_match
-    | e when is_match_catchable e ->
+    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
   let rec apply_match_context ist env goal nrs lex lpt = 
     begin
@@ -1513,11 +1552,9 @@ and interp_match_context ist g lr lmr =
     | (All t)::tl ->
       begin
         db_mc_pattern_success ist.debug;
-        try eval_with_fail ist t goal
-         with
-         | e when is_failure e -> raise e
-         | e when is_match_catchable e ->
-           apply_match_context ist env goal (nrs+1) (List.tl lex) tl
+        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
@@ -1527,33 +1564,19 @@ and interp_match_context ist g lr lmr =
       (match mgoal with
       |	Term mg ->
         (try
-           (let lgoal = apply_matching mg concl in
-            begin
-            db_matched_concl ist.debug (pf_env goal) concl;
-            if mhyps = [] then
-            begin
-              db_mc_pattern_success ist.debug;
-	      let lgoal = List.map (fun (id,c) -> (id,VConstr c)) lgoal in
-              eval_with_fail {ist with lfun=lgoal@ist.lfun} mt goal
-            end
-            else
-              apply_hyps_context ist env goal mt [] lgoal mhyps hyps
-            end)
-        with 
-        | e when is_failure e -> raise e
-        | e when is_match_catchable e ->
-          begin 
-            (match e with
-            | No_match -> db_matching_failure ist.debug
+           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
-          end)
+          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 
-         | e when is_failure e -> raise e
-         | e when is_match_catchable e ->
+        with
+        | PatternMatchingFailure ->
            apply_match_context ist env goal (nrs+1) (List.tl lex) tl))
     | _ ->
       errorlabstrm "Tacinterp.apply_match_context"
@@ -1567,7 +1590,7 @@ and interp_match_context ist g lr lmr =
     (read_match_rule (project g) env (fst (constr_list ist env)) lmr)
 
 (* Tries to match the hypotheses in a Match Context *)
-and apply_hyps_context ist env goal mt lctxt lgmatch mhyps hyps =
+and apply_hyps_context ist env lz goal mt lctxt lgmatch mhyps hyps =
   let rec apply_hyps_context_rec lfun lmatch lhyps_rest current = function
     | Hyp ((_,hypname),mhyp)::tl as mhyps ->
         let (lids,lm,hyp_match,next) =
@@ -1578,18 +1601,21 @@ and apply_hyps_context ist env goal mt lctxt lgmatch mhyps hyps =
             let nextlhyps = list_except hyp_match lhyps_rest in
             apply_hyps_context_rec (lfun@lids) (lmatch@lm) nextlhyps
 	      (nextlhyps,0) tl
-          with
-          | e when is_failure e -> raise e
-	  | e when is_match_catchable e -> 
+          with e when is_match_catchable e -> 
 	      apply_hyps_context_rec lfun lmatch lhyps_rest next mhyps
         end
     | [] ->
 	let lmatch = List.map (fun (id,c) -> (id,VConstr c)) lmatch in
         db_mc_pattern_success ist.debug;
-        eval_with_fail {ist with lfun=lmatch@lfun@ist.lfun} mt goal
+        eval_with_fail {ist with lfun=lmatch@lfun@ist.lfun} lz goal mt
   in
   apply_hyps_context_rec lctxt lgmatch hyps (hyps,0) mhyps
 
+and interp_external loc ist gl com req la =
+  let f ch = extern_request ch req gl la in
+  let g ch = internalise_tacarg ch in
+  interp_tacarg ist gl (System.connect f g com)
+
   (* Interprets extended tactic generic arguments *)
 and interp_genarg ist goal x =
   match genarg_tag x with
@@ -1607,8 +1633,8 @@ and interp_genarg ist goal x =
         (interp_intro_pattern ist (out_gen globwit_intro_pattern x))
   | IdentArgType ->
       in_gen wit_ident (interp_ident ist (out_gen globwit_ident x))
-  | HypArgType ->
-      in_gen wit_var (mkVar (interp_hyp ist goal (out_gen globwit_var x)))
+  | VarArgType ->
+      in_gen wit_var (interp_hyp ist goal (out_gen globwit_var x))
   | RefArgType ->
       in_gen wit_ref (pf_interp_reference ist goal (out_gen globwit_ref x))
   | SortArgType ->
@@ -1626,13 +1652,11 @@ and interp_genarg ist goal x =
           (out_gen globwit_quant_hyp x))
   | RedExprArgType ->
       in_gen wit_red_expr (pf_redexp_interp ist goal (out_gen globwit_red_expr x))
-  | TacticArgType -> in_gen wit_tactic (out_gen globwit_tactic x)
-  | OpenConstrArgType ->
-      in_gen wit_open_constr 
-        (pf_interp_openconstr ist goal (snd (out_gen globwit_open_constr x)))
-  | CastedOpenConstrArgType ->
-      in_gen wit_casted_open_constr 
-        (pf_interp_casted_openconstr ist goal (snd (out_gen globwit_casted_open_constr x)))
+  | TacticArgType n -> in_gen (wit_tactic n) (out_gen (globwit_tactic n) x)
+  | OpenConstrArgType casted ->
+      in_gen (wit_open_constr_gen casted) 
+        (pf_interp_open_constr casted ist goal 
+          (snd (out_gen (globwit_open_constr_gen casted) x)))
   | ConstrWithBindingsArgType ->
       in_gen wit_constr_with_bindings
         (interp_constr_with_bindings ist goal (out_gen globwit_constr_with_bindings x))
@@ -1646,33 +1670,28 @@ and interp_genarg ist goal x =
   | ExtraArgType s -> lookup_interp_genarg s ist goal x
 
 (* Interprets the Match expressions *)
-and interp_match ist g constr lmr =
-  let rec apply_sub_match ist nocc (id,c) csr mt =
-    try 
-      let (lm,ctxt) = sub_match nocc c csr in
-      let lctxt = give_context ctxt id in
-      let lm = List.map (fun (id,c) -> (id,VConstr c)) lm in
-      val_interp {ist with lfun=lm@lctxt@ist.lfun} g mt
-    with | NextOccurrence _ -> raise No_match
-         | e when is_match_catchable e -> 
-             apply_sub_match ist (nocc + 1) (id,c) csr mt
+and interp_match ist g lz constr lmr =
+  let rec apply_match_subterm ist nocc (id,c) csr mt =
+    let (lm,ctxt) = match_subterm nocc c csr in
+    let lctxt = give_context ctxt id in
+    let lm = List.map (fun (id,c) -> (id,VConstr c)) lm in
+    try eval_with_fail {ist with lfun=lm@lctxt@ist.lfun} lz g mt
+    with e when is_match_catchable e ->
+      apply_match_subterm ist (nocc + 1) (id,c) csr mt
   in
   let rec apply_match ist csr = function
     | (All t)::_ ->
-        (try val_interp ist g t
+        (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 = apply_matching c csr in
+	  let lm = matches c csr in
 	  let lm = List.map (fun (id,c) -> (id,VConstr c)) lm in
-          val_interp
-            { ist with lfun=lm@ist.lfun } g mt
+          eval_with_fail { ist with lfun=lm@ist.lfun } lz g mt
          with e when is_match_catchable e -> apply_match ist csr tl)
     | (Pat ([],Subterm (id,c),mt))::tl ->
-        (try
-          apply_sub_match ist 0 (id,c) csr mt
-         with | No_match ->
-	   apply_match ist csr 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
@@ -1683,14 +1702,7 @@ and interp_match ist g constr lmr =
       errorlabstrm "Tacinterp.apply_match" 
         (str "Argument of match does not evaluate to a term") in
   let ilr = read_match_rule (project g) env (fst (constr_list ist env)) lmr in
-  try
-    incr hack_fail_level_shift;
-    let x = apply_match ist csr ilr in
-    decr hack_fail_level_shift;
-    x
-  with e ->
-    decr hack_fail_level_shift;
-    raise e
+  apply_match ist csr ilr
 
 (* Interprets tactic expressions : returns a "tactic" *)
 and interp_tactic ist tac gl =
@@ -1711,37 +1723,48 @@ and interp_atomic ist gl = function
       (option_app (interp_hyp ist gl) ido')
   | TacAssumption -> h_assumption
   | TacExact c -> h_exact (pf_interp_casted_constr ist gl c)
+  | TacExactNoCheck c -> h_exact_no_check (pf_interp_constr ist gl c)
   | TacApply cb -> h_apply (interp_constr_with_bindings ist gl cb)
   | TacElim (cb,cbo) ->
       h_elim (interp_constr_with_bindings ist gl cb)
                 (option_app (interp_constr_with_bindings ist gl) cbo)
-  | TacElimType c -> h_elim_type (pf_interp_constr ist gl c)
+  | TacElimType c -> h_elim_type (pf_interp_type ist gl c)
   | TacCase cb -> h_case (interp_constr_with_bindings ist gl cb)
-  | TacCaseType c -> h_case_type (pf_interp_constr ist gl c)
+  | TacCaseType c -> h_case_type (pf_interp_type ist gl c)
   | TacFix (idopt,n) -> h_fix (option_app (interp_ident ist) idopt) n
   | TacMutualFix (id,n,l) ->
-      let f (id,n,c) = (interp_ident ist id,n,pf_interp_constr ist gl c) in
+      let f (id,n,c) = (interp_ident ist id,n,pf_interp_type ist gl c) in
       h_mutual_fix (interp_ident ist id) n (List.map f l)
   | TacCofix idopt -> h_cofix (option_app (interp_ident ist) idopt)
   | TacMutualCofix (id,l) ->
-      let f (id,c) = (interp_ident ist id,pf_interp_constr ist gl c) in
+      let f (id,c) = (interp_ident ist id,pf_interp_type ist gl c) in
       h_mutual_cofix (interp_ident ist id) (List.map f l)
-  | TacCut c -> h_cut (pf_interp_constr ist gl c)
-  | TacTrueCut (na,c) ->
-      h_true_cut (interp_name ist na) (pf_interp_constr ist gl c)
-  | TacForward (b,na,c) ->
-      h_forward b (interp_name ist na) (pf_interp_constr ist gl c)
+  | TacCut c -> h_cut (pf_interp_type ist gl c)
+  | TacAssert (t,ipat,c) ->
+      let c = (if t=None then pf_interp_constr else pf_interp_type) ist gl c in
+      abstract_tactic (TacAssert (t,ipat,c))
+        (Tactics.forward (option_app (interp_tactic ist) t)
+	  (interp_intro_pattern ist ipat) c)
   | TacGeneralize cl -> h_generalize (List.map (pf_interp_constr 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
       h_let_tac (interp_name ist na) (pf_interp_constr ist gl c) clp
-  | TacInstantiate (n,c,ido) -> h_instantiate n (pf_interp_constr ist gl c)
-      (clause_app (interp_hyp_location ist gl) ido)
-
+(* | TacInstantiate (n,c,idh) -> h_instantiate n (fst c) 
+      (* pf_interp_constr ist gl c *)
+      (match idh with
+	   ConclLocation () -> ConclLocation ()
+	 | HypLocation (id,hloc) -> 
+	     HypLocation(interp_hyp ist gl id,hloc))
+*)
   (* Automation tactics *)
-  | TacTrivial l -> Auto.h_trivial l
-  | TacAuto (n, l) -> Auto.h_auto (option_app (interp_int_or_var ist) n) l
+  | TacTrivial (lems,l) -> 
+      Auto.h_trivial (List.map (pf_interp_constr ist gl) lems)
+	(option_app (List.map (interp_hint_base ist)) l)
+  | TacAuto (n,lems,l) ->
+      Auto.h_auto (option_app (interp_int_or_var ist) n)
+      (List.map (pf_interp_constr ist gl) lems)
+      (option_app (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)
   | TacDestructConcl -> Dhyp.h_destructConcl
@@ -1749,21 +1772,18 @@ and interp_atomic ist gl = function
   | TacDAuto (n,p) -> Auto.h_dauto (option_app (interp_int_or_var ist) n,p)
 
   (* Derived basic tactics *)
-  | TacSimpleInduction (h,ids) ->
-      let h =
-        if !Options.v7 then interp_declared_or_quantified_hypothesis ist gl h
-        else interp_quantified_hypothesis ist h in
-      h_simple_induction (h,ids)
-  | TacNewInduction (c,cbo,(ids,ids')) ->
-      h_new_induction (interp_induction_arg ist gl c)
+  | TacSimpleInduction h ->
+      h_simple_induction (interp_quantified_hypothesis ist h)
+  | TacNewInduction (lc,cbo,ids) ->
+      h_new_induction (List.map (interp_induction_arg ist gl) lc)
         (option_app (interp_constr_with_bindings ist gl) cbo)
-        (option_app (interp_intro_pattern ist) ids,ids')
+        (interp_intro_pattern ist ids)
   | TacSimpleDestruct h ->
       h_simple_destruct (interp_quantified_hypothesis ist h)
-  | TacNewDestruct (c,cbo,(ids,ids')) -> 
-      h_new_destruct (interp_induction_arg ist gl c)
+  | TacNewDestruct (c,cbo,ids) -> 
+      h_new_destruct (List.map (interp_induction_arg ist gl) c)
         (option_app (interp_constr_with_bindings ist gl) cbo)
-        (option_app (interp_intro_pattern ist) ids,ids')
+        (interp_intro_pattern ist ids)
   | TacDoubleInduction (h1,h2) ->
       let h1 = interp_quantified_hypothesis ist h1 in
       let h2 = interp_quantified_hypothesis ist h2 in
@@ -1778,7 +1798,7 @@ and interp_atomic ist gl = function
   | TacLApply c -> h_lapply (pf_interp_constr ist gl c)
 
   (* Context management *)
-  | TacClear l -> h_clear (List.map (interp_hyp ist gl) l)
+  | 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)
   | TacMove (dep,id1,id2) ->
       h_move dep (interp_hyp ist gl id1) (interp_hyp ist gl id2)
@@ -1810,11 +1830,11 @@ and interp_atomic ist gl = function
   (* Equality and inversion *)
   | TacInversion (DepInversion (k,c,ids),hyp) ->
       Inv.dinv k (option_app (pf_interp_constr ist gl) c)
-        (option_app (interp_intro_pattern ist) ids)
+        (interp_intro_pattern ist ids)
         (interp_declared_or_quantified_hypothesis ist gl hyp)
   | TacInversion (NonDepInversion (k,idl,ids),hyp) ->
       Inv.inv_clause k 
-        (option_app (interp_intro_pattern ist) ids)
+        (interp_intro_pattern ist ids)
         (List.map (interp_hyp ist gl) idl)
         (interp_declared_or_quantified_hypothesis ist gl hyp)
   | TacInversion (InversionUsing (c,idl),hyp) ->
@@ -1836,29 +1856,31 @@ and interp_atomic ist gl = function
 	VIntroPattern (out_gen globwit_intro_pattern x)
     | IdentArgType -> 
         VIntroPattern (IntroIdentifier (out_gen globwit_ident x))
-    | HypArgType ->
-	VConstr (mkVar (interp_var ist gl (out_gen globwit_var x)))
+    | VarArgType ->
+	VConstr (mkVar (interp_hyp ist gl (out_gen globwit_var x)))
     | RefArgType -> 
-        VConstr (constr_of_reference 
+        VConstr (constr_of_global 
           (pf_interp_reference ist gl (out_gen globwit_ref x)))
     | SortArgType ->
-	VConstr (mkSort (Pretyping.interp_sort (out_gen globwit_sort x)))
+	VConstr (mkSort (interp_sort (out_gen globwit_sort x)))
     | ConstrArgType ->
         VConstr (pf_interp_constr ist gl (out_gen globwit_constr x))
     | ConstrMayEvalArgType ->
 	VConstr
           (interp_constr_may_eval ist gl (out_gen globwit_constr_may_eval x))
-    | TacticArgType -> 
-	val_interp ist gl (out_gen globwit_tactic x)
+    | TacticArgType n -> 
+	val_interp ist gl (out_gen (globwit_tactic n) x)
     | StringArgType | BoolArgType
-    | QuantHypArgType | RedExprArgType | OpenConstrArgType
-    | CastedOpenConstrArgType | ConstrWithBindingsArgType | BindingsArgType 
+    | QuantHypArgType | RedExprArgType 
+    | OpenConstrArgType _ | ConstrWithBindingsArgType | BindingsArgType 
     | ExtraArgType _ | List0ArgType _ | List1ArgType _ | OptArgType _ | PairArgType _ 
 	-> error "This generic type is not supported in alias"
     in
     let lfun = (List.map (fun (x,c) -> (x,f c)) l)@ist.lfun in
     let v = locate_tactic_call loc (val_interp { ist with lfun=lfun } gl body)
-    in tactic_of_value v gl
+    in 
+    try tactic_of_value v gl 
+    with NotTactic -> user_err_loc (loc,"",str "not a tactic")
 
 (* Initial call for interpretation *)
 let interp_tac_gen lfun debug t gl = 
@@ -1888,11 +1910,11 @@ let subst_quantified_hypothesis _ x = x
 
 let subst_declared_or_quantified_hypothesis _ x = x
 
-let subst_inductive subst (kn,i) = (subst_kn subst kn,i)
-
-let subst_rawconstr subst (c,e) =
+let subst_rawconstr_and_expr subst (c,e) =
   assert (e=None); (* e<>None only for toplevel tactics *)
-  (subst_raw subst c,None)
+  (Detyping.subst_rawconstr subst c,None)
+
+let subst_rawconstr = subst_rawconstr_and_expr (* shortening *)
 
 let subst_binding subst (loc,b,c) =
   (loc,subst_quantified_hypothesis subst b,subst_rawconstr subst c)
@@ -1910,10 +1932,6 @@ let subst_induction_arg subst = function
   | ElimOnAnonHyp n as x -> x
   | ElimOnIdent id as x -> x
 
-let subst_evaluable_reference subst = function
-  | EvalVarRef id -> EvalVarRef id
-  | EvalConstRef kn -> EvalConstRef (subst_kn subst kn)
-
 let subst_and_short_name f (c,n) =
   assert (n=None); (* since tacdef are strictly globalized *)
   (f c,None)
@@ -1927,11 +1945,23 @@ let subst_located f (_loc,id) = (loc,f id)
 let subst_reference subst = 
   subst_or_var (subst_located (subst_kn subst))
 
+(*CSC: subst_global_reference is used "only" for RefArgType, that propagates
+  to the syntactic non-terminals "global", used in commands such as
+  Print. It is also used for non-evaluable references. *) 
 let subst_global_reference subst = 
-  subst_or_var (subst_located (subst_global subst))
+ let subst_global ref =
+  let ref',t' = subst_global subst ref in
+   if not (eq_constr (constr_of_global ref') t') then
+    ppnl (str "Warning: the reference " ++ pr_global ref ++ str " is not " ++
+          str " expanded to \"" ++ pr_lconstr t' ++ str "\", but to " ++
+          pr_global ref') ;
+   ref'
+ in
+  subst_or_var (subst_located subst_global)
 
 let subst_evaluable subst =
-  subst_or_var (subst_and_short_name (subst_evaluable_reference subst))
+  let subst_eval_ref = subst_evaluable_reference subst in
+    subst_or_var (subst_and_short_name subst_eval_ref)
 
 let subst_unfold subst (l,e) = 
   (l,subst_evaluable subst e)
@@ -1948,7 +1978,7 @@ let subst_redexp subst = function
   | Lazy f -> Lazy (subst_flag subst f)
   | Pattern l -> Pattern (List.map (subst_constr_occurrence subst) l)
   | Simpl o -> Simpl (option_app (subst_constr_occurrence subst) o)
-  | (Red _ | Hnf | ExtraRedExpr _ as r) -> r
+  | (Red _ | Hnf | ExtraRedExpr _ | CbvVm as r) -> r
 
 let subst_raw_may_eval subst = function
   | ConstrEval (r,c) -> ConstrEval (subst_redexp subst r,subst_rawconstr subst c)
@@ -1971,6 +2001,7 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
   | TacIntroPattern _ | TacIntrosUntil _ | TacIntroMove _ as x -> x
   | TacAssumption as x -> x
   | TacExact c -> TacExact (subst_rawconstr subst c)
+  | TacExactNoCheck c -> TacExactNoCheck (subst_rawconstr subst c)
   | TacApply cb -> TacApply (subst_raw_with_bindings subst cb)
   | TacElim (cb,cbo) ->
       TacElim (subst_raw_with_bindings subst cb,
@@ -1985,16 +2016,15 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
   | TacMutualCofix (id,l) ->
       TacMutualCofix (id, List.map (fun (id,c) -> (id,subst_rawconstr subst c)) l)
   | TacCut c -> TacCut (subst_rawconstr subst c)
-  | TacTrueCut (ido,c) -> TacTrueCut (ido, subst_rawconstr subst c)
-  | TacForward (b,na,c) -> TacForward (b,na,subst_rawconstr subst c)
+  | TacAssert (b,na,c) -> TacAssert (b,na,subst_rawconstr subst c)
   | TacGeneralize cl -> TacGeneralize (List.map (subst_rawconstr subst) cl)
   | TacGeneralizeDep c -> TacGeneralizeDep (subst_rawconstr subst c)
   | TacLetTac (id,c,clp) -> TacLetTac (id,subst_rawconstr subst c,clp)
-  | TacInstantiate (n,c,ido) -> TacInstantiate (n,subst_rawconstr subst c,ido)
-
+(*| TacInstantiate (n,c,ido) -> TacInstantiate (n,subst_rawconstr subst c,ido)
+*)
   (* Automation tactics *)
-  | TacTrivial l -> TacTrivial l
-  | TacAuto (n,l) -> TacAuto (n,l)
+  | TacTrivial (lems,l) -> TacTrivial (List.map (subst_rawconstr subst) lems,l)
+  | TacAuto (n,lems,l) -> TacAuto (n,List.map (subst_rawconstr subst) lems,l)
   | TacAutoTDB n -> TacAutoTDB n
   | TacDestructHyp (b,id) -> TacDestructHyp(b,id)
   | TacDestructConcl -> TacDestructConcl
@@ -2003,12 +2033,12 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
 
   (* Derived basic tactics *)
   | TacSimpleInduction h as x -> x
-  | TacNewInduction (c,cbo,ids) ->
-      TacNewInduction (subst_induction_arg subst c,
+  | TacNewInduction (lc,cbo,ids) -> (* Pierre C. est-ce correct? *)
+      TacNewInduction (List.map (subst_induction_arg subst) lc,
                option_app (subst_raw_with_bindings subst) cbo, ids)
   | TacSimpleDestruct h as x -> x
   | TacNewDestruct (c,cbo,ids) ->
-      TacNewDestruct (subst_induction_arg subst c,
+      TacNewDestruct (List.map (subst_induction_arg subst) c,  (* Julien F. est-ce correct? *)
                option_app (subst_raw_with_bindings subst) cbo, ids)
   | TacDoubleInduction (h1,h2) as x -> x
   | TacDecomposeAnd c -> TacDecomposeAnd (subst_rawconstr subst c)
@@ -2020,7 +2050,7 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
   | TacLApply c -> TacLApply (subst_rawconstr subst c)
 
   (* Context management *)
-  | TacClear l as x -> x
+  | TacClear _ as x -> x
   | TacClearBody l as x -> x
   | TacMove (dep,id1,id2) as x -> x
   | TacRename (id1,id2) as x -> x
@@ -2065,10 +2095,10 @@ and subst_tactic subst (t:glob_tactic_expr) = match t with
   | TacLetIn (l,u) ->
       let l = List.map (fun (n,c,b) -> (n,option_app (subst_tactic subst) c,subst_tacarg subst b)) l in
       TacLetIn (l,subst_tactic subst u)
-  | TacMatchContext (lr,lmr) ->
-      TacMatchContext(lr, subst_match_rule subst lmr)
-  | TacMatch (c,lmr) ->
-      TacMatch (subst_tactic subst c,subst_match_rule subst lmr)
+  | TacMatchContext (lz,lr,lmr) ->
+      TacMatchContext(lz,lr, subst_match_rule subst lmr)
+  | TacMatch (lz,c,lmr) ->
+      TacMatch (lz,subst_tactic subst c,subst_match_rule subst lmr)
   | TacId _ | TacFail _ as x -> x
   | TacProgress tac -> TacProgress (subst_tactic subst tac:glob_tactic_expr)
   | TacAbstract (tac,s) -> TacAbstract (subst_tactic subst tac,s)
@@ -2084,6 +2114,7 @@ and subst_tactic subst (t:glob_tactic_expr) = match t with
       TacOrelse (subst_tactic subst tac1,subst_tactic subst tac2)
   | TacFirst l -> TacFirst (List.map (subst_tactic subst) l)
   | TacSolve l -> TacSolve (List.map (subst_tactic subst) l)
+  | TacComplete tac -> TacComplete (subst_tactic subst tac)
   | TacArg a -> TacArg (subst_tacarg subst a)
 
 and subst_tactic_fun subst (var,body) = (var,subst_tactic subst body)
@@ -2094,6 +2125,8 @@ and subst_tacarg subst = function
   | MetaIdArg (_loc,_) -> assert false
   | TacCall (_loc,f,l) ->
       TacCall (_loc, subst_reference subst f, List.map (subst_tacarg subst) l)
+  | TacExternal (_loc,com,req,la) -> 
+      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 ->
@@ -2123,7 +2156,7 @@ and subst_genarg subst (x:glob_generic_argument) =
   | IntroPatternArgType ->
       in_gen globwit_intro_pattern (out_gen globwit_intro_pattern x)
   | IdentArgType -> in_gen globwit_ident (out_gen globwit_ident x)
-  | HypArgType -> in_gen globwit_var (out_gen globwit_var x)
+  | VarArgType -> in_gen globwit_var (out_gen globwit_var x)
   | RefArgType ->
       in_gen globwit_ref (subst_global_reference subst 
 	(out_gen globwit_ref x))
@@ -2139,14 +2172,12 @@ and subst_genarg subst (x:glob_generic_argument) =
           (out_gen globwit_quant_hyp x))
   | RedExprArgType ->
       in_gen globwit_red_expr (subst_redexp subst (out_gen globwit_red_expr x))
-  | TacticArgType ->
-      in_gen globwit_tactic (subst_tactic subst (out_gen globwit_tactic x))
-  | OpenConstrArgType ->
-      in_gen globwit_open_constr 
-        ((),subst_rawconstr subst (snd (out_gen globwit_open_constr x)))
-  | CastedOpenConstrArgType ->
-      in_gen globwit_casted_open_constr 
-        ((),subst_rawconstr subst (snd (out_gen globwit_casted_open_constr x)))
+  | TacticArgType n ->
+      in_gen (globwit_tactic n)
+        (subst_tactic subst (out_gen (globwit_tactic n) x))
+  | OpenConstrArgType b ->
+      in_gen (globwit_open_constr_gen b)
+        ((),subst_rawconstr subst (snd (out_gen (globwit_open_constr_gen b) x)))
   | ConstrWithBindingsArgType ->
       in_gen globwit_constr_with_bindings
         (subst_raw_with_bindings subst (out_gen globwit_constr_with_bindings x))
@@ -2201,6 +2232,17 @@ let (inMD,outMD) =
      classify_function = (fun (_,o) -> Substitute o);       
      export_function = (fun x -> Some x)}
 
+let print_ltac id =
+ try
+  let kn = Nametab.locate_tactic id in
+  let t = lookup kn in
+   str "Ltac" ++ spc() ++ pr_qualid id ++ str ":=" ++ spc() ++
+    Pptactic.pr_glob_tactic (Global.env ()) t
+ with
+  Not_found ->
+   errorlabstrm "print_ltac"
+    (pr_qualid id ++ spc() ++ str "is not a user defined tactic")
+
 (* Adds a definition for tactics in the table *)
 let make_absolute_name (loc,id) =
   let kn = Lib.make_kn id in
@@ -2234,8 +2276,9 @@ let add_tacdef isrec tacl =
 let glob_tactic x = intern_tactic (make_empty_glob_sign ()) x
 
 let glob_tactic_env l env x = 
-  intern_tactic
-    { ltacvars = (l,[]); ltacrecvars = []; gsigma = Evd.empty; genv = env }
+  Options.with_option strict_check
+  (intern_tactic
+    { ltacvars = (l,[]); ltacrecvars = []; gsigma = Evd.empty; genv = env })
     x
 
 let interp_redexp env evc r = 
diff --git a/tactics/tacinterp.mli b/tactics/tacinterp.mli
index 1f75b5a4..68f6f6ac 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,v 1.13.2.1 2004/07/16 19:30:55 herbelin Exp $ i*)
+(*i $Id: tacinterp.mli 7841 2006-01-11 11:24:54Z herbelin $ i*)
 
 (*i*)
 open Dyn
@@ -19,6 +19,7 @@ open Term
 open Tacexpr
 open Genarg
 open Topconstr
+open Mod_subst
 (*i*)
 
 (* Values for interpretation *)
@@ -78,7 +79,7 @@ val add_interp_genarg :
     (glob_sign -> raw_generic_argument -> glob_generic_argument) *
     (interp_sign -> goal sigma -> glob_generic_argument -> 
       closed_generic_argument) *
-    (Names.substitution -> glob_generic_argument -> glob_generic_argument)
+    (substitution -> glob_generic_argument -> glob_generic_argument)
     -> unit
 
 val interp_genarg :
@@ -87,20 +88,32 @@ val interp_genarg :
 val intern_genarg :
   glob_sign -> raw_generic_argument -> glob_generic_argument
 
+val intern_constr :
+  glob_sign -> constr_expr -> rawconstr_and_expr
+
+val intern_hyp :
+  glob_sign -> identifier Util.located -> identifier Util.located
+
 val subst_genarg :
-  Names.substitution -> glob_generic_argument -> glob_generic_argument
+  substitution -> glob_generic_argument -> glob_generic_argument
+
+val subst_rawconstr_and_expr :
+  substitution -> rawconstr_and_expr -> rawconstr_and_expr
 
 (* Interprets any expression *)
 val val_interp : interp_sign -> goal sigma -> glob_tactic_expr -> value
 
 (* Interprets redexp arguments *)
 val interp_redexp : Environ.env -> Evd.evar_map -> raw_red_expr
-  -> Tacred.red_expr
+  -> Redexpr.red_expr
 
 (* Interprets tactic expressions *)
 val interp_tac_gen : (identifier * value) list -> 
                  debug_info -> raw_tactic_expr -> tactic
 
+val interp_hyp :  interp_sign -> goal sigma -> 
+  identifier Util.located -> identifier
+
 (* Initial call for interpretation *)
 val glob_tactic : raw_tactic_expr -> glob_tactic_expr
 
@@ -116,11 +129,12 @@ val subst_tactic : substitution -> glob_tactic_expr -> glob_tactic_expr
 
 val hide_interp : raw_tactic_expr -> tactic option -> tactic
 
-(* Adds an interpretation function *)
-val interp_add : string * (interp_sign -> Coqast.t -> value) -> unit
-
-(* Adds a possible existing interpretation function *)
-val overwriting_interp_add : string * (interp_sign -> Coqast.t -> value) ->
-                             unit
+(* Declare the default tactic to fill implicit arguments *)
+val declare_implicit_tactic : tactic -> unit
 
+(* Declare the xml printer *)
+val declare_xml_printer : 
+  (out_channel -> Environ.env -> Evd.evar_map -> constr -> unit) -> unit
 
+(* printing *)
+val print_ltac : Libnames.qualid -> std_ppcmds
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index 77898afb..d7bbb2a4 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacticals.ml,v 1.60.2.1 2004/07/16 19:30:55 herbelin Exp $ *)
+(* $Id: tacticals.ml 7909 2006-01-21 11:09:18Z herbelin $ *)
 
 open Pp
 open Util
@@ -22,6 +22,7 @@ open Libnames
 open Refiner
 open Tacmach
 open Clenv
+open Clenvtac
 open Pattern
 open Matching
 open Evar_refiner
@@ -90,7 +91,7 @@ let tclLAST_HYP = tclNTH_HYP 1
 
 let tclTRY_sign (tac : constr->tactic) sign gl =
   let rec arec = function
-    | []      -> tclFAIL 0 "no applicable hypothesis"
+    | []      -> tclFAIL 0 (str "no applicable hypothesis")
     | [s]     -> tac (mkVar s) (*added in order to get useful error messages *)
     | (s::sl) -> tclORELSE (tac (mkVar s)) (arec sl) 
   in 
@@ -118,15 +119,13 @@ type clause = identifier gclause
 
 let allClauses = { onhyps=None; onconcl=true; concl_occs=[] }
 let allHyps = { onhyps=None; onconcl=false; concl_occs=[] }
-let onHyp id =
-  { onhyps=Some[(id,[],(InHyp, ref None))]; onconcl=false; concl_occs=[] }
+let onHyp id = { onhyps=Some[(id,[],InHyp)]; onconcl=false; concl_occs=[] }
 let onConcl = { onhyps=Some[]; onconcl=true; concl_occs=[] }
 
 let simple_clause_list_of cl gls =
   let hyps =
     match cl.onhyps with 
-        None ->
-          List.map (fun id -> Some(id,[],(InHyp,ref None))) (pf_ids_of_hyps gls)
+        None -> List.map (fun id -> Some(id,[],InHyp)) (pf_ids_of_hyps gls)
       | Some l -> List.map (fun h -> Some h) l in
   if cl.onconcl then None::hyps else hyps
 
@@ -134,7 +133,7 @@ let simple_clause_list_of cl gls =
 (* OR-branch *)
 let tryClauses tac cl gls = 
   let rec firstrec = function
-    | []      -> tclFAIL 0 "no applicable hypothesis"
+    | []      -> tclFAIL 0 (str "no applicable hypothesis")
     | [cls]   -> tac cls (* added in order to get a useful error message *)
     | cls::tl -> (tclORELSE (tac cls) (firstrec tl))
   in
@@ -173,8 +172,7 @@ let clause_type cls gl =
 (* Functions concerning matching of clausal environments *)
 
 let pf_is_matching gls pat n =
-  let (wc,_) = startWalk gls in 
-  is_matching_conv (w_env wc) (w_Underlying wc) pat n
+  is_matching_conv (pf_env gls) (project gls) pat n
 
 let pf_matches gls pat n =
   matches_conv (pf_env gls) (project gls) pat n
@@ -268,9 +266,9 @@ type branch_assumptions = {
   assums    : named_context}   (* the list of assumptions introduced *)
 
 let compute_induction_names n = function
-  | None ->
+  | IntroAnonymous ->
       Array.make n []
-  | Some (IntroOrAndPattern names) when List.length names = n ->
+  | IntroOrAndPattern names when List.length names = n ->
       Array.of_list names
   | _ ->
       errorlabstrm "" (str "Expects " ++ int n ++ str " lists of names")
@@ -288,7 +286,7 @@ let compute_construtor_signatures isrec (_,k as ity) =
     | _ -> anomaly "compute_construtor_signatures"
   in 
   let (mib,mip) = Global.lookup_inductive ity in
-  let n = mip.mind_nparams in
+  let n = mib.mind_nparams in
   let lc =
     Array.map (fun c -> snd (decompose_prod_n_assum n c)) mip.mind_nf_lc in
   let lrecargs = dest_subterms mip.mind_recargs in
@@ -324,23 +322,22 @@ let general_elim_then_using
   elim isrec allnames tac predicate (indbindings,elimbindings) c gl =
   let (ity,t) = pf_reduce_to_quantified_ind gl (pf_type_of gl c) in
   (* applying elimination_scheme just a little modified *)
-  let (wc,kONT)  = startWalk gl in
-  let indclause  = mk_clenv_from wc (c,t) in
+  let indclause  = mk_clenv_from gl (c,t) in
   let indclause' = clenv_constrain_with_bindings indbindings indclause in
-  let elimclause = mk_clenv_from () (elim,w_type_of wc elim) in
+  let elimclause = mk_clenv_from gl (elim,pf_type_of gl elim) in
   let indmv = 
-    match kind_of_term (last_arg (clenv_template elimclause).rebus) with
+    match kind_of_term (last_arg elimclause.templval.Evd.rebus) with
       | Meta mv -> mv
       | _         -> error "elimination"
   in
   let pmv =
-    let p, _ = decompose_app (clenv_template_type elimclause).rebus in
+    let p, _ = decompose_app elimclause.templtyp.Evd.rebus in
     match kind_of_term p with
       | Meta p -> p
       | _ ->
 	  let name_elim =
 	    match kind_of_term elim with
-	      | Const kn -> string_of_kn kn
+	      | Const kn -> string_of_con kn
 	      | Var id -> string_of_id id
 	      | _ -> "\b"
 	  in
@@ -351,7 +348,7 @@ let general_elim_then_using
   let branchsigns = compute_construtor_signatures isrec ity in
   let brnames = compute_induction_names (Array.length branchsigns) allnames in
   let after_tac ce i gl =
-    let (hd,largs) = decompose_app (clenv_template_type ce).rebus in
+    let (hd,largs) = decompose_app ce.templtyp.Evd.rebus in
     let ba = { branchsign = branchsigns.(i);
                branchnames = brnames.(i);
                nassums = 
@@ -360,8 +357,8 @@ let general_elim_then_using
                    0 branchsigns.(i);
                branchnum = i+1;
                ity = ity;
-               largs = List.map (clenv_instance_term ce) largs;
-               pred = clenv_instance_term ce hd }
+               largs = List.map (clenv_nf_meta ce) largs;
+               pred = clenv_nf_meta ce hd }
     in 
     tac ba gl
   in
@@ -369,9 +366,10 @@ let general_elim_then_using
   let elimclause' =
     match predicate with
        | None   -> elimclause'
-       | Some p -> clenv_assign pmv p elimclause'
+       | Some p ->
+           clenv_unify true Reduction.CONV (mkMeta pmv) p elimclause'
   in 
-  elim_res_pf_THEN_i kONT elimclause' branchtacs gl
+  elim_res_pf_THEN_i elimclause' branchtacs gl
 
 
 let elimination_then_using tac predicate (indbindings,elimbindings) c gl = 
@@ -379,7 +377,7 @@ let elimination_then_using tac predicate (indbindings,elimbindings) c gl =
   let elim =
     Indrec.lookup_eliminator ind (elimination_sort_of_goal gl) in
   general_elim_then_using
-    elim true None tac predicate (indbindings,elimbindings) c gl
+    elim true IntroAnonymous tac predicate (indbindings,elimbindings) c gl
 
 
 let elimination_then tac        = elimination_then_using tac None 
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index 111a5e2d..7ceddc8b 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -6,9 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tacticals.mli,v 1.38.2.2 2005/01/21 16:41:52 herbelin Exp $ i*)
+(*i $Id: tacticals.mli 7909 2006-01-21 11:09:18Z herbelin $ i*)
 
 (*i*)
+open Pp
 open Names
 open Term
 open Sign
@@ -24,7 +25,7 @@ open Tacexpr
 (* Tacticals i.e. functions from tactics to tactics. *)
 
 val tclIDTAC         : tactic
-val tclIDTAC_MESSAGE : string -> tactic
+val tclIDTAC_MESSAGE : std_ppcmds -> tactic
 val tclORELSE        : tactic -> tactic -> tactic
 val tclTHEN          : tactic -> tactic -> tactic
 val tclTHENSEQ       : tactic list -> tactic
@@ -46,7 +47,7 @@ val tclTRY           : tactic -> tactic
 val tclINFO          : tactic -> tactic
 val tclCOMPLETE      : tactic -> tactic
 val tclAT_LEAST_ONCE : tactic -> tactic
-val tclFAIL          : int -> string -> tactic
+val tclFAIL          : int -> std_ppcmds -> tactic
 val tclDO            : int -> tactic -> tactic
 val tclPROGRESS      : tactic -> tactic
 val tclWEAK_PROGRESS : tactic -> tactic
@@ -129,13 +130,13 @@ type branch_assumptions = {
 
 (* Useful for [as intro_pattern] modifier *)
 val compute_induction_names : 
-  int -> intro_pattern_expr option -> intro_pattern_expr list array
+  int -> intro_pattern_expr -> intro_pattern_expr list array
 
 val elimination_sort_of_goal : goal sigma -> sorts_family
 val elimination_sort_of_hyp  : identifier -> goal sigma -> sorts_family
 
 val general_elim_then_using :
-  constr -> (* isrec: *) bool -> intro_pattern_expr option ->
+  constr -> (* isrec: *) bool -> intro_pattern_expr ->
     (branch_args -> tactic) -> constr option -> 
       (arg_bindings * arg_bindings) -> constr -> tactic
 	  
@@ -148,11 +149,11 @@ val elimination_then :
     (arg_bindings * arg_bindings) -> constr -> tactic
 
 val case_then_using :
-  intro_pattern_expr option -> (branch_args -> tactic) -> 
+  intro_pattern_expr -> (branch_args -> tactic) -> 
     constr option -> (arg_bindings * arg_bindings) -> constr -> tactic
 
 val case_nodep_then_using :
-  intro_pattern_expr option -> (branch_args -> tactic) -> 
+  intro_pattern_expr -> (branch_args -> tactic) -> 
     constr option -> (arg_bindings * arg_bindings) -> constr -> tactic
 
 val simple_elimination_then :
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 2ba09e52..1d97dc4f 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tactics.ml,v 1.162.2.7 2005/07/13 16:18:57 herbelin Exp $ *)
+(* $Id: tactics.ml 8701 2006-04-12 08:07:35Z courtieu $ *)
 
 open Pp
 open Util
@@ -31,6 +31,7 @@ open Proof_type
 open Logic
 open Evar_refiner
 open Clenv
+open Clenvtac
 open Refiner
 open Tacticals
 open Hipattern
@@ -39,6 +40,8 @@ open Nametab
 open Genarg
 open Tacexpr
 open Decl_kinds
+open Evarutil
+open Indrec
 
 exception Bound
 
@@ -47,7 +50,7 @@ let rec nb_prod x =
     match kind_of_term c with
         Prod(_,_,t) -> count (n+1) t
       | LetIn(_,a,_,t) -> count n (subst1 a t)
-      | Cast(c,_) -> count n c
+      | Cast(c,_,_) -> count n c
       | _ -> n
   in count 0 x
 
@@ -141,28 +144,24 @@ type tactic_reduction = env -> evar_map -> constr -> constr
    reduction function either to the conclusion or to a 
    certain hypothesis *)
 
-let reduct_in_concl redfun gl = 
-  convert_concl_no_check (pf_reduce redfun gl (pf_concl gl)) gl
+let reduct_in_concl (redfun,sty) gl = 
+  convert_concl_no_check (pf_reduce redfun gl (pf_concl gl)) sty gl
 
-let reduct_in_hyp redfun (id,_,(where,where')) gl =
+let reduct_in_hyp redfun (id,_,where) gl =
   let (_,c, ty) = pf_get_hyp gl id in
   let redfun' = (*under_casts*) (pf_reduce redfun gl) in
   match c with
   | None -> 
       if where = InHypValueOnly then
 	errorlabstrm "" (pr_id id ++ str "has no value");
-      if Options.do_translate () then where' := Some where;
       convert_hyp_no_check (id,None,redfun' ty) gl
   | Some b ->
-      let where =
-	if !Options.v7 & where = InHyp then InHypValueOnly else where in
       let b' = if where <> InHypTypeOnly then redfun' b else b in
       let ty' =	if where <> InHypValueOnly then redfun' ty else ty in
-      if Options.do_translate () then where' := Some where;
       convert_hyp_no_check (id,Some b',ty') gl
 
 let reduct_option redfun = function
-  | Some id -> reduct_in_hyp   redfun id 
+  | Some id -> reduct_in_hyp (fst redfun) id 
   | None    -> reduct_in_concl redfun 
 
 (* The following tactic determines whether the reduction
@@ -182,10 +181,13 @@ let change_and_check cv_pb t env sigma c =
 (* Use cumulutavity only if changing the conclusion not a subterm *)
 let change_on_subterm cv_pb t = function
   | None -> change_and_check cv_pb t
-  | Some occl -> contextually false occl (change_and_check CONV t) 
+  | Some occl -> contextually false occl (change_and_check Reduction.CONV t) 
 
-let change_in_concl occl t = reduct_in_concl (change_on_subterm CUMUL t occl) 
-let change_in_hyp occl t   = reduct_in_hyp (change_on_subterm CONV t occl)
+let change_in_concl occl t =
+  reduct_in_concl ((change_on_subterm Reduction.CUMUL t occl),DEFAULTcast)
+
+let change_in_hyp occl t   =
+  reduct_in_hyp (change_on_subterm Reduction.CONV t occl)
 
 let change_option occl t = function
     Some id -> change_in_hyp occl t id
@@ -200,22 +202,23 @@ let change occl c cls =
   onClauses (change_option occl c) cls
 
 (* Pour usage interne (le niveau User est pris en compte par reduce) *)
-let red_in_concl        = reduct_in_concl red_product
+let red_in_concl        = reduct_in_concl (red_product,DEFAULTcast)
 let red_in_hyp          = reduct_in_hyp   red_product
-let red_option          = reduct_option   red_product
-let hnf_in_concl        = reduct_in_concl hnf_constr
+let red_option          = reduct_option   (red_product,DEFAULTcast)
+let hnf_in_concl        = reduct_in_concl (hnf_constr,DEFAULTcast)
 let hnf_in_hyp          = reduct_in_hyp   hnf_constr
-let hnf_option          = reduct_option   hnf_constr
-let simpl_in_concl      = reduct_in_concl nf
+let hnf_option          = reduct_option   (hnf_constr,DEFAULTcast)
+let simpl_in_concl      = reduct_in_concl (nf,DEFAULTcast)
 let simpl_in_hyp        = reduct_in_hyp   nf
-let simpl_option        = reduct_option   nf
-let normalise_in_concl  = reduct_in_concl compute
+let simpl_option        = reduct_option   (nf,DEFAULTcast)
+let normalise_in_concl  = reduct_in_concl (compute,DEFAULTcast)
 let normalise_in_hyp    = reduct_in_hyp   compute
-let normalise_option    = reduct_option   compute
-let unfold_in_concl loccname   = reduct_in_concl (unfoldn loccname) 
-let unfold_in_hyp   loccname   = reduct_in_hyp   (unfoldn loccname) 
-let unfold_option   loccname   = reduct_option   (unfoldn loccname) 
-let pattern_option l = reduct_option (pattern_occs l)
+let normalise_option    = reduct_option   (compute,DEFAULTcast)
+let normalise_vm_in_concl = reduct_in_concl (Redexpr.cbv_vm,VMcast)
+let unfold_in_concl loccname = reduct_in_concl (unfoldn loccname,DEFAULTcast)
+let unfold_in_hyp   loccname = reduct_in_hyp   (unfoldn loccname) 
+let unfold_option   loccname = reduct_option (unfoldn loccname,DEFAULTcast) 
+let pattern_option l = reduct_option (pattern_occs l,DEFAULTcast)
 
 (* A function which reduces accordingly to a reduction expression,
    as the command Eval does. *)
@@ -228,7 +231,7 @@ let needs_check = function
 
 let reduce redexp cl goal =
   (if needs_check redexp then with_check else (fun x -> x))
-    (redin_combinator (reduction_of_redexp redexp) cl)
+    (redin_combinator (Redexpr.reduction_of_red_expr redexp) cl)
     goal
 
 (* Unfolding occurrences of a constant *)
@@ -300,6 +303,8 @@ let intro_force force_flag = intro_gen (IntroAvoid []) None force_flag
 let intro = intro_force false
 let introf = intro_force true
 
+let intro_avoiding l = intro_gen (IntroAvoid l) None false 
+
 let introf_move_name destopt = intro_gen (IntroAvoid []) destopt true
 
 (* For backwards compatibility *)
@@ -313,7 +318,7 @@ let rec intros_using = function
 
 let intros = tclREPEAT (intro_force false)
 
-let intro_erasing id = tclTHEN (thin [id]) (intro_using id)
+let intro_erasing id = tclTHEN (thin [id]) (introduction id)
 
 let intros_replacing ids gls = 
   let rec introrec = function
@@ -341,7 +346,9 @@ let pf_lookup_hypothesis_as_renamed_gen red h gl =
   let rec aux ccl =
     match pf_lookup_hypothesis_as_renamed env ccl h with
       | None when red ->
-          aux (reduction_of_redexp (Red true) env (project gl) ccl)
+          aux 
+	    ((fst (Redexpr.reduction_of_red_expr (Red true))) 
+	       env (project gl) ccl)
       | x -> x
   in
   try aux (pf_concl gl)
@@ -428,7 +435,7 @@ let rec intros_rmove = function
  *  of the type of a term. *)
 
 let apply_type hdcty argl gl =
-  refine (applist (mkCast (mkMeta (new_meta()),hdcty),argl)) gl
+  refine (applist (mkCast (Evarutil.mk_new_meta(),DEFAULTcast, hdcty),argl)) gl
     
 let apply_term hdc argl gl =
   refine (applist (hdc,argl)) gl
@@ -438,39 +445,33 @@ let bring_hyps hyps =
   else
     (fun gl ->
       let newcl = List.fold_right mkNamedProd_or_LetIn hyps (pf_concl gl) in
-      let f = mkCast (mkMeta (new_meta()),newcl) in
+      let f = mkCast (Evarutil.mk_new_meta(),DEFAULTcast, newcl) in
       refine_no_check (mkApp (f, instance_from_named_context hyps)) gl)
 
 (* Resolution with missing arguments *)
 
 let apply_with_bindings (c,lbind) gl = 
-  let apply = 
-    match kind_of_term c with 
-      | Lambda _ -> res_pf_cast 
-      | _ -> res_pf 
-  in 
-  let (wc,kONT) = startWalk gl in
   (* The actual type of the theorem. It will be matched against the
   goal. If this fails, then the head constant will be unfolded step by
   step. *)
-  let thm_ty0 = nf_betaiota (w_type_of wc c) in
+  let thm_ty0 = nf_betaiota (pf_type_of gl c) in
   let rec try_apply thm_ty =
     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 wc n (c,thm_ty) lbind in
-      apply kONT clause gl
-    with (RefinerError _|UserError _|Failure _) as exn ->
+      let clause = make_clenv_binding_apply gl n (c,thm_ty) lbind in
+      Clenvtac.res_pf clause gl
+    with (Pretype_errors.PretypeError _|RefinerError _|UserError _|Failure _) as exn ->
       let red_thm =
-        try red_product (w_env wc) (w_Underlying wc) thm_ty
+        try red_product (pf_env gl) (project gl) thm_ty
         with (Redelimination | UserError _) -> raise exn in
       try_apply red_thm in
   try try_apply thm_ty0
-  with (RefinerError _|UserError _|Failure _) ->
+  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 wc (-1) (c,thm_ty0) lbind in 
-    apply kONT clause gl
+    let clause = make_clenv_binding_apply gl (-1) (c,thm_ty0) lbind in 
+    Clenvtac.res_pf clause gl
 
 let apply c = apply_with_bindings (c,NoBindings)
 
@@ -481,9 +482,8 @@ let apply_list = function
 (* Resolution with no reduction on the type *)
 
 let apply_without_reduce c gl = 
-  let (wc,kONT) = startWalk gl in
-  let clause = mk_clenv_type_of wc c in 
-  res_pf kONT clause gl
+  let clause = mk_clenv_type_of gl c in 
+  res_pf clause gl
 
 (* A useful resolution tactic which, if c:A->B, transforms |- C into
    |- B -> C and |- A
@@ -502,6 +502,10 @@ 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
@@ -511,24 +515,6 @@ let cut_and_apply c gl =
 	  (apply_term c [mkMeta (new_meta())]) gl
     | _ -> error "Imp_elim needs a non-dependent product"
 
-(**************************)
-(*     Cut tactics        *)
-(**************************)
-
-let assert_tac first na c gl =
-  match kind_of_term (hnf_type_of gl c) with
-    | Sort s -> 
-	let id = match na with
-	  | Anonymous -> 
-              let d = match s with Prop _ -> "H" | Type _ -> "X" in
-              fresh_id [] (id_of_string d) gl
-	  | Name id -> id
-	in
-	(if first then internal_cut else internal_cut_rev) id c gl
-    | _  -> error "Not a proposition or a type"
-
-let true_cut = assert_tac true
-
 let cut c gl =
   match kind_of_term (hnf_type_of gl c) with
     | Sort _ ->
@@ -541,14 +527,13 @@ let cut c gl =
     | _  -> error "Not a proposition or a type"
 
 let cut_intro t = tclTHENFIRST (cut t) intro
-		    
-let cut_replacing id t = 
-  tclTHENFIRST
-    (cut t)
-    (tclORELSE
+
+let cut_replacing id t tac = 
+  tclTHENS (cut t)
+    [tclORELSE
       (intro_replacing id) 
-      (tclORELSE (intro_erasing id) 
-        (intro_using id)))
+      (tclORELSE (intro_erasing id) (intro_using id));
+     tac (refine_no_check (mkVar id)) ]
 
 let cut_in_parallel l = 
   let rec prec = function
@@ -557,226 +542,6 @@ let cut_in_parallel l =
   in 
   prec (List.rev l)
 
-(**************************)
-(*   Generalize tactics   *)
-(**************************)
-
-let generalize_goal gl c cl =
-  let t = pf_type_of gl c in
-  match kind_of_term c with
-    | Var id ->
-	(* The choice of remembering or not a non dependent name has an impact
-	   on the future Intro naming strategy! *)
-	(* if dependent c cl then mkNamedProd id t cl
-	   else mkProd (Anonymous,t,cl) *)
-	mkNamedProd id t cl
-    | _        -> 
-        let cl' = subst_term c cl in
-        if noccurn 1 cl' then 
-	  mkProd (Anonymous,t,cl)
-          (* On ne se casse pas la tete : on prend pour nom de variable
-             la premiere lettre du type, meme si "ci" est une
-             constante et qu'on pourrait prendre directement son nom *)
-        else 
-	  prod_name (Global.env()) (Anonymous, t, cl')
-
-let generalize_dep c gl =
-  let env = pf_env gl in
-  let sign = pf_hyps gl in
-  let init_ids = ids_of_named_context (Global.named_context()) in
-  let rec seek d toquant =
-    if List.exists (fun (id,_,_) -> occur_var_in_decl env id d) toquant
-      or dependent_in_decl c d then 
-      d::toquant
-    else 
-      toquant in
-  let to_quantify = Sign.fold_named_context seek sign ~init:[] in
-  let to_quantify_rev = List.rev to_quantify in
-  let qhyps = List.map (fun (id,_,_) -> id) to_quantify_rev in
-  let tothin = List.filter (fun id -> not (List.mem id init_ids)) qhyps in
-  let tothin' =
-    match kind_of_term c with
-      | Var id when mem_named_context id sign & not (List.mem id init_ids)
-	  -> id::tothin
-      | _ -> tothin
-  in
-  let cl' = it_mkNamedProd_or_LetIn (pf_concl gl) to_quantify in
-  let cl'' = generalize_goal gl c cl' in
-  let args = Array.to_list (instance_from_named_context to_quantify_rev) in
-  tclTHEN
-    (apply_type cl'' (c::args))
-    (thin (List.rev tothin'))
-    gl
-    
-let generalize lconstr gl = 
-  let newcl = List.fold_right (generalize_goal gl) lconstr (pf_concl gl) in
-  apply_type newcl lconstr gl
-
-(* Faudra-t-il une version avec plusieurs args de generalize_dep ?
-Cela peut-être troublant de faire "Generalize Dependent H n" dans
-"n:nat; H:n=n |- P(n)" et d'échouer parce que H a disparu après la
-généralisation dépendante par n.
-
-let quantify lconstr =
- List.fold_right 
-   (fun com tac -> tclTHEN tac (tactic_com generalize_dep c))
-   lconstr
-   tclIDTAC
-*)
-
-(* A dependent cut rule à la sequent calculus
-   ------------------------------------------
-   Sera simplifiable le jour où il y aura un let in primitif dans constr
-
-   [letin_tac b na c (occ_hyp,occ_ccl) gl] transforms
-   [...x1:T1(c),...,x2:T2(c),... |- G(c)] into
-   [...x:T;x1:T1(x),...,x2:T2(x),... |- G(x)] if [b] is false or
-   [...x:=c:T;x1:T1(x),...,x2:T2(x),... |- G(x)] if [b] is true
-
-   [occ_hyp,occ_ccl] tells which occurrences of [c] have to be substituted;
-   if [occ_hyp = []] and [occ_ccl = None] then [c] is substituted
-   wherever it occurs, otherwise [c] is substituted only in hyps
-   present in [occ_hyps] at the specified occurrences (everywhere if
-   the list of occurrences is empty), and in the goal at the specified
-   occurrences if [occ_goal] is not [None];
-
-   if name = Anonymous, the name is build from the first letter of the type;
-
-   The tactic first quantify the goal over x1, x2,... then substitute then
-   re-intro x1, x2,... at their initial place ([marks] is internally
-   used to remember the place of x1, x2, ...: it is the list of hypotheses on
-   the left of each x1, ...).
-*)
-
-
-
-let occurrences_of_hyp id cls =
-  let rec hyp_occ = function
-      [] -> None
-    | (id',occs,hl)::_ when id=id' -> Some occs
-    | _::l -> hyp_occ l in
-  match cls.onhyps with
-      None -> Some []
-    | Some l -> hyp_occ l
-
-let occurrences_of_goal cls =
-  if cls.onconcl then Some cls.concl_occs else None
-
-let in_every_hyp cls = (cls.onhyps = None)
-
-(*
-(* Implementation with generalisation then re-intro: introduces noise *)
-(* in proofs *)
-
-let letin_abstract id c occs gl =
-  let env = pf_env gl in
-  let compute_dependency _ (hyp,_,_ as d) ctxt =
-    let d' =
-      try
-	match occurrences_of_hyp hyp occs with
-	  | None -> raise Not_found
-	  | Some occ ->
-              let newdecl = subst_term_occ_decl occ c d in
-              if d = newdecl then
-		if not (everywhere occs)
-		then raise (RefinerError (DoesNotOccurIn (c,hyp)))
-		else raise Not_found
-              else 
-		(subst1_decl (mkVar id) newdecl, true)
-	with Not_found -> 
-	  (d,List.exists
-	      (fun ((id,_,_),dep) -> dep && occur_var_in_decl env id d) ctxt)
-    in d'::ctxt
-  in 
-  let ctxt' = fold_named_context compute_dependency env ~init:[] in
-  let compute_marks ((depdecls,marks as accu),lhyp) ((hyp,_,_) as d,b) =
-    if b then ((d::depdecls,(hyp,lhyp)::marks), lhyp)
-    else (accu, Some hyp) in
-  let (depdecls,marks),_ = List.fold_left compute_marks (([],[]),None) ctxt' in
-  let ccl = match occurrences_of_goal occs with
-    | None -> pf_concl gl
-    | Some occ -> subst1 (mkVar id) (subst_term_occ occ c (pf_concl gl))
-  in
-  (depdecls,marks,ccl)
-
-let letin_tac with_eq name c occs gl =
-  let x = id_of_name_using_hdchar (Global.env()) (pf_type_of gl c) name in
-  let id =
-    if name = Anonymous then fresh_id [] x gl else
-      if not (mem_named_context x (pf_hyps gl)) then x else
-	error ("The variable "^(string_of_id x)^" is already declared") in
-  let (depdecls,marks,ccl)= letin_abstract id c occs gl in 
-  let t = pf_type_of gl c in
-  let tmpcl = List.fold_right mkNamedProd_or_LetIn depdecls ccl in
-  let args = Array.to_list (instance_from_named_context depdecls) in
-  let newcl = mkNamedLetIn id c t tmpcl in
-  let lastlhyp = if marks=[] then None else snd (List.hd marks) in
-  tclTHENLIST
-    [ apply_type newcl args;
-      thin (List.map (fun (id,_,_) -> id) depdecls);
-      intro_gen (IntroMustBe id) lastlhyp false;
-      if with_eq then tclIDTAC else thin_body [id];
-      intros_move marks ] gl
-*)
-
-(* Implementation without generalisation: abbrev will be lost in hyps in *)
-(* in the extracted proof *)
-
-let letin_abstract id c occs gl =
-  let env = pf_env gl in
-  let compute_dependency _ (hyp,_,_ as d) depdecls =
-    match occurrences_of_hyp hyp occs with
-      | None -> depdecls
-      | Some occ ->
-          let newdecl = subst_term_occ_decl occ c d in
-          if occ = [] & d = newdecl then
-	    if not (in_every_hyp occs)
-	    then raise (RefinerError (DoesNotOccurIn (c,hyp)))
-	    else depdecls
-          else 
-	    (subst1_decl (mkVar id) newdecl)::depdecls in 
-  let depdecls = fold_named_context compute_dependency env ~init:[] in
-  let ccl = match occurrences_of_goal occs with
-    | None -> pf_concl gl
-    | Some occ -> subst1 (mkVar id) (subst_term_occ occ c (pf_concl gl)) in
-  let lastlhyp = if depdecls = [] then None else Some(pi1(list_last depdecls)) in
-  (depdecls,lastlhyp,ccl)
-
-let letin_tac with_eq name c occs gl =
-  let id =
-    let x = id_of_name_using_hdchar (Global.env()) (pf_type_of gl c) name in
-    if name = Anonymous then fresh_id [] x gl else
-      if not (mem_named_context x (pf_hyps gl)) then x else
-	error ("The variable "^(string_of_id x)^" is already declared") in
-  let (depdecls,lastlhyp,ccl)= letin_abstract id c occs gl in 
-  let t = Evarutil.refresh_universes (pf_type_of gl c) in
-  let newcl = mkNamedLetIn id c t ccl in
-  tclTHENLIST
-    [ convert_concl_no_check newcl;
-      intro_gen (IntroMustBe id) lastlhyp true;
-      if with_eq then tclIDTAC else thin_body [id];
-      tclMAP convert_hyp_no_check depdecls ] gl
-  
-let check_hypotheses_occurrences_list env (_,occl) =
-  let rec check acc = function
-    | (hyp,_) :: rest -> 
-	if List.mem hyp acc then
-	  error ("Hypothesis "^(string_of_id hyp)^" occurs twice");
-	if not (mem_named_context hyp (named_context env)) then
-	  error ("No such hypothesis: " ^ (string_of_id hyp));
-	check (hyp::acc) rest
-    | [] -> ()
-  in check [] occl
-
-let nowhere = {onhyps=Some[]; onconcl=false; concl_occs=[]}
-
-(* Tactic Assert (b=false) and Pose (b=true):
-   the behaviour of Pose is corrected by the translator.
-   not that of Assert *)
-let forward b na c =
-  let wh =  if !Options.v7 && b then onConcl else nowhere in
-  letin_tac b na c wh
-
 (********************************************************************)
 (*               Exact tactics                                      *)
 (********************************************************************)
@@ -838,9 +603,8 @@ let rec intros_clearing = function
 (* Adding new hypotheses  *)
 
 let new_hyp mopt (c,lbind) g =
-  let (wc,kONT) = startWalk g in
-  let clause  = make_clenv_binding wc (c,w_type_of wc c) lbind in
-  let (thd,tstack) = whd_stack (clenv_instance_template clause) in
+  let clause  = make_clenv_binding g (c,pf_type_of g c) lbind in
+  let (thd,tstack) = whd_stack (clenv_value clause) in
   let nargs = List.length tstack in
   let cut_pf = 
     applist(thd, 
@@ -848,10 +612,25 @@ let new_hyp mopt (c,lbind) g =
 	      | Some m -> if m < nargs then list_firstn m tstack else tstack
 	      | None   -> tstack)
   in 
-  (tclTHENLAST (tclTHEN (kONT clause.hook)
+  (tclTHENLAST (tclTHEN (tclEVARS (evars_of clause.env))
                (cut (pf_type_of g cut_pf)))
      ((tclORELSE (apply cut_pf) (exact_no_check cut_pf)))) g
 
+(* Keeping only a few hypotheses *)
+
+let keep hyps gl =
+  let env = Global.env() in
+  let ccl = pf_concl gl in
+  let cl,_ =
+    fold_named_context_reverse (fun (clear,keep) (hyp,_,_ as decl) ->
+      if List.mem hyp hyps
+	or List.exists (occur_var_in_decl env hyp) keep
+	or occur_var env hyp ccl
+      then (clear,decl::keep)
+      else (hyp::clear,keep))
+      ~init:([],[]) (pf_env gl)
+  in thin cl gl
+
 (************************)
 (* Introduction tactics *)
 (************************)
@@ -860,8 +639,7 @@ let constructor_tac boundopt i lbind gl =
   let cl = pf_concl gl in 
   let (mind,redcl) = pf_reduce_to_quantified_ind gl cl in 
   let nconstr =
-    Array.length (snd (Global.lookup_inductive mind)).mind_consnames
-  and sigma   = project gl in
+    Array.length (snd (Global.lookup_inductive mind)).mind_consnames in
   if i=0 then error "The constructors are numbered starting from 1";
   if i > nconstr then error "Not enough constructors";
   begin match boundopt with 
@@ -872,7 +650,8 @@ let constructor_tac boundopt i lbind gl =
   end;
   let cons = mkConstruct (ith_constructor_of_inductive mind i) in
   let apply_tac = apply_with_bindings (cons,lbind) in
-  (tclTHENLIST [convert_concl_no_check redcl; intros; apply_tac]) gl
+  (tclTHENLIST 
+     [convert_concl_no_check redcl DEFAULTcast; intros; apply_tac]) gl
 
 let one_constructor i = constructor_tac None i
 
@@ -903,33 +682,26 @@ let simplest_split = split NoBindings
 (*       Elimination tactics                *)
 (********************************************)
 
-
-(* kONT : ??
- * wc : ??
- * elimclause : ??
- * inclause : ??
- * gl : the current goal
-*)
-
 let last_arg c = match kind_of_term c with
-  | App (f,cl) ->  array_last cl
+  | App (f,cl) ->  
+      array_last cl
   | _ -> anomaly "last_arg"
 	
-let elimination_clause_scheme kONT elimclause indclause allow_K gl = 
+let elimination_clause_scheme allow_K elimclause indclause gl = 
   let indmv = 
-    (match kind_of_term (last_arg (clenv_template elimclause).rebus) with
+    (match kind_of_term (last_arg elimclause.templval.rebus) with
        | Meta mv -> mv
        | _  -> errorlabstrm "elimination_clause"
              (str "The type of elimination clause is not well-formed")) 
   in
   let elimclause' = clenv_fchain indmv elimclause indclause in 
-  elim_res_pf kONT elimclause' allow_K gl
+  res_pf elimclause' ~allow_K:allow_K gl
 
 (* cast added otherwise tactics Case (n1,n2) generates (?f x y) and 
  * refine fails *)
 
 let type_clenv_binding wc (c,t) lbind = 
-  clenv_instance_template_type (make_clenv_binding wc (c,t) lbind)
+  clenv_type (make_clenv_binding wc (c,t) lbind)
 
 (* 
  * Elimination tactic with bindings and using an arbitrary 
@@ -939,41 +711,30 @@ let type_clenv_binding wc (c,t) lbind =
  * matching I, lbindc are the expected terms for c arguments 
  *)
 
-let general_elim (c,lbindc) (elimc,lbindelimc) ?(allow_K=true) gl = 
-  let (wc,kONT)  = startWalk gl in
+let general_elim_clause elimtac (c,lbindc) (elimc,lbindelimc) gl =
   let ct = pf_type_of gl c in
   let t = try snd (pf_reduce_to_quantified_ind gl ct) with UserError _ -> ct in
-  let indclause  = make_clenv_binding wc (c,t) lbindc  in
-  let elimt      = w_type_of wc elimc in
-  let elimclause = make_clenv_binding wc (elimc,elimt) lbindelimc in 
-  elimination_clause_scheme kONT elimclause indclause allow_K 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
+
+let general_elim c e ?(allow_K=true) =
+  general_elim_clause (elimination_clause_scheme allow_K) c e
 
 (* Elimination tactic with bindings but using the default elimination 
  * constant associated with the type. *)
 
 let find_eliminator c gl =
-  let env = pf_env gl in
-  let (ind,t) = reduce_to_quantified_ind env (project gl) (pf_type_of gl c) in
-  let s = elimination_sort_of_goal gl in
-    Indrec.lookup_eliminator ind s 
-(*  with Not_found -> 
-    let dir, base = repr_path (path_of_inductive env ind) in
-    let id = Indrec.make_elimination_ident base s in
-    errorlabstrm "default_elim"
-      (str "Cannot find the elimination combinator :" ++
-         pr_id id ++ spc () ++
-	 str "The elimination of the inductive definition :" ++
-         pr_id base ++ spc () ++ str "on sort " ++
-         spc () ++ print_sort (new_sort_in_family s) ++
-	 str " is probably not allowed")
-(* lookup_eliminator prints the message *) *)
-let default_elim (c,lbindc) gl = 
-  general_elim (c,lbindc) (find_eliminator c gl,NoBindings) gl
-
-let elim_in_context (c,_ as cx) elim gl =
-  match elim with
-  | Some (elimc,lbindelimc) -> general_elim cx (elimc,lbindelimc) gl
-  | None -> general_elim cx (find_eliminator c gl,NoBindings) gl 
+  let (ind,t) = pf_reduce_to_quantified_ind gl (pf_type_of gl c) in
+  lookup_eliminator ind (elimination_sort_of_goal gl)
+
+let default_elim (c,_ as cx) gl = 
+  general_elim cx (find_eliminator c gl,NoBindings) gl
+
+let elim_in_context c = function
+  | Some elim -> general_elim c elim ~allow_K:true
+  | None -> default_elim c
 
 let elim (c,lbindc as cx) elim =
   match kind_of_term c with
@@ -987,7 +748,7 @@ let simplest_elim c = default_elim (c,NoBindings)
 
 (* Elimination in hypothesis *)
 
-let elimination_in_clause_scheme kONT id elimclause indclause =
+let elimination_in_clause_scheme id elimclause indclause gl =
   let (hypmv,indmv) = 
     match clenv_independent elimclause with
         [k1;k2] -> (k1,k2)
@@ -995,43 +756,31 @@ let elimination_in_clause_scheme kONT id elimclause indclause =
           (str "The type of elimination clause is not well-formed") in
   let elimclause'  = clenv_fchain indmv elimclause indclause in 
   let hyp = mkVar id in
-  let hyp_typ = clenv_type_of elimclause' hyp in
+  let hyp_typ = pf_type_of gl hyp in
   let hypclause =
-    mk_clenv_from_n elimclause'.hook (Some 0) (hyp, hyp_typ) in
+    mk_clenv_from_n gl (Some 0) (hyp, hyp_typ) in
   let elimclause'' = clenv_fchain hypmv elimclause' hypclause in  
-  let new_hyp_prf  = clenv_instance_template elimclause'' in
-  let new_hyp_typ  = clenv_instance_template_type elimclause'' in
+  let new_hyp_prf  = clenv_value elimclause'' in
+  let new_hyp_typ  = clenv_type elimclause'' in
   if eq_constr hyp_typ new_hyp_typ then
     errorlabstrm "general_rewrite_in" 
       (str "Nothing to rewrite in " ++ pr_id id);
   tclTHEN
-    (kONT elimclause''.hook)
-    (tclTHENS
-      (cut new_hyp_typ)
-      [ (* Try to insert the new hyp at the same place *)
-        tclORELSE (intro_replacing id)
-          (tclTHEN (clear [id]) (introduction id));
-        refine_no_check new_hyp_prf])
-
-let general_elim_in id (c,lbindc) (elimc,lbindelimc) gl = 
-  let (wc,kONT)  = startWalk gl in
-  let ct = pf_type_of gl c in
-  let t = try snd (pf_reduce_to_quantified_ind gl ct) with UserError _ -> ct in
-  let indclause  = make_clenv_binding wc (c,t) lbindc  in
-  let elimt      = w_type_of wc elimc in
-  let elimclause = make_clenv_binding wc (elimc,elimt) lbindelimc in 
-  elimination_in_clause_scheme kONT id elimclause indclause gl
+    (tclEVARS (evars_of elimclause''.env))
+    (cut_replacing id new_hyp_typ
+      (fun x gls -> refine_no_check new_hyp_prf gls)) gl
+
+let general_elim_in id =
+  general_elim_clause (elimination_in_clause_scheme id)
 
 (* Case analysis tactics *)
 
 let general_case_analysis_in_context (c,lbindc) gl =
-  let env = pf_env gl in
   let (mind,_) = pf_reduce_to_quantified_ind gl (pf_type_of gl c) in
-  let sigma    = project gl in 
   let sort     = elimination_sort_of_goal gl in
-  let case = if occur_term c (pf_concl gl) then Indrec.make_case_dep
-  else Indrec.make_case_gen in
-  let elim     = case env sigma mind sort in 
+  let case = 
+    if occur_term c (pf_concl gl) then make_case_dep else make_case_gen in
+  let elim     = pf_apply case gl mind sort in 
   general_elim (c,lbindc) (elim,NoBindings) gl
 
 let general_case_analysis (c,lbindc as cx) =
@@ -1051,23 +800,295 @@ let simplest_case c = general_case_analysis (c,NoBindings)
 let clear_last = tclLAST_HYP (fun c -> (clear [destVar c]))
 let case_last  = tclLAST_HYP simplest_case
 
-let rec intro_pattern destopt = function
-  | IntroWildcard ->
-      tclTHEN intro clear_last
-  | IntroIdentifier id ->
-      intro_gen (IntroMustBe id) destopt true
-  | IntroOrAndPattern l ->
-      tclTHEN introf
+let rec explicit_intro_names = function
+| (IntroWildcard | IntroAnonymous) :: l -> explicit_intro_names l
+| IntroIdentifier id :: l -> id :: explicit_intro_names l
+| IntroOrAndPattern ll :: l' -> 
+    List.flatten (List.map (fun l -> explicit_intro_names (l@l')) ll)
+| [] -> []
+
+  (* We delay thinning until the completion of the whole intros tactic
+     to ensure that dependent hypotheses are cleared in the right
+     dependency order (see bug #1000); we use fresh names, not used in
+     the tactic, for the hyps to clear *)
+let rec intros_patterns avoid thin destopt = function
+  | IntroWildcard :: l ->
+      tclTHEN 
+        (intro_gen (IntroAvoid (avoid@explicit_intro_names l)) None true)
+        (onLastHyp (fun id ->
+	  tclORELSE
+	    (tclTHEN (clear [id]) (intros_patterns avoid thin destopt l))
+	    (intros_patterns avoid (id::thin) destopt l)))
+  | IntroIdentifier id :: l ->
+      tclTHEN
+        (intro_gen (IntroMustBe id) destopt true)
+        (intros_patterns avoid thin destopt l)
+  | IntroAnonymous :: l ->
+      tclTHEN
+        (intro_gen (IntroAvoid (avoid@explicit_intro_names l)) destopt true)
+        (intros_patterns avoid thin destopt l)
+  | IntroOrAndPattern ll :: l' ->
+      tclTHEN
+        introf
         (tclTHENS
 	  (tclTHEN case_last clear_last)
-	  (List.map (intros_pattern destopt) l))
+	  (List.map (fun l -> intros_patterns avoid thin destopt (l@l')) ll))
+  | [] -> clear thin
+
+let intros_pattern = intros_patterns [] []
 
-and intros_pattern destopt l = tclMAP (intro_pattern destopt) l
+let intro_pattern destopt pat = intros_patterns [] [] destopt [pat]
 
 let intro_patterns = function 
   | [] -> tclREPEAT intro
   | l  -> intros_pattern None l
 
+(**************************)
+(*   Other cut tactics    *)
+(**************************)
+
+let hid = id_of_string "H"
+let xid = id_of_string "X"
+
+let make_id s = fresh_id [] (match s with Prop _ -> hid | Type _ -> xid)
+
+let prepare_intros s ipat gl = match ipat with
+  | IntroAnonymous -> make_id s gl, tclIDTAC
+  | IntroWildcard -> let id = make_id s gl in id, thin [id]
+  | IntroIdentifier id -> id, tclIDTAC
+  | IntroOrAndPattern ll -> make_id s gl, 
+    (tclTHENS 
+      (tclTHEN case_last clear_last)
+      (List.map (intros_pattern None) ll))
+
+let ipat_of_name = function
+  | Anonymous -> IntroAnonymous
+  | Name id -> IntroIdentifier id
+
+let assert_as first ipat c gl =
+  match kind_of_term (hnf_type_of gl c) with
+  | Sort s ->
+      let id,tac = prepare_intros s ipat gl in
+      tclTHENS ((if first then internal_cut else internal_cut_rev) id c)
+	(if first then [tclIDTAC; tac] else [tac; tclIDTAC]) gl
+  | _  -> error "Not a proposition or a type"
+
+let assert_tac first na = assert_as first (ipat_of_name na)
+let true_cut = assert_tac true 
+
+(**************************)
+(*   Generalize tactics   *)
+(**************************)
+
+let generalize_goal gl c cl =
+  let t = pf_type_of gl c in
+  match kind_of_term c with
+    | Var id ->
+	(* The choice of remembering or not a non dependent name has an impact
+	   on the future Intro naming strategy! *)
+	(* if dependent c cl then mkNamedProd id t cl
+	   else mkProd (Anonymous,t,cl) *)
+	mkNamedProd id t cl
+    | _        -> 
+        let cl' = subst_term c cl in
+        if noccurn 1 cl' then 
+	  mkProd (Anonymous,t,cl)
+          (* On ne se casse pas la tete : on prend pour nom de variable
+             la premiere lettre du type, meme si "ci" est une
+             constante et qu'on pourrait prendre directement son nom *)
+        else 
+	  prod_name (Global.env()) (Anonymous, t, cl')
+
+let generalize_dep c gl =
+  let env = pf_env gl in
+  let sign = pf_hyps gl in
+  let init_ids = ids_of_named_context (Global.named_context()) in
+  let rec seek d toquant =
+    if List.exists (fun (id,_,_) -> occur_var_in_decl env id d) toquant
+      or dependent_in_decl c d then 
+      d::toquant
+    else 
+      toquant in
+  let to_quantify = Sign.fold_named_context seek sign ~init:[] in
+  let to_quantify_rev = List.rev to_quantify in
+  let qhyps = List.map (fun (id,_,_) -> id) to_quantify_rev in
+  let tothin = List.filter (fun id -> not (List.mem id init_ids)) qhyps in
+  let tothin' =
+    match kind_of_term c with
+      | Var id when mem_named_context id sign & not (List.mem id init_ids)
+	  -> id::tothin
+      | _ -> tothin
+  in
+  let cl' = it_mkNamedProd_or_LetIn (pf_concl gl) to_quantify in
+  let cl'' = generalize_goal gl c cl' in
+  let args = Array.to_list (instance_from_named_context to_quantify_rev) in
+  tclTHEN
+    (apply_type cl'' (c::args))
+    (thin (List.rev tothin'))
+    gl
+    
+let generalize lconstr gl = 
+  let newcl = List.fold_right (generalize_goal gl) lconstr (pf_concl gl) in
+  apply_type newcl lconstr gl
+
+(* Faudra-t-il une version avec plusieurs args de generalize_dep ?
+Cela peut-être troublant de faire "Generalize Dependent H n" dans
+"n:nat; H:n=n |- P(n)" et d'échouer parce que H a disparu après la
+généralisation dépendante par n.
+
+let quantify lconstr =
+ List.fold_right 
+   (fun com tac -> tclTHEN tac (tactic_com generalize_dep c))
+   lconstr
+   tclIDTAC
+*)
+
+(* A dependent cut rule à la sequent calculus
+   ------------------------------------------
+   Sera simplifiable le jour où il y aura un let in primitif dans constr
+
+   [letin_tac b na c (occ_hyp,occ_ccl) gl] transforms
+   [...x1:T1(c),...,x2:T2(c),... |- G(c)] into
+   [...x:T;x1:T1(x),...,x2:T2(x),... |- G(x)] if [b] is false or
+   [...x:=c:T;x1:T1(x),...,x2:T2(x),... |- G(x)] if [b] is true
+
+   [occ_hyp,occ_ccl] tells which occurrences of [c] have to be substituted;
+   if [occ_hyp = []] and [occ_ccl = None] then [c] is substituted
+   wherever it occurs, otherwise [c] is substituted only in hyps
+   present in [occ_hyps] at the specified occurrences (everywhere if
+   the list of occurrences is empty), and in the goal at the specified
+   occurrences if [occ_goal] is not [None];
+
+   if name = Anonymous, the name is build from the first letter of the type;
+
+   The tactic first quantify the goal over x1, x2,... then substitute then
+   re-intro x1, x2,... at their initial place ([marks] is internally
+   used to remember the place of x1, x2, ...: it is the list of hypotheses on
+   the left of each x1, ...).
+*)
+
+
+
+let occurrences_of_hyp id cls =
+  let rec hyp_occ = function
+      [] -> None
+    | (id',occs,hl)::_ when id=id' -> Some occs
+    | _::l -> hyp_occ l in
+  match cls.onhyps with
+      None -> Some []
+    | Some l -> hyp_occ l
+
+let occurrences_of_goal cls =
+  if cls.onconcl then Some cls.concl_occs else None
+
+let in_every_hyp cls = (cls.onhyps=None)
+
+(*
+(* Implementation with generalisation then re-intro: introduces noise *)
+(* in proofs *)
+
+let letin_abstract id c occs gl =
+  let env = pf_env gl in
+  let compute_dependency _ (hyp,_,_ as d) ctxt =
+    let d' =
+      try
+	match occurrences_of_hyp hyp occs with
+	  | None -> raise Not_found
+	  | Some occ ->
+              let newdecl = subst_term_occ_decl occ c d in
+              if occ = [] & d = newdecl then
+		if not (in_every_hyp occs)
+		then raise (RefinerError (DoesNotOccurIn (c,hyp)))
+		else raise Not_found
+              else 
+		(subst1_decl (mkVar id) newdecl, true)
+	with Not_found -> 
+	  (d,List.exists
+	      (fun ((id,_,_),dep) -> dep && occur_var_in_decl env id d) ctxt)
+    in d'::ctxt
+  in 
+  let ctxt' = fold_named_context compute_dependency env ~init:[] in
+  let compute_marks ((depdecls,marks as accu),lhyp) ((hyp,_,_) as d,b) =
+    if b then ((d::depdecls,(hyp,lhyp)::marks), lhyp)
+    else (accu, Some hyp) in
+  let (depdecls,marks),_ = List.fold_left compute_marks (([],[]),None) ctxt' in
+  let ccl = match occurrences_of_goal occs with
+    | None -> pf_concl gl
+    | Some occ -> subst1 (mkVar id) (subst_term_occ occ c (pf_concl gl))
+  in
+  (depdecls,marks,ccl)
+
+let letin_tac with_eq name c occs gl =
+  let x = id_of_name_using_hdchar (Global.env()) (pf_type_of gl c) name in
+  let id =
+    if name = Anonymous then fresh_id [] x gl else
+      if not (mem_named_context x (pf_hyps gl)) then x else
+	error ("The variable "^(string_of_id x)^" is already declared") in
+  let (depdecls,marks,ccl)= letin_abstract id c occs gl in 
+  let t = pf_type_of gl c in
+  let tmpcl = List.fold_right mkNamedProd_or_LetIn depdecls ccl in
+  let args = Array.to_list (instance_from_named_context depdecls) in
+  let newcl = mkNamedLetIn id c t tmpcl in
+  let lastlhyp = if marks=[] then None else snd (List.hd marks) in
+  tclTHENLIST
+    [ apply_type newcl args;
+      thin (List.map (fun (id,_,_) -> id) depdecls);
+      intro_gen (IntroMustBe id) lastlhyp false;
+      if with_eq then tclIDTAC else thin_body [id];
+      intros_move marks ] gl
+*)
+
+(* Implementation without generalisation: abbrev will be lost in hyps in *)
+(* in the extracted proof *)
+
+let letin_abstract id c occs gl =
+  let env = pf_env gl in
+  let compute_dependency _ (hyp,_,_ as d) depdecls =
+    match occurrences_of_hyp hyp occs with
+      | None -> depdecls
+      | Some occ ->
+          let newdecl = subst_term_occ_decl occ c d in
+          if occ = [] & d = newdecl then
+	    if not (in_every_hyp occs)
+	    then raise (RefinerError (DoesNotOccurIn (c,hyp)))
+	    else depdecls
+          else 
+	    (subst1_decl (mkVar id) newdecl)::depdecls in 
+  let depdecls = fold_named_context compute_dependency env ~init:[] in
+  let ccl = match occurrences_of_goal occs with
+    | None -> pf_concl gl
+    | Some occ -> subst1 (mkVar id) (subst_term_occ occ c (pf_concl gl)) in
+  let lastlhyp = if depdecls = [] then None else Some(pi1(list_last depdecls)) in
+  (depdecls,lastlhyp,ccl)
+
+let letin_tac with_eq name c occs gl =
+  let id =
+    let x = id_of_name_using_hdchar (Global.env()) (pf_type_of gl c) name in
+    if name = Anonymous then fresh_id [] x gl else
+      if not (mem_named_context x (pf_hyps gl)) then x else
+	error ("The variable "^(string_of_id x)^" is already declared") in
+  let (depdecls,lastlhyp,ccl)= letin_abstract id c occs gl in 
+  let t = refresh_universes (pf_type_of gl c) in
+  let newcl = mkNamedLetIn id c t ccl in
+  tclTHENLIST
+    [ convert_concl_no_check newcl DEFAULTcast;
+      intro_gen (IntroMustBe id) lastlhyp true;
+      if with_eq then tclIDTAC else thin_body [id];
+      tclMAP convert_hyp_no_check depdecls ] gl
+  
+(* Tactics "pose proof" (usetac=None) and "assert" (otherwise) *)
+let forward usetac ipat c gl =
+  match usetac with
+  | None -> 
+      let t = refresh_universes (pf_type_of gl c) in
+      tclTHENS (assert_as true ipat t) [exact_no_check c; tclIDTAC] gl
+  | Some tac -> 
+      tclTHENS (assert_as true ipat c) [tac; tclIDTAC] gl
+
+(*****************************)
+(* High-level induction      *)
+(*****************************)
+
 (*
  * A "natural" induction tactic
  * 
@@ -1100,20 +1121,12 @@ let intro_patterns = function
 
  *)
 
-let rec str_intro_pattern = function
-  | IntroOrAndPattern pll ->
-      "["^(String.concat "|" 
-	(List.map 
-	  (fun pl -> String.concat " " (List.map str_intro_pattern pl)) pll))
-      ^"]"
-  | IntroWildcard -> "_"
-  | IntroIdentifier id -> string_of_id id
-
 let check_unused_names names =
   if names <> [] & Options.is_verbose () then
     let s = if List.tl names = [] then " " else "s " in
-    let names = String.concat " " (List.map str_intro_pattern names) in
-    warning ("Unused introduction pattern"^s^": "^names)
+    msg_warning 
+      (str"Unused introduction pattern" ++ str s ++ 
+       str": " ++ prlist_with_sep spc pr_intro_pattern names)
 
 let rec first_name_buggy = function
   | IntroOrAndPattern [] -> None
@@ -1121,100 +1134,48 @@ let rec first_name_buggy = function
   | IntroOrAndPattern ((p::_)::_) -> first_name_buggy p
   | IntroWildcard -> None
   | IntroIdentifier id -> Some id
+  | IntroAnonymous -> assert false
+
+let consume_pattern avoid id gl = function
+  | [] -> (IntroIdentifier (fresh_id avoid id gl), [])
+  | IntroAnonymous::names ->
+      let avoid = avoid@explicit_intro_names names in
+      (IntroIdentifier (fresh_id avoid id gl), names)
+  | pat::names -> (pat,names)
 
 type elim_arg_kind = RecArg | IndArg | OtherArg
 
-let induct_discharge statuslists destopt avoid' ((avoid7,avoid8),ra) (names,force,rnames) gl =
-  let avoid7 = avoid7 @ avoid' in
-  let avoid8 = avoid8 @ avoid' in
+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
-    | (RecArg,(recvarname7,recvarname8)) ::
-        (IndArg,(hyprecname7,hyprecname8)) :: ra' ->
-        let recpat,hyprec,names = match names with
-          | [] ->
-              let idrec7 = (fresh_id avoid7 recvarname7 gl) in
-              let idrec8 = (fresh_id avoid8 recvarname8 gl) in
-              let idhyp7 = (fresh_id avoid7 hyprecname7 gl) in
-              let idhyp8 = (fresh_id avoid8 hyprecname8 gl) in
- 	      if Options.do_translate() &
-                (idrec7 <> idrec8 or idhyp7 <> idhyp8)
-	      then force := true;
-              let idrec = if !Options.v7 then idrec7 else idrec8 in
-              let idhyp = if !Options.v7 then idhyp7 else idhyp8 in
-              (IntroIdentifier idrec, IntroIdentifier idhyp, [])
+    | (RecArg,recvarname) ::
+        (IndArg,hyprecname) :: ra' ->
+        let recpat,names = match names with
           | [IntroIdentifier id as pat] ->
-              let id7 = next_ident_away (add_prefix "IH" id) avoid7 in
-              let id8 = next_ident_away (add_prefix "IH" id) avoid8 in
- 	      if Options.do_translate() & id7 <> id8 then force := true;
-              let id = if !Options.v7 then id7 else id8 in
-	      (pat, IntroIdentifier id, [])
-	  | [pat] ->
-              let idhyp7 = (fresh_id avoid7 hyprecname7 gl) in
-              let idhyp8 = (fresh_id avoid8 hyprecname8 gl) in
- 	      if Options.do_translate() & idhyp7 <> idhyp8 then force := true;
-              let idhyp = if !Options.v7 then idhyp7 else idhyp8 in
-	      (pat, IntroIdentifier idhyp, [])
-          | pat1::pat2::names -> (pat1,pat2,names) in
+              let id = next_ident_away (add_prefix "IH" id) avoid in
+	      (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;
-	rnames := !rnames @ [recpat; hyprec];
         tclTHENLIST
-	  [ intros_pattern destopt [recpat];
-	    intros_pattern None [hyprec];
+	  [ intros_patterns avoid [] destopt [recpat];
+	    intros_patterns avoid [] None [hyprec];
 	    peel_tac ra' names ] gl
-    | (IndArg,(hyprecname7,hyprecname8)) :: ra' ->
+    | (IndArg,hyprecname) :: ra' ->
 	(* Rem: does not happen in Coq schemes, only in user-defined schemes *)
-        let pat,names = match names with
-          | [] -> IntroIdentifier (fresh_id avoid8 hyprecname8 gl), []
-	  | pat::names -> pat,names in
-	rnames := !rnames @ [pat];
-	tclTHEN (intros_pattern destopt [pat]) (peel_tac ra' names) gl
-    | (RecArg,(recvarname7,recvarname8)) :: ra' ->
-        let introtac,names = match names with
-          | [] -> 
-              let id8 = fresh_id avoid8 recvarname8 gl in
-	      let i =
-                if !Options.v7 then IntroAvoid avoid7 else IntroMustBe id8
-	      in
-	      (* For translator *)
-	      let id7 = fresh_id avoid7 (default_id gl
-		(match kind_of_term (pf_concl gl) with
-		  | Prod (name,t,_) -> (name,None,t)
-		  | LetIn (name,b,t,_) -> (name,Some b,t) 
-		  | _ -> raise (RefinerError IntroNeedsProduct))) gl in
-	      if Options.do_translate() & id7 <> id8 then force := true;
-              let id = if !Options.v7 then id7 else id8 in
-	      rnames := !rnames @ [IntroIdentifier id];
-	      intro_gen i destopt false, []
-          | pat::names ->
-	      rnames := !rnames @ [pat];
-	      intros_pattern destopt [pat],names in
-	tclTHEN introtac (peel_tac ra' names) gl
+        let pat,names = consume_pattern avoid hyprecname gl names in
+	tclTHEN (intros_patterns avoid [] destopt [pat]) (peel_tac ra' names) 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
     | (OtherArg,_) :: ra' ->
-        let introtac,names = match names with
-          | [] -> 
-	      (* For translator *)
-	      let id7 = fresh_id avoid7 (default_id gl
-		(match kind_of_term (pf_concl gl) with
-		  | Prod (name,t,_) -> (name,None,t)
-		  | LetIn (name,b,t,_) -> (name,Some b,t) 
-		  | _ -> raise (RefinerError IntroNeedsProduct))) gl in
-	      let id8 = fresh_id avoid8 (default_id gl
-		(match kind_of_term (pf_concl gl) with
-		  | Prod (name,t,_) -> (name,None,t)
-		  | LetIn (name,b,t,_) -> (name,Some b,t) 
-		  | _ -> raise (RefinerError IntroNeedsProduct))) gl in
-	      if Options.do_translate() & id7 <> id8 then force := true;
-              let id = if !Options.v7 then id7 else id8 in
-              let avoid = if !Options.v7 then avoid7 else avoid8 in
-	      rnames := !rnames @ [IntroIdentifier id];
-	      intro_gen (IntroAvoid avoid) destopt false, []
-          | pat::names ->
-	      rnames := !rnames @ [pat];
-	      intros_pattern destopt [pat],names in
-	tclTHEN introtac (peel_tac ra' names) gl
+        let pat,names = match names with
+          | [] -> IntroAnonymous, []
+          | pat::names -> pat,names in
+	tclTHEN (intros_patterns avoid [] destopt [pat]) (peel_tac ra' names) gl
     | [] ->
         check_unused_names names;
         tclIDTAC gl
@@ -1335,11 +1296,25 @@ let find_atomic_param_of_ind nparams indtyp =
    would have posed no problem. But for uniformity, we decided to use
    the right hyp for all hyps on the right of H4.
 
-   Others solutions are welcome *)
+   Others solutions are welcome 
+
+   PC 9 fev 06: Adapted to accept multi argument principle with no
+   main arg hyp. hyp0 is now optional, meaning that it is possible
+   that there is no main induction hypotheses. In this case, we
+   consider the last "parameter" (in [indvars]) as the limit between
+   "left" and "right", BUT it must be included in indhyps.
+
+   Other solutions are still welcome
+
+*)
 
 exception Shunt of identifier option
 
-let cook_sign hyp0 indvars env =
+let cook_sign hyp0_opt indvars_init env =
+  let hyp0,indvars = 
+    match hyp0_opt with
+      | None -> List.hd (List.rev indvars_init) , indvars_init
+      | Some h -> h,indvars_init in
   (* First phase from L to R: get [indhyps], [decldep] and [statuslist]
      for the hypotheses before (= more ancient than) hyp0 (see above) *)
   let allindhyps = hyp0::indvars in
@@ -1352,6 +1327,9 @@ let cook_sign hyp0 indvars env =
   let seek_deps env (hyp,_,_ as decl) rhyp =
     if hyp = hyp0 then begin
       before:=false; 
+      (* If there was no main induction hypotheses, then hyp is one of
+         indvars too, so add it to indhyps. *)
+      (if hyp0_opt=None then indhyps := hyp::!indhyps); 
       None (* fake value *)
     end else if List.mem hyp indvars then begin
       (* warning: hyp can still occur after induction *)
@@ -1374,7 +1352,7 @@ let cook_sign hyp0 indvars env =
   in
   let _ = fold_named_context seek_deps env ~init:None in
   (* 2nd phase from R to L: get left hyp of [hyp0] and [lhyps] *)
-  let compute_lstatus lhyp (hyp,_,_ as d) =
+  let compute_lstatus lhyp (hyp,_,_) =
     if hyp = hyp0 then raise (Shunt lhyp);
     if List.mem hyp !ldeps then begin
       lstatus := (hyp,lhyp)::!lstatus;
@@ -1384,49 +1362,89 @@ let cook_sign hyp0 indvars env =
   in
   try 
     let _ = fold_named_context_reverse compute_lstatus ~init:None env in
-    anomaly "hyp0 not found"
+(*     anomaly "hyp0 not found" *)
+    raise (Shunt (None)) (* ?? FIXME *)
   with Shunt lhyp0 ->
     let statuslists = (!lstatus,List.rev !rstatus) in
-    (statuslists, lhyp0, !indhyps, !decldeps)
+    (statuslists, (if hyp0_opt=None then None else lhyp0) , !indhyps, !decldeps)
 
-let induction_tac varname typ ((elimc,lbindelimc),elimt) gl =
+
+(*
+   The general form of an induction principle is the following:
+   
+   forall prm1 prm2 ... prmp,                          (induction parameters)
+   forall Q1...,(Qi:Ti_1 -> Ti_2 ->...-> Ti_ni),...Qq, (predicates)
+   branch1, branch2, ... , branchr,                    (branches of the principle)
+   forall (x1:Ti_1) (x2:Ti_2) ... (xni:Ti_ni),         (induction arguments)
+   (HI: I prm1..prmp x1...xni)                         (optional main induction arg)
+   -> (Qi x1...xni HI        (f prm1...prmp x1...xni)).(conclusion)
+                   ^^        ^^^^^^^^^^^^^^^^^^^^^^^^
+               optional        optional argument added if
+               even if HI    principle generated by functional 
+             present above   induction, only if HI does not exist
+             [indarg]                  [farg]
+
+  HI is not present when the induction principle does not come directly from an
+  inductive type (like when it is generated by functional induction for
+  example). HI is present otherwise BUT may not appear in the conclusion
+  (dependent principle). HI and (f...) cannot be both present.
+
+  Principles taken from functional induction have the final (f...).*)
+
+(* [rel_contexts] and [rel_declaration] actually contain triples, and
+   lists are actually in reverse order to fit [compose_prod]. *)
+type elim_scheme = { 
+  elimc: (Term.constr * constr Rawterm.bindings) option;
+  elimt: types;
+  indref: global_reference option;
+  params: rel_context;     (* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
+  nparams: int;            (* number of parameters *)
+  predicates: rel_context; (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
+  npredicates: int;        (* Number of predicates *)
+  branches: rel_context;   (* branchr,...,branch1 *)
+  nbranches: int;          (* Number of branches *) 
+  args: rel_context;       (* (xni, Ti_ni) ... (x1, Ti_1) *)
+  nargs: int;              (* number of arguments *)
+  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni) 
+				     if HI is in premisses, None otherwise *)
+  concl: types;            (* Qi x1...xni HI (f...), HI and (f...) 
+			      are optional and mutually exclusive *)
+  indarg_in_concl: bool;   (* true if HI appears at the end of conclusion *)
+  farg_in_concl: bool;     (* true if (f...) appears at the end of conclusion *)
+}
+
+let empty_scheme = 
+  { 
+    elimc = None;
+    elimt = mkProp;
+    indref = None;
+    params = [];
+    nparams = 0;
+    predicates = [];
+    npredicates = 0;
+    branches = [];
+    nbranches = 0;
+    args = [];
+    nargs = 0;
+    indarg = None;
+    concl = mkProp;
+    indarg_in_concl = false;
+    farg_in_concl = false;
+  }
+
+
+(* Unification between ((elimc:elimt) ?i ?j ?k ?l ... ?m) and the
+   hypothesis on which the induction is made *)
+let induction_tac varname typ scheme (*(elimc,lbindelimc),elimt*) gl =
+  let elimc,lbindelimc = 
+    match scheme.elimc with | Some x -> x | None -> error "No definition of the principle" in
+  let elimt = scheme.elimt in
   let c = mkVar varname in
-  let (wc,kONT)  = startWalk gl                    in
-  let indclause  = make_clenv_binding wc (c,typ) NoBindings  in
+  let indclause  = make_clenv_binding gl (c,typ) NoBindings  in
   let elimclause =
-    make_clenv_binding wc (mkCast (elimc,elimt),elimt) lbindelimc in
-  elimination_clause_scheme kONT elimclause indclause true gl
-
-let make_up_names7 n ind (old_style,cname) = 
-  if old_style (* = V6.3 version of Induction on hypotheses *)
-  then
-    let recvarname =
-      if n=1 then 
-        cname
-      else (* To force renumbering if there is only one *)
-        make_ident (string_of_id cname ) (Some 1) in
-    recvarname, add_prefix "Hrec" recvarname, []
-  else
-    let is_hyp = atompart_of_id cname = "H" in
-    let hyprecname =
-      add_prefix "IH" (if is_hyp then Nametab.id_of_global ind else cname) in
-    let avoid =
-      if n=1 (* Only one recursive argument *)
-        or 
-        (* Rem: no recursive argument (especially if Destruct) *)
-        n=0 (* & atompart_of_id cname <> "H" (* for 7.1 compatibility *)*)
-      then []
-      else
-        (* Forbid to use cname, cname0, hyprecname and hyprecname0 *)
-        (* in order to get names such as f1, f2, ... *)
-        let avoid =
-          (make_ident (string_of_id cname) (Some 0)) ::(*here for 7.1 cmpat*)
-          (make_ident (string_of_id hyprecname) None) ::
-          (make_ident (string_of_id hyprecname) (Some 0)) :: [] in
-        if atompart_of_id cname <> "H" then
-          (make_ident (string_of_id cname) None) :: avoid
-        else avoid in
-    cname, hyprecname, avoid
+    make_clenv_binding gl 
+      (mkCast (elimc,DEFAULTcast, elimt),elimt) lbindelimc in
+  elimination_clause_scheme true elimclause indclause gl
 
 let make_base n id =
   if n=0 or n=1 then id
@@ -1435,12 +1453,19 @@ let make_base n id =
     (* digits *)
     id_of_string (atompart_of_id (make_ident (string_of_id id) (Some 0)))
 
-let make_up_names8 n ind (_,cname) = 
+(* Builds tw different names from an optional inductive type and a
+   number, also deals with a list of names to avoid. If the inductive
+   type is None, then hyprecname is HIi where i is a number. *)
+let make_up_names n ind_opt cname = 
   let is_hyp = atompart_of_id cname = "H" in
   let base = string_of_id (make_base n cname) in
-  let hyprecname =
-    add_prefix "IH"
-      (make_base n (if is_hyp then Nametab.id_of_global ind else cname)) in
+  let base_ind = 
+    if is_hyp then 
+      match ind_opt with
+	| None -> id_of_string ""
+	| Some ind_id -> Nametab.id_of_global ind_id 
+    else cname in
+  let hyprecname = add_prefix "IH" (make_base n base_ind) in
   let avoid =
     if n=1 (* Only one recursive argument *) or n=0 then []
     else
@@ -1475,109 +1500,432 @@ let error_ind_scheme s =
   let s = if s <> "" then s^" " else s in
   error ("Cannot recognise "^s^"an induction schema")
 
+
+
+
+let occur_rel n c = 
+  let res = not (noccurn n c) in
+  res
+
+let list_filter_firsts f l =
+  let rec list_filter_firsts_aux f acc l =
+    match l with
+      | e::l' when f e -> list_filter_firsts_aux f (acc@[e]) l'
+      | _ -> acc,l
+  in
+  list_filter_firsts_aux f [] l
+
+let count_rels_from n c =
+  let rels = free_rels c in
+  let cpt,rg = ref 0, ref n in
+  while Intset.mem !rg rels do
+    cpt:= !cpt+1; rg:= !rg+1;
+  done;
+  !cpt
+
+let count_nonfree_rels_from n c =
+  let rels = free_rels c in
+  if Intset.exists (fun x -> x >= n) rels then
+    let cpt,rg = ref 0, ref n in
+    while not (Intset.mem !rg rels) do
+      cpt:= !cpt+1; rg:= !rg+1;
+    done;
+    !cpt
+  else raise Not_found
+
+
+(* cuts a list in two parts, first of size n. Size must be greater than n *)
+let cut_list n l =
+  let rec cut_list_aux acc n l =
+    if n<=0 then acc,l
+    else match l with
+      | [] -> assert false
+      | e::l' -> cut_list_aux (acc@[e]) (n-1) l' in
+  let res = cut_list_aux [] n l in
+  res
+
+
+(* This functions splits the products of the induction scheme [elimt] in three
+   parts: 
+    - branches, easily detectable (they are not referred by rels in the subterm)
+    - what was found before branches (acc1) that is: parameters and predicates
+    - what was found after branches (acc3) that is: args and indarg if any
+   if there is no branch, we try to fill in acc3 with args/indargs.
+   We also return the conclusion.
+*)
+let decompose_paramspred_branch_args elimt = 
+  let rec cut_noccur elimt acc2 : rel_context * rel_context * types =
+    match kind_of_term elimt with
+      | Prod(nme,tpe,elimt') -> 
+	  let hd_tpe,_ = decompose_app (snd (decompose_prod_assum tpe)) in
+	  if not (occur_rel 1 elimt') && isRel hd_tpe	    
+	  then cut_noccur elimt' ((nme,None,tpe)::acc2)
+	  else let acc3,ccl = decompose_prod_assum elimt in acc2 , acc3 , ccl
+      | App(_, _) | Rel _ -> acc2 , [] , elimt
+      | _ -> error "cannot recognise an induction schema" in
+  let rec cut_occur elimt acc1 : rel_context * rel_context * rel_context * types =
+    match kind_of_term elimt with
+      | Prod(nme,tpe,c) when occur_rel 1 c -> cut_occur c ((nme,None,tpe)::acc1)
+      | Prod(nme,tpe,c) -> let acc2,acc3,ccl = cut_noccur elimt [] in acc1,acc2,acc3,ccl
+      | App(_, _) | Rel _ -> acc1,[],[],elimt
+      | _ -> error "cannot recognise an induction schema" in
+  let acc1, acc2 , acc3, ccl = cut_occur elimt [] in
+  (* Particular treatment when dealing with a dependent empty type elim scheme:
+     if there is no branch, then acc1 contains all hyps which is wrong (acc1
+     should contain parameters and predicate only). This happens for an empty
+     type (See for example Empty_set_ind, as False would actually be ok). Then
+     we must find the predicate of the conclusion to separate params_pred from
+     args. We suppose there is only one predicate here. *)
+  if List.length acc2 <> 0 then acc1, acc2 , acc3, ccl
+  else 
+    let hyps,ccl = decompose_prod_assum elimt in
+    let hd_ccl_pred,_ = decompose_app ccl in
+    match kind_of_term hd_ccl_pred with
+      | Rel i  -> let acc3,acc1 = cut_list (i-1) hyps in acc1 , [] , acc3 , ccl
+      | _ -> error "cannot recognize an induction schema"
+
+
+
+let exchange_hd_app subst_hd t =
+  let hd,args= decompose_app t in mkApp (subst_hd,Array.of_list args)
+
+
+exception NoLastArg
+exception NoLastArgCcl
+
+(* Builds an elim_scheme frome its type and calling form (const+binding) We
+   first separate branches.  We obtain branches, hyps before (params + preds),
+   hyps after (args <+ indarg if present>) and conclusion.  Then we proceed as
+   follows:
+   
+   - separate parameters and predicates in params_preds. For that we build: 
+ forall (x1:Ti_1)(xni:Ti_ni) (HI:I prm1..prmp x1...xni), DUMMY x1...xni HI/farg
+                             ^^^^^^^^^^^^^^^^^^^^^^^^^                  ^^^^^^^
+                                       optional                           opt
+     Free rels appearing in this term are parameters (branches should not
+     appear, and the only predicate would have been Qi but we replaced it by
+     DUMMY). We guess this heuristic catches all params.  TODO: generalize to
+     the case where args are merged with branches (?) and/or where several
+     predicates are cited in the conclusion.
+
+   - finish to fill in the elim_scheme: indarg/farg/args and finally indref. *)
+let compute_elim_sig ?elimc elimt =
+  let params_preds,branches,args_indargs,conclusion = 
+    decompose_paramspred_branch_args elimt in
+  
+  let ccl = exchange_hd_app (mkVar (id_of_string "__QI_DUMMY__")) conclusion in
+  let concl_with_args = it_mkProd_or_LetIn ccl args_indargs in  
+  let nparams = Intset.cardinal (free_rels concl_with_args) in
+  let preds,params = cut_list (List.length params_preds - nparams) params_preds in
+  
+  (* A first approximation, further anlysis will tweak it *)
+  let res = ref { empty_scheme with
+    (* This fields are ok: *)
+    elimc = elimc; elimt = elimt; concl = conclusion;
+    predicates = preds; npredicates = List.length preds; 
+    branches = branches; nbranches = List.length branches; 
+    farg_in_concl = (try isApp (last_arg ccl) with _ -> false);
+    params = params; nparams = nparams; 
+    (* all other fields are unsure at this point. Including these:*)
+    args = args_indargs; nargs = List.length args_indargs; } in
+  try 
+    (* Order of tests below is important. Each of them exits if successful. *)
+    (* 1- First see if (f x...) is in the conclusion. *)
+    if !res.farg_in_concl 
+    then begin
+      res := { !res with
+	indarg = None;
+	indarg_in_concl = false; farg_in_concl = true };
+      raise Exit
+    end;
+    (* 2- If no args_indargs (=!res.nargs at this point) then no indarg *)
+    if !res.nargs=0 then raise Exit; 
+    (* 3- Look at last arg: is it the indarg? *)
+    ignore (
+      match List.hd args_indargs with
+	| 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_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. *)
+	    if not (hi_is_ind & hi_args_enough) then raise Exit (* No indarg *)
+	    else (* Last arg is the indarg *)
+	      res := {!res with
+		indarg = Some (List.hd !res.args);
+		indarg_in_concl = occur_rel 1 ccl;
+		args = List.tl !res.args; nargs = !res.nargs - 1;
+	      };
+	    raise Exit);
+    raise Exit(* exit anyway *)
+  with Exit -> (* Ending by computing indrev: *)
+    match !res.indarg with
+      | None -> !res (* No indref *)
+      | Some ( _,Some _,_) -> error "Cannot recognise an induction scheme"
+      | Some ( _,None,ind) -> 
+	  let indhd,indargs = decompose_app ind in
+	  try {!res with indref = Some (global_of_constr indhd) }
+	  with _ -> error "Cannot find the inductive type of the inductive schema";;
+
 (* Check that the elimination scheme has a form similar to the 
-   elimination schemes built by Coq *)
-let compute_elim_signature elimt names_info =
-  let nparams = ref 0 in
-  let hyps,ccl = decompose_prod_assum elimt in
-  let n = List.length hyps in
-  if n = 0 then error_ind_scheme "";
-  let f,l = decompose_app ccl in
-  let _,indbody,ind = List.hd hyps in
-  if indbody <> None then error "Cannot recognise an induction scheme";
-  let nargs = List.length l in
-  let dep = (nargs >= 1 && list_last l = mkRel 1) in
-  let nrealargs = if dep then nargs-1 else nargs in
-  let args = if dep then list_firstn nrealargs l else l in
-  let realargs,hyps1 = chop_context nrealargs (List.tl hyps) in
-  if args <> extended_rel_list 1 realargs then
-    error_ind_scheme "the conclusion of";
-  let indhd,indargs = decompose_app ind in
-  let indt = 
-    try reference_of_constr indhd
-    with _ -> error "Cannot find the inductive type of the inductive schema" in
-  let nparams = List.length indargs - nrealargs in
-  let revparams, revhyps2 = chop_context nparams (List.rev hyps1) in
-  let rec check_elim npred = function
-  | (na,None,t)::l when isSort (snd (decompose_prod_assum t)) ->
-      check_elim (npred+1) l
-  | l ->
-    let is_pred n c = 
-      let hd = fst (decompose_app c) in match kind_of_term hd with
-    | Rel q when n < q & q <= n+npred -> IndArg
-    | _ when hd = indhd -> RecArg
-    | _ -> OtherArg in
-    let rec check_branch p c = match kind_of_term c with
-    | Prod (_,t,c) -> is_pred p t :: check_branch (p+1) c
-    | LetIn (_,_,_,c) -> OtherArg :: check_branch (p+1) c
-(*    | App (f,_) when is_pred p f = IndArg -> []*)
-    | _ when is_pred p c = IndArg -> []
-    | _ -> raise Exit in 
-    let rec find_branches p = function
-    | (_,None,t)::brs ->
-	(match try Some (check_branch p t) with Exit -> None with
-	 | Some l ->
-	     let n7 = List.fold_left
-	       (fun n b -> if b=IndArg then n+1 else n) 0 l in
-	     let n8 = List.fold_left
-	       (fun n b -> if b=RecArg then n+1 else n) 0 l in
-             let recvarname7, hyprecname7, avoid7 = make_up_names7 n7 indt names_info in
-             let recvarname8, hyprecname8, avoid8 = make_up_names8 n8 indt names_info in
-	     let namesign = List.map
-	       (fun b -> (b,if b=IndArg then (hyprecname7,hyprecname8)
-                else (recvarname7,recvarname8))) l in
-	     ((avoid7,avoid8),namesign) :: find_branches (p+1) brs
-	 | None -> error_ind_scheme "the branches of")
-    | (_,Some _,_)::_ -> error_ind_scheme "the branches of"
-    | [] ->
-	(* Check again conclusion *)
-	let ccl_arg_ok = is_pred (p + List.length realargs + 1) f = IndArg in
-	let ind_is_ok = 
-	  list_lastn nrealargs indargs = extended_rel_list 0 realargs in
-	if not (ccl_arg_ok & ind_is_ok) then
-	  error "Cannot recognize the conclusion of an induction schema";
-	[] in
-    find_branches 0 l in
-  nparams, indt, (Array.of_list (check_elim 0 revhyps2))
-
-let find_elim_signature isrec style elim hyp0 gl =
+   elimination schemes built by Coq. Schemes may have the standard
+   form computed from an inductive type OR (feb. 2006) a non standard
+   form. That is: with no main induction argument and with an optional
+   extra final argument of the form (f x y ...) in the conclusion. In
+   the non standard case, naming of generated hypos is slightly
+   different. *)
+let compute_elim_signature elimc elimt names_info =
+  let scheme = compute_elim_sig ~elimc:elimc elimt in
+  let f,l = decompose_app scheme.concl in
+  (* Vérifier que les arguments de Qi sont bien les xi. *)
+  match scheme.indarg with
+    | Some (_,Some _,_) -> error "strange letin, cannot recognize an induction schema"
+    | None -> (* Non standard scheme *)
+	let npred = List.length scheme.predicates in 
+	let is_pred n c = 
+	  let hd = fst (decompose_app c) in match kind_of_term hd with
+	    | Rel q when n < q & q <= n+npred -> IndArg
+	    | _ -> OtherArg in 
+	let rec check_branch p c = 
+	  match kind_of_term c with
+	    | Prod (_,t,c) -> is_pred p t :: check_branch (p+1) c
+	    | LetIn (_,_,_,c) -> OtherArg :: check_branch (p+1) c
+	    | _ when is_pred p c = IndArg -> []
+	    | _ -> raise Exit in 
+	let rec find_branches p lbrch = 
+	  match lbrch with
+	    | (_,None,t)::brs ->
+		(try
+		  let lchck_brch = check_branch p t in
+		  let n = List.fold_left 
+		    (fun n b -> if b=RecArg then n+1 else n) 0 lchck_brch in
+		  let recvarname, hyprecname, avoid = 
+		    make_up_names n scheme.indref names_info in
+		  let namesign = 
+		    List.map (fun b -> (b,if b=IndArg then hyprecname else recvarname))
+		      lchck_brch in
+		  (avoid,namesign) :: find_branches (p+1) brs
+		with Exit-> error_ind_scheme "the branches of")
+	    | (_,Some _,_)::_ -> error_ind_scheme "the branches of"
+	    | [] -> [] in
+	let indsign = Array.of_list (find_branches 0 (List.rev scheme.branches)) in
+	indsign,scheme	
+	
+    | Some ( _,None,ind) -> (* Standard scheme from an inductive type *)
+	let indhd,indargs = decompose_app ind in
+	let npred = List.length scheme.predicates in
+	let is_pred n c = 
+	  let hd = fst (decompose_app c) in match kind_of_term hd with
+	    | Rel q when n < q & q <= n+npred -> IndArg
+	    | _ when hd = indhd -> RecArg
+	    | _ -> OtherArg in
+	let rec check_branch p c = match kind_of_term c with
+	  | Prod (_,t,c) -> is_pred p t :: check_branch (p+1) c
+	  | LetIn (_,_,_,c) -> OtherArg :: check_branch (p+1) c
+	  | _ when is_pred p c = IndArg -> []
+	  | _ -> raise Exit in 
+	let rec find_branches p lbrch =
+	  match lbrch with
+	    | (_,None,t)::brs ->
+		(try
+		  let lchck_brch = check_branch p t in
+		  let n = List.fold_left 
+		    (fun n b -> if b=RecArg then n+1 else n) 0 lchck_brch in
+		  let recvarname, hyprecname, avoid = 
+		    make_up_names n scheme.indref names_info in
+		  let namesign = 
+		    List.map (fun b -> (b,if b=IndArg then hyprecname else recvarname))
+		      lchck_brch in
+		  (avoid,namesign) :: find_branches (p+1) brs
+		with Exit -> error_ind_scheme "the branches of")
+	    | (_,Some _,_)::_ -> error_ind_scheme "the branches of"
+	    | [] ->
+		(* Check again conclusion *)
+
+		let ccl_arg_ok = is_pred (p + scheme.nargs + 1) f = IndArg in
+		let ind_is_ok = 
+		  list_lastn scheme.nargs indargs 
+		  = extended_rel_list 0 scheme.args in
+		if not (ccl_arg_ok & ind_is_ok) then
+		  error "Cannot recognize the conclusion of an induction schema";
+		[] 
+	in
+	let indsign = Array.of_list (find_branches 0 (List.rev scheme.branches)) in
+	indsign,scheme
+
+
+let find_elim_signature isrec elim hyp0 gl =
   let tmptyp0 =	pf_get_hyp_typ gl hyp0 in
   let (elimc,elimt) = match elim with
     | None ->
 	let mind,_ = pf_reduce_to_quantified_ind gl tmptyp0 in
 	let s = elimination_sort_of_goal gl in
 	let elimc =
-	  if isrec then Indrec.lookup_eliminator mind s
-	  else pf_apply Indrec.make_case_gen gl mind s in
+	  if isrec then lookup_eliminator mind s
+	  else pf_apply make_case_gen gl mind s in
 	let elimt = pf_type_of gl elimc in
 	((elimc, NoBindings), elimt)
     | Some (elimc,lbind as e) -> 
 	(e, pf_type_of gl elimc) in
-  let name_info = (style,hyp0) in
-  let nparams,indref,indsign = compute_elim_signature elimt name_info in
-  (elimc,elimt,nparams,indref,indsign)
+  let indsign,elim_scheme = compute_elim_signature elimc elimt hyp0 in
+  (indsign,elim_scheme)
+
+
+let mapi f l =
+  let rec mapi_aux f i l =   
+    match l with
+      | [] -> []
+      | e::l' -> f e i :: mapi_aux f (i+1) l' in
+  mapi_aux f 0 l
+
+
+(* Instanciate all meta variables of elimclause using lid, some elts
+   of lid are parameters (first ones), the other are
+   arguments. Returns the clause obtained.  *)
+let recolle_clenv scheme lid elimclause gl = 
+  let _,arr = destApp elimclause.templval.rebus in
+  let lindmv = 
+    Array.map
+      (fun x -> 
+	match kind_of_term x with
+	  | Meta mv -> mv
+	  | _  -> errorlabstrm "elimination_clause"
+              (str "The type of elimination clause is not well-formed"))
+      arr in
+  let nmv = Array.length lindmv in
+  let lidparams,lidargs = cut_list (scheme.nparams) lid in
+  let nidargs = List.length lidargs in
+  (* parameters correspond to first elts of lid. *)
+  let clauses_params = 
+    mapi (fun id i -> mkVar id , pf_get_hyp_typ gl id , lindmv.(i)) lidparams in
+  (* arguments correspond to last elts of lid. *)
+  let clauses_args = 
+    mapi 
+      (fun id i -> mkVar id , pf_get_hyp_typ gl id , lindmv.(nmv-nidargs+i))
+      lidargs in
+  let clause_indarg = 
+    match scheme.indarg with
+      | None -> []
+      | Some (x,_,typx) -> []
+  in
+  let clauses = clauses_params@clauses_args@clause_indarg in
+  (* iteration of clenv_fchain with all infos we have. *)
+  List.fold_right
+    (fun e acc ->
+      let x,y,i = e in
+      (* from_n (Some 0) means that x should be taken "as is" without
+         trying to unify (which would lead to trying to apply it to
+         evars if y is a product). *)
+      let indclause  = mk_clenv_from_n gl (Some 0) (x,y) in
+      let elimclause' = clenv_fchain i acc indclause in
+      elimclause')
+    (List.rev clauses)
+    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.
+*)
+let induction_tac_felim indvars (* (elimc,lbindelimc) elimt *) scheme gl = 
+  let elimt = scheme.elimt in
+  let elimc,lbindelimc = 
+    match scheme.elimc with | Some x -> x | None -> error "No definition of the principle" in
+  (* elimclause contains this: (elimc ?i ?j ?k...?l) *)
+  let elimclause =
+    make_clenv_binding gl (mkCast (elimc,DEFAULTcast, elimt),elimt) lbindelimc in
+  (* elimclause' is built from elimclause by instanciating all args and params. *)
+  let elimclause' = recolle_clenv scheme indvars elimclause gl in
+  (* one last resolution (useless?) *)
+  let resolved = clenv_unique_resolver true elimclause' gl in
+  clenv_refine resolved gl
+
+(* Induction with several induction arguments, main differences with
+   induction_from_context is that there is no main induction argument,
+   so we chose one to be the positioning reference. On the other hand,
+   all args and params must be given, so we help a bit the unifier by
+   making the "pattern" by hand before calling induction_tac_felim
+   FIXME: REUNIF AVEC induction_tac_felim? *)
+let induction_from_context_l isrec elim_info lid names gl =
+  let indsign,scheme = elim_info in
+  (* number of all args, counting farg and indarg if present. *)
+  let nargs_indarg_farg = scheme.nargs
+    + (if scheme.farg_in_concl then 1 else 0) 
+    + (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";  
+  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
+     induct. It is probably the first of them appearing in the
+     context. *)
+  let hyp0,indvars,lid_params = 
+    match lid with
+      | []  -> anomaly "induction_from_context_l"
+      | e::l -> 
+	  let nargs_without_first = nargs_indarg_farg - 1 in
+	  let ivs,lp = cut_list nargs_without_first l in
+	  e, ivs, lp in
+  let statlists,lhyp0,indhyps,deps = cook_sign None (hyp0::indvars) env in
+  let tmpcl = it_mkNamedProd_or_LetIn (pf_concl gl) deps in
+  let names = compute_induction_names (Array.length indsign) names in
+  let dephyps = List.map (fun (id,_,_) -> id) deps in
+  let deps_cstr =
+    List.fold_left (fun a (id,b,_) -> if b = None then (mkVar id)::a else a) [] deps in
+  (* terms to patternify we must patternify indarg or farg if present in concl *)
+  let lid_in_pattern = 
+    if scheme.indarg <> None & not scheme.indarg_in_concl then List.rev indvars
+    else List.rev (hyp0::indvars) in
+  let lidcstr = List.map (fun x -> mkVar x) lid_in_pattern in
+  let realindvars = (* hyp0 is a real induction arg if it is not the
+		       farg in the conclusion of the induction scheme *)
+    List.rev ((if scheme.farg_in_concl then indvars else hyp0::indvars) @ lid_params) in
+  (* Magistral effet de bord: comme dans induction_from_context. *)
+  tclTHENLIST
+    [ 
+      (* Generalize dependent hyps (but not args) *)
+      if deps = [] then tclIDTAC else apply_type tmpcl deps_cstr;
+      thin dephyps; (* clear dependent hyps *)
+      (* pattern to make the predicate appear. *)
+      reduce (Pattern (List.map (fun e -> ([],e)) lidcstr)) onConcl;
+      (* FIXME: Tester ca avec un principe dependant et non-dependant *)
+      (if isrec then tclTHENFIRSTn else tclTHENLASTn)
+       	(tclTHENLIST [ 
+	  (* Induction by "refine (indscheme ?i ?j ?k...)" + resolution of all
+	     possible holes using arguments given by the user (but the
+	     functional one). *)
+	  induction_tac_felim realindvars scheme;
+          tclTRY (thin (List.rev (indhyps)));
+	])
+	(array_map2 
+	  (induct_discharge statlists lhyp0 (List.rev dephyps)) indsign names)
+    ]
+    gl
+
+
 
-let induction_from_context isrec elim_info hyp0 (names,b_rnames) gl =
+let induction_from_context isrec elim_info hyp0 names gl =
   (*test suivant sans doute inutile car refait par le letin_tac*)
   if List.mem hyp0 (ids_of_named_context (Global.named_context())) then
     errorlabstrm "induction" 
       (str "Cannot generalize a global variable");
-  let elimc,elimt,nparams,indref,indsign = elim_info in
+  let indsign,scheme = elim_info in
+
+  let indref = match scheme.indref with | None -> assert false | Some x -> x in
   let tmptyp0 =	pf_get_hyp_typ gl hyp0 in
   let typ0 = pf_apply reduce_to_quantified_ref gl indref tmptyp0 in
+
   let env = pf_env gl in
-  let indvars = find_atomic_param_of_ind nparams (snd (decompose_prod typ0)) in
-  let (statlists,lhyp0,indhyps,deps) = cook_sign hyp0 indvars env in
+  let indvars = find_atomic_param_of_ind scheme.nparams (snd (decompose_prod typ0)) in
+  (* induction_from_context_l isrec elim_info (hyp0::List.rev indvars) names gl  *)
+  let statlists,lhyp0,indhyps,deps = cook_sign (Some hyp0) indvars env in
   let tmpcl = it_mkNamedProd_or_LetIn (pf_concl gl) deps in
   let names = compute_induction_names (Array.length indsign) names in
-  (* For translator *)
-  let names' = Array.map ref (Array.make (Array.length indsign) []) in
-  let b = ref false in
-  b_rnames := (b,Array.to_list names')::!b_rnames;
-  let names = array_map2 (fun n n' -> (n,b,n')) names names' in
-  (* End translator *)
   let dephyps = List.map (fun (id,_,_) -> id) deps in
-  let args =
+  let deps_cstr =
     List.fold_left
       (fun a (id,b,_) -> if b = None then (mkVar id)::a else a) [] deps in
 
@@ -1590,11 +1938,11 @@ let induction_from_context isrec elim_info hyp0 (names,b_rnames) gl =
      "ind_rec ... (hyp0 ?)", les buts correspondant à des arguments de
      hyp0 sont maintenant à la fin et c'est tclTHENFIRSTn qui marche !!! *)
   tclTHENLIST
-    [ if deps = [] then tclIDTAC else apply_type tmpcl args;
+    [ if deps = [] then tclIDTAC else apply_type tmpcl deps_cstr;
       thin dephyps;
       (if isrec then tclTHENFIRSTn else tclTHENLASTn)
        	(tclTHENLIST
-	  [ induction_tac hyp0 typ0 (elimc,elimt);
+	  [ induction_tac hyp0 typ0 scheme (*scheme.elimc,scheme.elimt*);
 	    thin [hyp0];
             tclTRY (thin indhyps) ])
        	(array_map2
@@ -1602,15 +1950,38 @@ let induction_from_context isrec elim_info hyp0 (names,b_rnames) gl =
     ]
     gl
 
+
+
+exception TryNewInduct of exn
+
 let induction_with_atomization_of_ind_arg isrec elim names hyp0 gl =
-  let (elimc,elimt,nparams,indref,indsign as elim_info) =
-    find_elim_signature isrec false elim hyp0 gl in
-  tclTHEN
-    (atomize_param_of_ind (indref,nparams) hyp0)
-    (induction_from_context isrec elim_info hyp0 names) gl
+  let (indsign,scheme as elim_info) = find_elim_signature isrec elim hyp0 gl in
+  if scheme.indarg = None then (* This is not a standard induction scheme (the
+				  argument is probably a parameter) So try the
+				  more general induction mechanism. *)
+    induction_from_context_l isrec elim_info [hyp0] names gl
+  else
+    let indref = match scheme.indref with | None -> assert false | Some x -> x in
+    tclTHEN
+      (atomize_param_of_ind (indref,scheme.nparams) hyp0)
+      (induction_from_context isrec elim_info hyp0 names) gl
+
+(* Induction on a list of induction arguments. Analyse the elim
+   scheme (which is mandatory for multiple ind args), check that all
+   parameters and arguments are given (mandatory too). *)
+let induction_without_atomization isrec elim names lid gl =
+  let (indsign,scheme as elim_info) =
+    find_elim_signature isrec elim (List.hd lid) gl in
+  let awaited_nargs = 
+    scheme.nparams + scheme.nargs 
+    + (if scheme.farg_in_concl then 1 else 0)
+    + (if scheme.indarg <> None then 1 else 0)
+  in
+  let nlid = List.length lid in
+  if nlid <> awaited_nargs
+  then error "Not the right number of induction arguments"
+  else induction_from_context_l isrec elim_info lid names gl
 
-(* This is Induction since V7 ("natural" induction both in quantified
-   premisses and introduced ones) *)
 let new_induct_gen isrec elim names c gl =
   match kind_of_term c with
     | Var id when not (mem_named_context id (Global.named_context())) ->
@@ -1623,18 +1994,119 @@ let new_induct_gen isrec elim names c gl =
 	  (letin_tac true (Name id) c allClauses)
 	  (induction_with_atomization_of_ind_arg isrec elim names id) gl
 
-let new_induct_destruct isrec c elim names = match c with
-  | ElimOnConstr c -> new_induct_gen isrec elim names c
-  | ElimOnAnonHyp n ->
-      tclTHEN (intros_until_n n)
-        (tclLAST_HYP (new_induct_gen isrec elim names))
-  (* Identifier apart because id can be quantified in goal and not typable *)
-  | ElimOnIdent (_,id) ->
-      tclTHEN (tclTRY (intros_until_id id))
-        (new_induct_gen isrec elim names (mkVar id))
+(* The two following functions should already exist, but found nowhere *)
+(* Unfolds x by its definition everywhere *)
+let unfold_body x gl =
+  let hyps = pf_hyps gl in
+  let xval =
+    match Sign.lookup_named x hyps with
+        (_,Some xval,_) -> xval
+      | _ -> errorlabstrm "unfold_body"
+          (pr_id x ++ str" is not a defined hypothesis") in
+  let aft = afterHyp x gl in
+  let hl = List.fold_right (fun (y,yval,_) cl -> (y,[],InHyp) :: cl) aft [] in
+  let xvar = mkVar x in
+  let rfun _ _ c = replace_term xvar xval c in
+  tclTHENLIST
+    [tclMAP (fun h -> reduct_in_hyp rfun h) hl;
+     reduct_in_concl (rfun,DEFAULTcast)] gl
+
+(* Unfolds x by its definition everywhere and clear x. This may raise
+   an error if x is not defined. *)
+let unfold_all x gl =
+  let (_,xval,_) = pf_get_hyp gl x in
+  (* If x has a body, simply replace x with body and clear x *)
+  if xval <> None then tclTHEN (unfold_body x) (clear [x]) gl
+  else tclIDTAC gl
+
+
+(* Induction on a list of arguments. First make induction arguments
+   atomic (using letins), then do induction. The specificity here is
+   that all arguments and parameters of the scheme are given
+   (mandatory for the moment), so we don't need to deal with
+    parameters of the inductive type as in new_induct_gen. *)
+let new_induct_gen_l isrec elim names lc gl =
+  let newlc = ref [] in
+  let letids = ref [] in
+  let rec atomize_list l gl =
+    match l with
+      | [] -> tclIDTAC gl
+      | c::l' ->
+	  match kind_of_term c with
+	    | Var id when not (mem_named_context id (Global.named_context())) -> 
+		let _ = newlc:= id::!newlc in
+		atomize_list l' gl
+
+	    | _ ->
+		let x = 
+		  id_of_name_using_hdchar (Global.env()) (pf_type_of gl c) Anonymous in
+		
+		let id = fresh_id [] x gl in
+		let newl' = List.map (replace_term c (mkVar id)) l' in
+		let _ = newlc:=id::!newlc in
+		let _ = letids:=id::!letids in
+		tclTHEN 
+		  (letin_tac true (Name id) c allClauses)
+		  (atomize_list newl') gl in
+  tclTHENLIST 
+    [
+      (atomize_list lc);
+      (fun gl' -> (* recompute each time to have the new value of newlc *)
+	induction_without_atomization isrec elim names !newlc gl') ;
+      (* after induction, try to unfold all letins created by atomize_list
+         FIXME: unfold_all does not exist anywhere else? *)
+      (fun gl' -> (* recompute each time to have the new value of letids *)
+	tclMAP (fun x -> tclTRY (unfold_all x)) !letids gl')
+    ]
+    gl
 
-let new_induct = new_induct_destruct true
-let new_destruct = new_induct_destruct false
+
+let induct_destruct_l isrec lc elim names = 
+  (* Several induction hyps: induction scheme is mandatory *)
+  let _ = 
+    if elim = None 
+    then 
+      error ("Induction scheme must be given when several induction hypothesis.\n"
+      ^ "Example: induction x1 x2 x3 using my_scheme.") in
+  let newlc = 
+    List.map
+      (fun x -> 
+	match x with (* FIXME: should we deal with ElimOnIdent? *)
+	  | ElimOnConstr x -> x
+	  | _ -> error "don't know where to find some argument")
+      lc in
+  new_induct_gen_l isrec elim names newlc
+
+
+(* Induction either over a term, over a quantified premisse, or over
+   several quantified premisses (like with functional induction
+   principles). 
+   TODO: really unify induction with one and induction with several
+   args *)
+let induct_destruct isrec lc elim names = 
+  assert (List.length lc > 0); (* ensured by syntax, but if called inside caml? *)
+  if List.length lc = 1 then (* induction on one arg: use old mechanism *)
+    try 
+      let c = List.hd lc in
+      match c with
+	| ElimOnConstr c -> new_induct_gen isrec elim names c
+	| ElimOnAnonHyp n ->
+	    tclTHEN (intros_until_n n)
+	      (tclLAST_HYP (new_induct_gen isrec elim names))
+	      (* Identifier apart because id can be quantified in goal and not typable *)
+	| ElimOnIdent (_,id) ->
+	    tclTHEN (tclTRY (intros_until_id id))
+	      (new_induct_gen isrec elim names (mkVar id))
+    with (* If this fails, try with new mechanism but if it fails too,
+	    then the exception is the first one. *)
+      | x -> (try induct_destruct_l isrec lc elim names with _  -> raise x)
+  else induct_destruct_l isrec lc elim names
+
+
+      
+
+let new_induct = induct_destruct true
+let new_destruct = induct_destruct false
 
 (* The registered tactic, which calls the default elimination
  * if no elimination constant is provided. *)
@@ -1645,23 +2117,12 @@ let new_destruct = new_induct_destruct false
 let raw_induct s = tclTHEN (intros_until_id s) (tclLAST_HYP simplest_elim)
 let raw_induct_nodep n = tclTHEN (intros_until_n n) (tclLAST_HYP simplest_elim)
 
-(* This was Induction in 6.3 (hybrid form) *)
-let induction_from_context_old_style hyp b_ids gl =
-  let elim_info = find_elim_signature true true None hyp gl in
-  let x = induction_from_context true elim_info hyp (None,b_ids) gl in
-  (* For translator *) fst (List.hd !b_ids) := true;
-  x
-
-let simple_induct_id hyp b_ids =
-  if !Options.v7 then
-    tclORELSE (raw_induct hyp) (induction_from_context_old_style hyp b_ids)
-  else
-    raw_induct hyp
+let simple_induct_id hyp = raw_induct hyp
 let simple_induct_nodep = raw_induct_nodep
 
 let simple_induct = function
-  | NamedHyp id,b_ids -> simple_induct_id id b_ids
-  | AnonHyp n,_ -> simple_induct_nodep n
+  | NamedHyp id -> simple_induct_id id
+  | AnonHyp n -> simple_induct_nodep n
 
 (* Destruction tactics *)
 
@@ -1682,25 +2143,25 @@ let simple_destruct = function
  *)
 
 let elim_scheme_type elim t gl =
-  let (wc,kONT) = startWalk gl in
-  let clause = mk_clenv_type_of wc elim in 
-  match kind_of_term (last_arg (clenv_template clause).rebus) with
+  let clause = mk_clenv_type_of gl elim in
+  match kind_of_term (last_arg clause.templval.rebus) with
     | Meta mv ->
         let clause' =
 	  (* t is inductive, then CUMUL or CONV is irrelevant *)
-	  clenv_unify true CUMUL t (clenv_instance_type clause mv) clause in
-	elim_res_pf kONT clause' true gl
+	  clenv_unify true Reduction.CUMUL t
+            (clenv_meta_type clause mv) clause in
+	res_pf clause' ~allow_K:true gl
     | _ -> anomaly "elim_scheme_type"
 
 let elim_type t gl =
   let (ind,t) = pf_reduce_to_atomic_ind gl t in
-  let elimc = Indrec.lookup_eliminator ind (elimination_sort_of_goal gl) in
+  let elimc = lookup_eliminator ind (elimination_sort_of_goal gl) in
   elim_scheme_type elimc t gl
 
 let case_type t gl =
   let (ind,t) = pf_reduce_to_atomic_ind gl t in
   let env = pf_env gl in
-  let elimc = Indrec.make_case_gen env (project gl) ind (elimination_sort_of_goal gl) in 
+  let elimc = make_case_gen env (project gl) ind (elimination_sort_of_goal gl) in 
   elim_scheme_type elimc t gl
 
 
@@ -1773,9 +2234,12 @@ let dImp cls =
 
 (* Reflexivity tactics *)
 
+let setoid_reflexivity = ref (fun _ -> assert false)
+let register_setoid_reflexivity f = setoid_reflexivity := f
+
 let reflexivity gl =
   match match_with_equation (pf_concl gl) with
-    | None -> error "The conclusion is not a substitutive equation" 
+    | None -> !setoid_reflexivity gl
     | Some (hdcncl,args) ->  one_constructor 1 NoBindings gl
 
 let intros_reflexivity  = (tclTHEN intros reflexivity)
@@ -1787,9 +2251,12 @@ let intros_reflexivity  = (tclTHEN intros reflexivity)
    defined and the conclusion is a=b, it solves the goal doing (Cut
    b=a;Intro H;Case H;Constructor 1) *)
 
+let setoid_symmetry = ref (fun _ -> assert false)
+let register_setoid_symmetry f = setoid_symmetry := f
+
 let symmetry gl =
   match match_with_equation (pf_concl gl) with
-    | None -> error "The conclusion is not a substitutive equation" 
+    | None -> !setoid_symmetry gl
     | Some (hdcncl,args) ->
         let hdcncls = string_of_inductive hdcncl in
         begin 
@@ -1810,12 +2277,14 @@ let symmetry gl =
 	      gl
 	end
 
+let setoid_symmetry_in = ref (fun _ _ -> assert false)
+let register_setoid_symmetry_in f = setoid_symmetry_in := f
+
 let symmetry_in id gl = 
   let ctype = pf_type_of gl (mkVar id) in 
   let sign,t = decompose_prod_assum ctype in
   match match_with_equation t with
-    | None -> (* Do not deal with setoids yet *) 
-        error "The term provided does not end with an equation" 
+    | None -> !setoid_symmetry_in id gl
     | Some (hdcncl,args) -> 
         let symccl = match args with 
 	  | [t1; c1; t2; c2] -> mkApp (hdcncl, [| t2; c2; t1; c1 |])
@@ -1845,9 +2314,12 @@ let intros_symmetry =
    --Eduardo (19/8/97)
 *)
 
+let setoid_transitivity = ref (fun _ _ -> assert false)
+let register_setoid_transitivity f = setoid_transitivity := f
+
 let transitivity t gl =
   match match_with_equation (pf_concl gl) with
-    | None -> error "The conclusion is not a substitutive equation" 
+    | None -> !setoid_transitivity t gl
     | Some (hdcncl,args) -> 
         let hdcncls = string_of_inductive hdcncl in
         begin
@@ -1886,7 +2358,6 @@ let interpretable_as_section_decl d1 d2 = match d1,d2 with
   | (_,None,t1), (_,_,t2) -> eq_constr t1 t2
 
 let abstract_subproof name tac gls = 
-  let env = Global.env() in
   let current_sign = Global.named_context()
   and global_sign = pf_hyps gls in
   let sign,secsign = 
@@ -1894,16 +2365,15 @@ let abstract_subproof name tac gls =
       (fun (id,_,_ as d) (s1,s2) -> 
 	 if mem_named_context id current_sign &
            interpretable_as_section_decl (Sign.lookup_named id current_sign) d
-         then (s1,add_named_decl d s2)
+         then (s1,push_named_context_val d s2)
 	 else (add_named_decl d s1,s2)) 
-      global_sign (empty_named_context,empty_named_context) in
+      global_sign (empty_named_context,empty_named_context_val) in
   let na = next_global_ident_away false name (pf_ids_of_hyps gls) in
   let concl = it_mkNamedProd_or_LetIn (pf_concl gls) sign in
   if occur_existential concl then
-    if !Options.v7 then error "Abstract cannot handle existentials"
-    else error "\"abstract\" cannot handle existentials";
+    error "\"abstract\" cannot handle existentials";
   let lemme =
-    start_proof na (IsGlobal (Proof Lemma)) secsign concl (fun _ _ -> ());
+    start_proof na (Global, Proof Lemma) secsign concl (fun _ _ -> ());
     let _,(const,kind,_) =
       try
 	by (tclCOMPLETE (tclTHEN (tclDO (List.length sign) intro) tac)); 
@@ -1913,9 +2383,8 @@ let abstract_subproof name tac gls =
 	(delete_current_proof(); raise e)
     in   (* Faudrait un peu fonctionnaliser cela *)
     let cd = Entries.DefinitionEntry const in
-    let sp = Declare.declare_internal_constant na (cd,IsProof Lemma) in
-    let newenv = Global.env() in
-    constr_of_reference (ConstRef (snd sp))
+    let con = Declare.declare_internal_constant na (cd,IsProof Lemma) in
+    constr_of_global (ConstRef con)
   in
   exact_no_check 
     (applist (lemme, 
@@ -1928,3 +2397,29 @@ let tclABSTRACT name_op tac gls =
     | None   -> add_suffix (get_current_proof_name ()) "_subproof" 
   in  
   abstract_subproof s tac gls
+
+
+let admit_as_an_axiom gls =
+  let current_sign = Global.named_context()
+  and global_sign = pf_hyps gls in
+  let sign,secsign = 
+    List.fold_right
+      (fun (id,_,_ as d) (s1,s2) -> 
+	 if mem_named_context id current_sign &
+           interpretable_as_section_decl (Sign.lookup_named id current_sign) d
+         then (s1,add_named_decl d s2)
+	 else (add_named_decl d s1,s2)) 
+      global_sign (empty_named_context,empty_named_context) in
+  let name = add_suffix (get_current_proof_name ()) "_admitted" in
+  let na = next_global_ident_away false name (pf_ids_of_hyps gls) in
+  let concl = it_mkNamedProd_or_LetIn (pf_concl gls) sign in
+  if occur_existential concl then error "\"admit\" cannot handle existentials";
+  let axiom =
+    let cd = Entries.ParameterEntry concl in
+    let con = Declare.declare_internal_constant na (cd,IsAssumption Logical) in
+    constr_of_global (ConstRef con)
+  in
+  exact_no_check 
+    (applist (axiom, 
+              List.rev (Array.to_list (instance_from_named_context sign))))
+    gls
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index 1155d845..5d04da9a 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,v 1.59.2.2 2005/01/21 16:41:52 herbelin Exp $ i*)
+(*i $Id: tactics.mli 8698 2006-04-11 15:12:48Z jforest $ i*)
 
 (*i*)
 open Names
@@ -19,7 +19,7 @@ open Reduction
 open Evd
 open Evar_refiner
 open Clenv
-open Tacred
+open Redexpr
 open Tacticals
 open Libnames
 open Genarg
@@ -32,7 +32,7 @@ open Rawterm
 
 (*s General functions. *)
 
-val type_clenv_binding : named_context sigma ->
+val type_clenv_binding : goal sigma ->
   constr * constr -> constr bindings  -> constr
 
 val string_of_inductive : constr -> string
@@ -46,7 +46,7 @@ exception Bound
 
 val introduction    : identifier -> tactic
 val refine          : constr -> tactic
-val convert_concl   : constr -> tactic
+val convert_concl   : constr -> cast_kind -> tactic
 val convert_hyp     : named_declaration -> tactic
 val thin            : identifier list -> tactic
 val mutual_fix      :
@@ -63,6 +63,9 @@ val intro                : tactic
 val introf               : tactic
 val intro_force          : bool -> tactic
 val intro_move           : identifier option -> identifier option -> tactic
+  (* [intro_avoiding idl] acts as intro but prevents the new identifier
+     to belong to [idl] *)
+val intro_avoiding       : identifier list -> tactic
 
 val intro_replacing      : identifier -> tactic
 val intro_using          : identifier -> tactic
@@ -110,8 +113,8 @@ val exact_proof      : Topconstr.constr_expr -> tactic
 type tactic_reduction = env -> evar_map -> constr -> constr
 
 val reduct_in_hyp     : tactic_reduction -> hyp_location -> tactic
-val reduct_option     : tactic_reduction -> simple_clause -> tactic
-val reduct_in_concl   : tactic_reduction -> tactic
+val reduct_option     : tactic_reduction * cast_kind -> simple_clause -> tactic
+val reduct_in_concl   : tactic_reduction * cast_kind -> tactic
 val change_in_concl   : constr occurrences option -> constr -> tactic
 val change_in_hyp     : constr occurrences option -> constr -> hyp_location ->
   tactic
@@ -124,9 +127,10 @@ val hnf_option        : simple_clause -> tactic
 val simpl_in_concl    : tactic
 val simpl_in_hyp      : hyp_location        -> tactic
 val simpl_option      : simple_clause -> tactic
-val normalise_in_concl: tactic
+val normalise_in_concl : tactic
 val normalise_in_hyp  : hyp_location        -> tactic
 val normalise_option  : simple_clause -> tactic
+val normalise_vm_in_concl : tactic
 val unfold_in_concl   : (int list * evaluable_global_reference) list -> tactic
 val unfold_in_hyp     : 
   (int list * evaluable_global_reference) list -> hyp_location -> tactic
@@ -144,6 +148,7 @@ val pattern_option  : (int list * constr) list -> simple_clause -> tactic
 
 val clear         : identifier list -> tactic
 val clear_body    : identifier list -> tactic
+val keep          : identifier list -> tactic
 
 val new_hyp       : int option -> constr with_bindings -> tactic
 
@@ -165,21 +170,67 @@ val cut_and_apply         : constr -> tactic
 
 (*s Elimination tactics. *)
 
-val general_elim  : constr with_bindings -> constr with_bindings -> 
-  ?allow_K:bool -> tactic
+
+(*
+   The general form of an induction principle is the following:
+   
+   forall prm1 prm2 ... prmp,                          (induction parameters)
+   forall Q1...,(Qi:Ti_1 -> Ti_2 ->...-> Ti_ni),...Qq, (predicates)
+   branch1, branch2, ... , branchr,                    (branches of the principle)
+   forall (x1:Ti_1) (x2:Ti_2) ... (xni:Ti_ni),         (induction arguments)
+   (HI: I prm1..prmp x1...xni)                         (optional main induction arg)
+   -> (Qi x1...xni HI        (f prm1...prmp x1...xni)).(conclusion)
+                   ^^        ^^^^^^^^^^^^^^^^^^^^^^^^
+               optional                optional
+               even if HI      argument added if principle
+             present above   generated by functional induction
+             [indarg]          [farg]
+
+  HI is not present when the induction principle does not come directly from an
+  inductive type (like when it is generated by functional induction for
+  example). HI is present otherwise BUT may not appear in the conclusion
+  (dependent principle). HI and (f...) cannot be both present.
+
+  Principles taken from functional induction have the final (f...).
+*)
+
+(* [rel_contexts] and [rel_declaration] actually contain triples, and
+   lists are actually in reverse order to fit [compose_prod]. *)
+type elim_scheme = { 
+  elimc: (Term.constr * constr Rawterm.bindings) option;
+  elimt: types;
+  indref: global_reference option;
+  params: rel_context;     (* (prm1,tprm1);(prm2,tprm2)...(prmp,tprmp) *)
+  nparams: int;            (* number of parameters *)
+  predicates: rel_context; (* (Qq, (Tq_1 -> Tq_2 ->...-> Tq_nq)), (Q1,...) *)
+  npredicates: int;        (* Number of predicates *)
+  branches: rel_context;   (* branchr,...,branch1 *)
+  nbranches: int;          (* Number of branches *) 
+  args: rel_context;       (* (xni, Ti_ni) ... (x1, Ti_1) *)
+  nargs: int;              (* number of arguments *)
+  indarg: rel_declaration option; (* Some (H,I prm1..prmp x1...xni) 
+				     if HI is in premisses, None otherwise *)
+  concl: types;            (* Qi x1...xni HI (f...), HI and (f...) 
+			      are optional and mutually exclusive *)
+  indarg_in_concl: bool;   (* true if HI appears at the end of conclusion *)
+  farg_in_concl: bool;     (* true if (f...) appears at the end of conclusion *)
+}
+
+
+val compute_elim_sig : ?elimc: (Term.constr * constr Rawterm.bindings) -> types -> elim_scheme
+
+val general_elim  :
+  constr with_bindings -> constr with_bindings -> ?allow_K:bool -> tactic
+val general_elim_in :
+  identifier -> constr with_bindings -> constr with_bindings -> tactic
+
 val default_elim  : constr with_bindings -> tactic
 val simplest_elim : constr -> tactic
 val elim          : constr with_bindings -> constr with_bindings option -> tactic
-val general_elim_in : identifier -> constr * constr bindings ->
-                      constr * constr bindings -> tactic
+val simple_induct : quantified_hypothesis -> tactic
 
-val simple_induct     : quantified_hypothesis * (bool ref * intro_pattern_expr list ref list) list ref -> tactic
-val general_elim_in : identifier -> constr * constr bindings ->
-                      constr * constr bindings -> tactic
-
-val new_induct : constr induction_arg -> constr with_bindings option ->
-  intro_pattern_expr option * (bool ref * intro_pattern_expr list ref list) list ref
-  -> tactic
+val new_induct : constr induction_arg list -> constr with_bindings option ->
+  intro_pattern_expr -> tactic
 
 (*s Case analysis tactics. *)
 
@@ -187,9 +238,8 @@ val general_case_analysis : constr with_bindings ->  tactic
 val simplest_case         : constr -> tactic
 
 val simple_destruct          : quantified_hypothesis -> tactic
-val new_destruct : constr induction_arg -> constr with_bindings option ->
-  intro_pattern_expr option * (bool ref * intro_pattern_expr list ref list) list ref
-  -> tactic
+val new_destruct : constr induction_arg list -> constr with_bindings option ->
+  intro_pattern_expr -> tactic
 
 (*s Eliminations giving the type instead of the proof. *)
 
@@ -221,26 +271,36 @@ val simplest_split             : tactic
 
 (*s Logical connective tactics. *)
 
+val register_setoid_reflexivity : tactic -> unit
 val reflexivity                 : tactic
 val intros_reflexivity          : tactic
 
+val register_setoid_symmetry : tactic -> unit
 val symmetry                    : tactic
+val register_setoid_symmetry_in : (identifier -> tactic) -> unit
 val symmetry_in                 : identifier -> tactic
 val intros_symmetry             : clause -> tactic
 
+val register_setoid_transitivity : (constr -> tactic) -> unit
 val transitivity                : constr -> tactic
 val intros_transitivity         : constr -> tactic
 
 val cut                         : constr -> tactic
 val cut_intro                   : constr -> tactic
-val cut_replacing               : identifier -> constr -> tactic
+val cut_replacing               : 
+  identifier -> constr -> (tactic -> tactic) -> tactic
 val cut_in_parallel             : constr list -> tactic
 
-val assert_tac                  : bool -> name -> constr -> tactic
+val assert_as : bool -> intro_pattern_expr -> constr -> tactic
+val forward   : tactic option -> intro_pattern_expr -> constr -> tactic
+
 val true_cut                    : name -> constr -> tactic
 val letin_tac                   : bool -> name -> constr -> clause -> tactic
-val forward                     : bool -> name -> constr -> tactic
+val assert_tac                  : bool -> name -> constr -> tactic
 val generalize                  : constr list -> tactic
 val generalize_dep              : constr  -> tactic
 
 val tclABSTRACT : identifier option -> tactic -> tactic
+
+val admit_as_an_axiom : tactic
+
diff --git a/tactics/tauto.ml4 b/tactics/tauto.ml4
index 553acc91..c91038fc 100644
--- a/tactics/tauto.ml4
+++ b/tactics/tauto.ml4
@@ -8,10 +8,8 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(*i $Id: tauto.ml4,v 1.62.2.1 2004/07/16 19:30:55 herbelin Exp $ i*)
+(*i $Id: tauto.ml4 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
-open Ast
-open Coqast
 open Hipattern
 open Names
 open Libnames
@@ -171,39 +169,11 @@ let tauto g =
 
 let default_intuition_tac = interp <:tactic< auto with * >>
 
-let q_elim tac=
-  <:tactic<
-  match goal with 
-    x : ?X1, H : ?X1 -> _ |- _ => generalize (H x); clear H; $tac
-  end >>
-
-let rec lfo n gl=
-  if n=0 then (tclFAIL 0 "LinearIntuition failed" gl) else
-    let p=if n<0 then n else (n-1) in
-    let lfo_rec=q_elim (Tacexpr.TacArg (valueIn (VTactic(dummy_loc,lfo p)))) in
-      intuition_gen (interp lfo_rec) gl
-
-let lfo_wrap n gl= 
-  try lfo n gl
-  with
-    Refiner.FailError _ | UserError _ ->
-      errorlabstrm "LinearIntuition" [< str "LinearIntuition failed." >]
-
-TACTIC EXTEND Tauto
-| [ "Tauto" ] -> [ tauto ]
-END
-(* Obsolete sinve V8.0
-TACTIC EXTEND TSimplif
-| [ "Simplif" ] -> [ simplif_gen ]
+TACTIC EXTEND tauto
+| [ "tauto" ] -> [ tauto ]
 END
-*)
-TACTIC EXTEND Intuition
-| [ "Intuition" ] -> [ intuition_gen default_intuition_tac ]
-| [ "Intuition" tactic(t) ] -> [ intuition_gen (snd t) ]
-END
-(* Obsolete since V8.0
-TACTIC EXTEND LinearIntuition
-| [ "LinearIntuition" ] -> [ lfo_wrap (-1)]
-| [ "LinearIntuition" integer(n)] -> [ lfo_wrap n]
+
+TACTIC EXTEND intuition
+| [ "intuition" ] -> [ intuition_gen default_intuition_tac ]
+| [ "intuition" tactic(t) ] -> [ intuition_gen (snd t) ]
 END
-*)
diff --git a/tactics/termdn.ml b/tactics/termdn.ml
index 9e77ddbd..65ad1dee 100644
--- a/tactics/termdn.ml
+++ b/tactics/termdn.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: termdn.ml,v 1.15.8.1 2004/07/16 19:30:56 herbelin Exp $ *)
+(* $Id: termdn.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
 
 open Util
 open Names
@@ -21,14 +21,14 @@ open Nametab
    See the module dn.ml for further explanations.
    Eduardo (5/8/97) *)
 
-type 'a t = (constr_label,constr_pattern,'a) Dn.t
+type 'a t = (global_reference,constr_pattern,'a) Dn.t
 
 (*If we have: f a b c ..., decomp gives: (f,[a;b;c;...])*)
 
 let decomp = 
   let rec decrec acc c = match kind_of_term c with
     | App (f,l) -> decrec (Array.fold_right (fun a l -> a::l) l acc) f
-    | Cast (c1,_) -> decrec acc c1
+    | Cast (c1,_,_) -> decrec acc c1
     | _ -> (c,acc)
   in 
   decrec []
@@ -45,19 +45,18 @@ let constr_pat_discr t =
     None
   else
     match decomp_pat t with
-      | PRef (IndRef sp), args -> Some(IndNode sp,args)
-      | PRef (ConstructRef sp), args -> Some(CstrNode sp,args)
-      | PRef (VarRef id), args -> Some(VarNode id,args)
+      | PRef ((IndRef _) as ref), args
+      | PRef ((ConstructRef _ ) as ref), args
+      | PRef ((VarRef _) as ref), args -> Some(ref,args)
       | _ -> None
 
 let constr_val_discr t =
   let c, l = decomp t in
   match kind_of_term c with
     (* Const _,_) -> Some(TERM c,l) *)
-    | Ind ind_sp -> Some(IndNode ind_sp,l)
-    | Construct cstr_sp -> Some(CstrNode cstr_sp,l)
-    (* Ici, comment distinguer SectionVarNode de VarNode ?? *)
-    | Var id -> Some(VarNode id,l)
+    | Ind ind_sp -> Some(IndRef ind_sp,l)
+    | Construct cstr_sp -> Some(ConstructRef cstr_sp,l)
+    | Var id -> Some(VarRef id,l)
     | _ -> None
 
 (* Les deux fonctions suivantes ecrasaient les precedentes, 
diff --git a/tactics/termdn.mli b/tactics/termdn.mli
index e3caf6d9..b65c0eeb 100644
--- a/tactics/termdn.mli
+++ b/tactics/termdn.mli
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: termdn.mli,v 1.9.16.1 2004/07/16 19:30:56 herbelin Exp $ i*)
+(*i $Id: termdn.mli 6427 2004-12-07 17:41:10Z sacerdot $ i*)
 
 (*i*)
 open Term
 open Pattern
+open Libnames
 (*i*)
   
 (* Discrimination nets of terms. *)
@@ -44,8 +45,8 @@ val app : ((constr_pattern * 'a) -> unit) -> 'a t -> unit
 (* These are for Nbtermdn *)
 
 val constr_pat_discr : 
-  constr_pattern -> (constr_label * constr_pattern list) option
+  constr_pattern -> (global_reference * constr_pattern list) option
 val constr_val_discr :
-  constr -> (constr_label * constr list) option
+  constr -> (global_reference * constr list) option
 
 (*i*)
diff --git a/test-suite/check b/test-suite/check
index fdc7b2d6..99893f88 100755
--- a/test-suite/check
+++ b/test-suite/check
@@ -3,16 +3,12 @@
 # Automatic test of Coq
 
 if [ "$1" = -byte ]; then
-  command7="../bin/coqtop.byte -translate -q -batch -load-vernac-source"
+  coqtop="../bin/coqtop.byte -q -batch"
 else
-  command7="../bin/coqtop -translate -q -batch -load-vernac-source"
+  coqtop="../bin/coqtop -q -batch"
 fi
 
-if [ "$1" = -byte ]; then
-  command="../bin/coqtop.byte -q -batch -load-vernac-source"
-else
-  command="../bin/coqtop -q -batch -load-vernac-source"
-fi
+command="$coqtop -top Top -load-vernac-source"
 
 # on compte le nombre de tests et de succès
 nbtests=0
@@ -24,34 +20,14 @@ test_success() {
     for f in $1/*.v; do 
 	nbtests=`expr $nbtests + 1`
 	printf "    "$f"..."
-	$command7 $f > /dev/null 2>&1
+	$command $f $2 > /dev/null 2>&1 
 	if [ $? = 0 ]; then
-            mv "$f"8 tmp8.v
-            $command tmp8.v > /dev/null 2>&1
-            if [ $? = 0 ]; then
-                echo "Ok"
-                nbtestsok=`expr $nbtestsok + 1`
-            else
-                echo "V8 Error! (should be accepted)"
-            fi
-            rm tmp8.v
+	    echo "Ok"
+	    nbtestsok=`expr $nbtestsok + 1`
         else 
-	    echo "V7 Error! (should be accepted)"
+	    echo "Error! (should be accepted)"
         fi 
     done
-    for f in $1/*.v8; do 
-	nbtests=`expr $nbtests + 1`
-	printf "    "$f"..."
-        cp $f tmp8.v
-	$command tmp8.v > /dev/null 2>&1
-        if [ $? = 0 ]; then
-            echo "Ok"
-            nbtestsok=`expr $nbtestsok + 1`
-        else
-            echo "V8 Error! (should be accepted)"
-        fi
-        rm tmp8.v
-    done
 }
 
 # La fonction suivante teste le compilateur sur des fichiers qu'il doit
@@ -60,7 +36,7 @@ test_failure() {
     for f in $1/*.v; do 
 	nbtests=`expr $nbtests + 1`
 	printf "    "$f"..."
-	$command7 $f > /dev/null 2>&1
+	$command $f > /dev/null 2>&1
 	if [ $? != 0 ]; then 
 	    echo "Ok"
 	    nbtestsok=`expr $nbtestsok + 1`
@@ -76,16 +52,16 @@ test_output() {
 	nbtests=`expr $nbtests + 1`
 	printf "    "$f"..."
         tmpoutput=`mktemp /tmp/coqcheck.XXXXXX`
-	$command7 $f | tail +3 > $tmpoutput 2>&1
+	$command $f 2>&1 | grep -v "Welcome to Coq" | grep -v "Skipping rcfile loading" > $tmpoutput
         foutput=`dirname $f`/`basename $f .v`.out
-        diff $tmpoutput $foutput > /dev/null
+        diff $tmpoutput $foutput >& /dev/null
 	if [ $? = 0 ]; then 
 	    echo "Ok"
 	    nbtestsok=`expr $nbtestsok + 1`
         else 
 	    echo "Error! (unexpected output)"
-        fi
-	rm $tmpoutput
+        fi 
+        rm $tmpoutput
     done
 }
 
@@ -107,25 +83,46 @@ test_parser() {
             echo "Ok"
             nbtestsok=`expr $nbtestsok + 1`
         fi
-	rm $tmpoutput
+        rm $tmpoutput
     done
     fi
 }
 
+# La fonction suivante teste en interactif 
+test_interactive() {
+    for f in $1/*.v; do 
+	nbtests=`expr $nbtests + 1`
+	printf "    "$f"..."
+	$coqtop < $f > /dev/null 2>&1
+	if [ $? = 0 ]; then 
+	    echo "Ok"
+	    nbtestsok=`expr $nbtestsok + 1`
+        else 
+	    echo "Error! (should be accepted)"
+        fi 
+    done
+}
+
 # Programme principal
 
-# echo "Output tests"
-# test_output output
-echo "[Output tests are off]"
 echo "Success tests"
 test_success success
 echo "Failure tests"
 test_failure failure
+echo "Output tests"
+test_output output
 echo "Parser tests"
 test_parser parser
+echo "Interactive tests"
+test_interactive interactive
+echo "Module tests"
+$coqtop -compile modules/Nat
+$coqtop -compile modules/plik
+test_success modules "-I modules -impredicative-set"
+
 pourcentage=`expr 100 \* $nbtestsok / $nbtests`
 echo
 echo "$nbtestsok tests passed over $nbtests, i.e. $pourcentage %"
 
-
-
+#echo "Ideal-features tests"
+#test_success ideal-features
diff --git a/test-suite/failure/Case1.v b/test-suite/failure/Case1.v
index fafcafc1..df11ed38 100644
--- a/test-suite/failure/Case1.v
+++ b/test-suite/failure/Case1.v
@@ -1 +1,4 @@
-Type Cases O of x => O | O => (S O) end.
+Type match 0 with
+     | x => 0
+     | O => 1
+     end.
diff --git a/test-suite/failure/Case10.v b/test-suite/failure/Case10.v
index ee47544d..43cc1e34 100644
--- a/test-suite/failure/Case10.v
+++ b/test-suite/failure/Case10.v
@@ -1 +1,3 @@
-Type [x:nat]<nat> Cases x  of ((S x) as b) => (S b) end.
+Type (fun x : nat => match x return nat with
+                     | S x as b => S b
+                     end).
diff --git a/test-suite/failure/Case11.v b/test-suite/failure/Case11.v
index c39a76ca..e76d0609 100644
--- a/test-suite/failure/Case11.v
+++ b/test-suite/failure/Case11.v
@@ -1 +1,3 @@
-Type [x:nat]<nat> Cases x  of ((S x) as b) => (S b x) end.
+Type (fun x : nat => match x return nat with
+                     | S x as b => S b x
+                     end).
diff --git a/test-suite/failure/Case12.v b/test-suite/failure/Case12.v
index b56eac0d..cf6c2026 100644
--- a/test-suite/failure/Case12.v
+++ b/test-suite/failure/Case12.v
@@ -1,7 +1,8 @@
 
-Type [x:nat]<nat> Cases x  of 
-                  ((S x) as b) => <nat>Cases x  of
-                                        x => x 
-                                   end
-                          end.
-
+Type
+  (fun x : nat =>
+   match x return nat with
+   | S x as b => match x with
+                 | x => x
+                 end
+   end).
diff --git a/test-suite/failure/Case13.v b/test-suite/failure/Case13.v
index 8a4d75b6..994dfd20 100644
--- a/test-suite/failure/Case13.v
+++ b/test-suite/failure/Case13.v
@@ -1,5 +1,7 @@
-Type [x:nat]<nat> Cases x  of 
-                  ((S x) as b) => <nat>Cases x  of
-                                        x => (S b x)
-                                   end
-                          end.
+Type
+  (fun x : nat =>
+   match x return nat with
+   | S x as b => match x with
+                 | x => S b x
+                 end
+   end).
diff --git a/test-suite/failure/Case14.v b/test-suite/failure/Case14.v
index a198d068..ba0c51a1 100644
--- a/test-suite/failure/Case14.v
+++ b/test-suite/failure/Case14.v
@@ -1,8 +1,9 @@
-Inductive List [A:Set] :Set := 
- Nil:(List A) | Cons:A->(List A)->(List A).
+Inductive List (A : Set) : Set :=
+  | Nil : List A
+  | Cons : A -> List A -> List A.
 
-Definition NIL := (Nil nat).
-Type <(List nat)>Cases (Nil nat) of 
-                NIL   => NIL
-              |  _    => NIL
-              end.
+Definition NIL := Nil nat.
+Type match Nil nat return (List nat) with
+     | NIL => NIL
+     | _ => NIL
+     end.
diff --git a/test-suite/failure/Case15.v b/test-suite/failure/Case15.v
index a27b07f8..18faaf5c 100644
--- a/test-suite/failure/Case15.v
+++ b/test-suite/failure/Case15.v
@@ -1,6 +1,9 @@
 (* Non exhaustive pattern-matching *)
 
-Check [x]Cases x x of
-    O (S (S y)) => true
-  | O (S x) => false
-  | (S y) O => true end.
\ No newline at end of file
+Check
+  (fun x =>
+   match x, x with
+   | O, S (S y) => true
+   | O, S x => false
+   | S y, O => true
+   end).
diff --git a/test-suite/failure/Case16.v b/test-suite/failure/Case16.v
index f994a8f2..3739adae 100644
--- a/test-suite/failure/Case16.v
+++ b/test-suite/failure/Case16.v
@@ -1,9 +1,11 @@
 (* Check for redundant clauses *)
 
-Check [x]Cases x x of
-   O (S (S y)) => true
- | (S _) (S (S y)) => true
- | _ (S (S x)) => false 
- | (S y) O => true 
- | _ _ => true
-end.
+Check
+  (fun x =>
+   match x, x with
+   | O, S (S y) => true
+   | S _, S (S y) => true
+   | _, S (S x) => false
+   | S y, O => true
+   | _, _ => true
+   end).
diff --git a/test-suite/failure/Case2.v b/test-suite/failure/Case2.v
index 183f612b..7d81ee81 100644
--- a/test-suite/failure/Case2.v
+++ b/test-suite/failure/Case2.v
@@ -1,13 +1,13 @@
-Inductive IFExpr : Set := 
-          Var  : nat -> IFExpr
-        | Tr   : IFExpr
-        | Fa   : IFExpr
-        | IfE   : IFExpr -> IFExpr -> IFExpr -> IFExpr.
-
-Type [F:IFExpr]
-    <Prop>Cases F of
-       (IfE (Var _) H I) => True
-     | (IfE _ _ _)   => False
-     |  _          => True
-     end.
+Inductive IFExpr : Set :=
+  | Var : nat -> IFExpr
+  | Tr : IFExpr
+  | Fa : IFExpr
+  | IfE : IFExpr -> IFExpr -> IFExpr -> IFExpr.
 
+Type
+  (fun F : IFExpr =>
+   match F return Prop with
+   | IfE (Var _) H I => True
+   | IfE _ _ _ => False
+   | _ => True
+   end).
diff --git a/test-suite/failure/Case3.v b/test-suite/failure/Case3.v
index 2c651b87..ca450d5b 100644
--- a/test-suite/failure/Case3.v
+++ b/test-suite/failure/Case3.v
@@ -1,7 +1,10 @@
-Inductive List [A:Set] :Set := 
- Nil:(List A) | Cons:A->(List A)->(List A).
+Inductive List (A : Set) : Set :=
+  | Nil : List A
+  | Cons : A -> List A -> List A.
 
-Type [l:(List nat)]<nat>Cases l of 
-                         (Nil nat) =>O
-                      | (Cons  a l) => (S a)
-                      end.
+Type
+  (fun l : List nat =>
+   match l return nat with
+   | Nil nat => 0
+   | Cons a l => S a
+   end).
diff --git a/test-suite/failure/Case4.v b/test-suite/failure/Case4.v
index d00c9a05..de63c3f7 100644
--- a/test-suite/failure/Case4.v
+++ b/test-suite/failure/Case4.v
@@ -1,7 +1,7 @@
 
-Definition Berry := [x,y,z:bool] 
-  Cases x y z of 
-     true false _ => O
-   | false _ true => (S O)
-   | _ true false => (S (S O))
-end.
+Definition Berry (x y z : bool) :=
+  match x, y, z with
+  | true, false, _ => 0
+  | false, _, true => 1
+  | _, true, false => 2
+  end.
diff --git a/test-suite/failure/Case5.v b/test-suite/failure/Case5.v
index bdb5544b..29996fd4 100644
--- a/test-suite/failure/Case5.v
+++ b/test-suite/failure/Case5.v
@@ -1,3 +1,7 @@
-Inductive MS: Set := X:MS->MS | Y:MS->MS.
+Inductive MS : Set :=
+  | X : MS -> MS
+  | Y : MS -> MS.
  
-Type  [p:MS]<nat>Cases p of (X x) => O end.
+Type (fun p : MS => match p return nat with
+                    | X x => 0
+                    end).
diff --git a/test-suite/failure/Case6.v b/test-suite/failure/Case6.v
index f588d275..fb8659bf 100644
--- a/test-suite/failure/Case6.v
+++ b/test-suite/failure/Case6.v
@@ -1,10 +1,8 @@
-Inductive List [A:Set] :Set := 
- Nil:(List A) | Cons:A->(List A)->(List A).
-
-
-Type <(List nat)>Cases (Nil nat) of 
-                NIL   => NIL
-              | (CONS _ _)  => NIL
-
-              end.
-
+Inductive List (A : Set) : Set :=
+  | Nil : List A
+  | Cons : A -> List A -> List A.
+
+Type (match Nil nat return List nat with
+      | NIL   => NIL
+      | (CONS _ _)  => NIL
+      end).
diff --git a/test-suite/failure/Case7.v b/test-suite/failure/Case7.v
index 3718f198..64453481 100644
--- a/test-suite/failure/Case7.v
+++ b/test-suite/failure/Case7.v
@@ -1,22 +1,20 @@
-Inductive listn : nat-> Set := 
-  niln : (listn O) 
-| consn : (n:nat)nat->(listn n) -> (listn (S n)).
+Inductive listn : nat -> Set :=
+  | niln : listn 0
+  | consn : forall n : nat, nat -> listn n -> listn (S n).
 
-Definition length1:= [n:nat] [l:(listn n)]
-                    Cases l of 
-                     (consn n _ (consn m _ _)) => (S (S m))
-                    |(consn n _ _) => (S O)
-                    | _ => O
-                    end.
-
-Type [n:nat]
-       [l:(listn n)]
-        <nat>Cases n of 
-            O  => O
-        |  (S n)  =>
-             <([_:nat]nat)>Cases l of 
-                 niln  => (S O)
-              |  l'  => (length1 (S n) l')
-             end
-       end.
+Definition length1 (n : nat) (l : listn n) :=
+  match l with
+  | consn n _ (consn m _ _) => S (S m)
+  | consn n _ _ => 1
+  | _ => 0
+  end.
 
+Type
+  (fun (n : nat) (l : listn n) =>
+   match n return nat with
+   | O => 0
+   | S n => match l return nat with
+            | niln => 1
+            | l' => length1 (S n) l'
+            end
+   end).
diff --git a/test-suite/failure/Case8.v b/test-suite/failure/Case8.v
index 7f6bb615..feae29a7 100644
--- a/test-suite/failure/Case8.v
+++ b/test-suite/failure/Case8.v
@@ -1,8 +1,8 @@
-Inductive List [A:Set] :Set := 
- Nil:(List A) | Cons:A->(List A)->(List A).
-
-Type <nat>Cases (Nil nat) of 
-                             ((Nil_) as b) =>b
-                            |((Cons _ _ _) as d) => d
-                      end.
+Inductive List (A : Set) : Set :=
+  | Nil : List A
+  | Cons : A -> List A -> List A.
 
+Type match Nil nat return nat with
+     | b => b
+     | Cons _ _ _ as d => d
+     end.
diff --git a/test-suite/failure/Case9.v b/test-suite/failure/Case9.v
index e8d8e89a..a3b99f63 100644
--- a/test-suite/failure/Case9.v
+++ b/test-suite/failure/Case9.v
@@ -1,6 +1,8 @@
-Parameter compare : (n,m:nat)({(lt n m)}+{n=m})+{(gt n m)}.
-Type <nat>Cases (compare O O) of
-               (* k<i *)  (left _ _ (left _ _ _)) => O
-            |  (* k=i *)  (left _ _ _)  => O
-            |  (* k>i *)  (right _ _ _) => O end.
-
+Parameter compare : forall n m : nat, {n < m} + {n = m} + {n > m}.
+Type
+  match compare 0 0 return nat with
+  
+      (* k<i *) | left _ _ (left _ _ _) => 0
+   (* k=i *) | left _ _ _ => 0
+   (* k>i *) | right _ _ _ => 0
+  end.
diff --git a/test-suite/failure/ClearBody.v b/test-suite/failure/ClearBody.v
index ca8e3c68..609d5b3b 100644
--- a/test-suite/failure/ClearBody.v
+++ b/test-suite/failure/ClearBody.v
@@ -2,7 +2,7 @@
    invalidate the well-typabilility of the visible goal *)
 
 Goal True.
-LetTac n:=O.
-LetTac I:=(refl_equal nat O).
-Change (n=O) in (Type of I).
-ClearBody n.
+set (n := 0) in *.
+set (I := refl_equal 0) in *.
+change (n = 0) in (type of I).
+clearbody n.
diff --git a/test-suite/failure/Notations.v b/test-suite/failure/Notations.v
new file mode 100644
index 00000000..074e176a
--- /dev/null
+++ b/test-suite/failure/Notations.v
@@ -0,0 +1,7 @@
+(* Submitted by Roland Zumkeller *)
+
+Notation "! A" := (forall i:nat, A) (at level 60).
+
+(* Should fail: no dynamic capture *)
+Check ! (i=i).
+
diff --git a/test-suite/failure/Tauto.v b/test-suite/failure/Tauto.v
index fb9a27bb..cda2d51e 100644
--- a/test-suite/failure/Tauto.v
+++ b/test-suite/failure/Tauto.v
@@ -15,6 +15,6 @@
   Simplifications of goals, based on LJT calcul ****)
 
 (* Fails because Tauto does not perform any Apply *)
-Goal ((A:Prop)A\/~A)->(x,y:nat)(x=y\/~x=y).
+Goal (forall A : Prop, A \/ ~ A) -> forall x y : nat, x = y \/ x <> y.
 Proof.
-  Tauto.
+   tauto.
diff --git a/test-suite/failure/cases.v b/test-suite/failure/cases.v
index a27b07f8..18faaf5c 100644
--- a/test-suite/failure/cases.v
+++ b/test-suite/failure/cases.v
@@ -1,6 +1,9 @@
 (* Non exhaustive pattern-matching *)
 
-Check [x]Cases x x of
-    O (S (S y)) => true
-  | O (S x) => false
-  | (S y) O => true end.
\ No newline at end of file
+Check
+  (fun x =>
+   match x, x with
+   | O, S (S y) => true
+   | O, S x => false
+   | S y, O => true
+   end).
diff --git a/test-suite/failure/check.v b/test-suite/failure/check.v
index 0bf7091c..649fdd2d 100644
--- a/test-suite/failure/check.v
+++ b/test-suite/failure/check.v
@@ -1,3 +1,3 @@
-Implicits eq [1].
+Implicit Arguments eq [A].
 
-Check (eq bool true).
+Check (bool = true).
diff --git a/test-suite/failure/clash_cons.v b/test-suite/failure/clash_cons.v
index 56cd73f4..07db69a9 100644
--- a/test-suite/failure/clash_cons.v
+++ b/test-suite/failure/clash_cons.v
@@ -8,9 +8,8 @@
 (* Teste la verification d'unicite des noms de constr *)
 
 
-Inductive X : Set := 
+Inductive X : Set :=
     cons : X.
 
-Inductive Y : Set := 
+Inductive Y : Set :=
     cons : Y.
-
diff --git a/test-suite/failure/clashes.v b/test-suite/failure/clashes.v
index fcfd29fe..207d62b9 100644
--- a/test-suite/failure/clashes.v
+++ b/test-suite/failure/clashes.v
@@ -4,5 +4,6 @@
    S.n to keep n accessible... *)
 
 Section S.
-Variable n:nat.
-Inductive P : Set := n : P.
+Variable n : nat.
+Inductive P : Set :=
+    n : P.
diff --git a/test-suite/failure/coqbugs0266.v b/test-suite/failure/coqbugs0266.v
index 2ac6c4f0..79eef5c9 100644
--- a/test-suite/failure/coqbugs0266.v
+++ b/test-suite/failure/coqbugs0266.v
@@ -1,7 +1,7 @@
 (* It is forbidden to erase a variable (or a local def) that is used in
    the current goal. *)
 Section S.
-Local a:=O.
-Definition b:=a.
-Goal b=b.
-Clear a.
+Let a := 0.
+Definition b := a.
+Goal b = b.
+clear a.
diff --git a/test-suite/failure/fixpoint1.v b/test-suite/failure/fixpoint1.v
index 742e9774..7d0d9d2d 100644
--- a/test-suite/failure/fixpoint1.v
+++ b/test-suite/failure/fixpoint1.v
@@ -5,5 +5,6 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-Fixpoint PreParadox [u:unit] : False := (PreParadox u).
-Definition Paradox := (PreParadox tt).
\ No newline at end of file
+Fixpoint PreParadox (u : unit) : False := PreParadox u.
+Definition Paradox := PreParadox tt.
+
diff --git a/test-suite/failure/ltac1.v b/test-suite/failure/ltac1.v
index d0256619..7b496a75 100644
--- a/test-suite/failure/ltac1.v
+++ b/test-suite/failure/ltac1.v
@@ -1,5 +1,7 @@
 (* Check all variables are different in a Context *)
-Tactic Definition X := Match Context With [ x:?; x:? |- ? ] -> Apply x.
-Goal True->True->True.
-Intros.
+Ltac X := match goal with
+          | x:_,x:_ |- _ => apply x
+          end.
+Goal True -> True -> True.
+intros.
 X.
diff --git a/test-suite/failure/ltac2.v b/test-suite/failure/ltac2.v
index 55925a7a..14436e58 100644
--- a/test-suite/failure/ltac2.v
+++ b/test-suite/failure/ltac2.v
@@ -1,6 +1,6 @@
 (* Check that Match arguments are forbidden *)
-Tactic Definition E x := Apply x.
-Goal True->True.
-E (Match Context With [ |- ? ] -> Intro H).
-(* Should fail with "Immediate Match producing tactics not allowed in 
-   local definitions" *)
+Ltac E x := apply x.
+Goal True -> True.
+E ltac:(match goal with
+        |  |- _ => intro H
+        end).
diff --git a/test-suite/failure/ltac3.v b/test-suite/failure/ltac3.v
deleted file mode 100644
index bfccc546..00000000
--- a/test-suite/failure/ltac3.v
+++ /dev/null
@@ -1,2 +0,0 @@
-(* Proposed by Benjamin *)
-Definition A := Try REflexivity.
diff --git a/test-suite/failure/ltac4.v b/test-suite/failure/ltac4.v
index d1e4e892..41471275 100644
--- a/test-suite/failure/ltac4.v
+++ b/test-suite/failure/ltac4.v
@@ -1,4 +1,5 @@
 (* Check static globalisation of tactic names *)
 (* Proposed by Benjamin (mars 2002) *)
-Goal (n:nat)n=n.
-Induction n; Try REflexivity.
+Goal forall n : nat, n = n.
+induction n; try REflexivity.
+
diff --git a/test-suite/failure/params_ind.v b/test-suite/failure/params_ind.v
deleted file mode 100644
index 20689128..00000000
--- a/test-suite/failure/params_ind.v
+++ /dev/null
@@ -1,4 +0,0 @@
-Inductive list [A:Set] : Set :=
-   nil : (list A)
-|  cons : A -> (list A->A)-> (list A).
-
diff --git a/test-suite/failure/pattern.v b/test-suite/failure/pattern.v
new file mode 100644
index 00000000..129c380e
--- /dev/null
+++ b/test-suite/failure/pattern.v
@@ -0,0 +1,9 @@
+(* Check that untypable beta-expansion are trapped *)
+
+Variable A : nat -> Type.
+Variable n : nat.
+Variable P : forall m : nat, m = n -> Prop.
+
+Goal forall p : n = n, P n p.
+intro.
+pattern n, p in |- *.
diff --git a/test-suite/failure/positivity.v b/test-suite/failure/positivity.v
index b43eb899..21683605 100644
--- a/test-suite/failure/positivity.v
+++ b/test-suite/failure/positivity.v
@@ -5,4 +5,5 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-Inductive t:Set := c: (t -> nat) -> t.
+Inductive t : Set :=
+    c : (t -> nat) -> t.
diff --git a/test-suite/failure/search.v b/test-suite/failure/search.v
index e8ca8494..ef750b50 100644
--- a/test-suite/failure/search.v
+++ b/test-suite/failure/search.v
@@ -5,4 +5,5 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-SearchPattern ? = ? outside n_existe_pas.
+
+SearchPattern (_ = _) outside n_existe_pas.
diff --git a/test-suite/failure/universes-buraliforti.v b/test-suite/failure/universes-buraliforti.v
index 01d46133..d18d2119 100644
--- a/test-suite/failure/universes-buraliforti.v
+++ b/test-suite/failure/universes-buraliforti.v
@@ -4,38 +4,41 @@
 
 (* Some properties about relations on objects in Type *)
 
-  Inductive ACC [A : Type; R : A->A->Prop] : A->Prop :=
-      ACC_intro : (x:A)((y:A)(R y x)->(ACC A R y))->(ACC A R x).
+  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:
-    (A:Type)(R:A->A->Prop)(x:A)(ACC A R x)->(R x x)->False.
-Induction 1; Intros.
-Exact (H1 x0 H2 H2).
-Save.
+  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](x:A)(ACC A R x).
+  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.
+  Variables (A B : Type) (R : B -> B -> Prop) (f : A -> B).
 
-  Definition Rof : A->A->Prop := [x,y:A](R (f x) (f y)).
+  Definition Rof (x y : A) : Prop := R (f x) (f y).
 
-  Remark ACC_lemma : (y:B)(ACC B R y)->(x:A)(y==(f x))->(ACC A Rof x).
-    Induction 1; Intros.
-    Constructor; Intros.
-    Apply (H1 (f y0)); Trivial.
-    Elim H2 using eqT_ind_r; Trivial.
-    Save.
+  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 : (x:A)(ACC B R (f x)) -> (ACC A Rof x).
-    Intros; Apply (ACC_lemma (f x)); Trivial.
-    Save.
+  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; Intros; Apply ACC_inverse_image; Auto.
-    Save.
+  Lemma WF_inverse_image : WF B R -> WF A Rof.
+    red in |- *; intros; apply ACC_inverse_image; auto.
+    Qed.
 
 End Inverse_Image.
 
@@ -44,8 +47,9 @@ End Inverse_Image.
 
 Section Burali_Forti_Paradox.
 
-  Definition morphism := [A:Type][R:A->A->Prop][B:Type][S:B->B->Prop][f:A->B]
-    (x,y:A)(R x y)->(S (f x) (f y)).
+  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:
@@ -53,120 +57,125 @@ Section Burali_Forti_Paradox.
       - 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  : (X:Type)(X->X->Prop)->A0. (* X: Type_j *)
-  Hypothesis inj : (X1:Type)(R1:X1->X1->Prop)(X2:Type)(R2:X2->X2->Prop)
-                     (i0 X1 R1)==(i0 X2 R2)
-                       ->(EXT f:X1->X2 | (morphism X1 R1 X2 R2 f)).
+  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: (z:X1)(R2 (f z) maj) }.
-
-
-  Lemma emb_trans: (x,y,z:A0)(emb x y)->(emb y z)->(emb x z).
-Intros.
-Case H; Intros.
-Case H0; Intros.
-Generalize eqx0; Clear eqx0.
-Elim eqy using eqT_ind_r; Intro.
-Case (inj ? ? ? ? eqx0); Intros.
-Exists X1 R1 X3 R3 [x:X1](f0 (x0 (f x))) maj0; Trivial.
-Red; Auto.
+  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.
+case H0; intros.
+generalize eqx0; clear eqx0.
+elim eqy using eq_ind_r; intro.
+case (inj _ _ _ _ eqx0); intros.
+exists X1 R1 X3 R3 (fun x : X1 => f0 (x0 (f x))) maj0; trivial.
+red in |- *; auto.
 Defined.
 
 
-  Lemma ACC_emb: (X:Type)(R:X->X->Prop)(x:X)(ACC X R x)
-    ->(Y:Type)(S:Y->Y->Prop)(f:Y->X)(morphism Y S X R f)
-      ->((y:Y)(R (f y) x))
-        ->(ACC A0 emb (i0 Y S)).
-Induction 1; Intros.
-Constructor; Intros.
-Case H4; Intros.
-Elim eqx using eqT_ind_r.
-Case (inj X2 R2 Y S).
-Apply sym_eqT; Assumption.
-
-Intros.
-Apply H1 with y:=(f (x1 maj)) f:=[x:X1](f (x1 (f0 x))); Try Red; Auto.
+  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 eqT_ind_r.
-Apply ACC_emb with X:=X2 R:=R2 x:=maj f:=f; Trivial.
+  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).
+  Definition Omega : A0 := i0 A0 emb.
 
 
 Section Subsets.
 
-  Variable a: A0.
+  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) }.
+  Record sub : Type :=  {witness : A0; emb_wit : emb witness a}.
 
   (* F is its image through i0 *)
-  Definition F : A0 := (i0 sub (Rof ? ? emb witness)).
+  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.
+  Lemma F_emb_Omega : emb F Omega.
+exists sub (Rof _ _ emb witness) A0 emb witness a; trivial.
+exact WF_emb.
 
-Red; Trivial.
+red in |- *; trivial.
 
-Exact emb_wit.
+exact emb_wit.
 Defined.
 
 End Subsets.
 
 
-  Definition fsub: (a,b:A0)(emb a b)->(sub a)->(sub b):=
-    [_,_][H][x]
-      (Build_sub ? (witness ? x) (emb_trans ? ? ? (emb_wit ? x) H)).
+  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; 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; Simpl; Intros.
-Trivial.
-
-Unfold Rof fsub; Simpl; Intros.
-Apply emb_wit.
+  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.
 
 
@@ -174,23 +183,23 @@ Defined.
      - 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.
+  Lemma Omega_refl : emb Omega Omega.
+exists A0 emb A0 emb F Omega; trivial.
+exact WF_emb.
 
-Exact F_morphism.
+exact F_morphism.
 
-Exact F_emb_Omega.
+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.
+  Theorem Burali_Forti : False.
+apply ACC_nonreflexive with A0 emb Omega.
+apply WF_emb.
 
-Exact Omega_refl.
+exact Omega_refl.
 
 Defined.
 
@@ -200,21 +209,23 @@ End Burali_Forti_Paradox.
   (* The following type seems to satisfy the hypothesis of the paradox.
      But it does not!
    *)
-  Record A0: Type := (* Type_i' *)
-    i0 { X0: Type; R0: X0->X0->Prop }. (* X0: Type_j' *)
+  Record A0 : Type :=  (* Type_i' *)
+    i0 {X0 : Type; R0 : X0 -> X0 -> Prop}. (* X0: Type_j' *)
 
 
   (* Note: this proof uses a large elimination of A0. *)
-  Lemma inj : (X1:Type)(R1:X1->X1->Prop)(X2:Type)(R2:X2->X2->Prop)
-                    (i0 X1 R1)==(i0 X2 R2)
-                      ->(EXT f:X1->X2 | (morphism X1 R1 X2 R2 f)).
-Intros.
-Change Cases (i0 X1 R1) (i0 X2 R2) of
-         (i0 x1 r1) (i0 x2 r2) => (EXT f | (morphism x1 r1 x2 r2 f))
-       end.
-Case H; Simpl.
-Exists [x:X1]x.
-Red; Trivial.
+  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
+  | i0 x1 r1, i0 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'.
@@ -223,5 +234,4 @@ Defined.
    with the constraint j >= i in the paradox.
 *)
 
-  Definition Paradox: False := (Burali_Forti A0 i0 inj).
-
+  Definition Paradox : False := Burali_Forti A0 i0 inj.
diff --git a/test-suite/failure/universes-sections1.v b/test-suite/failure/universes-sections1.v
index c4eef34b..6cd04349 100644
--- a/test-suite/failure/universes-sections1.v
+++ b/test-suite/failure/universes-sections1.v
@@ -2,7 +2,7 @@
 
 Section A.
   Definition Type2 := Type.
-  Definition Type1 := Type : Type2.
+  Definition Type1 : Type2 := Type.
 End A.
 
-Definition Inconsistency := Type2 : Type1.
+Definition Inconsistency : Type1 := Type2.
diff --git a/test-suite/failure/universes-sections2.v b/test-suite/failure/universes-sections2.v
index 1872dac1..98fdbc0d 100644
--- a/test-suite/failure/universes-sections2.v
+++ b/test-suite/failure/universes-sections2.v
@@ -3,8 +3,8 @@
 Definition Type2 := Type.
 
 Section A.
-  Local Type1 := Type : Type2.
+  Let Type1 : Type2 := Type.
   Definition Type1' := Type1.
 End A.
 
-Definition Inconsistency := Type2 : Type1'.
+Definition Inconsistency : Type1' := Type2.
diff --git a/test-suite/failure/universes.v b/test-suite/failure/universes.v
index 6fada6f1..938c29b8 100644
--- a/test-suite/failure/universes.v
+++ b/test-suite/failure/universes.v
@@ -1,3 +1,3 @@
 Definition Type2 := Type.
-Definition Type1 := Type : Type2.
-Definition Inconsistency := Type2 : Type1.
+Definition Type1 : Type2 := Type.
+Definition Inconsistency : Type1 := Type2.
diff --git a/test-suite/failure/universes2.v b/test-suite/failure/universes2.v
index a6c8ba43..e74de70f 100644
--- a/test-suite/failure/universes2.v
+++ b/test-suite/failure/universes2.v
@@ -1,5 +1,4 @@
 (* Example submitted by Randy Pollack *)
 
-Parameter K: (T:Type)T->T.
-Check (K ((T:Type)T->T) K).
-(* Universe Inconsistency *)
+Parameter K : forall T : Type, T -> T.
+Check (K (forall T : Type, T -> T) K).
diff --git a/test-suite/ideal-features/Apply.v b/test-suite/ideal-features/Apply.v
index bba356f2..6fd0fe8b 100644
--- a/test-suite/ideal-features/Apply.v
+++ b/test-suite/ideal-features/Apply.v
@@ -6,21 +6,25 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* This needs unification on type *)
+(* This needs step by step unfolding *)
 
-Goal (n,m:nat)(eq nat (S m) (S n)).
-Intros.
-Apply f_equal.
+Fixpoint T (n:nat) : Prop :=
+  match n with
+  | O => True
+  | S p => n = n -> T p
+  end.
 
-(* f_equal : (A,B:Set; f:(A->B); x,y:A)x=y->(f x)=(f y) *)
-(* and A cannot be deduced from the goal but only from the type of f, x or y *)
+Require Import Arith.
 
+Goal T 3 -> T 1.
+intro H.
+apply H.
 
-(* This needs step by step unfolding *)
+(* This needs unification on type *)
 
-Fixpoint T [n:nat] : Prop := Cases n of O => True | (S p) => n=n->(T p) end.
-Require Arith.
+Goal forall n m : nat, S m = S n :>nat.
+intros.
+apply f_equal.
 
-Goal (T (3))->(T (1)).
-Intro H.
-Apply H.
+(* f_equal : forall (A B:Set) (f:A->B) (x y:A), x=y->(f x)=(f y) *)
+(* and A cannot be deduced from the goal but only from the type of f, x or y *)
diff --git a/test-suite/ideal-features/Case3.v b/test-suite/ideal-features/Case3.v
index e9dba1e3..de7784ae 100644
--- a/test-suite/ideal-features/Case3.v
+++ b/test-suite/ideal-features/Case3.v
@@ -1,28 +1,29 @@
-Inductive Le : nat->nat->Set :=
-  LeO: (n:nat)(Le O n) 
-| LeS: (n,m:nat)(Le n m) -> (Le (S n) (S m)).
+Inductive Le : nat -> nat -> Set :=
+  | LeO : forall n : nat, Le 0 n
+  | LeS : forall n m : nat, Le n m -> Le (S n) (S m).
 
-Parameter iguales : (n,m:nat)(h:(Le n m))Prop .
+Parameter discr_l : forall n : nat, S n <> 0.
 
-Type <[n,m:nat][h:(Le n m)]Prop>Cases (LeO O) of 
-                         (LeO O) => True
-                       | (LeS (S x) (S y) H) => (iguales (S x) (S y) H)
-                       | _ => False end.
+Type
+  (fun n : nat =>
+   match n return (n = 0 \/ n <> 0) with
+   | O => or_introl (0 <> 0) (refl_equal 0)
+   | S O => or_intror (1 = 0) (discr_l 0)
+   | S (S x) => or_intror (S (S x) = 0) (discr_l (S x))
+   end).
 
+Parameter iguales : forall (n m : nat) (h : Le n m), Prop.
 
-Type <[n,m:nat][h:(Le n m)]Prop>Cases (LeO O) of 
-                         (LeO O) => True
-                       | (LeS (S x) O H) => (iguales (S x) O H)
-                       | _ => False end.
-
-Parameter discr_l : (n:nat) ~((S n)=O).
-
-Type 
-[n:nat] 
-  <[n:nat]n=O\/~n=O>Cases n of 
-      O     => (or_introl ? ~O=O (refl_equal ? O))      
-   |  (S O) => (or_intror (S O)=O ? (discr_l O))
-   |  (S (S x)) => (or_intror (S (S x))=O ? (discr_l (S x)))
- 
+Type
+  match LeO 0 as h in (Le n m) return Prop with
+  | LeO O => True
+  | LeS (S x) (S y) H => iguales (S x) (S y) H
+  | _ => False
   end.
 
+Type
+  match LeO 0 as h in (Le n m) return Prop with
+  | LeO O => True
+  | LeS (S x) O H => iguales (S x) 0 H
+  | _ => False
+  end.
diff --git a/test-suite/ideal-features/Case4.v b/test-suite/ideal-features/Case4.v
index d8f14a4e..cb076a71 100644
--- a/test-suite/ideal-features/Case4.v
+++ b/test-suite/ideal-features/Case4.v
@@ -1,39 +1,34 @@
-Inductive listn : nat-> Set := 
-  niln : (listn O) 
-| consn : (n:nat)nat->(listn n) -> (listn (S n)).
-
-Inductive empty : (n:nat)(listn n)-> Prop := 
-  intro_empty: (empty O niln).
-
-Parameter inv_empty : (n,a:nat)(l:(listn n)) ~(empty (S n) (consn n a l)).
-
-Type 
-[n:nat] [l:(listn n)]
-  <[n:nat] [l:(listn n)](empty n l) \/ ~(empty n l)>Cases l of 
-        niln               =>  (or_introl ? ~(empty O niln) intro_empty)
-   |  ((consn n O y) as b) =>  (or_intror (empty (S n) b) ? (inv_empty n O y))
-   |  ((consn n a y) as b) =>  (or_intror (empty (S n) b) ? (inv_empty n a y))
-
-  end.
-
-
-Type 
-[n:nat] [l:(listn n)]
-  <[n:nat] [l:(listn n)](empty n l) \/ ~(empty n l)>Cases l of 
-        niln               =>  (or_introl ? ~(empty O niln) intro_empty)
-   |  (consn n O y)  =>  (or_intror (empty (S n) (consn n O y)) ? 
-                                              (inv_empty n O y))
-   |  (consn n a y) =>  (or_intror (empty (S n) (consn n a y)) ? 
-                                          (inv_empty n a y))
-
-  end.
-
-Type 
-[n:nat] [l:(listn n)]
-  <[n:nat] [l:(listn n)](empty n l) \/ ~(empty n l)>Cases l of 
-        niln               =>  (or_introl ? ~(empty O niln) intro_empty)
-   |  ((consn O a y) as b) =>  (or_intror (empty (S O) b) ? (inv_empty O a y))
-   |  ((consn n a y) as b) =>  (or_intror (empty (S n) b) ? (inv_empty n a y))
-
-  end.
-
+Inductive listn : nat -> Set :=
+  | niln : listn 0
+  | consn : forall n : nat, nat -> listn n -> listn (S n).
+
+Inductive empty : forall n : nat, listn n -> Prop :=
+    intro_empty : empty 0 niln.
+
+Parameter
+  inv_empty : forall (n a : nat) (l : listn n), ~ empty (S n) (consn n a l).
+
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l in (listn n) return (empty n l \/ ~ empty n l) with
+   | niln => or_introl (~ empty 0 niln) intro_empty
+   | consn n O y as b => or_intror (empty (S n) b) (inv_empty n 0 y)
+   | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y)
+   end).
+
+
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l in (listn n) return (empty n l \/ ~ empty n l) with
+   | niln => or_introl (~ empty 0 niln) intro_empty
+   | consn n O y => or_intror (empty (S n) (consn n 0 y)) (inv_empty n 0 y)
+   | consn n a y => or_intror (empty (S n) (consn n a y)) (inv_empty n a y)
+   end).
+
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l in (listn n) return (empty n l \/ ~ empty n l) with
+   | niln => or_introl (~ empty 0 niln) intro_empty
+   | consn O a y as b => or_intror (empty 1 b) (inv_empty 0 a y)
+   | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y)
+   end).
diff --git a/test-suite/ideal-features/Case8.v b/test-suite/ideal-features/Case8.v
index 73b55028..2ac5bd8c 100644
--- a/test-suite/ideal-features/Case8.v
+++ b/test-suite/ideal-features/Case8.v
@@ -1,40 +1,36 @@
-Inductive listn : nat-> Set := 
-  niln : (listn O) 
-| consn : (n:nat)nat->(listn n) -> (listn (S n)).
-
-Inductive empty : (n:nat)(listn n)-> Prop := 
-  intro_empty: (empty O niln).
-
-Parameter inv_empty : (n,a:nat)(l:(listn n)) ~(empty (S n) (consn n a l)).
-
-Type 
-[n:nat] [l:(listn n)]
-  <[n:nat] [l:(listn n)](empty n l) \/ ~(empty n l)>Cases l of 
-        niln               =>  (or_introl ? ~(empty O niln) intro_empty)
-   |  ((consn n O y) as b) =>  (or_intror (empty (S n) b) ? (inv_empty n O y))
-   |  ((consn n a y) as b) =>  (or_intror (empty (S n) b) ? (inv_empty n a y))
-
-  end.
-
-
-Type 
-[n:nat] [l:(listn n)]
-  <[n:nat] [l:(listn n)](empty n l) \/ ~(empty n l)>Cases l of 
-        niln               =>  (or_introl ? ~(empty O niln) intro_empty)
-   |  (consn n O y)  =>  (or_intror (empty (S n) (consn n O y)) ? 
-                                              (inv_empty n O y))
-   |  (consn n a y) =>  (or_intror (empty (S n) (consn n a y)) ? 
-                                          (inv_empty n a y))
-
-  end.
-
-
-
-Type 
-[n:nat] [l:(listn n)]
-  <[n:nat] [l:(listn n)](empty n l) \/ ~(empty n l)>Cases l of 
-        niln               =>  (or_introl ? ~(empty O niln) intro_empty)
-   |  ((consn O a y) as b) =>  (or_intror (empty (S O) b) ? (inv_empty O a y))
-   |  ((consn n a y) as b) =>  (or_intror (empty (S n) b) ? (inv_empty n a y))
-
-  end.
+Inductive listn : nat -> Set :=
+  | niln : listn 0
+  | consn : forall n : nat, nat -> listn n -> listn (S n).
+
+Inductive empty : forall n : nat, listn n -> Prop :=
+    intro_empty : empty 0 niln.
+
+Parameter
+  inv_empty : forall (n a : nat) (l : listn n), ~ empty (S n) (consn n a l).
+
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l in (listn n) return (empty n l \/ ~ empty n l) with
+   | niln => or_introl (~ empty 0 niln) intro_empty
+   | consn n O y as b => or_intror (empty (S n) b) (inv_empty n 0 y)
+   | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y)
+   end).
+
+
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l in (listn n) return (empty n l \/ ~ empty n l) with
+   | niln => or_introl (~ empty 0 niln) intro_empty
+   | consn n O y => or_intror (empty (S n) (consn n 0 y)) (inv_empty n 0 y)
+   | consn n a y => or_intror (empty (S n) (consn n a y)) (inv_empty n a y)
+   end).
+
+
+
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l in (listn n) return (empty n l \/ ~ empty n l) with
+   | niln => or_introl (~ empty 0 niln) intro_empty
+   | consn O a y as b => or_intror (empty 1 b) (inv_empty 0 a y)
+   | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y)
+   end).
diff --git a/test-suite/interactive/Back.v b/test-suite/interactive/Back.v
new file mode 100644
index 00000000..b813a79a
--- /dev/null
+++ b/test-suite/interactive/Back.v
@@ -0,0 +1,8 @@
+(* Check that reset remains synchronised with the compilation unit cache *)
+(* See bug #1030 *)
+
+Section multiset_defs.
+  Require Import Plus.
+End multiset_defs.
+Unset Implicit Arguments.
+Back 1.
diff --git a/test-suite/modules/Demo.v b/test-suite/modules/Demo.v
index 1e9273f0..1f27fe1b 100644
--- a/test-suite/modules/Demo.v
+++ b/test-suite/modules/Demo.v
@@ -1,51 +1,51 @@
 Module M.
-  Definition t:=nat.
-  Definition x:=O.
+  Definition t := nat.
+  Definition x := 0.
 End M.
 
 Print M.t.
 
 
 Module Type SIG.
-  Parameter t:Set.
-  Parameter x:t.
+  Parameter t : Set.
+  Parameter x : t.
 End SIG.
 
 
-Module F[X:SIG].
-  Definition t:=X.t->X.t.
-  Definition x:t.
-    Intro.
-    Exact X.x.
+Module F (X: SIG).
+  Definition t := X.t -> X.t.
+  Definition x : t.
+    intro.
+    exact X.x.
   Defined.
-  Definition y:=X.x.
+  Definition y := X.x.
 End F.
 
 
 Module N := F M.
 
 Print N.t.
-Eval Compute in N.t.
+Eval compute in N.t.
 
 
 Module N' : SIG := N.
 
 Print N'.t.
-Eval Compute in N'.t.
+Eval compute in N'.t.
 
 
 Module N'' <: SIG := F N.
 
 Print N''.t.
-Eval Compute in N''.t.
+Eval compute in N''.t.
 
-Eval Compute in N''.x.
+Eval compute in N''.x.
 
 
-Module N''' : SIG with Definition t:=nat->nat  :=  N.
+Module N''' : SIG with Definition t := nat -> nat := N.
 
 Print N'''.t.
-Eval Compute in N'''.t.
+Eval compute in N'''.t.
 
 Print N'''.x.
 
diff --git a/test-suite/modules/Nametab.v b/test-suite/modules/Nametab.v
deleted file mode 100644
index 61966c7c..00000000
--- a/test-suite/modules/Nametab.v
+++ /dev/null
@@ -1,48 +0,0 @@
-Module Q.
-  Module N.
-    Module K.
-      Definition id:=Set.
-    End K.
-  End N.
-End Q.
-
-(* Bad *) Locate id.
-(* Bad *) Locate K.id.
-(* Bad *) Locate N.K.id.
-(* OK  *) Locate Q.N.K.id.
-(* OK  *) Locate Top.Q.N.K.id.
-
-(* Bad *) Locate K.
-(* Bad *) Locate N.K.
-(* OK  *) Locate Q.N.K.
-(* OK  *) Locate Top.Q.N.K.
-
-(* Bad *) Locate N.
-(* OK  *) Locate Q.N.
-(* OK  *) Locate Top.Q.N.
-
-(* OK  *) Locate Q.
-(* OK  *) Locate Top.Q.
-
-
-
-Import Q.N.
-
-
-(* Bad *) Locate id.
-(* OK  *) Locate K.id.
-(* Bad *) Locate N.K.id.
-(* OK  *) Locate Q.N.K.id.
-(* OK  *) Locate Top.Q.N.K.id.
-
-(* OK  *) Locate K.
-(* Bad *) Locate N.K.
-(* OK  *) Locate Q.N.K.
-(* OK  *) Locate Top.Q.N.K.
-
-(* Bad *) Locate N.
-(* OK  *) Locate Q.N.
-(* OK  *) Locate Top.Q.N.
-
-(* OK  *) Locate Q.
-(* OK  *) Locate Top.Q.
diff --git a/test-suite/modules/Nat.v b/test-suite/modules/Nat.v
index d3e98ae4..57878a5f 100644
--- a/test-suite/modules/Nat.v
+++ b/test-suite/modules/Nat.v
@@ -1,19 +1,19 @@
-Definition T:=nat.
+Definition T := nat.
 
-Definition le:=Peano.le.
+Definition le := le.
 
-Hints Unfold le.
+Hint Unfold le.
 
-Lemma le_refl:(n:nat)(le n n).
-  Auto.
+Lemma le_refl : forall n : nat, le n n.
+  auto.
 Qed.
 
-Require Le.
+Require Import Le.
 
-Lemma le_trans:(n,m,k:nat)(le n m) -> (le m k) -> (le n k).
-  EAuto with arith.
+Lemma le_trans : forall n m k : nat, le n m -> le m k -> le n k.
+   eauto with arith.
 Qed.
 
-Lemma le_antis:(n,m:nat)(le n m) -> (le m n) -> n=m.
-  EAuto with arith.
-Qed.
+Lemma le_antis : forall n m : nat, le n m -> le m n -> n = m.
+   eauto with arith.
+Qed.
\ No newline at end of file
diff --git a/test-suite/modules/PO.v b/test-suite/modules/PO.v
index 9ba3fb2e..354c3957 100644
--- a/test-suite/modules/PO.v
+++ b/test-suite/modules/PO.v
@@ -1,57 +1,57 @@
-Implicit Arguments On.
+Set Implicit Arguments.
+Unset Strict Implicit.
 
-Implicits fst.
-Implicits snd.
+Implicit Arguments fst.
+Implicit Arguments snd.
 
 Module Type PO.
-  Parameter T:Set.
-  Parameter le:T->T->Prop.
+  Parameter T : Set.
+  Parameter le : T -> T -> Prop.
   
-  Axiom le_refl : (x:T)(le x x).
-  Axiom le_trans : (x,y,z:T)(le x y) -> (le y z) -> (le x z).
-  Axiom le_antis : (x,y:T)(le x y) -> (le y x) -> (x=y).
+  Axiom le_refl : forall x : T, le x x.
+  Axiom le_trans : forall x y z : T, le x y -> le y z -> le x z.
+  Axiom le_antis : forall x y : T, le x y -> le y x -> x = y.
   
-  Hints Resolve le_refl le_trans le_antis.
+  Hint Resolve le_refl le_trans le_antis.
 End PO.
 
 
-Module Pair[X:PO][Y:PO] <: PO.
-  Definition T:=X.T*Y.T.
-  Definition le:=[p1,p2]
-    (X.le (fst p1) (fst p2)) /\ (Y.le (snd p1) (snd p2)).
+Module Pair (X: PO) (Y: PO) <: PO.
+  Definition T := (X.T * Y.T)%type.
+  Definition le p1 p2 := X.le (fst p1) (fst p2) /\ Y.le (snd p1) (snd p2).
 
-  Hints Unfold le.
+  Hint Unfold le.
 
-  Lemma le_refl : (p:T)(le p p).
-    Info Auto.
+  Lemma le_refl : forall p : T, le p p.
+    info auto.
   Qed.
 
-  Lemma le_trans : (p1,p2,p3:T)(le p1 p2) -> (le p2 p3) -> (le p1 p3).
-    Unfold le; Intuition; Info EAuto.
+  Lemma le_trans : forall p1 p2 p3 : T, le p1 p2 -> le p2 p3 -> le p1 p3.
+    unfold le in |- *;  intuition; info  eauto.
   Qed.    
 
-  Lemma le_antis : (p1,p2:T)(le p1 p2) -> (le p2 p1) -> (p1=p2).
-    NewDestruct p1.  
-    NewDestruct p2.
-    Unfold le.
-    Intuition.
-    CutRewrite t=t1.
-    CutRewrite t0=t2.
-    Reflexivity.
+  Lemma le_antis : forall p1 p2 : T, le p1 p2 -> le p2 p1 -> p1 = p2.
+    destruct p1.  
+    destruct p2.
+    unfold le in |- *.
+     intuition.
+     cutrewrite (t = t1).
+     cutrewrite (t0 = t2).
+    reflexivity.
 
-    Info Auto.
+    info auto.
 
-    Info Auto.
+    info auto.
   Qed.
 
 End Pair.
 
 
 
-Read Module Nat.
+Require Nat.
 
 Module NN := Pair Nat Nat.
 
-Lemma zz_min : (p:NN.T)(NN.le (O,O) p).
-  Info Auto with arith.
-Qed.
+Lemma zz_min : forall p : NN.T, NN.le (0, 0) p.
+  info auto with arith.
+Qed.
\ No newline at end of file
diff --git a/test-suite/modules/Przyklad.v b/test-suite/modules/Przyklad.v
index 4f4c2066..014f6c60 100644
--- a/test-suite/modules/Przyklad.v
+++ b/test-suite/modules/Przyklad.v
@@ -1,38 +1,40 @@
-Definition ifte := [T:Set][A:Prop][B:Prop][s:(sumbool A B)][th:T][el:T] 
-	   	   if s then [_]th else [_]el.
+Definition ifte (T : Set) (A B : Prop) (s : {A} + {B}) 
+  (th el : T) := if s then th else el.
 
-Implicits ifte.
+Implicit Arguments ifte.
 
-Lemma Reflexivity_provable : 
-  (A:Set)(a:A)(s:{a=a}+{~a=a})(EXT x| s==(left ? ? x)).
-Intros.
-Elim s.
-Intro x.
-Split with x; Reflexivity.
+Lemma Reflexivity_provable :
+ forall (A : Set) (a : A) (s : {a = a} + {a <> a}),
+ exists x : _, s = left _ x.
+intros.
+elim s.
+intro x.
+split with x; reflexivity.
 
-Intro.
-Absurd a=a; Auto.
+intro.
+ absurd (a = a); auto.
 
-Save.
+Qed.
 
-Lemma Disequality_provable : 
-  (A:Set)(a,b:A)(~a=b)->(s:{a=b}+{~a=b})(EXT x| s==(right ? ? x)).
-Intros.
-Elim s.
-Intro.
-Absurd a=a; Auto.
+Lemma Disequality_provable :
+ forall (A : Set) (a b : A),
+ a <> b -> forall s : {a = b} + {a <> b}, exists x : _, s = right _ x.
+intros.
+elim s.
+intro.
+ absurd (a = a); auto.
 
-Intro.
-Split with b0; Reflexivity.
+intro.
+split with b0; reflexivity.
 
-Save.
+Qed.
 
 Module Type ELEM.
   Parameter T : Set.
-  Parameter eq_dec : (a,a':T){a=a'}+{~ a=a'}.
+  Parameter eq_dec : forall a a' : T, {a = a'} + {a <> a'}.
 End ELEM.
                                         
-Module Type SET[Elt : ELEM].
+Module Type SET (Elt: ELEM).
   Parameter T : Set.
   Parameter empty : T.
   Parameter add : Elt.T -> T -> T.
@@ -40,56 +42,52 @@ Module Type SET[Elt : ELEM].
 
   (* Axioms *)
 
-  Axiom find_empty_false : 
-      (e:Elt.T) (find e empty) = false.
+  Axiom find_empty_false : forall e : Elt.T, find e empty = false.
 
-  Axiom find_add_true : 
-        (s:T) (e:Elt.T) (find e (add e s)) = true.
+  Axiom find_add_true : forall (s : T) (e : Elt.T), find e (add e s) = true.
 
-  Axiom find_add_false :
-        (s:T) (e:Elt.T) (e':Elt.T) ~(e=e') -> 
-	(find e (add e' s))=(find e s).
+  Axiom
+    find_add_false :
+      forall (s : T) (e e' : Elt.T), e <> e' -> find e (add e' s) = find e s.
 
 End SET.
 
-Module FuncDict[E : ELEM].
+Module FuncDict (E: ELEM).
   Definition T := E.T -> bool.
-  Definition empty := [e':E.T] false.
-  Definition find := [e':E.T] [s:T] (s e').
-  Definition add := [e:E.T][s:T][e':E.T]
-        (ifte (E.eq_dec e e') true (find e' s)).
+  Definition empty (e' : E.T) := false.
+  Definition find (e' : E.T) (s : T) := s e'.
+  Definition add (e : E.T) (s : T) (e' : E.T) :=
+    ifte (E.eq_dec e e') true (find e' s).
 
-  Lemma find_empty_false : (e:E.T) (find e empty) = false.
-    Auto.
+  Lemma find_empty_false : forall e : E.T, find e empty = false.
+    auto.
   Qed.
 
-  Lemma find_add_true : 
-        (s:T) (e:E.T) (find e (add e s)) = true.
+  Lemma find_add_true : forall (s : T) (e : E.T), find e (add e s) = true.
 
-    Intros.
-    Unfold find add.
-    Elim (Reflexivity_provable ? ? (E.eq_dec e e)).
-    Intros.
-    Rewrite H.
-    Auto.
+    intros.
+    unfold find, add in |- *.
+    elim (Reflexivity_provable _ _ (E.eq_dec e e)).
+    intros.
+     rewrite H.
+    auto.
 
   Qed.
 
   Lemma find_add_false :
-        (s:T) (e:E.T) (e':E.T) ~(e=e') -> 
-	(find e (add e' s))=(find e s).
-    Intros.
-    Unfold add find.
-    Cut (EXT x:? | (E.eq_dec e' e)==(right ? ? x)).
-    Intros.
-    Elim H0.
-    Intros.
-    Rewrite H1.
-    Unfold ifte.
-    Reflexivity.
-
-    Apply Disequality_provable.
-    Auto.
+   forall (s : T) (e e' : E.T), e <> e' -> find e (add e' s) = find e s.
+    intros.
+    unfold add, find in |- *.
+    cut (exists x : _, E.eq_dec e' e = right _ x).
+    intros.
+    elim H0.
+    intros.
+     rewrite H1.
+    unfold ifte in |- *.
+    reflexivity.
+
+    apply Disequality_provable.
+    auto.
 
   Qed.
 
@@ -99,84 +97,81 @@ Module F : SET := FuncDict.
 
 
 Module Nat.
-  Definition T:=nat.
-  Lemma eq_dec :  (a,a':T){a=a'}+{~ a=a'}.
-    Decide Equality.
+  Definition T := nat.
+  Lemma eq_dec : forall a a' : T, {a = a'} + {a <> a'}.
+     decide equality.
   Qed.
 End Nat.
 
 
-Module SetNat:=F Nat. 
+Module SetNat := F Nat. 
 
 
-Lemma no_zero_in_empty:(SetNat.find O SetNat.empty)=false. 
-Apply SetNat.find_empty_false. 
-Save.
+Lemma no_zero_in_empty : SetNat.find 0 SetNat.empty = false. 
+apply SetNat.find_empty_false. 
+Qed.
 
 (***************************************************************************)
-Module Lemmas[G:SET][E:ELEM].
+Module Lemmas (G: SET) (E: ELEM).
 
-  Module ESet:=G E.
+  Module ESet := G E.
 
-  Lemma commute : (S:ESet.T)(a1,a2:E.T) 
-    let S1 = (ESet.add a1 (ESet.add a2 S)) in 
-    let S2 = (ESet.add a2 (ESet.add a1 S)) in
-      (a:E.T)(ESet.find a S1)=(ESet.find a S2). 
+  Lemma commute :
+   forall (S : ESet.T) (a1 a2 : E.T),
+   let S1 := ESet.add a1 (ESet.add a2 S) in
+   let S2 := ESet.add a2 (ESet.add a1 S) in
+   forall a : E.T, ESet.find a S1 = ESet.find a S2. 
   
-    Intros.
-    Unfold S1 S2.
-    Elim (E.eq_dec a a1); Elim (E.eq_dec a a2); Intros H1 H2;
-    Try Rewrite <- H1; Try Rewrite <- H2;
-    Repeat 
-      (Try (Rewrite ESet.find_add_true; Auto);
-       Try (Rewrite ESet.find_add_false; Auto); 
-       Auto).
-  Save.
+    intros.
+    unfold S1, S2 in |- *.
+    elim (E.eq_dec a a1); elim (E.eq_dec a a2); intros H1 H2;
+     try  rewrite <- H1; try  rewrite <- H2;
+     repeat
+      (try ( rewrite ESet.find_add_true; auto);
+        try ( rewrite ESet.find_add_false; auto); auto).
+  Qed.
 End Lemmas.
 
 
-Inductive list [A:Set] : Set := nil : (list A) 
-                             | cons : A -> (list A) -> (list A).
+Inductive list (A : Set) : Set :=
+  | nil : list A
+  | cons : A -> list A -> list A.
 
-Module ListDict[E : ELEM]. 
-  Definition T := (list E.T).
+Module ListDict (E: ELEM). 
+  Definition T := list E.T.
   Definition elt := E.T.
    
-  Definition empty := (nil elt).
-  Definition add := [e:elt][s:T] (cons elt e s).
-  Fixpoint find [e:elt; s:T] : bool :=
-        Cases s of 
-          nil => false
-        | (cons e' s') => (ifte (E.eq_dec e e') 
-                                true
-                                (find e s'))
-        end.
-
-  Definition find_empty_false := [e:elt] (refl_equal bool false).
-
-  Lemma find_add_true : 
-        (s:T) (e:E.T) (find e (add e s)) = true.
-    Intros.
-    Simpl.
-    Elim (Reflexivity_provable ? ? (E.eq_dec e e)).
-    Intros.
-    Rewrite H.
-    Auto.
+  Definition empty := nil elt.
+  Definition add (e : elt) (s : T) := cons elt e s.
+  Fixpoint find (e : elt) (s : T) {struct s} : bool :=
+    match s with
+    | nil => false
+    | cons e' s' => ifte (E.eq_dec e e') true (find e s')
+    end.
+
+  Definition find_empty_false (e : elt) := refl_equal false.
+
+  Lemma find_add_true : forall (s : T) (e : E.T), find e (add e s) = true.
+    intros.
+    simpl in |- *.
+    elim (Reflexivity_provable _ _ (E.eq_dec e e)).
+    intros.
+     rewrite H.
+    auto.
 
   Qed.
   
 
   Lemma find_add_false :
-        (s:T) (e:E.T) (e':E.T) ~(e=e') -> 
-	(find e (add e' s))=(find e s).
-    Intros.
-    Simpl.
-    Elim (Disequality_provable ? ? ? H (E.eq_dec e e')).
-    Intros.
-    Rewrite H0.
-    Simpl.
-    Reflexivity.
-  Save.    
+   forall (s : T) (e e' : E.T), e <> e' -> find e (add e' s) = find e s.
+    intros.
+    simpl in |- *.
+    elim (Disequality_provable _ _ _ H (E.eq_dec e e')).
+    intros.
+     rewrite H0.
+    simpl in |- *.
+    reflexivity.
+  Qed.    
   
 
 End ListDict.
@@ -190,4 +185,3 @@ Module L : SET := ListDict.
 
 
 
-
diff --git a/test-suite/modules/Tescik.v b/test-suite/modules/Tescik.v
index 13c28418..8dadace7 100644
--- a/test-suite/modules/Tescik.v
+++ b/test-suite/modules/Tescik.v
@@ -1,30 +1,30 @@
 
 Module Type ELEM.
-  Parameter A:Set.
-  Parameter x:A.
+  Parameter A : Set.
+  Parameter x : A.
 End ELEM.
 
 Module Nat.
-    Definition A:=nat.
-    Definition x:=O.
+    Definition A := nat.
+    Definition x := 0.
 End Nat. 
 
-Module List[X:ELEM].
-  Inductive list : Set := nil : list 
-		       | cons : X.A -> list -> list.
+Module List (X: ELEM).
+  Inductive list : Set :=
+    | nil : list
+    | cons : X.A -> list -> list.
  
-  Definition head := 
-     [l:list]Cases l of 
-	  nil => X.x 
-	| (cons x _) => x
-     end.
+  Definition head (l : list) := match l with
+                                | nil => X.x
+                                | cons x _ => x
+                                end.
 
-  Definition singl := [x:X.A] (cons x nil).
+  Definition singl (x : X.A) := cons x nil.
   
-  Lemma head_singl : (x:X.A)(head (singl x))=x.
-  Auto.
+  Lemma head_singl : forall x : X.A, head (singl x) = x.
+  auto.
   Qed.
 
 End List.
 
-Module N:=(List Nat).
+Module N := List Nat.
\ No newline at end of file
diff --git a/test-suite/modules/fun_objects.v b/test-suite/modules/fun_objects.v
index 0f8eef84..f4dc19b3 100644
--- a/test-suite/modules/fun_objects.v
+++ b/test-suite/modules/fun_objects.v
@@ -1,32 +1,32 @@
-Implicit Arguments On.
+Set Implicit Arguments.
+Unset Strict Implicit.
 
 Module Type SIG.
-  Parameter id:(A:Set)A->A.
+  Parameter id : forall A : Set, A -> A.
 End SIG.
  
-Module M[X:SIG].
-  Definition idid := (X.id X.id).
-  Definition id := (idid X.id).
+Module M (X: SIG).
+  Definition idid := X.id X.id.
+  Definition id := idid X.id.
 End M.
 
-Module N:=M.
+Module N := M.
 
 Module Nat.
   Definition T := nat.
-  Definition x := O.
-  Definition id := [A:Set][x:A]x.
+  Definition x := 0.
+  Definition id (A : Set) (x : A) := x.
 End Nat.
 
-Module Z:=(N Nat).
+Module Z := N Nat.
 
-Check (Z.idid O).
+Check (Z.idid 0).
 
-Module P[Y:SIG] := N.
+Module P (Y: SIG) := N.
 
-Module Y:=P Nat Z.
-
-Check (Y.id O).
+Module Y := P Nat Z.
 
+Check (Y.id 0).
 
 
 
diff --git a/test-suite/modules/grammar.v b/test-suite/modules/grammar.v
index fb734b5d..9657c685 100644
--- a/test-suite/modules/grammar.v
+++ b/test-suite/modules/grammar.v
@@ -1,15 +1,15 @@
 Module N.
-Definition f:=plus.
-Syntax constr level 7: plus [ (f $n $m)] -> [ $n:L "+" $m:E].
-Check (f O O).
+Definition f := plus.
+(* <Warning> : Syntax is discontinued *)
+Check (f 0 0).
 End N.
-Check (N.f O O).
+Check (N.f 0 0).
 Import N.
-Check (N.f O O).
-Check (f O O).
-Module M:=N.
-Check (f O O).
-Check (N.f O O).
+Check (f 0 0).
+Check (f 0 0).
+Module M := N.
+Check (f 0 0).
+Check (f 0 0).
 Import M.
-Check (f O O).
-Check (N.f O O).
+Check (f 0 0).
+Check (N.f 0 0).
\ No newline at end of file
diff --git a/test-suite/modules/ind.v b/test-suite/modules/ind.v
index 94c344bb..a4f9d3a2 100644
--- a/test-suite/modules/ind.v
+++ b/test-suite/modules/ind.v
@@ -1,13 +1,17 @@
 Module Type SIG.
-  Inductive w:Set:=A:w.
-  Parameter f : w->w.
+  Inductive w : Set :=
+      A : w.
+  Parameter f : w -> w.
 End SIG.
 
-Module M:SIG.
-  Inductive w:Set:=A:w.
-  Definition f:=[x]Cases x of A => A end.
+Module M : SIG.
+  Inductive w : Set :=
+      A : w.
+  Definition f x := match x with
+                    | A => A
+                    end.
 End M.
 
-Module N:=M.
+Module N := M.
 
-Check (N.f M.A).
+Check (N.f M.A).
\ No newline at end of file
diff --git a/test-suite/modules/mod_decl.v b/test-suite/modules/mod_decl.v
index 867b8a11..aad493ce 100644
--- a/test-suite/modules/mod_decl.v
+++ b/test-suite/modules/mod_decl.v
@@ -1,55 +1,49 @@
 Module Type SIG.
-  Definition A:Set. (*error*)
-  Axiom A:Set.
+  Axiom A : Set.
 End SIG.
 
 Module M0.
-  Definition A:Set.
-  Exact nat.
-  Save.
+  Definition A : Set.
+  exact nat.
+  Qed.
 End M0.
 
-Module M1:SIG.
-  Definition A:=nat.
+Module M1 : SIG.
+  Definition A := nat.
 End M1.
 
-Module M2<:SIG.
-  Definition A:=nat.
+Module M2 <: SIG.
+  Definition A := nat.
 End M2.
 
-Module M3:=M0.
+Module M3 := M0.
 
-Module M4:SIG:=M0.
+Module M4 : SIG := M0.
 
-Module M5<:SIG:=M0.
+Module M5 <: SIG := M0.
 
 
-Module F[X:SIG]:=X.
-
-
-Declare Module M6.
+Module F (X: SIG) := X.
 
 
 Module Type T.
 
-  Declare Module M0.
-    Lemma A:Set (*error*).
-    Axiom A:Set.
+  Module M0.
+    Axiom A : Set.
   End M0.
   
-  Declare Module M1:SIG.
+  Declare Module M1: SIG.
   
-  Declare Module M2<:SIG.
-    Definition A:=nat.
+  Declare Module M2 <: SIG.
+    Definition A := nat.
   End M2.
   
-  Declare Module M3:=M0.
+  Module M3 := M0.
   
-  Declare Module M4:SIG:=M0.  (* error *)
+  Module M4 : SIG := M0.
   
-  Declare Module M5<:SIG:=M0.
+  Module M5 <: SIG := M0.
 
-  Declare Module M6:=F M0. (* error *)
+  Module M6 := F M0.
 
-  Module M7.
-End T.
\ No newline at end of file
+End T.
diff --git a/test-suite/modules/modeq.v b/test-suite/modules/modeq.v
index 73448dc7..45cf9f12 100644
--- a/test-suite/modules/modeq.v
+++ b/test-suite/modules/modeq.v
@@ -1,22 +1,22 @@
 Module M.
-  Definition T:=nat.
-  Definition x:T:=O.
+  Definition T := nat.
+  Definition x : T := 0.
 End M.
 
 Module Type SIG.
-  Declare Module M:=Top.M.
+  Module M := Top.M.
   Module Type SIG.
-    Parameter T:Set.
+    Parameter T : Set.
   End SIG.
-  Declare Module N:SIG.
+  Declare Module N: SIG.
 End SIG.
 
 Module Z.
-  Module M:=Top.M.
+  Module M := Top.M.
   Module Type SIG.
-    Parameter T:Set.
+    Parameter T : Set.
   End SIG.
-  Module N:=M.
+  Module N := M.
 End Z.
 
-Module A:SIG:=Z.  
+Module A : SIG := Z.  
\ No newline at end of file
diff --git a/test-suite/modules/modul.v b/test-suite/modules/modul.v
index 84942da1..9d24d6ce 100644
--- a/test-suite/modules/modul.v
+++ b/test-suite/modules/modul.v
@@ -1,39 +1,35 @@
 Module M.
-  Parameter rel:nat -> nat -> Prop.
+  Parameter rel : nat -> nat -> Prop.
 
-  Axiom w : (n:nat)(rel O (S n)).
+  Axiom w : forall n : nat, rel 0 (S n).
 
-  Hints Resolve w.
+  Hint Resolve w.
 
-  Grammar constr constr8 := 
-     not_eq [ constr7($a) "#" constr7($b) ] -> [ (rel $a $b) ].
+  (* <Warning> : Grammar is replaced by Notation *)
   
   Print Hint *.
 
-  Lemma w1 : (O#(S O)).
-  Auto.
-  Save.
+  Lemma w1 : rel 0 1.
+  auto.
+  Qed.
 
 End M.
 
+Locate Module M.
+
 (*Lemma w1 : (M.rel O (S O)).
 Auto.
 *)
 
 Import M.
 
-Print Hint *.
-Lemma w1 : (O#(S O)).
-Print Hint.
-Print Hint *.
-
-Auto.
-Save.
+Lemma w1 : rel 0 1.
+auto.
+Qed.
 
-Check (O#O).
+Check (rel 0 0).
 Locate rel.
 
-Locate Library M.
-
-Module N:=Top.M.
+Locate Module M.
 
+Module N := Top.M.
diff --git a/test-suite/modules/obj.v b/test-suite/modules/obj.v
index 2231e084..97337a12 100644
--- a/test-suite/modules/obj.v
+++ b/test-suite/modules/obj.v
@@ -1,16 +1,17 @@
-Implicit Arguments On.
+Set Implicit Arguments.
+Unset Strict Implicit.
 
 Module M. 
-  Definition a:=[s:Set]s.
+  Definition a (s : Set) := s.
   Print a.
 End M.
 
 Print M.a.
 
 Module K.
-  Definition app:=[A,B:Set; f:(A->B); x:A](f x).
+  Definition app (A B : Set) (f : A -> B) (x : A) := f x.
   Module N.
-    Definition apap:=[A,B:Set](app (app 1!A 2!B)).
+    Definition apap (A B : Set) := app (app (A:=A) (B:=B)).
     Print app.
     Print apap.
   End N.
@@ -20,7 +21,6 @@ End K.
 Print K.app.
 Print K.N.apap.
 
-Module W:=K.N.
+Module W := K.N.
 
 Print W.apap.
-
diff --git a/test-suite/modules/objects.v b/test-suite/modules/objects.v
index 418ece44..070f859e 100644
--- a/test-suite/modules/objects.v
+++ b/test-suite/modules/objects.v
@@ -1,33 +1,33 @@
 Module Type SET.
-  Axiom T:Set.
-  Axiom x:T.
+  Axiom T : Set.
+  Axiom x : T.
 End SET.
  
-Implicit Arguments On.
+Set Implicit Arguments.
+Unset Strict Implicit.
 
-Module M[X:SET].
+Module M (X: SET).
   Definition T := nat.
-  Definition x := O.
-  Definition f := [A:Set][x:A]X.x.
+  Definition x := 0.
+  Definition f (A : Set) (x : A) := X.x.
 End M.
 
-Module N:=M.
+Module N := M.
 
 Module Nat.
   Definition T := nat.
-  Definition x := O.
+  Definition x := 0.
 End Nat.
 
-Module Z:=(N Nat).
+Module Z := N Nat.
 
-Check (Z.f O).
+Check (Z.f 0).
 
-Module P[Y:SET] := N.
+Module P (Y: SET) := N.
 
-Module Y:=P Z Nat.
-
-Check (Y.f O).
+Module Y := P Z Nat.
 
+Check (Y.f 0).
 
 
 
diff --git a/test-suite/modules/pliczek.v b/test-suite/modules/pliczek.v
index 6061ace3..f806a7c4 100644
--- a/test-suite/modules/pliczek.v
+++ b/test-suite/modules/pliczek.v
@@ -1,3 +1,3 @@
 Require Export plik.
 
-Definition tutu := [X:Set](toto X).
+Definition tutu (X : Set) := toto X.
\ No newline at end of file
diff --git a/test-suite/modules/plik.v b/test-suite/modules/plik.v
index f1f59df0..50bfd960 100644
--- a/test-suite/modules/plik.v
+++ b/test-suite/modules/plik.v
@@ -1,4 +1,3 @@
-Definition toto:=[x:Set]x.
+Definition toto (x : Set) := x.
 
-Grammar constr constr8 := 
-     toto [ "#" constr7($b) ] -> [ (toto $b) ].
+(* <Warning> : Grammar is replaced by Notation *)
\ No newline at end of file
diff --git a/test-suite/modules/sig.v b/test-suite/modules/sig.v
index eb8736bb..4cb6291d 100644
--- a/test-suite/modules/sig.v
+++ b/test-suite/modules/sig.v
@@ -1,29 +1,29 @@
 Module M.
   Module Type SIG.
-    Parameter T:Set.
-    Parameter x:T.
+    Parameter T : Set.
+    Parameter x : T.
   End SIG.
-  Module N:SIG.
-    Definition T:=nat.
-    Definition x:=O.
+  Module N : SIG.
+    Definition T := nat.
+    Definition x := 0.
   End N.
 End M.
 
-Module N:=M.
+Module N := M.
 
 Module Type SPRYT.
-  Declare Module N.
-    Definition T:=M.N.T.
-    Parameter x:T.
+  Module N.
+    Definition T := M.N.T.
+    Parameter x : T.
   End N.
 End SPRYT.
 
-Module K:SPRYT:=N.  
-Module K':SPRYT:=M.  
+Module K : SPRYT := N.  
+Module K' : SPRYT := M.  
 
 Module Type SIG.
-  Definition T:Set:=M.N.T.
-  Parameter x:T.
+  Definition T : Set := M.N.T.
+  Parameter x : T.
 End SIG.
 
-Module J:SIG:=M.N.
+Module J : SIG := M.N.
\ No newline at end of file
diff --git a/test-suite/modules/sub_objects.v b/test-suite/modules/sub_objects.v
index 1bd4faef..5eec0775 100644
--- a/test-suite/modules/sub_objects.v
+++ b/test-suite/modules/sub_objects.v
@@ -1,33 +1,32 @@
 Set Implicit Arguments.
+Unset Strict Implicit.
 
 
 Module M.
-  Definition id:=[A:Set][x:A]x.
+  Definition id (A : Set) (x : A) := x.
 
   Module Type SIG.
-    Parameter idid:(A:Set)A->A.
+    Parameter idid : forall A : Set, A -> A.
   End SIG.
 
   Module N.
-    Definition idid:=[A:Set][x:A](id x).
-    Grammar constr constr8 := 
-      not_eq [ "#"  constr7($b) ] -> [ (idid $b) ].
-    Notation inc := (plus (S O)). 
+    Definition idid (A : Set) (x : A) := id x.
+    (* <Warning> : Grammar is replaced by Notation *)
+    Notation inc := (plus 1). 
   End N.
 
-  Definition zero:=(N.idid O).
+  Definition zero := N.idid 0.
 
 End M.
 
-Definition zero := (M.N.idid O).
-Definition jeden := (M.N.inc O).
+Definition zero := M.N.idid 0.
+Definition jeden := M.N.inc 0.
 
-Module Goly:=M.N.
+Module Goly := M.N.
 
-Definition Gole_zero := (Goly.idid O).
-Definition Goly_jeden := (Goly.inc O).
+Definition Gole_zero := Goly.idid 0.
+Definition Goly_jeden := Goly.inc 0.
 
 Module Ubrany : M.SIG := M.N.
 
-Definition Ubrane_zero := (Ubrany.idid O).
-
+Definition Ubrane_zero := Ubrany.idid 0.
diff --git a/test-suite/output/Arith.out b/test-suite/output/Arith.out
deleted file mode 100644
index 210dd6ad..00000000
--- a/test-suite/output/Arith.out
+++ /dev/null
@@ -1,4 +0,0 @@
-[n:nat](S (S n))
-     : nat->nat
-[n:nat](S (plus n n))
-     : nat->nat
diff --git a/test-suite/output/Arith.v b/test-suite/output/Arith.v
deleted file mode 100644
index 39989dfc..00000000
--- a/test-suite/output/Arith.v
+++ /dev/null
@@ -1,2 +0,0 @@
-Check [n](S (S n)).
-Check [n](S (plus n n)).
diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out
index 5f13caaf..63137edb 100644
--- a/test-suite/output/Cases.out
+++ b/test-suite/output/Cases.out
@@ -1,4 +1,9 @@
 t_rect = 
-[P:(t->Type); f:([x:=t](x0:x)(P x0)->(P (k x0)))]
- Fix F{F [t:t] : (P t) := <P>Cases t of (k x x0) => (f x0 (F x0)) end}
-     : (P:(t->Type))([x:=t](x0:x)(P x0)->(P (k x0)))->(t:t)(P t)
+fun (P : t -> Type) (f : let x := t in forall x0 : x, P x0 -> P (k x0)) =>
+fix F (t : t) : P t :=
+  match t as t0 return (P t0) with
+  | k x x0 => f x0 (F x0)
+  end
+     : forall P : t -> Type,
+       (let x := t in forall x0 : x, P x0 -> P (k x0)) -> forall t : t, P t
+
diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v
index 7483e8c4..452d3603 100644
--- a/test-suite/output/Cases.v
+++ b/test-suite/output/Cases.v
@@ -1,5 +1,6 @@
 (* Cases with let-in in constructors types *)
 
-Inductive t : Set := k : [x:=t]x -> x.
+Inductive t : Set :=
+    k : let x := t in x -> x.
 
 Print t_rect.
diff --git a/test-suite/output/Coercions.out b/test-suite/output/Coercions.out
index 63e042d8..4b8aa355 100644
--- a/test-suite/output/Coercions.out
+++ b/test-suite/output/Coercions.out
@@ -1,4 +1,6 @@
-(P x)
+P x
      : Prop
-(R x x)
+R x x
      : Prop
+fun (x : foo) (n : nat) => x n
+     : foo -> nat -> nat
diff --git a/test-suite/output/Coercions.v b/test-suite/output/Coercions.v
index 61b69038..c88b143f 100644
--- a/test-suite/output/Coercions.v
+++ b/test-suite/output/Coercions.v
@@ -1,9 +1,15 @@
 (* Submitted by Randy Pollack *)
 
-Record pred [S:Set]: Type := { sp_pred :> S -> Prop }.
-Record rel [S:Set]: Type := { sr_rel :> S -> S -> Prop }.
+Record pred (S : Set) : Type :=  {sp_pred :> S -> Prop}.
+Record rel (S : Set) : Type :=  {sr_rel :> S -> S -> Prop}.
 
 Section testSection.
-Variables S: Set; P: (pred S); R: (rel S); x:S.
+Variables (S : Set) (P : pred S) (R : rel S) (x : S).
 Check (P x).
 Check (R x x).
+End testSection.
+
+(* Check the removal of coercions with target Funclass *)
+
+Record foo : Type :=  {D :> nat -> nat}.
+Check (fun (x : foo) (n : nat) => x n).
diff --git a/test-suite/output/Fixpoint.out b/test-suite/output/Fixpoint.out
new file mode 100644
index 00000000..62c9d395
--- /dev/null
+++ b/test-suite/output/Fixpoint.out
@@ -0,0 +1,11 @@
+fix F (A B : Set) (f : A -> B) (l : list A) {struct l} : 
+list B := match l with
+          | nil => nil (A:=B)
+          | a :: l0 => f a :: F A B f l0
+          end
+     : forall A B : Set, (A -> B) -> list A -> list B
+let fix f (m : nat) : nat := match m with
+                             | 0 => 0
+                             | S m' => f m'
+                             end in f 0
+     : nat
diff --git a/test-suite/output/Fixpoint.v b/test-suite/output/Fixpoint.v
index 270fff4e..fc27e8d2 100644
--- a/test-suite/output/Fixpoint.v
+++ b/test-suite/output/Fixpoint.v
@@ -1,7 +1,18 @@
-Require PolyList.
+Require Import List.
+
+Check
+  (fix F (A B : Set) (f : A -> B) (l : list A) {struct l} : 
+   list B := match l with
+             | nil => nil
+             | a :: l => f a :: F _ _ f l
+             end).
+
+(* V8 printing of this term used to failed in V8.0 and V8.0pl1 (cf bug #860) *)
+Check
+  let fix f (m : nat) : nat :=
+    match m with
+    | O => 0
+    | S m' => f m'
+    end
+  in f 0.
 
-Check Fix F { F/4 : (A,B:Set)(A->B)->(list A)->(list B) :=
- [_,_,f,l]Cases l of
-   nil => (nil ?)
- | (cons a l) => (cons (f a) (F ? ? f l))
- end}.
diff --git a/test-suite/output/Implicit.out b/test-suite/output/Implicit.out
index f9cf9efc..38c5b827 100644
--- a/test-suite/output/Implicit.out
+++ b/test-suite/output/Implicit.out
@@ -1,5 +1,10 @@
-d2 = [x:nat](d1 1!x)
-     : (x,x0:nat)x0=x ->x0=x
+compose (C:=nat) S
+     : (nat -> nat) -> nat -> nat
+ex_intro (P:=fun _ : nat => True) (x:=0) I
+     : ex (fun _ : nat => True)
+d2 = fun x : nat => d1 (y:=x)
+     : forall x x0 : nat, x0 = x -> x0 = x
 
-Positions [1; 2] are implicit
+
+Arguments x, x0 are implicit
 Argument scopes are [nat_scope nat_scope _]
diff --git a/test-suite/output/Implicit.v b/test-suite/output/Implicit.v
index 2dea0d18..0ff7e87f 100644
--- a/test-suite/output/Implicit.v
+++ b/test-suite/output/Implicit.v
@@ -1,18 +1,19 @@
 Set Implicit Arguments.
+Unset Strict Implicit.
 
 (* Suggested by Pierre Casteran (bug #169) *)
 (* Argument 3 is needed to typecheck and should be printed *)
-Definition compose := [A,B,C:Set; f : A-> B ; g : B->C ; x : A] (g (f x)).
-Check (compose 3!nat S).
+Definition compose (A B C : Set) (f : A -> B) (g : B -> C) (x : A) := g (f x).
+Check (compose (C:=nat) S).
 
 (* Better to explicitly display the arguments inferable from a
    position that could disappear after reduction *)
-Inductive ex [A:Set;P:A->Prop] : Prop
-    := ex_intro : (x:A)(P x)->(ex P).
-Check (ex_intro 2![_]True 3!O I).
+Inductive ex (A : Set) (P : A -> Prop) : Prop :=
+    ex_intro : forall x : A, P x -> ex P.
+Check (ex_intro (P:=fun _ => True) (x:=0) I).
 
 (* Test for V8 printing of implicit by names *)
-Definition d1 [y;x;h:x=y:>nat] := h.
-Definition d2 [x] := (!d1 x).
+Definition d1 y x (h : x = y :>nat) := h.
+Definition d2 x := d1 (y:=x).
 
 Print d2.
diff --git a/test-suite/output/InitSyntax.out b/test-suite/output/InitSyntax.out
index d7120f89..4ed72c50 100644
--- a/test-suite/output/InitSyntax.out
+++ b/test-suite/output/InitSyntax.out
@@ -1,6 +1,10 @@
-Inductive sig2 [A : Set; P : A->Prop; Q : A->Prop] : Set :=
-    exist2 : (x:A)(P x)->(Q x)->(sig2 A P Q)
-(EX x:nat|x=x)
+Inductive sig2 (A : Set) (P : A -> Prop) (Q : A -> Prop) : Set :=
+    exist2 : forall x : A, P x -> Q x -> sig2 P Q
+For sig2: Argument A is implicit
+For exist2: Argument A is implicit
+For sig2: Argument scopes are [type_scope type_scope type_scope]
+For exist2: Argument scopes are [type_scope _ _ _ _ _]
+exists x : nat, x = x
      : Prop
-[b:bool](if b then b else b)
-     : bool->bool
+fun b : bool => if b then b else b
+     : bool -> bool
diff --git a/test-suite/output/InitSyntax.v b/test-suite/output/InitSyntax.v
index 90fad371..eb39782e 100644
--- a/test-suite/output/InitSyntax.v
+++ b/test-suite/output/InitSyntax.v
@@ -1,4 +1,4 @@
 (* Soumis par Pierre *)
-Print  sig2.
-Check (EX x:nat|x=x).
-Check [b:bool]if b then b else b.
+Print sig2.
+Check (exists x : nat, x = x).
+Check (fun b : bool => if b then b else b).
diff --git a/test-suite/output/Intuition.out b/test-suite/output/Intuition.out
index cadb35c6..5831c9f4 100644
--- a/test-suite/output/Intuition.out
+++ b/test-suite/output/Intuition.out
@@ -2,6 +2,6 @@
   
   m : Z
   n : Z
-  H : `m >= n`
+  H : (m >= n)%Z
   ============================
-   `m >= m`
+   (m >= m)%Z
diff --git a/test-suite/output/Intuition.v b/test-suite/output/Intuition.v
index c0508c90..5f1914d2 100644
--- a/test-suite/output/Intuition.v
+++ b/test-suite/output/Intuition.v
@@ -1,5 +1,5 @@
-Require ZArith_base.
-Goal (m,n:Z) `m >= n` -> `m >= m` /\ `m >= n`.
-Intros; Intuition.
+Require Import ZArith_base.
+Goal forall m n : Z, (m >= n)%Z -> (m >= m)%Z /\ (m >= n)%Z.
+intros; intuition.
 Show.
 Abort.
diff --git a/test-suite/output/Nametab.out b/test-suite/output/Nametab.out
index 505821d7..d0f15f0e 100644
--- a/test-suite/output/Nametab.out
+++ b/test-suite/output/Nametab.out
@@ -1,27 +1,35 @@
-id is not a defined object
-K.id is not a defined object
-N.K.id is not a defined object
 Constant Top.Q.N.K.id
+  (shorter name to refer to it in current context is Q.N.K.id)
 Constant Top.Q.N.K.id
-K is not a defined object
-N.K is not a defined object
+  (shorter name to refer to it in current context is Q.N.K.id)
+Constant Top.Q.N.K.id
+  (shorter name to refer to it in current context is Q.N.K.id)
+Constant Top.Q.N.K.id
+Constant Top.Q.N.K.id
+  (shorter name to refer to it in current context is Q.N.K.id)
+No module is referred to by basename K
+No module is referred to by name N.K
 Module Top.Q.N.K
 Module Top.Q.N.K
-N is not a defined object
+No module is referred to by basename N
 Module Top.Q.N
 Module Top.Q.N
 Module Top.Q
 Module Top.Q
-id is not a defined object
 Constant Top.Q.N.K.id
-N.K.id is not a defined object
+  (shorter name to refer to it in current context is K.id)
+Constant Top.Q.N.K.id
+Constant Top.Q.N.K.id
+  (shorter name to refer to it in current context is K.id)
 Constant Top.Q.N.K.id
+  (shorter name to refer to it in current context is K.id)
 Constant Top.Q.N.K.id
+  (shorter name to refer to it in current context is K.id)
 Module Top.Q.N.K
-N.K is not a defined object
+No module is referred to by name N.K
 Module Top.Q.N.K
 Module Top.Q.N.K
-N is not a defined object
+No module is referred to by basename N
 Module Top.Q.N
 Module Top.Q.N
 Module Top.Q
diff --git a/test-suite/output/Nametab.v b/test-suite/output/Nametab.v
index 61966c7c..a1a7579b 100644
--- a/test-suite/output/Nametab.v
+++ b/test-suite/output/Nametab.v
@@ -1,7 +1,7 @@
 Module Q.
   Module N.
     Module K.
-      Definition id:=Set.
+      Definition id := Set.
     End K.
   End N.
 End Q.
@@ -12,18 +12,17 @@ End Q.
 (* OK  *) Locate Q.N.K.id.
 (* OK  *) Locate Top.Q.N.K.id.
 
-(* Bad *) Locate K.
-(* Bad *) Locate N.K.
-(* OK  *) Locate Q.N.K.
-(* OK  *) Locate Top.Q.N.K.
+(* Bad *) Locate Module K.
+(* Bad *) Locate Module N.K.
+(* OK  *) Locate Module Q.N.K.
+(* OK  *) Locate Module Top.Q.N.K.
 
-(* Bad *) Locate N.
-(* OK  *) Locate Q.N.
-(* OK  *) Locate Top.Q.N.
-
-(* OK  *) Locate Q.
-(* OK  *) Locate Top.Q.
+(* Bad *) Locate Module N.
+(* OK  *) Locate Module Q.N.
+(* OK  *) Locate Module Top.Q.N.
 
+(* OK  *) Locate Module Q.
+(* OK  *) Locate Module Top.Q.
 
 
 Import Q.N.
@@ -35,14 +34,14 @@ Import Q.N.
 (* OK  *) Locate Q.N.K.id.
 (* OK  *) Locate Top.Q.N.K.id.
 
-(* OK  *) Locate K.
-(* Bad *) Locate N.K.
-(* OK  *) Locate Q.N.K.
-(* OK  *) Locate Top.Q.N.K.
+(* OK  *) Locate Module K.
+(* Bad *) Locate Module N.K.
+(* OK  *) Locate Module Q.N.K.
+(* OK  *) Locate Module Top.Q.N.K.
 
-(* Bad *) Locate N.
-(* OK  *) Locate Q.N.
-(* OK  *) Locate Top.Q.N.
+(* Bad *) Locate Module N.
+(* OK  *) Locate Module Q.N.
+(* OK  *) Locate Module Top.Q.N.
 
-(* OK  *) Locate Q.
-(* OK  *) Locate Top.Q.
+(* OK  *) Locate Module Q.
+(* OK  *) Locate Module Top.Q.
diff --git a/test-suite/output/Notations.out b/test-suite/output/Notations.out
new file mode 100644
index 00000000..3ab3de45
--- /dev/null
+++ b/test-suite/output/Notations.out
@@ -0,0 +1,24 @@
+true ? 0; 1
+     : nat
+if true as x return (x ? nat; bool) then 0 else true
+     : true ? nat; bool
+Defining 'proj1' as keyword
+fun e : nat * nat => proj1 e
+     : nat * nat -> nat
+Defining 'decomp' as keyword
+decomp (true, true) as t, u in (t, u)
+     : bool * bool
+!(0 = 0)
+     : Prop
+forall n : nat, n = 0
+     : Prop
+!(0 = 0)
+     : Prop
+3 + 3
+     : Z
+3 + 3
+     : znat
+[1; 2; 4]
+     : list nat
+(1; 2, 4)
+     : nat * nat * nat
diff --git a/test-suite/output/Notations.v b/test-suite/output/Notations.v
new file mode 100644
index 00000000..4382975e
--- /dev/null
+++ b/test-suite/output/Notations.v
@@ -0,0 +1,68 @@
+(**********************************************************************)
+(* Notations for if and let (submitted by Roland Zumkeller)           *)
+
+Notation "a ? b ; c" := (if a then b else c) (at level 10).
+
+Check (true ? 0 ; 1).
+Check if true as x return (if x then nat else bool) then 0 else true.
+
+Notation "'proj1' t" := (let (a,_) := t in a) (at level 1).
+
+Check (fun e : nat * nat => proj1 e).
+
+Notation "'decomp' a 'as' x , y 'in' b" := (let (x,y) := a in b) (at level 1).
+
+Check (decomp (true,true) as t, u in (t,u)).
+
+(**********************************************************************)
+(* Behaviour wrt to binding variables (submitted by Roland Zumkeller) *)
+
+Notation "! A" := (forall _:nat, A) (at level 60).
+
+Check ! (0=0).
+Check forall n, n=0.
+Check forall n:nat, 0=0.
+
+(**********************************************************************)
+(* Conflict between notation and notation below coercions             *)
+
+(* Case of a printer conflict *)
+
+Require Import BinInt.
+Coercion Zpos : positive >-> Z.
+Open Scope Z_scope.
+
+  (* Check that (Zpos 3) is better printed by the printer for Z than
+     by the printer for positive *)
+
+Check (3 + Zpos 3).
+
+(* Case of a num printer only below coercion (submitted by Georges Gonthier) *)
+
+Open Scope nat_scope.
+
+Inductive znat : Set := Zpos (n : nat) | Zneg (m : nat).
+Coercion Zpos: nat >-> znat.
+ 
+Delimit Scope znat_scope with znat.
+Open Scope znat_scope.
+ 
+Variable addz : znat -> znat -> znat.
+Notation "z1 + z2" := (addz z1 z2) : znat_scope.
+
+  (* Check that "3+3", where 3 is in nat and the coercion to znat is implicit,
+     is printed the same way, and not "S 2 + S 2" as if numeral printing was 
+     only tested with coercion still present *)
+
+Check (3+3).
+
+(**********************************************************************)
+(* Check recursive notations                                          *)
+ 
+Require Import List.
+Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).
+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).
diff --git a/test-suite/output/RealSyntax.out b/test-suite/output/RealSyntax.out
index fa30656b..e6f7556d 100644
--- a/test-suite/output/RealSyntax.out
+++ b/test-suite/output/RealSyntax.out
@@ -1,4 +1,4 @@
-``32``
+32%R
      : R
-``-31``
+(-31)%R
      : R
diff --git a/test-suite/output/RealSyntax.v b/test-suite/output/RealSyntax.v
index d976dcc1..15ae6601 100644
--- a/test-suite/output/RealSyntax.v
+++ b/test-suite/output/RealSyntax.v
@@ -1,3 +1,3 @@
-Require Reals.
-Check ``32``.
-Check ``-31``.
+Require Import Reals.
+Check 32%R.
+Check (-31)%R.
diff --git a/test-suite/output/Remark2.out b/test-suite/output/Remark2.out
deleted file mode 100644
index adabc2fe..00000000
--- a/test-suite/output/Remark2.out
+++ /dev/null
@@ -1 +0,0 @@
-B.C.t is not a defined object
diff --git a/test-suite/output/Remark2.v b/test-suite/output/Remark2.v
deleted file mode 100644
index e1ef57a0..00000000
--- a/test-suite/output/Remark2.v
+++ /dev/null
@@ -1,8 +0,0 @@
-Section A.
-Section B.
-Section C.
-Remark t : True. Proof I.
-End C.
-End B.
-End A.
-Locate B.C.t.
diff --git a/test-suite/output/Sum.out b/test-suite/output/Sum.out
index 22422602..bda6a68b 100644
--- a/test-suite/output/Sum.out
+++ b/test-suite/output/Sum.out
@@ -1,6 +1,6 @@
-nat+nat+{True}
+nat + nat + {True}
      : Set
-{True}+{True}+{True}
+{True} + {True} + {True}
      : Set
-nat+{True}+{True}
+nat + {True} + {True}
      : Set
diff --git a/test-suite/output/Sum.v b/test-suite/output/Sum.v
index aceadd12..f12285a6 100644
--- a/test-suite/output/Sum.v
+++ b/test-suite/output/Sum.v
@@ -1,3 +1,3 @@
-Check nat+nat+{True}.
-Check {True}+{True}+{True}.
-Check nat+{True}+{True}.
+Check (nat + nat + {True}).
+Check ({True} + {True} + {True}).
+Check (nat + {True} + {True}).
diff --git a/test-suite/output/Tactics.out b/test-suite/output/Tactics.out
new file mode 100644
index 00000000..71c59e43
--- /dev/null
+++ b/test-suite/output/Tactics.out
@@ -0,0 +1 @@
+intro H; split; [  a H |  e H ].
diff --git a/test-suite/output/Tactics.v b/test-suite/output/Tactics.v
new file mode 100644
index 00000000..24a33651
--- /dev/null
+++ b/test-suite/output/Tactics.v
@@ -0,0 +1,9 @@
+(* Test printing of Tactic Notation *)
+
+Tactic Notation "a" constr(x) := apply x.
+Tactic Notation "e" constr(x) := exact x.
+
+Lemma test : True -> True /\ True.
+intro H; split; [a H|e H].
+Show Script.
+Qed.
diff --git a/test-suite/output/TranspModtype.v b/test-suite/output/TranspModtype.v
index 27b1fb9f..68eff33a 100644
--- a/test-suite/output/TranspModtype.v
+++ b/test-suite/output/TranspModtype.v
@@ -1,17 +1,17 @@
 Module Type SIG.
-  Axiom A:Set.
-  Axiom B:Set.
+  Axiom A : Set.
+  Axiom B : Set.
 End SIG.
 
-Module M:SIG.
-  Definition A:=nat.
-  Definition B:=nat.
+Module M : SIG.
+  Definition A := nat.
+  Definition B := nat.
 End M.
 
-Module N<:SIG:=M.
+Module N <: SIG := M.
 
-Module TranspId[X:SIG] <: SIG with Definition A:=X.A := X.
-Module OpaqueId[X:SIG] : SIG with Definition A:=X.A := X.
+Module TranspId (X: SIG) <: SIG with Definition A := X.A := X.
+Module OpaqueId (X: SIG) : SIG with Definition A := X.A := X.
 
 Module TrM := TranspId M.
 Module OpM := OpaqueId M.
diff --git a/test-suite/output/ZSyntax.out b/test-suite/output/ZSyntax.out
index 0fdc5b7e..cbfb9f20 100644
--- a/test-suite/output/ZSyntax.out
+++ b/test-suite/output/ZSyntax.out
@@ -1,26 +1,26 @@
-`32`
+32%Z
      : Z
-[f:(nat->Z)]`(f O)+0`
-     : (nat->Z)->Z
-[x:positive](POS (xO x))
-     : positive->Z
-[x:positive]`(POS x)+1`
-     : positive->Z
-[x:positive](POS x)
-     : positive->Z
-[x:positive](NEG (xO x))
-     : positive->Z
-[x:positive]`(POS (xO x))+0`
-     : positive->Z
-[x:positive]`(Zopp (POS (xO x)))`
-     : positive->Z
-[x:positive]`(Zopp (POS (xO x)))+0`
-     : positive->Z
-`(inject_nat (0))+1`
+fun f : nat -> Z => (f 0%nat + 0)%Z
+     : (nat -> Z) -> Z
+fun x : positive => Zpos (xO x)
+     : positive -> Z
+fun x : positive => (Zpos x + 1)%Z
+     : positive -> Z
+fun x : positive => Zpos x
+     : positive -> Z
+fun x : positive => Zneg (xO x)
+     : positive -> Z
+fun x : positive => (Zpos (xO x) + 0)%Z
+     : positive -> Z
+fun x : positive => (- Zpos (xO x))%Z
+     : positive -> Z
+fun x : positive => (- Zpos (xO x) + 0)%Z
+     : positive -> Z
+(Z_of_nat 0 + 1)%Z
      : Z
-`0+(inject_nat (plus (0) (0)))`
+(0 + Z_of_nat (0 + 0))%Z
      : Z
-`(inject_nat (0)) = 0`
+Z_of_nat 0 = 0%Z
      : Prop
-`0+(inject_nat (11))`
+(0 + Z_of_nat 11)%Z
      : Z
diff --git a/test-suite/output/ZSyntax.v b/test-suite/output/ZSyntax.v
index 49442b75..289a1e3f 100644
--- a/test-suite/output/ZSyntax.v
+++ b/test-suite/output/ZSyntax.v
@@ -1,17 +1,17 @@
-Require ZArith.
-Check `32`.
-Check [f:nat->Z]`(f O) + 0`.
-Check [x:positive]`(POS (xO x))`.
-Check [x:positive]`(POS x)+1`.
-Check [x:positive]`(POS x)`.
-Check [x:positive]`(NEG (xO x))`.
-Check [x:positive]`(POS (xO x))+0`.
-Check [x:positive]`(Zopp (POS (xO x)))`.
-Check [x:positive]`(Zopp (POS (xO x)))+0`.
-Check `(inject_nat O)+1`.
-Check (Zplus `0` (inject_nat (plus O O))).
-Check `(inject_nat O)=0`.
+Require Import ZArith.
+Check 32%Z.
+Check (fun f : nat -> Z => (f 0%nat + 0)%Z).
+Check (fun x : positive => Zpos (xO x)).
+Check (fun x : positive => (Zpos x + 1)%Z).
+Check (fun x : positive => Zpos x).
+Check (fun x : positive => Zneg (xO x)).
+Check (fun x : positive => (Zpos (xO x) + 0)%Z).
+Check (fun x : positive => (- Zpos (xO x))%Z).
+Check (fun x : positive => (- Zpos (xO x) + 0)%Z).
+Check (Z_of_nat 0 + 1)%Z.
+Check (0 + Z_of_nat (0 + 0))%Z.
+Check (Z_of_nat 0 = 0%Z).
 
 (* Submitted by Pierre Casteran *)
-Require Arith.
-Check (Zplus `0` (inject_nat (11))).
+Require Import Arith.
+Check (0 + Z_of_nat 11)%Z.
diff --git a/test-suite/output/implicits.out b/test-suite/output/implicits.out
deleted file mode 100644
index e4837199..00000000
--- a/test-suite/output/implicits.out
+++ /dev/null
@@ -1,4 +0,0 @@
-(compose 3!nat S)
-     : (nat->nat)->nat->nat
-(ex_intro 2![_:nat]True 3!(0) I)
-     : (ex [_:nat]True)
diff --git a/test-suite/output/implicits.v b/test-suite/output/implicits.v
deleted file mode 100644
index d7ea7227..00000000
--- a/test-suite/output/implicits.v
+++ /dev/null
@@ -1,13 +0,0 @@
-Set Implicit Arguments.
-
-(* Suggested by Pierre Casteran (bug #169) *)
-(* Argument 3 is needed to typecheck and should be printed *)
-Definition compose := [A,B,C:Set; f : A-> B ; g : B->C ; x : A] (g (f x)).
-Check (compose 3!nat S).
-
-(* Better to explicitly display the arguments inferable from a
-   position that could disappear after reduction *)
-Inductive ex [A:Set;P:A->Prop] : Prop
-    := ex_intro : (x:A)(P x)->(ex P).
-Check (ex_intro 2![_]True 3!O I).
-
diff --git a/test-suite/success/Abstract.v8 b/test-suite/success/Abstract.v
index 21a985bc..fc8800a5 100644
--- a/test-suite/success/Abstract.v8
+++ b/test-suite/success/Abstract.v
@@ -24,3 +24,4 @@ induction n.
 Defined.
 
 End S.
+
diff --git a/test-suite/success/Case1.v b/test-suite/success/Case1.v
index 2d5a5134..ea9b654d 100644
--- a/test-suite/success/Case1.v
+++ b/test-suite/success/Case1.v
@@ -2,14 +2,14 @@
 
 Section NATIND2.
 Variable P : nat -> Type.
-Variable H0 : (P O).
-Variable H1 : (P (S O)).
-Variable H2 : (n:nat)(P n)->(P (S (S n))).
-Fixpoint nat_ind2 [n:nat] : (P n) :=
-         <P>Cases n of  
-                        O     => H0
-                  | (S O)     => H1
-                  | (S (S n)) => (H2 n (nat_ind2 n))
-        end.
+Variable H0 : P 0.
+Variable H1 : P 1.
+Variable H2 : forall n : nat, P n -> P (S (S n)).
+Fixpoint nat_ind2 (n : nat) : P n :=
+  match n as x return (P x) with
+  | O => H0
+  | S O => H1
+  | S (S n) => H2 n (nat_ind2 n)
+  end.
 End NATIND2.
 
diff --git a/test-suite/success/Case10.v b/test-suite/success/Case10.v
index 73413c47..378859e9 100644
--- a/test-suite/success/Case10.v
+++ b/test-suite/success/Case10.v
@@ -2,25 +2,27 @@
 (*     To test compilation of dependent case      *)
 (*      Multiple Patterns                         *)
 (* ============================================== *)
-Inductive skel: Type :=
-     PROP: skel
-   | PROD: skel->skel->skel.
+Inductive skel : Type :=
+  | PROP : skel
+  | PROD : skel -> skel -> skel.
 
 Parameter Can : skel -> Type.
-Parameter default_can : (s:skel) (Can s).
+Parameter default_can : forall s : skel, Can s.
 
 
-Type [s1,s2:skel]
-      <[s1,_:skel](Can s1)>Cases s1 s2 of
-          PROP PROP => (default_can PROP)
-        | s1 _ => (default_can s1)
-        end.
+Type
+  (fun s1 s2 : skel =>
+   match s1, s2 return (Can s1) with
+   | PROP, PROP => default_can PROP
+   | s1, _ => default_can s1
+   end).
 
 
-Type [s1,s2:skel]
-<[s1:skel][_:skel](Can s1)>Cases s1 s2 of
-  PROP                 PROP => (default_can PROP)
-| (PROP as s)             _ => (default_can s)
-| ((PROD s1 s2) as s)  PROP => (default_can s)
-| ((PROD s1 s2) as s)   _   => (default_can s)
-end.
+Type
+  (fun s1 s2 : skel =>
+   match s1, s2 return (Can s1) with
+   | PROP, PROP => default_can PROP
+   | PROP as s, _ => default_can s
+   | PROD s1 s2 as s, PROP => default_can s
+   | PROD s1 s2 as s, _ => default_can s
+   end).
diff --git a/test-suite/success/Case11.v b/test-suite/success/Case11.v
index 580cd87d..fd5d139c 100644
--- a/test-suite/success/Case11.v
+++ b/test-suite/success/Case11.v
@@ -3,9 +3,11 @@
 
 Section A.
 
-Variables Alpha:Set; Beta:Set.
+Variables (Alpha : Set) (Beta : Set).
 
-Definition nodep_prod_of_dep: (sigS Alpha [a:Alpha]Beta)-> Alpha*Beta:=
-[c] Cases c of (existS a b)=>(a,b) end.
+Definition nodep_prod_of_dep (c : sigS (fun a : Alpha => Beta)) :
+  Alpha * Beta := match c with
+                  | existS a b => (a, b)
+                  end.
 
 End A.
diff --git a/test-suite/success/Case12.v b/test-suite/success/Case12.v
index 284695f4..f6a0d578 100644
--- a/test-suite/success/Case12.v
+++ b/test-suite/success/Case12.v
@@ -1,60 +1,73 @@
 (* This example was proposed by Cuihtlauac ALVARADO *)
 
-Require PolyList.
+Require Import List.
 
-Fixpoint mult2 [n:nat] : nat :=
-Cases n of
-| O => O
-| (S n) => (S (S (mult2 n)))
-end.
+Fixpoint mult2 (n : nat) : nat :=
+  match n with
+  | O => 0
+  | S n => S (S (mult2 n))
+  end.
 
 Inductive list : nat -> Set :=
-| nil : (list O)
-| cons : (n:nat)(list (mult2 n))->(list (S (S (mult2 n)))).
+  | nil : list 0
+  | cons : forall n : nat, list (mult2 n) -> list (S (S (mult2 n))).
 
 Type
-[P:((n:nat)(list n)->Prop);
- f:(P O nil);
- f0:((n:nat; l:(list (mult2 n)))
-      (P (mult2 n) l)->(P (S (S (mult2 n))) (cons n l)))]
- Fix F
-   {F [n:nat; l:(list n)] : (P n l) :=
-      <P>Cases l of
-        nil => f
-      | (cons n0 l0) => (f0 n0 l0 (F (mult2 n0) l0))
-      end}.
+  (fun (P : forall n : nat, list n -> Prop) (f : P 0 nil)
+     (f0 : forall (n : nat) (l : list (mult2 n)),
+           P (mult2 n) l -> P (S (S (mult2 n))) (cons n l)) =>
+   fix F (n : nat) (l : list n) {struct l} : P n l :=
+     match l as x0 in (list x) return (P x x0) with
+     | nil => f
+     | cons n0 l0 => f0 n0 l0 (F (mult2 n0) l0)
+     end).
 
 Inductive list' : nat -> Set :=
-| nil' : (list' O)
-| cons' : (n:nat)[m:=(mult2 n)](list' m)->(list' (S (S m))).
+  | nil' : list' 0
+  | cons' : forall n : nat, let m := mult2 n in list' m -> list' (S (S m)).
 
-Fixpoint length [n; l:(list' n)] : nat :=
-  Cases l of
-     nil' => O
-  | (cons' _ m l0) => (S (length m l0))
+Fixpoint length n (l : list' n) {struct l} : nat :=
+  match l with
+  | nil' => 0
+  | cons' _ m l0 => S (length m l0)
   end.
 
 Type
-[P:((n:nat)(list' n)->Prop);
- f:(P O nil');
- f0:((n:nat)
-      [m:=(mult2 n)](l:(list' m))(P m l)->(P (S (S m)) (cons' n l)))]
- Fix F
-   {F [n:nat; l:(list' n)] : (P n l) :=
-      <P>
-        Cases l of
-          nil' => f
-        | (cons' n0 m l0) => (f0 n0 l0 (F m l0))
-        end}.
+  (fun (P : forall n : nat, list' n -> Prop) (f : P 0 nil')
+     (f0 : forall n : nat,
+           let m := mult2 n in
+           forall l : list' m, P m l -> P (S (S m)) (cons' n l)) =>
+   fix F (n : nat) (l : list' n) {struct l} : P n l :=
+     match l as x0 in (list' x) return (P x x0) with
+     | nil' => f
+     | cons' n0 m l0 => f0 n0 l0 (F m l0)
+     end).
 
 (* Check on-the-fly insertion of let-in patterns for compatibility *)
 
 Inductive list'' : nat -> Set :=
-| nil'' : (list'' O)
-| cons'' : (n:nat)[m:=(mult2 n)](list'' m)->[p:=(S (S m))](list'' p).
-
-Check Fix length { length [n; l:(list'' n)] : nat :=
-         Cases l of
-           nil'' => O
-         | (cons'' n l0) => (S (length (mult2 n) l0))
-         end }.
+  | nil'' : list'' 0
+  | cons'' :
+      forall n : nat,
+      let m := mult2 n in list'' m -> let p := S (S m) in list'' p.
+
+Check
+  (fix length n (l : list'' n) {struct l} : nat :=
+     match l with
+     | nil'' => 0
+     | cons'' n l0 => S (length (mult2 n) l0)
+     end).
+
+(* Check let-in in both parameters and in constructors *)
+
+Inductive list''' (A:Set) (B:=(A*A)%type) (a:A) : B -> Set :=
+  | nil''' : list''' A a (a,a)
+  | cons''' : 
+     forall a' : A, let m := (a',a) in list''' A a m -> list''' A a (a,a).
+
+Fixpoint length''' (A:Set) (B:=(A*A)%type) (a:A) (m:B) (l:list''' A a m) 
+  {struct l} : nat :=
+  match l with
+  | nil''' => 0
+  | cons''' _ m l0 => S (length''' A a m l0)
+  end.
diff --git a/test-suite/success/Case13.v b/test-suite/success/Case13.v
index 71c9191d..f19e24b8 100644
--- a/test-suite/success/Case13.v
+++ b/test-suite/success/Case13.v
@@ -1,33 +1,69 @@
 (* Check coercions in patterns *)
 
 Inductive I : Set :=
-  C1 : nat -> I
-| C2 : I -> I.
+  | C1 : nat -> I
+  | C2 : I -> I.
 
 Coercion C1 : nat >-> I.
 
 (* Coercion at the root of pattern *)
-Check [x]Cases x of (C2 n) => O | O => O | (S n) => n end.
+Check (fun x => match x with
+                | C2 n => 0
+                | O => 0
+                | S n => n
+                end).
 
 (* Coercion not at the root of pattern *)
-Check [x]Cases x of (C2 O) => O | _ => O end.
+Check (fun x => match x with
+                | C2 O => 0
+                | _ => 0
+                end).
 
 (* Unification and coercions inside patterns *)
-Check [x:(option nat)]Cases x of None => O | (Some O) => O | _ => O end.
+Check
+  (fun x : option nat => match x with
+                         | None => 0
+                         | Some O => 0
+                         | _ => 0
+                         end).
 
 (* Coercion up to delta-conversion, and unification *)
-Coercion somenat := (Some nat).
-Check [x]Cases x of None => O | O => O | (S n) => n end.
+Coercion somenat := Some (A:=nat).
+Check (fun x => match x with
+                | None => 0
+                | O => 0
+                | S n => n
+                end).
 
 (* Coercions with parameters *)
-Inductive listn : nat-> Set := 
-  niln : (listn O) 
-| consn : (n:nat)nat->(listn n) -> (listn (S n)).
+Inductive listn : nat -> Set :=
+  | niln : listn 0
+  | consn : forall n : nat, nat -> listn n -> listn (S n).
 
 Inductive I' : nat -> Set :=
-  C1' : (n:nat) (listn n) -> (I' n)
-| C2' : (n:nat) (I' n) -> (I' n).
+  | C1' : forall n : nat, listn n -> I' n
+  | C2' : forall n : nat, I' n -> I' n.
 
 Coercion C1' : listn >-> I'.
-Check [x:(I' O)]Cases x of (C2' _ _) => O | niln => O | _ => O end.
-Check [x:(I' O)]Cases x of (C2' _ niln) => O | _ => O end.
+Check (fun x : I' 0 => match x with
+                       | C2' _ _ => 0
+                       | niln => 0
+                       | _ => 0
+                       end).
+Check (fun x : I' 0 => match x with
+                       | C2' _ niln => 0
+                       | _ => 0
+                       end).
+
+(* Check insertion of coercions around matched subterm *)
+
+Parameter A:Set.
+Parameter f:> A -> nat.
+
+Inductive J : Set := D : A -> J.
+
+Check (fun x => match x with
+                | D 0 => 0
+                | D _ => 1
+                end).
+
diff --git a/test-suite/success/Case14.v b/test-suite/success/Case14.v
index edecee79..f106a64c 100644
--- a/test-suite/success/Case14.v
+++ b/test-suite/success/Case14.v
@@ -4,13 +4,18 @@
 Axiom bad : false = true.
 
 Definition try1 : False :=
-  <[b:bool][_:false=b](if b then False else True)>
-  Cases bad of refl_equal => I end.
+  match bad in (_ = b) return (if b then False else True) with
+  | refl_equal => I
+  end.
 
 Definition try2 : False :=
-  <[b:bool][_:false=b]((if b then False else True)::Prop)>
-  Cases bad of refl_equal => I end.
+  match bad in (_ = b) return ((if b then False else True):Prop) with
+  | refl_equal => I
+  end.
 
 Definition try3 : False :=
-  <[b:bool][_:false=b](([b':bool] if b' then False else True) b)>
-  Cases bad of refl_equal => I end.
+  match
+    bad in (_ = b) return ((fun b' : bool => if b' then False else True) b)
+  with
+  | refl_equal => I
+  end.
diff --git a/test-suite/success/Case15.v b/test-suite/success/Case15.v
index 22944520..8431880d 100644
--- a/test-suite/success/Case15.v
+++ b/test-suite/success/Case15.v
@@ -2,20 +2,23 @@
    apparently of inductive type *)
 
 (* Check that the non dependency in y is OK both in V7 and V8 *)
-Check ([x;y:Prop;z]<[x][z]x=x \/ z=z>Cases x y z of
-           | O y z' => (or_introl ? (z'=z') (refl_equal ? O))
-           | _ y O => (or_intror ?? (refl_equal ? O))
-           | x y _ => (or_introl ?? (refl_equal ? x))
-           end).
+Check
+  (fun x (y : Prop) z =>
+   match x, y, z return (x = x \/ z = z) with
+   | O, y, z' => or_introl (z' = z') (refl_equal 0)
+   | _, y, O => or_intror _ (refl_equal 0)
+   | x, y, _ => or_introl _ (refl_equal x)
+   end).
 
 (* Suggested by Pierre Letouzey (PR#207) *)
-Inductive Boite : Set := 
-  boite : (b:bool)(if b then nat else nat*nat)->Boite. 
+Inductive Boite : Set :=
+    boite : forall b : bool, (if b then nat else (nat * nat)%type) -> Boite. 
 
-Definition test := [B:Boite]<nat>Cases B of 
-  (boite true n) => n 
-| (boite false (n,m)) => (plus n m)
-end.
+Definition test (B : Boite) :=
+  match B return nat with
+  | boite true n => n
+  | boite false (n, m) => n + m
+  end.
 
 (* Check lazyness of compilation ... future work
 Inductive I : Set := c : (b:bool)(if b then bool else nat)->I.
diff --git a/test-suite/success/Case16.v b/test-suite/success/Case16.v
index 3f142fae..77016bbf 100644
--- a/test-suite/success/Case16.v
+++ b/test-suite/success/Case16.v
@@ -2,8 +2,9 @@
 (* Test dependencies in constructors                                  *)
 (**********************************************************************)
 
-Check [x : {b:bool|if b then True else False}]
-   <[x]let (b,_) = x in if b then True else False>Cases x of
-   | (exist true y)  => y
-   | (exist false z) => z
-   end.
+Check
+  (fun x : {b : bool | if b then True else False} =>
+   match x return (let (b, _) := x in if b then True else False) with
+   | exist true y => y
+   | exist false z => z
+   end).
diff --git a/test-suite/success/Case17.v b/test-suite/success/Case17.v
index 07d64958..061e136e 100644
--- a/test-suite/success/Case17.v
+++ b/test-suite/success/Case17.v
@@ -3,43 +3,48 @@
    (Simplification of an example from file parsing2.v of the Coq'Art
     exercises) *)
 
-Require Import PolyList.
+Require Import List.
 
-Variable parse_rel : (list bool) -> (list bool) -> nat -> Prop.
+Variable parse_rel : list bool -> list bool -> nat -> Prop.
 
-Variables l0:(list bool); rec:(l' : (list bool))
-    (le (length l') (S (length l0))) ->
-    {l'' : (list bool) &
-    {t : nat | (parse_rel l' l'' t) /\ (le (length l'') (length l'))}} +
-    {(l'' : (list bool))(t : nat)~ (parse_rel l' l'' t)}.
+Variables (l0 : list bool)
+  (rec :
+     forall l' : list bool,
+     length l' <= S (length l0) ->
+     {l'' : list bool & 
+     {t : nat | parse_rel l' l'' t /\ length l'' <= length l'}} +
+     {(forall (l'' : list bool) (t : nat), ~ parse_rel l' l'' t)}).
 
-Axiom HHH : (A:Prop)A.
+Axiom HHH : forall A : Prop, A.
 
-Check (Cases (rec l0 (HHH ?)) of
-      | (inleft (existS (cons false l1) _)) => (inright ? ? (HHH ?))
-      | (inleft (existS (cons true l1) (exist t1 (conj Hp Hl)))) =>
-         (inright ? ? (HHH ?))
-      | (inleft (existS _ _)) => (inright ? ? (HHH ?))
-      | (inright Hnp) => (inright ? ? (HHH ?))
-      end ::
-   {l'' : (list bool) &
-   {t : nat | (parse_rel (cons true l0) l'' t) /\ (le (length l'') (S (length l0)))}} +
-   {(l'' : (list bool)) (t : nat) ~ (parse_rel (cons true l0) l'' t)}).
+Check
+  (match rec l0 (HHH _) with
+   | inleft (existS (false :: l1) _) => inright _ (HHH _)
+   | inleft (existS (true :: l1) (exist t1 (conj Hp Hl))) =>
+       inright _ (HHH _)
+   | inleft (existS _ _) => inright _ (HHH _)
+   | inright Hnp => inright _ (HHH _)
+   end
+   :{l'' : list bool & 
+    {t : nat | parse_rel (true :: l0) l'' t /\ length l'' <= S (length l0)}} +
+    {(forall (l'' : list bool) (t : nat), ~ parse_rel (true :: l0) l'' t)}).
  
 (* The same but with relative links to l0 and rec *)
  
-Check [l0:(list bool);rec:(l' : (list bool))
-    (le (length l') (S (length l0))) ->
-    {l'' : (list bool) &
-    {t : nat | (parse_rel l' l'' t) /\ (le (length l'') (length l'))}} +
-    {(l'' : (list bool)) (t : nat) ~ (parse_rel l' l'' t)}]
-   (Cases (rec l0 (HHH ?)) of
-      | (inleft (existS (cons false l1) _)) => (inright ? ? (HHH ?))
-      | (inleft (existS (cons true l1) (exist t1 (conj Hp Hl)))) =>
-         (inright ? ? (HHH ?))
-      | (inleft (existS _ _)) => (inright ? ? (HHH ?))
-      | (inright Hnp) => (inright ? ? (HHH ?))
-      end ::
-   {l'' : (list bool) &
-   {t : nat | (parse_rel (cons true l0) l'' t) /\ (le (length l'') (S (length l0)))}} +
-   {(l'' : (list bool)) (t : nat) ~ (parse_rel (cons true l0) l'' t)}).
+Check
+  (fun (l0 : list bool)
+     (rec : forall l' : list bool,
+            length l' <= S (length l0) ->
+            {l'' : list bool & 
+            {t : nat | parse_rel l' l'' t /\ length l'' <= length l'}} +
+            {(forall (l'' : list bool) (t : nat), ~ parse_rel l' l'' t)}) =>
+   match rec l0 (HHH _) with
+   | inleft (existS (false :: l1) _) => inright _ (HHH _)
+   | inleft (existS (true :: l1) (exist t1 (conj Hp Hl))) =>
+       inright _ (HHH _)
+   | inleft (existS _ _) => inright _ (HHH _)
+   | inright Hnp => inright _ (HHH _)
+   end
+   :{l'' : list bool & 
+    {t : nat | parse_rel (true :: l0) l'' t /\ length l'' <= S (length l0)}} +
+    {(forall (l'' : list bool) (t : nat), ~ parse_rel (true :: l0) l'' t)}).
diff --git a/test-suite/success/Case18.v b/test-suite/success/Case18.v
new file mode 100644
index 00000000..a57fe413
--- /dev/null
+++ b/test-suite/success/Case18.v
@@ -0,0 +1,11 @@
+(* Check or-patterns *)
+
+Definition g x :=
+  match x with ((((1 as x),_) | (_,x)), (_,(2 as y))|(y,_)) => (x,y) end.
+
+Eval compute in (g ((1,2),(3,4))).
+(* (1,3) *)
+
+Eval compute in (g ((1,4),(3,2))).
+(* (1,2) *)
+
diff --git a/test-suite/success/Case2.v b/test-suite/success/Case2.v
index 0aa7b5be..db433695 100644
--- a/test-suite/success/Case2.v
+++ b/test-suite/success/Case2.v
@@ -3,9 +3,10 @@
 (*  Nested patterns                               *)
 (* ============================================== *)
 
-Type <[n:nat]n=n>Cases O of 
-                    O => (refl_equal nat O) 
-                  | m => (refl_equal nat m) 
-end.
+Type
+  match 0 as n return (n = n) with
+  | O => refl_equal 0
+  | m => refl_equal m
+  end.
 
 
diff --git a/test-suite/success/Case5.v b/test-suite/success/Case5.v
index fe49cdf9..833621d2 100644
--- a/test-suite/success/Case5.v
+++ b/test-suite/success/Case5.v
@@ -1,14 +1,13 @@
 
-Parameter ff: (n,m:nat)~n=m -> ~(S n)=(S m).
-Parameter discr_r : (n:nat) ~(O=(S n)).
-Parameter discr_l : (n:nat) ~((S n)=O).
+Parameter ff : forall n m : nat, n <> m -> S n <> S m.
+Parameter discr_r : forall n : nat, 0 <> S n.
+Parameter discr_l : forall n : nat, S n <> 0.
 
 
-Type 
-[n:nat] 
-  <[n:nat]n=O\/~n=O>Cases n of 
-      O     => (or_introl ? ~O=O (refl_equal ? O))      
-   |  (S O) => (or_intror (S O)=O ? (discr_l O))
-   |  (S (S x)) => (or_intror (S (S x))=O ? (discr_l (S x)))
- 
-  end.
+Type
+  (fun n : nat =>
+   match n return (n = 0 \/ n <> 0) with
+   | O => or_introl (0 <> 0) (refl_equal 0)
+   | S O => or_intror (1 = 0) (discr_l 0)
+   | S (S x) => or_intror (S (S x) = 0) (discr_l (S x))
+   end).
diff --git a/test-suite/success/Case6.v b/test-suite/success/Case6.v
index a262251e..cc1994e7 100644
--- a/test-suite/success/Case6.v
+++ b/test-suite/success/Case6.v
@@ -1,19 +1,15 @@
-Parameter ff: (n,m:nat)~n=m -> ~(S n)=(S m).
-Parameter discr_r : (n:nat) ~(O=(S n)).
-Parameter discr_l : (n:nat) ~((S n)=O).
-
-Fixpoint eqdec [n:nat] : (m:nat) n=m \/ ~n=m := 
-[m:nat]
- <[n,m:nat] n=m \/ ~n=m>Cases n m of
-      O   O   => (or_introl ? ~O=O (refl_equal ? O))
-
-   |  O (S x) => (or_intror O=(S x) ? (discr_r x))
-
-   | (S x) O  => (or_intror ? ~(S x)=O (discr_l x))
-
-   | ((S x) as N) ((S y) as M) =>  
-      <N=M\/~N=M>Cases (eqdec x y) of
-        (or_introl h) => (or_introl  ? ~N=M (f_equal nat nat S x y h))
-      | (or_intror h) => (or_intror N=M ? (ff x y h))   
+Parameter ff : forall n m : nat, n <> m -> S n <> S m.
+Parameter discr_r : forall n : nat, 0 <> S n.
+Parameter discr_l : forall n : nat, S n <> 0.
+
+Fixpoint eqdec (n m : nat) {struct n} : n = m \/ n <> m :=
+  match n, m return (n = m \/ n <> m) with
+  | O, O => or_introl (0 <> 0) (refl_equal 0)
+  | O, S x => or_intror (0 = S x) (discr_r x)
+  | S x, O => or_intror _ (discr_l x)
+  | S x as N, S y as M =>
+      match eqdec x y return (N = M \/ N <> M) with
+      | or_introl h => or_introl (N <> M) (f_equal S h)
+      | or_intror h => or_intror (N = M) (ff x y h)
       end
- end.
+  end.
diff --git a/test-suite/success/Case7.v b/test-suite/success/Case7.v
index 6e2aea48..6e4b2003 100644
--- a/test-suite/success/Case7.v
+++ b/test-suite/success/Case7.v
@@ -1,16 +1,17 @@
-Inductive List [A:Set] :Set := 
- Nil:(List A) | Cons:A->(List A)->(List A).
+Inductive List (A : Set) : Set :=
+  | Nil : List A
+  | Cons : A -> List A -> List A.
 
-Inductive Empty [A:Set] : (List A)-> Prop := 
-  intro_Empty: (Empty A (Nil A)).
+Inductive Empty (A : Set) : List A -> Prop :=
+    intro_Empty : Empty A (Nil A).
 
-Parameter inv_Empty : (A:Set)(a:A)(x:(List A)) ~(Empty A (Cons A a x)).
+Parameter
+  inv_Empty : forall (A : Set) (a : A) (x : List A), ~ Empty A (Cons A a x).
 
 
 Type
-[A:Set] 
-[l:(List A)]
-  <[l:(List A)](Empty A l) \/ ~(Empty A l)>Cases l of 
-        Nil  =>  (or_introl ? ~(Empty A (Nil A)) (intro_Empty A))
-   |  ((Cons a y) as b) =>  (or_intror (Empty A b) ? (inv_Empty A a y))
-  end.
+  (fun (A : Set) (l : List A) =>
+   match l return (Empty A l \/ ~ Empty A l) with
+   | Nil => or_introl (~ Empty A (Nil A)) (intro_Empty A)
+   | Cons a y as b => or_intror (Empty A b) (inv_Empty A a y)
+   end).
diff --git a/test-suite/success/Case8.v b/test-suite/success/Case8.v
new file mode 100644
index 00000000..a6113ab9
--- /dev/null
+++ b/test-suite/success/Case8.v
@@ -0,0 +1,11 @@
+(* Check dependencies in the matching predicate (was failing in V8.0pl1) *)
+
+Inductive t : forall x : 0 = 0, x = x -> Prop :=
+    c : forall x : 0 = 0, t x (refl_equal x).
+
+Definition a (x : t _ (refl_equal (refl_equal 0))) :=
+  match x return match x with
+                 | c y => Prop
+                 end with
+  | c y => y = y
+  end.
diff --git a/test-suite/success/Case9.v b/test-suite/success/Case9.v
index a5d07405..a8534a0b 100644
--- a/test-suite/success/Case9.v
+++ b/test-suite/success/Case9.v
@@ -1,55 +1,61 @@
-Inductive List [A:Set] :Set := 
- Nil:(List A) | Cons:A->(List A)->(List A).
-
-Inductive eqlong : (List nat)-> (List nat)-> Prop :=
- eql_cons : (n,m:nat)(x,y:(List nat)) 
-            (eqlong x y) -> (eqlong (Cons nat n x) (Cons nat m y))
-| eql_nil :  (eqlong (Nil nat) (Nil nat)).
-
-
-Parameter V1 : (eqlong (Nil nat) (Nil nat))\/ ~(eqlong (Nil nat) (Nil nat)).
-Parameter V2 : (a:nat)(x:(List nat))
-      (eqlong (Nil nat) (Cons nat a x))\/ ~(eqlong (Nil nat)(Cons nat a x)).
-Parameter V3 : (a:nat)(x:(List nat))
-      (eqlong  (Cons nat a x)  (Nil nat))\/ ~(eqlong (Cons nat a x) (Nil nat)).
-Parameter V4 : (a:nat)(x:(List nat))(b:nat)(y:(List nat))
-      (eqlong  (Cons nat a x)(Cons nat b y))
-        \/ ~(eqlong (Cons nat a x) (Cons nat b y)).
-
-Parameter nff : (n,m:nat)(x,y:(List nat)) 
-               ~(eqlong x y)-> ~(eqlong (Cons nat n x) (Cons nat m y)).
-Parameter inv_r : (n:nat)(x:(List nat)) ~(eqlong (Nil nat) (Cons nat n x)).
-Parameter inv_l : (n:nat)(x:(List nat)) ~(eqlong (Cons nat n x) (Nil nat)).
-
-Fixpoint eqlongdec [x:(List nat)]: (y:(List nat))(eqlong x y)\/~(eqlong x y) :=
-[y:(List nat)]
- <[x,y:(List nat)](eqlong x y)\/~(eqlong x y)>Cases x y of
-      Nil Nil   => (or_introl ? ~(eqlong (Nil nat) (Nil nat))  eql_nil)
-
-   |  Nil ((Cons a x) as L) =>(or_intror (eqlong (Nil nat) L)  ? (inv_r a x))
-
-   |  ((Cons a x) as L) Nil => (or_intror (eqlong L (Nil nat)) ? (inv_l a x))
-
-   | ((Cons a x) as L1) ((Cons b y) as L2) =>  
-      <(eqlong L1 L2) \/~(eqlong L1 L2)>Cases (eqlongdec x y) of
-        (or_introl h) => (or_introl  ? ~(eqlong L1 L2) (eql_cons a b x y h))
-      | (or_intror h) => (or_intror (eqlong L1 L2) ? (nff a b x y h))   
+Inductive List (A : Set) : Set :=
+  | Nil : List A
+  | Cons : A -> List A -> List A.
+
+Inductive eqlong : List nat -> List nat -> Prop :=
+  | eql_cons :
+      forall (n m : nat) (x y : List nat),
+      eqlong x y -> eqlong (Cons nat n x) (Cons nat m y)
+  | eql_nil : eqlong (Nil nat) (Nil nat).
+
+
+Parameter V1 : eqlong (Nil nat) (Nil nat) \/ ~ eqlong (Nil nat) (Nil nat).
+Parameter
+  V2 :
+    forall (a : nat) (x : List nat),
+    eqlong (Nil nat) (Cons nat a x) \/ ~ eqlong (Nil nat) (Cons nat a x).
+Parameter
+  V3 :
+    forall (a : nat) (x : List nat),
+    eqlong (Cons nat a x) (Nil nat) \/ ~ eqlong (Cons nat a x) (Nil nat).
+Parameter
+  V4 :
+    forall (a : nat) (x : List nat) (b : nat) (y : List nat),
+    eqlong (Cons nat a x) (Cons nat b y) \/
+    ~ eqlong (Cons nat a x) (Cons nat b y).
+
+Parameter
+  nff :
+    forall (n m : nat) (x y : List nat),
+    ~ eqlong x y -> ~ eqlong (Cons nat n x) (Cons nat m y).
+Parameter
+  inv_r : forall (n : nat) (x : List nat), ~ eqlong (Nil nat) (Cons nat n x).
+Parameter
+  inv_l : forall (n : nat) (x : List nat), ~ eqlong (Cons nat n x) (Nil nat).
+
+Fixpoint eqlongdec (x y : List nat) {struct x} :
+ eqlong x y \/ ~ eqlong x y :=
+  match x, y return (eqlong x y \/ ~ eqlong x y) with
+  | Nil, Nil => or_introl (~ eqlong (Nil nat) (Nil nat)) eql_nil
+  | Nil, Cons a x as L => or_intror (eqlong (Nil nat) L) (inv_r a x)
+  | Cons a x as L, Nil => or_intror (eqlong L (Nil nat)) (inv_l a x)
+  | Cons a x as L1, Cons b y as L2 =>
+      match eqlongdec x y return (eqlong L1 L2 \/ ~ eqlong L1 L2) with
+      | or_introl h => or_introl (~ eqlong L1 L2) (eql_cons a b x y h)
+      | or_intror h => or_intror (eqlong L1 L2) (nff a b x y h)
       end
- end.
+  end.
 
 
 Type
- <[x,y:(List nat)](eqlong x y)\/~(eqlong x y)>Cases (Nil nat) (Nil nat) of
-      Nil Nil   => (or_introl ? ~(eqlong (Nil nat) (Nil nat))  eql_nil)
-
-   |  Nil ((Cons a x) as L) =>(or_intror (eqlong (Nil nat) L)  ? (inv_r a x))
-
-   |  ((Cons a x) as L) Nil => (or_intror (eqlong L (Nil nat)) ? (inv_l a x))
-
-   | ((Cons a x) as L1) ((Cons b y) as L2) =>  
-      <(eqlong L1 L2) \/~(eqlong L1 L2)>Cases (eqlongdec x y) of
-        (or_introl h) => (or_introl  ? ~(eqlong L1 L2) (eql_cons a b x y h))
-      | (or_intror h) => (or_intror (eqlong L1 L2) ? (nff a b x y h))   
+  match Nil nat as x, Nil nat as y return (eqlong x y \/ ~ eqlong x y) with
+  | Nil, Nil => or_introl (~ eqlong (Nil nat) (Nil nat)) eql_nil
+  | Nil, Cons a x as L => or_intror (eqlong (Nil nat) L) (inv_r a x)
+  | Cons a x as L, Nil => or_intror (eqlong L (Nil nat)) (inv_l a x)
+  | Cons a x as L1, Cons b y as L2 =>
+      match eqlongdec x y return (eqlong L1 L2 \/ ~ eqlong L1 L2) with
+      | or_introl h => or_introl (~ eqlong L1 L2) (eql_cons a b x y h)
+      | or_intror h => or_intror (eqlong L1 L2) (nff a b x y h)
       end
- end.
+  end.
 
diff --git a/test-suite/success/CaseAlias.v b/test-suite/success/CaseAlias.v
index b5f0e730..32d85779 100644
--- a/test-suite/success/CaseAlias.v
+++ b/test-suite/success/CaseAlias.v
@@ -1,21 +1,21 @@
 (* This has been a bug reported by Y. Bertot *)
 Inductive expr : Set :=
-   b: expr -> expr ->  expr
- | u: expr ->  expr
- | a: expr
- | var: nat ->  expr .
+  | b : expr -> expr -> expr
+  | u : expr -> expr
+  | a : expr
+  | var : nat -> expr.
 
-Fixpoint f [t : expr] : expr :=
- Cases t of
- | (b t1 t2) => (b (f t1) (f t2))
- | a => a
- | x => (b t a)
- end.
+Fixpoint f (t : expr) : expr :=
+  match t with
+  | b t1 t2 => b (f t1) (f t2)
+  | a => a
+  | x => b t a
+  end.
 
-Fixpoint f2 [t : expr] : expr :=
- Cases t of
- | (b t1 t2) => (b (f2 t1) (f2 t2))
- | a => a
- | x => (b x a)
- end.
+Fixpoint f2 (t : expr) : expr :=
+  match t with
+  | b t1 t2 => b (f2 t1) (f2 t2)
+  | a => a
+  | x => b x a
+  end.
 
diff --git a/test-suite/success/Cases.v b/test-suite/success/Cases.v
index 6ccd669a..7c2b7c0b 100644
--- a/test-suite/success/Cases.v
+++ b/test-suite/success/Cases.v
@@ -2,89 +2,118 @@
 (* Pattern-matching when non inductive terms occur                          *)
 
 (* Dependent form of annotation *)
-Type <[n:nat]nat>Cases O eq of O x => O | (S x) y => x end.
-Type <[_,_:nat]nat>Cases O eq O of O x y => O | (S x) y z => x end.
+Type match 0 as n, eq return nat with
+     | O, x => 0
+     | S x, y => x
+     end.
+Type match 0, eq, 0 return nat with
+     | O, x, y => 0
+     | S x, y, z => x
+     end.
 
 (* Non dependent form of annotation *)
-Type <nat>Cases O eq of O x => O | (S x) y => x end.
+Type match 0, eq return nat with
+     | O, x => 0
+     | S x, y => x
+     end.
 
 (* Combining dependencies and non inductive arguments *)
-Type [A:Set][a:A][H:O=O]<[x][H]H==H>Cases H a of _ _ => (refl_eqT ? H) end.
+Type
+  (fun (A : Set) (a : A) (H : 0 = 0) =>
+   match H in (_ = x), a return (H = H) with
+   | _, _ => refl_equal H
+   end).
 
 (* Interaction with coercions *)
 Parameter bool2nat : bool -> nat.
 Coercion bool2nat : bool >-> nat.
-Check [x](Cases x of O => true | (S _) => O end :: nat).
+Check (fun x => match x with
+                | O => true
+                | S _ => 0
+                end:nat).
 
 (****************************************************************************)
 (* All remaining examples come from Cristina Cornes' V6 TESTS/MultCases.v   *)
 
-Inductive IFExpr : Set := 
-          Var  : nat -> IFExpr
-        | Tr   : IFExpr
-        | Fa   : IFExpr
-        | IfE   : IFExpr -> IFExpr -> IFExpr -> IFExpr.
+Inductive IFExpr : Set :=
+  | Var : nat -> IFExpr
+  | Tr : IFExpr
+  | Fa : IFExpr
+  | IfE : IFExpr -> IFExpr -> IFExpr -> IFExpr.
 
-Inductive List [A:Set] :Set := 
- Nil:(List A) | Cons:A->(List A)->(List A).
+Inductive List (A : Set) : Set :=
+  | Nil : List A
+  | Cons : A -> List A -> List A.
 
-Inductive listn : nat-> Set := 
-  niln : (listn O) 
-| consn : (n:nat)nat->(listn n) -> (listn (S n)).
+Inductive listn : nat -> Set :=
+  | niln : listn 0
+  | consn : forall n : nat, nat -> listn n -> listn (S n).
 
-Inductive Listn [A:Set] : nat-> Set := 
-  Niln : (Listn A O) 
-| Consn : (n:nat)nat->(Listn A n) -> (Listn A (S n)).
+Inductive Listn (A : Set) : nat -> Set :=
+  | Niln : Listn A 0
+  | Consn : forall n : nat, nat -> Listn A n -> Listn A (S n).
 
-Inductive Le : nat->nat->Set :=
-  LeO: (n:nat)(Le O n) 
-| LeS: (n,m:nat)(Le n m) -> (Le (S n) (S m)).
+Inductive Le : nat -> nat -> Set :=
+  | LeO : forall n : nat, Le 0 n
+  | LeS : forall n m : nat, Le n m -> Le (S n) (S m).
 
-Inductive LE [n:nat] : nat->Set := 
-    LE_n : (LE n n) | LE_S : (m:nat)(LE n m)->(LE n (S m)).
+Inductive LE (n : nat) : nat -> Set :=
+  | LE_n : LE n n
+  | LE_S : forall m : nat, LE n m -> LE n (S m).
 
-Require Bool.
+Require Import Bool.
 
 
 
-Inductive PropForm : Set := 
-          Fvar : nat -> PropForm
-        | Or   : PropForm -> PropForm -> PropForm .
+Inductive PropForm : Set :=
+  | Fvar : nat -> PropForm
+  | Or : PropForm -> PropForm -> PropForm.
 
 Section testIFExpr.
-Definition  Assign:= nat->bool.
+Definition Assign := nat -> bool.
 Parameter Prop_sem : Assign -> PropForm -> bool.
 
-Type [A:Assign][F:PropForm] 
-    <bool>Cases F of
-           (Fvar n)   => (A n)
-         | (Or F G)   => (orb (Prop_sem A F) (Prop_sem A G))
-    end.
-
-Type [A:Assign][H:PropForm] 
-    <bool>Cases H of
-           (Fvar n)   => (A n)
-         | (Or F G)   => (orb (Prop_sem A F) (Prop_sem A G))
-    end.
+Type
+  (fun (A : Assign) (F : PropForm) =>
+   match F return bool with
+   | Fvar n => A n
+   | Or F G => Prop_sem A F || Prop_sem A G
+   end).
+
+Type
+  (fun (A : Assign) (H : PropForm) =>
+   match H return bool with
+   | Fvar n => A n
+   | Or F G => Prop_sem A F || Prop_sem A G
+   end).
 End testIFExpr.
 
 
 
-Type [x:nat]<nat>Cases x of O => O | x => x end.
+Type (fun x : nat => match x return nat with
+                     | O => 0
+                     | x => x
+                     end).
 
 Section testlist.
-Parameter A:Set.
-Inductive list : Set := nil : list | cons : A->list->list.
-Parameter inf: A->A->Prop.
+Parameter A : Set.
+Inductive list : Set :=
+  | nil : list
+  | cons : A -> list -> list.
+Parameter inf : A -> A -> Prop.
 
 
-Definition list_Lowert2 :=
-   [a:A][l:list](<Prop>Cases l of nil => True 
-                               | (cons b l) =>(inf a b) end).
+Definition list_Lowert2 (a : A) (l : list) :=
+  match l return Prop with
+  | nil => True
+  | cons b l => inf a b
+  end.
 
-Definition titi :=
-   [a:A][l:list](<list>Cases l of nil => l
-                               | (cons b l) => l end).
+Definition titi (a : A) (l : list) :=
+  match l return list with
+  | nil => l
+  | cons b l => l
+  end.
 Reset list.
 End testlist.
 
@@ -93,444 +122,490 @@ End testlist.
 (* ------------------- *)
 
 
-Type  <nat>Cases O of O => O | _ => O end.
-
-Type <nat>Cases O of
-               (O as b) => b 
-             | (S O)  => O
-             | (S (S x)) => x end.
+Type match 0 return nat with
+     | O => 0
+     | _ => 0
+     end.
 
-Type Cases O of
-               (O as b) => b 
-             | (S O)  => O
-             | (S (S x)) => x end.
+Type match 0 return nat with
+     | O as b => b
+     | S O => 0
+     | S (S x) => x
+     end.
 
+Type match 0 with
+     | O as b => b
+     | S O => 0
+     | S (S x) => x
+     end.
 
-Type [x:nat]<nat>Cases x of
-                          (O as b) => b 
-                        | (S x)  => x end.
 
-Type              [x:nat]Cases x of
-                          (O as b) => b 
-                        | (S x)  => x end.
+Type (fun x : nat => match x return nat with
+                     | O as b => b
+                     | S x => x
+                     end).
 
-Type <nat>Cases O of 
-                          (O as b) => b 
-                        | (S x)  => x end.
+Type (fun x : nat => match x with
+                     | O as b => b
+                     | S x => x
+                     end).
 
-Type <nat>Cases O of 
-                          x  => x 
-                       end.
+Type match 0 return nat with
+     | O as b => b
+     | S x => x
+     end.
 
-Type  Cases O of 
-                          x  => x 
-                       end.
+Type match 0 return nat with
+     | x => x
+     end.
 
-Type <nat>Cases O of
-                              O => O
-                         | ((S x) as b) => b
-                        end.
+Type match 0 with
+     | x => x
+     end.
 
-Type [x:nat]<nat>Cases x of
-                              O => O
-                         | ((S x) as b) => b
-                        end.
+Type match 0 return nat with
+     | O => 0
+     | S x as b => b
+     end.
 
-Type [x:nat] Cases x of
-                              O => O
-                         | ((S x) as b) => b
-                        end.
+Type (fun x : nat => match x return nat with
+                     | O => 0
+                     | S x as b => b
+                     end).
 
+Type (fun x : nat => match x with
+                     | O => 0
+                     | S x as b => b
+                     end).
 
-Type <nat>Cases O of
-         O => O
-    | (S x) => O
-      end.
 
+Type match 0 return nat with
+     | O => 0
+     | S x => 0
+     end.
 
-Type <nat*nat>Cases O of
-                              O => (O,O)
-                         | (S x) =>  (x,O)
-                        end.
 
-Type                    Cases O of
-                              O => (O,O)
-                         | (S x) =>  (x,O)
-                        end.
+Type match 0 return (nat * nat) with
+     | O => (0, 0)
+     | S x => (x, 0)
+     end.
 
-Type <nat->nat>Cases O of
-                              O => [n:nat]O
-                         | (S x) =>  [n:nat]O
-                        end.
+Type match 0 with
+     | O => (0, 0)
+     | S x => (x, 0)
+     end.
 
-Type                   Cases O of
-                              O => [n:nat]O
-                         | (S x) =>  [n:nat]O
-                        end.
+Type
+  match 0 return (nat -> nat) with
+  | O => fun n : nat => 0
+  | S x => fun n : nat => 0
+  end.
 
+Type match 0 with
+     | O => fun n : nat => 0
+     | S x => fun n : nat => 0
+     end.
 
-Type <nat->nat>Cases O of
-                              O => [n:nat]O
-                         | (S x) =>  [n:nat](plus x n)
-                        end.
 
-Type                    Cases O of
-                              O => [n:nat]O
-                         | (S x) =>  [n:nat](plus x n)
-                        end.
+Type
+  match 0 return (nat -> nat) with
+  | O => fun n : nat => 0
+  | S x => fun n : nat => x + n
+  end.
 
+Type match 0 with
+     | O => fun n : nat => 0
+     | S x => fun n : nat => x + n
+     end.
 
-Type <nat>Cases O of
-                              O => O
-                         | ((S x) as b) => (plus b x)
-                         end.
 
-Type <nat>Cases O of
-              O => O
-          | ((S (x as a)) as b) => (plus b a)
-                         end.
-Type  Cases O of
-              O => O
-          | ((S (x as a)) as b) => (plus b a)
-                         end.
+Type match 0 return nat with
+     | O => 0
+     | S x as b => b + x
+     end.
 
+Type match 0 return nat with
+     | O => 0
+     | S a as b => b + a
+     end.
+Type match 0 with
+     | O => 0
+     | S a as b => b + a
+     end.
 
-Type  Cases O of
-                              O => O
-                         |  _  => O
-                        end.
 
-Type <nat>Cases O of
-                  O => O
-               |  x => x
-                 end.
+Type match 0 with
+     | O => 0
+     | _ => 0
+     end.
 
-Type <nat>Cases O (S O) of
-                             x  y => (plus x y)
-                        end.
-
-Type      Cases O (S O) of
-                             x  y => (plus x y)
-                        end.
- 
-Type <nat>Cases O (S O) of
-                             O  y => y
-                          | (S x) y => (plus x y) 
-                        end.
+Type match 0 return nat with
+     | O => 0
+     | x => x
+     end.
 
-Type              Cases O (S O) of
-                             O  y => y
-                          | (S x) y => (plus x y) 
-                        end.
+Type match 0, 1 return nat with
+     | x, y => x + y
+     end.
 
+Type match 0, 1 with
+     | x, y => x + y
+     end.
+ 
+Type match 0, 1 return nat with
+     | O, y => y
+     | S x, y => x + y
+     end.
 
-Type    <nat>Cases O (S O) of
-                      O  x =>  x
-             |      (S y) O =>  y
-             |        x y  => (plus x y)
-           end.
+Type match 0, 1 with
+     | O, y => y
+     | S x, y => x + y
+     end.
 
 
+Type match 0, 1 return nat with
+     | O, x => x
+     | S y, O => y
+     | x, y => x + y
+     end.
 
 
-Type        Cases O (S O) of
-                      O  x => (plus x O)
-             |      (S y) O =>  (plus y O)
-             |        x y  => (plus x y)
-           end.
 
-Type 
-          <nat>Cases O (S O) of
-                      O  x => (plus x O)
-             |      (S y) O =>  (plus y O)
-             |        x y  => (plus x y)
-           end.
 
+Type match 0, 1 with
+     | O, x => x + 0
+     | S y, O => y + 0
+     | x, y => x + y
+     end.
 
-Type 
-          <nat>Cases O (S O) of
-                      O  x =>  x 
-             | ((S x) as b) (S y) => (plus (plus b x) y)
-             |    x y  => (plus x y)
-           end.
+Type
+  match 0, 1 return nat with
+  | O, x => x + 0
+  | S y, O => y + 0
+  | x, y => x + y
+  end.
 
 
-Type         Cases O (S O) of
-                    O  x =>  x 
-             | ((S x) as b) (S y) => (plus (plus b x) y)
-             |    x y  => (plus x y)
-           end.
+Type
+  match 0, 1 return nat with
+  | O, x => x
+  | S x as b, S y => b + x + y
+  | x, y => x + y
+  end.
 
 
-Type [l:(List nat)]<(List nat)>Cases l of 
-                         Nil => (Nil nat)
-                      | (Cons  a l) => l
-                      end.
+Type
+  match 0, 1 with
+  | O, x => x
+  | S x as b, S y => b + x + y
+  | x, y => x + y
+  end.
 
-Type [l:(List nat)]  Cases l of 
-                         Nil => (Nil nat)
-                      | (Cons  a l) => l
-                      end.
 
-Type <nat>Cases (Nil nat) of 
-                         Nil =>O
-                      | (Cons  a l) => (S a)
-                      end.
-Type Cases (Nil nat) of 
-                         Nil =>O
-                      | (Cons  a l) => (S a)
-                      end.
+Type
+  (fun l : List nat =>
+   match l return (List nat) with
+   | Nil => Nil nat
+   | Cons a l => l
+   end).
+
+Type (fun l : List nat => match l with
+                          | Nil => Nil nat
+                          | Cons a l => l
+                          end).
+
+Type match Nil nat return nat with
+     | Nil => 0
+     | Cons a l => S a
+     end.
+Type match Nil nat with
+     | Nil => 0
+     | Cons a l => S a
+     end.
 
-Type <(List nat)>Cases (Nil nat) of 
-                        (Cons  a l) => l
-                       | x => x
-                      end.
+Type match Nil nat return (List nat) with
+     | Cons a l => l
+     | x => x
+     end.
 
-Type              Cases (Nil nat) of 
-                        (Cons  a l) => l
-                       | x => x
-                      end.
+Type match Nil nat with
+     | Cons a l => l
+     | x => x
+     end.
 
-Type <(List nat)>Cases (Nil nat) of 
-                         Nil => (Nil nat)
-                      | (Cons  a l) => l
-                      end.
+Type
+  match Nil nat return (List nat) with
+  | Nil => Nil nat
+  | Cons a l => l
+  end.
 
-Type             Cases (Nil nat) of 
-                         Nil => (Nil nat)
-                      | (Cons  a l) => l
-                      end.
+Type match Nil nat with
+     | Nil => Nil nat
+     | Cons a l => l
+     end.
 
 
-Type 
-   <nat>Cases O of 
-      O => O
-    | (S x) => <nat>Cases (Nil nat) of 
-                         Nil => x
-                      | (Cons  a l) => (plus x a)
-                      end
-     end.
+Type
+  match 0 return nat with
+  | O => 0
+  | S x => match Nil nat return nat with
+           | Nil => x
+           | Cons a l => x + a
+           end
+  end.
 
-Type 
-   Cases O of 
-      O => O
-    | (S x) => Cases (Nil nat) of 
-                         Nil => x
-                      | (Cons  a l) => (plus x a)
-                      end
-     end.
+Type
+  match 0 with
+  | O => 0
+  | S x => match Nil nat with
+           | Nil => x
+           | Cons a l => x + a
+           end
+  end.
 
-Type 
- [y:nat]Cases y of 
-      O => O
-    | (S x) => Cases (Nil nat) of 
-                         Nil => x
-                      | (Cons  a l) => (plus x a)
-                      end
-     end.
+Type
+  (fun y : nat =>
+   match y with
+   | O => 0
+   | S x => match Nil nat with
+            | Nil => x
+            | Cons a l => x + a
+            end
+   end).
 
 
-Type 
-   <nat>Cases O (Nil nat) of 
-      O       x => O
-    | (S x)  Nil => x
-    | (S x) (Cons  a l) => (plus x a)      
-     end.
+Type
+  match 0, Nil nat return nat with
+  | O, x => 0
+  | S x, Nil => x
+  | S x, Cons a l => x + a
+  end.
 
 
 
-Type [n:nat][l:(listn n)]<[_:nat]nat>Cases l of 
-                         niln => O
-                      |    x  => O
-                      end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l return nat with
+   | niln => 0
+   | x => 0
+   end).
 
-Type [n:nat][l:(listn n)]
-                     Cases l of 
-                         niln => O
-                      |    x  => O
-                      end.
+Type (fun (n : nat) (l : listn n) => match l with
+                                     | niln => 0
+                                     | x => 0
+                                     end).
 
 
-Type <[_:nat]nat>Cases niln of 
-                         niln => O
-                      |    x  => O
-                      end.
+Type match niln return nat with
+     | niln => 0
+     | x => 0
+     end.
 
-Type               Cases niln of 
-                         niln => O
-                      |    x  => O
-                      end.
+Type match niln with
+     | niln => 0
+     | x => 0
+     end.
 
 
-Type <[_:nat]nat>Cases niln of 
-                         niln => O
-                      |  (consn n a l)  => a
-                      end.
-Type Cases niln of niln => O
-               |  (consn n a l)  => a
+Type match niln return nat with
+     | niln => 0
+     | consn n a l => a
+     end.
+Type match niln with
+     | niln => 0
+     | consn n a l => a
      end.
 
 
-Type  <[n:nat][_:(listn n)]nat>Cases niln of 
-                         (consn m _ niln) => m
-                       | _ => (S O) end.
+Type
+  match niln in (listn n) return nat with
+  | consn m _ niln => m
+  | _ => 1
+  end.
 
 
 
-Type [n:nat][x:nat][l:(listn n)]<[_:nat]nat>Cases x l of 
-                         O niln => O
-                      |  y  x  => O
-                      end.
+Type
+  (fun (n x : nat) (l : listn n) =>
+   match x, l return nat with
+   | O, niln => 0
+   | y, x => 0
+   end).
+
+Type match 0, niln return nat with
+     | O, niln => 0
+     | y, x => 0
+     end.
 
-Type <[_:nat]nat>Cases O niln of 
-                         O niln => O
-                      |  y  x  => O
-                      end.
 
+Type match niln, 0 return nat with
+     | niln, O => 0
+     | y, x => 0
+     end.
 
-Type <[_:nat]nat>Cases niln O of 
-                         niln O => O
-                      |  y  x  => O
-                      end.
+Type match niln, 0 with
+     | niln, O => 0
+     | y, x => 0
+     end.
 
-Type               Cases niln O of 
-                         niln O => O
-                      |  y  x  => O
-                      end.
+Type match niln, niln return nat with
+     | niln, niln => 0
+     | x, y => 0
+     end.
 
-Type <[_:nat][_:nat]nat>Cases niln niln of 
-                         niln niln => O
-                      |    x  y  => O
-                      end.
+Type match niln, niln with
+     | niln, niln => 0
+     | x, y => 0
+     end.
 
-Type               Cases niln niln of 
-                         niln niln => O
-                      |    x  y  => O
-                      end.
+Type
+  match niln, niln, niln return nat with
+  | niln, niln, niln => 0
+  | x, y, z => 0
+  end.
 
-Type <[_,_,_:nat]nat>Cases niln niln niln of 
-                         niln niln niln => O
-                      |    x  y z  => O
-                      end.
 
+Type match niln, niln, niln with
+     | niln, niln, niln => 0
+     | x, y, z => 0
+     end.
 
-Type                 Cases niln niln niln of 
-                         niln niln niln => O
-                      |    x  y z  => O
-                      end.
 
 
+Type match niln return nat with
+     | niln => 0
+     | consn n a l => 0
+     end.
 
-Type <[_:nat]nat>Cases (niln) of 
-                         niln  => O
-                      | (consn n a l) => O
-                      end.
+Type match niln with
+     | niln => 0
+     | consn n a l => 0
+     end.
 
-Type         Cases (niln) of 
-                         niln  => O
-                      | (consn n a l) => O
-                      end.
 
+Type
+  match niln, niln return nat with
+  | niln, niln => 0
+  | niln, consn n a l => n
+  | consn n a l, x => a
+  end.
 
-Type <[_:nat][_:nat]nat>Cases niln niln of 
-                         niln niln => O
-                      |  niln (consn n a l) => n
-                      |  (consn n a l)  x  => a
-                      end.
 
+Type
+  match niln, niln with
+  | niln, niln => 0
+  | niln, consn n a l => n
+  | consn n a l, x => a
+  end.
 
-Type                Cases niln niln of 
-                         niln niln => O
-                      |  niln (consn n a l) => n
-                      |  (consn n a l)  x  => a
-                      end.
 
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l return nat with
+   | niln => 0
+   | x => 0
+   end).
 
-Type [n:nat][l:(listn n)]<[_:nat]nat>Cases l of 
-                         niln => O
-                      |    x  => O
-                      end.
+Type
+  (fun (c : nat) (s : bool) =>
+   match c, s return nat with
+   | O, _ => 0
+   | _, _ => c
+   end).
 
-Type [c:nat;s:bool]
-  <[_:nat;_:bool]nat>Cases c s of
-        | O _ => O
-        | _ _ => c
-        end.
-
-Type [c:nat;s:bool]
-  <[_:nat;_:bool]nat>Cases c s of
-        | O _ => O
-        | (S _) _ => c
-        end.
+Type
+  (fun (c : nat) (s : bool) =>
+   match c, s return nat with
+   | O, _ => 0
+   | S _, _ => c
+   end).
          
 
 (* Rows of pattern variables: some tricky cases *)
-Axiom P:nat->Prop; f:(n:nat)(P n).
+Axioms (P : nat -> Prop) (f : forall n : nat, P n).
 
-Type [i:nat]
-  <[_:bool;n:nat](P n)>Cases true i of
-        | true k => (f k)
-        | _    k => (f k)
-        end.
+Type
+  (fun i : nat =>
+   match true, i as n return (P n) with
+   | true, k => f k
+   | _, k => f k
+   end).
 
-Type [i:nat]
-  <[n:nat;_:bool](P n)>Cases i true of
-        | k true => (f k)
-        | k _ => (f k)
-        end.
+Type
+  (fun i : nat =>
+   match i as n, true return (P n) with
+   | k, true => f k
+   | k, _ => f k
+   end).
 
 (* Nested Cases: the SYNTH of the Cases on n used to make Multcase believe
  * it has to synthtize the predicate on O (which he can't)
  *)
-Type <[n]Cases n of O => bool | (S _) => nat end>Cases O of
-    O => true
-  | (S _) => O
+Type
+  match 0 as n return match n with
+                      | O => bool
+                      | S _ => nat
+                      end with
+  | O => true
+  | S _ => 0
   end.
 
-Type [n:nat][l:(listn n)]Cases l of 
-                         niln => O
-                      |    x  => O
-                      end.
+Type (fun (n : nat) (l : listn n) => match l with
+                                     | niln => 0
+                                     | x => 0
+                                     end).
 
-Type [n:nat][l:(listn n)]<[_:nat]nat>Cases l of 
-                         niln  => O
-                      | (consn n a niln) => O
-                      | (consn n a (consn m b l)) => (plus n m)
-                      end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l return nat with
+   | niln => 0
+   | consn n a niln => 0
+   | consn n a (consn m b l) => n + m
+   end).
 
 
-Type [n:nat][l:(listn n)]Cases l of 
-                         niln  => O
-                      | (consn n a niln) => O
-                      | (consn n a (consn m b l)) => (plus n m)
-                      end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l with
+   | niln => 0
+   | consn n a niln => 0
+   | consn n a (consn m b l) => n + m
+   end).
 
 
 
-Type [n:nat][l:(listn n)]<[_:nat]nat>Cases l of 
-                         niln  => O
-                      | (consn n a niln) => O
-                      | (consn n a (consn m b l)) => (plus n m)
-                      end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l return nat with
+   | niln => 0
+   | consn n a niln => 0
+   | consn n a (consn m b l) => n + m
+   end).
 
-Type [n:nat][l:(listn n)]Cases l of 
-                         niln  => O
-                      | (consn n a niln) => O
-                      | (consn n a (consn m b l)) => (plus n m)
-                      end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l with
+   | niln => 0
+   | consn n a niln => 0
+   | consn n a (consn m b l) => n + m
+   end).
 
 
-Type [A:Set][n:nat][l:(Listn A n)]<[_:nat]nat>Cases l of 
-                         Niln   => O
-                      | (Consn n a Niln) => O
-                      | (Consn n a (Consn m b l)) => (plus n m)
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l return nat with
+   | Niln => 0
+   | Consn n a Niln => 0
+   | Consn n a (Consn m b l) => n + m
+   end).
 
-Type [A:Set][n:nat][l:(Listn A n)]Cases l of 
-                         Niln   => O
-                      | (Consn n a Niln) => O
-                      | (Consn n a (Consn m b l)) => (plus n m)
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l with
+   | Niln => 0
+   | Consn n a Niln => 0
+   | Consn n a (Consn m b l) => n + m
+   end).
 
 (*
 Type [A:Set][n:nat][l:(Listn A n)]
@@ -557,401 +632,441 @@ Type [A:Set][n:nat][l:(Listn A n)]
 **********)
 
 (* To test tratement of as-patterns in depth *)
-Type [A:Set] [l:(List A)]
-                    Cases l of 
-                         (Nil  as b) => (Nil A)
-                      | ((Cons a Nil)  as L) => L
-                      | ((Cons a (Cons b m)) as L) => L
-                      end.
+Type
+  (fun (A : Set) (l : List A) =>
+   match l with
+   | Nil as b => Nil A
+   | Cons a Nil as L => L
+   | Cons a (Cons b m) as L => L
+   end).
 
 
-Type [n:nat][l:(listn n)]
-             <[_:nat](listn n)>Cases l of 
-                         niln  => l 
-                      | (consn n a c) => l
-                      end.
-Type [n:nat][l:(listn n)]
-                      Cases l of 
-                         niln  => l 
-                      | (consn n a c) => l
-                      end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l return (listn n) with
+   | niln => l
+   | consn n a c => l
+   end).
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l with
+   | niln => l
+   | consn n a c => l
+   end).
 
 
-Type [n:nat][l:(listn n)]
-             <[_:nat](listn n)>Cases l of 
-                         (niln as b) => l 
-                      |  _  => l
-                      end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l return (listn n) with
+   | niln as b => l
+   | _ => l
+   end).
 
 
-Type [n:nat][l:(listn n)]
-                     Cases l of 
-                         (niln as b) => l 
-                      |  _  => l
-                      end.
+Type
+  (fun (n : nat) (l : listn n) => match l with
+                                  | niln as b => l
+                                  | _ => l
+                                  end).
 
-Type [n:nat][l:(listn n)]
-             <[_:nat](listn n)>Cases l of 
-                         (niln as b) => l
-                      |  x  => l
-                      end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l return (listn n) with
+   | niln as b => l
+   | x => l
+   end).
 
 
-Type [A:Set][n:nat][l:(Listn A n)]
-                       Cases l of 
-                         (Niln  as b) => l 
-                      |   _ => l
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l with
+   | Niln as b => l
+   | _ => l
+   end).
 
-Type [A:Set][n:nat][l:(Listn A n)]
-             <[_:nat](Listn A n)>Cases l of 
-                         Niln  => l 
-                      | (Consn  n a Niln) => l
-                      | (Consn  n a (Consn  m b c)) => l 
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l return (Listn A n) with
+   | Niln => l
+   | Consn n a Niln => l
+   | Consn n a (Consn m b c) => l
+   end).
 
-Type [A:Set][n:nat][l:(Listn A n)]
-                      Cases l of 
-                         Niln  => l 
-                      | (Consn  n a Niln) => l
-                      | (Consn  n a (Consn  m b c)) => l 
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l with
+   | Niln => l
+   | Consn n a Niln => l
+   | Consn n a (Consn m b c) => l
+   end).
 
-Type [A:Set][n:nat][l:(Listn A n)]
-             <[_:nat](Listn A n)>Cases l of 
-                         (Niln as b) => l 
-                      | (Consn  n a (Niln as b)) => l
-                      | (Consn  n a (Consn  m b _)) => l 
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l return (Listn A n) with
+   | Niln as b => l
+   | Consn n a (Niln as b) => l
+   | Consn n a (Consn m b _) => l
+   end).
 
-Type [A:Set][n:nat][l:(Listn A n)]
-                     Cases l of 
-                         (Niln as b) => l 
-                      | (Consn  n a (Niln as b)) => l
-                      | (Consn  n a (Consn  m b _)) => l 
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l with
+   | Niln as b => l
+   | Consn n a (Niln as b) => l
+   | Consn n a (Consn m b _) => l
+   end).
 
 
-Type <[_:nat]nat>Cases (niln) of 
-                         niln  => O
-                      | (consn n a niln) => O
-                      | (consn n a (consn m b l)) => (plus n m)
-                      end.
+Type
+  match niln return nat with
+  | niln => 0
+  | consn n a niln => 0
+  | consn n a (consn m b l) => n + m
+  end.
 
 
-Type               Cases (niln) of 
-                         niln  => O
-                      | (consn n a niln) => O
-                      | (consn n a (consn m b l)) => (plus n m)
-                      end.
+Type
+  match niln with
+  | niln => 0
+  | consn n a niln => 0
+  | consn n a (consn m b l) => n + m
+  end.
 
-Type <[_,_:nat]nat>Cases (LeO O) of 
-                         (LeO x)  => x
-                      | (LeS n m h) => (plus n m) 
-                      end.
+Type match LeO 0 return nat with
+     | LeO x => x
+     | LeS n m h => n + m
+     end.
 
 
-Type               Cases (LeO O) of 
-                         (LeO x)  => x
-                      | (LeS n m h) => (plus n m) 
-                      end.
+Type match LeO 0 with
+     | LeO x => x
+     | LeS n m h => n + m
+     end.
 
-Type [n:nat][l:(Listn nat n)]
-                     <[_:nat]nat>Cases l of 
-                         Niln  => O
-                      | (Consn n a l) => O
-                      end.
+Type
+  (fun (n : nat) (l : Listn nat n) =>
+   match l return nat with
+   | Niln => 0
+   | Consn n a l => 0
+   end).
 
 
-Type [n:nat][l:(Listn nat n)]
-                      Cases l of 
-                         Niln  => O
-                      | (Consn n a l) => O
-                      end.
+Type
+  (fun (n : nat) (l : Listn nat n) =>
+   match l with
+   | Niln => 0
+   | Consn n a l => 0
+   end).
 
 
-Type                Cases (Niln nat) of 
-                         Niln  => O
-                      | (Consn n a l) => O
-                      end.
+Type match Niln nat with
+     | Niln => 0
+     | Consn n a l => 0
+     end.
 
-Type <[_:nat]nat>Cases (LE_n O) of 
-                         LE_n   => O 
-                      | (LE_S m h) => O
-                      end.
+Type match LE_n 0 return nat with
+     | LE_n => 0
+     | LE_S m h => 0
+     end.
 
 
-Type               Cases (LE_n O) of 
-                         LE_n   => O 
-                      | (LE_S m h) => O
-                      end.
+Type match LE_n 0 with
+     | LE_n => 0
+     | LE_S m h => 0
+     end.
 
 
 
-Type               Cases (LE_n O) of 
-                         LE_n   => O 
-                      | (LE_S m h) => O
-                      end.
+Type match LE_n 0 with
+     | LE_n => 0
+     | LE_S m h => 0
+     end.
 
 
 
-Type <[_:nat]nat>Cases (niln ) of 
-                         niln   => O
-                      | (consn  n a niln) => n
-                      | (consn  n a (consn  m b l)) => (plus n m)
-                      end.
+Type
+  match niln return nat with
+  | niln => 0
+  | consn n a niln => n
+  | consn n a (consn m b l) => n + m
+  end.
 
-Type               Cases (niln ) of 
-                         niln   => O
-                      | (consn  n a niln) => n
-                      | (consn  n a (consn  m b l)) => (plus n m)
-                      end.
+Type
+  match niln with
+  | niln => 0
+  | consn n a niln => n
+  | consn n a (consn m b l) => n + m
+  end.
 
 
-Type <[_:nat]nat>Cases (Niln nat) of 
-                         Niln  => O
-                      | (Consn  n a Niln) => n
-                      | (Consn   n a (Consn  m b l)) => (plus n m)
-                      end.
+Type
+  match Niln nat return nat with
+  | Niln => 0
+  | Consn n a Niln => n
+  | Consn n a (Consn m b l) => n + m
+  end.
 
-Type                Cases (Niln nat) of 
-                         Niln  => O
-                      | (Consn  n a Niln) => n
-                      | (Consn   n a (Consn  m b l)) => (plus n m)
-                      end.
+Type
+  match Niln nat with
+  | Niln => 0
+  | Consn n a Niln => n
+  | Consn n a (Consn m b l) => n + m
+  end.
 
 
-Type <[_,_:nat]nat>Cases (LeO O) of 
-                         (LeO x)  => x
-                      | (LeS n m (LeO x)) => (plus x m)
-                      | (LeS n m (LeS x y h)) => (plus n x)
-                      end.
+Type
+  match LeO 0 return nat with
+  | LeO x => x
+  | LeS n m (LeO x) => x + m
+  | LeS n m (LeS x y h) => n + x
+  end.
 
 
-Type                 Cases (LeO O) of 
-                         (LeO x)  => x
-                      | (LeS n m (LeO x)) => (plus x m)
-                      | (LeS n m (LeS x y h)) => (plus n x)
-                      end.
+Type
+  match LeO 0 with
+  | LeO x => x
+  | LeS n m (LeO x) => x + m
+  | LeS n m (LeS x y h) => n + x
+  end.
 
 
-Type <[_,_:nat]nat>Cases (LeO O) of 
-                         (LeO x)  => x
-                      | (LeS n m (LeO x)) => (plus x m)
-                      | (LeS n m (LeS x y h)) => m
-                      end.
+Type
+  match LeO 0 return nat with
+  | LeO x => x
+  | LeS n m (LeO x) => x + m
+  | LeS n m (LeS x y h) => m
+  end.
 
-Type                Cases (LeO O) of 
-                         (LeO x)  => x
-                      | (LeS n m (LeO x)) => (plus x m)
-                      | (LeS n m (LeS x y h)) => m
-                      end.
+Type
+  match LeO 0 with
+  | LeO x => x
+  | LeS n m (LeO x) => x + m
+  | LeS n m (LeS x y h) => m
+  end.
 
 
-Type [n,m:nat][h:(Le n m)]
-                    <[_,_:nat]nat>Cases h of 
-                         (LeO x)  => x
-                      | x => O
-                      end.
+Type
+  (fun (n m : nat) (h : Le n m) =>
+   match h return nat with
+   | LeO x => x
+   | x => 0
+   end).
 
-Type [n,m:nat][h:(Le n m)]
-                     Cases h of 
-                         (LeO x)  => x
-                      | x => O
-                      end.
+Type (fun (n m : nat) (h : Le n m) => match h with
+                                      | LeO x => x
+                                      | x => 0
+                                      end).
 
 
-Type [n,m:nat][h:(Le n m)]
-                    <[_,_:nat]nat>Cases h of 
-                        (LeS n m h)  => n
-                      | x => O
-                      end.
+Type
+  (fun (n m : nat) (h : Le n m) =>
+   match h return nat with
+   | LeS n m h => n
+   | x => 0
+   end).
 
 
-Type [n,m:nat][h:(Le n m)]
-                      Cases h of 
-                        (LeS n m h)  => n
-                      | x => O
-                      end.
+Type
+  (fun (n m : nat) (h : Le n m) => match h with
+                                   | LeS n m h => n
+                                   | x => 0
+                                   end).
 
 
-Type    [n,m:nat][h:(Le n m)]
-  <[_,_:nat]nat*nat>Cases h of
-                    (LeO n) => (O,n)
-                   |(LeS n m _) => ((S n),(S m))
-                   end.
+Type
+  (fun (n m : nat) (h : Le n m) =>
+   match h return (nat * nat) with
+   | LeO n => (0, n)
+   | LeS n m _ => (S n, S m)
+   end).
 
 
-Type    [n,m:nat][h:(Le n m)]
-                  Cases h of
-                    (LeO n) => (O,n)
-                   |(LeS n m _) => ((S n),(S m))
-                   end.
+Type
+  (fun (n m : nat) (h : Le n m) =>
+   match h with
+   | LeO n => (0, n)
+   | LeS n m _ => (S n, S m)
+   end).
 
 
-Fixpoint F [n,m:nat; h:(Le n m)] : (Le n (S m)) :=
- <[n,m:nat](Le n (S m))>Cases h  of 
-                (LeO m') => (LeO (S m'))
-              | (LeS n' m' h') => (LeS n' (S m') (F n' m' h'))
-        end.
+Fixpoint F (n m : nat) (h : Le n m) {struct h} : Le n (S m) :=
+  match h in (Le n m) return (Le n (S m)) with
+  | LeO m' => LeO (S m')
+  | LeS n' m' h' => LeS n' (S m') (F n' m' h')
+  end.
 
 Reset F.
 
-Fixpoint F [n,m:nat; h:(Le n m)] :(Le n (S m)) :=
-  <[n,m:nat](Le n (S m))>Cases h of
-                           (LeS n m h) => (LeS n (S m) (F n m h))
-                         | (LeO m) => (LeO (S m)) 
-                        end.
+Fixpoint F (n m : nat) (h : Le n m) {struct h} : Le n (S m) :=
+  match h in (Le n m) return (Le n (S m)) with
+  | LeS n m h => LeS n (S m) (F n m h)
+  | LeO m => LeO (S m)
+  end.
 
 (* Rend la longueur de la liste *)
-Definition length1:= [n:nat] [l:(listn n)]
-        <[_:nat]nat>Cases l of 
-                     (consn n _ (consn m _ _)) => (S (S m))
-                    |(consn n _ _) => (S O)
-                    | _ => O
-             end.
+Definition length1 (n : nat) (l : listn n) :=
+  match l return nat with
+  | consn n _ (consn m _ _) => S (S m)
+  | consn n _ _ => 1
+  | _ => 0
+  end.
 
 Reset length1.
-Definition length1:= [n:nat] [l:(listn n)]
-                    Cases l of 
-                     (consn n _ (consn m _ _)) => (S (S m))
-                    |(consn n _ _) => (S O)
-                    | _ => O
-                    end.
+Definition length1 (n : nat) (l : listn n) :=
+  match l with
+  | consn n _ (consn m _ _) => S (S m)
+  | consn n _ _ => 1
+  | _ => 0
+  end.
 
 
-Definition length2:= [n:nat] [l:(listn n)]
-        <[_:nat]nat>Cases l of 
-                     (consn n _ (consn m _ _)) => (S (S m))
-                    |(consn n _ _) => (S n)
-                    | _ => O
-             end.
+Definition length2 (n : nat) (l : listn n) :=
+  match l return nat with
+  | consn n _ (consn m _ _) => S (S m)
+  | consn n _ _ => S n
+  | _ => 0
+  end.
 
 Reset length2.
 
-Definition length2:= [n:nat] [l:(listn n)]
-                   Cases l of 
-                     (consn n _ (consn m _ _)) => (S (S m))
-                    |(consn n _ _) => (S n)
-                    | _ => O
-                   end.
+Definition length2 (n : nat) (l : listn n) :=
+  match l with
+  | consn n _ (consn m _ _) => S (S m)
+  | consn n _ _ => S n
+  | _ => 0
+  end.
 
-Definition length3 :=
-[n:nat][l:(listn n)]
-        <[_:nat]nat>Cases l of 
-                     (consn n _ (consn m _ l)) => (S n)
-                    |(consn n _ _) => (S O)
-                    | _  => O
-                   end.
+Definition length3 (n : nat) (l : listn n) :=
+  match l return nat with
+  | consn n _ (consn m _ l) => S n
+  | consn n _ _ => 1
+  | _ => 0
+  end.
 
 
 Reset length3.
 
-Definition length3 :=
-[n:nat][l:(listn n)]
-                   Cases l of 
-                     (consn n _ (consn m _ l)) => (S n)
-                    |(consn n _ _) => (S O)
-                    | _  => O
-                   end.
+Definition length3 (n : nat) (l : listn n) :=
+  match l with
+  | consn n _ (consn m _ l) => S n
+  | consn n _ _ => 1
+  | _ => 0
+  end.
 
  
-Type <[_,_:nat]nat>Cases (LeO O) of 
-                        (LeS n m h)  =>(plus n m)
-                      | x => O
-                      end.
-Type              Cases (LeO O) of 
-                        (LeS n m h)  =>(plus n m)
-                      | x => O
-                      end.
+Type match LeO 0 return nat with
+     | LeS n m h => n + m
+     | x => 0
+     end.
+Type match LeO 0 with
+     | LeS n m h => n + m
+     | x => 0
+     end.
 
-Type [n,m:nat][h:(Le n m)]<[_,_:nat]nat>Cases h of 
-                         (LeO x)  => x
-                      | (LeS n m (LeO x)) => (plus x m)
-                      | (LeS n m (LeS x y h)) =>(plus n (plus m (plus x y)))
-                      end.
+Type
+  (fun (n m : nat) (h : Le n m) =>
+   match h return nat with
+   | LeO x => x
+   | LeS n m (LeO x) => x + m
+   | LeS n m (LeS x y h) => n + (m + (x + y))
+   end).
 
 
-Type [n,m:nat][h:(Le n m)]Cases h of 
-                         (LeO x)  => x
-                      | (LeS n m (LeO x)) => (plus x m)
-                      | (LeS n m (LeS x y h)) =>(plus n (plus m (plus x y)))
-                      end.
+Type
+  (fun (n m : nat) (h : Le n m) =>
+   match h with
+   | LeO x => x
+   | LeS n m (LeO x) => x + m
+   | LeS n m (LeS x y h) => n + (m + (x + y))
+   end).
 
-Type <[_,_:nat]nat>Cases (LeO O) of 
-                         (LeO x)  => x
-                      | (LeS n m (LeO x)) => (plus x m)
-                      | (LeS n m (LeS x y h)) =>(plus n (plus m (plus x y)))
-                      end.
+Type
+  match LeO 0 return nat with
+  | LeO x => x
+  | LeS n m (LeO x) => x + m
+  | LeS n m (LeS x y h) => n + (m + (x + y))
+  end.
 
-Type                 Cases (LeO O) of 
-                         (LeO x)  => x
-                      | (LeS n m (LeO x)) => (plus x m)
-                      | (LeS n m (LeS x y h)) =>(plus n (plus m (plus x y)))
-                      end.
+Type
+  match LeO 0 with
+  | LeO x => x
+  | LeS n m (LeO x) => x + m
+  | LeS n m (LeS x y h) => n + (m + (x + y))
+  end.
 
 
-Type <[_:nat]nat>Cases (LE_n O) of 
-                         LE_n   => O
-                      | (LE_S m LE_n) => (plus O m)
-                      | (LE_S m (LE_S y h)) => (plus O m)
-                      end.
+Type
+  match LE_n 0 return nat with
+  | LE_n => 0
+  | LE_S m LE_n => 0 + m
+  | LE_S m (LE_S y h) => 0 + m
+  end.
 
 
-Type                Cases (LE_n O) of 
-                         LE_n   => O
-                      | (LE_S m LE_n) => (plus O m)
-                      | (LE_S m (LE_S y h)) => (plus O m)
-                      end.
+Type
+  match LE_n 0 with
+  | LE_n => 0
+  | LE_S m LE_n => 0 + m
+  | LE_S m (LE_S y h) => 0 + m
+  end.
 
 
-Type [n,m:nat][h:(Le n m)]              Cases h of 
-                                                x => x 
-                                          end.
+Type (fun (n m : nat) (h : Le n m) => match h with
+                                      | x => x
+                                      end).
 
-Type [n,m:nat][h:(Le n m)]<[_,_:nat]nat>Cases h of 
-                                               (LeO n) => n
-                                              |   x => O
-                                          end.
-Type [n,m:nat][h:(Le n m)] Cases h of 
-                               (LeO n) => n
-                             |   x => O
-                            end.
+Type
+  (fun (n m : nat) (h : Le n m) =>
+   match h return nat with
+   | LeO n => n
+   | x => 0
+   end).
+Type (fun (n m : nat) (h : Le n m) => match h with
+                                      | LeO n => n
+                                      | x => 0
+                                      end).
 
 
-Type [n:nat]<[_:nat]nat->nat>Cases niln of 
-                         niln  => [_:nat]O
-                      | (consn n a niln) => [_:nat]O
-                      | (consn n a (consn m b l)) => [_:nat](plus n m)
-                      end.
+Type
+  (fun n : nat =>
+   match niln return (nat -> nat) with
+   | niln => fun _ : nat => 0
+   | consn n a niln => fun _ : nat => 0
+   | consn n a (consn m b l) => fun _ : nat => n + m
+   end).
 
 
-Type [n:nat]         Cases niln of 
-                         niln  => [_:nat]O
-                      | (consn n a niln) => [_:nat]O
-                      | (consn n a (consn m b l)) => [_:nat](plus n m)
-                      end.
+Type
+  (fun n : nat =>
+   match niln with
+   | niln => fun _ : nat => 0
+   | consn n a niln => fun _ : nat => 0
+   | consn n a (consn m b l) => fun _ : nat => n + m
+   end).
 
-Type [A:Set][n:nat][l:(Listn A n)]
-                  <[_:nat]nat->nat>Cases l of 
-                         Niln  => [_:nat]O
-                      | (Consn  n a Niln) =>  [_:nat] n
-                      | (Consn  n a (Consn  m b l)) => [_:nat](plus n m)
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l return (nat -> nat) with
+   | Niln => fun _ : nat => 0
+   | Consn n a Niln => fun _ : nat => n
+   | Consn n a (Consn m b l) => fun _ : nat => n + m
+   end).
 
-Type [A:Set][n:nat][l:(Listn A n)]
-                        Cases l of 
-                         Niln  => [_:nat]O
-                      | (Consn  n a Niln) =>  [_:nat] n
-                      | (Consn  n a (Consn  m b l)) => [_:nat](plus n m)
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l with
+   | Niln => fun _ : nat => 0
+   | Consn n a Niln => fun _ : nat => n
+   | Consn n a (Consn m b l) => fun _ : nat => n + m
+   end).
 
 (* Alsos tests for multiple _ patterns *)
-Type [A:Set][n:nat][l:(Listn A n)]
-                  <[n:nat](Listn A n)>Cases l of 
-                        (Niln as b) => b
-                      | ((Consn _ _ _ ) as b)=>  b
-                      end.
+Type
+  (fun (A : Set) (n : nat) (l : Listn A n) =>
+   match l in (Listn _ n) return (Listn A n) with
+   | Niln as b => b
+   | Consn _ _ _ as b => b
+   end).
 
 (** Horrible error message! 
 
@@ -962,215 +1077,278 @@ Type [A:Set][n:nat][l:(Listn A n)]
                       end.
 ******)
 
-Type   <[n:nat](listn  n)>Cases niln of 
-               (niln as b) => b
-          | ((consn _ _ _ ) as b)=>  b
-          end.
-
+Type
+  match niln in (listn n) return (listn n) with
+  | niln as b => b
+  | consn _ _ _ as b => b
+  end.
 
-Type   <[n:nat](listn  n)>Cases niln of 
-               (niln as b) => b
-          |    x  =>  x
-          end.
 
-Type [n,m:nat][h:(LE n m)]<[_:nat]nat->nat>Cases h  of 
-                         LE_n   => [_:nat]n
-                      | (LE_S  m LE_n) => [_:nat](plus n m)
-                      | (LE_S  m (LE_S y h)) => [_:nat](plus m y )
-                      end.
-Type [n,m:nat][h:(LE n m)]Cases h  of 
-                         LE_n   => [_:nat]n
-                      | (LE_S  m LE_n) => [_:nat](plus n m)
-                      | (LE_S  m (LE_S y h)) => [_:nat](plus m y )
-                      end.
+Type
+  match niln in (listn n) return (listn n) with
+  | niln as b => b
+  | x => x
+  end.
 
+Type
+  (fun (n m : nat) (h : LE n m) =>
+   match h return (nat -> nat) with
+   | LE_n => fun _ : nat => n
+   | LE_S m LE_n => fun _ : nat => n + m
+   | LE_S m (LE_S y h) => fun _ : nat => m + y
+   end).
+Type
+  (fun (n m : nat) (h : LE n m) =>
+   match h with
+   | LE_n => fun _ : nat => n
+   | LE_S m LE_n => fun _ : nat => n + m
+   | LE_S m (LE_S y h) => fun _ : nat => m + y
+   end).
 
-Type [n,m:nat][h:(LE n m)]
-    <[_:nat]nat>Cases h  of 
-        LE_n   => n
-      | (LE_S m  LE_n ) => (plus n m)
-      | (LE_S  m (LE_S  y  LE_n )) => (plus (plus n m) y)
-      | (LE_S  m (LE_S  y (LE_S  y' h))) => (plus (plus n m) (plus y y'))
-                      end.
 
+Type
+  (fun (n m : nat) (h : LE n m) =>
+   match h return nat with
+   | LE_n => n
+   | LE_S m LE_n => n + m
+   | LE_S m (LE_S y LE_n) => n + m + y
+   | LE_S m (LE_S y (LE_S y' h)) => n + m + (y + y')
+   end).
 
 
-Type [n,m:nat][h:(LE n m)]
-       Cases h  of 
-        LE_n   => n
-      | (LE_S m  LE_n ) => (plus n m)
-      | (LE_S  m (LE_S  y  LE_n )) => (plus (plus n m) y)
-      | (LE_S  m (LE_S  y (LE_S  y' h))) => (plus (plus n m) (plus y y'))
-                      end.
 
+Type
+  (fun (n m : nat) (h : LE n m) =>
+   match h with
+   | LE_n => n
+   | LE_S m LE_n => n + m
+   | LE_S m (LE_S y LE_n) => n + m + y
+   | LE_S m (LE_S y (LE_S y' h)) => n + m + (y + y')
+   end).
 
-Type [n,m:nat][h:(LE n m)]<[_:nat]nat>Cases h  of 
-                        LE_n   => n
-                      | (LE_S m LE_n) => (plus n m)
-                      | (LE_S  m (LE_S y h)) => (plus (plus n m) y)
-                      end.
 
+Type
+  (fun (n m : nat) (h : LE n m) =>
+   match h return nat with
+   | LE_n => n
+   | LE_S m LE_n => n + m
+   | LE_S m (LE_S y h) => n + m + y
+   end).
 
-Type [n,m:nat][h:(LE n m)]Cases h  of 
-                        LE_n   => n
-                      | (LE_S m LE_n) => (plus n m)
-                      | (LE_S  m (LE_S y h)) => (plus (plus n m) y)
-                      end.
 
-Type [n,m:nat]
-                    <[_,_:nat]nat>Cases (LeO O) of 
-                        (LeS n m h)  =>(plus n m)
-                      | x => O
-                      end.
+Type
+  (fun (n m : nat) (h : LE n m) =>
+   match h with
+   | LE_n => n
+   | LE_S m LE_n => n + m
+   | LE_S m (LE_S y h) => n + m + y
+   end).
 
-Type [n,m:nat]
-                      Cases (LeO O) of 
-                        (LeS n m h)  =>(plus n m)
-                      | x => O
-                      end.
+Type
+  (fun n m : nat =>
+   match LeO 0 return nat with
+   | LeS n m h => n + m
+   | x => 0
+   end).
+
+Type (fun n m : nat => match LeO 0 with
+                       | LeS n m h => n + m
+                       | x => 0
+                       end).
 
-Parameter test : (n:nat){(le O n)}+{False}.
-Type  [n:nat]<nat>Cases (test n) of
-                        (left _) => O 
-                        | _ => O end.
+Parameter test : forall n : nat, {0 <= n} + {False}.
+Type (fun n : nat => match test n return nat with
+                     | left _ => 0
+                     | _ => 0
+                     end).
 
 
-Type  [n:nat]   <nat> Cases (test n) of
-                          (left _) => O 
-                        | _ => O end.
+Type (fun n : nat => match test n return nat with
+                     | left _ => 0
+                     | _ => 0
+                     end).
 
-Type  [n:nat]Cases (test n) of
-                          (left _) => O 
-                        | _ => O end.
+Type (fun n : nat => match test n with
+                     | left _ => 0
+                     | _ => 0
+                     end).
 
-Parameter compare : (n,m:nat)({(lt n m)}+{n=m})+{(gt n m)}.
-Type <nat>Cases (compare O O) of
-               (* k<i *)  (inleft (left _)) => O
-            |  (* k=i *)  (inleft  _)  => O
-            |  (* k>i *)  (inright  _) => O end.
+Parameter compare : forall n m : nat, {n < m} + {n = m} + {n > m}.
+Type
+  match compare 0 0 return nat with
+  
+      (* k<i *) | inleft (left _) => 0
+   (* k=i *) | inleft _ => 0
+   (* k>i *) | inright _ => 0
+  end.
 
-Type    Cases (compare O O) of
-               (* k<i *)  (inleft (left _)) => O
-            |  (* k=i *)  (inleft  _)  => O
-            |  (* k>i *)  (inright  _) => O end.
+Type
+  match compare 0 0 with
+  
+      (* k<i *) | inleft (left _) => 0
+   (* k=i *) | inleft _ => 0
+   (* k>i *) | inright _ => 0
+  end.
 
 
 
-CoInductive SStream [A:Set]  : (nat->A->Prop)->Type :=
-scons  : 
-  (P:nat->A->Prop)(a:A)(P O a)->(SStream A [n:nat](P (S n)))->(SStream A P).
+CoInductive SStream (A : Set) : (nat -> A -> Prop) -> Type :=
+    scons :
+      forall (P : nat -> A -> Prop) (a : A),
+      P 0 a -> SStream A (fun n : nat => P (S n)) -> SStream A P.
 Parameter B : Set.
 
-Type 
-  [P:nat->B->Prop][x:(SStream B P)]<[_:nat->B->Prop]B>Cases x of
-     (scons _ a _ _) => a  end.
+Type
+  (fun (P : nat -> B -> Prop) (x : SStream B P) =>
+   match x return B with
+   | scons _ a _ _ => a
+   end).
 
 
-Type 
-  [P:nat->B->Prop][x:(SStream B P)] Cases x of
-     (scons _ a _ _) => a  end.
+Type
+  (fun (P : nat -> B -> Prop) (x : SStream B P) =>
+   match x with
+   | scons _ a _ _ => a
+   end).
 
-Type <nat*nat>Cases (O,O) of  (x,y) => ((S x),(S y)) end.
-Type <nat*nat>Cases (O,O) of  ((x as b), y) => ((S x),(S y)) end.
-Type <nat*nat>Cases (O,O) of  (pair x y) => ((S x),(S y)) end.
+Type match (0, 0) return (nat * nat) with
+     | (x, y) => (S x, S y)
+     end.
+Type match (0, 0) return (nat * nat) with
+     | (b, y) => (S b, S y)
+     end.
+Type match (0, 0) return (nat * nat) with
+     | (x, y) => (S x, S y)
+     end.
 
-Type Cases (O,O) of  (x,y) => ((S x),(S y)) end.
-Type Cases (O,O) of  ((x as b), y) => ((S x),(S y)) end.
-Type Cases (O,O) of  (pair x y) => ((S x),(S y)) end.
+Type match (0, 0) with
+     | (x, y) => (S x, S y)
+     end.
+Type match (0, 0) with
+     | (b, y) => (S b, S y)
+     end.
+Type match (0, 0) with
+     | (x, y) => (S x, S y)
+     end.
 
 
 
-Parameter concat : (A:Set)(List A) ->(List A) ->(List A).
+Parameter concat : forall A : Set, List A -> List A -> List A.
 
-Type <(List nat)>Cases (Nil nat) (Nil nat) of 
-                 (Nil as b)  x  => (concat nat b x)
-              | ((Cons _ _) as d) (Nil as c) => (concat nat d c)
-              |  _ _ => (Nil nat)
-              end.
-Type Cases (Nil nat) (Nil nat) of 
-           (Nil as b)  x  => (concat nat b x)
-       | ((Cons _ _) as d) (Nil as c) => (concat nat d c)
-       |  _ _ => (Nil nat)
-       end.
+Type
+  match Nil nat, Nil nat return (List nat) with
+  | Nil as b, x => concat nat b x
+  | Cons _ _ as d, Nil as c => concat nat d c
+  | _, _ => Nil nat
+  end.
+Type
+  match Nil nat, Nil nat with
+  | Nil as b, x => concat nat b x
+  | Cons _ _ as d, Nil as c => concat nat d c
+  | _, _ => Nil nat
+  end.
 
 
 Inductive redexes : Set :=
-    VAR : nat -> redexes
+  | VAR : nat -> redexes
   | Fun : redexes -> redexes
-  | Ap  : bool -> redexes -> redexes -> redexes.
-
-Fixpoint regular [U:redexes] : Prop := <Prop>Cases U of
-  (VAR n) => True
-| (Fun V) => (regular V)
-| (Ap true ((Fun _) as V)  W) => (regular V) /\ (regular W)
-| (Ap true _ W) => False
-| (Ap false V W) => (regular V) /\ (regular W) 
-end.
+  | Ap : bool -> redexes -> redexes -> redexes.
+
+Fixpoint regular (U : redexes) : Prop :=
+  match U return Prop with
+  | VAR n => True
+  | Fun V => regular V
+  | Ap true (Fun _ as V) W => regular V /\ regular W
+  | Ap true _ W => False
+  | Ap false V W => regular V /\ regular W
+  end.
 
 
-Type [n:nat]Cases n of O => O | (S ((S n) as V)) => V | _ => O end.
+Type (fun n : nat => match n with
+                     | O => 0
+                     | S (S n as V) => V
+                     | _ => 0
+                     end).
 
 Reset concat.
-Parameter concat :(n:nat) (listn n) -> (m:nat) (listn m)-> (listn (plus n m)).
-Type [n:nat][l:(listn n)][m:nat][l':(listn m)] 
- <[n,_:nat](listn (plus n m))>Cases l l' of 
-                 niln  x => x
-              | (consn n a l'') x =>(consn (plus n m) a (concat n l'' m x))
-               end.
-
-Type [x,y,z:nat]
-        [H:x=y]
-         [H0:y=z]<[_:nat]x=z>Cases H of refl_equal => 
-                          <[n:nat]x=n>Cases H0 of refl_equal => H
-                                             end
-                                       end.
-
-Type [h:False]<False>Cases h of end.
+Parameter
+  concat :
+    forall n : nat, listn n -> forall m : nat, listn m -> listn (n + m).
+Type
+  (fun (n : nat) (l : listn n) (m : nat) (l' : listn m) =>
+   match l in (listn n), l' return (listn (n + m)) with
+   | niln, x => x
+   | consn n a l'', x => consn (n + m) a (concat n l'' m x)
+   end).
 
-Type [h:False]<True>Cases h of end.
+Type
+  (fun (x y z : nat) (H : x = y) (H0 : y = z) =>
+   match H return (x = z) with
+   | refl_equal =>
+       match H0 in (_ = n) return (x = n) with
+       | refl_equal => H
+       end
+   end).
+
+Type (fun h : False => match h return False with
+                       end).
 
-Definition is_zero := [n:nat]Cases n of O => True | _ => False end.
+Type (fun h : False => match h return True with
+                       end).
 
-Type [n:nat][h:O=(S n)]<[n:nat](is_zero n)>Cases h of refl_equal => I end.
+Definition is_zero (n : nat) := match n with
+                                | O => True
+                                | _ => False
+                                end.
 
-Definition disc : (n:nat)O=(S n)->False :=
-  [n:nat][h:O=(S n)]
-      <[n:nat](is_zero n)>Cases h of refl_equal => I end.
+Type
+  (fun (n : nat) (h : 0 = S n) =>
+   match h in (_ = n) return (is_zero n) with
+   | refl_equal => I
+   end).
+
+Definition disc (n : nat) (h : 0 = S n) : False :=
+  match h in (_ = n) return (is_zero n) with
+  | refl_equal => I
+  end.
 
-Definition nlength3 := [n:nat] [l: (listn n)]
-                         Cases l of 
-                            niln  => O
-                         |  (consn O  _ _)  => (S O)
-                         |  (consn (S n)  _ _) => (S (S n))
-                         end.
+Definition nlength3 (n : nat) (l : listn n) :=
+  match l with
+  | niln => 0
+  | consn O _ _ => 1
+  | consn (S n) _ _ => S (S n)
+  end.
 
 (* == Testing strategy elimintation predicate  synthesis == *)
 Section titi.
-Variable h:False.
-Type Cases O of 
-          O  => O
-       |  _  => (Except h)
-       end.
+Variable h : False.
+Type match 0 with
+     | O => 0
+     | _ => except h
+     end.
 End titi.
 
-Type Cases niln of 
-    (consn _ a niln) => a
- |  (consn n _ x)    => O
- |   niln  => O
- end.
+Type match niln with
+     | consn _ a niln => a
+     | consn n _ x => 0
+     | niln => 0
+     end.
 
 
 
-Inductive wsort : Set := ws : wsort | wt : wsort.
-Inductive TS : wsort->Set := 
-   id :(TS ws) 
-| lift:(TS ws)->(TS ws).
+Inductive wsort : Set :=
+  | ws : wsort
+  | wt : wsort.
+Inductive TS : wsort -> Set :=
+  | id : TS ws
+  | lift : TS ws -> TS ws.
 
-Type [b:wsort][M:(TS b)][N:(TS b)]
- Cases   M   N of   
-  (lift M1)   id => False 
- | _ _ => True 
- end.
+Type
+  (fun (b : wsort) (M N : TS b) =>
+   match M, N with
+   | lift M1, id => False
+   | _, _ => True
+   end).
 
 
 
@@ -1182,51 +1360,56 @@ Type [b:wsort][M:(TS b)][N:(TS b)]
 
 
 Parameter LTERM : nat -> Set.
-Mutual Inductive TERM : Type :=
-	  var : TERM
-	| oper : (op:nat) (LTERM op) -> TERM.
-
-Parameter t1, t2:TERM.
+Inductive TERM : Type :=
+  | var : TERM
+  | oper : forall op : nat, LTERM op -> TERM.
 
-Type Cases t1 t2 of 
-   var   var  => True
+Parameter t1 t2 : TERM.
 
- | (oper op1 l1)  (oper op2 l2) => False
- | _ _ => False 
- end. 
+Type
+  match t1, t2 with
+  | var, var => True
+  | oper op1 l1, oper op2 l2 => False
+  | _, _ => False
+  end. 
 Reset LTERM.
 
 
 
-Require Peano_dec.
-Parameter n:nat.
-Definition eq_prf := (EXT m | n=m).
-Parameter p:eq_prf .
+Require Import Peano_dec.
+Parameter n : nat.
+Definition eq_prf := exists m : _, n = m.
+Parameter p : eq_prf.
 
-Type Cases p of
-     (exT_intro c eqc) =>
-          Cases (eq_nat_dec c n) of
-            (right _) => (refl_equal ? n)
-           |(left y) (* c=n*) => (refl_equal ? n) 
-          end
-     end.
+Type
+  match p with
+  | ex_intro c eqc =>
+      match eq_nat_dec c n with
+      | right _ => refl_equal n
+      | left y => (* c=n*)  refl_equal n
+      end
+  end.
 
 
-Parameter ordre_total : nat->nat->Prop.
+Parameter ordre_total : nat -> nat -> Prop.
 
-Parameter N_cla:(N:nat){N=O}+{N=(S O)}+{(ge N (S (S O)))}.
+Parameter N_cla : forall N : nat, {N = 0} + {N = 1} + {N >= 2}.
 
-Parameter exist_U2:(N:nat)(ge N (S (S O)))->
-                      {n:nat|(m:nat)(lt O m)/\(le m N)
-                             /\(ordre_total n m)                   
-                             /\(lt O n)/\(lt n N)}.
+Parameter
+  exist_U2 :
+    forall N : nat,
+    N >= 2 ->
+    {n : nat |
+    forall m : nat, 0 < m /\ m <= N /\ ordre_total n m /\ 0 < n /\ n < N}.
 
-Type [N:nat](Cases (N_cla N) of
-                         (inright H)=>(Cases (exist_U2 N H) of
-                                               (exist a b)=>a
-                                       end)
-                        |   _       => O
-                       end).
+Type
+  (fun N : nat =>
+   match N_cla N with
+   | inright H => match exist_U2 N H with
+                  | exist a b => a
+                  end
+   | _ => 0
+   end).
 
 
 
@@ -1238,148 +1421,159 @@ Type [N:nat](Cases (N_cla N) of
 (* == To test that terms named with AS are correctly absolutized before
       substitution in rhs   == *)
 
-Type [n:nat]<[n:nat]nat>Cases (n) of 
-          O  => O
-       |  (S O)  => O
-       |  ((S (S n1)) as N)  => N
-      end.
+Type
+  (fun n : nat =>
+   match n return nat with
+   | O => 0
+   | S O => 0
+   | S (S n1) as N => N
+   end).
 
 (* ========= *)
 
-Type <[n:nat][_:(listn n)]Prop>Cases niln of 
-                         niln => True
-                       | (consn (S O) _ _) => False
-                       | _ => True end.
-
-Type <[n:nat][_:(listn n)]Prop>Cases niln of 
-                         niln => True
-                       | (consn (S (S O)) _ _) => False
-                       | _ => True end.
-
-
-Type <[n,m:nat][h:(Le n m)]nat>Cases (LeO O) of 
-                         (LeO _) => O
-                       | (LeS (S x) _ _) => x
-                       | _ => (S O) end.
-
-Type <[n,m:nat][h:(Le n m)]nat>Cases (LeO O) of 
-                         (LeO _) => O
-                       | (LeS (S x)  (S y) _) => x
-                       | _ => (S O) end.
-
-Type <[n,m:nat][h:(Le n m)]nat>Cases (LeO O) of 
-                         (LeO _) => O
-                       | (LeS ((S x) as b)  (S y) _) => b
-                       | _ => (S O) end.
+Type
+  match niln in (listn n) return Prop with
+  | niln => True
+  | consn (S O) _ _ => False
+  | _ => True
+  end.
 
+Type
+  match niln in (listn n) return Prop with
+  | niln => True
+  | consn (S (S O)) _ _ => False
+  | _ => True
+  end.
 
 
-Parameter ff: (n,m:nat)~n=m -> ~(S n)=(S m).
-Parameter discr_r : (n:nat) ~(O=(S n)).
-Parameter discr_l : (n:nat) ~((S n)=O).
+Type
+  match LeO 0 as h in (Le n m) return nat with
+  | LeO _ => 0
+  | LeS (S x) _ _ => x
+  | _ => 1
+  end.
 
-Type 
-[n:nat] 
-  <[n:nat]n=O\/~n=O>Cases n of 
-      O     => (or_introl ? ~O=O (refl_equal ? O))      
-   |  (S x) => (or_intror (S x)=O ? (discr_l x))
+Type
+  match LeO 0 as h in (Le n m) return nat with
+  | LeO _ => 0
+  | LeS (S x) (S y) _ => x
+  | _ => 1
   end.
 
+Type
+  match LeO 0 as h in (Le n m) return nat with
+  | LeO _ => 0
+  | LeS (S x as b) (S y) _ => b
+  | _ => 1
+  end.
 
-Fixpoint eqdec [n:nat] : (m:nat) n=m \/ ~n=m := 
-[m:nat]
- <[n,m:nat] n=m \/ ~n=m>Cases n m of
-      O   O   => (or_introl ? ~O=O (refl_equal ? O))
 
-   |  O (S x) => (or_intror O=(S x) ? (discr_r x))
 
-   | (S x) O  => (or_intror ? ~(S x)=O (discr_l x))
+Parameter ff : forall n m : nat, n <> m -> S n <> S m.
+Parameter discr_r : forall n : nat, 0 <> S n.
+Parameter discr_l : forall n : nat, S n <> 0.
 
-   | (S x) (S y) =>  
-      <(S x)=(S y)\/~(S x)=(S y)>Cases (eqdec x y) of
-        (or_introl h) => (or_introl  ? ~(S x)=(S y) (f_equal nat nat S x y h))
-      | (or_intror h) => (or_intror (S x)=(S y) ? (ff x y h))   
+Type
+  (fun n : nat =>
+   match n return (n = 0 \/ n <> 0) with
+   | O => or_introl (0 <> 0) (refl_equal 0)
+   | S x => or_intror (S x = 0) (discr_l x)
+   end).
+
+
+Fixpoint eqdec (n m : nat) {struct n} : n = m \/ n <> m :=
+  match n, m return (n = m \/ n <> m) with
+  | O, O => or_introl (0 <> 0) (refl_equal 0)
+  | O, S x => or_intror (0 = S x) (discr_r x)
+  | S x, O => or_intror _ (discr_l x)
+  | S x, S y =>
+      match eqdec x y return (S x = S y \/ S x <> S y) with
+      | or_introl h => or_introl (S x <> S y) (f_equal S h)
+      | or_intror h => or_intror (S x = S y) (ff x y h)
       end
- end.
+  end.
 
 Reset eqdec.
 
-Fixpoint eqdec [n:nat] : (m:nat) n=m \/ ~n=m := 
-<[n:nat] (m:nat)n=m \/ ~n=m>Cases n  of
-    O  => [m:nat] <[m:nat]O=m\/~O=m>Cases m of 
-                     O    => (or_introl ? ~O=O (refl_equal nat O))
-                   |(S x) => (or_intror O=(S x) ?  (discr_r x))
-                  end
-  | (S x) => [m:nat] 
-    <[m:nat](S x)=m\/~(S x)=m>Cases m of  
-        O    => (or_intror (S x)=O ? (discr_l x))
-     | (S y) =>  
-         <(S x)=(S y)\/~(S x)=(S y)>Cases (eqdec x y) of
-            (or_introl h) => (or_introl ? ~(S x)=(S y) (f_equal ? ? S x y h))
-          | (or_intror h) => (or_intror (S x)=(S y) ? (ff x y h))   
-         end
-    end
- end.
-
-
-Inductive empty : (n:nat)(listn n)-> Prop := 
-  intro_empty: (empty O niln).
-
-Parameter inv_empty : (n,a:nat)(l:(listn n)) ~(empty (S n) (consn n a l)).
-
-Type 
-[n:nat] [l:(listn n)]
-  <[n:nat] [l:(listn n)](empty n l) \/ ~(empty n l)>Cases l of 
-        niln               =>  (or_introl ? ~(empty O niln) intro_empty)
-   |  ((consn n a y) as b) =>  (or_intror (empty (S n) b) ? (inv_empty n a y))
+Fixpoint eqdec (n : nat) : forall m : nat, n = m \/ n <> m :=
+  match n return (forall m : nat, n = m \/ n <> m) with
+  | O =>
+      fun m : nat =>
+      match m return (0 = m \/ 0 <> m) with
+      | O => or_introl (0 <> 0) (refl_equal 0)
+      | S x => or_intror (0 = S x) (discr_r x)
+      end
+  | S x =>
+      fun m : nat =>
+      match m return (S x = m \/ S x <> m) with
+      | O => or_intror (S x = 0) (discr_l x)
+      | S y =>
+          match eqdec x y return (S x = S y \/ S x <> S y) with
+          | or_introl h => or_introl (S x <> S y) (f_equal S h)
+          | or_intror h => or_intror (S x = S y) (ff x y h)
+          end
+      end
   end.
 
-Reset ff.
-Parameter ff: (n,m:nat)~n=m -> ~(S n)=(S m).
-Parameter discr_r : (n:nat) ~(O=(S n)).
-Parameter discr_l : (n:nat) ~((S n)=O).
-
-Type 
-[n:nat] 
-  <[n:nat]n=O\/~n=O>Cases n of 
-      O     => (or_introl ? ~O=O (refl_equal ? O))      
-   |  (S x) => (or_intror (S x)=O ? (discr_l x))
-  end.
 
+Inductive empty : forall n : nat, listn n -> Prop :=
+    intro_empty : empty 0 niln.
 
-Fixpoint eqdec [n:nat] : (m:nat) n=m \/ ~n=m := 
-[m:nat]
- <[n,m:nat] n=m \/ ~n=m>Cases n m of
-      O   O   => (or_introl ? ~O=O (refl_equal ? O))
+Parameter
+  inv_empty : forall (n a : nat) (l : listn n), ~ empty (S n) (consn n a l).
 
-   |  O (S x) => (or_intror O=(S x) ? (discr_r x))
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l in (listn n) return (empty n l \/ ~ empty n l) with
+   | niln => or_introl (~ empty 0 niln) intro_empty
+   | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y)
+   end).
 
-   | (S x) O  => (or_intror ? ~(S x)=O (discr_l x))
+Reset ff.
+Parameter ff : forall n m : nat, n <> m -> S n <> S m.
+Parameter discr_r : forall n : nat, 0 <> S n.
+Parameter discr_l : forall n : nat, S n <> 0.
 
-   | (S x) (S y) =>  
-      <(S x)=(S y)\/~(S x)=(S y)>Cases (eqdec x y) of
-        (or_introl h) => (or_introl  ? ~(S x)=(S y) (f_equal nat nat S x y h))
-      | (or_intror h) => (or_intror (S x)=(S y) ? (ff x y h))   
+Type
+  (fun n : nat =>
+   match n return (n = 0 \/ n <> 0) with
+   | O => or_introl (0 <> 0) (refl_equal 0)
+   | S x => or_intror (S x = 0) (discr_l x)
+   end).
+
+
+Fixpoint eqdec (n m : nat) {struct n} : n = m \/ n <> m :=
+  match n, m return (n = m \/ n <> m) with
+  | O, O => or_introl (0 <> 0) (refl_equal 0)
+  | O, S x => or_intror (0 = S x) (discr_r x)
+  | S x, O => or_intror _ (discr_l x)
+  | S x, S y =>
+      match eqdec x y return (S x = S y \/ S x <> S y) with
+      | or_introl h => or_introl (S x <> S y) (f_equal S h)
+      | or_intror h => or_intror (S x = S y) (ff x y h)
       end
- end.
+  end.
 Reset eqdec.
 
-Fixpoint eqdec [n:nat] : (m:nat) n=m \/ ~n=m := 
-<[n:nat] (m:nat)n=m \/ ~n=m>Cases n  of
-    O  => [m:nat] <[m:nat]O=m\/~O=m>Cases m of 
-                     O    => (or_introl ? ~O=O (refl_equal nat O))
-                   |(S x) => (or_intror O=(S x) ?  (discr_r x))
-                  end
-  | (S x) => [m:nat] 
-    <[m:nat](S x)=m\/~(S x)=m>Cases m of  
-        O    => (or_intror (S x)=O ? (discr_l x))
-     | (S y) =>  
-         <(S x)=(S y)\/~(S x)=(S y)>Cases (eqdec x y) of
-            (or_introl h) => (or_introl ? ~(S x)=(S y) (f_equal ? ? S x y h))
-          | (or_intror h) => (or_intror (S x)=(S y) ? (ff x y h))   
-         end
-    end
- end.
+Fixpoint eqdec (n : nat) : forall m : nat, n = m \/ n <> m :=
+  match n return (forall m : nat, n = m \/ n <> m) with
+  | O =>
+      fun m : nat =>
+      match m return (0 = m \/ 0 <> m) with
+      | O => or_introl (0 <> 0) (refl_equal 0)
+      | S x => or_intror (0 = S x) (discr_r x)
+      end
+  | S x =>
+      fun m : nat =>
+      match m return (S x = m \/ S x <> m) with
+      | O => or_intror (S x = 0) (discr_l x)
+      | S y =>
+          match eqdec x y return (S x = S y \/ S x <> S y) with
+          | or_introl h => or_introl (S x <> S y) (f_equal S h)
+          | or_intror h => or_intror (S x = S y) (ff x y h)
+          end
+      end
+  end.
 
 
 (* ================================================== *)
@@ -1387,17 +1581,17 @@ Fixpoint eqdec [n:nat] : (m:nat) n=m \/ ~n=m :=
 (* ================================================== *)
 
 
-Inductive Empty [A:Set] : (List A)-> Prop := 
-  intro_Empty: (Empty A (Nil A)).
+Inductive Empty (A : Set) : List A -> Prop :=
+    intro_Empty : Empty A (Nil A).
 
-Parameter inv_Empty : (A:Set)(a:A)(x:(List A)) ~(Empty A (Cons A a x)).
+Parameter
+  inv_Empty : forall (A : Set) (a : A) (x : List A), ~ Empty A (Cons A a x).
 
 
 Type
-  <[l:(List nat)](Empty nat l) \/ ~(Empty nat l)>Cases (Nil nat) of 
-        Nil   =>  (or_introl ? ~(Empty nat (Nil nat)) (intro_Empty nat))
-   |   (Cons a y)  =>  (or_intror (Empty nat (Cons nat a y)) ? 
-                                   (inv_Empty nat a y))
+  match Nil nat as l return (Empty nat l \/ ~ Empty nat l) with
+  | Nil => or_introl (~ Empty nat (Nil nat)) (intro_Empty nat)
+  | Cons a y => or_intror (Empty nat (Cons nat a y)) (inv_Empty nat a y)
   end.
 
 
@@ -1406,192 +1600,222 @@ Type
 (* ================================================== *)
 
 
-Inductive empty : (n:nat)(listn n)-> Prop := 
-  intro_empty: (empty O niln).
+Inductive empty : forall n : nat, listn n -> Prop :=
+    intro_empty : empty 0 niln.
 
-Parameter inv_empty : (n,a:nat)(l:(listn n)) ~(empty (S n) (consn n a l)).
+Parameter
+  inv_empty : forall (n a : nat) (l : listn n), ~ empty (S n) (consn n a l).
 
-Type 
-[n:nat] [l:(listn n)]
-  <[n:nat] [l:(listn n)](empty n l) \/ ~(empty n l)>Cases l of 
-        niln               =>  (or_introl ? ~(empty O niln) intro_empty)
-   |  ((consn n a y) as b) =>  (or_intror (empty (S n) b) ? (inv_empty n a y))
-  end.
+Type
+  (fun (n : nat) (l : listn n) =>
+   match l in (listn n) return (empty n l \/ ~ empty n l) with
+   | niln => or_introl (~ empty 0 niln) intro_empty
+   | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y)
+   end).
 
 (* ===================================== *)
 (*   Test parametros:                    *)
 (* ===================================== *)
 
-Inductive eqlong : (List nat)-> (List nat)-> Prop :=
- eql_cons : (n,m:nat)(x,y:(List nat)) 
-            (eqlong x y) -> (eqlong (Cons nat n x) (Cons nat m y))
-| eql_nil :  (eqlong (Nil nat) (Nil nat)).
-
-
-Parameter V1 : (eqlong (Nil nat) (Nil nat))\/ ~(eqlong (Nil nat) (Nil nat)).
-Parameter V2 : (a:nat)(x:(List nat))
-      (eqlong (Nil nat) (Cons nat a x))\/ ~(eqlong (Nil nat)(Cons nat a x)).
-Parameter V3 : (a:nat)(x:(List nat))
-      (eqlong  (Cons nat a x)  (Nil nat))\/ ~(eqlong (Cons nat a x) (Nil nat)).
-Parameter V4 : (a:nat)(x:(List nat))(b:nat)(y:(List nat))
-      (eqlong  (Cons nat a x)(Cons nat b y))
-        \/ ~(eqlong (Cons nat a x) (Cons nat b y)).
+Inductive eqlong : List nat -> List nat -> Prop :=
+  | eql_cons :
+      forall (n m : nat) (x y : List nat),
+      eqlong x y -> eqlong (Cons nat n x) (Cons nat m y)
+  | eql_nil : eqlong (Nil nat) (Nil nat).
+
+
+Parameter V1 : eqlong (Nil nat) (Nil nat) \/ ~ eqlong (Nil nat) (Nil nat).
+Parameter
+  V2 :
+    forall (a : nat) (x : List nat),
+    eqlong (Nil nat) (Cons nat a x) \/ ~ eqlong (Nil nat) (Cons nat a x).
+Parameter
+  V3 :
+    forall (a : nat) (x : List nat),
+    eqlong (Cons nat a x) (Nil nat) \/ ~ eqlong (Cons nat a x) (Nil nat).
+Parameter
+  V4 :
+    forall (a : nat) (x : List nat) (b : nat) (y : List nat),
+    eqlong (Cons nat a x) (Cons nat b y) \/
+    ~ eqlong (Cons nat a x) (Cons nat b y).
 
 Type
- <[x,y:(List nat)](eqlong x y)\/~(eqlong x y)>Cases (Nil nat) (Nil nat) of
-      Nil Nil   => V1
-   |  Nil (Cons a x)  => (V2 a x)
-   |  (Cons a x)  Nil => (V3 a x)
-   | (Cons a x)  (Cons b y)  => (V4 a x b y)
- end.
+  match Nil nat as x, Nil nat as y return (eqlong x y \/ ~ eqlong x y) with
+  | Nil, Nil => V1
+  | Nil, Cons a x => V2 a x
+  | Cons a x, Nil => V3 a x
+  | Cons a x, Cons b y => V4 a x b y
+  end.
 
 
 Type
-[x,y:(List nat)]
- <[x,y:(List nat)](eqlong x y)\/~(eqlong x y)>Cases x y of
-      Nil Nil   => V1
-   |  Nil (Cons a x)  => (V2 a x)
-   |  (Cons a x)  Nil => (V3 a x)
-   | (Cons a x)  (Cons b y)  => (V4 a x b y)
- end.
+  (fun x y : List nat =>
+   match x, y return (eqlong x y \/ ~ eqlong x y) with
+   | Nil, Nil => V1
+   | Nil, Cons a x => V2 a x
+   | Cons a x, Nil => V3 a x
+   | Cons a x, Cons b y => V4 a x b y
+   end).
 
  
 (* ===================================== *)
 
-Inductive Eqlong : (n:nat) (listn n)-> (m:nat) (listn m)-> Prop :=
- Eql_cons : (n,m:nat )(x:(listn n))(y:(listn m)) (a,b:nat) 
-            (Eqlong n x m y) 
-             ->(Eqlong (S n) (consn n a x) (S m) (consn m b y))
-| Eql_niln :  (Eqlong O niln O niln).
-
-
-Parameter W1 : (Eqlong O niln O niln)\/ ~(Eqlong O niln O niln).
-Parameter W2 : (n,a:nat)(x:(listn n)) 
-  (Eqlong O niln (S n)(consn n a x)) \/ ~(Eqlong  O niln (S n) (consn n a x)).
-Parameter W3 : (n,a:nat)(x:(listn n)) 
- (Eqlong (S n) (consn n a x)  O niln) \/ ~(Eqlong (S n) (consn n a x)  O niln).
-Parameter W4 : (n,a:nat)(x:(listn n)) (m,b:nat)(y:(listn m)) 
-      (Eqlong  (S n)(consn n a x) (S m) (consn m b y))
-        \/ ~(Eqlong (S n)(consn n a x) (S m) (consn m b y)).
+Inductive Eqlong :
+forall n : nat, listn n -> forall m : nat, listn m -> Prop :=
+  | Eql_cons :
+      forall (n m : nat) (x : listn n) (y : listn m) (a b : nat),
+      Eqlong n x m y -> Eqlong (S n) (consn n a x) (S m) (consn m b y)
+  | Eql_niln : Eqlong 0 niln 0 niln.
+
+
+Parameter W1 : Eqlong 0 niln 0 niln \/ ~ Eqlong 0 niln 0 niln.
+Parameter
+  W2 :
+    forall (n a : nat) (x : listn n),
+    Eqlong 0 niln (S n) (consn n a x) \/ ~ Eqlong 0 niln (S n) (consn n a x).
+Parameter
+  W3 :
+    forall (n a : nat) (x : listn n),
+    Eqlong (S n) (consn n a x) 0 niln \/ ~ Eqlong (S n) (consn n a x) 0 niln.
+Parameter
+  W4 :
+    forall (n a : nat) (x : listn n) (m b : nat) (y : listn m),
+    Eqlong (S n) (consn n a x) (S m) (consn m b y) \/
+    ~ Eqlong (S n) (consn n a x) (S m) (consn m b y).
 
 Type
- <[n:nat][x:(listn n)][m:nat][y:(listn m)]
-     (Eqlong n x m y)\/~(Eqlong n x m y)>Cases niln  niln  of
-      niln niln   => W1
-   |  niln (consn n a x)  => (W2 n a x)
-   |  (consn n a x)  niln => (W3 n a x)
-   | (consn n a x)  (consn m b y)  => (W4 n a x m b y)
- end.
-
-
-Type 
-[n,m:nat][x:(listn n)][y:(listn m)]
- <[n:nat][x:(listn n)][m:nat][y:(listn m)]
-     (Eqlong n x m y)\/~(Eqlong n x m y)>Cases x y of
-      niln niln   => W1
-   |  niln (consn n a x)  => (W2 n a x)
-   |  (consn n a x)  niln => (W3 n a x)
-   | (consn n a x)  (consn m b y)  => (W4 n a x m b y)
- end.
-
-
-Parameter Inv_r : (n,a:nat)(x:(listn n)) ~(Eqlong O niln (S n) (consn n a x)).
-Parameter Inv_l : (n,a:nat)(x:(listn n)) ~(Eqlong (S n) (consn n a x) O niln).
-Parameter Nff : (n,a:nat)(x:(listn n)) (m,b:nat)(y:(listn m)) 
-               ~(Eqlong n x m y)
-                -> ~(Eqlong (S n) (consn n a x) (S m) (consn m b y)).
-
-
-
-Fixpoint Eqlongdec [n:nat; x:(listn n)] : (m:nat)(y:(listn m))
-                                           (Eqlong n x m y)\/~(Eqlong n x m y)
-:= [m:nat][y:(listn m)]
- <[n:nat][x:(listn n)][m:nat][y:(listn m)]
-     (Eqlong n x m y)\/~(Eqlong n x m y)>Cases x y of
-      niln niln   => (or_introl ? ~(Eqlong O niln O niln)  Eql_niln)
-
-   |  niln ((consn n a x) as L)  => 
-        (or_intror (Eqlong O niln (S n) L)  ? (Inv_r n a x))
-
-   | ((consn n a x) as L)  niln => 
-       (or_intror (Eqlong (S n) L O niln) ? (Inv_l n a x))
+  match
+    niln as x in (listn n), niln as y in (listn m)
+    return (Eqlong n x m y \/ ~ Eqlong n x m y)
+  with
+  | niln, niln => W1
+  | niln, consn n a x => W2 n a x
+  | consn n a x, niln => W3 n a x
+  | consn n a x, consn m b y => W4 n a x m b y
+  end.
 
 
-   | ((consn n a x) as L1) ((consn m b y) as L2) =>
-     <(Eqlong (S n) L1 (S m) L2) \/~(Eqlong (S n) L1 (S m) L2)>
-      Cases (Eqlongdec n x m y) of
-        (or_introl h) => 
-           (or_introl  ? ~(Eqlong (S n) L1 (S m) L2)(Eql_cons n m x y a b h))
-      | (or_intror h) => 
-           (or_intror (Eqlong (S n) L1 (S m) L2) ? (Nff n a x  m b y h))   
+Type
+  (fun (n m : nat) (x : listn n) (y : listn m) =>
+   match
+     x in (listn n), y in (listn m)
+     return (Eqlong n x m y \/ ~ Eqlong n x m y)
+   with
+   | niln, niln => W1
+   | niln, consn n a x => W2 n a x
+   | consn n a x, niln => W3 n a x
+   | consn n a x, consn m b y => W4 n a x m b y
+   end).
+
+
+Parameter
+  Inv_r :
+    forall (n a : nat) (x : listn n), ~ Eqlong 0 niln (S n) (consn n a x).
+Parameter
+  Inv_l :
+    forall (n a : nat) (x : listn n), ~ Eqlong (S n) (consn n a x) 0 niln.
+Parameter
+  Nff :
+    forall (n a : nat) (x : listn n) (m b : nat) (y : listn m),
+    ~ Eqlong n x m y -> ~ Eqlong (S n) (consn n a x) (S m) (consn m b y).
+
+
+
+Fixpoint Eqlongdec (n : nat) (x : listn n) (m : nat) 
+ (y : listn m) {struct x} : Eqlong n x m y \/ ~ Eqlong n x m y :=
+  match
+    x in (listn n), y in (listn m)
+    return (Eqlong n x m y \/ ~ Eqlong n x m y)
+  with
+  | niln, niln => or_introl (~ Eqlong 0 niln 0 niln) Eql_niln
+  | niln, consn n a x as L => or_intror (Eqlong 0 niln (S n) L) (Inv_r n a x)
+  | consn n a x as L, niln => or_intror (Eqlong (S n) L 0 niln) (Inv_l n a x)
+  | consn n a x as L1, consn m b y as L2 =>
+      match
+        Eqlongdec n x m y
+        return (Eqlong (S n) L1 (S m) L2 \/ ~ Eqlong (S n) L1 (S m) L2)
+      with
+      | or_introl h =>
+          or_introl (~ Eqlong (S n) L1 (S m) L2) (Eql_cons n m x y a b h)
+      | or_intror h =>
+          or_intror (Eqlong (S n) L1 (S m) L2) (Nff n a x m b y h)
       end
- end.
+  end.
 
 (* ============================================== *)
 (*     To test compilation of dependent case      *)
 (*      Multiple Patterns                         *)
 (* ============================================== *)
-Inductive skel: Type :=
-     PROP: skel
-   | PROD: skel->skel->skel.
+Inductive skel : Type :=
+  | PROP : skel
+  | PROD : skel -> skel -> skel.
 
 Parameter Can : skel -> Type.
-Parameter default_can : (s:skel) (Can s).
+Parameter default_can : forall s : skel, Can s.
 
-Type  [s1,s2:skel]
-[s1,s2:skel]<[s1:skel][_:skel](Can s1)>Cases s1 s2 of
-  PROP PROP => (default_can PROP)
-| (PROD x y) PROP => (default_can (PROD x y))
-| (PROD x y) _ => (default_can (PROD x y))
-| PROP _ => (default_can PROP)
-end.
+Type
+  (fun s1 s2 s1 s2 : skel =>
+   match s1, s2 return (Can s1) with
+   | PROP, PROP => default_can PROP
+   | PROD x y, PROP => default_can (PROD x y)
+   | PROD x y, _ => default_can (PROD x y)
+   | PROP, _ => default_can PROP
+   end).
 
 (* to test bindings in nested Cases *)
 (* ================================ *)
 Inductive Pair : Set :=
-  pnil : Pair |
-  pcons : Pair -> Pair -> Pair.
-
-Type [p,q:Pair]Cases p of
-  (pcons _ x) => 
-     Cases q of 
-      (pcons _ (pcons _ x)) => True
-     |  _  => False
-     end
-|  _  => False
-end.
-
-
-Type [p,q:Pair]Cases p of
-  (pcons _ x) => 
-     Cases q of 
-      (pcons _ (pcons _ x)) => 
-          Cases q of 
-              (pcons _ (pcons _ (pcons _ x))) => x
+  | pnil : Pair
+  | pcons : Pair -> Pair -> Pair.
+
+Type
+  (fun p q : Pair =>
+   match p with
+   | pcons _ x => match q with
+                  | pcons _ (pcons _ x) => True
+                  | _ => False
+                  end
+   | _ => False
+   end).
+
+
+Type
+  (fun p q : Pair =>
+   match p with
+   | pcons _ x =>
+       match q with
+       | pcons _ (pcons _ x) =>
+           match q with
+           | pcons _ (pcons _ (pcons _ x)) => x
            | _ => pnil
            end
-     |  _  => pnil
-     end
-|  _  => pnil
-end.
+       | _ => pnil
+       end
+   | _ => pnil
+   end).
 
-Type  
-  [n:nat]
-         [l:(listn (S n))]
-           <[z:nat](listn (pred z))>Cases l of 
-                       niln  => niln
-                    |  (consn n _ l)  => 
-                           <[m:nat](listn m)>Cases l of 
-                                             niln => niln
-                                           | b => b
-                                           end
-                   end.
+Type
+  (fun (n : nat) (l : listn (S n)) =>
+   match l in (listn z) return (listn (pred z)) with
+   | niln => niln
+   | consn n _ l =>
+       match l in (listn m) return (listn m) with
+       | niln => niln
+       | b => b
+       end
+   end).
 
 
 
 (* Test de la syntaxe avec nombres *)
-Require Arith.
-Type [n]Cases n of (2) => true | _ => false end.
-
-Require ZArith.
-Type [n]Cases n of `0` => true | _ => false end.
+Require Import Arith.
+Type (fun n => match n with
+               | S (S O) => true
+               | _ => false
+               end).
+
+Require Import ZArith.
+Type (fun n => match n with
+               | Z0 => true
+               | _ => false
+               end).
diff --git a/test-suite/success/CasesDep.v b/test-suite/success/CasesDep.v
index 0256280c..0477377e 100644
--- a/test-suite/success/CasesDep.v
+++ b/test-suite/success/CasesDep.v
@@ -1,25 +1,28 @@
 (* Check forward dependencies *)
 
-Check [P:nat->Prop][Q][A:(P O)->Q][B:(n:nat)(P (S n))->Q][x]
-  <[_]Q>Cases x of 
-  | (exist O H) => (A H)
-  | (exist (S n) H) => (B n H)
-  end.
+Check
+  (fun (P : nat -> Prop) Q (A : P 0 -> Q) (B : forall n : nat, P (S n) -> Q)
+     x =>
+   match x return Q with
+   | exist O H => A H
+   | exist (S n) H => B n H
+   end).
 
 (* Check dependencies in anonymous arguments (from FTA/listn.v) *)
 
-Inductive listn [A:Set] : nat->Set :=
-  niln: (listn A O)
-| consn: (a:A)(n:nat)(listn A n)->(listn A (S n)).
+Inductive listn (A : Set) : nat -> Set :=
+  | niln : listn A 0
+  | consn : forall (a : A) (n : nat), listn A n -> listn A (S n).
 
 Section Folding.
-Variables B, C : Set.
+Variable B C : Set.
 Variable g : B -> C -> C.
 Variable c : C.
 
-Fixpoint foldrn [n:nat; bs:(listn B n)] : C :=
-  Cases bs of niln => c
-            | (consn b _ tl) => (g b (foldrn ? tl))
+Fixpoint foldrn (n : nat) (bs : listn B n) {struct bs} : C :=
+  match bs with
+  | niln => c
+  | consn b _ tl => g b (foldrn _ tl)
   end.
 End Folding.
 
@@ -30,149 +33,154 @@ End Folding.
 (* -------------------------------------------------------------------- *)
 
 
-Require Prelude.
-Require Logic_Type.
+Require Import Prelude.
+Require Import Logic_Type.
 
 Section Orderings.
-   Variable U: Type.
+   Variable U : Type.
    
-   Definition Relation :=  U -> U -> Prop.
+   Definition Relation := U -> U -> Prop.
 
-   Variable R: Relation.
+   Variable R : Relation.
    
-   Definition Reflexive : Prop :=  (x: U) (R x x).
+   Definition Reflexive : Prop := forall x : U, R x x.
    
-   Definition Transitive : Prop :=  (x,y,z: U) (R x y) -> (R y z) -> (R x z).
+   Definition Transitive : Prop := forall x y z : U, R x y -> R y z -> R x z.
    
-   Definition Symmetric : Prop :=  (x,y: U) (R x y) -> (R y x).
+   Definition Symmetric : Prop := forall x y : U, R x y -> R y x.
    
-   Definition Antisymmetric : Prop :=
-      (x,y: U) (R x y) -> (R y x) -> x==y.
+   Definition Antisymmetric : Prop := forall x y : U, R x y -> R y x -> x = y.
    
-   Definition contains : Relation -> Relation -> Prop :=
-      [R,R': Relation] (x,y: U) (R' x y) -> (R x y).
-  Definition same_relation : Relation -> Relation -> Prop :=
-      [R,R': Relation] (contains R R') /\ (contains R' R).
+   Definition contains (R R' : Relation) : Prop :=
+     forall x y : U, R' x y -> R x y.
+  Definition same_relation (R R' : Relation) : Prop :=
+    contains R R' /\ contains R' R.
 Inductive Equivalence : Prop :=
-         Build_Equivalence:
-           Reflexive -> Transitive -> Symmetric -> Equivalence.
+    Build_Equivalence : Reflexive -> Transitive -> Symmetric -> Equivalence.
    
    Inductive PER : Prop :=
-         Build_PER: Symmetric -> Transitive -> PER.
+       Build_PER : Symmetric -> Transitive -> PER.
    
 End Orderings.
 
 (***** Setoid  *******)
 
-Inductive Setoid : Type 
-  := Build_Setoid : (S:Type)(R:(Relation S))(Equivalence ? R) -> Setoid.
+Inductive Setoid : Type :=
+    Build_Setoid :
+      forall (S : Type) (R : Relation S), Equivalence _ R -> Setoid.
 
-Definition elem := [A:Setoid] let (S,R,e)=A in S.
+Definition elem (A : Setoid) := let (S, R, e) := A in S.
 
-Grammar constr constr1 :=
- elem  [ "|" constr0($s) "|"] -> [ (elem $s) ].
+(* <Warning> : Grammar is replaced by Notation *)
 
-Definition equal := [A:Setoid]
-   <[s:Setoid](Relation |s|)>let (S,R,e)=A in R.
+Definition equal (A : Setoid) :=
+  let (S, R, e) as s return (Relation (elem s)) := A in R.
 
-Grammar constr constr1 :=
- equal   [ constr0($c) "=" "%" "S" constr0($c2) ] -> 
-         [ (equal ? $c $c2) ].
+(* <Warning> : Grammar is replaced by Notation *)
 
 
-Axiom prf_equiv : (A:Setoid)(Equivalence |A| (equal A)).
-Axiom prf_refl : (A:Setoid)(Reflexive |A| (equal A)).
-Axiom prf_sym : (A:Setoid)(Symmetric |A| (equal A)).
-Axiom prf_trans : (A:Setoid)(Transitive |A| (equal A)).
+Axiom prf_equiv : forall A : Setoid, Equivalence (elem A) (equal A).
+Axiom prf_refl : forall A : Setoid, Reflexive (elem A) (equal A).
+Axiom prf_sym : forall A : Setoid, Symmetric (elem A) (equal A).
+Axiom prf_trans : forall A : Setoid, Transitive (elem A) (equal A).
 
 Section Maps.
-Variables A,B: Setoid.
+Variable A B : Setoid.
 
-Definition Map_law := [f:|A| -> |B|]
-    (x,y:|A|) x =%S y -> (f x) =%S (f y).
+Definition Map_law (f : elem A -> elem B) :=
+  forall x y : elem A, equal _ x y -> equal _ (f x) (f y).
 
 Inductive Map : Type :=
-    Build_Map : (f:|A| -> |B|)(p:(Map_law f))Map.
+    Build_Map : forall (f : elem A -> elem B) (p : Map_law f), Map.
 
-Definition explicit_ap := [m:Map] <|A| -> |B|>Match m with 
-         [f:?][p:?]f end.
+Definition explicit_ap (m : Map) :=
+  match m return (elem A -> elem B) with
+  | Build_Map f p => f
+  end.
 
-Axiom pres : (m:Map)(Map_law (explicit_ap m)).
+Axiom pres : forall m : Map, Map_law (explicit_ap m).
 
-Definition ext := [f,g:Map]
-         (x:|A|) (explicit_ap f x) =%S (explicit_ap g x).
+Definition ext (f g : Map) :=
+  forall x : elem A, equal _ (explicit_ap f x) (explicit_ap g x).
 
-Axiom Equiv_map_eq : (Equivalence Map ext).
+Axiom Equiv_map_eq : Equivalence Map ext.
 
-Definition Map_setoid := (Build_Setoid Map ext Equiv_map_eq).
+Definition Map_setoid := Build_Setoid Map ext Equiv_map_eq.
 
 End Maps.
 
-Notation ap := (explicit_ap ? ?). 
+Notation ap := (explicit_ap _ _). 
 
-Grammar constr constr8 :=
-  map_setoid [ constr7($c1) "=>" constr8($c2) ] 
-                 -> [ (Map_setoid $c1 $c2) ].
+(* <Warning> : Grammar is replaced by Notation *)
 
 
-Definition ap2 := [A,B,C:Setoid][f:|(A=>(B=>C))|][a:|A|] (ap (ap f a)).
+Definition ap2 (A B C : Setoid) (f : elem (Map_setoid A (Map_setoid B C)))
+  (a : elem A) := ap (ap f a).
 
 
 (*****    posint     ******)
 
-Inductive posint : Type
-        := Z : posint | Suc : posint -> posint.
+Inductive posint : Type :=
+  | Z : posint
+  | Suc : posint -> posint.
 
-Axiom f_equal : (A,B:Type)(f:A->B)(x,y:A) x==y -> (f x)==(f y).
-Axiom eq_Suc : (n,m:posint) n==m -> (Suc n)==(Suc m).
+Axiom
+  f_equal : forall (A B : Type) (f : A -> B) (x y : A), x = y -> f x = f y.
+Axiom eq_Suc : forall n m : posint, n = m -> Suc n = Suc m.
 
 (* The predecessor function *)
 
-Definition pred : posint->posint
-     := [n:posint](<posint>Case n of (* Z *) Z 
-                            (* Suc u *) [u:posint]u end).
+Definition pred (n : posint) : posint :=
+  match n return posint with
+  | Z => (* Z *)  Z 
+      (* Suc u *) 
+  | Suc u => u
+  end.
 
-Axiom pred_Sucn : (m:posint) m==(pred (Suc m)).
-Axiom eq_add_Suc : (n,m:posint) (Suc n)==(Suc m) -> n==m.
-Axiom not_eq_Suc : (n,m:posint) ~(n==m) -> ~((Suc n)==(Suc m)).
+Axiom pred_Sucn : forall m : posint, m = pred (Suc m).
+Axiom eq_add_Suc : forall n m : posint, Suc n = Suc m -> n = m.
+Axiom not_eq_Suc : forall n m : posint, n <> m -> Suc n <> Suc m.
 
 
-Definition IsSuc : posint->Prop
-  := [n:posint](<Prop>Case n of (* Z *) False
-                          (* Suc p *) [p:posint]True end).
-Definition IsZero :posint->Prop :=
-	[n:posint]<Prop>Match n with 
-		True
-		[p:posint][H:Prop]False end.
+Definition IsSuc (n : posint) : Prop :=
+  match n return Prop with
+  | Z => (* Z *)  False
+      (* Suc p *) 
+  | Suc p => True
+  end.
+Definition IsZero (n : posint) : Prop :=
+  match n with
+  | Z => True
+  | Suc _ => False
+  end.
 
-Axiom Z_Suc : (n:posint) ~(Z==(Suc n)).
-Axiom  Suc_Z: (n:posint) ~(Suc n)==Z.
-Axiom n_Sucn : (n:posint) ~(n==(Suc n)).
-Axiom Sucn_n : (n:posint) ~(Suc n)==n.
-Axiom eqT_symt : (a,b:posint) ~(a==b)->~(b==a).
+Axiom Z_Suc : forall n : posint, Z <> Suc n.
+Axiom Suc_Z : forall n : posint, Suc n <> Z.
+Axiom n_Sucn : forall n : posint, n <> Suc n.
+Axiom Sucn_n : forall n : posint, Suc n <> n.
+Axiom eqT_symt : forall a b : posint, a <> b -> b <> a.
 
 
 (*******  Dsetoid *****)
 
-Definition Decidable :=[A:Type][R:(Relation A)]
-		(x,y:A)(R x y) \/ ~(R x y).
+Definition Decidable (A : Type) (R : Relation A) :=
+  forall x y : A, R x y \/ ~ R x y.
 
 
-Record DSetoid : Type :=
-{Set_of : Setoid;
- prf_decid : (Decidable |Set_of| (equal Set_of))}.
+Record DSetoid : Type := 
+  {Set_of : Setoid; prf_decid : Decidable (elem Set_of) (equal Set_of)}.
 
 (* example de Dsetoide d'entiers *)
 
 
-Axiom eqT_equiv : (Equivalence posint (eqT posint)).
-Axiom Eq_posint_deci : (Decidable posint (eqT posint)).
+Axiom eqT_equiv : Equivalence posint (eq (A:=posint)).
+Axiom Eq_posint_deci : Decidable posint (eq (A:=posint)).
 
 (* Dsetoide des posint*)
 
-Definition Set_of_posint := (Build_Setoid posint (eqT posint) eqT_equiv).
+Definition Set_of_posint := Build_Setoid posint (eq (A:=posint)) eqT_equiv.
 
-Definition Dposint := (Build_DSetoid Set_of_posint Eq_posint_deci).
+Definition Dposint := Build_DSetoid Set_of_posint Eq_posint_deci.
 
 
 
@@ -186,23 +194,22 @@ Definition Dposint := (Build_DSetoid Set_of_posint Eq_posint_deci).
 
 Section Sig.
 
-Record Signature :Type :=
-{Sigma : DSetoid; 
- Arity : (Map (Set_of Sigma) (Set_of Dposint))}.
+Record Signature : Type := 
+  {Sigma : DSetoid; Arity : Map (Set_of Sigma) (Set_of Dposint)}.
 
-Variable S:Signature.
+Variable S : Signature.
 
 
 
 Variable Var : DSetoid.
 
-Mutual Inductive TERM : Type :=
-	  var : |(Set_of Var)| -> TERM
-	| oper : (op: |(Set_of (Sigma S))| ) (LTERM (ap (Arity S) op)) -> TERM
-with
-	LTERM : posint -> Type :=
-	  nil : (LTERM Z)
-	| cons : TERM -> (n:posint)(LTERM n) -> (LTERM (Suc n)).
+Inductive TERM : Type :=
+  | var : elem (Set_of Var) -> TERM
+  | oper :
+      forall op : elem (Set_of (Sigma S)), LTERM (ap (Arity S) op) -> TERM
+with LTERM : posint -> Type :=
+  | nil : LTERM Z
+  | cons : TERM -> forall n : posint, LTERM n -> LTERM (Suc n).
 
 
 
@@ -211,51 +218,51 @@ with
 (* -------------------------------------------------------------------- *)
 
 
-Parameter t1,t2: TERM.
+Parameter t1 t2 : TERM.
 
-Type 
- Cases t1 t2 of 
- | (var  v1) (var v2) => True
- | (oper op1 l1) (oper op2 l2) => False
- | _ _ => False 
- end.
+Type
+  match t1, t2 with
+  | var v1, var v2 => True
+  | oper op1 l1, oper op2 l2 => False
+  | _, _ => False
+  end.
 
 
 
-Parameter n2:posint.
-Parameter l1, l2:(LTERM n2).
+Parameter n2 : posint.
+Parameter l1 l2 : LTERM n2.
 
-Type 
- Cases l1 l2  of
-    nil            nil => True 
- |  (cons v m y)   nil => False
- |  _               _  => False
-end.
+Type
+  match l1, l2 with
+  | nil, nil => True
+  | cons v m y, nil => False
+  | _, _ => False
+  end.
 
 
-Type Cases l1 l2 of
-    nil              nil      => True 
- | (cons u n x)  (cons v m y) =>False
- |   _               _        => False
-end.
+Type
+  match l1, l2 with
+  | nil, nil => True
+  | cons u n x, cons v m y => False
+  | _, _ => False
+  end.
 
 
 
-Definition equalT [t1:TERM]:TERM->Prop :=
-[t2:TERM] 
- Cases t1 t2 of 
-   (var  v1)        (var v2)    => True
- | (oper op1 l1)  (oper op2 l2) => False
- |  _                   _       => False 
- end.
+Definition equalT (t1 t2 : TERM) : Prop :=
+  match t1, t2 with
+  | var v1, var v2 => True
+  | oper op1 l1, oper op2 l2 => False
+  | _, _ => False
+  end.
 
-Definition EqListT [n1:posint;l1:(LTERM n1)]: (n2:posint)(LTERM n2)->Prop :=
-[n2:posint][l2:(LTERM n2)]
- Cases l1 l2 of
-    nil                 nil             => True 
- | (cons t1 n1' l1')  (cons t2 n2' l2') => False
- | _                    _               => False
-end.
+Definition EqListT (n1 : posint) (l1 : LTERM n1) (n2 : posint)
+  (l2 : LTERM n2) : Prop :=
+  match l1, l2 with
+  | nil, nil => True
+  | cons t1 n1' l1', cons t2 n2' l2' => False
+  | _, _ => False
+  end.
 
 
 Reset equalT.
@@ -263,37 +270,52 @@ Reset equalT.
 (*          Initial exemple (without patterns)                       *)
 (*-------------------------------------------------------------------*)
 
-Fixpoint equalT [t1:TERM]:TERM->Prop :=
-<TERM->Prop>Case t1 of 
-	(*var*) [v1:|(Set_of Var)|][t2:TERM]
-		<Prop>Case t2 of
-		(*var*)[v2:|(Set_of Var)|] (v1 =%S v2)
-		(*oper*)[op2:|(Set_of (Sigma S))|][_:(LTERM (ap (Arity S) op2))]False
-		end
-	(*oper*)[op1:|(Set_of (Sigma S))|]
-                [l1:(LTERM (ap (Arity S) op1))][t2:TERM]
-                <Prop>Case t2 of
-		(*var*)[v2:|(Set_of Var)|]False
-		(*oper*)[op2:|(Set_of (Sigma S))|]
-                        [l2:(LTERM (ap (Arity S) op2))]
-			((op1=%S op2)/\ (EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2))
-		end
-end
-with EqListT [n1:posint;l1:(LTERM n1)]: (n2:posint)(LTERM n2)->Prop :=
-<[_:posint](n2:posint)(LTERM n2)->Prop>Case l1 of
-	(*nil*) [n2:posint][l2:(LTERM n2)]
-		<[_:posint]Prop>Case l2 of
-		(*nil*)True
-	 	(*cons*)[t2:TERM][n2':posint][l2':(LTERM n2')]False
-	end
-	(*cons*)[t1:TERM][n1':posint][l1':(LTERM n1')]
-		[n2:posint][l2:(LTERM n2)]
-		<[_:posint]Prop>Case l2 of
-		(*nil*) False
-		(*cons*)[t2:TERM][n2':posint][l2':(LTERM n2')]
-			((equalT t1 t2) /\ (EqListT n1' l1' n2' l2'))
-		end
-end.
+Fixpoint equalT (t1 : TERM) : TERM -> Prop :=
+  match t1 return (TERM -> Prop) with
+  | var v1 => 
+      (*var*) 
+      fun t2 : TERM =>
+      match t2 return Prop with
+      | var v2 =>
+          (*var*) equal _ v1 v2
+          (*oper*)
+      | oper op2 _ => False
+      end
+      (*oper*)
+  | oper op1 l1 =>
+      fun t2 : TERM =>
+      match t2 return Prop with
+      | var v2 =>
+          (*var*) False
+          (*oper*)
+      | oper op2 l2 =>
+          equal _ op1 op2 /\
+          EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2
+      end
+  end
+ 
+ with EqListT (n1 : posint) (l1 : LTERM n1) {struct l1} :
+ forall n2 : posint, LTERM n2 -> Prop :=
+  match l1 in (LTERM _) return (forall n2 : posint, LTERM n2 -> Prop) with
+  | nil =>
+      (*nil*) 
+      fun (n2 : posint) (l2 : LTERM n2) =>
+      match l2 in (LTERM _) return Prop with
+      | nil =>
+          (*nil*) True
+          (*cons*)
+      | cons t2 n2' l2' => False
+      end
+      (*cons*)
+  | cons t1 n1' l1' =>
+      fun (n2 : posint) (l2 : LTERM n2) =>
+      match l2 in (LTERM _) return Prop with
+      | nil =>
+          (*nil*)  False
+          (*cons*)
+      | cons t2 n2' l2' => equalT t1 t2 /\ EqListT n1' l1' n2' l2'
+      end
+  end.
 
 
 (* ---------------------------------------------------------------- *)
@@ -301,91 +323,97 @@ end.
 (* ---------------------------------------------------------------- *)
 Reset equalT.
 
-Fixpoint equalT [t1:TERM]:TERM->Prop :=
-Cases t1 of 
-  (var  v1) => [t2:TERM]
-	        Cases t2 of
-		     (var v2) => (v1 =%S v2)
-		 | (oper op2 _) =>False
-		 end
-| (oper op1 l1) => [t2:TERM]
-		    Cases t2 of
-	              (var _) => False
-                    | (oper op2 l2) => (op1=%S op2)
-                      /\ (EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2)
-		    end
-end
-with EqListT [n1:posint;l1:(LTERM n1)]: (n2:posint)(LTERM n2)->Prop :=
-<[_:posint](n2:posint)(LTERM n2)->Prop>Cases l1 of
-  nil => [n2:posint][l2:(LTERM n2)]
-          Cases l2 of
-              nil => True
-	  | _  => False
-	  end
-| (cons t1 n1' l1') => [n2:posint][l2:(LTERM n2)]
-		        Cases l2 of
-		           nil =>False
-		        | (cons t2 n2' l2') => (equalT t1 t2) 
-                                                /\ (EqListT n1' l1' n2' l2')
-		end
-end.
+Fixpoint equalT (t1 : TERM) : TERM -> Prop :=
+  match t1 with
+  | var v1 =>
+      fun t2 : TERM =>
+      match t2 with
+      | var v2 => equal _ v1 v2
+      | oper op2 _ => False
+      end
+  | oper op1 l1 =>
+      fun t2 : TERM =>
+      match t2 with
+      | var _ => False
+      | oper op2 l2 =>
+          equal _ op1 op2 /\
+          EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2
+      end
+  end
+ 
+ with EqListT (n1 : posint) (l1 : LTERM n1) {struct l1} :
+ forall n2 : posint, LTERM n2 -> Prop :=
+  match l1 return (forall n2 : posint, LTERM n2 -> Prop) with
+  | nil =>
+      fun (n2 : posint) (l2 : LTERM n2) =>
+      match l2 with
+      | nil => True
+      | _ => False
+      end
+  | cons t1 n1' l1' =>
+      fun (n2 : posint) (l2 : LTERM n2) =>
+      match l2 with
+      | nil => False
+      | cons t2 n2' l2' => equalT t1 t2 /\ EqListT n1' l1' n2' l2'
+      end
+  end.
 
 
 Reset equalT.
 
-Fixpoint equalT [t1:TERM]:TERM->Prop :=
-Cases t1 of 
-  (var  v1) => [t2:TERM]
-	        Cases t2 of
-		     (var v2) => (v1 =%S v2)
-		 | (oper op2 _) =>False
-		 end
-| (oper op1 l1) => [t2:TERM]
-		    Cases t2 of
-	              (var _) => False
-                    | (oper op2 l2) => (op1=%S op2)
-                      /\ (EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2)
-		    end
-end
-with EqListT [n1:posint;l1:(LTERM n1)]: (n2:posint)(LTERM n2)->Prop :=
-[n2:posint][l2:(LTERM n2)]
-Cases l1 of
-  nil => 
-          Cases l2 of
-              nil => True
-	  | _  => False
-	  end
-| (cons t1 n1' l1') =>  Cases l2 of
-		           nil =>False
-		        | (cons t2 n2' l2') => (equalT t1 t2) 
-                                                /\ (EqListT n1' l1' n2' l2')
-		end
-end.
+Fixpoint equalT (t1 : TERM) : TERM -> Prop :=
+  match t1 with
+  | var v1 =>
+      fun t2 : TERM =>
+      match t2 with
+      | var v2 => equal _ v1 v2
+      | oper op2 _ => False
+      end
+  | oper op1 l1 =>
+      fun t2 : TERM =>
+      match t2 with
+      | var _ => False
+      | oper op2 l2 =>
+          equal _ op1 op2 /\
+          EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2
+      end
+  end
+ 
+ with EqListT (n1 : posint) (l1 : LTERM n1) (n2 : posint) 
+ (l2 : LTERM n2) {struct l1} : Prop :=
+  match l1 with
+  | nil => match l2 with
+           | nil => True
+           | _ => False
+           end
+  | cons t1 n1' l1' =>
+      match l2 with
+      | nil => False
+      | cons t2 n2' l2' => equalT t1 t2 /\ EqListT n1' l1' n2' l2'
+      end
+  end.
 
 (* ---------------------------------------------------------------- *)
 (*                  Version with multiple patterns                  *)
 (* ---------------------------------------------------------------- *)
 Reset equalT.
 
-Fixpoint equalT [t1:TERM]:TERM->Prop :=
-[t2:TERM] 
- Cases t1 t2 of 
-   (var  v1)       (var v2)     => (v1 =%S v2)
-
- | (oper op1 l1)  (oper op2 l2) => 
-     (op1=%S op2) /\ (EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2)
-
- |  _               _ => False 
- end
-
-with EqListT [n1:posint;l1:(LTERM n1)]: (n2:posint)(LTERM n2)->Prop :=
-[n2:posint][l2:(LTERM n2)]
- Cases l1 l2 of
-    nil                nil              => True 
- | (cons t1 n1' l1')  (cons t2 n2' l2') => (equalT t1 t2) 
-                                          /\ (EqListT n1' l1' n2'  l2')
- | _ _ => False
-end.
+Fixpoint equalT (t1 t2 : TERM) {struct t1} : Prop :=
+  match t1, t2 with
+  | var v1, var v2 => equal _ v1 v2
+  | oper op1 l1, oper op2 l2 =>
+      equal _ op1 op2 /\ EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2
+  | _, _ => False
+  end
+ 
+ with EqListT (n1 : posint) (l1 : LTERM n1) (n2 : posint) 
+ (l2 : LTERM n2) {struct l1} : Prop :=
+  match l1, l2 with
+  | nil, nil => True
+  | cons t1 n1' l1', cons t2 n2' l2' =>
+      equalT t1 t2 /\ EqListT n1' l1' n2' l2'
+  | _, _ => False
+  end.
 
 
 (* ------------------------------------------------------------------ *)
@@ -394,12 +422,11 @@ End Sig.
 
 (* Exemple soumis par Bruno *)
 
-Definition bProp [b:bool] : Prop :=
-  if b then True else False.
+Definition bProp (b : bool) : Prop := if b then True else False.
 
-Definition f0 [F:False;ty:bool]: (bProp ty) :=
-  <[_:bool][ty:bool](bProp ty)>Cases ty ty of
-    true true => I
-  | _ false => F
-  | _ true => I
+Definition f0 (F : False) (ty : bool) : bProp ty :=
+  match ty as _, ty return (bProp ty) with
+  | true, true => I
+  | _, false => F
+  | _, true => I
   end.
diff --git a/test-suite/success/Check.v b/test-suite/success/Check.v
index 5d183528..a20490cc 100644
--- a/test-suite/success/Check.v
+++ b/test-suite/success/Check.v
@@ -9,6 +9,6 @@
 (* This file tests that pretty-printing does not fail                        *)
 (* Test of exact output is not specified                                     *)
 
-Check O.
+Check 0.
 Check S.
 Check nat.
diff --git a/test-suite/success/Conjecture.v b/test-suite/success/Conjecture.v
index 6db5859b..ea4b5ff7 100644
--- a/test-suite/success/Conjecture.v
+++ b/test-suite/success/Conjecture.v
@@ -1,13 +1,13 @@
 (* Check keywords Conjecture and Admitted are recognized *)
 
-Conjecture c : (n:nat)n=O.
+Conjecture c : forall n : nat, n = 0.
 
 Check c.
 
-Theorem d : (n:nat)n=O.
+Theorem d : forall n : nat, n = 0.
 Proof.
-  NewInduction n.
-  Reflexivity.
-  Assert H:False.
-  2:NewDestruct H.
+  induction n.
+  reflexivity.
+  assert (H : False).
+  2: destruct H.
 Admitted.
diff --git a/test-suite/success/DHyp.v b/test-suite/success/DHyp.v
index 73907bc4..8b137891 100644
--- a/test-suite/success/DHyp.v
+++ b/test-suite/success/DHyp.v
@@ -1,14 +1 @@
-V7only [
-HintDestruct Hypothesis h1 (le ? O) 3 [Fun I -> Inversion I ].
 
-Lemma lem1 : ~(le (S O) O).
-Intro H.
-DHyp H.
-Qed.
-
-HintDestruct Conclusion h2 (le O ?) 3 [Constructor].
-
-Lemma lem2 : (le O O).
-DConcl.
-Qed.
-].
diff --git a/test-suite/success/Decompose.v b/test-suite/success/Decompose.v
index 21a3ab5d..1316cbf9 100644
--- a/test-suite/success/Decompose.v
+++ b/test-suite/success/Decompose.v
@@ -1,7 +1,9 @@
 (* This was a Decompose bug reported by Randy Pollack (29 Mar 2000) *)
 
-Goal (O=O/\((x:nat)(x=x)->(x=x)/\((y:nat)y=y->y=y)))-> True.
-Intro H.
-Decompose [and] H. (* Was failing *)
+Goal
+0 = 0 /\ (forall x : nat, x = x -> x = x /\ (forall y : nat, y = y -> y = y)) ->
+True.
+intro H.
+decompose [and] H. (* Was failing *)
 
 Abort.
diff --git a/test-suite/success/Destruct.v b/test-suite/success/Destruct.v
index fdd929bb..b909e45e 100644
--- a/test-suite/success/Destruct.v
+++ b/test-suite/success/Destruct.v
@@ -1,13 +1,13 @@
 (* Submitted by Robert Schneck *)
 
-Parameter A,B,C,D : Prop.
-Axiom X : A->B->C/\D.
+Parameter A B C D : Prop.
+Axiom X : A -> B -> C /\ D.
 
-Lemma foo : A->B->C.
+Lemma foo : A -> B -> C.
 Proof.
-Intros. 
-NewDestruct X. (* Should find axiom X and should handle arguments of X *)
-Assumption.
-Assumption.
-Assumption.
+intros. 
+destruct X. (* Should find axiom X and should handle arguments of X *)
+assumption.
+assumption.
+assumption.
 Qed.
diff --git a/test-suite/success/DiscrR.v b/test-suite/success/DiscrR.v
index 5d12098f..54528fb5 100644
--- a/test-suite/success/DiscrR.v
+++ b/test-suite/success/DiscrR.v
@@ -1,41 +1,41 @@
-Require Reals.
-Require DiscrR.
+Require Import Reals.
+Require Import DiscrR.
 
-Lemma ex0: ``1<>0``.
+Lemma ex0 : 1%R <> 0%R.
 Proof.
-  DiscrR.
-Save.
+  discrR.
+Qed.
 
-Lemma ex1: ``0<>2``.
+Lemma ex1 : 0%R <> 2%R.
 Proof.
-  DiscrR.
-Save.
-Lemma ex2: ``4<>3``.
+  discrR.
+Qed.
+Lemma ex2 : 4%R <> 3%R.
 Proof.
-  DiscrR.
-Save.
+  discrR.
+Qed.
 
-Lemma ex3: ``3<>5``.
+Lemma ex3 : 3%R <> 5%R.
 Proof.
-  DiscrR.
-Save.
+  discrR.
+Qed.
 
-Lemma ex4: ``-1<>0``.
+Lemma ex4 : (-1)%R <> 0%R.
 Proof.
-  DiscrR.
-Save.
+  discrR.
+Qed.
 
-Lemma ex5: ``-2<>-3``.
+Lemma ex5 : (-2)%R <> (-3)%R.
 Proof.
-  DiscrR.
-Save.
+  discrR.
+Qed.
 
-Lemma ex6: ``8<>-3``.
+Lemma ex6 : 8%R <> (-3)%R.
 Proof.
-  DiscrR.
-Save.
+  discrR.
+Qed.
 
-Lemma ex7: ``-8<>3``.
+Lemma ex7 : (-8)%R <> 3%R.
 Proof.
-  DiscrR.
-Save.
+  discrR.
+Qed.
diff --git a/test-suite/success/Discriminate.v b/test-suite/success/Discriminate.v
index 39d2f4bb..f28c83de 100644
--- a/test-suite/success/Discriminate.v
+++ b/test-suite/success/Discriminate.v
@@ -2,10 +2,10 @@
 
 (* Check that Discriminate tries Intro until *)
 
-Lemma l1 : O=(S O)->False.   
-Discriminate 1.
+Lemma l1 : 0 = 1 -> False.   
+ discriminate 1.
 Qed.
 
-Lemma l2 : (H:O=(S O))H==H.   
-Discriminate H.
+Lemma l2 : forall H : 0 = 1, H = H.   
+ discriminate H.
 Qed.
diff --git a/test-suite/success/Field.v b/test-suite/success/Field.v
index c203b739..9f4ec79a 100644
--- a/test-suite/success/Field.v
+++ b/test-suite/success/Field.v
@@ -6,66 +6,73 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field.v,v 1.1.16.1 2004/07/16 19:30:58 herbelin Exp $ *)
+(* $Id: Field.v 7693 2005-12-21 23:50:17Z herbelin $ *)
 
 (**** Tests of Field with real numbers ****)
 
-Require Reals.
+Require Import Reals.
 
 (* Example 1 *)
-Goal (eps:R)``eps*1/(2+2)+eps*1/(2+2) == eps*1/2``.
+Goal
+forall eps : R,
+(eps * (1 / (2 + 2)) + eps * (1 / (2 + 2)))%R = (eps * (1 / 2))%R.
 Proof.
-  Intros.
-  Field.
+  intros.
+   field.
 Abort.
 
 (* Example 2 *)
-Goal  (f,g:(R->R); x0,x1: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)``.
+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.
-  Field.
+  intros.
+   field.
 Abort.
  
 (* Example 3 *)
-Goal (a,b:R)``1/(a*b)*1/1/b == 1/a``.
+Goal forall a b : R, (1 / (a * b) * (1 / 1 / b))%R = (1 / a)%R.
 Proof.
-  Intros.
-  Field.
+  intros.
+   field.
 Abort.
  
 (* Example 4 *)
-Goal (a,b:R)``a <> 0``->``b <> 0``->``1/(a*b)/1/b == 1/a``.
+Goal
+forall a b : R, a <> 0%R -> b <> 0%R -> (1 / (a * b) / 1 / b)%R = (1 / a)%R.
 Proof.
-  Intros.
-  Field.
+  intros.
+   field.
 Abort.
  
 (* Example 5 *)
-Goal (a:R)``1 == 1*1/a*a``.
+Goal forall a : R, 1%R = (1 * (1 / a) * a)%R.
 Proof.
-  Intros.
-  Field.
+  intros.
+   field.
 Abort.
  
 (* Example 6 *)
-Goal (a,b:R)``b == b*/a*a``.
+Goal forall a b : R, b = (b * / a * a)%R.
 Proof.
-  Intros.
-  Field.
+  intros.
+   field.
 Abort.
  
 (* Example 7 *)
-Goal (a,b:R)``b == b*1/a*a``.
+Goal forall a b : R, b = (b * (1 / a) * a)%R.
 Proof.
-  Intros.
-  Field.
+  intros.
+   field.
 Abort.
 
 (* Example 8 *)
-Goal (x,y:R)``x*((1/x)+x/(x+y)) == -(1/y)*y*(-(x*x/(x+y))-1)``.
+Goal
+forall x y : R,
+(x * (1 / x + x / (x + y)))%R =
+(- (1 / y) * y * (- (x * (x / (x + y))) - 1))%R.
 Proof.
-  Intros.
-  Field.
+  intros.
+   field.
 Abort.
diff --git a/test-suite/success/Fixpoint.v b/test-suite/success/Fixpoint.v
new file mode 100644
index 00000000..680046da
--- /dev/null
+++ b/test-suite/success/Fixpoint.v
@@ -0,0 +1,31 @@
+(* Playing with (co-)fixpoints with local definitions *)
+
+Inductive listn : nat -> Set :=
+  niln : listn 0
+| consn : forall n:nat, nat -> listn n -> listn (S n).
+
+Fixpoint f (n:nat) (m:=pred n) (l:listn m) (p:=S n) {struct l} : nat :=
+   match n with O => p | _ => 
+     match l with niln => p | consn q _ l => f (S q) l end
+   end.
+
+Eval compute in (f 2 (consn 0 0 niln)).
+
+CoInductive Stream : nat -> Set :=
+  Consn : forall n, nat -> Stream n -> Stream (S n).
+
+CoFixpoint g (n:nat) (m:=pred n) (l:Stream m) (p:=S n) : Stream p :=
+    match n return (let m:=pred n in forall l:Stream m, let p:=S n in Stream p)
+    with
+    | O => fun l:Stream 0 => Consn O 0 l
+    | S n' =>
+      fun l:Stream n' =>
+      let l' :=
+        match l in Stream q return Stream (pred q) with Consn _ _ l => l end
+      in
+      let a := match l with Consn _ a l => a end in
+      Consn (S n') (S a) (g n' l')
+   end l.
+
+Eval compute in (fun l => match g 2 (Consn 0 6 l) with Consn _ a _ => a end).
+
diff --git a/test-suite/success/Fourier.v b/test-suite/success/Fourier.v
index f1f7ae08..2d184fef 100644
--- a/test-suite/success/Fourier.v
+++ b/test-suite/success/Fourier.v
@@ -1,16 +1,12 @@
-Require Rfunctions.
-Require Fourier.
+Require Import Rfunctions.
+Require Import Fourier.
  
-Lemma l1:
- (x, y, z : R)
-  ``(Rabsolu x-z) <= (Rabsolu x-y)+(Rabsolu y-z)``.
-Intros; SplitAbsolu; Fourier.
+Lemma l1 : forall x y z : R, Rabs (x - z) <= Rabs (x - y) + Rabs (y - z).
+intros; split_Rabs; fourier.
 Qed.
  
-Lemma l2:
- (x, y : R)
- ``x < (Rabsolu y)`` ->
- ``y < 1`` -> ``x >= 0`` -> ``-y <= 1`` ->  ``(Rabsolu x) <= 1``.
-Intros.
-SplitAbsolu; Fourier.
+Lemma l2 :
+ forall x y : R, x < Rabs y -> y < 1 -> x >= 0 -> - y <= 1 -> Rabs x <= 1.
+intros.
+split_Rabs; fourier.
 Qed.
diff --git a/test-suite/success/Funind.v b/test-suite/success/Funind.v
index 819da259..84a58a3a 100644
--- a/test-suite/success/Funind.v
+++ b/test-suite/success/Funind.v
@@ -1,80 +1,80 @@
 
-Definition iszero [n:nat] : bool := Cases n of
-                                    | O => true
-                                    | _ => false
-                                    end.
-
-Functional Scheme iszer_ind := Induction for iszero.
- 
-Lemma toto : (n:nat) n = 0 -> (iszero n) = true.
-Intros x eg.
-Functional Induction iszero x; Simpl.
-Trivial.
-Subst x.
-Inversion H_eq_.
+Definition iszero (n : nat) : bool :=
+  match n with
+  | O => true
+  | _ => false
+  end.
+
+ Functional Scheme iszer_ind := Induction for iszero.
+ 
+Lemma toto : forall n : nat, n = 0 -> iszero n = true.
+intros x eg.
+ functional induction iszero x; simpl in |- *.
+trivial.
+ subst x.
+inversion H_eq_.
 Qed.
 
 (* We can even reuse the proof as a scheme: *)
 
-Functional Scheme toto_ind := Induction for iszero.
+ Functional Scheme toto_ind := Induction for iszero.
 
 
 
 
  
-Definition ftest [n, m:nat] : nat :=
-  Cases n of
-  | O => Cases m of
+Definition ftest (n m : nat) : nat :=
+  match n with
+  | O => match m with
          | O => 0
          | _ => 1
          end
-  | (S p) => 0
+  | S p => 0
   end.
 
-Functional Scheme ftest_ind := Induction for ftest. 
+ Functional Scheme ftest_ind := Induction for ftest. 
 
-Lemma test1 : (n,m:nat) (le (ftest n m) 2).
-Intros n m.
-Functional Induction ftest n m;Auto.
-Save.
+Lemma test1 : forall n m : nat, ftest n m <= 2.
+intros n m.
+ functional induction ftest n m; auto.
+Qed.
 
 
-Lemma test11 : (m:nat) (le (ftest 0 m) 2).
-Intros m.
-Functional Induction ftest 0 m.
-Auto. 
-Auto. 
+Lemma test11 : forall m : nat, ftest 0 m <= 2.
+intros m.
+ functional induction ftest 0 m.
+auto. 
+auto. 
 Qed.
 
 
-Definition lamfix :=
-[m:nat ]
-(Fix trivfun {trivfun [n:nat] : nat := Cases n of
-                              | O => m
-                              | (S p) => (trivfun p)
-                              end}).
+Definition lamfix (m : nat) :=
+  fix trivfun (n : nat) : nat := match n with
+                                 | O => m
+                                 | S p => trivfun p
+                                 end.
 
 (* Parameter v1 v2 : nat. *)
 
-Lemma lamfix_lem : (v1,v2:nat) (lamfix v1 v2) = v1.
-Intros v1 v2.
-Functional Induction lamfix v1 v2.
-Trivial.
-Assumption.
+Lemma lamfix_lem : forall v1 v2 : nat, lamfix v1 v2 = v1.
+intros v1 v2.
+ functional induction lamfix v1 v2.
+trivial.
+assumption.
 Defined.
 
 
 
 (* polymorphic function *)
-Require PolyList.
+Require Import List.
 
-Functional Scheme app_ind := Induction for app.
+ Functional Scheme app_ind := Induction for app.
 
-Lemma appnil : (A:Set)(l,l':(list A)) l'=(nil A) ->  l = (app l l').
-Intros A l l'.
-Functional Induction app A l l';Intuition.
-Rewrite <- H1;Trivial.
-Save.
+Lemma appnil : forall (A : Set) (l l' : list A), l' = nil -> l = l ++ l'.
+intros A l l'.
+ functional induction app A l l';  intuition.
+ rewrite <- H1; trivial.
+Qed.
 
 
 
@@ -83,10 +83,10 @@ Save.
 Require Export Arith.
 
 
-Fixpoint trivfun [n:nat] : nat :=
-  Cases n of
+Fixpoint trivfun (n : nat) : nat :=
+  match n with
   | O => 0
-  | (S m) => (trivfun m)
+  | S m => trivfun m
   end.
 
 
@@ -94,22 +94,22 @@ Fixpoint trivfun [n:nat] : nat :=
 
 Parameter varessai : nat.
 
-Lemma first_try : (trivfun varessai) = 0.
-Functional Induction trivfun varessai.
-Trivial.
-Simpl.
-Assumption.
+Lemma first_try : trivfun varessai = 0.
+ functional induction trivfun varessai.
+trivial.
+simpl in |- *.
+assumption.
 Defined.
  
 
-Functional Scheme triv_ind := Induction for trivfun.
+ Functional Scheme triv_ind := Induction for trivfun.
 
-Lemma bisrepetita : (n':nat) (trivfun n') = 0.
-Intros n'.
-Functional Induction trivfun n'.
-Trivial.
-Simpl .
-Assumption.
+Lemma bisrepetita : forall n' : nat, trivfun n' = 0.
+intros n'.
+ functional induction trivfun n'.
+trivial.
+simpl in |- *.
+assumption.
 Qed.
 
 
@@ -118,312 +118,335 @@ Qed.
 
 
 
-Fixpoint iseven [n:nat] : bool :=
-  Cases n of
+Fixpoint iseven (n : nat) : bool :=
+  match n with
   | O => true
-  | (S (S m)) => (iseven m)
+  | S (S m) => iseven m
   | _ => false
   end.
  
-Fixpoint funex [n:nat] : nat :=
-  Cases (iseven n) of
+Fixpoint funex (n : nat) : nat :=
+  match iseven n with
   | true => n
-  | false => Cases n of
+  | false => match n with
              | O => 0
-             | (S r) => (funex r)
+             | S r => funex r
              end
   end.
  
-Fixpoint nat_equal_bool [n:nat]  : nat -> bool :=
-[m:nat]
-  Cases n of
-  | O => Cases m of
+Fixpoint nat_equal_bool (n m : nat) {struct n} : bool :=
+  match n with
+  | O => match m with
          | O => true
          | _ => false
          end
-  | (S p) => Cases m of
+  | S p => match m with
            | O => false
-           | (S q) => (nat_equal_bool p q)
+           | S q => nat_equal_bool p q
            end
   end.
 
 
 Require Export Div2.
  
-Lemma div2_inf : (n:nat) (le (div2 n) n).
-Intros n.
-Functional Induction div2 n.
-Auto.
-Auto.
+Lemma div2_inf : forall n : nat, div2 n <= n.
+intros n.
+ functional induction div2 n.
+auto.
+auto.
 
-Apply le_S.
-Apply le_n_S.
-Exact H.
+apply le_S.
+apply le_n_S.
+exact H.
 Qed.
 
 (* reuse this lemma as a scheme:*)
 
-Functional Scheme div2_ind := Induction for div2_inf.
+ Functional Scheme div2_ind := Induction for div2_inf.
 
-Fixpoint nested_lam [n:nat] : nat -> nat :=
-  Cases n of
-  | O => [m:nat ] 0
-  | (S n') => [m:nat ] (plus m (nested_lam n' m))
+Fixpoint nested_lam (n : nat) : nat -> nat :=
+  match n with
+  | O => fun m : nat => 0
+  | S n' => fun m : nat => m + nested_lam n' m
   end.
 
-Functional Scheme nested_lam_ind := Induction for nested_lam.
+ Functional Scheme nested_lam_ind := Induction for nested_lam.
 
-Lemma nest : (n, m:nat) (nested_lam n m) = (mult n m).
-Intros n m.
-Functional Induction nested_lam n m; Auto.
+Lemma nest : forall n m : nat, nested_lam n m = n * m.
+intros n m.
+ functional induction nested_lam n m; auto.
 Qed.
 
-Lemma nest2 : (n, m:nat) (nested_lam n m) = (mult n m).
-Intros n m. Pattern n m . 
-Apply nested_lam_ind; Simpl ; Intros; Auto.
+Lemma nest2 : forall n m : nat, nested_lam n m = n * m.
+intros n m. pattern n, m in |- *. 
+apply nested_lam_ind; simpl in |- *; intros; auto.
 Qed.
 
  
-Fixpoint essai [x : nat] : nat * nat ->  nat :=
- [p : nat * nat]  ( Case p of [n, m : ?]  Cases n of
-                                            O => O
-                                           | (S q) =>
-                                               Cases x of
-                                                 O => (S O)
-                                                | (S r) => (S (essai r (q, m)))
-                                               end
-                                          end end ).
- 
-Lemma essai_essai:
- (x : nat)
- (p : nat * nat)  ( Case p of [n, m : ?] (lt O n) ->  (lt O (essai x p)) end ).
-Intros x p.
-(Functional Induction essai x p); Intros.
-Inversion H.
-Simpl; Try Abstract ( Auto with arith ).
-Simpl; Try Abstract ( Auto with arith ).
+Fixpoint essai (x : nat) (p : nat * nat) {struct x} : nat :=
+  let (n, m) := p in
+  match n with
+  | O => 0
+  | S q => match x with
+           | O => 1
+           | S r => S (essai r (q, m))
+           end
+  end.
+ 
+Lemma essai_essai :
+ forall (x : nat) (p : nat * nat), let (n, m) := p in 0 < n -> 0 < essai x p.
+intros x p.
+ functional induction essai x p; intros.
+inversion H.
+simpl in |- *; try abstract auto with arith.
+simpl in |- *; try abstract auto with arith.
 Qed.
 
  
-Fixpoint plus_x_not_five'' [n : nat] : nat ->  nat :=
- [m : nat]  let x = (nat_equal_bool m (S (S (S (S (S O)))))) in
-              let y = O in
-                Cases n of
-                  O => y
-                 | (S q) =>
-                     let recapp = (plus_x_not_five'' q m) in
-                       Cases x of true => (S recapp) | false => (S recapp) end
-                end.
- 
-Lemma notplusfive'':
- (x, y : nat) y = (S (S (S (S (S O))))) ->  (plus_x_not_five'' x y) = x.
-Intros a b.
-Unfold plus_x_not_five''.
-(Functional Induction plus_x_not_five'' a b); Intros hyp; Simpl; Auto.
+Fixpoint plus_x_not_five'' (n m : nat) {struct n} : nat :=
+  let x := nat_equal_bool m 5 in
+  let y := 0 in
+  match n with
+  | O => y
+  | S q =>
+      let recapp := plus_x_not_five'' q m in
+      match x with
+      | true => S recapp
+      | false => S recapp
+      end
+  end.
+ 
+Lemma notplusfive'' : forall x y : nat, y = 5 -> plus_x_not_five'' x y = x.
+intros a b.
+unfold plus_x_not_five'' in |- *.
+ functional induction plus_x_not_five'' a b; intros hyp; simpl in |- *; auto.
 Qed.
  
-Lemma iseq_eq: (n, m : nat) n = m ->  (nat_equal_bool n m) = true.
-Intros n m.
-Unfold nat_equal_bool.
-(Functional Induction nat_equal_bool n m); Simpl; Intros hyp; Auto.
-Inversion hyp.
-Inversion hyp.
+Lemma iseq_eq : forall n m : nat, n = m -> nat_equal_bool n m = true.
+intros n m.
+unfold nat_equal_bool in |- *.
+ functional induction nat_equal_bool n m; simpl in |- *; intros hyp; auto.
+inversion hyp.
+inversion hyp.
 Qed.
  
-Lemma iseq_eq': (n, m : nat) (nat_equal_bool n m) = true ->  n = m.
-Intros n m.
-Unfold nat_equal_bool.
-(Functional Induction nat_equal_bool n m); Simpl; Intros eg; Auto.
-Inversion eg.
-Inversion eg.
+Lemma iseq_eq' : forall n m : nat, nat_equal_bool n m = true -> n = m.
+intros n m.
+unfold nat_equal_bool in |- *.
+ functional induction nat_equal_bool n m; simpl in |- *; intros eg; auto.
+inversion eg.
+inversion eg.
 Qed.
  
  
-Inductive istrue : bool ->  Prop :=
-  istrue0: (istrue true) .
+Inductive istrue : bool -> Prop :=
+    istrue0 : istrue true.
  
-Lemma inf_x_plusxy': (x, y : nat)  (le x (plus x y)).
-Intros n m.
-(Functional Induction plus n m); Intros.
-Auto with arith.
-Auto with arith.
+Lemma inf_x_plusxy' : forall x y : nat, x <= x + y.
+intros n m.
+ functional induction plus n m; intros.
+auto with arith.
+auto with arith.
 Qed.
 
  
-Lemma inf_x_plusxy'': (x : nat)  (le x (plus x O)).
-Intros n.
-Unfold plus.
-(Functional Induction plus n O); Intros.
-Auto with arith.
-Apply le_n_S.
-Assumption.
+Lemma inf_x_plusxy'' : forall x : nat, x <= x + 0.
+intros n.
+unfold plus in |- *.
+ functional induction plus n 0; intros.
+auto with arith.
+apply le_n_S.
+assumption.
 Qed.
  
-Lemma inf_x_plusxy''': (x : nat)  (le x (plus O x)).
-Intros n.
-(Functional Induction plus O n); Intros;Auto with arith.
+Lemma inf_x_plusxy''' : forall x : nat, x <= 0 + x.
+intros n.
+ functional induction plus 0 n; intros; auto with arith.
 Qed.
 
-Fixpoint mod2 [n : nat] : nat :=
- Cases n of   O => O
-             | (S (S m)) => (S (mod2 m))
-             | _ => O end.
+Fixpoint mod2 (n : nat) : nat :=
+  match n with
+  | O => 0
+  | S (S m) => S (mod2 m)
+  | _ => 0
+  end.
  
-Lemma princ_mod2: (n : nat)  (le (mod2 n) n).
-Intros n.
-(Functional Induction mod2 n); Simpl; Auto with arith.
+Lemma princ_mod2 : forall n : nat, mod2 n <= n.
+intros n.
+ functional induction mod2 n; simpl in |- *; auto with arith.
 Qed.
  
-Definition isfour : nat ->  bool :=
-   [n : nat]  Cases n of (S (S (S (S O)))) => true | _ => false end.
+Definition isfour (n : nat) : bool :=
+  match n with
+  | S (S (S (S O))) => true
+  | _ => false
+  end.
  
-Definition isononeorfour : nat ->  bool :=
-   [n : nat]  Cases n of   (S O) => true
-                          | (S (S (S (S O)))) => true
-                          | _ => false end.
+Definition isononeorfour (n : nat) : bool :=
+  match n with
+  | S O => true
+  | S (S (S (S O))) => true
+  | _ => false
+  end.
  
-Lemma toto'': (n : nat) (istrue (isfour n)) ->  (istrue (isononeorfour n)).
-Intros n.
-(Functional Induction isononeorfour n); Intros istr; Simpl; Inversion istr.
-Apply istrue0.
+Lemma toto'' : forall n : nat, istrue (isfour n) -> istrue (isononeorfour n).
+intros n.
+ functional induction isononeorfour n; intros istr; simpl in |- *;
+ inversion istr.
+apply istrue0.
 Qed.
  
-Lemma toto': (n, m : nat) n = (S (S (S (S O)))) ->  (istrue (isononeorfour n)).
-Intros n.
-(Functional Induction isononeorfour n); Intros m istr; Inversion istr.
-Apply istrue0.
+Lemma toto' : forall n m : nat, n = 4 -> istrue (isononeorfour n).
+intros n.
+ functional induction isononeorfour n; intros m istr; inversion istr.
+apply istrue0.
 Qed.
  
-Definition ftest4 : nat -> nat ->  nat :=
-   [n, m : nat]  Cases n of
-                   O =>
-                     Cases m of O => O | (S q) => (S O) end
-                  | (S p) =>
-                      Cases m of O => O | (S r) => (S O) end
-                 end.
- 
-Lemma test4: (n, m : nat)  (le (ftest n m) (S (S O))).
-Intros n m.
-(Functional Induction ftest n m); Auto with arith.
+Definition ftest4 (n m : nat) : nat :=
+  match n with
+  | O => match m with
+         | O => 0
+         | S q => 1
+         end
+  | S p => match m with
+           | O => 0
+           | S r => 1
+           end
+  end.
+ 
+Lemma test4 : forall n m : nat, ftest n m <= 2.
+intros n m.
+ functional induction ftest n m; auto with arith.
 Qed.
  
-Lemma test4': (n, m : nat)  (le (ftest4 (S n) m) (S (S O))).
-Intros n m.
-(Functional Induction ftest4 (S n) m).
-Auto with arith.
-Auto with arith.
+Lemma test4' : forall n m : nat, ftest4 (S n) m <= 2.
+intros n m.
+ functional induction ftest4 (S n) m.
+auto with arith.
+auto with arith.
 Qed.
  
-Definition ftest44 : nat * nat -> nat -> nat ->  nat :=
-   [x : nat * nat]
-   [n, m : nat]
-    ( Case x of [p, q : ?]  Cases n of
-                              O =>
-                                Cases m of O => O | (S q) => (S O) end
-                             | (S p) =>
-                                 Cases m of O => O | (S r) => (S O) end
-                            end end ).
- 
-Lemma test44:
- (pq : nat * nat) (n, m, o, r, s : nat)  (le (ftest44 pq n (S m)) (S (S O))).
-Intros pq n m o r s.
-(Functional Induction ftest44 pq n (S m)).
-Auto with arith.
-Auto with arith.
-Auto with arith.
-Auto with arith.
+Definition ftest44 (x : nat * nat) (n m : nat) : nat :=
+  let (p, q) := x in
+  match n with
+  | O => match m with
+         | O => 0
+         | S q => 1
+         end
+  | S p => match m with
+           | O => 0
+           | S r => 1
+           end
+  end.
+ 
+Lemma test44 :
+ forall (pq : nat * nat) (n m o r s : nat), ftest44 pq n (S m) <= 2.
+intros pq n m o r s.
+ functional induction ftest44 pq n (S m).
+auto with arith.
+auto with arith.
+auto with arith.
+auto with arith.
 Qed.
  
-Fixpoint ftest2 [n : nat] : nat ->  nat :=
- [m : nat]  Cases n of
-              O =>
-                Cases m of O => O | (S q) => O end
-             | (S p) => (ftest2 p m)
-            end.
+Fixpoint ftest2 (n m : nat) {struct n} : nat :=
+  match n with
+  | O => match m with
+         | O => 0
+         | S q => 0
+         end
+  | S p => ftest2 p m
+  end.
  
-Lemma test2: (n, m : nat)  (le (ftest2 n m) (S (S O))).
-Intros n m.
-(Functional Induction ftest2 n m) ; Simpl; Intros; Auto.
+Lemma test2 : forall n m : nat, ftest2 n m <= 2.
+intros n m.
+ functional induction ftest2 n m; simpl in |- *; intros; auto.
 Qed.
  
-Fixpoint ftest3 [n : nat] : nat ->  nat :=
- [m : nat]  Cases n of
-              O => O
-             | (S p) =>
-                 Cases m of O => (ftest3 p O) | (S r) => O end
-            end.
- 
-Lemma test3: (n, m : nat)  (le (ftest3 n m) (S (S O))).
-Intros n m.
-(Functional Induction ftest3 n m).
-Intros.
-Auto.
-Intros.
-Auto.
-Intros.
-Simpl.
-Auto.
+Fixpoint ftest3 (n m : nat) {struct n} : nat :=
+  match n with
+  | O => 0
+  | S p => match m with
+           | O => ftest3 p 0
+           | S r => 0
+           end
+  end.
+ 
+Lemma test3 : forall n m : nat, ftest3 n m <= 2.
+intros n m.
+ functional induction ftest3 n m.
+intros.
+auto.
+intros.
+auto.
+intros.
+simpl in |- *.
+auto.
 Qed.
  
-Fixpoint ftest5 [n : nat] : nat ->  nat :=
- [m : nat]  Cases n of
-              O => O
-             | (S p) =>
-                 Cases m of O => (ftest5 p O) | (S r) => (ftest5 p r) end
-            end.
- 
-Lemma test5: (n, m : nat)  (le (ftest5 n m) (S (S O))).
-Intros n m.
-(Functional Induction ftest5 n m).
-Intros.
-Auto.
-Intros.
-Auto.
-Intros.
-Simpl.
-Auto.
+Fixpoint ftest5 (n m : nat) {struct n} : nat :=
+  match n with
+  | O => 0
+  | S p => match m with
+           | O => ftest5 p 0
+           | S r => ftest5 p r
+           end
+  end.
+ 
+Lemma test5 : forall n m : nat, ftest5 n m <= 2.
+intros n m.
+ functional induction ftest5 n m.
+intros.
+auto.
+intros.
+auto.
+intros.
+simpl in |- *.
+auto.
 Qed.
  
-Definition ftest7 : (n : nat)  nat :=
-   [n : nat]  Cases (ftest5 n O) of O => O | (S r) => O end.
+Definition ftest7 (n : nat) : nat :=
+  match ftest5 n 0 with
+  | O => 0
+  | S r => 0
+  end.
  
-Lemma essai7:
- (Hrec : (n : nat) (ftest5 n O) = O ->  (le (ftest7 n) (S (S O))))
- (Hrec0 : (n, r : nat) (ftest5 n O) = (S r) ->  (le (ftest7 n) (S (S O))))
- (n : nat)  (le (ftest7 n) (S (S O))).
-Intros hyp1 hyp2 n.
-Unfold ftest7.
-(Functional Induction ftest7 n); Auto.
+Lemma essai7 :
+ forall (Hrec : forall n : nat, ftest5 n 0 = 0 -> ftest7 n <= 2)
+   (Hrec0 : forall n r : nat, ftest5 n 0 = S r -> ftest7 n <= 2) 
+   (n : nat), ftest7 n <= 2.
+intros hyp1 hyp2 n.
+unfold ftest7 in |- *.
+ functional induction ftest7 n; auto.
 Qed.
  
-Fixpoint ftest6 [n : nat] : nat ->  nat :=
- [m : nat]
-  Cases n of
-    O => O
-   | (S p) =>
-       Cases (ftest5 p O) of O => (ftest6 p O) | (S r) => (ftest6 p r) end
+Fixpoint ftest6 (n m : nat) {struct n} : nat :=
+  match n with
+  | O => 0
+  | S p => match ftest5 p 0 with
+           | O => ftest6 p 0
+           | S r => ftest6 p r
+           end
   end.
 
  
-Lemma princ6:
- ((n, m : nat) n = O ->  (le (ftest6 O m) (S (S O)))) ->
- ((n, m, p : nat)
-  (le (ftest6 p O) (S (S O))) ->
-  (ftest5 p O) = O -> n = (S p) ->  (le (ftest6 (S p) m) (S (S O)))) ->
- ((n, m, p, r : nat)
-  (le (ftest6 p r) (S (S O))) ->
-  (ftest5 p O) = (S r) -> n = (S p) ->  (le (ftest6 (S p) m) (S (S O)))) ->
- (x, y : nat)  (le (ftest6 x y) (S (S O))).
-Intros hyp1 hyp2 hyp3 n m.
-Generalize hyp1 hyp2 hyp3.
-Clear hyp1 hyp2 hyp3.
-(Functional Induction ftest6 n m);Auto.
+Lemma princ6 :
+ (forall n m : nat, n = 0 -> ftest6 0 m <= 2) ->
+ (forall n m p : nat,
+  ftest6 p 0 <= 2 -> ftest5 p 0 = 0 -> n = S p -> ftest6 (S p) m <= 2) ->
+ (forall n m p r : nat,
+  ftest6 p r <= 2 -> ftest5 p 0 = S r -> n = S p -> ftest6 (S p) m <= 2) ->
+ forall x y : nat, ftest6 x y <= 2.
+intros hyp1 hyp2 hyp3 n m.
+generalize hyp1 hyp2 hyp3.
+clear hyp1 hyp2 hyp3.
+ functional induction ftest6 n m; auto.
 Qed.
  
-Lemma essai6: (n, m : nat)  (le (ftest6 n m) (S (S O))).
-Intros n m.
-Unfold ftest6.
-(Functional Induction ftest6 n m); Simpl; Auto.
+Lemma essai6 : forall n m : nat, ftest6 n m <= 2.
+intros n m.
+unfold ftest6 in |- *.
+ functional induction ftest6 n m; simpl in |- *; auto.
 Qed.
 
 
diff --git a/test-suite/success/Generalize.v b/test-suite/success/Generalize.v
index 0dc73991..980c89dd 100644
--- a/test-suite/success/Generalize.v
+++ b/test-suite/success/Generalize.v
@@ -1,7 +1,8 @@
 (* Check Generalize Dependent *)
 
-Lemma l1 : [a:=O;b:=a](c:b=b;d:(True->b=b))d=d.
-Intros.
-Generalize Dependent a.
-Intros a b c d.
+Lemma l1 :
+ let a := 0 in let b := a in forall (c : b = b) (d : True -> b = b), d = d.
+intros.
+generalize dependent a.
+intros a b c d.
 Abort.
diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v
index f32753e0..e1c74048 100644
--- a/test-suite/success/Hints.v
+++ b/test-suite/success/Hints.v
@@ -2,47 +2,47 @@
 (* Checks that qualified names are accepted *)
 
 (* New-style syntax *)
-Hint h1 : core arith := Resolve Logic.refl_equal.
-Hint h2 := Immediate Logic.trans_equal.
-Hint h3 : core := Unfold Logic.sym_equal.
-Hint h4 : foo bar := Constructors Logic.eq.
-Hint h5 : foo bar := Extern 3 (eq ? ? ?) Apply Logic.refl_equal.
+Hint Resolve refl_equal: core arith.
+Hint Immediate trans_equal.
+Hint Unfold sym_equal: core.
+Hint Constructors eq: foo bar.
+Hint Extern 3 (_ = _) => apply refl_equal: foo bar.
 
 (* Old-style syntax *)
-Hints Resolve Coq.Init.Logic.refl_equal Coq.Init.Logic.sym_equal.
-Hints Resolve Coq.Init.Logic.refl_equal Coq.Init.Logic.sym_equal : foo.
-Hints Immediate Coq.Init.Logic.refl_equal Coq.Init.Logic.sym_equal.
-Hints Immediate Coq.Init.Logic.refl_equal Coq.Init.Logic.sym_equal : foo.
-Hints Unfold Coq.Init.Datatypes.fst Coq.Init.Logic.sym_equal.
-Hints Unfold Coq.Init.Datatypes.fst Coq.Init.Logic.sym_equal : foo.
+Hint Resolve refl_equal sym_equal.
+Hint Resolve refl_equal sym_equal: foo.
+Hint Immediate refl_equal sym_equal.
+Hint Immediate refl_equal sym_equal: foo.
+Hint Unfold fst sym_equal.
+Hint Unfold fst sym_equal: foo.
 
 (* What's this stranged syntax ? *)
-HintDestruct Conclusion h6 (le ? ?) 4 [ Fun H -> Apply H ].
-HintDestruct Discardable Hypothesis h7 (le ? ?) 4 [ Fun H -> Apply H ].
-HintDestruct Hypothesis h8 (le ? ?) 4 [ Fun H -> Apply H ].
+Hint Destruct h6 := 4 Conclusion (_ <= _) => fun H => apply H.
+Hint Destruct h7 := 4 Discardable Hypothesis (_ <= _) => fun H => apply H.
+Hint Destruct h8 := 4 Hypothesis (_ <= _) => fun H => apply H.
 
 (* Checks that local names are accepted *)
 Section A.
-  Remark Refl : (A:Set)(x:A)x=x. 
+  Remark Refl : forall (A : Set) (x : A), x = x. 
   Proof refl_equal.
   Definition Sym := sym_equal.
-  Local Trans := trans_equal.
+  Let Trans := trans_equal.
  
-  Hint h1 : foo := Resolve Refl.
-  Hint h2 : bar := Resolve Sym.
-  Hint h3 : foo2 := Resolve Trans.
+  Hint Resolve Refl: foo.
+  Hint Resolve Sym: bar.
+  Hint Resolve Trans: foo2.
 
-  Hint h2 := Immediate Refl.
-  Hint h2 := Immediate Sym.
-  Hint h2 := Immediate Trans.
+  Hint Immediate Refl.
+  Hint Immediate Sym.
+  Hint Immediate Trans.
 
-  Hint h3 := Unfold Refl.
-  Hint h3 := Unfold Sym.
-  Hint h3 := Unfold Trans.
+  Hint Unfold Refl.
+  Hint Unfold Sym.
+  Hint Unfold Trans.
 
-  Hints Resolve Sym Trans Refl.
-  Hints Immediate Sym Trans Refl.
-  Hints Unfold Sym Trans Refl.
+  Hint Resolve Sym Trans Refl.
+  Hint Immediate Sym Trans Refl.
+  Hint Unfold Sym Trans Refl.
 
 End A.
 
diff --git a/test-suite/success/If.v b/test-suite/success/If.v
new file mode 100644
index 00000000..b7f06dcf
--- /dev/null
+++ b/test-suite/success/If.v
@@ -0,0 +1,7 @@
+(* Check correct use of if-then-else predicate annotation (cf bug 690) *)
+
+Check fun b : bool =>
+ if b as b0 return (if b0 then b0 = true else b0 = false)
+ then refl_equal true
+ else refl_equal false.
+
diff --git a/test-suite/success/ImplicitTactic.v b/test-suite/success/ImplicitTactic.v
new file mode 100644
index 00000000..d8fa3043
--- /dev/null
+++ b/test-suite/success/ImplicitTactic.v
@@ -0,0 +1,16 @@
+(* A Wiedijk-Cruz-Filipe style tactic for solving implicit arguments *)
+
+(* Declare a term expression with a hole *)
+Parameter quo : nat -> forall n:nat, n<>0 -> nat.
+Notation "x / y" := (quo x y _) : nat_scope.
+
+(* Declare the tactic for resolving implicit arguments still
+   unresolved after type-checking; it must complete the subgoal to
+   succeed *)
+Declare Implicit Tactic assumption.
+
+Goal forall n d, d<>0 -> { q:nat & { r:nat | d * q + r = n }}.
+intros.
+(* Here, assumption is used to solve the implicit argument of quo *)
+exists (n / d).
+
diff --git a/test-suite/success/Inductive.v b/test-suite/success/Inductive.v
index 87431a75..1adcbd39 100644
--- a/test-suite/success/Inductive.v
+++ b/test-suite/success/Inductive.v
@@ -1,34 +1,52 @@
 (* Check local definitions in context of inductive types *)
-Inductive A [C,D:Prop; E:=C; F:=D; x,y:E->F] : E -> Set :=
-   I : (z:E)(A C D x y z).
+Inductive A (C D : Prop) (E:=C) (F:=D) (x y : E -> F) : E -> Set :=
+    I : forall z : E, A C D x y z.
 
 Check
-   [C,D:Prop; E:=C; F:=D; x,y:(E ->F);
-    P:((c:C)(A C D x y c) ->Type);
-    f:((z:C)(P z (I C D x y z)));
-    y0:C; a:(A C D x y y0)]
-    <[y1:C; a0:(A C D x y y1)](P y1 a0)>Cases a of (I x0) => (f x0) end.
-
-Record B [C,D:Set; E:=C; F:=D; x,y:E->F] : Set := { p : C; q : E }.
+  (fun C D : Prop =>
+   let E := C in
+   let F := D in
+   fun (x y : E -> F) (P : forall c : C, A C D x y c -> Type)
+     (f : forall z : C, P z (I C D x y z)) (y0 : C) 
+     (a : A C D x y y0) =>
+   match a as a0 in (A _ _ _ _ y1) return (P y1 a0) with
+   | I x0 => f x0
+   end).
+
+Record B (C D : Set) (E:=C) (F:=D) (x y : E -> F) : Set :=  {p : C; q : E}.
 
 Check
-   [C,D:Set; E:=C; F:=D; x,y:(E ->F);
-    P:((B C D x y) ->Type);
-    f:((p0,q0:C)(P (Build_B C D x y p0 q0)));
-    b:(B C D x y)]
-    <[b0:(B C D x y)](P b0)>Cases b of (Build_B x0 x1) => (f x0 x1) end.
+  (fun C D : Set =>
+   let E := C in
+   let F := D in
+   fun (x y : E -> F) (P : B C D x y -> Type)
+     (f : forall p0 q0 : C, P (Build_B C D x y p0 q0)) 
+     (b : B C D x y) =>
+   match b as b0 return (P b0) with
+   | Build_B x0 x1 => f x0 x1
+   end).
 
 (* Check implicit parameters of inductive types (submitted by Pierre
   Casteran and also implicit in #338) *)
 
 Set Implicit Arguments.
+Unset Strict Implicit.
+
+CoInductive LList (A : Set) : Set :=
+  | LNil : LList A
+  | LCons : A -> LList A -> LList A.
+
+Implicit Arguments LNil [A].
+
+Inductive Finite (A : Set) : LList A -> Prop :=
+  | Finite_LNil : Finite LNil
+  | Finite_LCons :
+      forall (a : A) (l : LList A), Finite l -> Finite (LCons a l).
+
+(* Check positivity modulo reduction (cf bug #983) *)
 
-CoInductive LList [A:Set] : Set :=
-   | LNil : (LList A)
-   | LCons : A -> (LList A) -> (LList A).
+Record P:Type := {PA:Set; PB:Set}.
 
-Implicits LNil [1].
+Definition F (p:P) := (PA p) -> (PB p).
 
-Inductive Finite [A:Set] : (LList A) -> Prop :=
-   | Finite_LNil : (Finite LNil)
-   | Finite_LCons : (a:A) (l:(LList A)) (Finite l) -> (Finite (LCons a l)).
+Inductive I_F:Set := c : (F (Build_P nat I_F)) -> I_F.
diff --git a/test-suite/success/Injection.v b/test-suite/success/Injection.v
index fd80cec6..f8f7c996 100644
--- a/test-suite/success/Injection.v
+++ b/test-suite/success/Injection.v
@@ -2,33 +2,37 @@
 
 (* Check that Injection tries Intro until *)
 
-Lemma l1 : (x:nat)(S x)=(S (S x))->False.
-Injection 1.
-Apply n_Sn.
+Lemma l1 : forall x : nat, S x = S (S x) -> False.
+ injection 1.
+apply n_Sn.
 Qed.
 
-Lemma l2 : (x:nat)(H:(S x)=(S (S x)))H==H->False.
-Injection H.
-Intros.
-Apply (n_Sn x H0).
+Lemma l2 : forall (x : nat) (H : S x = S (S x)), H = H -> False.
+ injection H.
+intros.
+apply (n_Sn x H0).
 Qed.
 
 (* Check that no tuple needs to be built *)
-Lemma l3 : (x,y:nat)
-     (existS ? [n:nat]({n=n}+{n=n}) x (left ? ? (refl_equal nat x)))=
-     (existS ? [n:nat]({n=n}+{n=n}) y (left ? ? (refl_equal nat y)))
-  -> x=y.
-Intros x y H.
-Injection H.
-Exact [H]H.
+Lemma l3 :
+ forall x y : nat,
+ existS (fun n : nat => {n = n} + {n = n}) x (left _ (refl_equal x)) =
+ existS (fun n : nat => {n = n} + {n = n}) y (left _ (refl_equal y)) -> 
+ x = y.
+intros x y H.
+ injection H.
+exact (fun H => H).
 Qed.
 
 (* Check that a tuple is built (actually the same as the initial one) *)
-Lemma l4 : (p1,p2:{O=O}+{O=O})
-    (existS ? [n:nat]({n=n}+{n=n}) O p1)=(existS ? [n:nat]({n=n}+{n=n}) O p2)
-  ->(existS ? [n:nat]({n=n}+{n=n}) O p1)=(existS ? [n:nat]({n=n}+{n=n}) O p2).
-Intros.
-Injection H.
-Exact [H]H.
+Lemma l4 :
+ forall p1 p2 : {0 = 0} + {0 = 0},
+ existS (fun n : nat => {n = n} + {n = n}) 0 p1 =
+ existS (fun n : nat => {n = n} + {n = n}) 0 p2 ->
+ existS (fun n : nat => {n = n} + {n = n}) 0 p1 =
+ existS (fun n : nat => {n = n} + {n = n}) 0 p2.
+intros.
+ injection H.
+exact (fun H => H).
 Qed.
 
diff --git a/test-suite/success/Inversion.v b/test-suite/success/Inversion.v
index a9e4a843..f83328e8 100644
--- a/test-suite/success/Inversion.v
+++ b/test-suite/success/Inversion.v
@@ -1,85 +1,101 @@
-Axiom magic:False.
+Axiom magic : False.
 
 (* Submitted by Dachuan Yu (bug #220) *)
-Fixpoint T[n:nat] : Type := 
- Cases n of 
- | O => (nat -> Prop) 
- | (S n') => (T n') 
- end. 
-Inductive R : (n:nat)(T n) -> nat -> Prop := 
-  | RO : (Psi:(T O); l:nat) 
-          (Psi l) -> (R O Psi l) 
-  | RS : (n:nat; Psi:(T (S n)); l:nat) 
-          (R n Psi l) -> (R (S n) Psi l). 
-Definition Psi00 : (nat -> Prop) := [n:nat] False. 
-Definition Psi0 : (T O) := Psi00. 
-Lemma Inversion_RO : (l:nat)(R O Psi0 l) -> (Psi00 l).
-Inversion 1.
+Fixpoint T (n : nat) : Type :=
+  match n with
+  | O => nat -> Prop
+  | S n' => T n'
+  end. 
+Inductive R : forall n : nat, T n -> nat -> Prop :=
+  | RO : forall (Psi : T 0) (l : nat), Psi l -> R 0 Psi l
+  | RS :
+      forall (n : nat) (Psi : T (S n)) (l : nat), R n Psi l -> R (S n) Psi l. 
+Definition Psi00 (n : nat) : Prop := False. 
+Definition Psi0 : T 0 := Psi00. 
+Lemma Inversion_RO : forall l : nat, R 0 Psi0 l -> Psi00 l.
+inversion 1.
 Abort.
 
 (* Submitted by Pierre Casteran (bug #540) *)
 
 Set Implicit Arguments.
-Parameter rule: Set -> Type.
+Unset Strict Implicit.
+Parameter rule : Set -> Type.
 
-Inductive extension [I:Set]:Type :=
- NL : (extension I) 
-|add_rule : (rule I)  -> (extension I)  -> (extension I).
+Inductive extension (I : Set) : Type :=
+  | NL : extension I
+  | add_rule : rule I -> extension I -> extension I.
 
 
-Inductive in_extension [I :Set;r: (rule I)] : (extension I)  -> Type :=
- in_first : (e:?)(in_extension r (add_rule r e))
-|in_rest : (e,r':?)(in_extension r e) -> (in_extension r (add_rule r' e)).
+Inductive in_extension (I : Set) (r : rule I) : extension I -> Type :=
+  | in_first : forall e, in_extension r (add_rule r e)
+  | in_rest : forall e r', in_extension r e -> in_extension r (add_rule r' e).
 
-Implicits NL [1].
+Implicit Arguments NL [I].
 
-Inductive super_extension [I:Set;e :(extension I)] : (extension I)  -> Type :=
- super_NL   : (super_extension   e NL)
-| super_add : (r:?)(e': (extension I))
-                 (in_extension  r e) ->
-                 (super_extension  e e') ->
-                 (super_extension  e (add_rule r e')). 
+Inductive super_extension (I : Set) (e : extension I) :
+extension I -> Type :=
+  | super_NL : super_extension e NL
+  | super_add :
+      forall r (e' : extension I),
+      in_extension r e ->
+      super_extension e e' -> super_extension e (add_rule r e'). 
 
 
 
-Lemma super_def : (I :Set)(e1, e2: (extension I))
-                 (super_extension  e2 e1) ->
-                 (ru:?) 
-                   (in_extension ru e1) ->
-                   (in_extension ru e2).
+Lemma super_def :
+ forall (I : Set) (e1 e2 : extension I),
+ super_extension e2 e1 -> forall ru, in_extension ru e1 -> in_extension ru e2.
 Proof.                 
- Induction 1.
- Inversion 1; Auto.
- Elim magic.
+ simple induction 1.
+ inversion 1; auto.
+ elim magic.
 Qed.
 
 (* Example from Norbert Schirmer on Coq-Club, Sep 2000 *)
 
+Set Strict Implicit.
 Unset Implicit Arguments.
-Definition Q[n,m:nat;prf:(le n m)]:=True.
-Goal (n,m:nat;H:(le (S n) m))(Q (S n) m H)==True.
-Intros.
-Dependent Inversion_clear H.
-Elim magic.
-Elim magic.
+Definition Q (n m : nat) (prf : n <= m) := True.
+Goal forall (n m : nat) (H : S n <= m), Q (S n) m H = True.
+intros.
+dependent inversion_clear H.
+elim magic.
+elim magic.
 Qed.
 
 (* Submitted by Boris Yakobowski (bug #529) *)
 (* Check that Inversion does not fail due to unnormalized evars *)
 
 Set Implicit Arguments.
+Unset Strict Implicit.
 Require Import Bvector.
 
 Inductive I : nat -> Set :=
-| C1 : (I (S O))
-| C2 : (k,i:nat)(vector (I i) k) -> (I i).
+  | C1 : I 1
+  | C2 : forall k i : nat, vector (I i) k -> I i.
 
-Inductive SI : (k:nat)(I k) -> (vector nat k) -> nat -> Prop :=
-| SC2 : (k,i,vf:nat) (v:(vector (I i) k))(xi:(vector nat i))(SI (C2 v) xi vf).
+Inductive SI : forall k : nat, I k -> vector nat k -> nat -> Prop :=
+    SC2 :
+      forall (k i vf : nat) (v : vector (I i) k) (xi : vector nat i),
+      SI (C2 v) xi vf.
 
-Theorem SUnique : (k:nat)(f:(I k))(c:(vector nat k))
-(v,v':?) (SI f c v) -> (SI f c v') -> v=v'.
+Theorem SUnique :
+ forall (k : nat) (f : I k) (c : vector nat k) v v',
+ SI f c v -> SI f c v' -> v = v'.
 Proof.
-NewInduction 1.
-Intros H ; Inversion H.
+induction 1.
+intros H; inversion H.
 Admitted.
+
+(* Used to failed at some time *)
+
+Set Strict Implicit.
+Unset Implicit Arguments.
+Parameter bar : forall p q : nat, p = q -> Prop.
+Inductive foo : nat -> nat -> Prop :=
+    C : forall (a b : nat) (Heq : a = b), bar a b Heq -> foo a b.
+Lemma depinv : forall a b, foo a b -> True.
+intros a b H.
+inversion H.
+Abort.
diff --git a/test-suite/success/LetIn.v b/test-suite/success/LetIn.v
index 0e0b4435..b61ea784 100644
--- a/test-suite/success/LetIn.v
+++ b/test-suite/success/LetIn.v
@@ -1,11 +1,11 @@
 (* Simple let-in's *)
-Definition l1 := [P := O]P.
-Definition l2 := [P := nat]P.
-Definition l3 := [P := True]P.
-Definition l4 := [P := Prop]P.
-Definition l5 := [P := Type]P.
+Definition l1 := let P := 0 in P.
+Definition l2 := let P := nat in P.
+Definition l3 := let P := True in P.
+Definition l4 := let P := Prop in P.
+Definition l5 := let P := Type in P.
 
 (* Check casting of let-in *)
-Definition l6 := [P := O : nat]P.
-Definition l7 := [P := True : Prop]P.
-Definition l8 := [P := True : Type]P.
+Definition l6 := let P := 0:nat in P.
+Definition l7 := let P := True:Prop in P.
+Definition l8 := let P := True:Type in P.
diff --git a/test-suite/success/MatchFail.v b/test-suite/success/MatchFail.v
index d89ee3be..660ca3cb 100644
--- a/test-suite/success/MatchFail.v
+++ b/test-suite/success/MatchFail.v
@@ -6,23 +6,24 @@ Require Export ZArithRing.
    2*(POS e)+1  ou 2*(POS e), pour rendre les expressions plus
    à même d'être utilisées par Ring, lorsque ces expressions contiennent
    des variables de type positive. *)
-Tactic Definition compute_POS :=
- (Match Context With
- | [|- [(POS (xI ?1))]] -> Let v = ?1 In 
-                          (Match v With
-                            | [xH] ->
-                              (Fail 1)
-                            |_->
-                              Rewrite (POS_xI v))
- | [ |- [(POS (xO ?1))]] -> Let v = ?1 In
-                           Match v With
-                            |[xH]->
-                              (Fail 1)
-                            |[?]->
-                              Rewrite (POS_xO v)).
+Ltac compute_POS :=
+  match goal with
+  |  |- context [(Zpos (xI ?X1))] =>
+      let v := constr:X1 in
+      match constr:v with
+      | 1%positive => fail 1
+      | _ =>  rewrite (BinInt.Zpos_xI v)
+      end
+  |  |- context [(Zpos (xO ?X1))] =>
+      let v := constr:X1 in
+      match constr:v with
+      | 1%positive => fail 1
+      | _ =>  rewrite (BinInt.Zpos_xO v)
+      end
+  end.
 
-Goal (x:positive)(POS (xI (xI x)))=`4*(POS x)+3`.
-Intros.
-Repeat compute_POS.
-Ring.
+Goal forall x : positive, Zpos (xI (xI x)) = (4 * Zpos x + 3)%Z.
+intros.
+repeat compute_POS.
+ ring.
 Qed.
diff --git a/test-suite/success/Mod_ltac.v b/test-suite/success/Mod_ltac.v
index 1a9f6fc5..44bb3a55 100644
--- a/test-suite/success/Mod_ltac.v
+++ b/test-suite/success/Mod_ltac.v
@@ -1,20 +1,20 @@
 (* Submitted by Houda Anoun *)
 
 Module toto.
-Tactic Definition titi:=Auto.
+Ltac titi := auto.
 End toto.
 
 Module ti.
 Import toto.
-Tactic Definition equal:=
-Match Context With
-[ |- ?1=?1]-> titi
-| [ |- ?]-> Idtac.
+Ltac equal := match goal with
+              |  |- (?X1 = ?X1) => titi
+              |  |- _ => idtac
+              end.
 
 End ti.
 
 Import ti.
-Definition simple:(a:nat) a=a.
-Intro.
+Definition simple : forall a : nat, a = a.
+intro.
 equal.
 Qed.
diff --git a/test-suite/success/Mod_params.v b/test-suite/success/Mod_params.v
index 098de3cf..74228bbb 100644
--- a/test-suite/success/Mod_params.v
+++ b/test-suite/success/Mod_params.v
@@ -3,10 +3,10 @@
 Module Type SIG.
 End SIG.
 
-Module Type FSIG[X:SIG].
+Module Type FSIG (X: SIG).
 End FSIG.
 
-Module F[X:SIG].
+Module F (X: SIG).
 End F.
 
 Module Q.
@@ -22,57 +22,57 @@ End Q.
 
 Module M.
 Reset M.
-Module M[X:SIG].
+Module M (X: SIG).
 Reset M.
-Module M[X,Y:SIG].
+Module M (X Y: SIG).
 Reset M.
-Module M[X:SIG;Y:SIG].
+Module M (X: SIG) (Y: SIG).
 Reset M.
-Module M[X,Y:SIG;Z1,Z:SIG].
+Module M (X Y: SIG) (Z1 Z: SIG).
 Reset M.
-Module M[X:SIG][Y:SIG].
+Module M (X: SIG) (Y: SIG).
 Reset M.
-Module M[X,Y:SIG][Z1,Z:SIG].
+Module M (X Y: SIG) (Z1 Z: SIG).
 Reset M.
-Module M:SIG.
+Module M : SIG.
 Reset M.
-Module M[X:SIG]:SIG.
+Module M (X: SIG) : SIG.
 Reset M.
-Module M[X,Y:SIG]:SIG.
+Module M (X Y: SIG) : SIG.
 Reset M.
-Module M[X:SIG;Y:SIG]:SIG.
+Module M (X: SIG) (Y: SIG) : SIG.
 Reset M.
-Module M[X,Y:SIG;Z1,Z:SIG]:SIG.
+Module M (X Y: SIG) (Z1 Z: SIG) : SIG.
 Reset M.
-Module M[X:SIG][Y:SIG]:SIG.
+Module M (X: SIG) (Y: SIG) : SIG.
 Reset M.
-Module M[X,Y:SIG][Z1,Z:SIG]:SIG.
+Module M (X Y: SIG) (Z1 Z: SIG) : SIG.
 Reset M.
-Module M:=(F Q).
+Module M := F Q.
 Reset M.
-Module M[X:FSIG]:=(X Q).
+Module M (X: FSIG) := X Q.
 Reset M.
-Module M[X,Y:FSIG]:=(X Q).
+Module M (X Y: FSIG) := X Q.
 Reset M.
-Module M[X:FSIG;Y:SIG]:=(X Y).
+Module M (X: FSIG) (Y: SIG) := X Y.
 Reset M.
-Module M[X,Y:FSIG;Z1,Z:SIG]:=(X Z).
+Module M (X Y: FSIG) (Z1 Z: SIG) := X Z.
 Reset M.
-Module M[X:FSIG][Y:SIG]:=(X Y).
+Module M (X: FSIG) (Y: SIG) := X Y.
 Reset M.
-Module M[X,Y:FSIG][Z1,Z:SIG]:=(X Z).
+Module M (X Y: FSIG) (Z1 Z: SIG) := X Z.
 Reset M.
-Module M:SIG:=(F Q).
+Module M : SIG := F Q.
 Reset M.
-Module M[X:FSIG]:SIG:=(X Q).
+Module M (X: FSIG) : SIG := X Q.
 Reset M.
-Module M[X,Y:FSIG]:SIG:=(X Q).
+Module M (X Y: FSIG) : SIG := X Q.
 Reset M.
-Module M[X:FSIG;Y:SIG]:SIG:=(X Y).
+Module M (X: FSIG) (Y: SIG) : SIG := X Y.
 Reset M.
-Module M[X,Y:FSIG;Z1,Z:SIG]:SIG:=(X Z).
+Module M (X Y: FSIG) (Z1 Z: SIG) : SIG := X Z.
 Reset M.
-Module M[X:FSIG][Y:SIG]:SIG:=(X Y).
+Module M (X: FSIG) (Y: SIG) : SIG := X Y.
 Reset M.
-Module M[X,Y:FSIG][Z1,Z:SIG]:SIG:=(X Z).
+Module M (X Y: FSIG) (Z1 Z: SIG) : SIG := X Z.
 Reset M.
diff --git a/test-suite/success/Mod_strengthen.v b/test-suite/success/Mod_strengthen.v
index a472e698..449610be 100644
--- a/test-suite/success/Mod_strengthen.v
+++ b/test-suite/success/Mod_strengthen.v
@@ -1,25 +1,27 @@
 Module Type Sub.
-  Axiom Refl1 : (x:nat)(x=x).
-  Axiom Refl2 : (x:nat)(x=x).
-  Axiom Refl3 : (x:nat)(x=x).
-  Inductive T : Set := A : T.
+  Axiom Refl1 : forall x : nat, x = x.
+  Axiom Refl2 : forall x : nat, x = x.
+  Axiom Refl3 : forall x : nat, x = x.
+  Inductive T : Set :=
+      A : T.
 End Sub.
 
 Module Type Main.
-  Declare Module M:Sub.
+  Declare Module M: Sub.
 End Main.
 
 
 Module A <: Main.
   Module M <: Sub.
-    Lemma Refl1 : (x:nat) x=x.
-      Intros;Reflexivity.
+    Lemma Refl1 : forall x : nat, x = x.
+      intros; reflexivity.
     Qed.
-    Axiom Refl2 : (x:nat) x=x.
-    Lemma Refl3 : (x:nat) x=x.
-      Intros;Reflexivity.
+    Axiom Refl2 : forall x : nat, x = x.
+    Lemma Refl3 : forall x : nat, x = x.
+      intros; reflexivity.
     Defined.
-    Inductive T : Set := A : T.
+    Inductive T : Set :=
+        A : T.
   End M.
 End A.
 
@@ -27,8 +29,8 @@ End A.
 
 (* first test *)
 
-Module F[S:Sub].
-  Module M:=S.
+Module F (S: Sub).
+  Module M := S.
 End F.
 
 Module B <: Main with Module M:=A.M := F A.M.
@@ -37,28 +39,29 @@ Module B <: Main with Module M:=A.M := F A.M.
 
 (* second test *)
 
-Lemma r1 : (A.M.Refl1 == B.M.Refl1).
+Lemma r1 : (A.M.Refl1 = B.M.Refl1).
 Proof.
-  Reflexivity.
+  reflexivity.
 Qed.
 
-Lemma r2 : (A.M.Refl2 == B.M.Refl2).
+Lemma r2 : (A.M.Refl2 = B.M.Refl2).
 Proof.
-  Reflexivity.
+  reflexivity.
 Qed.
 
-Lemma r3 : (A.M.Refl3 == B.M.Refl3).
+Lemma r3 : (A.M.Refl3 = B.M.Refl3).
 Proof.
-  Reflexivity.
+  reflexivity.
 Qed.
 
-Lemma t : (A.M.T == B.M.T).
+Lemma t : (A.M.T = B.M.T).
 Proof.
-  Reflexivity.
+  reflexivity.
 Qed.
 
-Lemma a : (A.M.A == B.M.A).
+Lemma a : (A.M.A = B.M.A).
 Proof.
-  Reflexivity.
+  reflexivity.
 Qed.
 
+
diff --git a/test-suite/success/Mod_type.v b/test-suite/success/Mod_type.v
new file mode 100644
index 00000000..b847833f
--- /dev/null
+++ b/test-suite/success/Mod_type.v
@@ -0,0 +1,19 @@
+(* Check bug #1025 submitted by Pierre-Luc Carmel Biron *)
+
+Module Type FOO.
+  Parameter A : Type.
+End FOO.
+
+Module Type BAR.
+  Declare Module Foo : FOO.
+End BAR.
+
+Module Bar : BAR.
+
+  Module Fu : FOO.
+    Definition A := Prop.
+  End Fu.
+
+  Module Foo := Fu.
+
+End Bar.
diff --git a/test-suite/success/NatRing.v b/test-suite/success/NatRing.v
index 6a1eeccc..8426c7e4 100644
--- a/test-suite/success/NatRing.v
+++ b/test-suite/success/NatRing.v
@@ -1,10 +1,10 @@
-Require ArithRing.
+Require Import ArithRing.
 
-Lemma l1 : (S (S O))=(plus (S O) (S O)).
-NatRing.
+Lemma l1 : 2 = 1 + 1.
+ring_nat.
 Qed.
 
-Lemma l2 : (x:nat)(S (S x))=(plus (S O) (S x)).
-Intro.
-NatRing.
-Qed.
\ No newline at end of file
+Lemma l2 : forall x : nat, S (S x) = 1 + S x.
+intro.
+ring_nat.
+Qed.
diff --git a/test-suite/success/Omega.v b/test-suite/success/Omega.v
index c324919f..2d29a835 100644
--- a/test-suite/success/Omega.v
+++ b/test-suite/success/Omega.v
@@ -1,40 +1,38 @@
 
-Require Omega.
+Require Import Omega.
 
 (* Submitted by Xavier Urbain 18 Jan 2002 *)
 
-Lemma lem1 : (x,y:Z) 
-  `-5 < x < 5` ->
-  `-5 < y` ->
-  `-5 < x+y+5`.
+Lemma lem1 :
+ forall x y : Z, (-5 < x < 5)%Z -> (-5 < y)%Z -> (-5 < x + y + 5)%Z.
 Proof.
-Intros x y.
-Omega.
+intros x y.
+ omega.
 Qed.
 
 (* Proposed by Pierre Crégut *)
 
-Lemma lem2 : (x:Z) `x < 4` -> `x > 2` -> `x=3`.
-Intro.
-Omega.
+Lemma lem2 : forall x : Z, (x < 4)%Z -> (x > 2)%Z -> x = 3%Z.
+intro.
+ omega.
 Qed.
 
 (* Proposed by Jean-Christophe Filliâtre *)
 
-Lemma lem3 : (x,y:Z) `x = y` -> `x+x = y+y`.
+Lemma lem3 : forall x y : Z, x = y -> (x + x)%Z = (y + y)%Z.
 Proof.
-Intros.
-Omega.
+intros.
+ omega.
 Qed.
 
 (* Proposed by Jean-Christophe Filliâtre: confusion between an Omega *)
 (* internal variable and a section variable (June 2001) *)
 
 Section A.
-Variable x,y : Z.
-Hypothesis H : `x > y`.
-Lemma lem4 : `x > y`.
-Omega.
+Variable x y : Z.
+Hypothesis H : (x > y)%Z.
+Lemma lem4 : (x > y)%Z.
+ omega.
 Qed.
 End A.
 
@@ -42,48 +40,57 @@ End A.
 (* May 2002 *)
 
 Section B.
-Variables R1,R2,S1,S2,H,S:Z.
-Hypothesis I:`R1 < 0`->`R2 = R1+(2*S1-1)`.
-Hypothesis J:`R1 < 0`->`S2 = S1-1`.
-Hypothesis K:`R1 >= 0`->`R2 = R1`.
-Hypothesis L:`R1 >= 0`->`S2 = S1`.
-Hypothesis M:`H <= 2*S`.
-Hypothesis N:`S < H`.
-Lemma lem5 : `H > 0`.
-Omega.
+Variable R1 R2 S1 S2 H S : Z.
+Hypothesis I : (R1 < 0)%Z -> R2 = (R1 + (2 * S1 - 1))%Z.
+Hypothesis J : (R1 < 0)%Z -> S2 = (S1 - 1)%Z.
+Hypothesis K : (R1 >= 0)%Z -> R2 = R1.
+Hypothesis L : (R1 >= 0)%Z -> S2 = S1.
+Hypothesis M : (H <= 2 * S)%Z.
+Hypothesis N : (S < H)%Z.
+Lemma lem5 : (H > 0)%Z.
+ omega.
 Qed.
 End B.
 
 (* From Nicolas Oury (bug #180): handling -> on Set (fixed Oct 2002) *)
-Lemma lem6: (A: Set) (i:Z) `i<= 0` -> (`i<= 0` -> A) -> `i<=0`.
-Intros.
-Omega.
+Lemma lem6 :
+ forall (A : Set) (i : Z), (i <= 0)%Z -> ((i <= 0)%Z -> A) -> (i <= 0)%Z.
+intros.
+ omega.
 Qed.
 
 (* Adapted from an example in Nijmegen/FTA/ftc/RefSeparating (Oct 2002) *)
-Require Omega.
+Require Import Omega.
 Section C.
-Parameter g:(m:nat)~m=O->Prop.
-Parameter f:(m:nat)(H:~m=O)(g m H).
-Variable n:nat.
-Variable ap_n:~n=O.
-Local delta:=(f n ap_n).
-Lemma lem7 : n=n.
-Omega.
+Parameter g : forall m : nat, m <> 0 -> Prop.
+Parameter f : forall (m : nat) (H : m <> 0), g m H.
+Variable n : nat.
+Variable ap_n : n <> 0.
+Let delta := f n ap_n.
+Lemma lem7 : n = n.
+ omega.
 Qed.
 End C.
 
 (* Problem of dependencies *)
-Require Omega.
-Lemma lem8 : (H:O=O->O=O) H=H -> O=O.
-Intros; Omega.
+Require Import Omega.
+Lemma lem8 : forall H : 0 = 0 -> 0 = 0, H = H -> 0 = 0.
+intros;  omega.
 Qed.
 
 (* Bug that what caused by the use of intro_using in Omega *)
+Require Import Omega.
+Lemma lem9 :
+ forall p q : nat, ~ (p <= q /\ p < q \/ q <= p /\ p < q) -> p < p \/ p <= p.
+intros;  omega.
+Qed.
+
+(* Check that the interpretation of mult on nat enforces its positivity *)
+(* Submitted by Hubert Thierry (bug #743) *)
+(* Postponed... problem with goals of the form "(n*m=0)%nat -> (n*m=0)%Z"
 Require Omega.
-Lemma lem9 : (p,q:nat)
-  ~((le p q)/\(lt p q)\/(le q p)/\(lt p q))
-  -> (lt p p)\/(le p p).
+Lemma lem10 : (n, m : nat) (le n (plus n (mult n m))).
+Proof.
 Intros; Omega.
 Qed.
-
+*)
diff --git a/test-suite/success/Omega2.v b/test-suite/success/Omega2.v
new file mode 100644
index 00000000..54b13702
--- /dev/null
+++ b/test-suite/success/Omega2.v
@@ -0,0 +1,28 @@
+Require Import ZArith Omega.
+
+(* Submitted by Yegor Bryukhov (#922) *)
+
+Open Scope Z_scope.
+
+Lemma Test46 : 
+forall v1 v2 v3 v4 v5 : Z,
+((2 * v4) + (5)) + (8 * v2) <= ((4 * v4) + (3 * v4)) + (5 * v4) ->
+9 * v4 > (1 * v4) + ((2 * v1) + (0 * v2)) ->
+((9 * v3) + (2 * v5)) + (5 * v2) = 3 * v4 ->
+0 > 6 * v1 ->
+(0 * v3) + (6 * v2) <> 2 ->
+(0 * v3) + (5 * v5) <> ((4 * v2) + (8 * v2)) + (2 * v5) ->
+7 * v3 > 5 * v5 ->
+0 * v4 >= ((5 * v1) + (4 * v1)) + ((6 * v5) + (3 * v5)) ->
+7 * v2 = ((3 * v2) + (6 * v5)) + (7 * v2) ->
+0 * v3 > 7 * v1 ->
+9 * v2 < 9 * v5 ->
+(2 * v3) + (8 * v1) <= 5 * v4 ->
+5 * v2 = ((5 * v1) + (0 * v5)) + (1 * v2) ->
+0 * v5 <= 9 * v2 ->
+((7 * v1) + (1 * v3)) + ((2 * v3) + (1 * v3)) >= ((6 * v5) + (4)) + ((1) + (9))
+-> False.
+intros.
+omega.
+Qed.
+
diff --git a/test-suite/success/PPFix.v8 b/test-suite/success/PPFix.v
index 1ecbae3a..833eb3ad 100644
--- a/test-suite/success/PPFix.v8
+++ b/test-suite/success/PPFix.v
@@ -6,3 +6,4 @@ Check fix a(n: nat): n<5 -> nat :=
     | 0 => fun _ => 0
     | S n => fun h => S (a n (lt_S_n _ _ (lt_S _ _ h)))
   end.
+
diff --git a/test-suite/success/Print.v b/test-suite/success/Print.v
index 4554a843..c4726bf3 100644
--- a/test-suite/success/Print.v
+++ b/test-suite/success/Print.v
@@ -6,15 +6,14 @@ Print Graph.
 Print Coercions.
 Print Classes.
 Print nat.
-Print Proof O.
+Print Term O.
 Print All.
-Print Grammar constr constr.
+Print Grammar constr.
 Inspect 10.
 
 Section A.
-Coercion f := [x]True : nat -> Prop.
-Print Coercion Paths nat SORTCLASS.
+Coercion f (x : nat) : Prop := True.
+Print Coercion Paths nat Sortclass.
 
 Print Section A.
-Print.
 
diff --git a/test-suite/success/Projection.v b/test-suite/success/Projection.v
index 7f5cd800..88da6013 100644
--- a/test-suite/success/Projection.v
+++ b/test-suite/success/Projection.v
@@ -1,10 +1,8 @@
-Structure S : Type := 
- {Dom     : Type;
-  Op      : Dom -> Dom -> Dom}.
+Structure S : Type :=  {Dom : Type; Op : Dom -> Dom -> Dom}.
 
-Check [s:S](Dom s).
-Check [s:S](Op s).
-Check [s:S;a,b:(Dom s)](Op s a b).
+Check (fun s : S => Dom s).
+Check (fun s : S => Op s).
+Check (fun (s : S) (a b : Dom s) => Op s a b).
 
 (* v8
 Check fun s:S => s.(Dom).
@@ -13,17 +11,16 @@ Check fun (s:S) (a b:s.(Dom)) => s.(Op) a b.
 *)
 
 Set Implicit Arguments.
-Unset Strict Implicits. 
+Unset Strict Implicit.
+Unset Strict Implicit. 
 
-Structure S' [A:Set] : Type := 
- {Dom'     : Type;
-  Op'      : A -> Dom' -> Dom'}.
+Structure S' (A : Set) : Type :=  {Dom' : Type; Op' : A -> Dom' -> Dom'}.
 
-Check [s:(S' nat)](Dom' s).
-Check [s:(S' nat)](Op' 2!s).
-Check [s:(S' nat)](!Op' nat s).
-Check [s:(S' nat);a:nat;b:(Dom' s)](Op' a b).
-Check [s:(S' nat);a:nat;b:(Dom' s)](!Op' nat s a b).
+Check (fun s : S' nat => Dom' s).
+Check (fun s : S' nat => Op' (s:=s)).
+Check (fun s : S' nat => Op' (A:=nat) (s:=s)).
+Check (fun (s : S' nat) (a : nat) (b : Dom' s) => Op' a b).
+Check (fun (s : S' nat) (a : nat) (b : Dom' s) => Op' (A:=nat) (s:=s) a b).
 
 (* v8
 Check fun s:S' => s.(Dom').
diff --git a/test-suite/success/RecTutorial.v b/test-suite/success/RecTutorial.v
new file mode 100644
index 00000000..d79b85df
--- /dev/null
+++ b/test-suite/success/RecTutorial.v
@@ -0,0 +1,1229 @@
+Inductive nat : Set := 
+ | O : nat 
+ | S : nat->nat.
+Check nat.
+Check O.
+Check S.
+
+Reset nat.
+Print nat.
+
+
+Print le.
+
+Theorem zero_leq_three: 0 <= 3.
+
+Proof.
+ constructor 2. 
+ constructor 2.  
+ constructor 2.
+ constructor 1.
+
+Qed.
+
+Print zero_leq_three.
+
+
+Lemma zero_leq_three': 0 <= 3.
+ repeat constructor.
+Qed.
+
+
+Lemma zero_lt_three : 0 < 3.
+Proof.
+ unfold lt.
+ repeat constructor. 
+Qed.
+
+
+Require Import List.
+
+Print list.
+
+Check list.
+
+Check (nil (A:=nat)).
+
+Check (nil (A:= nat -> nat)).
+
+Check (fun A: Set => (cons (A:=A))).
+
+Check (cons 3 (cons 2 nil)).
+
+
+
+
+Require Import Bvector.
+
+Print vector.
+
+Check (Vnil nat).
+
+Check (fun (A:Set)(a:A)=> Vcons _ a _ (Vnil _)).
+
+Check (Vcons _ 5 _ (Vcons _ 3 _ (Vnil _))).
+
+
+
+
+
+
+
+
+
+
+
+
+
+Lemma eq_3_3 : 2 + 1 = 3.
+Proof.
+ reflexivity.
+Qed.
+Print eq_3_3.
+
+Lemma eq_proof_proof : refl_equal (2*6) = refl_equal (3*4).
+Proof.
+ reflexivity.
+Qed.
+Print eq_proof_proof.
+
+Lemma eq_lt_le : ( 2 < 4) = (3 <= 4).
+Proof.
+ reflexivity.
+Qed.
+
+Lemma eq_nat_nat : nat = nat.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma eq_Set_Set : Set = Set.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma eq_Type_Type : Type = Type.
+Proof.
+ reflexivity.
+Qed.
+
+
+Check (2 + 1 = 3).
+
+
+Check (Type = Type).
+
+Goal Type = Type.
+reflexivity.
+Qed.
+
+
+Print or.
+
+Print and.
+
+
+Print sumbool.
+
+Print ex.
+
+Require Import ZArith.
+Require Import Compare_dec.
+
+Check le_lt_dec.
+
+Definition max (n p :nat) := match le_lt_dec n p with 
+                             | left _ => p
+                             | right _ => n
+                             end.
+
+Theorem le_max : forall n p, n <= p -> max n p = p.
+Proof.
+ intros n p ; unfold max ; case (le_lt_dec n p); simpl.
+ trivial.
+ intros; absurd (p < p); eauto with arith.
+Qed.
+
+Extraction max.
+
+
+
+
+
+
+Inductive tree(A:Set)   : Set :=
+    node : A -> forest A -> tree A 
+with
+  forest (A: Set)    : Set := 
+    nochild  : forest A |
+    addchild : tree A -> forest A -> forest A.
+
+
+
+
+
+Inductive 
+  even    : nat->Prop :=
+    evenO : even  O |
+    evenS : forall n, odd n -> even (S n)
+with
+  odd    : nat->Prop :=
+    oddS : forall n, even n -> odd (S n).
+
+Lemma odd_49 : odd (7 * 7).
+ simpl; repeat constructor.
+Qed.
+
+
+
+Definition nat_case := 
+ fun (Q : Type)(g0 : Q)(g1 : nat -> Q)(n:nat) =>
+    match n return Q with
+    | 0 => g0 
+    | S p => g1 p 
+    end.
+
+Eval simpl in (nat_case nat 0 (fun p => p) 34).
+
+Eval simpl in (fun g0 g1 => nat_case nat g0 g1 34).
+
+Eval simpl in (fun g0 g1 => nat_case nat g0 g1 0).
+
+
+Definition pred (n:nat) := match n with O => O | S m => m end.
+
+Eval simpl in pred 56.
+
+Eval simpl in pred 0.
+
+Eval simpl in fun p => pred (S p).
+
+
+Definition xorb (b1 b2:bool) :=
+match b1, b2 with 
+ | false, true => true
+ | true, false => true
+ | _ , _       => false
+end.
+
+
+ Definition pred_spec (n:nat) := {m:nat | n=0 /\ m=0  \/ n = S m}.
+  
+
+ Definition predecessor : forall n:nat, pred_spec n.
+  intro n;case n.
+  unfold pred_spec;exists 0;auto.
+  unfold pred_spec; intro n0;exists n0; auto.
+ Defined.
+
+Print predecessor.
+
+Extraction predecessor.
+
+Theorem nat_expand : 
+  forall n:nat, n = match n with 0 => 0 | S p => S p end.
+ intro n;case n;simpl;auto.
+Qed.
+
+Check (fun p:False => match p return 2=3 with end).
+
+Theorem fromFalse : False -> 0=1.
+ intro absurd. 
+ contradiction.
+Qed.
+
+Section equality_elimination.
+ Variables (A: Type)
+           (a b : A)
+           (p : a = b)
+           (Q : A -> Type).
+ Check (fun H : Q a =>
+  match p in (eq _  y) return Q y with
+     refl_equal => H
+  end).
+
+End equality_elimination.
+
+           
+Theorem trans : forall n m p:nat, n=m -> m=p -> n=p.
+Proof.
+ intros n m p eqnm.  
+ case eqnm.
+ trivial.        
+Qed.
+
+Lemma Rw :  forall x y: nat, y = y * x -> y * x * x = y.
+ intros x y e; do 2 rewrite <- e.
+ reflexivity.
+Qed.
+
+
+Require Import Arith.
+
+Check mult_1_l.
+(*
+mult_1_l
+     : forall n : nat, 1 * n = n
+*)
+
+Check mult_plus_distr_r.
+(*
+mult_plus_distr_r
+     : forall n m p : nat, (n + m) * p = n * p + m * p
+
+*)
+
+Lemma mult_distr_S : forall n p : nat, n * p + p = (S n)* p.
+ simpl;auto with arith.
+Qed.
+
+Lemma four_n : forall n:nat, n+n+n+n = 4*n.
+ intro n;rewrite <- (mult_1_l n).
+
+ Undo.
+ intro n; pattern n at 1.
+ 
+
+ rewrite <- mult_1_l.
+ repeat rewrite   mult_distr_S.
+ trivial.
+Qed.
+
+
+Section Le_case_analysis.
+ Variables (n p : nat)
+           (H : n <= p)
+           (Q : nat -> Prop)
+           (H0 : Q n)
+           (HS : forall m, n <= m -> Q (S m)).
+ Check (
+    match H in (_ <= q) return (Q q)  with
+    | le_n => H0
+    | le_S m Hm => HS m Hm
+    end
+  ).
+
+
+End Le_case_analysis.
+
+
+Lemma predecessor_of_positive : forall n, 1 <= n ->  exists p:nat, n = S p.
+Proof.
+ intros n  H; case H.
+ exists 0; trivial.
+ intros m Hm; exists m;trivial.
+Qed.
+
+Definition Vtail_total 
+   (A : Set) (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).
+ intros A n v; case v.  
+ simpl.
+ exact (Vnil A).
+ simpl.
+ auto.
+Defined.
+
+(*
+Inductive Lambda : Set :=
+  lambda : (Lambda -> False) -> Lambda. 
+
+
+Error: Non strictly positive occurrence of "Lambda" in
+ "(Lambda -> False) -> Lambda"
+
+*)
+
+Section Paradox.
+ Variable Lambda : Set.
+ Variable lambda : (Lambda -> False) ->Lambda.
+
+ Variable matchL  : Lambda -> forall Q:Prop, ((Lambda ->False) -> Q) -> Q.
+ (*
+  understand matchL Q l (fun h : Lambda -> False => t)
+
+  as match l return Q with lambda h => t end 
+ *)
+
+ Definition application (f x: Lambda) :False :=
+   matchL f False (fun h => h x).
+
+ Definition Delta : Lambda := lambda (fun x : Lambda => application x x).
+
+ Definition loop : False := application Delta Delta.
+
+ Theorem two_is_three : 2 = 3.
+ Proof.
+  elim loop.
+ Qed.
+
+End Paradox.
+
+
+Require Import ZArith.
+
+
+
+Inductive itree : Set :=
+| ileaf : itree
+| inode : Z-> (nat -> itree) -> itree.
+
+Definition isingle l := inode l (fun i => ileaf).
+
+Definition t1 := inode 0 (fun n => isingle (Z_of_nat (2*n))).
+
+Definition t2 := inode 0 
+                      (fun n : nat => 
+                               inode (Z_of_nat n)
+                                     (fun p => isingle (Z_of_nat (n*p)))).
+
+
+Inductive itree_le : itree-> itree -> Prop :=
+  | le_leaf : forall t, itree_le  ileaf t
+  | le_node  : forall l l' s s', 
+                       Zle l l' -> 
+                      (forall i, exists j:nat, itree_le (s i) (s' j)) -> 
+                      itree_le  (inode  l s) (inode  l' s').
+
+
+Theorem itree_le_trans : 
+  forall t t', itree_le t t' ->
+               forall t'', itree_le t' t'' -> itree_le t t''.
+ induction t.
+ constructor 1.
+ 
+ intros t'; case t'.
+ inversion 1.
+ intros z0 i0 H0.
+ intro t'';case t''.
+ inversion 1.
+ intros.
+ inversion_clear H1.
+ constructor 2.
+ inversion_clear H0;eauto with zarith.
+ inversion_clear H0.
+ intro i2; case (H4 i2).
+ intros.
+ generalize (H i2 _ H0). 
+ intros.
+ case (H3 x);intros.
+ generalize (H5 _ H6).
+ exists x0;auto.
+Qed.
+
+ 
+
+Inductive itree_le' : itree-> itree -> Prop :=
+  | le_leaf' : forall t, itree_le'  ileaf t
+  | le_node' : forall l l' s s' g, 
+                       Zle l l' ->  
+                      (forall i, itree_le' (s i) (s' (g i))) -> 
+                       itree_le'  (inode  l s) (inode  l' s').
+
+
+
+
+
+Lemma t1_le_t2 : itree_le t1 t2.
+ unfold t1, t2.
+ constructor.
+ auto with zarith.
+ intro i; exists (2 * i).
+ unfold isingle. 
+ constructor.
+ auto with zarith.
+ exists i;constructor.
+Qed.
+
+
+
+Lemma t1_le'_t2 :  itree_le' t1 t2.
+ unfold t1, t2.
+ constructor 2  with (fun i : nat => 2 * i).
+ auto with zarith.
+ unfold isingle;
+ intro i ; constructor 2 with (fun i :nat => i).
+ auto with zarith.
+ constructor .
+Qed.
+
+
+Require Import List.
+
+Inductive ltree  (A:Set) : Set :=  
+          lnode   : A -> list (ltree A) -> ltree A.
+
+Inductive prop : Prop :=
+ prop_intro : Prop -> prop.
+
+Lemma prop_inject: prop.
+Proof prop_intro prop.
+
+
+Inductive ex_Prop  (P : Prop -> Prop) : Prop :=
+  exP_intro : forall X : Prop, P X -> ex_Prop P.
+
+Lemma ex_Prop_inhabitant : ex_Prop (fun P => P -> P).
+Proof.
+  exists (ex_Prop (fun P => P -> P)).
+ trivial.
+Qed.
+
+
+
+
+(*
+
+Check (fun (P:Prop->Prop)(p: ex_Prop P) =>
+      match p with exP_intro X HX => X end).
+Error:
+Incorrect elimination of "p" in the inductive type  
+"ex_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
+
+*)
+
+(*
+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. 
+
+Definition typ_inject: typ.
+split. 
+exact typ.
+(*
+Defined.
+
+Error: Universe Inconsistency.
+*)
+Abort.
+(*
+
+Inductive aSet : Set :=
+  aSet_intro: Set -> aSet.
+
+
+User error: Large non-propositional inductive types must be in Type
+
+*)
+
+Inductive ex_Set  (P : Set -> Prop) : Type :=
+  exS_intro : forall X : Set, P X -> ex_Set P.
+
+
+Inductive comes_from_the_left (P Q:Prop): P \/ Q -> Prop :=
+  c1 : forall p, comes_from_the_left P Q (or_introl (A:=P) Q p).
+
+Goal (comes_from_the_left _ _ (or_introl  True I)).
+split.
+Qed.
+
+Goal ~(comes_from_the_left _ _ (or_intror True I)).
+ red;inversion 1.
+ (* discriminate H0.
+ *)
+Abort.
+
+Reset comes_from_the_left.
+
+(*
+
+
+
+
+
+
+ Definition comes_from_the_left (P Q:Prop)(H:P \/ Q): Prop :=
+  match H with
+         |  or_introl p => True 
+         |  or_intror q => False
+  end.
+
+Error:
+Incorrect elimination of "H" in the inductive type  
+"or", 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
+
+*)
+
+Definition comes_from_the_left_sumbool
+            (P Q:Prop)(x:{P}+{Q}): Prop :=
+  match x with
+         |  left  p => True 
+         |  right q => False
+  end.
+
+
+
+                    
+Close Scope Z_scope.
+
+
+
+
+
+Theorem S_is_not_O : forall n, S n <> 0. 
+
+Definition Is_zero (x:nat):= match x with 
+                                     | 0 => True  
+                                     | _ => False
+                             end.
+ Lemma O_is_zero : forall m, m = 0 -> Is_zero m.
+ Proof.
+  intros m H; subst m.
+  (*  
+  ============================
+   Is_zero 0
+  *)
+  simpl;trivial.
+ Qed.
+ 
+ red; intros n Hn.
+ apply O_is_zero with (m := S n).
+ assumption.
+Qed.
+
+Theorem disc2 : forall n, S (S n) <> 1. 
+Proof.
+ intros n Hn; discriminate.
+Qed.
+
+
+Theorem disc3 : forall n, S (S n) = 0 -> forall Q:Prop, Q.
+Proof.
+  intros n Hn Q.
+  discriminate.
+Qed.
+
+
+
+Theorem inj_succ  : forall n m, S n = S m -> n = m.
+Proof.
+ 
+
+Lemma inj_pred : forall n m, n = m -> pred n = pred m.
+Proof.
+ intros n m eq_n_m.
+ rewrite eq_n_m.
+ trivial.
+Qed.
+
+ intros n m eq_Sn_Sm.
+ 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),
+                     a :: b :: l = b :: a :: l' -> a = b /\ l = l'.
+Proof.
+ intros A a b l l' e.
+ injection e.
+ auto.
+Qed.
+
+
+Theorem not_le_Sn_0 : forall n:nat, ~ (S n <= 0).
+Proof.
+ red; intros n H.
+ case H.
+Undo.
+
+Lemma not_le_Sn_0_with_constraints :
+  forall n p , S n <= p ->  p = 0 -> False.
+Proof.
+ intros n p H; case H ;
+   intros; discriminate.
+Qed.
+   
+eapply not_le_Sn_0_with_constraints; eauto.
+Qed. 
+
+
+Theorem not_le_Sn_0' : forall n:nat, ~ (S n <= 0).
+Proof.
+ red; intros n H ; inversion H.
+Qed.
+
+Derive Inversion le_Sn_0_inv with (forall n :nat, S n <=  0).
+Check le_Sn_0_inv.
+
+Theorem le_Sn_0'' : forall n p : nat, ~ S n <= 0 .
+Proof.
+ intros n p H; 
+ inversion H using le_Sn_0_inv.
+Qed.
+
+Derive Inversion_clear le_Sn_0_inv' with (forall n :nat, S n <=  0).
+Check le_Sn_0_inv'.
+
+
+Theorem le_reverse_rules : 
+ forall n m:nat, n <= m -> 
+                   n = m \/  
+                   exists p, n <=  p /\ m = S p.
+Proof.
+  intros n m H; inversion H.
+  left;trivial.
+  right; exists m0; split; trivial.
+Restart.
+  intros n m H; inversion_clear H.
+  left;trivial.
+  right; exists m0; split; trivial.
+Qed.
+
+Inductive ArithExp : Set :=
+     Zero : ArithExp 
+   | Succ : ArithExp -> ArithExp
+   | Plus : ArithExp -> ArithExp -> ArithExp.
+
+Inductive RewriteRel : ArithExp -> ArithExp -> Prop :=
+     RewSucc  : forall e1 e2 :ArithExp,
+                  RewriteRel e1 e2 -> RewriteRel (Succ e1) (Succ e2) 
+  |  RewPlus0 : forall e:ArithExp,
+                  RewriteRel (Plus Zero e) e 
+  |  RewPlusS : forall e1 e2:ArithExp,
+                  RewriteRel e1 e2 ->
+                  RewriteRel (Plus (Succ e1) e2) (Succ (Plus e1 e2)).
+
+
+  
+Fixpoint plus (n p:nat) {struct n} : nat :=
+  match n with
+          | 0 => p
+          | S m => S (plus m p)
+ end.
+
+Fixpoint plus' (n p:nat) {struct p} : nat :=
+    match p with
+          | 0 => n
+          | S q => S (plus' n q)
+    end.
+
+Fixpoint plus'' (n p:nat) {struct n} : nat :=
+  match n with
+          | 0 => p
+          | S m => plus'' m (S p)
+ end.
+
+
+Fixpoint even_test (n:nat) : bool :=
+  match n 
+  with 0 =>  true
+     | 1 =>  false
+     | S (S p) => even_test p
+  end.
+
+
+Reset even_test.
+
+Fixpoint even_test (n:nat) : bool :=
+  match n 
+  with 
+      | 0 =>  true
+      | S p => odd_test p
+  end
+with odd_test (n:nat) : bool :=
+  match n
+  with 
+     | 0 => false
+     | S p => even_test p
+ end.
+
+
+  
+Eval simpl in even_test.
+
+
+
+Eval simpl in (fun x : nat => even_test x).
+
+Eval simpl in (fun x : nat => plus 5 x).
+Eval simpl in (fun x : nat => even_test (plus 5 x)).
+
+Eval simpl in (fun x : nat => even_test (plus x 5)).
+
+
+Section Principle_of_Induction.
+Variable    P               : nat -> Prop.
+Hypothesis  base_case       : P 0.
+Hypothesis  inductive_step   : forall n:nat, P n -> P (S n).
+Fixpoint nat_ind  (n:nat)    : (P n) := 
+   match n return P n with
+          | 0 => base_case
+          | S m => inductive_step m (nat_ind m)
+   end. 
+
+End Principle_of_Induction.
+
+Scheme Even_induction := Minimality for even Sort Prop
+with   Odd_induction  := Minimality for odd  Sort Prop.
+
+Theorem even_plus_four : forall n:nat, even n -> even (4+n).
+Proof.
+ intros n H.
+ elim H using Even_induction with (P0 := fun n => odd (4+n));
+ simpl;repeat constructor;assumption.
+Qed.
+
+
+Section Principle_of_Double_Induction.
+Variable    P               : nat -> nat ->Prop.
+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_ind (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_ind x y)
+     end.
+End Principle_of_Double_Induction.
+
+Section Principle_of_Double_Recursion.
+Variable    P               : nat -> nat -> Set.
+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 := 
+  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)
+     end.
+End Principle_of_Double_Recursion.
+
+Definition min : nat -> nat -> nat  := 
+  nat_double_rec (fun (x y:nat) => nat)
+                 (fun (x:nat) => 0)
+                 (fun (y:nat) => 0)
+                 (fun (x y r:nat) => S r).
+
+Eval compute in (min 5 8).
+Eval compute in (min 8 5).
+
+
+
+Lemma not_circular : forall n:nat, n <> S n.
+Proof.
+ intro n.
+ apply nat_ind with (P:= fun n => n <> S n).
+ discriminate.
+ red; intros n0 Hn0 eqn0Sn0;injection eqn0Sn0;trivial.
+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}).
+Undo.
+ pattern p,n.
+ elim n using nat_double_rec.
+ destruct x; auto.
+ destruct x; auto.
+ intros n0 m H; case H.
+ intro eq; rewrite eq ; auto.
+ intro neg; right; red ; injection 1; auto.
+Defined.
+
+Definition eq_nat_dec' : forall n p:nat, {n=p}+{n <> p}.
+ decide equality.
+Defined.
+
+Print Acc.
+
+
+Require Import Minus.
+
+(*
+Fixpoint div (x y:nat){struct x}: nat :=
+ if eq_nat_dec x 0 
+  then 0
+  else if eq_nat_dec y 0
+       then x
+       else S (div (x-y) y).
+
+Error:
+Recursive definition of div is ill-formed.
+In environment
+div : nat -> nat -> nat
+x : nat
+y : nat
+_ : x <> 0
+_ : y <> 0
+
+Recursive call to div has principal argument equal to
+"x - y"
+instead of a subterm of x
+
+*)
+
+Lemma minus_smaller_S: forall x y:nat, x - y < S x.
+Proof.
+ intros x y; pattern y, x;
+ elim x using nat_double_ind.
+ destruct x0; auto with arith.
+ simpl; auto with arith.
+ simpl; auto with arith.
+Qed.
+
+Lemma minus_smaller_positive : forall x y:nat, x <>0 -> y <> 0 ->
+                                     x - y < x.
+Proof.
+ destruct x; destruct y; 
+ ( simpl;intros; apply minus_smaller_S || 
+   intros; absurd (0=0); auto).
+Qed.
+
+Definition minus_decrease : forall x y:nat, Acc lt x -> 
+                                         x <> 0 -> 
+                                         y <> 0 ->
+                                         Acc lt (x-y).
+Proof.
+ intros x y H; case H.
+ intros Hz posz posy. 
+ apply Hz; apply minus_smaller_positive; assumption.
+Defined.
+
+Print minus_decrease.
+
+
+
+Definition div_aux (x y:nat)(H: Acc lt x):nat.
+ fix 3.
+ intros.
+  refine (if eq_nat_dec x 0 
+         then 0 
+         else if eq_nat_dec y 0 
+              then y
+              else div_aux (x-y) y _).
+ apply (minus_decrease x y H);assumption. 
+Defined.
+
+
+Print div_aux.
+(*
+div_aux = 
+(fix div_aux (x y : nat) (H : Acc lt x) {struct H} : nat :=
+   match eq_nat_dec x 0 with
+   | left _ => 0
+   | right _ =>
+       match eq_nat_dec y 0 with
+       | left _ => y
+       | right _0 => div_aux (x - y) y (minus_decrease x y H _ _0)
+       end
+   end)
+     : forall x : nat, nat -> Acc lt x -> nat
+*)
+
+Require Import Wf_nat.
+Definition div x y := div_aux x y (lt_wf x). 
+
+Extraction div.
+(*
+let div x y =
+  div_aux x y
+*)
+
+Extraction div_aux.
+
+(*
+let rec div_aux x y =
+  match eq_nat_dec x O with
+    | Left -> O
+    | Right ->
+        (match eq_nat_dec y O with
+           | Left -> y
+           | Right -> div_aux (minus x y) y)
+*)
+
+Lemma vector0_is_vnil : forall (A:Set)(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), 
+                                  n= 0 -> v = Vnil A.
+
+Toplevel input, characters 40281-40287
+> Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:vector A n),                                    n= 0 -> v = Vnil A.
+>                                                                                                                 ^^^^^^
+Error: In environment
+A : Set
+n : nat
+v : vector A n
+e : n = 0
+The term "Vnil A" has type "vector A 0" while it is expected to have type
+ "vector A n"
+*)
+ Require Import JMeq.
+
+Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:vector A n), 
+                                  n= 0 -> JMeq v (Vnil A).
+Proof.
+ destruct v.
+ auto.
+ intro; discriminate.
+Qed.
+
+Lemma vector0_is_vnil : forall (A:Set)(v:vector A 0), v = Vnil A.
+Proof.
+ intros a v;apply JMeq_eq.
+ apply vector0_is_vnil_aux.
+ trivial.
+Qed.
+
+
+Implicit Arguments Vcons [A n].
+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.
+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:Set)(v:vector A 0) => v).
+
+
+
+Lemma Vid_eq : forall (n:nat) (A:Set)(v:vector A n), v=(Vid _ n v).
+Proof.
+ destruct v. 
+ reflexivity.
+ reflexivity.
+Defined.
+
+Theorem zero_nil : forall A (v:vector A 0), v = Vnil.
+Proof.
+ intros.
+ change (Vnil (A:=A)) with (Vid _ 0 v). 
+ apply Vid_eq.
+Defined.
+
+
+Theorem decomp :
+  forall (A : Set) (n : nat) (v : vector A (S n)),
+  v = Vcons (Vhead v) (Vtail v).
+Proof.
+ intros.
+ change (Vcons (Vhead v) (Vtail v)) with (Vid _  (S n) v).
+ apply Vid_eq.
+Defined.
+
+
+
+Definition vector_double_rect : 
+    forall (A:Set) (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)) ->
+        forall n (v1 v2 : vector A n), P n v1 v2.
+ induction n.
+ intros; rewrite (zero_nil _ v1); rewrite (zero_nil _ v2).
+ auto.
+ intros v1 v2; rewrite (decomp _ _ v1);rewrite (decomp _ _ v2).
+ apply X0; auto.
+Defined.
+
+Require Import Bool.
+
+Definition bitwise_or n v1 v2 : vector bool n :=
+   vector_double_rect bool  (fun n v1 v2 => vector bool n)
+                        Vnil
+                        (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}
+                  : option A :=
+  match n,v  with
+    _   , Vnil => None
+  | 0   , Vcons b  _ _ => Some b
+  | S n', Vcons _  p' v' => vector_nth A n'  p' v'
+  end.
+
+Implicit Arguments vector_nth [A p].
+
+
+Lemma nth_bitwise : forall (n:nat) (v1 v2: vector bool n) i  a b,
+      vector_nth i v1 = Some a ->
+      vector_nth i v2 = Some b ->
+      vector_nth i (bitwise_or _ v1 v2) = Some (orb a b).
+Proof.
+ intros  n v1 v2; pattern n,v1,v2.
+ apply vector_double_rect.
+ simpl.
+ destruct i; discriminate 1.
+ destruct i; simpl;auto.
+ injection 1; injection 2;intros; subst a; subst b; auto.
+Qed.
+
+ Set Implicit Arguments.
+
+ CoInductive Stream (A:Set) : Set   :=
+ |  Cons : A -> Stream A -> Stream A.
+
+ CoInductive LList (A: Set) : Set :=
+ |  LNil : LList A
+ |  LCons : A -> LList A -> LList A.
+
+
+ 
+
+
+ Definition head (A:Set)(s : Stream A) := match s with Cons a s' => a end.
+
+ Definition tail (A : Set)(s : Stream A) :=
+      match s with Cons a s' => s' end.
+
+ CoFixpoint repeat (A:Set)(a:A) : Stream A := Cons a (repeat a).
+
+ CoFixpoint iterate (A: Set)(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:=
+  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:Set)(a:A) => head (repeat a)).
+
+
+CoInductive EqSt (A: Set) : Stream A -> Stream A -> Prop :=
+  eqst : forall s1 s2: Stream A,
+      head s1 = head s2 ->
+      EqSt (tail s1) (tail s2) ->
+      EqSt s1 s2.
+
+
+Section Parks_Principle.
+Variable A : Set.
+Variable    R      : Stream A -> Stream A -> Prop.
+Hypothesis  bisim1 : forall s1 s2:Stream A, R s1 s2 ->
+                                          head s1 = head s2.
+Hypothesis  bisim2 : forall s1 s2:Stream A, R s1 s2 ->
+                                          R (tail s1) (tail s2).
+
+CoFixpoint park_ppl     : forall s1 s2:Stream A, R s1 s2 ->
+                                               EqSt s1 s2 :=
+ fun s1 s2 (p : R s1 s2) =>
+      eqst s1 s2 (bisim1  p) 
+                 (park_ppl  (bisim2  p)).
+End Parks_Principle.
+
+
+Theorem map_iterate : forall (A:Set)(f:A->A)(x:A),
+                       EqSt (iterate f (f x)) (map f (iterate f x)).
+Proof.
+ intros A f x.
+ apply park_ppl with
+   (R:=  fun s1 s2 => exists x: A, 
+                      s1 = iterate f (f x) /\ s2 = map f (iterate f x)).
+
+ intros s1 s2 (x0,(eqs1,eqs2));rewrite eqs1;rewrite eqs2;reflexivity.
+ intros s1 s2 (x0,(eqs1,eqs2)).
+ exists (f x0);split;[rewrite eqs1|rewrite eqs2]; reflexivity.
+ exists x;split; reflexivity.
+Qed.
+
+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),
+                       EqSt (iterate f (f x)) (map f (iterate f x)).
+infiniteproof map_iterate'.
+ reflexivity.
+Qed.
+
+
+Implicit Arguments LNil [A].
+
+Lemma Lnil_not_Lcons : forall (A:Set)(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),
+                       LCons a (LCons b l) = LCons b (LCons a l') ->
+                       a = b /\ l = l'.
+Proof.
+ intros A a b l l' e; injection e; auto.
+Qed.
+
+
+Inductive Finite (A:Set) : 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 :=
+| LCons_inf : forall a l, Infinite l -> Infinite (LCons a l).
+
+Lemma LNil_not_Infinite : forall (A:Set), ~ Infinite (LNil (A:=A)).
+Proof.
+  intros A H;inversion H.
+Qed.
+
+Lemma Finite_not_Infinite : forall (A:Set)(l:LList A),
+                                Finite l -> ~ Infinite l.
+Proof.
+ intros A l H; elim H.
+ apply LNil_not_Infinite.
+ intros a l0 F0 I0' I1.
+ case I0'; inversion_clear I1.
+ trivial.
+Qed.
+
+Lemma Not_Finite_Infinite : forall (A:Set)(l:LList A),
+                            ~ Finite l -> Infinite l.
+Proof.
+ cofix H.
+ destruct l.
+ intro; absurd (Finite (LNil (A:=A)));[auto|constructor].
+ constructor.
+ apply H.
+ red; intro H1;case H0.
+ constructor.
+ trivial.
+Qed.
+
+
+
+
diff --git a/test-suite/success/Record.v b/test-suite/success/Record.v
index f3a13634..7fdbcda7 100644
--- a/test-suite/success/Record.v
+++ b/test-suite/success/Record.v
@@ -1,3 +1,3 @@
 (* Nijmegen expects redefinition of sorts *)
 Definition CProp := Prop.
-Record test : CProp := { n:nat }.
+Record test : CProp :=  {n : nat}.
diff --git a/test-suite/success/Reg.v b/test-suite/success/Reg.v
index eaa0690c..89b3032c 100644
--- a/test-suite/success/Reg.v
+++ b/test-suite/success/Reg.v
@@ -1,136 +1,144 @@
-Require Reals.
+Require Import Reals.
 
-Axiom y : R->R.
-Axiom d_y : (derivable y).
-Axiom n_y : (x:R)``(y x)<>0``.
-Axiom dy_0 : (derive_pt y R0 (d_y R0)) == R1.
+Axiom y : R -> R.
+Axiom d_y : derivable y.
+Axiom n_y : forall x : R, y x <> 0%R.
+Axiom dy_0 : derive_pt y 0 (d_y 0%R) = 1%R.
 
-Lemma essai0 : (continuity_pt [x:R]``(x+2)/(y x)+x/(y x)`` R0).
-Assert H := d_y.
-Assert H0 := n_y.
-Reg.
+Lemma essai0 : continuity_pt (fun x : R => ((x + 2) / y x + x / y x)%R) 0.
+assert (H := d_y).
+assert (H0 := n_y).
+reg.
 Qed.
 
-Lemma essai1 : (derivable_pt [x:R]``/2*(sin x)`` ``1``).
-Reg.
+Lemma essai1 : derivable_pt (fun x : R => (/ 2 * sin x)%R) 1.
+reg.
 Qed.
 
-Lemma essai2 : (continuity [x:R]``(Rsqr x)*(cos (x*x))+x``).
-Reg.
+Lemma essai2 : continuity (fun x : R => (Rsqr x * cos (x * x) + x)%R).
+reg.
 Qed.
 
-Lemma essai3 : (derivable_pt [x:R]``x*((Rsqr x)+3)`` R0).
-Reg.
+Lemma essai3 : derivable_pt (fun x : R => (x * (Rsqr x + 3))%R) 0.
+reg.
 Qed.
 
-Lemma essai4 : (derivable [x:R]``(x+x)*(sin x)``).
-Reg.
+Lemma essai4 : derivable (fun x : R => ((x + x) * sin x)%R).
+reg.
 Qed.
 
-Lemma essai5 : (derivable [x:R]``1+(sin (2*x+3))*(cos (cos x))``).
-Reg.
+Lemma essai5 : derivable (fun x : R => (1 + sin (2 * x + 3) * cos (cos x))%R).
+reg.
 Qed.
 
-Lemma essai6 : (derivable [x:R]``(cos (x+3))``).
-Reg.
+Lemma essai6 : derivable (fun x : R => cos (x + 3)).
+reg.
 Qed.
 
-Lemma essai7 : (derivable_pt [x:R]``(cos (/(sqrt x)))*(Rsqr ((sin x)+1))`` R1).
-Reg.
-Apply Rlt_R0_R1.
-Red; Intro; Rewrite sqrt_1 in H; Assert H0 := R1_neq_R0; Elim H0; Assumption.
+Lemma essai7 :
+ derivable_pt (fun x : R => (cos (/ sqrt x) * Rsqr (sin x + 1))%R) 1.
+reg.
+apply Rlt_0_1.
+red in |- *; intro;  rewrite sqrt_1 in H; assert (H0 := R1_neq_R0); elim H0;
+ assumption.
 Qed.
 
-Lemma essai8 : (derivable_pt [x:R]``(sqrt ((Rsqr x)+(sin x)+1))`` R0).
-Reg.
-Rewrite sin_0.
-Rewrite Rsqr_O.
-Replace ``0+0+1`` with ``1``; [Apply Rlt_R0_R1 | Ring].
+Lemma essai8 : derivable_pt (fun x : R => sqrt (Rsqr x + sin x + 1)) 0.
+reg.
+ rewrite sin_0.
+ rewrite Rsqr_0.
+ replace (0 + 0 + 1)%R with 1%R; [ apply Rlt_0_1 |  ring ].
 Qed.
 
-Lemma essai9 : (derivable_pt (plus_fct id sin) R1).
-Reg.
+Lemma essai9 : derivable_pt (id + sin) 1.
+reg.
 Qed.
 
-Lemma essai10 : (derivable_pt [x:R]``x+2`` R0).
-Reg.
+Lemma essai10 : derivable_pt (fun x : R => (x + 2)%R) 0.
+reg.
 Qed.
 
-Lemma essai11 : (derive_pt [x:R]``x+2`` R0 essai10)==R1.
-Reg.
+Lemma essai11 : derive_pt (fun x : R => (x + 2)%R) 0 essai10 = 1%R.
+reg.
 Qed.
 
-Lemma essai12 : (derivable [x:R]``x+(Rsqr (x+2))``).
-Reg.
+Lemma essai12 : derivable (fun x : R => (x + Rsqr (x + 2))%R).
+reg.
 Qed.
 
-Lemma essai13 : (derive_pt [x:R]``x+(Rsqr (x+2))`` R0 (essai12 R0)) == ``5``.
-Reg.
+Lemma essai13 :
+ derive_pt (fun x : R => (x + Rsqr (x + 2))%R) 0 (essai12 0%R) = 5%R.
+reg.
 Qed.
 
-Lemma essai14 : (derivable_pt [x:R]``2*x+x`` ``2``).
-Reg.
+Lemma essai14 : derivable_pt (fun x : R => (2 * x + x)%R) 2.
+reg.
 Qed.
 
-Lemma essai15 : (derive_pt [x:R]``2*x+x`` ``2`` essai14) == ``3``.
-Reg.
+Lemma essai15 : derive_pt (fun x : R => (2 * x + x)%R) 2 essai14 = 3%R.
+reg.
 Qed.
 
-Lemma essai16 : (derivable_pt [x:R]``x+(sin x)`` R0).
-Reg.
+Lemma essai16 : derivable_pt (fun x : R => (x + sin x)%R) 0.
+reg.
 Qed.
 
-Lemma essai17 : (derive_pt [x:R]``x+(sin x)`` R0 essai16)==``2``.
-Reg.
-Rewrite cos_0.
-Reflexivity.
+Lemma essai17 : derive_pt (fun x : R => (x + sin x)%R) 0 essai16 = 2%R.
+reg.
+ rewrite cos_0.
+reflexivity.
 Qed.
 
-Lemma essai18 : (derivable_pt [x:R]``x+(y x)`` ``0``).
-Assert H := d_y.
-Reg.
+Lemma essai18 : derivable_pt (fun x : R => (x + y x)%R) 0.
+assert (H := d_y).
+reg.
 Qed.
 
-Lemma essai19 : (derive_pt [x:R]``x+(y x)`` ``0`` essai18) == ``2``.
-Assert H := dy_0.
-Assert H0 := d_y.
-Reg.
+Lemma essai19 : derive_pt (fun x : R => (x + y x)%R) 0 essai18 = 2%R.
+assert (H := dy_0).
+assert (H0 := d_y).
+reg.
 Qed.
 
-Axiom z:R->R.
-Axiom d_z: (derivable z).
+Axiom z : R -> R.
+Axiom d_z : derivable z.
 
-Lemma essai20 : (derivable_pt [x:R]``(z (y x))`` R0).
-Reg.
-Apply d_y.
-Apply d_z.
+Lemma essai20 : derivable_pt (fun x : R => z (y x)) 0.
+reg.
+apply d_y.
+apply d_z.
 Qed.
 
-Lemma essai21 : (derive_pt [x:R]``(z (y x))`` R0 essai20) == R1.
-Assert H := dy_0.
-Reg.
+Lemma essai21 : derive_pt (fun x : R => z (y x)) 0 essai20 = 1%R.
+assert (H := dy_0).
+reg.
 Abort.
 
-Lemma essai22 : (derivable [x:R]``(sin (z x))+(Rsqr (z x))/(y x)``).
-Assert H := d_y.
-Reg.
-Apply n_y.
-Apply d_z.
+Lemma essai22 : derivable (fun x : R => (sin (z x) + Rsqr (z x) / y x)%R).
+assert (H := d_y).
+reg.
+apply n_y.
+apply d_z.
 Qed.
 
 (* Pour tester la continuite de sqrt en 0 *)
-Lemma essai23 : (continuity_pt [x:R]``(sin (sqrt (x-1)))+(exp (Rsqr ((sqrt x)+3)))`` R1).
-Reg.
-Left; Apply Rlt_R0_R1.
-Right; Unfold Rminus; Rewrite Rplus_Ropp_r; Reflexivity.
-Qed.
-
-Lemma essai24 : (derivable [x:R]``(sqrt (x*x+2*x+2))+(Rabsolu (x*x+1))``).
-Reg.
-Replace ``x*x+2*x+2`` with ``(Rsqr (x+1))+1``.
-Apply ge0_plus_gt0_is_gt0; [Apply pos_Rsqr | Apply Rlt_R0_R1].
-Unfold Rsqr; Ring.
-Red; Intro; Cut ``0<x*x+1``.
-Intro; Rewrite H in H0; Elim (Rlt_antirefl ? H0).
-Apply ge0_plus_gt0_is_gt0; [Replace ``x*x`` with (Rsqr x); [Apply pos_Rsqr | Reflexivity] | Apply Rlt_R0_R1].
+Lemma essai23 :
+ continuity_pt
+   (fun x : R => (sin (sqrt (x - 1)) + exp (Rsqr (sqrt x + 3)))%R) 1.
+reg.
+left; apply Rlt_0_1.
+right; unfold Rminus in |- *;  rewrite Rplus_opp_r; reflexivity.
+Qed.
+
+Lemma essai24 :
+ derivable (fun x : R => (sqrt (x * x + 2 * x + 2) + Rabs (x * x + 1))%R).
+reg.
+ replace (x * x + 2 * x + 2)%R with (Rsqr (x + 1) + 1)%R.
+apply Rplus_le_lt_0_compat; [ apply Rle_0_sqr | apply Rlt_0_1 ].
+unfold Rsqr in |- *;  ring.
+red in |- *; intro; cut (0 < x * x + 1)%R.
+intro;  rewrite H in H0; elim (Rlt_irrefl _ H0).
+apply Rplus_le_lt_0_compat;
+ [  replace (x * x)%R with (Rsqr x); [ apply Rle_0_sqr | reflexivity ]
+ | apply Rlt_0_1 ].
 Qed.
diff --git a/test-suite/success/Rename.v b/test-suite/success/Rename.v
index edb20a81..0576f3c6 100644
--- a/test-suite/success/Rename.v
+++ b/test-suite/success/Rename.v
@@ -1,5 +1,18 @@
-Goal (n:nat)(n=O)->(n=O).
-Intros.
-Rename n into p.
-NewInduction p; Auto.
+Goal forall n : nat, n = 0 -> n = 0.
+intros.
+rename n into p.
+induction p; auto.
 Qed.
+
+(* Submitted by Iris Loeb (#842) *)
+
+Section rename.
+
+Variable A:Prop.
+
+Lemma Tauto: A->A.
+rename A into B.
+tauto.
+Qed.
+
+End rename.
diff --git a/test-suite/success/Require.v b/test-suite/success/Require.v
index 654808fc..f851d8c7 100644
--- a/test-suite/success/Require.v
+++ b/test-suite/success/Require.v
@@ -1,3 +1,3 @@
-Require Coq.Arith.Plus.
-Read Module Coq.Arith.Minus.
+Require Import Coq.Arith.Plus.
+Require Coq.Arith.Minus.
 Locate Library Coq.Arith.Minus.
diff --git a/test-suite/success/Reset.v b/test-suite/success/Reset.v
new file mode 100644
index 00000000..b71ea69d
--- /dev/null
+++ b/test-suite/success/Reset.v
@@ -0,0 +1,7 @@
+(* Check Reset Section *)
+
+Section A.
+Definition B := Prop.
+End A.
+
+Reset A.
diff --git a/test-suite/success/Simplify_eq.v b/test-suite/success/Simplify_eq.v
index 41aa77ef..5b856e3d 100644
--- a/test-suite/success/Simplify_eq.v
+++ b/test-suite/success/Simplify_eq.v
@@ -2,12 +2,12 @@
 
 (* Check that Simplify_eq tries Intro until *)
 
-Lemma l1 : O=(S O)->False.   
-Simplify_eq 1.
+Lemma l1 : 0 = 1 -> False.   
+ simplify_eq 1.
 Qed.
 
-Lemma l2 : (x:nat)(H:(S x)=(S (S x)))H==H->False.   
-Simplify_eq H.
-Intros.
-Apply (n_Sn x H0).
+Lemma l2 : forall (x : nat) (H : S x = S (S x)), H = H -> False.   
+ simplify_eq H.
+intros.
+apply (n_Sn x H0).
 Qed.
diff --git a/test-suite/success/Tauto.v b/test-suite/success/Tauto.v
index 883a82ab..f0809839 100644
--- a/test-suite/success/Tauto.v
+++ b/test-suite/success/Tauto.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Tauto.v,v 1.10.8.1 2004/07/16 19:30:59 herbelin Exp $ *)
+(* $Id: Tauto.v 7693 2005-12-21 23:50:17Z herbelin $ *)
 
 (**** Tactics Tauto and Intuition ****)
 
@@ -18,183 +18,186 @@
   Simplifications of goals, based on LJT* calcul ****)
 
 (**** Examples of intuitionistic tautologies ****)
-Parameter A,B,C,D,E,F:Prop.
-Parameter even:nat -> Prop.
-Parameter P:nat -> Prop.
+Parameter A B C D E F : Prop.
+Parameter even : nat -> Prop.
+Parameter P : nat -> Prop.
 
-Lemma Ex_Wallen:(A->(B/\C)) -> ((A->B)\/(A->C)).
+Lemma Ex_Wallen : (A -> B /\ C) -> (A -> B) \/ (A -> C).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma Ex_Klenne:~(~(A \/ ~A)).
+Lemma Ex_Klenne : ~ ~ (A \/ ~ A).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma Ex_Klenne':(n:nat)(~(~((even n) \/ ~(even n)))).
+Lemma Ex_Klenne' : forall n : nat, ~ ~ (even n \/ ~ even n).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma Ex_Klenne'':~(~(((n:nat)(even n)) \/ ~((m:nat)(even m)))).
+Lemma Ex_Klenne'' :
+ ~ ~ ((forall n : nat, even n) \/ ~ (forall m : nat, even m)).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma tauto:((x:nat)(P x)) -> ((y:nat)(P y)).
+Lemma tauto : (forall x : nat, P x) -> forall y : nat, P y.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma tauto1:(A -> A).
+Lemma tauto1 : A -> A.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma tauto2:(A -> B -> C) -> (A -> B) -> A -> C.
+Lemma tauto2 : (A -> B -> C) -> (A -> B) -> A -> C.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma a:(x0: (A \/ B))(x1:(B /\ C))(A -> B).
+Lemma a : forall (x0 : A \/ B) (x1 : B /\ C), A -> B.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma a2:((A -> (B /\ C)) -> ((A -> B) \/ (A -> C))).
+Lemma a2 : (A -> B /\ C) -> (A -> B) \/ (A -> C).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma a4:(~A -> ~A).
+Lemma a4 : ~ A -> ~ A.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma e2:~(~(A \/ ~A)).
+Lemma e2 : ~ ~ (A \/ ~ A).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma e4:~(~((A \/ B) -> (A \/ B))).
+Lemma e4 : ~ ~ (A \/ B -> A \/ B).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y0:(x0:A)(x1: ~A)(x2:(A -> B))(x3:(A \/ B))(x4:(A /\ B))(A -> False).
+Lemma y0 :
+ forall (x0 : A) (x1 : ~ A) (x2 : A -> B) (x3 : A \/ B) (x4 : A /\ B),
+ A -> False.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y1:(x0:((A /\ B) /\ C))B.
+Lemma y1 : forall x0 : (A /\ B) /\ C, B.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y2:(x0:A)(x1:B)(C \/ B).
+Lemma y2 : forall (x0 : A) (x1 : B), C \/ B.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y3:(x0:(A /\ B))(B /\ A).
+Lemma y3 : forall x0 : A /\ B, B /\ A.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y5:(x0:(A \/ B))(B \/ A).
+Lemma y5 : forall x0 : A \/ B, B \/ A.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y6:(x0:(A -> B))(x1:A) B.
+Lemma y6 : forall (x0 : A -> B) (x1 : A), B.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y7:(x0 : ((A /\ B) -> C))(x1 : B)(x2 : A) C.
+Lemma y7 : forall (x0 : A /\ B -> C) (x1 : B) (x2 : A), C.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y8:(x0 : ((A \/ B) -> C))(x1 : A) C.
+Lemma y8 : forall (x0 : A \/ B -> C) (x1 : A), C.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y9:(x0 : ((A \/ B) -> C))(x1 : B) C.
+Lemma y9 : forall (x0 : A \/ B -> C) (x1 : B), C.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
-Lemma y10:(x0 : ((A -> B) -> C))(x1 : B) C.
+Lemma y10 : forall (x0 : (A -> B) -> C) (x1 : B), C.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* This example took much time with the old version of Tauto *)
-Lemma critical_example0:(~~B->B)->(A->B)->~~A->B.
+Lemma critical_example0 : (~ ~ B -> B) -> (A -> B) -> ~ ~ A -> B.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* Same remark as previously *)
-Lemma critical_example1:(~~B->B)->(~B->~A)->~~A->B.
+Lemma critical_example1 : (~ ~ B -> B) -> (~ B -> ~ A) -> ~ ~ A -> B.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* This example took very much time (about 3mn on a PIII 450MHz in bytecode)
    with the old Tauto. Now, it's immediate (less than 1s). *)
-Lemma critical_example2:(~A<->B)->(~B<->A)->(~~A<->A).
+Lemma critical_example2 : (~ A <-> B) -> (~ B <-> A) -> (~ ~ A <-> A).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* This example was a bug *)
-Lemma old_bug0:(~A<->B)->(~(C\/E)<->D/\F)->~(C\/A\/E)<->D/\B/\F.
+Lemma old_bug0 :
+ (~ A <-> B) -> (~ (C \/ E) <-> D /\ F) -> (~ (C \/ A \/ E) <-> D /\ B /\ F).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* Another bug *)
-Lemma old_bug1:((A->B->False)->False) -> (B->False) -> False.
+Lemma old_bug1 : ((A -> B -> False) -> False) -> (B -> False) -> False.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* A bug again *)
-Lemma old_bug2:
-  ((((C->False)->A)->((B->False)->A)->False)->False) ->
-  (((C->B->False)->False)->False) ->
-  ~A->A.
+Lemma old_bug2 :
+ ((((C -> False) -> A) -> ((B -> False) -> A) -> False) -> False) ->
+ (((C -> B -> False) -> False) -> False) -> ~ A -> A.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* A bug from CNF form *)
-Lemma old_bug3:
-  ((~A\/B)/\(~B\/B)/\(~A\/~B)/\(~B\/~B)->False)->~((A->B)->B)->False.
+Lemma old_bug3 :
+ ((~ A \/ B) /\ (~ B \/ B) /\ (~ A \/ ~ B) /\ (~ B \/ ~ B) -> False) ->
+ ~ ((A -> B) -> B) -> False.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* sometimes, the behaviour of Tauto depends on the order of the hyps *)
-Lemma old_bug3bis:
-  ~((A->B)->B)->((~B\/~B)/\(~B\/~A)/\(B\/~B)/\(B\/~A)->False)->False.
+Lemma old_bug3bis :
+ ~ ((A -> B) -> B) ->
+ ((~ B \/ ~ B) /\ (~ B \/ ~ A) /\ (B \/ ~ B) /\ (B \/ ~ A) -> False) -> False.
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 (* A bug found by Freek Wiedijk <freek@cs.kun.nl> *)
-Lemma new_bug:
- ((A<->B)->(B<->C)) ->
- ((B<->C)->(C<->A)) ->
- ((C<->A)->(A<->B)) ->
- (A<->B).
+Lemma new_bug :
+ ((A <-> B) -> (B <-> C)) ->
+ ((B <-> C) -> (C <-> A)) -> ((C <-> A) -> (A <-> B)) -> (A <-> B).
 Proof.
-  Tauto.
-Save.
+   tauto.
+Qed.
 
 
 (*  A private club has the following rules :
@@ -211,30 +214,31 @@ Save.
 
 Section club.
 
-Variable Scottish, RedSocks, WearKilt, Married, GoOutSunday : Prop.
+Variable Scottish RedSocks WearKilt Married GoOutSunday : Prop.
 
-Hypothesis rule1 : ~Scottish -> RedSocks.
-Hypothesis rule2 : WearKilt \/ ~RedSocks.
-Hypothesis rule3 : Married -> ~GoOutSunday.
+Hypothesis rule1 : ~ Scottish -> RedSocks.
+Hypothesis rule2 : WearKilt \/ ~ RedSocks.
+Hypothesis rule3 : Married -> ~ GoOutSunday.
 Hypothesis rule4 : GoOutSunday <-> Scottish.
-Hypothesis rule5 : WearKilt -> (Scottish /\ Married).
+Hypothesis rule5 : WearKilt -> Scottish /\ Married.
 Hypothesis rule6 : Scottish -> WearKilt.
 
 Lemma NoMember : False.
-Tauto.
-Save.
+ tauto.
+Qed.
 
 End club.
 
 (**** Use of Intuition ****)
-Lemma intu0:(((x:nat)(P x)) /\ B) ->
-              (((y:nat)(P y)) /\ (P O)) \/ (B /\ (P O)).
+Lemma intu0 :
+ (forall x : nat, P x) /\ B -> (forall y : nat, P y) /\ P 0 \/ B /\ P 0.
 Proof.
-  Intuition.
-Save.
+   intuition.
+Qed.
 
-Lemma intu1:((A:Prop)A\/~A)->(x,y:nat)(x=y\/~x=y).
+Lemma intu1 :
+ (forall A : Prop, A \/ ~ A) -> forall x y : nat, x = y \/ x <> y.
 Proof.
-  Intuition.
-Save.
+   intuition.
+Qed.
 
diff --git a/test-suite/success/TestRefine.v b/test-suite/success/TestRefine.v
index ee3d7e3f..82c5cf2e 100644
--- a/test-suite/success/TestRefine.v
+++ b/test-suite/success/TestRefine.v
@@ -6,27 +6,32 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* Petit bench vite fait, mal fait *)
-
-Require Refine.
-
-
 (************************************************************************)
 
-Lemma essai : (x:nat)x=x.
+Lemma essai : forall x : nat, x = x.
 
-Refine (([x0:nat]Cases x0 of
-    O => ?
-  | (S p) => ?
-  end) :: (x:nat)x=x).  (* x0=x0 et x0=x0 *)
+ refine
+ ((fun x0 : nat => match x0 with
+                   | O => _
+                   | S p => _
+                   end)
+  :forall x : nat, x = x).  (* x0=x0 et x0=x0 *)
 
 Restart.
 
-Refine [x0:nat]<[n:nat]n=n>Case x0 of ? [p:nat]? end. (* OK *)
+ refine
+ (fun x0 : nat => match x0 as n return (n = n) with
+                  | O => _
+                  | S p => _
+                  end). (* OK *)
 
 Restart.
 
-Refine [x0:nat]<[n:nat]n=n>Cases x0 of O => ? | (S p) => ? end. (* OK *)
+ refine
+ (fun x0 : nat => match x0 as n return (n = n) with
+                  | O => _
+                  | S p => _
+                  end). (* OK *)
 
 Restart.
 
@@ -41,55 +46,66 @@ Abort.
 
 Lemma T : nat. 
 
-Refine (S ?).
+ refine (S _).
 
 Abort.
 
 
 (************************************************************************)
 
-Lemma essai2 : (x:nat)x=x.
+Lemma essai2 : forall x : nat, x = x.
 
-Refine Fix f{f/1 : (x:nat)x=x := [x:nat]? }.
+ refine (fix f (x : nat) : x = x := _).
 
 Restart.
 
-Refine Fix f{f/1 : (x:nat)x=x :=
-  [x:nat]<[n:nat](eq nat n n)>Case x of ? [p:nat]? end}.
+ refine
+ (fix f (x : nat) : x = x :=
+    match x as n return (n = n :>nat) with
+    | O => _
+    | S p => _
+    end).
 
 Restart.
 
-Refine Fix f{f/1 : (x:nat)x=x :=
-  [x:nat]<[n:nat]n=n>Cases x of O => ? | (S p) => ? end}.
+ refine
+ (fix f (x : nat) : x = x :=
+    match x as n return (n = n) with
+    | O => _
+    | S p => _
+    end).
 
 Restart.
 
-Refine Fix f{f/1 : (x:nat)x=x :=
-  [x:nat]<[n:nat](eq nat n n)>Case x of
-       ?
-       [p:nat](f_equal nat nat S p p ?) end}.
+ refine
+ (fix f (x : nat) : x = x :=
+    match x as n return (n = n :>nat) with
+    | O => _
+    | S p => f_equal S _
+    end).
 
 Restart.
 
-Refine Fix f{f/1 : (x:nat)x=x :=
-  [x:nat]<[n:nat](eq nat n n)>Cases x of
-       O => ?
-     | (S p) =>(f_equal nat nat S p p ?) end}.
+ refine
+ (fix f (x : nat) : x = x :=
+    match x as n return (n = n :>nat) with
+    | O => _
+    | S p => f_equal S _
+    end).
 
 Abort.
 
 
 (************************************************************************)
+Parameter f : nat * nat -> nat -> nat. 
 
 Lemma essai : nat.
 
-Parameter f : nat*nat -> nat -> nat. 
-
-Refine (f ? ([x:nat](? :: nat) O)).
+ refine (f _ ((fun x : nat => _:nat) 0)).
 
 Restart.
 
-Refine (f ? O).
+ refine (f _ 0).
 
 Abort.
 
@@ -98,93 +114,113 @@ Abort.
 
 Parameter P : nat -> Prop.
 
-Lemma essai : { x:nat | x=(S O) }.
+Lemma essai : {x : nat | x = 1}.
 
-Refine (exist nat ? (S O) ?).  (* ECHEC *)
+ refine (exist _ 1 _).  (* ECHEC *)
 
 Restart.
 
 (* mais si on contraint par le but alors ca marche : *)
 (* Remarque : on peut toujours faire ça *)
-Refine ((exist nat ? (S O) ?) :: { x:nat | x=(S O) }).
+ refine (exist _ 1 _:{x : nat | x = 1}).
 
 Restart.
 
-Refine (exist nat [x:nat](x=(S O)) (S O) ?).
+ refine (exist (fun x : nat => x = 1) 1 _).
 
 Abort.
 
 
 (************************************************************************)
 
-Lemma essai : (n:nat){ x:nat | x=(S n) }.
+Lemma essai : forall n : nat, {x : nat | x = S n}.
 
-Refine [n:nat]<[n:nat]{x:nat|x=(S n)}>Case n of ? [p:nat]? end.
+ refine
+ (fun n : nat =>
+  match n return {x : nat | x = S n} with
+  | O => _
+  | S p => _
+  end).
 
 Restart.
 
-Refine (([n:nat]Case n of ? [p:nat]? end) :: (n:nat){ x:nat | x=(S n) }).
+ refine
+ ((fun n : nat => match n with
+                  | O => _
+                  | S p => _
+                  end)
+  :forall n : nat, {x : nat | x = S n}).
 
 Restart.
 
-Refine [n:nat]<[n:nat]{x:nat|x=(S n)}>Cases n of O => ? | (S p) => ? end.
+ refine
+ (fun n : nat =>
+  match n return {x : nat | x = S n} with
+  | O => _
+  | S p => _
+  end).
 
 Restart.
 
-Refine Fix f{f/1 :(n:nat){x:nat|x=(S n)} :=
-        [n:nat]<[n:nat]{x:nat|x=(S n)}>Case n of ? [p:nat]? end}.
+ refine
+ (fix f (n : nat) : {x : nat | x = S n} :=
+    match n return {x : nat | x = S n} with
+    | O => _
+    | S p => _
+    end).
 
 Restart.
 
-Refine Fix f{f/1 :(n:nat){x:nat|x=(S n)} :=
-        [n:nat]<[n:nat]{x:nat|x=(S n)}>Cases n of O => ? | (S p) => ? end}.
+ refine
+ (fix f (n : nat) : {x : nat | x = S n} :=
+    match n return {x : nat | x = S n} with
+    | O => _
+    | S p => _
+    end).
 
-Exists (S O). Trivial. 
-Elim (f0 p).
-Refine [x:nat][h:x=(S p)](exist nat [x:nat]x=(S (S p)) (S x) ?). 
-Rewrite h. Auto.
-Save.
+exists 1. trivial. 
+elim (f0 p).
+ refine
+ (fun (x : nat) (h : x = S p) => exist (fun x : nat => x = S (S p)) (S x) _). 
+ rewrite h. auto.
+Qed.
 
 
 
 (* Quelques essais de recurrence bien fondée *)
 
-Require Wf.
-Require Wf_nat.
+Require Import Wf.
+Require Import Wf_nat.
 
-Lemma essai_wf : nat->nat.
+Lemma essai_wf : nat -> nat.
 
-Refine [x:nat](well_founded_induction
-      	       nat
-      	       lt ?
-               [_:nat]nat->nat
-	       [phi0:nat][w:(phi:nat)(lt phi phi0)->nat->nat](w x ?)
-	       x x).
-Exact lt_wf.
+ refine
+ (fun x : nat =>
+  well_founded_induction _ (fun _ : nat => nat -> nat)
+    (fun (phi0 : nat) (w : forall phi : nat, phi < phi0 -> nat -> nat) =>
+     w x _) x x).
+exact lt_wf.
 
 Abort.
 
 
-Require Compare_dec.
-Require Lt.
+Require Import Compare_dec.
+Require Import Lt.
 
 Lemma fibo : nat -> nat.
-Refine (well_founded_induction
-       nat
-       lt ?
-       [_:nat]nat
-       [x0:nat][fib:(x:nat)(lt x x0)->nat]
-         Cases (zerop x0) of 
-      	   (left _)   => (S O)
-      	 | (right h1) => Cases (zerop (pred x0)) of
-      	                   (left _)   => (S O)
-                         | (right h2) => (plus (fib (pred x0) ?)
-      	       	       	       	       	       (fib (pred (pred x0)) ?))
-		     end
-	 end).
-Exact lt_wf.
-Auto with arith.
-Apply lt_trans with m:=(pred x0); Auto with arith.
-Save.
-
+ refine
+ (well_founded_induction _ (fun _ : nat => nat)
+    (fun (x0 : nat) (fib : forall x : nat, x < x0 -> nat) =>
+     match zerop x0 with
+     | left _ => 1
+     | right h1 =>
+         match zerop (pred x0) with
+         | left _ => 1
+         | right h2 => fib (pred x0) _ + fib (pred (pred x0)) _
+         end
+     end)).
+exact lt_wf.
+auto with arith.
+apply lt_trans with (m := pred x0); auto with arith.
+Qed.
 
diff --git a/test-suite/success/Try.v b/test-suite/success/Try.v
index 05cab1e6..b356f277 100644
--- a/test-suite/success/Try.v
+++ b/test-suite/success/Try.v
@@ -2,7 +2,7 @@
    non-existent names in Unfold [cf bug #263] *)
 
 Lemma lem1 : True.
-Try (Unfold i_dont_exist).
-Trivial.
+try unfold i_dont_exist in |- *.
+trivial.
 Qed.
 
diff --git a/test-suite/success/autorewritein.v b/test-suite/success/autorewritein.v
new file mode 100644
index 00000000..8126e9e4
--- /dev/null
+++ b/test-suite/success/autorewritein.v
@@ -0,0 +1,20 @@
+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 ResAck0 : (Ack 2 2 = 7 -> False) -> False.
+Proof.
+  intros.
+  autorewrite with base0 in H using try (apply H; reflexivity).
+Qed.
+
+Lemma ResAck1 : forall H:(Ack 2 2 = 7 -> False), H=H -> False.
+Proof.
+  intros.
+  autorewrite with base0 in H using try (apply H1; reflexivity).
+Qed.
+
diff --git a/test-suite/success/cc.v b/test-suite/success/cc.v
index 4d898da9..42df990f 100644
--- a/test-suite/success/cc.v
+++ b/test-suite/success/cc.v
@@ -1,83 +1,79 @@
 
-Theorem t1: (A:Set)(a:A)(f:A->A)
-	(f a)=a->(f (f a))=a.
-Intros.
-Congruence.
-Save.
-
-Theorem t2: (A:Set)(a,b:A)(f:A->A)(g:A->A->A)
-	a=(f a)->(g b (f a))=(f (f a))->(g a b)=(f (g b a))->
-	(g a b)=a.
-Intros.
-Congruence.
-Save.
+Theorem t1 : forall (A : Set) (a : A) (f : A -> A), f a = a -> f (f a) = a.
+intros.
+ congruence.
+Qed.
+
+Theorem t2 :
+ forall (A : Set) (a b : A) (f : A -> A) (g : A -> A -> A),
+ a = f a -> g b (f a) = f (f a) -> g a b = f (g b a) -> g a b = a.
+intros.
+ congruence.
+Qed.
 
 (* 15=0 /\ 10=0 /\ 6=0 -> 0=1 *)
 
-Theorem t3: (N:Set)(o:N)(s:N->N)(d:N->N)
-	(s(s(s(s(s(s(s(s(s(s(s(s(s(s(s o)))))))))))))))=o->
-	(s (s (s (s (s (s (s (s (s (s o))))))))))=o->
-	(s (s (s (s (s (s o))))))=o->
-	o=(s o).
-Intros.
-Congruence.
-Save.
+Theorem t3 :
+ forall (N : Set) (o : N) (s d : N -> N),
+ s (s (s (s (s (s (s (s (s (s (s (s (s (s (s o)))))))))))))) = o ->
+ s (s (s (s (s (s (s (s (s (s o))))))))) = o ->
+ s (s (s (s (s (s o))))) = o -> o = s o.
+intros.
+ congruence.
+Qed.
 
 (* Examples that fail due to dependencies *) 
 
 (* yields transitivity problem *)
 
-Theorem dep:(A:Set)(P:A->Set)(f,g:(x:A)(P x))(x,y:A)
-    (e:x=y)(e0:(f y)=(g y))(f x)=(g x).
-Intros;Dependent Rewrite -> e;Exact e0.
-Save.
+Theorem dep :
+ forall (A : Set) (P : A -> Set) (f g : forall x : A, P x) 
+   (x y : A) (e : x = y) (e0 : f y = g y), f x = g x.
+intros;  dependent rewrite e; exact e0.
+Qed.
 
 (* yields congruence problem *)
 
-Theorem dep2:(A,B:Set)(f:(A:Set)(b:bool)if b then unit else A->unit)(e:A==B)
-   (f A true)=(f B true).
-Intros;Rewrite e;Reflexivity.
-Save.
+Theorem dep2 :
+ forall (A B : Set)
+   (f : forall (A : Set) (b : bool), if b then unit else A -> unit)
+   (e : A = B), f A true = f B true.
+intros;  rewrite e; reflexivity.
+Qed.
 
 
 (* example that Congruence. can solve 	
 	(dependent function applied to the same argument)*) 
 
-Theorem dep3:(A:Set)(P:(A->Set))(f,g:(x:A)(P x))f=g->(x:A)(f x)=(g x).		Intros.	
-Congruence.
-Save.
+Theorem dep3 :
+ forall (A : Set) (P : A -> Set) (f g : forall x : A, P x),
+ f = g -> forall x : A, f x = g x.		intros.	
+ congruence.
+Qed.
 
 (* Examples with injection rule *)
 
-Theorem inj1 : (A:Set;a,b,c,d:A)(a,c)=(b,d)->a=b/\c=d.
-Intros.
-Split;Congruence.
-Save.
+Theorem inj1 :
+ forall (A : Set) (a b c d : A), (a, c) = (b, d) -> a = b /\ c = d.
+intros.
+split;  congruence.
+Qed.
 
-Theorem inj2 : (A:Set;a,c,d:A;f:A->A*A) (f=(pair A A a))->
-  (Some ? (f c))=(Some ? (f d))->c=d.                             
-Intros.
-Congruence.
-Save.
+Theorem inj2 :
+ forall (A : Set) (a c d : A) (f : A -> A * A),
+ f = pair (B:=A) a -> Some (f c) = Some (f d) -> c = d.                             
+intros.
+ congruence.
+Qed.
 
 (* Examples with discrimination rule *)
 
-Theorem discr1 : true=false->False.
-Intros.
-Congruence.
-Save.
+Theorem discr1 : true = false -> False.
+intros.
+ congruence.
+Qed.
 
-Theorem discr2 : (Some ? true)=(Some ? false)->False.
-Intros.
-Congruence.
-Save.
-
-(* example with Congruence.Solve (requires CCSolve.v)*)
-
-Require CCSolve.
-
-Theorem t4 :  (A:Set; P:(A->Prop); a,b,c,d:A)a=b->c=d->
-                 (P a)->((P b)->(P c))->(P d).
-Intros.
-CCsolve.
-Save.
+Theorem discr2 : Some true = Some false -> False.
+intros.
+ congruence.
+Qed.
diff --git a/test-suite/success/coercions.v b/test-suite/success/coercions.v
index 98b613ba..8dd48752 100644
--- a/test-suite/success/coercions.v
+++ b/test-suite/success/coercions.v
@@ -1,11 +1,32 @@
 (* Interaction between coercions and casts *)
 (*   Example provided by Eduardo Gimenez   *)
 
-Parameter Z,S:Set.
+Parameter Z S : Set.
 
-Parameter f: S  -> Z.
-Coercion  f: S >-> Z.
+Parameter f : S -> Z.
+Coercion f : S >-> Z.
 
 Parameter g : Z -> Z.
 
-Check [s](g (s::S)).
+Check (fun s => g (s:S)).
+
+
+(* Check uniform inheritance condition *)
+
+Parameter h : nat -> nat -> Prop.
+Parameter i : forall n m : nat, h n m -> nat.
+Coercion i : h >-> nat.
+
+(* Check coercion to funclass when the source occurs in the target *)
+
+Parameter C : nat -> nat -> nat.
+Coercion C : nat >-> Funclass.
+
+(* Remark: in the following example, it cannot be decide whether C is
+   from nat to Funclass or from A to nat. An explicit Coercion command is
+   expected 
+
+Parameter A : nat -> Prop.
+Parameter C:> forall n:nat, A n -> nat.
+*)
+
diff --git a/test-suite/success/coqbugs0181.v b/test-suite/success/coqbugs0181.v
index 21f906a6..d541dcf7 100644
--- a/test-suite/success/coqbugs0181.v
+++ b/test-suite/success/coqbugs0181.v
@@ -1,7 +1,7 @@
 
 (* test the strength of pretyping unification *)
 
-Require PolyList.
-Definition listn := [A,n] {l:(list A)|(length l)=n}.
-Definition make_ln [A,n;l:(list A); h:([l](length l)=n l)] :=
-  (exist ?? l h).
+Require Import List.
+Definition listn A n := {l : list A | length l = n}.
+Definition make_ln A n (l : list A) (h : (fun l => length l = n) l) :=
+  exist _ l h.
diff --git a/test-suite/success/destruct.v b/test-suite/success/destruct.v
new file mode 100644
index 00000000..ede573a3
--- /dev/null
+++ b/test-suite/success/destruct.v
@@ -0,0 +1,9 @@
+(* Simplification of bug 711 *)
+
+Parameter f : true = false.
+Goal let p := f in True.
+intro p.
+set (b := true) in *.
+(* Check that it doesn't fail with an anomaly *)
+(* Ultimately, adapt destruct to make it succeeding *)
+try destruct b.
diff --git a/test-suite/success/eauto.v b/test-suite/success/eauto.v
index 97f7ccf0..26339d51 100644
--- a/test-suite/success/eauto.v
+++ b/test-suite/success/eauto.v
@@ -5,45 +5,56 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-Require PolyList.
+Require Import List.
 
-Parameter in_list : (list nat*nat)->nat->Prop.
-Definition not_in_list : (list nat*nat)->nat->Prop
-	:= [l,n]~(in_list l n).
+Parameter in_list : list (nat * nat) -> nat -> Prop.
+Definition not_in_list (l : list (nat * nat)) (n : nat) : Prop :=
+  ~ in_list l n.
 
 (* Hints Unfold not_in_list. *)
 
-Axiom lem1 : (l1,l2:(list nat*nat))(n:nat)
-		(not_in_list (app l1 l2) n)->(not_in_list l1 n).
-
-Axiom lem2 : (l1,l2:(list nat*nat))(n:nat)
-		(not_in_list (app l1 l2) n)->(not_in_list l2 n).
-
-Axiom lem3 : (l:(list nat*nat))(n,p,q:nat)
-		(not_in_list (cons (p,q) l) n)->(not_in_list l n).
-
-Axiom lem4 : (l1,l2:(list nat*nat))(n:nat)
-	(not_in_list l1 n)->(not_in_list l2 n)->(not_in_list (app l1 l2) n).
-
-Hints Resolve lem1 lem2 lem3 lem4: essai.
-
-Goal (l:(list nat*nat))(n,p,q:nat)
-		(not_in_list (cons (p,q) l) n)->(not_in_list l n).
-Intros.
-EAuto with essai.
-Save.
+Axiom
+  lem1 :
+    forall (l1 l2 : list (nat * nat)) (n : nat),
+    not_in_list (l1 ++ l2) n -> not_in_list l1 n.
+
+Axiom
+  lem2 :
+    forall (l1 l2 : list (nat * nat)) (n : nat),
+    not_in_list (l1 ++ l2) n -> not_in_list l2 n.
+
+Axiom
+  lem3 :
+    forall (l : list (nat * nat)) (n p q : nat),
+    not_in_list ((p, q) :: l) n -> not_in_list l n.
+
+Axiom
+  lem4 :
+    forall (l1 l2 : list (nat * nat)) (n : nat),
+    not_in_list l1 n -> not_in_list l2 n -> not_in_list (l1 ++ l2) n.
+
+Hint Resolve lem1 lem2 lem3 lem4: essai.
+
+Goal
+forall (l : list (nat * nat)) (n p q : nat),
+not_in_list ((p, q) :: l) n -> not_in_list l n.
+intros.
+ eauto with essai.
+Qed.
 
 (* Example from Nicolas Magaud on coq-club - Jul 2000 *)
 
-Definition Nat: Set := nat.
-Parameter S':Nat ->Nat.
-Parameter plus':Nat -> Nat ->Nat.
-
-Lemma simpl_plus_l_rr1:
-  ((n0:Nat) ((m, p:Nat) (plus' n0 m)=(plus' n0 p) ->m=p) ->
-   (m, p:Nat) (S' (plus' n0 m))=(S' (plus' n0 p)) ->m=p) ->
-  (n:Nat) ((m, p:Nat) (plus' n m)=(plus' n p) ->m=p) ->
-  (m, p:Nat) (S' (plus' n m))=(S' (plus' n p)) ->m=p.
-Intros.
-EAuto. (* does EApply H *) 
+Definition Nat : Set := nat.
+Parameter S' : Nat -> Nat.
+Parameter plus' : Nat -> Nat -> Nat.
+
+Lemma simpl_plus_l_rr1 :
+ (forall n0 : Nat,
+  (forall m p : Nat, plus' n0 m = plus' n0 p -> m = p) ->
+  forall m p : Nat, S' (plus' n0 m) = S' (plus' n0 p) -> m = p) ->
+ forall n : Nat,
+ (forall m p : Nat, plus' n m = plus' n p -> m = p) ->
+ forall m p : Nat, S' (plus' n m) = S' (plus' n p) -> m = p.
+intros.
+ eauto. (* does EApply H *) 
 Qed.
diff --git a/test-suite/success/eqdecide.v b/test-suite/success/eqdecide.v
index f826df9a..e7b8ca23 100644
--- a/test-suite/success/eqdecide.v
+++ b/test-suite/success/eqdecide.v
@@ -6,24 +6,26 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Inductive T : Set := A: T | B :T->T.
+Inductive T : Set :=
+  | A : T
+  | B : T -> T.
 
-Lemma lem1 : (x,y:T){x=y}+{~x=y}.
-Decide Equality.
+Lemma lem1 : forall x y : T, {x = y} + {x <> y}.
+ decide equality.
 Qed.
 
-Lemma lem2 : (x,y:T){x=y}+{~x=y}.
-Intros x y.
-Decide Equality x y.
+Lemma lem2 : forall x y : T, {x = y} + {x <> y}.
+intros x y.
+ decide equality x y.
 Qed.
 
-Lemma lem3 : (x,y:T){x=y}+{~x=y}.
-Intros x y.
-Decide Equality y x.
+Lemma lem3 : forall x y : T, {x = y} + {x <> y}.
+intros x y.
+ decide equality y x.
 Qed.
 
-Lemma lem4 : (x,y:T){x=y}+{~x=y}.
-Intros x y.
-Compare x y; Auto.
+Lemma lem4 : forall x y : T, {x = y} + {x <> y}.
+intros x y.
+ compare x y; auto.
 Qed.
 
diff --git a/test-suite/success/evars.v b/test-suite/success/evars.v
index a7b6d6d8..64875fba 100644
--- a/test-suite/success/evars.v
+++ b/test-suite/success/evars.v
@@ -1,23 +1,70 @@
 (* The "?" of cons and eq should be inferred *)
-Variable list:Set -> Set.
-Variable cons:(T:Set) T -> (list T) -> (list T).
-Check (n:(list nat)) (EX l| (EX x| (n = (cons ? x l)))).
+Variable list : Set -> Set.
+Variable cons : forall T : Set, T -> list T -> list T.
+Check (forall n : list nat, exists l : _, (exists x : _, n = cons _ x l)).
 
 (* Examples provided by Eduardo Gimenez *)
 
-Definition c [A;Q:(nat*A->Prop)->Prop;P] :=
-   (Q [p:nat*A]let (i,v) = p in (P i v)).
+Definition c A (Q : (nat * A -> Prop) -> Prop) P :=
+  Q (fun p : nat * A => let (i, v) := p in P i v).
 
 (* What does this test ? *)
-Require PolyList.
-Definition list_forall_bool  [A:Set][p:A->bool][l:(list A)] : bool := 
- (fold_right ([a][r]if (p a) then r else false) true l).
+Require Import List.
+Definition list_forall_bool (A : Set) (p : A -> bool) 
+  (l : list A) : bool :=
+  fold_right (fun a r => if p a then r else false) true l.
 
 (* Checks that solvable ? in the lambda prefix of the definition are harmless*)
-Parameter A1,A2,F,B,C : Set.
+Parameter A1 A2 F B C : Set.
 Parameter f : F -> A1 -> B.
-Definition f1 [frm0,a1]: B := (f frm0 a1).
+Definition f1 frm0 a1 : B := f frm0 a1.
 
 (* Checks that solvable ? in the type part of the definition are harmless *)
-Definition f2 : (frm0:?;a1:?)B := [frm0,a1](f frm0 a1).
+Definition f2 frm0 a1 : B := f frm0 a1.
 
+(* Checks that sorts that are evars are handled correctly (bug 705) *)
+Require Import List.
+
+Fixpoint build (nl : list nat) :
+ match nl with
+ | nil => True
+ | _ => False
+ end -> unit :=
+  match nl return (match nl with
+                   | nil => True
+                   | _ => False
+                   end -> unit) with
+  | nil => fun _ => tt
+  | n :: rest =>
+      match n with
+      | O => fun _ => tt
+      | S m => fun a => build rest (False_ind _ a)
+      end
+  end.
+
+
+(* Checks that disjoint contexts are correctly set by restrict_hyp *)
+(* Bug de 1999 corrigé en déc 2004 *)
+
+Check
+  (let p :=
+     fun (m : nat) f (n : nat) =>
+     match f m n with
+     | exist a b => exist _ a b
+     end in
+   p
+   :forall x : nat,
+    (forall y n : nat, {q : nat | y = q * n}) ->
+    forall n : nat, {q : nat | x = q * n}).
+
+(* Check instantiation of nested evars (bug #1089) *)
+
+Check (fun f:(forall (v:Set->Set), v (v nat) -> nat) => f _ (Some (Some O))).
+
+(* This used to fail with anomaly "evar was not declared" in V8.0pl3 *)
+
+Theorem contradiction : forall p, ~ p -> p -> False.
+Proof. trivial. Qed.
+Hint Resolve contradiction.
+Goal False.
+eauto.
diff --git a/test-suite/success/extraction.v b/test-suite/success/extraction.v
new file mode 100644
index 00000000..e7da947b
--- /dev/null
+++ b/test-suite/success/extraction.v
@@ -0,0 +1,5 @@
+(* Mini extraction test *)
+
+Require Import ZArith.
+
+Extraction "zarith.ml" two_or_two_plus_one Zdiv_eucl_exist.
diff --git a/test-suite/success/fix.v b/test-suite/success/fix.v
index 374029bb..f4a4d36d 100644
--- a/test-suite/success/fix.v
+++ b/test-suite/success/fix.v
@@ -12,40 +12,41 @@ Require Import ZArith.
 
 Definition rNat := positive.
 
-Inductive rBoolOp: Set :=
-     rAnd: rBoolOp
-    | rEq: rBoolOp .
-
-Definition rlt: rNat -> rNat ->Prop := [a, b:rNat](compare a b EGAL)=INFERIEUR.
-
-Definition rltDec: (m, n:rNat){(rlt m n)}+{(rlt n m) \/ m=n}.
-Intros n m; Generalize (compare_convert_INFERIEUR n m);
- Generalize (compare_convert_SUPERIEUR n m);
- Generalize (compare_convert_EGAL n m); Case (compare n m EGAL).
-Intros H' H'0 H'1; Right; Right; Auto.
-Intros H' H'0 H'1; Left; Unfold rlt.
-Apply convert_compare_INFERIEUR; Auto.
-Intros H' H'0 H'1; Right; Left; Unfold rlt.
-Apply convert_compare_INFERIEUR; Auto.
-Apply H'0; Auto.
+Inductive rBoolOp : Set :=
+  | rAnd : rBoolOp
+  | rEq : rBoolOp.
+
+Definition rlt (a b : rNat) : Prop :=
+  (a ?= b)%positive Datatypes.Eq = Datatypes.Lt.
+
+Definition rltDec : forall m n : rNat, {rlt m n} + {rlt n m \/ m = n}.
+intros n m; generalize (nat_of_P_lt_Lt_compare_morphism n m);
+ generalize (nat_of_P_gt_Gt_compare_morphism n m);
+ generalize (Pcompare_Eq_eq n m); case ((n ?= m)%positive Datatypes.Eq).
+intros H' H'0 H'1; right; right; auto.
+intros H' H'0 H'1; left; unfold rlt in |- *.
+apply nat_of_P_lt_Lt_compare_complement_morphism; auto.
+intros H' H'0 H'1; right; left; unfold rlt in |- *.
+apply nat_of_P_lt_Lt_compare_complement_morphism; auto.
+apply H'0; auto.
 Defined.
 
 
-Definition rmax: rNat -> rNat ->rNat.
-Intros n m; Case (rltDec n m); Intros Rlt0.
-Exact m.
-Exact n.
+Definition rmax : rNat -> rNat -> rNat.
+intros n m; case (rltDec n m); intros Rlt0.
+exact m.
+exact n.
 Defined.
 
-Inductive rExpr: Set :=
-     rV: rNat ->rExpr
-    | rN: rExpr ->rExpr
-    | rNode: rBoolOp -> rExpr -> rExpr ->rExpr .
-
-Fixpoint maxVar[e:rExpr]: rNat :=
-   Cases e of
-       (rV n) => n
-      | (rN p) => (maxVar p)
-      | (rNode n p q) => (rmax (maxVar p) (maxVar q))
-   end.
+Inductive rExpr : Set :=
+  | rV : rNat -> rExpr
+  | rN : rExpr -> rExpr
+  | rNode : rBoolOp -> rExpr -> rExpr -> rExpr.
+
+Fixpoint maxVar (e : rExpr) : rNat :=
+  match e with
+  | rV n => n
+  | rN p => maxVar p
+  | rNode n p q => rmax (maxVar p) (maxVar q)
+  end.
 
diff --git a/test-suite/success/if.v b/test-suite/success/if.v
index 85cd1f11..3f763863 100644
--- a/test-suite/success/if.v
+++ b/test-suite/success/if.v
@@ -1,5 +1,5 @@
 (* The synthesis of the elimination predicate may fail if algebric *)
 (* universes are not cautiously treated *)
 
-Check [b:bool]if b then Type else nat.
+Check (fun b : bool => if b then Type else nat).
 
diff --git a/test-suite/success/implicit.v b/test-suite/success/implicit.v
index c597f9bf..1786424e 100644
--- a/test-suite/success/implicit.v
+++ b/test-suite/success/implicit.v
@@ -1,20 +1,23 @@
 (* Implicit on section variables *)
 
 Set Implicit Arguments.
+Unset Strict Implicit.
 
 (* Example submitted by David Nowak *)
 
 Section Spec.
-Variable A:Set.
-Variable op : (A:Set)A->A->Set.
-Infix 6 "#" op V8only (at level 70).
-Check (x:A)(x # x).
+Variable A : Set.
+Variable op : forall A : Set, A -> A -> Set.
+Infix "#" := op (at level 70).
+Check (forall x : A, x # x).
 
 (* Example submitted by Christine *)
-Record stack : Type := {type : Set; elt : type; 
-                        empty : type -> bool; proof : (empty elt)=true }.
+Record stack : Type := 
+  {type : Set; elt : type; empty : type -> bool; proof : empty elt = true}.
 
-Check (type:Set; elt:type; empty:(type->bool))(empty elt)=true->stack.
+Check
+  (forall (type : Set) (elt : type) (empty : type -> bool),
+   empty elt = true -> stack).
 
 End Spec.
 
@@ -22,10 +25,10 @@ End Spec.
 
 Parameter f : nat -> nat * nat.
 Notation lhs := fst.
-Check [x](lhs ? ? (f x)).
-Check [x](!lhs ? ? (f x)).
-Notation "'rhs'" := snd.
-Check [x](rhs ? ? (f x)).
+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)).
 *)
diff --git a/test-suite/success/import_lib.v b/test-suite/success/import_lib.v
index d031691d..c3dc2fc6 100644
--- a/test-suite/success/import_lib.v
+++ b/test-suite/success/import_lib.v
@@ -1,47 +1,47 @@
-Definition le_trans:=O.
+Definition le_trans := 0.
 
 
 Module Test_Read.     
   Module M.  
-    Read Module Le.        (* Reading without importing *)
+    Require Le.        (* Reading without importing *)
 
     Check Le.le_trans.
 
-    Lemma th0 : le_trans = O.
-      Reflexivity.
+    Lemma th0 : le_trans = 0.
+      reflexivity.
     Qed.
   End M.
 
   Check Le.le_trans. 
 
-  Lemma th0 : le_trans = O.
-    Reflexivity.
+  Lemma th0 : le_trans = 0.
+    reflexivity.
   Qed.
 
   Import M.
 
-  Lemma th1 : le_trans = O.
-    Reflexivity.
+  Lemma th1 : le_trans = 0.
+    reflexivity.
   Qed.
 End Test_Read.
 
 
 (****************************************************************)
 
-Definition le_decide := (S O).  (* from Arith/Compare *)
-Definition min := O.            (* from Arith/Min *)
+Definition le_decide := 1.  (* from Arith/Compare *)
+Definition min := 0.            (* from Arith/Min *)
 
 Module Test_Require.
   
   Module M.
-    Require Compare.              (* Imports Min as well *)
+    Require Import Compare.              (* Imports Min as well *)
   
-    Lemma th1 : le_decide = Compare.le_decide.
-      Reflexivity.
+    Lemma th1 : le_decide = le_decide.
+      reflexivity.
     Qed.
   
-    Lemma th2 : min = Min.min.
-      Reflexivity.
+    Lemma th2 : min = min.
+      reflexivity.
     Qed.
   
   End M.
@@ -52,23 +52,23 @@ Module Test_Require.
   
   
   (* Checks that Compare and List are _not_ imported *)
-  Lemma th1 : le_decide = (S O).
-    Reflexivity.
+  Lemma th1 : le_decide = 1.
+    reflexivity.
   Qed.
   
-  Lemma th2 : min = O.
-    Reflexivity.
+  Lemma th2 : min = 0.
+    reflexivity.
   Qed.
   
   (* It should still be the case after Import M *)
   Import M.
   
-  Lemma th3 : le_decide = (S O).
-    Reflexivity.
+  Lemma th3 : le_decide = 1.
+    reflexivity.
   Qed.
   
-  Lemma th4 : min = O.
-    Reflexivity.
+  Lemma th4 : min = 0.
+    reflexivity.
   Qed.
 
 End Test_Require.  
@@ -79,12 +79,12 @@ Module Test_Import.
   Module M.
     Import Compare.              (* Imports Min as well *)
   
-    Lemma th1 : le_decide = Compare.le_decide.
-      Reflexivity.
+    Lemma th1 : le_decide = le_decide.
+      reflexivity.
     Qed.
   
-    Lemma th2 : min = Min.min.
-      Reflexivity.
+    Lemma th2 : min = min.
+      reflexivity.
     Qed.
   
   End M.
@@ -95,23 +95,23 @@ Module Test_Import.
   
   
   (* Checks that Compare and List are _not_ imported *)
-  Lemma th1 : le_decide = (S O).
-    Reflexivity.
+  Lemma th1 : le_decide = 1.
+    reflexivity.
   Qed.
   
-  Lemma th2 : min = O.
-    Reflexivity.
+  Lemma th2 : min = 0.
+    reflexivity.
   Qed.
   
   (* It should still be the case after Import M *)
   Import M.
   
-  Lemma th3 : le_decide = (S O).
-    Reflexivity.
+  Lemma th3 : le_decide = 1.
+    reflexivity.
   Qed.
   
-  Lemma th4 : min = O.
-    Reflexivity.
+  Lemma th4 : min = 0.
+    reflexivity.
   Qed.
 End Test_Import.
 
@@ -121,24 +121,24 @@ Module Test_Export.
   Module M.
     Export Compare.              (* Exports Min as well *)
 
-    Lemma th1 : le_decide = Compare.le_decide.
-      Reflexivity.
+    Lemma th1 : le_decide = le_decide.
+      reflexivity.
     Qed.
 
-    Lemma th2 : min = Min.min.
-      Reflexivity.
+    Lemma th2 : min = min.
+      reflexivity.
     Qed.
 
   End M.
 
 
   (* Checks that Compare and List are _not_ imported *)
-  Lemma th1 : le_decide = (S O).
-    Reflexivity.
+  Lemma th1 : le_decide = 1.
+    reflexivity.
   Qed.
 
-  Lemma th2 : min = O.
-    Reflexivity.
+  Lemma th2 : min = 0.
+    reflexivity.
   Qed.
 
 
@@ -146,12 +146,12 @@ Module Test_Export.
 
   Import M.
 
-  Lemma th3 : le_decide = Compare.le_decide.
-    Reflexivity.
+  Lemma th3 : le_decide = le_decide.
+    reflexivity.
   Qed.
 
-  Lemma th4 : min = Min.min.
-    Reflexivity.
+  Lemma th4 : min = min.
+    reflexivity.
   Qed.
 End Test_Export.
 
@@ -160,30 +160,30 @@ End Test_Export.
 
 Module Test_Require_Export.
 
-  Definition mult_sym:=(S O).    (* from Arith/Mult *)
-  Definition plus_sym:=O.        (* from Arith/Plus *)
+  Definition mult_sym := 1.    (* from Arith/Mult *)
+  Definition plus_sym := 0.        (* from Arith/Plus *)
 
   Module M.
     Require Export Mult.         (* Exports Plus as well *)
 
-    Lemma th1 : mult_sym = Mult.mult_sym.
-      Reflexivity.
+    Lemma th1 : mult_comm = mult_comm.
+      reflexivity.
     Qed.
 
-    Lemma th2 : plus_sym = Plus.plus_sym.
-      Reflexivity.
+    Lemma th2 : plus_comm = plus_comm.
+      reflexivity.
     Qed.
 
   End M.
 
 
   (* Checks that Mult and Plus are _not_ imported *)
-  Lemma th1 : mult_sym = (S O).
-    Reflexivity.
+  Lemma th1 : mult_sym = 1.
+    reflexivity.
   Qed.
 
-  Lemma th2 : plus_sym = O.
-    Reflexivity.
+  Lemma th2 : plus_sym = 0.
+    reflexivity.
   Qed.
 
 
@@ -191,12 +191,12 @@ Module Test_Require_Export.
 
   Import M.
 
-  Lemma th3 : mult_sym = Mult.mult_sym.
-    Reflexivity.
+  Lemma th3 : mult_comm = mult_comm.
+    reflexivity.
   Qed.
 
-  Lemma th4 : plus_sym = Plus.plus_sym.
-    Reflexivity.
+  Lemma th4 : plus_comm = plus_comm.
+    reflexivity.
   Qed.
 
 End Test_Require_Export.
diff --git a/test-suite/success/import_mod.v b/test-suite/success/import_mod.v
index b4a8af46..c098c6e8 100644
--- a/test-suite/success/import_mod.v
+++ b/test-suite/success/import_mod.v
@@ -1,38 +1,38 @@
 
-Definition p:=O.
-Definition m:=O.
+Definition p := 0.
+Definition m := 0.
 
 Module Test_Import.
   Module P.
-    Definition p:=(S O).
+    Definition p := 1.
   End P.
 
   Module M.
     Import P.
-    Definition m:=p.
+    Definition m := p.
   End M.
 
   Module N.
     Import M.
 
-    Lemma th0 : p=O.
-      Reflexivity.
+    Lemma th0 : p = 0.
+      reflexivity.
     Qed.
 
   End N.
 
 
   (* M and P should be closed *)
-  Lemma th1 : m=O /\ p=O.
-    Split; Reflexivity.
+  Lemma th1 : m = 0 /\ p = 0.
+    split; reflexivity.
   Qed.
 
 
   Import N.
 
   (* M and P should still be closed *)
-  Lemma th2 : m=O /\ p=O.
-    Split; Reflexivity.
+  Lemma th2 : m = 0 /\ p = 0.
+    split; reflexivity.
   Qed.
 End Test_Import.
 
@@ -42,34 +42,34 @@ End Test_Import.
 
 Module Test_Export.
   Module P.
-    Definition p:=(S O).
+    Definition p := 1.
   End P.
 
   Module M.
     Export P.
-    Definition m:=p.
+    Definition m := p.
   End M.
 
   Module N.
     Export M.
 
-    Lemma th0 : p=(S O).
-      Reflexivity.
+    Lemma th0 : p = 1.
+      reflexivity.
     Qed.
 
   End N.
 
 
   (* M and P should be closed *)
-  Lemma th1 : m=O /\ p=O.
-    Split; Reflexivity.
+  Lemma th1 : m = 0 /\ p = 0.
+    split; reflexivity.
   Qed.
 
 
   Import N.
 
   (* M and P should now be opened *)
-  Lemma th2 : m=(S O) /\ p=(S O).
-    Split; Reflexivity.
+  Lemma th2 : m = 1 /\ p = 1.
+    split; reflexivity.
   Qed.
 End Test_Export.
diff --git a/test-suite/success/inds_type_sec.v b/test-suite/success/inds_type_sec.v
index a391b804..ed8b23c8 100644
--- a/test-suite/success/inds_type_sec.v
+++ b/test-suite/success/inds_type_sec.v
@@ -6,5 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 Section S.
-Inductive T [U:Type] : Type := c : U -> (T U).
+Inductive T (U : Type) : Type :=
+    c : U -> T U.
 End S.
diff --git a/test-suite/success/induct.v b/test-suite/success/induct.v
index 9ae498d2..2aec6e9b 100644
--- a/test-suite/success/induct.v
+++ b/test-suite/success/induct.v
@@ -7,11 +7,11 @@
 (************************************************************************)
 (* Teste des definitions inductives imbriquees *)
 
-Require PolyList.
+Require Import List.
 
-Inductive X : Set := 
-    cons1 : (list X)->X.
+Inductive X : Set :=
+    cons1 : list X -> X.
 
-Inductive Y : Set := 
-    cons2 : (list Y*Y)->Y.
+Inductive Y : Set :=
+    cons2 : list (Y * Y) -> Y.
 
diff --git a/test-suite/success/intros.v b/test-suite/success/intros.v
new file mode 100644
index 00000000..3599da4d
--- /dev/null
+++ b/test-suite/success/intros.v
@@ -0,0 +1,7 @@
+(* Thinning introduction hypothesis must be done after all introductions *)
+(* Submitted by Guillaume Melquiond (bug #1000) *)
+
+Goal forall A, A -> True.
+intros _ _.
+
+
diff --git a/test-suite/success/ltac.v b/test-suite/success/ltac.v
index 55aa110d..99cfe017 100644
--- a/test-suite/success/ltac.v
+++ b/test-suite/success/ltac.v
@@ -2,20 +2,23 @@
 
 (* Submitted by Pierre Crégut *)
 (* Checks substitution of x *)
-Tactic Definition f x := Unfold x; Idtac.
+Ltac f x := unfold x in |- *; idtac.
  
-Lemma lem1 : (plus O O) = O.
+Lemma lem1 : 0 + 0 = 0.
 f plus.
-Reflexivity.
+reflexivity.
 Qed.
 
 (* Submitted by Pierre Crégut *)
 (* Check syntactic correctness *)
-Recursive Tactic Definition F x := Idtac; (G x)
-And G y := Idtac; (F y).
+Ltac F x := idtac; G x
+ with G y := idtac; F y.
 
 (* Check that Match Context keeps a closure *)
-Tactic Definition U := Let a = 'I In Match Context With [ |- ? ] -> Apply a.
+Ltac U := let a := constr:I in
+          match goal with
+          |  |- _ => apply a
+          end.
 
 Lemma lem2 : True.
 U.
@@ -23,48 +26,130 @@ Qed.
 
 (* Check that Match giving non-tactic arguments are evaluated at Let-time *)
  
-Tactic Definition B :=
- Let y = (Match Context With [ z:? |- ? ] -> z) In 
- Intro H1; Exact y.
+Ltac B := let y := (match goal with
+                    | z:_ |- _ => z
+                    end) in
+          (intro H1; exact y).
 
 Lemma lem3 : True -> False -> True -> False.
-Intros H H0.
+intros H H0.
 B.  (* y is H0 if at let-time, H1 otherwise *)
 Qed.
 
 (* Checks the matching order of hypotheses *)
-Tactic Definition Y := Match Context With [ x:?; y:? |- ? ] -> Apply x.
-Tactic Definition Z := Match Context With [ y:?; x:? |- ? ] -> Apply x.
+Ltac Y := match goal with
+          | x:_,y:_ |- _ => apply x
+          end.
+Ltac Z := match goal with
+          | y:_,x:_ |- _ => apply x
+          end.
 
-Lemma lem4 : (True->False) -> (False->False) -> False.
-Intros H H0.
+Lemma lem4 : (True -> False) -> (False -> False) -> False.
+intros H H0.
 Z. (* Apply H0 *)
 Y. (* Apply H *)
-Exact I.
+exact I.
 Qed.
 
 (* Check backtracking *)
-Lemma back1 : (0)=(1)->(0)=(0)->(1)=(1)->(0)=(0).
-Intros; Match Context With [_:(O)=?1;_:(1)=(1)|-? ] -> Exact (refl_equal ? ?1).
+Lemma back1 : 0 = 1 -> 0 = 0 -> 1 = 1 -> 0 = 0.
+intros;
+ match goal with
+ | _:(0 = ?X1),_:(1 = 1) |- _ => exact (refl_equal X1)
+ end.
 Qed.
 
-Lemma back2 : (0)=(0)->(0)=(1)->(1)=(1)->(0)=(0).
-Intros; Match Context With [_:(O)=?1;_:(1)=(1)|-? ] -> Exact (refl_equal ? ?1).
+Lemma back2 : 0 = 0 -> 0 = 1 -> 1 = 1 -> 0 = 0.
+intros;
+ match goal with
+ | _:(0 = ?X1),_:(1 = 1) |- _ => exact (refl_equal X1)
+ end.
 Qed.
 
-Lemma back3 : (0)=(0)->(1)=(1)->(0)=(1)->(0)=(0).
-Intros; Match Context With [_:(O)=?1;_:(1)=(1)|-? ] -> Exact (refl_equal ? ?1).
+Lemma back3 : 0 = 0 -> 1 = 1 -> 0 = 1 -> 0 = 0.
+intros;
+ match goal with
+ | _:(0 = ?X1),_:(1 = 1) |- _ => exact (refl_equal X1)
+ end.
 Qed.
 
 (* Check context binding *)
-Tactic Definition sym t := Match t With [C[?1=?2]] -> Inst C[?1=?2].
-
-Lemma sym : ~(0)=(1)->~(1)=(0).
-Intro H.
-Let t = (sym (Check H)) In Assert t.
-Exact H.
-Intro H1.
-Apply H.
-Symmetry.
-Assumption.
+Ltac sym t :=
+  match constr:t with
+  | context C[(?X1 = ?X2)] => context C [X1 = X2]
+  end.
+
+Lemma sym : 0 <> 1 -> 1 <> 0.
+intro H.
+let t := sym type of H in
+assert t.
+exact H.
+intro H1.
+apply H.
+symmetry  in |- *.
+assumption.
 Qed.
+
+(* Check context binding in match goal *)
+(* This wasn't working in V8.0pl1, as the list of matched hyps wasn't empty *)
+Ltac sym' :=
+  match goal with
+  | _:True |- context C[(?X1 = ?X2)] =>
+      let t := context C [X2 = X1] in
+      assert t
+  end.
+
+Lemma sym' : True -> 0 <> 1 -> 1 <> 0.
+intros Ht H.
+sym'.
+exact H.
+intro H1.
+apply H.
+symmetry  in |- *.
+assumption.
+Qed.
+
+(* Check that fails abort the current match context *)
+Lemma decide : True \/ False.
+match goal with
+| _ => fail 1
+| _ => right
+end || left.
+exact I.
+Qed.
+
+(* Check that "match c with" backtracks on subterms *)
+Lemma refl : 1 = 1.
+let t :=
+ (match constr:(1 = 2) with
+  | context [(S ?X1)] => constr:(refl_equal X1:1 = 1)
+  end) in
+assert (H := t).
+assumption.
+Qed.
+
+(* Note that backtracking in "match c with" is only on type-checking not on
+evaluation of tactics. E.g., this does not work
+
+Lemma refl : (1)=(1).
+Match (1)=(2) With
+  [[(S ?1)]] -> Apply (refl_equal nat ?1).
+Qed.
+*)
+
+
+(* Check the precedences of rel context, ltac context and vars context *)
+(* (was wrong in V8.0) *)
+
+Ltac check_binding y := cut ((fun y => y) = S).
+Goal True.
+check_binding true.
+Abort.
+
+(* Check that variables explicitly parsed as ltac variables are not
+   seen as intro pattern or constr (bug #984) *)
+
+Ltac afi tac := intros; tac.
+Goal 1 = 2.
+afi ltac:auto.
+
diff --git a/test-suite/success/mutual_ind.v b/test-suite/success/mutual_ind.v
index e932f50c..463efed3 100644
--- a/test-suite/success/mutual_ind.v
+++ b/test-suite/success/mutual_ind.v
@@ -7,35 +7,36 @@
 (************************************************************************)
 (* Definition mutuellement inductive et dependante *)
 
-Require Export PolyList.
+Require Export List.
 
- Record signature : Type := {
-    sort : Set;
-    sort_beq : sort->sort->bool;
-    sort_beq_refl : (f:sort)true=(sort_beq f f);
-    sort_beq_eq : (f1,f2:sort)true=(sort_beq f1 f2)->f1=f2;
+ Record signature : Type := 
+   {sort : Set;
+    sort_beq : sort -> sort -> bool;
+    sort_beq_refl : forall f : sort, true = sort_beq f f;
+    sort_beq_eq : forall f1 f2 : sort, true = sort_beq f1 f2 -> f1 = f2;
     fsym :> Set;
-    fsym_type : fsym->(list sort)*sort;
-    fsym_beq : fsym->fsym->bool;
-    fsym_beq_refl : (f:fsym)true=(fsym_beq f f);
-    fsym_beq_eq : (f1,f2:fsym)true=(fsym_beq f1 f2)->f1=f2
-  }.
+    fsym_type : fsym -> list sort * sort;
+    fsym_beq : fsym -> fsym -> bool;
+    fsym_beq_refl : forall f : fsym, true = fsym_beq f f;
+    fsym_beq_eq : forall f1 f2 : fsym, true = fsym_beq f1 f2 -> f1 = f2}.
 
  
  Variable F : signature.
 
-  Definition vsym := (sort F)*nat.
+  Definition vsym := (sort F * nat)%type.
 
-  Definition vsym_sort := (fst (sort F) nat).
-  Definition vsym_nat := (snd (sort F) nat).
+  Definition vsym_sort := fst (A:=sort F) (B:=nat).
+  Definition vsym_nat := snd (A:=sort F) (B:=nat).
  
 
-  Mutual Inductive term : (sort F)->Set :=
-  	| term_var : (v:vsym)(term (vsym_sort v))
-	| term_app : (f:F)(list_term (Fst (fsym_type F f)))
-		->(term (Snd (fsym_type F f)))
-  with list_term : (list (sort F)) -> Set :=
-	| term_nil : (list_term (nil (sort F)))
-	| term_cons : (s:(sort F);l:(list (sort F)))
-	  (term s)->(list_term l)->(list_term (cons s l)).
+  Inductive term : sort F -> Set :=
+    | term_var : forall v : vsym, term (vsym_sort v)
+    | term_app :
+        forall f : F,
+        list_term (fst (fsym_type F f)) -> term (snd (fsym_type F f))
+with list_term : list (sort F) -> Set :=
+  | term_nil : list_term nil
+  | term_cons :
+      forall (s : sort F) (l : list (sort F)),
+      term s -> list_term l -> list_term (s :: l).
 
diff --git a/test-suite/success/options.v b/test-suite/success/options.v
index 9e9af4fa..bb678150 100644
--- a/test-suite/success/options.v
+++ b/test-suite/success/options.v
@@ -1,5 +1,7 @@
 (* Check that the syntax for options works *)
 Set Implicit Arguments.
+Unset Strict Implicit.
+Set Strict Implicit.
 Unset Implicit Arguments.
 Test Implicit Arguments.
 
@@ -12,16 +14,16 @@ Unset Silent.
 Test Silent.
 
 Set Printing Depth 100.
-Print Table Printing Depth.
+Test Printing Depth.
 
 Parameter i : bool -> nat.
 Coercion i : bool >-> nat.
-Set Printing Coercion i.
-Unset Printing Coercion i.
+Add Printing Coercion i.
+Remove Printing Coercion i.
 Test Printing Coercion i.
 
-Print Table Printing Let.
-Print Table Printing If.
+Test Printing Let.
+Test Printing If.
 Remove Printing Let sig.
 Remove Printing If bool.
 
diff --git a/test-suite/success/params_ind.v b/test-suite/success/params_ind.v
new file mode 100644
index 00000000..1bee31c8
--- /dev/null
+++ b/test-suite/success/params_ind.v
@@ -0,0 +1,4 @@
+Inductive list (A : Set) : Set :=
+  | nil : list A
+  | cons : A -> list (A -> A) -> list A.
+
diff --git a/test-suite/success/refine.v b/test-suite/success/refine.v
index ad4eed5a..b61cf275 100644
--- a/test-suite/success/refine.v
+++ b/test-suite/success/refine.v
@@ -1,30 +1,66 @@
 
 (* Refine and let-in's *)
 
-Goal (EX x:nat | x=O).
-Refine let y = (plus O O) in ?.
-Exists y; Auto.
+Goal exists x : nat, x = 0.
+ refine (let y := 0 + 0 in _).
+exists y; auto.
 Save test1.
 
-Goal (EX x:nat | x=O).
-Refine let y = (plus O O) in (ex_intro ? ? (plus y y) ?).  
-Auto.
+Goal exists x : nat, x = 0.
+ refine (let y := 0 + 0 in ex_intro _ (y + y) _).  
+auto.
 Save test2.
 
 Goal nat.
-Refine let y = O in (plus O ?).
-Exact (S O).
+ refine (let y := 0 in 0 + _).
+exact 1.
 Save test3.
 
 (* Example submitted by Yves on coqdev *)
 
-Require PolyList.
+Require Import List.
 
-Goal (l:(list nat))l=l.
+Goal forall l : list nat, l = l.
 Proof.
-Refine [l]<[l]l=l>
-       Cases l of
-       | nil => ?
-       | (cons O l0) => ?
-       | (cons (S _) l0) => ?
-       end.
+ refine
+ (fun l =>
+  match l return (l = l) with
+  | nil => _
+  | O :: l0 => _
+  | S _ :: l0 => _
+  end).
+Abort.
+
+(* Submitted by Roland Zumkeller (bug #888) *)
+
+(* The Fix and CoFix rules expect a subgoal even for closed components of the
+   (co-)fixpoint *)
+
+Goal nat -> nat.
+ refine (fix f (n : nat) : nat := S _
+         with pred (n : nat) : nat := n
+         for f).
+exact 0.
+Qed.
+
+(* Submitted by Roland Zumkeller (bug #889) *)
+
+(* The types of metas were in metamap and they were not updated when
+   passing through a binder *)
+
+Goal forall n : nat, nat -> n = 0.
+ refine
+ (fun n => fix f (i : nat) : n = 0 := match i with
+                                      | O => _
+                                      | S _ => _
+                                      end).
+Abort.
+
+(* Submitted by Roland Zumkeller (bug #931) *)
+(* Don't turn dependent evar into metas *)
+
+Goal (forall n : nat, n = 0 -> Prop) -> Prop.
+intro P.
+ refine (P _ _).
+reflexivity.
+Abort.
diff --git a/test-suite/success/rewrite.v b/test-suite/success/rewrite.v
new file mode 100644
index 00000000..9629b213
--- /dev/null
+++ b/test-suite/success/rewrite.v
@@ -0,0 +1,19 @@
+(* Check that dependent rewrite applies on arbitrary terms *)
+
+Inductive listn : nat -> Set :=
+  | niln : listn 0
+  | consn : forall n : nat, nat -> listn n -> listn (S n).
+
+Axiom
+  ax :
+    forall (n n' : nat) (l : listn (n + n')) (l' : listn (n' + n)),
+    existS _ (n + n') l = existS _ (n' + n) l'.
+
+Lemma lem :
+ forall (n n' : nat) (l : listn (n + n')) (l' : listn (n' + n)),
+ n + n' = n' + n /\ existT _ (n + n') l = existT _ (n' + n) l'.
+Proof.
+intros n n' l l'.
+ dependent rewrite (ax n n' l l').
+split; reflexivity.
+Qed.
diff --git a/test-suite/success/set.v b/test-suite/success/set.v
new file mode 100644
index 00000000..23019275
--- /dev/null
+++ b/test-suite/success/set.v
@@ -0,0 +1,8 @@
+Goal forall n, n+n=0->0=n+n.
+intros.
+
+(* This used to fail in 8.0pl1 *)
+set n in * |-.
+
+
+
diff --git a/test-suite/success/setoid_test.v b/test-suite/success/setoid_test.v
index 2d2b2af8..dd1022f0 100644
--- a/test-suite/success/setoid_test.v
+++ b/test-suite/success/setoid_test.v
@@ -1,104 +1,106 @@
-Require Setoid.
+Require Import Setoid.
 
 Parameter A : Set.
 
-Axiom eq_dec : (a,b :A) {a=b}+{~a=b}.
+Axiom eq_dec : forall a b : A, {a = b} + {a <> b}.
 
 Inductive set : Set :=
-|Empty : set
-|Add : A -> set -> set.
+  | Empty : set
+  | Add : A -> set -> set.
 
-Fixpoint In [a:A; s:set] : Prop :=
-Cases s of
-|Empty => False
-|(Add b s') => a=b \/ (In a s')
-end.
+Fixpoint In (a : A) (s : set) {struct s} : Prop :=
+  match s with
+  | Empty => False
+  | Add b s' => a = b \/ In a s'
+  end.
 
-Definition same [s,t:set] : Prop :=
-(a:A) (In a s) <-> (In a t).
+Definition same (s t : set) : Prop := forall a : A, In a s <-> In a t.
 
-Lemma setoid_set : (Setoid_Theory set same).
+Lemma setoid_set : Setoid_Theory set same.
 
-Unfold same; Split.
-Red; Auto.
+unfold same in |- *; split.
+red in |- *; auto.
 
-Red.
-Intros.
-Elim (H a); Auto.
+red in |- *.
+intros.
+elim (H a); auto.
 
-Intros.
-Elim (H a); Elim (H0 a).
-Split; Auto.
-Save.
+intros.
+elim (H a); elim (H0 a).
+split; auto.
+Qed.
 
-Add Setoid set same setoid_set.
+Add Setoid set same setoid_set as setsetoid.
 
 Add Morphism In : In_ext.
-Unfold same; Intros a s t H; Elim (H a); Auto.
-Save.
-
-Lemma add_aux : (s,t:set) (same s t) ->
-  (a,b:A)(In a (Add b s)) -> (In a (Add b t)).
-Unfold same; Induction 2; Intros.
-Rewrite H1.
-Simpl; Left; Reflexivity.
-
-Elim (H a).
-Intros.
-Simpl; Right.
-Apply (H2 H1).
-Save.
+unfold same in |- *; intros a s t H; elim (H a); auto.
+Qed.
+
+Lemma add_aux :
+ forall s t : set,
+ same s t -> forall a b : A, In a (Add b s) -> In a (Add b t).
+unfold same in |- *; simple induction 2; intros.
+rewrite H1.
+simpl in |- *; left; reflexivity.
+
+elim (H a).
+intros.
+simpl in |- *; right.
+apply (H2 H1).
+Qed.
 
 Add Morphism Add : Add_ext.
-Split; Apply add_aux.
-Assumption.
+split; apply add_aux.
+assumption.
+
+rewrite H.
+reflexivity.
+Qed.
 
-Rewrite H.
-Apply Seq_refl.
-Exact setoid_set.
-Save.
+Fixpoint remove (a : A) (s : set) {struct s} : set :=
+  match s with
+  | Empty => Empty
+  | Add b t =>
+      match eq_dec a b with
+      | left _ => remove a t
+      | right _ => Add b (remove a t)
+      end
+  end.
 
-Fixpoint remove [a:A; s:set] : set :=
-Cases s of
-|Empty => Empty
-|(Add b t) => Cases (eq_dec a b) of
-              |(left _) => (remove a t)
-              |(right _) => (Add b (remove a t))
-              end
-end.
+Lemma in_rem_not : forall (a : A) (s : set), ~ In a (remove a (Add a Empty)).
 
-Lemma in_rem_not : (a:A)(s:set) ~(In a (remove a (Add a Empty))).
+intros.
+setoid_replace (remove a (Add a Empty)) with Empty.
 
-Intros.
-Setoid_replace (remove a (Add a Empty)) with Empty.
-Unfold same.
-Split.
-Simpl.
-Intro H; Elim H.
+auto.
 
-Simpl.
-Case (eq_dec a a).
-Intros e ff; Elim ff.
+unfold same in |- *.
+split.
+simpl in |- *.
+case (eq_dec a a).
+intros e ff; elim ff.
 
-Intros; Absurd a=a; Trivial.
+intros; absurd (a = a); trivial.
 
-Auto.
-Save.
+simpl in |- *.
+intro H; elim H.
+Qed.
 
-Parameter P :set -> Prop.
-Parameter P_ext : (s,t:set) (same s t) -> (P s) -> (P t).
+Parameter P : set -> Prop.
+Parameter P_ext : forall s t : set, same s t -> P s -> P t.
 
 Add Morphism P : P_extt.
-Exact P_ext.
-Save.
-
-Lemma test_rewrite : (a:A)(s,t:set)(same s t) -> (P (Add a s)) -> (P (Add a t)).
-Intros.
-Rewrite <- H.
-Rewrite H.
-Setoid_rewrite <- H.
-Setoid_rewrite H.
-Setoid_rewrite <- H.
-Trivial.
-Save.
+intros; split; apply P_ext; (assumption || apply (Seq_sym _ _ setoid_set); assumption).
+Qed.
+
+Lemma test_rewrite :
+ forall (a : A) (s t : set), same s t -> P (Add a s) -> P (Add a t).
+intros.
+rewrite <- H.
+rewrite H.
+setoid_rewrite <- H.
+setoid_rewrite H.
+setoid_rewrite <- H.
+trivial.
+Qed.
 
diff --git a/test-suite/success/setoid_test2.v b/test-suite/success/setoid_test2.v
new file mode 100644
index 00000000..bac1cf14
--- /dev/null
+++ b/test-suite/success/setoid_test2.v
@@ -0,0 +1,242 @@
+Require Export Setoid.
+
+(* Testare:
+   +1. due setoidi con ugualianza diversa sullo stesso tipo
+   +2. due setoidi sulla stessa uguaglianza
+   +3. due morfismi sulla stessa funzione ma setoidi diversi
+   +4. due morfismi sulla stessa funzione e stessi setoidi
+   +5. setoid_replace
+   +6. solo cammini mal tipati
+   +7. esempio (f (g (h E1)))
+       dove h:(T1,=1) -> T2, g:T2->(T3,=3), f:(T3,=3)->Prop
+   +8. test con occorrenze non lineari del pattern
+   +9. test in cui setoid_replace fa direttamente fallback su replace
+   10. sezioni
+  +11. goal con impl
+  +12. testare *veramente* setoid_replace (ora testato solamente il caso
+       di fallback su replace)
+
+  Incompatibilita':
+    1. full_trivial in setoid_replace
+    2. "as ..." per "Add Setoid"
+    3. ipotesi permutate in lemma di "Add Morphism"
+    4. iff invece di if in "Add Morphism" nel caso di predicati
+    5. setoid_replace poteva riscrivere sia c1 in c2 che c2 in c1
+       (???? o poteva farlo da destra a sinitra o viceversa? ????)
+
+### Come evitare di dover fare "Require Setoid" prima di usare la
+    tattica?
+
+??? scelta: quando ci sono piu' scelte dare un warning oppure fallire?
+    difficile quando la tattica e' rewrite ed e' usata in tattiche
+    automatiche
+
+??? in test4.v il setoid_rewrite non si puo' sostituire con rewrite
+    perche' questo ultimo fallisce per via dell'unificazione
+
+??? ??? <-> non e' sottorelazione di ->. Quindi ora puo' capitare
+    di non riuscire a provare goal del tipo A /\ B dove (A, <->) e
+    (B, ->) (per esempio)
+
+### Nota: il parsing e pretty printing delle relazioni non e' in synch!
+    eq contro (ty,eq). Uniformare
+
+### diminuire la taglia dei proof term
+
+??? il messaggio di errore non e' assolutamente significativo quando
+    nessuna marcatura viene trovata
+
+### fare in modo che uscendo da una sezione vengano quantificate le
+    relazioni e i morfismi. Hugo: paciugare nel discharge.ml
+
+### implementare relazioni/morfismi quantificati con dei LetIn (che palle...)
+    decompose_prod da far diventare simile a un Reduction.dest_arity?
+    (ma senza riduzione??? e perche' li' c'e' riduzione?)
+    Soluzione da struzzo: fare zeta-conversione.
+
+### fare in modo che impl sia espanso nel lemma di compatibilita' del
+    morfismo (richiesta di Marco per poter fare Add Hing)
+
+??? snellire la sintassi omettendo "proved by" come proposto da Marco?  ;-(
+
+### non capisce piu' le riscritture con uguaglianze quantificate (almeno
+    nell'esempio di Marco)
+### Bas Spitters: poter dichiarare che ogni variabile nel contesto di tipo
+    un setoid_function e' un morfismo
+
+### unificare le varie check_...
+### sostituire a Use_* una sola eccezione Optimize
+
+  Implementare:
+   -2. user-defined subrelations && user-proved subrelations
+   -1. trucco di Bruno
+
+  Sorgenti di inefficacia:
+    1. scelta del setoide di default per un sostegno: per farlo velocemente
+       ci vorrebbe una tabella hash; attualmente viene fatta una ricerca
+       lineare sul range della setoid_table
+
+  Vantaggi rispetto alla vecchia tattica:
+    1. permette di avere setoidi differenti con lo stesso sostegno,
+       ma equivalenza differente
+    2. accetta setoidi differenti con lo stesso sostegno e stessa
+       equivalenza, scegliendo a caso quello da usare (proof irrelevance)
+    3. permette di avere morfismi differenti sulla stessa funzione
+       se hanno dominio o codominio differenti
+    4. accetta di avere morfismi differenti sulla stessa funzione e con
+       lo stesso dominio e codominio, scegliendo a caso quello da usare
+       (proof irrelevance)
+    5. quando un morfismo viene definito, se la scelta del dominio o del
+       codominio e' ambigua l'utente puo' esplicitamente disambiguare
+       la scelta fornendo esplicitamente il "tipo" del morfismo
+    6. permette di gestire riscritture ove ad almeno una funzione venga
+       associato piu' di un morfismo. Vengono automaticamente calcolate
+       le scelte globali che rispettano il tipaggio.
+    7. se esistono piu' scelte globali che rispettano le regole di tipaggio
+       l'utente puo' esplicitamente disambiguare la scelta globale fornendo
+       esplicitamente la scelta delle side conditions generate.
+    8. nel caso in cui la setoid_replace sia stata invocata al posto
+       della replace la setoid_replace invoca direttamente la replace.
+       Stessa cosa per la setoid_rewrite.
+    9. permette di gestire termini in cui il prefisso iniziale dell'albero
+       (fino a trovare il termine da riscrivere) non sia formato esclusivamente
+       da morfismi il cui dominio e codominio sia un setoide.
+       Ovvero ammette anche morfismi il cui dominio e/o codominio sia
+       l'uguaglianza di Leibniz. (Se entrambi sono uguaglianze di Leibniz
+       allora il setoide e' una semplice funzione).
+   10. [setoid_]rewrite ... in ...
+       setoid_replace ... in ...
+       [setoid_]reflexivity
+       [setoid_]transitivity ...
+       [setoid_]symmetry
+       [setoid_]symmetry in ...
+   11. permette di dichiarare dei setoidi/relazioni/morfismi in un module
+       type
+   12. relazioni, morfismi e setoidi quantificati
+*)
+
+Axiom S1: Set.
+Axiom eqS1: S1 -> S1 -> Prop.
+Axiom SetoidS1 : Setoid_Theory S1 eqS1.
+Add Setoid S1 eqS1 SetoidS1 as S1setoid.
+
+Axiom eqS1': S1 -> S1 -> Prop.
+Axiom SetoidS1' : Setoid_Theory S1 eqS1'.
+Axiom SetoidS1'_bis : Setoid_Theory S1 eqS1'.
+Add Setoid S1 eqS1' SetoidS1' as S1setoid'.
+Add Setoid S1 eqS1' SetoidS1'_bis as S1setoid''.
+
+Axiom S2: Set.
+Axiom eqS2: S2 -> S2 -> Prop.
+Axiom SetoidS2 : Setoid_Theory S2 eqS2.
+Add Setoid S2 eqS2 SetoidS2 as S2setoid.
+
+Axiom f : S1 -> nat -> S2.
+Add Morphism f : f_compat. Admitted.
+Add Morphism f : f_compat2. Admitted.
+
+Theorem test1: forall x y, (eqS1 x y) -> (eqS2 (f x 0) (f y 0)).
+ intros.
+ rewrite H.
+ reflexivity.
+Qed.
+
+Theorem test1': forall x y, (eqS1 x y) -> (eqS2 (f x 0) (f y 0)).
+ intros.
+ setoid_replace x with y.
+ reflexivity.
+ assumption.
+Qed.
+
+Axiom g : S1 -> S2 -> nat.
+Add Morphism g : g_compat. Admitted.
+
+Axiom P : nat -> Prop.
+Theorem test2:
+ forall x x' y y', (eqS1 x x') -> (eqS2 y y') -> (P (g x' y')) -> (P (g x y)).
+ intros.
+ rewrite H.
+ rewrite H0.
+ assumption.
+Qed.
+
+Theorem test3:
+ forall x x' y y',
+  (eqS1 x x') -> (eqS2 y y') -> (P (S (g x' y'))) -> (P (S (g x y))).
+ intros.
+ rewrite H.
+ rewrite H0.
+ assumption.
+Qed.
+
+Theorem test4:
+ forall x x' y y', (eqS1 x x') -> (eqS2 y y') -> (S (g x y)) = (S (g x' y')).
+ intros.
+ rewrite H.
+ rewrite H0.
+ reflexivity.
+Qed.
+
+Theorem test5:
+ forall x x' y y', (eqS1 x x') -> (eqS2 y y') -> (S (g x y)) = (S (g x' y')).
+ intros.
+ setoid_replace (g x y) with (g x' y').
+ reflexivity.
+ rewrite <- H0.
+ rewrite H.
+ reflexivity.
+Qed.
+
+Axiom f_test6 : S2 -> Prop.
+Add Morphism f_test6 : f_test6_compat. Admitted.
+
+Axiom g_test6 : bool -> S2.
+Add Morphism g_test6 : g_test6_compat. Admitted.
+
+Axiom h_test6 : S1 -> bool.
+Add Morphism h_test6 : h_test6_compat. Admitted.
+
+Theorem test6:
+ forall E1 E2, (eqS1 E1 E2) -> (f_test6 (g_test6 (h_test6 E2))) ->
+  (f_test6 (g_test6 (h_test6 E1))).
+ intros.
+ rewrite  H.
+ assumption.
+Qed.
+  
+Theorem test7:
+ forall E1 E2 y y', (eqS1 E1 E2) -> (eqS2 y y') ->
+  (f_test6 (g_test6 (h_test6 E2))) ->
+   (f_test6 (g_test6 (h_test6 E1))) /\ (S (g E1 y')) = (S (g E2 y')).
+  intros.
+  rewrite H.
+  split; [assumption | reflexivity].
+Qed.
+
+Axiom S1_test8: Set.
+Axiom eqS1_test8: S1_test8 -> S1_test8 -> Prop.
+Axiom SetoidS1_test8 : Setoid_Theory S1_test8 eqS1_test8.
+Add Setoid S1_test8 eqS1_test8 SetoidS1_test8 as S1_test8setoid.
+
+Axiom f_test8 : S2 -> S1_test8.
+Add Morphism f_test8 : f_compat_test8. Admitted.
+
+Axiom eqS1_test8': S1_test8 -> S1_test8 -> Prop.
+Axiom SetoidS1_test8' : Setoid_Theory S1_test8 eqS1_test8'.
+Add Setoid S1_test8 eqS1_test8' SetoidS1_test8' as S1_test8setoid'.
+    
+(*CSC: for test8 to be significant I want to choose the setoid
+  (S1_test8, eqS1_test8'). However this does not happen and
+  there is still no syntax for it ;-( *)
+Axiom g_test8 : S1_test8 -> S2.
+Add Morphism g_test8 : g_compat_test8. Admitted.
+
+Theorem test8:
+ forall x x': S2, (eqS2 x x') ->
+  (eqS2 (g_test8 (f_test8 x)) (g_test8 (f_test8 x'))).
+  intros.
+  rewrite H.
+Abort.
+
+(*Print Setoids.*)
+
diff --git a/test-suite/success/setoid_test_function_space.v b/test-suite/success/setoid_test_function_space.v
new file mode 100644
index 00000000..1602991d
--- /dev/null
+++ b/test-suite/success/setoid_test_function_space.v
@@ -0,0 +1,45 @@
+Require Export Setoid.
+Set Implicit Arguments.
+Section feq.
+Variables A B:Type.
+Definition feq (f g: A -> B):=forall a, (f a)=(g a).
+Infix "=f":= feq  (at level 80, right associativity).
+Hint Unfold feq.
+
+Lemma feq_refl: forall f, f =f f.
+intuition.
+Qed.
+                                                                                
+Lemma feq_sym: forall f g, f =f g-> g =f f.
+intuition.
+Qed.
+                                                                                
+Lemma feq_trans: forall f g h, f =f g-> g =f h -> f  =f h.
+unfold feq. intuition.
+rewrite H.
+auto.
+Qed.
+End feq.
+Infix "=f":= feq  (at level 80, right associativity).
+Hint Unfold feq. Hint Resolve feq_refl feq_sym feq_trans.
+                                                                                
+Variable K:(nat -> nat)->Prop.
+Variable K_ext:forall a b, (K a)->(a =f b)->(K b).
+
+Add Relation (fun A B:Type => A -> B) feq
+ reflexivity proved by feq_refl
+ symmetry proved by feq_sym
+ transitivity proved by feq_trans as funsetoid.
+                                                                             
+Add Morphism K with signature feq ==> iff as K_ext1.
+intuition. apply (K_ext H0 H).
+intuition. assert (x2 =f x1);auto.  apply (K_ext H0 H1).
+Qed.
+
+Lemma three:forall n, forall a, (K a)->(a =f (fun m => (a (n+m))))-> (K (fun m
+=> (a (n+m)))).
+intuition.
+setoid_rewrite <- H0.
+assumption.
+Qed.
+
diff --git a/test-suite/success/simpl.v b/test-suite/success/simpl.v
new file mode 100644
index 00000000..8d32b1d9
--- /dev/null
+++ b/test-suite/success/simpl.v
@@ -0,0 +1,24 @@
+(* Check that inversion of names of mutual inductive fixpoints works *)
+(* (cf bug #1031) *)
+
+Inductive tree : Set :=
+| node : nat -> forest -> tree  
+with forest    : Set :=
+| leaf : forest  
+| cons : tree    -> forest   -> forest  
+    .
+Definition copy_of_compute_size_forest := 
+fix copy_of_compute_size_forest (f:forest) : nat :=
+  match f with
+  | leaf => 1
+  | cons t f0 => copy_of_compute_size_forest f0 + copy_of_compute_size_tree t
+  end
+with copy_of_compute_size_tree (t:tree) : nat :=
+  match t with
+  | node _ f => 1 + copy_of_compute_size_forest f
+  end for copy_of_compute_size_forest
+.
+Eval simpl in (copy_of_compute_size_forest leaf).
+
+
+
diff --git a/test-suite/success/unfold.v b/test-suite/success/unfold.v
index de75dfce..35910011 100644
--- a/test-suite/success/unfold.v
+++ b/test-suite/success/unfold.v
@@ -8,8 +8,8 @@
 (* Test le Hint Unfold sur des var locales *)
 
 Section toto.
-Local EQ:=eq.
-Goal (EQ nat O O).
-Hints Unfold EQ.
-Auto.
-Save.
+Let EQ := eq.
+Goal EQ nat 0 0.
+Hint Unfold EQ.
+auto.
+Qed.
diff --git a/test-suite/success/unicode_utf8.v b/test-suite/success/unicode_utf8.v
new file mode 100644
index 00000000..e3c4dd30
--- /dev/null
+++ b/test-suite/success/unicode_utf8.v
@@ -0,0 +1,9 @@
+(* Check correct separation of identifiers followed by unicode symbols *)
+  Notation "x 〈 w" := (plus x w) (at level 30).
+  Check fun x => x〈x.
+
+(* Check Greek letters *)
+Definition test_greek : nat -> nat := fun Δ => Δ.
+
+(* Check indices *)
+Definition test_indices : nat -> nat := fun x� => x�.
diff --git a/test-suite/success/univers.v b/test-suite/success/univers.v
index a619b8da..87edc4de 100644
--- a/test-suite/success/univers.v
+++ b/test-suite/success/univers.v
@@ -1,40 +1,58 @@
 (* This requires cumulativity *)
 
 Definition Type2 := Type.
-Definition Type1 := Type : Type2.
+Definition Type1 : Type2 := Type.
 
-Lemma lem1 : (True->Type1)->Type2.
-Intro H.
-Apply H.
-Exact I.
+Lemma lem1 : (True -> Type1) -> Type2.
+intro H.
+apply H.
+exact I.
 Qed.
 
-Lemma lem2 : (A:Type)(P:A->Type)(x:A)((y:A)(x==y)->(P y))->(P x).
-Auto.
+Lemma lem2 :
+ forall (A : Type) (P : A -> Type) (x : A),
+ (forall y : A, x = y -> P y) -> P x.
+auto.
 Qed.
 
-Lemma lem3 : (P:Prop)P.
-Intro P ; Pattern P.
-Apply lem2.
+Lemma lem3 : forall P : Prop, P.
+intro P; pattern P in |- *.
+apply lem2.
 Abort.
 
 (* Check managing of universe constraints in inversion *)
 (* Bug report #855 *)
 
-Inductive dep_eq : (X:Type) X -> X -> Prop :=
-   | intro_eq : (X:Type) (f:X)(dep_eq X f f)
-   | intro_feq : (A:Type) (B:A->Type)
-                 let T = (x:A)(B x) in
-                 (f, g:T) (x:A)
-                 (dep_eq (B x) (f x) (g x)) ->
-                 (dep_eq T f g).
+Inductive dep_eq : forall X : Type, X -> X -> Prop :=
+  | intro_eq : forall (X : Type) (f : X), dep_eq X f f
+  | intro_feq :
+      forall (A : Type) (B : A -> Type),
+      let T := forall x : A, B x in
+      forall (f g : T) (x : A), dep_eq (B x) (f x) (g x) -> dep_eq T f g.
                                                                                 
 Require Import Relations.
                                                                                 
-Theorem dep_eq_trans : (X:Type) (transitive X (dep_eq X)).
+Theorem dep_eq_trans : forall X : Type, transitive X (dep_eq X).
 Proof.
-  Unfold transitive.
-  Intros X f g h H1 H2.
-  Inversion H1.
+  unfold transitive in |- *.
+  intros X f g h H1 H2.
+  inversion H1.
 Abort.
 
+
+(* Submitted by Bas Spitters (bug report #935) *)
+
+(* This is a problem with the status of the type in LetIn: is it a
+   user-provided one or an inferred one? At the current time, the
+   kernel type-check the type in LetIn, which means that it must be
+   considered as user-provided when calling the kernel. However, in
+   practice it is inferred so that a universe refresh is needed to set
+   its status as "user-provided".
+
+   Especially, universe refreshing was not done for "set/pose" *)
+
+Lemma ind_unsec : forall Q : nat -> Type, True. 
+intro.
+set (C := forall m, Q m -> Q m).
+exact I.
+Qed.
diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v
index 114a60ee..59d9b2b1 100755..100644
--- a/theories/Arith/Arith.v
+++ b/theories/Arith/Arith.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Arith.v,v 1.11.2.2 2004/08/03 17:42:42 herbelin Exp $ i*)
+(*i $Id: Arith.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Le.
 Require Export Lt.
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v
index 448ce002..7680997d 100755..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,v 1.12.2.1 2004/07/16 19:30:59 herbelin Exp $ i*)
+(*i $Id: Between.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Le.
 Require Import Lt.
diff --git a/theories/Arith/Bool_nat.v b/theories/Arith/Bool_nat.v
index 55dfd47f..fed650ab 100644
--- a/theories/Arith/Bool_nat.v
+++ b/theories/Arith/Bool_nat.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Bool_nat.v,v 1.5.2.1 2004/07/16 19:30:59 herbelin Exp $ *)
+(* $Id: Bool_nat.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Compare_dec.
 Require Export Peano_dec.
diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v
index 46827bae..b11f0517 100755..100644
--- a/theories/Arith/Compare.v
+++ b/theories/Arith/Compare.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Compare.v,v 1.12.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Compare.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Equality is decidable on [nat] *)
 Open Local Scope nat_scope.
diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v
index ea21437d..3a87ee1a 100755..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,v 1.13.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Compare_dec.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Le.
 Require Import Lt.
diff --git a/theories/Arith/Div.v b/theories/Arith/Div.v
index adb5593d..9011cee3 100755..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,v 1.8.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Div.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Euclidean division *)
 
diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v
index c005f061..6e5d292f 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,v 1.15.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Div2.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Lt.
 Require Import Plus.
diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v
index 2e99e068..09df9464 100755..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,v 1.14.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: EqNat.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Equality on natural numbers *)
 
diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v
index e50e3d70..23bc7cdb 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,v 1.7.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Euclid.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Mult.
 Require Import Compare_dec.
diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v
index f7a2ad71..cdbc86df 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,v 1.14.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Even.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Here we define the predicates [even] and [odd] by mutual induction
     and we prove the decidability and the exclusion of those predicates.
diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v
index 4db211e4..2767f9f0 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,v 1.5.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Factorial.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
 
 Require Import Plus.
 Require Import Mult.
@@ -15,7 +15,7 @@ Open Local Scope nat_scope.
 
 (** Factorial *)
 
-Fixpoint fact (n:nat) : nat :=
+Boxed Fixpoint fact (n:nat) : nat :=
   match n with
   | O => 1
   | S n => S n * fact n
@@ -47,4 +47,4 @@ assumption.
 simpl (1 * fact n) in H0.
 rewrite <- plus_n_O in H0.
 assumption.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v
index 299c664d..90f893a3 100755..100644
--- a/theories/Arith/Gt.v
+++ b/theories/Arith/Gt.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Gt.v,v 1.8.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Gt.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Le.
 Require Import Lt.
diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v
index a5378cff..e95ef408 100755..100644
--- a/theories/Arith/Le.v
+++ b/theories/Arith/Le.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Le.v,v 1.14.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Le.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Order on natural numbers *)
 Open Local Scope nat_scope.
@@ -62,15 +62,14 @@ 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 |- *.
-elim H; simpl in |- *; auto with arith.
+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.
 Proof.
-induction n as [| n IHn]. simpl in |- *. auto with arith.
-destruct m as [| m]. simpl in |- *. intro H. inversion H.
-simpl in |- *. auto with arith.
+destruct n; simpl; auto with arith.
+destruct m; simpl; auto with arith.
 Qed.
 
 (** Comparison to 0 *)
diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v
index e1b3e4b8..eeb4e35e 100755..100644
--- a/theories/Arith/Lt.v
+++ b/theories/Arith/Lt.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Lt.v,v 1.11.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Lt.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Le.
 Open Local Scope nat_scope.
diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v
index 82673ed0..7f5c1148 100755..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,v 1.7.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Max.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Arith.
 
@@ -69,17 +69,11 @@ 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 -> Set), 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.
-Qed.
-
-Lemma max_case2 : forall n m (P:nat -> Prop), P n -> P m -> P (max n m).
+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.
 Qed.
 
+Notation max_case2 := max_case (only parsing).
diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v
index 912e7ba3..38351817 100755..100644
--- a/theories/Arith/Min.v
+++ b/theories/Arith/Min.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Min.v,v 1.10.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Min.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Arith.
 
@@ -68,16 +68,12 @@ 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 -> Set), P n -> P m -> P (min n m).
+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.
 Qed.
 
-Lemma min_case2 : forall n m (P:nat -> Prop), 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.
-Qed.
\ No newline at end of file
+Notation min_case2 := min_case (only parsing).
+
diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v
index ba9a46ad..dfecd7cf 100755..100644
--- a/theories/Arith/Minus.v
+++ b/theories/Arith/Minus.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Minus.v,v 1.14.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Minus.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Subtraction (difference between two natural numbers) *)
 
diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v
index abfade57..051f8645 100755..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,v 1.21.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Mult.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Plus.
 Require Export Minus.
diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v
index 01204ee6..4aef7dc0 100755..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,v 1.10.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Peano_dec.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Decidable.
 
diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v
index e4ac631e..56e1c58a 100755..100644
--- a/theories/Arith/Plus.v
+++ b/theories/Arith/Plus.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Plus.v,v 1.18.2.1 2004/07/16 19:31:00 herbelin Exp $ i*)
+(*i $Id: Plus.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Properties of addition *)
 
@@ -199,4 +199,29 @@ Definition tail_plus n m := plus_acc m n.
 Lemma plus_tail_plus : forall n m, n + m = tail_plus n m.
 unfold tail_plus in |- *; induction n as [| n IHn]; simpl in |- *; auto.
 intro m; rewrite <- IHn; simpl in |- *; auto.
-Qed.
\ No newline at end of file
+Qed.
+
+(** 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.
+Qed.
+
+Lemma n_SSn : forall n, n <> S (S n).
+Proof.
+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).
+Qed.
+
+Lemma n_SSSSn : forall n, n <> S (S (S (S n))).
+Proof.
+intro n; exact (succ_plus_discr n 3).
+Qed.
diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v
index 8bf237b5..e1bbfad9 100755..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,v 1.16.2.1 2004/07/16 19:31:01 herbelin Exp $ i*)
+(*i $Id: Wf_nat.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Well-founded relations and natural numbers *)
 
@@ -36,10 +36,12 @@ apply Acc_intro.
 unfold ltof in |- *; intros b ltfafb.
 apply IHn.
 apply lt_le_trans with (f a); auto with arith.
-Qed.
+Defined.
 
 Theorem well_founded_gtof : well_founded gtof.
-Proof well_founded_ltof.
+Proof.
+exact well_founded_ltof.
+Defined.
 
 (** It is possible to directly prove the induction principle going
    back to primitive recursion on natural numbers ([induction_ltof1])
@@ -113,31 +115,30 @@ apply Acc_intro.
 intros b ltfafb.
 apply IHn.
 apply lt_le_trans with (f a); auto with arith.
-Qed.
+Defined.
 
 End Well_founded_Nat.
 
 Lemma lt_wf : well_founded lt.
-Proof well_founded_ltof nat (fun m => m).
+Proof.
+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.
 Proof.
-exact
- (fun p (P:nat -> Set) (F:forall n, (forall m, m < n -> P m) -> P n) =>
-    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.
 Proof.
-exact
- (fun p (P:nat -> Set) (F:forall n, (forall m, m < n -> P m) -> P n) =>
-    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.
+Proof.
 intro p; intros; elim (lt_wf p); auto with arith.
 Qed.
 
@@ -154,8 +155,9 @@ Proof lt_wf_ind.
 Lemma lt_wf_double_rec :
  forall P:nat -> nat -> Set,
    (forall n m,
-      (forall p (q:nat), p < n -> P p q) ->
+      (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.
 Defined.
@@ -165,6 +167,7 @@ Lemma lt_wf_double_ind :
    (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.
 Qed.
@@ -178,29 +181,29 @@ 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).
+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.
-intros x [n fxn]; generalize x fxn; clear x fxn.
+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.
-case (F_compat y x); trivial; 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.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v
index 854eb9e3..ff87eb96 100755..100644
--- a/theories/Bool/Bool.v
+++ b/theories/Bool/Bool.v
@@ -6,32 +6,28 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Bool.v,v 1.29.2.1 2004/07/16 19:31:01 herbelin Exp $ i*)
+(*i $Id: Bool.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
-(** Booleans  *)
+(** ** Booleans  *)
 
 (** The type [bool] is defined in the prelude as
     [Inductive bool : Set := true : bool | false : bool] *)
 
-(** Interpretation of booleans as Proposition *)
+(** Interpretation of booleans as propositions *)
 Definition Is_true (b:bool) :=
   match b with
   | true => True
   | false => False
   end.
-Hint Unfold Is_true: bool.
 
-Lemma Is_true_eq_left : forall x:bool, x = true -> Is_true x.
-Proof.
-  intros; rewrite H; auto with bool.
-Qed.
+(*****************)
+(** Decidability *)
+(*****************)
 
-Lemma Is_true_eq_right : forall x:bool, true = x -> Is_true x.
+Lemma bool_dec : forall b1 b2 : bool, {b1 = b2} + {b1 <> b2}.
 Proof.
-  intros; rewrite <- H; auto with bool.
-Qed.
-
-Hint Immediate Is_true_eq_right Is_true_eq_left: bool.
+  decide equality.
+Defined.
 
 (*******************)
 (** Discrimination *)
@@ -40,24 +36,26 @@ Hint Immediate Is_true_eq_right Is_true_eq_left: bool.
 Lemma diff_true_false : true <> false.
 Proof.
 unfold not in |- *; intro contr; change (Is_true false) in |- *.
-elim contr; simpl in |- *; trivial with bool.
+elim contr; simpl in |- *; trivial.
 Qed.
-Hint Resolve diff_true_false: bool v62.
+Hint Resolve diff_true_false : bool v62.
 
 Lemma diff_false_true : false <> true.
-Proof.
+Proof. 
 red in |- *; intros H; apply diff_true_false.
 symmetry  in |- *.
 assumption.
 Qed.
-Hint Resolve diff_false_true: bool v62.
+Hint Resolve diff_false_true : bool v62.
+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.
 Qed.
-Hint Resolve eq_true_false_abs: bool.
 
 Lemma not_true_is_false : forall b:bool, b <> true -> b = false.
+Proof.
 destruct b.
 intros.
 red in H; elim H.
@@ -67,6 +65,7 @@ reflexivity.
 Qed.
 
 Lemma not_false_is_true : forall b:bool, b <> false -> b = true.
+Proof.
 destruct b.
 intros.
 reflexivity.
@@ -85,6 +84,8 @@ Definition leb (b1 b2:bool) :=
   end.
 Hint Unfold leb: bool v62.
 
+(* Infix "<=" := leb : bool_scope. *)
+
 (*************)
 (** Equality *)
 (*************)
@@ -97,24 +98,9 @@ Definition eqb (b1 b2:bool) : bool :=
   | false, false => true
   end.
 
-Lemma eqb_refl : forall x:bool, Is_true (eqb x x).
-destruct x; simpl in |- *; auto with bool.
-Qed.
-
-Lemma eqb_eq : forall x y:bool, Is_true (eqb x y) -> x = y.
-destruct x; destruct y; simpl in |- *; tauto.
-Qed.
-
-Lemma Is_true_eq_true : forall x:bool, Is_true x -> x = true.
-destruct x; simpl in |- *; tauto.
-Qed.
- 
-Lemma Is_true_eq_true2 : forall x:bool, x = true -> Is_true x.
-destruct x; simpl in |- *; auto with bool.
-Qed.
-
 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.
@@ -130,6 +116,7 @@ trivial with bool.
 Qed.
 
 Lemma eqb_reflx : forall b:bool, eqb b b = true.
+Proof.
 intro b.
 case b.
 trivial with bool.
@@ -137,6 +124,7 @@ 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.
 Qed.
 
@@ -165,10 +153,7 @@ Definition xorb (b1 b2:bool) : bool :=
   | false, false => false
   end.
 
-Definition negb (b:bool) := match b with
-                            | true => false
-                            | false => true
-                            end.
+Definition negb (b:bool) := if b then false else true.
 
 Infix "||" := orb (at level 50, left associativity) : bool_scope.
 Infix "&&" := andb (at level 40, left associativity) : bool_scope.
@@ -179,30 +164,37 @@ Delimit Scope bool_scope with bool.
 
 Bind Scope bool_scope with bool.
 
-(**************************)
-(** Lemmas about [negb]   *)
-(**************************)
+(****************************)
+(** De Morgan laws          *)
+(****************************)
 
-Lemma negb_intro : forall b:bool, b = negb (negb b).
+Lemma negb_orb : forall b1 b2:bool, negb (b1 || b2) = negb b1 && negb b2.
 Proof.
-destruct b; reflexivity.
+  destruct b1; destruct b2; simpl in |- *; reflexivity.
 Qed.
 
-Lemma negb_elim : forall b:bool, negb (negb b) = b.
+Lemma negb_andb : forall b1 b2:bool, negb (b1 && b2) = negb b1 || negb b2.
 Proof.
-destruct b; reflexivity.
+  destruct b1; destruct b2; simpl in |- *; reflexivity.
 Qed.
-       
-Lemma negb_orb : forall b1 b2:bool, negb (b1 || b2) = negb b1 && negb b2.
+
+(********************************)
+(** *** Properties of [negb]    *)
+(********************************)
+
+Lemma negb_involutive : forall b:bool, negb (negb b) = b.
 Proof.
-  destruct b1; destruct b2; simpl in |- *; reflexivity.
+destruct b; reflexivity.
 Qed.
 
-Lemma negb_andb : forall b1 b2:bool, negb (b1 && b2) = negb b1 || negb b2.
+Lemma negb_involutive_reverse : forall b:bool, b = negb (negb b).
 Proof.
-  destruct b1; destruct b2; simpl in |- *; reflexivity.
+destruct b; reflexivity.
 Qed.
 
+Notation negb_elim := negb_involutive (only parsing).
+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.
@@ -215,12 +207,14 @@ destruct b; simpl in |- *; intro; apply diff_true_false;
 Qed.
 
 Lemma eqb_negb1 : forall b:bool, eqb (negb b) b = false.
+Proof.
 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.
@@ -235,22 +229,25 @@ Proof.
 Qed.
 
 
-(****************************)
-(** A few lemmas about [or] *)
-(****************************)
+(********************************)
+(** *** Properties of [orb]     *)
+(********************************)
 
-Lemma orb_prop : forall a b:bool, a || b = true -> a = true \/ b = true.
-destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
- auto with bool.
-Qed.
+Lemma orb_true_elim :
+  forall b1 b2:bool, b1 || b2 = true -> {b1 = true} + {b2 = true}.
+Proof.
+destruct b1; simpl in |- *; auto with bool.
+Defined.
 
-Lemma orb_prop2 : forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b.
+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.
 Qed.
 
 Lemma orb_true_intro :
  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.
@@ -258,37 +255,45 @@ rewrite H; trivial with bool.
 Qed.
 Hint Resolve orb_true_intro: bool v62.
 
-Lemma orb_b_true : forall b:bool, b || true = true.
+Lemma orb_false_intro :
+ forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false.
+Proof.
+intros b1 b2 H1 H2; rewrite H1; rewrite H2; trivial with bool.
+Qed.
+Hint Resolve orb_false_intro: bool v62.
+
+(** [true] is a zero for [orb] *)
+
+Lemma orb_true_r : forall b:bool, b || true = true.
+Proof.
 auto with bool.
 Qed.
-Hint Resolve orb_b_true: bool v62.
+Hint Resolve orb_true_r: bool v62.
 
-Lemma orb_true_b : forall b:bool, true || b = true.
+Lemma orb_true_l : forall b:bool, true || b = true.
+Proof.
 trivial with bool.
 Qed.
 
-Definition orb_true_elim :
-  forall b1 b2:bool, b1 || b2 = true -> {b1 = true} + {b2 = true}.
-destruct b1; simpl in |- *; auto with bool.
-Defined.
+Notation orb_b_true := orb_true_r (only parsing).
+Notation orb_true_b := orb_true_l (only parsing).
 
-Lemma orb_false_intro :
- forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false.
-intros b1 b2 H1 H2; rewrite H1; rewrite H2; trivial with bool.
-Qed.
-Hint Resolve orb_false_intro: bool v62.
+(** [false] is neutral for [orb] *)
 
-Lemma orb_b_false : forall b:bool, b || false = b.
+Lemma orb_false_r : forall b:bool, b || false = b.
 Proof.
   destruct b; trivial with bool.
 Qed.
-Hint Resolve orb_b_false: bool v62.
+Hint Resolve orb_false_r: bool v62.
 
-Lemma orb_false_b : forall b:bool, false || b = b.
+Lemma orb_false_l : forall b:bool, false || b = b.
 Proof.
   destruct b; trivial with bool.
 Qed.
-Hint Resolve orb_false_b: bool v62.
+Hint Resolve orb_false_l: bool v62.
+
+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.
@@ -300,49 +305,48 @@ Proof.
   auto with bool.
 Qed.
 
-Lemma orb_neg_b : forall b:bool, b || negb b = true.
+(** Complementation *)
+
+Lemma orb_negb_r : forall b:bool, b || negb b = true.
 Proof.
   destruct b; reflexivity.
 Qed.
-Hint Resolve orb_neg_b: bool v62.
+Hint Resolve orb_negb_r: bool v62.
+
+Notation orb_neg_b := orb_negb_r (only parsing).
+
+(** Commutativity *)
 
 Lemma orb_comm : forall b1 b2:bool, b1 || b2 = b2 || b1.
+Proof.
 destruct b1; destruct b2; reflexivity.
 Qed.
 
+(** Associativity *)
+
 Lemma orb_assoc : forall b1 b2 b3:bool, b1 || (b2 || b3) = b1 || b2 || b3.
 Proof.
   destruct b1; destruct b2; destruct b3; reflexivity.
 Qed.
+Hint Resolve orb_comm orb_assoc: bool v62.
 
-Hint Resolve orb_comm orb_assoc orb_b_false orb_false_b: bool v62.
-
-(*****************************)
-(** A few lemmas about [and] *)
-(*****************************)
+(*********************************)
+(** *** 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.
 Qed.
 Hint Resolve andb_prop: bool v62.
 
-Definition andb_true_eq :
+Lemma andb_true_eq :
   forall a b:bool, true = a && b -> true = a /\ true = b.
 Proof.
   destruct a; destruct b; auto.
 Defined.
 
-Lemma andb_prop2 :
- 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.
-Qed.
-Hint Resolve andb_prop2: bool v62.
-
 Lemma andb_true_intro :
  forall b1 b2:bool, b1 = true /\ b2 = true -> b1 && b2 = true.
 Proof.
@@ -350,61 +354,130 @@ Proof.
 Qed.
 Hint Resolve andb_true_intro: bool v62.
 
-Lemma andb_true_intro2 :
- forall b1 b2:bool, Is_true b1 -> Is_true b2 -> Is_true (b1 && b2).
-Proof.
-  destruct b1; destruct b2; simpl in |- *; tauto.
-Qed.
-Hint Resolve andb_true_intro2: 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.
 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.
 Qed.
 
-Lemma andb_b_false : forall b:bool, b && false = false.
+(** [false] is a zero for [andb] *)
+
+Lemma andb_false_r : forall b:bool, b && false = false.
+Proof.
 destruct b; auto with bool.
 Qed.
 
-Lemma andb_false_b : forall b:bool, false && b = false.
+Lemma andb_false_l : forall b:bool, false && b = false.
+Proof.
 trivial with bool.
 Qed.
 
-Lemma andb_b_true : forall b:bool, b && true = b.
+Notation andb_b_false := andb_false_r (only parsing).
+Notation andb_false_b := andb_false_l (only parsing).
+
+(** [true] is neutral for [andb] *)
+
+Lemma andb_true_r : forall b:bool, b && true = b.
+Proof.
 destruct b; auto with bool.
 Qed.
 
-Lemma andb_true_b : forall b:bool, true && b = b.
+Lemma andb_true_l : forall b:bool, true && b = b.
+Proof.
 trivial with bool.
 Qed.
 
-Definition andb_false_elim :
+Notation andb_b_true := andb_true_r (only parsing).
+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.
 Defined.
 Hint Resolve andb_false_elim: bool v62.
 
-Lemma andb_neg_b : forall b:bool, b && negb b = false.
+(** Complementation *)
+
+Lemma andb_negb_r : forall b:bool, b && negb b = false.
+Proof.
 destruct b; reflexivity.
 Qed.   
-Hint Resolve andb_neg_b: bool v62.
+Hint Resolve andb_negb_r: bool v62.
+
+Notation andb_neg_b := andb_negb_r (only parsing).
+
+(** Commutativity *)
 
 Lemma andb_comm : forall b1 b2:bool, b1 && b2 = b2 && b1.
+Proof.
 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.
 Qed.
 
 Hint Resolve andb_comm andb_assoc: bool v62.
 
-(*******************************)
-(** Properties of [xorb]       *)
-(*******************************)
+(*******************************************)
+(** *** Properties mixing [andb] and [orb] *)
+(*******************************************)
+
+(** Distributivity *)
+
+Lemma andb_orb_distrib_r :
+ forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3.
+Proof.
+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.
+Qed.
+
+Lemma orb_andb_distrib_r :
+ forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3).
+Proof.
+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).
+Proof.
+destruct b1; destruct b2; destruct b3; reflexivity.
+Qed.
+
+(* Compatibility *)
+Notation demorgan1 := andb_orb_distrib_r (only parsing).
+Notation demorgan2 := andb_orb_distrib_l (only parsing).
+Notation demorgan3 := orb_andb_distrib_r (only parsing).
+Notation demorgan4 := orb_andb_distrib_l (only parsing).
+
+(** Absorption *)
+
+Lemma absoption_andb : forall b1 b2:bool, b1 && (b1 || b2) = b1.
+Proof.
+  destruct b1; destruct b2; simpl in |- *; reflexivity.
+Qed.
+
+Lemma absoption_orb : forall b1 b2:bool, b1 || b1 && b2 = b1.
+Proof.
+  destruct b1; destruct b2; simpl in |- *; reflexivity.
+Qed.
+
+(***********************************)
+(** *** Properties of [xorb]       *)
+(***********************************)
 
 Lemma xorb_false : forall b:bool, xorb b false = b.
 Proof.
@@ -473,71 +546,156 @@ Proof.
   intros. rewrite H. rewrite xorb_assoc. rewrite xorb_nilpotent. apply xorb_false.
 Qed.
 
-(*******************************)
-(** De Morgan's law            *)
-(*******************************)
+(** Lemmas about the [b = true] embedding of [bool] to [Prop] *)
 
-Lemma demorgan1 :
- forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3.
-destruct b1; destruct b2; destruct b3; reflexivity.
+Lemma eq_true_iff_eq : forall b1 b2, (b1 = true <-> b2 = true) -> b1 = b2. 
+Proof. 
+ intros b1 b2; case b1; case b2; intuition.
 Qed.
 
-Lemma demorgan2 :
- forall b1 b2 b3:bool, (b1 || b2) && b3 = b1 && b3 || b2 && b3.
-destruct b1; destruct b2; destruct b3; reflexivity.
+Notation bool_1 := eq_true_iff_eq. (* Compatibility *)
+
+Lemma eq_true_negb_classical : forall b:bool, negb b <> true -> b = true.
+Proof.
+  destruct b; intuition.
 Qed.
 
-Lemma demorgan3 :
- forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3).
-destruct b1; destruct b2; destruct b3; reflexivity.
+Notation bool_3 := eq_true_negb_classical. (* Compatibility *)
+
+Lemma eq_true_not_negb : forall b:bool, b <> true -> negb b = true.  
+Proof.
+  destruct b; intuition.
 Qed.
 
-Lemma demorgan4 :
- forall b1 b2 b3:bool, b1 && b2 || b3 = (b1 || b3) && (b2 || b3).
-destruct b1; destruct b2; destruct b3; reflexivity.
+Notation bool_6 := eq_true_not_negb. (* Compatibility *)
+
+Hint Resolve eq_true_not_negb : bool.
+
+(* An interesting lemma for auto but too strong to keep compatibility *)
+
+Lemma absurd_eq_bool : forall b b':bool, False -> b = b'.
+Proof.
+  contradiction.
 Qed.
 
-Lemma absoption_andb : forall b1 b2:bool, b1 && (b1 || b2) = b1.
+(* A more specific one that preserves compatibility with old hint bool_3 *)
+
+Lemma absurd_eq_true : forall b, False -> b = true.
 Proof.
-  destruct b1; destruct b2; simpl in |- *; reflexivity.
+  contradiction.
 Qed.
+Hint Resolve absurd_eq_true.
 
-Lemma absoption_orb : forall b1 b2:bool, b1 || b1 && b2 = b1.
+(* A specific instance of trans_eq that preserves compatibility with
+   old hint bool_2 *)
+
+Lemma trans_eq_bool : forall x y z:bool, x = y -> y = z -> x = z.
 Proof.
-  destruct b1; destruct b2; simpl in |- *; reflexivity.
+  apply trans_eq.
+Qed.
+Hint Resolve trans_eq_bool.
+
+(*****************************************)
+(** *** Reflection of [bool] into [Prop] *)
+(*****************************************)
+
+(** [Is_true] and equality *)
+
+Hint Unfold Is_true: bool.
+
+Lemma Is_true_eq_true : forall x:bool, Is_true x -> x = true.
+Proof.
+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.
+Qed.
+
+Lemma Is_true_eq_right : forall x:bool, true = x -> Is_true x.
+Proof.
+  intros; rewrite <- H; auto with bool.
+Qed.
+
+Notation Is_true_eq_true2 := Is_true_eq_right (only parsing).
+
+Hint Immediate Is_true_eq_right Is_true_eq_left: bool.
+
+Lemma eqb_refl : forall x:bool, Is_true (eqb x x).
+Proof.
+  destruct x; simpl; auto with bool.
+Qed.
+
+Lemma eqb_eq : forall x y:bool, Is_true (eqb x y) -> x = y.
+Proof.
+  destruct x; destruct y; simpl; tauto.
 Qed.
 
+(** [Is_true] and connectives *)
+
+Lemma orb_prop_elim : 
+ forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b.
+Proof.
+  destruct a; destruct b; simpl; tauto.
+Qed.
 
-(** Misc. equalities between booleans (to be used by Auto) *)
+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).
+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).
+Proof.
+  destruct b1; destruct b2; simpl in |- *; tauto.
+Qed.
+Hint Resolve andb_prop_intro: bool v62.
 
-Lemma bool_1 : forall b1 b2:bool, (b1 = true <-> b2 = true) -> b1 = b2. 
+Notation andb_true_intro2 :=
+  (fun b1 b2 H1 H2 => andb_prop_intro b1 b2 (conj H1 H2))
+  (only parsing).
+
+Lemma andb_prop_elim :
+ 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.
+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. 
 Proof. 
- intros b1 b2; case b1; case b2; intuition.
+ destruct b1; destruct b2; simpl in *; intuition.
 Qed.
 
-Lemma bool_2 : forall b1 b2:bool, b1 = b2 -> b1 = true -> b2 = true.
+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.
 Qed. 
 
-Lemma bool_3 : forall b:bool, negb b <> true -> b = true.
+Lemma negb_prop_elim : forall b, Is_true (negb b) -> ~ Is_true b.
 Proof.
-  destruct b; intuition.
+ destruct b; intuition.
 Qed.
 
-Lemma bool_4 : forall b:bool, b = true -> negb b <> true.  
+Lemma negb_prop_intro : forall b, ~ Is_true b -> Is_true (negb b).
 Proof.
-  destruct b; intuition.
+ destruct b; simpl in *; intuition.
 Qed.
 
-Lemma bool_5 : forall b:bool, negb b = true -> b <> true.
+Lemma negb_prop_classical : forall b, ~ Is_true (negb b) -> Is_true b.
 Proof.
-  destruct b; intuition.
+ destruct b; intuition.
 Qed.
 
-Lemma bool_6 : forall b:bool, b <> true -> negb b = true.  
+Lemma negb_prop_involutive : forall b, Is_true b -> ~ Is_true (negb b).
 Proof.
-  destruct b; intuition.
+ destruct b; intuition.
 Qed.
-
-Hint Resolve bool_1 bool_2 bool_3 bool_4 bool_5 bool_6.
diff --git a/theories/Bool/BoolEq.v b/theories/Bool/BoolEq.v
index e038b3da..806ac70f 100644
--- a/theories/Bool/BoolEq.v
+++ b/theories/Bool/BoolEq.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: BoolEq.v,v 1.4.2.1 2004/07/16 19:31:02 herbelin Exp $ i*)
+(*i $Id: BoolEq.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 (* Cuihtlauac Alvarado - octobre 2000 *)
 
 (** Properties of a boolean equality   *)
diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v
index 51d940cf..b58ed280 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,v 1.6.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: Bvector.v 6844 2005-03-16 13:09:55Z herbelin $ i*)
 
 (** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *)
 
@@ -17,7 +17,7 @@ Require Import Arith.
 Open Local Scope nat_scope.
 
 (*  
-On s'inspire de PolyList pour fabriquer les vecteurs de bits.
+On s'inspire de List.v pour fabriquer les vecteurs de bits.
 La dimension du vecteur est un paramètre trop important pour
 se contenter de la fonction "length".
 La première idée est de faire un record avec la liste et la longueur.
@@ -26,42 +26,9 @@ de nombreux lemmes pour gerer les longueurs.
 La seconde idée est de faire un type dépendant dans lequel la
 longueur est un paramètre de construction. Cela complique un
 peu les inductions structurelles, la solution qui a ma préférence
-est alors d'utiliser un terme de preuve comme définition.
-
-(En effet une définition comme :
-Fixpoint Vunaire [n:nat; v:(vector n)]: (vector n) :=
-Cases v of
-	| Vnil => Vnil
-	| (Vcons a p v') => (Vcons (f a) p (Vunaire p v'))
-end.
-provoque ce message d'erreur :
-Coq < Error: Inference of annotation not yet implemented in this case).
-
-
-	Inductive list [A : Set]  : Set :=
-		nil : (list A) | cons : A->(list A)->(list A).
-	head = [A:Set; l:(list A)] Cases l of
-			| nil => Error
- 			| (cons x _) => (Value x)
- 			end
-     		: (A:Set)(list A)->(option A).
-	tail = [A:Set; l:(list A)]Cases l of
-                   			| nil => (nil A)
-                   			| (cons _ m) => m
-                   			end
-     		: (A:Set)(list A)->(list A).
-	length = [A:Set] Fix length {length [l:(list A)] : nat :=
-      		Cases l of
-       			| nil => O
-      			| (cons _ m) => (S (length m))
-      		end}
-     		: (A:Set)(list A)->nat.
-	map = [A,B:Set; f:(A->B)] Fix map {map [l:(list A)] : (list B) :=
-		Cases l of
-			| nil => (nil B)
-			| (cons a t) => (cons (f a) (map t))
-		end}
-		: (A,B:Set)(A->B)->(list A)->(list B)
+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.
@@ -141,13 +108,6 @@ Proof.
 	exact (Vcons a (S (S n)) (f H0)).
 Defined.
 
-(*
-Lemma S_minus_S : (n,p:nat) (gt n (S p)) -> (S (minus n (S p)))=(minus n p).
-Proof.
-  Intros.
-Save.
-*)
-
 Lemma Vtrunc : forall n p:nat, n > p -> vector n -> vector (n - p).
 Proof.
 	induction p as [| p f]; intros H v.
@@ -203,7 +163,7 @@ 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.
 On en extrait le bit  de poids faible (head) et la fin du vecteur (tail).
diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v
index 1998fb8e..b95b25fd 100755..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,v 1.6.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: DecBool.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Set Implicit Arguments.
 
diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v
index a00449d8..0a98c32a 100755..100644
--- a/theories/Bool/IfProp.v
+++ b/theories/Bool/IfProp.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: IfProp.v,v 1.7.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: IfProp.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Bool.
 
diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v
index 8188f038..2842437d 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,v 1.12.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: Sumbool.v 7235 2005-07-15 17:11:57Z coq $ 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
@@ -63,8 +63,8 @@ Defined.
 
 End connectives.
 
-Hint Resolve sumbool_and sumbool_or sumbool_not: core.
-
+Hint Resolve sumbool_and sumbool_or: core.
+Hint Immediate sumbool_not : core.
 
 (** Any decidability function in type [sumbool] can be turned into a function
     returning a boolean with the corresponding specification: *)
diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v
index b654e556..c9abf94a 100755..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,v 1.8.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: Zerob.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Arith.
 Require Import Bool.
diff --git a/theories/FSets/DecidableType.v b/theories/FSets/DecidableType.v
new file mode 100644
index 00000000..635f6bdb
--- /dev/null
+++ b/theories/FSets/DecidableType.v
@@ -0,0 +1,151 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: DecidableType.v 8639 2006-03-16 19:21:55Z letouzey $ *)
+
+Require Export SetoidList.
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+(** * Types with decidable Equalities (but no ordering) *)
+
+Module Type DecidableType. 
+
+  Parameter t : Set.
+
+  Parameter eq : t -> t -> Prop.
+
+  Axiom eq_refl : forall x : t, eq x x.
+  Axiom eq_sym : forall x y : t, eq x y -> eq y x.
+  Axiom eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z.
+
+  Parameter eq_dec : forall x y : t, { eq x y } + { ~ eq x y }.
+
+  Hint Immediate eq_sym.
+  Hint Resolve eq_refl eq_trans.
+
+End DecidableType. 
+
+
+Module PairDecidableType(D:DecidableType).
+ Import D.
+
+ Section Elt.
+ Variable elt : Set.
+ Notation key:=t.
+
+  Definition eqk (p p':key*elt) := eq (fst p) (fst p').
+  Definition eqke (p p':key*elt) := 
+          eq (fst p) (fst p') /\ (snd p) = (snd p').
+
+  Hint Unfold eqk eqke.
+  Hint Extern 2 (eqke ?a ?b) => split.
+
+   (* eqke is stricter than eqk *)
+ 
+   Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'.
+   Proof.
+     unfold eqk, eqke; intuition.
+   Qed.
+
+  (* eqk, eqke are equalities *)
+ 
+  Lemma eqk_refl : forall e, eqk e e.
+  Proof. auto. Qed.
+
+  Lemma eqke_refl : forall e, eqke e e.
+  Proof. auto. Qed.
+
+  Lemma eqk_sym : forall e e', eqk e e' -> eqk e' e.
+  Proof. auto. Qed.
+
+  Lemma eqke_sym : forall e e', eqke e e' -> eqke e' e.
+  Proof. unfold eqke; intuition. Qed.
+
+  Lemma eqk_trans : forall e e' e'', eqk e e' -> eqk e' e'' -> eqk e e''.
+  Proof. eauto. Qed.
+
+  Lemma eqke_trans : forall e e' e'', eqke e e' -> eqke e' e'' -> eqke e e''.
+  Proof.
+    unfold eqke; intuition; [ eauto | congruence ].
+  Qed.
+
+  Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
+  Hint Immediate eqk_sym eqke_sym.
+
+  Lemma InA_eqke_eqk : 
+     forall x m, InA eqke x m -> InA eqk x m.
+  Proof.
+    unfold eqke; induction 1; intuition.
+  Qed.
+  Hint Resolve InA_eqke_eqk.
+
+  Lemma InA_eqk : forall p q m, eqk p q -> InA eqk p m -> InA eqk q m.
+  Proof.
+   intros; apply InA_eqA with p; auto; apply eqk_trans; auto.
+  Qed.
+
+  Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
+  Definition In k m := exists e:elt, MapsTo k e m.
+
+  Hint Unfold MapsTo In.
+
+  (* An alternative formulation for [In k l] is [exists e, InA eqk (k,e) l] *)
+
+  Lemma In_alt : forall k l, In k l <-> exists e, InA eqk (k,e) l.
+  Proof.
+  firstorder.
+  exists x; auto.
+  induction H.
+  destruct y.
+  exists e; auto.
+  destruct IHInA as [e H0].
+  exists e; auto.
+  Qed.
+
+  Lemma MapsTo_eq : forall l x y e, eq x y -> MapsTo x e l -> MapsTo y e l.
+  Proof.
+  intros; unfold MapsTo in *; apply InA_eqA with (x,e); eauto.
+  Qed.
+
+  Lemma In_eq : forall l x y, eq x y -> In x l -> In y l.
+  Proof.
+  destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto.
+  Qed. 
+
+  Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> eq k k' \/ In k l.
+  Proof.
+    inversion 1.
+    inversion_clear H0; eauto.
+    destruct H1; simpl in *; intuition.
+  Qed.      
+
+  Lemma In_inv_2 : forall k k' e e' l, 
+      InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l.
+  Proof.  
+   inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+  Lemma In_inv_3 : forall x x' l, 
+      InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l.
+  Proof.
+   inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+ End Elt.
+
+ Hint Unfold eqk eqke.
+ Hint Extern 2 (eqke ?a ?b) => split.
+ Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
+ Hint Immediate eqk_sym eqke_sym.
+ Hint Resolve InA_eqke_eqk.
+ Hint Unfold MapsTo In.
+ Hint Resolve In_inv_2 In_inv_3.
+
+
+End PairDecidableType.
diff --git a/theories/FSets/FMapInterface.v b/theories/FSets/FMapInterface.v
new file mode 100644
index 00000000..dde74a0a
--- /dev/null
+++ b/theories/FSets/FMapInterface.v
@@ -0,0 +1,245 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FMapInterface.v 8671 2006-03-29 08:31:28Z letouzey $ *)
+
+(** * Finite map library *)  
+
+(** This file proposes an interface for finite maps *)
+
+(* begin hide *)
+Set Implicit Arguments.
+Unset Strict Implicit.
+Require Import FSetInterface. 
+(* end hide *)
+
+(** When compared with Ocaml Map, this signature has been split in two: 
+   - The first part [S] contains the usual operators (add, find, ...)
+     It only requires a ordered key type, the data type can be arbitrary. 
+     The only function that asks more is [equal], whose first argument should 
+     be an equality on data. 
+   - Then, [Sord] extends [S] with a complete comparison function. For 
+     that, the data type should have a decidable total ordering. 
+*)
+
+
+Module Type S.
+
+  Declare Module E : OrderedType.
+
+  Definition key := E.t.
+
+  Parameter t : Set -> Set. (** the abstract type of maps *)
+ 
+  Section Types. 
+
+    Variable elt:Set.
+
+    Parameter empty : t elt.
+      (** The empty map. *)
+
+    Parameter is_empty : t elt -> bool.
+    (** Test whether a map is empty or not. *)
+
+    Parameter add : key -> elt -> t elt -> t elt.
+    (** [add x y m] returns a map containing the same bindings as [m], 
+	plus a binding of [x] to [y]. If [x] was already bound in [m], 
+	its previous binding disappears. *)
+
+    Parameter find : key -> t elt -> option elt. 
+    (** [find x m] returns the current binding of [x] in [m], 
+	or raises [Not_found] if no such binding exists.
+	NB: in Coq, the exception mechanism becomes a option type. *)
+
+    Parameter remove : key -> t elt -> t elt.
+    (** [remove x m] returns a map containing the same bindings as [m], 
+	except for [x] which is unbound in the returned map. *)
+
+    Parameter mem : key -> t elt -> bool.
+    (** [mem x m] returns [true] if [m] contains a binding for [x], 
+	and [false] otherwise. *)
+
+    (** Coq comment: [iter] is useless in a purely functional world *)
+    (** val iter : (key -> 'a -> unit) -> 'a t -> unit *)
+    (** iter f m applies f to all bindings in map m. f receives the key as 
+	first argument, and the associated value as second argument. 
+	The bindings are passed to f in increasing order with respect to the 
+	ordering over the type of the keys. Only current bindings are 
+	presented to f: bindings hidden by more recent bindings are not 
+	passed to f. *)
+
+    Variable elt' : Set. 
+    Variable elt'': Set.
+
+    Parameter map : (elt -> elt') -> t elt -> t elt'.
+    (** [map f m] returns a map with same domain as [m], where the associated 
+	value a of all bindings of [m] has been replaced by the result of the
+	application of [f] to [a]. The bindings are passed to [f] in 
+	increasing order with respect to the ordering over the type of the 
+	keys. *)
+
+    Parameter mapi : (key -> elt -> elt') -> t elt -> t elt'.
+    (** Same as [S.map], but the function receives as arguments both the 
+	key and the associated value for each binding of the map. *)
+
+    Parameter map2 : (option elt -> option elt' -> option elt'') -> t elt -> t elt' ->  t elt''.
+    (** Not present in Ocaml. 
+         [map f m m'] creates a new map whose bindings belong to the ones of either 
+         [m] or [m']. The presence and value for a key [k] is determined by [f e e'] 
+         where [e] and [e'] are the (optional) bindings of [k] in [m] and [m']. *)
+
+    Parameter elements : t elt -> list (key*elt).
+    (** Not present in Ocaml. 
+         [elements m] returns an assoc list corresponding to the bindings of [m].
+         Elements of this list are sorted with respect to their first components. 
+         Useful to specify [fold] ... *)
+
+    Parameter fold : forall A: Set, (key -> elt -> A -> A) -> t elt -> A -> A.
+    (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], 
+	where [k1] ... [kN] are the keys of all bindings in [m] 
+	(in increasing order), and [d1] ... [dN] are the associated data. *)
+
+    Parameter equal : (elt -> elt -> bool) -> t elt -> t elt -> bool.
+    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, 
+      that is, contain equal keys and associate them with equal data. 
+      [cmp] is the equality predicate used to compare the data associated 
+      with the keys. *)
+
+    Section Spec. 
+      
+      Variable m m' m'' : t elt.
+      Variable x y z : key.
+      Variable e e' : elt.
+
+      Parameter MapsTo : key -> elt -> t elt -> Prop.
+
+      Definition In (k:key)(m: t elt) : Prop := exists e:elt, MapsTo k e m.
+
+      Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m.
+
+      Definition eq_key (p p':key*elt) := E.eq (fst p) (fst p').
+      
+      Definition eq_key_elt (p p':key*elt) := 
+          E.eq (fst p) (fst p') /\ (snd p) = (snd p').
+
+      Definition lt_key (p p':key*elt) := E.lt (fst p) (fst p').
+
+    (** Specification of [MapsTo] *)
+      Parameter MapsTo_1 : E.eq x y -> MapsTo x e m -> MapsTo y e m.
+      
+    (** Specification of [mem] *)
+      Parameter mem_1 : In x m -> mem x m = true.
+      Parameter mem_2 : mem x m = true -> In x m. 
+      
+    (** Specification of [empty] *)
+      Parameter empty_1 : Empty empty.
+
+    (** Specification of [is_empty] *)
+      Parameter is_empty_1 : Empty m -> is_empty m = true. 
+      Parameter is_empty_2 : is_empty m = true -> Empty m.
+      
+    (** Specification of [add] *)
+      Parameter add_1 : E.eq x y -> MapsTo y e (add x e m).
+      Parameter add_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+      Parameter add_3 : ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+
+    (** Specification of [remove] *)
+      Parameter remove_1 : E.eq x y -> ~ In y (remove x m).
+      Parameter remove_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+      Parameter remove_3 : MapsTo y e (remove x m) -> MapsTo y e m.
+
+    (** Specification of [find] *)
+      Parameter find_1 : MapsTo x e m -> find x m = Some e. 
+      Parameter find_2 : find x m = Some e -> MapsTo x e m.
+
+    (** Specification of [elements] *)
+      Parameter elements_1 : 
+        MapsTo x e m -> InA eq_key_elt (x,e) (elements m).
+      Parameter elements_2 : 
+        InA eq_key_elt (x,e) (elements m) -> MapsTo x e m.
+      Parameter elements_3 : sort lt_key (elements m).  
+
+    (** Specification of [fold] *)  
+      Parameter fold_1 :
+	forall (A : Set) (i : A) (f : key -> elt -> A -> A),
+        fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+ 
+   Definition Equal cmp m m' := 
+         (forall k, In k m <-> In k m') /\ 
+         (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).  
+
+   Variable cmp : elt -> elt -> bool. 
+
+   (** Specification of [equal] *)
+     Parameter equal_1 : Equal cmp m m' -> equal cmp m m' = true. 
+     Parameter equal_2 : equal cmp m m' = true -> Equal cmp m m'.
+
+    End Spec. 
+   End Types. 
+
+    (** Specification of [map] *)
+      Parameter map_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)(f:elt->elt'), 
+        MapsTo x e m -> MapsTo x (f e) (map f m).
+      Parameter map_2 : forall (elt elt':Set)(m: t elt)(x:key)(f:elt->elt'), 
+        In x (map f m) -> In x m.
+ 
+    (** Specification of [mapi] *)
+      Parameter mapi_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)
+        (f:key->elt->elt'), MapsTo x e m -> 
+        exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m).
+      Parameter mapi_2 : forall (elt elt':Set)(m: t elt)(x:key)
+        (f:key->elt->elt'), In x (mapi f m) -> In x m.
+
+    (** Specification of [map2] *)
+      Parameter map2_1 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt')
+	(x:key)(f:option elt->option elt'->option elt''), 
+	In x m \/ In x m' -> 
+        find x (map2 f m m') = f (find x m) (find x m').       
+
+     Parameter map2_2 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt')
+	(x:key)(f:option elt->option elt'->option elt''), 
+        In x (map2 f m m') -> In x m \/ In x m'.
+
+  (* begin hide *)
+  Hint Immediate MapsTo_1 mem_2 is_empty_2.
+  
+  Hint Resolve mem_1 is_empty_1 is_empty_2 add_1 add_2 add_3 remove_1
+    remove_2 remove_3 find_1 find_2 fold_1 map_1 map_2 mapi_1 mapi_2. 
+  (* end hide *)
+
+End S.
+
+
+Module Type Sord.
+ 
+  Declare Module Data : OrderedType.   
+  Declare Module MapS : S. 
+  Import MapS.
+  
+  Definition t := MapS.t Data.t. 
+
+  Parameter eq : t -> t -> Prop.
+  Parameter lt : t -> t -> Prop. 
+ 
+  Axiom eq_refl : forall m : t, eq m m.
+  Axiom eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1.
+  Axiom eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3.
+  Axiom lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3.
+  Axiom lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2.
+
+  Definition cmp e e' := match Data.compare e e' with EQ _ => true | _ => false end.	
+
+  Parameter eq_1 : forall m m', Equal cmp m m' -> eq m m'.
+  Parameter eq_2 : forall m m', eq m m' -> Equal cmp m m'.
+
+  Parameter compare : forall m1 m2, Compare lt eq m1 m2.
+  (** Total ordering between maps. The first argument (in Coq: Data.compare) 
+      is a total ordering used to compare data associated with equal keys 
+      in the two maps. *)
+
+End Sord.
\ No newline at end of file
diff --git a/theories/FSets/FMapList.v b/theories/FSets/FMapList.v
new file mode 100644
index 00000000..2d083d5b
--- /dev/null
+++ b/theories/FSets/FMapList.v
@@ -0,0 +1,1271 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FMapList.v 8667 2006-03-28 11:59:44Z letouzey $ *)
+
+(** * Finite map library *)
+
+(** This file proposes an implementation of the non-dependant interface
+ [FMapInterface.S] using lists of pairs ordered (increasing) with respect to
+ left projection. *)
+
+Require Import FSetInterface. 
+Require Import FMapInterface.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+Arguments Scope list [type_scope].
+
+Module Raw (X:OrderedType).
+
+Module E := X.
+Module MX := OrderedTypeFacts X.
+Module PX := PairOrderedType X.
+Import MX. 
+Import PX. 
+
+Definition key := X.t.
+Definition t (elt:Set) := list (X.t * elt).
+
+Section Elt.
+Variable elt : Set.
+
+(* Now in PairOrderedtype: 
+Definition eqk (p p':key*elt) := X.eq (fst p) (fst p').
+Definition eqke (p p':key*elt) := 
+        X.eq (fst p) (fst p') /\ (snd p) = (snd p').
+Definition ltk (p p':key*elt) := X.lt (fst p) (fst p').
+Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
+Definition In k m := exists e:elt, MapsTo k e m.
+*)
+
+Notation eqk := (eqk (elt:=elt)).   
+Notation eqke := (eqke (elt:=elt)).
+Notation ltk := (ltk (elt:=elt)).
+Notation MapsTo := (MapsTo (elt:=elt)).
+Notation In := (In (elt:=elt)).
+Notation Sort := (sort ltk).
+Notation Inf := (lelistA (ltk)).
+
+(** * [empty] *)
+
+Definition empty : t elt := nil.
+
+Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m.
+
+Lemma empty_1 : Empty empty.
+Proof.  
+ unfold Empty,empty.
+ intros a e.
+ intro abs.
+ inversion abs.
+Qed.
+Hint Resolve empty_1.
+
+Lemma empty_sorted : Sort empty.
+Proof. 
+ unfold empty; auto.
+Qed.
+
+(** * [is_empty] *)
+
+Definition is_empty (l : t elt) : bool := if l then true else false.
+
+Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. 
+Proof.
+ unfold Empty, PX.MapsTo.
+ intros m.
+ case m;auto.
+ intros (k,e) l inlist.
+ absurd (InA eqke (k, e) ((k, e) :: l));auto.
+Qed.
+
+Lemma is_empty_2 : forall m, is_empty m = true -> Empty m.
+Proof.  
+ intros m.
+ case m;auto.
+ intros p l abs.
+ inversion abs.
+Qed.
+
+(** * [mem] *)
+
+Fixpoint mem (k : key) (s : t elt) {struct s} : bool :=
+ match s with
+  | nil => false
+  | (k',_) :: l =>
+     match X.compare k k' with
+      | LT _ => false
+      | EQ _ => true
+      | GT _ => mem k l
+     end
+ end.
+
+Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true.
+Proof.  
+ intros m Hm x; generalize Hm; clear Hm.      
+ functional induction mem x m;intros sorted belong1;trivial.
+ 
+ inversion belong1. inversion H.
+ 
+ absurd (In k ((k', e) :: l));try assumption.
+ apply Sort_Inf_NotIn with e;auto.
+
+ apply H.
+ elim (sort_inv sorted);auto.
+ elim (In_inv belong1);auto.
+ intro abs.
+ absurd (X.eq k k');auto.
+Qed. 
+
+Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m. 
+Proof.
+ intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo.
+ functional induction mem x m; intros sorted hyp;try ((inversion hyp);fail).
+ exists e; auto. 
+ induction H; auto.
+ exists x; auto.
+ inversion_clear sorted; auto.
+Qed.
+
+(** * [find] *)
+
+Fixpoint find (k:key) (s: t elt) {struct s} : option elt :=
+ match s with
+  | nil => None
+  | (k',x)::s' => 
+     match X.compare k k' with
+      | LT _ => None
+      | EQ _ => Some x
+      | GT _ => find k s'
+     end
+ end.
+
+Lemma find_2 :  forall m x e, find x m = Some e -> MapsTo x e m.
+Proof.
+ intros m x. unfold PX.MapsTo.
+ functional induction find x m;simpl;intros e' eqfind; inversion eqfind; auto.
+Qed.
+
+Lemma find_1 :  forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e. 
+Proof.
+ intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo.
+ functional induction find x m;simpl; subst; try clear H_eq_1.
+
+ inversion 2.
+
+ inversion_clear 2.
+ compute in H0; destruct H0; order.
+ generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order.
+
+ inversion_clear 2.
+ compute in H0; destruct H0; intuition congruence. 
+ generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order.
+ 
+ do 2 inversion_clear 1; auto.
+ compute in H3; destruct H3; order.
+Qed.
+
+(** * [add] *)
+
+Fixpoint add (k : key) (x : elt) (s : t elt) {struct s} : t elt :=
+ match s with
+  | nil => (k,x) :: nil
+  | (k',y) :: l =>
+     match X.compare k k' with
+      | LT _ => (k,x)::s
+      | EQ _ => (k,x)::l
+      | GT _ => (k',y) :: add k x l
+     end
+ end.
+
+Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m).
+Proof.
+ intros m x y e; generalize y; clear y.
+ unfold PX.MapsTo.
+ functional induction add x e m;simpl;auto.
+Qed.
+
+Lemma add_2 : forall m x y e e', 
+  ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+Proof.
+ intros m x  y e e'. 
+ generalize y e; clear y e; unfold PX.MapsTo.
+ functional induction add x e' m;simpl;auto; clear H_eq_1.
+ intros y' e' eqky';  inversion_clear 1; destruct H0; simpl in *.
+ order.
+ auto.
+ auto.
+ intros y' e' eqky'; inversion_clear 1; intuition.
+Qed.
+  
+Lemma add_3 : forall m x y e e',
+  ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+Proof.
+ intros m x y e e'. generalize y e; clear y e; unfold PX.MapsTo.
+ functional induction add x e' m;simpl; intros.
+ apply (In_inv_3 H0); compute; auto.
+ apply (In_inv_3 H0); compute; auto.
+ constructor 2; apply (In_inv_3 H0); compute; auto. 
+ inversion_clear H1; auto.
+Qed.
+
+Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt), 
+  Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m).
+Proof.
+ induction m.  
+ simpl; intuition.
+ intros.
+ destruct a as (x'',e'').
+ inversion_clear H.
+ compute in H0,H1.
+ simpl; case (X.compare x x''); intuition.
+Qed.
+Hint Resolve add_Inf.
+
+Lemma add_sorted : forall m (Hm:Sort m) x e, Sort (add x e m).
+Proof.
+ induction m.
+ simpl; intuition.
+ intros.
+ destruct a as (x',e').
+ simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto.
+ constructor; auto.
+ apply Inf_eq with (x',e'); auto.
+Qed.  
+
+(** * [remove] *)
+
+Fixpoint remove (k : key) (s : t elt) {struct s} : t elt :=
+ match s with
+  | nil => nil
+  | (k',x) :: l =>
+     match X.compare k k' with
+      | LT _ => s
+      | EQ _ => l
+      | GT _ => (k',x) :: remove k l
+     end
+ end.  
+
+Lemma remove_1 : forall m (Hm:Sort m) x y, X.eq x y -> ~ In y (remove x m).
+Proof.
+ intros m Hm x y; generalize Hm; clear Hm.
+ functional induction remove x m;simpl;intros;subst;try clear H_eq_1.
+ 
+ red; inversion 1; inversion H1.
+
+ apply Sort_Inf_NotIn with x; auto.
+ constructor; compute; order.
+ 
+ inversion_clear Hm.
+ apply Sort_Inf_NotIn with x; auto. 
+ apply Inf_eq with (k',x);auto; compute; apply X.eq_trans with k; auto.
+
+ inversion_clear Hm.
+ assert (notin:~ In y (remove k l)) by auto.
+ intros (x0,abs).
+ inversion_clear abs. 
+ compute in H3; destruct H3; order.
+ apply notin; exists x0; auto.
+Qed.
+
+Lemma remove_2 : forall m (Hm:Sort m) x y e, 
+  ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+Proof.
+ intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo.
+ functional induction remove x m;auto; try clear H_eq_1.
+ inversion_clear 3; auto.
+ compute in H1; destruct H1; order.
+ 
+ inversion_clear 1; inversion_clear 2; auto.
+Qed.
+
+Lemma remove_3 : forall m (Hm:Sort m) x y e, 
+  MapsTo y e (remove x m) -> MapsTo y e m.
+Proof.
+ intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo.
+ functional induction remove x m;auto.
+ inversion_clear 1; inversion_clear 1; auto.
+Qed.
+
+Lemma remove_Inf : forall (m:t elt)(Hm : Sort m)(x x':key)(e':elt), 
+  Inf (x',e') m -> Inf (x',e') (remove x m).
+Proof.
+ induction m.  
+ simpl; intuition.
+ intros.
+ destruct a as (x'',e'').
+ inversion_clear H.
+ compute in H0.
+ simpl; case (X.compare x x''); intuition.
+ inversion_clear Hm.
+ apply Inf_lt with (x'',e''); auto.
+Qed.
+Hint Resolve remove_Inf.
+
+Lemma remove_sorted : forall m (Hm:Sort m) x, Sort (remove x m).
+Proof.
+ induction m.
+ simpl; intuition.
+ intros.
+ destruct a as (x',e').
+ simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto.
+Qed.  
+
+(** * [elements] *)
+
+Definition elements (m: t elt) := m.
+
+Lemma elements_1 : forall m x e, 
+  MapsTo x e m -> InA eqke (x,e) (elements m).
+Proof.
+ auto.
+Qed.
+
+Lemma elements_2 : forall m x e, 
+  InA eqke (x,e) (elements m) -> MapsTo x e m.
+Proof. 
+ auto.
+Qed.
+
+Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m). 
+Proof. 
+ auto.
+Qed.
+
+(** * [fold] *)
+
+Fixpoint fold (A:Set)(f:key->elt->A->A)(m:t elt) {struct m} : A -> A :=
+  fun acc => 
+  match m with
+   | nil => acc
+   | (k,e)::m' => fold f m' (f k e acc)
+  end.
+
+Lemma fold_1 : forall m (A:Set)(i:A)(f:key->elt->A->A),
+  fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+Proof. 
+ intros; functional induction fold A f m i; auto.
+Qed.
+
+(** * [equal] *)
+
+Fixpoint equal (cmp:elt->elt->bool)(m m' : t elt) { struct m } : bool := 
+  match m, m' with 
+   | nil, nil => true
+   | (x,e)::l, (x',e')::l' => 
+      match X.compare x x' with 
+       | EQ _ => cmp e e' && equal cmp l l'
+       | _    => false
+      end 
+   | _, _ => false 
+  end.
+
+Definition Equal cmp m m' := 
+  (forall k, In k m <-> In k m') /\ 
+  (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).  
+
+Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp, 
+  Equal cmp m m' -> equal cmp m m' = true. 
+Proof. 
+ intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
+ functional induction equal cmp m m'; simpl; auto; unfold Equal;
+ intuition; subst; try clear H_eq_3.
+
+ destruct p as (k,e).
+ destruct (H0 k).
+ destruct H2.
+ exists e; auto.
+ inversion H2.
+
+ destruct (H0 x).
+ destruct H.
+ exists e; auto.
+ inversion H.
+
+ destruct (H0 x).
+ assert (In x ((x',e')::l')). 
+  apply H; auto.
+  exists e; auto.
+ destruct (In_inv H3).
+ order.
+ inversion_clear Hm'.
+ assert (Inf (x,e) l').
+ apply Inf_lt with (x',e'); auto.
+ elim (Sort_Inf_NotIn H5 H7 H4).
+ 
+ assert (cmp e e' = true).
+  apply H2 with x; auto.
+ rewrite H0; simpl.
+ apply H; auto.
+ inversion_clear Hm; auto.
+ inversion_clear Hm'; auto.
+ unfold Equal; intuition.
+ destruct (H1 k).
+ assert (In k ((x,e) ::l)).
+  destruct H3 as (e'', hyp); exists e''; auto.
+ destruct (In_inv (H4 H6)); auto.
+ inversion_clear Hm.
+ elim (Sort_Inf_NotIn H8 H9).
+ destruct H3 as (e'', hyp); exists e''; auto.
+ apply MapsTo_eq with k; auto; order.
+ destruct (H1 k).
+ assert (In k ((x',e') ::l')).
+  destruct H3 as (e'', hyp); exists e''; auto.
+ destruct (In_inv (H5 H6)); auto.
+ inversion_clear Hm'.
+ elim (Sort_Inf_NotIn H8 H9).
+ destruct H3 as (e'', hyp); exists e''; auto.
+ apply MapsTo_eq with k; auto; order.
+ apply H2 with k; destruct (eq_dec x k); auto.
+
+ destruct (H0 x').
+ assert (In x' ((x,e)::l)). 
+  apply H2; auto.
+  exists e'; auto.
+ destruct (In_inv H3).
+ order.
+ inversion_clear Hm.
+ assert (Inf (x',e') l).
+  apply Inf_lt with (x,e); auto.
+ elim (Sort_Inf_NotIn H5 H7 H4).
+Qed.
+
+Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp, 
+  equal cmp m m' = true -> Equal cmp m m'.
+Proof.
+ intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
+ functional induction equal cmp m m'; simpl; auto; unfold Equal; 
+  intuition; try discriminate; subst; try clear H_eq_3; 
+  try solve [inversion H0]; destruct (andb_prop _ _ H0); clear H0; 
+  inversion_clear Hm; inversion_clear Hm'.
+
+ destruct (H H0 H5 H3).
+ destruct (In_inv H1).
+ exists e'; constructor; split; trivial; apply X.eq_trans with x; auto.
+ destruct (H7 k).
+ destruct (H10 H9) as (e'',hyp).
+ exists e''; auto.
+
+ destruct (H H0 H5 H3).
+ destruct (In_inv H1).
+ exists e; constructor; split; trivial; apply X.eq_trans with x'; auto.
+ destruct (H7 k).
+ destruct (H11 H9) as (e'',hyp).
+ exists e''; auto.
+
+ destruct (H H0 H6 H4).
+ inversion_clear H1.
+ destruct H10; simpl in *; subst.
+ inversion_clear H2. 
+ destruct H10; simpl in *; subst; auto.
+ elim (Sort_Inf_NotIn H6 H7).
+ exists e'0; apply MapsTo_eq with k; auto; order.
+ inversion_clear H2. 
+ destruct H1; simpl in *; subst; auto.
+ elim (Sort_Inf_NotIn H0 H5).
+ exists e1; apply MapsTo_eq with k; auto; order.
+ apply H9 with k; auto.
+Qed. 
+
+(** This lemma isn't part of the spec of [Equal], but is used in [FMapAVL] *)
+
+Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) ->
+  eqk x y -> cmp (snd x) (snd y) = true -> 
+  (Equal cmp l1 l2 <-> Equal cmp (x :: l1) (y :: l2)).
+Proof.
+ intros.
+ inversion H; subst.
+ inversion H0; subst.
+ destruct x; destruct y; compute in H1, H2.
+ split; intros.
+ apply equal_2; auto.
+ simpl.
+ elim_comp.
+ rewrite H2; simpl.
+ apply equal_1; auto.
+ apply equal_2; auto.
+ generalize (equal_1 H H0 H3).
+ simpl.
+ elim_comp.
+ rewrite H2; simpl; auto.
+Qed.
+
+Variable elt':Set.
+
+(** * [map] and [mapi] *)
+  
+Fixpoint map (f:elt -> elt') (m:t elt) {struct m} : t elt' :=
+  match m with
+   | nil => nil
+   | (k,e)::m' => (k,f e) :: map f m'
+  end.
+
+Fixpoint mapi (f: key -> elt -> elt') (m:t elt) {struct m} : t elt' :=
+  match m with
+   | nil => nil
+   | (k,e)::m' => (k,f k e) :: mapi f m'
+  end.
+
+End Elt.
+Section Elt2. 
+(* A new section is necessary for previous definitions to work 
+   with different [elt], especially [MapsTo]... *)
+  
+Variable elt elt' : Set.
+
+(** Specification of [map] *)
+
+Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), 
+  MapsTo x e m -> MapsTo x (f e) (map f m).
+Proof.
+ intros m x e f.
+ (* functional induction map elt elt' f m.  *) (* Marche pas ??? *)
+ induction m.
+ inversion 1.
+    
+ destruct a as (x',e').
+ simpl. 
+ inversion_clear 1.
+ constructor 1.
+ unfold eqke in *; simpl in *; intuition congruence.
+ constructor 2.
+ unfold MapsTo in *; auto.
+Qed.
+
+Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), 
+  In x (map f m) -> In x m.
+Proof.
+ intros m x f. 
+ (* functional induction map elt elt' f m. *) (* Marche pas ??? *)
+ induction m; simpl.
+ intros (e,abs).
+ inversion abs.
+  
+ destruct a as (x',e).
+ intros hyp.
+ inversion hyp. clear hyp.
+ inversion H; subst; rename x0 into e'.
+ exists e; constructor.
+ unfold eqke in *; simpl in *; intuition.
+ destruct IHm as (e'',hyp).
+ exists e'; auto.
+ exists e''.
+ constructor 2; auto.
+Qed.
+
+Lemma map_lelistA : forall (m: t elt)(x:key)(e:elt)(e':elt')(f:elt->elt'),
+  lelistA (@ltk elt) (x,e) m -> 
+  lelistA (@ltk elt') (x,e') (map f m).
+Proof. 
+ induction m; simpl; auto.
+ intros.
+ destruct a as (x0,e0).
+ inversion_clear H; auto.
+Qed.
+
+Hint Resolve map_lelistA.
+
+Lemma map_sorted : forall (m: t elt)(Hm : sort (@ltk elt) m)(f:elt -> elt'), 
+  sort (@ltk elt') (map f m).
+Proof.   
+ induction m; simpl; auto.
+ intros.
+ destruct a as (x',e').
+ inversion_clear Hm.
+ constructor; auto.
+ exact (map_lelistA _ _ H0).
+Qed.      
+ 
+(** Specification of [mapi] *)
+
+Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), 
+  MapsTo x e m -> 
+  exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m).
+Proof.
+ intros m x e f.
+ (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *)
+ induction m.
+ inversion 1.
+    
+ destruct a as (x',e').
+ simpl. 
+ inversion_clear 1.
+ exists x'.
+ destruct H0; simpl in *.
+ split; auto.
+ constructor 1.
+ unfold eqke in *; simpl in *; intuition congruence.
+ destruct IHm as (y, hyp); auto.
+ exists y; intuition.
+Qed.  
+
+
+Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), 
+  In x (mapi f m) -> In x m.
+Proof.
+ intros m x f. 
+ (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *)
+ induction m; simpl.
+ intros (e,abs).
+ inversion abs.
+   
+ destruct a as (x',e).
+ intros hyp.
+ inversion hyp. clear hyp.
+ inversion H; subst; rename x0 into e'.
+ exists e; constructor.
+ unfold eqke in *; simpl in *; intuition.
+ destruct IHm as (e'',hyp).
+ exists e'; auto.
+ exists e''.
+ constructor 2; auto.
+Qed.
+
+Lemma mapi_lelistA : forall (m: t elt)(x:key)(e:elt)(f:key->elt->elt'),
+  lelistA (@ltk elt) (x,e) m -> 
+  lelistA (@ltk elt') (x,f x e) (mapi f m).
+Proof. 
+ induction m; simpl; auto.
+ intros.
+ destruct a as (x',e').
+ inversion_clear H; auto.
+Qed.
+
+Hint Resolve mapi_lelistA.
+
+Lemma mapi_sorted : forall m (Hm : sort (@ltk elt) m)(f: key ->elt -> elt'), 
+  sort (@ltk elt') (mapi f m).
+Proof.
+ induction m; simpl; auto.
+ intros.
+ destruct a as (x',e').
+ inversion_clear Hm; auto.
+Qed.
+
+End Elt2. 
+Section Elt3.
+
+(** * [map2] *)
+
+Variable elt elt' elt'' : Set.
+Variable f : option elt -> option elt' -> option elt''.
+
+Definition option_cons (A:Set)(k:key)(o:option A)(l:list (key*A)) := 
+  match o with 
+   | Some e => (k,e)::l
+   | None => l
+  end.
+
+Fixpoint map2_l (m : t elt) : t elt'' := 
+  match m with 
+   | nil => nil 
+   | (k,e)::l => option_cons k (f (Some e) None) (map2_l l)
+  end. 
+
+Fixpoint map2_r (m' : t elt') : t elt'' := 
+  match m' with 
+   | nil => nil 
+   | (k,e')::l' => option_cons k (f None (Some e')) (map2_r l')
+  end. 
+
+Fixpoint map2 (m : t elt) : t elt' -> t elt'' :=
+  match m with
+   | nil => map2_r 
+   | (k,e) :: l =>
+      fix map2_aux (m' : t elt') : t elt'' :=
+        match m' with
+         | nil => map2_l m
+         | (k',e') :: l' =>
+            match X.compare k k' with
+             | LT _ => option_cons k (f (Some e) None) (map2 l m')
+             | EQ _ => option_cons k (f (Some e) (Some e')) (map2 l l')
+             | GT _ => option_cons k' (f None (Some e')) (map2_aux l')
+            end
+        end
+  end.      
+
+Notation oee' := (option elt * option elt')%type.
+
+Fixpoint combine (m : t elt) : t elt' -> t oee' :=
+  match m with
+   | nil => map (fun e' => (None,Some e'))
+   | (k,e) :: l =>
+      fix combine_aux (m':t elt') : list (key * oee') :=
+        match m' with
+         | nil => map (fun e => (Some e,None)) m
+         | (k',e') :: l' =>
+            match X.compare k k' with
+             | LT _ => (k,(Some e, None))::combine l m'
+             | EQ _ => (k,(Some e, Some e'))::combine l l'
+             | GT _ => (k',(None,Some e'))::combine_aux l'
+            end
+        end
+  end. 
+
+Definition fold_right_pair (A B C:Set)(f: A->B->C->C)(l:list (A*B))(i:C) := 
+  List.fold_right (fun p => f (fst p) (snd p)) i l.
+
+Definition map2_alt m m' := 
+  let m0 : t oee' := combine m m' in 
+  let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in 
+  fold_right_pair (option_cons (A:=elt'')) m1 nil.
+
+Lemma map2_alt_equiv : forall m m', map2_alt m m' = map2 m m'.
+Proof.
+ unfold map2_alt.
+ induction m.
+ simpl; auto; intros.
+ (* map2_r *)
+ induction m'; try destruct a; simpl; auto.
+ rewrite IHm'; auto.
+ (* fin map2_r *)
+ induction m'; destruct a.
+ simpl; f_equal.
+ (* map2_l *)
+ clear IHm.
+ induction m; try destruct a; simpl; auto.
+ rewrite IHm; auto.
+ (* fin map2_l *)
+ destruct a0.
+ simpl.
+ destruct (X.compare t0 t1); simpl; f_equal.
+ apply IHm.
+ apply IHm.
+ apply IHm'.
+Qed.
+
+Lemma combine_lelistA : 
+  forall m m' (x:key)(e:elt)(e':elt')(e'':oee'), 
+  lelistA (@ltk elt) (x,e) m -> 
+  lelistA (@ltk elt') (x,e') m' -> 
+  lelistA (@ltk oee') (x,e'') (combine m m').
+Proof.
+ induction m. 
+ intros.
+ simpl.
+ exact (map_lelistA _ _ H0).
+ induction m'. 
+ intros.
+ destruct a.
+ replace (combine ((t0, e0) :: m) nil) with 
+             (map (fun e => (Some e,None (A:=elt'))) ((t0,e0)::m)); auto.
+ exact (map_lelistA _ _ H).
+ intros.
+ simpl.
+ destruct a as (k,e0); destruct a0 as (k',e0').
+ destruct (X.compare k k').
+ inversion_clear H; auto.
+ inversion_clear H; auto.
+ inversion_clear H0; auto.
+Qed.
+Hint Resolve combine_lelistA.
+
+Lemma combine_sorted : 
+  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), 
+  sort (@ltk oee') (combine m m').
+Proof.
+ induction m. 
+ intros; clear Hm.
+ simpl.
+ apply map_sorted; auto.
+ induction m'. 
+ intros; clear Hm'.
+ destruct a.
+ replace (combine ((t0, e) :: m) nil) with 
+             (map (fun e => (Some e,None (A:=elt'))) ((t0,e)::m)); auto.
+ apply map_sorted; auto.
+ intros.
+ simpl.
+ destruct a as (k,e); destruct a0 as (k',e').
+ destruct (X.compare k k').
+ inversion_clear Hm.
+ constructor; auto.
+ assert (lelistA (ltk (elt:=elt')) (k, e') ((k',e')::m')) by auto.
+ exact (combine_lelistA _ H0 H1). 
+ inversion_clear Hm; inversion_clear Hm'.
+ constructor; auto.
+ assert (lelistA (ltk (elt:=elt')) (k, e') m') by apply Inf_eq with (k',e'); auto.
+ exact (combine_lelistA _ H0 H3). 
+ inversion_clear Hm; inversion_clear Hm'.
+ constructor; auto.
+ change (lelistA (ltk (elt:=oee')) (k', (None, Some e'))
+                 (combine ((k,e)::m) m')).
+ assert (lelistA (ltk (elt:=elt)) (k', e) ((k,e)::m)) by auto.
+ exact (combine_lelistA _  H3 H2).
+Qed.
+
+Lemma map2_sorted : 
+  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), 
+  sort (@ltk elt'') (map2 m m').
+Proof.
+ intros.
+ rewrite <- map2_alt_equiv.
+ unfold map2_alt.
+ assert (H0:=combine_sorted Hm Hm').
+ set (l0:=combine m m') in *; clearbody l0.
+ set (f':= fun p : oee' => f (fst p) (snd p)).
+ assert (H1:=map_sorted (elt' := option elt'') H0 f').
+ set (l1:=map f' l0) in *; clearbody l1. 
+ clear f' f H0 l0 Hm Hm' m m'.
+ induction l1.
+ simpl; auto.
+ inversion_clear H1.
+ destruct a; destruct o; auto.
+ simpl.
+ constructor; auto.
+ clear IHl1.
+ induction l1.
+ simpl; auto.
+ destruct a; destruct o; simpl; auto.
+ inversion_clear H0; auto.
+ inversion_clear H0.
+ red in H1; simpl in H1.
+ inversion_clear H.
+ apply IHl1; auto.
+ apply Inf_lt with (t1, None (A:=elt'')); auto.
+Qed.
+ 
+Definition at_least_one (o:option elt)(o':option elt') := 
+  match o, o' with 
+   | None, None => None 
+   | _, _  => Some (o,o')
+  end.
+
+Lemma combine_1 : 
+  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), 
+  find x (combine m m') = at_least_one (find x m) (find x m'). 
+Proof.
+ induction m.
+ intros.
+ simpl.
+ induction m'.
+ intros; simpl; auto.
+ simpl; destruct a.
+ simpl; destruct (X.compare x t0); simpl; auto.
+ inversion_clear Hm'; auto.
+ induction m'.
+ (* m' = nil *)
+ intros; destruct a; simpl.
+ destruct (X.compare x t0); simpl; auto.
+ inversion_clear Hm; clear H0 l Hm' IHm t0.
+ induction m; simpl; auto.
+ inversion_clear H.
+ destruct a.
+ simpl; destruct (X.compare x t0); simpl; auto.
+ (* m' <> nil *)
+ intros.
+ destruct a as (k,e); destruct a0 as (k',e'); simpl.
+ inversion Hm; inversion Hm'; subst.
+ destruct (X.compare k k'); simpl;
+  destruct (X.compare x k); 
+   elim_comp || destruct (X.compare x k'); simpl; auto.
+ rewrite IHm; auto; simpl; elim_comp; auto.
+ rewrite IHm; auto; simpl; elim_comp; auto.
+ rewrite IHm; auto; simpl; elim_comp; auto.
+ change (find x (combine ((k, e) :: m) m') = at_least_one None (find x m')).
+ rewrite IHm'; auto. 
+ simpl find; elim_comp; auto.
+ change (find x (combine ((k, e) :: m) m') = Some (Some e, find x m')).
+ rewrite IHm'; auto. 
+ simpl find; elim_comp; auto.
+ change (find x (combine ((k, e) :: m) m') = 
+         at_least_one (find x m) (find x m')).
+ rewrite IHm'; auto. 
+ simpl find; elim_comp; auto.
+Qed.
+
+Definition at_least_one_then_f (o:option elt)(o':option elt') := 
+  match o, o' with 
+   | None, None => None 
+   | _, _  => f o o'
+  end.
+
+Lemma map2_0 : 
+  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), 
+  find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). 
+Proof.
+ intros.
+ rewrite <- map2_alt_equiv.
+ unfold map2_alt.
+ assert (H:=combine_1 Hm Hm' x).
+ assert (H2:=combine_sorted Hm Hm').
+ set (f':= fun p : oee' => f (fst p) (snd p)).
+ set (m0 := combine m m') in *; clearbody m0.
+ set (o:=find x m) in *; clearbody o. 
+ set (o':=find x m') in *; clearbody o'.
+ clear Hm Hm' m m'.
+ generalize H; clear H.
+ match goal with |- ?m=?n -> ?p=?q =>
+   assert ((m=n->p=q)/\(m=None -> p=None)); [|intuition] end.
+ induction m0; simpl in *; intuition.
+ destruct o; destruct o'; simpl in *; try discriminate; auto.
+ destruct a as (k,(oo,oo')); simpl in *.
+ inversion_clear H2.
+ destruct (X.compare x k); simpl in *.
+ (* x < k *)
+ destruct (f' (oo,oo')); simpl.
+ elim_comp.
+ destruct o; destruct o'; simpl in *; try discriminate; auto.
+ destruct (IHm0 H0) as (H2,_); apply H2; auto.
+ rewrite <- H.
+ case_eq (find x m0); intros; auto.
+ assert (ltk (elt:=oee') (x,(oo,oo')) (k,(oo,oo'))).
+  red; auto.
+ destruct (Sort_Inf_NotIn H0 (Inf_lt H4 H1)).
+ exists p; apply find_2; auto.
+ (* x = k *)
+ assert (at_least_one_then_f o o' = f oo oo').
+  destruct o; destruct o'; simpl in *; inversion_clear H; auto.
+ rewrite H2.
+ unfold f'; simpl.
+ destruct (f oo oo'); simpl.
+ elim_comp; auto.
+ destruct (IHm0 H0) as (_,H4); apply H4; auto.
+ case_eq (find x m0); intros; auto.
+ assert (eqk (elt:=oee') (k,(oo,oo')) (x,(oo,oo'))).
+  red; auto.
+ destruct (Sort_Inf_NotIn H0 (Inf_eq (eqk_sym H5) H1)).
+ exists p; apply find_2; auto.
+ (* k < x *)
+ unfold f'; simpl.
+ destruct (f oo oo'); simpl.
+ elim_comp; auto.
+ destruct (IHm0 H0) as (H3,_); apply H3; auto.
+ destruct (IHm0 H0) as (H3,_); apply H3; auto.
+
+ (* None -> None *)
+ destruct a as (k,(oo,oo')).
+ simpl.
+ inversion_clear H2.
+ destruct (X.compare x k).
+ (* x < k *)
+ unfold f'; simpl.
+ destruct (f oo oo'); simpl.
+ elim_comp; auto.
+ destruct (IHm0 H0) as (_,H4); apply H4; auto.
+ case_eq (find x m0); intros; auto.
+ assert (ltk (elt:=oee') (x,(oo,oo')) (k,(oo,oo'))).
+  red; auto.
+ destruct (Sort_Inf_NotIn H0 (Inf_lt H3 H1)).
+ exists p; apply find_2; auto.
+ (* x = k *)
+ discriminate.
+ (* k < x *)
+ unfold f'; simpl.
+ destruct (f oo oo'); simpl.
+ elim_comp; auto.
+ destruct (IHm0 H0) as (_,H4); apply H4; auto.
+ destruct (IHm0 H0) as (_,H4); apply H4; auto.
+Qed.
+
+(** Specification of [map2] *)
+
+Lemma map2_1 : 
+  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key),
+  In x m \/ In x m' -> 
+  find x (map2 m m') = f (find x m) (find x m'). 
+Proof.
+ intros.
+ rewrite map2_0; auto.
+ destruct H as [(e,H)|(e,H)].
+ rewrite (find_1 Hm H).
+ destruct (find x m'); simpl; auto.
+ rewrite (find_1 Hm' H).
+ destruct (find x m); simpl; auto.
+Qed.
+ 
+Lemma map2_2 : 
+  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), 
+  In x (map2 m m') -> In x m \/ In x m'. 
+Proof.
+ intros.
+ destruct H as (e,H).
+ generalize (map2_0 Hm Hm' x).
+ rewrite (find_1 (map2_sorted Hm Hm') H).
+ generalize (@find_2 _ m x).
+ generalize (@find_2 _ m' x).
+ destruct (find x m); 
+   destruct (find x m'); simpl; intros.
+ left; exists e0; auto. 
+ left; exists e0; auto.
+ right; exists e0; auto.
+ discriminate.
+Qed.
+
+End Elt3.
+End Raw.
+
+Module Make (X: OrderedType) <: S with Module E := X.
+Module Raw := Raw X. 
+Module E := X.
+
+Definition key := X.t.
+
+Record slist (elt:Set) : Set :=  
+  {this :> Raw.t elt; sorted : sort (@Raw.PX.ltk elt) this}.
+Definition t (elt:Set) := slist elt. 
+
+Section Elt. 
+ Variable elt elt' elt'':Set. 
+
+ Implicit Types m : t elt.
+
+ Definition empty := Build_slist (Raw.empty_sorted elt).
+ Definition is_empty m := Raw.is_empty m.(this).
+ Definition add x e m := Build_slist (Raw.add_sorted m.(sorted) x e).
+ Definition find x m := Raw.find x m.(this).
+ Definition remove x m := Build_slist (Raw.remove_sorted m.(sorted) x). 
+ Definition mem x m := Raw.mem x m.(this).
+ Definition map f m : t elt' := Build_slist (Raw.map_sorted m.(sorted) f).
+ Definition mapi f m : t elt' := Build_slist (Raw.mapi_sorted m.(sorted) f).
+ Definition map2 f m (m':t elt') : t elt'' := 
+ Build_slist (Raw.map2_sorted f m.(sorted) m'.(sorted)).
+ Definition elements m := @Raw.elements elt m.(this).
+ Definition fold A f m i := @Raw.fold elt A f m.(this) i.
+ Definition equal cmp m m' := @Raw.equal elt cmp m.(this) m'.(this).
+
+ Definition MapsTo x e m := Raw.PX.MapsTo x e m.(this).
+ Definition In x m := Raw.PX.In x m.(this).
+ Definition Empty m := Raw.Empty m.(this).
+ Definition Equal cmp m m' := @Raw.Equal elt cmp m.(this) m'.(this).
+
+ Definition eq_key := Raw.PX.eqk.
+ Definition eq_key_elt := Raw.PX.eqke.
+ Definition lt_key := Raw.PX.ltk.
+
+ Definition MapsTo_1 m := @Raw.PX.MapsTo_eq elt m.(this).
+
+ Definition mem_1 m := @Raw.mem_1 elt m.(this) m.(sorted).
+ Definition mem_2 m := @Raw.mem_2 elt m.(this) m.(sorted).
+
+ Definition empty_1 := @Raw.empty_1.
+
+ Definition is_empty_1 m := @Raw.is_empty_1 elt m.(this).
+ Definition is_empty_2 m := @Raw.is_empty_2 elt m.(this).
+
+ Definition add_1 m := @Raw.add_1 elt m.(this).
+ Definition add_2 m := @Raw.add_2 elt m.(this).
+ Definition add_3 m := @Raw.add_3 elt m.(this).
+
+ Definition remove_1 m := @Raw.remove_1 elt m.(this) m.(sorted).
+ Definition remove_2 m := @Raw.remove_2 elt m.(this) m.(sorted).
+ Definition remove_3 m := @Raw.remove_3 elt m.(this) m.(sorted).
+
+ Definition find_1 m := @Raw.find_1 elt m.(this) m.(sorted).
+ Definition find_2 m := @Raw.find_2 elt m.(this).
+
+ Definition elements_1 m := @Raw.elements_1 elt m.(this). 
+ Definition elements_2 m := @Raw.elements_2 elt m.(this). 
+ Definition elements_3 m := @Raw.elements_3 elt m.(this) m.(sorted). 
+
+ Definition fold_1 m := @Raw.fold_1 elt m.(this).
+
+ Definition map_1 m := @Raw.map_1 elt elt' m.(this).
+ Definition map_2 m := @Raw.map_2 elt elt' m.(this).
+
+ Definition mapi_1 m := @Raw.mapi_1 elt elt' m.(this).
+ Definition mapi_2 m := @Raw.mapi_2 elt elt' m.(this).
+
+ Definition map2_1 m (m':t elt') x f := 
+  @Raw.map2_1 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x.
+ Definition map2_2 m (m':t elt') x f := 
+  @Raw.map2_2 elt elt' elt'' f m.(this) m.(sorted) m'.(this) m'.(sorted) x.
+
+ Definition equal_1 m m' := 
+  @Raw.equal_1 elt m.(this) m.(sorted) m'.(this) m'.(sorted).
+ Definition equal_2 m m' := 
+  @Raw.equal_2 elt m.(this) m.(sorted) m'.(this) m'.(sorted).
+
+ End Elt.
+End Make.
+
+Module Make_ord (X: OrderedType)(D : OrderedType) <: 
+Sord with Module Data := D 
+        with Module MapS.E := X.
+
+Module Data := D.
+Module MapS := Make(X). 
+Import MapS.
+
+Module MD := OrderedTypeFacts(D).
+Import MD.
+
+Definition t := MapS.t D.t. 
+
+Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end.
+
+Fixpoint eq_list (m m' : list (X.t * D.t)) { struct m } : Prop := 
+  match m, m' with 
+   | nil, nil => True
+   | (x,e)::l, (x',e')::l' => 
+      match X.compare x x' with 
+       | EQ _ => D.eq e e' /\ eq_list l l'
+       | _       => False
+      end 
+   | _, _ => False
+  end.
+
+Definition eq m m' := eq_list m.(this) m'.(this).
+
+Fixpoint lt_list (m m' : list (X.t * D.t)) {struct m} : Prop := 
+  match m, m' with 
+   | nil, nil => False
+   | nil, _  => True
+   | _, nil  => False
+   | (x,e)::l, (x',e')::l' => 
+      match X.compare x x' with 
+       | LT _ => True
+       | GT _ => False
+       | EQ _ => D.lt e e' \/ (D.eq e e' /\ lt_list l l')
+      end
+  end.
+
+Definition lt m m' := lt_list m.(this) m'.(this).
+
+Lemma eq_equal : forall m m', eq m m' <-> equal cmp m m' = true.
+Proof.
+ intros (l,Hl); induction l.
+ intros (l',Hl'); unfold eq; simpl.
+ destruct l'; unfold equal; simpl; intuition.
+ intros (l',Hl'); unfold eq.
+ destruct l'.
+ destruct a; unfold equal; simpl; intuition.
+ destruct a as (x,e).
+ destruct p as (x',e').
+ unfold equal; simpl. 
+ destruct (X.compare x x'); simpl; intuition.
+ unfold cmp at 1. 
+ MD.elim_comp; clear H; simpl.
+ inversion_clear Hl.
+ inversion_clear Hl'.
+ destruct (IHl H (Build_slist H3)).
+ unfold equal, eq in H5; simpl in H5; auto.
+ destruct (andb_prop _ _ H); clear H.
+ generalize H0; unfold cmp.
+ MD.elim_comp; auto; intro; discriminate.
+ destruct (andb_prop _ _ H); clear H.
+ inversion_clear Hl.
+ inversion_clear Hl'.
+ destruct (IHl H (Build_slist H3)).
+ unfold equal, eq in H6; simpl in H6; auto.
+Qed.
+
+Lemma eq_1 : forall m m', Equal cmp m m' -> eq m m'.
+Proof.
+ intros.
+ generalize (@equal_1 D.t m m' cmp).
+ generalize (@eq_equal m m').
+ intuition.
+Qed.
+
+Lemma eq_2 : forall m m', eq m m' -> Equal cmp m m'.
+Proof.
+ intros.
+ generalize (@equal_2 D.t m m' cmp).
+ generalize (@eq_equal m m').
+ intuition.
+Qed.
+
+Lemma eq_refl : forall m : t, eq m m.
+Proof.
+ intros (m,Hm); induction m; unfold eq; simpl; auto.
+ destruct a.
+ destruct (X.compare t0 t0); auto.
+ apply (MapS.Raw.MX.lt_antirefl l); auto.
+ split.
+ apply D.eq_refl.
+ inversion_clear Hm.
+ apply (IHm H).
+ apply (MapS.Raw.MX.lt_antirefl l); auto.
+Qed.
+
+Lemma  eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1.
+Proof.
+ intros (m,Hm); induction m; 
+ intros (m', Hm'); destruct m'; unfold eq; simpl;
+ try destruct a as (x,e); try destruct p as (x',e'); auto.
+ destruct (X.compare x x'); MapS.Raw.MX.elim_comp; intuition.
+ inversion_clear Hm; inversion_clear Hm'.
+ apply (IHm H0 (Build_slist H4)); auto.
+Qed.
+
+Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3.
+Proof. 
+ intros (m1,Hm1); induction m1; 
+ intros (m2, Hm2); destruct m2; 
+ intros (m3, Hm3); destruct m3; unfold eq; simpl; 
+ try destruct a as (x,e); 
+ try destruct p as (x',e'); 
+ try destruct p0 as (x'',e''); try contradiction; auto.
+ destruct (X.compare x x'); 
+  destruct (X.compare x' x''); 
+   MapS.Raw.MX.elim_comp.
+ intuition.
+ apply D.eq_trans with e'; auto.
+ inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
+ apply (IHm1 H1 (Build_slist H6) (Build_slist H8)); intuition.
+Qed.
+
+Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3.
+Proof.
+ intros (m1,Hm1); induction m1; 
+ intros (m2, Hm2); destruct m2; 
+ intros (m3, Hm3); destruct m3; unfold lt; simpl; 
+ try destruct a as (x,e); 
+ try destruct p as (x',e'); 
+ try destruct p0 as (x'',e''); try contradiction; auto.
+ destruct (X.compare x x'); 
+  destruct (X.compare x' x''); 
+   MapS.Raw.MX.elim_comp; auto.
+ intuition.
+ left; apply D.lt_trans with e'; auto.
+ left; apply lt_eq with e'; auto.
+ left; apply eq_lt with e'; auto.
+ right.
+ split.
+ apply D.eq_trans with e'; auto.
+ inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
+ apply (IHm1 H2 (Build_slist H6) (Build_slist H8)); intuition.
+Qed.
+
+Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2.
+Proof.
+ intros (m1,Hm1); induction m1; 
+ intros (m2, Hm2); destruct m2; unfold eq, lt; simpl; 
+ try destruct a as (x,e); 
+ try destruct p as (x',e'); try contradiction; auto.
+ destruct (X.compare x x'); auto.
+ intuition.
+ exact (D.lt_not_eq H0 H1).
+ inversion_clear Hm1; inversion_clear Hm2.
+ apply (IHm1 H0 (Build_slist H5)); intuition.
+Qed.
+
+Ltac cmp_solve := unfold eq, lt; simpl; try Raw.MX.elim_comp; auto.
+
+Definition compare : forall m1 m2, Compare lt eq m1 m2.
+Proof.
+ intros (m1,Hm1); induction m1; 
+ intros (m2, Hm2); destruct m2; 
+  [ apply EQ | apply LT | apply GT | ]; cmp_solve.
+ destruct a as (x,e); destruct p as (x',e'). 
+ destruct (X.compare x x'); 
+  [ apply LT | | apply GT ]; cmp_solve.
+ destruct (D.compare e e'); 
+  [ apply LT | | apply GT ]; cmp_solve.
+ assert (Hm11 : sort (Raw.PX.ltk (elt:=D.t)) m1).
+  inversion_clear Hm1; auto.
+ assert (Hm22 : sort (Raw.PX.ltk (elt:=D.t)) m2).
+  inversion_clear Hm2; auto.
+ destruct (IHm1 Hm11 (Build_slist Hm22)); 
+  [ apply LT | apply EQ | apply GT ]; cmp_solve.
+Qed.
+
+End Make_ord. 
diff --git a/syntax/MakeBare.v b/theories/FSets/FMapWeak.v
index 28d9b5ea..90ebeffc 100644
--- a/syntax/MakeBare.v
+++ b/theories/FSets/FMapWeak.v
@@ -1,9 +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        *)
-(************************************************************************)
-Load PPConstr.
-Load PPCases.
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FMapWeak.v 8639 2006-03-16 19:21:55Z letouzey $ *)
+
+Require Export FMapWeakInterface.
+Require Export FMapWeakList.
diff --git a/theories/FSets/FMapWeakInterface.v b/theories/FSets/FMapWeakInterface.v
new file mode 100644
index 00000000..b6df4da5
--- /dev/null
+++ b/theories/FSets/FMapWeakInterface.v
@@ -0,0 +1,201 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FMapWeakInterface.v 8639 2006-03-16 19:21:55Z letouzey $ *)
+
+(** * Finite map library *) 
+
+(** This file proposes an interface for finite maps over keys with decidable 
+     equality, but no decidable order. *)
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Require Import FSetInterface. 
+Require Import FSetWeakInterface. 
+
+Module Type S.
+
+  Declare Module E : DecidableType.
+
+  Definition key := E.t.
+
+  Parameter t : Set -> Set. (** the abstract type of maps *)
+ 
+  Section Types. 
+
+    Variable elt:Set.
+
+    Parameter empty : t elt.
+      (** The empty map. *)
+
+    Parameter is_empty : t elt -> bool.
+    (** Test whether a map is empty or not. *)
+
+    Parameter add : key -> elt -> t elt -> t elt.
+    (** [add x y m] returns a map containing the same bindings as [m], 
+	plus a binding of [x] to [y]. If [x] was already bound in [m], 
+	its previous binding disappears. *)
+
+    Parameter find : key -> t elt -> option elt. 
+    (** [find x m] returns the current binding of [x] in [m], 
+	or raises [Not_found] if no such binding exists.
+	NB: in Coq, the exception mechanism becomes a option type. *)
+
+    Parameter remove : key -> t elt -> t elt.
+    (** [remove x m] returns a map containing the same bindings as [m], 
+	except for [x] which is unbound in the returned map. *)
+
+    Parameter mem : key -> t elt -> bool.
+    (** [mem x m] returns [true] if [m] contains a binding for [x], 
+	and [false] otherwise. *)
+
+    (** Coq comment: [iter] is useless in a purely functional world *)
+    (** val iter : (key -> 'a -> unit) -> 'a t -> unit *)
+    (** iter f m applies f to all bindings in map m. f receives the key as 
+	first argument, and the associated value as second argument. 
+	The bindings are passed to f in increasing order with respect to the 
+	ordering over the type of the keys. Only current bindings are 
+	presented to f: bindings hidden by more recent bindings are not 
+	passed to f. *)
+
+    Variable elt' : Set. 
+    Variable elt'': Set.
+
+    Parameter map : (elt -> elt') -> t elt -> t elt'.
+    (** [map f m] returns a map with same domain as [m], where the associated 
+	value a of all bindings of [m] has been replaced by the result of the
+	application of [f] to [a]. The bindings are passed to [f] in 
+	increasing order with respect to the ordering over the type of the 
+	keys. *)
+
+    Parameter mapi : (key -> elt -> elt') -> t elt -> t elt'.
+    (** Same as [S.map], but the function receives as arguments both the 
+	key and the associated value for each binding of the map. *)
+
+    Parameter map2 : (option elt -> option elt' -> option elt'') -> t elt -> t elt' ->  t elt''.
+    (** Not present in Ocaml. 
+         [map f m m'] creates a new map whose bindings belong to the ones of either 
+         [m] or [m']. The presence and value for a key [k] is determined by [f e e'] 
+         where [e] and [e'] are the (optional) bindings of [k] in [m] and [m']. *)
+
+    Parameter elements : t elt -> list (key*elt).
+    (** Not present in Ocaml. 
+         [elements m] returns an assoc list corresponding to the bindings of [m].
+         Elements of this list are sorted with respect to their first components. 
+         Useful to specify [fold] ... *)
+
+    Parameter fold : forall A: Set, (key -> elt -> A -> A) -> t elt -> A -> A.
+    (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], 
+	where [k1] ... [kN] are the keys of all bindings in [m] 
+	(in increasing order), and [d1] ... [dN] are the associated data. *)
+
+    Parameter equal : (elt -> elt -> bool) -> t elt -> t elt -> bool.
+    (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, 
+      that is, contain equal keys and associate them with equal data. 
+      [cmp] is the equality predicate used to compare the data associated 
+      with the keys. *)
+
+    Section Spec. 
+      
+      Variable m m' m'' : t elt.
+      Variable x y z : key.
+      Variable e e' : elt.
+
+      Parameter MapsTo : key -> elt -> t elt -> Prop.
+
+      Definition In (k:key)(m: t elt) : Prop := exists e:elt, MapsTo k e m.
+
+      Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m.
+
+      Definition eq_key (p p':key*elt) := E.eq (fst p) (fst p').
+      
+      Definition eq_key_elt (p p':key*elt) := 
+          E.eq (fst p) (fst p') /\ (snd p) = (snd p').
+
+    (** Specification of [MapsTo] *)
+      Parameter MapsTo_1 : E.eq x y -> MapsTo x e m -> MapsTo y e m.
+      
+    (** Specification of [mem] *)
+      Parameter mem_1 : In x m -> mem x m = true.
+      Parameter mem_2 : mem x m = true -> In x m. 
+      
+    (** Specification of [empty] *)
+      Parameter empty_1 : Empty empty.
+
+    (** Specification of [is_empty] *)
+      Parameter is_empty_1 : Empty m -> is_empty m = true. 
+      Parameter is_empty_2 : is_empty m = true -> Empty m.
+      
+    (** Specification of [add] *)
+      Parameter add_1 : E.eq x y -> MapsTo y e (add x e m).
+      Parameter add_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+      Parameter add_3 : ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+
+    (** Specification of [remove] *)
+      Parameter remove_1 : E.eq x y -> ~ In y (remove x m).
+      Parameter remove_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+      Parameter remove_3 : MapsTo y e (remove x m) -> MapsTo y e m.
+
+    (** Specification of [find] *)
+      Parameter find_1 : MapsTo x e m -> find x m = Some e. 
+      Parameter find_2 : find x m = Some e -> MapsTo x e m.
+
+    (** Specification of [elements] *)
+      Parameter elements_1 : 
+        MapsTo x e m -> InA eq_key_elt (x,e) (elements m).
+      Parameter elements_2 : 
+        InA eq_key_elt (x,e) (elements m) -> MapsTo x e m.
+      Parameter elements_3 : NoDupA eq_key (elements m).  
+
+    (** Specification of [fold] *)  
+      Parameter fold_1 :
+	forall (A : Set) (i : A) (f : key -> elt -> A -> A),
+        fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+ 
+   Definition Equal cmp m m' := 
+         (forall k, In k m <-> In k m') /\ 
+         (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).  
+
+   Variable cmp : elt -> elt -> bool. 
+
+   (** Specification of [equal] *)
+     Parameter equal_1 : Equal cmp m m' -> equal cmp m m' = true. 
+     Parameter equal_2 : equal cmp m m' = true -> Equal cmp m m'.
+
+    End Spec. 
+   End Types. 
+
+    (** Specification of [map] *)
+      Parameter map_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)(f:elt->elt'), 
+        MapsTo x e m -> MapsTo x (f e) (map f m).
+      Parameter map_2 : forall (elt elt':Set)(m: t elt)(x:key)(f:elt->elt'), 
+        In x (map f m) -> In x m.
+ 
+    (** Specification of [mapi] *)
+      Parameter mapi_1 : forall (elt elt':Set)(m: t elt)(x:key)(e:elt)
+        (f:key->elt->elt'), MapsTo x e m -> 
+        exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m).
+      Parameter mapi_2 : forall (elt elt':Set)(m: t elt)(x:key)
+        (f:key->elt->elt'), In x (mapi f m) -> In x m.
+
+    (** Specification of [map2] *)
+      Parameter map2_1 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt')
+	(x:key)(f:option elt->option elt'->option elt''), 
+	In x m \/ In x m' -> 
+        find x (map2 f m m') = f (find x m) (find x m').       
+
+     Parameter map2_2 : forall (elt elt' elt'':Set)(m: t elt)(m': t elt')
+	(x:key)(f:option elt->option elt'->option elt''), 
+        In x (map2 f m m') -> In x m \/ In x m'.
+
+  Hint Immediate MapsTo_1 mem_2 is_empty_2.
+  
+  Hint Resolve mem_1 is_empty_1 is_empty_2 add_1 add_2 add_3 remove_1
+    remove_2 remove_3 find_1 find_2 fold_1 map_1 map_2 mapi_1 mapi_2. 
+
+End S.
diff --git a/theories/FSets/FMapWeakList.v b/theories/FSets/FMapWeakList.v
new file mode 100644
index 00000000..ce3893e0
--- /dev/null
+++ b/theories/FSets/FMapWeakList.v
@@ -0,0 +1,960 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FMapWeakList.v 8639 2006-03-16 19:21:55Z letouzey $ *)
+
+(** * Finite map library *)  
+
+(** This file proposes an implementation of the non-dependant interface
+ [FMapInterface.S] using lists of pairs,  unordered but without redundancy. *)
+
+Require Import FSetInterface. 
+Require Import FSetWeakInterface.
+Require Import FMapWeakInterface.
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+Arguments Scope list [type_scope].
+
+Module Raw (X:DecidableType).
+
+Module PX := PairDecidableType X.
+Import PX.
+
+Definition key := X.t.
+Definition t (elt:Set) := list (X.t * elt).
+
+Section Elt.
+
+Variable elt : Set.
+
+(* now in PairDecidableType:
+Definition eqk (p p':key*elt) := X.eq (fst p) (fst p').
+Definition eqke (p p':key*elt) := 
+          X.eq (fst p) (fst p') /\ (snd p) = (snd p').
+*)
+
+Notation eqk := (eqk (elt:=elt)).   
+Notation eqke := (eqke (elt:=elt)).
+Notation MapsTo := (MapsTo (elt:=elt)).
+Notation In := (In (elt:=elt)).
+Notation NoDupA := (NoDupA eqk).
+
+(** * [empty] *)
+
+Definition empty : t elt := nil.
+
+Definition Empty m := forall (a : key)(e:elt), ~ MapsTo a e m.
+
+Lemma empty_1 : Empty empty.
+Proof.
+ unfold Empty,empty.
+ intros a e.
+ intro abs.
+ inversion abs.
+Qed.
+
+Hint Resolve empty_1.
+
+Lemma empty_NoDup : NoDupA empty.
+Proof. 
+ unfold empty; auto.
+Qed.
+
+(** * [is_empty] *)
+
+Definition is_empty (l : t elt) : bool := if l then true else false.
+
+Lemma is_empty_1 :forall m, Empty m -> is_empty m = true. 
+Proof.
+ unfold Empty, PX.MapsTo.
+ intros m.
+ case m;auto.
+ intros p l inlist.
+ destruct p.
+ absurd (InA eqke (t0, e) ((t0, e) :: l));auto.
+Qed.
+
+Lemma is_empty_2 : forall m, is_empty m = true -> Empty m.
+Proof.
+ intros m.
+ case m;auto.
+ intros p l abs.
+ inversion abs.
+Qed.
+
+(** * [mem] *)
+
+Fixpoint mem (k : key) (s : t elt) {struct s} : bool :=
+  match s with
+   | nil => false
+   | (k',_) :: l => if X.eq_dec k k' then true else mem k l
+  end.
+
+Lemma mem_1 : forall m (Hm:NoDupA m) x, In x m -> mem x m = true.
+Proof.
+ intros m Hm x; generalize Hm; clear Hm.      
+ functional induction mem x m;intros NoDup belong1;trivial.
+ inversion belong1. inversion H.
+ inversion_clear NoDup.
+ inversion_clear belong1.
+ inversion_clear H3.
+ compute in H4; destruct H4.
+ elim H; auto.
+ apply H0; auto.
+ exists x; auto.
+Qed. 
+
+Lemma mem_2 : forall m (Hm:NoDupA m) x, mem x m = true -> In x m. 
+Proof.
+ intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo.
+ functional induction mem x m; intros NoDup hyp; try discriminate.
+ exists e; auto. 
+ inversion_clear NoDup.
+ destruct H0; auto.
+ exists x; auto.
+Qed.
+
+(** * [find] *)
+
+Fixpoint find (k:key) (s: t elt) {struct s} : option elt :=
+  match s with
+   | nil => None
+   | (k',x)::s' => if X.eq_dec k k' then Some x else find k s'
+  end.
+
+Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m.
+Proof.
+ intros m x. unfold PX.MapsTo.
+ functional induction find x m;simpl;intros e' eqfind; inversion eqfind; auto.
+Qed.
+
+Lemma find_1 : forall m (Hm:NoDupA m) x e, 
+  MapsTo x e m -> find x m = Some e. 
+Proof.
+ intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo.
+ functional induction find x m;simpl; subst; try clear H_eq_1.
+
+ inversion 2.
+
+ do 2 inversion_clear 1.
+ compute in H3; destruct H3; subst; trivial.
+ elim H0; apply InA_eqk with (k,e); auto.
+
+ do 2 inversion_clear 1; auto.
+ compute in H4; destruct H4; elim H; auto.
+Qed.
+
+(* Not part of the exported specifications, used later for [combine]. *)
+
+Lemma find_eq : forall m (Hm:NoDupA m) x x', 
+   X.eq x x' -> find x m = find x' m.
+Proof.
+ induction m; simpl; auto; destruct a; intros.
+ inversion_clear Hm.
+ rewrite (IHm H1 x x'); auto.
+ destruct (X.eq_dec x t0); destruct (X.eq_dec x' t0); trivial.
+ elim n; apply X.eq_trans with x; auto.
+ elim n; apply X.eq_trans with x'; auto.
+Qed.
+
+(** * [add] *)
+
+Fixpoint add (k : key) (x : elt) (s : t elt) {struct s} : t elt :=
+  match s with
+   | nil => (k,x) :: nil
+   | (k',y) :: l => if X.eq_dec k k' then (k,x)::l else (k',y)::add k x l
+  end.
+
+Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m).
+Proof.
+ intros m x y e; generalize y; clear y; unfold PX.MapsTo.
+ functional induction add x e m;simpl;auto.
+Qed.
+
+Lemma add_2 : forall m x y e e', 
+  ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
+Proof.
+ intros m x  y e e'; generalize y e; clear y e; unfold PX.MapsTo.
+ functional induction add x e' m;simpl;auto.
+ intros y' e' eqky';  inversion_clear 1.
+ destruct H1; simpl in *.
+ elim eqky'; apply X.eq_trans with k'; auto.
+ auto.
+ intros y' e' eqky'; inversion_clear 1; intuition.
+Qed.
+  
+Lemma add_3 : forall m x y e e',
+  ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
+Proof.
+ intros m x y e e'. generalize y e; clear y e; unfold PX.MapsTo.
+ functional induction add x e' m;simpl;auto.
+ intros; apply (In_inv_3 H0); auto.
+ constructor 2; apply (In_inv_3 H1); auto.
+ inversion_clear 2; auto.
+Qed.
+
+Lemma add_3' : forall m x y e e', 
+  ~ X.eq x y -> InA eqk (y,e) (add x e' m) -> InA eqk (y,e) m. 
+Proof.
+ intros m x y e e'. generalize y e; clear y e.
+ functional induction add x e' m;simpl;auto.
+ inversion_clear 2.
+ compute in H1; elim H; auto.
+ inversion H1. 
+ constructor 2; inversion_clear H1; auto.
+ compute in H2; elim H0; auto.
+ inversion_clear 2; auto.
+Qed.
+
+Lemma add_NoDup : forall m (Hm:NoDupA m) x e, NoDupA (add x e m).
+Proof.
+ induction m.
+ simpl; constructor; auto; red; inversion 1.
+ intros.
+ destruct a as (x',e').
+ simpl; case (X.eq_dec x x'); inversion_clear Hm; auto.
+ constructor; auto.
+ swap H.
+ apply InA_eqk with (x,e); auto.
+ constructor; auto.
+ swap H; apply add_3' with x e; auto.
+Qed.
+
+(* Not part of the exported specifications, used later for [combine]. *)
+
+Lemma add_eq : forall m (Hm:NoDupA m) x a e, 
+   X.eq x a -> find x (add a e m) = Some e.
+Proof.
+ intros.
+ apply find_1; auto.
+ apply add_NoDup; auto.
+ apply add_1; auto.
+Qed.
+
+Lemma add_not_eq : forall m (Hm:NoDupA m) x a e, 
+  ~X.eq x a -> find x (add a e m) = find x m.
+Proof.
+ intros.
+ case_eq (find x m); intros.
+ apply find_1; auto.
+ apply add_NoDup; auto.
+ apply add_2; auto.
+ apply find_2; auto.
+ case_eq (find x (add a e m)); intros; auto.
+ rewrite <- H0; symmetry.
+ apply find_1; auto.
+ apply add_3 with a e; auto.
+ apply find_2; auto.
+Qed.
+
+
+(** * [remove] *)
+
+Fixpoint remove (k : key) (s : t elt) {struct s} : t elt :=
+  match s with
+   | nil => nil
+   | (k',x) :: l => if X.eq_dec k k' then l else (k',x) :: remove k l
+  end.  
+
+Lemma remove_1 : forall m (Hm:NoDupA m) x y, X.eq x y -> ~ In y (remove x m).
+Proof.
+ intros m Hm x y; generalize Hm; clear Hm.
+ functional induction remove x m;simpl;intros;auto.
+
+ red; inversion 1; inversion H1.
+
+ inversion_clear Hm.
+ subst.
+ swap H1.
+ destruct H3 as (e,H3); unfold PX.MapsTo in H3.
+ apply InA_eqk with (y,e); auto.
+ compute; apply X.eq_trans with k; auto.
+  
+ intro H2.
+ destruct H2 as (e,H2); inversion_clear H2.
+ compute in H3; destruct H3.
+ elim H; apply X.eq_trans with y; auto.
+ inversion_clear Hm.
+ elim (H0 H4 H1).
+ exists e; auto.
+Qed.
+  
+Lemma remove_2 : forall m (Hm:NoDupA m) x y e, 
+  ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
+Proof.
+ intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo.
+ functional induction remove x m;auto.
+ inversion_clear 3; auto.
+ compute in H2; destruct H2.
+ elim H0; apply X.eq_trans with k'; auto.
+  
+ inversion_clear 1; inversion_clear 2; auto.
+Qed.
+
+Lemma remove_3 : forall m (Hm:NoDupA m) x y e, 
+  MapsTo y e (remove x m) -> MapsTo y e m.
+Proof.
+ intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo.
+ functional induction remove x m;auto.
+ do 2 inversion_clear 1; auto.
+Qed.
+
+Lemma remove_3' : forall m (Hm:NoDupA m) x y e, 
+  InA eqk (y,e) (remove x m) -> InA eqk (y,e) m.
+Proof.
+ intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo.
+ functional induction remove x m;auto.
+ do 2 inversion_clear 1; auto.
+Qed.
+
+Lemma remove_NoDup : forall m (Hm:NoDupA m) x, NoDupA (remove x m).
+Proof.
+ induction m.
+ simpl; intuition.
+ intros.
+ inversion_clear Hm.
+ destruct a as (x',e').
+ simpl; case (X.eq_dec x x'); auto.
+ constructor; auto.
+ swap H; apply remove_3' with x; auto.
+Qed.  
+
+(** * [elements] *)
+
+Definition elements (m: t elt) := m.
+
+Lemma elements_1 : forall m x e, MapsTo x e m -> InA eqke (x,e) (elements m).
+Proof.
+ auto.
+Qed.
+
+Lemma elements_2 : forall m x e, InA eqke (x,e) (elements m) -> MapsTo x e m.
+Proof. 
+auto.
+Qed.
+
+Lemma elements_3 : forall m (Hm:NoDupA m), NoDupA (elements m). 
+Proof. 
+ auto.
+Qed.
+
+(** * [fold] *)
+
+Fixpoint fold (A:Set)(f:key->elt->A->A)(m:t elt) {struct m} : A -> A :=
+  fun acc => 
+  match m with
+   | nil => acc
+   | (k,e)::m' => fold f m' (f k e acc)
+  end.
+
+Lemma fold_1 : forall m (A:Set)(i:A)(f:key->elt->A->A),
+  fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
+Proof. 
+ intros; functional induction fold A f m i; auto.
+Qed.
+
+(** * [equal] *)
+
+Definition check (cmp : elt -> elt -> bool)(k:key)(e:elt)(m': t elt) := 
+  match find k m' with 
+   | None => false
+   | Some e' => cmp e e'
+  end.
+
+Definition submap (cmp : elt -> elt -> bool)(m m' : t elt) : bool := 
+  fold (fun k e b => andb (check cmp k e m') b) m true. 
+   
+Definition equal (cmp : elt -> elt -> bool)(m m' : t elt) : bool :=
+  andb (submap cmp m m') (submap (fun e' e => cmp e e') m' m).
+
+Definition Submap cmp m m' := 
+  (forall k, In k m -> In k m') /\ 
+  (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).  
+
+Definition Equal cmp m m' := 
+  (forall k, In k m <-> In k m') /\ 
+  (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).  
+
+Lemma submap_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, 
+  Submap cmp m m' -> submap cmp m m' = true. 
+Proof.
+ unfold Submap, submap.
+ induction m.
+ simpl; auto.
+ destruct a; simpl; intros.
+ destruct H.
+ inversion_clear Hm.
+ assert (H3 : In t0 m').
+  apply H; exists e; auto.
+ destruct H3 as (e', H3).
+ unfold check at 2; rewrite (find_1 Hm' H3).
+ rewrite (H0 t0); simpl; auto.
+ eapply IHm; auto.
+ split; intuition.
+ apply H.
+ destruct H5 as (e'',H5); exists e''; auto.
+ apply H0 with k; auto.
+Qed.
+   
+Lemma submap_2 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, 
+  submap cmp m m' = true -> Submap cmp m m'. 
+Proof.
+ unfold Submap, submap.
+ induction m.
+ simpl; auto.
+ intuition.
+ destruct H0; inversion H0.
+ inversion H0.
+ 
+ destruct a; simpl; intros.
+ inversion_clear Hm.
+ rewrite andb_b_true in H.
+ assert (check cmp t0 e m' = true).
+  clear H1 H0 Hm' IHm.
+  set (b:=check cmp t0 e m') in *.
+  generalize H; clear H; generalize b; clear b.
+  induction m; simpl; auto; intros.
+  destruct a; simpl in *.
+  destruct (andb_prop _ _ (IHm _ H)); auto.
+ rewrite H2 in H.
+ destruct (IHm H1 m' Hm' cmp H); auto.
+ unfold check in H2.
+ case_eq (find t0 m'); [intros e' H5 | intros H5]; 
+  rewrite H5 in H2; try discriminate.
+ split; intros.
+ destruct H6 as (e0,H6); inversion_clear H6.
+ compute in H7; destruct H7; subst.
+ exists e'.
+ apply PX.MapsTo_eq with t0; auto.
+ apply find_2; auto.
+ apply H3.
+ exists e0; auto.
+ inversion_clear H6.
+ compute in H8; destruct H8; subst.
+ rewrite (find_1 Hm' (PX.MapsTo_eq H6 H7)) in H5; congruence.
+ apply H4 with k; auto.
+Qed.
+
+(** Specification of [equal] *)
+
+Lemma equal_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, 
+  Equal cmp m m' -> equal cmp m m' = true. 
+Proof. 
+ unfold Equal, equal.
+ intuition.
+ apply andb_true_intro; split; apply submap_1; unfold Submap; firstorder.
+Qed.
+
+Lemma equal_2 : forall m (Hm:NoDupA m) m' (Hm':NoDupA m') cmp, 
+  equal cmp m m' = true -> Equal cmp m m'.
+Proof.
+ unfold Equal, equal.
+ intros.
+ destruct (andb_prop _ _ H); clear H.
+ generalize (submap_2 Hm Hm' H0).
+ generalize (submap_2 Hm' Hm H1).
+ firstorder.
+Qed. 
+
+Variable elt':Set.
+
+(** * [map] and [mapi] *)
+  
+Fixpoint map (f:elt -> elt') (m:t elt) {struct m} : t elt' :=
+  match m with
+   | nil => nil
+   | (k,e)::m' => (k,f e) :: map f m'
+  end.
+
+Fixpoint mapi (f: key -> elt -> elt') (m:t elt) {struct m} : t elt' :=
+  match m with
+   | nil => nil
+   | (k,e)::m' => (k,f k e) :: mapi f m'
+  end.
+
+End Elt.
+Section Elt2. 
+(* A new section is necessary for previous definitions to work 
+   with different [elt], especially [MapsTo]... *)
+  
+Variable elt elt' : Set.
+
+(** Specification of [map] *)
+
+Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), 
+  MapsTo x e m -> MapsTo x (f e) (map f m).
+Proof.
+ intros m x e f.
+ (* functional induction map elt elt' f m.  *) (* Marche pas ??? *)
+ induction m.
+ inversion 1.
+    
+ destruct a as (x',e').
+ simpl. 
+ inversion_clear 1.
+ constructor 1.
+ unfold eqke in *; simpl in *; intuition congruence.
+ constructor 2.
+ unfold MapsTo in *; auto.
+Qed.
+
+Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), 
+  In x (map f m) -> In x m.
+Proof.
+ intros m x f. 
+ (* functional induction map elt elt' f m. *) (* Marche pas ??? *)
+ induction m; simpl.
+ intros (e,abs).
+ inversion abs.
+    
+ destruct a as (x',e).
+ intros hyp.
+ inversion hyp. clear hyp.
+ inversion H; subst; rename x0 into e'.
+ exists e; constructor.
+ unfold eqke in *; simpl in *; intuition.
+ destruct IHm as (e'',hyp).
+ exists e'; auto.
+ exists e''.
+ constructor 2; auto.
+Qed.
+
+Lemma map_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f:elt->elt'), 
+  NoDupA (@eqk elt') (map f m).
+Proof.   
+ induction m; simpl; auto.
+ intros.
+ destruct a as (x',e').
+ inversion_clear Hm.
+ constructor; auto.
+ swap H.
+ (* il faut un map_1 avec eqk au lieu de eqke *)
+ clear IHm H0. 
+ induction m; simpl in *; auto.
+ inversion H1.
+ destruct a; inversion H1; auto.
+Qed.      
+ 
+(** Specification of [mapi] *)
+
+Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), 
+  MapsTo x e m -> 
+  exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m).
+Proof.
+ intros m x e f.
+ (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *)
+ induction m.
+ inversion 1.
+    
+ destruct a as (x',e').
+ simpl. 
+ inversion_clear 1.
+ exists x'.
+ destruct H0; simpl in *.
+ split; auto.
+ constructor 1.
+ unfold eqke in *; simpl in *; intuition congruence.
+ destruct IHm as (y, hyp); auto.
+ exists y; intuition.
+Qed.  
+
+Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), 
+  In x (mapi f m) -> In x m.
+Proof.
+ intros m x f. 
+ (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *)
+ induction m; simpl.
+ intros (e,abs).
+ inversion abs.
+    
+ destruct a as (x',e).
+ intros hyp.
+ inversion hyp. clear hyp.
+ inversion H; subst; rename x0 into e'.
+ exists e; constructor.
+ unfold eqke in *; simpl in *; intuition.
+ destruct IHm as (e'',hyp).
+ exists e'; auto.
+ exists e''.
+ constructor 2; auto.
+Qed.
+
+Lemma mapi_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f: key->elt->elt'), 
+  NoDupA (@eqk elt') (mapi f m).
+Proof.
+ induction m; simpl; auto.
+ intros.
+ destruct a as (x',e').
+ inversion_clear Hm; auto.
+ constructor; auto.
+ swap H.
+ clear IHm H0.
+ induction m; simpl in *; auto.
+ inversion_clear H1.
+ destruct a; inversion_clear H1; auto.
+Qed.
+
+End Elt2. 
+Section Elt3.
+
+Variable elt elt' elt'' : Set.
+
+Notation oee' := (option elt * option elt')%type.
+	
+Definition combine_l (m:t elt)(m':t elt') : t oee' :=
+  mapi (fun k e => (Some e, find k m')) m.	
+
+Definition combine_r (m:t elt)(m':t elt') : t oee' :=
+  mapi (fun k e' => (find k m, Some e')) m'.	
+
+Definition fold_right_pair (A B C:Set)(f:A->B->C->C)(l:list (A*B))(i:C) := 
+  List.fold_right (fun p => f (fst p) (snd p)) i l.
+
+Definition combine (m:t elt)(m':t elt') : t oee' := 
+  let l := combine_l m m' in 
+  let r := combine_r m m' in 
+  fold_right_pair (add (elt:=oee')) l r.
+
+Lemma fold_right_pair_NoDup : 
+  forall l r (Hl: NoDupA (eqk (elt:=oee')) l) 
+    (Hl: NoDupA (eqk (elt:=oee')) r), 
+    NoDupA (eqk (elt:=oee')) (fold_right_pair (add (elt:=oee')) l r).
+Proof.
+ induction l; simpl; auto.
+ destruct a; simpl; auto.
+ inversion_clear 1.
+ intros; apply add_NoDup; auto.
+Qed.
+Hint Resolve fold_right_pair_NoDup.
+
+Lemma combine_NoDup : 
+  forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), 
+  NoDupA (@eqk oee') (combine m m').
+Proof.
+ unfold combine, combine_r, combine_l.
+ intros.
+ set (f1 := fun (k : key) (e : elt) => (Some e, find k m')).
+ set (f2 := fun (k : key) (e' : elt') => (find k m, Some e')).
+ generalize (mapi_NoDup Hm f1).
+ generalize (mapi_NoDup Hm' f2).
+ set (l := mapi f1 m); clearbody l.
+ set (r := mapi f2 m'); clearbody r.
+ auto.
+Qed.
+
+Definition at_least_left (o:option elt)(o':option elt') := 
+  match o with 
+   | None => None 
+   | _  => Some (o,o')
+  end.
+
+Definition at_least_right (o:option elt)(o':option elt') := 
+  match o' with 
+   | None => None 
+   | _  => Some (o,o')
+  end.
+
+Lemma combine_l_1 : 
+  forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), 
+  find x (combine_l m m') = at_least_left (find x m) (find x m'). 
+Proof.
+ unfold combine_l.
+ intros.
+ case_eq (find x m); intros.
+ simpl.
+ apply find_1.
+ apply mapi_NoDup; auto.
+ destruct (mapi_1 (fun k e => (Some e, find k m')) (find_2 H)) as (y,(H0,H1)).
+ rewrite (find_eq Hm' (X.eq_sym H0)); auto.
+ simpl.
+ case_eq (find x (mapi (fun k e => (Some e, find k m')) m)); intros; auto.
+ destruct (@mapi_2 _ _ m x (fun k e => (Some e, find k m'))).
+ exists p; apply find_2; auto.
+ rewrite (find_1 Hm H1) in H; discriminate.
+Qed.
+
+Lemma combine_r_1 : 
+  forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), 
+  find x (combine_r m m') = at_least_right (find x m) (find x m'). 
+Proof.
+ unfold combine_r.
+ intros.
+ case_eq (find x m'); intros.
+ simpl.
+ apply find_1.
+ apply mapi_NoDup; auto.
+ destruct (mapi_1 (fun k e => (find k m, Some e)) (find_2 H)) as (y,(H0,H1)).
+ rewrite (find_eq Hm (X.eq_sym H0)); auto.
+ simpl.
+ case_eq (find x (mapi (fun k e' => (find k m, Some e')) m')); intros; auto.
+ destruct (@mapi_2 _ _ m' x (fun k e' => (find k m, Some e'))).
+ exists p; apply find_2; auto.
+ rewrite (find_1 Hm' H1) in H; discriminate.
+Qed.
+
+Definition at_least_one (o:option elt)(o':option elt') := 
+  match o, o' with 
+   | None, None => None 
+   | _, _  => Some (o,o')
+  end.
+
+Lemma combine_1 : 
+  forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), 
+  find x (combine m m') = at_least_one (find x m) (find x m'). 
+Proof.
+ unfold combine.
+ intros.
+ generalize (combine_r_1 Hm Hm' x).
+ generalize (combine_l_1 Hm Hm' x).
+ assert (NoDupA (eqk (elt:=oee')) (combine_l m m')).
+  unfold combine_l; apply mapi_NoDup; auto.
+ assert (NoDupA (eqk (elt:=oee')) (combine_r m m')).
+  unfold combine_r; apply mapi_NoDup; auto.
+ set (l := combine_l m m') in *; clearbody l.
+ set (r := combine_r m m') in *; clearbody r.
+ set (o := find x m); clearbody o.
+ set (o' := find x m'); clearbody o'.
+ clear Hm' Hm m m'.
+ induction l.
+ destruct o; destruct o'; simpl; intros; discriminate || auto.
+ destruct a; simpl in *; intros.
+ destruct (X.eq_dec x t0); simpl in *.
+ unfold at_least_left in H1.
+ destruct o; simpl in *; try discriminate.
+ inversion H1; subst.
+ apply add_eq; auto.
+ inversion_clear H; auto.
+ inversion_clear H.
+ rewrite <- IHl; auto.
+ apply add_not_eq; auto.
+Qed.
+
+Variable f : option elt -> option elt' -> option elt''.
+
+Definition option_cons (A:Set)(k:key)(o:option A)(l:list (key*A)) := 
+  match o with
+   | Some e => (k,e)::l
+   | None => l
+  end.
+
+Definition map2 m m' := 
+  let m0 : t oee' := combine m m' in 
+  let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in 
+  fold_right_pair (option_cons (A:=elt'')) m1 nil.
+
+Lemma map2_NoDup : 
+  forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), 
+  NoDupA (@eqk elt'') (map2 m m').
+Proof.
+ intros.
+ unfold map2.
+ assert (H0:=combine_NoDup Hm Hm').
+ set (l0:=combine m m') in *; clearbody l0.
+ set (f':= fun p : oee' => f (fst p) (snd p)).
+ assert (H1:=map_NoDup (elt' := option elt'') H0 f').
+ set (l1:=map f' l0) in *; clearbody l1. 
+ clear f' f H0 l0 Hm Hm' m m'.
+ induction l1.
+ simpl; auto.
+ inversion_clear H1.
+ destruct a; destruct o; simpl; auto.
+ constructor; auto.
+ swap H.
+ clear IHl1.
+ induction l1.
+ inversion H1.
+ inversion_clear H0.
+ destruct a; destruct o; simpl in *; auto.
+ inversion_clear  H1; auto.
+Qed.
+
+Definition at_least_one_then_f (o:option elt)(o':option elt') := 
+  match o, o' with 
+   | None, None => None 
+   | _, _  => f o o'
+  end.
+
+Lemma map2_0 : 
+  forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), 
+  find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). 
+Proof.
+ intros.
+ unfold map2.
+ assert (H:=combine_1 Hm Hm' x).
+ assert (H2:=combine_NoDup Hm Hm').
+ set (f':= fun p : oee' => f (fst p) (snd p)).
+ set (m0 := combine m m') in *; clearbody m0.
+ set (o:=find x m) in *; clearbody o. 
+ set (o':=find x m') in *; clearbody o'.
+ clear Hm Hm' m m'.
+ generalize H; clear H.
+ match goal with |- ?m=?n -> ?p=?q =>
+   assert ((m=n->p=q)/\(m=None -> p=None)); [|intuition] end.
+ induction m0; simpl in *; intuition.
+ destruct o; destruct o'; simpl in *; try discriminate; auto.
+ destruct a as (k,(oo,oo')); simpl in *.
+ inversion_clear H2.
+ destruct (X.eq_dec x k); simpl in *.
+ (* x = k *)
+ assert (at_least_one_then_f o o' = f oo oo').
+  destruct o; destruct o'; simpl in *; inversion_clear H; auto.
+ rewrite H2.
+ unfold f'; simpl.
+ destruct (f oo oo'); simpl. 
+ destruct (X.eq_dec x k); try absurd_hyp n; auto.
+ destruct (IHm0 H1) as (_,H4); apply H4; auto.
+ case_eq (find x m0); intros; auto.
+ elim H0.
+ apply InA_eqk with (x,p); auto.
+ apply InA_eqke_eqk.
+ exact (find_2 H3). 
+ (* k < x *)
+ unfold f'; simpl.
+ destruct (f oo oo'); simpl.
+ destruct (X.eq_dec x k); [ absurd_hyp n; auto | auto].
+ destruct (IHm0 H1) as (H3,_); apply H3; auto.
+ destruct (IHm0 H1) as (H3,_); apply H3; auto.
+
+ (* None -> None *)
+ destruct a as (k,(oo,oo')).
+ simpl.
+ inversion_clear H2.
+ destruct (X.eq_dec x k).
+ (* x = k *)
+ discriminate.
+ (* k < x *)
+ unfold f'; simpl.
+ destruct (f oo oo'); simpl.
+ destruct (X.eq_dec x k); [ absurd_hyp n; auto | auto].
+ destruct (IHm0 H1) as (_,H4); apply H4; auto.
+ destruct (IHm0 H1) as (_,H4); apply H4; auto.
+Qed.
+
+(** Specification of [map2] *)
+Lemma map2_1 : 
+  forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key),
+  In x m \/ In x m' -> 
+  find x (map2 m m') = f (find x m) (find x m'). 
+Proof.
+ intros.
+ rewrite map2_0; auto.
+ destruct H as [(e,H)|(e,H)].
+ rewrite (find_1 Hm H).
+ destruct (find x m'); simpl; auto.
+ rewrite (find_1 Hm' H).
+ destruct (find x m); simpl; auto.
+Qed.
+ 
+Lemma map2_2 : 
+  forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), 
+  In x (map2 m m') -> In x m \/ In x m'. 
+Proof.
+ intros.
+ destruct H as (e,H).
+ generalize (map2_0 Hm Hm' x).
+ rewrite (find_1 (map2_NoDup Hm Hm') H).
+ generalize (@find_2 _ m x).
+ generalize (@find_2 _ m' x).
+ destruct (find x m); 
+   destruct (find x m'); simpl; intros.
+ left; exists e0; auto. 
+ left; exists e0; auto.
+ right; exists e0; auto.
+ discriminate.
+Qed.
+
+End Elt3.
+End Raw.
+
+
+Module Make (X: DecidableType) <: S with Module E:=X.
+ Module Raw := Raw X. 
+
+ Module E := X.
+ Definition key := X.t. 
+
+ Record slist (elt:Set) : Set :=  
+  {this :> Raw.t elt; NoDup : NoDupA (@Raw.PX.eqk elt) this}.
+ Definition t (elt:Set) := slist elt. 
+
+ Section Elt. 
+ Variable elt elt' elt'':Set. 
+
+ Implicit Types m : t elt.
+
+ Definition empty := Build_slist (Raw.empty_NoDup elt).
+ Definition is_empty m := Raw.is_empty m.(this).
+ Definition add x e m := Build_slist (Raw.add_NoDup m.(NoDup) x e).
+ Definition find x m := Raw.find x m.(this).
+ Definition remove x m := Build_slist (Raw.remove_NoDup m.(NoDup) x). 
+ Definition mem x m := Raw.mem x m.(this).
+ Definition map f m : t elt' := Build_slist (Raw.map_NoDup m.(NoDup) f).
+ Definition mapi f m : t elt' := Build_slist (Raw.mapi_NoDup m.(NoDup) f).
+ Definition map2 f m (m':t elt') : t elt'' := 
+ Build_slist (Raw.map2_NoDup f m.(NoDup) m'.(NoDup)).
+ Definition elements m := @Raw.elements elt m.(this).
+ Definition fold A f m i := @Raw.fold elt A f m.(this) i.
+ Definition equal cmp m m' := @Raw.equal elt cmp m.(this) m'.(this).
+
+ Definition MapsTo x e m := Raw.PX.MapsTo x e m.(this).
+ Definition In x m := Raw.PX.In x m.(this).
+ Definition Empty m := Raw.Empty m.(this).
+ Definition Equal cmp m m' := @Raw.Equal elt cmp m.(this) m'.(this).
+
+ Definition eq_key (p p':key*elt) := X.eq (fst p) (fst p').
+ 
+ Definition eq_key_elt (p p':key*elt) := 
+      X.eq (fst p) (fst p') /\ (snd p) = (snd p').
+
+ Definition MapsTo_1 m := @Raw.PX.MapsTo_eq elt m.(this).
+
+ Definition mem_1 m := @Raw.mem_1 elt m.(this) m.(NoDup).
+ Definition mem_2 m := @Raw.mem_2 elt m.(this) m.(NoDup).
+
+ Definition empty_1 := @Raw.empty_1.
+
+ Definition is_empty_1 m := @Raw.is_empty_1 elt m.(this).
+ Definition is_empty_2 m := @Raw.is_empty_2 elt m.(this).
+
+ Definition add_1 m := @Raw.add_1 elt m.(this).
+ Definition add_2 m := @Raw.add_2 elt m.(this).
+ Definition add_3 m := @Raw.add_3 elt m.(this).
+
+ Definition remove_1 m := @Raw.remove_1 elt m.(this) m.(NoDup).
+ Definition remove_2 m := @Raw.remove_2 elt m.(this) m.(NoDup).
+ Definition remove_3 m := @Raw.remove_3 elt m.(this) m.(NoDup).
+
+ Definition find_1 m := @Raw.find_1 elt m.(this) m.(NoDup).
+ Definition find_2 m := @Raw.find_2 elt m.(this).
+
+ Definition elements_1 m := @Raw.elements_1 elt m.(this).
+ Definition elements_2 m := @Raw.elements_2 elt m.(this).
+ Definition elements_3 m := @Raw.elements_3 elt m.(this) m.(NoDup).
+
+ Definition fold_1 m := @Raw.fold_1 elt m.(this).
+
+ Definition map_1 m := @Raw.map_1 elt elt' m.(this).
+ Definition map_2 m := @Raw.map_2 elt elt' m.(this).
+
+ Definition mapi_1 m := @Raw.mapi_1 elt elt' m.(this).
+ Definition mapi_2 m := @Raw.mapi_2 elt elt' m.(this).
+
+ Definition map2_1 m (m':t elt') x f := 
+  @Raw.map2_1 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x.
+ Definition map2_2 m (m':t elt') x f := 
+  @Raw.map2_2 elt elt' elt'' f m.(this) m.(NoDup) m'.(this) m'.(NoDup) x.
+
+ Definition equal_1 m m' := @Raw.equal_1 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup).
+ Definition equal_2 m m' := @Raw.equal_2 elt m.(this) m.(NoDup) m'.(this) m'.(NoDup).
+
+ End Elt.
+End Make.
+
+
diff --git a/states7/MakeInitial.v b/theories/FSets/FMaps.v
index 64c540fa..ae5b86c9 100644
--- a/states7/MakeInitial.v
+++ b/theories/FSets/FMaps.v
@@ -1,9 +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        *)
-(************************************************************************)
-Require Export Prelude.
-Require Export Logic_Type.
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FMaps.v 8667 2006-03-28 11:59:44Z letouzey $ *)
+
+Require Export FMapInterface.
+Require Export FMapList.
diff --git a/theories/FSets/FSetBridge.v b/theories/FSets/FSetBridge.v
new file mode 100644
index 00000000..3ea50df8
--- /dev/null
+++ b/theories/FSets/FSetBridge.v
@@ -0,0 +1,750 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetBridge.v 8639 2006-03-16 19:21:55Z letouzey $ *)
+
+(** * Finite sets library *)
+
+(** This module implements bridges (as functors) from dependent
+    to/from non-dependent set signature. *)
+
+Require Export FSetInterface.
+Set Implicit Arguments.
+Unset Strict Implicit.
+Set Firstorder Depth 2.
+
+(** * From non-dependent signature [S] to dependent signature [Sdep]. *)
+
+Module DepOfNodep (M: S) <: Sdep with Module E := M.E.
+  Import M.
+
+  Module ME := OrderedTypeFacts E.
+   
+  Definition empty : {s : t | Empty s}.
+  Proof. 
+    exists empty; auto.
+  Qed.
+
+  Definition is_empty : forall s : t, {Empty s} + {~ Empty s}.
+  Proof. 
+    intros; generalize (is_empty_1 (s:=s)) (is_empty_2 (s:=s)).
+    case (is_empty s); intuition.
+  Qed.
+
+
+  Definition mem : forall (x : elt) (s : t), {In x s} + {~ In x s}.
+  Proof. 
+    intros; generalize (mem_1 (s:=s) (x:=x)) (mem_2 (s:=s) (x:=x)).
+    case (mem x s); intuition.
+  Qed.
+ 
+  Definition Add (x : elt) (s s' : t) :=
+    forall y : elt, In y s' <-> E.eq x y \/ In y s.
+ 
+  Definition add : forall (x : elt) (s : t), {s' : t | Add x s s'}.
+  Proof.
+    intros; exists (add x s); auto.
+    unfold Add in |- *; intuition.
+    elim (ME.eq_dec x y); auto.
+    intros; right. 
+    eapply add_3; eauto.
+  Qed. 
+ 
+  Definition singleton :
+    forall x : elt, {s : t | forall y : elt, In y s <-> E.eq x y}.
+  Proof. 
+    intros; exists (singleton x); intuition.
+  Qed.
+ 
+  Definition remove :
+    forall (x : elt) (s : t),
+    {s' : t | forall y : elt, In y s' <-> ~ E.eq x y /\ In y s}.
+  Proof.
+    intros; exists (remove x s); intuition.
+    absurd (In x (remove x s)); auto.
+    apply In_1 with y; auto. 
+    elim (ME.eq_dec x y); intros; auto.
+    absurd (In x (remove x s)); auto.
+    apply In_1 with y; auto. 
+    eauto.
+  Qed.
+
+  Definition union :
+    forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s \/ In x s'}.
+  Proof.
+    intros; exists (union s s'); intuition.
+  Qed.    
+
+  Definition inter :
+    forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ In x s'}.
+  Proof. 
+    intros; exists (inter s s'); intuition; eauto.
+  Qed.
+
+  Definition diff :
+    forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ ~ In x s'}.
+  Proof. 
+    intros; exists (diff s s'); intuition; eauto. 
+    absurd (In x s'); eauto. 
+  Qed. 
+ 
+  Definition equal : forall s s' : t, {Equal s s'} + {~ Equal s s'}.
+  Proof. 
+    intros. 
+    generalize (equal_1 (s:=s) (s':=s')) (equal_2 (s:=s) (s':=s')).
+    case (equal s s'); intuition.
+  Qed.
+
+  Definition subset : forall s s' : t, {Subset s s'} + {~Subset s s'}.
+  Proof. 
+    intros. 
+    generalize (subset_1 (s:=s) (s':=s')) (subset_2 (s:=s) (s':=s')).
+    case (subset s s'); intuition.
+  Qed.   
+
+  Definition elements :
+    forall s : t,
+    {l : list elt | ME.Sort l /\ (forall x : elt, In x s <-> ME.In x l)}.
+   Proof.
+     intros; exists (elements s); intuition.   
+   Defined. 
+
+  Definition fold :
+    forall (A : Set) (f : elt -> A -> A) (s : t) (i : A),
+    {r : A |   let (l,_) := elements s in 
+                  r = fold_left (fun a e => f e a) l i}.
+  Proof. 
+  intros; exists (fold (A:=A) f s i); exact (fold_1 s i f).
+  Qed.
+
+  Definition cardinal :
+      forall s : t,
+      {r : nat | let (l,_) := elements s in r = length l }.
+  Proof.
+    intros; exists (cardinal s); exact (cardinal_1 s).
+  Qed.    
+
+  Definition fdec (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x})
+    (x : elt) := if Pdec x then true else false. 
+
+  Lemma compat_P_aux :
+   forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}),
+   compat_P E.eq P -> compat_bool E.eq (fdec Pdec).
+  Proof.
+    unfold compat_P, compat_bool, fdec in |- *; intros.
+    generalize (E.eq_sym H0); case (Pdec x); case (Pdec y); firstorder.
+  Qed.
+
+  Hint Resolve compat_P_aux.
+
+  Definition filter :
+    forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t),
+    {s' : t | compat_P E.eq P -> forall x : elt, In x s' <-> In x s /\ P x}.
+  Proof.
+    intros. 
+    exists (filter (fdec Pdec) s).
+    intro H; assert (compat_bool E.eq (fdec Pdec)); auto.
+    intuition.
+    eauto.
+    generalize (filter_2 H0 H1).
+    unfold fdec in |- *.
+    case (Pdec x); intuition.
+    inversion H2.
+    apply filter_3; auto.
+    unfold fdec in |- *; simpl in |- *.
+    case (Pdec x); intuition.
+  Qed.
+
+  Definition for_all :
+    forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t),
+    {compat_P E.eq P -> For_all P s} + {compat_P E.eq P -> ~ For_all P s}.
+  Proof. 
+    intros. 
+    generalize (for_all_1 (s:=s) (f:=fdec Pdec))
+     (for_all_2 (s:=s) (f:=fdec Pdec)).
+    case (for_all (fdec Pdec) s); unfold For_all in |- *; [ left | right ];
+     intros.
+    assert (compat_bool E.eq (fdec Pdec)); auto.
+    generalize (H0 H3 (refl_equal _) _ H2).
+    unfold fdec in |- *. 
+    case (Pdec x); intuition.
+    inversion H4.
+    intuition.    
+    absurd (false = true); [ auto with bool | apply H; auto ].
+    intro.
+    unfold fdec in |- *. 
+    case (Pdec x); intuition.
+  Qed.
+
+  Definition exists_ :
+    forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t),
+    {compat_P E.eq P -> Exists P s} + {compat_P E.eq P -> ~ Exists P s}.
+  Proof. 
+    intros. 
+    generalize (exists_1 (s:=s) (f:=fdec Pdec))
+     (exists_2 (s:=s) (f:=fdec Pdec)).
+    case (exists_ (fdec Pdec) s); unfold Exists in |- *; [ left | right ];
+     intros.
+    elim H0; auto; intros.
+    exists x; intuition.
+    generalize H4.
+    unfold fdec in |- *. 
+    case (Pdec x); intuition.
+    inversion H2.
+    intuition. 
+    elim H2; intros.    
+    absurd (false = true); [ auto with bool | apply H; auto ].
+    exists x; intuition.
+    unfold fdec in |- *. 
+    case (Pdec x); intuition.
+  Qed.
+
+  Definition partition :
+    forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t),
+    {partition : t * t |
+    let (s1, s2) := partition in
+    compat_P E.eq P ->
+    For_all P s1 /\
+    For_all (fun x => ~ P x) s2 /\
+    (forall x : elt, In x s <-> In x s1 \/ In x s2)}.
+  Proof.
+    intros.
+    exists (partition (fdec Pdec) s).
+    generalize (partition_1 s (f:=fdec Pdec)) (partition_2 s (f:=fdec Pdec)).
+    case (partition (fdec Pdec) s).
+    intros s1 s2; simpl in |- *.
+    intros; assert (compat_bool E.eq (fdec Pdec)); auto.
+    intros; assert (compat_bool E.eq (fun x => negb (fdec Pdec x))).
+    generalize H2; unfold compat_bool in |- *; intuition;
+     apply (f_equal negb); auto.
+    intuition.
+    generalize H4; unfold For_all, Equal in |- *; intuition.
+    elim (H0 x); intros.
+    assert (fdec Pdec x = true).
+     eauto.      
+    generalize H8; unfold fdec in |- *; case (Pdec x); intuition.
+    inversion H9.
+    generalize H; unfold For_all, Equal in |- *; intuition.
+    elim (H0 x); intros.
+    cut ((fun x => negb (fdec Pdec x)) x = true). 
+    unfold fdec in |- *; case (Pdec x); intuition.
+      change ((fun x => negb (fdec Pdec x)) x = true) in |- *.
+      apply (filter_2 (s:=s) (x:=x)); auto.
+    set (b := fdec Pdec x) in *; generalize (refl_equal b);
+     pattern b at -1 in |- *; case b; unfold b in |- *; 
+     [ left | right ].
+    elim (H4 x); intros _ B; apply B; auto.
+    elim (H x); intros _ B; apply B; auto.
+    apply filter_3; auto.
+    rewrite H5; auto.
+    eapply (filter_1 (s:=s) (x:=x) H2); elim (H4 x); intros B _; apply B;
+     auto.
+    eapply (filter_1 (s:=s) (x:=x) H3); elim (H x); intros B _; apply B; auto.
+  Qed. 
+
+  Definition choose : forall s : t, {x : elt | In x s} + {Empty s}.
+  Proof.  
+    intros.
+    generalize (choose_1 (s:=s)) (choose_2 (s:=s)).
+    case (choose s); [ left | right ]; auto.
+    exists e; auto.    
+  Qed.
+
+  Definition min_elt :
+    forall s : t,
+    {x : elt | In x s /\ For_all (fun y => ~ E.lt y x) s} + {Empty s}.
+  Proof. 
+    intros;
+     generalize (min_elt_1 (s:=s)) (min_elt_2 (s:=s)) (min_elt_3 (s:=s)).
+    case (min_elt s); [ left | right ]; auto.    
+    exists e; unfold For_all in |- *; eauto.
+  Qed. 
+
+  Definition max_elt :
+    forall s : t,
+    {x : elt | In x s /\ For_all (fun y => ~ E.lt x y) s} + {Empty s}.
+  Proof. 
+    intros;
+     generalize (max_elt_1 (s:=s)) (max_elt_2 (s:=s)) (max_elt_3 (s:=s)).
+    case (max_elt s); [ left | right ]; auto.    
+    exists e; unfold For_all in |- *; eauto.
+  Qed. 
+
+  Module E := E. 
+
+  Definition elt := elt.
+  Definition t := t.
+
+  Definition In := In. 
+  Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+  Definition Subset s s' := forall a : elt, In a s -> In a s'.
+  Definition Empty s := forall a : elt, ~ In a s.
+  Definition For_all (P : elt -> Prop) (s : t) :=
+    forall x : elt, In x s -> P x.
+  Definition Exists (P : elt -> Prop) (s : t) :=
+    exists x : elt, In x s /\ P x.
+  
+  Definition eq_In := In_1.
+
+  Definition eq := Equal.
+  Definition lt := lt.
+  Definition eq_refl := eq_refl.
+  Definition eq_sym := eq_sym.
+  Definition eq_trans := eq_trans.
+  Definition lt_trans := lt_trans. 
+  Definition lt_not_eq := lt_not_eq.
+  Definition compare := compare.
+
+End DepOfNodep.
+
+
+(** * From dependent signature [Sdep] to non-dependent signature [S]. *)
+
+Module NodepOfDep (M: Sdep) <: S with Module E := M.E.
+  Import M.
+
+  Module ME := OrderedTypeFacts E.
+
+  Definition empty : t := let (s, _) := empty in s.
+
+  Lemma empty_1 : Empty empty.
+  Proof.
+    unfold empty in |- *; case M.empty; auto.
+  Qed.
+
+  Definition is_empty (s : t) : bool :=
+    if is_empty s then true else false.
+
+  Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true.
+  Proof.
+    intros; unfold is_empty in |- *; case (M.is_empty s); auto.
+  Qed.
+
+  Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s.
+  Proof.
+    intro s; unfold is_empty in |- *; case (M.is_empty s); auto.
+    intros; discriminate H.
+  Qed.
+
+  Definition mem (x : elt) (s : t) : bool :=
+    if mem x s then true else false.
+
+  Lemma mem_1 : forall (s : t) (x : elt), In x s -> mem x s = true.
+  Proof.
+    intros; unfold mem in |- *; case (M.mem x s); auto.
+  Qed.
+   
+  Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s.
+  Proof.
+    intros s x; unfold mem in |- *; case (M.mem x s); auto.
+    intros; discriminate H.
+  Qed.
+
+  Definition equal (s s' : t) : bool :=
+    if equal s s' then true else false.
+
+  Lemma equal_1 : forall s s' : t, Equal s s' -> equal s s' = true.
+  Proof. 
+    intros; unfold equal in |- *; case M.equal; intuition.
+  Qed.    
+ 
+  Lemma equal_2 : forall s s' : t, equal s s' = true -> Equal s s'.
+  Proof. 
+    intros s s'; unfold equal in |- *; case (M.equal s s'); intuition;
+     inversion H.
+  Qed.
+  
+  Definition subset (s s' : t) : bool :=
+    if subset s s' then true else false.
+
+  Lemma subset_1 : forall s s' : t, Subset s s' -> subset s s' = true.
+  Proof. 
+    intros; unfold subset in |- *; case M.subset; intuition.
+  Qed.    
+ 
+  Lemma subset_2 : forall s s' : t, subset s s' = true -> Subset s s'.
+  Proof. 
+    intros s s'; unfold subset in |- *; case (M.subset s s'); intuition;
+     inversion H.
+  Qed.
+
+  Definition choose (s : t) : option elt :=
+    match choose s with
+    | inleft (exist x _) => Some x
+    | inright _ => None
+    end.
+
+  Lemma choose_1 : forall (s : t) (x : elt), choose s = Some x -> In x s.
+  Proof.
+    intros s x; unfold choose in |- *; case (M.choose s).
+    simple destruct s0; intros; injection H; intros; subst; auto.
+    intros; discriminate H.
+  Qed.
+
+  Lemma choose_2 : forall s : t, choose s = None -> Empty s.
+  Proof.
+    intro s; unfold choose in |- *; case (M.choose s); auto.
+    simple destruct s0; intros; discriminate H.
+  Qed.
+
+  Definition elements (s : t) : list elt := let (l, _) := elements s in l. 
+ 
+  Lemma elements_1 : forall (s : t) (x : elt), In x s -> ME.In x (elements s).
+  Proof. 
+    intros; unfold elements in |- *; case (M.elements s); firstorder.
+  Qed.
+
+  Lemma elements_2 : forall (s : t) (x : elt), ME.In x (elements s) -> In x s.
+  Proof. 
+    intros s x; unfold elements in |- *; case (M.elements s); firstorder.
+  Qed.
+
+  Lemma elements_3 : forall s : t, ME.Sort (elements s).  
+  Proof. 
+    intros; unfold elements in |- *; case (M.elements s); firstorder.
+  Qed.
+
+  Definition min_elt (s : t) : option elt :=
+    match min_elt s with
+    | inleft (exist x _) => Some x
+    | inright _ => None
+    end.
+
+  Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. 
+  Proof.
+    intros s x; unfold min_elt in |- *; case (M.min_elt s).
+    simple destruct s0; intros; injection H; intros; subst; intuition.
+    intros; discriminate H.
+  Qed. 
+
+  Lemma min_elt_2 :
+   forall (s : t) (x y : elt), min_elt s = Some x -> In y s -> ~ E.lt y x. 
+  Proof.
+    intros s x y; unfold min_elt in |- *; case (M.min_elt s).
+    unfold For_all in |- *; simple destruct s0; intros; injection H; intros;
+     subst; firstorder.
+    intros; discriminate H.
+  Qed. 
+
+  Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s.
+  Proof.
+    intros s; unfold min_elt in |- *; case (M.min_elt s); auto.
+    simple destruct s0; intros; discriminate H.
+  Qed. 
+
+  Definition max_elt (s : t) : option elt :=
+    match max_elt s with
+    | inleft (exist x _) => Some x
+    | inright _ => None
+    end.
+
+  Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. 
+  Proof.
+    intros s x; unfold max_elt in |- *; case (M.max_elt s).
+    simple destruct s0; intros; injection H; intros; subst; intuition.
+    intros; discriminate H.
+  Qed. 
+
+  Lemma max_elt_2 :
+   forall (s : t) (x y : elt), max_elt s = Some x -> In y s -> ~ E.lt x y. 
+  Proof.
+    intros s x y; unfold max_elt in |- *; case (M.max_elt s).
+    unfold For_all in |- *; simple destruct s0; intros; injection H; intros;
+     subst; firstorder.
+    intros; discriminate H.
+  Qed. 
+
+  Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s.
+  Proof.
+    intros s; unfold max_elt in |- *; case (M.max_elt s); auto.
+    simple destruct s0; intros; discriminate H.
+  Qed. 
+
+  Definition add (x : elt) (s : t) : t := let (s', _) := add x s in s'.
+
+  Lemma add_1 : forall (s : t) (x y : elt), E.eq x y -> In y (add x s).
+  Proof.
+    intros; unfold add in |- *; case (M.add x s); unfold Add in |- *;
+     firstorder.
+  Qed.
+
+  Lemma add_2 : forall (s : t) (x y : elt), In y s -> In y (add x s).
+  Proof.
+    intros; unfold add in |- *; case (M.add x s); unfold Add in |- *;
+     firstorder.
+  Qed.
+
+  Lemma add_3 :
+   forall (s : t) (x y : elt), ~ E.eq x y -> In y (add x s) -> In y s.
+  Proof.
+    intros s x y; unfold add in |- *; case (M.add x s); unfold Add in |- *;
+     firstorder.
+  Qed.
+
+  Definition remove (x : elt) (s : t) : t := let (s', _) := remove x s in s'.
+
+  Lemma remove_1 : forall (s : t) (x y : elt), E.eq x y -> ~ In y (remove x s).
+  Proof.
+    intros; unfold remove in |- *; case (M.remove x s); firstorder.
+  Qed.
+
+  Lemma remove_2 :
+   forall (s : t) (x y : elt), ~ E.eq x y -> In y s -> In y (remove x s).
+  Proof.
+    intros; unfold remove in |- *; case (M.remove x s); firstorder.
+  Qed.
+
+  Lemma remove_3 : forall (s : t) (x y : elt), In y (remove x s) -> In y s.
+  Proof.
+    intros s x y; unfold remove in |- *; case (M.remove x s); firstorder.
+  Qed.
+  
+  Definition singleton (x : elt) : t := let (s, _) := singleton x in s. 
+ 
+  Lemma singleton_1 : forall x y : elt, In y (singleton x) -> E.eq x y. 
+  Proof.
+    intros x y; unfold singleton in |- *; case (M.singleton x); firstorder.
+  Qed.
+
+  Lemma singleton_2 : forall x y : elt, E.eq x y -> In y (singleton x). 
+  Proof.
+    intros x y; unfold singleton in |- *; case (M.singleton x); firstorder.
+  Qed.
+  
+  Definition union (s s' : t) : t := let (s'', _) := union s s' in s''.
+ 
+  Lemma union_1 :
+   forall (s s' : t) (x : elt), In x (union s s') -> In x s \/ In x s'.
+  Proof. 
+    intros s s' x; unfold union in |- *; case (M.union s s'); firstorder.
+  Qed.
+
+  Lemma union_2 : forall (s s' : t) (x : elt), In x s -> In x (union s s'). 
+  Proof. 
+    intros s s' x; unfold union in |- *; case (M.union s s'); firstorder.
+  Qed.
+
+  Lemma union_3 : forall (s s' : t) (x : elt), In x s' -> In x (union s s').
+  Proof. 
+    intros s s' x; unfold union in |- *; case (M.union s s'); firstorder.
+  Qed.
+
+  Definition inter (s s' : t) : t := let (s'', _) := inter s s' in s''.
+ 
+  Lemma inter_1 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s.
+  Proof. 
+    intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder.
+  Qed.
+
+  Lemma inter_2 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s'.
+  Proof. 
+    intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder.
+  Qed.
+
+  Lemma inter_3 :
+   forall (s s' : t) (x : elt), In x s -> In x s' -> In x (inter s s').
+  Proof. 
+    intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder.
+  Qed.
+
+  Definition diff (s s' : t) : t := let (s'', _) := diff s s' in s''.
+ 
+  Lemma diff_1 : forall (s s' : t) (x : elt), In x (diff s s') -> In x s.
+  Proof. 
+    intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder.
+  Qed.
+
+  Lemma diff_2 : forall (s s' : t) (x : elt), In x (diff s s') -> ~ In x s'.
+  Proof. 
+    intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder.
+  Qed.
+
+  Lemma diff_3 :
+   forall (s s' : t) (x : elt), In x s -> ~ In x s' -> In x (diff s s').
+  Proof. 
+    intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder.
+  Qed.
+
+  Definition cardinal (s : t) : nat := let (f, _) := cardinal s in f.
+
+  Lemma cardinal_1 : forall s, cardinal s = length (elements s).
+  Proof.
+    intros; unfold cardinal in |- *; case (M.cardinal s); unfold elements in *; 
+    destruct (M.elements s); auto.
+  Qed.
+
+  Definition fold (B : Set) (f : elt -> B -> B) (i : t) 
+    (s : B) : B := let (fold, _) := fold f i s in fold.
+
+  Lemma fold_1 :
+   forall (s : t) (A : Set) (i : A) (f : elt -> A -> A),
+   fold f s i = fold_left (fun a e => f e a) (elements s) i.
+  Proof.
+    intros; unfold fold in |- *; case (M.fold f s i); unfold elements in *; 
+    destruct (M.elements s); auto.
+  Qed.  
+
+  Definition f_dec :
+    forall (f : elt -> bool) (x : elt), {f x = true} + {f x <> true}.
+  Proof.
+    intros; case (f x); auto with bool.
+  Defined. 
+
+  Lemma compat_P_aux :
+   forall f : elt -> bool,
+   compat_bool E.eq f -> compat_P E.eq (fun x => f x = true).
+  Proof.
+     unfold compat_bool, compat_P in |- *; intros; rewrite <- H1; firstorder.
+  Qed.
+
+  Hint Resolve compat_P_aux.
+    
+  Definition filter (f : elt -> bool) (s : t) : t :=
+    let (s', _) := filter (P:=fun x => f x = true) (f_dec f) s in s'.
+
+  Lemma filter_1 :
+   forall (s : t) (x : elt) (f : elt -> bool),
+   compat_bool E.eq f -> In x (filter f s) -> In x s.
+  Proof.
+    intros s x f; unfold filter in |- *; case M.filter; intuition.
+    generalize (i (compat_P_aux H)); firstorder.
+  Qed.
+
+  Lemma filter_2 :
+   forall (s : t) (x : elt) (f : elt -> bool),
+   compat_bool E.eq f -> In x (filter f s) -> f x = true. 
+  Proof.
+    intros s x f; unfold filter in |- *; case M.filter; intuition.
+    generalize (i (compat_P_aux H)); firstorder.
+  Qed.
+
+  Lemma filter_3 :
+   forall (s : t) (x : elt) (f : elt -> bool),
+   compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s).     
+  Proof.
+    intros s x f; unfold filter in |- *; case M.filter; intuition.
+    generalize (i (compat_P_aux H)); firstorder.
+  Qed.
+
+  Definition for_all (f : elt -> bool) (s : t) : bool :=
+    if for_all (P:=fun x => f x = true) (f_dec f) s
+    then true
+    else false. 
+
+  Lemma for_all_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool E.eq f ->
+   For_all (fun x => f x = true) s -> for_all f s = true.
+  Proof. 
+    intros s f; unfold for_all in |- *; case M.for_all; intuition; elim n;
+     auto.
+  Qed.
+ 
+  Lemma for_all_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool E.eq f ->
+   for_all f s = true -> For_all (fun x => f x = true) s.
+  Proof. 
+    intros s f; unfold for_all in |- *; case M.for_all; intuition;
+     inversion H0.
+  Qed.
+  
+  Definition exists_ (f : elt -> bool) (s : t) : bool :=
+    if exists_ (P:=fun x => f x = true) (f_dec f) s
+    then true
+    else false. 
+
+  Lemma exists_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true.
+  Proof. 
+    intros s f; unfold exists_ in |- *; case M.exists_; intuition; elim n;
+     auto.
+  Qed.
+ 
+  Lemma exists_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s.
+  Proof. 
+    intros s f; unfold exists_ in |- *; case M.exists_; intuition;
+     inversion H0.
+  Qed.
+     
+  Definition partition (f : elt -> bool) (s : t) : 
+    t * t :=
+    let (p, _) := partition (P:=fun x => f x = true) (f_dec f) s in p.
+  
+  Lemma partition_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s).
+  Proof.
+    intros s f; unfold partition in |- *; case M.partition. 
+    intro p; case p; clear p; intros s1 s2 H C. 
+    generalize (H (compat_P_aux C)); clear H; intro H.
+    simpl in |- *; unfold Equal in |- *; intuition.
+    apply filter_3; firstorder. 
+    elim (H2 a); intros. 
+    assert (In a s). 
+     eapply filter_1; eauto.
+    elim H3; intros; auto.
+    absurd (f a = true).
+    exact (H a H6).
+    eapply filter_2; eauto. 
+  Qed.    
+    
+  Lemma partition_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
+  Proof.
+    intros s f; unfold partition in |- *; case M.partition. 
+    intro p; case p; clear p; intros s1 s2 H C. 
+    generalize (H (compat_P_aux C)); clear H; intro H.
+    assert (D : compat_bool E.eq (fun x => negb (f x))).
+    generalize C; unfold compat_bool in |- *; intros; apply (f_equal negb);
+     auto.
+    simpl in |- *; unfold Equal in |- *; intuition.
+    apply filter_3; firstorder.
+    elim (H2 a); intros. 
+    assert (In a s). 
+     eapply filter_1; eauto.
+    elim H3; intros; auto.
+    absurd (f a = true).
+    intro.
+    generalize (filter_2 D H1). 
+    rewrite H7; intros H8; inversion H8.
+    exact (H0 a H6).
+  Qed. 
+
+
+  Module E := E. 
+  Definition elt := elt.
+  Definition t := t.
+
+  Definition In := In. 
+  Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+  Definition Subset s s' := forall a : elt, In a s -> In a s'.
+  Definition Add (x : elt) (s s' : t) :=
+    forall y : elt, In y s' <-> E.eq y x \/ In y s.
+  Definition Empty s := forall a : elt, ~ In a s.
+  Definition For_all (P : elt -> Prop) (s : t) :=
+    forall x : elt, In x s -> P x.
+  Definition Exists (P : elt -> Prop) (s : t) :=
+    exists x : elt, In x s /\ P x.
+
+  Definition In_1 := eq_In.
+
+  Definition eq := Equal.
+  Definition lt := lt.
+  Definition eq_refl := eq_refl.
+  Definition eq_sym := eq_sym.
+  Definition eq_trans := eq_trans.
+  Definition lt_trans := lt_trans. 
+  Definition lt_not_eq := lt_not_eq.
+  Definition compare := compare.
+
+End NodepOfDep.
diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v
new file mode 100644
index 00000000..006d78c7
--- /dev/null
+++ b/theories/FSets/FSetEqProperties.v
@@ -0,0 +1,923 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetEqProperties.v 8639 2006-03-16 19:21:55Z letouzey $ *)
+
+(** * Finite sets library *)
+
+(** This module proves many properties of finite sets that 
+    are consequences of the axiomatization in [FsetInterface] 
+    Contrary to the functor in [FsetProperties] it uses 
+    sets operations instead of predicates over sets, i.e.
+    [mem x s=true] instead of [In x s], 
+    [equal s s'=true] instead of [Equal s s'], etc. *)
+
+
+Require Import FSetProperties.
+Require Import Zerob.
+Require Import Sumbool.
+Require Import Omega.
+
+Module EqProperties (M:S).
+Import M.
+Import Logic. (* to unmask [eq] *)  
+Import Peano. (* to unmask [lt] *)
+  
+Module ME := OrderedTypeFacts E.  
+Module MP := Properties M.
+Import MP.
+Import MP.FM.
+
+Definition Add := MP.Add.
+
+Section BasicProperties. 
+
+(** Some old specifications written with boolean equalities. *) 
+
+Variable s s' s'': t.
+Variable x y z : elt.
+
+Lemma mem_eq: 
+  E.eq x y -> mem x s=mem y s.
+Proof. 
+intro H; rewrite H; auto.
+Qed.
+
+Lemma equal_mem_1: 
+  (forall a, mem a s=mem a s') -> equal s s'=true.
+Proof. 
+intros; apply equal_1; unfold Equal; intros.
+do 2 rewrite mem_iff; rewrite H; tauto.
+Qed.
+
+Lemma equal_mem_2: 
+  equal s s'=true -> forall a, mem a s=mem a s'.
+Proof. 
+intros; rewrite (equal_2 H); auto.
+Qed.
+
+Lemma subset_mem_1: 
+  (forall a, mem a s=true->mem a s'=true) -> subset s s'=true.
+Proof. 
+intros; apply subset_1; unfold Subset; intros a.
+do 2 rewrite mem_iff; auto.
+Qed.
+
+Lemma subset_mem_2: 
+  subset s s'=true -> forall a, mem a s=true -> mem a s'=true.
+Proof. 
+intros H a; do 2 rewrite <- mem_iff; apply subset_2; auto.
+Qed.
+  
+Lemma empty_mem: mem x empty=false.
+Proof. 
+rewrite <- not_mem_iff; auto.
+Qed.
+
+Lemma is_empty_equal_empty: is_empty s = equal s empty.
+Proof. 
+apply bool_1; split; intros.
+rewrite <- (empty_is_empty_1 (s:=empty)); auto with set.
+rewrite <- is_empty_iff; auto with set.
+Qed.
+  
+Lemma choose_mem_1: choose s=Some x -> mem x s=true.
+Proof.  
+auto.
+Qed.
+
+Lemma choose_mem_2: choose s=None -> is_empty s=true.
+Proof.
+auto.
+Qed.
+
+Lemma add_mem_1: mem x (add x s)=true.
+Proof.
+auto.
+Qed.  
+ 
+Lemma add_mem_2: ~E.eq x y -> mem y (add x s)=mem y s.
+Proof. 
+apply add_neq_b.
+Qed.
+
+Lemma remove_mem_1: mem x (remove x s)=false.
+Proof. 
+rewrite <- not_mem_iff; auto.
+Qed. 
+ 
+Lemma remove_mem_2: ~E.eq x y -> mem y (remove x s)=mem y s.
+Proof. 
+apply remove_neq_b.
+Qed.
+
+Lemma singleton_equal_add: 
+  equal (singleton x) (add x empty)=true.
+Proof.
+rewrite (singleton_equal_add x); auto with set.
+Qed.  
+
+Lemma union_mem: 
+  mem x (union s s')=mem x s || mem x s'.
+Proof. 
+apply union_b.
+Qed.
+
+Lemma inter_mem: 
+  mem x (inter s s')=mem x s && mem x s'.
+Proof. 
+apply inter_b.
+Qed.
+
+Lemma diff_mem: 
+  mem x (diff s s')=mem x s && negb (mem x s').
+Proof. 
+apply diff_b.
+Qed.
+
+(** properties of [mem] *)
+
+Lemma mem_3 : ~In x s -> mem x s=false.
+Proof.
+intros; rewrite <- not_mem_iff; auto.
+Qed.
+
+Lemma mem_4 : mem x s=false -> ~In x s.
+Proof.
+intros; rewrite not_mem_iff; auto.
+Qed.
+
+(** Properties of [equal] *) 
+
+Lemma equal_refl: equal s s=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma equal_sym: equal s s'=equal s' s.
+Proof.
+intros; apply bool_1; do 2 rewrite <- equal_iff; intuition.
+Qed.
+
+Lemma equal_trans: 
+ equal s s'=true -> equal s' s''=true -> equal s s''=true.
+Proof.
+intros; rewrite (equal_2 H); auto.
+Qed.
+
+Lemma equal_equal: 
+ equal s s'=true -> equal s s''=equal s' s''.
+Proof.
+intros; rewrite (equal_2 H); auto.
+Qed.
+
+Lemma equal_cardinal: 
+ equal s s'=true -> cardinal s=cardinal s'.
+Proof.
+auto with set.
+Qed.
+
+(* Properties of [subset] *)
+
+Lemma subset_refl: subset s s=true. 
+Proof.
+auto with set.
+Qed.
+
+Lemma subset_antisym: 
+ subset s s'=true -> subset s' s=true -> equal s s'=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma subset_trans: 
+ subset s s'=true -> subset s' s''=true -> subset s s''=true.
+Proof.
+do 3 rewrite <- subset_iff; intros.
+apply subset_trans with s'; auto.
+Qed.
+
+Lemma subset_equal: 
+ equal s s'=true -> subset s s'=true.
+Proof.
+auto with set.
+Qed.
+
+(** Properties of [choose] *)
+
+Lemma choose_mem_3: 
+ is_empty s=false -> {x:elt|choose s=Some x /\ mem x s=true}.
+Proof.
+intros.
+generalize (@choose_1 s) (@choose_2 s).
+destruct (choose s);intros.
+exists e;auto.
+generalize (H1 (refl_equal None)); clear H1.
+intros; rewrite (is_empty_1 H1) in H; discriminate.
+Qed.
+
+Lemma choose_mem_4: choose empty=None.
+Proof.
+generalize (@choose_1 empty).
+case (@choose empty);intros;auto.
+elim (@empty_1 e); auto.
+Qed.
+
+(** Properties of [add] *)
+
+Lemma add_mem_3: 
+ mem y s=true -> mem y (add x s)=true.
+Proof.
+auto.
+Qed.
+
+Lemma add_equal: 
+ mem x s=true -> equal (add x s) s=true.
+Proof.
+auto with set.
+Qed.
+
+(** Properties of [remove] *)
+
+Lemma remove_mem_3: 
+ mem y (remove x s)=true -> mem y s=true.
+Proof.
+rewrite remove_b; intros H;destruct (andb_prop _ _ H); auto.
+Qed.
+
+Lemma remove_equal: 
+ mem x s=false -> equal (remove x s) s=true.
+Proof.
+intros; apply equal_1; apply remove_equal.
+rewrite not_mem_iff; auto.
+Qed.
+
+Lemma add_remove: 
+ mem x s=true -> equal (add x (remove x s)) s=true.
+Proof.
+intros; apply equal_1; apply add_remove; auto.
+Qed.
+
+Lemma remove_add: 
+ mem x s=false -> equal (remove x (add x s)) s=true.
+Proof.
+intros; apply equal_1; apply remove_add; auto.
+rewrite not_mem_iff; auto.
+Qed.
+
+(** Properties of [is_empty] *)
+
+Lemma is_empty_cardinal: is_empty s = zerob (cardinal s).
+Proof.
+intros; apply bool_1; split; intros.
+rewrite cardinal_1; simpl; auto.
+assert (cardinal s = 0) by apply zerob_true_elim; auto.
+auto.
+Qed.
+
+(** Properties of [singleton] *)
+
+Lemma singleton_mem_1: mem x (singleton x)=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma singleton_mem_2: ~E.eq x y -> mem y (singleton x)=false.
+Proof.
+intros; rewrite singleton_b.
+unfold ME.eqb; destruct (ME.eq_dec x y); intuition.
+Qed.
+
+Lemma singleton_mem_3: mem y (singleton x)=true -> E.eq x y.
+Proof.
+auto.
+Qed.
+
+(** Properties of [union] *)
+
+Lemma union_sym:
+ equal (union s s') (union s' s)=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_subset_equal: 
+ subset s s'=true -> equal (union s s') s'=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_equal_1: 
+ equal s s'=true-> equal (union s s'') (union s' s'')=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_equal_2: 
+ equal s' s''=true-> equal (union s s') (union s s'')=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_assoc: 
+ equal (union (union s s') s'') (union s (union s' s''))=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma add_union_singleton: 
+ equal (add x s) (union (singleton x) s)=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_add: 
+ equal (union (add x s) s') (add x (union s s'))=true.
+Proof.
+auto with set.
+Qed.
+
+(* caracterisation of [union] via [subset] *)
+
+Lemma union_subset_1: subset s (union s s')=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_subset_2: subset s' (union s s')=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_subset_3:
+ subset s s''=true -> subset s' s''=true -> 
+  subset (union s s') s''=true.
+Proof.
+intros; apply subset_1; apply union_subset_3; auto.
+Qed.
+
+(** Properties of [inter] *) 
+
+Lemma inter_sym: equal (inter s s') (inter s' s)=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma inter_subset_equal: 
+ subset s s'=true -> equal (inter s s') s=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma inter_equal_1: 
+ equal s s'=true -> equal (inter s s'') (inter s' s'')=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma inter_equal_2: 
+ equal s' s''=true -> equal (inter s s') (inter s s'')=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma inter_assoc: 
+ equal (inter (inter s s') s'') (inter s (inter s' s''))=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_inter_1: 
+ equal (inter (union s s') s'') (union (inter s s'') (inter s' s''))=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_inter_2: 
+ equal (union (inter s s') s'') (inter (union s s'') (union s' s''))=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma inter_add_1: mem x s'=true -> 
+ equal (inter (add x s) s') (add x (inter s s'))=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma inter_add_2: mem x s'=false -> 
+ equal (inter (add x s) s') (inter s s')=true.
+Proof.
+intros; apply equal_1; apply inter_add_2.
+rewrite not_mem_iff; auto.
+Qed.
+
+(* caracterisation of [union] via [subset] *)
+
+Lemma inter_subset_1: subset (inter s s') s=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma inter_subset_2: subset (inter s s') s'=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma inter_subset_3:
+ subset s'' s=true -> subset s'' s'=true -> 
+  subset s'' (inter s s')=true.
+Proof.
+intros; apply subset_1; apply inter_subset_3; auto.
+Qed.
+
+(** Properties of [diff] *)
+
+Lemma diff_subset: subset (diff s s') s=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma diff_subset_equal:
+ subset s s'=true -> equal (diff s s') empty=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma remove_inter_singleton: 
+ equal (remove x s) (diff s (singleton x))=true.
+Proof.
+auto with set.
+Qed.
+
+Lemma diff_inter_empty:
+ equal (inter (diff s s') (inter s s')) empty=true. 
+Proof.
+auto with set.
+Qed.
+
+Lemma diff_inter_all: 
+ equal (union (diff s s') (inter s s')) s=true.
+Proof.
+auto with set.
+Qed.
+
+End BasicProperties.
+
+Hint Immediate empty_mem is_empty_equal_empty add_mem_1
+   remove_mem_1 singleton_equal_add union_mem inter_mem
+   diff_mem equal_sym add_remove remove_add : set. 
+Hint Resolve equal_mem_1 subset_mem_1 choose_mem_1
+   choose_mem_2 add_mem_2 remove_mem_2 equal_refl equal_equal
+   subset_refl subset_equal subset_antisym
+   add_mem_3 add_equal remove_mem_3 remove_equal : set.
+
+
+(** General recursion principes based on [cardinal] *)
+
+Lemma cardinal_set_rec:  forall (P:t->Type),
+ (forall s s', equal s s'=true -> P s -> P s') -> 
+ (forall s x, mem x s=false -> P s -> P (add x s)) -> 
+ P empty -> forall n s, cardinal s=n -> P s.
+Proof.
+intros.
+apply cardinal_induction with n; auto; intros.
+apply X with empty; auto with set.
+apply X with (add x s0); auto with set.
+apply equal_1; intro a; rewrite add_iff; rewrite (H1 a); tauto.
+apply X0; auto with set; apply mem_3; auto.
+Qed.
+
+Lemma set_rec:  forall (P:t->Type),
+ (forall s s', equal s s'=true -> P s -> P s') ->
+ (forall s x, mem x s=false -> P s -> P (add x s)) -> 
+ P empty -> forall s, P s.
+Proof.
+intros;apply cardinal_set_rec with (cardinal s);auto.
+Qed.
+
+(** Properties of [fold] *)
+
+Lemma exclusive_set : forall s s' x,
+ ~In x s\/~In x s' <-> mem x s && mem x s'=false.
+Proof.
+intros; do 2 rewrite not_mem_iff.
+destruct (mem x s); destruct (mem x s'); intuition.
+Qed.
+
+Section Fold. 
+Variables (A:Set)(eqA:A->A->Prop)(st:Setoid_Theory _ eqA).
+Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f).
+Variables (i:A).
+Variables (s s':t)(x:elt).
+ 
+Lemma fold_empty: eqA (fold f empty i) i.
+Proof. 
+apply fold_empty; auto.
+Qed.
+
+Lemma fold_equal: 
+ equal s s'=true -> eqA (fold f s i) (fold f s' i).
+Proof. 
+intros; apply fold_equal with (eqA:=eqA); auto.
+Qed.
+   
+Lemma fold_add: 
+ mem x s=false -> eqA (fold f (add x s) i) (f x (fold f s i)).
+Proof. 
+intros; apply fold_add with (eqA:=eqA); auto.
+rewrite not_mem_iff; auto.
+Qed.
+
+Lemma add_fold: 
+  mem x s=true -> eqA (fold f (add x s) i) (fold f s i).
+Proof.
+intros; apply add_fold with (eqA:=eqA); auto.
+Qed.
+
+Lemma remove_fold_1: 
+ mem x s=true -> eqA (f x (fold f (remove x s) i)) (fold f s i).
+Proof.
+intros; apply remove_fold_1 with (eqA:=eqA); auto.
+Qed.
+
+Lemma remove_fold_2: 
+ mem x s=false -> eqA (fold f (remove x s) i) (fold f s i).
+Proof.
+intros; apply remove_fold_2 with (eqA:=eqA); auto.
+rewrite not_mem_iff; auto.
+Qed.
+
+Lemma fold_union: 
+ (forall x, mem x s && mem x s'=false) -> 
+ eqA (fold f (union s s') i) (fold f s (fold f s' i)).
+Proof.
+intros; apply fold_union with (eqA:=eqA); auto.
+intros; rewrite exclusive_set; auto.
+Qed.
+
+End Fold.
+
+(** Properties of [cardinal] *)
+
+Lemma add_cardinal_1: 
+ forall s x, mem x s=true -> cardinal (add x s)=cardinal s.
+Proof.
+auto with set.
+Qed.
+
+Lemma add_cardinal_2: 
+ forall s x, mem x s=false -> cardinal (add x s)=S (cardinal s).
+Proof.
+intros; apply add_cardinal_2; auto.
+rewrite not_mem_iff; auto.
+Qed.
+
+Lemma remove_cardinal_1: 
+ forall s x, mem x s=true -> S (cardinal (remove x s))=cardinal s.
+Proof.
+intros; apply remove_cardinal_1; auto.
+Qed.
+
+Lemma remove_cardinal_2: 
+ forall s x, mem x s=false -> cardinal (remove x s)=cardinal s.
+Proof.
+auto with set.
+Qed.
+
+Lemma union_cardinal: 
+ forall s s', (forall x, mem x s && mem x s'=false) -> 
+ cardinal (union s s')=cardinal s+cardinal s'.
+Proof.
+intros; apply union_cardinal; auto; intros.
+rewrite exclusive_set; auto.
+Qed.
+
+Lemma subset_cardinal: 
+ forall s s', subset s s'=true -> cardinal s<=cardinal s'.
+Proof.
+intros; apply subset_cardinal; auto.
+Qed.
+
+Section Bool.
+
+(** Properties of [filter] *)
+
+Variable f:elt->bool.
+Variable Comp: compat_bool E.eq f.
+
+Let Comp' : compat_bool E.eq (fun x =>negb (f x)).
+Proof.
+unfold compat_bool in *; intros; f_equal; auto.
+Qed.
+
+Lemma filter_mem: forall s x, mem x (filter f s)=mem x s && f x.
+Proof. 
+intros; apply filter_b; auto.
+Qed.
+
+Lemma for_all_filter: 
+ forall s, for_all f s=is_empty (filter (fun x => negb (f x)) s).
+Proof. 
+intros; apply bool_1; split; intros.
+apply is_empty_1.
+unfold Empty; intros. 
+rewrite filter_iff; auto.
+red; destruct 1.
+rewrite <- (@for_all_iff s f) in H; auto.
+rewrite (H a H0) in H1; discriminate.
+apply for_all_1; auto; red; intros.
+revert H; rewrite <- is_empty_iff.
+unfold Empty; intro H; generalize (H x); clear H.
+rewrite filter_iff; auto.
+destruct (f x); auto.
+Qed.
+
+Lemma exists_filter : 
+ forall s, exists_ f s=negb (is_empty (filter f s)).
+Proof. 
+intros; apply bool_1; split; intros. 
+destruct (exists_2 Comp H) as (a,(Ha1,Ha2)).
+apply bool_6.
+red; intros; apply (@is_empty_2 _ H0 a); auto.
+generalize (@choose_1 (filter f s)) (@choose_2 (filter f s)).
+destruct (choose (filter f s)).
+intros H0 _; apply exists_1; auto.
+exists e; generalize (H0 e); rewrite filter_iff; auto.
+intros _ H0.
+rewrite (is_empty_1 (H0 (refl_equal None))) in H; auto; discriminate.
+Qed.
+
+Lemma partition_filter_1: 
+ forall s, equal (fst (partition f s)) (filter f s)=true.
+Proof. 
+auto.
+Qed.
+
+Lemma partition_filter_2: 
+ forall s, equal (snd (partition f s)) (filter (fun x => negb (f x)) s)=true.
+Proof. 
+auto.
+Qed.
+
+Lemma add_filter_1 : forall s s' x, 
+ f x=true -> (Add x s s') -> (Add x (filter f s) (filter f s')).
+Proof.
+unfold Add, MP.Add; intros.
+repeat rewrite filter_iff; auto.
+rewrite H0; clear H0.
+assert (E.eq x y -> f y = true) by 
+ intro H0; rewrite <- (Comp _ _ H0); auto.
+tauto.
+Qed.
+
+Lemma add_filter_2 : forall s s' x, 
+ f x=false -> (Add x s s') -> filter f s [=] filter f s'.
+Proof.
+unfold Add, MP.Add, Equal; intros.
+repeat rewrite filter_iff; auto.
+rewrite H0; clear H0.
+assert (f a = true -> ~E.eq x a).
+ intros H0 H1.
+ rewrite (Comp _ _ H1) in H.
+ rewrite H in H0; discriminate.
+tauto. 
+Qed.
+
+Lemma union_filter: forall f g, (compat_bool E.eq f) -> (compat_bool E.eq g) ->
+  forall s, union (filter f s) (filter g s) [=] filter (fun x=>orb (f x) (g x)) s.
+Proof.
+clear Comp' Comp f.
+intros.
+assert (compat_bool E.eq (fun x => orb (f x) (g x))).
+  unfold compat_bool; intros.
+  rewrite (H x y H1);  rewrite (H0 x y H1); auto.
+unfold Equal; intros; set_iff; repeat rewrite filter_iff; auto.
+assert (f a || g a = true <-> f a = true \/ g a = true).
+  split; auto with bool.
+  intro H3; destruct (orb_prop _ _ H3); auto.
+tauto.
+Qed.
+
+(** Properties of [for_all] *)
+
+Lemma for_all_mem_1: forall s, 
+ (forall x, (mem x s)=true->(f x)=true) -> (for_all f s)=true.
+Proof.
+intros.
+rewrite for_all_filter; auto.
+rewrite is_empty_equal_empty.
+apply equal_mem_1;intros.
+rewrite filter_b; auto.
+rewrite empty_mem.
+generalize (H a); case (mem a s);intros;auto.
+rewrite H0;auto.
+Qed.
+
+Lemma for_all_mem_2: forall s, 
+ (for_all f s)=true -> forall x,(mem x s)=true -> (f x)=true. 
+Proof.
+intros.
+rewrite for_all_filter in H; auto.
+rewrite is_empty_equal_empty in H.
+generalize (equal_mem_2 _ _ H x).
+rewrite filter_b; auto.
+rewrite empty_mem.
+rewrite H0; simpl;intros.
+replace true with (negb false);auto;apply negb_sym;auto.
+Qed.
+
+Lemma for_all_mem_3: 
+ forall s x,(mem x s)=true -> (f x)=false -> (for_all f s)=false.
+Proof.
+intros.
+apply (bool_eq_ind (for_all f s));intros;auto.
+rewrite for_all_filter in H1; auto.
+rewrite is_empty_equal_empty in H1.
+generalize (equal_mem_2 _ _ H1 x).
+rewrite filter_b; auto.
+rewrite empty_mem.
+rewrite H.
+rewrite H0.
+simpl;auto.
+Qed.
+
+Lemma for_all_mem_4: 
+ forall s, for_all f s=false -> {x:elt | mem x s=true /\ f x=false}.
+Proof.
+intros.
+rewrite for_all_filter in H; auto.
+destruct (choose_mem_3 _ H) as (x,(H0,H1));intros.
+exists x.
+rewrite filter_b in H1; auto.
+elim (andb_prop _ _ H1).
+split;auto.
+replace false with (negb true);auto;apply negb_sym;auto.
+Qed.
+
+(** Properties of [exists] *)
+
+Lemma for_all_exists: 
+ forall s, exists_ f s = negb (for_all (fun x =>negb (f x)) s).
+Proof.
+intros.
+rewrite for_all_b; auto.
+rewrite exists_b; auto.
+induction (elements s); simpl; auto.
+destruct (f a); simpl; auto.
+Qed.
+
+End Bool.
+Section Bool'.
+
+Variable f:elt->bool.
+Variable Comp: compat_bool E.eq f.
+
+Let Comp' : compat_bool E.eq (fun x =>negb (f x)).
+Proof.
+unfold compat_bool in *; intros; f_equal; auto.
+Qed.
+
+Lemma exists_mem_1: 
+ forall s, (forall x, mem x s=true->f x=false) -> exists_ f s=false.
+Proof.
+intros.
+rewrite for_all_exists; auto.
+rewrite for_all_mem_1;auto with bool.
+intros;generalize (H x H0);intros. 
+symmetry;apply negb_sym;simpl;auto.
+Qed.
+
+Lemma exists_mem_2: 
+ forall s, exists_ f s=false -> forall x, mem x s=true -> f x=false. 
+Proof.
+intros.
+rewrite for_all_exists in H; auto.
+replace false with (negb true);auto;apply negb_sym;symmetry.
+rewrite (for_all_mem_2 (fun x => negb (f x)) Comp' s);simpl;auto.
+replace true with (negb false);auto;apply negb_sym;auto.
+Qed.
+
+Lemma exists_mem_3: 
+ forall s x, mem x s=true -> f x=true -> exists_ f s=true.
+Proof.
+intros.
+rewrite for_all_exists; auto.
+symmetry;apply negb_sym;simpl.
+apply for_all_mem_3 with x;auto.
+rewrite H0;auto.
+Qed.
+
+Lemma exists_mem_4: 
+ forall s, exists_ f s=true -> {x:elt | (mem x s)=true /\ (f x)=true}.
+Proof.
+intros.
+rewrite for_all_exists in H; auto.
+elim (for_all_mem_4 (fun x =>negb (f x)) Comp' s);intros.
+elim p;intros.
+exists x;split;auto.
+replace true with (negb false);auto;apply negb_sym;auto.
+replace false with (negb true);auto;apply negb_sym;auto.
+Qed.
+
+End Bool'.
+
+Section Sum.
+
+(** Adding a valuation function on all elements of a set. *)
+
+Definition sum (f:elt -> nat)(s:t) := fold (fun x => plus (f x)) s 0. 
+
+Lemma sum_plus : 
+  forall f g, compat_nat E.eq f -> compat_nat E.eq g -> 
+    forall s, sum (fun x =>f x+g x) s = sum f s + sum g s.
+Proof.
+unfold sum.
+intros f g Hf Hg.
+assert (fc : compat_op E.eq (@eq _) (fun x:elt =>plus (f x))).  auto.
+assert (ft : transpose (@eq _) (fun x:elt =>plus (f x))). red; intros; omega.
+assert (gc : compat_op E.eq (@eq _) (fun x:elt => plus (g x))). auto.
+assert (gt : transpose (@eq _) (fun x:elt =>plus (g x))). red; intros; omega.
+assert (fgc : compat_op E.eq (@eq _) (fun x:elt =>plus ((f x)+(g x)))). auto.
+assert (fgt : transpose (@eq _) (fun x:elt=>plus ((f x)+(g x)))). red; intros; omega.
+assert (st := gen_st nat).
+intros s;pattern s; apply set_rec.
+intros.
+rewrite <- (fold_equal _ _ st _ fc ft 0 _ _ H).
+rewrite <- (fold_equal _ _ st _ gc gt 0 _ _ H).
+rewrite <- (fold_equal _ _ st _ fgc fgt 0 _ _ H); auto.
+intros; do 3 (rewrite (fold_add _ _ st);auto).
+rewrite H0;simpl;omega.
+intros; do 3 rewrite (fold_empty _ _ st);auto.
+Qed.
+
+Lemma sum_filter : forall f, (compat_bool E.eq f) -> 
+  forall s, (sum (fun x => if f x then 1 else 0) s) = (cardinal (filter f s)).
+Proof.
+unfold sum; intros f Hf.
+assert (st := gen_st nat).
+assert (cc : compat_op E.eq (@eq _) (fun x => plus (if f x then 1 else 0))). 
+ unfold compat_op; intros.
+ rewrite (Hf x x' H); auto.
+assert (ct : transpose (@eq _) (fun x => plus (if f x then 1 else 0))).
+ unfold transpose; intros; omega.
+intros s;pattern s; apply set_rec.
+intros.
+change elt with E.t.
+rewrite <- (fold_equal _ _ st _ cc ct 0 _ _ H).
+rewrite <- (MP.Equal_cardinal (filter_equal Hf (equal_2 H))); auto.
+intros; rewrite (fold_add _ _ st _ cc ct); auto.
+generalize (@add_filter_1 f Hf s0 (add x s0) x) (@add_filter_2 f Hf s0 (add x s0) x) .
+assert (~ In x (filter f s0)).
+ intro H1; rewrite (mem_1 (filter_1 Hf H1)) in H; discriminate H.
+case (f x); simpl; intros.
+rewrite (MP.cardinal_2 H1 (H2 (refl_equal true) (MP.Add_add s0 x))); auto.
+rewrite <- (MP.Equal_cardinal (H3 (refl_equal false) (MP.Add_add s0 x))); auto.
+intros; rewrite (fold_empty _ _ st);auto.
+rewrite MP.cardinal_1; auto.
+unfold Empty; intros.
+rewrite filter_iff; auto; set_iff; tauto.
+Qed.
+
+Lemma fold_compat : 
+  forall (A:Set)(eqA:A->A->Prop)(st:(Setoid_Theory _ eqA))
+  (f g:elt->A->A),
+  (compat_op E.eq eqA f) -> (transpose eqA f) -> 
+  (compat_op E.eq eqA g) -> (transpose eqA g) -> 
+  forall (i:A)(s:t),(forall x:elt, (In x s) -> forall y, (eqA (f x y) (g x y))) -> 
+  (eqA (fold f s i) (fold g s i)).
+Proof.
+intros A eqA st f g fc ft gc gt i.
+intro s; pattern s; apply set_rec; intros.
+trans_st (fold f s0 i).
+apply fold_equal with (eqA:=eqA); auto.
+rewrite equal_sym; auto.
+trans_st (fold g s0 i).
+apply H0; intros; apply H1; auto.
+elim  (equal_2 H x); auto; intros.
+apply fold_equal with (eqA:=eqA); auto.
+trans_st (f x (fold f s0 i)).
+apply fold_add with (eqA:=eqA); auto.
+trans_st (g x (fold f s0 i)).
+trans_st (g x (fold g s0 i)).
+sym_st; apply fold_add with (eqA:=eqA); auto.
+trans_st i; [idtac | sym_st ]; apply fold_empty; auto.
+Qed.
+
+Lemma sum_compat : 
+  forall f g, compat_nat E.eq f -> compat_nat E.eq g -> 
+  forall s, (forall x, In x s -> f x=g x) -> sum f s=sum g s.
+intros.
+unfold sum; apply (fold_compat _ (@eq nat)); auto.
+unfold transpose; intros; omega.
+unfold transpose; intros; omega.
+Qed.
+
+End Sum.
+
+End EqProperties. 
diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v
new file mode 100644
index 00000000..d8c0b802
--- /dev/null
+++ b/theories/FSets/FSetFacts.v
@@ -0,0 +1,409 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetFacts.v 8681 2006-04-05 11:56:14Z letouzey $ *)
+
+(** * Finite sets library *)
+
+(** This functor derives additional facts from [FSetInterface.S]. These
+  facts are mainly the specifications of [FSetInterface.S] written using 
+  different styles: equivalence and boolean equalities. 
+  Moreover, we prove that [E.Eq] and [Equal] are setoid equalities.
+*)
+
+Require Export FSetInterface. 
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+Module Facts (M: S).
+Module ME := OrderedTypeFacts M.E.  
+Import ME.
+Import M.
+Import Logic. (* to unmask [eq] *)  
+Import Peano. (* to unmask [lt] *)
+
+(** * Specifications written using equivalences *)
+
+Section IffSpec. 
+Variable s s' s'' : t.
+Variable x y z : elt.
+
+Lemma In_eq_iff : E.eq x y -> (In x s <-> In y s).
+Proof.
+split; apply In_1; auto.
+Qed.
+
+Lemma mem_iff : In x s <-> mem x s = true.
+Proof.
+split; [apply mem_1|apply mem_2].
+Qed.
+
+Lemma not_mem_iff : ~In x s <-> mem x s = false.
+Proof.
+rewrite mem_iff; destruct (mem x s); intuition.
+Qed.
+
+Lemma equal_iff : s[=]s' <-> equal s s' = true.
+Proof. 
+split; [apply equal_1|apply equal_2].
+Qed.
+
+Lemma subset_iff : s[<=]s' <-> subset s s' = true.
+Proof. 
+split; [apply subset_1|apply subset_2].
+Qed.
+
+Lemma empty_iff : In x empty <-> False.
+Proof.
+intuition; apply (empty_1 H).
+Qed.
+
+Lemma is_empty_iff : Empty s <-> is_empty s = true. 
+Proof. 
+split; [apply is_empty_1|apply is_empty_2].
+Qed.
+
+Lemma singleton_iff : In y (singleton x) <-> E.eq x y.
+Proof.
+split; [apply singleton_1|apply singleton_2].
+Qed.
+
+Lemma add_iff : In y (add x s) <-> E.eq x y \/ In y s.
+Proof. 
+split; [ | destruct 1; [apply add_1|apply add_2]]; auto.
+destruct (eq_dec x y) as [E|E]; auto.
+intro H; right; exact (add_3 E H).
+Qed.
+
+Lemma add_neq_iff : ~ E.eq x y -> (In y (add x s)  <-> In y s).
+Proof.
+split; [apply add_3|apply add_2]; auto.
+Qed.
+
+Lemma remove_iff : In y (remove x s) <-> In y s /\ ~E.eq x y.
+Proof.
+split; [split; [apply remove_3 with x |] | destruct 1; apply remove_2]; auto.
+intro.
+apply (remove_1 H0 H).
+Qed.
+
+Lemma remove_neq_iff : ~ E.eq x y -> (In y (remove x s) <-> In y s).
+Proof.
+split; [apply remove_3|apply remove_2]; auto.
+Qed.
+
+Lemma union_iff : In x (union s s') <-> In x s \/ In x s'.
+Proof.
+split; [apply union_1 | destruct 1; [apply union_2|apply union_3]]; auto.
+Qed.
+
+Lemma inter_iff : In x (inter s s') <-> In x s /\ In x s'.
+Proof.
+split; [split; [apply inter_1 with s' | apply inter_2 with s] | destruct 1; apply inter_3]; auto.
+Qed.
+
+Lemma diff_iff : In x (diff s s') <-> In x s /\ ~ In x s'.
+Proof.
+split; [split; [apply diff_1 with s' | apply diff_2 with s] | destruct 1; apply diff_3]; auto.
+Qed.
+
+Variable f : elt->bool.
+
+Lemma filter_iff :  compat_bool E.eq f -> (In x (filter f s) <-> In x s /\ f x = true).
+Proof. 
+split; [split; [apply filter_1 with f | apply filter_2 with s] | destruct 1; apply filter_3]; auto. 
+Qed.
+
+Lemma for_all_iff : compat_bool E.eq f ->
+  (For_all (fun x => f x = true) s <-> for_all f s = true).
+Proof.
+split; [apply for_all_1 | apply for_all_2]; auto.
+Qed.
+ 
+Lemma exists_iff : compat_bool E.eq f ->
+  (Exists (fun x => f x = true) s <-> exists_ f s = true).
+Proof.
+split; [apply exists_1 | apply exists_2]; auto.
+Qed.
+
+Lemma elements_iff : In x s <-> ME.In x (elements s).
+Proof. 
+split; [apply elements_1 | apply elements_2].
+Qed.
+
+End IffSpec.
+
+(** Useful tactic for simplifying expressions like [In y (add x (union s s'))] *)
+  
+Ltac set_iff := 
+ repeat (progress (
+  rewrite add_iff || rewrite remove_iff || rewrite singleton_iff 
+  || rewrite union_iff || rewrite inter_iff || rewrite diff_iff
+  || rewrite empty_iff)).
+
+(**  * Specifications written using boolean predicates *)
+
+Section BoolSpec.
+Variable s s' s'' : t.
+Variable x y z : elt.
+
+Lemma mem_b : E.eq x y -> mem x s = mem y s.
+Proof. 
+intros.
+generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H).
+destruct (mem x s); destruct (mem y s); intuition.
+Qed.
+
+Lemma add_b : mem y (add x s) = eqb x y || mem y s.
+Proof.
+generalize (mem_iff (add x s) y)(mem_iff s y)(add_iff s x y); unfold eqb.
+destruct (eq_dec x y); destruct (mem y s); destruct (mem y (add x s)); intuition.
+Qed.
+
+Lemma add_neq_b : ~ E.eq x y -> mem y (add x s) = mem y s.
+Proof.
+intros; generalize (mem_iff (add x s) y)(mem_iff s y)(add_neq_iff s H).
+destruct (mem y s); destruct (mem y (add x s)); intuition.
+Qed.
+
+Lemma remove_b : mem y (remove x s) = mem y s && negb (eqb x y).
+Proof.
+generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_iff s x y); unfold eqb.
+destruct (eq_dec x y); destruct (mem y s); destruct (mem y (remove x s)); simpl; intuition.
+Qed.
+
+Lemma remove_neq_b : ~ E.eq x y -> mem y (remove x s) = mem y s.
+Proof.
+intros; generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_neq_iff s H).
+destruct (mem y s); destruct (mem y (remove x s)); intuition.
+Qed.
+
+Lemma singleton_b : mem y (singleton x) = eqb x y.
+Proof. 
+generalize (mem_iff (singleton x) y)(singleton_iff x y); unfold eqb.
+destruct (eq_dec x y); destruct (mem y (singleton x)); intuition.
+Qed.
+
+Lemma union_b : mem x (union s s') = mem x s || mem x s'.
+Proof.
+generalize (mem_iff (union s s') x)(mem_iff s x)(mem_iff s' x)(union_iff s s' x).
+destruct (mem x s); destruct (mem x s'); destruct (mem x (union s s')); intuition.
+Qed.
+
+Lemma inter_b : mem x (inter s s') = mem x s && mem x s'.
+Proof.
+generalize (mem_iff (inter s s') x)(mem_iff s x)(mem_iff s' x)(inter_iff s s' x).
+destruct (mem x s); destruct (mem x s'); destruct (mem x (inter s s')); intuition.
+Qed.
+
+Lemma diff_b : mem x (diff s s') = mem x s && negb (mem x s').
+Proof.
+generalize (mem_iff (diff s s') x)(mem_iff s x)(mem_iff s' x)(diff_iff s s' x).
+destruct (mem x s); destruct (mem x s'); destruct (mem x (diff s s')); simpl; intuition.
+Qed.
+
+Lemma elements_b : mem x s = existsb (eqb x) (elements s).
+Proof.
+generalize (mem_iff s x)(elements_iff s x)(existsb_exists (eqb x) (elements s)).
+rewrite InA_alt.
+destruct (mem x s); destruct (existsb (eqb x) (elements s)); auto; intros.
+symmetry.
+rewrite H1.
+destruct H0 as (H0,_).
+destruct H0 as (a,(Ha1,Ha2)); [ intuition |].
+exists a; intuition.
+unfold eqb; destruct (eq_dec x a); auto.
+rewrite <- H.
+rewrite H0.
+destruct H1 as (H1,_).
+destruct H1 as (a,(Ha1,Ha2)); [intuition|].
+exists a; intuition.
+unfold eqb in *; destruct (eq_dec x a); auto; discriminate.
+Qed.
+
+Variable f : elt->bool.
+
+Lemma filter_b : compat_bool E.eq f -> mem x (filter f s) = mem x s && f x.
+Proof. 
+intros.
+generalize (mem_iff (filter f s) x)(mem_iff s x)(filter_iff s x H).
+destruct (mem x s); destruct (mem x (filter f s)); destruct (f x); simpl; intuition.
+Qed.
+
+Lemma for_all_b : compat_bool E.eq f ->
+  for_all f s = forallb f (elements s).
+Proof.
+intros.
+generalize (forallb_forall f (elements s))(for_all_iff s H)(elements_iff s).
+unfold For_all.
+destruct (forallb f (elements s)); destruct (for_all f s); auto; intros.
+rewrite <- H1; intros.
+destruct H0 as (H0,_).
+rewrite (H2 x0) in H3.
+rewrite (InA_alt E.eq x0 (elements s)) in H3.
+destruct H3 as (a,(Ha1,Ha2)).
+rewrite (H _ _ Ha1).
+apply H0; auto.
+symmetry.
+rewrite H0; intros.
+destruct H1 as (_,H1).
+apply H1; auto.
+Qed.
+
+Lemma exists_b : compat_bool E.eq f -> 
+  exists_ f s = existsb f (elements s).
+Proof.
+intros.
+generalize (existsb_exists f (elements s))(exists_iff s H)(elements_iff s).
+unfold Exists.
+destruct (existsb f (elements s)); destruct (exists_ f s); auto; intros.
+rewrite <- H1; intros.
+destruct H0 as (H0,_).
+destruct H0 as (a,(Ha1,Ha2)); auto.
+exists a; auto.
+symmetry.
+rewrite H0.
+destruct H1 as (_,H1).
+destruct H1 as (a,(Ha1,Ha2)); auto.
+rewrite (H2 a) in Ha1.
+rewrite (InA_alt E.eq a (elements s)) in Ha1.
+destruct Ha1 as (b,(Hb1,Hb2)).
+exists b; auto.
+rewrite <- (H _ _ Hb1); auto.
+Qed.
+
+End BoolSpec.
+
+(** * [E.eq] and [Equal] are setoid equalities *)
+
+Definition E_ST : Setoid_Theory elt E.eq.
+Proof.
+constructor; [apply E.eq_refl|apply E.eq_sym|apply E.eq_trans].
+Qed.
+
+Add Setoid elt E.eq E_ST as EltSetoid.
+
+Definition Equal_ST : Setoid_Theory t Equal.
+Proof. 
+constructor; [apply eq_refl | apply eq_sym | apply eq_trans].
+Qed.
+
+Add Setoid t Equal Equal_ST as EqualSetoid.
+
+Add Morphism In with signature E.eq ==> Equal ==> iff as In_m.
+Proof.
+unfold Equal; intros x y H s s' H0.
+rewrite (In_eq_iff s H); auto.
+Qed.
+
+Add Morphism is_empty : is_empty_m.
+Proof.
+unfold Equal; intros s s' H.
+generalize (is_empty_iff s)(is_empty_iff s').
+destruct (is_empty s); destruct (is_empty s'); 
+ unfold Empty; auto; intros.
+symmetry.
+rewrite <- H1; intros a Ha.
+rewrite <- (H a) in Ha.
+destruct H0 as (_,H0).
+exact (H0 (refl_equal true) _ Ha).
+rewrite <- H0; intros a Ha.
+rewrite (H a) in Ha.
+destruct H1 as (_,H1).
+exact (H1 (refl_equal true) _ Ha).
+Qed.
+
+Add Morphism Empty with signature Equal ==> iff as Empty_m.
+Proof. 
+intros; do 2 rewrite is_empty_iff; rewrite H; intuition.
+Qed.
+
+Add Morphism mem : mem_m.
+Proof.
+unfold Equal; intros x y H s s' H0.
+generalize (H0 x); clear H0; rewrite (In_eq_iff s' H).
+generalize (mem_iff s x)(mem_iff s' y).
+destruct (mem x s); destruct (mem y s'); intuition.
+Qed.
+
+Add Morphism singleton : singleton_m.
+Proof.
+unfold Equal; intros x y H a.
+do 2 rewrite singleton_iff; split; order.
+Qed.
+
+Add Morphism add : add_m.
+Proof.
+unfold Equal; intros x y H s s' H0 a.
+do 2 rewrite add_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism remove : remove_m.
+Proof.
+unfold Equal; intros x y H s s' H0 a.
+do 2 rewrite remove_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism union : union_m.
+Proof.
+unfold Equal; intros s s' H s'' s''' H0 a.
+do 2 rewrite union_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism inter : inter_m.
+Proof.
+unfold Equal; intros s s' H s'' s''' H0 a.
+do 2 rewrite inter_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism diff : diff_m.
+Proof.
+unfold Equal; intros s s' H s'' s''' H0 a.
+do 2 rewrite diff_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism Subset with signature Equal ==> Equal ==> iff as  Subset_m.
+Proof. 
+unfold Equal, Subset; firstorder.
+Qed.
+
+Add Morphism subset : subset_m.
+Proof.
+intros s s' H s'' s''' H0.
+generalize (subset_iff s s'') (subset_iff s' s'''). 
+destruct (subset s s''); destruct (subset s' s'''); auto; intros.
+rewrite H in H1; rewrite H0 in H1; intuition.
+rewrite H in H1; rewrite H0 in H1; intuition.
+Qed.
+
+Add Morphism equal : equal_m.
+Proof.
+intros s s' H s'' s''' H0.
+generalize (equal_iff s s'') (equal_iff s' s''').
+destruct (equal s s''); destruct (equal s' s'''); auto; intros.
+rewrite H in H1; rewrite H0 in H1; intuition.
+rewrite H in H1; rewrite H0 in H1; intuition.
+Qed.
+
+(* [fold], [filter], [for_all], [exists_] and [partition] cannot be proved morphism
+   without additional hypothesis on [f]. For instance: *)
+
+Lemma filter_equal : forall f, compat_bool E.eq f -> 
+  forall s s', s[=]s' -> filter f s [=] filter f s'.
+Proof.
+unfold Equal; intros; repeat rewrite filter_iff; auto; rewrite H0; tauto.
+Qed.
+
+(* For [elements], [min_elt], [max_elt] and [choose], we would need setoid 
+   structures on [list elt] and [option elt]. *)
+
+(* Later:
+Add Morphism cardinal ; cardinal_m.
+*)
+
+End Facts.
diff --git a/theories/FSets/FSetInterface.v b/theories/FSets/FSetInterface.v
new file mode 100644
index 00000000..c177abfe
--- /dev/null
+++ b/theories/FSets/FSetInterface.v
@@ -0,0 +1,420 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetInterface.v 8671 2006-03-29 08:31:28Z letouzey $ *)
+
+(** * Finite set library *)
+
+(** Set interfaces *)
+
+(* begin hide *)
+Require Export Bool.
+Require Export OrderedType.
+Set Implicit Arguments.
+Unset Strict Implicit.
+(* end hide *)
+
+(** Compatibility of a  boolean function with respect to an equality. *)
+Definition compat_bool (A:Set)(eqA: A->A->Prop)(f: A-> bool) :=
+  forall x y : A, eqA x y -> f x = f y.
+
+(** Compatibility of a predicate with respect to an equality. *)
+Definition compat_P (A:Set)(eqA: A->A->Prop)(P : A -> Prop) :=
+  forall x y : A, eqA x y -> P x -> P y.
+
+Hint Unfold compat_bool compat_P.
+
+(** * Non-dependent signature
+
+    Signature [S] presents sets as purely informative programs 
+    together with axioms *)
+
+Module Type S.
+
+  Declare Module E : OrderedType.
+  Definition elt := E.t.
+
+  Parameter t : Set. (** the abstract type of sets *)
+
+  (** Logical predicates *)
+  Parameter In : elt -> t -> Prop.
+  Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+  Definition Subset s s' := forall a : elt, In a s -> In a s'.
+  Definition Empty s := forall a : elt, ~ In a s.
+  Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
+  Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x.
+  
+  Notation "s [=] t" := (Equal s t) (at level 70, no associativity).
+  Notation "s [<=] t" := (Subset s t) (at level 70, no associativity).
+
+  Parameter empty : t.
+  (** The empty set. *)
+
+  Parameter is_empty : t -> bool.
+  (** Test whether a set is empty or not. *)
+
+  Parameter mem : elt -> t -> bool.
+  (** [mem x s] tests whether [x] belongs to the set [s]. *)
+
+  Parameter add : elt -> t -> t.
+  (** [add x s] returns a set containing all elements of [s],
+  plus [x]. If [x] was already in [s], [s] is returned unchanged. *)
+
+  Parameter singleton : elt -> t.
+  (** [singleton x] returns the one-element set containing only [x]. *)
+
+  Parameter remove : elt -> t -> t.
+  (** [remove x s] returns a set containing all elements of [s],
+  except [x]. If [x] was not in [s], [s] is returned unchanged. *)
+
+  Parameter union : t -> t -> t.
+  (** Set union. *)
+
+  Parameter inter : t -> t -> t.
+  (** Set intersection. *)
+
+  Parameter diff : t -> t -> t.
+  (** Set difference. *)
+
+  Definition eq : t -> t -> Prop := Equal.
+  Parameter lt : t -> t -> Prop.
+  Parameter compare : forall s s' : t, Compare lt eq s s'.
+  (** Total ordering between sets. Can be used as the ordering function
+  for doing sets of sets. *)
+
+  Parameter equal : t -> t -> bool.
+  (** [equal s1 s2] tests whether the sets [s1] and [s2] are
+  equal, that is, contain equal elements. *)
+
+  Parameter subset : t -> t -> bool.
+  (** [subset s1 s2] tests whether the set [s1] is a subset of
+  the set [s2]. *)
+
+  (** Coq comment: [iter] is useless in a purely functional world *)
+  (**  iter: (elt -> unit) -> set -> unit. i*)
+  (** [iter f s] applies [f] in turn to all elements of [s].
+  The order in which the elements of [s] are presented to [f]
+  is unspecified. *)
+
+  Parameter fold : forall A : Set, (elt -> A -> A) -> t -> A -> A.
+  (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)],
+  where [x1 ... xN] are the elements of [s], in increasing order. *)
+
+  Parameter for_all : (elt -> bool) -> t -> bool.
+  (** [for_all p s] checks if all elements of the set
+  satisfy the predicate [p]. *)
+
+  Parameter exists_ : (elt -> bool) -> t -> bool.
+  (** [exists p s] checks if at least one element of
+  the set satisfies the predicate [p]. *)
+
+  Parameter filter : (elt -> bool) -> t -> t.
+  (** [filter p s] returns the set of all elements in [s]
+  that satisfy predicate [p]. *)
+
+  Parameter partition : (elt -> bool) -> t -> t * t.
+  (** [partition p s] returns a pair of sets [(s1, s2)], where
+  [s1] is the set of all the elements of [s] that satisfy the
+  predicate [p], and [s2] is the set of all the elements of
+  [s] that do not satisfy [p]. *)
+
+  Parameter cardinal : t -> nat.
+  (** Return the number of elements of a set. *)
+  (** Coq comment: nat instead of int ... *)
+
+  Parameter elements : t -> list elt.
+  (** Return the list of all elements of the given set.
+  The returned list is sorted in increasing order with respect
+  to the ordering [Ord.compare], where [Ord] is the argument
+  given to {!Set.Make}. *)
+
+  Parameter min_elt : t -> option elt.
+  (** Return the smallest element of the given set
+  (with respect to the [Ord.compare] ordering), or raise
+  [Not_found] if the set is empty. *)
+  (** Coq comment: [Not_found] is represented by the option type *)
+
+  Parameter max_elt : t -> option elt.
+  (** Same as {!Set.S.min_elt}, but returns the largest element of the
+  given set. *)
+  (** Coq comment: [Not_found] is represented by the option type *)
+
+  Parameter choose : t -> option elt.
+  (** Return one element of the given set, or raise [Not_found] if
+  the set is empty. Which element is chosen is unspecified,
+  but equal elements will be chosen for equal sets. *)
+  (** Coq comment: [Not_found] is represented by the option type *)
+
+  Section Spec. 
+
+  Variable s s' s'' : t.
+  Variable x y z : elt.
+
+  (** Specification of [In] *)
+  Parameter In_1 : E.eq x y -> In x s -> In y s.
+ 
+  (** Specification of [eq] *)
+  Parameter eq_refl : eq s s. 
+  Parameter eq_sym : eq s s' -> eq s' s.
+  Parameter eq_trans : eq s s' -> eq s' s'' -> eq s s''.
+ 
+  (** Specification of [lt] *)
+  Parameter lt_trans : lt s s' -> lt s' s'' -> lt s s''.
+  Parameter lt_not_eq : lt s s' -> ~ eq s s'.
+
+  (** Specification of [mem] *)
+  Parameter mem_1 : In x s -> mem x s = true.
+  Parameter mem_2 : mem x s = true -> In x s. 
+ 
+  (** Specification of [equal] *) 
+  Parameter equal_1 : s[=]s' -> equal s s' = true.
+  Parameter equal_2 : equal s s' = true ->s[=]s'.
+
+  (** Specification of [subset] *)
+  Parameter subset_1 : s[<=]s' -> subset s s' = true.
+  Parameter subset_2 : subset s s' = true -> s[<=]s'.
+
+  (** Specification of [empty] *)
+  Parameter empty_1 : Empty empty.
+
+  (** Specification of [is_empty] *)
+  Parameter is_empty_1 : Empty s -> is_empty s = true. 
+  Parameter is_empty_2 : is_empty s = true -> Empty s.
+ 
+  (** Specification of [add] *)
+  Parameter add_1 : E.eq x y -> In y (add x s).
+  Parameter add_2 : In y s -> In y (add x s).
+  Parameter add_3 : ~ E.eq x y -> In y (add x s) -> In y s. 
+
+  (** Specification of [remove] *)
+  Parameter remove_1 : E.eq x y -> ~ In y (remove x s).
+  Parameter remove_2 : ~ E.eq x y -> In y s -> In y (remove x s).
+  Parameter remove_3 : In y (remove x s) -> In y s.
+
+  (** Specification of [singleton] *)
+  Parameter singleton_1 : In y (singleton x) -> E.eq x y. 
+  Parameter singleton_2 : E.eq x y -> In y (singleton x). 
+
+  (** Specification of [union] *)
+  Parameter union_1 : In x (union s s') -> In x s \/ In x s'.
+  Parameter union_2 : In x s -> In x (union s s'). 
+  Parameter union_3 : In x s' -> In x (union s s').
+
+  (** Specification of [inter] *)
+  Parameter inter_1 : In x (inter s s') -> In x s.
+  Parameter inter_2 : In x (inter s s') -> In x s'.
+  Parameter inter_3 : In x s -> In x s' -> In x (inter s s').
+
+  (** Specification of [diff] *)
+  Parameter diff_1 : In x (diff s s') -> In x s. 
+  Parameter diff_2 : In x (diff s s') -> ~ In x s'.
+  Parameter diff_3 : In x s -> ~ In x s' -> In x (diff s s').
+ 
+  (** Specification of [fold] *)  
+  Parameter fold_1 : forall (A : Set) (i : A) (f : elt -> A -> A),
+      fold f s i = fold_left (fun a e => f e a) (elements s) i.
+
+  (** Specification of [cardinal] *)  
+  Parameter cardinal_1 : cardinal s = length (elements s).
+
+  Section Filter.
+  
+  Variable f : elt -> bool.
+
+  (** Specification of [filter] *)
+  Parameter filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. 
+  Parameter filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. 
+  Parameter filter_3 :
+      compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s).
+
+  (** Specification of [for_all] *)
+  Parameter for_all_1 :
+      compat_bool E.eq f ->
+      For_all (fun x => f x = true) s -> for_all f s = true.
+  Parameter for_all_2 :
+      compat_bool E.eq f ->
+      for_all f s = true -> For_all (fun x => f x = true) s.
+
+  (** Specification of [exists] *)
+  Parameter exists_1 :
+      compat_bool E.eq f ->
+      Exists (fun x => f x = true) s -> exists_ f s = true.
+  Parameter exists_2 :
+      compat_bool E.eq f ->
+      exists_ f s = true -> Exists (fun x => f x = true) s.
+
+  (** Specification of [partition] *)
+  Parameter partition_1 : compat_bool E.eq f -> 
+      fst (partition f s) [=] filter f s.
+  Parameter partition_2 : compat_bool E.eq f -> 
+      snd (partition f s) [=] filter (fun x => negb (f x)) s.
+
+  (** Specification of [elements] *)
+  Parameter elements_1 : In x s -> InA E.eq x (elements s).
+  Parameter elements_2 : InA E.eq x (elements s) -> In x s.
+  Parameter elements_3 : sort E.lt (elements s).  
+
+  (** Specification of [min_elt] *)
+  Parameter min_elt_1 : min_elt s = Some x -> In x s. 
+  Parameter min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. 
+  Parameter min_elt_3 : min_elt s = None -> Empty s.
+
+  (** Specification of [max_elt] *)  
+  Parameter max_elt_1 : max_elt s = Some x -> In x s. 
+  Parameter max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. 
+  Parameter max_elt_3 : max_elt s = None -> Empty s.
+
+  (** Specification of [choose] *)
+  Parameter choose_1 : choose s = Some x -> In x s.
+  Parameter choose_2 : choose s = None -> Empty s.
+(*  Parameter choose_equal: 
+      (equal s s')=true -> E.eq (choose s) (choose s'). *)
+
+  End Filter.
+  End Spec.
+
+  (* begin hide *)
+  Hint Immediate In_1.
+  
+  Hint Resolve mem_1 mem_2 equal_1 equal_2 subset_1 subset_2 empty_1
+    is_empty_1 is_empty_2 choose_1 choose_2 add_1 add_2 add_3 remove_1
+    remove_2 remove_3 singleton_1 singleton_2 union_1 union_2 union_3 inter_1
+    inter_2 inter_3 diff_1 diff_2 diff_3 filter_1 filter_2 filter_3 for_all_1
+    for_all_2 exists_1 exists_2 partition_1 partition_2 elements_1 elements_2
+    elements_3 min_elt_1 min_elt_2 min_elt_3 max_elt_1 max_elt_2 max_elt_3.
+  (* end hide *)
+
+End S.
+
+(** * Dependent signature 
+
+    Signature [Sdep] presents sets using dependent types *)
+
+Module Type Sdep.
+
+  Declare Module E : OrderedType.
+  Definition elt := E.t.
+
+  Parameter t : Set.
+
+  Parameter In : elt -> t -> Prop.
+  Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+  Definition Subset s s' := forall a : elt, In a s -> In a s'.
+  Definition Add x s s' := forall y, In y s' <-> E.eq x y \/ In y s.
+  Definition Empty s := forall a : elt, ~ In a s.
+  Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
+  Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x.
+
+  Notation "s [=] t" := (Equal s t) (at level 70, no associativity).
+
+  Definition eq : t -> t -> Prop := Equal.
+  Parameter lt : t -> t -> Prop.
+  Parameter compare : forall s s' : t, Compare lt eq s s'.
+
+  Parameter eq_refl : forall s : t, eq s s. 
+  Parameter eq_sym : forall s s' : t, eq s s' -> eq s' s.
+  Parameter eq_trans : forall s s' s'' : t, eq s s' -> eq s' s'' -> eq s s''.
+  Parameter lt_trans : forall s s' s'' : t, lt s s' -> lt s' s'' -> lt s s''.
+  Parameter lt_not_eq : forall s s' : t, lt s s' -> ~ eq s s'.
+
+  Parameter eq_In : forall (s : t) (x y : elt), E.eq x y -> In x s -> In y s.
+
+  Parameter empty : {s : t | Empty s}.
+
+  Parameter is_empty : forall s : t, {Empty s} + {~ Empty s}.
+
+  Parameter mem : forall (x : elt) (s : t), {In x s} + {~ In x s}.
+
+  Parameter add : forall (x : elt) (s : t), {s' : t | Add x s s'}.
+
+  Parameter
+    singleton : forall x : elt, {s : t | forall y : elt, In y s <-> E.eq x y}.
+  
+  Parameter
+    remove :
+      forall (x : elt) (s : t),
+      {s' : t | forall y : elt, In y s' <-> ~ E.eq x y /\ In y s}.
+
+  Parameter
+    union :
+      forall s s' : t,
+      {s'' : t | forall x : elt, In x s'' <-> In x s \/ In x s'}.
+
+  Parameter
+    inter :
+      forall s s' : t,
+      {s'' : t | forall x : elt, In x s'' <-> In x s /\ In x s'}.
+
+  Parameter
+    diff :
+      forall s s' : t,
+      {s'' : t | forall x : elt, In x s'' <-> In x s /\ ~ In x s'}.
+
+  Parameter equal : forall s s' : t, {s[=]s'} + {~ s[=]s'}.
+ 
+  Parameter subset : forall s s' : t, {Subset s s'} + {~ Subset s s'}.
+
+  Parameter
+    filter :
+      forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x})
+        (s : t),
+      {s' : t | compat_P E.eq P -> forall x : elt, In x s' <-> In x s /\ P x}.
+
+  Parameter
+    for_all :
+      forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x})
+        (s : t),
+      {compat_P E.eq P -> For_all P s} + {compat_P E.eq P -> ~ For_all P s}.
+  
+  Parameter
+    exists_ :
+      forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x})
+        (s : t),
+      {compat_P E.eq P -> Exists P s} + {compat_P E.eq P -> ~ Exists P s}.
+
+  Parameter
+    partition :
+      forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x})
+        (s : t),
+      {partition : t * t |
+      let (s1, s2) := partition in
+      compat_P E.eq P ->
+      For_all P s1 /\
+      For_all (fun x => ~ P x) s2 /\
+      (forall x : elt, In x s <-> In x s1 \/ In x s2)}.
+
+  Parameter
+    elements :
+      forall s : t,
+      {l : list elt |
+      sort E.lt l /\ (forall x : elt, In x s <-> InA E.eq x l)}.
+
+  Parameter
+    fold :
+      forall (A : Set) (f : elt -> A -> A) (s : t) (i : A),
+      {r : A | let (l,_) := elements s in 
+                  r = fold_left (fun a e => f e a) l i}.
+
+  Parameter
+    cardinal :
+      forall s : t,
+      {r : nat | let (l,_) := elements s in r = length l }.
+
+  Parameter
+    min_elt :
+      forall s : t,
+      {x : elt | In x s /\ For_all (fun y => ~ E.lt y x) s} + {Empty s}.
+
+  Parameter
+    max_elt :
+      forall s : t,
+      {x : elt | In x s /\ For_all (fun y => ~ E.lt x y) s} + {Empty s}.
+
+  Parameter choose : forall s : t, {x : elt | In x s} + {Empty s}.
+
+End Sdep.
diff --git a/theories/FSets/FSetList.v b/theories/FSets/FSetList.v
new file mode 100644
index 00000000..ca86ffcc
--- /dev/null
+++ b/theories/FSets/FSetList.v
@@ -0,0 +1,1163 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetList.v 8667 2006-03-28 11:59:44Z letouzey $ *)
+
+(** * Finite sets library *)
+
+(** This file proposes an implementation of the non-dependant 
+    interface [FSetInterface.S] using strictly ordered list. *)
+
+Require Export FSetInterface.
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+(** * Functions over lists
+
+   First, we provide sets as lists which are not necessarily sorted.
+   The specs are proved under the additional condition of being sorted. 
+   And the functions returning sets are proved to preserve this invariant. *)
+
+Module Raw (X: OrderedType).
+ 
+  Module E := X.
+  Module MX := OrderedTypeFacts X.
+  Import MX.
+
+  Definition elt := X.t.
+  Definition t := list elt.
+
+  Definition empty : t := nil.
+
+  Definition is_empty (l : t) : bool := if l then true else false.
+
+  (** ** The set operations. *)
+
+  Fixpoint mem (x : elt) (s : t) {struct s} : bool :=
+    match s with
+    | nil => false
+    | y :: l =>
+        match X.compare x y with
+        | LT _ => false
+        | EQ _ => true
+        | GT _ => mem x l
+        end
+    end.
+
+  Fixpoint add (x : elt) (s : t) {struct s} : t :=
+    match s with
+    | nil => x :: nil
+    | y :: l =>
+        match X.compare x y with
+        | LT _ => x :: s
+        | EQ _ => s
+        | GT _ => y :: add x l
+        end
+    end.
+
+  Definition singleton (x : elt) : t := x :: nil. 
+
+  Fixpoint remove (x : elt) (s : t) {struct s} : t :=
+    match s with
+    | nil => nil
+    | y :: l =>
+        match X.compare x y with
+        | LT _ => s
+        | EQ _ => l
+        | GT _ => y :: remove x l
+        end
+    end.  
+  
+  Fixpoint union (s : t) : t -> t :=
+    match s with
+    | nil => fun s' => s'
+    | x :: l =>
+        (fix union_aux (s' : t) : t :=
+           match s' with
+           | nil => s
+           | x' :: l' =>
+               match X.compare x x' with
+               | LT _ => x :: union l s'
+               | EQ _ => x :: union l l'
+               | GT _ => x' :: union_aux l'
+               end
+           end)
+    end.      
+
+  Fixpoint inter (s : t) : t -> t :=
+    match s with
+    | nil => fun _ => nil
+    | x :: l =>
+        (fix inter_aux (s' : t) : t :=
+           match s' with
+           | nil => nil
+           | x' :: l' =>
+               match X.compare x x' with
+               | LT _ => inter l s'
+               | EQ _ => x :: inter l l'
+               | GT _ => inter_aux l'
+               end
+           end)
+    end.  
+  
+  Fixpoint diff (s : t) : t -> t :=
+    match s with
+    | nil => fun _ => nil
+    | x :: l =>
+        (fix diff_aux (s' : t) : t :=
+           match s' with
+           | nil => s
+           | x' :: l' =>
+               match X.compare x x' with
+               | LT _ => x :: diff l s'
+               | EQ _ => diff l l'
+               | GT _ => diff_aux l'
+               end
+           end)
+    end.  
+   
+  Fixpoint equal (s : t) : t -> bool :=
+    fun s' : t =>
+    match s, s' with
+    | nil, nil => true
+    | x :: l, x' :: l' =>
+        match X.compare x x' with
+        | EQ _ => equal l l'
+        | _ => false
+        end
+    | _, _ => false
+    end.
+
+  Fixpoint subset (s s' : t) {struct s'} : bool :=
+    match s, s' with
+    | nil, _ => true
+    | x :: l, x' :: l' =>
+        match X.compare x x' with
+        | LT _ => false
+        | EQ _ => subset l l'
+        | GT _ => subset s l'
+        end
+    | _, _ => false
+    end.
+
+  Fixpoint fold (B : Set) (f : elt -> B -> B) (s : t) {struct s} : 
+   B -> B := fun i => match s with
+                      | nil => i
+                      | x :: l => fold f l (f x i)
+                      end.  
+
+  Fixpoint filter (f : elt -> bool) (s : t) {struct s} : t :=
+    match s with
+    | nil => nil
+    | x :: l => if f x then x :: filter f l else filter f l
+    end.  
+
+  Fixpoint for_all (f : elt -> bool) (s : t) {struct s} : bool :=
+    match s with
+    | nil => true
+    | x :: l => if f x then for_all f l else false
+    end.  
+ 
+  Fixpoint exists_ (f : elt -> bool) (s : t) {struct s} : bool :=
+    match s with
+    | nil => false
+    | x :: l => if f x then true else exists_ f l
+    end.
+
+  Fixpoint partition (f : elt -> bool) (s : t) {struct s} : 
+   t * t :=
+    match s with
+    | nil => (nil, nil)
+    | x :: l =>
+        let (s1, s2) := partition f l in
+        if f x then (x :: s1, s2) else (s1, x :: s2)
+    end.
+
+  Definition cardinal (s : t) : nat := length s.
+
+  Definition elements (x : t) : list elt := x.
+
+  Definition min_elt (s : t) : option elt :=
+    match s with
+    | nil => None
+    | x :: _ => Some x
+    end.
+
+  Fixpoint max_elt (s : t) : option elt :=
+    match s with
+    | nil => None
+    | x :: nil => Some x
+    | _ :: l => max_elt l
+    end.
+
+  Definition choose := min_elt.
+
+  (** ** Proofs of set operation specifications. *)
+
+  Notation Sort := (sort X.lt).
+  Notation Inf := (lelistA X.lt).
+  Notation In := (InA X.eq).
+
+  Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+  Definition Subset s s' := forall a : elt, In a s -> In a s'.
+  Definition Empty s := forall a : elt, ~ In a s.
+  Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
+  Definition Exists (P : elt -> Prop) (s : t) := exists x, In x s /\ P x.
+
+  Lemma mem_1 :
+   forall (s : t) (Hs : Sort s) (x : elt), In x s -> mem x s = true. 
+  Proof.
+  simple induction s; intros.
+  inversion H.
+  inversion_clear Hs.
+  inversion_clear H0.
+  simpl; elim_comp; trivial.
+  simpl; elim_comp_gt x a; auto.
+  apply Sort_Inf_In with l; trivial.
+  Qed.
+
+  Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s.
+  Proof.
+  simple induction s.
+  intros; inversion H.
+  intros a l Hrec x.
+  simpl.
+  case (X.compare x a); intros; try discriminate; auto.
+  Qed.
+
+  Lemma add_Inf :
+   forall (s : t) (x a : elt), Inf a s -> X.lt a x -> Inf a (add x s).
+  Proof.
+  simple induction s.  
+  simpl; intuition.
+  simpl; intros; case (X.compare x a); intuition; inversion H0;
+   intuition.
+  Qed.
+  Hint Resolve add_Inf.
+  
+  Lemma add_sort : forall (s : t) (Hs : Sort s) (x : elt), Sort (add x s).
+  Proof.
+  simple induction s.
+  simpl; intuition.
+  simpl; intros; case (X.compare x a); intuition; inversion_clear Hs;
+   auto.
+  Qed. 
+
+  Lemma add_1 :
+   forall (s : t) (Hs : Sort s) (x y : elt), X.eq x y -> In y (add x s).
+  Proof.
+  simple induction s. 
+  simpl; intuition.
+  simpl; intros; case (X.compare x a); inversion_clear Hs; auto.
+  constructor; apply X.eq_trans with x; auto.
+  Qed.
+
+  Lemma add_2 :
+   forall (s : t) (Hs : Sort s) (x y : elt), In y s -> In y (add x s).
+  Proof.
+  simple induction s. 
+  simpl; intuition.
+  simpl; intros; case (X.compare x a); intuition.
+  inversion_clear Hs; inversion_clear H0; auto.
+  Qed.
+
+  Lemma add_3 :
+   forall (s : t) (Hs : Sort s) (x y : elt),
+   ~ X.eq x y -> In y (add x s) -> In y s.
+  Proof.
+  simple induction s. 
+  simpl; inversion_clear 3; auto; order.
+  simpl; intros a l Hrec Hs x y; case (X.compare x a); intros;
+   inversion_clear H0; inversion_clear Hs; auto.
+  order.
+  constructor 2; apply Hrec with x; auto.
+  Qed.
+
+  Lemma remove_Inf :
+   forall (s : t) (Hs : Sort s) (x a : elt), Inf a s -> Inf a (remove x s).
+  Proof.
+  simple induction s.  
+  simpl; intuition.
+  simpl; intros; case (X.compare x a); intuition; inversion_clear H0; auto.
+  inversion_clear Hs; apply Inf_lt with a; auto.
+  Qed.
+  Hint Resolve remove_Inf.
+
+  Lemma remove_sort :
+   forall (s : t) (Hs : Sort s) (x : elt), Sort (remove x s).
+  Proof.
+  simple induction s.
+  simpl; intuition.
+  simpl; intros; case (X.compare x a); intuition; inversion_clear Hs; auto.
+  Qed. 
+
+  Lemma remove_1 :
+   forall (s : t) (Hs : Sort s) (x y : elt), X.eq x y -> ~ In y (remove x s).
+  Proof.
+  simple induction s. 
+  simpl; red; intros; inversion H0.
+  simpl; intros; case (X.compare x a); intuition; inversion_clear Hs. 
+  inversion_clear H1.
+  order.
+  generalize (Sort_Inf_In H2 H3 H4); order.
+  generalize (Sort_Inf_In H2 H3 H1); order.
+  inversion_clear H1.
+  order.
+  apply (H H2 _ _ H0 H4).
+  Qed.
+
+  Lemma remove_2 :
+   forall (s : t) (Hs : Sort s) (x y : elt),
+   ~ X.eq x y -> In y s -> In y (remove x s).
+  Proof.
+  simple induction s. 
+  simpl; intuition.
+  simpl; intros; case (X.compare x a); intuition; inversion_clear Hs;
+   inversion_clear H1; auto. 
+  destruct H0; apply X.eq_trans with a; auto.
+  Qed.
+
+  Lemma remove_3 :
+   forall (s : t) (Hs : Sort s) (x y : elt), In y (remove x s) -> In y s.
+  Proof.
+  simple induction s. 
+  simpl; intuition.
+  simpl; intros a l Hrec Hs x y; case (X.compare x a); intuition.
+  inversion_clear Hs; inversion_clear H; auto.
+  constructor 2; apply Hrec with x; auto.
+  Qed.
+  
+  Lemma singleton_sort : forall x : elt, Sort (singleton x).
+  Proof.
+  unfold singleton; simpl; auto.
+  Qed.
+
+  Lemma singleton_1 : forall x y : elt, In y (singleton x) -> X.eq x y.
+  Proof.
+  unfold singleton; simpl; intuition.
+  inversion_clear H; auto; inversion H0.
+  Qed. 
+
+  Lemma singleton_2 : forall x y : elt, X.eq x y -> In y (singleton x).
+  Proof.
+  unfold singleton; simpl; auto.
+  Qed. 
+
+  Ltac DoubleInd :=
+    simple induction s;
+     [ simpl; auto; try solve [ intros; inversion H ]
+     | intros x l Hrec; simple induction s';
+        [ simpl; auto; try solve [ intros; inversion H ]
+        | intros x' l' Hrec' Hs Hs'; inversion Hs; inversion Hs'; subst;
+           simpl ] ].
+
+  Lemma union_Inf :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (a : elt),
+   Inf a s -> Inf a s' -> Inf a (union s s').
+  Proof.
+  DoubleInd.
+  intros i His His'; inversion_clear His; inversion_clear His'.
+  case (X.compare x x'); auto.
+  Qed.
+  Hint Resolve union_Inf.
+ 
+  Lemma union_sort :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (union s s').
+  Proof.
+  DoubleInd; case (X.compare x x'); intuition; constructor; auto.
+  apply Inf_eq with x'; trivial; apply union_Inf; trivial; apply Inf_eq with x; auto.
+  change (Inf x' (union (x :: l) l')); auto.
+  Qed.  
+  
+  Lemma union_1 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x (union s s') -> In x s \/ In x s'.
+  Proof.
+  DoubleInd; case (X.compare x x'); intuition; inversion_clear H; intuition.
+  elim (Hrec (x' :: l') H1 Hs' x0); intuition.
+  elim (Hrec l' H1 H5 x0); intuition.
+  elim (H0 x0); intuition.
+  Qed.
+
+  Lemma union_2 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x s -> In x (union s s').
+  Proof.
+  DoubleInd. 
+  intros i Hi; case (X.compare x x'); intuition; inversion_clear Hi; auto.
+  Qed.
+
+  Lemma union_3 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x s' -> In x (union s s').
+  Proof.
+  DoubleInd. 
+  intros i Hi; case (X.compare x x'); inversion_clear Hi; intuition.
+  constructor; apply X.eq_trans with x'; auto.  
+  Qed.
+    
+  Lemma inter_Inf :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (a : elt),
+   Inf a s -> Inf a s' -> Inf a (inter s s').
+  Proof.
+  DoubleInd.
+  intros i His His'; inversion His; inversion His'; subst.
+  case (X.compare x x'); intuition. 
+  apply Inf_lt with x; auto.
+  apply H3; auto.
+  apply Inf_lt with x'; auto.
+  Qed.
+  Hint Resolve inter_Inf. 
+
+  Lemma inter_sort :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (inter s s').
+  Proof.
+  DoubleInd; case (X.compare x x'); auto.
+  constructor; auto.
+  apply Inf_eq with x'; trivial; apply inter_Inf; trivial; apply Inf_eq with x; auto.
+  Qed.  
+  
+  Lemma inter_1 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x (inter s s') -> In x s.
+  Proof.
+  DoubleInd; case (X.compare x x'); intuition.
+  constructor 2; apply Hrec with (x'::l'); auto.
+  inversion_clear H; auto.
+  constructor 2; apply Hrec with l'; auto.
+  Qed.
+
+  Lemma inter_2 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x (inter s s') -> In x s'.
+  Proof.
+  DoubleInd; case (X.compare x x'); intuition; inversion_clear H.
+  constructor 1; apply X.eq_trans with x; auto.
+  constructor 2; auto.
+  Qed.
+
+  Lemma inter_3 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x s -> In x s' -> In x (inter s s').
+  Proof.
+  DoubleInd.
+  intros i His His'; elim (X.compare x x'); intuition.
+
+  inversion_clear His; auto.
+  generalize (Sort_Inf_In Hs' (cons_leA _ _ _ _ l0) His'); order.
+
+  inversion_clear His; auto; inversion_clear His'; auto.
+  constructor; apply X.eq_trans with x'; auto.
+
+  change (In i (inter (x :: l) l')). 
+  inversion_clear His'; auto.
+  generalize (Sort_Inf_In Hs (cons_leA _ _ _ _ l0) His); order.
+  Qed.
+
+  Lemma diff_Inf :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (a : elt),
+   Inf a s -> Inf a s' -> Inf a (diff s s').
+  Proof.
+  DoubleInd.
+  intros i His His'; inversion His; inversion His'.
+  case (X.compare x x'); intuition.
+  apply Hrec; trivial.
+  apply Inf_lt with x; auto.
+  apply Inf_lt with x'; auto.
+  apply H10; trivial.
+  apply Inf_lt with x'; auto.
+  Qed.
+  Hint Resolve diff_Inf. 
+
+  Lemma diff_sort :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Sort (diff s s').
+  Proof.
+  DoubleInd; case (X.compare x x'); auto.
+  Qed.  
+  
+  Lemma diff_1 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x (diff s s') -> In x s.
+  Proof.
+  DoubleInd; case (X.compare x x'); intuition.
+  inversion_clear H; auto.
+  constructor 2; apply Hrec with (x'::l'); auto.
+  constructor 2; apply Hrec with l'; auto.
+  Qed.
+
+  Lemma diff_2 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x (diff s s') -> ~ In x s'.
+  Proof.
+  DoubleInd.
+  intros; intro Abs; inversion Abs. 
+  case (X.compare x x'); intuition.
+
+  inversion_clear H.
+  generalize (Sort_Inf_In Hs' (cons_leA _ _ _ _ l0) H3); order.
+  apply Hrec with (x'::l') x0; auto.
+  
+  inversion_clear H3.
+  generalize (Sort_Inf_In H1 H2 (diff_1 H1 H5 H)); order.
+  apply Hrec with l' x0; auto.
+  
+  inversion_clear H3. 
+  generalize (Sort_Inf_In Hs (cons_leA _ _ _ _ l0) (diff_1 Hs H5 H)); order.
+  apply H0 with x0; auto.
+  Qed.
+
+  Lemma diff_3 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s') (x : elt),
+   In x s -> ~ In x s' -> In x (diff s s').
+  Proof.
+  DoubleInd.
+  intros i His His'; elim (X.compare x x'); intuition; inversion_clear His; auto.
+  elim His'; constructor; apply X.eq_trans with x; auto.
+  Qed.  
+
+  Lemma equal_1 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'),
+   Equal s s' -> equal s s' = true.
+  Proof.
+  simple induction s; unfold Equal.
+  intro s'; case s'; auto.
+  simpl; intuition.
+  elim (H e); intros; assert (A : In e nil); auto; inversion A.
+  intros x l Hrec s'.
+  case s'.
+  intros; elim (H x); intros; assert (A : In x nil); auto; inversion A.
+  intros x' l' Hs Hs'; inversion Hs; inversion Hs'; subst.
+  simpl; case (X.compare x); intros; auto.
+
+  elim (H x); intros.
+  assert (A : In x (x' :: l')); auto; inversion_clear A.
+  order.
+  generalize (Sort_Inf_In H5 H6 H4); order.
+  
+  apply Hrec; intuition; elim (H a); intros.
+  assert (A : In a (x' :: l')); auto; inversion_clear A; auto.
+  generalize (Sort_Inf_In H1 H2 H0); order.
+  assert (A : In a (x :: l)); auto; inversion_clear A; auto.
+  generalize (Sort_Inf_In H5 H6 H0); order.
+
+  elim (H x'); intros.
+  assert (A : In x' (x :: l)); auto; inversion_clear A.
+  order.
+  generalize (Sort_Inf_In H1 H2 H4); order.
+  Qed.
+
+  Lemma equal_2 : forall s s' : t, equal s s' = true -> Equal s s'.
+  Proof.
+  simple induction s; unfold Equal.
+  intro s'; case s'; intros.
+  intuition.
+  simpl in H; discriminate H.
+  intros x l Hrec s'.
+  case s'.
+  intros; simpl in H; discriminate.
+  intros x' l'; simpl; case (X.compare x); intros; auto; try discriminate.
+  elim (Hrec l' H a); intuition; inversion_clear H2; auto.
+  constructor; apply X.eq_trans with x; auto.
+  constructor; apply X.eq_trans with x'; auto.
+  Qed.  
+  
+  Lemma subset_1 :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'),
+   Subset s s' -> subset s s' = true.
+  Proof.
+  intros s s'; generalize s' s; clear s s'.
+  simple induction s'; unfold Subset.
+  intro s; case s; auto.
+  intros; elim (H e); intros; assert (A : In e nil); auto; inversion A. 
+  intros x' l' Hrec s; case s.
+  simpl; auto.
+  intros x l Hs Hs'; inversion Hs; inversion Hs'; subst.
+  simpl; case (X.compare x); intros; auto.
+
+  assert (A : In x (x' :: l')); auto; inversion_clear A.
+  order.
+  generalize (Sort_Inf_In H5 H6 H0); order.
+  
+  apply Hrec; intuition.
+  assert (A : In a (x' :: l')); auto; inversion_clear A; auto.
+  generalize (Sort_Inf_In H1 H2 H0); order.
+
+  apply Hrec; intuition.
+  assert (A : In a (x' :: l')); auto; inversion_clear A; auto.
+  inversion_clear H0. 
+  order.
+  generalize (Sort_Inf_In H1 H2 H4); order.
+  Qed.
+
+  Lemma subset_2 : forall s s' : t, subset s s' = true -> Subset s s'.
+  Proof.
+  intros s s'; generalize s' s; clear s s'.
+  simple induction s'; unfold Subset.
+  intro s; case s; auto.
+  simpl; intros; discriminate H.
+  intros x' l' Hrec s; case s.
+  intros; inversion H0.
+  intros x l; simpl; case (X.compare x); intros; auto.
+  discriminate H.  
+  inversion_clear H0.
+  constructor; apply X.eq_trans with x; auto.
+  constructor 2; apply Hrec with l; auto.
+  constructor 2; apply Hrec with (x::l); auto.
+  Qed.  
+  
+  Lemma empty_sort : Sort empty.
+  Proof.
+  unfold empty; constructor.
+  Qed.
+
+  Lemma empty_1 : Empty empty.
+  Proof.
+  unfold Empty, empty; intuition; inversion H.
+  Qed. 
+
+  Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true.
+  Proof.
+  unfold Empty; intro s; case s; simpl; intuition.
+  elim (H e); auto.
+  Qed.
+  
+  Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. 
+  Proof.
+  unfold Empty; intro s; case s; simpl; intuition;
+   inversion H0.
+  Qed.
+
+  Lemma elements_1 : forall (s : t) (x : elt), In x s -> In x (elements s).
+  Proof.
+  unfold elements; auto.
+  Qed.
+
+  Lemma elements_2 : forall (s : t) (x : elt), In x (elements s) -> In x s.
+  Proof. 
+  unfold elements; auto.
+  Qed.
+ 
+  Lemma elements_3 : forall (s : t) (Hs : Sort s), Sort (elements s).  
+  Proof. 
+  unfold elements; auto.
+  Qed.
+
+  Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. 
+  Proof.
+  intro s; case s; simpl; intros; inversion H; auto.
+  Qed.  
+
+  Lemma min_elt_2 :
+   forall (s : t) (Hs : Sort s) (x y : elt),
+   min_elt s = Some x -> In y s -> ~ X.lt y x. 
+  Proof.
+  simple induction s; simpl.
+  intros; inversion H.
+  intros a l; case l; intros; inversion H0; inversion_clear H1; subst. 
+  order.
+  inversion H2.
+  order.
+  inversion_clear Hs.
+  inversion_clear H3.
+  generalize (H H1 e y (refl_equal (Some e)) H2); order.
+  Qed. 
+
+  Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s.
+  Proof.
+  unfold Empty; intro s; case s; simpl; intuition;
+   inversion H; inversion H0.
+  Qed.
+
+  Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. 
+  Proof. 
+  simple induction s; simpl.
+  intros; inversion H.
+  intros x l; case l; simpl.
+  intuition.
+  inversion H0; auto.
+  intros.
+  constructor 2; apply (H _ H0).
+  Qed.
+ 
+  Lemma max_elt_2 :
+   forall (s : t) (Hs : Sort s) (x y : elt),
+   max_elt s = Some x -> In y s -> ~ X.lt x y. 
+  Proof.
+  simple induction s; simpl.
+  intros; inversion H.
+  intros x l; case l; simpl.
+  intuition.
+  inversion H0; subst.
+  inversion_clear H1.
+  order.
+  inversion H3.
+  intros; inversion_clear Hs; inversion_clear H3; inversion_clear H1.
+  assert (In e (e::l0)) by auto.
+  generalize (H H2 x0 e H0 H1); order.
+  generalize (H H2 x0 y H0 H3); order.
+  Qed. 
+
+  Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s.
+  Proof.
+  unfold Empty; simple induction s; simpl.
+  red; intros; inversion H0.
+  intros x l; case l; simpl; intros.
+  inversion H0.
+  elim (H H0 e); auto.
+  Qed.
+
+  Definition choose_1 :
+    forall (s : t) (x : elt), choose s = Some x -> In x s := min_elt_1.
+
+  Definition choose_2 : forall s : t, choose s = None -> Empty s := min_elt_3.
+
+  Lemma fold_1 :
+   forall (s : t) (Hs : Sort s) (A : Set) (i : A) (f : elt -> A -> A),
+   fold f s i = fold_left (fun a e => f e a) (elements s) i.
+  Proof.
+  induction s.
+  simpl; trivial.
+  intros.
+  inversion_clear Hs.
+  simpl; auto.
+  Qed.
+
+  Lemma cardinal_1 :
+   forall (s : t) (Hs : Sort s),
+   cardinal s = length (elements s).
+  Proof.
+  auto.
+  Qed.
+
+  Lemma filter_Inf :
+   forall (s : t) (Hs : Sort s) (x : elt) (f : elt -> bool),
+   Inf x s -> Inf x (filter f s).
+  Proof.
+  simple induction s; simpl.
+  intuition.  
+  intros x l Hrec Hs a f Ha; inversion_clear Hs; inversion_clear Ha.
+  case (f x). 
+  constructor; auto.
+  apply Hrec; auto.
+  apply Inf_lt with x; auto.
+  Qed.
+
+  Lemma filter_sort :
+   forall (s : t) (Hs : Sort s) (f : elt -> bool), Sort (filter f s).
+  Proof.
+  simple induction s; simpl.
+  auto.
+  intros x l Hrec Hs f; inversion_clear Hs.
+  case (f x); auto.
+  constructor; auto.
+  apply filter_Inf; auto. 
+  Qed.
+
+  Lemma filter_1 :
+   forall (s : t) (x : elt) (f : elt -> bool),
+   compat_bool X.eq f -> In x (filter f s) -> In x s.
+  Proof.
+  simple induction s; simpl.
+  intros; inversion H0.
+  intros x l Hrec a f Hf.
+  case (f x); simpl.
+  inversion_clear 1.
+  constructor; auto.
+  constructor 2; apply (Hrec a f Hf); trivial.
+  constructor 2; apply (Hrec a f Hf); trivial.
+  Qed.
+
+   Lemma filter_2 :
+    forall (s : t) (x : elt) (f : elt -> bool),
+    compat_bool X.eq f -> In x (filter f s) -> f x = true.   
+   Proof.
+  simple induction s; simpl.
+  intros; inversion H0.
+  intros x l Hrec a f Hf.
+  generalize (Hf x); case (f x); simpl; auto.
+  inversion_clear 2; auto.
+  symmetry; auto.
+  Qed.
+ 
+  Lemma filter_3 :
+   forall (s : t) (x : elt) (f : elt -> bool),
+   compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s).     
+  Proof.
+  simple induction s; simpl.
+  intros; inversion H0.
+  intros x l Hrec a f Hf.
+  generalize (Hf x); case (f x); simpl.
+  inversion_clear 2; auto.
+  inversion_clear 2; auto.
+  rewrite <- (H a (X.eq_sym H1)); intros; discriminate.
+  Qed.
+
+  Lemma for_all_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f ->
+   For_all (fun x => f x = true) s -> for_all f s = true.
+  Proof. 
+  simple induction s; simpl; auto; unfold For_all.
+  intros x l Hrec f Hf. 
+  generalize (Hf x); case (f x); simpl.
+  auto.
+  intros; rewrite (H x); auto.
+  Qed.
+
+  Lemma for_all_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f ->
+   for_all f s = true -> For_all (fun x => f x = true) s.
+  Proof. 
+  simple induction s; simpl; auto; unfold For_all.
+  intros; inversion H1.
+  intros x l Hrec f Hf. 
+  intros A a; intros. 
+  assert (f x = true).
+   generalize A; case (f x); auto.
+  rewrite H0 in A; simpl in A.
+  inversion_clear H; auto.
+  rewrite (Hf a x); auto.
+  Qed.
+
+  Lemma exists_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true.
+  Proof.
+  simple induction s; simpl; auto; unfold Exists.
+  intros.
+  elim H0; intuition. 
+  inversion H2.
+  intros x l Hrec f Hf. 
+  generalize (Hf x); case (f x); simpl.
+  auto.
+  destruct 2 as [a (A1,A2)].
+  inversion_clear A1.
+  rewrite <- (H a (X.eq_sym H0)) in A2; discriminate.
+  apply Hrec; auto.
+  exists a; auto.
+  Qed.
+
+  Lemma exists_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s.
+  Proof. 
+  simple induction s; simpl; auto; unfold Exists.
+  intros; discriminate.
+  intros x l Hrec f Hf.
+  case_eq (f x); intros.
+  exists x; auto.
+  destruct (Hrec f Hf H0) as [a (A1,A2)].
+  exists a; auto.
+  Qed.
+
+  Lemma partition_Inf_1 :
+   forall (s : t) (Hs : Sort s) (f : elt -> bool) (x : elt),
+   Inf x s -> Inf x (fst (partition f s)).
+  Proof.
+  simple induction s; simpl.
+  intuition.  
+  intros x l Hrec Hs f a Ha; inversion_clear Hs; inversion_clear Ha.
+  generalize (Hrec H f a).
+  case (f x); case (partition f l); simpl.
+  auto.
+  intros; apply H2; apply Inf_lt with x; auto.
+  Qed.
+
+  Lemma partition_Inf_2 :
+   forall (s : t) (Hs : Sort s) (f : elt -> bool) (x : elt),
+   Inf x s -> Inf x (snd (partition f s)).
+  Proof.
+  simple induction s; simpl.
+  intuition.  
+  intros x l Hrec Hs f a Ha; inversion_clear Hs; inversion_clear Ha.
+  generalize (Hrec H f a).
+  case (f x); case (partition f l); simpl.
+  intros; apply H2; apply Inf_lt with x; auto.
+  auto.
+  Qed.
+
+  Lemma partition_sort_1 :
+   forall (s : t) (Hs : Sort s) (f : elt -> bool), Sort (fst (partition f s)).
+  Proof.
+  simple induction s; simpl.
+  auto.
+  intros x l Hrec Hs f; inversion_clear Hs.
+  generalize (Hrec H f); generalize (partition_Inf_1 H f).
+  case (f x); case (partition f l); simpl; auto.
+  Qed.
+  
+  Lemma partition_sort_2 :
+   forall (s : t) (Hs : Sort s) (f : elt -> bool), Sort (snd (partition f s)).
+  Proof.
+  simple induction s; simpl.
+  auto.
+  intros x l Hrec Hs f; inversion_clear Hs.
+  generalize (Hrec H f); generalize (partition_Inf_2 H f).
+  case (f x); case (partition f l); simpl; auto.
+  Qed.
+
+  Lemma partition_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f -> Equal (fst (partition f s)) (filter f s).
+  Proof.
+  simple induction s; simpl; auto; unfold Equal.
+  split; auto.
+  intros x l Hrec f Hf.
+  generalize (Hrec f Hf); clear Hrec.
+  destruct (partition f l) as [s1 s2]; simpl; intros.
+  case (f x); simpl; auto.
+  split; inversion_clear 1; auto.
+  constructor 2; rewrite <- H; auto.
+  constructor 2; rewrite H; auto.
+  Qed.
+   
+  Lemma partition_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f ->
+   Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
+  Proof.
+  simple induction s; simpl; auto; unfold Equal.
+  split; auto.
+  intros x l Hrec f Hf. 
+  generalize (Hrec f Hf); clear Hrec.
+  destruct (partition f l) as [s1 s2]; simpl; intros.
+  case (f x); simpl; auto.
+  split; inversion_clear 1; auto.
+  constructor 2; rewrite <- H; auto.
+  constructor 2; rewrite H; auto.
+  Qed.
+ 
+  Definition eq : t -> t -> Prop := Equal.
+
+  Lemma eq_refl : forall s : t, eq s s. 
+  Proof. 
+  unfold eq, Equal; intuition.
+  Qed.
+
+  Lemma eq_sym : forall s s' : t, eq s s' -> eq s' s.
+  Proof. 
+  unfold eq, Equal; intros; destruct (H a); intuition.
+  Qed.
+
+  Lemma eq_trans : forall s s' s'' : t, eq s s' -> eq s' s'' -> eq s s''.
+  Proof. 
+  unfold eq, Equal; intros; destruct (H a); destruct (H0 a); intuition.
+  Qed.
+
+  Inductive lt : t -> t -> Prop :=
+    | lt_nil : forall (x : elt) (s : t), lt nil (x :: s)
+    | lt_cons_lt :
+        forall (x y : elt) (s s' : t), X.lt x y -> lt (x :: s) (y :: s')
+    | lt_cons_eq :
+        forall (x y : elt) (s s' : t),
+        X.eq x y -> lt s s' -> lt (x :: s) (y :: s').
+  Hint Constructors lt.
+   
+  Lemma lt_trans : forall s s' s'' : t, lt s s' -> lt s' s'' -> lt s s''.
+  Proof. 
+  intros s s' s'' H; generalize s''; clear s''; elim H.
+  intros x l s'' H'; inversion_clear H'; auto.
+  intros x x' l l' E s'' H'; inversion_clear H'; auto. 
+  constructor; apply X.lt_trans with x'; auto.
+  constructor; apply lt_eq with x'; auto.
+  intros.
+  inversion_clear H3.
+  constructor; apply eq_lt with y; auto.
+  constructor 3; auto; apply X.eq_trans with y; auto.  
+  Qed. 
+
+  Lemma lt_not_eq :
+   forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), lt s s' -> ~ eq s s'.
+  Proof. 
+  unfold eq, Equal. 
+  intros s s' Hs Hs' H; generalize Hs Hs'; clear Hs Hs'; elim H; intros; intro.
+  elim (H0 x); intros.
+  assert (X : In x nil); auto; inversion X.
+  inversion_clear Hs; inversion_clear Hs'.
+  elim (H1 x); intros. 
+  assert (X : In x (y :: s'0)); auto; inversion_clear X.
+  order.
+  generalize (Sort_Inf_In H4 H5 H8); order.
+  inversion_clear Hs; inversion_clear Hs'.
+  elim H2; auto; split; intros.
+  generalize (Sort_Inf_In H4 H5 H8); intros.
+  elim (H3 a); intros.
+  assert (X : In a (y :: s'0)); auto; inversion_clear X; auto.
+  order.
+  generalize (Sort_Inf_In H6 H7 H8); intros.
+  elim (H3 a); intros.
+  assert (X : In a (x :: s0)); auto; inversion_clear X; auto.
+  order.
+  Qed.
+
+  Definition compare :
+    forall (s s' : t) (Hs : Sort s) (Hs' : Sort s'), Compare lt eq s s'.
+  Proof.
+  simple induction s.
+  intros; case s'. 
+  constructor 2; apply eq_refl. 
+  constructor 1; auto.
+  intros a l Hrec s'; case s'.
+  constructor 3; auto.
+  intros a' l' Hs Hs'.
+  case (X.compare a a'); [ constructor 1 | idtac | constructor 3 ]; auto.
+  elim (Hrec l');
+   [ constructor 1
+   | constructor 2
+   | constructor 3
+   | inversion Hs
+   | inversion Hs' ]; auto.
+  generalize e; unfold eq, Equal; intuition; inversion_clear H.
+  constructor; apply X.eq_trans with a; auto.
+  destruct (e1 a0); auto.
+  constructor; apply X.eq_trans with a'; auto.
+  destruct (e1 a0); auto.
+  Defined.
+
+End Raw.
+
+(** * Encapsulation
+
+   Now, in order to really provide a functor implementing [S], we 
+   need to encapsulate everything into a type of strictly ordered lists. *)
+
+Module Make (X: OrderedType) <: S with Module E := X.
+
+ Module E := X.
+ Module Raw := Raw X. 
+
+ Record slist : Set :=  {this :> Raw.t; sorted : sort X.lt this}.
+ Definition t := slist. 
+ Definition elt := X.t.
+ 
+ Definition In (x : elt) (s : t) := InA X.eq x s.(this).
+ Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+ Definition Subset s s' := forall a : elt, In a s -> In a s'.
+ Definition Empty s := forall a : elt, ~ In a s.
+ Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
+ Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x.
+  
+ Definition In_1 (s : t) := Raw.MX.In_eq (l:=s.(this)).
+ 
+ Definition mem (x : elt) (s : t) := Raw.mem x s.
+ Definition mem_1 (s : t) := Raw.mem_1 (sorted s). 
+ Definition mem_2 (s : t) := Raw.mem_2 (s:=s).
+
+ Definition add x s := Build_slist (Raw.add_sort (sorted s) x).
+ Definition add_1 (s : t) := Raw.add_1 (sorted s).
+ Definition add_2 (s : t) := Raw.add_2 (sorted s).
+ Definition add_3 (s : t) := Raw.add_3 (sorted s).
+
+ Definition remove x s := Build_slist (Raw.remove_sort (sorted s) x).
+ Definition remove_1 (s : t) := Raw.remove_1 (sorted s).
+ Definition remove_2 (s : t) := Raw.remove_2 (sorted s).
+ Definition remove_3 (s : t) := Raw.remove_3 (sorted s).
+ 
+ Definition singleton x := Build_slist (Raw.singleton_sort x).
+ Definition singleton_1 := Raw.singleton_1.
+ Definition singleton_2 := Raw.singleton_2.
+  
+ Definition union (s s' : t) :=
+   Build_slist (Raw.union_sort (sorted s) (sorted s')). 
+ Definition union_1 (s s' : t) := Raw.union_1 (sorted s) (sorted s').
+ Definition union_2 (s s' : t) := Raw.union_2 (sorted s) (sorted s').
+ Definition union_3 (s s' : t) := Raw.union_3 (sorted s) (sorted s').
+
+ Definition inter (s s' : t) :=
+   Build_slist (Raw.inter_sort (sorted s) (sorted s')). 
+ Definition inter_1 (s s' : t) := Raw.inter_1 (sorted s) (sorted s').
+ Definition inter_2 (s s' : t) := Raw.inter_2 (sorted s) (sorted s').
+ Definition inter_3 (s s' : t) := Raw.inter_3 (sorted s) (sorted s').
+ 
+ Definition diff (s s' : t) :=
+   Build_slist (Raw.diff_sort (sorted s) (sorted s')). 
+ Definition diff_1 (s s' : t) := Raw.diff_1 (sorted s) (sorted s').
+ Definition diff_2 (s s' : t) := Raw.diff_2 (sorted s) (sorted s').
+ Definition diff_3 (s s' : t) := Raw.diff_3 (sorted s) (sorted s').
+ 
+ Definition equal (s s' : t) := Raw.equal s s'. 
+ Definition equal_1 (s s' : t) := Raw.equal_1 (sorted s) (sorted s').  
+ Definition equal_2 (s s' : t) := Raw.equal_2 (s:=s) (s':=s').
+ 
+ Definition subset (s s' : t) := Raw.subset s s'.
+ Definition subset_1 (s s' : t) := Raw.subset_1 (sorted s) (sorted s').  
+ Definition subset_2 (s s' : t) := Raw.subset_2 (s:=s) (s':=s').
+
+ Definition empty := Build_slist Raw.empty_sort.
+ Definition empty_1 := Raw.empty_1.
+ 
+ Definition is_empty (s : t) := Raw.is_empty s.
+ Definition is_empty_1 (s : t) := Raw.is_empty_1 (s:=s).
+ Definition is_empty_2 (s : t) := Raw.is_empty_2 (s:=s).
+
+ Definition elements (s : t) := Raw.elements s.
+ Definition elements_1 (s : t) := Raw.elements_1 (s:=s).
+ Definition elements_2 (s : t) := Raw.elements_2 (s:=s).
+ Definition elements_3 (s : t) := Raw.elements_3 (sorted s).
+ 
+ Definition min_elt (s : t) := Raw.min_elt s.
+ Definition min_elt_1 (s : t) := Raw.min_elt_1 (s:=s).
+ Definition min_elt_2 (s : t) := Raw.min_elt_2 (sorted s).
+ Definition min_elt_3 (s : t) := Raw.min_elt_3 (s:=s).
+
+ Definition max_elt (s : t) := Raw.max_elt s.
+ Definition max_elt_1 (s : t) := Raw.max_elt_1 (s:=s).
+ Definition max_elt_2 (s : t) := Raw.max_elt_2 (sorted s).
+ Definition max_elt_3 (s : t) := Raw.max_elt_3 (s:=s).
+  
+ Definition choose := min_elt.
+ Definition choose_1 := min_elt_1.
+ Definition choose_2 := min_elt_3.
+ 
+ Definition fold (B : Set) (f : elt -> B -> B) (s : t) := Raw.fold (B:=B) f s. 
+ Definition fold_1 (s : t) := Raw.fold_1 (sorted s). 
+ 
+ Definition cardinal (s : t) := Raw.cardinal s.
+ Definition cardinal_1 (s : t) := Raw.cardinal_1 (sorted s). 
+ 
+ Definition filter (f : elt -> bool) (s : t) :=
+   Build_slist (Raw.filter_sort (sorted s) f).
+ Definition filter_1 (s : t) := Raw.filter_1 (s:=s).
+ Definition filter_2 (s : t) := Raw.filter_2 (s:=s).
+ Definition filter_3 (s : t) := Raw.filter_3 (s:=s).
+ 
+ Definition for_all (f : elt -> bool) (s : t) := Raw.for_all f s.
+ Definition for_all_1 (s : t) := Raw.for_all_1 (s:=s). 
+ Definition for_all_2 (s : t) := Raw.for_all_2 (s:=s). 
+
+ Definition exists_ (f : elt -> bool) (s : t) := Raw.exists_ f s.
+ Definition exists_1 (s : t) := Raw.exists_1 (s:=s). 
+ Definition exists_2 (s : t) := Raw.exists_2 (s:=s). 
+
+ Definition partition (f : elt -> bool) (s : t) :=
+   let p := Raw.partition f s in
+   (Build_slist (this:=fst p) (Raw.partition_sort_1 (sorted s) f),
+   Build_slist (this:=snd p) (Raw.partition_sort_2 (sorted s) f)).
+ Definition partition_1 (s : t) := Raw.partition_1 s.
+ Definition partition_2 (s : t) := Raw.partition_2 s. 
+
+ Definition eq (s s' : t) := Raw.eq s s'.
+ Definition eq_refl (s : t) := Raw.eq_refl s.
+ Definition eq_sym (s s' : t) := Raw.eq_sym (s:=s) (s':=s').
+ Definition eq_trans (s s' s'' : t) :=
+   Raw.eq_trans (s:=s) (s':=s') (s'':=s'').
+  
+ Definition lt (s s' : t) := Raw.lt s s'.
+ Definition lt_trans (s s' s'' : t) :=
+   Raw.lt_trans (s:=s) (s':=s') (s'':=s'').
+ Definition lt_not_eq (s s' : t) := Raw.lt_not_eq (sorted s) (sorted s').
+
+ Definition compare : forall s s' : t, Compare lt eq s s'.
+ Proof.
+ intros; elim (Raw.compare (sorted s) (sorted s'));
+  [ constructor 1 | constructor 2 | constructor 3 ]; 
+  auto. 
+ Defined.
+
+End Make.
diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v
new file mode 100644
index 00000000..23843084
--- /dev/null
+++ b/theories/FSets/FSetProperties.v
@@ -0,0 +1,1007 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetProperties.v 8639 2006-03-16 19:21:55Z letouzey $ *)
+
+(** * Finite sets library *)
+
+(** This functor derives additional properties from [FSetInterface.S].
+    Contrary to the functor in [FSetEqProperties] it uses 
+    predicates over sets instead of sets operations, i.e.
+    [In x s] instead of [mem x s=true], 
+    [Equal s s'] instead of [equal s s'=true], etc. *)
+
+Require Export FSetInterface. 
+Require Import FSetFacts.
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+Section Misc.
+Variable A B : Set.
+Variable eqA : A -> A -> Prop. 
+Variable eqB : B -> B -> Prop.
+
+(** Two-argument functions that allow to reorder its arguments. *)
+Definition transpose (f : A -> B -> B) :=
+  forall (x y : A) (z : B), eqB (f x (f y z)) (f y (f x z)). 
+
+(** Compatibility of a two-argument function with respect to two equalities. *)
+Definition compat_op (f : A -> B -> B) :=
+  forall (x x' : A) (y y' : B), eqA x x' -> eqB y y' -> eqB (f x y) (f x' y').
+
+(** Compatibility of a function upon natural numbers. *)
+Definition compat_nat (f : A -> nat) :=
+  forall x x' : A, eqA x x' -> f x = f x'.
+
+End Misc.
+Hint Unfold transpose compat_op compat_nat.
+
+Hint Extern 1 (Setoid_Theory _ _) => constructor; congruence.
+
+Ltac trans_st x := match goal with 
+  | 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.
+
+Ltac refl_st := match goal with 
+  | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => 
+     apply (Seq_refl _ _ H); auto
+ end.
+
+Definition gen_st : forall A : Set, Setoid_Theory _ (@eq A).
+Proof. auto. Qed.
+
+Module Properties (M: S).
+  Module ME := OrderedTypeFacts M.E.  
+  Import ME.
+  Import M.
+  Import Logic. (* to unmask [eq] *)  
+  Import Peano. (* to unmask [lt] *)
+  
+   (** Results about lists without duplicates *)
+
+  Module FM := Facts M.
+  Import FM.
+
+  Definition Add (x : elt) (s s' : t) :=
+    forall y : elt, In y s' <-> E.eq x y \/ In y s.
+
+  Lemma In_dec : forall x s, {In x s} + {~ In x s}.
+  Proof.
+  intros; generalize (mem_iff s x); case (mem x s); intuition.
+  Qed.
+
+  Section BasicProperties.
+  Variable s s' s'' s1 s2 s3 : t.
+  Variable x : elt.
+
+  (** properties of [Equal] *)
+
+  Lemma equal_refl : s[=]s.
+  Proof.
+  apply eq_refl.
+  Qed.
+
+  Lemma equal_sym : s[=]s' -> s'[=]s.
+  Proof.
+  apply eq_sym. 
+  Qed.
+
+  Lemma equal_trans : s1[=]s2 -> s2[=]s3 -> s1[=]s3.
+  Proof.
+  intros; apply eq_trans with s2; auto.
+  Qed.
+
+  (** properties of [Subset] *)
+  
+  Lemma subset_refl : s[<=]s. 
+  Proof.
+  unfold Subset; intuition.
+  Qed.
+
+  Lemma subset_antisym : s[<=]s' -> s'[<=]s -> s[=]s'.
+  Proof.
+  unfold Subset, Equal; intuition.
+  Qed.
+
+  Lemma subset_trans : s1[<=]s2 -> s2[<=]s3 -> s1[<=]s3.
+  Proof.
+  unfold Subset; intuition.
+  Qed.
+
+  Lemma subset_equal : s[=]s' -> s[<=]s'.
+  Proof.
+  unfold Subset, Equal; firstorder.
+  Qed.
+
+  Lemma subset_empty : empty[<=]s.
+  Proof.
+  unfold Subset; intros a; set_iff; intuition.
+  Qed.
+
+  Lemma subset_remove_3 : s1[<=]s2 -> remove x s1 [<=] s2.
+  Proof.
+  unfold Subset; intros H a; set_iff; intuition.
+  Qed.
+
+  Lemma subset_diff : s1[<=]s3 -> diff s1 s2 [<=] s3.
+  Proof.
+  unfold Subset; intros H a; set_iff; intuition.
+  Qed.
+
+  Lemma subset_add_3 : In x s2 -> s1[<=]s2 -> add x s1 [<=] s2.
+  Proof.
+  unfold Subset; intros H H0 a; set_iff; intuition.
+  rewrite <- H2; auto.
+  Qed.
+
+  Lemma subset_add_2 : s1[<=]s2 -> s1[<=] add x s2.
+  Proof.
+  unfold Subset; intuition.
+  Qed.
+
+  Lemma in_subset : In x s1 -> s1[<=]s2 -> In x s2.
+  Proof.
+  unfold Subset; intuition.
+  Qed.
+
+  (** properties of [empty] *)
+
+  Lemma empty_is_empty_1 : Empty s -> s[=]empty.
+  Proof.
+  unfold Empty, Equal; intros; generalize (H a); set_iff; tauto.
+  Qed.
+
+  Lemma empty_is_empty_2 : s[=]empty -> Empty s.
+  Proof.
+  unfold Empty, Equal; intros; generalize (H a); set_iff; tauto.
+  Qed.
+
+  (** properties of [add] *)
+
+  Lemma add_equal : In x s -> add x s [=] s.
+  Proof.
+  unfold Equal; intros; set_iff; intuition.
+  rewrite <- H1; auto.
+  Qed.
+
+  (** properties of [remove] *)
+
+  Lemma remove_equal : ~ In x s -> remove x s [=] s.
+  Proof.
+  unfold Equal; intros; set_iff; intuition.
+  rewrite H1 in H; auto.
+  Qed.
+
+  Lemma Equal_remove : s[=]s' -> remove x s [=] remove x s'.
+  Proof.
+  intros; rewrite H; apply eq_refl.
+  Qed.
+
+  (** properties of [add] and [remove] *)
+
+  Lemma add_remove : In x s -> add x (remove x s) [=] s.
+  Proof.
+  unfold Equal; intros; set_iff; elim (eq_dec x a); intuition.
+  rewrite <- H1; auto.
+  Qed.
+
+  Lemma remove_add : ~In x s -> remove x (add x s) [=] s.
+  Proof.
+  unfold Equal; intros; set_iff; elim (eq_dec x a); intuition.
+  rewrite H1 in H; auto.
+  Qed.
+
+  (** properties of [singleton] *)
+
+  Lemma singleton_equal_add : singleton x [=] add x empty.
+  Proof.
+  unfold Equal; intros; set_iff; intuition.
+  Qed.
+
+  (** properties of [union] *)
+
+  Lemma union_sym : union s s' [=] union s' s.
+  Proof.
+  unfold Equal; intros; set_iff; tauto.
+  Qed.
+
+  Lemma union_subset_equal : s[<=]s' -> union s s' [=] s'.
+  Proof.
+  unfold Subset, Equal; intros; set_iff; intuition.
+  Qed.
+
+  Lemma union_equal_1 : s[=]s' -> union s s'' [=] union s' s''.
+  Proof.
+  intros; rewrite H; apply eq_refl.
+  Qed.
+
+  Lemma union_equal_2 : s'[=]s'' -> union s s' [=] union s s''.
+  Proof.
+  intros; rewrite H; apply eq_refl.
+  Qed.
+
+  Lemma union_assoc : union (union s s') s'' [=] union s (union s' s'').
+  Proof.
+  unfold Equal; intros; set_iff; tauto.
+  Qed.
+
+  Lemma add_union_singleton : add x s [=] union (singleton x) s.
+  Proof.
+  unfold Equal; intros; set_iff; tauto.
+  Qed.
+
+  Lemma union_add : union (add x s) s' [=] add x (union s s').
+  Proof.
+  unfold Equal; intros; set_iff; tauto.
+  Qed.
+
+  Lemma union_subset_1 : s [<=] union s s'.
+  Proof.
+  unfold Subset; intuition.
+  Qed.
+
+  Lemma union_subset_2 : s' [<=] union s s'.
+  Proof.
+  unfold Subset; intuition.
+  Qed.
+
+  Lemma union_subset_3 : s[<=]s'' -> s'[<=]s'' -> union s s' [<=] s''.
+  Proof.
+  unfold Subset; intros H H0 a; set_iff; intuition.
+  Qed.
+
+  Lemma empty_union_1 : Empty s -> union s s' [=] s'.
+  Proof.
+  unfold Equal, Empty; intros; set_iff; firstorder.
+  Qed.
+
+  Lemma empty_union_2 : Empty s -> union s' s [=] s'.
+  Proof.
+  unfold Equal, Empty; intros; set_iff; firstorder.
+  Qed.
+
+  Lemma not_in_union : ~In x s -> ~In x s' -> ~In x (union s s'). 
+  Proof.
+  intros; set_iff; intuition. 
+  Qed.  
+
+  (** properties of [inter] *)
+
+  Lemma inter_sym : inter s s' [=] inter s' s.
+  Proof.
+  unfold Equal; intros; set_iff; tauto.
+  Qed.
+
+  Lemma inter_subset_equal : s[<=]s' -> inter s s' [=] s.
+  Proof.
+  unfold Equal; intros; set_iff; intuition.
+  Qed.
+
+  Lemma inter_equal_1 : s[=]s' -> inter s s'' [=] inter s' s''.
+  Proof.
+  intros; rewrite H; apply eq_refl.
+  Qed.
+
+  Lemma inter_equal_2 : s'[=]s'' -> inter s s' [=] inter s s''.
+  Proof.
+  intros; rewrite H; apply eq_refl.
+  Qed.
+
+  Lemma inter_assoc : inter (inter s s') s'' [=] inter s (inter s' s'').
+  Proof.
+  unfold Equal; intros; set_iff; tauto.
+  Qed.
+
+  Lemma union_inter_1 : inter (union s s') s'' [=] union (inter s s'') (inter s' s'').
+  Proof.
+  unfold Equal; intros; set_iff; tauto.
+  Qed.
+
+  Lemma union_inter_2 : union (inter s s') s'' [=] inter (union s s'') (union s' s'').
+  Proof.
+  unfold Equal; intros; set_iff; tauto.
+  Qed.
+
+  Lemma inter_add_1 : In x s' -> inter (add x s) s' [=] add x (inter s s').
+  Proof.
+  unfold Equal; intros; set_iff; intuition.
+  rewrite <- H1; auto.
+  Qed.
+
+  Lemma inter_add_2 : ~ In x s' -> inter (add x s) s' [=] inter s s'.
+  Proof.
+  unfold Equal; intros; set_iff; intuition.
+  destruct H; rewrite H0; auto.
+  Qed.
+
+  Lemma empty_inter_1 : Empty s -> Empty (inter s s').
+  Proof.
+  unfold Empty; intros; set_iff; firstorder.
+  Qed.
+
+  Lemma empty_inter_2 : Empty s' -> Empty (inter s s').
+  Proof.
+  unfold Empty; intros; set_iff; firstorder.
+  Qed.
+
+  Lemma inter_subset_1 : inter s s' [<=] s.
+  Proof.
+  unfold Subset; intro a; set_iff; tauto.
+  Qed.
+
+  Lemma inter_subset_2 : inter s s' [<=] s'.
+  Proof.
+  unfold Subset; intro a; set_iff; tauto.
+  Qed.
+
+  Lemma inter_subset_3 :
+   s''[<=]s -> s''[<=]s' -> s''[<=] inter s s'.
+  Proof.
+  unfold Subset; intros H H' a; set_iff; intuition.
+  Qed.
+
+  (** properties of [diff] *)
+
+  Lemma empty_diff_1 : Empty s -> Empty (diff s s'). 
+  Proof.
+  unfold Empty, Equal; intros; set_iff; firstorder.
+  Qed.
+
+  Lemma empty_diff_2 : Empty s -> diff s' s [=] s'.
+  Proof.
+  unfold Empty, Equal; intros; set_iff; firstorder.
+  Qed.
+
+  Lemma diff_subset : diff s s' [<=] s.
+  Proof.
+  unfold Subset; intros a; set_iff; tauto.
+  Qed.
+
+  Lemma diff_subset_equal : s[<=]s' -> diff s s' [=] empty.
+  Proof.
+  unfold Subset, Equal; intros; set_iff; intuition; absurd (In a empty); auto.
+  Qed.
+
+  Lemma remove_diff_singleton :
+   remove x s [=] diff s (singleton x).
+  Proof.
+  unfold Equal; intros; set_iff; intuition.
+  Qed.
+
+  Lemma diff_inter_empty : inter (diff s s') (inter s s') [=] empty. 
+  Proof.
+  unfold Equal; intros; set_iff; intuition; absurd (In a empty); auto.
+  Qed.
+
+  Lemma diff_inter_all : union (diff s s') (inter s s') [=] s.
+  Proof.
+  unfold Equal; intros; set_iff; intuition.
+  elim (In_dec a s'); auto.
+  Qed.
+
+  (** properties of [Add] *)
+
+  Lemma Add_add : Add x s (add x s).
+  Proof.
+   unfold Add; intros; set_iff; intuition.
+  Qed.
+
+  Lemma Add_remove : In x s -> Add x (remove x s) s. 
+  Proof. 
+    unfold Add; intros; set_iff; intuition.
+    elim (eq_dec x y); auto.
+    rewrite <- H1; auto.
+  Qed.
+
+  Lemma union_Add : Add x s s' -> Add x (union s s'') (union s' s'').
+  Proof. 
+  unfold Add; intros; set_iff; rewrite H; tauto.
+  Qed.
+
+  Lemma inter_Add :
+   In x s'' -> Add x s s' -> Add x (inter s s'') (inter s' s'').
+  Proof. 
+  unfold Add; intros; set_iff; rewrite H0; intuition.
+  rewrite <- H2; auto.
+  Qed.  
+
+  Lemma union_Equal :
+   In x s'' -> Add x s s' -> union s s'' [=] union s' s''.
+  Proof. 
+  unfold Add, Equal; intros; set_iff; rewrite H0; intuition. 
+  rewrite <- H1; auto.
+  Qed.  
+
+  Lemma inter_Add_2 :
+   ~In x s'' -> Add x s s' -> inter s s'' [=] inter s' s''.
+  Proof.
+  unfold Add, Equal; intros; set_iff; rewrite H0; intuition.
+  destruct H; rewrite H1; auto.
+  Qed.
+
+  End BasicProperties.
+
+  Hint Immediate equal_sym: set.
+  Hint Resolve equal_refl equal_trans : set.
+
+  Hint Immediate add_remove remove_add union_sym inter_sym: set.
+  Hint Resolve subset_refl subset_equal subset_antisym 
+    subset_trans subset_empty subset_remove_3 subset_diff subset_add_3 
+    subset_add_2 in_subset empty_is_empty_1 empty_is_empty_2 add_equal
+    remove_equal singleton_equal_add union_subset_equal union_equal_1 
+    union_equal_2 union_assoc add_union_singleton union_add union_subset_1 
+    union_subset_2 union_subset_3 inter_subset_equal inter_equal_1 inter_equal_2
+    inter_assoc union_inter_1 union_inter_2 inter_add_1 inter_add_2
+    empty_inter_1 empty_inter_2 empty_union_1 empty_union_2 empty_diff_1 
+    empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union 
+    inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal 
+    remove_diff_singleton diff_inter_empty diff_inter_all Add_add Add_remove
+    Equal_remove : set.
+
+  Notation NoDup := (NoDupA E.eq).
+  Notation EqList := (eqlistA E.eq).
+
+  Section NoDupA_Remove.
+
+  Let ListAdd x l l' := forall y : elt, ME.In y l' <-> E.eq x y \/ ME.In y l.
+
+  Lemma removeA_add :
+    forall s s' x x', NoDup s -> NoDup (x' :: s') ->
+    ~ E.eq x x' -> ~ ME.In x s -> 
+    ListAdd x s (x' :: s') -> ListAdd x (removeA eq_dec x' s) s'.
+  Proof.
+   unfold ListAdd; intros.
+   inversion_clear H0.
+   rewrite removeA_InA; auto; [apply E.eq_trans|].
+   split; intros.
+   destruct (eq_dec x y); auto; intros.
+   right; split; auto.
+   destruct (H3 y); clear H3.
+   destruct H6; intuition.
+   swap H4; apply In_eq with y; auto.
+   destruct H0.
+   assert (ME.In y (x' :: s')) by rewrite H3; auto.
+   inversion_clear H6; auto.
+   elim H1; apply E.eq_trans with y; auto.
+   destruct H0.
+   assert (ME.In y (x' :: s')) by rewrite H3; auto.
+   inversion_clear H7; auto.
+   elim H6; auto.
+  Qed.
+
+  Variables (A:Set)(eqA:A->A->Prop)(st:Setoid_Theory _ eqA).
+  Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f).
+  Variables (i:A).
+
+  Lemma removeA_fold_right_0 :
+    forall s x, NoDup s -> ~ME.In x s ->
+    eqA (fold_right f i s) (fold_right f i (removeA eq_dec x s)).
+  Proof.
+   simple induction s; simpl; intros.
+   refl_st.
+   inversion_clear H0.
+   destruct (eq_dec x a); simpl; intros.
+   absurd_hyp e; auto.
+   apply Comp; auto. 
+  Qed.   
+
+  Lemma removeA_fold_right :
+    forall s x, NoDup s -> ME.In x s ->
+    eqA (fold_right f i s) (f x (fold_right f i (removeA eq_dec x s))).
+  Proof.
+   simple induction s; simpl.  
+   inversion_clear 2.
+   intros.
+   inversion_clear H0.
+   destruct (eq_dec x a); simpl; intros.
+   apply Comp; auto. 
+   apply removeA_fold_right_0; auto.
+   swap H2; apply ME.In_eq with x; auto.
+   inversion_clear H1. 
+   destruct n; auto.
+   trans_st (f a (f x (fold_right f i (removeA eq_dec x l)))).
+  Qed.   
+
+  Lemma fold_right_equal :
+    forall s s', NoDup s -> NoDup s' ->
+    EqList s s' -> eqA (fold_right f i s) (fold_right f i s').
+  Proof.
+   simple induction s.
+   destruct s'; simpl.
+   intros; refl_st; auto.
+   unfold eqlistA; intros.
+   destruct (H1 t0).
+   assert (X : ME.In t0 nil); auto; inversion X.
+   intros x l Hrec s' N N' E; simpl in *.
+   trans_st (f x (fold_right f i (removeA eq_dec x s'))).
+   apply Comp; auto.
+   apply Hrec; auto.
+   inversion N; auto.
+   apply removeA_NoDupA; auto; apply E.eq_trans.
+   apply removeA_eqlistA; auto; [apply E.eq_trans|].
+   inversion_clear N; auto.
+   sym_st.
+   apply removeA_fold_right; auto.
+   unfold eqlistA in E.
+   rewrite <- E; auto.
+  Qed.
+
+  Lemma fold_right_add :
+    forall s' s x, NoDup s -> NoDup s' -> ~ ME.In x s ->
+    ListAdd x s s' -> eqA (fold_right f i s') (f x (fold_right f i s)).
+  Proof.   
+   simple induction s'.
+   unfold ListAdd; intros.
+   destruct (H2 x); clear H2.
+   assert (X : ME.In x nil); auto; inversion X.
+   intros x' l' Hrec s x N N' IN EQ; simpl.
+   (* if x=x' *)
+   destruct (eq_dec x x').
+   apply Comp; auto.
+   apply fold_right_equal; auto.
+   inversion_clear N'; trivial.
+   unfold eqlistA; unfold ListAdd in EQ; intros.
+   destruct (EQ x0); clear EQ.
+   split; intros.
+   destruct H; auto.
+   inversion_clear N'.
+   destruct H2; apply In_eq with x0; auto; order.
+   assert (X:ME.In x0 (x' :: l')); auto; inversion_clear X; auto.
+   destruct IN; apply In_eq with x0; auto; order.
+   (* else x<>x' *)   
+   trans_st (f x' (f x (fold_right f i (removeA eq_dec x' s)))).
+   apply Comp; auto.
+   apply Hrec; auto.
+   apply removeA_NoDupA; auto; apply E.eq_trans.
+   inversion_clear N'; auto.
+   rewrite removeA_InA; auto; [apply E.eq_trans|intuition].
+   apply removeA_add; auto.
+   trans_st (f x (f x' (fold_right f i (removeA eq_dec x' s)))).
+   apply Comp; auto.
+   sym_st.
+   apply removeA_fold_right; auto.
+   destruct (EQ x'). 
+   destruct H; auto; destruct n; auto.
+  Qed.
+
+  End NoDupA_Remove.
+
+  (** * Alternative (weaker) specifications for [fold] *)
+
+  Section Old_Spec_Now_Properties. 
+
+  (** When [FSets] was first designed, the order in which Ocaml's [Set.fold]
+        takes the set elements was unspecified. This specification reflects this fact: 
+  *)
+
+  Lemma fold_0 : 
+      forall s (A : Set) (i : A) (f : elt -> A -> A),
+      exists l : list elt,
+        NoDup l /\
+        (forall x : elt, In x s <-> InA E.eq x l) /\
+        fold f s i = fold_right f i l.
+  Proof.
+  intros; exists (rev (elements s)); split.
+  apply NoDupA_rev; auto.
+  exact E.eq_trans.
+  split; intros.
+  rewrite elements_iff; do 2 rewrite InA_alt.
+  split; destruct 1; generalize (In_rev (elements s) x0); exists x0; intuition.
+  rewrite fold_left_rev_right.
+  apply fold_1.
+  Qed.
+
+  (** An alternate (and previous) specification for [fold] was based on 
+      the recursive structure of a set. It is now lemmas [fold_1] and 
+      [fold_2]. *)
+
+  Lemma fold_1 :
+   forall s (A : Set) (eqA : A -> A -> Prop) 
+     (st : Setoid_Theory A eqA) (i : A) (f : elt -> A -> A),
+   Empty s -> eqA (fold f s i) i.
+  Proof.
+  unfold Empty; intros; destruct (fold_0 s i f) as (l,(H1, (H2, H3))).
+  rewrite H3; clear H3.
+  generalize H H2; clear H H2; case l; simpl; intros.
+  refl_st.
+  elim (H e).
+  elim (H2 e); intuition. 
+  Qed.
+
+  Lemma fold_2 :
+   forall s s' x (A : Set) (eqA : A -> A -> Prop)
+     (st : Setoid_Theory A eqA) (i : A) (f : elt -> A -> A),
+   compat_op E.eq eqA f ->
+   transpose eqA f ->
+   ~ In x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)).
+  Proof.
+  intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); 
+    destruct (fold_0 s' i f) as (l',(Hl', (Hl'1, Hl'2))).
+  rewrite Hl2; rewrite Hl'2; clear Hl2 Hl'2.
+  apply fold_right_add with (eqA := eqA); auto.
+  rewrite <- Hl1; auto.
+  intros; rewrite <- Hl1; rewrite <- Hl'1; auto.
+  Qed.
+
+  (** Similar specifications for [cardinal]. *)
+
+  Lemma cardinal_fold : forall s, cardinal s = fold (fun _ => S) s 0.
+  Proof.
+  intros; rewrite cardinal_1; rewrite M.fold_1.
+  symmetry; apply fold_left_length; auto.
+  Qed.
+
+  Lemma cardinal_0 :
+     forall s, exists l : list elt,
+        NoDupA E.eq l /\
+        (forall x : elt, In x s <-> InA E.eq x l) /\ 
+        cardinal s = length l.
+  Proof. 
+  intros; exists (elements s); intuition; apply cardinal_1.
+  Qed.
+
+  Lemma cardinal_1 : forall s, Empty s -> cardinal s = 0.
+  Proof.
+  intros; rewrite cardinal_fold; apply fold_1; auto.
+  Qed.
+
+  Lemma cardinal_2 :
+    forall s s' x, ~ In x s -> Add x s s' -> cardinal s' = S (cardinal s).
+  Proof.
+  intros; do 2 rewrite cardinal_fold.
+  change S with ((fun _ => S) x).
+  apply fold_2; auto.
+  Qed.
+
+  End Old_Spec_Now_Properties.
+
+  (** * Induction principle over sets *)
+
+  Lemma cardinal_inv_1 : forall s, cardinal s = 0 -> Empty s. 
+  Proof. 
+    intros s; rewrite M.cardinal_1; intros H a; red.
+    rewrite elements_iff.
+    destruct (elements s); simpl in *; discriminate || inversion 1.
+  Qed.
+  Hint Resolve cardinal_inv_1.
+ 
+  Lemma cardinal_inv_2 :
+   forall s n, cardinal s = S n -> { x : elt | In x s }.
+  Proof. 
+    intros; rewrite M.cardinal_1 in H.
+    generalize (elements_2 (s:=s)).
+    destruct (elements s); try discriminate. 
+    exists e; auto.
+  Qed.
+
+  Lemma Equal_cardinal_aux :
+   forall n s s', cardinal s = n -> s[=]s' -> cardinal s = cardinal s'.
+  Proof.
+     simple induction n; intros.
+     rewrite H; symmetry .
+     apply cardinal_1.
+     rewrite <- H0; auto.
+     destruct (cardinal_inv_2 H0) as (x,H2).
+     revert H0.
+     rewrite (cardinal_2 (s:=remove x s) (s':=s) (x:=x)); auto with set.
+     rewrite (cardinal_2 (s:=remove x s') (s':=s') (x:=x)); auto with set.
+     rewrite H1 in H2; auto with set.
+  Qed.
+
+  Lemma Equal_cardinal : forall s s', s[=]s' -> cardinal s = cardinal s'.
+  Proof. 
+    intros; apply Equal_cardinal_aux with (cardinal s); auto.
+  Qed.
+
+  Add Morphism cardinal : cardinal_m.
+  Proof.
+  exact Equal_cardinal.
+  Qed.
+
+  Hint Resolve Add_add Add_remove Equal_remove cardinal_inv_1 Equal_cardinal.
+
+  Lemma cardinal_induction :
+   forall P : t -> Type,
+   (forall s, Empty s -> P s) ->
+   (forall s s', P s -> forall x, ~In x s -> Add x s s' -> P s') ->
+   forall n s, cardinal s = n -> P s.
+  Proof.
+  simple induction n; intros; auto.
+  destruct (cardinal_inv_2 H) as (x,H0). 
+  apply X0 with (remove x s) x; auto.
+  apply X1; auto.
+  rewrite (cardinal_2 (x:=x)(s:=remove x s)(s':=s)) in H; auto.
+  Qed.
+
+  Lemma set_induction :
+   forall P : t -> Type,
+   (forall s : t, Empty s -> P s) ->
+   (forall s s' : t, P s -> forall x : elt, ~In x s -> Add x s s' -> P s') ->
+   forall s : t, P s.
+  Proof.
+  intros; apply cardinal_induction with (cardinal s); auto.
+  Qed.  
+
+  (** Other properties of [fold]. *)
+
+  Section Fold. 
+  Variables (A:Set)(eqA:A->A->Prop)(st:Setoid_Theory _ eqA).
+  Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f).
+
+  Section Fold_1. 
+  Variable i i':A.
+
+  Lemma fold_empty : eqA (fold f empty i) i.
+  Proof. 
+  apply fold_1; auto.
+  Qed.
+
+  Lemma fold_equal : 
+   forall s s', s[=]s' -> eqA (fold f s i) (fold f s' i).
+  Proof. 
+  intros s; pattern s; apply set_induction; clear s; intros.
+  trans_st i.
+  apply fold_1; auto.
+  sym_st; apply fold_1; auto.
+  rewrite <- H0; auto.
+  trans_st (f x (fold f s i)).
+  apply fold_2 with (eqA := eqA); auto.
+  sym_st; apply fold_2 with (eqA := eqA); auto.
+  unfold Add in *; intros.
+  rewrite <- H2; auto.
+  Qed.
+   
+  Lemma fold_add : forall s x, ~In x s -> 
+   eqA (fold f (add x s) i) (f x (fold f s i)).
+  Proof. 
+  intros; apply fold_2 with (eqA := eqA); auto.
+  Qed.
+
+  Lemma add_fold : forall s x, In x s -> 
+   eqA (fold f (add x s) i) (fold f s i).
+  Proof.
+  intros; apply fold_equal; auto with set.
+  Qed.
+
+  Lemma remove_fold_1: forall s x, In x s -> 
+   eqA (f x (fold f (remove x s) i)) (fold f s i).
+  Proof.
+  intros.
+  sym_st.
+  apply fold_2 with (eqA:=eqA); auto.
+  Qed.
+
+  Lemma remove_fold_2: forall s x, ~In x s -> 
+   eqA (fold f (remove x s) i) (fold f s i).
+  Proof.
+  intros.
+  apply fold_equal; auto with set.
+  Qed.
+
+  Lemma fold_commutes : forall s x, 
+   eqA (fold f s (f x i)) (f x (fold f s i)).
+  Proof.
+  intros; pattern s; apply set_induction; clear s; intros.
+  trans_st (f x i).
+  apply fold_1; auto.
+  sym_st.
+  apply Comp; auto.
+  apply fold_1; auto.
+  trans_st (f x0 (fold f s (f x i))).
+  apply fold_2 with (eqA:=eqA); auto.
+  trans_st (f x0 (f x (fold f s i))).
+  trans_st (f x (f x0 (fold f s i))).
+  apply Comp; auto.
+  sym_st.
+  apply fold_2 with (eqA:=eqA); auto.
+  Qed.
+
+  Lemma fold_init : forall s, eqA i i' -> 
+   eqA (fold f s i) (fold f s i').
+  Proof. 
+  intros; pattern s; apply set_induction; clear s; intros.
+  trans_st i.
+  apply fold_1; auto.
+  trans_st i'.
+  sym_st; apply fold_1; auto.
+  trans_st (f x (fold f s i)).
+  apply fold_2 with (eqA:=eqA); auto.
+  trans_st (f x (fold f s i')).
+  sym_st; apply fold_2 with (eqA:=eqA); auto.
+  Qed.
+
+  End Fold_1.
+  Section Fold_2.
+  Variable i:A.
+
+  Lemma fold_union_inter : forall s s',
+   eqA (fold f (union s s') (fold f (inter s s') i))
+       (fold f s (fold f s' i)).
+  Proof.
+  intros; pattern s; apply set_induction; clear s; intros.
+  trans_st (fold f s' (fold f (inter s s') i)).
+  apply fold_equal; auto with set.
+  trans_st (fold f s' i).
+  apply fold_init; auto.
+  apply fold_1; auto with set.
+  sym_st; apply fold_1; auto.
+  rename s'0 into s''.
+  destruct (In_dec x s').
+  (* In x s' *)   
+  trans_st (fold f (union s'' s') (f x (fold f (inter s s') i))); auto with set.
+  apply fold_init; auto.
+  apply fold_2 with (eqA:=eqA); auto with set.
+  rewrite inter_iff; intuition.
+  trans_st (f x (fold f s (fold f s' i))).
+  trans_st (fold f (union s s') (f x (fold f (inter s s') i))).
+  apply fold_equal; auto.
+  apply equal_sym; apply union_Equal with x; auto with set.
+  trans_st (f x (fold f (union s s') (fold f (inter s s') i))).
+  apply fold_commutes; auto.
+  sym_st; apply fold_2 with (eqA:=eqA); auto.
+  (* ~(In x s') *)
+  trans_st (f x (fold f (union s s') (fold f (inter s'' s') i))).
+  apply fold_2 with (eqA:=eqA); auto with set.
+  trans_st (f x (fold f (union s s') (fold f (inter s s') i))).
+  apply Comp;auto.
+  apply fold_init;auto.
+  apply fold_equal;auto.
+  apply equal_sym; apply inter_Add_2 with x; auto with set.
+  trans_st (f x (fold f s (fold f s' i))).
+  sym_st; apply fold_2 with (eqA:=eqA); auto.
+  Qed.
+
+  End Fold_2.
+  Section Fold_3.
+  Variable i:A.
+
+  Lemma fold_diff_inter : forall s s', 
+   eqA (fold f (diff s s') (fold f (inter s s') i)) (fold f s i).
+  Proof.
+  intros.
+  trans_st (fold f (union (diff s s') (inter s s')) 
+              (fold f (inter (diff s s') (inter s s')) i)).
+  sym_st; apply fold_union_inter; auto.
+  trans_st (fold f s (fold f (inter (diff s s') (inter s s')) i)).
+  apply fold_equal; auto with set.
+  apply fold_init; auto.
+  apply fold_1; auto with set.
+  Qed.
+
+  Lemma fold_union: forall s s', (forall x, ~In x s\/~In x s') ->
+   eqA (fold f (union s s') i) (fold f s (fold f s' i)).
+  Proof.
+  intros.
+  trans_st (fold f (union s s') (fold f (inter s s') i)).
+  apply fold_init; auto.
+  sym_st; apply fold_1; auto with set.
+  unfold Empty; intro a; generalize (H a); set_iff; tauto.
+  apply fold_union_inter; auto.
+  Qed.
+
+  End Fold_3.
+  End Fold.
+
+  Lemma fold_plus :
+   forall s p, fold (fun _ => S) s p = fold (fun _ => S) s 0 + p.
+  Proof.
+  assert (st := gen_st nat).
+  assert (fe : compat_op E.eq (@eq _) (fun _ => S)) by unfold compat_op; auto. 
+  assert (fp : transpose (@eq _) (fun _:elt => S)) by unfold transpose; auto.
+  intros s p; pattern s; apply set_induction; clear s; intros.
+  rewrite (fold_1 st p (fun _ => S) H).
+  rewrite (fold_1 st 0 (fun _ => S) H); trivial.
+  assert (forall p s', Add x s s' -> fold (fun _ => S) s' p = S (fold (fun _ => S) s p)).
+   change S with ((fun _ => S) x).  
+   intros; apply fold_2; auto.
+  rewrite H2; auto.
+  rewrite (H2 0); auto.
+  rewrite H.
+  simpl; auto.
+  Qed.
+
+  (** properties of [cardinal] *)
+
+  Lemma empty_cardinal : cardinal empty = 0.
+  Proof.
+  rewrite cardinal_fold; apply fold_1; auto.
+  Qed.
+
+  Hint Immediate empty_cardinal cardinal_1 : set.
+
+  Lemma singleton_cardinal : forall x, cardinal (singleton x) = 1.
+  Proof.
+  intros.
+  rewrite (singleton_equal_add x).
+  replace 0 with (cardinal empty); auto with set.
+  apply cardinal_2 with x; auto with set.
+  Qed.
+
+  Hint Resolve singleton_cardinal: set.
+
+  Lemma diff_inter_cardinal :
+   forall s s', cardinal (diff s s') + cardinal (inter s s') = cardinal s .
+  Proof.
+  intros; do 3 rewrite cardinal_fold.
+  rewrite <- fold_plus.
+  apply fold_diff_inter with (eqA:=@eq nat); auto.
+  Qed.
+
+  Lemma union_cardinal: 
+   forall s s', (forall x, ~In x s\/~In x s') -> 
+   cardinal (union s s')=cardinal s+cardinal s'.
+  Proof.
+  intros; do 3 rewrite cardinal_fold.
+  rewrite <- fold_plus.
+  apply fold_union; auto.
+  Qed.
+
+  Lemma subset_cardinal : 
+   forall s s', s[<=]s' -> cardinal s <= cardinal s' .
+  Proof.
+  intros.
+  rewrite <- (diff_inter_cardinal s' s).
+  rewrite (inter_sym s' s).
+  rewrite (inter_subset_equal H); auto with arith.
+  Qed.
+
+  Lemma union_inter_cardinal :
+   forall s s', cardinal (union s s') + cardinal (inter s s')  = cardinal s  + cardinal s' .
+  Proof.
+  intros.
+  do 4 rewrite cardinal_fold.
+  do 2 rewrite <- fold_plus.
+  apply fold_union_inter with (eqA:=@eq nat); auto.
+  Qed.
+
+  Lemma union_cardinal_le : 
+   forall s s', cardinal (union s s') <= cardinal s  + cardinal s'.
+  Proof.
+   intros; generalize (union_inter_cardinal s s').
+   intros; rewrite <- H; auto with arith.
+  Qed.
+
+  Lemma add_cardinal_1 : 
+   forall s x, In x s -> cardinal (add x s) = cardinal s.
+  Proof.
+  auto with set.  
+  Qed.
+
+  Lemma add_cardinal_2 :
+   forall s x, ~In x s -> cardinal (add x s) = S (cardinal s).
+  Proof.
+  intros.
+  do 2 rewrite cardinal_fold.
+  change S with ((fun _ => S) x);
+   apply fold_add with (eqA:=@eq nat); auto.
+  Qed.
+
+  Lemma remove_cardinal_1 :
+   forall s x, In x s -> S (cardinal (remove x s)) = cardinal s.
+  Proof.
+  intros.
+  do 2 rewrite cardinal_fold.
+  change S with ((fun _ =>S) x).
+  apply remove_fold_1 with (eqA:=@eq nat); auto.
+  Qed.
+
+  Lemma remove_cardinal_2 : 
+   forall s x, ~In x s -> cardinal (remove x s) = cardinal s.
+  Proof. 
+  auto with set.
+  Qed.
+
+  Hint Resolve subset_cardinal union_cardinal add_cardinal_1 add_cardinal_2.
+
+End Properties.
diff --git a/contrib7/ring/Setoid_ring.v b/theories/FSets/FSetWeak.v
index 222104e5..7ed61c9f 100644
--- a/contrib7/ring/Setoid_ring.v
+++ b/theories/FSets/FSetWeak.v
@@ -1,13 +1,14 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
 
-(* $Id: Setoid_ring.v,v 1.1.2.1 2004/07/16 19:30:19 herbelin Exp $ *)
+(* $Id: FSetWeak.v 8641 2006-03-17 09:56:54Z letouzey $ *)
 
-Require Export Setoid_ring_theory.
-Require Export Quote.
-Require Export Setoid_ring_normalize.
+Require Export DecidableType.
+Require Export FSetWeakInterface.
+Require Export FSetFacts.
+Require Export FSetWeakList.
diff --git a/theories/FSets/FSetWeakFacts.v b/theories/FSets/FSetWeakFacts.v
new file mode 100644
index 00000000..46a73cc9
--- /dev/null
+++ b/theories/FSets/FSetWeakFacts.v
@@ -0,0 +1,415 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetWeakFacts.v 8681 2006-04-05 11:56:14Z letouzey $ *)
+
+(** * Finite sets library *)
+
+(** This functor derives additional facts from [FSetInterface.S]. These
+  facts are mainly the specifications of [FSetInterface.S] written using 
+  different styles: equivalence and boolean equalities. 
+  Moreover, we prove that [E.Eq] and [Equal] are setoid equalities.
+*)
+
+Require Export FSetWeakInterface. 
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+Module Facts (M: S).
+Import M.E.
+Import M.
+Import Logic. (* to unmask [eq] *)  
+
+(** * Specifications written using equivalences *)
+
+Section IffSpec. 
+Variable s s' s'' : t.
+Variable x y z : elt.
+
+Lemma In_eq_iff : E.eq x y -> (In x s <-> In y s).
+Proof.
+split; apply In_1; auto.
+Qed.
+
+Lemma mem_iff : In x s <-> mem x s = true.
+Proof.
+split; [apply mem_1|apply mem_2].
+Qed.
+
+Lemma not_mem_iff : ~In x s <-> mem x s = false.
+Proof.
+rewrite mem_iff; destruct (mem x s); intuition.
+Qed.
+
+Lemma equal_iff : s[=]s' <-> equal s s' = true.
+Proof. 
+split; [apply equal_1|apply equal_2].
+Qed.
+
+Lemma subset_iff : s[<=]s' <-> subset s s' = true.
+Proof. 
+split; [apply subset_1|apply subset_2].
+Qed.
+
+Lemma empty_iff : In x empty <-> False.
+Proof.
+intuition; apply (empty_1 H).
+Qed.
+
+Lemma is_empty_iff : Empty s <-> is_empty s = true. 
+Proof. 
+split; [apply is_empty_1|apply is_empty_2].
+Qed.
+
+Lemma singleton_iff : In y (singleton x) <-> E.eq x y.
+Proof.
+split; [apply singleton_1|apply singleton_2].
+Qed.
+
+Lemma add_iff : In y (add x s) <-> E.eq x y \/ In y s.
+Proof. 
+split; [ | destruct 1; [apply add_1|apply add_2]]; auto.
+destruct (eq_dec x y) as [E|E]; auto.
+intro H; right; exact (add_3 E H).
+Qed.
+
+Lemma add_neq_iff : ~ E.eq x y -> (In y (add x s)  <-> In y s).
+Proof.
+split; [apply add_3|apply add_2]; auto.
+Qed.
+
+Lemma remove_iff : In y (remove x s) <-> In y s /\ ~E.eq x y.
+Proof.
+split; [split; [apply remove_3 with x |] | destruct 1; apply remove_2]; auto.
+intro.
+apply (remove_1 H0 H).
+Qed.
+
+Lemma remove_neq_iff : ~ E.eq x y -> (In y (remove x s) <-> In y s).
+Proof.
+split; [apply remove_3|apply remove_2]; auto.
+Qed.
+
+Lemma union_iff : In x (union s s') <-> In x s \/ In x s'.
+Proof.
+split; [apply union_1 | destruct 1; [apply union_2|apply union_3]]; auto.
+Qed.
+
+Lemma inter_iff : In x (inter s s') <-> In x s /\ In x s'.
+Proof.
+split; [split; [apply inter_1 with s' | apply inter_2 with s] | destruct 1; apply inter_3]; auto.
+Qed.
+
+Lemma diff_iff : In x (diff s s') <-> In x s /\ ~ In x s'.
+Proof.
+split; [split; [apply diff_1 with s' | apply diff_2 with s] | destruct 1; apply diff_3]; auto.
+Qed.
+
+Variable f : elt->bool.
+
+Lemma filter_iff :  compat_bool E.eq f -> (In x (filter f s) <-> In x s /\ f x = true).
+Proof. 
+split; [split; [apply filter_1 with f | apply filter_2 with s] | destruct 1; apply filter_3]; auto. 
+Qed.
+
+Lemma for_all_iff : compat_bool E.eq f ->
+  (For_all (fun x => f x = true) s <-> for_all f s = true).
+Proof.
+split; [apply for_all_1 | apply for_all_2]; auto.
+Qed.
+ 
+Lemma exists_iff : compat_bool E.eq f ->
+  (Exists (fun x => f x = true) s <-> exists_ f s = true).
+Proof.
+split; [apply exists_1 | apply exists_2]; auto.
+Qed.
+
+Lemma elements_iff : In x s <-> InA E.eq x (elements s).
+Proof. 
+split; [apply elements_1 | apply elements_2].
+Qed.
+
+End IffSpec.
+
+(** Useful tactic for simplifying expressions like [In y (add x (union s s'))] *)
+  
+Ltac set_iff := 
+ repeat (progress (
+  rewrite add_iff || rewrite remove_iff || rewrite singleton_iff 
+  || rewrite union_iff || rewrite inter_iff || rewrite diff_iff
+  || rewrite empty_iff)).
+
+(**  * Specifications written using boolean predicates *)
+
+Definition eqb x y := if eq_dec x y then true else false.
+
+Section BoolSpec.
+Variable s s' s'' : t.
+Variable x y z : elt.
+
+Lemma mem_b : E.eq x y -> mem x s = mem y s.
+Proof. 
+intros.
+generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H).
+destruct (mem x s); destruct (mem y s); intuition.
+Qed.
+
+Lemma add_b : mem y (add x s) = eqb x y || mem y s.
+Proof.
+generalize (mem_iff (add x s) y)(mem_iff s y)(add_iff s x y); unfold eqb.
+destruct (eq_dec x y); destruct (mem y s); destruct (mem y (add x s)); intuition.
+Qed.
+
+Lemma add_neq_b : ~ E.eq x y -> mem y (add x s) = mem y s.
+Proof.
+intros; generalize (mem_iff (add x s) y)(mem_iff s y)(add_neq_iff s H).
+destruct (mem y s); destruct (mem y (add x s)); intuition.
+Qed.
+
+Lemma remove_b : mem y (remove x s) = mem y s && negb (eqb x y).
+Proof.
+generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_iff s x y); unfold eqb.
+destruct (eq_dec x y); destruct (mem y s); destruct (mem y (remove x s)); simpl; intuition.
+Qed.
+
+Lemma remove_neq_b : ~ E.eq x y -> mem y (remove x s) = mem y s.
+Proof.
+intros; generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_neq_iff s H).
+destruct (mem y s); destruct (mem y (remove x s)); intuition.
+Qed.
+
+Lemma singleton_b : mem y (singleton x) = eqb x y.
+Proof. 
+generalize (mem_iff (singleton x) y)(singleton_iff x y); unfold eqb.
+destruct (eq_dec x y); destruct (mem y (singleton x)); intuition.
+Qed.
+
+Lemma union_b : mem x (union s s') = mem x s || mem x s'.
+Proof.
+generalize (mem_iff (union s s') x)(mem_iff s x)(mem_iff s' x)(union_iff s s' x).
+destruct (mem x s); destruct (mem x s'); destruct (mem x (union s s')); intuition.
+Qed.
+
+Lemma inter_b : mem x (inter s s') = mem x s && mem x s'.
+Proof.
+generalize (mem_iff (inter s s') x)(mem_iff s x)(mem_iff s' x)(inter_iff s s' x).
+destruct (mem x s); destruct (mem x s'); destruct (mem x (inter s s')); intuition.
+Qed.
+
+Lemma diff_b : mem x (diff s s') = mem x s && negb (mem x s').
+Proof.
+generalize (mem_iff (diff s s') x)(mem_iff s x)(mem_iff s' x)(diff_iff s s' x).
+destruct (mem x s); destruct (mem x s'); destruct (mem x (diff s s')); simpl; intuition.
+Qed.
+
+Lemma elements_b : mem x s = existsb (eqb x) (elements s).
+Proof.
+generalize (mem_iff s x)(elements_iff s x)(existsb_exists (eqb x) (elements s)).
+rewrite InA_alt.
+destruct (mem x s); destruct (existsb (eqb x) (elements s)); auto; intros.
+symmetry.
+rewrite H1.
+destruct H0 as (H0,_).
+destruct H0 as (a,(Ha1,Ha2)); [ intuition |].
+exists a; intuition.
+unfold eqb; destruct (eq_dec x a); auto.
+rewrite <- H.
+rewrite H0.
+destruct H1 as (H1,_).
+destruct H1 as (a,(Ha1,Ha2)); [intuition|].
+exists a; intuition.
+unfold eqb in *; destruct (eq_dec x a); auto; discriminate.
+Qed.
+
+Variable f : elt->bool.
+
+Lemma filter_b : compat_bool E.eq f -> mem x (filter f s) = mem x s && f x.
+Proof. 
+intros.
+generalize (mem_iff (filter f s) x)(mem_iff s x)(filter_iff s x H).
+destruct (mem x s); destruct (mem x (filter f s)); destruct (f x); simpl; intuition.
+Qed.
+
+Lemma for_all_b : compat_bool E.eq f ->
+  for_all f s = forallb f (elements s).
+Proof.
+intros.
+generalize (forallb_forall f (elements s))(for_all_iff s H)(elements_iff s).
+unfold For_all.
+destruct (forallb f (elements s)); destruct (for_all f s); auto; intros.
+rewrite <- H1; intros.
+destruct H0 as (H0,_).
+rewrite (H2 x0) in H3.
+rewrite (InA_alt E.eq x0 (elements s)) in H3.
+destruct H3 as (a,(Ha1,Ha2)).
+rewrite (H _ _ Ha1).
+apply H0; auto.
+symmetry.
+rewrite H0; intros.
+destruct H1 as (_,H1).
+apply H1; auto.
+rewrite H2.
+rewrite InA_alt; eauto.
+Qed.
+
+Lemma exists_b : compat_bool E.eq f -> 
+  exists_ f s = existsb f (elements s).
+Proof.
+intros.
+generalize (existsb_exists f (elements s))(exists_iff s H)(elements_iff s).
+unfold Exists.
+destruct (existsb f (elements s)); destruct (exists_ f s); auto; intros.
+rewrite <- H1; intros.
+destruct H0 as (H0,_).
+destruct H0 as (a,(Ha1,Ha2)); auto.
+exists a; auto.
+split; auto.
+rewrite H2; rewrite InA_alt; eauto.
+symmetry.
+rewrite H0.
+destruct H1 as (_,H1).
+destruct H1 as (a,(Ha1,Ha2)); auto.
+rewrite (H2 a) in Ha1.
+rewrite (InA_alt E.eq a (elements s)) in Ha1.
+destruct Ha1 as (b,(Hb1,Hb2)).
+exists b; auto.
+rewrite <- (H _ _ Hb1); auto.
+Qed.
+
+End BoolSpec.
+
+(** * [E.eq] and [Equal] are setoid equalities *)
+
+Definition E_ST : Setoid_Theory elt E.eq.
+Proof.
+constructor; [apply E.eq_refl|apply E.eq_sym|apply E.eq_trans].
+Qed.
+
+Add Setoid elt E.eq E_ST as EltSetoid.
+
+Definition Equal_ST : Setoid_Theory t Equal.
+Proof. 
+constructor; unfold Equal; firstorder.
+Qed.
+
+Add Setoid t Equal Equal_ST as EqualSetoid.
+
+Add Morphism In with signature E.eq ==> Equal ==> iff as In_m.
+Proof.
+unfold Equal; intros x y H s s' H0.
+rewrite (In_eq_iff s H); auto.
+Qed.
+
+Add Morphism is_empty : is_empty_m.
+Proof.
+unfold Equal; intros s s' H.
+generalize (is_empty_iff s)(is_empty_iff s').
+destruct (is_empty s); destruct (is_empty s'); 
+ unfold Empty; auto; intros.
+symmetry.
+rewrite <- H1; intros a Ha.
+rewrite <- (H a) in Ha.
+destruct H0 as (_,H0).
+exact (H0 (refl_equal true) _ Ha).
+rewrite <- H0; intros a Ha.
+rewrite (H a) in Ha.
+destruct H1 as (_,H1).
+exact (H1 (refl_equal true) _ Ha).
+Qed.
+
+Add Morphism Empty with signature Equal ==> iff as Empty_m.
+Proof. 
+intros; do 2 rewrite is_empty_iff; rewrite H; intuition.
+Qed.
+
+Add Morphism mem : mem_m.
+Proof.
+unfold Equal; intros x y H s s' H0.
+generalize (H0 x); clear H0; rewrite (In_eq_iff s' H).
+generalize (mem_iff s x)(mem_iff s' y).
+destruct (mem x s); destruct (mem y s'); intuition.
+Qed.
+
+Add Morphism singleton : singleton_m.
+Proof.
+unfold Equal; intros x y H a.
+do 2 rewrite singleton_iff; split.
+intros; apply E.eq_trans with x; auto.
+intros; apply E.eq_trans with y; auto.
+Qed.
+
+Add Morphism add : add_m.
+Proof.
+unfold Equal; intros x y H s s' H0 a.
+do 2 rewrite add_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism remove : remove_m.
+Proof.
+unfold Equal; intros x y H s s' H0 a.
+do 2 rewrite remove_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism union : union_m.
+Proof.
+unfold Equal; intros s s' H s'' s''' H0 a.
+do 2 rewrite union_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism inter : inter_m.
+Proof.
+unfold Equal; intros s s' H s'' s''' H0 a.
+do 2 rewrite inter_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism diff : diff_m.
+Proof.
+unfold Equal; intros s s' H s'' s''' H0 a.
+do 2 rewrite diff_iff; rewrite H; rewrite H0; intuition.
+Qed.
+
+Add Morphism Subset with signature Equal ==> Equal ==> iff as  Subset_m.
+Proof. 
+unfold Equal, Subset; firstorder.
+Qed.
+
+Add Morphism subset : subset_m.
+Proof.
+intros s s' H s'' s''' H0.
+generalize (subset_iff s s'') (subset_iff s' s'''). 
+destruct (subset s s''); destruct (subset s' s'''); auto; intros.
+rewrite H in H1; rewrite H0 in H1; intuition.
+rewrite H in H1; rewrite H0 in H1; intuition.
+Qed.
+
+Add Morphism equal : equal_m.
+Proof.
+intros s s' H s'' s''' H0.
+generalize (equal_iff s s'') (equal_iff s' s''').
+destruct (equal s s''); destruct (equal s' s'''); auto; intros.
+rewrite H in H1; rewrite H0 in H1; intuition.
+rewrite H in H1; rewrite H0 in H1; intuition.
+Qed.
+
+(* [fold], [filter], [for_all], [exists_] and [partition] cannot be proved morphism
+   without additional hypothesis on [f]. For instance: *)
+
+Lemma filter_equal : forall f, compat_bool E.eq f -> 
+  forall s s', s[=]s' -> filter f s [=] filter f s'.
+Proof.
+unfold Equal; intros; repeat rewrite filter_iff; auto; rewrite H0; tauto.
+Qed.
+
+(* For [elements], [min_elt], [max_elt] and [choose], we would need setoid 
+   structures on [list elt] and [option elt]. *)
+
+(* Later:
+Add Morphism cardinal ; cardinal_m.
+*)
+
+End Facts.
diff --git a/theories/FSets/FSetWeakInterface.v b/theories/FSets/FSetWeakInterface.v
new file mode 100644
index 00000000..c1845494
--- /dev/null
+++ b/theories/FSets/FSetWeakInterface.v
@@ -0,0 +1,248 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetWeakInterface.v 8641 2006-03-17 09:56:54Z letouzey $ *)
+
+(** * Finite sets library *)
+
+(** Set interfaces for types with only a decidable equality, but no ordering *)
+
+Require Export Bool.
+Require Export DecidableType.
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+(** Compatibility of a  boolean function with respect to an equality. *)
+Definition compat_bool (A:Set)(eqA: A->A->Prop)(f: A-> bool) :=
+  forall x y : A, eqA x y -> f x = f y.
+
+(** Compatibility of a predicate with respect to an equality. *)
+Definition compat_P (A:Set)(eqA: A->A->Prop)(P : A -> Prop) :=
+  forall x y : A, eqA x y -> P x -> P y.
+
+Hint Unfold compat_bool compat_P.
+
+(** * Non-dependent signature
+
+    Signature [S] presents sets as purely informative programs 
+    together with axioms *)
+
+Module Type S.
+
+  Declare Module E : DecidableType.
+  Definition elt := E.t.
+
+  Parameter t : Set. (** the abstract type of sets *)
+
+  (** Logical predicates *)
+  Parameter In : elt -> t -> Prop.
+  Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+  Definition Subset s s' := forall a : elt, In a s -> In a s'.
+  Definition Empty s := forall a : elt, ~ In a s.
+  Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
+  Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x.
+  
+  Notation "s [=] t" := (Equal s t) (at level 70, no associativity).
+  Notation "s [<=] t" := (Subset s t) (at level 70, no associativity).
+
+  Parameter empty : t.
+  (** The empty set. *)
+
+  Parameter is_empty : t -> bool.
+  (** Test whether a set is empty or not. *)
+
+  Parameter mem : elt -> t -> bool.
+  (** [mem x s] tests whether [x] belongs to the set [s]. *)
+
+  Parameter add : elt -> t -> t.
+  (** [add x s] returns a set containing all elements of [s],
+  plus [x]. If [x] was already in [s], [s] is returned unchanged. *)
+
+  Parameter singleton : elt -> t.
+  (** [singleton x] returns the one-element set containing only [x]. *)
+
+  Parameter remove : elt -> t -> t.
+  (** [remove x s] returns a set containing all elements of [s],
+  except [x]. If [x] was not in [s], [s] is returned unchanged. *)
+
+  Parameter union : t -> t -> t.
+  (** Set union. *)
+
+  Parameter inter : t -> t -> t.
+  (** Set intersection. *)
+
+  Parameter diff : t -> t -> t.
+  (** Set difference. *)
+
+  Parameter equal : t -> t -> bool.
+  (** [equal s1 s2] tests whether the sets [s1] and [s2] are
+  equal, that is, contain equal elements. *)
+
+  Parameter subset : t -> t -> bool.
+  (** [subset s1 s2] tests whether the set [s1] is a subset of
+  the set [s2]. *)
+
+  (** Coq comment: [iter] is useless in a purely functional world *)
+  (**  iter: (elt -> unit) -> set -> unit. i*)
+  (** [iter f s] applies [f] in turn to all elements of [s].
+  The order in which the elements of [s] are presented to [f]
+  is unspecified. *)
+
+  Parameter fold : forall A : Set, (elt -> A -> A) -> t -> A -> A.
+  (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)],
+  where [x1 ... xN] are the elements of [s].
+  The order in which elements of [s] are presented to [f] is
+  unspecified. *)
+
+  Parameter for_all : (elt -> bool) -> t -> bool.
+  (** [for_all p s] checks if all elements of the set
+  satisfy the predicate [p]. *)
+
+  Parameter exists_ : (elt -> bool) -> t -> bool.
+  (** [exists p s] checks if at least one element of
+  the set satisfies the predicate [p]. *)
+
+  Parameter filter : (elt -> bool) -> t -> t.
+  (** [filter p s] returns the set of all elements in [s]
+  that satisfy predicate [p]. *)
+
+  Parameter partition : (elt -> bool) -> t -> t * t.
+  (** [partition p s] returns a pair of sets [(s1, s2)], where
+  [s1] is the set of all the elements of [s] that satisfy the
+  predicate [p], and [s2] is the set of all the elements of
+  [s] that do not satisfy [p]. *)
+
+  Parameter cardinal : t -> nat.
+  (** Return the number of elements of a set. *)
+  (** Coq comment: nat instead of int ... *)
+
+  Parameter elements : t -> list elt.
+  (** Return the list of all elements of the given set, in any order. *)
+
+  Parameter choose : t -> option elt.
+  (** Return one element of the given set, or raise [Not_found] if
+  the set is empty. Which element is chosen is unspecified.
+  Equal sets could return different elements. *)
+  (** Coq comment: [Not_found] is represented by the option type *)
+
+  Section Spec. 
+
+  Variable s s' s'' : t.
+  Variable x y z : elt.
+
+  (** Specification of [In] *)
+  Parameter In_1 : E.eq x y -> In x s -> In y s.
+ 
+  (** Specification of [mem] *)
+  Parameter mem_1 : In x s -> mem x s = true.
+  Parameter mem_2 : mem x s = true -> In x s. 
+ 
+  (** Specification of [equal] *) 
+  Parameter equal_1 : Equal s s' -> equal s s' = true.
+  Parameter equal_2 : equal s s' = true -> Equal s s'.
+
+  (** Specification of [subset] *)
+  Parameter subset_1 : Subset s s' -> subset s s' = true.
+  Parameter subset_2 : subset s s' = true -> Subset s s'.
+
+  (** Specification of [empty] *)
+  Parameter empty_1 : Empty empty.
+
+  (** Specification of [is_empty] *)
+  Parameter is_empty_1 : Empty s -> is_empty s = true. 
+  Parameter is_empty_2 : is_empty s = true -> Empty s.
+ 
+  (** Specification of [add] *)
+  Parameter add_1 : E.eq x y -> In y (add x s).
+  Parameter add_2 : In y s -> In y (add x s).
+  Parameter add_3 : ~ E.eq x y -> In y (add x s) -> In y s. 
+
+  (** Specification of [remove] *)
+  Parameter remove_1 : E.eq x y -> ~ In y (remove x s).
+  Parameter remove_2 : ~ E.eq x y -> In y s -> In y (remove x s).
+  Parameter remove_3 : In y (remove x s) -> In y s.
+
+  (** Specification of [singleton] *)
+  Parameter singleton_1 : In y (singleton x) -> E.eq x y. 
+  Parameter singleton_2 : E.eq x y -> In y (singleton x). 
+
+  (** Specification of [union] *)
+  Parameter union_1 : In x (union s s') -> In x s \/ In x s'.
+  Parameter union_2 : In x s -> In x (union s s'). 
+  Parameter union_3 : In x s' -> In x (union s s').
+
+  (** Specification of [inter] *)
+  Parameter inter_1 : In x (inter s s') -> In x s.
+  Parameter inter_2 : In x (inter s s') -> In x s'.
+  Parameter inter_3 : In x s -> In x s' -> In x (inter s s').
+
+  (** Specification of [diff] *)
+  Parameter diff_1 : In x (diff s s') -> In x s. 
+  Parameter diff_2 : In x (diff s s') -> ~ In x s'.
+  Parameter diff_3 : In x s -> ~ In x s' -> In x (diff s s').
+ 
+  (** Specification of [fold] *)  
+  Parameter fold_1 : forall (A : Set) (i : A) (f : elt -> A -> A),
+      fold f s i = fold_left (fun a e => f e a) (elements s) i.
+
+  (** Specification of [cardinal] *)  
+  Parameter cardinal_1 : cardinal s = length (elements s).
+
+  Section Filter.
+  
+  Variable f : elt -> bool.
+
+  (** Specification of [filter] *)
+  Parameter filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. 
+  Parameter filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. 
+  Parameter filter_3 :
+      compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s).
+
+  (** Specification of [for_all] *)
+  Parameter for_all_1 :
+      compat_bool E.eq f ->
+      For_all (fun x => f x = true) s -> for_all f s = true.
+  Parameter for_all_2 :
+      compat_bool E.eq f ->
+      for_all f s = true -> For_all (fun x => f x = true) s.
+
+  (** Specification of [exists] *)
+  Parameter exists_1 :
+      compat_bool E.eq f ->
+      Exists (fun x => f x = true) s -> exists_ f s = true.
+  Parameter exists_2 :
+      compat_bool E.eq f ->
+      exists_ f s = true -> Exists (fun x => f x = true) s.
+
+  (** Specification of [partition] *)
+  Parameter partition_1 :
+      compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s).
+  Parameter partition_2 :
+      compat_bool E.eq f ->
+      Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
+
+  (** Specification of [elements] *)
+  Parameter elements_1 : In x s -> InA E.eq x (elements s).
+  Parameter elements_2 : InA E.eq x (elements s) -> In x s.
+
+  (** Specification of [choose] *)
+  Parameter choose_1 : choose s = Some x -> In x s.
+  Parameter choose_2 : choose s = None -> Empty s.
+
+  End Filter.
+  End Spec.
+
+  Hint Immediate In_1.
+  
+  Hint Resolve mem_1 mem_2 equal_1 equal_2 subset_1 subset_2 empty_1
+    is_empty_1 is_empty_2 choose_1 choose_2 add_1 add_2 add_3 remove_1
+    remove_2 remove_3 singleton_1 singleton_2 union_1 union_2 union_3 inter_1
+    inter_2 inter_3 diff_1 diff_2 diff_3 filter_1 filter_2 filter_3 for_all_1
+    for_all_2 exists_1 exists_2 partition_1 partition_2 elements_1 elements_2.
+
+End S.
diff --git a/theories/FSets/FSetWeakList.v b/theories/FSets/FSetWeakList.v
new file mode 100644
index 00000000..74c81f37
--- /dev/null
+++ b/theories/FSets/FSetWeakList.v
@@ -0,0 +1,873 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: FSetWeakList.v 8639 2006-03-16 19:21:55Z letouzey $ *)
+
+(** * Finite sets library *)
+
+(** This file proposes an implementation of the non-dependant 
+    interface [FSetWeakInterface.S] using lists without redundancy. *)
+
+Require Import FSetWeakInterface.
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+(** * Functions over lists
+
+   First, we provide sets as lists which are (morally) without redundancy.
+   The specs are proved under the additional condition of no redundancy. 
+   And the functions returning sets are proved to preserve this invariant. *)
+
+Module Raw (X: DecidableType).
+ 
+  Module E := X.
+
+  Definition elt := X.t.
+  Definition t := list elt.
+
+  Definition empty : t := nil.
+
+  Definition is_empty (l : t) : bool := if l then true else false.
+
+  (** ** The set operations. *)
+
+  Fixpoint mem (x : elt) (s : t) {struct s} : bool :=
+    match s with
+    | nil => false
+    | y :: l =>
+           if X.eq_dec x y then true else mem x l
+    end.
+
+  Fixpoint add (x : elt) (s : t) {struct s} : t :=
+    match s with
+    | nil => x :: nil
+    | y :: l =>
+        if X.eq_dec x y then s else y :: add x l
+    end.
+
+  Definition singleton (x : elt) : t := x :: nil. 
+
+  Fixpoint remove (x : elt) (s : t) {struct s} : t :=
+    match s with
+    | nil => nil
+    | y :: l =>
+        if X.eq_dec x y then l else y :: remove x l
+    end.
+
+  Fixpoint fold (B : Set) (f : elt -> B -> B) (s : t) {struct s} : 
+   B -> B := fun i => match s with
+                      | nil => i
+                      | x :: l => fold f l (f x i)
+                      end.  
+
+  Definition union (s : t) : t -> t := fold add s.
+  
+  Definition diff (s s' : t) : t := fold remove s' s.
+
+  Definition inter (s s': t) : t := 
+    fold (fun x s => if mem x s' then add x s else s) s nil.
+
+  Definition subset (s s' : t) : bool := is_empty (diff s s').
+
+  Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s). 
+
+  Fixpoint filter (f : elt -> bool) (s : t) {struct s} : t :=
+    match s with
+    | nil => nil
+    | x :: l => if f x then x :: filter f l else filter f l
+    end.  
+
+  Fixpoint for_all (f : elt -> bool) (s : t) {struct s} : bool :=
+    match s with
+    | nil => true
+    | x :: l => if f x then for_all f l else false
+    end.  
+ 
+  Fixpoint exists_ (f : elt -> bool) (s : t) {struct s} : bool :=
+    match s with
+    | nil => false
+    | x :: l => if f x then true else exists_ f l
+    end.
+
+  Fixpoint partition (f : elt -> bool) (s : t) {struct s} : 
+   t * t :=
+    match s with
+    | nil => (nil, nil)
+    | x :: l =>
+        let (s1, s2) := partition f l in
+        if f x then (x :: s1, s2) else (s1, x :: s2)
+    end.
+
+  Definition cardinal (s : t) : nat := length s.
+
+  Definition elements (s : t) : list elt := s.
+
+  Definition choose (s : t) : option elt := 
+     match s with 
+      | nil => None
+      | x::_ => Some x
+     end.
+
+  (** ** Proofs of set operation specifications. *)
+
+  Notation NoDup := (NoDupA X.eq).
+  Notation In := (InA X.eq).
+
+  Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+  Definition Subset s s' := forall a : elt, In a s -> In a s'.
+  Definition Empty s := forall a : elt, ~ In a s.
+  Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x.
+  Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x.
+
+  Lemma In_eq :
+    forall (s : t) (x y : elt), X.eq x y -> In x s -> In y s.
+  Proof.
+  intros s x y; do 2 setoid_rewrite InA_alt; firstorder eauto.
+  Qed.
+  Hint Immediate In_eq.
+
+  Lemma mem_1 :
+   forall (s : t)(x : elt), In x s -> mem x s = true. 
+  Proof.
+  induction s; intros.
+  inversion H.
+  simpl; destruct (X.eq_dec x a); trivial.
+  inversion_clear H; auto.
+  Qed.
+
+  Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s.
+  Proof.
+  induction s. 
+  intros; inversion H.
+  intros x; simpl.
+  destruct (X.eq_dec x a); firstorder; discriminate.
+  Qed.
+
+  Lemma add_1 :
+   forall (s : t) (Hs : NoDup s) (x y : elt), X.eq x y -> In y (add x s).
+  Proof.
+  induction s. 
+  simpl; intuition.
+  simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs;
+   firstorder.
+  eauto.
+  Qed.
+
+  Lemma add_2 :
+   forall (s : t) (Hs : NoDup s) (x y : elt), In y s -> In y (add x s).
+  Proof.
+  induction s. 
+  simpl; intuition.
+  simpl; intros; case (X.eq_dec x a); intuition.
+  inversion_clear Hs; eauto; inversion_clear H; intuition.
+  Qed.
+
+  Lemma add_3 :
+   forall (s : t) (Hs : NoDup s) (x y : elt),
+   ~ X.eq x y -> In y (add x s) -> In y s.
+  Proof.
+  induction s. 
+  simpl; intuition.
+  inversion_clear H0; firstorder; absurd (X.eq x y); auto.
+  simpl; intros Hs x y; case (X.eq_dec x a); intros;
+   inversion_clear H0; inversion_clear Hs; firstorder; 
+   absurd (X.eq x y); auto.
+  Qed.
+
+  Lemma add_unique :
+   forall (s : t) (Hs : NoDup s)(x:elt), NoDup (add x s).
+  Proof.
+  induction s.  
+  simpl; intuition.
+  constructor; auto.
+  intro H0; inversion H0.
+  intros.
+  inversion_clear Hs.
+  simpl.
+  destruct (X.eq_dec x a).
+  constructor; auto.
+  constructor; auto.
+  intro H1; apply H.
+  eapply add_3; eauto.
+  Qed.
+
+  Lemma remove_1 :
+   forall (s : t) (Hs : NoDup s) (x y : elt), X.eq x y -> ~ In y (remove x s).
+  Proof.
+  simple induction s. 
+  simpl; red; intros; inversion H0.
+  simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs. 
+  elim H2.
+  apply In_eq with y; eauto.
+  inversion_clear H1; eauto.
+  Qed.
+
+  Lemma remove_2 :
+   forall (s : t) (Hs : NoDup s) (x y : elt),
+   ~ X.eq x y -> In y s -> In y (remove x s).
+  Proof.
+  simple induction s. 
+  simpl; intuition.
+  simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs;
+   inversion_clear H1; auto. 
+  absurd (X.eq x y); eauto. 
+  Qed.
+
+  Lemma remove_3 :
+   forall (s : t) (Hs : NoDup s) (x y : elt), In y (remove x s) -> In y s.
+  Proof.
+  simple induction s. 
+  simpl; intuition.
+  simpl; intros a l Hrec Hs x y; case (X.eq_dec x a); intuition.
+  inversion_clear Hs; inversion_clear H; firstorder.
+  Qed.
+
+  Lemma remove_unique :
+   forall (s : t) (Hs : NoDup s) (x : elt), NoDup (remove x s).
+  Proof.
+  simple induction s.
+  simpl; intuition.
+  simpl; intros; case (X.eq_dec x a); intuition; inversion_clear Hs;
+   auto.
+  constructor; auto.
+  intro H2; elim H0.
+  eapply remove_3; eauto.
+  Qed. 
+
+  Lemma singleton_unique : forall x : elt, NoDup (singleton x).
+  Proof.
+  unfold singleton; simpl; constructor; auto; intro H; inversion H.
+  Qed.
+
+  Lemma singleton_1 : forall x y : elt, In y (singleton x) -> X.eq x y.
+  Proof.
+  unfold singleton; simpl; intuition.
+  inversion_clear H; auto; inversion H0.
+  Qed. 
+
+  Lemma singleton_2 : forall x y : elt, X.eq x y -> In y (singleton x).
+  Proof.
+  unfold singleton; simpl; intuition.
+  Qed. 
+  
+  Lemma empty_unique : NoDup empty.
+  Proof.
+  unfold empty; constructor.
+  Qed.
+
+  Lemma empty_1 : Empty empty.
+  Proof.
+  unfold Empty, empty; intuition; inversion H.
+  Qed. 
+
+  Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true.
+  Proof.
+  unfold Empty; intro s; case s; simpl; intuition.
+  elim (H e); auto.
+  Qed.
+  
+  Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. 
+  Proof.
+  unfold Empty; intro s; case s; simpl; intuition;
+   inversion H0.
+  Qed.
+
+  Lemma elements_1 : forall (s : t) (x : elt), In x s -> In x (elements s).
+  Proof.
+  unfold elements; auto.
+  Qed.
+
+  Lemma elements_2 : forall (s : t) (x : elt), In x (elements s) -> In x s.
+  Proof. 
+  unfold elements; auto.
+  Qed.
+ 
+  Lemma elements_3 : forall (s : t) (Hs : NoDup s), NoDup (elements s).  
+  Proof. 
+  unfold elements; auto.
+  Qed.
+
+  Lemma fold_1 :
+   forall (s : t) (Hs : NoDup s) (A : Set) (i : A) (f : elt -> A -> A),
+   fold f s i = fold_left (fun a e => f e a) (elements s) i.
+  Proof.
+  induction s; simpl; auto; intros.
+  inversion_clear Hs; auto.
+  Qed.
+
+  Lemma union_unique :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s'), NoDup (union s s').
+  Proof.
+  unfold union; induction s; simpl; auto; intros.
+  inversion_clear Hs.
+  apply IHs; auto.
+  apply add_unique; auto.
+  Qed.
+  
+  Lemma union_1 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x (union s s') -> In x s \/ In x s'.
+  Proof.
+  unfold union; induction s; simpl; auto; intros.
+  inversion_clear Hs.
+  destruct (X.eq_dec x a).
+  left; auto.
+  destruct (IHs (add a s') H1 (add_unique Hs' a) x); intuition.
+  right; eapply add_3; eauto.
+  Qed.
+
+  Lemma union_0 : 
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x s \/ In x s' -> In x (union s s').
+  Proof.
+  unfold union; induction s; simpl; auto; intros.
+  inversion_clear H; auto.
+  inversion_clear H0.
+  inversion_clear Hs.
+  apply IHs; auto.
+  apply add_unique; auto.
+  destruct H.
+  inversion_clear H; auto.
+  right; apply add_1; auto.
+  right; apply add_2; auto.
+  Qed.
+
+  Lemma union_2 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x s -> In x (union s s').
+  Proof.
+  intros; apply union_0; auto.
+  Qed.
+
+  Lemma union_3 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x s' -> In x (union s s').
+  Proof.
+  intros; apply union_0; auto.
+  Qed.
+
+  Lemma inter_unique :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s'), NoDup (inter s s').
+  Proof.
+  unfold inter; intros s.
+  set (acc := nil (A:=elt)).
+  assert (NoDup acc) by (unfold acc; auto).
+  clearbody acc; generalize H; clear H; generalize acc; clear acc. 
+  induction s; simpl; auto; intros.
+  inversion_clear Hs.
+  apply IHs; auto.
+  destruct (mem a s'); intros; auto.
+  apply add_unique; auto.
+  Qed.  
+  
+  Lemma inter_0  :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x (inter s s') -> In x s /\ In x s'.
+  Proof.
+  unfold inter; intros.
+  set (acc := nil (A:=elt)) in *.
+  assert (NoDup acc) by (unfold acc; auto).
+  cut ((In x s /\ In x s') \/ In x acc).
+    destruct 1; auto.
+    inversion H1.
+  clearbody acc. 
+  generalize H0 H Hs' Hs; clear H0 H Hs Hs'.
+  generalize acc x s'; clear acc x s'.
+  induction s; simpl; auto; intros.
+  inversion_clear Hs.
+  case_eq (mem a s'); intros H3; rewrite H3 in H; simpl in H.
+  destruct (IHs _ _ _ (add_unique H0 a) H); auto.
+  left; intuition.
+  destruct (X.eq_dec x a); auto.
+  left; intuition.
+  apply In_eq with a; eauto.
+  apply mem_2; auto.
+  right; eapply add_3; eauto.
+  destruct (IHs _ _ _ H0 H); auto.
+  left; intuition.
+  Qed.
+
+  Lemma inter_1  :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x (inter s s') -> In x s.
+  Proof.
+  intros; cut (In x s /\ In x s'); [ intuition | apply inter_0; auto ].
+  Qed.
+
+  Lemma inter_2 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x (inter s s') -> In x s'.
+  Proof.
+  intros; cut (In x s /\ In x s'); [ intuition | apply inter_0; auto ].
+  Qed.
+
+  Lemma inter_3 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x s -> In x s' -> In x (inter s s').
+  Proof.
+  intros s s' Hs Hs' x.
+  cut (((In x s /\ In x s')\/ In x (nil (A:=elt))) -> In x (inter s s')).
+  intuition.
+  unfold inter.
+  set (acc := nil (A:=elt)) in *.
+  assert (NoDup acc) by (unfold acc; auto).
+  clearbody acc. 
+  generalize H Hs' Hs; clear H Hs Hs'.
+  generalize acc x s'; clear acc x s'.
+  induction s; simpl; auto; intros.
+  destruct H0; auto.
+  destruct H0; inversion H0.
+  inversion_clear Hs.
+  case_eq (mem a s'); intros H3; apply IHs; auto.
+  apply add_unique; auto.
+  destruct H0.
+  destruct H0.
+  inversion_clear H0.
+  right; apply add_1; auto.
+  left; auto.
+  right; apply add_2; auto.
+  destruct H0; auto.
+  destruct H0.
+  inversion_clear H0; auto.
+  absurd (In x s'); auto.
+  red; intros.
+  rewrite (mem_1 (In_eq H5 H0)) in H3.
+  discriminate.
+  Qed.
+
+  Lemma diff_unique :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s'), NoDup (diff s s').
+  Proof.
+  unfold diff; intros s s' Hs; generalize s Hs; clear Hs s.
+  induction s'; simpl; auto; intros.
+  inversion_clear Hs'.
+  apply IHs'; auto.
+  apply remove_unique; auto.
+  Qed.  
+  
+  Lemma diff_0 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x (diff s s') -> In x s /\ ~ In x s'.
+  Proof.
+  unfold diff; intros s s' Hs; generalize s Hs; clear Hs s.
+  induction s'; simpl; auto; intros.
+  inversion_clear Hs'.
+  split; auto; intro H1; inversion H1.
+  inversion_clear Hs'.
+  destruct (IHs' (remove a s) (remove_unique Hs a) H1 x H).
+  split. 
+  eapply remove_3; eauto.
+  red; intros.
+  inversion_clear H4; auto.
+  destruct (remove_1 Hs (X.eq_sym H5) H2).
+  Qed.
+
+  Lemma diff_1 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x (diff s s') -> In x s.
+  Proof.
+  intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. 
+  Qed.
+
+  Lemma diff_2 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x (diff s s') -> ~ In x s'.
+  Proof.
+  intros; cut (In x s /\ ~ In x s'); [ intuition | apply diff_0; auto]. 
+  Qed.
+
+  Lemma diff_3 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s') (x : elt),
+   In x s -> ~ In x s' -> In x (diff s s').
+  Proof.
+  unfold diff; intros s s' Hs; generalize s Hs; clear Hs s.
+  induction s'; simpl; auto; intros.
+  inversion_clear Hs'.
+  apply IHs'; auto.
+  apply remove_unique; auto.
+  apply remove_2; auto.
+  Qed.  
+  
+  Lemma subset_1 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s'),
+   Subset s s' -> subset s s' = true.
+  Proof.
+  unfold subset, Subset; intros.
+  apply is_empty_1.
+  unfold Empty; intros.
+  intro.
+  destruct (diff_2 Hs Hs' H0).
+  apply H.
+  eapply diff_1; eauto.
+  Qed.
+
+  Lemma subset_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'), 
+     subset s s' = true -> Subset s s'.
+  Proof.
+  unfold subset, Subset; intros.
+  generalize (is_empty_2 H); clear H; unfold Empty; intros.
+  generalize (@mem_1 s' a) (@mem_2 s' a); destruct (mem a s').
+  intuition.
+  intros.
+  destruct (H a).
+  apply diff_3; intuition.
+  Qed.
+
+  Lemma equal_1 :
+   forall (s s' : t) (Hs : NoDup s) (Hs' : NoDup s'),
+   Equal s s' -> equal s s' = true.
+  Proof.
+  unfold Equal, equal; intros.
+  apply andb_true_intro; split; apply subset_1; firstorder.
+  Qed.
+
+  Lemma equal_2 : forall (s s' : t)(Hs : NoDup s) (Hs' : NoDup s'),  
+     equal s s' = true -> Equal s s'.
+  Proof.
+  unfold Equal, equal; intros.
+  destruct (andb_prop _ _ H); clear H.
+  split; apply subset_2; auto.
+  Qed.  
+
+  Definition choose_1 :
+    forall (s : t) (x : elt), choose s = Some x -> In x s.
+  Proof.
+  destruct s; simpl; intros; inversion H; auto.
+  Qed.  
+
+  Definition choose_2 : forall s : t, choose s = None -> Empty s.
+  Proof.
+  destruct s; simpl; intros.
+  intros x H0; inversion H0.
+  inversion H.
+  Qed.  
+
+  Lemma cardinal_1 :
+   forall (s : t) (Hs : NoDup s), cardinal s = length (elements s).
+  Proof.
+  auto.
+  Qed.
+
+  Lemma filter_1 :
+   forall (s : t) (x : elt) (f : elt -> bool),
+   In x (filter f s) -> In x s.
+  Proof.
+  simple induction s; simpl.
+  intros; inversion H.
+  intros x l Hrec a f.
+  case (f x); simpl.
+  inversion_clear 1.
+  constructor; auto.
+  constructor 2; apply (Hrec a f); trivial.
+  constructor 2; apply (Hrec a f); trivial.
+  Qed.
+
+   Lemma filter_2 :
+    forall (s : t) (x : elt) (f : elt -> bool),
+    compat_bool X.eq f -> In x (filter f s) -> f x = true.   
+   Proof.
+  simple induction s; simpl.
+  intros; inversion H0.
+  intros x l Hrec a f Hf.
+  generalize (Hf x); case (f x); simpl; auto.
+  inversion_clear 2; auto.
+  symmetry; auto.
+  Qed.
+ 
+  Lemma filter_3 :
+   forall (s : t) (x : elt) (f : elt -> bool),
+   compat_bool X.eq f -> In x s -> f x = true -> In x (filter f s).     
+  Proof.
+  simple induction s; simpl.
+  intros; inversion H0.
+  intros x l Hrec a f Hf.
+  generalize (Hf x); case (f x); simpl.
+  inversion_clear 2; auto.
+  inversion_clear 2; auto.
+  rewrite <- (H a (X.eq_sym H1)); intros; discriminate.
+  Qed.
+
+  Lemma filter_unique :
+   forall (s : t) (Hs : NoDup s) (f : elt -> bool), NoDup (filter f s).
+  Proof.
+  simple induction s; simpl.
+  auto.
+  intros x l Hrec Hs f; inversion_clear Hs.
+  case (f x); auto.
+  constructor; auto.
+  intro H1; apply H.
+  eapply filter_1; eauto.
+  Qed.
+
+
+  Lemma for_all_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f ->
+   For_all (fun x => f x = true) s -> for_all f s = true.
+  Proof. 
+  simple induction s; simpl; auto; unfold For_all.
+  intros x l Hrec f Hf. 
+  generalize (Hf x); case (f x); simpl.
+  auto.
+  intros; rewrite (H x); auto.
+  Qed.
+
+  Lemma for_all_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f ->
+   for_all f s = true -> For_all (fun x => f x = true) s.
+  Proof. 
+  simple induction s; simpl; auto; unfold For_all.
+  intros; inversion H1.
+  intros x l Hrec f Hf. 
+  intros A a; intros. 
+  assert (f x = true).
+   generalize A; case (f x); auto.
+  rewrite H0 in A; simpl in A.
+  inversion_clear H; auto.
+  rewrite (Hf a x); auto.
+  Qed.
+
+  Lemma exists_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true.
+  Proof.
+  simple induction s; simpl; auto; unfold Exists.
+  intros.
+  elim H0; intuition. 
+  inversion H2.
+  intros x l Hrec f Hf. 
+  generalize (Hf x); case (f x); simpl.
+  auto.
+  destruct 2 as [a (A1,A2)].
+  inversion_clear A1.
+  rewrite <- (H a (X.eq_sym H0)) in A2; discriminate.
+  apply Hrec; auto.
+  exists a; auto.
+  Qed.
+
+  Lemma exists_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s.
+  Proof. 
+  simple induction s; simpl; auto; unfold Exists.
+  intros; discriminate.
+  intros x l Hrec f Hf.
+  case_eq (f x); intros.
+  exists x; auto.
+  destruct (Hrec f Hf H0) as [a (A1,A2)].
+  exists a; auto.
+  Qed.
+
+  Lemma partition_1 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f -> Equal (fst (partition f s)) (filter f s).
+  Proof.
+  simple induction s; simpl; auto; unfold Equal.
+  firstorder.
+  intros x l Hrec f Hf.
+  generalize (Hrec f Hf); clear Hrec.
+  case (partition f l); intros s1 s2; simpl; intros.
+  case (f x); simpl; firstorder; inversion H0; intros; firstorder. 
+  Qed.
+   
+  Lemma partition_2 :
+   forall (s : t) (f : elt -> bool),
+   compat_bool X.eq f ->
+   Equal (snd (partition f s)) (filter (fun x => negb (f x)) s).
+  Proof.
+  simple induction s; simpl; auto; unfold Equal.
+  firstorder.
+  intros x l Hrec f Hf. 
+  generalize (Hrec f Hf); clear Hrec.
+  case (partition f l); intros s1 s2; simpl; intros.
+  case (f x); simpl; firstorder; inversion H0; intros; firstorder. 
+  Qed.
+
+  Lemma partition_aux_1 : 
+   forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), 
+    In x (fst (partition f s)) -> In x s.
+  Proof.
+  induction s; simpl; auto; intros.
+  inversion_clear Hs.
+  generalize (IHs H1 f x).
+  destruct (f a); destruct (partition f s); simpl in *; auto.
+  inversion_clear H; auto.
+  Qed. 
+     
+  Lemma partition_aux_2 : 
+   forall (s : t) (Hs : NoDup s) (f : elt -> bool)(x:elt), 
+    In x (snd (partition f s)) -> In x s.
+  Proof.
+  induction s; simpl; auto; intros.
+  inversion_clear Hs.
+  generalize (IHs H1 f x).
+  destruct (f a); destruct (partition f s); simpl in *; auto.
+  inversion_clear H; auto.
+  Qed. 
+  
+  Lemma partition_unique_1 :
+   forall (s : t) (Hs : NoDup s) (f : elt -> bool), NoDup (fst (partition f s)).
+  Proof.
+  simple induction s; simpl.
+  auto.
+  intros x l Hrec Hs f; inversion_clear Hs.
+  generalize (@partition_aux_1 _ H0 f x).
+  generalize (Hrec H0 f).
+  case (f x); case (partition f l); simpl; auto.
+  Qed.
+  
+  Lemma partition_unique_2 :
+   forall (s : t) (Hs : NoDup s) (f : elt -> bool), NoDup (snd (partition f s)).
+  Proof.
+  simple induction s; simpl.
+  auto.
+  intros x l Hrec Hs f; inversion_clear Hs.
+  generalize (@partition_aux_2 _ H0 f x).
+  generalize (Hrec H0 f).
+  case (f x); case (partition f l); simpl; auto.
+  Qed.
+ 
+  Definition eq : t -> t -> Prop := Equal.
+
+  Lemma eq_refl : forall s : t, eq s s. 
+  Proof. 
+  unfold eq, Equal; intuition.
+  Qed.
+
+  Lemma eq_sym : forall s s' : t, eq s s' -> eq s' s.
+  Proof. 
+  unfold eq, Equal; firstorder.
+  Qed.
+
+  Lemma eq_trans : forall s s' s'' : t, eq s s' -> eq s' s'' -> eq s s''.
+  Proof. 
+  unfold eq, Equal; firstorder.
+  Qed.
+
+End Raw.
+
+(** * Encapsulation
+
+   Now, in order to really provide a functor implementing [S], we 
+   need to encapsulate everything into a type of lists without redundancy. *)
+
+Module Make (X: DecidableType) <: S with Module E := X.
+
+ Module E := X.
+ Module Raw := Raw X. 
+
+ Record slist : Set :=  {this :> Raw.t; unique : NoDupA X.eq this}.
+ Definition t := slist. 
+ Definition elt := X.t.
+ 
+ Definition In (x : elt) (s : t) := InA X.eq x s.(this).
+ Definition Equal s s' := forall a : elt, In a s <-> In a s'.
+ Definition Subset s s' := forall a : elt, In a s -> In a s'.
+ Definition Empty s := forall a : elt, ~ In a s.
+ Definition For_all (P : elt -> Prop) (s : t) :=
+   forall x : elt, In x s -> P x.
+ Definition Exists (P : elt -> Prop) (s : t) := exists x : elt, In x s /\ P x.
+  
+ Definition In_1 (s : t) := Raw.In_eq (s:=s).
+ 
+ Definition mem (x : elt) (s : t) := Raw.mem x s.
+ Definition mem_1 (s : t) := Raw.mem_1 (s:=s). 
+ Definition mem_2 (s : t) := Raw.mem_2 (s:=s).
+
+ Definition add x s := Build_slist (Raw.add_unique (unique s) x).
+ Definition add_1 (s : t) := Raw.add_1 (unique s).
+ Definition add_2 (s : t) := Raw.add_2 (unique s).
+ Definition add_3 (s : t) := Raw.add_3 (unique s).
+
+ Definition remove x s := Build_slist (Raw.remove_unique (unique s) x).
+ Definition remove_1 (s : t) := Raw.remove_1 (unique s).
+ Definition remove_2 (s : t) := Raw.remove_2 (unique s).
+ Definition remove_3 (s : t) := Raw.remove_3 (unique s).
+ 
+ Definition singleton x := Build_slist (Raw.singleton_unique x).
+ Definition singleton_1 := Raw.singleton_1.
+ Definition singleton_2 := Raw.singleton_2.
+  
+ Definition union (s s' : t) :=
+   Build_slist (Raw.union_unique (unique s) (unique s')). 
+ Definition union_1 (s s' : t) := Raw.union_1 (unique s) (unique s').
+ Definition union_2 (s s' : t) := Raw.union_2 (unique s) (unique s').
+ Definition union_3 (s s' : t) := Raw.union_3 (unique s) (unique s').
+
+ Definition inter (s s' : t) :=
+   Build_slist (Raw.inter_unique (unique s) (unique s')). 
+ Definition inter_1 (s s' : t) := Raw.inter_1 (unique s) (unique s').
+ Definition inter_2 (s s' : t) := Raw.inter_2 (unique s) (unique s').
+ Definition inter_3 (s s' : t) := Raw.inter_3 (unique s) (unique s').
+ 
+ Definition diff (s s' : t) :=
+   Build_slist (Raw.diff_unique (unique s) (unique s')). 
+ Definition diff_1 (s s' : t) := Raw.diff_1 (unique s) (unique s').
+ Definition diff_2 (s s' : t) := Raw.diff_2 (unique s) (unique s').
+ Definition diff_3 (s s' : t) := Raw.diff_3 (unique s) (unique s').
+ 
+ Definition equal (s s' : t) := Raw.equal s s'. 
+ Definition equal_1 (s s' : t) := Raw.equal_1 (unique s) (unique s').  
+ Definition equal_2 (s s' : t) := Raw.equal_2 (unique s) (unique s').
+ 
+ Definition subset (s s' : t) := Raw.subset s s'.
+ Definition subset_1 (s s' : t) := Raw.subset_1 (unique s) (unique s').  
+ Definition subset_2 (s s' : t) := Raw.subset_2 (unique s) (unique s').
+
+ Definition empty := Build_slist Raw.empty_unique.
+ Definition empty_1 := Raw.empty_1.
+ 
+ Definition is_empty (s : t) := Raw.is_empty s.
+ Definition is_empty_1 (s : t) := Raw.is_empty_1 (s:=s).
+ Definition is_empty_2 (s : t) := Raw.is_empty_2 (s:=s).
+
+ Definition elements (s : t) := Raw.elements s.
+ Definition elements_1 (s : t) := Raw.elements_1 (s:=s).
+ Definition elements_2 (s : t) := Raw.elements_2 (s:=s).
+ Definition elements_3 (s : t) := Raw.elements_3 (unique s).
+  
+ Definition choose (s:t) := Raw.choose s.
+ Definition choose_1 (s : t) := Raw.choose_1 (s:=s).
+ Definition choose_2 (s : t) := Raw.choose_2 (s:=s).
+  
+ Definition fold (B : Set) (f : elt -> B -> B) (s : t) := Raw.fold (B:=B) f s. 
+ Definition fold_1 (s : t) := Raw.fold_1 (unique s). 
+ 
+ Definition cardinal (s : t) := Raw.cardinal s.
+ Definition cardinal_1 (s : t) := Raw.cardinal_1 (unique s). 
+ 
+ Definition filter (f : elt -> bool) (s : t) :=
+   Build_slist (Raw.filter_unique (unique s) f).
+ Definition filter_1 (s : t)(x:elt)(f: elt -> bool)(H:compat_bool X.eq f) := 
+    @Raw.filter_1 s x f.
+ Definition filter_2 (s : t) := Raw.filter_2 (s:=s).
+ Definition filter_3 (s : t) := Raw.filter_3 (s:=s).
+ 
+ Definition for_all (f : elt -> bool) (s : t) := Raw.for_all f s.
+ Definition for_all_1 (s : t) := Raw.for_all_1 (s:=s). 
+ Definition for_all_2 (s : t) := Raw.for_all_2 (s:=s). 
+
+ Definition exists_ (f : elt -> bool) (s : t) := Raw.exists_ f s.
+ Definition exists_1 (s : t) := Raw.exists_1 (s:=s). 
+ Definition exists_2 (s : t) := Raw.exists_2 (s:=s). 
+
+ Definition partition (f : elt -> bool) (s : t) :=
+   let p := Raw.partition f s in
+   (Build_slist (this:=fst p) (Raw.partition_unique_1 (unique s) f),
+   Build_slist (this:=snd p) (Raw.partition_unique_2 (unique s) f)).
+ Definition partition_1 (s : t) := Raw.partition_1 s.
+ Definition partition_2 (s : t) := Raw.partition_2 s. 
+
+ Definition eq (s s' : t) := Raw.eq s s'.
+ Definition eq_refl (s : t) := Raw.eq_refl s.
+ Definition eq_sym (s s' : t) := Raw.eq_sym (s:=s) (s':=s').
+ Definition eq_trans (s s' s'' : t) :=
+   Raw.eq_trans (s:=s) (s':=s') (s'':=s'').
+
+End Make.
diff --git a/contrib7/correctness/Programs_stuff.v b/theories/FSets/FSets.v
index 00beeaeb..9dfcd51f 100644
--- a/contrib7/correctness/Programs_stuff.v
+++ b/theories/FSets/FSets.v
@@ -1,13 +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        *)
-(************************************************************************)
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
 
-(* Certification of Imperative Programs / Jean-Christophe Filliâtre *)
+(* $Id: FSets.v 8667 2006-03-28 11:59:44Z letouzey $ *)
 
-(* $Id: Programs_stuff.v,v 1.1.2.1 2004/07/16 19:30:16 herbelin Exp $ *)
-
-Require Export Arrays_stuff.
+Require Export OrderedType.
+Require Export FSetInterface.
+Require Export FSetBridge.
+Require Export FSetProperties.
+Require Export FSetEqProperties.
+Require Export FSetList.
diff --git a/theories/FSets/OrderedType.v b/theories/FSets/OrderedType.v
new file mode 100644
index 00000000..2bf08dc7
--- /dev/null
+++ b/theories/FSets/OrderedType.v
@@ -0,0 +1,566 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: OrderedType.v 8667 2006-03-28 11:59:44Z letouzey $ *)
+
+Require Export SetoidList.
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+(* TODO concernant la tactique order: 
+   * propagate_lt n'est sans doute pas complet
+   * un propagate_le
+   * exploiter les hypotheses negatives restant a la fin
+   * faire que ca marche meme quand une hypothese depend d'un eq ou lt.
+*) 
+
+(** * Ordered types *)
+
+Inductive Compare (X : Set) (lt eq : X -> X -> Prop) (x y : X) : Set :=
+  | LT : lt x y -> Compare lt eq x y
+  | EQ : eq x y -> Compare lt eq x y
+  | GT : lt y x -> Compare lt eq x y.
+
+Module Type OrderedType.
+
+  Parameter t : Set.
+
+  Parameter eq : t -> t -> Prop.
+  Parameter lt : t -> t -> Prop.
+
+  Axiom eq_refl : forall x : t, eq x x.
+  Axiom eq_sym : forall x y : t, eq x y -> eq y x.
+  Axiom eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z.
+ 
+  Axiom lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z.
+  Axiom lt_not_eq : forall x y : t, lt x y -> ~ eq x y.
+
+  Parameter compare : forall x y : t, Compare lt eq x y.
+
+  Hint Immediate eq_sym.
+  Hint Resolve eq_refl eq_trans lt_not_eq lt_trans.
+
+End OrderedType.
+
+(** * Ordered types properties *)
+
+(** Additional properties that can be derived from signature
+    [OrderedType]. *)
+
+Module OrderedTypeFacts (O: OrderedType). 
+  Import O.
+
+  Lemma lt_antirefl : forall x, ~ lt x x.
+  Proof.
+   intros; intro; absurd (eq x x); auto. 
+  Qed.
+
+  Lemma lt_eq : forall x y z, lt x y -> eq y z -> lt x z.
+  Proof. 
+   intros; destruct (compare x z); auto.
+   elim (lt_not_eq H); apply eq_trans with z; auto.
+   elim (lt_not_eq (lt_trans l H)); auto.
+  Qed. 
+
+  Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z.    
+  Proof.
+   intros; destruct (compare x z); auto.
+   elim (lt_not_eq H0); apply eq_trans with x; auto.
+   elim (lt_not_eq (lt_trans H0 l)); auto.
+  Qed. 
+
+  Lemma le_eq : forall x y z, ~lt x y -> eq y z -> ~lt x z.
+  Proof.
+   intros; intro; destruct H; apply lt_eq with z; auto.
+  Qed.
+
+  Lemma eq_le : forall x y z, eq x y -> ~lt y z -> ~lt x z.
+  Proof.
+   intros; intro; destruct H0; apply eq_lt with x; auto.
+  Qed.
+
+  Lemma neq_eq : forall x y z, ~eq x y -> eq y z -> ~eq x z.
+  Proof.
+   intros; intro; destruct H; apply eq_trans with z; auto.
+  Qed.
+
+  Lemma eq_neq : forall x y z, eq x y -> ~eq y z -> ~eq x z.
+  Proof.
+   intros; intro; destruct H0; apply eq_trans with x; auto.
+  Qed.
+
+  Hint Immediate eq_lt lt_eq le_eq eq_le neq_eq eq_neq.
+
+  Lemma le_lt_trans : forall x y z, ~lt y x -> lt y z -> lt x z.
+  Proof.
+   intros; destruct (compare y x); auto.
+   elim (H l).
+   apply eq_lt with y; auto.
+   apply lt_trans with y; auto.
+  Qed.
+
+  Lemma lt_le_trans : forall x y z, lt x y -> ~lt z y -> lt x z.
+  Proof.
+   intros; destruct (compare z y); auto.
+   elim (H0 l).
+   apply lt_eq with y; auto.
+   apply lt_trans with y; auto.
+  Qed.
+
+  Lemma le_neq : forall x y, ~lt x y -> ~eq x y -> lt y x.
+  Proof. 
+   intros; destruct (compare x y); intuition.
+  Qed.
+
+  Lemma neq_sym : forall x y, ~eq x y -> ~eq y x.
+  Proof. 
+   intuition.
+  Qed.
+
+Ltac abstraction := match goal with 
+ (* First, some obvious simplifications *)
+ | H : False |- _ => elim H
+ | H : lt ?x ?x |- _ => elim (lt_antirefl H)
+ | H : ~eq ?x ?x |- _ => elim (H (eq_refl x))
+ | H : eq ?x ?x |- _ => clear H; abstraction
+ | H : ~lt ?x ?x |- _ => clear H; abstraction
+ | |- eq ?x ?x => exact (eq_refl x)
+ | |- lt ?x ?x => elimtype False; abstraction
+ | |- ~ _ => intro; abstraction
+ | H1: ~lt ?x ?y, H2: ~eq ?x ?y |- _ => 
+     generalize (le_neq H1 H2); clear H1 H2; intro; abstraction
+ | H1: ~lt ?x ?y, H2: ~eq ?y ?x |- _ => 
+     generalize (le_neq H1 (neq_sym H2)); clear H1 H2; intro; abstraction
+ (* Then, we generalize all interesting facts *)
+ | H : lt ?x ?y |- _ => revert H; abstraction
+ | H : ~lt ?x ?y |- _ => revert H; abstraction  
+ | H : ~eq ?x ?y |- _ =>  revert H; abstraction
+ | H : eq ?x ?y |- _ =>  revert H; abstraction
+ | _ => idtac
+end.
+
+Ltac do_eq a b EQ := match goal with 
+ | |- lt ?x ?y -> _ => let H := fresh "H" in 
+     (intro H; 
+      (generalize (eq_lt (eq_sym EQ) H); clear H; intro H) ||
+      (generalize (lt_eq H EQ); clear H; intro H) || 
+      idtac); 
+      do_eq a b EQ
+ | |- ~lt ?x ?y -> _ => let H := fresh "H" in 
+     (intro H; 
+      (generalize (eq_le (eq_sym EQ) H); clear H; intro H) ||
+      (generalize (le_eq H EQ); clear H; intro H) || 
+      idtac); 
+      do_eq a b EQ 
+ | |- eq ?x ?y -> _ => let H := fresh "H" in 
+     (intro H; 
+      (generalize (eq_trans (eq_sym EQ) H); clear H; intro H) ||
+      (generalize (eq_trans H EQ); clear H; intro H) || 
+      idtac); 
+      do_eq a b EQ 
+ | |- ~eq ?x ?y -> _ => let H := fresh "H" in 
+     (intro H; 
+      (generalize (eq_neq (eq_sym EQ) H); clear H; intro H) ||
+      (generalize (neq_eq H EQ); clear H; intro H) || 
+      idtac); 
+      do_eq a b EQ 
+ | |- lt a ?y => apply eq_lt with b; [exact EQ|]
+ | |- lt ?y a => apply lt_eq with b; [|exact (eq_sym EQ)]
+ | |- eq a ?y => apply eq_trans with b; [exact EQ|]
+ | |- eq ?y a => apply eq_trans with b; [|exact (eq_sym EQ)]
+ | _ => idtac
+ end.
+
+Ltac propagate_eq := abstraction; clear; match goal with 
+ (* the abstraction tactic leaves equality facts in head position...*)
+ | |- eq ?a ?b -> _ => 
+     let EQ := fresh "EQ" in (intro EQ; do_eq a b EQ; clear EQ); 
+     propagate_eq 
+ | _ => idtac
+end.
+
+Ltac do_lt x y LT := match goal with 
+ (* LT *)
+ | |- lt x y -> _ => intros _; do_lt x y LT
+ | |- lt y ?z -> _ => let H := fresh "H" in 
+     (intro H; generalize (lt_trans LT H); intro); do_lt x y LT
+ | |- lt ?z x -> _ => let H := fresh "H" in 
+     (intro H; generalize (lt_trans H LT); intro); do_lt x y LT
+ | |- lt _ _ -> _ => intro; do_lt x y LT
+ (* Ge *)
+ | |- ~lt y x -> _ => intros _; do_lt x y LT
+ | |- ~lt x ?z -> _ => let H := fresh "H" in 
+     (intro H; generalize (le_lt_trans H LT); intro); do_lt x y LT
+ | |- ~lt ?z y -> _ => let H := fresh "H" in 
+     (intro H; generalize (lt_le_trans LT H); intro); do_lt x y LT
+ | |- ~lt _ _ -> _ => intro; do_lt x y LT
+ | _ => idtac
+ end.
+
+Definition hide_lt := lt.
+
+Ltac propagate_lt := abstraction; match goal with 
+ (* when no [=] remains, the abstraction tactic leaves [<] facts first. *)
+ | |- lt ?x ?y -> _ => 
+     let LT := fresh "LT" in (intro LT; do_lt x y LT; 
+     change (hide_lt x y) in LT); 
+     propagate_lt 
+ | _ => unfold hide_lt in *
+end.
+
+Ltac order := 
+ intros; 
+ propagate_eq; 
+ propagate_lt; 
+ auto; 
+ propagate_lt; 
+ eauto.
+
+Ltac false_order := elimtype False; order.
+
+  Lemma gt_not_eq : forall x y, lt y x -> ~ eq x y.
+  Proof.
+    order.
+  Qed.	
+ 
+  Lemma eq_not_lt : forall x y : t, eq x y -> ~ lt x y.
+  Proof. 
+    order.
+  Qed.
+
+  Hint Resolve gt_not_eq eq_not_lt.
+
+  Lemma eq_not_gt : forall x y : t, eq x y -> ~ lt y x.
+  Proof. 
+   order.
+  Qed.
+
+  Lemma lt_not_gt : forall x y : t, lt x y -> ~ lt y x.
+  Proof.  
+   order.
+  Qed.
+
+  Hint Resolve eq_not_gt lt_antirefl lt_not_gt.
+
+  Lemma elim_compare_eq :
+   forall x y : t,
+   eq x y -> exists H : eq x y, compare x y = EQ _ H.
+  Proof. 
+   intros; case (compare x y); intros H'; try solve [false_order].
+   exists H'; auto.   
+  Qed.
+
+  Lemma elim_compare_lt :
+   forall x y : t,
+   lt x y -> exists H : lt x y, compare x y = LT _ H.
+  Proof. 
+   intros; case (compare x y); intros H'; try solve [false_order].
+   exists H'; auto. 
+  Qed.
+
+  Lemma elim_compare_gt :
+   forall x y : t,
+   lt y x -> exists H : lt y x, compare x y = GT _ H.
+  Proof. 
+   intros; case (compare x y); intros H'; try solve [false_order].
+   exists H'; auto.   
+  Qed.
+
+  Ltac elim_comp := 
+    match goal with 
+      | |- ?e => match e with 
+           | context ctx [ compare ?a ?b ] =>
+                let H := fresh in 
+                (destruct (compare a b) as [H|H|H]; 
+                 try solve [ intros; false_order])
+         end
+    end.
+
+  Ltac elim_comp_eq x y :=
+    elim (elim_compare_eq (x:=x) (y:=y));
+     [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. 
+
+  Ltac elim_comp_lt x y :=
+    elim (elim_compare_lt (x:=x) (y:=y));
+     [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. 
+
+  Ltac elim_comp_gt x y :=
+    elim (elim_compare_gt (x:=x) (y:=y));
+     [ intros _1 _2; rewrite _2; clear _1 _2 | auto ].
+
+  Lemma eq_dec : forall x y : t, {eq x y} + {~ eq x y}.
+  Proof.
+   intros; elim (compare x y); [ right | left | right ]; auto.
+  Qed.
+ 
+  Lemma lt_dec : forall x y : t, {lt x y} + {~ lt x y}.
+  Proof.
+   intros; elim (compare x y); [ left | right | right ]; auto.
+  Qed.
+
+  Definition eqb x y : bool := if eq_dec x y then true else false.
+
+  Lemma eqb_alt : 
+    forall x y, eqb x y = match compare x y with EQ _ => true | _ => false end. 
+  Proof.
+  unfold eqb; intros; destruct (eq_dec x y); elim_comp; auto.
+  Qed.
+
+(* Specialization of resuts about lists modulo. *)
+
+Notation In:=(InA eq).
+Notation Inf:=(lelistA lt).
+Notation Sort:=(sort lt).
+Notation NoDup:=(NoDupA eq).
+
+Lemma In_eq : forall l x y, eq x y -> In x l -> In y l.
+Proof. exact (InA_eqA eq_sym eq_trans). Qed.
+
+Lemma ListIn_In : forall l x, List.In x l -> In x l.
+Proof. exact (In_InA eq_refl). Qed.
+
+Lemma Inf_lt : forall l x y, lt x y -> Inf y l -> Inf x l.
+Proof. exact (InfA_ltA lt_trans). Qed.
+ 
+Lemma Inf_eq : forall l x y, eq x y -> Inf y l -> Inf x l.
+Proof. exact (InfA_eqA eq_lt). Qed.
+
+Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> lt a x.
+Proof. exact (SortA_InfA_InA eq_refl eq_sym lt_trans lt_eq eq_lt). Qed.
+  
+Lemma ListIn_Inf : forall l x, (forall y, List.In y l -> lt x y) -> Inf x l.
+Proof. exact (@In_InfA t lt). Qed.
+
+Lemma In_Inf : forall l x, (forall y, In y l -> lt x y) -> Inf x l.
+Proof. exact (InA_InfA eq_refl (ltA:=lt)). Qed.
+
+Lemma Inf_alt : 
+ forall l x, Sort l -> (Inf x l <-> (forall y, In y l -> lt x y)).
+Proof. exact (InfA_alt eq_refl eq_sym lt_trans lt_eq eq_lt). Qed.
+
+Lemma Sort_NoDup : forall l, Sort l -> NoDup l.
+Proof. exact (SortA_NoDupA eq_refl eq_sym lt_trans lt_not_eq lt_eq eq_lt) . Qed.
+
+Hint Resolve ListIn_In Sort_NoDup Inf_lt. 
+Hint Immediate In_eq Inf_lt. 
+
+End OrderedTypeFacts.
+
+Module PairOrderedType(O:OrderedType).
+ Import O.
+ Module MO:=OrderedTypeFacts(O).
+ Import MO.
+
+ Section Elt.
+ Variable elt : Set.
+ Notation key:=t.
+
+  Definition eqk (p p':key*elt) := eq (fst p) (fst p').
+  Definition eqke (p p':key*elt) := 
+          eq (fst p) (fst p') /\ (snd p) = (snd p').
+  Definition ltk (p p':key*elt) := lt (fst p) (fst p').
+
+  Hint Unfold eqk eqke ltk.
+  Hint Extern 2 (eqke ?a ?b) => split.
+
+   (* eqke is stricter than eqk *)
+ 
+   Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'.
+   Proof.
+     unfold eqk, eqke; intuition.
+   Qed.
+
+  (* ltk ignore the second components *)
+
+   Lemma ltk_right_r : forall x k e e', ltk x (k,e) -> ltk x (k,e').
+   Proof. auto. Qed.
+
+   Lemma ltk_right_l : forall x k e e', ltk (k,e) x -> ltk (k,e') x.
+   Proof. auto. Qed.
+   Hint Immediate ltk_right_r ltk_right_l.
+
+  (* eqk, eqke are equalities, ltk is a strict order *)
+ 
+  Lemma eqk_refl : forall e, eqk e e.
+  Proof. auto. Qed.
+
+  Lemma eqke_refl : forall e, eqke e e.
+  Proof. auto. Qed.
+
+  Lemma eqk_sym : forall e e', eqk e e' -> eqk e' e.
+  Proof. auto. Qed.
+
+  Lemma eqke_sym : forall e e', eqke e e' -> eqke e' e.
+  Proof. unfold eqke; intuition. Qed.
+
+  Lemma eqk_trans : forall e e' e'', eqk e e' -> eqk e' e'' -> eqk e e''.
+  Proof. eauto. Qed.
+
+  Lemma eqke_trans : forall e e' e'', eqke e e' -> eqke e' e'' -> eqke e e''.
+  Proof.
+    unfold eqke; intuition; [ eauto | congruence ].
+  Qed.
+
+  Lemma ltk_trans : forall e e' e'', ltk e e' -> ltk e' e'' -> ltk e e''.
+  Proof. eauto. Qed.
+
+  Lemma ltk_not_eqk : forall e e', ltk e e' -> ~ eqk e e'.
+  Proof. unfold eqk, ltk; auto. Qed.  
+
+  Lemma ltk_not_eqke : forall e e', ltk e e' -> ~eqke e e'.
+  Proof.
+    unfold eqke, ltk; intuition; simpl in *; subst.
+    exact (lt_not_eq H H1).
+  Qed.
+
+  Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
+  Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke.
+  Hint Immediate eqk_sym eqke_sym.
+
+  (* Additionnal facts *)
+
+  Lemma eqk_not_ltk : forall x x', eqk x x' -> ~ltk x x'.
+   Proof.
+     unfold eqk, ltk; simpl; auto.
+   Qed.
+
+  Lemma ltk_eqk : forall e e' e'', ltk e e' -> eqk e' e'' -> ltk e e''.
+  Proof. eauto. Qed.
+
+  Lemma eqk_ltk : forall e e' e'', eqk e e' -> ltk e' e'' -> ltk e e''.
+  Proof.
+      intros (k,e) (k',e') (k'',e'').
+      unfold ltk, eqk; simpl; eauto.
+  Qed.
+  Hint Resolve eqk_not_ltk. 
+  Hint Immediate ltk_eqk eqk_ltk.
+
+  Lemma InA_eqke_eqk : 
+     forall x m, InA eqke x m -> InA eqk x m.
+  Proof.
+    unfold eqke; induction 1; intuition.
+  Qed.
+  Hint Resolve InA_eqke_eqk.
+
+  Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
+  Definition In k m := exists e:elt, MapsTo k e m.
+  Notation Sort := (sort ltk).
+  Notation Inf := (lelistA ltk).
+
+  Hint Unfold MapsTo In.
+
+  (* An alternative formulation for [In k l] is [exists e, InA eqk (k,e) l] *)
+
+  Lemma In_alt : forall k l, In k l <-> exists e, InA eqk (k,e) l.
+  Proof.
+  firstorder.
+  exists x; auto.
+  induction H.
+  destruct y.
+  exists e; auto.
+  destruct IHInA as [e H0].
+  exists e; auto.
+  Qed.
+
+  Lemma MapsTo_eq : forall l x y e, eq x y -> MapsTo x e l -> MapsTo y e l.
+  Proof.
+  intros; unfold MapsTo in *; apply InA_eqA with (x,e); eauto.
+  Qed.
+
+  Lemma In_eq : forall l x y, eq x y -> In x l -> In y l.
+  Proof.
+  destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto.
+  Qed. 
+
+  Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l.
+  Proof. exact (InfA_eqA eqk_ltk). Qed.
+
+  Lemma Inf_lt : forall l x x', ltk x x' -> Inf x' l -> Inf x l.
+  Proof. exact (InfA_ltA ltk_trans). Qed.
+
+  Hint Immediate Inf_eq.
+  Hint Resolve Inf_lt.
+
+  Lemma Sort_Inf_In : 
+      forall l p q, Sort l -> Inf q l -> InA eqk p l -> ltk q p.
+  Proof. 
+  exact (SortA_InfA_InA eqk_refl eqk_sym ltk_trans ltk_eqk eqk_ltk).
+  Qed.
+
+  Lemma Sort_Inf_NotIn : 
+      forall l k e, Sort l -> Inf (k,e) l ->  ~In k l.
+  Proof.
+    intros; red; intros.
+    destruct H1 as [e' H2].
+    elim (@ltk_not_eqk (k,e) (k,e')).
+    eapply Sort_Inf_In; eauto.
+    red; simpl; auto.
+  Qed.
+
+  Lemma Sort_NoDupA: forall l, Sort l -> NoDupA eqk l.
+  Proof. 
+  exact (SortA_NoDupA eqk_refl eqk_sym ltk_trans ltk_not_eqk ltk_eqk eqk_ltk).
+  Qed.
+
+  Lemma Sort_In_cons_1 : forall e l e', Sort (e::l) -> InA eqk e' l -> ltk e e'.
+  Proof.
+   inversion 1; intros; eapply Sort_Inf_In; eauto.
+  Qed.
+
+  Lemma Sort_In_cons_2 : forall l e e', Sort (e::l) -> InA eqk e' (e::l) ->
+      ltk e e' \/ eqk e e'.
+  Proof.
+    inversion_clear 2; auto.
+    left; apply Sort_In_cons_1 with l; auto.
+  Qed.
+
+  Lemma Sort_In_cons_3 : 
+    forall x l k e, Sort ((k,e)::l) -> In x l -> ~eq x k.
+  Proof.
+    inversion_clear 1; red; intros.
+    destruct (Sort_Inf_NotIn H0 H1 (In_eq H2 H)).
+  Qed.
+
+  Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> eq k k' \/ In k l.
+  Proof.
+    inversion 1.
+    inversion_clear H0; eauto.
+    destruct H1; simpl in *; intuition.
+  Qed.      
+
+  Lemma In_inv_2 : forall k k' e e' l, 
+      InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l.
+  Proof.  
+   inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+  Lemma In_inv_3 : forall x x' l, 
+      InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l.
+  Proof.
+   inversion_clear 1; compute in H0; intuition.
+  Qed.
+
+ End Elt.
+
+ Hint Unfold eqk eqke ltk.
+ Hint Extern 2 (eqke ?a ?b) => split.
+ Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
+ Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke.
+ Hint Immediate eqk_sym eqke_sym.
+ Hint Resolve eqk_not_ltk. 
+ Hint Immediate ltk_eqk eqk_ltk.
+ Hint Resolve InA_eqke_eqk.
+ Hint Unfold MapsTo In.
+ Hint Immediate Inf_eq.
+ Hint Resolve Inf_lt.
+ Hint Resolve Sort_Inf_NotIn.
+ Hint Resolve In_inv_2 In_inv_3.
+
+End PairOrderedType.
+
+
diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v
index 6aeabe13..f71f58c6 100755..100644
--- a/theories/Init/Datatypes.v
+++ b/theories/Init/Datatypes.v
@@ -6,19 +6,19 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Datatypes.v,v 1.26.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: Datatypes.v 8642 2006-03-17 10:09:02Z notin $ i*)
+
+Set Implicit Arguments.
 
 Require Import Notations.
 Require Import Logic.
 
-Set Implicit Arguments.
-
 (** [unit] is a singleton datatype with sole inhabitant [tt] *)
 
 Inductive unit : Set :=
     tt : unit.
 
-(** [bool] is the datatype of the booleans values [true] and [false] *)
+(** [bool] is the datatype of the boolean values [true] and [false] *)
 
 Inductive bool : Set :=
   | true : bool
@@ -27,7 +27,9 @@ Inductive bool : Set :=
 Add Printing If bool.
 
 (** [nat] is the datatype of natural numbers built from [O] and successor [S];
-    note that zero is the letter O, not the numeral 0 *)
+    note that the constructor name is the letter O.
+    Numbers in [nat] can be denoted using a decimal notation; 
+    e.g. [3%nat] abbreviates [S (S (S O))] *)
 
 Inductive nat : Set :=
   | O : nat
@@ -53,7 +55,7 @@ Implicit Arguments identity_ind [A].
 Implicit Arguments identity_rec [A].
 Implicit Arguments identity_rect [A].
 
-(** [option A] is the extension of A with a dummy element None *)
+(** [option A] is the extension of [A] with an extra element [None] *)
 
 Inductive option (A:Set) : Set :=
   | Some : A -> option A
@@ -61,7 +63,13 @@ Inductive option (A:Set) : Set :=
 
 Implicit Arguments None [A].
 
-(** [sum A B], equivalently [A + B], is the disjoint sum of [A] and [B] *)
+Definition option_map (A B:Set) (f:A->B) o :=
+  match o with
+  | Some a => Some (f a)
+  | None => None
+  end.
+
+(** [sum A B], written [A + B], is the disjoint sum of [A] and [B] *)
 (* Syntax defined in Specif.v *)
 Inductive sum (A B:Set) : Set :=
   | inl : A -> sum A B
diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v
index bae8d4a1..cbf8d7a7 100755..100644
--- a/theories/Init/Logic.v
+++ b/theories/Init/Logic.v
@@ -6,13 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Logic.v,v 1.29.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: Logic.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Set Implicit Arguments.
 
 Require Import Notations.
 
-(** * Propositional connectives *)
+(** *** Propositional connectives *)
 
 (** [True] is the always true proposition *)
 Inductive True : Prop :=
@@ -28,13 +28,6 @@ Notation "~ x" := (not x) : type_scope.
 
 Hint Unfold not: core.
 
-Inductive and (A B:Prop) : Prop :=
-    conj : A -> B -> A /\ B 
- where "A /\ B" := (and A B) : type_scope.
-
-
-Section Conjunction.
-
   (** [and A B], written [A /\ B], is the conjunction of [A] and [B]
 
       [conj p q] is a proof of [A /\ B] as soon as 
@@ -42,6 +35,13 @@ Section Conjunction.
 
       [proj1] and [proj2] are first and second projections of a conjunction *)
 
+Inductive and (A B:Prop) : Prop :=
+    conj : A -> B -> A /\ B 
+
+where "A /\ B" := (and A B) : type_scope.
+
+Section Conjunction.
+
   Variables A B : Prop.
 
   Theorem proj1 : A /\ B -> A.
@@ -61,7 +61,8 @@ End Conjunction.
 Inductive or (A B:Prop) : Prop :=
   | or_introl : A -> A \/ B
   | or_intror : B -> A \/ B 
- where "A \/ B" := (or A B) : type_scope.
+
+where "A \/ B" := (or A B) : type_scope.
 
 (** [iff A B], written [A <-> B], expresses the equivalence of [A] and [B] *)
 
@@ -94,20 +95,28 @@ End Equivalence.
 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) : type_scope.
-
-(** * First-order quantifiers
-  - [ex A P], or simply [exists x, P x], expresses the existence of an 
-      [x] of type [A] which satisfies the predicate [P] ([A] is of type 
-      [Set]). This is existential quantification.
-  - [ex2 A P Q], or simply [exists2 x, P x & Q x], expresses the
-      existence of an [x] of type [A] which satisfies both the predicates
-      [P] and [Q].
-  - Universal quantification (especially first-order one) is normally 
-    written [forall x:A, P x]. For duality with existential quantification, 
-    the construction [all P] is provided too.
+  (at level 200, right associativity) : type_scope.
+
+(** *** 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
+    satisfies the predicate [P].  This is existential quantification.
+
+    [ex2 P Q], or simply [exists2 x, P x & Q x], or also 
+    [exists2 x:A, P x & Q x], expresses the existence of an [x] of
+    type [A] which satisfies both predicates [P] and [Q].
+
+    Universal quantification is primitively written [forall x:A, Q]. By
+    symmetry with existential quantification, the construction [all P]
+    is provided too.
 *)
 
+(* 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.
 
@@ -119,19 +128,19 @@ Definition all (A:Type) (P:A -> Prop) := forall x:A, P x.
 (* Rule order is important to give printing priority to fully typed exists *)
 
 Notation "'exists' x , p" := (ex (fun x => p))
-  (at level 200, x ident) : type_scope.
+  (at level 200, x ident, right associativity) : type_scope.
 Notation "'exists' x : t , p" := (ex (fun x:t => p))
-  (at level 200, x ident, format "'exists'  '/  ' x  :  t ,  '/  ' p")
+  (at level 200, x ident, right associativity, 
+   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) : type_scope.
+  (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,
-   format "'exists2'  '/  ' x  :  t ,  '/  ' '[' p  &  '/' q ']'")
+  (at level 200, x ident, t at level 200, p at level 200, right associativity,
+   format "'[' 'exists2'  '/  ' x  :  t ,  '/  ' '[' p  &  '/' q ']' ']'")
   : type_scope.
 
-
 (** Derived rules for universal quantification *)
 
 Section universal_quantification.
@@ -151,18 +160,21 @@ Section universal_quantification.
 
 End universal_quantification.
 
-(** * Equality *)
+(** *** Equality *)
 
-(** [eq x y], or simply [x=y], expresses the (Leibniz') equality
-    of [x] and [y]. Both [x] and [y] must belong to the same type [A].
+(** [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].
     The definition is inductive and states the reflexivity of the equality.
     The others properties (symmetry, transitivity, replacement of 
-    equals) are proved below. The type of [x] and [y] can be made explicit
-    using the notation [x = y :> A] *)
+    equals by equals) are proved below. The type of [x] and [y] can be
+    made explicit using the notation [x = y :> A]. This is Leibniz equality
+    as it expresses that [x] and [y] are equal iff every property on
+    [A] which is true of [x] is also true of [y] *)
 
 Inductive eq (A:Type) (x:A) : A -> Prop :=
     refl_equal : x = x :>A 
- where "x = y :> A" := (@eq A x y) : type_scope.
+
+where "x = y :> A" := (@eq A x y) : type_scope.
 
 Notation "x = y" := (x = y :>_) : type_scope.
 Notation "x <> y  :> T" := (~ x = y :>T) : type_scope.
@@ -217,16 +229,6 @@ Section Logic_lemmas.
 
   End equality.
 
-(* Is now a primitive principle 
-  Theorem eq_rect: (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eq ? x y)->(P y).
-  Proof.
-   Intros.
-   Cut (identity A x y).
-   NewDestruct 1; Auto.
-   NewDestruct H; Auto.
-  Qed.
-*)
-
   Definition eq_ind_r :
     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.
@@ -277,3 +279,14 @@ Proof.
 Qed.
 
 Hint Immediate sym_eq sym_not_eq: core v62.
+
+(** Other notations *)
+
+Notation "'exists' ! x , P" := 
+  (exists x',  (fun x => P) x' /\ forall x'', (fun x => P) x'' -> x' = x'')
+  (at level 200, x ident, right associativity,
+   format "'[' 'exists' !  '/  ' x ,  '/  ' P ']'") : type_scope.
+Notation "'exists' ! x : A , P" := 
+  (exists x' : A,  (fun x => P) x' /\ forall x'':A, (fun x => P) x'' -> x' = x'')
+  (at level 200, x ident, right associativity,
+   format "'[' 'exists' !  '/  ' x  :  A ,  '/  ' P ']'") : type_scope.
diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v
index 0e62e842..857ffe94 100755..100644
--- a/theories/Init/Logic_Type.v
+++ b/theories/Init/Logic_Type.v
@@ -6,18 +6,48 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Logic_Type.v,v 1.19.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: Logic_Type.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
-Set Implicit Arguments.
+(** This module defines type constructors for types in [Type]
+    ([Datatypes.v] and [Logic.v] defined them for types in [Set]) *)
 
-(** This module defines quantification on the world [Type]
-    ([Logic.v] was defining it on the world [Set]) *)
+Set Implicit Arguments.
 
 Require Import Datatypes.
 Require Export Logic.
 
+(** Negation of a type in [Type] *)
+
 Definition notT (A:Type) := A -> False.
 
+(** Conjunction of types in [Type] *)
+
+Inductive prodT (A B:Type) : Type :=
+    pairT : A -> B -> prodT A B.
+
+Section prodT_proj.
+
+  Variables A B : Type.
+
+  Definition fstT (H:prodT A B) := match H with
+                                   | pairT x _ => x
+                                   end.
+  Definition sndT (H:prodT A B) := match H with
+                                   | pairT _ y => y
+                                   end.
+
+End prodT_proj.
+
+Definition prodT_uncurry (A B C:Type) (f:prodT A B -> C) 
+  (x:A) (y:B) : C := f (pairT x y).
+
+Definition prodT_curry (A B C:Type) (f:A -> B -> C) 
+  (p:prodT A B) : C := match p with
+                       | pairT x y => f x y
+                       end.
+
+(** Properties of [identity] *)
+
 Section identity_is_a_congruence.
 
  Variables A B : Type.
@@ -62,28 +92,4 @@ Definition identity_rect_r :
  intros A x P H y H0; case sym_id with (1 := H0); trivial.
 Defined.
 
-Inductive prodT (A B:Type) : Type :=
-    pairT : A -> B -> prodT A B.
-
-Section prodT_proj.
-
-  Variables A B : Type.
-
-  Definition fstT (H:prodT A B) := match H with
-                                   | pairT x _ => x
-                                   end.
-  Definition sndT (H:prodT A B) := match H with
-                                   | pairT _ y => y
-                                   end.
-
-End prodT_proj.
-
-Definition prodT_uncurry (A B C:Type) (f:prodT A B -> C) 
-  (x:A) (y:B) : C := f (pairT x y).
-
-Definition prodT_curry (A B C:Type) (f:A -> B -> C) 
-  (p:prodT A B) : C := match p with
-                       | pairT x y => f x y
-                       end.
-
 Hint Immediate sym_id sym_not_id: core v62.
diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v
index e0a18747..3ca93067 100644
--- a/theories/Init/Notations.v
+++ b/theories/Init/Notations.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Notations.v,v 1.24.2.2 2004/08/01 09:36:44 herbelin Exp $ i*)
+(*i $Id: Notations.v 6410 2004-12-06 11:34:35Z herbelin $ i*)
 
 (** These are the notations whose level and associativity are imposed by Coq *)
 
@@ -54,15 +54,12 @@ Reserved Notation "x ^ y" (at level 30, right associativity).
 Reserved Notation "( x , y , .. , z )" (at level 0).
 
 (** Notation "{ x }" is reserved and has a special status as component
-    of other notations; it is at level 0 to factor with {x:A|P} etc *)
+    of other notations such as "{ A } + { B }" and "A + { B }" (which
+    are at the same level than "x + y");
+    "{ x }" is at level 0 to factor with "{ x : A | P }" *)
 
 Reserved Notation "{ x }" (at level 0, x at level 99).
 
-(** Notations for sum-types *)
-
-Reserved Notation "{ A } + { B }" (at level 50, left associativity).
-Reserved Notation "A + { B }" (at level 50, left associativity).
-
 (** Notations for sigma-types or subsets *)
 
 Reserved Notation "{ x : A  |  P }" (at level 0, x at level 99).
diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v
index 789a020f..c0416b63 100755..100644
--- a/theories/Init/Peano.v
+++ b/theories/Init/Peano.v
@@ -6,9 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Peano.v,v 1.23.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: Peano.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
-(** Natural numbers [nat] built from [O] and [S] are defined in Datatypes.v *)
+(** The type [nat] of Peano natural numbers (built from [O] and [S])
+    is defined in [Datatypes.v] *)
 
 (** This module defines the following operations on natural numbers :
     - predecessor [pred]
@@ -19,13 +20,15 @@
     - greater or equal [ge]
     - greater [gt]
 
-   This module states various lemmas and theorems about natural numbers,
-   including Peano's axioms of arithmetic (in Coq, these are in fact provable)
-   Case analysis on [nat] and induction on [nat * nat] are provided too *)
+   It states various lemmas and theorems about natural numbers,
+   including Peano's axioms of arithmetic (in Coq, these are provable).
+   Case analysis on [nat] and induction on [nat * nat] are provided too
+ *)
 
 Require Import Notations.
 Require Import Datatypes.
 Require Import Logic.
+Unset Boxed Definitions.
 
 Open Scope nat_scope.
 
@@ -47,6 +50,8 @@ Proof.
   auto.
 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.
@@ -54,21 +59,20 @@ Qed.
 
 Hint Immediate eq_add_S: core v62.
 
-(** A consequence of the previous axioms *)
-
 Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m.
 Proof.
   red in |- *; auto.
 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.
 
-
 Theorem O_S : forall n:nat, 0 <> S n.
 Proof.
   red in |- *; intros n H.
@@ -88,13 +92,14 @@ Hint Resolve n_Sn: core v62.
 Fixpoint plus (n m:nat) {struct n} : nat :=
   match n with
   | O => m
-  | S p => S (plus p m)
-  end.
+  | S p => S (p + m)
+  end
+
+where "n + m" := (plus n m) : nat_scope.
+
 Hint Resolve (f_equal2 plus): v62.
 Hint Resolve (f_equal2 (A1:=nat) (A2:=nat)): core.
 
-Infix "+" := plus : nat_scope.
-
 Lemma plus_n_O : forall n:nat, n = n + 0.
 Proof.
   induction n; simpl in |- *; auto.
@@ -122,11 +127,12 @@ Qed.
 Fixpoint mult (n m:nat) {struct n} : nat :=
   match n with
   | O => 0
-  | S p => m + mult p m
-  end.
-Hint Resolve (f_equal2 mult): core v62.
+  | S p => m + p * m
+  end
 
-Infix "*" := mult : nat_scope.
+where "n * m" := (mult n m) : nat_scope.
+
+Hint Resolve (f_equal2 mult): core v62.
 
 Lemma mult_n_O : forall n:nat, 0 = n * 0.
 Proof.
@@ -142,27 +148,25 @@ Proof.
 Qed.
 Hint Resolve mult_n_Sm: core v62.
 
-(** Definition of subtraction on [nat] : [m-n] is [0] if [n>=m] *)
+(** Truncated subtraction: [m-n] is [0] if [n>=m] *)
 
 Fixpoint minus (n m:nat) {struct n} : nat :=
   match n, m with
   | O, _ => 0
   | S k, O => S k
-  | S k, S l => minus k l
-  end. 
+  | S k, S l => k - l
+  end
 
-Infix "-" := minus : nat_scope.
+where "n - m" := (minus n m) : nat_scope.
 
 (** Definition of the usual orders, the basic properties of [le] and [lt] 
     can be found in files Le and Lt *)
 
-(** An inductive definition to define the order *)
-
 Inductive le (n:nat) : nat -> Prop :=
-  | le_n : le n n
-  | le_S : forall m:nat, le n m -> le n (S m).
+  | le_n : n <= n
+  | le_S : forall m:nat, n <= m -> n <= S m
 
-Infix "<=" := le : nat_scope.
+where "n <= m" := (le n m) : nat_scope.
 
 Hint Constructors le: core v62.
 (*i equivalent to : "Hints Resolve le_n le_S : core v62." i*)
@@ -187,7 +191,7 @@ Notation "x <= y < z" := (x <= y /\ y < z) : nat_scope.
 Notation "x < y < z" := (x < y /\ y < z) : nat_scope.
 Notation "x < y <= z" := (x < y /\ y <= z) : nat_scope.
 
-(** Pattern-Matching on natural numbers *)
+(** Case analysis *)
 
 Theorem nat_case :
  forall (n:nat) (P:nat -> Prop), P 0 -> (forall m:nat, P (S m)) -> P n.
diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v
index 2fe520c4..5f6f1eab 100755..100644
--- a/theories/Init/Prelude.v
+++ b/theories/Init/Prelude.v
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Prelude.v,v 1.11.2.1 2004/07/16 19:31:03 herbelin Exp $ i*)
+(*i $Id: Prelude.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Notations.
 Require Export Logic.
 Require Export Datatypes.
 Require Export Specif.
 Require Export Peano.
-Require Export Wf.
\ No newline at end of file
+Require Export Wf.
+Require Export Tactics.
diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v
index 6855e689..e7fc1ac4 100755..100644
--- a/theories/Init/Specif.v
+++ b/theories/Init/Specif.v
@@ -6,21 +6,21 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Specif.v,v 1.25.2.1 2004/07/16 19:31:04 herbelin Exp $ i*)
+(*i $Id: Specif.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
-Set Implicit Arguments.
+(** Basic specifications : sets that may contain logical information *)
 
-(** Basic specifications : Sets containing logical information *)
+Set Implicit Arguments.
 
 Require Import Notations.
 Require Import Datatypes.
 Require Import Logic.
 
-(** Subsets *)
+(** Subsets and Sigma-types *)
 
-(** [(sig A P)], or more suggestively [{x:A | (P x)}], denotes the subset 
+(** [(sig A P)], or more suggestively [{x:A | P x}], denotes the subset 
     of elements of the Set [A] which satisfy the predicate [P].
-    Similarly [(sig2 A P Q)], or [{x:A | (P x) & (Q x)}], denotes the subset 
+    Similarly [(sig2 A P Q)], or [{x:A | P x & Q x}], denotes the subset 
     of elements of the Set [A] which satisfy both [P] and [Q]. *)
 
 Inductive sig (A:Set) (P:A -> Prop) : Set :=
@@ -29,8 +29,8 @@ Inductive sig (A:Set) (P:A -> Prop) : Set :=
 Inductive sig2 (A:Set) (P Q:A -> Prop) : Set :=
     exist2 : forall x:A, P x -> Q x -> sig2 (A:=A) P Q.
 
-(** [(sigS A P)], or more suggestively [{x:A & (P x)}], is a subtle variant
-    of subset where [P] is now of type [Set].
+(** [(sigS A P)], or more suggestively [{x:A & (P x)}] is a Sigma-type. 
+    It is a variant of subset where [P] is now of type [Set].
     Similarly for [(sigS2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *)
      
 Inductive sigS (A:Set) (P:A -> Set) : Set :=
@@ -57,7 +57,13 @@ Add Printing Let sigS.
 Add Printing Let sigS2.
 
 
-(** Projections of sig *)
+(** Projections of [sig]
+
+    An element [y] of a subset [{x:A & (P x)}] is the pair of an [a]
+    of type [A] and of a proof [h] that [a] satisfies [P].  Then
+    [(proj1_sig y)] is the witness [a] and [(proj2_sig y)] is the
+    proof of [(P a)] *)
+
 
 Section Subset_projections.
 
@@ -76,18 +82,18 @@ Section Subset_projections.
 End Subset_projections.
 
 
-(** Projections of sigS *)
+(** Projections of [sigS]
+
+    An element [x] of a sigma-type [{y:A & P y}] is a dependent pair
+    made of an [a] of type [A] and an [h] of type [P a].  Then,
+    [(projS1 x)] is the first projection and [(projS2 x)] is the
+    second projection, the type of which depends on the [projS1]. *)
 
 Section Projections.
 
   Variable A : Set.
   Variable P : A -> Set.
 
- (** An element [y] of a subset [{x:A & (P x)}] is the pair of an [a] of 
-     type [A] and of a proof [h] that [a] satisfies [P].
-     Then [(projS1 y)] is the witness [a]
-     and [(projS2 y)] is the proof of [(P a)] *)
-
   Definition projS1 (x:sigS P) : A := match x with
                                       | existS a _ => a
                                       end.
@@ -99,7 +105,8 @@ Section Projections.
 End Projections.
 
 
-(** Extended_booleans *)
+(** [sumbool] is a boolean type equipped with the justification of
+    their value *)
 
 Inductive sumbool (A B:Prop) : Set :=
   | left : A -> {A} + {B}
@@ -108,6 +115,9 @@ Inductive sumbool (A B:Prop) : Set :=
 
 Add Printing If sumbool.
 
+(** [sumor] is an option type equipped with the justification of why
+    it may not be a regular value *)
+
 Inductive sumor (A:Set) (B:Prop) : Set :=
   | inleft : A -> A + {B}
   | inright : B -> A + {B} 
@@ -115,12 +125,10 @@ Inductive sumor (A:Set) (B:Prop) : Set :=
 
 Add Printing If sumor.
 
-(** Choice *)
+(** Various forms of the axiom of choice for specifications *)
 
 Section Choice_lemmas.
 
-  (** The following lemmas state various forms of the axiom of choice *)
-
   Variables S S' : Set.
   Variable R : S -> S' -> Prop.
   Variable R' : S -> S' -> Set.
@@ -167,8 +175,10 @@ End Choice_lemmas.
 
  (** A result of type [(Exc A)] is either a normal value of type [A] or 
      an [error] :
-     [Inductive Exc [A:Set] : Set := value : A->(Exc A) | error : (Exc A)]
-     it is implemented using the option type. *) 
+
+     [Inductive Exc [A:Set] : Set := value : A->(Exc A) | error : (Exc A)].
+
+     It is implemented using the option type. *) 
 
 Definition Exc := option.
 Definition value := Some.
@@ -189,7 +199,7 @@ Qed.
 
 Hint Resolve left right inleft inright: core v62.
 
-(** Sigma Type at Type level [sigT] *)
+(** Sigma-type for types in [Type] *)
 
 Inductive sigT (A:Type) (P:A -> Type) : Type :=
     existT : forall x:A, P x -> sigT (A:=A) P.
diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v
new file mode 100644
index 00000000..ce37715e
--- /dev/null
+++ b/theories/Init/Tactics.v
@@ -0,0 +1,72 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(*i $Id: Tactics.v 8100 2006-02-27 12:10:03Z letouzey $ i*)
+
+Require Import Notations.
+Require Import Logic.
+
+(** Useful tactics *)
+
+(* A shorter name for generalize + clear, can be seen as an anti-intro *)
+
+Ltac revert H := generalize H; clear H.
+
+(* to contradict an hypothesis without copying its type. *)
+
+Ltac absurd_hyp h := 
+  let T := type of h in 
+  absurd T.
+
+(* Transforming a negative goal [ H:~A |- ~B ] into a positive one [ B |- A ]*)
+
+Ltac swap H := intro; apply H; clear H.
+
+(* A case with no loss of information. *)
+
+Ltac case_eq x := generalize (refl_equal x); pattern x at -1; case x.
+
+(* A tactic for easing the use of lemmas f_equal, f_equal2, ... *)
+
+Ltac f_equal := 
+  let cg := try congruence in
+  let r := try reflexivity in 
+  match goal with 
+   | |- ?f ?a = ?f' ?a' => cut (a=a'); [cg|r]
+   | |- ?f ?a ?b = ?f' ?a' ?b' => 
+      cut (b=b');[cut (a=a');[cg|r]|r]
+   | |- ?f ?a ?b ?c = ?f' ?a' ?b' ?c'=> 
+      cut (c=c');[cut (b=b');[cut (a=a');[cg|r]|r]|r]
+   | |- ?f ?a ?b ?c ?d= ?f' ?a' ?b' ?c' ?d'=> 
+      cut (d=d');[cut (c=c');[cut (b=b');[cut (a=a');[cg|r]|r]|r]|r]
+  | |- ?f ?a ?b ?c ?d ?e= ?f' ?a' ?b' ?c' ?d' ?e'=> 
+      cut (e=e');[cut (d=d');[cut (c=c');[cut (b=b');[cut (a=a');[cg|r]|r]|r]|r]|r]
+   | _ => 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.
diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v
index 7ab3723d..fde70225 100755..100644
--- a/theories/Init/Wf.v
+++ b/theories/Init/Wf.v
@@ -6,61 +6,59 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Set Implicit Arguments.
-
-(*i $Id: Wf.v,v 1.17.2.1 2004/07/16 19:31:04 herbelin Exp $ i*)
+(*i $Id: Wf.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** This module proves the validity of
     - well-founded recursion (also called course of values)
     - well-founded induction
 
-   from a well-founded ordering on a given set *)
+    from a well-founded ordering on a given set *)
+
+Set Implicit Arguments.
 
 Require Import Notations.
 Require Import Logic.
 Require Import Datatypes.
 
-(** Well-founded induction principle on Prop *)
+(** Well-founded induction principle on [Prop] *)
 
 Section Well_founded.
 
- Variable A : Set.
+ Variable A : Type.
  Variable R : A -> A -> Prop.
 
  (** The accessibility predicate is defined to be non-informative *)
 
- Inductive Acc : A -> Prop :=
-     Acc_intro : forall x:A, (forall y:A, R y x -> Acc y) -> Acc x.
+ Inductive Acc (x: A) : Prop :=
+     Acc_intro : (forall y:A, R y x -> Acc y) -> Acc x.
 
  Lemma Acc_inv : forall x:A, Acc x -> forall y:A, R y x -> Acc y.
   destruct 1; trivial.
  Defined.
 
-  (** the informative elimination :
+  (** Informative elimination :
      [let Acc_rec F = let rec wf x = F x wf in wf] *)
 
  Section AccRecType.
   Variable P : A -> Type.
-  Variable
-    F :
-      forall x:A,
-        (forall y:A, R y x -> Acc y) -> (forall y:A, R y x -> P y) -> P x.
+  Variable F : forall x:A,
+    (forall y:A, R y x -> Acc y) -> (forall y:A, R y x -> P y) -> P x.
 
   Fixpoint Acc_rect (x:A) (a:Acc x) {struct a} : P x :=
-    F (Acc_inv a) (fun (y:A) (h:R y x) => Acc_rect (x:=y) (Acc_inv a h)).
+    F (Acc_inv a) (fun (y:A) (h:R y x) => Acc_rect (Acc_inv a h)).
 
  End AccRecType.
 
  Definition Acc_rec (P:A -> Set) := Acc_rect P.
 
- (** A simplified version of Acc_rec(t) *)
+ (** A simplified version of [Acc_rect] *)
 
  Section AccIter.
-  Variable P : A -> Type. 
+  Variable P : A -> Type.
   Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x.
 
   Fixpoint Acc_iter (x:A) (a:Acc x) {struct a} : P x :=
-    F (fun (y:A) (h:R y x) => Acc_iter (x:=y) (Acc_inv a h)).
+    F (fun (y:A) (h:R y x) => Acc_iter (Acc_inv a h)).
 
  End AccIter.
 
@@ -68,7 +66,7 @@ Section Well_founded.
 
  Definition well_founded := forall a:A, Acc a.
 
- (** well-founded induction on Set and Prop *)
+ (** Well-founded induction on [Set] and [Prop] *)
 
  Hypothesis Rwf : well_founded.
 
@@ -95,47 +93,48 @@ Section Well_founded.
 
 (** Building fixpoints  *) 
 
-Section FixPoint.
+ Section FixPoint.
 
-Variable P : A -> Set.
-Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x.
-
-Fixpoint Fix_F (x:A) (r:Acc x) {struct r} : P x :=
-  F (fun (y:A) (p:R y x) => Fix_F (x:=y) (Acc_inv r p)).
+  Variable P : A -> Type.
+  Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x.
 
-Definition Fix (x:A) := Fix_F (Rwf x).
+  Notation Fix_F := (Acc_iter P F) (only parsing). (* alias *)
 
-(** Proof that [well_founded_induction] satisfies the fixpoint equation. 
-    It requires an extra property of the functional *)
+  Definition Fix (x:A) := Acc_iter P F (Rwf x).
 
-Hypothesis
-  F_ext :
-    forall (x:A) (f g:forall y:A, R y x -> P y),
-      (forall (y:A) (p:R y x), f y p = g y p) -> F f = F g.
+  (** Proof that [well_founded_induction] satisfies the fixpoint equation. 
+      It requires an extra property of the functional *)
 
-Scheme Acc_inv_dep := Induction for Acc Sort Prop.
+  Hypothesis
+    F_ext :
+      forall (x:A) (f g:forall y:A, R y x -> P y),
+        (forall (y:A) (p:R y x), f y p = g y p) -> F f = F g.
 
-Lemma Fix_F_eq :
- forall (x:A) (r:Acc x),
-   F (fun (y:A) (p:R y x) => Fix_F (Acc_inv r p)) = Fix_F r.
-destruct r using Acc_inv_dep; auto.
-Qed.
+  Scheme Acc_inv_dep := Induction for Acc Sort Prop.
 
-Lemma Fix_F_inv : forall (x:A) (r s:Acc x), Fix_F r = Fix_F s.
-intro x; induction (Rwf x); intros.
-rewrite <- (Fix_F_eq r); rewrite <- (Fix_F_eq s); intros.
-apply F_ext; auto.
-Qed.
+  Lemma Fix_F_eq :
+   forall (x:A) (r:Acc x),
+     F (fun (y:A) (p:R y x) => Fix_F y (Acc_inv r p)) = Fix_F x r.
+  Proof. 
+   destruct r using Acc_inv_dep; auto.
+  Qed.
 
+  Lemma Fix_F_inv : forall (x:A) (r s:Acc x), Fix_F x r = Fix_F x s.
+  Proof.
+   intro x; induction (Rwf x); intros.
+   rewrite <- (Fix_F_eq r); rewrite <- (Fix_F_eq s); intros.
+   apply F_ext; auto.
+  Qed.
 
-Lemma Fix_eq : forall x:A, Fix x = F (fun (y:A) (p:R y x) => Fix y).
-intro x; unfold Fix in |- *.
-rewrite <- (Fix_F_eq (x:=x)).
-apply F_ext; intros.
-apply Fix_F_inv.
-Qed.
+  Lemma Fix_eq : forall x:A, Fix x = F (fun (y:A) (p:R y x) => Fix y).
+  Proof.
+   intro x; unfold Fix in |- *.
+   rewrite <- (Fix_F_eq (x:=x)).
+   apply F_ext; intros.
+   apply Fix_F_inv.
+  Qed.
 
-End FixPoint.
+ End FixPoint.
 
 End Well_founded. 
 
@@ -169,3 +168,5 @@ Section Well_founded_2.
   Defined.
 
 End Well_founded_2.
+
+Notation Fix_F := Acc_iter (only parsing). (* compatibility *)
diff --git a/theories/IntMap/Adalloc.v b/theories/IntMap/Adalloc.v
index 9fde8f5f..2136bfb5 100644
--- a/theories/IntMap/Adalloc.v
+++ b/theories/IntMap/Adalloc.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Adalloc.v,v 1.10.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Adalloc.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/IntMap/Addec.v b/theories/IntMap/Addec.v
index 7dba9ef6..f1a937a3 100644
--- a/theories/IntMap/Addec.v
+++ b/theories/IntMap/Addec.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Addec.v,v 1.7.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Addec.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 (** Equality on adresses *)
 
diff --git a/theories/IntMap/Addr.v b/theories/IntMap/Addr.v
index 1370d72d..727117b3 100644
--- a/theories/IntMap/Addr.v
+++ b/theories/IntMap/Addr.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Addr.v,v 1.8.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Addr.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 (** Representation of adresses by the [positive] type of binary numbers *)
 
diff --git a/theories/IntMap/Adist.v b/theories/IntMap/Adist.v
index cdb4c885..790218ce 100644
--- a/theories/IntMap/Adist.v
+++ b/theories/IntMap/Adist.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	     $Id: Adist.v,v 1.9.2.1 2004/07/16 19:31:04 herbelin Exp $	      i*)
+(*i 	     $Id: Adist.v 5920 2004-07-16 20:01:26Z herbelin $	      i*)
 
 Require Import Bool.
 Require Import ZArith.
diff --git a/theories/IntMap/Allmaps.v b/theories/IntMap/Allmaps.v
index 68744220..f9a0feac 100644
--- a/theories/IntMap/Allmaps.v
+++ b/theories/IntMap/Allmaps.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Allmaps.v,v 1.3.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Allmaps.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Export Addr.
 Require Export Adist.
diff --git a/theories/IntMap/Fset.v b/theories/IntMap/Fset.v
index 8d217be9..27f739c1 100644
--- a/theories/IntMap/Fset.v
+++ b/theories/IntMap/Fset.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Fset.v,v 1.5.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Fset.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 (*s Sets operations on maps *)
 
diff --git a/theories/IntMap/Lsort.v b/theories/IntMap/Lsort.v
index 48972872..d31d8133 100644
--- a/theories/IntMap/Lsort.v
+++ b/theories/IntMap/Lsort.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Lsort.v,v 1.4.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Lsort.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/IntMap/Map.v b/theories/IntMap/Map.v
index da1fa99e..5345f81b 100644
--- a/theories/IntMap/Map.v
+++ b/theories/IntMap/Map.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Map.v,v 1.7.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Map.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 (** Definition of finite sets as trees indexed by adresses *)
 
diff --git a/theories/IntMap/Mapaxioms.v b/theories/IntMap/Mapaxioms.v
index 9d09f2a9..b6a2b134 100644
--- a/theories/IntMap/Mapaxioms.v
+++ b/theories/IntMap/Mapaxioms.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Mapaxioms.v,v 1.4.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Mapaxioms.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/IntMap/Mapc.v b/theories/IntMap/Mapc.v
index 7a394abb..d7a779ff 100644
--- a/theories/IntMap/Mapc.v
+++ b/theories/IntMap/Mapc.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Mapc.v,v 1.4.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Mapc.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/IntMap/Mapcanon.v b/theories/IntMap/Mapcanon.v
index 868fbe5e..23e0669e 100644
--- a/theories/IntMap/Mapcanon.v
+++ b/theories/IntMap/Mapcanon.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Mapcanon.v,v 1.4.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Mapcanon.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/IntMap/Mapcard.v b/theories/IntMap/Mapcard.v
index 49f9fe91..35efac47 100644
--- a/theories/IntMap/Mapcard.v
+++ b/theories/IntMap/Mapcard.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Mapcard.v,v 1.5.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Mapcard.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/IntMap/Mapfold.v b/theories/IntMap/Mapfold.v
index 641529ee..335a1384 100644
--- a/theories/IntMap/Mapfold.v
+++ b/theories/IntMap/Mapfold.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i   	  $Id: Mapfold.v,v 1.4.2.1 2004/07/16 19:31:04 herbelin Exp $      i*)
+(*i   	  $Id: Mapfold.v 5920 2004-07-16 20:01:26Z herbelin $      i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/IntMap/Mapiter.v b/theories/IntMap/Mapiter.v
index f5d443cc..31e98c49 100644
--- a/theories/IntMap/Mapiter.v
+++ b/theories/IntMap/Mapiter.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Mapiter.v,v 1.4.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Mapiter.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/IntMap/Maplists.v b/theories/IntMap/Maplists.v
index 645c3407..1d53e6e5 100644
--- a/theories/IntMap/Maplists.v
+++ b/theories/IntMap/Maplists.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Maplists.v,v 1.4.2.1 2004/07/16 19:31:04 herbelin Exp $	 i*)
+(*i 	$Id: Maplists.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Addr.
 Require Import Addec.
diff --git a/theories/IntMap/Mapsubset.v b/theories/IntMap/Mapsubset.v
index 33b412e3..e27943fb 100644
--- a/theories/IntMap/Mapsubset.v
+++ b/theories/IntMap/Mapsubset.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Mapsubset.v,v 1.4.2.1 2004/07/16 19:31:05 herbelin Exp $	 i*)
+(*i 	$Id: Mapsubset.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 Require Import Bool.
 Require Import Sumbool.
diff --git a/theories/Lists/List.v b/theories/Lists/List.v
index c3f65d67..ad91a350 100755..100644
--- a/theories/Lists/List.v
+++ b/theories/Lists/List.v
@@ -6,10 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: List.v,v 1.9.2.1 2004/07/16 19:31:05 herbelin Exp $ i*)
-
-Require Import Le.
+(*i $Id: List.v 8686 2006-04-06 13:25:10Z letouzey $ i*)
 
+Require Import Le Minus Min Bool.
 
 Section Lists.
 
@@ -25,6 +24,8 @@ Infix "::" := cons (at level 60, right associativity) : list_scope.
 
 Open Scope list_scope.
 
+Ltac now_show c := change c in |- *.
+
 (*************************)
 (** Discrimination       *)
 (*************************)
@@ -35,108 +36,6 @@ Proof.
 Qed.
 
 (*************************)
-(** Concatenation        *)
-(*************************)
-
-Fixpoint app (l m:list) {struct l} : list :=
-  match l with
-  | nil => m
-  | a :: l1 => a :: app l1 m
-  end.
-
-Infix "++" := app (right associativity, at level 60) : list_scope.
-
-Lemma app_nil_end : forall l:list, l = l ++ nil.
-Proof. 
-	induction l; simpl in |- *; auto.
-        rewrite <- IHl; auto.
-Qed.
-Hint Resolve app_nil_end.
-
-Ltac now_show c := change c in |- *.
-
-Lemma app_ass : forall l m n:list, (l ++ m) ++ n = l ++ m ++ n.
-Proof. 
-	intros. induction l; simpl in |- *; auto.
-        now_show (a :: (l ++ m) ++ n = a :: l ++ m ++ n).
-	rewrite <- IHl; auto.
-Qed.
-Hint Resolve app_ass.
-
-Lemma ass_app : forall l m n:list, l ++ m ++ n = (l ++ m) ++ n.
-Proof. 
-	auto.
-Qed.
-Hint Resolve ass_app.
-
-Lemma app_comm_cons : forall (x y:list) (a:A), a :: x ++ y = (a :: x) ++ y.
-Proof.
- auto.
-Qed.
-
-Lemma app_eq_nil : forall x y:list, x ++ y = nil -> x = nil /\ y = nil.
-Proof.
-  destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ];
-   simpl in |- *; auto.
-  intros H; discriminate H.
-  intros; discriminate H.
-Qed.
-
-Lemma app_cons_not_nil : forall (x y:list) (a:A), nil <> x ++ a :: y.
-Proof.
-unfold not in |- *.
-  destruct x as [| a l]; simpl in |- *; intros.
-  discriminate H.
-  discriminate H.
-Qed.
-
-Lemma app_eq_unit :
- forall (x y:list) (a:A),
-   x ++ y = a :: nil -> x = nil /\ y = a :: nil \/ x = a :: nil /\ y = nil.
-
-Proof.
-  destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ];
-   simpl in |- *.
-  intros a H; discriminate H.
-  left; split; auto.
-  right; split; auto.
-  generalize H.
-  generalize (app_nil_end l); intros E.
-  rewrite <- E; auto.
-  intros.
-  injection H.
-  intro.
-  cut (nil = l ++ a0 :: l0); auto.
-  intro.
-  generalize (app_cons_not_nil _ _ _ H1); intro.
-  elim H2.
-Qed.
-
-Lemma app_inj_tail :
- forall (x y:list) (a b:A), x ++ a :: nil = y ++ b :: nil -> x = y /\ a = b.
-Proof.
-  induction x as [| x l IHl];
-   [ destruct y as [| a l] | destruct y as [| a l0] ]; 
-   simpl in |- *; auto.
-  intros a b H.
-  injection H.
-  auto.
-  intros a0 b H.
-  injection H; intros.
-  generalize (app_cons_not_nil _ _ _ H0); destruct 1.
-  intros a b H.
-  injection H; intros.
-  cut (nil = l ++ a :: nil); auto.
-  intro.
-  generalize (app_cons_not_nil _ _ _ H2); destruct 1.
-  intros a0 b H.
-  injection H; intros.
-  destruct (IHl l0 a0 b H0). 
-  split; auto.
-  rewrite <- H1; rewrite <- H2; reflexivity.
-Qed.
-
-(*************************)
 (** Head and tail        *)
 (*************************)
 
@@ -253,6 +152,189 @@ Proof.
   destruct (H a0 a); simpl in |- *; auto.
   destruct IHl; simpl in |- *; auto. 
   right; unfold not in |- *; intros [Hc1| Hc2]; auto.
+Defined.
+
+(**************************)
+(** Nth element of a list *)
+(**************************)
+
+Fixpoint nth (n:nat) (l:list) (default:A) {struct l} : A :=
+  match n, l with
+  | O, x :: l' => x
+  | O, other => default
+  | S m, nil => default
+  | S m, x :: t => nth m t default
+  end.
+
+Fixpoint nth_ok (n:nat) (l:list) (default:A) {struct l} : bool :=
+  match n, l with
+  | O, x :: l' => true
+  | O, other => false
+  | S m, nil => false
+  | S m, x :: t => nth_ok m t default
+  end.
+
+Lemma nth_in_or_default :
+ forall (n:nat) (l:list) (d:A), {In (nth n l d) l} + {nth n l d = d}.
+(* Realizer nth_ok. Program_all. *)
+Proof. 
+  intros n l d; generalize n; induction l; intro n0.
+  right; case n0; trivial.
+  case n0; simpl in |- *.
+  auto.
+  intro n1; elim (IHl n1); auto.     
+Qed.
+
+Lemma nth_S_cons :
+ forall (n:nat) (l:list) (d a:A),
+   In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l).
+Proof. 
+  simpl in |- *; auto.
+Qed.
+
+Fixpoint nth_error (l:list) (n:nat) {struct n} : Exc A :=
+  match n, l with
+  | O, x :: _ => value x
+  | S n, _ :: l => nth_error l n
+  | _, _ => error
+  end.
+
+Definition nth_default (default:A) (l:list) (n:nat) : A :=
+  match nth_error l n with
+  | Some x => x
+  | None => default
+  end.
+
+Lemma nth_In :
+ forall (n:nat) (l:list) (d:A), n < length l -> In (nth n l d) l.
+
+Proof.
+unfold lt in |- *; induction n as [| n hn]; simpl in |- *.
+destruct l; simpl in |- *; [ inversion 2 | auto ].
+destruct l as [| a l hl]; simpl in |- *.
+inversion 2.
+intros d ie; right; apply hn; auto with arith.
+Qed.
+
+Lemma nth_overflow : forall l n d, length l <= n -> nth n l d = d.
+Proof.
+induction l; destruct n; simpl; intros; auto.
+inversion H.
+apply IHl; auto with arith.
+Qed.
+
+Lemma nth_indep : 
+ forall l n d d', n < length l -> nth n l d = nth n l d'.
+Proof.
+induction l; simpl; intros; auto.
+inversion H.
+destruct n; simpl; auto with arith.
+Qed.
+
+
+(*************************)
+(** Concatenation        *)
+(*************************)
+
+Fixpoint app (l m:list) {struct l} : list :=
+  match l with
+  | nil => m
+  | a :: l1 => a :: app l1 m
+  end.
+
+Infix "++" := app (right associativity, at level 60) : list_scope.
+
+Lemma app_nil_end : forall l:list, l = l ++ nil.
+Proof. 
+	induction l; simpl in |- *; auto.
+        rewrite <- IHl; auto.
+Qed.
+Hint Resolve app_nil_end.
+
+Lemma app_ass : forall l m n:list, (l ++ m) ++ n = l ++ m ++ n.
+Proof. 
+	intros. induction l; simpl in |- *; auto.
+        now_show (a :: (l ++ m) ++ n = a :: l ++ m ++ n).
+	rewrite <- IHl; auto.
+Qed.
+Hint Resolve app_ass.
+
+Lemma ass_app : forall l m n:list, l ++ m ++ n = (l ++ m) ++ n.
+Proof. 
+	auto.
+Qed.
+Hint Resolve ass_app.
+
+Lemma app_comm_cons : forall (x y:list) (a:A), a :: x ++ y = (a :: x) ++ y.
+Proof.
+ auto.
+Qed.
+
+Lemma app_eq_nil : forall x y:list, x ++ y = nil -> x = nil /\ y = nil.
+Proof.
+  destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ];
+   simpl in |- *; auto.
+  intros H; discriminate H.
+  intros; discriminate H.
+Qed.
+
+Lemma app_cons_not_nil : forall (x y:list) (a:A), nil <> x ++ a :: y.
+Proof.
+unfold not in |- *.
+  destruct x as [| a l]; simpl in |- *; intros.
+  discriminate H.
+  discriminate H.
+Qed.
+
+Lemma app_eq_unit :
+ forall (x y:list) (a:A),
+   x ++ y = a :: nil -> x = nil /\ y = a :: nil \/ x = a :: nil /\ y = nil.
+
+Proof.
+  destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ];
+   simpl in |- *.
+  intros a H; discriminate H.
+  left; split; auto.
+  right; split; auto.
+  generalize H.
+  generalize (app_nil_end l); intros E.
+  rewrite <- E; auto.
+  intros.
+  injection H.
+  intro.
+  cut (nil = l ++ a0 :: l0); auto.
+  intro.
+  generalize (app_cons_not_nil _ _ _ H1); intro.
+  elim H2.
+Qed.
+
+Lemma app_inj_tail :
+ forall (x y:list) (a b:A), x ++ a :: nil = y ++ b :: nil -> x = y /\ a = b.
+Proof.
+  induction x as [| x l IHl];
+   [ destruct y as [| a l] | destruct y as [| a l0] ]; 
+   simpl in |- *; auto.
+  intros a b H.
+  injection H.
+  auto.
+  intros a0 b H.
+  injection H; intros.
+  generalize (app_cons_not_nil _ _ _ H0); destruct 1.
+  intros a b H.
+  injection H; intros.
+  cut (nil = l ++ a :: nil); auto.
+  intro.
+  generalize (app_cons_not_nil _ _ _ H2); destruct 1.
+  intros a0 b H.
+  injection H; intros.
+  destruct (IHl l0 a0 b H0). 
+  split; auto.
+  rewrite <- H1; rewrite <- H2; reflexivity.
+Qed.
+
+Lemma app_length : forall l l', length (l++l') = length l + length l'.
+Proof.
+induction l; simpl; auto.
 Qed.
 
 Lemma in_app_or : forall (l m:list) (a:A), In a (l ++ m) -> In a l \/ In a m.
@@ -285,6 +367,33 @@ Proof.
 Qed.
 Hint Resolve in_or_app.
 
+Lemma app_nth1 : 
+ forall l l' d n, n < length l -> nth n (l++l') d = nth n l d.
+Proof.
+induction l.
+intros.
+inversion H.
+intros l' d n.
+case n; simpl; auto.
+intros; rewrite IHl; auto with arith.
+Qed.
+
+Lemma app_nth2 : 
+ forall l l' d n, n >= length l -> nth n (l++l') d = nth (n-length l) l' d.
+Proof.
+induction l.
+intros.
+simpl.
+destruct n; auto.
+intros l' d n.
+case n; simpl; auto.
+intros.
+inversion H.
+intros.
+rewrite IHl; auto with arith.
+Qed.
+
+
 (***************************)
 (** Set inclusion on list  *)
 (***************************)
@@ -344,67 +453,7 @@ Proof.
 Qed.
 Hint Resolve incl_app.
 
-(**************************)
-(** Nth element of a list *)
-(**************************)
-
-Fixpoint nth (n:nat) (l:list) (default:A) {struct l} : A :=
-  match n, l with
-  | O, x :: l' => x
-  | O, other => default
-  | S m, nil => default
-  | S m, x :: t => nth m t default
-  end.
-
-Fixpoint nth_ok (n:nat) (l:list) (default:A) {struct l} : bool :=
-  match n, l with
-  | O, x :: l' => true
-  | O, other => false
-  | S m, nil => false
-  | S m, x :: t => nth_ok m t default
-  end.
-
-Lemma nth_in_or_default :
- forall (n:nat) (l:list) (d:A), {In (nth n l d) l} + {nth n l d = d}.
-(* Realizer nth_ok. Program_all. *)
-Proof. 
-  intros n l d; generalize n; induction l; intro n0.
-  right; case n0; trivial.
-  case n0; simpl in |- *.
-  auto.
-  intro n1; elim (IHl n1); auto.     
-Qed.
-
-Lemma nth_S_cons :
- forall (n:nat) (l:list) (d a:A),
-   In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l).
-Proof. 
-  simpl in |- *; auto.
-Qed.
 
-Fixpoint nth_error (l:list) (n:nat) {struct n} : Exc A :=
-  match n, l with
-  | O, x :: _ => value x
-  | S n, _ :: l => nth_error l n
-  | _, _ => error
-  end.
-
-Definition nth_default (default:A) (l:list) (n:nat) : A :=
-  match nth_error l n with
-  | Some x => x
-  | None => default
-  end.
-
-Lemma nth_In :
- forall (n:nat) (l:list) (d:A), n < length l -> In (nth n l d) l.
-
-Proof.
-unfold lt in |- *; induction n as [| n hn]; simpl in |- *.
-destruct l; simpl in |- *; [ inversion 2 | auto ].
-destruct l as [| a l hl]; simpl in |- *.
-inversion 2.
-intros d ie; right; apply hn; auto with arith.
-Qed.
 
 (********************************)
 (** Decidable equality on lists *)
@@ -466,6 +515,72 @@ Proof.
  rewrite IHl; auto.
 Qed.
 
+Lemma In_rev : forall l x, In x l <-> In x (rev l).
+Proof.
+induction l.
+simpl; intuition.
+intros.
+simpl.
+intuition.
+subst.
+apply in_or_app; right; simpl; auto.
+apply in_or_app; left; firstorder.
+destruct (in_app_or _ _ _ H); firstorder.
+Qed.
+
+Lemma rev_length : forall l, length (rev l) = length l.
+Proof.
+induction l;simpl; auto.
+rewrite app_length.
+rewrite IHl.
+simpl.
+elim (length l); simpl; auto.
+Qed.
+
+Lemma rev_nth : forall l d n,  n < length l ->  
+ nth n (rev l) d = nth (length l - S n) l d.
+Proof.
+induction l.
+intros; inversion H.
+intros.
+simpl in H.
+simpl (rev (a :: l)).
+simpl (length (a :: l) - S n).
+inversion H.
+rewrite <- minus_n_n; simpl.
+rewrite <- rev_length.
+rewrite app_nth2; auto.
+rewrite <- minus_n_n; auto.
+rewrite app_nth1; auto.
+rewrite (minus_plus_simpl_l_reverse (length l) n 1).
+replace (1 + length l) with (S (length l)); auto with arith.
+rewrite <- minus_Sn_m; auto with arith; simpl.
+apply IHl; auto.
+rewrite rev_length; auto.
+Qed.
+
+(****************************************************)
+(**  An alternative tail-recursive definition for reverse *) 
+(****************************************************)
+
+Fixpoint rev_acc (l l': list) {struct l} : list := 
+ match l with 
+  | nil => l' 
+  | a::l => rev_acc l (a::l')
+ end.
+
+Lemma rev_acc_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.
+Proof.
+intros; rewrite rev_acc_rev.
+apply app_nil_end.
+Qed.
+
 (*********************************************)
 (**  Reverse Induction Principle on Lists    *)
 (*********************************************)
@@ -503,9 +618,119 @@ Qed.
 
 End Reverse_Induction.
 
+(***************************)
+(** Last elements of a list *)
+(***************************)
+
+(** [last l d] returns the last elements of the list [l], 
+    or the default value [d] if [l] is empty. *)
+
+Fixpoint last (l:list)(d:A)  {struct l} : A := 
+ match l with 
+  | nil => d 
+  | a :: nil => a 
+  | a :: l => last l d
+ end.
+
+(** [removelast l] remove the last element of [l] *)
+
+Fixpoint removelast (l:list) {struct l} : list := 
+ match l with 
+  | nil =>  nil 
+  | a :: nil => nil 
+  | a :: l => a :: removelast l
+ end.
+
+Lemma app_removelast_last : 
+ forall l d, l<>nil -> l = removelast l ++ (last l d :: nil).
+Proof.
+induction l.
+destruct 1; auto.
+intros d _.
+destruct l; auto.
+pattern (a0::l) at 1; rewrite IHl with d; auto; discriminate.
+Qed.
+
+Lemma exists_last : 
+ forall l, l<>nil -> { l' : list & { a : A | l = l'++a::nil}}. 
+Proof. 
+induction l.
+destruct 1; auto.
+intros _.
+destruct l.
+exists nil; exists a; auto.
+destruct IHl as [l' (a',H)]; try discriminate.
+rewrite H.
+exists (a::l'); exists a'; auto.
+Qed.
+
+(********************************)
+(* Cutting a list at some position *)
+(********************************)
+
+Fixpoint firstn (n:nat)(l:list) {struct n} : list := 
+ match n with 
+  | 0 => nil 
+  | S n => match l with  
+       | nil => nil 
+       | a::l => a::(firstn n l)
+   end
+  end.
+
+Fixpoint skipn (n:nat)(l:list) { struct n } : list := 
+  match n with 
+   | 0 => l 
+   | S n => match l with 
+        | nil => nil 
+        | a::l => skipn n l
+    end
+  end.
+
+Lemma firstn_skipn : forall n l, firstn n l ++ skipn n l = l.
+Proof.
+induction n.
+simpl; auto.
+destruct l; simpl; auto.
+f_equal; auto.
+Qed.
+
+(**************)
+(** Remove *)
+(**************)
+
+Section Remove.
+
+Hypothesis eq_dec : forall x y : A, {x = y}+{x <> y}.
+
+Fixpoint remove (x : A) (l : list){struct l} : list :=
+  match l with
+    | nil => nil
+    | y::tl => if (eq_dec x y) then remove x tl else y::(remove x tl)
+  end.
+
+End Remove.
+
+(***************************)
+(** List without redundancy *)
+(***************************)
+
+Inductive NoDup : list -> Prop := 
+ | NoDup_nil : NoDup nil 
+ | NoDup_cons : forall x l, ~ In x l -> NoDup l -> NoDup (x::l). 
+
 End Lists.
 
+(** Exporting list notations and hints *)
+
 Implicit Arguments nil [A].
+Infix "::" := cons (at level 60, right associativity) : list_scope.
+Infix "++" := app (right associativity, at level 60) : list_scope.
+
+Open Scope list_scope.
+
+Delimit Scope list_scope with list.
+
+Bind Scope list_scope with list.
 
 Hint Resolve nil_cons app_nil_end ass_app app_ass: datatypes v62.
 Hint Resolve app_comm_cons app_cons_not_nil: datatypes v62.
@@ -523,40 +748,241 @@ Section Functions_on_lists.
 (** Some generic functions on lists and basic functions of them *)
 (****************************************************************)
 
+(*********)
+(** Map *)
+(*********)
+
 Section Map.
 Variables A B : Set.
 Variable f : A -> B.
+
 Fixpoint map (l:list A) : list B :=
   match l with
   | nil => nil
   | cons a t => cons (f a) (map t)
   end.
-End Map.
 
 Lemma in_map :
- forall (A B:Set) (f:A -> B) (l:list A) (x:A), In x l -> In (f x) (map f l).
+ forall (l:list A) (x:A), In x l -> In (f x) (map l).
 Proof. 
   induction l as [| a l IHl]; simpl in |- *;
    [ auto
    | destruct 1; [ left; apply f_equal with (f := f); assumption | auto ] ].
 Qed.
 
-Fixpoint flat_map (A B:Set) (f:A -> list B) (l:list A) {struct l} : 
+Lemma in_map_iff : forall l y, In y (map l) <-> exists x, f x = y /\ In x l.
+Proof.
+induction l; firstorder (subst; auto).
+Qed.
+
+Lemma map_length : forall l, length (map l) = length l.
+Proof.
+induction l; simpl; auto.
+Qed.
+
+Lemma map_nth : forall l d n, 
+ nth n (map l) (f d) = f (nth n l d).
+Proof.
+induction l; simpl map; destruct n; firstorder.
+Qed.
+
+Lemma map_app : forall l l',  
+ map (l++l') = (map l)++(map l').
+Proof. 
+induction l; simpl; auto.
+intros; rewrite IHl; auto.
+Qed.
+
+Lemma map_rev : forall l, map (rev l) = rev (map l).
+Proof. 
+induction l; simpl; auto.
+rewrite map_app.
+rewrite IHl; auto.
+Qed.
+
+End Map. 
+
+Lemma map_map : forall (A B C:Set)(f:A->B)(g:B->C) l, 
+  map g (map f l) = map (fun x => g (f x)) l.
+Proof.
+induction l; simpl; auto.
+rewrite IHl; auto.
+Qed.
+
+Lemma map_ext : 
+ forall (A B : Set)(f g:A->B), (forall a, f a = g a) -> forall l, map f l = map g l.
+Proof.
+induction l; simpl; auto.
+rewrite H; rewrite IHl; auto.
+Qed.
+
+(********************************************)
+(** Operations on lists of pairs or lists of lists *)
+(********************************************)
+
+Section ListPairs.
+Variable A B : Set.
+
+(** [split] derives two lists from a list of pairs *)
+
+Fixpoint split  (l:list (A*B)) { struct l }: list A * list B :=
+  match l with
+    | nil => (nil, nil)
+    | (x,y) :: tl => let (g,d) := split tl in (x::g, y::d)
+  end.
+
+Lemma in_split_l : forall (l:list (A*B))(p:A*B), 
+  In p l -> In (fst p) (fst (split l)). 
+Proof.
+induction l; simpl; intros; auto.
+destruct p; destruct a; destruct (split l); simpl in *.
+destruct H.
+injection H; auto.
+right; apply (IHl (a0,b) H).
+Qed.
+
+Lemma in_split_r : forall (l:list (A*B))(p:A*B), 
+  In p l -> In (snd p) (snd (split l)). 
+Proof.
+induction l; simpl; intros; auto.
+destruct p; destruct a; destruct (split l); simpl in *.
+destruct H.
+injection H; auto.
+right; apply (IHl (a0,b) H).
+Qed.
+
+Lemma split_nth : forall (l:list (A*B))(n:nat)(d:A*B), 
+ nth n l d = (nth n (fst (split l)) (fst d), nth n (snd (split l)) (snd d)).
+Proof.
+induction l.
+destruct n; destruct d; simpl; auto.
+destruct n; destruct d; simpl; auto.
+destruct a; destruct (split l); simpl; auto.
+destruct a; destruct (split l); simpl in *; auto.
+rewrite IHl; simpl; auto.
+Qed.
+
+Lemma split_lenght_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)),
+  length (snd (split l)) = length l. 
+Proof.
+induction l; simpl; auto.
+destruct a; destruct (split l); simpl; auto.
+Qed.
+
+(** [combine] is the opposite of [split]. 
+    Lists given to [combine] are meant to be of same length. 
+    If not, [combine] stops on the shorter list *)
+
+Fixpoint combine (l : list A) (l' : list B){struct l} : list (A*B) :=
+  match l,l' with
+    | x::tl, y::tl' => (x,y)::(combine tl tl')
+    | _, _ => nil
+  end.
+
+Lemma split_combine : forall (l: list (A*B)), 
+  let (l1,l2) := split l in combine l1 l2 = l.
+Proof.
+induction l.
+simpl; auto.
+destruct a; simpl. 
+destruct (split l); simpl in *.
+f_equal; auto.
+Qed.
+
+Lemma combine_split : forall (l:list A)(l':list B), length l = length l' -> 
+ split (combine l l') = (l,l').
+Proof.
+induction l; destruct l'; simpl; intros; auto; try discriminate.
+injection H; clear H; intros.
+rewrite IHl; auto.
+Qed.
+
+Lemma in_combine_l : forall (l:list A)(l':list B)(x:A)(y:B), 
+ In (x,y) (combine l l') -> In x l.
+Proof.
+induction l.
+simpl; auto.
+destruct l'; simpl; auto; intros.
+contradiction. 
+destruct H.
+injection H; auto.
+right; apply IHl with l' y; auto.
+Qed.
+
+Lemma in_combine_r : forall (l:list A)(l':list B)(x:A)(y:B), 
+ In (x,y) (combine l l') -> In y l'.
+Proof.
+induction l.
+simpl; intros; contradiction.
+destruct l'; simpl; auto; intros.
+destruct H.
+injection H; auto.
+right; apply IHl with x; auto.
+Qed.
+
+Lemma combine_length : forall (l:list A)(l':list B), 
+  length (combine l l') = min (length l) (length l').
+Proof.
+induction l.
+simpl; auto.
+destruct l'; simpl; auto.
+Qed.
+
+Lemma combine_nth : forall (l:list A)(l':list B)(n:nat)(x:A)(y:B), 
+ length l = length l' -> 
+ nth n (combine l l') (x,y) = (nth n l x, nth n l' y).
+Proof.
+induction l; destruct l'; intros; try discriminate.
+destruct n; simpl; auto.
+destruct n; simpl in *; auto.
+Qed.
+
+(** [flat_map] *)
+
+Fixpoint flat_map (f:A -> list B) (l:list A) {struct l} : 
  list B :=
   match l with
   | nil => nil
-  | cons x t => app (f x) (flat_map f t)
+  | cons x t => (f x)++(flat_map f t)
   end.
 
-Fixpoint list_prod (A B:Set) (l:list A) (l':list B) {struct l} :
+Lemma in_flat_map : forall (f:A->list B)(l:list A)(y:B),
+ In y (flat_map f l) <-> exists x, In x l /\ In y (f x). 
+Proof.
+induction l; simpl; split; intros.
+contradiction.
+destruct H as (x,(H,_)); contradiction.
+destruct (in_app_or _ _ _ H).
+exists a; auto.
+destruct (IHl y) as (H1,_); destruct (H1 H0) as (x,(H2,H3)).
+exists x; auto.
+apply in_or_app.
+destruct H as (x,(H0,H1)); destruct H0.
+subst; auto.
+right; destruct (IHl y) as (_,H2); apply H2.
+exists x; auto.
+Qed.
+
+(** [list_prod] has the same signature as [combine], but unlike
+   [combine], it adds every possible pairs, not only those at the 
+   same position. *)
+
+Fixpoint list_prod (l:list A) (l':list B) {struct l} :
  list (A * B) :=
   match l with
   | nil => nil
-  | cons x t => app (map (fun y:B => (x, y)) l') (list_prod t l')
+  | cons x t => (map (fun y:B => (x, y)) l')++(list_prod t l')
   end.
 
 Lemma in_prod_aux :
- forall (A B:Set) (x:A) (y:B) (l:list B),
+ forall (x:A) (y:B) (l:list B),
    In y l -> In (x, y) (map (fun y0:B => (x, y0)) l).
 Proof. 
   induction l;
@@ -566,7 +992,7 @@ Proof.
 Qed.
 
 Lemma in_prod :
- forall (A B:Set) (l:list A) (l':list B) (x:A) (y:B),
+ forall (l:list A) (l':list B) (x:A) (y:B),
    In x l -> In y l' -> In (x, y) (list_prod l l').
 Proof. 
   induction l;
@@ -575,10 +1001,36 @@ Proof.
       [ left; rewrite H; apply in_prod_aux; assumption | right; auto ] ].
 Qed.
 
+Lemma in_prod_iff : 
+ forall (l:list A)(l':list B)(x:A)(y:B), 
+  In (x,y) (list_prod l l') <-> In x l /\ In y l'.
+Proof.
+split; [ | intros; apply in_prod; intuition ].
+induction l; simpl; intros.
+intuition.
+destruct (in_app_or _ _ _ H); clear H.
+destruct (in_map_iff (fun y : B => (a, y)) l' (x,y)) as (H1,_).
+destruct (H1 H0) as (z,(H2,H3)); clear H0 H1.
+injection H2; clear H2; intros; subst; intuition.
+intuition.
+Qed. 
+
+Lemma prod_length : forall (l:list A)(l':list B), 
+  length (list_prod l l') = (length l) * (length l').
+Proof.
+induction l; simpl; auto.
+intros.
+rewrite app_length.
+rewrite map_length.
+auto.
+Qed.
+
+End ListPairs.
+
 (** [(list_power x y)] is [y^x], or the set of sequences of elts of [y]
     indexed by elts of [x], sorted in lexicographic order. *)
 
-Fixpoint list_power (A B:Set) (l:list A) (l':list B) {struct l} :
+Fixpoint list_power (A B:Set)(l:list A) (l':list B) {struct l} :
  list (list (A * B)) :=
   match l with
   | nil => cons nil nil
@@ -594,13 +1046,37 @@ Fixpoint list_power (A B:Set) (l:list A) (l':list B) {struct l} :
 Section Fold_Left_Recursor.
 Variables A B : Set.
 Variable f : A -> B -> A.
+
 Fixpoint fold_left (l:list B) (a0:A) {struct l} : A :=
   match l with
   | nil => a0
   | cons b t => fold_left t (f a0 b)
   end.
+
+Lemma fold_left_app : forall (l l':list B)(i:A), 
+ fold_left (l++l') i = fold_left l' (fold_left l i).
+Proof.
+induction l. 
+simpl; auto.
+intros.
+simpl.
+auto.
+Qed.
+
 End Fold_Left_Recursor.
 
+Lemma fold_left_length : 
+ forall (A:Set)(l:list A), fold_left (fun x _ => S x) l 0 = length l.
+Proof.
+intro A.
+cut (forall (l:list A) n, fold_left (fun x _ => S x) l n = n + length l).
+intros.
+exact (H l 0).
+induction l; simpl; auto.
+intros; rewrite IHl.
+simpl; auto with arith.
+Qed.
+
 (************************************)
 (** Right-to-left iterator on lists *)
 (************************************)
@@ -609,13 +1085,34 @@ Section Fold_Right_Recursor.
 Variables A B : Set.
 Variable f : B -> A -> A.
 Variable a0 : A.
+
 Fixpoint fold_right (l:list B) : A :=
   match l with
   | nil => a0
   | cons b t => f b (fold_right t)
   end.
+
 End Fold_Right_Recursor.
 
+Lemma fold_right_app : forall (A B:Set)(f:A->B->B) l l' i, 
+  fold_right f i (l++l') = fold_right f (fold_right f i l') l.
+Proof.
+induction l.
+simpl; auto.
+simpl; intros.
+f_equal; auto.
+Qed.
+
+Lemma fold_left_rev_right : forall (A B:Set)(f:A->B->B) l i, 
+  fold_right f i (rev l) = fold_left (fun x y => f y x) l i.
+Proof.
+induction l.
+simpl; auto.
+intros.
+simpl.
+rewrite fold_right_app; simpl; auto.
+Qed.
+
 Theorem fold_symmetric :
  forall (A:Set) (f:A -> A -> A),
    (forall x y z:A, f x (f y z) = f (f x y) z) ->
@@ -638,18 +1135,157 @@ rewrite IHl.
 reflexivity.
 Qed.
 
-End Functions_on_lists.
+(********************************)
+(** Boolean operations over lists *)
+(********************************)
 
+Section Bool. 
+Variable A : Set.
+Variable f : A -> bool.
 
-(** Exporting list notations *)
+(** find whether a boolean function can be satisfied by an 
+     elements of the list. *)
 
-Infix "::" := cons (at level 60, right associativity) : list_scope.
+Fixpoint existsb (l:list A) {struct l}: bool := 
+ match l with 
+    | nil => false
+    | a::l => f a || existsb l
+ end.
 
-Infix "++" := app (right associativity, at level 60) : list_scope.
+Lemma existsb_exists : 
+ forall l, existsb l = true <-> exists x, In x l /\ f x = true.
+Proof.
+induction l; simpl; intuition.
+inversion H.
+firstorder.
+destruct (orb_prop _ _ H1); firstorder.
+firstorder.
+subst.
+rewrite H2; auto.
+Qed.
 
-Open Scope list_scope.
+Lemma existsb_nth : forall l n d, n < length l ->
+  existsb l = false -> f (nth n l d) = false.
+Proof.
+induction l.
+inversion 1.
+simpl; intros.
+destruct (orb_false_elim _ _ H0); clear H0; auto.
+destruct n ; auto. 
+rewrite IHl; auto with arith.
+Qed.
 
-(** Declare Scope list_scope with key list *)
-Delimit Scope list_scope with list.
+(** find whether a boolean function is satisfied by 
+  all the elements of a list. *)
 
-Bind Scope list_scope with list.
+Fixpoint forallb (l:list A) {struct l} : bool := 
+ match l with 
+    | nil => true
+    | a::l => f a && forallb l
+ end.
+
+Lemma forallb_forall : 
+ forall l, forallb l = true <-> (forall x, In x l -> f x = true).
+Proof.
+induction l; simpl; intuition.
+destruct (andb_prop _ _ H1).
+congruence.
+destruct (andb_prop _ _ H1); auto.
+assert (forallb l = true).
+apply H0; intuition.
+rewrite H1; auto. 
+Qed.
+
+(** [filter] *)
+
+Fixpoint filter (l:list A) : list A := 
+ match l with 
+  | nil => nil
+  | x :: l => if f x then x::(filter l) else filter l
+ end.
+
+Lemma filter_In : forall x l, In x (filter l) <-> In x l /\ f x = true.
+Proof.
+induction l; simpl.
+intuition.
+intros.
+case_eq (f a); intros; simpl; intuition congruence.
+Qed.
+
+(** [find] *)
+
+Fixpoint find (l:list A) : option A :=
+  match l with
+    | nil => None
+    | x :: tl => if f x then Some x else find tl
+  end.
+
+(** [partition] *)
+
+Fixpoint partition (l:list A) {struct l} : list A * list A := 
+  match l with
+    | nil => (nil, nil)
+    | x :: tl => let (g,d) := partition tl in 
+      if f x then (x::g,d) else (g,x::d)
+  end.
+
+End Bool.
+
+
+(*********************************)
+(** Sequence of natural numbers *)
+(*********************************)
+
+(** [seq] computes the sequence of [len] contiguous integers 
+    that starts at [start]. For instance, [seq 2 3] is [2::3::4::nil]. *)
+
+Fixpoint seq (start len:nat) {struct len} : list nat := 
+ match len with 
+  | 0 => nil
+  | S len => start :: seq (S start) len
+ end. 
+
+Lemma seq_length : forall len start, length (seq start len) = len.
+Proof.
+induction len; simpl; auto.
+Qed.
+
+Lemma seq_nth : forall len start n d, 
+  n < len -> nth n (seq start len) d = start+n.
+Proof.
+induction len; intros.
+inversion H.
+simpl seq.
+destruct n; simpl.
+auto with arith.
+rewrite IHlen;simpl; auto with arith.
+Qed.
+
+Lemma seq_shift : forall len start,
+ map S (seq start len) = seq (S start) len.
+Proof. 
+induction len; simpl; auto.
+intros.
+rewrite IHlen.
+auto with arith.
+Qed.
+
+End Functions_on_lists.
+
+
+Hint Rewrite 
+ rev_involutive (* rev (rev l) = l *)
+ rev_unit (* rev (l ++ a :: nil) = a :: rev l *)
+ map_nth (* nth n (map f l) (f d) = f (nth n l d) *)
+ map_length (* length (map f l) = length l *)
+ seq_length (* length (seq start len) = len *)
+ app_length (* length (l ++ l') = length l + length l' *)
+ rev_length (* length (rev l) = length l *)
+ : list.
+
+Hint Rewrite <- 
+ app_nil_end (* l = l ++ nil *)
+ : list.
+
+Ltac simpl_list := autorewrite with list.
+Ltac ssimpl_list := autorewrite with list using simpl.
diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v
index d5ecad9c..4e009ed5 100644
--- a/theories/Lists/ListSet.v
+++ b/theories/Lists/ListSet.v
@@ -6,14 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ListSet.v,v 1.13.2.1 2004/07/16 19:31:05 herbelin Exp $ i*)
+(*i $Id: ListSet.v 6844 2005-03-16 13:09:55Z herbelin $ i*)
 
-(** A Library for finite sets, implemented as lists 
-    A Library with similar interface will soon be available under
-    the name TreeSet in the theories/Trees directory *)
+(** A Library for finite sets, implemented as lists *)
 
-(** PolyList is loaded, but not exported.
-    This allow to "hide" the definitions, functions and theorems of PolyList
+(** List is loaded, but not exported.
+    This allow to "hide" the definitions, functions and theorems of List
     and to see only the ones of ListSet *)
 
 Require Import List.
@@ -395,4 +393,4 @@ Section other_definitions.
  
 End other_definitions.
 
-Unset Implicit Arguments.
\ No newline at end of file
+Unset Implicit Arguments.
diff --git a/theories/Lists/MonoList.v b/theories/Lists/MonoList.v
index d639a39d..aa2b74dd 100755..100644
--- a/theories/Lists/MonoList.v
+++ b/theories/Lists/MonoList.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: MonoList.v,v 1.2.2.1 2004/07/16 19:31:05 herbelin Exp $ i*)
+(*i $Id: MonoList.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***)
 
diff --git a/theories/Lists/SetoidList.v b/theories/Lists/SetoidList.v
new file mode 100644
index 00000000..811dcab4
--- /dev/null
+++ b/theories/Lists/SetoidList.v
@@ -0,0 +1,300 @@
+(***********************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
+(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
+(*   \VV/  *************************************************************)
+(*    //   *      This file is distributed under the terms of the      *)
+(*         *       GNU Lesser General Public License Version 2.1       *)
+(***********************************************************************)
+
+(* $Id: SetoidList.v 8686 2006-04-06 13:25:10Z letouzey $ *)
+
+Require Export List.
+Require Export Sorting.
+Require Export Setoid.
+Set Implicit Arguments.
+Unset Strict Implicit.
+
+(** * Logical relations over lists with respect to a setoid equality 
+      or ordering. *) 
+
+(** This can be seen as a complement of predicate [lelistA] and [sort] 
+    found in [Sorting]. *)
+
+Section Type_with_equality.
+Variable A : Set.
+Variable eqA : A -> A -> Prop. 
+
+(** Being in a list modulo an equality relation over type [A]. *)
+
+Inductive InA (x : A) : list A -> Prop :=
+  | InA_cons_hd : forall y l, eqA x y -> InA x (y :: l)
+  | InA_cons_tl : forall y l, InA x l -> InA x (y :: l).
+
+Hint Constructors InA.
+
+(** An alternative definition of [InA]. *)
+
+Lemma InA_alt : forall x l, InA x l <-> exists y, eqA x y /\ In y l.
+Proof. 
+ induction l; intuition.
+ inversion H.
+ firstorder.
+ inversion H1; firstorder.
+ firstorder; subst; auto.
+Qed.
+
+(** A list without redundancy modulo the equality over [A]. *)
+
+Inductive NoDupA : list A -> Prop :=
+  | NoDupA_nil : NoDupA nil
+  | NoDupA_cons : forall x l, ~ InA x l -> NoDupA l -> NoDupA (x::l).
+
+Hint Constructors NoDupA.
+
+(** lists with same elements modulo [eqA] *)
+
+Definition eqlistA l l' := forall x, InA x l <-> InA x l'.
+
+(** Results concerning lists modulo [eqA] *)
+
+Hypothesis eqA_refl : forall x, eqA x x.
+Hypothesis eqA_sym : forall x y, eqA x y -> eqA y x.
+Hypothesis eqA_trans : forall x y z, eqA x y -> eqA y z -> eqA x z.
+
+Hint Resolve eqA_refl eqA_trans.
+Hint Immediate eqA_sym.
+
+Lemma InA_eqA : forall l x y, eqA x y -> InA x l -> InA y l.
+Proof. 
+ intros s x y.
+ do 2 rewrite InA_alt.
+ intros H (z,(U,V)).  
+ exists z; split; eauto.
+Qed.
+Hint Immediate InA_eqA.
+
+Lemma In_InA : forall l x, In x l -> InA x l.
+Proof.
+ simple induction l; simpl in |- *; intuition.
+ subst; auto.  
+Qed.
+Hint Resolve In_InA.
+
+(** Results concerning lists modulo [eqA] and [ltA] *)
+
+Variable ltA : A -> A -> Prop.
+
+Hypothesis ltA_trans : forall x y z, ltA x y -> ltA y z -> ltA x z.
+Hypothesis ltA_not_eqA : forall x y, ltA x y -> ~ eqA x y.
+Hypothesis ltA_eqA : forall x y z, ltA x y -> eqA y z -> ltA x z.
+Hypothesis eqA_ltA : forall x y z, eqA x y -> ltA y z -> ltA x z.
+
+Hint Resolve ltA_trans.
+Hint Immediate ltA_eqA eqA_ltA.
+
+Notation InfA:=(lelistA ltA).
+Notation SortA:=(sort ltA).
+
+Lemma InfA_ltA :
+ forall l x y, ltA x y -> InfA y l -> InfA x l.
+Proof.
+ intro s; case s; constructor; inversion_clear H0.
+ eapply ltA_trans; eauto.
+Qed.
+ 
+Lemma InfA_eqA :
+ forall l x y, eqA x y -> InfA y l -> InfA x l.
+Proof.
+ intro s; case s; constructor; inversion_clear H0; eauto.
+Qed.
+Hint Immediate InfA_ltA InfA_eqA. 
+
+Lemma SortA_InfA_InA :
+ forall l x a, SortA l -> InfA a l -> InA x l -> ltA a x.
+Proof. 
+ simple induction l.
+ intros; inversion H1.
+ intros.
+ inversion_clear H0; inversion_clear H1; inversion_clear H2.
+ eapply ltA_eqA; eauto.
+ eauto.
+Qed.
+  
+Lemma In_InfA :
+ forall l x, (forall y, In y l -> ltA x y) -> InfA x l.
+Proof.
+ simple induction l; simpl in |- *; intros; constructor; auto.
+Qed.
+ 
+Lemma InA_InfA :
+ forall l x, (forall y, InA y l -> ltA x y) -> InfA x l.
+Proof.
+ simple induction l; simpl in |- *; intros; constructor; auto.
+Qed.
+
+(* In fact, this may be used as an alternative definition for InfA: *)
+
+Lemma InfA_alt : 
+ forall l x, SortA l -> (InfA x l <-> (forall y, InA y l -> ltA x y)).
+Proof. 
+split.
+intros; eapply SortA_InfA_InA; eauto.
+apply InA_InfA.
+Qed.
+
+Lemma SortA_NoDupA : forall l, SortA l -> NoDupA l.
+Proof.
+ simple induction l; auto.
+ intros x l' H H0.
+ inversion_clear H0.
+ constructor; auto.  
+ intro.
+ assert (ltA x x) by eapply SortA_InfA_InA; eauto.
+ elim (ltA_not_eqA H3); auto.
+Qed.
+
+Lemma NoDupA_app : forall l l', NoDupA l -> NoDupA l' -> 
+  (forall x, InA x l -> InA x l' -> False) -> 
+  NoDupA (l++l').
+Proof.
+induction l; simpl; auto; intros.
+inversion_clear H.
+constructor.
+rewrite InA_alt; intros (y,(H4,H5)).
+destruct (in_app_or _ _ _ H5).
+elim H2.
+rewrite InA_alt.
+exists y; auto.
+apply (H1 a).
+auto.
+rewrite InA_alt.
+exists y; auto.
+apply IHl; auto.
+intros.
+apply (H1 x); auto.
+Qed.
+
+
+Lemma NoDupA_rev : forall l, NoDupA l -> NoDupA (rev l).
+Proof.
+induction l.
+simpl; auto.
+simpl; intros.
+inversion_clear H.
+apply NoDupA_app; auto.
+constructor; auto.
+intro H2; inversion H2.
+intros x.
+rewrite InA_alt.
+intros (x1,(H2,H3)).
+inversion_clear 1.
+destruct H0.
+apply InA_eqA with x1; eauto.
+apply In_InA.
+rewrite In_rev; auto.
+inversion H4.
+Qed.
+
+
+Lemma InA_app : forall l1 l2 x,
+ InA x (l1 ++ l2) -> InA x l1 \/ InA x l2.
+Proof.
+ induction l1; simpl in *; intuition.
+ inversion_clear H; auto.
+ elim (IHl1 l2 x H0); auto.
+Qed.
+
+ Hint Constructors lelistA sort.
+
+Lemma InfA_app : forall l1 l2 a, InfA a l1 -> InfA a l2 -> InfA a (l1++l2).
+Proof.
+ induction l1; simpl; auto.
+ inversion_clear 1; auto.
+Qed.
+
+Lemma SortA_app :
+ forall l1 l2, SortA l1 -> SortA l2 ->
+ (forall x y, InA x l1 -> InA y l2 -> ltA x y) ->
+ SortA (l1 ++ l2).
+Proof.
+ induction l1; simpl in *; intuition.
+ inversion_clear H.
+ constructor; auto.
+ apply InfA_app; auto.
+ destruct l2; auto.
+Qed.
+
+Section Remove.
+
+Hypothesis eqA_dec : forall x y : A, {eqA x y}+{~(eqA x y)}.
+
+Fixpoint removeA (x : A) (l : list A){struct l} : list A :=
+  match l with
+    | nil => nil
+    | y::tl => if (eqA_dec x y) then removeA x tl else y::(removeA x tl)
+  end.
+
+Lemma removeA_filter : forall x l, 
+  removeA x l = filter (fun y => if eqA_dec x y then false else true) l.
+Proof.
+induction l; simpl; auto.
+destruct (eqA_dec x a); auto.
+rewrite IHl; auto.
+Qed.
+
+Lemma removeA_InA : forall l x y, InA y (removeA x l) <-> InA y l /\ ~eqA x y.
+Proof.
+induction l; simpl; auto.
+split.
+inversion_clear 1.
+destruct 1; inversion_clear H.
+intros.
+destruct (eqA_dec x a); simpl; auto.
+rewrite IHl; split; destruct 1; split; auto.
+inversion_clear H; auto.
+destruct H0; apply eqA_trans with a; auto.
+split.
+inversion_clear 1.
+split; auto.
+swap n.
+apply eqA_trans with y; auto.
+rewrite (IHl x y) in H0; destruct H0; auto.
+destruct 1; inversion_clear H; auto.
+constructor 2; rewrite IHl; auto.
+Qed.
+
+Lemma removeA_NoDupA :
+  forall s x, NoDupA s ->  NoDupA (removeA x s).
+Proof.
+simple induction s; simpl; intros.
+auto.
+inversion_clear H0.
+destruct (eqA_dec x a); simpl; auto. 
+constructor; auto.
+rewrite removeA_InA.
+intuition.
+Qed. 
+
+Lemma removeA_eqlistA : forall l l' x, 
+  ~InA x l -> eqlistA (x :: l) l' -> eqlistA l (removeA x l').
+Proof.  
+unfold eqlistA; intros. 
+rewrite removeA_InA.
+split; intros.
+rewrite <- H0; split; auto.
+swap H.
+apply InA_eqA with x0; auto.
+rewrite <- (H0 x0) in H1.
+destruct H1.
+inversion_clear H1; auto.
+elim H2; auto.
+Qed.
+
+End Remove.
+
+End Type_with_equality.
+
+Hint Constructors InA.
+Hint Constructors NoDupA. 
+Hint Constructors sort.
+Hint Constructors lelistA.
diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v
index 3c433ba2..7bc6a09d 100755..100644
--- a/theories/Lists/Streams.v
+++ b/theories/Lists/Streams.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Streams.v,v 1.15.2.1 2004/07/16 19:31:05 herbelin Exp $ i*)
+(*i $Id: Streams.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Set Implicit Arguments.
 
@@ -71,9 +71,8 @@ Qed.
 
 (** Extensional Equality between two streams  *)
 
-CoInductive EqSt : Stream -> Stream -> Prop :=
+CoInductive EqSt (s1 s2: Stream) : Prop :=
     eqst :
-      forall s1 s2:Stream,
         hd s1 = hd s2 -> EqSt (tl s1) (tl s2) -> EqSt s1 s2.
 
 (** A coinduction principle *)
@@ -140,12 +139,12 @@ Inductive Exists : Stream -> Prop :=
   | Further : forall x:Stream, ~ P x -> Exists (tl x) -> Exists x.
 i*)
 
-Inductive Exists : Stream -> Prop :=
-  | Here : forall x:Stream, P x -> Exists x
-  | Further : forall x:Stream, Exists (tl x) -> Exists x.
+Inductive Exists ( x: Stream ) : Prop :=
+  | Here : P x -> Exists x
+  | Further : Exists (tl x) -> Exists x.
 
-CoInductive ForAll : Stream -> Prop :=
-    HereAndFurther : forall x:Stream, P x -> ForAll (tl x) -> ForAll x.
+CoInductive ForAll (x: Stream) : Prop :=
+    HereAndFurther : P x -> ForAll (tl x) -> ForAll x.
 
 
 Section Co_Induction_ForAll.
diff --git a/theories/Lists/TheoryList.v b/theories/Lists/TheoryList.v
index fbeb97ce..19f97aec 100755..100644
--- a/theories/Lists/TheoryList.v
+++ b/theories/Lists/TheoryList.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: TheoryList.v,v 1.15.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: TheoryList.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Some programs and results about lists following CAML Manual *)
 
diff --git a/theories/Lists/intro.tex b/theories/Lists/intro.tex
index 344bba59..c45f8803 100755
--- a/theories/Lists/intro.tex
+++ b/theories/Lists/intro.tex
@@ -4,21 +4,24 @@ This library includes the following files:
 
 \begin{itemize}
 
-\item {\tt List.v} THIS OLD LIBRARY IS HERE ONLY FOR COMPATIBILITY
-  WITH OLDER VERSIONS OF COQS. THE USER SHOULD USE POLYLIST INSTEAD.
-
-\item {\tt PolyList.v} contains definitions of (polymorphic) lists, 
+\item {\tt List.v} contains definitions of (polymorphic) lists, 
   functions on lists such as head, tail, map, append and prove some
   properties of these functions. Implicit arguments are used in this
-  library, so you should read the Referance Manual about implicit
+  library, so you should read the Reference Manual about implicit
   arguments before using it.
 
+\item {\tt ListSet.v} contains definitions and properties of finite
+  sets, implemented as lists.
+
 \item {\tt TheoryList.v} contains complementary results on lists. Here
-  a more theoric point of view is assumed : one extracts functions
+  a more theoretic point of view is assumed : one extracts functions
   from propositions, rather than defining functions and then prove them.
 
 \item {\tt Streams.v} defines the type of infinite lists (streams). It is a
   coinductive type. Basic facts are stated and proved. The streams are
   also polymorphic.
 
+\item {\tt MonoList.v} THIS OLD LIBRARY IS HERE ONLY FOR COMPATIBILITY
+  WITH OLDER VERSIONS OF COQ. THE USER SHOULD USE {\tt List.v} INSTEAD.
+
 \end{itemize}
diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v
index 0fe8a87d..9eaef07a 100644
--- a/theories/Logic/Berardi.v
+++ b/theories/Logic/Berardi.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Berardi.v,v 1.5.2.2 2004/08/03 17:42:43 herbelin Exp $ i*)
+(*i $Id: Berardi.v 8122 2006-03-04 19:26:40Z herbelin $ i*)
 
 (** This file formalizes Berardi's paradox which says that in
    the calculus of constructions, excluded middle (EM) and axiom of
@@ -92,14 +92,10 @@ End Retracts.
 Lemma L1 : forall A B:Prop, retract_cond (pow A) (pow B).
 Proof.
 intros A B.
-elim (EM (retract (pow A) (pow B))).
-intros [f0 g0 e].
-exists f0 g0.
-trivial.
-
-intros hf.
-exists (fun (x:pow A) (y:B) => F) (fun (x:pow B) (y:A) => F).
-intros; elim hf; auto.
+destruct (EM (retract (pow A) (pow B))) as [(f0,g0,e) | hf].
+  exists f0 g0; trivial.
+  exists (fun (x:pow A) (y:B) => F) (fun (x:pow B) (y:A) => F); intros; 
+    destruct hf; auto.
 Qed.
 
 
diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v
index 87d8a70e..bc892ca9 100644
--- a/theories/Logic/ChoiceFacts.v
+++ b/theories/Logic/ChoiceFacts.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ChoiceFacts.v,v 1.7.2.2 2004/08/01 09:29:59 herbelin Exp $ i*)
+(*i $Id: ChoiceFacts.v 8132 2006-03-05 10:59:47Z herbelin $ i*)
 
 (** We show that the functional formulation of the axiom of Choice
    (usual formulation in type theory) is equivalent to its relational
@@ -17,29 +17,33 @@
    relational formulation) without known inconsistency with classical logic,
    though definite description conflicts with classical logic *)
 
+Section ChoiceEquivalences.
+
+Variables A B :Type.
+
 Definition RelationalChoice :=
-  forall (A B:Type) (R:A -> B -> Prop),
-    (forall x:A,  exists y : B, R x y) ->
+  forall (R:A -> B -> Prop),
+    (forall x:A, exists y : B, R x y) ->
      exists R' : A -> B -> Prop,
       (forall x:A,
-          exists y : B, R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
+         exists y : B, R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
 
 Definition FunctionalChoice :=
-  forall (A B:Type) (R:A -> B -> Prop),
-    (forall x:A,  exists y : B, R x y) ->
+  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)).
 
 Definition ParamDefiniteDescription :=
-  forall (A B:Type) (R:A -> B -> Prop),
-    (forall x:A,  exists y : B, R x y /\ (forall y':B, R x y' -> y = y')) ->
+  forall (R:A -> B -> Prop),
+    (forall x:A, exists y : B, R x y /\ (forall y':B, R x y' -> y = y')) ->
      exists f : A -> B, (forall x:A, R x (f x)).
 
 Lemma description_rel_choice_imp_funct_choice :
  ParamDefiniteDescription -> RelationalChoice -> FunctionalChoice.
 intros Descr RelCh.
-red in |- *; intros A B R H.
-destruct (RelCh A B R H) as [R' H0].
-destruct (Descr A B R') as [f H1].
+red in |- *; intros R H.
+destruct (RelCh R H) as [R' H0].
+destruct (Descr R') as [f H1].
 intro x.
 elim (H0 x); intros y [H2 [H3 H4]]; exists y; split; [ exact H3 | exact H4 ].
 exists f; intro x.
@@ -50,8 +54,8 @@ Qed.
 
 Lemma funct_choice_imp_rel_choice : FunctionalChoice -> RelationalChoice.
 intros FunCh.
-red in |- *; intros A B R H.
-destruct (FunCh A B R H) as [f H0].
+red in |- *; intros R H.
+destruct (FunCh R H) as [f H0].
 exists (fun x y => y = f x).
 intro x; exists (f x); split;
  [ apply H0
@@ -61,8 +65,8 @@ Qed.
 Lemma funct_choice_imp_description :
  FunctionalChoice -> ParamDefiniteDescription.
 intros FunCh.
-red in |- *; intros A B R H.
-destruct (FunCh A B R) as [f H0].
+red in |- *; intros R H.
+destruct (FunCh R) as [f H0].
 (* 1 *)
 intro x.
 elim (H x); intros y [H0 H1].
@@ -80,22 +84,25 @@ intro H; split;
 intros [H H0]; exact (description_rel_choice_imp_funct_choice H0 H).
 Qed.
 
+End ChoiceEquivalences.
+
 (** We show that the guarded relational formulation of the axiom of Choice
    comes from the non guarded formulation in presence either of the
    independance of premises or proof-irrelevance *)
 
-Definition GuardedRelationalChoice :=
-  forall (A B:Type) (P:A -> Prop) (R:A -> B -> Prop),
-    (forall x:A, P x ->  exists y : B, R x y) ->
+Definition GuardedRelationalChoice (A B:Type) :=
+  forall (P:A -> Prop) (R:A -> B -> Prop),
+    (forall x:A, P x -> exists y : B, R x y) ->
      exists R' : A -> B -> Prop,
       (forall x:A,
          P x ->
-          exists y : B, R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
+         exists y : B, R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
 
 Definition ProofIrrelevance := forall (A:Prop) (a1 a2:A), a1 = a2.
 
 Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice :
- RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice.
+  (forall A B, RelationalChoice A B)
+    -> ProofIrrelevance -> (forall A B, GuardedRelationalChoice A B).
 Proof.
 intros rel_choice proof_irrel.
 red in |- *; intros A B P R H.
@@ -103,7 +110,7 @@ destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as [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).
+set (R'' := fun (x:A) (y:B) => exists H : P x, R' (existT P x H) y).
 exists R''; intros x HPx.
 destruct (H0 (existT P x HPx)) as [y [HRxy [HR'xy Huniq]]].
 exists y. split.
@@ -118,16 +125,17 @@ exists y. split.
       exact HR'xy'.
 Qed.
 
-Definition IndependenceOfPremises :=
+Definition IndependenceOfGeneralPremises :=
   forall (A:Type) (P:A -> Prop) (Q:Prop),
-    (Q ->  exists x : _, P x) ->  exists x : _, Q -> P x.
+    (Q -> exists x, P x) -> exists x, Q -> P x.
 
-Lemma rel_choice_indep_of_premises_imp_guarded_rel_choice :
- RelationalChoice -> IndependenceOfPremises -> GuardedRelationalChoice.
+Lemma rel_choice_indep_of_general_premises_imp_guarded_rel_choice :
+ forall A B, RelationalChoice A B -> 
+   IndependenceOfGeneralPremises -> GuardedRelationalChoice A B.
 Proof.
-intros RelCh IndPrem.
-red in |- *; intros A B P R H.
-destruct (RelCh A B (fun x y => P x -> R x y)) as [R' H0].
+intros A B RelCh IndPrem.
+red in |- *; intros P R H.
+destruct (RelCh (fun x y => P x -> R x y)) as [R' H0].
   intro x. apply IndPrem.
     apply H.
   exists R'.
@@ -137,3 +145,79 @@ destruct (RelCh A B (fun x y => P x -> R x y)) as [R' H0].
       apply (H1 HPx).
       exact H2.
 Qed.
+
+
+(** Countable codomains, such as [nat], can be equipped with a
+    well-order, which implies the existence of a least element on
+    inhabited decidable subsets. As a consequence, the relational form of
+    the axiom of choice is derivable on [nat] for decidable relations.
+
+    We show instead that definite description and the functional form
+    of the axiom of choice are equivalent on decidable relation with [nat]
+    as codomain 
+*)
+
+Require Import Wf_nat.
+Require Import Compare_dec.
+Require Import Decidable.
+Require Import Arith.
+
+Definition has_unique_least_element (A:Type) (R:A->A->Prop) (P:A->Prop) :=
+  (exists x, (P x /\ forall x', P x' -> R x x')
+      /\ forall x', P x' /\ (forall x'', P x'' -> R x' x'') -> x=x').
+
+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 nat 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')).
+  induction n.
+  right.
+  intros n' Hn'.
+  apply le_O_n.
+  destruct IHn.
+  left; destruct H as (n', (Hlt', HPn')).
+  exists n'; split.
+  apply lt_S; assumption.
+  assumption.
+  destruct (Pdec n).
+  left; exists n; split.
+  apply lt_n_Sn.
+  split; assumption.
+  right.
+  intros n' Hltn'.
+  destruct (le_lt_eq_dec n n') as [Hltn|Heqn].
+  apply H; assumption.
+  assumption.
+  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.
+Qed.
+
+Definition FunctionalChoice_on (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)).
+
+Lemma classical_denumerable_description_imp_fun_choice : 
+  forall A:Type, 
+  ParamDefiniteDescription A nat -> 
+  forall R, (forall x y, decidable (R x y)) -> FunctionalChoice_on A nat 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].
+  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.
+Qed.
diff --git a/theories/Logic/Classical.v b/theories/Logic/Classical.v
index 044cee17..523c9245 100755..100644
--- a/theories/Logic/Classical.v
+++ b/theories/Logic/Classical.v
@@ -6,9 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical.v,v 1.6.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: Classical.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Classical Logic *)
 
 Require Export Classical_Prop.
-Require Export Classical_Pred_Type.
\ No newline at end of file
+Require Export Classical_Pred_Type.
+
diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v
index 51f758e2..5a633f84 100644
--- a/theories/Logic/ClassicalChoice.v
+++ b/theories/Logic/ClassicalChoice.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalChoice.v,v 1.4.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: ClassicalChoice.v 6401 2004-12-05 16:44:57Z herbelin $ i*)
 
 (** This file provides classical logic and functional choice *)
 
@@ -23,10 +23,11 @@ Require Import ChoiceFacts.
 
 Theorem choice :
  forall (A B:Type) (R:A -> B -> Prop),
-   (forall x:A,  exists y : B, R x y) ->
+   (forall x:A, exists y : B, R x y) ->
     exists f : A -> B, (forall x:A, R x (f x)).
 Proof.
+intros A B.
 apply description_rel_choice_imp_funct_choice.
-exact description.
-exact relational_choice.
-Qed.
\ No newline at end of file
+exact (description A B).
+exact (relational_choice A B).
+Qed.
diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v
index 6602cd73..ce3e279c 100644
--- a/theories/Logic/ClassicalDescription.v
+++ b/theories/Logic/ClassicalDescription.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalDescription.v,v 1.7.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: ClassicalDescription.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** This file provides classical logic and definite description *)
 
diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v
index cb14fb0e..91056250 100644
--- a/theories/Logic/ClassicalFacts.v
+++ b/theories/Logic/ClassicalFacts.v
@@ -6,24 +6,56 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalFacts.v,v 1.6.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: ClassicalFacts.v 8136 2006-03-05 21:57:47Z herbelin $ i*)
 
-(** Some facts and definitions about classical logic *)
+(** ** Some facts and definitions about classical logic
 
-(** [prop_degeneracy] (also referred as propositional completeness) *)
-(*  asserts (up to consistency) that there are only two distinct formulas *)
+Table of contents:
+
+A. Propositional degeneracy = excluded-middle + propositional extensionality
+
+B. Classical logic and proof-irrelevance
+
+B. 1. CC |- prop. ext. + A inhabited -> (A = A->A) -> A has fixpoint
+
+B. 2. CC |- prop. ext. + dep elim on bool -> proof-irrelevance
+
+B. 3. CIC |- prop. ext. -> proof-irrelevance
+
+B. 4. CC |- excluded-middle + dep elim on bool -> proof-irrelevance
+
+B. 5. CIC |- excluded-middle -> proof-irrelevance
+
+C. Weak classical axioms
+
+C. 1. Weak excluded middle
+
+C. 2. Gödel-Dummet axiom and right distributivity of implication over
+      disjunction
+
+C. 3. Independence of general premises and drinker's paradox
+
+*)
+
+(************************************************************************)
+(** *** A. Prop degeneracy = excluded-middle + prop extensionality      *)
+(**
+ i.e.        [(forall A, A=True \/ A=False)
+                         <->
+       (forall A, A\/~A) /\ (forall A B, (A<->B) -> A=B)]
+*)
+
+(** [prop_degeneracy] (also referred to as propositional completeness)
+    asserts (up to consistency) that there are only two distinct formulas *)
 Definition prop_degeneracy := forall A:Prop, A = True \/ A = False.
 
-(** [prop_extensionality] asserts equivalent formulas are equal *)
+(** [prop_extensionality] asserts that equivalent formulas are equal *)
 Definition prop_extensionality := forall A B:Prop, (A <-> B) -> A = B.
 
-(** [excluded_middle] asserts we can reason by case on the truth *)
-(*  or falsity of any formula *)
+(** [excluded_middle] asserts that we can reason by case on the truth
+    or falsity of any formula *)
 Definition excluded_middle := forall A:Prop, A \/ ~ A.
 
-(** [proof_irrelevance] asserts equality of all proofs of a given formula *)
-Definition proof_irrelevance := forall (A:Prop) (a1 a2:A), a1 = a2.
-
 (** We show [prop_degeneracy <-> (prop_extensionality /\ excluded_middle)] *)
 
 Lemma prop_degen_ext : prop_degeneracy -> prop_extensionality.
@@ -58,6 +90,12 @@ destruct (EM A).
   right; apply (Ext A False); split; [ exact H | apply False_ind ].
 Qed.
 
+(************************************************************************)
+(** *** B. Classical logic and proof-irrelevance *)
+
+(************************************************************************)
+(** **** B. 1. CC |- prop ext + A inhabited -> (A = A->A) -> A has fixpoint *)
+
 (** We successively show that:
 
    [prop_extensionality]
@@ -104,13 +142,20 @@ rewrite (g1_o_g2 (fun x:A => f (g1 x x))).
 reflexivity.
 Qed.
 
-(** Assume we have booleans with the property that there is at most 2
+(************************************************************************)
+(** **** B. 2. 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.
+
+(** Assume that we have booleans with the property that there is at most 2
     booleans (which is equivalent to dependent case analysis). Consider
     the fixpoint of the negation function: it is either true or false by
     dependent case analysis, but also the opposite by fixpoint. Hence
     proof-irrelevance.
 
-    We then map bool proof-irrelevance to all propositions.
+    We then map equality of boolean proofs to proof irrelevance in all
+    propositions.
 *)
 
 Section Proof_irrelevance_gen.
@@ -161,7 +206,7 @@ End Proof_irrelevance_gen.
     most 2 elements.
 *)
 
-Section Proof_irrelevance_CC.
+Section Proof_irrelevance_Prop_Ext_CC.
 
 Definition BoolP := forall C:Prop, C -> C -> C.
 Definition TrueP : BoolP := fun C c1 c2 => c1.
@@ -181,7 +226,10 @@ Proof
   ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim BoolP_elim_redl
     BoolP_elim_redr.
 
-End Proof_irrelevance_CC.
+End Proof_irrelevance_Prop_Ext_CC.
+
+(************************************************************************)
+(** **** B. 3. CIC |- prop. ext. -> proof-irrelevance                   *)
 
 (** In the Calculus of Inductive Constructions, inductively defined booleans
     enjoy dependent case analysis, hence directly proof-irrelevance from
@@ -211,9 +259,286 @@ End Proof_irrelevance_CIC.
   (i.e. propositional extensionality + excluded middle) without
   dependent case analysis ?
 
-  Conjecture: it seems possible to build a model of CC interpreting
-  all non-empty types by the set of all lambda-terms. Such a model would
-  satisfy propositional degeneracy without satisfying proof-irrelevance
-  (nor dependent case analysis). This would imply that the previous
-  results cannot be refined.
+  Berardi [[Berardi90]] built a model of CC interpreting inhabited
+  types by the set of all untyped lambda-terms. This model satisfies
+  propositional degeneracy without satisfying proof-irrelevance (nor
+  dependent case analysis). This implies that the previous results
+  cannot be refined.
+
+  [[Berardi90]] Stefano Berardi, "Type dependence and constructive
+  mathematics", Ph. D. thesis, Dipartimento Matematica, Università di
+  Torino, 1990.
 *)
+
+(************************************************************************)
+(** **** B. 4. 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
+    proof-irrelevance.
+
+    Reference:
+
+    [[Coquand90]] T. Coquand, "Metamathematical Investigations of a
+    Calculus of Constructions", Proceedings of Logic in Computer Science
+    (LICS'90), 1990.
+
+    Proof skeleton: classical logic + dependent elimination of
+    disjunction + discrimination of proofs implies the existence of a
+    retract from [Prop] into [bool], hence inconsistency by encoding any
+    paradox of system U- (e.g. Hurkens' paradox).
+*)
+
+Require 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 :
+    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 :
+    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 :
+    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.
+    trivial.
+  apply (paradox B p2b b2p (p2p2 H) p2p1).
+Qed.
+
+End Proof_irrelevance_EM_CC.
+
+(** Remark: Hurkens' paradox still holds with a retract from the
+    _negative_ fragment of [Prop] into [bool], hence weak classical
+    logic, i.e. [forall A, ~A\/~~A], is enough for deriving
+    proof-irrelevance.
+*)
+
+(************************************************************************)
+(** **** B. 5. CIC |- excluded-middle -> proof-irrelevance               *)
+
+(**
+    Since, dependent elimination is derivable in the Calculus of
+    Inductive Constructions (CCI), we get proof-irrelevance from classical
+    logic in the CCI.
+*)
+
+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.
+
+End Proof_irrelevance_CCI.
+
+(** Remark: in the Set-impredicative CCI, Hurkens' paradox still holds with
+    [bool] in [Set] and since [~true=false] for [true] and [false]
+    in [bool] from [Set], we get the inconsistency of
+    [em : forall A:Prop, {A}+{~A}] in the Set-impredicative CCI.
+*)
+
+(** *** C. 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
+ - independence of general premises and drinker's paradox
+ - excluded-middle
+*)
+
+(** **** C. 1. Weak excluded-middle *)
+
+(** The weak classical logic based on [~~A \/ ~A] is referred to with
+    name KC in {[ChagrovZakharyaschev97]]
+
+   [[ChagrovZakharyaschev97]] Alexander Chagrov and Michael
+   Zakharyaschev, "Modal Logic", Clarendon Press, 1997.
+*)
+
+Definition weak_excluded_middle :=
+  forall A:Prop, ~~A \/ ~A.
+
+(** 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) *)
+
+Definition weak_generalized_excluded_middle := 
+  forall A B:Prop, ((A -> B) -> B) \/ (A -> B).
+
+(** **** C. 2. Gödel-Dummett axiom *)
+
+(** [(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",
+    Ergeb. Math. Koll. 4 (1933), pp. 34-38.
+ *)
+
+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].
+  left; intros _; exact HB.
+  right; intros HB; destruct (HnotB HB).
+Qed.
+
+(** [(A->B) \/ (B->A)] is equivalent to [(C -> A\/B) -> (C->A) \/ (C->B)]
+    (proof from [[Dummett59]]) *)
+
+Definition RightDistributivityImplicationOverDisjunction :=
+  forall A B C:Prop, (C -> A\/B) -> (C->A) \/ (C->B).
+
+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.
+Qed.
+
+(** [(A->B) \/ (B->A)] is stronger than the weak excluded middle *)
+
+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).
+Qed.
+
+(** **** C. 3. Independence of general premises and drinker's paradox *)
+
+(** Independence of general premises is the unconstrained, non
+    constructive, version of the Independence of Premises as
+    considered in [[Troelstra73]].
+
+    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
+    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
+    Graundlagenforschung, 3:74- 78, 1957.
+
+    [[Troelstra73]], Anne Troelstra, editor. Metamathematical
+    Investigation of Intuitionistic Arithmetic and Analysis, volume
+    344 of Lecture Notes in Mathematics, Springer-Verlag, 1973.
+*)
+
+Notation Local "'inhabited' A" := A (at level 10, only parsing).
+
+Definition IndependenceOfGeneralPremises :=
+  forall (A:Type) (P:A -> Prop) (Q:Prop),
+    inhabited A -> (Q -> exists x, P x) -> exists x, Q -> P x.
+
+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.
+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.
+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.
+
+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)).
+Qed.
+
+(** Independence of general premises is weaker than (generalized) 
+    excluded middle *)
+
+Definition generalized_excluded_middle := 
+  forall A B:Prop, A \/ (A -> B).
+
+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.
+Qed.
+ 
diff --git a/theories/Logic/Classical_Pred_Set.v b/theories/Logic/Classical_Pred_Set.v
index c8f87fe8..2a5f03ec 100755..100644
--- a/theories/Logic/Classical_Pred_Set.v
+++ b/theories/Logic/Classical_Pred_Set.v
@@ -6,11 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical_Pred_Set.v,v 1.6.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: Classical_Pred_Set.v 8642 2006-03-17 10:09:02Z notin $ i*)
+
+(** This file is obsolete, use Classical_Pred_Type.v via Classical.v
+instead *)
 
 (** Classical Predicate Logic on Set*)
 
-Require Import Classical_Prop.
+Require Import Classical_Pred_Type.
 
 Section Generic.
 Variable U : Set.
@@ -19,52 +22,26 @@ Variable U : Set.
 
 Lemma not_all_ex_not :
  forall P:U -> Prop, ~ (forall n:U, P n) ->  exists n : U, ~ P n.
-Proof.
-unfold not in |- *; intros P notall.
-apply NNPP; unfold not in |- *.
-intro abs.
-cut (forall n:U, P n); auto.
-intro n; apply NNPP.
-unfold not in |- *; intros.
-apply abs; exists n; trivial.
-Qed.
+Proof (Classical_Pred_Type.not_all_ex_not U).
 
 Lemma not_all_not_ex :
  forall P:U -> Prop, ~ (forall n:U, ~ P n) ->  exists n : U, P n.
-Proof.
-intros P H.
-elim (not_all_ex_not (fun n:U => ~ P n) H); intros n Pn; exists n.
-apply NNPP; trivial.
-Qed.
+Proof (Classical_Pred_Type.not_all_not_ex U).
 
 Lemma not_ex_all_not :
  forall P:U -> Prop, ~ (exists n : U, P n) -> forall n:U, ~ P n.
-Proof.
-unfold not in |- *; intros P notex n abs.
-apply notex.
-exists n; trivial.
-Qed. 
+Proof (Classical_Pred_Type.not_ex_all_not U).
 
 Lemma not_ex_not_all :
  forall P:U -> Prop, ~ (exists n : U, ~ P n) -> forall n:U, P n.
-Proof.
-intros P H n.
-apply NNPP.
-red in |- *; intro K; apply H; exists n; trivial.
-Qed.
+Proof (Classical_Pred_Type.not_ex_not_all U).
 
 Lemma ex_not_not_all :
  forall P:U -> Prop, (exists n : U, ~ P n) -> ~ (forall n:U, P n).
-Proof.
-unfold not in |- *; intros P exnot allP.
-elim exnot; auto.
-Qed.
+Proof (Classical_Pred_Type.ex_not_not_all U).
 
 Lemma all_not_not_ex :
  forall P:U -> Prop, (forall n:U, ~ P n) -> ~ (exists n : U, P n).
-Proof.
-unfold not in |- *; intros P allnot exP; elim exP; intros n p.
-apply allnot with n; auto.
-Qed.
+Proof (Classical_Pred_Type.all_not_not_ex U).
 
-End Generic.
\ No newline at end of file
+End Generic.
diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v
index 804ff32d..56ebf967 100755..100644
--- a/theories/Logic/Classical_Pred_Type.v
+++ b/theories/Logic/Classical_Pred_Type.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical_Pred_Type.v,v 1.6.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: Classical_Pred_Type.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Classical Predicate Logic on Type *)
 
@@ -17,29 +17,30 @@ Variable U : Type.
 
 (** de Morgan laws for quantifiers *)
 
-Lemma not_all_ex_not :
- forall P:U -> Prop, ~ (forall n:U, P n) ->  exists n : U, ~ P n.
+Lemma not_all_not_ex :
+ forall P:U -> Prop, ~ (forall n:U, ~ P n) ->  exists n : U, P n.
 Proof.
-unfold not in |- *; intros P notall.
-apply NNPP; unfold not in |- *.
+intros P notall.
+apply NNPP.
 intro abs.
-cut (forall n:U, P n); auto.
-intro n; apply NNPP.
-unfold not in |- *; intros.
-apply abs; exists n; trivial.
+apply notall.
+intros n H.
+apply abs; exists n; exact H.
 Qed.
 
-Lemma not_all_not_ex :
- forall P:U -> Prop, ~ (forall n:U, ~ P n) ->  exists n : U, P n.
+Lemma not_all_ex_not :
+ forall P:U -> Prop, ~ (forall n:U, P n) ->  exists n : U, ~ P n.
 Proof.
-intros P H.
-elim (not_all_ex_not (fun n:U => ~ P n) H); intros n Pn; exists n.
-apply NNPP; trivial.
+intros P notall.
+apply not_all_not_ex with (P:=fun x => ~ P x).
+intro all; apply notall.
+intro n; apply NNPP.
+apply all.
 Qed.
 
 Lemma not_ex_all_not :
  forall P:U -> Prop, ~ (exists n : U, P n) -> forall n:U, ~ P n.
-Proof.
+Proof. (* Intuitionistic *)
 unfold not in |- *; intros P notex n abs.
 apply notex.
 exists n; trivial.
@@ -55,16 +56,16 @@ Qed.
 
 Lemma ex_not_not_all :
  forall P:U -> Prop, (exists n : U, ~ P n) -> ~ (forall n:U, P n).
-Proof.
+Proof. (* Intuitionistic *)
 unfold not in |- *; intros P exnot allP.
 elim exnot; auto.
 Qed.
 
 Lemma all_not_not_ex :
  forall P:U -> Prop, (forall n:U, ~ P n) -> ~ (exists n : U, P n).
-Proof.
+Proof. (* Intuitionistic *)
 unfold not in |- *; intros P allnot exP; elim exP; intros n p.
 apply allnot with n; auto.
 Qed.
 
-End Generic.
\ No newline at end of file
+End Generic.
diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v
index ccc26df1..f8b0e65b 100755..100644
--- a/theories/Logic/Classical_Prop.v
+++ b/theories/Logic/Classical_Prop.v
@@ -6,11 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical_Prop.v,v 1.6.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: Classical_Prop.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Classical Propositional Logic *)
 
-Require Import ProofIrrelevance.
+Require Import ClassicalFacts.
 
 Hint Unfold not: core.
 
@@ -29,8 +29,8 @@ intro; apply H; intro; absurd P; trivial.
 Qed.
 
 Lemma not_imply_elim2 : forall P Q:Prop, ~ (P -> Q) -> ~ Q.
-Proof.
-intros; elim (classic Q); auto.
+Proof. (* Intuitionistic *)
+tauto.
 Qed.
 
 Lemma imply_to_or : forall P Q:Prop, (P -> Q) -> ~ P \/ Q.
@@ -46,9 +46,8 @@ apply not_imply_elim2 with P; trivial.
 Qed.
 
 Lemma or_to_imply : forall P Q:Prop, ~ P \/ Q -> P -> Q.
-Proof.
-simple induction 1; auto.
-intros H1 H2; elim (H1 H2).
+Proof. (* Intuitionistic *)
+tauto.
 Qed.
 
 Lemma not_and_or : forall P Q:Prop, ~ (P /\ Q) -> ~ P \/ ~ Q.
@@ -62,24 +61,50 @@ simple induction 1; red in |- *; simple induction 2; auto.
 Qed.
 
 Lemma not_or_and : forall P Q:Prop, ~ (P \/ Q) -> ~ P /\ ~ Q.
-Proof.
-intros; elim (classic P); auto.
+Proof. (* Intuitionistic *)
+tauto.
 Qed.
 
 Lemma and_not_or : forall P Q:Prop, ~ P /\ ~ Q -> ~ (P \/ Q).
-Proof.
-simple induction 1; red in |- *; simple induction 3; trivial.
+Proof. (* Intuitionistic *)
+tauto.
 Qed.
 
 Lemma imply_and_or : forall P Q:Prop, (P -> Q) -> P \/ Q -> Q.
-Proof.
-simple induction 2; trivial.
+Proof. (* Intuitionistic *)
+tauto.
 Qed.
 
 Lemma imply_and_or2 : forall P Q R:Prop, (P -> Q) -> P \/ R -> Q \/ R.
-Proof.
-simple induction 2; auto.
+Proof. (* Intuitionistic *)
+tauto.
 Qed.
 
 Lemma proof_irrelevance : forall (P:Prop) (p1 p2:P), p1 = p2.
-Proof proof_irrelevance_cci classic.
\ No newline at end of file
+Proof proof_irrelevance_cci classic.
+
+(* classical_left  transforms |- A \/ B into ~B |- A *)
+(* classical_right transforms |- A \/ B into ~A |- B *)
+
+Ltac classical_right :=  match goal with 
+ | _:_ |-?X1 \/ _ => (elim (classic X1);intro;[left;trivial|right])
+end.
+
+Ltac classical_left := match goal with 
+| _:_ |- _ \/?X1 => (elim (classic X1);intro;[right;trivial|left])
+end.
+
+Require Export EqdepFacts.
+
+Module Eq_rect_eq.
+
+Lemma eq_rect_eq : 
+  forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
+Proof.
+intros; rewrite proof_irrelevance with (p1:=h) (p2:=refl_equal p); reflexivity.
+Qed.
+
+End Eq_rect_eq.
+
+Module EqdepTheory := EqdepTheory(Eq_rect_eq).
+Export EqdepTheory.
diff --git a/theories/Logic/Classical_Type.v b/theories/Logic/Classical_Type.v
index 753b8590..9b1f4e19 100755..100644
--- a/theories/Logic/Classical_Type.v
+++ b/theories/Logic/Classical_Type.v
@@ -6,9 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Classical_Type.v,v 1.5.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: Classical_Type.v 8642 2006-03-17 10:09:02Z notin $ i*)
+
+(** This file is obsolete, use Classical.v instead *)
 
 (** Classical Logic for Type *)
 
 Require Export Classical_Prop.
-Require Export Classical_Pred_Type.
\ No newline at end of file
+Require Export Classical_Pred_Type.
diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v
index 08babda9..8317f6bb 100644
--- a/theories/Logic/Decidable.v
+++ b/theories/Logic/Decidable.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i 	$Id: Decidable.v,v 1.5.2.1 2004/07/16 19:31:06 herbelin Exp $	 i*)
+(*i 	$Id: Decidable.v 5920 2004-07-16 20:01:26Z herbelin $	 i*)
 
 (** Properties of decidable propositions *)
 
diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v
index 2b982963..3e94deda 100644
--- a/theories/Logic/Diaconescu.v
+++ b/theories/Logic/Diaconescu.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Diaconescu.v,v 1.5.2.3 2004/08/01 09:36:44 herbelin Exp $ i*)
+(*i $Id: Diaconescu.v 6401 2004-12-05 16:44:57Z herbelin $ i*)
 
 (** R. Diaconescu [Diaconescu] showed that the Axiom of Choice in Set Theory
    entails Excluded-Middle; S. Lacas and B. Werner [LacasWerner]
@@ -59,18 +59,18 @@ Qed.
 
 Require Import ChoiceFacts.
 
-Variable rel_choice : RelationalChoice.
+Variable rel_choice : forall A B:Type, RelationalChoice A B.
 
 Lemma guarded_rel_choice :
  forall (A B:Type) (P:A -> Prop) (R:A -> B -> Prop),
    (forall x:A, P x ->  exists y : B, R x y) ->
-    exists R' : A -> B -> Prop,
+     exists R' : A -> B -> Prop,
      (forall x:A,
         P x ->
          exists y : B, R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
 Proof.
-  exact
-   (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel).
+ apply
+  (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel).
 Qed.
 
 (** The form of choice we need: there is a functional relation which chooses
diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v
index 24905039..2fe9d1a6 100755..100644
--- a/theories/Logic/Eqdep.v
+++ b/theories/Logic/Eqdep.v
@@ -6,183 +6,29 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Eqdep.v,v 1.10.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: Eqdep.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
-(** This file defines dependent equality and shows its equivalence with
-    equality on dependent pairs (inhabiting sigma-types). It axiomatizes
-    the invariance by substitution of reflexive equality proofs and 
-    shows the equivalence between the 4 following statements
+(** This file axiomatizes the invariance by substitution of reflexive
+    equality proofs [[Streicher93]] and exports its consequences, such
+    as the injectivity of the projection of the dependent pair.
 
-    - Invariance by Substitution of Reflexive Equality Proofs.
-    - Injectivity of Dependent Equality
-    - Uniqueness of Identity Proofs
-    - Uniqueness of Reflexive Identity Proofs
-    - Streicher's Axiom K
-
-  These statements are independent of the calculus of constructions [2].
-
-  References:
-
-  [1] T. Streicher, Semantical Investigations into Intensional Type Theory,
-      Habilitationsschrift, LMU München, 1993.
-  [2] M. Hofmann, T. Streicher, The groupoid interpretation of type theory,
-      Proceedings of the meeting Twenty-five years of constructive
-      type theory, Venice, Oxford University Press, 1998
+    [[Streicher93]] T. Streicher, Semantical Investigations into
+    Intensional Type Theory, Habilitationsschrift, LMU München, 1993.
 *)
 
-Section Dependent_Equality.
-
-Variable U : Type.
-Variable P : U -> Type.
-
-(** Dependent equality *)
-
-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.
-
-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.
+Require Export EqdepFacts.
 
-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.
-
-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.
-
-(** Invariance by Substitution of Reflexive Equality Proofs *)
+Module Eq_rect_eq.
 
 Axiom 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 is a consequence of *)
-(** Invariance by Substitution of Reflexive Equality Proof *)
-
-Lemma eq_dep1_eq : forall (p:U) (x y:P p), eq_dep1 p x p y -> x = y.
-Proof.
-simple destruct 1; intro.
-rewrite <- eq_rect_eq; auto.
-Qed.
-
-Lemma eq_dep_eq : forall (p:U) (x y:P p), eq_dep p x p y -> x = y.
-Proof.
-intros; apply eq_dep1_eq; apply eq_dep_dep1; trivial.
-Qed.
-
-End Dependent_Equality.
-
-(** Uniqueness of Identity Proofs (UIP) is a consequence of *)
-(** Injectivity of Dependent Equality *)
-
-Lemma UIP : forall (U:Type) (x y:U) (p1 p2:x = y), p1 = p2.
-Proof.
-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_refl : forall (U:Type) (x:U) (p:x = x), p = refl_equal x.
-Proof.
-intros; apply UIP.
-Qed.
-
-(** Streicher axiom K is a direct consequence of Uniqueness of
-    Reflexive Identity Proofs *)
-
-Lemma Streicher_K :
- forall (U:Type) (x:U) (P:x = x -> Prop),
-   P (refl_equal x) -> forall p:x = x, P p.
-Proof.
-intros; rewrite UIP_refl; assumption.
-Qed.
-
-(** We finally recover eq_rec_eq (alternatively eq_rect_eq) from K *)
-
-Lemma eq_rec_eq :
- forall (U:Type) (P:U -> Set) (p:U) (x:P p) (h:p = p), x = eq_rec p P x p h.
-Proof.
-intros.
-apply Streicher_K with (p := h).
-reflexivity.
-Qed.
-
-(** Dependent equality is equivalent to equality on dependent pairs *)
-
-Lemma equiv_eqex_eqdep :
- 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 U P p x q y.
-Proof.
-split. 
-(* -> *)
-intro H.
-change p with (projS1 (existS P p x)) in |- *.
-change x at 2 with (projS2 (existS P p x)) in |- *.
-rewrite H.
-apply eq_dep_intro.
-(* <- *)
-destruct 1; reflexivity.
-Qed.
-
-(** UIP implies the injectivity of equality on dependent pairs *)
-
-Lemma inj_pair2 :
- forall (U:Set) (P:U -> Set) (p:U) (x y:P p),
-   existS P p x = existS P p y -> x = y.
-Proof.
-intros.
-apply (eq_dep_eq U P).
-generalize (equiv_eqex_eqdep U P p p x y).
-simple induction 1.
-intros.
-auto.
-Qed.
+  forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
 
-(** UIP implies the injectivity of equality on dependent pairs *)
+End Eq_rect_eq.
 
-Lemma inj_pairT2 :
- forall (U:Type) (P:U -> Type) (p:U) (x y:P p),
-   existT P p x = existT P p y -> x = y.
-Proof.
-intros.
-apply (eq_dep_eq U P).
-change p at 1 with (projT1 (existT P p x)) in |- *.
-change x at 2 with (projT2 (existT P p x)) in |- *.
-rewrite H.
-apply eq_dep_intro.
-Qed.
+Module EqdepTheory := EqdepTheory(Eq_rect_eq).
+Export EqdepTheory.
 
-(** The main results to be exported *)
+(** Exported hints *)
 
-Hint Resolve eq_dep_intro eq_dep_eq: core v62.
-Hint Immediate eq_dep_sym: core v62.
+Hint Resolve eq_dep_eq: core v62.
 Hint Resolve inj_pair2 inj_pairT2: core.
diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v
new file mode 100644
index 00000000..7963555a
--- /dev/null
+++ b/theories/Logic/EqdepFacts.v
@@ -0,0 +1,351 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: EqdepFacts.v 8674 2006-03-30 06:56:50Z herbelin $ i*)
+
+(** This file defines dependent equality and shows its equivalence with
+    equality on dependent pairs (inhabiting sigma-types). It derives
+    the consequence of axiomatizing the invariance by substitution of
+    reflexive equality proofs and shows the equivalence between the 4
+    following statements
+
+    - Invariance by Substitution of Reflexive Equality Proofs.
+    - Injectivity of Dependent Equality
+    - Uniqueness of Identity Proofs
+    - Uniqueness of Reflexive Identity Proofs
+    - Streicher's Axiom K
+
+  These statements are independent of the calculus of constructions [2].
+
+  References:
+
+  [1] T. Streicher, Semantical Investigations into Intensional Type Theory,
+      Habilitationsschrift, LMU München, 1993.
+  [2] M. Hofmann, T. Streicher, The groupoid interpretation of type theory,
+      Proceedings of the meeting Twenty-five years of constructive
+      type theory, Venice, Oxford University Press, 1998
+
+Table of contents:
+
+A. Definition of dependent equality and equivalence with equality
+
+B. Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K
+
+C. 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 *)
+
+Section Dependent_Equality.
+
+Variable U : Type.
+Variable P : U -> Type.
+
+(** Dependent equality *)
+
+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.
+
+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_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.
+
+(** 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 :=
+    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.
+
+End Dependent_Equality.
+
+Implicit Arguments eq_dep [U P].
+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.
+Proof.
+  intros.
+  dependent rewrite H.
+  apply eq_dep_intro.
+Qed.
+
+Lemma equiv_eqex_eqdep :
+ 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. 
+  (* -> *)
+  apply eq_sigS_eq_dep.
+  (* <- *)
+  destruct 1; reflexivity.
+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.
+Proof.
+  intros.
+  dependent rewrite H.
+  apply eq_dep_intro.
+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.
+Proof.
+  destruct 1; reflexivity.
+Qed.
+
+(** Exported hints *)
+
+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          *)
+
+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.
+
+(** 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]):
+
+   [Definition Eq_rec_eq :=
+      forall (P:U -> Set) (p:U) (x:P p) (h:p = p), x = eq_rec p P x p h.]
+
+    Typically, [eq_rect_eq] allows to prove UIP and Streicher's K what
+    does not seem possible with [eq_rec_eq]. In particular, the proof of [UIP]
+    requires to use [eq_rect_eq] on [fun y -> x=y] which is in [Type] but not
+    in [Set].  
+*)
+
+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.
+ 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_sigS_eq_dep.
+  assumption.
+Qed.
+
+End Corollaries.
+
+(************************************************************************)
+(** *** C. Definition of the functor that builds properties of dependent equalities assuming axiom eq_rect_eq *)
+
+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.
+
+End EqdepElimination.
+
+Module EqdepTheory (M:EqdepElimination).
+
+Section Axioms.
+
+Variable U:Type.
+
+(** Invariance by Substitution of Reflexive Equality Proofs *)
+
+Lemma eq_rect_eq :
+  forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
+Proof M.eq_rect_eq U.
+
+Lemma eq_rec_eq :
+  forall (p:U) (Q:U -> Set) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
+Proof (fun p Q => M.eq_rect_eq U p Q).
+
+(** Injectivity of Dependent Equality *)
+
+Lemma eq_dep_eq : forall (P:U->Type) (p:U) (x y:P p), eq_dep p x p y -> x = y.
+Proof (eq_rect_eq__eq_dep_eq U eq_rect_eq).
+
+(** Uniqueness of Identity Proofs (UIP) is a consequence of *)
+(** Injectivity of Dependent Equality *)
+
+Lemma UIP : forall (x y:U) (p1 p2:x = y), p1 = p2.
+Proof (eq_dep_eq__UIP U eq_dep_eq).
+
+(** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *)
+
+Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x.
+Proof (UIP__UIP_refl U UIP).
+
+(** Streicher's axiom K is a direct consequence of Uniqueness of
+    Reflexive Identity Proofs *)
+
+Lemma Streicher_K :
+  forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+Proof (UIP_refl__Streicher_K U UIP_refl).
+
+End Axioms.
+
+(** UIP implies the injectivity of equality on dependent pairs in Type *)
+
+Lemma inj_pairT2 :
+ forall (U:Type) (P:U -> Type) (p:U) (x y:P p),
+   existT P p x = existT P p y -> x = y.
+Proof (fun U => eq_dep_eq__inj_pairT2 U (eq_dep_eq U)).
+
+(** UIP implies the injectivity of equality on dependent pairs in Set *)
+
+Lemma inj_pair2 :
+ forall (U:Set) (P:U -> Set) (p:U) (x y:P p),
+   existS P p x = existS P p y -> x = y.
+Proof (fun U => eq_dep_eq__inj_pair2 U (eq_dep_eq U)).
+
+End EqdepTheory.
+
+Implicit Arguments eq_dep [].
+Implicit Arguments eq_dep1 [].
diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v
index 7caf403c..7d71a1a6 100644
--- a/theories/Logic/Eqdep_dec.v
+++ b/theories/Logic/Eqdep_dec.v
@@ -6,56 +6,43 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Eqdep_dec.v,v 1.14.2.1 2004/07/16 19:31:06 herbelin Exp $ i*)
+(*i $Id: Eqdep_dec.v 8136 2006-03-05 21:57:47Z herbelin $ i*)
 
-(** We prove that there is only one proof of [x=x], i.e [(refl_equal ? x)].
-   This holds if the equality upon the set of [x] is decidable.
-   A corollary of this theorem is the equality of the right projections
-   of two equal dependent pairs.
+(** We prove that there is only one proof of [x=x], i.e [refl_equal x].
+    This holds if the equality upon the set of [x] is decidable.
+    A corollary of this theorem is the equality of the right projections
+    of two equal dependent pairs.
 
-   Author:   Thomas Kleymann |<tms@dcs.ed.ac.uk>| in Lego
-             adapted to Coq by B. Barras
+    Author:   Thomas Kleymann |<tms@dcs.ed.ac.uk>| in Lego
+              adapted to Coq by B. Barras
 
-   Credit:   Proofs up to [K_dec] follows an outline by Michael Hedberg
-*)
+    Credit:   Proofs up to [K_dec] follow an outline by Michael Hedberg
 
+Table of contents:
 
-(** We need some dependent elimination schemes *)
+A. Streicher's K and injectivity of dependent pair hold on decidable types
 
-Set Implicit Arguments.
+B.1. Definition of the functor that builds properties of dependent equalities
+     from a proof of decidability of equality for a set in Type
 
-  (** Bijection between [eq] and [eqT] *)
-  Definition eq2eqT (A:Set) (x y:A) (eqxy:x = y) : 
-    x = y :=
-    match eqxy in (_ = y) return x = y with
-    | refl_equal => refl_equal x
-    end.
-
-  Definition eqT2eq (A:Set) (x y:A) (eqTxy:x = y) : 
-    x = y :=
-    match eqTxy in (_ = y) return x = y with
-    | refl_equal => refl_equal x
-    end.
+B.2. Definition of the functor that builds properties of dependent equalities
+     from a proof of decidability of equality for a set in Set
 
-  Lemma eq_eqT_bij : forall (A:Set) (x y:A) (p:x = y), p = eqT2eq (eq2eqT p).
-intros.
-case p; reflexivity.
-Qed.
+*)
 
-  Lemma eqT_eq_bij : forall (A:Set) (x y:A) (p:x = y), p = eq2eqT (eqT2eq p).
-intros.
-case p; reflexivity.
-Qed.
+(************************************************************************)
+(** *** A. Streicher's K and injectivity of dependent pair hold on decidable types *)
 
+Set Implicit Arguments.
 
-Section DecidableEqDep.
+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_eqT : forall (x y:A) (u:x = y), comp u u = refl_equal y.
+  Remark trans_sym_eq : forall (x y:A) (u:x = y), comp u u = refl_equal y.
 intros.
 case u; trivial.
 Qed.
@@ -89,7 +76,7 @@ Qed.
   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_eqT.
+apply trans_sym_eq.
 Qed.
 
 
@@ -108,7 +95,6 @@ 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 :=
@@ -138,21 +124,173 @@ case H.
 reflexivity.
 Qed.
 
-End DecidableEqDep.
+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.
+Qed.
 
-  (** We deduce the [K] axiom for (decidable) Set *)
   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.
-intros.
-rewrite eq_eqT_bij.
-elim (eq2eqT p) using K_dec.
-intros.
-case (H x0 y); intros.
-elim e; left; reflexivity.
+  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)).
+Qed.
 
-right; red in |- *; intro neq; apply n; elim neq; reflexivity.
+Unset Implicit Arguments.
 
-trivial.
-Qed.
\ No newline at end of file
+(************************************************************************)
+(** *** B.1. 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}.
+
+End DecidableType.
+
+(** The module [DecidableEqDep] collects equality properties for decidable 
+    set in [Type] *)
+
+Module DecidableEqDep (M:DecidableType).
+
+  Import M.
+
+  (** Invariance by Substitution of Reflexive Equality Proofs *)
+
+  Lemma eq_rect_eq :
+    forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
+  Proof eq_rect_eq_dec eq_dec.
+
+  (** Injectivity of Dependent Equality *)
+
+  Theorem eq_dep_eq :
+    forall (P:U->Type) (p:U) (x y:P p), eq_dep U P p x p y -> x = y.
+  Proof (eq_rect_eq__eq_dep_eq U eq_rect_eq).
+
+  (** Uniqueness of Identity Proofs (UIP) *)
+
+  Lemma UIP : forall (x y:U) (p1 p2:x = y), p1 = p2.
+  Proof (eq_dep_eq__UIP U eq_dep_eq).
+
+  (** Uniqueness of Reflexive Identity Proofs *)
+
+  Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x.
+  Proof (UIP__UIP_refl U UIP).
+
+  (** Streicher's axiom K *)
+
+  Lemma Streicher_K :
+    forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+  Proof (K_dec_type eq_dec).
+
+  (** Injectivity of equality on dependent pairs in [Type] *)
+
+  Lemma inj_pairT2 :
+    forall (P:U -> Type) (p:U) (x y:P p),
+      existT P p x = existT P p y -> x = y.
+  Proof eq_dep_eq__inj_pairT2 U eq_dep_eq.
+
+  (** Proof-irrelevance on subsets of decidable sets *)
+
+  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.
+  Qed.
+
+End DecidableEqDep.
+
+(************************************************************************)
+(** *** B.2 Definition of the functor that builds properties of dependent equalities on decidable sets in Set *)
+
+(** The signature of decidable sets in [Set] *)
+
+Module Type DecidableSet.
+
+  Parameter U:Set.
+  Axiom eq_dec : forall x y:U, {x = y} + {x <> y}.
+
+End DecidableSet.
+
+(** The module [DecidableEqDepSet] collects equality properties for decidable 
+    set in [Set] *)
+
+Module DecidableEqDepSet (M:DecidableSet).
+
+  Import M.
+  Module N:=DecidableEqDep(M).
+
+  (** Invariance by Substitution of Reflexive Equality Proofs *)
+
+  Lemma eq_rect_eq :
+    forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
+  Proof eq_rect_eq_dec eq_dec.
+
+  (** Injectivity of Dependent Equality *)
+
+  Theorem eq_dep_eq :
+    forall (P:U->Type) (p:U) (x y:P p), eq_dep U P p x p y -> x = y.
+  Proof N.eq_dep_eq.
+
+  (** Uniqueness of Identity Proofs (UIP) *)
+
+  Lemma UIP : forall (x y:U) (p1 p2:x = y), p1 = p2.
+  Proof N.UIP.
+
+  (** Uniqueness of Reflexive Identity Proofs *)
+
+  Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x.
+  Proof N.UIP_refl.
+
+  (** Streicher's axiom K *)
+
+  Lemma Streicher_K :
+    forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+  Proof N.Streicher_K.
+
+  (** Injectivity of equality on dependent pairs with second component
+      in [Type] *)
+
+  Lemma inj_pairT2 :
+    forall (P:U -> Type) (p:U) (x y:P p),
+      existT P p x = existT P p y -> x = y.
+  Proof N.inj_pairT2.
+
+  (** Proof-irrelevance on subsets of decidable sets *)
+
+  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.
+  Proof N.inj_pairP2.
+
+  (** Injectivity of equality on dependent pairs in [Set] *)
+
+  Lemma inj_pair2 :
+    forall (P:U -> Set) (p:U) (x y:P p),
+      existS P p x = existS P p y -> x = y.
+  Proof eq_dep_eq__inj_pair2 U N.eq_dep_eq.
+
+End DecidableEqDepSet.
diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v
index 4666d9b4..4d365e32 100644
--- a/theories/Logic/JMeq.v
+++ b/theories/Logic/JMeq.v
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: JMeq.v,v 1.8.2.2 2004/08/03 17:42:32 herbelin Exp $ i*)
+(*i $Id: JMeq.v 6009 2004-08-03 17:42:55Z herbelin $ i*)
 
-(** John Major's Equality as proposed by C. Mc Bride
+(** John Major's Equality as proposed by Conor McBride
 
   Reference:
 
diff --git a/theories/Logic/ProofIrrelevance.v b/theories/Logic/ProofIrrelevance.v
index afdc0ffe..44ab9a2e 100644
--- a/theories/Logic/ProofIrrelevance.v
+++ b/theories/Logic/ProofIrrelevance.v
@@ -6,109 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** This is a proof in the pure Calculus of Construction that
-    classical logic in Prop + dependent elimination of disjunction entails
-    proof-irrelevance.
+(** This file axiomatizes proof-irrelevance and derives some consequences *)
 
-    Since, dependent elimination is derivable in the Calculus of
-    Inductive Constructions (CCI), we get proof-irrelevance from classical
-    logic in the CCI.
+Require Import ProofIrrelevanceFacts.
 
-    Reference:
+Axiom proof_irrelevance : forall (P:Prop) (p1 p2:P), p1 = p2.
 
-    - [Coquand] T. Coquand, "Metamathematical Investigations of a
-      Calculus of Constructions", Proceedings of Logic in Computer Science
-      (LICS'90), 1990.
+Module PI. Definition proof_irrelevance := proof_irrelevance. End PI.
 
-    Proof skeleton: classical logic + dependent elimination of
-    disjunction + discrimination of proofs implies the existence of a
-    retract from [Prop] into [bool], hence inconsistency by encoding any
-    paradox of system U- (e.g. Hurkens' paradox).
-*)
-
-Require Import Hurkens.
-
-Section Proof_irrelevance_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 :
-    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 :
-    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 :
-    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.
-    trivial.
-  apply (paradox B p2b b2p (p2p2 H) p2p1).
-Qed.
-
-End Proof_irrelevance_CC.
-
-
-(** The Calculus of Inductive Constructions (CCI) enjoys dependent
-    elimination, hence classical logic in CCI entails proof-irrelevance.
-*)
-
-Section Proof_irrelevance_CCI.
-
-Hypothesis em : 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.
-
-End Proof_irrelevance_CCI.
-
-(** Remark: in CCI, [bool] can be taken in [Set] as well in the
-    paradox and since [~true=false] for [true] and [false] in
-    [bool], we get the inconsistency of [em : forall A:Prop, {A}+{~A}] in CCI
-*)
+Module ProofIrrelevanceTheory := ProofIrrelevanceTheory(PI).
+Export ProofIrrelevanceTheory.
diff --git a/theories/Logic/ProofIrrelevanceFacts.v b/theories/Logic/ProofIrrelevanceFacts.v
new file mode 100644
index 00000000..dd3178eb
--- /dev/null
+++ b/theories/Logic/ProofIrrelevanceFacts.v
@@ -0,0 +1,62 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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 defines the functor that build consequences of proof-irrelevance *)
+
+Require Export EqdepFacts.
+
+Module Type ProofIrrelevance.
+
+  Axiom proof_irrelevance : forall (P:Prop) (p1 p2:P), p1 = p2.
+
+End ProofIrrelevance.
+
+Module ProofIrrelevanceTheory (M:ProofIrrelevance).
+
+  (** Proof-irrelevance implies uniqueness of reflexivity proofs *)
+
+  Module Eq_rect_eq.
+    Lemma eq_rect_eq : 
+      forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), 
+        x = eq_rect p Q x p h.
+    Proof.
+      intros; rewrite M.proof_irrelevance with (p1:=h) (p2:=refl_equal p).
+      reflexivity.
+    Qed.
+  End Eq_rect_eq.
+
+  (** Export the theory of injective dependent elimination *)
+
+  Module EqdepTheory := EqdepTheory(Eq_rect_eq).
+  Export EqdepTheory.
+
+  Scheme eq_indd := Induction for eq Sort Prop.
+
+  (** We derive the irrelevance of the membership property for subsets *)
+
+  Lemma subset_eq_compat :
+    forall (U:Set) (P:U->Prop) (x y:U) (p:P x) (q:P y),
+      x = y -> exist P x p = exist P y q.
+  Proof.
+    intros.
+    rewrite M.proof_irrelevance with (p1:=q) (p2:=eq_rect x P p y H).
+    elim H using eq_indd.
+    reflexivity.
+  Qed.
+
+  Lemma subsetT_eq_compat :
+    forall (U:Type) (P:U->Prop) (x y:U) (p:P x) (q:P y),
+      x = y -> existT P x p = existT P y q.
+  Proof.
+    intros.
+    rewrite M.proof_irrelevance with (p1:=q) (p2:=eq_rect x P p y H).
+    elim H using eq_indd.
+    reflexivity.
+  Qed.
+
+End ProofIrrelevanceTheory.
diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v
index 08873aa5..11979057 100644
--- a/theories/Logic/RelationalChoice.v
+++ b/theories/Logic/RelationalChoice.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: RelationalChoice.v,v 1.3.2.2 2004/08/01 09:29:59 herbelin Exp $ i*)
+(*i $Id: RelationalChoice.v 6001 2004-08-01 09:27:26Z herbelin $ i*)
 
 (** This file axiomatizes the relational form of the axiom of choice *)
 
diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v
index e6a14938..b4582d51 100644
--- a/theories/NArith/BinNat.v
+++ b/theories/NArith/BinNat.v
@@ -6,9 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: BinNat.v,v 1.7.2.1 2004/07/16 19:31:07 herbelin Exp $ i*)
+(*i $Id: BinNat.v 8685 2006-04-06 13:22:02Z letouzey $ i*)
 
 Require Import BinPos.
+Unset Boxed Definitions.
 
 (**********************************************************************)
 (** Binary natural numbers *)
@@ -21,10 +22,10 @@ Inductive N : Set :=
 
 Delimit Scope N_scope with N.
 
-(** Automatically open scope N_scope for the constructors of N *)
+(** Automatically open scope positive_scope for the constructors of N *)
 
 Bind Scope N_scope with N.
-Arguments Scope Npos [N_scope].
+Arguments Scope Npos [positive_scope].
 
 Open Local Scope N_scope.
 
@@ -32,7 +33,7 @@ Open Local Scope N_scope.
 
 Definition Ndouble_plus_one x :=
   match x with
-  | N0 => Npos 1%positive
+  | N0 => Npos 1
   | Npos p => Npos (xI p)
   end.
 
@@ -47,7 +48,7 @@ Definition Ndouble n := match n with
 
 Definition Nsucc n :=
   match n with
-  | N0 => Npos 1%positive
+  | N0 => Npos 1
   | Npos p => Npos (Psucc p)
   end.
 
@@ -57,7 +58,7 @@ Definition Nplus n m :=
   match n, m with
   | N0, _ => m
   | _, N0 => n
-  | Npos p, Npos q => Npos (p + q)%positive
+  | Npos p, Npos q => Npos (p + q)
   end.
 
 Infix "+" := Nplus : N_scope.
@@ -68,7 +69,7 @@ Definition Nmult n m :=
   match n, m with
   | N0, _ => N0
   | _, N0 => N0
-  | Npos p, Npos q => Npos (p * q)%positive
+  | Npos p, Npos q => Npos (p * q)
   end.
 
 Infix "*" := Nmult : N_scope.
@@ -154,7 +155,7 @@ Qed.
 
 (** Properties of multiplication *)
 
-Theorem Nmult_1_l : forall n:N, Npos 1%positive * n = n.
+Theorem Nmult_1_l : forall n:N, Npos 1 * n = n.
 Proof.
 destruct n; reflexivity.
 Qed.
diff --git a/theories/NArith/BinPos.v b/theories/NArith/BinPos.v
index fffb10c1..513a67c2 100644
--- a/theories/NArith/BinPos.v
+++ b/theories/NArith/BinPos.v
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: BinPos.v,v 1.7.2.1 2004/07/16 19:31:07 herbelin Exp $ i*)
+(*i $Id: BinPos.v 6699 2005-02-07 14:30:08Z coq $ i*)
+
+Unset Boxed Definitions.
 
 (**********************************************************************)
 (** Binary positive numbers *)
@@ -39,6 +41,8 @@ Fixpoint Psucc (x:positive) : positive :=
 
 (** Addition *)
 
+Set Boxed Definitions.
+
 Fixpoint Pplus (x y:positive) {struct x} : positive :=
   match x, y with
   | xI x', xI y' => xO (Pplus_carry x' y')
@@ -65,6 +69,8 @@ Fixpoint Pplus (x y:positive) {struct x} : positive :=
   | xH, xH => xI xH
   end.
 
+Unset Boxed Definitions.
+
 Infix "+" := Pplus : positive_scope.
 
 Open Local Scope positive_scope.
diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v
index b1bdaaf0..2f066efa 100644
--- a/theories/NArith/NArith.v
+++ b/theories/NArith/NArith.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: NArith.v,v 1.2.2.1 2004/07/16 19:31:07 herbelin Exp $ *)
+(* $Id: NArith.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (** Library for binary natural numbers *)
 
diff --git a/theories/NArith/Pnat.v b/theories/NArith/Pnat.v
index f5bbb1c9..88abc700 100644
--- a/theories/NArith/Pnat.v
+++ b/theories/NArith/Pnat.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Pnat.v,v 1.3.2.1 2004/07/16 19:31:07 herbelin Exp $ i*)
+(*i $Id: Pnat.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import BinPos.
 
diff --git a/theories/NArith/intro.tex b/theories/NArith/intro.tex
new file mode 100644
index 00000000..83eed970
--- /dev/null
+++ b/theories/NArith/intro.tex
@@ -0,0 +1,5 @@
+\section{Binary positive and non negative integers : NArith}\label{NArith}
+
+Here are defined various arithmetical notions and their properties,
+similar to those of {\tt Arith}.
+
diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v
index a691b189..e6bc69b6 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,v 1.14.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: Alembert.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -30,7 +30,7 @@ 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; apply X.
+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 ].
@@ -107,7 +107,7 @@ red in |- *; intro; assert (H8 := H n); rewrite H7 in 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; elim X; intros.
+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;
@@ -418,7 +418,7 @@ 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; apply X.
+intro X; apply X.
 apply completeness.
 assert (H1 := tech13 _ _ Hyp H0).
 elim H1; intros.
@@ -517,7 +517,7 @@ 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; elim X; intros.
+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;
@@ -559,11 +559,11 @@ rewrite <- Rabs_mult.
 rewrite Rabs_Rabsolu.
 unfold Rdiv in H3; apply H3; assumption.
 apply H0.
-intro.
+intro X.
 elim X; intros.
 apply existT with x.
 assumption.
-intro.
+intro X.
 elim X; intros.
 apply existT with x.
 assumption.
@@ -581,7 +581,7 @@ intros.
 cut
  (sigT
     (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l)).
-intro.
+intro X.
 elim X; intros.
 apply existT with x0.
 apply tech12; assumption.
@@ -723,4 +723,4 @@ 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.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v
index 166a8a46..1ec8c664 100644
--- a/theories/Reals/AltSeries.v
+++ b/theories/Reals/AltSeries.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: AltSeries.v,v 1.12.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: AltSeries.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v
index ad535a9d..24d64c07 100644
--- a/theories/Reals/ArithProp.v
+++ b/theories/Reals/ArithProp.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: ArithProp.v,v 1.11.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: ArithProp.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rbasic_fun.
diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v
index e31b623c..940bd628 100644
--- a/theories/Reals/Binomial.v
+++ b/theories/Reals/Binomial.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Binomial.v,v 1.9.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: Binomial.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -201,4 +201,4 @@ 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.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v
index 41a6284f..7f3727c7 100644
--- a/theories/Reals/Cauchy_prod.v
+++ b/theories/Reals/Cauchy_prod.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Cauchy_prod.v,v 1.10.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: Cauchy_prod.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v
index 422eb4a4..558632c5 100644
--- a/theories/Reals/Cos_plus.v
+++ b/theories/Reals/Cos_plus.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Cos_plus.v,v 1.11.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: Cos_plus.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v
index 9f76a5ad..8320382c 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,v 1.12.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: Cos_rel.v 6245 2004-10-20 13:50:08Z barras $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -417,4 +417,4 @@ unfold sin_in in s.
 assert
  (H1 := uniqueness_sum (fun i:nat => sin_n i * (x * x) ^ i) x0 x1 p_i s). 
 rewrite H1; reflexivity. 
-Qed. 
\ No newline at end of file
+Qed. 
diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v
index f897e258..1c663288 100644
--- a/theories/Reals/DiscrR.v
+++ b/theories/Reals/DiscrR.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i        $Id: DiscrR.v,v 1.21.2.1 2004/07/16 19:31:10 herbelin Exp $       i*)
+(*i        $Id: DiscrR.v 5920 2004-07-16 20:01:26Z herbelin $       i*)
 
 Require Import RIneq.
 Require Import Omega. Open Local Scope R_scope.
diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v
index fcaeb11e..90ea93ef 100644
--- a/theories/Reals/Exp_prop.v
+++ b/theories/Reals/Exp_prop.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Exp_prop.v,v 1.16.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: Exp_prop.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -895,7 +895,7 @@ cut
        Un_cv
          (fun n:nat =>
             sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l)).
-intro.
+intro X.
 elim X; intros.
 exists x; intros.
 split.
@@ -1008,4 +1008,4 @@ 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.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Integration.v b/theories/Reals/Integration.v
index c3c3d9bb..d4f3a8ec 100644
--- a/theories/Reals/Integration.v
+++ b/theories/Reals/Integration.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Integration.v,v 1.1.6.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: Integration.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Export NewtonInt.
 Require Export RiemannInt_SF.
diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v
index baa61304..241313a0 100644
--- a/theories/Reals/MVT.v
+++ b/theories/Reals/MVT.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: MVT.v,v 1.10.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: MVT.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -27,7 +27,7 @@ Theorem MVT :
 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; cut (forall c:R, a <= c <= b -> continuity_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.
@@ -142,9 +142,9 @@ Lemma MVT_cor1 :
    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 | intros; apply pr ].
+ [ intro X | intros; apply pr ].
 cut (forall c:R, a < c < b -> derivable_pt id c);
- [ intro | intros; apply derivable_pt_id ].
+ [ 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);
@@ -166,11 +166,11 @@ Theorem MVT_cor2 :
    (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; cut (forall c:R, a < c < b -> derivable_pt f c).
-intro; cut (forall c:R, a <= c <= b -> continuity_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; cut (forall c:R, a < c < b -> derivable_pt id c).
-intro; cut (forall c:R, a <= c <= b -> continuity_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).
@@ -595,7 +595,7 @@ Lemma IAF_var :
    g b - g a <= f b - f a.
 intros.
 cut (derivable (g - f)).
-intro.
+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).
diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v
index 97cd4b94..62c53e6d 100644
--- a/theories/Reals/NewtonInt.v
+++ b/theories/Reals/NewtonInt.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: NewtonInt.v,v 1.11.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: NewtonInt.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -128,7 +128,8 @@ Lemma NewtonInt_P5 :
    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; elim X; intros; elim X0; intros;
+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.
diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v
index 0c19c8da..d6dc352c 100644
--- a/theories/Reals/PSeries_reg.v
+++ b/theories/Reals/PSeries_reg.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: PSeries_reg.v,v 1.12.2.1 2004/07/16 19:31:10 herbelin Exp $ i*)
+(*i $Id: PSeries_reg.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v
index 6087d3f2..bace7b9d 100644
--- a/theories/Reals/PartSum.v
+++ b/theories/Reals/PartSum.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: PartSum.v,v 1.11.2.2 2005/07/13 22:28:30 herbelin Exp $ i*)
+(*i $Id: PartSum.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -430,7 +430,7 @@ 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.
+intros An X.
 elim X; intros.
 unfold Un_cv in p.
 unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v
index 5da14193..3e1dbccf 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,v 1.23.2.2 2005/03/29 15:35:13 herbelin Exp $ i*)
+(*i $Id: RIneq.v 6897 2005-03-29 15:39:12Z herbelin $ i*)
 
 (***************************************************************************)
 (**              Basic lemmas for the classical reals numbers              *)
diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v
index 3b58c02f..551aec98 100644
--- a/theories/Reals/RList.v
+++ b/theories/Reals/RList.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: RList.v,v 1.10.2.1 2004/07/16 19:31:11 herbelin Exp $ i*)
+(*i $Id: RList.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v
index 289b1921..97355238 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,v 1.14.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: R_Ifp.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (**********************************************************)
 (** Complements for the reals.Integer and fractional part *)
diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v
index 0abf9064..d87adc24 100644
--- a/theories/Reals/R_sqr.v
+++ b/theories/Reals/R_sqr.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: R_sqr.v,v 1.19.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: R_sqr.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rbasic_fun. Open Local Scope R_scope.
diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v
index 660b0527..cb372840 100644
--- a/theories/Reals/R_sqrt.v
+++ b/theories/Reals/R_sqrt.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: R_sqrt.v,v 1.10.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: R_sqrt.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -396,4 +396,4 @@ unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
 rewrite Ropp_minus_distr.
 reflexivity.
 reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v
index 88af8b20..b885e4ce 100644
--- a/theories/Reals/Ranalysis.v
+++ b/theories/Reals/Ranalysis.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Ranalysis.v,v 1.19.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Ranalysis.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v
index 918ebfc0..6d30e291 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,v 1.21.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Ranalysis1.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -453,7 +453,7 @@ Qed.
 
 Theorem derivable_continuous_pt :
  forall f (x:R), derivable_pt f x -> continuity_pt f x.
-intros.
+intros f x X.
 generalize (derivable_derive f x X); intro.
 elim H; intros l H1.
 cut (l = fct_cte l x).
@@ -468,7 +468,7 @@ unfold fct_cte in |- *; reflexivity.
 Qed.
 
 Theorem derivable_continuous : forall f, derivable f -> continuity f.
-unfold derivable, continuity in |- *; intros.
+unfold derivable, continuity in |- *; intros f X x.
 apply (derivable_continuous_pt f x (X x)).
 Qed.
 
@@ -661,7 +661,7 @@ 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.
+unfold derivable_pt in |- *; intros f1 f2 x X X0.
 elim X; intros.
 elim X0; intros.
 apply existT with (x0 + x1).
@@ -670,7 +670,7 @@ Qed.
 
 Lemma derivable_pt_opp :
  forall f (x:R), derivable_pt f x -> derivable_pt (- f) x.
-unfold derivable_pt in |- *; intros.
+unfold derivable_pt in |- *; intros f x X.
 elim X; intros.
 apply existT with (- x0).
 apply derivable_pt_lim_opp; assumption.
@@ -679,7 +679,7 @@ 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.
+unfold derivable_pt in |- *; intros f1 f2 x X X0.
 elim X; intros.
 elim X0; intros.
 apply existT with (x0 - x1).
@@ -689,7 +689,7 @@ 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.
+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).
@@ -704,7 +704,7 @@ 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.
+unfold derivable_pt in |- *; intros f1 a x X.
 elim X; intros.
 apply existT with (a * x0).
 apply derivable_pt_lim_scal; assumption.
@@ -724,7 +724,7 @@ 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.
+unfold derivable_pt in |- *; intros f1 f2 x X X0.
 elim X; intros.
 elim X0; intros.
 apply existT with (x1 * x0).
@@ -733,24 +733,24 @@ Qed.
 
 Lemma derivable_plus :
  forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2).
-unfold derivable in |- *; intros.
+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.
+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.
+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.
+unfold derivable in |- *; intros f1 f2 X X0 x.
 apply (derivable_pt_mult _ _ x (X _) (X0 _)).
 Qed.
 
@@ -761,7 +761,7 @@ Qed.
 
 Lemma derivable_scal :
  forall f (a:R), derivable f -> derivable (mult_real_fct a f).
-unfold derivable in |- *; intros.
+unfold derivable in |- *; intros f a X x.
 apply (derivable_pt_scal _ a x (X _)).
 Qed.
 
@@ -775,7 +775,7 @@ Qed.
 
 Lemma derivable_comp :
  forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1).
-unfold derivable in |- *; intros.
+unfold derivable in |- *; intros f1 f2 X X0 x.
 apply (derivable_pt_comp _ _ x (X _) (X0 _)).
 Qed.
 
diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v
index 35f7eab8..0627e22c 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,v 1.11.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Ranalysis2.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v
index 9f85b00a..663ccb07 100644
--- a/theories/Reals/Ranalysis3.v
+++ b/theories/Reals/Ranalysis3.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis3.v,v 1.10.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Ranalysis3.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -20,9 +20,9 @@ Theorem derivable_pt_lim_div :
    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.
+intros f1 f2 x l1 l2 H H0 H1.
 cut (derivable_pt f2 x);
- [ intro | unfold derivable_pt in |- *; apply existT with l2; exact H0 ].
+ [ 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 |- *.
@@ -756,7 +756,7 @@ Lemma derivable_pt_div :
    derivable_pt f1 x ->
    derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x.
 unfold derivable_pt in |- *.
-intros.
+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)).
@@ -767,7 +767,7 @@ 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.
+unfold derivable in |- *; intros f1 f2 X X0 H x.
 apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)).
 Qed.
 
@@ -790,4 +790,4 @@ 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.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v
index 86f49cd4..40bb2429 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,v 1.19.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Ranalysis4.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -20,13 +20,13 @@ 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; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x).
-intro; apply X0.
+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; elim X0; intros;
+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; 
@@ -76,8 +76,8 @@ Qed.
 (**********)
 Lemma derivable_inv :
  forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f).
-intros.
-unfold derivable in |- *; intro.
+intros f H X.
+unfold derivable in |- *; intro x.
 apply derivable_pt_inv.
 apply (H x).
 apply (X x).
@@ -381,4 +381,4 @@ 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.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v
index bef9f89c..61902568 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,v 1.20.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Raxioms.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
 
 (*********************************************************)
 (**    Axiomatisation of the classical reals             *)
@@ -107,7 +107,7 @@ Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real.
 (**********************************************************)
 
 (**********)
-Fixpoint INR (n:nat) : R :=
+Boxed Fixpoint INR (n:nat) : R :=
   match n with
   | O => 0
   | S O => 1
diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v
index 773819a2..5bfb692a 100644
--- a/theories/Reals/Rbase.v
+++ b/theories/Reals/Rbase.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rbase.v,v 1.39.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Rbase.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Export Rdefinitions.
 Require Export Raxioms.
diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v
index 49ba48f7..436a8011 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,v 1.22.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Rbasic_fun.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*********************************************************)
 (**          Complements for the real numbers            *)
diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v
index dd8379cb..2f11a404 100644
--- a/theories/Reals/Rcomplete.v
+++ b/theories/Reals/Rcomplete.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Rcomplete.v,v 1.10.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Rcomplete.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v
index 33f494df..62aec6bc 100644
--- a/theories/Reals/Rdefinitions.v
+++ b/theories/Reals/Rdefinitions.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Rdefinitions.v,v 1.14.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Rdefinitions.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 
 (*********************************************************)
diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v
index 81db80ab..42663de6 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,v 1.15.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Rderiv.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*********************************************************)
 (**     Definition of the derivative,continuity          *)
diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v
index 5e4b3e7b..c9cd189d 100644
--- a/theories/Reals/Reals.v
+++ b/theories/Reals/Reals.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Reals.v,v 1.24.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Reals.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* The library REALS is divided in 6 parts :
    - Rbase: basic lemmas on R
diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v
index cdff9fcb..0ab93229 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,v 1.31.2.1 2004/07/16 19:31:12 herbelin Exp $ i*)
+(*i $Id: Rfunctions.v 6338 2004-11-22 09:10:51Z gregoire $ 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*)
@@ -63,7 +63,7 @@ Qed.
 (*          Power              *)
 (*******************************)
 (*********)
-Fixpoint pow (r:R) (n:nat) {struct n} : R :=
+Boxed Fixpoint pow (r:R) (n:nat) {struct n} : R :=
   match n with
   | O => 1
   | S n => r * pow r n
@@ -670,7 +670,7 @@ Definition decimal_exp (r:R) (z:Z) : R := (r * 10 ^Z z).
 (** Sum of n first naturals    *)
 (*******************************)
 (*********)
-Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) {struct n} : nat :=
+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
diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v
index a01e7b52..9ce20839 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,v 1.13.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: Rgeom.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v
index ce33afdb..79cb7797 100644
--- a/theories/Reals/RiemannInt.v
+++ b/theories/Reals/RiemannInt.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: RiemannInt.v,v 1.18.2.2 2005/07/13 23:18:52 herbelin Exp $ i*)
+(*i $Id: RiemannInt.v 7223 2005-07-13 23:43:54Z herbelin $ i*)
 
 Require Import Rfunctions.
 Require Import SeqSeries.
diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v
index 0ae8f9f2..71ab0b4c 100644
--- a/theories/Reals/RiemannInt_SF.v
+++ b/theories/Reals/RiemannInt_SF.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: RiemannInt_SF.v,v 1.16.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: RiemannInt_SF.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -147,7 +147,7 @@ Definition subdivision_val (a b:R) (f:StepFun a b) : Rlist :=
   | existT a b => a
   end.
 
-Fixpoint Int_SF (l k:Rlist) {struct l} : R :=
+Boxed Fixpoint Int_SF (l k:Rlist) {struct l} : R :=
   match l with
   | nil => 0
   | cons a l' =>
diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v
index 0fbb17c6..b8d304b1 100644
--- a/theories/Reals/Rlimit.v
+++ b/theories/Reals/Rlimit.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rlimit.v,v 1.23.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: Rlimit.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*********************************************************)
 (*           Definition of the limit                     *)
diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v
index 7575d929..aa9e9887 100644
--- a/theories/Reals/Rpower.v
+++ b/theories/Reals/Rpower.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Rpower.v,v 1.17.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: Rpower.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
 (*i Due to L.Thery i*) 
 
 (************************************************************)
@@ -658,4 +658,4 @@ apply derivable_pt_lim_const with (a := y).
 apply derivable_pt_lim_id.
 ring.
 apply derivable_pt_lim_exp.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v
index 6577146f..ec738996 100644
--- a/theories/Reals/Rprod.v
+++ b/theories/Reals/Rprod.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Rprod.v,v 1.10.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: Rprod.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
 
 Require Import Compare.
 Require Import Rbase.
@@ -17,7 +17,7 @@ Require Import Binomial.
 Open Local Scope R_scope.
 
 (* TT Ak; 1<=k<=N *)
-Fixpoint prod_f_SO (An:nat -> R) (N:nat) {struct N} : R :=
+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)
@@ -188,4 +188,4 @@ rewrite mult_INR; apply prod_neq_R0; apply INR_fact_neq_0.
 apply prod_neq_R0; apply INR_fact_neq_0.
 apply INR_eq; rewrite minus_INR;
  [ rewrite mult_INR; do 2 rewrite S_INR; ring | apply le_n_2n ].
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v
index cbf93278..aa3a0316 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,v 1.11.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: Rseries.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -28,7 +28,7 @@ Section sequence.
 Variable Un : nat -> R.
 
 (*********)
-Fixpoint Rmax_N (N:nat) : R :=
+Boxed Fixpoint Rmax_N (N:nat) : R :=
   match N with
   | O => Un 0
   | S n => Rmax (Un (S n)) (Rmax_N n)
diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v
index e54c3675..1e69a8f5 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,v 1.12.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: Rsigma.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v
index 459f2716..de3422e8 100644
--- a/theories/Reals/Rsqrt_def.v
+++ b/theories/Reals/Rsqrt_def.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Rsqrt_def.v,v 1.14.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: Rsqrt_def.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Sumbool.
 Require Import Rbase.
@@ -15,7 +15,7 @@ Require Import SeqSeries.
 Require Import Ranalysis1.
 Open Local Scope R_scope.
 
-Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R :=
+Boxed Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R :=
   match N with
   | O => x
   | S n =>
@@ -455,7 +455,7 @@ 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.
+intros X X0.
 elim X; intros.
 elim X0; intros.
 assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
@@ -759,4 +759,4 @@ apply Rsqr_inj.
 assumption.
 assumption.
 rewrite <- H0; rewrite <- H2; reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v
index 1c112bf1..84f3b081 100644
--- a/theories/Reals/Rtopology.v
+++ b/theories/Reals/Rtopology.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Rtopology.v,v 1.19.2.1 2004/07/16 19:31:13 herbelin Exp $ i*)
+(*i $Id: Rtopology.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v
index e4cae6c6..060070c4 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,v 1.40.2.1 2004/07/16 19:31:14 herbelin Exp $ i*)
+(*i $Id: Rtrigo.v 6245 2004-10-20 13:50:08Z barras $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -1704,4 +1704,4 @@ Lemma cos_eq_0_2PI_1 :
 intros x H1 H2 H3; elim H3; intro H4;
  [ rewrite H4; rewrite cos_PI2; reflexivity
  | rewrite H4; rewrite cos_3PI2; reflexivity ].
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v
index 3cda9290..fc465bc4 100644
--- a/theories/Reals/Rtrigo_alt.v
+++ b/theories/Reals/Rtrigo_alt.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Rtrigo_alt.v,v 1.16.2.1 2004/07/16 19:31:14 herbelin Exp $ i*)
+(*i $Id: Rtrigo_alt.v 6245 2004-10-20 13:50:08Z barras $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -423,4 +423,4 @@ 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.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v
index 0ef87322..f8c15667 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,v 1.15.2.1 2004/07/16 19:31:14 herbelin Exp $ i*)
+(*i $Id: Rtrigo_calc.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v
index 92ec68ce..94f5ec97 100644
--- a/theories/Reals/Rtrigo_def.v
+++ b/theories/Reals/Rtrigo_def.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Rtrigo_def.v,v 1.17.2.1 2004/07/16 19:31:14 herbelin Exp $ i*)
+(*i $Id: Rtrigo_def.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -409,4 +409,4 @@ 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.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v
index b0f29e5c..eaf2121e 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,v 1.7.2.1 2004/07/16 19:31:15 herbelin Exp $ i*)
+(*i $Id: Rtrigo_fun.v 8691 2006-04-10 09:23:37Z msozeau $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -61,10 +61,10 @@ intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros;
  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;
+intro ;
  generalize
   (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4
-     (le_INR x n ((fun (n m:nat) (H:(m >= n)%nat) => H) x n H2))); 
+     (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 ].
diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v
index 9d3b60c6..1c9a9445 100644
--- a/theories/Reals/Rtrigo_reg.v
+++ b/theories/Reals/Rtrigo_reg.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Rtrigo_reg.v,v 1.15.2.1 2004/07/16 19:31:15 herbelin Exp $ i*)
+(*i $Id: Rtrigo_reg.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -32,7 +32,7 @@ cut
          (fun n:nat =>
             sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k)))
               n) l)).
-intro; elim X; intros.
+intro X; elim X; intros.
 apply existT with x.
 split.
 apply p.
@@ -206,7 +206,7 @@ cut
             sum_f_R0
               (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n)
          l)).
-intro; elim X; intros.
+intro X; elim X; intros.
 apply existT with x.
 split.
 apply p.
@@ -605,4 +605,4 @@ 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.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v
index 34f9fd72..2e851b13 100644
--- a/theories/Reals/SeqProp.v
+++ b/theories/Reals/SeqProp.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: SeqProp.v,v 1.13.2.1 2004/07/16 19:31:15 herbelin Exp $ i*)
+
+(*i $Id: SeqProp.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -48,7 +48,7 @@ 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); 
+ unfold is_upper_bound in H8; generalize (H3 (x - eps) H8);
  apply Rlt_not_le; apply tech_Rgt_minus; exact H1.
 Qed.
 
@@ -66,12 +66,12 @@ Lemma decreasing_cv :
    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.
+intro X.
 apply X.
 apply growing_cv.
 apply decreasing_growing; assumption.
 exact H0.
-intro.
+intro X.
 elim X; intros.
 apply existT with (- x).
 unfold Un_cv in p.
@@ -155,14 +155,14 @@ elim H1; intros.
 exists (k + x1)%nat; assumption.
 Qed.
 
-Definition sequence_majorant (Un:nat -> R) (pr:has_ub Un) 
+Definition sequence_majorant (Un:nat -> R) (pr:has_ub Un)
   (i:nat) : R := majorant (fun k:nat => Un (i + k)%nat) (maj_ss Un i pr).
 
-Definition sequence_minorant (Un:nat -> R) (pr:has_lb Un) 
+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). 
+ forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_majorant Un pr).
 intros.
 unfold Un_decreasing in |- *.
 intro.
@@ -289,14 +289,14 @@ 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. 
+ 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.
+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.
@@ -329,7 +329,7 @@ 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.
+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.
@@ -379,7 +379,7 @@ Qed.
 
 Lemma maj_min :
  forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un),
-   has_lb (sequence_majorant Un pr1). 
+   has_lb (sequence_majorant Un pr1).
 intros.
 assert (H := Vn_Un_Wn_order Un pr1 pr2).
 unfold has_lb in |- *.
@@ -486,7 +486,7 @@ Qed.
 Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2.
 intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *.
 tauto.
-Qed. 
+Qed.
 
 (**********)
 Lemma approx_maj :
@@ -628,234 +628,234 @@ 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. 
+ 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)). 
+    [ 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. 
+ [ apply Rabs_triang | ring ].
+rewrite (double_var eps); apply Rplus_lt_compat.
 rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3;
- unfold ge, N in |- *; apply le_max_l. 
-apply H4; unfold ge, N in |- *; apply le_max_r. 
+ unfold ge, N 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. 
+   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. 
+    [ 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. 
+ [ 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 ]. 
+ [ 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 ]. 
+ [ 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. 
-Qed. 
+   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.
+Qed.
 
-(**********) 
+(**********)
 Lemma CV_Cauchy :
- forall Un:nat -> R, sigT (fun l:R => Un_cv Un l) -> Cauchy_crit Un. 
-intros; elim X; intros. 
-unfold Cauchy_crit in |- *; intros. 
-unfold Un_cv in p; unfold R_dist in p. 
+ 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. 
+    [ 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)). 
+ 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. 
+ [ 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) ->
-    exists l : R, 0 < l /\ (forall n:nat, Rabs (Un n) <= l). 
-intros; elim X; intros. 
-cut (sigT (fun l:R => Un_cv (fun k:nat => Rabs (Un k)) l)). 
-intro. 
-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. 
+    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. 
-Qed. 
- 
-(**********) 
+ 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. 
-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. 
+   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)). 
+ (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 ]. 
+ [ 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. 
+ (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. 
+ [ 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). 
+ [ 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. 
+ 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. 
+ 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)). 
+ (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 ]. 
+ [ 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. 
+ (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 ]. 
+ [ 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. 
+ [ 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 ]. 
+ [ 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. 
+    [ prove_sup0 | assumption ] ].
+apply existT with l1; assumption.
+Qed.
 
 Lemma tech9 :
  forall Un:nat -> R,
@@ -905,13 +905,13 @@ 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). 
+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). 
+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.
@@ -931,7 +931,7 @@ 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; 
+ 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.
@@ -977,7 +977,7 @@ unfold R_dist in H4; rewrite <- Rabs_Rabsolu;
 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_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.
@@ -989,7 +989,7 @@ Qed.
 (**********)
 Lemma growing_ineq :
  forall (Un:nat -> R) (l:R),
-   Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l. 
+   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.
@@ -1042,14 +1042,14 @@ 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. 
-Qed. 
+   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.
+Qed.
 
 (* Un -> +oo *)
 Definition cv_infty (Un:nat -> R) : Prop :=
@@ -1265,7 +1265,7 @@ 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. 
+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;
diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v
index deb98492..6cab2486 100644
--- a/theories/Reals/SeqSeries.v
+++ b/theories/Reals/SeqSeries.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: SeqSeries.v,v 1.14.2.1 2004/07/16 19:31:15 herbelin Exp $ i*)
+(*i $Id: SeqSeries.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -36,12 +36,12 @@ intros;
   (sigT
      (fun l:R =>
         Un_cv (fun n:nat => sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) l)).
-intro;
+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; elim X; intros l1N H2.
+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).
@@ -217,7 +217,7 @@ Lemma Rseries_CV_comp :
    (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; apply cv_cauchy_2.
+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.
diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v
index b4026e67..11b9d57b 100644
--- a/theories/Reals/SplitAbsolu.v
+++ b/theories/Reals/SplitAbsolu.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i      $Id: SplitAbsolu.v,v 1.6.2.1 2004/07/16 19:31:15 herbelin Exp $       i*)
+(*i      $Id: SplitAbsolu.v 5920 2004-07-16 20:01:26Z herbelin $       i*)
 
 Require Import Rbasic_fun.
 
diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v
index 19df2afa..31d49b76 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,v 1.7.2.1 2004/07/16 19:31:15 herbelin Exp $ i*)
+(*i $Id: SplitRmult.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*)
 
diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v
index b11e51f0..3e2b6b9f 100644
--- a/theories/Reals/Sqrt_reg.v
+++ b/theories/Reals/Sqrt_reg.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Sqrt_reg.v,v 1.9.2.1 2004/07/16 19:31:15 herbelin Exp $ i*)
+(*i $Id: Sqrt_reg.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
diff --git a/theories/Relations/Newman.v b/theories/Relations/Newman.v
index 3cf604d8..ae914933 100755..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,v 1.7.2.1 2004/07/16 19:31:16 herbelin Exp $ i*)
+(*i $Id: Newman.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Rstar.
 
diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v
index 5e0e9ec8..22a08a27 100755..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,v 1.7.2.1 2004/07/16 19:31:16 herbelin Exp $ i*)
+(*i $Id: Operators_Properties.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (****************************************************************************)
 (*                            Bruno Barras                                  *)
diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v
index e115b0b0..22ba7413 100755..100644
--- a/theories/Relations/Relation_Definitions.v
+++ b/theories/Relations/Relation_Definitions.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Relation_Definitions.v,v 1.6.2.1 2004/07/16 19:31:16 herbelin Exp $ i*)
+(*i $Id: Relation_Definitions.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Section Relation_Definition.
 
diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v
index b6359ada..edc112e5 100755..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,v 1.8.2.1 2004/07/16 19:31:16 herbelin Exp $ i*)
+(*i $Id: Relation_Operators.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (****************************************************************************)
 (*                      Bruno Barras, Cristina Cornes                       *)
@@ -22,31 +22,31 @@ Require Import List.
 (** Some operators to build relations *)
 
 Section Transitive_Closure.
-  Variable A : Set.
+  Variable A : Type.
   Variable R : relation A.
 
-  Inductive clos_trans : A -> A -> Prop :=
-    | t_step : forall x y:A, R x y -> clos_trans x y
+  Inductive clos_trans (x: A) : A -> Prop :=
+    | t_step : forall y:A, R x y -> clos_trans x y
     | t_trans :
-        forall x y z:A, clos_trans x y -> clos_trans y z -> clos_trans x z.
+        forall y z:A, clos_trans x y -> clos_trans y z -> clos_trans x z.
 End Transitive_Closure.
 
 
 Section Reflexive_Transitive_Closure.
-  Variable A : Set.
+  Variable A : Type.
   Variable R : relation A.
 
-  Inductive clos_refl_trans : relation A :=
-    | rt_step : forall x y:A, R x y -> clos_refl_trans x y
-    | rt_refl : forall x:A, clos_refl_trans x x
+  Inductive clos_refl_trans (x:A) : A -> Prop:=
+    | rt_step : forall y:A, R x y -> clos_refl_trans x y
+    | rt_refl : clos_refl_trans x x
     | rt_trans :
-        forall x y z:A,
+        forall y z:A,
           clos_refl_trans x y -> clos_refl_trans y z -> clos_refl_trans x z.
 End Reflexive_Transitive_Closure.
 
 
 Section Reflexive_Symetric_Transitive_Closure.
-  Variable A : Set.
+  Variable A : Type.
   Variable R : relation A.
 
   Inductive clos_refl_sym_trans : relation A :=
@@ -62,7 +62,7 @@ End Reflexive_Symetric_Transitive_Closure.
 
 
 Section Transposee.
-  Variable A : Set.
+  Variable A : Type.
   Variable R : relation A.
 
   Definition transp (x y:A) := R y x.
@@ -70,7 +70,7 @@ End Transposee.
 
 
 Section Union.
-  Variable A : Set.
+  Variable A : Type.
   Variables R1 R2 : relation A.
 
   Definition union (x y:A) := R1 x y \/ R2 x y.
@@ -164,4 +164,4 @@ End Lexicographic_Exponentiation.
 
 Hint Unfold transp union: sets v62.
 Hint Resolve t_step rt_step rt_refl rst_step rst_refl: sets v62.
-Hint Immediate rst_sym: sets v62.
\ No newline at end of file
+Hint Immediate rst_sym: sets v62.
diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v
index 6c96f14d..2df0317b 100755..100644
--- a/theories/Relations/Relations.v
+++ b/theories/Relations/Relations.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Relations.v,v 1.6.2.1 2004/07/16 19:31:16 herbelin Exp $ i*)
+(*i $Id: Relations.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Relation_Definitions.
 Require Export Relation_Operators.
diff --git a/theories/Relations/Rstar.v b/theories/Relations/Rstar.v
index 7bb3ee93..4e62d73a 100755..100644
--- a/theories/Relations/Rstar.v
+++ b/theories/Relations/Rstar.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rstar.v,v 1.8.2.1 2004/07/16 19:31:16 herbelin Exp $ i*)
+(*i $Id: Rstar.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (** Properties of a binary relation [R] on type [A] *)
 
diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v
index 63f21fed..6ff73438 100644
--- a/theories/Setoids/Setoid.v
+++ b/theories/Setoids/Setoid.v
@@ -1,3 +1,4 @@
+
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
 (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
@@ -6,66 +7,658 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Setoid.v,v 1.5.2.1 2004/07/16 19:31:17 herbelin Exp $: i*)
+(*i $Id: Setoid.v 6306 2004-11-16 16:11:10Z sacerdot $: i*)
+
+Require Export Relation_Definitions.
+
+Set Implicit Arguments.
+
+(* 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 *)
+Inductive X_Relation_Class (X: Type) : Type :=
+   SymmetricReflexive :
+     forall A Aeq, symmetric A Aeq -> reflexive _ Aeq -> X_Relation_Class X
+ | AsymmetricReflexive : X -> forall A Aeq, reflexive A Aeq -> X_Relation_Class X
+ | SymmetricAreflexive : forall A Aeq, symmetric A Aeq -> X_Relation_Class X
+ | AsymmetricAreflexive : X -> forall A (Aeq : relation A), X_Relation_Class X
+ | Leibniz : Type -> X_Relation_Class X.
+
+Inductive variance : Set :=
+   Covariant
+ | Contravariant.
+
+Definition Argument_Class := X_Relation_Class variance.
+Definition Relation_Class := X_Relation_Class unit.
+
+Inductive Reflexive_Relation_Class : Type :=
+   RSymmetric :
+     forall A Aeq, symmetric A Aeq -> reflexive _ Aeq -> Reflexive_Relation_Class
+ | RAsymmetric :
+     forall A Aeq, reflexive A Aeq -> Reflexive_Relation_Class
+ | RLeibniz : Type -> Reflexive_Relation_Class.
+
+Inductive Areflexive_Relation_Class  : Type :=
+ | ASymmetric : forall A Aeq, symmetric A Aeq -> Areflexive_Relation_Class
+ | AAsymmetric : forall A (Aeq : relation A), Areflexive_Relation_Class.
+
+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).
+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.
+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).
+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.
+
+Inductive nelistT (A : Type) : Type :=
+   singl : A -> nelistT A
+ | cons : A -> nelistT A -> nelistT A.
+
+Definition Arguments := nelistT Argument_Class.
+
+Implicit Type In: Arguments.
+
+Definition function_type_of_morphism_signature :
+ Arguments -> Relation_Class -> Type.
+  intros In Out.
+  induction In.
+    exact (carrier_of_relation_class a -> carrier_of_relation_class Out).
+    exact (carrier_of_relation_class a -> IHIn).
+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.
+        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)).
+      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 x, relation_of_relation_class Out (f x) (g x)).
+  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)).
+    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 x, IHIn (f x) (g x)).
+Defined. 
+
+Definition make_compatibility_goal :=
+ (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}.
+
+Definition list_of_Leibniz_of_list_of_types: nelistT Type -> Arguments.
+ induction 1.
+   exact (singl (Leibniz _ a)).
+   exact (cons (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'.
+  intros.
+  exists X.
+  induction In;  unfold make_compatibility_goal; simpl.
+    reflexivity.
+    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 *)
+
+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.
+Defined.
+
+(* 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).
+ intros.
+ exists Aeq.
+ unfold make_compatibility_goal; simpl; split; eauto.
+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).
+ intros.
+ exists Aeq.
+ unfold make_compatibility_goal; simpl; split; eauto.
+Defined.
+
+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).
+ intros.
+ exists Aeq.
+ unfold make_compatibility_goal; simpl; unfold impl; eauto.
+Defined.
+
+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).
+ intros.
+ exists Aeq.
+ unfold make_compatibility_goal; simpl; unfold impl; eauto.
+Defined.
+
+(* iff AS A RELATION *)
+
+Add Relation Prop iff
+ reflexivity proved by iff_refl
+ symmetry proved by iff_sym
+ transitivity proved by iff_trans
+ as iff_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.
+
+(* impl AS A RELATION *)
+
+Theorem impl_trans: transitive _ impl.
+ hnf; unfold impl; tauto.
+Qed.
+
+Add Relation Prop impl
+ reflexivity proved by impl_refl
+ transitivity proved by impl_trans
+ as impl_relation.
+
+(* THE CIC PART OF THE REFLEXIVE TACTIC (SETOID REWRITE) *)
 
-Section Setoid.
+Inductive rewrite_direction : Type :=
+   Left2Right
+ | Right2Left.
 
-Variable A : Type.
-Variable Aeq : A -> A -> Prop.
+Implicit Type dir: rewrite_direction.
 
-Record Setoid_Theory : Prop := 
+Definition variance_of_argument_class : Argument_Class -> option variance.
+ 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
+   end.
+
+Lemma opposite_direction_idempotent:
+ forall dir, (opposite_direction (opposite_direction dir)) = dir.
+  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,
+      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).
+Defined.
+
+Definition relation_class_of_areflexive_relation_class:
+ 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).
+
+Definition carrier_of_areflexive_relation_class :=
+ 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).
+
+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'
+  | ToReplace : Morphism_Context Hole dir Hole dir
+  | ToKeep :
+     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),
+      relation_of_areflexive_relation_class S x x ->
+        Morphism_Context Hole dir (relation_class_of_areflexive_relation_class S) dir'
+with Morphism_Context_List Hole dir :
+   rewrite_direction -> Arguments -> Type
+:=
+    fcl_singl :
+      forall S dir' 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'' (singl S)
+ | fcl_cons :
+      forall S L dir' 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).
+
+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 (prodT (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 *)
+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).
+Defined.
+
+Definition directed_relation_of_argument_class:
+ 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).
+  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.
+   apply and.
+     exact
+      (directed_relation_of_argument_class (get_rewrite_direction dir a) a c c0).
+     exact (IHIn p p0).
+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).
+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).
+  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.
+         exact H1.
+       apply IHIn.
+         apply H; exact H0.       
+          exact H1.
+     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.
+    rewrite H0; apply IHIn.
+      apply H.
+      exact H1.
+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).
+  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.
+         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. 
+          exact H1.
+    rewrite H0; apply IHIn.
+      apply H.
+      exact H1.
+Qed.
+
+Definition interp :
+ forall Hole dir Out dir', carrier_of_relation_class Hole ->
+  Morphism_Context Hole dir Out dir' -> carrier_of_relation_class Out.
+ intros Hole dir Out dir' H t.
+ elim t using
+  (@Morphism_Context_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.
+
+(*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.
+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) ->
+    (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 =>
+        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
+    (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 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).
+
+  change
+    (directed_relation_of_argument_class (get_rewrite_direction dir'' S) S
+       (eq_rect _ (fun T : Type => T) (interp E1 m) _
+         (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'' _
+       (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 *)
+
+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 Setoid.
+(* END OF UTILITY/BACKWARD COMPATIBILITY PART *)
+
+(* A FEW EXAMPLES ON iff *)
 
-Definition Prop_S : Setoid_Theory Prop iff.
-split; [ exact iff_refl | exact iff_sym | exact iff_trans ].
+(* impl IS A MORPHISM *)
+
+Add Morphism impl with signature iff ==> iff ==> iff as Impl_Morphism.
+unfold impl; tauto.
 Qed.
 
-Add Setoid Prop iff Prop_S.
+(* and IS A MORPHISM *)
 
-Hint Resolve (Seq_refl Prop iff Prop_S): setoid.
-Hint Resolve (Seq_sym Prop iff Prop_S): setoid.
-Hint Resolve (Seq_trans Prop iff Prop_S): setoid.
+Add Morphism and with signature iff ==> iff ==> iff as And_Morphism.
+ tauto.
+Qed.
 
-Add Morphism or : or_ext.
-intros.
-inversion H1.
-left.
-inversion H.
-apply (H3 H2).
+(* or IS A MORPHISM *)
 
-right.
-inversion H0.
-apply (H3 H2).
+Add Morphism or with signature iff ==> iff ==> iff as Or_Morphism.
+ tauto.
 Qed.
 
-Add Morphism and : and_ext.
-intros.
-inversion H1.
-split.
-inversion H.
-apply (H4 H2).
+(* not IS A MORPHISM *)
 
-inversion H0.
-apply (H4 H3).
+Add Morphism not with signature iff ==> iff as Not_Morphism.
+ tauto.
 Qed.
 
-Add Morphism not : not_ext.
-red in |- *; intros.
-apply H0.
-inversion H.
-apply (H3 H1).
+(* THE SAME EXAMPLES ON impl *)
+
+Add Morphism and with signature impl ++> impl ++> impl as And_Morphism2.
+ unfold impl; tauto.
 Qed.
 
-Definition fleche (A B:Prop) := A -> B.
+Add Morphism or with signature impl ++> impl ++> impl as Or_Morphism2.
+ unfold impl; tauto.
+Qed.
 
-Add Morphism fleche : fleche_ext.
-unfold fleche in |- *.
-intros.
-inversion H0.
-inversion H.
-apply (H3 (H1 (H6 H2))).
+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 [].
diff --git a/theories/Setoids/intro.tex b/theories/Setoids/intro.tex
new file mode 100644
index 00000000..50cd025d
--- /dev/null
+++ b/theories/Setoids/intro.tex
@@ -0,0 +1 @@
+\section{Setoids}\label{Setoids}
diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v
index 98cb14e4..382b5d72 100755..100644
--- a/theories/Sets/Classical_sets.v
+++ b/theories/Sets/Classical_sets.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Classical_sets.v,v 1.4.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Classical_sets.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Constructive_sets.
diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v
index a2bc781d..7e4471a0 100755..100644
--- a/theories/Sets/Constructive_sets.v
+++ b/theories/Sets/Constructive_sets.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Constructive_sets.v,v 1.5.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Constructive_sets.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Ensembles.
 
diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v
index 9fae12f5..0b2cf3e3 100755..100644
--- a/theories/Sets/Cpo.v
+++ b/theories/Sets/Cpo.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Cpo.v,v 1.5.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Cpo.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Relations_1.
diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v
index 05afc298..d71c96b0 100755..100644
--- a/theories/Sets/Ensembles.v
+++ b/theories/Sets/Ensembles.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Ensembles.v,v 1.7.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Ensembles.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Section Ensembles.
 Variable U : Type.
diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v
index 5a2e4397..47b41ec3 100755..100644
--- a/theories/Sets/Finite_sets.v
+++ b/theories/Sets/Finite_sets.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Finite_sets.v,v 1.6.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Finite_sets.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Import Ensembles.
 
diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v
index 952965e8..ddbf62e4 100755..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,v 1.7.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Finite_sets_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Finite_sets.
 Require Export Constructive_sets.
diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v
index f58f2f81..c97aa127 100755..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,v 1.6.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Image.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Finite_sets.
 Require Export Constructive_sets.
diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v
index c357e26c..806e9dde 100755..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,v 1.5.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Infinite_sets.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Finite_sets.
 Require Export Constructive_sets.
diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v
index 26f29c96..cfadd81c 100755..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,v 1.6.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Integers.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Finite_sets.
 Require Export Constructive_sets.
diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v
index a308282b..cdc8520c 100755..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,v 1.9.2.1 2004/07/16 19:31:17 herbelin Exp $ i*)
+(*i $Id: Multiset.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (* G. Huet 1-9-95 *)
 
diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v
index b3e59886..9924ba66 100755..100644
--- a/theories/Sets/Partial_Order.v
+++ b/theories/Sets/Partial_Order.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Partial_Order.v,v 1.6.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Partial_Order.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Relations_1.
diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v
index af6151bf..2b6c899f 100755..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,v 1.6.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Permut.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 (* G. Huet 1-9-95 *)
 
diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v
index a7f5e9f4..c9a52ac2 100755..100644
--- a/theories/Sets/Powerset.v
+++ b/theories/Sets/Powerset.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Powerset.v,v 1.5.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Powerset.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Relations_1.
diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v
index 05c60def..210017d4 100755..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,v 1.5.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Powerset_Classical_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Constructive_sets.
diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v
index 2c71f529..47ef2ea7 100755..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,v 1.8.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Powerset_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Constructive_sets.
diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v
index e33746a9..64c4c654 100755..100644
--- a/theories/Sets/Relations_1.v
+++ b/theories/Sets/Relations_1.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_1.v,v 1.4.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Relations_1.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Section Relations_1.
    Variable U : Type.
diff --git a/theories/Sets/Relations_1_facts.v b/theories/Sets/Relations_1_facts.v
index 62688895..6ee7f5e2 100755..100644
--- a/theories/Sets/Relations_1_facts.v
+++ b/theories/Sets/Relations_1_facts.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_1_facts.v,v 1.7.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Relations_1_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Relations_1.
 
diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v
index 15d3ee2d..a74102fd 100755..100644
--- a/theories/Sets/Relations_2.v
+++ b/theories/Sets/Relations_2.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_2.v,v 1.4.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Relations_2.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Relations_1.
 
@@ -32,18 +32,18 @@ Section Relations_2.
 Variable U : Type.
 Variable R : Relation U.
 
-Inductive Rstar : Relation U :=
-  | Rstar_0 : forall x:U, Rstar x x
-  | Rstar_n : forall x y z:U, R x y -> Rstar y z -> Rstar x z.
+Inductive Rstar (x:U) : U -> Prop :=
+  | Rstar_0 : Rstar x x
+  | Rstar_n : forall y z:U, R x y -> Rstar y z -> Rstar x z.
 
-Inductive Rstar1 : Relation U :=
-  | Rstar1_0 : forall x:U, Rstar1 x x
-  | Rstar1_1 : forall x y:U, R x y -> Rstar1 x y
-  | Rstar1_n : forall x y z:U, Rstar1 x y -> Rstar1 y z -> Rstar1 x z.
+Inductive Rstar1 (x:U) : U -> Prop :=
+  | Rstar1_0 : Rstar1 x x
+  | Rstar1_1 : forall y:U, R x y -> Rstar1 x y
+  | Rstar1_n : forall y z:U, Rstar1 x y -> Rstar1 y z -> Rstar1 x z.
 
-Inductive Rplus : Relation U :=
-  | Rplus_0 : forall x y:U, R x y -> Rplus x y
-  | Rplus_n : forall x y z:U, R x y -> Rplus y z -> Rplus x z.
+Inductive Rplus (x:U) : U -> Prop :=
+  | Rplus_0 : forall y:U, R x y -> Rplus x y
+  | Rplus_n : forall y z:U, R x y -> Rplus y z -> Rplus x z.
 
 Definition Strongly_confluent : Prop :=
   forall x a b:U, R x a -> R x b -> ex (fun z:U => R a z /\ R b z).
diff --git a/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v
index 4c729fe7..3291f3ee 100755..100644
--- a/theories/Sets/Relations_2_facts.v
+++ b/theories/Sets/Relations_2_facts.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_2_facts.v,v 1.6.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Relations_2_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Relations_1.
 Require Export Relations_1_facts.
diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v
index 6a254819..b8c65148 100755..100644
--- a/theories/Sets/Relations_3.v
+++ b/theories/Sets/Relations_3.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_3.v,v 1.7.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Relations_3.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Relations_1.
 Require Export Relations_2.
@@ -46,9 +46,9 @@ Section Relations_3.
    
    Definition Confluent : Prop := forall x:U, confluent x.
    
-   Inductive noetherian : U -> Prop :=
+   Inductive noetherian (x: U) : Prop :=
        definition_of_noetherian :
-         forall x:U, (forall y:U, R x y -> noetherian y) -> noetherian x.
+         (forall y:U, R x y -> noetherian y) -> noetherian x.
    
    Definition Noetherian : Prop := forall x:U, noetherian x.
    
diff --git a/theories/Sets/Relations_3_facts.v b/theories/Sets/Relations_3_facts.v
index 34322dc7..38ff9eae 100755..100644
--- a/theories/Sets/Relations_3_facts.v
+++ b/theories/Sets/Relations_3_facts.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Relations_3_facts.v,v 1.6.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Relations_3_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
 
 Require Export Relations_1.
 Require Export Relations_1_facts.
diff --git a/theories/Sets/Uniset.v b/theories/Sets/Uniset.v
index 10d26f22..42c96191 100644
--- a/theories/Sets/Uniset.v
+++ b/theories/Sets/Uniset.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Uniset.v,v 1.9.2.1 2004/07/16 19:31:18 herbelin Exp $ i*)
+(*i $Id: Uniset.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Sets as characteristic functions *)
 
diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v
index 41594749..346ae95a 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,v 1.3.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Heap.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** A development of Treesort on Heap trees *)
 
diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v
index 43a0f0bc..b3287cd1 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,v 1.4.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Permutation.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Relations.
 Require Import List.
diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v
index aa829fea..0e0bfe8f 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,v 1.4.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Sorting.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import List.
 Require Import Multiset.
diff --git a/theories/Sorting/intro.tex b/theories/Sorting/intro.tex
new file mode 100644
index 00000000..64ae4c88
--- /dev/null
+++ b/theories/Sorting/intro.tex
@@ -0,0 +1 @@
+\section{Sorting}\label{Sorting}
diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v
new file mode 100644
index 00000000..919989fd
--- /dev/null
+++ b/theories/Strings/Ascii.v
@@ -0,0 +1,133 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* $Id: Ascii.v 8026 2006-02-11 19:40:49Z herbelin $ *)
+
+(* 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 character as a 8 bits constructor *)
+ 
+Inductive ascii : Set := Ascii (_ _ _ _ _ _ _ _ : bool).
+
+Delimit Scope char_scope with char.
+Bind Scope char_scope with ascii.
+ 
+Definition zero := Ascii false false false false false false false false.
+ 
+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 (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 (f a1 b1) (f a2 b2) (f a3 b3) (f a4 b4) 
+        (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
+  end.
+
+(* Definition of a decidable function that is effective *)
+ 
+Definition ascii_dec : forall a b : ascii, {a = b} + {a <> b}.
+ decide equality; apply bool_dec.
+Defined.
+
+(** *** Conversion between natural numbers modulo 256 and ascii characters *)
+
+(* 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 :=
+  match n with
+  | 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
+      end
+  end.
+
+
+(* 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 *)
+
+Definition ascii_of_nat (a : nat) :=
+  match a with
+  | O => zero
+  | S a' => ascii_of_pos (P_of_succ_nat a')
+  end.
+ 
+(* 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 * (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).
+
+Theorem ascii_nat_embedding : 
+  forall a : ascii, ascii_of_nat (nat_of_ascii a) = a.
+Proof.
+  destruct a as [[|][|][|][|][|][|][|][|]]; compute; reflexivity.
+Abort.
+
+(** *** Concrete syntax *)
+
+(**
+  Ascii characters can be represented in scope char_scope as follows:
+  - ["c"]   represents itself if c is a character of code < 128,
+  - [""""]  is an exception: it represents the ascii character 34
+            (double quote),
+  - ["nnn"] represents the ascii character of decimal code nnn.
+
+  For instance, both ["065"] and ["A"] denote the character `uppercase
+  A', and both ["034"] and [""""] denote the character `double quote'.
+
+  Notice that the ascii characters of code >= 128 do not denote
+  stand-alone utf8 characters so that only the notation "nnn" is
+  available for them (unless your terminal is able to represent them,
+  which is typically not the case in coqide). 
+*)
+
+Open Local Scope char_scope.
+
+Example Space := " ".
+Example DoubleQuote := """".
+Example Beep := "007".
diff --git a/theories/Strings/String.v b/theories/Strings/String.v
new file mode 100644
index 00000000..f2c58364
--- /dev/null
+++ b/theories/Strings/String.v
@@ -0,0 +1,392 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: String.v 8026 2006-02-11 19:40:49Z herbelin $ *)
+
+(** Contributed by Laurent Théry (INRIA);
+    Adapted to Coq V8 by the Coq Development Team *)
+
+Require Import Arith.
+Require Import Ascii.
+
+(** *** Definition of strings *)
+
+(** Implementation of string as list of ascii characters *)
+ 
+Inductive string : Set :=
+  | EmptyString : string
+  | String : ascii -> string -> string.
+
+Delimit Scope string_scope with string.
+Bind Scope string_scope with string.
+Open Local Scope string_scope.
+
+(** Equality is decidable *)
+
+Definition string_dec : forall s1 s2 : string, {s1 = s2} + {s1 <> s2}.
+ decide equality; apply ascii_dec.
+Defined.
+
+(** *** Concatenation of strings *)
+
+Reserved Notation "x ++ y" (right associativity, at level 60).
+
+Fixpoint append (s1 s2 : string) {struct s1} : string :=
+  match s1 with
+  | EmptyString => s2
+  | String c s1' => String c (s1' ++ s2)
+  end
+
+where "s1 ++ s2" := (append s1 s2) : string_scope.
+
+(******************************)
+(** Length                    *)
+(******************************)
+ 
+Fixpoint length (s : string) : nat :=
+  match s with
+  | EmptyString => 0
+  | String c s' => S (length s')
+  end.
+
+(******************************)
+(** Nth character of a string *)
+(******************************)
+ 
+Fixpoint get (n : nat) (s : string) {struct s} : option ascii :=
+  match s with
+  | EmptyString => None
+  | String c s' => match n with
+                   | O => Some c
+                   | S n' => get n' s'
+                   end
+  end.
+
+(** Two lists that are identical through get are syntactically equal *)
+ 
+Theorem get_correct :
+  forall s1 s2 : string, (forall n : nat, get n s1 = get n s2) <-> s1 = s2.
+Proof.
+intros s1; elim s1; simpl in |- *.
+intros s2; case s2; simpl in |- *; split; auto.
+intros H; generalize (H 0); intros H1; inversion H1.
+intros; discriminate.
+intros a s1' Rec s2; case s2; simpl in |- *; split; auto.
+intros H; generalize (H 0); intros H1; inversion H1.
+intros; discriminate.
+intros H; generalize (H 0); simpl in |- *; intros H1; inversion H1.
+case (Rec s).
+intros H0; rewrite H0; auto.
+intros n; exact (H (S n)).
+intros H; injection H; intros H1 H2 n; case n; auto.
+rewrite H2; trivial.
+rewrite H1; auto.
+Qed.
+
+(** The first elements of [s1 ++ s2] are the ones of [s1] *)
+ 
+Theorem append_correct1 :
+ forall (s1 s2 : string) (n : nat),
+ n < length s1 -> get n s1 = get n (s1 ++ s2).
+Proof.
+intros s1; elim s1; simpl in |- *; auto.
+intros s2 n H; inversion H.
+intros a s1' Rec s2 n; case n; simpl in |- *; auto.
+intros n0 H; apply Rec; auto.
+apply lt_S_n; auto.
+Qed.
+
+(** The last elements of [s1 ++ s2] are the ones of [s2] *)
+ 
+Theorem append_correct2 :
+ forall (s1 s2 : string) (n : nat),
+ get n s2 = get (n + length s1) (s1 ++ s2).
+Proof.
+intros s1; elim s1; simpl in |- *; auto.
+intros s2 n; rewrite plus_comm; simpl in |- *; auto.
+intros a s1' Rec s2 n; case n; simpl in |- *; auto.
+generalize (Rec s2 0); simpl in |- *; auto.
+intros n0; rewrite <- Plus.plus_Snm_nSm; auto.
+Qed.
+
+(** *** Substrings *)
+
+(** [substring n m s] returns the substring of [s] that starts
+    at position [n] and of length [m];
+    if this does not make sense it returns [""] *)
+ 
+Fixpoint substring (n m : nat) (s : string) {struct s} : string :=
+  match n, m, s with
+  | 0, 0, _ => EmptyString
+  | 0, S m', EmptyString => s
+  | 0, S m', String c s' => String c (substring 0 m' s')
+  | S n', _, EmptyString => s
+  | S n', _, String c s' => substring n' m s'
+  end.
+
+(** The substring is included in the initial string *)
+ 
+Theorem substring_correct1 :
+ forall (s : string) (n m p : nat),
+ p < m -> get p (substring n m s) = get (p + n) s.
+Proof.
+intros s; elim s; simpl in |- *; auto.
+intros n; case n; simpl in |- *; auto.
+intros m; case m; simpl in |- *; auto.
+intros a s' Rec; intros n; case n; simpl in |- *; auto.
+intros m; case m; simpl in |- *; auto.
+intros p H; inversion H.
+intros m' p; case p; simpl in |- *; auto.
+intros n0 H; apply Rec; simpl in |- *; auto.
+apply Lt.lt_S_n; auto.
+intros n' m p H; rewrite <- Plus.plus_Snm_nSm; simpl in |- *; auto.
+Qed.
+
+(** The substring has at most [m] elements *)
+ 
+Theorem substring_correct2 :
+ forall (s : string) (n m p : nat), m <= p -> get p (substring n m s) = None.
+Proof.
+intros s; elim s; simpl in |- *; auto.
+intros n; case n; simpl in |- *; auto.
+intros m; case m; simpl in |- *; auto.
+intros a s' Rec; intros n; case n; simpl in |- *; auto.
+intros m; case m; simpl in |- *; auto.
+intros m' p; case p; simpl in |- *; auto.
+intros H; inversion H.
+intros n0 H; apply Rec; simpl in |- *; auto.
+apply Le.le_S_n; auto.
+Qed.
+
+(** *** Test functions *)
+
+(** Test if [s1] is a prefix of [s2] *)
+ 
+Fixpoint prefix (s1 s2 : string) {struct s2} : bool :=
+  match s1 with
+  | EmptyString => true
+  | String a s1' =>
+      match s2 with
+      | EmptyString => false
+      | String b s2' =>
+          match ascii_dec a b with
+          | left _ => prefix s1' s2'
+          | right _ => false
+          end
+      end
+  end.
+
+(** If [s1] is a prefix of [s2], it is the [substring] of length
+    [length s1] starting at position [O] of [s2] *)
+ 
+Theorem prefix_correct :
+ forall s1 s2 : string,
+ prefix s1 s2 = true <-> substring 0 (length s1) s2 = s1.
+Proof.
+intros s1; elim s1; simpl in |- *; auto.
+intros s2; case s2; simpl in |- *; split; auto.
+intros a s1' Rec s2; case s2; simpl in |- *; auto.
+split; intros; discriminate.
+intros b s2'; case (ascii_dec a b); simpl in |- *; auto.
+intros e; case (Rec s2'); intros H1 H2; split; intros H3; auto.
+rewrite e; rewrite H1; auto.
+apply H2; injection H3; auto.
+intros n; split; intros; try discriminate.
+case n; injection H; auto.
+Qed.
+
+(** Test if, starting at position [n], [s1] occurs in [s2]; if
+    so it returns the position *)
+ 
+Fixpoint index (n : nat) (s1 s2 : string) {struct s2} : option nat :=
+  match s2, n with
+  | EmptyString, 0 =>
+      match s1 with
+      | EmptyString => Some 0
+      | String a s1' => None
+      end
+  | EmptyString, S n' => None
+  | String b s2', 0 => 
+      if prefix s1 s2 then Some 0
+      else
+        match index 0 s1 s2' with
+        | Some n => Some (S n)
+        | None => None
+        end
+   | String b s2', S n' =>
+      match index n' s1 s2' with
+      | Some n => Some (S n)
+      | None => None
+      end
+  end.
+
+(* Dirty trick to evaluate locally that prefix reduces itself *)
+Opaque prefix.
+
+(** If the result of [index] is [Some m], [s1] in [s2] at position [m] *)
+ 
+Theorem index_correct1 :
+ forall (n m : nat) (s1 s2 : string),
+ index n s1 s2 = Some m -> substring m (length s1) s2 = s1.
+Proof.
+intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *;
+ auto.
+intros n; case n; simpl in |- *; auto.
+intros m s1; case s1; simpl in |- *; auto.
+intros H; injection H; intros H1; rewrite <- H1; auto.
+intros; discriminate.
+intros; discriminate.
+intros b s2' Rec n m s1.
+case n; simpl in |- *; auto.
+generalize (prefix_correct s1 (String b s2'));
+ case (prefix s1 (String b s2')).
+intros H0 H; injection H; intros H1; rewrite <- H1; auto.
+case H0; simpl in |- *; auto.
+case m; simpl in |- *; auto.
+case (index 0 s1 s2'); intros; discriminate.
+intros m'; generalize (Rec 0 m' s1); case (index 0 s1 s2'); auto.
+intros x H H0 H1; apply H; injection H1; intros H2; injection H2; auto.
+intros; discriminate.
+intros n'; case m; simpl in |- *; auto.
+case (index n' s1 s2'); intros; discriminate.
+intros m'; generalize (Rec n' m' s1); case (index n' s1 s2'); auto.
+intros x H H1; apply H; injection H1; intros H2; injection H2; auto.
+intros; discriminate.
+Qed.
+
+(** If the result of [index] is [Some m], 
+    [s1] does not occur in [s2] before [m] *)
+ 
+Theorem index_correct2 :
+ forall (n m : nat) (s1 s2 : string),
+ index n s1 s2 = Some m ->
+ forall p : nat, n <= p -> p < m -> substring p (length s1) s2 <> s1.
+Proof.
+intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *;
+ auto.
+intros n; case n; simpl in |- *; auto.
+intros m s1; case s1; simpl in |- *; auto.
+intros H; injection H; intros H1; rewrite <- H1.
+intros p H0 H2; inversion H2.
+intros; discriminate.
+intros; discriminate.
+intros b s2' Rec n m s1.
+case n; simpl in |- *; auto.
+generalize (prefix_correct s1 (String b s2'));
+ case (prefix s1 (String b s2')).
+intros H0 H; injection H; intros H1; rewrite <- H1; auto.
+intros p H2 H3; inversion H3.
+case m; simpl in |- *; auto.
+case (index 0 s1 s2'); intros; discriminate.
+intros m'; generalize (Rec 0 m' s1); case (index 0 s1 s2'); auto.
+intros x H H0 H1 p; try case p; simpl in |- *; auto.
+intros H2 H3; red in |- *; intros H4; case H0.
+intros H5 H6; absurd (false = true); auto with bool.
+intros n0 H2 H3; apply H; auto.
+injection H1; intros H4; injection H4; auto.
+apply Le.le_O_n.
+apply Lt.lt_S_n; auto.
+intros; discriminate.
+intros n'; case m; simpl in |- *; auto.
+case (index n' s1 s2'); intros; discriminate.
+intros m'; generalize (Rec n' m' s1); case (index n' s1 s2'); auto.
+intros x H H0 p; case p; simpl in |- *; auto.
+intros H1; inversion H1; auto.
+intros n0 H1 H2; apply H; auto.
+injection H0; intros H3; injection H3; auto.
+apply Le.le_S_n; auto.
+apply Lt.lt_S_n; auto.
+intros; discriminate.
+Qed.
+
+(** If the result of [index] is [None], [s1] does not occur in [s2] 
+    after [n] *)
+ 
+Theorem index_correct3 :
+ forall (n m : nat) (s1 s2 : string),
+ index n s1 s2 = None ->
+ s1 <> EmptyString -> n <= m -> substring m (length s1) s2 <> s1.
+Proof.
+intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *;
+ auto.
+intros n; case n; simpl in |- *; auto.
+intros m s1; case s1; simpl in |- *; auto.
+case m; intros; red in |- *; intros; discriminate.
+intros n' m; case m; auto.
+intros s1; case s1; simpl in |- *; auto.
+intros b s2' Rec n m s1.
+case n; simpl in |- *; auto.
+generalize (prefix_correct s1 (String b s2'));
+ case (prefix s1 (String b s2')).
+intros; discriminate.
+case m; simpl in |- *; auto with bool.
+case s1; simpl in |- *; auto.
+intros a s H H0 H1 H2; red in |- *; intros H3; case H.
+intros H4 H5; absurd (false = true); auto with bool.
+case s1; simpl in |- *; auto.
+intros a s n0 H H0 H1 H2;
+ change (substring n0 (length (String a s)) s2' <> String a s) in |- *;
+ apply (Rec 0); auto.
+generalize H0; case (index 0 (String a s) s2'); simpl in |- *; auto; intros;
+ discriminate.
+apply Le.le_O_n.
+intros n'; case m; simpl in |- *; auto.
+intros H H0 H1; inversion H1.
+intros n0 H H0 H1; apply (Rec n'); auto.
+generalize H; case (index n' s1 s2'); simpl in |- *; auto; intros;
+ discriminate.
+apply Le.le_S_n; auto.
+Qed.
+
+(* Back to normal for prefix *)
+Transparent prefix.
+
+(** If we are searching for the [Empty] string and the answer is no
+    this means that [n] is greater than the size of [s] *)
+ 
+Theorem index_correct4 :
+ forall (n : nat) (s : string),
+ index n EmptyString s = None -> length s < n.
+Proof.
+intros n s; generalize n; clear n; elim s; simpl in |- *; auto.
+intros n; case n; simpl in |- *; auto.
+intros; discriminate.
+intros; apply Lt.lt_O_Sn.
+intros a s' H n; case n; simpl in |- *; auto.
+intros; discriminate.
+intros n'; generalize (H n'); case (index n' EmptyString s'); simpl in |- *;
+ auto.
+intros; discriminate.
+intros H0 H1; apply Lt.lt_n_S; auto.
+Qed.
+
+(** Same as [index] but with no optional type, we return [0] when it
+    does not occur *)
+ 
+Definition findex n s1 s2 :=
+  match index n s1 s2 with
+  | Some n => n
+  | None => 0
+  end.
+
+(** *** Concrete syntax *)
+
+(**
+  The concrete syntax for strings in scope string_scope follows the
+  Coq convention for strings: all ascii characters of code less than
+  128 are litteral to the exception of the character `double quote'
+  which must be doubled.
+
+  Strings that involve ascii characters of code >= 128 which are not
+  part of a valid utf8 sequence of characters are not representable
+  using the Coq string notation (use explicitly the String constructor
+  with the ascii codes of the characters).
+*)
+
+Example HelloWorld := "	""Hello world!""
+".
diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v
index a3f16888..940569bd 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,v 1.9.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Disjoint_Union.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Author: Cristina Cornes
     From : Constructing Recursion Operators in Type Theory                 
diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v
index 1677659c..f596640d 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,v 1.7.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Inclusion.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Author: Bruno Barras *)
 
diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v
index f2cf1d2e..3323590e 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,v 1.10.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Inverse_Image.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Author: Bruno Barras *)
 
diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v
index d8a4d37c..988d2475 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,v 1.10.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Lexicographic_Exponentiation.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Author: Cristina Cornes
 
diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v
index 8ac178fc..035c1e65 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,v 1.12.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Lexicographic_Product.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Authors: Bruno Barras, Cristina Cornes *)
 
diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v
index 2e9d497b..5bf82ffb 100644
--- a/theories/Wellfounded/Transitive_Closure.v
+++ b/theories/Wellfounded/Transitive_Closure.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Transitive_Closure.v,v 1.7.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Transitive_Closure.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Author: Bruno Barras *)
 
diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v
index 8f31ce9f..269cfd9d 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,v 1.9.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Union.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Author: Bruno Barras *)
 
diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v
index 4a20c518..e9a18e74 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,v 1.7.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Well_Ordering.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Author: Cristina Cornes.
     From: Constructing Recursion Operators in Type Theory
diff --git a/theories/Wellfounded/Wellfounded.v b/theories/Wellfounded/Wellfounded.v
index 87c00b47..d5dfd072 100644
--- a/theories/Wellfounded/Wellfounded.v
+++ b/theories/Wellfounded/Wellfounded.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Wellfounded.v,v 1.4.2.1 2004/07/16 19:31:19 herbelin Exp $ i*)
+(*i $Id: Wellfounded.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Export Disjoint_Union.
 Require Export Inclusion.
diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v
index 11fa3872..02cf5f2d 100644
--- a/theories/ZArith/BinInt.v
+++ b/theories/ZArith/BinInt.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: BinInt.v,v 1.5.2.1 2004/07/16 19:31:20 herbelin Exp $ i*)
+(*i $Id: BinInt.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
 
 (***********************************************************)
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
@@ -17,6 +17,8 @@ Require Export Pnat.
 Require Import BinNat.
 Require Import Plus.
 Require Import Mult.
+
+Unset Boxed Definitions.
 (**********************************************************************)
 (** Binary integer numbers *)
 
@@ -1035,4 +1037,4 @@ Definition Zabs_N (z:Z) :=
 Definition Z_of_N (x:N) := match x with
                            | N0 => Z0
                            | Npos p => Zpos p
-                           end.
\ No newline at end of file
+                           end.
diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v
index 069ddd42..af1fdd0b 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,v 1.20.2.1 2004/07/16 19:31:20 herbelin Exp $ i*)
+(*i $Id: Wf_Z.v 6984 2005-05-02 10:50:15Z herbelin $ i*)
 
 Require Import BinInt.
 Require Import Zcompare.
@@ -176,11 +176,11 @@ apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
 intros; elim H; simpl in |- *; trivial.
 Qed.
 
-(** A more general induction principal using [Zlt]. *)
+(** A more general induction principle on non-negative numbers using [Zlt]. *)
 
-Lemma Z_lt_rec :
+Lemma Zlt_0_rec :
  forall P:Z -> Type,
-   (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
+   (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).
@@ -189,10 +189,29 @@ 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.
+
+(** 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_induction :
  forall P:Z -> Prop,
    (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
@@ -201,4 +220,37 @@ Proof.
 exact Z_lt_rec.
 Qed.
 
+(** 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_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 7e361621..45749fa3 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,v 1.5.2.2 2004/08/03 17:56:30 herbelin Exp $ i*)
+(*i $Id: ZArith.v 6013 2004-08-03 17:56:19Z herbelin $ i*)
 
 (** Library for manipulating integers based on binary encoding *)
 
diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v
index 694e071e..20fd6b5f 100644
--- a/theories/ZArith/ZArith_base.v
+++ b/theories/ZArith/ZArith_base.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ZArith_base.v,v 1.5.2.1 2004/07/16 19:31:20 herbelin Exp $ *)
+(* $Id: ZArith_base.v 8032 2006-02-12 21:20:48Z herbelin $ *)
 
 (** Library for manipulating integers based on binary encoding.
     These are the basic modules, required by [Omega] and [Ring] for instance. 
@@ -19,6 +19,8 @@ Require Export Zcompare.
 Require Export Zorder.
 Require Export Zeven.
 Require Export Zmin.
+Require Export Zmax.
+Require Export Zminmax.
 Require Export Zabs.
 Require Export Znat.
 Require Export auxiliary.
@@ -31,4 +33,4 @@ Hint Resolve Zle_refl Zplus_comm Zplus_assoc Zmult_comm Zmult_assoc Zplus_0_l
   Zplus_0_r Zmult_1_l Zplus_opp_l Zplus_opp_r Zmult_plus_distr_l
   Zmult_plus_distr_r: zarith.
 
-Require Export Zhints.
\ No newline at end of file
+Require Export Zhints.
diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v
index dbd0df6c..40c5860c 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,v 1.11.2.1 2004/07/16 19:31:20 herbelin Exp $ i*)
+(*i $Id: ZArith_dec.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import Sumbool.
 
diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v
index 90e4c2a4..fed6ad76 100644
--- a/theories/ZArith/Zabs.v
+++ b/theories/ZArith/Zabs.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zabs.v,v 1.4.2.1 2004/07/16 19:31:21 herbelin Exp $ i*)
+(*i $Id: Zabs.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
 
diff --git a/theories/ZArith/Zbinary.v b/theories/ZArith/Zbinary.v
index fa5f00dc..353f0d5d 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,v 1.6.2.1 2004/07/16 19:31:21 herbelin Exp $ i*)
+(*i $Id: Zbinary.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Bit vectors interpreted as integers. 
     Contribution by Jean Duprat (ENS Lyon). *)
diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v
index bb8abef4..a195b951 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,v 1.4.2.1 2004/07/16 19:31:21 herbelin Exp $ *)
+(* $Id: Zbool.v 6295 2004-11-12 16:40:39Z gregoire $ *)
 
 Require Import BinInt.
 Require Import Zeven.
@@ -15,6 +15,8 @@ Require Import Zcompare.
 Require Import ZArith_dec.
 Require Import Sumbool.
 
+Unset Boxed Definitions.
+
 (** The decidability of equality and order relations over
     type [Z] give some boolean functions with the adequate specification. *)
 
diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v
index b60cd37c..817fbc1b 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,v 1.26.2.1 2004/07/16 19:31:21 herbelin Exp $ i*)
+(*i $Id: Zcomplements.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import ZArithRing.
 Require Import ZArith_base.
diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v
index 84eb2259..e391d087 100644
--- a/theories/ZArith/Zdiv.v
+++ b/theories/ZArith/Zdiv.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zdiv.v,v 1.21.2.1 2004/07/16 19:31:21 herbelin Exp $ i*)
+(*i $Id: Zdiv.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
 
 (* Contribution by Claude Marché and Xavier Urbain *)
 
@@ -36,7 +36,7 @@ Open Local Scope Z_scope.
   
 *)
 
-Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : 
+Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : 
  Z * Z :=
   match a with
   | xH => if Zge_bool b 2 then (0, 1) else (1, 0)
diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v
index a4a9abde..72d2d828 100644
--- a/theories/ZArith/Zeven.v
+++ b/theories/ZArith/Zeven.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zeven.v,v 1.3.2.1 2004/07/16 19:31:21 herbelin Exp $ i*)
+(*i $Id: Zeven.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import BinInt.
 
diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v
index a9ee2c87..d0a2d2a0 100644
--- a/theories/ZArith/Zhints.v
+++ b/theories/ZArith/Zhints.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zhints.v,v 1.8.2.1 2004/07/16 19:31:21 herbelin Exp $ i*)
+(*i $Id: Zhints.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** This file centralizes the lemmas about [Z], classifying them
     according to the way they can be used in automatic search  *)
diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v
index b575de88..653ee951 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,v 1.14.2.1 2004/07/16 19:31:21 herbelin Exp $ i*)
+(*i $Id: Zlogarithm.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
 
 (**********************************************************************)
 (** The integer logarithms with base 2. 
@@ -36,6 +36,7 @@ Fixpoint log_inf (p:positive) : Z :=
   | 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 *)
diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v
new file mode 100644
index 00000000..ae3bbf41
--- /dev/null
+++ b/theories/ZArith/Zmax.v
@@ -0,0 +1,108 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+(*i $Id: Zmax.v 8032 2006-02-12 21:20:48Z herbelin $ i*)
+
+Require Import Arith.
+Require Import BinInt.
+Require Import Zcompare.
+Require Import Zorder.
+
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** *** Maximum of two binary integer numbers *)
+
+Definition Zmax m n :=
+   match m ?= n with
+    | Eq | Gt => m
+    | Lt => n
+    end.
+
+(** 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.
+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. 
+Qed.
+
+(** 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.
+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.
+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.
+Qed.
+
+(** Semi-lattice properties of max *)
+
+Lemma Zmax_idempotent : forall n:Z, Zmax n n = n.
+Proof.
+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.
+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.
+Qed.
+
+(** 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.
+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.
+Qed.
+
+(** 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.
+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.
+Qed.
diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v
index d48e62c5..d79ebe98 100644
--- a/theories/ZArith/Zmin.v
+++ b/theories/ZArith/Zmin.v
@@ -5,9 +5,12 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zmin.v,v 1.3.2.1 2004/07/16 19:31:21 herbelin Exp $ i*)
+(*i $Id: Zmin.v 8032 2006-02-12 21:20:48Z herbelin $ i*)
 
-(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
+(** 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 BinInt.
@@ -17,23 +20,31 @@ Require Import Zorder.
 Open Local Scope Z_scope.
 
 (**********************************************************************)
-(** Minimum on binary integer numbers *)
+(** *** Minimum on binary integer numbers *)
 
-Definition Zmin (n m:Z) :=
-  match n ?= m return Z with
-  | Eq => n
-  | Lt => n
+Unboxed Definition Zmin (n m:Z) :=
+  match n ?= m with
+  | Eq | Lt => n
   | Gt => m
   end.
 
-(** Properties of minimum on binary integer numbers *)
+(** Characterization of the minimum on binary integer numbers *)
 
-Lemma Zmin_SS : forall n m:Z, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m).
+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; unfold Zmin in |- *; rewrite (Zcompare_succ_compat n m);
- elim_compare n m; intros E; rewrite E; auto with arith.
+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.
+Qed.
+
+(** 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;
@@ -50,57 +61,70 @@ intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E;
  | apply Zle_refl ].
 Qed.
 
-Lemma Zmin_case : forall (n m:Z) (P:Z -> Set), P n -> P m -> P (Zmin n m).
+Lemma Zmin_glb : forall n m p:Z, 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; apply Zmin_case; assumption.
 Qed.
 
-Lemma Zmin_or : forall n m:Z, Zmin n m = n \/ Zmin n m = m.
+(** Semi-lattice properties of min *)
+
+Lemma Zmin_idempotent : forall n:Z, Zmin n n = n.
 Proof.
-unfold Zmin in |- *; intros; elim (n ?= m); auto.
+unfold Zmin in |- *; intros; elim (n ?= n); auto.
 Qed.
 
-Lemma Zmin_n_n : forall n:Z, Zmin n n = n.
+Notation Zmin_n_n := Zmin_idempotent (only parsing).
+
+Lemma Zmin_comm : forall n m:Z, Zmin n m = Zmin m n.
 Proof.
-unfold Zmin in |- *; intros; elim (n ?= n); 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_plus : forall n m p:Z, Zmin (n + p) (m + p) = Zmin n m + p.
+Lemma Zmin_assoc : forall n m p:Z, Zmin n (Zmin m p) = Zmin (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 n m p; repeat apply Zmin_case_strong; intros; 
+  reflexivity || (try apply Zle_antisym); eauto with zarith.
 Qed.
 
-(**********************************************************************)
-(** Maximum of two binary integer numbers *)
+(** Additional properties of min *)
 
-Definition Zmax a b := match a ?= b with
-                       | Lt => b
-                       | _ => a
-                       end.
+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.
+Qed.
 
-(** Properties of maximum on binary integer numbers *)
+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.
+Qed.
 
-Ltac CaseEq name :=
-  generalize (refl_equal name); pattern name at -1 in |- *; case name.
+Notation Zmin_or := Zmin_irreducible (only parsing).
 
-Theorem Zmax1 : forall a b, a <= Zmax a b.
+Lemma Zmin_le_prime_inf : forall n m p:Z, Zmin n m <= p -> {n <= p} + {m <= p}.
 Proof.
-intros a b; unfold Zmax in |- *; CaseEq (a ?= b); simpl in |- *;
- auto with zarith.
-unfold Zle in |- *; intros H; rewrite H; red in |- *; intros; discriminate.
+intros n m p; apply Zmin_case; auto.
 Qed.
 
-Theorem Zmax2 : forall a b, b <= Zmax a b.
+(** Operations preserving min *)
+
+Lemma Zsucc_min_distr : 
+  forall n m:Z, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m).
 Proof.
-intros a b; unfold Zmax in |- *; CaseEq (a ?= b); simpl in |- *;
- auto with zarith.
-intros H;
- (case (Zle_or_lt b a); auto; unfold Zlt in |- *; rewrite H; intros;
-   discriminate).
-intros H;
- (case (Zle_or_lt b a); auto; unfold Zlt in |- *; rewrite H; intros;
-   discriminate).
+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.
+Qed.
+
+Notation Zmin_plus := Zplus_min_distr_r (only parsing).
diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v
new file mode 100644
index 00000000..ebe9318e
--- /dev/null
+++ b/theories/ZArith/Zminmax.v
@@ -0,0 +1,82 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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: Zminmax.v 8034 2006-02-12 22:08:04Z herbelin $ i*)
+
+Require Import Zmin Zmax.
+Require Import BinInt Zorder.
+
+Open Local Scope Z_scope.
+
+(** *** 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.
+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.
+Qed.
+
+(** Distributivity *)
+
+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).
+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).
+Qed.
+
+(** Modularity *)
+
+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).
+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).
+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).
+Qed.
+
+
+
+
+
+
+
diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v
index adcaf0ba..8246e324 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,v 1.20.2.1 2004/07/16 19:31:22 herbelin Exp $ i*)
+(*i $Id: Zmisc.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import BinInt.
 Require Import Zcompare.
diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v
index d051ed74..3e27878c 100644
--- a/theories/ZArith/Znat.v
+++ b/theories/ZArith/Znat.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Znat.v,v 1.3.2.1 2004/07/16 19:31:22 herbelin Exp $ i*)
+(*i $Id: Znat.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
 
diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v
index 715cdc7d..a1963446 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,v 1.5.2.1 2004/07/16 19:31:22 herbelin Exp $ i*)
+(*i $Id: Znumtheory.v 6984 2005-05-02 10:50:15Z herbelin $ i*)
 
 Require Import ZArith_base.
 Require Import ZArithRing.
@@ -278,12 +278,12 @@ Lemma euclid_rec :
      (forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid.
 Proof.
 intros v3 Hv3; generalize Hv3; pattern v3 in |- *.
-apply Z_lt_rec.
+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 H2.
+apply H3.
 rewrite a0; auto with zarith.
 set (q := u3 / x) in *.
 assert (Hq : 0 <= u3 - q * x < x).
@@ -297,9 +297,9 @@ apply (H (u3 - q * x) Hq (proj1 Hq) v1 v2 x (u1 - q * v1) (u2 - q * v2)).
 tauto.
 replace ((u1 - q * v1) * a + (u2 - q * v2) * b) with
  (u1 * a + u2 * b - q * (v1 * a + v2 * b)).
-rewrite H0; rewrite H1; trivial.
+rewrite H1; rewrite H2; trivial.
 ring.
-intros; apply H2.
+intros; apply H3.
 apply Zis_gcd_for_euclid with q; assumption.
 assumption.
 Qed.
@@ -377,11 +377,11 @@ Definition Zgcd_pos :
 Proof.
 intros a Ha.
 apply
- (Z_lt_rec
+ (Zlt_0_rec
     (fun a:Z => forall b:Z, {g : Z | 0 <= a -> Zis_gcd a b g /\ g >= 0}));
  try assumption.
 intro x; case x.
-intros _ b; exists (Zabs b).
+intros _ _ b; exists (Zabs b).
   elim (Z_le_lt_eq_dec _ _ (Zabs_pos b)).
     intros H0; split.
     apply Zabs_ind.
@@ -393,7 +393,7 @@ intros _ b; exists (Zabs b).
     rewrite <- (Zabs_Zsgn b); rewrite <- H0; simpl in |- *.
     split; [ apply Zis_gcd_0 | idtac ]; auto with zarith.
   
-intros p Hrec b.
+intros p Hrec _ b.
 generalize (Z_div_mod b (Zpos p)).
 case (Zdiv_eucl b (Zpos p)); intros q r Hqr.
 elim Hqr; clear Hqr; intros; auto with zarith.
@@ -405,8 +405,7 @@ split; auto.
 rewrite H.
 apply Zis_gcd_for_euclid2; auto.
 
-intros p Hrec b.
-exists 0; intros.
+intros p _ H b.
 elim H; auto.
 Defined.
 
diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v
index 27eb02cd..b81cc580 100644
--- a/theories/ZArith/Zorder.v
+++ b/theories/ZArith/Zorder.v
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zorder.v,v 1.6.2.3 2005/03/29 15:35:12 herbelin Exp $ i*)
+(*i $Id: Zorder.v 6983 2005-05-02 10:47:51Z herbelin $ i*)
 
 (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
 
@@ -905,23 +905,23 @@ Qed.
 (** Simplification of square wrt order *)
 
 Lemma Zgt_square_simpl :
- forall n m:Z, n >= 0 -> m >= 0 -> n * n > m * m -> n > m.
+ forall n m:Z, n >= 0 -> n * n > m * m -> n > m.
 Proof.
-intros x y H0 H1 H2.
-case (dec_Zlt y x).
+intros n m H0 H1.
+case (dec_Zlt m n).
 intro; apply Zlt_gt; trivial.
-intros H3; cut (y >= x).
+intros H2; cut (m >= n).
 intros H.
-elim Zgt_not_le with (1 := H2).
+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 -> 0 <= m -> m * m < n * n -> m < n.
+ forall n m:Z, 0 <= n -> m * m < n * n -> m < n.
 Proof.
-intros x y H0 H1 H2.
+intros x y H0 H1.
 apply Zgt_lt.
 apply Zgt_square_simpl; try apply Zle_ge; try apply Zlt_gt; assumption.
 Qed.
@@ -967,5 +967,17 @@ 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.
+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. 
+Qed.
+
 (* 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 e5bf8b04..70a2bd45 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,v 1.11.2.1 2004/07/16 19:31:22 herbelin Exp $ i*)
+(*i $Id: Zpower.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 Require Import ZArith_base.
 Require Import Omega.
diff --git a/theories/ZArith/Zsqrt.v b/theories/ZArith/Zsqrt.v
index 583c5828..cf4acb5f 100644
--- a/theories/ZArith/Zsqrt.v
+++ b/theories/ZArith/Zsqrt.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Zsqrt.v,v 1.11.2.1 2004/07/16 19:31:22 herbelin Exp $ *)
+(* $Id: Zsqrt.v 6199 2004-10-11 11:39:18Z herbelin $ *)
 
 Require Import Omega.
 Require Export ZArith_base.
@@ -22,12 +22,12 @@ Ltac compute_POS :=
   match goal with
   |  |- context [(Zpos (xI ?X1))] =>
       match constr:X1 with
-      | context [1%positive] => fail
+      | context [1%positive] => fail 1
       | _ => rewrite (BinInt.Zpos_xI X1)
       end
   |  |- context [(Zpos (xO ?X1))] =>
       match constr:X1 with
-      | context [1%positive] => fail
+      | context [1%positive] => fail 1
       | _ => rewrite (BinInt.Zpos_xO X1)
       end
   end.
diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v
index 8633986b..4ff663fb 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,v 1.7.2.1 2004/07/16 19:31:22 herbelin Exp $ *)
+(* $Id: Zwf.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Import ZArith_base.
 Require Export Wf_nat.
diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v
index ecd2daab..28cbd1e4 100644
--- a/theories/ZArith/auxiliary.v
+++ b/theories/ZArith/auxiliary.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: auxiliary.v,v 1.12.2.1 2004/07/16 19:31:22 herbelin Exp $ i*)
+(*i $Id: auxiliary.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
 
diff --git a/theories7/Arith/Arith.v b/theories7/Arith/Arith.v
deleted file mode 100755
index 181fadbc..00000000
--- a/theories7/Arith/Arith.v
+++ /dev/null
@@ -1,21 +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: Arith.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
-
-Require Export Le.
-Require Export Lt.
-Require Export Plus.
-Require Export Gt.
-Require Export Minus.
-Require Export Mult.
-Require Export Between.
-Require Export Minus.
-Require Export Peano_dec.
-Require Export Compare_dec.
-Require Export Factorial.
diff --git a/theories7/Arith/Between.v b/theories7/Arith/Between.v
deleted file mode 100755
index b3fef325..00000000
--- a/theories7/Arith/Between.v
+++ /dev/null
@@ -1,185 +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: Between.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
-
-Require Le.
-Require Lt.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type k,l,p,q,r:nat.
-
-Section Between.
-Variables P,Q : nat -> Prop.
-
-Inductive between [k:nat] : nat -> Prop
- := bet_emp : (between k k)
- | bet_S : (l:nat)(between k l)->(P l)->(between k (S l)).
-
-Hint constr_between : arith v62 := Constructors between.
-
-Lemma bet_eq : (k,l:nat)(l=k)->(between k l).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-
-Hints Resolve bet_eq : arith v62.
-
-Lemma between_le : (k,l:nat)(between k l)->(le k l).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-Hints Immediate between_le : arith v62.
-
-Lemma between_Sk_l : (k,l:nat)(between k l)->(le (S k) l)->(between (S k) l).
-Proof.
-NewInduction 1.
-Intros; Absurd (le (S k) k); Auto with arith.
-NewDestruct H; Auto with arith.
-Qed.
-Hints Resolve between_Sk_l : arith v62.
-
-Lemma between_restr : 
-  (k,l,m:nat)(le k l)->(le l m)->(between k m)->(between l m).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-
-Inductive exists [k:nat] : nat -> Prop
- := exists_S : (l:nat)(exists k l)->(exists k (S l))
- | exists_le: (l:nat)(le k l)->(Q l)->(exists k (S l)).
-
-Hint constr_exists : arith v62 := Constructors exists.
-
-Lemma exists_le_S : (k,l:nat)(exists k l)->(le (S k) l).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-
-Lemma exists_lt : (k,l:nat)(exists k l)->(lt k l).
-Proof exists_le_S.
-Hints Immediate exists_le_S exists_lt : arith v62.
-
-Lemma exists_S_le : (k,l:nat)(exists k (S l))->(le k l).
-Proof.
-Intros; Apply le_S_n; Auto with arith.
-Qed.
-Hints Immediate exists_S_le : arith v62.
-
-Definition in_int := [p,q,r:nat](le p r)/\(lt r q).
-
-Lemma in_int_intro : (p,q,r:nat)(le p r)->(lt r q)->(in_int p q r).
-Proof.
-Red; Auto with arith.
-Qed.
-Hints Resolve in_int_intro : arith v62.
-
-Lemma in_int_lt : (p,q,r:nat)(in_int p q r)->(lt p q).
-Proof.
-NewInduction 1; Intros.
-Apply le_lt_trans with r; Auto with arith.
-Qed.
-
-Lemma in_int_p_Sq : 
-  (p,q,r:nat)(in_int p (S q) r)->((in_int p q r) \/ <nat>r=q).
-Proof.
-NewInduction 1; Intros.
-Elim (le_lt_or_eq r q); Auto with arith.
-Qed.
-
-Lemma in_int_S : (p,q,r:nat)(in_int p q r)->(in_int p (S q) r).
-Proof.
-NewInduction 1;Auto with arith.
-Qed.
-Hints Resolve in_int_S : arith v62.
-
-Lemma in_int_Sp_q : (p,q,r:nat)(in_int (S p) q r)->(in_int p q r).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-Hints Immediate in_int_Sp_q : arith v62.
-
-Lemma between_in_int : (k,l:nat)(between k l)->(r:nat)(in_int k l r)->(P r).
-Proof.
-NewInduction 1; Intros.
-Absurd (lt k k); Auto with arith.
-Apply in_int_lt with r; Auto with arith.
-Elim (in_int_p_Sq k l r); Intros; Auto with arith.
-Rewrite H2; Trivial with arith.
-Qed.
-
-Lemma in_int_between : 
-  (k,l:nat)(le k l)->((r:nat)(in_int k l r)->(P r))->(between k l).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-
-Lemma exists_in_int : 
-  (k,l:nat)(exists k l)->(EX m:nat | (in_int k l m) & (Q m)).
-Proof.
-NewInduction 1.
-Case IHexists; Intros p inp Qp; Exists p; Auto with arith.
-Exists l; Auto with arith.
-Qed.
-
-Lemma in_int_exists : (k,l,r:nat)(in_int k l r)->(Q r)->(exists k l).
-Proof.
-NewDestruct 1; Intros.
-Elim H0; Auto with arith.
-Qed.
-
-Lemma between_or_exists : 
-  (k,l:nat)(le k l)->((n:nat)(in_int k l n)->((P n)\/(Q n)))
-     ->((between k l)\/(exists k l)).
-Proof.
-NewInduction 1; Intros; Auto with arith.
-Elim IHle; Intro; Auto with arith.
-Elim (H0 m); Auto with arith.
-Qed.
-
-Lemma between_not_exists : (k,l:nat)(between k l)->
-     ((n:nat)(in_int k l n) -> (P n) -> ~(Q n))
-     -> ~(exists k l).
-Proof.
-NewInduction 1; Red; Intros.
-Absurd (lt k k); Auto with arith.
-Absurd (Q l); Auto with arith.
-Elim (exists_in_int k (S l)); Auto with arith; Intros l' inl' Ql'.
-Replace l with l'; Auto with arith.
-Elim inl'; Intros.
-Elim (le_lt_or_eq l' l); Auto with arith; Intros.
-Absurd (exists k l); Auto with arith.
-Apply in_int_exists with l'; Auto with arith.
-Qed.
-
-Inductive P_nth [init:nat] : nat->nat->Prop
-  := nth_O : (P_nth init init O)
-  | nth_S : (k,l:nat)(n:nat)(P_nth init k n)->(between (S k) l)
-                        ->(Q l)->(P_nth init l (S n)).
-
-Lemma nth_le : (init,l,n:nat)(P_nth init l n)->(le init l).
-Proof.
-NewInduction 1; Intros; Auto with arith.
-Apply le_trans with (S k); Auto with arith.
-Qed.
-
-Definition eventually := [n:nat](EX k:nat | (le k n) & (Q k)).
-
-Lemma event_O : (eventually O)->(Q O).
-Proof.
-NewInduction 1; Intros.
-Replace O with x; Auto with arith.
-Qed.
-
-End Between.
-
-Hints Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le 
- in_int_S in_int_intro : arith v62. 
-Hints Immediate in_int_Sp_q exists_le_S exists_S_le : arith v62.
diff --git a/theories7/Arith/Bool_nat.v b/theories7/Arith/Bool_nat.v
deleted file mode 100644
index c36f8f15..00000000
--- a/theories7/Arith/Bool_nat.v
+++ /dev/null
@@ -1,43 +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        *)
-(************************************************************************)
-
-(* $Id: Bool_nat.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ *)
-
-Require Export Compare_dec.
-Require Export Peano_dec.
-Require Sumbool.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,x,y:nat.
-
-(** The decidability of equality and order relations over
-    type [nat] give some boolean functions with the adequate specification. *)
-
-Definition notzerop := [n:nat] (sumbool_not ? ? (zerop n)).
-Definition lt_ge_dec : (x,y:nat){(lt x y)}+{(ge x y)} := 
-  [n,m:nat] (sumbool_not ? ? (le_lt_dec m n)).
-
-Definition nat_lt_ge_bool := 
-  [x,y:nat](bool_of_sumbool (lt_ge_dec x y)).
-Definition nat_ge_lt_bool := 
-  [x,y:nat](bool_of_sumbool (sumbool_not ? ? (lt_ge_dec x y))).
-
-Definition nat_le_gt_bool := 
-  [x,y:nat](bool_of_sumbool (le_gt_dec x y)).
-Definition nat_gt_le_bool := 
-  [x,y:nat](bool_of_sumbool (sumbool_not ? ? (le_gt_dec x y))).
-
-Definition nat_eq_bool :=
-  [x,y:nat](bool_of_sumbool (eq_nat_dec x y)).
-Definition nat_noteq_bool := 
-  [x,y:nat](bool_of_sumbool (sumbool_not ? ? (eq_nat_dec x y))).
-
-Definition zerop_bool := [x:nat](bool_of_sumbool (zerop x)).
-Definition notzerop_bool := [x:nat](bool_of_sumbool (notzerop x)).
diff --git a/theories7/Arith/Compare.v b/theories7/Arith/Compare.v
deleted file mode 100755
index 1bca3fbe..00000000
--- a/theories7/Arith/Compare.v
+++ /dev/null
@@ -1,60 +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: Compare.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
-
-(** Equality is decidable on [nat] *)
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-(*
-Lemma not_eq_sym : (A:Set)(p,q:A)(~p=q) -> ~(q=p).
-Proof sym_not_eq.
-Hints Immediate not_eq_sym : arith.
-*)
-Notation not_eq_sym := sym_not_eq.
-
-Implicit Variables Type m,n,p,q:nat.
-
-Require Arith.
-Require Peano_dec.
-Require Compare_dec.
-
-Definition le_or_le_S := le_le_S_dec.
-
-Definition compare := gt_eq_gt_dec.
-
-Lemma le_dec : (n,m:nat) {le n m} + {le m n}.
-Proof le_ge_dec.
-
-Definition lt_or_eq := [n,m:nat]{(gt m n)}+{n=m}.
-
-Lemma le_decide : (n,m:nat)(le n m)->(lt_or_eq n m).
-Proof le_lt_eq_dec.
-
-Lemma le_le_S_eq : (p,q:nat)(le p q)->((le (S p) q)\/(p=q)).
-Proof le_lt_or_eq.
-
-(* By special request of G. Kahn - Used in Group Theory *)
-Lemma discrete_nat : (m, n: nat) (lt m n) ->
-   (S m) = n \/ (EX r: nat | n = (S (S (plus m r)))).
-Proof.
-Intros m n H.
-LApply (lt_le_S m n); Auto with arith.
-Intro H'; LApply (le_lt_or_eq (S m) n); Auto with arith.
-NewInduction 1; Auto with arith.
-Right; Exists (minus n (S (S m))); Simpl.
-Rewrite (plus_sym m (minus n (S (S m)))).
-Rewrite (plus_n_Sm (minus n (S (S m))) m).
-Rewrite (plus_n_Sm (minus n (S (S m))) (S m)).
-Rewrite (plus_sym (minus n (S (S m))) (S (S m))); Auto with arith.
-Qed.
-
-Require Export Wf_nat.
-
-Require Export Min.
diff --git a/theories7/Arith/Compare_dec.v b/theories7/Arith/Compare_dec.v
deleted file mode 100755
index 504c0562..00000000
--- a/theories7/Arith/Compare_dec.v
+++ /dev/null
@@ -1,109 +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: Compare_dec.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
-
-Require Le.
-Require Lt.
-Require Gt.
-Require Decidable.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,x,y:nat.
-
-Definition zerop : (n:nat){n=O}+{lt O n}.
-NewDestruct n; Auto with arith.
-Defined.
-
-Definition lt_eq_lt_dec : (n,m:nat){(lt n m)}+{n=m}+{(lt m n)}.
-Proof.
-NewInduction n; Destruct m; Auto with arith.
-Intros m0; Elim (IHn m0); Auto with arith.
-NewInduction 1; Auto with arith.
-Defined.
-
-Lemma gt_eq_gt_dec : (n,m:nat)({(gt m n)}+{n=m})+{(gt n m)}.
-Proof lt_eq_lt_dec.
-
-Lemma le_lt_dec : (n,m:nat) {le n m} + {lt m n}.
-Proof.
-NewInduction n.
-Auto with arith.
-NewInduction m.
-Auto with arith.
-Elim (IHn m); Auto with arith.
-Defined.
-
-Definition le_le_S_dec : (n,m:nat) {le n m} + {le (S m) n}.
-Proof.
-Exact le_lt_dec.
-Defined.
-
-Definition le_ge_dec : (n,m:nat) {le n m} + {ge n m}.
-Proof.
-Intros; Elim (le_lt_dec n m); Auto with arith.
-Defined.
-
-Definition le_gt_dec : (n,m:nat){(le n m)}+{(gt n m)}.
-Proof.
-Exact le_lt_dec.
-Defined.
-
-Definition le_lt_eq_dec : (n,m:nat)(le n m)->({(lt n m)}+{n=m}).
-Proof.
-Intros; Elim (lt_eq_lt_dec n m); Auto with arith.
-Intros; Absurd (lt m n); Auto with arith.
-Defined.
-
-(** Proofs of decidability *)
-
-Theorem dec_le:(x,y:nat)(decidable (le x y)).
-Intros x y; Unfold decidable ; Elim (le_gt_dec x y); [
-  Auto with arith
-| Intro; Right; Apply gt_not_le; Assumption].
-Qed.
-
-Theorem dec_lt:(x,y:nat)(decidable (lt x y)).
-Intros x y; Unfold lt; Apply dec_le.
-Qed.
-
-Theorem dec_gt:(x,y:nat)(decidable (gt x y)).
-Intros x y; Unfold gt; Apply dec_lt.
-Qed.
-
-Theorem dec_ge:(x,y:nat)(decidable (ge x y)).
-Intros x y; Unfold ge; Apply dec_le.
-Qed.
-
-Theorem not_eq : (x,y:nat) ~ x=y -> (lt x y) \/ (lt y x).
-Intros x y H; Elim (lt_eq_lt_dec x y); [
-  Intros H1; Elim H1; [ Auto with arith | Intros H2; Absurd x=y; Assumption]
-| Auto with arith].
-Qed.
-
-
-Theorem not_le : (x,y:nat) ~(le x y) -> (gt x y).
-Intros x y H; Elim (le_gt_dec x y);
-  [ Intros H1; Absurd (le x y); Assumption | Trivial with arith ].
-Qed.
-
-Theorem not_gt : (x,y:nat) ~(gt x y) -> (le x y).
-Intros x y H; Elim (le_gt_dec x y);
-  [ Trivial with arith | Intros H1; Absurd (gt x y); Assumption].
-Qed.
-
-Theorem not_ge : (x,y:nat) ~(ge x y) -> (lt x y).
-Intros x y H; Exact (not_le y x H).
-Qed.
-
-Theorem not_lt : (x,y:nat) ~(lt x y) -> (ge x y).
-Intros x y H; Exact (not_gt y x H). 
-Qed.
-
diff --git a/theories7/Arith/Div.v b/theories7/Arith/Div.v
deleted file mode 100755
index 59694628..00000000
--- a/theories7/Arith/Div.v
+++ /dev/null
@@ -1,64 +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: Div.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
-
-(** Euclidean division *)
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Require Le.
-Require Euclid_def.
-Require Compare_dec.
-
-Implicit Variables Type n,a,b,q,r:nat.
-
-Fixpoint inf_dec [n:nat] : nat->bool :=
-      [m:nat] Cases n m of
-                  O     _     => true
-              | (S n')  O     => false
-              | (S n') (S m') => (inf_dec n' m')
-             end.
-
-Theorem div1 : (b:nat)(gt b O)->(a:nat)(diveucl a b).
-Realizer Fix div1 {div1/2: nat->nat->diveucl :=
-  [b,a]Cases a of
-         O     => (O,O)
-       | (S n) =>
-           let (q,r) = (div1 b n) in
-             if (le_gt_dec b (S r)) then ((S q),O)
-	     else (q,(S r))
-       end}.
-Program_all.
-Rewrite e.
-Replace b with (S r).
-Simpl.
-Elim plus_n_O; Auto with arith.
-Apply le_antisym; Auto with arith.
-Elim plus_n_Sm; Auto with arith.
-Qed.
-
-Theorem div2 : (b:nat)(gt b O)->(a:nat)(diveucl a b).
-Realizer Fix div1 {div1/2: nat->nat->diveucl :=
-  [b,a]Cases a of
-         O     => (O,O)
-       | (S n) =>
-           let (q,r) = (div1 b n) in
-             if (inf_dec b (S r)) :: :: { {(le b (S r))}+{(gt b (S r))} }
-             then ((S q),O)
-	     else (q,(S r))
-       end}.
-Program_all.
-Rewrite e.
-Replace b with (S r).
-Simpl.
-Elim plus_n_O; Auto with arith.
-Apply le_antisym; Auto with arith.
-Elim plus_n_Sm; Auto with arith.
-Qed.
diff --git a/theories7/Arith/Div2.v b/theories7/Arith/Div2.v
deleted file mode 100644
index 8bd0160f..00000000
--- a/theories7/Arith/Div2.v
+++ /dev/null
@@ -1,174 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i $Id: Div2.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-Require Lt.
-Require Plus.
-Require Compare_dec.
-Require Even.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type n:nat.
-
-(** Here we define [n/2] and prove some of its properties *)
-
-Fixpoint div2 [n:nat] : nat :=
-  Cases n of
-    O => O
-  | (S O) => O
-  | (S (S n')) => (S (div2 n'))
-  end.
-
-(** Since [div2] is recursively defined on [0], [1] and [(S (S n))], it is
-    useful to prove the corresponding induction principle *)
-
-Lemma ind_0_1_SS : (P:nat->Prop)
-  (P O) -> (P (S O)) -> ((n:nat)(P n)->(P (S (S n)))) -> (n:nat)(P n).
-Proof.
-Intros.
-Cut (n:nat)(P n)/\(P (S n)).
-Intros. Elim (H2 n). Auto with arith.
-
-NewInduction n0. Auto with arith.
-Intros. Elim IHn0; Auto with arith.
-Qed.
-
-(** [0 <n  =>  n/2 < n] *)
-
-Lemma lt_div2 : (n:nat) (lt O n) -> (lt (div2 n) n).
-Proof.
-Intro n. Pattern n. Apply ind_0_1_SS.
-Intro. Inversion H.
-Auto with arith.
-Intros. Simpl.
-Case (zerop n0).
-Intro. Rewrite e. Auto with arith.
-Auto with arith.
-Qed.
-
-Hints Resolve lt_div2 : arith.
-
-(** Properties related to the parity *)
-
-Lemma even_odd_div2 : (n:nat) 
-  ((even n)<->(div2 n)=(div2 (S n))) /\ ((odd n)<->(S (div2 n))=(div2 (S n))).
-Proof.
-Intro n. Pattern n. Apply ind_0_1_SS.
-(* n  = 0 *)
-Split. Split; Auto with arith. 
-Split. Intro H. Inversion H.
-Intro H.  Absurd (S (div2 O))=(div2 (S O)); Auto with arith.
-(* n = 1 *)
-Split. Split. Intro. Inversion H. Inversion H1.
-Intro H.  Absurd (div2 (S O))=(div2 (S (S O))).
-Simpl. Discriminate. Assumption.
-Split; Auto with arith.
-(* n = (S (S n')) *)
-Intros. Decompose [and] H. Unfold iff in H0 H1.
-Decompose [and] H0. Decompose [and] H1. Clear H H0 H1.
-Split; Split; Auto with arith.
-Intro H. Inversion H. Inversion H1.
-Change (S (div2 n0))=(S (div2 (S n0))). Auto with arith.
-Intro H. Inversion H. Inversion H1.
-Change (S (S (div2 n0)))=(S (div2 (S n0))). Auto with arith.
-Qed.
-
-(** Specializations *)
-
-Lemma even_div2 : (n:nat) (even n) -> (div2 n)=(div2 (S n)).
-Proof [n:nat](proj1 ? ? (proj1 ? ? (even_odd_div2 n))).
-
-Lemma div2_even : (n:nat) (div2 n)=(div2 (S n)) -> (even n).
-Proof [n:nat](proj2 ? ? (proj1 ? ? (even_odd_div2 n))).
-
-Lemma odd_div2 : (n:nat) (odd n) -> (S (div2 n))=(div2 (S n)).
-Proof [n:nat](proj1 ? ? (proj2 ? ? (even_odd_div2 n))).
-
-Lemma div2_odd : (n:nat) (S (div2 n))=(div2 (S n)) -> (odd n).
-Proof [n:nat](proj2 ? ? (proj2 ? ? (even_odd_div2 n))).
-
-Hints Resolve even_div2 div2_even odd_div2 div2_odd : arith.
-
-(** Properties related to the double ([2n]) *)
-
-Definition double := [n:nat](plus n n).
-
-Hints Unfold double : arith.
-
-Lemma double_S : (n:nat) (double (S n))=(S (S (double n))).
-Proof.
-Intro. Unfold double. Simpl. Auto with arith.
-Qed.
-
-Lemma double_plus : (m,n:nat) (double (plus m n))=(plus (double m) (double n)).
-Proof.
-Intros m n. Unfold double.
-Do 2 Rewrite -> plus_assoc_r. Rewrite -> (plus_permute n).
-Reflexivity.
-Qed.
-
-Hints Resolve double_S : arith.
-
-Lemma even_odd_double : (n:nat) 
-  ((even n)<->n=(double (div2 n))) /\ ((odd n)<->n=(S (double (div2 n)))).
-Proof.
-Intro n. Pattern n. Apply ind_0_1_SS.
-(* n = 0 *)
-Split; Split; Auto with arith.
-Intro H. Inversion H.
-(* n = 1 *)
-Split; Split; Auto with arith.
-Intro H. Inversion H. Inversion H1.
-(* n = (S (S n')) *)
-Intros. Decompose [and] H. Unfold iff in H0 H1.
-Decompose [and] H0. Decompose [and] H1. Clear H H0 H1.
-Split; Split.
-Intro H. Inversion H. Inversion H1.
-Simpl. Rewrite (double_S (div2 n0)). Auto with arith.
-Simpl. Rewrite (double_S (div2 n0)). Intro H. Injection H. Auto with arith.
-Intro H. Inversion H. Inversion H1.
-Simpl. Rewrite (double_S (div2 n0)). Auto with arith.
-Simpl. Rewrite (double_S (div2 n0)). Intro H. Injection H. Auto with arith.
-Qed.
-
-
-(** Specializations *)
-
-Lemma even_double : (n:nat) (even n) -> n=(double (div2 n)).
-Proof [n:nat](proj1 ? ? (proj1 ? ? (even_odd_double n))).
-
-Lemma double_even : (n:nat) n=(double (div2 n)) -> (even n).
-Proof [n:nat](proj2 ? ? (proj1 ? ? (even_odd_double n))).
-
-Lemma odd_double : (n:nat) (odd n) -> n=(S (double (div2 n))).
-Proof [n:nat](proj1 ? ? (proj2 ? ? (even_odd_double n))).
-
-Lemma double_odd : (n:nat) n=(S (double (div2 n))) -> (odd n).
-Proof [n:nat](proj2 ? ? (proj2 ? ? (even_odd_double n))).
-
-Hints Resolve even_double double_even odd_double double_odd : arith.
-
-(** Application: 
-    - if [n] is even then there is a [p] such that [n = 2p]
-    - if [n] is odd  then there is a [p] such that [n = 2p+1]
-
-    (Immediate: it is [n/2]) *)
-
-Lemma even_2n : (n:nat) (even n) -> { p:nat | n=(double p) }.
-Proof.
-Intros n H. Exists (div2 n). Auto with arith.
-Qed.
-
-Lemma odd_S2n : (n:nat) (odd n) -> { p:nat | n=(S (double p)) }.
-Proof.
-Intros n H. Exists (div2 n). Auto with arith.
-Qed.
-
diff --git a/theories7/Arith/EqNat.v b/theories7/Arith/EqNat.v
deleted file mode 100755
index 9f5ee7ee..00000000
--- a/theories7/Arith/EqNat.v
+++ /dev/null
@@ -1,78 +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: EqNat.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-(** Equality on natural numbers *)
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,x,y:nat.
-
-Fixpoint  eq_nat [n:nat] : nat -> Prop :=
-  [m:nat]Cases n m of 
-                O      O     => True
-             |  O     (S _)  => False
-             | (S _)   O     => False
-             | (S n1) (S m1) => (eq_nat n1 m1)
-          end.
-
-Theorem eq_nat_refl : (n:nat)(eq_nat n n).
-NewInduction n; Simpl; Auto.
-Qed.
-Hints Resolve eq_nat_refl : arith v62.
-
-Theorem eq_eq_nat : (n,m:nat)(n=m)->(eq_nat n m).
-NewInduction 1; Trivial with arith.
-Qed.
-Hints Immediate eq_eq_nat : arith v62.
-
-Theorem eq_nat_eq : (n,m:nat)(eq_nat n m)->(n=m).
-NewInduction n; NewInduction m; Simpl; Contradiction Orelse Auto with arith.
-Qed.
-Hints Immediate eq_nat_eq : arith v62.
-
-Theorem eq_nat_elim : (n:nat)(P:nat->Prop)(P n)->(m:nat)(eq_nat n m)->(P m).
-Intros; Replace m with n; Auto with arith.
-Qed.
-
-Theorem eq_nat_decide : (n,m:nat){(eq_nat n m)}+{~(eq_nat n m)}.
-NewInduction n.
-NewDestruct m.
-Auto with arith.
-Intros; Right; Red; Trivial with arith.
-NewDestruct m.
-Right; Red; Auto with arith.
-Intros.
-Simpl.
-Apply IHn.
-Defined.
-
-Fixpoint  beq_nat [n:nat] : nat -> bool :=
-  [m:nat]Cases n m of 
-                O      O     => true
-             |  O     (S _)  => false
-             | (S _)   O     => false
-             | (S n1) (S m1) => (beq_nat n1 m1)
-          end.
-
-Lemma beq_nat_refl : (x:nat)true=(beq_nat x x).
-Proof.
-  Intro x; NewInduction x; Simpl; Auto.
-Qed.
-
-Definition beq_nat_eq : (x,y:nat)true=(beq_nat x y)->x=y.
-Proof.
-  Double Induction x y; Simpl.
-    Reflexivity.
-    Intros; Discriminate H0.
-    Intros; Discriminate H0.
-    Intros; Case (H0 ? H1); Reflexivity.
-Defined.
-
diff --git a/theories7/Arith/Euclid.v b/theories7/Arith/Euclid.v
deleted file mode 100644
index adeaf713..00000000
--- a/theories7/Arith/Euclid.v
+++ /dev/null
@@ -1,65 +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: Euclid.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-Require Mult.
-Require Compare_dec.
-Require Wf_nat.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type a,b,n,q,r:nat.
-
-Inductive diveucl [a,b:nat] : Set 
-      := divex : (q,r:nat)(gt b r)->(a=(plus (mult q b) r))->(diveucl a b).
-
-
-Lemma eucl_dev : (b:nat)(gt b O)->(a:nat)(diveucl a b).
-Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
-Elim (le_gt_dec b n).
-Intro lebn.
-Elim (H0 (minus n b)); Auto with arith.
-Intros q r g e.
-Apply divex with (S q) r; Simpl; Auto with arith.
-Elim plus_assoc_l.
-Elim e; Auto with arith.
-Intros gtbn.
-Apply divex with O n; Simpl; Auto with arith.
-Qed.
-
-Lemma quotient : (b:nat)(gt b O)->
-     (a:nat){q:nat|(EX r:nat | (a=(plus (mult q b) r))/\(gt b r))}.
-Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
-Elim (le_gt_dec b n).
-Intro lebn.
-Elim (H0 (minus n b)); Auto with arith.
-Intros q Hq; Exists (S q).
-Elim Hq; Intros r Hr.
-Exists r; Simpl; Elim Hr; Intros.
-Elim plus_assoc_l.
-Elim H1; Auto with arith.
-Intros gtbn.
-Exists O; Exists n; Simpl; Auto with arith.
-Qed.
-
-Lemma modulo : (b:nat)(gt b O)->
-     (a:nat){r:nat|(EX q:nat | (a=(plus (mult q b) r))/\(gt b r))}.
-Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
-Elim (le_gt_dec b n).
-Intro lebn.
-Elim (H0 (minus n b)); Auto with arith.
-Intros r Hr; Exists r.
-Elim Hr; Intros q Hq.
-Elim Hq; Intros; Exists (S q); Simpl.
-Elim plus_assoc_l.
-Elim H1; Auto with arith.
-Intros gtbn.
-Exists n; Exists O; Simpl; Auto with arith.
-Qed.
diff --git a/theories7/Arith/Even.v b/theories7/Arith/Even.v
deleted file mode 100644
index bcc413f5..00000000
--- a/theories7/Arith/Even.v
+++ /dev/null
@@ -1,310 +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: Even.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-(** Here we define the predicates [even] and [odd] by mutual induction
-    and we prove the decidability and the exclusion of those predicates.
-    The main results about parity are proved in the module Div2. *)
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n:nat.
-
-Inductive even : nat->Prop :=
-    even_O : (even O)
-  | even_S : (n:nat)(odd n)->(even (S n))
-with odd : nat->Prop :=
-    odd_S : (n:nat)(even n)->(odd (S n)).
-
-Hint constr_even : arith := Constructors even.
-Hint constr_odd : arith := Constructors odd.
-
-Lemma even_or_odd : (n:nat) (even n)\/(odd n).
-Proof.
-NewInduction n.
-Auto with arith.
-Elim IHn; Auto with arith.
-Qed.
-
-Lemma even_odd_dec : (n:nat) { (even n) }+{ (odd n) }.
-Proof.
-NewInduction n.
-Auto with arith.
-Elim IHn; Auto with arith.
-Qed.
-
-Lemma not_even_and_odd : (n:nat) (even n) -> (odd n) -> False.
-Proof.
-NewInduction n.
-Intros. Inversion H0.
-Intros. Inversion H. Inversion H0. Auto with arith.
-Qed.
-
-Lemma even_plus_aux:
-  (n,m:nat)
-   (iff (odd (plus n m)) (odd n) /\ (even m) \/ (even n) /\ (odd m)) /\
-   (iff (even (plus n m)) (even n) /\ (even m) \/ (odd n) /\ (odd m)).
-Proof.
-Intros n; Elim n; Simpl; Auto with arith.
-Intros m; Split; Auto.
-Split.
-Intros H; Right; Split; Auto with arith.
-Intros H'; Case H'; Auto with arith.
-Intros H'0; Elim H'0; Intros H'1 H'2; Inversion H'1.
-Intros H; Elim H; Auto.
-Split; Auto with arith.
-Intros H'; Elim H'; Auto with arith.
-Intros H; Elim H; Auto.
-Intros H'0; Elim H'0; Intros H'1 H'2; Inversion H'1.
-Intros n0 H' m; Elim (H' m); Intros H'1 H'2; Elim H'1; Intros E1 E2; Elim H'2;
- Intros E3 E4; Clear H'1 H'2.
-Split; Split.
-Intros H'0; Case E3.
-Inversion H'0; Auto.
-Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
-Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
-Intros H'0; Case H'0; Intros C0; Case C0; Intros C1 C2.
-Apply odd_S.
-Apply E4; Left; Split; Auto with arith.
-Inversion C1; Auto.
-Apply odd_S.
-Apply E4; Right; Split; Auto with arith.
-Inversion C1; Auto.
-Intros H'0.
-Case E1.
-Inversion H'0; Auto.
-Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
-Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
-Intros H'0; Case H'0; Intros C0; Case C0; Intros C1 C2.
-Apply even_S.
-Apply E2; Left; Split; Auto with arith.
-Inversion C1; Auto.
-Apply even_S.
-Apply E2; Right; Split; Auto with arith.
-Inversion C1; Auto.
-Qed.
- 
-Lemma even_even_plus : (n,m:nat) (even n) -> (even m) -> (even (plus n m)).
-Proof.
-Intros n m; Case (even_plus_aux n m).
-Intros H H0; Case H0; Auto.
-Qed.
- 
-Lemma odd_even_plus : (n,m:nat) (odd n) -> (odd m) -> (even (plus n m)).
-Proof.
-Intros n m; Case (even_plus_aux n m).
-Intros H H0; Case H0; Auto.
-Qed.
- 
-Lemma even_plus_even_inv_r :
-  (n,m:nat) (even (plus n m)) -> (even n) -> (even m).
-Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'0.
-Intros H'1; Case H'1; Auto.
-Intros H0; Elim H0; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
-Case H0; Auto.
-Qed.
- 
-Lemma even_plus_even_inv_l :
-  (n,m:nat) (even (plus n m)) -> (even m) -> (even n).
-Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'0.
-Intros H'1; Case H'1; Auto.
-Intros H0; Elim H0; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
-Case H0; Auto.
-Qed.
- 
-Lemma even_plus_odd_inv_r : (n,m:nat) (even (plus n m)) -> (odd n) -> (odd m).
-Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'0.
-Intros H'1; Case H'1; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
-Case H0; Auto.
-Intros H0; Case H0; Auto.
-Qed.
- 
-Lemma even_plus_odd_inv_l : (n,m:nat) (even (plus n m)) -> (odd m) -> (odd n).
-Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'0.
-Intros H'1; Case H'1; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
-Case H0; Auto.
-Intros H0; Case H0; Auto.
-Qed.
-Hints Resolve even_even_plus odd_even_plus :arith.
- 
-Lemma odd_plus_l : (n,m:nat) (odd n) -> (even m) -> (odd (plus n m)).
-Proof.
-Intros n m; Case (even_plus_aux n m).
-Intros H; Case H; Auto.
-Qed.
- 
-Lemma odd_plus_r : (n,m:nat) (even n) -> (odd m) -> (odd (plus n m)).
-Proof.
-Intros n m; Case (even_plus_aux n m).
-Intros H; Case H; Auto.
-Qed.
- 
-Lemma odd_plus_even_inv_l : (n,m:nat) (odd (plus n m)) -> (odd m) -> (even n).
-Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'.
-Intros H'1; Case H'1; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
-Case H0; Auto.
-Intros H0; Case H0; Auto.
-Qed.
- 
-Lemma odd_plus_even_inv_r : (n,m:nat) (odd (plus n m)) -> (odd n) -> (even m).
-Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'.
-Intros H'1; Case H'1; Auto.
-Intros H0; Case H0; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
-Case H0; Auto.
-Qed.
- 
-Lemma odd_plus_odd_inv_l : (n,m:nat) (odd (plus n m)) -> (even m) -> (odd n).
-Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'.
-Intros H'1; Case H'1; Auto.
-Intros H0; Case H0; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
-Case H0; Auto.
-Qed.
- 
-Lemma odd_plus_odd_inv_r : (n,m:nat) (odd (plus n m)) -> (even n) -> (odd m).
-Proof.
-Intros n m H; Case (even_plus_aux n m).
-Intros H' H'0; Elim H'.
-Intros H'1; Case H'1; Auto.
-Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
-Case H0; Auto.
-Intros H0; Case H0; Auto.
-Qed.
-Hints Resolve odd_plus_l odd_plus_r :arith.
- 
-Lemma even_mult_aux :
-  (n,m:nat)
-   (iff (odd (mult n m)) (odd n) /\ (odd m)) /\
-   (iff (even (mult n m)) (even n) \/ (even m)).
-Proof.
-Intros n; Elim n; Simpl; Auto with arith.
-Intros m; Split; Split; Auto with arith.
-Intros H'; Inversion H'.
-Intros H'; Elim H'; Auto.
-Intros n0 H' m; Split; Split; Auto with arith.
-Intros H'0.
-Elim (even_plus_aux m (mult n0 m)); Intros H'3 H'4; Case H'3; Intros H'1 H'2;
- Case H'1; Auto.
-Intros H'5; Elim H'5; Intros H'6 H'7; Auto with arith.
-Split; Auto with arith.
-Case (H' m).
-Intros H'8 H'9; Case H'9.
-Intros H'10; Case H'10; Auto with arith.
-Intros H'11 H'12; Case (not_even_and_odd m); Auto with arith.
-Intros H'5; Elim H'5; Intros H'6 H'7; Case (not_even_and_odd (mult n0 m)); Auto.
-Case (H' m).
-Intros H'8 H'9; Case H'9; Auto.
-Intros H'0; Elim H'0; Intros H'1 H'2; Clear H'0.
-Elim (even_plus_aux m (mult n0 m)); Auto.
-Intros H'0 H'3.
-Elim H'0.
-Intros H'4 H'5; Apply H'5; Auto.
-Left; Split; Auto with arith.
-Case (H' m).
-Intros H'6 H'7; Elim H'7.
-Intros H'8 H'9; Apply H'9.
-Left.
-Inversion H'1; Auto.
-Intros H'0.
-Elim (even_plus_aux m (mult n0 m)); Intros H'3 H'4; Case H'4.
-Intros H'1 H'2.
-Elim H'1; Auto.
-Intros H; Case H; Auto.
-Intros H'5; Elim H'5; Intros H'6 H'7; Auto with arith.
-Left.
-Case (H' m).
-Intros H'8; Elim H'8.
-Intros H'9; Elim H'9; Auto with arith.
-Intros H'0; Elim H'0; Intros H'1.
-Case (even_or_odd m); Intros H'2.
-Apply even_even_plus; Auto.
-Case (H' m).
-Intros H H0; Case H0; Auto.
-Apply odd_even_plus; Auto.
-Inversion H'1; Case (H' m); Auto.
-Intros H1; Case H1; Auto.
-Apply even_even_plus; Auto.
-Case (H' m).
-Intros H H0; Case H0; Auto.
-Qed.
- 
-Lemma even_mult_l : (n,m:nat) (even n) -> (even (mult n m)).
-Proof.
-Intros n m; Case (even_mult_aux n m); Auto.
-Intros H H0; Case H0; Auto.
-Qed.
- 
-Lemma even_mult_r: (n,m:nat) (even m) -> (even (mult n m)).
-Proof.
-Intros n m; Case (even_mult_aux n m); Auto.
-Intros H H0; Case H0; Auto.
-Qed.
-Hints Resolve even_mult_l even_mult_r :arith.
- 
-Lemma even_mult_inv_r: (n,m:nat) (even (mult n m)) -> (odd n) -> (even m).
-Proof.
-Intros n m H' H'0.
-Case (even_mult_aux n m).
-Intros H'1 H'2; Elim H'2.
-Intros H'3; Elim H'3; Auto.
-Intros H; Case (not_even_and_odd n); Auto.
-Qed.
- 
-Lemma even_mult_inv_l : (n,m:nat) (even (mult n m)) -> (odd m) -> (even n).
-Proof.
-Intros n m H' H'0.
-Case (even_mult_aux n m).
-Intros H'1 H'2; Elim H'2.
-Intros H'3; Elim H'3; Auto.
-Intros H; Case (not_even_and_odd m); Auto.
-Qed.
- 
-Lemma odd_mult : (n,m:nat) (odd n) -> (odd m) -> (odd (mult n m)).
-Proof.
-Intros n m; Case (even_mult_aux n m); Intros H; Case H; Auto.
-Qed.
-Hints Resolve even_mult_l even_mult_r odd_mult :arith.
- 
-Lemma odd_mult_inv_l : (n,m:nat) (odd (mult n m)) -> (odd n).
-Proof.
-Intros n m H'.
-Case (even_mult_aux n m).
-Intros H'1 H'2; Elim H'1.
-Intros H'3; Elim H'3; Auto.
-Qed.
- 
-Lemma odd_mult_inv_r : (n,m:nat) (odd (mult n m)) -> (odd m).
-Proof.
-Intros n m H'.
-Case (even_mult_aux n m).
-Intros H'1 H'2; Elim H'1.
-Intros H'3; Elim H'3; Auto.
-Qed.
-
diff --git a/theories7/Arith/Factorial.v b/theories7/Arith/Factorial.v
deleted file mode 100644
index a8a60c98..00000000
--- a/theories7/Arith/Factorial.v
+++ /dev/null
@@ -1,51 +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: Factorial.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-Require Plus.
-Require Mult.
-Require Lt.
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-(** Factorial *)
-
-Fixpoint fact [n:nat]:nat:=
-  Cases n of
-     O     => (S O)
-    |(S n) => (mult (S n) (fact n))
-  end.
-
-Arguments Scope fact [ nat_scope ].
-
-Lemma lt_O_fact : (n:nat)(lt O (fact n)).
-Proof.
-Induction n; Unfold lt; Simpl; Auto with arith.
-Qed.
-
-Lemma fact_neq_0:(n:nat)~(fact n)=O.
-Proof.
-Intro.
-Apply sym_not_eq.
-Apply lt_O_neq.
-Apply lt_O_fact.
-Qed.
-
-Lemma fact_growing : (n,m:nat) (le n m) -> (le (fact n) (fact m)).
-Proof.
-NewInduction 1.
-Apply le_n.
-Assert (le (mult (S O) (fact n)) (mult (S m) (fact m))).
-Apply le_mult_mult.
-Apply lt_le_S; Apply lt_O_Sn.
-Assumption.
-Simpl (mult (S O) (fact n)) in H0.
-Rewrite <- plus_n_O in H0.
-Assumption.
-Qed.
diff --git a/theories7/Arith/Gt.v b/theories7/Arith/Gt.v
deleted file mode 100755
index 16b6f203..00000000
--- a/theories7/Arith/Gt.v
+++ /dev/null
@@ -1,149 +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: Gt.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-Require Le.
-Require Lt.
-Require Plus.
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,p:nat.
-
-(** Order and successor *)
-
-Theorem gt_Sn_O : (n:nat)(gt (S n) O).
-Proof.
-  Auto with arith.
-Qed.
-Hints Resolve gt_Sn_O : arith v62.
-
-Theorem gt_Sn_n : (n:nat)(gt (S n) n).
-Proof.
-  Auto with arith.
-Qed.
-Hints Resolve gt_Sn_n : arith v62.
-
-Theorem gt_n_S : (n,m:nat)(gt n m)->(gt (S n) (S m)).
-Proof.
-  Auto with arith.
-Qed.
-Hints Resolve gt_n_S : arith v62.
-
-Lemma gt_S_n : (n,p:nat)(gt (S p) (S n))->(gt p n).
-Proof.
-  Auto with arith.
-Qed.
-Hints Immediate gt_S_n : arith v62.
-
-Theorem gt_S : (n,m:nat)(gt (S n) m)->((gt n m)\/(m=n)).
-Proof.
-  Intros n m H; Unfold gt; Apply le_lt_or_eq; Auto with arith.
-Qed.
-
-Lemma gt_pred : (n,p:nat)(gt p (S n))->(gt (pred p) n).
-Proof.
-  Auto with arith.
-Qed.
-Hints Immediate gt_pred : arith v62.
-
-(** Irreflexivity *)
-
-Lemma gt_antirefl : (n:nat)~(gt n n).
-Proof lt_n_n.
-Hints Resolve gt_antirefl : arith v62.
-
-(** Asymmetry *)
-
-Lemma gt_not_sym : (n,m:nat)(gt n m) -> ~(gt m n).
-Proof [n,m:nat](lt_not_sym m n).
-
-Hints Resolve gt_not_sym : arith v62.
-
-(** Relating strict and large orders *)
-
-Lemma le_not_gt : (n,m:nat)(le n m) -> ~(gt n m).
-Proof le_not_lt.
-Hints Resolve le_not_gt : arith v62.
-
-Lemma gt_not_le : (n,m:nat)(gt n m) -> ~(le n m).
-Proof.
-Auto with arith.
-Qed.
-
-Hints Resolve gt_not_le : arith v62.
-
-Theorem le_S_gt : (n,m:nat)(le (S n) m)->(gt m n).
-Proof.
-  Auto with arith.
-Qed.
-Hints Immediate le_S_gt : arith v62.
-
-Lemma gt_S_le : (n,p:nat)(gt (S p) n)->(le n p).
-Proof.
-  Intros n p; Exact (lt_n_Sm_le n p).
-Qed.
-Hints Immediate gt_S_le : arith v62.
-
-Lemma gt_le_S : (n,p:nat)(gt p n)->(le (S n) p).
-Proof.
-  Auto with arith.
-Qed.
-Hints Resolve gt_le_S : arith v62.
-
-Lemma le_gt_S : (n,p:nat)(le n p)->(gt (S p) n).
-Proof.
-  Auto with arith.
-Qed.
-Hints Resolve le_gt_S : arith v62.
-
-(** Transitivity *)
-
-Theorem le_gt_trans : (n,m,p:nat)(le m n)->(gt m p)->(gt n p).
-Proof.
-  Red; Intros; Apply lt_le_trans with m; Auto with arith.
-Qed.
-
-Theorem gt_le_trans : (n,m,p:nat)(gt n m)->(le p m)->(gt n p).
-Proof.
-  Red; Intros; Apply le_lt_trans with m; Auto with arith.
-Qed.
-
-Lemma gt_trans : (n,m,p:nat)(gt n m)->(gt m p)->(gt n p).
-Proof.
-  Red; Intros n m p H1 H2.
-  Apply lt_trans with m; Auto with arith.
-Qed.
-
-Theorem gt_trans_S : (n,m,p:nat)(gt (S n) m)->(gt m p)->(gt n p).
-Proof.
-  Red; Intros; Apply lt_le_trans with m; Auto with arith.
-Qed.
-
-Hints Resolve gt_trans_S le_gt_trans gt_le_trans : arith v62.
-
-(** Comparison to 0 *)
-
-Theorem gt_O_eq : (n:nat)((gt n O)\/(O=n)).
-Proof.
-  Intro n ; Apply gt_S ; Auto with arith.
-Qed.
-
-(** Simplification and compatibility *)
-
-Lemma simpl_gt_plus_l : (n,m,p:nat)(gt (plus p n) (plus p m))->(gt n m).
-Proof.
-  Red; Intros n m p H; Apply simpl_lt_plus_l with p; Auto with arith.
-Qed.
-
-Lemma gt_reg_l : (n,m,p:nat)(gt n m)->(gt (plus p n) (plus p m)).
-Proof.
-  Auto with arith.
-Qed.
-Hints Resolve gt_reg_l : arith v62.
diff --git a/theories7/Arith/Le.v b/theories7/Arith/Le.v
deleted file mode 100755
index cdb98645..00000000
--- a/theories7/Arith/Le.v
+++ /dev/null
@@ -1,122 +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: Le.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-(** Order on natural numbers *)
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,p:nat.
-
-(** Reflexivity *)
-
-Theorem le_refl : (n:nat)(le n n).
-Proof.
-Exact le_n.
-Qed.
-
-(** Transitivity *)
-
-Theorem le_trans : (n,m,p:nat)(le n m)->(le m p)->(le n p).
-Proof.
-  NewInduction 2; Auto.
-Qed.
-Hints Resolve le_trans : arith v62.
-
-(** Order, successor and predecessor *)
-
-Theorem le_n_S : (n,m:nat)(le n m)->(le (S n) (S m)).
-Proof.
-  NewInduction 1; Auto.
-Qed.
-
-Theorem le_n_Sn : (n:nat)(le n (S n)).
-Proof.
-  Auto.
-Qed.
-
-Theorem le_O_n : (n:nat)(le O n).
-Proof.
-  NewInduction n ; Auto.
-Qed.
-
-Hints Resolve le_n_S le_n_Sn le_O_n le_n_S : arith v62.
-
-Theorem le_pred_n : (n:nat)(le (pred n) n).
-Proof.
-NewInduction n ; Auto with arith.
-Qed.
-Hints Resolve le_pred_n : arith v62.
-
-Theorem le_trans_S : (n,m:nat)(le (S n) m)->(le n m).
-Proof.
-Intros n m H ; Apply le_trans with (S n); Auto with arith.
-Qed.
-Hints Immediate le_trans_S : arith v62.
-
-Theorem le_S_n : (n,m:nat)(le (S n) (S m))->(le n m).
-Proof.
-Intros n m H ; Change (le (pred (S n)) (pred (S m))).
-Elim H ; Simpl ; Auto with arith.
-Qed.
-Hints Immediate le_S_n : arith v62.
-
-Theorem le_pred : (n,m:nat)(le n m)->(le (pred n) (pred m)).
-Proof.
-NewInduction n as [|n IHn]. Simpl. Auto with arith.
-NewDestruct m as [|m]. Simpl. Intro H. Inversion H.
-Simpl. Auto with arith.
-Qed.
-
-(** Comparison to 0 *)
-
-Theorem le_Sn_O : (n:nat)~(le (S n) O).
-Proof.
-Red ; Intros n H.
-Change (IsSucc O) ; Elim H ; Simpl ; Auto with arith.
-Qed.
-Hints Resolve le_Sn_O : arith v62.
-
-Theorem le_n_O_eq : (n:nat)(le n O)->(O=n).
-Proof.
-NewInduction n; Auto with arith.
-Intro; Contradiction le_Sn_O with n.
-Qed.
-Hints Immediate le_n_O_eq : arith v62.
-
-(** Negative properties *)
-
-Theorem le_Sn_n : (n:nat)~(le (S n) n).
-Proof.
-NewInduction n; Auto with arith.
-Qed.
-Hints Resolve le_Sn_n : arith v62.
-
-(** Antisymmetry *)
-
-Theorem le_antisym : (n,m:nat)(le n m)->(le m n)->(n=m).
-Proof.
-Intros n m h ; NewDestruct h as [|m0]; Auto with arith.
-Intros H1.
-Absurd (le (S m0) m0) ; Auto with arith.
-Apply le_trans with n ; Auto with arith.
-Qed.
-Hints Immediate le_antisym : arith v62.
-
-(** A different elimination principle for the order on natural numbers *)
-
-Lemma le_elim_rel : (P:nat->nat->Prop)
-     ((p:nat)(P O p))->
-     ((p,q:nat)(le p q)->(P p q)->(P (S p) (S q)))->
-     (n,m:nat)(le n m)->(P n m).
-Proof.
-NewInduction n; Auto with arith.
-Intros m Le.
-Elim Le; Auto with arith.
-Qed.
diff --git a/theories7/Arith/Lt.v b/theories7/Arith/Lt.v
deleted file mode 100755
index 9bb1d564..00000000
--- a/theories7/Arith/Lt.v
+++ /dev/null
@@ -1,176 +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: Lt.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-Require Le.
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,p:nat.
-
-(** Irreflexivity *)
-
-Theorem lt_n_n : (n:nat)~(lt n n).
-Proof le_Sn_n.
-Hints Resolve lt_n_n : arith v62.
-
-(** Relationship between [le] and [lt] *) 
-
-Theorem lt_le_S : (n,p:nat)(lt n p)->(le (S n) p).
-Proof.
-Auto with arith.
-Qed.
-Hints Immediate lt_le_S : arith v62.
-
-Theorem lt_n_Sm_le : (n,m:nat)(lt n (S m))->(le n m).
-Proof.
-Auto with arith.
-Qed.
-Hints Immediate lt_n_Sm_le : arith v62.
-
-Theorem le_lt_n_Sm : (n,m:nat)(le n m)->(lt n (S m)).
-Proof.
-Auto with arith.
-Qed.
-Hints Immediate le_lt_n_Sm : arith v62.
-
-Theorem le_not_lt : (n,m:nat)(le n m) -> ~(lt m n).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-
-Theorem lt_not_le : (n,m:nat)(lt n m) -> ~(le m n).
-Proof.
-Red; Intros n m Lt Le; Exact (le_not_lt m n Le Lt).
-Qed.
-Hints Immediate le_not_lt lt_not_le : arith v62.
-
-(** Asymmetry *)
-
-Theorem lt_not_sym : (n,m:nat)(lt n m) -> ~(lt m n).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-
-(** Order and successor *)
-
-Theorem lt_n_Sn : (n:nat)(lt n (S n)).
-Proof.
-Auto with arith.
-Qed.
-Hints Resolve lt_n_Sn : arith v62.
-
-Theorem lt_S : (n,m:nat)(lt n m)->(lt n (S m)).
-Proof.
-Auto with arith.
-Qed.
-Hints Resolve lt_S : arith v62.
-
-Theorem lt_n_S : (n,m:nat)(lt n m)->(lt (S n) (S m)).
-Proof.
-Auto with arith.
-Qed.
-Hints Resolve lt_n_S : arith v62.
-
-Theorem lt_S_n : (n,m:nat)(lt (S n) (S m))->(lt n m).
-Proof.
-Auto with arith.
-Qed.
-Hints Immediate lt_S_n : arith v62.
-
-Theorem lt_O_Sn : (n:nat)(lt O (S n)).
-Proof.
-Auto with arith.
-Qed.
-Hints Resolve lt_O_Sn : arith v62.
-
-Theorem lt_n_O : (n:nat)~(lt n O).
-Proof le_Sn_O.
-Hints Resolve lt_n_O : arith v62.
-
-(** Predecessor *)
-
-Lemma S_pred : (n,m:nat)(lt m n)->n=(S (pred n)).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-
-Lemma lt_pred : (n,p:nat)(lt (S n) p)->(lt n (pred p)).
-Proof.
-NewInduction 1; Simpl; Auto with arith.
-Qed.
-Hints Immediate lt_pred : arith v62.
-
-Lemma lt_pred_n_n : (n:nat)(lt O n)->(lt (pred n) n).
-NewDestruct 1; Simpl; Auto with arith.
-Qed.
-Hints Resolve lt_pred_n_n : arith v62.
-
-(** Transitivity properties *)
-
-Theorem lt_trans : (n,m,p:nat)(lt n m)->(lt m p)->(lt n p).
-Proof.
-NewInduction 2; Auto with arith.
-Qed.
-
-Theorem lt_le_trans : (n,m,p:nat)(lt n m)->(le m p)->(lt n p).
-Proof.
-NewInduction 2; Auto with arith.
-Qed.
-
-Theorem le_lt_trans : (n,m,p:nat)(le n m)->(lt m p)->(lt n p).
-Proof.
-NewInduction 2; Auto with arith.
-Qed.
-
-Hints Resolve lt_trans lt_le_trans le_lt_trans : arith v62.
-
-(** Large = strict or equal *)
-
-Theorem le_lt_or_eq : (n,m:nat)(le n m)->((lt n m) \/ n=m).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-
-Theorem lt_le_weak : (n,m:nat)(lt n m)->(le n m).
-Proof.
-Auto with arith.
-Qed.
-Hints Immediate lt_le_weak : arith v62.
-
-(** Dichotomy *)
-
-Theorem le_or_lt : (n,m:nat)((le n m)\/(lt m n)).
-Proof.
-Intros n m; Pattern n m; Apply nat_double_ind; Auto with arith.
-NewInduction 1; Auto with arith.
-Qed.
-
-Theorem nat_total_order: (m,n: nat) ~ m = n -> (lt m n) \/ (lt n m).
-Proof.
-Intros m n diff.
-Elim (le_or_lt n m); [Intro H'0 | Auto with arith].
-Elim (le_lt_or_eq n m); Auto with arith.
-Intro H'; Elim diff; Auto with arith.
-Qed.
-
-(** Comparison to 0 *)
-
-Theorem neq_O_lt : (n:nat)(~O=n)->(lt O n).
-Proof.
-NewInduction n; Auto with arith.
-Intros; Absurd O=O; Trivial with arith.
-Qed.
-Hints Immediate neq_O_lt : arith v62.
-
-Theorem lt_O_neq : (n:nat)(lt O n)->(~O=n).
-Proof.
-NewInduction 1; Auto with arith.
-Qed.
-Hints Immediate lt_O_neq : arith v62.
diff --git a/theories7/Arith/Max.v b/theories7/Arith/Max.v
deleted file mode 100755
index aea389d1..00000000
--- a/theories7/Arith/Max.v
+++ /dev/null
@@ -1,87 +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: Max.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-Require Arith.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n:nat.
-
-(** maximum of two natural numbers *)
-
-Fixpoint max [n:nat] : nat -> nat :=  
-[m:nat]Cases n m of
-          O      _     => m
-       | (S n')  O     => n
-       | (S n') (S m') => (S (max n' m'))
-       end.
-
-(** Simplifications of [max] *)
-
-Lemma max_SS : (n,m:nat)((S (max n m))=(max (S n) (S m))).
-Proof.
-Auto with arith.
-Qed.
-
-Lemma max_sym : (n,m:nat)(max n m)=(max m n).
-Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Qed.
-
-(** [max] and [le] *)
-
-Lemma max_l : (n,m:nat)(le m n)->(max n m)=n.
-Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Qed.
-
-Lemma max_r : (n,m:nat)(le n m)->(max n m)=m.
-Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Qed.
-
-Lemma le_max_l : (n,m:nat)(le n (max n m)).
-Proof.
-NewInduction n; Intros; Simpl; Auto with arith.
-Elim m; Intros; Simpl; Auto with arith.
-Qed.
-
-Lemma le_max_r : (n,m:nat)(le m (max n m)).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Simpl; Auto with arith.
-Qed.
-Hints Resolve max_r max_l le_max_l le_max_r: arith v62.
-
-
-(** [max n m] is equal to [n] or [m] *)
-
-Lemma max_dec : (n,m:nat){(max n m)=n}+{(max n m)=m}.
-Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Elim (IHn m);Intro H;Elim H;Auto.
-Qed.
-
-Lemma max_case : (n,m:nat)(P:nat->Set)(P n)->(P m)->(P (max n m)).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Intros; Simpl; Auto with arith.
-Pattern (max n m); Apply IHn ; Auto with arith.
-Qed.
-
-Lemma max_case2 : (n,m:nat)(P:nat->Prop)(P n)->(P m)->(P (max n m)).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Intros; Simpl; Auto with arith.
-Pattern (max n m); Apply IHn ; Auto with arith.
-Qed.
-
-
diff --git a/theories7/Arith/Min.v b/theories7/Arith/Min.v
deleted file mode 100755
index fd5da61a..00000000
--- a/theories7/Arith/Min.v
+++ /dev/null
@@ -1,84 +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: Min.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-Require Arith.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n:nat.
-
-(** minimum of two natural numbers *)
-
-Fixpoint min [n:nat] : nat -> nat :=  
-[m:nat]Cases n m of
-          O      _     => O
-       | (S n')  O     => O
-       | (S n') (S m') => (S (min n' m'))
-       end.
-
-(** Simplifications of [min] *)
-
-Lemma min_SS : (n,m:nat)((S (min n m))=(min (S n) (S m))).
-Proof.
-Auto with arith.
-Qed.
-
-Lemma min_sym : (n,m:nat)(min n m)=(min m n).
-Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Qed.
-
-(** [min] and [le] *)
-
-Lemma min_l : (n,m:nat)(le n m)->(min n m)=n.
-Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Qed.
-
-Lemma min_r : (n,m:nat)(le m n)->(min n m)=m.
-Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Qed.
-
-Lemma le_min_l : (n,m:nat)(le (min n m) n).
-Proof.
-NewInduction n; Intros; Simpl; Auto with arith.
-Elim m; Intros; Simpl; Auto with arith.
-Qed.
-
-Lemma le_min_r : (n,m:nat)(le (min n m) m).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Simpl; Auto with arith.
-Qed.
-Hints Resolve min_l min_r le_min_l le_min_r : arith v62.
-
-(** [min n m] is equal to [n] or [m] *)
-
-Lemma min_dec : (n,m:nat){(min n m)=n}+{(min n m)=m}.
-Proof.
-NewInduction n;NewInduction m;Simpl;Auto with arith.
-Elim (IHn m);Intro H;Elim H;Auto.
-Qed.
-
-Lemma min_case : (n,m:nat)(P:nat->Set)(P n)->(P m)->(P (min n m)).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Intros; Simpl; Auto with arith.
-Pattern (min n m); Apply IHn ; Auto with arith.
-Qed.
-
-Lemma min_case2 : (n,m:nat)(P:nat->Prop)(P n)->(P m)->(P (min n m)).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-NewInduction m; Intros; Simpl; Auto with arith.
-Pattern (min n m); Apply IHn ; Auto with arith.
-Qed.
diff --git a/theories7/Arith/Minus.v b/theories7/Arith/Minus.v
deleted file mode 100755
index 709d5f0b..00000000
--- a/theories7/Arith/Minus.v
+++ /dev/null
@@ -1,120 +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: Minus.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
-
-(** Subtraction (difference between two natural numbers) *)
-
-Require Lt.
-Require Le.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,p:nat.
-
-(** 0 is right neutral *)
-
-Lemma minus_n_O : (n:nat)(n=(minus n O)).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-Qed.
-Hints Resolve minus_n_O : arith v62.
-
-(** Permutation with successor *)
-
-Lemma minus_Sn_m : (n,m:nat)(le m n)->((S (minus n m))=(minus (S n) m)).
-Proof.
-Intros n m Le; Pattern m n; Apply le_elim_rel; Simpl; Auto with arith.
-Qed.
-Hints Resolve minus_Sn_m : arith v62.
-
-Theorem pred_of_minus : (x:nat)(pred x)=(minus x (S O)).
-Intro x; NewInduction x; Simpl; Auto with arith.
-Qed.
-
-(** Diagonal *)
-
-Lemma minus_n_n : (n:nat)(O=(minus n n)).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-Qed.
-Hints Resolve minus_n_n : arith v62.
-
-(** Simplification *)
-
-Lemma minus_plus_simpl : 
-	(n,m,p:nat)((minus n m)=(minus (plus p n) (plus p m))).
-Proof.
-  NewInduction p; Simpl; Auto with arith.
-Qed.
-Hints Resolve minus_plus_simpl : arith v62.
-
-(** Relation with plus *)
-
-Lemma plus_minus : (n,m,p:nat)(n=(plus m p))->(p=(minus n m)).
-Proof.
-Intros n m p; Pattern m n; Apply nat_double_ind; Simpl; Intros.
-Replace (minus n0 O) with n0; Auto with arith.
-Absurd O=(S (plus n0 p)); Auto with arith.
-Auto with arith.
-Qed.
-Hints Immediate plus_minus : arith v62.
-
-Lemma minus_plus : (n,m:nat)(minus (plus n m) n)=m.
-Symmetry; Auto with arith.
-Qed.
-Hints Resolve minus_plus : arith v62.
-
-Lemma le_plus_minus : (n,m:nat)(le n m)->(m=(plus n (minus m n))).
-Proof.
-Intros n m Le; Pattern n m; Apply le_elim_rel; Simpl; Auto with arith.
-Qed.
-Hints Resolve le_plus_minus : arith v62.
-
-Lemma le_plus_minus_r : (n,m:nat)(le n m)->(plus n (minus m n))=m.
-Proof.
-Symmetry; Auto with arith.
-Qed.
-Hints Resolve le_plus_minus_r : arith v62.
-
-(** Relation with order *)
-
-Theorem le_minus: (i,h:nat) (le (minus i h) i).
-Proof.
-Intros i h;Pattern i h; Apply nat_double_ind; [
-  Auto
-| Auto
-| Intros m n H; Simpl; Apply le_trans with m:=m; Auto ].
-Qed.
-
-Lemma lt_minus : (n,m:nat)(le m n)->(lt O m)->(lt (minus n m) n).
-Proof.
-Intros n m Le; Pattern m n; Apply le_elim_rel; Simpl; Auto with arith.
-Intros; Absurd (lt O O); Auto with arith.
-Intros p q lepq Hp gtp.
-Elim (le_lt_or_eq O p); Auto with arith.
-Auto with arith.
-NewInduction 1; Elim minus_n_O; Auto with arith.
-Qed.
-Hints Resolve lt_minus : arith v62.
-
-Lemma lt_O_minus_lt : (n,m:nat)(lt O (minus n m))->(lt m n).
-Proof.
-Intros n m; Pattern n m; Apply nat_double_ind; Simpl; Auto with arith.
-Intros; Absurd (lt O O); Trivial with arith.
-Qed.
-Hints Immediate lt_O_minus_lt : arith v62.
-
-Theorem inj_minus_aux: (x,y:nat) ~(le y x) -> (minus x y) = O.
-Intros y x; Pattern y x ; Apply nat_double_ind; [
-  Simpl; Trivial with arith
-| Intros n H; Absurd (le O (S n)); [ Assumption | Apply le_O_n]
-| Simpl; Intros n m H1 H2; Apply H1;
-  Unfold not ; Intros H3; Apply H2; Apply le_n_S; Assumption].
-Qed.
diff --git a/theories7/Arith/Mult.v b/theories7/Arith/Mult.v
deleted file mode 100755
index 9bd4aaf9..00000000
--- a/theories7/Arith/Mult.v
+++ /dev/null
@@ -1,224 +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: Mult.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-Require Export Plus.
-Require Export Minus.
-Require Export Lt.
-Require Export Le.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,p:nat.
-
-(** Zero property *)
-
-Lemma mult_0_r : (n:nat) (mult n O)=O.
-Proof.
-Intro; Symmetry; Apply mult_n_O.
-Qed.
-
-Lemma mult_0_l : (n:nat) (mult O n)=O.
-Proof.
-Reflexivity.
-Qed.
-
-(** Distributivity *)
-
-Lemma mult_plus_distr : 
-      (n,m,p:nat)((mult (plus n m) p)=(plus (mult n p) (mult m p))).
-Proof.
-Intros; Elim n; Simpl; Intros; Auto with arith.
-Elim plus_assoc_l; Elim H; Auto with arith.
-Qed.
-Hints Resolve mult_plus_distr : arith v62.
-
-Lemma mult_plus_distr_r : (n,m,p:nat) (mult n (plus m p))=(plus (mult n m) (mult n p)).
-Proof.
-  NewInduction n. Trivial.
-  Intros. Simpl. Rewrite (IHn m p). Apply sym_eq. Apply plus_permute_2_in_4.
-Qed.
-
-Lemma mult_minus_distr : (n,m,p:nat)((mult (minus n m) p)=(minus (mult n p) (mult m p))).
-Proof.
-Intros; Pattern n m; Apply nat_double_ind; Simpl; Intros; Auto with arith.
-Elim minus_plus_simpl; Auto with arith.
-Qed.
-Hints Resolve mult_minus_distr : arith v62.
-
-(** Associativity *)
-
-Lemma mult_assoc_r : (n,m,p:nat)((mult (mult n m) p) = (mult n (mult m p))).
-Proof.
-Intros; Elim n; Intros; Simpl; Auto with arith.
-Rewrite mult_plus_distr.
-Elim H; Auto with arith.
-Qed.
-Hints Resolve mult_assoc_r : arith v62.
-
-Lemma mult_assoc_l : (n,m,p:nat)(mult n (mult m p)) = (mult (mult n m) p).
-Proof.
-Auto with arith.
-Qed.
-Hints Resolve mult_assoc_l : arith v62.
-
-(** Commutativity *)
-
-Lemma mult_sym : (n,m:nat)(mult n m)=(mult m n).
-Proof.
-Intros; Elim n; Intros; Simpl; Auto with arith.
-Elim mult_n_Sm.
-Elim H; Apply plus_sym.
-Qed.
-Hints Resolve mult_sym : arith v62.
-
-(** 1 is neutral *)
-
-Lemma mult_1_n : (n:nat)(mult (S O) n)=n.
-Proof.
-Simpl; Auto with arith.
-Qed.
-Hints Resolve mult_1_n : arith v62.
-
-Lemma mult_n_1 : (n:nat)(mult n (S O))=n.
-Proof.
-Intro; Elim mult_sym; Auto with arith.
-Qed.
-Hints Resolve mult_n_1 : arith v62.
-
-(** Compatibility with orders *)
-
-Lemma mult_O_le : (n,m:nat)(m=O)\/(le n (mult m n)).
-Proof.
-NewInduction m; Simpl; Auto with arith.
-Qed.
-Hints Resolve mult_O_le : arith v62.
-
-Lemma mult_le_compat_l : (n,m,p:nat) (le n m) -> (le (mult p n) (mult p m)).
-Proof.
-  NewInduction p as [|p IHp]. Intros. Simpl. Apply le_n.
-  Intros. Simpl. Apply le_plus_plus. Assumption.
-  Apply IHp. Assumption.
-Qed.
-Hints Resolve mult_le_compat_l : arith.
-V7only [
-Notation mult_le := [m,n,p:nat](mult_le_compat_l p n m).
-].
-
-
-Lemma le_mult_right : (m,n,p:nat)(le m n)->(le (mult m p) (mult n p)).
-Intros m n p H.
-Rewrite mult_sym. Rewrite (mult_sym n).
-Auto with arith.
-Qed.
-
-Lemma le_mult_mult :
-  (m,n,p,q:nat)(le m n)->(le p q)->(le (mult m p) (mult n q)).
-Proof.
-Intros m n p q Hmn Hpq; NewInduction Hmn.
-NewInduction Hpq.
-(* m*p<=m*p *)
-Apply le_n.
-(* m*p<=m*m0 -> m*p<=m*(S m0) *)
-Rewrite <- mult_n_Sm; Apply le_trans with (mult m m0).
-Assumption.
-Apply le_plus_l.
-(* m*p<=m0*q -> m*p<=(S m0)*q *)
-Simpl; Apply le_trans with (mult m0 q).
-Assumption.
-Apply le_plus_r.
-Qed.
-
-Lemma mult_lt : (m,n,p:nat) (lt n p) -> (lt (mult (S m) n) (mult (S m) p)).
-Proof.
-  Intro m; NewInduction m. Intros. Simpl. Rewrite <- plus_n_O. Rewrite <- plus_n_O. Assumption.
-  Intros. Exact (lt_plus_plus ? ? ? ? H (IHm ? ? H)).
-Qed.
-
-Hints Resolve mult_lt : arith.
-V7only [
-Notation lt_mult_left := mult_lt.
-(* Theorem lt_mult_left :
-   (x,y,z:nat) (lt x y) -> (lt (mult (S z) x) (mult (S z) y)).
-*)
-].
-
-Lemma lt_mult_right :
-  (m,n,p:nat) (lt m n) -> (lt (0) p) -> (lt (mult m p) (mult n p)).
-Intros m n p H H0.
-NewInduction p.
-Elim (lt_n_n ? H0).
-Rewrite mult_sym.
-Replace (mult n (S p)) with (mult (S p) n); Auto with arith.
-Qed.
-
-Lemma mult_le_conv_1 : (m,n,p:nat) (le (mult (S m) n) (mult (S m) p)) -> (le n p).
-Proof.
-  Intros m n p H. Elim (le_or_lt n p). Trivial.
-  Intro H0. Cut (lt (mult (S m) n) (mult (S m) n)). Intro. Elim (lt_n_n ? H1).
-  Apply le_lt_trans with m:=(mult (S m) p). Assumption.
-  Apply mult_lt. Assumption.
-Qed.
-
-(** n|->2*n and n|->2n+1 have disjoint image *)
-
-V7only [ (* From Zdivides *) ].
-Theorem odd_even_lem:
-  (p, q : ?)  ~ (plus (mult (2) p) (1)) = (mult (2) q).
-Intros p; Elim p; Auto.
-Intros q; Case q; Simpl.
-Red; Intros; Discriminate.
-Intros q'; Rewrite [x, y : ?]  (plus_sym x (S y)); Simpl; Red; Intros;
- Discriminate.
-Intros p' H q; Case q.
-Simpl; Red; Intros; Discriminate.
-Intros q'; Red; Intros H0; Case (H q').
-Replace (mult (S (S O)) q') with (minus (mult (S (S O)) (S q')) (2)).
-Rewrite <- H0; Simpl; Auto.
-Repeat Rewrite [x, y : ?]  (plus_sym x (S y)); Simpl; Auto.
-Simpl; Repeat Rewrite [x, y : ?]  (plus_sym x (S y)); Simpl; Auto.
-Case q'; Simpl; Auto.
-Qed.
-
-
-(** Tail-recursive mult *)
-
-(** [tail_mult] is an alternative definition for [mult] which is 
-    tail-recursive, whereas [mult] is not. This can be useful 
-    when extracting programs. *)
-
-Fixpoint mult_acc [s,m,n:nat] : nat := 
-   Cases n of 
-      O => s
-      | (S p) => (mult_acc (tail_plus m s) m p)
-    end.
-
-Lemma mult_acc_aux : (n,s,m:nat)(plus s (mult n m))= (mult_acc s m n).
-Proof.
-NewInduction n as [|p IHp]; Simpl;Auto.
-Intros s m; Rewrite <- plus_tail_plus; Rewrite <- IHp.
-Rewrite <- plus_assoc_r; Apply (f_equal2 nat nat);Auto.
-Rewrite plus_sym;Auto.
-Qed.
-
-Definition tail_mult := [n,m:nat](mult_acc O m n).
-
-Lemma mult_tail_mult : (n,m:nat)(mult n m)=(tail_mult n m).
-Proof.
-Intros; Unfold tail_mult; Rewrite <- mult_acc_aux;Auto.
-Qed.
-
-(** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus] 
-    and [mult] and simplify *)
-
-Tactic Definition TailSimpl := 
-   Repeat Rewrite <- plus_tail_plus; 
-   Repeat Rewrite <- mult_tail_mult; 
-   Simpl. 
diff --git a/theories7/Arith/Peano_dec.v b/theories7/Arith/Peano_dec.v
deleted file mode 100755
index 6646545a..00000000
--- a/theories7/Arith/Peano_dec.v
+++ /dev/null
@@ -1,36 +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: Peano_dec.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-Require Decidable.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,x,y:nat.
-
-Theorem O_or_S : (n:nat)({m:nat|(S m)=n})+{O=n}.
-Proof.
-NewInduction n.
-Auto.
-Left; Exists n; Auto.
-Defined.
-
-Theorem eq_nat_dec : (n,m:nat){n=m}+{~(n=m)}.
-Proof.
-NewInduction n; NewInduction m; Auto.
-Elim (IHn m); Auto.
-Defined.
-
-Hints Resolve O_or_S eq_nat_dec : arith.
-
-Theorem dec_eq_nat:(x,y:nat)(decidable (x=y)).
-Intros x y; Unfold decidable; Elim (eq_nat_dec x y); Auto with arith.
-Defined.
-
diff --git a/theories7/Arith/Plus.v b/theories7/Arith/Plus.v
deleted file mode 100755
index 23488b4c..00000000
--- a/theories7/Arith/Plus.v
+++ /dev/null
@@ -1,223 +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: Plus.v,v 1.5.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-(** Properties of addition *)
-
-Require Le.
-Require Lt.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,p,q:nat.
-
-(** Zero is neutral *)
-
-Lemma plus_0_l : (n:nat) (O+n)=n.
-Proof.
-Reflexivity.
-Qed.
-
-Lemma plus_0_r : (n:nat) (n+O)=n.
-Proof.
-Intro; Symmetry; Apply plus_n_O.
-Qed.
-
-(** Commutativity *)
-
-Lemma plus_sym : (n,m:nat)(n+m)=(m+n).
-Proof.
-Intros n m ; Elim n ; Simpl ; Auto with arith.
-Intros y H ; Elim (plus_n_Sm m y) ; Auto with arith.
-Qed.
-Hints Immediate plus_sym : arith v62.
-
-(** Associativity *)
-
-Lemma plus_Snm_nSm : (n,m:nat)((S n)+m)=(n+(S m)).
-Intros.
-Simpl.
-Rewrite -> (plus_sym n m).
-Rewrite -> (plus_sym n (S m)).
-Trivial with arith.
-Qed.
-
-Lemma plus_assoc_l : (n,m,p:nat)((n+(m+p))=((n+m)+p)).
-Proof.
-Intros n m p; Elim n; Simpl; Auto with arith.
-Qed.
-Hints Resolve plus_assoc_l : arith v62.
-
-Lemma plus_permute : (n,m,p:nat) ((n+(m+p))=(m+(n+p))).
-Proof. 
-Intros; Rewrite (plus_assoc_l m n p); Rewrite (plus_sym m n); Auto with arith.
-Qed.
-
-Lemma plus_assoc_r : (n,m,p:nat)(((n+m)+p)=(n+(m+p))).
-Proof.
-Auto with arith.
-Qed.
-Hints Resolve plus_assoc_r : arith v62.
-
-(** Simplification *)
-
-Lemma plus_reg_l : (m,p,n:nat)((n+m)=(n+p))->(m=p).
-Proof.
-Intros m p n; NewInduction n ; Simpl ; Auto with arith.
-Qed.
-V7only [
-(* Compatibility order of arguments *)
-Notation "'simpl_plus_l' c" := [a,b:nat](plus_reg_l a b c)
-  (at level 10, c at next level).
-Notation "'simpl_plus_l' c a" := [b:nat](plus_reg_l a b c)
-  (at level 10, a, c at next level).
-Notation "'simpl_plus_l' c a b" := (plus_reg_l a b c)
-  (at level 10, a, b, c at next level).
-Notation simpl_plus_l := plus_reg_l.
-].
-
-Lemma plus_le_reg_l : (n,m,p:nat)((p+n)<=(p+m))->(n<=m).
-Proof.
-NewInduction p; Simpl; Auto with arith.
-Qed.
-V7only [
-(* Compatibility order of arguments *)
-Notation "'simpl_le_plus_l' c" := [a,b:nat](plus_le_reg_l a b c)
-  (at level 10, c at next level).
-Notation "'simpl_le_plus_l' c a" := [b:nat](plus_le_reg_l a b c)
-  (at level 10, a, c at next level).
-Notation "'simpl_le_plus_l' c a b" := (plus_le_reg_l a b c)
-  (at level 10, a, b, c at next level).
-Notation simpl_le_plus_l := [p,n,m:nat](plus_le_reg_l n m p).
-].
-
-Lemma simpl_lt_plus_l : (n,m,p:nat) (p+n)<(p+m) -> n<m.
-Proof.
-NewInduction p; Simpl; Auto with arith.
-Qed.
-
-(** Compatibility with order *)
-
-Lemma le_reg_l : (n,m,p:nat) n<=m -> (p+n)<=(p+m).
-Proof.
-NewInduction p; Simpl; Auto with arith.
-Qed.
-Hints Resolve le_reg_l : arith v62.
-
-Lemma le_reg_r : (a,b,c:nat) a<=b -> (a+c)<=(b+c).
-Proof.
-NewInduction 1 ; Simpl; Auto with arith.
-Qed.
-Hints Resolve le_reg_r : arith v62.
-
-Lemma le_plus_l : (n,m:nat) n<=(n+m).
-Proof.
-NewInduction n; Simpl; Auto with arith.
-Qed.
-Hints Resolve le_plus_l : arith v62.
-
-Lemma le_plus_r : (n,m:nat) m<=(n+m).
-Proof.
-Intros n m; Elim n; Simpl; Auto with arith.
-Qed.
-Hints Resolve le_plus_r : arith v62.
-
-Theorem le_plus_trans : (n,m,p:nat) n<=m -> n<=(m+p).
-Proof.
-Intros; Apply le_trans with m:=m; Auto with arith.
-Qed.
-Hints Resolve le_plus_trans : arith v62.
-
-Theorem lt_plus_trans : (n,m,p:nat) n<m -> n<(m+p).
-Proof.
-Intros; Apply lt_le_trans with m:=m; Auto with arith.
-Qed.
-Hints Immediate lt_plus_trans : arith v62.
-
-Lemma lt_reg_l : (n,m,p:nat) n<m -> (p+n)<(p+m).
-Proof.
-NewInduction p; Simpl; Auto with arith.
-Qed.
-Hints Resolve lt_reg_l : arith v62.
-
-Lemma lt_reg_r : (n,m,p:nat) n<m -> (n+p)<(m+p).
-Proof.
-Intros n m p H ; Rewrite (plus_sym n p) ; Rewrite (plus_sym m p).
-Elim p; Auto with arith.
-Qed.
-Hints Resolve lt_reg_r : arith v62.
-
-Lemma le_plus_plus : (n,m,p,q:nat)  n<=m -> p<=q -> (n+p)<=(m+q).
-Proof.
-Intros n m p q H H0.
-Elim H; Simpl; Auto with arith.
-Qed.
-
-Lemma le_lt_plus_plus : (n,m,p,q:nat)  n<=m -> p<q -> (n+p)<(m+q).
-Proof.
-  Unfold lt. Intros. Change ((S n)+p)<=(m+q). Rewrite plus_Snm_nSm.
-  Apply le_plus_plus; Assumption.
-Qed.
-
-Lemma lt_le_plus_plus : (n,m,p,q:nat) n<m -> p<=q -> (n+p)<(m+q).
-Proof.
-  Unfold lt. Intros. Change ((S n)+p)<=(m+q). Apply le_plus_plus; Assumption.
-Qed.
-
-Lemma lt_plus_plus : (n,m,p,q:nat) n<m -> p<q -> (n+p)<(m+q).
-Proof.
-  Intros. Apply lt_le_plus_plus. Assumption.
-  Apply lt_le_weak. Assumption.
-Qed.
-
-(** Inversion lemmas *)
-
-Lemma plus_is_O : (m,n:nat) (m+n)=O -> m=O /\ n=O.
-Proof.
-  Intro m; NewDestruct m; Auto.
-  Intros. Discriminate H.
-Qed.
-
-Definition plus_is_one : 
-      (m,n:nat) (m+n)=(S O) -> {m=O /\ n=(S O)}+{m=(S O) /\ n=O}.
-Proof.
-  Intro m; NewDestruct m; Auto.
-  NewDestruct n; Auto.
-  Intros. 
-  Simpl in H. Discriminate H.
-Defined.
-
-(** Derived properties *)
-
-Lemma plus_permute_2_in_4 : (m,n,p,q:nat) ((m+n)+(p+q))=((m+p)+(n+q)).
-Proof.
-  Intros m n p q. 
-  Rewrite <- (plus_assoc_l m n (p+q)). Rewrite (plus_assoc_l n p q).
-  Rewrite (plus_sym n p). Rewrite <- (plus_assoc_l p n q). Apply plus_assoc_l.
-Qed.
-
-(** Tail-recursive plus *)
-
-(** [tail_plus] is an alternative definition for [plus] which is 
-    tail-recursive, whereas [plus] is not. This can be useful
-    when extracting programs. *)
-
-Fixpoint plus_acc [q,n:nat] : nat := 
-   Cases n of 
-      O => q
-      | (S p) => (plus_acc (S q) p)
-    end.
-
-Definition tail_plus := [n,m:nat](plus_acc m n).
-
-Lemma plus_tail_plus : (n,m:nat)(n+m)=(tail_plus n m).
-Unfold tail_plus; NewInduction n as [|n IHn]; Simpl; Auto.
-Intro m; Rewrite <- IHn; Simpl; Auto.
-Qed.
diff --git a/theories7/Arith/Wf_nat.v b/theories7/Arith/Wf_nat.v
deleted file mode 100755
index be1003ce..00000000
--- a/theories7/Arith/Wf_nat.v
+++ /dev/null
@@ -1,200 +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: Wf_nat.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-(** Well-founded relations and natural numbers *)
-
-Require Lt.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Implicit Variables Type m,n,p:nat.
-
-Chapter  Well_founded_Nat.
-
-Variable A : Set.
-
-Variable f : A -> nat.
-Definition ltof := [a,b:A](lt (f a) (f b)).
-Definition gtof := [a,b:A](gt (f b) (f a)).
-
-Theorem well_founded_ltof : (well_founded A ltof).
-Proof.
-Red.
-Cut (n:nat)(a:A)(lt (f a) n)->(Acc A ltof a).
-Intros H a;  Apply (H (S (f a))); Auto with arith.
-NewInduction n.
-Intros; Absurd (lt (f a) O); Auto with arith.
-Intros a ltSma.
-Apply Acc_intro.
-Unfold ltof; Intros b ltfafb.
-Apply IHn.
-Apply lt_le_trans with (f a); Auto with arith.
-Qed.
-
-Theorem  well_founded_gtof : (well_founded A gtof).
-Proof well_founded_ltof.
-
-(** It is possible to directly prove the induction principle going
-   back to primitive recursion on natural numbers ([induction_ltof1])
-   or to use the previous lemmas to extract a program with a fixpoint
-   ([induction_ltof2]) 
-
-the ML-like program for [induction_ltof1] is : [[
-   let induction_ltof1 F a = indrec ((f a)+1) a 
-   where rec indrec = 
-        function 0    -> (function a -> error)
-               |(S m) -> (function a -> (F a (function y -> indrec y m)));;
-]]
-
-the ML-like program for [induction_ltof2] is : [[
-   let induction_ltof2 F a = indrec a
-   where rec indrec a = F a indrec;;
-]] *)
-
-Theorem induction_ltof1 
-  : (P:A->Set)((x:A)((y:A)(ltof y x)->(P y))->(P x))->(a:A)(P a).
-Proof.
-Intros P F; Cut (n:nat)(a:A)(lt (f a) n)->(P a).
-Intros H a;  Apply (H (S (f a))); Auto with arith.
-NewInduction n.
-Intros; Absurd (lt (f a) O); Auto with arith.
-Intros a ltSma.
-Apply F.
-Unfold ltof; Intros b ltfafb.
-Apply IHn.
-Apply lt_le_trans with (f a); Auto with arith.
-Defined. 
-
-Theorem induction_gtof1 
-  : (P:A->Set)((x:A)((y:A)(gtof y x)->(P y))->(P x))->(a:A)(P a).
-Proof.
-Exact induction_ltof1.
-Defined.
-
-Theorem induction_ltof2 
-  : (P:A->Set)((x:A)((y:A)(ltof y x)->(P y))->(P x))->(a:A)(P a).
-Proof.
-Exact (well_founded_induction A ltof well_founded_ltof).
-Defined.
-
-Theorem induction_gtof2 
-  : (P:A->Set)((x:A)((y:A)(gtof y x)->(P y))->(P x))->(a:A)(P a).
-Proof.
-Exact induction_ltof2.
-Defined.
-
-(** If a relation [R] is compatible with [lt] i.e. if [x R y => f(x) < f(y)]
-    then [R] is well-founded. *)
-
-Variable R : A->A->Prop.
-
-Hypothesis H_compat : (x,y:A) (R x y) -> (lt (f x) (f y)).
-
-Theorem well_founded_lt_compat : (well_founded A R).
-Proof.
-Red.
-Cut (n:nat)(a:A)(lt (f a) n)->(Acc A R a).
-Intros H a; Apply (H (S (f a))); Auto with arith.
-NewInduction n.
-Intros; Absurd (lt (f a) O); Auto with arith.
-Intros a ltSma.
-Apply Acc_intro.
-Intros b ltfafb.
-Apply IHn.
-Apply lt_le_trans with (f a); Auto with arith.
-Qed.
-
-End Well_founded_Nat.
-
-Lemma lt_wf : (well_founded nat lt).
-Proof (well_founded_ltof nat [m:nat]m).
-
-Lemma lt_wf_rec1 : (p:nat)(P:nat->Set)
-              ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
-Proof.
-Exact [p:nat][P:nat->Set][F:(n:nat)((m:nat)(lt m n)->(P m))->(P n)]
-     (induction_ltof1 nat [m:nat]m P F p).
-Defined.
-
-Lemma lt_wf_rec : (p:nat)(P:nat->Set)
-              ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
-Proof.
-Exact [p:nat][P:nat->Set][F:(n:nat)((m:nat)(lt m n)->(P m))->(P n)]
-     (induction_ltof2 nat [m:nat]m P F p).
-Defined.
-
-Lemma lt_wf_ind : (p:nat)(P:nat->Prop)
-              ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
-Intro p; Intros; Elim (lt_wf p); Auto with arith.
-Qed.
-
-Lemma gt_wf_rec : (p:nat)(P:nat->Set)
-              ((n:nat)((m:nat)(gt n m)->(P m))->(P n)) -> (P p).
-Proof.
-Exact lt_wf_rec.
-Defined.
-
-Lemma gt_wf_ind : (p:nat)(P:nat->Prop)
-              ((n:nat)((m:nat)(gt n m)->(P m))->(P n)) -> (P p).
-Proof lt_wf_ind.
-
-Lemma lt_wf_double_rec : 
-  (P:nat->nat->Set)
-  ((n,m:nat)((p,q:nat)(lt p n)->(P p q))->((p:nat)(lt p m)->(P n p))->(P n m))
-   -> (p,q:nat)(P p q).
-Intros P Hrec p; Pattern p; Apply lt_wf_rec.
-Intros n H q; Pattern q; Apply lt_wf_rec; Auto with arith.
-Defined.
-
-Lemma lt_wf_double_ind : 
-  (P:nat->nat->Prop)
-  ((n,m:nat)((p,q:nat)(lt p n)->(P p q))->((p:nat)(lt p m)->(P n p))->(P n m))
-   -> (p,q:nat)(P p q).
-Intros P Hrec p; Pattern p; Apply lt_wf_ind.
-Intros n H q; Pattern q; Apply lt_wf_ind; Auto with arith.
-Qed.
-
-Hints Resolve lt_wf : arith.
-Hints Resolve well_founded_lt_compat : arith.
-
-Section LT_WF_REL.
-Variable A :Set.
-Variable R:A->A->Prop.
-
-(* Relational form of inversion *)
-Variable F : A -> nat -> Prop.
-Definition inv_lt_rel 
- [x,y]:=(EX n | (F x n) & (m:nat)(F y m)->(lt n m)).
-
-Hypothesis F_compat : (x,y:A) (R x y) -> (inv_lt_rel x y).
-Remark acc_lt_rel : 
-  (x:A)(EX n | (F x n))->(Acc A R x).
-Intros x (n,fxn); Generalize x fxn; Clear x fxn.
-Pattern n; Apply lt_wf_ind; Intros.
-Constructor; Intros.
-Case (F_compat y x); Trivial; Intros.
-Apply (H x0); Auto.
-Save.
-
-Theorem well_founded_inv_lt_rel_compat : (well_founded A R).
-Constructor; Intros.
-Case (F_compat y a); Trivial; Intros.
-Apply acc_lt_rel; Trivial.
-Exists x; Trivial.
-Save.
-
-
-End LT_WF_REL.
-
-Lemma well_founded_inv_rel_inv_lt_rel 
-  : (A:Set)(F:A->nat->Prop)(well_founded A (inv_lt_rel A F)).
-Intros; Apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); Trivial.
-Save.
diff --git a/theories7/Bool/Bool.v b/theories7/Bool/Bool.v
deleted file mode 100755
index cd75cf30..00000000
--- a/theories7/Bool/Bool.v
+++ /dev/null
@@ -1,544 +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: Bool.v,v 1.2.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-(** Booleans  *)
-
-(** The type [bool] is defined in the prelude as
-    [Inductive bool : Set := true : bool | false : bool] *)
-
-(** Interpretation of booleans as Proposition *)
-Definition Is_true := [b:bool](Cases b of
-                                 true  => True
-                               | false => False
-                               end).
-Hints Unfold Is_true : bool.
-
-Lemma Is_true_eq_left : (x:bool)x=true -> (Is_true x).
-Proof.
-  Intros; Rewrite H; Auto with bool.
-Qed.
-
-Lemma Is_true_eq_right : (x:bool)true=x -> (Is_true x).
-Proof.
-  Intros; Rewrite <- H; Auto with bool.
-Qed.
-
-Hints Immediate Is_true_eq_right Is_true_eq_left : bool.
-
-(*******************)
-(** Discrimination *)
-(*******************)
-
-Lemma diff_true_false : ~true=false.
-Proof.
-Unfold not; Intro contr; Change (Is_true false).
-Elim contr; Simpl; Trivial with bool.
-Qed.
-Hints Resolve diff_true_false : bool v62.
-
-Lemma diff_false_true : ~false=true.
-Proof.
-Red; Intros H; Apply diff_true_false.
-Symmetry.
-Assumption.
-Qed.
-Hints Resolve diff_false_true : bool v62.
-
-Lemma eq_true_false_abs : (b:bool)(b=true)->(b=false)->False.
-Intros b H; Rewrite H; Auto with bool.
-Qed.
-Hints Resolve eq_true_false_abs : bool.
-
-Lemma not_true_is_false : (b:bool)~b=true->b=false.
-NewDestruct b.
-Intros.
-Red in H; Elim H.
-Reflexivity.
-Intros abs.
-Reflexivity.
-Qed.
-
-Lemma not_false_is_true : (b:bool)~b=false->b=true.
-NewDestruct b.
-Intros.
-Reflexivity.
-Intro H; Red in H; Elim H.
-Reflexivity.
-Qed.
-
-(**********************)
-(** Order on booleans *)
-(**********************)
-
-Definition leb := [b1,b2:bool]
-  Cases b1 of 
-  | true => b2=true
-  | false => True 
-  end.
-Hints Unfold leb : bool v62.
-
-(*************)
-(** Equality *)
-(*************)
-
-Definition eqb : bool->bool->bool :=
- [b1,b2:bool]
-    Cases b1 b2 of
-      true  true  => true
-    | true  false => false
-    | false true  => false
-    | false false => true
-    end.
-
-Lemma eqb_refl : (x:bool)(Is_true (eqb x x)).
-NewDestruct x; Simpl; Auto with bool.
-Qed.
-
-Lemma eqb_eq : (x,y:bool)(Is_true (eqb x y))->x=y.
-NewDestruct x; NewDestruct y; Simpl; Tauto.
-Qed.
-
-Lemma Is_true_eq_true : (x:bool) (Is_true x) -> x=true.
-NewDestruct x; Simpl; Tauto.
-Qed.
- 
-Lemma Is_true_eq_true2 : (x:bool)  x=true -> (Is_true x).
-NewDestruct x; Simpl; Auto with bool.
-Qed.
-
-Lemma eqb_subst : 
-  (P:bool->Prop)(b1,b2:bool)(eqb b1 b2)=true->(P b1)->(P b2).
-Unfold eqb .
-Intros P b1.
-Intros b2.
-Case b1.
-Case b2.
-Trivial with bool.
-Intros H.
-Inversion_clear H.
-Case b2.
-Intros H.
-Inversion_clear H.
-Trivial with bool.
-Qed.
-
-Lemma eqb_reflx : (b:bool)(eqb b b)=true.
-Intro b.
-Case b.
-Trivial with bool.
-Trivial with bool.
-Qed.
-
-Lemma eqb_prop : (a,b:bool)(eqb a b)=true -> a=b.
-NewDestruct a; NewDestruct b; Simpl; Intro;
-  Discriminate H Orelse Reflexivity.
-Qed.
-
-
-(************************)
-(** Logical combinators *)
-(************************)
- 
-Definition ifb : bool -> bool -> bool -> bool
-     := [b1,b2,b3:bool](Cases b1 of true => b2 | false => b3 end).
-
-Definition andb : bool -> bool -> bool
-     := [b1,b2:bool](ifb b1 b2 false).
-
-Definition orb : bool -> bool -> bool
-     := [b1,b2:bool](ifb b1 true b2).
-
-Definition implb : bool -> bool -> bool
-     := [b1,b2:bool](ifb b1 b2 true).
-
-Definition xorb :  bool -> bool -> bool
-     := [b1,b2:bool]
-    Cases b1 b2 of
-      true  true  => false
-    | true  false => true
-    | false true  => true
-    | false false => false
-    end.
-
-Definition negb := [b:bool]Cases b of
-                             true  => false
-                           | false => true
-                           end.
-
-Infix "||" orb  (at level 4, left associativity) : bool_scope.
-Infix "&&" andb (at level 3, no associativity) : bool_scope
-  V8only (at level 40, left associativity).
-
-Open Scope bool_scope.
-
-Delimits Scope bool_scope with bool.
-
-Bind Scope bool_scope with bool.
-
-(**************************)
-(** Lemmas about [negb]   *)
-(**************************)
-
-Lemma negb_intro : (b:bool)b=(negb (negb b)).
-Proof.
-NewDestruct b; Reflexivity.
-Qed.
-
-Lemma negb_elim : (b:bool)(negb (negb b))=b.
-Proof.
-NewDestruct b; Reflexivity.
-Qed.
-       
-Lemma negb_orb : (b1,b2:bool)
-  (negb (orb b1 b2)) = (andb (negb b1) (negb b2)).
-Proof.
-  NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
-Qed.
-
-Lemma negb_andb : (b1,b2:bool)
-  (negb (andb b1 b2)) = (orb (negb b1) (negb b2)).
-Proof.
-  NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
-Qed.
-
-Lemma negb_sym : (b,b':bool)(b'=(negb b))->(b=(negb b')).
-Proof.
-NewDestruct b; NewDestruct b'; Intros; Simpl; Trivial with bool.
-Qed.
-
-Lemma no_fixpoint_negb : (b:bool)~(negb b)=b.
-Proof.
-NewDestruct b; Simpl; Intro; Apply diff_true_false; Auto with bool.
-Qed.
-
-Lemma eqb_negb1 : (b:bool)(eqb (negb b) b)=false.
-NewDestruct b.
-Trivial with bool.
-Trivial with bool.
-Qed.
- 
-Lemma eqb_negb2 : (b:bool)(eqb b (negb b))=false.
-NewDestruct b.
-Trivial with bool.
-Trivial with bool.
-Qed.
-
-
-Lemma if_negb : (A:Set) (b:bool) (x,y:A) (if (negb b) then x else y)=(if b then y else x).
-Proof.
-  NewDestruct b;Trivial.
-Qed.
-
-
-(****************************)
-(** A few lemmas about [or] *)
-(****************************)
-
-Lemma orb_prop : 
-  (a,b:bool)(orb a b)=true -> (a = true)\/(b = true).
-NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); Auto with bool.
-Qed.
-
-Lemma orb_prop2 : 
-  (a,b:bool)(Is_true (orb a b)) -> (Is_true a)\/(Is_true b).
-NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); Auto with bool.
-Qed.
-
-Lemma orb_true_intro 
-    : (b1,b2:bool)(b1=true)\/(b2=true)->(orb b1 b2)=true.
-NewDestruct b1; Auto with bool.
-NewDestruct 1; Intros.
-Elim diff_true_false; Auto with bool.
-Rewrite H; Trivial with bool.
-Qed.
-Hints Resolve orb_true_intro : bool v62.
-
-Lemma orb_b_true : (b:bool)(orb b true)=true.
-Auto with bool.
-Qed.
-Hints Resolve orb_b_true : bool v62.
-
-Lemma orb_true_b : (b:bool)(orb true b)=true.
-Trivial with bool.
-Qed.
-
-Definition orb_true_elim : (b1,b2:bool)(orb b1 b2)=true -> {b1=true}+{b2=true}.
-NewDestruct b1; Simpl; Auto with bool.
-Defined.
-
-Lemma orb_false_intro 
-    : (b1,b2:bool)(b1=false)->(b2=false)->(orb b1 b2)=false.
-Intros b1 b2 H1 H2; Rewrite H1; Rewrite H2; Trivial with bool.
-Qed.
-Hints Resolve orb_false_intro : bool v62.
-
-Lemma orb_b_false : (b:bool)(orb b false)=b.
-Proof.
-  NewDestruct b; Trivial with bool.
-Qed.
-Hints Resolve orb_b_false : bool v62.
-
-Lemma orb_false_b : (b:bool)(orb false b)=b.
-Proof.
-  NewDestruct b; Trivial with bool.
-Qed.
-Hints Resolve orb_false_b : bool v62.
-
-Lemma orb_false_elim : 
-    (b1,b2:bool)(orb b1 b2)=false -> (b1=false)/\(b2=false).
-Proof.
-  NewDestruct b1.
-  Intros; Elim diff_true_false; Auto with bool.
-  NewDestruct b2.
-  Intros; Elim diff_true_false; Auto with bool.
-  Auto with bool.
-Qed.
-
-Lemma orb_neg_b :
-  (b:bool)(orb b (negb b))=true.
-Proof.
-  NewDestruct b; Reflexivity.
-Qed.
-Hints Resolve orb_neg_b : bool v62.
-
-Lemma orb_sym : (b1,b2:bool)(orb b1 b2)=(orb b2 b1).
-NewDestruct b1; NewDestruct b2; Reflexivity.
-Qed.
-
-Lemma orb_assoc : (b1,b2,b3:bool)(orb b1 (orb b2 b3))=(orb (orb b1 b2) b3).
-Proof.
-  NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
-Qed.
-
-Hints Resolve orb_sym orb_assoc orb_b_false orb_false_b : bool v62.
-
-(*****************************)
-(** A few lemmas about [and] *)
-(*****************************)
-
-Lemma andb_prop : 
-  (a,b:bool)(andb a b) = true -> (a = true)/\(b = true).
-
-Proof.
-  NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H);
-  Auto with bool.
-Qed.
-Hints Resolve andb_prop : bool v62.
-
-Definition andb_true_eq : (a,b:bool) true = (andb a b) -> true = a /\ true = b.
-Proof.
-  NewDestruct a; NewDestruct b; Auto.
-Defined.
-
-Lemma andb_prop2 : 
-  (a,b:bool)(Is_true (andb a b)) -> (Is_true a)/\(Is_true b).
-Proof.
-  NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H);
-  Auto with bool.
-Qed.
-Hints Resolve andb_prop2 : bool v62.
-
-Lemma andb_true_intro : (b1,b2:bool)(b1=true)/\(b2=true)->(andb b1 b2)=true.
-Proof.
-  NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
-Qed.
-Hints Resolve andb_true_intro : bool v62.
-
-Lemma andb_true_intro2 : 
-  (b1,b2:bool)(Is_true b1)->(Is_true b2)->(Is_true (andb b1 b2)).
-Proof.
-  NewDestruct b1; NewDestruct b2; Simpl; Tauto.
-Qed.
-Hints Resolve andb_true_intro2 : bool v62.
-
-Lemma andb_false_intro1 
-    : (b1,b2:bool)(b1=false)->(andb b1 b2)=false.
-NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
-Qed.
-
-Lemma andb_false_intro2 
-    : (b1,b2:bool)(b2=false)->(andb b1 b2)=false.
-NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
-Qed.
-
-Lemma andb_b_false : (b:bool)(andb b false)=false.
-NewDestruct b; Auto with bool.
-Qed.
-
-Lemma andb_false_b : (b:bool)(andb false b)=false.
-Trivial with bool.
-Qed.
-
-Lemma andb_b_true : (b:bool)(andb b true)=b.
-NewDestruct b; Auto with bool.
-Qed.
-
-Lemma andb_true_b : (b:bool)(andb true b)=b.
-Trivial with bool.
-Qed.
-
-Definition andb_false_elim : 
-    (b1,b2:bool)(andb b1 b2)=false -> {b1=false}+{b2=false}.
-NewDestruct b1; Simpl; Auto with bool.
-Defined.
-Hints Resolve andb_false_elim : bool v62.
-
-Lemma andb_neg_b :
-   (b:bool)(andb b (negb b))=false.
-NewDestruct b; Reflexivity.
-Qed.   
-Hints Resolve andb_neg_b : bool v62.
-
-Lemma andb_sym : (b1,b2:bool)(andb b1 b2)=(andb b2 b1).
-NewDestruct b1; NewDestruct b2; Reflexivity.
-Qed.
-
-Lemma andb_assoc : (b1,b2,b3:bool)(andb b1 (andb b2 b3))=(andb (andb b1 b2) b3).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
-Qed.
-
-Hints Resolve andb_sym andb_assoc : bool v62.
-
-(*******************************)
-(** Properties of [xorb]       *)
-(*******************************)
-
-Lemma xorb_false : (b:bool) (xorb b false)=b.
-Proof.
-  NewDestruct b; Trivial.
-Qed.
-
-Lemma false_xorb : (b:bool) (xorb false b)=b.
-Proof.
-  NewDestruct b; Trivial.
-Qed.
-
-Lemma xorb_true : (b:bool) (xorb b true)=(negb b).
-Proof.
-  Trivial.
-Qed.
-
-Lemma true_xorb : (b:bool) (xorb true b)=(negb b).
-Proof.
-  NewDestruct b; Trivial.
-Qed.
-
-Lemma xorb_nilpotent : (b:bool) (xorb b b)=false.
-Proof.
-  NewDestruct b; Trivial.
-Qed.
-
-Lemma xorb_comm : (b,b':bool) (xorb b b')=(xorb b' b).
-Proof.
-  NewDestruct b; NewDestruct b'; Trivial.
-Qed.
-
-Lemma xorb_assoc : (b,b',b'':bool) (xorb (xorb b b') b'')=(xorb b (xorb b' b'')).
-Proof.
-  NewDestruct b; NewDestruct b'; NewDestruct b''; Trivial.
-Qed.
-
-Lemma xorb_eq : (b,b':bool) (xorb b b')=false -> b=b'.
-Proof.
-  NewDestruct b; NewDestruct b'; Trivial.
-  Unfold xorb. Intros. Rewrite H. Reflexivity.
-Qed.
-
-Lemma xorb_move_l_r_1 : (b,b',b'':bool) (xorb b b')=b'' -> b'=(xorb b b'').
-Proof.
-  Intros. Rewrite <- (false_xorb b'). Rewrite <- (xorb_nilpotent b). Rewrite xorb_assoc.
-  Rewrite H. Reflexivity.
-Qed.
-
-Lemma xorb_move_l_r_2 : (b,b',b'':bool) (xorb b b')=b'' -> b=(xorb b'' b').
-Proof.
-  Intros. Rewrite xorb_comm in H. Rewrite (xorb_move_l_r_1 b' b b'' H). Apply xorb_comm.
-Qed.
-
-Lemma xorb_move_r_l_1 : (b,b',b'':bool) b=(xorb b' b'') -> (xorb b' b)=b''.
-Proof.
-  Intros. Rewrite H. Rewrite <- xorb_assoc. Rewrite xorb_nilpotent. Apply false_xorb.
-Qed.
-
-Lemma xorb_move_r_l_2 : (b,b',b'':bool) b=(xorb b' b'') -> (xorb b b'')=b'.
-Proof.
-  Intros. Rewrite H. Rewrite xorb_assoc. Rewrite xorb_nilpotent. Apply xorb_false.
-Qed.
-
-(*******************************)
-(** De Morgan's law            *)
-(*******************************)
-
-Lemma demorgan1 : (b1,b2,b3:bool)
-  (andb b1 (orb b2 b3)) = (orb (andb b1 b2) (andb b1 b3)).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
-Qed.
-
-Lemma demorgan2 : (b1,b2,b3:bool)
-  (andb (orb b1 b2) b3) = (orb (andb b1 b3) (andb b2 b3)).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
-Qed.
-
-Lemma demorgan3 : (b1,b2,b3:bool)
-  (orb b1 (andb b2 b3)) = (andb (orb b1 b2) (orb b1 b3)).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
-Qed.
-
-Lemma demorgan4 : (b1,b2,b3:bool)
-  (orb (andb b1 b2) b3) = (andb (orb b1 b3) (orb b2 b3)).
-NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
-Qed.
-
-Lemma absoption_andb : (b1,b2:bool)
-  (andb b1 (orb b1 b2)) = b1.
-Proof.
-  NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
-Qed.
-
-Lemma absoption_orb : (b1,b2:bool)
-  (orb b1 (andb b1 b2)) = b1.
-Proof.
-  NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
-Qed.
-
-
-(** Misc. equalities between booleans (to be used by Auto) *)
-
-Lemma bool_1 : (b1,b2:bool)(b1=true <-> b2=true) -> b1=b2. 
-Proof. 
- Intros b1 b2; Case b1; Case b2; Intuition.
-Qed.
-
-Lemma bool_2 : (b1,b2:bool)b1=b2 -> b1=true -> b2=true.
-Proof. 
- Intros b1 b2; Case b1; Case b2; Intuition.
-Qed. 
-
-Lemma bool_3 : (b:bool) ~(negb b)=true -> b=true.
-Proof.
-  NewDestruct b; Intuition.
-Qed.
-
-Lemma bool_4 : (b:bool) b=true -> ~(negb b)=true.  
-Proof.
-  NewDestruct b; Intuition.
-Qed.
-
-Lemma bool_5 : (b:bool) (negb b)=true -> ~b=true.
-Proof.
-  NewDestruct b; Intuition.
-Qed.
-
-Lemma bool_6 : (b:bool) ~b=true -> (negb b)=true.  
-Proof.
-  NewDestruct b; Intuition.
-Qed.
-
-Hints Resolve bool_1 bool_2 bool_3 bool_4 bool_5 bool_6.
diff --git a/theories7/Bool/BoolEq.v b/theories7/Bool/BoolEq.v
deleted file mode 100644
index b670dbdd..00000000
--- a/theories7/Bool/BoolEq.v
+++ /dev/null
@@ -1,72 +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: BoolEq.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-(* Cuihtlauac Alvarado - octobre 2000 *)
-
-(** Properties of a boolean equality   *)
-
-
-Require Export Bool.
-
-Section Bool_eq_dec.
-
-  Variable A : Set.
-
-  Variable beq : A -> A -> bool.
-
-  Variable beq_refl : (x:A)true=(beq x x).
-
-  Variable beq_eq : (x,y:A)true=(beq x y)->x=y.
-
-  Definition beq_eq_true : (x,y:A)x=y->true=(beq x y).
-  Proof.
-    Intros x y H.
-    Case H.
-    Apply beq_refl.
-  Defined.
-
-  Definition beq_eq_not_false : (x,y:A)x=y->~false=(beq x y).
-  Proof.
-    Intros x y e.
-    Rewrite <- beq_eq_true; Trivial; Discriminate.
-  Defined.
-
-  Definition beq_false_not_eq : (x,y:A)false=(beq x y)->~x=y.
-  Proof.
-    Exact [x,y:A; H:(false=(beq x y)); e:(x=y)](beq_eq_not_false x y e H).
-  Defined.
-
-  Definition exists_beq_eq : (x,y:A){b:bool | b=(beq x y)}.
-  Proof.
-    Intros.
-    Exists (beq x y).
-    Constructor.
-  Defined.
-
-  Definition not_eq_false_beq : (x,y:A)~x=y->false=(beq x y).
-  Proof.
-    Intros x y H.
-    Symmetry.
-    Apply not_true_is_false.
-    Intro.
-    Apply H.
-    Apply beq_eq.
-    Symmetry.
-    Assumption.
-  Defined.
-
-  Definition eq_dec : (x,y:A){x=y}+{~x=y}.
-  Proof.
-    Intros x y; Case (exists_beq_eq x y).
-    Intros b; Case b; Intro H.
-      Left; Apply beq_eq; Assumption.
-      Right; Apply beq_false_not_eq; Assumption.
-  Defined.
-
-End Bool_eq_dec.
diff --git a/theories7/Bool/Bvector.v b/theories7/Bool/Bvector.v
deleted file mode 100644
index e6545381..00000000
--- a/theories7/Bool/Bvector.v
+++ /dev/null
@@ -1,266 +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: Bvector.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-(** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *)
-
-Require Export Bool.
-Require Export Sumbool.
-Require Arith.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-(*  
-On s'inspire de PolyList pour fabriquer les vecteurs de bits.
-La dimension du vecteur est un paramètre trop important pour
-se contenter de la fonction "length".
-La première idée est de faire un record avec la liste et la longueur.
-Malheureusement, cette verification a posteriori amene a faire
-de nombreux lemmes pour gerer les longueurs.
-La seconde idée est de faire un type dépendant dans lequel la
-longueur est un paramètre de construction. Cela complique un
-peu les inductions structurelles, la solution qui a ma préférence
-est alors d'utiliser un terme de preuve comme définition.
-
-(En effet une définition comme :
-Fixpoint Vunaire [n:nat; v:(vector n)]: (vector n) :=
-Cases v of
-	| Vnil => Vnil
-	| (Vcons a p v') => (Vcons (f a) p (Vunaire p v'))
-end.
-provoque ce message d'erreur :
-Coq < Error: Inference of annotation not yet implemented in this case).
-
-
-	Inductive list [A : Set]  : Set :=
-		nil : (list A) | cons : A->(list A)->(list A).
-	head = [A:Set; l:(list A)] Cases l of
-			| nil => Error
- 			| (cons x _) => (Value x)
- 			end
-     		: (A:Set)(list A)->(option A).
-	tail = [A:Set; l:(list A)]Cases l of
-                   			| nil => (nil A)
-                   			| (cons _ m) => m
-                   			end
-     		: (A:Set)(list A)->(list A).
-	length = [A:Set] Fix length {length [l:(list A)] : nat :=
-      		Cases l of
-       			| nil => O
-      			| (cons _ m) => (S (length m))
-      		end}
-     		: (A:Set)(list A)->nat.
-	map = [A,B:Set; f:(A->B)] Fix map {map [l:(list A)] : (list B) :=
-		Cases l of
-			| nil => (nil B)
-			| (cons a t) => (cons (f a) (map t))
-		end}
-		: (A,B:Set)(A->B)->(list A)->(list B)
-*)
-
-Section VECTORS.
-
-(* 
-Un vecteur est une liste de taille n d'éléments d'un ensemble A.
-Si la taille est non nulle, on peut extraire la première composante et 
-le reste du vecteur, la dernière composante ou rajouter ou enlever 
-une composante (carry) ou repeter la dernière composante en fin de vecteur.
-On peut aussi tronquer le vecteur de ses p dernières composantes ou
-au contraire l'étendre (concaténer) d'un vecteur de longueur p.
-Une fonction unaire sur A génère une fonction des vecteurs de taille n
-dans les vecteurs de taille n en appliquant f terme à terme.
-Une fonction binaire sur A génère une fonction des couple de vecteurs 
-de taille n dans les vecteurs de taille n en appliquant f terme à terme.
-*)
-
-Variable A : Set.
-
-Inductive vector: nat -> Set :=
-	| Vnil : (vector O)
-	| Vcons  : (a:A) (n:nat) (vector n) -> (vector (S n)).
-
-Definition Vhead : (n:nat) (vector (S n)) -> A.
-Proof.
-	Intros n v; Inversion v; Exact a.
-Defined.
-
-Definition Vtail : (n:nat) (vector (S n)) -> (vector n).
-Proof.
-	Intros n v; Inversion v; Exact H0.
-Defined.
-
-Definition Vlast : (n:nat) (vector (S n)) -> A.
-Proof.
-	NewInduction n as [|n f]; Intro v.
-	Inversion v.
-	Exact a.
-
-	Inversion v.
-	Exact (f H0).
-Defined.
-
-Definition Vconst : (a:A) (n:nat) (vector n).
-Proof.
-	NewInduction n as [|n v].
-	Exact Vnil.
-
-	Exact (Vcons a n v).
-Defined.
-
-Lemma Vshiftout : (n:nat) (vector (S n)) -> (vector n).
-Proof.
-	NewInduction n as [|n f]; Intro v.
-	Exact Vnil.
-
-	Inversion v.
-	Exact (Vcons a n (f H0)).
-Defined.
-
-Lemma Vshiftin : (n:nat) A -> (vector n) -> (vector (S n)).
-Proof.
-	NewInduction n as [|n f]; Intros a v.
-	Exact (Vcons a O v).
-
-	Inversion v.
-	Exact (Vcons a (S n) (f a H0)).
-Defined.
-
-Lemma Vshiftrepeat : (n:nat) (vector (S n)) -> (vector (S (S n))).
-Proof.
-	NewInduction n as [|n f]; Intro v.
-	Inversion v.
-	Exact (Vcons a (1) v).
-
-	Inversion v.
-	Exact (Vcons a (S (S n)) (f H0)).
-Defined.
-
-(*
-Lemma S_minus_S : (n,p:nat) (gt n (S p)) -> (S (minus n (S p)))=(minus n p).
-Proof.
-  Intros.
-Save.
-*)
-
-Lemma Vtrunc : (n,p:nat) (gt n p) ->  (vector n) -> (vector (minus n p)).
-Proof.
-	NewInduction p as [|p f]; Intros H v.
-	Rewrite <- minus_n_O.
-	Exact v.
-
-	Apply (Vshiftout (minus n (S p))).
-
-Rewrite minus_Sn_m.
-Apply f.
-Auto with *.
-Exact v.
-Auto with *.
-Defined.
-
-Lemma Vextend : (n,p:nat) (vector n) ->  (vector p) -> (vector (plus n p)).
-Proof.
-	NewInduction n as [|n f]; Intros p v v0.
-	Simpl; Exact v0.
-
-	Inversion v.
-	Simpl; Exact (Vcons a (plus n p) (f p H0 v0)).
-Defined.
-
-Variable f : A -> A.
-
-Lemma Vunary : (n:nat)(vector n)->(vector n).
-Proof.
-	NewInduction n as [|n g]; Intro v.
-	Exact Vnil.
-
-	Inversion v.
-	Exact (Vcons (f a) n (g H0)).
-Defined.
-
-Variable g : A -> A -> A.
-
-Lemma Vbinary : (n:nat)(vector n)->(vector n)->(vector n).
-Proof.
-	NewInduction n as [|n h]; Intros v v0.
-	Exact Vnil.
-
-	Inversion v; Inversion v0.
-	Exact (Vcons (g a a0) n (h H0 H2)).
-Defined.
-
-End VECTORS.
-
-Section BOOLEAN_VECTORS.
-
-(* 
-Un vecteur de bits est un vecteur sur l'ensemble des booléens de longueur fixe. 
-ATTENTION : le stockage s'effectue poids FAIBLE en tête.
-On en extrait le bit  de poids faible (head) et la fin du vecteur (tail).
-On calcule la négation d'un vecteur, le et, le ou et le xor bit à bit de 2 vecteurs.
-On calcule les décalages d'une position vers la gauche (vers les poids forts, on
-utilise donc Vshiftout, vers la droite (vers les poids faibles, on utilise Vshiftin) en 
-insérant un bit 'carry' (logique) ou en répétant le bit de poids fort (arithmétique).
-ATTENTION : Tous les décalages prennent la taille moins un comme paramètre
-(ils ne travaillent que sur des vecteurs au moins de longueur un).
-*)
-
-Definition Bvector := (vector bool).
-
-Definition Bnil := (Vnil bool).
-
-Definition Bcons := (Vcons bool).
-
-Definition Bvect_true := (Vconst bool true).
-
-Definition Bvect_false := (Vconst bool false).
-
-Definition Blow := (Vhead bool).
-
-Definition Bhigh := (Vtail bool).
-
-Definition Bsign := (Vlast bool).
-
-Definition Bneg := (Vunary bool negb).
-
-Definition BVand := (Vbinary bool andb).
-
-Definition BVor := (Vbinary bool orb).
-
-Definition BVxor := (Vbinary bool xorb).
-
-Definition BshiftL := [n:nat; bv : (Bvector (S n)); carry:bool] 
-	(Bcons carry n (Vshiftout bool n bv)).
-
-Definition BshiftRl := [n:nat; bv : (Bvector (S n)); carry:bool] 
-	(Bhigh (S n) (Vshiftin bool (S n) carry bv)).
-
-Definition BshiftRa := [n:nat; bv : (Bvector (S n))] 
-	(Bhigh (S n) (Vshiftrepeat bool n bv)).
-
-Fixpoint BshiftL_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
-Cases p of
-	| O => bv
-	| (S p') => (BshiftL n (BshiftL_iter n bv p') false)
-end.
-
-Fixpoint BshiftRl_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
-Cases p of
-	| O => bv
-	| (S p') => (BshiftRl n (BshiftRl_iter n bv p') false)
-end.
-
-Fixpoint BshiftRa_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
-Cases p of
-	| O => bv
-	| (S p') => (BshiftRa n (BshiftRa_iter n bv p'))
-end.
-
-End BOOLEAN_VECTORS.
-
diff --git a/theories7/Bool/IfProp.v b/theories7/Bool/IfProp.v
deleted file mode 100755
index bcfa4be3..00000000
--- a/theories7/Bool/IfProp.v
+++ /dev/null
@@ -1,49 +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: IfProp.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-Require Bool.
-
-Inductive IfProp [A,B:Prop] : bool-> Prop 
-  := Iftrue  : A -> (IfProp A B true)
-  |  Iffalse : B -> (IfProp A B false).
-
-Hints Resolve Iftrue Iffalse : bool v62.
-
-Lemma Iftrue_inv : (A,B:Prop)(b:bool) (IfProp A B b) -> b=true -> A.
-NewDestruct 1; Intros; Auto with bool.
-Case diff_true_false; Auto with bool.
-Qed.
-
-Lemma Iffalse_inv : (A,B:Prop)(b:bool) (IfProp A B b) -> b=false -> B.
-NewDestruct 1; Intros; Auto with bool.
-Case diff_true_false; Trivial with bool.
-Qed.
-
-Lemma IfProp_true : (A,B:Prop)(IfProp A B true) -> A.
-Intros.
-Inversion H.
-Assumption.
-Qed.
-
-Lemma IfProp_false : (A,B:Prop)(IfProp A B false) -> B.
-Intros.
-Inversion H.
-Assumption.
-Qed.
-
-Lemma IfProp_or : (A,B:Prop)(b:bool)(IfProp A B b) -> A\/B.
-NewDestruct 1; Auto with bool.
-Qed.
-
-Lemma IfProp_sum : (A,B:Prop)(b:bool)(IfProp A B b) -> {A}+{B}.
-NewDestruct b; Intro H.
-Left; Inversion H; Auto with bool.
-Right; Inversion H; Auto with bool.
-Qed.
diff --git a/theories7/Bool/Sumbool.v b/theories7/Bool/Sumbool.v
deleted file mode 100644
index 8d55cbb6..00000000
--- a/theories7/Bool/Sumbool.v
+++ /dev/null
@@ -1,77 +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: Sumbool.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-(** Here are collected some results about the type sumbool (see INIT/Specif.v)
-   [sumbool A B], which is written [{A}+{B}], is the informative
-   disjunction "A or B", where A and B are logical propositions.
-   Its extraction is isomorphic to the type of booleans. *)
-
-(** A boolean is either [true] or [false], and this is decidable *)
-
-Definition sumbool_of_bool : (b:bool) {b=true}+{b=false}.
-Proof.
-  NewDestruct b; Auto.
-Defined.
-
-Hints Resolve sumbool_of_bool : bool.
-
-Definition bool_eq_rec : (b:bool)(P:bool->Set)
-                    ((b=true)->(P true))->((b=false)->(P false))->(P b).
-NewDestruct b; Auto.
-Defined.
-
-Definition bool_eq_ind : (b:bool)(P:bool->Prop)
-                    ((b=true)->(P true))->((b=false)->(P false))->(P b).
-NewDestruct b; Auto.
-Defined.
-
-
-(*i pourquoi ce machin-la est dans BOOL et pas dans LOGIC ?  Papageno i*)
-
-(** Logic connectives on type [sumbool] *)
-
-Section connectives.
-
-Variables A,B,C,D : Prop.
-
-Hypothesis H1 : {A}+{B}.
-Hypothesis H2 : {C}+{D}.
-
-Definition sumbool_and : {A/\C}+{B\/D}.
-Proof.
-Case H1; Case H2; Auto.
-Defined.
-
-Definition sumbool_or : {A\/C}+{B/\D}.
-Proof.
-Case H1; Case H2; Auto.
-Defined.
-
-Definition sumbool_not : {B}+{A}.
-Proof.
-Case H1; Auto.
-Defined.
-
-End connectives.
-
-Hints Resolve sumbool_and sumbool_or sumbool_not : core.
-
-
-(** Any decidability function in type [sumbool] can be turned into a function
-    returning a boolean with the corresponding specification: *)
-
-Definition bool_of_sumbool : 
-  (A,B:Prop) {A}+{B} -> { b:bool | if b then A else B }.
-Proof.
-Intros A B H.
-Elim H; [ Intro; Exists true; Assumption
-        | Intro; Exists false; Assumption ].
-Defined.
-Implicits bool_of_sumbool.
diff --git a/theories7/Bool/Zerob.v b/theories7/Bool/Zerob.v
deleted file mode 100755
index 24e48c28..00000000
--- a/theories7/Bool/Zerob.v
+++ /dev/null
@@ -1,36 +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: Zerob.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
-
-Require Arith.
-Require Bool.
-
-V7only [Import nat_scope.].
-Open Local Scope nat_scope.
-
-Definition zerob : nat->bool 
-      := [n:nat]Cases n of O => true | (S _) => false end.
-
-Lemma zerob_true_intro : (n:nat)(n=O)->(zerob n)=true.
-NewDestruct n; [Trivial with bool | Inversion 1].
-Qed.
-Hints Resolve zerob_true_intro : bool.
-
-Lemma zerob_true_elim : (n:nat)(zerob n)=true->(n=O).
-NewDestruct n; [Trivial with bool | Inversion 1].
-Qed.
-
-Lemma zerob_false_intro : (n:nat)~(n=O)->(zerob n)=false.
-NewDestruct n; [NewDestruct 1; Auto with bool | Trivial with bool].
-Qed.
-Hints Resolve zerob_false_intro : bool.
-
-Lemma zerob_false_elim : (n:nat)(zerob n)=false -> ~(n=O).
-NewDestruct n; [Intro H; Inversion H | Auto with bool].
-Qed.
diff --git a/theories7/Init/Datatypes.v b/theories7/Init/Datatypes.v
deleted file mode 100755
index 006ec08e..00000000
--- a/theories7/Init/Datatypes.v
+++ /dev/null
@@ -1,125 +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: Datatypes.v,v 1.3.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
-
-Require Notations.
-Require Logic.
-
-Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
-
-(** [unit] is a singleton datatype with sole inhabitant [tt] *)
-
-Inductive unit : Set := tt : unit.
-
-(** [bool] is the datatype of the booleans values [true] and [false] *)
-
-Inductive bool : Set := true : bool 
-                      | false : bool.
-
-Add Printing If bool.
-
-(** [nat] is the datatype of natural numbers built from [O] and successor [S];
-    note that zero is the letter O, not the numeral 0 *)
-
-Inductive nat : Set := O : nat 
-                     | S : nat->nat.
-
-Delimits Scope nat_scope with nat.
-Bind Scope nat_scope with nat.
-Arguments Scope S [ nat_scope ].
-
-(** [Empty_set] has no inhabitant *)
-
-Inductive Empty_set:Set :=.
-
-(** [identity A a] is the family of datatypes on [A] whose sole non-empty
-    member is the singleton datatype [identity A a a] whose
-    sole inhabitant is denoted [refl_identity A a] *)
-
-Inductive identity [A:Type; a:A] : A->Set :=
-     refl_identity: (identity A a a).
-Hints Resolve refl_identity : core v62.
-
-Implicits identity_ind [1].
-Implicits identity_rec [1].
-Implicits identity_rect [1].
-V7only [
-Implicits identity_ind [].
-Implicits identity_rec [].
-Implicits identity_rect [].
-].
-
-(** [option A] is the extension of A with a dummy element None *)
-
-Inductive option [A:Set] : Set := Some : A -> (option A) | None : (option A).
-
-Implicits None [1].
-V7only [Implicits None [].].
-
-(** [sum A B], equivalently [A + B], is the disjoint sum of [A] and [B] *)
-(* Syntax defined in Specif.v *)
-Inductive sum [A,B:Set] : Set
-    := inl : A -> (sum A B)
-     | inr : B -> (sum A B).
-
-Notation "x + y" := (sum x y) : type_scope.
-
-(** [prod A B], written [A * B], is the product of [A] and [B];
-    the pair [pair A B a b] of [a] and [b] is abbreviated [(a,b)] *)
-
-Inductive prod [A,B:Set] : Set := pair : A -> B -> (prod A B).
-Add Printing Let prod.
-
-Notation "x * y" := (prod x y) : type_scope.
-V7only [Notation "( x , y )" := (pair ? ? x y) : core_scope.].
-V8Notation "( x , y , .. , z )" := (pair ? ? .. (pair ? ? x y) .. z) : core_scope.
-
-Section projections.
-   Variables A,B:Set.
-   Definition fst := [p:(prod A B)]Cases p of (pair x y) => x end.
-   Definition snd := [p:(prod A B)]Cases p of (pair x y) => y end.
-End projections. 
-
-V7only [
-Notation Fst := (fst ? ?).
-Notation Snd := (snd ? ?).
-].
-Hints Resolve pair inl inr : core v62.
-
-Lemma surjective_pairing : (A,B:Set;p:A*B)p=(pair A B (Fst p) (Snd p)).
-Proof.
-NewDestruct p; Reflexivity.
-Qed.
-
-Lemma injective_projections : 
- (A,B:Set;p1,p2:A*B)(Fst p1)=(Fst p2)->(Snd p1)=(Snd p2)->p1=p2.
-Proof.
-NewDestruct p1; NewDestruct p2; Simpl; Intros Hfst Hsnd.
-Rewrite Hfst; Rewrite Hsnd; Reflexivity. 
-Qed.
-
-V7only[
-(** Parsing only of things in [Datatypes.v] *)
-Notation "< A , B > ( x , y )" := (pair A B x y) (at level 1, only parsing, A annot).
-Notation "< A , B > 'Fst' ( p )" := (fst A B p) (at level 1, only parsing, A annot).
-Notation "< A , B > 'Snd' ( p )" := (snd A B p) (at level 1, only parsing, A annot).
-].
-
-(** Comparison *)
-
-Inductive relation : Set := 
-  EGAL :relation | INFERIEUR : relation | SUPERIEUR : relation.
-
-Definition Op := [r:relation]
-  Cases r of
-    EGAL => EGAL
-  | INFERIEUR => SUPERIEUR
-  | SUPERIEUR => INFERIEUR
-  end.
diff --git a/theories7/Init/Logic.v b/theories7/Init/Logic.v
deleted file mode 100755
index 6ba9c7a1..00000000
--- a/theories7/Init/Logic.v
+++ /dev/null
@@ -1,306 +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: Logic.v,v 1.6.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
-
-Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
-
-Require Notations.
-
-(** [True] is the always true proposition *)
-Inductive True : Prop := I : True. 
-
-(** [False] is the always false proposition *)
-Inductive False : Prop := . 
-
-(** [not A], written [~A], is the negation of [A] *)
-Definition not := [A:Prop]A->False.
-
-Notation "~ x" := (not x) : type_scope.
-
-Hints Unfold not : core.
-
-Inductive and [A,B:Prop] : Prop := conj : A -> B -> A /\ B
-
-where "A /\ B" := (and A B) : type_scope.
-
-V7only[
-Notation "< P , Q > { p , q }" := (conj P Q p q) (P annot, at level 1).
-].
-
-Section Conjunction.
-
-  (** [and A B], written [A /\ B], is the conjunction of [A] and [B]
-
-      [conj A B p q], written [<p,q>] is a proof of [A /\ B] as soon as 
-      [p] is a proof of [A] and [q] a proof of [B]
-
-      [proj1] and [proj2] are first and second projections of a conjunction *)
-
-  Variables A,B : Prop.
-
-  Theorem proj1 : (and A B) -> A.
-  Proof.
-  NewDestruct 1; Trivial.
-  Qed.
-
-  Theorem proj2 : (and A B) -> B.
-  Proof.
-  NewDestruct 1; Trivial.
-  Qed.
-
-End Conjunction.
-
-(** [or A B], written [A \/ B], is the disjunction of [A] and [B] *)
-
-Inductive or [A,B:Prop] : Prop :=
-     or_introl : A -> A \/ B 
-   | or_intror : B -> A \/ B
-
-where "A \/ B" := (or A B) : type_scope.
-
-(** [iff A B], written [A <-> B], expresses the equivalence of [A] and [B] *)
-
-Definition iff := [A,B:Prop] (and (A->B) (B->A)).
-
-Notation "A <-> B" := (iff A B) : type_scope.
-
-Section Equivalence.
-
-Theorem iff_refl : (A:Prop) (iff A A).
-  Proof.
-    Split; Auto.
-  Qed.
-
-Theorem iff_trans : (a,b,c:Prop) (iff a b) -> (iff b c) -> (iff a c).
-  Proof.
-    Intros A B C (H1,H2) (H3,H4); Split; Auto.
-  Qed.
-
-Theorem iff_sym : (A,B:Prop) (iff A B) -> (iff B A).
-  Proof.
-    Intros A B (H1,H2); Split; Auto.
-  Qed.
-
-End Equivalence.
-
-(** [(IF P Q R)], or more suggestively [(either P and_then Q or_else R)],
-    denotes either [P] and [Q], or [~P] and [Q] *)
-Definition IF_then_else := [P,Q,R:Prop] (or (and P Q) (and (not P) R)).
-V7only [Notation IF:=IF_then_else.].
-
-Notation "'IF' c1 'then' c2 'else' c3" := (IF c1 c2 c3)
-  (at level 1, c1, c2, c3 at level 8) : type_scope
-  V8only (at level 200).
-
-(** First-order quantifiers *)
-
-  (** [ex A P], or simply [exists x, P x], expresses the existence of an 
-      [x] of type [A] which satisfies the predicate [P] ([A] is of type 
-      [Set]). This is existential quantification. *)
-
-  (** [ex2 A P Q], or simply [exists2 x, P x & Q x], expresses the
-      existence of an [x] of type [A] which satisfies both the predicates
-      [P] and [Q] *)
-
-  (** Universal quantification (especially first-order one) is normally 
-      written [forall x:A, P x]. For duality with existential quantification, 
-      the construction [all P] is provided too *)
-
-Inductive ex [A:Type;P:A->Prop] : Prop 
-    := ex_intro : (x:A)(P x)->(ex A P).
-
-Inductive ex2 [A:Type;P,Q:A->Prop] : Prop
-    := ex_intro2 : (x:A)(P x)->(Q x)->(ex2 A P Q).
-
-Definition all := [A:Type][P:A->Prop](x:A)(P x). 
-
-(* Rule order is important to give printing priority to fully typed exists *)
-
-V7only [ Notation Ex  := (ex ?). ].
-Notation "'EX' x | p"      := (ex ? [x]p)
-  (at level 10, p at level 8) : type_scope
-  V8only "'exists' x , p" (at level 200, x ident, p at level 99).
-Notation "'EX' x : t | p"  := (ex ? [x:t]p)
-  (at level 10, p at level 8) : type_scope
-  V8only "'exists' x : t , p" (at level 200, x ident, p at level 99, format
-  "'exists'  '/  ' x  :  t ,  '/  ' p").
-
-V7only [ Notation Ex2 := (ex2 ?). ].
-Notation "'EX' x | p & q"       := (ex2 ? [x]p [x]q)
-  (at level 10, p, q at level 8) : type_scope
-  V8only "'exists2' x , p & q" (at level 200, x ident, p, q at level 99).
-Notation "'EX' x : t | p & q"   := (ex2 ? [x:t]p [x:t]q)
-  (at level 10, p, q at level 8) : type_scope
-  V8only "'exists2' x : t , p & q"
-    (at level 200, x ident, t at level 200, p, q at level 99, format
-    "'exists2'  '/  ' x  :  t ,  '/  ' '[' p  &  '/' q ']'").
-
-V7only [Notation All := (all ?).
-Notation "'ALL' x | p"     := (all ? [x]p)
-  (at level 10, p at level 8) : type_scope
-  V8only (at level 200, x ident, p at level 200).
-Notation "'ALL' x : t | p" := (all ? [x:t]p)
-  (at level 10, p at level 8) : type_scope
-  V8only (at level 200, x ident, t, p at level 200).
-].
-
-(** Universal quantification *)
-
-Section universal_quantification.
-
-  Variable A : Type.
-  Variable P : A->Prop.
-
-  Theorem inst : (x:A)(all ? [x](P x))->(P x).
-  Proof.
-  Unfold all; Auto.
-  Qed.
-
-  Theorem gen : (B:Prop)(f:(y:A)B->(P y))B->(all A P).
-  Proof.
-  Red; Auto.
-  Qed.
-
-  End universal_quantification.
-
-(** Equality *)
-
-(** [eq A x y], or simply [x=y], expresses the (Leibniz') equality
-    of [x] and [y]. Both [x] and [y] must belong to the same type [A].
-    The definition is inductive and states the reflexivity of the equality.
-    The others properties (symmetry, transitivity, replacement of 
-    equals) are proved below *)
-
-Inductive eq [A:Type;x:A] : A->Prop
-       := refl_equal : x = x :> A
-
-where "x = y :> A" := (!eq A x y) : type_scope.
-
-Notation "x = y" := (eq ? x y) : type_scope.
-Notation "x <> y  :> T" := ~ (!eq T x y) : type_scope.
-Notation "x <> y" := ~ x=y : type_scope.
-
-Implicits eq_ind [1].
-Implicits eq_rec [1].
-Implicits eq_rect [1].
-V7only [
-Implicits eq_ind [].
-Implicits eq_rec [].
-Implicits eq_rect [].
-].
-
-Hints Resolve I conj or_introl or_intror refl_equal : core v62.
-Hints Resolve ex_intro ex_intro2 : core v62.
-
-Section Logic_lemmas.
-
-  Theorem absurd : (A:Prop)(C:Prop) A -> (not A) -> C.
-  Proof.
-    Unfold not; Intros A C h1 h2.
-    NewDestruct (h2 h1).
-  Qed.
-
-  Section equality.
-    Variable A,B : Type.
-    Variable f   : A->B.
-    Variable x,y,z : A.
-
-    Theorem sym_eq : (eq ? x y) -> (eq ? y x).
-    Proof.
-     NewDestruct 1; Trivial.
-    Defined.
-    Opaque sym_eq.
-
-    Theorem trans_eq : (eq ? x y) -> (eq ? y z) -> (eq ? x z).
-    Proof.
-     NewDestruct 2; Trivial.
-    Defined.
-    Opaque trans_eq.
-
-    Theorem f_equal : (eq ? x y) -> (eq ? (f x) (f y)).
-    Proof.
-     NewDestruct 1; Trivial.
-    Defined.
-    Opaque f_equal.
-
-    Theorem sym_not_eq : (not (eq ? x y)) -> (not (eq ? y x)).
-    Proof.
-     Red; Intros h1 h2; Apply h1; NewDestruct h2; Trivial.
-    Qed.
-
-    Definition sym_equal     := sym_eq.
-    Definition sym_not_equal := sym_not_eq.
-    Definition trans_equal   := trans_eq.
-
-  End equality.
-
-(* Is now a primitive principle 
-  Theorem eq_rect: (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eq ? x y)->(P y).
-  Proof.
-   Intros.
-   Cut (identity A x y).
-   NewDestruct 1; Auto.
-   NewDestruct H; Auto.
-  Qed.
-*)
-
-  Definition eq_ind_r : (A:Type)(x:A)(P:A->Prop)(P x)->(y:A)(eq ? y x)->(P y).
-   Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
-  Defined.
-
-  Definition eq_rec_r : (A:Type)(x:A)(P:A->Set)(P x)->(y:A)(eq ? y x)->(P y).
-    Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
-  Defined.
-
-  Definition eq_rect_r : (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eq ? y x)->(P y).
-    Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
-  Defined.
-End Logic_lemmas.
-
-Theorem f_equal2 : (A1,A2,B:Type)(f:A1->A2->B)(x1,y1:A1)(x2,y2:A2)
-  (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? (f x1 x2) (f y1 y2)).
-Proof.
-  NewDestruct 1; NewDestruct 1; Reflexivity.
-Qed.
-
-Theorem f_equal3 : (A1,A2,A3,B:Type)(f:A1->A2->A3->B)(x1,y1:A1)(x2,y2:A2)
-  (x3,y3:A3)(eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) 
-   -> (eq ? (f x1 x2 x3) (f y1 y2 y3)).
-Proof.
-  NewDestruct 1; NewDestruct 1; NewDestruct 1; Reflexivity.
-Qed.
-
-Theorem f_equal4 : (A1,A2,A3,A4,B:Type)(f:A1->A2->A3->A4->B)
-  (x1,y1:A1)(x2,y2:A2)(x3,y3:A3)(x4,y4:A4)
-  (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) -> (eq ? x4 y4)
-   -> (eq ? (f x1 x2 x3 x4) (f y1 y2 y3 y4)).
-Proof.
-  NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; Reflexivity.
-Qed.
-
-Theorem f_equal5 : (A1,A2,A3,A4,A5,B:Type)(f:A1->A2->A3->A4->A5->B)
-  (x1,y1:A1)(x2,y2:A2)(x3,y3:A3)(x4,y4:A4)(x5,y5:A5)
-  (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) -> (eq ? x4 y4) -> (eq ? x5 y5)
-    -> (eq ? (f x1 x2 x3 x4 x5) (f y1 y2 y3 y4 y5)).
-Proof.
-  NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1;
-  Reflexivity.
-Qed.
-
-Hints Immediate sym_eq sym_not_eq : core v62.
-
-V7only[
-(** Parsing only of things in [Logic.v] *)
-Notation "< A > 'All' ( P )" :=(all A P) (A annot, at level 1, only parsing).
-Notation "< A > x = y" := (eq A x y)
- (A annot, at level 1, x at level 0, only parsing).
-Notation "< A > x <> y" := ~(eq A x y)
-  (A annot, at level 1, x at level 0, only parsing).
-].
diff --git a/theories7/Init/Logic_Type.v b/theories7/Init/Logic_Type.v
deleted file mode 100755
index 793b671c..00000000
--- a/theories7/Init/Logic_Type.v
+++ /dev/null
@@ -1,304 +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: Logic_Type.v,v 1.3.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
-
-Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
-
-(** This module defines quantification on the world [Type]
-    ([Logic.v] was defining it on the world [Set]) *)
-
-Require Datatypes.
-Require Export Logic.
-
-V7only [
-(*
-(** [allT A P], or simply [(ALLT x | P(x))], stands for [(x:A)(P x)]
-   when [A] is of type [Type] *)
-
-Definition allT := [A:Type][P:A->Prop](x:A)(P x). 
-*)
-
-Notation allT := all (only parsing).
-Notation inst := Logic.inst (only parsing).
-Notation gen := Logic.gen (only parsing).
-
-(* Order is important to give printing priority to fully typed ALL and EX *)
-
-Notation AllT := (all ?).
-Notation "'ALLT' x | p"     := (all ? [x]p)   (at level 10, p at level 8).
-Notation "'ALLT' x : t | p" := (all ? [x:t]p) (at level 10, p at level 8).
-
-(*
-Section universal_quantification.
-
-Variable A : Type.
-Variable P : A->Prop.
-
-Theorem inst :  (x:A)(allT ? [x](P x))->(P x).
-Proof.
-Unfold all; Auto.
-Qed.
-
-Theorem gen : (B:Prop)(f:(y:A)B->(P y))B->(allT A P).
-Proof.
-Red; Auto.
-Qed.
-
-End universal_quantification.
-*)
-
-(*
-(** * Existential Quantification *)
-
-(** [exT A P], or simply [(EXT x | P(x))], stands for the existential 
-    quantification on the predicate [P] when [A] is of type [Type] *)
-
-(** [exT2 A P Q], or simply [(EXT x | P(x) & Q(x))], stands for the
-    existential quantification on both [P] and [Q] when [A] is of
-    type [Type] *)
-Inductive  exT [A:Type;P:A->Prop] : Prop
-    := exT_intro : (x:A)(P x)->(exT A P).
-*)
-
-Notation exT := ex (only parsing).
-Notation exT_intro := ex_intro (only parsing).
-Notation exT_ind  := ex_ind (only parsing).
-
-Notation ExT  := (ex ?).
-Notation "'EXT' x | p"      := (ex ? [x]p)
-  (at level 10, p at level 8, only parsing).
-Notation "'EXT' x : t | p"  := (ex ? [x:t]p)
-  (at level 10, p at level 8, only parsing).
-
-(*
-Inductive exT2 [A:Type;P,Q:A->Prop] : Prop
-    := exT_intro2 : (x:A)(P x)->(Q x)->(exT2 A P Q).
-*)
-
-Notation exT2 := ex2 (only parsing).
-Notation exT_intro2 := ex_intro2 (only parsing).
-Notation exT2_ind  := ex2_ind (only parsing).
-
-Notation ExT2 := (ex2 ?).
-Notation "'EXT' x | p & q"     := (ex2 ? [x]p [x]q)
-  (at level 10, p, q at level 8).
-Notation "'EXT' x : t | p & q" := (ex2 ? [x:t]p [x:t]q)
-  (at level 10, p, q at level 8).
-
-(*
-(** Leibniz equality : [A:Type][x,y:A] (P:A->Prop)(P x)->(P y)
-
-   [eqT A x y], or simply [x==y], is Leibniz' equality when [A] is of 
-   type [Type]. This equality satisfies reflexivity (by definition), 
-   symmetry, transitivity and stability by congruence *)
-
-
-Inductive eqT [A:Type;x:A] : A -> Prop
-                       := refl_eqT : (eqT A x x).
-
-Hints Resolve refl_eqT (* exT_intro2 exT_intro *) : core v62.
-*)
-
-Notation eqT      := eq (only parsing).
-Notation refl_eqT := refl_equal (only parsing).
-Notation eqT_ind  := eq_ind (only parsing).
-Notation eqT_rect := eq_rect (only parsing).
-Notation eqT_rec  := eq_rec (only parsing).
-
-Notation "x == y"  := (eq ? x y) (at level 5, no associativity, only parsing).
-
-(** Parsing only of things in [Logic_type.v] *)
-
-Notation "< A > x == y"  := (eq A x y)
-   (A annot, at level 1, x at level 0, only parsing).
-
-(*
-Section Equality_is_a_congruence.
-
- Variables A,B : Type.
- Variable  f : A->B.
-
- Variable x,y,z : A.
- 
- Lemma sym_eqT : (eqT ? x y) -> (eqT ? y x).
- Proof.
-  NewDestruct 1; Trivial.
- Qed.
-
- Lemma trans_eqT : (eqT ? x y) -> (eqT ? y z) -> (eqT ? x z).
- Proof.
-  NewDestruct 2; Trivial.
- Qed.
-
- Lemma congr_eqT : (eqT ? x y)->(eqT ? (f x) (f y)).
- Proof.
-  NewDestruct 1; Trivial.
- Qed.
-
- Lemma sym_not_eqT : ~(eqT ? x y) -> ~(eqT ? y x).
- Proof.
-  Red; Intros H H'; Apply H; NewDestruct H'; Trivial.
- Qed.
-
-End Equality_is_a_congruence.
-*)
-
-Notation sym_eqT  := sym_eq (only parsing).
-Notation trans_eqT  := trans_eq (only parsing).
-Notation congr_eqT  := f_equal (only parsing).
-Notation sym_not_eqT  := sym_not_eq (only parsing).
-
-(*
-Hints Immediate sym_eqT sym_not_eqT : core v62.
-*)
-
-(** This states the replacement of equals by equals *)
-
-(*
-Definition eqT_ind_r : (A:Type)(x:A)(P:A->Prop)(P x)->(y:A)(eqT ? y x)->(P y).
-Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
-Defined.
-
-Definition eqT_rec_r : (A:Type)(x:A)(P:A->Set)(P x)->(y:A)(eqT ? y x)->(P y).
-Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
-Defined.
-
-Definition eqT_rect_r : (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eqT ? y x)->(P y).
-Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
-Defined.
-*)
-
-Notation eqT_ind_r  := eq_ind_r (only parsing).
-Notation eqT_rec_r  := eq_rec_r (only parsing).
-Notation eqT_rect_r  := eq_rect_r (only parsing).
-
-(** Some datatypes at the [Type] level *)
-(*
-Inductive EmptyT: Type :=.
-Inductive UnitT : Type := IT : UnitT.
-*)
-
-Notation EmptyT := False (only parsing).
-Notation UnitT := unit (only parsing).
-Notation IT := tt.
-].
-Definition notT := [A:Type] A->EmptyT.
-
-V7only [
-(** Have you an idea of what means [identityT A a b]? No matter! *)
-
-(*
-Inductive identityT [A:Type; a:A] : A -> Type :=
-     refl_identityT : (identityT A a a).
-*)
-
-Notation identityT := identity (only parsing).
-Notation refl_identityT := refl_identity (only parsing).
-
-Notation "< A > x === y" := (!identityT A x y)
-   (A annot, at level 1, x at level 0, only parsing) : type_scope.
-
-Notation "x === y" := (identityT ? x y)
-  (at level 5, no associativity, only parsing) : type_scope.
-
-(*
-Hints Resolve refl_identityT : core v62.
-*)
-].
-Section identity_is_a_congruence.
-
- Variables A,B : Type.
- Variable  f : A->B.
-
- Variable x,y,z : A.
- 
- Lemma sym_id : (identityT ? x y) -> (identityT ? y x).
- Proof.
-  NewDestruct 1; Trivial.
- Qed.
-
- Lemma trans_id : (identityT ? x y) -> (identityT ? y z) -> (identityT ? x z).
- Proof.
-  NewDestruct 2; Trivial.
- Qed.
-
- Lemma congr_id : (identityT ? x y)->(identityT ? (f x) (f y)).
- Proof.
-  NewDestruct 1; Trivial.
- Qed.
-
- Lemma sym_not_id : (notT (identityT ? x y)) -> (notT (identityT ? y x)).
- Proof.
-  Red; Intros H H'; Apply H; NewDestruct H'; Trivial.
- Qed.
-
-End identity_is_a_congruence.
-
-Definition identity_ind_r :
-     (A:Type)
-        (a:A)
-         (P:A->Prop)
-          (P a)->(y:A)(identityT ? y a)->(P y).
- Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
-Defined.
-
-Definition identity_rec_r :      
-     (A:Type)
-        (a:A)
-         (P:A->Set)
-          (P a)->(y:A)(identityT ? y a)->(P y).
- Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
-Defined.
-
-Definition identity_rect_r :      
-     (A:Type)
-        (a:A)
-         (P:A->Type)
-          (P a)->(y:A)(identityT ? y a)->(P y).
- Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
-Defined.
-
-V7only [
-Notation sym_idT  := sym_id (only parsing).
-Notation trans_idT  := trans_id (only parsing).
-Notation congr_idT  := congr_id (only parsing).
-Notation sym_not_idT  := sym_not_id (only parsing).
-Notation identityT_ind_r := identity_ind_r (only parsing).
-Notation identityT_rec_r  := identity_rec_r (only parsing).
-Notation identityT_rect_r := identity_rect_r (only parsing).
-].
-Inductive prodT [A,B:Type] : Type := pairT : A -> B -> (prodT A B).
-
-Section prodT_proj.
-
-  Variables A, B : Type.
-
-  Definition fstT := [H:(prodT A B)]Cases H of (pairT x _) => x end.
-  Definition sndT := [H:(prodT A B)]Cases H of (pairT _ y) => y end.
-
-End prodT_proj.
-
-Definition prodT_uncurry : (A,B,C:Type)((prodT A B)->C)->A->B->C :=
-  [A,B,C:Type; f:((prodT A B)->C); x:A; y:B]
-  (f (pairT A B x y)).
-
-Definition prodT_curry : (A,B,C:Type)(A->B->C)->(prodT A B)->C :=
-  [A,B,C:Type; f:(A->B->C); p:(prodT A B)]
-  Cases p of
-  | (pairT x y) => (f x y)
-  end.
-
-Hints Immediate sym_id sym_not_id : core v62.
-
-V7only [
-Implicits fstT [1 2].
-Implicits sndT [1 2].
-Implicits pairT [1 2].
-].
diff --git a/theories7/Init/Notations.v b/theories7/Init/Notations.v
deleted file mode 100644
index 34bfcbfa..00000000
--- a/theories7/Init/Notations.v
+++ /dev/null
@@ -1,94 +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: Notations.v,v 1.5.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
-
-(** These are the notations whose level and associativity is imposed by Coq *)
-
-(** Notations for logical connectives *)
-
-Uninterpreted Notation "x <-> y" (at level 8, right associativity)
-  V8only (at level 95, no associativity).
-Uninterpreted Notation "x /\ y" (at level 6, right associativity) 
-  V8only (at level 80, right associativity).
-Uninterpreted Notation "x \/ y" (at level 7, right associativity)
-  V8only (at level 85, right associativity).
-Uninterpreted Notation "~ x" (at level 5, right associativity)
-  V8only (at level 75, right associativity).
-
-(** Notations for equality and inequalities *)
-
-Uninterpreted Notation "x = y  :> T" 
-  (at level 5, y at next level, no associativity).
-Uninterpreted Notation "x = y"
-  (at level 5, no associativity).
-Uninterpreted Notation "x = y = z"
-  (at level 5, no associativity, y at next level).
-
-Uninterpreted Notation "x <> y  :> T" 
-  (at level 5, y at next level, no associativity).
-Uninterpreted Notation "x <> y"
-  (at level 5, no associativity).
-
-Uninterpreted V8Notation "x <= y" (at level 70, no associativity).
-Uninterpreted V8Notation "x < y" (at level 70, no associativity).
-Uninterpreted V8Notation "x >= y" (at level 70, no associativity).
-Uninterpreted V8Notation "x > y" (at level 70, no associativity).
-
-Uninterpreted V8Notation "x <= y <= z" (at level 70, y at next level).
-Uninterpreted V8Notation "x <= y < z"  (at level 70, y at next level).
-Uninterpreted V8Notation "x < y < z"   (at level 70, y at next level).
-Uninterpreted V8Notation "x < y <= z"  (at level 70, y at next level).
-
-(** Arithmetical notations (also used for type constructors) *)
-
-Uninterpreted Notation "x + y" (at level 4, left associativity).
-Uninterpreted V8Notation "x - y" (at level 50, left associativity).
-Uninterpreted Notation "x * y" (at level 3, right associativity)
-  V8only (at level 40, left associativity).
-Uninterpreted V8Notation "x / y" (at level 40, left associativity).
-Uninterpreted V8Notation "- x" (at level 35, right associativity).
-Uninterpreted V8Notation "/ x" (at level 35, right associativity).
-Uninterpreted V8Notation "x ^ y" (at level 30, right associativity).
-
-(** Notations for pairs *)
-
-V7only [Uninterpreted Notation "( x , y )" (at level 0) V8only.].
-Uninterpreted V8Notation "( x , y , .. , z )" (at level 0).
-
-(** Notation "{ x }" is reserved and has a special status as component
-    of other notations; it is at level 1 to factor with {x:A|P} etc *)
-
-Uninterpreted Notation "{ x }" (at level 1)
-  V8only (at level 0, x at level 99).
-
-(** Notations for sum-types *)
-
-Uninterpreted Notation "{ A }  + { B }" (at level 4, left associativity)
-  V8only (at level 50, left associativity).
-
-Uninterpreted Notation "A + { B }" (at level 4, left associativity)
-  V8only (at level 50, left associativity).
-
-(** Notations for sigma-types or subsets *)
-
-Uninterpreted Notation "{ x : A  |  P }" (at level 1)
-  V8only (at level 0, x at level 99).
-Uninterpreted Notation "{ x : A  |  P  &  Q }" (at level 1)
-  V8only (at level 0, x at level 99).
-
-Uninterpreted Notation "{ x : A  &  P }" (at level 1)
-  V8only (at level 0, x at level 99).
-Uninterpreted Notation "{ x : A  &  P  &  Q }" (at level 1)
-  V8only (at level 0, x at level 99).
-
-Delimits Scope type_scope with type.
-Delimits Scope core_scope with core.
-
-Open Scope core_scope.
-Open Scope type_scope.
diff --git a/theories7/Init/Peano.v b/theories7/Init/Peano.v
deleted file mode 100755
index 72d19399..00000000
--- a/theories7/Init/Peano.v
+++ /dev/null
@@ -1,218 +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: Peano.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
-
-(** Natural numbers [nat] built from [O] and [S] are defined in Datatypes.v *)
-
-(** This module defines the following operations on natural numbers :
-    - predecessor [pred]
-    - addition [plus]
-    - multiplication [mult]
-    - less or equal order [le]
-    - less [lt]
-    - greater or equal [ge]
-    - greater [gt]
-
-   This module states various lemmas and theorems about natural numbers,
-   including Peano's axioms of arithmetic (in Coq, these are in fact provable)
-   Case analysis on [nat] and induction on [nat * nat] are provided too *)
-
-Require Notations.
-Require Datatypes.
-Require Logic.
-
-Open Scope nat_scope.
-
-Definition eq_S := (f_equal nat nat S).
-
-Hint eq_S : v62 := Resolve (f_equal nat nat S).
-Hint eq_nat_unary : core := Resolve (f_equal nat).
-
-(** The predecessor function *)
-
-Definition pred : nat->nat := [n:nat](Cases n of O => O | (S u) => u end).
-Hint eq_pred : v62 := Resolve (f_equal nat nat pred).
-
-Theorem pred_Sn : (m:nat) m=(pred (S m)).
-Proof.
-  Auto.
-Qed.
-
-Theorem eq_add_S : (n,m:nat) (S n)=(S m) -> n=m.
-Proof.
-  Intros n m H ; Change (pred (S n))=(pred (S m)); Auto.
-Qed.
-
-Hints Immediate eq_add_S : core v62.
-
-(** A consequence of the previous axioms *)
-
-Theorem not_eq_S : (n,m:nat) ~(n=m) -> ~((S n)=(S m)).
-Proof.
-  Red; Auto.
-Qed.
-Hints Resolve not_eq_S : core v62.
-
-Definition IsSucc : nat->Prop
-  := [n:nat]Cases n of O => False | (S p) => True end.
-
-
-Theorem O_S : (n:nat)~(O=(S n)).
-Proof.
-  Red;Intros n H.
-  Change (IsSucc O).
-  Rewrite <- (sym_eq nat O (S n));[Exact I | Assumption].
-Qed.
-Hints Resolve O_S : core v62.
-
-Theorem n_Sn : (n:nat) ~(n=(S n)).
-Proof.
-  NewInduction n ; Auto.
-Qed.
-Hints Resolve n_Sn : core v62.
-
-(** Addition *)
-
-Fixpoint plus [n:nat] : nat -> nat := 
-   [m:nat]Cases n of 
-      O   => m 
-  | (S p) => (S (plus p m)) end.
-Hint eq_plus : v62 := Resolve (f_equal2 nat nat nat plus).
-Hint eq_nat_binary : core := Resolve (f_equal2 nat nat).
-
-V8Infix "+" plus : nat_scope.
-
-Lemma plus_n_O : (n:nat) n=(plus n O).
-Proof.
-  NewInduction n ; Simpl ; Auto.
-Qed.
-Hints Resolve plus_n_O : core v62.
-
-Lemma plus_O_n : (n:nat) (plus O n)=n.
-Proof.
-  Auto.
-Qed.
-
-Lemma plus_n_Sm : (n,m:nat) (S (plus n m))=(plus n (S m)).
-Proof.
-  Intros n m; NewInduction n; Simpl; Auto.
-Qed.
-Hints Resolve plus_n_Sm : core v62.
-
-Lemma plus_Sn_m : (n,m:nat)(plus (S n) m)=(S (plus n m)).
-Proof.
-  Auto.
-Qed.
-
-(** Multiplication *)
-
-Fixpoint  mult [n:nat] : nat -> nat := 
-   [m:nat]Cases n of O => O 
-               | (S p) => (plus m (mult p m)) end.
-Hint eq_mult : core v62 := Resolve (f_equal2 nat nat nat mult).
-
-V8Infix "*" mult : nat_scope.
-
-Lemma mult_n_O : (n:nat) O=(mult n O).
-Proof.
-  NewInduction n; Simpl; Auto.
-Qed.
-Hints Resolve mult_n_O : core v62.
-
-Lemma mult_n_Sm : (n,m:nat) (plus (mult n m) n)=(mult n (S m)).
-Proof.
-  Intros; NewInduction n as [|p H]; Simpl; Auto.
-  NewDestruct H; Rewrite <- plus_n_Sm; Apply (f_equal nat nat S).
-  Pattern 1 3 m; Elim m; Simpl; Auto.
-Qed.
-Hints Resolve mult_n_Sm : core v62.
-
-(** Definition of subtraction on [nat] : [m-n] is [0] if [n>=m] *)
-
-Fixpoint minus [n:nat] : nat -> nat := 
-  [m:nat]Cases n m of
-            O    _     =>  O
-         | (S k) O     => (S k)
-         | (S k) (S l) => (minus k l)
-        end. 
-
-V8Infix "-" minus : nat_scope.
-
-(** Definition of the usual orders, the basic properties of [le] and [lt] 
-    can be found in files Le and Lt *)
-
-(** An inductive definition to define the order *)
-
-Inductive le [n:nat] : nat -> Prop
-    := le_n : (le n n)
-     | le_S : (m:nat)(le n m)->(le n (S m)).
-
-V8Infix "<=" le : nat_scope.
-
-Hint constr_le : core v62 := Constructors le.
-(*i equivalent to : "Hints Resolve le_n le_S : core v62." i*)
-
-Definition lt := [n,m:nat](le (S n) m).
-Hints Unfold lt : core v62.
-
-V8Infix "<" lt : nat_scope.
-
-Definition ge := [n,m:nat](le m n).
-Hints Unfold ge : core v62.
-
-V8Infix ">=" ge : nat_scope.
-
-Definition gt := [n,m:nat](lt m n).
-Hints Unfold gt : core v62.
-
-V8Infix ">" gt : nat_scope.
-
-V8Notation "x <= y <= z" := (le x y)/\(le y z) : nat_scope.
-V8Notation "x <= y < z"  := (le x y)/\(lt y z) : nat_scope.
-V8Notation "x < y < z"   := (lt x y)/\(lt y z) : nat_scope.
-V8Notation "x < y <= z"  := (lt x y)/\(le y z) : nat_scope.
-
-(** Pattern-Matching on natural numbers *)
-
-Theorem nat_case : (n:nat)(P:nat->Prop)(P O)->((m:nat)(P (S m)))->(P n).
-Proof.
-  NewInduction n ; Auto.
-Qed.
-
-(** Principle of double induction *)
-
-Theorem nat_double_ind : (R:nat->nat->Prop)
-     ((n:nat)(R O n)) -> ((n:nat)(R (S n) O))
-     -> ((n,m:nat)(R n m)->(R (S n) (S m)))
-     -> (n,m:nat)(R n m).
-Proof.
-  NewInduction n; Auto.
-  NewDestruct m; Auto.
-Qed.
-
-(** Notations *)
-V7only[
-Syntax constr
-  level 0:
-    S [ (S $p) ] -> [$p:"nat_printer":9]
-  | O [ O ]      -> ["(0)"].
-].
-
-V7only [
-(* For parsing/printing based on scopes *)
-Module nat_scope.
-Infix 4 "+" plus : nat_scope.
-Infix 3 "*" mult : nat_scope.
-Infix 4 "-" minus : nat_scope.
-Infix NONA 5 "<=" le : nat_scope.
-Infix NONA 5 "<" lt : nat_scope.
-Infix NONA 5 ">=" ge : nat_scope.
-Infix NONA 5 ">" gt : nat_scope.
-End nat_scope.
-].
diff --git a/theories7/Init/Specif.v b/theories7/Init/Specif.v
deleted file mode 100755
index c39e5ed8..00000000
--- a/theories7/Init/Specif.v
+++ /dev/null
@@ -1,204 +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: Specif.v,v 1.2.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
-
-Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
-
-(** Basic specifications : Sets containing logical information *)
-
-Require Notations.
-Require Datatypes.
-Require Logic.
-
-(** Subsets *)
-
-(** [(sig A P)], or more suggestively [{x:A | (P x)}], denotes the subset 
-    of elements of the Set [A] which satisfy the predicate [P].
-    Similarly [(sig2 A P Q)], or [{x:A | (P x) & (Q x)}], denotes the subset 
-    of elements of the Set [A] which satisfy both [P] and [Q]. *)
-
-Inductive sig [A:Set;P:A->Prop] : Set
-    := exist : (x:A)(P x) -> (sig A P).
-
-Inductive sig2 [A:Set;P,Q:A->Prop] : Set
-    := exist2 : (x:A)(P x) -> (Q x) -> (sig2 A P Q).
-
-(** [(sigS A P)], or more suggestively [{x:A & (P x)}], is a subtle variant
-    of subset where [P] is now of type [Set].
-    Similarly for [(sigS2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *)
-     
-Inductive sigS [A:Set;P:A->Set] : Set
-    := existS : (x:A)(P x) -> (sigS A P).
-
-Inductive sigS2 [A:Set;P,Q:A->Set] : Set
-    := existS2 : (x:A)(P x) -> (Q x) -> (sigS2 A P Q).
-
-Arguments Scope sig [type_scope type_scope].
-Arguments Scope sig2 [type_scope type_scope type_scope].
-Arguments Scope sigS [type_scope type_scope].
-Arguments Scope sigS2 [type_scope type_scope type_scope].
-
-Notation "{ x : A  |  P }" := (sig A [x:A]P) : type_scope.
-Notation "{ x : A  |  P  &  Q }" := (sig2 A [x:A]P [x:A]Q) : type_scope.
-Notation "{ x : A  &  P }" := (sigS A [x:A]P) : type_scope.
-Notation "{ x : A  &  P  &  Q }" := (sigS2 A [x:A]P [x:A]Q) : type_scope.
-
-Add Printing Let sig.
-Add Printing Let sig2.
-Add Printing Let sigS.
-Add Printing Let sigS2.
-
-
-(** Projections of sig *)
-
-Section Subset_projections.
-
-  Variable A:Set.
-  Variable P:A->Prop.
-
-  Definition proj1_sig :=
-   [e:(sig A P)]Cases e of (exist a b) => a  end.
-
-  Definition proj2_sig :=
-   [e:(sig A P)]
-     <[e:(sig A P)](P (proj1_sig e))>Cases e of (exist a b) => b  end.
-
-End Subset_projections.
-
-
-(** Projections of sigS *)
-
-Section Projections.
-
-  Variable A:Set.
-  Variable P:A->Set.
-
- (** An element [y] of a subset [{x:A & (P x)}] is the pair of an [a] of 
-     type [A] and of a proof [h] that [a] satisfies [P].
-     Then [(projS1 y)] is the witness [a]
-     and [(projS2 y)] is the proof of [(P a)] *)
-
-  Definition projS1 : (sigS A P) -> A
-           := [x:(sigS A P)]Cases x of (existS a _) => a end.
-  Definition projS2 : (x:(sigS A P))(P (projS1 x))
-           := [x:(sigS A P)]<[x:(sigS A P)](P (projS1 x))> 
-                  Cases x of (existS _ h) => h end.
-
-End Projections.
-
-
-(** Extended_booleans *)
-
-Inductive sumbool [A,B:Prop] : Set
-    := left  : A -> {A}+{B}
-     | right : B -> {A}+{B}
-
-where "{ A } + { B }" := (sumbool A B) : type_scope.
-
-Inductive sumor [A:Set;B:Prop] : Set
-    := inleft  : A -> A+{B}
-     | inright : B -> A+{B}
-
-where "A + { B }" := (sumor A B) : type_scope.
-
-(** Choice *)
-
-Section Choice_lemmas.
-
-  (** The following lemmas state various forms of the axiom of choice *)
-
-  Variables S,S':Set.
-  Variable R:S->S'->Prop.
-  Variable R':S->S'->Set.
-  Variables R1,R2 :S->Prop.
-
-  Lemma Choice : ((x:S)(sig ? [y:S'](R x y))) ->
-                     (sig ? [f:S->S'](z:S)(R z (f z))).
-  Proof.
-   Intro H.
-   Exists [z:S]Cases (H z) of (exist y _) => y end.
-   Intro z; NewDestruct (H z); Trivial.
-  Qed.
-
-  Lemma Choice2 : ((x:S)(sigS ? [y:S'](R' x y))) ->
-                     (sigS ? [f:S->S'](z:S)(R' z (f z))).
-  Proof.
-    Intro H.
-    Exists [z:S]Cases (H z) of (existS y _) => y end.
-    Intro z; NewDestruct (H z); Trivial.
-  Qed.
-
-  Lemma bool_choice : 
-    ((x:S)(sumbool (R1 x) (R2 x))) ->
-    (sig ? [f:S->bool] (x:S)( ((f x)=true  /\ (R1 x)) 
-                           \/ ((f x)=false /\ (R2 x)))).
-  Proof.
-    Intro H.
-    Exists [z:S]Cases (H z) of (left _) => true | (right _) => false end.
-    Intro z; NewDestruct (H z); Auto.
-  Qed.
-
-End Choice_lemmas.
-
- (** A result of type [(Exc A)] is either a normal value of type [A] or 
-     an [error] :
-     [Inductive Exc [A:Set] : Set := value : A->(Exc A) | error : (Exc A)]
-     it is implemented using the option type. *) 
-
-Definition Exc := option.
-Definition value := Some.
-Definition error := !None.
-
-Implicits error [1].
-
-Definition except := False_rec. (* for compatibility with previous versions *)
-
-Implicits except [1].
-
-V7only [
-Notation Except := (!except ?) (only parsing).
-Notation Error := (!error ?) (only parsing).
-V7only [Implicits error [].].
-V7only [Implicits except [].].
-].
-Theorem absurd_set : (A:Prop)(C:Set)A->(~A)->C.
-Proof.
-  Intros A C h1 h2.
-  Apply False_rec.
-  Apply (h2 h1).
-Qed.
-
-Hints Resolve left right inleft inright : core v62.
-
-(** Sigma Type at Type level [sigT] *)
-
-Inductive sigT [A:Type;P:A->Type] : Type
-    := existT : (x:A)(P x) -> (sigT A P).
-
-Section projections_sigT.
-
-  Variable A:Type.
-  Variable P:A->Type.
-
-  Definition projT1 : (sigT A P) -> A
-              := [H:(sigT A P)]Cases H of (existT x _) => x end.
-   
-  Definition projT2 : (x:(sigT A P))(P (projT1 x))
-              := [H:(sigT A P)]<[H:(sigT A P)](P (projT1 H))> 
-                     Cases H of (existT x h) => h end.
-
-End projections_sigT.
-
-V7only [
-Notation ProjS1 := (projS1 ? ?).
-Notation ProjS2 := (projS2 ? ?).
-Notation Value := (value ?).
-].
-
diff --git a/theories7/Init/Wf.v b/theories7/Init/Wf.v
deleted file mode 100755
index b65057eb..00000000
--- a/theories7/Init/Wf.v
+++ /dev/null
@@ -1,158 +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        *)
-(************************************************************************)
-
-Set Implicit Arguments.
-V7only [Unset Implicit Arguments.].
-
-(*i $Id: Wf.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
-
-(** This module proves the validity of
-    - well-founded recursion (also called course of values)
-    - well-founded induction
-
-   from a well-founded ordering on a given set *)
-
-Require Notations.
-Require Logic.
-Require Datatypes.
-
-(** Well-founded induction principle on Prop *)
-
-Chapter Well_founded.
-
- Variable A : Set.
- Variable R : A -> A -> Prop.
-
- (** The accessibility predicate is defined to be non-informative *)
-
- Inductive  Acc : A -> Prop 
-    := Acc_intro : (x:A)((y:A)(R y x)->(Acc y))->(Acc x).
-
- Lemma Acc_inv : (x:A)(Acc x) -> (y:A)(R y x) -> (Acc y).
-  NewDestruct 1; Trivial.
- Defined.
-
-  (** the informative elimination :
-     [let Acc_rec F = let rec wf x = F x wf in wf] *)
-
- Section AccRecType.
-  Variable P : A -> Type.
-  Variable F : (x:A)((y:A)(R y x)->(Acc y))->((y:A)(R y x)->(P y))->(P x).
-
-  Fixpoint Acc_rect [x:A;a:(Acc x)] : (P x)
-     := (F x (Acc_inv x a) ([y:A][h:(R y x)](Acc_rect y (Acc_inv x a y h)))).
-
- End AccRecType.
-
- Definition Acc_rec [P:A->Set] := (Acc_rect P).
-
- (** A simplified version of Acc_rec(t) *)
-
- Section AccIter.
-  Variable P : A -> Type. 
-  Variable F : (x:A)((y:A)(R y x)-> (P y))->(P x).
-
-  Fixpoint Acc_iter [x:A;a:(Acc x)] : (P x)
-     := (F x ([y:A][h:(R y x)](Acc_iter y (Acc_inv x a y h)))).
-
- End AccIter.
-
- (** A relation is well-founded if every element is accessible *)
-
- Definition well_founded := (a:A)(Acc a).
-
- (** well-founded induction on Set and Prop *)
-
- Hypothesis Rwf : well_founded.
-
- Theorem well_founded_induction_type : 
-        (P:A->Type)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
- Proof.
-  Intros; Apply (Acc_iter P); Auto.
- Defined.
-
- Theorem well_founded_induction :
-        (P:A->Set)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
- Proof.
-  Exact [P:A->Set](well_founded_induction_type P).
- Defined.
-
- Theorem well_founded_ind : 
-         (P:A->Prop)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
- Proof.
-  Exact [P:A->Prop](well_founded_induction_type P).
- Defined.
-
-(** Building fixpoints  *) 
-
-Section FixPoint.
-
-Variable P : A -> Set.
-Variable F : (x:A)((y:A)(R y x)->(P y))->(P x).
-
-Fixpoint Fix_F [x:A;r:(Acc x)] : (P x) := 
-         (F x [y:A][p:(R y x)](Fix_F y (Acc_inv x r y p))).
-
-Definition fix := [x:A](Fix_F x (Rwf x)).
-
-(** Proof that [well_founded_induction] satisfies the fixpoint equation. 
-    It requires an extra property of the functional *)
-
-Hypothesis F_ext : 
-  (x:A)(f,g:(y:A)(R y x)->(P y))
-  ((y:A)(p:(R y x))((f y p)=(g y p)))->(F x f)=(F x g).
-
-Scheme Acc_inv_dep := Induction for Acc Sort Prop.
-
-Lemma Fix_F_eq
-  : (x:A)(r:(Acc x))
-    (F x [y:A][p:(R y x)](Fix_F y (Acc_inv x r y p)))=(Fix_F x r).
-NewDestruct r using  Acc_inv_dep; Auto.
-Qed.
-
-Lemma Fix_F_inv : (x:A)(r,s:(Acc x))(Fix_F x r)=(Fix_F x s).
-Intro x; NewInduction (Rwf x); Intros.
-Rewrite <- (Fix_F_eq x r); Rewrite <- (Fix_F_eq x s); Intros.
-Apply F_ext; Auto.
-Qed.
-
-
-Lemma Fix_eq : (x:A)(fix x)=(F x [y:A][p:(R y x)](fix y)).
-Intro x; Unfold fix.
-Rewrite <- (Fix_F_eq x).
-Apply F_ext; Intros.
-Apply Fix_F_inv.
-Qed.
-
-End FixPoint.
-
-End Well_founded. 
-
-(** A recursor over pairs *)
-
-Chapter Well_founded_2.
-
-  Variable A,B : Set.
-  Variable R : A * B -> A * B -> Prop.
-
-  Variable P : A -> B -> Type. 
-  Variable F : (x:A)(x':B)((y:A)(y':B)(R (y,y') (x,x'))-> (P y y'))->(P x x').
-
-  Fixpoint Acc_iter_2 [x:A;x':B;a:(Acc ? R (x,x'))] : (P x x')
-     := (F x x' ([y:A][y':B][h:(R (y,y') (x,x'))](Acc_iter_2 y y' (Acc_inv ? ? (x,x') a (y,y') h)))).
-
-  Hypothesis Rwf : (well_founded ? R).
-
-  Theorem well_founded_induction_type_2 : 
-     ((x:A)(x':B)((y:A)(y':B)(R (y,y') (x,x'))->(P y y'))->(P x x'))->(a:A)(b:B)(P a b).
-  Proof.
-   Intros; Apply Acc_iter_2; Auto.
-  Defined.
-
-End Well_founded_2.
-
diff --git a/theories7/IntMap/Adalloc.v b/theories7/IntMap/Adalloc.v
deleted file mode 100644
index 9e8dd1b3..00000000
--- a/theories7/IntMap/Adalloc.v
+++ /dev/null
@@ -1,339 +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: Adalloc.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $	 i*)
-
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Arith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Fset.
-
-Section AdAlloc.
-
-  Variable A : Set.
-
-  Definition nat_of_ad := [a:ad] Cases a of
-                                     ad_z => O
-				   | (ad_x p) => (convert p)
-			         end.
-
-  Fixpoint nat_le [m:nat] : nat -> bool :=
-    Cases m of
-        O => [_:nat] true
-      | (S m') => [n:nat] Cases n of
-                              O => false
-			    | (S n') => (nat_le m' n')
-			  end
-    end.
-
-  Lemma nat_le_correct : (m,n:nat) (le m n) -> (nat_le m n)=true.
-  Proof.
-    NewInduction m as [|m IHm]. Trivial.
-    NewDestruct n. Intro H. Elim (le_Sn_O ? H).
-    Intros. Simpl. Apply IHm. Apply le_S_n. Assumption.
-  Qed.
-
-  Lemma nat_le_complete : (m,n:nat) (nat_le m n)=true -> (le m n).
-  Proof.
-    NewInduction m. Trivial with arith.
-    NewDestruct n. Intro H. Discriminate H.
-    Auto with arith.
-  Qed.
-
-  Lemma nat_le_correct_conv : (m,n:nat) (lt m n) -> (nat_le n m)=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (nat_le n m)). Intro H0.
-    Elim (lt_n_n ? (lt_le_trans ? ? ? H (nat_le_complete ? ? H0))).
-    Trivial.
-  Qed.
-
-  Lemma nat_le_complete_conv : (m,n:nat) (nat_le n m)=false -> (lt m n).
-  Proof.
-    Intros. Elim (le_or_lt n m). Intro. Conditional Trivial Rewrite nat_le_correct in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Definition ad_of_nat := [n:nat] Cases n of
-                                      O => ad_z
-				    | (S n') => (ad_x (anti_convert n'))
-				  end.
-
-  Lemma ad_of_nat_of_ad : (a:ad) (ad_of_nat (nat_of_ad a))=a.
-  Proof.
-    NewDestruct a as [|p]. Reflexivity.
-    Simpl. Elim (ZL4 p). Intros n H. Rewrite H. Simpl. Rewrite <- bij1 in H.
-    Rewrite convert_intro with 1:=H. Reflexivity.
-  Qed.
-
-  Lemma nat_of_ad_of_nat : (n:nat) (nat_of_ad (ad_of_nat n))=n.
-  Proof.
-    NewInduction n. Trivial.
-    Intros. Simpl. Apply bij1.
-  Qed.
-
-  Definition ad_le := [a,b:ad] (nat_le (nat_of_ad a) (nat_of_ad b)).
-
-  Lemma ad_le_refl : (a:ad) (ad_le a a)=true.
-  Proof.
-    Intro. Unfold ad_le. Apply nat_le_correct. Apply le_n.
-  Qed.
-
-  Lemma ad_le_antisym : (a,b:ad) (ad_le a b)=true -> (ad_le b a)=true -> a=b.
-  Proof.
-    Unfold ad_le. Intros. Rewrite <- (ad_of_nat_of_ad a). Rewrite <- (ad_of_nat_of_ad b).
-    Rewrite (le_antisym ? ? (nat_le_complete ? ? H) (nat_le_complete ? ? H0)). Reflexivity.
-  Qed.
-
-  Lemma ad_le_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le b c)=true -> 
-      (ad_le a c)=true.
-  Proof.
-    Unfold ad_le. Intros. Apply nat_le_correct. Apply le_trans with m:=(nat_of_ad b).
-    Apply nat_le_complete. Assumption.
-    Apply nat_le_complete. Assumption.
-  Qed.
-
-  Lemma ad_le_lt_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le c b)=false -> 
-      (ad_le c a)=false.
-  Proof.
-    Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply le_lt_trans with m:=(nat_of_ad b).
-    Apply nat_le_complete. Assumption.
-    Apply nat_le_complete_conv. Assumption.
-  Qed.
-
-  Lemma ad_lt_le_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le b c)=true -> 
-      (ad_le c a)=false.
-  Proof.
-    Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_le_trans with m:=(nat_of_ad b).
-    Apply nat_le_complete_conv. Assumption.
-    Apply nat_le_complete. Assumption.
-  Qed.
-
-  Lemma ad_lt_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le c b)=false -> 
-      (ad_le c a)=false.
-  Proof.
-    Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_trans with m:=(nat_of_ad b).
-    Apply nat_le_complete_conv. Assumption.
-    Apply nat_le_complete_conv. Assumption.
-  Qed.
-
-  Lemma ad_lt_le_weak : (a,b:ad) (ad_le b a)=false -> (ad_le a b)=true.
-  Proof.
-    Unfold ad_le. Intros. Apply nat_le_correct. Apply lt_le_weak.
-    Apply nat_le_complete_conv. Assumption.
-  Qed.
-
-  Definition ad_min := [a,b:ad] if (ad_le a b) then a else b.
-
-  Lemma ad_min_choice : (a,b:ad) {(ad_min a b)=a}+{(ad_min a b)=b}.
-  Proof.
-    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Left . Rewrite H.
-    Reflexivity.
-    Intro H. Right . Rewrite H. Reflexivity.
-  Qed.
-
-  Lemma ad_min_le_1 : (a,b:ad) (ad_le (ad_min a b) a)=true.
-  Proof.
-    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H.
-    Apply ad_le_refl.
-    Intro H. Rewrite H. Apply ad_lt_le_weak. Assumption.
-  Qed.
-
-  Lemma ad_min_le_2 : (a,b:ad) (ad_le (ad_min a b) b)=true.
-  Proof.
-    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H. Assumption.
-    Intro H. Rewrite H. Apply ad_le_refl.
-  Qed.
-
-  Lemma ad_min_le_3 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a b)=true.
-  Proof.
-    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
-    Assumption.
-    Intro H0. Rewrite H0 in H. Apply ad_lt_le_weak. Apply ad_le_lt_trans with b:=c; Assumption.
-  Qed.
-
-  Lemma ad_min_le_4 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a c)=true.
-  Proof.
-    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
-    Apply ad_le_trans with b:=b; Assumption.
-    Intro H0. Rewrite H0 in H. Assumption.
-  Qed.
-
-  Lemma ad_min_le_5 : (a,b,c:ad) (ad_le a b)=true -> (ad_le a c)=true ->
-      (ad_le a (ad_min b c))=true.
-  Proof.
-    Intros. Elim (ad_min_choice b c). Intro H1. Rewrite H1. Assumption.
-    Intro H1. Rewrite H1. Assumption.
-  Qed.
-
-  Lemma ad_min_lt_3 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le b a)=false.
-  Proof.
-    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
-    Assumption.
-    Intro H0. Rewrite H0 in H. Apply ad_lt_trans with b:=c; Assumption.
-  Qed.
-
-  Lemma ad_min_lt_4 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le c a)=false.
-  Proof.
-    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
-    Apply ad_lt_le_trans with b:=b; Assumption.
-    Intro H0. Rewrite H0 in H. Assumption.
-  Qed.
-
-  (** Allocator: returns an address not in the domain of [m].
-  This allocator is optimal in that it returns the lowest possible address,
-  in the usual ordering on integers. It is not the most efficient, however. *)
-  Fixpoint ad_alloc_opt [m:(Map A)] : ad :=
-    Cases m of
-        M0 => ad_z
-      | (M1 a _) => if (ad_eq a ad_z)
-                    then (ad_x xH)
-		    else ad_z
-      | (M2 m1 m2) => (ad_min (ad_double (ad_alloc_opt m1))
-                              (ad_double_plus_un (ad_alloc_opt m2)))
-    end.
-
-  Lemma ad_alloc_opt_allocates_1 : (m:(Map A)) (MapGet A m (ad_alloc_opt m))=(NONE A).
-  Proof.
-    NewInduction m as [|a|m0 H m1 H0]. Reflexivity.
-    Simpl. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H. Rewrite H.
-    Rewrite (ad_eq_complete ? ? H). Reflexivity.
-    Intro H. Rewrite H. Rewrite H. Reflexivity.
-    Intros. Change (ad_alloc_opt (M2 A m0 m1)) with
-         (ad_min (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))).
-    Elim (ad_min_choice (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))).
-    Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
-    Apply ad_double_bit_0.
-    Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption.
-    Apply ad_double_plus_un_bit_0.
-  Qed.
-
-  Lemma ad_alloc_opt_allocates : (m:(Map A)) (in_dom A (ad_alloc_opt m) m)=false.
-  Proof.
-    Unfold in_dom. Intro. Rewrite (ad_alloc_opt_allocates_1 m). Reflexivity.
-  Qed.
-
-  (** Moreover, this is optimal: all addresses below [(ad_alloc_opt m)]
-      are in [dom m]: *)
-
-  Lemma nat_of_ad_double : (a:ad) (nat_of_ad (ad_double a))=(mult (2) (nat_of_ad a)).
-  Proof.
-    NewDestruct a as [|p]. Trivial.
-    Exact (convert_xO p).
-  Qed.
-
-  Lemma nat_of_ad_double_plus_un : (a:ad)
-      (nat_of_ad (ad_double_plus_un a))=(S (mult (2) (nat_of_ad a))).
-  Proof.
-    NewDestruct a as [|p]. Trivial.
-    Exact (convert_xI p).
-  Qed.
-
-  Lemma ad_le_double_mono : (a,b:ad) (ad_le a b)=true -> 
-      (ad_le (ad_double a) (ad_double b))=true.
-  Proof.
-    Unfold ad_le. Intros. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Apply nat_le_correct.
-    Simpl. Apply le_plus_plus. Apply nat_le_complete. Assumption.
-    Apply le_plus_plus. Apply nat_le_complete. Assumption.
-    Apply le_n.
-  Qed.
-
-  Lemma ad_le_double_plus_un_mono : (a,b:ad) (ad_le a b)=true ->
-      (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true.
-  Proof.
-    Unfold ad_le. Intros. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un.
-    Apply nat_le_correct. Apply le_n_S. Simpl. Apply le_plus_plus. Apply nat_le_complete.
-    Assumption.
-    Apply le_plus_plus. Apply nat_le_complete. Assumption.
-    Apply le_n.
-  Qed.
-
-  Lemma ad_le_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=true ->
-      (ad_le a b)=true.
-  Proof.
-    Unfold ad_le. Intros a b. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Intro.
-    Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply nat_le_complete. Assumption.
-  Qed.
-
-  Lemma ad_le_double_plus_un_mono_conv : (a,b:ad)
-      (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true -> (ad_le a b)=true.
-  Proof.
-    Unfold ad_le. Intros a b. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un.
-    Intro. Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply le_S_n. Apply nat_le_complete.
-    Assumption.
-  Qed.
-
-  Lemma ad_lt_double_mono : (a,b:ad) (ad_le a b)=false ->
-      (ad_le (ad_double a) (ad_double b))=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_le (ad_double a) (ad_double b))). Intro H0.
-    Rewrite (ad_le_double_mono_conv ? ? H0) in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma ad_lt_double_plus_un_mono : (a,b:ad) (ad_le a b)=false ->
-      (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_le (ad_double_plus_un a) (ad_double_plus_un b))). Intro H0.
-    Rewrite (ad_le_double_plus_un_mono_conv ? ? H0) in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma ad_lt_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=false ->
-      (ad_le a b)=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0. Rewrite (ad_le_double_mono ? ? H0) in H.
-    Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma ad_lt_double_plus_un_mono_conv : (a,b:ad)
-      (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false -> (ad_le a b)=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0.
-    Rewrite (ad_le_double_plus_un_mono ? ? H0) in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma ad_alloc_opt_optimal_1 : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false ->
-      {y:A | (MapGet A m a)=(SOME A y)}.
-  Proof.
-    NewInduction m as [|a y|m0 H m1 H0]. Simpl. Unfold ad_le. Simpl. Intros. Discriminate H.
-    Simpl. Intros b H. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H0. Rewrite H0 in H.
-    Unfold ad_le in H. Cut ad_z=b. Intro. Split with y. Rewrite <- H1. Rewrite H0. Reflexivity.
-    Rewrite <- (ad_of_nat_of_ad b).
-    Rewrite <- (le_n_O_eq ? (le_S_n ? ? (nat_le_complete_conv ? ? H))). Reflexivity.
-    Intro H0. Rewrite H0 in H. Discriminate H.
-    Intros. Simpl in H1. Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3.
-    Rewrite H3 in H1. Elim (H ? (ad_lt_double_mono_conv ? ? (ad_min_lt_3 ? ? ? H1))). Intros y H4.
-    Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
-    Apply ad_double_bit_0.
-    Intro H2. Elim H2. Intros a0 H3. Rewrite H3 in H1.
-    Elim (H0 ? (ad_lt_double_plus_un_mono_conv ? ? (ad_min_lt_4 ? ? ? H1))). Intros y H4.
-    Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2.
-    Assumption.
-    Apply ad_double_plus_un_bit_0.
-  Qed.
-
-  Lemma ad_alloc_opt_optimal : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false ->
-      (in_dom A a m)=true.
-  Proof.
-    Intros. Unfold in_dom. Elim (ad_alloc_opt_optimal_1 m a H). Intros y H0. Rewrite H0.
-    Reflexivity.
-  Qed.
-
-End AdAlloc.
-
-V7only [
-(* Moved to NArith *)
-Notation positive_to_nat_2 := positive_to_nat_2.
-Notation positive_to_nat_4 := positive_to_nat_4.
-].
diff --git a/theories7/IntMap/Addec.v b/theories7/IntMap/Addec.v
deleted file mode 100644
index 50dc1480..00000000
--- a/theories7/IntMap/Addec.v
+++ /dev/null
@@ -1,179 +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: Addec.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $	 i*)
-
-(** Equality on adresses *)
-
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-
-Fixpoint ad_eq_1 [p1,p2:positive] : bool :=
-  Cases p1 p2 of
-      xH xH => true
-    | (xO p'1) (xO p'2) => (ad_eq_1 p'1 p'2)
-    | (xI p'1) (xI p'2) => (ad_eq_1 p'1 p'2)
-    | _ _ => false
-  end.
-
-Definition ad_eq := [a,a':ad]
-  Cases a a' of
-      ad_z ad_z => true
-    | (ad_x p) (ad_x p') => (ad_eq_1 p p')
-    | _ _ => false
-  end.
-
-Lemma ad_eq_correct : (a:ad) (ad_eq a a)=true.
-Proof.
-  NewDestruct a; Trivial.
-  NewInduction p; Trivial.
-Qed.
-
-Lemma ad_eq_complete : (a,a':ad) (ad_eq a a')=true -> a=a'.
-Proof.
-  NewDestruct a. NewDestruct a'; Trivial. NewDestruct p.
-  Discriminate 1.
-  Discriminate 1.
-  Discriminate 1.
-  NewDestruct a'. Intros. Discriminate H.
-  Unfold ad_eq. Intros. Cut p=p0. Intros. Rewrite H0. Reflexivity.
-  Generalize Dependent p0.
-  NewInduction p as [p IHp|p IHp|]. NewDestruct p0; Intro H.
-  Rewrite (IHp p0). Reflexivity.
-  Exact H.
-  Discriminate H.
-  Discriminate H.
-  NewDestruct p0; Intro H. Discriminate H.
-  Rewrite (IHp p0 H). Reflexivity.
-  Discriminate H.
-  NewDestruct p0; Intro H. Discriminate H.
-  Discriminate H.
-  Trivial.
-Qed.
-
-Lemma ad_eq_comm : (a,a':ad) (ad_eq a a')=(ad_eq a' a).
-Proof.
-  Intros. Cut (b,b':bool)(ad_eq a a')=b->(ad_eq a' a)=b'->b=b'.
-  Intros. Apply H. Reflexivity.
-  Reflexivity.
-  NewDestruct b. Intros. Cut a=a'.
-  Intro. Rewrite H1 in H0. Rewrite (ad_eq_correct a') in H0. Exact H0.
-  Apply ad_eq_complete. Exact H.
-  NewDestruct b'. Intros. Cut a'=a.
-  Intro. Rewrite H1 in H. Rewrite H1 in H0. Rewrite <- H. Exact H0.
-  Apply ad_eq_complete. Exact H0.
-  Trivial.
-Qed.
-
-Lemma ad_xor_eq_true : (a,a':ad) (ad_xor a a')=ad_z -> (ad_eq a a')=true.
-Proof.
-  Intros. Rewrite (ad_xor_eq a a' H). Apply ad_eq_correct.
-Qed.
-
-Lemma ad_xor_eq_false :
-    (a,a':ad) (p:positive) (ad_xor a a')=(ad_x p) -> (ad_eq a a')=false.
-Proof.
-  Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0.
-  Rewrite (ad_eq_complete a a' H0) in H. Rewrite (ad_xor_nilpotent a') in H. Discriminate H.
-  Trivial.
-Qed.
-
-Lemma ad_bit_0_1_not_double : (a:ad) (ad_bit_0 a)=true ->
-      (a0:ad) (ad_eq (ad_double a0) a)=false.
-Proof.
-  Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0.
-  Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_bit_0 a0) in H. Discriminate H.
-  Trivial.
-Qed.
-
-Lemma ad_not_div_2_not_double : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false ->
-      (ad_eq a (ad_double a0))=false.
-Proof.
-  Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0.
-  Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_div_2 a0) in H.
-  Rewrite (ad_eq_correct a0) in H. Discriminate H.
-  Intro. Rewrite ad_eq_comm. Assumption.
-Qed.
-
-Lemma ad_bit_0_0_not_double_plus_un : (a:ad) (ad_bit_0 a)=false ->
-      (a0:ad) (ad_eq (ad_double_plus_un a0) a)=false.
-Proof.
-  Intros. Elim (sumbool_of_bool (ad_eq (ad_double_plus_un a0) a)). Intro H0.
-  Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_bit_0 a0) in H.
-  Discriminate H.
-  Trivial.
-Qed.
-
-Lemma ad_not_div_2_not_double_plus_un : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false ->
-      (ad_eq (ad_double_plus_un a0) a)=false.
-Proof.
-  Intros. Elim (sumbool_of_bool (ad_eq a (ad_double_plus_un a0))). Intro H0.
-  Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_div_2 a0) in H.
-  Rewrite (ad_eq_correct a0) in H. Discriminate H.
-  Intro H0. Rewrite ad_eq_comm. Assumption.
-Qed.
-
-Lemma ad_bit_0_neq :
-    (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> (ad_eq a a')=false.
-Proof.
-  Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H1. Rewrite (ad_eq_complete ? ? H1) in H.
-  Rewrite H in H0. Discriminate H0.
-  Trivial.
-Qed.
-
-Lemma ad_div_eq :
-    (a,a':ad) (ad_eq a a')=true -> (ad_eq (ad_div_2 a) (ad_div_2 a'))=true.
-Proof.
-  Intros. Cut a=a'. Intros. Rewrite H0. Apply ad_eq_correct.
-  Apply ad_eq_complete. Exact H.
-Qed.
-
-Lemma ad_div_neq : (a,a':ad) (ad_eq (ad_div_2 a) (ad_div_2 a'))=false -> 
-    (ad_eq a a')=false.
-Proof.
-  Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0.
-  Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_eq_correct (ad_div_2 a')) in H. Discriminate H.
-  Trivial.
-Qed.
-
-Lemma ad_div_bit_eq : (a,a':ad) (ad_bit_0 a)=(ad_bit_0 a') ->
-    (ad_div_2 a)=(ad_div_2 a') -> a=a'.
-Proof.
-  Intros. Apply ad_faithful. Unfold eqf. NewDestruct n.
-  Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Assumption.
-  Rewrite <- ad_div_2_correct. Rewrite <- ad_div_2_correct.
-  Rewrite H0. Reflexivity.
-Qed.
-
-Lemma ad_div_bit_neq : (a,a':ad) (ad_eq a a')=false -> (ad_bit_0 a)=(ad_bit_0 a') ->
-    (ad_eq (ad_div_2 a) (ad_div_2 a'))=false.
-Proof.
-  Intros. Elim (sumbool_of_bool (ad_eq (ad_div_2 a) (ad_div_2 a'))). Intro H1.
-  Rewrite (ad_div_bit_eq ? ? H0 (ad_eq_complete ? ? H1)) in H.
-  Rewrite (ad_eq_correct a') in H. Discriminate H.
-  Trivial.
-Qed.
-
-Lemma ad_neq : (a,a':ad) (ad_eq a a')=false ->
-    (ad_bit_0 a)=(negb (ad_bit_0 a')) \/ (ad_eq (ad_div_2 a) (ad_div_2 a'))=false.
-Proof.
-  Intros. Cut (ad_bit_0 a)=(ad_bit_0 a')\/(ad_bit_0 a)=(negb (ad_bit_0 a')).
-  Intros. Elim H0. Intro. Right . Apply ad_div_bit_neq. Assumption.
-  Assumption.
-  Intro. Left . Assumption.
-  Case (ad_bit_0 a); Case (ad_bit_0 a'); Auto.
-Qed.
-
-Lemma ad_double_or_double_plus_un : (a:ad)
-    {a0:ad | a=(ad_double a0)}+{a1:ad | a=(ad_double_plus_un a1)}.
-Proof.
-  Intro. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Right . Split with (ad_div_2 a).
-  Rewrite (ad_div_2_double_plus_un a H). Reflexivity.
-  Intro H. Left . Split with (ad_div_2 a). Rewrite (ad_div_2_double a H). Reflexivity.
-Qed.
diff --git a/theories7/IntMap/Addr.v b/theories7/IntMap/Addr.v
deleted file mode 100644
index 9f362772..00000000
--- a/theories7/IntMap/Addr.v
+++ /dev/null
@@ -1,456 +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: Addr.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
-
-(** Representation of adresses by the [positive] type of binary numbers *)
-
-Require Bool.
-Require ZArith.
-
-Inductive ad : Set :=
-    ad_z : ad
-  | ad_x : positive -> ad.
-
-Lemma ad_sum : (a:ad) {p:positive | a=(ad_x p)}+{a=ad_z}.
-Proof.
-  NewDestruct a; Auto.
-  Left; Exists p; Trivial.
-Qed.
-
-Fixpoint p_xor [p:positive] : positive -> ad :=
-  [p2] Cases p of
-      xH => Cases p2 of
-	        xH => ad_z
-	      | (xO p'2) => (ad_x (xI p'2))
-	      | (xI p'2) => (ad_x (xO p'2))
-	    end
-    | (xO p') => Cases p2 of
-                     xH => (ad_x (xI p'))
-		   | (xO p'2) => Cases (p_xor p' p'2) of
-		                     ad_z => ad_z
-				   | (ad_x p'') => (ad_x (xO p''))
-				 end
-		   | (xI p'2) => Cases (p_xor p' p'2) of
-		                     ad_z => (ad_x xH)
-				   | (ad_x p'') => (ad_x (xI p''))
-				 end
-                 end
-    | (xI p') => Cases p2 of
-		     xH => (ad_x (xO p'))
-		   | (xO p'2) => Cases (p_xor p' p'2) of
-		                     ad_z => (ad_x xH)
-				   | (ad_x p'') => (ad_x (xI p''))
-				 end
-		   | (xI p'2) => Cases (p_xor p' p'2) of
-		                     ad_z => ad_z
-				   | (ad_x p'') => (ad_x (xO p''))
-				 end
-                 end
-  end.
-
-Definition ad_xor := [a,a':ad]
-  Cases a of
-      ad_z => a'
-    | (ad_x p) => Cases a' of
-                      ad_z => a
-	            | (ad_x p') => (p_xor p p')
-                  end
-  end.
-
-Lemma ad_xor_neutral_left : (a:ad) (ad_xor ad_z a)=a.
-Proof.
-  Trivial.
-Qed.
-
-Lemma ad_xor_neutral_right : (a:ad) (ad_xor a ad_z)=a.
-Proof.
-  NewDestruct a; Trivial.
-Qed.
-
-Lemma ad_xor_comm : (a,a':ad) (ad_xor a a')=(ad_xor a' a).
-Proof.
-  NewDestruct a; NewDestruct a'; Simpl; Auto.
-  Generalize p0; Clear p0; NewInduction p as [p Hrecp|p Hrecp|]; Simpl; Auto.
-  NewDestruct p0; Simpl; Trivial; Intros.
-  Rewrite Hrecp; Trivial.
-  Rewrite Hrecp; Trivial.
-  NewDestruct p0; Simpl; Trivial; Intros.
-  Rewrite Hrecp; Trivial.
-  Rewrite Hrecp; Trivial.
-  NewDestruct p0; Simpl; Auto.
-Qed.
-
-Lemma ad_xor_nilpotent : (a:ad) (ad_xor a a)=ad_z.
-Proof.
-  NewDestruct a; Trivial.
-  Simpl. NewInduction p as [p IHp|p IHp|]; Trivial.
-  Simpl. Rewrite IHp; Reflexivity.
-  Simpl. Rewrite IHp; Reflexivity.
-Qed.
-
-Fixpoint ad_bit_1 [p:positive] : nat -> bool :=
-  Cases p of
-      xH => [n:nat] Cases n of
-                        O => true
-		      | (S _) => false
-		    end
-    | (xO p) => [n:nat] Cases n of
-                            O => false
-			  | (S n') => (ad_bit_1 p n')
-		        end
-    | (xI p) => [n:nat] Cases n of
-                            O => true
-			  | (S n') => (ad_bit_1 p n')
-		        end
-  end.
-
-Definition ad_bit := [a:ad]
-  Cases a of
-      ad_z => [_:nat] false
-    | (ad_x p) => (ad_bit_1 p)
-  end.
-
-Definition eqf := [f,g:nat->bool] (n:nat) (f n)=(g n).
-
-Lemma ad_faithful_1 : (a:ad) (eqf (ad_bit ad_z) (ad_bit a)) -> ad_z=a.
-Proof.
-  NewDestruct a. Trivial.
-  NewInduction p as [p IHp|p IHp|];Intro H. Absurd ad_z=(ad_x p). Discriminate.
-  Exact (IHp [n:nat](H (S n))).
-  Absurd ad_z=(ad_x p). Discriminate.
-  Exact (IHp [n:nat](H (S n))).
-  Absurd false=true. Discriminate.
-  Exact (H O).
-Qed.
-
-Lemma ad_faithful_2 : (a:ad) (eqf (ad_bit (ad_x xH)) (ad_bit a)) -> (ad_x xH)=a.
-Proof.
-  NewDestruct a. Intros. Absurd true=false. Discriminate.
-  Exact (H O).
-  NewDestruct p. Intro H. Absurd ad_z=(ad_x p). Discriminate.
-  Exact (ad_faithful_1 (ad_x p) [n:nat](H (S n))).
-  Intros. Absurd true=false. Discriminate.
-  Exact (H O).
-  Trivial.
-Qed.
-
-Lemma ad_faithful_3 :
-    (a:ad) (p:positive)
-      ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') ->
-        (eqf (ad_bit (ad_x (xO p))) (ad_bit a)) ->
-          (ad_x (xO p))=a.
-Proof.
-  NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xO p)))).
-  Intro. Rewrite (ad_faithful_1 (ad_x (xO p)) H1). Reflexivity.
-  Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity.
-  Case p. Intros. Absurd false=true. Discriminate.
-  Exact (H0 O).
-  Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity.
-  Intros. Absurd false=true. Discriminate.
-  Exact (H0 O).
-Qed.
-
-Lemma ad_faithful_4 :
-    (a:ad) (p:positive)
-      ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') ->
-        (eqf (ad_bit (ad_x (xI p))) (ad_bit a)) ->
-          (ad_x (xI p))=a.
-Proof.
-  NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xI p)))).
-  Intro. Rewrite (ad_faithful_1 (ad_x (xI p)) H1). Reflexivity.
-  Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity.
-  Case p. Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity.
-  Intros. Absurd true=false. Discriminate.
-  Exact (H0 O).
-  Intros. Absurd ad_z=(ad_x p0). Discriminate.
-  Cut (eqf (ad_bit (ad_x xH)) (ad_bit (ad_x (xI p0)))).
-  Intro. Exact (ad_faithful_1 (ad_x p0) [n:nat](H1 (S n))).
-  Unfold eqf. Unfold eqf in H0. Intro. Rewrite H0. Reflexivity.
-Qed.
-
-Lemma ad_faithful : (a,a':ad) (eqf (ad_bit a) (ad_bit a')) -> a=a'.
-Proof.
-  NewDestruct a. Exact ad_faithful_1.
-  NewInduction p. Intros a' H. Apply ad_faithful_4. Intros. Cut (ad_x p)=(ad_x p').
-  Intro. Inversion H1. Reflexivity.
-  Exact (IHp (ad_x p') H0).
-  Assumption.
-  Intros. Apply ad_faithful_3. Intros. Cut (ad_x p)=(ad_x p'). Intro. Inversion H1. Reflexivity.
-  Exact (IHp (ad_x p') H0).
-  Assumption.
-  Exact ad_faithful_2.
-Qed.
-
-Definition adf_xor := [f,g:nat->bool; n:nat] (xorb (f n) (g n)).
-
-Lemma ad_xor_sem_1 : (a':ad) (ad_bit (ad_xor ad_z a') O)=(ad_bit a' O).
-Proof.
-  Trivial.
-Qed.
-
-Lemma ad_xor_sem_2 : (a':ad) (ad_bit (ad_xor (ad_x xH) a') O)=(negb (ad_bit a' O)).
-Proof.
-  Intro. Case a'. Trivial.
-  Simpl. Intro. 
-  Case p; Trivial.
-Qed.
-
-Lemma ad_xor_sem_3 :
-    (p:positive) (a':ad) (ad_bit (ad_xor (ad_x (xO p)) a') O)=(ad_bit a' O).
-Proof.
-  Intros. Case a'. Trivial.
-  Simpl. Intro. 
-  Case p0; Trivial. Intro. 
-  Case (p_xor p p1); Trivial.
-  Intro. Case (p_xor p p1); Trivial.
-Qed.
-
-Lemma ad_xor_sem_4 : (p:positive) (a':ad)
-    (ad_bit (ad_xor (ad_x (xI p)) a') O)=(negb (ad_bit a' O)).
-Proof.
-  Intros. Case a'. Trivial.
-  Simpl. Intro. Case p0; Trivial. Intro. 
-  Case (p_xor p p1); Trivial.
-  Intro. 
-  Case (p_xor p p1); Trivial.
-Qed.
-
-Lemma ad_xor_sem_5 :
-    (a,a':ad) (ad_bit (ad_xor a a') O)=(adf_xor (ad_bit a) (ad_bit a') O).
-Proof.
-  NewDestruct a. Intro. Change (ad_bit a' O)=(xorb false (ad_bit a' O)). Rewrite false_xorb. Trivial.
-  Case p. Exact ad_xor_sem_4.
-  Intros. Change (ad_bit (ad_xor (ad_x (xO p0)) a') O)=(xorb false (ad_bit a' O)).
-  Rewrite false_xorb. Apply ad_xor_sem_3. Exact ad_xor_sem_2.
-Qed.
-
-Lemma ad_xor_sem_6 : (n:nat)
-    ((a,a':ad) (ad_bit (ad_xor a a') n)=(adf_xor (ad_bit a) (ad_bit a') n)) ->
-      (a,a':ad) (ad_bit (ad_xor a a') (S n))=(adf_xor (ad_bit a) (ad_bit a') (S n)).
-Proof.
-  Intros. Case a. Unfold adf_xor. Unfold 2 ad_bit. Rewrite false_xorb. Reflexivity.
-  Case a'. Unfold adf_xor. Unfold 3 ad_bit. Intro. Rewrite xorb_false. Reflexivity.
-  Intros. Case p0. Case p. Intros.
-  Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xI p1))) (S n))
-        =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
-  Rewrite <- H. Simpl. 
-  Case (p_xor p2 p1); Trivial.
-  Intros.
-  Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xO p1))) (S n))
-        =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
-  Rewrite <- H. Simpl. 
-  Case (p_xor p2 p1); Trivial.
-  Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity.
-  Case p. Intros.
-  Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xI p1))) (S n))
-        =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
-  Rewrite <- H. Simpl. 
-  Case (p_xor p2 p1); Trivial.
-  Intros.
-  Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xO p1))) (S n))
-        =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
-  Rewrite <- H. Simpl. 
-  Case (p_xor p2 p1); Trivial.
-  Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity.
-  Unfold adf_xor. Unfold 2 ad_bit. Unfold ad_bit_1. Rewrite false_xorb. Simpl.   Case p; Trivial.
-Qed.
-
-Lemma ad_xor_semantics :
-    (a,a':ad) (eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a'))).
-Proof.
-  Unfold eqf. Intros. Generalize a a'. Elim n. Exact ad_xor_sem_5.
-  Exact ad_xor_sem_6.
-Qed.
-
-Lemma eqf_sym : (f,f':nat->bool) (eqf f f') -> (eqf f' f).
-Proof.
-  Unfold eqf. Intros. Rewrite H. Reflexivity.
-Qed.
-
-Lemma eqf_refl :  (f:nat->bool) (eqf f f).
-Proof.
-  Unfold eqf. Trivial.
-Qed.
-
-Lemma eqf_trans : (f,f',f'':nat->bool) (eqf f f') -> (eqf f' f'') -> (eqf f f'').
-Proof.
-  Unfold eqf. Intros. Rewrite H. Exact (H0 n).
-Qed.
-
-Lemma adf_xor_eq : (f,f':nat->bool) (eqf (adf_xor f f') [n:nat] false) -> (eqf f f').
-Proof.
-  Unfold eqf. Unfold adf_xor. Intros. Apply xorb_eq. Apply H.
-Qed.
-
-Lemma ad_xor_eq : (a,a':ad) (ad_xor a a')=ad_z -> a=a'.
-Proof.
-  Intros. Apply ad_faithful. Apply adf_xor_eq. Apply eqf_trans with f':=(ad_bit (ad_xor a a')).
-  Apply eqf_sym. Apply ad_xor_semantics.
-  Rewrite H. Unfold eqf. Trivial.
-Qed.
-
-Lemma adf_xor_assoc : (f,f',f'':nat->bool)
-    (eqf (adf_xor (adf_xor f f') f'') (adf_xor f (adf_xor f' f''))).
-Proof.
-  Unfold eqf. Unfold adf_xor. Intros. Apply xorb_assoc.
-Qed.
-
-Lemma eqf_xor_1 : (f,f',f'',f''':nat->bool) (eqf f f') -> (eqf f'' f''') ->
-    (eqf (adf_xor f f'') (adf_xor f' f''')).
-Proof.
-  Unfold eqf. Intros. Unfold adf_xor. Rewrite H. Rewrite H0. Reflexivity.
-Qed.
-
-Lemma ad_xor_assoc :
-    (a,a',a'':ad) (ad_xor (ad_xor a a') a'')=(ad_xor a (ad_xor a' a'')).
-Proof.
-  Intros. Apply ad_faithful.
-  Apply eqf_trans with f':=(adf_xor (adf_xor (ad_bit a) (ad_bit a')) (ad_bit a'')).
-  Apply eqf_trans with f':=(adf_xor (ad_bit (ad_xor a a')) (ad_bit a'')).
-  Apply ad_xor_semantics.
-  Apply eqf_xor_1. Apply ad_xor_semantics.
-  Apply eqf_refl.
-  Apply eqf_trans with f':=(adf_xor (ad_bit a) (adf_xor (ad_bit a') (ad_bit a''))).
-  Apply adf_xor_assoc.
-  Apply eqf_trans with f':=(adf_xor (ad_bit a) (ad_bit (ad_xor a' a''))).
-  Apply eqf_xor_1. Apply eqf_refl.
-  Apply eqf_sym. Apply ad_xor_semantics.
-  Apply eqf_sym. Apply ad_xor_semantics.
-Qed.
-
-Definition ad_double := [a:ad]
-  Cases a of
-      ad_z => ad_z
-    | (ad_x p) => (ad_x (xO p))
-  end.
-
-Definition ad_double_plus_un := [a:ad]
-  Cases a of
-      ad_z => (ad_x xH)
-    | (ad_x p) => (ad_x (xI p))
-  end.
-
-Definition ad_div_2 := [a:ad]
-  Cases a of
-      ad_z => ad_z
-    | (ad_x xH) => ad_z
-    | (ad_x (xO p)) => (ad_x p)
-    | (ad_x (xI p)) => (ad_x p)
-  end.
-
-Lemma ad_double_div_2 : (a:ad) (ad_div_2 (ad_double a))=a.
-Proof.
-  NewDestruct a; Trivial.
-Qed.
-
-Lemma ad_double_plus_un_div_2 : (a:ad) (ad_div_2 (ad_double_plus_un a))=a.
-Proof.
-  NewDestruct a; Trivial.
-Qed.
-
-Lemma ad_double_inj : (a0,a1:ad) (ad_double a0)=(ad_double a1) -> a0=a1.
-Proof.
-  Intros. Rewrite <- (ad_double_div_2 a0). Rewrite H. Apply ad_double_div_2.
-Qed.
-
-Lemma ad_double_plus_un_inj :
-    (a0,a1:ad) (ad_double_plus_un a0)=(ad_double_plus_un a1) -> a0=a1.
-Proof.
-  Intros. Rewrite <- (ad_double_plus_un_div_2 a0). Rewrite H. Apply ad_double_plus_un_div_2.
-Qed.
-
-Definition ad_bit_0 := [a:ad]
-  Cases a of
-      ad_z => false
-    | (ad_x (xO _)) => false
-    | _ => true
-  end.
-
-Lemma ad_double_bit_0 : (a:ad) (ad_bit_0 (ad_double a))=false.
-Proof.
-  NewDestruct a; Trivial.
-Qed.
-
-Lemma ad_double_plus_un_bit_0 : (a:ad) (ad_bit_0 (ad_double_plus_un a))=true.
-Proof.
-  NewDestruct a; Trivial.
-Qed.
-
-Lemma ad_div_2_double : (a:ad) (ad_bit_0 a)=false -> (ad_double (ad_div_2 a))=a.
-Proof.
-  NewDestruct a. Trivial. NewDestruct p. Intro H. Discriminate H.
-  Intros. Reflexivity.
-  Intro H. Discriminate H.
-Qed.
-
-Lemma ad_div_2_double_plus_un :
-    (a:ad) (ad_bit_0 a)=true -> (ad_double_plus_un (ad_div_2 a))=a.
-Proof.
-  NewDestruct a. Intro. Discriminate H.
-  NewDestruct p. Intros. Reflexivity.
-  Intro H. Discriminate H.
-  Intro. Reflexivity.
-Qed.
-
-Lemma ad_bit_0_correct : (a:ad) (ad_bit a O)=(ad_bit_0 a).
-Proof.
-  NewDestruct a; Trivial.
-  NewDestruct p; Trivial.
-Qed.
-
-Lemma ad_div_2_correct : (a:ad) (n:nat) (ad_bit (ad_div_2 a) n)=(ad_bit a (S n)).
-Proof.
-  NewDestruct a; Trivial.
-  NewDestruct p; Trivial.
-Qed.
-
-Lemma ad_xor_bit_0 :
-    (a,a':ad) (ad_bit_0 (ad_xor a a'))=(xorb (ad_bit_0 a) (ad_bit_0 a')).
-Proof.
-  Intros. Rewrite <- ad_bit_0_correct. Rewrite (ad_xor_semantics a a' O).
-  Unfold adf_xor. Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Reflexivity.
-Qed.
-
-Lemma ad_xor_div_2 :
-    (a,a':ad) (ad_div_2 (ad_xor a a'))=(ad_xor (ad_div_2 a) (ad_div_2 a')).
-Proof.
-  Intros. Apply ad_faithful. Unfold eqf. Intro.
-  Rewrite (ad_xor_semantics (ad_div_2 a) (ad_div_2 a') n).
-  Rewrite ad_div_2_correct.
-  Rewrite (ad_xor_semantics a a' (S n)).
-  Unfold adf_xor. Rewrite ad_div_2_correct. Rewrite ad_div_2_correct.
-  Reflexivity.
-Qed.
-
-Lemma ad_neg_bit_0 : (a,a':ad) (ad_bit_0 (ad_xor a a'))=true ->
-    (ad_bit_0 a)=(negb (ad_bit_0 a')).
-Proof.
-  Intros. Rewrite <- true_xorb. Rewrite <- H. Rewrite ad_xor_bit_0.
-  Rewrite xorb_assoc. Rewrite xorb_nilpotent. Rewrite xorb_false. Reflexivity.
-Qed.
-
-Lemma ad_neg_bit_0_1 :
-    (a,a':ad) (ad_xor a a')=(ad_x xH) -> (ad_bit_0 a)=(negb (ad_bit_0 a')).
-Proof.
-  Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity.
-Qed.
-
-Lemma ad_neg_bit_0_2 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xI p)) ->
-    (ad_bit_0 a)=(negb (ad_bit_0 a')).
-Proof.
-  Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity.
-Qed.
-
-Lemma ad_same_bit_0 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xO p)) ->
-    (ad_bit_0 a)=(ad_bit_0 a').
-Proof.
-  Intros. Rewrite <- (xorb_false (ad_bit_0 a)). Cut (ad_bit_0 (ad_x (xO p)))=false.
-  Intro. Rewrite <- H0. Rewrite <- H. Rewrite ad_xor_bit_0. Rewrite <- xorb_assoc.
-  Rewrite xorb_nilpotent. Rewrite false_xorb. Reflexivity.
-  Reflexivity.
-Qed.
diff --git a/theories7/IntMap/Adist.v b/theories7/IntMap/Adist.v
deleted file mode 100644
index a7948c72..00000000
--- a/theories7/IntMap/Adist.v
+++ /dev/null
@@ -1,321 +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: Adist.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	      i*)
-
-Require Bool.
-Require ZArith.
-Require Arith.
-Require Min.
-Require Addr.
-
-Fixpoint ad_plength_1 [p:positive] : nat :=
-  Cases p of
-      xH => O
-    | (xI _) => O
-    | (xO p') => (S (ad_plength_1 p'))
-  end.
-
-Inductive natinf : Set :=
-    infty : natinf
-  | ni : nat -> natinf.
-
-Definition ad_plength := [a:ad]
-  Cases a of
-      ad_z => infty
-    | (ad_x p) => (ni (ad_plength_1 p))
-  end.
-
-Lemma ad_plength_infty : (a:ad) (ad_plength a)=infty -> a=ad_z.
-Proof.
-  Induction a; Trivial. 
-  Unfold ad_plength; Intros; Discriminate H.
-Qed.
-
-Lemma ad_plength_zeros : (a:ad) (n:nat) (ad_plength a)=(ni n) ->
-    (k:nat) (lt k n) -> (ad_bit a k)=false.
-Proof.
-  Induction a; Trivial. 
-  Induction p. Induction n. Intros. Inversion H1.
-  Induction k. Simpl in H1. Discriminate H1.
-  Intros. Simpl in H1. Discriminate H1.
-  Induction k. Trivial.
-  Generalize H0. Case n. Intros. Inversion H3.
-  Intros. Simpl. Unfold ad_bit in H. Apply (H n0). Simpl in H1. Inversion H1. Reflexivity.
-  Exact (lt_S_n n1 n0 H3).
-  Simpl. Intros n H. Inversion H. Intros. Inversion H0.
-Qed.
-
-Lemma ad_plength_one : (a:ad) (n:nat) (ad_plength a)=(ni n) -> (ad_bit a n)=true.
-Proof.
-  Induction a. Intros. Inversion H.
-  Induction p. Intros. Simpl in H0. Inversion H0. Reflexivity.
-  Intros. Simpl in H0. Inversion H0. Simpl. Unfold ad_bit in H. Apply H. Reflexivity.
-  Intros. Simpl in H. Inversion H. Reflexivity.
-Qed.
-
-Lemma ad_plength_first_one : (a:ad) (n:nat)
-    ((k:nat) (lt k n) -> (ad_bit a k)=false) -> (ad_bit a n)=true ->
-      (ad_plength a)=(ni n).
-Proof.
-  Induction a. Intros. Simpl in H0. Discriminate H0.
-  Induction p. Intros. Generalize H0. Case n. Intros. Reflexivity.
-  Intros. Absurd (ad_bit (ad_x (xI p0)) O)=false. Trivial with bool.
-  Auto with bool arith.
-  Intros. Generalize H0 H1. Case n. Intros. Simpl in H3. Discriminate H3.
-  Intros. Simpl. Unfold ad_plength in H.
-  Cut (ni (ad_plength_1 p0))=(ni n0). Intro. Inversion H4. Reflexivity.
-  Apply H. Intros. Change (ad_bit (ad_x (xO p0)) (S k))=false. Apply H2. Apply lt_n_S. Exact H4.
-  Exact H3.
-  Intro. Case n. Trivial.
-  Intros. Simpl in H0. Discriminate H0.
-Qed.
-
-Definition ni_min := [d,d':natinf]
-  Cases d of
-      infty => d'
-    | (ni n) => Cases d' of
-                    infty => d
-		  | (ni n') => (ni (min n n'))
-		end
-  end.
-
-Lemma ni_min_idemp : (d:natinf) (ni_min d d)=d.
-Proof.
-  Induction d; Trivial.
-  Unfold ni_min.
-  Induction n; Trivial.
-  Intros.
-  Simpl.
-  Inversion H.
-  Rewrite H1.
-  Rewrite H1.
-  Reflexivity.
-Qed.
-
-Lemma ni_min_comm : (d,d':natinf) (ni_min d d')=(ni_min d' d).
-Proof.
-  Induction d. Induction d'; Trivial.
-  Induction d'; Trivial. Elim n. Induction n0; Trivial.
-  Intros. Elim n1; Trivial. Intros. Unfold ni_min in H. Cut (min n0 n2)=(min n2 n0).
-  Intro. Unfold ni_min. Simpl. Rewrite H1. Reflexivity.
-  Cut (ni (min n0 n2))=(ni (min n2 n0)). Intros.
-  Inversion H1; Trivial.
-  Exact (H n2).
-Qed.
-
-Lemma ni_min_assoc : (d,d',d'':natinf) (ni_min (ni_min d d') d'')=(ni_min d (ni_min d' d'')).
-Proof.
-  Induction d; Trivial. Induction d'; Trivial. 
-  Induction d''; Trivial.
-  Unfold ni_min. Intro. Cut (min (min n n0) n1)=(min n (min n0 n1)).
-  Intro. Rewrite H. Reflexivity.
-  Generalize n0 n1. Elim n; Trivial. 
-  Induction n3; Trivial. Induction n5; Trivial.
-  Intros. Simpl. Auto.
-Qed.
-
-Lemma ni_min_O_l : (d:natinf) (ni_min (ni O) d)=(ni O).
-Proof.
-  Induction d; Trivial.
-Qed.
-
-Lemma ni_min_O_r : (d:natinf) (ni_min d (ni O))=(ni O).
-Proof.
-  Intros. Rewrite ni_min_comm. Apply ni_min_O_l.
-Qed.
-
-Lemma ni_min_inf_l : (d:natinf) (ni_min infty d)=d.
-Proof.
-  Trivial.
-Qed.
-
-Lemma ni_min_inf_r : (d:natinf) (ni_min d infty)=d.
-Proof.
-  Induction d; Trivial.
-Qed.
-
-Definition ni_le := [d,d':natinf] (ni_min d d')=d.
-
-Lemma ni_le_refl : (d:natinf) (ni_le d d).
-Proof.
-  Exact ni_min_idemp.
-Qed.
-
-Lemma ni_le_antisym : (d,d':natinf) (ni_le d d') -> (ni_le d' d) -> d=d'.
-Proof.
-  Unfold ni_le. Intros d d'. Rewrite ni_min_comm. Intro H. Rewrite H. Trivial.
-Qed.
-
-Lemma ni_le_trans : (d,d',d'':natinf) (ni_le d d') -> (ni_le d' d'') -> (ni_le d d'').
-Proof.
-  Unfold ni_le. Intros. Rewrite <- H. Rewrite ni_min_assoc. Rewrite H0. Reflexivity.
-Qed.
-
-Lemma ni_le_min_1 : (d,d':natinf) (ni_le (ni_min d d') d).
-Proof.
-  Unfold ni_le. Intros. Rewrite (ni_min_comm d d'). Rewrite ni_min_assoc.
-  Rewrite ni_min_idemp. Reflexivity.
-Qed.
-
-Lemma ni_le_min_2 : (d,d':natinf) (ni_le (ni_min d d') d').
-Proof.
-  Unfold ni_le. Intros. Rewrite ni_min_assoc. Rewrite ni_min_idemp. Reflexivity.
-Qed.
-
-Lemma ni_min_case : (d,d':natinf) (ni_min d d')=d \/ (ni_min d d')=d'.
-Proof.
-  Induction d. Intro. Right . Exact (ni_min_inf_l d').
-  Induction d'. Left . Exact (ni_min_inf_r (ni n)).
-  Unfold ni_min. Cut (n0:nat)(min n n0)=n\/(min n n0)=n0.
-  Intros. Case (H n0). Intro. Left . Rewrite H0. Reflexivity.
-  Intro. Right . Rewrite H0. Reflexivity.
-  Elim n. Intro. Left . Reflexivity.
-  Induction n1. Right . Reflexivity.
-  Intros. Case (H n2). Intro. Left . Simpl. Rewrite H1. Reflexivity.
-  Intro. Right . Simpl. Rewrite H1. Reflexivity.
-Qed.
-
-Lemma ni_le_total : (d,d':natinf) (ni_le d d') \/ (ni_le d' d).
-Proof.
-  Unfold ni_le. Intros. Rewrite (ni_min_comm d' d). Apply ni_min_case.
-Qed.
-
-Lemma ni_le_min_induc : (d,d',dm:natinf) (ni_le dm d) -> (ni_le dm d') ->
-    ((d'':natinf) (ni_le d'' d) -> (ni_le d'' d') -> (ni_le d'' dm)) ->
-      (ni_min d d')=dm.
-Proof.
-  Intros. Case (ni_min_case d d'). Intro. Rewrite H2.
-  Apply ni_le_antisym. Apply H1. Apply ni_le_refl.
-  Exact H2.
-  Exact H.
-  Intro. Rewrite H2. Apply ni_le_antisym. Apply H1. Unfold ni_le. Rewrite ni_min_comm. Exact H2.
-  Apply ni_le_refl.
-  Exact H0.
-Qed.
-
-Lemma le_ni_le : (m,n:nat) (le m n) -> (ni_le (ni m) (ni n)).
-Proof.
-  Cut (m,n:nat)(le m n)->(min m n)=m.
-  Intros. Unfold ni_le ni_min. Rewrite (H m n H0). Reflexivity.
-  Induction m. Trivial.
-  Induction n0. Intro. Inversion H0.
-  Intros. Simpl. Rewrite (H n1 (le_S_n n n1 H1)). Reflexivity.
-Qed.
-
-Lemma ni_le_le : (m,n:nat) (ni_le (ni m) (ni n)) -> (le m n).
-Proof.
-  Unfold ni_le. Unfold ni_min. Intros. Inversion H. Apply le_min_r.
-Qed.
-
-Lemma ad_plength_lb : (a:ad) (n:nat) ((k:nat) (lt k n) -> (ad_bit a k)=false) ->
-    (ni_le (ni n) (ad_plength a)).
-Proof.
-  Induction a. Intros. Exact (ni_min_inf_r (ni n)).
-  Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt n (ad_plength_1 p)). Trivial.
-  Intro. Absurd (ad_bit (ad_x p) (ad_plength_1 p))=false.
-  Rewrite (ad_plength_one (ad_x p) (ad_plength_1 p)
-          (refl_equal natinf (ad_plength (ad_x p)))).
-  Discriminate.
-  Apply H. Exact H0.
-Qed.
-
-Lemma ad_plength_ub : (a:ad) (n:nat) (ad_bit a n)=true ->
-    (ni_le (ad_plength a) (ni n)).
-Proof.
-  Induction a. Intros. Discriminate H.
-  Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt (ad_plength_1 p) n). Trivial.
-  Intro. Absurd (ad_bit (ad_x p) n)=true.
-  Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p)
-          (refl_equal natinf (ad_plength (ad_x p))) n H0).
-  Discriminate.
-  Exact H.
-Qed.
-
-
-(** We define an ultrametric distance between addresses: 
-    $d(a,a')=1/2^pd(a,a')$, 
-    where $pd(a,a')$ is the number of identical bits at the beginning 
-    of $a$ and $a'$ (infinity if $a=a'$).  
-    Instead of working with $d$, we work with $pd$, namely
-    [ad_pdist]: *)
-
-Definition ad_pdist := [a,a':ad] (ad_plength (ad_xor a a')).
-
-(** d is a distance, so $d(a,a')=0$ iff $a=a'$; this means that
-    $pd(a,a')=infty$ iff $a=a'$: *)
-
-Lemma ad_pdist_eq_1 : (a:ad) (ad_pdist a a)=infty.
-Proof.
-  Intros. Unfold ad_pdist. Rewrite ad_xor_nilpotent. Reflexivity.
-Qed.
-
-Lemma ad_pdist_eq_2 : (a,a':ad) (ad_pdist a a')=infty -> a=a'.
-Proof.
-  Intros. Apply ad_xor_eq. Apply ad_plength_infty. Exact H.
-Qed.
-
-(** $d$ is a distance, so $d(a,a')=d(a',a)$: *)
-
-Lemma ad_pdist_comm : (a,a':ad) (ad_pdist a a')=(ad_pdist a' a).
-Proof.
-  Unfold ad_pdist. Intros. Rewrite ad_xor_comm. Reflexivity.
-Qed.
-
-(** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq
-    d(a,a'')+d(a'',a')$,
-  but in fact $d(a,a')\leq max(d(a,a''),d(a'',a'))$.
-  This means that $min(pd(a,a''),pd(a'',a'))<=pd(a,a')$ (lemma [ad_pdist_ultra] below).
-  This follows from the fact that $a ~Ra~|a| = 1/2^{\texttt{ad\_plength}}(a))$
-  is an ultrametric norm, i.e. that $|a-a'| \leq max (|a-a''|, |a''-a'|)$,
-  or equivalently that $|a+b|<=max(|a|,|b|)$, i.e. that
-  min $(\texttt{ad\_plength}(a), \texttt{ad\_plength}(b)) \leq 
-  \texttt{ad\_plength} (a~\texttt{xor}~ b)$
-  (lemma [ad_plength_ultra]).
-*)
-
-Lemma ad_plength_ultra_1 : (a,a':ad)
-    (ni_le (ad_plength a) (ad_plength a')) ->
-      (ni_le (ad_plength a) (ad_plength (ad_xor a a'))).
-Proof.
-  Induction a. Intros. Unfold ni_le in H. Unfold 1 3 ad_plength in H.
-  Rewrite (ni_min_inf_l (ad_plength a')) in H.
-  Rewrite (ad_plength_infty a' H). Simpl. Apply ni_le_refl.
-  Intros. Unfold 1 ad_plength. Apply ad_plength_lb. Intros.
-  Cut (a'':ad)(ad_xor (ad_x p) a')=a''->(ad_bit a'' k)=false.
-  Intros. Apply H1. Reflexivity.
-  Intro a''. Case a''. Intro. Reflexivity.
-  Intros. Rewrite <- H1. Rewrite (ad_xor_semantics (ad_x p) a' k). Unfold adf_xor.
-  Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p)
-          (refl_equal natinf (ad_plength (ad_x p))) k H0).
-  Generalize H. Case a'. Trivial.
-  Intros. Cut (ad_bit (ad_x p1) k)=false. Intros. Rewrite H3. Reflexivity.
-  Apply ad_plength_zeros with n:=(ad_plength_1 p1). Reflexivity.
-  Apply (lt_le_trans k (ad_plength_1 p) (ad_plength_1 p1)). Exact H0.
-  Apply ni_le_le. Exact H2.
-Qed.
-
-Lemma ad_plength_ultra : (a,a':ad)
-    (ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a'))).
-Proof.
-  Intros. Case (ni_le_total (ad_plength a) (ad_plength a')). Intro.
-  Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a).
-  Intro. Rewrite H0. Apply ad_plength_ultra_1. Exact H.
-  Exact H.
-  Intro. Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a').
-  Intro. Rewrite H0. Rewrite ad_xor_comm. Apply ad_plength_ultra_1. Exact H.
-  Rewrite ni_min_comm. Exact H.
-Qed.
-
-Lemma ad_pdist_ultra : (a,a',a'':ad)
-    (ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a')).
-Proof.
-  Intros. Unfold ad_pdist. Cut (ad_xor (ad_xor a a'') (ad_xor a'' a'))=(ad_xor a a').
-  Intro. Rewrite <- H. Apply ad_plength_ultra.
-  Rewrite ad_xor_assoc. Rewrite <- (ad_xor_assoc a'' a'' a'). Rewrite ad_xor_nilpotent.
-  Rewrite ad_xor_neutral_left. Reflexivity.
-Qed.
diff --git a/theories7/IntMap/Allmaps.v b/theories7/IntMap/Allmaps.v
deleted file mode 100644
index e76e210f..00000000
--- a/theories7/IntMap/Allmaps.v
+++ /dev/null
@@ -1,26 +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: Allmaps.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
-
-Require Export Addr.
-Require Export Adist.
-Require Export Addec.
-Require Export Map.
-
-Require Export Fset.
-Require Export Mapaxioms.
-Require Export Mapiter.
-
-Require Export Mapsubset.
-Require Export Lsort.
-Require Export Mapfold.
-Require Export Mapcard.
-Require Export Mapcanon.
-Require Export Mapc.
-Require Export Maplists.
-Require Export Adalloc.
diff --git a/theories7/IntMap/Fset.v b/theories7/IntMap/Fset.v
deleted file mode 100644
index 545c1716..00000000
--- a/theories7/IntMap/Fset.v
+++ /dev/null
@@ -1,338 +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: Fset.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
-
-(*s Sets operations on maps *)
-
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-
-Section Dom.
-
-  Variable A, B : Set.
-
-  Fixpoint MapDomRestrTo [m:(Map A)] : (Map B) -> (Map A) :=
-    Cases m of
-        M0 => [_:(Map B)] (M0 A)
-      | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of
-                                 NONE => (M0 A)
-			       | _ => m
-			     end
-      | (M2 m1 m2) => [m':(Map B)] Cases m' of
-                                   M0 => (M0 A)
-				 | (M1 a' y') => Cases (MapGet A m a') of
-				                     NONE => (M0 A)
-						   | (SOME y) => (M1 A a' y)
-						 end
-				 | (M2 m'1 m'2) => (makeM2 A (MapDomRestrTo m1 m'1)
-				                             (MapDomRestrTo m2 m'2))
-			       end
-    end.
-
-  Lemma MapDomRestrTo_semantics : (m:(Map A)) (m':(Map B))
-      (eqm A (MapGet A (MapDomRestrTo m m'))
-             [a0:ad] Cases (MapGet B m' a0) of
-	               NONE => (NONE A)
-		     | _ => (MapGet A m a0)
-		   end).
-  Proof.
-    Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial.
-    Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H.
-    Rewrite <- (ad_eq_complete ? ? H). Case (MapGet B m' a). Reflexivity.
-    Intro. Apply M1_semantics_1.
-    Intro H. Rewrite H. Case (MapGet B m' a). 
-    Case (MapGet B m' a1); Reflexivity.
-    Case (MapGet B m' a1); Intros; Exact (M1_semantics_2 A a a1 a0 H).
-    Induction m'. Trivial.
-    Unfold MapDomRestrTo. Intros. Elim (sumbool_of_bool (ad_eq a a1)).
-    Intro H1.
-    Rewrite (ad_eq_complete ? ? H1). Rewrite (M1_semantics_1 B a1 a0).
-    Case (MapGet A (M2 A m0 m1) a1). Reflexivity.
-    Intro. Apply M1_semantics_1.
-    Intro H1. Rewrite (M1_semantics_2 B a a1 a0 H1). Case (MapGet A (M2 A m0 m1) a). Reflexivity.
-    Intro. Exact (M1_semantics_2 A a a1 a2 H1).
-    Intros. Change (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a)
-        =(Cases (MapGet B (M2 B m2 m3) a) of
-            NONE => (NONE A)
-          | (SOME _) => (MapGet A (M2 A m0 m1) a)
-          end).
-    Rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a).
-    Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)).
-    Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
-    Case (ad_bit_0 a); Reflexivity.
-  Qed.
-
-  Fixpoint MapDomRestrBy [m:(Map A)] : (Map B) -> (Map A) :=
-    Cases m of
-        M0 => [_:(Map B)] (M0 A)
-      | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of
-                                 NONE => m
-			       | _ => (M0 A)
-			     end
-      | (M2 m1 m2) => [m':(Map B)] Cases m' of
-                                   M0 => m
-				 | (M1 a' y') => (MapRemove A m a')
-				 | (M2 m'1 m'2) => (makeM2 A (MapDomRestrBy m1 m'1)
-				                             (MapDomRestrBy m2 m'2))
-			       end
-    end.
-
-  Lemma MapDomRestrBy_semantics : (m:(Map A)) (m':(Map B))
-      (eqm A (MapGet A (MapDomRestrBy m m'))
-             [a0:ad] Cases (MapGet B m' a0) of
-	               NONE => (MapGet A m a0)
-		     | _ => (NONE A)
-		   end).
-  Proof.
-    Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial.
-    Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H.
-    Rewrite (ad_eq_complete ? ? H). Case (MapGet B m' a1). Apply M1_semantics_1.
-    Trivial.
-    Intro H. Rewrite H. Case (MapGet B m' a). Rewrite (M1_semantics_2 A a a1 a0 H).
-    Case (MapGet B m' a1); Trivial.
-    Case (MapGet B m' a1); Trivial.
-    Induction m'. Trivial.
-    Unfold MapDomRestrBy. Intros. Rewrite (MapRemove_semantics A (M2 A m0 m1) a a1).
-    Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1).
-    Rewrite (M1_semantics_1 B a1 a0). Reflexivity.
-    Intro H1. Rewrite H1. Rewrite (M1_semantics_2 B a a1 a0 H1). Reflexivity.
-    Intros. Change (MapGet A (makeM2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3)) a)
-        =(Cases (MapGet B (M2 B m2 m3) a) of
-            NONE => (MapGet A (M2 A m0 m1) a)
-          | (SOME _) => (NONE A)
-          end).
-    Rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a).
-    Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)).
-    Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
-    Case (ad_bit_0 a); Reflexivity.
-  Qed.
-
-  Definition in_dom := [a:ad; m:(Map A)]
-    Cases (MapGet A m a) of
-        NONE => false
-      | _ => true
-    end.
-
-  Lemma in_dom_M0 : (a:ad) (in_dom a (M0 A))=false.
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma in_dom_M1 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=(ad_eq a a0).
-  Proof.
-    Unfold in_dom. Intros. Simpl. Case (ad_eq a a0); Reflexivity.
-  Qed.
-
-  Lemma in_dom_M1_1 : (a:ad) (y:A) (in_dom a (M1 A a y))=true.
-  Proof.
-    Intros. Rewrite in_dom_M1. Apply ad_eq_correct.
-  Qed.
-
-  Lemma in_dom_M1_2 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=true -> a=a0.
-  Proof.
-    Intros. Apply (ad_eq_complete a a0). Rewrite (in_dom_M1 a a0 y) in H. Assumption.
-  Qed.
-
-  Lemma in_dom_some : (m:(Map A)) (a:ad) (in_dom a m)=true ->
-      {y:A | (MapGet A m a)=(SOME A y)}.
-  Proof.
-    Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Trivial.
-    Intro H0. Rewrite H0 in H. Discriminate H.
-  Qed.
-
-  Lemma in_dom_none : (m:(Map A)) (a:ad) (in_dom a m)=false ->
-      (MapGet A m a)=(NONE A).
-  Proof.
-    Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Intro H0. Elim H0.
-    Intros y H1. Rewrite H1 in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma in_dom_put : (m:(Map A)) (a0:ad) (y0:A) (a:ad)
-      (in_dom a (MapPut A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)).
-  Proof.
-    Unfold in_dom. Intros. Rewrite (MapPut_semantics A m a0 y0 a).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
-    Rewrite H. Rewrite orb_true_b. Reflexivity.
-    Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Rewrite orb_false_b.
-    Reflexivity.
-  Qed.
-
-  Lemma in_dom_put_behind : (m:(Map A)) (a0:ad) (y0:A) (a:ad)
-      (in_dom a (MapPut_behind A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)).
-  Proof.
-    Unfold in_dom. Intros. Rewrite (MapPut_behind_semantics A m a0 y0 a).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
-    Rewrite H. Case (MapGet A m a); Reflexivity.
-    Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Case (MapGet A m a); Trivial.
-  Qed.
-
-  Lemma in_dom_remove : (m:(Map A)) (a0:ad) (a:ad)
-      (in_dom a (MapRemove A m a0))=(andb (negb (ad_eq a a0)) (in_dom a m)).
-  Proof.
-    Unfold in_dom. Intros. Rewrite (MapRemove_semantics A m a0 a).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
-    Rewrite H. Reflexivity.
-    Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H.
-    Case (MapGet A m a); Reflexivity.
-  Qed.
-
-  Lemma in_dom_merge : (m,m':(Map A)) (a:ad)
-      (in_dom a (MapMerge A m m'))=(orb (in_dom a m) (in_dom a m')).
-  Proof.
-    Unfold in_dom. Intros. Rewrite (MapMerge_semantics A m m' a).
-    Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
-    Case (MapGet A m a); Reflexivity.
-    Intro H. Rewrite H. Rewrite orb_b_false. Reflexivity.
-  Qed.
-
-  Lemma in_dom_delta : (m,m':(Map A)) (a:ad)
-      (in_dom a (MapDelta A m m'))=(xorb (in_dom a m) (in_dom a m')).
-  Proof.
-    Unfold in_dom. Intros. Rewrite (MapDelta_semantics A m m' a).
-    Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
-    Case (MapGet A m a); Reflexivity.
-    Intro H. Rewrite H. Case (MapGet A m a); Reflexivity.
-  Qed.
-
-End Dom.
-
-Section InDom.
-
-  Variable A, B : Set.
-
-  Lemma in_dom_restrto : (m:(Map A)) (m':(Map B)) (a:ad)
-    (in_dom A a (MapDomRestrTo A B m m'))=(andb (in_dom A a m) (in_dom B a m')).
-  Proof.
-    Unfold in_dom. Intros. Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
-    Rewrite andb_b_true. Reflexivity.
-    Intro H. Rewrite H. Rewrite andb_b_false. Reflexivity.
-  Qed.
-
-  Lemma in_dom_restrby : (m:(Map A)) (m':(Map B)) (a:ad)
-    (in_dom A a (MapDomRestrBy A B m m'))=(andb (in_dom A a m) (negb (in_dom B a m'))).
-  Proof.
-    Unfold in_dom. Intros. Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
-    Unfold negb. Rewrite andb_b_false. Reflexivity.
-    Intro H. Rewrite H. Unfold negb. Rewrite andb_b_true. Reflexivity.
-  Qed.
-
-End InDom.
-
-Definition FSet := (Map unit).
-
-Section FSetDefs.
-
-  Variable A : Set.
-
-  Definition in_FSet : ad -> FSet -> bool := (in_dom unit).
-
-  Fixpoint MapDom [m:(Map A)] : FSet :=
-    Cases m of
-      	M0 => (M0 unit)
-      | (M1 a _) => (M1 unit a tt)
-      | (M2 m m') => (M2 unit (MapDom m) (MapDom m'))
-    end.
-
-  Lemma MapDom_semantics_1 : (m:(Map A)) (a:ad) 
-      (y:A) (MapGet A m a)=(SOME A y) -> (in_FSet a (MapDom m))=true.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0 y0.
-    Case (ad_eq a a0). Trivial.
-    Intro. Discriminate H.
-    Intros m0 H m1 H0 a y. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet.
-    Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a).
-    Case (ad_bit_0 a). Unfold in_FSet in_dom in H0. Intro. Apply H0 with y:=y. Assumption.
-    Unfold in_FSet in_dom in H. Intro. Apply H with y:=y. Assumption.
-  Qed.
-
-  Lemma MapDom_semantics_2 : (m:(Map A)) (a:ad) 
-      (in_FSet a (MapDom m))=true -> {y:A | (MapGet A m a)=(SOME A y)}.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0. Case (ad_eq a a0).
-    Intro. Split with y. Reflexivity.
-    Intro. Discriminate H.
-    Intros m0 H m1 H0 a. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet.
-    Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a).
-    Case (ad_bit_0 a). Unfold in_FSet in_dom in H0. Intro. Apply H0. Assumption.
-    Unfold in_FSet in_dom in H. Intro. Apply H. Assumption.
-  Qed.
-
-  Lemma MapDom_semantics_3 : (m:(Map A)) (a:ad) 
-      (MapGet A m a)=(NONE A) -> (in_FSet a (MapDom m))=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H0.
-    Elim (MapDom_semantics_2 m a H0). Intros y H1. Rewrite H in H1. Discriminate H1.
-    Trivial.
-  Qed.
-
-  Lemma MapDom_semantics_4 : (m:(Map A)) (a:ad) 
-      (in_FSet a (MapDom m))=false -> (MapGet A m a)=(NONE A).
-  Proof.
-    Intros. Elim (option_sum A (MapGet A m a)). Intro H0. Elim H0. Intros y H1.
-    Rewrite (MapDom_semantics_1 m a y H1) in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma MapDom_Dom : (m:(Map A)) (a:ad) (in_dom A a m)=(in_FSet a (MapDom m)).
-  Proof.
-    Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H.
-    Elim (MapDom_semantics_2 m a H). Intros y H0. Rewrite H. Unfold in_dom. Rewrite H0.
-    Reflexivity.
-    Intro H. Rewrite H. Unfold in_dom. Rewrite (MapDom_semantics_4 m a H). Reflexivity.
-  Qed.
-
-  Definition FSetUnion : FSet -> FSet -> FSet := [s,s':FSet] (MapMerge unit s s').
-
-  Lemma in_FSet_union : (s,s':FSet) (a:ad)
-      (in_FSet a (FSetUnion s s'))=(orb (in_FSet a s) (in_FSet a s')).
-  Proof.
-    Exact (in_dom_merge unit).
-  Qed.
-
-  Definition FSetInter : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrTo unit unit s s').
-
-  Lemma in_FSet_inter : (s,s':FSet) (a:ad)
-      (in_FSet a (FSetInter s s'))=(andb (in_FSet a s) (in_FSet a s')).
-  Proof.
-    Exact (in_dom_restrto unit unit).
-  Qed.
-
-  Definition FSetDiff : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrBy unit unit s s').
-
-  Lemma in_FSet_diff : (s,s':FSet) (a:ad)
-      (in_FSet a (FSetDiff s s'))=(andb (in_FSet a s) (negb (in_FSet a s'))).
-  Proof.
-    Exact (in_dom_restrby unit unit).
-  Qed.
-
-  Definition FSetDelta : FSet -> FSet -> FSet := [s,s':FSet] (MapDelta unit s s').
-
-  Lemma in_FSet_delta : (s,s':FSet) (a:ad)
-      (in_FSet a (FSetDelta s s'))=(xorb (in_FSet a s) (in_FSet a s')).
-  Proof.
-    Exact (in_dom_delta unit).
-  Qed.
-
-End FSetDefs.
-
-Lemma FSet_Dom : (s:FSet) (MapDom unit s)=s.
-Proof.
-  Induction s. Trivial.
-  Simpl. Intros a t. Elim t. Reflexivity.
-  Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
-Qed.
diff --git a/theories7/IntMap/Lsort.v b/theories7/IntMap/Lsort.v
deleted file mode 100644
index 31b71c62..00000000
--- a/theories7/IntMap/Lsort.v
+++ /dev/null
@@ -1,537 +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: Lsort.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
-
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require PolyList.
-Require Mapiter.
-
-Section LSort.
-
-  Variable A : Set.
-
-  Fixpoint ad_less_1 [a,a':ad; p:positive] : bool :=
-    Cases p of
-        (xO p') => (ad_less_1 (ad_div_2 a) (ad_div_2 a') p')
-      | _ => (andb (negb (ad_bit_0 a)) (ad_bit_0 a'))
-    end.
-
-  Definition ad_less := [a,a':ad] Cases (ad_xor a a') of
-      	                              ad_z => false
-				    | (ad_x p) => (ad_less_1 a a' p)
-				  end.
-
-  Lemma ad_bit_0_less : (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> 
-      (ad_less a a')=true.
-  Proof.
-    Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less.
-    Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
-    Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5.
-    Rewrite H in H5. Rewrite H0 in H5. Discriminate H5.
-    Rewrite H4. Reflexivity.
-    Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity.
-    Intro H1. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H2.
-    Rewrite H in H2. Rewrite H0 in H2. Discriminate H2.
-    Rewrite H1. Reflexivity.
-  Qed.
-
-  Lemma ad_bit_0_gt : (a,a':ad) (ad_bit_0 a)=true -> (ad_bit_0 a')=false -> 
-      (ad_less a a')=false.
-  Proof.
-    Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less.
-    Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
-    Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5.
-    Rewrite H in H5. Rewrite H0 in H5. Discriminate H5.
-    Rewrite H4. Reflexivity.
-    Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity.
-    Intro H1. Unfold ad_less. Rewrite H1. Reflexivity.
-  Qed.
-
-  Lemma ad_less_not_refl : (a:ad) (ad_less a a)=false.
-  Proof.
-    Intro. Unfold ad_less. Rewrite (ad_xor_nilpotent a). Reflexivity.
-  Qed.
-
-  Lemma ad_ind_double : 
-      (a:ad)(P:ad->Prop) (P ad_z) ->
-      	((a:ad) (P a) -> (P (ad_double a))) ->
-      	((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a).
-  Proof.
-    Intros; Elim a. Trivial.
-    Induction p. Intros. 
-    Apply (H1 (ad_x p0)); Trivial.
-    Intros; Apply (H0 (ad_x p0)); Trivial.
-    Intros; Apply (H1 ad_z); Assumption.
-  Qed.
-
-  Lemma ad_rec_double : 
-      (a:ad)(P:ad->Set) (P ad_z) ->
-      	((a:ad) (P a) -> (P (ad_double a))) ->
-      	((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a).
-  Proof.
-    Intros; Elim a. Trivial.
-    Induction p. Intros. 
-    Apply (H1 (ad_x p0)); Trivial.
-    Intros; Apply (H0 (ad_x p0)); Trivial.
-    Intros; Apply (H1 ad_z); Assumption.
-  Qed.
-
-  Lemma ad_less_def_1 : (a,a':ad) (ad_less (ad_double a) (ad_double a'))=(ad_less a a').
-  Proof.
-    Induction a. Induction a'. Reflexivity.
-    Trivial.
-    Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial).
-    Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity.
-    Trivial.
-  Qed.
-
-  Lemma ad_less_def_2 : (a,a':ad)
-      (ad_less (ad_double_plus_un a) (ad_double_plus_un a'))=(ad_less a a').
-  Proof.
-    Induction a. Induction a'. Reflexivity.
-    Trivial.
-    Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial).
-    Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity.
-    Trivial.
-  Qed.
-
-  Lemma ad_less_def_3 : (a,a':ad) (ad_less (ad_double a) (ad_double_plus_un a'))=true.
-  Proof.
-    Intros. Apply ad_bit_0_less. Apply ad_double_bit_0.
-    Apply ad_double_plus_un_bit_0.
-  Qed.
-
-  Lemma ad_less_def_4 : (a,a':ad) (ad_less (ad_double_plus_un a) (ad_double a'))=false.
-  Proof.
-    Intros. Apply ad_bit_0_gt. Apply ad_double_plus_un_bit_0.
-    Apply ad_double_bit_0.
-  Qed.
-
-  Lemma ad_less_z : (a:ad) (ad_less a ad_z)=false.
-  Proof.
-    Induction a. Reflexivity.
-    Unfold ad_less. Intro. Rewrite (ad_xor_neutral_right (ad_x p)). (Elim p; Trivial).
-  Qed.
-
-  Lemma ad_z_less_1 : (a:ad) (ad_less ad_z a)=true -> {p:positive | a=(ad_x p)}.
-  Proof.
-    Induction a. Intro. Discriminate H.
-    Intros. Split with p. Reflexivity.
-  Qed.
-
-  Lemma ad_z_less_2 : (a:ad) (ad_less ad_z a)=false -> a=ad_z.
-  Proof.
-    Induction a. Trivial.
-    Unfold ad_less. Simpl. Cut (p:positive)(ad_less_1 ad_z (ad_x p) p)=false->False.
-    Intros. Elim (H p H0).
-    Induction p. Intros. Discriminate H0.
-    Intros. Exact (H H0).
-    Intro. Discriminate H.
-  Qed.
-
-  Lemma ad_less_trans : (a,a',a'':ad)
-      (ad_less a a')=true -> (ad_less a' a'')=true -> (ad_less a a'')=true.
-  Proof.
-    Intro a. Apply ad_ind_double with P:=[a:ad]
-          (a',a'':ad)
-           (ad_less a a')=true
-            ->(ad_less a' a'')=true->(ad_less a a'')=true.
-    Intros. Elim (sumbool_of_bool (ad_less ad_z a'')). Trivial.
-    Intro H1. Rewrite (ad_z_less_2 a'' H1) in H0. Rewrite (ad_less_z a') in H0. Discriminate H0.
-    Intros a0 H a'. Apply ad_ind_double with P:=[a':ad]
-          (a'':ad)
-           (ad_less (ad_double a0) a')=true
-            ->(ad_less a' a'')=true->(ad_less (ad_double a0) a'')=true.
-    Intros. Rewrite (ad_less_z (ad_double a0)) in H0. Discriminate H0.
-    Intros a1 H0 a'' H1. Rewrite (ad_less_def_1 a0 a1) in H1.
-    Apply ad_ind_double with P:=[a'':ad]
-          (ad_less (ad_double a1) a'')=true
-           ->(ad_less (ad_double a0) a'')=true.
-    Intro. Rewrite (ad_less_z (ad_double a1)) in H2. Discriminate H2.
-    Intros. Rewrite (ad_less_def_1 a1 a2) in H3. Rewrite (ad_less_def_1 a0 a2).
-    Exact (H a1 a2 H1 H3).
-    Intros. Apply ad_less_def_3.
-    Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad]
-          (ad_less (ad_double_plus_un a1) a'')=true
-           ->(ad_less (ad_double a0) a'')=true.
-    Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2.
-    Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3.
-    Intros. Apply ad_less_def_3.
-    Intros a0 H a'. Apply ad_ind_double with P:=[a':ad]
-          (a'':ad)
-           (ad_less (ad_double_plus_un a0) a')=true
-            ->(ad_less a' a'')=true
-               ->(ad_less (ad_double_plus_un a0) a'')=true.
-    Intros. Rewrite (ad_less_z (ad_double_plus_un a0)) in H0. Discriminate H0.
-    Intros. Rewrite (ad_less_def_4 a0 a1) in H1. Discriminate H1.
-    Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad]
-          (ad_less (ad_double_plus_un a1) a'')=true
-           ->(ad_less (ad_double_plus_un a0) a'')=true.
-    Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2.
-    Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3.
-    Rewrite (ad_less_def_2 a0 a1) in H1. Intros. Rewrite (ad_less_def_2 a1 a2) in H3.
-    Rewrite (ad_less_def_2 a0 a2). Exact (H a1 a2 H1 H3).
-  Qed.
-
-  Fixpoint alist_sorted [l:(alist A)] : bool :=
-    Cases l of
-      	nil => true
-      | (cons (a, _) l') => Cases l' of
-                                nil => true
-			      | (cons (a', y') l'') => (andb (ad_less a a')
-			                                     (alist_sorted l'))
-			    end
-    end.
-
-  Fixpoint alist_nth_ad [n:nat; l:(alist A)] : ad :=
-    Cases l of
-      	nil => ad_z (* dummy *)
-      | (cons (a, y) l') => Cases n of
-                                O => a
-			      | (S n') => (alist_nth_ad n' l')
-			    end
-    end.
-
-  Definition alist_sorted_1 := [l:(alist A)]
-      (n:nat) (le (S (S n)) (length l)) ->
-      	(ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l))=true.
-
-  Lemma alist_sorted_imp_1 : (l:(alist A)) (alist_sorted l)=true -> (alist_sorted_1 l).
-  Proof.
-    Unfold alist_sorted_1. Induction l. Intros. Elim (le_Sn_O (S n) H0).
-    Intro r. Elim r. Intros a y. Induction l0. Intros. Simpl in H1.
-    Elim (le_Sn_O n (le_S_n (S n) O H1)).
-    Intro r0. Elim r0. Intros a0 y0. Induction n. Intros. Simpl. Simpl in H1.
-    Exact (proj1 ? ? (andb_prop ? ? H1)).
-    Intros. Change (ad_less (alist_nth_ad n0 (cons (a0,y0) l1))
-      	                    (alist_nth_ad (S n0) (cons (a0,y0) l1)))=true.
-    Apply H0. Exact (proj2 ? ? (andb_prop ? ? H1)).
-    Apply le_S_n. Exact H3.
-  Qed.
-
-  Definition alist_sorted_2 := [l:(alist A)]
-    (m,n:nat) (lt m n) -> (le (S n) (length l)) ->
-      	(ad_less (alist_nth_ad m l) (alist_nth_ad n l))=true.
-
-  Lemma alist_sorted_1_imp_2 : (l:(alist A)) (alist_sorted_1 l) -> (alist_sorted_2 l).
-  Proof.
-    Unfold alist_sorted_1 alist_sorted_2 lt. Intros l H m n H0. Elim H0. Exact (H m).
-    Intros. Apply ad_less_trans with a':=(alist_nth_ad m0 l). Apply H2. Apply le_trans_S.
-    Assumption.
-    Apply H. Assumption.
-  Qed.
-
-  Lemma alist_sorted_2_imp : (l:(alist A)) (alist_sorted_2 l) -> (alist_sorted l)=true.
-  Proof.
-    Unfold alist_sorted_2 lt. Induction l. Trivial.
-    Intro r. Elim r. Intros a y. Induction l0. Trivial.
-    Intro r0. Elim r0. Intros a0 y0. Intros.
-    Change (andb (ad_less a a0) (alist_sorted (cons (a0,y0) l1)))=true.
-    Apply andb_true_intro. Split. Apply (H1 (0) (1)). Apply le_n.
-    Simpl. Apply le_n_S. Apply le_n_S. Apply le_O_n.
-    Apply H0. Intros. Apply (H1 (S m) (S n)). Apply le_n_S. Assumption.
-    Exact (le_n_S ? ? H3).
-  Qed.
-
-  Lemma app_length : (C:Set) (l,l':(list C)) (length (app l l'))=(plus (length l) (length l')).
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite (H l'). Reflexivity.
-  Qed.
-
-  Lemma aapp_length : (l,l':(alist A)) (length (aapp A l l'))=(plus (length l) (length l')).
-  Proof.
-    Exact (app_length ad*A).
-  Qed.
-
-  Lemma alist_nth_ad_aapp_1 : (l,l':(alist A)) (n:nat)
-      (le (S n) (length l)) -> (alist_nth_ad n (aapp A l l'))=(alist_nth_ad n l).
-  Proof.
-    Induction l. Intros. Elim (le_Sn_O n H).
-    Intro r. Elim r. Intros a y l' H l''. Induction n. Trivial.
-    Intros. Simpl. Apply H. Apply le_S_n. Exact H1.
-  Qed.
-
-  Lemma alist_nth_ad_aapp_2 : (l,l':(alist A)) (n:nat)
-      (le (S n) (length l')) ->
-      	(alist_nth_ad (plus (length l) n) (aapp A l l'))=(alist_nth_ad n l').
-  Proof.
-    Induction l. Trivial.
-    Intro r. Elim r. Intros a y l' H l'' n H0. Simpl. Apply H. Exact H0.
-  Qed.
-
-  Lemma interval_split : (p,q,n:nat) (le (S n) (plus p q)) ->
-      {n' : nat | (le (S n') q) /\ n=(plus p n')}+{(le (S n) p)}.
-  Proof.
-    Induction p. Simpl. Intros. Left . Split with n. (Split; [ Assumption | Reflexivity ]).
-    Intros p' H q. Induction n. Intros. Right . Apply le_n_S. Apply le_O_n.
-    Intros. Elim (H ? ? (le_S_n ? ? H1)). Intro H2. Left . Elim H2. Intros n' H3.
-    Elim H3. Intros H4 H5. Split with n'. (Split; [ Assumption | Rewrite H5; Reflexivity ]).
-    Intro H2. Right . Apply le_n_S. Assumption.
-  Qed.
-
-  Lemma alist_conc_sorted : (l,l':(alist A)) (alist_sorted_2 l) -> (alist_sorted_2 l') ->
-      ((n,n':nat) (le (S n) (length l)) -> (le (S n') (length l')) ->
-      	  (ad_less (alist_nth_ad n l) (alist_nth_ad n' l'))=true) ->
-      	(alist_sorted_2 (aapp A l l')).
-  Proof.
-    Unfold alist_sorted_2 lt. Intros. Rewrite (aapp_length l l') in H3.
-    Elim (interval_split (length l) (length l') m
-            (le_trans ? ? ? (le_n_S ? ? (lt_le_weak m n H2)) H3)).
-    Intro H4. Elim H4. Intros m' H5. Elim H5. Intros. Rewrite H7.
-    Rewrite (alist_nth_ad_aapp_2 l l' m' H6). Elim (interval_split (length l) (length l') n H3).
-    Intro H8. Elim H8. Intros n' H9. Elim H9. Intros. Rewrite H11.
-    Rewrite (alist_nth_ad_aapp_2 l l' n' H10). Apply H0. Rewrite H7 in H2. Rewrite H11 in H2.
-    Change (le (plus (S (length l)) m') (plus (length l) n')) in H2.
-    Rewrite (plus_Snm_nSm (length l) m') in H2. Exact (simpl_le_plus_l (length l) (S m') n' H2).
-    Exact H10.
-    Intro H8. Rewrite H7 in H2. Cut (le (S (length l)) (length l)). Intros. Elim (le_Sn_n ? H9).
-    Apply le_trans with m:=(S n). Apply le_n_S. Apply le_trans with m:=(S (plus (length l) m')).
-    Apply le_trans with m:=(plus (length l) m'). Apply le_plus_l.
-    Apply le_n_Sn.
-    Exact H2.
-    Exact H8.
-    Intro H4. Rewrite (alist_nth_ad_aapp_1 l l' m H4).
-    Elim (interval_split (length l) (length l') n H3). Intro H5. Elim H5. Intros n' H6. Elim H6.
-    Intros. Rewrite H8. Rewrite (alist_nth_ad_aapp_2 l l' n' H7). Exact (H1 m n' H4 H7).
-    Intro H5. Rewrite (alist_nth_ad_aapp_1 l l' n H5). Exact (H m n H2 H5).
-  Qed.
-
-  Lemma alist_nth_ad_semantics : (l:(alist A)) (n:nat) (le (S n) (length l)) ->
-      {y:A | (alist_semantics A l (alist_nth_ad n l))=(SOME A y)}.
-  Proof.
-    Induction l. Intros. Elim (le_Sn_O ? H).
-    Intro r. Elim r. Intros a y l0 H. Induction n. Simpl. Intro. Split with y.
-    Rewrite (ad_eq_correct a). Reflexivity.
-    Intros. Elim (H ? (le_S_n ? ? H1)). Intros y0 H2.
-    Elim (sumbool_of_bool (ad_eq a (alist_nth_ad n0 l0))). Intro H3. Split with y.
-    Rewrite (ad_eq_complete ? ? H3). Simpl. Rewrite (ad_eq_correct (alist_nth_ad n0 l0)).
-    Reflexivity.
-    Intro H3. Split with y0. Simpl. Rewrite H3. Assumption.
-  Qed.
-
-  Lemma alist_of_Map_nth_ad : (m:(Map A)) (pf:ad->ad)
-      (l:(alist A)) l=(MapFold1 A (alist A) (anil A) (aapp A)
-                                [a0:ad][y:A](acons A (a0,y) (anil A)) pf m) ->
-      	(n:nat) (le (S n) (length l)) -> {a':ad | (alist_nth_ad n l)=(pf a')}.
-  Proof.
-    Intros. Elim (alist_nth_ad_semantics l n H0). Intros y H1.
-    Apply (alist_of_Map_semantics_1_1 A m pf (alist_nth_ad n l) y).
-    Rewrite <- H. Assumption.
-  Qed.
-
-  Definition ad_monotonic := [pf:ad->ad] (a,a':ad)
-      (ad_less a a')=true -> (ad_less (pf a) (pf a'))=true.
-
-  Lemma ad_double_monotonic : (ad_monotonic ad_double).
-  Proof.
-    Unfold ad_monotonic. Intros. Rewrite ad_less_def_1. Assumption.
-  Qed.
-
-  Lemma ad_double_plus_un_monotonic : (ad_monotonic ad_double_plus_un).
-  Proof.
-    Unfold ad_monotonic. Intros. Rewrite ad_less_def_2. Assumption.
-  Qed.
-
-  Lemma ad_comp_monotonic : (pf,pf':ad->ad) (ad_monotonic pf) -> (ad_monotonic pf') ->
-      (ad_monotonic [a0:ad] (pf (pf' a0))).
-  Proof.
-    Unfold ad_monotonic. Intros. Apply H. Apply H0. Exact H1.
-  Qed.
-
-  Lemma ad_comp_double_monotonic : (pf:ad->ad) (ad_monotonic pf) ->
-      (ad_monotonic [a0:ad] (pf (ad_double a0))).
-  Proof.
-    Intros. Apply ad_comp_monotonic. Assumption.
-    Exact ad_double_monotonic.
-  Qed.
-
-  Lemma ad_comp_double_plus_un_monotonic : (pf:ad->ad) (ad_monotonic pf) ->
-      (ad_monotonic [a0:ad] (pf (ad_double_plus_un a0))).
-  Proof.
-    Intros. Apply ad_comp_monotonic. Assumption.
-    Exact ad_double_plus_un_monotonic.
-  Qed.
-
-  Lemma alist_of_Map_sorts_1 : (m:(Map A)) (pf:ad->ad) (ad_monotonic pf) ->
-      (alist_sorted_2 (MapFold1 A (alist A) (anil A) (aapp A)
-                                [a:ad][y:A](acons A (a,y) (anil A)) pf m)).
-  Proof.
-    Induction m. Simpl. Intros. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity.
-    Intros. Simpl. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity.
-    Intros. Simpl. Apply alist_conc_sorted.
-    Exact (H [a0:ad](pf (ad_double a0)) (ad_comp_double_monotonic pf H1)).
-    Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_comp_double_plus_un_monotonic pf H1)).
-    Intros. Elim (alist_of_Map_nth_ad m0 [a0:ad](pf (ad_double a0))
-       (MapFold1 A (alist A) (anil A) (aapp A)
-         [a0:ad][y:A](acons A (a0,y) (anil A))
-         [a0:ad](pf (ad_double a0)) m0) (refl_equal ? ?) n H2).
-    Intros a H4. Rewrite H4. Elim (alist_of_Map_nth_ad m1 [a0:ad](pf (ad_double_plus_un a0))
-       (MapFold1 A (alist A) (anil A) (aapp A)
-         [a0:ad][y:A](acons A (a0,y) (anil A))
-         [a0:ad](pf (ad_double_plus_un a0)) m1) (refl_equal ? ?) n' H3).
-    Intros a' H5. Rewrite H5. Unfold ad_monotonic in H1. Apply H1. Apply ad_less_def_3.
-  Qed.
-
-  Lemma alist_of_Map_sorts : (m:(Map A)) (alist_sorted (alist_of_Map A m))=true.
-  Proof.
-    Intro. Apply alist_sorted_2_imp.
-    Exact (alist_of_Map_sorts_1 m [a0:ad]a0 [a,a':ad][p:(ad_less a a')=true]p).
-  Qed.
-
-  Lemma alist_of_Map_sorts1 : (m:(Map A)) (alist_sorted_1 (alist_of_Map A m)).
-  Proof.
-    Intro. Apply alist_sorted_imp_1. Apply alist_of_Map_sorts.
-  Qed.
- 
-  Lemma alist_of_Map_sorts2 : (m:(Map A)) (alist_sorted_2 (alist_of_Map A m)).
-  Proof.
-    Intro. Apply alist_sorted_1_imp_2. Apply alist_of_Map_sorts1.
-  Qed.
- 
-  Lemma ad_less_total : (a,a':ad) {(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}.
-  Proof.
-    Intro a. Refine (ad_rec_double a [a:ad] (a':ad){(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}
-                            ? ? ?).
-    Intro. Elim (sumbool_of_bool (ad_less ad_z a')). Intro H. Left . Left . Assumption.
-    Intro H. Right . Rewrite (ad_z_less_2 a' H). Reflexivity.
-    Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double a0) a')=true}
-                                 +{(ad_less a' (ad_double a0))=true}+{(ad_double a0)=a'} ? ? ?).
-    Elim (sumbool_of_bool (ad_less ad_z (ad_double a0))). Intro H0. Left . Right . Assumption.
-    Intro H0. Right . Exact (ad_z_less_2 ? H0).
-    Intros a1 H0. Rewrite ad_less_def_1. Rewrite ad_less_def_1. Elim (H a1). Intro H1.
-    Left . Assumption.
-    Intro H1. Right . Rewrite H1. Reflexivity.
-    Intros a1 H0. Left . Left . Apply ad_less_def_3.
-    Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double_plus_un a0) a')=true}
-                                 +{(ad_less a' (ad_double_plus_un a0))=true}
-                                 +{(ad_double_plus_un a0)=a'} ? ? ?).
-    Left . Right . (Case a0; Reflexivity).
-    Intros a1 H0. Left . Right . Apply ad_less_def_3.
-    Intros a1 H0. Rewrite ad_less_def_2. Rewrite ad_less_def_2. Elim (H a1). Intro H1.
-    Left . Assumption.
-    Intro H1. Right . Rewrite H1. Reflexivity.
-  Qed.
-
-  Lemma alist_too_low : (l:(alist A)) (a,a':ad) (y:A)
-      (ad_less a a')=true -> (alist_sorted_2 (cons (a',y) l)) ->
-      	(alist_semantics A (cons (a',y) l) a)=(NONE A).
-  Proof.
-    Induction l. Intros. Simpl. Elim (sumbool_of_bool (ad_eq a' a)). Intro H1.
-    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_less_not_refl a) in H. Discriminate H.
-    Intro H1. Rewrite H1. Reflexivity.
-    Intro r. Elim r. Intros a y l0 H a0 a1 y0 H0 H1.
-    Change (Case (ad_eq a1 a0) of
-               (SOME A y0)
-               (alist_semantics A (cons (a,y) l0) a0)
-               end)=(NONE A).
-    Elim (sumbool_of_bool (ad_eq a1 a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0.
-    Rewrite (ad_less_not_refl a0) in H0. Discriminate H0.
-    Intro H2. Rewrite H2. Apply H. Apply ad_less_trans with a':=a1. Assumption.
-    Unfold alist_sorted_2 in H1. Apply (H1 (0) (1)). Apply lt_n_Sn.
-    Simpl. Apply le_n_S. Apply le_n_S. Apply le_O_n.
-    Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1.
-    Cut (alist_sorted (cons (a1,y0) (cons (a,y) l0)))=true. Intro H3.
-    Exact (proj2 ? ? (andb_prop ? ? H3)).
-    Apply alist_sorted_2_imp. Assumption.
-  Qed.
-
-  Lemma alist_semantics_nth_ad : (l:(alist A)) (a:ad) (y:A)
-      (alist_semantics A l a)=(SOME A y) ->
-      	{n:nat | (le (S n) (length l)) /\ (alist_nth_ad n l)=a}.
-  Proof.
-    Induction l. Intros. Discriminate H.
-    Intro r. Elim r. Intros a y l0 H a0 y0 H0. Simpl in H0. Elim (sumbool_of_bool (ad_eq a a0)).
-    Intro H1. Rewrite H1 in H0. Split with O. Split. Simpl. Apply le_n_S. Apply le_O_n.
-    Simpl. Exact (ad_eq_complete ? ? H1).
-    Intro H1. Rewrite H1 in H0. Elim (H a0 y0 H0). Intros n' H2. Split with (S n'). Split.
-    Simpl. Apply le_n_S. Exact (proj1 ? ? H2).
-    Exact (proj2 ? ? H2).
-  Qed.
-
-  Lemma alist_semantics_tail : (l:(alist A)) (a:ad) (y:A)
-      (alist_sorted_2 (cons (a,y) l)) ->
-      	(eqm A (alist_semantics A l) [a0:ad] if (ad_eq a a0)
-                                             then (NONE A)
-					     else (alist_semantics A (cons (a,y) l) a0)).
-  Proof.
-    Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
-    Rewrite <- (ad_eq_complete ? ? H0). Unfold alist_sorted_2 in H.
-    Elim (option_sum A (alist_semantics A l a)). Intro H1. Elim H1. Intros y0 H2.
-    Elim (alist_semantics_nth_ad l a y0 H2). Intros n H3. Elim H3. Intros.
-    Cut (ad_less (alist_nth_ad (0) (cons (a,y) l)) (alist_nth_ad (S n) (cons (a,y) l)))=true.
-    Intro. Simpl in H6. Rewrite H5 in H6. Rewrite (ad_less_not_refl a) in H6. Discriminate H6.
-    Apply H. Apply lt_O_Sn.
-    Simpl. Apply le_n_S. Assumption.
-    Trivial.
-    Intro H0. Simpl. Rewrite H0. Reflexivity.
-  Qed.
-
-  Lemma alist_semantics_same_tail : (l,l':(alist A)) (a:ad) (y:A)
-      (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 (cons (a,y) l')) ->
-      	(eqm A (alist_semantics A (cons (a,y) l)) (alist_semantics A (cons (a,y) l'))) ->
-	  (eqm A (alist_semantics A l) (alist_semantics A l')).
-  Proof.
-    Unfold eqm. Intros. Rewrite (alist_semantics_tail ? ? ? H a0).
-    Rewrite (alist_semantics_tail ? ? ? H0 a0). Case (ad_eq a a0). Reflexivity.
-    Exact (H1 a0).
-  Qed.
-
-  Lemma alist_sorted_tail : (l:(alist A)) (a:ad) (y:A)
-      (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 l).
-  Proof.
-    Unfold alist_sorted_2. Intros. Apply (H (S m) (S n)). Apply lt_n_S. Assumption.
-    Simpl. Apply le_n_S. Assumption.
-  Qed.
-
-  Lemma alist_canonical : (l,l':(alist A))
-      (eqm A (alist_semantics A l) (alist_semantics A l')) ->
-      	(alist_sorted_2 l) -> (alist_sorted_2 l') -> l=l'.
-  Proof.
-    Unfold eqm. Induction l. Induction l'. Trivial.
-    Intro r. Elim r. Intros a y l0 H H0 H1 H2. Simpl in H0.
-    Cut (NONE A)=(Case (ad_eq a a) of (SOME A y)
-                           (alist_semantics A l0 a)
-                           end).
-    Rewrite (ad_eq_correct a). Intro. Discriminate H3.
-    Exact (H0 a).
-    Intro r. Elim r. Intros a y l0 H. Induction l'. Intros. Simpl in H0.
-    Cut (Case (ad_eq a a) of (SOME A y)
-                         (alist_semantics A l0 a)
-                         end)=(NONE A).
-    Rewrite (ad_eq_correct a). Intro. Discriminate H3.
-    Exact (H0 a).
-    Intro r'. Elim r'. Intros a' y' l'0 H0 H1 H2 H3. Elim (ad_less_total a a'). Intro H4.
-    Elim H4. Intro H5.
-    Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a).
-    Intro. Rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. Simpl in H6.
-    Rewrite (ad_eq_correct a) in H6. Discriminate H6.
-    Exact (H1 a).
-    Intro H5. Cut (alist_semantics A (cons (a,y) l0) a')=(alist_semantics A (cons (a',y') l'0) a').
-    Intro. Rewrite (alist_too_low l0 a' a y H5 H2) in H6. Simpl in H6.
-    Rewrite (ad_eq_correct a') in H6. Discriminate H6.
-    Exact (H1 a').
-    Intro H4. Rewrite H4.
-    Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a).
-    Intro. Simpl in H5. Rewrite H4 in H5. Rewrite (ad_eq_correct a') in H5. Inversion H5.
-    Rewrite H4 in H1. Rewrite H7 in H1. Cut l0=l'0. Intro. Rewrite H6. Reflexivity.
-    Apply H. Rewrite H4 in H2. Rewrite H7 in H2.
-    Exact (alist_semantics_same_tail l0 l'0 a' y' H2 H3 H1).
-    Exact (alist_sorted_tail ? ? ? H2).
-    Exact (alist_sorted_tail ? ? ? H3).
-    Exact (H1 a).
-  Qed.
-
-End LSort.
diff --git a/theories7/IntMap/Map.v b/theories7/IntMap/Map.v
deleted file mode 100644
index 00ba3f8a..00000000
--- a/theories7/IntMap/Map.v
+++ /dev/null
@@ -1,786 +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: Map.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
-
-(** Definition of finite sets as trees indexed by adresses *)
-
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-
-
-Section MapDefs.
-
-(** We define maps from ad to A. *)
-  Variable A : Set.  
-
-  Inductive Map : Set :=
-      M0 : Map
-    | M1 : ad -> A -> Map
-    | M2 : Map -> Map -> Map.
-
-  Inductive option : Set :=
-      NONE : option
-    | SOME : A -> option.
-
-  Lemma option_sum : (o:option) {y:A | o=(SOME y)}+{o=NONE}.
-  Proof.
-    Induction o. Right . Reflexivity.
-    Left . Split with a. Reflexivity.
-  Qed.
-
-  (** The semantics of maps is given by the function [MapGet].
-      The semantics of a map [m] is a partial, finite function from
-      [ad] to [A]: *)
-
-  Fixpoint MapGet [m:Map] : ad -> option :=
-    Cases m of
-        M0 => [a:ad] NONE
-      | (M1 x y) => [a:ad]
-          if (ad_eq x a)
-	     then (SOME y)
-	  else NONE
-      | (M2 m1 m2) => [a:ad]
-          Cases a of
-	      ad_z => (MapGet m1 ad_z)
-	    | (ad_x xH) => (MapGet m2 ad_z)
-	    | (ad_x (xO p)) => (MapGet m1 (ad_x p))
-	    | (ad_x (xI p)) => (MapGet m2 (ad_x p))
-	  end
-    end.
-
-  Definition newMap := M0.
-
-  Definition MapSingleton := M1.
-
-  Definition eqm := [g,g':ad->option] (a:ad) (g a)=(g' a).
-
-  Lemma newMap_semantics : (eqm (MapGet newMap) [a:ad] NONE).
-  Proof.
-    Simpl. Unfold eqm. Trivial.
-  Qed.
-
-  Lemma MapSingleton_semantics : (a:ad) (y:A)
-      (eqm (MapGet (MapSingleton a y)) [a':ad] if (ad_eq a a') then (SOME y) else NONE).
-  Proof.
-    Simpl. Unfold eqm. Trivial.
-  Qed.
-
-  Lemma M1_semantics_1 : (a:ad) (y:A) (MapGet (M1 a y) a)=(SOME y).
-  Proof.
-    Unfold MapGet. Intros. Rewrite (ad_eq_correct a). Reflexivity.
-  Qed.
-
-  Lemma M1_semantics_2 :
-      (a,a':ad) (y:A) (ad_eq a a')=false -> (MapGet (M1 a y) a')=NONE.
-  Proof.
-    Intros. Simpl. Rewrite H. Reflexivity.
-  Qed.
-
-  Lemma Map2_semantics_1 :
-      (m,m':Map) (eqm (MapGet m) [a:ad] (MapGet (M2 m m') (ad_double a))).
-  Proof.
-    Unfold eqm. Induction a; Trivial.
-  Qed.
-
-  Lemma Map2_semantics_1_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f)
-      -> (eqm (MapGet m) [a:ad] (f (ad_double a))).
-  Proof.
-    Unfold eqm.
-    Intros.
-    Rewrite <- (H (ad_double a)).
-    Exact (Map2_semantics_1 m m' a).
-  Qed.
-
-  Lemma Map2_semantics_2 :
-      (m,m':Map) (eqm (MapGet m') [a:ad] (MapGet (M2 m m') (ad_double_plus_un a))).
-  Proof.
-    Unfold eqm. Induction a; Trivial.
-  Qed.
-
-  Lemma Map2_semantics_2_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f)
-      -> (eqm (MapGet m') [a:ad] (f (ad_double_plus_un a))).
-  Proof.
-    Unfold eqm.
-    Intros.
-    Rewrite <- (H (ad_double_plus_un a)).
-    Exact (Map2_semantics_2 m m' a).
-  Qed.
-
-  Lemma MapGet_M2_bit_0_0 : (a:ad) (ad_bit_0 a)=false
-      -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m (ad_div_2 a)).
-  Proof.
-    Induction a; Trivial. Induction p. Intros. Discriminate H0.
-    Trivial.
-    Intros. Discriminate H.
-  Qed.
-
-  Lemma MapGet_M2_bit_0_1 : (a:ad) (ad_bit_0 a)=true
-      -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m' (ad_div_2 a)).
-  Proof.
-    Induction a. Intros. Discriminate H.
-    Induction p. Trivial.
-    Intros. Discriminate H0.
-    Trivial.
-  Qed.
-
-  Lemma MapGet_M2_bit_0_if : (m,m':Map) (a:ad) (MapGet (M2 m m') a)=
-      (if (ad_bit_0 a) then (MapGet m' (ad_div_2 a)) else (MapGet m (ad_div_2 a))).
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H.
-    Apply MapGet_M2_bit_0_1; Assumption.
-    Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption.
-  Qed.
-
-  Lemma MapGet_M2_bit_0 : (m,m',m'':Map)
-      (a:ad) (if (ad_bit_0 a) then (MapGet (M2 m' m) a) else (MapGet (M2 m m'') a))=
-             (MapGet m (ad_div_2 a)).
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H.
-    Apply MapGet_M2_bit_0_1; Assumption.
-    Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption.
-  Qed.
-
-  Lemma Map2_semantics_3 : (m,m':Map) (eqm (MapGet (M2 m m'))
-      [a:ad] Cases (ad_bit_0 a) of
-                 false => (MapGet m (ad_div_2 a))
-	       | true => (MapGet m' (ad_div_2 a))
-	     end).
-  Proof.
-    Unfold eqm.
-    Induction a; Trivial.
-    Induction p; Trivial.
-  Qed.
-
-  Lemma Map2_semantics_3_eq : (m,m':Map) (f,f':ad->option)
-      (eqm (MapGet m) f) -> (eqm (MapGet m') f') -> (eqm (MapGet (M2 m m'))
-      [a:ad] Cases (ad_bit_0 a) of
-                 false => (f (ad_div_2 a))
-	       | true => (f' (ad_div_2 a))
-	     end).
-  Proof.
-    Unfold eqm.
-    Intros.
-    Rewrite <- (H (ad_div_2 a)).
-    Rewrite <- (H0 (ad_div_2 a)).
-    Exact (Map2_semantics_3 m m' a).
-  Qed.
-
-  Fixpoint MapPut1 [a:ad; y:A; a':ad; y':A; p:positive] : Map :=
-    Cases p of
-        (xO p') => let m = (MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p') in
-      	           Cases (ad_bit_0 a) of
-      	               false => (M2 m M0)
-		     | true => (M2 M0 m)
-		   end
-      | _ => Cases (ad_bit_0 a) of
-                 false => (M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y'))
-	       | true => (M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y))
-	     end
-    end.
-
-  Lemma MapGet_if_commute : (b:bool) (m,m':Map) (a:ad)
-      (MapGet (if b then m else m') a)=(if b then (MapGet m a) else (MapGet m' a)).
-  Proof.
-    Intros. Case b; Trivial.
-  Qed.
-
-  (*i
-  Lemma MapGet_M2_bit_0_1' : (m,m',m'',m''':Map)
-      (a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m'' m''')) a)=
-             (MapGet (if (ad_bit_0 a) then m' else m'') (ad_div_2 a)).
-  Proof.
-    Intros. Rewrite (MapGet_if_commute (ad_bit_0 a)). Rewrite (MapGet_if_commute (ad_bit_0 a)).
-    Cut (ad_bit_0 a)=false\/(ad_bit_0 a)=true. Intros. Elim H. Intros. Rewrite H0.
-    Apply MapGet_M2_bit_0_0. Assumption.
-    Intros. Rewrite H0. Apply MapGet_M2_bit_0_1. Assumption.
-    Case (ad_bit_0 a); Auto.
-  Qed.
-  i*)
-
-  Lemma MapGet_if_same : (m:Map) (b:bool) (a:ad) 
-      (MapGet (if b then m else m) a)=(MapGet m a).
-  Proof.
-    Induction b;Trivial.
-  Qed.
-
-  Lemma MapGet_M2_bit_0_2 : (m,m',m'':Map)
-      (a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m' m'')) a)=
-             (MapGet m' (ad_div_2 a)).
-  Proof.
-    Intros. Rewrite MapGet_if_commute. Apply MapGet_M2_bit_0.
-  Qed.
-
-  Lemma MapPut1_semantics_1 : (p:positive) (a,a':ad) (y,y':A)
-      (ad_xor a a')=(ad_x p)
-      	-> (MapGet (MapPut1 a y a' y' p) a)=(SOME y).
-  Proof.
-    Induction p. Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
-    Intros. Simpl. Rewrite MapGet_M2_bit_0_2. Apply H. Rewrite <- ad_xor_div_2. Rewrite H0.
-    Reflexivity.
-    Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
-  Qed.
-
-  Lemma MapPut1_semantics_2 : (p:positive) (a,a':ad) (y,y':A)
-      (ad_xor a a')=(ad_x p)
-      	-> (MapGet (MapPut1 a y a' y' p) a')=(SOME y').
-  Proof.
-    Induction p. Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_2 a a' p0 H0).
-    Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
-    Intros. Simpl. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite MapGet_M2_bit_0_2.
-    Apply H. Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
-    Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite if_negb.
-    Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
-  Qed.
-
-  Lemma MapGet_M2_both_NONE : (m,m':Map) (a:ad)
-      (MapGet m (ad_div_2 a))=NONE -> (MapGet m' (ad_div_2 a))=NONE -> 
-        (MapGet (M2 m m') a)=NONE.
-  Proof.
-    Intros. Rewrite (Map2_semantics_3 m m' a). 
-    Case (ad_bit_0 a); Assumption.
-  Qed.
- 
-  Lemma MapPut1_semantics_3 : (p:positive) (a,a',a0:ad) (y,y':A)
-      	(ad_xor a a')=(ad_x p) -> (ad_eq a a0)=false -> (ad_eq a' a0)=false ->
-	  (MapGet (MapPut1 a y a' y' p) a0)=NONE.
-  Proof.
-    Induction p. Intros. Unfold MapPut1. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb.
-    Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption.
-    Rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. Rewrite (negb_intro (ad_bit_0 a')).
-    Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H3. Reflexivity.
-    Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_neg_bit_0_2 a a' p0 H0). Rewrite H4.
-    Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2.
-    Apply M1_semantics_2; Assumption.
-    Intro; Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; 
-	Apply M1_semantics_2; Assumption.
-    Intros. Simpl. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb.
-    Rewrite MapGet_M2_bit_0_2. Reflexivity.
-    Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite H4.
-    Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Reflexivity.
-    Intro. Cut (ad_xor (ad_div_2 a) (ad_div_2 a'))=(ad_x p0). Intro.
-    Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Trivial; 
-	Apply H; Assumption.
-    Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
-    Intros. Simpl. Elim (ad_neq a a0 H0). Intro. Rewrite H2. Rewrite if_negb.
-    Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption.
-    Rewrite (ad_neg_bit_0_1 a a' H) in H2. Rewrite (negb_intro (ad_bit_0 a')).
-    Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H2. Reflexivity.
-    Intro. Elim (ad_neq a' a0 H1). Intro. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite H3.
-    Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2.
-    Apply M1_semantics_2; Assumption.
-    Intro. Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Apply M1_semantics_2; Assumption.
-  Qed.
-
-  Lemma MapPut1_semantics : (p:positive) (a,a':ad) (y,y':A)
-      (ad_xor a a')=(ad_x p)
-        -> (eqm (MapGet (MapPut1 a y a' y' p))
-	        [a0:ad] if (ad_eq a a0) then (SOME y)
-		        else if (ad_eq a' a0) then (SOME y') else NONE).
-  Proof.
-    Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
-    Rewrite <- (ad_eq_complete ? ? H0). Exact (MapPut1_semantics_1 p a a' y y' H).
-    Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq a' a0)). Intro H1.
-    Rewrite <- (ad_eq_complete ? ? H1). Rewrite (ad_eq_correct a').
-    Exact (MapPut1_semantics_2 p a a' y y' H).
-    Intro H1. Rewrite H1. Exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1).
-  Qed.
-
-  Lemma MapPut1_semantics' : (p:positive) (a,a':ad) (y,y':A)
-      (ad_xor a a')=(ad_x p)
-        -> (eqm (MapGet (MapPut1 a y a' y' p))
-	        [a0:ad] if (ad_eq a' a0) then (SOME y')
-		        else if (ad_eq a a0) then (SOME y) else NONE).
-  Proof.
-    Unfold eqm. Intros. Rewrite (MapPut1_semantics p a a' y y' H a0).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
-    Rewrite <- (ad_eq_complete a a0 H0). Rewrite (ad_eq_comm a' a).
-    Rewrite (ad_xor_eq_false a a' p H). Reflexivity.
-    Intro H0. Rewrite H0. Reflexivity.
-  Qed.
-
-  Fixpoint MapPut [m:Map] : ad -> A -> Map :=
-    Cases m of
-        M0 => M1
-      | (M1 a y) => [a':ad; y':A]
-          Cases (ad_xor a a') of
-	      ad_z => (M1 a' y')
-	    | (ad_x p) => (MapPut1 a y a' y' p)
-          end
-      | (M2 m1 m2) => [a:ad; y:A]
-          Cases a of
-	      ad_z => (M2 (MapPut m1 ad_z y) m2)
-	    | (ad_x xH) => (M2 m1 (MapPut m2 ad_z y))
-	    | (ad_x (xO p)) => (M2 (MapPut m1 (ad_x p) y) m2)
-	    | (ad_x (xI p)) => (M2 m1 (MapPut m2 (ad_x p) y))
-	  end
-    end.
-
-  Lemma MapPut_semantics_1 : (a:ad) (y:A) (a0:ad)
-      (MapGet (MapPut M0 a y) a0)=(MapGet (M1 a y) a0).
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma MapPut_semantics_2_1 : (a:ad) (y,y':A) (a0:ad)
-      (MapGet (MapPut (M1 a y) a y') a0)=(if (ad_eq a a0) then (SOME y') else NONE).
-  Proof.
-    Simpl. Intros. Rewrite (ad_xor_nilpotent a). Trivial.
-  Qed.
-
-  Lemma MapPut_semantics_2_2 : (a,a':ad) (y,y':A) (a0:ad) (a'':ad) (ad_xor a a')=a'' ->
-      (MapGet (MapPut (M1 a y) a' y') a0)=
-      (if (ad_eq a' a0) then (SOME y') else
-       if (ad_eq a a0) then (SOME y) else NONE).
-  Proof.
-    Induction a''. Intro. Rewrite (ad_xor_eq ? ? H). Rewrite MapPut_semantics_2_1.
-    Case (ad_eq a' a0); Trivial.
-    Intros. Simpl. Rewrite H. Rewrite (MapPut1_semantics p a a' y y' H a0).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. Rewrite <- (ad_eq_complete ? ? H0).
-    Rewrite (ad_eq_comm a' a). Rewrite (ad_xor_eq_false ? ? ? H). Reflexivity.
-    Intro H0. Rewrite H0. Reflexivity.
-  Qed.
-
-  Lemma MapPut_semantics_2 : (a,a':ad) (y,y':A) (a0:ad)
-      (MapGet (MapPut (M1 a y) a' y') a0)=
-      (if (ad_eq a' a0) then (SOME y') else
-       if (ad_eq a a0) then (SOME y) else NONE).
-  Proof.
-    Intros. Apply MapPut_semantics_2_2 with a'':=(ad_xor a a'); Trivial.
-  Qed.
-
-  Lemma MapPut_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
-      (MapPut (M2 m m') a y)=(if (ad_bit_0 a) then (M2 m (MapPut m' (ad_div_2 a) y))
-                                              else (M2 (MapPut m (ad_div_2 a) y) m')).
-  Proof.
-    Induction a. Trivial.
-    Induction p; Trivial.
-  Qed.
-
-  Lemma MapPut_semantics : (m:Map) (a:ad) (y:A)
-      (eqm (MapGet (MapPut m a y)) [a':ad] if (ad_eq a a') then (SOME y) else (MapGet m a')).
-  Proof.
-    Unfold eqm. Induction m. Exact MapPut_semantics_1.
-    Intros. Unfold 2 MapGet. Apply MapPut_semantics_2; Assumption.
-    Intros. Rewrite MapPut_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a0).
-    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if.
-    Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite H2.
-    Rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). Elim (sumbool_of_bool (ad_eq a a0)).
-    Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity.
-    Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity.
-    Intro H2. Rewrite H2. Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq a0 a H2 H1).
-    Reflexivity.
-    Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)).
-    Intro H2. Rewrite H2. Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity.
-    Intro H2. Rewrite H2. Rewrite (H (ad_div_2 a) y (ad_div_2 a0)).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3.
-    Rewrite (ad_div_eq a a0 H3). Reflexivity.
-    Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq a a0 H3 H1). Reflexivity.
-  Qed.
-
-  Fixpoint MapPut_behind [m:Map] : ad -> A -> Map :=
-    Cases m of
-        M0 => M1
-      | (M1 a y) => [a':ad; y':A]
-          Cases (ad_xor a a') of
-	      ad_z => m
-	    | (ad_x p) => (MapPut1 a y a' y' p)
-          end
-      | (M2 m1 m2) => [a:ad; y:A]
-          Cases a of
-	      ad_z => (M2 (MapPut_behind m1 ad_z y) m2)
-	    | (ad_x xH) => (M2 m1 (MapPut_behind m2 ad_z y))
-	    | (ad_x (xO p)) => (M2 (MapPut_behind m1 (ad_x p) y) m2)
-	    | (ad_x (xI p)) => (M2 m1 (MapPut_behind m2 (ad_x p) y))
-	  end
-    end.
-
-  Lemma MapPut_behind_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
-      (MapPut_behind (M2 m m') a y)=
-      (if (ad_bit_0 a) then (M2 m (MapPut_behind m' (ad_div_2 a) y))
-                       else (M2 (MapPut_behind m (ad_div_2 a) y) m')).
-  Proof.
-    Induction a. Trivial.
-    Induction p; Trivial.
-  Qed.
-
-  Lemma MapPut_behind_as_before_1 : (a,a',a0:ad) (ad_eq a' a0)=false ->
-      (y,y':A) (MapGet (MapPut (M1 a y) a' y') a0)
-               =(MapGet (MapPut_behind (M1 a y) a' y') a0).
-  Proof.
-    Intros a a' a0. Simpl. Intros H y y'. Elim (ad_sum (ad_xor a a')). Intro H0. Elim H0.
-    Intros p H1. Rewrite H1. Reflexivity.
-    Intro H0. Rewrite H0. Rewrite (ad_xor_eq ? ? H0). Rewrite (M1_semantics_2 a' a0 y H).
-    Exact (M1_semantics_2 a' a0 y' H).
-  Qed.
-
-  Lemma MapPut_behind_as_before : (m:Map) (a:ad) (y:A)
-      (a0:ad) (ad_eq a a0)=false ->
-         (MapGet (MapPut m a y) a0)=(MapGet (MapPut_behind m a y) a0).
-  Proof.
-    Induction m. Trivial.
-    Intros a y a' y' a0 H. Exact (MapPut_behind_as_before_1 a a' a0 H y y').
-    Intros. Rewrite MapPut_semantics_3_1. Rewrite MapPut_behind_semantics_3_1.
-    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if.
-    Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3.
-    Rewrite H3. Apply H0. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2).
-    Intro H3. Rewrite H3. Reflexivity.
-    Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if.
-    Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3. Rewrite H3. Reflexivity.
-    Intro H3. Rewrite H3. Apply H. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2).
-  Qed.
-
-  Lemma MapPut_behind_new : (m:Map) (a:ad) (y:A)
-      (MapGet (MapPut_behind m a y) a)=(Cases (MapGet m a) of
-                                            (SOME y') => (SOME y')
-					  | _ => (SOME y)
-				        end).
-  Proof.
-    Induction m. Simpl. Intros. Rewrite (ad_eq_correct a). Reflexivity.
-    Intros. Elim (ad_sum (ad_xor a a1)). Intro H. Elim H. Intros p H0. Simpl.
-    Rewrite H0. Rewrite (ad_xor_eq_false a a1 p). Exact (MapPut1_semantics_2 p a a1 a0 y H0).
-    Assumption.
-    Intro H. Simpl. Rewrite H. Rewrite <- (ad_xor_eq ? ? H). Rewrite (ad_eq_correct a).
-    Exact (M1_semantics_1 a a0).
-    Intros. Rewrite MapPut_behind_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a).
-    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_1 a H1).
-    Exact (H0 (ad_div_2 a) y).
-    Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_0 a H1). Exact (H (ad_div_2 a) y).
-  Qed.
-
-  Lemma MapPut_behind_semantics : (m:Map) (a:ad) (y:A)
-      (eqm (MapGet (MapPut_behind m a y))
-           [a':ad] Cases (MapGet m a') of
-                       (SOME y') => (SOME y')
-		     | _ => if (ad_eq a a') then (SOME y) else NONE
-		   end).
-  Proof.
-    Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H.
-    Rewrite (ad_eq_complete ? ? H). Apply MapPut_behind_new.
-    Intro H. Rewrite H. Rewrite <- (MapPut_behind_as_before m a y a0 H).
-    Rewrite (MapPut_semantics m a y a0). Rewrite H. Case (MapGet m a0); Trivial.
-  Qed.
-
-  Definition makeM2 := [m,m':Map] Cases m m' of
-                                      M0 M0 => M0
-				    | M0 (M1 a y) => (M1 (ad_double_plus_un a) y)
-				    | (M1 a y) M0 => (M1 (ad_double a) y)
-				    | _ _ => (M2 m m')
-				  end.
-
-  Lemma makeM2_M2 : (m,m':Map) (eqm (MapGet (makeM2 m m')) (MapGet (M2 m m'))).
-  Proof.
-    Unfold eqm. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H.
-    Rewrite (MapGet_M2_bit_0_1 a H m m'). Case m'. Case m. Reflexivity.
-    Intros a0 y. Simpl. Rewrite (ad_bit_0_1_not_double a H a0). Reflexivity.
-    Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
-    Assumption.
-    Case m. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))).
-    Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double_plus_un a H).
-    Rewrite (ad_eq_correct a). Reflexivity.
-    Intro H0. Rewrite H0. Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0.
-    Rewrite (ad_not_div_2_not_double_plus_un a a0 H0). Reflexivity.
-    Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
-    Assumption.
-    Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
-    Assumption.
-    Intros m1 m2. Unfold makeM2.
-    Cut (MapGet (M2 m (M2 m1 m2)) a)=(MapGet (M2 m1 m2) (ad_div_2 a)). 
-    Case m; Trivial.
-    Exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)).
-    Intro H. Rewrite (MapGet_M2_bit_0_0 a H m m'). Case m. Case m'. Reflexivity.
-    Intros a0 y. Simpl. Rewrite (ad_bit_0_0_not_double_plus_un a H a0). Reflexivity.
-    Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
-    Assumption.
-    Case m'. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). Intro H0.
-    Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double a H).
-    Rewrite (ad_eq_correct a). Reflexivity.
-    Intro H0. Rewrite H0. Rewrite (ad_eq_comm (ad_double a0) a).
-    Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. Rewrite (ad_not_div_2_not_double a a0 H0).
-    Reflexivity.
-    Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
-    Assumption.
-    Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
-    Assumption.
-    Intros m1 m2. Unfold makeM2. Exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m').
-  Qed.
-
-  Fixpoint MapRemove [m:Map] : ad -> Map :=
-    Cases m of
-        M0 => [_:ad] M0
-      | (M1 a y) => [a':ad]
-          Cases (ad_eq a a') of
-	      true => M0
-	    | false => m
-          end
-      | (M2 m1 m2) => [a:ad]
-          if (ad_bit_0 a)
-	  then (makeM2 m1 (MapRemove m2 (ad_div_2 a)))
-	  else (makeM2 (MapRemove m1 (ad_div_2 a)) m2)
-    end.
-
-  Lemma MapRemove_semantics : (m:Map) (a:ad)
-      (eqm (MapGet (MapRemove m a)) [a':ad] if (ad_eq a a') then NONE else (MapGet m a')).
-  Proof.
-    Unfold eqm. Induction m. Simpl. Intros. Case (ad_eq a a0); Trivial.
-    Intros. Simpl. Elim (sumbool_of_bool (ad_eq a1 a2)). Intro H. Rewrite H.
-    Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Reflexivity.
-    Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H) in H0. Exact (M1_semantics_2 a a2 a0 H0).
-    Intro H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Rewrite H.
-    Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite H. Reflexivity.
-    Intro H0. Rewrite H0. Rewrite H. Reflexivity.
-    Intros. Change (MapGet (if (ad_bit_0 a)
-                            then (makeM2 m0 (MapRemove m1 (ad_div_2 a)))
-                            else (makeM2 (MapRemove m0 (ad_div_2 a)) m1))
-			   a0)
-                   =(if (ad_eq a a0) then NONE else (MapGet (M2 m0 m1) a0)).
-    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1.
-    Rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). Elim (sumbool_of_bool (ad_bit_0 a0)).
-    Intro H2. Rewrite MapGet_M2_bit_0_1. Rewrite (H0 (ad_div_2 a) (ad_div_2 a0)).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3).
-    Reflexivity.
-    Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1).
-    Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Reflexivity.
-    Assumption.
-    Intro H2. Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (ad_div_2 a))).
-    Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq ? ? H2 H1).
-    Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Reflexivity.
-    Intro H1. Rewrite H1. Rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0).
-    Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite MapGet_M2_bit_0_1.
-    Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity.
-    Assumption.
-    Intro H2. Rewrite MapGet_M2_bit_0_0. Rewrite (H (ad_div_2 a) (ad_div_2 a0)).
-    Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Elim (sumbool_of_bool (ad_eq a a0)). Intro H3.
-    Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity.
-    Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity.
-    Assumption.
-  Qed.
-
-  Fixpoint MapCard [m:Map] : nat :=
-    Cases m of
-        M0 => O
-      | (M1 _ _) => (S O)
-      | (M2 m m') => (plus (MapCard m) (MapCard m'))
-    end.
-
-  Fixpoint MapMerge [m:Map] : Map -> Map :=
-    Cases m of
-        M0 => [m':Map] m'
-      | (M1 a y) => [m':Map] (MapPut_behind m' a y)
-      | (M2 m1 m2) => [m':Map] Cases m' of
-      	                           M0 => m
-				 | (M1 a' y') => (MapPut m a' y')
-				 | (M2 m'1 m'2) => (M2 (MapMerge m1 m'1) 
-	                                               (MapMerge m2 m'2))
-			       end
-    end.
-
-  Lemma MapMerge_semantics : (m,m':Map)
-      (eqm (MapGet (MapMerge m m'))
-           [a0:ad] Cases (MapGet m' a0) of
-	               (SOME y') => (SOME y')
-		     | NONE => (MapGet m a0)
-                   end).
-  Proof.
-    Unfold eqm. Induction m. Intros. Simpl. Case (MapGet m' a); Trivial.
-    Intros. Simpl. Rewrite (MapPut_behind_semantics m' a a0 a1). Reflexivity.
-    Induction m'. Trivial.
-    Intros. Unfold MapMerge. Rewrite (MapPut_semantics (M2 m0 m1) a a0 a1).
-    Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1).
-    Rewrite (M1_semantics_1 a1 a0). Reflexivity.
-    Intro H1. Rewrite H1. Rewrite (M1_semantics_2 a a1 a0 H1). Reflexivity.
-    Intros. Cut (MapMerge (M2 m0 m1) (M2 m2 m3))=(M2 (MapMerge m0 m2) (MapMerge m1 m3)).
-    Intro. Rewrite H3. Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)).
-    Rewrite (H m2 (ad_div_2 a)). Rewrite (MapGet_M2_bit_0_if m2 m3 a).
-    Rewrite (MapGet_M2_bit_0_if m0 m1 a). Case (ad_bit_0 a); Trivial.
-    Reflexivity.
-  Qed.
-
-  (** [MapInter], [MapRngRestrTo], [MapRngRestrBy], [MapInverse] 
-      not implemented: need a decidable equality on [A]. *)
-
-  Fixpoint MapDelta [m:Map] : Map -> Map :=
-    Cases m of
-        M0 => [m':Map] m'
-      | (M1 a y) => [m':Map] Cases (MapGet m' a) of
-                                 NONE => (MapPut m' a y)
-			       | _ => (MapRemove m' a)
-			     end
-      | (M2 m1 m2) => [m':Map] Cases m' of
-                                   M0 => m
-				 | (M1 a' y') => Cases (MapGet m a') of
-				                     NONE => (MapPut m a' y')
-						   | _ => (MapRemove m a')
-						 end
-				 | (M2 m'1 m'2) => (makeM2 (MapDelta m1 m'1)
-				                           (MapDelta m2 m'2))
-			       end
-    end.
-
-  Lemma MapDelta_semantics_comm : (m,m':Map)
-      (eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m))).
-  Proof.
-    Unfold eqm. Induction m. Induction m'; Reflexivity.
-    Induction m'. Reflexivity.
-    Unfold MapDelta. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H.
-    Rewrite <- (ad_eq_complete ? ? H). Rewrite (M1_semantics_1 a a2).
-    Rewrite (M1_semantics_1 a a0). Simpl. Rewrite (ad_eq_correct a). Reflexivity.
-    Intro H. Rewrite (M1_semantics_2 a a1 a0 H). Rewrite (ad_eq_comm a a1) in H.
-    Rewrite (M1_semantics_2 a1 a a2 H). Rewrite (MapPut_semantics (M1 a a0) a1 a2 a3).
-    Rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). Elim (sumbool_of_bool (ad_eq a a3)).
-    Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0) in H. Rewrite H.
-    Rewrite (ad_eq_complete ? ? H0). Rewrite (M1_semantics_1 a3 a0). Reflexivity.
-    Intro H0. Rewrite H0. Rewrite (M1_semantics_2 a a3 a0 H0).
-    Elim (sumbool_of_bool (ad_eq a1 a3)). Intro H1. Rewrite H1.
-    Rewrite (ad_eq_complete ? ? H1). Exact (M1_semantics_1 a3 a2).
-    Intro H1. Rewrite H1. Exact (M1_semantics_2 a1 a3 a2 H1).
-    Intros. Reflexivity.
-    Induction m'. Reflexivity.
-    Reflexivity.
-    Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
-    Rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a).
-    Rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a).
-    Rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a).
-    Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). Reflexivity.
-  Qed.
-
-  Lemma MapDelta_semantics_1_1 : (a:ad) (y:A) (m':Map) (a0:ad)
-    (MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=NONE -> 
-      (MapGet (MapDelta (M1 a y) m') a0)=NONE.
-  Proof.
-    Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
-    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H.
-    Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption.
-    Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial.
-  Qed.
-
-  Lemma MapDelta_semantics_1 : (m,m':Map) (a:ad)
-    (MapGet m a)=NONE -> (MapGet m' a)=NONE -> 
-      (MapGet (MapDelta m m') a)=NONE.
-  Proof.
-    Induction m. Trivial.
-    Exact MapDelta_semantics_1_1.
-    Induction m'. Trivial.
-    Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
-    Apply MapDelta_semantics_1_1; Trivial.
-    Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
-    Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
-    Apply H0. Rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. Exact H3.
-    Rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. Exact H4.
-    Intro H5. Rewrite H5. Apply H. Rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. Exact H3.
-    Rewrite (MapGet_M2_bit_0_0 a H5 m2 m3) in H4. Exact H4.
-  Qed.
-
-  Lemma MapDelta_semantics_2_1 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
-    (MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=(SOME y0) ->
-      (MapGet (MapDelta (M1 a y) m') a0)=(SOME y0).
-  Proof.
-    Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
-    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H.
-    Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption.
-    Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial.
-  Qed.
-
-  Lemma MapDelta_semantics_2_2 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
-    (MapGet (M1 a y) a0)=(SOME y0) -> (MapGet m' a0)=NONE ->
-      (MapGet (MapDelta (M1 a y) m') a0)=(SOME y0).
-  Proof.
-    Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
-    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_eq_complete ? ? H1).
-    Rewrite H0. Rewrite (MapPut_semantics m' a0 y a0). Rewrite (ad_eq_correct a0).
-    Rewrite (M1_semantics_1 a0 y) in H. Simple Inversion H. Assumption.
-    Intro H1. Rewrite (M1_semantics_2 a a0 y H1) in H. Discriminate H.
-  Qed.
-
-  Lemma MapDelta_semantics_2 : (m,m':Map) (a:ad) (y:A)
-    (MapGet m a)=NONE -> (MapGet m' a)=(SOME y) -> 
-      (MapGet (MapDelta m m') a)=(SOME y).
-  Proof.
-    Induction m. Trivial.
-    Exact MapDelta_semantics_2_1.
-    Induction m'. Intros. Discriminate H2.
-    Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
-    Apply MapDelta_semantics_2_2; Assumption.
-    Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
-    Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
-    Apply H0. Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption.
-    Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption.
-    Intro H5. Rewrite H5. Apply H. Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption.
-    Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption.
-  Qed.
-
-  Lemma MapDelta_semantics_3_1 : (a0:ad) (y0:A) (m':Map) (a:ad) (y,y':A)
-    (MapGet (M1 a0 y0) a)=(SOME y) -> (MapGet m' a)=(SOME y') ->
-      (MapGet (MapDelta (M1 a0 y0) m') a)=NONE.
-  Proof.
-    Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H1.
-    Rewrite (ad_eq_complete a0 a H1). Rewrite H0. Rewrite (MapRemove_semantics m' a a).
-    Rewrite (ad_eq_correct a). Reflexivity.
-    Intro H1. Rewrite (M1_semantics_2 a0 a y0 H1) in H. Discriminate H.
-  Qed.
-
-  Lemma MapDelta_semantics_3 : (m,m':Map) (a:ad) (y,y':A)
-    (MapGet m a)=(SOME y) -> (MapGet m' a)=(SOME y') -> 
-      (MapGet (MapDelta m m') a)=NONE.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Exact MapDelta_semantics_3_1.
-    Induction m'. Intros. Discriminate H2.
-    Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
-    Exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1).
-    Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
-    Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
-    Apply (H0 m3 (ad_div_2 a) y y'). Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption.
-    Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption.
-    Intro H5. Rewrite H5. Apply (H m2 (ad_div_2 a) y y').
-    Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption.
-    Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption.
-  Qed.
-
-  Lemma MapDelta_semantics : (m,m':Map)
-      (eqm (MapGet (MapDelta m m'))
-           [a0:ad] Cases (MapGet m a0) (MapGet m' a0) of
-	               NONE (SOME y') => (SOME y')
-		     | (SOME y) NONE => (SOME y)
-		     | _ _ => NONE
-		   end).
-  Proof.
-    Unfold eqm. Intros. Elim (option_sum (MapGet m' a)). Intro H. Elim H. Intros a0 H0.
-    Rewrite H0. Elim (option_sum (MapGet m a)). Intro H1. Elim H1. Intros a1 H2. Rewrite H2.
-    Exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0).
-    Intro H1. Rewrite H1. Exact (MapDelta_semantics_2 m m' a a0 H1 H0).
-    Intro H. Rewrite H. Elim (option_sum (MapGet m a)). Intro H0. Elim H0. Intros a0 H1.
-    Rewrite H1. Rewrite (MapDelta_semantics_comm m m' a).
-    Exact (MapDelta_semantics_2 m' m a a0 H H1).
-    Intro H0. Rewrite H0. Exact (MapDelta_semantics_1 m m' a H0 H).
-  Qed.
-
-  Definition MapEmptyp := [m:Map]
-    Cases m of
-      	M0 => true
-      | _ => false
-    end.
-
-  Lemma MapEmptyp_correct : (MapEmptyp M0)=true.
-  Proof.
-    Reflexivity.
-  Qed.
-
-  Lemma MapEmptyp_complete : (m:Map) (MapEmptyp m)=true -> m=M0.
-  Proof.
-    Induction m; Trivial. Intros. Discriminate H.
-    Intros. Discriminate H1.
-  Qed.
-
-  (** [MapSplit] not implemented: not the preferred way of recursing over Maps
-      (use [MapSweep], [MapCollect], or [MapFold] in Mapiter.v. *)
-
-End MapDefs.
diff --git a/theories7/IntMap/Mapaxioms.v b/theories7/IntMap/Mapaxioms.v
deleted file mode 100644
index 085afd69..00000000
--- a/theories7/IntMap/Mapaxioms.v
+++ /dev/null
@@ -1,670 +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: Mapaxioms.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
-
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Fset.
-
-Section MapAxioms.
-
-  Variable A, B, C : Set.
-
-  Lemma eqm_sym : (f,f':ad->(option A)) (eqm A f f') -> (eqm A f' f).
-  Proof.
-    Unfold eqm. Intros. Rewrite H. Reflexivity.
-  Qed.
-
-  Lemma eqm_refl :  (f:ad->(option A)) (eqm A f f).
-  Proof.
-    Unfold eqm. Trivial.
-  Qed.
-
-  Lemma eqm_trans : (f,f',f'':ad->(option A)) (eqm A f f') -> (eqm A f' f'') -> (eqm A f f'').
-  Proof.
-    Unfold eqm. Intros. Rewrite H. Exact (H0 a).
-  Qed.
-
-  Definition eqmap := [m,m':(Map A)] (eqm A (MapGet A m) (MapGet A m')).
-
-  Lemma eqmap_sym : (m,m':(Map A)) (eqmap m m') -> (eqmap m' m).
-  Proof.
-    Intros. Unfold eqmap. Apply eqm_sym. Assumption.
-  Qed.
-
-  Lemma eqmap_refl :  (m:(Map A)) (eqmap m m).
-  Proof.
-    Intros. Unfold eqmap. Apply eqm_refl.
-  Qed.
-
-  Lemma eqmap_trans : (m,m',m'':(Map A)) (eqmap m m') -> (eqmap m' m'') -> (eqmap m m'').
-  Proof.
-    Intros. Exact (eqm_trans (MapGet A m) (MapGet A m') (MapGet A m'') H H0).
-  Qed.
-
-  Lemma MapPut_as_Merge : (m:(Map A)) (a:ad) (y:A)
-      (eqmap (MapPut A m a y) (MapMerge A m (M1 A a y))).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m a y a0).
-    Rewrite (MapMerge_semantics A m (M1 A a y) a0). Unfold 2 MapGet.
-    Elim (sumbool_of_bool (ad_eq a a0)); Intro H; Rewrite H; Reflexivity.
-  Qed.
-
-  Lemma MapPut_ext : (m,m':(Map A)) (eqmap m m') ->
-      (a:ad) (y:A) (eqmap (MapPut A m a y) (MapPut A m' a y)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m' a y a0).
-    Rewrite (MapPut_semantics A m a y a0). 
-    Case (ad_eq a a0); [ Reflexivity | Apply H ].
-  Qed.
-
-  Lemma MapPut_behind_as_Merge : (m:(Map A)) (a:ad) (y:A)
-      (eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a y) m)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m a y a0).
-    Rewrite (MapMerge_semantics A (M1 A a y) m a0). Reflexivity.
-  Qed.
-
-  Lemma MapPut_behind_ext : (m,m':(Map A)) (eqmap m m') ->
-      (a:ad) (y:A) (eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m' a y a0).
-    Rewrite (MapPut_behind_semantics A m a y a0). Rewrite (H a0). Reflexivity.
-  Qed.
-
-  Lemma MapMerge_empty_m_1 : (m:(Map A)) (MapMerge A (M0 A) m)=m.
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma MapMerge_empty_m : (m:(Map A)) (eqmap (MapMerge A (M0 A) m) m).
-  Proof.
-    Unfold eqmap eqm. Trivial.
-  Qed.
-
-  Lemma MapMerge_m_empty_1 : (m:(Map A)) (MapMerge A m (M0 A))=m.
-  Proof.
-    Induction m;Trivial.
-  Qed.
-
-  Lemma MapMerge_m_empty : (m:(Map A)) (eqmap (MapMerge A m (M0 A)) m).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite MapMerge_m_empty_1. Reflexivity.
-  Qed.
-
-  Lemma MapMerge_empty_l : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) ->
-      (eqmap m (M0 A)).
-  Proof.
-    Unfold eqmap eqm. Intros. Cut (MapGet A (MapMerge A m m') a)=(MapGet A (M0 A) a).
-    Rewrite (MapMerge_semantics A m m' a). Case (MapGet A m' a). Trivial.
-    Intros. Discriminate H0.
-    Exact (H a).
-  Qed.
-
-  Lemma MapMerge_empty_r : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) ->
-      (eqmap m' (M0 A)).
-  Proof.
-    Unfold eqmap eqm. Intros. Cut (MapGet A (MapMerge A m m') a)=(MapGet A (M0 A) a).
-    Rewrite (MapMerge_semantics A m m' a). Case (MapGet A m' a). Trivial.
-    Intros. Discriminate H0.
-    Exact (H a).
-  Qed.
-
-  Lemma MapMerge_assoc : (m,m',m'':(Map A)) (eqmap
-      (MapMerge A (MapMerge A m m') m'')
-      (MapMerge A m (MapMerge A m' m''))).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A (MapMerge A m m') m'' a).
-    Rewrite (MapMerge_semantics A m (MapMerge A m' m'') a). Rewrite (MapMerge_semantics A m m' a).
-    Rewrite (MapMerge_semantics A m' m'' a).
-    Case (MapGet A m'' a); Case (MapGet A m' a); Trivial.
-  Qed.
-
-  Lemma MapMerge_idempotent : (m:(Map A)) (eqmap (MapMerge A m m) m).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m m a).
-    Case (MapGet A m a); Trivial.
-  Qed.
-
-  Lemma MapMerge_ext : (m1,m2,m'1,m'2:(Map A))
-      (eqmap m1 m'1) -> (eqmap m2 m'2) -> 
-        (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m1 m2 a).
-    Rewrite (MapMerge_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
-  Qed.
-
-  Lemma MapMerge_ext_l : (m1,m'1,m2:(Map A))
-      (eqmap m1 m'1) -> (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2)).
-  Proof.
-    Intros. Apply MapMerge_ext. Assumption.
-    Apply eqmap_refl.
-  Qed.
-
-  Lemma MapMerge_ext_r : (m1,m2,m'2:(Map A))
-      (eqmap m2 m'2) -> (eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2)).
-  Proof.
-    Intros. Apply MapMerge_ext. Apply eqmap_refl.
-    Assumption.
-  Qed.
-
-  Lemma MapMerge_RestrTo_l : (m,m',m'':(Map A))
-      (eqmap (MapMerge A (MapDomRestrTo A A m m') m'')
-             (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m''))).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A (MapDomRestrTo A A m m') m'' a).
-    Rewrite (MapDomRestrTo_semantics A A m m' a).
-    Rewrite (MapDomRestrTo_semantics A A (MapMerge A m m'') (MapMerge A m' m'') a).
-    Rewrite (MapMerge_semantics A m' m'' a). Rewrite (MapMerge_semantics A m m'' a).
-    Case (MapGet A m'' a); Case (MapGet A m' a); Reflexivity.
-  Qed.
-
-  Lemma MapRemove_as_RestrBy : (m:(Map A)) (a:ad) (y:B)
-      (eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y))).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m a a0).
-    Rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). Elim (sumbool_of_bool (ad_eq a a0)).
-    Intro H. Rewrite H. Rewrite (ad_eq_complete a a0 H). Rewrite (M1_semantics_1 B a0 y).
-    Reflexivity.
-    Intro H. Rewrite H. Rewrite (M1_semantics_2 B a a0 y H). Reflexivity.
-  Qed.
-
-  Lemma MapRemove_ext : (m,m':(Map A)) (eqmap m m') ->
-      (a:ad) (eqmap (MapRemove A m a) (MapRemove A m' a)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m' a a0).
-    Rewrite (MapRemove_semantics A m a a0). 
-    Case (ad_eq a a0); [ Reflexivity | Apply H ].
-  Qed.
-
-  Lemma MapDomRestrTo_empty_m_1 : 
-      (m:(Map B)) (MapDomRestrTo A B (M0 A) m)=(M0 A).
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma MapDomRestrTo_empty_m : 
-      (m:(Map B)) (eqmap (MapDomRestrTo A B (M0 A) m) (M0 A)).
-  Proof.
-    Unfold eqmap eqm. Trivial.
-  Qed.
-
-  Lemma MapDomRestrTo_m_empty_1 : 
-      (m:(Map A)) (MapDomRestrTo A B m (M0 B))=(M0 A).
-  Proof.
-    Induction m;Trivial.
-  Qed.
-
-  Lemma MapDomRestrTo_m_empty : 
-      (m:(Map A)) (eqmap (MapDomRestrTo A B m (M0 B)) (M0 A)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_m_empty_1 m). Reflexivity.
-  Qed.
-
-  Lemma MapDomRestrTo_assoc : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')
-             (MapDomRestrTo A B m (MapDomRestrTo B C m' m''))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a).
-    Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A B m (MapDomRestrTo B C m' m'') a).
-    Rewrite (MapDomRestrTo_semantics B C m' m'' a).
-    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrTo_idempotent : (m:(Map A)) (eqmap (MapDomRestrTo A A m m) m).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A A m m a).
-    Case (MapGet A m a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrTo_Dom : (m:(Map A)) (m':(Map B))
-      (eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m'))).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A unit m (MapDom B m') a).
-    Elim (sumbool_of_bool (in_FSet a (MapDom B m'))). Intro H.
-    Elim (MapDom_semantics_2 B m' a H). Intros y H0. Rewrite H0. Unfold in_FSet in_dom in H.
-    Generalize H. Case (MapGet unit (MapDom B m') a); Trivial. Intro H1. Discriminate H1.
-    Intro H. Rewrite (MapDom_semantics_4 B m' a H). Unfold in_FSet in_dom in H.
-    Generalize H. Case (MapGet unit (MapDom B m') a). Trivial.
-    Intros H0 H1. Discriminate H1.
-  Qed.
-
-  Lemma MapDomRestrBy_empty_m_1 : 
-      (m:(Map B)) (MapDomRestrBy A B (M0 A) m)=(M0 A).
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma MapDomRestrBy_empty_m : 
-      (m:(Map B)) (eqmap (MapDomRestrBy A B (M0 A) m) (M0 A)).
-  Proof.
-    Unfold eqmap eqm. Trivial.
-  Qed.
-
-  Lemma MapDomRestrBy_m_empty_1 : (m:(Map A)) (MapDomRestrBy A B m (M0 B))=m.
-  Proof.
-    Induction m;Trivial.
-  Qed.
-
-  Lemma MapDomRestrBy_m_empty : (m:(Map A)) (eqmap (MapDomRestrBy A B m (M0 B)) m).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_m_empty_1 m). Reflexivity.
-  Qed.
-
-  Lemma MapDomRestrBy_Dom : (m:(Map A)) (m':(Map B))
-      (eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m'))).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Rewrite (MapDomRestrBy_semantics A unit m (MapDom B m') a).
-    Elim (sumbool_of_bool (in_FSet a (MapDom B m'))). Intro H.
-    Elim (MapDom_semantics_2 B m' a H). Intros y H0. Rewrite H0.
-    Unfold in_FSet in_dom in H. Generalize H. Case (MapGet unit (MapDom B m') a); Trivial.
-    Intro H1. Discriminate H1.
-    Intro H. Rewrite (MapDom_semantics_4 B m' a H). Unfold in_FSet in_dom in H.
-    Generalize H. Case (MapGet unit (MapDom B m') a). Trivial.
-    Intros H0 H1. Discriminate H1.
-  Qed.
-
-  Lemma MapDomRestrBy_m_m_1 : (m:(Map A)) (eqmap (MapDomRestrBy A A m m) (M0 A)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A A m m a).
-    Case (MapGet A m a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrBy_By : (m:(Map A)) (m':(Map B)) (m'':(Map B))
-      (eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m') m'')
-             (MapDomRestrBy A B m (MapMerge B m' m''))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A B m m') m'' a).
-    Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Rewrite (MapDomRestrBy_semantics A B m (MapMerge B m' m'') a).
-    Rewrite (MapMerge_semantics B m' m'' a).
-    Case (MapGet B m'' a); Case (MapGet B m' a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrBy_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m') m'')
-             (MapDomRestrBy A B (MapDomRestrBy A C m m'') m')).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrBy_semantics A C (MapDomRestrBy A B m m') m'' a).
-    Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A C m m'') m' a).
-    Rewrite (MapDomRestrBy_semantics A C m m'' a).
-    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrBy_To : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')
-             (MapDomRestrTo A B m (MapDomRestrBy B C m' m''))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a).
-    Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A B m (MapDomRestrBy B C m' m'') a).
-    Rewrite (MapDomRestrBy_semantics B C m' m'' a).
-    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrBy_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')
-             (MapDomRestrTo A B (MapDomRestrBy A C m m'') m')).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a).
-    Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A B (MapDomRestrBy A C m m'') m' a).
-    Rewrite (MapDomRestrBy_semantics A C m m'' a).
-    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrTo_By : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')
-             (MapDomRestrTo A C m (MapDomRestrBy C B m'' m'))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a).
-    Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A C m (MapDomRestrBy C B m'' m') a).
-    Rewrite (MapDomRestrBy_semantics C B m'' m' a).
-    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrTo_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')
-             (MapDomRestrBy A B (MapDomRestrTo A C m m'') m')).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a).
-    Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Rewrite (MapDomRestrBy_semantics A B (MapDomRestrTo A C m m'') m' a).
-    Rewrite (MapDomRestrTo_semantics A C m m'' a).
-    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
-  Qed.
-
-  Lemma MapDomRestrTo_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')
-             (MapDomRestrTo A B (MapDomRestrTo A C m m'') m')).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a).
-    Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A B (MapDomRestrTo A C m m'') m' a).
-    Rewrite (MapDomRestrTo_semantics A C m m'' a).
-    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
-  Qed.
-
-  Lemma MapMerge_DomRestrTo : (m,m':(Map A)) (m'':(Map B))
-      (eqmap (MapDomRestrTo A B (MapMerge A m m') m'')
-             (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m''))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrTo_semantics A B (MapMerge A m m') m'' a).
-    Rewrite (MapMerge_semantics A m m' a).
-    Rewrite (MapMerge_semantics A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'') a).
-    Rewrite (MapDomRestrTo_semantics A B m' m'' a).
-    Rewrite (MapDomRestrTo_semantics A B m m'' a).
-    Case (MapGet B m'' a); Case (MapGet A m' a); Trivial.
-  Qed.
-
-  Lemma MapMerge_DomRestrBy : (m,m':(Map A)) (m'':(Map B))
-      (eqmap (MapDomRestrBy A B (MapMerge A m m') m'')
-             (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m''))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrBy_semantics A B (MapMerge A m m') m'' a).
-    Rewrite (MapMerge_semantics A m m' a).
-    Rewrite (MapMerge_semantics A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'') a).
-    Rewrite (MapDomRestrBy_semantics A B m' m'' a).
-    Rewrite (MapDomRestrBy_semantics A B m m'' a).
-    Case (MapGet B m'' a); Case (MapGet A m' a); Trivial.
-  Qed.
-
-  Lemma MapDelta_empty_m_1 : (m:(Map A)) (MapDelta A (M0 A) m)=m.
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma MapDelta_empty_m : (m:(Map A)) (eqmap (MapDelta A (M0 A) m) m).
-  Proof.
-    Unfold eqmap eqm. Trivial.
-  Qed.
-
-  Lemma MapDelta_m_empty_1 : (m:(Map A)) (MapDelta A m (M0 A))=m.
-  Proof.
-    Induction m;Trivial.
-  Qed.
-
-  Lemma MapDelta_m_empty : (m:(Map A)) (eqmap (MapDelta A m (M0 A)) m).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite MapDelta_m_empty_1. Reflexivity.
-  Qed.
-
-  Lemma MapDelta_nilpotent : (m:(Map A)) (eqmap (MapDelta A m m) (M0 A)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m a).
-    Case (MapGet A m a); Trivial.
-  Qed.
-
-  Lemma MapDelta_as_Merge : (m,m':(Map A)) (eqmap (MapDelta A m m')
-      	(MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDelta_semantics A m m' a).
-    Rewrite (MapMerge_semantics A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m) a).
-    Rewrite (MapDomRestrBy_semantics A A m' m a).
-    Rewrite (MapDomRestrBy_semantics A A m m' a).
-    Case (MapGet A m a); Case (MapGet A m' a); Trivial.
-  Qed.
-
-  Lemma MapDelta_as_DomRestrBy : (m,m':(Map A)) (eqmap (MapDelta A m m')
-      	(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'))).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
-    Rewrite (MapDomRestrBy_semantics A A (MapMerge A m m') (MapDomRestrTo A A m m') a).
-    Rewrite (MapDomRestrTo_semantics A A m m' a). Rewrite (MapMerge_semantics A m m' a).
-    Case (MapGet A m a); Case (MapGet A m' a); Trivial.
-  Qed.
-
-  Lemma MapDelta_as_DomRestrBy_2 : (m,m':(Map A)) (eqmap (MapDelta A m m')
-      	(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m))).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
-    Rewrite (MapDomRestrBy_semantics A A (MapMerge A m m') (MapDomRestrTo A A m' m) a).
-    Rewrite (MapDomRestrTo_semantics A A m' m a). Rewrite (MapMerge_semantics A m m' a).
-    Case (MapGet A m a); Case (MapGet A m' a); Trivial.
-  Qed.
-
-  Lemma MapDelta_sym : (m,m':(Map A)) (eqmap (MapDelta A m m') (MapDelta A m' m)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
-    Rewrite (MapDelta_semantics A m' m a). 
-    Case (MapGet A m a); Case (MapGet A m' a); Trivial.
-  Qed.
-
-  Lemma MapDelta_ext : (m1,m2,m'1,m'2:(Map A))
-      (eqmap m1 m'1) -> (eqmap m2 m'2) -> 
-        (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m1 m2 a).
-    Rewrite (MapDelta_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
-  Qed.
-
-  Lemma MapDelta_ext_l : (m1,m'1,m2:(Map A))
-      (eqmap m1 m'1) -> (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2)).
-  Proof.
-    Intros. Apply MapDelta_ext. Assumption.
-    Apply eqmap_refl.
-  Qed.
-
-  Lemma MapDelta_ext_r : (m1,m2,m'2:(Map A))
-      (eqmap m2 m'2) -> (eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2)).
-  Proof.
-    Intros. Apply MapDelta_ext. Apply eqmap_refl.
-    Assumption.
-  Qed.
-
-  Lemma MapDom_Split_1 : (m:(Map A)) (m':(Map B))
-      (eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapMerge_semantics A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') a).
-    Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Case (MapGet B m' a); Case (MapGet A m a); Trivial.
-  Qed.
- 
-  Lemma MapDom_Split_2 : (m:(Map A)) (m':(Map B))
-      (eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'))).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapMerge_semantics A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m') a).
-    Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Case (MapGet B m' a); Case (MapGet A m a); Trivial.
-  Qed.
-
-  Lemma MapDom_Split_3 : (m:(Map A)) (m':(Map B))
-      (eqmap (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')) 
-	(M0 A)).
-  Proof.
-    Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrTo_semantics A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') a).
-    Rewrite (MapDomRestrBy_semantics A B m m' a).
-    Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Case (MapGet B m' a); Case (MapGet A m a); Trivial.
-  Qed.
-
-End MapAxioms.
-
-Lemma MapDomRestrTo_ext : (A,B:Set) 
-    (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B))
-      (eqmap A m1 m'1) -> (eqmap B m2 m'2) ->
-        (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2)).
-Proof.
-  Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A B m1 m2 a).
-  Rewrite (MapDomRestrTo_semantics A B m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
-Qed.
-
-Lemma MapDomRestrTo_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A))
-    (eqmap A m1 m'1) ->
-      (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2)).
-Proof.
-  Intros. Apply MapDomRestrTo_ext; [ Assumption | Apply eqmap_refl ].
-Qed.
-
-Lemma MapDomRestrTo_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B))
-    (eqmap B m2 m'2) ->
-      (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2)).
-Proof.
-  Intros. Apply MapDomRestrTo_ext; [ Apply eqmap_refl | Assumption ].
-Qed.
-
-Lemma MapDomRestrBy_ext : (A,B:Set) 
-    (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B))
-      (eqmap A m1 m'1) -> (eqmap B m2 m'2) ->
-        (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2)).
-Proof.
-  Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A B m1 m2 a).
-  Rewrite (MapDomRestrBy_semantics A B m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
-Qed.
-
-Lemma MapDomRestrBy_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A))
-    (eqmap A m1 m'1) ->
-      (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2)).
-Proof.
-  Intros. Apply MapDomRestrBy_ext; [ Assumption | Apply eqmap_refl ].
-Qed.
-
-Lemma MapDomRestrBy_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B))
-    (eqmap B m2 m'2) ->
-      (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2)).
-Proof.
-  Intros. Apply MapDomRestrBy_ext; [ Apply eqmap_refl | Assumption ].
-Qed.
-
-Lemma MapDomRestrBy_m_m : (A:Set) (m:(Map A))
-    (eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A)).
-Proof.
-  Intros. Apply eqmap_trans with m':=(MapDomRestrBy A A m m). Apply eqmap_sym.
-  Apply MapDomRestrBy_Dom.
-  Apply MapDomRestrBy_m_m_1.
-Qed.
-
-Lemma FSetDelta_assoc : (s,s',s'':FSet)
-    (eqmap unit (MapDelta ? (MapDelta ? s s') s'') (MapDelta ? s (MapDelta ? s' s''))).
-Proof.
-  Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics unit (MapDelta unit s s') s'' a).
-  Rewrite (MapDelta_semantics unit s s' a).
-  Rewrite (MapDelta_semantics unit s (MapDelta unit s' s'') a).
-  Rewrite (MapDelta_semantics unit s' s'' a).
-  Case (MapGet ? s a); Case (MapGet ? s' a); Case (MapGet ? s'' a); Trivial.
-  Intros. Elim u. Elim u1. Reflexivity.
-Qed.
-
-Lemma FSet_ext : (s,s':FSet) ((a:ad) (in_FSet a s)=(in_FSet a s')) -> (eqmap unit s s').
-Proof.
-  Unfold in_FSet eqmap eqm. Intros. Elim (sumbool_of_bool (in_dom ? a s)). Intro H0.
-  Elim (in_dom_some ? s a H0). Intros y H1. Rewrite (H a) in H0. Elim (in_dom_some ? s' a H0).
-  Intros y' H2. Rewrite H1. Rewrite H2. Elim y. Elim y'. Reflexivity.
-  Intro H0. Rewrite (in_dom_none ? s a H0). Rewrite (H a) in H0. Rewrite (in_dom_none ? s' a H0).
-  Reflexivity.
-Qed.
-
-Lemma FSetUnion_comm : (s,s':FSet) (eqmap unit (FSetUnion s s') (FSetUnion s' s)).
-Proof.
-  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_union. Apply orb_sym.
-Qed.
-
-Lemma FSetUnion_assoc : (s,s',s'':FSet) (eqmap unit
-      (FSetUnion (FSetUnion s s') s'') (FSetUnion s (FSetUnion s' s''))).
-Proof.
-  Exact (MapMerge_assoc unit).
-Qed.
-
-Lemma FSetUnion_M0_s : (s:FSet) (eqmap unit (FSetUnion (M0 unit) s) s).
-Proof.
-  Exact (MapMerge_empty_m unit).
-Qed.
-
-Lemma FSetUnion_s_M0 : (s:FSet) (eqmap unit (FSetUnion s (M0 unit)) s).
-Proof.
-  Exact (MapMerge_m_empty unit).
-Qed.
-
-Lemma FSetUnion_idempotent : (s:FSet) (eqmap unit (FSetUnion s s) s).
-Proof.
-  Exact (MapMerge_idempotent unit).
-Qed.
-
-Lemma FSetInter_comm : (s,s':FSet) (eqmap unit (FSetInter s s') (FSetInter s' s)).
-Proof.
-  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_inter. Apply andb_sym.
-Qed.
-
-Lemma FSetInter_assoc : (s,s',s'':FSet) (eqmap unit
-      (FSetInter (FSetInter s s') s'') (FSetInter s (FSetInter s' s''))).
-Proof.
-  Exact (MapDomRestrTo_assoc unit unit unit).
-Qed.
-
-Lemma FSetInter_M0_s : (s:FSet) (eqmap unit (FSetInter (M0 unit) s) (M0 unit)).
-Proof.
-  Exact (MapDomRestrTo_empty_m unit unit).
-Qed.
-
-Lemma FSetInter_s_M0 : (s:FSet) (eqmap unit (FSetInter s (M0 unit)) (M0 unit)).
-Proof.
-  Exact (MapDomRestrTo_m_empty unit unit).
-Qed.
-
-Lemma FSetInter_idempotent : (s:FSet) (eqmap unit (FSetInter s s) s).
-Proof.
-  Exact (MapDomRestrTo_idempotent unit).
-Qed.
-
-Lemma FSetUnion_Inter_l : (s,s',s'':FSet) (eqmap unit
-      (FSetUnion (FSetInter s s') s'') (FSetInter (FSetUnion s s'') (FSetUnion s' s''))).
-Proof.
-  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter.
-  Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union.
-  Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
-Qed.
-
-Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (eqmap unit
-      (FSetUnion s (FSetInter s' s'')) (FSetInter (FSetUnion s s') (FSetUnion s s''))).
-Proof.
-  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter.
-  Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union.
-  Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
-Qed.
-
-Lemma FSetInter_Union_l : (s,s',s'':FSet) (eqmap unit
-      (FSetInter (FSetUnion s s') s'') (FSetUnion (FSetInter s s'') (FSetInter s' s''))).
-Proof.
-  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union.
-  Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter.
-  Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
-Qed.
-
-Lemma FSetInter_Union_r : (s,s',s'':FSet) (eqmap unit
-      (FSetInter s (FSetUnion s' s'')) (FSetUnion (FSetInter s s') (FSetInter s s''))).
-Proof.
-  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union.
-  Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter.
-  Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
-Qed.
diff --git a/theories7/IntMap/Mapc.v b/theories7/IntMap/Mapc.v
deleted file mode 100644
index 181050b1..00000000
--- a/theories7/IntMap/Mapc.v
+++ /dev/null
@@ -1,457 +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: Mapc.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
-
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Mapaxioms.
-Require Fset.
-Require Mapiter.
-Require Mapsubset.
-Require PolyList.
-Require Lsort.
-Require Mapcard.
-Require Mapcanon.
-
-Section MapC.
-
-  Variable A, B, C : Set.
-
-  Lemma MapPut_as_Merge_c : (m:(Map A)) (mapcanon A m) ->
-      (a:ad) (y:A) (MapPut A m a y)=(MapMerge A m (M1 A a y)).
-  Proof.
-    Intros. Apply mapcanon_unique. Exact (MapPut_canon A m H a y).
-    Apply MapMerge_canon. Assumption.
-    Apply M1_canon.
-    Apply MapPut_as_Merge.
-  Qed.
-
-  Lemma MapPut_behind_as_Merge_c : (m:(Map A)) (mapcanon A m) ->
-      (a:ad) (y:A) (MapPut_behind A m a y)=(MapMerge A (M1 A a y) m).
-  Proof.
-    Intros. Apply mapcanon_unique. Exact (MapPut_behind_canon A m H a y).
-    Apply MapMerge_canon. Apply M1_canon.
-    Assumption.
-    Apply MapPut_behind_as_Merge.
-  Qed.
-
-  Lemma MapMerge_empty_m_c : (m:(Map A)) (MapMerge A (M0 A) m)=m.
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma MapMerge_assoc_c : (m,m',m'':(Map A))
-      (mapcanon A m) -> (mapcanon A m') -> (mapcanon A m'') ->
-        (MapMerge A (MapMerge A m m') m'')=(MapMerge A m (MapMerge A m' m'')).
-  Proof.
-    Intros. Apply mapcanon_unique.
-    (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption).
-    (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption).
-    Apply MapMerge_assoc.
-  Qed.
-
-  Lemma MapMerge_idempotent_c : (m:(Map A)) (mapcanon A m) -> (MapMerge A m m)=m.
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapMerge_canon; Assumption).
-    Assumption.
-    Apply MapMerge_idempotent.
-  Qed.
-
-  Lemma MapMerge_RestrTo_l_c : (m,m',m'':(Map A)) 
-      (mapcanon A m) -> (mapcanon A m'') -> 
-        (MapMerge A (MapDomRestrTo A A m m') m'')=
-        (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption.
-    Assumption.
-    Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
-    Apply MapMerge_RestrTo_l.
-  Qed.
-
-  Lemma MapRemove_as_RestrBy_c : (m:(Map A)) (mapcanon A m) ->
-      (a:ad) (y:B) (MapRemove A m a)=(MapDomRestrBy A B m (M1 B a y)).
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapRemove_canon; Assumption).
-    (Apply MapDomRestrBy_canon; Assumption).
-    Apply MapRemove_as_RestrBy.
-  Qed.
-
-  Lemma MapDomRestrTo_assoc_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (mapcanon A m) ->
-        (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')=
-        (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')).
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Try Assumption).
-    (Apply MapDomRestrTo_canon; Try Assumption).
-    (Apply MapDomRestrTo_canon; Try Assumption).
-    Apply MapDomRestrTo_assoc.
-  Qed.
-
-  Lemma MapDomRestrTo_idempotent_c : (m:(Map A)) (mapcanon A m) -> 
-      (MapDomRestrTo A A m m)=m.
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption).
-    Assumption.
-    Apply MapDomRestrTo_idempotent.
-  Qed.
-
-  Lemma MapDomRestrTo_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
-      (MapDomRestrTo A B m m')=(MapDomRestrTo A unit m (MapDom B m')).
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption).
-    (Apply MapDomRestrTo_canon; Assumption).
-    Apply MapDomRestrTo_Dom.
-  Qed.
-
-  Lemma MapDomRestrBy_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
-      (MapDomRestrBy A B m m')=(MapDomRestrBy A unit m (MapDom B m')).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon; Assumption.
-    Apply MapDomRestrBy_canon; Assumption.
-    Apply MapDomRestrBy_Dom.
-  Qed.
-
-  Lemma MapDomRestrBy_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map B)) 
-      (mapcanon A m) -> 
-        (MapDomRestrBy A B (MapDomRestrBy A B m m') m'')=
-        (MapDomRestrBy A B m (MapMerge B m' m'')).
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDomRestrBy_canon; Try Assumption).
-    (Apply MapDomRestrBy_canon; Try Assumption).
-    (Apply MapDomRestrBy_canon; Try Assumption).
-    Apply MapDomRestrBy_By.
-  Qed.
-
-  Lemma MapDomRestrBy_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
-      (mapcanon A m) ->
-        (MapDomRestrBy A C (MapDomRestrBy A B m m') m'')=
-        (MapDomRestrBy A B (MapDomRestrBy A C m m'') m').
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
-    (Apply MapDomRestrBy_canon; Assumption).
-    Apply MapDomRestrBy_canon. (Apply MapDomRestrBy_canon; Assumption).
-    Apply MapDomRestrBy_By_comm.
-  Qed.
-
-  Lemma MapDomRestrBy_To_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
-      (mapcanon A m) ->
-        (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')=
-        (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
-    (Apply MapDomRestrTo_canon; Assumption).
-    (Apply MapDomRestrTo_canon; Assumption).
-    Apply MapDomRestrBy_To.
-  Qed.
-
-  Lemma MapDomRestrBy_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
-      (mapcanon A m) ->
-        (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')=
-        (MapDomRestrTo A B (MapDomRestrBy A C m m'') m').
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
-    Apply MapDomRestrTo_canon; Assumption.
-    Apply MapDomRestrTo_canon. Apply MapDomRestrBy_canon; Assumption.
-    Apply MapDomRestrBy_To_comm.
-  Qed.
-
-  Lemma MapDomRestrTo_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
-      (mapcanon A m) ->
-        (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')=
-        (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
-    Apply MapDomRestrBy_canon; Assumption.
-    Apply MapDomRestrTo_canon; Assumption.
-    Apply MapDomRestrTo_By.
-  Qed.
-
-  Lemma MapDomRestrTo_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
-      (mapcanon A m) ->
-        (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')=
-        (MapDomRestrBy A B (MapDomRestrTo A C m m'') m').
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
-    (Apply MapDomRestrBy_canon; Assumption).
-    Apply MapDomRestrBy_canon. (Apply MapDomRestrTo_canon; Assumption).
-    Apply MapDomRestrTo_By_comm.
-  Qed.
-
-  Lemma MapDomRestrTo_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
-      (mapcanon A m) ->
-        (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')=
-        (MapDomRestrTo A B (MapDomRestrTo A C m m'') m').
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
-    Apply MapDomRestrTo_canon; Assumption.
-    Apply MapDomRestrTo_canon. Apply MapDomRestrTo_canon; Assumption.
-    Apply MapDomRestrTo_To_comm.
-  Qed.
-
-  Lemma MapMerge_DomRestrTo_c : (m,m':(Map A)) (m'':(Map B))
-      (mapcanon A m) -> (mapcanon A m') ->
-        (MapDomRestrTo A B (MapMerge A m m') m'')=
-        (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
-    (Apply MapMerge_canon; Assumption).
-    Apply MapMerge_canon. (Apply MapDomRestrTo_canon; Assumption).
-    (Apply MapDomRestrTo_canon; Assumption).
-    Apply MapMerge_DomRestrTo.
-  Qed.
-
-  Lemma MapMerge_DomRestrBy_c : (m,m':(Map A)) (m'':(Map B))
-      (mapcanon A m) -> (mapcanon A m') ->
-        (MapDomRestrBy A B (MapMerge A m m') m'')=
-        (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption.
-    Apply MapMerge_canon. Apply MapDomRestrBy_canon; Assumption.
-    Apply MapDomRestrBy_canon; Assumption.
-    Apply MapMerge_DomRestrBy.
-  Qed.
-
-  Lemma MapDelta_nilpotent_c : (m:(Map A)) (mapcanon A m) -> 
-      (MapDelta A m m)=(M0 A).
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
-    Apply M0_canon.
-    Apply MapDelta_nilpotent.
-  Qed.
-
-  Lemma MapDelta_as_Merge_c : (m,m':(Map A))
-      (mapcanon A m) -> (mapcanon A m') ->
-        (MapDelta A m m')=
-	(MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)).
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
-    (Apply MapMerge_canon; Apply MapDomRestrBy_canon; Assumption).
-    Apply MapDelta_as_Merge.
-  Qed.
-
-  Lemma MapDelta_as_DomRestrBy_c : (m,m':(Map A))
-      (mapcanon A m) -> (mapcanon A m') ->
-        (MapDelta A m m')=
-	(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDelta_canon; Assumption.
-    Apply MapDomRestrBy_canon. (Apply MapMerge_canon; Assumption).
-    Apply MapDelta_as_DomRestrBy.
-  Qed.
-
-  Lemma MapDelta_as_DomRestrBy_2_c : (m,m':(Map A))
-      (mapcanon A m) -> (mapcanon A m') ->
-        (MapDelta A m m')=
-	(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)).
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
-    Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption.
-    Apply MapDelta_as_DomRestrBy_2.
-  Qed.
-
-  Lemma MapDelta_sym_c : (m,m':(Map A))
-      (mapcanon A m) -> (mapcanon A m') -> (MapDelta A m m')=(MapDelta A m' m).
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
-    (Apply MapDelta_canon; Assumption). Apply MapDelta_sym.
-  Qed.
-
-  Lemma MapDom_Split_1_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
-      m=(MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')).
-  Proof.
-    Intros. Apply mapcanon_unique. Assumption.
-    Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption.
-    Apply MapDomRestrBy_canon; Assumption.
-    Apply MapDom_Split_1.
-  Qed.
-
-  Lemma MapDom_Split_2_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
-      m=(MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')).
-  Proof.
-    Intros. Apply mapcanon_unique. Assumption.
-    Apply MapMerge_canon. (Apply MapDomRestrBy_canon; Assumption).
-    (Apply MapDomRestrTo_canon; Assumption).
-    Apply MapDom_Split_2.
-  Qed.
-
-  Lemma MapDom_Split_3_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
-      (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))=
-      (M0 A).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
-    Apply MapDomRestrTo_canon; Assumption.
-    Apply M0_canon.
-    Apply MapDom_Split_3.
-  Qed.
-
-  Lemma Map_of_alist_of_Map_c : (m:(Map A)) (mapcanon A m) ->
-      (Map_of_alist A (alist_of_Map A m))=m.
-  Proof.
-    Intros. (Apply mapcanon_unique; Try Assumption). Apply Map_of_alist_canon.
-    Apply Map_of_alist_of_Map.
-  Qed.
-
-  Lemma alist_of_Map_of_alist_c : (l:(alist A)) (alist_sorted_2 A l) ->
-      (alist_of_Map A (Map_of_alist A l))=l.
-  Proof.
-    Intros. Apply alist_canonical. Apply alist_of_Map_of_alist.
-    Apply alist_of_Map_sorts2.
-    Assumption.
-  Qed.
-
-  Lemma MapSubset_antisym_c : (m:(Map A)) (m':(Map B))
-      (mapcanon A m) -> (mapcanon B m') ->
-      (MapSubset A B m m') -> (MapSubset B A m' m) -> (MapDom A m)=(MapDom B m').
-  Proof.
-    Intros. Apply (mapcanon_unique unit). (Apply MapDom_canon; Assumption).
-    (Apply MapDom_canon; Assumption).
-    (Apply MapSubset_antisym; Assumption).
-  Qed.
-
-  Lemma FSubset_antisym_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
-      (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> s=s'.
-  Proof.
-    Intros. Apply (mapcanon_unique unit); Try Assumption. Apply FSubset_antisym; Assumption.
-  Qed.
-
-  Lemma MapDisjoint_empty_c : (m:(Map A)) (mapcanon A m) ->
-      (MapDisjoint A A m m) -> m=(M0 A).
-  Proof.
-    Intros. Apply mapcanon_unique; Try Assumption; Try Apply M0_canon.
-    Apply MapDisjoint_empty; Assumption.
-  Qed.
-
-  Lemma MapDelta_disjoint_c : (m,m':(Map A)) (mapcanon A m) -> (mapcanon A m') ->
-      (MapDisjoint A A m m') -> (MapDelta A m m')=(MapMerge A m m').
-  Proof.
-    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
-    (Apply MapMerge_canon; Assumption). Apply MapDelta_disjoint; Assumption.
-  Qed.
-
-End MapC.
-
-Lemma FSetDelta_assoc_c : (s,s',s'':FSet)
-    (mapcanon unit s) -> (mapcanon unit s') -> (mapcanon unit s'') ->
-      (MapDelta ? (MapDelta ? s s') s'')=(MapDelta ? s (MapDelta ? s' s'')).
-Proof.
-  Intros. Apply (mapcanon_unique unit). Apply MapDelta_canon. (Apply MapDelta_canon; Assumption).
-  Assumption.
-  Apply MapDelta_canon. Assumption.
-  (Apply MapDelta_canon; Assumption).
-  Apply FSetDelta_assoc; Assumption.
-Qed.
-
-Lemma FSet_ext_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
-      ((a:ad) (in_FSet a s)=(in_FSet a s')) -> s=s'.
-Proof.
-  Intros. (Apply (mapcanon_unique unit); Try Assumption). Apply FSet_ext. Assumption.
-Qed.
-
-Lemma FSetUnion_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
-      (FSetUnion s s')=(FSetUnion s' s).
-Proof.
-  Intros.
-  Apply (mapcanon_unique unit); Try (Unfold FSetUnion; Apply MapMerge_canon; Assumption).
-  Apply FSetUnion_comm.
-Qed.
-
-Lemma FSetUnion_assoc_c : (s,s',s'':FSet)
-      (mapcanon unit s) -> (mapcanon unit s') -> (mapcanon unit s'') ->
-        (FSetUnion (FSetUnion s s') s'')=(FSetUnion s (FSetUnion s' s'')).
-Proof.
-  Exact (MapMerge_assoc_c unit).
-Qed.
-
-Lemma FSetUnion_M0_s_c : (s:FSet) (FSetUnion (M0 unit) s)=s.
-Proof.
-  Exact (MapMerge_empty_m_c unit).
-Qed.
-
-Lemma FSetUnion_s_M0_c : (s:FSet) (FSetUnion s (M0 unit))=s.
-Proof.
-  Exact (MapMerge_m_empty_1 unit).
-Qed.
-
-Lemma FSetUnion_idempotent : (s:FSet) (mapcanon unit s) -> (FSetUnion s s)=s.
-Proof.
-  Exact (MapMerge_idempotent_c unit).
-Qed.
-
-Lemma FSetInter_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
-      (FSetInter s s')=(FSetInter s' s).
-Proof.
-  Intros.
-  Apply (mapcanon_unique unit); Try (Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption).
-  Apply FSetInter_comm.
-Qed.
-
-Lemma FSetInter_assoc_c : (s,s',s'':FSet)
-      (mapcanon unit s) ->
-        (FSetInter (FSetInter s s') s'')=(FSetInter s (FSetInter s' s'')).
-Proof.
-  Exact (MapDomRestrTo_assoc_c unit unit unit).
-Qed.
-
-Lemma FSetInter_M0_s_c : (s:FSet) (FSetInter (M0 unit) s)=(M0 unit).
-Proof.
-  Trivial.
-Qed.
-
-Lemma FSetInter_s_M0_c : (s:FSet) (FSetInter s (M0 unit))=(M0 unit).
-Proof.
-  Exact (MapDomRestrTo_m_empty_1 unit unit).
-Qed.
-
-Lemma FSetInter_idempotent : (s:FSet) (mapcanon unit s) -> (FSetInter s s)=s.
-Proof.
-  Exact (MapDomRestrTo_idempotent_c unit).
-Qed.
-
-Lemma FSetUnion_Inter_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s'') ->
-      (FSetUnion (FSetInter s s') s'')=(FSetInter (FSetUnion s s'') (FSetUnion s' s'')).
-Proof.
-  Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (Apply MapMerge_canon; Try Assumption).
-  Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption).
-  Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
-  Apply FSetUnion_Inter_l.
-Qed.
-
-Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
-      (FSetUnion s (FSetInter s' s''))=(FSetInter (FSetUnion s s') (FSetUnion s s'')).
-Proof.
-  Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (Apply MapMerge_canon; Try Assumption).
-  Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption).
-  Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
-  Apply FSetUnion_Inter_r.
-Qed.
-
-Lemma FSetInter_Union_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
-      (FSetInter (FSetUnion s s') s'')=(FSetUnion (FSetInter s s'') (FSetInter s' s'')).
-Proof.
-  Intros. Apply (mapcanon_unique unit). Unfold FSetInter.
-  Apply MapDomRestrTo_canon; Try Assumption. Unfold FSetUnion.
-  Apply MapMerge_canon; Assumption.
-  Unfold FSetUnion; Unfold FSetInter; Apply MapMerge_canon; Apply MapDomRestrTo_canon;
-  Assumption.
-  Apply FSetInter_Union_l.
-Qed.
-
-Lemma FSetInter_Union_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
-      (FSetInter s (FSetUnion s' s''))=(FSetUnion (FSetInter s s') (FSetInter s s'')).
-Proof.
-  Intros. Apply (mapcanon_unique unit). Unfold FSetInter.
-  Apply MapDomRestrTo_canon; Try Assumption.
-  Unfold FSetUnion. Apply MapMerge_canon; Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption.
-  Apply FSetInter_Union_r.
-Qed.
diff --git a/theories7/IntMap/Mapcanon.v b/theories7/IntMap/Mapcanon.v
deleted file mode 100644
index 7beb1fd4..00000000
--- a/theories7/IntMap/Mapcanon.v
+++ /dev/null
@@ -1,376 +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: Mapcanon.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
-
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Mapaxioms.
-Require Mapiter.
-Require Fset.
-Require PolyList.
-Require Lsort.
-Require Mapsubset.
-Require Mapcard.
-
-Section MapCanon.
-
-  Variable A : Set.
-
-  Inductive mapcanon : (Map A) -> Prop :=
-      M0_canon : (mapcanon (M0 A))
-    | M1_canon : (a:ad) (y:A) (mapcanon (M1 A a y))
-    | M2_canon : (m1,m2:(Map A)) (mapcanon m1) -> (mapcanon m2) ->
-        (le (2) (MapCard A (M2 A m1 m2))) -> (mapcanon (M2 A m1 m2)).
-
-  Lemma mapcanon_M2 : 
-      (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (le (2) (MapCard A (M2 A m1 m2))).
-  Proof.
-    Intros. Inversion H. Assumption.
-  Qed.
-
-  Lemma mapcanon_M2_1 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m1).
-  Proof.
-    Intros. Inversion H. Assumption.
-  Qed.
-
-  Lemma mapcanon_M2_2 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m2).
-  Proof.
-    Intros. Inversion H. Assumption.
-  Qed.
-
-  Lemma M2_eqmap_1 : (m0,m1,m2,m3:(Map A)) 
-      (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m0 m2).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite <- (ad_double_div_2 a).
-    Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1).
-    Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m2 m3).
-    Exact (H (ad_double a)).
-  Qed.
-
-  Lemma M2_eqmap_2 : (m0,m1,m2,m3:(Map A)) 
-      (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m1 m3).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite <- (ad_double_plus_un_div_2 a).
-    Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1).
-    Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m2 m3).
-    Exact (H (ad_double_plus_un a)).
-  Qed.
-
-  Lemma mapcanon_unique : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
-      (eqmap A m m') -> m=m'.
-  Proof.
-    Induction m. Induction m'. Trivial.
-    Intros a y H H0 H1. Cut (NONE A)=(MapGet A (M1 A a y) a). Simpl. Rewrite (ad_eq_correct a).
-    Intro. Discriminate H2.
-    Exact (H1 a).
-    Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4).
-    Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2).
-    Intros a y. Induction m'. Intros. Cut (MapGet A (M1 A a y) a)=(NONE A). Simpl.
-    Rewrite (ad_eq_correct a). Intro. Discriminate H2.
-    Exact (H1 a).
-    Intros a0 y0 H H0 H1. Cut (MapGet A (M1 A a y) a)=(MapGet A (M1 A a0 y0) a). Simpl.
-    Rewrite (ad_eq_correct a). Intro. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H3.
-    Rewrite H3 in H2. Inversion H2. Rewrite (ad_eq_complete ? ? H3). Reflexivity.
-    Intro H3. Rewrite H3 in H2. Discriminate H2.
-    Exact (H1 a).
-    Intros. Cut (le (2) (MapCard A (M1 A a y))). Intro. Elim (le_Sn_O ? (le_S_n ? ? H4)).
-    Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2).
-    Induction m'. Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4).
-    Rewrite <- (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H1).
-    Intros a y H1 H2 H3. Cut (le (2) (MapCard A (M1 A a y))). Intro.
-    Elim (le_Sn_O ? (le_S_n ? ? H4)).
-    Rewrite <- (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H1).
-    Intros. Rewrite (H m2). Rewrite (H0 m3). Reflexivity.
-    Exact (mapcanon_M2_2 ? ? H3).
-    Exact (mapcanon_M2_2 ? ? H4).
-    Exact (M2_eqmap_2 ? ? ? ? H5).
-    Exact (mapcanon_M2_1 ? ? H3).
-    Exact (mapcanon_M2_1 ? ? H4).
-    Exact (M2_eqmap_1 ? ? ? ? H5).
-  Qed.
-
-  Lemma MapPut1_canon : 
-      (p:positive) (a,a':ad) (y,y':A) (mapcanon (MapPut1 A a y a' y' p)).
-  Proof.
-    Induction p. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon.
-    Apply M1_canon.
-    Apply le_n.
-    Apply M2_canon. Apply M1_canon.
-    Apply M1_canon.
-    Apply le_n.
-    Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M0_canon.
-    Apply H.
-    Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n.
-    Apply M2_canon. Apply H.
-    Apply M0_canon.
-    Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n.
-    Simpl. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon.
-    Apply M1_canon.
-    Simpl. Apply le_n.
-    Apply M2_canon. Apply M1_canon.
-    Apply M1_canon.
-    Simpl. Apply le_n.
-  Qed.
-
-  Lemma MapPut_canon : 
-      (m:(Map A)) (mapcanon m) -> (a:ad) (y:A) (mapcanon (MapPut A m a y)).
-  Proof.
-    Induction m. Intros. Simpl. Apply M1_canon.
-    Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon.
-    Intro. Apply MapPut1_canon.
-    Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
-    Exact (mapcanon_M2_2 m0 m1 H1).
-    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1).
-    Apply le_plus_plus. Exact (MapCard_Put_lb A m0 ad_z y).
-    Apply le_n.
-    Intro. Case p. Intro. Apply M2_canon. Exact (mapcanon_M2_1 m0 m1 H1).
-    Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
-    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
-    Exact (mapcanon_M2 m0 m1 H1).
-    Apply le_reg_l. Exact (MapCard_Put_lb A m1 (ad_x p0) y).
-    Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
-    Exact (mapcanon_M2_2 m0 m1 H1).
-    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
-    Exact (mapcanon_M2 m0 m1 H1).
-    Apply le_reg_r. Exact (MapCard_Put_lb A m0 (ad_x p0) y).
-    Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1).
-    Apply H0. Apply (mapcanon_M2_2 m0 m1 H1).
-    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
-    Exact (mapcanon_M2 m0 m1 H1).
-    Apply le_reg_l. Exact (MapCard_Put_lb A m1 ad_z y).
-  Qed.
-
-  Lemma MapPut_behind_canon : (m:(Map A)) (mapcanon m) ->
-      (a:ad) (y:A) (mapcanon (MapPut_behind A m a y)).
-  Proof.
-    Induction m. Intros. Simpl. Apply M1_canon.
-    Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon.
-    Intro. Apply MapPut1_canon.
-    Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
-    Exact (mapcanon_M2_2 m0 m1 H1).
-    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1).
-    Apply le_plus_plus. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 ad_z y).
-    Apply le_n.
-    Intro. Case p. Intro. Apply M2_canon. Exact (mapcanon_M2_1 m0 m1 H1).
-    Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
-    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
-    Exact (mapcanon_M2 m0 m1 H1).
-    Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 (ad_x p0) y).
-    Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
-    Exact (mapcanon_M2_2 m0 m1 H1).
-    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
-    Exact (mapcanon_M2 m0 m1 H1).
-    Apply le_reg_r. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 (ad_x p0) y).
-    Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1).
-    Apply H0. Apply (mapcanon_M2_2 m0 m1 H1).
-    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
-    Exact (mapcanon_M2 m0 m1 H1).
-    Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 ad_z y).
-  Qed.
-
-  Lemma makeM2_canon : 
-      (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> (mapcanon (makeM2 A m m')).
-  Proof.
-    Intro. Case m. Intro. Case m'. Intros. Exact M0_canon.
-    Intros a y H H0. Exact (M1_canon (ad_double_plus_un a) y).
-    Intros. Simpl. (Apply M2_canon; Try Assumption). Exact (mapcanon_M2 m0 m1 H0).
-    Intros a y m'. Case m'. Intros. Exact (M1_canon (ad_double a) y).
-    Intros a0 y0 H H0. Simpl. (Apply M2_canon; Try Assumption). Apply le_n.
-    Intros. Simpl. (Apply M2_canon; Try Assumption).
-    Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H0).
-    Exact (le_plus_r (MapCard A (M1 A a y)) (MapCard A (M2 A m0 m1))).
-    Simpl. Intros. (Apply M2_canon; Try Assumption).
-    Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H).
-    Exact (le_plus_l (MapCard A (M2 A m0 m1)) (MapCard A m')).
-  Qed.
-
-  Fixpoint MapCanonicalize [m:(Map A)] : (Map A) :=
-      Cases m of
-          (M2 m0 m1) => (makeM2 A (MapCanonicalize m0) (MapCanonicalize m1))
-	| _ => m
-      end.
-
-  Lemma mapcanon_exists_1 : (m:(Map A)) (eqmap A m (MapCanonicalize m)).
-  Proof.
-    Induction m. Apply eqmap_refl.
-    Intros. Apply eqmap_refl.
-    Intros. Simpl. Unfold eqmap eqm. Intro.
-    Rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a).
-    Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if.
-    Rewrite <- (H (ad_div_2 a)). Rewrite <- (H0 (ad_div_2 a)). Reflexivity.
-  Qed.
-
-  Lemma mapcanon_exists_2 : (m:(Map A)) (mapcanon (MapCanonicalize m)).
-  Proof.
-    Induction m. Apply M0_canon.
-    Intros. Simpl. Apply M1_canon.
-    Intros. Simpl. (Apply makeM2_canon; Assumption).
-  Qed.
-
-  Lemma mapcanon_exists : 
-      (m:(Map A)) {m':(Map A) | (eqmap A m m') /\ (mapcanon m')}.
-  Proof.
-    Intro. Split with (MapCanonicalize m). Split. Apply mapcanon_exists_1.
-    Apply mapcanon_exists_2.
-  Qed.
-
-  Lemma MapRemove_canon : 
-      (m:(Map A)) (mapcanon m) -> (a:ad) (mapcanon (MapRemove A m a)).
-  Proof.
-    Induction m. Intros. Exact M0_canon.
-    Intros a y H a0. Simpl. Case (ad_eq a a0). Exact M0_canon.
-    Assumption.
-    Intros. Simpl. Case (ad_bit_0 a). Apply makeM2_canon. Exact (mapcanon_M2_1 ? ? H1).
-    Apply H0. Exact (mapcanon_M2_2 ? ? H1).
-    Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1).
-    Exact (mapcanon_M2_2 ? ? H1).
-  Qed.
-
-  Lemma MapMerge_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
-      (mapcanon (MapMerge A m m')).
-  Proof.
-    Induction m. Intros. Exact H0.
-    Simpl. Intros a y m' H H0. Exact (MapPut_behind_canon m' H0 a y).
-    Induction m'. Intros. Exact H1.
-    Intros a y H1 H2. Unfold MapMerge. Exact (MapPut_canon ? H1 a y).
-    Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H3).
-    Exact (mapcanon_M2_1 ? ? H4).
-    Apply H0. Exact (mapcanon_M2_2 ? ? H3).
-    Exact (mapcanon_M2_2 ? ? H4).
-    Change (le (2) (MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3)))).
-    Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H3).
-    Exact (MapMerge_Card_lb_l A (M2 A m0 m1) (M2 A m2 m3)).
-  Qed.
-
-  Lemma MapDelta_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
-      (mapcanon (MapDelta A m m')).
-  Proof.
-    Induction m. Intros. Exact H0.
-    Simpl. Intros a y m' H H0. Case (MapGet A m' a). Exact (MapPut_canon m' H0 a y).
-    Intro. Exact (MapRemove_canon m' H0 a).
-    Induction m'. Intros. Exact H1.
-    Unfold MapDelta. Intros a y H1 H2. Case (MapGet A (M2 A m0 m1) a).
-    Exact (MapPut_canon ? H1 a y).
-    Intro. Exact (MapRemove_canon ? H1 a).
-    Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H3).
-    Exact (mapcanon_M2_1 ? ? H4).
-    Apply H0. Exact (mapcanon_M2_2 ? ? H3).
-    Exact (mapcanon_M2_2 ? ? H4).
-  Qed.
-
-  Variable B : Set.
-
-  Lemma MapDomRestrTo_canon : (m:(Map A)) (mapcanon m) ->
-      (m':(Map B)) (mapcanon (MapDomRestrTo A B m m')).
-  Proof.
-    Induction m. Intros. Exact M0_canon.
-    Simpl. Intros a y H m'. Case (MapGet B m' a). Exact M0_canon.
-    Intro. Apply M1_canon.
-    Induction m'. Exact M0_canon.
-    Unfold MapDomRestrTo. Intros a y. Case (MapGet A (M2 A m0 m1) a). Exact M0_canon.
-    Intro. Apply M1_canon.
-    Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
-    Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
-  Qed.
-
-  Lemma MapDomRestrBy_canon : (m:(Map A)) (mapcanon m) ->
-      (m':(Map B)) (mapcanon (MapDomRestrBy A B m m')).
-  Proof.
-    Induction m. Intros. Exact M0_canon.
-    Simpl. Intros a y H m'. Case (MapGet B m' a). Assumption.
-    Intro. Exact M0_canon.
-    Induction m'. Exact H1.
-    Intros a y. Simpl. Case (ad_bit_0 a). Apply makeM2_canon. Exact (mapcanon_M2_1 ? ? H1).
-    Apply MapRemove_canon. Exact (mapcanon_M2_2 ? ? H1).
-    Apply makeM2_canon. Apply MapRemove_canon. Exact (mapcanon_M2_1 ? ? H1).
-    Exact (mapcanon_M2_2 ? ? H1).
-    Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1).
-    Apply H0. Exact (mapcanon_M2_2 ? ? H1).
-  Qed.
-
-  Lemma Map_of_alist_canon : (l:(alist A)) (mapcanon (Map_of_alist A l)).
-  Proof.
-    Induction l. Exact M0_canon.
-    Intro r. Elim r. Intros a y l0 H. Simpl. Apply MapPut_canon. Assumption.
-  Qed.
-
-  Lemma MapSubset_c_1 : (m:(Map A)) (m':(Map B)) (mapcanon m) ->
-      (MapSubset A B m m') -> (MapDomRestrBy A B m m')=(M0 A).
-  Proof.
-    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Assumption.
-    Apply M0_canon.
-    Exact (MapSubset_imp_2 ? ? m m' H0).
-  Qed.
-
-  Lemma MapSubset_c_2 : (m:(Map A)) (m':(Map B))
-      (MapDomRestrBy A B m m')=(M0 A) -> (MapSubset A B m m').
-  Proof.
-    Intros. Apply MapSubset_2_imp. Unfold MapSubset_2. Rewrite H. Apply eqmap_refl.
-  Qed.
-
-End MapCanon.
-
-Section FSetCanon.
-
-  Variable A : Set.
-
-  Lemma MapDom_canon : (m:(Map A)) (mapcanon A m) -> (mapcanon unit (MapDom A m)).
-  Proof.
-    Induction m. Intro. Exact (M0_canon unit).
-    Intros a y H. Exact (M1_canon unit a ?).
-    Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 A ? ? H1).
-    Apply H0. Exact (mapcanon_M2_2 A ? ? H1).
-    Change (le (2) (MapCard unit (MapDom A (M2 A m0 m1)))). Rewrite <- MapCard_Dom.
-    Exact (mapcanon_M2 A ? ? H1).
-  Qed.
-
-End FSetCanon.
-
-Section MapFoldCanon.
-
-  Variable A, B : Set.
-
-  Lemma MapFold_canon_1 : (m0:(Map B)) (mapcanon B m0) ->
-      (op : (Map B) -> (Map B) -> (Map B))
-      	((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) ->
-	  (mapcanon B (op m1 m2))) ->
-      (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
-	(m:(Map A)) (pf : ad->ad) (mapcanon B (MapFold1 A (Map B) m0 op f pf m)).
-  Proof.
-    Induction m. Intro. Exact H.
-    Intros a y pf. Simpl. Apply H1.
-    Intros. Simpl. Apply H0. Apply H2.
-    Apply H3.
-  Qed.
-
-  Lemma MapFold_canon : (m0:(Map B)) (mapcanon B m0) ->
-      (op : (Map B) -> (Map B) -> (Map B))
-      	((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) ->
-	  (mapcanon B (op m1 m2))) ->
-      (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
-	(m:(Map A)) (mapcanon B (MapFold A (Map B) m0 op f m)).
-  Proof.
-    Intros. Exact (MapFold_canon_1 m0 H op H0 f H1 m [a:ad]a).
-  Qed.
-
-  Lemma MapCollect_canon : 
-      (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
-	(m:(Map A)) (mapcanon B (MapCollect A B f m)).
-  Proof.
-    Intros. Rewrite MapCollect_as_Fold. Apply MapFold_canon. Apply M0_canon.
-    Intros. Exact (MapMerge_canon B m1 m2 H0 H1).
-    Assumption.
-  Qed.
-
-End MapFoldCanon.
diff --git a/theories7/IntMap/Mapcard.v b/theories7/IntMap/Mapcard.v
deleted file mode 100644
index 5c5e2a93..00000000
--- a/theories7/IntMap/Mapcard.v
+++ /dev/null
@@ -1,670 +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: Mapcard.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
-
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Mapaxioms.
-Require Mapiter.
-Require Fset.
-Require Mapsubset.
-Require PolyList.
-Require Lsort.
-Require Peano_dec.
-
-Section MapCard.
-
-  Variable A, B : Set.
-
-  Lemma MapCard_M0 : (MapCard A (M0 A))=O.
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma MapCard_M1 : (a:ad) (y:A) (MapCard A (M1 A a y))=(1).
-  Proof.
-    Trivial.
-  Qed.
-
-  Lemma MapCard_is_O : (m:(Map A)) (MapCard A m)=O -> 
-      (a:ad) (MapGet A m a)=(NONE A).
-  Proof.
-    Induction m. Trivial.
-    Intros a y H. Discriminate H.
-    Intros. Simpl in H1. Elim (plus_is_O ? ? H1). Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
-    Case (ad_bit_0 a). Apply H0. Assumption.
-    Apply H. Assumption.
-  Qed.
-
-  Lemma MapCard_is_not_O : (m:(Map A)) (a:ad) (y:A) (MapGet A m a)=(SOME A y) ->
-      {n:nat | (MapCard A m)=(S n)}.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Intros a y a0 y0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Split with O.
-    Reflexivity.
-    Intro H0. Rewrite H0 in H. Discriminate H.
-    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
-    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Elim (H0 (ad_div_2 a) y H1). Intros n H3.
-    Simpl. Rewrite H3. Split with (plus (MapCard A m0) n).
-    Rewrite <- (plus_Snm_nSm (MapCard A m0) n). Reflexivity.
-    Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Elim (H (ad_div_2 a) y H1).
-    Intros n H3. Simpl. Rewrite H3. Split with (plus n (MapCard A m1)). Reflexivity.
-  Qed.
-
-  Lemma MapCard_is_one : (m:(Map A)) (MapCard A m)=(1) ->
-      {a:ad & {y:A | (MapGet A m a)=(SOME A y)}}.
-  Proof.
-    Induction m. Intro. Discriminate H.
-    Intros a y H. Split with a. Split with y. Apply M1_semantics_1.
-    Intros. Simpl in H1. Elim (plus_is_one (MapCard A m0) (MapCard A m1) H1).
-    Intro H2. Elim H2. Intros. Elim (H0 H4). Intros a H5. Split with (ad_double_plus_un a).
-    Rewrite (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1).
-    Rewrite ad_double_plus_un_div_2. Exact H5.
-    Intro H2. Elim H2. Intros. Elim (H H3). Intros a H5. Split with (ad_double a).
-    Rewrite (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1).
-    Rewrite ad_double_div_2. Exact H5.
-  Qed.
-
-  Lemma MapCard_is_one_unique : (m:(Map A)) (MapCard A m)=(1) -> (a,a':ad) (y,y':A) 
-      (MapGet A m a)=(SOME A y) -> (MapGet A m a')=(SOME A y') ->
-        a=a' /\ y=y'.
-  Proof.
-    Induction m. Intro. Discriminate H.
-    Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0.
-    Rewrite (M1_semantics_1 A a1 a0) in H0. Inversion H0. Elim (sumbool_of_bool (ad_eq a a')).
-    Intro H5. Rewrite (ad_eq_complete ? ? H5) in H1. Rewrite (M1_semantics_1 A a' a0) in H1.
-    Inversion H1. Rewrite <- (ad_eq_complete ? ? H2). Rewrite <- (ad_eq_complete ? ? H5).
-    Rewrite <- H4. Rewrite <- H6. (Split; Reflexivity).
-    Intro H5. Rewrite (M1_semantics_2 A a a' a0 H5) in H1. Discriminate H1.
-    Intro H2. Rewrite (M1_semantics_2 A a a1 a0 H2) in H0. Discriminate H0.
-    Intros. Simpl in H1. Elim (plus_is_one ? ? H1). Intro H4. Elim H4. Intros.
-    Rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. Elim (sumbool_of_bool (ad_bit_0 a)).
-    Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3.
-    Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3. Elim (H0 H6 ? ? ? ? H2 H3).
-    Intros. Split. Rewrite <- (ad_div_2_double_plus_un a H7).
-    Rewrite <- (ad_div_2_double_plus_un a' H8). Rewrite H9. Reflexivity.
-    Assumption.
-    Intro H8. Rewrite H8 in H3. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a')) in H3.
-    Discriminate H3.
-    Intro H7. Rewrite H7 in H2. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a)) in H2.
-    Discriminate H2.
-    Intro H4. Elim H4. Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2.
-    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H7. Rewrite H7 in H2.
-    Rewrite (MapCard_is_O m1 H6 (ad_div_2 a)) in H2. Discriminate H2.
-    Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3.
-    Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3.
-    Rewrite (MapCard_is_O m1 H6 (ad_div_2 a')) in H3. Discriminate H3.
-    Intro H8. Rewrite H8 in H3. Elim (H H5 ? ? ? ? H2 H3). Intros. Split.
-    Rewrite <- (ad_div_2_double a H7). Rewrite <- (ad_div_2_double a' H8).
-    Rewrite H9. Reflexivity.
-    Assumption.
-  Qed.
-
-  Lemma length_as_fold : (C:Set) (l:(list C)) 
-      (length l)=(fold_right [_:C][n:nat](S n) O l).
-  Proof.
-    Induction l. Reflexivity.
-    Intros. Simpl. Rewrite H. Reflexivity.
-  Qed.
-
-  Lemma length_as_fold_2 : (l:(alist A)) 
-      (length l)=(fold_right [r:ad*A][n:nat]let (a,y)=r in (plus (1) n) O l).
-  Proof.
-    Induction l. Reflexivity.
-    Intros. Simpl. Rewrite H. (Elim a; Reflexivity).
-  Qed.
-
-  Lemma MapCard_as_Fold_1 : (m:(Map A)) (pf:ad->ad)
-      (MapCard A m)=(MapFold1 A nat O plus [_:ad][_:A](1) pf m).
-  Proof.
-    Induction m. Trivial.
-    Trivial.
-    Intros. Simpl. Rewrite <- (H [a0:ad](pf (ad_double a0))).
-    Rewrite <- (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
-  Qed.
-
-  Lemma MapCard_as_Fold : 
-      (m:(Map A)) (MapCard A m)=(MapFold A nat O plus [_:ad][_:A](1) m).
-  Proof.
-    Intro. Exact (MapCard_as_Fold_1 m [a0:ad]a0).
-  Qed.
- 
-  Lemma MapCard_as_length : (m:(Map A)) (MapCard A m)=(length (alist_of_Map A m)).
-  Proof.
-    Intro. Rewrite MapCard_as_Fold. Rewrite length_as_fold_2.
-    Apply MapFold_as_fold with op:=plus neutral:=O f:=[_:ad][_:A](1). Exact plus_assoc_r.
-    Trivial.
-    Intro. Rewrite <- plus_n_O. Reflexivity.
-  Qed.
-
-  Lemma MapCard_Put1_equals_2 : (p:positive) (a,a':ad) (y,y':A)
-      (MapCard A (MapPut1 A a y a' y' p))=(2).
-  Proof.
-    Induction p. Intros. Simpl. (Case (ad_bit_0 a); Reflexivity).
-    Intros. Simpl. Case (ad_bit_0 a). Exact (H (ad_div_2 a) (ad_div_2 a') y y').
-    Simpl. Rewrite <- plus_n_O. Exact (H (ad_div_2 a) (ad_div_2 a') y y').
-    Intros. Simpl. (Case (ad_bit_0 a); Reflexivity).
-  Qed.
-
-  Lemma MapCard_Put_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat)
-      m'=(MapPut A m a y) -> n=(MapCard A m) -> n'=(MapCard A m') ->
-        {n'=n}+{n'=(S n)}.
-  Proof.
-    Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Right .
-    Rewrite H0. Rewrite H1. Reflexivity.
-    Intros a y m' a0 y0 n n' H H0 H1. Simpl in H. Elim (ad_sum (ad_xor a a0)). Intro H2.
-    Elim H2. Intros p H3. Rewrite H3 in H. Rewrite H in H1.
-    Rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H1. Simpl in H0. Right .
-    Rewrite H0. Rewrite H1. Reflexivity.
-    Intro H2. Rewrite H2 in H. Rewrite H in H1. Simpl in H1. Simpl in H0. Left .
-    Rewrite H0. Rewrite H1. Reflexivity.
-    Intros. Simpl in H2. Rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1.
-    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4. Rewrite H4 in H1.
-    Elim (H0 (MapPut A m1 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m1)
-       (MapCard A (MapPut A m1 (ad_div_2 a) y)) (refl_equal ? ?)
-       (refl_equal ? ?) (refl_equal ? ?)).
-    Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Rewrite <- H2 in H3. Left .
-    Assumption.
-    Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3.
-    Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)) in H3.
-    Simpl in H3. Rewrite <- H2 in H3. Right . Assumption.
-    Intro H4. Rewrite H4 in H1.
-    Elim (H (MapPut A m0 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m0)
-       (MapCard A (MapPut A m0 (ad_div_2 a) y)) (refl_equal ? ?)
-       (refl_equal ? ?) (refl_equal ? ?)).
-    Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Rewrite <- H2 in H3.
-    Left . Assumption.
-    Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Simpl in H3. Rewrite <- H2 in H3.
-    Right . Assumption.
-  Qed.
-
-  Lemma MapCard_Put_lb : (m:(Map A)) (a:ad) (y:A)
-      (ge (MapCard A (MapPut A m a y)) (MapCard A m)).
-  Proof.
-    Unfold ge. Intros.
-    Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
-       (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
-       (refl_equal ? ?)).
-    Intro H. Rewrite H. Apply le_n.
-    Intro H. Rewrite H. Apply le_n_Sn.
-  Qed.
-
-  Lemma MapCard_Put_ub : (m:(Map A)) (a:ad) (y:A)
-      (le (MapCard A (MapPut A m a y)) (S (MapCard A m))).
-  Proof.
-    Intros.
-    Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
-       (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
-       (refl_equal ? ?)).
-    Intro H. Rewrite H. Apply le_n_Sn.
-    Intro H. Rewrite H. Apply le_n.
-  Qed.
-
-  Lemma MapCard_Put_1 : (m:(Map A)) (a:ad) (y:A)
-      (MapCard A (MapPut A m a y))=(MapCard A m) -> 
-        {y:A | (MapGet A m a)=(SOME A y)}.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Intros a y a0 y0 H. Simpl in H. Elim (ad_sum (ad_xor a a0)). Intro H0. Elim H0.
-    Intros p H1. Rewrite H1 in H. Rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H.
-    Discriminate H.
-    Intro H0. Rewrite H0 in H. Rewrite (ad_xor_eq ? ? H0). Split with y. Apply M1_semantics_1.
-    Intros. Rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. Elim (sumbool_of_bool (ad_bit_0 a)).
-    Intro H2. Rewrite H2 in H1. Simpl in H1. Elim (H0 (ad_div_2 a) y (simpl_plus_l ? ? ? H1)).
-    Intros y0 H3. Split with y0. Rewrite <- H3. Exact (MapGet_M2_bit_0_1 A a H2 m0 m1).
-    Intro H2. Rewrite H2 in H1. Simpl in H1.
-    Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H1.
-    Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1.
-    Elim (H (ad_div_2 a) y (simpl_plus_l ? ? ? H1)). Intros y0 H3. Split with y0.
-    Rewrite <- H3. Exact (MapGet_M2_bit_0_0 A a H2 m0 m1).
-  Qed.
-
-  Lemma MapCard_Put_2 : (m:(Map A)) (a:ad) (y:A)
-      (MapCard A (MapPut A m a y))=(S (MapCard A m)) -> (MapGet A m a)=(NONE A).
-  Proof.
-    Induction m. Trivial.
-    Intros. Simpl in H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0.
-    Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_xor_nilpotent a1) in H. Discriminate H.
-    Intro H0. Exact (M1_semantics_2 A a a1 a0 H0).
-    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
-    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply (H0 (ad_div_2 a) y).
-    Apply simpl_plus_l with n:=(MapCard A m0).
-    Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). Simpl in H1. Simpl. Rewrite <- H1.
-    Clear H1.
-    NewInduction a. Discriminate H2.
-    NewInduction p. Reflexivity.
-    Discriminate H2.
-    Reflexivity.
-    Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply (H (ad_div_2 a) y).
-    Cut (plus (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1))
-         =(plus (S (MapCard A m0)) (MapCard A m1)).
-    Intro. Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H3.
-    Rewrite (plus_sym (S (MapCard A m0)) (MapCard A m1)) in H3. Exact (simpl_plus_l ? ? ? H3).
-    Simpl. Simpl in H1. Rewrite <- H1. NewInduction a. Trivial.
-    NewInduction p. Discriminate H2.
-    Reflexivity.
-    Discriminate H2.
-  Qed.
-
-  Lemma MapCard_Put_1_conv : (m:(Map A)) (a:ad) (y,y':A)
-      (MapGet A m a)=(SOME A y) -> (MapCard A (MapPut A m a y'))=(MapCard A m).
-  Proof.
-    Intros.
-    Elim (MapCard_Put_sum m (MapPut A m a y') a y' (MapCard A m)
-           (MapCard A (MapPut A m a y')) (refl_equal ? ?) (refl_equal ? ?)
-           (refl_equal ? ?)).
-    Trivial.
-    Intro H0. Rewrite (MapCard_Put_2 m a y' H0) in H. Discriminate H.
-  Qed.
-
-  Lemma MapCard_Put_2_conv : (m:(Map A)) (a:ad) (y:A)
-      (MapGet A m a)=(NONE A) -> (MapCard A (MapPut A m a y))=(S (MapCard A m)).
-  Proof.
-    Intros.
-    Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
-           (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
-           (refl_equal ? ?)).
-    Intro H0. Elim (MapCard_Put_1 m a y H0). Intros y' H1. Rewrite H1 in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma MapCard_ext : (m,m':(Map A))
-      (eqm A (MapGet A m) (MapGet A m')) -> (MapCard A m)=(MapCard A m').
-  Proof.
-    Unfold eqm. Intros. Rewrite (MapCard_as_length m). Rewrite (MapCard_as_length m').
-    Rewrite (alist_canonical A (alist_of_Map A m) (alist_of_Map A m')). Reflexivity.
-    Unfold eqm. Intro. Rewrite (Map_of_alist_semantics A (alist_of_Map A m) a).
-    Rewrite (Map_of_alist_semantics A (alist_of_Map A m') a). Rewrite (Map_of_alist_of_Map A m' a).
-    Rewrite (Map_of_alist_of_Map A m a). Exact (H a).
-    Apply alist_of_Map_sorts2.
-    Apply alist_of_Map_sorts2.
-  Qed.
-
-  Lemma MapCard_Dom : (m:(Map A)) (MapCard A m)=(MapCard unit (MapDom A m)).
-  Proof.
-    (Induction m; Trivial). Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
-  Qed.
-
-  Lemma MapCard_Dom_Put_behind : (m:(Map A)) (a:ad) (y:A)
-      (MapDom A (MapPut_behind A m a y))=(MapDom A (MapPut A m a y)).
-  Proof.
-    Induction m. Trivial.
-    Intros a y a0 y0. Simpl. Elim (ad_sum (ad_xor a a0)). Intro H. Elim H.
-    Intros p H0. Rewrite H0. Reflexivity.
-    Intro H. Rewrite H. Rewrite (ad_xor_eq ? ? H). Reflexivity.
-    Intros. Simpl. Elim (ad_sum a). Intro H1. Elim H1. Intros p H2. Rewrite H2. Case p.
-    Intro p0. Simpl. Rewrite H0. Reflexivity.
-    Intro p0. Simpl. Rewrite H. Reflexivity.
-    Simpl. Rewrite H0. Reflexivity.
-    Intro H1. Rewrite H1. Simpl. Rewrite H. Reflexivity.
-  Qed.
-
-  Lemma MapCard_Put_behind_Put : (m:(Map A)) (a:ad) (y:A)
-      (MapCard A (MapPut_behind A m a y))=(MapCard A (MapPut A m a y)).
-  Proof.
-    Intros. Rewrite MapCard_Dom. Rewrite MapCard_Dom. Rewrite MapCard_Dom_Put_behind.
-    Reflexivity.
-  Qed.
-
-  Lemma MapCard_Put_behind_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat)
-      m'=(MapPut_behind A m a y) -> n=(MapCard A m) -> n'=(MapCard A m') ->
-        {n'=n}+{n'=(S n)}.
-  Proof.
-    Intros. (Apply (MapCard_Put_sum m (MapPut A m a y) a y n n'); Trivial).
-    Rewrite <- MapCard_Put_behind_Put. Rewrite <- H. Assumption.
-  Qed.
-
-  Lemma MapCard_makeM2 : (m,m':(Map A))
-      (MapCard A (makeM2 A m m'))=(plus (MapCard A m) (MapCard A m')).
-  Proof.
-    Intros. Rewrite (MapCard_ext ? ? (makeM2_M2 A m m')). Reflexivity.
-  Qed.
- 
-  Lemma MapCard_Remove_sum : (m,m':(Map A)) (a:ad) (n,n':nat)
-      m'=(MapRemove A m a) -> n=(MapCard A m) -> n'=(MapCard A m') ->
-        {n=n'}+{n=(S n')}.
-  Proof.
-    Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption.
-    Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite H2 in H.
-    Rewrite H in H1. Simpl in H1. Right . Rewrite H1. Assumption.
-    Intro H2. Rewrite H2 in H. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption.
-    Intros. Simpl in H1. Simpl in H2. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4.
-    Rewrite H4 in H1. Rewrite H1 in H3.
-    Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H3.
-    Elim (H0 (MapRemove A m1 (ad_div_2 a)) (ad_div_2 a) (MapCard A m1)
-             (MapCard A (MapRemove A m1 (ad_div_2 a))) (refl_equal ? ?)
-             (refl_equal ? ?) (refl_equal ? ?)).
-    Intro H5. Rewrite H5 in H2. Left . Rewrite H3. Exact H2.
-    Intro H5. Rewrite H5 in H2.
-    Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H2.
-    Right . Rewrite H3. Exact H2.
-    Intro H4. Rewrite H4 in H1. Rewrite H1 in H3.
-    Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H3.
-    Elim (H (MapRemove A m0 (ad_div_2 a)) (ad_div_2 a) (MapCard A m0)
-            (MapCard A (MapRemove A m0 (ad_div_2 a))) (refl_equal ? ?)
-            (refl_equal ? ?) (refl_equal ? ?)).
-    Intro H5. Rewrite H5 in H2. Left . Rewrite H3. Exact H2.
-    Intro H5. Rewrite H5 in H2. Right . Rewrite H3. Exact H2.
-  Qed.
-
-  Lemma MapCard_Remove_ub : (m:(Map A)) (a:ad)
-      (le (MapCard A (MapRemove A m a)) (MapCard A m)).
-  Proof.
-    Intros.
-    Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
-           (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
-           (refl_equal ? ?)).
-    Intro H. Rewrite H. Apply le_n.
-    Intro H. Rewrite H. Apply le_n_Sn.
-  Qed.
-
-  Lemma MapCard_Remove_lb : (m:(Map A)) (a:ad)
-      (ge (S (MapCard A (MapRemove A m a))) (MapCard A m)).
-  Proof.
-    Unfold ge. Intros.
-    Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
-           (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
-           (refl_equal ? ?)).
-    Intro H. Rewrite H. Apply le_n_Sn.
-    Intro H. Rewrite H. Apply le_n.
-  Qed.
-
-  Lemma MapCard_Remove_1 : (m:(Map A)) (a:ad)
-      (MapCard A (MapRemove A m a))=(MapCard A m) -> (MapGet A m a)=(NONE A).
-  Proof.
-    Induction m. Trivial.
-    Simpl. Intros a y a0 H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0.
-    Rewrite H0 in H. Discriminate H.
-    Intro H0. Rewrite H0. Reflexivity.
-    Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1.
-    Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1.
-    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0. Exact (simpl_plus_l ? ? ? H1).
-    Intro H2. Rewrite H2 in H1.
-    Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1.
-    Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H.
-    Rewrite (plus_sym (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1)) in H1.
-    Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1).
-  Qed.
-
-  Lemma MapCard_Remove_2 : (m:(Map A)) (a:ad)
-      (S (MapCard A (MapRemove A m a)))=(MapCard A m) -> 
-        {y:A | (MapGet A m a)=(SOME A y)}.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Intros a y a0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0.
-    Rewrite (ad_eq_complete ? ? H0). Split with y. Exact (M1_semantics_1 A a0 y).
-    Intro H0. Rewrite H0 in H. Discriminate H.
-    Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1.
-    Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1.
-    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0.
-    Change (plus (S (MapCard A m0)) (MapCard A (MapRemove A m1 (ad_div_2 a))))
-            =(plus (MapCard A m0) (MapCard A m1)) in H1.
-    Rewrite (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H1.
-    Exact (simpl_plus_l ? ? ? H1).
-    Intro H2. Rewrite H2 in H1. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H.
-    Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1.
-    Change (plus (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1))
-      	   =(plus (MapCard A m0) (MapCard A m1)) in H1.
-    Rewrite (plus_sym (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) in H1.
-    Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1).
-  Qed.
-
-  Lemma MapCard_Remove_1_conv : (m:(Map A)) (a:ad)
-      (MapGet A m a)=(NONE A) -> (MapCard A (MapRemove A m a))=(MapCard A m).
-  Proof.
-    Intros.
-    Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
-           (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
-           (refl_equal ? ?)).
-    Intro H0. Rewrite H0. Reflexivity.
-    Intro H0. Elim (MapCard_Remove_2 m a (sym_eq ? ? ? H0)). Intros y H1. Rewrite H1 in H.
-    Discriminate H.
-  Qed.
-
-  Lemma MapCard_Remove_2_conv : (m:(Map A)) (a:ad) (y:A)
-      (MapGet A m a)=(SOME A y) -> 
-        (S (MapCard A (MapRemove A m a)))=(MapCard A m).
-  Proof.
-    Intros.
-    Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
-           (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
-           (refl_equal ? ?)).
-    Intro H0. Rewrite (MapCard_Remove_1 m a (sym_eq ? ? ? H0)) in H. Discriminate H.
-    Intro H0. Rewrite H0. Reflexivity.
-  Qed.
-
-  Lemma MapMerge_Restr_Card : (m,m':(Map A))
-      (plus (MapCard A m) (MapCard A m'))=
-      (plus (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))).
-  Proof.
-    Induction m. Simpl. Intro. Apply plus_n_O.
-    Simpl. Intros a y m'. Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y0 H0.
-    Rewrite H0. Rewrite MapCard_Put_behind_Put. Rewrite (MapCard_Put_1_conv m' a y0 y H0).
-    Simpl. Rewrite <- plus_Snm_nSm. Apply plus_n_O.
-    Intro H. Rewrite H. Rewrite MapCard_Put_behind_Put. Rewrite (MapCard_Put_2_conv m' a y H).
-    Apply plus_n_O.
-    Intros.
-    Change (plus (plus (MapCard A m0) (MapCard A m1)) (MapCard A m'))
-            =(plus (MapCard A (MapMerge A (M2 A m0 m1) m'))
-               (MapCard A (MapDomRestrTo A A (M2 A m0 m1) m'))).
-    Elim m'. Reflexivity.
-    Intros a y. Unfold MapMerge. Unfold MapDomRestrTo.
-    Elim (option_sum A (MapGet A (M2 A m0 m1) a)). Intro H1. Elim H1. Intros y0 H2. Rewrite H2.
-    Rewrite (MapCard_Put_1_conv (M2 A m0 m1) a y0 y H2). Reflexivity.
-    Intro H1. Rewrite H1. Rewrite (MapCard_Put_2_conv (M2 A m0 m1) a y H1). Simpl.
-    Rewrite <- (plus_Snm_nSm (plus (MapCard A m0) (MapCard A m1)) O). Reflexivity.
-    Intros. Simpl.
-    Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m1) (MapCard A m2) (MapCard A m3)).
-    Rewrite (H m2). Rewrite (H0 m3).
-    Rewrite (MapCard_makeM2 (MapDomRestrTo A A m0 m2) (MapDomRestrTo A A m1 m3)).
-    Apply plus_permute_2_in_4.
-  Qed.
-
-  Lemma MapMerge_disjoint_Card : (m,m':(Map A)) (MapDisjoint A A m m') ->
-      	(MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')).
-  Proof.
-    Intros. Rewrite (MapMerge_Restr_Card m m').
-    Rewrite (MapCard_ext ? ? (MapDisjoint_imp_2 ? ? ? ? H)). Apply plus_n_O.
-  Qed.
-
-  Lemma MapSplit_Card : (m:(Map A)) (m':(Map B))
-      (MapCard A m)=(plus (MapCard A (MapDomRestrTo A B m m'))
-                          (MapCard A (MapDomRestrBy A B m m'))).
-  Proof.
-    Intros. Rewrite (MapCard_ext ? ? (MapDom_Split_1 A B m m')). Apply MapMerge_disjoint_Card.
-    Apply MapDisjoint_2_imp. Unfold MapDisjoint_2. Apply MapDom_Split_3.
-  Qed.
-
-  Lemma MapMerge_Card_ub : (m,m':(Map A))
-      (le (MapCard A (MapMerge A m m')) (plus (MapCard A m) (MapCard A m'))).
-  Proof.
-    Intros. Rewrite MapMerge_Restr_Card. Apply le_plus_l.
-  Qed.
-
-  Lemma MapDomRestrTo_Card_ub_l : (m:(Map A)) (m':(Map B))
-      (le (MapCard A (MapDomRestrTo A B m m')) (MapCard A m)).
-  Proof.
-    Intros. Rewrite (MapSplit_Card m m'). Apply le_plus_l.
-  Qed.
-
-  Lemma MapDomRestrBy_Card_ub_l : (m:(Map A)) (m':(Map B))
-      (le (MapCard A (MapDomRestrBy A B m m')) (MapCard A m)).
-  Proof.
-    Intros. Rewrite (MapSplit_Card m m'). Apply le_plus_r.
-  Qed.
-
-  Lemma MapMerge_Card_disjoint : (m,m':(Map A))
-      (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')) ->
-        (MapDisjoint A A m m').
-  Proof.
-    Induction m. Intros. Apply Map_M0_disjoint.
-    Simpl. Intros. Rewrite (MapCard_Put_behind_Put m' a a0) in H. Unfold MapDisjoint in_dom.
-    Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2.
-    Rewrite (ad_eq_complete ? ? H2) in H. Rewrite (MapCard_Put_2 m' a1 a0 H) in H1.
-    Discriminate H1.
-    Intro H2. Rewrite H2 in H0. Discriminate H0.
-    Induction m'. Intros. Apply Map_disjoint_M0.
-    Intros a y H1. Rewrite <- (MapCard_ext ? ? (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1.
-    Unfold 3 MapCard in H1. Rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) O) in H1.
-    Rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. Unfold MapDisjoint in_dom.
-    Unfold 2 MapGet. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H4.
-    Rewrite <- (ad_eq_complete ? ? H4) in H2. Rewrite (MapCard_Put_2 ? ? ? H1) in H2.
-    Discriminate H2.
-    Intro H4. Rewrite H4 in H3. Discriminate H3.
-    Intros. Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H6.
-    Unfold MapDisjoint in H0. Apply H0 with m':=m3 a:=(ad_div_2 a). Apply le_antisym.
-    Apply MapMerge_Card_ub.
-    Apply simpl_le_plus_l with p:=(plus (MapCard A m0) (MapCard A m2)).
-    Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (MapCard A m1) (MapCard A m3)).
-    Change (MapCard A (M2 A (MapMerge A m0 m2) (MapMerge A m1 m3)))
-           =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3.
-    Rewrite <- H3. Simpl. Apply le_reg_r. Apply MapMerge_Card_ub.
-    Elim (in_dom_some ? ? ? H4). Intros y H7. Rewrite (MapGet_M2_bit_0_1 ? a H6 m0 m1) in H7.
-    Unfold in_dom. Rewrite H7. Reflexivity.
-    Elim (in_dom_some ? ? ? H5). Intros y H7. Rewrite (MapGet_M2_bit_0_1 ? a H6 m2 m3) in H7.
-    Unfold in_dom. Rewrite H7. Reflexivity.
-    Intro H6. Unfold MapDisjoint in H. Apply H with m':=m2 a:=(ad_div_2 a). Apply le_antisym.
-    Apply MapMerge_Card_ub.
-    Apply simpl_le_plus_l with p:=(plus (MapCard A m1) (MapCard A m3)).
-    Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (plus (MapCard A m0) (MapCard A m2))).
-    Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (MapCard A m1) (MapCard A m3)).
-    Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (MapCard A (MapMerge A m0 m2))).
-    Change (plus (MapCard A (MapMerge A m0 m2)) (MapCard A (MapMerge A m1 m3)))
-           =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3.
-    Rewrite <- H3. Apply le_reg_l. Apply MapMerge_Card_ub.
-    Elim (in_dom_some ? ? ? H4). Intros y H7. Rewrite (MapGet_M2_bit_0_0 ? a H6 m0 m1) in H7.
-    Unfold in_dom. Rewrite H7. Reflexivity.
-    Elim (in_dom_some ? ? ? H5). Intros y H7. Rewrite (MapGet_M2_bit_0_0 ? a H6 m2 m3) in H7.
-    Unfold in_dom. Rewrite H7. Reflexivity.
-  Qed.
-
-  Lemma MapCard_is_Sn : (m:(Map A)) (n:nat) (MapCard ? m)=(S n) -> 
-      {a:ad | (in_dom ? a m)=true}.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Intros a y n H. Split with a. Unfold in_dom. Rewrite (M1_semantics_1 ? a y). Reflexivity.
-    Intros. Simpl in H1. Elim (O_or_S (MapCard ? m0)). Intro H2. Elim H2. Intros m2 H3.
-    Elim (H ? (sym_eq ? ? ? H3)). Intros a H4. Split with (ad_double a). Unfold in_dom.
-    Rewrite (MapGet_M2_bit_0_0 A (ad_double a) (ad_double_bit_0 a) m0 m1).
-    Rewrite (ad_double_div_2 a). Elim (in_dom_some ? ? ? H4). Intros y H5. Rewrite H5. Reflexivity.
-    Intro H2. Rewrite <- H2 in H1. Simpl in H1. Elim (H0 ? H1). Intros a H3.
-    Split with (ad_double_plus_un a). Unfold in_dom.
-    Rewrite (MapGet_M2_bit_0_1 A (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1).
-    Rewrite (ad_double_plus_un_div_2 a). Elim (in_dom_some ? ? ? H3). Intros y H4. Rewrite H4.
-    Reflexivity.
-  Qed.
-
-End MapCard.
-
-Section MapCard2.
-
-  Variable A, B : Set.
-
-  Lemma MapSubset_card_eq_1 : (n:nat) (m:(Map A)) (m':(Map B))
-      (MapSubset ? ? m m') -> (MapCard ? m)=n -> (MapCard ? m')=n ->
-        (MapSubset ? ? m' m).
-  Proof.
-    Induction n. Intros. Unfold MapSubset in_dom. Intro. Rewrite (MapCard_is_O ? m H0 a).
-    Rewrite (MapCard_is_O ? m' H1 a). Intro H2. Discriminate H2.
-    Intros. Elim (MapCard_is_Sn A m n0 H1). Intros a H3. Elim (in_dom_some ? ? ? H3).
-    Intros y H4. Elim (in_dom_some ? ? ? (H0 ? H3)). Intros y' H6.
-    Cut (eqmap ? (MapPut ? (MapRemove ? m a) a y) m). Intro.
-    Cut (eqmap ? (MapPut ? (MapRemove ? m' a) a y') m'). Intro.
-    Apply MapSubset_ext with m0:=(MapPut ? (MapRemove ? m' a) a y')
-                             m2:=(MapPut ? (MapRemove ? m a) a y).
-    Assumption.
-    Assumption.
-    Apply MapSubset_Put_mono. Apply H. Apply MapSubset_Remove_mono. Assumption.
-    Rewrite <- (MapCard_Remove_2_conv ? m a y H4) in H1. Inversion_clear H1. Reflexivity.
-    Rewrite <- (MapCard_Remove_2_conv ? m' a y' H6) in H2. Inversion_clear H2. Reflexivity.
-    Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove B m' a) a y' a0).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7).
-    Apply sym_eq. Assumption.
-    Intro H7. Rewrite H7. Rewrite (MapRemove_semantics ? m' a a0). Rewrite H7. Reflexivity.
-    Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove A m a) a y a0).
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7).
-    Apply sym_eq. Assumption.
-    Intro H7. Rewrite H7. Rewrite (MapRemove_semantics A m a a0). Rewrite H7. Reflexivity.
-  Qed.
-
-  Lemma MapDomRestrTo_Card_ub_r : (m:(Map A)) (m':(Map B))
-      (le (MapCard A (MapDomRestrTo A B m m')) (MapCard B m')).
-  Proof.
-    Induction m. Intro. Simpl. Apply le_O_n.
-    Intros a y m'. Simpl. Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y0 H0.
-    Rewrite H0. Elim (MapCard_is_not_O B m' a y0 H0). Intros n H1. Rewrite H1. Simpl.
-    Apply le_n_S. Apply le_O_n.
-    Intro H. Rewrite H. Simpl. Apply le_O_n.
-    Induction m'. Simpl. Apply le_O_n.
-
-    Intros a y. Unfold MapDomRestrTo. Case (MapGet A (M2 A m0 m1) a). Simpl. Apply le_O_n.
-    Intro. Simpl. Apply le_n.
-    Intros. Simpl. Rewrite (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)).
-    Apply le_plus_plus. Apply H.
-    Apply H0.
-  Qed.
-
-End MapCard2.
-
-Section MapCard3.
-
-  Variable A, B : Set.
-
-  Lemma MapMerge_Card_lb_l : (m,m':(Map A))
-      (ge (MapCard A (MapMerge A m m')) (MapCard A m)).
-  Proof.
-    Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m')).
-    Rewrite (plus_sym (MapCard A m') (MapCard A m)).
-    Rewrite (plus_sym (MapCard A m') (MapCard A (MapMerge A m m'))).
-    Rewrite (MapMerge_Restr_Card A m m'). Apply le_reg_l. Apply MapDomRestrTo_Card_ub_r.
-  Qed.
-
-  Lemma MapMerge_Card_lb_r : (m,m':(Map A))
-      (ge (MapCard A (MapMerge A m m')) (MapCard A m')).
-  Proof.
-    Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m)). Rewrite (MapMerge_Restr_Card A m m').
-    Rewrite (plus_sym (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))).
-    Apply le_reg_r. Apply MapDomRestrTo_Card_ub_l.
-  Qed.
-
-  Lemma MapDomRestrBy_Card_lb : (m:(Map A)) (m':(Map B))
-      (ge (plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))) (MapCard A m)).
-  Proof.
-    Unfold ge. Intros. Rewrite (MapSplit_Card A B m m'). Apply le_reg_r.
-    Apply MapDomRestrTo_Card_ub_r.
-  Qed.
-
-  Lemma MapSubset_Card_le : (m:(Map A)) (m':(Map B))
-      (MapSubset A B m m') -> (le (MapCard A m) (MapCard B m')).
-  Proof.
-    Intros. Apply le_trans with m:=(plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))).
-    Exact (MapDomRestrBy_Card_lb m m').
-    Rewrite (MapCard_ext ? ? ? (MapSubset_imp_2 ? ? ? ? H)). Simpl. Rewrite <- plus_n_O.
-    Apply le_n.
-  Qed.
-
-  Lemma MapSubset_card_eq : (m:(Map A)) (m':(Map B))
-      (MapSubset ? ? m m') -> (le (MapCard ? m') (MapCard ? m)) ->
-        (eqmap ? (MapDom ? m) (MapDom ? m')).
-  Proof.
-    Intros. Apply MapSubset_antisym. Assumption.
-    Cut (MapCard B m')=(MapCard A m). Intro. Apply (MapSubset_card_eq_1 A B (MapCard A m)).
-    Assumption.
-    Reflexivity.
-    Assumption.
-    Apply le_antisym. Assumption.
-    Apply MapSubset_Card_le. Assumption.
-  Qed.
-
-End MapCard3.
diff --git a/theories7/IntMap/Mapfold.v b/theories7/IntMap/Mapfold.v
deleted file mode 100644
index 8061f253..00000000
--- a/theories7/IntMap/Mapfold.v
+++ /dev/null
@@ -1,381 +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: Mapfold.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $      i*)
-
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Fset.
-Require Mapaxioms.
-Require Mapiter.
-Require Lsort.
-Require Mapsubset.
-Require PolyList.
-
-Section MapFoldResults.
-
-  Variable A : Set.
-
-  Variable M : Set.
-  Variable neutral : M.
-  Variable op : M -> M -> M.
-
-  Variable nleft : (a:M) (op neutral a)=a.
-  Variable nright : (a:M) (op a neutral)=a.
-  Variable assoc : (a,b,c:M) (op (op a b) c)=(op a (op b c)).
-
-  Lemma MapFold_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') ->
-      (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op f m').
-  Proof.
-    Intros. Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m).
-    Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m').
-    Cut (alist_of_Map A m)=(alist_of_Map A m'). Intro. Rewrite H0. Reflexivity.
-    Apply alist_canonical. Unfold eqmap in H. Apply eqm_trans with f':=(MapGet A m).
-    Apply eqm_sym. Apply alist_of_Map_semantics.
-    Apply eqm_trans with f':=(MapGet A m'). Assumption.
-    Apply alist_of_Map_semantics.
-    Apply alist_of_Map_sorts2.
-    Apply alist_of_Map_sorts2.
-  Qed.
-
-  Lemma MapFold_ext_f_1 : (m:(Map A)) (f,g:ad->A->M) (pf:ad->ad)
-      ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y) -> (f (pf a) y)=(g (pf a) y)) ->
-        (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op g pf m).
-  Proof.
-    Induction m. Trivial.
-    Simpl. Intros. Apply H. Rewrite (ad_eq_correct a). Reflexivity.
-    Intros. Simpl. Rewrite (H f g [a0:ad](pf (ad_double a0))).
-    Rewrite (H0 f g [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
-    Intros. Apply H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption.
-    Apply ad_double_plus_un_bit_0.
-    Intros. Apply H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
-    Apply ad_double_bit_0.
-  Qed.
-
-  Lemma MapFold_ext_f : (f,g:ad->A->M) (m:(Map A))
-      ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y) -> (f a y)=(g a y)) ->
-        (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op g m).
-  Proof.
-    Intros. Exact (MapFold_ext_f_1 m f g [a0:ad]a0 H).
-  Qed.
-
-  Lemma MapFold1_as_Fold_1 : (m:(Map A)) (f,f':ad->A->M) (pf, pf':ad->ad)
-      ((a:ad) (y:A) (f (pf a) y)=(f' (pf' a) y)) ->
-        (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f' pf' m).
-  Proof.
-    Induction m. Trivial.
-    Intros. Simpl. Apply H.
-    Intros. Simpl.
-    Rewrite (H f f' [a0:ad](pf (ad_double a0)) [a0:ad](pf' (ad_double a0))).
-    Rewrite (H0 f f' [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](pf' (ad_double_plus_un a0))).
-    Reflexivity.
-    Intros. Apply H1.
-    Intros. Apply H1.
-  Qed.
-
-  Lemma MapFold1_as_Fold : (f:ad->A->M) (pf:ad->ad) (m:(Map A))
-      (MapFold1 ? ? neutral op f pf m)=(MapFold ? ? neutral op [a:ad][y:A] (f (pf a) y) m).
-  Proof.
-    Intros. Unfold MapFold. Apply MapFold1_as_Fold_1. Trivial.
-  Qed.
-
-  Lemma MapFold1_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') -> (pf:ad->ad)
-      (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f pf m').
-  Proof.
-    Intros. Rewrite MapFold1_as_Fold. Rewrite MapFold1_as_Fold. Apply MapFold_ext. Assumption.
-  Qed.
-
-  Variable comm : (a,b:M) (op a b)=(op b a).
-
-  Lemma MapFold_Put_disjoint_1 : (p:positive)
-        (f:ad->A->M) (pf:ad->ad) (a1,a2:ad) (y1,y2:A) 
-	  (ad_xor a1 a2)=(ad_x p) ->
-      	    (MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p))=
-	    (op (f (pf a1) y1) (f (pf a2) y2)).
-  Proof.
-    Induction p. Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1.
-    Simpl. Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double. Apply comm.
-    Change (ad_bit_0 a2)=(negb true). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0).
-    Rewrite negb_elim. Reflexivity.
-    Assumption.
-    Intro H1. Rewrite H1. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un.
-    Reflexivity.
-    Change (ad_bit_0 a2)=(negb false). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0).
-    Rewrite negb_elim. Reflexivity.
-    Assumption.
-    Simpl. Intros. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1. Simpl.
-    Rewrite nleft.
-    Rewrite (H f [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2).
-    Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double_plus_un. Reflexivity.
-    Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption.
-    Assumption.
-    Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
-    Intro H1. Rewrite H1. Simpl. Rewrite nright.
-    Rewrite (H f [a0:ad](pf (ad_double a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2).
-    Rewrite ad_div_2_double. Rewrite ad_div_2_double. Reflexivity.
-    Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption.
-    Assumption.
-    Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
-    Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H0. Rewrite H0. Simpl.
-    Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. Apply comm.
-    Assumption.
-    Change (ad_bit_0 a2)=(negb true). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H).
-    Rewrite negb_elim. Reflexivity.
-    Intro H0. Rewrite H0. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un.
-    Reflexivity.
-    Change (ad_bit_0 a2)=(negb false). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H).
-    Rewrite negb_elim. Reflexivity.
-    Assumption.
-  Qed.
-
-  Lemma MapFold_Put_disjoint_2 : 
-        (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad)
-	  (MapGet A m a)=(NONE A) ->
-      	    (MapFold1 A M neutral op f pf (MapPut A m a y))=
-	    (op (f (pf a) y) (MapFold1 A M neutral op f pf m)).
-  Proof.
-    Induction m. Intros. Simpl. Rewrite (nright (f (pf a) y)). Reflexivity.
-    Intros a1 y1 a2 y2 pf H. Simpl. Elim (ad_sum (ad_xor a1 a2)). Intro H0. Elim H0.
-    Intros p H1. Rewrite H1. Rewrite comm. Exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1).
-    Intro H0. Rewrite (ad_eq_complete ? ? (ad_xor_eq_true ? ? H0)) in H.
-    Rewrite (M1_semantics_1 A a2 y1) in H. Discriminate H.
-    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
-    Cut (MapPut A (M2 A m0 m1) a y)=(M2 A m0 (MapPut A m1 (ad_div_2 a) y)). Intro.
-    Rewrite H3. Simpl. Rewrite (H0 (ad_div_2 a) y [a0:ad](pf (ad_double_plus_un a0))).
-    Rewrite ad_div_2_double_plus_un. Rewrite <- assoc.
-    Rewrite (comm (MapFold1 A M neutral op f [a0:ad](pf (ad_double a0)) m0) (f (pf a) y)).
-    Rewrite assoc. Reflexivity.
-    Assumption.
-    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Assumption.
-    Simpl. Elim (ad_sum a). Intro H3. Elim H3. Intro p. Elim p. Intros p0 H4 H5. Rewrite H5.
-    Reflexivity.
-    Intros p0 H4 H5. Rewrite H5 in H2. Discriminate H2.
-    Intro H4. Rewrite H4. Reflexivity.
-    Intro H3. Rewrite H3 in H2. Discriminate H2.
-    Intro H2. Cut (MapPut A (M2 A m0 m1) a y)=(M2 A (MapPut A m0 (ad_div_2 a) y) m1).
-    Intro. Rewrite H3. Simpl. Rewrite (H (ad_div_2 a) y [a0:ad](pf (ad_double a0))).
-    Rewrite ad_div_2_double. Rewrite <- assoc. Reflexivity.
-    Assumption.
-    Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Assumption.
-    Simpl. Elim (ad_sum a). Intro H3. Elim H3. Intro p. Elim p. Intros p0 H4 H5. Rewrite H5 in H2.
-    Discriminate H2.
-    Intros p0 H4 H5. Rewrite H5. Reflexivity.
-    Intro H4. Rewrite H4 in H2. Discriminate H2.
-    Intro H3. Rewrite H3. Reflexivity.
-  Qed.
-
-  Lemma MapFold_Put_disjoint : 
-        (f:ad->A->M) (m:(Map A)) (a:ad) (y:A)
-	  (MapGet A m a)=(NONE A) ->
-      	    (MapFold A M neutral op f (MapPut A m a y))=
-	    (op (f a y) (MapFold A M neutral op f m)).
-  Proof.
-    Intros. Exact (MapFold_Put_disjoint_2 f m a y [a0:ad]a0 H).
-  Qed.
-
-  Lemma MapFold_Put_behind_disjoint_2 : 
-        (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad)
-	  (MapGet A m a)=(NONE A) ->
-      	    (MapFold1 A M neutral op f pf (MapPut_behind A m a y))=
-	    (op (f (pf a) y) (MapFold1 A M neutral op f pf m)).
-  Proof.
-    Intros. Cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). Intro.
-    Rewrite (MapFold1_ext f ? ? H0 pf). Apply MapFold_Put_disjoint_2. Assumption.
-    Apply eqmap_trans with m':=(MapMerge A (M1 A a y) m). Apply MapPut_behind_as_Merge.
-    Apply eqmap_trans with m':=(MapMerge A m (M1 A a y)).
-    Apply eqmap_trans with m':=(MapDelta A (M1 A a y) m). Apply eqmap_sym. Apply MapDelta_disjoint.
-    Unfold MapDisjoint. Unfold in_dom. Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a0)).
-    Intro H2. Rewrite (ad_eq_complete ? ? H2) in H. Rewrite H in H1. Discriminate H1.
-    Intro H2. Rewrite H2 in H0. Discriminate H0.
-    Apply eqmap_trans with m':=(MapDelta A m (M1 A a y)). Apply MapDelta_sym.
-    Apply MapDelta_disjoint. Unfold MapDisjoint. Unfold in_dom. Simpl. Intros.
-    Elim (sumbool_of_bool (ad_eq a a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H.
-    Rewrite H in H0. Discriminate H0.
-    Intro H2. Rewrite H2 in H1. Discriminate H1.
-    Apply eqmap_sym. Apply MapPut_as_Merge.
-  Qed.
-
-  Lemma MapFold_Put_behind_disjoint : 
-        (f:ad->A->M) (m:(Map A)) (a:ad) (y:A)
-	  (MapGet A m a)=(NONE A) ->
-      	    (MapFold A M neutral op f (MapPut_behind A m a y))
-            =(op (f a y) (MapFold A M neutral op f m)).
-  Proof.
-    Intros. Exact (MapFold_Put_behind_disjoint_2 f m a y [a0:ad]a0 H).
-  Qed.
-
-  Lemma MapFold_Merge_disjoint_1 :
-        (f:ad->A->M) (m1,m2:(Map A)) (pf:ad->ad)
-	  (MapDisjoint A A m1 m2) ->
-      	    (MapFold1 A M neutral op f pf (MapMerge A m1 m2))=
-	    (op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2)).
-  Proof.
-    Induction m1. Simpl. Intros. Rewrite nleft. Reflexivity.
-    Intros. Unfold MapMerge. Apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf).
-    Apply in_dom_none. Exact (MapDisjoint_M1_l ? ? m2 a a0 H).
-    Induction m2. Intros. Simpl. Rewrite nright. Reflexivity.
-    Intros. Unfold MapMerge. Rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). Apply comm.
-    Apply in_dom_none. Exact (MapDisjoint_M1_r ? ? (M2 A m m0) a a0 H1).
-    Intros. Simpl. Rewrite (H m3 [a0:ad](pf (ad_double a0))).
-    Rewrite (H0 m4 [a0:ad](pf (ad_double_plus_un a0))).
-    Cut (a,b,c,d:M)(op (op a b) (op c d))=(op (op a c) (op b d)). Intro. Apply H4.
-    Intros. Rewrite assoc. Rewrite <- (assoc b c d). Rewrite (comm b c). Rewrite (assoc c b d).
-    Rewrite assoc. Reflexivity.
-    Exact (MapDisjoint_M2_r ? ? ? ? ? ? H3).
-    Exact (MapDisjoint_M2_l ? ? ? ? ? ? H3).
-  Qed.
-
-  Lemma MapFold_Merge_disjoint :
-        (f:ad->A->M) (m1,m2:(Map A))
-	  (MapDisjoint A A m1 m2) ->
-      	    (MapFold A M neutral op f (MapMerge A m1 m2))=
-	    (op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2)).
-  Proof.
-    Intros. Exact (MapFold_Merge_disjoint_1 f m1 m2 [a0:ad]a0 H).
-  Qed.
- 
-End MapFoldResults.
-
-Section MapFoldDistr.
-
-  Variable A : Set.
-
-  Variable M : Set.
-  Variable neutral : M.
-  Variable op : M -> M -> M.
-
-  Variable M' : Set.
-  Variable neutral' : M'.
-  Variable op' : M' -> M' -> M'.
-
-  Variable N : Set.
-
-  Variable times : M -> N -> M'.
-
-  Variable absorb : (c:N)(times neutral c)=neutral'.
-  Variable distr : (a,b:M) (c:N) (times (op a b) c) = (op' (times a c) (times b c)).
-
-  Lemma MapFold_distr_r_1 : (f:ad->A->M) (m:(Map A)) (c:N) (pf:ad->ad)
-      (times (MapFold1 A M neutral op f pf m) c)=
-      (MapFold1 A M' neutral' op' [a:ad][y:A] (times (f a y) c) pf m).
-  Proof.
-    Induction m. Intros. Exact (absorb c).
-    Trivial.
-    Intros. Simpl. Rewrite distr. Rewrite H. Rewrite H0. Reflexivity.
-  Qed.
-
-  Lemma MapFold_distr_r : (f:ad->A->M) (m:(Map A)) (c:N)
-      (times (MapFold A M neutral op f m) c)=
-      (MapFold A M' neutral' op' [a:ad][y:A] (times (f a y) c) m).
-  Proof.
-    Intros. Exact (MapFold_distr_r_1 f m c [a:ad]a).
-  Qed.
-
-End MapFoldDistr.
-
-Section MapFoldDistrL.
-
-  Variable A : Set.
-
-  Variable M : Set.
-  Variable neutral : M.
-  Variable op : M -> M -> M.
-
-  Variable M' : Set.
-  Variable neutral' : M'.
-  Variable op' : M' -> M' -> M'.
-
-  Variable N : Set.
-
-  Variable times : N -> M -> M'.
-
-  Variable absorb : (c:N)(times c neutral)=neutral'.
-  Variable distr : (a,b:M) (c:N) (times c (op a b)) = (op' (times c a) (times c b)).
-
-  Lemma MapFold_distr_l : (f:ad->A->M) (m:(Map A)) (c:N)
-      (times c (MapFold A M neutral op f m))=
-      (MapFold A M' neutral' op' [a:ad][y:A] (times c (f a y)) m).
-  Proof.
-    Intros. Apply MapFold_distr_r with times:=[a:M][b:N](times b a); Assumption.
-  Qed.
-
-End MapFoldDistrL.
-
-Section MapFoldExists.
-
-  Variable A : Set.
-
-  Lemma MapFold_orb_1 : (f:ad->A->bool) (m:(Map A)) (pf:ad->ad)
-      	       	      (MapFold1 A bool false orb f pf m)=
-                      (Cases (MapSweep1 A f pf m) of
-		           (SOME _) => true
-			 | _ => false
-	               end).
-  Proof.
-    Induction m. Trivial.
-    Intros a y pf. Simpl. Unfold MapSweep2. (Case (f (pf a) y); Reflexivity).
-    Intros. Simpl. Rewrite (H [a0:ad](pf (ad_double a0))).
-    Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))).
-    Case (MapSweep1 A f [a0:ad](pf (ad_double a0)) m0); Reflexivity.
-  Qed.
-
-  Lemma MapFold_orb : (f:ad->A->bool) (m:(Map A)) (MapFold A bool false orb f m)=
-                      (Cases (MapSweep A f m) of
-		           (SOME _) => true
-			 | _ => false
-	               end).
-  Proof.
-    Intros. Exact (MapFold_orb_1 f m [a:ad]a).
-  Qed.
-
-End MapFoldExists.
-
-Section DMergeDef.
-
-  Variable A : Set.
-
-  Definition DMerge := (MapFold (Map A) (Map A) (M0 A) (MapMerge A) [_:ad][m:(Map A)] m).
-
-  Lemma in_dom_DMerge_1 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=
-                              (Cases (MapSweep ? [_:ad][m0:(Map A)] (in_dom A a m0) m) of
-			           (SOME _) => true
-				 | _ => false
-		               end).
-  Proof.
-    Unfold DMerge. Intros.
-    Rewrite (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false
-               orb ad (in_dom A) [c:ad](refl_equal ? ?) (in_dom_merge A)).
-    Apply MapFold_orb.
-  Qed.
-
-  Lemma in_dom_DMerge_2 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=true ->
-                               {b:ad & {m0:(Map A) | (MapGet ? m b)=(SOME ? m0) /\
-			                             (in_dom A a m0)=true}}.
-  Proof.
-    Intros m a. Rewrite in_dom_DMerge_1.
-    Elim (option_sum ? (MapSweep (Map A) [_:ad][m0:(Map A)](in_dom A a m0) m)).
-    Intro H. Elim H. Intro r. Elim r. Intros b m0 H0. Intro. Split with b. Split with m0.
-    Split. Exact (MapSweep_semantics_2 ? ? ? ? ? H0).
-    Exact (MapSweep_semantics_1 ? ? ? ? ? H0).
-    Intro H. Rewrite H. Intro. Discriminate H0.
-  Qed.
-
-  Lemma in_dom_DMerge_3 : (m:(Map (Map A))) (a,b:ad) (m0:(Map A))
-      (MapGet ? m a)=(SOME ? m0) -> (in_dom A b m0)=true -> 
-        (in_dom A b (DMerge m))=true.
-  Proof.
-    Intros m a b m0 H H0. Rewrite in_dom_DMerge_1.
-    Elim (MapSweep_semantics_4 ? [_:ad][m'0:(Map A)](in_dom A b m'0) ? ? ? H H0).
-    Intros a' H1. Elim H1. Intros m'0 H2. Rewrite H2. Reflexivity.
-  Qed.
-
-End DMergeDef.
diff --git a/theories7/IntMap/Mapiter.v b/theories7/IntMap/Mapiter.v
deleted file mode 100644
index 144572fd..00000000
--- a/theories7/IntMap/Mapiter.v
+++ /dev/null
@@ -1,527 +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: Mapiter.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
-
-Require Bool.
-Require Sumbool.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Mapaxioms.
-Require Fset.
-Require PolyList.
-
-Section MapIter.
-
-  Variable A : Set.
-
-  Section MapSweepDef.
-
-  Variable f:ad->A->bool.
-
-  Definition MapSweep2 := [a0:ad; y:A] if (f a0 y) then (SOME ? (a0, y)) else (NONE ?).
-
-  Fixpoint MapSweep1 [pf:ad->ad; m:(Map A)] : (option (ad * A)) :=
-    Cases m of
-        M0 => (NONE ?)
-      | (M1 a y) => (MapSweep2 (pf a) y)
-      | (M2 m m') => Cases (MapSweep1 ([a:ad] (pf (ad_double a))) m) of
-                         (SOME r) => (SOME ? r)
-		       | NONE => (MapSweep1 ([a:ad] (pf (ad_double_plus_un a))) m')
-		     end
-    end.
-
-  Definition MapSweep := [m:(Map A)] (MapSweep1 ([a:ad] a) m).
-
-  Lemma MapSweep_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
-      (MapSweep1 pf m)=(SOME ? (a, y)) -> (f a y)=true.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (f (pf a) y)). Intro H. Unfold MapSweep2.
-    Rewrite H. Intro H0. Inversion H0. Rewrite <- H3. Assumption.
-    Intro H. Unfold MapSweep2. Rewrite H. Intro H0. Discriminate H0.
-    Simpl. Intros. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)).
-    Intro H2. Elim H2. Intros r H3. Rewrite H3 in H1. Inversion H1. Rewrite H5 in H3.
-    Exact (H [a0:ad](pf (ad_double a0)) a y H3).
-    Intro H2. Rewrite H2 in H1. Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1).
-  Qed.
-
-  Lemma MapSweep_semantics_1 : (m:(Map A)) (a:ad) (y:A)
-      (MapSweep m)=(SOME ? (a, y)) -> (f a y)=true.
-  Proof.
-    Intros. Exact (MapSweep_semantics_1_1 m [a:ad]a a y H).
-  Qed.
-
-  Lemma MapSweep_semantics_2_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
-      	(MapSweep1 pf m)=(SOME ? (a, y)) -> {a':ad | a=(pf a')}.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Simpl. Unfold MapSweep2. Intros a y pf a0 y0. Case (f (pf a) y). Intros. Split with a.
-    Inversion H. Reflexivity.
-    Intro. Discriminate H.
-    Intros m0 H m1 H0 pf a y. Simpl.
-    Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H1. Elim H1.
-    Intros r H2. Rewrite H2. Intro H3. Inversion H3. Rewrite H5 in H2.
-    Elim (H [a0:ad](pf (ad_double a0)) a y H2). Intros a0 H6. Split with (ad_double a0).
-    Assumption.
-    Intro H1. Rewrite H1. Intro H2. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H2).
-    Intros a0 H3. Split with (ad_double_plus_un a0). Assumption.
-  Qed.
-
-  Lemma MapSweep_semantics_2_2 : (m:(Map A))
-      (pf,fp:ad->ad) ((a0:ad) (fp (pf a0))=a0) -> (a:ad) (y:A)
-      	(MapSweep1 pf m)=(SOME ? (a, y)) -> (MapGet A m (fp a))=(SOME ? y).
-  Proof.
-    Induction m. Intros. Discriminate H0.
-    Simpl. Intros a y pf fp H a0 y0. Unfold MapSweep2. Elim (sumbool_of_bool (f (pf a) y)).
-    Intro H0. Rewrite H0. Intro H1. Inversion H1. Rewrite (H a). Rewrite (ad_eq_correct a).
-    Reflexivity.
-    Intro H0. Rewrite H0. Intro H1. Discriminate H1.
-    Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). Elim (sumbool_of_bool (ad_bit_0 (fp a))).
-    Intro H3. Rewrite H3. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)).
-    Intro H4. Simpl in H2. Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))).
-    Intro. Rewrite H1. Apply ad_double_plus_un_div_2.
-    Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H5. Elim H5.
-    Intros r H6. Rewrite H6 in H2. Inversion H2. Rewrite H8 in H6.
-    Elim (MapSweep_semantics_2_1 m0 [a0:ad](pf (ad_double a0)) a y H6). Intros a0 H9.
-    Rewrite H9 in H3. Rewrite (H1 (ad_double a0)) in H3. Rewrite (ad_double_bit_0 a0) in H3.
-    Discriminate H3.
-    Intro H5. Rewrite H5 in H2. Assumption.
-    Intro H4. Simpl in H2. Rewrite H4 in H2.
-    Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))). Intro.
-    Rewrite H1. Apply ad_double_plus_un_div_2.
-    Assumption.
-    Intro H3. Rewrite H3. Simpl in H2.
-    Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H4. Elim H4.
-    Intros r H5. Rewrite H5 in H2. Inversion H2. Rewrite H7 in H5.
-    Apply (H [a0:ad](pf (ad_double a0)) [a0:ad](ad_div_2 (fp a0))). Intro. Rewrite H1.
-    Apply ad_double_div_2.
-    Assumption.
-    Intro H4. Rewrite H4 in H2.
-    Elim (MapSweep_semantics_2_1 m1 [a0:ad](pf (ad_double_plus_un a0)) a y H2).
-    Intros a0 H5. Rewrite H5 in H3. Rewrite (H1 (ad_double_plus_un a0)) in H3.
-    Rewrite (ad_double_plus_un_bit_0 a0) in H3. Discriminate H3.
-  Qed.
-
-  Lemma MapSweep_semantics_2 : (m:(Map A)) (a:ad) (y:A)
-      (MapSweep m)=(SOME ? (a, y)) -> (MapGet A m a)=(SOME ? y).
-  Proof.
-    Intros.
-    Exact (MapSweep_semantics_2_2 m [a0:ad]a0 [a0:ad]a0 [a0:ad](refl_equal ad a0) a y H).
-  Qed.
-
-  Lemma MapSweep_semantics_3_1 : (m:(Map A)) (pf:ad->ad)
-      (MapSweep1 pf m)=(NONE ?) ->
-        (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> (f (pf a) y)=false.
-  Proof.
-    Induction m. Intros. Discriminate H0.
-    Simpl. Unfold MapSweep2. Intros a y pf. Elim (sumbool_of_bool (f (pf a) y)). Intro H.
-    Rewrite H. Intro. Discriminate H0.
-    Intro H. Rewrite H. Intros H0 a0 y0. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. Rewrite H1.
-    Intro H2. Inversion H2. Rewrite <- H4. Rewrite <- (ad_eq_complete ? ? H1). Assumption.
-    Intro H1. Rewrite H1. Intro. Discriminate H2.
-    Intros. Simpl in H1. Elim (option_sum ad*A (MapSweep1 [a:ad](pf (ad_double a)) m0)).
-    Intro H3. Elim H3. Intros r H4. Rewrite H4 in H1. Discriminate H1.
-    Intro H3. Rewrite H3 in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4.
-    Rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double_plus_un a H4).
-    Exact (H0 [a:ad](pf (ad_double_plus_un a)) H1 (ad_div_2 a) y H2).
-    Intro H4. Rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double a H4).
-    Exact (H [a:ad](pf (ad_double a)) H3 (ad_div_2 a) y H2).
-  Qed.
-
-  Lemma MapSweep_semantics_3 : (m:(Map A))
-      (MapSweep m)=(NONE ?) -> (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> 
-        (f a y)=false.
-  Proof.
-    Intros.
-    Exact (MapSweep_semantics_3_1 m [a0:ad]a0 H a y H0).
-  Qed.
-
-  Lemma MapSweep_semantics_4_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
-      (MapGet A m a)=(SOME A y) -> (f (pf a) y)=true ->
-      	{a':ad & {y':A | (MapSweep1 pf m)=(SOME ? (a', y'))}}.
-  Proof.
-    Induction m. Intros. Discriminate H.
-    Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Split with (pf a1). Split with y.
-    Rewrite (ad_eq_complete ? ? H1). Unfold MapSweep1 MapSweep2.
-    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 ? a1 a0) in H.
-    Inversion H. Rewrite H0. Reflexivity.
-
-    Intro H1. Rewrite (M1_semantics_2 ? a a1 a0 H1) in H. Discriminate H.
-
-    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H3.
-    Rewrite (MapGet_M2_bit_0_1 ? ? H3 m0 m1) in H1.
-    Rewrite <- (ad_div_2_double_plus_un a H3) in H2.
-    Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4.
-    Intros y'' H5. Simpl. Elim (option_sum ? (MapSweep1 [a:ad](pf (ad_double a)) m0)).
-    Intro H6. Elim H6. Intro r. Elim r. Intros a''' y''' H7. Rewrite H7. Split with a'''.
-    Split with y'''. Reflexivity.
-    Intro H6. Rewrite H6. Split with a''. Split with y''. Assumption.
-    Intro H3. Rewrite (MapGet_M2_bit_0_0 ? ? H3 m0 m1) in H1.
-    Rewrite <- (ad_div_2_double a H3) in H2.
-    Elim (H [a0:ad](pf (ad_double a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4.
-    Intros y'' H5. Split with a''. Split with y''. Simpl. Rewrite H5. Reflexivity.
-  Qed.
-
-  Lemma MapSweep_semantics_4 : (m:(Map A)) (a:ad) (y:A)
-      (MapGet A m a)=(SOME A y) -> (f a y)=true ->
-      	{a':ad & {y':A | (MapSweep m)=(SOME ? (a', y'))}}.
-  Proof.
-    Intros. Exact (MapSweep_semantics_4_1 m [a0:ad]a0 a y H H0).
-  Qed.
-
-  End MapSweepDef.
-
-  Variable B : Set.
-
-  Fixpoint MapCollect1 [f:ad->A->(Map B); pf:ad->ad; m:(Map A)] : (Map B) :=
-    Cases m of
-        M0 => (M0 B)
-      | (M1 a y) => (f (pf a) y)
-      | (M2 m1 m2) => (MapMerge B (MapCollect1 f [a0:ad] (pf (ad_double a0)) m1)
-                                  (MapCollect1 f [a0:ad] (pf (ad_double_plus_un a0)) m2))
-    end.
-
-  Definition MapCollect := [f:ad->A->(Map B); m:(Map A)] (MapCollect1 f [a:ad]a m).
-
-  Section MapFoldDef.
-
-    Variable M : Set.
-    Variable neutral : M.
-    Variable op : M -> M -> M.
-
-    Fixpoint MapFold1 [f:ad->A->M; pf:ad->ad; m:(Map A)] : M :=
-      Cases m of
-      	  M0 => neutral
-        | (M1 a y) => (f (pf a) y)
-        | (M2 m1 m2) => (op (MapFold1 f [a0:ad] (pf (ad_double a0)) m1)
-                            (MapFold1 f [a0:ad] (pf (ad_double_plus_un a0)) m2))
-      end.
-
-    Definition MapFold := [f:ad->A->M; m:(Map A)] (MapFold1 f [a:ad]a m).
-
-    Lemma MapFold_empty : (f:ad->A->M) (MapFold f (M0 A))=neutral.
-    Proof.
-      Trivial.
-    Qed.
-
-    Lemma MapFold_M1 : (f:ad->A->M) (a:ad) (y:A) (MapFold f (M1 A a y)) = (f a y).
-    Proof.
-      Trivial.
-    Qed.
-
-    Variable State : Set.
-    Variable f:State -> ad -> A -> State * M.
-
-    Fixpoint MapFold1_state [state:State; pf:ad->ad; m:(Map A)]
-                            : State * M :=
-      Cases m of
-          M0 => (state, neutral)
-	| (M1 a y) => (f state (pf a) y)
-	| (M2 m1 m2) =>
-          Cases (MapFold1_state state [a0:ad] (pf (ad_double a0)) m1) of
-              (state1, x1) =>
-	      Cases (MapFold1_state state1 [a0:ad] (pf (ad_double_plus_un a0)) m2) of
-	          (state2, x2) => (state2, (op x1 x2))
-	      end
-          end
-      end.
-
-    Definition MapFold_state := [state:State] (MapFold1_state state [a:ad]a).
-
-    Lemma pair_sp : (B,C:Set) (x:B*C) x=(Fst x, Snd x).
-    Proof.
-      Induction x. Trivial.
-    Qed.
-
-    Lemma MapFold_state_stateless_1 : (m:(Map A)) (g:ad->A->M) (pf:ad->ad)
-        ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) ->
-      	  (state:State)
-      	    (Snd (MapFold1_state state pf m))=(MapFold1 g pf m).
-    Proof.
-      Induction m. Trivial.
-      Intros. Simpl. Apply H.
-      Intros. Simpl. Rewrite (pair_sp ? ?
-          (MapFold1_state state [a0:ad](pf (ad_double a0)) m0)).
-      Rewrite (H g [a0:ad](pf (ad_double a0)) H1 state).
-      Rewrite (pair_sp ? ?
-          (MapFold1_state
-            (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0))
-            [a0:ad](pf (ad_double_plus_un a0)) m1)).
-      Simpl.
-      Rewrite (H0 g [a0:ad](pf (ad_double_plus_un a0)) H1
-          (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0))).
-      Reflexivity.
-    Qed.
-
-    Lemma MapFold_state_stateless : (g:ad->A->M)
-        ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) ->
-      	  (state:State) (m:(Map A))
-      	    (Snd (MapFold_state state m))=(MapFold g m).
-    Proof.
-      Intros. Exact (MapFold_state_stateless_1 m g [a0:ad]a0 H state).
-    Qed.
-
-  End MapFoldDef.
-
-  Lemma MapCollect_as_Fold : (f:ad->A->(Map B)) (m:(Map A))
-      (MapCollect f m)=(MapFold (Map B) (M0 B) (MapMerge B) f m).
-  Proof.
-    Induction m;Trivial.
-  Qed.
-
-  Definition alist := (list (ad*A)).
-  Definition anil := (nil (ad*A)).
-  Definition acons := (!cons (ad*A)).
-  Definition aapp := (!app (ad*A)).
-
-  Definition alist_of_Map := (MapFold alist anil aapp [a:ad;y:A] (acons (pair ? ? a y) anil)).
-
-  Fixpoint alist_semantics [l:alist] : ad -> (option A) :=
-    Cases l of
-        nil => [_:ad] (NONE A)
-      | (cons (a, y) l') => [a0:ad] if (ad_eq a a0) then (SOME A y) else (alist_semantics l' a0)
-    end.
-
-  Lemma alist_semantics_app : (l,l':alist) (a:ad)
-      (alist_semantics (aapp l l') a)=
-      (Cases (alist_semantics l a) of
-           NONE => (alist_semantics l' a)
-	 | (SOME y) => (SOME A y)
-       end).
-  Proof.
-    Unfold aapp. Induction l. Trivial.
-    Intros. Elim a. Intros a1 y1. Simpl. Case (ad_eq a1 a0). Reflexivity.
-    Apply H.
-  Qed.
-
-  Lemma alist_of_Map_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
-      (alist_semantics (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) pf m) a)
-      =(SOME A y) -> {a':ad | a=(pf a')}.
-  Proof.
-    Induction m. Simpl. Intros. Discriminate H.
-    Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (ad_eq (pf a) a0)). Intro H. Rewrite H.
-    Intro H0. Split with a. Rewrite (ad_eq_complete ? ? H). Reflexivity.
-    Intro H. Rewrite H. Intro H0. Discriminate H0.
-    Intros. Change (alist_semantics
-         (aapp
-           (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
-             [a0:ad](pf (ad_double a0)) m0)
-           (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
-             [a0:ad](pf (ad_double_plus_un a0)) m1)) a)=(SOME A y)  in H1.
-    Rewrite (alist_semantics_app
-          (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
-            [a0:ad](pf (ad_double a0)) m0)
-          (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
-            [a0:ad](pf (ad_double_plus_un a0)) m1) a) in H1.
-    Elim (option_sum A
-       (alist_semantics
-         (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
-           [a0:ad](pf (ad_double a0)) m0) a)).
-    Intro H2. Elim H2. Intros y0 H3. Elim (H [a0:ad](pf (ad_double a0)) a y0 H3). Intros a0 H4.
-    Split with (ad_double a0). Assumption.
-    Intro H2. Rewrite H2 in H1. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1).
-    Intros a0 H3. Split with (ad_double_plus_un a0). Assumption.
-  Qed.
-
-  Definition ad_inj := [pf:ad->ad] (a0,a1:ad) (pf a0)=(pf a1) -> a0=a1.
-
-  Lemma ad_comp_double_inj : 
-      (pf:ad->ad) (ad_inj pf) -> (ad_inj [a0:ad] (pf (ad_double a0))).
-  Proof.
-    Unfold ad_inj. Intros. Apply ad_double_inj. Exact (H ? ? H0).
-  Qed.
-
-  Lemma ad_comp_double_plus_un_inj : (pf:ad->ad) (ad_inj pf) ->
-      (ad_inj [a0:ad] (pf (ad_double_plus_un a0))).
-  Proof.
-    Unfold ad_inj. Intros. Apply ad_double_plus_un_inj. Exact (H ? ? H0).
-  Qed.
-
-  Lemma alist_of_Map_semantics_1 : (m:(Map A)) (pf:ad->ad) (ad_inj pf) ->
-      (a:ad) (MapGet A m a)=(alist_semantics (MapFold1 alist anil aapp
-                                                   [a0:ad;y:A] (acons (pair ? ? a0 y) anil) pf m)
-                                      (pf a)).
-  Proof.
-    Induction m. Trivial.
-    Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0.
-    Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_eq_correct (pf a1)). Reflexivity.
-    Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq (pf a) (pf a1))). Intro H1.
-    Rewrite (H a a1 (ad_eq_complete ? ? H1)) in H0. Rewrite (ad_eq_correct a1) in H0.
-    Discriminate H0.
-    Intro H1. Rewrite H1. Reflexivity.
-    Intros. Change (MapGet A (M2 A m0 m1) a)
-        =(alist_semantics
-           (aapp
-             (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
-               [a0:ad](pf (ad_double a0)) m0)
-             (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
-               [a0:ad](pf (ad_double_plus_un a0)) m1)) (pf a)).
-    Rewrite alist_semantics_app. Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
-    Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3. Rewrite H3.
-    Rewrite (ad_double_bit_0 a0).
-    Rewrite <- (H [a1:ad](pf (ad_double a1)) (ad_comp_double_inj pf H1) a0).
-    Rewrite ad_double_div_2. Case (MapGet A m0 a0).
-    Elim (option_sum A
-       (alist_semantics
-         (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil)
-           [a1:ad](pf (ad_double_plus_un a1)) m1) (pf (ad_double a0)))).
-    Intro H4. Elim H4. Intros y H5.
-    Elim (alist_of_Map_semantics_1_1 m1 [a1:ad](pf (ad_double_plus_un a1))
-          (pf (ad_double a0)) y H5).
-    Intros a1 H6. Cut (ad_bit_0 (ad_double a0))=(ad_bit_0 (ad_double_plus_un a1)).
-    Intro. Rewrite (ad_double_bit_0 a0) in H7. Rewrite (ad_double_plus_un_bit_0 a1) in H7.
-    Discriminate H7.
-    Rewrite (H1 (ad_double a0) (ad_double_plus_un a1) H6). Reflexivity.
-    Intro H4. Rewrite H4. Reflexivity.
-    Trivial.
-    Intro H2. Elim H2. Intros a0 H3. Rewrite H3. Rewrite (ad_double_plus_un_bit_0 a0).
-    Rewrite <- (H0 [a1:ad](pf (ad_double_plus_un a1)) (ad_comp_double_plus_un_inj pf H1) a0).
-    Rewrite ad_double_plus_un_div_2.
-    Elim (option_sum A
-       (alist_semantics
-         (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil)
-           [a1:ad](pf (ad_double a1)) m0) (pf (ad_double_plus_un a0)))).
-    Intro H4. Elim H4. Intros y H5.
-    Elim (alist_of_Map_semantics_1_1 m0 [a1:ad](pf (ad_double a1))
-       (pf (ad_double_plus_un a0)) y H5).
-    Intros a1 H6. Cut (ad_bit_0 (ad_double_plus_un a0))=(ad_bit_0 (ad_double a1)).
-    Intro H7. Rewrite (ad_double_plus_un_bit_0 a0) in H7. Rewrite (ad_double_bit_0 a1) in H7.
-    Discriminate H7.
-    Rewrite (H1 (ad_double_plus_un a0) (ad_double a1) H6). Reflexivity.
-    Intro H4. Rewrite H4. Reflexivity.
-  Qed.
-
-  Lemma alist_of_Map_semantics : (m:(Map A))
-      (eqm A (MapGet A m) (alist_semantics (alist_of_Map m))).
-  Proof.
-    Unfold eqm. Intros. Exact (alist_of_Map_semantics_1 m [a0:ad]a0 [a0,a1:ad][p:a0=a1]p a).
-  Qed.
-
-  Fixpoint Map_of_alist [l:alist] : (Map A) :=
-    Cases l of
-        nil => (M0 A)
-      | (cons (a, y) l') => (MapPut A (Map_of_alist l') a y)
-    end.
-
-  Lemma Map_of_alist_semantics : (l:alist)
-      (eqm A (alist_semantics l) (MapGet A (Map_of_alist l))).
-  Proof.
-    Unfold eqm. Induction l. Trivial.
-    Intros r l0 H a. Elim r. Intros a0 y0. Simpl. Elim (sumbool_of_bool (ad_eq a0 a)).
-    Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0).
-    Rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). Rewrite (ad_eq_correct a).
-    Reflexivity.
-    Intro H0. Rewrite H0. Rewrite (MapPut_semantics A (Map_of_alist l0) a0 y0 a).
-    Rewrite H0. Apply H.
-  Qed.
-
-  Lemma Map_of_alist_of_Map : (m:(Map A)) (eqmap A (Map_of_alist (alist_of_Map m)) m).
-  Proof.
-    Unfold eqmap. Intro. Apply eqm_trans with f':=(alist_semantics (alist_of_Map m)).
-    Apply eqm_sym. Apply Map_of_alist_semantics.
-    Apply eqm_sym. Apply alist_of_Map_semantics.
-  Qed.
-
-  Lemma alist_of_Map_of_alist : (l:alist)
-      (eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) (alist_semantics l)).
-  Proof.
-    Intro. Apply eqm_trans with f':=(MapGet A (Map_of_alist l)).
-    Apply eqm_sym. Apply alist_of_Map_semantics.
-    Apply eqm_sym. Apply Map_of_alist_semantics.
-  Qed.
-
-  Lemma fold_right_aapp : (M:Set) (neutral:M) (op:M->M->M)
-      ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
-      ((a:M) (op neutral a)=a) ->
-      (f:ad->A->M) (l,l':alist)
-        (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral
-                    (aapp l l'))=
-        (op (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l)
-            (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l'))
-.
-  Proof.
-    Induction l. Simpl. Intro. Rewrite H0. Reflexivity.
-    Intros r l0 H1 l'. Elim r. Intros a y. Simpl. Rewrite H. Rewrite (H1 l'). Reflexivity.
-  Qed.
-
-  Lemma MapFold_as_fold_1 : (M:Set) (neutral:M) (op:M->M->M)
-      ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
-      ((a:M) (op neutral a)=a) ->
-      ((a:M) (op a neutral)=a) ->
-        (f:ad->A->M) (m:(Map A)) (pf:ad->ad)
-         (MapFold1 M neutral op f pf m)=
-         (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral
-                    (MapFold1 alist anil aapp [a:ad;y:A] (acons (pair ? ? 
-a y) anil) pf m)).
-  Proof.
-    Induction m. Trivial.
-    Intros. Simpl. Rewrite H1. Reflexivity.
-    Intros. Simpl. Rewrite (fold_right_aapp M neutral op H H0 f).
-    Rewrite (H2 [a0:ad](pf (ad_double a0))). Rewrite (H3 [a0:ad](pf (ad_double_plus_un a0))).
-    Reflexivity.
-  Qed.
-
-  Lemma MapFold_as_fold : (M:Set) (neutral:M) (op:M->M->M)
-      ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
-      ((a:M) (op neutral a)=a) ->
-      ((a:M) (op a neutral)=a) ->
-        (f:ad->A->M) (m:(Map A))
-         (MapFold M neutral op f m)=
-         (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral
-  (alist_of_Map m)).
-  Proof.
-    Intros. Exact (MapFold_as_fold_1 M neutral op H H0 H1 f m [a0:ad]a0).
-  Qed.
-
-  Lemma alist_MapMerge_semantics : (m,m':(Map A))
-      (eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m)))
-             (alist_semantics (alist_of_Map (MapMerge A m m')))).
-  Proof.
-    Unfold eqm. Intros. Rewrite alist_semantics_app. Rewrite <- (alist_of_Map_semantics m a).
-    Rewrite <- (alist_of_Map_semantics m' a).
-    Rewrite <- (alist_of_Map_semantics (MapMerge A m m') a).
-    Rewrite (MapMerge_semantics A m m' a). Reflexivity.
-  Qed.
-
-  Lemma alist_MapMerge_semantics_disjoint : (m,m':(Map A))
-        (eqmap A (MapDomRestrTo A A m m') (M0 A)) ->
-	  (eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m')))
-	         (alist_semantics (alist_of_Map (MapMerge A m m')))).
-  Proof.
-    Unfold eqm. Intros. Rewrite alist_semantics_app. Rewrite <- (alist_of_Map_semantics m a).
-    Rewrite <- (alist_of_Map_semantics m' a).
-    Rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). Rewrite (MapMerge_semantics A m m' a).
-    Elim (option_sum ? (MapGet A m a)). Intro H0. Elim H0. Intros y H1. Rewrite H1.
-    Elim (option_sum ? (MapGet A m' a)). Intro H2. Elim H2. Intros y' H3.
-    Cut (MapGet A (MapDomRestrTo A A m m') a)=(NONE A).
-    Rewrite (MapDomRestrTo_semantics A A m m' a). Rewrite H3. Rewrite H1. Intro. Discriminate H4.
-    Exact (H a).
-    Intro H2. Rewrite H2. Reflexivity.
-    Intro H0. Rewrite H0. Case (MapGet A m' a); Trivial.
-  Qed.
-
-  Lemma alist_semantics_disjoint_comm : (l,l':alist)
-      (eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A)) ->
-      	(eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l))).
-  Proof.
-    Unfold eqm. Intros. Rewrite (alist_semantics_app l l' a). Rewrite (alist_semantics_app l' l a).
-    Rewrite <- (alist_of_Map_of_alist l a). Rewrite <- (alist_of_Map_of_alist l' a).
-    Rewrite <- (alist_semantics_app (alist_of_Map (Map_of_alist l))
-                                    (alist_of_Map (Map_of_alist l')) a).
-    Rewrite <- (alist_semantics_app (alist_of_Map (Map_of_alist l'))
-                                    (alist_of_Map (Map_of_alist l)) a).
-    Rewrite (alist_MapMerge_semantics (Map_of_alist l) (Map_of_alist l') a).
-    Rewrite (alist_MapMerge_semantics_disjoint (Map_of_alist l) (Map_of_alist l') H a).
-    Reflexivity.
-  Qed.
-
-End MapIter.
-
diff --git a/theories7/IntMap/Maplists.v b/theories7/IntMap/Maplists.v
deleted file mode 100644
index f01ee3d8..00000000
--- a/theories7/IntMap/Maplists.v
+++ /dev/null
@@ -1,399 +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: Maplists.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
-
-Require Addr.
-Require Addec.
-Require Map.
-Require Fset.
-Require Mapaxioms.
-Require Mapsubset.
-Require Mapcard.
-Require Mapcanon.
-Require Mapc.
-Require Bool.
-Require Sumbool.
-Require PolyList.
-Require Arith.
-Require Mapiter.
-Require Mapfold.
-
-Section MapLists.
-
-  Fixpoint ad_in_list [a:ad;l:(list ad)] : bool :=
-    Cases l of
-	nil => false
-      | (cons a' l') => (orb (ad_eq a a') (ad_in_list a l'))
-    end.
-
-  Fixpoint ad_list_stutters [l:(list ad)] : bool :=
-    Cases l of
-	nil => false
-      | (cons a l') => (orb (ad_in_list a l') (ad_list_stutters l'))
-    end.
-
-  Lemma ad_in_list_forms_circuit : (x:ad) (l:(list ad)) (ad_in_list x l)=true ->
-      {l1 : (list ad) & {l2 : (list ad) | l=(app l1 (cons x l2))}}.
-  Proof.
-    Induction l. Intro. Discriminate H.
-    Intros. Elim (sumbool_of_bool (ad_eq x a)). Intro H1. Simpl in H0. Split with (nil ad).
-    Split with l0. Rewrite (ad_eq_complete ? ? H1). Reflexivity.
-    Intro H2. Simpl in H0. Rewrite H2 in H0. Simpl in H0. Elim (H H0). Intros l'1 H3.
-    Split with (cons a l'1). Elim H3. Intros l2 H4. Split with l2. Rewrite H4. Reflexivity.
-  Qed.
-
-  Lemma ad_list_stutters_has_circuit : (l:(list ad)) (ad_list_stutters l)=true ->
-      {x:ad & {l0 : (list ad) & {l1 : (list ad) & {l2 : (list ad) |
-        l=(app l0 (cons x (app l1 (cons x l2))))}}}}.
-  Proof.
-    Induction l. Intro. Discriminate H.
-    Intros. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Split with a.
-    Split with (nil ad). Simpl. Elim (ad_in_list_forms_circuit a l0 H1). Intros l1 H2.
-    Split with l1. Elim H2. Intros l2 H3. Split with l2. Rewrite H3. Reflexivity.
-    Intro H1. Elim (H H1). Intros x H2. Split with x. Elim H2. Intros l1 H3.
-    Split with (cons a l1). Elim H3. Intros l2 H4. Split with l2. Elim H4. Intros l3 H5.
-    Split with l3. Rewrite H5. Reflexivity.
-  Qed.
-
-  Fixpoint Elems [l:(list ad)] : FSet :=
-    Cases l of
-	nil => (M0 unit)
-      | (cons a l') => (MapPut ? (Elems l') a tt)
-    end.
-
-  Lemma Elems_canon : (l:(list ad)) (mapcanon ? (Elems l)).
-  Proof.
-    Induction l. Exact (M0_canon unit).
-    Intros. Simpl. Apply MapPut_canon. Assumption.
-  Qed.
-
-  Lemma Elems_app : (l,l':(list ad)) (Elems (app l l'))=(FSetUnion (Elems l) (Elems l')).
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)).
-    Rewrite (MapPut_as_Merge_c unit (Elems (app l0 l'))).
-    Change (FSetUnion (Elems (app l0 l')) (M1 unit a tt))
-           =(FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l')).
-    Rewrite FSetUnion_comm_c. Rewrite (FSetUnion_comm_c (Elems l0) (M1 unit a tt)).
-    Rewrite FSetUnion_assoc_c. Rewrite (H l'). Reflexivity.
-    Apply M1_canon.
-    Apply Elems_canon.
-    Apply Elems_canon.
-    Apply Elems_canon.
-    Apply M1_canon.
-    Apply Elems_canon.
-    Apply M1_canon.
-    Apply Elems_canon.
-    Apply Elems_canon.
-  Qed.
-
-  Lemma Elems_rev : (l:(list ad)) (Elems (rev l))=(Elems l).
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite Elems_app. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)).
-    Rewrite H. Reflexivity.
-    Apply Elems_canon.
-  Qed.
-
-  Lemma ad_in_elems_in_list : (l:(list ad)) (a:ad) (in_FSet a (Elems l))=(ad_in_list a l).
-  Proof.
-    Induction l. Trivial.
-    Simpl. Unfold in_FSet. Intros. Rewrite (in_dom_put ? (Elems l0) a tt a0).
-    Rewrite (H a0). Reflexivity.
-  Qed.
-
-  Lemma ad_list_not_stutters_card : (l:(list ad)) (ad_list_stutters l)=false ->
-      	  (length l)=(MapCard ? (Elems l)).
-  Proof.
-    Induction l. Trivial.
-    Simpl. Intros. Rewrite MapCard_Put_2_conv. Rewrite H. Reflexivity.
-    Elim (orb_false_elim ? ? H0). Trivial.
-    Elim (sumbool_of_bool (in_FSet a (Elems l0))). Rewrite ad_in_elems_in_list.
-    Intro H1. Rewrite H1 in H0. Discriminate H0.
-    Exact (in_dom_none unit (Elems l0) a).
-  Qed.
-
-  Lemma ad_list_card : (l:(list ad)) (le (MapCard ? (Elems l)) (length l)).
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Apply le_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub.
-    Apply le_n_S. Assumption.
-  Qed.
-
-  Lemma ad_list_stutters_card : (l:(list ad)) (ad_list_stutters l)=true ->
-      	 (lt (MapCard ? (Elems l)) (length l)).
-  Proof.
-    Induction l. Intro. Discriminate H.
-    Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1.
-    Rewrite <- (ad_in_elems_in_list l0 a) in H1. Elim (in_dom_some ? ? ? H1). Intros y H2.
-    Rewrite (MapCard_Put_1_conv ? ? ? ? tt H2). Apply le_lt_trans with m:=(length l0).
-    Apply ad_list_card.
-    Apply lt_n_Sn.
-    Intro H1. Apply le_lt_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub.
-    Apply lt_n_S. Apply H. Assumption.
-  Qed.
-
-  Lemma ad_list_not_stutters_card_conv : (l:(list ad)) (length l)=(MapCard ? (Elems l)) ->
-      (ad_list_stutters l)=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0.
-    Cut (lt (MapCard ? (Elems l)) (length l)). Intro. Rewrite H in H1. Elim (lt_n_n ? H1).
-    Exact (ad_list_stutters_card ? H0).
-    Trivial.
-  Qed.
-
-  Lemma ad_list_stutters_card_conv : (l:(list ad)) (lt (MapCard ? (Elems l)) (length l)) ->
-      (ad_list_stutters l)=true.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Trivial.
-    Intro H0. Rewrite (ad_list_not_stutters_card ? H0) in H. Elim (lt_n_n ? H).
-  Qed.
-
-  Lemma ad_in_list_l : (l,l':(list ad)) (a:ad) (ad_in_list a l)=true ->
-      (ad_in_list a (app l l'))=true.
-  Proof.
-    Induction l. Intros. Discriminate H.
-    Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
-    Intro H1. Rewrite (H l' a0 H1). Apply orb_b_true.
-  Qed.
-
-  Lemma ad_list_stutters_app_l : (l,l':(list ad)) (ad_list_stutters l)=true ->
-      (ad_list_stutters (app l l'))=true.
-  Proof.
-    Induction l. Intros. Discriminate H.
-    Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1.
-    Rewrite (ad_in_list_l l0 l' a H1). Reflexivity.
-    Intro H1. Rewrite (H l' H1). Apply orb_b_true.
-  Qed.
-
-  Lemma ad_in_list_r : (l,l':(list ad)) (a:ad) (ad_in_list a l')=true ->
-      (ad_in_list a (app l l'))=true.
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite (H l' a0 H0). Apply orb_b_true. 
-  Qed.
-
-  Lemma ad_list_stutters_app_r : (l,l':(list ad)) (ad_list_stutters l')=true ->
-      (ad_list_stutters (app l l'))=true.
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite (H l' H0). Apply orb_b_true.
-  Qed.
-
-  Lemma ad_list_stutters_app_conv_l : (l,l':(list ad)) (ad_list_stutters (app l l'))=false ->
-      (ad_list_stutters l)=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0.
-    Rewrite (ad_list_stutters_app_l l l' H0) in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma ad_list_stutters_app_conv_r : (l,l':(list ad)) (ad_list_stutters (app l l'))=false ->
-      (ad_list_stutters l')=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_list_stutters l')). Intro H0.
-    Rewrite (ad_list_stutters_app_r l l' H0) in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma ad_in_list_app_1 : (l,l':(list ad)) (x:ad) (ad_in_list x (app l (cons x l')))=true.
-  Proof.
-    Induction l. Simpl. Intros. Rewrite (ad_eq_correct x). Reflexivity.
-    Intros. Simpl. Rewrite (H l' x). Apply orb_b_true.
-  Qed.
-
-  Lemma ad_in_list_app : (l,l':(list ad)) (x:ad)
-      (ad_in_list x (app l l'))=(orb (ad_in_list x l) (ad_in_list x l')).
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite <- orb_assoc. Rewrite (H l' x). Reflexivity.
-  Qed.
-
-  Lemma ad_in_list_rev : (l:(list ad)) (x:ad)
-      (ad_in_list x (rev l))=(ad_in_list x l).
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite ad_in_list_app. Rewrite (H x). Simpl. Rewrite orb_b_false.
-    Apply orb_sym.
-  Qed.
-
-  Lemma ad_list_has_circuit_stutters : (l0,l1,l2:(list ad)) (x:ad)
-      (ad_list_stutters (app l0 (cons x (app l1 (cons x l2)))))=true.
-  Proof.
-    Induction l0. Simpl. Intros. Rewrite (ad_in_list_app_1 l1 l2 x). Reflexivity.
-    Intros. Simpl. Rewrite (H l1 l2 x). Apply orb_b_true.
-  Qed.
-
-  Lemma ad_list_stutters_prev_l : (l,l':(list ad)) (x:ad) (ad_in_list x l)=true ->
-      (ad_list_stutters (app l (cons x l')))=true.
-  Proof.
-    Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1.
-    Rewrite H1. Rewrite app_ass. Simpl. Apply ad_list_has_circuit_stutters.
-  Qed.
-
-  Lemma ad_list_stutters_prev_conv_l : (l,l':(list ad)) (x:ad)
-      (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l)=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_in_list x l)). Intro H0.
-    Rewrite (ad_list_stutters_prev_l l l' x H0) in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma ad_list_stutters_prev_r : (l,l':(list ad)) (x:ad) (ad_in_list x l')=true ->
-      (ad_list_stutters (app l (cons x l')))=true.
-  Proof.
-    Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1.
-    Rewrite H1. Apply ad_list_has_circuit_stutters.
-  Qed.
-
-  Lemma ad_list_stutters_prev_conv_r : (l,l':(list ad)) (x:ad)
-      (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l')=false.
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_in_list x l')). Intro H0.
-    Rewrite (ad_list_stutters_prev_r l l' x H0) in H. Discriminate H.
-    Trivial.
-  Qed.
-
-  Lemma ad_list_Elems : (l,l':(list ad)) (MapCard ? (Elems l))=(MapCard ? (Elems l')) ->
-      (length l)=(length l') ->
-        (ad_list_stutters l)=(ad_list_stutters l').
-  Proof.
-    Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H1. Rewrite H1. Apply sym_eq.
-    Apply ad_list_stutters_card_conv. Rewrite <- H. Rewrite <- H0. Apply ad_list_stutters_card.
-    Assumption.
-    Intro H1. Rewrite H1. Apply sym_eq. Apply ad_list_not_stutters_card_conv. Rewrite <- H.
-    Rewrite <- H0. Apply ad_list_not_stutters_card. Assumption.
-  Qed.
-
-  Lemma ad_list_app_length : (l,l':(list ad)) (length (app l l'))=(plus (length l) (length l')).
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite (H l'). Reflexivity.
-  Qed.
-
-  Lemma ad_list_stutters_permute : (l,l':(list ad))
-      (ad_list_stutters (app l l'))=(ad_list_stutters (app l' l)).
-  Proof.
-    Intros. Apply ad_list_Elems. Rewrite Elems_app. Rewrite Elems_app.
-    Rewrite (FSetUnion_comm_c ? ? (Elems_canon l) (Elems_canon l')). Reflexivity.
-    Rewrite ad_list_app_length. Rewrite ad_list_app_length. Apply plus_sym.
-  Qed.
-
-  Lemma ad_list_rev_length : (l:(list ad)) (length (rev l))=(length l).
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite ad_list_app_length. Simpl. Rewrite H. Rewrite <- plus_Snm_nSm.
-    Rewrite <- plus_n_O. Reflexivity.
-  Qed.
-
-  Lemma ad_list_stutters_rev : (l:(list ad)) (ad_list_stutters (rev l))=(ad_list_stutters l).
-  Proof.
-    Intros. Apply ad_list_Elems. Rewrite Elems_rev. Reflexivity.
-    Apply ad_list_rev_length.
-  Qed.
-
-  Lemma ad_list_app_rev : (l,l':(list ad)) (x:ad)
-      (app (rev l) (cons x l'))=(app (rev (cons x l)) l').
-  Proof.
-    Induction l. Trivial.
-    Intros. Simpl. Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x l')). Simpl.
-    Rewrite (H (cons x l') a). Simpl.
-    Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x (nil ad))). Simpl.
-    Rewrite app_ass. Simpl. Rewrite app_ass. Reflexivity.
-  Qed.
-
-  Section ListOfDomDef.
-
-  Variable A : Set.
-
-  Definition ad_list_of_dom :=
-      (MapFold A (list ad) (nil ad) (!app ad) [a:ad][_:A] (cons a (nil ad))).
-
-  Lemma ad_in_list_of_dom_in_dom : (m:(Map A)) (a:ad)
-      (ad_in_list a (ad_list_of_dom m))=(in_dom A a m).
-  Proof.
-    Unfold ad_list_of_dom. Intros.
-    Rewrite (MapFold_distr_l A (list ad) (nil ad) (!app ad) bool false orb
-              ad [a:ad][l:(list ad)](ad_in_list a l) [c:ad](refl_equal ? ?)
-              ad_in_list_app [a0:ad][_:A](cons a0 (nil ad)) m a).
-    Simpl. Rewrite (MapFold_orb A [a0:ad][_:A](orb (ad_eq a a0) false) m).
-    Elim (option_sum ? (MapSweep A [a0:ad][_:A](orb (ad_eq a a0) false) m)). Intro H. Elim H.
-    Intro r. Elim r. Intros a0 y H0. Rewrite H0. Unfold in_dom.
-    Elim (orb_prop ? ? (MapSweep_semantics_1 ? ? ? ? ? H0)). Intro H1.
-    Rewrite (ad_eq_complete ? ? H1). Rewrite (MapSweep_semantics_2 A ? ? ? ? H0). Reflexivity.
-    Intro H1. Discriminate H1.
-    Intro H. Rewrite H. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
-    Elim (in_dom_some A m a H0). Intros y H1.
-    Elim (orb_false_elim ? ? (MapSweep_semantics_3 ? ? ? H ? ? H1)). Intro H2.
-    Rewrite (ad_eq_correct a) in H2. Discriminate H2.
-    Exact (sym_eq ? ? ?).
-  Qed.
-
-  Lemma Elems_of_list_of_dom : 
-      (m:(Map A)) (eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m)).
-  Proof.
-    Unfold eqmap eqm. Intros. Elim (sumbool_of_bool (in_FSet a (Elems (ad_list_of_dom m)))).
-    Intro H. Elim (in_dom_some ? ? ? H). Intro t. Elim t. Intro H0.
-    Rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H.
-    Rewrite (ad_in_list_of_dom_in_dom m a) in H. Rewrite (MapDom_Dom A m a) in H.
-    Elim (in_dom_some ? ? ? H). Intro t'. Elim t'. Intro H1. Rewrite H1. Assumption.
-    Intro H. Rewrite (in_dom_none ? ? ? H).
-    Rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H.
-    Rewrite (ad_in_list_of_dom_in_dom m a) in H. Rewrite (MapDom_Dom A m a) in H.
-    Rewrite (in_dom_none ? ? ? H). Reflexivity.
-  Qed.
-
-  Lemma Elems_of_list_of_dom_c : (m:(Map A)) (mapcanon A m) ->
-      (Elems (ad_list_of_dom m))=(MapDom A m).
-  Proof.
-    Intros. Apply (mapcanon_unique unit). Apply Elems_canon.
-    Apply MapDom_canon. Assumption.
-    Apply Elems_of_list_of_dom.
-  Qed.
-
-  Lemma ad_list_of_dom_card_1 : (m:(Map A)) (pf:ad->ad)
-      (length (MapFold1 A (list ad) (nil ad) (app 1!ad) [a:ad][_:A](cons a (nil ad)) pf m))=
-      (MapCard A m).
-  Proof.
-    Induction m; Try Trivial. Simpl. Intros. Rewrite ad_list_app_length.
-    Rewrite (H [a0:ad](pf (ad_double a0))). Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))).
-    Reflexivity.
-  Qed.
-
-  Lemma ad_list_of_dom_card : (m:(Map A)) (length (ad_list_of_dom m))=(MapCard A m).
-  Proof.
-    Exact [m:(Map A)](ad_list_of_dom_card_1 m [a:ad]a).
-  Qed.
-
-  Lemma ad_list_of_dom_not_stutters : 
-      (m:(Map A)) (ad_list_stutters (ad_list_of_dom m))=false.
-  Proof.
-    Intro. Apply ad_list_not_stutters_card_conv. Rewrite ad_list_of_dom_card. Apply sym_eq.
-    Rewrite (MapCard_Dom A m). Apply MapCard_ext. Exact (Elems_of_list_of_dom m).
-  Qed.
-
-  End ListOfDomDef.
-
-  Lemma ad_list_of_dom_Dom_1 : (A:Set)
-    (m:(Map A)) (pf:ad->ad)
-      (MapFold1 A (list ad) (nil ad) (app 1!ad) 
-        [a:ad][_:A](cons a (nil ad)) pf m)=
-      (MapFold1 unit (list ad) (nil ad) (app 1!ad)
-        [a:ad][_:unit](cons a (nil ad)) pf (MapDom A m)).
-  Proof.
-    Induction m; Try Trivial. Simpl. Intros. Rewrite (H [a0:ad](pf (ad_double a0))).
-    Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
-  Qed.
-
-  Lemma ad_list_of_dom_Dom : (A:Set) (m:(Map A))
-      (ad_list_of_dom A m)=(ad_list_of_dom unit (MapDom A m)).
-  Proof.
-    Intros. Exact (ad_list_of_dom_Dom_1 A m [a0:ad]a0).
-  Qed.
-
-End MapLists.
diff --git a/theories7/IntMap/Mapsubset.v b/theories7/IntMap/Mapsubset.v
deleted file mode 100644
index c0b1cccd..00000000
--- a/theories7/IntMap/Mapsubset.v
+++ /dev/null
@@ -1,554 +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: Mapsubset.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
-
-Require Bool.
-Require Sumbool.
-Require Arith.
-Require ZArith.
-Require Addr.
-Require Adist.
-Require Addec.
-Require Map.
-Require Fset.
-Require Mapaxioms.
-Require Mapiter.
-
-Section MapSubsetDef.
-
-  Variable A, B : Set.
-
-  Definition MapSubset := [m:(Map A)] [m':(Map B)]
-      (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true.
-
-  Definition MapSubset_1 := [m:(Map A)] [m':(Map B)]
-      Cases (MapSweep A [a:ad][_:A] (negb (in_dom B a m')) m) of
-          NONE => true
-	| _ => false
-      end.
-
-  Definition MapSubset_2 := [m:(Map A)] [m':(Map B)] 
-      (eqmap A (MapDomRestrBy A B m m') (M0 A)).
-
-  Lemma MapSubset_imp_1 : (m:(Map A)) (m':(Map B))
-      (MapSubset m m') -> (MapSubset_1 m m')=true.
-  Proof.
-    Unfold MapSubset MapSubset_1. Intros.
-    Elim (option_sum ? (MapSweep A [a:ad][_:A](negb (in_dom B a m')) m)).
-    Intro H0. Elim H0. Intro r. Elim r. Intros a y H1. Cut (negb (in_dom B a m'))=true.
-    Intro. Cut (in_dom A a m)=false. Intro. Unfold in_dom in H3.
-    Rewrite (MapSweep_semantics_2 ? ? m a y H1) in H3. Discriminate H3.
-    Elim (sumbool_of_bool (in_dom A a m)). Intro H3. Rewrite (H a H3) in H2. Discriminate H2.
-    Trivial.
-    Exact (MapSweep_semantics_1 ? ? m a y H1).
-    Intro H0. Rewrite H0. Reflexivity.
-  Qed.
-
-  Lemma MapSubset_1_imp : (m:(Map A)) (m':(Map B))
-      (MapSubset_1 m m')=true -> (MapSubset m m').
-  Proof.
-    Unfold MapSubset MapSubset_1. Unfold 2 in_dom. Intros. Elim (option_sum ? (MapGet A m a)).
-    Intro H1. Elim H1. Intros y H2.
-    Elim (option_sum ? (MapSweep A [a:ad][_:A](negb (in_dom B a m')) m)). Intro H3.
-    Elim H3. Intro r. Elim r. Intros a' y' H4. Rewrite H4 in H. Discriminate H.
-    Intro H3. Cut (negb (in_dom B a m'))=false. Intro. Rewrite (negb_intro (in_dom B a m')).
-    Rewrite H4. Reflexivity.
-    Exact (MapSweep_semantics_3 ? ? m H3 a y H2).
-    Intro H1. Rewrite H1 in H0. Discriminate H0.
-  Qed.
-
-  Lemma map_dom_empty_1 : 
-      (m:(Map A)) (eqmap A m (M0 A)) -> (a:ad) (in_dom ? a m)=false.
-  Proof.
-    Unfold eqmap eqm in_dom. Intros. Rewrite (H a). Reflexivity.
-  Qed.
-
-  Lemma map_dom_empty_2 : 
-      (m:(Map A)) ((a:ad) (in_dom ? a m)=false) -> (eqmap A m (M0 A)).
-  Proof.
-    Unfold eqmap eqm in_dom. Intros.
-    Cut (Cases (MapGet A m a) of NONE => false | (SOME _) => true end)=false.
-    Case (MapGet A m a). Trivial.
-    Intros. Discriminate H0.
-    Exact (H a).
-  Qed.
-
-  Lemma MapSubset_imp_2 : 
-      (m:(Map A)) (m':(Map B)) (MapSubset m m') -> (MapSubset_2 m m').
-  Proof.
-    Unfold MapSubset MapSubset_2. Intros. Apply map_dom_empty_2. Intro. Rewrite in_dom_restrby.
-    Elim (sumbool_of_bool (in_dom A a m)). Intro H0. Rewrite H0. Rewrite (H a H0). Reflexivity.
-    Intro H0. Rewrite H0. Reflexivity.
-  Qed.
-
-  Lemma MapSubset_2_imp : 
-      (m:(Map A)) (m':(Map B)) (MapSubset_2 m m') -> (MapSubset m m').
-  Proof.
-    Unfold MapSubset MapSubset_2. Intros. Cut (in_dom ? a (MapDomRestrBy A B m m'))=false.
-    Rewrite in_dom_restrby. Intro. Elim (andb_false_elim ? ? H1). Rewrite H0.
-    Intro H2. Discriminate H2.
-    Intro H2. Rewrite (negb_intro (in_dom B a m')). Rewrite H2. Reflexivity.
-    Exact (map_dom_empty_1 ? H a).
-  Qed.
-
-End MapSubsetDef.
-
-Section MapSubsetOrder.
-
-  Variable A, B, C : Set.
-
-  Lemma MapSubset_refl : (m:(Map A)) (MapSubset A A m m).
-  Proof.
-      Unfold MapSubset. Trivial.
-  Qed.
-
-  Lemma MapSubset_antisym : (m:(Map A)) (m':(Map B))
-      (MapSubset A B m m') -> (MapSubset B A m' m) -> 
-        (eqmap unit (MapDom A m) (MapDom B m')).
-  Proof.
-    Unfold MapSubset eqmap eqm. Intros. Elim (option_sum ? (MapGet ? (MapDom A m) a)).
-    Intro H1. Elim H1. Intro t. Elim t. Intro H2. Elim (option_sum ? (MapGet ? (MapDom B m') a)).
-    Intro H3. Elim H3. Intro t'. Elim t'. Intro H4. Rewrite H4. Exact H2. 
-    Intro H3. Cut (in_dom B a m')=true. Intro. Rewrite (MapDom_Dom B m' a) in H4.
-    Unfold in_FSet in_dom in H4. Rewrite H3 in H4. Discriminate H4.
-    Apply H. Rewrite (MapDom_Dom A m a). Unfold in_FSet in_dom. Rewrite H2. Reflexivity.
-    Intro H1. Elim (option_sum ? (MapGet ? (MapDom B m') a)). Intro H2. Elim H2. Intros t H3.
-    Cut (in_dom A a m)=true. Intro. Rewrite (MapDom_Dom A m a) in H4. Unfold in_FSet in_dom in H4.
-    Rewrite H1 in H4. Discriminate H4.
-    Apply H0. Rewrite (MapDom_Dom B m' a). Unfold in_FSet in_dom. Rewrite H3. Reflexivity.
-    Intro H2. Rewrite H2. Exact H1.
-  Qed.
-
-  Lemma MapSubset_trans : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (MapSubset A B m m') -> (MapSubset B C m' m'') -> (MapSubset A C m m'').
-  Proof.
-    Unfold MapSubset. Intros. Apply H0. Apply H. Assumption.
-  Qed.
-
-End MapSubsetOrder.
-
-Section FSubsetOrder.
-
-  Lemma FSubset_refl : (s:FSet) (MapSubset ? ? s s).
-  Proof.
-    Exact (MapSubset_refl unit).
-  Qed.
-
-  Lemma FSubset_antisym : (s,s':FSet)
-      (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> (eqmap unit s s').
-  Proof.
-    Intros. Rewrite <- (FSet_Dom s). Rewrite <- (FSet_Dom s').
-    Exact (MapSubset_antisym ? ? s s' H H0).
-  Qed.
-
-  Lemma FSubset_trans : (s,s',s'':FSet)
-      (MapSubset ? ? s s') -> (MapSubset ? ? s' s'') -> (MapSubset ? ? s s'').
-  Proof.
-    Exact (MapSubset_trans unit unit unit).
-  Qed.
-
-End FSubsetOrder.
-
-Section MapSubsetExtra.
-
-  Variable A, B : Set.
-
-  Lemma MapSubset_Dom_1 : (m:(Map A)) (m':(Map B))
-      (MapSubset A B m m') -> (MapSubset unit unit (MapDom A m) (MapDom B m')).
-  Proof.
-    Unfold MapSubset. Intros. Elim (MapDom_semantics_2 ? m a H0). Intros y H1.
-    Cut (in_dom A a m)=true->(in_dom B a m')=true. Intro. Unfold in_dom in H2.
-    Rewrite H1 in H2. Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3.
-    Intros y' H4. Exact (MapDom_semantics_1 ? m' a y' H4).
-    Intro H3. Rewrite H3 in H2. Cut false=true. Intro. Discriminate H4.
-    Apply H2. Reflexivity.
-    Exact (H a).
-  Qed.
-
-  Lemma MapSubset_Dom_2 : (m:(Map A)) (m':(Map B))
-      (MapSubset unit unit (MapDom A m) (MapDom B m')) -> (MapSubset A B m m').
-  Proof.
-    Unfold MapSubset. Intros. Unfold in_dom in H0. Elim (option_sum ? (MapGet A m a)).
-    Intro H1. Elim H1. Intros y H2.
-    Elim (MapDom_semantics_2 ? ? ? (H a (MapDom_semantics_1 ? ? ? ? H2))). Intros y' H3.
-    Unfold in_dom. Rewrite H3. Reflexivity.
-    Intro H1. Rewrite H1 in H0. Discriminate H0.
-  Qed.
-
-  Lemma MapSubset_1_Dom : (m:(Map A)) (m':(Map B))
-      (MapSubset_1 A B m m')=(MapSubset_1 unit unit (MapDom A m) (MapDom B m')).
-  Proof.
-    Intros. Elim (sumbool_of_bool (MapSubset_1 A B m m')). Intro H. Rewrite H.
-    Apply sym_eq. Apply MapSubset_imp_1. Apply MapSubset_Dom_1. Exact (MapSubset_1_imp ? ? ? ? H).
-    Intro H. Rewrite H. Elim (sumbool_of_bool (MapSubset_1 unit unit (MapDom A m) (MapDom B m'))).
-    Intro H0.
-    Rewrite (MapSubset_imp_1 ? ? ? ? (MapSubset_Dom_2 ? ? (MapSubset_1_imp ? ? ? ? H0))) in H.
-    Discriminate H.
-    Intro. Apply sym_eq. Assumption.
-  Qed.
-
-  Lemma MapSubset_Put : (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut A m a y)).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite H. Apply orb_b_true.
-  Qed.
-
-  Lemma MapSubset_Put_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B)
-      (MapSubset A B m m') -> (MapSubset A B (MapPut A m a y) (MapPut B m' a y')).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite (in_dom_put A m a y a0) in H0.
-    Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
-    Intro H1. Rewrite (H ? H1). Apply orb_b_true.
-  Qed.
-
-  Lemma MapSubset_Put_behind : 
-      (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut_behind A m a y)).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_put_behind. Rewrite H. Apply orb_b_true.
-  Qed.
-
-  Lemma MapSubset_Put_behind_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B)
-      (MapSubset A B m m') -> 
-        (MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y')).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_put_behind.
-    Rewrite (in_dom_put_behind A m a y a0) in H0.
-    Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
-    Intro H1. Rewrite (H ? H1). Apply orb_b_true.
-  Qed.
-
-  Lemma MapSubset_Remove : (m:(Map A)) (a:ad) (MapSubset A A (MapRemove A m a) m).
-  Proof.
-    Unfold MapSubset. Intros. Unfold MapSubset. Intros. Rewrite (in_dom_remove ? m a a0) in H.
-    Elim (andb_prop ? ? H). Trivial.
-  Qed.
-
-  Lemma MapSubset_Remove_mono : (m:(Map A)) (m':(Map B)) (a:ad)
-      (MapSubset A B m m') -> (MapSubset A B (MapRemove A m a) (MapRemove B m' a)).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_remove. Rewrite (in_dom_remove A m a a0) in H0.
-    Elim (andb_prop ? ? H0). Intros. Rewrite H1. Rewrite (H ? H2). Reflexivity.
-  Qed.
-
-  Lemma MapSubset_Merge_l : (m,m':(Map A)) (MapSubset A A m (MapMerge A m m')).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Reflexivity.
-  Qed.
-
-  Lemma MapSubset_Merge_r : (m,m':(Map A)) (MapSubset A A m' (MapMerge A m m')).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Apply orb_b_true.
-  Qed.
-
-  Lemma MapSubset_Merge_mono : (m,m':(Map A)) (m'',m''':(Map B))
-      (MapSubset A B m m'') -> (MapSubset A B m' m''') ->
-      	(MapSubset A B (MapMerge A m m') (MapMerge B m'' m''')).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite (in_dom_merge A m m' a) in H1.
-    Elim (orb_true_elim ? ? H1). Intro H2. Rewrite (H ? H2). Reflexivity.
-    Intro H2. Rewrite (H0 ? H2). Apply orb_b_true.
-  Qed.
-
-  Lemma MapSubset_DomRestrTo_l : (m:(Map A)) (m':(Map B))
-      (MapSubset A A (MapDomRestrTo A B m m') m).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H).
-    Trivial.
-  Qed.
-
-  Lemma MapSubset_DomRestrTo_r: (m:(Map A)) (m':(Map B))
-      (MapSubset A B (MapDomRestrTo A B m m') m').
-  Proof.
-    Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H).
-    Trivial.
-  Qed.
-
-  Lemma MapSubset_ext : (m0,m1:(Map A)) (m2,m3:(Map B))
-      (eqmap A m0 m1) -> (eqmap B m2 m3) ->
-        (MapSubset A B m0 m2) -> (MapSubset A B m1 m3).
-  Proof.
-    Intros. Apply MapSubset_2_imp. Unfold MapSubset_2.
-    Apply eqmap_trans with m':=(MapDomRestrBy A B m0 m2). Apply MapDomRestrBy_ext. Apply eqmap_sym.
-    Assumption.
-    Apply eqmap_sym. Assumption.
-    Exact (MapSubset_imp_2 ? ? ? ? H1).
-  Qed.
-
-  Variable C, D : Set.
-
-  Lemma MapSubset_DomRestrTo_mono : 
-      (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
-        (MapSubset ? ? m m'') -> (MapSubset ? ?  m' m''') ->
-      	  (MapSubset ? ? (MapDomRestrTo ? ? m m') (MapDomRestrTo ? ? m'' m''')).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_restrto. Rewrite (in_dom_restrto A B m m' a) in H1.
-    Elim (andb_prop ? ? H1). Intros. Rewrite (H ? H2). Rewrite (H0 ? H3). Reflexivity.
-  Qed.
-
-  Lemma MapSubset_DomRestrBy_l : (m:(Map A)) (m':(Map B))
-      (MapSubset A A (MapDomRestrBy A B m m') m).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite (in_dom_restrby ? ? m m' a) in H. Elim (andb_prop ? ? H).
-    Trivial.
-  Qed.
-
-  Lemma MapSubset_DomRestrBy_mono : 
-      (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
-        (MapSubset ? ? m m'') -> (MapSubset ? ?  m''' m') ->
-      	  (MapSubset ? ? (MapDomRestrBy ? ? m m') (MapDomRestrBy ? ? m'' m''')).
-  Proof.
-    Unfold MapSubset. Intros. Rewrite in_dom_restrby. Rewrite (in_dom_restrby A B m m' a) in H1.
-    Elim (andb_prop ? ? H1). Intros. Rewrite (H ? H2). Elim (sumbool_of_bool (in_dom D a m''')).
-    Intro H4. Rewrite (H0 ? H4) in H3. Discriminate H3.
-    Intro H4. Rewrite H4. Reflexivity.
-  Qed.
-  
-End MapSubsetExtra.
-
-Section MapDisjointDef.
-
-  Variable A, B : Set.
-
-  Definition MapDisjoint := [m:(Map A)] [m':(Map B)]
-      (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true -> False.
-
-  Definition MapDisjoint_1 := [m:(Map A)] [m':(Map B)]
-      Cases (MapSweep A [a:ad][_:A] (in_dom B a m') m) of
-          NONE => true
-	| _ => false
-      end.
-
-  Definition MapDisjoint_2 := [m:(Map A)] [m':(Map B)] 
-      (eqmap A (MapDomRestrTo A B m m') (M0 A)).
-
-  Lemma MapDisjoint_imp_1 : (m:(Map A)) (m':(Map B))
-      (MapDisjoint m m') -> (MapDisjoint_1 m m')=true.
-  Proof.
-    Unfold MapDisjoint MapDisjoint_1. Intros.
-    Elim (option_sum ? (MapSweep A [a:ad][_:A](in_dom B a m') m)). Intro H0. Elim H0.
-    Intro r. Elim r. Intros a y H1. Cut (in_dom A a m)=true->(in_dom B a m')=true->False.
-    Intro. Unfold 1 in_dom in H2. Rewrite (MapSweep_semantics_2 ? ? ? ? ? H1) in H2.
-    Rewrite (MapSweep_semantics_1 ? ? ? ? ? H1) in H2. Elim (H2 (refl_equal ? ?) (refl_equal ? ?)).
-    Exact (H a).
-    Intro H0. Rewrite H0. Reflexivity.
-  Qed.
-
-  Lemma MapDisjoint_1_imp : (m:(Map A)) (m':(Map B))
-      (MapDisjoint_1 m m')=true -> (MapDisjoint m m').
-  Proof.
-    Unfold MapDisjoint MapDisjoint_1. Intros.
-    Elim (option_sum ? (MapSweep A [a:ad][_:A](in_dom B a m') m)). Intro H2. Elim H2.
-    Intro r. Elim r. Intros a' y' H3. Rewrite H3 in H. Discriminate H.
-    Intro H2. Unfold in_dom in H0. Elim (option_sum ? (MapGet A m a)). Intro H3. Elim H3.
-    Intros y H4. Rewrite (MapSweep_semantics_3 ? ? ? H2 a y H4) in H1. Discriminate H1.
-    Intro H3. Rewrite H3 in H0. Discriminate H0.
-  Qed.
-
-  Lemma MapDisjoint_imp_2 : (m:(Map A)) (m':(Map B)) (MapDisjoint m m') -> 
-      (MapDisjoint_2 m m').
-  Proof.
-    Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. Intros.
-    Rewrite (MapDomRestrTo_semantics A B m m' a).
-    Cut (in_dom A a m)=true->(in_dom B a m')=true->False. Intro.
-    Elim (option_sum ? (MapGet A m a)). Intro H1. Elim H1. Intros y H2. Unfold 1 in_dom in H0.
-    Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3. Intros y' H4. Unfold 1 in_dom in H0.
-    Rewrite H4 in H0. Rewrite H2 in H0. Elim (H0 (refl_equal ? ?) (refl_equal ? ?)).
-    Intro H3. Rewrite H3. Reflexivity.
-    Intro H1. Rewrite H1. Case (MapGet B m' a); Reflexivity.
-    Exact (H a).
-  Qed.
-
-  Lemma MapDisjoint_2_imp : (m:(Map A)) (m':(Map B)) (MapDisjoint_2 m m') -> 
-      (MapDisjoint m m').
-  Proof.
-    Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. Intros. Elim (in_dom_some ? ? ? H0).
-    Intros y H2. Elim (in_dom_some ? ? ? H1). Intros y' H3.
-    Cut (MapGet A (MapDomRestrTo A B m m') a)=(NONE A). Intro.
-    Rewrite (MapDomRestrTo_semantics ? ? m m' a) in H4. Rewrite H3 in H4. Rewrite H2 in H4.
-    Discriminate H4.
-    Exact (H a).
-  Qed.
-
-  Lemma Map_M0_disjoint : (m:(Map B)) (MapDisjoint (M0 A) m).
-  Proof.
-    Unfold MapDisjoint in_dom. Intros. Discriminate H.
-  Qed.
-
-  Lemma Map_disjoint_M0 : (m:(Map A)) (MapDisjoint m (M0 B)).
-  Proof.
-    Unfold MapDisjoint in_dom. Intros. Discriminate H0.
-  Qed.
-
-End MapDisjointDef.
-
-Section MapDisjointExtra.
-
-  Variable A, B : Set.
-
-  Lemma MapDisjoint_ext : (m0,m1:(Map A)) (m2,m3:(Map B))
-      (eqmap A m0 m1) -> (eqmap B m2 m3) -> 
-        (MapDisjoint A B m0 m2) -> (MapDisjoint A B m1 m3).
-  Proof.
-    Intros. Apply MapDisjoint_2_imp. Unfold MapDisjoint_2.
-    Apply eqmap_trans with m':=(MapDomRestrTo A B m0 m2). Apply eqmap_sym. Apply MapDomRestrTo_ext.
-    Assumption.
-    Assumption.
-    Exact (MapDisjoint_imp_2 ? ? ? ? H1).
-  Qed.
-
-  Lemma MapMerge_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') ->
-      	(a:ad) (in_dom A a (MapMerge A m m'))=
-	       (orb (andb (in_dom A a m) (negb (in_dom A a m')))
-	            (andb (in_dom A a m') (negb (in_dom A a m)))).
-  Proof.
-    Unfold MapDisjoint. Intros. Rewrite in_dom_merge. Elim (sumbool_of_bool (in_dom A a m)).
-    Intro H0. Rewrite H0. Elim (sumbool_of_bool (in_dom A a m')). Intro H1. Elim (H a H0 H1).
-    Intro H1. Rewrite H1. Reflexivity.
-    Intro H0. Rewrite H0. Simpl. Rewrite andb_b_true. Reflexivity.
-  Qed.
-
-  Lemma MapDisjoint_M2_l : (m0,m1:(Map A)) (m2,m3:(Map B))
-      (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m0 m2).
-  Proof.
-    Unfold MapDisjoint in_dom. Intros. Elim (option_sum ? (MapGet A m0 a)). Intro H2.
-    Elim H2. Intros y H3. Elim (option_sum ? (MapGet B m2 a)). Intro H4. Elim H4.
-    Intros y' H5. Apply (H (ad_double a)).
-    Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m0 m1).
-    Rewrite (ad_double_div_2 a). Rewrite H3. Reflexivity.
-    Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m2 m3).
-    Rewrite (ad_double_div_2 a). Rewrite H5. Reflexivity.
-    Intro H4. Rewrite H4 in H1. Discriminate H1.
-    Intro H2. Rewrite H2 in H0. Discriminate H0.
-  Qed.
-
-  Lemma MapDisjoint_M2_r : (m0,m1:(Map A)) (m2,m3:(Map B))
-      (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m1 m3).
-  Proof.
-    Unfold MapDisjoint in_dom. Intros. Elim (option_sum ? (MapGet A m1 a)). Intro H2.
-    Elim H2. Intros y H3. Elim (option_sum ? (MapGet B m3 a)). Intro H4. Elim H4.
-    Intros y' H5. Apply (H (ad_double_plus_un a)).
-    Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1).
-    Rewrite (ad_double_plus_un_div_2 a). Rewrite H3. Reflexivity.
-    Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m2 m3).
-    Rewrite (ad_double_plus_un_div_2 a). Rewrite H5. Reflexivity.
-    Intro H4. Rewrite H4 in H1. Discriminate H1.
-    Intro H2. Rewrite H2 in H0. Discriminate H0.
-  Qed.
-
-  Lemma MapDisjoint_M2 : (m0,m1:(Map A)) (m2,m3:(Map B))
-      (MapDisjoint A B m0 m2) -> (MapDisjoint A B m1 m3) ->
-      	(MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)).
-  Proof.
-    Unfold MapDisjoint in_dom. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H3.
-    Rewrite (MapGet_M2_bit_0_1 A a H3 m0 m1) in H1.
-    Rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. Exact (H0 (ad_div_2 a) H1 H2).
-    Intro H3. Rewrite (MapGet_M2_bit_0_0 A a H3 m0 m1) in H1.
-    Rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. Exact (H (ad_div_2 a) H1 H2).
-  Qed.
-
-  Lemma MapDisjoint_M1_l : (m:(Map A)) (a:ad) (y:B)
-      (MapDisjoint B A (M1 B a y) m) -> (in_dom A a m)=false.
-  Proof.
-    Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
-    Elim (H a (in_dom_M1_1 B a y) H0).
-    Trivial.
-  Qed.
-
-  Lemma MapDisjoint_M1_r : (m:(Map A)) (a:ad) (y:B)
-      (MapDisjoint A B m (M1 B a y)) -> (in_dom A a m)=false.
-  Proof.
-    Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
-    Elim (H a H0 (in_dom_M1_1 B a y)).
-    Trivial.
-  Qed.
-
-  Lemma MapDisjoint_M1_conv_l : (m:(Map A)) (a:ad) (y:B)
-      (in_dom A a m)=false -> (MapDisjoint B A (M1 B a y) m).
-  Proof.
-    Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H0) in H. Rewrite H1 in H.
-    Discriminate H.
-  Qed.
-
-  Lemma MapDisjoint_M1_conv_r : (m:(Map A)) (a:ad) (y:B)
-      (in_dom A a m)=false -> (MapDisjoint A B m (M1 B a y)).
-  Proof.
-    Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H1) in H. Rewrite H0 in H.
-    Discriminate H.
-  Qed.
- 
-  Lemma MapDisjoint_sym : (m:(Map A)) (m':(Map B))
-      (MapDisjoint A B m m') -> (MapDisjoint B A m' m).
-  Proof.
-    Unfold MapDisjoint. Intros. Exact (H ? H1 H0).
-  Qed.
-
-  Lemma MapDisjoint_empty : (m:(Map A)) (MapDisjoint A A m m) -> (eqmap A m (M0 A)).
-  Proof.
-    Unfold eqmap eqm. Intros. Rewrite <- (MapDomRestrTo_idempotent A m a).
-    Exact (MapDisjoint_imp_2 A A m m H a).
-  Qed.
-
-  Lemma MapDelta_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') ->
-      (eqmap A (MapDelta A m m') (MapMerge A m m')).
-  Proof.
-    Intros.
-    Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).
-    Apply MapDelta_as_DomRestrBy.
-    Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (M0 A)).
-    Apply MapDomRestrBy_ext. Apply eqmap_refl.
-    Exact (MapDisjoint_imp_2 A A m m' H).
-    Apply MapDomRestrBy_m_empty.
-  Qed.
-
-  Variable C : Set.
-
-  Lemma MapDomRestr_disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m'')).
-  Proof.
-    Unfold MapDisjoint. Intros m m' m'' a. Rewrite in_dom_restrto. Rewrite in_dom_restrby.
-    Intros. Elim (andb_prop ? ? H). Elim (andb_prop ? ? H0). Intros. Rewrite H4 in H2.
-    Discriminate H2.
-  Qed.
-
-  Lemma MapDelta_RestrTo_disjoint : (m,m':(Map A))
-      (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m')).
-  Proof.
-    Unfold MapDisjoint. Intros m m' a. Rewrite in_dom_delta. Rewrite in_dom_restrto.
-    Intros. Elim (andb_prop ? ? H0). Intros. Rewrite H1 in H. Rewrite H2 in H. Discriminate H.
-  Qed.
-
-  Lemma MapDelta_RestrTo_disjoint_2 : (m,m':(Map A))
-      (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m)).
-  Proof.
-    Unfold MapDisjoint. Intros m m' a. Rewrite in_dom_delta. Rewrite in_dom_restrto.
-    Intros. Elim (andb_prop ? ? H0). Intros. Rewrite H1 in H. Rewrite H2 in H. Discriminate H.
-  Qed.
-
-  Variable D : Set.
-
-  Lemma MapSubset_Disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
-      (MapSubset ? ? m m') -> (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m' m''') ->
-        (MapDisjoint ? ? m m'').
-  Proof.
-    Unfold MapSubset MapDisjoint. Intros. Exact (H1 ? (H ? H2) (H0 ? H3)).
-  Qed.
-
-  Lemma MapSubset_Disjoint_l : (m:(Map A)) (m':(Map B)) (m'':(Map C))
-      (MapSubset ? ? m m') -> (MapDisjoint ? ? m' m'') ->
-        (MapDisjoint ? ? m m'').
-  Proof.
-    Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? (H ? H1) H2).
-  Qed.
-
-  Lemma MapSubset_Disjoint_r : (m:(Map A)) (m'':(Map C)) (m''':(Map D))
-      (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m m''') ->
-        (MapDisjoint ? ? m m'').
-  Proof.
-    Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? H1 (H ? H2)).
-  Qed.
-
-End MapDisjointExtra.
diff --git a/theories7/Lists/List.v b/theories7/Lists/List.v
deleted file mode 100755
index 574b2688..00000000
--- a/theories7/Lists/List.v
+++ /dev/null
@@ -1,261 +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: List.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $ i*)
-
-(* This file is a copy of file MonoList.v *)
-
-(** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***)
-
-Require Le.
-
-Parameter List_Dom:Set.
-Definition A := List_Dom.
-
-Inductive list : Set := nil : list | cons : A -> list -> list.
-
-Fixpoint app [l:list] : list -> list 
-      := [m:list]<list>Cases l of
-                           nil =>  m 
-                       | (cons a l1) => (cons a (app l1 m)) 
-                   end.
-
-
-Lemma app_nil_end : (l:list)(l=(app l nil)).
-Proof. 
-	Intro l ; Elim l ; Simpl ; Auto.
-        Induction 1; Auto.
-Qed.
-Hints Resolve app_nil_end : list v62.
-
-Lemma app_ass : (l,m,n : list)(app (app l m) n)=(app l (app m n)).
-Proof. 
-	Intros l m n ; Elim l ; Simpl ; Auto with list.
-	Induction 1; Auto with list.
-Qed.
-Hints Resolve app_ass : list v62.
-
-Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l m) n).
-Proof. 
-	Auto with list.
-Qed.
-Hints Resolve ass_app : list v62.
-
-Definition tail := 
-    [l:list] <list>Cases l of  (cons _ m) => m | _ => nil end : list->list.
-                   
-
-Lemma nil_cons : (a:A)(m:list)~nil=(cons a m).
-  Intros; Discriminate.
-Qed.
-
-(****************************************)
-(* Length of lists                      *)
-(****************************************)
-
-Fixpoint length [l:list] : nat 
-   := <nat>Cases l of (cons _ m) => (S (length m)) | _ => O end.
-
-(******************************)
-(* Length order of lists      *)
-(******************************)
-
-Section length_order.
-Definition lel := [l,m:list](le (length l) (length m)).
-
-Hints Unfold lel : list.
-
-Variables a,b:A.
-Variables l,m,n:list.
-
-Lemma lel_refl : (lel l l).
-Proof. 
-	Unfold lel ; Auto with list.
-Qed.
-
-Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
-Proof. 
-	Unfold lel ; Intros.
-        Apply le_trans with (length m) ; Auto with list.
-Qed.
-
-Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
-Proof. 
-	Unfold lel ; Simpl ; Auto with list arith.
-Qed.
-
-Lemma lel_cons : (lel l m)->(lel l (cons b m)).
-Proof. 
-	Unfold lel ; Simpl ; Auto with list arith.
-Qed.
-
-Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
-Proof. 
-	Unfold lel ; Simpl ; Auto with list arith.
-Qed.
-
-Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
-Proof. 
-	Intro l' ; Elim l' ; Auto with list arith.
-	Intros a' y H H0.
-	(*  <list>nil=(cons a' y)
-	    ============================
-	      H0 : (lel (cons a' y) nil)
-	      H : (lel y nil)->(<list>nil=y)
-	      y : list
-	      a' : A
-	      l' : list *)
-	Absurd (le (S (length y)) O); Auto with list arith.
-Qed.
-End length_order.
-
-Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62.
-
-Fixpoint In  [a:A;l:list] : Prop :=
-      Cases l of
-         nil => False 
-      | (cons b m) => (b=a)\/(In a m)
-      end.
-
-Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
-Proof. 
-	Simpl ; Auto with list.
-Qed.
-Hints Resolve in_eq : list v62.
-
-Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
-Proof. 
-	Simpl ; Auto with list.
-Qed.
-Hints Resolve in_cons : list v62.
-
-Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))->((In a l)\/(In a m)).
-Proof. 
-	Intros l m a.
-	Elim l ; Simpl ; Auto with list.
-	Intros a0 y H H0.
-	(*  ((<A>a0=a)\/(In a y))\/(In a m)
-	    ============================
-	      H0 : (<A>a0=a)\/(In a (app y m))
-	      H : (In a (app y m))->((In a y)\/(In a m))
-	      y : list
-	      a0 : A
-	      a : A
-	      m : list
-	      l : list *)
-	Elim H0 ; Auto with list.
-	Intro H1.
-	(*  ((<A>a0=a)\/(In a y))\/(In a m)
-	    ============================
-	      H1 : (In a (app y m)) *)
-	Elim (H H1) ; Auto with list.
-Qed.
-Hints Immediate in_app_or : list v62.
-
-Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (app l m)).
-Proof. 
-	Intros l m a.
-	Elim l ; Simpl ; Intro H.
-	(* 1 (In a m)
-	    ============================
-	      H : False\/(In a m)
-	      a : A
-	      m : list
-	      l : list *)
-	Elim H ; Auto with list ; Intro H0.
-	(*  (In a m)
-	    ============================
-	      H0 : False *)
-	Elim H0. (* subProof completed *)
-	Intros y H0 H1.
-	(*  2 (<A>H=a)\/(In a (app y m))
-	    ============================
-	      H1 : ((<A>H=a)\/(In a y))\/(In a m)
-	      H0 : ((In a y)\/(In a m))->(In a (app y m))
-	      y : list *)
-	Elim H1 ; Auto 4 with list.
-	Intro H2.
-	(*  (<A>H=a)\/(In a (app y m))
-	    ============================
-	      H2 : (<A>H=a)\/(In a y) *)
-	Elim H2 ; Auto with list.
-Qed.
-Hints Resolve in_or_app : list v62.
-
-Definition incl := [l,m:list](a:A)(In a l)->(In a m).
-
-Hints Unfold  incl : list v62.
-
-Lemma incl_refl : (l:list)(incl l l).
-Proof. 
-	Auto with list.
-Qed.
-Hints Resolve incl_refl : list v62.
-
-Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
-Proof. 
-	Auto with list.
-Qed.
-Hints Immediate incl_tl : list v62.
-
-Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
-Proof. 
-	Auto with list.
-Qed.
-
-Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (app n m)).
-Proof. 
-	Auto with list.
-Qed.
-Hints Immediate incl_appl : list v62.
-
-Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (app m n)).
-Proof. 
-	Auto with list.
-Qed.
-Hints Immediate incl_appr : list v62.
-
-Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
-Proof. 
-	Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
-	(*  (In a0 m)
-	    ============================
-	      H1 : (<A>a=a0)\/(In a0 l)
-	      a0 : A
-	      H0 : (a:A)(In a l)->(In a m)
-	      H : (In a m)
-	      m : list
-	      l : list
-	      a : A *)
-	Elim H1.
-	(*  1 (<A>a=a0)->(In a0 m) *)
-	Elim H1 ; Auto with list ; Intro H2.
-	(*  (<A>a=a0)->(In a0 m)
-	    ============================
-	      H2 : <A>a=a0 *)
-	Elim H2 ; Auto with list. (* solves subgoal *)
-	(*  2 (In a0 l)->(In a0 m) *)
-	Auto with list.
-Qed.
-Hints Resolve incl_cons : list v62.
-
-Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (app l m) n).
-Proof. 
-	Unfold incl ; Simpl ; Intros l m n H H0 a H1.
-	(*  (In a n)
-	    ============================
-	      H1 : (In a (app l m))
-	      a : A
-	      H0 : (a:A)(In a m)->(In a n)
-	      H : (a:A)(In a l)->(In a n)
-	      n : list
-	      m : list
-	      l : list *)
-	Elim (in_app_or l m a) ; Auto with list.
-Qed.
-Hints Resolve incl_app : list v62.
diff --git a/theories7/Lists/ListSet.v b/theories7/Lists/ListSet.v
deleted file mode 100644
index 9bf259da..00000000
--- a/theories7/Lists/ListSet.v
+++ /dev/null
@@ -1,389 +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: ListSet.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $ i*)
-
-(** A Library for finite sets, implemented as lists 
-    A Library with similar interface will soon be available under
-    the name TreeSet in the theories/Trees directory *)
-
-(** PolyList is loaded, but not exported.
-    This allow to "hide" the definitions, functions and theorems of PolyList
-    and to see only the ones of ListSet *)
-
-Require PolyList.
-
-Set Implicit Arguments.
-V7only [Implicits nil [1].].
-
-Section first_definitions.
-
-  Variable A : Set.
-  Hypothesis Aeq_dec : (x,y:A){x=y}+{~x=y}.
-
-  Definition set := (list A).
-
-  Definition empty_set := (!nil ?) : set.
-
-  Fixpoint set_add [a:A; x:set] : set :=
-    Cases x of
-    | nil => (cons a nil)
-    | (cons a1 x1) => Cases (Aeq_dec a a1) of 
-                    | (left _) => (cons a1 x1) 
-                    | (right _) => (cons a1 (set_add a x1))
-                   end
-    end.
-
-
-  Fixpoint set_mem [a:A; x:set] : bool :=
-    Cases x of
-    | nil => false
-    | (cons a1 x1) => Cases (Aeq_dec a a1) of 
-                    | (left _) => true 
-                    | (right _) => (set_mem a x1)
-                   end
-    end.
- 
-  (** If [a] belongs to [x], removes [a] from [x]. If not, does nothing *)
-  Fixpoint set_remove [a:A; x:set] : set :=
-    Cases x of
-    | nil => empty_set
-    | (cons a1 x1) => Cases (Aeq_dec a a1) of 
-                    | (left _) => x1 
-                    | (right _) => (cons a1 (set_remove a x1))
-                   end
-    end.
-
-  Fixpoint set_inter [x:set] : set -> set :=
-    Cases x of
-    | nil => [y]nil
-    | (cons a1 x1) => [y]if (set_mem a1 y) 
-                      then (cons a1 (set_inter x1 y))
-		      else (set_inter x1 y)
-    end.
-
-  Fixpoint set_union [x,y:set] : set :=
-    Cases y of
-    | nil => x
-    | (cons a1 y1) => (set_add a1 (set_union x y1))
-    end.
-        
-  (** returns the set of all els of [x] that does not belong to [y] *)
-  Fixpoint set_diff [x:set] : set -> set :=
-    [y]Cases x of
-    | nil => nil
-    | (cons a1 x1) => if (set_mem a1 y) 
-                      then (set_diff x1 y)
-		      else (set_add a1 (set_diff x1 y))
-    end.
-   
-
-  Definition set_In : A -> set -> Prop := (In 1!A).
-
-  Lemma set_In_dec : (a:A; x:set){(set_In a x)}+{~(set_In a x)}.
-
-  Proof.
-    Unfold set_In.
-    (*** Realizer set_mem. Program_all. ***)
-    Induction x.
-    Auto.
-    Intros a0 x0 Ha0. Case (Aeq_dec a a0); Intro eq.
-    Rewrite eq; Simpl; Auto with datatypes.
-    Elim Ha0.
-    Auto with datatypes.
-    Right; Simpl; Unfold not; Intros [Hc1 | Hc2 ]; Auto with datatypes.
-  Qed.
-
-  Lemma set_mem_ind : 
-    (B:Set)(P:B->Prop)(y,z:B)(a:A)(x:set)
-      ((set_In a x) -> (P y))
-       ->(P z)
-       ->(P (if (set_mem a x) then y else z)).
-
-  Proof.
-    Induction x; Simpl; Intros.
-    Assumption.
-    Elim (Aeq_dec a a0); Auto with datatypes.
-  Qed.
-
-  Lemma set_mem_ind2 : 
-    (B:Set)(P:B->Prop)(y,z:B)(a:A)(x:set)
-      ((set_In a x) -> (P y))
-       ->(~(set_In a x) -> (P z))
-       ->(P (if (set_mem a x) then y else z)).
-
-  Proof.
-    Induction x; Simpl; Intros.
-    Apply H0; Red; Trivial.
-    Case (Aeq_dec a a0); Auto with datatypes.
-    Intro; Apply H; Intros; Auto.
-    Apply H1; Red; Intro.
-    Case H3; Auto.
-  Qed.
-
- 
-  Lemma set_mem_correct1 :
-    (a:A)(x:set)(set_mem a x)=true -> (set_In a x).
-  Proof.
-    Induction x; Simpl.
-    Discriminate.
-    Intros a0 l; Elim (Aeq_dec a a0); Auto with datatypes.
-  Qed.
-
-  Lemma set_mem_correct2 :
-    (a:A)(x:set)(set_In a x) -> (set_mem a x)=true.
-  Proof.
-    Induction x; Simpl.
-    Intro Ha; Elim Ha.
-    Intros a0 l; Elim (Aeq_dec a a0); Auto with datatypes.
-    Intros H1 H2 [H3 | H4].
-    Absurd a0=a; Auto with datatypes.
-    Auto with datatypes.
-  Qed.
-
-  Lemma set_mem_complete1 :
-    (a:A)(x:set)(set_mem a x)=false -> ~(set_In a x).
-  Proof.
-    Induction x; Simpl.
-    Tauto.
-    Intros a0 l; Elim (Aeq_dec a a0).
-    Intros; Discriminate H0.
-    Unfold not; Intros; Elim H1; Auto with datatypes.
-  Qed.
-
-  Lemma set_mem_complete2 :
-    (a:A)(x:set)~(set_In a x) -> (set_mem a x)=false.
-  Proof.
-    Induction x; Simpl.
-    Tauto.
-    Intros a0 l; Elim (Aeq_dec a a0).
-    Intros; Elim H0; Auto with datatypes.
-    Tauto.
-  Qed.
-
-  Lemma set_add_intro1 : (a,b:A)(x:set) 
-    (set_In a x) -> (set_In a (set_add b x)).
-
-  Proof.
-    Unfold set_In; Induction x; Simpl.
-    Auto with datatypes.
-    Intros a0 l H [ Ha0a | Hal ].
-    Elim (Aeq_dec b a0); Left; Assumption.
-    Elim (Aeq_dec b a0); Right; [ Assumption | Auto with datatypes ].
-  Qed.
-
-  Lemma set_add_intro2 : (a,b:A)(x:set) 
-    a=b -> (set_In a (set_add b x)).
-
-  Proof.
-    Unfold set_In; Induction x; Simpl.
-    Auto with datatypes.
-    Intros a0 l H Hab.
-    Elim (Aeq_dec b a0); 
-    [ Rewrite Hab; Intro Hba0; Rewrite Hba0; Simpl; Auto with datatypes
-    | Auto with datatypes ].
-  Qed.
-
-  Hints Resolve set_add_intro1 set_add_intro2.
-
-  Lemma set_add_intro : (a,b:A)(x:set) 
-    a=b\/(set_In a x) -> (set_In a (set_add b x)).
-  
-  Proof.
-    Intros a b x [H1 | H2] ; Auto with datatypes.
-  Qed.
- 
-  Lemma set_add_elim : (a,b:A)(x:set) 
-    (set_In a (set_add b x)) -> a=b\/(set_In a x).
-
-  Proof.
-    Unfold set_In.
-    Induction x.
-    Simpl; Intros [H1|H2]; Auto with datatypes.
-    Simpl; Do 3 Intro.
-    Elim (Aeq_dec b a0).
-    Simpl; Tauto.
-    Simpl; Intros; Elim H0.
-    Trivial with datatypes.
-    Tauto.
-    Tauto.
-  Qed.
-
-  Lemma set_add_elim2 :  (a,b:A)(x:set) 
-    (set_In a (set_add b x)) -> ~(a=b) -> (set_In a x).
-   Intros a b x H; Case (set_add_elim H); Intros; Trivial.
-   Case H1; Trivial.
-   Qed.
-
-  Hints Resolve set_add_intro set_add_elim set_add_elim2.
-
-  Lemma set_add_not_empty : (a:A)(x:set)~(set_add a x)=empty_set.
-  Proof.
-    Induction x; Simpl.
-    Discriminate.
-    Intros; Elim  (Aeq_dec a a0); Intros; Discriminate.
-  Qed.   
-
-
-  Lemma set_union_intro1 : (a:A)(x,y:set)
-    (set_In a x) -> (set_In a (set_union x y)).
-  Proof.
-    Induction y; Simpl; Auto with datatypes.
-  Qed.
-
-  Lemma set_union_intro2 : (a:A)(x,y:set)
-    (set_In a y) -> (set_In a (set_union x y)).
-  Proof.
-    Induction y; Simpl.
-    Tauto.
-    Intros; Elim H0; Auto with datatypes.
-  Qed.
-
-  Hints Resolve set_union_intro2 set_union_intro1.
-
-  Lemma set_union_intro : (a:A)(x,y:set)
-    (set_In a x)\/(set_In a y) -> (set_In a (set_union x y)).
-  Proof.
-    Intros; Elim H; Auto with datatypes.
-  Qed.
-
-  Lemma set_union_elim : (a:A)(x,y:set)
-    (set_In a (set_union x y)) -> (set_In a x)\/(set_In a y).
-  Proof.
-    Induction y; Simpl.
-    Auto with datatypes.
-    Intros.
-    Generalize (set_add_elim H0).
-    Intros [H1 | H1].
-    Auto with datatypes.
-    Tauto.
-  Qed.
-
-  Lemma set_union_emptyL : (a:A)(x:set)(set_In a (set_union empty_set x)) -> (set_In a x).
-    Intros a x H; Case (set_union_elim H); Auto Orelse Contradiction.
-  Qed.
-
-
-  Lemma set_union_emptyR : (a:A)(x:set)(set_In a (set_union x empty_set)) -> (set_In a x).
-    Intros a x H; Case (set_union_elim H); Auto Orelse Contradiction.
-  Qed.
-
-
-  Lemma set_inter_intro :  (a:A)(x,y:set)
-    (set_In a x) -> (set_In a y) -> (set_In a (set_inter x y)).
-  Proof.
-    Induction x.
-    Auto with datatypes.
-    Simpl; Intros a0 l Hrec y [Ha0a | Hal] Hy.
-    Simpl; Rewrite Ha0a.
-    Generalize (!set_mem_correct1 a y).
-    Generalize (!set_mem_complete1 a y).
-    Elim (set_mem a y); Simpl; Intros.
-    Auto with datatypes.
-    Absurd (set_In a y); Auto with datatypes.
-    Elim (set_mem a0 y); [ Right; Auto with datatypes | Auto with datatypes].     
-  Qed.
-
-  Lemma set_inter_elim1 : (a:A)(x,y:set)
-    (set_In a (set_inter x y)) -> (set_In a x).
-  Proof.
-    Induction x.
-    Auto with datatypes.
-    Simpl; Intros a0 l Hrec y.
-    Generalize (!set_mem_correct1 a0 y).
-    Elim (set_mem a0 y); Simpl; Intros.
-    Elim H0; EAuto with datatypes.
-    EAuto with datatypes.
-  Qed.
-
-  Lemma set_inter_elim2 : (a:A)(x,y:set)
-    (set_In a (set_inter x y)) -> (set_In a y).
-  Proof.
-    Induction x.
-    Simpl; Tauto.
-    Simpl; Intros a0 l Hrec y.
-    Generalize (!set_mem_correct1 a0 y).
-    Elim (set_mem a0 y); Simpl; Intros.
-    Elim H0; [ Intro Hr; Rewrite <- Hr; EAuto with datatypes  | EAuto with datatypes ] .
-    EAuto with datatypes.
-  Qed.
-
-  Hints Resolve set_inter_elim1 set_inter_elim2.
-
-  Lemma set_inter_elim : (a:A)(x,y:set)
-    (set_In a (set_inter x y)) -> (set_In a x)/\(set_In a y).
-  Proof.
-    EAuto with datatypes.
-  Qed. 
-
-  Lemma set_diff_intro : (a:A)(x,y:set)
-    (set_In a x) -> ~(set_In a y) -> (set_In a (set_diff x y)).
-  Proof.
-    Induction x.
-    Simpl; Tauto.
-    Simpl; Intros a0 l Hrec y [Ha0a | Hal] Hay.
-    Rewrite Ha0a; Generalize (set_mem_complete2 Hay).
-    Elim (set_mem a y); [ Intro Habs; Discriminate Habs | Auto with datatypes ].
-    Elim (set_mem a0 y); Auto with datatypes.
-  Qed.
-
-  Lemma set_diff_elim1 : (a:A)(x,y:set)
-    (set_In a (set_diff x y)) -> (set_In a x).
-  Proof.
-    Induction x.
-    Simpl; Tauto.
-    Simpl; Intros a0 l Hrec y; Elim (set_mem a0 y).
-    EAuto with datatypes.
-    Intro; Generalize (set_add_elim  H).
-    Intros [H1 | H2]; EAuto with datatypes.
-  Qed.
-
-  Lemma set_diff_elim2 : (a:A)(x,y:set)
-    (set_In a (set_diff x y)) -> ~(set_In a y).
-  Intros a x y; Elim x; Simpl.
-  Intros; Contradiction.
-  Intros a0 l Hrec. 
-  Apply set_mem_ind2; Auto.
-  Intros H1 H2; Case (set_add_elim H2); Intros; Auto.
-  Rewrite H; Trivial.
-  Qed.
-
-  Lemma set_diff_trivial : (a:A)(x:set)~(set_In a (set_diff x x)).
-  Red; Intros a x H.
-  Apply (set_diff_elim2 H).
-  Apply (set_diff_elim1 H).
-  Qed.
-
-Hints Resolve set_diff_intro set_diff_trivial.
-
-
-End first_definitions.
-
-Section other_definitions.
-
-  Variables A,B : Set.
-
-  Definition set_prod : (set A) -> (set B) -> (set A*B) := (list_prod 1!A 2!B).
-
-  (** [B^A], set of applications from [A] to [B] *)
-  Definition set_power : (set A) -> (set B) -> (set (set A*B)) := 
-    (list_power 1!A 2!B).
-
-  Definition set_map : (A->B) -> (set A) ->  (set B) := (map 1!A 2!B).
-
-  Definition set_fold_left : (B -> A -> B) -> (set A) -> B -> B := 
-     (fold_left 1!B 2!A).
-
-  Definition set_fold_right : (A -> B -> B) -> (set A) -> B -> B  := 
-     [f][x][b](fold_right f b x).
-
- 
-End other_definitions.
-
-V7only [Implicits nil [].].
-Unset Implicit Arguments.
diff --git a/theories7/Lists/MonoList.v b/theories7/Lists/MonoList.v
deleted file mode 100755
index 2ab78f7f..00000000
--- a/theories7/Lists/MonoList.v
+++ /dev/null
@@ -1,259 +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: MonoList.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $ i*)
-
-(** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***)
-
-Require Le.
-
-Parameter List_Dom:Set.
-Definition A := List_Dom.
-
-Inductive list : Set := nil : list | cons : A -> list -> list.
-
-Fixpoint app [l:list] : list -> list 
-      := [m:list]<list>Cases l of
-                           nil =>  m 
-                       | (cons a l1) => (cons a (app l1 m)) 
-                   end.
-
-
-Lemma app_nil_end : (l:list)(l=(app l nil)).
-Proof. 
-	Intro l ; Elim l ; Simpl ; Auto.
-        Induction 1; Auto.
-Qed.
-Hints Resolve app_nil_end : list v62.
-
-Lemma app_ass : (l,m,n : list)(app (app l m) n)=(app l (app m n)).
-Proof. 
-	Intros l m n ; Elim l ; Simpl ; Auto with list.
-	Induction 1; Auto with list.
-Qed.
-Hints Resolve app_ass : list v62.
-
-Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l m) n).
-Proof. 
-	Auto with list.
-Qed.
-Hints Resolve ass_app : list v62.
-
-Definition tail := 
-    [l:list] <list>Cases l of  (cons _ m) => m | _ => nil end : list->list.
-                   
-
-Lemma nil_cons : (a:A)(m:list)~nil=(cons a m).
-  Intros; Discriminate.
-Qed.
-
-(****************************************)
-(* Length of lists                      *)
-(****************************************)
-
-Fixpoint length [l:list] : nat 
-   := <nat>Cases l of (cons _ m) => (S (length m)) | _ => O end.
-
-(******************************)
-(* Length order of lists      *)
-(******************************)
-
-Section length_order.
-Definition lel := [l,m:list](le (length l) (length m)).
-
-Hints Unfold lel : list.
-
-Variables a,b:A.
-Variables l,m,n:list.
-
-Lemma lel_refl : (lel l l).
-Proof. 
-	Unfold lel ; Auto with list.
-Qed.
-
-Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
-Proof. 
-	Unfold lel ; Intros.
-        Apply le_trans with (length m) ; Auto with list.
-Qed.
-
-Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
-Proof. 
-	Unfold lel ; Simpl ; Auto with list arith.
-Qed.
-
-Lemma lel_cons : (lel l m)->(lel l (cons b m)).
-Proof. 
-	Unfold lel ; Simpl ; Auto with list arith.
-Qed.
-
-Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
-Proof. 
-	Unfold lel ; Simpl ; Auto with list arith.
-Qed.
-
-Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
-Proof. 
-	Intro l' ; Elim l' ; Auto with list arith.
-	Intros a' y H H0.
-	(*  <list>nil=(cons a' y)
-	    ============================
-	      H0 : (lel (cons a' y) nil)
-	      H : (lel y nil)->(<list>nil=y)
-	      y : list
-	      a' : A
-	      l' : list *)
-	Absurd (le (S (length y)) O); Auto with list arith.
-Qed.
-End length_order.
-
-Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62.
-
-Fixpoint In  [a:A;l:list] : Prop :=
-      Cases l of
-         nil => False 
-      | (cons b m) => (b=a)\/(In a m)
-      end.
-
-Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
-Proof. 
-	Simpl ; Auto with list.
-Qed.
-Hints Resolve in_eq : list v62.
-
-Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
-Proof. 
-	Simpl ; Auto with list.
-Qed.
-Hints Resolve in_cons : list v62.
-
-Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))->((In a l)\/(In a m)).
-Proof. 
-	Intros l m a.
-	Elim l ; Simpl ; Auto with list.
-	Intros a0 y H H0.
-	(*  ((<A>a0=a)\/(In a y))\/(In a m)
-	    ============================
-	      H0 : (<A>a0=a)\/(In a (app y m))
-	      H : (In a (app y m))->((In a y)\/(In a m))
-	      y : list
-	      a0 : A
-	      a : A
-	      m : list
-	      l : list *)
-	Elim H0 ; Auto with list.
-	Intro H1.
-	(*  ((<A>a0=a)\/(In a y))\/(In a m)
-	    ============================
-	      H1 : (In a (app y m)) *)
-	Elim (H H1) ; Auto with list.
-Qed.
-Hints Immediate in_app_or : list v62.
-
-Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (app l m)).
-Proof. 
-	Intros l m a.
-	Elim l ; Simpl ; Intro H.
-	(* 1 (In a m)
-	    ============================
-	      H : False\/(In a m)
-	      a : A
-	      m : list
-	      l : list *)
-	Elim H ; Auto with list ; Intro H0.
-	(*  (In a m)
-	    ============================
-	      H0 : False *)
-	Elim H0. (* subProof completed *)
-	Intros y H0 H1.
-	(*  2 (<A>H=a)\/(In a (app y m))
-	    ============================
-	      H1 : ((<A>H=a)\/(In a y))\/(In a m)
-	      H0 : ((In a y)\/(In a m))->(In a (app y m))
-	      y : list *)
-	Elim H1 ; Auto 4 with list.
-	Intro H2.
-	(*  (<A>H=a)\/(In a (app y m))
-	    ============================
-	      H2 : (<A>H=a)\/(In a y) *)
-	Elim H2 ; Auto with list.
-Qed.
-Hints Resolve in_or_app : list v62.
-
-Definition incl := [l,m:list](a:A)(In a l)->(In a m).
-
-Hints Unfold  incl : list v62.
-
-Lemma incl_refl : (l:list)(incl l l).
-Proof. 
-	Auto with list.
-Qed.
-Hints Resolve incl_refl : list v62.
-
-Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
-Proof. 
-	Auto with list.
-Qed.
-Hints Immediate incl_tl : list v62.
-
-Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
-Proof. 
-	Auto with list.
-Qed.
-
-Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (app n m)).
-Proof. 
-	Auto with list.
-Qed.
-Hints Immediate incl_appl : list v62.
-
-Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (app m n)).
-Proof. 
-	Auto with list.
-Qed.
-Hints Immediate incl_appr : list v62.
-
-Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
-Proof. 
-	Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
-	(*  (In a0 m)
-	    ============================
-	      H1 : (<A>a=a0)\/(In a0 l)
-	      a0 : A
-	      H0 : (a:A)(In a l)->(In a m)
-	      H : (In a m)
-	      m : list
-	      l : list
-	      a : A *)
-	Elim H1.
-	(*  1 (<A>a=a0)->(In a0 m) *)
-	Elim H1 ; Auto with list ; Intro H2.
-	(*  (<A>a=a0)->(In a0 m)
-	    ============================
-	      H2 : <A>a=a0 *)
-	Elim H2 ; Auto with list. (* solves subgoal *)
-	(*  2 (In a0 l)->(In a0 m) *)
-	Auto with list.
-Qed.
-Hints Resolve incl_cons : list v62.
-
-Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (app l m) n).
-Proof. 
-	Unfold incl ; Simpl ; Intros l m n H H0 a H1.
-	(*  (In a n)
-	    ============================
-	      H1 : (In a (app l m))
-	      a : A
-	      H0 : (a:A)(In a m)->(In a n)
-	      H : (a:A)(In a l)->(In a n)
-	      n : list
-	      m : list
-	      l : list *)
-	Elim (in_app_or l m a) ; Auto with list.
-Qed.
-Hints Resolve incl_app : list v62.
diff --git a/theories7/Lists/PolyList.v b/theories7/Lists/PolyList.v
deleted file mode 100644
index e69ecd10..00000000
--- a/theories7/Lists/PolyList.v
+++ /dev/null
@@ -1,646 +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: PolyList.v,v 1.2.2.1 2004/07/16 19:31:28 herbelin Exp $ i*)
-
-Require Le.
-
-
-Section Lists.
-
-Variable A : Set.
-
-Set Implicit Arguments.
-
-Inductive list : Set := nil : list | cons : A -> list -> list.
-
-Infix "::" cons (at level 7, right associativity) : list_scope
-  V8only (at level 60, right associativity).
-
-Open Scope list_scope.
-
-(*************************)
-(** Discrimination       *)
-(*************************)
-
-Lemma nil_cons : (a:A)(m:list)~(nil=(cons a m)).
-Proof. 
-  Intros; Discriminate.
-Qed.
-
-(*************************)
-(** Concatenation        *)
-(*************************)
-
-Fixpoint app [l:list] : list -> list 
-      := [m:list]Cases l of
-                   nil         => m 
-                 | (cons a l1) => (cons a (app l1 m))
-                 end.
-
-Infix RIGHTA 7 "^" app : list_scope
-  V8only RIGHTA 60 "++".
-
-Lemma app_nil_end : (l:list)l=(l^nil).
-Proof. 
-	NewInduction l ; Simpl ; Auto.
-        Rewrite <- IHl; Auto.
-Qed.
-Hints Resolve app_nil_end.
-
-Tactic Definition now_show c := Change c.
-V7only [Tactic Definition NowShow := now_show.].
-
-Lemma app_ass : (l,m,n : list)((l^m)^ n)=(l^(m^n)).
-Proof. 
-	Intros. NewInduction l ; Simpl ; Auto.
-        NowShow '(cons a (app (app l m) n))=(cons a (app l (app m n))).
-	Rewrite <- IHl; Auto.
-Qed.
-Hints Resolve app_ass.
-
-Lemma ass_app : (l,m,n : list)(l^(m^n))=((l^m)^n).
-Proof. 
-	Auto.
-Qed.
-Hints Resolve ass_app.
-
-Lemma app_comm_cons : (x,y:list)(a:A) (cons a (x^y))=((cons a x)^y).
-Proof.
- Auto.
-Qed.
-
-Lemma app_eq_nil: (x,y:list) (x^y)=nil -> x=nil /\ y=nil.
-Proof.
-  NewDestruct x;NewDestruct y;Simpl;Auto.
-  Intros H;Discriminate H.
-  Intros;Discriminate H.
-Qed.
-
-Lemma app_cons_not_nil: (x,y:list)(a:A)~nil=(x^(cons a y)).
-Proof.
-Unfold not .
-  NewDestruct x;Simpl;Intros.
-  Discriminate H.
-  Discriminate H.
-Qed.
-
-Lemma app_eq_unit:(x,y:list)(a:A)
-     (x^y)=(cons a nil)-> (x=nil)/\ y=(cons a nil) \/ x=(cons a nil)/\ y=nil.
-
-Proof.
-  NewDestruct x;NewDestruct y;Simpl.
-  Intros a H;Discriminate H.
-  Left;Split;Auto.
-  Right;Split;Auto.
-  Generalize H .
-  Generalize (app_nil_end  l) ;Intros E.
-  Rewrite <- E;Auto.
-  Intros.
-  Injection H.
-  Intro.
-  Cut  nil=(l^(cons a0 l0));Auto.
-  Intro.
-  Generalize (app_cons_not_nil H1); Intro.
-  Elim H2.
-Qed.
-
-Lemma app_inj_tail : (x,y:list)(a,b:A)
-   (x^(cons a nil))=(y^(cons b nil)) -> x=y /\ a=b.
-Proof.
-  NewInduction x as [|x l IHl];NewDestruct y;Simpl;Auto.
-  Intros a b H.
-  Injection H.
-  Auto.
-  Intros a0 b H.
-  Injection H;Intros.
-  Generalize (app_cons_not_nil H0) ;NewDestruct 1.
-  Intros a b H.
-  Injection H;Intros.
-  Cut   nil=(l^(cons a nil));Auto.
-  Intro.
-  Generalize (app_cons_not_nil H2) ;NewDestruct 1.
-  Intros a0 b H.
-  Injection H;Intros.
-  NewDestruct (IHl l0 a0 b H0). 
-  Split;Auto.
-  Rewrite <- H1;Rewrite <- H2;Reflexivity.
-Qed.
-
-(*************************)
-(** Head and tail        *)
-(*************************)
-
-Definition head :=
-  [l:list]Cases l of
-  | nil => Error
-  | (cons x _) => (Value x)
-  end.
-
-Definition tail : list -> list :=
-  [l:list]Cases l of
-  | nil => nil 
-  | (cons a m) => m
-  end.
-
-(****************************************)
-(** Length of lists                     *)
-(****************************************)
-
-Fixpoint length [l:list] : nat 
-   := Cases l of nil => O | (cons _ m) => (S (length m)) end.
-
-(******************************)
-(** Length order of lists     *)
-(******************************)
-
-Section length_order.
-Definition lel := [l,m:list](le (length l) (length m)).
-
-Variables a,b:A.
-Variables l,m,n:list.
-
-Lemma lel_refl : (lel l l).
-Proof. 
-	Unfold lel ; Auto with arith.
-Qed.
-
-Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
-Proof. 
-	Unfold lel ; Intros.
-        NowShow '(le (length l) (length n)).
-        Apply le_trans with (length m) ; Auto with arith.
-Qed.
-
-Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
-Proof. 
-	Unfold lel ; Simpl ; Auto with arith.
-Qed.
-
-Lemma lel_cons : (lel l m)->(lel l (cons b m)).
-Proof. 
-	Unfold lel ; Simpl ; Auto with arith.
-Qed.
-
-Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
-Proof. 
-	Unfold lel ; Simpl ; Auto with arith.
-Qed.
-
-Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
-Proof. 
-	Intro l' ; Elim l' ; Auto with arith.
-	Intros a' y H H0.
-        NowShow 'nil=(cons a' y).
-	Absurd (le (S (length y)) O); Auto with arith.
-Qed.
-End length_order.
-
-Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons.
-
-(*********************************)
-(** The [In] predicate           *)
-(*********************************)
-
-Fixpoint In  [a:A;l:list] : Prop :=
-      Cases l of nil => False | (cons b m) => (b=a)\/(In a m) end.
-
-Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
-Proof. 
-	Simpl ; Auto.
-Qed.
-Hints Resolve in_eq.
-
-Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
-Proof. 
-	Simpl ; Auto.
-Qed.
-Hints Resolve in_cons.
-
-Lemma in_nil : (a:A)~(In a nil).
-Proof.
-  Unfold not; Intros a H; Inversion_clear H.
-Qed.
-
-
-Lemma in_inv : (a,b:A)(l:list)
-               (In b (cons a l)) -> a=b \/ (In b l).
-Proof.
- Intros a b l H ; Inversion_clear H ; Auto.
-Qed.
-
-Lemma In_dec : ((x,y:A){x=y}+{~x=y}) ->   (a:A)(l:list){(In a l)}+{~(In a l)}.
-
-Proof.
-  NewInduction l as [|a0 l IHl].
-  Right; Apply in_nil.
-  NewDestruct (H a0 a); Simpl; Auto.
-  NewDestruct IHl; Simpl; Auto. 
-  Right; Unfold not; Intros [Hc1 | Hc2]; Auto.
-Qed.
-
-Lemma in_app_or : (l,m:list)(a:A)(In a (l^m))->((In a l)\/(In a m)).
-Proof. 
-	Intros l m a.
-	Elim l ; Simpl ; Auto.
-	Intros a0 y H H0.
-	NowShow '(a0=a\/(In a y))\/(In a m).
-	Elim H0 ; Auto.
-	Intro H1.
-        NowShow '(a0=a\/(In a y))\/(In a m).
-	Elim (H H1) ; Auto.
-Qed.
-Hints Immediate in_app_or.
-
-Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (l^m)).
-Proof. 
-	Intros l m a.
-	Elim l ; Simpl ; Intro H.
-        NowShow '(In a m).
-	Elim H ; Auto ; Intro H0.
-	NowShow '(In a m).
-	Elim H0. (* subProof completed *)
-	Intros y H0 H1.
-	NowShow 'H=a\/(In a (app y m)).
-	Elim H1 ; Auto 4.
-	Intro H2.
-	NowShow 'H=a\/(In a (app y m)).
-	Elim H2 ; Auto.
-Qed.
-Hints Resolve in_or_app.
-
-(***************************)
-(** Set inclusion on list  *)
-(***************************)
-
-Definition incl := [l,m:list](a:A)(In a l)->(In a m).
-Hints Unfold  incl.
-
-Lemma incl_refl : (l:list)(incl l l).
-Proof. 
-	Auto.
-Qed.
-Hints Resolve incl_refl.
-
-Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
-Proof. 
-	Auto.
-Qed.
-Hints Immediate incl_tl.
-
-Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
-Proof. 
-	Auto.
-Qed.
-
-Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (n^m)).
-Proof. 
-	Auto.
-Qed.
-Hints Immediate incl_appl.
-
-Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (m^n)).
-Proof. 
-	Auto.
-Qed.
-Hints Immediate incl_appr.
-
-Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
-Proof. 
-	Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
-        NowShow '(In a0 m).
-	Elim H1.
-	NowShow 'a=a0->(In a0 m).
-	Elim H1 ; Auto ; Intro H2.
-	NowShow 'a=a0->(In a0 m).
-	Elim H2 ; Auto. (* solves subgoal *)
-	NowShow '(In a0 l)->(In a0 m).
-	Auto.
-Qed.
-Hints Resolve incl_cons.
-
-Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (l^m) n).
-Proof. 
-	Unfold incl ; Simpl ; Intros l m n H H0 a H1.
-        NowShow '(In a n).
-	Elim (in_app_or H1); Auto.
-Qed.
-Hints Resolve incl_app.
-
-(**************************)
-(** Nth element of a list *)
-(**************************)
-
-Fixpoint nth [n:nat; l:list] : A->A :=
-  [default]Cases n l of
-    O (cons x l') => x
-  | O other => default
-  | (S m) nil => default
-  | (S m) (cons x t) => (nth m t default)
-  end.
-
-Fixpoint nth_ok [n:nat; l:list] : A->bool :=
-  [default]Cases n l of
-    O (cons x l') => true
-  | O other => false
-  | (S m) nil => false
-  | (S m) (cons x t) => (nth_ok m t default)
-  end.
-
-Lemma nth_in_or_default :
-  (n:nat)(l:list)(d:A){(In (nth n l d) l)}+{(nth n l d)=d}.
-(* Realizer nth_ok. Program_all. *)
-Proof. 
-  Intros n l d; Generalize n; NewInduction l; Intro n0.
-  Right; Case n0; Trivial.
-  Case n0; Simpl.
-  Auto.
-  Intro n1; Elim (IHl n1); Auto.     
-Qed.
-
-Lemma nth_S_cons :
- (n:nat)(l:list)(d:A)(a:A)(In (nth n l d) l)
-   ->(In (nth (S n) (cons a l) d) (cons a l)).
-Proof. 
-  Simpl; Auto.
-Qed.
-
-Fixpoint nth_error [l:list;n:nat] : (Exc A) :=
-  Cases n l of
-  | O (cons x _) => (Value x)
-  | (S n) (cons _ l) => (nth_error l n)
-  | _ _ => Error 
-  end.
-
-Definition nth_default : A -> list -> nat -> A :=
-  [default,l,n]Cases (nth_error l n) of
-  | (Some x) => x
-  | None => default
-  end.
-
-Lemma nth_In :
-  (n:nat)(l:list)(d:A)(lt n (length l))->(In (nth n l d) l).
-
-Proof.
-Unfold lt; NewInduction n as [|n hn]; Simpl.
-NewDestruct l ; Simpl ;  [ Inversion 2 | Auto].
-NewDestruct l as [|a l hl] ; Simpl.
-Inversion 2.
-Intros d ie ; Right ; Apply hn ; Auto with arith.
-Qed.
-
-(********************************)
-(** Decidable equality on lists *)
-(********************************)
-
-
-Lemma list_eq_dec : ((x,y:A){x=y}+{~x=y})->(x,y:list){x=y}+{~x=y}.
-Proof.
-  NewInduction x as [|a l IHl]; NewDestruct y as [|a0 l0]; Auto.
-  NewDestruct (H a a0) as [e|e].
-  NewDestruct (IHl l0) as [e'|e'].
-  Left; Rewrite e; Rewrite e'; Trivial.
-  Right; Red; Intro.
-  Apply e'; Injection H0; Trivial.
-  Right; Red; Intro.
-  Apply e; Injection H0; Trivial.
-Qed.
-
-(*************************)
-(**  Reverse             *)
-(*************************)
-
-Fixpoint rev [l:list] : list :=
-   Cases l of
-      nil        => nil
-   | (cons x l') => (rev l')^(cons x nil)
-   end.
-
-Lemma distr_rev : 
- (x,y:list) (rev (x^y))=((rev y)^(rev x)).
-Proof.
- NewInduction x as [|a l IHl].
- NewDestruct y.
- Simpl.
- Auto.
-
- Simpl.
- Apply app_nil_end;Auto.
-
- Intro y.
- Simpl.
- Rewrite (IHl y).
- Apply (app_ass (rev y) (rev l) (cons a nil)).
-Qed.
-
-Remark  rev_unit : (l:list)(a:A) (rev  l^(cons a nil))= (cons a (rev l)).
-Proof.
- Intros.
- Apply (distr_rev l (cons a nil));Simpl;Auto.
-Qed.
-
-Lemma idempot_rev : (l:list)(rev (rev l))=l.
-Proof.
- NewInduction l as [|a l IHl].
- Simpl;Auto.
-
- Simpl.
- Rewrite (rev_unit (rev l) a).
- Rewrite -> IHl;Auto.
-Qed.
-
-(*********************************************)
-(**  Reverse Induction Principle on Lists    *)
-(*********************************************)
-
-Section Reverse_Induction.
-
-Unset Implicit Arguments.
-
-Remark rev_list_ind: (P:list->Prop)
-      (P nil)
-       ->((a:A)(l:list)(P (rev l))->(P (rev  (cons a l)))) 
-             ->(l:list) (P (rev  l)).
-Proof.
- NewInduction l; Auto.
-Qed.
-Set Implicit Arguments.
-
-Lemma rev_ind : 
- (P:list->Prop)
-   (P nil)->
-    ((x:A)(l:list)(P l)->(P l^(cons x nil)))
-      ->(l:list)(P l).
-Proof.
- Intros.
- Generalize (idempot_rev l) .
- Intros E;Rewrite <- E.
- Apply (rev_list_ind P).
- Auto.
-
- Simpl.
- Intros.
- Apply (H0 a (rev l0)).
- Auto.
-Qed.
-
-End Reverse_Induction.
-
-End Lists.
-
-Implicits nil [1].
-
-Hints Resolve nil_cons app_nil_end ass_app app_ass : datatypes v62.
-Hints Resolve app_comm_cons  app_cons_not_nil : datatypes v62.
-Hints Immediate app_eq_nil : datatypes v62.
-Hints Resolve app_eq_unit app_inj_tail : datatypes v62. 
-Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons 
-   : datatypes v62.
-Hints Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app : datatypes v62.
-Hints Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons incl_app 
-  : datatypes v62.
-
-Section Functions_on_lists.
-
-(****************************************************************)
-(** Some generic functions on lists and basic functions of them *)
-(****************************************************************)
-
-Section Map.
-Variables A,B:Set.
-Variable  f:A->B.
-Fixpoint map [l:(list A)] : (list B) :=
-  Cases l of 
-     nil       => nil
-  | (cons a t) => (cons (f a) (map t))
-  end.
-End Map.
-
-Lemma in_map : (A,B:Set)(f:A->B)(l:(list A))(x:A)
-  (In x l) -> (In (f x) (map f l)).
-Proof. 
-  NewInduction l as [|a l IHl]; Simpl;
-  [ Auto
-  | NewDestruct 1;
-    [ Left; Apply f_equal with f:=f; Assumption
-    | Auto]
-  ].
-Qed.
-
-Fixpoint flat_map [A,B:Set; f:A->(list B); l:(list A)] : (list B) :=
-  Cases l of
-    nil => nil
-  | (cons x t) => (app (f x) (flat_map f t))
-  end.
-
-Fixpoint list_prod [A:Set; B:Set; l:(list A)] : (list B)->(list A*B) :=
-  [l']Cases l of
-    nil => nil
-  | (cons x t) => (app (map [y:B](x,y) l')
-      	       	       	     (list_prod t l'))
-  end.
-
-Lemma in_prod_aux :
-  (A:Set)(B:Set)(x:A)(y:B)(l:(list B))
-    (In y l) -> (In (x,y) (map [y0:B](x,y0) l)).
-Proof. 
-  NewInduction l;
-  [ Simpl; Auto
-  | Simpl; NewDestruct 1 as [H1|];
-    [ Left; Rewrite H1; Trivial
-    | Right; Auto]
-  ].
-Qed.
-
-Lemma in_prod : (A:Set)(B:Set)(l:(list A))(l':(list B))
-  (x:A)(y:B)(In x l)->(In y l')->(In (x,y) (list_prod l l')).
-Proof. 
-  NewInduction l;
-  [ Simpl; Tauto
-  | Simpl; Intros; Apply in_or_app; NewDestruct H;
-    [ Left; Rewrite H; Apply in_prod_aux; Assumption
-    | Right; Auto]
-  ].
-Qed.
-
-(** [(list_power x y)] is [y^x], or the set of sequences of elts of [y]
-    indexed by elts of [x], sorted in lexicographic order. *)
-
-Fixpoint list_power [A,B:Set; l:(list A)] : (list B)->(list (list A*B)) :=
-  [l']Cases l of
-    nil => (cons nil nil)
-  | (cons x t) => (flat_map [f:(list A*B)](map [y:B](cons (x,y) f) l') 
-      	       	       	    (list_power t l'))
-  end.
-
-(************************************)
-(** Left-to-right iterator on lists *)
-(************************************)
-
-Section Fold_Left_Recursor.
-Variables A,B:Set.
-Variable  f:A->B->A.
-Fixpoint fold_left[l:(list B)] : A -> A :=
-[a0]Cases l of
-     nil       => a0
-  | (cons b t) => (fold_left t (f a0 b))
-  end.
-End Fold_Left_Recursor.
-
-(************************************)
-(** Right-to-left iterator on lists *)
-(************************************)
-
-Section Fold_Right_Recursor.
-Variables A,B:Set.
-Variable  f:B->A->A.
-Variable  a0:A.
-Fixpoint fold_right [l:(list B)] : A :=
-  Cases l of
-    nil => a0
-  | (cons b t) => (f b (fold_right t))
-  end.
-End Fold_Right_Recursor.
-
-Theorem fold_symmetric :
-  (A:Set)(f:A->A->A)
-   ((x,y,z:A)(f x (f y z))=(f (f x y) z))
-    ->((x,y:A)(f x y)=(f y x))
-     ->(a0:A)(l:(list A))(fold_left f l a0)=(fold_right f a0 l).
-Proof.
-NewDestruct l as [|a l].
-Reflexivity.
-Simpl.
-Rewrite <- H0.
-Generalize a0 a.
-NewInduction l as [|a3 l IHl]; Simpl.
-Trivial.
-Intros.
-Rewrite H.
-Rewrite (H0 a2).
-Rewrite <- (H a1).
-Rewrite (H0 a1).
-Rewrite IHl.
-Reflexivity.
-Qed.
-
-End Functions_on_lists.
-
-V7only [Implicits nil [].].
-
-(** Exporting list notations *)
-
-V8Infix "::" cons (at level 60, right associativity) : list_scope.
-
-Infix RIGHTA 7 "^" app : list_scope V8only RIGHTA 60 "++".
-
-Open Scope list_scope.
-
-Delimits Scope list_scope with list.
-
-Bind Scope list_scope with list.
diff --git a/theories7/Lists/Streams.v b/theories7/Lists/Streams.v
deleted file mode 100755
index ccfc4895..00000000
--- a/theories7/Lists/Streams.v
+++ /dev/null
@@ -1,170 +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: Streams.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-Set Implicit Arguments.
-
-(** Streams *)
-
-Section Streams.
-
-Variable A : Set.
-
-CoInductive Set Stream   := Cons : A->Stream->Stream.
-
-
-Definition hd  := 
-  [x:Stream] Cases x of (Cons a _) => a end.
-
-Definition tl  := 
-  [x:Stream] Cases x of (Cons _ s) => s end.
-
-
-Fixpoint Str_nth_tl [n:nat] : Stream->Stream := 
-  [s:Stream] Cases n of
-	          O    => s
-		|(S m) => (Str_nth_tl m (tl s))
-	    end.
-
-Definition Str_nth : nat->Stream->A := [n:nat][s:Stream](hd (Str_nth_tl n s)).
-
-
-Lemma unfold_Stream :(x:Stream)x=(Cases x of (Cons a s) => (Cons a s) end). 
-Proof.
-  Intro x.
-  Case x.
-  Trivial.
-Qed.
-
-Lemma tl_nth_tl : (n:nat)(s:Stream)(tl (Str_nth_tl n s))=(Str_nth_tl n (tl s)).
-Proof.
-  Induction n; Simpl; Auto.
-Qed.
-Hints Resolve tl_nth_tl : datatypes v62.
-
-Lemma Str_nth_tl_plus 
-: (n,m:nat)(s:Stream)(Str_nth_tl n (Str_nth_tl m s))=(Str_nth_tl (plus n m) s).
-Induction n; Simpl; Intros; Auto with datatypes.
-Rewrite <- H.
-Rewrite tl_nth_tl; Trivial with datatypes.
-Qed.
-
-Lemma Str_nth_plus 
-  : (n,m:nat)(s:Stream)(Str_nth n (Str_nth_tl m s))=(Str_nth (plus n m) s).
-Intros; Unfold Str_nth; Rewrite Str_nth_tl_plus; Trivial with datatypes.
-Qed.
-
-(** Extensional Equality between two streams  *)
-
-CoInductive EqSt  : Stream->Stream->Prop := 
-	    eqst : (s1,s2:Stream)
-		   ((hd s1)=(hd s2))->
-		   (EqSt (tl s1) (tl s2))
-                    ->(EqSt s1 s2).
-
-(** A coinduction principle *)
-
-Tactic Definition CoInduction proof := 
-  Cofix proof; Intros; Constructor;
-    [Clear proof | Try (Apply proof;Clear proof)].
-
-
-(** Extensional equality is an equivalence relation *)
-
-Theorem  EqSt_reflex : (s:Stream)(EqSt s s).
-CoInduction EqSt_reflex.
-Reflexivity.
-Qed.
-
-Theorem sym_EqSt : 
- (s1:Stream)(s2:Stream)(EqSt s1 s2)->(EqSt s2 s1).
-(CoInduction Eq_sym).
-Case H;Intros;Symmetry;Assumption.
-Case H;Intros;Assumption.
-Qed.
-
-
-Theorem trans_EqSt : 
- (s1,s2,s3:Stream)(EqSt s1 s2)->(EqSt s2 s3)->(EqSt s1 s3).
-(CoInduction Eq_trans).
-Transitivity (hd s2).
-Case H; Intros; Assumption.
-Case H0; Intros; Assumption.
-Apply (Eq_trans (tl s1) (tl s2) (tl s3)).
-Case H;  Trivial with datatypes.
-Case H0; Trivial with datatypes.
-Qed.
-
-(** The definition given is equivalent to require the elements at each
-    position to be equal *)
-
-Theorem eqst_ntheq :
-  (n:nat)(s1,s2:Stream)(EqSt s1 s2)->(Str_nth n s1)=(Str_nth n s2).
-Unfold Str_nth; Induction n.
-Intros s1 s2 H; Case H; Trivial with datatypes.
-Intros m hypind.
-Simpl.
-Intros s1 s2 H.
-Apply hypind.
-Case H; Trivial with datatypes.
-Qed.
-
-Theorem ntheq_eqst : 
-  (s1,s2:Stream)((n:nat)(Str_nth n s1)=(Str_nth n s2))->(EqSt s1 s2).
-(CoInduction Equiv2).
-Apply (H O).
-Intros n; Apply (H (S n)).
-Qed.
-
-Section Stream_Properties.
-
-Variable P : Stream->Prop.
-
-(*i
-Inductive Exists : Stream -> Prop :=
-  | Here    : forall x:Stream, P x -> Exists x
-  | Further : forall x:Stream, ~ P x -> Exists (tl x) -> Exists x.
-i*)
-
-Inductive   Exists :  Stream -> Prop :=
-   Here    : (x:Stream)(P x) ->(Exists x) |
-   Further : (x:Stream)(Exists (tl x))->(Exists x).
-
-CoInductive ForAll : Stream  -> Prop :=
-    forall : (x:Stream)(P x)->(ForAll (tl x))->(ForAll x).
-
-
-Section Co_Induction_ForAll.
-Variable   Inv        :  Stream -> Prop.
-Hypothesis InvThenP   : (x:Stream)(Inv x)->(P x).
-Hypothesis InvIsStable: (x:Stream)(Inv x)->(Inv (tl x)).
-
-Theorem ForAll_coind : (x:Stream)(Inv x)->(ForAll x).
-(CoInduction ForAll_coind);Auto.
-Qed.
-End Co_Induction_ForAll.
-
-End Stream_Properties.
-
-End Streams.
-
-Section Map.
-Variables A,B : Set.
-Variable  f   : A->B.
-CoFixpoint map : (Stream A)->(Stream B) :=
- [s:(Stream A)](Cons (f (hd s)) (map (tl s))).
-End Map.
-
-Section Constant_Stream.
-Variable A : Set.
-Variable a : A.
-CoFixpoint const : (Stream A) := (Cons a const).
-End Constant_Stream.
-
-Unset Implicit Arguments.
diff --git a/theories7/Lists/TheoryList.v b/theories7/Lists/TheoryList.v
deleted file mode 100755
index f7adda70..00000000
--- a/theories7/Lists/TheoryList.v
+++ /dev/null
@@ -1,386 +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: TheoryList.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** Some programs and results about lists following CAML Manual *)
-
-Require Export PolyList.
-Set Implicit Arguments.
-Chapter Lists.
-
-Variable  A : Set.
-
-(**********************)
-(** The null function *)
-(**********************)
-
-Definition Isnil : (list A) -> Prop := [l:(list A)](nil A)=l.
-
-Lemma Isnil_nil : (Isnil (nil A)).
-Red; Auto.
-Qed.
-Hints Resolve Isnil_nil.
-
-Lemma not_Isnil_cons : (a:A)(l:(list A))~(Isnil (cons a l)).
-Unfold Isnil.
-Intros; Discriminate.
-Qed.
-
-Hints Resolve Isnil_nil not_Isnil_cons.
-
-Lemma Isnil_dec : (l:(list A)){(Isnil l)}+{~(Isnil l)}.
-Intro l; Case l;Auto.
-(*
-Realizer (fun l => match l with
-  | nil => true
-  | _ => false
-  end).
-*)
-Qed.
-
-(************************)
-(** The Uncons function *)
-(************************)
-
-Lemma Uncons : (l:(list A)){a : A & { m: (list A) | (cons a m)=l}}+{Isnil l}.
-Intro l; Case l.
-Auto.
-Intros a m; Intros; Left; Exists a; Exists m; Reflexivity.
-(*
-Realizer (fun l => match l with
-  | nil => error
-  | (cons a m) => value (a,m)
-  end).
-*)
-Qed.
-
-(********************************)
-(** The head function           *)
-(********************************)
-
-Lemma Hd : (l:(list A)){a : A | (EX m:(list A) |(cons a m)=l)}+{Isnil l}.
-Intro l; Case l.
-Auto.
-Intros a m; Intros; Left; Exists a; Exists m; Reflexivity.
-(*
-Realizer (fun l => match l with
-  | nil => error
-  | (cons a m) => value a
-  end).
-*)
-Qed.
-
-Lemma Tl : (l:(list A)){m:(list A)| (EX a:A |(cons a m)=l)
-                         \/ ((Isnil l) /\ (Isnil m)) }.
-Intro l; Case l.
-Exists (nil A); Auto.
-Intros a m; Intros; Exists m; Left; Exists a; Reflexivity.
-(*
-Realizer (fun l => match l with
-  | nil => nil
-  | (cons a m) => m
-  end).
-*)
-Qed.
-
-(****************************************)
-(** Length of lists                     *)
-(****************************************)
-
-(* length is defined in List *)
-Fixpoint Length_l [l:(list A)] : nat -> nat 
-  :=  [n:nat] Cases l of
-                  nil => n
-              | (cons _ m) => (Length_l m (S n))
-	     end.
-
-(* A tail recursive version *)
-Lemma Length_l_pf : (l:(list A))(n:nat){m:nat|(plus n (length l))=m}.
-NewInduction l as [|a m lrec].
-Intro n; Exists n; Simpl; Auto.
-Intro n; Elim (lrec (S n)); Simpl; Intros.
-Exists x; Transitivity (S (plus n (length m))); Auto.
-(*
-Realizer Length_l.
-*)
-Qed.
-
-Lemma Length : (l:(list A)){m:nat|(length l)=m}.
-Intro l. Apply (Length_l_pf l O).
-(*
-Realizer (fun l -> Length_l_pf l O).
-*)
-Qed.
-
-(*******************************)
-(** Members of lists           *)
-(*******************************)
-Inductive In_spec [a:A] : (list A) -> Prop := 
-   | in_hd : (l:(list A))(In_spec a (cons a l))
-   | in_tl : (l:(list A))(b:A)(In a l)->(In_spec a (cons b l)).
-Hints Resolve in_hd in_tl.
-Hints Unfold  In.
-Hints Resolve in_cons.
-
-Theorem In_In_spec : (a:A)(l:(list A))(In a l) <-> (In_spec a l).
-Split.
-Elim l; [ Intros; Contradiction 
-      	| Intros; Elim H0; 
-	  [ Intros; Rewrite H1; Auto
-	  | Auto ]].
-Intros; Elim H; Auto.
-Qed.
-
-Inductive AllS [P:A->Prop] : (list A) -> Prop 
-   := allS_nil : (AllS P (nil A))
-   | allS_cons : (a:A)(l:(list A))(P a)->(AllS P l)->(AllS P (cons a l)).
-Hints Resolve allS_nil allS_cons.
-
-Hypothesis eqA_dec : (a,b:A){a=b}+{~a=b}.
-
-Fixpoint mem [a:A; l:(list A)] : bool :=
-  Cases l of
-    nil => false
-  | (cons b m) => if (eqA_dec a b) then [H]true else [H](mem a m)
-  end.
-
-Hints Unfold  In.
-Lemma Mem : (a:A)(l:(list A)){(In a l)}+{(AllS [b:A]~b=a l)}.
-Intros a l.
-NewInduction l.
-Auto.
-Elim (eqA_dec a a0).
-Auto.
-Simpl. Elim IHl; Auto.
-(*
-Realizer mem.
-*)
-Qed.
-
-(*********************************)
-(** Index of elements            *)
-(*********************************)
-
-Require Le.
-Require Lt.
-
-Inductive nth_spec : (list A)->nat->A->Prop :=
-  nth_spec_O : (a:A)(l:(list A))(nth_spec (cons a l) (S O) a)
-| nth_spec_S : (n:nat)(a,b:A)(l:(list A))
-           (nth_spec l n a)->(nth_spec (cons b l) (S n) a).
-Hints Resolve nth_spec_O nth_spec_S.
-
-Inductive fst_nth_spec : (list A)->nat->A->Prop :=
-  fst_nth_O : (a:A)(l:(list A))(fst_nth_spec (cons a l) (S O) a)
-| fst_nth_S : (n:nat)(a,b:A)(l:(list A))(~a=b)->
-           (fst_nth_spec l n a)->(fst_nth_spec (cons b l) (S n) a).
-Hints Resolve fst_nth_O fst_nth_S.
-
-Lemma fst_nth_nth : (l:(list A))(n:nat)(a:A)(fst_nth_spec l n a)->(nth_spec l n a).
-NewInduction 1; Auto.
-Qed.
-Hints Immediate fst_nth_nth.
-
-Lemma nth_lt_O : (l:(list A))(n:nat)(a:A)(nth_spec l n a)->(lt O n).
-NewInduction 1; Auto.
-Qed.
-
-Lemma nth_le_length : (l:(list A))(n:nat)(a:A)(nth_spec l n a)->(le n (length l)).
-NewInduction 1; Simpl; Auto with arith.
-Qed.
-
-Fixpoint Nth_func [l:(list A)] : nat -> (Exc A) 
-  := [n:nat] Cases  l  n  of 
-               (cons a _)  (S O)       => (value A a) 
-             | (cons _ l') (S (S p)) => (Nth_func l' (S p))
-             |  _ _      => Error
-            end.
-
-Lemma Nth : (l:(list A))(n:nat)
-            {a:A|(nth_spec l n a)}+{(n=O)\/(lt (length l) n)}.
-NewInduction l as [|a l IHl].
-Intro n; Case n; Simpl; Auto with arith.
-Intro n; NewDestruct n as [|[|n1]]; Simpl; Auto.
-Left; Exists a; Auto.
-NewDestruct (IHl (S n1)) as [[b]|o].
-Left; Exists b; Auto.
-Right; NewDestruct o.
-Absurd (S n1)=O; Auto.
-Auto with arith.
-(*
-Realizer Nth_func.
-*)
-Qed.
-
-Lemma Item : (l:(list A))(n:nat){a:A|(nth_spec l (S n) a)}+{(le (length l) n)}.
-Intros l n; Case (Nth l (S n)); Intro.
-Case s; Intro a; Left; Exists a; Auto.
-Right; Case o; Intro.
-Absurd (S n)=O; Auto.
-Auto with arith.
-Qed.
-
-Require Minus.
-Require DecBool.
-
-Fixpoint index_p [a:A;l:(list A)] : nat -> (Exc nat) := 
-   Cases l of nil => [p]Error
-     | (cons b m) => [p](ifdec (eqA_dec a b) (Value p) (index_p a m (S p)))
-   end.
-
-Lemma Index_p : (a:A)(l:(list A))(p:nat)
-     {n:nat|(fst_nth_spec l (minus (S n) p) a)}+{(AllS [b:A]~a=b l)}.
-NewInduction l as [|b m irec].
-Auto.
-Intro p.
-NewDestruct (eqA_dec a b) as [e|e].
-Left; Exists p.
-NewDestruct e; Elim minus_Sn_m; Trivial; Elim minus_n_n; Auto with arith.
-NewDestruct (irec (S p)) as [[n H]|].
-Left; Exists n; Auto with arith.
-Elim minus_Sn_m; Auto with arith.
-Apply lt_le_weak; Apply lt_O_minus_lt; Apply nth_lt_O with m a; Auto with arith.
-Auto.
-Qed.
-
-Lemma Index : (a:A)(l:(list A))
-     {n:nat|(fst_nth_spec l n a)}+{(AllS [b:A]~a=b l)}.
-
-Intros a l; Case (Index_p a l (S O)); Auto.
-Intros (n,P); Left; Exists n; Auto.
-Rewrite (minus_n_O n); Trivial.
-(*
-Realizer (fun a l -> Index_p a l (S O)).
-*)
-Qed.
-
-Section Find_sec.
-Variable R,P : A -> Prop.
-
-Inductive InR : (list A) -> Prop 
-   := inR_hd : (a:A)(l:(list A))(R a)->(InR (cons a l))
-   | inR_tl : (a:A)(l:(list A))(InR l)->(InR (cons a l)).
-Hints Resolve inR_hd inR_tl.
-
-Definition InR_inv := 
-       [l:(list A)]Cases l of 
-                   nil => False 
-                | (cons b m) => (R b)\/(InR m) 
-               end.
-
-Lemma InR_INV : (l:(list A))(InR l)->(InR_inv l).
-NewInduction 1; Simpl; Auto.
-Qed.
-
-Lemma InR_cons_inv : (a:A)(l:(list A))(InR (cons a l))->((R a)\/(InR l)).
-Intros a l H; Exact (InR_INV H).
-Qed.
-
-Lemma InR_or_app : (l,m:(list A))((InR l)\/(InR m))->(InR (app l m)).
-Intros l m [|].
-NewInduction 1; Simpl; Auto.
-Intro. NewInduction l; Simpl; Auto.
-Qed.
-
-Lemma InR_app_or : (l,m:(list A))(InR (app l m))->((InR l)\/(InR m)).
-Intros l m; Elim l; Simpl; Auto.
-Intros b l' Hrec IAc; Elim (InR_cons_inv IAc);Auto.
-Intros; Elim Hrec; Auto.
-Qed.
-
-Hypothesis RS_dec : (a:A){(R a)}+{(P a)}.
-
-Fixpoint find [l:(list A)] : (Exc A) := 
-	Cases l of nil => Error
-                | (cons a m) => (ifdec (RS_dec a) (Value a) (find m))
-        end.
-
-Lemma Find : (l:(list A)){a:A | (In a l) & (R a)}+{(AllS P l)}.
-NewInduction l as [|a m [[b H1 H2]|H]]; Auto.
-Left; Exists b; Auto.
-NewDestruct (RS_dec a).
-Left; Exists a; Auto.
-Auto.
-(*
-Realizer find.
-*)
-Qed.
-
-Variable B : Set.
-Variable T : A -> B -> Prop.
-
-Variable TS_dec : (a:A){c:B| (T a c)}+{(P a)}.
-
-Fixpoint try_find [l:(list A)] : (Exc B) :=
-   Cases l of
-     nil => Error
-   | (cons a l1) =>
-	   Cases (TS_dec a) of
-	     (inleft (exist c _)) => (Value c)
-	   | (inright _) => (try_find l1)
-	   end
-   end.
-
-Lemma Try_find : (l:(list A)){c:B|(EX a:A |(In a l) & (T a c))}+{(AllS P l)}.
-NewInduction l as [|a m [[b H1]|H]].
-Auto.
-Left; Exists b; NewDestruct H1 as [a' H2 H3]; Exists a'; Auto.
-NewDestruct (TS_dec a) as [[c H1]|].
-Left; Exists c.
-Exists a; Auto.
-Auto.
-(* 
-Realizer try_find.
-*)
-Qed.
-
-End Find_sec.
-
-Section Assoc_sec.
-
-Variable B : Set.
-Fixpoint assoc [a:A;l:(list A*B)] : (Exc B) :=
-    Cases l of        nil => Error
-        | (cons (a',b) m) => (ifdec (eqA_dec a a') (Value b) (assoc a m))
-    end.
-
-Inductive AllS_assoc [P:A -> Prop]: (list A*B) -> Prop := 
-      allS_assoc_nil : (AllS_assoc P (nil A*B))
-    | allS_assoc_cons : (a:A)(b:B)(l:(list A*B))
-        (P a)->(AllS_assoc P l)->(AllS_assoc P (cons (a,b) l)).
-
-Hints Resolve allS_assoc_nil allS_assoc_cons.
-
-(* The specification seems too weak: it is enough to return b if the
-   list has at least an element (a,b); probably the intention is to have
-   the specification
-
-   (a:A)(l:(list A*B)){b:B|(In_spec (a,b) l)}+{(AllS_assoc [a':A]~(a=a') l)}.
-*)
-
-Lemma Assoc : (a:A)(l:(list A*B))(B+{(AllS_assoc [a':A]~(a=a') l)}).
-NewInduction l as [|[a' b] m assrec]. Auto.
-NewDestruct (eqA_dec a a').
-Left; Exact b.
-NewDestruct assrec as [b'|].
-Left; Exact b'.
-Right; Auto.
-(*
-Realizer assoc.
-*)
-Qed.
-
-End Assoc_sec.
-
-End Lists.
-
-Hints Resolve Isnil_nil not_Isnil_cons in_hd in_tl in_cons allS_nil allS_cons 
- : datatypes.
-Hints Immediate fst_nth_nth : datatypes.
-
diff --git a/theories7/Logic/Berardi.v b/theories7/Logic/Berardi.v
deleted file mode 100644
index db9007ec..00000000
--- a/theories7/Logic/Berardi.v
+++ /dev/null
@@ -1,170 +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: Berardi.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** This file formalizes Berardi's paradox which says that in
-   the calculus of constructions, excluded middle (EM) and axiom of
-   choice (AC) implie proof irrelevenace (PI).
-   Here, the axiom of choice is not necessary because of the use
-   of inductive types.
-<<
-@article{Barbanera-Berardi:JFP96,
-   author    = {F. Barbanera and S. Berardi},
-   title     = {Proof-irrelevance out of Excluded-middle and Choice
-                in the Calculus of Constructions},
-   journal   = {Journal of Functional Programming},
-   year      = {1996},
-   volume    = {6},
-   number    = {3},
-   pages     = {519-525}
-}
->> *)
-
-Set Implicit Arguments.
-
-Section Berardis_paradox.
-
-(** Excluded middle *)
-Hypothesis EM : (P:Prop) P \/ ~P.
-
-(** Conditional on any proposition. *)
-Definition IFProp := [P,B:Prop][e1,e2:P]
-  Cases (EM B) of
-    (or_introl _) => e1
-  | (or_intror _) => e2
-  end.
-
-(** Axiom of choice applied to disjunction.
-    Provable in Coq because of dependent elimination. *)
-Lemma AC_IF : (P,B:Prop)(e1,e2:P)(Q:P->Prop)
-  ( B -> (Q e1))->
-  (~B -> (Q e2))->
-  (Q (IFProp B e1 e2)).
-Proof.
-Intros P B e1 e2 Q p1 p2.
-Unfold IFProp.
-Case (EM B); Assumption.
-Qed.
-
-
-(** We assume a type with two elements. They play the role of booleans.
-    The main theorem under the current assumptions is that [T=F] *)
-Variable Bool: Prop.
-Variable T: Bool.
-Variable F: Bool.
-
-(** The powerset operator *)
-Definition pow [P:Prop] :=P->Bool.
-
-
-(** A piece of theory about retracts *)
-Section Retracts.
-
-Variable A,B: Prop.
-
-Record retract : Prop := {
-    i: A->B;
-    j: B->A;
-    inv: (a:A)(j (i a))==a
-  }.
-
-Record retract_cond : Prop := {
-    i2: A->B;
-    j2: B->A;
-    inv2: retract -> (a:A)(j2 (i2 a))==a
-  }.
-
-
-(** The dependent elimination above implies the axiom of choice: *)
-Lemma AC: (r:retract_cond) retract -> (a:A)((j2 r) ((i2 r) a))==a.
-Proof.
-Intros r.
-Case r; Simpl.
-Trivial.
-Qed.
-
-End Retracts.
-
-(** This lemma is basically a commutation of implication and existential
-    quantification:  (EX x | A -> P(x))  <=> (A -> EX x | P(x))
-    which is provable in classical logic ( => is already provable in
-    intuitionnistic logic). *)
-
-Lemma L1 : (A,B:Prop)(retract_cond (pow A) (pow B)).
-Proof.
-Intros A B.
-Elim (EM (retract (pow A) (pow B))).
-Intros (f0, g0, e).
-Exists f0 g0.
-Trivial.
-
-Intros hf.
-Exists ([x:(pow A); y:B]F) ([x:(pow B); y:A]F).
-Intros; Elim hf; Auto.
-Qed.
-
-
-(** The paradoxical set *)
-Definition U := (P:Prop)(pow P).
-
-(** Bijection between [U] and [(pow U)] *)
-Definition f : U -> (pow U) :=
-  [u](u U).
-
-Definition g : (pow U) -> U :=
-  [h,X]
-    let lX = (j2 (L1 X U)) in
-    let rU = (i2 (L1 U U)) in
-    (lX (rU h)).
-
-(** We deduce that the powerset of [U] is a retract of [U].
-    This lemma is stated in Berardi's article, but is not used
-    afterwards. *)
-Lemma retract_pow_U_U : (retract (pow U) U).
-Proof.
-Exists g f.
-Intro a.
-Unfold f g; Simpl.
-Apply AC.
-Exists ([x:(pow U)]x) ([x:(pow U)]x).
-Trivial.
-Qed.
-
-(** Encoding of Russel's paradox *)
-
-(** The boolean negation. *)
-Definition Not_b := [b:Bool](IFProp b==T F T).
-
-(** the set of elements not belonging to itself *)
-Definition R : U := (g ([u:U](Not_b (u U u)))).
-
-
-Lemma not_has_fixpoint : (R R)==(Not_b (R R)).
-Proof.
-Unfold 1 R.
-Unfold g.
-Rewrite AC with r:=(L1 U U) a:=[u:U](Not_b (u U u)).
-Trivial.
-Exists ([x:(pow U)]x) ([x:(pow U)]x); Trivial.
-Qed.
-
-
-Theorem classical_proof_irrelevence : T==F.
-Proof.
-Generalize not_has_fixpoint.
-Unfold Not_b.
-Apply AC_IF.
-Intros is_true is_false.
-Elim is_true; Elim is_false; Trivial.
-
-Intros not_true is_true.
-Elim not_true; Trivial.
-Qed.
-
-End Berardis_paradox.
diff --git a/theories7/Logic/ChoiceFacts.v b/theories7/Logic/ChoiceFacts.v
deleted file mode 100644
index 5b7e002a..00000000
--- a/theories7/Logic/ChoiceFacts.v
+++ /dev/null
@@ -1,134 +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: ChoiceFacts.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(* We show that the functional formulation of the axiom of Choice
-   (usual formulation in type theory) is equivalent to its relational
-   formulation (only formulation of set theory) + the axiom of
-   (parametric) definite description (aka axiom of unique choice) *)
-
-(* This shows that the axiom of choice can be assumed (under its
-   relational formulation) without known inconsistency with classical logic,
-   though definite description conflicts with classical logic *)
-
-Definition RelationalChoice :=
- (A:Type;B:Type;R: A->B->Prop) 
-  ((x:A)(EX y:B|(R x y)))
-   -> (EXT R':A->B->Prop | 
-         ((x:A)(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
-
-Definition FunctionalChoice :=
- (A:Type;B:Type;R: A->B->Prop)
-  ((x:A)(EX y:B|(R x y))) -> (EX f:A->B | (x:A)(R x (f x))).
-
-Definition ParamDefiniteDescription :=
- (A:Type;B:Type;R: A->B->Prop)
-  ((x:A)(EX y:B|(R x y)/\ ((y':B)(R x y') -> y=y')))
-   -> (EX f:A->B | (x:A)(R x (f x))).
-
-Lemma description_rel_choice_imp_funct_choice : 
-  ParamDefiniteDescription->RelationalChoice->FunctionalChoice.
-Intros Descr RelCh.
-Red; Intros A B R H.
-NewDestruct (RelCh A B R H) as [R' H0].
-NewDestruct (Descr A B R') as [f H1].
-Intro x.
-Elim (H0 x); Intros y [H2 [H3 H4]]; Exists y; Split; [Exact H3 | Exact H4].
-Exists f; Intro x.
-Elim (H0 x); Intros y [H2 [H3 H4]].
-Rewrite <- (H4 (f x) (H1 x)).
-Exact H2.
-Qed.
-
-Lemma funct_choice_imp_rel_choice : 
-  FunctionalChoice->RelationalChoice.
-Intros FunCh.
-Red; Intros A B R H.
-NewDestruct (FunCh A B R H) as [f H0].
-Exists [x,y]y=(f x).
-Intro x; Exists (f x);
-Split; [Apply H0| Split;[Reflexivity| Intros y H1; Symmetry; Exact H1]].
-Qed.
-
-Lemma funct_choice_imp_description : 
-  FunctionalChoice->ParamDefiniteDescription.
-Intros FunCh.
-Red; Intros A B R H.
-NewDestruct (FunCh A B R) as [f H0].
-(* 1 *)
-Intro x.
-Elim (H x); Intros y [H0 H1].
-Exists y; Exact H0.
-(* 2 *)
-Exists f; Exact H0.
-Qed.
-
-Theorem FunChoice_Equiv_RelChoice_and_ParamDefinDescr :
-  FunctionalChoice <-> RelationalChoice /\ ParamDefiniteDescription.
-Split.
-Intro H; Split; [
-  Exact (funct_choice_imp_rel_choice H)
- | Exact (funct_choice_imp_description H)].
-Intros [H H0]; Exact (description_rel_choice_imp_funct_choice H0 H).
-Qed.
-
-(* We show that the guarded relational formulation of the axiom of Choice
-   comes from the non guarded formulation in presence either of the
-   independance of premises or proof-irrelevance *)
-
-Definition GuardedRelationalChoice :=
- (A:Type;B:Type;P:A->Prop;R: A->B->Prop) 
-  ((x:A)(P x)->(EX y:B|(R x y)))
-   -> (EXT R':A->B->Prop | 
-        ((x:A)(P x)->(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
-
-Definition ProofIrrelevance := (A:Prop)(a1,a2:A) a1==a2.
-
-Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice : 
-  RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice.
-Proof.
-Intros rel_choice proof_irrel.
-Red; Intros A B P R H.
-NewDestruct (rel_choice ? ? [x:(sigT ? P);y:B](R (projT1 ? ? x) y)) as [R' H0].
-Intros [x HPx].
-NewDestruct (H x HPx) as [y HRxy].
-Exists y; Exact HRxy.
-Pose R'':=[x:A;y:B](EXT H:(P x) | (R' (existT ? P x H) y)).
-Exists R''; Intros x HPx.
-NewDestruct (H0 (existT ? P x HPx)) as [y [HRxy [HR'xy Huniq]]].
-Exists y. Split.
-  Exact HRxy.
-  Split.
-    Red; Exists HPx; Exact HR'xy.
-    Intros y' HR''xy'.
-      Apply Huniq.
-      Unfold R'' in HR''xy'.
-      NewDestruct HR''xy' as [H'Px HR'xy'].
-      Rewrite proof_irrel with a1:=HPx a2:=H'Px.
-      Exact HR'xy'.
-Qed.
-
-Definition IndependenceOfPremises :=
- (A:Type)(P:A->Prop)(Q:Prop)(Q->(EXT x|(P x)))->(EXT x|Q->(P x)).
-
-Lemma rel_choice_indep_of_premises_imp_guarded_rel_choice :
-  RelationalChoice -> IndependenceOfPremises -> GuardedRelationalChoice.
-Proof.
-Intros RelCh IndPrem.
-Red; Intros A B P R H.
-NewDestruct (RelCh A B [x,y](P x)->(R x y)) as [R' H0].
-  Intro x. Apply IndPrem.
-    Apply H.
-  Exists R'.
-  Intros x HPx.
-    NewDestruct (H0 x) as [y [H1 H2]].
-    Exists y. Split. 
-      Apply (H1 HPx).
-      Exact H2.
-Qed.
diff --git a/theories7/Logic/Classical.v b/theories7/Logic/Classical.v
deleted file mode 100755
index 8d7fe1d1..00000000
--- a/theories7/Logic/Classical.v
+++ /dev/null
@@ -1,14 +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: Classical.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** Classical Logic *)
-
-Require Export Classical_Prop.
-Require Export Classical_Pred_Type.
diff --git a/theories7/Logic/ClassicalChoice.v b/theories7/Logic/ClassicalChoice.v
deleted file mode 100644
index 5419e958..00000000
--- a/theories7/Logic/ClassicalChoice.v
+++ /dev/null
@@ -1,31 +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: ClassicalChoice.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** This file provides classical logic and functional choice *)
-
-(** This file extends ClassicalDescription.v with the axiom of choice.
-    As ClassicalDescription.v, it implies the double-negation of
-    excluded-middle in Set and implies a strongly classical
-    world. Especially it conflicts with impredicativity of Set, knowing
-    that true<>false in Set.
-*)
-
-Require Export ClassicalDescription.
-Require Export RelationalChoice.
-Require ChoiceFacts.
-
-Theorem choice : 
- (A:Type;B:Type;R: A->B->Prop)
-  ((x:A)(EX y:B|(R x y))) -> (EX f:A->B | (x:A)(R x (f x))).
-Proof.
-Apply description_rel_choice_imp_funct_choice.
-Exact description.
-Exact relational_choice.
-Qed.
diff --git a/theories7/Logic/ClassicalDescription.v b/theories7/Logic/ClassicalDescription.v
deleted file mode 100644
index 85700c22..00000000
--- a/theories7/Logic/ClassicalDescription.v
+++ /dev/null
@@ -1,76 +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: ClassicalDescription.v,v 1.2.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** This file provides classical logic and definite description *)
-
-(** Classical logic and definite description, as shown in [1],
-    implies the double-negation of excluded-middle in Set, hence it
-    implies a strongly classical world. Especially it conflicts with
-    impredicativity of Set, knowing that true<>false in Set.
-
-    [1] Laurent Chicli, Loïc Pottier, Carlos Simpson, Mathematical
-    Quotients and Quotient Types in Coq, Proceedings of TYPES 2002,
-    Lecture Notes in Computer Science 2646, Springer Verlag.
-*)
-
-Require Export Classical.
-
-Axiom dependent_description :
-  (A:Type;B:A->Type;R: (x:A)(B x)->Prop)
-  ((x:A)(EX y:(B x)|(R x y)/\ ((y':(B x))(R x y') -> y=y')))
-   -> (EX f:(x:A)(B x) | (x:A)(R x (f x))).
-
-(** Principle of definite descriptions (aka axiom of unique choice) *)
-
-Theorem description :
-  (A:Type;B:Type;R: A->B->Prop)
-  ((x:A)(EX y:B|(R x y)/\ ((y':B)(R x y') -> y=y')))
-   -> (EX f:A->B | (x:A)(R x (f x))).
-Proof.
-Intros A B.
-Apply (dependent_description A [_]B).
-Qed.
-
-(** The followig proof comes from [1] *)
-
-Theorem classic_set : (((P:Prop){P}+{~P}) -> False) -> False.
-Proof.
-Intro HnotEM.
-Pose R:=[A,b]A/\true=b \/ ~A/\false=b.
-Assert H:(EX f:Prop->bool|(A:Prop)(R A (f A))).
-Apply description.
-Intro A.
-NewDestruct (classic A) as [Ha|Hnota].
-  Exists true; Split.
-    Left; Split; [Assumption|Reflexivity].
-    Intros y [[_ Hy]|[Hna _]].
-      Assumption.
-      Contradiction.
-  Exists false; Split.
-    Right; Split; [Assumption|Reflexivity].
-    Intros y [[Ha _]|[_ Hy]].
-      Contradiction.
-      Assumption.
-NewDestruct H as [f Hf].
-Apply HnotEM.
-Intro P.
-Assert HfP := (Hf P).
-(* Elimination from Hf to Set is not allowed but from f to Set yes ! *)
-NewDestruct (f P).
-  Left.
-  NewDestruct HfP as [[Ha _]|[_ Hfalse]].
-    Assumption.
-    Discriminate.
-  Right.
-  NewDestruct HfP as [[_ Hfalse]|[Hna _]].
-    Discriminate.
-    Assumption.
-Qed.
- 
diff --git a/theories7/Logic/ClassicalFacts.v b/theories7/Logic/ClassicalFacts.v
deleted file mode 100644
index 1d37652e..00000000
--- a/theories7/Logic/ClassicalFacts.v
+++ /dev/null
@@ -1,214 +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: ClassicalFacts.v,v 1.2.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** Some facts and definitions about classical logic *)
-
-(** [prop_degeneracy] (also referred as propositional completeness) *)
-(*  asserts (up to consistency) that there are only two distinct formulas *)
-Definition prop_degeneracy := (A:Prop) A==True \/ A==False.
-
-(** [prop_extensionality] asserts equivalent formulas are equal *)
-Definition prop_extensionality := (A,B:Prop) (A<->B) -> A==B.
-
-(** [excluded_middle] asserts we can reason by case on the truth *)
-(*  or falsity of any formula *)
-Definition excluded_middle := (A:Prop) A \/ ~A.
-
-(** [proof_irrelevance] asserts equality of all proofs of a given formula *)
-Definition proof_irrelevance := (A:Prop)(a1,a2:A) a1==a2.
-
-(** We show [prop_degeneracy <-> (prop_extensionality /\ excluded_middle)] *)
-
-Lemma prop_degen_ext : prop_degeneracy -> prop_extensionality.
-Proof.
-Intros H A B (Hab,Hba).
-NewDestruct (H A); NewDestruct (H B).
-  Rewrite H1; Exact H0.
-  Absurd B.
-    Rewrite H1; Exact [H]H.
-    Apply Hab; Rewrite H0; Exact I.
-  Absurd A.
-    Rewrite H0; Exact [H]H.
-    Apply Hba; Rewrite H1; Exact I.
-  Rewrite H1; Exact H0.
-Qed.
-
-Lemma prop_degen_em : prop_degeneracy -> excluded_middle.
-Proof.
-Intros H A.
-NewDestruct (H A).
-  Left; Rewrite H0; Exact I.
-  Right; Rewrite H0; Exact [x]x.
-Qed.
-
-Lemma prop_ext_em_degen :
-   prop_extensionality -> excluded_middle -> prop_degeneracy.
-Proof.
-Intros Ext EM A.
-NewDestruct (EM A).
-  Left; Apply (Ext A True); Split; [Exact [_]I | Exact [_]H].
-  Right; Apply (Ext A False); Split; [Exact H | Apply False_ind].
-Qed.
-
-(** We successively show that:
-
-   [prop_extensionality]
-     implies equality of [A] and [A->A] for inhabited [A], which 
-     implies the existence of a (trivial) retract from [A->A] to [A]
-        (just take the identity), which
-     implies the existence of a fixpoint operator in [A]
-        (e.g. take the Y combinator of lambda-calculus)
-*)
-
-Definition inhabited [A:Prop] := A.
-
-Lemma prop_ext_A_eq_A_imp_A :
-  prop_extensionality->(A:Prop)(inhabited A)->(A->A)==A.
-Proof.
-Intros Ext A a.
-Apply (Ext A->A A); Split; [ Exact [_]a | Exact [_;_]a ].
-Qed.
-
-Record retract [A,B:Prop] : Prop := {
-  f1: A->B;
-  f2: B->A;
-  f1_o_f2: (x:B)(f1 (f2 x))==x
-}.
-
-Lemma prop_ext_retract_A_A_imp_A :
-  prop_extensionality->(A:Prop)(inhabited A)->(retract A A->A).
-Proof.
-Intros Ext A a.
-Rewrite -> (prop_ext_A_eq_A_imp_A Ext A a).
-Exists [x:A]x [x:A]x.
-Reflexivity.
-Qed.
-
-Record has_fixpoint [A:Prop] : Prop := {
-  F : (A->A)->A;
-  fix : (f:A->A)(F f)==(f (F f))
-}.
-
-Lemma ext_prop_fixpoint :
-  prop_extensionality->(A:Prop)(inhabited A)->(has_fixpoint A).
-Proof.
-Intros Ext A a.
-Case (prop_ext_retract_A_A_imp_A Ext A a); Intros g1 g2 g1_o_g2.
-Exists [f]([x:A](f (g1 x x)) (g2 [x](f (g1 x x)))).
-Intro f.
-Pattern 1 (g1 (g2 [x:A](f (g1 x x)))).
-Rewrite (g1_o_g2 [x:A](f (g1 x x))).
-Reflexivity.
-Qed.
-
-(** Assume we have booleans with the property that there is at most 2
-    booleans (which is equivalent to dependent case analysis). Consider
-    the fixpoint of the negation function: it is either true or false by
-    dependent case analysis, but also the opposite by fixpoint. Hence
-    proof-irrelevance.
-
-    We then map bool proof-irrelevance to all propositions.
-*)
-
-Section Proof_irrelevance_gen.
-
-Variable bool : Prop.
-Variable true : bool.
-Variable false : bool.
-Hypothesis bool_elim : (C:Prop)C->C->bool->C.
-Hypothesis bool_elim_redl : (C:Prop)(c1,c2:C)c1==(bool_elim C c1 c2 true).
-Hypothesis bool_elim_redr : (C:Prop)(c1,c2:C)c2==(bool_elim C c1 c2 false).
-Local bool_dep_induction := (P:bool->Prop)(P true)->(P false)->(b:bool)(P b).
-
-Lemma aux : prop_extensionality -> bool_dep_induction -> true==false.
-Proof.
-Intros Ext Ind.
-Case (ext_prop_fixpoint Ext bool true); Intros G Gfix.
-Pose neg := [b:bool](bool_elim bool false true b).
-Generalize (refl_eqT ? (G neg)).
-Pattern 1 (G neg).
-Apply Ind with b:=(G neg); Intro Heq.
-Rewrite (bool_elim_redl bool false true).
-Change true==(neg true); Rewrite -> Heq; Apply Gfix.
-Rewrite (bool_elim_redr bool false true).
-Change (neg false)==false; Rewrite -> Heq; Symmetry; Apply Gfix.
-Qed.
-
-Lemma ext_prop_dep_proof_irrel_gen :
-  prop_extensionality -> bool_dep_induction -> proof_irrelevance.
-Proof.
-Intros Ext Ind A a1 a2.
-Pose f := [b:bool](bool_elim A a1 a2 b).
-Rewrite (bool_elim_redl A a1 a2).
-Change (f true)==a2.
-Rewrite (bool_elim_redr A a1 a2).
-Change (f true)==(f false).
-Rewrite (aux Ext Ind).
-Reflexivity.
-Qed.
-
-End Proof_irrelevance_gen.
-
-(** In the pure Calculus of Constructions, we can define the boolean
-    proposition bool = (C:Prop)C->C->C but we cannot prove that it has at
-    most 2 elements.
-*)
-
-Section Proof_irrelevance_CC.
-
-Definition BoolP  := (C:Prop)C->C->C.
-Definition TrueP  := [C][c1,c2]c1 : BoolP.
-Definition FalseP := [C][c1,c2]c2 : BoolP.
-Definition BoolP_elim := [C][c1,c2][b:BoolP](b C c1 c2).
-Definition BoolP_elim_redl : (C:Prop)(c1,c2:C)c1==(BoolP_elim C c1 c2 TrueP)
-  := [C;c1,c2](refl_eqT C c1).
-Definition BoolP_elim_redr : (C:Prop)(c1,c2:C)c2==(BoolP_elim C c1 c2 FalseP)
-  := [C;c1,c2](refl_eqT C c2).
-
-Definition BoolP_dep_induction := 
- (P:BoolP->Prop)(P TrueP)->(P FalseP)->(b:BoolP)(P b).
-
-Lemma ext_prop_dep_proof_irrel_cc :
-  prop_extensionality -> BoolP_dep_induction -> proof_irrelevance.
-Proof (ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim
-         BoolP_elim_redl BoolP_elim_redr).
-
-End Proof_irrelevance_CC.
-
-(** In the Calculus of Inductive Constructions, inductively defined booleans
-    enjoy dependent case analysis, hence directly proof-irrelevance from
-    propositional extensionality.
-*)
-
-Section Proof_irrelevance_CIC.
-
-Inductive boolP : Prop := trueP : boolP | falseP : boolP.
-Definition boolP_elim_redl : (C:Prop)(c1,c2:C)c1==(boolP_ind C c1 c2 trueP)
-  := [C;c1,c2](refl_eqT C c1).
-Definition boolP_elim_redr : (C:Prop)(c1,c2:C)c2==(boolP_ind C c1 c2 falseP)
-  := [C;c1,c2](refl_eqT C c2).
-Scheme boolP_indd := Induction for boolP Sort Prop.
-
-Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance.
-Proof [pe](ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind
-         boolP_elim_redl boolP_elim_redr pe boolP_indd).
-
-End Proof_irrelevance_CIC.
-
-(** Can we state proof irrelevance from propositional degeneracy
-  (i.e. propositional extensionality + excluded middle) without
-  dependent case analysis ?
-
-  Conjecture: it seems possible to build a model of CC interpreting
-  all non-empty types by the set of all lambda-terms. Such a model would
-  satisfy propositional degeneracy without satisfying proof-irrelevance
-  (nor dependent case analysis). This would imply that the previous
-  results cannot be refined.
-*)
diff --git a/theories7/Logic/Classical_Pred_Set.v b/theories7/Logic/Classical_Pred_Set.v
deleted file mode 100755
index b1c26e6d..00000000
--- a/theories7/Logic/Classical_Pred_Set.v
+++ /dev/null
@@ -1,64 +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: Classical_Pred_Set.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** Classical Predicate Logic on Set*)
-
-Require Classical_Prop.
-
-Section Generic.
-Variable U: Set.
-
-(** de Morgan laws for quantifiers *)
-
-Lemma not_all_ex_not : (P:U->Prop)(~(n:U)(P n)) -> (EX n:U | ~(P n)).
-Proof.
-Unfold not; Intros P notall.
-Apply NNPP; Unfold not.
-Intro abs.
-Cut ((n:U)(P n)); Auto.
-Intro n; Apply NNPP.
-Unfold not; Intros.
-Apply abs; Exists n; Trivial.
-Qed.
-
-Lemma not_all_not_ex : (P:U->Prop)(~(n:U)~(P n)) -> (EX n:U |(P n)).
-Proof.
-Intros P H.
-Elim (not_all_ex_not [n:U]~(P n) H); Intros n Pn; Exists n.
-Apply NNPP; Trivial.
-Qed.
-
-Lemma not_ex_all_not : (P:U->Prop) (~(EX n:U |(P n))) -> (n:U)~(P n).
-Proof.
-Unfold not; Intros P notex n abs.
-Apply notex.
-Exists n; Trivial.
-Qed. 
-
-Lemma not_ex_not_all : (P:U->Prop)(~(EX n:U | ~(P n))) -> (n:U)(P n).
-Proof.
-Intros P H n.
-Apply NNPP.
-Red; Intro K; Apply H; Exists n; Trivial.
-Qed.
-
-Lemma ex_not_not_all : (P:U->Prop) (EX n:U | ~(P n)) -> ~(n:U)(P n).
-Proof.
-Unfold not; Intros P exnot allP.
-Elim exnot; Auto.
-Qed.
-
-Lemma all_not_not_ex : (P:U->Prop) ((n:U)~(P n)) -> ~(EX n:U |(P n)).
-Proof.
-Unfold not; Intros P allnot exP; Elim exP; Intros n p.
-Apply allnot with n; Auto.
-Qed.
-
-End Generic.
diff --git a/theories7/Logic/Classical_Pred_Type.v b/theories7/Logic/Classical_Pred_Type.v
deleted file mode 100755
index 69175ec7..00000000
--- a/theories7/Logic/Classical_Pred_Type.v
+++ /dev/null
@@ -1,64 +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: Classical_Pred_Type.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** Classical Predicate Logic on Type *)
-
-Require Classical_Prop.
-
-Section Generic.
-Variable U: Type.
-
-(** de Morgan laws for quantifiers *)
-
-Lemma not_all_ex_not : (P:U->Prop)(~(n:U)(P n)) -> (EXT n:U | ~(P n)).
-Proof.
-Unfold not; Intros P notall.
-Apply NNPP; Unfold not.
-Intro abs.
-Cut ((n:U)(P n)); Auto.
-Intro n; Apply NNPP.
-Unfold not; Intros.
-Apply abs; Exists n; Trivial.
-Qed.
-
-Lemma not_all_not_ex : (P:U->Prop)(~(n:U)~(P n)) -> (EXT n:U | (P n)).
-Proof.
-Intros P H.
-Elim (not_all_ex_not [n:U]~(P n) H); Intros n Pn; Exists n.
-Apply NNPP; Trivial.
-Qed.
-
-Lemma not_ex_all_not : (P:U->Prop)(~(EXT n:U | (P n))) -> (n:U)~(P n).
-Proof.
-Unfold not; Intros P notex n abs.
-Apply notex.
-Exists n; Trivial.
-Qed. 
-
-Lemma not_ex_not_all : (P:U->Prop)(~(EXT n:U | ~(P n))) -> (n:U)(P n).
-Proof.
-Intros P H n.
-Apply NNPP.
-Red; Intro K; Apply H; Exists n; Trivial.
-Qed.
-
-Lemma ex_not_not_all : (P:U->Prop) (EXT n:U | ~(P n)) -> ~(n:U)(P n).
-Proof.
-Unfold not; Intros P exnot allP.
-Elim exnot; Auto.
-Qed.
-
-Lemma all_not_not_ex : (P:U->Prop) ((n:U)~(P n)) -> ~(EXT n:U | (P n)).
-Proof.
-Unfold not; Intros P allnot exP; Elim exP; Intros n p.
-Apply allnot with n; Auto.
-Qed.
-
-End Generic.
diff --git a/theories7/Logic/Classical_Prop.v b/theories7/Logic/Classical_Prop.v
deleted file mode 100755
index 1dc7ec57..00000000
--- a/theories7/Logic/Classical_Prop.v
+++ /dev/null
@@ -1,85 +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: Classical_Prop.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** Classical Propositional Logic *)
-
-Require ProofIrrelevance.
-
-Hints Unfold not : core.
-
-Axiom classic: (P:Prop)(P \/ ~(P)).
-
-Lemma NNPP : (p:Prop)~(~(p))->p.
-Proof.
-Unfold not; Intros; Elim (classic p); Auto.
-Intro NP; Elim (H NP).
-Qed.
-
-Lemma not_imply_elim : (P,Q:Prop)~(P->Q)->P.
-Proof.
-Intros; Apply NNPP; Red.
-Intro; Apply H; Intro; Absurd P; Trivial.
-Qed.
-
-Lemma not_imply_elim2 : (P,Q:Prop)~(P->Q) -> ~Q.
-Proof.
-Intros; Elim (classic Q); Auto.
-Qed.
-
-Lemma imply_to_or : (P,Q:Prop)(P->Q) -> ~P \/ Q.
-Proof.
-Intros; Elim (classic P); Auto.
-Qed.
-
-Lemma imply_to_and : (P,Q:Prop)~(P->Q) -> P /\ ~Q.
-Proof.
-Intros; Split.
-Apply not_imply_elim with Q;  Trivial.
-Apply not_imply_elim2 with P; Trivial.
-Qed.
-
-Lemma or_to_imply : (P,Q:Prop)(~P \/ Q) -> P->Q.
-Proof.
-Induction 1; Auto.
-Intros H1 H2; Elim (H1 H2).
-Qed.
-
-Lemma not_and_or : (P,Q:Prop)~(P/\Q)-> ~P \/ ~Q.
-Proof.
-Intros; Elim (classic P); Auto.
-Qed.
-
-Lemma or_not_and : (P,Q:Prop)(~P \/ ~Q) -> ~(P/\Q).
-Proof.
-Induction 1; Red; Induction 2; Auto.
-Qed.
-
-Lemma not_or_and : (P,Q:Prop)~(P\/Q)-> ~P /\ ~Q.
-Proof.
-Intros; Elim (classic P); Auto.
-Qed.
-
-Lemma and_not_or : (P,Q:Prop)(~P /\ ~Q) -> ~(P\/Q).
-Proof.
-Induction 1; Red; Induction 3; Trivial.
-Qed.
-
-Lemma imply_and_or: (P,Q:Prop)(P->Q) -> P \/ Q -> Q.
-Proof.
-Induction 2; Trivial.
-Qed.
-
-Lemma imply_and_or2: (P,Q,R:Prop)(P->Q) -> P \/ R -> Q \/ R.
-Proof.
-Induction 2; Auto.
-Qed.
-
-Lemma proof_irrelevance: (P:Prop)(p1,p2:P)p1==p2.
-Proof (proof_irrelevance_cci classic).
diff --git a/theories7/Logic/Classical_Type.v b/theories7/Logic/Classical_Type.v
deleted file mode 100755
index e34170cd..00000000
--- a/theories7/Logic/Classical_Type.v
+++ /dev/null
@@ -1,14 +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: Classical_Type.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** Classical Logic for Type *)
-
-Require Export Classical_Prop.
-Require Export Classical_Pred_Type.
diff --git a/theories7/Logic/Decidable.v b/theories7/Logic/Decidable.v
deleted file mode 100644
index 537b5e88..00000000
--- a/theories7/Logic/Decidable.v
+++ /dev/null
@@ -1,58 +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: Decidable.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $	 i*)
-
-(** Properties of decidable propositions *)
-
-Definition decidable := [P:Prop] P \/ ~P.
-
-Theorem dec_not_not : (P:Prop)(decidable P) -> (~P -> False) -> P.
-Unfold decidable; Tauto. 
-Qed.
-
-Theorem dec_True: (decidable True).
-Unfold decidable; Auto.
-Qed.
-
-Theorem dec_False: (decidable False).
-Unfold decidable not; Auto.
-Qed.
-
-Theorem dec_or: (A,B:Prop)(decidable A) -> (decidable B) -> (decidable (A\/B)).
-Unfold decidable; Tauto. 
-Qed.
-
-Theorem dec_and: (A,B:Prop)(decidable A) -> (decidable B) ->(decidable (A/\B)).
-Unfold decidable; Tauto. 
-Qed.
-
-Theorem dec_not: (A:Prop)(decidable A) -> (decidable ~A).
-Unfold decidable; Tauto. 
-Qed.
-
-Theorem dec_imp: (A,B:Prop)(decidable A) -> (decidable B) ->(decidable (A->B)).
-Unfold decidable; Tauto. 
-Qed.
-
-Theorem not_not : (P:Prop)(decidable P) -> (~(~P)) -> P.
-Unfold decidable; Tauto. Qed.
-
-Theorem not_or : (A,B:Prop) ~(A\/B) -> ~A /\ ~B.
-Tauto. Qed.
-
-Theorem not_and : (A,B:Prop) (decidable A) -> ~(A/\B) -> ~A \/ ~B.
-Unfold decidable; Tauto. Qed.
-
-Theorem not_imp : (A,B:Prop) (decidable A) -> ~(A -> B) -> A /\ ~B.
-Unfold decidable;Tauto.
-Qed.
-
-Theorem imp_simp : (A,B:Prop) (decidable A) -> (A -> B) -> ~A \/ B.
-Unfold decidable; Tauto.
-Qed.
-
diff --git a/theories7/Logic/Diaconescu.v b/theories7/Logic/Diaconescu.v
deleted file mode 100644
index 9f5f91a0..00000000
--- a/theories7/Logic/Diaconescu.v
+++ /dev/null
@@ -1,133 +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: Diaconescu.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(* R. Diaconescu [Diaconescu] showed that the Axiom of Choice in Set Theory
-   entails Excluded-Middle; S. Lacas and B. Werner [LacasWerner]
-   adapted the proof to show that the axiom of choice in equivalence
-   classes entails Excluded-Middle in Type Theory.
-
-   This is an adaptatation of the proof by Hugo Herbelin to show that
-   the relational form of the Axiom of Choice + Extensionality for
-   predicates entails Excluded-Middle
-
-   [Diaconescu] R. Diaconescu, Axiom of Choice and Complementation, in
-   Proceedings of AMS, vol 51, pp 176-178, 1975.
-
-   [LacasWerner] S. Lacas, B Werner, Which Choices imply the excluded middle?,
-   preprint, 1999.
-
-*)
-
-Section PredExt_GuardRelChoice_imp_EM.
-
-(* The axiom of extensionality for predicates *)
-
-Definition PredicateExtensionality :=
-   (P,Q:bool->Prop)((b:bool)(P b)<->(Q b))->P==Q.
-
-(* From predicate extensionality we get propositional extensionality
-   hence proof-irrelevance *)
-
-Require ClassicalFacts.
-
-Variable pred_extensionality : PredicateExtensionality.
-  
-Lemma prop_ext : (A,B:Prop) (A<->B) -> A==B.
-Proof.
-  Intros A B H.
-  Change ([_]A true)==([_]B true).
-  Rewrite pred_extensionality with P:=[_:bool]A Q:=[_:bool]B.
-    Reflexivity.
-    Intros _; Exact H.
-Qed.
-
-Lemma proof_irrel : (A:Prop)(a1,a2:A) a1==a2.
-Proof.
-  Apply (ext_prop_dep_proof_irrel_cic prop_ext).
-Qed.
-
-(* From proof-irrelevance and relational choice, we get guarded
-   relational choice *)
-
-Require ChoiceFacts.
-
-Variable rel_choice : RelationalChoice.
-
-Lemma guarded_rel_choice :
-  (A:Type)(B:Type)(P:A->Prop)(R:A->B->Prop)
-  ((x:A)(P x)->(EX y:B|(R x y)))->
-    (EXT R':A->B->Prop | 
-      ((x:A)(P x)->(EX y:B|(R x y)/\(R' x y)/\ ((y':B)(R' x y') -> y=y')))).
-Proof.
-  Exact
-    (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel).
-Qed.
-
-(* The form of choice we need: there is a functional relation which chooses
-   an element in any non empty subset of bool *)
-
-Require Bool.
-
-Lemma AC :
-  (EXT R:(bool->Prop)->bool->Prop |
-     (P:bool->Prop)(EX b : bool | (P b))->
-        (EX b : bool | (P b) /\ (R P b) /\ ((b':bool)(R P b')->b=b'))).
-Proof.
-  Apply guarded_rel_choice with
-    P:= [Q:bool->Prop](EX y | (Q y)) R:=[Q:bool->Prop;y:bool](Q y).
-  Exact [_;H]H.
-Qed.
-
-(* The proof of the excluded middle *)
-(* Remark: P could have been in Set or Type *)
-
-Theorem pred_ext_and_rel_choice_imp_EM : (P:Prop)P\/~P.
-Proof.
-Intro P.
-
-(* first we exhibit the choice functional relation R *)
-NewDestruct AC as [R H].
-
-Pose class_of_true := [b]b=true\/P.
-Pose class_of_false := [b]b=false\/P.
-
-(* the actual "decision": is (R class_of_true) = true or false? *)
-NewDestruct (H class_of_true) as [b0 [H0 [H0' H0'']]].
-Exists true; Left; Reflexivity.
-NewDestruct H0.
-
-(* the actual "decision": is (R class_of_false) = true or false? *)
-NewDestruct (H class_of_false) as [b1 [H1 [H1' H1'']]].
-Exists false; Left; Reflexivity.
-NewDestruct H1.
-
-(* case where P is false: (R class_of_true)=true /\ (R class_of_false)=false *)
-Right.
-Intro HP.
-Assert Hequiv:(b:bool)(class_of_true b)<->(class_of_false b).
-Intro b; Split.
-Unfold class_of_false; Right; Assumption.
-Unfold class_of_true; Right; Assumption.
-Assert Heq:class_of_true==class_of_false.
-Apply pred_extensionality with 1:=Hequiv.
-Apply diff_true_false.
-Rewrite <- H0.
-Rewrite <- H1.
-Rewrite <- H0''. Reflexivity.
-Rewrite Heq.
-Assumption.
-
-(* cases where P is true *)
-Left; Assumption.
-Left; Assumption.
-
-Qed.
-
-End PredExt_GuardRelChoice_imp_EM.
diff --git a/theories7/Logic/Eqdep.v b/theories7/Logic/Eqdep.v
deleted file mode 100755
index fc2dfe52..00000000
--- a/theories7/Logic/Eqdep.v
+++ /dev/null
@@ -1,183 +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: Eqdep.v,v 1.2.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** This file defines dependent equality and shows its equivalence with
-    equality on dependent pairs (inhabiting sigma-types). It axiomatizes
-    the invariance by substitution of reflexive equality proofs and 
-    shows the equivalence between the 4 following statements
-
-    - Invariance by Substitution of Reflexive Equality Proofs.
-    - Injectivity of Dependent Equality
-    - Uniqueness of Identity Proofs
-    - Uniqueness of Reflexive Identity Proofs
-    - Streicher's Axiom K
-
-  These statements are independent of the calculus of constructions [2].
-
-  References:
-
-  [1] T. Streicher, Semantical Investigations into Intensional Type Theory,
-      Habilitationsschrift, LMU München, 1993.
-  [2] M. Hofmann, T. Streicher, The groupoid interpretation of type theory,
-      Proceedings of the meeting Twenty-five years of constructive
-      type theory, Venice, Oxford University Press, 1998
-*)
-
-Section Dependent_Equality.
-
-Variable U : Type.
-Variable P : U->Type.
-
-(** Dependent equality *)
-
-Inductive eq_dep [p:U;x:(P p)] : (q:U)(P q)->Prop :=
-   eq_dep_intro : (eq_dep p x p x).
-Hint constr_eq_dep : core v62 := Constructors eq_dep.
-
-Lemma eq_dep_sym : (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)->(eq_dep q y p x).
-Proof.
-NewDestruct 1; Auto.
-Qed.
-Hints Immediate eq_dep_sym : core v62.
-
-Lemma eq_dep_trans : (p,q,r:U)(x:(P p))(y:(P q))(z:(P r))
-     (eq_dep p x q y)->(eq_dep q y r z)->(eq_dep p x r z).
-Proof.
-NewDestruct 1; Auto.
-Qed.
-
-Inductive eq_dep1 [p:U;x:(P p);q:U;y:(P q)] : Prop :=
-   eq_dep1_intro : (h:q=p)
-                  (x=(eq_rect U q P y p h))->(eq_dep1 p x q y).
-
-Scheme eq_indd := Induction for eq Sort Prop.
-
-Lemma eq_dep1_dep :
-      (p:U)(x:(P p))(q:U)(y:(P q))(eq_dep1 p x q y)->(eq_dep p x q y).
-Proof.
-NewDestruct 1 as [eq_qp H].
-NewDestruct eq_qp using eq_indd.
-Rewrite H.
-Apply eq_dep_intro.
-Qed.
-
-Lemma eq_dep_dep1 : 
-  (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)->(eq_dep1 p x q y).
-Proof.
-NewDestruct 1.
-Apply eq_dep1_intro with (refl_equal U p).
-Simpl; Trivial.
-Qed.
-
-(** Invariance by Substitution of Reflexive Equality Proofs *)
-
-Axiom eq_rect_eq : (p:U)(Q:U->Type)(x:(Q p))(h:p=p)
-                  x=(eq_rect U p Q x p h).
-
-(** Injectivity of Dependent Equality is a consequence of *)
-(** Invariance by Substitution of Reflexive Equality Proof *)
-
-Lemma eq_dep1_eq : (p:U)(x,y:(P p))(eq_dep1 p x p y)->x=y.
-Proof.
-Destruct 1; Intro.
-Rewrite <- eq_rect_eq; Auto.
-Qed.
-
-Lemma eq_dep_eq : (p:U)(x,y:(P p))(eq_dep p x p y)->x=y.
-Proof.
-Intros; Apply eq_dep1_eq; Apply eq_dep_dep1; Trivial.
-Qed.
-
-End Dependent_Equality.
-
-(** Uniqueness of Identity Proofs (UIP) is a consequence of *)
-(** Injectivity of Dependent Equality *)
-
-Lemma UIP : (U:Type)(x,y:U)(p1,p2:x=y)p1=p2.
-Proof.
-Intros; Apply eq_dep_eq with P:=[y]x=y.
-Elim p2 using eq_indd.
-Elim p1 using eq_indd.
-Apply eq_dep_intro.
-Qed.
-
-(** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *)
-
-Lemma UIP_refl : (U:Type)(x:U)(p:x=x)p=(refl_equal U x).
-Proof.
-Intros; Apply UIP.
-Qed.
-
-(** Streicher axiom K is a direct consequence of Uniqueness of
-    Reflexive Identity Proofs *)
-
-Lemma Streicher_K : (U:Type)(x:U)(P:x=x->Prop)
-  (P (refl_equal ? x))->(p:x=x)(P p).
-Proof.
-Intros; Rewrite UIP_refl; Assumption.
-Qed.
-
-(** We finally recover eq_rec_eq (alternatively eq_rect_eq) from K *)
-
-Lemma eq_rec_eq : (U:Type)(P:U->Set)(p:U)(x:(P p))(h:p=p)
-  x=(eq_rec U p P x p h).
-Proof.
-Intros.
-Apply Streicher_K with p:=h.
-Reflexivity.
-Qed.
-
-(** Dependent equality is equivalent to equality on dependent pairs *)
-
-Lemma equiv_eqex_eqdep : (U:Set)(P:U->Set)(p,q:U)(x:(P p))(y:(P q)) 
-    (existS U P p x)=(existS U P q y) <-> (eq_dep U P p x q y).
-Proof.
-Split. 
-(* -> *)
-Intro H.
-Change p with   (projS1 U P (existS U P p x)).
-Change 2 x with (projS2 U P (existS U P p x)).
-Rewrite H.
-Apply eq_dep_intro.
-(* <- *)
-NewDestruct 1; Reflexivity.
-Qed.
-
-(** UIP implies the injectivity of equality on dependent pairs *)
-
-Lemma inj_pair2: (U:Set)(P:U->Set)(p:U)(x,y:(P p))
-    (existS U P p x)=(existS U P p y)-> x=y.
-Proof.
-Intros.
-Apply (eq_dep_eq U P).
-Generalize (equiv_eqex_eqdep U P p p x y) .
-Induction 1.
-Intros.
-Auto.
-Qed.
-
-(** UIP implies the injectivity of equality on dependent pairs *)
-
-Lemma inj_pairT2: (U:Type)(P:U->Type)(p:U)(x,y:(P p))
-    (existT U P p x)=(existT U P p y)-> x=y.
-Proof.
-Intros.
-Apply (eq_dep_eq U P).
-Change 1 p with (projT1 U P (existT U P p x)).
-Change 2 x with (projT2 U P (existT U P p x)).
-Rewrite H.
-Apply eq_dep_intro.
-Qed.
-
-(** The main results to be exported *)
-
-Hints Resolve eq_dep_intro eq_dep_eq : core v62.
-Hints Immediate eq_dep_sym : core v62.
-Hints Resolve inj_pair2 inj_pairT2 : core.
diff --git a/theories7/Logic/Eqdep_dec.v b/theories7/Logic/Eqdep_dec.v
deleted file mode 100644
index 959395e3..00000000
--- a/theories7/Logic/Eqdep_dec.v
+++ /dev/null
@@ -1,149 +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: Eqdep_dec.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** We prove that there is only one proof of [x=x], i.e [(refl_equal ? x)].
-   This holds if the equality upon the set of [x] is decidable.
-   A corollary of this theorem is the equality of the right projections
-   of two equal dependent pairs.
-
-   Author:   Thomas Kleymann |<tms@dcs.ed.ac.uk>| in Lego
-             adapted to Coq by B. Barras
-
-   Credit:   Proofs up to [K_dec] follows an outline by Michael Hedberg
-*)
-
-
-(** We need some dependent elimination schemes *)
-
-Set Implicit Arguments.
-
-  (** Bijection between [eq] and [eqT] *)
-  Definition eq2eqT: (A:Set)(x,y:A)x=y->x==y :=
-    [A,x,_,eqxy]<[y:A]x==y>Cases eqxy of refl_equal => (refl_eqT ? x) end.
-
-  Definition eqT2eq: (A:Set)(x,y:A)x==y->x=y :=
-    [A,x,_,eqTxy]<[y:A]x=y>Cases eqTxy of refl_eqT => (refl_equal ? x) end.
-
-  Lemma eq_eqT_bij: (A:Set)(x,y:A)(p:x=y)p==(eqT2eq (eq2eqT p)).
-Intros.
-Case p; Reflexivity.
-Qed.
-
-  Lemma eqT_eq_bij: (A:Set)(x,y:A)(p:x==y)p==(eq2eqT (eqT2eq p)).
-Intros.
-Case p; Reflexivity.
-Qed.
-
-
-Section DecidableEqDep.
-
-  Variable A: Type.
-
-  Local comp [x,y,y':A]: x==y->x==y'->y==y' :=
-    [eq1,eq2](eqT_ind ? ? [a]a==y' eq2 ? eq1).
-
-  Remark trans_sym_eqT: (x,y:A)(u:x==y)(comp u u)==(refl_eqT ? y).
-Intros.
-Case u; Trivial.
-Qed.
-
-
-
-  Variable eq_dec: (x,y:A) x==y \/ ~x==y.
-
-  Variable x: A.
-
-
-  Local nu [y:A]: x==y->x==y :=
-    [u]Cases (eq_dec x y) of
-       (or_introl eqxy)  => eqxy
-     | (or_intror neqxy) => (False_ind ? (neqxy u))
-     end.
-
-  Local nu_constant : (y:A)(u,v:x==y) (nu u)==(nu v).
-Intros.
-Unfold nu.
-Case (eq_dec x y); Intros.
-Reflexivity.
-
-Case n; Trivial.
-Qed.
-
-
-  Local nu_inv [y:A]: x==y->x==y := [v](comp (nu (refl_eqT ? x)) v).
-
-
-  Remark nu_left_inv : (y:A)(u:x==y) (nu_inv (nu u))==u.
-Intros.
-Case u; Unfold nu_inv.
-Apply trans_sym_eqT.
-Qed.
-
-
-  Theorem eq_proofs_unicity: (y:A)(p1,p2:x==y) p1==p2.
-Intros.
-Elim nu_left_inv with u:=p1.
-Elim nu_left_inv with u:=p2.
-Elim nu_constant with y p1 p2.
-Reflexivity.
-Qed.
-
-  Theorem K_dec: (P:x==x->Prop)(P (refl_eqT ? x)) -> (p:x==x)(P p).
-Intros.
-Elim eq_proofs_unicity with x (refl_eqT ? x) p.
-Trivial.
-Qed.
-
-
-  (** The corollary *)
-
-  Local proj: (P:A->Prop)(ExT P)->(P x)->(P x) :=
-    [P,exP,def]Cases exP of
-      (exT_intro x' prf) =>
-        Cases (eq_dec x' x) of
-          (or_introl eqprf) => (eqT_ind ? x' P prf x eqprf)
-        | _ => def
-        end
-      end.
-
-
-  Theorem inj_right_pair: (P:A->Prop)(y,y':(P x))
-    (exT_intro ? P x y)==(exT_intro ? P x y') -> y==y'.
-Intros.
-Cut (proj (exT_intro A P x y) y)==(proj (exT_intro A P x y') y).
-Simpl.
-Case (eq_dec x x).
-Intro e.
-Elim e using K_dec; Trivial.
-
-Intros.
-Case n; Trivial.
-
-Case H.
-Reflexivity.
-Qed.
-
-End DecidableEqDep.
-
-  (** We deduce the [K] axiom for (decidable) Set *)
-  Theorem K_dec_set: (A:Set)((x,y:A){x=y}+{~x=y})
-                       ->(x:A)(P: x=x->Prop)(P (refl_equal ? x))
-                         ->(p:x=x)(P p).
-Intros.
-Rewrite eq_eqT_bij.
-Elim (eq2eqT p) using K_dec.
-Intros.
-Case (H x0 y); Intros.
-Elim e; Left ; Reflexivity.
-
-Right ; Red; Intro neq; Apply n; Elim neq; Reflexivity.
-
-Trivial.
-Qed.
diff --git a/theories7/Logic/Hurkens.v b/theories7/Logic/Hurkens.v
deleted file mode 100644
index 066e51aa..00000000
--- a/theories7/Logic/Hurkens.v
+++ /dev/null
@@ -1,79 +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        *)
-(************************************************************************)
-(*                              Hurkens.v                               *)
-(************************************************************************)
-
-(** This is Hurkens paradox [Hurkens] in system U-, adapted by Herman
-    Geuvers [Geuvers] to show the inconsistency in the pure calculus of
-    constructions of a retract from Prop into a small type.
-
-    References:
-
-    - [Hurkens] A. J. Hurkens, "A simplification of Girard's paradox",
-      Proceedings of the 2nd international conference Typed Lambda-Calculi
-      and Applications (TLCA'95), 1995.
-
-    - [Geuvers] "Inconsistency of Classical Logic in Type Theory", 2001
-      (see www.cs.kun.nl/~herman/note.ps.gz).
-*)
-
-Section Paradox.
-
-Variable bool : Prop.
-Variable p2b : Prop -> bool.
-Variable b2p : bool -> Prop.
-Hypothesis p2p1 : (A:Prop)(b2p (p2b A))->A.
-Hypothesis p2p2 : (A:Prop)A->(b2p (p2b A)).
-Variable B:Prop.
-
-Definition V := (A:Prop)((A->bool)->(A->bool))->(A->bool).
-Definition U := V->bool.
-Definition sb : V -> V := [z][A;r;a](r (z A r) a).
-Definition le : (U->bool)->(U->bool) := [i][x](x [A;r;a](i [v](sb v A r a))).
-Definition induct : (U->bool)->Prop := [i](x:U)(b2p (le i x))->(b2p (i x)).
-Definition WF : U := [z](p2b (induct (z U le))).
-Definition I : U->Prop :=
-  [x]((i:U->bool)(b2p (le i x))->(b2p (i [v](sb v U le x))))->B.
-
-Lemma Omega : (i:U->bool)(induct i)->(b2p (i WF)).
-Proof.
-Intros i y.
-Apply y.
-Unfold le WF induct.
-Apply p2p2.
-Intros x H0.
-Apply y.
-Exact H0.
-Qed.
-
-Lemma lemma1 : (induct [u](p2b (I u))).
-Proof.
-Unfold induct.
-Intros x p.
-Apply (p2p2 (I x)).
-Intro q.
-Apply (p2p1 (I [v:V](sb v U le x)) (q [u](p2b (I u)) p)).
-Intro i.
-Apply q with i:=[y:?](i [v:V](sb v U le y)).
-Qed.
-
-Lemma lemma2 : ((i:U->bool)(induct i)->(b2p (i WF)))->B.
-Proof.
-Intro x.
-Apply (p2p1 (I WF) (x [u](p2b (I u)) lemma1)).
-Intros i H0.
-Apply (x [y](i [v](sb v U le y))).
-Apply (p2p1 ? H0).
-Qed.
-
-Theorem paradox : B.
-Proof.
-Exact (lemma2 Omega).
-Qed.
-
-End Paradox.
diff --git a/theories7/Logic/JMeq.v b/theories7/Logic/JMeq.v
deleted file mode 100644
index 38dfa5e6..00000000
--- a/theories7/Logic/JMeq.v
+++ /dev/null
@@ -1,64 +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: JMeq.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(** John Major's Equality as proposed by C. Mc Bride *)
-
-Set Implicit Arguments.
-
-Inductive JMeq [A:Set;x:A] : (B:Set)B->Prop := 
-	JMeq_refl : (JMeq x x).
-Reset JMeq_ind.
-
-Hints Resolve JMeq_refl.
-
-Lemma sym_JMeq : (A,B:Set)(x:A)(y:B)(JMeq x y)->(JMeq y x).
-NewDestruct 1; Trivial.
-Qed.
-
-Hints Immediate sym_JMeq.
-
-Lemma trans_JMeq : (A,B,C:Set)(x:A)(y:B)(z:C)
-	(JMeq x y)->(JMeq y z)->(JMeq x z).
-NewDestruct 1; Trivial.
-Qed.
-
-Axiom JMeq_eq : (A:Set)(x,y:A)(JMeq x y)->(x=y).
-
-Lemma JMeq_ind : (A:Set)(x,y:A)(P:A->Prop)(P x)->(JMeq x y)->(P y).
-Intros A x y P H H'; Case JMeq_eq with 1:=H'; Trivial.
-Qed.
-
-Lemma JMeq_rec : (A:Set)(x,y:A)(P:A->Set)(P x)->(JMeq x y)->(P y).
-Intros A x y P H H'; Case JMeq_eq with 1:=H'; Trivial.
-Qed.
-
-Lemma JMeq_ind_r : (A:Set)(x,y:A)(P:A->Prop)(P y)->(JMeq x y)->(P x).
-Intros A x y P H H'; Case JMeq_eq with 1:=(sym_JMeq H'); Trivial.
-Qed.
-
-Lemma JMeq_rec_r : (A:Set)(x,y:A)(P:A->Set)(P y)->(JMeq x y)->(P x).
-Intros A x y P H H'; Case JMeq_eq with 1:=(sym_JMeq H'); Trivial.
-Qed.
-
-(** [JMeq] is equivalent to [(eq_dep Set [X]X)] *)
-
-Require Eqdep.
-
-Lemma JMeq_eq_dep : (A,B:Set)(x:A)(y:B)(JMeq x y)->(eq_dep Set [X]X A x B y).
-Proof.
-NewDestruct 1.
-Apply eq_dep_intro.
-Qed.
-
-Lemma eq_dep_JMeq : (A,B:Set)(x:A)(y:B)(eq_dep Set [X]X A x B y)->(JMeq x y).
-Proof.
-NewDestruct 1.
-Apply JMeq_refl. 
-Qed.
diff --git a/theories7/Logic/ProofIrrelevance.v b/theories7/Logic/ProofIrrelevance.v
deleted file mode 100644
index 3f031ff7..00000000
--- a/theories7/Logic/ProofIrrelevance.v
+++ /dev/null
@@ -1,113 +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        *)
-(************************************************************************)
-
-(** This is a proof in the pure Calculus of Construction that
-    classical logic in Prop + dependent elimination of disjunction entails
-    proof-irrelevance.
-
-    Since, dependent elimination is derivable in the Calculus of
-    Inductive Constructions (CCI), we get proof-irrelevance from classical
-    logic in the CCI.
-
-    Reference:
-
-    - [Coquand] T. Coquand, "Metamathematical Investigations of a
-      Calculus of Constructions", Proceedings of Logic in Computer Science
-      (LICS'90), 1990.
-
-    Proof skeleton: classical logic + dependent elimination of
-    disjunction + discrimination of proofs implies the existence of a
-    retract from Prop into bool, hence inconsistency by encoding any
-    paradox of system U- (e.g. Hurkens' paradox).
-*)
-
-Require Hurkens.
-
-Section Proof_irrelevance_CC.
-
-Variable or : Prop -> Prop -> Prop.
-Variable or_introl : (A,B:Prop)A->(or A B).
-Variable or_intror : (A,B:Prop)B->(or A B).
-Hypothesis or_elim : (A,B:Prop)(C:Prop)(A->C)->(B->C)->(or A B)->C.
-Hypothesis or_elim_redl :
-  (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(a:A)
-  (f a)==(or_elim A B C f g (or_introl A B a)).
-Hypothesis or_elim_redr :
-  (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(b:B)
-  (g b)==(or_elim A B C f g (or_intror A B b)).
-Hypothesis or_dep_elim :
- (A,B:Prop)(P:(or A B)->Prop)
- ((a:A)(P (or_introl A B a))) ->
- ((b:B)(P (or_intror A B b))) -> (b:(or A B))(P b).
-
-Hypothesis em : (A:Prop)(or A ~A).
-Variable B : Prop.
-Variable b1,b2 : B.
-
-(** [p2b] and [b2p] form a retract if [~b1==b2] *)
-
-Definition p2b [A] := (or_elim A ~A B [_]b1 [_]b2 (em A)).
-Definition b2p [b] := b1==b.
-
-Lemma p2p1 : (A:Prop) A -> (b2p (p2b A)).
-Proof.
-  Unfold p2b; Intro A; Apply or_dep_elim with b:=(em A); Unfold b2p; Intros.
-  Apply (or_elim_redl A ~A B [_]b1 [_]b2).
-  NewDestruct (b H).
-Qed.
-Lemma p2p2 :  ~b1==b2->(A:Prop) (b2p (p2b A)) -> A.
-Proof.
-  Intro not_eq_b1_b2.
-  Unfold p2b; Intro A; Apply or_dep_elim with b:=(em A); Unfold b2p; Intros.
-  Assumption.
-  NewDestruct not_eq_b1_b2.
-  Rewrite <- (or_elim_redr A ~A B [_]b1 [_]b2) in H.
-  Assumption.
-Qed.
-
-(** Using excluded-middle a second time, we get proof-irrelevance *)
-
-Theorem proof_irrelevance_cc : b1==b2.
-Proof.
-  Refine (or_elim ? ? ? ? ? (em b1==b2));Intro H.
-    Trivial.
-  Apply (paradox B p2b b2p (p2p2 H) p2p1).
-Qed.
-
-End Proof_irrelevance_CC.
-
-
-(** The Calculus of Inductive Constructions (CCI) enjoys dependent
-    elimination, hence classical logic in CCI entails proof-irrelevance.
-*)
-
-Section Proof_irrelevance_CCI.
-
-Hypothesis em : (A:Prop) A \/ ~A.
-
-Definition or_elim_redl :
-  (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(a:A)
-  (f a)==(or_ind A B C f g (or_introl A B a))
-  := [A,B,C;f;g;a](refl_eqT C (f a)).
-Definition or_elim_redr :
-  (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(b:B)
-  (g b)==(or_ind A B C f g (or_intror A B b))
-  := [A,B,C;f;g;b](refl_eqT C (g b)).
-Scheme or_indd := Induction for or Sort Prop.
-
-Theorem proof_irrelevance_cci : (B:Prop)(b1,b2:B)b1==b2.
-Proof
-  (proof_irrelevance_cc or or_introl or_intror or_ind
-     or_elim_redl or_elim_redr or_indd em).
-
-End Proof_irrelevance_CCI.
-
-(** Remark: in CCI, [bool] can be taken in [Set] as well in the
-    paradox and since [~true=false] for [true] and [false] in
-    [bool], we get the inconsistency of [em : (A:Prop){A}+{~A}] in CCI
-*)
diff --git a/theories7/Logic/RelationalChoice.v b/theories7/Logic/RelationalChoice.v
deleted file mode 100644
index e61f3582..00000000
--- a/theories7/Logic/RelationalChoice.v
+++ /dev/null
@@ -1,17 +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: RelationalChoice.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
-
-(* This file axiomatizes the relational form of the axiom of choice *)
-
-Axiom relational_choice :
- (A:Type;B:Type;R: A->B->Prop) 
-  ((x:A)(EX y:B|(R x y)))
-   -> (EXT R':A->B->Prop | 
-         ((x:A)(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
diff --git a/theories7/NArith/BinNat.v b/theories7/NArith/BinNat.v
deleted file mode 100644
index 5e04e22e..00000000
--- a/theories7/NArith/BinNat.v
+++ /dev/null
@@ -1,205 +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: BinNat.v,v 1.1.2.1 2004/07/16 19:31:30 herbelin Exp $ i*)
-
-Require BinPos.
-
-(**********************************************************************)
-(** Binary natural numbers *)
-
-Inductive entier: Set := Nul : entier | Pos : positive -> entier.
-
-(** Declare binding key for scope positive_scope *)
-
-Delimits Scope N_scope with N.
-
-(** Automatically open scope N_scope for the constructors of N *)
-
-Bind Scope N_scope with entier.
-Arguments Scope Pos [ N_scope ].
-
-Open Local Scope N_scope.
-
-(** Operation x -> 2*x+1 *)
-
-Definition Un_suivi_de := [x]
-  Cases x of Nul => (Pos xH) | (Pos p) => (Pos (xI p)) end.
-
-(** Operation x -> 2*x *)
-
-Definition Zero_suivi_de :=
-  [n] Cases n of Nul => Nul | (Pos p) => (Pos (xO p)) end.
-
-(** Successor *)
-
-Definition Nsucc :=
-  [n] Cases n of Nul => (Pos xH) | (Pos p) => (Pos (add_un p)) end.
-
-(** Addition *)
-
-Definition Nplus := [n,m]
-  Cases n m of
-  | Nul     _       => m
-  | _       Nul     => n
-  | (Pos p) (Pos q) => (Pos (add p q))
-  end.
-
-V8Infix "+" Nplus : N_scope.
-
-(** Multiplication *)
-
-Definition Nmult := [n,m]
-  Cases n m of
-  | Nul     _       => Nul
-  | _       Nul     => Nul
-  | (Pos p) (Pos q) => (Pos (times p q))
-  end.
-
-V8Infix "*" Nmult : N_scope.
-
-(** Order *)
-
-Definition Ncompare := [n,m]
-  Cases n m of
-  | Nul      Nul      => EGAL
-  | Nul      (Pos m') => INFERIEUR
-  | (Pos n') Nul      => SUPERIEUR
-  | (Pos n') (Pos m') => (compare n' m' EGAL)
-  end.
-
-V8Infix "?=" Ncompare (at level 70, no associativity) : N_scope.
-
-(** Peano induction on binary natural numbers *)
-
-Theorem Nind : (P:(entier ->Prop))
-  (P Nul) ->((n:entier)(P n) ->(P (Nsucc n))) ->(n:entier)(P n).
-Proof.
-NewDestruct n.
-  Assumption.
-  Apply Pind with P := [p](P (Pos p)).
-Exact (H0 Nul H).
-Intro p'; Exact (H0 (Pos p')).
-Qed.
-
-(** Properties of addition *)
-
-Theorem Nplus_0_l : (n:entier)(Nplus Nul n)=n.
-Proof.
-Reflexivity.
-Qed.
-
-Theorem Nplus_0_r : (n:entier)(Nplus n Nul)=n.
-Proof.
-NewDestruct n; Reflexivity.
-Qed.
-
-Theorem Nplus_comm : (n,m:entier)(Nplus n m)=(Nplus m n).
-Proof.
-Intros.
-NewDestruct n; NewDestruct m; Simpl; Try Reflexivity.
-Rewrite add_sym; Reflexivity.
-Qed.
-
-Theorem Nplus_assoc : 
-  (n,m,p:entier)(Nplus n (Nplus m p))=(Nplus (Nplus n m) p).
-Proof.
-Intros.
-NewDestruct n; Try Reflexivity.
-NewDestruct m; Try Reflexivity.
-NewDestruct p; Try Reflexivity.
-Simpl; Rewrite add_assoc; Reflexivity.
-Qed.
-
-Theorem Nplus_succ : (n,m:entier)(Nplus (Nsucc n) m)=(Nsucc (Nplus n m)).
-Proof.
-NewDestruct n; NewDestruct m.
-  Simpl; Reflexivity.
-  Unfold Nsucc Nplus; Rewrite <- ZL12bis; Reflexivity.
-  Simpl; Reflexivity.
-  Simpl; Rewrite ZL14bis; Reflexivity.
-Qed.
-
-Theorem Nsucc_inj : (n,m:entier)(Nsucc n)=(Nsucc m)->n=m.
-Proof.
-NewDestruct n; NewDestruct m; Simpl; Intro H; 
-  Reflexivity Orelse Injection H; Clear H; Intro H.
-  Symmetry in H; Contradiction add_un_not_un with p.
-  Contradiction add_un_not_un with p.
-  Rewrite add_un_inj with 1:=H; Reflexivity.
-Qed.
-
-Theorem Nplus_reg_l : (n,m,p:entier)(Nplus n m)=(Nplus n p)->m=p.
-Proof.
-Intro n; Pattern n; Apply Nind; Clear n; Simpl.
-  Trivial.
-  Intros n IHn m p H0; Do 2 Rewrite Nplus_succ in H0.
-  Apply IHn; Apply Nsucc_inj; Assumption.
-Qed.
-
-(** Properties of multiplication *)
-
-Theorem Nmult_1_l : (n:entier)(Nmult (Pos xH) n)=n.
-Proof.
-NewDestruct n; Reflexivity.
-Qed.
-
-Theorem Nmult_1_r : (n:entier)(Nmult n (Pos xH))=n.
-Proof.
-NewDestruct n; Simpl; Try Reflexivity.
-Rewrite times_x_1; Reflexivity.
-Qed.
-
-Theorem Nmult_comm : (n,m:entier)(Nmult n m)=(Nmult m n).
-Proof.
-Intros.
-NewDestruct n; NewDestruct m; Simpl; Try Reflexivity.
-Rewrite times_sym; Reflexivity.
-Qed.
-
-Theorem Nmult_assoc : 
-  (n,m,p:entier)(Nmult n (Nmult m p))=(Nmult (Nmult n m) p).
-Proof.
-Intros.
-NewDestruct n; Try Reflexivity.
-NewDestruct m; Try Reflexivity.
-NewDestruct p; Try Reflexivity.
-Simpl; Rewrite times_assoc; Reflexivity.
-Qed.
-
-Theorem Nmult_plus_distr_r :
-  (n,m,p:entier)(Nmult (Nplus n m) p)=(Nplus (Nmult n p) (Nmult m p)).
-Proof.
-Intros.
-NewDestruct n; Try Reflexivity.
-NewDestruct m; NewDestruct p; Try Reflexivity.
-Simpl; Rewrite times_add_distr_l; Reflexivity.
-Qed.
-
-Theorem Nmult_reg_r : (n,m,p:entier) ~p=Nul->(Nmult n p)=(Nmult m p) -> n=m.
-Proof.
-NewDestruct p; Intros Hp H.
-Contradiction Hp; Reflexivity.
-NewDestruct n; NewDestruct m; Reflexivity Orelse Try Discriminate H.
-Injection H; Clear H; Intro H; Rewrite simpl_times_r with 1:=H; Reflexivity.
-Qed. 
-
-Theorem Nmult_0_l : (n:entier) (Nmult Nul n) = Nul.
-Proof.
-Reflexivity.
-Qed.
-
-(** Properties of comparison *)
-
-Theorem Ncompare_Eq_eq : (n,m:entier) (Ncompare n m) = EGAL -> n = m.
-Proof.
-NewDestruct n as [|n]; NewDestruct m as [|m]; Simpl; Intro H;
-  Reflexivity Orelse Try Discriminate H.
-  Rewrite (compare_convert_EGAL n m H); Reflexivity.
-Qed.
-
diff --git a/theories7/NArith/BinPos.v b/theories7/NArith/BinPos.v
deleted file mode 100644
index ae61587d..00000000
--- a/theories7/NArith/BinPos.v
+++ /dev/null
@@ -1,894 +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: BinPos.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
-
-(**********************************************************************)
-(** Binary positive numbers *)
-
-(** Original development by Pierre Crégut, CNET, Lannion, France *)
-
-Inductive positive : Set :=
-  xI : positive -> positive
-| xO : positive -> positive
-| xH : positive.
-
-(** Declare binding key for scope positive_scope *)
-
-Delimits Scope positive_scope with positive.
-
-(** Automatically open scope positive_scope for type positive, xO and xI *)
-
-Bind Scope positive_scope with positive.
-Arguments Scope xO [ positive_scope ].
-Arguments Scope xI [ positive_scope ].
-
-(** Successor *)
-
-Fixpoint add_un [x:positive]:positive :=
-  Cases x of
-    (xI x') => (xO (add_un x'))
-  | (xO x') => (xI x')
-  | xH => (xO xH)
-  end.
-
-(** Addition *)
-
-Fixpoint add [x:positive]:positive -> positive := [y:positive]
-  Cases x y of
-  | (xI x') (xI y') => (xO (add_carry x' y'))
-  | (xI x') (xO y') => (xI (add x' y'))
-  | (xI x') xH      => (xO (add_un x'))
-  | (xO x') (xI y') => (xI (add x' y'))
-  | (xO x') (xO y') => (xO (add x' y'))
-  | (xO x') xH      => (xI x')
-  | xH      (xI y') => (xO (add_un y'))
-  | xH      (xO y') => (xI y')
-  | xH      xH      => (xO xH)
-  end
-with add_carry [x:positive]:positive -> positive := [y:positive]
-  Cases x y of
-  | (xI x') (xI y') => (xI (add_carry x' y'))
-  | (xI x') (xO y') => (xO (add_carry x' y'))
-  | (xI x') xH      => (xI (add_un x'))
-  | (xO x') (xI y') => (xO (add_carry x' y'))
-  | (xO x') (xO y') => (xI (add x' y'))
-  | (xO x') xH      => (xO (add_un x'))
-  | xH      (xI y') => (xI (add_un y'))
-  | xH      (xO y') => (xO (add_un y'))
-  | xH      xH      => (xI xH)
-  end.
-
-V7only [Notation "x + y" := (add x y) : positive_scope.].
-V8Infix "+" add : positive_scope.
-
-Open Local Scope positive_scope.
-
-(** From binary positive numbers to Peano natural numbers *)
-
-Fixpoint positive_to_nat [x:positive]:nat -> nat :=
-  [pow2:nat]
-   Cases x of
-     (xI x') => (plus pow2 (positive_to_nat x' (plus pow2 pow2)))
-   | (xO x') => (positive_to_nat x' (plus pow2 pow2))
-   | xH      => pow2
-   end.
-
-Definition convert := [x:positive] (positive_to_nat x (S O)).
-
-(** From Peano natural numbers to binary positive numbers *)
-
-Fixpoint anti_convert [n:nat]: positive :=
-   Cases n of
-                O => xH
-             | (S x') => (add_un (anti_convert x'))
-             end.
-
-(** Operation x -> 2*x-1 *)
-
-Fixpoint double_moins_un [x:positive]:positive :=
-  Cases x of
-      (xI x') => (xI (xO x'))
-    | (xO x') => (xI (double_moins_un x'))
-    | xH => xH
-    end.
-
-(** Predecessor *)
-
-Definition sub_un := [x:positive]
-   Cases x of
-             (xI x') => (xO x')
-           | (xO x') => (double_moins_un x')
-           | xH => xH
-           end.
-
-(** An auxiliary type for subtraction *)
-
-Inductive positive_mask: Set :=
-   IsNul : positive_mask
- | IsPos : positive -> positive_mask
- | IsNeg : positive_mask.
-
-(** Operation x -> 2*x+1 *)
-
-Definition Un_suivi_de_mask := [x:positive_mask]
-  Cases x of IsNul => (IsPos xH) | IsNeg => IsNeg | (IsPos p) => (IsPos (xI p)) end.
-
-(** Operation x -> 2*x *)
-
-Definition Zero_suivi_de_mask := [x:positive_mask]
-  Cases x of IsNul => IsNul | IsNeg => IsNeg | (IsPos p) => (IsPos (xO p)) end.
-
-(** Operation x -> 2*x-2 *)
-
-Definition double_moins_deux :=
-  [x:positive] Cases x of
-           (xI x') => (IsPos (xO (xO x')))
-         | (xO x') => (IsPos (xO (double_moins_un x')))
-         | xH => IsNul
-         end.
-
-(** Subtraction of binary positive numbers into a positive numbers mask *)
-
-Fixpoint sub_pos[x,y:positive]:positive_mask :=
-  Cases x y of
-  | (xI x') (xI y') => (Zero_suivi_de_mask (sub_pos x' y'))
-  | (xI x') (xO y') => (Un_suivi_de_mask (sub_pos x' y'))
-  | (xI x') xH      => (IsPos (xO x'))
-  | (xO x') (xI y') => (Un_suivi_de_mask (sub_neg x' y'))
-  | (xO x') (xO y') => (Zero_suivi_de_mask (sub_pos x' y'))
-  | (xO x') xH      => (IsPos (double_moins_un x'))
-  | xH      xH      => IsNul
-  | xH      _       => IsNeg
-  end
-with sub_neg [x,y:positive]:positive_mask :=
-  Cases x y of
-    (xI x') (xI y') => (Un_suivi_de_mask (sub_neg x' y'))
-  | (xI x') (xO y') => (Zero_suivi_de_mask (sub_pos x' y'))
-  | (xI x') xH      => (IsPos (double_moins_un x'))
-  | (xO x') (xI y') => (Zero_suivi_de_mask (sub_neg x' y'))
-  | (xO x') (xO y') => (Un_suivi_de_mask (sub_neg x' y'))
-  | (xO x') xH      => (double_moins_deux x')
-  | xH      _       => IsNeg
-  end.
-
-(** Subtraction of binary positive numbers x and y, returns 1 if x<=y *)
-
-Definition true_sub := [x,y:positive] 
-  Cases (sub_pos x y) of (IsPos z) => z | _ => xH  end.
-
-V8Infix "-" true_sub : positive_scope.
-
-(** Multiplication on binary positive numbers *)
-
-Fixpoint times [x:positive] : positive -> positive:=
-  [y:positive]
-  Cases x of
-    (xI x') => (add y (xO (times x' y)))
-  | (xO x') => (xO (times x' y))
-  | xH => y
-  end.
-
-V8Infix "*" times : positive_scope.
-
-(** Division by 2 rounded below but for 1 *)
-
-Definition Zdiv2_pos :=
-  [z:positive]Cases z of xH => xH
-                       | (xO p) => p
-		       | (xI p) => p
-		      end.
-
-V8Infix "/" Zdiv2_pos : positive_scope.
-
-(** Comparison on binary positive numbers *)
-
-Fixpoint compare [x,y:positive]: relation -> relation :=
-  [r:relation] 
-  Cases x y of
-  | (xI x') (xI y') => (compare x' y' r)
-  | (xI x') (xO y') => (compare x' y' SUPERIEUR)
-  | (xI x')  xH     => SUPERIEUR
-  | (xO x') (xI y') => (compare x' y' INFERIEUR)
-  | (xO x') (xO y') => (compare x' y' r)
-  | (xO x')  xH     => SUPERIEUR
-  | xH      (xI y') => INFERIEUR
-  | xH      (xO y') => INFERIEUR
-  | xH       xH     => r
-  end.
-
-V8Infix "?=" compare (at level 70, no associativity) : positive_scope.
-
-(**********************************************************************)
-(** Miscellaneous properties of binary positive numbers *)
-
-Lemma ZL11: (x:positive) (x=xH) \/ ~(x=xH).
-Proof.
-Intros x;Case x;Intros; (Left;Reflexivity) Orelse (Right;Discriminate).
-Qed.
-
-(**********************************************************************)
-(** Properties of successor on binary positive numbers *)
-
-(** Specification of [xI] in term of [Psucc] and [xO] *)
-
-Lemma xI_add_un_xO : (x:positive)(xI x) = (add_un (xO x)).
-Proof.
-Reflexivity.
-Qed.
-
-Lemma add_un_discr : (x:positive)x<>(add_un x).
-Proof.
-Intro x; NewDestruct x; Discriminate.
-Qed.
-
-(** Successor and double *)
-
-Lemma is_double_moins_un : (x:positive) (add_un (double_moins_un x)) = (xO x).
-Proof.
-Intro x; NewInduction x as [x IHx|x|]; Simpl; Try Rewrite IHx; Reflexivity.
-Qed.
-
-Lemma double_moins_un_add_un_xI : 
- (x:positive)(double_moins_un (add_un x))=(xI x).
-Proof.
-Intro x;NewInduction x as [x IHx|x|]; Simpl; Try Rewrite IHx; Reflexivity.
-Qed.
-
-Lemma ZL1: (y:positive)(xO (add_un y)) = (add_un (add_un (xO y))).
-Proof.
-Intro y; Induction y; Simpl; Auto.
-Qed.
-
-Lemma double_moins_un_xO_discr : (x:positive)(double_moins_un x)<>(xO x).
-Proof.
-Intro x; NewDestruct x; Discriminate.
-Qed.
-
-(** Successor and predecessor *)
-
-Lemma add_un_not_un : (x:positive) (add_un x) <> xH.
-Proof.
-Intro x; NewDestruct x as [x|x|]; Discriminate.
-Qed.
-
-Lemma sub_add_one : (x:positive) (sub_un (add_un x)) = x.
-Proof.
-(Intro x; NewDestruct x as [p|p|]; [Idtac | Idtac | Simpl;Auto]);
-(NewInduction p as [p IHp||]; [Idtac | Reflexivity | Reflexivity ]);
-Simpl; Simpl in IHp; Try Rewrite <- IHp; Reflexivity.
-Qed.
-
-Lemma add_sub_one : (x:positive) (x=xH) \/ (add_un (sub_un x)) = x.
-Proof.
-Intro x; Induction x; [
-  Simpl; Auto
-| Simpl; Intros;Right;Apply is_double_moins_un
-| Auto ].
-Qed.
-
-(** Injectivity of successor *)
-
-Lemma add_un_inj : (x,y:positive) (add_un x)=(add_un y) -> x=y.
-Proof.
-Intro x;NewInduction x; Intro y; NewDestruct y as [y|y|]; Simpl; 
-  Intro H; Discriminate H Orelse Try (Injection H; Clear H; Intro H).
-Rewrite (IHx y H); Reflexivity.
-Absurd (add_un x)=xH; [ Apply add_un_not_un | Assumption ].
-Apply f_equal with 1:=H; Assumption.
-Absurd (add_un y)=xH; [ Apply add_un_not_un | Symmetry; Assumption ].
-Reflexivity.
-Qed.
-
-(**********************************************************************)
-(** Properties of addition on binary positive numbers *)
-
-(** Specification of [Psucc] in term of [Pplus] *)
-
-Lemma ZL12: (q:positive) (add_un q) = (add q xH).
-Proof.
-Intro q; NewDestruct q; Reflexivity.
-Qed.
-
-Lemma ZL12bis: (q:positive) (add_un q) = (add xH q).
-Proof.
-Intro q; NewDestruct q; Reflexivity.
-Qed.
-
-(** Specification of [Pplus_carry] *)
-
-Theorem ZL13: (x,y:positive)(add_carry x y) = (add_un (add x y)).
-Proof.
-(Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto);
-  Rewrite IHp; Auto.
-Qed.
-
-(** Commutativity *)
-
-Theorem add_sym : (x,y:positive) (add x y) = (add y x).
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto;
-  Try Do 2 Rewrite ZL13; Rewrite IHp;Auto.
-Qed. 
-
-(** Permutation of [Pplus] and [Psucc] *)
-
-Theorem ZL14: (x,y:positive)(add x (add_un y)) = (add_un (add x y)).
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto; [
-  Rewrite ZL13; Rewrite IHp; Auto
-| Rewrite ZL13; Auto
-| NewDestruct p;Simpl;Auto
-| Rewrite IHp;Auto
-| NewDestruct p;Simpl;Auto ].
-Qed.
-
-Theorem ZL14bis: (x,y:positive)(add (add_un x) y) = (add_un (add x y)).
-Proof.
-Intros x y; Rewrite add_sym; Rewrite add_sym with x:=x; Apply ZL14.
-Qed.
-
-Theorem ZL15: (q,z:positive) ~z=xH -> (add_carry q (sub_un z)) = (add q z).
-Proof.
-Intros q z H; Elim (add_sub_one z); [
-  Intro;Absurd z=xH;Auto
-| Intros E;Pattern 2 z ;Rewrite <- E; Rewrite ZL14; Rewrite ZL13; Trivial ].
-Qed. 
-
-(** No neutral for addition on strictly positive numbers *)
-
-Lemma add_no_neutral : (x,y:positive) ~(add y x)=x.
-Proof.
-Intro x;NewInduction x; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H;
-  Discriminate H Orelse Injection H; Clear H; Intro H; Apply (IHx y H).
-Qed.
-
-Lemma add_carry_not_add_un : (x,y:positive) ~(add_carry y x)=(add_un x).
-Proof.
-Intros x y H; Absurd (add y x)=x; 
-      [ Apply add_no_neutral
-      | Apply add_un_inj; Rewrite <- ZL13; Assumption ].
-Qed.
-
-(** Simplification *)
-
-Lemma add_carry_add :
-  (x,y,z,t:positive) (add_carry x z)=(add_carry y t) -> (add x z)=(add y t).
-Proof.
-Intros x y z t H; Apply add_un_inj; Do 2 Rewrite <- ZL13; Assumption.
-Qed.
-
-Lemma simpl_add_r : (x,y,z:positive) (add x z)=(add y z) -> x=y.
-Proof.
-Intros x y z; Generalize x y; Clear x y.
-NewInduction z as [z|z|].
-  NewDestruct x as [x|x|]; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H; 
-  Discriminate H Orelse Try (Injection H; Clear H; Intro H).
-    Rewrite IHz with 1:=(add_carry_add ? ? ? ? H); Reflexivity.
-    Absurd (add_carry x z)=(add_un z);
-      [ Apply add_carry_not_add_un | Assumption ].
-    Rewrite IHz with 1:=H; Reflexivity.
-    Symmetry in H; Absurd (add_carry y z)=(add_un z);
-      [ Apply add_carry_not_add_un | Assumption ].
-    Reflexivity.
-  NewDestruct x as [x|x|]; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H; 
-  Discriminate H Orelse Try (Injection H; Clear H; Intro H).
-    Rewrite IHz with 1:=H; Reflexivity.
-    Absurd (add x z)=z; [ Apply add_no_neutral | Assumption ].
-    Rewrite IHz with 1:=H; Reflexivity.
-    Symmetry in H; Absurd y+z=z; [ Apply add_no_neutral | Assumption ].
-    Reflexivity.
-  Intros H x y; Apply add_un_inj; Do 2 Rewrite ZL12; Assumption.
-Qed.
-
-Lemma simpl_add_l : (x,y,z:positive) (add x y)=(add x z) -> y=z.
-Proof.
-Intros x y z H;Apply simpl_add_r with z:=x; 
-  Rewrite add_sym with x:=z; Rewrite add_sym with x:=y; Assumption.
-Qed.
-
-Lemma simpl_add_carry_r :
- (x,y,z:positive) (add_carry x z)=(add_carry y z) -> x=y.
-Proof.
-Intros x y z H; Apply simpl_add_r with z:=z; Apply add_carry_add; Assumption.
-Qed.
-
-Lemma simpl_add_carry_l :
-  (x,y,z:positive) (add_carry x y)=(add_carry x z) -> y=z.
-Proof.
-Intros x y z H;Apply simpl_add_r with z:=x; 
-Rewrite add_sym with x:=z; Rewrite add_sym with x:=y; Apply add_carry_add; 
-Assumption.
-Qed.
-
-(** Addition on positive is associative *)
-
-Theorem add_assoc: (x,y,z:positive)(add x (add y z)) = (add (add x y) z).
-Proof.
-Intros x y; Generalize x; Clear x.
-NewInduction y as [y|y|]; Intro x.
-  NewDestruct x as [x|x|]; 
-    Intro z; NewDestruct z as [z|z|]; Simpl; Repeat Rewrite ZL13;
-    Repeat Rewrite ZL14; Repeat Rewrite ZL14bis; Reflexivity Orelse
-    Repeat Apply f_equal with A:=positive; Apply IHy.
-  NewDestruct x as [x|x|]; 
-    Intro z; NewDestruct z as [z|z|]; Simpl; Repeat Rewrite ZL13;
-    Repeat Rewrite ZL14; Repeat Rewrite ZL14bis; Reflexivity Orelse
-    Repeat Apply f_equal with A:=positive; Apply IHy.
-  Intro z; Rewrite add_sym with x:=xH; Do 2 Rewrite <- ZL12; Rewrite ZL14bis; Rewrite ZL14; Reflexivity.
-Qed.
-
-(** Commutation of addition with the double of a positive number *)
-
-Lemma add_xI_double_moins_un :
-  (p,q:positive)(xO (add p q)) = (add (xI p) (double_moins_un q)).
-Proof.
-Intros; Change (xI p) with (add (xO p) xH).
-Rewrite <- add_assoc; Rewrite <- ZL12bis; Rewrite is_double_moins_un.
-Reflexivity.
-Qed.
-
-Lemma add_xO_double_moins_un :
- (p,q:positive) (double_moins_un (add p q)) = (add (xO p) (double_moins_un q)).
-Proof.
-NewInduction p as [p IHp|p IHp|]; NewDestruct q as [q|q|];
- Simpl; Try Rewrite ZL13; Try Rewrite double_moins_un_add_un_xI;
- Try Rewrite IHp; Try Rewrite add_xI_double_moins_un; Try Reflexivity.
- Rewrite <- is_double_moins_un; Rewrite ZL12bis; Reflexivity. 
-Qed.
-
-(** Misc *)
-
-Lemma add_x_x : (x:positive) (add x x) = (xO x).
-Proof.
-Intro x;NewInduction x; Simpl; Try Rewrite ZL13; Try Rewrite IHx; Reflexivity.
-Qed.
-
-(**********************************************************************)
-(** Peano induction on binary positive positive numbers *)
-
-Fixpoint plus_iter [x:positive] : positive -> positive := 
-  [y]Cases x of 
-  | xH => (add_un y)
-  | (xO x) => (plus_iter x (plus_iter x y))
-  | (xI x) => (plus_iter x (plus_iter x (add_un y)))
-  end.
-
-Lemma plus_iter_add : (x,y:positive)(plus_iter x y)=(add x y).
-Proof.
-Intro x;NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y; Simpl;
-  Reflexivity Orelse Do 2 Rewrite IHp; Rewrite add_assoc; Rewrite add_x_x;
-  Try Reflexivity.
-Rewrite ZL13; Rewrite <- ZL14; Reflexivity.
-Rewrite ZL12; Reflexivity.
-Qed.
-
-Lemma plus_iter_xO : (x:positive)(plus_iter x x)=(xO x).
-Proof.
-Intro; Rewrite <- add_x_x; Apply plus_iter_add.
-Qed.
-
-Lemma plus_iter_xI : (x:positive)(add_un (plus_iter x x))=(xI x).
-Proof.
-Intro; Rewrite xI_add_un_xO; Rewrite <- add_x_x; 
-  Apply (f_equal positive); Apply plus_iter_add.
-Qed.
-
-Lemma iterate_add : (P:(positive->Type))
-  ((n:positive)(P n) ->(P (add_un n)))->(p,n:positive)(P n) ->
-  (P (plus_iter p n)).
-Proof.
-Intros P H; NewInduction p; Simpl; Intros.
-Apply IHp; Apply IHp; Apply H; Assumption.
-Apply IHp; Apply IHp; Assumption.
-Apply H; Assumption.
-Defined.
-
-(** Peano induction *)
-
-Theorem Pind : (P:(positive->Prop))
-  (P xH) ->((n:positive)(P n) ->(P (add_un n))) ->(n:positive)(P n).
-Proof.
-Intros P H1 Hsucc n; NewInduction n.
-Rewrite <- plus_iter_xI; Apply Hsucc; Apply iterate_add; Assumption.
-Rewrite <- plus_iter_xO; Apply iterate_add; Assumption.
-Assumption.
-Qed.
-
-(** Peano recursion *)
-
-Definition Prec : (A:Set)A->(positive->A->A)->positive->A :=
-  [A;a;f]Fix Prec { Prec [p:positive] : A :=
-  Cases p of
-  | xH => a
-  | (xO p) => (iterate_add [_]A f p p (Prec p))
-  | (xI p) => (f (plus_iter p p) (iterate_add [_]A f p p (Prec p)))
-  end}.
-
-(** Peano case analysis *)
-
-Theorem Pcase : (P:(positive->Prop))
-  (P xH) ->((n:positive)(P (add_un n))) ->(n:positive)(P n).
-Proof.
-Intros; Apply Pind; Auto.
-Qed.
-
-Check
- let fact = (Prec positive xH [p;r](times (add_un p) r)) in
- let seven = (xI (xI xH)) in
- let five_thousand_forty= (xO(xO(xO(xO(xI(xI(xO(xI(xI(xI(xO(xO xH))))))))))))
- in ((refl_equal ? ?) :: (fact seven) = five_thousand_forty).
-
-(**********************************************************************)
-(** Properties of multiplication on binary positive numbers *)
-
-(** One is right neutral for multiplication *)
-
-Lemma times_x_1 : (x:positive) (times x xH) = x.
-Proof.
-Intro x;NewInduction x; Simpl.
-  Rewrite IHx; Reflexivity.
-  Rewrite IHx; Reflexivity.
-  Reflexivity.
-Qed.
-
-(** Right reduction properties for multiplication *)
-
-Lemma times_x_double : (x,y:positive) (times x (xO y)) = (xO (times x y)).
-Proof.
-Intros x y; NewInduction x; Simpl.
-  Rewrite IHx; Reflexivity.
-  Rewrite IHx; Reflexivity.
-  Reflexivity.
-Qed.
-
-Lemma times_x_double_plus_one :
- (x,y:positive) (times x (xI y)) = (add x (xO (times x y))).
-Proof.
-Intros x y; NewInduction x; Simpl.
-  Rewrite IHx; Do 2 Rewrite add_assoc; Rewrite add_sym with x:=y; Reflexivity.
-  Rewrite IHx; Reflexivity.
-  Reflexivity.
-Qed.
-
-(** Commutativity of multiplication *)
-
-Theorem times_sym : (x,y:positive) (times x y) = (times y x).
-Proof.
-Intros x y; NewInduction y; Simpl.
-  Rewrite <- IHy; Apply times_x_double_plus_one.
-  Rewrite <- IHy; Apply times_x_double.
-  Apply times_x_1.
-Qed.
-
-(** Distributivity of multiplication over addition *)
-
-Theorem times_add_distr:
-  (x,y,z:positive) (times x (add y z)) = (add (times x y) (times x z)).
-Proof.
-Intros x y z; NewInduction x; Simpl.
-  Rewrite IHx; Rewrite <- add_assoc with y := (xO (times x y));
-    Rewrite -> add_assoc with x := (xO (times x y));
-    Rewrite -> add_sym with x := (xO (times x y));
-    Rewrite <- add_assoc with y := (xO (times x y));
-    Rewrite -> add_assoc with y := z; Reflexivity.
-  Rewrite IHx; Reflexivity.
-  Reflexivity.
-Qed.
-
-Theorem times_add_distr_l:
-  (x,y,z:positive) (times (add x y) z) = (add (times x z) (times y z)).
-Proof.
-Intros x y z; Do 3 Rewrite times_sym with y:=z; Apply times_add_distr.
-Qed.
-
-(** Associativity of multiplication *)
-
-Theorem times_assoc :
-  ((x,y,z:positive) (times x (times y z))= (times (times x y) z)).
-Proof.
-Intro x;NewInduction x as [x|x|]; Simpl; Intros y z.
-  Rewrite IHx; Rewrite times_add_distr_l; Reflexivity.
-  Rewrite IHx; Reflexivity.
-  Reflexivity.
-Qed.
-
-(** Parity properties of multiplication *)
-
-Lemma times_discr_xO_xI : 
-  (x,y,z:positive)(times (xI x) z)<>(times (xO y) z).
-Proof.
-Intros x y z; NewInduction z as [|z IHz|]; Try Discriminate.
-Intro H; Apply IHz; Clear IHz.
-Do 2 Rewrite times_x_double in H.
-Injection H; Clear H; Intro H; Exact H.
-Qed.
-
-Lemma times_discr_xO : (x,y:positive)(times (xO x) y)<>y.
-Proof.
-Intros x y; NewInduction y; Try Discriminate.
-Rewrite times_x_double; Injection; Assumption.
-Qed.
-
-(** Simplification properties of multiplication *)
-
-Theorem simpl_times_r : (x,y,z:positive) (times x z)=(times y z) -> x=y.
-Proof.
-Intro x;NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y as [q|q|]; Intros z H;
-    Reflexivity Orelse Apply (f_equal positive) Orelse Apply False_ind.
-  Simpl in H; Apply IHp with (xO z); Simpl; Do 2 Rewrite times_x_double;
-    Apply simpl_add_l with 1 := H.
-  Apply times_discr_xO_xI with 1 := H.
-  Simpl in H; Rewrite add_sym in H; Apply add_no_neutral with 1 := H.
-  Symmetry in H; Apply times_discr_xO_xI with 1 := H.
-  Apply IHp with (xO z); Simpl; Do 2 Rewrite times_x_double; Assumption.
-  Apply times_discr_xO with 1:=H.
-  Simpl in H; Symmetry in H; Rewrite add_sym in H; 
-    Apply add_no_neutral with 1 := H.
-  Symmetry in H; Apply times_discr_xO with 1:=H.
-Qed.
-
-Theorem simpl_times_l : (x,y,z:positive) (times z x)=(times z y) -> x=y.
-Proof.
-Intros x y z H; Apply simpl_times_r with z:=z.
-Rewrite times_sym with x:=x; Rewrite times_sym with x:=y; Assumption.
-Qed.
-
-(** Inversion of multiplication *)
-
-Lemma times_one_inversion_l : (x,y:positive) (times x y)=xH -> x=xH.
-Proof.
-Intros x y; NewDestruct x; Simpl.
- NewDestruct y; Intro; Discriminate.
- Intro; Discriminate.
- Reflexivity.
-Qed.
-
-(**********************************************************************)
-(** Properties of comparison on binary positive numbers *)
-
-Theorem compare_convert1 : 
- (x,y:positive) 
-  ~(compare x y SUPERIEUR) = EGAL /\ ~(compare x y INFERIEUR) = EGAL.
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y as [q|q|];
-  Split;Simpl;Auto;
-  Discriminate Orelse (Elim (IHp q); Auto).
-Qed.
-
-Theorem compare_convert_EGAL : (x,y:positive) (compare x y EGAL) = EGAL -> x=y.
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; 
-  Intro y; NewDestruct y as [q|q|];Simpl;Auto; Intro H; [
-  Rewrite (IHp q); Trivial
-| Absurd (compare p q SUPERIEUR)=EGAL ;
-   [ Elim (compare_convert1 p q);Auto | Assumption ]
-| Discriminate H
-| Absurd (compare p q INFERIEUR) = EGAL; 
-    [ Elim (compare_convert1 p q);Auto | Assumption ]
-| Rewrite (IHp q);Auto 
-| Discriminate H
-| Discriminate H
-| Discriminate H ].
-Qed.
-
-Lemma ZLSI:
- (x,y:positive) (compare x y SUPERIEUR) = INFERIEUR -> 
-                (compare x y EGAL) = INFERIEUR.
-Proof.
-Intro x; Induction x;Intro y; Induction y;Simpl;Auto; 
-  Discriminate Orelse Intros H;Discriminate H.
-Qed.
-
-Lemma ZLIS:
- (x,y:positive) (compare x y INFERIEUR) = SUPERIEUR -> 
-                (compare x y EGAL) = SUPERIEUR.
-Proof.
-Intro x; Induction x;Intro y; Induction y;Simpl;Auto; 
-  Discriminate Orelse Intros H;Discriminate H.
-Qed.
-
-Lemma ZLII:
- (x,y:positive) (compare x y INFERIEUR) = INFERIEUR ->
-                (compare x y EGAL) = INFERIEUR \/ x = y.
-Proof.
-(Intro x; NewInduction x as [p IHp|p IHp|];
- Intro y; NewDestruct y as [q|q|];Simpl;Auto;Try Discriminate);
- Intro H2; Elim (IHp q H2);Auto; Intros E;Rewrite E;
- Auto.
-Qed.
-
-Lemma ZLSS:
- (x,y:positive) (compare x y SUPERIEUR) = SUPERIEUR ->
-                (compare x y EGAL) = SUPERIEUR \/ x = y.
-Proof.
-(Intro x; NewInduction x as [p IHp|p IHp|];
- Intro y; NewDestruct y as [q|q|];Simpl;Auto;Try Discriminate);
- Intro H2; Elim (IHp q H2);Auto; Intros E;Rewrite E;
- Auto.
-Qed.
-
-Lemma Dcompare : (r:relation) r=EGAL \/ r = INFERIEUR \/ r = SUPERIEUR.
-Proof.
-Induction r; Auto. 
-Qed.
-
-Tactic Definition ElimPcompare c1 c2:=
-  Elim (Dcompare (compare c1 c2 EGAL)); [ Idtac | 
-     Let x = FreshId "H" In Intro x; Case x; Clear x ].
-
-Theorem convert_compare_EGAL: (x:positive)(compare x x EGAL)=EGAL.
-Intro x; Induction x; Auto.
-Qed.
-
-Lemma Pcompare_antisym :
-  (x,y:positive)(r:relation) (Op (compare x y r)) = (compare y x (Op r)).
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y; 
-Intro r; Reflexivity Orelse (Symmetry; Assumption) Orelse Discriminate H
-Orelse Simpl; Apply IHp Orelse Try Rewrite IHp; Try Reflexivity.
-Qed.
-
-Lemma ZC1:
-  (x,y:positive)(compare x y EGAL)=SUPERIEUR -> (compare y x EGAL)=INFERIEUR.
-Proof.
-Intros; Change EGAL with (Op EGAL).
-Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
-Qed.
-
-Lemma ZC2:
-  (x,y:positive)(compare x y EGAL)=INFERIEUR -> (compare y x EGAL)=SUPERIEUR.
-Proof.
-Intros; Change EGAL with (Op EGAL).
-Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
-Qed.
-
-Lemma ZC3: (x,y:positive)(compare x y EGAL)=EGAL -> (compare y x EGAL)=EGAL.
-Proof.
-Intros; Change EGAL with (Op EGAL).
-Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
-Qed.
-
-Lemma ZC4: (x,y:positive) (compare x y EGAL) = (Op (compare y x EGAL)).
-Proof.
-Intros; Change 1 EGAL with (Op EGAL).
-Symmetry; Apply Pcompare_antisym.
-Qed.
-
-(**********************************************************************)
-(** Properties of subtraction on binary positive numbers *)
-
-Lemma ZS: (p:positive_mask) (Zero_suivi_de_mask p) = IsNul -> p = IsNul.
-Proof.
-NewDestruct p; Simpl; [ Trivial | Discriminate 1 | Discriminate 1 ].
-Qed.
-
-Lemma US: (p:positive_mask) ~(Un_suivi_de_mask p)=IsNul.
-Proof.
-Induction p; Intros; Discriminate.
-Qed.
-
-Lemma USH: (p:positive_mask) (Un_suivi_de_mask p) = (IsPos xH) -> p = IsNul.
-Proof.
-NewDestruct p; Simpl; [ Trivial | Discriminate 1 | Discriminate 1 ].
-Qed.
-
-Lemma ZSH: (p:positive_mask) ~(Zero_suivi_de_mask p)= (IsPos xH).
-Proof.
-Induction p; Intros; Discriminate.
-Qed.
-
-Theorem sub_pos_x_x : (x:positive) (sub_pos x x) = IsNul.
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; [
-  Simpl; Rewrite IHp;Simpl; Trivial
-| Simpl; Rewrite IHp;Auto
-| Auto ].
-Qed.
-
-Lemma ZL10: (x,y:positive)
- (sub_pos x y) = (IsPos xH) -> (sub_neg x y) = IsNul.
-Proof.
-Intro x; NewInduction x as [p|p|]; Intro y; NewDestruct y as [q|q|]; Simpl; 
-  Intro H; Try Discriminate H; [
-  Absurd (Zero_suivi_de_mask (sub_pos p q))=(IsPos xH);
-   [ Apply ZSH | Assumption ]
-| Assert Heq : (sub_pos p q)=IsNul;
-   [ Apply USH;Assumption | Rewrite Heq; Reflexivity ]
-| Assert Heq : (sub_neg p q)=IsNul;
-   [ Apply USH;Assumption | Rewrite Heq; Reflexivity ]
-| Absurd (Zero_suivi_de_mask (sub_pos p q))=(IsPos xH); 
-   [ Apply ZSH | Assumption ]
-| NewDestruct p; Simpl; [ Discriminate H | Discriminate H | Reflexivity ] ].
-Qed.
-
-(** Properties of subtraction valid only for x>y *)
-
-Lemma sub_pos_SUPERIEUR:
-  (x,y:positive)(compare x y EGAL)=SUPERIEUR -> 
-    (EX h:positive | (sub_pos x y) = (IsPos h) /\ (add y h) = x /\
-                     (h = xH \/ (sub_neg x y) = (IsPos (sub_un h)))).
-Proof.
-Intro x;NewInduction x as [p|p|];Intro y; NewDestruct y as [q|q|]; Simpl; Intro H;
-  Try Discriminate H.
-  NewDestruct (IHp q H) as [z [H4 [H6 H7]]]; Exists (xO z); Split.
-    Rewrite H4; Reflexivity.
-    Split.
-      Simpl; Rewrite H6; Reflexivity.
-      Right; Clear H6; NewDestruct (ZL11 z) as [H8|H8]; [
-        Rewrite H8; Rewrite H8 in H4;
-        Rewrite ZL10; [ Reflexivity | Assumption ]
-      | Clear H4; NewDestruct H7 as [H9|H9]; [
-          Absurd z=xH; Assumption
-        | Rewrite H9; Clear H9; NewDestruct z; 
-            [ Reflexivity | Reflexivity | Absurd xH=xH; Trivial ]]].
-  Case ZLSS with 1:=H; [
-    Intros H3;Elim (IHp q H3); Intros z H4; Exists (xI z);
-    Elim H4;Intros H5 H6;Elim H6;Intros H7 H8; Split; [
-      Simpl;Rewrite H5;Auto
-    | Split; [
-        Simpl; Rewrite H7; Trivial
-      | Right;
-        Change (Zero_suivi_de_mask (sub_pos p q))=(IsPos (sub_un (xI z)));
-        Rewrite H5; Auto ]]
-  | Intros H3; Exists xH; Rewrite H3; Split; [
-      Simpl; Rewrite sub_pos_x_x; Auto
-    | Split; Auto ]].
-  Exists (xO p); Auto.
-  NewDestruct (IHp q) as [z [H4 [H6 H7]]].
-    Apply ZLIS; Assumption.
-    NewDestruct (ZL11 z) as [vZ|]; [
-      Exists xH; Split; [
-        Rewrite ZL10; [ Reflexivity | Rewrite vZ in H4;Assumption ]
-      | Split; [
-          Simpl; Rewrite ZL12; Rewrite <- vZ; Rewrite H6; Trivial
-        | Auto ]]
-    | Exists (xI (sub_un z)); NewDestruct H7 as [|H8];[
-        Absurd z=xH;Assumption
-      | Split; [
-          Rewrite H8; Trivial
-        | Split; [ Simpl; Rewrite ZL15; [
-              Rewrite H6;Trivial
-            | Assumption ]
-          | Right; Rewrite H8; Reflexivity]]]].
-  NewDestruct (IHp q H) as [z [H4 [H6 H7]]].
-  Exists (xO z); Split; [
-    Rewrite H4;Auto
-  | Split; [
-      Simpl;Rewrite H6;Reflexivity
-    | Right; 
-      Change (Un_suivi_de_mask (sub_neg p q))=(IsPos (double_moins_un z));
-      NewDestruct (ZL11 z) as [H8|H8]; [
-        Rewrite H8; Simpl;
-        Assert H9:(sub_neg p q)=IsNul;[
-          Apply ZL10;Rewrite <- H8;Assumption
-        | Rewrite H9;Reflexivity ]
-      | NewDestruct H7 as [H9|H9]; [
-          Absurd z=xH;Auto
-        | Rewrite H9; NewDestruct z; Simpl; 
-            [ Reflexivity
-            | Reflexivity
-            | Absurd xH=xH; [Assumption | Reflexivity]]]]]].
-  Exists (double_moins_un p); Split; [
-    Reflexivity
-  | Clear IHp; Split; [
-      NewDestruct p; Simpl; [
-        Reflexivity
-      | Rewrite is_double_moins_un; Reflexivity
-      | Reflexivity ]
-    | NewDestruct p; [Right|Right|Left]; Reflexivity ]].
-Qed.
-
-Theorem sub_add: 
-(x,y:positive) (compare x y EGAL) = SUPERIEUR -> (add y (true_sub x y)) = x.
-Proof.
-Intros x y H;Elim sub_pos_SUPERIEUR with 1:=H;
-Intros z H1;Elim H1;Intros H2 H3; Elim H3;Intros H4 H5; 
-Unfold true_sub ;Rewrite H2; Exact H4.
-Qed.
-
diff --git a/theories7/NArith/Pnat.v b/theories7/NArith/Pnat.v
deleted file mode 100644
index d62661ed..00000000
--- a/theories7/NArith/Pnat.v
+++ /dev/null
@@ -1,472 +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: Pnat.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
-
-Require BinPos.
-
-(**********************************************************************)
-(** Properties of the injection from binary positive numbers to Peano 
-    natural numbers *)
-
-(** Original development by Pierre Crégut, CNET, Lannion, France *)
-
-Require Le.
-Require Lt.
-Require Gt.
-Require Plus.
-Require Mult.
-Require Minus.
-
-(** [nat_of_P] is a morphism for addition *)
-
-Lemma convert_add_un :
-  (x:positive)(m:nat)
-    (positive_to_nat (add_un x) m) = (plus m (positive_to_nat x m)).
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|]; Simpl; Auto; Intro m; Rewrite IHp;
-Rewrite plus_assoc_l; Trivial.
-Qed.
-
-Lemma cvt_add_un :
-  (p:positive) (convert (add_un p)) = (S (convert p)).
-Proof.
-  Intro; Change (S (convert p)) with (plus (S O) (convert p));
-  Unfold convert; Apply convert_add_un.
-Qed.
-
-Theorem convert_add_carry :
-  (x,y:positive)(m:nat)
-    (positive_to_nat (add_carry x y) m) =
-    (plus m (positive_to_nat (add x y) m)).
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];
-  Intro y; NewDestruct y; Simpl; Auto with arith; Intro m; [
-  Rewrite IHp; Rewrite plus_assoc_l; Trivial with arith
-| Rewrite IHp; Rewrite plus_assoc_l; Trivial with arith
-| Rewrite convert_add_un; Rewrite plus_assoc_l; Trivial with arith
-| Rewrite convert_add_un; Apply plus_assoc_r ].
-Qed.
-
-Theorem cvt_carry :
-  (x,y:positive)(convert (add_carry x y)) = (S (convert (add x y))).
-Proof.
-Intros;Unfold convert; Rewrite convert_add_carry; Simpl; Trivial with arith.
-Qed.
-
-Theorem add_verif :
-  (x,y:positive)(m:nat)
-    (positive_to_nat (add x y) m) = 
-    (plus (positive_to_nat x m) (positive_to_nat y m)).
-Proof.
-Intro x; NewInduction x as [p IHp|p IHp|];
-  Intro y; NewDestruct y;Simpl;Auto with arith; [
-  Intros m;Rewrite convert_add_carry; Rewrite IHp; 
-  Rewrite plus_assoc_r; Rewrite plus_assoc_r; 
-  Rewrite (plus_permute m (positive_to_nat p (plus m m))); Trivial with arith
-| Intros m; Rewrite IHp; Apply plus_assoc_l
-| Intros m; Rewrite convert_add_un; 
-  Rewrite (plus_sym (plus m (positive_to_nat p (plus m m))));
-  Apply plus_assoc_r
-| Intros m; Rewrite IHp; Apply plus_permute
-| Intros m; Rewrite convert_add_un; Apply plus_assoc_r ].
-Qed.
-
-Theorem convert_add:
-  (x,y:positive) (convert (add x y)) = (plus (convert x) (convert y)).
-Proof.
-Intros x y; Exact (add_verif x y (S O)).
-Qed.
-
-(** [Pmult_nat] is a morphism for addition *)
-
-Lemma ZL2:
-  (y:positive)(m:nat)
-    (positive_to_nat y (plus m m)) =
-              (plus (positive_to_nat y m) (positive_to_nat y m)).
-Proof.
-Intro y; NewInduction y as [p H|p H|]; Intro m; [
-  Simpl; Rewrite H; Rewrite plus_assoc_r; 
-  Rewrite (plus_permute m (positive_to_nat p (plus m m)));
-  Rewrite plus_assoc_r; Auto with arith
-| Simpl; Rewrite H; Auto with arith
-| Simpl; Trivial with arith ].
-Qed.
-
-Lemma ZL6:
-  (p:positive) (positive_to_nat p (S (S O))) = (plus (convert p) (convert p)).
-Proof.
-Intro p;Change (2) with (plus (S O) (S O)); Rewrite ZL2; Trivial.
-Qed.
- 
-(** [nat_of_P] is a morphism for multiplication *)
-
-Theorem times_convert :
-  (x,y:positive) (convert (times x y)) = (mult (convert x) (convert y)).
-Proof.
-Intros x y; NewInduction x as [ x' H | x' H | ]; [
-  Change (times (xI x') y) with (add y (xO (times x' y))); Rewrite convert_add;
-  Unfold 2 3 convert; Simpl; Do 2 Rewrite ZL6; Rewrite H;
-  Rewrite -> mult_plus_distr; Reflexivity
-| Unfold 1 2 convert; Simpl; Do 2 Rewrite ZL6;
-  Rewrite H; Rewrite mult_plus_distr; Reflexivity
-| Simpl; Rewrite <- plus_n_O; Reflexivity ].
-Qed.
-V7only [
-  Comments "Compatibility with the old version of times and times_convert".
-  Syntactic Definition times1 :=
-    [x:positive;_:positive->positive;y:positive](times x y).
-  Syntactic Definition times1_convert :=
-    [x,y:positive;_:positive->positive](times_convert x y).
-].
-
-(** [nat_of_P] maps to the strictly positive subset of [nat] *)
-
-Lemma ZL4: (y:positive) (EX h:nat |(convert y)=(S h)).
-Proof.
-Intro y; NewInduction y as [p H|p H|]; [
-  NewDestruct H as [x H1]; Exists (plus (S x) (S x));
-  Unfold convert ;Simpl; Change (2) with (plus (1) (1)); Rewrite ZL2; Unfold convert in H1;
-  Rewrite H1; Auto with arith
-| NewDestruct H as [x H2]; Exists (plus x (S x)); Unfold convert;
-  Simpl; Change (2) with (plus (1) (1)); Rewrite ZL2;Unfold convert in H2; Rewrite H2; Auto with arith
-| Exists O ;Auto with arith ].
-Qed.
-
-(** Extra lemmas on [lt] on Peano natural numbers *)
-
-Lemma ZL7:
-  (m,n:nat) (lt m n) -> (lt (plus m m) (plus n n)).
-Proof.
-Intros m n H; Apply lt_trans with m:=(plus m n); [
-  Apply lt_reg_l with 1:=H
-| Rewrite (plus_sym m n); Apply lt_reg_l with 1:=H ].
-Qed.
-
-Lemma ZL8:
-  (m,n:nat) (lt m n) -> (lt (S (plus m m)) (plus n n)).
-Proof.
-Intros m n H; Apply le_lt_trans with m:=(plus m n); [
-  Change (lt (plus m m) (plus m n)) ; Apply lt_reg_l with 1:=H
-| Rewrite (plus_sym m n); Apply lt_reg_l with 1:=H ].
-Qed.
-
-(** [nat_of_P] is a morphism from [positive] to [nat] for [lt] (expressed
-    from [compare] on [positive])
-
-    Part 1: [lt] on [positive] is finer than [lt] on [nat]
-*)
-
-Lemma compare_convert_INFERIEUR : 
-  (x,y:positive) (compare x y EGAL) = INFERIEUR -> 
-    (lt (convert x) (convert y)).
-Proof.
-Intro x; NewInduction x as [p H|p H|];Intro y; NewDestruct y as [q|q|];
-  Intro H2; [
-  Unfold convert ;Simpl; Apply lt_n_S; 
-  Do 2 Rewrite ZL6; Apply ZL7; Apply H; Simpl in H2; Assumption
-| Unfold convert ;Simpl; Do 2 Rewrite ZL6; 
-  Apply ZL8; Apply H;Simpl in H2; Apply ZLSI;Assumption
-| Simpl; Discriminate H2
-| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
-  Elim (ZLII p q H2); [
-    Intros H3;Apply lt_S;Apply ZL7; Apply H;Apply H3
-  | Intros E;Rewrite E;Apply lt_n_Sn]
-| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
-  Apply ZL7;Apply H;Assumption
-| Simpl; Discriminate H2
-| Unfold convert ;Simpl; Apply lt_n_S; Rewrite ZL6;
-  Elim (ZL4 q);Intros h H3; Rewrite H3;Simpl; Apply lt_O_Sn
-| Unfold convert ;Simpl; Rewrite ZL6; Elim (ZL4 q);Intros h H3;
-  Rewrite H3; Simpl; Rewrite <- plus_n_Sm; Apply lt_n_S; Apply lt_O_Sn
-| Simpl; Discriminate H2 ].
-Qed.
-
-(** [nat_of_P] is a morphism from [positive] to [nat] for [gt] (expressed
-    from [compare] on [positive])
-
-    Part 1: [gt] on [positive] is finer than [gt] on [nat]
-*)
-
-Lemma compare_convert_SUPERIEUR : 
-  (x,y:positive) (compare x y EGAL)=SUPERIEUR -> (gt (convert x) (convert y)).
-Proof.
-Unfold gt; Intro x; NewInduction x as [p H|p H|];
-  Intro y; NewDestruct y as [q|q|]; Intro H2; [
-  Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
-  Apply lt_n_S; Apply ZL7; Apply H;Assumption
-| Simpl; Unfold convert ;Simpl; Do 2 Rewrite ZL6;
-  Elim (ZLSS p q H2); [
-    Intros H3;Apply lt_S;Apply ZL7;Apply H;Assumption
-  | Intros E;Rewrite E;Apply lt_n_Sn]
-| Unfold convert ;Simpl; Rewrite ZL6;Elim (ZL4 p);
-  Intros h H3;Rewrite H3;Simpl; Apply lt_n_S; Apply lt_O_Sn
-| Simpl;Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
-  Apply ZL8; Apply H; Apply ZLIS; Assumption
-| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
-  Apply ZL7;Apply H;Assumption
-| Unfold convert ;Simpl; Rewrite ZL6; Elim (ZL4 p);
-  Intros h H3;Rewrite H3;Simpl; Rewrite <- plus_n_Sm;Apply lt_n_S;
-  Apply lt_O_Sn
-| Simpl; Discriminate H2
-| Simpl; Discriminate H2
-| Simpl; Discriminate H2 ].
-Qed.
-
-(** [nat_of_P] is a morphism from [positive] to [nat] for [lt] (expressed
-    from [compare] on [positive])
-
-    Part 2: [lt] on [nat] is finer than [lt] on [positive]
-*)
-
-Lemma convert_compare_INFERIEUR : 
-  (x,y:positive)(lt (convert x) (convert y)) -> (compare x y EGAL) = INFERIEUR.
-Proof.
-Intros x y; Unfold gt; Elim (Dcompare (compare x y EGAL)); [
-  Intros E; Rewrite (compare_convert_EGAL x y E); 
-  Intros H;Absurd (lt (convert y) (convert y)); [ Apply lt_n_n | Assumption ]
-| Intros H;Elim H; [
-    Auto
-  | Intros H1 H2; Absurd (lt (convert x) (convert y)); [
-      Apply lt_not_sym; Change (gt (convert x) (convert y)); 
-      Apply compare_convert_SUPERIEUR; Assumption
-    | Assumption ]]].
-Qed.
-
-(** [nat_of_P] is a morphism from [positive] to [nat] for [gt] (expressed
-    from [compare] on [positive])
-
-    Part 2: [gt] on [nat] is finer than [gt] on [positive]
-*)
-
-Lemma convert_compare_SUPERIEUR : 
-  (x,y:positive)(gt (convert x) (convert y)) -> (compare x y EGAL) = SUPERIEUR.
-Proof.
-Intros x y; Unfold gt; Elim (Dcompare (compare x y EGAL)); [
-  Intros E; Rewrite (compare_convert_EGAL x y E); 
-  Intros H;Absurd (lt (convert y) (convert y)); [ Apply lt_n_n | Assumption ]
-| Intros H;Elim H; [
-    Intros H1 H2; Absurd (lt (convert y) (convert x)); [
-      Apply lt_not_sym; Apply compare_convert_INFERIEUR; Assumption
-    | Assumption ]
-  | Auto]].
-Qed.
-
-(** [nat_of_P] is strictly positive *)
-
-Lemma compare_positive_to_nat_O : 
-	(p:positive)(m:nat)(le m (positive_to_nat p m)).
-NewInduction p; Simpl; Auto with arith.
-Intro m; Apply le_trans with (plus m m);  Auto with arith.
-Qed.
-
-Lemma compare_convert_O : (p:positive)(lt O (convert p)).
-Intro; Unfold convert; Apply lt_le_trans with (S O); Auto with arith.
-Apply compare_positive_to_nat_O.
-Qed.
-
-(** Pmult_nat permutes with multiplication *)
-
-Lemma positive_to_nat_mult : (p:positive) (n,m:nat)
-    (positive_to_nat p (mult m n))=(mult m (positive_to_nat p n)).
-Proof.
-  Induction p. Intros. Simpl. Rewrite mult_plus_distr_r. Rewrite <- (mult_plus_distr_r m n n).
-  Rewrite (H (plus n n) m). Reflexivity.
-  Intros. Simpl. Rewrite <- (mult_plus_distr_r m n n). Apply H.
-  Trivial.
-Qed.
-
-Lemma positive_to_nat_2 : (p:positive)
-    (positive_to_nat p (2))=(mult (2) (positive_to_nat p (1))).
-Proof.
-  Intros. Rewrite <- positive_to_nat_mult. Reflexivity.
-Qed.
-
-Lemma positive_to_nat_4 : (p:positive)
-    (positive_to_nat p (4))=(mult (2) (positive_to_nat p (2))).
-Proof.
-  Intros. Rewrite <- positive_to_nat_mult. Reflexivity.
-Qed.
-
-(** Mapping of xH, xO and xI through [nat_of_P] *)
-
-Lemma convert_xH : (convert xH)=(1).
-Proof.
-  Reflexivity.
-Qed.
-
-Lemma convert_xO : (p:positive) (convert (xO p))=(mult (2) (convert p)).
-Proof.
-  Induction p. Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2.
-  Rewrite positive_to_nat_4. Rewrite H. Simpl. Rewrite <- plus_Snm_nSm. Reflexivity.
-  Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. Rewrite positive_to_nat_4.
-  Rewrite H. Reflexivity.
-  Reflexivity.
-Qed.
-
-Lemma convert_xI : (p:positive) (convert (xI p))=(S (mult (2) (convert p))).
-Proof.
-  Induction p. Unfold convert. Simpl. Intro p0. Intro. Rewrite positive_to_nat_2.
-  Rewrite positive_to_nat_4; Injection H; Intro H1; Rewrite H1; Rewrite <- plus_Snm_nSm; Reflexivity.
-  Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. Rewrite positive_to_nat_4.
-  Injection H; Intro H1; Rewrite H1; Reflexivity.
-  Reflexivity.
-Qed.
-
-(**********************************************************************)
-(** Properties of the shifted injection from Peano natural numbers to 
-    binary positive numbers *)
-
-(** Composition of [P_of_succ_nat] and [nat_of_P] is successor on [nat] *)
-
-Theorem bij1 : (m:nat) (convert (anti_convert m)) = (S m).
-Proof.
-Intro m; NewInduction m as [|n H]; [
-  Reflexivity
-| Simpl; Rewrite cvt_add_un; Rewrite H; Auto ].
-Qed.
-
-(** Miscellaneous lemmas on [P_of_succ_nat] *)
-
-Lemma ZL3: (x:nat) (add_un (anti_convert (plus x x))) =  (xO (anti_convert x)).
-Proof.
-Intro x; NewInduction x as [|n H]; [
-  Simpl; Auto with arith
-| Simpl; Rewrite  plus_sym; Simpl; Rewrite  H; Rewrite  ZL1;Auto with arith].
-Qed.
-
-Lemma ZL5: (x:nat) (anti_convert (plus (S x) (S x))) =  (xI (anti_convert x)).
-Proof.
-Intro x; NewInduction x as [|n H];Simpl; [
-  Auto with arith
-| Rewrite <- plus_n_Sm; Simpl; Simpl in H; Rewrite H; Auto with arith].
-Qed.
-
-(** Composition of [nat_of_P] and [P_of_succ_nat] is successor on [positive] *)
-
-Theorem bij2 : (x:positive) (anti_convert (convert x)) = (add_un x).
-Proof.
-Intro x; NewInduction x as [p H|p H|]; [
-  Simpl; Rewrite <- H; Change (2) with (plus (1) (1));
-  Rewrite ZL2; Elim (ZL4 p); 
-  Unfold convert; Intros n H1;Rewrite H1; Rewrite ZL3; Auto with arith
-| Unfold convert ;Simpl; Change (2) with (plus (1) (1));
-  Rewrite ZL2;
-  Rewrite <- (sub_add_one
-               (anti_convert
-                 (plus (positive_to_nat p (S O)) (positive_to_nat p (S O)))));
-  Rewrite <- (sub_add_one (xI p));
-  Simpl;Rewrite <- H;Elim (ZL4 p); Unfold convert ;Intros n H1;Rewrite H1;
-  Rewrite ZL5; Simpl; Trivial with arith
-| Unfold convert; Simpl; Auto with arith ].
-Qed.
-
-(** Composition of [nat_of_P], [P_of_succ_nat] and [Ppred] is identity
-    on [positive] *)
-
-Theorem bij3: (x:positive)(sub_un (anti_convert (convert x))) = x.
-Proof.
-Intros x; Rewrite bij2; Rewrite sub_add_one; Trivial with arith.
-Qed.
-
-(**********************************************************************)
-(** Extra properties of the injection from binary positive numbers to Peano 
-    natural numbers *)
-
-(** [nat_of_P] is a morphism for subtraction on positive numbers *)
-
-Theorem true_sub_convert:
-  (x,y:positive) (compare x y EGAL) = SUPERIEUR -> 
-     (convert (true_sub x y)) = (minus (convert x) (convert y)).
-Proof.
-Intros x y H; Apply plus_reg_l with (convert y);
-Rewrite le_plus_minus_r; [
-  Rewrite <- convert_add; Rewrite sub_add; Auto with arith
-| Apply lt_le_weak; Exact (compare_convert_SUPERIEUR x y H)].
-Qed.
-
-(** [nat_of_P] is injective *)
-
-Lemma convert_intro : (x,y:positive)(convert x)=(convert y) -> x=y.
-Proof.
-Intros x y H;Rewrite <- (bij3 x);Rewrite <- (bij3 y); Rewrite H; Trivial with arith.
-Qed.
-
-Lemma ZL16: (p,q:positive)(lt (minus (convert p) (convert q)) (convert p)).
-Proof.
-Intros p q; Elim (ZL4 p);Elim (ZL4 q); Intros h H1 i H2; 
-Rewrite H1;Rewrite H2; Simpl;Unfold lt; Apply le_n_S; Apply le_minus.
-Qed.
-
-Lemma ZL17: (p,q:positive)(lt (convert p) (convert (add p q))).
-Proof.
-Intros p q; Rewrite convert_add;Unfold lt;Elim (ZL4 q); Intros k H;Rewrite H;
-Rewrite plus_sym;Simpl; Apply le_n_S; Apply le_plus_r.
-Qed.
-
-(** Comparison and subtraction *)
-
-Lemma compare_true_sub_right :
-  (p,q,z:positive)
-  (compare q p EGAL)=INFERIEUR->
-  (compare z p EGAL)=SUPERIEUR->
-  (compare z q EGAL)=SUPERIEUR->
-  (compare (true_sub z p) (true_sub z q) EGAL)=INFERIEUR.
-Proof.
-Intros; Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
-  Rewrite true_sub_convert; [
-    Apply simpl_lt_plus_l with p:=(convert q); Rewrite le_plus_minus_r; [
-      Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert p);
-        Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
-          Rewrite (plus_sym (convert p)); Apply lt_reg_l;
-          Apply compare_convert_INFERIEUR; Assumption 
-        | Apply lt_le_weak; Apply compare_convert_INFERIEUR;
-          Apply ZC1; Assumption ]
-      | Apply lt_le_weak;Apply compare_convert_INFERIEUR;
-        Apply ZC1; Assumption ]
-    | Assumption ]
-  | Assumption ].
-Qed.
-
-Lemma compare_true_sub_left :
-  (p,q,z:positive)
-  (compare q p EGAL)=INFERIEUR->
-  (compare p z EGAL)=SUPERIEUR->
-  (compare q z EGAL)=SUPERIEUR->
-  (compare (true_sub q z) (true_sub p z) EGAL)=INFERIEUR.
-Proof.
-Intros p q z; Intros; 
-  Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
-  Rewrite true_sub_convert; [
-    Unfold gt; Apply simpl_lt_plus_l with p:=(convert z);
-    Rewrite le_plus_minus_r; [
-      Rewrite le_plus_minus_r; [
-        Apply compare_convert_INFERIEUR;Assumption
-      | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1;Assumption]
-    | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1; Assumption]
-  | Assumption]
-| Assumption].
-Qed.
-
-(** Distributivity of multiplication over subtraction *)
-
-Theorem times_true_sub_distr:
-  (x,y,z:positive) (compare y z EGAL) = SUPERIEUR -> 
-      (times x (true_sub y z)) = (true_sub (times x y) (times x z)).
-Proof.
-Intros x y z H; Apply convert_intro;
-Rewrite times_convert; Rewrite true_sub_convert; [
-  Rewrite true_sub_convert; [
-    Do 2 Rewrite times_convert;
-    Do 3 Rewrite (mult_sym (convert x));Apply mult_minus_distr
-  | Apply convert_compare_SUPERIEUR; Do 2 Rewrite times_convert; 
-    Unfold gt; Elim (ZL4 x);Intros h H1;Rewrite H1; Apply lt_mult_left;
-    Exact (compare_convert_SUPERIEUR y z H) ]
-| Assumption ].
-Qed.
-
diff --git a/theories7/Reals/Alembert.v b/theories7/Reals/Alembert.v
deleted file mode 100644
index 702daffc..00000000
--- a/theories7/Reals/Alembert.v
+++ /dev/null
@@ -1,549 +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: Alembert.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require SeqProp.
-Require PartSum.
-Require Max.
-
-Open Local Scope R_scope.
-
-(***************************************************)
-(* Various versions of the criterion of D'Alembert *)
-(***************************************************)
-
-Lemma Alembert_C1 : (An:nat->R) ((n:nat)``0<(An n)``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) R0) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros An H H0.
-Cut (sigTT R [l:R](is_lub (EUn [N:nat](sum_f_R0 An N)) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intro; Apply X.
-Apply complet.
-Unfold Un_cv in H0; Unfold bound; Cut ``0</2``; [Intro | Apply Rlt_Rinv; Sup0].
-Elim (H0 ``/2`` H1); Intros.
-Exists ``(sum_f_R0 An x)+2*(An (S x))``.
-Unfold is_upper_bound; Intros; Unfold EUn in H3; Elim H3; Intros.
-Rewrite H4; Assert H5 := (lt_eq_lt_dec x1 x).
-Elim H5; Intros.
-Elim a; Intro.
-Replace (sum_f_R0 An x) with (Rplus (sum_f_R0 An x1) (sum_f_R0 [i:nat](An (plus (S x1) i)) (minus x (S x1)))).
-Pattern 1 (sum_f_R0 An x1); Rewrite <- Rplus_Or; Rewrite Rplus_assoc; Apply Rle_compatibility.
-Left; Apply gt0_plus_gt0_is_gt0.
-Apply tech1; Intros; Apply H.
-Apply Rmult_lt_pos; [Sup0 | Apply H].
-Symmetry; Apply tech2; Assumption.
-Rewrite b; Pattern 1 (sum_f_R0 An x); Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Left; Apply Rmult_lt_pos; [Sup0 | Apply H].
-Replace (sum_f_R0 An x1) with (Rplus (sum_f_R0 An x) (sum_f_R0 [i:nat](An (plus (S x) i)) (minus x1 (S x)))).
-Apply Rle_compatibility.
-Cut (Rle (sum_f_R0 [i:nat](An (plus (S x) i)) (minus x1 (S x))) (Rmult (An (S x)) (sum_f_R0 [i:nat](pow ``/2`` i) (minus x1 (S x))))).
-Intro; Apply Rle_trans with (Rmult (An (S x)) (sum_f_R0 [i:nat](pow ``/2`` i) (minus x1 (S x)))).
-Assumption.
-Rewrite <- (Rmult_sym (An (S x))); Apply Rle_monotony.
-Left; Apply H.
-Rewrite tech3.
-Replace ``1-/2`` with ``/2``.
-Unfold Rdiv; Rewrite Rinv_Rinv.
-Pattern 3 ``2``; Rewrite <- Rmult_1r; Rewrite <- (Rmult_sym ``2``); Apply Rle_monotony.
-Left; Sup0.
-Left; Apply Rlt_anti_compatibility with ``(pow (/2) (S (minus x1 (S x))))``.
-Replace ``(pow (/2) (S (minus x1 (S x))))+(1-(pow (/2) (S (minus x1 (S x)))))`` with R1; [Idtac | Ring].
-Rewrite <- (Rplus_sym ``1``); Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Apply pow_lt; Apply Rlt_Rinv; Sup0.
-DiscrR.
-Apply r_Rmult_mult with ``2``.
-Rewrite Rminus_distr; Rewrite <- Rinv_r_sym.
-Ring.
-DiscrR.
-DiscrR.
-Pattern 3 R1; Replace R1 with ``/1``; [Apply tech7; DiscrR | Apply Rinv_R1].
-Replace (An (S x)) with (An (plus (S x) O)).
-Apply (tech6 [i:nat](An (plus (S x) i)) ``/2``).
-Left; Apply Rlt_Rinv; Sup0.
-Intro; Cut (n:nat)(ge n x)->``(An (S n))</2*(An n)``.
-Intro; Replace (plus (S x) (S i)) with (S (plus (S x) i)).
-Apply H6; Unfold ge; Apply tech8.
-Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Intros; Unfold R_dist in H2; Apply Rlt_monotony_contra with ``/(An n)``.
-Apply Rlt_Rinv; Apply H.
-Do 2 Rewrite (Rmult_sym ``/(An n)``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace ``(An (S n))*/(An n)`` with ``(Rabsolu ((Rabsolu ((An (S n))/(An n)))-0))``.
-Apply H2; Assumption.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_right.
-Unfold Rdiv; Reflexivity.
-Left; Unfold Rdiv; Change ``0<(An (S n))*/(An n)``; Apply Rmult_lt_pos; [Apply H | Apply Rlt_Rinv; Apply H].
-Red; Intro; Assert H8 := (H n); Rewrite H7 in H8; Elim (Rlt_antirefl ? H8).
-Replace (plus (S x) O) with (S x); [Reflexivity | Ring].
-Symmetry; Apply tech2; Assumption.
-Exists (sum_f_R0 An O); Unfold EUn; Exists O; Reflexivity.
-Intro; Elim X; Intros.
-Apply Specif.existT with x; Apply tech10; [Unfold Un_growing; Intro; Rewrite tech5; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply H | Apply p].
-Qed.
-
-Lemma Alembert_C2 : (An:nat->R) ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) R0) -> (SigT R  [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros.
-Pose Vn := [i:nat]``(2*(Rabsolu (An i))+(An i))/2``.
-Pose Wn := [i:nat]``(2*(Rabsolu (An i))-(An i))/2``.
-Cut (n:nat)``0<(Vn n)``.
-Intro; Cut (n:nat)``0<(Wn n)``.
-Intro; Cut (Un_cv [n:nat](Rabsolu ``(Vn (S n))/(Vn n)``) ``0``).
-Intro; Cut (Un_cv [n:nat](Rabsolu ``(Wn (S n))/(Wn n)``) ``0``).
-Intro; Assert H5 := (Alembert_C1 Vn H1 H3).
-Assert H6 := (Alembert_C1 Wn H2 H4).
-Elim H5; Intros.
-Elim H6; Intros.
-Apply Specif.existT with ``x-x0``; Unfold Un_cv; Unfold Un_cv in p; Unfold Un_cv in p0; Intros; Cut ``0<eps/2``.
-Intro; Elim (p ``eps/2`` H8); Clear p; Intros.
-Elim (p0 ``eps/2`` H8); Clear p0; Intros.
-Pose N := (max x1 x2).
-Exists N; Intros; Replace (sum_f_R0 An n) with (Rminus (sum_f_R0 Vn n) (sum_f_R0 Wn n)).
-Unfold R_dist; Replace (Rminus (Rminus (sum_f_R0 Vn n) (sum_f_R0 Wn n)) (Rminus x x0)) with (Rplus (Rminus (sum_f_R0 Vn n) x) (Ropp (Rminus (sum_f_R0 Wn n) x0))); [Idtac | Ring]; Apply Rle_lt_trans with (Rplus (Rabsolu (Rminus (sum_f_R0 Vn n) x)) (Rabsolu (Ropp (Rminus (sum_f_R0 Wn n) x0)))).
-Apply Rabsolu_triang.
-Rewrite Rabsolu_Ropp; Apply Rlt_le_trans with ``eps/2+eps/2``.
-Apply Rplus_lt.
-Unfold R_dist in H9; Apply H9; Unfold ge; Apply le_trans with N; [Unfold N; Apply le_max_l | Assumption].
-Unfold R_dist in H10; Apply H10; Unfold ge; Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption].
-Right; Symmetry; Apply double_var.
-Symmetry; Apply tech11; Intro; Unfold Vn Wn; Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/2``); Apply r_Rmult_mult with ``2``.
-Rewrite Rminus_distr; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Ring.
-DiscrR.
-DiscrR.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Cut (n:nat)``/2*(Rabsolu (An n))<=(Wn n)<=(3*/2)*(Rabsolu (An n))``.
-Intro; Cut (n:nat)``/(Wn n)<=2*/(Rabsolu (An n))``.
-Intro; Cut (n:nat)``(Wn (S n))/(Wn n)<=3*(Rabsolu (An (S n))/(An n))``.
-Intro; Unfold Un_cv; Intros; Unfold Un_cv in H0; Cut ``0<eps/3``.
-Intro; Elim (H0 ``eps/3`` H8); Intros.
-Exists x; Intros.
-Assert H11 := (H9 n H10).
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold R_dist in H11; Unfold Rminus in H11; Rewrite Ropp_O in H11; Rewrite Rplus_Or in H11; Rewrite Rabsolu_Rabsolu in H11; Rewrite Rabsolu_right.
-Apply Rle_lt_trans with ``3*(Rabsolu ((An (S n))/(An n)))``.
-Apply H6.
-Apply Rlt_monotony_contra with ``/3``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H11; Exact H11.
-Left; Change ``0<(Wn (S n))/(Wn n)``; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H2.
-Apply Rlt_Rinv; Apply H2.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Intro; Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite <- Rmult_assoc; Replace ``3`` with ``2*(3*/2)``; [Idtac | Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m; DiscrR]; Apply Rle_trans with ``(Wn (S n))*2*/(Rabsolu (An n))``.
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply H2.
-Apply H5.
-Rewrite Rabsolu_Rinv.
-Replace ``(Wn (S n))*2*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*(Wn (S n))``; [Idtac | Ring]; Replace ``2*(3*/2)*(Rabsolu (An (S n)))*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*((3*/2)*(Rabsolu (An (S n))))``; [Idtac | Ring]; Apply Rle_monotony.
-Left; Apply Rmult_lt_pos.
-Sup0.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply H.
-Elim (H4 (S n)); Intros; Assumption.
-Apply H.
-Intro; Apply Rle_monotony_contra with (Wn n).
-Apply H2.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with (Rabsolu (An n)).
-Apply Rabsolu_pos_lt; Apply H.
-Rewrite Rmult_1r; Replace ``(Rabsolu (An n))*((Wn n)*(2*/(Rabsolu (An n))))`` with ``2*(Wn n)*((Rabsolu (An n))*/(Rabsolu (An n)))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Apply Rle_monotony_contra with ``/2``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Elim (H4 n); Intros; Assumption.
-DiscrR.
-Apply Rabsolu_no_R0; Apply H.
-Red; Intro; Assert H6 := (H2 n); Rewrite H5 in H6; Elim (Rlt_antirefl ? H6).
-Intro; Split.
-Unfold Wn; Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Rewrite double; Unfold Rminus; Rewrite Rplus_assoc; Apply Rle_compatibility.
-Apply Rle_anti_compatibility with (An n).
-Rewrite Rplus_Or; Rewrite (Rplus_sym (An n)); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rle_Rabsolu.
-Unfold Wn; Unfold Rdiv; Repeat Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Unfold Rminus; Rewrite double; Replace ``3*(Rabsolu (An n))`` with ``(Rabsolu (An n))+(Rabsolu (An n))+(Rabsolu (An n))``; [Idtac | Ring]; Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility.
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Cut (n:nat)``/2*(Rabsolu (An n))<=(Vn n)<=(3*/2)*(Rabsolu (An n))``.
-Intro; Cut (n:nat)``/(Vn n)<=2*/(Rabsolu (An n))``.
-Intro; Cut (n:nat)``(Vn (S n))/(Vn n)<=3*(Rabsolu (An (S n))/(An n))``.
-Intro; Unfold Un_cv; Intros; Unfold Un_cv in H1; Cut ``0<eps/3``.
-Intro; Elim (H0 ``eps/3`` H7); Intros.
-Exists x; Intros.
-Assert H10 := (H8 n H9).
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold R_dist in H10; Unfold Rminus in H10; Rewrite Ropp_O in H10; Rewrite Rplus_Or in H10; Rewrite Rabsolu_Rabsolu in H10; Rewrite Rabsolu_right.
-Apply Rle_lt_trans with ``3*(Rabsolu ((An (S n))/(An n)))``.
-Apply H5.
-Apply Rlt_monotony_contra with ``/3``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H10; Exact H10.
-Left; Change ``0<(Vn (S n))/(Vn n)``; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H1.
-Apply Rlt_Rinv; Apply H1.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Intro; Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite <- Rmult_assoc; Replace ``3`` with ``2*(3*/2)``; [Idtac | Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m; DiscrR]; Apply Rle_trans with ``(Vn (S n))*2*/(Rabsolu (An n))``.
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply H1.
-Apply H4.
-Rewrite Rabsolu_Rinv.
-Replace ``(Vn (S n))*2*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*(Vn (S n))``; [Idtac | Ring]; Replace ``2*(3*/2)*(Rabsolu (An (S n)))*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*((3*/2)*(Rabsolu (An (S n))))``; [Idtac | Ring]; Apply Rle_monotony.
-Left; Apply Rmult_lt_pos.
-Sup0.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply H.
-Elim (H3 (S n)); Intros; Assumption.
-Apply H.
-Intro; Apply Rle_monotony_contra with (Vn n).
-Apply H1.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with (Rabsolu (An n)).
-Apply Rabsolu_pos_lt; Apply H.
-Rewrite Rmult_1r; Replace ``(Rabsolu (An n))*((Vn n)*(2*/(Rabsolu (An n))))`` with ``2*(Vn n)*((Rabsolu (An n))*/(Rabsolu (An n)))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Apply Rle_monotony_contra with ``/2``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Elim (H3 n); Intros; Assumption.
-DiscrR.
-Apply Rabsolu_no_R0; Apply H.
-Red; Intro; Assert H5 := (H1 n); Rewrite H4 in H5; Elim (Rlt_antirefl ? H5).
-Intro; Split.
-Unfold Vn; Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Rewrite double; Rewrite Rplus_assoc; Apply Rle_compatibility.
-Apply Rle_anti_compatibility with ``-(An n)``; Rewrite Rplus_Or; Rewrite <- (Rplus_sym (An n)); Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Unfold Vn; Unfold Rdiv; Repeat Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Unfold Rminus; Rewrite double; Replace ``3*(Rabsolu (An n))`` with ``(Rabsolu (An n))+(Rabsolu (An n))+(Rabsolu (An n))``; [Idtac | Ring]; Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility; Apply Rle_Rabsolu.
-Intro; Unfold Wn; Unfold Rdiv; Rewrite <- (Rmult_Or ``/2``); Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_anti_compatibility with (An n); Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym (An n)); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rle_lt_trans with (Rabsolu (An n)).
-Apply Rle_Rabsolu.
-Rewrite double; Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rabsolu_pos_lt; Apply H.
-Intro; Unfold Vn; Unfold Rdiv; Rewrite <- (Rmult_Or ``/2``); Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_anti_compatibility with ``-(An n)``; Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym ``-(An n)``); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Apply Rle_lt_trans with (Rabsolu (An n)).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Rewrite double; Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rabsolu_pos_lt; Apply H.
-Qed.
-
-Lemma AlembertC3_step1 : (An:nat->R;x:R) ``x<>0`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) ``0``) -> (SigT R [l:R](Pser An x l)).
-Intros; Pose Bn := [i:nat]``(An i)*(pow x i)``.
-Cut (n:nat)``(Bn n)<>0``.
-Intro; Cut (Un_cv [n:nat](Rabsolu ``(Bn (S n))/(Bn n)``) ``0``).
-Intro; Assert H4 := (Alembert_C2 Bn H2 H3).
-Elim H4; Intros.
-Apply Specif.existT with x0; Unfold Bn in p; Apply tech12; Assumption.
-Unfold Un_cv; Intros; Unfold Un_cv in H1; Cut ``0<eps/(Rabsolu x)``.
-Intro; Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
-Exists x0; Intros; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold Bn; Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
-Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- (Rmult_sym (Rabsolu x)); Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H5; Replace ``(Rabsolu ((An (S n))/(An n)))`` with ``(R_dist (Rabsolu ((An (S n))*/(An n))) 0)``.
-Apply H5; Assumption.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold Rdiv; Reflexivity.
-Apply Rabsolu_no_R0; Assumption.
-Replace (S n) with (plus n (1)); [Idtac | Ring]; Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
-Replace ``(An (plus n (S O)))*((pow x n)*(pow x (S O)))*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*(pow x (S O))*/(An n)*((pow x n)*/(pow x n))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
-Simpl; Ring.
-Apply pow_nonzero; Assumption.
-Apply H0.
-Apply pow_nonzero; Assumption.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption].
-Intro; Unfold Bn; Apply prod_neq_R0; [Apply H0 | Apply pow_nonzero; Assumption].
-Qed.
-
-Lemma AlembertC3_step2 : (An:nat->R;x:R) ``x==0`` -> (SigT R [l:R](Pser An x l)).
-Intros; Apply Specif.existT with (An O).
-Unfold Pser; Unfold infinit_sum; Intros; Exists O; Intros; Replace (sum_f_R0 [n0:nat]``(An n0)*(pow x n0)`` n) with (An O).
-Unfold R_dist; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Induction n.
-Simpl; Ring.
-Rewrite tech5; Rewrite Hrecn; [Rewrite H; Simpl; Ring | Unfold ge; Apply le_O_n].
-Qed.
-
-(* An useful criterion of convergence for power series *)
-Theorem Alembert_C3 : (An:nat->R;x:R) ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) ``0``) -> (SigT R [l:R](Pser An x l)).
-Intros; Case (total_order_T x R0); Intro.
-Elim s; Intro.
-Cut ``x<>0``.
-Intro; Apply AlembertC3_step1; Assumption.
-Red; Intro; Rewrite H1 in a; Elim (Rlt_antirefl ? a).
-Apply AlembertC3_step2; Assumption.
-Cut ``x<>0``.
-Intro; Apply AlembertC3_step1; Assumption.
-Red; Intro; Rewrite H1 in r; Elim (Rlt_antirefl ? r).
-Qed.
-
-Lemma Alembert_C4 : (An:nat->R;k:R) ``0<=k<1`` -> ((n:nat)``0<(An n)``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros An k Hyp H H0.
-Cut (sigTT R [l:R](is_lub (EUn [N:nat](sum_f_R0 An N)) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intro; Apply X.
-Apply complet.
-Assert H1 := (tech13 ? ? Hyp H0).
-Elim H1; Intros.
-Elim H2; Intros.
-Elim H4; Intros.
-Unfold bound; Exists ``(sum_f_R0 An x0)+/(1-x)*(An (S x0))``.
-Unfold is_upper_bound; Intros; Unfold EUn in H6.
-Elim H6; Intros.
-Rewrite H7.
-Assert H8 := (lt_eq_lt_dec x2 x0).
-Elim H8; Intros.
-Elim a; Intro.
-Replace (sum_f_R0 An x0) with (Rplus (sum_f_R0 An x2) (sum_f_R0 [i:nat](An (plus (S x2) i)) (minus x0 (S x2)))).
-Pattern 1 (sum_f_R0 An x2); Rewrite <- Rplus_Or.
-Rewrite Rplus_assoc; Apply Rle_compatibility.
-Left; Apply gt0_plus_gt0_is_gt0.
-Apply tech1.
-Intros; Apply H.
-Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
-Apply H.
-Symmetry; Apply tech2; Assumption.
-Rewrite b; Pattern 1 (sum_f_R0 An x0); Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Left; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
-Apply H.
-Replace (sum_f_R0 An x2) with (Rplus (sum_f_R0 An x0) (sum_f_R0 [i:nat](An (plus (S x0) i)) (minus x2 (S x0)))).
-Apply Rle_compatibility.
-Cut (Rle (sum_f_R0 [i:nat](An (plus (S x0) i)) (minus x2 (S x0))) (Rmult (An (S x0)) (sum_f_R0 [i:nat](pow x i) (minus x2 (S x0))))).
-Intro; Apply Rle_trans with (Rmult (An (S x0)) (sum_f_R0 [i:nat](pow x i) (minus x2 (S x0)))).
-Assumption.
-Rewrite <- (Rmult_sym (An (S x0))); Apply Rle_monotony.
-Left; Apply H.
-Rewrite tech3.
-Unfold Rdiv; Apply Rle_monotony_contra with ``1-x``.
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or.
-Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
-Do 2 Rewrite (Rmult_sym ``1-x``).
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Apply Rle_anti_compatibility with ``(pow x (S (minus x2 (S x0))))``.
-Replace ``(pow x (S (minus x2 (S x0))))+(1-(pow x (S (minus x2 (S x0)))))`` with R1; [Idtac | Ring].
-Rewrite <- (Rplus_sym R1); Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Left; Apply pow_lt.
-Apply Rle_lt_trans with k.
-Elim Hyp; Intros; Assumption.
-Elim H3; Intros; Assumption.
-Apply Rminus_eq_contra.
-Red; Intro.
-Elim H3; Intros.
-Rewrite H10 in H12; Elim (Rlt_antirefl ? H12).
-Red; Intro.
-Elim H3; Intros.
-Rewrite H10 in H12; Elim (Rlt_antirefl ? H12).
-Replace (An (S x0)) with (An (plus (S x0) O)).
-Apply (tech6 [i:nat](An (plus (S x0) i)) x).
-Left; Apply Rle_lt_trans with k.
-Elim Hyp; Intros; Assumption.
-Elim H3; Intros; Assumption.
-Intro.
-Cut (n:nat)(ge n x0)->``(An (S n))<x*(An n)``.
-Intro.
-Replace (plus (S x0) (S i)) with (S (plus (S x0) i)).
-Apply H9.
-Unfold ge.
-Apply tech8.
-  Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Intros.
-Apply Rlt_monotony_contra with ``/(An n)``.
-Apply Rlt_Rinv; Apply H.
-Do 2 Rewrite (Rmult_sym ``/(An n)``).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Replace ``(An (S n))*/(An n)`` with ``(Rabsolu ((An (S n))/(An n)))``.
-Apply H5; Assumption.
-Rewrite Rabsolu_right.
-Unfold Rdiv; Reflexivity.
-Left; Unfold Rdiv; Change ``0<(An (S n))*/(An n)``; Apply Rmult_lt_pos.
-Apply H.
-Apply Rlt_Rinv; Apply H.
-Red; Intro.
-Assert H11 := (H n).
-Rewrite H10 in H11; Elim (Rlt_antirefl ? H11).
-Replace (plus (S x0) O) with (S x0); [Reflexivity | Ring].
-Symmetry; Apply tech2; Assumption.
-Exists (sum_f_R0 An O); Unfold EUn; Exists O; Reflexivity.
-Intro; Elim X; Intros.
-Apply Specif.existT with x; Apply tech10; [Unfold Un_growing; Intro; Rewrite tech5; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply H | Apply p].
-Qed.
-
-Lemma Alembert_C5 : (An:nat->R;k:R) ``0<=k<1`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros.
-Cut (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intro Hyp0; Apply Hyp0.
-Apply cv_cauchy_2.
-Apply cauchy_abs.
-Apply cv_cauchy_1.
-Cut (SigT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat](Rabsolu (An i)) N) l)) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat](Rabsolu (An i)) N) l)).
-Intro Hyp; Apply Hyp.
-Apply (Alembert_C4 [i:nat](Rabsolu (An i)) k).
-Assumption.
-Intro; Apply Rabsolu_pos_lt; Apply H0.
-Unfold Un_cv.
-Unfold Un_cv in H1.
-Unfold Rdiv.
-Intros.
-Elim (H1 eps H2); Intros.
-Exists x; Intros.
-Rewrite <- Rabsolu_Rinv.
-Rewrite <- Rabsolu_mult.
-Rewrite Rabsolu_Rabsolu.
-Unfold Rdiv in H3; Apply H3; Assumption.
-Apply H0.
-Intro.
-Elim X; Intros.
-Apply existTT with x.
-Assumption.
-Intro.
-Elim X; Intros.
-Apply Specif.existT with x.
-Assumption.
-Qed.
-
-(* Convergence of power series in D(O,1/k) *)
-(*     k=0 is described in Alembert_C3     *)
-Lemma Alembert_C6 : (An:nat->R;x,k:R) ``0<k`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> ``(Rabsolu x)</k`` -> (SigT R [l:R](Pser An x l)).
-Intros.
-Cut (SigT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat]``(An i)*(pow x i)`` N) l)).
-Intro.
-Elim X; Intros.
-Apply Specif.existT with x0.
-Apply tech12; Assumption.
-Case (total_order_T x R0); Intro.
-Elim s; Intro.
-EApply Alembert_C5 with ``k*(Rabsolu x)``.
-Split.
-Unfold Rdiv; Apply Rmult_le_pos.
-Left; Assumption.
-Left; Apply Rabsolu_pos_lt.
-Red; Intro; Rewrite H3 in a; Elim (Rlt_antirefl ? a).
-Apply Rlt_monotony_contra with ``/k``.
-Apply Rlt_Rinv; Assumption.
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite Rmult_1r; Assumption.
-Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
-Intro; Apply prod_neq_R0.
-Apply H0.
-Apply pow_nonzero.
-Red; Intro; Rewrite H3 in a; Elim (Rlt_antirefl ? a).
-Unfold Un_cv; Unfold Un_cv in H1.
-Intros.
-Cut ``0<eps/(Rabsolu x)``.
-Intro.
-Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
-Exists x0.
-Intros.
-Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
-Unfold R_dist.
-Rewrite Rabsolu_mult.
-Replace ``(Rabsolu ((An (S n))/(An n)))*(Rabsolu x)-k*(Rabsolu x)`` with ``(Rabsolu x)*((Rabsolu ((An (S n))/(An n)))-k)``; [Idtac | Ring].
-Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rabsolu.
-Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite <- (Rmult_sym eps).
-Unfold R_dist in H5.
-Unfold Rdiv; Unfold Rdiv in H5; Apply H5; Assumption.
-Apply Rabsolu_no_R0.
-Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Unfold Rdiv; Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add.
-Simpl.
-Rewrite Rmult_1r.
-Rewrite Rinv_Rmult.
-Replace ``(An (plus n (S O)))*((pow x n)*x)*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*/(An n)*x*((pow x n)*/(pow x n))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Reflexivity.
-Apply pow_nonzero.
-Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Apply H0.
-Apply pow_nonzero.
-Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Red; Intro H7; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
-Apply Specif.existT with (An O).
-Unfold Un_cv.
-Intros.
-Exists O.
-Intros.
-Unfold R_dist.
-Replace (sum_f_R0 [i:nat]``(An i)*(pow x i)`` n) with (An O).
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Induction n.
-Simpl; Ring.
-Rewrite tech5.
-Rewrite <- Hrecn.
-Rewrite b; Simpl; Ring.
-Unfold ge; Apply le_O_n.
-EApply Alembert_C5 with ``k*(Rabsolu x)``.
-Split.
-Unfold Rdiv; Apply Rmult_le_pos.
-Left; Assumption.
-Left; Apply Rabsolu_pos_lt.
-Red; Intro; Rewrite H3 in r; Elim (Rlt_antirefl ? r).
-Apply Rlt_monotony_contra with ``/k``.
-Apply Rlt_Rinv; Assumption.
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite Rmult_1r; Assumption.
-Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
-Intro; Apply prod_neq_R0.
-Apply H0.
-Apply pow_nonzero.
-Red; Intro; Rewrite H3 in r; Elim (Rlt_antirefl ? r).
-Unfold Un_cv; Unfold Un_cv in H1.
-Intros.
-Cut ``0<eps/(Rabsolu x)``.
-Intro.
-Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
-Exists x0.
-Intros.
-Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
-Unfold R_dist.
-Rewrite Rabsolu_mult.
-Replace ``(Rabsolu ((An (S n))/(An n)))*(Rabsolu x)-k*(Rabsolu x)`` with ``(Rabsolu x)*((Rabsolu ((An (S n))/(An n)))-k)``; [Idtac | Ring].
-Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rabsolu.
-Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite <- (Rmult_sym eps).
-Unfold R_dist in H5.
-Unfold Rdiv; Unfold Rdiv in H5; Apply H5; Assumption.
-Apply Rabsolu_no_R0.
-Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Unfold Rdiv; Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add.
-Simpl.
-Rewrite Rmult_1r.
-Rewrite Rinv_Rmult.
-Replace ``(An (plus n (S O)))*((pow x n)*x)*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*/(An n)*x*((pow x n)*/(pow x n))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Reflexivity.
-Apply pow_nonzero.
-Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Apply H0.
-Apply pow_nonzero.
-Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Red; Intro H7; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
-Qed.
diff --git a/theories7/Reals/AltSeries.v b/theories7/Reals/AltSeries.v
deleted file mode 100644
index af4b558a..00000000
--- a/theories7/Reals/AltSeries.v
+++ /dev/null
@@ -1,362 +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: AltSeries.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require SeqProp.
-Require PartSum.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(**********)
-Definition tg_alt [Un:nat->R] : nat->R := [i:nat]``(pow (-1) i)*(Un i)``.
-Definition positivity_seq [Un:nat->R] : Prop := (n:nat)``0<=(Un n)``.
-
-Lemma CV_ALT_step0 : (Un:nat->R) (Un_decreasing Un) -> (Un_growing [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
-Intros; Unfold Un_growing; Intro.
-Cut (mult (S (S O)) (S n)) = (S (S (mult (2) n))).
-Intro; Rewrite H0.
-Do 4 Rewrite tech5; Repeat Rewrite Rplus_assoc; Apply Rle_compatibility.
-Pattern 1 (tg_alt Un (S (mult (S (S O)) n))); Rewrite <- Rplus_Or.
-Apply Rle_compatibility.
-Unfold tg_alt; Rewrite <- H0; Rewrite pow_1_odd; Rewrite pow_1_even; Rewrite Rmult_1l.
-Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) (S n))))``.
-Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) (S n))))+((Un (mult (S (S O)) (S n)))+ -1*(Un (S (mult (S (S O)) (S n)))))`` with ``(Un (mult (S (S O)) (S n)))``; [Idtac | Ring].
-Apply H.
-Cut (n:nat) (S n)=(plus n (1)); [Intro | Intro; Ring].
-Rewrite (H0 n); Rewrite (H0 (S (mult (2) n))); Rewrite (H0 (mult (2) n)); Ring.
-Qed.
-
-Lemma CV_ALT_step1 : (Un:nat->R) (Un_decreasing Un) -> (Un_decreasing [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N))).
-Intros; Unfold Un_decreasing; Intro.
-Cut (mult (S (S O)) (S n)) = (S (S (mult (2) n))).
-Intro; Rewrite H0; Do 2 Rewrite tech5; Repeat Rewrite Rplus_assoc.
-Pattern 2 (sum_f_R0 (tg_alt Un) (mult (S (S O)) n)); Rewrite <- Rplus_Or.
-Apply Rle_compatibility.
-Unfold tg_alt; Rewrite <- H0; Rewrite pow_1_odd; Rewrite pow_1_even; Rewrite Rmult_1l.
-Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) n)))``.
-Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) n)))+( -1*(Un (S (mult (S (S O)) n)))+(Un (mult (S (S O)) (S n))))`` with ``(Un (mult (S (S O)) (S n)))``; [Idtac | Ring].
-Rewrite H0; Apply H.
-Cut (n:nat) (S n)=(plus n (1)); [Intro | Intro; Ring].
-Rewrite (H0 n); Rewrite (H0 (S (mult (2) n))); Rewrite (H0 (mult (2) n)); Ring.
-Qed.
-
-(**********)
-Lemma CV_ALT_step2 : (Un:nat->R;N:nat) (Un_decreasing Un) -> (positivity_seq Un) -> (Rle (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (2) N))) R0). 
-Intros; Induction N.
-Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1r.
-Replace ``-1* -1*(Un (S (S O)))`` with (Un (S (S O))); [Idtac | Ring].
-Apply Rle_anti_compatibility with ``(Un (S O))``; Rewrite Rplus_Or.
-Replace ``(Un (S O))+ (-1*(Un (S O))+(Un (S (S O))))`` with (Un (S (S O))); [Apply H | Ring].
-Cut (S (mult (2) (S N))) = (S (S (S (mult (2) N)))).
-Intro; Rewrite H1; Do 2 Rewrite tech5.
-Apply Rle_trans with (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) N))).
-Pattern 2 (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) N))); Rewrite <- Rplus_Or.
-Rewrite Rplus_assoc; Apply Rle_compatibility.
-Unfold tg_alt; Rewrite <- H1.
-Rewrite pow_1_odd.
-Cut (S (S (mult (2) (S N)))) = (mult (2) (S (S N))).
-Intro; Rewrite H2; Rewrite pow_1_even; Rewrite Rmult_1l; Rewrite <- H2.
-Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) (S N))))``.
-Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) (S N))))+( -1*(Un (S (mult (S (S O)) (S N))))+(Un (S (S (mult (S (S O)) (S N))))))`` with ``(Un (S (S (mult (S (S O)) (S N)))))``; [Idtac | Ring].
-Apply H.
-Apply INR_eq; Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply HrecN.
-Apply INR_eq; Repeat Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Qed.
-
-(* A more general inequality *)
-Lemma CV_ALT_step3 : (Un:nat->R;N:nat) (Un_decreasing Un) -> (positivity_seq Un) -> (Rle (sum_f_R0 [i:nat](tg_alt Un (S i)) N) R0). 
-Intros; Induction N.
-Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1r.
-Apply Rle_anti_compatibility with (Un (S O)).
-Rewrite Rplus_Or; Replace ``(Un (S O))+ -1*(Un (S O))`` with R0; [Apply H0 | Ring].
-Assert H1 := (even_odd_cor N).
-Elim H1; Intros.
-Elim H2; Intro.
-Rewrite H3; Apply CV_ALT_step2; Assumption.
-Rewrite H3; Rewrite tech5.
-Apply Rle_trans with (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) x))).
-Pattern 2 (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) x))); Rewrite <- Rplus_Or.
-Apply Rle_compatibility.
-Unfold tg_alt; Simpl.
-Replace (plus x (plus x O)) with (mult (2) x); [Idtac | Ring].
-Rewrite pow_1_even.
-Replace `` -1*( -1*( -1*1))*(Un (S (S (S (mult (S (S O)) x)))))`` with ``-(Un (S (S (S (mult (S (S O)) x)))))``; [Idtac | Ring].
-Apply Rle_anti_compatibility with (Un (S (S (S (mult (S (S O)) x))))).
-Rewrite Rplus_Or; Rewrite Rplus_Ropp_r.
-Apply H0.
-Apply CV_ALT_step2; Assumption.
-Qed.
-
-(**********)
-Lemma CV_ALT_step4 : (Un:nat->R) (Un_decreasing Un) -> (positivity_seq Un) -> (has_ub [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
-Intros; Unfold has_ub; Unfold bound.
-Exists ``(Un O)``.
-Unfold is_upper_bound; Intros; Elim H1; Intros.
-Rewrite H2; Rewrite decomp_sum.
-Replace (tg_alt Un O) with ``(Un O)``.
-Pattern 2 ``(Un O)``; Rewrite <- Rplus_Or.
-Apply Rle_compatibility.
-Apply CV_ALT_step3; Assumption.
-Unfold tg_alt; Simpl; Ring.
-Apply lt_O_Sn.
-Qed.
-
-(* This lemma gives an interesting result about alternated series *)
-Lemma CV_ALT : (Un:nat->R) (Un_decreasing Un) -> (positivity_seq Un) -> (Un_cv Un R0) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l)).
-Intros.
-Assert H2 := (CV_ALT_step0 ? H).
-Assert H3 := (CV_ALT_step4 ? H H0).
-Assert X := (growing_cv ? H2 H3).
-Elim X; Intros.
-Apply existTT with x.
-Unfold Un_cv; Unfold R_dist; Unfold Un_cv in H1; Unfold R_dist in H1; Unfold Un_cv in p; Unfold R_dist in p.
-Intros; Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H1 ``eps/2`` H5); Intros N2 H6.
-Elim (p ``eps/2`` H5); Intros N1 H7.
-Pose N := (max (S (mult (2) N1)) N2).
-Exists N; Intros.
-Assert H9 := (even_odd_cor n).
-Elim H9; Intros P H10.
-Cut (le N1 P).
-Intro; Elim H10; Intro.
-Replace ``(sum_f_R0 (tg_alt Un) n)-x`` with ``((sum_f_R0 (tg_alt Un) (S n))-x)+(-(tg_alt Un (S n)))``.
-Apply Rle_lt_trans with ``(Rabsolu ((sum_f_R0 (tg_alt Un) (S n))-x))+(Rabsolu (-(tg_alt Un (S n))))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Rewrite H12; Apply H7; Assumption.
-Rewrite Rabsolu_Ropp; Unfold tg_alt; Rewrite Rabsolu_mult; Rewrite pow_1_abs; Rewrite Rmult_1l; Unfold Rminus in H6; Rewrite Ropp_O in H6; Rewrite <- (Rplus_Or (Un (S n))); Apply H6.
-Unfold ge; Apply le_trans with n.
-Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption].
-Apply le_n_Sn.
-Rewrite tech5; Ring.
-Rewrite H12; Apply Rlt_trans with ``eps/2``.
-Apply H7; Assumption.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
-Rewrite RIneq.double.
-Pattern 1 eps; Rewrite <- (Rplus_Or eps); Apply Rlt_compatibility; Assumption.
-Elim H10; Intro; Apply le_double.
-Rewrite <- H11; Apply le_trans with N.
-Unfold N; Apply le_trans with (S (mult (2) N1)); [Apply le_n_Sn | Apply le_max_l].
-Assumption.
-Apply lt_n_Sm_le.
-Rewrite <- H11.
-Apply lt_le_trans with N.
-Unfold N; Apply lt_le_trans with (S (mult (2) N1)).
-Apply lt_n_Sn.
-Apply le_max_l.
-Assumption.
-Qed.
-
-(************************************************)
-(*        Convergence of alternated series      *)
-(*                                              *)
-(*         Applications: PI, cos, sin           *)
-(************************************************)
-Theorem alternated_series : (Un:nat->R) (Un_decreasing Un) -> (Un_cv Un R0) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l)).
-Intros; Apply CV_ALT.
-Assumption.
-Unfold positivity_seq; Apply decreasing_ineq; Assumption.
-Assumption.
-Qed.
-
-Theorem alternated_series_ineq : (Un:nat->R;l:R;N:nat) (Un_decreasing Un) -> (Un_cv Un R0) -> (Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l) -> ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) N)))<=l<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) N))``.
-Intros.
-Cut (Un_cv [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N)) l).
-Cut (Un_cv [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N))) l).
-Intros; Split.
-Apply (growing_ineq [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
-Apply CV_ALT_step0; Assumption.
-Assumption.
-Apply (decreasing_ineq [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N))).
-Apply CV_ALT_step1; Assumption.
-Assumption.
-Unfold Un_cv; Unfold R_dist; Unfold Un_cv in H1; Unfold R_dist in H1; Intros. 
-Elim (H1 eps H2); Intros.
-Exists x; Intros.
-Apply H3.
-Unfold ge; Apply le_trans with (mult (2) n).
-Apply le_trans with n.
-Assumption.
-Assert H5 := (mult_O_le n (2)).
-Elim H5; Intro. 
-Cut ~(O)=(2); [Intro; Elim H7; Symmetry; Assumption | Discriminate].
-Assumption.
-Apply le_n_Sn.
-Unfold Un_cv; Unfold R_dist; Unfold Un_cv in H1; Unfold R_dist in H1; Intros. 
-Elim (H1 eps H2); Intros.
-Exists x; Intros.
-Apply H3.
-Unfold ge; Apply le_trans with n.
-Assumption.
-Assert H5 := (mult_O_le n (2)).
-Elim H5; Intro. 
-Cut ~(O)=(2); [Intro; Elim H7; Symmetry; Assumption | Discriminate].
-Assumption.
-Qed.
-
-(************************************)
-(* Application : construction of PI *)
-(************************************)
-
-Definition PI_tg := [n:nat]``/(INR (plus (mult (S (S O)) n) (S O)))``.
-
-Lemma PI_tg_pos : (n:nat)``0<=(PI_tg n)``.
-Intro; Unfold PI_tg; Left; Apply Rlt_Rinv; Apply lt_INR_0; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Qed.
-
-Lemma PI_tg_decreasing : (Un_decreasing PI_tg).
-Unfold PI_tg Un_decreasing; Intro.
-Apply Rle_monotony_contra with ``(INR (plus (mult (S (S O)) n) (S O)))``.
-Apply lt_INR_0.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with ``(INR (plus (mult (S (S O)) (S n)) (S O)))``.
-Apply lt_INR_0.
-Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
-Rewrite (Rmult_sym ``(INR (plus (mult (S (S O)) (S n)) (S O)))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Do 2 Rewrite Rmult_1r; Apply le_INR.
-Replace (plus (mult (2) (S n)) (1)) with (S (S (plus (mult (2) n) (1)))).
-Apply le_trans with (S (plus (mult (2) n) (1))); Apply le_n_Sn.
-Apply INR_eq; Do 2  Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Discriminate | Ring].
-Qed.
-
-Lemma PI_tg_cv : (Un_cv PI_tg R0).
-Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<2*eps``; [Intro | Apply Rmult_lt_pos; [Sup0 | Assumption]].
-Assert H1 := (archimed ``/(2*eps)``).
-Cut (Zle `0` ``(up (/(2*eps)))``).
-Intro; Assert H3 := (IZN ``(up (/(2*eps)))`` H2).
-Elim H3; Intros N H4.
-Cut (lt O N).
-Intro; Exists N; Intros.
-Cut (lt O n).
-Intro; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_right.
-Unfold PI_tg; Apply Rlt_trans with ``/(INR (mult (S (S O)) n))``.
-Apply Rlt_monotony_contra with ``(INR (mult (S (S O)) n))``.
-Apply lt_INR_0.
-Replace (mult (2) n) with (plus n n); [Idtac | Ring].
-Apply lt_le_trans with n.
-Assumption.
-Apply le_plus_l.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with ``(INR (plus (mult (S (S O)) n) (S O)))``.
-Apply lt_INR_0.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Rewrite (Rmult_sym ``(INR (plus (mult (S (S O)) n) (S O)))``).
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Do 2 Rewrite Rmult_1r; Apply lt_INR.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_n_Sn | Ring].
-Apply not_O_INR; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Discriminate | Ring].
-Replace n with (S (pred n)).
-Apply not_O_INR; Discriminate.
-Symmetry; Apply S_pred with O.
-Assumption.
-Apply Rle_lt_trans with ``/(INR (mult (S (S O)) N))``.
-Apply Rle_monotony_contra with ``(INR (mult (S (S O)) N))``.
-Rewrite mult_INR; Apply Rmult_lt_pos; [Simpl; Sup0 | Apply lt_INR_0; Assumption].
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with ``(INR (mult (S (S O)) n))``.
-Rewrite mult_INR; Apply Rmult_lt_pos; [Simpl; Sup0 | Apply lt_INR_0; Assumption].
-Rewrite (Rmult_sym (INR (mult (S (S O)) n))); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Do 2 Rewrite Rmult_1r; Apply le_INR.
-Apply mult_le; Assumption.
-Replace n with (S (pred n)).
-Apply not_O_INR; Discriminate.
-Symmetry; Apply S_pred with O.
-Assumption.
-Replace N with (S (pred N)).
-Apply not_O_INR; Discriminate.
-Symmetry; Apply S_pred with O.
-Assumption.
-Rewrite mult_INR.
-Rewrite Rinv_Rmult.
-Replace (INR (S (S O))) with ``2``; [Idtac | Reflexivity].
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Idtac | DiscrR].
-Rewrite Rmult_1l; Apply Rlt_monotony_contra with (INR N).
-Apply lt_INR_0; Assumption.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with ``/(2*eps)``.
-Apply Rlt_Rinv; Assumption.
-Rewrite Rmult_1r; Replace ``/(2*eps)*((INR N)*(2*eps))`` with ``(INR N)*((2*eps)*/(2*eps))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace (INR N) with (IZR (INZ N)).
-Rewrite <- H4.
-Elim H1; Intros; Assumption.
-Symmetry; Apply INR_IZR_INZ.
-Apply prod_neq_R0; [DiscrR | Red; Intro; Rewrite H8 in H; Elim (Rlt_antirefl ? H)].
-Apply not_O_INR.
-Red; Intro; Rewrite H8 in H5; Elim (lt_n_n ? H5).
-Replace (INR (S (S O))) with ``2``; [DiscrR | Reflexivity].
-Apply not_O_INR.
-Red; Intro; Rewrite H8 in H5; Elim (lt_n_n ? H5).
-Apply Rle_sym1; Apply PI_tg_pos.
-Apply lt_le_trans with N; Assumption.
-Elim H1; Intros H5 _.
-Assert H6 := (lt_eq_lt_dec O N).
-Elim H6; Intro.
-Elim a; Intro.
-Assumption.
-Rewrite <- b in H4.
-Rewrite H4 in H5.
-Simpl in H5.
-Cut ``0</(2*eps)``; [Intro | Apply Rlt_Rinv; Assumption].
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H7 H5)).
-Elim (lt_n_O ? b).
-Apply le_IZR.
-Simpl.
-Left; Apply Rlt_trans with ``/(2*eps)``.
-Apply Rlt_Rinv; Assumption.
-Elim H1; Intros; Assumption.
-Qed.
-
-Lemma exist_PI : (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt PI_tg) N) l)).
-Apply alternated_series.
-Apply PI_tg_decreasing.
-Apply PI_tg_cv.
-Qed.
-
-(* Now, PI is defined *)
-Definition PI : R := (Rmult ``4`` (Cases exist_PI of (existTT a b) => a end)).
-
-(* We can get an approximation of PI with the following inequality *)
-Lemma PI_ineq : (N:nat) ``(sum_f_R0 (tg_alt PI_tg) (S (mult (S (S O)) N)))<=PI/4<=(sum_f_R0 (tg_alt PI_tg) (mult (S (S O)) N))``.
-Intro; Apply alternated_series_ineq.
-Apply PI_tg_decreasing.
-Apply PI_tg_cv.
-Unfold PI; Case exist_PI; Intro.
-Replace ``(4*x)/4`` with x.
-Trivial.
-Unfold Rdiv; Rewrite (Rmult_sym ``4``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r; Reflexivity | DiscrR].
-Qed.
-
-Lemma PI_RGT_0 : ``0<PI``.
-Assert H := (PI_ineq O).
-Apply Rlt_monotony_contra with ``/4``.
-Apply Rlt_Rinv; Sup0.
-Rewrite Rmult_Or; Rewrite Rmult_sym.
-Elim H; Clear H; Intros H _.
-Unfold Rdiv in H; Apply Rlt_le_trans with ``(sum_f_R0 (tg_alt PI_tg) (S (mult (S (S O)) O)))``.
-Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1l; Rewrite Rmult_1r; Apply Rlt_anti_compatibility with ``(PI_tg (S O))``.
-Rewrite Rplus_Or; Replace ``(PI_tg (S O))+((PI_tg O)+ -1*(PI_tg (S O)))`` with ``(PI_tg O)``; [Unfold PI_tg | Ring].
-Simpl; Apply Rinv_lt.
-Rewrite Rmult_1l; Replace ``2+1`` with ``3``; [Sup0 | Ring].
-Rewrite Rplus_sym; Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Sup0.
-Assumption.
-Qed.
diff --git a/theories7/Reals/ArithProp.v b/theories7/Reals/ArithProp.v
deleted file mode 100644
index 468675ca..00000000
--- a/theories7/Reals/ArithProp.v
+++ /dev/null
@@ -1,134 +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: ArithProp.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rbasic_fun.
-Require Even.
-Require Div2.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope Z_scope.
-Open Local Scope R_scope.
-
-Lemma minus_neq_O : (n,i:nat) (lt i n) -> ~(minus n i)=O.
-Intros; Red; Intro.
-Cut (n,m:nat) (le m n) -> (minus n m)=O -> n=m.
-Intro; Assert H2 := (H1 ? ? (lt_le_weak ? ? H) H0); Rewrite H2 in H; Elim (lt_n_n ? H).
-Pose R := [n,m:nat](le m n)->(minus n m)=(0)->n=m.
-Cut ((n,m:nat)(R n m)) -> ((n0,m:nat)(le m n0)->(minus n0 m)=(0)->n0=m).
-Intro; Apply H1.
-Apply nat_double_ind.
-Unfold R; Intros; Inversion H2; Reflexivity.
-Unfold R; Intros; Simpl in H3; Assumption.
-Unfold R; Intros; Simpl in H4; Assert H5 := (le_S_n ? ? H3); Assert H6 := (H2 H5 H4); Rewrite H6; Reflexivity.
-Unfold R; Intros; Apply H1; Assumption.
-Qed.
-
-Lemma le_minusni_n : (n,i:nat) (le i n)->(le (minus n i) n).
-Pose R := [m,n:nat] (le n m) -> (le (minus m n) m).
-Cut ((m,n:nat)(R m n)) -> ((n,i:nat)(le i n)->(le (minus n i) n)).
-Intro; Apply H.
-Apply nat_double_ind.
-Unfold R; Intros; Simpl; Apply le_n.
-Unfold R; Intros; Simpl; Apply le_n.
-Unfold R; Intros; Simpl; Apply le_trans with n.
-Apply H0; Apply le_S_n; Assumption.
-Apply le_n_Sn.
-Unfold R; Intros; Apply H; Assumption.
-Qed.
-
-Lemma lt_minus_O_lt : (m,n:nat) (lt m n) -> (lt O (minus n m)).
-Intros n m; Pattern n m; Apply nat_double_ind; [
-  Intros; Rewrite <- minus_n_O; Assumption
-| Intros; Elim (lt_n_O ? H)
-| Intros; Simpl; Apply H; Apply lt_S_n; Assumption].
-Qed.
-
-Lemma even_odd_cor : (n:nat) (EX p : nat | n=(mult (2) p)\/n=(S (mult (2) p))).
-Intro.
-Assert H := (even_or_odd n).
-Exists (div2 n).
-Assert H0 := (even_odd_double n).
-Elim H0; Intros.
-Elim H1; Intros H3 _.
-Elim H2; Intros H4 _.
-Replace (mult (2) (div2 n)) with (Div2.double (div2 n)).
-Elim H; Intro.
-Left.
-Apply H3; Assumption.
-Right.
-Apply H4; Assumption.
-Unfold Div2.double; Ring.
-Qed.
-
-(* 2m <= 2n => m<=n *)
-Lemma le_double : (m,n:nat) (le (mult (2) m) (mult (2) n)) -> (le m n).
-Intros; Apply INR_le.
-Assert H1 := (le_INR ? ? H).
-Do 2 Rewrite mult_INR in H1.
-Apply Rle_monotony_contra with ``(INR (S (S O)))``.
-Replace (INR (S (S O))) with ``2``; [Sup0 | Reflexivity].
-Assumption.
-Qed.
-
-(* Here, we have the euclidian division *)
-(* This lemma is used in the proof of sin_eq_0 : (sin x)=0<->x=kPI *)
-Lemma euclidian_division : (x,y:R) ``y<>0`` -> (EXT k:Z | (EXT r : R | ``x==(IZR k)*y+r``/\``0<=r<(Rabsolu y)``)).
-Intros.
-Pose k0 := Cases (case_Rabsolu y) of
-     (leftT _) => (Zminus `1` (up ``x/-y``))
-   | (rightT _) => (Zminus (up ``x/y``) `1`) end.
-Exists k0.
-Exists ``x-(IZR k0)*y``.
-Split.
-Ring.
-Unfold k0; Case (case_Rabsolu y); Intro.
-Assert H0 := (archimed ``x/-y``); Rewrite <- Z_R_minus; Simpl; Unfold Rminus.
-Replace ``-((1+ -(IZR (up (x/( -y)))))*y)`` with ``((IZR (up (x/-y)))-1)*y``; [Idtac | Ring].
-Split.
-Apply Rle_monotony_contra with ``/-y``.
-Apply Rlt_Rinv; Apply Rgt_RO_Ropp; Exact r.
-Rewrite Rmult_Or; Rewrite (Rmult_sym ``/-y``); Rewrite Rmult_Rplus_distrl; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
-Rewrite Rmult_assoc; Repeat Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption].
-Apply Rle_anti_compatibility with ``(IZR (up (x/( -y))))-x/( -y)``.
-Rewrite Rplus_Or; Unfold Rdiv; Pattern 4 ``/-y``; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
-Replace ``(IZR (up (x*/ -y)))-x* -/y+( -(x*/y)+ -((IZR (up (x*/ -y)))-1))`` with R1; [Idtac | Ring].
-Elim H0; Intros _ H1; Unfold Rdiv in H1; Exact H1.
-Rewrite (Rabsolu_left ? r); Apply Rlt_monotony_contra with ``/-y``.
-Apply Rlt_Rinv; Apply Rgt_RO_Ropp; Exact r.
-Rewrite <- Rinv_l_sym.
-Rewrite (Rmult_sym ``/-y``); Rewrite Rmult_Rplus_distrl; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
-Rewrite Rmult_assoc; Repeat Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rlt_anti_compatibility with ``((IZR (up (x/( -y))))-1)``.
-Replace ``(IZR (up (x/( -y))))-1+1`` with ``(IZR (up (x/( -y))))``; [Idtac | Ring].
-Replace ``(IZR (up (x/( -y))))-1+( -(x*/y)+ -((IZR (up (x/( -y))))-1))`` with ``-(x*/y)``; [Idtac | Ring].
-Rewrite <- Ropp_mul3; Rewrite (Ropp_Rinv ? H); Elim H0; Unfold Rdiv; Intros H1 _; Exact H1.
-Apply Ropp_neq; Assumption.
-Assert H0 := (archimed ``x/y``); Rewrite <- Z_R_minus; Simpl; Cut ``0<y``.
-Intro; Unfold Rminus; Replace ``-(((IZR (up (x/y)))+ -1)*y)`` with ``(1-(IZR (up (x/y))))*y``; [Idtac | Ring].
-Split.
-Apply Rle_monotony_contra with ``/y``.
-Apply Rlt_Rinv; Assumption.
-Rewrite Rmult_Or; Rewrite (Rmult_sym ``/y``); Rewrite Rmult_Rplus_distrl; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rle_anti_compatibility with ``(IZR (up (x/y)))-x/y``; Rewrite Rplus_Or; Unfold Rdiv; Replace ``(IZR (up (x*/y)))-x*/y+(x*/y+(1-(IZR (up (x*/y)))))`` with R1; [Idtac | Ring]; Elim H0; Intros _ H2; Unfold Rdiv in H2; Exact H2.
-Rewrite (Rabsolu_right ? r); Apply Rlt_monotony_contra with ``/y``.
-Apply Rlt_Rinv; Assumption.
-Rewrite <- (Rinv_l_sym ? H); Rewrite (Rmult_sym ``/y``); Rewrite Rmult_Rplus_distrl; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rlt_anti_compatibility with ``((IZR (up (x/y)))-1)``; Replace ``(IZR (up (x/y)))-1+1`` with ``(IZR (up (x/y)))``; [Idtac | Ring]; Replace ``(IZR (up (x/y)))-1+(x*/y+(1-(IZR (up (x/y)))))`` with ``x*/y``; [Idtac | Ring]; Elim H0; Unfold Rdiv; Intros H2 _; Exact H2.
-Case (total_order_T R0 y); Intro.
-Elim s; Intro.
-Assumption.
-Elim H; Symmetry; Exact b.
-Assert H1 := (Rle_sym2 ? ? r); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 r0)).
-Qed.
-
-Lemma tech8 : (n,i:nat) (le n (plus (S n) i)).
-Intros; Induction i.
-Replace (plus (S n) O) with (S n); [Apply le_n_Sn | Ring].
-Replace (plus (S n) (S i)) with (S (plus (S n) i)).
-Apply le_S; Assumption.
-Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Qed.
diff --git a/theories7/Reals/Binomial.v b/theories7/Reals/Binomial.v
deleted file mode 100644
index 1dfd2ec0..00000000
--- a/theories7/Reals/Binomial.v
+++ /dev/null
@@ -1,181 +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: Binomial.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require PartSum.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Definition C [n,p:nat] : R := ``(INR (fact n))/((INR (fact p))*(INR (fact (minus n p))))``.
-
-Lemma pascal_step1 : (n,i:nat) (le i n) -> (C n i) == (C n (minus n i)).
-Intros; Unfold C; Replace (minus n (minus n i)) with i.
-Rewrite Rmult_sym.
-Reflexivity.
-Apply plus_minus; Rewrite plus_sym; Apply le_plus_minus; Assumption.
-Qed.
-
-Lemma pascal_step2 : (n,i:nat) (le i n) -> (C (S n) i) == ``(INR (S n))/(INR (minus (S n) i))*(C n i)``.
-Intros; Unfold C; Replace (minus (S n) i) with (S (minus n i)).
-Cut (n:nat) (fact (S n))=(mult (S n) (fact n)).
-Intro; Repeat Rewrite H0.
-Unfold Rdiv; Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
-Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply prod_neq_R0.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Intro; Reflexivity.
-Apply minus_Sn_m; Assumption.
-Qed.
-
-Lemma pascal_step3 : (n,i:nat) (lt i n) -> (C n (S i)) == ``(INR (minus n i))/(INR (S i))*(C n i)``.
-Intros; Unfold C.
-Cut (n:nat) (fact (S n))=(mult (S n) (fact n)).
-Intro.
-Cut (minus n i) = (S (minus n (S i))).
-Intro.
-Pattern 2 (minus n i); Rewrite H1.
-Repeat Rewrite H0; Unfold Rdiv; Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
-Rewrite <- H1; Rewrite (Rmult_sym ``/(INR (minus n i))``); Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym (INR (minus n i))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Ring.
-Apply not_O_INR; Apply minus_neq_O; Assumption.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Apply INR_fact_neq_0.
-Rewrite minus_Sn_m.
-Simpl; Reflexivity.
-Apply lt_le_S; Assumption.
-Intro; Reflexivity.
-Qed.
-
-(**********)
-Lemma pascal : (n,i:nat) (lt i n) -> ``(C n i)+(C n (S i))==(C (S n) (S i))``.
-Intros.
-Rewrite pascal_step3; [Idtac | Assumption].
-Replace ``(C n i)+(INR (minus n i))/(INR (S i))*(C n i)`` with ``(C n i)*(1+(INR (minus n i))/(INR (S i)))``; [Idtac | Ring].
-Replace ``1+(INR (minus n i))/(INR (S i))`` with ``(INR (S n))/(INR (S i))``.
-Rewrite pascal_step1.
-Rewrite Rmult_sym; Replace (S i) with (minus (S n) (minus n i)).
-Rewrite <- pascal_step2.
-Apply pascal_step1.
-Apply le_trans with n.
-Apply le_minusni_n.
-Apply lt_le_weak; Assumption.
-Apply le_n_Sn.
-Apply le_minusni_n.
-Apply lt_le_weak; Assumption.
-Rewrite <- minus_Sn_m.
-Cut (minus n (minus n i))=i.
-Intro; Rewrite H0; Reflexivity.
-Symmetry; Apply plus_minus.
-Rewrite plus_sym; Rewrite le_plus_minus_r.
-Reflexivity.
-Apply lt_le_weak; Assumption.
-Apply le_minusni_n; Apply lt_le_weak; Assumption.
-Apply lt_le_weak; Assumption.
-Unfold Rdiv.
-Repeat Rewrite S_INR.
-Rewrite minus_INR.
-Cut ``((INR i)+1)<>0``.
-Intro.
-Apply r_Rmult_mult with ``(INR i)+1``; [Idtac | Assumption].
-Rewrite Rmult_Rplus_distr.
-Rewrite Rmult_1r.
-Do 2 Rewrite (Rmult_sym ``(INR i)+1``).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym; [Idtac | Assumption].
-Ring.
-Rewrite <- S_INR.
-Apply not_O_INR; Discriminate.
-Apply lt_le_weak; Assumption.
-Qed.
-
-(*********************)
-(*********************)
-Lemma binomial : (x,y:R;n:nat) ``(pow (x+y) n)``==(sum_f_R0 [i:nat]``(C n i)*(pow x i)*(pow y (minus n i))`` n).
-Intros; Induction n.
-Unfold C; Simpl; Unfold Rdiv; Repeat Rewrite Rmult_1r; Rewrite Rinv_R1; Ring.
-Pattern 1 (S n); Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add; Rewrite Hrecn.
-Replace ``(pow (x+y) (S O))`` with ``x+y``; [Idtac | Simpl; Ring].
-Rewrite tech5.
-Cut (p:nat)(C p p)==R1.
-Cut (p:nat)(C p O)==R1.
-Intros; Rewrite H0; Rewrite <- minus_n_n; Rewrite Rmult_1l.
-Replace (pow y O) with R1; [Rewrite Rmult_1r | Simpl; Reflexivity].
-Induction n.
-Simpl; Do 2 Rewrite H; Ring.
-(* N >= 1 *)
-Pose N := (S n).
-Rewrite Rmult_Rplus_distr.
-Replace (Rmult (sum_f_R0 ([i:nat]``(C N i)*(pow x i)*(pow y (minus N i))``) N) x) with (sum_f_R0 [i:nat]``(C N i)*(pow x (S i))*(pow y (minus N i))`` N).
-Replace (Rmult (sum_f_R0 ([i:nat]``(C N i)*(pow x i)*(pow y (minus N i))``) N) y) with (sum_f_R0 [i:nat]``(C N i)*(pow x i)*(pow y (minus (S N) i))`` N).
-Rewrite (decomp_sum [i:nat]``(C (S N) i)*(pow x i)*(pow y (minus (S N) i))`` N).
-Rewrite H; Replace (pow x O) with R1; [Idtac | Reflexivity].
-Do 2 Rewrite Rmult_1l.
-Replace (minus (S N) O) with (S N); [Idtac | Reflexivity].
-Pose An := [i:nat]``(C N i)*(pow x (S i))*(pow y (minus N i))``.
-Pose Bn := [i:nat]``(C N (S i))*(pow x (S i))*(pow y (minus N i))``.
-Replace (pred N) with n.
-Replace (sum_f_R0 ([i:nat]``(C (S N) (S i))*(pow x (S i))*(pow y (minus (S N) (S i)))``) n) with (sum_f_R0 [i:nat]``(An i)+(Bn i)`` n).
-Rewrite plus_sum.
-Replace (pow x (S N)) with (An (S n)).
-Rewrite (Rplus_sym (sum_f_R0 An n)).
-Repeat Rewrite Rplus_assoc.
-Rewrite <- tech5.
-Fold N.
-Pose Cn := [i:nat]``(C N i)*(pow x i)*(pow y (minus (S N) i))``.
-Cut (i:nat) (lt i N)-> (Cn (S i))==(Bn i).
-Intro; Replace (sum_f_R0 Bn n) with (sum_f_R0 [i:nat](Cn (S i)) n).
-Replace (pow y (S N)) with (Cn O).
-Rewrite <- Rplus_assoc; Rewrite (decomp_sum Cn N).
-Replace (pred N) with n.
-Ring.
-Unfold N; Simpl; Reflexivity.
-Unfold N; Apply lt_O_Sn.
-Unfold Cn; Rewrite H; Simpl; Ring.
-Apply sum_eq.
-Intros; Apply H1.
-Unfold N; Apply le_lt_trans with n; [Assumption | Apply lt_n_Sn].
-Intros; Unfold Bn Cn.
-Replace (minus (S N) (S i)) with (minus N i); Reflexivity.
-Unfold An; Fold N; Rewrite <- minus_n_n; Rewrite H0; Simpl; Ring.
-Apply sum_eq.
-Intros; Unfold An Bn; Replace (minus (S N) (S i)) with (minus N i); [Idtac | Reflexivity].
-Rewrite <- pascal; [Ring | Apply le_lt_trans with n; [Assumption | Unfold N; Apply lt_n_Sn]].
-Unfold N; Reflexivity.
-Unfold N; Apply lt_O_Sn.
-Rewrite <- (Rmult_sym y); Rewrite scal_sum; Apply sum_eq.
-Intros; Replace (minus (S N) i) with (S (minus N i)).
-Replace (S (minus N i)) with (plus (minus N i) (1)); [Idtac | Ring].
-Rewrite pow_add; Replace (pow y (S O)) with y; [Idtac | Simpl; Ring]; Ring.
-Apply minus_Sn_m; Assumption.
-Rewrite <- (Rmult_sym x); Rewrite scal_sum; Apply sum_eq.
-Intros; Replace (S i) with (plus i (1)); [Idtac | Ring]; Rewrite pow_add; Replace (pow x (S O)) with x; [Idtac | Simpl; Ring]; Ring.
-Intro; Unfold C.
-Replace (INR (fact O)) with R1; [Idtac | Reflexivity].
-Replace (minus p O) with p; [Idtac | Apply minus_n_O].
-Rewrite Rmult_1l; Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | Apply INR_fact_neq_0].
-Intro; Unfold C.
-Replace (minus p p) with O; [Idtac | Apply minus_n_n].
-Replace (INR (fact O)) with R1; [Idtac | Reflexivity].
-Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | Apply INR_fact_neq_0].
-Qed.
diff --git a/theories7/Reals/Cauchy_prod.v b/theories7/Reals/Cauchy_prod.v
deleted file mode 100644
index 9442eff0..00000000
--- a/theories7/Reals/Cauchy_prod.v
+++ /dev/null
@@ -1,347 +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: Cauchy_prod.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require PartSum.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(**********)
-Lemma sum_N_predN : (An:nat->R;N:nat) (lt O N) -> (sum_f_R0 An N)==``(sum_f_R0 An (pred N)) + (An N)``.
-Intros.
-Replace N with (S (pred N)).
-Rewrite tech5.
-Reflexivity.
-Symmetry; Apply S_pred with O; Assumption.
-Qed.
-
-(**********)
-Lemma sum_plus : (An,Bn:nat->R;N:nat) (sum_f_R0 [l:nat]``(An l)+(Bn l)`` N)==``(sum_f_R0 An N)+(sum_f_R0 Bn N)``.
-Intros.
-Induction N.
-Reflexivity.
-Do 3 Rewrite tech5.
-Rewrite HrecN; Ring.
-Qed.
-
-(* The main result *)
-Theorem cauchy_finite : (An,Bn:nat->R;N:nat) (lt O N) -> (Rmult (sum_f_R0 An N) (sum_f_R0 Bn N)) == (Rplus (sum_f_R0 [k:nat](sum_f_R0 [p:nat]``(An p)*(Bn (minus k p))`` k) N) (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N))). 
-Intros; Induction N.
-Elim (lt_n_n ? H).
-Cut N=O\/(lt O N).
-Intro; Elim H0; Intro.
-Rewrite H1; Simpl; Ring.
-Replace (pred (S N)) with (S (pred N)).
-Do 5 Rewrite tech5.
-Rewrite Rmult_Rplus_distrl; Rewrite Rmult_Rplus_distr; Rewrite (HrecN H1).
-Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Replace (pred (minus (S N) (S (pred N)))) with (O).
-Rewrite Rmult_Rplus_distr; Replace (sum_f_R0 [l:nat]``(An (S (plus l (S (pred N)))))*(Bn (minus (S N) l))`` O) with ``(An (S N))*(Bn (S N))``.
-Repeat Rewrite <- Rplus_assoc; Do 2 Rewrite <- (Rplus_sym ``(An (S N))*(Bn (S N))``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Rewrite <- minus_n_n; Cut N=(1)\/(le (2) N).
-Intro; Elim H2; Intro.
-Rewrite H3; Simpl; Ring.
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))) (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N))).
-Replace (sum_f_R0 [p:nat]``(An p)*(Bn (minus (S N) p))`` N) with (Rplus (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N)) ``(An O)*(Bn (S N))``).
-Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N))); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus (S N) l))`` (pred (minus (S N) k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) (Rmult (Bn (S N)) (sum_f_R0 [l:nat](An (S l)) (pred N)))).
-Rewrite (decomp_sum An N H1); Rewrite Rmult_Rplus_distrl; Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym ``(An O)*(Bn (S N))``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym (Rmult (sum_f_R0 [i:nat](An (S i)) (pred N)) (Bn (S N)))); Rewrite <- (Rplus_sym (Rmult (Bn (S N)) (sum_f_R0 [i:nat](An (S i)) (pred N)))); Rewrite (Rmult_sym (Bn (S N))); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))) (Rmult (An (S N)) (sum_f_R0 [l:nat](Bn (S l)) (pred N)))).
-Rewrite (decomp_sum Bn N H1); Rewrite Rmult_Rplus_distr.
-Pose Z := (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))); Pose Z2 := (sum_f_R0 [i:nat](Bn (S i)) (pred N)); Ring.
-Rewrite (sum_N_predN [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)).
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred (pred N))) with (sum_f_R0 [k:nat](Rplus (sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) ``(An (S N))*(Bn (S k))``) (pred (pred N))).
-Rewrite (sum_plus [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) [k:nat]``(An (S N))*(Bn (S k))`` (pred (pred N))).
-Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Replace (pred (minus N (pred N))) with O.
-Simpl; Rewrite <- minus_n_O.
-Replace (S (pred N)) with N.
-Replace (sum_f_R0 [k:nat]``(An (S N))*(Bn (S k))`` (pred (pred N))) with (sum_f_R0 [k:nat]``(Bn (S k))*(An (S N))`` (pred (pred N))).
-Rewrite <- (scal_sum [l:nat](Bn (S l)) (pred (pred N)) (An (S N))); Rewrite (sum_N_predN [l:nat](Bn (S l)) (pred N)).
-Replace (S (pred N)) with N.
-Ring.
-Apply S_pred with O; Assumption.
-Apply lt_pred; Apply lt_le_trans with (2); [Apply lt_n_Sn | Assumption].
-Apply sum_eq; Intros; Apply Rmult_sym.
-Apply S_pred with O; Assumption.
-Replace (minus N (pred N)) with (1).
-Reflexivity.
-Pattern 1 N; Replace N with (S (pred N)).
-Rewrite <- minus_Sn_m.
-Rewrite <- minus_n_n; Reflexivity.
-Apply le_n.
-Symmetry; Apply S_pred with O; Assumption.
-Apply sum_eq; Intros; Rewrite (sum_N_predN [l:nat]``(An (S (S (plus l i))))*(Bn (minus N l))`` (pred (minus N i))).
-Replace (S (S (plus (pred (minus N i)) i))) with (S N).
-Replace (minus N (pred (minus N i))) with (S i).
-Ring.
-Rewrite pred_of_minus; Apply INR_eq; Repeat Rewrite minus_INR.
-Rewrite S_INR; Ring.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply INR_le; Rewrite minus_INR.
-Apply Rle_anti_compatibility with ``(INR i)-1``.
-Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
-Replace ``(INR i)-1+((INR N)-(INR i))`` with ``(INR N)-(INR (S O))``; [Idtac | Ring].
-Rewrite <- minus_INR.
-Apply le_INR; Apply le_trans with (pred (pred N)).
-Assumption.
-Rewrite <- pred_of_minus; Apply le_pred_n.
-Apply le_trans with (2).
-Apply le_n_Sn.
-Assumption.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Rewrite <- pred_of_minus.
-Apply le_trans with (pred N).
-Apply le_S_n.
-Replace (S (pred N)) with N.
-Replace (S (pred (minus N i))) with (minus N i).
-Apply simpl_le_plus_l with i; Rewrite le_plus_minus_r.
-Apply le_plus_r.
-Apply le_trans with (pred (pred N)); [Assumption | Apply le_trans with (pred N); Apply le_pred_n].
-Apply S_pred with O.
-Apply simpl_lt_plus_l with i; Rewrite le_plus_minus_r.
-Replace (plus i O) with i; [Idtac | Ring].
-Apply le_lt_trans with (pred (pred N)); [Assumption | Apply lt_trans with (pred N); Apply lt_pred_n_n].
-Apply lt_S_n.
-Replace (S (pred N)) with N.
-Apply lt_le_trans with (2).
-Apply lt_n_Sn.
-Assumption.
-Apply S_pred with O; Assumption.
-Assumption.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply S_pred with O; Assumption.
-Apply le_pred_n.
-Apply INR_eq; Rewrite pred_of_minus; Do 3 Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite minus_INR.
-Ring.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply INR_le.
-Rewrite minus_INR.
-Apply Rle_anti_compatibility with ``(INR i)-1``.
-Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
-Replace ``(INR i)-1+((INR N)-(INR i))`` with ``(INR N)-(INR (S O))``; [Idtac | Ring].
-Rewrite <- minus_INR.
-Apply le_INR.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Rewrite <- pred_of_minus.
-Apply le_pred_n.
-Apply le_trans with (2).
-Apply le_n_Sn.
-Assumption.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Apply INR_le.
-Rewrite pred_of_minus.
-Repeat Rewrite minus_INR.
-Apply Rle_anti_compatibility with ``(INR i)-1``.
-Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
-Replace ``(INR i)-1+((INR N)-(INR i)-(INR (S O)))`` with ``(INR N)-(INR (S O)) -(INR (S O))``.
-Repeat Rewrite <- minus_INR.
-Apply le_INR.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Do 2 Rewrite <- pred_of_minus.
-Apply le_n.
-Apply simpl_le_plus_l with (1).
-Rewrite le_plus_minus_r.
-Simpl; Assumption.
-Apply le_trans with (2); [Apply le_n_Sn | Assumption].
-Apply le_trans with (2); [Apply le_n_Sn | Assumption].
-Ring.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply simpl_le_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i (1)) with (S i).
-Replace N with (S (pred N)).
-Apply le_n_S.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_pred_n.
-Symmetry; Apply S_pred with O; Assumption.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Reflexivity.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Apply le_S_n.
-Replace (S (pred N)) with N.
-Assumption.
-Apply S_pred with O; Assumption.
-Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus (S N) l))`` (pred (minus (S N) k))) (pred N)) with (sum_f_R0 [k:nat](Rplus (sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) ``(An (S k))*(Bn (S N))``) (pred N)).
-Rewrite (sum_plus [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) [k:nat]``(An (S k))*(Bn (S N))``).
-Apply Rplus_plus_r.
-Rewrite scal_sum; Reflexivity.
-Apply sum_eq; Intros; Rewrite Rplus_sym; Rewrite (decomp_sum [l:nat]``(An (S (plus l i)))*(Bn (minus (S N) l))`` (pred (minus (S N) i))).
-Replace (plus O i) with i; [Idtac | Ring].
-Rewrite <- minus_n_O; Apply Rplus_plus_r.
-Replace (pred (pred (minus (S N) i))) with (pred (minus N i)).
-Apply sum_eq; Intros.
-Replace (minus (S N) (S i0)) with (minus N i0); [Idtac | Reflexivity].
-Replace (plus (S i0) i) with (S (plus i0 i)).
-Reflexivity.
-Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring.
-Cut (minus N i)=(pred (minus (S N) i)).
-Intro; Rewrite H5; Reflexivity.
-Rewrite pred_of_minus.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Rewrite S_INR; Ring.
-Apply le_trans with N.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply simpl_le_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i (1)) with (S i).
-Apply le_n_S.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_trans with N.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Replace (pred (minus (S N) i)) with (minus (S N) (S i)).
-Replace (minus (S N) (S i)) with (minus N i); [Idtac | Reflexivity].
-Apply simpl_lt_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i O) with i; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n.
-Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Rewrite pred_of_minus.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Repeat Rewrite S_INR; Ring.
-Apply le_trans with N.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply simpl_le_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i (1)) with (S i).
-Apply le_n_S.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_trans with N.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply le_n_S.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Rewrite Rplus_sym.
-Rewrite (decomp_sum [p:nat]``(An p)*(Bn (minus (S N) p))`` N).
-Rewrite <- minus_n_O.
-Apply Rplus_plus_r.
-Apply sum_eq; Intros.
-Reflexivity.
-Assumption.
-Rewrite Rplus_sym.
-Rewrite (decomp_sum [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N)).
-Rewrite <- minus_n_O.
-Replace (sum_f_R0 [l:nat]``(An (S (plus l O)))*(Bn (minus N l))`` (pred N)) with (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N)).
-Apply Rplus_plus_r.
-Apply sum_eq; Intros.
-Replace (pred (minus N (S i))) with (pred (pred (minus N i))).
-Apply sum_eq; Intros.
-Replace (plus i0 (S i)) with (S (plus i0 i)).
-Reflexivity.
-Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring.
-Cut (pred (minus N i))=(minus N (S i)).
-Intro; Rewrite H5; Reflexivity.
-Rewrite pred_of_minus.
-Apply INR_eq.
-Repeat Rewrite minus_INR.
-Repeat Rewrite S_INR; Ring.
-Apply le_trans with (S (pred (pred N))).
-Apply le_n_S; Assumption.
-Replace (S (pred (pred N))) with (pred N).
-Apply le_pred_n.
-Apply S_pred with O.
-Apply lt_S_n.
-Replace (S (pred N)) with N.
-Apply lt_le_trans with (2).
-Apply lt_n_Sn.
-Assumption.
-Apply S_pred with O; Assumption.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply simpl_le_plus_l with i.
-Rewrite le_plus_minus_r.
-Replace (plus i (1)) with (S i).
-Replace N with (S (pred N)).
-Apply le_n_S.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_pred_n.
-Symmetry; Apply S_pred with O; Assumption.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_trans with (pred (pred N)).
-Assumption.
-Apply le_trans with (pred N); Apply le_pred_n.
-Apply sum_eq; Intros.
-Replace (plus i O) with i; [Reflexivity | Trivial].
-Apply lt_S_n.
-Replace (S (pred N)) with N.
-Apply lt_le_trans with (2); [Apply lt_n_Sn | Assumption].
-Apply S_pred with O; Assumption.
-Inversion H1.
-Left; Reflexivity.
-Right; Apply le_n_S; Assumption.
-Simpl.
-Replace (S (pred N)) with N.
-Reflexivity.
-Apply S_pred with O; Assumption.
-Simpl.
-Cut (minus N (pred N))=(1).
-Intro; Rewrite H2; Reflexivity.
-Rewrite pred_of_minus.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Ring.
-Apply lt_le_S; Assumption.
-Rewrite <- pred_of_minus; Apply le_pred_n.
-Simpl; Symmetry; Apply S_pred with O; Assumption.
-Inversion H.
-Left; Reflexivity.
-Right; Apply lt_le_trans with (1); [Apply lt_n_Sn | Exact H1].
-Qed.
diff --git a/theories7/Reals/Cos_plus.v b/theories7/Reals/Cos_plus.v
deleted file mode 100644
index 481e51bf..00000000
--- a/theories7/Reals/Cos_plus.v
+++ /dev/null
@@ -1,1017 +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: Cos_plus.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo_def.
-Require Cos_rel.
-Require Max.
-V7only [Import nat_scope.]. Open Local Scope nat_scope.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Definition Majxy [x,y:R] : nat->R := [n:nat](Rdiv (pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (4) (S n))) (INR (fact n))).
-
-Lemma Majxy_cv_R0 : (x,y:R) (Un_cv (Majxy x y) R0).
-Intros.
-Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
-Pose C0 := (pow C (4)).
-Cut ``0<C``.
-Intro.
-Cut ``0<C0``.
-Intro.
-Assert H1 := (cv_speed_pow_fact C0).
-Unfold Un_cv in H1; Unfold R_dist in H1.
-Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<eps/C0``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption]].
-Elim (H1 ``eps/C0`` H3); Intros N0 H4.
-Exists N0; Intros.
-Replace (Majxy x y n) with ``(pow C0 (S n))/(INR (fact n))``.
-Simpl.
-Apply Rlt_monotony_contra with ``(Rabsolu (/C0))``.
-Apply Rabsolu_pos_lt.
-Apply Rinv_neq_R0.
-Red; Intro; Rewrite H6 in H0; Elim (Rlt_antirefl ? H0).
-Rewrite <- Rabsolu_mult.
-Unfold Rminus; Rewrite Rmult_Rplus_distr.
-Rewrite Ropp_O; Rewrite Rmult_Or.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite (Rabsolu_right ``/C0``).
-Rewrite <- (Rmult_sym eps).
-Replace ``(pow C0 n)*/(INR (fact n))+0`` with ``(pow C0 n)*/(INR (fact n))-0``; [Idtac | Ring].
-Unfold Rdiv in H4; Apply H4; Assumption.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Assumption.
-Red; Intro; Rewrite H6 in H0; Elim (Rlt_antirefl ? H0).
-Unfold Majxy.
-Unfold C0.
-Rewrite pow_mult.
-Unfold C; Reflexivity.
-Unfold C0; Apply pow_lt; Assumption.
-Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C.
-Apply RmaxLess1.
-Qed.
-
-Lemma reste1_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste1 x y N))<=(Majxy x y (pred N))``.
-Intros.
-Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
-Unfold Reste1.
-Apply Rle_trans with (sum_f_R0
-     [k:nat]
-        (Rabsolu (sum_f_R0
-          [l:nat]
-           ``(pow ( -1) (S (plus l k)))/
-           (INR (fact (mult (S (S O)) (S (plus l k)))))*
-           (pow x (mult (S (S O)) (S (plus l k))))*
-           (pow ( -1) (minus N l))/
-           (INR (fact (mult (S (S O)) (minus N l))))*
-           (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))))
-     (pred N)).
-Apply (sum_Rabsolu [k:nat]
-        (sum_f_R0
-          [l:nat]
-           ``(pow ( -1) (S (plus l k)))/
-           (INR (fact (mult (S (S O)) (S (plus l k)))))*
-           (pow x (mult (S (S O)) (S (plus l k))))*
-           (pow ( -1) (minus N l))/
-           (INR (fact (mult (S (S O)) (minus N l))))*
-           (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))) (pred N)).
-Apply Rle_trans with (sum_f_R0
-     [k:nat]
-          (sum_f_R0
-            [l:nat]
-             (Rabsolu (``(pow ( -1) (S (plus l k)))/
-             (INR (fact (mult (S (S O)) (S (plus l k)))))*
-             (pow x (mult (S (S O)) (S (plus l k))))*
-             (pow ( -1) (minus N l))/
-             (INR (fact (mult (S (S O)) (minus N l))))*
-             (pow y (mult (S (S O)) (minus N l)))``)) (pred (minus N k)))
-     (pred N)).
-Apply sum_Rle.
-Intros.
-Apply (sum_Rabsolu [l:nat]
-        ``(pow ( -1) (S (plus l n)))/
-        (INR (fact (mult (S (S O)) (S (plus l n)))))*
-        (pow x (mult (S (S O)) (S (plus l n))))*
-        (pow ( -1) (minus N l))/
-        (INR (fact (mult (S (S O)) (minus N l))))*
-        (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N n))).
-Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (mult (fact (mult (S (S O)) (S (plus l k)))) (fact (mult (S (S O)) (minus N l)))))*(pow C (mult (S (S O)) (S (plus N k))))`` (pred (minus N k))) (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Unfold Rdiv; Repeat Rewrite Rabsolu_mult.
-Do 2 Rewrite pow_1_abs.
-Do 2 Rewrite Rmult_1l.
-Rewrite (Rabsolu_right ``/(INR (fact (mult (S (S O)) (S (plus n0 n)))))``).
-Rewrite (Rabsolu_right ``/(INR (fact (mult (S (S O)) (minus N n0))))``).
-Rewrite mult_INR.
-Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (minus N n0))))``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Do 2 Rewrite <- Pow_Rabsolu.
-Apply Rle_trans with ``(pow (Rabsolu x) (mult (S (S O)) (S (plus n0 n))))*(pow C (mult (S (S O)) (minus N n0)))``.
-Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Apply pow_incr.
-Split.
-Apply Rabsolu_pos.
-Unfold C.
-Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)); Apply RmaxLess2.
-Apply Rle_trans with ``(pow C (mult (S (S O)) (S (plus n0 n))))*(pow C (mult (S (S O)) (minus N n0)))``.
-Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S O)) (minus N n0)))``).
-Apply Rle_monotony.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Apply pow_incr.
-Split.
-Apply Rabsolu_pos.
-Unfold C; Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
-Apply RmaxLess1.
-Apply RmaxLess2.
-Right.
-Replace (mult (2) (S (plus N n))) with (plus (mult (2) (minus N n0)) (mult (2) (S (plus n0 n)))).
-Rewrite pow_add.
-Apply Rmult_sym.
-Apply INR_eq; Rewrite plus_INR; Do 3 Rewrite mult_INR.
-Rewrite minus_INR.
-Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Ring.
-Apply le_trans with (pred (minus N n)).
-Exact H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_trans with (sum_f_R0
-     [k:nat]
-        (sum_f_R0
-          [l:nat]
-           ``/(INR
-              (mult (fact (mult (S (S O)) (S (plus l k))))
-              (fact (mult (S (S O)) (minus N l)))))*
-           (pow C (mult (S (S (S (S O)))) N))`` (pred (minus N k)))
-     (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv.
-Rewrite mult_INR; Apply Rmult_lt_pos; Apply INR_fact_lt_0.
-Apply Rle_pow.
-Unfold C; Apply RmaxLess1.
-Replace (mult (4) N) with (mult (2) (mult (2) N)); [Idtac | Ring].
-Apply mult_le.
-Replace (mult (2) N) with (S (plus N (pred N))).
-Apply le_n_S.
-Apply le_reg_l; Assumption.
-Rewrite pred_of_minus.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Rewrite minus_INR.
-Repeat Rewrite S_INR; Ring.
-Apply lt_le_S; Assumption.
-Apply Rle_trans with (sum_f_R0
-     [k:nat]
-        (sum_f_R0
-          [l:nat]
-         ``(pow C (mult (S (S (S (S O)))) N))*(Rsqr (/(INR (fact (S (plus N k))))))`` (pred (minus N k)))
-     (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
-Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Replace ``/(INR
-      (mult (fact (mult (S (S O)) (S (plus n0 n))))
-      (fact (mult (S (S O)) (minus N n0)))))`` with ``(Binomial.C (mult (S (S O)) (S (plus N n))) (mult (S (S O)) (S (plus n0 n))))/(INR (fact (mult (S (S O)) (S (plus N n)))))``.
-Apply Rle_trans with ``(Binomial.C (mult (S (S O)) (S (plus N n))) (S (plus N n)))/(INR (fact (mult (S (S O)) (S (plus N n)))))``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S (plus N n)))))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply C_maj.
-Apply mult_le.
-Apply le_n_S.
-Apply le_reg_r.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Right.
-Unfold Rdiv; Rewrite Rmult_sym.
-Unfold Binomial.C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace (minus (mult (2) (S (plus N n))) (S (plus N n))) with (S (plus N n)).
-Rewrite Rinv_Rmult.
-Unfold Rsqr; Reflexivity.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Rewrite S_INR; Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_2n.
-Apply INR_fact_neq_0.
-Unfold Rdiv; Rewrite Rmult_sym.
-Unfold Binomial.C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace (minus (mult (2) (S (plus N n))) (mult (2) (S (plus n0 n)))) with (mult (2) (minus N n0)).
-Rewrite mult_INR.
-Reflexivity.
-Apply INR_eq; Rewrite minus_INR.
-Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite minus_INR.
-Ring.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply mult_le.
-Apply le_n_S.
-Apply le_reg_r.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_fact_neq_0.
-Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)/(INR (fact (S N)))*(pow C (mult (S (S (S (S O)))) N))`` (pred N)).
-Apply sum_Rle; Intros.
-Rewrite <- (scal_sum [_:nat]``(pow C (mult (S (S (S (S O)))) N))`` (pred (minus N n)) ``(Rsqr (/(INR (fact (S (plus N n))))))``).
-Rewrite sum_cte.
-Rewrite <- Rmult_assoc.
-Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Apply Rle_trans with ``(Rsqr (/(INR (fact (S (plus N n))))))*(INR N)``.
-Apply Rle_monotony.
-Apply pos_Rsqr.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_INR.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Rewrite Rmult_sym; Unfold Rdiv; Apply Rle_monotony.
-Apply pos_INR.
-Apply Rle_trans with ``/(INR (fact (S (plus N n))))``.
-Pattern 2 ``/(INR (fact (S (plus N n))))``; Rewrite <- Rmult_1r.
-Unfold Rsqr.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_monotony_contra with ``(INR (fact (S (plus N n))))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Replace R1 with (INR (S O)).
-Apply le_INR.
-Apply lt_le_S.
-Apply INR_lt; Apply INR_fact_lt_0.
-Reflexivity.
-Apply INR_fact_neq_0.
-Apply Rle_monotony_contra with ``(INR (fact (S (plus N n))))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with ``(INR (fact (S N)))``.
-Apply INR_fact_lt_0.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym (INR (fact (S N)))).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Apply le_INR.
-Apply fact_growing.
-Apply le_n_S.
-Apply le_plus_l.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Rewrite sum_cte.
-Apply Rle_trans with ``(pow C (mult (S (S (S (S O)))) N))/(INR (fact (pred N)))``.
-Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
-Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Cut (S (pred N)) = N.
-Intro; Rewrite H0.
-Pattern 2 N; Rewrite <- H0.
-Do 2 Rewrite fact_simpl.
-Rewrite H0.
-Repeat Rewrite mult_INR.
-Repeat Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym ``/(INR (S N))``).
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Pattern 2 ``/(INR (fact (pred N)))``; Rewrite <- Rmult_1r.
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_monotony_contra with (INR (S N)).
-Apply lt_INR_0; Apply lt_O_Sn.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite Rmult_1l.
-Apply le_INR; Apply le_n_Sn.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR.
-Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
-Apply not_O_INR.
-Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply prod_neq_R0.
-Apply not_O_INR.
-Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
-Apply INR_fact_neq_0.
-Symmetry; Apply S_pred with O; Assumption.
-Right.
-Unfold Majxy.
-Unfold C.
-Replace (S (pred N)) with N.
-Reflexivity.
-Apply S_pred with O; Assumption.
-Qed.
-
-Lemma reste2_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste2 x y N))<=(Majxy x y N)``.
-Intros.
-Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
-Unfold Reste2.
-Apply Rle_trans with (sum_f_R0
-     [k:nat]
-        (Rabsolu (sum_f_R0
-          [l:nat]
-           ``(pow ( -1) (S (plus l k)))/
-           (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
-           (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
-           (pow ( -1) (minus N l))/
-           (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
-           (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))))
-     (pred N)).
-Apply (sum_Rabsolu [k:nat]
-        (sum_f_R0
-          [l:nat]
-           ``(pow ( -1) (S (plus l k)))/
-           (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
-           (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
-           (pow ( -1) (minus N l))/
-           (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
-           (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))) (pred N)).
-Apply Rle_trans with (sum_f_R0
-     [k:nat]
-          (sum_f_R0
-            [l:nat]
-             (Rabsolu (``(pow ( -1) (S (plus l k)))/
-             (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
-             (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
-             (pow ( -1) (minus N l))/
-             (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
-             (pow y (plus (mult (S (S O)) (minus N l)) (S O)))``)) (pred (minus N k)))
-     (pred N)).
-Apply sum_Rle.
-Intros.
-Apply (sum_Rabsolu [l:nat]
-        ``(pow ( -1) (S (plus l n)))/
-        (INR (fact (plus (mult (S (S O)) (S (plus l n))) (S O))))*
-        (pow x (plus (mult (S (S O)) (S (plus l n))) (S O)))*
-        (pow ( -1) (minus N l))/
-        (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
-        (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N n))).
-Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (mult (fact (plus (mult (S (S O)) (S (plus l k))) (S O))) (fact (plus (mult (S (S O)) (minus N l)) (S O)))))*(pow C (mult (S (S O)) (S (S (plus N k)))))`` (pred (minus N k))) (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Unfold Rdiv; Repeat Rewrite Rabsolu_mult.
-Do 2 Rewrite pow_1_abs.
-Do 2 Rewrite Rmult_1l.
-Rewrite (Rabsolu_right ``/(INR (fact (plus (mult (S (S O)) (S (plus n0 n))) (S O))))``).
-Rewrite (Rabsolu_right ``/(INR (fact (plus (mult (S (S O)) (minus N n0)) (S O))))``).
-Rewrite mult_INR.
-Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym ``/(INR (fact (plus (mult (S (S O)) (minus N n0)) (S O))))``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Do 2 Rewrite <- Pow_Rabsolu.
-Apply Rle_trans with ``(pow (Rabsolu x) (plus (mult (S (S O)) (S (plus n0 n))) (S O)))*(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``.
-Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Apply pow_incr.
-Split.
-Apply Rabsolu_pos.
-Unfold C.
-Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)); Apply RmaxLess2.
-Apply Rle_trans with ``(pow C (plus (mult (S (S O)) (S (plus n0 n))) (S O)))*(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``.
-Do 2 Rewrite <- (Rmult_sym ``(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``).
-Apply Rle_monotony.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Apply pow_incr.
-Split.
-Apply Rabsolu_pos.
-Unfold C; Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
-Apply RmaxLess1.
-Apply RmaxLess2.
-Right.
-Replace (mult (2) (S (S (plus N n)))) with (plus (plus (mult (2) (minus N n0)) (S O)) (plus (mult (2) (S (plus n0 n))) (S O))).
-Repeat Rewrite pow_add.
-Ring.
-Apply INR_eq; Repeat Rewrite plus_INR; Do 3 Rewrite mult_INR.
-Rewrite minus_INR.
-Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Ring.
-Apply le_trans with (pred (minus N n)).
-Exact H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Apply INR_fact_lt_0.
-Apply Rle_trans with (sum_f_R0
-     [k:nat]
-        (sum_f_R0
-          [l:nat]
-           ``/(INR
-              (mult (fact (plus (mult (S (S O)) (S (plus l k))) (S O)))
-              (fact (plus (mult (S (S O)) (minus N l)) (S O)))))*
-           (pow C (mult (S (S (S (S O)))) (S N)))`` (pred (minus N k)))
-     (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv.
-Rewrite mult_INR; Apply Rmult_lt_pos; Apply INR_fact_lt_0.
-Apply Rle_pow.
-Unfold C; Apply RmaxLess1.
-Replace (mult (4) (S N)) with (mult (2) (mult (2) (S N))); [Idtac | Ring].
-Apply mult_le.
-Replace (mult (2) (S N)) with (S (S (plus N N))).
-Repeat Apply le_n_S.
-Apply le_reg_l.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_eq; Do 2Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR.
-Repeat Rewrite S_INR; Ring.
-Apply Rle_trans with (sum_f_R0
-     [k:nat]
-        (sum_f_R0
-          [l:nat]
-         ``(pow C (mult (S (S (S (S O)))) (S N)))*(Rsqr (/(INR (fact (S (S (plus N k)))))))`` (pred (minus N k)))
-     (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
-Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Replace ``/(INR
-      (mult (fact (plus (mult (S (S O)) (S (plus n0 n))) (S O)))
-      (fact (plus (mult (S (S O)) (minus N n0)) (S O)))))`` with ``(Binomial.C (mult (S (S O)) (S (S (plus N n)))) (plus (mult (S (S O)) (S (plus n0 n))) (S O)))/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``.
-Apply Rle_trans with ``(Binomial.C (mult (S (S O)) (S (S (plus N n)))) (S (S (plus N n))))/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply C_maj.
-Apply le_trans with (mult (2) (S (S (plus n0 n)))).
-Replace (mult (2) (S (S (plus n0 n)))) with (S (plus (mult (2) (S (plus n0 n))) (1))).
-Apply le_n_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply mult_le.
-Repeat Apply le_n_S.
-Apply le_reg_r.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Right.
-Unfold Rdiv; Rewrite Rmult_sym.
-Unfold Binomial.C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace (minus (mult (2) (S (S (plus N n)))) (S (S (plus N n)))) with (S (S (plus N n))).
-Rewrite Rinv_Rmult.
-Unfold Rsqr; Reflexivity.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Do 2 Rewrite S_INR; Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_2n.
-Apply INR_fact_neq_0.
-Unfold Rdiv; Rewrite Rmult_sym.
-Unfold Binomial.C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace (minus (mult (2) (S (S (plus N n)))) (plus (mult (2) (S (plus n0 n))) (S O))) with (plus (mult (2) (minus N n0)) (S O)).
-Rewrite mult_INR.
-Reflexivity.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite plus_INR; Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite minus_INR.
-Ring.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_trans with (mult (2) (S (S (plus n0 n)))).
-Replace (mult (2) (S (S (plus n0 n)))) with (S (plus (mult (2) (S (plus n0 n))) (1))).
-Apply le_n_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply mult_le.
-Repeat Apply le_n_S.
-Apply le_reg_r.
-Apply le_trans with (pred (minus N n)).
-Assumption.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply INR_fact_neq_0.
-Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)/(INR (fact (S (S N))))*(pow C (mult (S (S (S (S O)))) (S N)))`` (pred N)).
-Apply sum_Rle; Intros.
-Rewrite <- (scal_sum [_:nat]``(pow C (mult (S (S (S (S O)))) (S N)))`` (pred (minus N n)) ``(Rsqr (/(INR (fact (S (S (plus N n)))))))``).
-Rewrite sum_cte.
-Rewrite <- Rmult_assoc.
-Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Apply Rle_trans with ``(Rsqr (/(INR (fact (S (S (plus N n)))))))*(INR N)``.
-Apply Rle_monotony.
-Apply pos_Rsqr.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_INR.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n O) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Assumption.
-Apply lt_pred_n_n; Assumption.
-Apply le_trans with (pred N).
-Assumption.
-Apply le_pred_n.
-Rewrite Rmult_sym; Unfold Rdiv; Apply Rle_monotony.
-Apply pos_INR.
-Apply Rle_trans with ``/(INR (fact (S (S (plus N n)))))``.
-Pattern 2 ``/(INR (fact (S (S (plus N n)))))``; Rewrite <- Rmult_1r.
-Unfold Rsqr.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_monotony_contra with ``(INR (fact (S (S (plus N n)))))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Replace R1 with (INR (S O)).
-Apply le_INR.
-Apply lt_le_S.
-Apply INR_lt; Apply INR_fact_lt_0.
-Reflexivity.
-Apply INR_fact_neq_0.
-Apply Rle_monotony_contra with ``(INR (fact (S (S (plus N n)))))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with ``(INR (fact (S (S N))))``.
-Apply INR_fact_lt_0.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym (INR (fact (S (S N))))).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Apply le_INR.
-Apply fact_growing.
-Repeat Apply le_n_S.
-Apply le_plus_l.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Rewrite sum_cte.
-Apply Rle_trans with ``(pow C (mult (S (S (S (S O)))) (S N)))/(INR (fact N))``.
-Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
-Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le.
-Left; Apply Rlt_le_trans with R1.
-Apply Rlt_R0_R1.
-Unfold C; Apply RmaxLess1.
-Cut (S (pred N)) = N.
-Intro; Rewrite H0.
-Do 2 Rewrite fact_simpl.
-Repeat Rewrite mult_INR.
-Repeat Rewrite Rinv_Rmult.
-Apply Rle_trans with ``(INR (S (S N)))*(/(INR (S (S N)))*(/(INR (S N))*/(INR (fact N))))*
-   (INR N)``.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (INR N)).
-Rewrite (Rmult_sym (INR (S (S N)))).
-Apply Rle_monotony.
-Repeat Apply Rmult_le_pos.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
-Left; Apply Rlt_Rinv.
-Apply INR_fact_lt_0.
-Apply pos_INR.
-Apply le_INR.
-Apply le_trans with (S N); Apply le_n_Sn.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Apply Rle_trans with ``/(INR (S N))*/(INR (fact N))*(INR (S N))``.
-Repeat Rewrite Rmult_assoc.
-Repeat Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply le_INR; Apply le_n_Sn.
-Rewrite (Rmult_sym ``/(INR (S N))``).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Right; Reflexivity.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Symmetry; Apply S_pred with O; Assumption.
-Right.
-Unfold Majxy.
-Unfold C.
-Reflexivity.
-Qed.
-
-Lemma reste1_cv_R0 : (x,y:R) (Un_cv (Reste1 x y) R0).
-Intros.
-Assert H := (Majxy_cv_R0 x y).
-Unfold Un_cv in H; Unfold R_dist in H.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H eps H0); Intros N0 H1.
-Exists (S N0); Intros.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
-Apply Rle_lt_trans with (Rabsolu (Majxy x y (pred n))).
-Rewrite (Rabsolu_right (Majxy x y (pred n))).
-Apply reste1_maj.
-Apply lt_le_trans with (S N0).
-Apply lt_O_Sn.
-Assumption.
-Apply Rle_sym1.
-Unfold Majxy.
-Unfold Rdiv; Apply Rmult_le_pos.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Replace (Majxy x y (pred n)) with ``(Majxy x y (pred n))-0``; [Idtac | Ring].
-Apply H1.
-Unfold ge; Apply le_S_n.
-Replace (S (pred n)) with n.
-Assumption.
-Apply S_pred with O.
-Apply lt_le_trans with (S N0); [Apply lt_O_Sn | Assumption].
-Qed.
-
-Lemma reste2_cv_R0 : (x,y:R) (Un_cv (Reste2 x y) R0).
-Intros.
-Assert H := (Majxy_cv_R0 x y).
-Unfold Un_cv in H; Unfold R_dist in H.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H eps H0); Intros N0 H1.
-Exists (S N0); Intros.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
-Apply Rle_lt_trans with (Rabsolu (Majxy x y n)).
-Rewrite (Rabsolu_right (Majxy x y n)).
-Apply reste2_maj.
-Apply lt_le_trans with (S N0).
-Apply lt_O_Sn.
-Assumption.
-Apply Rle_sym1.
-Unfold Majxy.
-Unfold Rdiv; Apply Rmult_le_pos.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Replace (Majxy x y n) with ``(Majxy x y n)-0``; [Idtac | Ring].
-Apply H1.
-Unfold ge; Apply le_trans with (S N0).
-Apply le_n_Sn.
-Exact H2.
-Qed.
-
-Lemma reste_cv_R0 : (x,y:R) (Un_cv (Reste x y) R0).
-Intros.
-Unfold Reste.
-Pose An := [n:nat](Reste2 x y n).
-Pose Bn := [n:nat](Reste1 x y (S n)).
-Cut (Un_cv [n:nat]``(An n)-(Bn n)`` ``0-0``) -> (Un_cv [N:nat]``(Reste2 x y N)-(Reste1 x y (S N))`` ``0``).
-Intro.
-Apply H.
-Apply CV_minus.
-Unfold An.
-Replace [n:nat](Reste2 x y n) with (Reste2 x y).
-Apply reste2_cv_R0.
-Reflexivity.
-Unfold Bn.
-Assert H0 := (reste1_cv_R0 x y).
-Unfold Un_cv in H0; Unfold R_dist in H0.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H0 eps H1); Intros N0 H2.
-Exists N0; Intros.
-Apply H2.
-Unfold ge; Apply le_trans with (S N0).
-Apply le_n_Sn.
-Apply le_n_S; Assumption.
-Unfold An Bn.
-Intro.
-Replace R0 with ``0-0``; [Idtac | Ring].
-Exact H.
-Qed.
-
-Theorem cos_plus : (x,y:R) ``(cos (x+y))==(cos x)*(cos y)-(sin x)*(sin y)``. 
-Intros. 
-Cut (Un_cv (C1 x y) ``(cos x)*(cos y)-(sin x)*(sin y)``). 
-Cut (Un_cv (C1 x y) ``(cos (x+y))``). 
-Intros. 
-Apply UL_sequence with (C1 x y); Assumption. 
-Apply C1_cvg. 
-Unfold Un_cv; Unfold R_dist. 
-Intros. 
-Assert H0 := (A1_cvg x). 
-Assert H1 := (A1_cvg y). 
-Assert H2 := (B1_cvg x). 
-Assert H3 := (B1_cvg y). 
-Assert H4 := (CV_mult ? ? ? ? H0 H1). 
-Assert H5 := (CV_mult ? ? ? ? H2 H3). 
-Assert H6 := (reste_cv_R0 x y).
-Unfold Un_cv in H4; Unfold Un_cv in H5; Unfold Un_cv in H6.
-Unfold R_dist in H4; Unfold R_dist in H5; Unfold R_dist in H6. 
-Cut ``0<eps/3``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. 
-Elim (H4 ``eps/3`` H7); Intros N1 H8. 
-Elim (H5 ``eps/3`` H7); Intros N2 H9. 
-Elim (H6 ``eps/3`` H7); Intros N3 H10.
-Pose N := (S (S (max (max N1 N2) N3))). 
-Exists N. 
-Intros. 
-Cut n = (S (pred n)). 
-Intro; Rewrite H12. 
-Rewrite <- cos_plus_form. 
-Rewrite <- H12. 
-Apply Rle_lt_trans with ``(Rabsolu ((A1 x n)*(A1 y n)-(cos x)*(cos y)))+(Rabsolu ((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))+(Reste x y (pred n))))``. 
-Replace ``(A1 x n)*(A1 y n)-(B1 x (pred n))*(B1 y (pred n))+
-     (Reste x y (pred n))-((cos x)*(cos y)-(sin x)*(sin y))`` with ``((A1 x n)*(A1 y n)-(cos x)*(cos y))+((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))+(Reste x y (pred n)))``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``eps/3+(eps/3+eps/3)``.
-Apply Rplus_lt. 
-Apply H8. 
-Unfold ge; Apply le_trans with N. 
-Unfold N. 
-Apply le_trans with (max N1 N2). 
-Apply le_max_l. 
-Apply le_trans with (max (max N1 N2) N3).
-Apply le_max_l.
-Apply le_trans with (S (max (max N1 N2) N3)); Apply le_n_Sn.
-Assumption. 
-Apply Rle_lt_trans with ``(Rabsolu ((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))))+(Rabsolu (Reste x y (pred n)))``.
-Apply Rabsolu_triang.
-Apply Rplus_lt.
-Rewrite <- Rabsolu_Ropp. 
-Rewrite Ropp_distr2. 
-Apply H9. 
-Unfold ge; Apply le_trans with (max N1 N2). 
-Apply le_max_r. 
-Apply le_S_n. 
-Rewrite <- H12. 
-Apply le_trans with N.
-Unfold N.
-Apply le_n_S.
-Apply le_trans with (max (max N1 N2) N3).
-Apply le_max_l.
-Apply le_n_Sn.
-Assumption.
-Replace (Reste x y (pred n)) with ``(Reste x y (pred n))-0``.
-Apply H10.
-Unfold ge.
-Apply le_S_n.
-Rewrite <- H12.
-Apply le_trans with N.
-Unfold N.
-Apply le_n_S.
-Apply le_trans with (max (max N1 N2) N3).
-Apply le_max_r.
-Apply le_n_Sn.
-Assumption.
-Ring.
-Pattern 4 eps; Replace eps with ``3*eps/3``.
-Ring.
-Unfold Rdiv.
-Rewrite <- Rmult_assoc.
-Apply Rinv_r_simpl_m.
-DiscrR.
-Apply lt_le_trans with (pred N).
-Unfold N; Simpl; Apply lt_O_Sn.
-Apply le_S_n.
-Rewrite <- H12.
-Replace (S (pred N)) with N.
-Assumption.
-Unfold N; Simpl; Reflexivity.
-Cut (lt O N). 
-Intro. 
-Cut (lt O n). 
-Intro. 
-Apply S_pred with O; Assumption.
-Apply lt_le_trans with N; Assumption. 
-Unfold N; Apply lt_O_Sn.
-Qed.
diff --git a/theories7/Reals/Cos_rel.v b/theories7/Reals/Cos_rel.v
deleted file mode 100644
index e29825ab..00000000
--- a/theories7/Reals/Cos_rel.v
+++ /dev/null
@@ -1,360 +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: Cos_rel.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo_def.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Definition A1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))*(pow x (mult (S (S O)) k))`` N). 
- 
-Definition B1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow x (plus (mult (S (S O)) k) (S O)))`` N). 
- 
-Definition C1 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))*(pow (x+y) (mult (S (S O)) k))`` N). 
- 
-Definition Reste1 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow (-1) (S (plus l k)))/(INR (fact (mult (S (S O)) (S (plus l k)))))*(pow x (mult (S (S O)) (S (plus l k))))*(pow (-1) (minus N l))/(INR (fact (mult (S (S O)) (minus N l))))*(pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))) (pred N)).
-
-Definition Reste2 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow (-1) (S (plus l k)))/(INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*(pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*(pow (-1) (minus N l))/(INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*(pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))) (pred N)).
-
-Definition Reste [x,y:R] : nat -> R := [N:nat]``(Reste2 x y N)-(Reste1 x y (S N))``.
-
-(* Here is the main result that will be used to prove that (cos (x+y))=(cos x)(cos y)-(sin x)(sin y) *)
-Theorem cos_plus_form : (x,y:R;n:nat) (lt O n) -> ``(A1 x (S n))*(A1 y (S n))-(B1 x n)*(B1 y n)+(Reste x y n)``==(C1 x y (S n)). 
-Intros.
-Unfold A1 B1.
-Rewrite (cauchy_finite [k:nat]
-        ``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*
-        (pow x (mult (S (S O)) k))`` [k:nat]
-      ``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*
-      (pow y (mult (S (S O)) k))`` (S n)).
-Rewrite (cauchy_finite [k:nat]
-      ``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*
-      (pow x (plus (mult (S (S O)) k) (S O)))`` [k:nat]
-      ``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*
-      (pow y (plus (mult (S (S O)) k) (S O)))`` n H).
-Unfold Reste.
-Replace (sum_f_R0
-   [k:nat]
-      (sum_f_R0
-        [l:nat]
-         ``(pow ( -1) (S (plus l k)))/
-         (INR (fact (mult (S (S O)) (S (plus l k)))))*
-         (pow x (mult (S (S O)) (S (plus l k))))*
-         ((pow ( -1) (minus (S n) l))/
-         (INR (fact (mult (S (S O)) (minus (S n) l))))*
-         (pow y (mult (S (S O)) (minus (S n) l))))``
-        (pred (minus (S n) k))) (pred (S n))) with (Reste1 x y (S n)).
-Replace (sum_f_R0
-   [k:nat]
-      (sum_f_R0
-        [l:nat]
-         ``(pow ( -1) (S (plus l k)))/
-         (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
-         (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
-         ((pow ( -1) (minus n l))/
-         (INR (fact (plus (mult (S (S O)) (minus n l)) (S O))))*
-         (pow y (plus (mult (S (S O)) (minus n l)) (S O))))``
-        (pred (minus n k))) (pred n)) with (Reste2 x y n).
-Ring.
-Replace (sum_f_R0
-   [k:nat]
-      (sum_f_R0
-        [p:nat]
-         ``(pow ( -1) p)/(INR (fact (mult (S (S O)) p)))*
-         (pow x (mult (S (S O)) p))*((pow ( -1) (minus k p))/
-         (INR (fact (mult (S (S O)) (minus k p))))*
-         (pow y (mult (S (S O)) (minus k p))))`` k) (S n)) with (sum_f_R0 [k:nat](Rmult ``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))`` (sum_f_R0 [l:nat]``(C (mult (S (S O)) k) (mult (S (S O)) l))*(pow x (mult (S (S O)) l))*(pow y (mult (S (S O)) (minus k l)))`` k)) (S n)).
-Pose sin_nnn := [n:nat]Cases n of O => R0 | (S p) => (Rmult ``(pow (-1) (S p))/(INR (fact (mult (S (S O)) (S p))))`` (sum_f_R0 [l:nat]``(C (mult (S (S O)) (S p)) (S (mult (S (S O)) l)))*(pow x (S (mult (S (S O)) l)))*(pow y (S (mult (S (S O)) (minus p l))))`` p)) end.
-Replace (Ropp (sum_f_R0
-       [k:nat]
-          (sum_f_R0
-            [p:nat]
-             ``(pow ( -1) p)/
-             (INR (fact (plus (mult (S (S O)) p) (S O))))*
-             (pow x (plus (mult (S (S O)) p) (S O)))*
-             ((pow ( -1) (minus k p))/
-             (INR (fact (plus (mult (S (S O)) (minus k p)) (S O))))*
-             (pow y (plus (mult (S (S O)) (minus k p)) (S O))))`` k)
-       n)) with (sum_f_R0 sin_nnn (S n)).
-Rewrite <- sum_plus.
-Unfold C1.
-Apply sum_eq; Intros.
-Induction i.
-Simpl.
-Rewrite Rplus_Ol.
-Replace (C O O) with R1.
-Unfold Rdiv; Rewrite Rinv_R1.
-Ring.
-Unfold C.
-Rewrite <- minus_n_n.
-Simpl.
-Unfold Rdiv; Rewrite Rmult_1r; Rewrite Rinv_R1; Ring.
-Unfold sin_nnn.
-Rewrite <- Rmult_Rplus_distr.
-Apply Rmult_mult_r.
-Rewrite binomial.
-Pose Wn := [i0:nat]``(C (mult (S (S O)) (S i)) i0)*(pow x i0)*
-         (pow y (minus (mult (S (S O)) (S i)) i0))``.
-Replace (sum_f_R0
-   [l:nat]
-      ``(C (mult (S (S O)) (S i)) (mult (S (S O)) l))*
-      (pow x (mult (S (S O)) l))*
-      (pow y (mult (S (S O)) (minus (S i) l)))`` (S i)) with (sum_f_R0 [l:nat](Wn (mult (2) l)) (S i)).
-Replace (sum_f_R0
-     [l:nat]
-        ``(C (mult (S (S O)) (S i)) (S (mult (S (S O)) l)))*
-        (pow x (S (mult (S (S O)) l)))*
-        (pow y (S (mult (S (S O)) (minus i l))))`` i) with (sum_f_R0 [l:nat](Wn (S (mult (2) l))) i).
-Rewrite Rplus_sym.
-Apply sum_decomposition.
-Apply sum_eq; Intros.
-Unfold Wn.
-Apply Rmult_mult_r.
-Replace (minus (mult (2) (S i)) (S (mult (2) i0))) with (S (mult (2) (minus i i0))).
-Reflexivity.
-Apply INR_eq.
-Rewrite S_INR; Rewrite mult_INR.
-Repeat Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Replace (mult (2) (S i)) with (S (S (mult (2) i))).
-Apply le_n_S.
-Apply le_trans with (mult (2) i).
-Apply mult_le; Assumption.
-Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Assumption.
-Apply sum_eq; Intros.
-Unfold Wn.
-Apply Rmult_mult_r.
-Replace (minus (mult (2) (S i)) (mult (2) i0)) with (mult (2) (minus (S i) i0)).
-Reflexivity.
-Apply INR_eq.
-Rewrite mult_INR.
-Repeat Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply mult_le; Assumption.
-Assumption.
-Rewrite <- (Ropp_Ropp (sum_f_R0 sin_nnn (S n))).
-Apply eq_Ropp.
-Replace ``-(sum_f_R0 sin_nnn (S n))`` with ``-1*(sum_f_R0 sin_nnn (S n))``; [Idtac | Ring].
-Rewrite scal_sum.
-Rewrite decomp_sum.
-Replace (sin_nnn O) with R0.
-Rewrite Rmult_Ol; Rewrite Rplus_Ol.
-Replace (pred (S n)) with n; [Idtac | Reflexivity].
-Apply sum_eq; Intros.
-Rewrite Rmult_sym.
-Unfold sin_nnn.
-Rewrite scal_sum.
-Rewrite scal_sum.
-Apply sum_eq; Intros.
-Unfold Rdiv.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``/(INR (fact (mult (S (S O)) (S i))))``).
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S i))))``).
-Repeat Rewrite <- Rmult_assoc.
-Replace ``/(INR (fact (mult (S (S O)) (S i))))*
-   (C (mult (S (S O)) (S i)) (S (mult (S (S O)) i0)))`` with ``/(INR (fact (plus (mult (S (S O)) i0) (S O))))*/(INR (fact (plus (mult (S (S O)) (minus i i0)) (S O))))``.
-Replace (S (mult (2) i0)) with (plus (mult (2) i0) (1)); [Idtac | Ring].
-Replace (S (mult (2) (minus i i0))) with (plus (mult (2) (minus i i0)) (1)); [Idtac | Ring].
-Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i0)*(pow (-1) (minus i i0))``.
-Ring.
-Simpl.
-Pattern 2 i; Replace i with (plus i0 (minus i i0)).
-Rewrite pow_add.
-Ring.
-Symmetry; Apply le_plus_minus; Assumption.
-Unfold C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite Rinv_Rmult.
-Replace (S (mult (S (S O)) i0)) with (plus (mult (2) i0) (1)); [Apply Rmult_mult_r | Ring].
-Replace (minus (mult (2) (S i)) (plus (mult (2) i0) (1))) with (plus (mult (2) (minus i i0)) (1)).
-Reflexivity.
-Apply INR_eq.
-Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite minus_INR.
-Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) i0) (1)) with (S (mult (2) i0)).
-Replace (mult (2) (S i)) with (S (S (mult (2) i))).
-Apply le_n_S.
-Apply le_trans with (mult (2) i).
-Apply mult_le; Assumption.
-Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Assumption.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Reflexivity.
-Apply lt_O_Sn.
-Apply sum_eq; Intros.
-Rewrite scal_sum.
-Apply sum_eq; Intros.
-Unfold Rdiv.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) i)))``).
-Repeat Rewrite <- Rmult_assoc.
-Replace ``/(INR (fact (mult (S (S O)) i)))*
-   (C (mult (S (S O)) i) (mult (S (S O)) i0))`` with ``/(INR (fact (mult (S (S O)) i0)))*/(INR (fact (mult (S (S O)) (minus i i0))))``.
-Replace ``(pow (-1) i)`` with ``(pow (-1) i0)*(pow (-1) (minus i i0))``.
-Ring.
-Pattern 2 i; Replace i with (plus i0 (minus i i0)).
-Rewrite pow_add.
-Ring.
-Symmetry; Apply le_plus_minus; Assumption.
-Unfold C.
-Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Rewrite Rinv_Rmult.
-Replace (minus (mult (2) i) (mult (2) i0)) with (mult (2) (minus i i0)).
-Reflexivity.
-Apply INR_eq.
-Rewrite mult_INR; Repeat Rewrite minus_INR.
-Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply mult_le; Assumption.
-Assumption.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Unfold Reste2; Apply sum_eq; Intros.
-Apply sum_eq; Intros.
-Unfold Rdiv; Ring. 
-Unfold Reste1; Apply sum_eq; Intros.
-Apply sum_eq; Intros.
-Unfold Rdiv; Ring.
-Apply lt_O_Sn.
-Qed.
-
-Lemma pow_sqr : (x:R;i:nat) (pow x (mult (2) i))==(pow ``x*x`` i). 
-Intros. 
-Assert H := (pow_Rsqr x i).
-Unfold Rsqr in H; Exact H.
-Qed. 
- 
-Lemma A1_cvg : (x:R) (Un_cv (A1 x) (cos x)). 
-Intro. 
-Assert H := (exist_cos ``x*x``). 
-Elim H; Intros. 
-Assert p_i := p. 
-Unfold cos_in in p. 
-Unfold cos_n infinit_sum in p. 
-Unfold R_dist in p. 
-Cut ``(cos x)==x0``. 
-Intro. 
-Rewrite H0. 
-Unfold Un_cv; Unfold R_dist; Intros. 
-Elim (p eps H1); Intros. 
-Exists x1; Intros. 
-Unfold A1. 
-Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*(pow x (mult (S (S O)) k))``) n) with (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (mult (S (S O)) i)))*(pow (x*x) i)``) n). 
-Apply H2; Assumption. 
-Apply sum_eq. 
-Intros. 
-Replace ``(pow (x*x) i)`` with ``(pow x (mult (S (S O)) i))``. 
-Reflexivity. 
-Apply pow_sqr. 
-Unfold cos. 
-Case (exist_cos (Rsqr x)). 
-Unfold Rsqr; Intros. 
-Unfold cos_in in p_i. 
-Unfold cos_in in c. 
-Apply unicity_sum with [i:nat]``(cos_n i)*(pow (x*x) i)``; Assumption. 
-Qed. 
- 
-Lemma C1_cvg : (x,y:R) (Un_cv (C1 x y) (cos (Rplus x y))). 
-Intros. 
-Assert H := (exist_cos ``(x+y)*(x+y)``). 
-Elim H; Intros. 
-Assert p_i := p. 
-Unfold cos_in in p. 
-Unfold cos_n infinit_sum in p. 
-Unfold R_dist in p. 
-Cut ``(cos (x+y))==x0``. 
-Intro. 
-Rewrite H0. 
-Unfold Un_cv; Unfold R_dist; Intros. 
-Elim (p eps H1); Intros. 
-Exists x1; Intros. 
-Unfold C1. 
-Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*(pow (x+y) (mult (S (S O)) k))``) n) with (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (mult (S (S O)) i)))*(pow ((x+y)*(x+y)) i)``) n). 
-Apply H2; Assumption. 
-Apply sum_eq. 
-Intros. 
-Replace ``(pow ((x+y)*(x+y)) i)`` with ``(pow (x+y) (mult (S (S O)) i))``. 
-Reflexivity. 
-Apply pow_sqr. 
-Unfold cos. 
-Case (exist_cos (Rsqr ``x+y``)). 
-Unfold Rsqr; Intros. 
-Unfold cos_in in p_i. 
-Unfold cos_in in c. 
-Apply unicity_sum with [i:nat]``(cos_n i)*(pow ((x+y)*(x+y)) i)``; Assumption. 
-Qed. 
- 
-Lemma B1_cvg : (x:R) (Un_cv (B1 x) (sin x)). 
-Intro. 
-Case (Req_EM x R0); Intro. 
-Rewrite H. 
-Rewrite sin_0. 
-Unfold B1. 
-Unfold Un_cv; Unfold R_dist; Intros; Exists O; Intros. 
-Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow 0 (plus (mult (S (S O)) k) (S O)))``) n) with R0. 
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. 
-Induction n. 
-Simpl; Ring. 
-Rewrite tech5; Rewrite <- Hrecn. 
-Simpl; Ring. 
-Unfold ge; Apply le_O_n. 
-Assert H0 := (exist_sin ``x*x``). 
-Elim H0; Intros. 
-Assert p_i := p. 
-Unfold sin_in in p. 
-Unfold sin_n infinit_sum in p. 
-Unfold R_dist in p. 
-Cut ``(sin x)==x*x0``. 
-Intro. 
-Rewrite H1. 
-Unfold Un_cv; Unfold R_dist; Intros. 
-Cut ``0<eps/(Rabsolu x)``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption]]. 
-Elim (p ``eps/(Rabsolu x)`` H3); Intros. 
-Exists x1; Intros. 
-Unfold B1. 
-Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow x (plus (mult (S (S O)) k) (S O)))``) n) with (Rmult x (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n)). 
-Replace (Rminus (Rmult x (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n)) (Rmult x x0)) with (Rmult x (Rminus (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n) x0)); [Idtac | Ring]. 
-Rewrite Rabsolu_mult. 
-Apply Rlt_monotony_contra with ``/(Rabsolu x)``. 
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. 
-Rewrite <- Rmult_assoc. 
-Rewrite <- Rinv_l_sym. 
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H4; Apply H4; Assumption. 
-Apply Rabsolu_no_R0; Assumption. 
-Rewrite scal_sum. 
-Apply sum_eq. 
-Intros. 
-Rewrite pow_add. 
-Rewrite pow_sqr. 
-Simpl. 
-Ring. 
-Unfold sin. 
-Case (exist_sin (Rsqr x)). 
-Unfold Rsqr; Intros. 
-Unfold sin_in in p_i. 
-Unfold sin_in in s. 
-Assert H1 := (unicity_sum [i:nat]``(sin_n i)*(pow (x*x) i)`` x0 x1 p_i s). 
-Rewrite H1; Reflexivity. 
-Qed. 
diff --git a/theories7/Reals/DiscrR.v b/theories7/Reals/DiscrR.v
deleted file mode 100644
index 31c90727..00000000
--- a/theories7/Reals/DiscrR.v
+++ /dev/null
@@ -1,58 +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: DiscrR.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $       i*)
-
-Require RIneq.
-Require Omega.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Lemma Rlt_R0_R2 : ``0<2``.
-Replace ``2`` with (INR (2)); [Apply lt_INR_0; Apply lt_O_Sn | Reflexivity].
-Qed.
-
-Lemma Rplus_lt_pos : (x,y:R) ``0<x`` -> ``0<y`` -> ``0<x+y``.
-Intros.
-Apply Rlt_trans with x.
-Assumption. 
-Pattern 1 x; Rewrite <- Rplus_Or.
-Apply Rlt_compatibility.
-Assumption.
-Qed.
-
-Lemma IZR_eq : (z1,z2:Z) z1=z2 -> (IZR z1)==(IZR z2).
-Intros; Rewrite H; Reflexivity.
-Qed.
-
-Lemma IZR_neq : (z1,z2:Z) `z1<>z2` -> ``(IZR z1)<>(IZR z2)``.
-Intros; Red; Intro; Elim H; Apply eq_IZR; Assumption.
-Qed.
-
-Tactic Definition DiscrR :=
-  Try Match Context With
-  | [ |- ~(?1==?2) ] -> Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_neq; Try Discriminate | Reflexivity] | Reflexivity] | Reflexivity].
-
-Recursive Tactic Definition Sup0 :=
-  Match Context With
-  | [ |- ``0<1`` ] -> Apply Rlt_R0_R1
-  | [ |- ``0<?1`` ] -> Repeat (Apply Rmult_lt_pos Orelse Apply Rplus_lt_pos; Try Apply Rlt_R0_R1 Orelse Apply Rlt_R0_R2)
-  | [ |- ``?1>0`` ] -> Change ``0<?1``; Sup0.
-
-Tactic Definition SupOmega := Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_lt; Omega | Reflexivity] | Reflexivity] | Reflexivity].
-  
-Recursive Tactic Definition Sup :=
-  Match Context With
-  | [ |- (Rgt ?1 ?2) ] -> Change ``?2<?1``; Sup
-  | [ |- ``0<?1`` ] -> Sup0
-  | [ |- (Rlt (Ropp ?1) R0) ] -> Rewrite <- Ropp_O; Sup
-  | [ |- (Rlt (Ropp ?1) (Ropp ?2)) ] -> Apply Rlt_Ropp; Sup
-  | [ |- (Rlt (Ropp ?1) ?2) ] -> Apply Rlt_trans with ``0``; Sup
-  | [ |- (Rlt ?1 ?2) ] -> SupOmega
-  | _ -> Idtac.
-
-Tactic Definition RCompute := Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_eq; Try Reflexivity | Reflexivity] | Reflexivity] | Reflexivity].
diff --git a/theories7/Reals/Exp_prop.v b/theories7/Reals/Exp_prop.v
deleted file mode 100644
index 6ed9c00b..00000000
--- a/theories7/Reals/Exp_prop.v
+++ /dev/null
@@ -1,890 +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: Exp_prop.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis1.
-Require PSeries_reg.
-Require Div2.
-Require Even.
-Require Max.
-V7only [Import R_scope.].
-Open Local Scope nat_scope.
-V7only [Import nat_scope.].
-Open Local Scope R_scope.
-
-Definition E1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``/(INR (fact k))*(pow x k)`` N).
-
-Lemma E1_cvg : (x:R) (Un_cv (E1 x) (exp x)).
-Intro; Unfold exp; Unfold projT1.
-Case (exist_exp x); Intro.
-Unfold exp_in Un_cv; Unfold infinit_sum E1; Trivial.
-Qed.
-
-Definition Reste_E [x,y:R] : nat->R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k))) (pred N)).
-
-Lemma exp_form : (x,y:R;n:nat) (lt O n) -> ``(E1 x n)*(E1 y n)-(Reste_E x y n)==(E1 (x+y) n)``.
-Intros; Unfold E1.
-Rewrite cauchy_finite.
-Unfold Reste_E; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Apply sum_eq; Intros.
-Rewrite binomial.
-Rewrite scal_sum; Apply sum_eq; Intros.
-Unfold C; Unfold Rdiv; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym (INR (fact i))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite Rinv_Rmult.
-Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply H.
-Qed.
-
-Definition maj_Reste_E [x,y:R] : nat->R := [N:nat]``4*(pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) N))/(Rsqr (INR (fact (div2 (pred N)))))``.
-
-Lemma Rle_Rinv : (x,y:R) ``0<x`` -> ``0<y`` -> ``x<=y`` -> ``/y<=/x``.
-Intros; Apply Rle_monotony_contra with x.
-Apply H.
-Rewrite <- Rinv_r_sym.
-Apply Rle_monotony_contra with y.
-Apply H0.
-Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Apply H1.
-Red; Intro; Rewrite H2 in H0; Elim (Rlt_antirefl ? H0).
-Red; Intro; Rewrite H2 in H; Elim (Rlt_antirefl ? H).
-Qed.
-
-(**********)
-Lemma div2_double : (N:nat) (div2 (mult (2) N))=N.
-Intro; Induction N.
-Reflexivity.
-Replace (mult (2) (S N)) with (S (S (mult (2) N))).
-Simpl; Simpl in HrecN; Rewrite HrecN; Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Qed.
-
-Lemma div2_S_double : (N:nat) (div2 (S (mult (2) N)))=N.
-Intro; Induction N.
-Reflexivity.
-Replace (mult (2) (S N)) with (S (S (mult (2) N))).
-Simpl; Simpl in HrecN; Rewrite HrecN; Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Qed.
-
-Lemma div2_not_R0 : (N:nat) (lt (1) N) -> (lt O (div2 N)).
-Intros; Induction N.
-Elim (lt_n_O ? H).
-Cut (lt (1) N)\/N=(1).
-Intro; Elim H0; Intro.
-Assert H2 := (even_odd_dec N).
-Elim H2; Intro.
-Rewrite <- (even_div2 ? a); Apply HrecN; Assumption.
-Rewrite <- (odd_div2 ? b); Apply lt_O_Sn.
-Rewrite H1; Simpl; Apply lt_O_Sn.
-Inversion H.
-Right; Reflexivity.
-Left; Apply lt_le_trans with (2); [Apply lt_n_Sn | Apply H1].
-Qed.
-
-Lemma Reste_E_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste_E x y N))<=(maj_Reste_E x y N)``.
-Intros; Pose M := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
-Apply Rle_trans with (Rmult (pow M (mult (2) N)) (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(Rsqr (INR (fact (div2 (S N)))))`` (pred (minus N k))) (pred N))). 
-Unfold Reste_E.
-Apply Rle_trans with (sum_f_R0 [k:nat](Rabsolu (sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k)))) (pred N)).
-Apply (sum_Rabsolu [k:nat](sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k))) (pred N)).
-Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(Rabsolu (/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))))`` (pred (minus N k))) (pred N)).
-Apply sum_Rle; Intros.
-Apply (sum_Rabsolu [l:nat]``/(INR (fact (S (plus l n))))*(pow x (S (plus l n)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))``).
-Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow M (mult (S (S O)) N))*/(INR (fact (S l)))*/(INR (fact (minus N l)))`` (pred (minus N k))) (pred N)).
-Apply sum_Rle; Intros.
-Apply sum_Rle; Intros.
-Repeat Rewrite Rabsolu_mult.
-Do 2 Rewrite <- Pow_Rabsolu.
-Rewrite (Rabsolu_right ``/(INR (fact (S (plus n0 n))))``).
-Rewrite (Rabsolu_right ``/(INR (fact (minus N n0)))``).
-Replace ``/(INR (fact (S (plus n0 n))))*(pow (Rabsolu x) (S (plus n0 n)))*
-   (/(INR (fact (minus N n0)))*(pow (Rabsolu y) (minus N n0)))`` with ``/(INR (fact (minus N n0)))*/(INR (fact (S (plus n0 n))))*(pow (Rabsolu x) (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``; [Idtac | Ring].
-Rewrite <- (Rmult_sym ``/(INR (fact (minus N n0)))``).
-Repeat Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_trans with ``/(INR (fact (S n0)))*(pow (Rabsolu x) (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``.
-Rewrite (Rmult_sym ``/(INR (fact (S (plus n0 n))))``); Rewrite (Rmult_sym ``/(INR (fact (S n0)))``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Rewrite (Rmult_sym ``/(INR (fact (S n0)))``); Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Apply Rle_Rinv.
-Apply INR_fact_lt_0.
-Apply INR_fact_lt_0.
-Apply le_INR; Apply fact_growing; Apply le_n_S.
-Apply le_plus_l.
-Rewrite (Rmult_sym ``(pow M (mult (S (S O)) N))``); Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_trans with ``(pow M (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``.
-Do 2 Rewrite <- (Rmult_sym ``(pow (Rabsolu y) (minus N n0))``).
-Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Apply pow_incr; Split.
-Apply Rabsolu_pos.
-Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
-Apply RmaxLess1.
-Unfold M; Apply RmaxLess2.
-Apply Rle_trans with ``(pow M (S (plus n0 n)))*(pow M (minus N n0))``.
-Apply Rle_monotony.
-Apply pow_le; Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Unfold M; Apply RmaxLess1.
-Apply pow_incr; Split.
-Apply Rabsolu_pos.
-Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
-Apply RmaxLess2.
-Unfold M; Apply RmaxLess2.
-Rewrite <- pow_add; Replace (plus (S (plus n0 n)) (minus N n0)) with (plus N (S n)).
-Apply Rle_pow.
-Unfold M; Apply RmaxLess1.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring].
-Apply le_reg_l.
-Replace N with (S (pred N)).
-Apply le_n_S; Apply H0.
-Symmetry; Apply S_pred with O; Apply H.
-Apply INR_eq; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite minus_INR.
-Ring.
-Apply le_trans with (pred (minus N n)).
-Apply H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n (0)) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Apply H0.
-Apply lt_pred_n_n.
-Apply H.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Rewrite scal_sum.
-Apply sum_Rle; Intros.
-Rewrite <- Rmult_sym.
-Rewrite scal_sum.
-Apply sum_Rle; Intros.
-Rewrite (Rmult_sym ``/(Rsqr (INR (fact (div2 (S N)))))``).
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Unfold M; Apply RmaxLess1.
-Assert H2 := (even_odd_cor N).
-Elim H2; Intros N0 H3.
-Elim H3; Intro.
-Apply Rle_trans with ``/(INR (fact n0))*/(INR (fact (minus N n0)))``.
-Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (minus N n0)))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_Rinv.
-Apply INR_fact_lt_0.
-Apply INR_fact_lt_0.
-Apply le_INR.
-Apply fact_growing.
-Apply le_n_Sn.
-Replace ``/(INR (fact n0))*/(INR (fact (minus N n0)))`` with ``(C N n0)/(INR (fact N))``.
-Pattern 1 N; Rewrite H4.
-Apply Rle_trans with ``(C N N0)/(INR (fact N))``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact N))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Rewrite H4.
-Apply C_maj.
-Rewrite <- H4; Apply le_trans with (pred (minus N n)).
-Apply H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n (0)) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Apply H0.
-Apply lt_pred_n_n.
-Apply H.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Replace ``(C N N0)/(INR (fact N))`` with ``/(Rsqr (INR (fact N0)))``.
-Rewrite H4; Rewrite div2_S_double; Right; Reflexivity.
-Unfold Rsqr C Rdiv.
-Repeat Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym (INR (fact N))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace (minus N N0) with N0.
-Ring.
-Replace N with (plus N0 N0).
-Symmetry; Apply minus_plus.
-Rewrite H4.
-Apply INR_eq; Rewrite plus_INR; Rewrite mult_INR; Do 2 Rewrite S_INR; Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Unfold C Rdiv.
-Rewrite (Rmult_sym (INR (fact N))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rinv_Rmult.
-Rewrite Rmult_1r; Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Replace ``/(INR (fact (S n0)))*/(INR (fact (minus N n0)))`` with ``(C (S N) (S n0))/(INR (fact (S N)))``.
-Apply Rle_trans with ``(C (S N) (S N0))/(INR (fact (S N)))``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (S N)))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Cut (S N) = (mult (2) (S N0)).
-Intro; Rewrite H5; Apply C_maj.
-Rewrite <- H5; Apply le_n_S.
-Apply le_trans with (pred (minus N n)).
-Apply H1.
-Apply le_S_n.
-Replace (S (pred (minus N n))) with (minus N n).
-Apply le_trans with N.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply le_n_Sn.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n (0)) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Apply H0.
-Apply lt_pred_n_n.
-Apply H.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply INR_eq; Rewrite H4.
-Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat  Rewrite S_INR; Ring.
-Cut (S N) = (mult (2) (S N0)).
-Intro.
-Replace ``(C (S N) (S N0))/(INR (fact (S N)))`` with ``/(Rsqr (INR (fact (S N0))))``.
-Rewrite H5; Rewrite div2_double.
-Right; Reflexivity.
-Unfold Rsqr C Rdiv.
-Repeat Rewrite Rinv_Rmult.
-Replace (minus (S N) (S N0)) with (S N0).
-Rewrite (Rmult_sym (INR (fact (S N)))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Reflexivity.
-Apply INR_fact_neq_0.
-Replace (S N) with (plus (S N0) (S N0)).
-Symmetry; Apply minus_plus.
-Rewrite H5; Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Rewrite H4; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Unfold C Rdiv.
-Rewrite (Rmult_sym (INR (fact (S N)))).
-Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite Rinv_Rmult.
-Reflexivity.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Unfold maj_Reste_E.
-Unfold Rdiv; Rewrite (Rmult_sym ``4``).
-Rewrite Rmult_assoc.
-Apply Rle_monotony.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Apply Rle_trans with (sum_f_R0 [k:nat]``(INR (minus N k))*/(Rsqr (INR (fact (div2 (S N)))))`` (pred N)).
-Apply sum_Rle; Intros.
-Rewrite sum_cte.
-Replace (S (pred (minus N n))) with (minus N n).
-Right; Apply Rmult_sym.
-Apply S_pred with O.
-Apply simpl_lt_plus_l with n.
-Rewrite <- le_plus_minus.
-Replace (plus n (0)) with n; [Idtac | Ring].
-Apply le_lt_trans with (pred N).
-Apply H0.
-Apply lt_pred_n_n.
-Apply H.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)*/(Rsqr (INR (fact (div2 (S N)))))`` (pred N)).
-Apply sum_Rle; Intros.
-Do 2 Rewrite <- (Rmult_sym ``/(Rsqr (INR (fact (div2 (S N)))))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt.
-Apply INR_fact_neq_0.
-Apply le_INR.
-Apply simpl_le_plus_l with n.
-Rewrite <- le_plus_minus.
-Apply le_plus_r.
-Apply le_trans with (pred N).
-Apply H0.
-Apply le_pred_n.
-Rewrite sum_cte; Replace (S (pred N)) with N.
-Cut (div2 (S N)) = (S (div2 (pred N))).
-Intro; Rewrite H0.
-Rewrite fact_simpl; Rewrite mult_sym; Rewrite mult_INR; Rewrite Rsqr_times.
-Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym (INR N)); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Apply INR_fact_neq_0.
-Rewrite <- H0.
-Cut ``(INR N)<=(INR (mult (S (S O)) (div2 (S N))))``.
-Intro; Apply Rle_monotony_contra with ``(Rsqr (INR (div2 (S N))))``.
-Apply Rsqr_pos_lt.
-Apply not_O_INR; Red; Intro.
-Cut (lt (1) (S N)).
-Intro; Assert H4 := (div2_not_R0 ? H3).
-Rewrite H2 in H4; Elim (lt_n_O ? H4).
-Apply lt_n_S; Apply H.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Replace ``(INR N)*(INR N)`` with (Rsqr (INR N)); [Idtac | Reflexivity].
-Rewrite Rmult_assoc.
-Rewrite Rmult_sym.
-Replace ``4`` with (Rsqr ``2``); [Idtac | SqRing].
-Rewrite <- Rsqr_times.
-Apply Rsqr_incr_1.
-Replace ``2`` with (INR (2)).
-Rewrite <- mult_INR; Apply H1.
-Reflexivity.
-Left; Apply lt_INR_0; Apply H.
-Left; Apply Rmult_lt_pos.
-Sup0.
-Apply lt_INR_0; Apply div2_not_R0.
-Apply lt_n_S; Apply H.
-Cut (lt (1) (S N)).
-Intro; Unfold Rsqr; Apply prod_neq_R0; Apply not_O_INR; Intro; Assert H4 := (div2_not_R0 ? H2); Rewrite H3 in H4; Elim (lt_n_O ? H4).
-Apply lt_n_S; Apply H.
-Assert H1 := (even_odd_cor N).
-Elim H1; Intros N0 H2.
-Elim H2; Intro.
-Pattern 2 N; Rewrite H3.
-Rewrite div2_S_double.
-Right; Rewrite H3; Reflexivity.
-Pattern 2 N; Rewrite H3.
-Replace (S (S (mult (2) N0))) with (mult (2) (S N0)).
-Rewrite div2_double.
-Rewrite H3.
-Rewrite S_INR; Do 2 Rewrite mult_INR.
-Rewrite (S_INR N0).
-Rewrite Rmult_Rplus_distr.
-Apply Rle_compatibility.
-Rewrite Rmult_1r.
-Simpl.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Unfold Rsqr; Apply prod_neq_R0; Apply INR_fact_neq_0.
-Unfold Rsqr; Apply prod_neq_R0; Apply not_O_INR; Discriminate.
-Assert H0 := (even_odd_cor N).
-Elim H0; Intros N0 H1.
-Elim H1; Intro.
-Cut (lt O N0).
-Intro; Rewrite H2.
-Rewrite div2_S_double.
-Replace (mult (2) N0) with (S (S (mult (2) (pred N0)))).
-Replace (pred (S (S (mult (2) (pred N0))))) with (S (mult (2) (pred N0))).
-Rewrite div2_S_double.
-Apply S_pred with O; Apply H3.
-Reflexivity.
-Replace N0 with (S (pred N0)).
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Symmetry; Apply S_pred with O; Apply H3.
-Rewrite H2 in H.
-Apply neq_O_lt.
-Red; Intro.
-Rewrite <- H3 in H.
-Simpl in H.
-Elim (lt_n_O ? H).
-Rewrite H2.
-Replace (pred (S (mult (2) N0))) with (mult (2) N0); [Idtac | Reflexivity].
-Replace (S (S (mult (2) N0))) with (mult (2) (S N0)).
-Do 2 Rewrite div2_double.
-Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply S_pred with O; Apply H.
-Qed.
-
-Lemma maj_Reste_cv_R0 : (x,y:R) (Un_cv (maj_Reste_E x y) ``0``).
-Intros; Assert H := (Majxy_cv_R0 x y).
-Unfold Un_cv in H; Unfold Un_cv; Intros.
-Cut ``0<eps/4``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H ? H1); Intros N0 H2.
-Exists (max (mult (2) (S N0)) (2)); Intros.
-Unfold R_dist in H2; Unfold R_dist; Rewrite minus_R0; Unfold Majxy in H2; Unfold maj_Reste_E.
-Rewrite Rabsolu_right.
-Apply Rle_lt_trans with ``4*(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))``.
-Apply Rle_monotony.
-Left; Sup0.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) n))``); Rewrite (Rmult_sym ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))``); Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Rle_trans with ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) n))``.
-Rewrite Rmult_sym; Pattern 2 (pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (2) n)); Rewrite <- Rmult_1r; Apply Rle_monotony.
-Apply pow_le; Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Apply Rle_monotony_contra with ``(INR (fact (div2 (pred n))))``.
-Apply INR_fact_lt_0.
-Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
-Replace R1 with (INR (1)); [Apply le_INR | Reflexivity].
-Apply lt_le_S.
-Apply INR_lt.
-Apply INR_fact_lt_0.
-Apply INR_fact_neq_0.
-Apply Rle_pow.
-Apply RmaxLess1.
-Assert H4 := (even_odd_cor n).
-Elim H4; Intros N1 H5.
-Elim H5; Intro.
-Cut (lt O N1).
-Intro.
-Rewrite H6.
-Replace (pred (mult (2) N1)) with (S (mult (2) (pred N1))).
-Rewrite div2_S_double.
-Replace (S (pred N1)) with N1.
-Apply INR_le.
-Right.
-Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply S_pred with O; Apply H7.
-Replace (mult (2) N1) with (S (S (mult (2) (pred N1)))).
-Reflexivity.
-Pattern 2 N1; Replace N1 with (S (pred N1)).
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Symmetry ; Apply S_pred with O; Apply H7.
-Apply INR_lt.
-Apply Rlt_monotony_contra with (INR (2)).
-Simpl; Sup0.
-Rewrite Rmult_Or; Rewrite <- mult_INR.
-Apply lt_INR_0.
-Rewrite <- H6.
-Apply lt_le_trans with (2).
-Apply lt_O_Sn.
-Apply le_trans with (max (mult (2) (S N0)) (2)).
-Apply le_max_r.
-Apply H3.
-Rewrite H6.
-Replace (pred (S (mult (2) N1))) with (mult (2) N1).
-Rewrite div2_double.
-Replace (mult (4) (S N1)) with (mult (2) (mult (2) (S N1))).
-Apply mult_le.
-Replace (mult (2) (S N1)) with (S (S (mult (2) N1))).
-Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Ring.
-Reflexivity.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply Rlt_monotony_contra with ``/4``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite Rmult_sym.
-Replace ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))`` with ``(Rabsolu ((pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))-0))``.
-Apply H2; Unfold ge.
-Cut (le (mult (2) (S N0)) n).
-Intro; Apply le_S_n.
-Apply INR_le; Apply Rle_monotony_contra with (INR (2)).
-Simpl; Sup0.
-Do 2 Rewrite <- mult_INR; Apply le_INR.
-Apply le_trans with n.
-Apply H4.
-Assert H5 := (even_odd_cor n).
-Elim H5; Intros N1 H6.
-Elim H6; Intro.
-Cut (lt O N1).
-Intro.
-Rewrite H7.
-Apply mult_le.
-Replace (pred (mult (2) N1)) with (S (mult (2) (pred N1))).
-Rewrite div2_S_double.
-Replace (S (pred N1)) with N1.
-Apply le_n.
-Apply S_pred with O; Apply H8.
-Replace (mult (2) N1) with (S (S (mult (2) (pred N1)))).
-Reflexivity.
-Pattern 2 N1; Replace N1 with (S (pred N1)).
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Symmetry; Apply S_pred with O; Apply H8.
-Apply INR_lt.
-Apply Rlt_monotony_contra with (INR (2)).
-Simpl; Sup0.
-Rewrite Rmult_Or; Rewrite <- mult_INR.
-Apply lt_INR_0.
-Rewrite <- H7.
-Apply lt_le_trans with (2).
-Apply lt_O_Sn.
-Apply le_trans with (max (mult (2) (S N0)) (2)).
-Apply le_max_r.
-Apply H3.
-Rewrite H7.
-Replace (pred (S (mult (2) N1))) with (mult (2) N1).
-Rewrite div2_double.
-Replace (mult (2) (S N1)) with (S (S (mult (2) N1))).
-Apply le_n_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Reflexivity.
-Apply le_trans with (max (mult (2) (S N0)) (2)).
-Apply le_max_l.
-Apply H3.
-Rewrite minus_R0; Apply Rabsolu_right.
-Apply Rle_sym1.
-Unfold Rdiv; Repeat Apply Rmult_le_pos.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
-DiscrR.
-Apply Rle_sym1.
-Unfold Rdiv; Apply Rmult_le_pos.
-Left; Sup0.
-Apply Rmult_le_pos.
-Apply pow_le.
-Apply Rle_trans with R1.
-Left; Apply Rlt_R0_R1.
-Apply RmaxLess1.
-Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Apply INR_fact_neq_0.
-Qed.
-
-(**********)
-Lemma Reste_E_cv : (x,y:R) (Un_cv (Reste_E x y) R0).
-Intros; Assert H := (maj_Reste_cv_R0 x y).
-Unfold Un_cv in H; Unfold Un_cv; Intros; Elim (H ? H0); Intros.
-Exists (max x0 (1)); Intros.
-Unfold R_dist; Rewrite minus_R0.
-Apply Rle_lt_trans with (maj_Reste_E x y n).
-Apply Reste_E_maj.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Apply le_trans with (max x0 (1)).
-Apply le_max_r.
-Apply H2.
-Replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) R0).
-Apply H1.
-Unfold ge; Apply le_trans with (max x0 (1)).
-Apply le_max_l.
-Apply H2.
-Unfold R_dist; Rewrite minus_R0; Apply Rabsolu_right.
-Apply Rle_sym1; Apply Rle_trans with (Rabsolu (Reste_E x y n)).
-Apply Rabsolu_pos.
-Apply Reste_E_maj.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Apply le_trans with (max x0 (1)).
-Apply le_max_r.
-Apply H2.
-Qed.
-
-(**********)
-Lemma exp_plus : (x,y:R) ``(exp (x+y))==(exp x)*(exp y)``.
-Intros; Assert H0 := (E1_cvg x).
-Assert H := (E1_cvg y).
-Assert H1 := (E1_cvg ``x+y``).
-EApply UL_sequence.
-Apply H1.
-Assert H2 := (CV_mult ? ? ? ? H0 H).
-Assert H3 := (CV_minus ? ? ? ? H2 (Reste_E_cv x y)).
-Unfold Un_cv; Unfold Un_cv in H3; Intros.
-Elim (H3 ? H4); Intros.
-Exists (S x0); Intros.
-Rewrite <- (exp_form x y n).
-Rewrite minus_R0 in H5.
-Apply H5.
-Unfold ge; Apply le_trans with (S x0).
-Apply le_n_Sn.
-Apply H6.
-Apply lt_le_trans with (S x0).
-Apply lt_O_Sn.
-Apply H6.
-Qed.
-
-(**********)
-Lemma exp_pos_pos : (x:R) ``0<x`` -> ``0<(exp x)``.
-Intros; Pose An := [N:nat]``/(INR (fact N))*(pow x N)``.
-Cut (Un_cv [n:nat](sum_f_R0 An n) (exp x)).
-Intro; Apply Rlt_le_trans with (sum_f_R0 An O).
-Unfold An; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Apply Rlt_R0_R1.
-Apply sum_incr.
-Assumption.
-Intro; Unfold An; Left; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply (pow_lt ? n H).
-Unfold exp; Unfold projT1; Case (exist_exp x); Intro.
-Unfold exp_in; Unfold infinit_sum Un_cv; Trivial.
-Qed.
-
-(**********)
-Lemma exp_pos : (x:R) ``0<(exp x)``.
-Intro; Case (total_order_T R0 x); Intro.
-Elim s; Intro.
-Apply (exp_pos_pos ? a).
-Rewrite <- b; Rewrite exp_0; Apply Rlt_R0_R1.
-Replace (exp x) with ``1/(exp (-x))``.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_R0_R1.
-Apply Rlt_Rinv; Apply exp_pos_pos.
-Apply (Rgt_RO_Ropp ? r).
-Cut ``(exp (-x))<>0``.
-Intro; Unfold Rdiv; Apply r_Rmult_mult with ``(exp (-x))``.
-Rewrite Rmult_1l; Rewrite <- Rinv_r_sym.
-Rewrite <- exp_plus.
-Rewrite Rplus_Ropp_l; Rewrite exp_0; Reflexivity.
-Apply H.
-Apply H.
-Assert H := (exp_plus x ``-x``).
-Rewrite Rplus_Ropp_r in H; Rewrite exp_0 in H.
-Red; Intro; Rewrite H0 in H.
-Rewrite Rmult_Or in H.
-Elim R1_neq_R0; Assumption.
-Qed.
-
-(* ((exp h)-1)/h -> 0 quand h->0 *)
-Lemma derivable_pt_lim_exp_0 : (derivable_pt_lim exp ``0`` ``1``).
-Unfold derivable_pt_lim; Intros.
-Pose fn := [N:nat][x:R]``(pow x N)/(INR (fact (S N)))``.
-Cut (CVN_R fn).
-Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
-Intro cv; Cut ((n:nat)(continuity (fn n))).
-Intro; Cut (continuity (SFL fn cv)).
-Intro; Unfold continuity in H1.
-Assert H2 := (H1 R0).
-Unfold continuity_pt in H2; Unfold continue_in in H2; Unfold limit1_in in H2; Unfold limit_in in H2; Simpl in H2; Unfold R_dist in H2.
-Elim (H2 ? H); Intros alp H3.
-Elim H3; Intros.
-Exists (mkposreal ? H4); Intros.
-Rewrite Rplus_Ol; Rewrite exp_0.
-Replace ``((exp h)-1)/h`` with (SFL fn cv h).
-Replace R1 with (SFL fn cv R0).
-Apply H5.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply (not_sym ? ? H6).
-Rewrite minus_R0; Apply H7.
-Unfold SFL.
-Case (cv ``0``); Intros.
-EApply UL_sequence.
-Apply u.
-Unfold Un_cv SP.
-Intros; Exists (1); Intros.
-Unfold R_dist; Rewrite decomp_sum.
-Rewrite (Rplus_sym (fn O R0)).
-Replace (fn O R0) with R1.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
-Replace (sum_f_R0 [i:nat](fn (S i) ``0``) (pred n)) with R0.
-Rewrite Rabsolu_R0; Apply H8.
-Symmetry; Apply sum_eq_R0; Intros.
-Unfold fn.
-Simpl.
-Unfold Rdiv; Do 2 Rewrite Rmult_Ol; Reflexivity.
-Unfold fn; Simpl.
-Unfold Rdiv; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
-Apply lt_le_trans with (1); [Apply lt_n_Sn | Apply H9].
-Unfold SFL exp.
-Unfold projT1.
-Case (cv h); Case (exist_exp h); Intros.
-EApply UL_sequence.
-Apply u.
-Unfold Un_cv; Intros.
-Unfold exp_in in e.
-Unfold infinit_sum in e.
-Cut ``0<eps0*(Rabsolu h)``.
-Intro; Elim (e ? H9); Intros N0 H10.
-Exists N0; Intros.
-Unfold R_dist.
-Apply Rlt_monotony_contra with ``(Rabsolu h)``.
-Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rabsolu_mult.
-Rewrite Rminus_distr.
-Replace ``h*(x-1)/h`` with ``(x-1)``.
-Unfold R_dist in H10.
-Replace ``h*(SP fn n h)-(x-1)`` with (Rminus (sum_f_R0 [i:nat]``/(INR (fact i))*(pow h i)`` (S n)) x).
-Rewrite (Rmult_sym (Rabsolu h)).
-Apply H10.
-Unfold ge.
-Apply le_trans with (S N0).
-Apply le_n_Sn.
-Apply le_n_S; Apply H11.
-Rewrite decomp_sum.
-Replace ``/(INR (fact O))*(pow h O)`` with R1.
-Unfold Rminus.
-Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Rewrite <- (Rplus_sym ``-x``).
-Rewrite <- (Rplus_sym ``-x+1``).
-Rewrite Rplus_assoc; Repeat Apply Rplus_plus_r.
-Replace (pred (S n)) with n; [Idtac | Reflexivity].
-Unfold SP.
-Rewrite scal_sum.
-Apply sum_eq; Intros.
-Unfold fn.
-Replace (pow h (S i)) with ``h*(pow h i)``.
-Unfold Rdiv; Ring.
-Simpl; Ring.
-Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
-Apply lt_O_Sn.
-Unfold Rdiv.
-Rewrite <- Rmult_assoc.
-Symmetry; Apply Rinv_r_simpl_m.
-Assumption.
-Apply Rmult_lt_pos.
-Apply H8.
-Apply Rabsolu_pos_lt; Assumption.
-Apply SFL_continuity; Assumption.
-Intro; Unfold fn.
-Replace [x:R]``(pow x n)/(INR (fact (S n)))`` with (div_fct (pow_fct n) (fct_cte (INR (fact (S n))))); [Idtac | Reflexivity].
-Apply continuity_div.
-Apply derivable_continuous; Apply (derivable_pow n).
-Apply derivable_continuous; Apply derivable_const.
-Intro; Unfold fct_cte; Apply INR_fact_neq_0.
-Apply (CVN_R_CVS ? X).
-Assert H0 := Alembert_exp.
-Unfold CVN_R.
-Intro; Unfold CVN_r.
-Apply Specif.existT with [N:nat]``(pow r N)/(INR (fact (S N)))``.
-Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``(pow r k)/(INR (fact (S k)))``) n) l)).
-Intro.
-Elim X; Intros.
-Exists x; Intros.
-Split.
-Apply p.
-Unfold Boule; Intros.
-Rewrite minus_R0 in H1.
-Unfold fn.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Cut ``0<(INR (fact (S n)))``.
-Intro.
-Rewrite (Rabsolu_right ``/(INR (fact (S n)))``).
-Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (S n)))``).
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply H2.
-Rewrite <- Pow_Rabsolu.
-Apply pow_maj_Rabs.
-Rewrite Rabsolu_Rabsolu; Left; Apply H1.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply H2.
-Apply INR_fact_lt_0.
-Cut (r::R)<>``0``.
-Intro; Apply Alembert_C2.
-Intro; Apply Rabsolu_no_R0.
-Unfold Rdiv; Apply prod_neq_R0.
-Apply pow_nonzero; Assumption.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Unfold Un_cv in H0.
-Unfold Un_cv; Intros.
-Cut ``0<eps0/r``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply (cond_pos r)]].
-Elim (H0 ? H3); Intros N0 H4.
-Exists N0; Intros.
-Cut (ge (S n) N0).
-Intro hyp_sn.
-Assert H6 := (H4 ? hyp_sn).
-Unfold R_dist in H6; Rewrite minus_R0 in H6.
-Rewrite Rabsolu_Rabsolu in H6.
-Unfold R_dist; Rewrite minus_R0.
-Rewrite Rabsolu_Rabsolu.
-Replace ``(Rabsolu ((pow r (S n))/(INR (fact (S (S n))))))/
-     (Rabsolu ((pow r n)/(INR (fact (S n)))))`` with ``r*/(INR (fact (S (S n))))*//(INR (fact (S n)))``.
-Rewrite Rmult_assoc; Rewrite Rabsolu_mult.
-Rewrite (Rabsolu_right r).
-Apply Rlt_monotony_contra with ``/r``.
-Apply Rlt_Rinv; Apply (cond_pos r).
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps0).
-Apply H6.
-Assumption.
-Apply Rle_sym1; Left; Apply (cond_pos r).
-Unfold Rdiv.
-Repeat Rewrite Rabsolu_mult.
-Repeat Rewrite Rabsolu_Rinv.
-Rewrite Rinv_Rmult.
-Repeat Rewrite Rabsolu_right.
-Rewrite Rinv_Rinv.
-Rewrite (Rmult_sym r).
-Rewrite (Rmult_sym (pow r (S n))).
-Repeat Rewrite Rmult_assoc.
-Apply Rmult_mult_r.
-Rewrite (Rmult_sym r).
-Rewrite <- Rmult_assoc; Rewrite <- (Rmult_sym (INR (fact (S n)))).
-Apply Rmult_mult_r.
-Simpl.
-Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Ring.
-Apply pow_nonzero; Assumption.
-Apply INR_fact_neq_0.
-Apply Rle_sym1; Left; Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply pow_lt; Apply (cond_pos r).
-Apply Rle_sym1; Left; Apply INR_fact_lt_0.
-Apply Rle_sym1; Left; Apply pow_lt; Apply (cond_pos r).
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply Rinv_neq_R0; Apply Rabsolu_no_R0; Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Unfold ge; Apply le_trans with n.
-Apply H5.
-Apply le_n_Sn.
-Assert H1 := (cond_pos r); Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
-Qed.
-
-(**********)
-Lemma derivable_pt_lim_exp : (x:R) (derivable_pt_lim exp x (exp x)).
-Intro; Assert H0 := derivable_pt_lim_exp_0.
-Unfold derivable_pt_lim in H0; Unfold derivable_pt_lim; Intros.
-Cut ``0<eps/(exp x)``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Apply H | Apply Rlt_Rinv; Apply exp_pos]].
-Elim (H0 ? H1); Intros del H2.
-Exists del; Intros.
-Assert H5 := (H2 ? H3 H4).
-Rewrite Rplus_Ol in H5; Rewrite exp_0 in H5.
-Replace ``((exp (x+h))-(exp x))/h-(exp x)`` with ``(exp x)*(((exp h)-1)/h-1)``.
-Rewrite Rabsolu_mult; Rewrite (Rabsolu_right (exp x)).
-Apply Rlt_monotony_contra with ``/(exp x)``.
-Apply Rlt_Rinv; Apply exp_pos.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps).
-Apply H5.
-Assert H6 := (exp_pos x); Red; Intro; Rewrite H7 in H6; Elim (Rlt_antirefl ? H6).
-Apply Rle_sym1; Left; Apply exp_pos.
-Rewrite Rminus_distr.
-Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rminus_distr.
-Rewrite Rmult_1r; Rewrite exp_plus; Reflexivity.
-Qed.
diff --git a/theories7/Reals/Integration.v b/theories7/Reals/Integration.v
deleted file mode 100644
index 410429ed..00000000
--- a/theories7/Reals/Integration.v
+++ /dev/null
@@ -1,13 +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: Integration.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
-
-Require Export NewtonInt.
-Require Export RiemannInt_SF.
-Require Export RiemannInt.
\ No newline at end of file
diff --git a/theories7/Reals/MVT.v b/theories7/Reals/MVT.v
deleted file mode 100644
index eae414b1..00000000
--- a/theories7/Reals/MVT.v
+++ /dev/null
@@ -1,517 +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: MVT.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-Require Rtopology.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(* The Mean Value Theorem *)
-Theorem MVT : (f,g:R->R;a,b:R;pr1:(c:R)``a<c<b``->(derivable_pt f c);pr2:(c:R)``a<c<b``->(derivable_pt g c)) ``a<b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> ((c:R)``a<=c<=b``->(continuity_pt g c)) -> (EXT c : R | (EXT P : ``a<c<b`` | ``((g b)-(g a))*(derive_pt f c (pr1 c P))==((f b)-(f a))*(derive_pt g c (pr2 c P))``)).
-Intros; Assert H2 := (Rlt_le ? ? H).
-Pose h := [y:R]``((g b)-(g a))*(f y)-((f b)-(f a))*(g y)``.
-Cut (c:R)``a<c<b``->(derivable_pt h c).
-Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt h c)).
-Intro; Assert H4 := (continuity_ab_maj h a b H2 H3).
-Assert H5 := (continuity_ab_min h a b H2 H3).
-Elim H4; Intros Mx H6.
-Elim H5; Intros mx H7.
-Cut (h a)==(h b).
-Intro; Pose M := (h Mx); Pose m := (h mx).
-Cut (c:R;P:``a<c<b``) (derive_pt h c (X c P))==``((g b)-(g a))*(derive_pt f c (pr1 c P))-((f b)-(f a))*(derive_pt g c (pr2 c P))``.
-Intro; Case (Req_EM (h a) M); Intro.
-Case (Req_EM (h a) m); Intro.
-Cut ((c:R)``a<=c<=b``->(h c)==M).
-Intro; Cut ``a<(a+b)/2<b``.
-(*** h constant ***)
-Intro; Exists ``(a+b)/2``.
-Exists H13.
-Apply Rminus_eq; Rewrite <- H9; Apply deriv_constant2 with a b.
-Elim H13; Intros; Assumption.
-Elim H13; Intros; Assumption.
-Intros; Rewrite (H12 ``(a+b)/2``).
-Apply H12; Split; Left; Assumption.
-Elim H13; Intros; Split; Left; Assumption.
-Split.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H.
-DiscrR.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite Rplus_sym; Rewrite double; Apply Rlt_compatibility; Apply H.
-DiscrR.
-Intros; Elim H6; Intros H13 _.
-Elim H7; Intros H14 _.
-Apply Rle_antisym.
-Apply H13; Apply H12.
-Rewrite H10 in H11; Rewrite H11; Apply H14; Apply H12.
-Cut ``a<mx<b``.
-(*** h admet un minimum global sur [a,b] ***)
-Intro; Exists mx.
-Exists H12.
-Apply Rminus_eq; Rewrite <- H9; Apply deriv_minimum with a b.
-Elim H12; Intros; Assumption.
-Elim H12; Intros; Assumption.
-Intros; Elim H7; Intros.
-Apply H15; Split; Left; Assumption.
-Elim H7; Intros _ H12; Elim H12; Intros; Split.
-Inversion H13.
-Apply H15.
-Rewrite H15 in H11; Elim H11; Reflexivity.
-Inversion H14.
-Apply H15.
-Rewrite H8 in H11; Rewrite <- H15 in H11; Elim H11; Reflexivity.
-Cut ``a<Mx<b``.
-(*** h admet un maximum global sur [a,b] ***)
-Intro; Exists Mx.
-Exists H11.
-Apply Rminus_eq; Rewrite <- H9; Apply deriv_maximum with a b.
-Elim H11; Intros; Assumption.
-Elim H11; Intros; Assumption.
-Intros; Elim H6; Intros; Apply H14.
-Split; Left; Assumption.
-Elim H6; Intros _ H11; Elim H11; Intros; Split.
-Inversion H12.
-Apply H14.
-Rewrite H14 in H10; Elim H10; Reflexivity.
-Inversion H13.
-Apply H14.
-Rewrite H8 in H10; Rewrite <- H14 in H10; Elim H10; Reflexivity.
-Intros; Unfold h; Replace (derive_pt [y:R]``((g b)-(g a))*(f y)-((f b)-(f a))*(g y)`` c (X c P)) with (derive_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c (derivable_pt_minus ? ? ? (derivable_pt_mult ? ? ? (derivable_pt_const ``(g b)-(g a)`` c) (pr1 c P)) (derivable_pt_mult ? ? ? (derivable_pt_const ``(f b)-(f a)`` c) (pr2 c P)))); [Idtac | Apply pr_nu].
-Rewrite derive_pt_minus; Do 2 Rewrite derive_pt_mult; Do 2 Rewrite derive_pt_const; Do 2 Rewrite Rmult_Ol; Do 2 Rewrite Rplus_Ol; Reflexivity.
-Unfold h; Ring.
-Intros; Unfold h; Change (continuity_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c).
-Apply continuity_pt_minus; Apply continuity_pt_mult.
-Apply derivable_continuous_pt; Apply derivable_const.
-Apply H0; Apply H3.
-Apply derivable_continuous_pt; Apply derivable_const.
-Apply H1; Apply H3.
-Intros; Change (derivable_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c).
-Apply derivable_pt_minus; Apply derivable_pt_mult.
-Apply derivable_pt_const.
-Apply (pr1 ? H3).
-Apply derivable_pt_const.
-Apply (pr2 ? H3).
-Qed.
-
-(* Corollaries ... *)
-Lemma MVT_cor1 : (f:(R->R); a,b:R; pr:(derivable f)) ``a < b``->(EXT c:R | ``(f b)-(f a) == (derive_pt f c (pr c))*(b-a)``/\``a < c < b``).
-Intros f a b pr H; Cut (c:R)``a<c<b``->(derivable_pt f c); [Intro | Intros; Apply pr].
-Cut (c:R)``a<c<b``->(derivable_pt id c); [Intro | Intros; Apply derivable_pt_id].
-Cut ((c:R)``a<=c<=b``->(continuity_pt f c)); [Intro | Intros; Apply derivable_continuous_pt; Apply pr].
-Cut ((c:R)``a<=c<=b``->(continuity_pt id c)); [Intro | Intros; Apply derivable_continuous_pt; Apply derivable_id].
-Assert H2 := (MVT f id a b X X0 H H0 H1).
-Elim H2; Intros c H3; Elim H3; Intros.
-Exists c; Split.
-Cut (derive_pt id c (X0 c x)) == (derive_pt id c (derivable_pt_id c)); [Intro | Apply pr_nu].
-Rewrite H5 in H4; Rewrite (derive_pt_id c) in H4; Rewrite Rmult_1r in H4; Rewrite <- H4; Replace (derive_pt f c (X c x)) with (derive_pt f c (pr c)); [Idtac | Apply pr_nu]; Apply Rmult_sym.
-Apply x.
-Qed.
-
-Theorem MVT_cor2 : (f,f':R->R;a,b:R) ``a<b`` -> ((c:R)``a<=c<=b``->(derivable_pt_lim f c (f' c))) -> (EXT c:R | ``(f b)-(f a)==(f' c)*(b-a)``/\``a<c<b``).
-Intros f f' a b H H0; Cut ((c:R)``a<=c<=b``->(derivable_pt f c)).
-Intro; Cut ((c:R)``a<c<b``->(derivable_pt f c)).
-Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt f c)).
-Intro; Cut ((c:R)``a<=c<=b``->(derivable_pt id c)).
-Intro; Cut ((c:R)``a<c<b``->(derivable_pt id c)).
-Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt id c)).
-Intro; Elim (MVT f id a b X0 X2 H H1 H2); Intros; Elim H3; Clear H3; Intros; Exists x; Split.
-Cut (derive_pt id x (X2 x x0))==R1.
-Cut (derive_pt f x (X0 x x0))==(f' x).
-Intros; Rewrite H4 in H3; Rewrite H5 in H3; Unfold id in H3; Rewrite Rmult_1r in H3; Rewrite Rmult_sym; Symmetry; Assumption.
-Apply derive_pt_eq_0; Apply H0; Elim x0; Intros; Split; Left; Assumption.
-Apply derive_pt_eq_0; Apply derivable_pt_lim_id.
-Assumption.
-Intros; Apply derivable_continuous_pt; Apply X1; Assumption.
-Intros; Apply derivable_pt_id.
-Intros; Apply derivable_pt_id.
-Intros; Apply derivable_continuous_pt; Apply X; Assumption.
-Intros; Elim H1; Intros; Apply X; Split; Left; Assumption.
-Intros; Unfold derivable_pt; Apply Specif.existT with (f' c); Apply H0; Apply H1.
-Qed.
-
-Lemma MVT_cor3 : (f,f':(R->R); a,b:R) ``a < b``  -> ((x:R)``a <= x`` ->  ``x <= b``->(derivable_pt_lim f x (f' x))) -> (EXT c:R | ``a<=c``/\``c<=b``/\``(f b)==(f a) + (f' c)*(b-a)``).
-Intros f f' a b H H0; Assert H1 : (EXT c:R | ``(f b) -(f a) == (f' c)*(b-a)``/\``a<c<b``); [Apply MVT_cor2; [Apply H | Intros; Elim H1; Intros; Apply (H0 ? H2 H3)] | Elim H1; Intros; Exists x; Elim H2; Intros; Elim H4; Intros; Split; [Left; Assumption | Split; [Left; Assumption | Rewrite <- H3; Ring]]].
-Qed.
-
-Lemma Rolle : (f:R->R;a,b:R;pr:(x:R)``a<x<b``->(derivable_pt f x)) ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ``a<b`` -> (f a)==(f b) -> (EXT c:R | (EXT P: ``a<c<b`` | ``(derive_pt f c (pr c P))==0``)).
-Intros; Assert H2 : (x:R)``a<x<b``->(derivable_pt id x).
-Intros; Apply derivable_pt_id.
-Assert H3 := (MVT f id a b pr H2 H0 H); Assert H4 : (x:R)``a<=x<=b``->(continuity_pt id x).
-Intros; Apply derivable_continuous; Apply derivable_id.
-Elim (H3 H4); Intros; Elim H5; Intros; Exists x; Exists x0; Rewrite H1 in H6; Unfold id in H6; Unfold Rminus in H6; Rewrite Rplus_Ropp_r in H6; Rewrite Rmult_Ol in H6; Apply r_Rmult_mult with ``b-a``; [Rewrite Rmult_Or; Apply H6 | Apply Rminus_eq_contra; Red; Intro; Rewrite H7 in H0; Elim (Rlt_antirefl ? H0)].
-Qed.
-
-(**********)
-Lemma nonneg_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``0<=(derive_pt f x (pr x))``) -> (increasing f).
-Intros.
-Unfold increasing.
-Intros.
-Case (total_order_T x y); Intro.
-Elim s; Intro.
-Apply Rle_anti_compatibility with ``-(f x)``.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
-Assert H1 := (MVT_cor1 f ? ? pr a).
-Elim H1; Intros.
-Elim H2; Intros.
-Unfold Rminus in H3.
-Rewrite H3.
-Apply Rmult_le_pos.
-Apply H.
-Apply Rle_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
-Rewrite b; Right; Reflexivity.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
-Qed.
- 
-(**********)
-Lemma nonpos_derivative_0 : (f:R->R;pr:(derivable f)) (decreasing f) -> ((x:R) ``(derive_pt f x (pr x))<=0``).
-Intros f pr H x; Assert H0 :=H; Unfold decreasing in H0; Generalize (derivable_derive f x (pr x)); Intro; Elim H1; Intros l H2.
-Rewrite H2; Case (total_order l R0); Intro.
-Left; Assumption.
-Elim H3; Intro.
-Right; Assumption.
-Generalize (derive_pt_eq_1 f x l (pr x) H2); Intros; Cut ``0< (l/2)``.
-Intro; Elim (H5 ``(l/2)`` H6); Intros delta H7; Cut ``delta/2<>0``/\``0<delta/2``/\``(Rabsolu delta/2)<delta``.
-Intro; Decompose [and] H8; Intros; Generalize (H7 ``delta/2`` H9 H12); Cut ``((f (x+delta/2))-(f x))/(delta/2)<=0``.
-Intro; Cut ``0< -(((f (x+delta/2))-(f x))/(delta/2)-l)``.
-Intro; Unfold Rabsolu; Case (case_Rabsolu ``((f (x+delta/2))-(f x))/(delta/2)-l``).
-Intros; Generalize (Rlt_compatibility_r ``-l`` ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` ``(l/2)`` H14); Unfold Rminus.
-Replace ``(l/2)+ -l`` with ``-(l/2)``.
-Replace `` -(((f (x+delta/2))+ -(f x))/(delta/2)+ -l)+ -l`` with ``-(((f (x+delta/2))+ -(f x))/(delta/2))``.
-Intro.
-Generalize (Rlt_Ropp ``-(((f (x+delta/2))+ -(f x))/(delta/2))`` ``-(l/2)`` H15). 
-Repeat Rewrite Ropp_Ropp.
-Intro.
-Generalize (Rlt_trans ``0`` ``l/2`` ``((f (x+delta/2))-(f x))/(delta/2)`` H6 H16); Intro.
-Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)`` ``0`` H17 H10)).
-Ring.
-Pattern 3 l; Rewrite double_var.
-Ring.
-Intros.
-Generalize (Rge_Ropp ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``0`` r).
-Rewrite Ropp_O.
-Intro.
-Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` ``0`` H13 H15)).
-Replace ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` with ``(((f (x))-(f (x+delta/2)))/(delta/2)) +l``.
-Unfold Rminus.
-Apply ge0_plus_gt0_is_gt0.
-Unfold Rdiv; Apply Rmult_le_pos.
-Cut ``x<=(x+(delta*/2))``.
-Intro; Generalize (H0 x ``x+(delta*/2)`` H13); Intro; Generalize (Rle_compatibility ``-(f (x+delta/2))`` ``(f (x+delta/2))`` ``(f x)`` H14); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
-Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_Rinv; Assumption.
-Assumption.
-Rewrite Ropp_distr2.
-Unfold Rminus.
-Rewrite (Rplus_sym l).
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Rewrite (Rplus_sym (f x)).
-Reflexivity.
-Replace ``((f (x+delta/2))-(f x))/(delta/2)`` with ``-(((f x)-(f (x+delta/2)))/(delta/2))``.
-Rewrite <- Ropp_O.
-Apply Rge_Ropp.
-Apply Rle_sym1.
-Unfold Rdiv; Apply Rmult_le_pos.
-Cut ``x<=(x+(delta*/2))``.
-Intro; Generalize (H0 x ``x+(delta*/2)`` H10); Intro.
-Generalize (Rle_compatibility ``-(f (x+delta/2))`` ``(f (x+delta/2))`` ``(f x)`` H13); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
-Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_Rinv; Assumption.
-Unfold Rdiv; Rewrite <- Ropp_mul1.
-Rewrite Ropp_distr2.
-Reflexivity.
-Split.
-Unfold Rdiv; Apply prod_neq_R0.
-Generalize (cond_pos delta); Intro; Red; Intro H9; Rewrite H9 in H8; Elim (Rlt_antirefl ``0`` H8).
-Apply Rinv_neq_R0; DiscrR.
-Split.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Rewrite Rabsolu_right.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double; Pattern 1 (pos delta); Rewrite <- Rplus_Or.
-Apply Rlt_compatibility; Apply (cond_pos delta).
-DiscrR.
-Apply Rle_sym1; Unfold Rdiv; Left; Apply Rmult_lt_pos.
-Apply (cond_pos delta).
-Apply Rlt_Rinv; Sup0.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply H4 | Apply Rlt_Rinv; Sup0].
-Qed.
-
-(**********)
-Lemma increasing_decreasing_opp : (f:R->R) (increasing f) -> (decreasing (opp_fct f)).
-Unfold increasing decreasing opp_fct; Intros; Generalize (H x y H0); Intro; Apply Rge_Ropp; Apply Rle_sym1; Assumption.
-Qed.
-
-(**********)
-Lemma nonpos_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))<=0``) -> (decreasing f).
-Intros.
-Cut (h:R)``-(-(f h))==(f h)``.
-Intro.
-Generalize (increasing_decreasing_opp (opp_fct f)).
-Unfold decreasing.
-Unfold opp_fct.
-Intros.
-Rewrite <- (H0 x); Rewrite <- (H0 y).
-Apply H1.
-Cut (x:R)``0<=(derive_pt (opp_fct f) x ((derivable_opp f pr) x))``.
-Intros.
-Replace [x:R]``-(f x)`` with (opp_fct f); [Idtac | Reflexivity].
-Apply (nonneg_derivative_1 (opp_fct f) (derivable_opp f pr) H3).
-Intro.
-Assert H3 := (derive_pt_opp f x0 (pr x0)).
-Cut ``(derive_pt (opp_fct f) x0 (derivable_pt_opp f x0 (pr x0)))==(derive_pt (opp_fct f) x0 (derivable_opp f pr x0))``.
-Intro.
-Rewrite <- H4.
-Rewrite H3.
-Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Apply (H x0).
-Apply pr_nu.
-Assumption.
-Intro; Ring.
-Qed.
- 
-(**********)
-Lemma positive_derivative : (f:R->R;pr:(derivable f)) ((x:R) ``0<(derive_pt f x (pr x))``)->(strict_increasing f).
-Intros.
-Unfold strict_increasing.
-Intros.
-Apply Rlt_anti_compatibility with ``-(f x)``.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
-Assert H1 := (MVT_cor1 f ? ? pr H0).
-Elim H1; Intros.
-Elim H2; Intros.
-Unfold Rminus in H3.
-Rewrite H3.
-Apply Rmult_lt_pos.
-Apply H.
-Apply Rlt_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
-Qed.
-
-(**********)
-Lemma strictincreasing_strictdecreasing_opp : (f:R->R) (strict_increasing f) ->
-(strict_decreasing (opp_fct f)).
-Unfold strict_increasing strict_decreasing opp_fct; Intros; Generalize (H x y H0); Intro; Apply Rlt_Ropp; Assumption.
-Qed.
- 
-(**********)
-Lemma negative_derivative : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))<0``)->(strict_decreasing f).
-Intros.
-Cut (h:R)``- (-(f h))==(f h)``.
-Intros.
-Generalize (strictincreasing_strictdecreasing_opp (opp_fct f)).
-Unfold strict_decreasing opp_fct.
-Intros.
-Rewrite <- (H0 x).
-Rewrite <- (H0 y).
-Apply H1; [Idtac | Assumption].
-Cut (x:R)``0<(derive_pt (opp_fct f) x (derivable_opp f pr x))``.
-Intros; EApply positive_derivative; Apply H3.
-Intro.
-Assert H3 := (derive_pt_opp f x0 (pr x0)).
-Cut ``(derive_pt (opp_fct f) x0 (derivable_pt_opp f x0 (pr x0)))==(derive_pt (opp_fct f) x0 (derivable_opp f pr x0))``.
-Intro.
-Rewrite <- H4; Rewrite H3.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Apply (H x0).
-Apply pr_nu.
-Intro; Ring.
-Qed.
- 
-(**********)
-Lemma null_derivative_0 : (f:R->R;pr:(derivable f)) (constant f)->((x:R) ``(derive_pt f x (pr x))==0``). 
-Intros.
-Unfold constant in H.
-Apply derive_pt_eq_0.
-Intros; Exists (mkposreal ``1`` Rlt_R0_R1); Simpl; Intros.
-Rewrite (H x ``x+h``); Unfold Rminus; Unfold Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Qed.
-
-(**********)
-Lemma increasing_decreasing : (f:R->R) (increasing f) -> (decreasing f) -> (constant f).
-Unfold increasing decreasing constant; Intros; Case (total_order x y); Intro.
-Generalize (Rlt_le x y H1); Intro; Apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)).
-Elim H1; Intro.
-Rewrite H2; Reflexivity.
-Generalize (Rlt_le y x H2); Intro; Symmetry; Apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)).
-Qed.
-
-(**********)
-Lemma null_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))==0``)->(constant f).
-Intros.
-Cut (x:R)``(derive_pt f x (pr x)) <= 0``.
-Cut (x:R)``0 <= (derive_pt f x (pr x))``.
-Intros.
-Assert H2 := (nonneg_derivative_1 f pr H0).
-Assert H3 := (nonpos_derivative_1 f  pr H1).
-Apply increasing_decreasing; Assumption.
-Intro; Right; Symmetry; Apply (H x).
-Intro; Right; Apply (H x).
-Qed.
-
-(**********)
-Lemma derive_increasing_interv_ax : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> (((t:R) ``a<t<b`` -> ``0<(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<(f y)``)) /\ (((t:R) ``a<t<b`` -> ``0<=(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<=(f y)``)).
-Intros.
-Split; Intros.
-Apply Rlt_anti_compatibility with ``-(f x)``.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
-Assert H4 := (MVT_cor1 f ? ? pr H3).
-Elim H4; Intros.
-Elim H5; Intros.
-Unfold Rminus in H6.
-Rewrite H6.
-Apply Rmult_lt_pos.
-Apply H0.
-Elim H7; Intros.
-Split.
-Elim H1; Intros.
-Apply Rle_lt_trans with x; Assumption.
-Elim H2; Intros.
-Apply Rlt_le_trans with y; Assumption.
-Apply Rlt_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
-Apply Rle_anti_compatibility with ``-(f x)``.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
-Assert H4 := (MVT_cor1 f ? ? pr H3).
-Elim H4; Intros.
-Elim H5; Intros.
-Unfold Rminus in H6.
-Rewrite H6.
-Apply Rmult_le_pos.
-Apply H0.
-Elim H7; Intros.
-Split.
-Elim H1; Intros.
-Apply Rle_lt_trans with x; Assumption.
-Elim H2; Intros.
-Apply Rlt_le_trans with y; Assumption.
-Apply Rle_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Left; Assumption | Ring].
-Qed.
-
-(**********)
-Lemma derive_increasing_interv : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> ((t:R) ``a<t<b`` -> ``0<(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<(f y)``).
-Intros.
-Generalize (derive_increasing_interv_ax a b f pr H); Intro.
-Elim H4; Intros H5 _; Apply (H5 H0 x y H1 H2 H3).
-Qed.
-
-(**********)
-Lemma derive_increasing_interv_var : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> ((t:R) ``a<t<b`` -> ``0<=(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<=(f y)``).
-Intros a b f pr H H0 x y H1 H2 H3; Generalize (derive_increasing_interv_ax a b f pr H); Intro; Elim H4; Intros _ H5; Apply (H5 H0 x y H1 H2 H3).
-Qed.
-
-(**********)
-(**********)
-Theorem IAF : (f:R->R;a,b,k:R;pr:(derivable f)) ``a<=b`` -> ((c:R) ``a<=c<=b`` -> ``(derive_pt f c (pr c))<=k``) -> ``(f b)-(f a)<=k*(b-a)``.
-Intros.
-Case (total_order_T a b); Intro.
-Elim s; Intro.
-Assert H1 := (MVT_cor1 f ? ? pr a0).
-Elim H1; Intros.
-Elim H2; Intros.
-Rewrite H3.
-Do 2 Rewrite <- (Rmult_sym ``(b-a)``).
-Apply Rle_monotony.
-Apply Rle_anti_compatibility with ``a``; Rewrite Rplus_Or.
-Replace ``a+(b-a)`` with b; [Assumption | Ring].
-Apply H0.
-Elim H4; Intros.
-Split; Left; Assumption.
-Rewrite b0.
-Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r.
-Rewrite Rmult_Or; Right; Reflexivity.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Qed.
-
-Lemma IAF_var : (f,g:R->R;a,b:R;pr1:(derivable f);pr2:(derivable g)) ``a<=b`` -> ((c:R) ``a<=c<=b`` -> ``(derive_pt g c (pr2 c))<=(derive_pt f c (pr1 c))``) -> ``(g b)-(g a)<=(f b)-(f a)``.
-Intros.
-Cut (derivable (minus_fct g f)).
-Intro.
-Cut (c:R)``a<=c<=b``->``(derive_pt (minus_fct g f) c (X c))<=0``.
-Intro. 
-Assert H2 := (IAF (minus_fct g f) a b R0 X H H1).
-Rewrite Rmult_Ol in H2; Unfold minus_fct in H2.
-Apply Rle_anti_compatibility with ``-(f b)+(f a)``.
-Replace ``-(f b)+(f a)+((f b)-(f a))`` with R0; [Idtac | Ring].
-Replace ``-(f b)+(f a)+((g b)-(g a))`` with ``(g b)-(f b)-((g a)-(f a))``; [Apply H2 | Ring].
-Intros.
-Cut (derive_pt (minus_fct g f) c (X c))==(derive_pt (minus_fct g f) c (derivable_pt_minus ? ? ? (pr2 c) (pr1 c))).
-Intro.
-Rewrite H2.
-Rewrite derive_pt_minus.
-Apply Rle_anti_compatibility with (derive_pt f c (pr1 c)).
-Rewrite Rplus_Or.
-Replace ``(derive_pt f c (pr1 c))+((derive_pt g c (pr2 c))-(derive_pt f c (pr1 c)))`` with ``(derive_pt g c (pr2 c))``; [Idtac | Ring].
-Apply H0; Assumption.
-Apply pr_nu.
-Apply derivable_minus; Assumption.
-Qed.
-
-(* If f has a null derivative in ]a,b[ and is continue in [a,b], *)
-(* then f is constant on [a,b] *)
-Lemma null_derivative_loc : (f:R->R;a,b:R;pr:(x:R)``a<x<b``->(derivable_pt f x)) ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ((x:R;P:``a<x<b``)(derive_pt f x (pr x P))==R0) -> (constant_D_eq f [x:R]``a<=x<=b`` (f a)).
-Intros; Unfold constant_D_eq; Intros; Case (total_order_T a b); Intro.
-Elim s; Intro.
-Assert H2 : (y:R)``a<y<x``->(derivable_pt id y).
-Intros; Apply derivable_pt_id.
-Assert H3 : (y:R)``a<=y<=x``->(continuity_pt id y).
-Intros; Apply derivable_continuous; Apply derivable_id.
-Assert H4 : (y:R)``a<y<x``->(derivable_pt f y).
-Intros; Apply pr; Elim H4; Intros; Split.
-Assumption.
-Elim H1; Intros; Apply Rlt_le_trans with x; Assumption.
-Assert H5 : (y:R)``a<=y<=x``->(continuity_pt f y).
-Intros; Apply H; Elim H5; Intros; Split.
-Assumption.
-Elim H1; Intros; Apply Rle_trans with x; Assumption.
-Elim H1; Clear H1; Intros; Elim H1; Clear H1; Intro.
-Assert H7 := (MVT f id a x H4 H2 H1 H5 H3).
-Elim H7; Intros; Elim H8; Intros; Assert H10 : ``a<x0<b``.
-Elim x1; Intros; Split.
-Assumption.
-Apply Rlt_le_trans with x; Assumption.
-Assert H11 : ``(derive_pt f x0 (H4 x0 x1))==0``.
-Replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10)); [Apply H0 | Apply pr_nu].
-Assert H12 : ``(derive_pt id x0 (H2 x0 x1))==1``.
-Apply derive_pt_eq_0; Apply derivable_pt_lim_id.
-Rewrite H11 in H9; Rewrite H12 in H9; Rewrite Rmult_Or in H9; Rewrite Rmult_1r in H9; Apply Rminus_eq; Symmetry; Assumption.
-Rewrite H1; Reflexivity.
-Assert H2 : x==a.
-Rewrite <- b0 in H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
-Rewrite H2; Reflexivity.
-Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H2 H3) r)).
-Qed.
-
-(* Unicity of the antiderivative *)
-Lemma antiderivative_Ucte : (f,g1,g2:R->R;a,b:R) (antiderivative f g1 a b) -> (antiderivative f g2 a b) -> (EXT c:R | (x:R)``a<=x<=b``->``(g1 x)==(g2 x)+c``).
-Unfold antiderivative; Intros; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros H0 _; Exists ``(g1 a)-(g2 a)``; Intros; Assert H3 : (x:R)``a<=x<=b``->(derivable_pt g1 x).
-Intros; Unfold derivable_pt; Apply Specif.existT with (f x0); Elim (H x0 H3); Intros; EApply derive_pt_eq_1; Symmetry; Apply H4.
-Assert H4 : (x:R)``a<=x<=b``->(derivable_pt g2 x).
-Intros; Unfold derivable_pt; Apply Specif.existT with (f x0); Elim (H0 x0 H4); Intros; EApply derive_pt_eq_1; Symmetry; Apply H5.
-Assert H5 : (x:R)``a<x<b``->(derivable_pt (minus_fct g1 g2) x).
-Intros; Elim H5; Intros; Apply derivable_pt_minus; [Apply H3; Split; Left; Assumption | Apply H4; Split; Left; Assumption].
-Assert H6 : (x:R)``a<=x<=b``->(continuity_pt (minus_fct g1 g2) x).
-Intros; Apply derivable_continuous_pt; Apply derivable_pt_minus; [Apply H3 | Apply H4]; Assumption.
-Assert H7 : (x:R;P:``a<x<b``)(derive_pt (minus_fct g1 g2) x (H5 x P))==``0``.
-Intros; Elim P; Intros; Apply derive_pt_eq_0; Replace R0 with ``(f x0)-(f x0)``; [Idtac | Ring].
-Assert H9 : ``a<=x0<=b``.
-Split; Left; Assumption.
-Apply derivable_pt_lim_minus; [Elim (H ? H9) | Elim (H0 ? H9)]; Intros; EApply derive_pt_eq_1; Symmetry; Apply H10.
-Assert H8 := (null_derivative_loc (minus_fct g1 g2) a b H5 H6 H7); Unfold constant_D_eq in H8; Assert H9 := (H8 ? H2); Unfold minus_fct in H9; Rewrite <- H9; Ring.
-Qed.
diff --git a/theories7/Reals/NewtonInt.v b/theories7/Reals/NewtonInt.v
deleted file mode 100644
index 56e5f15e..00000000
--- a/theories7/Reals/NewtonInt.v
+++ /dev/null
@@ -1,600 +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: NewtonInt.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(*******************************************)
-(*            Newton's Integral            *)
-(*******************************************)
-
-Definition Newton_integrable [f:R->R;a,b:R] : Type := (sigTT ? [g:R->R](antiderivative f g a b)\/(antiderivative f g b a)).
-
-Definition NewtonInt [f:R->R;a,b:R;pr:(Newton_integrable f a b)] : R := let g = Cases pr of (existTT a b) => a end in ``(g b)-(g a)``.
-
-(* If f is differentiable, then f' is Newton integrable (Tautology ?) *)
-Lemma FTCN_step1 : (f:Differential;a,b:R) (Newton_integrable [x:R](derive_pt f x (cond_diff f x)) a b).
-Intros f a b; Unfold Newton_integrable; Apply existTT with (d1 f); Unfold antiderivative; Intros; Case (total_order_Rle a b); Intro; [Left; Split; [Intros; Exists (cond_diff f x); Reflexivity | Assumption] | Right; Split; [Intros; Exists (cond_diff f x); Reflexivity | Auto with real]].
-Defined.
-
-(* By definition, we have the Fondamental Theorem of Calculus *)
-Lemma FTC_Newton : (f:Differential;a,b:R) (NewtonInt [x:R](derive_pt f x (cond_diff f x)) a b (FTCN_step1 f a b))==``(f b)-(f a)``.
-Intros; Unfold NewtonInt; Reflexivity.
-Qed.
-
-(* $\int_a^a f$ exists forall a:R and f:R->R *)
-Lemma NewtonInt_P1 : (f:R->R;a:R) (Newton_integrable f a a).
-Intros f a; Unfold Newton_integrable; Apply existTT with (mult_fct (fct_cte (f a)) id); Left; Unfold antiderivative; Split.
-Intros; Assert H1 : (derivable_pt (mult_fct (fct_cte (f a)) id) x).
-Apply derivable_pt_mult.
-Apply derivable_pt_const.
-Apply derivable_pt_id.
-Exists H1; Assert H2 : x==a.
-Elim H; Intros; Apply Rle_antisym; Assumption.
-Symmetry; Apply derive_pt_eq_0; Replace (f x) with ``0*(id x)+(fct_cte (f a) x)*1``; [Apply (derivable_pt_lim_mult (fct_cte (f a)) id x); [Apply derivable_pt_lim_const | Apply derivable_pt_lim_id] | Unfold id fct_cte; Rewrite H2; Ring].
-Right; Reflexivity.
-Defined.
-
-(* $\int_a^a f = 0$ *)
-Lemma NewtonInt_P2 : (f:R->R;a:R) ``(NewtonInt f a a (NewtonInt_P1 f a))==0``.
-Intros; Unfold NewtonInt; Simpl; Unfold mult_fct fct_cte id; Ring.
-Qed.
-
-(* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *)
-Lemma NewtonInt_P3 : (f:R->R;a,b:R;X:(Newton_integrable f a b)) (Newton_integrable f b a).
-Unfold Newton_integrable; Intros; Elim X; Intros g H; Apply existTT with g; Tauto.
-Defined.
-
-(* $\int_a^b f = -\int_b^a f$ *)
-Lemma NewtonInt_P4 : (f:R->R;a,b:R;pr:(Newton_integrable f a b)) ``(NewtonInt f a b pr)==-(NewtonInt f b a (NewtonInt_P3 f a b pr))``.
-Intros; Unfold Newton_integrable in pr; Elim pr; Intros; Elim p; Intro.
-Unfold NewtonInt; Case (NewtonInt_P3 f a b (existTT R->R [g:(R->R)](antiderivative f g a b)\/(antiderivative f g b a) x p)).
-Intros; Elim o; Intro.
-Unfold antiderivative in H0; Elim H0; Intros; Elim H2; Intro.
-Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)).
-Rewrite H3; Ring.
-Assert H1 := (antiderivative_Ucte f x x0 a b H H0); Elim H1; Intros; Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Assert H3 : ``a<=a<=b``.
-Split; [Right; Reflexivity | Assumption].
-Assert H4 : ``a<=b<=b``.
-Split; [Assumption | Right; Reflexivity].
-Assert H5 := (H2 ? H3); Assert H6 := (H2 ? H4); Rewrite H5; Rewrite H6; Ring.
-Unfold NewtonInt; Case (NewtonInt_P3 f a b (existTT R->R [g:(R->R)](antiderivative f g a b)\/(antiderivative f g b a) x p)); Intros; Elim o; Intro.
-Assert H1 := (antiderivative_Ucte f x x0 b a H H0); Elim H1; Intros; Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Assert H3 : ``b<=a<=a``.
-Split; [Assumption | Right; Reflexivity].
-Assert H4 : ``b<=b<=a``.
-Split; [Right; Reflexivity | Assumption].
-Assert H5 := (H2 ? H3); Assert H6 := (H2 ? H4); Rewrite H5; Rewrite H6; Ring.
-Unfold antiderivative in H0; Elim H0; Intros; Elim H2; Intro.
-Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)).
-Rewrite H3; Ring.
-Qed.
-
-(* The set of Newton integrable functions is a vectorial space *)
-Lemma NewtonInt_P5 : (f,g:R->R;l,a,b:R) (Newton_integrable f a b) -> (Newton_integrable g a b) -> (Newton_integrable [x:R]``l*(f x)+(g x)`` a b).
-Unfold Newton_integrable; Intros; Elim X; Intros; Elim X0; Intros; Exists [y:R]``l*(x y)+(x0 y)``.
-Elim p; Intro.
-Elim p0; Intro.
-Left; Unfold antiderivative; Unfold antiderivative in H H0; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros H0 _.
-Split.
-Intros; Elim (H ? H2); Elim (H0 ? H2); Intros.
-Assert H5 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
-Reg.
-Exists H5; Symmetry; Reg; Rewrite <- H3; Rewrite <- H4; Reflexivity.
-Assumption.
-Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Elim H4; Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H5 H2)).
-Left; Rewrite <- H5; Unfold antiderivative; Split.
-Intros; Elim H6; Intros; Assert H9 : ``x1==a``.
-Apply Rle_antisym; Assumption.
-Assert H10 : ``a<=x1<=b``.
-Split; Right; [Symmetry; Assumption | Rewrite <- H5; Assumption].
-Assert H11 : ``b<=x1<=a``.
-Split; Right; [Rewrite <- H5; Symmetry; Assumption | Assumption].
-Assert H12 : (derivable_pt x x1).
-Unfold derivable_pt; Exists (f x1); Elim (H3 ? H10); Intros; EApply derive_pt_eq_1; Symmetry; Apply H12.
-Assert H13 : (derivable_pt x0 x1).
-Unfold derivable_pt; Exists (g x1); Elim (H1 ? H11); Intros; EApply derive_pt_eq_1; Symmetry; Apply H13.
-Assert H14 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
-Reg.
-Exists H14; Symmetry; Reg.
-Assert H15 : ``(derive_pt x0 x1 H13)==(g x1)``.
-Elim (H1 ? H11); Intros; Rewrite H15; Apply pr_nu.
-Assert H16 : ``(derive_pt x x1 H12)==(f x1)``.
-Elim (H3 ? H10); Intros; Rewrite H16; Apply pr_nu.
-Rewrite H15; Rewrite H16; Ring.
-Right; Reflexivity.
-Elim p0; Intro.
-Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Elim H4; Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H5 H2)).
-Left; Rewrite H5; Unfold antiderivative; Split.
-Intros; Elim H6; Intros; Assert H9 : ``x1==a``.
-Apply Rle_antisym; Assumption.
-Assert H10 : ``a<=x1<=b``.
-Split; Right; [Symmetry; Assumption | Rewrite H5; Assumption].
-Assert H11 : ``b<=x1<=a``.
-Split; Right; [Rewrite H5; Symmetry; Assumption | Assumption].
-Assert H12 : (derivable_pt x x1).
-Unfold derivable_pt; Exists (f x1); Elim (H3 ? H11); Intros; EApply derive_pt_eq_1; Symmetry; Apply H12.
-Assert H13 : (derivable_pt x0 x1).
-Unfold derivable_pt; Exists (g x1); Elim (H1 ? H10); Intros; EApply derive_pt_eq_1; Symmetry; Apply H13.
-Assert H14 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
-Reg.
-Exists H14; Symmetry; Reg.
-Assert H15 : ``(derive_pt x0 x1 H13)==(g x1)``.
-Elim (H1 ? H10); Intros; Rewrite H15; Apply pr_nu.
-Assert H16 : ``(derive_pt x x1 H12)==(f x1)``.
-Elim (H3 ? H11); Intros; Rewrite H16; Apply pr_nu.
-Rewrite H15; Rewrite H16; Ring.
-Right; Reflexivity.
-Right; Unfold antiderivative; Unfold antiderivative in H H0; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros H0 _; Split.
-Intros; Elim (H ? H2); Elim (H0 ? H2); Intros.
-Assert H5 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
-Reg.
-Exists H5; Symmetry; Reg; Rewrite <- H3; Rewrite <- H4; Reflexivity.
-Assumption.
-Defined.
-
-(**********)
-Lemma antiderivative_P1 : (f,g,F,G:R->R;l,a,b:R) (antiderivative f F a b) -> (antiderivative g G a b) -> (antiderivative [x:R]``l*(f x)+(g x)`` [x:R]``l*(F x)+(G x)`` a b).
-Unfold antiderivative; Intros; Elim H; Elim H0; Clear H H0; Intros; Split.
-Intros; Elim (H ? H3); Elim (H1 ? H3); Intros.
-Assert H6 : (derivable_pt [x:R]``l*(F x)+(G x)`` x).
-Reg.
-Exists H6; Symmetry; Reg; Rewrite <- H4; Rewrite <- H5; Ring.
-Assumption.
-Qed.
-
-(* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *)
-Lemma NewtonInt_P6 : (f,g:R->R;l,a,b:R;pr1:(Newton_integrable f a b);pr2:(Newton_integrable g a b)) (NewtonInt [x:R]``l*(f x)+(g x)`` a b (NewtonInt_P5 f g l a b pr1 pr2))==``l*(NewtonInt f a b pr1)+(NewtonInt g a b pr2)``.
-Intros f g l a b pr1 pr2; Unfold NewtonInt; Case (NewtonInt_P5 f g l a b pr1 pr2); Intros; Case pr1; Intros; Case pr2; Intros; Case (total_order_T a b); Intro.
-Elim s; Intro.
-Elim o; Intro.
-Elim o0; Intro.
-Elim o1; Intro.
-Assert H2 := (antiderivative_P1 f g x0 x1 l a b H0 H1); Assert H3 := (antiderivative_Ucte ? ? ? ? ? H H2); Elim H3; Intros; Assert H5 : ``a<=a<=b``.
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H6 : ``a<=b<=b``.
-Split; [Left; Assumption | Right; Reflexivity].
-Assert H7 := (H4 ? H5); Assert H8 := (H4 ? H6); Rewrite H7; Rewrite H8; Ring.
-Unfold antiderivative in H1; Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 a0)).
-Unfold antiderivative in H0; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
-Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 a0)).
-Rewrite b0; Ring.
-Elim o; Intro.
-Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 r)).
-Elim o0; Intro.
-Unfold antiderivative in H0; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 r)).
-Elim o1; Intro.
-Unfold antiderivative in H1; Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 r)).
-Assert H2 := (antiderivative_P1 f g x0 x1 l b a H0 H1); Assert H3 := (antiderivative_Ucte ? ? ? ? ? H H2); Elim H3; Intros; Assert H5 : ``b<=a<=a``.
-Split; [Left; Assumption | Right; Reflexivity].
-Assert H6 : ``b<=b<=a``.
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H7 := (H4 ? H5); Assert H8 := (H4 ? H6); Rewrite H7; Rewrite H8; Ring.
-Qed.
-
-Lemma antiderivative_P2 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 b c) -> (antiderivative f [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))``  end) a c).
-Unfold antiderivative; Intros; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros; Split.
-2:Apply Rle_trans with b; Assumption.
-Intros; Elim H3; Clear H3; Intros; Case (total_order_T x b); Intro.
-Elim s; Intro.
-Assert H5 : ``a<=x<=b``.
-Split; [Assumption | Left; Assumption].
-Assert H6 := (H ? H5); Elim H6; Clear H6; Intros; Assert H7 : (derivable_pt_lim [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) x (f x)).
-Unfold derivable_pt_lim; Assert H7 : ``(derive_pt F0 x x0)==(f x)``.
-Symmetry; Assumption.
-Assert H8 := (derive_pt_eq_1 F0 x (f x) x0 H7); Unfold derivable_pt_lim in H8; Intros; Elim (H8 ? H9); Intros; Pose D := (Rmin x1 ``b-x``).
-Assert H11 : ``0<D``.
-Unfold D; Unfold Rmin; Case (total_order_Rle x1 ``b-x``); Intro.
-Apply (cond_pos x1).
-Apply Rlt_Rminus; Assumption.
-Exists (mkposreal ? H11); Intros; Case (total_order_Rle x b); Intro.
-Case (total_order_Rle ``x+h`` b); Intro.
-Apply H10.
-Assumption.
-Apply Rlt_le_trans with D; [Assumption | Unfold D; Apply Rmin_l].
-Elim n; Left; Apply Rlt_le_trans with ``x+D``.
-Apply Rlt_compatibility; Apply Rle_lt_trans with (Rabsolu h).
-Apply Rle_Rabsolu.
-Apply H13.
-Apply Rle_anti_compatibility with ``-x``; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite Rplus_sym; Unfold D; Apply Rmin_r.
-Elim n; Left; Assumption.
-Assert H8 : (derivable_pt  [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x).
-Unfold derivable_pt; Apply Specif.existT with (f x); Apply H7.
-Exists H8; Symmetry; Apply derive_pt_eq_0; Apply H7.
-Assert H5 : ``a<=x<=b``.
-Split; [Assumption | Right; Assumption].
-Assert H6 :  ``b<=x<=c``.
-Split; [Right; Symmetry; Assumption | Assumption].
-Elim (H ? H5); Elim (H0 ? H6); Intros; Assert H9 : (derive_pt F0 x x1)==(f x).
-Symmetry; Assumption.
-Assert H10 : (derive_pt F1 x x0)==(f x).
-Symmetry; Assumption.
-Assert H11 := (derive_pt_eq_1 F0 x (f x) x1 H9); Assert H12 := (derive_pt_eq_1 F1 x (f x) x0 H10); Assert H13 : (derivable_pt_lim [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x (f x)).
-Unfold derivable_pt_lim; Unfold derivable_pt_lim in H11 H12; Intros; Elim (H11 ? H13); Elim (H12 ? H13); Intros; Pose D := (Rmin x2 x3); Assert H16 : ``0<D``.
-Unfold D; Unfold Rmin; Case (total_order_Rle x2 x3); Intro.
-Apply (cond_pos x2).
-Apply (cond_pos x3).
-Exists (mkposreal ? H16); Intros; Case (total_order_Rle x b); Intro.
-Case (total_order_Rle ``x+h`` b); Intro.
-Apply H15.
-Assumption.
-Apply Rlt_le_trans with D; [Assumption | Unfold D; Apply Rmin_r].
-Replace ``(F1 (x+h))+((F0 b)-(F1 b))-(F0 x)`` with ``(F1 (x+h))-(F1 x)``.
-Apply H14.
-Assumption.
-Apply Rlt_le_trans with D; [Assumption | Unfold D; Apply Rmin_l].
-Rewrite b0; Ring.
-Elim n; Right; Assumption.
-Assert H14 : (derivable_pt [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) x).
-Unfold derivable_pt; Apply Specif.existT with (f x); Apply H13.
-Exists H14; Symmetry; Apply derive_pt_eq_0; Apply H13.
-Assert H5 : ``b<=x<=c``.
-Split; [Left; Assumption | Assumption].
-Assert H6 := (H0 ? H5); Elim H6; Clear H6; Intros; Assert H7 : (derivable_pt_lim [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x (f x)).
-Unfold derivable_pt_lim; Assert H7 : ``(derive_pt F1 x x0)==(f x)``.
-Symmetry; Assumption.
-Assert H8 := (derive_pt_eq_1 F1 x (f x) x0 H7); Unfold derivable_pt_lim in H8; Intros; Elim (H8 ? H9); Intros; Pose D := (Rmin x1 ``x-b``); Assert H11 : ``0<D``.
-Unfold D; Unfold Rmin; Case (total_order_Rle x1 ``x-b``); Intro.
-Apply (cond_pos x1).
-Apply Rlt_Rminus; Assumption.
-Exists (mkposreal ? H11); Intros; Case (total_order_Rle x b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 r)).
-Case (total_order_Rle ``x+h`` b); Intro.
-Cut ``b<x+h``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H14)).
-Apply Rlt_anti_compatibility with ``-h-b``; Replace ``-h-b+b`` with ``-h``; [Idtac | Ring]; Replace ``-h-b+(x+h)`` with ``x-b``; [Idtac | Ring]; Apply Rle_lt_trans with (Rabsolu h).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Apply Rlt_le_trans with D.
-Apply H13.
-Unfold D; Apply Rmin_r.
-Replace ``((F1 (x+h))+((F0 b)-(F1 b)))-((F1 x)+((F0 b)-(F1 b)))`` with ``(F1 (x+h))-(F1 x)``; [Idtac | Ring]; Apply H10.
-Assumption.
-Apply Rlt_le_trans with D.
-Assumption.
-Unfold D; Apply Rmin_l.
-Assert H8 : (derivable_pt  [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x).
-Unfold derivable_pt; Apply Specif.existT with (f x); Apply H7.
-Exists H8; Symmetry; Apply derive_pt_eq_0; Apply H7.
-Qed.
-
-Lemma antiderivative_P3 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 c b) -> (antiderivative f F1 c a)\/(antiderivative f F0 a c).
-Intros; Unfold antiderivative in H H0; Elim H; Clear H; Elim H0; Clear H0; Intros; Case (total_order_T a c); Intro.
-Elim s; Intro.
-Right; Unfold antiderivative; Split.
-Intros; Apply H1; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with c; Assumption].
-Left; Assumption.
-Right; Unfold antiderivative; Split.
-Intros; Apply H1; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with c; Assumption].
-Right; Assumption.
-Left; Unfold antiderivative; Split.
-Intros; Apply H; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with a; Assumption].
-Left; Assumption.
-Qed.
-
-Lemma antiderivative_P4 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 a c) -> (antiderivative f F1 b c)\/(antiderivative f F0 c b).
-Intros; Unfold antiderivative in H H0; Elim H; Clear H; Elim H0; Clear H0; Intros; Case (total_order_T c b); Intro.
-Elim s; Intro.
-Right; Unfold antiderivative; Split.
-Intros; Apply H1; Elim H3; Intros; Split; [Apply Rle_trans with c; Assumption | Assumption].
-Left; Assumption.
-Right; Unfold antiderivative; Split.
-Intros; Apply H1; Elim H3; Intros; Split; [Apply Rle_trans with c; Assumption | Assumption].
-Right; Assumption.
-Left; Unfold antiderivative; Split.
-Intros; Apply H; Elim H3; Intros; Split; [Apply Rle_trans with b; Assumption | Assumption].
-Left; Assumption.
-Qed.
-
-Lemma NewtonInt_P7 : (f:R->R;a,b,c:R) ``a<b`` -> ``b<c`` -> (Newton_integrable f a b) -> (Newton_integrable f b c) -> (Newton_integrable f a c).
-Unfold Newton_integrable; Intros f a b c Hab Hbc X X0; Elim X; Clear X; Intros F0 H0; Elim X0; Clear X0; Intros F1 H1; Pose g := [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))``  end); Apply existTT with g; Left; Unfold g; Apply antiderivative_P2.
-Elim H0; Intro.
-Assumption.
-Unfold antiderivative in H; Elim H; Clear H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 Hab)).
-Elim H1; Intro.
-Assumption.
-Unfold antiderivative in H; Elim H; Clear H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 Hbc)).
-Qed.
-
-Lemma NewtonInt_P8 : (f:(R->R); a,b,c:R) (Newton_integrable f a b) -> (Newton_integrable f b c) -> (Newton_integrable f a c).
-Intros.
-Elim X; Intros F0 H0.
-Elim X0; Intros F1 H1.
-Case (total_order_T a b); Intro.
-Elim s; Intro.
-Case (total_order_T b c); Intro.
-Elim s0; Intro.
-(* a<b & b<c *)
-Unfold Newton_integrable; Apply existTT with [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end).
-Elim H0; Intro.
-Elim H1; Intro.
-Left; Apply antiderivative_P2; Assumption.
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a1)).
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
-(* a<b & b=c *)
-Rewrite b0 in X; Apply X.
-(* a<b & b>c *)
-Case (total_order_T a c); Intro.
-Elim s0; Intro.
-Unfold Newton_integrable; Apply existTT with F0.
-Left.
-Elim H1; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim H0; Intro.
-Assert H3 := (antiderivative_P3 f F0 F1 a b c H2 H).
-Elim H3; Intro.
-Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 a1)).
-Assumption.
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
-Rewrite b0; Apply NewtonInt_P1.
-Unfold Newton_integrable; Apply existTT with F1.
-Right.
-Elim H1; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim H0; Intro.
-Assert H3 := (antiderivative_P3 f F0 F1 a b c H2 H).
-Elim H3; Intro.
-Assumption.
-Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 r0)).
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
-(* a=b *)
-Rewrite b0; Apply X0.
-Case (total_order_T b c); Intro.
-Elim s; Intro.
-(* a>b & b<c *)
-Case (total_order_T a c); Intro.
-Elim s0; Intro.
-Unfold Newton_integrable; Apply existTT with F1.
-Left.
-Elim H1; Intro.
-(*****************)
-Elim H0; Intro.
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 r)).
-Assert H3 := (antiderivative_P4 f F0 F1 b a c H2 H).
-Elim H3; Intro.
-Assumption.
-Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 a1)).
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
-Rewrite b0; Apply NewtonInt_P1.
-Unfold Newton_integrable; Apply existTT with F0.
-Right.
-Elim H0; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim H1; Intro.
-Assert H3 := (antiderivative_P4 f F0 F1 b a c H H2).
-Elim H3; Intro.
-Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 r0)).
-Assumption.
-Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
-(* a>b & b=c *)
-Rewrite b0 in X; Apply X.
-(* a>b & b>c *)
-Assert X1 := (NewtonInt_P3 f a b X).
-Assert X2 := (NewtonInt_P3 f b c X0).
-Apply NewtonInt_P3.
-Apply NewtonInt_P7 with b; Assumption.
-Defined.
-
-(* Chasles' relation *)
-Lemma NewtonInt_P9 : (f:R->R;a,b,c:R;pr1:(Newton_integrable f a b);pr2:(Newton_integrable f b c)) ``(NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2))==(NewtonInt f a b pr1)+(NewtonInt f b c pr2)``.
-Intros; Unfold NewtonInt.
-Case (NewtonInt_P8 f a b c pr1 pr2); Intros.
-Case pr1; Intros.
-Case pr2; Intros.
-Case (total_order_T a b); Intro.
-Elim s; Intro.
-Case (total_order_T b c); Intro.
-Elim s0; Intro.
-(* a<b & b<c *)
-Elim o0; Intro.
-Elim o1; Intro.
-Elim o; Intro.
-Assert H2 := (antiderivative_P2 f x0 x1 a b c H H0).
-Assert H3 := (antiderivative_Ucte f x [x:R]
-          Cases (total_order_Rle x b) of
-            (leftT _) => (x0 x)
-          | (rightT _) => ``(x1 x)+((x0 b)-(x1 b))``
-          end a c H1 H2).
-Elim H3; Intros.
-Assert H5 : ``a<=a<=c``.
-Split; [Right; Reflexivity | Left; Apply Rlt_trans with b; Assumption].
-Assert H6 : ``a<=c<=c``.
-Split; [Left; Apply Rlt_trans with b; Assumption | Right; Reflexivity].
-Rewrite (H4 ? H5); Rewrite (H4 ? H6).
-Case (total_order_Rle a b); Intro.
-Case (total_order_Rle c b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 a1)).
-Ring.
-Elim n; Left; Assumption.
-Unfold antiderivative in H1; Elim H1; Clear H1; Intros _ H1.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 (Rlt_trans ? ? ? a0 a1))).
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a1)).
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
-(* a<b & b=c *)
-Rewrite <- b0.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
-Rewrite <- b0 in o.
-Elim o0; Intro.
-Elim o; Intro.
-Assert H1 := (antiderivative_Ucte f x x0 a b H0 H).
-Elim H1; Intros.
-Rewrite (H2 b).
-Rewrite (H2 a).
-Ring.
-Split; [Right; Reflexivity | Left; Assumption].
-Split; [Left; Assumption | Right; Reflexivity].
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
-(* a<b & b>c *)
-Elim o1; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim o0; Intro.
-Elim o; Intro.
-Assert H2 := (antiderivative_P2 f x x1 a c b H1 H).
-Assert H3 := (antiderivative_Ucte ? ? ? a b H0 H2).
-Elim H3; Intros.
-Rewrite (H4 a).
-Rewrite (H4 b).
-Case (total_order_Rle b c); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 r)).
-Case (total_order_Rle a c); Intro.
-Ring.
-Elim n0; Unfold antiderivative in H1; Elim H1; Intros; Assumption.
-Split; [Left; Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H1 H0).
-Assert H3 := (antiderivative_Ucte ? ? ? c b H H2).
-Elim H3; Intros.
-Rewrite (H4 c).
-Rewrite (H4 b).
-Case (total_order_Rle b a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 a0)).
-Case (total_order_Rle c a); Intro.
-Ring.
-Elim n0; Unfold antiderivative in H1; Elim H1; Intros; Assumption.
-Split; [Left; Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Left; Assumption].
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
-(* a=b *)
-Rewrite b0 in o; Rewrite b0.
-Elim o; Intro.
-Elim o1; Intro.
-Assert H1 := (antiderivative_Ucte ? ? ? b c H H0).
-Elim H1; Intros.
-Assert H3 : ``b<=c``.
-Unfold antiderivative in H; Elim H; Intros; Assumption.
-Rewrite (H2 b).
-Rewrite (H2 c).
-Ring.
-Split; [Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Assumption].
-Assert H1 : ``b==c``.
-Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite H1; Ring.
-Elim o1; Intro.
-Assert H1 : ``b==c``.
-Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite H1; Ring.
-Assert H1 := (antiderivative_Ucte ? ? ? c b H H0).
-Elim H1; Intros.
-Assert H3 : ``c<=b``.
-Unfold antiderivative in H; Elim H; Intros; Assumption.
-Rewrite (H2 c).
-Rewrite (H2 b).
-Ring.
-Split; [Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Assumption].
-(* a>b & b<c *)
-Case (total_order_T b c); Intro.
-Elim s; Intro.
-Elim o0; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim o1; Intro.
-Elim o; Intro.
-Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H H1).
-Assert H3 := (antiderivative_Ucte ? ? ? b c H0 H2).
-Elim H3; Intros.
-Rewrite (H4 b).
-Rewrite (H4 c).
-Case (total_order_Rle b a); Intro.
-Case (total_order_Rle c a); Intro.
-Assert H5 : ``a==c``.
-Unfold antiderivative in  H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
-Rewrite H5; Ring.
-Ring.
-Elim n; Left; Assumption.
-Split; [Left; Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H0 H1).
-Assert H3 := (antiderivative_Ucte ? ? ? b a H H2).
-Elim H3; Intros.
-Rewrite (H4 a).
-Rewrite (H4 b).
-Case (total_order_Rle b c); Intro.
-Case (total_order_Rle a c); Intro.
-Assert H5 : ``a==c``.
-Unfold antiderivative in  H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
-Rewrite H5; Ring.
-Ring.
-Elim n; Left; Assumption.
-Split; [Right; Reflexivity | Left; Assumption].
-Split; [Left; Assumption | Right; Reflexivity].
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
-(* a>b & b=c *)
-Rewrite <- b0.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
-Rewrite <- b0 in o.
-Elim o0; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim o; Intro.
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
-Assert H1 := (antiderivative_Ucte f x x0 b a H0 H).
-Elim H1; Intros.
-Rewrite (H2 b).
-Rewrite (H2 a).
-Ring.
-Split; [Left; Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Left; Assumption].
-(* a>b & b>c *)
-Elim o0; Intro.
-Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Elim o1; Intro.
-Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r0)).
-Elim o; Intro.
-Unfold antiderivative in H1; Elim H1; Clear H1; Intros _ H1.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 (Rlt_trans ? ? ? r0 r))).
-Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H0 H).
-Assert H3 := (antiderivative_Ucte ? ? ? c a H1 H2).
-Elim H3; Intros.
-Assert H5 : ``c<=a``.
-Unfold antiderivative in H1; Elim H1; Intros; Assumption.
-Rewrite (H4 c).
-Rewrite (H4 a).
-Case (total_order_Rle a b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r1 r)).
-Case (total_order_Rle c b); Intro.
-Ring.
-Elim n0; Left; Assumption.
-Split; [Assumption | Right; Reflexivity].
-Split; [Right; Reflexivity | Assumption].
-Qed.
-
diff --git a/theories7/Reals/PSeries_reg.v b/theories7/Reals/PSeries_reg.v
deleted file mode 100644
index 68645379..00000000
--- a/theories7/Reals/PSeries_reg.v
+++ /dev/null
@@ -1,194 +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: PSeries_reg.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Ranalysis1.
-Require Max.
-Require Even.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Definition Boule [x:R;r:posreal] : R -> Prop := [y:R]``(Rabsolu (y-x))<r``.
-
-(* Uniform convergence *)
-Definition CVU [fn:nat->R->R;f:R->R;x:R;r:posreal] : Prop := (eps:R)``0<eps``->(EX N:nat | (n:nat;y:R) (le N n)->(Boule x r y)->``(Rabsolu ((f y)-(fn n y)))<eps``). 
-
-(* Normal convergence *)
-Definition CVN_r [fn:nat->R->R;r:posreal] : Type := (SigT ? [An:nat->R](sigTT R [l:R]((Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu (An k)) n) l)/\((n:nat)(y:R)(Boule R0 r y)->(Rle (Rabsolu (fn n y)) (An n)))))).
-
-Definition CVN_R [fn:nat->R->R] : Type := (r:posreal) (CVN_r fn r).
-
-Definition SFL [fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))] : R-> R := [y:R](Cases (cv y) of (existTT a b) => a end).
-
-(* In a complete space, normal convergence implies uniform convergence *)
-Lemma CVN_CVU : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l));r:posreal) (CVN_r fn r) -> (CVU [n:nat](SP fn n) (SFL fn cv) ``0`` r).
-Intros; Unfold CVU; Intros.
-Unfold CVN_r in X.
-Elim X; Intros An X0.
-Elim X0; Intros s H0.
-Elim H0; Intros.
-Cut (Un_cv [n:nat](Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s) R0).
-Intro; Unfold Un_cv in H3.
-Elim (H3 eps H); Intros N0 H4.
-Exists N0; Intros.
-Apply Rle_lt_trans with (Rabsolu (Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s)).
-Rewrite <- (Rabsolu_Ropp (Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s)); Rewrite Ropp_distr3; Rewrite (Rabsolu_right (Rminus s (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n))).
-EApply sum_maj1.
-Unfold SFL; Case (cv y); Intro.
-Trivial.
-Apply H1.
-Intro; Elim H0; Intros.
-Rewrite (Rabsolu_right (An n0)).
-Apply H8; Apply H6.
-Apply Rle_sym1; Apply Rle_trans with (Rabsolu (fn n0 y)).
-Apply Rabsolu_pos.
-Apply H8; Apply H6.
-Apply Rle_sym1; Apply Rle_anti_compatibility with (sum_f_R0 [k:nat](Rabsolu (An k)) n).
-Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym s); Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Apply sum_incr.
-Apply H1.
-Intro; Apply Rabsolu_pos.
-Unfold R_dist in H4; Unfold Rminus in H4; Rewrite Ropp_O in H4.
-Assert H7 := (H4 n H5).
-Rewrite Rplus_Or in H7; Apply H7.
-Unfold Un_cv in H1; Unfold Un_cv; Intros.
-Elim (H1? H3); Intros.
-Exists x; Intros.
-Unfold R_dist; Unfold R_dist in H4.
-Rewrite minus_R0; Apply H4; Assumption.
-Qed.
-
-(* Each limit of a sequence of functions which converges uniformly is continue *)
-Lemma CVU_continuity : (fn:nat->R->R;f:R->R;x:R;r:posreal) (CVU fn f x r) -> ((n:nat)(y:R) (Boule x r y)->(continuity_pt (fn n) y)) -> ((y:R) (Boule x r y) -> (continuity_pt f y)).
-Intros; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Unfold CVU in H.
-Cut ``0<eps/3``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H ? H3); Intros N0 H4.
-Assert H5 := (H0 N0 y H1).
-Cut (EXT del : posreal | (h:R) ``(Rabsolu h)<del`` -> (Boule x r ``y+h``) ).
-Intro.
-Elim H6; Intros del1 H7.
-Unfold continuity_pt in H5; Unfold continue_in in H5; Unfold limit1_in in H5; Unfold limit_in in H5; Simpl in H5; Unfold R_dist in H5.
-Elim (H5 ? H3); Intros del2 H8.
-Pose del := (Rmin del1 del2).
-Exists del; Intros.
-Split.
-Unfold del; Unfold Rmin; Case (total_order_Rle del1 del2); Intro.
-Apply (cond_pos del1).
-Elim H8; Intros; Assumption.
-Intros; Apply Rle_lt_trans with ``(Rabsolu ((f x0)-(fn N0 x0)))+(Rabsolu ((fn N0 x0)-(f y)))``.
-Replace ``(f x0)-(f y)`` with ``((f x0)-(fn N0 x0))+((fn N0 x0)-(f y))``; [Apply Rabsolu_triang | Ring].
-Apply Rle_lt_trans with ``(Rabsolu ((f x0)-(fn N0 x0)))+(Rabsolu ((fn N0 x0)-(fn N0 y)))+(Rabsolu ((fn N0 y)-(f y)))``.
-Rewrite Rplus_assoc; Apply Rle_compatibility.
-Replace ``(fn N0 x0)-(f y)`` with ``((fn N0 x0)-(fn N0 y))+((fn N0 y)-(f y))``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``eps/3+eps/3+eps/3``.
-Repeat Apply Rplus_lt.
-Apply H4.
-Apply le_n.
-Replace x0 with ``y+(x0-y)``; [Idtac | Ring]; Apply H7.
-Elim H9; Intros.
-Apply Rlt_le_trans with del.
-Assumption.
-Unfold del; Apply Rmin_l.
-Elim H8; Intros.
-Apply H11.
-Split.
-Elim H9; Intros; Assumption.
-Elim H9; Intros; Apply Rlt_le_trans with del.
-Assumption.
-Unfold del; Apply Rmin_r.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply H4.
-Apply le_n.
-Assumption.
-Apply r_Rmult_mult with ``3``.
-Do 2 Rewrite Rmult_Rplus_distr; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
-Ring.
-DiscrR.
-DiscrR.
-Cut ``0<r-(Rabsolu (x-y))``.
-Intro; Exists (mkposreal ? H6).
-Simpl; Intros.
-Unfold Boule; Replace ``y+h-x`` with ``h+(y-x)``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu h)+(Rabsolu (y-x))``.
-Apply Rabsolu_triang.
-Apply Rlt_anti_compatibility with ``-(Rabsolu (x-y))``.
-Rewrite <- (Rabsolu_Ropp ``y-x``); Rewrite Ropp_distr3.
-Replace ``-(Rabsolu (x-y))+r`` with ``r-(Rabsolu (x-y))``.
-Replace ``-(Rabsolu (x-y))+((Rabsolu h)+(Rabsolu (x-y)))`` with (Rabsolu h).
-Apply H7.
-Ring.
-Ring.
-Unfold Boule in H1; Rewrite <- (Rabsolu_Ropp ``x-y``); Rewrite Ropp_distr3; Apply Rlt_anti_compatibility with ``(Rabsolu (y-x))``.
-Rewrite Rplus_Or; Replace ``(Rabsolu (y-x))+(r-(Rabsolu (y-x)))`` with ``(pos r)``; [Apply H1 | Ring].
-Qed.
-
-(**********)
-Lemma continuity_pt_finite_SF : (fn:nat->R->R;N:nat;x:R) ((n:nat)(le n N)->(continuity_pt (fn n) x)) -> (continuity_pt [y:R](sum_f_R0 [k:nat]``(fn k y)`` N) x).
-Intros; Induction N.
-Simpl; Apply (H O); Apply le_n.
-Simpl; Replace [y:R](Rplus (sum_f_R0 [k:nat](fn k y) N) (fn (S N) y)) with (plus_fct [y:R](sum_f_R0 [k:nat](fn k y) N) [y:R](fn (S N) y)); [Idtac | Reflexivity].
-Apply continuity_pt_plus.
-Apply HrecN.
-Intros; Apply H.
-Apply le_trans with N; [Assumption | Apply le_n_Sn].
-Apply (H (S N)); Apply le_n.
-Qed.
-
-(* Continuity and normal convergence *)
-Lemma SFL_continuity_pt : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l));r:posreal) (CVN_r fn r) -> ((n:nat)(y:R) (Boule ``0`` r y) -> (continuity_pt (fn n) y)) -> ((y:R) (Boule ``0`` r y) -> (continuity_pt (SFL fn cv) y)).
-Intros; EApply CVU_continuity.
-Apply CVN_CVU.
-Apply X.
-Intros; Unfold SP; Apply continuity_pt_finite_SF.
-Intros; Apply H.
-Apply H1.
-Apply H0.
-Qed.
-
-Lemma SFL_continuity : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))) (CVN_R fn) -> ((n:nat)(continuity (fn n))) -> (continuity (SFL fn cv)).
-Intros; Unfold continuity; Intro.
-Cut ``0<(Rabsolu x)+1``; [Intro | Apply ge0_plus_gt0_is_gt0; [Apply Rabsolu_pos | Apply Rlt_R0_R1]].
-Cut (Boule ``0`` (mkposreal ? H0) x).
-Intro; EApply SFL_continuity_pt with (mkposreal ? H0).
-Apply X.
-Intros; Apply (H n y).
-Apply H1.
-Unfold Boule; Simpl; Rewrite minus_R0; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Qed.
-
-(* As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) 
-Lemma CVN_R_CVS : (fn:nat->R->R) (CVN_R fn) -> ((x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))).
-Intros; Apply R_complete.
-Unfold SP; Pose An := [N:nat](fn N x).
-Change (Cauchy_crit_series An).
-Apply cauchy_abs.
-Unfold Cauchy_crit_series; Apply CV_Cauchy.
-Unfold CVN_R in X; Cut ``0<(Rabsolu x)+1``.
-Intro; Assert H0 := (X (mkposreal ? H)).
-Unfold CVN_r in H0; Elim H0; Intros Bn H1.
-Elim H1; Intros l H2.
-Elim H2; Intros.
-Apply Rseries_CV_comp with Bn.
-Intro; Split.
-Apply Rabsolu_pos.
-Unfold An; Apply H4; Unfold Boule; Simpl; Rewrite minus_R0.
-Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Apply existTT with l.
-Cut (n:nat)``0<=(Bn n)``.
-Intro; Unfold Un_cv in H3; Unfold Un_cv; Intros.
-Elim (H3 ? H6); Intros.
-Exists x0; Intros.
-Replace (sum_f_R0 Bn n) with (sum_f_R0 [k:nat](Rabsolu (Bn k)) n).
-Apply H7; Assumption.
-Apply sum_eq; Intros; Apply Rabsolu_right; Apply Rle_sym1; Apply H5.
-Intro; Apply Rle_trans with (Rabsolu (An n)).
-Apply Rabsolu_pos.
-Unfold An; Apply H4; Unfold Boule; Simpl; Rewrite minus_R0; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Apply ge0_plus_gt0_is_gt0; [Apply Rabsolu_pos | Apply Rlt_R0_R1].
-Qed.
diff --git a/theories7/Reals/PartSum.v b/theories7/Reals/PartSum.v
deleted file mode 100644
index 4d28bec8..00000000
--- a/theories7/Reals/PartSum.v
+++ /dev/null
@@ -1,475 +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: PartSum.v,v 1.1.2.2 2005/07/13 23:19:16 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require Rcomplete.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Lemma tech1 : (An:nat->R;N:nat) ((n:nat)``(le n N)``->``0<(An n)``) -> ``0 < (sum_f_R0 An N)``.
-Intros; Induction N.
-Simpl; Apply H; Apply le_n.
-Simpl; Apply gt0_plus_gt0_is_gt0.
-Apply HrecN; Intros; Apply H; Apply le_S; Assumption.
-Apply H; Apply le_n.
-Qed.
-
-(* Chasles' relation *)
-Lemma tech2 : (An:nat->R;m,n:nat) (lt m n) -> (sum_f_R0 An n) == (Rplus (sum_f_R0 An m) (sum_f_R0 [i:nat]``(An (plus (S m) i))`` (minus n (S m)))). 
-Intros; Induction n.
-Elim (lt_n_O ? H).
-Cut (lt m n)\/m=n.
-Intro; Elim H0; Intro.
-Replace (sum_f_R0 An (S n)) with ``(sum_f_R0 An n)+(An (S n))``; [Idtac | Reflexivity].
-Replace (minus (S n) (S m)) with (S (minus n (S m))).
-Replace (sum_f_R0 [i:nat](An (plus (S m) i)) (S (minus n (S m)))) with (Rplus (sum_f_R0 [i:nat](An (plus (S m) i)) (minus n (S m))) (An (plus (S m) (S (minus n (S m)))))); [Idtac | Reflexivity].
-Replace (plus (S m) (S (minus n (S m)))) with (S n).
-Rewrite (Hrecn H1).
-Ring.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite minus_INR.
-Rewrite S_INR; Ring.
-Apply lt_le_S; Assumption.
-Apply INR_eq; Rewrite S_INR; Repeat Rewrite minus_INR.
-Repeat Rewrite S_INR; Ring.
-Apply le_n_S; Apply lt_le_weak; Assumption.
-Apply lt_le_S; Assumption.
-Rewrite H1; Rewrite <- minus_n_n; Simpl.
-Replace (plus n O) with n; [Reflexivity | Ring].
-Inversion H.
-Right; Reflexivity.
-Left; Apply lt_le_trans with (S m); [Apply lt_n_Sn | Assumption].
-Qed.
-
-(* Sum of geometric sequences *)
-Lemma tech3 : (k:R;N:nat) ``k<>1`` -> (sum_f_R0 [i:nat](pow k i) N)==``(1-(pow k (S N)))/(1-k)``.
-Intros; Cut ``1-k<>0``.
-Intro; Induction N.
-Simpl; Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rinv_r_sym.
-Reflexivity.
-Apply H0.
-Replace (sum_f_R0 ([i:nat](pow k i)) (S N)) with (Rplus (sum_f_R0 [i:nat](pow k i) N) (pow k (S N))); [Idtac | Reflexivity]; Rewrite HrecN; Replace ``(1-(pow k (S N)))/(1-k)+(pow k (S N))`` with ``((1-(pow k (S N)))+(1-k)*(pow k (S N)))/(1-k)``.
-Apply r_Rmult_mult with ``1-k``.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(1-k)``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [ Do 2 Rewrite Rmult_1l; Simpl; Ring | Apply H0].
-Apply H0.
-Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Rewrite (Rmult_sym ``1-k``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Reflexivity.
-Apply H0.
-Apply Rminus_eq_contra; Red; Intro; Elim H; Symmetry; Assumption.
-Qed.
-
-Lemma tech4 : (An:nat->R;k:R;N:nat) ``0<=k`` -> ((i:nat)``(An (S i))<k*(An i)``) -> ``(An N)<=(An O)*(pow k N)``.
-Intros; Induction N.
-Simpl; Right; Ring.
-Apply Rle_trans with ``k*(An N)``.
-Left; Apply (H0 N).
-Replace (S N) with (plus N (1)); [Idtac | Ring].
-Rewrite pow_add; Simpl; Rewrite Rmult_1r; Replace ``(An O)*((pow k N)*k)`` with ``k*((An O)*(pow k N))``; [Idtac | Ring]; Apply Rle_monotony.
-Assumption.
-Apply HrecN.
-Qed.
-
-Lemma tech5 : (An:nat->R;N:nat) (sum_f_R0 An (S N))==``(sum_f_R0 An N)+(An (S N))``.
-Intros; Reflexivity.
-Qed.
-
-Lemma tech6 : (An:nat->R;k:R;N:nat) ``0<=k`` -> ((i:nat)``(An (S i))<k*(An i)``) -> (Rle (sum_f_R0 An N) (Rmult (An O) (sum_f_R0 [i:nat](pow k i) N))).
-Intros; Induction N.
-Simpl; Right; Ring.
-Apply Rle_trans with (Rplus (Rmult (An O) (sum_f_R0 [i:nat](pow k i) N)) (An (S N))).
-Rewrite tech5; Do 2 Rewrite <- (Rplus_sym (An (S N))); Apply Rle_compatibility.
-Apply HrecN.
-Rewrite tech5 ; Rewrite Rmult_Rplus_distr; Apply Rle_compatibility.
-Apply tech4; Assumption.
-Qed.
-
-Lemma tech7 : (r1,r2:R) ``r1<>0`` -> ``r2<>0`` -> ``r1<>r2`` -> ``/r1<>/r2``.
-Intros; Red; Intro.
-Assert H3 := (Rmult_mult_r r1 ? ? H2).
-Rewrite <- Rinv_r_sym in H3; [Idtac | Assumption].
-Assert H4 := (Rmult_mult_r r2 ? ? H3).
-Rewrite Rmult_1r in H4; Rewrite <- Rmult_assoc in H4.
-Rewrite Rinv_r_simpl_m in H4; [Idtac | Assumption].
-Elim H1; Symmetry; Assumption.
-Qed.
-
-Lemma tech11 : (An,Bn,Cn:nat->R;N:nat) ((i:nat) (An i)==``(Bn i)-(Cn i)``) -> (sum_f_R0 An N)==``(sum_f_R0 Bn N)-(sum_f_R0 Cn N)``.
-Intros; Induction N.
-Simpl; Apply H.
-Do 3 Rewrite tech5; Rewrite HrecN; Rewrite (H (S N)); Ring.
-Qed.
-
-Lemma tech12 : (An:nat->R;x:R;l:R) (Un_cv [N:nat](sum_f_R0 [i:nat]``(An i)*(pow x i)`` N) l) -> (Pser An x l).
-Intros; Unfold Pser; Unfold infinit_sum; Unfold Un_cv in H; Assumption.
-Qed. 
-
-Lemma scal_sum : (An:nat->R;N:nat;x:R) (Rmult x (sum_f_R0 An N))==(sum_f_R0 [i:nat]``(An i)*x`` N).
-Intros; Induction N.
-Simpl; Ring.
-Do 2 Rewrite tech5.
-Rewrite Rmult_Rplus_distr; Rewrite <- HrecN; Ring.
-Qed.
-
-Lemma decomp_sum : (An:nat->R;N:nat) (lt O N) -> (sum_f_R0 An N)==(Rplus (An O) (sum_f_R0 [i:nat](An (S i)) (pred N))).
-Intros; Induction N.
-Elim (lt_n_n ? H).
-Cut (lt O N)\/N=O.
-Intro; Elim H0; Intro.
-Cut (S (pred N))=(pred (S N)).
-Intro; Rewrite <- H2.
-Do 2 Rewrite tech5.
-Replace (S (S (pred N))) with (S N).
-Rewrite (HrecN H1); Ring.
-Rewrite H2; Simpl; Reflexivity.
-Assert H2 := (O_or_S N).
-Elim H2; Intros.
-Elim a; Intros.
-Rewrite <- p.
-Simpl; Reflexivity.
-Rewrite <- b in H1; Elim (lt_n_n ? H1).
-Rewrite H1; Simpl; Reflexivity.
-Inversion H.
-Right; Reflexivity.
-Left; Apply lt_le_trans with (1); [Apply lt_O_Sn | Assumption].
-Qed.
-
-Lemma plus_sum : (An,Bn:nat->R;N:nat) (sum_f_R0 [i:nat]``(An i)+(Bn i)`` N)==``(sum_f_R0 An N)+(sum_f_R0 Bn N)``.
-Intros; Induction N.
-Simpl; Ring.
-Do 3 Rewrite tech5; Rewrite HrecN; Ring.
-Qed.
-
-Lemma sum_eq : (An,Bn:nat->R;N:nat) ((i:nat)(le i N)->(An i)==(Bn i)) -> (sum_f_R0 An N)==(sum_f_R0 Bn N).
-Intros; Induction N.
-Simpl; Apply H; Apply le_n.
-Do 2 Rewrite tech5; Rewrite HrecN.
-Rewrite (H (S N)); [Reflexivity | Apply le_n].
-Intros; Apply H; Apply le_trans with N; [Assumption | Apply le_n_Sn].
-Qed.
-
-(* Unicity of the limit defined by convergent series *)
-Lemma unicity_sum : (An:nat->R;l1,l2:R) (infinit_sum An l1) -> (infinit_sum An l2) -> l1 == l2.
-Unfold infinit_sum; Intros.
-Case (Req_EM l1 l2); Intro.
-Assumption.
-Cut ``0<(Rabsolu ((l1-l2)/2))``; [Intro | Apply Rabsolu_pos_lt].
-Elim (H ``(Rabsolu ((l1-l2)/2))`` H2); Intros.
-Elim (H0 ``(Rabsolu ((l1-l2)/2))`` H2); Intros.
-Pose N := (max x0 x); Cut (ge N x0).
-Cut (ge N x).
-Intros; Assert H7 := (H3 N H5); Assert H8 := (H4 N H6).
-Cut ``(Rabsolu (l1-l2)) <= (R_dist (sum_f_R0 An N) l1) + (R_dist (sum_f_R0 An N) l2)``.
-Intro; Assert H10 := (Rplus_lt ? ? ? ? H7 H8); Assert H11 := (Rle_lt_trans ? ? ? H9 H10); Unfold Rdiv in H11; Rewrite Rabsolu_mult in H11.
-Cut ``(Rabsolu (/2))==/2``.
-Intro; Rewrite H12 in H11; Assert H13 := double_var; Unfold Rdiv in H13; Rewrite <- H13 in H11.
-Elim (Rlt_antirefl ? H11).
-Apply Rabsolu_right; Left; Change ``0</2``; Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H20; Generalize (lt_INR_0 (2) (neq_O_lt (2) H20)); Unfold INR; Intro; Assumption | Discriminate].
-Unfold R_dist; Rewrite <- (Rabsolu_Ropp ``(sum_f_R0 An N)-l1``); Rewrite Ropp_distr3.
-Replace ``l1-l2`` with ``((l1-(sum_f_R0 An N)))+((sum_f_R0 An N)-l2)``; [Idtac | Ring].
-Apply Rabsolu_triang.
-Unfold ge; Unfold N; Apply le_max_r.
-Unfold ge; Unfold N; Apply le_max_l.
-Unfold Rdiv; Apply prod_neq_R0.
-Apply Rminus_eq_contra; Assumption.
-Apply Rinv_neq_R0; DiscrR.
-Qed.
-
-Lemma minus_sum : (An,Bn:nat->R;N:nat) (sum_f_R0 [i:nat]``(An i)-(Bn i)`` N)==``(sum_f_R0 An N)-(sum_f_R0 Bn N)``. 
-Intros; Induction N. 
-Simpl; Ring. 
-Do 3 Rewrite tech5; Rewrite HrecN; Ring. 
-Qed. 
-
-Lemma sum_decomposition : (An:nat->R;N:nat) (Rplus (sum_f_R0 [l:nat](An (mult (2) l)) (S N)) (sum_f_R0 [l:nat](An (S (mult (2) l))) N))==(sum_f_R0 An (mult (2) (S N))).
-Intros.
-Induction N.
-Simpl; Ring.
-Rewrite tech5.
-Rewrite (tech5 [l:nat](An (S (mult (2) l))) N).
-Replace (mult (2) (S (S N))) with (S (S (mult (2) (S N)))).
-Rewrite (tech5 An (S (mult (2) (S N)))).
-Rewrite (tech5 An (mult (2) (S N))).
-Rewrite <- HrecN.
-Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR;Repeat Rewrite S_INR.
-Ring.
-Qed.
-
-Lemma sum_Rle : (An,Bn:nat->R;N:nat) ((n:nat)(le n N)->``(An n)<=(Bn n)``) -> ``(sum_f_R0 An N)<=(sum_f_R0 Bn N)``.
-Intros.
-Induction N.
-Simpl; Apply H.
-Apply le_n.
-Do 2 Rewrite tech5.
-Apply Rle_trans with ``(sum_f_R0 An N)+(Bn (S N))``.
-Apply Rle_compatibility.
-Apply H.
-Apply le_n.
-Do 2 Rewrite <- (Rplus_sym ``(Bn (S N))``).
-Apply Rle_compatibility.
-Apply HrecN.
-Intros; Apply H.
-Apply le_trans with N; [Assumption | Apply le_n_Sn].
-Qed.
-
-Lemma sum_Rabsolu : (An:nat->R;N:nat) (Rle (Rabsolu (sum_f_R0 An N)) (sum_f_R0 [l:nat](Rabsolu (An l)) N)).
-Intros.
-Induction N.
-Simpl.
-Right; Reflexivity.
-Do 2 Rewrite tech5.
-Apply Rle_trans with ``(Rabsolu (sum_f_R0 An N))+(Rabsolu (An (S N)))``.
-Apply Rabsolu_triang.
-Do 2 Rewrite <- (Rplus_sym (Rabsolu (An (S N)))).
-Apply Rle_compatibility.
-Apply HrecN.
-Qed.
-
-Lemma sum_cte : (x:R;N:nat) (sum_f_R0 [_:nat]x N) == ``x*(INR (S N))``.
-Intros.
-Induction N.
-Simpl; Ring.
-Rewrite tech5.
-Rewrite HrecN; Repeat Rewrite S_INR; Ring.
-Qed.
-
-(**********)
-Lemma sum_growing : (An,Bn:nat->R;N:nat) ((n:nat)``(An n)<=(Bn n)``)->``(sum_f_R0 An N)<=(sum_f_R0 Bn N)``.
-Intros.
-Induction N.
-Simpl; Apply H.
-Do 2 Rewrite tech5.
-Apply Rle_trans with ``(sum_f_R0 An N)+(Bn (S N))``.
-Apply Rle_compatibility; Apply H.
-Do 2 Rewrite <- (Rplus_sym (Bn (S N))).
-Apply Rle_compatibility; Apply HrecN.
-Qed.
-
-(**********)
-Lemma Rabsolu_triang_gen : (An:nat->R;N:nat) (Rle (Rabsolu (sum_f_R0 An N)) (sum_f_R0 [i:nat](Rabsolu (An i)) N)). 
-Intros.
-Induction N.
-Simpl.
-Right; Reflexivity.
-Do 2 Rewrite tech5.
-Apply Rle_trans with ``(Rabsolu ((sum_f_R0 An N)))+(Rabsolu (An (S N)))``.
-Apply Rabsolu_triang.
-Do 2 Rewrite <- (Rplus_sym (Rabsolu (An (S N)))).
-Apply Rle_compatibility; Apply HrecN.
-Qed.
-
-(**********)
-Lemma cond_pos_sum : (An:nat->R;N:nat) ((n:nat)``0<=(An n)``) -> ``0<=(sum_f_R0 An N)``.
-Intros.
-Induction N.
-Simpl; Apply H.
-Rewrite tech5.
-Apply ge0_plus_ge0_is_ge0.
-Apply HrecN.
-Apply H.
-Qed.
-
-(* Cauchy's criterion for series *)
-Definition Cauchy_crit_series [An:nat->R] : Prop := (Cauchy_crit [N:nat](sum_f_R0 An N)).
-
-(* If (|An|) satisfies the Cauchy's criterion for series, then (An) too *)
-Lemma cauchy_abs : (An:nat->R) (Cauchy_crit_series [i:nat](Rabsolu (An i))) -> (Cauchy_crit_series An).
-Unfold Cauchy_crit_series; Unfold Cauchy_crit.
-Intros.
-Elim (H eps H0); Intros.
-Exists x.
-Intros.
-Cut (Rle (R_dist (sum_f_R0 An n) (sum_f_R0 An m)) (R_dist (sum_f_R0 [i:nat](Rabsolu (An i)) n) (sum_f_R0 [i:nat](Rabsolu (An i)) m))).
-Intro.
-Apply Rle_lt_trans with (R_dist (sum_f_R0 [i:nat](Rabsolu (An i)) n) (sum_f_R0 [i:nat](Rabsolu (An i)) m)).
-Assumption.
-Apply H1; Assumption.
-Assert H4 := (lt_eq_lt_dec n m).
-Elim H4; Intro.
-Elim a; Intro.
-Rewrite (tech2 An n m); [Idtac | Assumption].
-Rewrite (tech2 [i:nat](Rabsolu (An i)) n m); [Idtac | Assumption].
-Unfold R_dist.
-Unfold Rminus.
-Do 2 Rewrite Ropp_distr1.
-Do 2 Rewrite <- Rplus_assoc.
-Do 2 Rewrite Rplus_Ropp_r.
-Do 2 Rewrite Rplus_Ol.
-Do 2 Rewrite Rabsolu_Ropp.
-Rewrite (Rabsolu_right (sum_f_R0 [i:nat](Rabsolu (An (plus (S n) i))) (minus m (S n)))).
-Pose Bn:=[i:nat](An (plus (S n) i)).
-Replace [i:nat](Rabsolu (An (plus (S n) i))) with [i:nat](Rabsolu (Bn i)).
-Apply Rabsolu_triang_gen.
-Unfold Bn; Reflexivity.
-Apply Rle_sym1.
-Apply cond_pos_sum.
-Intro; Apply Rabsolu_pos.
-Rewrite b.
-Unfold R_dist.
-Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r.
-Rewrite Rabsolu_R0; Right; Reflexivity.
-Rewrite (tech2 An m n); [Idtac | Assumption].
-Rewrite (tech2 [i:nat](Rabsolu (An i)) m n); [Idtac | Assumption].
-Unfold R_dist.
-Unfold Rminus.
-Do 2 Rewrite Rplus_assoc.
-Rewrite (Rplus_sym (sum_f_R0 An m)).
-Rewrite (Rplus_sym (sum_f_R0 [i:nat](Rabsolu (An i)) m)).
-Do 2 Rewrite Rplus_assoc.
-Do 2 Rewrite Rplus_Ropp_l.
-Do 2 Rewrite Rplus_Or.
-Rewrite (Rabsolu_right (sum_f_R0 [i:nat](Rabsolu (An (plus (S m) i))) (minus n (S m)))).
-Pose Bn:=[i:nat](An (plus (S m) i)).
-Replace [i:nat](Rabsolu (An (plus (S m) i))) with [i:nat](Rabsolu (Bn i)).
-Apply Rabsolu_triang_gen.
-Unfold Bn; Reflexivity.
-Apply Rle_sym1.
-Apply cond_pos_sum.
-Intro; Apply Rabsolu_pos.
-Qed.
-
-(**********)
-Lemma cv_cauchy_1 : (An:nat->R) (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)) -> (Cauchy_crit_series An).
-Intros.
-Elim X; Intros.
-Unfold Un_cv in p.
-Unfold Cauchy_crit_series; Unfold Cauchy_crit.
-Intros.
-Cut ``0<eps/2``.
-Intro.
-Elim (p ``eps/2`` H0); Intros.
-Exists x0.
-Intros.
-Apply Rle_lt_trans with ``(R_dist (sum_f_R0 An n) x)+(R_dist (sum_f_R0 An m) x)``.
-Unfold R_dist.
-Replace ``(sum_f_R0 An n)-(sum_f_R0 An m)`` with ``((sum_f_R0 An n)-x)+ -((sum_f_R0 An m)-x)``; [Idtac | Ring].
-Rewrite <- (Rabsolu_Ropp ``(sum_f_R0 An m)-x``).
-Apply Rabsolu_triang.
-Apply Rlt_le_trans with ``eps/2+eps/2``.
-Apply Rplus_lt.
-Apply H1; Assumption.
-Apply H1; Assumption.
-Right; Symmetry; Apply double_var.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Qed.
-
-Lemma cv_cauchy_2 : (An:nat->R) (Cauchy_crit_series An) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros.
-Apply R_complete.
-Unfold Cauchy_crit_series in H.
-Exact H.
-Qed.
-
-(**********)
-Lemma sum_eq_R0 : (An:nat->R;N:nat) ((n:nat)(le n N)->``(An n)==0``) -> (sum_f_R0 An N)==R0.
-Intros; Induction N.
-Simpl; Apply H; Apply le_n.
-Rewrite tech5; Rewrite HrecN; [Rewrite Rplus_Ol; Apply H; Apply le_n | Intros; Apply H; Apply le_trans with N; [Assumption | Apply le_n_Sn]].
-Qed.
-
-Definition SP [fn:nat->R->R;N:nat] : R->R := [x:R](sum_f_R0 [k:nat]``(fn k x)`` N).
-
-(**********)
-Lemma sum_incr : (An:nat->R;N:nat;l:R) (Un_cv [n:nat](sum_f_R0 An n) l) -> ((n:nat)``0<=(An n)``) -> ``(sum_f_R0 An N)<=l``.
-Intros; Case (total_order_T (sum_f_R0 An N) l); Intro.
-Elim s; Intro.
-Left; Apply a.
-Right; Apply b.
-Cut (Un_growing [n:nat](sum_f_R0 An n)).
-Intro; LetTac l1 := (sum_f_R0 An N) in r.
-Unfold Un_cv in H; Cut ``0<l1-l``.
-Intro; Elim (H ? H2); Intros.
-Pose N0 := (max x N); Cut (ge N0 x).
-Intro; Assert H5 := (H3 N0 H4).
-Cut ``l1<=(sum_f_R0 An N0)``.
-Intro; Unfold R_dist in H5; Rewrite Rabsolu_right in H5.
-Cut ``(sum_f_R0 An N0)<l1``.
-Intro; Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H7 H6)).
-Apply Rlt_anti_compatibility with ``-l``.
-Do 2 Rewrite (Rplus_sym ``-l``).
-Apply H5.
-Apply Rle_sym1; Apply Rle_anti_compatibility with l.
-Rewrite Rplus_Or; Replace ``l+((sum_f_R0 An N0)-l)`` with (sum_f_R0 An N0); [Idtac | Ring]; Apply Rle_trans with l1.
-Left; Apply r.
-Apply H6.
-Unfold l1; Apply Rle_sym2; Apply (growing_prop [k:nat](sum_f_R0 An k)).
-Apply H1.
-Unfold ge N0; Apply le_max_r.
-Unfold ge N0; Apply le_max_l.
-Apply Rlt_anti_compatibility with l; Rewrite Rplus_Or; Replace ``l+(l1-l)`` with l1; [Apply r | Ring].
-Unfold Un_growing; Intro; Simpl; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Apply H0.
-Qed.
-
-(**********)
-Lemma sum_cv_maj : (An:nat->R;fn:nat->R->R;x,l1,l2:R) (Un_cv [n:nat](SP fn n x) l1) -> (Un_cv [n:nat](sum_f_R0 An n) l2) -> ((n:nat)``(Rabsolu (fn n x))<=(An n)``) -> ``(Rabsolu l1)<=l2``.
-Intros; Case (total_order_T (Rabsolu l1) l2); Intro.
-Elim s; Intro.
-Left; Apply a.
-Right; Apply b.
-Cut (n0:nat)``(Rabsolu (SP fn n0 x))<=(sum_f_R0 An n0)``.
-Intro; Cut ``0<((Rabsolu l1)-l2)/2``.
-Intro; Unfold Un_cv in H H0.
-Elim (H ? H3); Intros Na H4.
-Elim (H0 ? H3); Intros Nb H5.
-Pose N := (max Na Nb).
-Unfold R_dist in H4 H5.
-Cut ``(Rabsolu ((sum_f_R0 An N)-l2))<((Rabsolu l1)-l2)/2``.
-Intro; Cut ``(Rabsolu ((Rabsolu l1)-(Rabsolu (SP fn N x))))<((Rabsolu l1)-l2)/2``.
-Intro; Cut ``(sum_f_R0 An N)<((Rabsolu l1)+l2)/2``.
-Intro; Cut ``((Rabsolu l1)+l2)/2<(Rabsolu (SP fn N x))``.
-Intro; Cut ``(sum_f_R0 An N)<(Rabsolu (SP fn N x))``.
-Intro; Assert H11 := (H2 N).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H10)).
-Apply Rlt_trans with ``((Rabsolu l1)+l2)/2``; Assumption.
-Case (case_Rabsolu ``(Rabsolu l1)-(Rabsolu (SP fn N x))``); Intro.
-Apply Rlt_trans with (Rabsolu l1).
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite double; Apply Rlt_compatibility; Apply r.
-DiscrR.
-Apply (Rminus_lt ? ? r0).
-Rewrite (Rabsolu_right ? r0) in H7.
-Apply Rlt_anti_compatibility with ``((Rabsolu l1)-l2)/2-(Rabsolu (SP fn N x))``.
-Replace ``((Rabsolu l1)-l2)/2-(Rabsolu (SP fn N x))+((Rabsolu l1)+l2)/2`` with ``(Rabsolu l1)-(Rabsolu (SP fn N x))``.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H7.
-Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Rewrite <- (Rmult_sym ``/2``); Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``/2``); Pattern 1 (Rabsolu l1); Rewrite double_var; Unfold Rdiv; Ring.
-Case (case_Rabsolu ``(sum_f_R0 An N)-l2``); Intro.
-Apply Rlt_trans with l2.
-Apply (Rminus_lt ? ? r0).
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite (double l2); Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rplus_sym (Rabsolu l1)); Apply Rlt_compatibility; Apply r.
-DiscrR.
-Rewrite (Rabsolu_right ? r0) in H6; Apply Rlt_anti_compatibility with ``-l2``.
-Replace ``-l2+((Rabsolu l1)+l2)/2`` with ``((Rabsolu l1)-l2)/2``.
-Rewrite Rplus_sym; Apply H6.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite Rminus_distr; Rewrite Rmult_Rplus_distrl; Pattern 2 l2; Rewrite double_var; Repeat Rewrite (Rmult_sym ``/2``); Rewrite Ropp_distr1; Unfold Rdiv; Ring.
-Apply Rle_lt_trans with ``(Rabsolu ((SP fn N x)-l1))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply Rabsolu_triang_inv2.
-Apply H4; Unfold ge N; Apply le_max_l.
-Apply H5; Unfold ge N; Apply le_max_r.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_anti_compatibility with l2.
-Rewrite Rplus_Or; Replace ``l2+((Rabsolu l1)-l2)`` with (Rabsolu l1); [Apply r | Ring].
-Apply Rlt_Rinv; Sup0.
-Intros; Induction n0.
-Unfold SP; Simpl; Apply H1.
-Unfold SP; Simpl.
-Apply Rle_trans with (Rplus (Rabsolu (sum_f_R0 [k:nat](fn k x) n0)) (Rabsolu (fn (S n0) x))).
-Apply Rabsolu_triang.
-Apply Rle_trans with ``(sum_f_R0 An n0)+(Rabsolu (fn (S n0) x))``.
-Do 2 Rewrite <- (Rplus_sym (Rabsolu (fn (S n0) x))).
-Apply Rle_compatibility; Apply Hrecn0.
-Apply Rle_compatibility; Apply H1.
-Qed.
diff --git a/theories7/Reals/RIneq.v b/theories7/Reals/RIneq.v
deleted file mode 100644
index 00d41c70..00000000
--- a/theories7/Reals/RIneq.v
+++ /dev/null
@@ -1,1631 +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: RIneq.v,v 1.2.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-(***************************************************************************)
-(**              Basic lemmas for the classical reals numbers              *)
-(***************************************************************************)
-
-Require Export Raxioms.
-Require Export ZArithRing.
-Require Omega.
-Require Export Field.
-
-Open Local Scope Z_scope.
-Open Local Scope R_scope.
-
-Implicit Variable Type r:R.
-
-(***************************************************************************)
-(**       Instantiating Ring tactic on reals                               *)
-(***************************************************************************)
-
-Lemma RTheory : (Ring_Theory Rplus Rmult R1 R0 Ropp [x,y:R]false).
-  Split.
-  Exact Rplus_sym.
-  Symmetry; Apply Rplus_assoc.
-  Exact Rmult_sym.
-  Symmetry; Apply Rmult_assoc.
-  Intro; Apply Rplus_Ol.
-  Intro; Apply Rmult_1l.
-  Exact Rplus_Ropp_r.
-  Intros.
-  Rewrite Rmult_sym.
-  Rewrite (Rmult_sym n p).
-  Rewrite (Rmult_sym m p).
-  Apply Rmult_Rplus_distr.
-  Intros; Contradiction.
-Defined.
-
-Add Field R Rplus Rmult R1 R0 Ropp [x,y:R]false Rinv RTheory Rinv_l
-          with minus:=Rminus div:=Rdiv.
-
-(**************************************************************************)
-(**  Relation between orders and equality                                 *)
-(**************************************************************************)
-
-(**********)
-Lemma Rlt_antirefl:(r:R)~``r<r``.
-  Generalize Rlt_antisym. Intuition EAuto.
-Qed.
-Hints Resolve Rlt_antirefl : real.
-
-Lemma Rle_refl : (x:R) ``x<=x``.
-Intro; Right; Reflexivity.
-Qed.
-
-Lemma Rlt_not_eq:(r1,r2:R)``r1<r2``->``r1<>r2``.
-  Red; Intros r1 r2 H H0; Apply (Rlt_antirefl r1).
-  Pattern 2 r1; Rewrite H0; Trivial.
-Qed.
-
-Lemma Rgt_not_eq:(r1,r2:R)``r1>r2``->``r1<>r2``.
-Intros; Apply sym_not_eqT; Apply Rlt_not_eq; Auto with real.
-Qed.
-
-(**********)
-Lemma imp_not_Req:(r1,r2:R)(``r1<r2``\/ ``r1>r2``) -> ``r1<>r2``.
-Generalize Rlt_not_eq Rgt_not_eq. Intuition EAuto.
-Qed.
-Hints Resolve imp_not_Req : real.
-
-(** Reasoning by case on equalities and order *)
-
-(**********)
-Lemma Req_EM:(r1,r2:R)(r1==r2)\/``r1<>r2``.
-Intros ; Generalize (total_order_T r1 r2) imp_not_Req ; Intuition EAuto 3. 
-Qed.
-Hints Resolve Req_EM : real.
-
-(**********)
-Lemma total_order:(r1,r2:R)``r1<r2``\/(r1==r2)\/``r1>r2``.
-Intros;Generalize (total_order_T r1 r2);Tauto.
-Qed.
-
-(**********)
-Lemma not_Req:(r1,r2:R)``r1<>r2``->(``r1<r2``\/``r1>r2``).
-Intros; Generalize (total_order_T r1 r2) ; Tauto.
-Qed.
-
-
-(*********************************************************************************)
-(**       Order Lemma  : relating [<], [>], [<=] and [>=]  	                 *)
-(*********************************************************************************)
-
-(**********)
-Lemma Rlt_le:(r1,r2:R)``r1<r2``-> ``r1<=r2``.
-Intros ; Red ; Tauto.
-Qed.
-Hints Resolve Rlt_le : real.
-
-(**********)
-Lemma Rle_ge : (r1,r2:R)``r1<=r2`` -> ``r2>=r1``.
-NewDestruct 1; Red; Auto with real.
-Qed.
-
-Hints Immediate Rle_ge : real.
-
-(**********)
-Lemma Rge_le : (r1,r2:R)``r1>=r2`` -> ``r2<=r1``.
-NewDestruct 1; Red; Auto with real.
-Qed.
-
-Hints Resolve Rge_le : real.
-
-(**********)
-Lemma not_Rle:(r1,r2:R)~``r1<=r2`` -> ``r2<r1``.
-Intros r1 r2 ; Generalize (total_order r1 r2) ; Unfold Rle; Tauto.
-Qed.
-
-Hints Immediate not_Rle : real.
-
-Lemma not_Rge:(r1,r2:R)~``r1>=r2`` -> ``r1<r2``.
-Intros; Apply not_Rle; Auto with real.
-Qed.
-
-(**********)
-Lemma Rlt_le_not:(r1,r2:R)``r2<r1`` -> ~``r1<=r2``.
-Generalize Rlt_antisym imp_not_Req ; Unfold Rle.
-Intuition EAuto 3.
-Qed.
-
-Lemma Rle_not:(r1,r2:R)``r1>r2`` -> ~``r1<=r2``.
-Proof Rlt_le_not.
-
-Hints Immediate Rlt_le_not : real.
-
-Lemma Rle_not_lt: (r1, r2:R) ``r2 <= r1`` -> ~``r1<r2``.
-Intros r1 r2. Generalize (Rlt_antisym r1 r2) (imp_not_Req r1 r2).
-Unfold Rle; Intuition.
-Qed.
-
-(**********)
-Lemma Rlt_ge_not:(r1,r2:R)``r1<r2`` -> ~``r1>=r2``.
-Generalize Rlt_le_not. Unfold Rle Rge. Intuition EAuto 3.
-Qed.
-
-Hints Immediate Rlt_ge_not : real.
-
-(**********)
-Lemma eq_Rle:(r1,r2:R)r1==r2->``r1<=r2``.
-Unfold Rle; Tauto.
-Qed.
-Hints Immediate eq_Rle : real.
-
-Lemma eq_Rge:(r1,r2:R)r1==r2->``r1>=r2``.
-Unfold Rge; Tauto.
-Qed.
-Hints Immediate eq_Rge : real.
-
-Lemma eq_Rle_sym:(r1,r2:R)r2==r1->``r1<=r2``.
-Unfold Rle; Auto.
-Qed.
-Hints Immediate eq_Rle_sym : real.
-
-Lemma eq_Rge_sym:(r1,r2:R)r2==r1->``r1>=r2``.
-Unfold Rge; Auto.
-Qed.
-Hints Immediate eq_Rge_sym : real.
-
-Lemma Rle_antisym : (r1,r2:R)``r1<=r2`` -> ``r2<=r1``-> r1==r2.
-Intros r1 r2; Generalize (Rlt_antisym r1 r2) ; Unfold Rle ; Intuition.
-Qed.
-Hints Resolve Rle_antisym : real.
-
-(**********)
-Lemma Rle_le_eq:(r1,r2:R)(``r1<=r2``/\``r2<=r1``)<->(r1==r2).
-Intuition.
-Qed.
-
-Lemma Rlt_rew : (x,x',y,y':R)``x==x'``->``x'<y'`` -> `` y' == y`` -> ``x < y``.
-Intros x x' y y'; Intros; Replace x with x'; Replace y with y'; Assumption.
-Qed.
-
-(**********)
-Lemma Rle_trans:(r1,r2,r3:R) ``r1<=r2``->``r2<=r3``->``r1<=r3``.
-Generalize trans_eqT Rlt_trans Rlt_rew.
-Unfold Rle.
-Intuition EAuto 2.
-Qed.
-
-(**********)
-Lemma Rle_lt_trans:(r1,r2,r3:R)``r1<=r2``->``r2<r3``->``r1<r3``.
-Generalize Rlt_trans Rlt_rew. 
-Unfold Rle.
-Intuition EAuto 2.
-Qed.
-
-(**********)
-Lemma Rlt_le_trans:(r1,r2,r3:R)``r1<r2``->``r2<=r3``->``r1<r3``.
-Generalize Rlt_trans Rlt_rew; Unfold Rle; Intuition EAuto 2.
-Qed.
-
-
-(** Decidability of the order *)
-Lemma total_order_Rlt:(r1,r2:R)(sumboolT ``r1<r2`` ~(``r1<r2``)).
-Intros;Generalize (total_order_T r1 r2) (imp_not_Req r1 r2) ; Intuition.
-Qed.
-
-(**********)
-Lemma total_order_Rle:(r1,r2:R)(sumboolT ``r1<=r2`` ~(``r1<=r2``)).
-Intros r1 r2.
-Generalize (total_order_T r1 r2) (imp_not_Req r1 r2).
-Intuition EAuto 4 with real.
-Qed.
-
-(**********)
-Lemma total_order_Rgt:(r1,r2:R)(sumboolT ``r1>r2`` ~(``r1>r2``)).
-Intros;Unfold Rgt;Intros;Apply total_order_Rlt.
-Qed.
-
-(**********)
-Lemma total_order_Rge:(r1,r2:R)(sumboolT (``r1>=r2``) ~(``r1>=r2``)).
-Intros;Generalize (total_order_Rle r2 r1);Intuition.
-Qed.
-
-Lemma total_order_Rlt_Rle:(r1,r2:R)(sumboolT ``r1<r2`` ``r2<=r1``).
-Intros;Generalize (total_order_T r1 r2); Intuition.
-Qed.
-
-Lemma Rle_or_lt: (n, m:R)(Rle n m) \/ (Rlt m n).
-Intros n m; Elim (total_order_Rlt_Rle m n);Auto with real.
-Qed.
-
-Lemma total_order_Rle_Rlt_eq :(r1,r2:R)``r1<=r2``-> 
-                              (sumboolT ``r1<r2`` ``r1==r2``).
-Intros r1 r2 H;Generalize (total_order_T r1 r2); Intuition.
-Qed.
-
-(**********)
-Lemma inser_trans_R:(n,m,p,q:R)``n<=m<p``-> (sumboolT ``n<=m<q`` ``q<=m<p``).
-Intros n m p q; Intros; Generalize (total_order_Rlt_Rle m q); Intuition.
-Qed.
-
-(****************************************************************)
-(**        Field Lemmas                                         *)
-(* This part contains lemma involving the Fields operations     *)
-(****************************************************************)
-(*********************************************************)
-(**      Addition                                        *)
-(*********************************************************)
-
-Lemma Rplus_ne:(r:R)``r+0==r``/\``0+r==r``.
-Intro;Split;Ring.
-Qed.
-Hints Resolve Rplus_ne : real v62.
-
-Lemma Rplus_Or:(r:R)``r+0==r``.
-Intro; Ring.
-Qed.
-Hints Resolve Rplus_Or : real.
-
-(**********)
-Lemma Rplus_Ropp_l:(r:R)``(-r)+r==0``.
-  Intro; Ring.
-Qed.
-Hints Resolve Rplus_Ropp_l : real.
-
-
-(**********)
-Lemma Rplus_Ropp:(x,y:R)``x+y==0``->``y== -x``.
-  Intros x y H; Replace y with ``(-x+x)+y``;
-  [ Rewrite -> Rplus_assoc; Rewrite -> H; Ring
-  | Ring ].
-Qed.
-
-(*i New i*)
-Hint eqT_R_congr : real := Resolve (congr_eqT R).
-
-Lemma Rplus_plus_r:(r,r1,r2:R)(r1==r2)->``r+r1==r+r2``.
-  Auto with real.
-Qed.
-
-(*i Old i*)Hints Resolve Rplus_plus_r : v62.
-
-(**********)
-Lemma r_Rplus_plus:(r,r1,r2:R)``r+r1==r+r2``->r1==r2.
-  Intros; Transitivity ``(-r+r)+r1``.
-  Ring.
-  Transitivity ``(-r+r)+r2``.
-  Repeat Rewrite -> Rplus_assoc; Rewrite <- H; Reflexivity.
-  Ring.
-Qed.
-Hints Resolve r_Rplus_plus : real.
-
-(**********)
-Lemma Rplus_ne_i:(r,b:R)``r+b==r`` -> ``b==0``.
-  Intros r b; Pattern 2 r; Replace r with ``r+0``;
-  EAuto with real.
-Qed.
-
-(***********************************************************)       
-(**       Multiplication                                   *)
-(***********************************************************)
-
-(**********)
-Lemma Rinv_r:(r:R)``r<>0``->``r* (/r)==1``.
-  Intros; Rewrite -> Rmult_sym; Auto with real.
-Qed.
-Hints Resolve Rinv_r : real.
-
-Lemma Rinv_l_sym:(r:R)``r<>0``->``1==(/r) * r``.
-  Symmetry; Auto with real.
-Qed.
-
-Lemma Rinv_r_sym:(r:R)``r<>0``->``1==r* (/r)``.
-  Symmetry; Auto with real.
-Qed.
-Hints Resolve Rinv_l_sym Rinv_r_sym : real.
-
-
-(**********)
-Lemma Rmult_Or :(r:R) ``r*0==0``.
-Intro; Ring.
-Qed.
-Hints Resolve Rmult_Or : real v62.
-
-(**********)
-Lemma Rmult_Ol:(r:R) ``0*r==0``.
-Intro; Ring.
-Qed.
-Hints Resolve Rmult_Ol : real v62.
-
-(**********)
-Lemma Rmult_ne:(r:R)``r*1==r``/\``1*r==r``.
-Intro;Split;Ring.
-Qed.
-Hints Resolve Rmult_ne : real v62.
-
-(**********)
-Lemma Rmult_1r:(r:R)(``r*1==r``).
-Intro; Ring.
-Qed.
-Hints Resolve Rmult_1r : real.
-
-(**********)
-Lemma Rmult_mult_r:(r,r1,r2:R)r1==r2->``r*r1==r*r2``.
-  Auto with real.
-Qed.
-
-(*i OLD i*)Hints Resolve Rmult_mult_r : v62.
-
-(**********)
-Lemma r_Rmult_mult:(r,r1,r2:R)(``r*r1==r*r2``)->``r<>0``->(r1==r2).
-  Intros; Transitivity ``(/r * r)*r1``.
-  Rewrite Rinv_l; Auto with real.
-  Transitivity ``(/r * r)*r2``.
-  Repeat Rewrite Rmult_assoc; Rewrite H; Trivial.
-  Rewrite Rinv_l; Auto with real.
-Qed.
-
-(**********)
-Lemma without_div_Od:(r1,r2:R)``r1*r2==0`` -> ``r1==0`` \/ ``r2==0``.
-  Intros; Case (Req_EM r1 ``0``); [Intro Hz | Intro Hnotz].
-  Auto.
-  Right; Apply r_Rmult_mult with r1; Trivial.
-  Rewrite H; Auto with real.
-Qed.
-
-(**********)
-Lemma without_div_Oi:(r1,r2:R) ``r1==0``\/``r2==0`` -> ``r1*r2==0``.
-  Intros r1 r2 [H | H]; Rewrite H; Auto with real.
-Qed.
-
-Hints Resolve without_div_Oi : real.
-
-(**********)
-Lemma without_div_Oi1:(r1,r2:R) ``r1==0`` -> ``r1*r2==0``.
-  Auto with real.
-Qed.
-
-(**********)
-Lemma without_div_Oi2:(r1,r2:R) ``r2==0`` -> ``r1*r2==0``.
-  Auto with real.
-Qed.
-
-
-(**********) 
-Lemma without_div_O_contr:(r1,r2:R)``r1*r2<>0`` -> ``r1<>0`` /\ ``r2<>0``.
-Intros r1 r2 H; Split; Red; Intro; Apply H; Auto with real.
-Qed.
-
-(**********) 
-Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``.
-Red; Intros r1 r2 (H1,H2) H.
-Case (without_div_Od r1 r2); Auto with real.
-Qed.
-Hints Resolve mult_non_zero : real.
-
-(**********) 
-Lemma Rmult_Rplus_distrl:
-   (r1,r2,r3:R) ``(r1+r2)*r3 == (r1*r3)+(r2*r3)``.
-Intros; Ring.
-Qed.
-
-(** Square function *)
-
-(***********)
-Definition Rsqr:R->R:=[r:R]``r*r``.
-V7only[Notation "x ²" := (Rsqr x) (at level 2,left associativity).].
-
-(***********)
-Lemma Rsqr_O:(Rsqr ``0``)==``0``.
-  Unfold Rsqr; Auto with real.
-Qed.
-
-(***********)
-Lemma Rsqr_r_R0:(r:R)(Rsqr r)==``0``->``r==0``.
-Unfold Rsqr;Intros;Elim (without_div_Od r r H);Trivial.
-Qed.
-
-(*********************************************************)
-(**      Opposite                                        *)
-(*********************************************************)
-
-(**********)
-Lemma eq_Ropp:(r1,r2:R)(r1==r2)->``-r1 == -r2``.
-  Auto with real.
-Qed.
-Hints Resolve eq_Ropp : real.
-
-(**********)
-Lemma Ropp_O:``-0==0``.
-  Ring.
-Qed.
-Hints Resolve Ropp_O : real v62.
-
-(**********)
-Lemma eq_RoppO:(r:R)``r==0``-> ``-r==0``.
-  Intros; Rewrite -> H; Auto with real.
-Qed.
-Hints Resolve eq_RoppO : real.
-
-(**********)
-Lemma Ropp_Ropp:(r:R)``-(-r)==r``.
-  Intro; Ring.
-Qed.
-Hints Resolve Ropp_Ropp : real.
-
-(*********)
-Lemma Ropp_neq:(r:R)``r<>0``->``-r<>0``.
-Red;Intros r H H0.
-Apply H.
-Transitivity ``-(-r)``; Auto with real.
-Qed.
-Hints Resolve Ropp_neq : real.
-
-(**********)
-Lemma Ropp_distr1:(r1,r2:R)``-(r1+r2)==(-r1 + -r2)``.
-  Intros; Ring.
-Qed.
-Hints Resolve Ropp_distr1 : real.
-
-(** Opposite and multiplication *)
-
-Lemma Ropp_mul1:(r1,r2:R)``(-r1)*r2 == -(r1*r2)``.
-  Intros; Ring.
-Qed.
-Hints Resolve Ropp_mul1 : real.
-
-(**********)
-Lemma Ropp_mul2:(r1,r2:R)``(-r1)*(-r2)==r1*r2``.
-  Intros; Ring.
-Qed.
-Hints Resolve Ropp_mul2 : real.
-
-Lemma Ropp_mul3 : (r1,r2:R) ``r1*(-r2) == -(r1*r2)``.
-Intros; Rewrite <- Ropp_mul1; Ring.
-Qed.
-
-(** Substraction *)
-
-Lemma minus_R0:(r:R)``r-0==r``.
-Intro;Ring.
-Qed.
-Hints Resolve minus_R0 : real.
-
-Lemma Rminus_Ropp:(r:R)``0-r==-r``.
-Intro;Ring.
-Qed.
-Hints Resolve Rminus_Ropp : real.
-
-(**********)
-Lemma Ropp_distr2:(r1,r2:R)``-(r1-r2)==r2-r1``.
-  Intros; Ring.
-Qed.
-Hints Resolve Ropp_distr2 : real.
-
-Lemma Ropp_distr3:(r1,r2:R)``-(r2-r1)==r1-r2``.
-Intros; Ring.
-Qed.
-Hints Resolve Ropp_distr3 : real. 
-
-(**********)
-Lemma eq_Rminus:(r1,r2:R)(r1==r2)->``r1-r2==0``.
-  Intros; Rewrite H; Ring.
-Qed.
-Hints Resolve eq_Rminus : real.
-
-(**********)
-Lemma Rminus_eq:(r1,r2:R)``r1-r2==0`` -> r1==r2.
-  Intros r1 r2; Unfold Rminus; Rewrite -> Rplus_sym; Intro.
-  Rewrite <- (Ropp_Ropp r2); Apply (Rplus_Ropp (Ropp r2) r1 H).
-Qed.
-Hints Immediate Rminus_eq : real.
-
-Lemma Rminus_eq_right:(r1,r2:R)``r2-r1==0`` -> r1==r2.
-Intros;Generalize (Rminus_eq r2 r1 H);Clear H;Intro H;Rewrite H;Ring.
-Qed.
-Hints Immediate Rminus_eq_right : real.
-
-Lemma Rplus_Rminus: (p,q:R)``p+(q-p)``==q.
-Intros; Ring.
-Qed.
-Hints Resolve Rplus_Rminus:real.
-
-(**********)
-Lemma Rminus_eq_contra:(r1,r2:R)``r1<>r2``->``r1-r2<>0``.
-Red; Intros r1 r2 H H0.
-Apply H; Auto with real.
-Qed.
-Hints Resolve Rminus_eq_contra : real.
-
-Lemma Rminus_not_eq:(r1,r2:R)``r1-r2<>0``->``r1<>r2``.
-Red; Intros; Elim H; Apply eq_Rminus; Auto.
-Qed.
-Hints Resolve Rminus_not_eq : real.
-
-Lemma Rminus_not_eq_right:(r1,r2:R)``r2-r1<>0`` -> ``r1<>r2``.
-Red; Intros;Elim H;Rewrite H0; Ring.
-Qed.
-Hints Resolve Rminus_not_eq_right : real. 
-
-V7only [Notation not_sym := (sym_not_eq R).].
-
-(**********)
-Lemma Rminus_distr:  (x,y,z:R) ``x*(y-z)==(x*y) - (x*z)``.
-Intros; Ring.
-Qed.
-
-(** Inverse *)
-Lemma Rinv_R1:``/1==1``.
-Field;Auto with real.
-Qed.
-Hints Resolve Rinv_R1 : real.
-
-(*********)
-Lemma Rinv_neq_R0:(r:R)``r<>0``->``(/r)<>0``.
-Red; Intros; Apply R1_neq_R0.
-Replace ``1`` with ``(/r) * r``; Auto with real.
-Qed.
-Hints Resolve Rinv_neq_R0 : real.
-
-(*********)
-Lemma Rinv_Rinv:(r:R)``r<>0``->``/(/r)==r``.
-Intros;Field;Auto with real.
-Qed.
-Hints Resolve Rinv_Rinv : real.
-
-(*********)
-Lemma Rinv_Rmult:(r1,r2:R)``r1<>0``->``r2<>0``->``/(r1*r2)==(/r1)*(/r2)``.
-Intros;Field;Auto with real.
-Qed.
-
-(*********)
-Lemma Ropp_Rinv:(r:R)``r<>0``->``-(/r)==/(-r)``.
-Intros;Field;Auto with real.
-Qed.
-
-Lemma Rinv_r_simpl_r : (r1,r2:R)``r1<>0``->``r1*(/r1)*r2==r2``.
-Intros; Transitivity ``1*r2``; Auto with real.
-Rewrite Rinv_r; Auto with real.
-Qed.
-
-Lemma Rinv_r_simpl_l : (r1,r2:R)``r1<>0``->``r2*r1*(/r1)==r2``.
-Intros; Transitivity ``r2*1``; Auto with real.
-Transitivity ``r2*(r1*/r1)``; Auto with real.
-Qed.
-
-Lemma Rinv_r_simpl_m : (r1,r2:R)``r1<>0``->``r1*r2*(/r1)==r2``.
-Intros; Transitivity ``r2*1``; Auto with real.
-Transitivity ``r2*(r1*/r1)``; Auto with real.
-Ring.
-Qed.
-Hints Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m : real.
-
-(*********)
-Lemma Rinv_Rmult_simpl:(a,b,c:R)``a<>0``->``(a*(/b))*(c*(/a))==c*(/b)``.
-Intros a b c; Intros.
-Transitivity ``(a*/a)*(c*(/b))``; Auto with real.
-Ring.
-Qed.
-
-(** Order and addition *)
-
-Lemma Rlt_compatibility_r:(r,r1,r2:R)``r1<r2``->``r1+r<r2+r``.
-Intros.
-Rewrite (Rplus_sym r1 r); Rewrite (Rplus_sym r2 r); Auto with real.
-Qed.
-
-Hints Resolve Rlt_compatibility_r : real.
-
-(**********)
-Lemma Rlt_anti_compatibility:  (r,r1,r2:R)``r+r1 < r+r2`` -> ``r1<r2``.
-Intros; Cut ``(-r+r)+r1 < (-r+r)+r2``.
-Rewrite -> Rplus_Ropp_l.
-Elim (Rplus_ne r1); Elim (Rplus_ne r2); Intros; Rewrite <- H3;
- Rewrite <- H1; Auto with zarith real.
-Rewrite -> Rplus_assoc; Rewrite -> Rplus_assoc;
- Apply (Rlt_compatibility ``-r`` ``r+r1`` ``r+r2`` H).
-Qed.
-
-(**********)
-Lemma Rle_compatibility:(r,r1,r2:R)``r1<=r2`` -> ``r+r1 <= r+r2 ``.
-Unfold Rle; Intros; Elim H; Intro.
-Left; Apply (Rlt_compatibility r r1 r2 H0).
-Right; Rewrite <- H0; Auto with zarith real.
-Qed.
-
-(**********)
-Lemma Rle_compatibility_r:(r,r1,r2:R)``r1<=r2`` -> ``r1+r<=r2+r``.
-Unfold Rle; Intros; Elim H; Intro.
-Left; Apply (Rlt_compatibility_r r r1 r2 H0).
-Right; Rewrite <- H0; Auto with real.
-Qed.
-
-Hints Resolve Rle_compatibility Rle_compatibility_r : real.
-
-(**********)
-Lemma Rle_anti_compatibility: (r,r1,r2:R)``r+r1<=r+r2`` -> ``r1<=r2``.
-Unfold Rle; Intros; Elim H; Intro.
-Left; Apply (Rlt_anti_compatibility r r1 r2 H0).
-Right; Apply (r_Rplus_plus r r1 r2 H0).
-Qed.
-
-(**********)
-Lemma sum_inequa_Rle_lt:(a,x,b,c,y,d:R)``a<=x`` -> ``x<b`` ->
-           ``c<y`` -> ``y<=d`` -> ``a+c < x+y < b+d``.
-Intros;Split.
-Apply Rlt_le_trans with ``a+y``; Auto with real.
-Apply Rlt_le_trans with ``b+y``; Auto with real.
-Qed.
-
-(*********)
-Lemma Rplus_lt:(r1,r2,r3,r4:R)``r1<r2`` -> ``r3<r4`` -> ``r1+r3 < r2+r4``.
-Intros; Apply Rlt_trans with ``r2+r3``; Auto with real.
-Qed.
-
-Lemma Rplus_le:(r1,r2,r3,r4:R)``r1<=r2`` -> ``r3<=r4`` -> ``r1+r3 <= r2+r4``.
-Intros; Apply Rle_trans with ``r2+r3``; Auto with real.
-Qed.
-
-(*********)
-Lemma Rplus_lt_le_lt:(r1,r2,r3,r4:R)``r1<r2`` -> ``r3<=r4`` -> 
-                     ``r1+r3 < r2+r4``.
-Intros; Apply Rlt_le_trans with ``r2+r3``; Auto with real.
-Qed.
-
-(*********)
-Lemma Rplus_le_lt_lt:(r1,r2,r3,r4:R)``r1<=r2`` -> ``r3<r4`` -> 
-                                    ``r1+r3 < r2+r4``.
-Intros; Apply Rle_lt_trans with ``r2+r3``; Auto with real.
-Qed.
-
-Hints Immediate Rplus_lt Rplus_le Rplus_lt_le_lt Rplus_le_lt_lt : real.
-
-(** Order and Opposite *)
-
-(**********)
-Lemma Rgt_Ropp:(r1,r2:R) ``r1 > r2`` -> ``-r1 < -r2``.
-Unfold Rgt; Intros.
-Apply (Rlt_anti_compatibility ``r2+r1``).
-Replace ``r2+r1+(-r1)`` with r2.
-Replace ``r2+r1+(-r2)`` with r1.
-Trivial.
-Ring.
-Ring.
-Qed.
-Hints Resolve Rgt_Ropp.
-
-(**********)
-Lemma Rlt_Ropp:(r1,r2:R) ``r1 < r2`` -> ``-r1 > -r2``.
-Unfold Rgt; Auto with real.
-Qed.
-Hints Resolve Rlt_Ropp : real.
-
-Lemma Ropp_Rlt: (x,y:R) ``-y < -x`` ->``x<y``.
-Intros x y H'.
-Rewrite <- (Ropp_Ropp x); Rewrite <- (Ropp_Ropp y); Auto with real.
-Qed.
-Hints Immediate Ropp_Rlt : real.
-
-Lemma Rlt_Ropp1:(r1,r2:R) ``r2 < r1`` -> ``-r1 < -r2``.
-Auto with real.
-Qed.
-Hints Resolve Rlt_Ropp1 : real.
-
-(**********)
-Lemma Rle_Ropp:(r1,r2:R) ``r1 <= r2`` -> ``-r1 >= -r2``.
-Unfold Rge; Intros r1 r2 [H|H]; Auto with real.
-Qed.
-Hints Resolve Rle_Ropp : real.
-
-Lemma Ropp_Rle: (x,y:R) ``-y <= -x`` ->``x <= y``.
-Intros x y H.
-Elim H;Auto with real.
-Intro H1;Rewrite <-(Ropp_Ropp x);Rewrite <-(Ropp_Ropp y);Rewrite H1;
-  Auto with real.
-Qed.
-Hints Immediate Ropp_Rle : real.
-
-Lemma Rle_Ropp1:(r1,r2:R) ``r2 <= r1`` -> ``-r1 <= -r2``.
-Intros r1 r2 H;Elim H;Auto with real.
-Qed.
-Hints Resolve Rle_Ropp1 : real.
-
-(**********)
-Lemma Rge_Ropp:(r1,r2:R) ``r1 >= r2`` -> ``-r1 <= -r2``.
-Unfold Rge; Intros r1 r2 [H|H]; Auto with real.
-Qed.
-Hints Resolve Rge_Ropp : real.
-
-(**********)
-Lemma Rlt_RO_Ropp:(r:R) ``0 < r`` -> ``0 > -r``.
-Intros; Replace ``0`` with ``-0``; Auto with real.
-Qed.
-Hints Resolve Rlt_RO_Ropp : real.
-
-(**********)
-Lemma Rgt_RO_Ropp:(r:R) ``0 > r`` -> ``0 < -r``.
-Intros; Replace ``0`` with ``-0``; Auto with real.
-Qed.
-Hints Resolve Rgt_RO_Ropp : real.
-
-(**********)
-Lemma Rgt_RoppO:(r:R)``r>0``->``(-r)<0``.
-Intros; Rewrite <- Ropp_O; Auto with real.
-Qed.
-
-(**********)
-Lemma Rlt_RoppO:(r:R)``r<0``->``-r>0``.
-Intros; Rewrite <- Ropp_O; Auto with real.
-Qed.
-Hints Resolve Rgt_RoppO Rlt_RoppO: real.
-
-(**********)
-Lemma Rle_RO_Ropp:(r:R) ``0 <= r`` -> ``0 >= -r``.
-Intros; Replace ``0`` with ``-0``; Auto with real.
-Qed.
-Hints Resolve Rle_RO_Ropp : real.
-
-(**********)
-Lemma Rge_RO_Ropp:(r:R) ``0 >= r`` -> ``0 <= -r``.
-Intros; Replace ``0`` with ``-0``; Auto with real.
-Qed.
-Hints Resolve Rge_RO_Ropp : real.
-
-(** Order and multiplication *)
-
-Lemma Rlt_monotony_r:(r,r1,r2:R)``0<r`` -> ``r1 < r2`` -> ``r1*r < r2*r``.
-Intros; Rewrite (Rmult_sym r1 r); Rewrite (Rmult_sym r2 r); Auto with real.
-Qed.
-Hints Resolve Rlt_monotony_r.
-
-Lemma Rlt_monotony_contra: (z, x, y:R) ``0<z`` ->``z*x<z*y`` ->``x<y``.
-Intros z x y H H0.
-Case (total_order x y); Intros Eq0; Auto; Elim Eq0; Clear Eq0; Intros Eq0.
- Rewrite Eq0 in H0;ElimType False;Apply (Rlt_antirefl ``z*y``);Auto.
-Generalize (Rlt_monotony z y x H Eq0);Intro;ElimType False;
- Generalize (Rlt_trans ``z*x`` ``z*y`` ``z*x`` H0 H1);Intro;
- Apply (Rlt_antirefl ``z*x``);Auto.
-Qed.
-
-V7only [
-Notation Rlt_monotony_rev := Rlt_monotony_contra.
-Notation "'Rlt_monotony_contra' a b c" := (Rlt_monotony_contra c a b)
-  (at level 10, a,b,c at level 9, only parsing).
-].
-
-Lemma Rlt_anti_monotony:(r,r1,r2:R)``r < 0`` -> ``r1 < r2`` -> ``r*r1 > r*r2``.
-Intros; Replace r with ``-(-r)``; Auto with real.
-Rewrite (Ropp_mul1 ``-r``); Rewrite (Ropp_mul1 ``-r``).
-Apply Rlt_Ropp; Auto with real.
-Qed.
-
-(**********)
-Lemma Rle_monotony: 
-  (r,r1,r2:R)``0 <= r`` -> ``r1 <= r2`` -> ``r*r1 <= r*r2``.
-Intros r r1 r2 H H0; NewDestruct H; NewDestruct H0; Unfold Rle; Auto with real.
-Right; Rewrite <- H; Do 2 Rewrite Rmult_Ol; Reflexivity.
-Qed.
-Hints Resolve Rle_monotony : real.
-
-Lemma Rle_monotony_r: 
-  (r,r1,r2:R)``0 <= r`` -> ``r1 <= r2`` -> ``r1*r <= r2*r``.
-Intros r r1 r2 H;
-Rewrite (Rmult_sym r1 r); Rewrite (Rmult_sym r2 r); Auto with real.
-Qed.
-Hints Resolve Rle_monotony_r : real.
-
-Lemma Rmult_le_reg_l:
-  (z, x, y:R) ``0<z`` ->``z*x<=z*y`` ->``x<=y``.
-Intros z x y H H0;Case H0; Auto with real.
-Intros H1; Apply Rlt_le.
-Apply Rlt_monotony_contra with z := z;Auto.
-Intros H1;Replace x with (Rmult (Rinv z) (Rmult z x)); Auto with real.
-Replace y with (Rmult (Rinv z) (Rmult z y)).
- Rewrite H1;Auto with real.
-Rewrite <- Rmult_assoc; Rewrite Rinv_l; Auto with real.
-Rewrite <- Rmult_assoc; Rewrite Rinv_l; Auto with real.
-Qed.
-
-V7only [
-Notation "'Rle_monotony_contra' a b c" := (Rmult_le_reg_l c a b)
-  (at level 10, a,b,c at level 9, only parsing).
-Notation Rle_monotony_contra := Rmult_le_reg_l.
-].
-
-
-Lemma Rle_anti_monotony1
-	:(r,r1,r2:R)``r <= 0`` -> ``r1 <= r2`` -> ``r*r2 <= r*r1``.
-Intros; Replace r with ``-(-r)``; Auto with real.
-Do 2 Rewrite (Ropp_mul1 ``-r``).
-Apply Rle_Ropp1; Auto with real.
-Qed.
-Hints Resolve Rle_anti_monotony1 : real.
-
-Lemma Rle_anti_monotony
-	:(r,r1,r2:R)``r <= 0`` -> ``r1 <= r2`` -> ``r*r1 >= r*r2``.
-Intros; Apply Rle_ge; Auto with real.
-Qed.
-Hints Resolve Rle_anti_monotony : real.
-
-Lemma Rle_Rmult_comp:
-  (x, y, z, t:R) ``0 <= x`` -> ``0 <= z`` -> ``x <= y`` -> ``z <= t`` ->
-  ``x*z <= y*t``.
-Intros x y z t H' H'0 H'1 H'2.
-Apply Rle_trans with r2 := ``x*t``; Auto with real.
-Repeat Rewrite [x:?](Rmult_sym x t).
-Apply Rle_monotony; Auto.
-Apply Rle_trans with z; Auto.
-Qed.
-Hints Resolve Rle_Rmult_comp :real.
-
-Lemma Rmult_lt:(r1,r2,r3,r4:R)``r3>0`` -> ``r2>0`` ->
-  `` r1 < r2`` -> ``r3 < r4`` -> ``r1*r3 < r2*r4``.
-Intros; Apply Rlt_trans with ``r2*r3``; Auto with real.
-Qed.
-
-(*********)
-Lemma Rmult_lt_0
-  :(r1,r2,r3,r4:R)``r3>=0``->``r2>0``->``r1<r2``->``r3<r4``->``r1*r3<r2*r4``.
-Intros; Apply Rle_lt_trans with ``r2*r3``; Auto with real.
-Qed.
-
-(** Order and Substractions *)
-Lemma Rlt_minus:(r1,r2:R)``r1 < r2`` -> ``r1-r2 < 0``.
-Intros; Apply (Rlt_anti_compatibility ``r2``).
-Replace ``r2+(r1-r2)`` with r1.
-Replace  ``r2+0`` with r2; Auto with real.
-Ring.
-Qed.
-Hints Resolve Rlt_minus : real.
-
-(**********)
-Lemma Rle_minus:(r1,r2:R)``r1 <= r2`` -> ``r1-r2 <= 0``.
-NewDestruct 1; Unfold Rle; Auto with real.
-Qed.
-
-(**********)
-Lemma Rminus_lt:(r1,r2:R)``r1-r2 < 0`` -> ``r1 < r2``.
-Intros; Replace r1 with ``r1-r2+r2``.
-Pattern 3 r2; Replace r2 with ``0+r2``; Auto with real.
-Ring.
-Qed.
-
-(**********)
-Lemma Rminus_le:(r1,r2:R)``r1-r2 <= 0`` -> ``r1 <= r2``.
-Intros; Replace r1 with ``r1-r2+r2``.
-Pattern 3 r2; Replace r2 with ``0+r2``; Auto with real.
-Ring.
-Qed.
-
-(**********)
-Lemma tech_Rplus:(r,s:R)``0<=r`` -> ``0<s`` -> ``r+s<>0``.
-Intros; Apply sym_not_eqT; Apply Rlt_not_eq.
-Rewrite Rplus_sym; Replace ``0`` with ``0+0``; Auto with real.
-Qed.
-Hints Immediate tech_Rplus : real.
-
-(** Order and the square function *)
-Lemma pos_Rsqr:(r:R)``0<=(Rsqr r)``.
-Intro; Case (total_order_Rlt_Rle r ``0``); Unfold Rsqr; Intro.
-Replace ``r*r`` with ``(-r)*(-r)``; Auto with real.
-Replace ``0`` with ``-r*0``; Auto with real.
-Replace ``0`` with ``0*r``; Auto with real.
-Qed.
-
-(***********)
-Lemma pos_Rsqr1:(r:R)``r<>0``->``0<(Rsqr r)``.
-Intros; Case (not_Req r ``0``); Trivial; Unfold Rsqr; Intro.
-Replace ``r*r`` with ``(-r)*(-r)``; Auto with real.
-Replace ``0`` with ``-r*0``; Auto with real.
-Replace ``0`` with ``0*r``; Auto with real.
-Qed.
-Hints Resolve pos_Rsqr pos_Rsqr1 : real.
-
-(** Zero is less than one *)
-Lemma Rlt_R0_R1:``0<1``.
-Replace ``1`` with ``(Rsqr 1)``; Auto with real.
-Unfold Rsqr; Auto with real.
-Qed.
-Hints Resolve Rlt_R0_R1 : real.
-
-Lemma Rle_R0_R1:``0<=1``.
-Left.
-Exact Rlt_R0_R1.
-Qed.
-
-(** Order and inverse *)
-Lemma Rlt_Rinv:(r:R)``0<r``->``0</r``.
-Intros; Apply not_Rle; Red; Intros.
-Absurd ``1<=0``; Auto with real.
-Replace ``1`` with ``r*(/r)``; Auto with real.
-Replace ``0`` with ``r*0``; Auto with real.
-Qed.
-Hints Resolve Rlt_Rinv : real.
-
-(*********)
-Lemma Rlt_Rinv2:(r:R)``r < 0``->``/r < 0``.
-Intros; Apply not_Rle; Red; Intros.
-Absurd ``1<=0``; Auto with real.
-Replace ``1`` with ``r*(/r)``; Auto with real.
-Replace ``0`` with ``r*0``; Auto with real.
-Qed.
-Hints Resolve Rlt_Rinv2 : real.
-
-(*********)
-Lemma Rinv_lt:(r1,r2:R)``0 < r1*r2`` -> ``r1 < r2`` -> ``/r2 < /r1``.
-Intros; Apply Rlt_monotony_rev with ``r1*r2``; Auto with real.
-Case (without_div_O_contr r1 r2 ); Intros; Auto with real.
-Replace ``r1*r2*/r2`` with r1.
-Replace ``r1*r2*/r1`` with r2; Trivial.
-Symmetry; Auto with real.
-Symmetry; Auto with real.
-Qed.
-
-Lemma Rlt_Rinv_R1: (x, y:R) ``1 <= x`` -> ``x<y`` ->``/y< /x``.
-Intros x y H' H'0.
-Cut (Rlt R0 x); [Intros Lt0 | Apply Rlt_le_trans with r2 := R1]; 
-  Auto with real.
-Apply Rlt_monotony_contra with z := x; Auto with real.
-Rewrite (Rmult_sym x (Rinv x)); Rewrite Rinv_l; Auto with real.
-Apply Rlt_monotony_contra with z := y; Auto with real.
-Apply Rlt_trans with r2:=x;Auto.
-Cut ``y*(x*/y)==x``.
-Intro H1;Rewrite H1;Rewrite (Rmult_1r y);Auto.
-Rewrite (Rmult_sym x); Rewrite <- Rmult_assoc; Rewrite (Rmult_sym y (Rinv y));
- Rewrite Rinv_l; Auto with real.
-Apply imp_not_Req; Right.
-Red; Apply Rlt_trans with r2 := x; Auto with real.
-Qed.
-Hints Resolve Rlt_Rinv_R1 :real.
-
-(*********************************************************)        
-(**      Greater                                         *)
-(*********************************************************)
-
-(**********)
-Lemma Rge_ge_eq:(r1,r2:R)``r1 >= r2`` -> ``r2 >= r1`` -> r1==r2.
-Intros; Apply Rle_antisym; Auto with real.
-Qed.
-
-(**********)
-Lemma Rlt_not_ge:(r1,r2:R)~(``r1<r2``)->``r1>=r2``.
-Intros; Unfold Rge; Elim (total_order r1 r2); Intro.
-Absurd ``r1<r2``; Trivial.
-Case H0; Auto.
-Qed.
-
-(**********)
-Lemma Rnot_lt_le:(r1,r2:R)~(``r1<r2``)->``r2<=r1``.
-Intros; Apply Rge_le; Apply Rlt_not_ge; Assumption.
-Qed.
-
-(**********)
-Lemma Rgt_not_le:(r1,r2:R)~(``r1>r2``)->``r1<=r2``.
-Intros r1 r2 H; Apply Rge_le.
-Exact (Rlt_not_ge r2 r1 H).
-Qed.
-
-(**********)
-Lemma Rgt_ge:(r1,r2:R)``r1>r2`` -> ``r1 >= r2``.
-Red; Auto with real.
-Qed.
-
-V7only [
-(**********)
-Lemma Rlt_sym:(r1,r2:R)``r1<r2`` <-> ``r2>r1``.
-Split; Unfold Rgt; Auto with real.
-Qed.
-
-(**********)
-Lemma Rle_sym1:(r1,r2:R)``r1<=r2``->``r2>=r1``.
-Proof Rle_ge.
-
-Notation "'Rle_sym2' a b" := (Rge_le b a)
-  (at level 10, a,b at next level).
-Notation "'Rle_sym2' a" := [b:R](Rge_le b a)
-  (at level 10, a at next level).
-Notation Rle_sym2 := Rge_le.
-(*
-(**********)
-Lemma Rle_sym2:(r1,r2:R)``r2>=r1`` -> ``r1<=r2``.
-Proof [r1,r2](Rge_le r2 r1).
-*)
-
-(**********)
-Lemma Rle_sym:(r1,r2:R)``r1<=r2``<->``r2>=r1``.
-Split; Auto with real.
-Qed.
-].
-
-(**********)
-Lemma Rge_gt_trans:(r1,r2,r3:R)``r1>=r2``->``r2>r3``->``r1>r3``.
-Unfold Rgt; Intros; Apply Rlt_le_trans with r2; Auto with real.
-Qed.
-
-(**********)
-Lemma Rgt_ge_trans:(r1,r2,r3:R)``r1>r2`` -> ``r2>=r3`` -> ``r1>r3``.
-Unfold Rgt; Intros; Apply Rle_lt_trans with r2; Auto with real.
-Qed.
-
-(**********)
-Lemma Rgt_trans:(r1,r2,r3:R)``r1>r2`` -> ``r2>r3`` -> ``r1>r3``.
-Unfold Rgt; Intros; Apply Rlt_trans with r2; Auto with real.
-Qed.
-
-(**********)
-Lemma Rge_trans:(r1,r2,r3:R)``r1>=r2`` -> ``r2>=r3`` -> ``r1>=r3``.
-Intros; Apply Rle_ge.
-Apply Rle_trans with r2; Auto with real.
-Qed.
-
-(**********)
-Lemma Rlt_r_plus_R1:(r:R)``0<=r`` -> ``0<r+1``.
-Intros.
-Apply Rlt_le_trans with ``1``; Auto with real.
-Pattern 1 ``1``; Replace ``1`` with ``0+1``; Auto with real.
-Qed.
-Hints Resolve Rlt_r_plus_R1: real.
-
-(**********)
-Lemma Rlt_r_r_plus_R1:(r:R)``r<r+1``.
-Intros.
-Pattern 1 r; Replace r with ``r+0``; Auto with real.
-Qed.
-Hints Resolve Rlt_r_r_plus_R1: real.
-
-(**********)
-Lemma tech_Rgt_minus:(r1,r2:R)``0<r2``->``r1>r1-r2``.
-Red; Unfold Rminus; Intros.
-Pattern 2 r1; Replace r1 with ``r1+0``; Auto with real.
-Qed.
-
-(***********)
-Lemma Rgt_plus_plus_r:(r,r1,r2:R)``r1>r2``->``r+r1 > r+r2``.
-Unfold Rgt; Auto with real.
-Qed.
-Hints Resolve Rgt_plus_plus_r : real.
-
-(***********)
-Lemma Rgt_r_plus_plus:(r,r1,r2:R)``r+r1 > r+r2`` -> ``r1 > r2``.
-Unfold Rgt; Intros; Apply (Rlt_anti_compatibility r r2 r1 H).
-Qed.
-
-(***********)
-Lemma Rge_plus_plus_r:(r,r1,r2:R)``r1>=r2`` -> ``r+r1 >= r+r2``.
-Intros; Apply Rle_ge; Auto with real.
-Qed.
-Hints Resolve Rge_plus_plus_r : real.
-
-(***********)
-Lemma Rge_r_plus_plus:(r,r1,r2:R)``r+r1 >= r+r2`` -> ``r1>=r2``.
-Intros; Apply Rle_ge; Apply Rle_anti_compatibility with r; Auto with real.
-Qed.
-
-(***********)
-Lemma Rmult_ge_compat_r:
- (z,x,y:R) ``z>=0`` -> ``x>=y`` -> ``x*z >= y*z``.
-Intros z x y; Intros; Apply Rle_ge; Apply Rle_monotony_r; Apply Rge_le; Assumption.
-Qed.
-
-V7only [
-Notation "'Rge_monotony' a b c" := (Rmult_ge_compat_r c a b)
-  (at level 10, a,b,c at level 9, only parsing).
-Notation Rge_monotony := Rmult_ge_compat_r.
-].
-
-(***********)
-Lemma Rgt_minus:(r1,r2:R)``r1>r2`` -> ``r1-r2 > 0``.
-Intros; Replace ``0`` with ``r2-r2``; Auto with real.
-Unfold Rgt Rminus; Auto with real.
-Qed.
-
-(*********)
-Lemma minus_Rgt:(r1,r2:R)``r1-r2 > 0`` -> ``r1>r2``.
-Intros; Replace r2 with ``r2+0``; Auto with real.
-Intros; Replace r1 with ``r2+(r1-r2)``; Auto with real.
-Qed.
-
-(**********)
-Lemma Rge_minus:(r1,r2:R)``r1>=r2`` -> ``r1-r2 >= 0``.
-Unfold Rge; Intros; Elim H; Intro.
-Left; Apply (Rgt_minus r1 r2 H0).
-Right; Apply (eq_Rminus r1 r2 H0).
-Qed.
-
-(*********)
-Lemma minus_Rge:(r1,r2:R)``r1-r2 >= 0`` -> ``r1>=r2``.
-Intros; Replace r2 with ``r2+0``; Auto with real.
-Intros; Replace r1 with ``r2+(r1-r2)``; Auto with real.
-Qed.
-
-
-(*********)
-Lemma Rmult_gt:(r1,r2:R)``r1>0`` -> ``r2>0`` -> ``r1*r2>0``.
-Unfold Rgt;Intros.
-Replace ``0`` with ``0*r2``; Auto with real.
-Qed.
-
-(*********)
-Lemma Rmult_lt_pos:(x,y:R)``0<x`` -> ``0<y`` -> ``0<x*y``.
-Proof Rmult_gt.
-
-(***********)
-Lemma Rplus_eq_R0_l:(a,b:R)``0<=a`` -> ``0<=b`` -> ``a+b==0`` -> ``a==0``.
-Intros a b [H|H] H0 H1; Auto with real.
-Absurd ``0<a+b``.
-Rewrite H1; Auto with real.
-Replace ``0`` with ``0+0``; Auto with real.
-Qed.
-
-
-Lemma Rplus_eq_R0
-	:(a,b:R)``0<=a`` -> ``0<=b`` -> ``a+b==0`` -> ``a==0``/\``b==0``.
-Intros a b; Split.
-Apply Rplus_eq_R0_l with b; Auto with real.
-Apply Rplus_eq_R0_l with a; Auto with real.
-Rewrite Rplus_sym; Auto with real.
-Qed.
-
-
-(***********)
-Lemma Rplus_Rsr_eq_R0_l:(a,b:R)``(Rsqr a)+(Rsqr b)==0``->``a==0``.
-Intros a b; Intros; Apply Rsqr_r_R0; Apply Rplus_eq_R0_l with (Rsqr b); Auto with real.
-Qed.
-
-Lemma Rplus_Rsr_eq_R0:(a,b:R)``(Rsqr a)+(Rsqr b)==0``->``a==0``/\``b==0``.
-Intros a b; Split.
-Apply Rplus_Rsr_eq_R0_l with b; Auto with real.
-Apply Rplus_Rsr_eq_R0_l with a; Auto with real.
-Rewrite Rplus_sym; Auto with real.
-Qed.
-
-
-(**********************************************************) 
-(**       Injection from [N] to [R]                       *)
-(**********************************************************)
-
-(**********)
-Lemma S_INR:(n:nat)(INR (S n))==``(INR n)+1``.
-Intro; Case n; Auto with real.
-Qed.
-
-(**********)
-Lemma S_O_plus_INR:(n:nat)
-    (INR (plus (S O) n))==``(INR (S O))+(INR n)``.
-Intro; Simpl; Case n; Intros; Auto with real.
-Qed.
-
-(**********)
-Lemma plus_INR:(n,m:nat)(INR (plus n m))==``(INR n)+(INR m)``. 
-Intros n m; Induction n.
-Simpl; Auto with real.
-Replace (plus (S n) m) with (S (plus n m)); Auto with arith.
-Repeat Rewrite S_INR.
-Rewrite Hrecn; Ring.
-Qed.
-
-(**********)
-Lemma minus_INR:(n,m:nat)(le m n)->(INR (minus n m))==``(INR n)-(INR m)``.
-Intros n m le; Pattern m n; Apply le_elim_rel; Auto with real.
-Intros; Rewrite <- minus_n_O; Auto with real.
-Intros; Repeat Rewrite S_INR; Simpl.
-Rewrite H0; Ring.
-Qed.
-
-(*********)
-Lemma mult_INR:(n,m:nat)(INR (mult n m))==(Rmult (INR n) (INR m)).
-Intros n m; Induction n.
-Simpl; Auto with real.
-Intros; Repeat Rewrite S_INR; Simpl.
-Rewrite plus_INR; Rewrite Hrecn; Ring.
-Qed.
-
-Hints Resolve plus_INR minus_INR mult_INR : real.
-
-(*********)
-Lemma lt_INR_0:(n:nat)(lt O n)->``0 < (INR n)``.
-Induction 1; Intros; Auto with real.
-Rewrite S_INR; Auto with real.
-Qed.
-Hints Resolve lt_INR_0: real.
-
-Lemma lt_INR:(n,m:nat)(lt n m)->``(INR n) < (INR m)``.
-Induction 1; Intros; Auto with real.
-Rewrite S_INR; Auto with real.
-Rewrite S_INR; Apply Rlt_trans with (INR m0); Auto with real.
-Qed.
-Hints Resolve lt_INR: real.
-
-Lemma INR_lt_1:(n:nat)(lt (S O) n)->``1 < (INR n)``.
-Intros;Replace ``1`` with (INR (S O));Auto with real.
-Qed.
-Hints Resolve INR_lt_1: real.
-
-(**********)
-Lemma INR_pos : (p:positive)``0<(INR (convert p))``.
-Intro; Apply lt_INR_0.
-Simpl; Auto with real.
-Apply compare_convert_O.
-Qed.
-Hints Resolve INR_pos : real.
-
-(**********)
-Lemma pos_INR:(n:nat)``0 <= (INR n)``.
-Intro n; Case n.
-Simpl; Auto with real.
-Auto with arith real.
-Qed.
-Hints Resolve pos_INR: real.
-
-Lemma INR_lt:(n,m:nat)``(INR n) < (INR m)``->(lt n m).
-Double Induction n m;Intros.
-Simpl;ElimType False;Apply (Rlt_antirefl R0);Auto.
-Auto with arith.
-Generalize (pos_INR (S n0));Intro;Cut (INR O)==R0;
-  [Intro H2;Rewrite H2 in H0;Idtac|Simpl;Trivial]. 
-Generalize (Rle_lt_trans ``0`` (INR (S n0)) ``0`` H1 H0);Intro;
-  ElimType False;Apply (Rlt_antirefl R0);Auto.
-Do 2 Rewrite S_INR in H1;Cut ``(INR n1) < (INR n0)``.
-Intro H2;Generalize (H0 n0 H2);Intro;Auto with arith.
-Apply (Rlt_anti_compatibility ``1`` (INR n1) (INR n0)).
-Rewrite Rplus_sym;Rewrite (Rplus_sym ``1`` (INR n0));Trivial.
-Qed.
-Hints Resolve INR_lt: real.
-
-(*********)
-Lemma le_INR:(n,m:nat)(le n m)->``(INR n)<=(INR m)``.
-Induction 1; Intros; Auto with real.
-Rewrite S_INR.
-Apply Rle_trans with (INR m0); Auto with real.
-Qed.
-Hints Resolve le_INR: real.
-
-(**********)
-Lemma not_INR_O:(n:nat)``(INR n)<>0``->~n=O.
-Red; Intros n H H1.
-Apply H.
-Rewrite H1; Trivial.
-Qed.
-Hints Immediate not_INR_O : real.
-
-(**********)
-Lemma not_O_INR:(n:nat)~n=O->``(INR n)<>0``.
-Intro n; Case n.
-Intro; Absurd (0)=(0); Trivial.
-Intros; Rewrite S_INR.
-Apply Rgt_not_eq; Red; Auto with real.
-Qed.
-Hints Resolve not_O_INR : real.
-
-Lemma not_nm_INR:(n,m:nat)~n=m->``(INR n)<>(INR m)``.
-Intros n m H; Case (le_or_lt n m); Intros H1.
-Case (le_lt_or_eq ? ? H1); Intros H2.
-Apply imp_not_Req; Auto with real.
-ElimType False;Auto.
-Apply sym_not_eqT; Apply imp_not_Req; Auto with real.
-Qed.
-Hints Resolve not_nm_INR : real.
-
-Lemma INR_eq: (n,m:nat)(INR n)==(INR m)->n=m.
-Intros;Case (le_or_lt n m); Intros H1.
-Case (le_lt_or_eq ? ? H1); Intros H2;Auto.
-Cut ~n=m.
-Intro H3;Generalize (not_nm_INR n m H3);Intro H4;
-  ElimType False;Auto.
-Omega.
-Symmetry;Cut ~m=n.
-Intro H3;Generalize (not_nm_INR m n H3);Intro H4;
-  ElimType False;Auto.
-Omega.
-Qed.
-Hints Resolve INR_eq : real.
-
-Lemma INR_le: (n, m : nat) (Rle (INR n) (INR m)) ->  (le n m).
-Intros;Elim H;Intro.
-Generalize (INR_lt n m H0);Intro;Auto with arith.
-Generalize (INR_eq n m H0);Intro;Rewrite H1;Auto.
-Qed.
-Hints Resolve INR_le : real.
-
-Lemma not_1_INR:(n:nat)~n=(S O)->``(INR n)<>1``.
-Replace ``1``  with (INR (S O)); Auto with real.
-Qed.
-Hints Resolve not_1_INR : real.
-
-(**********************************************************) 
-(**      Injection from [Z] to [R]                        *)
-(**********************************************************)
-
-V7only [
-(**********)
-Definition Z_of_nat := inject_nat.
-Notation INZ:=Z_of_nat.
-].
-
-(**********)
-Lemma IZN:(z:Z)(`0<=z`)->(Ex [m:nat] z=(INZ m)).
-Intros z; Unfold INZ; Apply inject_nat_complete; Assumption.
-Qed.
-
-(**********)
-Lemma INR_IZR_INZ:(n:nat)(INR n)==(IZR (INZ n)).
-Induction n; Auto with real.
-Intros; Simpl; Rewrite bij1; Auto with real.
-Qed.
-
-Lemma plus_IZR_NEG_POS : 
-  (p,q:positive)(IZR `(POS p)+(NEG q)`)==``(IZR (POS p))+(IZR (NEG q))``.
-Intros.
-Case (lt_eq_lt_dec (convert p) (convert q)).
-Intros [H | H]; Simpl.
-Rewrite convert_compare_INFERIEUR; Simpl; Trivial.
-Rewrite (true_sub_convert q p).
-Rewrite minus_INR; Auto with arith; Ring.
-Apply ZC2; Apply convert_compare_INFERIEUR; Trivial.
-Rewrite (convert_intro p q); Trivial.
-Rewrite convert_compare_EGAL; Simpl; Auto with real.
-Intro H; Simpl.
-Rewrite convert_compare_SUPERIEUR; Simpl; Auto with arith.
-Rewrite (true_sub_convert p q).
-Rewrite minus_INR; Auto with arith; Ring.
-Apply ZC2; Apply convert_compare_INFERIEUR; Trivial.
-Qed.
-
-(**********)
-Lemma plus_IZR:(z,t:Z)(IZR `z+t`)==``(IZR z)+(IZR t)``.
-Intro z; NewDestruct z; Intro t; NewDestruct t; Intros; Auto with real.
-Simpl; Intros; Rewrite convert_add; Auto with real.
-Apply plus_IZR_NEG_POS.
-Rewrite Zplus_sym; Rewrite Rplus_sym; Apply plus_IZR_NEG_POS.
-Simpl; Intros; Rewrite convert_add; Rewrite plus_INR; Auto with real.
-Qed.
-
-(**********)
-Lemma mult_IZR:(z,t:Z)(IZR `z*t`)==``(IZR z)*(IZR t)``.
-Intros z t; Case z; Case t; Simpl; Auto with real.
-Intros t1 z1; Rewrite times_convert; Auto with real.
-Intros t1 z1; Rewrite times_convert; Auto with real.
-Rewrite Rmult_sym.
-Rewrite Ropp_mul1; Auto with real.
-Apply eq_Ropp; Rewrite mult_sym; Auto with real.
-Intros t1 z1; Rewrite times_convert; Auto with real.
-Rewrite Ropp_mul1; Auto with real.
-Intros t1 z1; Rewrite times_convert; Auto with real.
-Rewrite Ropp_mul2; Auto with real.
-Qed.
-
-(**********)
-Lemma Ropp_Ropp_IZR:(z:Z)(IZR (`-z`))==``-(IZR z)``.
-Intro z; Case z; Simpl; Auto with real.
-Qed.
-
-(**********)
-Lemma Z_R_minus:(z1,z2:Z)``(IZR z1)-(IZR z2)``==(IZR `z1-z2`).
-Intros z1 z2; Unfold Rminus; Unfold Zminus.
-Rewrite <-(Ropp_Ropp_IZR z2); Symmetry; Apply plus_IZR.
-Qed. 
-
-(**********)
-Lemma lt_O_IZR:(z:Z)``0 < (IZR z)``->`0<z`.
-Intro z; Case z; Simpl; Intros.
-Absurd ``0<0``; Auto with real.
-Unfold Zlt; Simpl; Trivial.
-Case Rlt_le_not with 1:=H.
-Replace ``0`` with ``-0``; Auto with real.
-Qed.
-
-(**********)
-Lemma lt_IZR:(z1,z2:Z)``(IZR z1)<(IZR z2)``->`z1<z2`.
-Intros z1 z2 H; Apply Zlt_O_minus_lt. 
-Apply lt_O_IZR.
-Rewrite <- Z_R_minus.
-Exact (Rgt_minus (IZR z2) (IZR z1) H).
-Qed.
-
-(**********)
-Lemma eq_IZR_R0:(z:Z)``(IZR z)==0``->`z=0`.
-Intro z; NewDestruct z; Simpl; Intros; Auto with zarith.
-Case (Rlt_not_eq ``0`` (INR (convert p))); Auto with real.
-Case (Rlt_not_eq ``-(INR (convert p))`` ``0`` ); Auto with real.
-Apply Rgt_RoppO. Unfold Rgt; Apply INR_pos.
-Qed.
-
-(**********)
-Lemma eq_IZR:(z1,z2:Z)(IZR z1)==(IZR z2)->z1=z2.
-Intros z1 z2 H;Generalize (eq_Rminus (IZR z1) (IZR z2) H);
- Rewrite (Z_R_minus z1 z2);Intro;Generalize (eq_IZR_R0 `z1-z2` H0);
- Intro;Omega.
-Qed.
-
-(**********)
-Lemma not_O_IZR:(z:Z)`z<>0`->``(IZR z)<>0``.
-Intros z H; Red; Intros H0; Case H.
-Apply eq_IZR; Auto.
-Qed.
-
-(*********)
-Lemma le_O_IZR:(z:Z)``0<= (IZR z)``->`0<=z`.
-Unfold Rle; Intros z [H|H].
-Red;Intro;Apply (Zlt_le_weak `0` z (lt_O_IZR z H)); Assumption.
-Rewrite (eq_IZR_R0 z); Auto with zarith real.
-Qed.
-
-(**********)
-Lemma le_IZR:(z1,z2:Z)``(IZR z1)<=(IZR z2)``->`z1<=z2`.
-Unfold Rle; Intros z1 z2 [H|H].
-Apply (Zlt_le_weak z1 z2); Auto with real.
-Apply lt_IZR; Trivial.
-Rewrite (eq_IZR z1 z2); Auto with zarith real.
-Qed.
-
-(**********)
-Lemma le_IZR_R1:(z:Z)``(IZR z)<=1``-> `z<=1`.
-Pattern 1 ``1``; Replace ``1`` with (IZR `1`); Intros; Auto.
-Apply le_IZR; Trivial.
-Qed.
-
-(**********)
-Lemma IZR_ge: (m,n:Z) `m>= n` -> ``(IZR m)>=(IZR n)``.
-Intros m n H; Apply Rlt_not_ge;Red;Intro.
-Generalize (lt_IZR m n H0); Intro; Omega.
-Qed.
-
-Lemma IZR_le: (m,n:Z) `m<= n` -> ``(IZR m)<=(IZR n)``.
-Intros m n H;Apply Rgt_not_le;Red;Intro.
-Unfold Rgt in H0;Generalize (lt_IZR n m H0); Intro; Omega.
-Qed.
-
-Lemma IZR_lt: (m,n:Z) `m< n` -> ``(IZR m)<(IZR n)``.
-Intros m n H;Cut `m<=n`.
-Intro H0;Elim (IZR_le m n H0);Intro;Auto.
-Generalize (eq_IZR m n H1);Intro;ElimType False;Omega.
-Omega.
-Qed.
-
-Lemma one_IZR_lt1 : (z:Z)``-1<(IZR z)<1``->`z=0`.
-Intros z (H1,H2).
-Apply Zle_antisym.
-Apply Zlt_n_Sm_le; Apply lt_IZR; Trivial.
-Replace `0` with (Zs `-1`); Trivial.
-Apply Zlt_le_S; Apply lt_IZR; Trivial.
-Qed.
-
-Lemma one_IZR_r_R1
-  : (r:R)(z,x:Z)``r<(IZR z)<=r+1``->``r<(IZR x)<=r+1``->z=x.
-Intros r z x (H1,H2) (H3,H4).
-Cut `z-x=0`; Auto with zarith.
-Apply one_IZR_lt1.
-Rewrite <- Z_R_minus; Split.
-Replace ``-1`` with ``r-(r+1)``.
-Unfold Rminus; Apply Rplus_lt_le_lt; Auto with real.
-Ring.
-Replace ``1`` with ``(r+1)-r``.
-Unfold Rminus; Apply Rplus_le_lt_lt; Auto with real.
-Ring.
-Qed.
-
-
-(**********)
-Lemma single_z_r_R1: 
-   (r:R)(z,x:Z)``r<(IZR z)``->``(IZR z)<=r+1``->``r<(IZR x)``->
-        ``(IZR x)<=r+1``->z=x.
-Intros; Apply one_IZR_r_R1 with r; Auto.
-Qed.
-
-(**********)
-Lemma tech_single_z_r_R1
-	:(r:R)(z:Z)``r<(IZR z)``->``(IZR z)<=r+1``
-         -> (Ex [s:Z] (~s=z/\``r<(IZR s)``/\``(IZR s)<=r+1``))->False.
-Intros r z H1 H2 (s, (H3,(H4,H5))).
-Apply H3; Apply single_z_r_R1 with r; Trivial.
-Qed.
-
-(*****************************************************************)
-(** Definitions of new types                                     *)
-(*****************************************************************)
-
-Record nonnegreal : Type := mknonnegreal {
-nonneg :> R;
-cond_nonneg : ``0<=nonneg`` }.
-
-Record posreal : Type := mkposreal {
-pos :> R;
-cond_pos : ``0<pos`` }.
-
-Record nonposreal : Type := mknonposreal {
-nonpos :> R;
-cond_nonpos : ``nonpos<=0`` }.
-
-Record negreal : Type := mknegreal {
-neg :> R;
-cond_neg : ``neg<0`` }.
-
-Record nonzeroreal : Type := mknonzeroreal {
-nonzero :> R;
-cond_nonzero : ~``nonzero==0`` }.
-
-(**********)
-Lemma prod_neq_R0 : (x,y:R) ~``x==0``->~``y==0``->~``x*y==0``.
-Intros x y; Intros; Red; Intro; Generalize (without_div_Od x y H1); Intro; Elim H2; Intro; [Rewrite H3 in H; Elim H | Rewrite H3 in H0; Elim H0]; Reflexivity.
-Qed.
-
-(*********)
-Lemma Rmult_le_pos : (x,y:R) ``0<=x`` -> ``0<=y`` -> ``0<=x*y``.
-Intros x y H H0; Rewrite <- (Rmult_Ol x); Rewrite <- (Rmult_sym x); Apply (Rle_monotony x R0 y H H0).
-Qed.
-
-Lemma double : (x:R) ``2*x==x+x``.
-Intro; Ring.
-Qed.
-
-Lemma double_var : (x:R) ``x == x/2 + x/2``.
-Intro; Rewrite <- double; Unfold Rdiv; Rewrite <- Rmult_assoc; Symmetry; Apply Rinv_r_simpl_m.
-Replace ``2`` with (INR (2)); [Apply not_O_INR; Discriminate | Unfold INR; Ring].
-Qed.
-
-(**********************************************************)
-(** Other rules about < and <=                            *)
-(**********************************************************)
-
-Lemma gt0_plus_gt0_is_gt0 : (x,y:R) ``0<x`` -> ``0<y`` -> ``0<x+y``.
-Intros x y; Intros; Apply Rlt_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rlt_compatibility; Assumption].
-Qed.
-
-Lemma ge0_plus_gt0_is_gt0 : (x,y:R) ``0<=x`` -> ``0<y`` -> ``0<x+y``.
-Intros x y; Intros; Apply Rle_lt_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rlt_compatibility; Assumption].
-Qed.
-
-Lemma gt0_plus_ge0_is_gt0 : (x,y:R) ``0<x`` -> ``0<=y`` -> ``0<x+y``.
-Intros x y; Intros; Rewrite <- Rplus_sym; Apply ge0_plus_gt0_is_gt0; Assumption.
-Qed.
-
-Lemma ge0_plus_ge0_is_ge0 : (x,y:R) ``0<=x`` -> ``0<=y`` -> ``0<=x+y``.
-Intros x y; Intros; Apply Rle_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption].
-Qed.
-
-Lemma plus_le_is_le : (x,y,z:R) ``0<=y`` -> ``x+y<=z`` -> ``x<=z``.
-Intros x y z; Intros; Apply Rle_trans with ``x+y``; [Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption | Assumption].
-Qed.
-
-Lemma plus_lt_is_lt : (x,y,z:R) ``0<=y`` -> ``x+y<z`` -> ``x<z``.
-Intros x y z; Intros; Apply Rle_lt_trans with ``x+y``; [Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption | Assumption].
-Qed.
-
-Lemma Rmult_lt2 : (r1,r2,r3,r4:R) ``0<=r1`` -> ``0<=r3`` -> ``r1<r2`` -> ``r3<r4`` -> ``r1*r3<r2*r4``.
-Intros; Apply Rle_lt_trans with ``r2*r3``; [Apply Rle_monotony_r; [Assumption | Left; Assumption] | Apply Rlt_monotony; [Apply Rle_lt_trans with r1; Assumption | Assumption]].
-Qed.
-
-Lemma le_epsilon : (x,y:R) ((eps : R) ``0<eps``->``x<=y+eps``) -> ``x<=y``.
-Intros x y; Intros; Elim (total_order x y); Intro.
-Left; Assumption.
-Elim H0; Intro.
-Right; Assumption.
-Clear H0; Generalize (Rgt_minus x y H1); Intro H2; Change ``0<x-y`` in H2.
-Cut ``0<2``.
-Intro.
-Generalize (Rmult_lt_pos ``x-y`` ``/2`` H2 (Rlt_Rinv ``2`` H0)); Intro H3; Generalize (H ``(x-y)*/2`` H3); Replace ``y+(x-y)*/2`` with ``(y+x)*/2``.
-Intro H4; Generalize (Rle_monotony ``2`` x ``(y+x)*/2`` (Rlt_le ``0`` ``2`` H0) H4); Rewrite <- (Rmult_sym ``((y+x)*/2)``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Replace ``2*x`` with ``x+x``.
-Rewrite (Rplus_sym y); Intro H5; Apply Rle_anti_compatibility with x; Assumption.
-Ring. 
-Replace ``2`` with (INR (S (S O))); [Apply not_O_INR; Discriminate | Ring].
-Pattern 2 y; Replace y with ``y/2+y/2``.
-Unfold Rminus Rdiv.
-Repeat Rewrite Rmult_Rplus_distrl.
-Ring.
-Cut (z:R) ``2*z == z + z``.
-Intro.
-Rewrite <- (H4 ``y/2``).
-Unfold Rdiv.
-Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
-Replace ``2`` with (INR (2)).
-Apply not_O_INR.
-Discriminate.
-Unfold INR; Reflexivity.
-Intro; Ring.
-Cut ~(O=(2)); [Intro H0; Generalize (lt_INR_0 (2) (neq_O_lt (2) H0)); Unfold INR; Intro; Assumption | Discriminate].
-Qed.
-
-(**********)
-Lemma complet_weak : (E:R->Prop) (bound E) -> (ExT [x:R] (E x)) -> (ExT [m:R] (is_lub E m)).
-Intros; Elim (complet E H H0); Intros; Split with x; Assumption.
-Qed.
diff --git a/theories7/Reals/RList.v b/theories7/Reals/RList.v
deleted file mode 100644
index b89296fb..00000000
--- a/theories7/Reals/RList.v
+++ /dev/null
@@ -1,427 +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: RList.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Inductive Rlist : Type :=
-| nil : Rlist
-| cons : R -> Rlist -> Rlist.
-
-Fixpoint In [x:R;l:Rlist] : Prop :=
-Cases l of
-| nil => False
-| (cons a l') => ``x==a``\/(In x l') end.
-
-Fixpoint Rlength [l:Rlist] : nat :=
-Cases l of
-| nil => O
-| (cons a l') => (S (Rlength l')) end.
-
-Fixpoint MaxRlist [l:Rlist] : R :=
- Cases l of
- | nil => R0
- | (cons a l1) => 
-   Cases l1 of
-   | nil => a
-   | (cons a' l2) => (Rmax a (MaxRlist l1)) 
-   end
-end.
-
-Fixpoint MinRlist [l:Rlist] : R :=
-Cases l of
- | nil => R1 
- | (cons a l1) => 
-   Cases l1 of
-   | nil => a
-   | (cons a' l2) => (Rmin a (MinRlist l1)) 
-   end
-end.
-
-Lemma MaxRlist_P1 : (l:Rlist;x:R) (In x l)->``x<=(MaxRlist l)``.
-Intros; Induction l.
-Simpl in H; Elim H.
-Induction l.
-Simpl in H; Elim H; Intro.
-Simpl; Right; Assumption.
-Elim H0.
-Replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))).
-Simpl in H; Decompose [or] H.
-Rewrite H0; Apply RmaxLess1.
-Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
-Apply Hrecl; Simpl; Tauto.
-Apply Rle_trans with (MaxRlist (cons r0 l)); [Apply Hrecl; Simpl; Tauto | Left; Auto with real].
-Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
-Apply Hrecl; Simpl; Tauto.
-Apply Rle_trans with (MaxRlist (cons r0 l)); [Apply Hrecl; Simpl; Tauto | Left; Auto with real].
-Reflexivity.
-Qed.
-
-Fixpoint AbsList [l:Rlist] : R->Rlist :=
-[x:R] Cases l of
-| nil => nil
-| (cons a l') => (cons ``(Rabsolu (a-x))/2`` (AbsList l' x))
-end.
-
-Lemma MinRlist_P1 : (l:Rlist;x:R) (In x l)->``(MinRlist l)<=x``.
-Intros; Induction l.
-Simpl in H; Elim H.
-Induction l.
-Simpl in H; Elim H; Intro.
-Simpl; Right; Symmetry; Assumption.
-Elim H0.
-Replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
-Simpl in H; Decompose [or] H.
-Rewrite H0; Apply Rmin_l.
-Unfold Rmin; Case (total_order_Rle r (MinRlist (cons r0 l))); Intro.
-Apply Rle_trans with (MinRlist (cons r0 l)).
-Assumption.
-Apply Hrecl; Simpl; Tauto.
-Apply Hrecl; Simpl; Tauto.
-Apply Rle_trans with (MinRlist (cons r0 l)).
-Apply Rmin_r.
-Apply Hrecl; Simpl; Tauto.
-Reflexivity.
-Qed.
-
-Lemma AbsList_P1 : (l:Rlist;x,y:R) (In y l) -> (In ``(Rabsolu (y-x))/2`` (AbsList l x)).
-Intros; Induction l.
-Elim H.
-Simpl; Simpl in H; Elim H; Intro.
-Left; Rewrite H0; Reflexivity.
-Right; Apply Hrecl; Assumption.
-Qed.
-
-Lemma MinRlist_P2 : (l:Rlist) ((y:R)(In y l)->``0<y``)->``0<(MinRlist l)``.
-Intros; Induction l.
-Apply Rlt_R0_R1.
-Induction l.
-Simpl; Apply H; Simpl; Tauto.
-Replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
-Unfold Rmin; Case (total_order_Rle r (MinRlist (cons r0 l))); Intro.
-Apply H; Simpl; Tauto.
-Apply Hrecl; Intros; Apply H; Simpl; Simpl in H0; Tauto.
-Reflexivity.
-Qed.
-
-Lemma AbsList_P2 : (l:Rlist;x,y:R) (In y (AbsList l x)) -> (EXT z : R | (In z l)/\``y==(Rabsolu (z-x))/2``).
-Intros; Induction l.
-Elim H.
-Elim H; Intro.
-Exists r; Split.
-Simpl; Tauto.
-Assumption.
-Assert H1 := (Hrecl H0); Elim H1; Intros; Elim H2; Clear H2; Intros; Exists x0; Simpl; Simpl in H2; Tauto.
-Qed.
-
-Lemma MaxRlist_P2 : (l:Rlist) (EXT y:R | (In y l)) -> (In (MaxRlist l) l).
-Intros; Induction l.
-Simpl in H; Elim H; Trivial.
-Induction l.
-Simpl; Left; Reflexivity.
-Change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))); Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
-Right; Apply Hrecl; Exists r0; Left; Reflexivity.
-Left; Reflexivity.
-Qed.
-
-Fixpoint pos_Rl [l:Rlist] : nat->R :=
-[i:nat] Cases l of
-| nil => R0
-| (cons a l') =>
- Cases i of
- | O => a
- | (S i') => (pos_Rl l' i')
- end
-end.
-
-Lemma pos_Rl_P1 : (l:Rlist;a:R) (lt O (Rlength l)) -> (pos_Rl (cons a l) (Rlength l))==(pos_Rl l (pred (Rlength l))).
-Intros; Induction l; [Elim (lt_n_O ? H) | Simpl; Case (Rlength l); [Reflexivity | Intro; Reflexivity]].
-Qed.
-
-Lemma pos_Rl_P2 : (l:Rlist;x:R) (In x l)<->(EX i:nat | (lt i (Rlength l))/\x==(pos_Rl l i)).
-Intros; Induction l.
-Split; Intro; [Elim H | Elim H; Intros; Elim H0; Intros; Elim (lt_n_O ? H1)].
-Split; Intro.
-Elim H; Intro.
-Exists O; Split; [Simpl; Apply lt_O_Sn | Simpl; Apply H0].
-Elim Hrecl; Intros; Assert H3 := (H1 H0); Elim H3; Intros; Elim H4; Intros; Exists (S x0); Split; [Simpl; Apply lt_n_S; Assumption | Simpl; Assumption].
-Elim H; Intros; Elim H0; Intros; Elim (zerop x0); Intro.
-Rewrite a in H2; Simpl in H2; Left; Assumption.
-Right; Elim Hrecl; Intros; Apply H4; Assert H5 : (S (pred x0))=x0.
-Symmetry; Apply S_pred with O; Assumption.
-Exists (pred x0); Split; [Simpl in H1; Apply lt_S_n; Rewrite H5; Assumption | Rewrite <- H5 in H2; Simpl in H2; Assumption].
-Qed.
-
-Lemma Rlist_P1 : (l:Rlist;P:R->R->Prop) ((x:R)(In x l)->(EXT y:R | (P x y))) -> (EXT l':Rlist | (Rlength l)=(Rlength l')/\(i:nat) (lt i (Rlength l))->(P (pos_Rl l i) (pos_Rl l' i))).
-Intros; Induction l.
-Exists nil; Intros; Split; [Reflexivity | Intros; Simpl in H0; Elim (lt_n_O ? H0)].
-Assert H0 : (In r (cons r l)).
-Simpl; Left; Reflexivity.
-Assert H1 := (H ? H0); Assert H2 : (x:R)(In x l)->(EXT y:R | (P x y)).
-Intros; Apply H; Simpl; Right; Assumption.
-Assert H3 := (Hrecl H2); Elim H1; Intros; Elim H3; Intros; Exists (cons x x0); Intros; Elim H5; Clear H5; Intros; Split.
-Simpl; Rewrite H5; Reflexivity.
-Intros; Elim (zerop i); Intro.
-Rewrite a; Simpl; Assumption.
-Assert H8 : i=(S (pred i)).
-Apply S_pred with O; Assumption.
-Rewrite H8; Simpl; Apply H6; Simpl in H7; Apply lt_S_n; Rewrite <- H8; Assumption.
-Qed.
-
-Definition ordered_Rlist [l:Rlist] : Prop := (i:nat) (lt i (pred (Rlength l))) -> (Rle (pos_Rl l i) (pos_Rl l (S i))).
-
-Fixpoint insert [l:Rlist] : R->Rlist :=
-[x:R] Cases l of
-| nil => (cons x nil)
-| (cons a l') =>
- Cases (total_order_Rle a x) of
- | (leftT _) => (cons a (insert l' x))
- | (rightT _) => (cons x l)
- end
-end.
-
-Fixpoint cons_Rlist [l:Rlist] : Rlist->Rlist :=
-[k:Rlist] Cases l of
-| nil => k
-| (cons a l') => (cons a (cons_Rlist l' k)) end.
-
-Fixpoint cons_ORlist [k:Rlist] : Rlist->Rlist :=
-[l:Rlist] Cases k of
-| nil => l
-| (cons a k') => (cons_ORlist k' (insert l a))
-end.
-
-Fixpoint app_Rlist [l:Rlist] : (R->R)->Rlist :=
-[f:R->R] Cases l of
-| nil => nil
-| (cons a l') => (cons (f a) (app_Rlist l' f))
-end.
-
-Fixpoint mid_Rlist [l:Rlist] : R->Rlist :=
-[x:R] Cases l of
-| nil => nil
-| (cons a l') => (cons ``(x+a)/2`` (mid_Rlist l' a))
-end.
-
-Definition Rtail [l:Rlist] : Rlist :=
-Cases l of
-| nil => nil
-| (cons a l') => l'
-end.
-
-Definition FF [l:Rlist;f:R->R] : Rlist := 
-Cases l of
-| nil => nil
-| (cons a l') => (app_Rlist (mid_Rlist l' a) f)
-end.
-
-Lemma RList_P0 : (l:Rlist;a:R) ``(pos_Rl (insert l a) O) == a`` \/ ``(pos_Rl (insert l a) O) == (pos_Rl l O)``.
-Intros; Induction l; [Left; Reflexivity | Simpl; Case (total_order_Rle r a); Intro; [Right; Reflexivity | Left; Reflexivity]].
-Qed.
-
-Lemma RList_P1 : (l:Rlist;a:R) (ordered_Rlist l) -> (ordered_Rlist (insert l a)).
-Intros; Induction l.
-Simpl; Unfold ordered_Rlist; Intros; Simpl in H0; Elim (lt_n_O ? H0).
-Simpl; Case (total_order_Rle r a); Intro.
-Assert H1 : (ordered_Rlist l).
-Unfold ordered_Rlist; Unfold ordered_Rlist in H; Intros; Assert H1 : (lt (S i) (pred (Rlength (cons r l)))); [Simpl; Replace (Rlength l) with (S (pred (Rlength l))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H1 in H0; Simpl in H0; Elim (lt_n_O ? H0)] | Apply (H ? H1)].
-Assert H2 := (Hrecl H1); Unfold ordered_Rlist; Intros; Induction i.
-Simpl; Assert H3 := (RList_P0 l a); Elim H3; Intro.
-Rewrite H4; Assumption.
-Induction l; [Simpl; Assumption | Rewrite H4; Apply (H O); Simpl; Apply lt_O_Sn].
-Simpl; Apply H2; Simpl in H0; Apply lt_S_n; Replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a)); [Assumption | Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H3 in H0; Elim (lt_n_O ? H0)].
-Unfold ordered_Rlist; Intros; Induction i; [Simpl; Auto with real | Change ``(pos_Rl (cons r l) i)<=(pos_Rl (cons r l) (S i))``; Apply H; Simpl in H0; Simpl; Apply (lt_S_n ? ? H0)].
-Qed.
-
-Lemma RList_P2 : (l1,l2:Rlist) (ordered_Rlist l2) ->(ordered_Rlist (cons_ORlist l1 l2)).
-Induction l1; [Intros; Simpl; Apply H | Intros; Simpl; Apply H; Apply RList_P1; Assumption].
-Qed.
-
-Lemma RList_P3 : (l:Rlist;x:R) (In x l) <-> (EX i:nat | x==(pos_Rl l i)/\(lt i (Rlength l))).
-Intros; Split; Intro; Induction l.
-Elim H.
-Elim H; Intro; [Exists O; Split; [Apply H0 | Simpl; Apply lt_O_Sn] | Elim (Hrecl H0); Intros; Elim H1; Clear H1; Intros; Exists (S x0); Split; [Apply H1 | Simpl; Apply lt_n_S; Assumption]].
-Elim H; Intros; Elim H0; Intros; Elim (lt_n_O ? H2).
-Simpl; Elim H; Intros; Elim H0; Clear H0; Intros; Induction x0; [Left; Apply H0 | Right; Apply Hrecl; Exists x0; Split; [Apply H0 | Simpl in H1; Apply lt_S_n; Assumption]].
-Qed.
-
-Lemma RList_P4 : (l1:Rlist;a:R) (ordered_Rlist (cons a l1)) -> (ordered_Rlist l1).
-Intros; Unfold ordered_Rlist; Intros; Apply (H (S i)); Simpl; Replace (Rlength l1) with (S (pred (Rlength l1))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H1 in H0; Elim (lt_n_O ? H0)].
-Qed.
-
-Lemma RList_P5 : (l:Rlist;x:R) (ordered_Rlist l) -> (In x l) -> ``(pos_Rl l O)<=x``.
-Intros; Induction l; [Elim H0 | Simpl; Elim H0; Intro; [Rewrite H1; Right; Reflexivity | Apply Rle_trans with (pos_Rl l O); [Apply (H O); Simpl; Induction l; [Elim H1 | Simpl; Apply lt_O_Sn] | Apply Hrecl; [EApply RList_P4; Apply H | Assumption]]]].
-Qed.
-
-Lemma RList_P6 : (l:Rlist) (ordered_Rlist l)<->((i,j:nat)(le i j)->(lt j (Rlength l))->``(pos_Rl l i)<=(pos_Rl l j)``).
-Induction l; Split; Intro.
-Intros; Right; Reflexivity.
-Unfold ordered_Rlist; Intros; Simpl in H0; Elim (lt_n_O ? H0).
-Intros; Induction i; [Induction j; [Right; Reflexivity | Simpl; Apply Rle_trans with (pos_Rl r0 O); [Apply (H0 O); Simpl; Simpl in H2; Apply neq_O_lt; Red; Intro; Rewrite <- H3 in H2; Assert H4 := (lt_S_n ? ? H2); Elim (lt_n_O ? H4) | Elim H; Intros; Apply H3; [Apply RList_P4 with r; Assumption | Apply le_O_n | Simpl in H2; Apply lt_S_n; Assumption]]] | Induction j; [Elim (le_Sn_O ? H1) | Simpl; Elim H; Intros; Apply H3; [Apply RList_P4 with r; Assumption | Apply le_S_n; Assumption | Simpl in H2; Apply lt_S_n; Assumption]]].
-Unfold ordered_Rlist; Intros; Apply H0; [Apply le_n_Sn | Simpl; Simpl in H1; Apply lt_n_S; Assumption].
-Qed.
-
-Lemma RList_P7 : (l:Rlist;x:R) (ordered_Rlist l) -> (In x l) -> ``x<=(pos_Rl l (pred (Rlength l)))``.
-Intros; Assert H1 := (RList_P6 l); Elim H1; Intros H2 _; Assert H3 := (H2 H); Clear H1 H2; Assert H1 := (RList_P3 l x); Elim H1; Clear H1; Intros; Assert H4 := (H1 H0); Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Rewrite H4; Assert H6 : (Rlength l)=(S (pred (Rlength l))).
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H6 in H5; Elim (lt_n_O ? H5).
-Apply H3; [Rewrite H6 in H5; Apply lt_n_Sm_le; Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H7 in H5; Elim (lt_n_O ? H5)].
-Qed.
-
-Lemma RList_P8 : (l:Rlist;a,x:R) (In x (insert l a)) <-> x==a\/(In x l).
-Induction l.
-Intros; Split; Intro; Simpl in H; Apply H.
-Intros; Split; Intro; [Simpl in H0; Generalize H0; Case (total_order_Rle r a); Intros; [Simpl in H1; Elim H1; Intro; [Right; Left; Assumption |Elim (H a x); Intros; Elim (H3 H2); Intro; [Left; Assumption | Right; Right; Assumption]] | Simpl in H1; Decompose [or] H1; [Left; Assumption | Right; Left; Assumption | Right; Right; Assumption]]  |  Simpl; Case (total_order_Rle r a); Intro; [Simpl in H0; Decompose [or] H0; [Right; Elim (H a x); Intros; Apply H3; Left | Left | Right; Elim (H a x); Intros; Apply H3; Right] | Simpl in H0; Decompose [or] H0; [Left | Right; Left | Right; Right]]; Assumption].
-Qed.
-
-Lemma RList_P9 : (l1,l2:Rlist;x:R) (In x (cons_ORlist l1 l2)) <-> (In x l1)\/(In x l2).
-Induction l1.
-Intros; Split; Intro; [Simpl in H; Right; Assumption | Simpl; Elim H; Intro; [Elim H0 | Assumption]].
-Intros; Split.
-Simpl; Intros; Elim (H (insert l2 r) x); Intros; Assert H3 := (H1 H0); Elim H3; Intro; [Left; Right; Assumption | Elim (RList_P8 l2 r x); Intros H5 _; Assert H6 := (H5 H4); Elim H6; Intro; [Left; Left; Assumption | Right; Assumption]].
-Intro; Simpl; Elim (H (insert l2 r) x); Intros _ H1; Apply H1; Elim H0; Intro; [Elim H2; Intro; [Right; Elim (RList_P8 l2 r x); Intros _ H4; Apply H4; Left; Assumption | Left; Assumption] | Right; Elim (RList_P8 l2 r x); Intros _ H3; Apply H3; Right; Assumption].
-Qed.
-
-Lemma RList_P10 : (l:Rlist;a:R) (Rlength (insert l a))==(S (Rlength l)).
-Intros; Induction l; [Reflexivity | Simpl; Case (total_order_Rle r a); Intro; [Simpl; Rewrite Hrecl; Reflexivity | Reflexivity]].
-Qed.
-
-Lemma RList_P11 : (l1,l2:Rlist) (Rlength (cons_ORlist l1 l2))=(plus (Rlength l1) (Rlength l2)).
-Induction l1; [Intro; Reflexivity | Intros; Simpl; Rewrite (H (insert l2 r)); Rewrite RList_P10; Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring].
-Qed.
-
-Lemma RList_P12 : (l:Rlist;i:nat;f:R->R) (lt i (Rlength l)) -> (pos_Rl (app_Rlist l f) i)==(f (pos_Rl l i)).
-Induction l; [Intros; Elim (lt_n_O ? H) | Intros; Induction i; [Reflexivity | Simpl; Apply H; Apply lt_S_n; Apply H0]].
-Qed.
-
-Lemma RList_P13 : (l:Rlist;i:nat;a:R) (lt i (pred (Rlength l))) -> ``(pos_Rl (mid_Rlist l a) (S i)) == ((pos_Rl l i)+(pos_Rl l (S i)))/2``.
-Induction l.
-Intros; Simpl in H; Elim (lt_n_O ? H).
-Induction r0.
-Intros; Simpl in H0; Elim (lt_n_O ? H0).
-Intros; Simpl in H1; Induction i.
-Reflexivity.
-Change ``(pos_Rl (mid_Rlist (cons r1 r2) r) (S i)) == ((pos_Rl (cons r1 r2) i)+(pos_Rl (cons r1 r2) (S i)))/2``; Apply H0; Simpl; Apply lt_S_n; Assumption.
-Qed.
-
-Lemma RList_P14 : (l:Rlist;a:R) (Rlength (mid_Rlist l a))=(Rlength l).
-Induction l; Intros; [Reflexivity | Simpl; Rewrite (H r); Reflexivity].
-Qed.
-
-Lemma RList_P15 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> (pos_Rl l1 O)==(pos_Rl l2 O) -> (pos_Rl (cons_ORlist l1 l2) O)==(pos_Rl l1 O).
-Intros; Apply Rle_antisym.
-Induction l1; [Simpl; Simpl in H1; Right; Symmetry; Assumption | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (0))); Intros; Assert H4 : (In (pos_Rl (cons r l1) (0)) (cons r l1))\/(In (pos_Rl (cons r l1) (0)) l2); [Left; Left; Reflexivity | Assert H5 := (H3 H4); Apply RList_P5; [Apply RList_P2; Assumption | Assumption]]].
-Induction l1; [Simpl; Simpl in H1; Right; Assumption | Assert H2 : (In (pos_Rl (cons_ORlist (cons r l1) l2) (0)) (cons_ORlist (cons r l1) l2)); [Elim (RList_P3 (cons_ORlist (cons r l1) l2) (pos_Rl (cons_ORlist (cons r l1) l2) (0))); Intros; Apply H3; Exists O; Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_O_Sn] | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) (0))); Intros; Assert H5 := (H3 H2); Elim H5; Intro; [Apply RList_P5; Assumption | Rewrite H1; Apply RList_P5; Assumption]]].
-Qed.
-
-Lemma RList_P16 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> (pos_Rl l1 (pred (Rlength l1)))==(pos_Rl l2 (pred (Rlength l2))) -> (pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))))==(pos_Rl l1 (pred (Rlength l1))).
-Intros; Apply Rle_antisym.
-Induction l1.
-Simpl; Simpl in H1; Right; Symmetry; Assumption. 
-Assert H2 : (In (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2)))) (cons_ORlist (cons r l1) l2)); [Elim (RList_P3 (cons_ORlist (cons r l1) l2) (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2))))); Intros; Apply H3; Exists (pred (Rlength (cons_ORlist (cons r l1) l2))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn] | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2))))); Intros; Assert H5 := (H3 H2); Elim H5; Intro; [Apply RList_P7; Assumption | Rewrite H1; Apply RList_P7; Assumption]].
-Induction l1.
-Simpl; Simpl in H1; Right; Assumption.
-Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Assert H4 : (In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1))\/(In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2); [Left; Change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)); Elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); Intros; Apply H5; Exists (Rlength l1); Split; [Reflexivity | Simpl; Apply lt_n_Sn] | Assert H5 := (H3 H4); Apply RList_P7; [Apply RList_P2; Assumption | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Apply H7; Left; Elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Apply H9; Exists (pred (Rlength (cons r l1))); Split; [Reflexivity | Simpl; Apply lt_n_Sn]]].
-Qed.
-
-Lemma RList_P17 : (l1:Rlist;x:R;i:nat) (ordered_Rlist l1) -> (In x l1) -> ``(pos_Rl l1 i)<x`` -> (lt i (pred (Rlength l1))) -> ``(pos_Rl l1 (S i))<=x``.
-Induction l1.
-Intros; Elim H0.
-Intros; Induction i.
-Simpl; Elim H1; Intro; [Simpl in H2; Rewrite H4 in H2; Elim (Rlt_antirefl ? H2) | Apply RList_P5; [Apply RList_P4 with r; Assumption | Assumption]].
-Simpl; Simpl in H2; Elim H1; Intro.
-Rewrite H4 in H2; Assert H5 : ``r<=(pos_Rl r0 i)``; [Apply Rle_trans with (pos_Rl r0 O); [Apply (H0 O); Simpl; Simpl in H3; Apply neq_O_lt; Red; Intro; Rewrite <- H5 in H3; Elim (lt_n_O ? H3) | Elim (RList_P6 r0); Intros; Apply H5; [Apply RList_P4 with r; Assumption | Apply le_O_n | Simpl in H3; Apply lt_S_n; Apply lt_trans with (Rlength r0); [Apply H3 | Apply lt_n_Sn]]] | Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H2))].
-Apply H; Try Assumption; [Apply RList_P4 with r; Assumption | Simpl in H3; Apply lt_S_n; Replace (S (pred (Rlength r0))) with (Rlength r0); [Apply H3 | Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H5 in H3; Elim (lt_n_O ? H3)]].
-Qed.
-
-Lemma RList_P18 : (l:Rlist;f:R->R) (Rlength (app_Rlist l f))=(Rlength l).
-Induction l; Intros; [Reflexivity | Simpl; Rewrite H; Reflexivity].
-Qed.
-
-Lemma RList_P19 : (l:Rlist) ~l==nil -> (EXT r:R | (EXT r0:Rlist | l==(cons r r0))).
-Intros; Induction l; [Elim H; Reflexivity | Exists r; Exists l; Reflexivity].
-Qed.
-
-Lemma RList_P20 : (l:Rlist) (le (2) (Rlength l)) -> (EXT r:R | (EXT r1:R | (EXT l':Rlist | l==(cons r (cons r1 l'))))). 
-Intros; Induction l; [Simpl in H; Elim (le_Sn_O ? H) | Induction l; [Simpl in H; Elim (le_Sn_O ? (le_S_n ? ? H)) | Exists r; Exists r0; Exists l; Reflexivity]].
-Qed.
-
-Lemma RList_P21 : (l,l':Rlist) l==l' -> (Rtail l)==(Rtail l').
-Intros; Rewrite H; Reflexivity.
-Qed.
-
-Lemma RList_P22 : (l1,l2:Rlist) ~l1==nil -> (pos_Rl (cons_Rlist l1 l2) O)==(pos_Rl l1 O).
-Induction l1; [Intros; Elim H; Reflexivity | Intros; Reflexivity].
-Qed.
-
-Lemma RList_P23 : (l1,l2:Rlist) (Rlength (cons_Rlist l1 l2))==(plus (Rlength l1) (Rlength l2)).
-Induction l1; [Intro; Reflexivity | Intros; Simpl; Rewrite H; Reflexivity].
-Qed.
-
-Lemma RList_P24 : (l1,l2:Rlist) ~l2==nil -> (pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2)))) == (pos_Rl l2 (pred (Rlength l2))).
-Induction l1.
-Intros; Reflexivity.
-Intros; Rewrite <- (H l2 H0); Induction l2.
-Elim H0; Reflexivity.
-Do 2 Rewrite RList_P23; Replace (plus (Rlength (cons r r0)) (Rlength (cons r1 l2))) with (S (S (plus (Rlength r0) (Rlength l2)))); [Replace (plus (Rlength r0) (Rlength (cons r1 l2))) with (S (plus (Rlength r0) (Rlength l2))); [Reflexivity | Simpl; Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring] | Simpl; Apply INR_eq; Do 3 Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring].
-Qed.
-
-Lemma RList_P25 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> ``(pos_Rl l1 (pred (Rlength l1)))<=(pos_Rl l2 O)`` -> (ordered_Rlist (cons_Rlist l1 l2)).
-Induction l1.
-Intros; Simpl; Assumption.
-Induction r0.
-Intros; Simpl; Simpl in H2; Unfold ordered_Rlist; Intros; Simpl in H3.
-Induction i.
-Simpl; Assumption.
-Change ``(pos_Rl l2 i)<=(pos_Rl l2 (S i))``; Apply (H1 i); Apply lt_S_n; Replace (S (pred (Rlength l2))) with (Rlength l2); [Assumption | Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H4 in H3; Elim (lt_n_O ? H3)].
-Intros; Clear H; Assert H : (ordered_Rlist (cons_Rlist (cons r1 r2) l2)).
-Apply H0; Try Assumption.
-Apply RList_P4 with r; Assumption.
-Unfold ordered_Rlist; Intros; Simpl in H4; Induction i.
-Simpl; Apply (H1 O); Simpl; Apply lt_O_Sn.
-Change ``(pos_Rl (cons_Rlist (cons r1 r2) l2) i)<=(pos_Rl (cons_Rlist (cons r1 r2) l2) (S i))``; Apply (H i); Simpl; Apply lt_S_n; Assumption.
-Qed.
-
-Lemma RList_P26 : (l1,l2:Rlist;i:nat) (lt i (Rlength l1)) -> (pos_Rl (cons_Rlist l1 l2) i)==(pos_Rl l1 i).
-Induction l1.
-Intros; Elim (lt_n_O ? H).
-Intros; Induction i.
-Apply RList_P22; Discriminate.
-Apply (H l2 i); Simpl in H0; Apply lt_S_n; Assumption.
-Qed.
-
-Lemma RList_P27 : (l1,l2,l3:Rlist) (cons_Rlist l1 (cons_Rlist l2 l3))==(cons_Rlist (cons_Rlist l1 l2) l3).
-Induction l1; Intros; [Reflexivity | Simpl; Rewrite (H l2 l3); Reflexivity].
-Qed.
-
-Lemma RList_P28 : (l:Rlist) (cons_Rlist l nil)==l.
-Induction l; [Reflexivity | Intros; Simpl; Rewrite H; Reflexivity].
-Qed.
-
-Lemma RList_P29 : (l2,l1:Rlist;i:nat) (le (Rlength l1) i) -> (lt i (Rlength (cons_Rlist l1 l2))) -> (pos_Rl (cons_Rlist l1 l2) i)==(pos_Rl l2 (minus i (Rlength l1))).
-Induction l2.
-Intros; Rewrite RList_P28 in H0; Elim (lt_n_n ? (le_lt_trans ? ? ? H H0)).
-Intros; Replace (cons_Rlist l1 (cons r r0)) with (cons_Rlist (cons_Rlist l1 (cons r nil)) r0).
-Inversion H0.
-Rewrite <- minus_n_n; Simpl; Rewrite RList_P26.
-Clear l2 r0 H i H0 H1 H2; Induction l1.
-Reflexivity.
-Simpl; Assumption.
-Rewrite RList_P23; Rewrite plus_sym; Simpl; Apply lt_n_Sn.
-Replace (minus (S m) (Rlength l1)) with (S (minus (S m) (S (Rlength l1)))).
-Rewrite H3; Simpl; Replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))).
-Apply (H (cons_Rlist l1 (cons r nil)) i).
-Rewrite RList_P23; Rewrite plus_sym; Simpl; Rewrite <- H3; Apply le_n_S; Assumption.
-Repeat Rewrite RList_P23; Simpl; Rewrite RList_P23 in H1; Rewrite plus_sym in H1; Simpl in H1; Rewrite (plus_sym (Rlength l1)); Simpl; Rewrite plus_sym; Apply H1.
-Rewrite RList_P23; Rewrite plus_sym; Reflexivity.
-Change (S (minus m (Rlength l1)))=(minus (S m) (Rlength l1)); Apply minus_Sn_m; Assumption.
-Replace (cons r r0) with (cons_Rlist (cons r nil) r0); [Symmetry; Apply RList_P27 | Reflexivity].
-Qed.
diff --git a/theories7/Reals/R_Ifp.v b/theories7/Reals/R_Ifp.v
deleted file mode 100644
index 621cca64..00000000
--- a/theories7/Reals/R_Ifp.v
+++ /dev/null
@@ -1,552 +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: R_Ifp.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-(**********************************************************)
-(** Complements for the reals.Integer and fractional part *)
-(*                                                        *)
-(**********************************************************)
-
-Require Rbase.
-Require Omega.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(*********************************************************)
-(**      Fractional part                                 *)
-(*********************************************************)
-
-(**********)
-Definition Int_part:R->Z:=[r:R](`(up r)-1`).
-
-(**********)
-Definition frac_part:R->R:=[r:R](Rminus r (IZR (Int_part r))).
-
-(**********)
-Lemma tech_up:(r:R)(z:Z)(Rlt r (IZR z))->(Rle (IZR z) (Rplus r R1))->
-  z=(up r).
-Intros;Generalize (archimed r);Intro;Elim H1;Intros;Clear H1;
- Unfold Rgt in H2;Unfold Rminus in H3;
-Generalize (Rle_compatibility r (Rplus (IZR (up r)) 
- (Ropp r)) R1 H3);Intro;Clear H3;
- Rewrite (Rplus_sym (IZR (up r)) (Ropp r)) in H1;
- Rewrite <-(Rplus_assoc r (Ropp r) (IZR (up r))) in H1;
- Rewrite (Rplus_Ropp_r r) in H1;Elim (Rplus_ne (IZR (up r)));Intros a b;
- Rewrite b in H1;Clear a b;Apply (single_z_r_R1 r z (up r));Auto with zarith real.
-Qed.
-
-(**********)
-Lemma up_tech:(r:R)(z:Z)(Rle (IZR z) r)->(Rlt r (IZR `z+1`))->
-  `z+1`=(up r).
-Intros;Generalize (Rle_compatibility R1 (IZR z) r H);Intro;Clear H;
- Rewrite (Rplus_sym R1 (IZR z)) in H1;Rewrite (Rplus_sym R1 r) in H1;
- Cut (R1==(IZR `1`));Auto with zarith real.
-Intro;Generalize H1;Pattern 1 R1;Rewrite H;Intro;Clear H H1;
- Rewrite <-(plus_IZR z `1`) in H2;Apply (tech_up r `z+1`);Auto with zarith real.
-Qed.
-
-(**********)
-Lemma fp_R0:(frac_part R0)==R0.
-Unfold frac_part; Unfold Int_part; Elim (archimed R0);
- Intros; Unfold Rminus;
- Elim (Rplus_ne (Ropp (IZR `(up R0)-1`))); Intros a b;
- Rewrite b;Clear a b;Rewrite <- Z_R_minus;Cut (up R0)=`1`.
-Intro;Rewrite H1;
- Rewrite (eq_Rminus (IZR `1`) (IZR `1`) (refl_eqT R (IZR `1`)));
- Apply Ropp_O. 
-Elim (archimed R0);Intros;Clear H2;Unfold Rgt in H1;
- Rewrite (minus_R0 (IZR (up R0))) in H0;
- Generalize (lt_O_IZR (up R0) H1);Intro;Clear H1;
- Generalize (le_IZR_R1 (up R0) H0);Intro;Clear H H0;Omega.
-Qed.
-
-(**********)
-Lemma for_base_fp:(r:R)(Rgt (Rminus (IZR (up r)) r) R0)/\ 
-                       (Rle (Rminus (IZR (up r)) r) R1).
-Intro; Split;
- Cut (Rgt (IZR (up r)) r)/\(Rle (Rminus (IZR (up r)) r) R1).
-Intro; Elim H; Intros.
-Apply (Rgt_minus (IZR (up r)) r H0).
-Apply archimed.
-Intro; Elim H; Intros.
-Exact H1.
-Apply archimed.
-Qed.
-
-(**********)
-Lemma base_fp:(r:R)(Rge (frac_part r) R0)/\(Rlt (frac_part r) R1).
-Intro; Unfold frac_part; Unfold Int_part; Split.
-     (*sup a O*)
-Cut (Rge (Rminus r (IZR (up r))) (Ropp R1)).
-Rewrite <- Z_R_minus;Simpl;Intro; Unfold Rminus;
- Rewrite Ropp_distr1;Rewrite <-Rplus_assoc;
- Fold (Rminus r (IZR (up r)));
- Fold (Rminus (Rminus r (IZR (up r))) (Ropp R1));
- Apply Rge_minus;Auto with zarith real.
-Rewrite <- Ropp_distr2;Apply Rle_Ropp;Elim (for_base_fp r); Auto with zarith real.
-    (*inf a 1*) 
-Cut (Rlt (Rminus r (IZR (up r))) R0).
-Rewrite <- Z_R_minus; Simpl;Intro; Unfold Rminus;
- Rewrite Ropp_distr1;Rewrite <-Rplus_assoc;
- Fold (Rminus r (IZR (up r)));Rewrite Ropp_Ropp;
- Elim (Rplus_ne R1);Intros a b;Pattern 2 R1;Rewrite <-a;Clear a b;
- Rewrite (Rplus_sym  (Rminus r (IZR (up r))) R1);
- Apply Rlt_compatibility;Auto with zarith real.
-Elim (for_base_fp r);Intros;Rewrite <-Ropp_O;
- Rewrite<-Ropp_distr2;Apply Rgt_Ropp;Auto with zarith real.
-Qed.
-
-(*********************************************************)
-(**      Properties                                      *)
-(*********************************************************)
-
-(**********)
-Lemma base_Int_part:(r:R)(Rle (IZR (Int_part r)) r)/\
-                    (Rgt (Rminus (IZR (Int_part r)) r) (Ropp R1)). 
-Intro;Unfold Int_part;Elim (archimed r);Intros.
-Split;Rewrite <- (Z_R_minus (up r) `1`);Simpl.
-Generalize (Rle_minus (Rminus (IZR (up r)) r) R1 H0);Intro;
- Unfold Rminus in H1;
- Rewrite (Rplus_assoc (IZR (up r)) (Ropp r) (Ropp R1)) in 
- H1;Rewrite (Rplus_sym (Ropp r) (Ropp R1)) in H1;
- Rewrite <-(Rplus_assoc (IZR (up r)) (Ropp R1) (Ropp r)) in
- H1;Fold (Rminus (IZR (up r)) R1) in H1;
- Fold (Rminus (Rminus (IZR (up r)) R1) r) in H1;
- Apply Rminus_le;Auto with zarith real.
-Generalize (Rgt_plus_plus_r (Ropp R1) (IZR (up r)) r H);Intro;
- Rewrite (Rplus_sym (Ropp R1) (IZR (up r))) in H1;
- Generalize (Rgt_plus_plus_r (Ropp r) 
-   (Rplus (IZR (up r)) (Ropp R1)) (Rplus (Ropp R1) r) H1);
- Intro;Clear H H0 H1;
- Rewrite (Rplus_sym (Ropp r) (Rplus (IZR (up r)) (Ropp R1)))
- in H2;Fold (Rminus (IZR (up r)) R1) in H2;
- Fold (Rminus (Rminus (IZR (up r)) R1) r) in H2;
- Rewrite (Rplus_sym (Ropp r) (Rplus (Ropp R1) r)) in H2;
- Rewrite (Rplus_assoc (Ropp R1) r (Ropp r)) in H2;
- Rewrite (Rplus_Ropp_r r) in H2;Elim (Rplus_ne (Ropp R1));Intros a b;
- Rewrite a in H2;Clear a b;Auto with zarith real.  
-Qed.
-
-(**********)
-Lemma Int_part_INR:(n : nat)  (Int_part (INR n)) = (inject_nat n).
-Intros n; Unfold Int_part.
-Cut (up (INR n)) = (Zplus (inject_nat n) (inject_nat (1))).
-Intros H'; Rewrite H'; Simpl; Ring.
-Apply sym_equal; Apply tech_up; Auto.
-Replace (Zplus (inject_nat n) (inject_nat (1))) with (INZ (S n)).
-Repeat Rewrite <- INR_IZR_INZ.
-Apply lt_INR; Auto.
-Rewrite Zplus_sym; Rewrite <- inj_plus; Simpl; Auto.
-Rewrite plus_IZR; Simpl; Auto with real.
-Repeat Rewrite <- INR_IZR_INZ; Auto with real.
-Qed.
-
-(**********)
-Lemma fp_nat:(r:R)(frac_part r)==R0->(Ex [c:Z](r==(IZR c))).
-Unfold frac_part;Intros;Split with (Int_part r);Apply Rminus_eq; Auto with zarith real.
-Qed.
-
-(**********)
-Lemma R0_fp_O:(r:R)~R0==(frac_part r)->~R0==r.
-Red;Intros;Rewrite <- H0 in H;Generalize fp_R0;Intro;Auto with zarith real.
-Qed.
-
-(**********)
-Lemma Rminus_Int_part1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))->
-  (Int_part (Rminus r1 r2))=(Zminus (Int_part r1) (Int_part r2)).
-Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;
- Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
- Generalize (Rle_Ropp R0 (frac_part r2) H4);Intro;Clear H4;
- Rewrite (Ropp_O) in H0;
- Generalize (Rle_sym2 (Ropp (frac_part r2)) R0 H0);Intro;Clear H0;
- Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
- Generalize (Rlt_Ropp (frac_part r2) R1 H1);Intro;Clear H1;
- Unfold Rgt in H2;
- Generalize (sum_inequa_Rle_lt R0 (frac_part r1) R1 (Ropp R1)
-   (Ropp (frac_part r2)) R0 H0 H3 H2 H4);Intro;Elim H1;Intros;
- Clear H1;Elim (Rplus_ne R1);Intros a b;Rewrite a in H6;Clear a b H5;
- Generalize (Rge_minus (frac_part r1) (frac_part r2) H);Intro;Clear H;
- Fold (Rminus (frac_part r1) (frac_part r2)) in H6;
- Generalize (Rle_sym2 R0 (Rminus (frac_part r1) (frac_part r2)) H1);
- Intro;Clear H1 H3 H4 H0 H2;Unfold frac_part in H6 H;
- Unfold Rminus in H6 H;
- Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H;
- Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus (Ropp r2) (IZR (Int_part r2)))) in H;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
-  (IZR (Int_part r2))) in H;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H;
- Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
-  (IZR (Int_part r2))) in H;
- Rewrite <-(Rplus_assoc r1 (Ropp r2) 
-  (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H;
- Fold (Rminus r1 r2) in H;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) 
- in H;Generalize (Rle_compatibility 
-  (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R0 
-  (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) H);Intro;
- Clear H;Rewrite (Rplus_sym (Rminus r1 r2)
-  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H0;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H0;
- Unfold Rminus in H0;Fold (Rminus r1 r2) in H0;
- Rewrite (Rplus_assoc (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))) 
-  (Rplus (IZR (Int_part r2)) (Ropp (IZR (Int_part r1))))) in H0;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r2))) (IZR (Int_part r2))
-  (Ropp (IZR (Int_part r1)))) in H0;Rewrite (Rplus_Ropp_l (IZR (Int_part r2))) in 
- H0;Elim (Rplus_ne (Ropp (IZR (Int_part r1))));Intros a b;Rewrite b in H0;
- Clear a b;
- Elim (Rplus_ne (Rplus (IZR (Int_part r1)) (Ropp (IZR (Int_part r2)))));
- Intros a b;Rewrite a in H0;Clear a b;Rewrite (Rplus_Ropp_r (IZR (Int_part r1))) 
- in H0;Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H0;
- Clear a b;Fold (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
- Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H6;
- Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H6;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus (Ropp r2) (IZR (Int_part r2)))) in H6;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
-  (IZR (Int_part r2))) in H6;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H6;
- Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
-  (IZR (Int_part r2))) in H6;
- Rewrite <-(Rplus_assoc r1 (Ropp r2) 
-  (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H6;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H6;
- Fold (Rminus r1 r2) in H6;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) 
- in H6;Generalize (Rlt_compatibility 
-   (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) 
-   (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) R1 H6);
- Intro;Clear H6;
- Rewrite (Rplus_sym (Rminus r1 r2)
-  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H;
- Rewrite <-(Ropp_distr2 (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- Rewrite (Rplus_Ropp_r (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H;
- Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H;Clear a b;
- Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
- Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
- Cut R1==(IZR `1`);Auto with zarith real.
-Intro;Rewrite H1 in H;Clear H1;
- Rewrite <-(plus_IZR `(Int_part r1)-(Int_part r2)` `1`) in H;
- Generalize (up_tech  (Rminus r1 r2) `(Int_part r1)-(Int_part r2)`
-  H0 H);Intros;Clear H H0;Unfold 1 Int_part;Omega.
-Qed.
-
-(**********)
-Lemma Rminus_Int_part2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))->
-  (Int_part (Rminus r1 r2))=(Zminus (Zminus (Int_part r1) (Int_part r2)) `1`).
-Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;
- Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
- Generalize (Rle_Ropp R0 (frac_part r2) H4);Intro;Clear H4;
- Rewrite (Ropp_O) in H0;
- Generalize (Rle_sym2 (Ropp (frac_part r2)) R0 H0);Intro;Clear H0;
- Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
- Generalize (Rlt_Ropp (frac_part r2) R1 H1);Intro;Clear H1;
- Unfold Rgt in H2;
- Generalize (sum_inequa_Rle_lt R0 (frac_part r1) R1 (Ropp R1)
-   (Ropp (frac_part r2)) R0 H0 H3 H2 H4);Intro;Elim H1;Intros;
- Clear H1;Elim (Rplus_ne (Ropp R1));Intros a b;Rewrite b in H5;
- Clear a b H6;Generalize (Rlt_minus (frac_part r1) (frac_part r2) H);
- Intro;Clear H;Fold (Rminus (frac_part r1) (frac_part r2)) in H5;
- Clear H3 H4 H0 H2;Unfold frac_part in H5 H1;
- Unfold Rminus in H5 H1;
- Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H5;
- Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H5;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus (Ropp r2) (IZR (Int_part r2)))) in H5;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
-  (IZR (Int_part r2))) in H5;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H5;
- Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
-  (IZR (Int_part r2))) in H5;
- Rewrite <-(Rplus_assoc r1 (Ropp r2) 
-  (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H5;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H5;
- Fold (Rminus r1 r2) in H5;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) 
- in H5;Generalize (Rlt_compatibility 
-  (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) (Ropp R1) 
-  (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) H5);
- Intro;Clear H5;Rewrite (Rplus_sym (Rminus r1 r2)
-  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H;
- Unfold Rminus in H;Fold (Rminus r1 r2) in H;
- Rewrite (Rplus_assoc (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))) 
-  (Rplus (IZR (Int_part r2)) (Ropp (IZR (Int_part r1))))) in H;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r2))) (IZR (Int_part r2))
-  (Ropp (IZR (Int_part r1)))) in H;Rewrite (Rplus_Ropp_l (IZR (Int_part r2))) in 
- H;Elim (Rplus_ne (Ropp (IZR (Int_part r1))));Intros a b;Rewrite b in H;
- Clear a b;Rewrite (Rplus_Ropp_r (IZR (Int_part r1))) in H;
- Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H;
- Clear a b;Fold (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- Fold (Rminus (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R1) in H;
- Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H1;
- Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus (Ropp r2) (IZR (Int_part r2)))) in H1;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
-  (IZR (Int_part r2))) in H1;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H1;
- Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
-  (IZR (Int_part r2))) in H1;
- Rewrite <-(Rplus_assoc r1 (Ropp r2) 
-  (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H1;
- Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H1;
- Fold (Rminus r1 r2) in H1;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) 
- in H1;Generalize (Rlt_compatibility 
-   (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) 
-   (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) R0 H1);
- Intro;Clear H1;
- Rewrite (Rplus_sym (Rminus r1 r2)
-  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H0;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H0;
- Rewrite <-(Ropp_distr2 (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
- Rewrite (Rplus_Ropp_r (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
- Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H0;Clear a b;
- Rewrite <-(Rplus_Ropp_l R1) in H0;
- Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Ropp R1) R1) in H0;
- Fold (Rminus (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R1) in H0;
- Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
- Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
- Cut R1==(IZR `1`);Auto with zarith real.
-Intro;Rewrite H1 in H;Rewrite H1 in H0;Clear H1;
- Rewrite (Z_R_minus `(Int_part r1)-(Int_part r2)` `1`) in H;
- Rewrite (Z_R_minus `(Int_part r1)-(Int_part r2)` `1`) in H0;
- Rewrite <-(plus_IZR `(Int_part r1)-(Int_part r2)-1` `1`) in H0;
- Generalize (Rlt_le (IZR `(Int_part r1)-(Int_part r2)-1`) (Rminus r1 r2) H);
- Intro;Clear H;
- Generalize (up_tech  (Rminus r1 r2) `(Int_part r1)-(Int_part r2)-1`
-  H1 H0);Intros;Clear H0 H1;Unfold 1 Int_part;Omega.
-Qed.
-
-(**********)
-Lemma Rminus_fp1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))->
-  (frac_part (Rminus r1 r2))==(Rminus (frac_part r1) (frac_part r2)).
-Intros;Unfold frac_part;
- Generalize (Rminus_Int_part1 r1 r2 H);Intro;Rewrite -> H0;
- Rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));Unfold Rminus;
- Rewrite -> (Ropp_distr1 (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))));
- Rewrite -> (Ropp_distr1 r2 (Ropp (IZR (Int_part r2))));
- Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));
- Rewrite -> (Rplus_assoc r1 (Ropp r2)
-             (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))));
- Rewrite -> (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
-             (Rplus (Ropp r2) (IZR (Int_part r2))));
- Rewrite <- (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
-             (IZR (Int_part r2)));
- Rewrite <- (Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
-             (IZR (Int_part r2)));
- Rewrite -> (Rplus_sym (Ropp r2) (Ropp (IZR (Int_part r1))));Auto with zarith real.
-Qed.
-
-(**********)
-Lemma Rminus_fp2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))->
-  (frac_part (Rminus r1 r2))==
-  (Rplus (Rminus (frac_part r1) (frac_part r2)) R1).
-Intros;Unfold frac_part;Generalize (Rminus_Int_part2 r1 r2 H);Intro;
- Rewrite -> H0;
- Rewrite <- (Z_R_minus (Zminus (Int_part r1) (Int_part r2)) `1`);
- Rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));Unfold Rminus;
- Rewrite -> (Ropp_distr1 (Rplus (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))))
-             (Ropp (IZR `1`)));
- Rewrite -> (Ropp_distr1 r2 (Ropp (IZR (Int_part r2))));
- Rewrite -> (Ropp_Ropp (IZR `1`));
- Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));
- Rewrite -> (Ropp_distr1 (IZR (Int_part r1)));
- Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));Simpl;
- Rewrite <- (Rplus_assoc (Rplus r1 (Ropp r2))
-             (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) R1);
- Rewrite -> (Rplus_assoc r1 (Ropp r2)
-             (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))));
- Rewrite -> (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
-             (Rplus (Ropp r2) (IZR (Int_part r2)))); 
- Rewrite <- (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
-             (IZR (Int_part r2)));
- Rewrite <- (Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
-             (IZR (Int_part r2)));
- Rewrite -> (Rplus_sym (Ropp r2) (Ropp (IZR (Int_part r1))));Auto with zarith real.
-Qed.
-
-(**********)
-Lemma plus_Int_part1:(r1,r2:R)(Rge (Rplus (frac_part r1) (frac_part r2)) R1)->
-  (Int_part (Rplus r1 r2))=(Zplus (Zplus (Int_part r1) (Int_part r2)) `1`).
-Intros;
- Generalize (Rle_sym2 R1 (Rplus (frac_part r1) (frac_part r2)) H);
- Intro;Clear H;Elim (base_fp r1);Elim (base_fp r2);Intros;Clear H H2;
- Generalize (Rlt_compatibility (frac_part r2) (frac_part r1) R1 H3);
- Intro;Clear H3;
- Generalize (Rlt_compatibility R1 (frac_part r2) R1 H1);Intro;Clear H1;
- Rewrite (Rplus_sym R1 (frac_part r2)) in H2;
- Generalize (Rlt_trans (Rplus (frac_part r2) (frac_part r1))
-  (Rplus (frac_part r2) R1) (Rplus R1 R1) H H2);Intro;Clear H H2;
- Rewrite (Rplus_sym (frac_part r2) (frac_part r1)) in H1;
- Unfold frac_part in H0 H1;Unfold Rminus in H0 H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus r2 (Ropp (IZR (Int_part r2))))) in H1;
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H1;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
-  r2) in H1;
- Rewrite (Rplus_sym 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H1;
- Rewrite <-(Rplus_assoc r1 r2 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H1;
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus r2 (Ropp (IZR (Int_part r2))))) in H0;
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H0;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
-  r2) in H0;
- Rewrite (Rplus_sym 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H0;
- Rewrite <-(Rplus_assoc r1 r2 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H0;
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
- Generalize (Rle_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  R1 (Rplus (Rplus r1 r2)
-           (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) H0);Intro;
- Clear H0;
- Generalize (Rlt_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Rplus (Rplus r1 r2)
-   (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) (Rplus R1 R1) H1);
- Intro;Clear H1;
- Rewrite (Rplus_sym (Rplus r1 r2) 
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H;
- Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H;
- Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H;Clear a b;
- Rewrite (Rplus_sym (Rplus r1 r2) 
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H0;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H0;
- Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
- Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H0;Clear a b;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) R1 R1) in 
- H0;Cut R1==(IZR `1`);Auto with zarith real.
-Intro;Rewrite H1 in H0;Rewrite H1 in H;Clear H1;
- Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H; 
- Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H0;
- Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H;
- Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H0;
- Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)+1` `1`) in H0;
- Generalize (up_tech (Rplus r1 r2) `(Int_part r1)+(Int_part r2)+1` H H0);Intro;
- Clear H H0;Unfold 1 Int_part;Omega.
-Qed.
-
-(**********)
-Lemma plus_Int_part2:(r1,r2:R)(Rlt (Rplus (frac_part r1) (frac_part r2)) R1)->
-  (Int_part (Rplus r1 r2))=(Zplus (Int_part r1) (Int_part r2)).
-Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;Clear H1 H3;
- Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
- Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
- Generalize (Rle_compatibility (frac_part r1) R0 (frac_part r2) H1);
- Intro;Clear H1;Elim (Rplus_ne (frac_part r1));Intros a b;
- Rewrite a in H2;Clear a b;Generalize (Rle_trans R0 (frac_part r1)
-  (Rplus (frac_part r1) (frac_part r2)) H0 H2);Intro;Clear H0 H2;
- Unfold frac_part in H H1;Unfold Rminus in H H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus r2 (Ropp (IZR (Int_part r2))))) in H1;
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H1;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
-  r2) in H1;
- Rewrite (Rplus_sym 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H1;
- Rewrite <-(Rplus_assoc r1 r2 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H1;
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus r2 (Ropp (IZR (Int_part r2))))) in H;
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H;
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
-  r2) in H;
- Rewrite (Rplus_sym 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H;
- Rewrite <-(Rplus_assoc r1 r2 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H;
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- Generalize (Rle_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  R0 (Rplus (Rplus r1 r2)
-           (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) H1);Intro;
- Clear H1;
- Generalize (Rlt_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Rplus (Rplus r1 r2)
-   (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) R1 H);
- Intro;Clear H;
- Rewrite (Rplus_sym (Rplus r1 r2) 
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H1;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H1;
- Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H1;
- Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H1;Clear a b;
- Rewrite (Rplus_sym (Rplus r1 r2) 
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H0;
- Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H0;
- Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
- Elim (Rplus_ne (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))));Intros a b;
- Rewrite a in H0;Clear a b;Elim (Rplus_ne (Rplus r1 r2));Intros a b;
- Rewrite b in H0;Clear a b;Cut R1==(IZR `1`);Auto with zarith real.
-Intro;Rewrite H in H1;Clear H;
- Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H0;
- Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H1;
- Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H1;
- Generalize (up_tech (Rplus r1 r2) `(Int_part r1)+(Int_part r2)` H0 H1);Intro;
- Clear H0 H1;Unfold 1 Int_part;Omega.
-Qed.
-
-(**********)
-Lemma plus_frac_part1:(r1,r2:R)
-  (Rge (Rplus (frac_part r1) (frac_part r2)) R1)->
-                (frac_part (Rplus r1 r2))==
-                (Rminus (Rplus (frac_part r1) (frac_part r2)) R1).
-Intros;Unfold frac_part;
- Generalize (plus_Int_part1 r1 r2 H);Intro;Rewrite H0;
- Rewrite (plus_IZR `(Int_part r1)+(Int_part r2)` `1`);
- Rewrite (plus_IZR (Int_part r1) (Int_part r2));Simpl;Unfold 3 4 Rminus;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus r2 (Ropp (IZR (Int_part r2)))));
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2))));
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
-   r2);
- Rewrite (Rplus_sym 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2);
- Rewrite <-(Rplus_assoc r1 r2 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))));
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2)));
- Unfold Rminus;
- Rewrite (Rplus_assoc (Rplus r1 r2) 
-  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))
-  (Ropp R1));
- Rewrite <-(Ropp_distr1 (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) R1);
- Trivial with zarith real.
-Qed.
-
-(**********)
-Lemma plus_frac_part2:(r1,r2:R)
-  (Rlt (Rplus (frac_part r1) (frac_part r2)) R1)->
-(frac_part (Rplus r1 r2))==(Rplus (frac_part r1) (frac_part r2)).
-Intros;Unfold frac_part;
- Generalize (plus_Int_part2 r1 r2 H);Intro;Rewrite H0;
- Rewrite (plus_IZR (Int_part r1) (Int_part r2));Unfold 2 3 Rminus;
- Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
-  (Rplus r2 (Ropp (IZR (Int_part r2)))));
- Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2))));
- Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
-  r2);
- Rewrite (Rplus_sym 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2);
- Rewrite <-(Rplus_assoc r1 r2 
-  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))));
- Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2)));Unfold Rminus;
- Trivial with zarith real.
-Qed.
diff --git a/theories7/Reals/R_sqr.v b/theories7/Reals/R_sqr.v
deleted file mode 100644
index fc01a164..00000000
--- a/theories7/Reals/R_sqr.v
+++ /dev/null
@@ -1,232 +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: R_sqr.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rbasic_fun.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(****************************************************)
-(* Rsqr : some results                              *)
-(****************************************************)
-
-Tactic Definition SqRing := Unfold Rsqr; Ring.
-
-Lemma Rsqr_neg : (x:R) ``(Rsqr x)==(Rsqr (-x))``.
-Intros; SqRing.
-Qed.
-
-Lemma Rsqr_times : (x,y:R) ``(Rsqr (x*y))==(Rsqr x)*(Rsqr y)``.
-Intros; SqRing.
-Qed.
-
-Lemma Rsqr_plus : (x,y:R) ``(Rsqr (x+y))==(Rsqr x)+(Rsqr y)+2*x*y``.
-Intros; SqRing.
-Qed.
-
-Lemma Rsqr_minus : (x,y:R) ``(Rsqr (x-y))==(Rsqr x)+(Rsqr y)-2*x*y``.
-Intros; SqRing.
-Qed.
-
-Lemma Rsqr_neg_minus : (x,y:R) ``(Rsqr (x-y))==(Rsqr (y-x))``.
-Intros; SqRing.
-Qed.
-
-Lemma Rsqr_1 : ``(Rsqr 1)==1``.
-SqRing.
-Qed.
-
-Lemma Rsqr_gt_0_0 : (x:R) ``0<(Rsqr x)`` -> ~``x==0``.
-Intros; Red; Intro; Rewrite H0 in H; Rewrite Rsqr_O in H; Elim (Rlt_antirefl ``0`` H).
-Qed.
-
-Lemma Rsqr_pos_lt : (x:R) ~(x==R0)->``0<(Rsqr x)``.
-Intros; Case (total_order R0 x); Intro; [Unfold Rsqr; Apply Rmult_lt_pos; Assumption | Elim H0; Intro; [Elim H; Symmetry; Exact H1 | Rewrite Rsqr_neg; Generalize (Rlt_Ropp x ``0`` H1); Rewrite Ropp_O; Intro; Unfold Rsqr; Apply Rmult_lt_pos; Assumption]].
-Qed.
-
-Lemma Rsqr_div : (x,y:R) ~``y==0`` -> ``(Rsqr (x/y))==(Rsqr x)/(Rsqr y)``.
-Intros; Unfold Rsqr.
-Unfold Rdiv.
-Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc.
-Apply Rmult_mult_r.
-Pattern 2 x; Rewrite Rmult_sym.
-Repeat Rewrite Rmult_assoc.
-Apply Rmult_mult_r.
-Reflexivity.
-Assumption.
-Assumption.
-Qed.
-
-Lemma Rsqr_eq_0 : (x:R) ``(Rsqr x)==0`` -> ``x==0``.
-Unfold Rsqr; Intros; Generalize (without_div_Od x x H); Intro; Elim H0; Intro ; Assumption.
-Qed.
-
-Lemma Rsqr_minus_plus : (a,b:R) ``(a-b)*(a+b)==(Rsqr a)-(Rsqr b)``.
-Intros; SqRing.
-Qed.
-
-Lemma Rsqr_plus_minus : (a,b:R) ``(a+b)*(a-b)==(Rsqr a)-(Rsqr b)``.
-Intros; SqRing.
-Qed.
-
-Lemma Rsqr_incr_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``0<=x`` -> ``0<=y`` -> ``x<=y``.
-Intros; Case (total_order_Rle x y); Intro; [Assumption | Cut ``y<x``; [Intro; Unfold Rsqr in H; Generalize (Rmult_lt2 y x y x H1 H1 H2 H2); Intro; Generalize (Rle_lt_trans ``x*x`` ``y*y`` ``x*x`` H H3); Intro; Elim (Rlt_antirefl ``x*x`` H4) | Auto with real]].
-Qed.
-
-Lemma Rsqr_incr_0_var : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``0<=y`` -> ``x<=y``.
-Intros; Case (total_order_Rle x y); Intro; [Assumption | Cut ``y<x``; [Intro; Unfold Rsqr in H; Generalize (Rmult_lt2 y x y x H0 H0 H1 H1); Intro; Generalize (Rle_lt_trans ``x*x`` ``y*y`` ``x*x`` H H2); Intro; Elim (Rlt_antirefl ``x*x`` H3) | Auto with real]].
-Qed.
-
-Lemma Rsqr_incr_1 : (x,y:R) ``x<=y``->``0<=x``->``0<= y``->``(Rsqr x)<=(Rsqr y)``.
-Intros; Unfold Rsqr; Apply Rle_Rmult_comp; Assumption.
-Qed.
-
-Lemma Rsqr_incrst_0 : (x,y:R) ``(Rsqr x)<(Rsqr y)``->``0<=x``->``0<=y``-> ``x<y``.
-Intros; Case (total_order x y); Intro; [Assumption | Elim H2; Intro; [Rewrite H3 in H; Elim (Rlt_antirefl (Rsqr y) H) | Generalize (Rmult_lt2 y x y x H1 H1 H3 H3); Intro; Unfold Rsqr in H; Generalize (Rlt_trans ``x*x`` ``y*y`` ``x*x`` H H4); Intro; Elim (Rlt_antirefl ``x*x`` H5)]].
-Qed.
-
-Lemma Rsqr_incrst_1 : (x,y:R) ``x<y``->``0<=x``->``0<=y``->``(Rsqr x)<(Rsqr y)``.
-Intros; Unfold Rsqr; Apply Rmult_lt2; Assumption.
-Qed.
-
-Lemma Rsqr_neg_pos_le_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)``->``0<=y``->``-y<=x``.
-Intros; Case (case_Rabsolu x); Intro.
-Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Rewrite (Rsqr_neg x) in H; Generalize (Rsqr_incr_0 (Ropp x) y H H2 H0); Intro; Rewrite <- (Ropp_Ropp x); Apply Rge_Ropp; Apply Rle_sym1; Assumption.
-Apply Rle_trans with ``0``; [Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Assumption | Apply Rle_sym2; Assumption].
-Qed.
-
-Lemma Rsqr_neg_pos_le_1 : (x,y:R) ``(-y)<=x`` -> ``x<=y`` -> ``0<=y`` -> ``(Rsqr x)<=(Rsqr y)``.
-Intros; Case (case_Rabsolu x); Intro.
-Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H2); Intro; Generalize (Rle_Ropp ``-y`` x H); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-x`` y H4); Intro; Rewrite (Rsqr_neg x); Apply Rsqr_incr_1; Assumption.
-Generalize (Rle_sym2 ``0`` x r); Intro; Apply Rsqr_incr_1; Assumption.
-Qed.
-
-Lemma neg_pos_Rsqr_le : (x,y:R) ``(-y)<=x``->``x<=y``->``(Rsqr x)<=(Rsqr y)``.
-Intros; Case (case_Rabsolu x); Intro.
-Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rle_Ropp ``-y`` x H); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-x`` y H2); Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Generalize (Rle_trans ``0`` ``-x`` y H4 H3); Intro; Rewrite (Rsqr_neg x); Apply Rsqr_incr_1; Assumption.
-Generalize (Rle_sym2 ``0`` x r); Intro; Generalize (Rle_trans ``0`` x y H1 H0); Intro; Apply Rsqr_incr_1; Assumption.
-Qed.
-
-Lemma Rsqr_abs : (x:R) ``(Rsqr x)==(Rsqr (Rabsolu x))``.
-Intro; Unfold Rabsolu; Case (case_Rabsolu x); Intro; [Apply Rsqr_neg | Reflexivity].
-Qed.
-
-Lemma Rsqr_le_abs_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``(Rabsolu x)<=(Rabsolu y)``.
-Intros; Apply Rsqr_incr_0; Repeat Rewrite <- Rsqr_abs; [Assumption | Apply Rabsolu_pos | Apply Rabsolu_pos].
-Qed.
-
-Lemma Rsqr_le_abs_1 : (x,y:R) ``(Rabsolu x)<=(Rabsolu y)`` -> ``(Rsqr x)<=(Rsqr y)``.
-Intros; Rewrite (Rsqr_abs x); Rewrite (Rsqr_abs y); Apply (Rsqr_incr_1 (Rabsolu x) (Rabsolu y)  H (Rabsolu_pos x) (Rabsolu_pos y)).
-Qed.
-
-Lemma Rsqr_lt_abs_0 : (x,y:R) ``(Rsqr x)<(Rsqr y)`` -> ``(Rabsolu x)<(Rabsolu y)``.
-Intros; Apply Rsqr_incrst_0; Repeat Rewrite <- Rsqr_abs; [Assumption | Apply Rabsolu_pos | Apply Rabsolu_pos].
-Qed.
-
-Lemma Rsqr_lt_abs_1 : (x,y:R) ``(Rabsolu x)<(Rabsolu y)`` -> ``(Rsqr x)<(Rsqr y)``.
-Intros; Rewrite (Rsqr_abs x); Rewrite (Rsqr_abs y); Apply (Rsqr_incrst_1 (Rabsolu x) (Rabsolu y)  H (Rabsolu_pos x) (Rabsolu_pos y)).
-Qed.
-
-Lemma Rsqr_inj : (x,y:R) ``0<=x`` -> ``0<=y`` -> (Rsqr x)==(Rsqr y) -> x==y.
-Intros; Generalize (Rle_le_eq (Rsqr x) (Rsqr y)); Intro; Elim H2; Intros _ H3; Generalize (H3 H1); Intro; Elim H4; Intros; Apply Rle_antisym; Apply Rsqr_incr_0; Assumption.
-Qed.
-
-Lemma Rsqr_eq_abs_0 : (x,y:R) (Rsqr x)==(Rsqr y) -> (Rabsolu x)==(Rabsolu y).
-Intros; Unfold Rabsolu; Case (case_Rabsolu x); Case (case_Rabsolu y); Intros.
-Rewrite -> (Rsqr_neg x) in H; Rewrite -> (Rsqr_neg y) in H; Generalize (Rlt_Ropp y ``0`` r); Generalize (Rlt_Ropp x ``0`` r0); Rewrite Ropp_O; Intros; Generalize (Rlt_le ``0`` ``-x`` H0); Generalize (Rlt_le ``0`` ``-y`` H1); Intros; Apply Rsqr_inj; Assumption.
-Rewrite -> (Rsqr_neg x) in H; Generalize (Rle_sym2 ``0`` y r); Intro; Generalize (Rlt_Ropp x ``0`` r0); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Apply Rsqr_inj; Assumption.
-Rewrite -> (Rsqr_neg y) in H; Generalize (Rle_sym2 ``0`` x r0); Intro; Generalize (Rlt_Ropp y ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-y`` H1); Intro; Apply Rsqr_inj; Assumption.
-Generalize (Rle_sym2 ``0`` x r0); Generalize (Rle_sym2 ``0`` y r); Intros; Apply Rsqr_inj; Assumption.
-Qed.
-
-Lemma Rsqr_eq_asb_1 : (x,y:R) (Rabsolu x)==(Rabsolu y) -> (Rsqr x)==(Rsqr y).
-Intros; Cut ``(Rsqr (Rabsolu x))==(Rsqr (Rabsolu y))``.
-Intro; Repeat Rewrite <- Rsqr_abs in H0; Assumption.
-Rewrite H; Reflexivity.
-Qed.
-
-Lemma triangle_rectangle : (x,y,z:R) ``0<=z``->``(Rsqr x)+(Rsqr y)<=(Rsqr z)``->``-z<=x<=z`` /\``-z<=y<=z``.
-Intros; Generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H0); Rewrite Rplus_sym in H0; Generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H0); Intros; Split; [Split; [Apply Rsqr_neg_pos_le_0; Assumption | Apply Rsqr_incr_0_var; Assumption] | Split; [Apply Rsqr_neg_pos_le_0; Assumption | Apply Rsqr_incr_0_var; Assumption]].
-Qed.
-
-Lemma triangle_rectangle_lt : (x,y,z:R) ``(Rsqr x)+(Rsqr y)<(Rsqr z)`` -> ``(Rabsolu x)<(Rabsolu z)``/\``(Rabsolu y)<(Rabsolu z)``.
-Intros; Split; [Generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H); Intro; Apply Rsqr_lt_abs_0; Assumption | Rewrite Rplus_sym in H; Generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H); Intro; Apply Rsqr_lt_abs_0; Assumption].
-Qed.
-
-Lemma triangle_rectangle_le : (x,y,z:R) ``(Rsqr x)+(Rsqr y)<=(Rsqr z)`` -> ``(Rabsolu x)<=(Rabsolu z)``/\``(Rabsolu y)<=(Rabsolu z)``.
-Intros; Split; [Generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H); Intro; Apply Rsqr_le_abs_0; Assumption | Rewrite Rplus_sym in H; Generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H); Intro; Apply Rsqr_le_abs_0; Assumption].
-Qed.
-
-Lemma Rsqr_inv : (x:R) ~``x==0`` -> ``(Rsqr (/x))==/(Rsqr x)``.
-Intros; Unfold Rsqr.
-Rewrite Rinv_Rmult; Try Reflexivity Orelse Assumption.
-Qed.
-
-Lemma canonical_Rsqr : (a:nonzeroreal;b,c,x:R) ``a*(Rsqr x)+b*x+c == a* (Rsqr (x+b/(2*a))) + (4*a*c - (Rsqr b))/(4*a)``.
-Intros.
-Rewrite Rsqr_plus.
-Repeat Rewrite Rmult_Rplus_distr.
-Repeat Rewrite Rplus_assoc.
-Apply Rplus_plus_r.
-Unfold Rdiv Rminus.
-Replace ``2*1+2*1`` with ``4``; [Idtac | Ring].
-Rewrite (Rmult_Rplus_distrl ``4*a*c`` ``-(Rsqr b)`` ``/(4*a)``).
-Rewrite Rsqr_times.
-Repeat Rewrite Rinv_Rmult.
-Repeat Rewrite (Rmult_sym a).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym ``/2``).
-Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym a).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Repeat Rewrite Rplus_assoc.
-Rewrite (Rplus_sym ``(Rsqr b)*((Rsqr (/a*/2))*a)``).
-Repeat Rewrite Rplus_assoc.
-Rewrite (Rmult_sym x).
-Apply Rplus_plus_r.
-Rewrite (Rmult_sym ``/a``).
-Unfold Rsqr; Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Ring.
-Apply (cond_nonzero a).
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-Apply (cond_nonzero a).
-Qed.
-
-Lemma Rsqr_eq : (x,y:R) (Rsqr x)==(Rsqr y) -> x==y \/ x==``-y``.
-Intros; Unfold Rsqr in H; Generalize (Rplus_plus_r ``-(y*y)`` ``x*x`` ``y*y`` H); Rewrite Rplus_Ropp_l; Replace ``-(y*y)+x*x`` with ``(x-y)*(x+y)``.
-Intro; Generalize (without_div_Od ``x-y`` ``x+y`` H0); Intro; Elim H1; Intros.
-Left; Apply Rminus_eq; Assumption.
-Right; Apply Rminus_eq; Unfold Rminus; Rewrite Ropp_Ropp; Assumption.
-Ring.
-Qed.
diff --git a/theories7/Reals/R_sqrt.v b/theories7/Reals/R_sqrt.v
deleted file mode 100644
index 8c87659b..00000000
--- a/theories7/Reals/R_sqrt.v
+++ /dev/null
@@ -1,251 +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: R_sqrt.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rsqrt_def.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(* Here is a continuous extension of Rsqrt on R *)
-Definition sqrt : R->R := [x:R](Cases (case_Rabsolu x) of
-      (leftT _) => R0
-    | (rightT a) => (Rsqrt (mknonnegreal x (Rle_sym2 ? ? a))) end).
-
-Lemma sqrt_positivity : (x:R) ``0<=x`` -> ``0<=(sqrt x)``.
-Intros.
-Unfold sqrt.
-Case (case_Rabsolu x); Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? r H)).
-Apply Rsqrt_positivity.
-Qed.
-
-Lemma sqrt_sqrt : (x:R) ``0<=x`` -> ``(sqrt x)*(sqrt x)==x``.
-Intros.
-Unfold sqrt.
-Case (case_Rabsolu x); Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? r H)).
-Rewrite Rsqrt_Rsqrt; Reflexivity.
-Qed.
-
-Lemma sqrt_0 : ``(sqrt 0)==0``.
-Apply Rsqr_eq_0; Unfold Rsqr; Apply sqrt_sqrt; Right; Reflexivity. 
-Qed.
-
-Lemma sqrt_1 : ``(sqrt 1)==1``.
-Apply (Rsqr_inj (sqrt R1) R1); [Apply sqrt_positivity; Left | Left | Unfold Rsqr; Rewrite -> sqrt_sqrt; [Ring | Left]]; Apply Rlt_R0_R1.
-Qed.
-
-Lemma sqrt_eq_0 : (x:R) ``0<=x``->``(sqrt x)==0``->``x==0``.
-Intros; Cut ``(Rsqr (sqrt x))==0``.
-Intro; Unfold Rsqr in H1; Rewrite -> sqrt_sqrt in H1; Assumption.
-Rewrite H0; Apply Rsqr_O.
-Qed.
-
-Lemma sqrt_lem_0 : (x,y:R) ``0<=x``->``0<=y``->(sqrt x)==y->``y*y==x``.
-Intros; Rewrite <- H1; Apply (sqrt_sqrt x H).
-Qed.
-
-Lemma sqtr_lem_1 : (x,y:R) ``0<=x``->``0<=y``->``y*y==x``->(sqrt x)==y.
-Intros; Apply Rsqr_inj; [Apply (sqrt_positivity x H) | Assumption | Unfold Rsqr; Rewrite -> H1; Apply (sqrt_sqrt x H)].
-Qed.
-
-Lemma sqrt_def : (x:R) ``0<=x``->``(sqrt x)*(sqrt x)==x``.
-Intros; Apply (sqrt_sqrt x H).
-Qed.
-
-Lemma sqrt_square : (x:R) ``0<=x``->``(sqrt (x*x))==x``.
-Intros; Apply (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (pos_Rsqr x)) H); Unfold Rsqr; Apply (sqrt_sqrt (Rsqr x) (pos_Rsqr x)).
-Qed.
-
-Lemma sqrt_Rsqr : (x:R) ``0<=x``->``(sqrt (Rsqr x))==x``.
-Intros; Unfold Rsqr; Apply sqrt_square; Assumption.
-Qed.
-
-Lemma sqrt_Rsqr_abs : (x:R) (sqrt (Rsqr x))==(Rabsolu x).
-Intro x; Rewrite -> Rsqr_abs; Apply sqrt_Rsqr; Apply Rabsolu_pos.
-Qed.
-
-Lemma Rsqr_sqrt : (x:R) ``0<=x``->(Rsqr (sqrt x))==x.
-Intros x H1; Unfold Rsqr; Apply (sqrt_sqrt x H1).
-Qed.
-
-Lemma sqrt_times : (x,y:R) ``0<=x``->``0<=y``->``(sqrt (x*y))==(sqrt x)*(sqrt y)``.
-Intros x y H1 H2; Apply (Rsqr_inj (sqrt (Rmult x y)) (Rmult (sqrt x) (sqrt y)) (sqrt_positivity (Rmult x y) (Rmult_le_pos x y H1 H2)) (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) (sqrt_positivity y H2))); Rewrite Rsqr_times; Repeat Rewrite Rsqr_sqrt; [Ring | Assumption |Assumption | Apply (Rmult_le_pos x y H1 H2)].
-Qed.
-
-Lemma sqrt_lt_R0 : (x:R) ``0<x`` -> ``0<(sqrt x)``.
-Intros x H1; Apply Rsqr_incrst_0; [Rewrite Rsqr_O; Rewrite Rsqr_sqrt ; [Assumption | Left; Assumption] | Right; Reflexivity | Apply (sqrt_positivity x (Rlt_le R0 x H1))].
-Qed.
-
-Lemma sqrt_div : (x,y:R) ``0<=x``->``0<y``->``(sqrt (x/y))==(sqrt x)/(sqrt y)``.
-Intros x y H1 H2; Apply Rsqr_inj; [ Apply sqrt_positivity; Apply (Rmult_le_pos x (Rinv y)); [ Assumption | Generalize (Rlt_Rinv y H2); Clear H2; Intro H2; Left; Assumption] | Apply (Rmult_le_pos (sqrt x) (Rinv (sqrt y))) ; [ Apply (sqrt_positivity x H1) | Generalize (sqrt_lt_R0 y H2); Clear H2; Intro H2; Generalize (Rlt_Rinv (sqrt y) H2); Clear H2; Intro H2; Left; Assumption] | Rewrite Rsqr_div; Repeat Rewrite Rsqr_sqrt; [ Reflexivity | Left; Assumption | Assumption | Generalize (Rlt_Rinv y H2); Intro H3; Generalize (Rlt_le R0 (Rinv y) H3); Intro H4; Apply (Rmult_le_pos x (Rinv y) H1 H4) |Red; Intro H3; Generalize (Rlt_le R0 y H2); Intro H4; Generalize (sqrt_eq_0 y H4 H3); Intro H5; Rewrite H5 in H2; Elim (Rlt_antirefl R0 H2)]].
-Qed.
-
-Lemma sqrt_lt_0 : (x,y:R) ``0<=x``->``0<=y``->``(sqrt x)<(sqrt y)``->``x<y``.
-Intros x y H1 H2 H3; Generalize (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); Intro H4; Rewrite (Rsqr_sqrt x H1) in H4; Rewrite (Rsqr_sqrt y H2) in H4; Assumption.
-Qed.
-
-Lemma sqrt_lt_1 : (x,y:R) ``0<=x``->``0<=y``->``x<y``->``(sqrt x)<(sqrt y)``.
-Intros x y H1 H2 H3; Apply Rsqr_incrst_0; [Rewrite (Rsqr_sqrt x H1); Rewrite (Rsqr_sqrt y H2); Assumption | Apply (sqrt_positivity x H1) | Apply (sqrt_positivity y H2)].
-Qed.
-
-Lemma sqrt_le_0 : (x,y:R) ``0<=x``->``0<=y``->``(sqrt x)<=(sqrt y)``->``x<=y``.
-Intros x y H1 H2 H3; Generalize (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); Intro H4; Rewrite (Rsqr_sqrt x H1) in H4; Rewrite (Rsqr_sqrt y H2) in H4; Assumption.
-Qed.
-
-Lemma sqrt_le_1 : (x,y:R) ``0<=x``->``0<=y``->``x<=y``->``(sqrt x)<=(sqrt y)``.
-Intros x y H1 H2 H3; Apply Rsqr_incr_0; [ Rewrite (Rsqr_sqrt x H1); Rewrite (Rsqr_sqrt y H2); Assumption | Apply (sqrt_positivity x H1) | Apply (sqrt_positivity y H2)].
-Qed.
-
-Lemma sqrt_inj : (x,y:R) ``0<=x``->``0<=y``->(sqrt x)==(sqrt y)->x==y.
-Intros; Cut ``(Rsqr (sqrt x))==(Rsqr (sqrt y))``.
-Intro; Rewrite (Rsqr_sqrt x H) in H2; Rewrite (Rsqr_sqrt y H0) in H2; Assumption.
-Rewrite H1; Reflexivity.
-Qed.
-
-Lemma sqrt_less : (x:R)  ``0<=x``->``1<x``->``(sqrt x)<x``.
-Intros x H1 H2; Generalize (sqrt_lt_1 R1 x (Rlt_le R0 R1 (Rlt_R0_R1)) H1 H2); Intro H3; Rewrite  sqrt_1 in H3; Generalize (Rmult_ne (sqrt x)); Intro H4; Elim H4; Intros H5 H6; Rewrite <- H5; Pattern 2 x; Rewrite <- (sqrt_def x H1); Apply (Rlt_monotony (sqrt x) R1 (sqrt x) (sqrt_lt_R0 x (Rlt_trans R0 R1 x Rlt_R0_R1 H2)) H3).
-Qed.
-
-Lemma sqrt_more : (x:R) ``0<x``->``x<1``->``x<(sqrt x)``.
-Intros x H1 H2; Generalize (sqrt_lt_1 x R1 (Rlt_le R0 x H1) (Rlt_le R0 R1 (Rlt_R0_R1)) H2); Intro H3; Rewrite  sqrt_1 in H3; Generalize (Rmult_ne (sqrt x)); Intro H4; Elim H4; Intros H5 H6; Rewrite <- H5; Pattern 1 x; Rewrite <- (sqrt_def x (Rlt_le R0 x H1)); Apply (Rlt_monotony (sqrt x) (sqrt x) R1 (sqrt_lt_R0 x H1) H3).
-Qed.
-
-Lemma sqrt_cauchy : (a,b,c,d:R) ``a*c+b*d<=(sqrt ((Rsqr a)+(Rsqr b)))*(sqrt ((Rsqr c)+(Rsqr d)))``.
-Intros a b c d; Apply Rsqr_incr_0_var; [Rewrite Rsqr_times; Repeat Rewrite Rsqr_sqrt; Unfold Rsqr; [Replace ``(a*c+b*d)*(a*c+b*d)`` with ``(a*a*c*c+b*b*d*d)+(2*a*b*c*d)``; [Replace ``(a*a+b*b)*(c*c+d*d)`` with ``(a*a*c*c+b*b*d*d)+(a*a*d*d+b*b*c*c)``; [Apply Rle_compatibility; Replace ``a*a*d*d+b*b*c*c`` with ``(2*a*b*c*d)+(a*a*d*d+b*b*c*c-2*a*b*c*d)``; [Pattern 1 ``2*a*b*c*d``; Rewrite <- Rplus_Or; Apply Rle_compatibility; Replace ``a*a*d*d+b*b*c*c-2*a*b*c*d`` with (Rsqr (Rminus (Rmult a d) (Rmult b c))); [Apply pos_Rsqr | Unfold Rsqr; Ring] | Ring] | Ring] | Ring] | Apply (ge0_plus_ge0_is_ge0 (Rsqr c) (Rsqr d) (pos_Rsqr c) (pos_Rsqr d)) | Apply (ge0_plus_ge0_is_ge0 (Rsqr a) (Rsqr b) (pos_Rsqr a) (pos_Rsqr b))] | Apply Rmult_le_pos; Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr].
-Qed.
-
-(************************************************************)
-(* Resolution of [a*X^2+b*X+c=0]                            *)
-(************************************************************)
-
-Definition Delta [a:nonzeroreal;b,c:R] : R := ``(Rsqr b)-4*a*c``.
-
-Definition Delta_is_pos [a:nonzeroreal;b,c:R] : Prop := ``0<=(Delta a b c)``.
-
-Definition sol_x1 [a:nonzeroreal;b,c:R] : R := ``(-b+(sqrt (Delta a b c)))/(2*a)``.
-
-Definition sol_x2 [a:nonzeroreal;b,c:R] : R := ``(-b-(sqrt (Delta a b c)))/(2*a)``.
-
-Lemma Rsqr_sol_eq_0_1 : (a:nonzeroreal;b,c,x:R) (Delta_is_pos a b c) -> (x==(sol_x1 a b c))\/(x==(sol_x2 a b c)) -> ``a*(Rsqr x)+b*x+c==0``.
-Intros; Elim H0; Intro.
-Unfold sol_x1 in H1; Unfold Delta in H1; Rewrite H1; Unfold Rdiv; Repeat Rewrite Rsqr_times; Rewrite Rsqr_plus; Rewrite <- Rsqr_neg; Rewrite Rsqr_sqrt.
-Rewrite Rsqr_inv.
-Unfold Rsqr; Repeat Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym a).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Pattern 2 ``2``; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_Rplus_distrl ``-b`` ``(sqrt (b*b-(2*(2*(a*c)))))`` ``(/2*/a)``).
-Rewrite Rmult_Rplus_distr; Repeat Rewrite Rplus_assoc.
-Replace ``( -b*((sqrt (b*b-(2*(2*(a*c)))))*(/2*/a))+(b*( -b*(/2*/a))+(b*((sqrt (b*b-(2*(2*(a*c)))))*(/2*/a))+c)))`` with ``(b*( -b*(/2*/a)))+c``.
-Unfold Rminus; Repeat Rewrite <- Rplus_assoc.
-Replace ``b*b+b*b`` with ``2*(b*b)``.
-Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym a); Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite <- Ropp_mul2.
-Ring.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-DiscrR.
-Ring.
-Ring.
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-Apply (cond_nonzero a).
-Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Assumption.
-Unfold sol_x2 in H1; Unfold Delta in H1; Rewrite H1; Unfold Rdiv; Repeat Rewrite Rsqr_times; Rewrite Rsqr_minus; Rewrite <- Rsqr_neg; Rewrite Rsqr_sqrt.
-Rewrite Rsqr_inv.
-Unfold Rsqr; Repeat Rewrite Rinv_Rmult; Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym a); Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Unfold Rminus; Rewrite Rmult_Rplus_distrl.
-Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc; Pattern 2 ``2``; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_Rplus_distrl ``-b`` ``-(sqrt (b*b+ -(2*(2*(a*c))))) `` ``(/2*/a)``).
-Rewrite Rmult_Rplus_distr; Repeat Rewrite Rplus_assoc.
-Rewrite Ropp_mul1; Rewrite Ropp_Ropp.
-Replace ``(b*((sqrt (b*b+ -(2*(2*(a*c)))))*(/2*/a))+(b*( -b*(/2*/a))+(b*( -(sqrt (b*b+ -(2*(2*(a*c)))))*(/2*/a))+c)))`` with ``(b*( -b*(/2*/a)))+c``.
-Repeat Rewrite <- Rplus_assoc; Replace ``b*b+b*b`` with ``2*(b*b)``.
-Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym a); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite <- Ropp_mul2; Ring.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-DiscrR.
-Ring.
-Ring.
-DiscrR.
-Apply (cond_nonzero a).
-DiscrR.
-DiscrR.
-Apply (cond_nonzero a).
-Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
-Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
-Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
-Assumption.
-Qed.
-
-Lemma Rsqr_sol_eq_0_0 : (a:nonzeroreal;b,c,x:R) (Delta_is_pos a b c) -> ``a*(Rsqr x)+b*x+c==0`` -> (x==(sol_x1 a b c))\/(x==(sol_x2 a b c)).
-Intros; Rewrite (canonical_Rsqr a b c x) in H0; Rewrite Rplus_sym in H0; Generalize (Rplus_Ropp  ``(4*a*c-(Rsqr b))/(4*a)`` ``a*(Rsqr (x+b/(2*a)))`` H0); Cut ``(Rsqr b)-4*a*c==(Delta a b c)``.
-Intro; Replace ``-((4*a*c-(Rsqr b))/(4*a))`` with ``((Rsqr b)-4*a*c)/(4*a)``.
-Rewrite H1; Intro; Generalize (Rmult_mult_r ``/a`` ``a*(Rsqr (x+b/(2*a)))`` ``(Delta a b c)/(4*a)`` H2); Replace ``/a*(a*(Rsqr (x+b/(2*a))))`` with ``(Rsqr (x+b/(2*a)))``.
-Replace ``/a*(Delta a b c)/(4*a)`` with ``(Rsqr ((sqrt (Delta a b c))/(2*a)))``.
-Intro; Generalize (Rsqr_eq ``(x+b/(2*a))`` ``((sqrt (Delta a b c))/(2*a))`` H3); Intro; Elim H4; Intro.
-Left; Unfold sol_x1; Generalize (Rplus_plus_r ``-(b/(2*a))`` ``x+b/(2*a)`` ``(sqrt (Delta a b c))/(2*a)`` H5); Replace `` -(b/(2*a))+(x+b/(2*a))`` with x.
-Intro; Rewrite H6; Unfold Rdiv; Ring.
-Ring.
-Right; Unfold sol_x2; Generalize (Rplus_plus_r ``-(b/(2*a))`` ``x+b/(2*a)`` ``-((sqrt (Delta a b c))/(2*a))`` H5); Replace `` -(b/(2*a))+(x+b/(2*a))`` with x.
-Intro; Rewrite H6; Unfold Rdiv; Ring.
-Ring.
-Rewrite Rsqr_div.
-Rewrite Rsqr_sqrt.
-Unfold Rdiv.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym ``/a``).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Replace ``(2*(2*a))*a`` with ``(Rsqr (2*a))``.
-Reflexivity.
-SqRing.
-Rewrite <- Rmult_assoc; Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Apply (cond_nonzero a).
-Assumption.
-Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Symmetry; Apply Rmult_1l.
-Apply (cond_nonzero a).
-Unfold Rdiv; Rewrite <- Ropp_mul1.
-Rewrite Ropp_distr2.
-Reflexivity.
-Reflexivity.
-Qed.
diff --git a/theories7/Reals/Ranalysis.v b/theories7/Reals/Ranalysis.v
deleted file mode 100644
index d5d84f50..00000000
--- a/theories7/Reals/Ranalysis.v
+++ /dev/null
@@ -1,477 +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: Ranalysis.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rtrigo.
-Require SeqSeries.
-Require Export Ranalysis1.
-Require Export Ranalysis2.
-Require Export Ranalysis3.
-Require Export Rtopology.
-Require Export MVT.
-Require Export PSeries_reg.
-Require Export Exp_prop.
-Require Export Rtrigo_reg.
-Require Export Rsqrt_def.
-Require Export R_sqrt.
-Require Export Rtrigo_calc.
-Require Export Rgeom.
-Require Export RList.
-Require Export Sqrt_reg.
-Require Export Ranalysis4.
-Require Export Rpower.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Axiom AppVar : R.
-
-(**********)
-Recursive Tactic Definition IntroHypG trm :=
-Match trm With
-|[(plus_fct ?1 ?2)] -> 
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- | _ -> Idtac)
-|[(minus_fct ?1 ?2)] -> 
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- | _ -> Idtac)
-|[(mult_fct ?1 ?2)] ->
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- | _ -> Idtac)
-|[(div_fct ?1 ?2)] -> Let aux = ?2 In
- (Match Context With
- |[_:(x0:R)``(aux x0)<>0``|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[_:(x0:R)``(aux x0)<>0``|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(derivable ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1; IntroHypG ?2 | Try Assumption]
- |[|-(continuity ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1; IntroHypG ?2 | Try Assumption]
- | _ -> Idtac)
-|[(comp ?1 ?2)] -> 
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
- |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
- | _ -> Idtac)
-|[(opp_fct ?1)] -> 
- (Match Context With
- |[|-(derivable ?)] -> IntroHypG ?1
- |[|-(continuity ?)] -> IntroHypG ?1
- | _ -> Idtac)
-|[(inv_fct ?1)] -> Let aux = ?1 In
- (Match Context With
- |[_:(x0:R)``(aux x0)<>0``|-(derivable ?)] -> IntroHypG ?1
- |[_:(x0:R)``(aux x0)<>0``|-(continuity ?)] -> IntroHypG ?1
- |[|-(derivable ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1 | Try Assumption]
- |[|-(continuity ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1| Try Assumption]
- | _ -> Idtac)
-|[cos] -> Idtac
-|[sin] -> Idtac
-|[cosh] -> Idtac
-|[sinh] -> Idtac
-|[exp] -> Idtac
-|[Rsqr] -> Idtac
-|[sqrt] -> Idtac
-|[id] -> Idtac
-|[(fct_cte ?)] -> Idtac
-|[(pow_fct ?)] -> Idtac
-|[Rabsolu] -> Idtac
-|[?1] -> Let p = ?1 In
- (Match Context With
- |[_:(derivable p)|- ?] -> Idtac
- |[|-(derivable p)] -> Idtac
- |[|-(derivable ?)] -> Cut True -> (derivable p); [Intro HYPPD; Cut (derivable p); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- | [_:(continuity p)|- ?] -> Idtac
- |[|-(continuity p)] -> Idtac
- |[|-(continuity ?)] -> Cut True -> (continuity p); [Intro HYPPD; Cut (continuity p); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- | _ -> Idtac).
-
-(**********)
-Recursive Tactic Definition IntroHypL trm pt :=
-Match trm With
-|[(plus_fct ?1 ?2)] -> 
- (Match Context With
- |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- | _ -> Idtac)
-|[(minus_fct ?1 ?2)] -> 
- (Match Context With
- |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- | _ -> Idtac)
-|[(mult_fct ?1 ?2)] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- | _ -> Idtac)
-|[(div_fct ?1 ?2)] -> Let aux = ?2 In
- (Match Context With
- |[_:``(aux pt)<>0``|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[_:``(aux pt)<>0``|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[_:``(aux pt)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
- |[id:(x0:R)``(aux x0)<>0``|-(derivable_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
- |[id:(x0:R)``(aux x0)<>0``|-(continuity_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
- |[id:(x0:R)``(aux x0)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
- |[|-(derivable_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
- |[|-(continuity_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
- | _ -> Idtac)
-|[(comp ?1 ?2)] -> 
- (Match Context With
- |[|-(derivable_pt ? ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
- |[|-(continuity_pt ? ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
- | _ -> Idtac)
-|[(opp_fct ?1)] -> 
- (Match Context With
- |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt
- |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt
- | _ -> Idtac)
-|[(inv_fct ?1)] -> Let aux = ?1 In
- (Match Context With
- |[_:``(aux pt)<>0``|-(derivable_pt ? ?)] -> IntroHypL ?1 pt
- |[_:``(aux pt)<>0``|-(continuity_pt ? ?)] -> IntroHypL ?1 pt
- |[_:``(aux pt)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt
- |[id:(x0:R)``(aux x0)<>0``|-(derivable_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
- |[id:(x0:R)``(aux x0)<>0``|-(continuity_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
- |[id:(x0:R)``(aux x0)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
- |[|-(derivable_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt | Try Assumption]
- |[|-(continuity_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt| Try Assumption]
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt | Try Assumption]
- | _ -> Idtac)
-|[cos] -> Idtac
-|[sin] -> Idtac
-|[cosh] -> Idtac
-|[sinh] -> Idtac
-|[exp] -> Idtac
-|[Rsqr] -> Idtac
-|[id] -> Idtac
-|[(fct_cte ?)] -> Idtac
-|[(pow_fct ?)] -> Idtac
-|[sqrt] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> Cut ``0<pt``; [Intro | Try Assumption]
- |[|-(continuity_pt ? ?)] -> Cut ``0<=pt``; [Intro | Try Assumption]
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``0<pt``; [Intro | Try Assumption]
- | _ -> Idtac)
-|[Rabsolu] ->
- (Match Context With
- |[|-(derivable_pt ? ?)] -> Cut ``pt<>0``; [Intro | Try Assumption]
- | _ -> Idtac)
-|[?1] -> Let p = ?1 In
- (Match Context With
- |[_:(derivable_pt p pt)|- ?] -> Idtac
- |[|-(derivable_pt p pt)] -> Idtac
- |[|-(derivable_pt ? ?)] -> Cut True -> (derivable_pt p pt); [Intro HYPPD; Cut (derivable_pt p pt); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- |[_:(continuity_pt p pt)|- ?] -> Idtac
- |[|-(continuity_pt p pt)] -> Idtac
- |[|-(continuity_pt ? ?)] -> Cut True -> (continuity_pt p pt); [Intro HYPPD; Cut (continuity_pt p pt); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut True -> (derivable_pt p pt); [Intro HYPPD; Cut (derivable_pt p pt); [Intro; Clear HYPPD | Apply HYPPD; Clear HYPPD; Trivial] | Idtac]
- | _ -> Idtac).
- 
-(**********)
-Recursive Tactic Definition IsDiff_pt :=
-Match Context With
- (* fonctions de base *)
- [|-(derivable_pt Rsqr ?)] -> Apply derivable_pt_Rsqr
-|[|-(derivable_pt id ?1)] -> Apply (derivable_pt_id ?1)
-|[|-(derivable_pt (fct_cte ?) ?)] -> Apply derivable_pt_const
-|[|-(derivable_pt sin ?)] -> Apply derivable_pt_sin
-|[|-(derivable_pt cos ?)] -> Apply derivable_pt_cos
-|[|-(derivable_pt sinh ?)] -> Apply derivable_pt_sinh
-|[|-(derivable_pt cosh ?)] -> Apply derivable_pt_cosh
-|[|-(derivable_pt exp ?)] -> Apply derivable_pt_exp
-|[|-(derivable_pt (pow_fct ?) ?)] -> Unfold pow_fct; Apply derivable_pt_pow
-|[|-(derivable_pt sqrt ?1)] -> Apply (derivable_pt_sqrt ?1); Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
-|[|-(derivable_pt Rabsolu ?1)] -> Apply (derivable_pt_Rabsolu ?1); Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
- (* regles de differentiabilite *)
- (* PLUS *)
-|[|-(derivable_pt (plus_fct ?1 ?2) ?3)] -> Apply (derivable_pt_plus ?1 ?2 ?3); IsDiff_pt
- (* MOINS *)
-|[|-(derivable_pt (minus_fct ?1 ?2) ?3)] -> Apply (derivable_pt_minus ?1 ?2 ?3); IsDiff_pt
- (* OPPOSE *)
-|[|-(derivable_pt (opp_fct ?1) ?2)] -> Apply (derivable_pt_opp ?1 ?2); IsDiff_pt
- (* MULTIPLICATION PAR UN SCALAIRE *)
-|[|-(derivable_pt (mult_real_fct ?1 ?2) ?3)] -> Apply (derivable_pt_scal ?2 ?1 ?3); IsDiff_pt
- (* MULTIPLICATION *)
-|[|-(derivable_pt (mult_fct ?1 ?2) ?3)] -> Apply (derivable_pt_mult ?1 ?2 ?3); IsDiff_pt
-  (* DIVISION *)
- |[|-(derivable_pt (div_fct ?1 ?2) ?3)] -> Apply (derivable_pt_div ?1 ?2 ?3); [IsDiff_pt | IsDiff_pt | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp pow_fct id fct_cte]
-  (* INVERSION *)
- |[|-(derivable_pt (inv_fct ?1) ?2)] -> Apply (derivable_pt_inv ?1 ?2); [Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp pow_fct id fct_cte | IsDiff_pt]
- (* COMPOSITION *)
-|[|-(derivable_pt (comp ?1 ?2) ?3)] -> Apply (derivable_pt_comp ?2 ?1 ?3); IsDiff_pt
-|[_:(derivable_pt ?1 ?2)|-(derivable_pt ?1 ?2)] -> Assumption
-|[_:(derivable ?1) |- (derivable_pt ?1 ?2)] -> Cut (derivable ?1); [Intro HypDDPT; Apply HypDDPT | Assumption]
-|[|-True->(derivable_pt ? ?)] -> Intro HypTruE; Clear HypTruE; IsDiff_pt
-| _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
-
-(**********)
-Recursive Tactic Definition IsDiff_glob :=
-Match Context With
- (* fonctions de base *)
-  [|-(derivable Rsqr)] -> Apply derivable_Rsqr
- |[|-(derivable id)] -> Apply derivable_id
- |[|-(derivable (fct_cte ?))] -> Apply derivable_const
- |[|-(derivable sin)] -> Apply derivable_sin
- |[|-(derivable cos)] -> Apply derivable_cos
- |[|-(derivable cosh)] -> Apply derivable_cosh
- |[|-(derivable sinh)] -> Apply derivable_sinh
- |[|-(derivable exp)] -> Apply derivable_exp
- |[|-(derivable (pow_fct ?))] -> Unfold pow_fct; Apply derivable_pow
-  (* regles de differentiabilite *)
-  (* PLUS *)
- |[|-(derivable (plus_fct ?1 ?2))] -> Apply (derivable_plus ?1 ?2); IsDiff_glob
-  (* MOINS *)
- |[|-(derivable (minus_fct ?1 ?2))] -> Apply (derivable_minus ?1 ?2); IsDiff_glob
-  (* OPPOSE *)
- |[|-(derivable (opp_fct ?1))] -> Apply (derivable_opp ?1); IsDiff_glob
-  (* MULTIPLICATION PAR UN SCALAIRE *)
- |[|-(derivable (mult_real_fct ?1 ?2))] -> Apply (derivable_scal ?2 ?1); IsDiff_glob
-  (* MULTIPLICATION *)
- |[|-(derivable (mult_fct ?1 ?2))] -> Apply (derivable_mult ?1 ?2); IsDiff_glob
-  (* DIVISION *)
- |[|-(derivable (div_fct ?1 ?2))] -> Apply (derivable_div ?1 ?2); [IsDiff_glob | IsDiff_glob | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct]
-  (* INVERSION *)
- |[|-(derivable (inv_fct ?1))] -> Apply (derivable_inv ?1); [Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct | IsDiff_glob]
-  (* COMPOSITION *)
- |[|-(derivable (comp sqrt ?))] -> Unfold derivable; Intro; Try IsDiff_pt
- |[|-(derivable (comp Rabsolu ?))] -> Unfold derivable; Intro; Try IsDiff_pt
- |[|-(derivable (comp ?1 ?2))] -> Apply (derivable_comp ?2 ?1); IsDiff_glob
- |[_:(derivable ?1)|-(derivable ?1)] -> Assumption
- |[|-True->(derivable ?)] -> Intro HypTruE; Clear HypTruE; IsDiff_glob
- | _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
-
-(**********)
-Recursive Tactic Definition IsCont_pt :=
-Match Context With
- (* fonctions de base *)
- [|-(continuity_pt Rsqr ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_Rsqr
-|[|-(continuity_pt id ?1)] -> Apply derivable_continuous_pt; Apply (derivable_pt_id ?1)
-|[|-(continuity_pt (fct_cte ?) ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_const
-|[|-(continuity_pt sin ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_sin
-|[|-(continuity_pt cos ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_cos
-|[|-(continuity_pt sinh ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_sinh
-|[|-(continuity_pt cosh ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_cosh
-|[|-(continuity_pt exp ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_exp
-|[|-(continuity_pt (pow_fct ?) ?)] -> Unfold pow_fct; Apply derivable_continuous_pt; Apply derivable_pt_pow
-|[|-(continuity_pt sqrt ?1)] -> Apply continuity_pt_sqrt; Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
-|[|-(continuity_pt Rabsolu ?1)] -> Apply (continuity_Rabsolu ?1)
- (* regles de differentiabilite *)
- (* PLUS *)
-|[|-(continuity_pt (plus_fct ?1 ?2) ?3)] -> Apply (continuity_pt_plus ?1 ?2 ?3); IsCont_pt
- (* MOINS *)
-|[|-(continuity_pt (minus_fct ?1 ?2) ?3)] -> Apply (continuity_pt_minus ?1 ?2 ?3); IsCont_pt
- (* OPPOSE *)
-|[|-(continuity_pt (opp_fct ?1) ?2)] -> Apply (continuity_pt_opp ?1 ?2); IsCont_pt
- (* MULTIPLICATION PAR UN SCALAIRE *)
-|[|-(continuity_pt (mult_real_fct ?1 ?2) ?3)] -> Apply (continuity_pt_scal ?2 ?1 ?3); IsCont_pt
- (* MULTIPLICATION *)
-|[|-(continuity_pt (mult_fct ?1 ?2) ?3)] -> Apply (continuity_pt_mult ?1 ?2 ?3); IsCont_pt
-  (* DIVISION *)
- |[|-(continuity_pt (div_fct ?1 ?2) ?3)] -> Apply (continuity_pt_div ?1 ?2 ?3); [IsCont_pt | IsCont_pt | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp id fct_cte pow_fct]
-  (* INVERSION *)
- |[|-(continuity_pt (inv_fct ?1) ?2)] -> Apply (continuity_pt_inv ?1 ?2); [IsCont_pt | Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp id fct_cte pow_fct]
- (* COMPOSITION *)
-|[|-(continuity_pt (comp ?1 ?2) ?3)] -> Apply (continuity_pt_comp ?2 ?1 ?3); IsCont_pt
-|[_:(continuity_pt ?1 ?2)|-(continuity_pt ?1 ?2)] -> Assumption
-|[_:(continuity ?1) |- (continuity_pt ?1 ?2)] -> Cut (continuity ?1); [Intro HypDDPT; Apply HypDDPT | Assumption]
-|[_:(derivable_pt ?1 ?2)|-(continuity_pt ?1 ?2)] -> Apply derivable_continuous_pt; Assumption
-|[_:(derivable ?1)|-(continuity_pt ?1 ?2)] -> Cut (continuity ?1); [Intro HypDDPT; Apply HypDDPT | Apply derivable_continuous; Assumption]
-|[|-True->(continuity_pt ? ?)] -> Intro HypTruE; Clear HypTruE; IsCont_pt
-| _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
-
-(**********)
-Recursive Tactic Definition IsCont_glob :=
-Match Context With
-  (* fonctions de base *)
-  [|-(continuity Rsqr)] -> Apply derivable_continuous; Apply derivable_Rsqr
- |[|-(continuity id)] -> Apply derivable_continuous; Apply derivable_id
- |[|-(continuity (fct_cte ?))] -> Apply derivable_continuous; Apply derivable_const
- |[|-(continuity sin)] -> Apply derivable_continuous; Apply derivable_sin
- |[|-(continuity cos)] -> Apply derivable_continuous; Apply derivable_cos
- |[|-(continuity exp)] -> Apply derivable_continuous; Apply derivable_exp
- |[|-(continuity (pow_fct ?))] -> Unfold pow_fct; Apply derivable_continuous; Apply derivable_pow
- |[|-(continuity sinh)] -> Apply derivable_continuous; Apply derivable_sinh
- |[|-(continuity cosh)] -> Apply derivable_continuous; Apply derivable_cosh
- |[|-(continuity Rabsolu)] -> Apply continuity_Rabsolu
- (* regles de continuite *)
- (* PLUS *)
-|[|-(continuity (plus_fct ?1 ?2))] -> Apply (continuity_plus ?1 ?2); Try IsCont_glob Orelse Assumption
- (* MOINS *)
-|[|-(continuity (minus_fct ?1 ?2))] -> Apply (continuity_minus ?1 ?2); Try IsCont_glob Orelse Assumption
- (* OPPOSE *)
-|[|-(continuity (opp_fct ?1))] -> Apply (continuity_opp ?1); Try IsCont_glob Orelse Assumption
- (* INVERSE *)
-|[|-(continuity (inv_fct ?1))] -> Apply (continuity_inv ?1); Try IsCont_glob Orelse Assumption
- (* MULTIPLICATION PAR UN SCALAIRE *)
-|[|-(continuity (mult_real_fct ?1 ?2))] -> Apply (continuity_scal ?2 ?1); Try IsCont_glob Orelse Assumption
- (* MULTIPLICATION *)
-|[|-(continuity (mult_fct ?1 ?2))] -> Apply (continuity_mult ?1 ?2); Try IsCont_glob Orelse Assumption
-  (* DIVISION *)
- |[|-(continuity (div_fct ?1 ?2))] -> Apply (continuity_div ?1 ?2); [Try IsCont_glob Orelse Assumption | Try IsCont_glob Orelse Assumption | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte pow_fct]
-  (* COMPOSITION *)
- |[|-(continuity (comp sqrt ?))] -> Unfold continuity_pt; Intro; Try IsCont_pt
- |[|-(continuity (comp ?1 ?2))] -> Apply (continuity_comp ?2 ?1); Try IsCont_glob Orelse Assumption
- |[_:(continuity ?1)|-(continuity ?1)] -> Assumption
- |[|-True->(continuity ?)] -> Intro HypTruE; Clear HypTruE; IsCont_glob
- |[_:(derivable ?1)|-(continuity ?1)] -> Apply derivable_continuous; Assumption
- | _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
-
-(**********)
-Recursive Tactic Definition RewTerm trm :=
-Match trm With
-| [(Rplus ?1 ?2)] -> Let p1= (RewTerm ?1) And p2 = (RewTerm ?2) In 
-  (Match p1 With
-   [(fct_cte ?3)] -> 
-    (Match p2 With
-    | [(fct_cte ?4)] -> '(fct_cte (Rplus ?3 ?4))
-    | _ -> '(plus_fct p1 p2))
-  | _ -> '(plus_fct p1 p2))
-| [(Rminus ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
-  (Match p1 With
-   [(fct_cte ?3)] -> 
-    (Match p2 With
-    | [(fct_cte ?4)] -> '(fct_cte (Rminus ?3 ?4))
-    | _ -> '(minus_fct p1 p2))
-  | _ -> '(minus_fct p1 p2))
-| [(Rdiv ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
-  (Match p1 With
-   [(fct_cte ?3)] -> 
-    (Match p2 With
-    | [(fct_cte ?4)] -> '(fct_cte (Rdiv ?3 ?4))
-    | _ -> '(div_fct p1 p2))
-  | _ -> 
-    (Match p2 With
-    | [(fct_cte ?4)] -> '(mult_fct p1 (fct_cte (Rinv ?4)))
-    | _ -> '(div_fct p1 p2)))
-| [(Rmult ?1 (Rinv ?2))] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
-  (Match p1 With
-   [(fct_cte ?3)] -> 
-    (Match p2 With
-    | [(fct_cte ?4)] -> '(fct_cte (Rdiv ?3 ?4))
-    | _ -> '(div_fct p1 p2))
-  | _ -> 
-   (Match p2 With
-   | [(fct_cte ?4)] -> '(mult_fct p1 (fct_cte (Rinv ?4)))
-   | _ -> '(div_fct p1 p2)))
-| [(Rmult ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
-  (Match p1 With
-   [(fct_cte ?3)] -> 
-    (Match p2 With
-    | [(fct_cte ?4)] -> '(fct_cte (Rmult ?3 ?4))
-    | _ -> '(mult_fct p1 p2))
-  | _ -> '(mult_fct p1 p2))
-| [(Ropp ?1)] -> Let p = (RewTerm ?1) In 
-  (Match p With
-   [(fct_cte ?2)] -> '(fct_cte (Ropp ?2))
-   | _ -> '(opp_fct p))
-| [(Rinv ?1)] -> Let p = (RewTerm ?1) In 
-  (Match p With
-   [(fct_cte ?2)] -> '(fct_cte (Rinv ?2))
-   | _ -> '(inv_fct p))
-| [(?1 AppVar)] -> '?1
-| [(?1 ?2)] -> Let p = (RewTerm ?2) In 
- (Match p With
- | [(fct_cte ?3)] -> '(fct_cte (?1 ?3))
- | _ -> '(comp ?1 p))
-| [AppVar] -> 'id
-| [(pow AppVar ?1)] -> '(pow_fct ?1)
-| [(pow ?1 ?2)] -> Let p = (RewTerm ?1) In 
- (Match p With
- | [(fct_cte ?3)] -> '(fct_cte (pow_fct ?2 ?3))
- | _ -> '(comp (pow_fct ?2) p))
-| [?1]-> '(fct_cte ?1).
-
-(**********)
-Recursive Tactic Definition ConsProof trm pt :=
-Match trm With
-| [(plus_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_plus ?1 ?2 pt p1 p2)
-| [(minus_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_minus ?1 ?2 pt p1 p2)
-| [(mult_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_mult ?1 ?2 pt p1 p2)
-| [(div_fct ?1 ?2)] ->
- (Match Context With
- |[id:~((?2 pt)==R0) |- ?] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_div ?1 ?2 pt p1 p2 id)
- | _ -> 'False)
-| [(inv_fct ?1)] ->
- (Match Context With
- |[id:~((?1 pt)==R0) |- ?] -> Let p1 = (ConsProof ?1 pt) In '(derivable_pt_inv ?1 pt p1 id)
- | _ -> 'False)
-| [(comp ?1 ?2)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In Let p1 = (ConsProof ?1 pt_f1) And p2 = (ConsProof ?2 pt) In '(derivable_pt_comp ?2 ?1 pt p2 p1)
-| [(opp_fct ?1)] -> Let p1 = (ConsProof ?1 pt) In '(derivable_pt_opp ?1 pt p1)
-| [sin] -> '(derivable_pt_sin pt)
-| [cos] -> '(derivable_pt_cos pt)
-| [sinh] -> '(derivable_pt_sinh pt)
-| [cosh] -> '(derivable_pt_cosh pt)
-| [exp] -> '(derivable_pt_exp pt)
-| [id] -> '(derivable_pt_id pt)
-| [Rsqr] -> '(derivable_pt_Rsqr pt)
-| [sqrt] ->
- (Match Context With
- |[id:(Rlt R0 pt) |- ?] -> '(derivable_pt_sqrt pt id)
- | _ -> 'False)
-| [(fct_cte ?1)] -> '(derivable_pt_const ?1 pt)
-| [?1] -> Let aux = ?1 In
- (Match Context With
-    [ id : (derivable_pt aux pt) |- ?] -> 'id
-   |[ id : (derivable aux) |- ?] -> '(id pt)
-   | _ -> 'False).
-
-(**********)
-Recursive Tactic Definition SimplifyDerive trm pt :=
-Match trm With
-| [(plus_fct ?1 ?2)] -> Try Rewrite derive_pt_plus; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
-| [(minus_fct ?1 ?2)] -> Try Rewrite derive_pt_minus; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
-| [(mult_fct ?1 ?2)] -> Try Rewrite derive_pt_mult; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
-| [(div_fct ?1 ?2)] -> Try Rewrite derive_pt_div; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
-| [(comp ?1 ?2)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In Try Rewrite derive_pt_comp; SimplifyDerive ?1 pt_f1; SimplifyDerive ?2 pt
-| [(opp_fct ?1)] -> Try Rewrite derive_pt_opp; SimplifyDerive ?1 pt
-| [(inv_fct ?1)] -> Try Rewrite derive_pt_inv; SimplifyDerive ?1 pt
-| [(fct_cte ?1)] -> Try Rewrite derive_pt_const
-| [id] -> Try Rewrite derive_pt_id
-| [sin] -> Try Rewrite derive_pt_sin
-| [cos] -> Try Rewrite derive_pt_cos
-| [sinh] -> Try Rewrite derive_pt_sinh
-| [cosh] -> Try Rewrite derive_pt_cosh
-| [exp] -> Try Rewrite derive_pt_exp
-| [Rsqr] -> Try Rewrite derive_pt_Rsqr
-| [sqrt] -> Try Rewrite derive_pt_sqrt
-| [?1] -> Let aux = ?1 In
-  (Match Context With
-    [ id : (eqT ? (derive_pt aux pt ?2) ?); H : (derivable aux) |- ? ] -> Try Replace (derive_pt aux pt (H pt)) with (derive_pt aux pt ?2); [Rewrite id | Apply pr_nu]
-    |[ id : (eqT ? (derive_pt aux pt ?2) ?); H : (derivable_pt aux pt) |- ? ] -> Try Replace (derive_pt aux pt H) with (derive_pt aux pt ?2); [Rewrite id | Apply pr_nu]
-    | _ -> Idtac )
-| _ -> Idtac.
-
-(**********)
-Tactic Definition Reg :=
-Match Context With
-| [|-(derivable_pt ?1 ?2)] -> 
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In IntroHypL aux ?2; Try (Change (derivable_pt aux ?2); IsDiff_pt) Orelse IsDiff_pt
-| [|-(derivable ?1)] ->
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In IntroHypG aux; Try (Change (derivable aux); IsDiff_glob) Orelse IsDiff_glob
-| [|-(continuity ?1)] ->
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In IntroHypG aux; Try (Change (continuity aux); IsCont_glob) Orelse IsCont_glob
-| [|-(continuity_pt ?1 ?2)] ->
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In IntroHypL aux ?2; Try (Change (continuity_pt aux ?2); IsCont_pt) Orelse IsCont_pt
-| [|-(eqT ? (derive_pt ?1 ?2 ?3) ?4)] -> 
-Let trm = Eval Cbv Beta in (?1 AppVar) In
-Let aux = (RewTerm trm) In
-IntroHypL aux ?2; Let aux2 = (ConsProof aux ?2) In Try (Replace (derive_pt ?1 ?2 ?3) with (derive_pt aux ?2 aux2); [SimplifyDerive aux ?2; Try Unfold plus_fct minus_fct mult_fct div_fct id fct_cte inv_fct opp_fct; Try Ring | Try Apply pr_nu]) Orelse IsDiff_pt.
diff --git a/theories7/Reals/Ranalysis1.v b/theories7/Reals/Ranalysis1.v
deleted file mode 100644
index 8cb4c358..00000000
--- a/theories7/Reals/Ranalysis1.v
+++ /dev/null
@@ -1,1046 +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: Ranalysis1.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Export Rlimit.
-Require Export Rderiv.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-Implicit Variable Type f:R->R.
-
-(****************************************************)
-(**           Basic operations on functions         *)
-(****************************************************)
-Definition plus_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)+(f2 x)``.
-Definition opp_fct [f:R->R] : R->R := [x:R] ``-(f x)``.
-Definition mult_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)*(f2 x)``.
-Definition mult_real_fct [a:R;f:R->R] : R->R := [x:R] ``a*(f x)``.
-Definition minus_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)-(f2 x)``.
-Definition div_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)/(f2 x)``.
-Definition div_real_fct [a:R;f:R->R] : R->R := [x:R] ``a/(f x)``.
-Definition comp [f1,f2:R->R] : R->R := [x:R] ``(f1 (f2 x))``.
-Definition inv_fct [f:R->R] : R->R := [x:R]``/(f x)``.
-
-V8Infix "+" plus_fct : Rfun_scope.
-V8Notation "- x" := (opp_fct x) : Rfun_scope.
-V8Infix "*" mult_fct : Rfun_scope.
-V8Infix "-" minus_fct : Rfun_scope.
-V8Infix "/" div_fct : Rfun_scope.
-Notation Local "f1 'o' f2" := (comp f1 f2) (at level 2, right associativity)
-  : Rfun_scope 
-  V8only (at level 20, right associativity).
-V8Notation "/ x" := (inv_fct x) : Rfun_scope.
-
-Delimits Scope Rfun_scope with F.
-
-Definition fct_cte [a:R] : R->R := [x:R]a.
-Definition id := [x:R]x.
-
-(****************************************************)
-(**            Variations of functions              *)
-(****************************************************)
-Definition increasing [f:R->R] : Prop := (x,y:R) ``x<=y``->``(f x)<=(f y)``.
-Definition decreasing [f:R->R] : Prop := (x,y:R) ``x<=y``->``(f y)<=(f x)``.
-Definition strict_increasing [f:R->R] : Prop := (x,y:R) ``x<y``->``(f x)<(f y)``.
-Definition strict_decreasing [f:R->R] : Prop := (x,y:R) ``x<y``->``(f y)<(f x)``.
-Definition constant [f:R->R] : Prop := (x,y:R) ``(f x)==(f y)``.
-  
-(**********) 
-Definition no_cond : R->Prop := [x:R] True.
-
-(**********)
-Definition constant_D_eq [f:R->R;D:R->Prop;c:R] : Prop := (x:R) (D x) -> (f x)==c.
-
-(***************************************************)
-(**      Definition of continuity as a limit       *)
-(***************************************************)
-
-(**********)
-Definition continuity_pt [f:R->R; x0:R] : Prop := (continue_in f no_cond x0).
-Definition continuity [f:R->R] : Prop := (x:R) (continuity_pt f x).
-
-Arguments Scope continuity_pt [Rfun_scope R_scope].
-Arguments Scope continuity [Rfun_scope].
-
-(**********)
-Lemma continuity_pt_plus : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (plus_fct f1 f2) x0).
-Unfold continuity_pt plus_fct; Unfold continue_in; Intros; Apply limit_plus; Assumption.
-Qed.
-
-Lemma continuity_pt_opp : (f:R->R; x0:R) (continuity_pt f x0) -> (continuity_pt (opp_fct f) x0).
-Unfold continuity_pt opp_fct; Unfold continue_in; Intros; Apply limit_Ropp; Assumption.
-Qed.
- 
-Lemma continuity_pt_minus : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (minus_fct f1 f2) x0).
-Unfold continuity_pt minus_fct; Unfold continue_in; Intros; Apply limit_minus; Assumption.
-Qed.
-
-Lemma continuity_pt_mult : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (mult_fct f1 f2) x0).
-Unfold continuity_pt mult_fct; Unfold continue_in; Intros; Apply limit_mul; Assumption.
-Qed.
-
-Lemma continuity_pt_const : (f:R->R; x0:R) (constant f) -> (continuity_pt f x0).
-Unfold constant continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Intros; Exists ``1``; Split; [Apply Rlt_R0_R1 | Intros; Generalize (H x x0); Intro; Rewrite H2; Simpl; Rewrite R_dist_eq; Assumption].
-Qed.
-
-Lemma continuity_pt_scal : (f:R->R;a:R; x0:R) (continuity_pt f x0) -> (continuity_pt (mult_real_fct a f) x0).
-Unfold continuity_pt mult_real_fct; Unfold continue_in; Intros; Apply (limit_mul ([x:R] a) f (D_x no_cond x0) a (f x0) x0).
-Unfold limit1_in; Unfold limit_in; Intros; Exists ``1``; Split.
-Apply Rlt_R0_R1.
-Intros; Rewrite R_dist_eq; Assumption.
-Assumption.
-Qed.
-
-Lemma continuity_pt_inv : (f:R->R; x0:R) (continuity_pt f x0) -> ~``(f x0)==0`` -> (continuity_pt (inv_fct f) x0).
-Intros.
-Replace (inv_fct f) with [x:R]``/(f x)``.
-Unfold continuity_pt; Unfold continue_in; Intros; Apply limit_inv; Assumption.
-Unfold inv_fct; Reflexivity.
-Qed.
- 
-Lemma div_eq_inv : (f1,f2:R->R) (div_fct f1 f2)==(mult_fct f1 (inv_fct f2)).
-Intros; Reflexivity.
-Qed.
- 
-Lemma continuity_pt_div : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> ~``(f2 x0)==0`` -> (continuity_pt (div_fct f1 f2) x0).
-Intros; Rewrite -> (div_eq_inv f1 f2); Apply continuity_pt_mult; [Assumption | Apply continuity_pt_inv; Assumption].
-Qed.
-
-Lemma continuity_pt_comp : (f1,f2:R->R;x:R) (continuity_pt f1 x) -> (continuity_pt f2 (f1 x)) -> (continuity_pt (comp f2 f1) x).
-Unfold continuity_pt; Unfold continue_in; Intros; Unfold comp.
-Cut (limit1_in [x0:R](f2 (f1 x0)) (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1)
-(f2 (f1 x)) x) -> (limit1_in [x0:R](f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x).
-Intro; Apply H1.
-EApply limit_comp.
-Apply H.
-Apply H0.
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Assert H3 := (H1 eps H2).
-Elim H3; Intros.
-Exists x0.
-Split.
-Elim H4; Intros; Assumption.
-Intros; Case (Req_EM (f1 x) (f1 x1)); Intro.
-Rewrite H6; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Elim H4; Intros; Apply H8.
-Split.
-Unfold Dgf D_x no_cond.
-Split.
-Split.
-Trivial.
-Elim H5; Unfold D_x no_cond; Intros.
-Elim H9; Intros; Assumption.
-Split.
-Trivial.
-Assumption.
-Elim H5; Intros; Assumption.
-Qed.
-
-(**********) 
-Lemma continuity_plus : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (plus_fct f1 f2)).
-Unfold continuity; Intros; Apply (continuity_pt_plus f1 f2 x (H x) (H0 x)).
-Qed.
-
-Lemma continuity_opp : (f:R->R) (continuity f)->(continuity (opp_fct f)).
-Unfold continuity; Intros; Apply (continuity_pt_opp f x (H x)).
-Qed.
-
-Lemma continuity_minus : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (minus_fct f1 f2)).
-Unfold continuity; Intros; Apply (continuity_pt_minus f1 f2 x (H x) (H0 x)).
-Qed.
- 
-Lemma continuity_mult : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (mult_fct f1 f2)).
-Unfold continuity; Intros; Apply (continuity_pt_mult f1 f2 x (H x) (H0 x)).
-Qed.
-
-Lemma continuity_const : (f:R->R) (constant f) -> (continuity f).
-Unfold continuity; Intros; Apply (continuity_pt_const f x H).
-Qed.
-
-Lemma continuity_scal : (f:R->R;a:R) (continuity f) -> (continuity (mult_real_fct a f)).
-Unfold continuity; Intros; Apply (continuity_pt_scal f a x (H x)).
-Qed.
-  
-Lemma continuity_inv : (f:R->R) (continuity f)->((x:R) ~``(f x)==0``)->(continuity (inv_fct f)).
-Unfold continuity; Intros; Apply (continuity_pt_inv f x (H x) (H0 x)).
-Qed.
-
-Lemma continuity_div : (f1,f2:R->R) (continuity f1)->(continuity f2)->((x:R) ~``(f2 x)==0``)->(continuity (div_fct f1 f2)).
-Unfold continuity; Intros; Apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)).
-Qed.
- 
-Lemma continuity_comp : (f1,f2:R->R) (continuity f1) -> (continuity f2) -> (continuity (comp f2 f1)).
-Unfold continuity; Intros.
-Apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))).
-Qed.
-
-
-(*****************************************************)
-(**  Derivative's definition using Landau's kernel   *)
-(*****************************************************)
-
-Definition derivable_pt_lim [f:R->R;x,l:R] : Prop := ((eps:R) ``0<eps``->(EXT delta : posreal | ((h:R) ~``h==0``->``(Rabsolu h)<delta`` -> ``(Rabsolu ((((f (x+h))-(f x))/h)-l))<eps``))).
-
-Definition derivable_pt_abs [f:R->R;x:R] : R -> Prop := [l:R](derivable_pt_lim f x l).
-
-Definition derivable_pt [f:R->R;x:R] := (SigT R (derivable_pt_abs f x)).
-Definition derivable [f:R->R] := (x:R)(derivable_pt f x).
-
-Definition derive_pt [f:R->R;x:R;pr:(derivable_pt f x)] := (projT1 ? ? pr).
-Definition derive [f:R->R;pr:(derivable f)] := [x:R](derive_pt f x (pr x)).
-
-Arguments Scope derivable_pt_lim [Rfun_scope R_scope].
-Arguments Scope derivable_pt_abs [Rfun_scope R_scope R_scope].
-Arguments Scope derivable_pt [Rfun_scope R_scope].
-Arguments Scope derivable [Rfun_scope].
-Arguments Scope derive_pt [Rfun_scope R_scope _].
-Arguments Scope derive [Rfun_scope _].
-
-Definition antiderivative [f,g:R->R;a,b:R] : Prop := ((x:R)``a<=x<=b``->(EXT pr : (derivable_pt g x) | (f x)==(derive_pt g x pr)))/\``a<=b``.
-(************************************)
-(** Class of differential functions *)
-(************************************)
-Record Differential : Type := mkDifferential {
-d1 :> R->R;
-cond_diff : (derivable d1) }.
- 
-Record Differential_D2 : Type := mkDifferential_D2 {
-d2 :> R->R;
-cond_D1 : (derivable d2);
-cond_D2 : (derivable (derive d2 cond_D1)) }.
-
-(**********)
-Lemma unicite_step1 : (f:R->R;x,l1,l2:R) (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l1 R0) -> (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l2 R0) -> l1 == l2.
-Intros; Apply (single_limit [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l1 l2 R0); Try Assumption.
-Unfold adhDa; Intros; Exists ``alp/2``.
-Split.
-Unfold Rdiv; Apply prod_neq_R0.
-Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
-Apply Rinv_neq_R0; DiscrR.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Unfold Rdiv; Rewrite Rabsolu_mult.
-Replace ``(Rabsolu (/2))`` with ``/2``.
-Replace (Rabsolu alp) with alp.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1r; Rewrite double; Pattern 1 alp; Replace alp with ``alp+0``; [Idtac | Ring]; Apply Rlt_compatibility; Assumption.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
-Symmetry; Apply Rabsolu_right; Left; Change ``0</2``; Apply Rlt_Rinv; Sup0. 
-Qed.
-
-Lemma unicite_step2 : (f:R->R;x,l:R) (derivable_pt_lim f x l) -> (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l R0).
-Unfold derivable_pt_lim; Intros; Unfold limit1_in; Unfold limit_in; Intros.
-Assert H1 := (H eps H0).
-Elim H1 ; Intros.
-Exists (pos x0).
-Split.
-Apply (cond_pos x0).
-Simpl; Unfold R_dist; Intros.
-Elim H3; Intros.
-Apply H2; [Assumption |Unfold Rminus in H5; Rewrite Ropp_O in H5; Rewrite Rplus_Or in H5; Assumption].
-Qed.
-
-Lemma unicite_step3 : (f:R->R;x,l:R) (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l R0) -> (derivable_pt_lim f x l).
-Unfold limit1_in derivable_pt_lim; Unfold limit_in; Unfold dist; Simpl; Intros.
-Elim (H eps H0).
-Intros; Elim H1; Intros.
-Exists (mkposreal x0 H2).
-Simpl; Intros; Unfold R_dist in H3; Apply (H3 h).
-Split; [Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Assumption].
-Qed.
-
-Lemma unicite_limite : (f:R->R;x,l1,l2:R) (derivable_pt_lim f x l1) -> (derivable_pt_lim f x l2) -> l1==l2.
-Intros.
-Assert H1 := (unicite_step2 ? ? ? H).
-Assert H2 := (unicite_step2 ? ? ? H0).
-Assert H3 := (unicite_step1 ? ? ? ? H1 H2).
-Assumption.
-Qed.
-
-Lemma derive_pt_eq : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derive_pt f x pr)==l <-> (derivable_pt_lim f x l).
-Intros; Split.
-Intro; Assert H1 := (projT2 ? ? pr); Unfold derive_pt in H; Rewrite H in H1; Assumption.
-Intro; Assert H1 := (projT2 ? ? pr); Unfold derivable_pt_abs in H1.
-Assert H2 := (unicite_limite ? ? ? ? H H1).
-Unfold derive_pt; Unfold derivable_pt_abs.
-Symmetry; Assumption.
-Qed.
-
-(**********)
-Lemma derive_pt_eq_0 : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derivable_pt_lim f x l) -> (derive_pt f x pr)==l.
-Intros; Elim (derive_pt_eq f x l pr); Intros.
-Apply (H1 H).
-Qed.
-
-(**********)
-Lemma derive_pt_eq_1 : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derive_pt f x pr)==l -> (derivable_pt_lim f x l).
-Intros; Elim (derive_pt_eq f x l pr); Intros.
-Apply (H0 H).
-Qed.
-
-
-(********************************************************************)
-(** Equivalence of this definition with the one using limit concept *)
-(********************************************************************)
-Lemma derive_pt_D_in : (f,df:R->R;x:R;pr:(derivable_pt f x)) (D_in f df no_cond x) <-> (derive_pt f x pr)==(df x).
-Intros; Split.
-Unfold D_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Apply derive_pt_eq_0. 
-Unfold derivable_pt_lim.
-Intros; Elim (H eps H0); Intros alpha H1; Elim H1; Intros;  Exists (mkposreal alpha H2); Intros; Generalize (H3 ``x+h``); Intro; Cut ``x+h-x==h``; [Intro; Cut ``(D_x no_cond x (x+h))``/\``(Rabsolu (x+h-x)) < alpha``; [Intro; Generalize (H6 H8); Rewrite H7; Intro; Assumption | Split; [Unfold D_x; Split; [Unfold no_cond; Trivial | Apply Rminus_not_eq_right; Rewrite H7; Assumption] | Rewrite H7; Assumption]] | Ring].
-Intro.
-Assert H0 := (derive_pt_eq_1 f x (df x) pr H).
-Unfold D_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H0 eps H1); Intros alpha H2; Exists (pos alpha); Split.
-Apply (cond_pos alpha).
-Intros; Elim H3; Intros; Unfold D_x in H4; Elim H4; Intros; Cut ``x0-x<>0``.
-Intro; Generalize (H2 ``x0-x`` H8 H5); Replace ``x+(x0-x)`` with x0.
-Intro; Assumption.
-Ring.
-Auto with real.
-Qed.
-
-Lemma derivable_pt_lim_D_in : (f,df:R->R;x:R) (D_in f df no_cond x) <-> (derivable_pt_lim f x (df x)).
-Intros; Split.
-Unfold D_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Unfold derivable_pt_lim.
-Intros; Elim (H eps H0); Intros alpha H1; Elim H1; Intros;  Exists (mkposreal alpha H2); Intros; Generalize (H3 ``x+h``); Intro; Cut ``x+h-x==h``; [Intro; Cut ``(D_x no_cond x (x+h))``/\``(Rabsolu (x+h-x)) < alpha``; [Intro; Generalize (H6 H8); Rewrite H7; Intro; Assumption | Split; [Unfold D_x; Split; [Unfold no_cond; Trivial | Apply Rminus_not_eq_right; Rewrite H7; Assumption] | Rewrite H7; Assumption]] | Ring].
-Intro.
-Unfold derivable_pt_lim in H.
-Unfold D_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H eps H0); Intros alpha H2; Exists (pos alpha); Split.
-Apply (cond_pos alpha).
-Intros.
-Elim H1; Intros; Unfold D_x in H3; Elim H3; Intros; Cut ``x0-x<>0``.
-Intro; Generalize (H2 ``x0-x`` H7 H4); Replace ``x+(x0-x)`` with x0.
-Intro; Assumption.
-Ring.
-Auto with real.
-Qed.
-
-
-(***********************************)
-(**   derivability -> continuity   *)
-(***********************************)
-(**********)
-Lemma derivable_derive : (f:R->R;x:R;pr:(derivable_pt f x)) (EXT l : R | (derive_pt f x pr)==l).
-Intros; Exists (projT1  ? ? pr).
-Unfold derive_pt; Reflexivity.
-Qed.
-
-Theorem derivable_continuous_pt : (f:R->R;x:R) (derivable_pt f x) -> (continuity_pt f x).
-Intros.
-Generalize (derivable_derive f x X); Intro.
-Elim H; Intros l H1.
-Cut l==((fct_cte l) x).
-Intro.
-Rewrite H0 in H1.
-Generalize (derive_pt_D_in f (fct_cte l) x); Intro.
-Elim (H2 X); Intros.
-Generalize (H4 H1); Intro.
-Unfold continuity_pt.
-Apply (cont_deriv f (fct_cte l) no_cond x H5).
-Unfold fct_cte; Reflexivity.
-Qed.
-
-Theorem derivable_continuous : (f:R->R) (derivable f) -> (continuity f).
-Unfold derivable continuity; Intros.
-Apply (derivable_continuous_pt f x (X x)).
-Qed.
-
-(****************************************************************)
-(**                      Main rules                             *)
-(****************************************************************)
-
-Lemma derivable_pt_lim_plus : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (plus_fct f1 f2) x ``l1+l2``).
-Intros.
-Apply unicite_step3.
-Assert H1 := (unicite_step2 ? ? ? H).
-Assert H2 := (unicite_step2 ? ? ? H0).
-Unfold  plus_fct.
-Cut (h:R)``((f1 (x+h))+(f2 (x+h))-((f1 x)+(f2 x)))/h``==``((f1 (x+h))-(f1 x))/h+((f2 (x+h))-(f2 x))/h``.
-Intro.
-Generalize(limit_plus [h':R]``((f1 (x+h'))-(f1 x))/h'`` [h':R]``((f2 (x+h'))-(f2 x))/h'`` [h:R]``h <> 0`` l1 l2 ``0`` H1 H2).
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H4 eps H5); Intros.
-Exists x0.
-Elim H6; Intros.
-Split.
-Assumption.
-Intros; Rewrite H3; Apply H8; Assumption.
-Intro; Unfold Rdiv; Ring.
-Qed.
-
-Lemma derivable_pt_lim_opp : (f:R->R;x,l:R) (derivable_pt_lim f x l) -> (derivable_pt_lim (opp_fct f) x (Ropp l)).
-Intros.
-Apply unicite_step3.
-Assert H1 := (unicite_step2 ? ? ? H).
-Unfold opp_fct.
-Cut (h:R) ``( -(f (x+h))- -(f x))/h``==(Ropp ``((f (x+h))-(f x))/h``).
-Intro.
-Generalize (limit_Ropp [h:R]``((f (x+h))-(f x))/h``[h:R]``h <> 0`` l ``0`` H1).
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H2 eps H3); Intros.
-Exists x0.
-Elim H4; Intros.
-Split.
-Assumption.
-Intros; Rewrite H0; Apply H6; Assumption.
-Intro; Unfold Rdiv; Ring.
-Qed.
-
-Lemma derivable_pt_lim_minus : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (minus_fct f1 f2) x ``l1-l2``).
-Intros.
-Apply unicite_step3.
-Assert H1 := (unicite_step2 ? ? ? H).
-Assert H2 := (unicite_step2 ? ? ? H0).
-Unfold  minus_fct.
-Cut (h:R)``((f1 (x+h))-(f1 x))/h-((f2 (x+h))-(f2 x))/h``==``((f1 (x+h))-(f2 (x+h))-((f1 x)-(f2 x)))/h``.
-Intro.
-Generalize (limit_minus [h':R]``((f1 (x+h'))-(f1 x))/h'`` [h':R]``((f2 (x+h'))-(f2 x))/h'`` [h:R]``h <> 0`` l1 l2 ``0`` H1 H2).
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H4 eps H5); Intros.
-Exists x0.
-Elim H6; Intros.
-Split.
-Assumption.
-Intros; Rewrite <- H3; Apply H8; Assumption.
-Intro; Unfold Rdiv; Ring.
-Qed.
-
-Lemma derivable_pt_lim_mult : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (mult_fct f1 f2) x ``l1*(f2 x)+(f1 x)*l2``).
-Intros.
-Assert H1 := (derivable_pt_lim_D_in f1 [y:R]l1 x).
-Elim H1; Intros.
-Assert H4 := (H3 H).
-Assert H5 := (derivable_pt_lim_D_in f2 [y:R]l2 x).
-Elim H5; Intros.
-Assert H8 := (H7 H0).
-Clear H1 H2 H3 H5 H6 H7.
-Assert H1 := (derivable_pt_lim_D_in (mult_fct f1 f2) [y:R]``l1*(f2 x)+(f1 x)*l2`` x).
-Elim H1; Intros.
-Clear H1 H3.
-Apply H2.
-Unfold mult_fct.
-Apply (Dmult no_cond [y:R]l1 [y:R]l2 f1 f2 x); Assumption.
-Qed.
-
-Lemma derivable_pt_lim_const : (a,x:R) (derivable_pt_lim (fct_cte a) x ``0``).
-Intros; Unfold fct_cte derivable_pt_lim.
-Intros; Exists (mkposreal ``1`` Rlt_R0_R1); Intros; Unfold Rminus; Rewrite Rplus_Ropp_r; Unfold Rdiv; Rewrite Rmult_Ol; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Qed.
-
-Lemma derivable_pt_lim_scal : (f:R->R;a,x,l:R) (derivable_pt_lim f x l) -> (derivable_pt_lim (mult_real_fct a f) x ``a*l``).
-Intros.
-Assert H0 := (derivable_pt_lim_const a x).
-Replace (mult_real_fct a f) with (mult_fct (fct_cte a) f).
-Replace ``a*l`` with ``0*(f x)+a*l``; [Idtac | Ring].
-Apply (derivable_pt_lim_mult (fct_cte a) f x ``0`` l); Assumption.
-Unfold mult_real_fct mult_fct fct_cte; Reflexivity.
-Qed.
-
-Lemma derivable_pt_lim_id : (x:R) (derivable_pt_lim id x ``1``).
-Intro; Unfold derivable_pt_lim.
-Intros eps Heps; Exists (mkposreal eps Heps); Intros h H1 H2; Unfold id; Replace ``(x+h-x)/h-1`` with ``0``.
-Rewrite Rabsolu_R0; Apply Rle_lt_trans with ``(Rabsolu h)``.
-Apply Rabsolu_pos.
-Assumption.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite (Rplus_sym x); Rewrite Rplus_assoc.
-Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Unfold Rdiv; Rewrite <- Rinv_r_sym.
-Symmetry; Apply Rplus_Ropp_r.
-Assumption.
-Qed.
-
-Lemma derivable_pt_lim_Rsqr : (x:R) (derivable_pt_lim Rsqr x ``2*x``).
-Intro; Unfold derivable_pt_lim.
-Unfold Rsqr; Intros eps Heps; Exists (mkposreal eps Heps); Intros h H1 H2; Replace ``((x+h)*(x+h)-x*x)/h-2*x`` with ``h``.
-Assumption.
-Replace ``(x+h)*(x+h)-x*x`` with ``2*x*h+h*h``; [Idtac | Ring].
-Unfold Rdiv; Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Repeat Rewrite <- Rinv_r_sym; [Idtac | Assumption].
-Ring.
-Qed.
-
-Lemma derivable_pt_lim_comp : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 (f1 x) l2) -> (derivable_pt_lim (comp f2 f1) x ``l2*l1``).
-Intros; Assert H1 := (derivable_pt_lim_D_in f1 [y:R]l1 x).
-Elim H1; Intros.
-Assert H4 := (H3 H).
-Assert H5 := (derivable_pt_lim_D_in f2 [y:R]l2 (f1 x)).
-Elim H5; Intros.
-Assert H8 := (H7 H0).
-Clear H1 H2 H3 H5 H6 H7.
-Assert H1 := (derivable_pt_lim_D_in (comp f2 f1) [y:R]``l2*l1`` x).
-Elim H1; Intros.
-Clear H1 H3; Apply H2.
-Unfold comp; Cut (D_in [x0:R](f2 (f1 x0)) [y:R]``l2*l1`` (Dgf no_cond no_cond f1) x) -> (D_in [x0:R](f2 (f1 x0)) [y:R]``l2*l1`` no_cond x).
-Intro; Apply H1.
-Rewrite Rmult_sym; Apply (Dcomp no_cond no_cond [y:R]l1 [y:R]l2 f1 f2 x); Assumption.
-Unfold Dgf D_in no_cond; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Elim (H1 eps H3); Intros.
-Exists x0; Intros; Split.
-Elim H5; Intros; Assumption.
-Intros; Elim H5; Intros; Apply H9; Split.
-Unfold D_x; Split.
-Split; Trivial.
-Elim H6; Intros; Unfold D_x in H10; Elim H10; Intros; Assumption.
-Elim H6; Intros; Assumption.
-Qed.
-
-Lemma derivable_pt_plus : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (plus_fct f1 f2) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Apply Specif.existT with ``x0+x1``.
-Apply derivable_pt_lim_plus; Assumption.
-Qed.
-
-Lemma derivable_pt_opp : (f:R->R;x:R) (derivable_pt f x) -> (derivable_pt (opp_fct f) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Apply Specif.existT with ``-x0``.
-Apply derivable_pt_lim_opp; Assumption.
-Qed.
-
-Lemma derivable_pt_minus : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (minus_fct f1 f2) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Apply Specif.existT with ``x0-x1``.
-Apply derivable_pt_lim_minus; Assumption.
-Qed.
-
-Lemma derivable_pt_mult : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (mult_fct f1 f2) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Apply Specif.existT with ``x0*(f2 x)+(f1 x)*x1``.
-Apply derivable_pt_lim_mult; Assumption.
-Qed.
-
-Lemma derivable_pt_const : (a,x:R) (derivable_pt (fct_cte a) x).
-Intros; Unfold derivable_pt.
-Apply Specif.existT with ``0``.
-Apply derivable_pt_lim_const.
-Qed.
-
-Lemma derivable_pt_scal : (f:R->R;a,x:R) (derivable_pt f x) -> (derivable_pt (mult_real_fct a f) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Apply Specif.existT with ``a*x0``.
-Apply derivable_pt_lim_scal; Assumption.
-Qed.
-
-Lemma derivable_pt_id : (x:R) (derivable_pt id x).
-Unfold derivable_pt; Intro.
-Exists ``1``.
-Apply derivable_pt_lim_id.
-Qed.
-
-Lemma derivable_pt_Rsqr : (x:R) (derivable_pt Rsqr x).
-Unfold derivable_pt; Intro; Apply Specif.existT with ``2*x``.
-Apply derivable_pt_lim_Rsqr.
-Qed.
-
-Lemma derivable_pt_comp : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 (f1 x)) -> (derivable_pt (comp f2 f1) x).
-Unfold derivable_pt; Intros.
-Elim X; Intros.
-Elim X0 ;Intros.
-Apply Specif.existT with ``x1*x0``.
-Apply derivable_pt_lim_comp; Assumption.
-Qed.
-
-Lemma derivable_plus : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (plus_fct f1 f2)).
-Unfold derivable; Intros.
-Apply (derivable_pt_plus ? ? x (X ?) (X0 ?)).
-Qed.
-
-Lemma derivable_opp : (f:R->R) (derivable f) -> (derivable (opp_fct f)).
-Unfold derivable; Intros.
-Apply (derivable_pt_opp ? x (X ?)).
-Qed.
-
-Lemma derivable_minus : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (minus_fct f1 f2)).
-Unfold derivable; Intros.
-Apply (derivable_pt_minus ? ? x (X ?) (X0 ?)).
-Qed.
-
-Lemma derivable_mult : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (mult_fct f1 f2)).
-Unfold derivable; Intros.
-Apply (derivable_pt_mult ? ? x (X ?) (X0 ?)).
-Qed.
-
-Lemma derivable_const : (a:R) (derivable (fct_cte a)).
-Unfold derivable; Intros.
-Apply derivable_pt_const.
-Qed.
-
-Lemma derivable_scal : (f:R->R;a:R) (derivable f) -> (derivable (mult_real_fct a f)).
-Unfold derivable; Intros.
-Apply (derivable_pt_scal ? a x (X ?)).
-Qed.
-
-Lemma derivable_id : (derivable id).
-Unfold derivable; Intro; Apply derivable_pt_id.
-Qed.
-
-Lemma derivable_Rsqr : (derivable Rsqr).
-Unfold derivable; Intro; Apply derivable_pt_Rsqr.
-Qed.
-
-Lemma derivable_comp : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (comp f2 f1)).
-Unfold derivable; Intros.
-Apply (derivable_pt_comp ? ? x (X ?) (X0 ?)).
-Qed.
-
-Lemma derive_pt_plus : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (plus_fct f1 f2) x (derivable_pt_plus ? ? ? pr1 pr2)) == (derive_pt f1 x pr1) + (derive_pt f2 x pr2)``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 x pr2).
-Assert H1 := (derivable_derive (plus_fct f1 f2) x (derivable_pt_plus ? ? ? pr1 pr2)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_plus; Assumption.
-Qed.
-
-Lemma derive_pt_opp : (f:R->R;x:R;pr1:(derivable_pt f x)) ``(derive_pt (opp_fct f) x (derivable_pt_opp ? ? pr1)) == -(derive_pt f x pr1)``.
-Intros.
-Assert H := (derivable_derive f x pr1).
-Assert H0 := (derivable_derive (opp_fct f) x (derivable_pt_opp ? ? pr1)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Rewrite H; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Apply derivable_pt_lim_opp; Assumption.
-Qed.
-
-Lemma derive_pt_minus : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (minus_fct f1 f2) x (derivable_pt_minus ? ? ? pr1 pr2)) == (derive_pt f1 x pr1) - (derive_pt f2 x pr2)``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 x pr2).
-Assert H1 := (derivable_derive (minus_fct f1 f2) x (derivable_pt_minus ? ? ? pr1 pr2)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_minus; Assumption.
-Qed.
-
-Lemma derive_pt_mult : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (mult_fct f1 f2) x (derivable_pt_mult ? ? ? pr1 pr2)) == (derive_pt f1 x pr1)*(f2 x) + (f1 x)*(derive_pt f2 x pr2)``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 x pr2).
-Assert H1 := (derivable_derive (mult_fct f1 f2) x (derivable_pt_mult ? ? ? pr1 pr2)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_mult; Assumption.
-Qed.
-
-Lemma derive_pt_const : (a,x:R) (derive_pt (fct_cte a) x (derivable_pt_const a x)) == R0.
-Intros.
-Apply derive_pt_eq_0.
-Apply derivable_pt_lim_const.
-Qed.
-
-Lemma derive_pt_scal : (f:R->R;a,x:R;pr:(derivable_pt f x)) ``(derive_pt (mult_real_fct a f) x (derivable_pt_scal ? ? ? pr)) == a * (derive_pt f x pr)``.
-Intros.
-Assert H := (derivable_derive f x pr).
-Assert H0 := (derivable_derive (mult_real_fct a f) x (derivable_pt_scal ? ? ? pr)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Rewrite H; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr).
-Unfold derive_pt in H; Rewrite H in H3.
-Apply derivable_pt_lim_scal; Assumption.
-Qed.
-
-Lemma derive_pt_id : (x:R) (derive_pt id x (derivable_pt_id ?))==R1.
-Intros.
-Apply derive_pt_eq_0.
-Apply derivable_pt_lim_id.
-Qed.
-
-Lemma derive_pt_Rsqr : (x:R) (derive_pt Rsqr x (derivable_pt_Rsqr ?)) == ``2*x``.
-Intros.
-Apply derive_pt_eq_0.
-Apply derivable_pt_lim_Rsqr.
-Qed.
-
-Lemma derive_pt_comp : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 (f1 x))) ``(derive_pt (comp f2 f1) x (derivable_pt_comp ? ? ? pr1 pr2)) == (derive_pt f2 (f1 x) pr2) * (derive_pt f1 x pr1)``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 (f1 x) pr2).
-Assert H1 := (derivable_derive (comp f2 f1) x (derivable_pt_comp ? ? ? pr1 pr2)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_comp; Assumption.
-Qed.
-
-(* Pow *)
-Definition pow_fct [n:nat] : R->R := [y:R](pow y n).
-
-Lemma derivable_pt_lim_pow_pos : (x:R;n:nat) (lt O n) -> (derivable_pt_lim [y:R](pow y n) x ``(INR n)*(pow x (pred n))``).
-Intros.
-Induction n.
-Elim (lt_n_n ? H).
-Cut n=O\/(lt O n).
-Intro; Elim H0; Intro.
-Rewrite H1; Simpl.
-Replace [y:R]``y*1`` with (mult_fct id (fct_cte R1)).
-Replace ``1*1`` with ``1*(fct_cte R1 x)+(id x)*0``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte id; Ring.
-Reflexivity.
-Replace [y:R](pow y (S n)) with [y:R]``y*(pow y n)``.
-Replace (pred (S n)) with n; [Idtac | Reflexivity].
-Replace [y:R]``y*(pow y n)`` with (mult_fct id [y:R](pow y n)).
-Pose f := [y:R](pow y n).
-Replace ``(INR (S n))*(pow x n)`` with (Rplus (Rmult R1 (f x)) (Rmult (id x) (Rmult (INR n) (pow x (pred n))))).
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_id.
-Unfold f; Apply Hrecn; Assumption.
-Unfold f.
-Pattern 1 5 n; Replace n with (S (pred n)).
-Unfold id; Rewrite S_INR; Simpl.
-Ring.
-Symmetry; Apply S_pred with O; Assumption.
-Unfold mult_fct id; Reflexivity.
-Reflexivity.
-Inversion H.
-Left; Reflexivity.
-Right.
-Apply lt_le_trans with (1).
-Apply lt_O_Sn.
-Assumption.
-Qed.
-
-Lemma derivable_pt_lim_pow : (x:R; n:nat) (derivable_pt_lim [y:R](pow y n) x ``(INR n)*(pow x (pred n))``).
-Intros.
-Induction n.
-Simpl.
-Rewrite Rmult_Ol.
-Replace [_:R]``1`` with (fct_cte R1); [Apply derivable_pt_lim_const | Reflexivity].
-Apply derivable_pt_lim_pow_pos.
-Apply lt_O_Sn.
-Qed.
-
-Lemma derivable_pt_pow : (n:nat;x:R) (derivable_pt [y:R](pow y n) x).
-Intros; Unfold derivable_pt.
-Apply Specif.existT with ``(INR n)*(pow x (pred n))``.
-Apply derivable_pt_lim_pow.
-Qed.
-
-Lemma derivable_pow : (n:nat) (derivable [y:R](pow y n)).
-Intro; Unfold derivable; Intro; Apply derivable_pt_pow.
-Qed.
-
-Lemma derive_pt_pow : (n:nat;x:R) (derive_pt [y:R](pow y n) x (derivable_pt_pow n x))==``(INR n)*(pow x (pred n))``.
-Intros; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_pow.
-Qed.
-
-Lemma pr_nu : (f:R->R;x:R;pr1,pr2:(derivable_pt f x)) (derive_pt f x pr1)==(derive_pt f x pr2). 
-Intros.
-Unfold derivable_pt in pr1.
-Unfold derivable_pt in pr2.
-Elim pr1; Intros.
-Elim pr2; Intros.
-Unfold derivable_pt_abs in p.
-Unfold derivable_pt_abs in p0.
-Simpl.
-Apply (unicite_limite f x x0 x1 p p0).
-Qed.
-
-
-(************************************************************)
-(**             Local extremum's condition                  *)
-(************************************************************)
-
-Theorem deriv_maximum : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f x)<=(f c)``)->``(derive_pt f c pr)==0``.
-Intros; Case (total_order R0 (derive_pt f c pr)); Intro.
-Assert H3 := (derivable_derive f c pr).
-Elim H3; Intros l H4; Rewrite H4 in H2.
-Assert H5 := (derive_pt_eq_1 f c l pr H4).
-Cut ``0<l/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
-Elim (H5 ``l/2`` H6); Intros delta H7.
-Cut ``0<(b-c)/2``.
-Intro; Cut ``(Rmin delta/2 ((b-c)/2))<>0``.
-Intro; Cut ``(Rabsolu (Rmin delta/2 ((b-c)/2)))<delta``.
-Intro.
-Assert H11 := (H7 ``(Rmin delta/2 ((b-c)/2))`` H9 H10).
-Cut ``0<(Rmin (delta/2) ((b-c)/2))``.
-Intro; Cut ``a<c+(Rmin (delta/2) ((b-c)/2))``.
-Intro; Cut ``c+(Rmin (delta/2) ((b-c)/2))<b``.
-Intro; Assert H15 := (H1 ``c+(Rmin (delta/2) ((b-c)/2))`` H13 H14).
-Cut ``((f (c+(Rmin (delta/2) ((b-c)/2))))-(f c))/(Rmin (delta/2) ((b-c)/2))<=0``.
-Intro; Cut ``-l<0``.
-Intro; Unfold Rminus in H11.
-Cut ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l<0``.
-Intro; Cut ``(Rabsolu (((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l)) < l/2``.
-Unfold Rabsolu; Case (case_Rabsolu ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l``); Intro.
-Replace `` -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l)`` with ``l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))``.
-Intro; Generalize (Rlt_compatibility ``-l`` ``l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))`` ``l/2`` H19); Repeat Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Replace ``-l+l/2`` with ``-(l/2)``.
-Intro; Generalize (Rlt_Ropp ``-(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))`` ``-(l/2)`` H20); Repeat Rewrite Ropp_Ropp; Intro; Generalize (Rlt_trans ``0`` ``l/2`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))`` H6 H21); Intro; Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))`` ``0`` H22 H16)).
-Pattern 2 l; Rewrite double_var.
-Ring.
-Ring.
-Intro.
-Assert H20 := (Rle_sym2 ``0`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l`` r).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H20 H18)). 
-Assumption.
-Rewrite <- Ropp_O; Replace ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l`` with ``-(l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))-(f c))/(Rmin (delta/2) ((b+ -c)/2))))``.
-Apply Rgt_Ropp; Change ``0<l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))-(f c))/(Rmin (delta/2) ((b+ -c)/2)))``; Apply gt0_plus_ge0_is_gt0; [Assumption | Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Assumption].
-Ring.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Replace ``((f (c+(Rmin (delta/2) ((b-c)/2))))-(f c))/(Rmin (delta/2) ((b-c)/2))`` with ``- (((f c)-(f (c+(Rmin (delta/2) ((b-c)/2)))))/(Rmin (delta/2) ((b-c)/2)))``.
-Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Unfold Rdiv; Apply Rmult_le_pos; [Generalize (Rle_compatibility_r ``-(f (c+(Rmin (delta*/2) ((b-c)*/2))))`` ``(f (c+(Rmin (delta*/2) ((b-c)*/2))))`` (f c) H15); Rewrite Rplus_Ropp_r; Intro; Assumption | Left; Apply Rlt_Rinv; Assumption].
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Repeat Rewrite <- (Rmult_sym ``/(Rmin (delta*/2) ((b-c)*/2))``).
-Apply r_Rmult_mult with ``(Rmin (delta*/2) ((b-c)*/2))``.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Repeat Rewrite Rmult_1l.
-Ring.
-Red; Intro.
-Unfold Rdiv in H12; Rewrite H16 in H12; Elim (Rlt_antirefl ``0`` H12).
-Red; Intro.
-Unfold Rdiv in H12; Rewrite H16 in H12; Elim (Rlt_antirefl ``0`` H12).
-Assert H14 := (Rmin_r ``(delta/2)`` ``((b-c)/2)``).
-Assert H15 := (Rle_compatibility ``c`` ``(Rmin (delta/2) ((b-c)/2))`` ``(b-c)/2`` H14).
-Apply Rle_lt_trans with ``c+(b-c)/2``.
-Assumption.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Replace ``2*(c+(b-c)/2)`` with ``c+b``.
-Replace ``2*b`` with ``b+b``.
-Apply Rlt_compatibility_r; Assumption.
-Ring.
-Unfold Rdiv; Rewrite Rmult_Rplus_distr.
-Repeat Rewrite (Rmult_sym ``2``).
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Ring.
-DiscrR.
-Apply Rlt_trans with c.
-Assumption.
-Pattern 1 c; Rewrite <- (Rplus_Or c); Apply Rlt_compatibility; Assumption.
-Cut ``0<delta/2``.
-Intro; Apply (Rmin_stable_in_posreal (mkposreal ``delta/2`` H12) (mkposreal ``(b-c)/2`` H8)).
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Unfold Rabsolu; Case (case_Rabsolu (Rmin ``delta/2`` ``(b-c)/2``)).
-Intro.
-Cut ``0<delta/2``.
-Intro.
-Generalize (Rmin_stable_in_posreal (mkposreal ``delta/2`` H10) (mkposreal ``(b-c)/2`` H8)); Simpl; Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(Rmin (delta/2) ((b-c)/2))`` ``0`` H11 r)).
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Intro; Apply Rle_lt_trans with ``delta/2``.
-Apply Rmin_l.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Replace ``2*delta`` with ``delta+delta``. 
-Pattern 2 delta; Rewrite <- (Rplus_Or delta); Apply Rlt_compatibility.
-Rewrite Rplus_Or; Apply (cond_pos delta).
-Symmetry; Apply double.
-DiscrR.
-Cut ``0<delta/2``.
-Intro; Generalize (Rmin_stable_in_posreal (mkposreal ``delta/2`` H9) (mkposreal ``(b-c)/2`` H8)); Simpl; Intro; Red; Intro; Rewrite H11 in H10; Elim (Rlt_antirefl ``0`` H10).
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Unfold Rdiv; Apply Rmult_lt_pos.
-Generalize (Rlt_compatibility_r ``-c`` c b H0); Rewrite Rplus_Ropp_r; Intro; Assumption.
-Apply Rlt_Rinv; Sup0.
-Elim H2; Intro.
-Symmetry; Assumption.
-Generalize (derivable_derive f c pr); Intro; Elim H4; Intros l H5.
-Rewrite H5 in H3; Generalize (derive_pt_eq_1 f c l pr H5); Intro; Cut ``0< -(l/2)``.
-Intro; Elim (H6 ``-(l/2)`` H7); Intros delta H9.
-Cut ``0<(c-a)/2``.
-Intro; Cut ``(Rmax (-(delta/2)) ((a-c)/2))<0``.
-Intro; Cut ``(Rmax (-(delta/2)) ((a-c)/2))<>0``.
-Intro; Cut ``(Rabsolu (Rmax (-(delta/2)) ((a-c)/2)))<delta``.
-Intro; Generalize (H9 ``(Rmax (-(delta/2)) ((a-c)/2))`` H11 H12); Intro; Cut ``a<c+(Rmax (-(delta/2)) ((a-c)/2))``.
-Cut ``c+(Rmax (-(delta/2)) ((a-c)/2))<b``.
-Intros; Generalize (H1 ``c+(Rmax (-(delta/2)) ((a-c)/2))`` H15 H14); Intro; Cut ``0<=((f (c+(Rmax (-(delta/2)) ((a-c)/2))))-(f c))/(Rmax (-(delta/2)) ((a-c)/2))``.
-Intro; Cut ``0< -l``.
-Intro; Unfold Rminus in H13; Cut ``0<((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l``.
-Intro; Cut ``(Rabsolu (((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l)) < -(l/2)``.
-Unfold Rabsolu; Case (case_Rabsolu ``((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l``).
-Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``((f (c+(Rmax ( -(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax ( -(delta/2)) ((a+ -c)/2))+ -l`` ``0`` H19 r)).
-Intros; Generalize (Rlt_compatibility_r ``l`` ``(((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2)))+ -l`` ``-(l/2)`` H20); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Replace ``-(l/2)+l`` with ``l/2``.
-Cut ``l/2<0``.
-Intros; Generalize (Rlt_trans ``((f (c+(Rmax ( -(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax ( -(delta/2)) ((a+ -c)/2))`` ``l/2`` ``0`` H22 H21); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``((f (c+(Rmax ( -(delta/2)) ((a-c)/2))))-(f c))/(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H17 H23)).
-Rewrite <- (Ropp_Ropp ``l/2``); Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Pattern 3 l; Rewrite double_var.
-Ring.
-Assumption.
-Apply ge0_plus_gt0_is_gt0; Assumption.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Unfold Rdiv; Replace ``((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c))*/(Rmax ( -(delta*/2)) ((a-c)*/2))`` with ``(-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c)))*/(-(Rmax ( -(delta*/2)) ((a-c)*/2)))``.
-Apply Rmult_le_pos.
-Generalize (Rle_compatibility ``-(f (c+(Rmax (-(delta*/2)) ((a-c)*/2))))`` ``(f (c+(Rmax (-(delta*/2)) ((a-c)*/2))))`` (f c) H16); Rewrite Rplus_Ropp_l; Replace ``-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c))`` with ``-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2)))))+(f c)``.
-Intro; Assumption.
-Ring.
-Left; Apply Rlt_Rinv; Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Unfold Rdiv.
-Rewrite <- Ropp_Rinv.
-Rewrite Ropp_mul2.
-Reflexivity.
-Unfold Rdiv in H11; Assumption.
-Generalize (Rlt_compatibility c ``(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H10); Rewrite Rplus_Or; Intro; Apply Rlt_trans with ``c``; Assumption.
-Generalize (RmaxLess2 ``(-(delta/2))`` ``((a-c)/2)``); Intro; Generalize (Rle_compatibility c ``(a-c)/2`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` H14); Intro; Apply Rlt_le_trans with ``c+(a-c)/2``.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Replace ``2*(c+(a-c)/2)`` with ``a+c``.
-Rewrite double.
-Apply Rlt_compatibility; Assumption.
-Ring.
-Rewrite <- Rplus_assoc.
-Rewrite <- double_var.
-Ring.
-Assumption.
-Unfold Rabsolu; Case (case_Rabsolu (Rmax ``-(delta/2)`` ``(a-c)/2``)).
-Intro; Generalize (RmaxLess1 ``-(delta/2)`` ``(a-c)/2``); Intro; Generalize (Rle_Ropp ``-(delta/2)`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` H12); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-(Rmax ( -(delta/2)) ((a-c)/2))`` ``delta/2`` H13); Intro; Apply Rle_lt_trans with ``delta/2``.
-Assumption.
-Apply Rlt_monotony_contra with ``2``. 
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double.
-Pattern 2 delta; Rewrite <- (Rplus_Or delta); Apply Rlt_compatibility; Rewrite Rplus_Or; Apply (cond_pos delta).
-DiscrR. 
-Cut ``-(delta/2) < 0``.
-Cut ``(a-c)/2<0``.
-Intros; Generalize (Rmax_stable_in_negreal (mknegreal ``-(delta/2)`` H13) (mknegreal ``(a-c)/2`` H12)); Simpl; Intro; Generalize (Rle_sym2 ``0`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` r); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H15 H14)).
-Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp ``(a-c)/2``); Apply Rlt_Ropp; Replace ``-((a-c)/2)`` with ``(c-a)/2``.
-Assumption.
-Unfold Rdiv.
-Rewrite <- Ropp_mul1. 
-Rewrite (Ropp_distr2 a c).
-Reflexivity.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
-Red; Intro; Rewrite H11 in H10; Elim (Rlt_antirefl ``0`` H10).
-Cut ``(a-c)/2<0``.
-Intro; Cut ``-(delta/2)<0``.
-Intro; Apply (Rmax_stable_in_negreal (mknegreal ``-(delta/2)`` H11) (mknegreal ``(a-c)/2`` H10)).
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
-Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp ``(a-c)/2``); Apply Rlt_Ropp; Replace ``-((a-c)/2)`` with ``(c-a)/2``.
-Assumption.
-Unfold Rdiv.
-Rewrite <- Ropp_mul1. 
-Rewrite (Ropp_distr2 a c).
-Reflexivity.
-Unfold Rdiv; Apply Rmult_lt_pos; [Generalize (Rlt_compatibility_r ``-a`` a c H); Rewrite Rplus_Ropp_r; Intro; Assumption | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
-Replace ``-(l/2)`` with ``(-l)/2``.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)].
-Unfold Rdiv; Apply Ropp_mul1.
-Qed.
-
-Theorem deriv_minimum : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f c)<=(f x)``)->``(derive_pt f c pr)==0``.
-Intros.
-Rewrite <- (Ropp_Ropp (derive_pt f c pr)).
-Apply eq_RoppO.
-Rewrite <- (derive_pt_opp f c pr).
-Cut (x:R)(``a<x``->``x<b``->``((opp_fct f) x)<=((opp_fct f) c)``).
-Intro.
-Apply (deriv_maximum (opp_fct f) a b c (derivable_pt_opp ? ? pr) H H0 H2).
-Intros; Unfold opp_fct; Apply Rge_Ropp; Apply Rle_sym1.
-Apply (H1 x H2 H3).
-Qed.
- 
-Theorem deriv_constant2 : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f x)==(f c)``)->``(derive_pt f c pr)==0``.
-Intros.
-EApply deriv_maximum with a b; Try Assumption.
-Intros; Right; Apply (H1 x H2 H3).
-Qed.
-
-(**********)
-Lemma nonneg_derivative_0 : (f:R->R;pr:(derivable f)) (increasing f) -> ((x:R) ``0<=(derive_pt f x (pr x))``).
-Intros; Unfold increasing in H.
-Assert H0 := (derivable_derive f x (pr x)).
-Elim H0; Intros l H1.
-Rewrite H1; Case (total_order R0 l); Intro.
-Left; Assumption.
-Elim H2; Intro.
-Right; Assumption.
-Assert H4 := (derive_pt_eq_1 f x l (pr x) H1).
-Cut ``0< -(l/2)``.
-Intro; Elim (H4 ``-(l/2)`` H5); Intros delta H6.
-Cut ``delta/2<>0``/\``0<delta/2``/\``(Rabsolu delta/2)<delta``.
-Intro; Decompose [and] H7; Intros; Generalize (H6 ``delta/2`` H8 H11); Cut ``0<=((f (x+delta/2))-(f x))/(delta/2)``.
-Intro; Cut ``0<=((f (x+delta/2))-(f x))/(delta/2)-l``.
-Intro; Unfold Rabsolu; Case (case_Rabsolu ``((f (x+delta/2))-(f x))/(delta/2)-l``).
-Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``0`` H12 r)).
-Intros; Generalize (Rlt_compatibility_r l ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``-(l/2)`` H13); Unfold Rminus; Replace ``-(l/2)+l`` with ``l/2``.
-Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Intro; Generalize (Rle_lt_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)`` ``l/2`` H9 H14); Intro; Cut ``l/2<0``.
-Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``l/2`` ``0`` H15 H16)).
-Rewrite <- Ropp_O in H5; Generalize (Rlt_Ropp ``-0`` ``-(l/2)`` H5); Repeat Rewrite Ropp_Ropp; Intro; Assumption.
-Pattern 3 l ; Rewrite double_var.
-Ring.
-Unfold Rminus; Apply ge0_plus_ge0_is_ge0.
-Unfold Rdiv; Apply Rmult_le_pos.
-Cut ``x<=(x+(delta*/2))``.
-Intro; Generalize (H x ``x+(delta*/2)`` H12); Intro; Generalize (Rle_compatibility ``-(f x)`` ``(f x)`` ``(f (x+delta*/2))`` H13); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
-Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_Rinv; Assumption.
-Left; Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
-Unfold Rdiv; Apply Rmult_le_pos.
-Cut ``x<=(x+(delta*/2))``.
-Intro; Generalize (H x ``x+(delta*/2)`` H9); Intro; Generalize (Rle_compatibility ``-(f x)`` ``(f x)`` ``(f (x+delta*/2))`` H12); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
-Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption. 
-Left; Apply Rlt_Rinv; Assumption.
-Split.
-Unfold Rdiv; Apply prod_neq_R0.
-Generalize (cond_pos delta); Intro; Red; Intro H9; Rewrite H9 in H7; Elim (Rlt_antirefl ``0`` H7).
-Apply Rinv_neq_R0; DiscrR.
-Split.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Replace ``(Rabsolu delta/2)`` with ``delta/2``.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite (Rmult_sym ``2``).
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Pattern 1 (pos delta); Rewrite <- Rplus_Or.
-Apply Rlt_compatibility; Apply (cond_pos delta).
-Symmetry; Apply Rabsolu_right.
-Left; Change ``0<delta/2``; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
-Unfold Rdiv; Rewrite <- Ropp_mul1; Apply Rmult_lt_pos.
-Apply Rlt_anti_compatibility with l.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Assumption.
-Apply Rlt_Rinv; Sup0.
-Qed.
diff --git a/theories7/Reals/Ranalysis2.v b/theories7/Reals/Ranalysis2.v
deleted file mode 100644
index 35fa58d5..00000000
--- a/theories7/Reals/Ranalysis2.v
+++ /dev/null
@@ -1,302 +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: Ranalysis2.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(**********)
-Lemma formule : (x,h,l1,l2:R;f1,f2:R->R) ``h<>0`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ``((f1 (x+h))/(f2 (x+h))-(f1 x)/(f2 x))/h-(l1*(f2 x)-l2*(f1 x))/(Rsqr (f2 x))`` == ``/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1) + l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))) - (f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2) + (l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))``.
-Intros; Unfold Rdiv Rminus Rsqr.
-Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; Repeat Rewrite Rinv_Rmult; Try Assumption.
-Replace ``l1*(f2 x)*(/(f2 x)*/(f2 x))`` with ``l1*/(f2 x)*((f2 x)*/(f2 x))``; [Idtac | Ring].
-Replace ``l1*(/(f2 x)*/(f2 (x+h)))*(f2 x)`` with ``l1*/(f2 (x+h))*((f2 x)*/(f2 x))``; [Idtac | Ring].
-Replace ``l1*(/(f2 x)*/(f2 (x+h)))* -(f2 (x+h))`` with ``-(l1*/(f2 x)*((f2 (x+h))*/(f2 (x+h))))``; [Idtac | Ring].
-Replace ``(f1 x)*(/(f2 x)*/(f2 (x+h)))*((f2 (x+h))*/h)`` with ``(f1 x)*/(f2 x)*/h*((f2 (x+h))*/(f2 (x+h)))``; [Idtac | Ring].
-Replace ``(f1 x)*(/(f2 x)*/(f2 (x+h)))*( -(f2 x)*/h)`` with ``-((f1 x)*/(f2 (x+h))*/h*((f2 x)*/(f2 x)))``; [Idtac | Ring].
-Replace ``(l2*(f1 x)*(/(f2 x)*/(f2 x)*/(f2 (x+h)))*(f2 (x+h)))`` with ``l2*(f1 x)*/(f2 x)*/(f2 x)*((f2 (x+h))*/(f2 (x+h)))``; [Idtac | Ring].
-Replace ``l2*(f1 x)*(/(f2 x)*/(f2 x)*/(f2 (x+h)))* -(f2 x)`` with ``-(l2*(f1 x)*/(f2 x)*/(f2 (x+h))*((f2 x)*/(f2 x)))``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym; Try Assumption Orelse Ring.
-Apply prod_neq_R0; Assumption.
-Qed.
-
-Lemma Rmin_pos : (x,y:R) ``0<x`` -> ``0<y`` -> ``0 < (Rmin x y)``.
-Intros; Unfold Rmin.
-Case (total_order_Rle x y); Intro; Assumption.
-Qed.
-
-Lemma maj_term1 : (x,h,eps,l1,alp_f2:R;eps_f2,alp_f1d:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((h:R)``h <> 0``->``(Rabsolu h) < alp_f1d``->``(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < (Rabsolu ((eps*(f2 x))/8))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f1d`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) < eps/4``.
-Intros.
-Assert H7 := (H3 h H6).
-Assert H8 := (H2 h H4 H5).
-Apply Rle_lt_trans with ``2/(Rabsolu (f2 x))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1))``.
-Rewrite Rabsolu_mult.
-Apply Rle_monotony_r.
-Apply Rabsolu_pos.
-Rewrite Rabsolu_Rinv; [Left; Exact H7 | Assumption].
-Apply Rlt_le_trans with ``2/(Rabsolu (f2 x))*(Rabsolu ((eps*(f2 x))/8))``.
-Apply Rlt_monotony.
-Unfold Rdiv; Apply Rmult_lt_pos; [Sup0 | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption].
-Exact H8.
-Right; Unfold Rdiv.
-Repeat Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rinv; DiscrR.
-Replace ``(Rabsolu 8)`` with ``8``.
-Replace ``8`` with ``2*4``; [Idtac | Ring].
-Rewrite Rinv_Rmult; [Idtac | DiscrR | DiscrR].
-Replace ``2*/(Rabsolu (f2 x))*((Rabsolu eps)*(Rabsolu (f2 x))*(/2*/4))`` with ``(Rabsolu eps)*/4*(2*/2)*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))``; [Idtac | Ring].
-Replace (Rabsolu eps) with eps.
-Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
-Ring.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
-Symmetry; Apply Rabsolu_right; Left; Sup.
-Qed.
-
-Lemma maj_term2 : (x,h,eps,l1,alp_f2,alp_f2t2:R;eps_f2:posreal;f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((a:R)``(Rabsolu a) < alp_f2t2``->``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``)-> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2t2`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``l1<>0`` -> ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) < eps/4``.
-Intros.
-Assert H8 := (H3 h H6).
-Assert H9 := (H2 h H5).
-Apply Rle_lt_trans with ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Rewrite Rabsolu_mult; Apply Rle_monotony.
-Apply Rabsolu_pos.
-Rewrite <- (Rabsolu_Ropp ``(f2 x)-(f2 (x+h))``); Rewrite Ropp_distr2.
-Left; Apply H9.
-Apply Rlt_le_trans with ``(Rabsolu (2*l1/((f2 x)*(f2 x))))*(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Apply Rlt_monotony_r.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Try Assumption Orelse DiscrR.
-Red; Intro H10; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
-Apply Rinv_neq_R0; Apply prod_neq_R0; Try Assumption Orelse DiscrR.
-Unfold Rdiv.
-Repeat Rewrite Rinv_Rmult; Try Assumption.
-Repeat Rewrite Rabsolu_mult.
-Replace ``(Rabsolu 2)`` with ``2``.
-Rewrite (Rmult_sym ``2``).
-Replace ``(Rabsolu l1)*((Rabsolu (/(f2 x)))*(Rabsolu (/(f2 x))))*2`` with ``(Rabsolu l1)*((Rabsolu (/(f2 x)))*((Rabsolu (/(f2 x)))*2))``; [Idtac | Ring].
-Repeat Apply Rlt_monotony.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Assumption.
-Repeat Rewrite Rabsolu_Rinv; Try Assumption.
-Rewrite <- (Rmult_sym ``2``).
-Unfold Rdiv in H8; Exact H8.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Right.
-Unfold Rsqr Rdiv.
-Do 1 Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Do 1 Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Repeat Rewrite Rabsolu_mult.
-Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
-Replace (Rabsolu eps) with eps.
-Replace ``(Rabsolu (8))`` with ``8``.
-Replace ``(Rabsolu 2)`` with ``2``.
-Replace ``8`` with ``4*2``; [Idtac | Ring].
-Rewrite Rinv_Rmult; DiscrR.
-Replace ``2*((Rabsolu l1)*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*(eps*((Rabsolu (f2 x))*(Rabsolu (f2 x)))*(/4*/2*/(Rabsolu l1)))`` with ``eps*/4*((Rabsolu l1)*/(Rabsolu l1))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*(2*/2)``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym; Try (Apply Rabsolu_no_R0; Assumption) Orelse DiscrR.
-Ring.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Symmetry; Apply Rabsolu_right; Left; Sup.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
-Qed.
-
-Lemma maj_term3 : (x,h,eps,l2,alp_f2:R;eps_f2,alp_f2d:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((h:R)``h <> 0``->``(Rabsolu h) < alp_f2d``->``(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < (Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2d`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(f1 x)<>0`` -> ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) < eps/4``.
-Intros.
-Assert H8 := (H2 h H4 H5).
-Assert H9 := (H3 h H6).
-Apply Rle_lt_trans with ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``.
-Rewrite Rabsolu_mult.
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply H8.
-Apply Rlt_le_trans with ``(Rabsolu (2*(f1 x)/((f2 x)*(f2 x))))*(Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``.
-Apply Rlt_monotony_r.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Try Assumption.
-Red; Intro H10; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
-Apply Rinv_neq_R0; Apply prod_neq_R0; DiscrR Orelse Assumption.
-Unfold Rdiv.
-Repeat Rewrite Rinv_Rmult; Try Assumption.
-Repeat Rewrite Rabsolu_mult.
-Replace ``(Rabsolu 2)`` with ``2``.
-Rewrite (Rmult_sym ``2``).
-Replace ``(Rabsolu (f1 x))*((Rabsolu (/(f2 x)))*(Rabsolu (/(f2 x))))*2`` with ``(Rabsolu (f1 x))*((Rabsolu (/(f2 x)))*((Rabsolu (/(f2 x)))*2))``; [Idtac | Ring].
-Repeat Apply Rlt_monotony.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Assumption.
-Repeat Rewrite Rabsolu_Rinv; Assumption Orelse Idtac.
-Rewrite <- (Rmult_sym ``2``).
-Unfold Rdiv in H9; Exact H9.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Right.
-Unfold Rsqr Rdiv.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Repeat Rewrite Rabsolu_mult.
-Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
-Replace (Rabsolu eps) with eps.
-Replace ``(Rabsolu (8))`` with ``8``.
-Replace ``(Rabsolu 2)`` with ``2``.
-Replace ``8`` with ``4*2``; [Idtac | Ring].
-Rewrite Rinv_Rmult; DiscrR.
-Replace ``2*((Rabsolu (f1 x))*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*((Rabsolu (f2 x))*(Rabsolu (f2 x))*eps*(/4*/2*/(Rabsolu (f1 x))))`` with ``eps*/4*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f1 x))*/(Rabsolu (f1 x)))*(2*/2)``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
-Ring.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Symmetry; Apply Rabsolu_right; Left; Sup.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
-Qed.
-
-Lemma maj_term4 : (x,h,eps,l2,alp_f2,alp_f2c:R;eps_f2:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((a:R)``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``)  -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2c`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(f1 x)<>0`` -> ``l2<>0`` -> ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x)))) < eps/4``.
-Intros.
-Assert H9 := (H2 h H5).
-Assert H10 := (H3 h H6).
-Apply Rle_lt_trans with ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Rewrite Rabsolu_mult.
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply H9.
-Apply Rlt_le_trans with ``(Rabsolu (2*l2*(f1 x)/((Rsqr (f2 x))*(f2 x))))*(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Apply Rlt_monotony_r.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Assumption Orelse Idtac.
-Red; Intro H11; Rewrite H11 in H; Elim (Rlt_antirefl ? H).
-Apply Rinv_neq_R0; Apply prod_neq_R0.
-Apply prod_neq_R0.
-DiscrR.
-Assumption.
-Assumption.
-Unfold Rdiv.
-Repeat Rewrite Rinv_Rmult; Try Assumption Orelse (Unfold Rsqr; Apply prod_neq_R0; Assumption).
-Repeat Rewrite Rabsolu_mult.
-Replace ``(Rabsolu 2)`` with ``2``.
-Replace ``2*(Rabsolu l2)*((Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 x)))))`` with ``(Rabsolu l2)*((Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*((Rabsolu (/(f2 x)))*2)))``; [Idtac | Ring].
-Replace ``(Rabsolu l2)*(Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 (x+h)))))`` with ``(Rabsolu l2)*((Rabsolu (f1 x))*(((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 (x+h)))))))``; [Idtac | Ring].
-Repeat Apply Rlt_monotony.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Unfold Rsqr; Apply prod_neq_R0;  Assumption.
-Repeat Rewrite Rabsolu_Rinv; [Idtac | Assumption | Assumption].
-Rewrite <- (Rmult_sym ``2``).
-Unfold Rdiv in H10; Exact H10.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Right; Unfold Rsqr Rdiv.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Repeat Rewrite Rabsolu_mult.
-Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
-Replace (Rabsolu eps) with eps.
-Replace ``(Rabsolu (8))`` with ``8``.
-Replace ``(Rabsolu 2)`` with ``2``.
-Replace ``8`` with ``4*2``; [Idtac | Ring].
-Rewrite Rinv_Rmult; DiscrR.
-Replace ``2*(Rabsolu l2)*((Rabsolu (f1 x))*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*((Rabsolu (f2 x))*(Rabsolu (f2 x))*(Rabsolu (f2 x))*eps*(/4*/2*/(Rabsolu (f1 x))*/(Rabsolu l2)))`` with ``eps*/4*((Rabsolu l2)*/(Rabsolu l2))*((Rabsolu (f1 x))*/(Rabsolu (f1 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*(2*/2)``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
-Ring.
-Symmetry; Apply Rabsolu_right; Left; Sup0.
-Symmetry; Apply Rabsolu_right; Left; Sup.
-Symmetry; Apply Rabsolu_right; Left; Assumption.
-Apply prod_neq_R0; Assumption Orelse DiscrR.
-Apply prod_neq_R0; Assumption.
-Qed.
-
-Lemma D_x_no_cond : (x,a:R) ``a<>0`` -> (D_x no_cond x ``x+a``).
-Intros.
-Unfold D_x no_cond.
-Split.
-Trivial.
-Apply Rminus_not_eq.
-Unfold Rminus.
-Rewrite Ropp_distr1.
-Rewrite <- Rplus_assoc.
-Rewrite Rplus_Ropp_r.
-Rewrite Rplus_Ol.
-Apply Ropp_neq; Assumption.
-Qed.
-
-Lemma Rabsolu_4 : (a,b,c,d:R) ``(Rabsolu (a+b+c+d)) <= (Rabsolu a) + (Rabsolu b) + (Rabsolu c) + (Rabsolu d)``.
-Intros.
-Apply Rle_trans with ``(Rabsolu (a+b)) + (Rabsolu (c+d))``.
-Replace ``a+b+c+d`` with ``(a+b)+(c+d)``; [Apply Rabsolu_triang | Ring].
-Apply Rle_trans with ``(Rabsolu a) + (Rabsolu b) + (Rabsolu (c+d))``.
-Apply Rle_compatibility_r.
-Apply Rabsolu_triang.
-Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility.
-Apply Rabsolu_triang.
-Qed.
-
-Lemma Rlt_4 : (a,b,c,d,e,f,g,h:R) ``a < b`` -> ``c < d`` -> ``e < f `` -> ``g < h`` -> ``a+c+e+g < b+d+f+h``.
-Intros; Apply Rlt_trans with ``b+c+e+g``.
-Repeat Apply Rlt_compatibility_r; Assumption.
-Repeat Rewrite Rplus_assoc; Apply Rlt_compatibility.
-Apply Rlt_trans with ``d+e+g``.
-Rewrite Rplus_assoc; Apply Rlt_compatibility_r; Assumption.
-Rewrite Rplus_assoc; Apply Rlt_compatibility; Apply Rlt_trans with ``f+g``.
-Apply Rlt_compatibility_r; Assumption.
-Apply Rlt_compatibility; Assumption.
-Qed.
-
-Lemma Rmin_2 : (a,b,c:R) ``a < b`` -> ``a < c`` -> ``a < (Rmin b c)``.
-Intros; Unfold Rmin; Case (total_order_Rle b c); Intro; Assumption.
-Qed.
-
-Lemma quadruple : (x:R) ``4*x == x + x + x + x``.
-Intro; Ring.
-Qed.
-
-Lemma quadruple_var : (x:R) `` x == x/4 + x/4 + x/4 + x/4``.
-Intro; Rewrite <- quadruple.
-Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m; DiscrR.
-Reflexivity.
-Qed.
-
-(**********)
-Lemma continuous_neq_0 : (f:R->R; x0:R) (continuity_pt f x0) -> ~``(f x0)==0`` -> (EXT eps : posreal | (h:R) ``(Rabsolu h) < eps`` -> ~``(f (x0+h))==0``).
-Intros; Unfold continuity_pt in H; Unfold continue_in in H; Unfold limit1_in in H; Unfold limit_in in H; Elim (H ``(Rabsolu ((f x0)/2))``).
-Intros; Elim H1; Intros.
-Exists (mkposreal x H2).
-Intros; Assert H5 := (H3 ``x0+h``).
-Cut ``(dist R_met (x0+h) x0) < x`` -> ``(dist R_met (f (x0+h)) (f x0)) < (Rabsolu ((f x0)/2))``.
-Unfold dist; Simpl; Unfold R_dist; Replace ``x0+h-x0`` with h.
-Intros; Assert H7 := (H6 H4).
-Red; Intro.
-Rewrite H8 in H7; Unfold Rminus in H7; Rewrite Rplus_Ol in H7; Rewrite Rabsolu_Ropp in H7; Unfold Rdiv in H7; Rewrite Rabsolu_mult in H7; Pattern 1 ``(Rabsolu (f x0)) `` in H7; Rewrite <- Rmult_1r in H7.
-Cut ``0<(Rabsolu (f x0))``.
-Intro; Assert H10 := (Rlt_monotony_contra ? ? ? H9 H7).
-Cut ``(Rabsolu (/2))==/2``.
-Assert Hyp:``0<2``.
-Sup0.
-Intro; Rewrite H11 in H10; Assert H12 := (Rlt_monotony ``2`` ? ? Hyp H10); Rewrite Rmult_1r in H12; Rewrite <- Rinv_r_sym in H12; [Idtac | DiscrR].
-Cut (Rlt (IZR `1`) (IZR `2`)).
-Unfold IZR; Unfold INR convert; Simpl; Intro; Elim (Rlt_antirefl ``1`` (Rlt_trans ? ? ? H13 H12)).
-Apply IZR_lt; Omega.
-Unfold Rabsolu; Case (case_Rabsolu ``/2``); Intro.
-Assert Hyp:``0<2``.
-Sup0.
-Assert H11 := (Rlt_monotony ``2`` ? ? Hyp r); Rewrite Rmult_Or in H11; Rewrite <- Rinv_r_sym in H11; [Idtac | DiscrR].
-Elim (Rlt_antirefl ``0`` (Rlt_trans ? ? ? Rlt_R0_R1 H11)).
-Reflexivity.
-Apply (Rabsolu_pos_lt ? H0).
-Ring.
-Assert H6 := (Req_EM ``x0`` ``x0+h``); Elim H6; Intro.
-Intro; Rewrite <- H7; Unfold dist R_met; Unfold R_dist; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
-Unfold Rdiv; Apply prod_neq_R0; [Assumption | Apply Rinv_neq_R0; DiscrR].
-Intro; Apply H5.
-Split.
-Unfold D_x no_cond.
-Split; Trivial Orelse Assumption.
-Assumption.
-Change ``0 < (Rabsolu ((f x0)/2))``.
-Apply Rabsolu_pos_lt; Unfold Rdiv; Apply prod_neq_R0.
-Assumption.
-Apply Rinv_neq_R0; DiscrR.
-Qed.
diff --git a/theories7/Reals/Ranalysis3.v b/theories7/Reals/Ranalysis3.v
deleted file mode 100644
index 6ce63bbc..00000000
--- a/theories7/Reals/Ranalysis3.v
+++ /dev/null
@@ -1,617 +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: Ranalysis3.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-Require Ranalysis2.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(* Division *)
-Theorem derivable_pt_lim_div : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> ~``(f2 x)==0``-> (derivable_pt_lim (div_fct f1 f2) x ``(l1*(f2 x)-l2*(f1 x))/(Rsqr (f2 x))``).
-Intros.
-Cut (derivable_pt f2 x); [Intro | Unfold derivable_pt; Apply Specif.existT with l2; Exact H0].
-Assert H2 := ((continuous_neq_0 ? ? (derivable_continuous_pt ? ? X)) H1).
-Elim H2; Clear H2; Intros eps_f2 H2.
-Unfold div_fct.
-Assert H3 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H3; Unfold continue_in in H3; Unfold limit1_in in H3; Unfold limit_in in H3; Unfold dist in H3.
-Simpl in H3; Unfold R_dist in H3.
-Elim (H3 ``(Rabsolu (f2 x))/2``); [Idtac | Unfold Rdiv; Change ``0 < (Rabsolu (f2 x))*/2``; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Sup0]].
-Clear H3; Intros alp_f2 H3.
-Cut (x0:R) ``(Rabsolu (x0-x)) < alp_f2`` ->``(Rabsolu ((f2 x0)-(f2 x))) < (Rabsolu (f2 x))/2``.
-Intro H4.
-Cut (a:R) ``(Rabsolu (a-x)) < alp_f2``->``(Rabsolu (f2 x))/2 < (Rabsolu (f2 a))``.
-Intro H5.
-Cut (a:R) ``(Rabsolu (a)) < (Rmin eps_f2 alp_f2)`` -> ``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``.
-Intro Maj.
-Unfold derivable_pt_lim; Intros.
-Elim (H ``(Rabsolu ((eps*(f2 x))/8))``); [Idtac | Unfold Rdiv; Change ``0 < (Rabsolu (eps*(f2 x)*/8))``; Apply Rabsolu_pos_lt; Repeat Apply prod_neq_R0; [Red; Intro H7; Rewrite H7 in H6; Elim (Rlt_antirefl ? H6) | Assumption | Apply Rinv_neq_R0; DiscrR]].
-Intros alp_f1d H7.
-Case (Req_EM (f1 x) R0); Intro.
-Case (Req_EM l1 R0); Intro.
-(***********************************)
-(*              Cas n° 1           *)
-(*           (f1 x)=0  l1 =0       *)
-(***********************************)
-Cut ``0 < (Rmin eps_f2 (Rmin alp_f2 alp_f1d))``; [Intro | Repeat Apply Rmin_pos; [Apply (cond_pos eps_f2) | Elim H3; Intros; Assumption | Apply (cond_pos alp_f1d)]].
-Exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10).
-Simpl; Intros.
-Assert H13 := (Rlt_le_trans ? ? ? H12 (Rmin_r ? ?)).
-Assert H14 := (Rlt_le_trans ? ? ? H12 (Rmin_l ? ?)).
-Assert H15 := (Rlt_le_trans ? ? ? H13 (Rmin_r ? ?)).
-Assert H16 := (Rlt_le_trans ? ? ? H13 (Rmin_l ? ?)).
-Assert H17 := (H7 ? H11 H15).
-Rewrite formule; [Idtac | Assumption | Assumption | Apply H2; Apply H14].
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite H8.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite H8.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite H9.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption Orelse Apply H2.
-Apply H14.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-(***********************************)
-(*              Cas n° 2           *)
-(*           (f1 x)=0  l1<>0       *)
-(***********************************)
-Assert H10 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H10.
-Unfold continue_in in H10.
-Unfold limit1_in in H10.
-Unfold limit_in in H10.
-Unfold dist in H10.
-Simpl in H10.
-Unfold R_dist in H10.
-Elim (H10 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
-Clear H10; Intros alp_f2t2 H10.
-Cut (a:R) ``(Rabsolu a) < alp_f2t2`` -> ``(Rabsolu ((f2 (x+a)) - (f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Intro H11.
-Cut ``0 < (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12).
-Simpl.
-Intros.
-Assert H15 := (Rlt_le_trans ? ? ? H14 (Rmin_r ? ?)).
-Assert H16 := (Rlt_le_trans ? ? ? H14 (Rmin_l ? ?)).
-Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
-Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)).
-Clear H14 H15 H16.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite H8.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite H8.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Apply (cond_pos alp_f1d).
-Elim H3; Intros; Assumption.
-Elim H10; Intros; Assumption.
-Intros.
-Elim H10; Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H14; Rewrite Rplus_Or.
-Unfold Rminus; Rewrite Rplus_Ropp_r.
-Rewrite Rabsolu_R0.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc.
-Repeat Apply prod_neq_R0; Try Assumption.
-Red; Intro; Rewrite H15 in H6; Elim (Rlt_antirefl ? H6).
-Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; DiscrR Orelse Assumption.
-Apply H13.
-Split.
-Apply D_x_no_cond; Assumption.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Change ``0<(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Apply Rabsolu_pos_lt; Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc; Repeat Apply prod_neq_R0.
-Red; Intro; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6).
-Assumption. 
-Assumption.
-Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; [DiscrR | DiscrR | DiscrR | Assumption].
-(***********************************)
-(*              Cas n° 3           *)
-(*     (f1 x)<>0  l1=0  l2=0       *)
-(***********************************)
-Case (Req_EM l1 R0); Intro.
-Case (Req_EM l2 R0); Intro.
-Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``); [Idtac | Apply Rabsolu_pos_lt; Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc; Repeat Apply prod_neq_R0; [Assumption | Assumption | Red; Intro; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6) | Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; DiscrR Orelse Assumption]].
-Intros alp_f2d H12.
-Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11).
-Simpl.
-Intros.
-Assert H15 := (Rlt_le_trans ? ? ? H14 (Rmin_l ? ?)).
-Assert H16 := (Rlt_le_trans ? ? ? H14 (Rmin_r ? ?)).
-Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
-Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)).
-Clear H15 H16.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite H10.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite H9.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Assumption Orelse Idtac.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Elim H3; Intros; Assumption.
-Apply (cond_pos alp_f1d).
-Apply (cond_pos alp_f2d).
-(***********************************)
-(*              Cas n° 4           *)
-(*    (f1 x)<>0  l1=0  l2<>0       *)
-(***********************************)
-Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``); [Idtac | Apply Rabsolu_pos_lt; Unfold Rsqr Rdiv; Repeat Rewrite Rinv_Rmult; Repeat Apply prod_neq_R0; Try Assumption Orelse DiscrR].
-Intros alp_f2d H11.
-Assert H12 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H12.
-Unfold continue_in in H12.
-Unfold limit1_in in H12.
-Unfold limit_in in H12.
-Unfold dist in H12.
-Simpl in H12.
-Unfold R_dist in H12.
-Elim (H12 ``(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``).
-Intros alp_f2c H13.
-Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c)))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) H14).
-Simpl; Intros.
-Assert H17 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)).
-Assert H18 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H19 (Rmin_l ? ?)).
-Assert H21 := (Rlt_le_trans ? ? ? H19 (Rmin_r ? ?)).
-Assert H22 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
-Assert H23 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
-Assert H24 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
-Clear H16 H17 H18 H19.
-Cut (a:R) ``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Intro.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite H9.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H17; Rewrite Rplus_Or.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr.
-Repeat Rewrite Rinv_Rmult; Try Assumption.
-Repeat Apply prod_neq_R0; Try Assumption.
-Red; Intro H18; Rewrite H18 in H6; Elim (Rlt_antirefl ? H6). 
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; Assumption.
-Apply Rinv_neq_R0; Assumption.
-DiscrR.
-DiscrR.
-DiscrR.
-DiscrR.
-DiscrR.
-Apply prod_neq_R0; [DiscrR | Assumption].
-Elim H13; Intros.
-Apply H19.
-Split.
-Apply D_x_no_cond; Assumption.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Elim H3; Intros; Assumption.
-Apply (cond_pos alp_f1d).
-Apply (cond_pos alp_f2d).
-Elim H13; Intros; Assumption.
-Change ``0 < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Apply Rabsolu_pos_lt.
-Unfold Rsqr Rdiv.
-Repeat Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
-Repeat Apply prod_neq_R0; Try Assumption.
-Red; Intro H13; Rewrite H13 in H6; Elim (Rlt_antirefl ? H6). 
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; Assumption.
-Apply Rinv_neq_R0; Assumption.
-Apply prod_neq_R0; [DiscrR | Assumption].
-Red; Intro H11; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6). 
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rinv_neq_R0; Assumption.
-(***********************************)
-(*              Cas n° 5           *)
-(*    (f1 x)<>0  l1<>0  l2=0       *)
-(***********************************)
-Case (Req_EM l2 R0); Intro.
-Assert H11 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H11.
-Unfold continue_in in H11.
-Unfold limit1_in in H11.
-Unfold limit_in in H11.
-Unfold dist in H11.
-Simpl in H11.
-Unfold R_dist in H11.
-Elim (H11 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
-Clear H11; Intros alp_f2t2 H11.
-Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``).
-Intros alp_f2d H12.
-Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2)))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13).
-Simpl.
-Intros.
-Cut (a:R) ``(Rabsolu a)<alp_f2t2`` -> ``(Rabsolu ((f2 (x+a))-(f2 x)))<(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Intro.
-Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
-Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
-Assert H21 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)).
-Assert H22 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
-Assert H23 := (Rlt_le_trans ? ? ? H21 (Rmin_l ? ?)).
-Assert H24 := (Rlt_le_trans ? ? ? H21 (Rmin_r ? ?)).
-Clear H15 H17 H18 H21.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite H10.
-Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
-Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
-Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
-Rewrite <- Rabsolu_mult.
-Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H17; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
-Unfold Rsqr.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H18; Rewrite H18 in H6; Elim (Rlt_antirefl ? H6)).
-Elim H11; Intros.
-Apply H19.
-Split.
-Apply D_x_no_cond; Assumption.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Elim H3; Intros; Assumption.
-Apply (cond_pos alp_f1d). 
-Apply (cond_pos alp_f2d).
-Elim H11; Intros; Assumption.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H12; Rewrite H12 in H6; Elim (Rlt_antirefl ? H6)).
-Change ``0 < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H12; Rewrite H12 in H6; Elim (Rlt_antirefl ? H6)).
-(***********************************)
-(*              Cas n° 6           *)
-(*    (f1 x)<>0  l1<>0  l2<>0      *)
-(***********************************)
-Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``).
-Intros alp_f2d H11.
-Assert H12 := (derivable_continuous_pt ? ? X).
-Unfold continuity_pt in H12.
-Unfold continue_in in H12.
-Unfold limit1_in in H12.
-Unfold limit_in in H12.
-Unfold dist in H12.
-Simpl in H12.
-Unfold R_dist in H12.
-Elim (H12 ``(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``).
-Intros alp_f2c H13.
-Elim (H12 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
-Intros alp_f2t2 H14.
-Cut ``0 < (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2))``.
-Intro.
-Exists (mkposreal (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2)) H15).
-Simpl.
-Intros.
-Assert H18 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
-Assert H19 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
-Assert H20 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
-Assert H21 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)).
-Assert H22 := (Rlt_le_trans ? ? ? H19 (Rmin_l ? ?)).
-Assert H23 := (Rlt_le_trans ? ? ? H19 (Rmin_r ? ?)).
-Assert H24 := (Rlt_le_trans ? ? ? H20 (Rmin_l ? ?)).
-Assert H25 := (Rlt_le_trans ? ? ? H20 (Rmin_r ? ?)).
-Assert H26 := (Rlt_le_trans ? ? ? H21 (Rmin_l ? ?)).
-Assert H27 := (Rlt_le_trans ? ? ? H21 (Rmin_r ? ?)).
-Clear H17 H18 H19 H20 H21.
-Cut (a:R) ``(Rabsolu a) < alp_f2t2`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
-Cut (a:R) ``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
-Intros.
-Rewrite formule; Try Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
-Unfold Rminus.
-Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
-Apply Rabsolu_4.
-Repeat Rewrite Rabsolu_mult.
-Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
-Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
-Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
-Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
-Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
-Intros.
-Apply Rlt_4; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Rewrite <- Rabsolu_mult.
-Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption.
-Apply H2; Assumption.
-Apply Rmin_2; Assumption.
-Right; Symmetry; Apply quadruple_var.
-Apply H2; Assumption.
-Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H18; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H28; Rewrite H28 in H6; Elim (Rlt_antirefl ? H6)).
-Apply prod_neq_R0; [DiscrR | Assumption].
-Apply prod_neq_R0; [DiscrR | Assumption].
-Assumption.
-Elim H13; Intros.
-Apply H20.
-Split.
-Apply D_x_no_cond; Assumption.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Intros.
-Case (Req_EM a R0); Intro.
-Rewrite H18; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H28; Rewrite H28 in H6; Elim (Rlt_antirefl ? H6)).
-DiscrR.
-Assumption.
-Elim H14; Intros.
-Apply H20.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply Rminus_not_eq_right.
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Replace ``x+a-x`` with a; [Assumption | Ring].
-Repeat Apply Rmin_pos.
-Apply (cond_pos eps_f2).
-Elim H3; Intros; Assumption.
-Apply (cond_pos alp_f1d).
-Apply (cond_pos alp_f2d).
-Elim H13; Intros; Assumption.
-Elim H14; Intros; Assumption.
-Change ``0 < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``; Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H14; Rewrite H14 in H6; Elim (Rlt_antirefl ? H6)).
-Change ``0 < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``; Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H13; Rewrite H13 in H6; Elim (Rlt_antirefl ? H6)).
-Apply prod_neq_R0; [DiscrR | Assumption].
-Apply prod_neq_R0; [DiscrR | Assumption].
-Assumption.
-Apply Rabsolu_pos_lt.
-Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; [Idtac | DiscrR | Assumption].
-Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H11; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6)).
-Intros.
-Unfold Rdiv.
-Apply Rlt_monotony_contra with ``(Rabsolu (f2 (x+a)))``.
-Apply Rabsolu_pos_lt; Apply H2.
-Apply Rlt_le_trans with (Rmin eps_f2 alp_f2).
-Assumption.
-Apply Rmin_l.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with (Rabsolu (f2 x)).
-Apply Rabsolu_pos_lt; Assumption.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym (Rabsolu (f2 x))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Apply Rlt_monotony_contra with ``/2``.
-Apply Rlt_Rinv; Sup0.
-Repeat Rewrite (Rmult_sym ``/2``).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Unfold Rdiv in H5; Apply H5.
-Replace ``x+a-x`` with a.
-Assert H7 := (Rlt_le_trans ? ? ? H6 (Rmin_r ? ?)); Assumption.
-Ring.
-DiscrR.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Apply H2.
-Assert H7 := (Rlt_le_trans ? ? ? H6 (Rmin_l ? ?)); Assumption.
-Intros.
-Assert H6 := (H4 a H5).
-Rewrite <- (Rabsolu_Ropp ``(f2 a)-(f2 x)``) in H6.
-Rewrite Ropp_distr2 in H6.
-Assert H7 := (Rle_lt_trans ? ? ? (Rabsolu_triang_inv ? ?) H6).
-Apply Rlt_anti_compatibility with ``-(Rabsolu (f2 a)) + (Rabsolu (f2 x))/2``.
-Rewrite Rplus_assoc.
-Rewrite <- double_var.
-Do 2 Rewrite (Rplus_sym ``-(Rabsolu (f2 a))``).
-Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Unfold Rminus in H7; Assumption.
-Intros.
-Case (Req_EM x x0); Intro.
-Rewrite <- H5; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Sup0].
-Elim H3; Intros.
-Apply H7.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Assumption.
-Assumption.
-Qed.
-
-Lemma derivable_pt_div : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> ``(f2 x)<>0`` -> (derivable_pt (div_fct f1 f2) x).
-Unfold derivable_pt.
-Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Apply Specif.existT with ``(x0*(f2 x)-x1*(f1 x))/(Rsqr (f2 x))``.
-Apply derivable_pt_lim_div; Assumption.
-Qed.
-
-Lemma derivable_div : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> ((x:R)``(f2 x)<>0``) -> (derivable (div_fct f1 f2)).
-Unfold derivable; Intros.
-Apply (derivable_pt_div ? ? ? (X x) (X0 x) (H x)).
-Qed.
-
-Lemma derive_pt_div : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x);na:``(f2 x)<>0``) ``(derive_pt (div_fct f1 f2) x (derivable_pt_div ? ? ? pr1 pr2 na)) == ((derive_pt f1 x pr1)*(f2 x)-(derive_pt f2 x pr2)*(f1 x))/(Rsqr (f2 x))``.
-Intros.
-Assert H := (derivable_derive f1 x pr1).
-Assert H0 := (derivable_derive f2 x pr2).
-Assert H1 := (derivable_derive (div_fct f1 f2) x (derivable_pt_div ? ? ? pr1 pr2 na)).
-Elim H; Clear H; Intros l1 H.
-Elim H0; Clear H0; Intros l2 H0.
-Elim H1; Clear H1; Intros l H1.
-Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
-Assert H3 := (projT2 ? ? pr1).
-Unfold derive_pt in H; Rewrite H in H3.
-Assert H4 := (projT2 ? ? pr2).
-Unfold derive_pt in H0; Rewrite H0 in H4.
-Apply derivable_pt_lim_div; Assumption.
-Qed.
diff --git a/theories7/Reals/Ranalysis4.v b/theories7/Reals/Ranalysis4.v
deleted file mode 100644
index 061854dc..00000000
--- a/theories7/Reals/Ranalysis4.v
+++ /dev/null
@@ -1,313 +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: Ranalysis4.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis1.
-Require Ranalysis3.
-Require Exp_prop.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(**********)
-Lemma derivable_pt_inv : (f:R->R;x:R) ``(f x)<>0`` -> (derivable_pt f x) -> (derivable_pt (inv_fct f) x).
-Intros; Cut (derivable_pt (div_fct (fct_cte R1) f) x) -> (derivable_pt (inv_fct f) x).
-Intro; Apply X0.
-Apply derivable_pt_div.
-Apply derivable_pt_const.
-Assumption.
-Assumption.
-Unfold div_fct inv_fct fct_cte; Intro; Elim X0; Intros; Unfold derivable_pt; Apply Specif.existT with x0; Unfold derivable_pt_abs; Unfold derivable_pt_lim; Unfold derivable_pt_abs in p; Unfold derivable_pt_lim in p; Intros; Elim (p eps H0); Intros; Exists x1; Intros; Unfold Rdiv in H1; Unfold Rdiv; Rewrite <- (Rmult_1l ``/(f x)``); Rewrite <- (Rmult_1l ``/(f (x+h))``).
-Apply H1; Assumption.
-Qed.
-
-(**********)
-Lemma pr_nu_var : (f,g:R->R;x:R;pr1:(derivable_pt f x);pr2:(derivable_pt g x)) f==g -> (derive_pt f x pr1) == (derive_pt g x pr2).
-Unfold derivable_pt derive_pt; Intros.
-Elim pr1; Intros.
-Elim pr2; Intros.
-Simpl.
-Rewrite H in p.
-Apply unicite_limite with g x; Assumption.
-Qed.
-
-(**********)
-Lemma pr_nu_var2 : (f,g:R->R;x:R;pr1:(derivable_pt f x);pr2:(derivable_pt g x)) ((h:R)(f h)==(g h)) -> (derive_pt f x pr1) == (derive_pt g x pr2).
-Unfold derivable_pt derive_pt; Intros.
-Elim pr1; Intros.
-Elim pr2; Intros.
-Simpl.
-Assert H0 := (unicite_step2 ? ? ? p). 
-Assert H1 := (unicite_step2 ? ? ? p0). 
-Cut (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h <> 0`` x1 ``0``).
-Intro; Assert H3 := (unicite_step1 ? ? ? ? H0 H2). 
-Assumption.
-Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Unfold limit1_in in H1; Unfold limit_in in H1; Unfold dist in H1; Simpl in H1; Unfold R_dist in H1.
-Intros; Elim (H1 eps H2); Intros.
-Elim H3; Intros.
-Exists x2.
-Split.
-Assumption.
-Intros; Do 2 Rewrite H; Apply H5; Assumption.
-Qed.
-
-(**********)
-Lemma derivable_inv : (f:R->R) ((x:R)``(f x)<>0``)->(derivable f)->(derivable (inv_fct f)).
-Intros.
-Unfold derivable; Intro.
-Apply derivable_pt_inv.
-Apply (H x).
-Apply (X x).
-Qed.
-
-Lemma derive_pt_inv : (f:R->R;x:R;pr:(derivable_pt f x);na:``(f x)<>0``) (derive_pt (inv_fct f) x (derivable_pt_inv f x na pr)) == ``-(derive_pt f x pr)/(Rsqr (f x))``.
-Intros; Replace (derive_pt (inv_fct f) x (derivable_pt_inv f x na pr)) with (derive_pt (div_fct (fct_cte R1) f) x (derivable_pt_div (fct_cte R1) f x (derivable_pt_const R1 x) pr na)).
-Rewrite derive_pt_div; Rewrite derive_pt_const; Unfold fct_cte; Rewrite Rmult_Ol; Rewrite Rmult_1r; Unfold Rminus; Rewrite Rplus_Ol; Reflexivity.
-Apply pr_nu_var2.
-Intro; Unfold div_fct fct_cte inv_fct.
-Unfold Rdiv; Ring.
-Qed.
-
-(* Rabsolu *)
-Lemma Rabsolu_derive_1 : (x:R) ``0<x`` -> (derivable_pt_lim Rabsolu x ``1``).
-Intros.
-Unfold derivable_pt_lim; Intros.
-Exists (mkposreal x H); Intros.
-Rewrite (Rabsolu_right x).
-Rewrite (Rabsolu_right ``x+h``).
-Rewrite Rplus_sym.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r.
-Rewrite Rplus_Or; Unfold Rdiv; Rewrite <- Rinv_r_sym.
-Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H0.
-Apply H1.
-Apply Rle_sym1.
-Case (case_Rabsolu h); Intro.
-Rewrite (Rabsolu_left h r) in H2.
-Left; Rewrite Rplus_sym; Apply Rlt_anti_compatibility with ``-h``; Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Apply H2.
-Apply ge0_plus_ge0_is_ge0.
-Left; Apply H.
-Apply Rle_sym2; Apply r.
-Left; Apply H.
-Qed.
-
-Lemma Rabsolu_derive_2 : (x:R) ``x<0`` -> (derivable_pt_lim Rabsolu x ``-1``).
-Intros.
-Unfold derivable_pt_lim; Intros.
-Cut ``0< -x``.
-Intro; Exists (mkposreal ``-x`` H1); Intros.
-Rewrite (Rabsolu_left x).
-Rewrite (Rabsolu_left ``x+h``).
-Rewrite Rplus_sym.
-Rewrite Ropp_distr1.
-Unfold Rminus; Rewrite Ropp_Ropp; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l.
-Rewrite Rplus_Or; Unfold Rdiv.
-Rewrite Ropp_mul1.
-Rewrite <- Rinv_r_sym.
-Rewrite Ropp_Ropp; Rewrite Rplus_Ropp_l; Rewrite Rabsolu_R0; Apply H0.
-Apply H2.
-Case (case_Rabsolu h); Intro.
-Apply Ropp_Rlt.
-Rewrite Ropp_O; Rewrite Ropp_distr1; Apply gt0_plus_gt0_is_gt0.
-Apply H1.
-Apply Rgt_RO_Ropp; Apply r.
-Rewrite (Rabsolu_right h r) in H3.
-Apply Rlt_anti_compatibility with ``-x``; Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Apply H3.
-Apply H.
-Apply Rgt_RO_Ropp; Apply H.
-Qed.
-
-(* Rabsolu is derivable for all x <> 0 *)
-Lemma derivable_pt_Rabsolu : (x:R) ``x<>0`` -> (derivable_pt Rabsolu x).
-Intros.
-Case (total_order_T x R0); Intro.
-Elim s; Intro.
-Unfold derivable_pt; Apply Specif.existT with ``-1``.
-Apply (Rabsolu_derive_2 x a).
-Elim H; Exact b.
-Unfold derivable_pt; Apply Specif.existT with ``1``.
-Apply (Rabsolu_derive_1 x r).
-Qed.
-
-(* Rabsolu is continuous for all x *)
-Lemma continuity_Rabsolu : (continuity Rabsolu).
-Unfold continuity; Intro.
-Case (Req_EM x R0); Intro.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Exists eps; Split.
-Apply H0.
-Intros; Rewrite H; Rewrite Rabsolu_R0; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Elim H1; Intros; Rewrite H in H3; Unfold Rminus in H3; Rewrite Ropp_O in H3; Rewrite Rplus_Or in H3; Apply H3.
-Apply derivable_continuous_pt; Apply (derivable_pt_Rabsolu x H).
-Qed.
-
-(* Finite sums : Sum a_k x^k *)
-Lemma continuity_finite_sum : (An:nat->R;N:nat) (continuity [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N)).
-Intros; Unfold continuity; Intro.
-Induction N.
-Simpl.
-Apply continuity_pt_const.
-Unfold constant; Intros; Reflexivity.
-Replace [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` (S N)) with (plus_fct [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) [y:R]``(An (S N))*(pow y (S N))``).
-Apply continuity_pt_plus.
-Apply HrecN.
-Replace [y:R]``(An (S N))*(pow y (S N))`` with (mult_real_fct (An (S N)) [y:R](pow y (S N))).
-Apply continuity_pt_scal.
-Apply derivable_continuous_pt.
-Apply derivable_pt_pow.
-Reflexivity.
-Reflexivity.
-Qed.
-
-Lemma derivable_pt_lim_fs : (An:nat->R;x:R;N:nat) (lt O N) -> (derivable_pt_lim [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N))).
-Intros; Induction N.
-Elim (lt_n_n ? H).
-Cut N=O\/(lt O N).
-Intro; Elim H0; Intro.
-Rewrite H1.
-Simpl.
-Replace [y:R]``(An O)*1+(An (S O))*(y*1)`` with (plus_fct (fct_cte ``(An O)*1``) (mult_real_fct ``(An (S O))`` (mult_fct id (fct_cte R1)))).
-Replace ``1*(An (S O))*1`` with ``0+(An (S O))*(1*(fct_cte R1 x)+(id x)*0)``.
-Apply derivable_pt_lim_plus.
-Apply derivable_pt_lim_const.
-Apply derivable_pt_lim_scal.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte id; Ring.
-Reflexivity.
-Replace [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` (S N)) with (plus_fct [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) [y:R]``(An (S N))*(pow y (S N))``).
-Replace (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred (S N))) with (Rplus (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N)) ``(An (S N))*((INR (S (pred (S N))))*(pow x (pred (S N))))``).
-Apply derivable_pt_lim_plus.
-Apply HrecN.
-Assumption.
-Replace [y:R]``(An (S N))*(pow y (S N))`` with (mult_real_fct (An (S N)) [y:R](pow y (S N))).
-Apply derivable_pt_lim_scal.
-Replace (pred (S N)) with N; [Idtac | Reflexivity].
-Pattern 3 N; Replace N with (pred (S N)).
-Apply derivable_pt_lim_pow.
-Reflexivity.
-Reflexivity.
-Cut (pred (S N)) = (S (pred N)).
-Intro; Rewrite H2.
-Rewrite tech5.
-Apply Rplus_plus_r.
-Rewrite <- H2.
-Replace (pred (S N)) with N; [Idtac | Reflexivity].
-Ring.
-Simpl.
-Apply S_pred with O; Assumption.
-Unfold plus_fct.
-Simpl; Reflexivity.
-Inversion H.
-Left; Reflexivity.
-Right; Apply lt_le_trans with (1); [Apply lt_O_Sn | Assumption].
-Qed.
-
-Lemma derivable_pt_lim_finite_sum : (An:(nat->R); x:R; N:nat) (derivable_pt_lim [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x (Cases N of O => R0 | _ => (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N)) end)).
-Intros.
-Induction N.
-Simpl.
-Rewrite Rmult_1r.
-Replace [_:R]``(An O)`` with (fct_cte (An O)); [Apply derivable_pt_lim_const | Reflexivity].
-Apply derivable_pt_lim_fs; Apply lt_O_Sn.
-Qed.
-
-Lemma derivable_pt_finite_sum : (An:nat->R;N:nat;x:R) (derivable_pt [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x).
-Intros.
-Unfold derivable_pt.
-Assert H := (derivable_pt_lim_finite_sum An x N).
-Induction N.
-Apply Specif.existT with R0; Apply H.
-Apply Specif.existT with (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred (S N))); Apply H.
-Qed.
-
-Lemma derivable_finite_sum : (An:nat->R;N:nat) (derivable [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N)).
-Intros; Unfold derivable; Intro; Apply derivable_pt_finite_sum.
-Qed.
-
-(* Regularity of hyperbolic functions *)
-Lemma derivable_pt_lim_cosh : (x:R) (derivable_pt_lim cosh x ``(sinh x)``).
-Intro.
-Unfold cosh sinh; Unfold Rdiv.
-Replace [x0:R]``((exp x0)+(exp ( -x0)))*/2`` with (mult_fct (plus_fct exp (comp exp (opp_fct id))) (fct_cte ``/2``)); [Idtac | Reflexivity].
-Replace ``((exp x)-(exp ( -x)))*/2`` with ``((exp x)+((exp (-x))*-1))*((fct_cte (Rinv 2)) x)+((plus_fct exp (comp exp (opp_fct id))) x)*0``. 
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_plus.
-Apply derivable_pt_lim_exp.
-Apply derivable_pt_lim_comp.
-Apply derivable_pt_lim_opp.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_exp.
-Apply derivable_pt_lim_const.
-Unfold plus_fct mult_real_fct comp opp_fct id fct_cte; Ring.
-Qed.
-
-Lemma derivable_pt_lim_sinh : (x:R) (derivable_pt_lim sinh x ``(cosh x)``).
-Intro.
-Unfold cosh sinh; Unfold Rdiv.
-Replace [x0:R]``((exp x0)-(exp ( -x0)))*/2`` with (mult_fct (minus_fct exp (comp exp (opp_fct id))) (fct_cte ``/2``)); [Idtac | Reflexivity].
-Replace ``((exp x)+(exp ( -x)))*/2`` with ``((exp x)-((exp (-x))*-1))*((fct_cte (Rinv 2)) x)+((minus_fct exp (comp exp (opp_fct id))) x)*0``. 
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_exp.
-Apply derivable_pt_lim_comp.
-Apply derivable_pt_lim_opp.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_exp.
-Apply derivable_pt_lim_const.
-Unfold plus_fct mult_real_fct comp opp_fct id fct_cte; Ring.
-Qed.
-
-Lemma derivable_pt_exp : (x:R) (derivable_pt exp x).
-Intro.
-Unfold derivable_pt.
-Apply Specif.existT with (exp x).
-Apply derivable_pt_lim_exp.
-Qed.
-
-Lemma derivable_pt_cosh : (x:R) (derivable_pt cosh x).
-Intro.
-Unfold derivable_pt.
-Apply Specif.existT with (sinh x).
-Apply derivable_pt_lim_cosh.
-Qed.
-
-Lemma derivable_pt_sinh : (x:R) (derivable_pt sinh x).
-Intro.
-Unfold derivable_pt.
-Apply Specif.existT with (cosh x).
-Apply derivable_pt_lim_sinh.
-Qed.
-
-Lemma derivable_exp : (derivable exp).
-Unfold derivable; Apply derivable_pt_exp.
-Qed.
-
-Lemma derivable_cosh : (derivable cosh).
-Unfold derivable; Apply derivable_pt_cosh.
-Qed.
-
-Lemma derivable_sinh : (derivable sinh).
-Unfold derivable; Apply derivable_pt_sinh.
-Qed.
-
-Lemma derive_pt_exp : (x:R) (derive_pt exp x (derivable_pt_exp x))==(exp x).
-Intro; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_exp.
-Qed.
-
-Lemma derive_pt_cosh : (x:R) (derive_pt cosh x (derivable_pt_cosh x))==(sinh x).
-Intro; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_cosh.
-Qed.
-
-Lemma derive_pt_sinh : (x:R) (derive_pt sinh x (derivable_pt_sinh x))==(cosh x).
-Intro; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_sinh.
-Qed.
diff --git a/theories7/Reals/Raxioms.v b/theories7/Reals/Raxioms.v
deleted file mode 100644
index caf8524c..00000000
--- a/theories7/Reals/Raxioms.v
+++ /dev/null
@@ -1,172 +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: Raxioms.v,v 1.2.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
-
-(*********************************************************)
-(**    Axiomatisation of the classical reals             *)
-(*********************************************************)
-
-Require Export ZArith_base.
-V7only [
-Require Export Rsyntax.
-Import R_scope.
-].
-Open Local Scope R_scope.
-
-V7only [
-(*********************************************************)
-(*   Compatibility                                       *)
-(*********************************************************)
-Notation sumboolT := Specif.sumbool.
-Notation leftT := Specif.left.
-Notation rightT := Specif.right.
-Notation sumorT := Specif.sumor.
-Notation inleftT := Specif.inleft.
-Notation inrightT := Specif.inright.
-Notation sigTT := Specif.sigT.
-Notation existTT := Specif.existT.
-Notation SigT := Specif.sigT.
-].
-
-(*********************************************************)
-(*               Field axioms                            *)
-(*********************************************************)
-
-(*********************************************************)
-(**      Addition                                        *)
-(*********************************************************)
-
-(**********)
-Axiom Rplus_sym:(r1,r2:R)``r1+r2==r2+r1``.
-Hints Resolve Rplus_sym : real.
-
-(**********)
-Axiom Rplus_assoc:(r1,r2,r3:R)``(r1+r2)+r3==r1+(r2+r3)``.
-Hints Resolve Rplus_assoc : real.
-
-(**********)
-Axiom Rplus_Ropp_r:(r:R)``r+(-r)==0``.
-Hints Resolve Rplus_Ropp_r : real v62.
-
-(**********)
-Axiom Rplus_Ol:(r:R)``0+r==r``.
-Hints Resolve Rplus_Ol : real.
-
-(***********************************************************)       
-(**       Multiplication                                   *)
-(***********************************************************)
-
-(**********)
-Axiom Rmult_sym:(r1,r2:R)``r1*r2==r2*r1``.
-Hints Resolve Rmult_sym : real v62. 
-
-(**********)
-Axiom Rmult_assoc:(r1,r2,r3:R)``(r1*r2)*r3==r1*(r2*r3)``.
-Hints Resolve Rmult_assoc : real v62.
-
-(**********)
-Axiom Rinv_l:(r:R)``r<>0``->``(/r)*r==1``.
-Hints Resolve Rinv_l : real.
-
-(**********)
-Axiom Rmult_1l:(r:R)``1*r==r``.
-Hints Resolve Rmult_1l : real.
-
-(**********)
-Axiom R1_neq_R0:``1<>0``.
-Hints Resolve R1_neq_R0 : real.
-
-(*********************************************************)
-(**      Distributivity                                  *)
-(*********************************************************)
-
-(**********)
-Axiom Rmult_Rplus_distr:(r1,r2,r3:R)``r1*(r2+r3)==(r1*r2)+(r1*r3)``.
-Hints Resolve Rmult_Rplus_distr : real v62.
-
-(*********************************************************)
-(**      Order axioms                                    *)
-(*********************************************************)
-(*********************************************************)
-(**      Total Order                                     *)
-(*********************************************************)
-
-(**********)
-Axiom total_order_T:(r1,r2:R)(sumorT (sumboolT ``r1<r2`` r1==r2) ``r1>r2``).
-
-(*********************************************************)
-(**      Lower                                           *)
-(*********************************************************)
-
-(**********)
-Axiom Rlt_antisym:(r1,r2:R)``r1<r2`` -> ~ ``r2<r1``.
-
-(**********)
-Axiom Rlt_trans:(r1,r2,r3:R)
-  ``r1<r2``->``r2<r3``->``r1<r3``.
-
-(**********)
-Axiom Rlt_compatibility:(r,r1,r2:R)``r1<r2``->``r+r1<r+r2``.
-
-(**********)
-Axiom Rlt_monotony:(r,r1,r2:R)``0<r``->``r1<r2``->``r*r1<r*r2``.
-
-Hints Resolve Rlt_antisym Rlt_compatibility Rlt_monotony : real.
-
-(**********************************************************) 
-(**      Injection from N to R                            *)
-(**********************************************************)
-
-(**********)
-Fixpoint INR [n:nat]:R:=(Cases n of
-                          O      => ``0``
-                         |(S O)  => ``1``
-                         |(S n)  => ``(INR n)+1``
-                        end).  
-Arguments Scope INR [nat_scope].
-
-
-(**********************************************************) 
-(**      Injection from [Z] to [R]                        *)
-(**********************************************************)
-
-(**********)
-Definition IZR:Z->R:=[z:Z](Cases z of
-                         ZERO      => ``0``
-                        |(POS n) => (INR (convert n))
-                        |(NEG n) => ``-(INR (convert n))``
-                           end).  
-Arguments Scope IZR [Z_scope].
-
-(**********************************************************)
-(**      [R] Archimedian                                  *)
-(**********************************************************)
-
-(**********)
-Axiom archimed:(r:R)``(IZR (up r)) > r``/\``(IZR (up r))-r <= 1``.
-
-(**********************************************************)
-(**      [R] Complete                                     *)
-(**********************************************************)
-
-(**********)
-Definition is_upper_bound:=[E:R->Prop][m:R](x:R)(E x)->``x <= m``.
-
-(**********)
-Definition bound:=[E:R->Prop](ExT [m:R](is_upper_bound E m)).
-
-(**********)
-Definition is_lub:=[E:R->Prop][m:R]
-    (is_upper_bound E m)/\(b:R)(is_upper_bound E b)->``m <= b``.
-
-(**********)
-Axiom complet:(E:R->Prop)(bound E)->
-              (ExT [x:R] (E x))->
-              (sigTT R [m:R](is_lub E m)).
-
diff --git a/theories7/Reals/Rbase.v b/theories7/Reals/Rbase.v
deleted file mode 100644
index 54226206..00000000
--- a/theories7/Reals/Rbase.v
+++ /dev/null
@@ -1,14 +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: Rbase.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
-
-Require Export Rdefinitions.
-Require Export Raxioms.
-Require Export RIneq.
-Require Export DiscrR.
diff --git a/theories7/Reals/Rbasic_fun.v b/theories7/Reals/Rbasic_fun.v
deleted file mode 100644
index 3d143e34..00000000
--- a/theories7/Reals/Rbasic_fun.v
+++ /dev/null
@@ -1,476 +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: Rbasic_fun.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
-
-(*********************************************************)
-(**          Complements for the real numbers            *)
-(*                                                       *)
-(*********************************************************)
-
-Require Rbase.
-Require R_Ifp.
-Require Fourier.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Implicit Variable Type r:R.
-
-(*******************************)
-(**          Rmin              *)
-(*******************************)
-
-(*********)
-Definition Rmin :R->R->R:=[x,y:R]
-  Cases (total_order_Rle x y) of 
-    (leftT _)  => x
-  | (rightT _) => y
-  end.
-
-(*********)
-Lemma Rmin_Rgt_l:(r1,r2,r:R)(Rgt (Rmin r1 r2) r) ->
-    ((Rgt r1 r)/\(Rgt r2 r)).
-Intros r1 r2 r;Unfold Rmin;Case (total_order_Rle r1 r2);Intros.
-Split.
-Assumption.
-Unfold Rgt;Unfold Rgt in H;Exact (Rlt_le_trans r r1 r2 H r0).
-Split.
-Generalize (not_Rle r1 r2 n);Intro;Exact (Rgt_trans r1 r2 r H0 H).
-Assumption.
-Qed.
-
-(*********)
-Lemma Rmin_Rgt_r:(r1,r2,r:R)(((Rgt r1 r)/\(Rgt r2 r)) -> 
-         (Rgt (Rmin r1 r2) r)).
-Intros;Unfold Rmin;Case (total_order_Rle r1 r2);Elim H;Clear H;Intros;
- Assumption.
-Qed.
-
-(*********)
-Lemma Rmin_Rgt:(r1,r2,r:R)(Rgt (Rmin r1 r2) r)<->
-    ((Rgt r1 r)/\(Rgt r2 r)).
-Intros; Split.
-Exact (Rmin_Rgt_l r1 r2 r).
-Exact (Rmin_Rgt_r r1 r2 r).
-Qed.
-
-(*********)
-Lemma Rmin_l : (x,y:R) ``(Rmin x y)<=x``.
-Intros; Unfold Rmin; Case (total_order_Rle x y); Intro H1; [Right; Reflexivity | Auto with real].
-Qed.
- 
-(*********)
-Lemma Rmin_r : (x,y:R) ``(Rmin x y)<=y``.
-Intros; Unfold Rmin; Case (total_order_Rle x y); Intro H1; [Assumption | Auto with real].
-Qed.
-
-(*********)
-Lemma Rmin_sym : (a,b:R) (Rmin a b)==(Rmin b a).
-Intros; Unfold Rmin; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse (Apply Rle_antisym; Assumption Orelse Auto with real).
-Qed.
-
-(*********)
-Lemma Rmin_stable_in_posreal : (x,y:posreal) ``0<(Rmin x y)``.
-Intros; Apply Rmin_Rgt_r; Split; [Apply (cond_pos x) | Apply (cond_pos y)].
-Qed.
-
-(*******************************)
-(**          Rmax              *)
-(*******************************)
-
-(*********)
-Definition Rmax :R->R->R:=[x,y:R]
-  Cases (total_order_Rle x y) of 
-    (leftT _)  => y
-  | (rightT _) => x
-  end.
-
-(*********)
-Lemma Rmax_Rle:(r1,r2,r:R)(Rle r (Rmax r1 r2))<->
-    ((Rle r r1)\/(Rle r r2)).
-Intros;Split.
-Unfold Rmax;Case (total_order_Rle r1 r2);Intros;Auto.
-Intro;Unfold Rmax;Case (total_order_Rle r1 r2);Elim H;Clear H;Intros;Auto.
-Apply (Rle_trans r r1 r2);Auto.
-Generalize (not_Rle r1 r2 n);Clear n;Intro;Unfold Rgt in H0;
- Apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)).
-Qed.
-
-Lemma RmaxLess1: (r1, r2 : R)  (Rle r1 (Rmax r1 r2)).
-Intros r1 r2; Unfold Rmax; Case (total_order_Rle r1 r2); Auto with real.
-Qed.
- 
-Lemma RmaxLess2: (r1, r2 : R)  (Rle r2 (Rmax r1 r2)).
-Intros r1 r2; Unfold Rmax; Case (total_order_Rle r1 r2); Auto with real.
-Qed.
- 
-Lemma RmaxSym: (p, q : R)  (Rmax p q) == (Rmax q p).
-Intros p q; Unfold Rmax;
- Case (total_order_Rle p q); Case (total_order_Rle q p); Auto; Intros H1 H2;
- Apply Rle_antisym; Auto with real.
-Qed.
-
-Lemma RmaxRmult:
- (p, q, r : R)
- (Rle R0 r) ->  (Rmax (Rmult r p) (Rmult r q)) == (Rmult r (Rmax p q)).
-Intros p q r H; Unfold Rmax.
-Case (total_order_Rle p q); Case (total_order_Rle (Rmult r p) (Rmult r q));
- Auto; Intros H1 H2; Auto.
-Case H; Intros E1.
-Case H1; Auto with real.
-Rewrite <- E1; Repeat Rewrite Rmult_Ol; Auto.
-Case H; Intros E1.
-Case H2; Auto with real.
-Apply Rle_monotony_contra with z := r; Auto.
-Rewrite <- E1; Repeat Rewrite Rmult_Ol; Auto.
-Qed.
-
-Lemma Rmax_stable_in_negreal : (x,y:negreal) ``(Rmax x y)<0``.
-Intros; Unfold Rmax; Case (total_order_Rle x y); Intro; [Apply (cond_neg y) | Apply (cond_neg x)].
-Qed.
-
-(*******************************)
-(**          Rabsolu           *)
-(*******************************)
-
-(*********)
-Lemma case_Rabsolu:(r:R)(sumboolT (Rlt r R0) (Rge r R0)). 
-Intro;Generalize (total_order_Rle R0 r);Intro X;Elim X;Intro;Clear X.
-Right;Apply (Rle_sym1 R0 r a).
-Left;Fold (Rgt R0 r);Apply (not_Rle R0 r b).
-Qed.
-
-(*********)
-Definition Rabsolu:R->R:=
-      [r:R](Cases (case_Rabsolu r) of
-              (leftT  _) => (Ropp r)
-             |(rightT _) => r
-            end).
-
-(*********)
-Lemma Rabsolu_R0:(Rabsolu R0)==R0.
-Unfold Rabsolu;Case (case_Rabsolu R0);Auto;Intro.
-Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
-Qed.
-
-Lemma Rabsolu_R1: (Rabsolu R1)==R1.
-Unfold Rabsolu; Case (case_Rabsolu R1); Auto with real.
-Intros H; Absurd ``1 < 0``;Auto with real.
-Qed.
-
-(*********)
-Lemma Rabsolu_no_R0:(r:R)~r==R0->~(Rabsolu r)==R0.
-Intros;Unfold Rabsolu;Case (case_Rabsolu r);Intro;Auto.
-Apply Ropp_neq;Auto.
-Qed.
-
-(*********)
-Lemma Rabsolu_left: (r:R)(Rlt r R0)->((Rabsolu r) == (Ropp r)).
-Intros;Unfold Rabsolu;Case (case_Rabsolu r);Trivial;Intro;Absurd (Rge r R0).
-Exact (Rlt_ge_not r R0 H).
-Assumption.
-Qed.
-
-(*********)
-Lemma Rabsolu_right: (r:R)(Rge r R0)->((Rabsolu r) == r).
-Intros;Unfold Rabsolu;Case (case_Rabsolu r);Intro.
-Absurd (Rge r R0).
-Exact (Rlt_ge_not r R0 r0).
-Assumption.
-Trivial.
-Qed.
-
-Lemma Rabsolu_left1: (a : R) (Rle a R0) ->  (Rabsolu a) == (Ropp a).
-Intros a H; Case H; Intros H1.
-Apply Rabsolu_left; Auto.
-Rewrite H1; Simpl; Rewrite Rabsolu_right; Auto with real.
-Qed.
-
-(*********)
-Lemma Rabsolu_pos:(x:R)(Rle R0 (Rabsolu x)).
-Intros;Unfold Rabsolu;Case (case_Rabsolu x);Intro.
-Generalize (Rlt_Ropp x R0 r);Intro;Unfold Rgt in H;
- Rewrite Ropp_O in H;Unfold Rle;Left;Assumption.
-Apply Rle_sym2;Assumption.
-Qed.
-
-Lemma Rle_Rabsolu:
- (x:R) (Rle x (Rabsolu x)).
-Intro; Unfold Rabsolu;Case (case_Rabsolu x);Intros;Fourier.
-Qed.
-
-(*********)
-Lemma Rabsolu_pos_eq:(x:R)(Rle R0 x)->(Rabsolu x)==x.
-Intros;Unfold Rabsolu;Case (case_Rabsolu x);Intro;
- [Generalize (Rle_not R0 x r);Intro;ElimType False;Auto|Trivial].
-Qed.
-
-(*********)
-Lemma Rabsolu_Rabsolu:(x:R)(Rabsolu (Rabsolu x))==(Rabsolu x).
-Intro;Apply (Rabsolu_pos_eq (Rabsolu x) (Rabsolu_pos x)).
-Qed.
-
-(*********)
-Lemma Rabsolu_pos_lt:(x:R)(~x==R0)->(Rlt R0 (Rabsolu x)).
-Intros;Generalize (Rabsolu_pos x);Intro;Unfold Rle in H0;
- Elim H0;Intro;Auto.
-ElimType False;Clear H0;Elim H;Clear H;Generalize H1;
- Unfold Rabsolu;Case (case_Rabsolu x);Intros;Auto.
-Clear r H1; Generalize (Rplus_plus_r x R0 (Ropp x) H0);
- Rewrite (let (H1,H2)=(Rplus_ne x) in H1);Rewrite (Rplus_Ropp_r x);Trivial.
-Qed.
-
-(*********)
-Lemma Rabsolu_minus_sym:(x,y:R)
- (Rabsolu (Rminus x y))==(Rabsolu (Rminus y x)).
-Intros;Unfold Rabsolu;Case (case_Rabsolu (Rminus x y)); 
- Case (case_Rabsolu (Rminus y x));Intros.
- Generalize (Rminus_lt y x r);Generalize (Rminus_lt x y r0);Intros;
- Generalize (Rlt_antisym x y H);Intro;ElimType False;Auto.
-Rewrite (Ropp_distr2 x y);Trivial.
-Rewrite (Ropp_distr2 y x);Trivial.
-Unfold Rge in r r0;Elim r;Elim r0;Intros;Clear r r0.
-Generalize (Rgt_RoppO (Rminus x y) H);Rewrite (Ropp_distr2 x y);
- Intro;Unfold Rgt in H0;Generalize (Rlt_antisym R0 (Rminus y x) H0);
- Intro;ElimType False;Auto.
-Rewrite (Rminus_eq x y H);Trivial.
-Rewrite (Rminus_eq y x H0);Trivial.
-Rewrite (Rminus_eq y x H0);Trivial.
-Qed.
-
-(*********)
-Lemma Rabsolu_mult:(x,y:R)
- (Rabsolu (Rmult x y))==(Rmult (Rabsolu x) (Rabsolu y)).
-Intros;Unfold Rabsolu;Case (case_Rabsolu (Rmult x y));
- Case (case_Rabsolu x);Case (case_Rabsolu y);Intros;Auto.
-Generalize (Rlt_anti_monotony y x R0 r r0);Intro;
- Rewrite (Rmult_Or y) in H;Generalize (Rlt_antisym (Rmult x y) R0 r1);
- Intro;Unfold Rgt in H;ElimType False;Rewrite (Rmult_sym y x) in H;
- Auto.
-Rewrite (Ropp_mul1 x y);Trivial. 
-Rewrite (Rmult_sym x (Ropp y));Rewrite (Ropp_mul1 y x);
- Rewrite (Rmult_sym  x y);Trivial.
-Unfold Rge in r r0;Elim r;Elim r0;Clear r r0;Intros;Unfold Rgt in H H0.
-Generalize (Rlt_monotony x R0 y H H0);Intro;Rewrite (Rmult_Or x) in H1;
- Generalize (Rlt_antisym (Rmult x y) R0 r1);Intro;ElimType False;Auto.
-Rewrite H in r1;Rewrite (Rmult_Ol y) in r1;Generalize (Rlt_antirefl R0);
- Intro;ElimType False;Auto.
-Rewrite H0 in r1;Rewrite (Rmult_Or x) in r1;Generalize (Rlt_antirefl R0);
- Intro;ElimType False;Auto.
-Rewrite H0 in r1;Rewrite (Rmult_Or x) in r1;Generalize (Rlt_antirefl R0);
- Intro;ElimType False;Auto.
-Rewrite (Ropp_mul2 x y);Trivial.
-Unfold Rge in r r1;Elim r;Elim r1;Clear r r1;Intros;Unfold Rgt in H0 H.
-Generalize (Rlt_monotony y x R0 H0 r0);Intro;Rewrite (Rmult_Or y) in H1;
- Rewrite (Rmult_sym y x) in H1; 
- Generalize (Rlt_antisym (Rmult x y) R0 H1);Intro;ElimType False;Auto.
-Generalize (imp_not_Req x R0 (or_introl (Rlt x R0) (Rgt x R0) r0));
- Generalize (imp_not_Req y R0 (or_intror (Rlt y R0) (Rgt y R0) H0));Intros;
- Generalize (without_div_Od x y H);Intro;Elim H3;Intro;ElimType False;
- Auto.  
-Rewrite H0 in H;Rewrite (Rmult_Or x) in H;Unfold Rgt in H;
- Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
-Rewrite H0;Rewrite (Rmult_Or x);Rewrite (Rmult_Or (Ropp x));Trivial.
-Unfold Rge in r0 r1;Elim r0;Elim r1;Clear r0 r1;Intros;Unfold Rgt in H0 H.
-Generalize (Rlt_monotony x y R0 H0 r);Intro;Rewrite (Rmult_Or x) in H1;
- Generalize (Rlt_antisym (Rmult x y) R0 H1);Intro;ElimType False;Auto.
-Generalize (imp_not_Req y R0 (or_introl (Rlt y R0) (Rgt y R0) r));
- Generalize (imp_not_Req R0 x (or_introl (Rlt R0 x) (Rgt R0 x) H0));Intros;
- Generalize (without_div_Od x y H);Intro;Elim H3;Intro;ElimType False;
- Auto.  
-Rewrite H0 in H;Rewrite (Rmult_Ol y) in H;Unfold Rgt in H;
- Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
-Rewrite H0;Rewrite (Rmult_Ol y);Rewrite (Rmult_Ol (Ropp y));Trivial.
-Qed.
-
-(*********)
-Lemma Rabsolu_Rinv:(r:R)(~r==R0)->(Rabsolu (Rinv r))==
-                                  (Rinv (Rabsolu r)).
-Intro;Unfold Rabsolu;Case (case_Rabsolu r);
- Case (case_Rabsolu (Rinv r));Auto;Intros.
-Apply Ropp_Rinv;Auto.
-Generalize (Rlt_Rinv2 r r1);Intro;Unfold Rge in r0;Elim r0;Intros.
-Unfold Rgt in H1;Generalize (Rlt_antisym R0 (Rinv r) H1);Intro; 
- ElimType False;Auto.
-Generalize 
-  (imp_not_Req (Rinv r) R0 
-   (or_introl (Rlt (Rinv r) R0) (Rgt (Rinv r) R0) H0));Intro;
- ElimType False;Auto.
-Unfold Rge in r1;Elim r1;Clear r1;Intro.
-Unfold Rgt in H0;Generalize (Rlt_antisym R0 (Rinv r)  
-     (Rlt_Rinv r H0));Intro;ElimType False;Auto.
-ElimType False;Auto.
-Qed. 
-
-Lemma Rabsolu_Ropp:
-  (x:R) (Rabsolu (Ropp x))==(Rabsolu x).
-Intro;Cut (Ropp x)==(Rmult (Ropp R1) x).
-Intros; Rewrite H.
-Rewrite Rabsolu_mult.
-Cut (Rabsolu (Ropp R1))==R1.
-Intros; Rewrite H0.
-Ring.
-Unfold Rabsolu; Case (case_Rabsolu (Ropp R1)).
-Intro; Ring.
-Intro H0;Generalize (Rle_sym2 R0 (Ropp R1) H0);Intros.
-Generalize (Rle_Ropp R0 (Ropp R1) H1).
-Rewrite Ropp_Ropp; Rewrite Ropp_O.
-Intro;Generalize (Rle_not R1 R0 Rlt_R0_R1);Intro;
- Generalize (Rle_sym2 R1 R0 H2);Intro;
- ElimType False;Auto.  
-Ring.
-Qed.
-
-(*********)
-Lemma Rabsolu_triang:(a,b:R)(Rle (Rabsolu (Rplus a b)) 
-                                (Rplus (Rabsolu a) (Rabsolu b))).
-Intros a b;Unfold Rabsolu;Case (case_Rabsolu (Rplus a b));
- Case (case_Rabsolu a);Case (case_Rabsolu b);Intros.
-Apply (eq_Rle (Ropp (Rplus a b)) (Rplus (Ropp a) (Ropp b)));
- Rewrite (Ropp_distr1 a b);Reflexivity.
-(**)
-Rewrite (Ropp_distr1 a b);
- Apply (Rle_compatibility (Ropp a) (Ropp b) b);
- Unfold Rle;Unfold Rge in r;Elim r;Intro.
-Left;Unfold Rgt in H;Generalize (Rlt_compatibility (Ropp b) R0 b H);
- Intro;Elim (Rplus_ne (Ropp b));Intros v w;Rewrite v in H0;Clear v w;
- Rewrite (Rplus_Ropp_l b) in H0;Apply (Rlt_trans (Ropp b) R0 b H0 H).
-Right;Rewrite H;Apply Ropp_O.
-(**)
-Rewrite (Ropp_distr1 a b);
- Rewrite (Rplus_sym (Ropp a) (Ropp b));
- Rewrite (Rplus_sym a (Ropp b));
- Apply (Rle_compatibility (Ropp b) (Ropp a) a);
- Unfold Rle;Unfold Rge in r0;Elim r0;Intro.
-Left;Unfold Rgt in H;Generalize (Rlt_compatibility (Ropp a) R0 a H);
- Intro;Elim (Rplus_ne (Ropp a));Intros v w;Rewrite v in H0;Clear v w;
- Rewrite (Rplus_Ropp_l a) in H0;Apply (Rlt_trans (Ropp a) R0 a H0 H).
-Right;Rewrite H;Apply Ropp_O.
-(**)
-ElimType False;Generalize (Rge_plus_plus_r a b R0 r);Intro;
- Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w; 
- Generalize (Rge_trans (Rplus a b) a R0 H r0);Intro;Clear H;
- Unfold Rge in H0;Elim H0;Intro;Clear H0.
-Unfold Rgt in H;Generalize (Rlt_antisym (Rplus a b) R0 r1);Intro;Auto.
-Absurd (Rplus a b)==R0;Auto.
-Apply (imp_not_Req (Rplus a b) R0);Left;Assumption.
-(**)
-ElimType False;Generalize (Rlt_compatibility a b R0 r);Intro;
- Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w;
- Generalize (Rlt_trans (Rplus a b) a R0 H r0);Intro;Clear H;
- Unfold Rge in r1;Elim r1;Clear r1;Intro.
-Unfold Rgt in H;
- Generalize (Rlt_trans (Rplus a b) R0 (Rplus a b) H0 H);Intro;
- Apply (Rlt_antirefl (Rplus a b));Assumption.
-Rewrite H in H0;Apply (Rlt_antirefl R0);Assumption.
-(**)
-Rewrite (Rplus_sym a b);Rewrite (Rplus_sym (Ropp a) b);
- Apply (Rle_compatibility b a (Ropp a));
- Apply (Rminus_le a (Ropp a));Unfold Rminus;Rewrite (Ropp_Ropp a);
- Generalize (Rlt_compatibility a a R0 r0);Clear r r1;Intro;
- Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w;
- Generalize (Rlt_trans (Rplus a a) a R0 H r0);Intro;
- Apply (Rlt_le (Rplus a a) R0 H0).
-(**)
-Apply (Rle_compatibility a b (Ropp b));
- Apply (Rminus_le b (Ropp b));Unfold Rminus;Rewrite (Ropp_Ropp b);
- Generalize (Rlt_compatibility b b R0 r);Clear r0 r1;Intro;
- Elim (Rplus_ne b);Intros v w;Rewrite v in H;Clear v w;
- Generalize (Rlt_trans (Rplus b b) b R0 H r);Intro;
- Apply (Rlt_le (Rplus b b) R0 H0).
-(**)
-Unfold Rle;Right;Reflexivity.
-Qed.
-
-(*********)
-Lemma Rabsolu_triang_inv:(a,b:R)(Rle (Rminus (Rabsolu a) (Rabsolu b))
-                                     (Rabsolu (Rminus a b))).
-Intros;
- Apply (Rle_anti_compatibility (Rabsolu b)
-        (Rminus (Rabsolu a) (Rabsolu b)) (Rabsolu (Rminus a b)));
- Unfold Rminus;
- Rewrite <- (Rplus_assoc (Rabsolu b) (Rabsolu a) (Ropp (Rabsolu b)));
- Rewrite (Rplus_sym (Rabsolu b) (Rabsolu a));
- Rewrite (Rplus_assoc (Rabsolu a) (Rabsolu b) (Ropp (Rabsolu b)));
- Rewrite (Rplus_Ropp_r (Rabsolu b));
- Rewrite (proj1 ? ? (Rplus_ne (Rabsolu a)));
- Replace (Rabsolu a) with (Rabsolu (Rplus a R0)).
- Rewrite <- (Rplus_Ropp_r b);
- Rewrite <- (Rplus_assoc a b (Ropp b)); 
- Rewrite (Rplus_sym a b);
- Rewrite (Rplus_assoc b a (Ropp b)).
- Exact (Rabsolu_triang b (Rplus a (Ropp b))).
- Rewrite (proj1 ? ? (Rplus_ne a));Trivial.
-Qed.
-
-(* ||a|-|b||<=|a-b| *)
-Lemma Rabsolu_triang_inv2 : (a,b:R) ``(Rabsolu ((Rabsolu a)-(Rabsolu b)))<=(Rabsolu (a-b))``. 
-Cut (a,b:R) ``(Rabsolu b)<=(Rabsolu a)``->``(Rabsolu ((Rabsolu a)-(Rabsolu b))) <= (Rabsolu (a-b))``. 
-Intros; NewDestruct (total_order (Rabsolu a) (Rabsolu b)) as [Hlt|[Heq|Hgt]].
-Rewrite <- (Rabsolu_Ropp ``(Rabsolu a)-(Rabsolu b)``); Rewrite <- (Rabsolu_Ropp ``a-b``); Do 2 Rewrite Ropp_distr2. 
-Apply H; Left; Assumption. 
-Rewrite Heq; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos. 
-Apply H; Left; Assumption. 
-Intros; Replace ``(Rabsolu ((Rabsolu a)-(Rabsolu b)))`` with ``(Rabsolu a)-(Rabsolu b)``. 
-Apply Rabsolu_triang_inv. 
-Rewrite (Rabsolu_right ``(Rabsolu a)-(Rabsolu b)``); [Reflexivity | Apply Rle_sym1; Apply Rle_anti_compatibility with (Rabsolu b); Rewrite Rplus_Or; Replace ``(Rabsolu b)+((Rabsolu a)-(Rabsolu b))`` with (Rabsolu a); [Assumption | Ring]]. 
-Qed. 
-
-(*********)
-Lemma Rabsolu_def1:(x,a:R)(Rlt x a)->(Rlt (Ropp a) x)->(Rlt (Rabsolu x) a).
-Unfold Rabsolu;Intros;Case (case_Rabsolu x);Intro.
-Generalize (Rlt_Ropp (Ropp a) x H0);Unfold Rgt;Rewrite Ropp_Ropp;Intro;
- Assumption.
-Assumption.
-Qed.
-
-(*********)
-Lemma Rabsolu_def2:(x,a:R)(Rlt (Rabsolu x) a)->(Rlt x a)/\(Rlt (Ropp a) x).
-Unfold Rabsolu;Intro x;Case (case_Rabsolu x);Intros.
-Generalize (Rlt_RoppO x r);Unfold Rgt;Intro;
- Generalize (Rlt_trans R0 (Ropp x) a H0 H);Intro;Split. 
-Apply (Rlt_trans x R0 a r H1).
-Generalize (Rlt_Ropp (Ropp x) a H);Rewrite (Ropp_Ropp x);Unfold Rgt;Trivial.
-Fold (Rgt a x) in H;Generalize (Rgt_ge_trans a x R0 H r);Intro;
- Generalize (Rgt_RoppO a H0);Intro;Fold (Rgt R0 (Ropp a));
- Generalize (Rge_gt_trans x R0 (Ropp a) r H1);Unfold Rgt;Intro;Split;
- Assumption.
-Qed.
-
-Lemma RmaxAbs:
- (p, q, r : R)
- (Rle p q) -> (Rle q r) ->  (Rle (Rabsolu q) (Rmax (Rabsolu p) (Rabsolu r))).
-Intros p q r H' H'0; Case (Rle_or_lt R0 p); Intros H'1.
-Repeat Rewrite Rabsolu_right; Auto with real.
-Apply Rle_trans with r; Auto with real.
-Apply RmaxLess2; Auto.
-Apply Rge_trans with p; Auto with real; Apply Rge_trans with q; Auto with real.
-Apply Rge_trans with p; Auto with real.
-Rewrite (Rabsolu_left p); Auto.
-Case (Rle_or_lt R0 q); Intros H'2.
-Repeat Rewrite Rabsolu_right; Auto with real.
-Apply Rle_trans with r; Auto.
-Apply RmaxLess2; Auto.
-Apply Rge_trans with q; Auto with real.
-Rewrite (Rabsolu_left q); Auto.
-Case (Rle_or_lt R0 r); Intros H'3.
-Repeat Rewrite Rabsolu_right; Auto with real.
-Apply Rle_trans with (Ropp p); Auto with real.
-Apply RmaxLess1; Auto.
-Rewrite (Rabsolu_left r); Auto.
-Apply Rle_trans with (Ropp p); Auto with real.
-Apply RmaxLess1; Auto.
-Qed.
-
-Lemma Rabsolu_Zabs: (z : Z)  (Rabsolu (IZR z)) == (IZR (Zabs z)).
-Intros z; Case z; Simpl; Auto with real.
-Apply Rabsolu_right; Auto with real.
-Intros p0; Apply Rabsolu_right; Auto with real zarith.
-Intros p0; Rewrite Rabsolu_Ropp.
-Apply Rabsolu_right; Auto with real zarith.
-Qed.
- 
diff --git a/theories7/Reals/Rcomplete.v b/theories7/Reals/Rcomplete.v
deleted file mode 100644
index 5985a382..00000000
--- a/theories7/Reals/Rcomplete.v
+++ /dev/null
@@ -1,175 +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: Rcomplete.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require SeqProp.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(****************************************************)
-(*              R is complete :                     *)
-(*        Each sequence which satisfies             *)
-(*       the Cauchy's criterion converges           *)
-(*                                                  *)
-(*    Proof with adjacent sequences (Vn and Wn)     *)
-(****************************************************)
-
-Theorem R_complete : (Un:nat->R) (Cauchy_crit Un) -> (sigTT R [l:R](Un_cv Un l)).
-Intros.
-Pose Vn := (sequence_minorant Un (cauchy_min Un H)).
-Pose Wn := (sequence_majorant Un (cauchy_maj Un H)).
-Assert H0 := (maj_cv Un H).
-Fold Wn in H0.
-Assert H1 := (min_cv Un H).
-Fold Vn in H1.
-Elim H0; Intros.
-Elim H1; Intros.
-Cut x==x0.
-Intros.
-Apply existTT with x.
-Rewrite <- H2 in p0.
-Unfold Un_cv.
-Intros.
-Unfold Un_cv in p; Unfold Un_cv in p0.
-Cut ``0<eps/3``.
-Intro.
-Elim (p ``eps/3`` H4); Intros.
-Elim (p0 ``eps/3`` H4); Intros.
-Exists (max x1 x2).
-Intros.
-Unfold R_dist.
-Apply Rle_lt_trans with ``(Rabsolu ((Un n)-(Vn n)))+(Rabsolu ((Vn n)-x))``.
-Replace ``(Un n)-x`` with ``((Un n)-(Vn n))+((Vn n)-x)``; [Apply Rabsolu_triang | Ring].
-Apply Rle_lt_trans with ``(Rabsolu ((Wn n)-(Vn n)))+(Rabsolu ((Vn n)-x))``.
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu ((Vn n)-x))``).
-Apply Rle_compatibility.
-Repeat Rewrite Rabsolu_right.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-(Vn n)``); Apply Rle_compatibility.
-Assert H8 := (Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-Fold Vn Wn in H8.
-Elim (H8 n); Intros.
-Assumption.
-Apply Rle_sym1.
-Unfold Rminus; Apply Rle_anti_compatibility with (Vn n).
-Rewrite Rplus_Or.
-Replace ``(Vn n)+((Wn n)+ -(Vn n))`` with (Wn n); [Idtac | Ring].
-Assert H8 := (Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-Fold Vn Wn in H8.
-Elim (H8 n); Intros.
-Apply Rle_trans with (Un n); Assumption.
-Apply Rle_sym1.
-Unfold Rminus; Apply Rle_anti_compatibility with (Vn n).
-Rewrite Rplus_Or.
-Replace ``(Vn n)+((Un n)+ -(Vn n))`` with (Un n); [Idtac | Ring].
-Assert H8 := (Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-Fold Vn Wn in H8.
-Elim (H8 n); Intros.
-Assumption.
-Apply Rle_lt_trans with ``(Rabsolu ((Wn n)-x))+(Rabsolu (x-(Vn n)))+(Rabsolu ((Vn n)-x))``.
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu ((Vn n)-x))``).
-Apply Rle_compatibility.
-Replace ``(Wn n)-(Vn n)`` with ``((Wn n)-x)+(x-(Vn n))``; [Apply Rabsolu_triang | Ring].
-Apply Rlt_le_trans with ``eps/3+eps/3+eps/3``.
-Repeat Apply Rplus_lt.
-Unfold R_dist in H5.
-Apply H5.
-Unfold ge; Apply le_trans with (max x1 x2).
-Apply le_max_l.
-Assumption.
-Rewrite <- Rabsolu_Ropp.
-Replace ``-(x-(Vn n))`` with ``(Vn n)-x``; [Idtac | Ring].
-Unfold R_dist in H6.
-Apply H6.
-Unfold ge; Apply le_trans with (max x1 x2).
-Apply le_max_r.
-Assumption.
-Unfold R_dist in H6.
-Apply H6.
-Unfold ge; Apply le_trans with (max x1 x2).
-Apply le_max_r.
-Assumption.
-Right.
-Pattern 4 eps; Replace ``eps`` with ``3*eps/3``.
-Ring.
-Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m; DiscrR.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Apply cond_eq.
-Intros.
-Cut ``0<eps/5``.
-Intro.
-Unfold Un_cv in p; Unfold Un_cv in p0.
-Unfold R_dist in p; Unfold R_dist in p0.
-Elim (p ``eps/5`` H3); Intros N1 H4.
-Elim (p0 ``eps/5`` H3); Intros N2 H5.
-Unfold Cauchy_crit in H.
-Unfold R_dist in H.
-Elim (H ``eps/5`` H3); Intros N3 H6.
-Pose N := (max (max N1 N2) N3).
-Apply Rle_lt_trans with ``(Rabsolu (x-(Wn N)))+(Rabsolu ((Wn N)-x0))``.
-Replace ``x-x0`` with ``(x-(Wn N))+((Wn N)-x0)``; [Apply Rabsolu_triang | Ring].
-Apply Rle_lt_trans with ``(Rabsolu (x-(Wn N)))+(Rabsolu ((Wn N)-(Vn N)))+(Rabsolu (((Vn N)-x0)))``.
-Rewrite Rplus_assoc.
-Apply Rle_compatibility.
-Replace ``(Wn N)-x0`` with ``((Wn N)-(Vn N))+((Vn N)-x0)``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``eps/5+3*eps/5+eps/5``.
-Repeat Apply Rplus_lt.
-Rewrite <- Rabsolu_Ropp.
-Replace ``-(x-(Wn N))`` with ``(Wn N)-x``; [Apply H4 | Ring].
-Unfold ge N.
-Apply le_trans with (max N1 N2); Apply le_max_l.
-Unfold Wn Vn.
-Unfold sequence_majorant sequence_minorant.
-Assert H7 := (approx_maj [k:nat](Un (plus N k)) (maj_ss Un N (cauchy_maj Un H))).
-Assert H8 := (approx_min [k:nat](Un (plus N k)) (min_ss Un N (cauchy_min Un H))).
-Cut (Wn N)==(majorant ([k:nat](Un (plus N k))) (maj_ss Un N (cauchy_maj Un H))).
-Cut (Vn N)==(minorant ([k:nat](Un (plus N k))) (min_ss Un N (cauchy_min Un H))).
-Intros.
-Rewrite <- H9; Rewrite <- H10.
-Rewrite <- H9 in H8.
-Rewrite <- H10 in H7.
-Elim (H7 ``eps/5`` H3); Intros k2 H11.
-Elim (H8 ``eps/5`` H3); Intros k1 H12.
-Apply Rle_lt_trans with ``(Rabsolu ((Wn N)-(Un (plus N k2))))+(Rabsolu ((Un (plus N k2))-(Vn N)))``.
-Replace ``(Wn N)-(Vn N)`` with ``((Wn N)-(Un (plus N k2)))+((Un (plus N k2))-(Vn N))``; [Apply Rabsolu_triang | Ring].
-Apply Rle_lt_trans with ``(Rabsolu ((Wn N)-(Un (plus N k2))))+(Rabsolu ((Un (plus N k2))-(Un (plus N k1))))+(Rabsolu ((Un (plus N k1))-(Vn N)))``.
-Rewrite Rplus_assoc.
-Apply Rle_compatibility.
-Replace ``(Un (plus N k2))-(Vn N)`` with ``((Un (plus N k2))-(Un (plus N k1)))+((Un (plus N k1))-(Vn N))``; [Apply Rabsolu_triang | Ring].
-Replace ``3*eps/5`` with ``eps/5+eps/5+eps/5``; [Repeat Apply Rplus_lt | Ring].
-Assumption.
-Apply H6.
-Unfold ge.
-Apply le_trans with N.
-Unfold N; Apply le_max_r.
-Apply le_plus_l.
-Unfold ge.
-Apply le_trans with N.
-Unfold N; Apply le_max_r.
-Apply le_plus_l.
-Rewrite <- Rabsolu_Ropp.
-Replace ``-((Un (plus N k1))-(Vn N))`` with ``(Vn N)-(Un (plus N k1))``; [Assumption | Ring].
-Reflexivity.
-Reflexivity.
-Apply H5.
-Unfold ge; Apply le_trans with (max N1 N2).
-Apply le_max_r.
-Unfold N; Apply le_max_l.
-Pattern 4 eps; Replace ``eps`` with ``5*eps/5``.
-Ring.
-Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
-DiscrR.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv.
-Sup0; Try Apply lt_O_Sn.
-Qed.
diff --git a/theories7/Reals/Rdefinitions.v b/theories7/Reals/Rdefinitions.v
deleted file mode 100644
index 79be0176..00000000
--- a/theories7/Reals/Rdefinitions.v
+++ /dev/null
@@ -1,69 +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: Rdefinitions.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
-
-
-(*********************************************************)
-(**          Definitions for the axiomatization          *)
-(*                                                       *)
-(*********************************************************)
-
-Require Export ZArith_base.
-
-Parameter R:Set.
-
-(* Declare Scope positive_scope with Key R *)
-Delimits Scope R_scope with R.
-
-(* Automatically open scope R_scope for arguments of type R *)
-Bind Scope R_scope with R.
-
-Parameter R0:R.
-Parameter R1:R.
-Parameter Rplus:R->R->R.
-Parameter Rmult:R->R->R.
-Parameter Ropp:R->R.
-Parameter Rinv:R->R. 
-Parameter Rlt:R->R->Prop.    
-Parameter up:R->Z.
-
-V8Infix "+" Rplus : R_scope.
-V8Infix "*" Rmult : R_scope.
-V8Notation "- x" := (Ropp x) : R_scope.
-V8Notation "/ x" := (Rinv x) : R_scope.
-
-V8Infix "<"  Rlt : R_scope.
-
-(*i*******************************************************i*)
-
-(**********)
-Definition Rgt:R->R->Prop:=[r1,r2:R](Rlt r2 r1).
-
-(**********)
-Definition Rle:R->R->Prop:=[r1,r2:R]((Rlt r1 r2)\/(r1==r2)).
-
-(**********)
-Definition Rge:R->R->Prop:=[r1,r2:R]((Rgt r1 r2)\/(r1==r2)).
-
-(**********)
-Definition Rminus:R->R->R:=[r1,r2:R](Rplus r1 (Ropp r2)).
-
-(**********)
-Definition Rdiv:R->R->R:=[r1,r2:R](Rmult r1 (Rinv r2)).
-
-V8Infix "-" Rminus : R_scope.
-V8Infix "/" Rdiv : R_scope.
-
-V8Infix "<=" Rle : R_scope.
-V8Infix ">=" Rge : R_scope.
-V8Infix ">" Rgt : R_scope.
-
-V8Notation "x <= y <= z" := (Rle x y)/\(Rle y z) : R_scope.
-V8Notation "x <= y < z" := (Rle x y)/\(Rlt y z) : R_scope.
-V8Notation "x < y < z" := (Rlt x y)/\(Rlt y z) : R_scope.
-V8Notation "x < y <= z" := (Rlt x y)/\(Rle y z) : R_scope.
diff --git a/theories7/Reals/Rderiv.v b/theories7/Reals/Rderiv.v
deleted file mode 100644
index b55aa6ea..00000000
--- a/theories7/Reals/Rderiv.v
+++ /dev/null
@@ -1,453 +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: Rderiv.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
-
-(*********************************************************)
-(**     Definition of the derivative,continuity          *)
-(*                                                       *)
-(*********************************************************)
-
-Require Rbase.
-Require Rfunctions.
-Require Rlimit.
-Require Fourier.
-Require Classical_Prop.
-Require Classical_Pred_Type.
-Require Omega.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(*********)
-Definition D_x:(R->Prop)->R->R->Prop:=[D:R->Prop][y:R][x:R]
-       (D x)/\(~y==x).
-
-(*********)
-Definition continue_in:(R->R)->(R->Prop)->R->Prop:=
-       [f:R->R; D:R->Prop; x0:R](limit1_in f (D_x D x0) (f x0) x0).
-
-(*********)
-Definition D_in:(R->R)->(R->R)->(R->Prop)->R->Prop:=
-  [f:R->R; d:R->R; D:R->Prop; x0:R](limit1_in 
-    [x:R] (Rdiv (Rminus (f x) (f x0)) (Rminus x x0)) 
-    (D_x D x0) (d x0) x0).
-
-(*********)
-Lemma cont_deriv:(f,d:R->R;D:R->Prop;x0:R)
-         (D_in f d D x0)->(continue_in f D x0).
-Unfold continue_in;Unfold D_in;Unfold limit1_in;Unfold limit_in;
- Unfold Rdiv;Simpl;Intros;Elim (H eps H0); Clear H;Intros;
- Elim H;Clear H;Intros; Elim (Req_EM (d x0) R0);Intro.
-Split with (Rmin R1 x);Split.
-Elim (Rmin_Rgt R1 x R0);Intros a b;
- Apply (b (conj (Rgt R1 R0) (Rgt x R0) Rlt_R0_R1 H)).
-Intros;Elim H3;Clear H3;Intros;
-Generalize (let (H1,H2)=(Rmin_Rgt R1 x (R_dist x1 x0)) in H1);
- Unfold Rgt;Intro;Elim (H5 H4);Clear H5;Intros;
- Generalize (H1 x1 (conj (D_x D x0 x1) (Rlt (R_dist x1 x0) x) H3 H6));
- Clear H1;Intro;Unfold D_x in H3;Elim H3;Intros.
-Rewrite H2 in H1;Unfold R_dist; Unfold R_dist in H1;
- Cut (Rlt (Rabsolu (Rminus (f x1) (f x0))) 
-          (Rmult eps (Rabsolu (Rminus x1 x0)))).
-Intro;Unfold R_dist in H5;
-  Generalize (Rlt_monotony eps ``(Rabsolu (x1-x0))`` ``1`` H0 H5);
-Rewrite Rmult_1r;Intro;Apply Rlt_trans with r2:=``eps*(Rabsolu (x1-x0))``;
- Assumption.
-Rewrite (minus_R0 ``((f x1)-(f x0))*/(x1-x0)``) in H1;
- Rewrite Rabsolu_mult in H1; Cut ``x1-x0 <> 0``.
-Intro;Rewrite (Rabsolu_Rinv (Rminus x1 x0) H9) in H1;
- Generalize (Rlt_monotony ``(Rabsolu (x1-x0))`` 
- ``(Rabsolu ((f x1)-(f x0)))*/(Rabsolu (x1-x0))`` eps 
- (Rabsolu_pos_lt ``x1-x0`` H9) H1);Intro; Rewrite Rmult_sym in H10;
- Rewrite Rmult_assoc in H10;Rewrite Rinv_l in H10.
-Rewrite Rmult_1r in H10;Rewrite Rmult_sym;Assumption.
-Apply Rabsolu_no_R0;Auto.
-Apply Rminus_eq_contra;Auto.
-(**)
- Split with (Rmin (Rmin (Rinv (Rplus R1 R1)) x) 
-              (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))));
- Split.
-Cut (Rgt (Rmin (Rinv (Rplus R1 R1)) x) R0).
-Cut (Rgt (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0).
-Intros;Elim (Rmin_Rgt (Rmin (Rinv (Rplus R1 R1)) x) 
-            (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0);
- Intros a b;
- Apply (b (conj (Rgt (Rmin (Rinv (Rplus R1 R1)) x) R0)
-       (Rgt (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0)
-        H4 H3)).
-Apply Rmult_gt;Auto.
-Unfold Rgt;Apply Rlt_Rinv;Apply Rabsolu_pos_lt;Apply mult_non_zero;
- Split.
-DiscrR.
-Assumption.
-Elim (Rmin_Rgt (Rinv (Rplus R1 R1)) x R0);Intros a b;
- Cut (Rlt R0 (Rplus R1 R1)).
-Intro;Generalize (Rlt_Rinv (Rplus R1 R1) H3);Intro;
- Fold (Rgt (Rinv (Rplus R1 R1)) R0) in H4;
- Apply (b (conj (Rgt (Rinv (Rplus R1 R1)) R0) (Rgt x R0) H4 H)).
-Fourier.
-Intros;Elim H3;Clear H3;Intros;
- Generalize (let (H1,H2)=(Rmin_Rgt (Rmin (Rinv (Rplus R1 R1)) x)
-       (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0)))))
-       (R_dist x1 x0)) in H1);Unfold Rgt;Intro;Elim (H5 H4);Clear H5;
- Intros;
- Generalize (let (H1,H2)=(Rmin_Rgt (Rinv (Rplus R1 R1)) x
-          (R_dist x1 x0)) in H1);Unfold Rgt;Intro;Elim (H7 H5);Clear H7;
- Intros;Clear H4 H5;
- Generalize (H1 x1 (conj (D_x D x0 x1) (Rlt (R_dist x1 x0) x) H3 H8));
- Clear H1;Intro;Unfold D_x in H3;Elim H3;Intros;
- Generalize (sym_not_eqT R x0 x1 H5);Clear H5;Intro H5;
- Generalize (Rminus_eq_contra x1 x0 H5);
- Intro;Generalize H1;Pattern 1 (d x0); 
- Rewrite <-(let (H1,H2)=(Rmult_ne (d x0)) in H2);
- Rewrite <-(Rinv_l (Rminus x1 x0) H9); Unfold R_dist;Unfold 1 Rminus;
- Rewrite (Rmult_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0)));
- Rewrite (Rmult_sym (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)) (d x0));
- Rewrite <-(Ropp_mul1 (d x0) (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)));
- Rewrite (Rmult_sym (Ropp (d x0))
-                    (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)));
- Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus x1 x0) (Ropp (d x0)));
- Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0)) (Rminus (f x1) (f x0))
-                   (Rmult (Rminus x1 x0) (Ropp (d x0))));
- Rewrite (Rabsolu_mult (Rinv (Rminus x1 x0))
-                       (Rplus (Rminus (f x1) (f x0))
-                              (Rmult (Rminus x1 x0) (Ropp (d x0)))));
- Clear H1;Intro;Generalize (Rlt_monotony (Rabsolu (Rminus x1 x0)) 
-        (Rmult (Rabsolu (Rinv (Rminus x1 x0)))
-           (Rabsolu
-             (Rplus (Rminus (f x1) (f x0))
-               (Rmult (Rminus x1 x0) (Ropp (d x0)))))) eps 
-        (Rabsolu_pos_lt (Rminus x1 x0) H9) H1); 
- Rewrite <-(Rmult_assoc (Rabsolu (Rminus x1 x0)) 
-                 (Rabsolu (Rinv (Rminus x1 x0)))
-               (Rabsolu
-           (Rplus (Rminus (f x1) (f x0))
-             (Rmult (Rminus x1 x0) (Ropp (d x0)))))); 
- Rewrite (Rabsolu_Rinv (Rminus x1 x0) H9);
- Rewrite (Rinv_r (Rabsolu (Rminus x1 x0)) 
-                 (Rabsolu_no_R0 (Rminus x1 x0) H9));
- Rewrite (let (H1,H2)=(Rmult_ne (Rabsolu
-         (Rplus (Rminus (f x1) (f x0))
-           (Rmult (Rminus x1 x0) (Ropp (d x0)))))) in H2);
- Generalize (Rabsolu_triang_inv (Rminus (f x1) (f x0))
-         (Rmult (Rminus x1 x0) (d x0)));Intro;
- Rewrite (Rmult_sym (Rminus x1 x0) (Ropp (d x0)));
- Rewrite (Ropp_mul1 (d x0) (Rminus x1 x0));
- Fold (Rminus (Rminus (f x1) (f x0)) (Rmult (d x0) (Rminus x1 x0)));
- Rewrite (Rmult_sym (Rminus x1 x0) (d x0)) in H10;
- Clear H1;Intro;Generalize (Rle_lt_trans 
-           (Rminus (Rabsolu (Rminus (f x1) (f x0)))
-           (Rabsolu (Rmult (d x0) (Rminus x1 x0))))
-          (Rabsolu
-           (Rminus (Rminus (f x1) (f x0)) (Rmult (d x0) (Rminus x1 x0))))
-          (Rmult (Rabsolu (Rminus x1 x0)) eps) H10 H1);
- Clear H1;Intro;
- Generalize (Rlt_compatibility (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
-   (Rminus (Rabsolu (Rminus (f x1) (f x0)))
-           (Rabsolu (Rmult (d x0) (Rminus x1 x0))))
-   (Rmult (Rabsolu (Rminus x1 x0)) eps) H1);
- Unfold 2 Rminus;Rewrite (Rplus_sym (Rabsolu (Rminus (f x1) (f x0)))
-    (Ropp (Rabsolu (Rmult (d x0) (Rminus x1 x0)))));
- Rewrite <-(Rplus_assoc (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
-  (Ropp (Rabsolu (Rmult (d x0) (Rminus x1 x0)))) 
-  (Rabsolu (Rminus (f x1) (f x0))));
- Rewrite (Rplus_Ropp_r (Rabsolu (Rmult (d x0) (Rminus x1 x0))));
- Rewrite (let (H1,H2)=(Rplus_ne (Rabsolu (Rminus (f x1) (f x0)))) in H2);
- Clear H1;Intro;Cut (Rlt (Rplus (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
-           (Rmult (Rabsolu (Rminus x1 x0)) eps)) eps).
-Intro;Apply (Rlt_trans (Rabsolu (Rminus (f x1) (f x0))) 
-    (Rplus (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
-            (Rmult (Rabsolu (Rminus x1 x0)) eps)) eps H1 H11). 
-Clear H1 H5 H3 H10;Generalize (Rabsolu_pos_lt (d x0) H2);
- Intro;Unfold Rgt in H0;Generalize (Rlt_monotony eps (R_dist x1 x0)
-       (Rinv (Rplus R1 R1)) H0 H7);Clear H7;Intro;
- Generalize (Rlt_monotony (Rabsolu (d x0)) (R_dist x1 x0) 
-    (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) H1 H6);
- Clear H6;Intro;Rewrite (Rmult_sym eps (R_dist x1 x0)) in H3; 
- Unfold R_dist in H3 H5;
- Rewrite <-(Rabsolu_mult (d x0) (Rminus x1 x0)) in H5;
- Rewrite (Rabsolu_mult (Rplus R1 R1) (d x0)) in H5;
- Cut ~(Rabsolu (Rplus R1 R1))==R0.
-Intro;Fold (Rgt (Rabsolu (d x0)) R0) in H1;
- Rewrite (Rinv_Rmult (Rabsolu (Rplus R1 R1)) (Rabsolu (d x0))
- H6 (imp_not_Req (Rabsolu (d x0)) R0 
-  (or_intror (Rlt (Rabsolu (d x0)) R0) (Rgt (Rabsolu (d x0)) R0) H1))) 
-  in H5;
- Rewrite (Rmult_sym (Rabsolu (d x0)) (Rmult eps
-             (Rmult (Rinv (Rabsolu (Rplus R1 R1)))
-               (Rinv (Rabsolu (d x0)))))) in H5;
- Rewrite <-(Rmult_assoc eps (Rinv (Rabsolu (Rplus R1 R1))) 
-   (Rinv (Rabsolu (d x0)))) in H5;
- Rewrite (Rmult_assoc (Rmult eps (Rinv (Rabsolu (Rplus R1 R1))))
-    (Rinv (Rabsolu (d x0))) (Rabsolu (d x0))) in H5;
- Rewrite (Rinv_l (Rabsolu (d x0)) (imp_not_Req (Rabsolu (d x0)) R0 
-  (or_intror (Rlt (Rabsolu (d x0)) R0) (Rgt (Rabsolu (d x0)) R0) H1))) 
-  in H5;
- Rewrite (let (H1,H2)=(Rmult_ne (Rmult eps (Rinv (Rabsolu (Rplus R1 R1)))))
-   in H1) in H5;Cut (Rabsolu (Rplus R1 R1))==(Rplus R1 R1).
-Intro;Rewrite H7 in H5;
- Generalize (Rplus_lt (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
-        (Rmult eps (Rinv (Rplus R1 R1)))
-        (Rmult (Rabsolu (Rminus x1 x0)) eps)
-        (Rmult eps (Rinv (Rplus R1 R1))) H5 H3);Intro;
- Rewrite eps2 in H10;Assumption.
-Unfold Rabsolu;Case (case_Rabsolu (Rplus R1 R1));Auto.
- Intro;Cut (Rlt R0 (Rplus R1 R1)).
-Intro;Generalize (Rlt_antisym R0 (Rplus R1 R1) H7);Intro;ElimType False;
- Auto.
-Fourier.
-Apply Rabsolu_no_R0.
-DiscrR.
-Qed.
-
-
-(*********)
-Lemma Dconst:(D:R->Prop)(y:R)(x0:R)(D_in [x:R]y [x:R]R0 D x0).
-Unfold D_in;Intros;Unfold limit1_in;Unfold limit_in;Unfold Rdiv;Intros;Simpl;
- Split with eps;Split;Auto.
-Intros;Rewrite (eq_Rminus y y (refl_eqT R y));
- Rewrite Rmult_Ol;Unfold R_dist; 
- Rewrite (eq_Rminus R0 R0 (refl_eqT R R0));Unfold Rabsolu;
- Case (case_Rabsolu R0);Intro.
-Absurd (Rlt R0 R0);Auto.
-Red;Intro;Apply (Rlt_antirefl R0 H1).
-Unfold Rgt in H0;Assumption.
-Qed.
-
-(*********)
-Lemma Dx:(D:R->Prop)(x0:R)(D_in [x:R]x [x:R]R1 D x0).
-Unfold D_in;Unfold Rdiv;Intros;Unfold limit1_in;Unfold limit_in;Intros;Simpl;
-  Split with eps;Split;Auto.
-Intros;Elim H0;Clear H0;Intros;Unfold D_x in H0;
- Elim H0;Intros;
- Rewrite (Rinv_r (Rminus x x0) (Rminus_eq_contra x x0 
-      (sym_not_eqT R x0 x H3)));
- Unfold R_dist; 
- Rewrite (eq_Rminus R1 R1 (refl_eqT R R1));Unfold Rabsolu;
- Case (case_Rabsolu R0);Intro.
-Absurd (Rlt R0 R0);Auto.
-Red;Intro;Apply (Rlt_antirefl R0 r).
-Unfold Rgt in H;Assumption.
-Qed. 
-
-(*********)
-Lemma Dadd:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
-  (D_in f df D x0)->(D_in g dg D x0)->
-  (D_in [x:R](Rplus (f x) (g x)) [x:R](Rplus (df x) (dg x)) D x0).
-Unfold D_in;Intros;Generalize (limit_plus 
-   [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
-   [x:R](Rmult  (Rminus (g x) (g x0)) (Rinv (Rminus x x0))) 
-   (D_x D x0) (df x0) (dg x0) x0 H H0);Clear H H0;
- Unfold limit1_in;Unfold limit_in;Simpl;Intros;
- Elim (H eps H0);Clear H;Intros;Elim H;Clear H;Intros;
- Split with x;Split;Auto;Intros;Generalize (H1 x1 H2);Clear H1;Intro; 
- Rewrite (Rmult_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))) in H1;
- Rewrite (Rmult_sym (Rminus (g x1) (g x0)) (Rinv (Rminus x1 x0))) in H1;
- Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0)) 
-                    (Rminus (f x1) (f x0)) 
-                    (Rminus (g x1) (g x0))) in H1;
- Rewrite (Rmult_sym (Rinv (Rminus x1 x0))
-           (Rplus (Rminus (f x1) (f x0)) (Rminus (g x1) (g x0)))) in H1;
- Cut (Rplus (Rminus (f x1) (f x0)) (Rminus (g x1) (g x0)))==
-      (Rminus (Rplus (f x1) (g x1)) (Rplus (f x0) (g x0))).
-Intro;Rewrite H3 in H1;Assumption.
-Ring.
-Qed.
-
-(*********)
-Lemma Dmult:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
-  (D_in f df D x0)->(D_in g dg D x0)->
-  (D_in [x:R](Rmult (f x) (g x))  
-             [x:R](Rplus (Rmult (df x) (g x)) (Rmult (f x) (dg x))) D x0).
-Intros;Unfold D_in;Generalize H H0;Intros;Unfold D_in in H H0;
- Generalize (cont_deriv f df D x0 H1);Unfold continue_in;Intro;
- Generalize (limit_mul 
-   [x:R](Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0)))
-   [x:R](f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3);Intro;
- Cut (limit1_in [x:R](g x0) (D_x D x0) (g x0) x0).
-Intro;Generalize (limit_mul 
-  [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
-  [_:R](g x0) (D_x D x0) (df x0) (g x0) x0 H H5);Clear H H0 H1 H2 H3 H5;
- Intro;Generalize (limit_plus 
-  [x:R](Rmult (Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) (g x0))
-  [x:R](Rmult (Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0)))
-                (f x)) (D_x D x0) (Rmult (df x0) (g x0)) 
-                               (Rmult (dg x0) (f x0)) x0 H H4);
- Clear H4 H;Intro;Unfold limit1_in in H;Unfold limit_in in H;
- Simpl in H;Unfold limit1_in;Unfold limit_in;Simpl;Intros;
- Elim (H eps H0);Clear H;Intros;Elim H;Clear H;Intros;
- Split with x;Split;Auto;Intros;Generalize (H1 x1 H2);Clear H1;Intro;
- Rewrite (Rmult_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))) in H1;
- Rewrite (Rmult_sym (Rminus (g x1) (g x0)) (Rinv (Rminus x1 x0))) in H1;
- Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus (f x1) (f x0))
-       (g x0)) in H1;
- Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus (g x1) (g x0))
-       (f x1)) in H1;
- Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0))
-                (Rmult (Rminus (f x1) (f x0)) (g x0))
-                (Rmult (Rminus (g x1) (g x0)) (f x1))) in H1;
- Rewrite (Rmult_sym (Rinv (Rminus x1 x0))
-       (Rplus (Rmult (Rminus (f x1) (f x0)) (g x0))
-               (Rmult (Rminus (g x1) (g x0)) (f x1)))) in H1;
- Rewrite (Rmult_sym (dg x0) (f x0)) in H1;
- Cut (Rplus (Rmult (Rminus (f x1) (f x0)) (g x0))
-               (Rmult (Rminus (g x1) (g x0)) (f x1)))==
-      (Rminus (Rmult (f x1) (g x1)) (Rmult (f x0) (g x0))).
-Intro;Rewrite H3 in H1;Assumption.
-Ring.
-Unfold limit1_in;Unfold limit_in;Simpl;Intros;
- Split with eps;Split;Auto;Intros;Elim (R_dist_refl (g x0) (g x0));
- Intros a b;Rewrite (b (refl_eqT R (g x0)));Unfold Rgt in H;Assumption.
-Qed.
-
-(*********)
-Lemma Dmult_const:(D:R->Prop)(f,df:R->R)(x0:R)(a:R)(D_in f df D x0)->
-  (D_in [x:R](Rmult a (f x)) ([x:R](Rmult a (df x))) D x0).
-Intros;Generalize (Dmult D [_:R]R0 df [_:R]a f x0 (Dconst D a x0) H);
- Unfold D_in;Intros;
- Rewrite (Rmult_Ol (f x0)) in H0;
- Rewrite (let (H1,H2)=(Rplus_ne (Rmult a (df x0))) in H2) in H0;
- Assumption.
-Qed.
-
-(*********)
-Lemma Dopp:(D:R->Prop)(f,df:R->R)(x0:R)(D_in f df D x0)->
-  (D_in [x:R](Ropp (f x)) ([x:R](Ropp (df x))) D x0).
-Intros;Generalize (Dmult_const D f df x0 (Ropp R1) H); Unfold D_in;
- Unfold limit1_in;Unfold limit_in;Intros;
- Generalize (H0 eps H1);Clear H0;Intro;Elim H0;Clear H0;Intros; 
- Elim H0;Clear H0;Simpl;Intros;Split with x;Split;Auto.
-Intros;Generalize (H2 x1 H3);Clear H2;Intro;Rewrite Ropp_mul1 in H2;
- Rewrite Ropp_mul1 in H2;Rewrite Ropp_mul1 in H2;
- Rewrite (let (H1,H2)=(Rmult_ne (f x1)) in H2) in H2; 
- Rewrite (let (H1,H2)=(Rmult_ne (f x0)) in H2) in H2;
- Rewrite (let (H1,H2)=(Rmult_ne (df x0)) in H2) in H2;Assumption.
-Qed.
-
-(*********)
-Lemma Dminus:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
-  (D_in f df D x0)->(D_in g dg D x0)->
-  (D_in [x:R](Rminus (f x) (g x)) [x:R](Rminus (df x) (dg x)) D x0).
-Unfold Rminus;Intros;Generalize (Dopp D g dg x0 H0);Intro;
- Apply (Dadd D df [x:R](Ropp (dg x)) f [x:R](Ropp (g x)) x0);Assumption. 
-Qed.
-
-(*********)
-Lemma Dx_pow_n:(n:nat)(D:R->Prop)(x0:R)
-  (D_in [x:R](pow x n)  
-        [x:R](Rmult (INR n) (pow x (minus n (1)))) D x0).
-Induction n;Intros.
-Simpl; Rewrite Rmult_Ol; Apply Dconst.
-Intros;Cut n0=(minus (S n0) (1));
-  [ Intro a; Rewrite <- a;Clear a | Simpl; Apply minus_n_O ].
-Generalize (Dmult D [_:R]R1 
-   [x:R](Rmult (INR n0) (pow x (minus n0 (1)))) [x:R]x [x:R](pow x n0) 
-   x0 (Dx D x0) (H D x0));Unfold D_in;Unfold limit1_in;Unfold limit_in;
- Simpl;Intros;
- Elim (H0 eps H1);Clear H0;Intros;Elim H0;Clear H0;Intros;
- Split with x;Split;Auto.
-Intros;Generalize (H2 x1 H3);Clear H2 H3;Intro;
- Rewrite (let (H1,H2)=(Rmult_ne (pow x0 n0)) in H2) in H2;
- Rewrite (tech_pow_Rmult x1 n0) in H2;
- Rewrite (tech_pow_Rmult x0 n0) in H2;
- Rewrite (Rmult_sym (INR n0) (pow x0 (minus n0 (1)))) in H2;
- Rewrite <-(Rmult_assoc x0 (pow x0 (minus n0 (1))) (INR n0)) in H2;
- Rewrite (tech_pow_Rmult x0 (minus n0 (1))) in H2;
- Elim (classic (n0=O));Intro cond.
-Rewrite cond in H2;Rewrite cond;Simpl in H2;Simpl;
- Cut (Rplus R1 (Rmult (Rmult x0 R1) R0))==(Rmult R1 R1);
- [Intro A; Rewrite A in H2; Assumption|Ring].
-Cut ~(n0=O)->(S (minus n0 (1)))=n0;[Intro|Omega];
- Rewrite (H3 cond) in H2; Rewrite (Rmult_sym (pow x0 n0) (INR n0)) in H2;
- Rewrite (tech_pow_Rplus x0 n0 n0) in H2; Assumption.
-Qed.
-
-(*********)
-Lemma Dcomp:(Df,Dg:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
-  (D_in f df Df x0)->(D_in g dg Dg (f x0))->
-  (D_in [x:R](g (f x)) [x:R](Rmult (df x) (dg (f x))) 
-                       (Dgf Df Dg f) x0).
-Intros Df Dg df dg f g x0 H H0;Generalize H H0;Unfold D_in;Unfold Rdiv;Intros;
-Generalize (limit_comp f [x:R](Rmult (Rminus (g x) (g (f x0)))
-                               (Rinv (Rminus x (f x0)))) (D_x Df x0)
-              (D_x Dg (f x0)) 
-              (f x0) (dg (f x0)) x0);Intro;
- Generalize (cont_deriv f df Df x0 H);Intro;Unfold continue_in in H4;
- Generalize (H3 H4 H2);Clear H3;Intro;
- Generalize (limit_mul [x:R](Rmult (Rminus (g (f x)) (g (f x0)))
-                                   (Rinv (Rminus (f x) (f x0))))
-                       [x:R](Rmult (Rminus (f x) (f x0))
-                                   (Rinv (Rminus x x0))) 
-                       (Dgf (D_x Df x0) (D_x Dg (f x0)) f) 
-                       (dg (f x0)) (df x0) x0 H3);Intro;
- Cut (limit1_in
-         [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
-         (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0).
-Intro;Generalize (H5 H6);Clear H5;Intro;
- Generalize (limit_mul 
-        [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) 
-        [x:R](dg (f x0))
-       (D_x Df x0) (df x0) (dg (f x0)) x0 H1
-    (limit_free [x:R](dg (f x0)) (D_x Df x0) x0 x0));
- Intro;
- Unfold limit1_in;Unfold limit_in;Simpl;Unfold limit1_in in H5 H7;
- Unfold limit_in in H5 H7;Simpl in H5 H7;Intros;Elim (H5 eps H8);
- Elim (H7 eps H8);Clear H5 H7;Intros;Elim H5;Elim H7;Clear H5 H7;
- Intros;Split with (Rmin x x1);Split.
-Elim (Rmin_Rgt x x1 R0);Intros a b;
- Apply (b (conj (Rgt x R0) (Rgt x1 R0) H9 H5));Clear a b.
-Intros;Elim H11;Clear H11;Intros;Elim (Rmin_Rgt x x1 (R_dist x2 x0));
- Intros a b;Clear b;Unfold Rgt in a;Elim (a H12);Clear H5 a;Intros;
- Unfold D_x Dgf in H11 H7 H10;Clear H12;
- Elim (classic (f x2)==(f x0));Intro.
-Elim H11;Clear H11;Intros;Elim H11;Clear H11;Intros;
- Generalize (H10 x2 (conj (Df x2)/\~x0==x2 (Rlt (R_dist x2 x0) x)
-        (conj (Df x2) ~x0==x2 H11 H14) H5));Intro;
- Rewrite (eq_Rminus (f x2) (f x0) H12) in H16;
- Rewrite (Rmult_Ol (Rinv (Rminus x2 x0))) in H16;
- Rewrite (Rmult_Ol (dg (f x0))) in H16;
- Rewrite H12;
- Rewrite (eq_Rminus (g (f x0)) (g (f x0)) (refl_eqT R (g (f x0))));
- Rewrite (Rmult_Ol (Rinv (Rminus x2 x0)));Assumption.
-Clear H10 H5;Elim H11;Clear H11;Intros;Elim H5;Clear H5;Intros;
-Cut (((Df x2)/\~x0==x2)/\(Dg (f x2))/\~(f x0)==(f x2))
-        /\(Rlt (R_dist x2 x0) x1);Auto;Intro;
- Generalize (H7 x2 H14);Intro;
- Generalize (Rminus_eq_contra (f x2) (f x0) H12);Intro;
- Rewrite (Rmult_assoc (Rminus (g (f x2)) (g (f x0))) 
-           (Rinv (Rminus (f x2) (f x0)))
-          (Rmult (Rminus (f x2) (f x0)) (Rinv (Rminus x2 x0)))) in H15;
- Rewrite <-(Rmult_assoc (Rinv (Rminus (f x2) (f x0))) 
-             (Rminus (f x2) (f x0)) (Rinv (Rminus x2 x0))) in H15;
- Rewrite (Rinv_l (Rminus (f x2) (f x0)) H16) in H15;
- Rewrite (let (H1,H2)=(Rmult_ne (Rinv (Rminus x2 x0))) in H2) in H15;
- Rewrite (Rmult_sym (df x0) (dg (f x0)));Assumption.
-Clear H5 H3 H4 H2;Unfold limit1_in;Unfold limit_in;Simpl;
- Unfold limit1_in in H1;Unfold limit_in in H1;Simpl in H1;Intros;
- Elim (H1 eps H2);Clear H1;Intros;Elim H1;Clear H1;Intros;
- Split with x;Split;Auto;Intros;Unfold D_x Dgf in H4 H3;
- Elim H4;Clear H4;Intros;Elim H4;Clear H4;Intros;
- Exact (H3 x1 (conj (Df x1)/\~x0==x1 (Rlt (R_dist x1 x0) x) H4 H5)).
-Qed.   
-
-(*********)
-Lemma D_pow_n:(n:nat)(D:R->Prop)(x0:R)(expr,dexpr:R->R)
- (D_in expr dexpr D x0)-> (D_in [x:R](pow (expr x) n) 
-     [x:R](Rmult (Rmult (INR n) (pow (expr x) (minus n (1)))) (dexpr x)) 
-          (Dgf D D expr) x0).
-Intros n D x0 expr dexpr H; 
- Generalize (Dcomp D D dexpr [x:R](Rmult (INR n) (pow x (minus n (1)))) 
-         expr [x:R](pow x n) x0  H (Dx_pow_n n D (expr x0)));
- Intro; Unfold D_in; Unfold limit1_in; Unfold limit_in;Simpl;Intros; 
- Unfold D_in in H0; Unfold limit1_in in H0; Unfold limit_in in H0;Simpl in H0;
- Elim (H0 eps H1);Clear H0;Intros;Elim H0;Clear H0;Intros;Split with x;Split;
- Intros; Auto.
-Cut ``((dexpr x0)*((INR n)*(pow (expr x0) (minus n (S O)))))==
-            ((INR n)*(pow (expr x0) (minus n (S O)))*(dexpr x0))``;
- [Intro Rew;Rewrite <- Rew;Exact (H2 x1 H3)|Ring].
-Qed.
-
diff --git a/theories7/Reals/Reals.v b/theories7/Reals/Reals.v
deleted file mode 100644
index d0f879ab..00000000
--- a/theories7/Reals/Reals.v
+++ /dev/null
@@ -1,32 +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: Reals.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
-
-(* The library REALS is divided in 6 parts :
-   - Rbase: basic lemmas on R
-            equalities and inequalities
-            Ring and Field are instantiated on R
-   - Rfunctions: some useful functions (Rabsolu, Rmin, Rmax, fact...)
-   - SeqSeries: theory of sequences and series
-   - Rtrigo: theory of trigonometric functions
-   - Ranalysis: some topology and general results of real analysis (mean value theorem, intermediate value theorem,...)
-   - Integration: Newton and Riemann' integrals
-
-  Tactics are:
-  - DiscrR: for goals like ``?1<>0``
-  - Sup: for goals like ``?1<?2``
-  - RCompute: for equalities with constants like ``10*10==100``
-  - Reg: for goals like (continuity_pt ?1 ?2) or (derivable_pt ?1 ?2) *)
-  
-Require Export Rbase.
-Require Export Rfunctions.
-Require Export SeqSeries.
-Require Export Rtrigo.
-Require Export Ranalysis.
-Require Export Integration.
diff --git a/theories7/Reals/Rfunctions.v b/theories7/Reals/Rfunctions.v
deleted file mode 100644
index fe6ccd96..00000000
--- a/theories7/Reals/Rfunctions.v
+++ /dev/null
@@ -1,832 +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: Rfunctions.v,v 1.2.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
-
-(*i Some properties about pow and sum have been made with John Harrison i*)
-(*i Some Lemmas (about pow and powerRZ) have been done by Laurent Thery i*)
-
-(********************************************************)
-(**          Definition of the sum functions            *)
-(*                                                      *)
-(********************************************************)
-
-Require Rbase.
-Require Export R_Ifp.
-Require Export Rbasic_fun.
-Require Export R_sqr.
-Require Export SplitAbsolu.
-Require Export SplitRmult.
-Require Export ArithProp.
-Require Omega.
-Require Zpower.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope nat_scope.
-Open Local Scope R_scope.
-
-(*******************************)
-(**  Lemmas about factorial    *)
-(*******************************)
-(*********)
-Lemma INR_fact_neq_0:(n:nat)~(INR (fact n))==R0.
-Proof.
-Intro;Red;Intro;Apply (not_O_INR (fact n) (fact_neq_0 n));Assumption.
-Qed.    
-
-(*********)
-Lemma fact_simpl : (n:nat) (fact (S n))=(mult (S n) (fact n)).
-Proof.
-Intro; Reflexivity.
-Qed. 
-
-(*********)
-Lemma simpl_fact:(n:nat)(Rmult (Rinv (INR (fact (S n)))) 
-         (Rinv (Rinv (INR (fact n)))))==
-         (Rinv (INR (S n))).
-Proof.
-Intro;Rewrite (Rinv_Rinv (INR (fact n)) (INR_fact_neq_0 n)); 
- Unfold 1 fact;Cbv Beta Iota;Fold fact;
- Rewrite (mult_INR (S n) (fact n));
- Rewrite (Rinv_Rmult (INR (S n)) (INR (fact n))).
-Rewrite (Rmult_assoc (Rinv (INR (S n))) (Rinv (INR (fact n))) 
-  (INR (fact n)));Rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n));
- Apply (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1).
-Apply not_O_INR;Auto.
-Apply INR_fact_neq_0.
-Qed.
-
-(*******************************)
-(*          Power              *)
-(*******************************)
-(*********)
-Fixpoint pow [r:R;n:nat]:R:=
-  Cases n of
-     O     => R1
-    |(S n) => (Rmult r (pow r n))
-  end.
-
-V8Infix "^" pow : R_scope.
-
-Lemma pow_O: (x : R)  (pow x O) == R1.
-Proof.
-Reflexivity.
-Qed.
- 
-Lemma pow_1: (x : R)  (pow x (1)) == x.
-Proof.
-Simpl; Auto with real.
-Qed.
- 
-Lemma pow_add:
- (x : R) (n, m : nat)  (pow x (plus n m)) == (Rmult (pow x n) (pow x m)).
-Proof.
-Intros x n; Elim n; Simpl; Auto with real.
-Intros n0 H' m; Rewrite H'; Auto with real.
-Qed.
-
-Lemma pow_nonzero:
-  (x:R) (n:nat) ~(x==R0) -> ~((pow x n)==R0).
-Proof.
-Intro; Induction n; Simpl.
-Intro; Red;Intro;Apply R1_neq_R0;Assumption.
-Intros;Red; Intro;Elim (without_div_Od x (pow x n0) H1).
-Intro; Auto.
-Apply H;Assumption.
-Qed.
-
-Hints Resolve pow_O pow_1 pow_add pow_nonzero:real.
- 
-Lemma pow_RN_plus:
- (x : R)
- (n, m : nat)
- ~ x == R0 ->  (pow x n) == (Rmult (pow x (plus n m)) (Rinv (pow x m))).
-Proof.
-Intros x n; Elim n; Simpl; Auto with real.
-Intros n0 H' m H'0.
-Rewrite Rmult_assoc; Rewrite <- H'; Auto.
-Qed.
-
-Lemma pow_lt: (x : R) (n : nat) (Rlt R0 x) ->  (Rlt R0 (pow x n)).
-Proof.
-Intros x n; Elim n; Simpl; Auto with real.
-Intros n0 H' H'0; Replace R0 with (Rmult x R0); Auto with real.
-Qed.
-Hints Resolve pow_lt :real.
-
-Lemma Rlt_pow_R1:
- (x : R) (n : nat) (Rlt R1 x) -> (lt O n) ->  (Rlt R1 (pow x n)).
-Proof.
-Intros x n; Elim n; Simpl; Auto with real.
-Intros H' H'0; ElimType False; Omega.
-Intros n0; Case n0.
-Simpl; Rewrite Rmult_1r; Auto.
-Intros n1 H' H'0 H'1.
-Replace R1 with (Rmult R1 R1); Auto with real.
-Apply Rlt_trans with r2 := (Rmult x R1); Auto with real.
-Apply Rlt_monotony; Auto with real.
-Apply Rlt_trans with r2 := R1; Auto with real.
-Apply H'; Auto with arith.
-Qed.
-Hints Resolve Rlt_pow_R1 :real.
-
-Lemma Rlt_pow:
- (x : R) (n, m : nat) (Rlt R1 x) -> (lt n m) ->  (Rlt (pow x n) (pow x m)).
-Proof.
-Intros x n m H' H'0; Replace m with (plus (minus m n) n).
-Rewrite pow_add.
-Pattern 1 (pow x n); Replace (pow x n) with (Rmult R1 (pow x n)); 
- Auto with real.
-Apply Rminus_lt.
-Repeat Rewrite [y : R]  (Rmult_sym y (pow x n)); Rewrite <- Rminus_distr.
-Replace R0 with (Rmult (pow x n) R0); Auto with real.
-Apply Rlt_monotony; Auto with real.
-Apply pow_lt; Auto with real.
-Apply Rlt_trans with r2 := R1; Auto with real.
-Apply Rlt_minus; Auto with real.
-Apply Rlt_pow_R1; Auto with arith.
-Apply simpl_lt_plus_l with p := n; Auto with arith.
-Rewrite le_plus_minus_r; Auto with arith; Rewrite <- plus_n_O; Auto.
-Rewrite plus_sym; Auto with arith.
-Qed.
-Hints Resolve Rlt_pow :real.
-
-(*********)
-Lemma tech_pow_Rmult:(x:R)(n:nat)(Rmult x (pow x n))==(pow x (S n)).
-Proof.
-Induction n; Simpl; Trivial.
-Qed.
-
-(*********)
-Lemma tech_pow_Rplus:(x:R)(a,n:nat)
-  (Rplus (pow x a) (Rmult (INR n) (pow x a)))==
-           (Rmult (INR (S n)) (pow x a)).
-Proof.
-Intros; Pattern 1 (pow x a);  
- Rewrite <-(let (H1,H2)=(Rmult_ne (pow x a)) in H1); 
- Rewrite (Rmult_sym (INR n) (pow x a));
- Rewrite <- (Rmult_Rplus_distr (pow x a) R1 (INR n));
- Rewrite (Rplus_sym R1 (INR n)); Rewrite <-(S_INR n);
- Apply Rmult_sym.
-Qed.
-
-Lemma poly: (n:nat)(x:R)(Rlt R0 x)->
- (Rle (Rplus R1 (Rmult (INR n) x)) (pow  (Rplus R1 x) n)).
-Proof.
-Intros;Elim n.
-Simpl;Cut (Rplus R1 (Rmult R0 x))==R1.
-Intro;Rewrite H0;Unfold Rle;Right; Reflexivity.
-Ring.
-Intros;Unfold pow; Fold pow;
- Apply (Rle_trans (Rplus R1 (Rmult (INR (S n0)) x))
-    (Rmult (Rplus R1 x) (Rplus R1 (Rmult (INR n0) x))) 
-    (Rmult (Rplus R1 x) (pow (Rplus R1 x) n0))).
-Cut (Rmult (Rplus R1 x) (Rplus R1 (Rmult (INR n0) x)))== 
-  (Rplus (Rplus R1 (Rmult (INR (S n0)) x)) 
-         (Rmult (INR n0) (Rmult x x))).
-Intro;Rewrite H1;Pattern 1 (Rplus R1 (Rmult (INR (S n0)) x));
- Rewrite <-(let (H1,H2)=
-   (Rplus_ne (Rplus R1 (Rmult (INR (S n0)) x))) in H1);
- Apply Rle_compatibility;Elim n0;Intros.
-Simpl;Rewrite Rmult_Ol;Unfold Rle;Right;Auto.
-Unfold Rle;Left;Generalize Rmult_gt;Unfold Rgt;Intro;
- Fold (Rsqr x);Apply (H3 (INR (S n1)) (Rsqr x) 
-        (lt_INR_0 (S n1) (lt_O_Sn n1)));Fold (Rgt x R0) in H;
- Apply (pos_Rsqr1 x (imp_not_Req x R0 
-  (or_intror (Rlt x R0) (Rgt x R0) H))).
-Rewrite (S_INR n0);Ring.
-Unfold Rle in H0;Elim H0;Intro. 
-Unfold Rle;Left;Apply Rlt_monotony.
-Rewrite Rplus_sym;
- Apply (Rlt_r_plus_R1 x (Rlt_le R0 x H)).
-Assumption.
-Rewrite H1;Unfold Rle;Right;Trivial.
-Qed.
-
-Lemma Power_monotonic:
- (x:R) (m,n:nat) (Rgt (Rabsolu x) R1) 
-        -> (le m n)
-           -> (Rle (Rabsolu (pow x m)) (Rabsolu (pow x n))).
-Proof.
-Intros x m n H;Induction n;Intros;Inversion H0.
-Unfold Rle; Right; Reflexivity.
-Unfold Rle; Right; Reflexivity.
-Apply (Rle_trans (Rabsolu (pow x m))
-                 (Rabsolu (pow x n))
-                 (Rabsolu (pow x (S n)))).
-Apply Hrecn; Assumption.
-Simpl;Rewrite Rabsolu_mult.
-Pattern 1 (Rabsolu (pow x n)).
-Rewrite <-Rmult_1r.
-Rewrite (Rmult_sym (Rabsolu x) (Rabsolu (pow x n))).
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Unfold Rgt in H.
-Apply Rlt_le; Assumption.
-Qed.
-
-Lemma Pow_Rabsolu: (x:R) (n:nat)
-     (pow (Rabsolu x) n)==(Rabsolu (pow x n)).
-Proof.
-Intro;Induction n;Simpl.
-Apply sym_eqT;Apply Rabsolu_pos_eq;Apply Rlt_le;Apply Rlt_R0_R1.
-Intros; Rewrite H;Apply sym_eqT;Apply Rabsolu_mult.
-Qed.
-
-
-Lemma Pow_x_infinity:
-  (x:R) (Rgt (Rabsolu x) R1)
-        -> (b:R) (Ex [N:nat] ((n:nat) (ge n N) 
-                     -> (Rge (Rabsolu (pow x n)) b ))).
-Proof.
-Intros;Elim (archimed (Rmult b (Rinv (Rminus (Rabsolu x) R1))));Intros;
-  Clear H1;
-  Cut (Ex[N:nat] (Rge (INR N) (Rmult b (Rinv (Rminus (Rabsolu x) R1))))).
-Intro; Elim H1;Clear H1;Intros;Exists x0;Intros;
- Apply (Rge_trans (Rabsolu (pow x n)) (Rabsolu (pow x x0)) b).
-Apply Rle_sym1;Apply Power_monotonic;Assumption.
-Rewrite <- Pow_Rabsolu;Cut (Rabsolu x)==(Rplus R1 (Rminus (Rabsolu x) R1)).
-Intro; Rewrite H3;
- Apply (Rge_trans (pow (Rplus R1 (Rminus (Rabsolu x) R1)) x0)
-                 (Rplus R1 (Rmult (INR x0)  
-                                  (Rminus (Rabsolu x) R1)))
-                 b).
-Apply Rle_sym1;Apply poly;Fold (Rgt (Rminus (Rabsolu x) R1) R0);
- Apply Rgt_minus;Assumption.
-Apply (Rge_trans 
-         (Rplus R1 (Rmult (INR x0) (Rminus (Rabsolu x) R1)))
-         (Rmult (INR x0) (Rminus (Rabsolu x) R1))
-         b).
-Apply Rle_sym1; Apply Rlt_le;Rewrite (Rplus_sym R1 
-                   (Rmult (INR x0) (Rminus (Rabsolu x) R1)));
- Pattern 1 (Rmult (INR x0) (Rminus (Rabsolu x) R1));
- Rewrite <- (let (H1,H2) = (Rplus_ne 
-            (Rmult (INR x0) (Rminus (Rabsolu x) R1))) in
-         H1);
- Apply Rlt_compatibility;
- Apply Rlt_R0_R1.
-Cut b==(Rmult (Rmult b (Rinv (Rminus (Rabsolu x) R1)))
-              (Rminus (Rabsolu x) R1)).
-Intros; Rewrite H4;Apply Rge_monotony.
-Apply Rge_minus;Unfold Rge; Left; Assumption.
-Assumption.
-Rewrite Rmult_assoc;Rewrite Rinv_l.
-Ring.
-Apply imp_not_Req; Right;Apply Rgt_minus;Assumption.
-Ring.
-Cut `0<= (up (Rmult b (Rinv (Rminus (Rabsolu x) R1))))`\/
-     `(up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))) <=  0`.
-Intros;Elim H1;Intro.
-Elim (IZN (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))) H2);Intros;Exists x0;
- Apply (Rge_trans 
-   (INR x0)
-   (IZR (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))))
-   (Rmult b (Rinv (Rminus (Rabsolu x) R1)))).
-Rewrite INR_IZR_INZ;Apply IZR_ge;Omega.
-Unfold Rge; Left; Assumption.
-Exists O;Apply (Rge_trans (INR (0))
-          (IZR (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))))
-          (Rmult b (Rinv (Rminus (Rabsolu x) R1)))).
-Rewrite INR_IZR_INZ;Apply IZR_ge;Simpl;Omega.
-Unfold Rge; Left; Assumption.
-Omega.
-Qed.
-
-Lemma pow_ne_zero:
-  (n:nat) ~(n=(0))-> (pow R0 n) == R0.
-Proof.
-Induction n.
-Simpl;Auto.
-Intros;Elim H;Reflexivity.
-Intros; Simpl;Apply Rmult_Ol.
-Qed.
-
-Lemma Rinv_pow:
-  (x:R) (n:nat) ~(x==R0) -> (Rinv (pow x n))==(pow (Rinv x) n).
-Proof.
-Intros; Elim n; Simpl.
-Apply Rinv_R1.
-Intro m;Intro;Rewrite Rinv_Rmult.
-Rewrite H0; Reflexivity;Assumption.
-Assumption.
-Apply pow_nonzero;Assumption.
-Qed.
-
-Lemma pow_lt_1_zero:
-  (x:R) (Rlt (Rabsolu x) R1)
-        -> (y:R) (Rlt R0 y) 
-                 -> (Ex[N:nat] (n:nat) (ge n N)
-                         -> (Rlt (Rabsolu (pow x n)) y)).
-Proof.
-Intros;Elim (Req_EM x R0);Intro. 
-Exists (1);Rewrite H1;Intros n GE;Rewrite pow_ne_zero.
-Rewrite Rabsolu_R0;Assumption.
-Inversion GE;Auto.
-Cut (Rgt (Rabsolu (Rinv x)) R1).
-Intros;Elim (Pow_x_infinity (Rinv x) H2 (Rplus (Rinv y) R1));Intros N.
-Exists N;Intros;Rewrite <- (Rinv_Rinv y).
-Rewrite <- (Rinv_Rinv (Rabsolu (pow x n))).
-Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply Rlt_Rinv.
-Assumption.
-Apply Rlt_Rinv.
-Apply Rabsolu_pos_lt.
-Apply pow_nonzero.
-Assumption.
-Rewrite <- Rabsolu_Rinv.
-Rewrite Rinv_pow.
-Apply (Rlt_le_trans (Rinv y)
-                    (Rplus (Rinv y) R1)
-                    (Rabsolu (pow (Rinv x) n))).
-Pattern 1 (Rinv y).
-Rewrite <- (let (H1,H2) = 
-                (Rplus_ne (Rinv y)) in H1).
-Apply Rlt_compatibility.
-Apply Rlt_R0_R1.
-Apply Rle_sym2.
-Apply H3.
-Assumption.
-Assumption.
-Apply pow_nonzero.
-Assumption.
-Apply Rabsolu_no_R0.
-Apply pow_nonzero.
-Assumption.
-Apply imp_not_Req.
-Right; Unfold Rgt; Assumption.
-Rewrite <- (Rinv_Rinv R1).
-Rewrite Rabsolu_Rinv.
-Unfold Rgt; Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt.
-Assumption.
-Rewrite Rinv_R1; Apply Rlt_R0_R1.
-Rewrite Rinv_R1; Assumption.
-Assumption.
-Red;Intro; Apply R1_neq_R0;Assumption.
-Qed.
-
-Lemma pow_R1:
- (r : R) (n : nat) (pow r n) == R1 ->  (Rabsolu r) == R1 \/ n = O.
-Proof.
-Intros r n H'.
-Case (Req_EM (Rabsolu r) R1); Auto; Intros H'1.
-Case (not_Req ? ? H'1); Intros H'2.
-Generalize H'; Case n; Auto.
-Intros n0 H'0.
-Cut ~ r == R0; [Intros Eq1 | Idtac].
-Cut ~ (Rabsolu r) == R0; [Intros Eq2 | Apply Rabsolu_no_R0]; Auto.
-Absurd (Rlt (pow (Rabsolu (Rinv r)) O) (pow (Rabsolu (Rinv r)) (S n0))); Auto.
-Replace (pow (Rabsolu (Rinv r)) (S n0)) with R1.
-Simpl; Apply Rlt_antirefl; Auto.
-Rewrite Rabsolu_Rinv; Auto.
-Rewrite <- Rinv_pow; Auto.
-Rewrite Pow_Rabsolu; Auto.
-Rewrite H'0; Rewrite Rabsolu_right; Auto with real.
-Apply Rle_ge; Auto with real.
-Apply Rlt_pow; Auto with arith.
-Rewrite Rabsolu_Rinv; Auto.
-Apply Rlt_monotony_contra with z := (Rabsolu r).
-Case (Rabsolu_pos r); Auto.
-Intros H'3; Case Eq2; Auto.
-Rewrite Rmult_1r; Rewrite Rinv_r; Auto with real.
-Red;Intro;Absurd ``(pow r (S n0)) == 1``;Auto.
-Simpl; Rewrite H; Rewrite Rmult_Ol; Auto with real.
-Generalize H'; Case n; Auto.
-Intros n0 H'0.
-Cut ~ r == R0; [Intros Eq1 | Auto with real].
-Cut ~ (Rabsolu r) == R0; [Intros Eq2 | Apply Rabsolu_no_R0]; Auto.
-Absurd (Rlt (pow (Rabsolu r) O) (pow (Rabsolu r) (S n0))); 
-  Auto with real arith.
-Repeat Rewrite Pow_Rabsolu; Rewrite H'0; Simpl; Auto with real.
-Red;Intro;Absurd ``(pow r (S n0)) == 1``;Auto.
-Simpl; Rewrite H; Rewrite Rmult_Ol; Auto with real.
-Qed.
-
-Lemma pow_Rsqr : (x:R;n:nat) (pow x (mult (2) n))==(pow (Rsqr x) n).
-Proof.
-Intros; Induction n.
-Reflexivity.
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Replace (pow x (S (S (mult (2) n)))) with ``x*x*(pow x (mult (S (S O)) n))``.
-Rewrite Hrecn; Reflexivity.
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Qed.
-
-Lemma pow_le : (a:R;n:nat) ``0<=a`` -> ``0<=(pow a n)``.
-Proof.
-Intros; Induction n.
-Simpl; Left; Apply Rlt_R0_R1.
-Simpl; Apply Rmult_le_pos; Assumption.
-Qed.
-
-(**********)
-Lemma pow_1_even : (n:nat) ``(pow (-1) (mult (S (S O)) n))==1``.
-Proof.
-Intro; Induction n.
-Reflexivity.
-Replace (mult (2) (S n)) with (plus (2) (mult (2) n)).
-Rewrite pow_add; Rewrite Hrecn; Simpl; Ring.
-Replace (S n) with (plus n (1)); [Ring | Ring].
-Qed.
-
-(**********)
-Lemma pow_1_odd : (n:nat) ``(pow (-1) (S (mult (S (S O)) n)))==-1``.
-Proof.
-Intro; Replace (S (mult (2) n)) with (plus (mult (2) n) (1)); [Idtac | Ring].
-Rewrite pow_add; Rewrite pow_1_even; Simpl; Ring.
-Qed.
-
-(**********)
-Lemma pow_1_abs : (n:nat) ``(Rabsolu (pow (-1) n))==1``.
-Proof.
-Intro; Induction n.
-Simpl; Apply Rabsolu_R1.
-Replace (S n) with (plus n (1)); [Rewrite pow_add | Ring].
-Rewrite Rabsolu_mult.
-Rewrite Hrecn; Rewrite Rmult_1l; Simpl; Rewrite Rmult_1r; Rewrite Rabsolu_Ropp; Apply Rabsolu_R1.
-Qed.
-
-Lemma pow_mult : (x:R;n1,n2:nat) (pow x (mult n1 n2))==(pow (pow x n1) n2).
-Proof.
-Intros; Induction n2.
-Simpl; Replace (mult n1 O) with O; [Reflexivity | Ring].
-Replace (mult n1 (S n2)) with (plus (mult n1 n2) n1).
-Replace (S n2) with (plus n2 (1)); [Idtac | Ring].
-Do 2 Rewrite pow_add.
-Rewrite Hrecn2.
-Simpl.
-Ring.
-Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite mult_INR; Rewrite S_INR; Ring.
-Qed.
-
-Lemma pow_incr : (x,y:R;n:nat) ``0<=x<=y`` -> ``(pow x n)<=(pow y n)``.
-Proof.
-Intros.
-Induction n.
-Right; Reflexivity.
-Simpl.
-Elim H; Intros.
-Apply Rle_trans with ``y*(pow x n)``.
-Do 2 Rewrite <- (Rmult_sym (pow x n)).
-Apply Rle_monotony.
-Apply pow_le; Assumption.
-Assumption.
-Apply Rle_monotony.
-Apply Rle_trans with x; Assumption.
-Apply Hrecn.
-Qed.
-
-Lemma pow_R1_Rle : (x:R;k:nat) ``1<=x`` -> ``1<=(pow x k)``.
-Proof.
-Intros.
-Induction k.
-Right; Reflexivity.
-Simpl.
-Apply Rle_trans with ``x*1``.
-Rewrite Rmult_1r; Assumption.
-Apply Rle_monotony.
-Left; Apply Rlt_le_trans with R1; [Apply Rlt_R0_R1 | Assumption].
-Exact Hreck.
-Qed.
-
-Lemma Rle_pow : (x:R;m,n:nat) ``1<=x`` -> (le m n) -> ``(pow x m)<=(pow x n)``.
-Proof.
-Intros.
-Replace n with (plus (minus n m) m).
-Rewrite pow_add.
-Rewrite Rmult_sym.
-Pattern 1 (pow x m); Rewrite <- Rmult_1r.
-Apply Rle_monotony.
-Apply pow_le; Left; Apply Rlt_le_trans with R1; [Apply Rlt_R0_R1 | Assumption].
-Apply pow_R1_Rle; Assumption.
-Rewrite plus_sym.
-Symmetry; Apply le_plus_minus; Assumption.
-Qed.
-
-Lemma pow1 : (n:nat) (pow R1 n)==R1.
-Proof.
-Intro; Induction n.
-Reflexivity.
-Simpl; Rewrite Hrecn; Rewrite Rmult_1r; Reflexivity.
-Qed.
-
-Lemma pow_Rabs : (x:R;n:nat) ``(pow x n)<=(pow (Rabsolu x) n)``.
-Proof.
-Intros; Induction n.
-Right; Reflexivity.
-Simpl; Case (case_Rabsolu x); Intro.
-Apply Rle_trans with (Rabsolu ``x*(pow x n)``).
-Apply Rle_Rabsolu.
-Rewrite Rabsolu_mult.
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Right; Symmetry; Apply Pow_Rabsolu.
-Pattern 1 (Rabsolu x); Rewrite (Rabsolu_right x r); Apply Rle_monotony.
-Apply Rle_sym2; Exact r.
-Apply Hrecn.
-Qed.
-
-Lemma pow_maj_Rabs : (x,y:R;n:nat) ``(Rabsolu y)<=x`` -> ``(pow y n)<=(pow x n)``.
-Proof.
-Intros; Cut ``0<=x``.
-Intro; Apply Rle_trans with (pow (Rabsolu y) n).
-Apply pow_Rabs.
-Induction n.
-Right; Reflexivity.
-Simpl; Apply Rle_trans with ``x*(pow (Rabsolu y) n)``.
-Do 2 Rewrite <- (Rmult_sym (pow (Rabsolu y) n)).
-Apply Rle_monotony.
-Apply pow_le; Apply Rabsolu_pos.
-Assumption.
-Apply Rle_monotony.
-Apply H0.
-Apply Hrecn.
-Apply Rle_trans with (Rabsolu y); [Apply Rabsolu_pos | Exact H].
-Qed.
-
-(*******************************)
-(**         PowerRZ            *)
-(*******************************)
-(*i Due to L.Thery i*)
-
-Tactic Definition CaseEqk name :=
-Generalize (refl_equal ? name); Pattern -1 name; Case name.
-
-Definition powerRZ :=
-   [x : R] [n : Z]  Cases n of
-                      ZERO => R1
-                     | (POS p) => (pow x (convert p))
-                     | (NEG p) => (Rinv (pow x (convert p)))
-                    end.
-
-Infix Local "^Z" powerRZ (at level 2, left associativity) : R_scope.
-
-Lemma Zpower_NR0:
- (x : Z) (n : nat) (Zle ZERO x) ->  (Zle ZERO (Zpower_nat x n)).
-Proof.
-NewInduction n; Unfold Zpower_nat; Simpl; Auto with zarith.
-Qed.
-
-Lemma powerRZ_O: (x : R)  (powerRZ x ZERO) == R1.
-Proof.
-Reflexivity.
-Qed.
- 
-Lemma powerRZ_1: (x : R)  (powerRZ x (Zs ZERO)) == x.
-Proof.
-Simpl; Auto with real.
-Qed.
- 
-Lemma powerRZ_NOR: (x : R) (z : Z) ~ x == R0 ->  ~ (powerRZ x z) == R0.
-Proof.
-NewDestruct z; Simpl; Auto with real.
-Qed.
- 
-Lemma powerRZ_add:
- (x : R)
- (n, m : Z)
- ~ x == R0 ->  (powerRZ x (Zplus n m)) == (Rmult (powerRZ x n) (powerRZ x m)).
-Proof.
-Intro x; NewDestruct n as [|n1|n1]; NewDestruct m as [|m1|m1]; Simpl;
-  Auto with real.
-(* POS/POS *)
-Rewrite convert_add; Auto with real.
-(* POS/NEG *)
-(CaseEqk '(compare n1 m1 EGAL)); Simpl; Auto with real.
-Intros H' H'0; Rewrite compare_convert_EGAL with 1 := H'; Auto with real.
-Intros H' H'0; Rewrite (true_sub_convert m1 n1); Auto with real.
-Rewrite (pow_RN_plus x (minus (convert m1) (convert n1)) (convert n1));
- Auto with real.
-Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
-Rewrite Rinv_Rmult; Auto with real.
-Rewrite Rinv_Rinv; Auto with real.
-Apply lt_le_weak.
-Apply compare_convert_INFERIEUR; Auto.
-Apply ZC2; Auto.
-Intros H' H'0; Rewrite (true_sub_convert n1 m1); Auto with real.
-Rewrite (pow_RN_plus x (minus (convert n1) (convert m1)) (convert m1));
- Auto with real.
-Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
-Apply lt_le_weak.
-Change (gt (convert n1) (convert m1)).
-Apply compare_convert_SUPERIEUR; Auto.
-(* NEG/POS *)
-(CaseEqk '(compare n1 m1 EGAL)); Simpl; Auto with real.
-Intros H' H'0; Rewrite compare_convert_EGAL with 1 := H'; Auto with real.
-Intros H' H'0; Rewrite (true_sub_convert m1 n1); Auto with real.
-Rewrite (pow_RN_plus x (minus (convert m1) (convert n1)) (convert n1));
- Auto with real.
-Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
-Apply lt_le_weak.
-Apply compare_convert_INFERIEUR; Auto.
-Apply ZC2; Auto.
-Intros H' H'0; Rewrite (true_sub_convert n1 m1); Auto with real.
-Rewrite (pow_RN_plus x (minus (convert n1) (convert m1)) (convert m1));
- Auto with real.
-Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
-Rewrite Rinv_Rmult; Auto with real.
-Apply lt_le_weak.
-Change (gt (convert n1) (convert m1)).
-Apply compare_convert_SUPERIEUR; Auto.
-(* NEG/NEG *)
-Rewrite convert_add; Auto with real.
-Intros H'; Rewrite pow_add; Auto with real.
-Apply Rinv_Rmult; Auto.
-Apply pow_nonzero; Auto.
-Apply pow_nonzero; Auto.
-Qed.
-Hints Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add :real.
- 
-Lemma Zpower_nat_powerRZ:
- (n, m : nat)
-  (IZR (Zpower_nat (inject_nat n) m)) == (powerRZ (INR n) (inject_nat m)).
-Proof.
-Intros n m; Elim m; Simpl; Auto with real.
-Intros m1 H'; Rewrite bij1; Simpl.
-Replace (Zpower_nat (inject_nat n) (S m1))
-     with (Zmult (inject_nat n) (Zpower_nat (inject_nat n) m1)).
-Rewrite mult_IZR; Auto with real.
-Repeat Rewrite <- INR_IZR_INZ; Simpl.
-Rewrite H'; Simpl.
-Case m1; Simpl; Auto with real.
-Intros m2; Rewrite bij1; Auto.
-Unfold Zpower_nat; Auto.
-Qed.
- 
-Lemma powerRZ_lt: (x : R) (z : Z) (Rlt R0 x) ->  (Rlt R0 (powerRZ x z)).
-Proof.
-Intros x z; Case z; Simpl; Auto with real.
-Qed.
-Hints Resolve powerRZ_lt :real.
- 
-Lemma powerRZ_le: (x : R) (z : Z) (Rlt R0 x) ->  (Rle R0 (powerRZ x z)).
-Proof.
-Intros x z H'; Apply Rlt_le; Auto with real.
-Qed.
-Hints Resolve powerRZ_le :real.
- 
-Lemma Zpower_nat_powerRZ_absolu:
- (n, m : Z)
- (Zle ZERO m) ->  (IZR (Zpower_nat n (absolu m))) == (powerRZ (IZR n) m).
-Proof.
-Intros n m; Case m; Simpl; Auto with zarith.
-Intros p H'; Elim (convert p); Simpl; Auto with zarith.
-Intros n0 H'0; Rewrite <- H'0; Simpl; Auto with zarith.
-Rewrite <- mult_IZR; Auto.
-Intros p H'; Absurd `0 <= (NEG p)`;Auto with zarith.
-Qed.
-
-Lemma powerRZ_R1: (n : Z)  (powerRZ R1 n) == R1.
-Proof.
-Intros n; Case n; Simpl; Auto.
-Intros p; Elim (convert p); Simpl; Auto; Intros n0 H'; Rewrite H'; Ring.
-Intros p; Elim (convert p); Simpl.
-Exact Rinv_R1.
-Intros n1 H'; Rewrite Rinv_Rmult; Try Rewrite Rinv_R1; Try Rewrite H';
- Auto with real.
-Qed.
-
-(*******************************)
-(** Sum of n first naturals    *)
-(*******************************)
-(*********)
-Fixpoint sum_nat_f_O [f:nat->nat;n:nat]:nat:=       
-  Cases n of                            
-    O => (f O)                               
-   |(S n') => (plus (sum_nat_f_O f n') (f (S n'))) 
-  end.
-
-(*********)
-Definition sum_nat_f [s,n:nat;f:nat->nat]:nat:=      
-  (sum_nat_f_O [x:nat](f (plus x s)) (minus n s)).
-
-(*********)
-Definition sum_nat_O [n:nat]:nat:=
-  (sum_nat_f_O [x:nat]x n).
-
-(*********)
-Definition sum_nat [s,n:nat]:nat:=
-  (sum_nat_f s n [x:nat]x).
-
-(*******************************)
-(**            Sum             *)
-(*******************************)
-(*********)
-Fixpoint sum_f_R0 [f:nat->R;N:nat]:R:=
-  Cases N of
-     O     => (f O)
-    |(S i) => (Rplus (sum_f_R0 f i) (f (S i)))
-  end.
-
-(*********)
-Definition sum_f [s,n:nat;f:nat->R]:R:=      
-  (sum_f_R0 [x:nat](f (plus x s)) (minus n s)).
-
-Lemma GP_finite:
-  (x:R) (n:nat) (Rmult (sum_f_R0 [n:nat] (pow x n) n)
-                       (Rminus x R1)) ==
-                (Rminus (pow x (plus n (1))) R1).
-Proof.
-Intros; Induction n; Simpl.
-Ring.
-Rewrite Rmult_Rplus_distrl;Rewrite Hrecn;Cut (plus n (1))=(S n).
-Intro H;Rewrite H;Simpl;Ring.
-Omega.
-Qed.
-
-Lemma sum_f_R0_triangle:
-  (x:nat->R)(n:nat) (Rle (Rabsolu (sum_f_R0 x n))
-                         (sum_f_R0 [i:nat] (Rabsolu (x i)) n)).
-Proof.
-Intro; Induction n; Simpl.
-Unfold Rle; Right; Reflexivity.
-Intro m; Intro;Apply (Rle_trans
-          (Rabsolu (Rplus (sum_f_R0 x m) (x (S m))))
-          (Rplus (Rabsolu (sum_f_R0 x m))
-                 (Rabsolu (x (S m))))
-          (Rplus (sum_f_R0 [i:nat](Rabsolu (x i)) m) 
-                 (Rabsolu (x (S m))))).
-Apply Rabsolu_triang.
-Rewrite Rplus_sym;Rewrite (Rplus_sym 
-  (sum_f_R0 [i:nat](Rabsolu (x i)) m) (Rabsolu (x (S m))));
-  Apply Rle_compatibility;Assumption.
-Qed.
-
-(*******************************)
-(*        Distance  in R       *)
-(*******************************)
-
-(*********)
-Definition R_dist:R->R->R:=[x,y:R](Rabsolu (Rminus x y)).
-
-(*********)
-Lemma R_dist_pos:(x,y:R)(Rge (R_dist x y) R0).
-Proof.
-Intros;Unfold R_dist;Unfold Rabsolu;Case (case_Rabsolu (Rminus x y));Intro l.
-Unfold Rge;Left;Apply (Rlt_RoppO (Rminus x y) l).
-Trivial.
-Qed.
-
-(*********)
-Lemma R_dist_sym:(x,y:R)(R_dist x y)==(R_dist y x).
-Proof.
-Unfold R_dist;Intros;SplitAbsolu;Ring.
-Generalize (Rlt_RoppO (Rminus y x) r); Intro;
- Rewrite (Ropp_distr2 y x) in H;
- Generalize (Rlt_antisym (Rminus x y) R0 r0); Intro;Unfold Rgt in H;
- ElimType False; Auto.
-Generalize (minus_Rge y x r); Intro;
- Generalize (minus_Rge x y r0); Intro;
- Generalize (Rge_ge_eq x y H0 H); Intro;Rewrite H1;Ring.
-Qed.
-
-(*********)
-Lemma R_dist_refl:(x,y:R)((R_dist x y)==R0<->x==y).
-Proof.
-Unfold R_dist;Intros;SplitAbsolu;Split;Intros.
-Rewrite (Ropp_distr2 x y) in H;Apply sym_eqT;
- Apply (Rminus_eq y x H).
-Rewrite (Ropp_distr2 x y);Generalize (sym_eqT R x y H);Intro;
- Apply (eq_Rminus y x H0).
-Apply (Rminus_eq x y H).
-Apply (eq_Rminus x y H). 
-Qed.
-
-Lemma R_dist_eq:(x:R)(R_dist x x)==R0.
-Proof.
-Unfold R_dist;Intros;SplitAbsolu;Intros;Ring.
-Qed.
-
-(***********)
-Lemma R_dist_tri:(x,y,z:R)(Rle (R_dist x y) 
-                   (Rplus (R_dist x z) (R_dist z y))).
-Proof.
-Intros;Unfold R_dist; Replace ``x-y`` with ``(x-z)+(z-y)``;
-  [Apply (Rabsolu_triang ``x-z`` ``z-y``)|Ring].
-Qed.
-
-(*********)
-Lemma R_dist_plus: (a,b,c,d:R)(Rle (R_dist (Rplus a c) (Rplus b d))
-                   (Rplus (R_dist a b) (R_dist c d))).
-Proof.
-Intros;Unfold R_dist;
- Replace (Rminus (Rplus a c) (Rplus b d))
-  with (Rplus (Rminus a b) (Rminus c d)).
-Exact (Rabsolu_triang (Rminus a b) (Rminus c d)).
-Ring.
-Qed.
-
-(*******************************)
-(**       Infinit Sum          *)
-(*******************************)
-(*********)
-Definition infinit_sum:(nat->R)->R->Prop:=[s:nat->R;l:R]
-  (eps:R)(Rgt eps R0)->
-  (Ex[N:nat](n:nat)(ge n N)->(Rlt (R_dist (sum_f_R0 s n) l) eps)).
diff --git a/theories7/Reals/Rgeom.v b/theories7/Reals/Rgeom.v
deleted file mode 100644
index 12c52e37..00000000
--- a/theories7/Reals/Rgeom.v
+++ /dev/null
@@ -1,84 +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: Rgeom.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require R_sqrt.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Definition dist_euc [x0,y0,x1,y1:R] : R := ``(sqrt ((Rsqr (x0-x1))+(Rsqr (y0-y1))))``.
-
-Lemma distance_refl : (x0,y0:R) ``(dist_euc x0 y0 x0 y0)==0``.
-Intros x0 y0; Unfold dist_euc; Apply Rsqr_inj; [Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; [Apply pos_Rsqr | Apply pos_Rsqr] | Right; Reflexivity | Rewrite Rsqr_O; Rewrite Rsqr_sqrt; [Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0; [Apply pos_Rsqr | Apply pos_Rsqr]]].
-Qed.
-
-Lemma distance_symm : (x0,y0,x1,y1:R) ``(dist_euc x0 y0 x1 y1) == (dist_euc x1 y1 x0 y0)``. 
-Intros x0 y0 x1 y1; Unfold dist_euc; Apply Rsqr_inj; [ Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Repeat Rewrite Rsqr_sqrt; [Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0 |Apply ge0_plus_ge0_is_ge0]]; Apply pos_Rsqr.
-Qed.
-
-Lemma law_cosines : (x0,y0,x1,y1,x2,y2,ac:R) let a = (dist_euc x1 y1 x0 y0) in let b=(dist_euc x2 y2 x0 y0) in let c=(dist_euc x2 y2 x1 y1) in ( ``a*c*(cos ac) == ((x0-x1)*(x2-x1) + (y0-y1)*(y2-y1))`` -> ``(Rsqr b)==(Rsqr c)+(Rsqr a)-2*(a*c*(cos ac))`` ).
-Unfold dist_euc; Intros; Repeat Rewrite -> Rsqr_sqrt; [ Rewrite H; Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0]; Apply pos_Rsqr.
-Qed.
-
-Lemma triangle : (x0,y0,x1,y1,x2,y2:R) ``(dist_euc x0 y0 x1 y1)<=(dist_euc x0 y0 x2 y2)+(dist_euc x2 y2 x1 y1)``.
-Intros; Unfold dist_euc; Apply Rsqr_incr_0; [Rewrite Rsqr_plus; Repeat Rewrite Rsqr_sqrt; [Replace ``(Rsqr (x0-x1))`` with ``(Rsqr (x0-x2))+(Rsqr (x2-x1))+2*(x0-x2)*(x2-x1)``; [Replace ``(Rsqr (y0-y1))`` with ``(Rsqr (y0-y2))+(Rsqr (y2-y1))+2*(y0-y2)*(y2-y1)``; [Apply Rle_anti_compatibility with ``-(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))``; Replace `` -(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))+((Rsqr (x0-x2))+(Rsqr (x2-x1))+2*(x0-x2)*(x2-x1)+((Rsqr (y0-y2))+(Rsqr (y2-y1))+2*(y0-y2)*(y2-y1)))`` with ``2*((x0-x2)*(x2-x1)+(y0-y2)*(y2-y1))``; [Replace ``-(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))+((Rsqr (x0-x2))+(Rsqr (y0-y2))+((Rsqr (x2-x1))+(Rsqr (y2-y1)))+2*(sqrt ((Rsqr (x0-x2))+(Rsqr (y0-y2))))*(sqrt ((Rsqr (x2-x1))+(Rsqr (y2-y1)))))`` with ``2*((sqrt ((Rsqr (x0-x2))+(Rsqr (y0-y2))))*(sqrt ((Rsqr (x2-x1))+(Rsqr (y2-y1)))))``; [Apply Rle_monotony; [Left; Cut ~(O=(2)); [Intros; Generalize (lt_INR_0 (2) (neq_O_lt (2) H)); Intro H0; Assumption | Discriminate] | Apply sqrt_cauchy] | Ring] | Ring] | SqRing] | SqRing] | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr] | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr].
-Qed.
-
-(******************************************************************)
-(**                         Translation                           *)
-(******************************************************************)
-
-Definition xt[x,tx:R] : R := ``x+tx``.
-Definition yt[y,ty:R] : R := ``y+ty``.
-
-Lemma translation_0 : (x,y:R) ``(xt x 0)==x``/\``(yt y 0)==y``.
-Intros x y; Split; [Unfold xt | Unfold yt]; Ring.
-Qed.
-
-Lemma isometric_translation : (x1,x2,y1,y2,tx,ty:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2))==(Rsqr ((xt x1 tx)-(xt x2 tx)))+(Rsqr ((yt y1 ty)-(yt y2 ty)))``.
-Intros; Unfold Rsqr xt yt; Ring.
-Qed.
-
-(******************************************************************)
-(**                           Rotation                            *)
-(******************************************************************)
-
-Definition xr [x,y,theta:R] : R := ``x*(cos theta)+y*(sin theta)``.
-Definition yr [x,y,theta:R] : R := ``-x*(sin theta)+y*(cos theta)``.
-
-Lemma rotation_0 : (x,y:R) ``(xr x y 0)==x`` /\ ``(yr x y 0)==y``.
-Intros x y; Unfold xr yr; Split; Rewrite cos_0; Rewrite sin_0; Ring.
-Qed.
-
-Lemma rotation_PI2 : (x,y:R) ``(xr x y PI/2)==y`` /\ ``(yr x y PI/2)==-x``.
-Intros  x y; Unfold xr yr; Split; Rewrite cos_PI2; Rewrite sin_PI2; Ring.
-Qed.
-
-Lemma isometric_rotation_0 : (x1,y1,x2,y2,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xr x1 y1 theta))-(xr x2 y2 theta)) + (Rsqr ((yr x1 y1 theta))-(yr x2 y2 theta))``.
-Intros; Unfold xr yr; Replace ``x1*(cos theta)+y1*(sin theta)-(x2*(cos theta)+y2*(sin theta))`` with ``(cos theta)*(x1-x2)+(sin theta)*(y1-y2)``; [Replace ``-x1*(sin theta)+y1*(cos theta)-( -x2*(sin theta)+y2*(cos theta))`` with ``(cos theta)*(y1-y2)+(sin theta)*(x2-x1)``; [Repeat Rewrite Rsqr_plus; Repeat Rewrite Rsqr_times; Repeat Rewrite cos2; Ring; Replace ``x2-x1`` with ``-(x1-x2)``; [Rewrite <- Rsqr_neg; Ring | Ring] |Ring] | Ring].
-Qed.
-
-Lemma isometric_rotation : (x1,y1,x2,y2,theta:R) ``(dist_euc x1 y1 x2 y2) == (dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) (yr x2 y2 theta))``.
-Unfold dist_euc; Intros; Apply Rsqr_inj; [Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Repeat Rewrite Rsqr_sqrt; [ Apply isometric_rotation_0 | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0]]; Apply pos_Rsqr.
-Qed.
-
-(******************************************************************)
-(**                         Similarity                            *)
-(******************************************************************)
-
-Lemma isometric_rot_trans : (x1,y1,x2,y2,tx,ty,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xr (xt x1 tx) (yt y1 ty) theta)-(xr (xt x2 tx) (yt y2 ty) theta))) + (Rsqr ((yr (xt x1 tx) (yt y1 ty) theta)-(yr (xt x2 tx) (yt y2 ty) theta)))``. 
-Intros; Rewrite <- isometric_rotation_0; Apply isometric_translation.
-Qed.
-
-Lemma isometric_trans_rot : (x1,y1,x2,y2,tx,ty,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xt (xr x1 y1 theta) tx)-(xt (xr x2 y2 theta) tx))) + (Rsqr ((yt (yr x1 y1 theta) ty)-(yt (yr x2 y2 theta) ty)))``. 
-Intros; Rewrite <- isometric_translation; Apply isometric_rotation_0.
-Qed.
diff --git a/theories7/Reals/RiemannInt.v b/theories7/Reals/RiemannInt.v
deleted file mode 100644
index cc537c6d..00000000
--- a/theories7/Reals/RiemannInt.v
+++ /dev/null
@@ -1,1699 +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: RiemannInt.v,v 1.1.2.2 2005/07/13 23:19:16 herbelin Exp $ i*)
-
-Require Rfunctions.
-Require SeqSeries.
-Require Ranalysis.
-Require Rbase.
-Require RiemannInt_SF.
-Require Classical_Prop.
-Require Classical_Pred_Type.
-Require Max.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Implicit Arguments On.
-
-(********************************************)
-(*            Riemann's Integral            *)
-(********************************************)
-
-Definition Riemann_integrable [f:R->R;a,b:R] : Type := (eps:posreal) (SigT ? [phi:(StepFun a b)](SigT ? [psi:(StepFun a b)]((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi t)))<=(psi t)``)/\``(Rabsolu (RiemannInt_SF psi))<eps``)).
-
-Definition phi_sequence [un:nat->posreal;f:R->R;a,b:R;pr:(Riemann_integrable f a b)] := [n:nat](projT1 ? ? (pr (un n))).
-
-Lemma phi_sequence_prop : (un:nat->posreal;f:R->R;a,b:R;pr:(Riemann_integrable f a b);N:nat) (SigT ? [psi:(StepFun a b)]((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-[(phi_sequence un pr N t)]))<=(psi t)``)/\``(Rabsolu (RiemannInt_SF psi))<(un N)``).
-Intros; Apply (projT2 ? ? (pr (un N))).
-Qed.
-
-Lemma RiemannInt_P1 : (f:R->R;a,b:R) (Riemann_integrable f a b) -> (Riemann_integrable f b a).
-Unfold Riemann_integrable; Intros; Elim (X eps); Clear X; Intros; Elim p; Clear p; Intros; Apply Specif.existT with (mkStepFun (StepFun_P6 (pre x))); Apply Specif.existT with (mkStepFun (StepFun_P6 (pre x0))); Elim p; Clear p; Intros; Split.
-Intros; Apply (H t); Elim H1; Clear H1; Intros; Split; [Apply Rle_trans with (Rmin b a); Try Assumption; Right; Unfold Rmin | Apply Rle_trans with (Rmax b a); Try Assumption; Right; Unfold Rmax]; (Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse Apply Rle_antisym; [Assumption | Assumption | Auto with real | Auto with real]).
-Generalize H0; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; (Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with (Int_SF (subdivision_val x0) (subdivision x0)); [Idtac | Apply StepFun_P17 with (fe x0) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0))))]]).
-Apply H1.
-Rewrite Rabsolu_Ropp; Apply H1.
-Rewrite Rabsolu_Ropp in H1; Apply H1.
-Apply H1.
-Qed.
-
-Lemma RiemannInt_P2 : (f:R->R;a,b:R;un:nat->posreal;vn,wn:nat->(StepFun a b)) (Un_cv un R0) -> ``a<=b`` -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(vn n t)))<=(wn n t)``)/\``(Rabsolu (RiemannInt_SF (wn n)))<(un n)``) -> (sigTT ? [l:R](Un_cv [N:nat](RiemannInt_SF (vn N)) l)).
-Intros; Apply R_complete; Unfold Un_cv in H; Unfold Cauchy_crit; Intros; Assert H3 : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H3); Intros N0 H4; Exists N0; Intros; Unfold R_dist; Unfold R_dist in H4; Elim (H1 n); Elim (H1 m); Intros; Replace ``(RiemannInt_SF (vn n))-(RiemannInt_SF (vn m))`` with ``(RiemannInt_SF (vn n))+(-1)*(RiemannInt_SF (vn m))``; [Idtac | Ring]; Rewrite <- StepFun_P30; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (vn n) (vn m)))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (wn n) (wn m)))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((vn n x)-(f x)))+(Rabsolu ((f x)-(vn m x)))``.
-Replace ``(vn n x)+-1*(vn m x)`` with ``((vn n x)-(f x))+((f x)-(vn m x))``; [Apply Rabsolu_triang | Ring].
-Assert H12 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H13 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite <- H12 in H11; Pattern 2 b in H11; Rewrite <- H13 in H11; Rewrite Rmult_1l; Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9.
-Elim H11; Intros; Split; Left; Assumption.
-Apply H7.
-Elim H11; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Apply Rlt_trans with ``(un n)+(un m)``.
-Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF (wn n)))+(Rabsolu (RiemannInt_SF (wn m)))``.
-Apply Rplus_le; Apply Rle_Rabsolu.
-Apply Rplus_lt; Assumption.
-Apply Rle_lt_trans with ``(Rabsolu (un n))+(Rabsolu (un m))``.
-Apply Rplus_le; Apply Rle_Rabsolu.
-Replace (pos (un n)) with ``(un n)-0``; [Idtac | Ring]; Replace (pos (un m)) with ``(un m)-0``; [Idtac | Ring]; Rewrite (double_var eps); Apply Rplus_lt; Apply H4; Assumption.
-Qed.
-
-Lemma RiemannInt_P3 : (f:R->R;a,b:R;un:nat->posreal;vn,wn:nat->(StepFun a b)) (Un_cv un R0) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(vn n t)))<=(wn n t)``)/\``(Rabsolu (RiemannInt_SF (wn n)))<(un n)``)->(sigTT R ([l:R](Un_cv ([N:nat](RiemannInt_SF (vn N))) l))).
-Intros; Case (total_order_Rle a b); Intro.
-Apply RiemannInt_P2 with f un wn; Assumption.
-Assert H1 : ``b<=a``; Auto with real.
-Pose vn' := [n:nat](mkStepFun (StepFun_P6 (pre (vn n)))); Pose wn' := [n:nat](mkStepFun (StepFun_P6 (pre (wn n)))); Assert H2 : (n:nat)((t:R)``(Rmin b a)<=t<=(Rmax b a)``->``(Rabsolu ((f t)-(vn' n t)))<=(wn' n t)``)/\``(Rabsolu (RiemannInt_SF (wn' n)))<(un n)``.
-Intro; Elim (H0 n0); Intros; Split.
-Intros; Apply (H2 t); Elim H4; Clear H4; Intros; Split; [Apply Rle_trans with (Rmin b a); Try Assumption; Right; Unfold Rmin | Apply Rle_trans with (Rmax b a); Try Assumption; Right; Unfold Rmax]; (Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse Apply Rle_antisym; [Assumption | Assumption | Auto with real | Auto with real]).
-Generalize H3; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Unfold wn'; Intros; (Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0))); [Idtac | Apply StepFun_P17 with (fe (wn n0)) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0)))))]]).
-Apply H4.
-Rewrite Rabsolu_Ropp; Apply H4.
-Rewrite Rabsolu_Ropp in H4; Apply H4.
-Apply H4.
-Assert H3 := (RiemannInt_P2 H H1 H2); Elim H3; Intros; Apply existTT with ``-x``; Unfold Un_cv; Unfold Un_cv in p; Intros; Elim (p ? H4); Intros; Exists x0; Intros; Generalize (H5 ? H6); Unfold R_dist RiemannInt_SF; Case (total_order_Rle b a); Case (total_order_Rle a b); Intros.
-Elim n; Assumption.
-Unfold vn' in H7; Replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0))))) (subdivision (mkStepFun (StepFun_P6 (pre (vn n0)))))); [Unfold Rminus; Rewrite Ropp_Ropp; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Apply H7 | Symmetry; Apply StepFun_P17 with (fe (vn n0)) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0)))))]].
-Elim n1; Assumption.
-Elim n2; Assumption.
-Qed.
-
-Lemma RiemannInt_exists : (f:R->R;a,b:R;pr:(Riemann_integrable f a b);un:nat->posreal) (Un_cv un R0) -> (sigTT ? [l:R](Un_cv [N:nat](RiemannInt_SF (phi_sequence un pr N)) l)).
-Intros f; Intros; Apply RiemannInt_P3 with f un [n:nat](projT1 ? ? (phi_sequence_prop un pr n)); [Apply H | Intro; Apply (projT2 ? ? (phi_sequence_prop un pr n))].
-Qed.
-
-Lemma RiemannInt_P4 : (f:R->R;a,b,l:R;pr1,pr2:(Riemann_integrable f a b);un,vn:nat->posreal) (Un_cv un R0) -> (Un_cv vn R0) -> (Un_cv [N:nat](RiemannInt_SF (phi_sequence un pr1 N)) l) -> (Un_cv [N:nat](RiemannInt_SF (phi_sequence vn pr2 N)) l).
-Unfold Un_cv; Unfold R_dist; Intros f; Intros; Assert H3 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H3); Clear H; Intros N0 H; Elim (H0 ? H3); Clear H0; Intros N1 H0; Elim (H1 ? H3); Clear H1; Intros N2 H1; Pose N := (max (max N0 N1) N2); Exists N; Intros; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)])))+(Rabsolu ((RiemannInt_SF [(phi_sequence un pr1 n)])-l))``.
-Replace ``(RiemannInt_SF [(phi_sequence vn pr2 n)])-l`` with ``((RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)]))+((RiemannInt_SF [(phi_sequence un pr1 n)])-l)``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``2*eps/3+eps/3``.
-Apply Rplus_lt.
-Elim (phi_sequence_prop vn pr2 n); Intros psi_vn H5; Elim (phi_sequence_prop un pr1 n); Intros psi_un H6; Replace ``(RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)])`` with ``(RiemannInt_SF [(phi_sequence vn pr2 n)])+(-1)*(RiemannInt_SF [(phi_sequence un pr1 n)])``; [Idtac | Ring]; Rewrite <- StepFun_P30.
-Case (total_order_Rle a b); Intro.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence vn pr2 n) (phi_sequence un pr1 n)))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 psi_un psi_vn))).
-Apply StepFun_P37; Try Assumption; Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ([(phi_sequence vn pr2 n x)]-(f x)))+(Rabsolu ((f x)-[(phi_sequence un pr1 n x)]))``.
-Replace ``[(phi_sequence vn pr2 n x)]+-1*[(phi_sequence un pr1 n x)]`` with ``([(phi_sequence vn pr2 n x)]-(f x))+((f x)-[(phi_sequence un pr1 n x)])``; [Apply Rabsolu_triang | Ring].
-Assert H10 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H11 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite (Rplus_sym (psi_un x)); Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim H5; Intros; Apply H8.
-Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
-Elim H6; Intros; Apply H8.
-Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
-Apply Rlt_trans with (pos (un n)).
-Elim H6; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_un)).
-Apply Rle_Rabsolu.
-Assumption.
-Replace (pos (un n)) with (Rabsolu ``(un n)-0``); [Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_trans with (max N0 N1); Apply le_max_l | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n))].
-Apply Rlt_trans with (pos (vn n)).
-Elim H5; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_vn)).
-Apply Rle_Rabsolu; Assumption.
-Assumption.
-Replace (pos (vn n)) with (Rabsolu ``(vn n)-0``); [Apply H0; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_trans with (max N0 N1); [Apply le_max_r | Apply le_max_l] | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (vn n))].
-Rewrite StepFun_P39; Rewrite Rabsolu_Ropp; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 ``-1`` (phi_sequence vn pr2 n) (phi_sequence un pr1 n))))))))).
-Apply StepFun_P34; Try Auto with real.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 psi_vn psi_un)))))).
-Apply StepFun_P37.
-Auto with real.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ([(phi_sequence vn pr2 n x)]-(f x)))+(Rabsolu ((f x)-[(phi_sequence un pr1 n x)]))``.
-Replace ``[(phi_sequence vn pr2 n x)]+-1*[(phi_sequence un pr1 n x)]`` with ``([(phi_sequence vn pr2 n x)]-(f x))+((f x)-[(phi_sequence un pr1 n x)])``; [Apply Rabsolu_triang | Ring].
-Assert H10 : (Rmin a b)==b.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
-Assert H11 : (Rmax a b)==a.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
-Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim H5; Intros; Apply H8.
-Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
-Elim H6; Intros; Apply H8.
-Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
-Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 psi_vn psi_un))))))); Rewrite <- StepFun_P39; Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Rewrite Ropp_distr1; Apply Rplus_lt.
-Apply Rlt_trans with (pos (vn n)).
-Elim H5; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_vn)).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Assumption.
-Replace (pos (vn n)) with (Rabsolu ``(vn n)-0``); [Apply H0; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_trans with (max N0 N1); [Apply le_max_r | Apply le_max_l] | Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (vn n))].
-Apply Rlt_trans with (pos (un n)).
-Elim H6; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_un)).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu; Assumption.
-Assumption.
-Replace (pos (un n)) with (Rabsolu ``(un n)-0``); [Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_trans with (max N0 N1); Apply le_max_l | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n))].
-Apply H1; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Qed.
-
-Lemma RinvN_pos : (n:nat) ``0</((INR n)+1)``.
-Intro; Apply Rlt_Rinv; Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
-Qed.
-
-Definition RinvN : nat->posreal := [N:nat](mkposreal ? (RinvN_pos N)).
- 
-Lemma RinvN_cv : (Un_cv RinvN R0).
-Unfold Un_cv; Intros; Assert H0 := (archimed ``/eps``); Elim H0; Clear H0; Intros; Assert H2 : `0<=(up (Rinv eps))`.
-Apply le_IZR; Left; Apply Rlt_trans with ``/eps``; [Apply Rlt_Rinv; Assumption | Assumption].
-Elim (IZN ? H2); Intros; Exists x; Intros; Unfold R_dist; Simpl; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Assert H5 : ``0<(INR n)+1``.
-Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
-Rewrite Rabsolu_right; [Idtac | Left; Change ``0</((INR n)+1)``; Apply Rlt_Rinv; Assumption]; Apply Rle_lt_trans with ``/((INR x)+1)``.
-Apply Rle_Rinv.
-Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
-Assumption.
-Do 2 Rewrite <- (Rplus_sym R1); Apply Rle_compatibility; Apply le_INR; Apply H4.
-Rewrite <- (Rinv_Rinv eps).
-Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Assumption.
-Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
-Apply Rlt_trans with (INR x); [Rewrite INR_IZR_INZ; Rewrite <- H3; Apply H0 | Pattern 1 (INR x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1].
-Red; Intro; Rewrite H6 in H; Elim (Rlt_antirefl ? H).
-Qed.
-
-(**********) 
-Definition RiemannInt [f:R->R;a,b:R;pr:(Riemann_integrable f a b)] : R := Cases
-(RiemannInt_exists pr 5!RinvN RinvN_cv) of (existTT a' b') => a' end.
-
-Lemma RiemannInt_P5 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f a b)) (RiemannInt pr1)==(RiemannInt pr2).
-Intros; Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Intros; EApply UL_sequence; [Apply u0 | Apply RiemannInt_P4 with pr2 RinvN; Apply RinvN_cv Orelse Assumption].
-Qed.
-
-(**************************************)
-(* C°([a,b]) is included in L1([a,b]) *)
-(**************************************)
-
-Lemma maxN : (a,b:R;del:posreal) ``a<b`` -> (sigTT ? [n:nat]``a+(INR n)*del<b``/\``b<=a+(INR (S n))*del``).
-Intros; Pose I := [n:nat]``a+(INR n)*del < b``; Assert H0 : (EX n:nat | (I n)).
-Exists O; Unfold I; Rewrite Rmult_Ol; Rewrite Rplus_Or; Assumption.
-Cut (Nbound I).
-Intro; Assert H2 := (Nzorn H0 H1); Elim H2; Intros; Exists x; Elim p; Intros; Split.
-Apply H3.
-Case (total_order_T ``a+(INR (S x))*del`` b); Intro.
-Elim s; Intro.
-Assert H5 := (H4 (S x) a0); Elim (le_Sn_n ? H5).
-Right; Symmetry; Assumption.
-Left; Apply r.
-Assert H1 : ``0<=(b-a)/del``.
-Unfold Rdiv; Apply Rmult_le_pos; [Apply Rle_sym2; Apply Rge_minus; Apply Rle_sym1; Left; Apply H | Left; Apply Rlt_Rinv; Apply (cond_pos del)].
-Elim (archimed ``(b-a)/del``); Intros; Assert H4 : `0<=(up (Rdiv (Rminus b a) del))`.
-Apply le_IZR; Simpl; Left; Apply Rle_lt_trans with ``(b-a)/del``; Assumption.
-Assert H5 := (IZN ? H4); Elim H5; Clear H5; Intros N H5; Unfold Nbound; Exists N; Intros; Unfold I in H6; Apply INR_le; Rewrite H5 in H2; Rewrite <- INR_IZR_INZ in H2; Left; Apply Rle_lt_trans with ``(b-a)/del``; Try Assumption; Apply Rle_monotony_contra with (pos del); [Apply (cond_pos del) | Unfold Rdiv; Rewrite <- (Rmult_sym ``/del``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite Rmult_sym; Apply Rle_anti_compatibility with a; Replace ``a+(b-a)`` with b; [Left; Assumption | Ring] | Assert H7 := (cond_pos del); Red; Intro; Rewrite H8 in H7; Elim (Rlt_antirefl ? H7)]].
-Qed.
-
-Fixpoint SubEquiN [N:nat] : R->R->posreal->Rlist :=
-[x:R][y:R][del:posreal] Cases N of
-| O => (cons y nil)
-| (S p) => (cons x (SubEquiN p ``x+del`` y del))
-end.
-
-Definition max_N [a,b:R;del:posreal;h:``a<b``] : nat := Cases (maxN del h) of (existTT N H0) => N end.
-
-Definition SubEqui [a,b:R;del:posreal;h:``a<b``] :Rlist := (SubEquiN (S (max_N del h)) a b del).
-
-Lemma Heine_cor1 : (f:R->R;a,b:R) ``a<b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (eps:posreal) (sigTT ? [delta:posreal]``delta<=b-a``/\(x,y:R)``a<=x<=b``->``a<=y<=b``->``(Rabsolu (x-y)) < delta``->``(Rabsolu ((f x)-(f y))) < eps``).
-Intro f; Intros; Pose E := [l:R]``0<l<=b-a``/\(x,y:R)``a <= x <= b``->``a <= y <= b``->``(Rabsolu (x-y)) < l``->``(Rabsolu ((f x)-(f y))) < eps``; Assert H1 : (bound E).
-Unfold bound; Exists ``b-a``; Unfold is_upper_bound; Intros; Unfold E in H1; Elim H1; Clear H1; Intros H1 _; Elim H1; Intros; Assumption.
-Assert H2 : (EXT x:R | (E x)).
-Assert H2 := (Heine f [x:R]``a<=x<=b`` (compact_P3 a b) H0 eps); Elim H2; Intros; Exists (Rmin x ``b-a``); Unfold E; Split; [Split; [Unfold Rmin; Case (total_order_Rle x ``b-a``); Intro; [Apply (cond_pos x) | Apply Rlt_Rminus; Assumption] | Apply Rmin_r] | Intros; Apply H3; Try Assumption; Apply Rlt_le_trans with (Rmin x ``b-a``); [Assumption | Apply Rmin_l]].
-Assert H3 := (complet E H1 H2); Elim H3; Intros; Cut ``0<x<=b-a``.
-Intro; Elim H4; Clear H4; Intros; Apply existTT with (mkposreal ? H4); Split.
-Apply H5.
-Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H6; Pose D := ``(Rabsolu (x0-y))``; Elim (classic (EXT y:R | ``D<y``/\(E y))); Intro.
-Elim H11; Intros; Elim H12; Clear H12; Intros; Unfold E in H13; Elim H13; Intros; Apply H15; Assumption.
-Assert H12 := (not_ex_all_not ? [y:R]``D < y``/\(E y) H11); Assert H13 : (is_upper_bound E D).
-Unfold is_upper_bound; Intros; Assert H14 := (H12 x1); Elim (not_and_or ``D<x1`` (E x1) H14); Intro.
-Case (total_order_Rle x1 D); Intro.
-Assumption.
-Elim H15; Auto with real.
-Elim H15; Assumption.
-Assert H14 := (H7 ? H13); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H10)).
-Unfold is_lub in p; Unfold is_upper_bound in p; Elim p; Clear p; Intros; Split.
-Elim H2; Intros; Assert H7 := (H4 ? H6); Unfold E in H6; Elim H6; Clear H6; Intros H6 _; Elim H6; Intros; Apply Rlt_le_trans with x0; Assumption.
-Apply H5; Intros; Unfold E in H6; Elim H6; Clear H6; Intros H6 _; Elim H6; Intros; Assumption.
-Qed.
-
-Lemma Heine_cor2 : (f:(R->R); a,b:R) ((x:R)``a <= x <= b``->(continuity_pt f x))->(eps:posreal)(sigTT posreal [delta:posreal]((x,y:R)``a <= x <= b``->``a <= y <= b``->``(Rabsolu (x-y)) < delta``->``(Rabsolu ((f x)-(f y))) < eps``)).
-Intro f; Intros; Case (total_order_T a b); Intro.
-Elim s; Intro.
-Assert H0 := (Heine_cor1 a0 H eps); Elim H0; Intros; Apply existTT with x; Elim p; Intros; Apply H2; Assumption.
-Apply existTT with (mkposreal ? Rlt_R0_R1); Intros; Assert H3 : x==y; [Elim H0; Elim H1; Intros; Rewrite b0 in H3; Rewrite b0 in H5; Apply Rle_antisym; Apply Rle_trans with b; Assumption | Rewrite H3; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos eps)].
-Apply existTT with (mkposreal ? Rlt_R0_R1); Intros; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H3 H4) r)).
-Qed.
-
-Lemma SubEqui_P1 : (a,b:R;del:posreal;h:``a<b``) (pos_Rl (SubEqui del h) O)==a.
-Intros; Unfold SubEqui; Case (maxN del h); Intros; Reflexivity.
-Qed.
-
-Lemma SubEqui_P2 : (a,b:R;del:posreal;h:``a<b``) (pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))))==b.
-Intros; Unfold SubEqui; Case (maxN del h); Intros; Clear a0; Cut (x:nat)(a:R)(del:posreal)(pos_Rl (SubEquiN (S x) a b del) (pred (Rlength (SubEquiN (S x) a b del)))) == b; [Intro; Apply H | Induction x0; [Intros; Reflexivity | Intros; Change (pos_Rl (SubEquiN (S n) ``a0+del0`` b del0) (pred (Rlength (SubEquiN (S n) ``a0+del0`` b del0))))==b; Apply H]].
-Qed.
-
-Lemma SubEqui_P3 : (N:nat;a,b:R;del:posreal) (Rlength (SubEquiN N a b del))=(S N).
-Induction N; Intros; [Reflexivity | Simpl; Rewrite H; Reflexivity].
-Qed.
-
-Lemma SubEqui_P4 : (N:nat;a,b:R;del:posreal;i:nat) (lt i (S N)) -> (pos_Rl (SubEquiN (S N) a b del) i)==``a+(INR i)*del``.
-Induction N; [Intros; Inversion H; [Simpl; Ring | Elim (le_Sn_O ? H1)] | Intros; Induction i; [Simpl; Ring | Change (pos_Rl (SubEquiN (S n) ``a+del`` b del) i)==``a+(INR (S i))*del``; Rewrite H; [Rewrite S_INR; Ring | Apply lt_S_n; Apply H0]]].
-Qed.
-
-Lemma SubEqui_P5 : (a,b:R;del:posreal;h:``a<b``) (Rlength (SubEqui del h))=(S (S (max_N del h))).
-Intros; Unfold SubEqui; Apply SubEqui_P3.
-Qed.
-
-Lemma SubEqui_P6 : (a,b:R;del:posreal;h:``a<b``;i:nat) (lt i (S (max_N del h))) -> (pos_Rl (SubEqui del h) i)==``a+(INR i)*del``.
-Intros; Unfold SubEqui; Apply SubEqui_P4; Assumption.
-Qed.
-
-Lemma SubEqui_P7 : (a,b:R;del:posreal;h:``a<b``) (ordered_Rlist (SubEqui del h)).
-Intros; Unfold ordered_Rlist; Intros; Rewrite SubEqui_P5 in H; Simpl in H; Inversion H.
-Rewrite (SubEqui_P6 3!del 4!h 5!(max_N del h)).
-Replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))).
-Rewrite SubEqui_P2; Unfold max_N; Case (maxN del h); Intros; Left; Elim a0; Intros; Assumption.
-Rewrite SubEqui_P5; Reflexivity.
-Apply lt_n_Sn.
-Repeat Rewrite SubEqui_P6.
-3:Assumption.
-2:Apply le_lt_n_Sm; Assumption.
-Apply Rle_compatibility; Rewrite S_INR; Rewrite Rmult_Rplus_distrl; Pattern 1 ``(INR i)*del``; Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite Rmult_1l; Left; Apply (cond_pos del).
-Qed.
-
-Lemma SubEqui_P8 : (a,b:R;del:posreal;h:``a<b``;i:nat) (lt i (Rlength (SubEqui del h))) -> ``a<=(pos_Rl (SubEqui del h) i)<=b``.
-Intros; Split.
-Pattern 1 a; Rewrite <- (SubEqui_P1 del h); Apply RList_P5.
-Apply SubEqui_P7.
-Elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); Intros; Apply H1; Exists i; Split; [Reflexivity | Assumption].
-Pattern 2 b; Rewrite <- (SubEqui_P2 del h); Apply RList_P7; [Apply SubEqui_P7 | Elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); Intros; Apply H1; Exists i; Split; [Reflexivity | Assumption]].
-Qed.
-
-Lemma SubEqui_P9 : (a,b:R;del:posreal;f:R->R;h:``a<b``) (sigTT ? [g:(StepFun a b)](g b)==(f b)/\(i:nat)(lt i (pred (Rlength (SubEqui del h))))->(constant_D_eq g (co_interval (pos_Rl (SubEqui del h) i) (pos_Rl (SubEqui del h) (S i))) (f (pos_Rl (SubEqui del h) i)))).
-Intros; Apply StepFun_P38; [Apply SubEqui_P7 | Apply SubEqui_P1 | Apply SubEqui_P2].
-Qed.
-
-Lemma  RiemannInt_P6 : (f:R->R;a,b:R) ``a<b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (Riemann_integrable f a b).
-Intros; Unfold Riemann_integrable; Intro; Assert H1 : ``0<eps/(2*(b-a))``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rlt_Rminus; Assumption]].
-Assert H2 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption].
-Assert H3 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption].
-Elim (Heine_cor2 H0 (mkposreal ? H1)); Intros del H4; Elim (SubEqui_P9 del f H); Intros phi [H5 H6]; Split with phi; Split with (mkStepFun (StepFun_P4 a b ``eps/(2*(b-a))``)); Split.
-2:Rewrite StepFun_P18; Unfold Rdiv; Rewrite Rinv_Rmult.
-2:Do 2 Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-2:Rewrite Rmult_1r; Rewrite Rabsolu_right.
-2:Apply Rlt_monotony_contra with ``2``.
-2:Sup0.
-2:Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-2:Rewrite Rmult_1l; Pattern 1 (pos eps); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply (cond_pos eps).
-2:DiscrR.
-2:Apply Rle_sym1; Left; Apply Rmult_lt_pos.
-2:Apply (cond_pos eps).
-2:Apply Rlt_Rinv; Sup0.
-2:Apply Rminus_eq_contra; Red; Intro; Clear H6; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
-2:DiscrR.
-2:Apply Rminus_eq_contra; Red; Intro; Clear H6; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
-Intros; Rewrite H2 in H7; Rewrite H3 in H7; Simpl; Unfold fct_cte; Cut (t:R)``a<=t<=b``->t==b\/(EX i:nat | (lt i (pred (Rlength (SubEqui del H))))/\(co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i)) t)).
-Intro; Elim (H8 ? H7); Intro.
-Rewrite H9; Rewrite H5; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H9; Clear H9; Intros I [H9 H10]; Assert H11 := (H6 I H9 t H10); Rewrite H11; Left; Apply H4.
-Assumption.
-Apply SubEqui_P8; Apply lt_trans with (pred (Rlength (SubEqui del H))).
-Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H9; Elim (lt_n_O ? H9).
-Unfold co_interval in H10; Elim H10; Clear H10; Intros; Rewrite Rabsolu_right.
-Rewrite SubEqui_P5 in H9; Simpl in H9; Inversion H9.
-Apply Rlt_anti_compatibility with (pos_Rl (SubEqui del H) (max_N del H)).
-Replace ``(pos_Rl (SubEqui del H) (max_N del H))+(t-(pos_Rl (SubEqui del H) (max_N del H)))`` with t; [Idtac | Ring]; Apply Rlt_le_trans with b.
-Rewrite H14 in H12; Assert H13 : (S (max_N del H))=(pred (Rlength (SubEqui del H))).
-Rewrite SubEqui_P5; Reflexivity.
-Rewrite H13 in H12; Rewrite SubEqui_P2 in H12; Apply H12.
-Rewrite SubEqui_P6.
-2:Apply lt_n_Sn.
-Unfold max_N; Case (maxN del H); Intros; Elim a0; Clear a0; Intros _ H13; Replace ``a+(INR x)*del+del`` with ``a+(INR (S x))*del``; [Assumption | Rewrite S_INR; Ring].
-Apply Rlt_anti_compatibility with (pos_Rl (SubEqui del H) I); Replace ``(pos_Rl (SubEqui del H) I)+(t-(pos_Rl (SubEqui del H) I))`` with t; [Idtac | Ring]; Replace ``(pos_Rl (SubEqui del H) I)+del`` with (pos_Rl (SubEqui del H) (S I)).
-Assumption.
-Repeat Rewrite SubEqui_P6.
-Rewrite S_INR; Ring.
-Assumption.
-Apply le_lt_n_Sm; Assumption.
-Apply Rge_minus; Apply Rle_sym1; Assumption.
-Intros; Clear H0 H1 H4 phi H5 H6 t H7; Case (Req_EM t0 b); Intro.
-Left; Assumption.
-Right; Pose I := [j:nat]``a+(INR j)*del<=t0``; Assert H1 : (EX n:nat | (I n)).
-Exists O; Unfold I; Rewrite Rmult_Ol; Rewrite Rplus_Or; Elim H8; Intros; Assumption.
-Assert H4 : (Nbound I).
-Unfold Nbound; Exists (S (max_N del H)); Intros; Unfold max_N; Case (maxN del H); Intros; Elim a0; Clear a0; Intros _ H5; Apply INR_le; Apply Rle_monotony_contra with (pos del).
-Apply (cond_pos del).
-Apply Rle_anti_compatibility with a; Do 2 Rewrite (Rmult_sym del); Apply Rle_trans with t0; Unfold I in H4; Try Assumption; Apply Rle_trans with b; Try Assumption; Elim H8; Intros; Assumption.
-Elim (Nzorn H1 H4); Intros N [H5 H6]; Assert H7 : (lt N (S (max_N del H))).
-Unfold max_N; Case (maxN del H); Intros; Apply INR_lt; Apply Rlt_monotony_contra with (pos del).
-Apply (cond_pos del).
-Apply Rlt_anti_compatibility with a; Do 2 Rewrite (Rmult_sym del); Apply Rle_lt_trans with t0; Unfold I in H5; Try Assumption; Elim a0; Intros; Apply Rlt_le_trans with b; Try Assumption; Elim H8; Intros.
-Elim H11; Intro.
-Assumption.
-Elim H0; Assumption.
-Exists N; Split.
-Rewrite SubEqui_P5; Simpl; Assumption.
-Unfold co_interval; Split.
-Rewrite SubEqui_P6.
-Apply H5.
-Assumption.
-Inversion H7.
-Replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))).
-Rewrite (SubEqui_P2 del H); Elim H8; Intros.
-Elim H11; Intro.
-Assumption.
-Elim H0; Assumption.
-Rewrite SubEqui_P5; Reflexivity.
-Rewrite SubEqui_P6.
-Case (total_order_Rle ``a+(INR (S N))*del`` t0); Intro.
-Assert H11 := (H6 (S N) r); Elim (le_Sn_n ? H11).
-Auto with real.
-Apply le_lt_n_Sm; Assumption.
-Qed.
-
-Lemma RiemannInt_P7 : (f:R->R;a:R) (Riemann_integrable f a a).
-Unfold Riemann_integrable; Intro f; Intros; Split with (mkStepFun (StepFun_P4 a a (f a))); Split with (mkStepFun (StepFun_P4 a a R0)); Split.
-Intros; Simpl; Unfold fct_cte; Replace t with a.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Right; Reflexivity.
-Generalize H; Unfold Rmin Rmax; Case (total_order_Rle a a); Intros; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos eps).
-Qed.
-
-Lemma continuity_implies_RiemannInt : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (Riemann_integrable f a b).
-Intros; Case (total_order_T a b); Intro; [Elim s; Intro; [Apply RiemannInt_P6; Assumption | Rewrite b0; Apply RiemannInt_P7] | Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r))].
-Qed.
-
-Lemma RiemannInt_P8 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b a)) ``(RiemannInt pr1)==-(RiemannInt pr2)``.
-Intro f; Intros; EApply UL_sequence.
-Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Intros; Apply u.
-Unfold RiemannInt; Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Intros; Cut (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Cut (EXT psi2:nat->(StepFun b a) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Intros; Elim H; Clear H; Intros psi2 H; Elim H0; Clear H0; Intros psi1 H0; Assert H1 := RinvN_cv; Unfold Un_cv; Intros; Assert H3 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Unfold Un_cv in H1; Elim (H1 ? H3); Clear H1; Intros N0 H1; Unfold R_dist in H1; Simpl in H1; Assert H4 : (n:nat)(ge n N0)->``(RinvN n)<eps/3``.
-Intros; Assert H5 := (H1 ? H4); Replace (pos (RinvN n)) with ``(Rabsolu (/((INR n)+1)-0))``; [Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))].
-Clear H1; Unfold Un_cv in u; Elim (u ? H3); Clear u; Intros N1 H1; Exists (max N0 N1); Intros; Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)])))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``.
-Rewrite <- (Rabsolu_Ropp ``(RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x``); Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])- -x`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))+ -((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)``; [Apply Rabsolu_triang | Ring].
-Replace eps with ``2*eps/3+eps/3``.
-Apply Rplus_lt.
-Rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])+ -(RiemannInt_SF (mkStepFun (StepFun_P6 (pre [(phi_sequence RinvN pr2 n)]))))`` with ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(-1)*(RiemannInt_SF (mkStepFun (StepFun_P6 (pre [(phi_sequence RinvN pr2 n)]))))``; [Idtac | Ring]; Rewrite <- StepFun_P30.
-Case (total_order_Rle a b); Intro.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 ``1`` (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr1 n)] x0)-(f x0)))+(Rabsolu ((f x0)-([(phi_sequence RinvN pr2 n)] x0)))``.
-Replace ``([(phi_sequence RinvN pr1 n)] x0)+ -1*([(phi_sequence RinvN pr2 n)] x0)`` with ``(([(phi_sequence RinvN pr1 n)] x0)-(f x0))+((f x0)-([(phi_sequence RinvN pr2 n)] x0))``; [Apply Rabsolu_triang | Ring].
-Assert H7 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H8 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Apply Rplus_le.
-Elim (H0 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9; Rewrite H7; Rewrite H8.
-Elim H6; Intros; Split; Left; Assumption.
-Elim (H n); Intros; Apply H9; Rewrite H7; Rewrite H8.
-Elim H6; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
-Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
-Elim (H n); Intros; Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))); Rewrite <- StepFun_P39; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
-Assert Hyp : ``b<=a``.
-Auto with real.
-Rewrite StepFun_P39; Rewrite Rabsolu_Ropp; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (StepFun_P28 ``-1`` (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 ``1`` (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr1 n)] x0)-(f x0)))+(Rabsolu ((f x0)-([(phi_sequence RinvN pr2 n)] x0)))``.
-Replace ``([(phi_sequence RinvN pr1 n)] x0)+ -1*([(phi_sequence RinvN pr2 n)] x0)`` with ``(([(phi_sequence RinvN pr1 n)] x0)-(f x0))+((f x0)-([(phi_sequence RinvN pr2 n)] x0))``; [Apply Rabsolu_triang | Ring].
-Assert H7 : (Rmin a b)==b.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
-Assert H8 : (Rmax a b)==a.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
-Apply Rplus_le.
-Elim (H0 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9; Rewrite H7; Rewrite H8.
-Elim H6; Intros; Split; Left; Assumption.
-Elim (H n); Intros; Apply H9; Rewrite H7; Rewrite H8; Elim H6; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
-Elim (H0 n); Intros; Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))); Rewrite <- StepFun_P39; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
-Elim (H n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
-Unfold R_dist in H1; Apply H1; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_r | Assumption].
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Rewrite Rmin_sym; Rewrite RmaxSym; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)).
-Qed.
-
-Lemma RiemannInt_P9 : (f:R->R;a:R;pr:(Riemann_integrable f a a)) ``(RiemannInt pr)==0``.
-Intros; Assert H := (RiemannInt_P8 pr pr); Apply r_Rmult_mult with ``2``; [Rewrite Rmult_Or; Rewrite double; Pattern 2 (RiemannInt pr); Rewrite H; Apply Rplus_Ropp_r | DiscrR].
-Qed.
-
-Lemma Req_EM_T :(r1,r2:R) (sumboolT (r1==r2) ``r1<>r2``).
-Intros; Elim (total_order_T r1 r2);Intros; [Elim a;Intro; [Right; Red; Intro; Rewrite H in a0; Elim (Rlt_antirefl ``r2`` a0) | Left;Assumption] | Right; Red; Intro; Rewrite H in b; Elim (Rlt_antirefl ``r2`` b)].
-Qed.
-
-(* L1([a,b]) is a vectorial space *)
-Lemma RiemannInt_P10 : (f,g:R->R;a,b,l:R) (Riemann_integrable f a b) -> (Riemann_integrable g a b) -> (Riemann_integrable [x:R]``(f x)+l*(g x)`` a b).
-Unfold Riemann_integrable; Intros f g; Intros; Case (Req_EM_T l R0); Intro.
-Elim (X eps); Intros; Split with x; Elim p; Intros; Split with x0; Elim p0; Intros; Split; Try Assumption; Rewrite e; Intros; Rewrite Rmult_Ol; Rewrite Rplus_Or; Apply H; Assumption.
-Assert H : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
-Assert H0 : ``0<eps/(2*(Rabsolu l))``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]].
-Elim (X (mkposreal ? H)); Intros; Elim (X0 (mkposreal ? H0)); Intros; Split with (mkStepFun (StepFun_P28 l x x0)); Elim p0; Elim p; Intros; Split with (mkStepFun (StepFun_P28 (Rabsolu l) x1 x2)); Elim p1; Elim p2; Clear p1 p2 p0 p X X0; Intros; Split.
-Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-(x t)))+(Rabsolu (l*((g t)-(x0 t))))``.
-Replace ``(f t)+l*(g t)-((x t)+l*(x0 t))`` with ``((f t)-(x t))+ l*((g t)-(x0 t))``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_le; [Apply H3; Assumption | Rewrite Rabsolu_mult; Apply Rle_monotony; [Apply Rabsolu_pos | Apply H1; Assumption]].
-Rewrite StepFun_P30; Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF x1))+(Rabsolu ((Rabsolu l)*(RiemannInt_SF x2)))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply H4.
-Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/2`` with ``eps/(2*(Rabsolu l))``; [Apply H2 | Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption]] | Apply Rabsolu_no_R0; Assumption].
-Qed.
-
-Lemma RiemannInt_P11 : (f:R->R;a,b,l:R;un:nat->posreal;phi1,phi2,psi1,psi2:nat->(StepFun a b)) (Un_cv un R0) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi1 n t)))<=(psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n)))<(un n)``) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi2 n t)))<=(psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n)))<(un n)``) -> (Un_cv [N:nat](RiemannInt_SF (phi1 N)) l) -> (Un_cv [N:nat](RiemannInt_SF (phi2 N)) l).
-Unfold Un_cv; Intro f; Intros; Intros.
-Case (total_order_Rle a b); Intro Hyp.
-Assert H4 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H4); Clear H; Intros N0 H.
-Elim (H2 ? H4); Clear H2; Intros N1 H2.
-Pose N := (max N0 N1); Exists N; Intros; Unfold R_dist.
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))))+(Rabsolu ((RiemannInt_SF (phi1 n))-l))``.
-Replace ``(RiemannInt_SF (phi2 n))-l`` with ``((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n)))+((RiemannInt_SF (phi1 n))-l)``; [Apply Rabsolu_triang | Ring].
-Replace ``eps`` with ``2*eps/3+eps/3``.
-Apply Rplus_lt.
-Replace ``(RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))`` with ``(RiemannInt_SF (phi2 n))+(-1)*(RiemannInt_SF (phi1 n))``; [Idtac | Ring].
-Rewrite <- StepFun_P30.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi2 n) (phi1 n)))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n)))).
-Apply StepFun_P37; Try Assumption; Intros; Simpl; Rewrite Rmult_1l.
-Apply Rle_trans with ``(Rabsolu ((phi2 n x)-(f x)))+(Rabsolu ((f x)-(phi1 n x)))``.
-Replace ``(phi2 n x)+-1*(phi1 n x)`` with ``((phi2 n x)-(f x))+((f x)-(phi1 n x))``; [Apply Rabsolu_triang | Ring].
-Rewrite (Rplus_sym (psi1 n x)); Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim (H1 n); Intros; Apply H7.
-Assert H10 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H11 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
-Elim (H0 n); Intros; Apply H7; Assert H10 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H11 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
-Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
-Apply Rlt_trans with (pos (un n)).
-Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
-Apply Rle_Rabsolu.
-Assumption.
-Replace (pos (un n)) with (R_dist (un n) R0).
-Apply H; Unfold ge; Apply le_trans with N; Try Assumption.
-Unfold N; Apply le_max_l.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right.
-Apply Rle_sym1; Left; Apply (cond_pos (un n)).
-Apply Rlt_trans with (pos (un n)).
-Elim (H1 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
-Apply Rle_Rabsolu; Assumption.
-Assumption.
-Replace (pos (un n)) with (R_dist (un n) R0).
-Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_l.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n)).
-Unfold R_dist in H2; Apply H2; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Assert H4 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H4); Clear H; Intros N0 H.
-Elim (H2 ? H4); Clear H2; Intros N1 H2.
-Pose N := (max N0 N1); Exists N; Intros; Unfold R_dist.
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))))+(Rabsolu ((RiemannInt_SF (phi1 n))-l))``.
-Replace ``(RiemannInt_SF (phi2 n))-l`` with ``((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n)))+((RiemannInt_SF (phi1 n))-l)``; [Apply Rabsolu_triang | Ring].
-Assert Hyp_b : ``b<=a``.
-Auto with real.
-Replace ``eps`` with ``2*eps/3+eps/3``.
-Apply Rplus_lt.
-Replace ``(RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))`` with ``(RiemannInt_SF (phi2 n))+(-1)*(RiemannInt_SF (phi1 n))``; [Idtac | Ring].
-Rewrite <- StepFun_P30.
-Rewrite StepFun_P39.
-Rewrite Rabsolu_Ropp.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 ``-1`` (phi2 n) (phi1 n))))))))).
-Apply StepFun_P34; Try Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n))))))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l.
-Apply Rle_trans with ``(Rabsolu ((phi2 n x)-(f x)))+(Rabsolu ((f x)-(phi1 n x)))``.
-Replace ``(phi2 n x)+-1*(phi1 n x)`` with ``((phi2 n x)-(f x))+((f x)-(phi1 n x))``; [Apply Rabsolu_triang | Ring].
-Rewrite (Rplus_sym (psi1 n x)); Apply Rplus_le.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim (H1 n); Intros; Apply H7.
-Assert H10 : (Rmin a b)==b.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
-Assert H11 : (Rmax a b)==a.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
-Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
-Elim (H0 n); Intros; Apply H7; Assert H10 : (Rmin a b)==b.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
-Assert H11 : (Rmax a b)==a.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
-Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
-Rewrite <- (Ropp_Ropp (RiemannInt_SF
-     (mkStepFun
-     (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n)))))))).
-Rewrite <- StepFun_P39.
-Rewrite StepFun_P30.
-Rewrite Rmult_1l; Rewrite double.
-Rewrite Ropp_distr1; Apply Rplus_lt.
-Apply Rlt_trans with (pos (un n)).
-Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Assumption.
-Replace (pos (un n)) with (R_dist (un n) R0).
-Apply H; Unfold ge; Apply le_trans with N; Try Assumption.
-Unfold N; Apply le_max_l.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right.
-Apply Rle_sym1; Left; Apply (cond_pos (un n)).
-Apply Rlt_trans with (pos (un n)).
-Elim (H1 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu; Assumption.
-Assumption.
-Replace (pos (un n)) with (R_dist (un n) R0).
-Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_l.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n)).
-Unfold R_dist in H2; Apply H2; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Qed.
-
-Lemma RiemannInt_P12 : (f,g:R->R;a,b,l:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b);pr3:(Riemann_integrable [x:R]``(f x)+l*(g x)`` a b)) ``a<=b`` -> ``(RiemannInt pr3)==(RiemannInt pr1)+l*(RiemannInt pr2)``.
-Intro f; Intros; Case (Req_EM l R0); Intro.
-Pattern 2 l; Rewrite H0; Rewrite Rmult_Ol; Rewrite Rplus_Or; Unfold RiemannInt; Case (RiemannInt_exists pr3 5!RinvN RinvN_cv); Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Intros; EApply UL_sequence; [Apply u0 | Pose psi1 := [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Pose psi2 := [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; [Apply RinvN_cv | Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)) | Intro; Assert H1 : ((t:R) ``(Rmin a b) <= t``/\``t <= (Rmax a b)`` -> (Rle (Rabsolu (Rminus ``(f t)+l*(g t)`` (phi_sequence RinvN pr3 n t))) (psi2 n t))) /\ ``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``; [Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n)) | Elim H1; Intros; Split; Try Assumption; Intros; Replace (f t) with ``(f t)+l*(g t)``; [Apply H2; Assumption | Rewrite H0; Ring]] | Assumption]].
-EApply UL_sequence.
-Unfold RiemannInt; Case (RiemannInt_exists pr3 5!RinvN RinvN_cv); Intros; Apply u.
-Unfold Un_cv; Intros; Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Unfold Un_cv; Intros; Assert H2 : ``0<eps/5``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (u0 ? H2); Clear u0; Intros N0 H3; Assert H4 := RinvN_cv; Unfold Un_cv in H4; Elim (H4 ? H2); Clear H4 H2; Intros N1 H4; Assert H5 : ``0<eps/(5*(Rabsolu l))``. 
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]].
-Elim (u ? H5); Clear u; Intros N2 H6; Assert H7 := RinvN_cv; Unfold Un_cv in H7; Elim (H7 ? H5); Clear H7 H5; Intros N3 H5; Unfold R_dist in H3 H4 H5 H6; Pose N := (max (max N0 N1) (max N2 N3)).
-Assert H7 : (n:nat) (ge n N1)->``(RinvN n)< eps/5``.
-Intros; Replace (pos (RinvN n)) with ``(Rabsolu ((RinvN n)-0))``; [Unfold RinvN; Apply H4; Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))].
-Clear H4; Assert H4 := H7; Clear H7; Assert H7 : (n:nat) (ge n N3)->``(RinvN n)< eps/(5*(Rabsolu l))``.
-Intros; Replace (pos (RinvN n)) with ``(Rabsolu ((RinvN n)-0))``; [Unfold RinvN; Apply H5; Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))].
-Clear H5; Assert H5 := H7; Clear H7; Exists N; Intros; Unfold R_dist.
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0))+(Rabsolu l)*(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``.
-Apply Rle_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu (((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)))``.
-Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-(x0+l*x)`` with ``(((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``; [Apply Rabsolu_triang | Ring].
-Rewrite Rplus_assoc; Apply Rle_compatibility; Rewrite <- Rabsolu_mult; Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+(l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``; [Apply Rabsolu_triang | Ring].
-Replace eps with ``3*eps/5+eps/5+eps/5``.
-Repeat Apply Rplus_lt.
-Assert H7 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n0)).
-Assert H8 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((g t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n0)).
-Assert H9 : (EXT psi3:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu (((f t)+l*(g t))-([(phi_sequence RinvN pr3 n)] t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n0)).
-Elim H7; Clear H7; Intros psi1 H7; Elim H8; Clear H8; Intros psi2 H8; Elim H9; Clear H9; Intros psi3 H9; Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))`` with ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])+(-1)*((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))``; [Idtac | Ring]; Do 2 Rewrite <- StepFun_P30; Assert H10 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Assert H11 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Rewrite H10 in H7; Rewrite H10 in H8; Rewrite H10 in H9; Rewrite H11 in H7; Rewrite H11 in H8; Rewrite H11 in H9; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence RinvN pr3 n) (mkStepFun (StepFun_P28 l (phi_sequence RinvN pr1 n) (phi_sequence RinvN pr2 n)))))))).
-Apply StepFun_P34; Assumption.
-Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (psi3 n) (mkStepFun (StepFun_P28 (Rabsolu l) (psi1 n) (psi2 n)))))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l.
-Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr3 n)] x1)-((f x1)+l*(g x1))))+(Rabsolu (((f x1)+l*(g x1))+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))))``.
-Replace ``([(phi_sequence RinvN pr3 n)] x1)+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))`` with ``(([(phi_sequence RinvN pr3 n)] x1)-((f x1)+l*(g x1)))+(((f x1)+l*(g x1))+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1)))``; [Apply Rabsolu_triang | Ring].
-Rewrite Rplus_assoc; Apply Rplus_le.
-Elim (H9 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H13.
-Elim H12; Intros; Split; Left; Assumption. 
-Apply Rle_trans with ``(Rabsolu ((f x1)-([(phi_sequence RinvN pr1 n)] x1)))+(Rabsolu l)*(Rabsolu ((g x1)-([(phi_sequence RinvN pr2 n)] x1)))``.
-Rewrite <- Rabsolu_mult; Replace ``((f x1)+(l*(g x1)+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))))`` with ``((f x1)-([(phi_sequence RinvN pr1 n)] x1))+l*((g x1)-([(phi_sequence RinvN pr2 n)] x1))``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_le.
-Elim (H7 n); Intros; Apply H13.
-Elim H12; Intros; Split; Left; Assumption.
-Apply Rle_monotony; [Apply Rabsolu_pos | Elim (H8 n); Intros; Apply H13; Elim H12; Intros; Split; Left; Assumption].
-Do 2 Rewrite StepFun_P30; Rewrite Rmult_1l; Replace ``3*eps/5`` with ``eps/5+(eps/5+eps/5)``; [Repeat Apply Rplus_lt | Ring].
-Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi3 n))); [Apply Rle_Rabsolu | Elim (H9 n); Intros; Assumption] | Apply H4; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N0 N1); [Apply le_max_r | Unfold N; Apply le_max_l] | Assumption]].
-Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Apply Rle_Rabsolu | Elim (H7 n); Intros; Assumption] | Apply H4; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N0 N1); [Apply le_max_r | Unfold N; Apply le_max_l] | Assumption]].
-Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/5`` with ``eps/(5*(Rabsolu l))``.
-Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Apply Rle_Rabsolu | Elim (H8 n); Intros; Assumption] | Apply H5; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N2 N3); [Apply le_max_r | Unfold N; Apply le_max_r] | Assumption]].
-Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption].
-Apply Rabsolu_no_R0; Assumption.
-Apply H3; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Apply le_trans with N; [Unfold N; Apply le_max_l | Assumption]].
-Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/5`` with ``eps/(5*(Rabsolu l))``.
-Apply H6; Unfold ge; Apply le_trans with (max N2 N3); [Apply le_max_l | Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption]].
-Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption].
-Apply Rabsolu_no_R0; Assumption.
-Apply r_Rmult_mult with ``5``; [Unfold Rdiv; Do 2 Rewrite Rmult_Rplus_distr; Do 3 Rewrite (Rmult_sym ``5``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. 
-Qed.
-
-Lemma RiemannInt_P13 : (f,g:R->R;a,b,l:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b);pr3:(Riemann_integrable [x:R]``(f x)+l*(g x)`` a b)) ``(RiemannInt pr3)==(RiemannInt pr1)+l*(RiemannInt pr2)``.
-Intros; Case (total_order_Rle a b); Intro; [Apply RiemannInt_P12; Assumption | Assert H : ``b<=a``; [Auto with real | Replace (RiemannInt pr3) with (Ropp (RiemannInt (RiemannInt_P1 pr3))); [Idtac | Symmetry; Apply RiemannInt_P8]; Replace (RiemannInt pr2) with (Ropp (RiemannInt (RiemannInt_P1 pr2))); [Idtac | Symmetry; Apply RiemannInt_P8]; Replace (RiemannInt pr1) with (Ropp (RiemannInt (RiemannInt_P1 pr1))); [Idtac | Symmetry; Apply RiemannInt_P8]; Rewrite (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) (RiemannInt_P1 pr3) H); Ring]].
-Qed.
-
-Lemma RiemannInt_P14 : (a,b,c:R) (Riemann_integrable (fct_cte c) a b).
-Unfold Riemann_integrable; Intros; Split with (mkStepFun (StepFun_P4 a b c)); Split with (mkStepFun (StepFun_P4 a b R0)); Split; [Intros; Simpl; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold fct_cte; Right; Reflexivity | Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos eps)].
-Qed.
-
-Lemma RiemannInt_P15 : (a,b,c:R;pr:(Riemann_integrable (fct_cte c) a b)) ``(RiemannInt pr)==c*(b-a)``.
-Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!(fct_cte c) 2!a 3!b pr 5!RinvN RinvN_cv); Intros; EApply UL_sequence.
-Apply u.
-Pose phi1 := [N:nat](phi_sequence RinvN 2!(fct_cte c) 3!a 4!b pr N); Change (Un_cv [N:nat](RiemannInt_SF (phi1 N)) ``c*(b-a)``); Pose f := (fct_cte c); Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr n)).
-Elim H1; Clear H1; Intros psi1 H1; Pose phi2 := [n:nat](mkStepFun (StepFun_P4 a b c)); Pose psi2 := [n:nat](mkStepFun (StepFun_P4 a b R0)); Apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; Try Assumption.
-Apply RinvN_cv.
-Intro; Split.
-Intros; Unfold f; Simpl; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold fct_cte; Right; Reflexivity.
-Unfold psi2; Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos (RinvN n)).
-Unfold Un_cv; Intros; Split with O; Intros; Unfold R_dist; Unfold phi2; Rewrite StepFun_P18; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H.
-Qed.
-
-Lemma RiemannInt_P16 : (f:R->R;a,b:R) (Riemann_integrable f a b) -> (Riemann_integrable [x:R](Rabsolu (f x)) a b).
-Unfold Riemann_integrable; Intro f; Intros; Elim (X eps); Clear X; Intros phi [psi [H H0]]; Split with (mkStepFun (StepFun_P32 phi)); Split with psi; Split; Try Assumption; Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-(phi t)))``; [Apply Rabsolu_triang_inv2 | Apply H; Assumption].
-Qed.
-
-Lemma Rle_cv_lim : (Un,Vn:nat->R;l1,l2:R) ((n:nat)``(Un n)<=(Vn n)``) -> (Un_cv Un l1) -> (Un_cv Vn l2) -> ``l1<=l2``.
-Intros; Case (total_order_Rle l1 l2); Intro.
-Assumption.
-Assert H2 : ``l2<l1``.
-Auto with real.
-Clear n; Assert H3 : ``0<(l1-l2)/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rlt_Rminus; Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H1 ? H3); Elim (H0 ? H3); Clear H0 H1; Unfold R_dist; Intros; Pose N := (max x x0); Cut ``(Vn N)<(Un N)``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (H N) H4)).
-Apply Rlt_trans with ``(l1+l2)/2``.
-Apply Rlt_anti_compatibility with ``-l2``; Replace ``-l2+(l1+l2)/2`` with ``(l1-l2)/2``.
-Rewrite Rplus_sym; Apply Rle_lt_trans with ``(Rabsolu ((Vn N)-l2))``.
-Apply Rle_Rabsolu.
-Apply H1; Unfold ge; Unfold N; Apply le_max_r.
-Apply r_Rmult_mult with ``2``; [Unfold Rdiv; Do 2 Rewrite -> (Rmult_sym ``2``); Rewrite (Rmult_Rplus_distrl ``-l2`` ``(l1+l2)*/2`` ``2``); Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [ Ring | DiscrR ] | DiscrR].
-Apply Ropp_Rlt; Apply Rlt_anti_compatibility with l1; Replace ``l1+ -((l1+l2)/2)`` with ``(l1-l2)/2``.
-Apply Rle_lt_trans with ``(Rabsolu ((Un N)-l1))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
-Apply H0; Unfold ge; Unfold N; Apply le_max_l.
-Apply r_Rmult_mult with ``2``; [Unfold Rdiv; Do 2 Rewrite -> (Rmult_sym ``2``); Rewrite (Rmult_Rplus_distrl ``l1`` ``-((l1+l2)*/2)`` ``2``); Rewrite <- Ropp_mul1; Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [ Ring | DiscrR ] | DiscrR].
-Qed.
-
-Lemma RiemannInt_P17 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable [x:R](Rabsolu (f x)) a b)) ``a<=b`` -> ``(Rabsolu (RiemannInt pr1))<=(RiemannInt pr2)``.
-Intro f; Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!([x0:R](Rabsolu (f x0))) 2!a 3!b pr2 5!RinvN RinvN_cv); Intros; LetTac phi1 := (phi_sequence RinvN pr1) in u0; Pose phi2 := [N:nat](mkStepFun (StepFun_P32 (phi1 N))); Apply Rle_cv_lim with [N:nat](Rabsolu (RiemannInt_SF (phi1 N))) [N:nat](RiemannInt_SF (phi2 N)).
-Intro; Unfold phi2; Apply StepFun_P34; Assumption.
-Apply (continuity_seq Rabsolu [N:nat](RiemannInt_SF (phi1 N)) x0); Try Assumption.
-Apply continuity_Rabsolu.
-Pose phi3 := (phi_sequence RinvN pr2); Assert H0 : (EXT psi3:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((Rabsolu (f t))-((phi3 n) t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). 
-Assert H1 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((Rabsolu (f t))-((phi2 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Assert H1 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-((phi1 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)).
-Elim H1; Clear H1; Intros psi2 H1; Split with psi2; Intros; Elim (H1 n); Clear H1; Intros; Split; Try Assumption.
-Intros; Unfold phi2; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-((phi1 n) t)))``.
-Apply Rabsolu_triang_inv2.
-Apply H1; Assumption.
-Elim H0; Clear H0; Intros psi3 H0; Elim H1; Clear H1; Intros psi2 H1; Apply RiemannInt_P11 with [x:R](Rabsolu (f x)) RinvN phi3 psi3 psi2; Try Assumption; Apply RinvN_cv.
-Qed.
-
-Lemma RiemannInt_P18 : (f,g:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)==(g x)``) -> ``(RiemannInt pr1)==(RiemannInt pr2)``.
-Intro f; Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!g 2!a 3!b pr2 5!RinvN RinvN_cv); Intros; EApply UL_sequence.
-Apply u0.
-Pose phi1 := [N:nat](phi_sequence RinvN 2!f 3!a 4!b pr1 N); Change (Un_cv [N:nat](RiemannInt_SF (phi1 N)) x); Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-((phi1 n) t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)). 
-Elim H1; Clear H1; Intros psi1 H1; Pose phi2 := [N:nat](phi_sequence RinvN 2!g 3!a 4!b pr2 N).
-Pose phi2_aux := [N:nat][x:R](Cases (Req_EM_T x a) of
-    | (leftT _) => (f a)
-    | (rightT _) => (Cases (Req_EM_T x b) of
-	| (leftT _) => (f b)
-	| (rightT _) => (phi2 N x) end) end).
-Cut (N:nat)(IsStepFun (phi2_aux N) a b).
-Intro; Pose phi2_m := [N:nat](mkStepFun (X N)).
-Assert H2 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((g t)-((phi2 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). 
-Elim H2; Clear H2; Intros psi2 H2; Apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; Try Assumption. 
-Apply RinvN_cv.
-Intro; Elim (H2 n); Intros; Split; Try Assumption.
-Intros; Unfold phi2_m; Simpl; Unfold phi2_aux; Case (Req_EM_T t a); Case (Req_EM_T t b); Intros.
-Rewrite e0; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
-Apply Rabsolu_pos.
-Pattern 3 a; Rewrite <- e0; Apply H3; Assumption.
-Rewrite e; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
-Apply Rabsolu_pos.
-Pattern 3 a; Rewrite <- e; Apply H3; Assumption.
-Rewrite e; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
-Apply Rabsolu_pos.
-Pattern 3 b; Rewrite <- e; Apply H3; Assumption.
-Replace (f t) with (g t).
-Apply H3; Assumption.
-Symmetry; Apply H0; Elim H5; Clear H5; Intros.
-Assert H7 : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n2; Assumption].
-Assert H8 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n2; Assumption].
-Rewrite H7 in H5; Rewrite H8 in H6; Split.
-Elim H5; Intro; [Assumption | Elim n1; Symmetry; Assumption].
-Elim H6; Intro; [Assumption | Elim n0; Assumption].
-Cut (N:nat)(RiemannInt_SF (phi2_m N))==(RiemannInt_SF (phi2 N)).
-Intro; Unfold Un_cv; Intros; Elim (u ? H4); Intros; Exists x1; Intros; Rewrite (H3 n); Apply H5; Assumption.
-Intro; Apply Rle_antisym.
-Apply StepFun_P37; Try Assumption.
-Intros; Unfold phi2_m; Simpl; Unfold phi2_aux; Case (Req_EM_T x1 a); Case (Req_EM_T x1 b); Intros.
-Elim H3; Intros; Rewrite e0 in H4; Elim (Rlt_antirefl ? H4).
-Elim H3; Intros; Rewrite e in H4; Elim (Rlt_antirefl ? H4).
-Elim H3; Intros; Rewrite e in H5; Elim (Rlt_antirefl ? H5).
-Right; Reflexivity.
-Apply StepFun_P37; Try Assumption.
-Intros; Unfold phi2_m; Simpl; Unfold phi2_aux; Case (Req_EM_T x1 a); Case (Req_EM_T x1 b); Intros.
-Elim H3; Intros; Rewrite e0 in H4; Elim (Rlt_antirefl ? H4).
-Elim H3; Intros; Rewrite e in H4; Elim (Rlt_antirefl ? H4).
-Elim H3; Intros; Rewrite e in H5; Elim (Rlt_antirefl ? H5).
-Right; Reflexivity.
-Intro; Assert H2 := (pre (phi2 N)); Unfold IsStepFun in H2; Unfold is_subdivision in H2; Elim H2; Clear H2; Intros l [lf H2]; Split with l; Split with lf; Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H2); Unfold constant_D_eq open_interval in H9; Unfold constant_D_eq open_interval; Intros; Rewrite <- (H9 x1 H7); Assert H10 : ``a<=(pos_Rl l i)``.
-Replace a with (Rmin a b).
-Rewrite <- H5; Elim (RList_P6 l); Intros; Apply H10.
-Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l)); [Assumption | Apply lt_pred_n_n].
-Apply neq_O_lt; Intro; Rewrite <- H12 in H6; Discriminate.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H11 : ``(pos_Rl l (S i))<=b``.
-Replace b with (Rmax a b).
-Rewrite <- H4; Elim (RList_P6 l); Intros; Apply H11.
-Assumption.
-Apply lt_le_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Intro; Rewrite <- H13 in H6; Discriminate.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Elim H7; Clear H7; Intros; Unfold phi2_aux; Case (Req_EM_T x1 a); Case (Req_EM_T x1 b); Intros.
-Rewrite e in H12; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H12)).
-Rewrite e in H7; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H10 H7)).
-Rewrite e in H12; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H12)).
-Reflexivity.
-Qed.
-
-Lemma RiemannInt_P19 : (f,g:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt pr1)<=(RiemannInt pr2)``.
-Intro f; Intros; Apply Rle_anti_compatibility with ``-(RiemannInt pr1)``; Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Apply Rle_trans with (Rabsolu (RiemannInt (RiemannInt_P10 ``-1`` pr2 pr1))).
-Apply Rabsolu_pos.
-Replace ``(RiemannInt pr2)+ -(RiemannInt pr1)`` with (RiemannInt (RiemannInt_P16 (RiemannInt_P10 ``-1`` pr2 pr1))).
-Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` pr2 pr1) (RiemannInt_P16 (RiemannInt_P10 ``-1`` pr2 pr1))); Assumption.
-Replace ``(RiemannInt pr2)+-(RiemannInt pr1)`` with (RiemannInt (RiemannInt_P10 ``-1`` pr2 pr1)).
-Apply RiemannInt_P18; Try Assumption.
-Intros; Apply Rabsolu_right.
-Apply Rle_sym1; Apply Rle_anti_compatibility with (f x); Rewrite Rplus_Or; Replace ``(f x)+((g x)+ -1*(f x))`` with (g x); [Apply H0; Assumption | Ring].
-Rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 ``-1`` pr2 pr1)); [Ring | Assumption].
-Qed.
-
-Lemma FTC_P1 : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x)).
-Intros; Apply continuity_implies_RiemannInt; [Assumption | Intros; Apply H0; Elim H3; Intros; Split; Assumption Orelse Apply Rle_trans with x; Assumption].
-Qed.
-V7only [Notation FTC_P2 := Rle_refl.].
-
-Definition primitive [f:R->R;a,b:R;h:``a<=b``;pr:((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x))] : R->R := [x:R] Cases (total_order_Rle a x) of
-   | (leftT r) => Cases (total_order_Rle x b) of
-          | (leftT r0) => (RiemannInt (pr x r r0))
-          | (rightT _) => ``(f b)*(x-b)+(RiemannInt (pr b h (FTC_P2 b)))`` end
-   | (rightT _) => ``(f a)*(x-a)`` end.
-
-Lemma RiemannInt_P20 : (f:R->R;a,b:R;h:``a<=b``;pr:((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x));pr0:(Riemann_integrable f a b)) ``(RiemannInt pr0)==(primitive h pr b)-(primitive h pr a)``.
-Intros; Replace (primitive h pr a) with R0.
-Replace (RiemannInt pr0) with (primitive h pr b).
-Ring.
-Unfold primitive; Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; [Apply RiemannInt_P5 | Elim n; Right; Reflexivity | Elim n; Assumption | Elim n0; Assumption].
-Symmetry; Unfold primitive; Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; [Apply RiemannInt_P9 | Elim n; Assumption | Elim n; Right; Reflexivity | Elim n0; Right; Reflexivity].
-Qed.
-
-Lemma RiemannInt_P21 : (f:R->R;a,b,c:R) ``a<=b``-> ``b<=c`` -> (Riemann_integrable f a b) -> (Riemann_integrable f b c) -> (Riemann_integrable f a c).
-Unfold Riemann_integrable; Intros f a b c Hyp1 Hyp2 X X0 eps.
-Assert H : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
-Elim (X (mkposreal ? H)); Clear X; Intros phi1 [psi1 H1]; Elim (X0 (mkposreal ? H)); Clear X0; Intros phi2 [psi2 H2].
-Pose phi3 := [x:R] Cases (total_order_Rle a x) of
-  | (leftT _) => Cases (total_order_Rle x b) of
-    | (leftT _) => (phi1 x)
-    | (rightT _) => (phi2 x) end
-  | (rightT _) => R0 end.
-Pose psi3 := [x:R] Cases (total_order_Rle a x) of
-  | (leftT _) => Cases (total_order_Rle x b) of
-    | (leftT _) => (psi1 x)
-    | (rightT _) => (psi2 x) end
-  | (rightT _) => R0 end.
-Cut (IsStepFun phi3 a c).
-Intro; Cut (IsStepFun psi3 a b).
-Intro; Cut (IsStepFun psi3 b c).
-Intro; Cut (IsStepFun psi3 a c).
-Intro; Split with (mkStepFun X); Split with (mkStepFun X2); Simpl; Split.
-Intros; Unfold phi3 psi3; Case (total_order_Rle t b); Case (total_order_Rle a t); Intros.
-Elim H1; Intros; Apply H3.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Split; Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Elim n; Replace a with (Rmin a c).
-Elim H0; Intros; Assumption.
-Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Elim H2; Intros; Apply H3.
-Replace (Rmax b c) with (Rmax a c).
-Elim H0; Intros; Split; Try Assumption.
-Replace (Rmin b c) with b.
-Auto with real.
-Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
-Unfold Rmax; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; Try (Elim n0; Assumption Orelse Elim n0; Apply Rle_trans with b; Assumption).
-Reflexivity.
-Elim n; Replace a with (Rmin a c).
-Elim H0; Intros; Assumption.
-Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n1; Apply Rle_trans with b; Assumption].
-Rewrite <- (StepFun_P43 X0 X1 X2).
-Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF (mkStepFun X0)))+(Rabsolu (RiemannInt_SF (mkStepFun X1)))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1).
-Replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2).
-Apply Rplus_lt.
-Elim H1; Intros; Assumption.
-Elim H2; Intros; Assumption.
-Apply Rle_antisym.
-Apply StepFun_P37; Try Assumption.
-Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H0)) | Right; Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
-Apply StepFun_P37; Try Assumption.
-Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H0)) | Right; Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
-Apply Rle_antisym.
-Apply StepFun_P37; Try Assumption.
-Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Right; Reflexivity | Elim n; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Apply StepFun_P37; Try Assumption.
-Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Right; Reflexivity | Elim n; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Apply StepFun_P46 with b; Assumption.
-Assert H3 := (pre psi2); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H3); Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9; Intros; Rewrite <- (H9 x H7); Unfold psi3; Assert H10 : ``b<x``.
-Apply Rle_lt_trans with (pos_Rl l1 i).
-Replace b with (Rmin b c).
-Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H10; Try Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H6; Discriminate. 
-Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Assumption].
-Elim H7; Intros; Assumption.
-Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)) | Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
-Assert H3 := (pre psi1); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H3); Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9; Intros; Rewrite <- (H9 x H7); Unfold psi3; Assert H10 : ``x<=b``.
-Apply Rle_trans with (pos_Rl l1 (S i)).
-Elim H7; Intros; Left; Assumption.
-Replace b with (Rmax a b).
-Rewrite <- H4; Elim (RList_P6 l1); Intros; Apply H10; Try Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H6; Discriminate. 
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H11 : ``a<=x``.
-Apply Rle_trans with (pos_Rl l1 i).
-Replace a with (Rmin a b).
-Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H11; Try Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H6; Discriminate. 
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Left; Elim H7; Intros; Assumption.
-Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Reflexivity Orelse Elim n; Assumption.
-Apply StepFun_P46 with b.
-Assert H3 := (pre phi1); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H3); Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9; Intros; Rewrite <- (H9 x H7); Unfold psi3; Assert H10 : ``x<=b``.
-Apply Rle_trans with (pos_Rl l1 (S i)).
-Elim H7; Intros; Left; Assumption.
-Replace b with (Rmax a b).
-Rewrite <- H4; Elim (RList_P6 l1); Intros; Apply H10; Try Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H6; Discriminate. 
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H11 : ``a<=x``.
-Apply Rle_trans with (pos_Rl l1 i).
-Replace a with (Rmin a b).
-Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H11; Try Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H6; Discriminate. 
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Left; Elim H7; Intros; Assumption.
-Unfold phi3; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Reflexivity Orelse Elim n; Assumption.
-Assert H3 := (pre phi2); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption.
-Intros; Assert H9 := (H8 i H3); Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9; Intros; Rewrite <- (H9 x H7); Unfold psi3; Assert H10 : ``b<x``.
-Apply Rle_lt_trans with (pos_Rl l1 i).
-Replace b with (Rmin b c).
-Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H10; Try Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H12 in H6; Discriminate. 
-Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Assumption].
-Elim H7; Intros; Assumption.
-Unfold phi3; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)) | Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
-Qed.
-
-Lemma RiemannInt_P22 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> ``a<=c<=b`` -> (Riemann_integrable f a c).
-Unfold Riemann_integrable; Intros; Elim (X eps); Clear X; Intros phi [psi H0]; Elim H; Elim H0; Clear H H0; Intros; Assert H3 : (IsStepFun phi a c).
-Apply StepFun_P44 with b.
-Apply (pre phi).
-Split; Assumption.
-Assert H4 : (IsStepFun psi a c).
-Apply StepFun_P44 with b.
-Apply (pre psi).
-Split; Assumption.
-Split with (mkStepFun H3); Split with (mkStepFun H4); Split.
-Simpl; Intros; Apply H.
-Replace (Rmin a b) with (Rmin a c).
-Elim H5; Intros; Split; Try Assumption.
-Apply Rle_trans with (Rmax a c); Try Assumption.
-Replace (Rmax a b) with b.
-Replace (Rmax a c) with c.
-Assumption.
-Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption | Elim n; Assumption | Elim n0; Assumption].
-Rewrite Rabsolu_right.
-Assert H5 : (IsStepFun psi c b).
-Apply StepFun_P46 with a.
-Apply StepFun_P6; Assumption.
-Apply (pre psi).
-Replace (RiemannInt_SF (mkStepFun H4)) with ``(RiemannInt_SF psi)-(RiemannInt_SF (mkStepFun H5))``.
-Apply Rle_lt_trans with (RiemannInt_SF psi).
-Unfold Rminus; Pattern 2 (RiemannInt_SF psi); Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b R0))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
-Apply Rabsolu_pos.
-Apply H.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Elim H6; Intros; Split; Left.
-Apply Rle_lt_trans with c; Assumption.
-Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Rewrite StepFun_P18; Ring.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi)).
-Apply Rle_Rabsolu.
-Assumption.
-Assert H6 : (IsStepFun psi a b).
-Apply (pre psi).
-Replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
-Rewrite <- (StepFun_P43 H4 H5 H6); Ring.
-Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-EApply StepFun_P17.
-Apply StepFun_P1.
-Simpl; Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply StepFun_P1.
-Simpl; Apply StepFun_P1.
-Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c R0))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
-Apply Rabsolu_pos.
-Apply H.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Elim H5; Intros; Split; Left.
-Assumption.
-Apply Rlt_le_trans with c; Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Rewrite StepFun_P18; Ring.
-Qed.
-
-Lemma RiemannInt_P23 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> ``a<=c<=b`` -> (Riemann_integrable f c b).
-Unfold Riemann_integrable; Intros; Elim (X eps); Clear X; Intros phi [psi H0]; Elim H; Elim H0; Clear H H0; Intros; Assert H3 : (IsStepFun phi c b).
-Apply StepFun_P45 with a.
-Apply (pre phi).
-Split; Assumption.
-Assert H4 : (IsStepFun psi c b).
-Apply StepFun_P45 with a.
-Apply (pre psi).
-Split; Assumption.
-Split with (mkStepFun H3); Split with (mkStepFun H4); Split.
-Simpl; Intros; Apply H.
-Replace (Rmax a b) with (Rmax c b).
-Elim H5; Intros; Split; Try Assumption.
-Apply Rle_trans with (Rmin c b); Try Assumption.
-Replace (Rmin a b) with a.
-Replace (Rmin c b) with c.
-Assumption.
-Unfold Rmin; Case (total_order_Rle c b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmax; Case (total_order_Rle c b); Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption | Elim n; Assumption | Elim n0; Assumption].
-Rewrite Rabsolu_right.
-Assert H5 : (IsStepFun psi a c).
-Apply StepFun_P46 with b.
-Apply (pre psi).
-Apply StepFun_P6; Assumption.
-Replace (RiemannInt_SF (mkStepFun H4)) with ``(RiemannInt_SF psi)-(RiemannInt_SF (mkStepFun H5))``.
-Apply Rle_lt_trans with (RiemannInt_SF psi).
-Unfold Rminus; Pattern 2 (RiemannInt_SF psi); Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c R0))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
-Apply Rabsolu_pos.
-Apply H.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Elim H6; Intros; Split; Left.
-Assumption.
-Apply Rlt_le_trans with c; Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Rewrite StepFun_P18; Ring.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi)).
-Apply Rle_Rabsolu.
-Assumption.
-Assert H6 : (IsStepFun psi a b).
-Apply (pre psi).
-Replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
-Rewrite <- (StepFun_P43 H5 H4 H6); Ring.
-Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-EApply StepFun_P17.
-Apply StepFun_P1.
-Simpl; Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply StepFun_P1.
-Simpl; Apply StepFun_P1.
-Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b R0))).
-Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
-Apply Rabsolu_pos.
-Apply H.
-Replace (Rmin a b) with a.
-Replace (Rmax a b) with b.
-Elim H5; Intros; Split; Left.
-Apply Rle_lt_trans with c; Assumption.
-Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
-Rewrite StepFun_P18; Ring.
-Qed.
-
-Lemma RiemannInt_P24 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> (Riemann_integrable f b c) -> (Riemann_integrable f a c).
-Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
-Apply RiemannInt_P21 with b; Assumption.
-Case (total_order_Rle a c); Intro.
-Apply RiemannInt_P22 with b; Try Assumption.
-Split; [Assumption | Auto with real].
-Apply RiemannInt_P1; Apply RiemannInt_P22 with b.
-Apply RiemannInt_P1; Assumption.
-Split; Auto with real.
-Case (total_order_Rle a c); Intro.
-Apply RiemannInt_P23 with b; Try Assumption.
-Split; Auto with real.
-Apply RiemannInt_P1; Apply RiemannInt_P23 with b.
-Apply RiemannInt_P1; Assumption.
-Split; [Assumption | Auto with real].
-Apply RiemannInt_P1; Apply RiemannInt_P21 with b; Auto with real Orelse Apply RiemannInt_P1; Assumption.
-Qed.
-
-Lemma RiemannInt_P25 : (f:R->R;a,b,c:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b c);pr3:(Riemann_integrable f a c)) ``a<=b``->``b<=c``->``(RiemannInt pr1)+(RiemannInt pr2)==(RiemannInt pr3)``.
-Intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!f 2!b 3!c pr2 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!f 2!a 3!c pr3 5!RinvN RinvN_cv); Intros; Symmetry; EApply UL_sequence.
-Apply u.
-Unfold Un_cv; Intros; Assert H0 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (u1 ? H0); Clear u1; Intros N1 H1; Elim (u0 ? H0); Clear u0; Intros N2 H2; Cut (Un_cv [n:nat]``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))`` R0).
-Intro; Elim (H3 ? H0); Clear H3; Intros N3 H3; Pose N0 := (max (max N1 N2) N3); Exists N0; Intros; Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu (((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0)))``.
-Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-(x1+x0)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)])))+(((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0))``; [Apply Rabsolu_triang | Ring].
-Replace eps with ``eps/3+eps/3+eps/3``.
-Rewrite Rplus_assoc; Apply Rplus_lt.
-Unfold R_dist in H3; Cut (ge n N3).
-Intro; Assert H6 := (H3 ? H5); Unfold Rminus in H6; Rewrite Ropp_O in H6; Rewrite Rplus_Or in H6; Apply H6.
-Unfold ge; Apply le_trans with N0; [Unfold N0; Apply le_max_r | Assumption].
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x1))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x0))``.
-Replace ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x1)+((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x0)``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_lt.
-Unfold R_dist in H1; Apply H1.
-Unfold ge; Apply le_trans with N0; [Apply le_trans with (max N1 N2); [Apply le_max_l | Unfold N0; Apply le_max_l] | Assumption].
-Unfold R_dist in H2; Apply H2.
-Unfold ge; Apply le_trans with N0; [Apply le_trans with (max N1 N2); [Apply le_max_r | Unfold N0; Apply le_max_l] | Assumption].
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Repeat Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Clear x u x0 x1 eps H H0 N1 H1 N2 H2; Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)). 
-Assert H2 : (EXT psi2:nat->(StepFun b c) | (n:nat) ((t:R)``(Rmin b c) <= t``/\``t <= (Rmax b c)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). 
-Assert H3 : (EXT psi3:nat->(StepFun a c) | (n:nat) ((t:R)``(Rmin a c) <= t``/\``t <= (Rmax a c)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr3 n)] t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
-Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n)). 
-Elim H1; Clear H1; Intros psi1 H1; Elim H2; Clear H2; Intros psi2 H2; Elim H3; Clear H3; Intros psi3 H3; Assert H := RinvN_cv; Unfold Un_cv; Intros; Assert H4 : ``0<eps/3``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H ? H4); Clear H; Intros N0 H; Assert H5 : (n:nat)(ge n N0)->``(RinvN n)<eps/3``.
-Intros; Replace (pos (RinvN n)) with ``(R_dist (mkposreal (/((INR n)+1)) (RinvN_pos n)) 0)``.
-Apply H; Assumption.
-Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (RinvN n)).
-Exists N0; Intros; Elim (H1 n); Elim (H2 n); Elim (H3 n); Clear H1 H2 H3; Intros; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; LetTac phi1 := (phi_sequence RinvN pr1 n) in H8 Goal; LetTac phi2 := (phi_sequence RinvN pr2 n) in H3 Goal; LetTac phi3 := (phi_sequence RinvN pr3 n) in H1 Goal; Assert H10 : (IsStepFun phi3 a b).
-Apply StepFun_P44 with c.
-Apply (pre phi3).
-Split; Assumption.
-Assert H11 : (IsStepFun (psi3 n) a b).
-Apply StepFun_P44 with c.
-Apply (pre (psi3 n)).
-Split; Assumption.
-Assert H12 : (IsStepFun phi3 b c).
-Apply StepFun_P45 with a.
-Apply (pre phi3).
-Split; Assumption.
-Assert H13 : (IsStepFun (psi3 n) b c).
-Apply StepFun_P45 with a.
-Apply (pre (psi3 n)).
-Split; Assumption.
-Replace (RiemannInt_SF phi3) with ``(RiemannInt_SF (mkStepFun H10))+(RiemannInt_SF (mkStepFun H12))``.
-Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1)))+(Rabsolu ((RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2)))``.
-Replace ``(RiemannInt_SF (mkStepFun H10))+(RiemannInt_SF (mkStepFun H12))+ -((RiemannInt_SF phi1)+(RiemannInt_SF phi2))`` with ``((RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1))+((RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2))``; [Apply Rabsolu_triang | Ring].
-Replace ``(RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1)`` with (RiemannInt_SF (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H10) phi1))).
-Replace ``(RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2)`` with (RiemannInt_SF (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H12) phi2))).
-Apply Rle_lt_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))))+(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))``.
-Apply Rle_trans with ``(Rabsolu (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))))+(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))``.
-Apply Rle_compatibility.
-Apply StepFun_P34; Try Assumption.
-Do 2 Rewrite <- (Rplus_sym (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H12) phi2)))))); Apply Rle_compatibility; Apply StepFun_P34; Try Assumption.
-Apply Rle_lt_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H11) (psi1 n))))+(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``.
-Apply Rle_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))))+(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``.
-Apply Rle_compatibility; Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ((f x)-(phi3 x)))+(Rabsolu ((f x)-(phi2 x)))``.
-Rewrite <- (Rabsolu_Ropp ``(f x)-(phi3 x)``); Rewrite Ropp_distr2; Replace ``(phi3 x)+ -1*(phi2 x)`` with ``((phi3 x)-(f x))+((f x)-(phi2 x))``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_le.
-Apply H1.
-Elim H14; Intros; Split.
-Replace (Rmin a c) with a.
-Apply Rle_trans with b; Try Assumption.
-Left; Assumption.
-Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Replace (Rmax a c) with c.
-Left; Assumption.
-Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Apply H3.
-Elim H14; Intros; Split.
-Replace (Rmin b c) with b.
-Left; Assumption.
-Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
-Replace (Rmax b c) with c.
-Left; Assumption.
-Unfold Rmax; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
-Do 2 Rewrite <- (Rplus_sym ``(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``); Apply Rle_compatibility; Apply StepFun_P37; Try Assumption.
-Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ((f x)-(phi3 x)))+(Rabsolu ((f x)-(phi1 x)))``.
-Rewrite <- (Rabsolu_Ropp ``(f x)-(phi3 x)``); Rewrite Ropp_distr2; Replace ``(phi3 x)+ -1*(phi1 x)`` with ``((phi3 x)-(f x))+((f x)-(phi1 x))``; [Apply Rabsolu_triang | Ring].
-Apply Rplus_le.
-Apply H1.
-Elim H14; Intros; Split.
-Replace (Rmin a c) with a.
-Left; Assumption.
-Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Replace (Rmax a c) with c.
-Apply Rle_trans with b.
-Left; Assumption.
-Assumption.
-Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
-Apply H8.
-Elim H14; Intros; Split.
-Replace (Rmin a b) with a.
-Left; Assumption.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Replace (Rmax a b) with b.
-Left; Assumption.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
-Do 2 Rewrite StepFun_P30.
-Do 2 Rewrite Rmult_1l; Replace ``(RiemannInt_SF (mkStepFun H11))+(RiemannInt_SF (psi1 n))+((RiemannInt_SF (mkStepFun H13))+(RiemannInt_SF (psi2 n)))`` with ``(RiemannInt_SF (psi3 n))+(RiemannInt_SF (psi1 n))+(RiemannInt_SF (psi2 n))``.
-Replace eps with ``eps/3+eps/3+eps/3``.
-Repeat Rewrite Rplus_assoc; Repeat Apply Rplus_lt.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi3 n))).
-Apply Rle_Rabsolu.
-Apply Rlt_trans with (pos (RinvN n)).
-Assumption.
-Apply H5; Assumption.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
-Apply Rle_Rabsolu.
-Apply Rlt_trans with (pos (RinvN n)).
-Assumption.
-Apply H5; Assumption.
-Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
-Apply Rle_Rabsolu.
-Apply Rlt_trans with (pos (RinvN n)).
-Assumption.
-Apply H5; Assumption.
-Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Repeat Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
-Replace (RiemannInt_SF (psi3 n)) with (RiemannInt_SF (mkStepFun (pre (psi3 n)))).
-Rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); Ring.
-Reflexivity.
-Rewrite StepFun_P30; Ring.
-Rewrite StepFun_P30; Ring.
-Apply (StepFun_P43 H10 H12 (pre phi3)).
-Qed.
-
-Lemma RiemannInt_P26 : (f:R->R;a,b,c:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b c);pr3:(Riemann_integrable f a c)) ``(RiemannInt pr1)+(RiemannInt pr2)==(RiemannInt pr3)``.
-Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
-Apply RiemannInt_P25; Assumption.
-Case (total_order_Rle a c); Intro.
-Assert H : ``c<=b``.
-Auto with real.
-Rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H); Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Ring.
-Assert H : ``c<=a``.
-Auto with real.
-Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Ring.
-Assert H : ``b<=a``.
-Auto with real.
-Case (total_order_Rle a c); Intro.
-Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0); Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Ring.
-Assert H0 : ``c<=a``.
-Auto with real.
-Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r  H0); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Ring.
-Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)); [Ring | Auto with real | Auto with real].
-Qed.
-
-Lemma RiemannInt_P27 : (f:R->R;a,b,x:R;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) ``a<x<b`` -> (derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x)).
-Intro f; Intros; Elim H; Clear H; Intros; Assert H1 : (continuity_pt f x).
-Apply C0; Split; Left; Assumption.
-Unfold derivable_pt_lim; Intros; Assert Hyp : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H1 ? Hyp); Unfold dist D_x no_cond; Simpl; Unfold R_dist; Intros; Pose del := (Rmin x0 (Rmin ``b-x`` ``x-a``)); Assert H4 : ``0<del``.
-Unfold del; Unfold Rmin; Case (total_order_Rle ``b-x`` ``x-a``); Intro.
-Case (total_order_Rle x0 ``b-x``); Intro; [Elim H3; Intros; Assumption | Apply Rlt_Rminus; Assumption].
-Case (total_order_Rle x0 ``x-a``); Intro; [Elim H3; Intros; Assumption | Apply Rlt_Rminus; Assumption].
-Split with (mkposreal ? H4); Intros; Assert H7 : (Riemann_integrable f x ``x+h0``).
-Case (total_order_Rle x ``x+h0``); Intro.
-Apply continuity_implies_RiemannInt; Try Assumption.
-Intros; Apply C0; Elim H7; Intros; Split.
-Apply Rle_trans with x; [Left; Assumption | Assumption].
-Apply Rle_trans with ``x+h0``.
-Assumption.
-Left; Apply Rlt_le_trans with ``x+del``.
-Apply Rlt_compatibility; Apply Rle_lt_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Apply H6].
-Unfold del; Apply Rle_trans with ``x+(Rmin (b-x) (x-a))``.
-Apply Rle_compatibility; Apply Rmin_r.
-Pattern 2 b; Replace b with ``x+(b-x)``; [Apply Rle_compatibility; Apply Rmin_l | Ring].
-Apply RiemannInt_P1; Apply continuity_implies_RiemannInt; Auto with real.
-Intros; Apply C0; Elim H7; Intros; Split.
-Apply Rle_trans with ``x+h0``.
-Left; Apply Rle_lt_trans with ``x-del``.
-Unfold del; Apply Rle_trans with ``x-(Rmin (b-x) (x-a))``.
-Pattern 1 a; Replace a with ``x+(a-x)``; [Idtac | Ring].
-Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
-Rewrite Ropp_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Rewrite (Rplus_sym x); Apply Rmin_r.
-Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
-Do 2 Rewrite Ropp_Ropp; Apply Rmin_r.
-Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt.
-Rewrite Ropp_Ropp; Apply Rle_lt_trans with (Rabsolu h0); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply H6].
-Assumption.
-Apply Rle_trans with x; [Assumption | Left; Assumption].
-Replace ``(primitive h (FTC_P1 h C0) (x+h0))-(primitive h (FTC_P1 h C0) x)`` with (RiemannInt H7).
-Replace (f x) with ``(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))/h0``.
-Replace ``(RiemannInt H7)/h0-(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))/h0`` with ``((RiemannInt H7)-(RiemannInt (RiemannInt_P14 x (x+h0) (f x))))/h0``.
-Replace ``(RiemannInt H7)-(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))).
-Unfold Rdiv; Rewrite Rabsolu_mult; Case (total_order_Rle x ``x+h0``); Intro.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x)))))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x))))); Assumption.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 x (x+h0) (eps/2)))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply RiemannInt_P19; Try Assumption.
-Intros; Replace ``(f x1)+ -1*(fct_cte (f x) x1)`` with ``(f x1)-(f x)``.
-Unfold fct_cte; Case (Req_EM x x1); Intro.
-Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H3; Intros; Left; Apply H11.
-Repeat Split.
-Assumption.
-Rewrite Rabsolu_right.
-Apply Rlt_anti_compatibility with x; Replace ``x+(x1-x)`` with x1; [Idtac | Ring].
-Apply Rlt_le_trans with ``x+h0``.
-Elim H8; Intros; Assumption.
-Apply Rle_compatibility; Apply Rle_trans with del.
-Left; Apply Rle_lt_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Assumption].
-Unfold del; Apply Rmin_l.
-Apply Rge_minus; Apply Rle_sym1; Left; Elim H8; Intros; Assumption.
-Unfold fct_cte; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rmult_assoc; Replace ``(x+h0-x)*(Rabsolu (/h0))`` with R1.
-Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite Rabsolu_right.
-Replace ``x+h0-x`` with h0; [Idtac | Ring].
-Apply Rinv_r_sym.
-Assumption.
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Elim r; Intro.
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Assumption.
-Elim H5; Symmetry; Apply r_Rplus_plus with x; Rewrite Rplus_Or; Assumption.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x))))))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Replace (RiemannInt (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))) with ``-(RiemannInt (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x)))))``.
-Rewrite Rabsolu_Ropp; Apply (RiemannInt_P17 (RiemannInt_P1 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))) (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))))); Auto with real.
-Symmetry; Apply RiemannInt_P8.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 (x+h0) x (eps/2)))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply RiemannInt_P19.
-Auto with real.
-Intros; Replace ``(f x1)+ -1*(fct_cte (f x) x1)`` with ``(f x1)-(f x)``.
-Unfold fct_cte; Case (Req_EM x x1); Intro.
-Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H3; Intros; Left; Apply H11.
-Repeat Split.
-Assumption.
-Rewrite Rabsolu_left.
-Apply Rlt_anti_compatibility with ``x1-x0``; Replace ``x1-x0+x0`` with x1; [Idtac | Ring].
-Replace ``x1-x0+ -(x1-x)`` with ``x-x0``; [Idtac | Ring].
-Apply Rle_lt_trans with ``x+h0``.
-Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
-Rewrite Ropp_Ropp; Apply Rle_trans with (Rabsolu h0).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rmin_l].
-Elim H8; Intros; Assumption.
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(x1-x)`` with x1; [Elim H8; Intros; Assumption | Ring].
-Unfold fct_cte; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rmult_assoc; Replace ``(x-(x+h0))*(Rabsolu (/h0))`` with R1.
-Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite Rabsolu_left.
-Replace ``x-(x+h0)`` with ``-h0``; [Idtac | Ring].
-Rewrite Ropp_mul1; Rewrite Ropp_mul3; Rewrite Ropp_Ropp; Apply Rinv_r_sym.
-Assumption.
-Apply Rlt_Rinv2.
-Assert H8 : ``x+h0<x``.
-Auto with real.
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Assumption.
-Rewrite (RiemannInt_P13 H7 (RiemannInt_P14 x ``x+h0`` (f x)) (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))).
-Ring.
-Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring.
-Rewrite RiemannInt_P15; Apply r_Rmult_mult with h0; [Unfold Rdiv; Rewrite -> (Rmult_sym h0); Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | Assumption] | Assumption].
-Cut ``a<=x+h0``.
-Cut ``x+h0<=b``.
-Intros; Unfold primitive.
-Case (total_order_Rle a ``x+h0``); Case (total_order_Rle ``x+h0`` b); Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Try (Elim n; Assumption Orelse Left; Assumption).
-Rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); Ring.
-Apply Rle_anti_compatibility with ``-x``; Replace ``-x+(x+h0)`` with h0; [Idtac | Ring].
-Rewrite Rplus_sym; Apply Rle_trans with (Rabsolu h0).
-Apply Rle_Rabsolu.
-Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rle_trans with ``(Rmin (b-x) (x-a))``; [Apply Rmin_r | Apply Rmin_l]].
-Apply Ropp_Rle; Apply Rle_anti_compatibility with ``x``; Replace ``x+-(x+h0)`` with ``-h0``; [Idtac | Ring].
-Apply Rle_trans with (Rabsolu h0); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rle_trans with ``(Rmin (b-x) (x-a))``; Apply Rmin_r]].
-Qed.
-
-Lemma RiemannInt_P28 : (f:R->R;a,b,x:R;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) ``a<=x<=b`` -> (derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x)).
-Intro f; Intros; Elim h; Intro.
-Elim H; Clear H; Intros; Elim H; Intro.
-Elim H1; Intro.
-Apply RiemannInt_P27; Split; Assumption.
-Pose f_b := [x:R]``(f b)*(x-b)+(RiemannInt [(FTC_P1 h C0 h (FTC_P2 b))])``; Rewrite H3.
-Assert H4 : (derivable_pt_lim f_b b (f b)).
-Unfold f_b; Pattern 2 (f b); Replace (f b) with ``(f b)+0``.
-Change (derivable_pt_lim (plus_fct (mult_fct (fct_cte (f b)) (minus_fct id (fct_cte b))) (fct_cte (RiemannInt (FTC_P1 h C0 h (FTC_P2 b))))) b ``(f b)+0``). 
-Apply derivable_pt_lim_plus.
-Pattern 2 (f b); Replace (f b) with ``0*((minus_fct id (fct_cte b)) b)+((fct_cte (f b)) b)*1``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_const.
-Replace R1 with ``1-0``; [Idtac | Ring].
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte; Ring.
-Apply derivable_pt_lim_const.
-Ring.
-Unfold derivable_pt_lim; Intros; Elim (H4 ? H5); Intros; Assert H7 : (continuity_pt f b).
-Apply C0; Split; [Left; Assumption | Right; Reflexivity].
-Assert H8 : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H7 ? H8); Unfold D_x no_cond dist; Simpl; Unfold R_dist; Intros; Pose del := (Rmin x0 (Rmin x1 ``b-a``)); Assert H10 : ``0<del``.
-Unfold del; Unfold Rmin; Case (total_order_Rle x1 ``b-a``); Intros.
-Case (total_order_Rle x0 x1); Intro; [Apply (cond_pos x0) | Elim H9; Intros; Assumption].
-Case (total_order_Rle x0 ``b-a``); Intro; [Apply (cond_pos x0) | Apply Rlt_Rminus; Assumption].
-Split with (mkposreal ? H10); Intros; Case (case_Rabsolu h0); Intro.
-Assert H14 : ``b+h0<b``.
-Pattern 2 b; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Assert H13 : (Riemann_integrable f ``b+h0`` b).
-Apply continuity_implies_RiemannInt.
-Left; Assumption.
-Intros; Apply C0; Elim H13; Intros; Split; Try Assumption.
-Apply Rle_trans with ``b+h0``; Try Assumption.
-Apply Rle_anti_compatibility with ``-a-h0``.
-Replace ``-a-h0+a`` with ``-h0``; [Idtac | Ring].
-Replace ``-a-h0+(b+h0)`` with ``b-a``; [Idtac | Ring].
-Apply Rle_trans with del.
-Apply Rle_trans with (Rabsolu h0).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Left; Assumption.
-Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r.
-Replace ``[(primitive h (FTC_P1 h C0) (b+h0))]-[(primitive h (FTC_P1 h C0) b)]`` with ``-(RiemannInt H13)``.
-Replace (f b) with ``-[(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))]/h0``.
-Rewrite <- Rabsolu_Ropp; Unfold Rminus; Unfold Rdiv; Rewrite Ropp_mul1; Rewrite Ropp_distr1; Repeat Rewrite Ropp_Ropp; Replace ``(RiemannInt H13)*/h0+ -(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))*/h0`` with ``((RiemannInt H13)-(RiemannInt (RiemannInt_P14 (b+h0) b (f b))))/h0``.
-Replace ``(RiemannInt H13)-(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b)))).
-Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b+h0) b (f b)))))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b))))); Left; Assumption.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 (b+h0) b (eps/2)))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply RiemannInt_P19.
-Left; Assumption.
-Intros; Replace ``(f x2)+ -1*(fct_cte (f b) x2)`` with ``(f x2)-(f b)``.
-Unfold fct_cte; Case (Req_EM b x2); Intro.
-Rewrite H16; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H9; Intros; Left; Apply H18.
-Repeat Split.
-Assumption.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
-Apply Rlt_anti_compatibility with ``x2-x1``; Replace ``x2-x1+(b-x2)`` with ``b-x1``; [Idtac | Ring].
-Replace ``x2-x1+x1`` with x2; [Idtac | Ring].
-Apply Rlt_le_trans with ``b+h0``.
-2:Elim H15; Intros; Left; Assumption.
-Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_Ropp; Apply Rle_lt_trans with (Rabsolu h0).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); [Apply Rmin_r | Apply Rmin_l]].
-Apply Rle_sym1; Left; Apply Rlt_Rminus; Elim H15; Intros; Assumption.
-Unfold fct_cte; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rmult_assoc; Replace ``(b-(b+h0))*(Rabsolu (/h0))`` with R1.
-Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite Rabsolu_left.
-Apply r_Rmult_mult with h0; [Do 2 Rewrite (Rmult_sym h0); Rewrite Rmult_assoc; Rewrite Ropp_mul1; Rewrite <- Rinv_l_sym; [ Ring | Assumption ] | Assumption].
-Apply Rlt_Rinv2; Assumption.
-Rewrite (RiemannInt_P13 H13 (RiemannInt_P14 ``b+h0`` b (f b)) (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b)))); Ring.
-Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring.
-Rewrite RiemannInt_P15.
-Rewrite <- Ropp_mul1; Apply r_Rmult_mult with h0; [Repeat Rewrite (Rmult_sym h0); Unfold Rdiv; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | Assumption] | Assumption].
-Cut ``a<=b+h0``.
-Cut ``b+h0<=b``.
-Intros; Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; Try (Elim n; Right; Reflexivity) Orelse (Elim n; Left; Assumption).
-Rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); Ring.
-Elim n; Assumption.
-Left; Assumption.
-Apply Rle_anti_compatibility with ``-a-h0``.
-Replace ``-a-h0+a`` with ``-h0``; [Idtac | Ring].
-Replace ``-a-h0+(b+h0)`` with ``b-a``; [Idtac | Ring].
-Apply Rle_trans with del.
-Apply Rle_trans with (Rabsolu h0).
-Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
-Left; Assumption.
-Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r.
-Cut (primitive  h (FTC_P1 h C0) b)==(f_b b).
-Intro; Cut (primitive  h (FTC_P1 h C0) ``b+h0``)==(f_b ``b+h0``).
-Intro; Rewrite H13; Rewrite H14; Apply H6.
-Assumption.
-Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rmin_l].
-Assert H14 : ``b<b+h0``.
-Pattern 1 b; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Assert H14 := (Rle_sym2 ? ? r); Elim H14; Intro.
-Assumption.
-Elim H11; Symmetry; Assumption.
-Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H14)) | Unfold f_b; Reflexivity | Elim n; Left; Apply Rlt_trans with b; Assumption | Elim n0; Left; Apply Rlt_trans with b; Assumption].
-Unfold f_b; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Unfold primitive; Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; [Apply RiemannInt_P5 | Elim n; Right; Reflexivity | Elim n; Left; Assumption | Elim n; Right; Reflexivity].
-(*****)
-Pose f_a := [x:R]``(f a)*(x-a)``; Rewrite <- H2; Assert H3 : (derivable_pt_lim f_a a (f a)).
-Unfold f_a; Change (derivable_pt_lim (mult_fct (fct_cte (f a)) (minus_fct id (fct_cte a))) a (f a)); Pattern 2 (f a); Replace (f a) with ``0*((minus_fct id (fct_cte a)) a)+((fct_cte (f a)) a)*1``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_const.
-Replace R1 with ``1-0``; [Idtac | Ring].
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte; Ring.
-Unfold derivable_pt_lim; Intros; Elim (H3 ? H4); Intros.
-Assert H6 : (continuity_pt f a).
-Apply C0; Split; [Right; Reflexivity | Left; Assumption].
-Assert H7 : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Elim (H6 ? H7); Unfold D_x no_cond dist; Simpl; Unfold R_dist; Intros.
-Pose del := (Rmin x0 (Rmin x1 ``b-a``)).
-Assert H9 : ``0<del``.
-Unfold del; Unfold Rmin.
-Case (total_order_Rle x1 ``b-a``); Intros.
-Case (total_order_Rle x0 x1); Intro.
-Apply (cond_pos x0).
-Elim H8; Intros; Assumption.
-Case (total_order_Rle x0 ``b-a``); Intro.
-Apply (cond_pos x0).
-Apply Rlt_Rminus; Assumption.
-Split with (mkposreal ? H9).
-Intros; Case (case_Rabsolu h0); Intro.
-Assert H12 : ``a+h0<a``.
-Pattern 2 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Unfold primitive.
-Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Left; Assumption) Orelse (Elim n; Right; Reflexivity).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H12)).
-Elim n; Left; Apply Rlt_trans with a; Assumption.
-Rewrite RiemannInt_P9; Replace R0 with (f_a a).
-Replace ``(f a)*(a+h0-a)`` with (f_a ``a+h0``).
-Apply H5; Try Assumption.
-Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rmin_l].
-Unfold f_a; Ring.
-Unfold f_a; Ring.
-Elim n; Left; Apply Rlt_trans with a; Assumption.
-Assert H12 : ``a<a+h0``.
-Pattern 1 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Assert H12 := (Rle_sym2 ? ? r); Elim H12; Intro.
-Assumption.
-Elim H10; Symmetry; Assumption.
-Assert H13 : (Riemann_integrable f a ``a+h0``).
-Apply continuity_implies_RiemannInt.
-Left; Assumption.
-Intros; Apply C0; Elim H13; Intros; Split; Try Assumption.
-Apply Rle_trans with ``a+h0``; Try Assumption.
-Apply Rle_anti_compatibility with ``-b-h0``.
-Replace ``-b-h0+b`` with ``-h0``; [Idtac | Ring].
-Replace ``-b-h0+(a+h0)`` with ``a-b``; [Idtac | Ring].
-Apply Ropp_Rle; Rewrite Ropp_Ropp; Rewrite Ropp_distr2; Apply Rle_trans with del.
-Apply Rle_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Left; Assumption].
-Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r.
-Replace ``(primitive h (FTC_P1 h C0) (a+h0))-(primitive h (FTC_P1 h C0) a)`` with ``(RiemannInt H13)``.
-Replace (f a) with ``(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))/h0``.
-Replace ``(RiemannInt H13)/h0-(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))/h0`` with ``((RiemannInt H13)-(RiemannInt (RiemannInt_P14 a (a+h0) (f a))))/h0``.
-Replace ``(RiemannInt H13)-(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14  a ``a+h0`` (f a)))).
-Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a+h0) (f a)))))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a))))); Left; Assumption.
-Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 a (a+h0) (eps/2)))*(Rabsolu (/h0))``.
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
-Apply Rabsolu_pos.
-Apply RiemannInt_P19.
-Left; Assumption.
-Intros; Replace ``(f x2)+ -1*(fct_cte (f a) x2)`` with ``(f x2)-(f a)``.
-Unfold fct_cte; Case (Req_EM a x2); Intro.
-Rewrite H15; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
-Elim H8; Intros; Left; Apply H17; Repeat Split.
-Assumption.
-Rewrite Rabsolu_right.
-Apply Rlt_anti_compatibility with a; Replace ``a+(x2-a)`` with x2; [Idtac | Ring].
-Apply Rlt_le_trans with ``a+h0``.
-Elim H14; Intros; Assumption.
-Apply Rle_compatibility; Left; Apply Rle_lt_trans with (Rabsolu h0).
-Apply Rle_Rabsolu.
-Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); [Apply Rmin_r | Apply Rmin_l]].
-Apply Rle_sym1; Left; Apply Rlt_Rminus; Elim H14; Intros; Assumption.
-Unfold fct_cte; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rmult_assoc; Replace ``((a+h0)-a)*(Rabsolu (/h0))`` with R1.
-Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite Rabsolu_right.
-Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Rewrite <- Rinv_r_sym; [ Reflexivity | Assumption ].
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Assert H14 := (Rle_sym2 ? ? r); Elim H14; Intro.
-Assumption.
-Elim H10; Symmetry; Assumption.
-Rewrite (RiemannInt_P13 H13 (RiemannInt_P14 a ``a+h0`` (f a)) (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a)))); Ring.
-Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring.
-Rewrite RiemannInt_P15.
-Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Unfold Rdiv; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [ Ring | Assumption ].
-Cut ``a<=a+h0``.
-Cut ``a+h0<=b``.
-Intros; Unfold primitive; Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Right; Reflexivity) Orelse (Elim n; Left; Assumption).
-Rewrite RiemannInt_P9; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply RiemannInt_P5.
-Elim n; Assumption.
-Elim n; Assumption.
-2:Left; Assumption.
-Apply Rle_anti_compatibility with ``-a``; Replace ``-a+(a+h0)`` with h0; [Idtac | Ring].
-Rewrite Rplus_sym; Apply Rle_trans with del; [Apply Rle_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Left; Assumption] | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r].
-(*****)
-Assert H1 : x==a.
-Rewrite <- H0 in H; Elim H; Intros; Apply Rle_antisym; Assumption.
-Pose f_a := [x:R]``(f a)*(x-a)``.
-Assert H2 : (derivable_pt_lim f_a a (f a)).
-Unfold f_a; Change (derivable_pt_lim (mult_fct (fct_cte (f a)) (minus_fct id (fct_cte a))) a (f a)); Pattern 2 (f a); Replace (f a) with ``0*((minus_fct id (fct_cte a)) a)+((fct_cte (f a)) a)*1``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_const.
-Replace R1 with ``1-0``; [Idtac | Ring].
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte; Ring.
-Pose f_b := [x:R]``(f b)*(x-b)+(RiemannInt (FTC_P1 h C0 b h (FTC_P2 b)))``.
-Assert H3 : (derivable_pt_lim f_b b (f b)).
-Unfold f_b; Pattern 2 (f b); Replace (f b) with ``(f b)+0``.
-Change (derivable_pt_lim (plus_fct (mult_fct (fct_cte (f b)) (minus_fct id (fct_cte b))) (fct_cte (RiemannInt (FTC_P1 h C0 h (FTC_P2 b))))) b ``(f b)+0``). 
-Apply derivable_pt_lim_plus.
-Pattern 2 (f b); Replace (f b) with ``0*((minus_fct id (fct_cte b)) b)+((fct_cte (f b)) b)*1``.
-Apply derivable_pt_lim_mult.
-Apply derivable_pt_lim_const.
-Replace R1 with ``1-0``; [Idtac | Ring].
-Apply derivable_pt_lim_minus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Unfold fct_cte; Ring.
-Apply derivable_pt_lim_const.
-Ring.
-Unfold derivable_pt_lim; Intros; Elim (H2 ? H4); Intros; Elim (H3 ? H4); Intros; Pose del := (Rmin x0 x1).
-Assert H7 : ``0<del``.
-Unfold del; Unfold Rmin; Case (total_order_Rle x0 x1); Intro.
-Apply (cond_pos x0).
-Apply (cond_pos x1).
-Split with (mkposreal ? H7); Intros; Case (case_Rabsolu h0); Intro.
-Assert H10 : ``a+h0<a``.
-Pattern 2 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Rewrite H1; Unfold primitive; Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros;  Try (Elim n; Right; Assumption Orelse Reflexivity).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H10)).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r2 H10)).
-Rewrite RiemannInt_P9; Replace R0 with (f_a a).
-Replace ``(f a)*(a+h0-a)`` with (f_a ``a+h0``).
-Apply H5; Try Assumption.
-Apply Rlt_le_trans with del; Try Assumption.
-Unfold del; Apply Rmin_l.
-Unfold f_a; Ring.
-Unfold f_a; Ring.
-Elim n; Rewrite <- H0; Left; Assumption.
-Assert H10 : ``a<a+h0``.
-Pattern 1 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Assert H10 := (Rle_sym2 ? ? r); Elim H10; Intro.
-Assumption.
-Elim H8; Symmetry; Assumption.
-Rewrite H0 in H1; Rewrite H1; Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Case (total_order_Rle a b); Case (total_order_Rle b b); Intros;  Try (Elim n; Right; Assumption Orelse Reflexivity).
-Rewrite H0 in H10; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r2 H10)).
-Repeat Rewrite RiemannInt_P9.
-Replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b).
-Fold (f_b ``b+h0``).
-Apply H6; Try Assumption.
-Apply Rlt_le_trans with del; Try Assumption.
-Unfold del; Apply Rmin_r.
-Unfold f_b; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Apply RiemannInt_P5.
-Elim n; Rewrite <- H0; Left; Assumption.
-Elim n0; Rewrite <- H0; Left; Assumption.
-Qed.
-
-Lemma RiemannInt_P29 : (f:R->R;a,b;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) (antiderivative f (primitive h (FTC_P1 h C0)) a b).
-Intro f; Intros; Unfold antiderivative; Split; Try Assumption; Intros; Assert H0 := (RiemannInt_P28 h C0 H); Assert H1 : (derivable_pt (primitive h (FTC_P1 h C0)) x); [Unfold derivable_pt; Split with (f x); Apply H0 | Split with H1; Symmetry; Apply derive_pt_eq_0; Apply H0].
-Qed.
-
-Lemma RiemannInt_P30 : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (sigTT ? [g:R->R](antiderivative f g a b)).
-Intros; Split with (primitive H (FTC_P1 H H0)); Apply RiemannInt_P29.
-Qed.
-
-Record C1_fun : Type := mkC1 {
-c1 :> R->R;
-diff0 : (derivable c1);
-cont1 : (continuity (derive c1 diff0)) }.
-
-Lemma RiemannInt_P31 : (f:C1_fun;a,b:R) ``a<=b`` -> (antiderivative (derive f (diff0 f)) f a b).
-Intro f; Intros; Unfold antiderivative; Split; Try Assumption; Intros; Split with (diff0 f x); Reflexivity.
-Qed.
-
-Lemma RiemannInt_P32 : (f:C1_fun;a,b:R) (Riemann_integrable (derive f (diff0 f)) a b).
-Intro f; Intros; Case (total_order_Rle a b); Intro; [Apply continuity_implies_RiemannInt; Try Assumption; Intros; Apply (cont1 f) | Assert H : ``b<=a``; [Auto with real | Apply RiemannInt_P1; Apply continuity_implies_RiemannInt; Try Assumption; Intros; Apply (cont1 f)]].
-Qed.
-
-Lemma RiemannInt_P33 : (f:C1_fun;a,b:R;pr:(Riemann_integrable (derive f (diff0 f)) a b)) ``a<=b`` -> (RiemannInt pr)==``(f b)-(f a)``.
-Intro f; Intros; Assert H0 : (x:R)``a<=x<=b``->(continuity_pt (derive f (diff0 f)) x).
-Intros; Apply (cont1 f).
-Rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); Assert H1 := (RiemannInt_P29 H H0); Assert H2 := (RiemannInt_P31 f H); Elim (antiderivative_Ucte (derive f (diff0 f)) ? ? ? ? H1 H2); Intros C H3; Repeat Rewrite H3; [Ring | Split; [Right; Reflexivity | Assumption] | Split; [Assumption | Right; Reflexivity]].
-Qed.
-
-Lemma FTC_Riemann : (f:C1_fun;a,b:R;pr:(Riemann_integrable (derive f (diff0 f)) a b)) (RiemannInt pr)==``(f b)-(f a)``.
-Intro f; Intros; Case (total_order_Rle a b); Intro; [Apply RiemannInt_P33; Assumption | Assert H : ``b<=a``; [Auto with real | Assert H0 := (RiemannInt_P1 pr); Rewrite (RiemannInt_P8 pr H0); Rewrite (RiemannInt_P33 H0 H); Ring]].
-Qed.
diff --git a/theories7/Reals/RiemannInt_SF.v b/theories7/Reals/RiemannInt_SF.v
deleted file mode 100644
index 3e2cc457..00000000
--- a/theories7/Reals/RiemannInt_SF.v
+++ /dev/null
@@ -1,1400 +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: RiemannInt_SF.v,v 1.2.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis.
-Require Classical_Prop.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Implicit Arguments On.
-
-(**************************************************)
-(* Each bounded subset of N has a maximal element *)
-(**************************************************)
-
-Definition Nbound [I:nat->Prop] : Prop := (EX n:nat | (i:nat)(I i)->(le i n)).
-
-Lemma IZN_var:(z:Z)(`0<=z`)->{ n:nat | z=(INZ n)}.
-Intros; Apply inject_nat_complete_inf; Assumption.
-Qed.
-
-Lemma Nzorn : (I:nat->Prop) (EX n:nat | (I n)) -> (Nbound I) -> (sigTT ?  [n:nat](I n)/\(i:nat)(I i)->(le i n)).
-Intros I H H0; Pose E := [x:R](EX i:nat | (I i)/\(INR i)==x); Assert H1 : (bound E).
-Unfold Nbound in H0; Elim H0; Intros N H1; Unfold bound; Exists (INR N); Unfold is_upper_bound; Intros; Unfold E in H2; Elim H2; Intros; Elim H3; Intros; Rewrite <- H5; Apply le_INR; Apply H1; Assumption.
-Assert H2 : (EXT x:R | (E x)).
-Elim H; Intros; Exists (INR x); Unfold E; Exists x; Split; [Assumption | Reflexivity].
-Assert H3 := (complet E H1 H2); Elim H3; Intros; Unfold is_lub in p; Elim p; Clear p; Intros; Unfold is_upper_bound in H4 H5; Assert H6 : ``0<=x``.
-Elim H2; Intros; Unfold E in H6; Elim H6; Intros; Elim H7; Intros; Apply Rle_trans with x0; [Rewrite <- H9; Change ``(INR O)<=(INR x1)``; Apply le_INR; Apply le_O_n | Apply H4; Assumption].
-Assert H7 := (archimed x); Elim H7; Clear H7; Intros; Assert H9 : ``x<=(IZR (up x))-1``.
-Apply H5; Intros; Assert H10 := (H4 ? H9); Unfold E in H9; Elim H9; Intros; Elim H11; Intros; Rewrite <- H13; Apply Rle_anti_compatibility with R1; Replace ``1+((IZR (up x))-1)`` with (IZR (up x)); [Idtac | Ring]; Replace ``1+(INR x1)`` with (INR (S x1)); [Idtac | Rewrite S_INR; Ring].
-Assert H14 : `0<=(up x)`.
-Apply le_IZR; Apply Rle_trans with x; [Apply H6 | Left; Assumption].
-Assert H15 := (IZN ? H14); Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- INR_IZR_INZ; Apply le_INR; Apply lt_le_S; Apply INR_lt; Rewrite H13; Apply Rle_lt_trans with x; [Assumption | Rewrite INR_IZR_INZ; Rewrite <- H15; Assumption].
-Assert H10 : ``x==(IZR (up x))-1``.
-Apply Rle_antisym; [Assumption | Apply Rle_anti_compatibility with ``-x+1``; Replace `` -x+1+((IZR (up x))-1)`` with ``(IZR (up x))-x``; [Idtac | Ring]; Replace ``-x+1+x`` with R1; [Assumption | Ring]].
-Assert H11 : `0<=(up x)`.
-Apply le_IZR; Apply Rle_trans with x; [Apply H6 | Left; Assumption].
-Assert H12 := (IZN_var H11); Elim H12; Clear H12; Intros; Assert H13 : (E x).
-Elim (classic (E x)); Intro; Try Assumption.
-Cut ((y:R)(E y)->``y<=x-1``).
-Intro; Assert H14 := (H5 ? H13); Cut ``x-1<x``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H15)).
-Apply Rminus_lt; Replace ``x-1-x`` with ``-1``; [Idtac | Ring]; Rewrite <- Ropp_O; Apply Rlt_Ropp; Apply Rlt_R0_R1.
-Intros; Assert H14 := (H4 ? H13); Elim H14; Intro; Unfold E in H13; Elim H13; Intros; Elim H16; Intros; Apply Rle_anti_compatibility with R1.
-Replace ``1+(x-1)`` with x; [Idtac | Ring]; Rewrite <- H18; Replace ``1+(INR x1)`` with (INR (S x1)); [Idtac | Rewrite S_INR; Ring].
-Cut x==(INR (pred x0)).
-Intro; Rewrite H19; Apply le_INR; Apply lt_le_S; Apply INR_lt; Rewrite H18; Rewrite <- H19; Assumption.
-Rewrite H10; Rewrite p; Rewrite <- INR_IZR_INZ; Replace R1 with (INR (S O)); [Idtac | Reflexivity]; Rewrite <- minus_INR.
-Replace (minus x0 (S O)) with (pred x0); [Reflexivity | Case x0; [Reflexivity | Intro; Simpl; Apply minus_n_O]].
-Induction x0; [Rewrite p in H7; Rewrite <- INR_IZR_INZ in H7; Simpl in H7; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 H7)) | Apply le_n_S; Apply le_O_n].
-Rewrite H15 in H13; Elim H12; Assumption.
-Split with (pred x0); Unfold E in H13; Elim H13; Intros; Elim H12; Intros; Rewrite H10 in H15; Rewrite p in H15; Rewrite <- INR_IZR_INZ in H15; Assert H16 : ``(INR x0)==(INR x1)+1``.
-Rewrite H15; Ring.
-Rewrite <- S_INR in H16; Assert H17 := (INR_eq ? ? H16); Rewrite H17; Simpl; Split.
-Assumption.
-Intros; Apply INR_le; Rewrite H15; Rewrite <- H15; Elim H12; Intros; Rewrite H20; Apply H4; Unfold E; Exists i; Split; [Assumption | Reflexivity].
-Qed.
-
-(*******************************************)
-(*             Step functions              *)
-(*******************************************)
-
-Definition open_interval [a,b:R] : R->Prop := [x:R]``a<x<b``.
-Definition co_interval [a,b:R] : R->Prop := [x:R]``a<=x<b``. 
-
-Definition adapted_couple [f:R->R;a,b:R;l,lf:Rlist] : Prop := (ordered_Rlist l)/\``(pos_Rl l O)==(Rmin a b)``/\``(pos_Rl l (pred (Rlength l)))==(Rmax a b)``/\(Rlength l)=(S (Rlength lf))/\(i:nat)(lt i (pred (Rlength l)))->(constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) (pos_Rl lf i)).
-
-Definition adapted_couple_opt [f:R->R;a,b:R;l,lf:Rlist] := (adapted_couple f a b l lf)/\((i:nat)(lt i (pred (Rlength lf)))->(``(pos_Rl lf i)<>(pos_Rl lf (S i))``\/``(f (pos_Rl l (S i)))<>(pos_Rl lf i)``))/\((i:nat)(lt i (pred (Rlength l)))->``(pos_Rl l i)<>(pos_Rl l (S i))``).
-
-Definition is_subdivision [f:R->R;a,b:R;l:Rlist] : Type := (sigTT ? [l0:Rlist](adapted_couple f a b l l0)).
-
-Definition IsStepFun [f:R->R;a,b:R] : Type := (SigT ? [l:Rlist](is_subdivision f a b l)).
-
-(* Class of step functions *)
-Record StepFun [a,b:R] : Type := mkStepFun {
-  fe:> R->R;
-  pre:(IsStepFun fe a b)}.
-
-Definition subdivision [a,b:R;f:(StepFun a b)] : Rlist := (projT1 ? ? (pre f)).
-
-Definition subdivision_val [a,b:R;f:(StepFun a b)] : Rlist := Cases (projT2 ? ? (pre f)) of (existTT a b) => a end.
-
-Fixpoint Int_SF [l:Rlist] : Rlist -> R :=
-[k:Rlist] Cases l of
-| nil => R0
-| (cons a l') => Cases k of
-   | nil => R0
-   | (cons x nil) => R0
-   | (cons x (cons y k')) => ``a*(y-x)+(Int_SF l' (cons y k'))``
-  end
-end.
-
-(* Integral of step functions *)
-Definition RiemannInt_SF [a,b:R;f:(StepFun a b)] : R := 
-Cases (total_order_Rle a b) of
-  (leftT _) => (Int_SF (subdivision_val f) (subdivision f))
-| (rightT _) => ``-(Int_SF (subdivision_val f) (subdivision f))``
-end.
-
-(********************************)
-(* Properties of step functions *)
-(********************************)
-
-Lemma StepFun_P1 : (a,b:R;f:(StepFun a b)) (adapted_couple f a b (subdivision f) (subdivision_val f)).
-Intros a b f; Unfold subdivision_val; Case (projT2 Rlist ([l:Rlist](is_subdivision f a b l)) (pre f)); Intros; Apply a0.
-Qed.
-
-Lemma StepFun_P2 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> (adapted_couple f b a l lf).
-Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
-Rewrite H2; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Rewrite H1; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Qed.
-
-Lemma StepFun_P3 : (a,b,c:R) ``a<=b`` -> (adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil)).
-Intros; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H0; Inversion H0; [Simpl; Assumption | Elim (le_Sn_O ? H2)].
-Simpl; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Simpl; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold constant_D_eq open_interval; Intros; Simpl in H0; Inversion H0; [Reflexivity | Elim (le_Sn_O ? H3)].
-Qed.
-
-Lemma StepFun_P4 : (a,b,c:R) (IsStepFun (fct_cte c) a b).
-Intros; Unfold IsStepFun; Case (total_order_Rle a b); Intro.
-Apply Specif.existT with (cons a (cons b nil)); Unfold is_subdivision; Apply existTT with (cons c nil); Apply (StepFun_P3 c r).
-Apply Specif.existT with (cons b (cons a nil)); Unfold is_subdivision; Apply existTT with (cons c nil); Apply StepFun_P2; Apply StepFun_P3; Auto with real.
-Qed.
-
-Lemma StepFun_P5 : (a,b:R;f:R->R;l:Rlist) (is_subdivision f a b l) -> (is_subdivision f b a l).
-Unfold is_subdivision; Intros; Elim X; Intros; Exists x; Unfold adapted_couple in p; Decompose [and] p; Clear p; Unfold adapted_couple; Repeat Split; Try Assumption.
-Rewrite H1; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Rewrite H0; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Qed.
-
-Lemma StepFun_P6 : (f:R->R;a,b:R) (IsStepFun f a b) -> (IsStepFun f b a).
-Unfold IsStepFun; Intros; Elim X; Intros; Apply Specif.existT with x; Apply StepFun_P5; Assumption.
-Qed.
-
-Lemma StepFun_P7 : (a,b,r1,r2,r3:R;f:R->R;l,lf:Rlist) ``a<=b`` -> (adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf)) -> (adapted_couple f r2 b (cons r2 l) lf).
-Unfold adapted_couple; Intros; Decompose [and] H0; Clear H0; Assert H5 : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H7 : ``r2<=b``.
-Rewrite H5 in H2; Rewrite <- H2; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
-Repeat Split.
-Apply RList_P4 with r1; Assumption.
-Rewrite H5 in H2; Unfold Rmin; Case (total_order_Rle r2 b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmax; Case (total_order_Rle r2 b); Intro; [Rewrite H5 in H2; Rewrite <- H2; Reflexivity | Elim n; Assumption].
-Simpl in H4; Simpl; Apply INR_eq; Apply r_Rplus_plus with R1; Do 2 Rewrite (Rplus_sym R1); Do 2 Rewrite <- S_INR; Rewrite H4; Reflexivity.
-Intros; Unfold constant_D_eq open_interval; Intros; Unfold constant_D_eq open_interval in H6; Assert H9 : (lt (S i) (pred (Rlength (cons r1 (cons r2 l))))).
-Simpl; Simpl in H0; Apply lt_n_S; Assumption.
-Assert H10 := (H6 ? H9); Apply H10; Assumption.
-Qed.
-
-Lemma StepFun_P8 : (f:R->R;l1,lf1:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> a==b -> (Int_SF lf1 l1)==R0.
-Induction l1.
-Intros; Induction lf1; Reflexivity.
-Induction r0.
-Intros; Induction lf1.
-Reflexivity.
-Unfold adapted_couple in H0; Decompose [and] H0; Clear H0; Simpl in H5; Discriminate.
-Intros; Induction lf1.
-Reflexivity.
-Simpl; Cut r==r1.
-Intro; Rewrite H3; Rewrite (H0 lf1 r b).
-Ring.
-Rewrite H3; Apply StepFun_P7 with a r r3; [Right; Assumption | Assumption].
-Clear H H0 Hreclf1 r0; Unfold adapted_couple in H1; Decompose [and] H1; Intros; Simpl in H4; Rewrite H4; Unfold Rmin; Case (total_order_Rle a b); Intro; [Assumption | Reflexivity].
-Unfold adapted_couple in H1; Decompose [and] H1; Intros; Apply Rle_antisym.
-Apply (H3 O); Simpl; Apply lt_O_Sn.
-Simpl in H5; Rewrite H2 in H5; Rewrite H5; Replace (Rmin b b) with (Rmax a b); [Rewrite <- H4; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity] | Unfold Rmin Rmax; Case (total_order_Rle b b); Case (total_order_Rle a b); Intros; Try Assumption Orelse Reflexivity].
-Qed.
-
-Lemma StepFun_P9 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> ``a<>b`` -> (le (2) (Rlength l)).
-Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Induction l; [Simpl in H4; Discriminate | Induction l; [Simpl in H3; Simpl in H2; Generalize H3; Generalize H2; Unfold Rmin Rmax; Case (total_order_Rle a b); Intros; Elim H0; Rewrite <- H5; Rewrite <- H7; Reflexivity | Simpl; Do 2 Apply le_n_S; Apply le_O_n]].
-Qed.
-
-Lemma StepFun_P10 : (f:R->R;l,lf:Rlist;a,b:R) ``a<=b`` -> (adapted_couple f a b l lf) -> (EXT l':Rlist | (EXT lf':Rlist | (adapted_couple_opt f a b l' lf'))).
-Induction l.
-Intros; Unfold adapted_couple in H0; Decompose [and] H0; Simpl in H4; Discriminate.
-Intros; Case (Req_EM a b); Intro.
-Exists (cons a nil); Exists nil; Unfold adapted_couple_opt; Unfold adapted_couple; Unfold ordered_Rlist; Repeat Split; Try (Intros; Simpl in H3; Elim (lt_n_O ? H3)).
-Simpl; Rewrite <- H2; Unfold Rmin; Case (total_order_Rle a a); Intro; Reflexivity.
-Simpl; Rewrite <- H2; Unfold Rmax; Case (total_order_Rle a a); Intro; Reflexivity.
-Elim (RList_P20 ? (StepFun_P9 H1 H2)); Intros t1 [t2 [t3 H3]]; Induction lf.
-Unfold adapted_couple in H1; Decompose [and] H1; Rewrite H3 in H7; Simpl in H7; Discriminate.
-Clear Hreclf; Assert H4 : (adapted_couple f t2 b r0 lf).
-Rewrite H3 in H1; Assert H4 := (RList_P21 ? ? H3); Simpl in H4; Rewrite H4; EApply StepFun_P7; [Apply H0 | Apply H1].
-Cut ``t2<=b``.
-Intro; Assert H6 := (H ? ? ? H5 H4); Case (Req_EM t1 t2); Intro Hyp_eq.
-Replace a with t2.
-Apply H6.
-Rewrite <- Hyp_eq; Rewrite H3 in H1; Unfold adapted_couple in H1; Decompose [and] H1; Clear H1; Simpl in H9; Rewrite H9; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Elim H6; Clear H6; Intros l' [lf' H6]; Case (Req_EM t2 b); Intro.
-Exists (cons a (cons b nil)); Exists (cons r1 nil); Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H8; Inversion H8; [Simpl; Assumption | Elim (le_Sn_O ? H10)].
-Simpl; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Simpl; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Intros; Simpl in H8; Inversion H8.
-Unfold constant_D_eq open_interval; Intros; Simpl; Simpl in H9; Rewrite H3 in H1; Unfold adapted_couple in H1; Decompose [and] H1; Apply (H16 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl; Rewrite H7; Simpl in H13; Rewrite H13; Unfold Rmin; Case (total_order_Rle a b); Intro; [Assumption | Elim n; Assumption].
-Elim (le_Sn_O ? H10).
-Intros; Simpl in H8; Elim (lt_n_O ? H8).
-Intros; Simpl in H8; Inversion H8; [Simpl; Assumption | Elim (le_Sn_O ? H10)].
-Assert Hyp_min : (Rmin t2 b)==t2.
-Unfold Rmin; Case (total_order_Rle t2 b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold adapted_couple in H6; Elim H6; Clear H6; Intros; Elim (RList_P20 ? (StepFun_P9 H6 H7)); Intros s1 [s2 [s3 H9]]; Induction lf'.
-Unfold adapted_couple in H6; Decompose [and] H6; Rewrite H9 in H13; Simpl in H13; Discriminate.
-Clear Hreclf'; Case (Req_EM r1 r2); Intro.
-Case (Req_EM (f t2) r1); Intro.
-Exists (cons t1 (cons s2 s3)); Exists (cons r1 lf'); Rewrite H3 in H1; Rewrite H9 in H6; Unfold adapted_couple in H6 H1; Decompose [and] H1; Decompose [and] H6; Clear H1 H6; Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
-Simpl; Apply Rle_trans with s1.
-Replace s1 with t2.
-Apply (H12 O).
-Simpl; Apply lt_O_Sn.
-Simpl in H19; Rewrite H19; Symmetry; Apply Hyp_min.
-Apply (H16 O); Simpl; Apply lt_O_Sn.
-Change ``(pos_Rl (cons s2 s3) i)<=(pos_Rl (cons s2 s3) (S i))``; Apply (H16 (S i)); Simpl; Assumption.
-Simpl; Simpl in H14; Rewrite H14; Reflexivity.
-Simpl; Simpl in H18; Rewrite H18; Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle t2 b); Intros; Reflexivity Orelse Elim n; Assumption.
-Simpl; Simpl in H20; Apply H20.
-Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Simpl in H6; Case (total_order_T x t2); Intro.
-Elim s; Intro.
-Apply (H17 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Elim H6; Intros; Split; Assumption].
-Rewrite b0; Assumption.
-Rewrite H10; Apply (H22 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Replace s1 with t2; [Elim H6; Intros; Split; Assumption | Simpl in H19; Rewrite H19; Rewrite Hyp_min; Reflexivity]].
-Simpl; Simpl in H6; Apply (H22 (S i)); [Simpl; Assumption | Unfold open_interval; Simpl; Apply H6].
-Intros; Simpl in H1; Rewrite H10; Change ``(pos_Rl (cons r2 lf') i)<>(pos_Rl (cons r2 lf') (S i))``\/``(f (pos_Rl (cons s1 (cons s2 s3)) (S i)))<>(pos_Rl (cons r2 lf') i)``; Rewrite <- H9; Elim H8; Intros; Apply H6; Simpl; Apply H1.
-Intros; Induction i.
-Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
-Apply (H12 O); Simpl; Apply lt_O_Sn.
-Rewrite <- Hyp_min; Rewrite H6; Simpl in H19; Rewrite <- H19; Apply (H16 O); Simpl; Apply lt_O_Sn.
-Elim H8; Intros; Rewrite H9 in H21; Apply (H21 (S i)); Simpl; Simpl in H1; Apply H1.
-Exists (cons t1 l'); Exists (cons r1 (cons r2 lf')); Rewrite H9 in H6; Rewrite H3 in H1; Unfold adapted_couple in H1 H6; Decompose [and] H6; Decompose [and] H1; Clear H6 H1; Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
-Rewrite H9; Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
-Simpl; Replace s1 with t2.
-Apply (H16 O); Simpl; Apply lt_O_Sn.
-Simpl in H14; Rewrite H14; Rewrite Hyp_min; Reflexivity.
-Change ``(pos_Rl (cons s1 (cons s2 s3)) i)<=(pos_Rl (cons s1 (cons s2 s3)) (S i))``; Apply (H12 i); Simpl; Apply lt_S_n; Assumption.
-Simpl; Simpl in H19; Apply H19.
-Rewrite H9; Simpl; Simpl in H13; Rewrite H13; Unfold Rmax; Case (total_order_Rle t2 b); Case (total_order_Rle a b); Intros; Reflexivity Orelse Elim n; Assumption.
-Rewrite H9; Simpl; Simpl in H15; Rewrite H15; Reflexivity.
-Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Rewrite H9 in H6; Simpl in H6; Apply (H22 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl.
-Replace t2 with s1.
-Assumption.
-Simpl in H14; Rewrite H14; Rewrite Hyp_min; Reflexivity.
-Change (f x)==(pos_Rl (cons r2 lf') i); Clear Hreci; Apply (H17 i).
-Simpl; Rewrite H9 in H1; Simpl in H1; Apply lt_S_n; Apply H1.
-Rewrite H9 in H6; Unfold open_interval; Apply H6.
-Intros; Simpl in H1; Induction i.
-Simpl; Rewrite H9; Right; Simpl; Replace s1 with t2.
-Assumption.
-Simpl in H14; Rewrite H14; Rewrite Hyp_min; Reflexivity.
-Elim H8; Intros; Apply (H6 i).
-Simpl; Apply lt_S_n; Apply H1.
-Intros; Rewrite H9; Induction i.
-Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
-Apply (H16 O); Simpl; Apply lt_O_Sn.
-Rewrite <- Hyp_min; Rewrite H6; Simpl in H14; Rewrite <- H14; Right; Reflexivity.
-Elim H8; Intros; Rewrite <- H9; Apply (H21 i); Rewrite H9; Rewrite H9 in H1; Simpl; Simpl in H1; Apply lt_S_n; Apply H1.
-Exists (cons t1 l'); Exists (cons r1 (cons r2 lf')); Rewrite H9 in H6; Rewrite H3 in H1; Unfold adapted_couple in H1 H6; Decompose [and] H6; Decompose [and] H1; Clear H6 H1; Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
-Rewrite H9; Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
-Simpl; Replace s1 with t2.
-Apply (H15 O); Simpl; Apply lt_O_Sn.
-Simpl in H13; Rewrite H13; Rewrite Hyp_min; Reflexivity.
-Change ``(pos_Rl (cons s1 (cons s2 s3)) i)<=(pos_Rl (cons s1 (cons s2 s3)) (S i))``; Apply (H11 i); Simpl; Apply lt_S_n; Assumption.
-Simpl; Simpl in H18; Apply H18.
-Rewrite H9; Simpl; Simpl in H12; Rewrite H12; Unfold Rmax; Case (total_order_Rle t2 b); Case (total_order_Rle a b); Intros; Reflexivity Orelse Elim n; Assumption.
-Rewrite H9; Simpl; Simpl in H14; Rewrite H14; Reflexivity.
-Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Rewrite H9 in H6; Simpl in H6; Apply (H21 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl; Replace t2 with s1.
-Assumption.
-Simpl in H13; Rewrite H13; Rewrite Hyp_min; Reflexivity.
-Change (f x)==(pos_Rl (cons r2 lf') i); Clear Hreci; Apply (H16 i).
-Simpl; Rewrite H9 in H1; Simpl in H1; Apply lt_S_n; Apply H1.
-Rewrite H9 in H6; Unfold open_interval; Apply H6.
-Intros; Simpl in H1; Induction i.
-Simpl; Left; Assumption.
-Elim H8; Intros; Apply (H6 i).
-Simpl; Apply lt_S_n; Apply H1.
-Intros; Rewrite H9; Induction i.
-Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
-Apply (H15 O); Simpl; Apply lt_O_Sn.
-Rewrite <- Hyp_min; Rewrite H6; Simpl in H13; Rewrite <- H13; Right; Reflexivity.
-Elim H8; Intros; Rewrite <- H9; Apply (H20 i); Rewrite H9; Rewrite H9 in H1; Simpl; Simpl in H1; Apply lt_S_n; Apply H1.
-Rewrite H3 in H1; Clear H4; Unfold adapted_couple in H1; Decompose [and] H1; Clear H1; Clear H H7 H9; Cut (Rmax a b)==b; [Intro; Rewrite H in H5; Rewrite <- H5; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity] | Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]].
-Qed.
-
-Lemma StepFun_P11 : (a,b,r,r1,r3,s1,s2,r4:R;r2,lf1,s3,lf2:Rlist;f:R->R) ``a<b`` -> (adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1)) -> (adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2)) -> ``r1<=s2``.
-Intros; Unfold adapted_couple_opt in H1; Elim H1; Clear H1; Intros; Unfold adapted_couple in H0 H1; Decompose [and] H0; Decompose [and] H1; Clear H0 H1; Assert H12 : r==s1.
-Simpl in H10; Simpl in H5; Rewrite H10; Rewrite H5; Reflexivity.
-Assert H14 := (H3 O (lt_O_Sn ?)); Simpl in H14; Elim H14; Intro.
-Assert H15 := (H7 O (lt_O_Sn ?)); Simpl in H15; Elim H15; Intro.
-Rewrite <- H12 in H1; Case (total_order_Rle r1 s2); Intro; Try Assumption.
-Assert H16 : ``s2<r1``; Auto with real.
-Induction s3.
-Simpl in H9; Rewrite H9 in H16; Cut ``r1<=(Rmax a b)``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H17 H16)).
-Rewrite <- H4; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
-Clear Hrecs3; Induction lf2.
-Simpl in H11; Discriminate.
-Clear Hreclf2; Assert H17 : r3==r4.
-Pose x := ``(r+s2)/2``; Assert H17 := (H8 O (lt_O_Sn ?)); Assert H18 := (H13 O (lt_O_Sn ?)); Unfold constant_D_eq open_interval in H17 H18; Simpl in H17; Simpl in H18; Rewrite <- (H17 x).
-Rewrite <- (H18 x).
-Reflexivity.
-Rewrite <- H12; Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_trans with s2; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]] | Assumption].
-Assert H18 : (f s2)==r3.
-Apply (H8 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Split; Assumption].
-Assert H19 : r3 == r5.
-Assert H19 := (H7 (S O)); Simpl in H19; Assert H20 := (H19 (lt_n_S ? ? (lt_O_Sn ?))); Elim H20; Intro.
-Pose x := ``(s2+(Rmin r1 r0))/2``; Assert H22 := (H8 O); Assert H23 := (H13 (S O)); Simpl in H22; Simpl in H23; Rewrite <- (H22 (lt_O_Sn ?) x).
-Rewrite <- (H23 (lt_n_S ? ? (lt_O_Sn ?)) x).
-Reflexivity.
-Unfold open_interval; Simpl; Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Unfold Rmin; Case (total_order_Rle r1 r0); Intro; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_le_trans with ``r0+(Rmin r1 r0)``; [Do 2 Rewrite <- (Rplus_sym (Rmin r1 r0)); Apply Rlt_compatibility; Assumption | Apply Rle_compatibility; Apply Rmin_r] | DiscrR]].
-Unfold open_interval; Simpl; Unfold x; Split.
-Apply Rlt_trans with s2; [Assumption | Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Unfold Rmin; Case (total_order_Rle r1 r0); Intro; Assumption | DiscrR]]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_le_trans with ``r1+(Rmin r1 r0)``; [Do 2 Rewrite <- (Rplus_sym (Rmin r1 r0)); Apply Rlt_compatibility; Assumption | Apply Rle_compatibility; Apply Rmin_l] | DiscrR]].
-Elim H2; Clear H2; Intros; Assert H23 := (H22 (S O)); Simpl in H23; Assert H24 := (H23 (lt_n_S ? ? (lt_O_Sn ?))); Elim H24; Assumption.
-Elim H2; Intros; Assert H22 := (H20 O); Simpl in H22; Assert H23 := (H22 (lt_O_Sn ?)); Elim H23; Intro; [Elim H24; Rewrite <- H17; Rewrite <- H19; Reflexivity | Elim H24; Rewrite <- H17; Assumption].
-Elim H2; Clear H2; Intros; Assert H17 := (H16 O); Simpl in H17; Elim (H17 (lt_O_Sn ?)); Assumption.
-Rewrite <- H0; Rewrite H12; Apply (H7 O); Simpl; Apply lt_O_Sn.
-Qed.
-
-Lemma StepFun_P12 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple_opt f a b l lf) -> (adapted_couple_opt f b a l lf).
-Unfold adapted_couple_opt; Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
-Rewrite H0; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Rewrite H3; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
-Apply Rle_antisym; Assumption.
-Apply Rle_antisym; Auto with real.
-Qed.
-
-Lemma StepFun_P13 : (a,b,r,r1,r3,s1,s2,r4:R;r2,lf1,s3,lf2:Rlist;f:R->R) ``a<>b`` -> (adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1)) -> (adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2)) -> ``r1<=s2``.
-Intros; Case (total_order_T a b); Intro.
-Elim s; Intro.
-EApply StepFun_P11; [Apply a0 | Apply H0 | Apply H1].
-Elim H; Assumption.
-EApply StepFun_P11; [Apply r0 | Apply StepFun_P2; Apply H0 | Apply StepFun_P12; Apply H1].
-Qed.
-
-Lemma StepFun_P14 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) ``a<=b`` -> (adapted_couple f a b l1 lf1) -> (adapted_couple_opt f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
-Induction l1.
-Intros l2 lf1 lf2 a b Hyp H H0; Unfold adapted_couple in H; Decompose [and] H; Clear H H0 H2 H3 H1 H6; Simpl in H4; Discriminate.
-Induction r0.
-Intros; Case (Req_EM a b); Intro.
-Unfold adapted_couple_opt in H2; Elim H2; Intros; Rewrite (StepFun_P8 H4 H3); Rewrite (StepFun_P8 H1 H3); Reflexivity.
-Assert H4 := (StepFun_P9 H1 H3); Simpl in H4; Elim (le_Sn_O ? (le_S_n ? ? H4)).
-Intros; Clear H; Unfold adapted_couple_opt in H3; Elim H3; Clear H3; Intros; Case (Req_EM a b); Intro.
-Rewrite (StepFun_P8 H2 H4); Rewrite (StepFun_P8 H H4); Reflexivity.
-Assert Hyp_min : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert Hyp_max : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Elim (RList_P20 ? (StepFun_P9 H H4)); Intros s1 [s2 [s3 H5]]; Rewrite H5 in H; Rewrite H5; Induction lf1.
-Unfold adapted_couple in H2; Decompose [and] H2; Clear H H2 H4 H5 H3 H6 H8 H7 H11; Simpl in H9; Discriminate.
-Clear Hreclf1; Induction lf2.
-Unfold adapted_couple in H; Decompose [and] H; Clear H H2 H4 H5 H3 H6 H8 H7 H11; Simpl in H9; Discriminate.
-Clear Hreclf2; Assert H6 : r==s1.
-Unfold adapted_couple in H H2; Decompose [and] H; Decompose [and] H2; Clear H H2; Simpl in H13; Simpl in H8; Rewrite H13; Rewrite H8; Reflexivity.
-Assert H7 : r3==r4\/r==r1.
-Case (Req_EM r r1); Intro.
-Right; Assumption.
-Left; Cut ``r1<=s2``.
-Intro; Unfold adapted_couple in H2 H; Decompose [and] H; Decompose [and] H2; Clear H H2; Pose x := ``(r+r1)/2``; Assert H18 := (H14 O); Assert H20 := (H19 O); Unfold constant_D_eq open_interval in H18 H20; Simpl in H18; Simpl in H20; Rewrite <- (H18 (lt_O_Sn ?) x).
-Rewrite <- (H20 (lt_O_Sn ?) x).
-Reflexivity.
-Assert H21 := (H13 O (lt_O_Sn ?)); Simpl in H21; Elim H21; Intro; [Idtac | Elim H7; Assumption]; Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite <- (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
-Rewrite <- H6; Assert H21 := (H13 O (lt_O_Sn ?)); Simpl in H21; Elim H21; Intro; [Idtac | Elim H7; Assumption]; Unfold x; Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
-Apply Rlt_le_trans with r1; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite <- (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]] | Assumption].
-EApply StepFun_P13.
-Apply H4.
-Apply H2.
-Unfold adapted_couple_opt; Split.
-Apply H.
-Rewrite H5 in H3; Apply H3.
-Assert H8 : ``r1<=s2``.
-EApply StepFun_P13.
-Apply H4.
-Apply H2.
-Unfold adapted_couple_opt; Split.
-Apply H.
-Rewrite H5 in H3; Apply H3.
-Elim H7; Intro.
-Simpl; Elim H8; Intro.
-Replace ``r4*(s2-s1)`` with ``r3*(r1-r)+r3*(s2-r1)``; [Idtac | Rewrite H9; Rewrite H6; Ring].
-Rewrite Rplus_assoc; Apply Rplus_plus_r; Change (Int_SF lf1 (cons r1 r2))==(Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))); Apply H0 with r1 b.
-Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Replace b with (Rmax a b).
-Rewrite <- H12; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
-EApply StepFun_P7.
-Apply H1.
-Apply H2.
-Unfold adapted_couple_opt; Split.
-Apply StepFun_P7 with a a r3.
-Apply H1.
-Unfold adapted_couple in H2 H; Decompose [and] H2; Decompose [and] H; Clear H H2; Assert H20 : r==a.
-Simpl in H13; Rewrite H13; Apply Hyp_min.
-Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
-Simpl; Rewrite <- H20; Apply (H11 O).
-Simpl; Apply lt_O_Sn.
-Induction i.
-Simpl; Assumption.
-Change ``(pos_Rl (cons s2 s3) i)<=(pos_Rl (cons s2 s3) (S i))``; Apply (H15 (S i)); Simpl; Apply lt_S_n; Assumption.
-Simpl; Symmetry; Apply Hyp_min.
-Rewrite <- H17; Reflexivity.
-Simpl in H19; Simpl; Rewrite H19; Reflexivity.
-Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Apply (H16 O).
-Simpl; Apply lt_O_Sn.
-Simpl in H2; Rewrite <- H20 in H2; Unfold open_interval; Simpl; Apply H2.
-Clear Hreci; Induction i.
-Simpl; Simpl in H2; Rewrite H9; Apply (H21 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl; Elim H2; Intros; Split.
-Apply Rle_lt_trans with r1; Try Assumption; Rewrite <- H6; Apply (H11 O); Simpl; Apply lt_O_Sn.
-Assumption.
-Clear Hreci; Simpl; Apply (H21 (S i)).
-Simpl; Apply lt_S_n; Assumption.
-Unfold open_interval; Apply H2.
-Elim H3; Clear H3; Intros; Split.
-Rewrite H9; Change (i:nat) (lt i (pred (Rlength (cons r4 lf2)))) ->``(pos_Rl (cons r4 lf2) i)<>(pos_Rl (cons r4 lf2) (S i))``\/``(f (pos_Rl (cons s1 (cons s2 s3)) (S i)))<>(pos_Rl (cons r4 lf2) i)``; Rewrite <- H5; Apply H3.
-Rewrite H5 in H11; Intros; Simpl in H12; Induction i.
-Simpl; Red; Intro; Rewrite H13 in H10; Elim (Rlt_antirefl ? H10).
-Clear Hreci; Apply (H11 (S i)); Simpl; Apply H12.
-Rewrite H9; Rewrite H10; Rewrite H6; Apply Rplus_plus_r; Rewrite <- H10; Apply H0 with r1 b.
-Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Replace b with (Rmax a b).
-Rewrite <- H12; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
-EApply StepFun_P7.
-Apply H1.
-Apply H2.
-Unfold adapted_couple_opt; Split.
-Apply StepFun_P7 with a a r3.
-Apply H1.
-Unfold adapted_couple in H2 H; Decompose [and] H2; Decompose [and] H; Clear H H2; Assert H20 : r==a.
-Simpl in H13; Rewrite H13; Apply Hyp_min.
-Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
-Simpl; Rewrite <- H20; Apply (H11 O); Simpl; Apply lt_O_Sn.
-Rewrite H10; Apply (H15 (S i)); Simpl; Assumption.
-Simpl; Symmetry; Apply Hyp_min.
-Rewrite <- H17; Rewrite H10; Reflexivity.
-Simpl in H19; Simpl; Apply H19.
-Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Apply (H16 O).
-Simpl; Apply lt_O_Sn.
-Simpl in H2; Rewrite <- H20 in H2; Unfold open_interval; Simpl; Apply H2.
-Clear Hreci; Simpl; Apply (H21 (S i)).
-Simpl; Assumption.
-Rewrite <- H10; Unfold open_interval; Apply H2.
-Elim H3; Clear H3; Intros; Split.
-Rewrite H5 in H3; Intros; Apply (H3 (S i)).
-Simpl; Replace (Rlength lf2) with (S (pred (Rlength lf2))).
-Apply lt_n_S; Apply H12.
-Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H12; Elim (lt_n_O ? H12).
-Intros; Simpl in H12; Rewrite H10; Rewrite H5 in H11; Apply (H11 (S i)); Simpl; Apply lt_n_S; Apply H12.
-Simpl; Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Change (Int_SF lf1 (cons r1 r2))==(Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))); EApply H0.
-Apply H1.
-2: Rewrite H5 in H3; Unfold adapted_couple_opt; Split; Assumption.
-Assert H10 : r==a.
-Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Simpl in H12; Rewrite H12; Apply Hyp_min.
-Rewrite <- H9; Rewrite H10; Apply StepFun_P7 with a r r3; [Apply H1 | Pattern 2 a; Rewrite <- H10; Pattern 2 r; Rewrite H9; Apply H2].
-Qed.
-
-Lemma StepFun_P15 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> (adapted_couple_opt f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
-Intros; Case (total_order_Rle a b); Intro; [Apply (StepFun_P14 r H H0) | Assert H1 : ``b<=a``; [Auto with real | EApply StepFun_P14; [Apply H1 | Apply StepFun_P2; Apply H | Apply StepFun_P12; Apply H0]]].
-Qed.
-
-Lemma StepFun_P16 : (f:R->R;l,lf:Rlist;a,b:R) (adapted_couple f a b l lf) -> (EXT l':Rlist | (EXT lf':Rlist | (adapted_couple_opt f a b l' lf'))). 
-Intros; Case (total_order_Rle a b); Intro; [Apply (StepFun_P10 r H) | Assert H1 : ``b<=a``; [Auto with real | Assert H2 := (StepFun_P10 H1 (StepFun_P2 H)); Elim H2; Intros l' [lf' H3]; Exists l'; Exists lf'; Apply StepFun_P12; Assumption]].
-Qed.
-
-Lemma StepFun_P17 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> (adapted_couple f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
-Intros; Elim (StepFun_P16 H); Intros l' [lf' H1]; Rewrite (StepFun_P15 H H1); Rewrite (StepFun_P15 H0 H1); Reflexivity.
-Qed.
-
-Lemma StepFun_P18 : (a,b,c:R) (RiemannInt_SF (mkStepFun (StepFun_P4 a b c)))==``c*(b-a)``.
-Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with (Int_SF (cons c nil) (cons a (cons b nil))); [Simpl; Ring | Apply StepFun_P17 with (fct_cte c) a b; [Apply StepFun_P3; Assumption | Apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c)))]].
-Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with (Int_SF (cons c nil) (cons b (cons a nil))); [Simpl; Ring | Apply StepFun_P17 with (fct_cte c) a b; [Apply StepFun_P2; Apply StepFun_P3; Auto with real | Apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c)))]].
-Qed.
-
-Lemma StepFun_P19 : (l1:Rlist;f,g:R->R;l:R) (Int_SF (FF l1 [x:R]``(f x)+l*(g x)``) l1)==``(Int_SF (FF l1 f) l1)+l*(Int_SF (FF l1 g) l1)``.
-Intros; Induction l1; [Simpl; Ring | Induction l1; Simpl; [Ring | Simpl in Hrecl1; Rewrite Hrecl1; Ring]].
-Qed.
-
-Lemma StepFun_P20 : (l:Rlist;f:R->R) (lt O (Rlength l)) -> (Rlength l)=(S (Rlength (FF l f))).
-Intros l f H; NewInduction l; [Elim (lt_n_n ? H) | Simpl; Rewrite RList_P18; Rewrite RList_P14; Reflexivity].
-Qed.
-
-Lemma StepFun_P21 : (a,b:R;f:R->R;l:Rlist) (is_subdivision f a b l) -> (adapted_couple f a b l (FF l f)).
-Intros; Unfold adapted_couple; Unfold is_subdivision in X; Unfold adapted_couple in X; Elim X; Clear X; Intros; Decompose [and] p; Clear p; Repeat Split; Try Assumption.
-Apply StepFun_P20; Rewrite H2; Apply lt_O_Sn.
-Intros; Assert H5 := (H4 ? H3); Unfold constant_D_eq open_interval in H5; Unfold constant_D_eq open_interval; Intros; Induction l.
-Discriminate.
-Unfold FF; Rewrite RList_P12.
-Simpl; Change (f x0)==(f (pos_Rl (mid_Rlist (cons r l) r) (S i))); Rewrite RList_P13; Try Assumption; Rewrite (H5 x0 H6); Rewrite H5.
-Reflexivity.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Elim H6; Intros; Apply Rlt_trans with x0; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons r l) i)); Apply Rlt_compatibility; Elim H6; Intros; Apply Rlt_trans with x0; Assumption | DiscrR]].
-Rewrite RList_P14; Simpl in H3; Apply H3.
-Qed.
-
-Lemma StepFun_P22 : (a,b:R;f,g:R->R;lf,lg:Rlist) ``a<=b`` -> (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision f a b (cons_ORlist lf lg)).
-Unfold is_subdivision; Intros a b f g lf lg Hyp X X0; Elim X; Elim X0; Clear X X0; Intros lg0 p lf0 p0; Assert Hyp_min : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert Hyp_max : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Apply existTT with (FF (cons_ORlist lf lg) f); Unfold adapted_couple in p p0; Decompose [and] p; Decompose [and] p0; Clear p p0; Rewrite Hyp_min in H6; Rewrite Hyp_min in H1; Rewrite Hyp_max in H0; Rewrite Hyp_max in H5; Unfold adapted_couple; Repeat Split.
-Apply RList_P2; Assumption.
-Rewrite Hyp_min; Symmetry; Apply Rle_antisym.
-Induction lf.
-Simpl; Right; Symmetry; Assumption.
-Assert H10 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (0)) (cons_ORlist (cons r lf) lg)).
-Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros _ H10; Apply H10; Exists O; Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_O_Sn].
-Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H12 _; Assert H13 := (H12 H10); Elim H13; Intro.
-Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H6; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
-Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H1; Elim (RList_P6 lg); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
-Induction lf.
-Simpl; Right; Assumption.
-Assert H8 : (In a (cons_ORlist (cons r lf) lg)).
-Elim (RList_P9 (cons r lf) lg a); Intros; Apply H10; Left; Elim (RList_P3 (cons r lf) a); Intros; Apply H12; Exists O; Split; [Symmetry; Assumption | Simpl; Apply lt_O_Sn].
-Apply RList_P5; [Apply RList_P2; Assumption | Assumption].
-Rewrite Hyp_max; Apply Rle_antisym.
-Induction lf.
-Simpl; Right; Assumption.
-Assert H8 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)).
-Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros _ H10; Apply H10; Exists (pred (Rlength (cons_ORlist (cons r lf) lg))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn].
-Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H10 _.
-Assert H11 := (H10 H8); Elim H11; Intro.
-Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H5; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Simpl; Simpl in H14; Apply lt_n_Sm_le; Assumption | Simpl; Apply lt_n_Sn].
-Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros.
-Rewrite H15; Assert H17 : (Rlength lg)=(S (pred (Rlength lg))).
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H17 in H16; Elim (lt_n_O ? H16).
-Rewrite <- H0; Elim (RList_P6 lg); Intros; Apply H18; [Assumption | Rewrite H17 in H16; Apply lt_n_Sm_le; Assumption | Apply lt_pred_n_n; Rewrite H17; Apply lt_O_Sn].
-Induction lf.
-Simpl; Right; Symmetry; Assumption.
-Assert H8 : (In b (cons_ORlist (cons r lf) lg)).
-Elim (RList_P9 (cons r lf) lg b); Intros; Apply H10; Left; Elim (RList_P3 (cons r lf) b); Intros; Apply H12; Exists (pred (Rlength (cons r lf))); Split; [Symmetry; Assumption | Simpl; Apply lt_n_Sn].
-Apply RList_P7; [Apply RList_P2; Assumption | Assumption].
-Apply StepFun_P20; Rewrite RList_P11; Rewrite H2; Rewrite H7; Simpl; Apply lt_O_Sn.
-Intros; Unfold constant_D_eq open_interval; Intros; Cut (EXT l:R | (constant_D_eq f (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l)).
-Intros; Elim H11; Clear H11; Intros; Assert H12 := H11; Assert Hyp_cons : (EXT r:R | (EXT r0:Rlist | (cons_ORlist lf lg)==(cons r r0))).
-Apply RList_P19; Red; Intro; Rewrite H13 in H8; Elim (lt_n_O ? H8).
-Elim Hyp_cons; Clear Hyp_cons; Intros r [r0 Hyp_cons]; Rewrite Hyp_cons; Unfold FF; Rewrite RList_P12.
-Change (f x)==(f (pos_Rl (mid_Rlist (cons r r0) r) (S i))); Rewrite <- Hyp_cons; Rewrite RList_P13.
-Assert H13 := (RList_P2 ? ? H ? H8); Elim H13; Intro.
-Unfold constant_D_eq open_interval in H11 H12; Rewrite (H11 x H10); Assert H15 : ``(pos_Rl (cons_ORlist lf lg) i)<((pos_Rl (cons_ORlist lf lg) i)+(pos_Rl (cons_ORlist lf lg) (S i)))/2<(pos_Rl (cons_ORlist lf lg) (S i))``.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons_ORlist lf lg) i)); Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite (H11 ? H15); Reflexivity.
-Elim H10; Intros; Rewrite H14 in H15; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H16 H15)).
-Apply H8.
-Rewrite RList_P14; Rewrite Hyp_cons in H8; Simpl in H8; Apply H8.
-Assert H11 : ``a<b``.
-Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i).
-Rewrite <- H6; Rewrite <- (RList_P15 lf lg).
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
-Apply RList_P2; Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8)].
-Assumption.
-Assumption.
-Rewrite H1; Assumption.
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
-Elim H10; Intros; Apply Rlt_trans with x; Assumption.
-Rewrite <- H5; Rewrite <- (RList_P16 lf lg); Try Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
-Apply RList_P2; Assumption.
-Apply lt_n_Sm_le; Apply lt_n_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8).
-Rewrite H0; Assumption.
-Pose I := [j:nat]``(pos_Rl lf j)<=(pos_Rl (cons_ORlist lf lg) i)``/\(lt j (Rlength lf)); Assert H12 : (Nbound I).
-Unfold Nbound; Exists (Rlength lf); Intros; Unfold I in H12; Elim H12; Intros; Apply lt_le_weak; Assumption.
-Assert H13 : (EX n:nat | (I n)).
-Exists O; Unfold I; Split.
-Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) O).
-Right; Symmetry.
-Apply RList_P15; Try Assumption; Rewrite H1; Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H13.
-Apply RList_P2; Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))).
-Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H15 in H8; Elim (lt_n_O ? H8).
-Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H5; Rewrite <- H6 in H11; Rewrite <- H5 in H11; Elim (Rlt_antirefl ? H11).
-Assert H14 := (Nzorn H13 H12); Elim H14; Clear H14; Intros x0 H14; Exists (pos_Rl lf0 x0); Unfold constant_D_eq open_interval; Intros; Assert H16 := (H9 x0); Assert H17 : (lt x0 (pred (Rlength lf))).
-Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Apply lt_S_n; Replace (S (pred (Rlength lf))) with (Rlength lf).
-Inversion H18.
-2:Apply lt_n_S; Assumption.
-Cut x0=(pred (Rlength lf)).
-Intro; Rewrite H19 in H14; Rewrite H5 in H14; Cut ``(pos_Rl (cons_ORlist lf lg) i)<b``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H21)).
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
-Elim H10; Intros; Apply Rlt_trans with x; Assumption.
-Rewrite <- H5; Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))).
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H21.
-Apply RList_P2; Assumption.
-Apply lt_n_Sm_le; Apply lt_n_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H23 in H8; Elim (lt_n_O ? H8).
-Right; Apply RList_P16; Try Assumption; Rewrite H0; Assumption.
-Rewrite <- H20; Reflexivity.
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H19 in H18; Elim (lt_n_O ? H18).
-Assert H18 := (H16 H17); Unfold constant_D_eq open_interval in H18; Rewrite (H18 x1).
-Reflexivity.
-Elim H15; Clear H15; Intros; Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Split.
-Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); Assumption.
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); Try Assumption.
-Assert H22 : (lt (S x0) (Rlength lf)).
-Replace (Rlength lf) with (S (pred (Rlength lf))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H21; Elim (lt_n_O ? H21)].
-Elim (total_order_Rle (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); Intro.
-Assert H23 : (le (S x0) x0).
-Apply H20; Unfold I; Split; Assumption.
-Elim (le_Sn_n ? H23).
-Assert H23 : ``(pos_Rl (cons_ORlist lf lg) i)<(pos_Rl lf (S x0))``.
-Auto with real.
-Clear b0; Apply RList_P17; Try Assumption.
-Apply RList_P2; Assumption.
-Elim (RList_P9 lf lg (pos_Rl lf (S x0))); Intros; Apply H25; Left; Elim (RList_P3 lf (pos_Rl lf (S x0))); Intros; Apply H27; Exists (S x0); Split; [Reflexivity | Apply H22].
-Qed.
-
-Lemma StepFun_P23 : (a,b:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision f a b (cons_ORlist lf lg)).
-Intros; Case (total_order_Rle a b); Intro; [Apply StepFun_P22 with g; Assumption | Apply StepFun_P5; Apply StepFun_P22 with g; [Auto with real | Apply StepFun_P5; Assumption | Apply StepFun_P5; Assumption]].
-Qed.
-
-Lemma StepFun_P24 : (a,b:R;f,g:R->R;lf,lg:Rlist) ``a<=b`` -> (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision g a b (cons_ORlist lf lg)).
-Unfold is_subdivision; Intros a b f g lf lg Hyp X X0; Elim X; Elim X0; Clear X X0; Intros lg0 p lf0 p0; Assert Hyp_min : (Rmin a b)==a.
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert Hyp_max : (Rmax a b)==b.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Apply existTT with (FF (cons_ORlist lf lg) g); Unfold adapted_couple in p p0; Decompose [and] p; Decompose [and] p0; Clear p p0; Rewrite Hyp_min in H1; Rewrite Hyp_min in H6; Rewrite Hyp_max in H0; Rewrite Hyp_max in H5; Unfold adapted_couple; Repeat Split.
-Apply RList_P2; Assumption.
-Rewrite Hyp_min; Symmetry; Apply Rle_antisym.
-Induction lf.
-Simpl; Right; Symmetry; Assumption.
-Assert H10 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (0)) (cons_ORlist (cons r lf) lg)).
-Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros _ H10; Apply H10; Exists O; Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_O_Sn].
-Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H12 _; Assert H13 := (H12 H10); Elim H13; Intro.
-Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H6; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
-Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H1; Elim (RList_P6 lg); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
-Induction lf.
-Simpl; Right; Assumption.
-Assert H8 : (In a (cons_ORlist (cons r lf) lg)).
-Elim (RList_P9 (cons r lf) lg a); Intros; Apply H10; Left; Elim (RList_P3 (cons r lf) a); Intros; Apply H12; Exists O; Split; [Symmetry; Assumption | Simpl; Apply lt_O_Sn].
-Apply RList_P5; [Apply RList_P2; Assumption | Assumption].
-Rewrite Hyp_max; Apply Rle_antisym.
-Induction lf.
-Simpl; Right; Assumption.
-Assert H8 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)).
-Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros _ H10; Apply H10; Exists (pred (Rlength (cons_ORlist (cons r lf) lg))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn].
-Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H10 _; Assert H11 := (H10 H8); Elim H11; Intro.
-Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H5; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Simpl; Simpl in H14; Apply lt_n_Sm_le; Assumption | Simpl; Apply lt_n_Sn].
-Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Assert H17 : (Rlength lg)=(S (pred (Rlength lg))).
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H17 in H16; Elim (lt_n_O ? H16).
-Rewrite <- H0; Elim (RList_P6 lg); Intros; Apply H18; [Assumption | Rewrite H17 in H16; Apply lt_n_Sm_le; Assumption | Apply lt_pred_n_n; Rewrite H17; Apply lt_O_Sn].
-Induction lf.
-Simpl; Right; Symmetry; Assumption.
-Assert H8 : (In b (cons_ORlist (cons r lf) lg)).
-Elim (RList_P9 (cons r lf) lg b); Intros; Apply H10; Left; Elim (RList_P3 (cons r lf) b); Intros; Apply H12; Exists (pred (Rlength (cons r lf))); Split; [Symmetry; Assumption | Simpl; Apply lt_n_Sn].
-Apply RList_P7; [Apply RList_P2; Assumption | Assumption].
-Apply StepFun_P20; Rewrite RList_P11; Rewrite H7; Rewrite H2; Simpl; Apply lt_O_Sn.
-Unfold constant_D_eq open_interval; Intros; Cut (EXT l:R | (constant_D_eq g (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l)).
-Intros; Elim H11; Clear H11; Intros;  Assert H12 := H11; Assert Hyp_cons : (EXT r:R | (EXT r0:Rlist | (cons_ORlist lf lg)==(cons r r0))).
-Apply RList_P19; Red; Intro; Rewrite H13 in H8; Elim (lt_n_O ? H8).
-Elim Hyp_cons; Clear Hyp_cons; Intros r [r0 Hyp_cons]; Rewrite Hyp_cons; Unfold FF; Rewrite RList_P12.
-Change (g x)==(g (pos_Rl (mid_Rlist (cons r r0) r) (S i))); Rewrite <- Hyp_cons; Rewrite RList_P13.
-Assert H13 := (RList_P2 ? ? H ? H8); Elim H13; Intro.
-Unfold constant_D_eq open_interval in H11 H12; Rewrite (H11 x H10); Assert H15 : ``(pos_Rl (cons_ORlist lf lg) i)<((pos_Rl (cons_ORlist lf lg) i)+(pos_Rl (cons_ORlist lf lg) (S i)))/2<(pos_Rl (cons_ORlist lf lg) (S i))``.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons_ORlist lf lg) i)); Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite (H11 ? H15); Reflexivity.
-Elim H10; Intros; Rewrite H14 in H15; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H16 H15)).
-Apply H8.
-Rewrite RList_P14; Rewrite Hyp_cons in H8; Simpl in H8; Apply H8.
-Assert H11 : ``a<b``.
-Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i).
-Rewrite <- H6; Rewrite <- (RList_P15 lf lg); Try Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
-Apply RList_P2; Assumption.
-Apply le_O_n.
-Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8)].
-Rewrite H1; Assumption.
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
-Elim H10; Intros; Apply Rlt_trans with x; Assumption.
-Rewrite <- H5; Rewrite <- (RList_P16 lf lg); Try Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
-Apply RList_P2; Assumption.
-Apply lt_n_Sm_le; Apply lt_n_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8).
-Rewrite H0; Assumption.
-Pose I := [j:nat]``(pos_Rl lg j)<=(pos_Rl (cons_ORlist lf lg) i)``/\(lt j (Rlength lg)); Assert H12 : (Nbound I).
-Unfold Nbound; Exists (Rlength lg); Intros; Unfold I in H12; Elim H12; Intros; Apply lt_le_weak; Assumption.
-Assert H13 : (EX n:nat | (I n)).
-Exists O; Unfold I; Split.
-Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) O).
-Right; Symmetry; Rewrite H1; Rewrite <- H6; Apply RList_P15; Try Assumption; Rewrite H1; Assumption.
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H13; [Apply RList_P2; Assumption | Apply le_O_n | Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H15 in H8; Elim (lt_n_O ? H8)]].
-Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H0; Rewrite <- H1 in H11; Rewrite <- H0 in H11; Elim (Rlt_antirefl ? H11).
-Assert H14 := (Nzorn H13 H12); Elim H14; Clear H14; Intros x0 H14; Exists (pos_Rl lg0 x0); Unfold constant_D_eq open_interval; Intros; Assert H16 := (H4 x0); Assert H17 : (lt x0 (pred (Rlength lg))).
-Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Apply lt_S_n; Replace (S (pred (Rlength lg))) with (Rlength lg).
-Inversion H18.
-2:Apply lt_n_S; Assumption.
-Cut x0=(pred (Rlength lg)).
-Intro; Rewrite H19 in H14; Rewrite H0 in H14; Cut ``(pos_Rl (cons_ORlist lf lg) i)<b``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H21)).
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
-Elim H10; Intros; Apply Rlt_trans with x; Assumption.
-Rewrite <- H0; Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))).
-Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H21.
-Apply RList_P2; Assumption.
-Apply lt_n_Sm_le; Apply lt_n_S; Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H23 in H8; Elim (lt_n_O ? H8).
-Right; Rewrite H0; Rewrite <- H5; Apply RList_P16; Try Assumption.
-Rewrite H0; Assumption.
-Rewrite <- H20; Reflexivity.
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H19 in H18; Elim (lt_n_O ? H18).
-Assert H18 := (H16 H17); Unfold constant_D_eq open_interval in H18; Rewrite (H18 x1).
-Reflexivity.
-Elim H15; Clear H15; Intros; Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Split.
-Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); Assumption.
-Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); Try Assumption.
-Assert H22 : (lt (S x0) (Rlength lg)).
-Replace (Rlength lg) with (S (pred (Rlength lg))).
-Apply lt_n_S; Assumption.
-Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H21; Elim (lt_n_O ? H21).
-Elim (total_order_Rle (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); Intro.
-Assert H23 : (le (S x0) x0); [Apply H20; Unfold I; Split; Assumption | Elim (le_Sn_n ? H23)].
-Assert H23 : ``(pos_Rl (cons_ORlist lf lg) i)<(pos_Rl lg (S x0))``.
-Auto with real.
-Clear b0; Apply RList_P17; Try Assumption; [Apply RList_P2; Assumption | Elim (RList_P9 lf lg (pos_Rl lg (S x0))); Intros; Apply H25; Right; Elim (RList_P3 lg (pos_Rl lg (S x0))); Intros; Apply H27; Exists (S x0); Split; [Reflexivity | Apply H22]].
-Qed.
-
-Lemma StepFun_P25 : (a,b:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision g a b (cons_ORlist lf lg)).
-Intros a b f g lf lg H H0; Case (total_order_Rle a b); Intro; [Apply StepFun_P24 with f; Assumption | Apply StepFun_P5; Apply StepFun_P24 with f; [Auto with real | Apply StepFun_P5; Assumption | Apply StepFun_P5; Assumption]].
-Qed.
-
-Lemma StepFun_P26 : (a,b,l:R;f,g:R->R;l1:Rlist) (is_subdivision f a b l1) -> (is_subdivision g a b l1) -> (is_subdivision [x:R]``(f x)+l*(g x)`` a b l1).
-Intros a b l f g l1; Unfold is_subdivision; Intros; Elim X; Elim X0; Intros; Clear X X0; Unfold adapted_couple in p p0; Decompose [and] p; Decompose [and] p0; Clear p p0; Apply existTT with (FF l1 [x:R]``(f x)+l*(g x)``); Unfold adapted_couple; Repeat Split; Try Assumption.
-Apply StepFun_P20; Apply neq_O_lt; Red; Intro; Rewrite <- H8 in H7; Discriminate.
-Intros; Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9 H4; Intros; Rewrite (H9 ? H8 ? H10); Rewrite (H4 ? H8 ? H10); Assert H11 : ~l1==nil.
-Red; Intro; Rewrite H11 in H8; Elim (lt_n_O ? H8).
-Assert H12 := (RList_P19 ? H11); Elim H12; Clear H12; Intros r [r0 H12]; Rewrite H12; Unfold FF; Change ``(pos_Rl x0 i)+l*(pos_Rl x i)`` == (pos_Rl (app_Rlist (mid_Rlist (cons r r0) r) [x2:R]``(f x2)+l*(g x2)``) (S i)); Rewrite RList_P12.
-Rewrite RList_P13.
-Rewrite <- H12; Rewrite (H9 ? H8); Try Rewrite (H4 ? H8); Reflexivity Orelse (Elim H10; Clear H10; Intros; Split; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply Rlt_trans with x1; Assumption | DiscrR]] | Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl l1 i)); Apply Rlt_compatibility; Apply Rlt_trans with x1; Assumption | DiscrR]]]).
-Rewrite <- H12; Assumption.
-Rewrite RList_P14; Simpl; Rewrite H12 in H8; Simpl in H8; Apply lt_n_S; Apply H8.
-Qed.
-
-Lemma StepFun_P27 : (a,b,l:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision [x:R]``(f x)+l*(g x)`` a b (cons_ORlist lf lg)).
-Intros a b l f g lf lg H H0; Apply StepFun_P26; [Apply StepFun_P23 with g; Assumption | Apply StepFun_P25 with f; Assumption].
-Qed.
-
-(* The set of step functions on [a,b] is a vectorial space *)
-Lemma StepFun_P28 : (a,b,l:R;f,g:(StepFun a b)) (IsStepFun [x:R]``(f x)+l*(g x)`` a b).
-Intros a b l f g; Unfold IsStepFun; Assert H := (pre f); Assert H0 := (pre g); Unfold IsStepFun in H H0; Elim H; Elim H0; Intros; Apply Specif.existT with (cons_ORlist x0 x); Apply StepFun_P27; Assumption.
-Qed.
-
-Lemma StepFun_P29 : (a,b:R;f:(StepFun a b)) (is_subdivision f a b (subdivision f)).
-Intros a b f; Unfold is_subdivision; Apply existTT with (subdivision_val f); Apply StepFun_P1.
-Qed.
-
-Lemma StepFun_P30 : (a,b,l:R;f,g:(StepFun a b)) ``(RiemannInt_SF (mkStepFun (StepFun_P28 l f g)))==(RiemannInt_SF f)+l*(RiemannInt_SF g)``.
-Intros a b l f g; Unfold RiemannInt_SF; Case (total_order_Rle a b); (Intro; Replace ``(Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) (subdivision (mkStepFun (StepFun_P28 l f g))))`` with (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) [x:R]``(f x)+l*(g x)``) (cons_ORlist (subdivision f) (subdivision g))); [Rewrite StepFun_P19; Replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val f) (subdivision f)); [Replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val g) (subdivision g)); [Ring | Apply StepFun_P17 with (fe g) a b; [Apply StepFun_P1 | Apply StepFun_P21; Apply StepFun_P25 with (fe f); Apply StepFun_P29]] | Apply StepFun_P17 with (fe f) a b; [Apply StepFun_P1 | Apply StepFun_P21; Apply StepFun_P23 with (fe g); Apply StepFun_P29]] | Apply StepFun_P17 with [x:R]``(f x)+l*(g x)`` a b; [Apply StepFun_P21; Apply StepFun_P27; Apply StepFun_P29 | Apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g)))]]).
-Qed.
-
-Lemma StepFun_P31 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> (adapted_couple [x:R](Rabsolu (f x)) a b l (app_Rlist lf Rabsolu)).
-Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
-Symmetry; Rewrite H3; Rewrite RList_P18; Reflexivity.
-Intros; Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H5; Intros; Rewrite (H5 ? H ? H4); Rewrite RList_P12; [Reflexivity | Rewrite H3 in H; Simpl in H; Apply H].
-Qed.
-
-Lemma StepFun_P32 : (a,b:R;f:(StepFun a b)) (IsStepFun [x:R](Rabsolu (f x)) a b).
-Intros a b f; Unfold IsStepFun; Apply Specif.existT with (subdivision f); Unfold is_subdivision; Apply existTT with (app_Rlist (subdivision_val f) Rabsolu); Apply StepFun_P31; Apply StepFun_P1.
-Qed.
-
-Lemma StepFun_P33 : (l2,l1:Rlist) (ordered_Rlist l1) -> ``(Rabsolu (Int_SF l2 l1))<=(Int_SF (app_Rlist l2 Rabsolu) l1)``.
-Induction l2; Intros.
-Simpl; Rewrite Rabsolu_R0; Right; Reflexivity.
-Simpl; Induction l1.
-Rewrite Rabsolu_R0; Right; Reflexivity.
-Induction l1.
-Rewrite Rabsolu_R0; Right; Reflexivity.
-Apply Rle_trans with ``(Rabsolu (r*(r2-r1)))+(Rabsolu (Int_SF r0 (cons r2 l1)))``.
-Apply Rabsolu_triang.
-Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``r2-r1``); [Apply Rle_compatibility; Apply H; Apply RList_P4 with r1; Assumption | Apply Rge_minus; Apply Rle_sym1; Apply (H0 O); Simpl; Apply lt_O_Sn].
-Qed.
-
-Lemma StepFun_P34 : (a,b:R;f:(StepFun a b)) ``a<=b`` -> ``(Rabsolu (RiemannInt_SF f))<=(RiemannInt_SF (mkStepFun (StepFun_P32 f)))``.
-Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) (subdivision (mkStepFun (StepFun_P32 f)))) with (Int_SF (app_Rlist (subdivision_val f) Rabsolu) (subdivision f)).
-Apply StepFun_P33; Assert H0 := (StepFun_P29 f); Unfold is_subdivision in H0; Elim H0; Intros; Unfold adapted_couple in p; Decompose [and] p; Assumption.
-Apply StepFun_P17 with [x:R](Rabsolu (f x)) a b; [Apply StepFun_P31; Apply StepFun_P1 | Apply (StepFun_P1 (mkStepFun (StepFun_P32 f)))].
-Elim n; Assumption.
-Qed.
-
-Lemma StepFun_P35 : (l:Rlist;a,b:R;f,g:R->R) (ordered_Rlist l) -> (pos_Rl l O)==a -> (pos_Rl l (pred (Rlength l)))==b -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(Int_SF (FF l f) l)<=(Int_SF (FF l g) l)``.
-Induction l; Intros.
-Right; Reflexivity.
-Simpl; Induction r0.
-Right; Reflexivity.
-Simpl; Apply Rplus_le.
-Case (Req_EM r r0); Intro.
-Rewrite H4; Right; Ring.
-Do 2 Rewrite <- (Rmult_sym ``r0-r``); Apply Rle_monotony.
-Apply Rle_sym2; Apply Rge_minus; Apply Rle_sym1; Apply (H0 O); Simpl; Apply lt_O_Sn.
-Apply H3; Split.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Assert H5 : r==a.
-Apply H1.
-Rewrite H5; Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility.
-Assert H6 := (H0 O (lt_O_Sn ?)).
-Simpl in H6.
-Elim H6; Intro.
-Rewrite H5 in H7; Apply H7.
-Elim H4; Assumption.
-DiscrR.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite double; Assert H5 : ``r0<=b``.
-Replace b with (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))).
-Replace r0 with (pos_Rl (cons r (cons r0 r1)) (S O)).
-Elim (RList_P6 (cons r (cons r0 r1))); Intros; Apply H5.
-Assumption.
-Simpl; Apply le_n_S.
-Apply le_O_n.
-Simpl; Apply lt_n_Sn.
-Reflexivity.
-Apply Rle_lt_trans with ``r+b``.
-Apply Rle_compatibility; Assumption.
-Rewrite (Rplus_sym r); Apply Rlt_compatibility.
-Apply Rlt_le_trans with r0.
-Assert H6 := (H0 O (lt_O_Sn ?)).
-Simpl in H6.
-Elim H6; Intro.
-Apply H7.
-Elim H4; Assumption.
-Assumption.
-DiscrR.
-Simpl in H; Apply H with r0 b.
-Apply RList_P4 with r; Assumption.
-Reflexivity.
-Rewrite <- H2; Reflexivity.
-Intros; Apply H3; Elim H4; Intros; Split; Try Assumption.
-Apply Rle_lt_trans with r0; Try Assumption.
-Rewrite <- H1.
-Simpl; Apply (H0 O); Simpl; Apply lt_O_Sn.
-Qed.
-
-Lemma StepFun_P36 : (a,b:R;f,g:(StepFun a b);l:Rlist) ``a<=b`` -> (is_subdivision f a b l) -> (is_subdivision g a b l) -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt_SF f) <= (RiemannInt_SF g)``.
-Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-Replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l).
-Replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l).
-Unfold is_subdivision in X; Elim X; Clear X; Intros; Unfold adapted_couple in p; Decompose [and] p; Clear p; Assert H5 : (Rmin a b)==a; [Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption] | Assert H7 : (Rmax a b)==b; [Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption] | Rewrite H5 in H3; Rewrite H7 in H2; EApply StepFun_P35 with a b; Assumption]].
-Apply StepFun_P17 with (fe g) a b; [Apply StepFun_P21; Assumption | Apply StepFun_P1].
-Apply StepFun_P17 with (fe f) a b; [Apply StepFun_P21; Assumption | Apply StepFun_P1].
-Elim n; Assumption.
-Qed.
-
-Lemma StepFun_P37 : (a,b:R;f,g:(StepFun a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt_SF f) <= (RiemannInt_SF g)``.
-Intros; EApply StepFun_P36; Try Assumption.
-EApply StepFun_P25; Apply StepFun_P29.
-EApply StepFun_P23; Apply StepFun_P29.
-Qed.
-
-Lemma StepFun_P38 : (l:Rlist;a,b:R;f:R->R) (ordered_Rlist l) -> (pos_Rl l O)==a -> (pos_Rl l (pred (Rlength l)))==b -> (sigTT ? [g:(StepFun a b)](g b)==(f b)/\(i:nat)(lt i (pred (Rlength l)))->(constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) (f (pos_Rl l i)))).
-Intros l a b f; Generalize a; Clear a; NewInduction l. 
-Intros a H H0 H1; Simpl in H0; Simpl in H1; Exists (mkStepFun (StepFun_P4 a b (f b))); Split.
-Reflexivity.
-Intros; Elim (lt_n_O ? H2).
-Intros; NewDestruct l as [|r1 l].
-Simpl in H1; Simpl in H0; Exists (mkStepFun (StepFun_P4 a b (f b))); Split.
-Reflexivity.
-Intros i H2; Elim (lt_n_O ? H2).
-Intros; Assert H2 : (ordered_Rlist (cons r1 l)).
-Apply RList_P4 with r; Assumption.
-Assert H3 : (pos_Rl (cons r1 l) O)==r1.
-Reflexivity.
-Assert H4 : (pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))))==b.
-Rewrite <- H1; Reflexivity.
-Elim (IHl r1 H2 H3 H4); Intros g [H5 H6].
-Pose g' := [x:R]Cases (total_order_Rle r1 x) of
-                      | (leftT _) => (g x)
-                      | (rightT _) => (f a) end.
-Assert H7 : ``r1<=b``.
-Rewrite <- H4; Apply RList_P7; [Assumption | Left; Reflexivity].
-Assert H8 : (IsStepFun g' a b).
-Unfold IsStepFun; Assert H8 := (pre g); Unfold IsStepFun in H8; Elim H8; Intros lg H9; Unfold is_subdivision in H9; Elim H9; Clear H9; Intros lg2 H9; Split with (cons a lg); Unfold is_subdivision; Split with (cons (f a) lg2); Unfold adapted_couple in H9; Decompose [and] H9; Clear H9; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H9; Induction i.
-Simpl; Rewrite H12; Replace (Rmin r1 b) with r1.
-Simpl in H0; Rewrite <- H0; Apply (H O); Simpl; Apply lt_O_Sn.
-Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n; Assumption].
-Apply (H10 i); Apply lt_S_n.
-Replace (S (pred (Rlength lg))) with (Rlength lg).
-Apply H9.
-Apply S_pred with O; Apply neq_O_lt; Intro; Rewrite <- H14 in H9; Elim (lt_n_O ? H9).
-Simpl; Assert H14 : ``a<=b``.
-Rewrite <- H1; Simpl in H0; Rewrite <- H0; Apply RList_P7; [Assumption | Left; Reflexivity].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Assert H14 : ``a<=b``.
-Rewrite <- H1; Simpl in H0; Rewrite <- H0; Apply RList_P7; [Assumption | Left; Reflexivity].
-Replace (Rmax a b) with (Rmax r1 b).
-Rewrite <- H11; Induction lg.
-Simpl in H13; Discriminate.
-Reflexivity.
-Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle r1 b); Intros; Reflexivity Orelse Elim n; Assumption.
-Simpl; Rewrite H13; Reflexivity.
-Intros; Simpl in H9; Induction i.
-Unfold constant_D_eq open_interval; Simpl; Intros; Assert H16 : (Rmin r1 b)==r1.
-Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n; Assumption].
-Rewrite H16 in H12; Rewrite H12 in H14; Elim H14; Clear H14; Intros _ H14; Unfold g'; Case (total_order_Rle r1 x); Intro r3.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H14)).
-Reflexivity.
-Change (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i))) (pos_Rl lg2 i)); Clear Hreci; Assert H16 := (H15 i); Assert H17 : (lt i (pred (Rlength lg))).
-Apply lt_S_n.
-Replace (S (pred (Rlength lg))) with (Rlength lg).
-Assumption.
-Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H14 in H9; Elim (lt_n_O ? H9).
-Assert H18 := (H16 H17); Unfold constant_D_eq open_interval in H18; Unfold constant_D_eq open_interval; Intros; Assert H19 := (H18 ? H14); Rewrite <- H19; Unfold g'; Case (total_order_Rle r1 x); Intro.
-Reflexivity.
-Elim n; Replace r1 with (Rmin r1 b).
-Rewrite <- H12; Elim H14; Clear H14; Intros H14 _; Left; Apply Rle_lt_trans with (pos_Rl lg i); Try Assumption.
-Apply RList_P5.
-Assumption.
-Elim (RList_P3 lg (pos_Rl lg i)); Intros; Apply H21; Exists i; Split.
-Reflexivity.
-Apply lt_trans with (pred (Rlength lg)); Try Assumption.
-Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H17; Elim (lt_n_O ? H17).
-Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n0; Assumption].
-Exists (mkStepFun H8); Split.
-Simpl; Unfold g'; Case (total_order_Rle r1 b); Intro.
-Assumption.
-Elim n; Assumption.
-Intros; Simpl in H9; Induction i.
-Unfold constant_D_eq co_interval; Simpl; Intros; Simpl in H0; Rewrite H0; Elim H10; Clear H10; Intros; Unfold g'; Case (total_order_Rle r1 x); Intro r3.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H11)).
-Reflexivity.
-Clear Hreci; Change (constant_D_eq (mkStepFun H8) (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i))) (f (pos_Rl (cons r1 l) i))); Assert H10 := (H6 i); Assert H11 : (lt i (pred (Rlength (cons r1 l)))).
-Simpl; Apply lt_S_n; Assumption.
-Assert H12 := (H10 H11); Unfold constant_D_eq co_interval in H12; Unfold constant_D_eq co_interval; Intros; Rewrite <- (H12 ? H13); Simpl; Unfold g'; Case (total_order_Rle r1 x); Intro.
-Reflexivity.
-Elim n; Elim H13; Clear H13; Intros; Apply Rle_trans with (pos_Rl (cons r1 l) i); Try Assumption; Change ``(pos_Rl (cons r1 l) O)<=(pos_Rl (cons r1 l) i)``; Elim (RList_P6 (cons r1 l)); Intros; Apply H15; [Assumption | Apply le_O_n | Simpl; Apply lt_trans with (Rlength l); [Apply lt_S_n; Assumption | Apply lt_n_Sn]].
-Qed.
-
-Lemma StepFun_P39 : (a,b:R;f:(StepFun a b)) (RiemannInt_SF f)==(Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))))).
-Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros.
-Assert H : (adapted_couple f a b (subdivision f) (subdivision_val f)); [Apply StepFun_P1 | Assert H0 : (adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a (subdivision (mkStepFun (StepFun_P6 (pre f)))) (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); [Apply StepFun_P1 | Assert H1 : a==b; [Apply Rle_antisym; Assumption | Rewrite (StepFun_P8 H H1); Assert H2 : b==a; [Symmetry; Apply H1 | Rewrite (StepFun_P8 H0 H2); Ring]]]].
-Rewrite Ropp_Ropp; EApply StepFun_P17; [Apply StepFun_P1 | Apply StepFun_P2; Pose H := (StepFun_P6 (pre f)); Unfold IsStepFun in H; Elim H; Intros; Unfold is_subdivision; Elim p; Intros; Apply p0].
-Apply eq_Ropp; EApply StepFun_P17; [Apply StepFun_P1 | Apply StepFun_P2; Pose H := (StepFun_P6 (pre f)); Unfold IsStepFun in H; Elim H; Intros; Unfold is_subdivision; Elim p; Intros; Apply p0].
-Assert H : ``a<b``; [Auto with real | Assert H0 : ``b<a``; [Auto with real | Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H H0))]].
-Qed.
-
-Lemma StepFun_P40 : (f:R->R;a,b,c:R;l1,l2,lf1,lf2:Rlist) ``a<b`` -> ``b<c`` -> (adapted_couple f a b l1 lf1) -> (adapted_couple f b c l2 lf2) -> (adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f)).
-Intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; Unfold adapted_couple in H1 H2; Unfold adapted_couple; Decompose [and] H1; Decompose [and] H2; Clear H1 H2; Repeat Split.
-Apply RList_P25; Try Assumption.
-Rewrite H10; Rewrite H4; Unfold Rmin Rmax; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; (Right; Reflexivity) Orelse (Elim n; Left; Assumption).
-Rewrite RList_P22.
-Rewrite H5; Unfold Rmin Rmax; Case (total_order_Rle a b); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Apply Rle_trans with b; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Red; Intro; Rewrite H1 in H6; Discriminate.
-Rewrite RList_P24.
-Rewrite H9; Unfold Rmin Rmax; Case (total_order_Rle b c); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Apply Rle_trans with b; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Red; Intro; Rewrite H1 in H11; Discriminate.
-Apply StepFun_P20.
-Rewrite RList_P23; Apply neq_O_lt; Red; Intro.
-Assert H2 : (plus (Rlength l1) (Rlength l2))=O.
-Symmetry; Apply H1.
-Elim (plus_is_O ? ? H2); Intros; Rewrite H12 in H6; Discriminate.
-Unfold constant_D_eq open_interval; Intros; Elim (le_or_lt (S (S i)) (Rlength l1)); Intro.
-Assert H14 : (pos_Rl (cons_Rlist l1 l2) i) == (pos_Rl l1 i).
-Apply RList_P26; Apply lt_S_n; Apply le_lt_n_Sm; Apply le_S_n; Apply le_trans with (Rlength l1); [Assumption | Apply le_n_Sn].
-Assert H15 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l1 (S i)).
-Apply RList_P26; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
-Rewrite H14 in H2; Rewrite H15 in H2; Assert H16 : (le (2) (Rlength l1)).
-Apply le_trans with (S (S i)); [Repeat Apply le_n_S; Apply le_O_n | Assumption].
-Elim (RList_P20 ? H16); Intros r1 [r2 [r3 H17]]; Rewrite H17; Change (f x)==(pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i); Rewrite RList_P12.
-Induction i.
-Simpl; Assert H18 := (H8 O); Unfold constant_D_eq open_interval in H18; Assert H19 : (lt O (pred (Rlength l1))).
-Rewrite H17; Simpl; Apply lt_O_Sn.
-Assert H20 := (H18 H19); Repeat Rewrite H20.
-Reflexivity.
-Assert H21 : ``r1<=r2``.
-Rewrite H17 in H3; Apply (H3 O).
-Simpl; Apply lt_O_Sn.
-Elim H21; Intro.
-Split.
-Rewrite H17; Simpl; Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite H17; Simpl; Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Elim H2; Intros; Rewrite H17 in H23; Rewrite H17 in H24; Simpl in H24; Simpl in H23; Rewrite H22 in H23; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H23 H24)).
-Assumption.
-Clear Hreci; Rewrite RList_P13.
-Rewrite H17 in H14; Rewrite H17 in H15; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) i)== (pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; Rewrite H14; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i))==(pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; Rewrite H15; Assert H18 := (H8 (S i)); Unfold constant_D_eq open_interval in H18; Assert H19 : (lt (S i) (pred (Rlength l1))).
-Apply lt_pred; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
-Assert H20 := (H18 H19); Repeat Rewrite H20.
-Reflexivity.
-Rewrite <- H17; Assert H21 : ``(pos_Rl l1 (S i))<=(pos_Rl l1 (S (S i)))``.
-Apply (H3 (S i)); Apply lt_pred; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
-Elim H21; Intro.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym (pos_Rl l1 (S i))); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Elim H2; Intros; Rewrite H22 in H23; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H23 H24)).
-Assumption.
-Simpl; Rewrite H17 in H1; Simpl in H1; Apply lt_S_n; Assumption.
-Rewrite RList_P14; Rewrite H17 in H1; Simpl in H1; Apply H1.
-Inversion H12.
-Assert H16 : (pos_Rl (cons_Rlist l1 l2) (S i))==b.
-Rewrite RList_P29.
-Rewrite H15; Rewrite <- minus_n_n; Rewrite H10; Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Left; Assumption].
-Rewrite H15; Apply le_n.
-Induction l1.
-Simpl in H15; Discriminate.
-Clear Hrecl1; Simpl in H1; Simpl; Apply lt_n_S; Assumption.
-Assert H17 : (pos_Rl (cons_Rlist l1 l2) i)==b.
-Rewrite RList_P26.
-Replace i with (pred (Rlength l1)); [Rewrite H4; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption] | Rewrite H15; Reflexivity].
-Rewrite H15; Apply lt_n_Sn.
-Rewrite H16 in H2; Rewrite H17 in H2; Elim H2; Intros; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H14 H18)).
-Assert H16 : (pos_Rl (cons_Rlist l1 l2) i) == (pos_Rl l2 (minus i (Rlength l1))).
-Apply RList_P29.
-Apply le_S_n; Assumption.
-Apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2))); [Assumption | Apply le_pred_n].
-Assert H17 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l2 (S (minus i (Rlength l1)))).
-Replace (S (minus i (Rlength l1))) with (minus (S i) (Rlength l1)).
-Apply RList_P29.
-Apply le_S_n; Apply le_trans with (S i); [Assumption | Apply le_n_Sn].
-Induction l1.
-Simpl in H6; Discriminate.
-Clear Hrecl1; Simpl in H1; Simpl; Apply lt_n_S; Assumption.
-Symmetry; Apply minus_Sn_m; Apply le_S_n; Assumption.
-Assert H18 : (le (2) (Rlength l1)).
-Clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17; Induction l1.
-Discriminate.
-Clear Hrecl1; Induction l1.
-Simpl in H5; Simpl in H4; Assert H0 : ``(Rmin a b)<(Rmax a b)``.
-Unfold Rmin Rmax; Case (total_order_Rle a b); Intro; [Assumption | Elim n; Left; Assumption].
-Rewrite <- H5 in H0; Rewrite <- H4 in H0; Elim (Rlt_antirefl ? H0).
-Clear Hrecl1; Simpl; Repeat Apply le_n_S; Apply le_O_n.
-Elim (RList_P20 ? H18); Intros r1 [r2 [r3 H19]]; Rewrite H19; Change (f x)==(pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i); Rewrite RList_P12.
-Induction i.
-Assert H20 := (le_S_n ? ? H15); Assert H21 := (le_trans ? ? ? H18 H20); Elim (le_Sn_O ? H21).
-Clear Hreci; Rewrite RList_P13.
-Rewrite H19 in H16; Rewrite H19 in H17; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) i)==  (pos_Rl l2 (minus (S i) (Rlength (cons r1 (cons r2 r3))))) in H16; Rewrite H16; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i))== (pos_Rl l2 (S (minus (S i) (Rlength (cons r1 (cons r2 r3)))))) in H17; Rewrite H17; Assert H20 := (H13 (minus (S i) (Rlength l1))); Unfold constant_D_eq open_interval in H20; Assert H21 : (lt (minus (S i) (Rlength l1)) (pred (Rlength l2))).
-Apply lt_pred; Rewrite minus_Sn_m.
-Apply simpl_lt_plus_l with (Rlength l1); Rewrite <- le_plus_minus.
-Rewrite H19 in H1; Simpl in H1; Rewrite H19; Simpl; Rewrite RList_P23 in H1; Apply lt_n_S; Assumption.
-Apply le_trans with (S i); [Apply le_S_n; Assumption | Apply le_n_Sn].
-Apply le_S_n; Assumption.
-Assert H22 := (H20 H21); Repeat Rewrite H22.
-Reflexivity.
-Rewrite <- H19; Assert H23 : ``(pos_Rl l2 (minus (S i) (Rlength l1)))<=(pos_Rl l2 (S (minus (S i) (Rlength l1))))``.
-Apply H7; Apply lt_pred.
-Rewrite minus_Sn_m.
-Apply simpl_lt_plus_l with (Rlength l1); Rewrite <- le_plus_minus.
-Rewrite H19 in H1; Simpl in H1; Rewrite H19; Simpl; Rewrite RList_P23 in H1; Apply lt_n_S; Assumption.
-Apply le_trans with (S i); [Apply le_S_n; Assumption | Apply le_n_Sn].
-Apply le_S_n; Assumption.
-Elim H23; Intro.
-Split.
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym (pos_Rl l2 (minus (S i) (Rlength l1)))); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
-Rewrite <- H19 in H16; Rewrite <- H19 in H17; Elim H2; Intros; Rewrite H19 in H25; Rewrite H19 in H26; Simpl in H25; Simpl in H16; Rewrite H16 in H25; Simpl in H26; Simpl in H17; Rewrite H17 in H26; Simpl in H24; Rewrite H24 in H25; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H25 H26)).
-Assert H23 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l2 (minus (S i) (Rlength l1))).
-Rewrite H19; Simpl; Simpl in H16; Apply H16.
-Assert H24 : (pos_Rl (cons_Rlist l1 l2) (S (S i)))==(pos_Rl l2 (S (minus (S i) (Rlength l1)))).
-Rewrite H19; Simpl; Simpl in H17; Apply H17.
-Rewrite <- H23; Rewrite <- H24; Assumption.
-Simpl; Rewrite H19 in H1; Simpl in H1; Apply lt_S_n; Assumption.
-Rewrite RList_P14; Rewrite H19 in H1; Simpl in H1; Simpl; Apply H1.
-Qed.
-
-Lemma StepFun_P41 : (f:R->R;a,b,c:R) ``a<=b``->``b<=c``->(IsStepFun f a b) -> (IsStepFun f b c) -> (IsStepFun f a c).
-Unfold IsStepFun; Unfold is_subdivision; Intros; Elim X; Clear X; Intros l1 [lf1 H1]; Elim X0; Clear X0; Intros l2 [lf2 H2]; Case (total_order_T a b); Intro.
-Elim s; Intro.
-Case (total_order_T b c); Intro.
-Elim s0; Intro.
-Split with (cons_Rlist l1 l2); Split with (FF (cons_Rlist l1 l2) f); Apply StepFun_P40 with b lf1 lf2; Assumption.
-Split with l1; Split with lf1; Rewrite b0 in H1; Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
-Split with l2; Split with lf2; Rewrite <- b0 in H2; Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Qed.
-
-Lemma StepFun_P42 : (l1,l2:Rlist;f:R->R) (pos_Rl l1 (pred (Rlength l1)))==(pos_Rl l2 O) -> ``(Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)) == (Int_SF (FF l1 f) l1) + (Int_SF (FF l2 f) l2)``.
-Intros l1 l2 f; NewInduction l1 as [|r l1 IHl1]; Intros H; [ Simpl; Ring | NewDestruct l1; [Simpl in H; Simpl; NewDestruct l2; [Simpl; Ring | Simpl; Simpl in H; Rewrite H; Ring] | Simpl; Rewrite Rplus_assoc; Apply Rplus_plus_r; Apply IHl1; Rewrite <- H; Reflexivity]].
-Qed.
-
-Lemma StepFun_P43 : (f:R->R;a,b,c:R;pr1:(IsStepFun f a b);pr2:(IsStepFun f b c);pr3:(IsStepFun f a c)) ``(RiemannInt_SF (mkStepFun pr1))+(RiemannInt_SF (mkStepFun pr2))==(RiemannInt_SF (mkStepFun pr3))``.
-Intros f; Intros; Assert H1 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a b l l0))).
-Apply pr1.
-Assert H2 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f b c l l0))).
-Apply pr2.
-Assert H3 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a c l l0))).
-Apply pr3.
-Elim H1; Clear H1; Intros l1 [lf1 H1]; Elim H2; Clear H2; Intros l2 [lf2 H2]; Elim H3; Clear H3; Intros l3 [lf3 H3].
-Replace (RiemannInt_SF (mkStepFun pr1)) with (Cases (total_order_Rle a b) of (leftT _) => (Int_SF lf1 l1) | (rightT _) => ``-(Int_SF lf1 l1)`` end).
-Replace (RiemannInt_SF (mkStepFun pr2)) with (Cases (total_order_Rle b c) of (leftT _) => (Int_SF lf2 l2) | (rightT _) => ``-(Int_SF lf2 l2)`` end).
-Replace (RiemannInt_SF (mkStepFun pr3)) with (Cases (total_order_Rle a c) of (leftT _) => (Int_SF lf3 l3) | (rightT _) => ``-(Int_SF lf3 l3)`` end).
-Case (total_order_Rle a b); Case (total_order_Rle b c); Case (total_order_Rle a c); Intros.
-Elim r1; Intro.
-Elim r0; Intro.
-Replace (Int_SF lf3 l3) with (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)).
-Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H1 H2; Decompose [and] H1; Decompose [and] H2; Clear H1 H2; Rewrite H11; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; Reflexivity Orelse Elim n; Assumption.
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2; Assumption | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
-EApply StepFun_P17; [Apply (StepFun_P40 H H0 H1 H2) | Apply H3].
-Replace (Int_SF lf2 l2) with R0.
-Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Rewrite <- H0 in H3; Apply H3].
-Symmetry; EApply StepFun_P8; [Apply H2 | Assumption].
-Replace (Int_SF lf1 l1) with R0.
-Rewrite Rplus_Ol; EApply StepFun_P17; [Apply H2 | Rewrite H in H3; Apply H3].
-Symmetry; EApply StepFun_P8; [Apply H1 | Assumption].
-Elim n; Apply Rle_trans with b; Assumption.
-Apply r_Rplus_plus with (Int_SF lf2 l2); Replace ``(Int_SF lf2 l2)+((Int_SF lf1 l1)+ -(Int_SF lf2 l2))`` with (Int_SF lf1 l1); [Idtac | Ring].
-Assert H : ``c<b``.
-Auto with real.
-Elim r; Intro.
-Rewrite Rplus_sym; Replace (Int_SF lf1 l1) with (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)).
-Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
-Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-Apply StepFun_P42.
-Unfold adapted_couple in H2 H3; Decompose [and] H2; Decompose [and] H3; Clear H3 H2; Rewrite H10; Rewrite H6; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; [Elim n; Assumption | Reflexivity | Elim n0; Assumption | Elim n1; Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
-EApply StepFun_P17; [Apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | Apply H1].
-Replace (Int_SF lf3 l3) with R0.
-Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Apply StepFun_P2; Rewrite <- H0 in H2; Apply H2].
-Symmetry; EApply StepFun_P8; [Apply H3 | Assumption].
-Replace (Int_SF lf2 l2) with ``(Int_SF lf3 l3)+(Int_SF lf1 l1)``.
-Ring.
-Elim r; Intro.
-Replace (Int_SF lf2 l2) with (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)).
-Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
-Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H1 H3; Decompose [and] H1; Decompose [and] H3; Clear H3 H1; Rewrite H9; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Elim n; Assumption | Elim n1; Assumption | Reflexivity | Elim n1; Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
-EApply StepFun_P17.
-Assert H0 : ``c<a``.
-Auto with real.
-Apply (StepFun_P40 H0 H (StepFun_P2 H3) H1).
-Apply StepFun_P2; Apply H2.
-Replace (Int_SF lf1 l1) with R0.
-Rewrite Rplus_Or; EApply StepFun_P17; [Apply H3 | Rewrite <- H in H2; Apply H2].
-Symmetry; EApply StepFun_P8; [Apply H1 | Assumption].
-Assert H : ``b<a``.
-Auto with real.
-Replace (Int_SF lf2 l2) with ``(Int_SF lf3 l3)+(Int_SF lf1 l1)``.
-Ring.
-Rewrite Rplus_sym; Elim r; Intro.
-Replace (Int_SF lf2 l2) with (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)).
-Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
-Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H1 H3; Decompose [and] H1; Decompose [and] H3; Clear H3 H1; Rewrite H11; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Elim n; Assumption | Reflexivity | Elim n0; Assumption | Elim n1; Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
-EApply StepFun_P17.
-Apply (StepFun_P40 H H0 (StepFun_P2 H1) H3).
-Apply H2.
-Replace (Int_SF lf3 l3) with R0.
-Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Rewrite <- H0 in H2; Apply StepFun_P2; Apply H2].
-Symmetry; EApply StepFun_P8; [Apply H3 | Assumption].
-Assert H : ``c<a``.
-Auto with real.
-Replace (Int_SF lf1 l1) with ``(Int_SF lf2 l2)+(Int_SF lf3 l3)``.
-Ring.
-Elim r; Intro.
-Replace (Int_SF lf1 l1) with (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)).
-Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
-Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H2 H3; Decompose [and] H2; Decompose [and] H3; Clear H3 H2; Rewrite H11; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; [Elim n; Assumption | Elim n1; Assumption | Reflexivity | Elim n1; Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
-EApply StepFun_P17.
-Apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)).
-Apply StepFun_P2; Apply H1.
-Replace (Int_SF lf2 l2) with R0.
-Rewrite Rplus_Ol; EApply StepFun_P17; [Apply H3 | Rewrite H0 in H1; Apply H1].
-Symmetry; EApply StepFun_P8; [Apply H2 | Assumption].
-Elim n; Apply Rle_trans with a; Try Assumption.
-Auto with real.
-Assert H : ``c<b``.
-Auto with real.
-Assert H0 : ``b<a``.
-Auto with real.
-Replace (Int_SF lf3 l3) with ``(Int_SF lf2 l2)+(Int_SF lf1 l1)``.
-Ring.
-Replace (Int_SF lf3 l3) with (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)).
-Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1).
-Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2).
-Symmetry; Apply StepFun_P42.
-Unfold adapted_couple in H2 H1; Decompose [and] H2; Decompose [and] H1; Clear H1 H2; Rewrite H11; Rewrite H5; Unfold Rmax Rmin; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; [Elim n1; Assumption | Elim n1; Assumption | Elim n0; Assumption | Reflexivity].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
-EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
-EApply StepFun_P17.
-Apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)).
-Apply StepFun_P2; Apply H3.
-Unfold RiemannInt_SF; Case (total_order_Rle a c); Intro.
-EApply StepFun_P17.
-Apply H3.
-Change (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun 1!a 2!c 3!f pr3)) (subdivision_val (mkStepFun 1!a 2!c 3!f pr3))); Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply H3.
-Change (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun 1!a 2!c 3!f pr3)) (subdivision_val (mkStepFun 1!a 2!c 3!f pr3))); Apply StepFun_P1.
-Unfold RiemannInt_SF; Case (total_order_Rle b c); Intro.
-EApply StepFun_P17.
-Apply H2.
-Change (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun 1!b 2!c 3!f pr2)) (subdivision_val (mkStepFun 1!b 2!c 3!f pr2))); Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply H2.
-Change (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun 1!b 2!c 3!f pr2)) (subdivision_val (mkStepFun 1!b 2!c 3!f pr2))); Apply StepFun_P1.
-Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
-EApply StepFun_P17.
-Apply H1.
-Change (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun 1!a 2!b 3!f pr1)) (subdivision_val (mkStepFun 1!a 2!b 3!f pr1))); Apply StepFun_P1.
-Apply eq_Ropp; EApply StepFun_P17.
-Apply H1.
-Change (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun 1!a 2!b 3!f pr1)) (subdivision_val (mkStepFun 1!a 2!b 3!f pr1))); Apply StepFun_P1.
-Qed.
-
-Lemma StepFun_P44 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> ``a<=c<=b`` -> (IsStepFun f a c).
-Intros f; Intros; Assert H0 : ``a<=b``.
-Elim H; Intros; Apply Rle_trans with c; Assumption.
-Elim H; Clear H; Intros; Unfold IsStepFun in X; Unfold is_subdivision in X; Elim X; Clear X; Intros l1 [lf1 H2]; Cut (l1,lf1:Rlist;a,b,c:R;f:R->R) (adapted_couple f a b l1 lf1) -> ``a<=c<=b`` -> (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a c l l0))).
-Intros; Unfold IsStepFun; Unfold is_subdivision; EApply X.
-Apply H2.
-Split; Assumption.
-Clear f a b c H0 H H1 H2 l1 lf1; Induction l1.
-Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
-Induction r0.
-Intros; Assert H1 : ``a==b``.
-Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H3; Simpl in H2; Assert H7 : ``a<=b``.
-Elim H0; Intros; Apply Rle_trans with c; Assumption.
-Replace a with (Rmin a b).
-Pattern 2 b; Replace b with (Rmax a b).
-Rewrite <- H2; Rewrite H3; Reflexivity.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Split with (cons r nil); Split with lf1; Assert H2 : ``c==b``.
-Rewrite H1 in H0; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite H2; Assumption.
-Intros; Clear X; Induction lf1.
-Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
-Clear Hreclf1; Assert H1 : (sumboolT ``c<=r1`` ``r1<c``).
-Case (total_order_Rle c r1); Intro; [Left; Assumption | Right; Auto with real].
-Elim H1; Intro.
-Split with (cons r (cons c nil)); Split with (cons r3 nil); Unfold adapted_couple in H; Decompose [and] H; Clear H; Assert H6 : ``r==a``.
-Simpl in H4; Rewrite H4; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Elim H0; Intros; Apply Rle_trans with c; Assumption].
-Elim H0; Clear H0; Intros; Unfold adapted_couple; Repeat Split.
-Rewrite H6; Unfold ordered_Rlist; Intros; Simpl in H8; Inversion H8; [Simpl; Assumption | Elim (le_Sn_O ? H10)].
-Simpl; Unfold Rmin; Case (total_order_Rle a c); Intro; [Assumption | Elim n; Assumption].
-Simpl; Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n; Assumption].
-Unfold constant_D_eq open_interval; Intros; Simpl in H8; Inversion H8.
-Simpl; Assert H10 := (H7 O); Assert H12 : (lt (0) (pred (Rlength (cons r (cons r1 r2))))).
-Simpl; Apply lt_O_Sn.
-Apply (H10 H12); Unfold open_interval; Simpl; Rewrite H11 in H9; Simpl in H9; Elim H9; Clear H9; Intros; Split; Try Assumption.
-Apply Rlt_le_trans with c; Assumption.
-Elim (le_Sn_O ? H11).
-Cut (adapted_couple f r1 b (cons r1 r2) lf1).
-Cut ``r1<=c<=b``.
-Intros.
-Elim (X0 ? ? ? ? ? H3 H2); Intros l1' [lf1' H4]; Split with (cons r l1'); Split with (cons r3 lf1'); Unfold adapted_couple in H H4; Decompose [and] H; Decompose [and] H4; Clear H H4 X0; Assert H14 : ``a<=b``.
-Elim H0; Intros; Apply Rle_trans with c; Assumption.
-Assert H16 : ``r==a``.
-Simpl in H7; Rewrite H7; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Induction l1'.
-Simpl in H13; Discriminate.
-Clear Hrecl1'; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
-Simpl; Replace r4 with r1.
-Apply (H5 O).
-Simpl; Apply lt_O_Sn.
-Simpl in H12; Rewrite H12; Unfold Rmin; Case (total_order_Rle r1 c); Intro; [Reflexivity | Elim n; Left; Assumption].
-Apply (H9 i); Simpl; Apply lt_S_n; Assumption.
-Simpl; Unfold Rmin; Case (total_order_Rle a c); Intro; [Assumption | Elim n; Elim H0; Intros; Assumption].
-Replace (Rmax a c) with (Rmax r1 c).
-Rewrite <- H11; Reflexivity.
-Unfold Rmax; Case (total_order_Rle r1 c); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Elim H0; Intros; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
-Simpl; Simpl in H13; Rewrite H13; Reflexivity.
-Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
-Simpl; Assert H17 := (H10 O); Assert H18 : (lt (0) (pred (Rlength (cons r (cons r1 r2))))).
-Simpl; Apply lt_O_Sn.
-Apply (H17 H18); Unfold open_interval; Simpl; Simpl in H4; Elim H4; Clear H4; Intros; Split; Try Assumption; Replace r1 with r4.
-Assumption.
-Simpl in H12; Rewrite H12; Unfold Rmin; Case (total_order_Rle r1 c); Intro; [Reflexivity | Elim n; Left; Assumption].
-Clear Hreci; Simpl; Apply H15.
-Simpl; Apply lt_S_n; Assumption.
-Unfold open_interval; Apply H4.
-Split.
-Left; Assumption.
-Elim H0; Intros; Assumption.
-EApply StepFun_P7; [Elim H0; Intros; Apply Rle_trans with c; [Apply H2 | Apply H3] | Apply H].
-Qed.
-
-Lemma StepFun_P45 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> ``a<=c<=b`` -> (IsStepFun f c b).
-Intros f; Intros; Assert H0 : ``a<=b``.
-Elim H; Intros; Apply Rle_trans with c; Assumption.
-Elim H; Clear H; Intros; Unfold IsStepFun in X; Unfold is_subdivision in X; Elim X; Clear X; Intros l1 [lf1 H2]; Cut (l1,lf1:Rlist;a,b,c:R;f:R->R) (adapted_couple f a b l1 lf1) -> ``a<=c<=b`` -> (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f c b l l0))).
-Intros; Unfold IsStepFun; Unfold is_subdivision; EApply X; [Apply H2 | Split; Assumption].
-Clear f a b c H0 H H1 H2 l1 lf1; Induction l1.
-Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
-Induction r0.
-Intros; Assert H1 : ``a==b``.
-Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H3; Simpl in H2; Assert H7 : ``a<=b``.
-Elim H0; Intros; Apply Rle_trans with c; Assumption.
-Replace a with (Rmin a b).
-Pattern 2 b; Replace b with (Rmax a b).
-Rewrite <- H2; Rewrite H3; Reflexivity.
-Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
-Split with (cons r nil); Split with lf1; Assert H2 : ``c==b``.
-Rewrite H1 in H0; Elim H0; Intros; Apply Rle_antisym; Assumption.
-Rewrite <- H2 in H1; Rewrite <- H1; Assumption.
-Intros; Clear X; Induction lf1.
-Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
-Clear Hreclf1; Assert H1 : (sumboolT ``c<=r1`` ``r1<c``).
-Case (total_order_Rle c r1); Intro; [Left; Assumption | Right; Auto with real].
-Elim H1; Intro.
-Split with (cons c (cons r1 r2)); Split with (cons r3 lf1); Unfold adapted_couple in H; Decompose [and] H; Clear H; Unfold adapted_couple; Repeat Split.
-Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
-Simpl; Assumption.
-Clear Hreci; Apply (H2 (S i)); Simpl; Assumption.
-Simpl; Unfold Rmin; Case (total_order_Rle c b); Intro; [Reflexivity | Elim n; Elim H0; Intros; Assumption].
-Replace (Rmax c b) with (Rmax a b).
-Rewrite <- H3; Reflexivity.
-Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle c b); Intros; [Reflexivity | Elim n; Elim H0; Intros; Assumption | Elim n; Elim H0; Intros; Apply Rle_trans with c; Assumption | Elim n0; Elim H0; Intros; Apply Rle_trans with c; Assumption].
-Simpl; Simpl in H5; Apply H5.
-Intros; Simpl in H; Induction i.
-Unfold constant_D_eq open_interval; Intros; Simpl; Apply (H7 O).
-Simpl; Apply lt_O_Sn.
-Unfold open_interval; Simpl; Simpl in H6; Elim H6; Clear H6; Intros; Split; Try Assumption; Apply Rle_lt_trans with c; Try Assumption; Replace r with a.
-Elim H0; Intros; Assumption.
-Simpl in H4; Rewrite H4; Unfold Rmin; Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Elim H0; Intros; Apply Rle_trans with c; Assumption].
-Clear Hreci; Apply (H7 (S i)); Simpl; Assumption.
-Cut (adapted_couple f r1 b (cons r1 r2) lf1).
-Cut ``r1<=c<=b``.
-Intros; Elim (X0 ? ? ? ? ? H3 H2); Intros l1' [lf1' H4]; Split with l1'; Split with lf1'; Assumption.
-Split; [Left; Assumption | Elim H0; Intros; Assumption].
-EApply StepFun_P7; [Elim H0; Intros; Apply Rle_trans with c; [Apply H2 | Apply H3] | Apply H].
-Qed.
-
-Lemma StepFun_P46 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> (IsStepFun f b c) -> (IsStepFun f a c).
-Intros f; Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
-Apply StepFun_P41 with b; Assumption.
-Case (total_order_Rle a c); Intro.
-Apply StepFun_P44 with b; Try Assumption.
-Split; [Assumption | Auto with real].
-Apply StepFun_P6; Apply StepFun_P44 with b.
-Apply StepFun_P6; Assumption.
-Split; Auto with real.
-Case (total_order_Rle a c); Intro.
-Apply StepFun_P45 with b; Try Assumption.
-Split; Auto with real.
-Apply StepFun_P6; Apply StepFun_P45 with b.
-Apply StepFun_P6; Assumption.
-Split; [Assumption | Auto with real].
-Apply StepFun_P6; Apply StepFun_P41 with b; Auto with real Orelse Apply StepFun_P6; Assumption.
-Qed.
diff --git a/theories7/Reals/Rlimit.v b/theories7/Reals/Rlimit.v
deleted file mode 100644
index 3308b2e3..00000000
--- a/theories7/Reals/Rlimit.v
+++ /dev/null
@@ -1,539 +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: Rlimit.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-(*********************************************************)
-(*           Definition of the limit                     *)
-(*                                                       *)
-(*********************************************************)
-
-Require Rbase.
-Require Rfunctions.
-Require Classical_Prop.
-Require Fourier.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(*******************************)
-(*      Calculus               *)
-(*******************************)
-(*********)
-Lemma eps2_Rgt_R0:(eps:R)(Rgt eps R0)->
-      (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
-Intros;Fourier.
-Qed.
-
-(*********)
-Lemma eps2:(eps:R)(Rplus (Rmult eps (Rinv (Rplus R1 R1)))
-                        (Rmult eps (Rinv (Rplus R1 R1))))==eps.
-Intro esp.
-Assert H := (double_var esp).
-Unfold Rdiv in H.
-Symmetry; Exact H.
-Qed.
-
-(*********)
-Lemma eps4:(eps:R)
-  (Rplus (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) )))
-        (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) ))))==
-                  (Rmult eps (Rinv (Rplus R1 R1))).
-Intro eps.
-Replace ``2+2`` with ``2*2``.
-Pattern 3 eps; Rewrite double_var.
-Rewrite (Rmult_Rplus_distrl ``eps/2`` ``eps/2`` ``/2``).
-Unfold Rdiv.
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Reflexivity.
-DiscrR.
-DiscrR.
-Ring.
-Qed.
-
-(*********)
-Lemma Rlt_eps2_eps:(eps:R)(Rgt eps R0)->
-        (Rlt (Rmult eps (Rinv (Rplus R1 R1))) eps).
-Intros.
-Pattern 2 eps; Rewrite <- Rmult_1r.
-Repeat Rewrite (Rmult_sym eps).
-Apply Rlt_monotony_r.
-Exact H.
-Apply Rlt_monotony_contra with ``2``.
-Fourier.
-Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
-Fourier.
-DiscrR.
-Qed.
-
-(*********)
-Lemma Rlt_eps4_eps:(eps:R)(Rgt eps R0)->
-        (Rlt (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1)))) eps).
-Intros.
-Replace ``2+2`` with ``4``.
-Pattern 2 eps; Rewrite <- Rmult_1r.
-Repeat Rewrite (Rmult_sym eps).
-Apply Rlt_monotony_r.
-Exact H.
-Apply Rlt_monotony_contra with ``4``.
-Replace ``4`` with ``2*2``.
-Apply Rmult_lt_pos; Fourier.
-Ring.
-Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
-Fourier.
-DiscrR.
-Ring.
-Qed. 
-
-(*********)
-Lemma prop_eps:(r:R)((eps:R)(Rgt eps R0)->(Rlt r eps))->(Rle r R0).
-Intros;Elim (total_order r R0); Intro.
-Apply Rlt_le; Assumption.
-Elim H0; Intro.
-Apply eq_Rle; Assumption.
-Clear H0;Generalize (H r H1); Intro;Generalize (Rlt_antirefl r);
- Intro;ElimType False; Auto.
-Qed.
-
-(*********)
-Definition mul_factor := [l,l':R](Rinv (Rplus R1 (Rplus (Rabsolu l) 
-                                                        (Rabsolu l')))).
-
-(*********)
-Lemma mul_factor_wd : (l,l':R)
-  ~(Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))==R0.
-Intros;Rewrite (Rplus_sym R1 (Rplus (Rabsolu l) (Rabsolu l')));
- Apply tech_Rplus.
-Cut (Rle (Rabsolu (Rplus l l')) (Rplus (Rabsolu l) (Rabsolu l'))).
-Cut (Rle R0 (Rabsolu (Rplus l l'))).
-Exact (Rle_trans ? ? ?).
-Exact (Rabsolu_pos (Rplus l l')).
-Exact (Rabsolu_triang ? ?).
-Exact Rlt_R0_R1.
-Qed.
-
-(*********)
-Lemma mul_factor_gt:(eps:R)(l,l':R)(Rgt eps R0)->
-      (Rgt (Rmult eps (mul_factor l l')) R0).
-Intros;Unfold Rgt;Rewrite <- (Rmult_Or eps);Apply Rlt_monotony.
-Assumption.
-Unfold mul_factor;Apply Rlt_Rinv;
- Cut (Rle R1 (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))).
-Cut (Rlt R0 R1).
-Exact (Rlt_le_trans ? ? ?).
-Exact Rlt_R0_R1.
-Replace (Rle R1 (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l'))))
- with (Rle (Rplus R1 R0) (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))).
-Apply Rle_compatibility.
-Cut (Rle (Rabsolu (Rplus l l')) (Rplus (Rabsolu l) (Rabsolu l'))).
-Cut (Rle R0 (Rabsolu (Rplus l l'))).
-Exact (Rle_trans ? ? ?).
-Exact (Rabsolu_pos ?).
-Exact (Rabsolu_triang ? ?).
-Rewrite (proj1 ? ? (Rplus_ne R1));Trivial.
-Qed.
-
-(*********)
-Lemma mul_factor_gt_f:(eps:R)(l,l':R)(Rgt eps R0)->
-      (Rgt (Rmin R1 (Rmult eps (mul_factor l l'))) R0).
-Intros;Apply Rmin_Rgt_r;Split.
-Exact Rlt_R0_R1.
-Exact (mul_factor_gt eps l l' H).
-Qed.
-
-
-(*******************************)
-(*      Metric space           *)
-(*******************************)
-
-(*********)
-Record Metric_Space:Type:= {
-   Base:Type;
-   dist:Base->Base->R;
-   dist_pos:(x,y:Base)(Rge (dist x y) R0);
-   dist_sym:(x,y:Base)(dist x y)==(dist y x);
-   dist_refl:(x,y:Base)((dist x y)==R0<->x==y);
-   dist_tri:(x,y,z:Base)(Rle (dist x y) 
-              (Rplus (dist x z) (dist z y))) }.
-
-(*******************************)
-(*     Limit in Metric space   *)
-(*******************************)
-
-(*********)
-Definition limit_in:=
-   [X:Metric_Space; X':Metric_Space; f:(Base X)->(Base X'); 
-    D:(Base X)->Prop; x0:(Base X); l:(Base X')]
-   (eps:R)(Rgt eps R0)->
-   (EXT alp:R | (Rgt alp R0)/\(x:(Base X))(D x)/\
-                (Rlt (dist X x x0) alp)->
-                (Rlt (dist X' (f x) l) eps)). 
-
-(*******************************)
-(*    R is a metric space      *)
-(*******************************)
-
-(*********)
-Definition R_met:Metric_Space:=(Build_Metric_Space R R_dist 
-  R_dist_pos R_dist_sym R_dist_refl R_dist_tri).
-
-(*******************************)
-(*         Limit 1 arg         *)
-(*******************************)
-(*********)
-Definition Dgf:=[Df,Dg:R->Prop][f:R->R][x:R](Df x)/\(Dg (f x)).
-
-(*********)
-Definition limit1_in:(R->R)->(R->Prop)->R->R->Prop:=
-  [f:R->R; D:R->Prop; l:R; x0:R](limit_in R_met R_met f D x0 l).
-
-(*********)
-Lemma tech_limit:(f:R->R)(D:R->Prop)(l:R)(x0:R)(D x0)->
-   (limit1_in f D l x0)->l==(f x0).
-Intros f D l x0 H H0.
-Case (Rabsolu_pos (Rminus (f x0) l)); Intros H1.
-Absurd (Rlt (dist R_met (f x0) l) (dist R_met (f x0) l)).
-Apply Rlt_antirefl.
-Case (H0 (dist R_met (f x0) l)); Auto.
-Intros alpha1 (H2, H3); Apply H3; Auto; Split; Auto.
-Case (dist_refl R_met x0 x0); Intros Hr1 Hr2; Rewrite Hr2; Auto.
-Case (dist_refl R_met (f x0) l); Intros Hr1 Hr2; Apply sym_eqT; Auto.
-Qed.
-
-(*********)
-Lemma tech_limit_contr:(f:R->R)(D:R->Prop)(l:R)(x0:R)(D x0)->~l==(f x0)
-   ->~(limit1_in f D l x0).
-Intros;Generalize (tech_limit f D l x0);Tauto.
-Qed.
-
-(*********)
-Lemma lim_x:(D:R->Prop)(x0:R)(limit1_in [x:R]x D x0 x0).
-Unfold limit1_in; Unfold limit_in; Simpl; Intros;Split with eps;
- Split; Auto;Intros;Elim H0; Intros; Auto.
-Qed.
-
-(*********)
-Lemma limit_plus:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
-   (limit1_in f D l x0)->(limit1_in g D l' x0)->
-   (limit1_in [x:R](Rplus (f x) (g x)) D (Rplus l l') x0).
-Intros;Unfold limit1_in; Unfold limit_in; Simpl; Intros;
- Elim (H (Rmult eps (Rinv (Rplus R1 R1))) (eps2_Rgt_R0 eps H1));
-  Elim (H0 (Rmult eps (Rinv (Rplus R1 R1))) (eps2_Rgt_R0 eps H1));
- Simpl;Clear H H0; Intros; Elim H; Elim H0; Clear H H0; Intros;
-  Split with (Rmin x1 x); Split.
-Exact (Rmin_Rgt_r x1 x R0 (conj ? ? H H2)).
-Intros;Elim H4; Clear H4; Intros;
- Cut (Rlt (Rplus (R_dist (f x2) l) (R_dist (g x2) l')) eps).
- Cut (Rle (R_dist (Rplus (f x2) (g x2)) (Rplus l l'))
-      (Rplus (R_dist (f x2) l) (R_dist (g x2) l'))).
-Exact (Rle_lt_trans ? ? ?).
-Exact (R_dist_plus ? ? ? ?).
-Elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); Clear H5; Intros.
-Generalize (H3 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H4 H6));
- Generalize (H0 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H4 H5));
- Intros;
- Replace eps
- with (Rplus (Rmult eps (Rinv (Rplus R1 R1)))
-        (Rmult eps (Rinv (Rplus R1 R1)))).
-Exact (Rplus_lt ? ? ? ? H7 H8).
-Exact (eps2 eps).
-Qed.
-
-(*********)
-Lemma limit_Ropp:(f:R->R)(D:R->Prop)(l:R)(x0:R)
-   (limit1_in f D l x0)->(limit1_in [x:R](Ropp (f x)) D (Ropp l) x0).
-Unfold limit1_in;Unfold limit_in;Simpl;Intros;Elim (H eps H0);Clear H;
- Intros;Elim H;Clear H;Intros;Split with x;Split;Auto;Intros;
- Generalize (H1 x1 H2);Clear H1;Intro;Unfold R_dist;Unfold Rminus;
- Rewrite (Ropp_Ropp l);Rewrite (Rplus_sym (Ropp (f x1)) l);
- Fold (Rminus l (f x1));Fold (R_dist l (f x1));Rewrite R_dist_sym;
- Assumption.
-Qed.
-
-(*********)
-Lemma limit_minus:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
-   (limit1_in f D l x0)->(limit1_in g D l' x0)->
-   (limit1_in [x:R](Rminus (f x) (g x)) D (Rminus l l') x0).
-Intros;Unfold Rminus;Generalize (limit_Ropp g D l' x0 H0);Intro;
- Exact (limit_plus f [x:R](Ropp (g x)) D l (Ropp l') x0 H H1).
-Qed.
-
-(*********)
-Lemma limit_free:(f:R->R)(D:R->Prop)(x:R)(x0:R)
-   (limit1_in [h:R](f x) D (f x) x0).
-Unfold limit1_in;Unfold limit_in;Simpl;Intros;Split with eps;Split;
- Auto;Intros;Elim (R_dist_refl (f x) (f x));Intros a b;
- Rewrite (b (refl_eqT R (f x)));Unfold Rgt in H;Assumption.
-Qed.
-
-(*********)
-Lemma limit_mul:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
-   (limit1_in f D l x0)->(limit1_in g D l' x0)->
-   (limit1_in [x:R](Rmult (f x) (g x)) D (Rmult l l') x0).
-Intros;Unfold limit1_in; Unfold limit_in; Simpl; Intros; 
- Elim (H (Rmin R1 (Rmult eps (mul_factor l l'))) 
-                   (mul_factor_gt_f eps l l' H1));
- Elim (H0 (Rmult eps (mul_factor l l')) (mul_factor_gt eps l l' H1));
- Clear H H0; Simpl; Intros; Elim H; Elim H0; Clear H H0; Intros;
- Split with (Rmin x1 x); Split.
-Exact (Rmin_Rgt_r x1 x R0 (conj ? ? H H2)).
-Intros; Elim H4; Clear H4; Intros;Unfold R_dist;
- Replace (Rminus (Rmult (f x2) (g x2)) (Rmult l l')) with 
-     (Rplus (Rmult (f x2) (Rminus (g x2) l')) (Rmult l' (Rminus (f x2) l))).
-Cut (Rlt (Rplus (Rabsolu (Rmult (f x2) (Rminus (g x2) l'))) (Rabsolu (Rmult l' 
- (Rminus (f x2) l)))) eps). 
-Cut (Rle (Rabsolu (Rplus (Rmult (f x2) (Rminus (g x2) l')) (Rmult l' (Rminus 
-  (f x2) l)))) (Rplus (Rabsolu (Rmult (f x2) (Rminus (g x2) l'))) (Rabsolu 
-        (Rmult l' (Rminus (f x2) l))))).
-Exact (Rle_lt_trans ? ? ?).
-Exact (Rabsolu_triang ? ?).
-Rewrite (Rabsolu_mult (f x2) (Rminus (g x2) l'));
- Rewrite (Rabsolu_mult l' (Rminus (f x2) l));
- Cut (Rle (Rplus (Rmult (Rplus R1 (Rabsolu l)) (Rmult eps (mul_factor l l'))) 
-   (Rmult (Rabsolu l') (Rmult eps (mul_factor l l')))) eps).
-Cut (Rlt (Rplus (Rmult (Rabsolu (f x2)) (Rabsolu (Rminus (g x2) l'))) (Rmult 
-  (Rabsolu l') (Rabsolu (Rminus (f x2) l)))) (Rplus (Rmult (Rplus R1 (Rabsolu 
-     l)) (Rmult eps (mul_factor l l'))) (Rmult (Rabsolu l') (Rmult eps 
-      (mul_factor l l'))))).
-Exact (Rlt_le_trans ? ? ?).
-Elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); Clear H5; Intros;
- Generalize (H0 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H4 H5));Intro;
- Generalize (Rmin_Rgt_l ? ? ? H7);Intro;Elim H8;Intros;Clear H0 H8;
- Apply Rplus_lt_le_lt.
-Apply Rmult_lt_0.
-Apply Rle_sym1.
-Exact (Rabsolu_pos (Rminus (g x2) l')).
-Rewrite (Rplus_sym R1 (Rabsolu l));Unfold Rgt;Apply Rlt_r_plus_R1;
- Exact (Rabsolu_pos l).
-Unfold R_dist in H9;
- Apply (Rlt_anti_compatibility (Ropp (Rabsolu l)) (Rabsolu (f x2)) 
-     (Rplus R1 (Rabsolu l))).
-Rewrite <- (Rplus_assoc (Ropp (Rabsolu l)) R1 (Rabsolu l));
- Rewrite (Rplus_sym (Ropp (Rabsolu l)) R1);
- Rewrite (Rplus_assoc R1 (Ropp (Rabsolu l)) (Rabsolu l));
- Rewrite (Rplus_Ropp_l (Rabsolu l));
- Rewrite (proj1 ? ? (Rplus_ne R1));
- Rewrite (Rplus_sym (Ropp (Rabsolu l)) (Rabsolu (f x2)));
- Generalize H9;
-Cut (Rle (Rminus (Rabsolu (f x2)) (Rabsolu l)) (Rabsolu (Rminus (f x2) l))).
-Exact (Rle_lt_trans ? ? ?).
-Exact (Rabsolu_triang_inv ? ?).
-Generalize (H3 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H4 H6));Trivial.
-Apply Rle_monotony.
-Exact (Rabsolu_pos l').
-Unfold Rle;Left;Assumption.
-Rewrite (Rmult_sym (Rplus R1 (Rabsolu l)) (Rmult eps (mul_factor l l')));
- Rewrite (Rmult_sym (Rabsolu l') (Rmult eps (mul_factor l l')));
- Rewrite <- (Rmult_Rplus_distr
-           (Rmult eps (mul_factor l l'))
-           (Rplus R1 (Rabsolu l))
-           (Rabsolu l'));
- Rewrite (Rmult_assoc eps (mul_factor l l') (Rplus (Rplus R1 (Rabsolu l)) 
-      (Rabsolu l')));
- Rewrite (Rplus_assoc R1 (Rabsolu l) (Rabsolu l'));Unfold mul_factor;
- Rewrite (Rinv_l (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l'))) 
-  (mul_factor_wd l l'));
- Rewrite (proj1 ? ? (Rmult_ne eps));Apply eq_Rle;Trivial.
-Ring.
-Qed.
-
-(*********)
-Definition adhDa:(R->Prop)->R->Prop:=[D:R->Prop][a:R]
-  (alp:R)(Rgt alp R0)->(EXT x:R | (D x)/\(Rlt (R_dist x a) alp)).
-
-(*********)
-Lemma single_limit:(f:R->R)(D:R->Prop)(l:R)(l':R)(x0:R)
-  (adhDa D x0)->(limit1_in f D l x0)->(limit1_in f D l' x0)->l==l'.
-Unfold limit1_in; Unfold limit_in; Intros.
-Cut (eps:R)(Rgt eps R0)->(Rlt (dist R_met l l') 
-                              (Rmult (Rplus R1 R1) eps)).
-Clear H0 H1;Unfold dist; Unfold R_met; Unfold R_dist; 
- Unfold Rabsolu;Case (case_Rabsolu (Rminus l l')); Intros.
-Cut (eps:R)(Rgt eps R0)->(Rlt (Ropp (Rminus l l')) eps).
-Intro;Generalize (prop_eps (Ropp (Rminus l l')) H1);Intro;
- Generalize (Rlt_RoppO (Rminus l l') r); Intro;Unfold Rgt in H3;
- Generalize (Rle_not (Ropp (Rminus l l')) R0 H3); Intro;
- ElimType False; Auto.
-Intros;Cut (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
-Intro;Generalize (H0 (Rmult eps (Rinv (Rplus R1 R1))) H2);
- Rewrite (Rmult_sym eps (Rinv (Rplus R1 R1)));
- Rewrite <- (Rmult_assoc (Rplus R1 R1) (Rinv (Rplus R1 R1)) eps);
- Rewrite (Rinv_r (Rplus R1 R1)).
-Elim (Rmult_ne eps);Intros a b;Rewrite b;Clear a b;Trivial.
-Apply (imp_not_Req (Rplus R1 R1) R0);Right;Generalize Rlt_R0_R1;Intro;
- Unfold Rgt;Generalize (Rlt_compatibility R1 R0 R1 H3);Intro;
- Elim (Rplus_ne R1);Intros a b;Rewrite a in H4;Clear a b; 
- Apply (Rlt_trans R0 R1 (Rplus R1 R1) H3 H4).
-Unfold Rgt;Unfold Rgt in H1;
- Rewrite (Rmult_sym eps(Rinv (Rplus R1 R1)));
- Rewrite <-(Rmult_Or (Rinv (Rplus R1 R1)));
- Apply (Rlt_monotony (Rinv (Rplus R1 R1)) R0 eps);Auto.
-Apply (Rlt_Rinv (Rplus R1 R1));Cut (Rlt R1 (Rplus R1 R1)).
-Intro;Apply (Rlt_trans R0 R1 (Rplus R1 R1) Rlt_R0_R1 H2).
-Generalize (Rlt_compatibility R1 R0 R1 Rlt_R0_R1);Elim (Rplus_ne R1);
- Intros a b;Rewrite a;Clear a b;Trivial.
-(**)
-Cut (eps:R)(Rgt eps R0)->(Rlt (Rminus l l') eps).
-Intro;Generalize (prop_eps (Rminus l l') H1);Intro;
- Elim (Rle_le_eq (Rminus l l') R0);Intros a b;Clear b;
- Apply (Rminus_eq l l');Apply a;Split.
-Assumption.
-Apply (Rle_sym2 R0 (Rminus l l') r).
-Intros;Cut (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
-Intro;Generalize (H0 (Rmult eps (Rinv (Rplus R1 R1))) H2);
- Rewrite (Rmult_sym eps (Rinv (Rplus R1 R1)));
- Rewrite <- (Rmult_assoc (Rplus R1 R1) (Rinv (Rplus R1 R1)) eps);
- Rewrite (Rinv_r (Rplus R1 R1)).
-Elim (Rmult_ne eps);Intros a b;Rewrite b;Clear a b;Trivial.
-Apply (imp_not_Req (Rplus R1 R1) R0);Right;Generalize Rlt_R0_R1;Intro;
- Unfold Rgt;Generalize (Rlt_compatibility R1 R0 R1 H3);Intro;
- Elim (Rplus_ne R1);Intros a b;Rewrite a in H4;Clear a b; 
- Apply (Rlt_trans R0 R1 (Rplus R1 R1) H3 H4).
-Unfold Rgt;Unfold Rgt in H1;
- Rewrite (Rmult_sym eps(Rinv (Rplus R1 R1)));
- Rewrite <-(Rmult_Or (Rinv (Rplus R1 R1)));
- Apply (Rlt_monotony (Rinv (Rplus R1 R1)) R0 eps);Auto.
-Apply (Rlt_Rinv (Rplus R1 R1));Cut (Rlt R1 (Rplus R1 R1)).
-Intro;Apply (Rlt_trans R0 R1 (Rplus R1 R1) Rlt_R0_R1 H2).
-Generalize (Rlt_compatibility R1 R0 R1 Rlt_R0_R1);Elim (Rplus_ne R1);
- Intros a b;Rewrite a;Clear a b;Trivial.
-(**)
-Intros;Unfold adhDa in H;Elim (H0 eps H2);Intros;Elim (H1 eps H2);
- Intros;Clear H0 H1;Elim H3;Elim H4;Clear H3 H4;Intros;
- Simpl;Simpl in H1 H4;Generalize (Rmin_Rgt x x1 R0);Intro;Elim H5;
- Intros;Clear H5;
- Elim (H (Rmin x x1) (H7 (conj (Rgt x R0) (Rgt x1 R0) H3 H0)));
- Intros; Elim H5;Intros;Clear H5 H H6 H7;
- Generalize (Rmin_Rgt x x1 (R_dist x2 x0));Intro;Elim H;
- Intros;Clear H H6;Unfold Rgt in H5;Elim (H5 H9);Intros;Clear H5 H9;
- Generalize (H1 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H8 H6));
- Generalize (H4 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H8 H));
- Clear H8 H H6 H1 H4 H0 H3;Intros;
- Generalize (Rplus_lt (R_dist (f x2) l) eps (R_dist (f x2) l') eps 
-  H H0); Unfold R_dist;Intros;
- Rewrite (Rabsolu_minus_sym (f x2) l) in H1;
- Rewrite (Rmult_sym (Rplus R1 R1) eps);Rewrite (Rmult_Rplus_distr eps R1 R1);
- Elim (Rmult_ne eps);Intros a b;Rewrite a;Clear a b;
- Generalize (R_dist_tri l l' (f x2));Unfold R_dist;Intros;
- Apply (Rle_lt_trans (Rabsolu (Rminus l l')) 
-  (Rplus (Rabsolu (Rminus l (f x2))) (Rabsolu (Rminus (f x2) l')))
-  (Rplus eps eps) H3 H1).
-Qed.
-
-(*********)
-Lemma limit_comp:(f,g:R->R)(Df,Dg:R->Prop)(l,l':R)(x0:R)
-   (limit1_in f Df l x0)->(limit1_in g Dg l' l)->
-   (limit1_in [x:R](g (f x)) (Dgf Df Dg f) l' x0).
-Unfold limit1_in limit_in Dgf;Simpl.
-Intros f g Df Dg l l' x0 Hf Hg eps eps_pos.
-Elim (Hg eps eps_pos).
-Intros alpg lg.
-Elim (Hf alpg).
-2: Tauto.
-Intros alpf lf.
-Exists alpf.
-Intuition.
-Qed.
-
-(*********)
-
-Lemma limit_inv : (f:R->R)(D:R->Prop)(l:R)(x0:R) (limit1_in f D l x0)->~(l==R0)->(limit1_in [x:R](Rinv (f x)) D (Rinv l) x0).
-Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H ``(Rabsolu l)/2``).
-Intros delta1 H2; Elim (H ``eps*((Rsqr l)/2)``).
-Intros delta2 H3; Elim H2; Elim H3; Intros; Exists (Rmin delta1 delta2); Split.
-Unfold Rmin; Case (total_order_Rle delta1 delta2); Intro; Assumption.
-Intro; Generalize (H5 x); Clear H5; Intro H5; Generalize (H7 x); Clear H7; Intro H7; Intro H10; Elim H10; Intros; Cut (D x)/\``(Rabsolu (x-x0))<delta1``.
-Cut (D x)/\``(Rabsolu (x-x0))<delta2``.
-Intros; Generalize (H5 H11); Clear H5; Intro H5; Generalize (H7 H12); Clear H7; Intro H7; Generalize (Rabsolu_triang_inv l (f x)); Intro; Rewrite Rabsolu_minus_sym in H7; Generalize (Rle_lt_trans ``(Rabsolu l)-(Rabsolu (f x))`` ``(Rabsolu (l-(f x)))`` ``(Rabsolu l)/2`` H13 H7); Intro; Generalize (Rlt_compatibility ``(Rabsolu (f x))-(Rabsolu l)/2`` ``(Rabsolu l)-(Rabsolu (f x))`` ``(Rabsolu l)/2`` H14); Replace ``(Rabsolu (f x))-(Rabsolu l)/2+((Rabsolu l)-(Rabsolu (f x)))`` with ``(Rabsolu l)/2``.
-Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Intro; Cut ~``(f x)==0``.
-Intro; Replace ``/(f x)+ -/l`` with ``(l-(f x))*/(l*(f x))``.
-Rewrite Rabsolu_mult; Rewrite Rabsolu_Rinv.
-Cut ``/(Rabsolu (l*(f x)))<2/(Rsqr l)``.
-Intro; Rewrite Rabsolu_minus_sym in H5; Cut ``0<=/(Rabsolu (l*(f x)))``.
-Intro; Generalize (Rmult_lt2 ``(Rabsolu (l-(f x)))`` ``eps*(Rsqr l)/2`` ``/(Rabsolu (l*(f x)))`` ``2/(Rsqr l)`` (Rabsolu_pos ``l-(f x)``) H18 H5 H17); Replace ``eps*(Rsqr l)/2*2/(Rsqr l)`` with ``eps``.
-Intro; Assumption.
-Unfold Rdiv; Unfold Rsqr; Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym l).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym l).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Reflexivity.
-DiscrR.
-Exact H0.
-Exact H0.
-Exact H0.
-Exact H0.
-Left; Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply prod_neq_R0; Assumption.
-Rewrite Rmult_sym; Rewrite Rabsolu_mult; Rewrite Rinv_Rmult.
-Rewrite (Rsqr_abs l); Unfold Rsqr; Unfold Rdiv; Rewrite Rinv_Rmult.
-Repeat Rewrite <- Rmult_assoc; Apply Rlt_monotony_r.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Apply Rlt_monotony_contra with ``(Rabsolu (f x))*(Rabsolu l)*/2``.
-Repeat Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H17; Generalize (lt_INR_0 (2) (neq_O_lt (2) H17)); Unfold INR; Intro H18; Assumption | Discriminate].
-Replace ``(Rabsolu (f x))*(Rabsolu l)*/2*/(Rabsolu (f x))`` with ``(Rabsolu l)/2``.
-Replace ``(Rabsolu (f x))*(Rabsolu l)*/2*(2*/(Rabsolu l))`` with ``(Rabsolu (f x))``.
-Assumption.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (Rabsolu l)).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Reflexivity.
-DiscrR.
-Apply Rabsolu_no_R0.
-Assumption.
-Unfold Rdiv.
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (Rabsolu (f x))).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Reflexivity.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Apply Rabsolu_no_R0; Assumption.
-Apply prod_neq_R0; Assumption.
-Rewrite (Rinv_Rmult ? ? H0 H16).
-Unfold Rminus; Rewrite Rmult_Rplus_distrl.
-Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Rewrite Ropp_mul1.
-Rewrite (Rmult_sym (f x)).
-Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Reflexivity.
-Assumption.
-Assumption.
-Red; Intro; Rewrite H16 in H15; Rewrite Rabsolu_R0 in H15; Cut ``0<(Rabsolu l)/2``.
-Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(Rabsolu l)/2`` ``0`` H17 H15)).
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt; Assumption.
-Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H17; Generalize (lt_INR_0 (2) (neq_O_lt (2) H17)); Unfold INR; Intro; Assumption | Discriminate].
-Pattern 3 (Rabsolu l); Rewrite double_var.
-Ring.
-Split; [Assumption | Apply Rlt_le_trans with (Rmin delta1 delta2); [Assumption | Apply Rmin_r]].
-Split; [Assumption | Apply Rlt_le_trans with (Rmin delta1 delta2); [Assumption | Apply Rmin_l]].
-Change ``0<eps*(Rsqr l)/2``; Unfold Rdiv; Repeat Rewrite Rmult_assoc; Repeat Apply Rmult_lt_pos.
-Assumption.
-Apply Rsqr_pos_lt; Assumption.
-Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H3; Generalize (lt_INR_0 (2) (neq_O_lt (2) H3)); Unfold INR; Intro; Assumption | Discriminate].
-Change ``0<(Rabsolu l)/2``; Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H3; Generalize (lt_INR_0 (2) (neq_O_lt (2) H3)); Unfold INR; Intro; Assumption | Discriminate]].
-Qed.
diff --git a/theories7/Reals/Rpower.v b/theories7/Reals/Rpower.v
deleted file mode 100644
index 0acfa8d2..00000000
--- a/theories7/Reals/Rpower.v
+++ /dev/null
@@ -1,560 +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: Rpower.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-(*i Due to L.Thery i*) 
-
-(************************************************************)
-(* Definitions of log and Rpower : R->R->R; main properties *)
-(************************************************************)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis1.
-Require Exp_prop.
-Require Rsqrt_def.
-Require R_sqrt.
-Require MVT.
-Require Ranalysis4.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Lemma P_Rmin: (P : R ->  Prop) (x, y : R) (P x) -> (P y) ->  (P (Rmin x y)).
-Intros P x y H1 H2; Unfold Rmin; Case (total_order_Rle x y); Intro; Assumption.
-Qed.
-
-Lemma exp_le_3 :  ``(exp 1)<=3``.
-Assert exp_1 : ``(exp 1)<>0``.
-Assert H0 := (exp_pos R1); Red; Intro; Rewrite H in H0; Elim (Rlt_antirefl ? H0).
-Apply Rle_monotony_contra with ``/(exp 1)``.
-Apply Rlt_Rinv; Apply exp_pos.
-Rewrite <- Rinv_l_sym.
-Apply Rle_monotony_contra with ``/3``.
-Apply Rlt_Rinv; Sup0.
-Rewrite Rmult_1r; Rewrite <- (Rmult_sym ``3``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Replace ``/(exp 1)`` with ``(exp (-1))``.
-Unfold exp; Case (exist_exp ``-1``); Intros; Simpl; Unfold exp_in in e; Assert H := (alternated_series_ineq [i:nat]``/(INR (fact i))`` x (S O)).
-Cut ``(sum_f_R0 (tg_alt [([i:nat]``/(INR (fact i))``)]) (S (mult (S (S O)) (S O)))) <= x <= (sum_f_R0 (tg_alt [([i:nat]``/(INR (fact i))``)]) (mult (S (S O)) (S O)))``.
-Intro; Elim H0; Clear H0; Intros H0 _; Simpl in H0; Unfold tg_alt in H0; Simpl in H0.
-Replace ``/3`` with ``1*/1+ -1*1*/1+ -1*( -1*1)*/2+ -1*( -1*( -1*1))*/(2+1+1+1+1)``.
-Apply H0.
-Repeat Rewrite Rinv_R1; Repeat Rewrite Rmult_1r; Rewrite Ropp_mul1; Rewrite Rmult_1l; Rewrite Ropp_Ropp; Rewrite Rplus_Ropp_r; Rewrite Rmult_1r; Rewrite Rplus_Ol; Rewrite Rmult_1l; Apply r_Rmult_mult with ``6``.
-Rewrite Rmult_Rplus_distr; Replace ``2+1+1+1+1`` with ``6``.
-Rewrite <- (Rmult_sym ``/6``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Replace ``6`` with ``2*3``.
-Do 2 Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``3``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Ring.
-DiscrR.
-DiscrR.
-Ring.
-DiscrR.
-Ring.
-DiscrR.
-Apply H.
-Unfold Un_decreasing; Intros; Apply Rle_monotony_contra with ``(INR (fact n))``.
-Apply INR_fact_lt_0.
-Apply Rle_monotony_contra with ``(INR (fact (S n)))``.
-Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Apply le_INR; Apply fact_growing; Apply le_n_Sn.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Assert H0 := (cv_speed_pow_fact R1); Unfold Un_cv; Unfold Un_cv in H0; Intros; Elim (H0 ? H1); Intros; Exists x0; Intros; Unfold R_dist in H2; Unfold R_dist; Replace ``/(INR (fact n))`` with ``(pow 1 n)/(INR (fact n))``.
-Apply (H2 ? H3).
-Unfold Rdiv; Rewrite pow1; Rewrite Rmult_1l; Reflexivity.
-Unfold infinit_sum in e; Unfold Un_cv tg_alt; Intros; Elim (e ? H0); Intros; Exists x0; Intros; Replace (sum_f_R0 ([i:nat]``(pow ( -1) i)*/(INR (fact i))``) n) with (sum_f_R0 ([i:nat]``/(INR (fact i))*(pow ( -1) i)``) n).
-Apply (H1 ? H2).
-Apply sum_eq; Intros; Apply Rmult_sym.
-Apply r_Rmult_mult with ``(exp 1)``.
-Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0; Rewrite <- Rinv_r_sym.
-Reflexivity.
-Assumption.
-Assumption.
-DiscrR.
-Assumption.
-Qed.
-
-(******************************************************************)
-(*                        Properties of  Exp                      *)
-(******************************************************************)
-
-Theorem exp_increasing: (x, y : R) ``x<y`` -> ``(exp x)<(exp y)``.
-Intros x y H.
-Assert H0 : (derivable exp).
-Apply derivable_exp.
-Assert H1 := (positive_derivative ? H0).
-Unfold strict_increasing in H1.
-Apply H1.
-Intro.
-Replace (derive_pt exp x0 (H0 x0)) with (exp x0).
-Apply exp_pos.
-Symmetry; Apply derive_pt_eq_0.
-Apply (derivable_pt_lim_exp x0).
-Apply H.
-Qed.
- 
-Theorem exp_lt_inv: (x, y : R) ``(exp x)<(exp y)`` -> ``x<y``.
-Intros x y H; Case (total_order x y); [Intros H1 | Intros [H1|H1]].
-Assumption.
-Rewrite H1 in H; Elim (Rlt_antirefl ? H).
-Assert H2 := (exp_increasing ? ? H1).
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H H2)).
-Qed.
- 
-Lemma exp_ineq1 : (x:R) ``0<x`` -> ``1+x < (exp x)``.
-Intros; Apply Rlt_anti_compatibility with ``-(exp 0)``; Rewrite <- (Rplus_sym (exp x)); Assert H0 := (MVT_cor1 exp R0 x derivable_exp H); Elim H0; Intros; Elim H1; Intros; Unfold Rminus in H2; Rewrite H2; Rewrite Ropp_O; Rewrite Rplus_Or; Replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0).
-Rewrite exp_0; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Pattern 1 x; Rewrite <- Rmult_1r; Rewrite (Rmult_sym (exp x0)); Apply Rlt_monotony.
-Apply H.
-Rewrite <- exp_0; Apply exp_increasing; Elim H3; Intros; Assumption.
-Symmetry; Apply derive_pt_eq_0; Apply derivable_pt_lim_exp.
-Qed.
-
-Lemma ln_exists1 : (y:R) ``0<y``->``1<=y``->(sigTT R [z:R]``y==(exp z)``).
-Intros; Pose f := [x:R]``(exp x)-y``; Cut ``(f 0)<=0``.
-Intro; Cut (continuity f).
-Intro; Cut ``0<=(f y)``.
-Intro; Cut ``(f 0)*(f y)<=0``.
-Intro; Assert X := (IVT_cor f R0 y H2 (Rlt_le ? ? H) H4); Elim X; Intros t H5; Apply existTT with t; Elim H5; Intros; Unfold f in H7; Apply Rminus_eq_right; Exact H7.
-Pattern 2 R0; Rewrite <- (Rmult_Or (f y)); Rewrite (Rmult_sym (f R0)); Apply Rle_monotony; Assumption.
-Unfold f; Apply Rle_anti_compatibility with y; Left; Apply Rlt_trans with ``1+y``.
-Rewrite <- (Rplus_sym y); Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Replace ``y+((exp y)-y)`` with (exp y); [Apply (exp_ineq1 y H) | Ring].
-Unfold f; Change (continuity (minus_fct exp (fct_cte y))); Apply continuity_minus; [Apply derivable_continuous; Apply derivable_exp | Apply derivable_continuous; Apply derivable_const].
-Unfold f; Rewrite exp_0; Apply Rle_anti_compatibility with y; Rewrite Rplus_Or; Replace ``y+(1-y)`` with R1; [Apply H0 | Ring].
-Qed.
-
-(**********)
-Lemma ln_exists : (y:R) ``0<y`` -> (sigTT R [z:R]``y==(exp z)``).
-Intros; Case (total_order_Rle R1 y); Intro.
-Apply (ln_exists1 ? H r).
-Assert H0 : ``1<=/y``.
-Apply Rle_monotony_contra with y.
-Apply H.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Left; Apply (not_Rle ? ? n).
-Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
-Assert H1 : ``0</y``.
-Apply Rlt_Rinv; Apply H.
-Assert H2 := (ln_exists1 ? H1 H0); Elim H2; Intros; Apply existTT with ``-x``; Apply r_Rmult_mult with ``(exp x)/y``.
-Unfold Rdiv; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite <- (Rmult_sym ``/y``); Rewrite Rmult_assoc; Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0; Rewrite Rmult_1r; Symmetry; Apply p.
-Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
-Unfold Rdiv; Apply prod_neq_R0.
-Assert H3 := (exp_pos x); Red; Intro; Rewrite H4 in H3; Elim (Rlt_antirefl ? H3).
-Apply Rinv_neq_R0; Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
-Qed.
-
-(* Definition of log R+* -> R *)
-Definition Rln [y:posreal] : R := Cases (ln_exists (pos y) (RIneq.cond_pos y)) of (existTT a b) => a end.
-
-(* Extension on R *)
-Definition ln : R->R := [x:R](Cases (total_order_Rlt R0 x) of
-      (leftT a) => (Rln (mkposreal x a)) 
-    | (rightT a) => R0 end).
-
-Lemma exp_ln :  (x : R) ``0<x`` ->  (exp (ln x)) == x.
-Intros; Unfold ln; Case (total_order_Rlt R0 x); Intro.
-Unfold Rln; Case (ln_exists (mkposreal x r) (RIneq.cond_pos (mkposreal x r))); Intros.
-Simpl in e; Symmetry; Apply e.
-Elim n; Apply H.
-Qed.
-
-Theorem exp_inv: (x, y : R) (exp x) == (exp y) ->  x == y.
-Intros x y H; Case (total_order x y); [Intros H1 | Intros [H1|H1]]; Auto; Assert H2 := (exp_increasing ? ? H1); Rewrite H in H2; Elim (Rlt_antirefl ? H2).
-Qed.
- 
-Theorem exp_Ropp: (x : R)  ``(exp (-x)) == /(exp x)``.
-Intros x; Assert H : ``(exp x)<>0``.
-Assert H := (exp_pos x); Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
-Apply r_Rmult_mult with r := (exp x).
-Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0.
-Apply Rinv_r_sym.
-Apply H.
-Apply H.
-Qed.
- 
-(******************************************************************)
-(*                        Properties of  Ln                       *)
-(******************************************************************)
-
-Theorem ln_increasing:
- (x, y : R) ``0<x`` -> ``x<y`` -> ``(ln x) < (ln y)``.
-Intros x y H H0; Apply exp_lt_inv.
-Repeat  Rewrite exp_ln. 
-Apply H0.
-Apply Rlt_trans with x; Assumption.
-Apply H.
-Qed.
-
-Theorem ln_exp: (x : R)  (ln (exp x)) == x.
-Intros x; Apply exp_inv.
-Apply exp_ln.
-Apply exp_pos.
-Qed.
- 
-Theorem ln_1: ``(ln 1) == 0``.
-Rewrite <- exp_0; Rewrite ln_exp; Reflexivity.
-Qed.
- 
-Theorem ln_lt_inv:
- (x, y : R) ``0<x`` -> ``0<y`` -> ``(ln x)<(ln y)`` ->  ``x<y``.
-Intros x y H H0 H1; Rewrite <- (exp_ln x); Try Rewrite <- (exp_ln y).
-Apply exp_increasing; Apply H1.
-Assumption. 
-Assumption.
-Qed.
- 
-Theorem ln_inv: (x, y : R) ``0<x`` -> ``0<y`` -> (ln x) == (ln y) ->  x == y.
-Intros x y H H0 H'0; Case (total_order x y); [Intros H1 | Intros [H1|H1]]; Auto.
-Assert H2 := (ln_increasing ? ? H H1); Rewrite H'0 in H2; Elim (Rlt_antirefl ? H2).
-Assert H2 := (ln_increasing ? ? H0 H1); Rewrite H'0 in H2; Elim (Rlt_antirefl ? H2).
-Qed.
- 
-Theorem ln_mult: (x, y : R) ``0<x`` -> ``0<y`` ->  ``(ln (x*y)) == (ln x)+(ln y)``.
-Intros x y H H0; Apply exp_inv.
-Rewrite exp_plus.
-Repeat Rewrite exp_ln.
-Reflexivity.
-Assumption.
-Assumption.
-Apply Rmult_lt_pos; Assumption.
-Qed.
-
-Theorem ln_Rinv: (x : R) ``0<x`` ->  ``(ln (/x)) == -(ln x)``.
-Intros x H; Apply exp_inv; Repeat (Rewrite exp_ln Orelse Rewrite exp_Ropp).
-Reflexivity.
-Assumption. 
-Apply Rlt_Rinv; Assumption.
-Qed.
-
-Theorem ln_continue:
- (y : R) ``0<y`` ->  (continue_in ln [x : R]  (Rlt R0 x) y).
-Intros y H.
-Unfold continue_in limit1_in limit_in; Intros eps Heps.
-Cut (Rlt R1 (exp eps)); [Intros H1 | Idtac].
-Cut (Rlt (exp (Ropp eps)) R1); [Intros H2 | Idtac].
-Exists
- (Rmin (Rmult y (Rminus (exp eps) R1)) (Rmult y (Rminus R1 (exp (Ropp eps)))));
- Split.
-Red; Apply P_Rmin.
-Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_anti_compatibility with R1.
-Rewrite Rplus_Or; Replace ``(1+((exp eps)-1))`` with (exp eps); [Apply H1 | Ring].
-Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_anti_compatibility with ``(exp (-eps))``.
-Rewrite Rplus_Or; Replace ``(exp ( -eps))+(1-(exp ( -eps)))`` with R1; [Apply H2 | Ring].
-Unfold dist R_met R_dist; Simpl.
-Intros x ((H3, H4), H5).
-Cut (Rmult y (Rmult x (Rinv y))) == x.
-Intro Hxyy. 
-Replace (Rminus (ln x) (ln y)) with (ln (Rmult x (Rinv y))).
-Case (total_order x y); [Intros Hxy | Intros [Hxy|Hxy]].
-Rewrite Rabsolu_left.
-Apply Ropp_Rlt; Rewrite Ropp_Ropp.
-Apply exp_lt_inv.
-Rewrite exp_ln.
-Apply Rlt_monotony_contra with z := y.
-Apply H.
-Rewrite Hxyy.
-Apply Ropp_Rlt.
-Apply Rlt_anti_compatibility with r := y.
-Replace (Rplus y (Ropp (Rmult y (exp (Ropp eps)))))
-     with (Rmult y (Rminus R1 (exp (Ropp eps)))); [Idtac | Ring].
-Replace (Rplus y (Ropp x)) with (Rabsolu (Rminus x y)); [Idtac | Ring].
-Apply Rlt_le_trans with 1 := H5; Apply Rmin_r.
-Rewrite Rabsolu_left; [Ring | Idtac].
-Apply (Rlt_minus ? ? Hxy).
-Apply Rmult_lt_pos; [Apply H3  | Apply (Rlt_Rinv ? H)].
-Rewrite <- ln_1.
-Apply ln_increasing.
-Apply Rmult_lt_pos; [Apply H3  | Apply (Rlt_Rinv ? H)].
-Apply Rlt_monotony_contra with z := y.
-Apply H.
-Rewrite Hxyy; Rewrite Rmult_1r; Apply Hxy.
-Rewrite Hxy; Rewrite Rinv_r.
-Rewrite ln_1; Rewrite Rabsolu_R0; Apply Heps.
-Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
-Rewrite Rabsolu_right.
-Apply exp_lt_inv.
-Rewrite exp_ln.
-Apply Rlt_monotony_contra with z := y.
-Apply H.
-Rewrite Hxyy.
-Apply Rlt_anti_compatibility with r := (Ropp y).
-Replace (Rplus (Ropp y) (Rmult y (exp eps)))
-     with (Rmult y (Rminus (exp eps) R1)); [Idtac | Ring].
-Replace (Rplus (Ropp y) x) with (Rabsolu (Rminus x y)); [Idtac | Ring].
-Apply Rlt_le_trans with 1 := H5; Apply Rmin_l.
-Rewrite Rabsolu_right; [Ring | Idtac].
-Left; Apply (Rgt_minus ? ? Hxy).
-Apply Rmult_lt_pos; [Apply H3  | Apply (Rlt_Rinv ? H)].
-Rewrite <- ln_1.
-Apply Rgt_ge; Red; Apply ln_increasing.
-Apply Rlt_R0_R1.
-Apply Rlt_monotony_contra with z := y.
-Apply H.
-Rewrite Hxyy; Rewrite Rmult_1r; Apply Hxy.
-Rewrite ln_mult.
-Rewrite ln_Rinv.
-Ring.
-Assumption.
-Assumption.
-Apply Rlt_Rinv; Assumption.
-Rewrite (Rmult_sym x); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Ring.
-Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
-Apply Rlt_monotony_contra with (exp eps).
-Apply exp_pos.
-Rewrite <- exp_plus; Rewrite Rmult_1r; Rewrite Rplus_Ropp_r; Rewrite exp_0; Apply H1.
-Rewrite <- exp_0.
-Apply exp_increasing; Apply Heps.
-Qed.
-
-(******************************************************************)
-(*                        Definition of  Rpower                   *)
-(******************************************************************)
- 
-Definition Rpower := [x : R] [y : R]  ``(exp (y*(ln x)))``.
-
-Infix Local "^R" Rpower (at level 2, left associativity) : R_scope.
-
-(******************************************************************)
-(*                        Properties of  Rpower                   *)
-(******************************************************************)
- 
-Theorem Rpower_plus:
- (x, y, z : R)  ``(Rpower z (x+y)) == (Rpower z x)*(Rpower z y)``.
-Intros x y z; Unfold Rpower.
-Rewrite Rmult_Rplus_distrl; Rewrite exp_plus; Auto.
-Qed.
- 
-Theorem Rpower_mult:
- (x, y, z : R)  ``(Rpower (Rpower x y) z) == (Rpower x (y*z))``.
-Intros x y z; Unfold Rpower.
-Rewrite ln_exp.
-Replace (Rmult z (Rmult y (ln x))) with (Rmult (Rmult y z) (ln x)).
-Reflexivity.
-Ring.
-Qed.
- 
-Theorem Rpower_O: (x : R) ``0<x`` ->  ``(Rpower x 0) == 1``.
-Intros x H; Unfold Rpower.
-Rewrite Rmult_Ol; Apply exp_0.
-Qed.
- 
-Theorem Rpower_1: (x : R) ``0<x`` ->  ``(Rpower x 1) == x``.
-Intros x H; Unfold Rpower.
-Rewrite Rmult_1l; Apply exp_ln; Apply H.
-Qed.
- 
-Theorem Rpower_pow:
- (n : nat) (x : R) ``0<x`` ->  (Rpower x (INR n)) == (pow x n).
-Intros n; Elim n; Simpl; Auto; Fold INR.
-Intros x H; Apply Rpower_O; Auto.
-Intros n1; Case n1.
-Intros H x H0; Simpl; Rewrite Rmult_1r; Apply Rpower_1; Auto.
-Intros n0 H x H0; Rewrite Rpower_plus; Rewrite H; Try Rewrite Rpower_1; Try Apply Rmult_sym Orelse Assumption.
-Qed.
- 
-Theorem Rpower_lt: (x, y, z : R) ``1<x`` -> ``0<=y`` -> ``y<z`` ->  ``(Rpower x y) < (Rpower x z)``.
-Intros x y z H H0 H1.
-Unfold Rpower.
-Apply exp_increasing.
-Apply Rlt_monotony_r.
-Rewrite <- ln_1; Apply ln_increasing.
-Apply Rlt_R0_R1.
-Apply H.
-Apply H1.
-Qed.
- 
-Theorem Rpower_sqrt: (x : R) ``0<x`` ->  ``(Rpower x (/2)) == (sqrt x)``.
-Intros x H.
-Apply ln_inv.
-Unfold Rpower; Apply exp_pos.
-Apply sqrt_lt_R0; Apply H.
-Apply r_Rmult_mult with (INR (S (S O))).
-Apply exp_inv.
-Fold Rpower.
-Cut (Rpower (Rpower x (Rinv (Rplus R1 R1))) (INR (S (S O)))) == (Rpower (sqrt x) (INR (S (S O)))).
-Unfold Rpower; Auto.
-Rewrite Rpower_mult.
-Rewrite Rinv_l.
-Replace R1 with (INR (S O)); Auto.
-Repeat Rewrite Rpower_pow; Simpl.
-Pattern 1 x; Rewrite <- (sqrt_sqrt x (Rlt_le ? ? H)).
-Ring.
-Apply sqrt_lt_R0; Apply H.
-Apply H.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Qed.
- 
-Theorem Rpower_Ropp: (x, y : R) ``(Rpower x (-y)) == /(Rpower x y)``.
-Unfold Rpower.
-Intros x y; Rewrite Ropp_mul1.
-Apply exp_Ropp.
-Qed.
- 
-Theorem Rle_Rpower: (e,n,m : R) ``1<e`` -> ``0<=n`` -> ``n<=m`` ->  ``(Rpower e n)<=(Rpower e m)``.
-Intros e n m H H0 H1; Case H1.
-Intros H2; Left; Apply Rpower_lt; Assumption.
-Intros H2; Rewrite H2; Right; Reflexivity.
-Qed.
-  
-Theorem ln_lt_2: ``/2<(ln 2)``.
-Apply Rlt_monotony_contra with z := (Rplus R1 R1).
-Sup0.
-Rewrite Rinv_r.
-Apply exp_lt_inv.
-Apply Rle_lt_trans with 1 := exp_le_3.
-Change (Rlt (Rplus R1 (Rplus R1 R1)) (Rpower (Rplus R1 R1) (Rplus R1 R1))).
-Repeat Rewrite Rpower_plus; Repeat Rewrite Rpower_1.
-Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr;
- Repeat Rewrite Rmult_1l.
-Pattern 1 ``3``; Rewrite <- Rplus_Or; Replace ``2+2`` with ``3+1``; [Apply Rlt_compatibility; Apply Rlt_R0_R1 | Ring].
-Sup0.
-DiscrR.
-Qed.
-
-(**************************************)
-(* Differentiability of Ln and Rpower *)
-(**************************************)
-
-Theorem limit1_ext: (f, g : R ->  R)(D : R ->  Prop)(l, x : R) ((x : R) (D x) ->  (f x) == (g x)) -> (limit1_in f D l x) ->  (limit1_in g D l x).
-Intros f g D l x H; Unfold limit1_in limit_in.
-Intros H0 eps H1; Case (H0 eps); Auto.
-Intros x0 (H2, H3); Exists x0; Split; Auto.
-Intros x1 (H4, H5); Rewrite <- H; Auto.
-Qed.
-
-Theorem limit1_imp: (f : R ->  R)(D, D1 : R ->  Prop)(l, x : R) ((x : R) (D1 x) ->  (D x)) -> (limit1_in f D l x) ->  (limit1_in f D1 l x).
-Intros f D D1 l x H; Unfold limit1_in limit_in.
-Intros H0 eps H1; Case (H0 eps H1); Auto.
-Intros alpha (H2, H3); Exists alpha; Split; Auto.
-Intros d (H4, H5); Apply H3; Split; Auto.
-Qed.
-
-Theorem Rinv_Rdiv: (x, y : R) ``x<>0`` -> ``y<>0`` ->  ``/(x/y) == y/x``.
-Intros x y H1 H2; Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Apply Rmult_sym.
-Assumption.
-Assumption.
-Apply Rinv_neq_R0; Assumption.
-Qed.
-
-Theorem Dln: (y : R) ``0<y`` ->  (D_in ln Rinv [x:R]``0<x`` y).
-Intros y Hy; Unfold D_in.
-Apply limit1_ext with f := [x : R](Rinv (Rdiv (Rminus (exp (ln x)) (exp (ln y))) (Rminus (ln x) (ln y)))).
-Intros x (HD1, HD2); Repeat Rewrite exp_ln.
-Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Apply Rmult_sym.
-Apply Rminus_eq_contra.
-Red; Intros H2; Case HD2.
-Symmetry; Apply (ln_inv ? ? HD1 Hy H2).
-Apply Rminus_eq_contra; Apply (not_sym ? ? HD2).
-Apply Rinv_neq_R0; Apply Rminus_eq_contra; Red; Intros H2; Case HD2; Apply ln_inv; Auto.
-Assumption.
-Assumption.
-Apply limit_inv with f := [x : R]  (Rdiv (Rminus (exp (ln x)) (exp (ln y))) (Rminus (ln x) (ln y))).
-Apply limit1_imp with f := [x : R] ([x : R]  (Rdiv (Rminus (exp x) (exp (ln y))) (Rminus x (ln y))) (ln x)) D := (Dgf (D_x [x : R]  (Rlt R0 x) y) (D_x [x : R]  True (ln y)) ln).
-Intros x (H1, H2); Split.
-Split; Auto.
-Split; Auto.
-Red; Intros H3; Case H2; Apply ln_inv; Auto.
-Apply limit_comp with l := (ln y) g := [x : R]  (Rdiv (Rminus (exp x) (exp (ln y))) (Rminus x (ln y))) f := ln.
-Apply ln_continue; Auto.
-Assert H0 := (derivable_pt_lim_exp (ln y)); Unfold derivable_pt_lim in H0; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H0 ? H); Intros; Exists (pos x); Split.
-Apply (RIneq.cond_pos x).
-Intros; Pattern 3 y; Rewrite <- exp_ln.
-Pattern 1 x0; Replace x0 with ``(ln y)+(x0-(ln y))``; [Idtac | Ring].
-Apply H1.
-Elim H2; Intros H3 _; Unfold D_x in H3; Elim H3; Clear H3; Intros _ H3; Apply Rminus_eq_contra; Apply not_sym; Apply H3.
-Elim H2; Clear H2; Intros _ H2; Apply H2.
-Assumption.
-Red; Intro; Rewrite H in Hy; Elim (Rlt_antirefl ? Hy).
-Qed.
-
-Lemma derivable_pt_lim_ln : (x:R) ``0<x`` -> (derivable_pt_lim ln x ``/x``).
-Intros; Assert H0 := (Dln x H); Unfold D_in in H0; Unfold limit1_in in H0; Unfold limit_in in H0; Simpl in H0; Unfold R_dist in H0; Unfold derivable_pt_lim; Intros; Elim (H0 ? H1); Intros; Elim H2; Clear H2; Intros; Pose alp := (Rmin x0 ``x/2``); Assert H4 : ``0<alp``.
-Unfold alp; Unfold Rmin; Case (total_order_Rle x0 ``x/2``); Intro.
-Apply H2.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Exists (mkposreal ? H4); Intros; Pattern 2 h; Replace h with ``(x+h)-x``; [Idtac | Ring].
-Apply H3; Split.
-Unfold D_x; Split.
-Case (case_Rabsolu h); Intro.
-Assert H7 : ``(Rabsolu h)<x/2``.
-Apply Rlt_le_trans with alp.
-Apply H6.
-Unfold alp; Apply Rmin_r.
-Apply Rlt_trans with ``x/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Rewrite Rabsolu_left in H7.
-Apply Rlt_anti_compatibility with ``-h-x/2``.
-Replace ``-h-x/2+x/2`` with ``-h``; [Idtac | Ring].
-Pattern 2 x; Rewrite double_var.
-Replace ``-h-x/2+(x/2+x/2+h)`` with ``x/2``; [Apply H7 | Ring].
-Apply r.
-Apply gt0_plus_ge0_is_gt0; [Assumption | Apply Rle_sym2; Apply r].
-Apply not_sym; Apply Rminus_not_eq; Replace ``x+h-x`` with h; [Apply H5 | Ring].
-Replace ``x+h-x`` with h; [Apply Rlt_le_trans with alp; [Apply H6 | Unfold alp; Apply Rmin_l] | Ring].
-Qed.
-
-Theorem D_in_imp: (f, g : R ->  R)(D, D1 : R ->  Prop)(x : R) ((x : R) (D1 x) ->  (D x)) -> (D_in f g D x) ->  (D_in f g D1 x).
-Intros f g D D1 x H; Unfold D_in.
-Intros H0; Apply limit1_imp with D := (D_x D x); Auto.
-Intros x1 (H1, H2); Split; Auto.
-Qed.
-
-Theorem D_in_ext: (f, g, h : R ->  R)(D : R ->  Prop) (x : R) (f x) == (g x) -> (D_in h f D x) ->  (D_in h g D x).
-Intros f g h D x H; Unfold D_in.
-Rewrite H; Auto.
-Qed.
-
-Theorem Dpower: (y, z : R) ``0<y`` -> (D_in [x:R](Rpower x z) [x:R](Rmult z (Rpower x (Rminus z R1))) [x:R]``0<x`` y).
-Intros y z H; Apply D_in_imp with D := (Dgf [x : R]  (Rlt R0 x) [x : R]  True ln).
-Intros x H0; Repeat Split.
-Assumption.
-Apply D_in_ext with f := [x : R]  (Rmult (Rinv x) (Rmult z (exp (Rmult z (ln x))))).
-Unfold Rminus; Rewrite Rpower_plus; Rewrite Rpower_Ropp; Rewrite (Rpower_1 ? H); Ring.
-Apply Dcomp with f := ln g := [x : R]  (exp (Rmult z x)) df := Rinv dg := [x : R]  (Rmult z (exp (Rmult z x))).
-Apply (Dln ? H).
-Apply D_in_imp with D := (Dgf [x : R]  True [x : R]  True [x : R]  (Rmult z x)).
-Intros x H1; Repeat Split; Auto.
-Apply (Dcomp [_ : R]  True [_ : R]  True [x : ?]  z exp [x : R]  (Rmult z x) exp); Simpl.
-Apply D_in_ext with f := [x : R]  (Rmult z R1).
-Apply Rmult_1r.
-Apply (Dmult_const [x : ?]  True [x : ?]  x [x : ?]  R1); Apply Dx.
-Assert H0 := (derivable_pt_lim_D_in exp exp ``z*(ln y)``); Elim H0; Clear H0; Intros _ H0; Apply H0; Apply derivable_pt_lim_exp.
-Qed.
-
-Theorem derivable_pt_lim_power: (x, y : R) (Rlt R0 x) -> (derivable_pt_lim [x : ?]  (Rpower x y) x (Rmult y (Rpower x (Rminus y R1)))).
-Intros x y H.
-Unfold Rminus; Rewrite Rpower_plus.
-Rewrite Rpower_Ropp.
-Rewrite Rpower_1; Auto.
-Rewrite <- Rmult_assoc.
-Unfold Rpower.
-Apply derivable_pt_lim_comp with f1 := ln f2 := [x : ?]  (exp (Rmult y x)).
-Apply derivable_pt_lim_ln; Assumption.
-Rewrite (Rmult_sym y).
-Apply derivable_pt_lim_comp with f1 := [x : ?]  (Rmult y x) f2 := exp.
-Pattern 2 y; Replace y with (Rplus (Rmult R0 (ln x)) (Rmult y R1)).
-Apply derivable_pt_lim_mult with f1 := [x : R]  y f2 := [x : R]  x.
-Apply derivable_pt_lim_const with a := y.
-Apply derivable_pt_lim_id.
-Ring.
-Apply derivable_pt_lim_exp.
-Qed.
diff --git a/theories7/Reals/Rprod.v b/theories7/Reals/Rprod.v
deleted file mode 100644
index a524a915..00000000
--- a/theories7/Reals/Rprod.v
+++ /dev/null
@@ -1,164 +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: Rprod.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-Require Compare.
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require PartSum.
-Require Binomial.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(* TT Ak; 1<=k<=N *)
-Fixpoint prod_f_SO [An:nat->R;N:nat] : R := Cases N of
-  O => R1
-| (S p) => ``(prod_f_SO An p)*(An (S p))``
-end.
-
-(**********)
-Lemma prod_SO_split : (An:nat->R;n,k:nat) (le k n) -> (prod_f_SO An n)==(Rmult (prod_f_SO An k) (prod_f_SO [l:nat](An (plus k l)) (minus n k))).
-Intros; Induction n.
-Cut k=O; [Intro; Rewrite H0; Simpl; Ring | Inversion H; Reflexivity].
-Cut k=(S n)\/(le k n).
-Intro; Elim H0; Intro.
-Rewrite H1; Simpl; Rewrite <- minus_n_n; Simpl; Ring.
-Replace (minus (S n) k) with (S (minus n k)).
-Simpl; Replace (plus k (S (minus n k))) with (S n).
-Rewrite Hrecn; [Ring | Assumption].
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite S_INR; Rewrite minus_INR; [Ring | Assumption].
-Apply INR_eq; Rewrite S_INR; Repeat Rewrite minus_INR.
-Rewrite S_INR; Ring.
-Apply le_trans with n; [Assumption | Apply le_n_Sn].
-Assumption.
-Inversion H; [Left; Reflexivity | Right; Assumption].
-Qed.
-
-(**********)
-Lemma prod_SO_pos : (An:nat->R;N:nat) ((n:nat)(le n N)->``0<=(An n)``) -> ``0<=(prod_f_SO An N)``.
-Intros; Induction N.
-Simpl; Left; Apply Rlt_R0_R1.
-Simpl; Apply Rmult_le_pos.
-Apply HrecN; Intros; Apply H; Apply le_trans with N; [Assumption | Apply le_n_Sn].
-Apply H; Apply le_n.
-Qed.
-
-(**********)
-Lemma prod_SO_Rle : (An,Bn:nat->R;N:nat) ((n:nat)(le n N)->``0<=(An n)<=(Bn n)``) -> ``(prod_f_SO An N)<=(prod_f_SO Bn N)``.
-Intros; Induction N.
-Right; Reflexivity.
-Simpl; Apply Rle_trans with ``(prod_f_SO An N)*(Bn (S N))``.
-Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Elim (H n (le_trans ? ? ? H0 (le_n_Sn N))); Intros; Assumption.
-Elim (H (S N) (le_n (S N))); Intros; Assumption.
-Do 2 Rewrite <- (Rmult_sym (Bn (S N))); Apply Rle_monotony.
-Elim (H (S N) (le_n (S N))); Intros.
-Apply Rle_trans with (An (S N)); Assumption.
-Apply HrecN; Intros; Elim (H n (le_trans ? ? ? H0 (le_n_Sn N))); Intros; Split; Assumption.
-Qed.
-
-(* Application to factorial *)
-Lemma fact_prodSO : (n:nat) (INR (fact n))==(prod_f_SO [k:nat](INR k) n).
-Intro; Induction n.
-Reflexivity.
-Change (INR (mult (S n) (fact n)))==(prod_f_SO ([k:nat](INR k)) (S n)).
-Rewrite mult_INR; Rewrite Rmult_sym; Rewrite Hrecn; Reflexivity.
-Qed.
-
-Lemma le_n_2n : (n:nat) (le n (mult (2) n)).
-Induction n.
-Replace (mult (2) (O)) with O; [Apply le_n | Ring].
-Intros; Replace (mult (2) (S n0)) with (S (S (mult (2) n0))).
-Apply le_n_S; Apply le_S; Assumption.
-Replace (S (S (mult (2) n0))) with (plus (mult (2) n0) (2)); [Idtac | Ring].
-Replace (S n0) with (plus n0 (1)); [Idtac | Ring].
-Ring.
-Qed. 
-
-(* We prove that (N!)²<=(2N-k)!*k! forall k in [|O;2N|] *)
-Lemma RfactN_fact2N_factk : (N,k:nat) (le k (mult (2) N)) -> ``(Rsqr (INR (fact N)))<=(INR (fact (minus (mult (S (S O)) N) k)))*(INR (fact k))``.
-Intros; Unfold Rsqr; Repeat Rewrite fact_prodSO.
-Cut (le k N)\/(le N k).
-Intro; Elim H0; Intro.
-Rewrite (prod_SO_split [l:nat](INR l) (minus (mult (2) N) k) N).
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Apply pos_INR.
-Replace (minus (minus (mult (2) N) k) N) with (minus N k).
-Rewrite Rmult_sym; Rewrite (prod_SO_split [l:nat](INR l) N k).
-Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Apply pos_INR.
-Apply prod_SO_Rle; Intros; Split.
-Apply pos_INR.
-Apply le_INR; Apply le_reg_r; Assumption.
-Assumption.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply le_trans with N; [Assumption | Apply le_n_2n].
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring].
-Apply le_reg_r; Assumption.
-Assumption.
-Assumption.
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring].
-Apply le_reg_r; Assumption.
-Assumption.
-Rewrite <- (Rmult_sym (prod_f_SO [l:nat](INR l) k)); Rewrite (prod_SO_split [l:nat](INR l) k N).
-Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Apply pos_INR.
-Rewrite Rmult_sym; Rewrite (prod_SO_split [l:nat](INR l) N (minus (mult (2) N) k)).
-Apply Rle_monotony.
-Apply prod_SO_pos; Intros; Apply pos_INR.
-Replace (minus N (minus (mult (2) N) k)) with (minus k N).
-Apply prod_SO_Rle; Intros; Split.
-Apply pos_INR.
-Apply le_INR; Apply le_reg_r.
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
-Assumption.
-Apply INR_eq; Repeat Rewrite minus_INR.
-Rewrite mult_INR; Do 2 Rewrite S_INR; Ring.
-Assumption.
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
-Assumption.
-Assumption.
-Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
-Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
-Assumption.
-Assumption.
-Elim (le_dec k N); Intro; [Left; Assumption | Right; Assumption].
-Qed.
-
-(**********)
-Lemma INR_fact_lt_0 : (n:nat) ``0<(INR (fact n))``.
-Intro; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Elim (fact_neq_0 n); Symmetry; Assumption.
-Qed.
-
-(* We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *)
-Lemma C_maj : (N,k:nat) (le k (mult (2) N)) -> ``(C (mult (S (S O)) N) k)<=(C (mult (S (S O)) N) N)``.
-Intros; Unfold C; Unfold Rdiv; Apply Rle_monotony.
-Apply pos_INR.
-Replace (minus (mult (2) N) N) with N.
-Apply Rle_monotony_contra with ``((INR (fact N))*(INR (fact N)))``.
-Apply Rmult_lt_pos; Apply INR_fact_lt_0.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_sym; Apply Rle_monotony_contra with ``((INR (fact k))*
-   (INR (fact (minus (mult (S (S O)) N) k))))``.
-Apply Rmult_lt_pos; Apply INR_fact_lt_0.
-Rewrite Rmult_1r; Rewrite <- mult_INR; Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite mult_INR; Rewrite (Rmult_sym (INR (fact k))); Replace ``(INR (fact N))*(INR (fact N))`` with (Rsqr (INR (fact N))).
-Apply RfactN_fact2N_factk.
-Assumption.
-Reflexivity.
-Rewrite mult_INR; Apply prod_neq_R0; Apply INR_fact_neq_0.
-Apply prod_neq_R0; Apply INR_fact_neq_0.
-Apply INR_eq; Rewrite minus_INR; [Rewrite mult_INR; Do 2 Rewrite S_INR; Ring | Apply le_n_2n].
-Qed.
diff --git a/theories7/Reals/Rseries.v b/theories7/Reals/Rseries.v
deleted file mode 100644
index a38099dd..00000000
--- a/theories7/Reals/Rseries.v
+++ /dev/null
@@ -1,279 +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: Rseries.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Classical.
-Require Compare.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Implicit Variable Type r:R.
-
-(* classical is needed for [Un_cv_crit] *)
-(*********************************************************)
-(*           Definition of sequence and properties       *)
-(*                                                       *)
-(*********************************************************)
-
-Section sequence.
-
-(*********)
-Variable Un:nat->R.
-
-(*********)
-Fixpoint Rmax_N [N:nat]:R:=
-   Cases N of
-     O     => (Un O)
-    |(S n) => (Rmax (Un (S n)) (Rmax_N n))
-   end.
-
-(*********)
-Definition EUn:R->Prop:=[r:R](Ex [i:nat] (r==(Un i))).
-
-(*********)
-Definition Un_cv:R->Prop:=[l:R]
-  (eps:R)(Rgt eps R0)->(Ex[N:nat](n:nat)(ge n N)->
-             (Rlt (R_dist (Un n) l) eps)).
-
-(*********)
-Definition Cauchy_crit:Prop:=(eps:R)(Rgt eps R0)->
-       (Ex[N:nat] (n,m:nat)(ge n N)->(ge m N)->
-                  (Rlt (R_dist (Un n) (Un m)) eps)).
-
-(*********)
-Definition Un_growing:Prop:=(n:nat)(Rle (Un n) (Un (S n))).
-
-(*********)
-Lemma EUn_noempty:(ExT [r:R] (EUn r)).
-Unfold EUn;Split with (Un O);Split with O;Trivial.
-Qed.
-
-(*********)
-Lemma Un_in_EUn:(n:nat)(EUn (Un n)).
-Intro;Unfold EUn;Split with n;Trivial.
-Qed.
-
-(*********)
-Lemma Un_bound_imp:(x:R)((n:nat)(Rle (Un n) x))->(is_upper_bound EUn x).
-Intros;Unfold is_upper_bound;Intros;Unfold EUn in H0;Elim H0;Clear H0;
- Intros;Generalize (H x1);Intro;Rewrite <- H0 in H1;Trivial.
-Qed.
-
-(*********)
-Lemma growing_prop:(n,m:nat)Un_growing->(ge n m)->(Rge (Un n) (Un m)).
-Double Induction n m;Intros.
-Unfold Rge;Right;Trivial.
-ElimType False;Unfold ge in H1;Generalize (le_Sn_O n0);Intro;Auto.
-Cut (ge n0 (0)).
-Generalize H0;Intros;Unfold Un_growing in H0;
- Apply (Rge_trans (Un (S n0)) (Un n0) (Un (0)) 
-                  (Rle_sym1 (Un n0) (Un (S n0)) (H0 n0)) (H O H2 H3)).
-Elim n0;Auto.
-Elim (lt_eq_lt_dec n1 n0);Intro y.
-Elim y;Clear y;Intro y.
-Unfold ge in H2;Generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2));Intro;
- ElimType False;Auto.
-Rewrite y;Unfold Rge;Right;Trivial.
-Unfold ge in H0;Generalize (H0 (S n0) H1 (lt_le_S n0 n1 y));Intro;
- Unfold Un_growing in H1;
- Apply (Rge_trans (Un (S n1)) (Un n1) (Un (S n0)) 
-                  (Rle_sym1 (Un n1) (Un (S n1)) (H1 n1)) H3).
-Qed.
-
-
-(* classical is needed: [not_all_not_ex] *)
-(*********)
-Lemma Un_cv_crit:Un_growing->(bound EUn)->(ExT [l:R] (Un_cv l)).
-Unfold Un_growing Un_cv;Intros;
- Generalize (complet_weak EUn H0 EUn_noempty);Intro;
- Elim H1;Clear H1;Intros;Split with x;Intros;
- Unfold is_lub in H1;Unfold bound in H0;Unfold is_upper_bound in H0 H1;
- Elim H0;Clear H0;Intros;Elim H1;Clear H1;Intros;
- Generalize (H3 x0 H0);Intro;Cut (n:nat)(Rle (Un n) x);Intro.
-Cut (Ex [N:nat] (Rlt (Rminus x eps) (Un N))).
-Intro;Elim H6;Clear H6;Intros;Split with x1.
-Intros;Unfold R_dist;Apply (Rabsolu_def1 (Rminus (Un n) x) eps).
-Unfold Rgt in H2;
- Apply (Rle_lt_trans (Rminus (Un n) x) R0 eps 
-                     (Rle_minus (Un n) x (H5 n)) H2).
-Fold Un_growing in H;Generalize (growing_prop n x1 H H7);Intro;
- Generalize (Rlt_le_trans (Rminus x eps) (Un x1) (Un n) H6
-                          (Rle_sym2 (Un x1) (Un n) H8));Intro;
- Generalize (Rlt_compatibility (Ropp x) (Rminus x eps) (Un n) H9);
- Unfold Rminus;Rewrite <-(Rplus_assoc (Ropp x) x (Ropp eps));
- Rewrite (Rplus_sym (Ropp x) (Un n));Fold (Rminus (Un n) x);
- Rewrite Rplus_Ropp_l;Rewrite (let (H1,H2)=(Rplus_ne (Ropp eps)) in H2);
- Trivial.
-Cut ~((N:nat)(Rge (Rminus x eps) (Un N))).
-Intro;Apply (not_all_not_ex nat ([N:nat](Rlt (Rminus x eps) (Un N))));
- Red;Intro;Red in H6;Elim H6;Clear H6;Intro;
- Apply (Rlt_not_ge (Rminus x eps) (Un N) (H7 N)).
-Red;Intro;Cut (N:nat)(Rle (Un N) (Rminus x eps)).
-Intro;Generalize (Un_bound_imp (Rminus x eps) H7);Intro;
- Unfold is_upper_bound in H8;Generalize (H3 (Rminus x eps) H8);Intro;
- Generalize (Rle_minus x (Rminus x eps) H9);Unfold Rminus;
- Rewrite Ropp_distr1;Rewrite <- Rplus_assoc;Rewrite Rplus_Ropp_r;
- Rewrite (let (H1,H2)=(Rplus_ne (Ropp (Ropp eps))) in H2);
- Rewrite Ropp_Ropp;Intro;Unfold Rgt in H2;
- Generalize (Rle_not eps R0 H2);Intro;Auto.
-Intro;Elim (H6 N);Intro;Unfold Rle.
-Left;Unfold Rgt in H7;Assumption.
-Right;Auto.
-Apply (H1 (Un n) (Un_in_EUn n)).
-Qed.
-
-(*********)
-Lemma finite_greater:(N:nat)(ExT [M:R] (n:nat)(le n N)->(Rle (Un n) M)).
-Intro;Induction N.
-Split with (Un O);Intros;Rewrite (le_n_O_eq n H); 
- Apply (eq_Rle (Un (n)) (Un (n)) (refl_eqT R (Un (n)))).
-Elim HrecN;Clear HrecN;Intros;Split with (Rmax (Un (S N)) x);Intros;
- Elim (Rmax_Rle (Un (S N)) x (Un n));Intros;Clear H1;Inversion H0.
-Rewrite <-H1;Rewrite <-H1 in H2;
- Apply (H2 (or_introl (Rle (Un n) (Un n)) (Rle (Un n) x) 
-    (eq_Rle (Un n) (Un n) (refl_eqT R (Un n))))).
-Apply (H2 (or_intror (Rle (Un n) (Un (S N))) (Rle (Un n) x) 
-    (H n H3))).
-Qed.
-
-(*********)
-Lemma cauchy_bound:Cauchy_crit->(bound EUn).
-Unfold Cauchy_crit bound;Intros;Unfold is_upper_bound;
- Unfold Rgt in H;Elim (H R1 Rlt_R0_R1);Clear H;Intros;
- Generalize (H x);Intro;Generalize (le_dec x);Intro;
- Elim (finite_greater x);Intros;Split with (Rmax x0 (Rplus (Un x) R1));
- Clear H;Intros;Unfold EUn in H;Elim H;Clear H;Intros;Elim (H1 x2);
- Clear H1;Intro y.
-Unfold ge in H0;Generalize (H0 x2 (le_n x) y);Clear H0;Intro;
- Rewrite <- H in H0;Unfold R_dist in H0;
- Elim (Rabsolu_def2 (Rminus (Un x) x1) R1 H0);Clear H0;Intros;
- Elim (Rmax_Rle x0 (Rplus (Un x) R1) x1);Intros;Apply H4;Clear H3 H4;
- Right;Clear H H0 y;Apply (Rlt_le x1 (Rplus (Un x) R1));
- Generalize (Rlt_minus (Ropp R1) (Rminus (Un x) x1) H1);Clear H1;
- Intro;Apply (Rminus_lt x1 (Rplus (Un x) R1));
- Cut (Rminus (Ropp R1) (Rminus (Un x) x1))==
-  (Rminus x1 (Rplus (Un x) R1));[Intro;Rewrite H0 in H;Assumption|Ring].
-Generalize (H2 x2 y);Clear H2 H0;Intro;Rewrite<-H in H0;
- Elim (Rmax_Rle x0 (Rplus (Un x) R1) x1);Intros;Clear H1;Apply H2;
- Left;Assumption.
-Qed.
-
-End sequence.
-
-(*****************************************************************)
-(*           Definition of Power Series and properties           *)
-(*                                                               *)
-(*****************************************************************)
-
-Section Isequence.
-
-(*********)
-Variable An:nat->R.
-
-(*********)
-Definition Pser:R->R->Prop:=[x,l:R]
-   (infinit_sum [n:nat](Rmult (An n) (pow x n)) l).
-
-End Isequence.
-
-Lemma GP_infinite:
- (x:R) (Rlt (Rabsolu x) R1) 
-       -> (Pser ([n:nat] R1) x (Rinv(Rminus R1 x))).
-Intros;Unfold Pser; Unfold infinit_sum;Intros;Elim (Req_EM x R0).
-Intros;Exists O; Intros;Rewrite H1;Rewrite minus_R0;Rewrite Rinv_R1;
-  Cut (sum_f_R0 [n0:nat](Rmult R1 (pow R0 n0)) n)==R1.
-Intros; Rewrite H3;Rewrite R_dist_eq;Auto.
-Elim n; Simpl.
-Ring.
-Intros;Rewrite H3;Ring.
-Intro;Cut (Rlt R0
-      (Rmult eps (Rmult (Rabsolu (Rminus R1 x)) 
-                        (Rabsolu (Rinv x))))).
-Intro;Elim (pow_lt_1_zero x H
-                    (Rmult eps (Rmult (Rabsolu (Rminus R1 x))
-                                 (Rabsolu (Rinv x))))
-                    H2);Intro N; Intros;Exists N; Intros;
-  Cut (sum_f_R0 [n0:nat](Rmult R1 (pow x n0)) n)==
-    (sum_f_R0 [n0:nat](pow x n0) n).
-Intros; Rewrite H5;Apply (Rlt_monotony_rev
-         (Rabsolu (Rminus R1 x))
-         (R_dist (sum_f_R0 [n0:nat](pow x n0) n) 
-                 (Rinv (Rminus R1 x))) 
-         eps).
-Apply Rabsolu_pos_lt.
-Apply Rminus_eq_contra.
-Apply imp_not_Req.
-Right; Unfold Rgt.
-Apply (Rle_lt_trans x (Rabsolu x) R1).
-Apply Rle_Rabsolu.
-Assumption.
-Unfold R_dist; Rewrite <- Rabsolu_mult.
-Rewrite Rminus_distr.
-Cut (Rmult (Rminus R1 x) (sum_f_R0 [n0:nat](pow x n0) n))==
-    (Ropp (Rmult(sum_f_R0 [n0:nat](pow x n0) n) 
-          (Rminus x R1))).
-Intro; Rewrite H6.
-Rewrite GP_finite.
-Rewrite Rinv_r.
-Cut (Rminus (Ropp (Rminus (pow x (plus n (1))) R1)) R1)==
-    (Ropp (pow x (plus n (1)))).
-Intro; Rewrite H7.
-Rewrite Rabsolu_Ropp;Cut (plus n (S O))=(S n);Auto.
-Intro H8;Rewrite H8;Simpl;Rewrite Rabsolu_mult;
-  Apply (Rlt_le_trans (Rmult (Rabsolu x) (Rabsolu (pow x n)))
-                    (Rmult (Rabsolu x)
-                           (Rmult eps
-                              (Rmult (Rabsolu (Rminus R1 x)) 
-                                      (Rabsolu (Rinv x)))))
-                 (Rmult (Rabsolu (Rminus R1 x)) eps)).
-Apply Rlt_monotony.
-Apply Rabsolu_pos_lt.
-Assumption.
-Auto.
-Cut (Rmult (Rabsolu x)
-           (Rmult eps (Rmult (Rabsolu (Rminus R1 x)) 
-                             (Rabsolu (Rinv x)))))==
-    (Rmult (Rmult (Rabsolu x) (Rabsolu (Rinv x))) 
-           (Rmult eps (Rabsolu (Rminus R1 x)))).
-Clear H8;Intros; Rewrite H8;Rewrite <- Rabsolu_mult;Rewrite Rinv_r.  
-Rewrite Rabsolu_R1;Cut (Rmult R1 (Rmult eps (Rabsolu (Rminus R1 x))))==
-    (Rmult (Rabsolu (Rminus R1 x)) eps).
-Intros; Rewrite H9;Unfold Rle; Right; Reflexivity.
-Ring.
-Assumption.
-Ring.
-Ring.
-Ring.
-Apply Rminus_eq_contra.
-Apply imp_not_Req.
-Right; Unfold Rgt.
-Apply (Rle_lt_trans x (Rabsolu x) R1).
-Apply Rle_Rabsolu.
-Assumption.
-Ring; Ring.
-Elim n; Simpl.
-Ring.
-Intros; Rewrite H5.
-Ring.
-Apply Rmult_lt_pos.
-Auto.
-Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt.
-Apply Rminus_eq_contra.
-Apply imp_not_Req.
-Right; Unfold Rgt.
-Apply (Rle_lt_trans x (Rabsolu x) R1).
-Apply Rle_Rabsolu.
-Assumption.
-Apply Rabsolu_pos_lt.
-Apply Rinv_neq_R0.
-Assumption.
-Qed.
diff --git a/theories7/Reals/Rsigma.v b/theories7/Reals/Rsigma.v
deleted file mode 100644
index f9e8e92b..00000000
--- a/theories7/Reals/Rsigma.v
+++ /dev/null
@@ -1,117 +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: Rsigma.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require PartSum.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Set Implicit Arguments.
-
-Section Sigma.
-
-Variable f : nat->R.
-
-Definition sigma [low,high:nat] : R := (sum_f_R0 [k:nat](f (plus low k)) (minus high low)).
-
-Theorem sigma_split : (low,high,k:nat) (le low k)->(lt k high)->``(sigma low high)==(sigma low k)+(sigma (S k) high)``.
-Intros; Induction k.
-Cut low = O.
-Intro; Rewrite H1; Unfold sigma; Rewrite <- minus_n_n; Rewrite <- minus_n_O; Simpl; Replace (minus high (S O)) with (pred high).
-Apply (decomp_sum [k:nat](f k)).
-Assumption.
-Apply pred_of_minus.
-Inversion H; Reflexivity.
-Cut (le low k)\/low=(S k).
-Intro; Elim H1; Intro.
-Replace (sigma low (S k)) with ``(sigma low k)+(f (S k))``.
-Rewrite Rplus_assoc; Replace ``(f (S k))+(sigma (S (S k)) high)`` with (sigma (S k) high).
-Apply Hreck.
-Assumption.
-Apply lt_trans with (S k); [Apply lt_n_Sn | Assumption].
-Unfold sigma; Replace (minus high (S (S k))) with (pred (minus high (S k))).
-Pattern 3 (S k); Replace (S k) with (plus (S k) O); [Idtac | Ring].
-Replace (sum_f_R0 [k0:nat](f (plus (S (S k)) k0)) (pred (minus high (S k)))) with (sum_f_R0 [k0:nat](f (plus (S k) (S k0))) (pred (minus high (S k)))).
-Apply (decomp_sum [i:nat](f (plus (S k) i))).
-Apply lt_minus_O_lt; Assumption.
-Apply sum_eq; Intros; Replace (plus (S k) (S i)) with (plus (S (S k)) i).
-Reflexivity.
-Apply INR_eq; Do 2 Rewrite plus_INR; Do 3 Rewrite S_INR; Ring.
-Replace (minus high (S (S k))) with (minus (minus high (S k)) (S O)).
-Apply pred_of_minus.
-Apply INR_eq; Repeat  Rewrite minus_INR.
-Do 4 Rewrite S_INR; Ring.
-Apply lt_le_S; Assumption.
-Apply lt_le_weak; Assumption.
-Apply lt_le_S; Apply lt_minus_O_lt; Assumption.
-Unfold sigma; Replace (minus (S k) low) with (S (minus k low)).
-Pattern 1 (S k); Replace (S k) with (plus low (S (minus k low))).
-Symmetry; Apply (tech5 [i:nat](f (plus low i))).
-Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite minus_INR.
-Ring.
-Assumption.
-Apply minus_Sn_m; Assumption.
-Rewrite <- H2; Unfold sigma; Rewrite <- minus_n_n; Simpl; Replace (minus high (S low)) with (pred (minus high low)).
-Replace (sum_f_R0 [k0:nat](f (S (plus low k0))) (pred (minus high low))) with (sum_f_R0 [k0:nat](f (plus low (S k0))) (pred (minus high low))).
-Apply (decomp_sum [k0:nat](f (plus low k0))).
-Apply lt_minus_O_lt.
-Apply le_lt_trans with (S k); [Rewrite H2; Apply le_n | Assumption].
-Apply sum_eq; Intros; Replace (S (plus low i)) with (plus low (S i)).
-Reflexivity.
-Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Replace (minus high (S low)) with (minus (minus high low) (S O)).
-Apply pred_of_minus.
-Apply INR_eq; Repeat  Rewrite minus_INR.
-Do 2 Rewrite S_INR; Ring.
-Apply lt_le_S; Rewrite H2; Assumption.
-Rewrite H2; Apply lt_le_weak; Assumption.
-Apply lt_le_S; Apply lt_minus_O_lt; Rewrite H2; Assumption.
-Inversion H; [
-  Right; Reflexivity
-| Left; Assumption].
-Qed.
-
-Theorem sigma_diff : (low,high,k:nat) (le low k) -> (lt k high )->``(sigma low high)-(sigma low k)==(sigma (S k) high)``.
-Intros low high k H1 H2; Symmetry; Rewrite -> (sigma_split H1 H2); Ring.
-Qed.
-
-Theorem sigma_diff_neg : (low,high,k:nat) (le low k) -> (lt k high)-> ``(sigma low k)-(sigma low high)==-(sigma (S k) high)``.
-Intros low high k H1 H2; Rewrite -> (sigma_split H1 H2); Ring.
-Qed.
-
-Theorem sigma_first : (low,high:nat) (lt low high) -> ``(sigma low high)==(f low)+(sigma (S low) high)``.
-Intros low high H1; Generalize (lt_le_S low high H1); Intro H2; Generalize (lt_le_weak low high H1); Intro H3; Replace ``(f low)`` with ``(sigma low low)``.
-Apply sigma_split.
-Apply le_n.
-Assumption.
-Unfold sigma; Rewrite <- minus_n_n.
-Simpl.
-Replace (plus low O) with low; [Reflexivity | Ring].
-Qed.
-
-Theorem sigma_last : (low,high:nat) (lt low high) -> ``(sigma low high)==(f high)+(sigma low (pred high))``.
-Intros low high H1; Generalize (lt_le_S low high H1); Intro H2; Generalize (lt_le_weak low high H1); Intro H3; Replace ``(f high)`` with ``(sigma high high)``.
-Rewrite Rplus_sym; Cut high = (S (pred high)).
-Intro; Pattern 3 high; Rewrite H.
-Apply sigma_split.
-Apply le_S_n; Rewrite <- H; Apply lt_le_S; Assumption.
-Apply lt_pred_n_n; Apply le_lt_trans with low; [Apply le_O_n | Assumption].
-Apply S_pred with O; Apply le_lt_trans with low; [Apply le_O_n | Assumption].
-Unfold sigma; Rewrite <- minus_n_n; Simpl; Replace (plus high O) with high; [Reflexivity | Ring].
-Qed.
-
-Theorem sigma_eq_arg : (low:nat) (sigma low low)==(f low).
-Intro; Unfold sigma; Rewrite <- minus_n_n.
-Simpl; Replace (plus low O) with low; [Reflexivity | Ring].
-Qed.
-
-End Sigma.
diff --git a/theories7/Reals/Rsqrt_def.v b/theories7/Reals/Rsqrt_def.v
deleted file mode 100644
index 17367dce..00000000
--- a/theories7/Reals/Rsqrt_def.v
+++ /dev/null
@@ -1,688 +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: Rsqrt_def.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-Require Sumbool.
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Ranalysis1.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Fixpoint Dichotomy_lb [x,y:R;P:R->bool;N:nat] : R :=
-Cases N of 
-  O => x
-| (S n) => let down = (Dichotomy_lb x y P n) in let up = (Dichotomy_ub x y P n) in let z = ``(down+up)/2``  in if (P z) then down else z
-end
-with Dichotomy_ub [x,y:R;P:R->bool;N:nat] : R :=
-Cases N of 
-  O => y
-| (S n) => let down = (Dichotomy_lb x y P n) in let up = (Dichotomy_ub x y P n) in let z = ``(down+up)/2``  in if (P z) then z else up
-end.
-
-Definition dicho_lb [x,y:R;P:R->bool] : nat->R := [N:nat](Dichotomy_lb x y P N).
-Definition dicho_up [x,y:R;P:R->bool] : nat->R := [N:nat](Dichotomy_ub x y P N).
-
-(**********)
-Lemma dicho_comp : (x,y:R;P:R->bool;n:nat) ``x<=y`` -> ``(dicho_lb x y P n)<=(dicho_up x y P n)``.
-Intros.
-Induction n.
-Simpl; Assumption.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 1 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Apply Rle_compatibility.
-Assumption.
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 3 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Rewrite <- (Rplus_sym (Dichotomy_ub x y P n)).
-Apply Rle_compatibility.
-Assumption.
-Qed.
-
-Lemma dicho_lb_growing : (x,y:R;P:R->bool) ``x<=y`` -> (Un_growing (dicho_lb x y P)).
-Intros.
-Unfold Un_growing.
-Intro.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Right; Reflexivity.
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 1 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Apply Rle_compatibility.
-Replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [Apply dicho_comp; Assumption | Reflexivity].
-Qed.
-
-Lemma dicho_up_decreasing : (x,y:R;P:R->bool) ``x<=y`` -> (Un_decreasing (dicho_up x y P)).
-Intros.
-Unfold Un_decreasing.
-Intro.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 3 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
-Rewrite Rmult_1r.
-Rewrite double.
-Replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [Idtac | Reflexivity].
-Replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); [Idtac | Reflexivity].
-Rewrite <- (Rplus_sym ``(dicho_up x y P n)``).
-Apply Rle_compatibility.
-Apply dicho_comp; Assumption.
-Right; Reflexivity.
-Qed.
-
-Lemma dicho_lb_maj_y : (x,y:R;P:R->bool) ``x<=y`` -> (n:nat)``(dicho_lb x y P n)<=y``.
-Intros.
-Induction n.
-Simpl; Assumption.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Assumption.
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 3 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
-Rewrite double; Apply Rplus_le.
-Assumption.
-Pattern 2 y; Replace y with (Dichotomy_ub x y P O); [Idtac | Reflexivity].
-Apply decreasing_prop.
-Assert H0 := (dicho_up_decreasing x y P H).
-Assumption.
-Apply le_O_n.
-Qed.
-
-Lemma dicho_lb_maj : (x,y:R;P:R->bool) ``x<=y`` -> (has_ub (dicho_lb x y P)).
-Intros.
-Cut (n:nat)``(dicho_lb x y P n)<=y``.
-Intro.
-Unfold has_ub.
-Unfold bound.
-Exists y.
-Unfold is_upper_bound.
-Intros.
-Elim H1; Intros.
-Rewrite H2; Apply H0.
-Apply dicho_lb_maj_y; Assumption.
-Qed.
-
-Lemma dicho_up_min_x : (x,y:R;P:R->bool) ``x<=y`` -> (n:nat)``x<=(dicho_up x y P n)``.
-Intros.
-Induction n.
-Simpl; Assumption.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Pattern 1 ``2``; Rewrite Rmult_sym.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
-Rewrite double; Apply Rplus_le.
-Pattern 1 x; Replace x with (Dichotomy_lb x y P O); [Idtac | Reflexivity].
-Apply tech9.
-Assert H0 := (dicho_lb_growing x y P H).
-Assumption.
-Apply le_O_n.
-Assumption.
-Assumption.
-Qed.
-
-Lemma dicho_up_min : (x,y:R;P:R->bool) ``x<=y`` -> (has_lb (dicho_up x y P)).
-Intros.
-Cut (n:nat)``x<=(dicho_up x y P n)``.
-Intro.
-Unfold has_lb.
-Unfold bound.
-Exists ``-x``.
-Unfold is_upper_bound.
-Intros.
-Elim H1; Intros.
-Rewrite H2.
-Unfold opp_seq.
-Apply Rle_Ropp1.
-Apply H0.
-Apply dicho_up_min_x; Assumption.
-Qed.
-
-Lemma dicho_lb_cv : (x,y:R;P:R->bool) ``x<=y`` -> (sigTT R [l:R](Un_cv (dicho_lb x y P) l)).
-Intros.
-Apply growing_cv.
-Apply dicho_lb_growing; Assumption.
-Apply dicho_lb_maj; Assumption.
-Qed.
-
-Lemma dicho_up_cv : (x,y:R;P:R->bool) ``x<=y`` -> (sigTT R [l:R](Un_cv (dicho_up x y P) l)).
-Intros.
-Apply decreasing_cv.
-Apply dicho_up_decreasing; Assumption.
-Apply dicho_up_min; Assumption.
-Qed.
-
-Lemma dicho_lb_dicho_up : (x,y:R;P:R->bool;n:nat) ``x<=y`` -> ``(dicho_up x y P n)-(dicho_lb x y P n)==(y-x)/(pow 2 n)``.
-Intros.
-Induction n.
-Simpl.
-Unfold Rdiv; Rewrite Rinv_R1; Ring.
-Simpl.
-Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
-Unfold Rdiv.
-Replace ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))*/2-
-   (Dichotomy_lb x y P n)`` with ``((dicho_up x y P n)-(dicho_lb x y P n))/2``.
-Unfold Rdiv; Rewrite Hrecn.
-Unfold Rdiv.
-Rewrite Rinv_Rmult.
-Ring.
-DiscrR.
-Apply pow_nonzero; DiscrR.
-Pattern 2 (Dichotomy_lb x y P n); Rewrite (double_var (Dichotomy_lb x y P n)); Unfold dicho_up dicho_lb Rminus Rdiv; Ring.
-Replace ``(Dichotomy_ub x y P n)-((Dichotomy_lb x y P n)+
-   (Dichotomy_ub x y P n))/2`` with ``((dicho_up x y P n)-(dicho_lb x y P n))/2``.
-Unfold Rdiv; Rewrite Hrecn.
-Unfold Rdiv.
-Rewrite Rinv_Rmult.
-Ring.
-DiscrR.
-Apply pow_nonzero; DiscrR.
-Pattern 1 (Dichotomy_ub x y P n); Rewrite (double_var (Dichotomy_ub x y P n)); Unfold dicho_up dicho_lb Rminus Rdiv; Ring.
-Qed.
-
-Definition pow_2_n := [n:nat](pow ``2`` n).
-
-Lemma pow_2_n_neq_R0 : (n:nat) ``(pow_2_n n)<>0``.
-Intro.
-Unfold pow_2_n.
-Apply pow_nonzero.
-DiscrR.
-Qed.
-
-Lemma pow_2_n_growing : (Un_growing pow_2_n).
-Unfold Un_growing.
-Intro.
-Replace (S n) with (plus n (1)); [Unfold pow_2_n; Rewrite pow_add | Ring].
-Pattern 1 (pow ``2`` n); Rewrite <- Rmult_1r.
-Apply Rle_monotony.
-Left; Apply pow_lt; Sup0.
-Simpl.
-Rewrite Rmult_1r.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1.
-Qed.
-
-Lemma pow_2_n_infty : (cv_infty pow_2_n).
-Cut (N:nat)``(INR N)<=(pow 2 N)``.
-Intros.
-Unfold cv_infty.
-Intro.
-Case (total_order_T R0 M); Intro.
-Elim s; Intro.
-Pose N := (up M).
-Cut `0<=N`.
-Intro.
-Elim (IZN N H0); Intros N0 H1.
-Exists N0.
-Intros.
-Apply Rlt_le_trans with (INR N0).
-Rewrite INR_IZR_INZ.
-Rewrite <- H1.
-Unfold N.
-Assert H3 := (archimed M).
-Elim H3; Intros; Assumption.
-Apply Rle_trans with (pow_2_n N0).
-Unfold pow_2_n; Apply H.
-Apply Rle_sym2.
-Apply growing_prop.
-Apply pow_2_n_growing.
-Assumption.
-Apply le_IZR.
-Unfold N.
-Simpl.
-Assert H0 := (archimed M); Elim H0; Intros.
-Left; Apply Rlt_trans with M; Assumption.
-Exists O; Intros.
-Rewrite <- b.
-Unfold pow_2_n; Apply pow_lt; Sup0.
-Exists O; Intros.
-Apply Rlt_trans with R0.
-Assumption.
-Unfold pow_2_n; Apply pow_lt; Sup0.
-Induction N.
-Simpl.
-Left; Apply Rlt_R0_R1.
-Intros.
-Pattern 2 (S n); Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite S_INR; Rewrite pow_add.
-Simpl.
-Rewrite Rmult_1r.
-Apply Rle_trans with ``(pow 2 n)``.
-Rewrite <- (Rplus_sym R1).
-Rewrite <- (Rmult_1r (INR n)).
-Apply (poly n R1).
-Apply Rlt_R0_R1.
-Pattern 1 (pow ``2`` n); Rewrite <- Rplus_Or.
-Rewrite <- (Rmult_sym ``2``).
-Rewrite double.
-Apply Rle_compatibility.
-Left; Apply pow_lt; Sup0.
-Qed.
-
-Lemma cv_dicho : (x,y,l1,l2:R;P:R->bool) ``x<=y`` -> (Un_cv (dicho_lb x y P) l1) -> (Un_cv (dicho_up x y P) l2) -> l1==l2.
-Intros.
-Assert H2 := (CV_minus ? ? ? ? H0 H1).
-Cut (Un_cv [i:nat]``(dicho_lb x y P i)-(dicho_up x y P i)`` R0).
-Intro.
-Assert H4 := (UL_sequence ? ? ? H2 H3).
-Symmetry; Apply Rminus_eq_right; Assumption.
-Unfold Un_cv; Unfold R_dist.
-Intros.
-Assert H4 := (cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty).
-Case (total_order_T x y); Intro.
-Elim s; Intro.
-Unfold Un_cv in H4; Unfold R_dist in H4.
-Cut ``0<y-x``.
-Intro Hyp.
-Cut ``0<eps/(y-x)``.
-Intro.
-Elim (H4 ``eps/(y-x)`` H5); Intros N H6.
-Exists N; Intros.
-Replace ``(dicho_lb x y P n)-(dicho_up x y P n)-0`` with ``(dicho_lb x y P n)-(dicho_up x y P n)``; [Idtac | Ring].
-Rewrite <- Rabsolu_Ropp.
-Rewrite Ropp_distr3.
-Rewrite dicho_lb_dicho_up.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Rewrite (Rabsolu_right ``y-x``).
-Apply Rlt_monotony_contra with ``/(y-x)``.
-Apply Rlt_Rinv; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace ``/(pow 2 n)`` with ``/(pow 2 n)-0``; [Unfold pow_2_n Rdiv in H6; Rewrite <- (Rmult_sym eps); Apply H6; Assumption | Ring].
-Red; Intro; Rewrite H8 in Hyp; Elim (Rlt_antirefl ? Hyp).
-Apply Rle_sym1.
-Apply Rle_anti_compatibility with x; Rewrite Rplus_Or.
-Replace ``x+(y-x)`` with y; [Assumption | Ring].
-Assumption.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption].
-Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or.
-Replace ``x+(y-x)`` with y; [Assumption | Ring].
-Exists O; Intros.
-Replace ``(dicho_lb x y P n)-(dicho_up x y P n)-0`` with ``(dicho_lb x y P n)-(dicho_up x y P n)``; [Idtac | Ring].
-Rewrite <- Rabsolu_Ropp.
-Rewrite Ropp_distr3.
-Rewrite dicho_lb_dicho_up.
-Rewrite b.
-Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Assumption.
-Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
-Qed.
-
-Definition cond_positivity [x:R] : bool := Cases (total_order_Rle R0 x) of 
-  (leftT _) => true 
-| (rightT _) => false end.
-
-(* Sequential caracterisation of continuity *)
-Lemma continuity_seq : (f:R->R;Un:nat->R;l:R) (continuity_pt f l) -> (Un_cv Un l) -> (Un_cv [i:nat](f (Un i)) (f l)).
-Unfold continuity_pt Un_cv; Unfold continue_in.
-Unfold limit1_in.
-Unfold limit_in.
-Unfold dist.
-Simpl.
-Unfold R_dist.
-Intros.
-Elim (H eps H1); Intros alp H2.
-Elim H2; Intros.
-Elim (H0 alp H3); Intros N H5.
-Exists N; Intros.
-Case (Req_EM (Un n) l); Intro.
-Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Apply H4.
-Split.
-Unfold D_x no_cond.
-Split.
-Trivial.
-Apply not_sym; Assumption.
-Apply H5; Assumption.
-Qed.
-
-Lemma dicho_lb_car : (x,y:R;P:R->bool;n:nat) (P x)=false -> (P (dicho_lb x y P n))=false.
-Intros.
-Induction n.
-Simpl.
-Assumption.
-Simpl.
-Assert X := (sumbool_of_bool (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``)).
-Elim X; Intro.
-Rewrite a.
-Unfold dicho_lb in Hrecn; Assumption.
-Rewrite b.
-Assumption.
-Qed.
-
-Lemma dicho_up_car : (x,y:R;P:R->bool;n:nat) (P y)=true -> (P (dicho_up x y P n))=true.
-Intros.
-Induction n.
-Simpl.
-Assumption.
-Simpl.
-Assert X := (sumbool_of_bool (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``)).
-Elim X; Intro.
-Rewrite a.
-Unfold dicho_lb in Hrecn; Assumption.
-Rewrite b.
-Assumption.
-Qed.
-
-(* Intermediate Value Theorem *)
-Lemma IVT : (f:R->R;x,y:R) (continuity f) -> ``x<y`` -> ``(f x)<0`` -> ``0<(f y)`` -> (sigTT R [z:R]``x<=z<=y``/\``(f z)==0``).
-Intros.
-Cut ``x<=y``.
-Intro.
-Generalize (dicho_lb_cv x y [z:R](cond_positivity (f z)) H3). 
-Generalize (dicho_up_cv x y [z:R](cond_positivity (f z)) H3). 
-Intros.
-Elim X; Intros.
-Elim X0; Intros.
-Assert H4 := (cv_dicho ? ? ? ? ? H3 p0 p).
-Rewrite H4 in p0.
-Apply existTT with x0.
-Split.
-Split.
-Apply Rle_trans with (dicho_lb x y [z:R](cond_positivity (f z)) O).
-Simpl.
-Right; Reflexivity.
-Apply growing_ineq.
-Apply dicho_lb_growing; Assumption.
-Assumption.
-Apply Rle_trans with (dicho_up x y [z:R](cond_positivity (f z)) O).
-Apply decreasing_ineq.
-Apply dicho_up_decreasing; Assumption.
-Assumption.
-Right; Reflexivity.
-2:Left; Assumption.
-Pose Vn := [n:nat](dicho_lb x y [z:R](cond_positivity (f z)) n).
-Pose Wn := [n:nat](dicho_up x y [z:R](cond_positivity (f z)) n).
-Cut ((n:nat)``(f (Vn n))<=0``)->``(f x0)<=0``.
-Cut ((n:nat)``0<=(f (Wn n))``)->``0<=(f x0)``.
-Intros.
-Cut (n:nat)``(f (Vn n))<=0``.
-Cut (n:nat)``0<=(f (Wn n))``.
-Intros.
-Assert H9 := (H6 H8).
-Assert H10 := (H5 H7).
-Apply Rle_antisym; Assumption.
-Intro.
-Unfold Wn.
-Cut (z:R) (cond_positivity z)=true <-> ``0<=z``.
-Intro.
-Assert H8 := (dicho_up_car x y [z:R](cond_positivity (f z)) n).
-Elim (H7 (f (dicho_up x y [z:R](cond_positivity (f z)) n))); Intros.
-Apply H9.
-Apply H8.
-Elim (H7 (f y)); Intros.
-Apply H12.
-Left; Assumption.
-Intro.
-Unfold cond_positivity.
-Case (total_order_Rle R0 z); Intro.
-Split.
-Intro; Assumption.
-Intro; Reflexivity.
-Split.
-Intro; Elim diff_false_true; Assumption.
-Intro.
-Elim n0; Assumption.
-Unfold Vn.
-Cut (z:R) (cond_positivity z)=false <-> ``z<0``.
-Intros.
-Assert H8 := (dicho_lb_car x y [z:R](cond_positivity (f z)) n).
-Left.
-Elim (H7 (f (dicho_lb x y [z:R](cond_positivity (f z)) n))); Intros.
-Apply H9.
-Apply H8.
-Elim (H7 (f x)); Intros.
-Apply H12.
-Assumption.
-Intro.
-Unfold cond_positivity.
-Case (total_order_Rle R0 z); Intro.
-Split.
-Intro; Elim diff_true_false; Assumption.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H7)).
-Split.
-Intro; Auto with real.
-Intro; Reflexivity.
-Cut (Un_cv Wn x0).
-Intros.
-Assert H7 := (continuity_seq f Wn x0 (H x0) H5).
-Case (total_order_T R0 (f x0)); Intro.
-Elim s; Intro.
-Left; Assumption.
-Rewrite <- b; Right; Reflexivity.
-Unfold Un_cv in H7; Unfold R_dist in H7.
-Cut ``0< -(f x0)``.
-Intro.
-Elim (H7 ``-(f x0)`` H8); Intros.
-Cut (ge x2 x2); [Intro | Unfold ge; Apply le_n].
-Assert H11 := (H9 x2 H10).
-Rewrite Rabsolu_right in H11.
-Pattern 1 ``-(f x0)`` in H11; Rewrite <- Rplus_Or in H11.
-Unfold Rminus in H11; Rewrite (Rplus_sym (f (Wn x2))) in H11.
-Assert H12 := (Rlt_anti_compatibility ? ? ? H11).
-Assert H13 := (H6 x2).
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H13 H12)).
-Apply Rle_sym1; Left; Unfold Rminus; Apply ge0_plus_gt0_is_gt0.
-Apply H6.
-Exact H8.
-Apply Rgt_RO_Ropp; Assumption.
-Unfold Wn; Assumption.
-Cut (Un_cv Vn x0).
-Intros.
-Assert H7 := (continuity_seq f Vn x0 (H x0) H5).
-Case (total_order_T R0 (f x0)); Intro.
-Elim s; Intro.
-Unfold Un_cv in H7; Unfold R_dist in H7.
-Elim (H7 ``(f x0)`` a); Intros.
-Cut (ge x2 x2); [Intro | Unfold ge; Apply le_n].
-Assert H10 := (H8 x2 H9).
-Rewrite Rabsolu_left in H10.
-Pattern 2 ``(f x0)`` in H10; Rewrite <- Rplus_Or in H10.
-Rewrite Ropp_distr3 in H10.
-Unfold Rminus in H10.
-Assert H11 := (Rlt_anti_compatibility ? ? ? H10).
-Assert H12 := (H6 x2).
-Cut ``0<(f (Vn x2))``.
-Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H13 H12)).
-Rewrite <- (Ropp_Ropp (f (Vn x2))).
-Apply Rgt_RO_Ropp; Assumption.
-Apply Rlt_anti_compatibility with ``(f x0)-(f (Vn x2))``.
-Rewrite Rplus_Or; Replace ``(f x0)-(f (Vn x2))+((f (Vn x2))-(f x0))`` with R0; [Unfold Rminus; Apply gt0_plus_ge0_is_gt0 | Ring].
-Assumption.
-Apply Rge_RO_Ropp; Apply Rle_sym1; Apply H6.
-Right; Rewrite <- b; Reflexivity.
-Left; Assumption.
-Unfold Vn; Assumption.
-Qed.
-
-Lemma IVT_cor : (f:R->R;x,y:R) (continuity f) -> ``x<=y`` -> ``(f x)*(f y)<=0`` -> (sigTT R [z:R]``x<=z<=y``/\``(f z)==0``).
-Intros.
-Case (total_order_T R0 (f x)); Intro.
-Case (total_order_T R0 (f y)); Intro.
-Elim s; Intro.
-Elim s0; Intro.
-Cut ``0<(f x)*(f y)``; [Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 H2)) | Apply Rmult_lt_pos; Assumption].
-Exists y.
-Split.
-Split; [Assumption | Right; Reflexivity].
-Symmetry; Exact b.
-Exists x.
-Split.
-Split; [Right; Reflexivity | Assumption].
-Symmetry; Exact b.
-Elim s; Intro.
-Cut ``x<y``.
-Intro.
-Assert H3 := (IVT (opp_fct f) x y (continuity_opp f H) H2).
-Cut ``(opp_fct f x)<0``.
-Cut ``0<(opp_fct f y)``.
-Intros.
-Elim (H3 H5 H4); Intros.
-Apply existTT with x0.
-Elim p; Intros.
-Split.
-Assumption.
-Unfold opp_fct in H7.
-Rewrite <- (Ropp_Ropp (f x0)).
-Apply eq_RoppO; Assumption.
-Unfold opp_fct; Apply Rgt_RO_Ropp; Assumption.
-Unfold opp_fct.
-Apply Rlt_anti_compatibility with (f x); Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Assumption.
-Inversion H0.
-Assumption.
-Rewrite H2 in a.
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? r a)).
-Apply existTT with x.
-Split.
-Split; [Right; Reflexivity | Assumption].
-Symmetry; Assumption.
-Case (total_order_T R0 (f y)); Intro.
-Elim s; Intro.
-Cut ``x<y``.
-Intro.
-Apply IVT; Assumption.
-Inversion H0.
-Assumption.
-Rewrite H2 in r.
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? r a)).
-Apply existTT with y.
-Split.
-Split; [Assumption | Right; Reflexivity].
-Symmetry; Assumption.
-Cut ``0<(f x)*(f y)``.
-Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H2 H1)).
-Rewrite <- Ropp_mul2; Apply Rmult_lt_pos; Apply Rgt_RO_Ropp; Assumption.
-Qed.
-
-(* We can now define the square root function as the reciprocal transformation of the square root function *)
-Lemma Rsqrt_exists : (y:R) ``0<=y`` -> (sigTT R [z:R]``0<=z``/\``y==(Rsqr z)``).
-Intros.
-Pose f := [x:R]``(Rsqr x)-y``.
-Cut ``(f 0)<=0``.
-Intro.
-Cut (continuity f).
-Intro.
-Case (total_order_T y R1); Intro.
-Elim s; Intro.
-Cut ``0<=(f 1)``.
-Intro.
-Cut ``(f 0)*(f 1)<=0``.
-Intro.
-Assert X := (IVT_cor f R0 R1 H1 (Rlt_le ? ? Rlt_R0_R1) H3).
-Elim X; Intros t H4.
-Apply existTT with t.
-Elim H4; Intros.
-Split.
-Elim H5; Intros; Assumption.
-Unfold f in H6.
-Apply Rminus_eq_right; Exact H6.
-Rewrite Rmult_sym; Pattern 2 R0; Rewrite <- (Rmult_Or (f R1)).
-Apply Rle_monotony; Assumption.
-Unfold f.
-Rewrite Rsqr_1.
-Apply Rle_anti_compatibility with y.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Left; Assumption.
-Apply existTT with R1.
-Split.
-Left; Apply Rlt_R0_R1.
-Rewrite b; Symmetry; Apply Rsqr_1.
-Cut ``0<=(f y)``.
-Intro.
-Cut ``(f 0)*(f y)<=0``.
-Intro.
-Assert X := (IVT_cor f R0 y H1 H H3).
-Elim X; Intros t H4.
-Apply existTT with t.
-Elim H4; Intros.
-Split.
-Elim H5; Intros; Assumption.
-Unfold f in H6.
-Apply Rminus_eq_right; Exact H6.
-Rewrite Rmult_sym; Pattern 2 R0; Rewrite <- (Rmult_Or (f y)).
-Apply Rle_monotony; Assumption.
-Unfold f.
-Apply Rle_anti_compatibility with y.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 1 y; Rewrite <- Rmult_1r.
-Unfold Rsqr; Apply Rle_monotony.
-Assumption.
-Left; Exact r.
-Replace f with (minus_fct Rsqr (fct_cte y)).
-Apply continuity_minus.
-Apply derivable_continuous; Apply derivable_Rsqr.
-Apply derivable_continuous; Apply derivable_const.
-Reflexivity.
-Unfold f; Rewrite Rsqr_O.
-Unfold Rminus; Rewrite Rplus_Ol.
-Apply Rle_sym2.
-Apply Rle_RO_Ropp; Assumption.
-Qed.
-
-(* Definition of the square root: R+->R *)
-Definition Rsqrt [y:nonnegreal] : R := Cases (Rsqrt_exists (nonneg y) (cond_nonneg y)) of (existTT a b) => a end.
-
-(**********)
-Lemma Rsqrt_positivity : (x:nonnegreal) ``0<=(Rsqrt x)``.
-Intro.
-Assert X := (Rsqrt_exists (nonneg x) (cond_nonneg x)).
-Elim X; Intros.
-Cut x0==(Rsqrt x).
-Intros.
-Elim p; Intros.
-Rewrite H in H0; Assumption.
-Unfold Rsqrt.
-Case (Rsqrt_exists x (cond_nonneg x)).
-Intros.
-Elim p; Elim a; Intros.
-Apply Rsqr_inj.
-Assumption.
-Assumption.
-Rewrite <- H0; Rewrite <- H2; Reflexivity.
-Qed.
-
-(**********)
-Lemma Rsqrt_Rsqrt : (x:nonnegreal) ``(Rsqrt x)*(Rsqrt x)==x``.
-Intros.
-Assert X := (Rsqrt_exists (nonneg x) (cond_nonneg x)).
-Elim X; Intros.
-Cut x0==(Rsqrt x).
-Intros.
-Rewrite <- H.
-Elim p; Intros.
-Rewrite H1; Reflexivity.
-Unfold Rsqrt.
-Case (Rsqrt_exists x (cond_nonneg x)).
-Intros.
-Elim p; Elim a; Intros.
-Apply Rsqr_inj.
-Assumption.
-Assumption.
-Rewrite <- H0; Rewrite <- H2; Reflexivity.
-Qed.
diff --git a/theories7/Reals/Rsyntax.v b/theories7/Reals/Rsyntax.v
deleted file mode 100644
index 7b1b6266..00000000
--- a/theories7/Reals/Rsyntax.v
+++ /dev/null
@@ -1,236 +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: Rsyntax.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-Require Export Rdefinitions.
-
-Axiom NRplus : R->R.
-Axiom NRmult : R->R.
-
-V7only[
-Grammar rnatural ident :=
-  nat_id [ prim:var($id) ] -> [$id]
-
-with rnegnumber : constr := 
-  neg_expr [ "-" rnumber ($c) ] -> [ (Ropp $c) ] 
-
-with rnumber :=
-
-with rformula : constr :=
-  form_expr [ rexpr($p) ] -> [ $p ]
-(* | form_eq [ rexpr($p) "==" rexpr($c) ] -> [ (eqT R $p $c) ] *)
-| form_eq [ rexpr($p) "==" rexpr($c) ] -> [ (eqT ? $p $c) ]
-| form_eq2 [ rexpr($p) "=" rexpr($c) ] -> [ (eqT ? $p $c) ]
-| form_le [ rexpr($p) "<=" rexpr($c) ] -> [ (Rle $p $c) ]
-| form_lt [ rexpr($p) "<" rexpr($c) ] -> [ (Rlt $p $c) ]
-| form_ge [ rexpr($p) ">=" rexpr($c) ] -> [ (Rge $p $c) ]
-| form_gt [ rexpr($p) ">" rexpr($c) ] -> [ (Rgt $p $c) ]
-(*
-| form_eq_eq [ rexpr($p) "==" rexpr($c) "==" rexpr($c1) ]
-              -> [ (eqT R $p $c)/\(eqT R $c $c1) ]
-*)
-| form_eq_eq [ rexpr($p) "==" rexpr($c) "==" rexpr($c1) ]
-              -> [ (eqT ? $p $c)/\(eqT ? $c $c1) ]
-| form_le_le [ rexpr($p) "<=" rexpr($c) "<=" rexpr($c1) ]
-              -> [ (Rle $p $c)/\(Rle $c $c1) ]
-| form_le_lt [ rexpr($p) "<=" rexpr($c) "<" rexpr($c1) ]
-              -> [ (Rle $p $c)/\(Rlt $c $c1) ]
-| form_lt_le [ rexpr($p) "<" rexpr($c) "<=" rexpr($c1) ]
-              -> [ (Rlt $p $c)/\(Rle $c $c1) ]
-| form_lt_lt [ rexpr($p) "<" rexpr($c) "<" rexpr($c1) ]
-              -> [ (Rlt $p $c)/\(Rlt $c $c1) ]
-| form_neq  [ rexpr($p) "<>" rexpr($c) ] -> [ ~(eqT ? $p $c) ]
-
-with rexpr : constr :=
-  expr_plus [ rexpr($p) "+" rexpr($c) ] -> [ (Rplus $p $c) ]
-| expr_minus [ rexpr($p) "-" rexpr($c) ] -> [ (Rminus $p $c) ]
-| rexpr2 [ rexpr2($e) ] -> [ $e ]
-
-with rexpr2 : constr :=
-  expr_mult [ rexpr2($p) "*" rexpr2($c) ] -> [ (Rmult $p $c) ]
-| rexpr0 [ rexpr0($e) ] -> [ $e ]
-
-
-with rexpr0 : constr :=
-  expr_id [ constr:global($c) ] -> [ $c ]
-| expr_com [ "[" constr:constr($c) "]" ] -> [ $c ]
-| expr_appl [ "(" rapplication($a) ")" ] -> [ $a ]
-| expr_num [ rnumber($s) ] -> [ $s ]
-| expr_negnum [ "-" rnegnumber($n) ] -> [ $n ]
-| expr_div [ rexpr0($p) "/" rexpr0($c) ] -> [ (Rdiv $p $c) ]
-| expr_opp [ "-" rexpr0($c) ] -> [ (Ropp $c) ] 
-| expr_inv [ "/" rexpr0($c) ] -> [ (Rinv $c) ]
-| expr_meta [ meta($m) ] -> [ $m ]
-
-with meta :=
-| rimpl [ "?" ] -> [ ? ]
-| rmeta0 [ "?" "0" ] -> [ ?0 ]
-| rmeta1 [ "?" "1" ] -> [ ?1 ]
-| rmeta2 [ "?" "2" ] -> [ ?2 ]
-| rmeta3 [ "?" "3" ] -> [ ?3 ]
-| rmeta4 [ "?" "4" ] -> [ ?4 ]
-| rmeta5 [ "?" "5" ] -> [ ?5 ]
-
-with rapplication : constr :=
-  apply [ rapplication($p) rexpr($c1) ] -> [ ($p $c1) ]
-| pair [ rexpr($p) "," rexpr($c) ] -> [ ($p, $c) ]
-| appl0 [ rexpr($a) ] -> [ $a ].
-
-Grammar constr constr0 :=
-  r_in_com [ "``" rnatural:rformula($c) "``" ] -> [ $c ].
-
-Grammar constr atomic_pattern :=
-  r_in_pattern [ "``" rnatural:rnumber($c) "``" ] -> [ $c ].   
-
-(*i* pp **)
-
-Syntax constr
-  level 0:
-   Rle [ (Rle $n1 $n2) ] -> 
-      [[<hov 0> "``" (REXPR $n1) [1 0] "<= " (REXPR $n2) "``"]]
-  | Rlt [ (Rlt $n1 $n2) ] -> 
-      [[<hov 0> "``" (REXPR $n1) [1 0] "< "(REXPR $n2) "``" ]]
-  | Rge [ (Rge $n1 $n2) ] -> 
-      [[<hov 0> "``" (REXPR $n1) [1 0] ">= "(REXPR $n2) "``" ]]
-  | Rgt [ (Rgt $n1 $n2) ] -> 
-      [[<hov 0> "``" (REXPR $n1) [1 0] "> "(REXPR $n2) "``" ]]
-  | Req [ (eqT R $n1 $n2) ] -> 
-      [[<hov 0> "``" (REXPR $n1) [1 0] "= "(REXPR $n2)"``"]]
-  | Rneq [ ~(eqT R $n1 $n2) ] ->
-      [[<hov 0> "``" (REXPR $n1) [1 0] "<> "(REXPR $n2) "``"]]
-  | Rle_Rle [ (Rle $n1 $n2)/\(Rle $n2 $n3) ] ->
-      [[<hov 0> "``" (REXPR $n1) [1 0] "<= " (REXPR $n2)
-                                [1 0] "<= " (REXPR $n3) "``"]]
-  | Rle_Rlt [ (Rle $n1 $n2)/\(Rlt $n2 $n3) ] ->
-      [[<hov 0> "``" (REXPR $n1) [1 0] "<= "(REXPR $n2)
-                                [1 0] "< " (REXPR $n3) "``"]]
-  | Rlt_Rle [ (Rlt $n1 $n2)/\(Rle $n2 $n3) ] ->
-      [[<hov 0> "``" (REXPR $n1) [1 0] "< " (REXPR $n2)
-                                [1 0] "<= " (REXPR $n3) "``"]]
-  | Rlt_Rlt [ (Rlt $n1 $n2)/\(Rlt $n2 $n3) ] ->
-      [[<hov 0> "``" (REXPR $n1) [1 0] "< " (REXPR $n2)
-                                [1 0] "< " (REXPR $n3) "``"]]
-  | Rzero [ R0 ] -> [ "``0``" ]
-  | Rone [ R1 ] -> [ "``1``" ]
-  ;
-
-  level 7:
-    Rplus [ (Rplus $n1 $n2) ]
-      -> [ [<hov 0> "``"(REXPR $n1):E "+"  [0 0] (REXPR $n2):L "``"] ]
-   | Rodd_outside [(Rplus R1 $r)] -> [ $r:"r_printer_odd_outside"]
-   | Rminus [ (Rminus $n1 $n2) ]
-      -> [ [<hov 0> "``"(REXPR $n1):E "-" [0 0] (REXPR $n2):L "``"] ]
-  ;
-
-  level 6:
-    Rmult [ (Rmult $n1 $n2) ]
-      -> [ [<hov 0> "``"(REXPR $n1):E "*" [0 0] (REXPR $n2):L "``"] ]
-    | Reven_outside [ (Rmult (Rplus R1 R1) $r) ] -> [ $r:"r_printer_even_outside"]
-    | Rdiv [ (Rdiv $n1 $n2) ]
-      -> [ [<hov 0> "``"(REXPR $n1):E "/" [0 0] (REXPR $n2):L "``"] ]
-  ;
-
-  level 8:
-    Ropp [(Ropp $n1)] -> [ [<hov 0> "``" "-"(REXPR $n1):E "``"] ]
-    | Rinv [(Rinv $n1)] -> [ [<hov 0> "``" "/"(REXPR $n1):E "``"] ]
-  ;
-
-  level 0:
-    rescape_inside [<< (REXPR $r) >>] -> [ "[" $r:E "]" ]
-  ;
-
-  level 4:
-    Rappl_inside [<<(REXPR (APPLIST $h ($LIST $t)))>>]
- -> [ [<hov 0> "("(REXPR $h):E [1 0] (RAPPLINSIDETAIL ($LIST $t)):E ")"] ]
-  | Rappl_inside_tail [<<(RAPPLINSIDETAIL $h ($LIST $t))>>]
-      -> [(REXPR $h):E [1 0] (RAPPLINSIDETAIL ($LIST $t)):E] 
-  | Rappl_inside_one [<<(RAPPLINSIDETAIL $e)>>] ->[(REXPR $e):E]
-  | rpair_inside [<<(REXPR <<(pair $s1 $s2 $r1 $r2)>>)>>] 
-      -> [ [<hov 0> "("(REXPR $r1):E "," [1 0] (REXPR $r2):E ")"] ]
-  ;
-
- level 3:
-    rvar_inside [<<(REXPR ($VAR $i))>>] -> [$i]
-  | rsecvar_inside [<<(REXPR (SECVAR $i))>>] -> [(SECVAR $i)]
-  | rconst_inside [<<(REXPR (CONST $c))>>] -> [(CONST $c)]
-  | rmutind_inside [<<(REXPR (MUTIND $i $n))>>] 
-      -> [(MUTIND $i $n)]
-  | rmutconstruct_inside [<<(REXPR (MUTCONSTRUCT $c1 $c2 $c3))>>]
-      -> [ (MUTCONSTRUCT $c1 $c2 $c3) ]
-  | rimplicit_head_inside [<<(REXPR (XTRA "!" $c))>>] -> [ $c ]
-  | rimplicit_arg_inside  [<<(REXPR (XTRA "!" $n $c))>>] -> [ ]
-
-  ;
-
-  
-  level 7:
-   Rplus_inside
-      [<<(REXPR <<(Rplus $n1 $n2)>>)>>]
-      	 -> [ (REXPR $n1):E "+" [0 0] (REXPR $n2):L ]
-  | Rminus_inside
-      [<<(REXPR <<(Rminus $n1 $n2)>>)>>]
-      	 -> [ (REXPR $n1):E "-" [0 0] (REXPR $n2):L ]
-  | NRplus_inside
-      [<<(REXPR <<(NRplus $r)>>)>>] -> [ "(" "1" "+" (REXPR $r):L ")"]
-  ;
-
-  level 6:
-    Rmult_inside
-      [<<(REXPR <<(Rmult $n1 $n2)>>)>>]
-      	 -> [ (REXPR $n1):E "*" (REXPR $n2):L ]
-  |  NRmult_inside
-      [<<(REXPR <<(NRmult $r)>>)>>] -> [ "(" "2" "*" (REXPR $r):L ")"]
-  ;
-
-  level 5:
-    Ropp_inside [<<(REXPR <<(Ropp $n1)>>)>>] -> [ " -" (REXPR $n1):E  ]
-  | Rinv_inside [<<(REXPR <<(Rinv $n1)>>)>>] -> [ "/" (REXPR $n1):E  ]
-  | Rdiv_inside
-      [<<(REXPR <<(Rdiv $n1 $n2)>>)>>]
-      	 -> [ (REXPR $n1):E "/" [0 0] (REXPR $n2):L ]
-  ;  
-
-  level 0:
-    Rzero_inside [<<(REXPR <<R0>>)>>] -> ["0"]
-  | Rone_inside [<<(REXPR <<R1>>)>>] -> ["1"]
-  | Rodd_inside [<<(REXPR <<(Rplus R1 $r)>>)>>] -> [ $r:"r_printer_odd" ]
-  | Reven_inside [<<(REXPR <<(Rmult (Rplus R1 R1) $r)>>)>>] -> [ $r:"r_printer_even" ]
-.
-
-(* For parsing/printing based on scopes *)
-Module R_scope.
-
-Infix "<=" Rle (at level 5, no associativity) : R_scope V8only.
-Infix "<"  Rlt (at level 5, no associativity) : R_scope V8only.
-Infix ">=" Rge (at level 5, no associativity) : R_scope V8only.
-Infix ">" Rgt (at level 5, no associativity) : R_scope V8only.
-Infix "+" Rplus (at level 4) : R_scope V8only.
-Infix "-" Rminus (at level 4) : R_scope V8only.
-Infix "*" Rmult (at level 3) : R_scope V8only.
-Infix "/" Rdiv (at level 3) : R_scope V8only.
-Notation "- x" := (Ropp x) (at level 0) : R_scope V8only.
-Notation "x == y == z" := (eqT R x y)/\(eqT R y z)
-  (at level 5, y at level 4, no associtivity): R_scope.
-Notation "x <= y <= z" := (Rle x y)/\(Rle y z)
-  (at level 5, y at level 4) : R_scope
-  V8only.
-Notation "x <= y < z" := (Rle x y)/\(Rlt y z)
-  (at level 5, y at level 4) : R_scope
-  V8only.
-Notation "x < y < z" := (Rlt x y)/\(Rlt y z)
-  (at level 5, y at level 4) : R_scope
-  V8only.
-Notation "x < y <= z" := (Rlt x y)/\(Rle y z)
-  (at level 5, y at level 4) : R_scope
-  V8only.
-Notation "/ x" := (Rinv x) (at level 0): R_scope
-  V8only.
-
-Open Local Scope R_scope.
-End R_scope.
-].
diff --git a/theories7/Reals/Rtopology.v b/theories7/Reals/Rtopology.v
deleted file mode 100644
index f2ae19b9..00000000
--- a/theories7/Reals/Rtopology.v
+++ /dev/null
@@ -1,1178 +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: Rtopology.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-Require RList.
-Require Classical_Prop.
-Require Classical_Pred_Type.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-Definition included [D1,D2:R->Prop] : Prop := (x:R)(D1 x)->(D2 x).
-Definition disc [x:R;delta:posreal] : R->Prop := [y:R]``(Rabsolu (y-x))<delta``.
-Definition neighbourhood [V:R->Prop;x:R] : Prop := (EXT delta:posreal | (included (disc x delta) V)).
-Definition open_set [D:R->Prop] : Prop := (x:R) (D x)->(neighbourhood D x).
-Definition complementary [D:R->Prop] : R->Prop := [c:R]~(D c).
-Definition closed_set [D:R->Prop] : Prop := (open_set (complementary D)).
-Definition intersection_domain [D1,D2:R->Prop] : R->Prop := [c:R](D1 c)/\(D2 c).
-Definition union_domain [D1,D2:R->Prop] : R->Prop := [c:R](D1 c)\/(D2 c).
-Definition interior [D:R->Prop] : R->Prop := [x:R](neighbourhood D x).
-
-Lemma interior_P1 : (D:R->Prop) (included (interior D) D).
-Intros; Unfold included; Unfold interior; Intros; Unfold neighbourhood in H; Elim H; Intros; Unfold included in H0; Apply H0; Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos x0).
-Qed.
-
-Lemma interior_P2 : (D:R->Prop) (open_set D) -> (included D (interior D)).
-Intros; Unfold open_set in H; Unfold included; Intros; Assert H1 := (H ? H0); Unfold interior; Apply H1.
-Qed.
-
-Definition point_adherent [D:R->Prop;x:R] : Prop := (V:R->Prop) (neighbourhood V x) -> (EXT y:R | (intersection_domain V D y)).
-Definition adherence [D:R->Prop] : R->Prop := [x:R](point_adherent D x).
-
-Lemma adherence_P1 : (D:R->Prop) (included D (adherence D)).
-Intro; Unfold included; Intros; Unfold adherence; Unfold point_adherent; Intros; Exists x; Unfold intersection_domain; Split.
-Unfold neighbourhood in H0; Elim H0; Intros; Unfold included in H1; Apply H1; Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos x0).
-Apply H.
-Qed.
-
-Lemma included_trans : (D1,D2,D3:R->Prop) (included D1 D2) -> (included D2 D3) -> (included D1 D3).
-Unfold included; Intros; Apply H0; Apply H; Apply H1.
-Qed.
-
-Lemma interior_P3 : (D:R->Prop) (open_set (interior D)).
-Intro; Unfold open_set interior; Unfold neighbourhood; Intros; Elim H; Intros.
-Exists x0; Unfold included; Intros.
-Pose del := ``x0-(Rabsolu (x-x1))``.
-Cut ``0<del``.
-Intro; Exists (mkposreal del H2); Intros.
-Cut (included (disc x1 (mkposreal del H2)) (disc x x0)).
-Intro; Assert H5 := (included_trans ? ? ? H4 H0).
-Apply H5; Apply H3.
-Unfold included; Unfold disc; Intros.
-Apply Rle_lt_trans with ``(Rabsolu (x3-x1))+(Rabsolu (x1-x))``.
-Replace ``x3-x`` with ``(x3-x1)+(x1-x)``; [Apply Rabsolu_triang | Ring].
-Replace (pos x0) with ``del+(Rabsolu (x1-x))``.
-Do 2 Rewrite <- (Rplus_sym (Rabsolu ``x1-x``)); Apply Rlt_compatibility; Apply H4.
-Unfold del; Rewrite <- (Rabsolu_Ropp ``x-x1``); Rewrite Ropp_distr2; Ring.
-Unfold del; Apply Rlt_anti_compatibility with ``(Rabsolu (x-x1))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x1))+(x0-(Rabsolu (x-x1)))`` with (pos x0); [Idtac | Ring].
-Unfold disc in H1; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H1.
-Qed.
-
-Lemma complementary_P1 : (D:R->Prop) ~(EXT y:R | (intersection_domain D (complementary D) y)).
-Intro; Red; Intro; Elim H; Intros; Unfold intersection_domain complementary in H0; Elim H0; Intros; Elim H2; Assumption.
-Qed.
-
-Lemma adherence_P2 : (D:R->Prop) (closed_set D) -> (included (adherence D) D).
-Unfold closed_set; Unfold open_set complementary; Intros; Unfold included adherence; Intros; Assert H1 := (classic (D x)); Elim H1; Intro.
-Assumption.
-Assert H3 := (H ? H2); Assert H4 := (H0 ? H3); Elim H4; Intros; Unfold intersection_domain in H5; Elim H5; Intros; Elim H6; Assumption.
-Qed.
-
-Lemma adherence_P3 : (D:R->Prop) (closed_set (adherence D)).
-Intro; Unfold closed_set adherence; Unfold open_set complementary point_adherent; Intros; Pose P := [V:R->Prop](neighbourhood V x)->(EXT y:R | (intersection_domain V D y)); Assert H0 := (not_all_ex_not ? P H); Elim H0; Intros V0 H1; Unfold P in H1; Assert H2 := (imply_to_and ? ? H1); Unfold neighbourhood; Elim H2; Intros; Unfold neighbourhood in H3; Elim H3; Intros; Exists x0; Unfold included; Intros; Red; Intro.
-Assert H8 := (H7 V0); Cut (EXT delta:posreal | (x:R)(disc x1 delta x)->(V0 x)).
-Intro; Assert H10 := (H8 H9); Elim H4; Assumption.
-Cut ``0<x0-(Rabsolu (x-x1))``.
-Intro; Pose del := (mkposreal ? H9); Exists del; Intros; Unfold included in H5; Apply H5; Unfold disc; Apply Rle_lt_trans with ``(Rabsolu (x2-x1))+(Rabsolu (x1-x))``.
-Replace ``x2-x`` with ``(x2-x1)+(x1-x)``; [Apply Rabsolu_triang | Ring].
-Replace (pos x0) with ``del+(Rabsolu (x1-x))``.
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x1-x))``); Apply Rlt_compatibility; Apply H10.
-Unfold del; Simpl; Rewrite <- (Rabsolu_Ropp ``x-x1``); Rewrite Ropp_distr2; Ring.
-Apply Rlt_anti_compatibility with ``(Rabsolu (x-x1))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x1))+(x0-(Rabsolu (x-x1)))`` with (pos x0); [Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H6 | Ring].
-Qed.
-
-Definition eq_Dom [D1,D2:R->Prop] : Prop := (included D1 D2)/\(included D2 D1).
-
-Infix "=_D" eq_Dom (at level 5, no associativity).
-
-Lemma open_set_P1 : (D:R->Prop) (open_set D) <-> D =_D (interior D).
-Intro; Split.
-Intro; Unfold eq_Dom; Split.
-Apply interior_P2; Assumption.
-Apply interior_P1.
-Intro; Unfold eq_Dom in H; Elim H; Clear H; Intros; Unfold open_set; Intros; Unfold included interior in H; Unfold included in H0; Apply (H ? H1).
-Qed.
-
-Lemma closed_set_P1 : (D:R->Prop) (closed_set D) <-> D =_D (adherence D).
-Intro; Split.
-Intro; Unfold eq_Dom; Split.
-Apply adherence_P1.
-Apply adherence_P2; Assumption.
-Unfold eq_Dom; Unfold included; Intros; Assert H0 := (adherence_P3 D); Unfold closed_set in H0; Unfold closed_set; Unfold open_set; Unfold open_set in H0; Intros; Assert H2 : (complementary (adherence D) x).
-Unfold complementary; Unfold complementary in H1; Red; Intro; Elim H; Clear H; Intros _ H; Elim H1; Apply (H ? H2).
-Assert H3 := (H0 ? H2); Unfold neighbourhood; Unfold neighbourhood in H3; Elim H3; Intros; Exists x0; Unfold included; Unfold included in H4; Intros; Assert H6 := (H4 ? H5); Unfold complementary in H6; Unfold complementary; Red; Intro; Elim H; Clear H; Intros H _; Elim H6; Apply (H ? H7).
-Qed.
-
-Lemma neighbourhood_P1 : (D1,D2:R->Prop;x:R) (included D1 D2) -> (neighbourhood D1 x) -> (neighbourhood D2 x).
-Unfold included neighbourhood; Intros; Elim H0; Intros; Exists x0; Intros; Unfold included; Unfold included in H1; Intros; Apply (H ? (H1 ? H2)).
-Qed.
-
-Lemma open_set_P2 : (D1,D2:R->Prop) (open_set D1) -> (open_set D2) -> (open_set (union_domain D1 D2)).
-Unfold open_set; Intros; Unfold union_domain in H1; Elim H1; Intro.
-Apply neighbourhood_P1 with D1.
-Unfold included union_domain; Tauto.
-Apply H; Assumption.
-Apply neighbourhood_P1 with D2.
-Unfold included union_domain; Tauto.
-Apply H0; Assumption.
-Qed.
-
-Lemma open_set_P3 : (D1,D2:R->Prop) (open_set D1) -> (open_set D2) -> (open_set (intersection_domain D1 D2)).
-Unfold open_set; Intros; Unfold intersection_domain in H1; Elim H1; Intros.
-Assert H4 := (H ? H2); Assert H5 := (H0 ? H3); Unfold intersection_domain; Unfold neighbourhood in H4 H5; Elim H4; Clear H; Intros del1 H; Elim H5; Clear H0; Intros del2 H0; Cut ``0<(Rmin del1 del2)``.
-Intro; Pose del := (mkposreal ? H6).
-Exists del; Unfold included; Intros; Unfold included in H H0; Unfold disc in H H0 H7.
-Split.
-Apply H; Apply Rlt_le_trans with (pos del).
-Apply H7.
-Unfold del; Simpl; Apply Rmin_l.
-Apply H0; Apply Rlt_le_trans with (pos del).
-Apply H7.
-Unfold del; Simpl; Apply Rmin_r.
-Unfold Rmin; Case (total_order_Rle del1 del2); Intro.
-Apply (cond_pos del1).
-Apply (cond_pos del2).
-Qed.
-
-Lemma open_set_P4 : (open_set [x:R]False).
-Unfold open_set; Intros; Elim H.
-Qed.
-
-Lemma open_set_P5 : (open_set [x:R]True).
-Unfold open_set; Intros; Unfold neighbourhood.
-Exists (mkposreal R1 Rlt_R0_R1); Unfold included; Intros; Trivial.
-Qed.
-
-Lemma disc_P1 : (x:R;del:posreal) (open_set (disc x del)).
-Intros; Assert H := (open_set_P1 (disc x del)).
-Elim H; Intros; Apply H1.
-Unfold eq_Dom; Split.
-Unfold included interior disc; Intros; Cut ``0<del-(Rabsolu (x-x0))``.
-Intro; Pose del2 := (mkposreal ? H3).
-Exists del2; Unfold included; Intros.
-Apply Rle_lt_trans with ``(Rabsolu (x1-x0))+(Rabsolu (x0 -x))``.
-Replace ``x1-x`` with ``(x1-x0)+(x0-x)``; [Apply Rabsolu_triang | Ring].
-Replace (pos del) with ``del2 + (Rabsolu (x0-x))``.
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x0-x))``); Apply Rlt_compatibility.
-Apply H4.
-Unfold del2; Simpl; Rewrite <- (Rabsolu_Ropp ``x-x0``); Rewrite Ropp_distr2; Ring.
-Apply Rlt_anti_compatibility with ``(Rabsolu (x-x0))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x0))+(del-(Rabsolu (x-x0)))`` with (pos del); [Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H2 | Ring].
-Apply interior_P1.
-Qed.
-
-Lemma continuity_P1 : (f:R->R;x:R) (continuity_pt f x) <-> (W:R->Prop)(neighbourhood W (f x)) -> (EXT V:R->Prop | (neighbourhood V x) /\ ((y:R)(V y)->(W (f y)))).
-Intros; Split.
-Intros; Unfold neighbourhood in H0.
-Elim H0; Intros del1 H1.
-Unfold continuity_pt in H; Unfold continue_in in H; Unfold limit1_in in H; Unfold limit_in in H; Simpl in H; Unfold R_dist in H.
-Assert H2 := (H del1 (cond_pos del1)).
-Elim H2; Intros del2 H3.
-Elim H3; Intros.
-Exists (disc x (mkposreal del2 H4)).
-Intros; Unfold included in H1; Split.
-Unfold neighbourhood disc.
-Exists (mkposreal del2 H4).
-Unfold included; Intros; Assumption.
-Intros; Apply H1; Unfold disc; Case (Req_EM y x); Intro.
-Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos del1).
-Apply H5; Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply not_sym; Apply H7.
-Unfold disc in H6; Apply H6.
-Intros; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Intros.
-Assert H1 := (H (disc (f x) (mkposreal eps H0))).
-Cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)).
-Intro; Assert H3 := (H1 H2).
-Elim H3; Intros D H4; Elim H4; Intros; Unfold neighbourhood in H5; Elim H5; Intros del1 H7.
-Exists (pos del1); Split.
-Apply (cond_pos del1).
-Intros; Elim H8; Intros; Simpl in H10; Unfold R_dist in H10; Simpl; Unfold R_dist; Apply (H6 ? (H7 ? H10)).
-Unfold neighbourhood disc; Exists (mkposreal eps H0); Unfold included; Intros; Assumption.
-Qed.
-
-Definition image_rec [f:R->R;D:R->Prop] : R->Prop := [x:R](D (f x)).
-
-(**********)
-Lemma continuity_P2 : (f:R->R;D:R->Prop) (continuity f) -> (open_set D) -> (open_set (image_rec f D)).
-Intros; Unfold open_set in H0; Unfold open_set; Intros; Assert H2 := (continuity_P1 f x); Elim H2; Intros H3 _; Assert H4 := (H3 (H x)); Unfold neighbourhood image_rec; Unfold image_rec in H1; Assert H5 := (H4 D (H0 (f x) H1)); Elim H5; Intros V0 H6; Elim H6; Intros; Unfold neighbourhood in H7; Elim H7; Intros del H9; Exists del; Unfold included in H9; Unfold included; Intros; Apply (H8 ? (H9 ? H10)).
-Qed.
-
-(**********)
-Lemma continuity_P3 : (f:R->R) (continuity f) <-> (D:R->Prop) (open_set D)->(open_set (image_rec f D)).
-Intros; Split.
-Intros; Apply continuity_P2; Assumption.
-Intros; Unfold continuity; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Cut (open_set (disc (f x) (mkposreal ? H0))).
-Intro; Assert H2 := (H ? H1).
-Unfold open_set image_rec in H2; Cut (disc (f x) (mkposreal ? H0) (f x)).
-Intro; Assert H4 := (H2 ? H3).
-Unfold neighbourhood in H4; Elim H4; Intros del H5.
-Exists (pos del); Split.
-Apply (cond_pos del).
-Intros; Unfold included in H5; Apply H5; Elim H6; Intros; Apply H8.
-Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H0.
-Apply disc_P1.
-Qed.
-
-(**********)
-Theorem Rsepare : (x,y:R) ``x<>y``->(EXT V:R->Prop | (EXT W:R->Prop | (neighbourhood V x)/\(neighbourhood W y)/\~(EXT y:R | (intersection_domain V W y)))).
-Intros x y Hsep; Pose D := ``(Rabsolu (x-y))``.
-Cut ``0<D/2``.
-Intro; Exists (disc x (mkposreal ? H)).
-Exists (disc y (mkposreal ? H)); Split.
-Unfold neighbourhood; Exists (mkposreal ? H); Unfold included; Tauto.
-Split.
-Unfold neighbourhood; Exists (mkposreal ? H); Unfold included; Tauto.
-Red; Intro; Elim H0; Intros; Unfold intersection_domain in H1; Elim H1; Intros.
-Cut ``D<D``.
-Intro; Elim (Rlt_antirefl ? H4).
-Change ``(Rabsolu (x-y))<D``; Apply Rle_lt_trans with ``(Rabsolu (x-x0))+(Rabsolu (x0-y))``.
-Replace ``x-y`` with ``(x-x0)+(x0-y)``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var D); Apply Rplus_lt.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H2.
-Apply H3.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Unfold D; Apply Rabsolu_pos_lt; Apply (Rminus_eq_contra ? ? Hsep).
-Apply Rlt_Rinv; Sup0.
-Qed.
-
-Record family : Type := mkfamily {
-  ind : R->Prop;
-  f :> R->R->Prop;
-  cond_fam : (x:R)(EXT y:R|(f x y))->(ind x) }.
-
-Definition family_open_set [f:family] : Prop := (x:R) (open_set (f x)).
-
-Definition domain_finite [D:R->Prop] : Prop := (EXT l:Rlist | (x:R)(D x)<->(In x l)).
-
-Definition family_finite [f:family] : Prop := (domain_finite (ind f)).
-
-Definition covering [D:R->Prop;f:family] : Prop := (x:R) (D x)->(EXT y:R | (f y x)).
-
-Definition covering_open_set [D:R->Prop;f:family] : Prop := (covering D f)/\(family_open_set f).
-
-Definition covering_finite [D:R->Prop;f:family] : Prop := (covering D f)/\(family_finite f).
-
-Lemma restriction_family : (f:family;D:R->Prop) (x:R)(EXT y:R|([z1:R][z2:R](f z1 z2)/\(D z1) x y))->(intersection_domain (ind f) D x).
-Intros; Elim H; Intros; Unfold intersection_domain; Elim H0; Intros; Split.
-Apply (cond_fam f0); Exists x0; Assumption.
-Assumption.
-Qed.
-
-Definition subfamily [f:family;D:R->Prop] : family := (mkfamily (intersection_domain (ind f) D) [x:R][y:R](f x y)/\(D x) (restriction_family f D)).
-
-Definition compact [X:R->Prop] : Prop := (f:family) (covering_open_set X f) -> (EXT D:R->Prop | (covering_finite X (subfamily f D))).
-
-(**********)
-Lemma family_P1 : (f:family;D:R->Prop) (family_open_set f) -> (family_open_set (subfamily f D)).
-Unfold family_open_set; Intros; Unfold subfamily; Simpl; Assert H0 := (classic (D x)).
-Elim H0; Intro.
-Cut (open_set (f0 x))->(open_set [y:R](f0 x y)/\(D x)).
-Intro; Apply H2; Apply H.
-Unfold open_set; Unfold neighbourhood; Intros; Elim H3; Intros; Assert H6 := (H2 ? H4); Elim H6; Intros; Exists x1; Unfold included; Intros; Split.
-Apply (H7 ? H8).
-Assumption.
-Cut (open_set [y:R]False) -> (open_set [y:R](f0 x y)/\(D x)).
-Intro; Apply H2; Apply open_set_P4.
-Unfold open_set; Unfold neighbourhood; Intros; Elim H3; Intros; Elim H1; Assumption.
-Qed.
-
-Definition bounded [D:R->Prop] : Prop := (EXT m:R | (EXT M:R | (x:R)(D x)->``m<=x<=M``)).
-
-Lemma open_set_P6 : (D1,D2:R->Prop) (open_set D1) -> D1 =_D D2 -> (open_set D2).
-Unfold open_set; Unfold neighbourhood; Intros.
-Unfold eq_Dom in H0; Elim H0; Intros.
-Assert H4 := (H ? (H3 ? H1)).
-Elim H4; Intros.
-Exists x0; Apply included_trans with D1; Assumption.
-Qed.
-
-(**********)
-Lemma compact_P1 : (X:R->Prop) (compact X) -> (bounded X).
-Intros; Unfold compact in H; Pose D := [x:R]True; Pose g := [x:R][y:R]``(Rabsolu y)<x``; Cut (x:R)(EXT y|(g x y))->True; [Intro | Intro; Trivial].
-Pose f0 := (mkfamily D g H0); Assert H1 := (H f0); Cut (covering_open_set X f0).
-Intro; Assert H3 := (H1 H2); Elim H3; Intros D' H4; Unfold covering_finite in H4; Elim H4; Intros; Unfold family_finite in H6; Unfold domain_finite in H6; Elim H6; Intros l H7; Unfold bounded; Pose r := (MaxRlist l).
-Exists ``-r``; Exists r; Intros.
-Unfold covering in H5; Assert H9 := (H5 ? H8); Elim H9; Intros; Unfold subfamily in H10; Simpl in H10; Elim H10; Intros; Assert H13 := (H7 x0); Simpl in H13; Cut (intersection_domain D D' x0).
-Elim H13; Clear H13; Intros.
-Assert H16 := (H13 H15); Unfold g in H11; Split.
-Cut ``x0<=r``.
-Intro; Cut ``(Rabsolu x)<r``.
-Intro; Assert H19 := (Rabsolu_def2 x r H18); Elim H19; Intros; Left; Assumption.
-Apply Rlt_le_trans with x0; Assumption.
-Apply (MaxRlist_P1 l x0 H16).
-Cut ``x0<=r``.
-Intro; Apply Rle_trans with (Rabsolu x).
-Apply Rle_Rabsolu.
-Apply Rle_trans with x0.
-Left; Apply H11.
-Assumption.
-Apply (MaxRlist_P1 l x0 H16).
-Unfold intersection_domain D; Tauto.
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Simpl; Exists ``(Rabsolu x)+1``; Unfold g; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Unfold family_open_set; Intro; Case (total_order R0 x); Intro.
-Apply open_set_P6 with (disc R0 (mkposreal ? H2)).
-Apply disc_P1.
-Unfold eq_Dom; Unfold f0; Simpl; Unfold g disc; Split.
-Unfold included; Intros; Unfold Rminus in H3; Rewrite Ropp_O in H3; Rewrite Rplus_Or in H3; Apply H3.
-Unfold included; Intros; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply H3.
-Apply open_set_P6 with [x:R]False.
-Apply open_set_P4.
-Unfold eq_Dom; Split.
-Unfold included; Intros; Elim H3.
-Unfold included f0; Simpl; Unfold g; Intros; Elim H2; Intro; [Rewrite <- H4 in H3; Assert H5 := (Rabsolu_pos x0); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)) | Assert H6 := (Rabsolu_pos x0); Assert H7 := (Rlt_trans ? ? ? H3 H4); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 H7))].
-Qed.
-
-(**********)
-Lemma compact_P2 : (X:R->Prop) (compact X) -> (closed_set X).
-Intros; Assert H0 := (closed_set_P1 X); Elim H0; Clear H0; Intros _ H0; Apply H0; Clear H0.
-Unfold eq_Dom; Split.
-Apply adherence_P1.
-Unfold included; Unfold adherence; Unfold point_adherent; Intros; Unfold compact in H; Assert H1 := (classic (X x)); Elim H1; Clear H1; Intro.
-Assumption.
-Cut (y:R)(X y)->``0<(Rabsolu (y-x))/2``.
-Intro; Pose D := X; Pose g := [y:R][z:R]``(Rabsolu (y-z))<(Rabsolu (y-x))/2``/\(D y); Cut (x:R)(EXT y|(g x y))->(D x).
-Intro; Pose f0 := (mkfamily D g H3); Assert H4 := (H f0); Cut (covering_open_set X f0).
-Intro; Assert H6 := (H4 H5); Elim H6; Clear H6; Intros D' H6.
-Unfold covering_finite in H6; Decompose [and] H6; Unfold covering subfamily in H7; Simpl in H7; Unfold family_finite subfamily in H8; Simpl in H8; Unfold domain_finite in H8; Elim H8; Clear H8; Intros l H8; Pose alp := (MinRlist (AbsList l x)); Cut ``0<alp``.
-Intro; Assert H10 := (H0 (disc x (mkposreal ? H9))); Cut (neighbourhood (disc x (mkposreal alp H9)) x).
-Intro; Assert H12 := (H10 H11); Elim H12; Clear H12; Intros y H12; Unfold intersection_domain in H12; Elim H12; Clear H12; Intros; Assert H14 := (H7 ? H13); Elim H14; Clear H14; Intros y0 H14; Elim H14; Clear H14; Intros; Unfold g in H14; Elim H14; Clear H14; Intros; Unfold disc in H12; Simpl in H12; Cut ``alp<=(Rabsolu (y0-x))/2``.
-Intro; Assert H18 := (Rlt_le_trans ? ? ? H12 H17); Cut ``(Rabsolu (y0-x))<(Rabsolu (y0-x))``.
-Intro; Elim (Rlt_antirefl ? H19).
-Apply Rle_lt_trans with ``(Rabsolu (y0-y))+(Rabsolu (y-x))``.
-Replace ``y0-x`` with ``(y0-y)+(y-x)``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var ``(Rabsolu (y0-x))``); Apply Rplus_lt; Assumption.
-Apply (MinRlist_P1 (AbsList l x) ``(Rabsolu (y0-x))/2``); Apply AbsList_P1; Elim (H8 y0); Clear H8; Intros; Apply H8; Unfold intersection_domain; Split; Assumption.
-Assert H11 := (disc_P1 x (mkposreal alp H9)); Unfold open_set in H11; Apply H11.
-Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H9.
-Unfold alp; Apply MinRlist_P2; Intros; Assert H10 := (AbsList_P2 ? ? ? H9); Elim H10; Clear H10; Intros z H10; Elim H10; Clear H10; Intros; Rewrite H11; Apply H2; Elim (H8 z); Clear H8; Intros; Assert H13 := (H12 H10); Unfold intersection_domain D in H13; Elim H13; Clear H13; Intros; Assumption.
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Exists x0; Simpl; Unfold g; Split.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold Rminus in H2; Apply (H2 ? H5).
-Apply H5.
-Unfold family_open_set; Intro; Simpl; Unfold g; Elim (classic (D x0)); Intro.
-Apply open_set_P6 with (disc x0 (mkposreal ? (H2 ? H5))).
-Apply disc_P1.
-Unfold eq_Dom; Split.
-Unfold included disc; Simpl; Intros; Split.
-Rewrite <- (Rabsolu_Ropp ``x0-x1``); Rewrite Ropp_distr2; Apply H6.
-Apply H5.
-Unfold included disc; Simpl; Intros; Elim H6; Intros; Rewrite <- (Rabsolu_Ropp ``x1-x0``); Rewrite Ropp_distr2; Apply H7.
-Apply open_set_P6 with [z:R]False.
-Apply open_set_P4.
-Unfold eq_Dom; Split.
-Unfold included; Intros; Elim H6.
-Unfold included; Intros; Elim H6; Intros; Elim H5; Assumption.
-Intros; Elim H3; Intros; Unfold g in H4; Elim H4; Clear H4; Intros _ H4; Apply H4.
-Intros; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt; Apply Rminus_eq_contra; Red; Intro; Rewrite H3 in H2; Elim H1; Apply H2.
-Apply Rlt_Rinv; Sup0.
-Qed.
-
-(**********)
-Lemma compact_EMP : (compact [_:R]False).
-Unfold compact; Intros; Exists [x:R]False; Unfold covering_finite; Split.
-Unfold covering; Intros; Elim H0.
-Unfold family_finite; Unfold domain_finite; Exists nil; Intro.
-Split.
-Simpl; Unfold intersection_domain; Intros; Elim H0.
-Elim H0; Clear H0; Intros _ H0; Elim H0.
-Simpl; Intro; Elim H0.
-Qed.
-
-Lemma compact_eqDom : (X1,X2:R->Prop) (compact X1) -> X1 =_D X2 -> (compact X2).
-Unfold compact; Intros; Unfold eq_Dom in H0; Elim H0; Clear H0; Unfold included; Intros; Assert H3 : (covering_open_set X1 f0).
-Unfold covering_open_set; Unfold covering_open_set in H1; Elim H1; Clear H1; Intros; Split.
-Unfold covering in H1; Unfold covering; Intros; Apply (H1 ? (H0 ? H4)).
-Apply H3.
-Elim (H ? H3); Intros D H4; Exists D; Unfold covering_finite; Unfold covering_finite in H4; Elim H4; Intros; Split.
-Unfold covering in H5; Unfold covering; Intros; Apply (H5 ? (H2 ? H7)).
-Apply H6.
-Qed.
-
-(* Borel-Lebesgue's lemma *)
-Lemma compact_P3 : (a,b:R) (compact [c:R]``a<=c<=b``).
-Intros; Case (total_order_Rle a b); Intro.
-Unfold compact; Intros; Pose A := [x:R]``a<=x<=b``/\(EXT D:R->Prop | (covering_finite [c:R]``a <= c <= x`` (subfamily f0 D))); Cut (A a).
-Intro; Cut (bound A).
-Intro; Cut (EXT a0:R | (A a0)).
-Intro; Assert H3 := (complet A H1 H2); Elim H3; Clear H3; Intros m H3; Unfold is_lub in H3; Cut ``a<=m<=b``.
-Intro; Unfold covering_open_set in H; Elim H; Clear H; Intros; Unfold covering in H; Assert H6 := (H m H4); Elim H6; Clear H6; Intros y0 H6; Unfold family_open_set in H5; Assert H7 := (H5 y0); Unfold open_set in H7; Assert H8 := (H7 m H6); Unfold neighbourhood in H8; Elim H8; Clear H8; Intros eps H8; Cut (EXT x:R | (A x)/\``m-eps<x<=m``).
-Intro; Elim H9; Clear H9; Intros x H9; Elim H9; Clear H9; Intros; Case (Req_EM m b); Intro.
-Rewrite H11 in H10; Rewrite H11 in H8; Unfold A in H9; Elim H9; Clear H9; Intros; Elim H12; Clear H12; Intros Dx H12; Pose Db := [x:R](Dx x)\/x==y0; Exists Db; Unfold covering_finite; Split.
-Unfold covering; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold covering in H12; Case (total_order_Rle x0 x); Intro.
-Cut ``a<=x0<=x``.
-Intro; Assert H16 := (H12 x0 H15); Elim H16; Clear H16; Intros; Exists x1; Simpl in H16; Simpl; Unfold Db; Elim H16; Clear H16; Intros; Split; [Apply H16 | Left; Apply H17].
-Split.
-Elim H14; Intros; Assumption.
-Assumption.
-Exists y0; Simpl; Split.
-Apply H8; Unfold disc; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
-Apply Rlt_trans with ``b-x``.
-Unfold Rminus; Apply Rlt_compatibility; Apply Rlt_Ropp; Auto with real.
-Elim H10; Intros H15 _; Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(b-x)`` with ``b-eps``; [Replace ``x-eps+eps`` with x; [Apply H15 | Ring] | Ring].
-Apply Rge_minus; Apply Rle_sym1; Elim H14; Intros _ H15; Apply H15.
-Unfold Db; Right; Reflexivity.
-Unfold family_finite; Unfold domain_finite; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold family_finite in H13; Unfold domain_finite in H13; Elim H13; Clear H13; Intros l H13; Exists (cons y0 l); Intro; Split.
-Intro; Simpl in H14; Unfold intersection_domain in H14; Elim (H13 x0); Clear H13; Intros; Case (Req_EM x0 y0); Intro.
-Simpl; Left; Apply H16.
-Simpl; Right; Apply H13.
-Simpl; Unfold intersection_domain; Unfold Db in H14; Decompose [and or] H14.
-Split; Assumption.
-Elim H16; Assumption.
-Intro; Simpl in H14; Elim H14; Intro; Simpl; Unfold intersection_domain.
-Split.
-Apply (cond_fam f0); Rewrite H15; Exists m; Apply H6.
-Unfold Db; Right; Assumption.
-Simpl; Unfold intersection_domain; Elim (H13 x0).
-Intros _ H16; Assert H17 := (H16 H15); Simpl in H17; Unfold intersection_domain in H17; Split.
-Elim H17; Intros; Assumption.
-Unfold Db; Left; Elim H17; Intros; Assumption.
-Pose m' := (Rmin ``m+eps/2`` b); Cut (A m').
-Intro; Elim H3; Intros; Unfold is_upper_bound in H13; Assert H15 := (H13 m' H12); Cut ``m<m'``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H15 H16)).
-Unfold m'; Unfold Rmin; Case (total_order_Rle ``m+eps/2`` b); Intro.
-Pattern 1 m; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
-Elim H4; Intros.
-Elim H17; Intro.
-Assumption.
-Elim H11; Assumption.
-Unfold A; Split.
-Split.
-Apply Rle_trans with m.
-Elim H4; Intros; Assumption.
-Unfold m'; Unfold Rmin; Case (total_order_Rle ``m+eps/2`` b); Intro.
-Pattern 1 m; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
-Elim H4; Intros.
-Elim H13; Intro.
-Assumption.
-Elim H11; Assumption.
-Unfold m'; Apply Rmin_r.
-Unfold A in H9; Elim H9; Clear H9; Intros; Elim H12; Clear H12; Intros Dx H12; Pose Db := [x:R](Dx x)\/x==y0; Exists Db; Unfold covering_finite; Split.
-Unfold covering; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold covering in H12; Case (total_order_Rle x0 x); Intro.
-Cut ``a<=x0<=x``.
-Intro; Assert H16 := (H12 x0 H15); Elim H16; Clear H16; Intros; Exists x1; Simpl in H16; Simpl; Unfold Db.
-Elim H16; Clear H16; Intros; Split; [Apply H16 | Left; Apply H17].
-Elim H14; Intros; Split; Assumption.
-Exists y0; Simpl; Split.
-Apply H8; Unfold disc; Unfold Rabsolu; Case (case_Rabsolu ``x0-m``); Intro.
-Rewrite Ropp_distr2; Apply Rlt_trans with ``m-x``.
-Unfold Rminus; Apply Rlt_compatibility; Apply Rlt_Ropp; Auto with real.
-Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(m-x)`` with ``m-eps``.
-Replace ``x-eps+eps`` with x.
-Elim H10; Intros; Assumption.
-Ring.
-Ring.
-Apply Rle_lt_trans with ``m'-m``.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-m``); Apply Rle_compatibility; Elim H14; Intros; Assumption.
-Apply Rlt_anti_compatibility with m; Replace ``m+(m'-m)`` with m'.
-Apply Rle_lt_trans with ``m+eps/2``.
-Unfold m'; Apply Rmin_l.
-Apply Rlt_compatibility; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Pattern 1 (pos eps); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply (cond_pos eps).
-DiscrR.
-Ring.
-Unfold Db; Right; Reflexivity.
-Unfold family_finite; Unfold domain_finite; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold family_finite in H13; Unfold domain_finite in H13; Elim H13; Clear H13; Intros l H13; Exists (cons y0 l); Intro; Split.
-Intro; Simpl in H14; Unfold intersection_domain in H14; Elim (H13 x0); Clear H13; Intros; Case (Req_EM x0 y0); Intro.
-Simpl; Left; Apply H16.
-Simpl; Right; Apply H13; Simpl; Unfold intersection_domain; Unfold Db in H14; Decompose [and or] H14.
-Split; Assumption.
-Elim H16; Assumption.
-Intro; Simpl in H14; Elim H14; Intro; Simpl; Unfold intersection_domain.
-Split.
-Apply (cond_fam f0); Rewrite H15; Exists m; Apply H6.
-Unfold Db; Right; Assumption.
-Elim (H13 x0); Intros _ H16.
-Assert H17 := (H16 H15).
-Simpl in H17.
-Unfold intersection_domain in H17.
-Split.
-Elim H17; Intros; Assumption.
-Unfold Db; Left; Elim H17; Intros; Assumption.
-Elim (classic (EXT x:R | (A x)/\``m-eps < x <= m``)); Intro.
-Assumption.
-Elim H3; Intros; Cut (is_upper_bound A ``m-eps``).
-Intro; Assert H13 := (H11 ? H12); Cut ``m-eps<m``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H13 H14)).
-Pattern 2 m; Rewrite <- Rplus_Or; Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_Ropp; Rewrite Ropp_O; Apply (cond_pos eps).
-Pose P := [n:R](A n)/\``m-eps<n<=m``; Assert H12 := (not_ex_all_not ? P H9); Unfold P in H12; Unfold is_upper_bound; Intros; Assert H14 := (not_and_or ? ? (H12 x)); Elim H14; Intro.
-Elim H15; Apply H13.
-Elim (not_and_or ? ? H15); Intro.
-Case (total_order_Rle x ``m-eps``); Intro.
-Assumption.
-Elim H16; Auto with real.
-Unfold is_upper_bound in H10; Assert H17 := (H10 x H13); Elim H16; Apply H17.
-Elim H3; Clear H3; Intros.
-Unfold is_upper_bound in H3.
-Split.
-Apply (H3 ? H0).
-Apply (H4 b); Unfold is_upper_bound; Intros; Unfold A in H5; Elim H5; Clear H5; Intros H5 _; Elim H5; Clear H5; Intros _ H5; Apply H5.
-Exists a; Apply H0.
-Unfold bound; Exists b; Unfold is_upper_bound; Intros; Unfold A in H1; Elim H1; Clear H1; Intros H1 _; Elim H1; Clear H1; Intros _ H1; Apply H1.
-Unfold A; Split.
-Split; [Right; Reflexivity | Apply r].
-Unfold covering_open_set in H; Elim H; Clear H; Intros; Unfold covering in H; Cut ``a<=a<=b``.
-Intro; Elim (H ? H1); Intros y0 H2; Pose D':=[x:R]x==y0; Exists D'; Unfold covering_finite; Split.
-Unfold covering; Simpl; Intros; Cut x==a.
-Intro; Exists y0; Split.
-Rewrite H4; Apply H2.
-Unfold D'; Reflexivity.
-Elim H3; Intros; Apply Rle_antisym; Assumption.
-Unfold family_finite; Unfold domain_finite; Exists (cons y0 nil); Intro; Split.
-Simpl; Unfold intersection_domain; Intro; Elim H3; Clear H3; Intros; Unfold D' in H4; Left; Apply H4.
-Simpl; Unfold intersection_domain; Intro; Elim H3; Intro.
-Split; [Rewrite H4; Apply (cond_fam f0); Exists a; Apply H2 | Apply H4].
-Elim H4.
-Split; [Right; Reflexivity | Apply r].
-Apply compact_eqDom with [c:R]False.
-Apply compact_EMP.
-Unfold eq_Dom; Split.
-Unfold included; Intros; Elim H.
-Unfold included; Intros; Elim H; Clear H; Intros; Assert H1 := (Rle_trans ? ? ? H H0); Elim n; Apply H1.
-Qed.
-
-Lemma compact_P4 : (X,F:R->Prop) (compact X) -> (closed_set F) -> (included F X) -> (compact F).
-Unfold compact; Intros; Elim (classic (EXT z:R | (F z))); Intro Hyp_F_NE.
-Pose D := (ind f0); Pose g := (f f0); Unfold closed_set in H0.
-Pose g' := [x:R][y:R](f0 x y)\/((complementary F y)/\(D x)).
-Pose D' := D.
-Cut (x:R)(EXT y:R | (g' x y))->(D' x).
-Intro; Pose f' := (mkfamily D' g' H3); Cut (covering_open_set X f').
-Intro; Elim (H ? H4); Intros DX H5; Exists DX.
-Unfold covering_finite; Unfold covering_finite in H5; Elim H5; Clear H5; Intros.
-Split.
-Unfold covering; Unfold covering in H5; Intros.
-Elim (H5 ? (H1 ? H7)); Intros y0 H8; Exists y0; Simpl in H8; Simpl; Elim H8; Clear H8; Intros.
-Split.
-Unfold g' in H8; Elim H8; Intro.
-Apply H10.
-Elim H10; Intros H11 _; Unfold complementary in H11; Elim H11; Apply H7.
-Apply H9.
-Unfold family_finite; Unfold domain_finite; Unfold family_finite in H6; Unfold domain_finite in H6; Elim H6; Clear H6; Intros l H6; Exists l; Intro; Assert H7 := (H6 x); Elim H7; Clear H7; Intros.
-Split.
-Intro; Apply H7; Simpl; Unfold intersection_domain; Simpl in H9; Unfold intersection_domain in H9; Unfold D'; Apply H9.
-Intro; Assert H10 := (H8 H9); Simpl in H10; Unfold intersection_domain in H10; Simpl; Unfold intersection_domain; Unfold D' in H10; Apply H10.
-Unfold covering_open_set; Unfold covering_open_set in H2; Elim H2; Clear H2; Intros.
-Split.
-Unfold covering; Unfold covering in H2; Intros.
-Elim (classic (F x)); Intro.
-Elim (H2 ? H6); Intros y0 H7; Exists y0; Simpl; Unfold g'; Left; Assumption.
-Cut (EXT z:R | (D z)).
-Intro; Elim H7; Clear H7; Intros x0 H7; Exists x0; Simpl; Unfold g'; Right.
-Split.
-Unfold complementary; Apply H6.
-Apply H7.
-Elim Hyp_F_NE; Intros z0 H7.
-Assert H8 := (H2 ? H7).
-Elim H8; Clear H8; Intros t H8; Exists t; Apply (cond_fam f0); Exists z0; Apply H8.
-Unfold family_open_set; Intro; Simpl; Unfold g'; Elim (classic (D x)); Intro.
-Apply open_set_P6 with (union_domain (f0 x) (complementary F)).
-Apply open_set_P2.
-Unfold family_open_set in H4; Apply H4.
-Apply H0.
-Unfold eq_Dom; Split.
-Unfold included union_domain complementary; Intros.
-Elim H6; Intro; [Left; Apply H7 | Right; Split; Assumption].
-Unfold included union_domain complementary; Intros.
-Elim H6; Intro; [Left; Apply H7 | Right; Elim H7; Intros; Apply H8].
-Apply open_set_P6 with (f0 x).
-Unfold family_open_set in H4; Apply H4.
-Unfold eq_Dom; Split.
-Unfold included complementary; Intros; Left; Apply H6.
-Unfold included complementary; Intros.
-Elim H6; Intro.
-Apply H7.
-Elim H7; Intros _ H8; Elim H5; Apply H8.
-Intros; Elim H3; Intros y0 H4; Unfold g' in H4; Elim H4; Intro.
-Apply (cond_fam f0); Exists y0; Apply H5.
-Elim H5; Clear H5; Intros _ H5; Apply H5.
-(* Cas ou F est l'ensemble vide *)
-Cut (compact F).
-Intro; Apply (H3 f0 H2).
-Apply compact_eqDom with [_:R]False.
-Apply compact_EMP.
-Unfold eq_Dom; Split.
-Unfold included; Intros; Elim H3.
-Assert H3 := (not_ex_all_not ? ? Hyp_F_NE); Unfold included; Intros; Elim (H3 x); Apply H4.
-Qed.
-
-(**********)
-Lemma compact_P5 : (X:R->Prop) (closed_set X)->(bounded X)->(compact X).
-Intros; Unfold bounded in H0.
-Elim H0; Clear H0; Intros m H0.
-Elim H0; Clear H0; Intros M H0.
-Assert H1 := (compact_P3 m M).
-Apply (compact_P4 [c:R]``m<=c<=M`` X H1 H H0).
-Qed.
-
-(**********)
-Lemma compact_carac : (X:R->Prop) (compact X)<->(closed_set X)/\(bounded X).
-Intro; Split.
-Intro; Split; [Apply (compact_P2 ? H) | Apply (compact_P1 ? H)].
-Intro; Elim H; Clear H; Intros; Apply (compact_P5 ? H H0).
-Qed.
-
-Definition image_dir [f:R->R;D:R->Prop] : R->Prop := [x:R](EXT y:R | x==(f y)/\(D y)).
-
-(**********)
-Lemma continuity_compact : (f:R->R;X:R->Prop) ((x:R)(continuity_pt f x)) -> (compact X) -> (compact (image_dir f X)).
-Unfold compact; Intros; Unfold covering_open_set in H1.
-Elim H1; Clear H1; Intros.
-Pose D := (ind f1).
-Pose g := [x:R][y:R](image_rec f0 (f1 x) y).
-Cut (x:R)(EXT y:R | (g x y))->(D x).
-Intro; Pose f' := (mkfamily D g H3).
-Cut (covering_open_set X f').
-Intro; Elim (H0 f' H4); Intros D' H5; Exists D'.
-Unfold covering_finite in H5; Elim H5; Clear H5; Intros; Unfold covering_finite; Split.
-Unfold covering image_dir; Simpl; Unfold covering in H5; Intros; Elim H7; Intros y H8; Elim H8; Intros; Assert H11 := (H5 ? H10); Simpl in H11; Elim H11; Intros z H12; Exists z; Unfold g in H12; Unfold image_rec in H12; Rewrite H9; Apply H12.
-Unfold family_finite in H6; Unfold domain_finite in H6; Unfold family_finite; Unfold domain_finite; Elim H6; Intros l H7; Exists l; Intro; Elim (H7 x); Intros; Split; Intro.
-Apply H8; Simpl in H10; Simpl; Apply H10.
-Apply (H9 H10).
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Simpl; Unfold covering in H1; Unfold image_dir in H1; Unfold g; Unfold image_rec; Apply H1.
-Exists x; Split; [Reflexivity | Apply H4].
-Unfold family_open_set; Unfold family_open_set in H2; Intro; Simpl; Unfold g; Cut ([y:R](image_rec f0 (f1 x) y))==(image_rec f0 (f1 x)).
-Intro; Rewrite H4.
-Apply (continuity_P2 f0 (f1 x) H (H2 x)).
-Reflexivity.
-Intros; Apply (cond_fam f1); Unfold g in H3; Unfold image_rec in H3; Elim H3; Intros; Exists (f0 x0); Apply H4.
-Qed.
-
-Lemma Rlt_Rminus : (a,b:R) ``a<b`` -> ``0<b-a``.
-Intros; Apply Rlt_anti_compatibility with a; Rewrite Rplus_Or; Replace ``a+(b-a)`` with b; [Assumption | Ring].
-Qed.
-
-Lemma prolongement_C0 : (f:R->R;a,b:R) ``a<=b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> (EXT g:R->R | (continuity g)/\((c:R)``a<=c<=b``->(g c)==(f c))).
-Intros; Elim H; Intro.
-Pose h := [x:R](Cases (total_order_Rle x a) of
-  (leftT _) => (f0 a)
-| (rightT _) => (Cases (total_order_Rle x b) of
-       (leftT _) => (f0 x)
-     | (rightT _) => (f0 b) end) end).
-Assert H2 : ``0<b-a``.
-Apply Rlt_Rminus; Assumption.
-Exists h; Split.
-Unfold continuity; Intro; Case (total_order x a); Intro.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Exists ``a-x``; Split.
-Change ``0<a-x``; Apply Rlt_Rminus; Assumption.
-Intros; Elim H5; Clear H5; Intros _ H5; Unfold h.
-Case (total_order_Rle x a); Intro.
-Case (total_order_Rle x0 a); Intro.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Elim n; Left; Apply Rlt_anti_compatibility with ``-x``; Do 2 Rewrite (Rplus_sym ``-x``); Apply Rle_lt_trans with ``(Rabsolu (x0-x))``.
-Apply Rle_Rabsolu.
-Assumption.
-Elim n; Left; Assumption.
-Elim H3; Intro.
-Assert H5 : ``a<=a<=b``.
-Split; [Right; Reflexivity | Left; Assumption].
-Assert H6 := (H0 ? H5); Unfold continuity_pt in H6; Unfold continue_in in H6; Unfold limit1_in in H6; Unfold limit_in in H6; Simpl in H6; Unfold R_dist in H6; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H6 ? H7); Intros; Exists (Rmin x0 ``b-a``); Split.
-Unfold Rmin; Case (total_order_Rle x0 ``b-a``); Intro.
-Elim H8; Intros; Assumption.
-Change ``0<b-a``; Apply Rlt_Rminus; Assumption.
-Intros; Elim H9; Clear H9; Intros _ H9; Cut ``x1<b``.
-Intro; Unfold h; Case (total_order_Rle x a); Intro.
-Case (total_order_Rle x1 a); Intro.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Case (total_order_Rle x1 b); Intro.
-Elim H8; Intros; Apply H12; Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Red; Intro; Elim n; Right; Symmetry; Assumption.
-Apply Rlt_le_trans with (Rmin x0 ``b-a``).
-Rewrite H4 in H9; Apply H9.
-Apply Rmin_l.
-Elim n0; Left; Assumption.
-Elim n; Right; Assumption.
-Apply Rlt_anti_compatibility with ``-a``; Do 2 Rewrite (Rplus_sym ``-a``); Rewrite H4 in H9; Apply Rle_lt_trans with ``(Rabsolu (x1-a))``.
-Apply Rle_Rabsolu.
-Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
-Assumption.
-Apply Rmin_r.
-Case (total_order x b); Intro.
-Assert H6 : ``a<=x<=b``.
-Split; Left; Assumption.
-Assert H7 := (H0 ? H6); Unfold continuity_pt in H7; Unfold continue_in in H7; Unfold limit1_in in H7; Unfold limit_in in H7; Simpl in H7; Unfold R_dist in H7; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H7 ? H8); Intros; Elim H9; Clear H9; Intros.
-Assert H11 : ``0<x-a``.
-Apply Rlt_Rminus; Assumption.
-Assert H12 : ``0<b-x``.
-Apply Rlt_Rminus; Assumption.
-Exists (Rmin x0 (Rmin ``x-a`` ``b-x``)); Split.
-Unfold Rmin; Case (total_order_Rle ``x-a`` ``b-x``); Intro.
-Case (total_order_Rle x0 ``x-a``); Intro.
-Assumption.
-Assumption.
-Case (total_order_Rle x0 ``b-x``); Intro.
-Assumption.
-Assumption.
-Intros; Elim H13; Clear H13; Intros; Cut ``a<x1<b``.
-Intro; Elim H15; Clear H15; Intros; Unfold h; Case (total_order_Rle x a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
-Case (total_order_Rle x b); Intro.
-Case (total_order_Rle x1 a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H15)).
-Case (total_order_Rle x1 b); Intro.
-Apply H10; Split.
-Assumption.
-Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
-Assumption.
-Apply Rmin_l.
-Elim n1; Left; Assumption.
-Elim n0; Left; Assumption.
-Split.
-Apply Ropp_Rlt; Apply Rlt_anti_compatibility with x; Apply Rle_lt_trans with ``(Rabsolu (x1-x))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
-Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
-Assumption.
-Apply Rle_trans with ``(Rmin (x-a) (b-x))``.
-Apply Rmin_r.
-Apply Rmin_l.
-Apply Rlt_anti_compatibility with ``-x``; Do 2 Rewrite (Rplus_sym ``-x``); Apply Rle_lt_trans with ``(Rabsolu (x1-x))``.
-Apply Rle_Rabsolu.
-Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
-Assumption.
-Apply Rle_trans with ``(Rmin (x-a) (b-x))``; Apply Rmin_r.
-Elim H5; Intro.
-Assert H7 : ``a<=b<=b``.
-Split; [Left; Assumption | Right; Reflexivity].
-Assert H8 := (H0 ? H7); Unfold continuity_pt in H8; Unfold continue_in in H8; Unfold limit1_in in H8; Unfold limit_in in H8; Simpl in H8; Unfold R_dist in H8; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H8 ? H9); Intros; Exists (Rmin x0 ``b-a``); Split.
-Unfold Rmin; Case (total_order_Rle x0 ``b-a``); Intro.
-Elim H10; Intros; Assumption.
-Change ``0<b-a``; Apply Rlt_Rminus; Assumption.
-Intros; Elim H11; Clear H11; Intros _ H11; Cut ``a<x1``.
-Intro; Unfold h; Case (total_order_Rle x a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
-Case (total_order_Rle x1 a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H12)).
-Case (total_order_Rle x b); Intro.
-Case (total_order_Rle x1 b); Intro.
-Rewrite H6; Elim H10; Intros; Elim r0; Intro.
-Apply H14; Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Red; Intro; Rewrite <- H16 in H15; Elim (Rlt_antirefl ? H15).
-Rewrite H6 in H11; Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
-Apply H11.
-Apply Rmin_l.
-Rewrite H15; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Rewrite H6; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Elim n1; Right; Assumption.
-Rewrite H6 in H11; Apply Ropp_Rlt; Apply Rlt_anti_compatibility with b; Apply Rle_lt_trans with ``(Rabsolu (x1-b))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
-Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
-Assumption.
-Apply Rmin_r.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Exists ``x-b``; Split.
-Change ``0<x-b``; Apply Rlt_Rminus; Assumption.
-Intros; Elim H8; Clear H8; Intros.
-Assert H10 : ``b<x0``.
-Apply Ropp_Rlt; Apply Rlt_anti_compatibility with x; Apply Rle_lt_trans with ``(Rabsolu (x0-x))``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
-Assumption.
-Unfold h; Case (total_order_Rle x a); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
-Case (total_order_Rle x b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H6)).
-Case (total_order_Rle x0 a); Intro.
-Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H1 (Rlt_le_trans ? ? ? H10 r))).
-Case (total_order_Rle x0 b); Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)).
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Intros; Elim H3; Intros; Unfold h; Case (total_order_Rle c a); Intro.
-Elim r; Intro.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 H6)).
-Rewrite H6; Reflexivity.
-Case (total_order_Rle c b); Intro.
-Reflexivity.
-Elim n0; Assumption.
-Exists [_:R](f0 a); Split.
-Apply derivable_continuous; Apply (derivable_const (f0 a)).
-Intros; Elim H2; Intros; Rewrite H1 in H3; Cut b==c.
-Intro; Rewrite <- H5; Rewrite H1; Reflexivity.
-Apply Rle_antisym; Assumption.
-Qed.
-
-(**********)
-Lemma continuity_ab_maj : (f:R->R;a,b:R) ``a<=b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> (EXT Mx : R |  ((c:R)``a<=c<=b``->``(f c)<=(f Mx)``)/\``a<=Mx<=b``).
-Intros; Cut (EXT g:R->R | (continuity g)/\((c:R)``a<=c<=b``->(g c)==(f0 c))).
-Intro HypProl.
-Elim HypProl; Intros g Hcont_eq.
-Elim Hcont_eq; Clear Hcont_eq; Intros Hcont Heq.
-Assert H1 := (compact_P3 a b).
-Assert H2 := (continuity_compact g [c:R]``a<=c<=b`` Hcont H1).
-Assert H3 := (compact_P2 ? H2).
-Assert H4 := (compact_P1 ? H2).
-Cut (bound (image_dir g [c:R]``a <= c <= b``)).
-Cut (ExT [x:R] ((image_dir g [c:R]``a <= c <= b``) x)).
-Intros; Assert H7 := (complet ? H6 H5).
-Elim H7; Clear H7; Intros M H7; Cut (image_dir g [c:R]``a <= c <= b`` M).
-Intro; Unfold image_dir in H8; Elim H8; Clear H8; Intros Mxx H8; Elim H8; Clear H8; Intros; Exists Mxx; Split.
-Intros; Rewrite <- (Heq c H10); Rewrite <- (Heq Mxx H9); Intros; Rewrite <- H8; Unfold is_lub in H7; Elim H7; Clear H7; Intros H7 _; Unfold is_upper_bound in H7; Apply H7; Unfold image_dir; Exists c; Split; [Reflexivity | Apply H10].
-Apply H9.
-Elim (classic (image_dir g [c:R]``a <= c <= b`` M)); Intro.
-Assumption.
-Cut (EXT eps:posreal | (y:R)~(intersection_domain (disc M eps) (image_dir g [c:R]``a <= c <= b``) y)).
-Intro; Elim H9; Clear H9; Intros eps H9; Unfold is_lub in H7; Elim H7; Clear H7; Intros; Cut (is_upper_bound (image_dir g [c:R]``a <= c <= b``) ``M-eps``).
-Intro; Assert H12 := (H10 ? H11); Cut ``M-eps<M``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H12 H13)).
-Pattern 2 M; Rewrite <- Rplus_Or; Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_O; Rewrite Ropp_Ropp; Apply (cond_pos eps).
-Unfold is_upper_bound image_dir; Intros; Cut ``x<=M``.
-Intro; Case (total_order_Rle x ``M-eps``); Intro.
-Apply r.
-Elim (H9 x); Unfold intersection_domain disc image_dir; Split.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
-Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(M-x)`` with ``M-eps``.
-Replace ``x-eps+eps`` with x.
-Auto with real.
-Ring.
-Ring.
-Apply Rge_minus; Apply Rle_sym1; Apply H12.
-Apply H11.
-Apply H7; Apply H11.
-Cut (EXT V:R->Prop | (neighbourhood V M)/\((y:R)~(intersection_domain V (image_dir g [c:R]``a <= c <= b``) y))).
-Intro; Elim H9; Intros V H10; Elim H10; Clear H10; Intros.
-Unfold neighbourhood in H10; Elim H10; Intros del H12; Exists del; Intros; Red; Intro; Elim (H11 y).
-Unfold intersection_domain; Unfold intersection_domain in H13; Elim H13; Clear H13; Intros; Split.
-Apply (H12 ? H13).
-Apply H14.
-Cut ~(point_adherent (image_dir g [c:R]``a <= c <= b``) M).
-Intro; Unfold point_adherent in H9.
-Assert H10 := (not_all_ex_not ? [V:R->Prop](neighbourhood V M)
-            ->(EXT y:R |
-                   (intersection_domain V
-                     (image_dir g [c:R]``a <= c <= b``) y)) H9).
-Elim H10; Intros V0 H11; Exists V0; Assert H12 := (imply_to_and ? ? H11); Elim H12; Clear H12; Intros.
-Split.
-Apply H12.
-Apply (not_ex_all_not ? ? H13).
-Red; Intro; Cut (adherence (image_dir g [c:R]``a <= c <= b``) M).
-Intro; Elim (closed_set_P1 (image_dir g [c:R]``a <= c <= b``)); Intros H11 _; Assert H12 := (H11 H3).
-Elim H8.
-Unfold eq_Dom in H12; Elim H12; Clear H12; Intros.
-Apply (H13 ? H10).
-Apply H9.
-Exists (g a); Unfold image_dir; Exists a; Split.
-Reflexivity.
-Split; [Right; Reflexivity | Apply H].
-Unfold bound; Unfold bounded in H4; Elim H4; Clear H4; Intros m H4; Elim H4; Clear H4; Intros M H4; Exists M; Unfold is_upper_bound; Intros; Elim (H4 ? H5); Intros _ H6; Apply H6.
-Apply prolongement_C0; Assumption.
-Qed.
-
-(**********)
-Lemma continuity_ab_min : (f:(R->R); a,b:R) ``a <= b``->((c:R)``a<=c<=b``->(continuity_pt f c))->(EXT mx:R | ((c:R)``a <= c <= b``->``(f mx) <= (f c)``)/\``a <= mx <= b``).
-Intros.
-Cut ((c:R)``a<=c<=b``->(continuity_pt (opp_fct f0) c)).
-Intro; Assert H2 := (continuity_ab_maj (opp_fct f0) a b H H1); Elim H2; Intros x0 H3; Exists x0; Intros; Split.
-Intros; Rewrite <- (Ropp_Ropp (f0 x0)); Rewrite <- (Ropp_Ropp (f0 c)); Apply Rle_Ropp1; Elim H3; Intros; Unfold opp_fct in H5; Apply H5; Apply H4.
-Elim H3; Intros; Assumption.
-Intros.
-Assert H2 := (H0 ? H1).
-Apply (continuity_pt_opp ? ? H2).
-Qed.
-
-
-(********************************************************)
-(*         Proof of Bolzano-Weierstrass theorem         *)
-(********************************************************)
-
-Definition ValAdh [un:nat->R;x:R] : Prop := (V:R->Prop;N:nat) (neighbourhood V x) -> (EX p:nat | (le N p)/\(V (un p))).
-
-Definition intersection_family [f:family] : R->Prop := [x:R](y:R)(ind f y)->(f y x).
-
-Lemma ValAdh_un_exists : (un:nat->R) let D=[x:R](EX n:nat | x==(INR n)) in let f=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)) in ((x:R)(EXT y:R | (f x y))->(D x)).
-Intros; Elim H; Intros; Unfold f in H0; Unfold adherence in H0; Unfold point_adherent in H0; Assert H1 : (neighbourhood (disc x0 (mkposreal ? Rlt_R0_R1)) x0).
-Unfold neighbourhood disc; Exists (mkposreal ? Rlt_R0_R1); Unfold included; Trivial.
-Elim (H0 ? H1); Intros; Unfold intersection_domain in H2; Elim H2; Intros; Elim H4; Intros; Apply H6.
-Qed.
-
-Definition ValAdh_un [un:nat->R] : R->Prop := let D=[x:R](EX n:nat | x==(INR n)) in let f=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)) in (intersection_family (mkfamily D f (ValAdh_un_exists un))).
-
-Lemma ValAdh_un_prop : (un:nat->R;x:R) (ValAdh un x) <-> (ValAdh_un un x).
-Intros; Split; Intro.
-Unfold ValAdh in H; Unfold ValAdh_un; Unfold intersection_family; Simpl; Intros; Elim H0; Intros N H1; Unfold adherence; Unfold point_adherent; Intros; Elim (H V N H2); Intros; Exists (un x0); Unfold intersection_domain; Elim H3; Clear H3; Intros; Split.
-Assumption.
-Split.
-Exists x0; Split; [Reflexivity | Rewrite H1; Apply (le_INR ? ? H3)].
-Exists N; Assumption.
-Unfold ValAdh; Intros; Unfold ValAdh_un in H; Unfold intersection_family in H; Simpl in H; Assert H1 : (adherence [y0:R](EX p:nat | ``y0 == (un p)``/\``(INR N) <= (INR p)``)/\(EX n:nat | ``(INR N) == (INR n)``) x).
-Apply H; Exists N; Reflexivity.
-Unfold adherence in H1; Unfold point_adherent in H1; Assert H2 := (H1 ? H0); Elim H2; Intros; Unfold intersection_domain in H3; Elim H3; Clear H3; Intros; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Exists x1; Split.
-Apply (INR_le ? ? H6).
-Rewrite H4 in H3; Apply H3.
-Qed.
-
-Lemma adherence_P4 : (F,G:R->Prop) (included F G) -> (included (adherence F) (adherence G)).
-Unfold adherence included; Unfold point_adherent; Intros; Elim (H0 ? H1); Unfold intersection_domain; Intros; Elim H2; Clear H2; Intros; Exists x0; Split; [Assumption | Apply (H ? H3)].
-Qed.
-
-Definition family_closed_set [f:family] : Prop := (x:R) (closed_set (f x)).
-
-Definition intersection_vide_in [D:R->Prop;f:family] : Prop := ((x:R)((ind f x)->(included (f x) D))/\~(EXT y:R | (intersection_family f y))).
-
-Definition intersection_vide_finite_in [D:R->Prop;f:family] : Prop := (intersection_vide_in D f)/\(family_finite f).
-
-(**********)
-Lemma compact_P6 : (X:R->Prop) (compact X) -> (EXT z:R | (X z)) -> ((g:family) (family_closed_set g) -> (intersection_vide_in X g) -> (EXT D:R->Prop | (intersection_vide_finite_in X (subfamily g D)))).
-Intros X H Hyp g H0 H1.
-Pose D' := (ind g).
-Pose f' := [x:R][y:R](complementary (g x) y)/\(D' x).
-Assert H2 : (x:R)(EXT y:R|(f' x y))->(D' x).
-Intros; Elim H2; Intros; Unfold f' in H3; Elim H3; Intros; Assumption.
-Pose f0 := (mkfamily D' f' H2).
-Unfold compact in H; Assert H3 : (covering_open_set X f0).
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Unfold intersection_vide_in in H1; Elim (H1 x); Intros; Unfold intersection_family in H5; Assert H6 := (not_ex_all_not ? [y:R](y0:R)(ind g y0)->(g y0 y) H5 x); Assert H7 := (not_all_ex_not ? [y0:R](ind g y0)->(g y0 x) H6); Elim H7; Intros; Exists x0; Elim (imply_to_and ? ? H8); Intros; Unfold f0; Simpl; Unfold f'; Split; [Apply H10 | Apply H9].
-Unfold family_open_set; Intro; Elim (classic (D' x)); Intro.
-Apply open_set_P6 with (complementary (g x)).
-Unfold family_closed_set in H0; Unfold closed_set in H0; Apply H0.
-Unfold f0; Simpl; Unfold f'; Unfold eq_Dom; Split.
-Unfold included; Intros; Split; [Apply H4 | Apply H3].
-Unfold included; Intros; Elim H4; Intros; Assumption.
-Apply open_set_P6 with [_:R]False.
-Apply open_set_P4.
-Unfold eq_Dom; Unfold included; Split; Intros; [Elim H4 | Simpl in H4; Unfold f' in H4; Elim H4; Intros; Elim H3; Assumption].
-Elim (H ? H3); Intros SF H4; Exists SF; Unfold intersection_vide_finite_in; Split.
-Unfold intersection_vide_in; Simpl; Intros; Split.
-Intros; Unfold included; Intros; Unfold intersection_vide_in in H1; Elim (H1 x); Intros; Elim H6; Intros; Apply H7.
-Unfold intersection_domain in H5; Elim H5; Intros; Assumption.
-Assumption.
-Elim (classic (EXT y:R | (intersection_domain (ind g) SF y))); Intro Hyp'.
-Red; Intro; Elim H5; Intros; Unfold intersection_family in H6; Simpl in H6.
-Cut (X x0).
-Intro; Unfold covering_finite in H4; Elim H4; Clear H4; Intros H4 _; Unfold covering in H4; Elim (H4 x0 H7); Intros; Simpl in H8; Unfold intersection_domain in H6; Cut (ind g x1)/\(SF x1).
-Intro; Assert H10 := (H6 x1 H9); Elim H10; Clear H10; Intros H10 _; Elim H8; Clear H8; Intros H8 _; Unfold f' in H8; Unfold complementary in H8; Elim H8; Clear H8; Intros H8 _; Elim H8; Assumption.
-Split.
-Apply (cond_fam f0).
-Exists x0; Elim H8; Intros; Assumption.
-Elim H8; Intros; Assumption.
-Unfold intersection_vide_in in H1; Elim Hyp'; Intros; Assert H8 := (H6 ? H7); Elim H8; Intros; Cut (ind g x1).
-Intro; Elim (H1 x1); Intros; Apply H12.
-Apply H11.
-Apply H9.
-Apply (cond_fam g); Exists x0; Assumption.
-Unfold covering_finite in H4; Elim H4; Clear H4; Intros H4 _; Cut (EXT z:R | (X z)).
-Intro; Elim H5; Clear H5; Intros; Unfold covering in H4; Elim (H4 x0 H5); Intros; Simpl in H6; Elim Hyp'; Exists x1; Elim H6; Intros; Unfold intersection_domain; Split.
-Apply (cond_fam f0); Exists x0; Apply H7.
-Apply H8.
-Apply Hyp.
-Unfold covering_finite in H4; Elim H4; Clear H4; Intros; Unfold family_finite in H5; Unfold domain_finite in H5; Unfold family_finite; Unfold domain_finite; Elim H5; Clear H5; Intros l H5; Exists l; Intro; Elim (H5 x); Intros; Split; Intro; [Apply H6; Simpl; Simpl in H8; Apply H8 | Apply (H7 H8)].
-Qed.
-
-Theorem Bolzano_Weierstrass : (un:nat->R;X:R->Prop) (compact X) -> ((n:nat)(X (un n))) -> (EXT l:R | (ValAdh un l)).
-Intros; Cut (EXT l:R | (ValAdh_un un l)).
-Intro; Elim H1; Intros; Exists x; Elim (ValAdh_un_prop un x); Intros; Apply (H4 H2).
-Assert H1 : (EXT z:R | (X z)).
-Exists (un O); Apply H0.
-Pose D:=[x:R](EX n:nat | x==(INR n)).
-Pose g:=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)).
-Assert H2 : (x:R)(EXT y:R | (g x y))->(D x).
-Intros; Elim H2; Intros; Unfold g in H3; Unfold adherence in H3; Unfold point_adherent in H3.
-Assert H4 : (neighbourhood (disc x0 (mkposreal ? Rlt_R0_R1)) x0).
-Unfold neighbourhood; Exists (mkposreal ? Rlt_R0_R1); Unfold included; Trivial.
-Elim (H3 ? H4); Intros; Unfold intersection_domain in H5; Decompose [and] H5; Assumption.
-Pose f0 := (mkfamily D g H2).
-Assert H3 := (compact_P6 X H H1 f0).
-Elim (classic (EXT l:R | (ValAdh_un un l))); Intro.
-Assumption.
-Cut (family_closed_set f0).
-Intro; Cut (intersection_vide_in X f0).
-Intro; Assert H7 := (H3 H5 H6).
-Elim H7; Intros SF H8; Unfold intersection_vide_finite_in in H8; Elim H8; Clear H8; Intros; Unfold intersection_vide_in in H8; Elim (H8 R0); Intros _ H10; Elim H10; Unfold family_finite in H9; Unfold domain_finite in H9; Elim H9; Clear H9; Intros l H9; Pose r := (MaxRlist l); Cut (D r).
-Intro; Unfold D in H11; Elim H11; Intros; Exists (un x); Unfold intersection_family; Simpl; Unfold intersection_domain; Intros; Split.
-Unfold g; Apply adherence_P1; Split.
-Exists x; Split; [Reflexivity | Rewrite <- H12; Unfold r; Apply MaxRlist_P1; Elim (H9 y); Intros; Apply H14; Simpl; Apply H13].
-Elim H13; Intros; Assumption.
-Elim H13; Intros; Assumption.
-Elim (H9 r); Intros.
-Simpl in H12; Unfold intersection_domain in H12; Cut (In r l).
-Intro; Elim (H12 H13); Intros; Assumption.
-Unfold r; Apply MaxRlist_P2; Cut (EXT z:R | (intersection_domain (ind f0) SF z)).
-Intro; Elim H13; Intros; Elim (H9 x); Intros; Simpl in H15; Assert H17 := (H15 H14); Exists x; Apply H17.
-Elim (classic (EXT z:R | (intersection_domain (ind f0) SF z))); Intro.
-Assumption.
-Elim (H8 R0); Intros _ H14; Elim H1; Intros; Assert H16 := (not_ex_all_not ? [y:R](intersection_family (subfamily f0 SF) y) H14); Assert H17 := (not_ex_all_not ? [z:R](intersection_domain (ind f0) SF z) H13); Assert H18 := (H16 x); Unfold intersection_family in H18; Simpl in H18; Assert H19 := (not_all_ex_not ? [y:R](intersection_domain D SF y)->(g y x)/\(SF y) H18); Elim H19; Intros; Assert H21 := (imply_to_and ? ? H20); Elim (H17 x0); Elim H21; Intros; Assumption.
-Unfold intersection_vide_in; Intros; Split.
-Intro; Simpl in H6; Unfold f0; Simpl; Unfold g; Apply included_trans with (adherence X).
-Apply adherence_P4.
-Unfold included; Intros; Elim H7; Intros; Elim H8; Intros; Elim H10; Intros; Rewrite H11; Apply H0.
-Apply adherence_P2; Apply compact_P2; Assumption.
-Apply H4.
-Unfold family_closed_set; Unfold f0; Simpl; Unfold g; Intro; Apply adherence_P3.
-Qed.
-
-(********************************************************)
-(*               Proof of Heine's theorem               *)
-(********************************************************)
-
-Definition uniform_continuity [f:R->R;X:R->Prop] : Prop := (eps:posreal)(EXT delta:posreal | (x,y:R) (X x)->(X y)->``(Rabsolu (x-y))<delta`` ->``(Rabsolu ((f x)-(f y)))<eps``).
-
-Lemma is_lub_u : (E:R->Prop;x,y:R) (is_lub E x) -> (is_lub E y) -> x==y.
-Unfold is_lub; Intros; Elim H; Elim H0; Intros; Apply Rle_antisym; [Apply (H4 ? H1) | Apply (H2 ? H3)].
-Qed.
-
-Lemma domain_P1 : (X:R->Prop) ~(EXT y:R | (X y))\/(EXT y:R | (X y)/\((x:R)(X x)->x==y))\/(EXT x:R | (EXT y:R | (X x)/\(X y)/\``x<>y``)).
-Intro; Elim (classic (EXT y:R | (X y))); Intro.
-Right; Elim H; Intros; Elim (classic (EXT y:R | (X y)/\``y<>x``)); Intro.
-Right; Elim H1; Intros; Elim H2; Intros; Exists x; Exists x0; Intros.
-Split; [Assumption | Split; [Assumption | Apply not_sym; Assumption]].
-Left; Exists x; Split.
-Assumption.
-Intros; Case (Req_EM x0 x); Intro.
-Assumption.
-Elim H1; Exists x0; Split; Assumption.
-Left; Assumption.
-Qed.
-
-Theorem Heine : (f:R->R;X:R->Prop) (compact X) -> ((x:R)(X x)->(continuity_pt f x)) -> (uniform_continuity f X).
-Intros f0 X H0 H; Elim (domain_P1 X); Intro Hyp.
-(* X est vide *)
-Unfold uniform_continuity; Intros; Exists (mkposreal ? Rlt_R0_R1); Intros; Elim Hyp; Exists x; Assumption.
-Elim Hyp; Clear Hyp; Intro Hyp.
-(* X possède un seul élément *)
-Unfold uniform_continuity; Intros; Exists (mkposreal ? Rlt_R0_R1); Intros; Elim Hyp; Clear Hyp; Intros; Elim H4; Clear H4; Intros; Assert H6 := (H5 ? H1); Assert H7 := (H5 ? H2); Rewrite H6; Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos eps).
-(* X possède au moins deux éléments distincts *)
-Assert X_enc : (EXT m:R | (EXT M:R | ((x:R)(X x)->``m<=x<=M``)/\``m<M``)).
-Assert H1 := (compact_P1 X H0); Unfold bounded in H1; Elim H1; Intros; Elim H2; Intros; Exists x; Exists x0; Split.
-Apply H3.
-Elim Hyp; Intros; Elim H4; Intros; Decompose [and] H5; Assert H10 := (H3 ? H6); Assert H11 := (H3 ? H8); Elim H10; Intros; Elim H11; Intros; Case (total_order_T x x0); Intro.
-Elim s; Intro.
-Assumption.
-Rewrite b in H13; Rewrite b in H7; Elim H9; Apply Rle_antisym; Apply Rle_trans with x0; Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H13 H14) r)).
-Elim X_enc; Clear X_enc; Intros m X_enc; Elim X_enc; Clear X_enc; Intros M X_enc; Elim X_enc; Clear X_enc Hyp; Intros X_enc Hyp; Unfold uniform_continuity; Intro; Assert H1 : (t:posreal)``0<t/2``.
-Intro; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos t) | Apply Rlt_Rinv; Sup0].
-Pose g := [x:R][y:R](X x)/\(EXT del:posreal | ((z:R) ``(Rabsolu (z-x))<del``->``(Rabsolu ((f0 z)-(f0 x)))<eps/2``)/\(is_lub [zeta:R]``0<zeta<=M-m``/\((z:R) ``(Rabsolu (z-x))<zeta``->``(Rabsolu ((f0 z)-(f0 x)))<eps/2``) del)/\(disc x (mkposreal ``del/2`` (H1 del)) y)).
-Assert H2 : (x:R)(EXT y:R | (g x y))->(X x).
-Intros; Elim H2; Intros; Unfold g in H3; Elim H3; Clear H3; Intros H3 _; Apply H3.
-Pose f' := (mkfamily X g H2); Unfold compact in H0; Assert H3 : (covering_open_set X f').
-Unfold covering_open_set; Split.
-Unfold covering; Intros; Exists x; Simpl; Unfold g; Split.
-Assumption.
-Assert H4 := (H ? H3); Unfold continuity_pt in H4; Unfold continue_in in H4; Unfold limit1_in in H4; Unfold limit_in in H4; Simpl in H4; Unfold R_dist in H4; Elim (H4 ``eps/2`` (H1 eps)); Intros; Pose E:=[zeta:R]``0<zeta <= M-m``/\((z:R)``(Rabsolu (z-x)) < zeta``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``); Assert H6 : (bound E).
-Unfold bound; Exists ``M-m``; Unfold is_upper_bound; Unfold E; Intros; Elim H6; Clear H6; Intros H6 _; Elim H6; Clear H6; Intros _ H6; Apply H6.
-Assert H7 : (EXT x:R | (E x)).
-Elim H5; Clear H5; Intros; Exists (Rmin x0 ``M-m``); Unfold E; Intros; Split.
-Split.
-Unfold Rmin; Case (total_order_Rle x0 ``M-m``); Intro.
-Apply H5.
-Apply Rlt_Rminus; Apply Hyp.
-Apply Rmin_r.
-Intros; Case (Req_EM x z); Intro.
-Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (H1 eps).
-Apply H7; Split.
-Unfold D_x no_cond; Split; [Trivial | Assumption].
-Apply Rlt_le_trans with (Rmin x0 ``M-m``); [Apply H8 | Apply Rmin_l].
-Assert H8 := (complet ? H6 H7); Elim H8; Clear H8; Intros; Cut ``0<x1<=(M-m)``.
-Intro; Elim H8; Clear H8; Intros; Exists (mkposreal ? H8); Split.
-Intros; Cut (EXT alp:R | ``(Rabsolu (z-x))<alp<=x1``/\(E alp)).
-Intros; Elim H11; Intros; Elim H12; Clear H12; Intros; Unfold E in H13; Elim H13; Intros; Apply H15.
-Elim H12; Intros; Assumption.
-Elim (classic (EXT alp:R | ``(Rabsolu (z-x)) < alp <= x1``/\(E alp))); Intro.
-Assumption.
-Assert H12 := (not_ex_all_not ? [alp:R]``(Rabsolu (z-x)) < alp <= x1``/\(E alp) H11); Unfold is_lub in p; Elim p; Intros; Cut (is_upper_bound E ``(Rabsolu (z-x))``).
-Intro; Assert H16 := (H14 ? H15); Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H10 H16)).
-Unfold is_upper_bound; Intros; Unfold is_upper_bound in H13; Assert H16 := (H13 ? H15); Case (total_order_Rle x2 ``(Rabsolu (z-x))``); Intro.
-Assumption.
-Elim (H12 x2); Split; [Split; [Auto with real | Assumption] | Assumption].
-Split.
-Apply p.
-Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Simpl; Unfold Rdiv; Apply Rmult_lt_pos; [Apply H8 | Apply Rlt_Rinv; Sup0].
-Elim H7; Intros; Unfold E in H8; Elim H8; Intros H9 _; Elim H9; Intros H10 _; Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H12; Unfold is_upper_bound in H11; Split.
-Apply Rlt_le_trans with x2; [Assumption | Apply (H11 ? H8)].
-Apply H12; Intros; Unfold E in H13; Elim H13; Intros; Elim H14; Intros; Assumption.
-Unfold family_open_set; Intro; Simpl; Elim (classic (X x)); Intro.
-Unfold g; Unfold open_set; Intros; Elim H4; Clear H4; Intros _ H4; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Unfold neighbourhood; Case (Req_EM x x0); Intro.
-Exists (mkposreal ? (H1 x1)); Rewrite <- H6; Unfold included; Intros; Split.
-Assumption.
-Exists x1; Split.
-Apply H4.
-Split.
-Elim H5; Intros; Apply H8.
-Apply H7.
-Pose d := ``x1/2-(Rabsolu (x0-x))``; Assert H7 : ``0<d``.
-Unfold d; Apply Rlt_Rminus; Elim H5; Clear H5; Intros; Unfold disc in H7; Apply H7.
-Exists (mkposreal ? H7); Unfold included; Intros; Split.
-Assumption.
-Exists x1; Split.
-Apply H4.
-Elim H5; Intros; Split.
-Assumption.
-Unfold disc in H8; Simpl in H8; Unfold disc; Simpl; Unfold disc in H10; Simpl in H10; Apply Rle_lt_trans with ``(Rabsolu (x2-x0))+(Rabsolu (x0-x))``.
-Replace ``x2-x`` with ``(x2-x0)+(x0-x)``; [Apply Rabsolu_triang | Ring].
-Replace ``x1/2`` with ``d+(Rabsolu (x0-x))``; [Idtac | Unfold d; Ring].
-Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x0-x))``); Apply Rlt_compatibility; Apply H8.
-Apply open_set_P6 with [_:R]False.
-Apply open_set_P4.
-Unfold eq_Dom; Unfold included; Intros; Split.
-Intros; Elim H4.
-Intros; Unfold g in H4; Elim H4; Clear H4; Intros H4 _; Elim H3; Apply H4.
-Elim (H0 ? H3); Intros DF H4; Unfold covering_finite in H4; Elim H4; Clear H4; Intros; Unfold family_finite in H5; Unfold domain_finite in H5; Unfold covering in H4; Simpl in H4; Simpl in H5; Elim H5; Clear H5; Intros l H5; Unfold intersection_domain in H5; Cut (x:R)(In x l)->(EXT del:R | ``0<del``/\((z:R)``(Rabsolu (z-x)) < del``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``)/\(included (g x) [z:R]``(Rabsolu (z-x))<del/2``)).
-Intros; Assert H7 := (Rlist_P1 l [x:R][del:R]``0<del``/\((z:R)``(Rabsolu (z-x)) < del``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``)/\(included (g x) [z:R]``(Rabsolu (z-x))<del/2``) H6); Elim H7; Clear H7; Intros l' H7; Elim H7; Clear H7; Intros; Pose D := (MinRlist l'); Cut ``0<D/2``.
-Intro; Exists (mkposreal ? H9); Intros; Assert H13 := (H4 ? H10); Elim H13; Clear H13; Intros xi H13; Assert H14 : (In xi l).
-Unfold g in H13; Decompose [and] H13; Elim (H5 xi); Intros; Apply H14; Split; Assumption.
-Elim (pos_Rl_P2 l xi); Intros H15 _; Elim (H15 H14); Intros i H16; Elim H16; Intros; Apply Rle_lt_trans with ``(Rabsolu ((f0 x)-(f0 xi)))+(Rabsolu ((f0 xi)-(f0 y)))``.
-Replace ``(f0 x)-(f0 y)`` with ``((f0 x)-(f0 xi))+((f0 xi)-(f0 y))``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var eps); Apply Rplus_lt.
-Assert H19 := (H8 i H17); Elim H19; Clear H19; Intros; Rewrite <- H18 in H20; Elim H20; Clear H20; Intros; Apply H20; Unfold included in H21; Apply Rlt_trans with ``(pos_Rl l' i)/2``.
-Apply H21.
-Elim H13; Clear H13; Intros; Assumption.
-Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Pattern 1 (pos_Rl l' i); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply H19.
-DiscrR.
-Assert H19 := (H8 i H17); Elim H19; Clear H19; Intros; Rewrite <- H18 in H20; Elim H20; Clear H20; Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H20; Unfold included in H21; Elim H13; Intros; Assert H24 := (H21 x H22); Apply Rle_lt_trans with ``(Rabsolu (y-x))+(Rabsolu (x-xi))``.
-Replace ``y-xi`` with ``(y-x)+(x-xi)``; [Apply Rabsolu_triang | Ring].
-Rewrite (double_var (pos_Rl l' i)); Apply Rplus_lt.
-Apply Rlt_le_trans with ``D/2``.
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H12.
-Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Sup0.
-Unfold D; Apply MinRlist_P1; Elim (pos_Rl_P2 l' (pos_Rl l' i)); Intros; Apply H26; Exists i; Split; [Rewrite <- H7; Assumption | Reflexivity].
-Assumption.
-Unfold Rdiv; Apply Rmult_lt_pos; [Unfold D; Apply MinRlist_P2; Intros; Elim (pos_Rl_P2 l' y); Intros; Elim (H10 H9); Intros; Elim H12; Intros; Rewrite H14; Rewrite <- H7 in H13; Elim (H8 x H13); Intros; Apply H15 | Apply Rlt_Rinv; Sup0].
-Intros; Elim (H5 x); Intros; Elim (H8 H6); Intros; Pose E:=[zeta:R]``0<zeta <= M-m``/\((z:R)``(Rabsolu (z-x)) < zeta``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``); Assert H11 : (bound E).
-Unfold bound; Exists ``M-m``; Unfold is_upper_bound; Unfold E; Intros; Elim H11; Clear H11; Intros H11 _; Elim H11; Clear H11; Intros _ H11; Apply H11.
-Assert H12 : (EXT x:R | (E x)).
-Assert H13 := (H ? H9); Unfold continuity_pt in H13; Unfold continue_in in H13; Unfold limit1_in in H13; Unfold limit_in in H13; Simpl in H13; Unfold R_dist in H13; Elim (H13 ? (H1 eps)); Intros; Elim H12; Clear H12; Intros; Exists (Rmin x0 ``M-m``); Unfold E; Intros; Split.
-Split; [Unfold Rmin; Case (total_order_Rle x0 ``M-m``); Intro; [Apply H12 | Apply Rlt_Rminus; Apply Hyp] | Apply Rmin_r].
-Intros; Case (Req_EM x z); Intro.
-Rewrite H16; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (H1 eps).
-Apply H14; Split; [Unfold D_x no_cond; Split; [Trivial | Assumption] | Apply Rlt_le_trans with (Rmin x0 ``M-m``); [Apply H15 | Apply Rmin_l]].
-Assert H13 := (complet ? H11 H12); Elim H13; Clear H13; Intros; Cut ``0<x0<=M-m``.
-Intro; Elim H13; Clear H13; Intros; Exists x0; Split.
-Assumption.
-Split.
-Intros; Cut (EXT alp:R | ``(Rabsolu (z-x))<alp<=x0``/\(E alp)).
-Intros; Elim H16; Intros; Elim H17; Clear H17; Intros; Unfold E in H18; Elim H18; Intros; Apply H20; Elim H17; Intros; Assumption.
-Elim (classic (EXT alp:R | ``(Rabsolu (z-x)) < alp <= x0``/\(E alp))); Intro.
-Assumption.
-Assert H17 := (not_ex_all_not ? [alp:R]``(Rabsolu (z-x)) < alp <= x0``/\(E alp) H16); Unfold is_lub in p; Elim p; Intros; Cut (is_upper_bound E ``(Rabsolu (z-x))``).
-Intro; Assert H21 := (H19 ? H20); Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H15 H21)).
-Unfold is_upper_bound; Intros; Unfold is_upper_bound in H18; Assert H21 := (H18 ? H20); Case (total_order_Rle x1 ``(Rabsolu (z-x))``); Intro.
-Assumption.
-Elim (H17 x1); Split.
-Split; [Auto with real | Assumption].
-Assumption.
-Unfold included g; Intros; Elim H15; Intros; Elim H17; Intros; Decompose [and] H18; Cut x0==x2.
-Intro; Rewrite H20; Apply H22.
-Unfold E in p; EApply is_lub_u.
-Apply p.
-Apply H21.
-Elim H12; Intros; Unfold E in H13; Elim H13; Intros H14 _; Elim H14; Intros H15 _; Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H16; Unfold is_upper_bound in H17; Split.
-Apply Rlt_le_trans with x1; [Assumption | Apply (H16 ? H13)].
-Apply H17; Intros; Unfold E in H18; Elim H18; Intros; Elim H19; Intros; Assumption.
-Qed.
diff --git a/theories7/Reals/Rtrigo.v b/theories7/Reals/Rtrigo.v
deleted file mode 100644
index 2b19a00a..00000000
--- a/theories7/Reals/Rtrigo.v
+++ /dev/null
@@ -1,1111 +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: Rtrigo.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Export Rtrigo_fun.
-Require Export Rtrigo_def.
-Require Export Rtrigo_alt.
-Require Export Cos_rel.
-Require Export Cos_plus.
-Require ZArith_base.
-Require Zcomplements.
-Require Classical_Prop.
-V7only [Import nat_scope. Import Z_scope. Import R_scope.].
-Open Local Scope nat_scope.
-Open Local Scope R_scope.
-
-(** sin_PI2 is the only remaining axiom **)
-Axiom sin_PI2 : ``(sin (PI/2))==1``.
-
-(**********)
-Lemma PI_neq0 : ~``PI==0``.
-Red; Intro; Assert H0 := PI_RGT_0; Rewrite H in H0; Elim (Rlt_antirefl ? H0).
-Qed.
-
-(**********) 
-Lemma cos_minus : (x,y:R) ``(cos (x-y))==(cos x)*(cos y)+(sin x)*(sin y)``.
-Intros; Unfold Rminus; Rewrite cos_plus.
-Rewrite <- cos_sym; Rewrite sin_antisym; Ring.
-Qed.
-
-(**********)
-Lemma sin2_cos2 : (x:R) ``(Rsqr (sin x)) + (Rsqr (cos x))==1``.
-Intro; Unfold Rsqr; Rewrite Rplus_sym; Rewrite <- (cos_minus x x); Unfold Rminus; Rewrite Rplus_Ropp_r; Apply cos_0.
-Qed.
-
-Lemma cos2 : (x:R) ``(Rsqr (cos x))==1-(Rsqr (sin x))``.
-Intro x; Generalize (sin2_cos2 x); Intro H1; Rewrite <- H1; Unfold Rminus; Rewrite <- (Rplus_sym (Rsqr (cos x))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Symmetry; Apply Rplus_Or.
-Qed.
-
-(**********)
-Lemma cos_PI2 : ``(cos (PI/2))==0``.
-Apply Rsqr_eq_0; Rewrite cos2; Rewrite sin_PI2; Rewrite Rsqr_1; Unfold Rminus; Apply Rplus_Ropp_r.
-Qed.
-
-(**********)
-Lemma cos_PI : ``(cos PI)==-1``.
-Replace ``PI`` with ``PI/2+PI/2``.
-Rewrite cos_plus.
-Rewrite sin_PI2; Rewrite cos_PI2.
-Ring.
-Symmetry; Apply double_var.
-Qed.
-
-Lemma sin_PI : ``(sin PI)==0``.
-Assert H := (sin2_cos2 PI).
-Rewrite cos_PI in H.
-Rewrite <- Rsqr_neg in H.
-Rewrite Rsqr_1 in H.
-Cut (Rsqr (sin PI))==R0.
-Intro; Apply (Rsqr_eq_0 ? H0).
-Apply r_Rplus_plus with R1.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Exact H.
-Qed.
-
-(**********)
-Lemma neg_cos : (x:R) ``(cos (x+PI))==-(cos x)``.
-Intro x; Rewrite -> cos_plus; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
-Qed.
-
-(**********)
-Lemma sin_cos : (x:R) ``(sin x)==-(cos (PI/2+x))``.
-Intro x; Rewrite -> cos_plus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
-Qed.
-
-(**********)
-Lemma sin_plus : (x,y:R) ``(sin (x+y))==(sin x)*(cos y)+(cos x)*(sin y)``.
-Intros.
-Rewrite (sin_cos ``x+y``).
-Replace ``PI/2+(x+y)`` with ``(PI/2+x)+y``; [Rewrite cos_plus | Ring].
-Rewrite (sin_cos ``PI/2+x``).
-Replace ``PI/2+(PI/2+x)`` with ``x+PI``.
-Rewrite neg_cos.
-Replace (cos ``PI/2+x``) with ``-(sin x)``.
-Ring.
-Rewrite sin_cos; Rewrite Ropp_Ropp; Reflexivity.
-Pattern 1 PI; Rewrite (double_var PI); Ring.
-Qed.
-
-Lemma sin_minus : (x,y:R) ``(sin (x-y))==(sin x)*(cos y)-(cos x)*(sin y)``.
-Intros; Unfold Rminus; Rewrite sin_plus.
-Rewrite <- cos_sym; Rewrite sin_antisym; Ring.
-Qed.
-
-(**********)
-Definition tan [x:R] : R := ``(sin x)/(cos x)``.
-
-Lemma tan_plus : (x,y:R) ~``(cos x)==0`` -> ~``(cos y)==0`` -> ~``(cos (x+y))==0`` -> ~``1-(tan x)*(tan y)==0`` -> ``(tan (x+y))==((tan x)+(tan y))/(1-(tan x)*(tan y))``.
-Intros; Unfold tan; Rewrite sin_plus; Rewrite cos_plus; Unfold Rdiv; Replace ``((cos x)*(cos y)-(sin x)*(sin y))`` with ``((cos x)*(cos y))*(1-(sin x)*/(cos x)*((sin y)*/(cos y)))``.
-Rewrite Rinv_Rmult.
-Repeat Rewrite <- Rmult_assoc; Replace ``((sin x)*(cos y)+(cos x)*(sin y))*/((cos x)*(cos y))`` with ``((sin x)*/(cos x)+(sin y)*/(cos y))``.
-Reflexivity.
-Rewrite Rmult_Rplus_distrl; Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc; Repeat Rewrite (Rmult_sym ``(sin x)``); Repeat Rewrite <- Rmult_assoc.
-Repeat Rewrite Rinv_r_simpl_m; [Reflexivity | Assumption | Assumption].
-Assumption.
-Assumption.
-Apply prod_neq_R0; Assumption.
-Assumption.
-Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Apply Rplus_plus_r; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``(sin x)``); Rewrite (Rmult_sym ``(cos y)``); Rewrite <- Ropp_mul3; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite (Rmult_sym (sin x)); Rewrite <- Ropp_mul3; Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r; Rewrite (Rmult_sym ``/(cos y)``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Apply Rmult_1r.
-Assumption.
-Assumption.
-Qed.
-
-(*******************************************************)
-(* Some properties of cos, sin and tan                 *)
-(*******************************************************)
-
-Lemma sin2 : (x:R) ``(Rsqr (sin x))==1-(Rsqr (cos x))``.
-Intro x; Generalize (cos2 x); Intro H1; Rewrite -> H1.
-Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Symmetry; Apply Ropp_Ropp.
-Qed.
-
-Lemma sin_2a : (x:R) ``(sin (2*x))==2*(sin x)*(cos x)``.
-Intro x; Rewrite double; Rewrite sin_plus.
-Rewrite <- (Rmult_sym (sin x)); Symmetry; Rewrite Rmult_assoc; Apply double.
-Qed.
-
-Lemma cos_2a : (x:R) ``(cos (2*x))==(cos x)*(cos x)-(sin x)*(sin x)``.
-Intro x; Rewrite double; Apply cos_plus.
-Qed.
-
-Lemma cos_2a_cos : (x:R) ``(cos (2*x))==2*(cos x)*(cos x)-1``.
-Intro x; Rewrite double; Unfold Rminus; Rewrite Rmult_assoc; Rewrite cos_plus; Generalize (sin2_cos2 x); Rewrite double; Intro H1; Rewrite <- H1; SqRing.
-Qed.
-
-Lemma cos_2a_sin : (x:R) ``(cos (2*x))==1-2*(sin x)*(sin x)``.
-Intro x; Rewrite Rmult_assoc; Unfold Rminus; Repeat Rewrite double.
-Generalize (sin2_cos2 x); Intro H1; Rewrite <- H1; Rewrite cos_plus; SqRing.
-Qed.
-
-Lemma tan_2a : (x:R) ~``(cos x)==0`` -> ~``(cos (2*x))==0`` -> ~``1-(tan x)*(tan x)==0`` ->``(tan (2*x))==(2*(tan x))/(1-(tan x)*(tan x))``.
-Repeat Rewrite double; Intros; Repeat Rewrite double; Rewrite double in H0; Apply tan_plus; Assumption.
-Qed.
-
-Lemma sin_neg : (x:R) ``(sin (-x))==-(sin x)``.
-Apply sin_antisym.
-Qed.
-
-Lemma cos_neg : (x:R) ``(cos (-x))==(cos x)``.
-Intro; Symmetry; Apply cos_sym.
-Qed.
-
-Lemma tan_0 : ``(tan 0)==0``.
-Unfold tan; Rewrite -> sin_0; Rewrite -> cos_0.
-Unfold Rdiv; Apply Rmult_Ol. 
-Qed.
-
-Lemma tan_neg : (x:R) ``(tan (-x))==-(tan x)``.
-Intros x; Unfold tan; Rewrite sin_neg; Rewrite cos_neg; Unfold Rdiv.
-Apply Ropp_mul1.
-Qed.
-
-Lemma tan_minus : (x,y:R) ~``(cos x)==0`` -> ~``(cos y)==0`` -> ~``(cos (x-y))==0`` -> ~``1+(tan x)*(tan y)==0`` -> ``(tan (x-y))==((tan x)-(tan y))/(1+(tan x)*(tan y))``.
-Intros; Unfold Rminus; Rewrite tan_plus.
-Rewrite tan_neg; Unfold Rminus; Rewrite <- Ropp_mul1; Rewrite Ropp_mul2; Reflexivity.
-Assumption.
-Rewrite cos_neg; Assumption.
-Assumption.
-Rewrite tan_neg; Unfold Rminus; Rewrite <- Ropp_mul1; Rewrite Ropp_mul2; Assumption.
-Qed.
-
-Lemma cos_3PI2 : ``(cos (3*(PI/2)))==0``.
-Replace ``3*(PI/2)`` with ``PI+(PI/2)``.
-Rewrite -> cos_plus; Rewrite -> sin_PI; Rewrite -> cos_PI2; Ring.
-Pattern 1 PI; Rewrite (double_var PI).
-Ring.
-Qed.
-
-Lemma sin_2PI : ``(sin (2*PI))==0``.
-Rewrite -> sin_2a; Rewrite -> sin_PI; Ring.
-Qed.
-
-Lemma cos_2PI : ``(cos (2*PI))==1``.
-Rewrite -> cos_2a; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
-Qed.
-
-Lemma neg_sin : (x:R) ``(sin (x+PI))==-(sin x)``.
-Intro x; Rewrite -> sin_plus; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
-Qed.
-
-Lemma sin_PI_x : (x:R) ``(sin (PI-x))==(sin x)``.
-Intro x; Rewrite -> sin_minus; Rewrite -> sin_PI; Rewrite -> cos_PI; Rewrite Rmult_Ol; Unfold Rminus; Rewrite Rplus_Ol; Rewrite Ropp_mul1; Rewrite Ropp_Ropp; Apply Rmult_1l.
-Qed.
-
-Lemma sin_period : (x:R)(k:nat) ``(sin (x+2*(INR k)*PI))==(sin x)``.
-Intros x k; Induction k.
-Cut ``x+2*(INR O)*PI==x``; [Intro; Rewrite H; Reflexivity | Ring].
-Replace ``x+2*(INR (S k))*PI`` with ``(x+2*(INR k)*PI)+(2*PI)``; [Rewrite -> sin_plus; Rewrite -> sin_2PI; Rewrite -> cos_2PI; Ring; Apply Hreck | Rewrite -> S_INR; Ring].
-Qed.
-
-Lemma cos_period : (x:R)(k:nat) ``(cos (x+2*(INR k)*PI))==(cos x)``.
-Intros x k; Induction k.
-Cut ``x+2*(INR O)*PI==x``; [Intro; Rewrite H; Reflexivity | Ring].
-Replace ``x+2*(INR (S k))*PI`` with ``(x+2*(INR k)*PI)+(2*PI)``; [Rewrite -> cos_plus; Rewrite -> sin_2PI; Rewrite -> cos_2PI; Ring; Apply Hreck | Rewrite -> S_INR; Ring].
-Qed.
-
-Lemma sin_shift : (x:R) ``(sin (PI/2-x))==(cos x)``.
-Intro x; Rewrite -> sin_minus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
-Qed.
-
-Lemma cos_shift : (x:R) ``(cos (PI/2-x))==(sin x)``.
-Intro x; Rewrite -> cos_minus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
-Qed.
-
-Lemma cos_sin : (x:R) ``(cos x)==(sin (PI/2+x))``.
-Intro x; Rewrite -> sin_plus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
-Qed.
-
-Lemma PI2_RGT_0 : ``0<PI/2``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup].
-Qed. 
-
-Lemma SIN_bound : (x:R) ``-1<=(sin x)<=1``.
-Intro; Case (total_order_Rle ``-1`` (sin x)); Intro.
-Case (total_order_Rle (sin x) ``1``); Intro.
-Split; Assumption.
-Cut ``1<(sin x)``.
-Intro; Generalize (Rsqr_incrst_1 ``1`` (sin x) H (Rlt_le ``0`` ``1`` Rlt_R0_R1) (Rlt_le ``0`` (sin x) (Rlt_trans ``0`` ``1`` (sin x) Rlt_R0_R1 H))); Rewrite Rsqr_1; Intro; Rewrite sin2 in H0; Unfold Rminus in H0; Generalize (Rlt_compatibility ``-1`` ``1`` ``1+ -(Rsqr (cos x))`` H0); Repeat Rewrite <- Rplus_assoc; Repeat Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Intro; Rewrite <- Ropp_O in H1; Generalize (Rlt_Ropp ``-0`` ``-(Rsqr (cos x))`` H1); Repeat Rewrite Ropp_Ropp; Intro; Generalize (pos_Rsqr (cos x)); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` (Rsqr (cos x)) ``0`` H3 H2)).
-Auto with real.
-Cut ``(sin x)< -1``.
-Intro; Generalize (Rlt_Ropp (sin x) ``-1`` H); Rewrite Ropp_Ropp; Clear H; Intro; Generalize (Rsqr_incrst_1 ``1`` ``-(sin x)`` H (Rlt_le ``0`` ``1`` Rlt_R0_R1) (Rlt_le ``0`` ``-(sin x)`` (Rlt_trans ``0`` ``1`` ``-(sin x)`` Rlt_R0_R1 H))); Rewrite Rsqr_1; Intro; Rewrite <- Rsqr_neg in H0; Rewrite sin2 in H0; Unfold Rminus in H0; Generalize (Rlt_compatibility ``-1`` ``1`` ``1+ -(Rsqr (cos x))`` H0); Repeat Rewrite <- Rplus_assoc; Repeat Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Intro; Rewrite <- Ropp_O in H1; Generalize (Rlt_Ropp ``-0`` ``-(Rsqr (cos x))`` H1); Repeat Rewrite Ropp_Ropp; Intro; Generalize (pos_Rsqr (cos x)); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` (Rsqr (cos x)) ``0`` H3 H2)).
-Auto with real.
-Qed.
-
-Lemma COS_bound : (x:R) ``-1<=(cos x)<=1``.
-Intro; Rewrite <- sin_shift; Apply SIN_bound.
-Qed.
-
-Lemma cos_sin_0 : (x:R) ~(``(cos x)==0``/\``(sin x)==0``).
-Intro; Red; Intro; Elim H; Intros; Generalize (sin2_cos2 x); Intro; Rewrite H0 in H2; Rewrite H1 in H2; Repeat Rewrite Rsqr_O in H2; Rewrite Rplus_Or in H2; Generalize Rlt_R0_R1; Intro; Rewrite <- H2 in H3; Elim (Rlt_antirefl ``0`` H3).
-Qed.
-  
-Lemma cos_sin_0_var : (x:R) ~``(cos x)==0``\/~``(sin x)==0``.
-Intro; Apply not_and_or; Apply cos_sin_0.
-Qed.
-
-(*****************************************************************)
-(* Using series definitions of cos and sin                       *)
-(*****************************************************************)
-
-Definition sin_lb [a:R] : R := (sin_approx a (3)).
-Definition sin_ub [a:R] : R := (sin_approx a (4)).
-Definition cos_lb [a:R] : R := (cos_approx a (3)).
-Definition cos_ub [a:R] : R := (cos_approx a (4)).
-
-Lemma sin_lb_gt_0 : (a:R) ``0<a``->``a<=PI/2``->``0<(sin_lb a)``.
-Intros.
-Unfold sin_lb; Unfold sin_approx; Unfold sin_term.
-Pose Un := [i:nat]``(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))``.
-Replace (sum_f_R0 [i:nat] ``(pow ( -1) i)*(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))`` (S (S (S O)))) with (sum_f_R0 [i:nat]``(pow (-1) i)*(Un i)`` (3)); [Idtac | Apply sum_eq; Intros; Unfold Un; Reflexivity].
-Cut (n:nat)``(Un (S n))<(Un n)``.
-Intro; Simpl.
-Repeat Rewrite Rmult_1l; Repeat Rewrite Rmult_1r; Replace ``-1*(Un (S O))`` with ``-(Un (S O))``; [Idtac | Ring]; Replace ``-1* -1*(Un (S (S O)))`` with ``(Un (S (S O)))``; [Idtac | Ring]; Replace ``-1*( -1* -1)*(Un (S (S (S O))))`` with ``-(Un (S (S (S O))))``; [Idtac | Ring]; Replace ``(Un O)+ -(Un (S O))+(Un (S (S O)))+ -(Un (S (S (S O))))`` with ``((Un O)-(Un (S O)))+((Un (S (S O)))-(Un (S (S (S O)))))``; [Idtac | Ring].
-Apply gt0_plus_gt0_is_gt0.
-Unfold Rminus; Apply Rlt_anti_compatibility with (Un (S O)); Rewrite Rplus_Or; Rewrite (Rplus_sym (Un (S O))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H1.
-Unfold Rminus; Apply Rlt_anti_compatibility with (Un (S (S (S O)))); Rewrite Rplus_Or; Rewrite (Rplus_sym (Un (S (S (S O))))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H1.
-Intro; Unfold Un.
-Cut (plus (mult (2) (S n)) (S O)) = (plus (plus (mult (2) n) (S O)) (2)).
-Intro; Rewrite H1.
-Rewrite pow_add; Unfold Rdiv; Rewrite Rmult_assoc; Apply Rlt_monotony.
-Apply pow_lt; Assumption.
-Rewrite <- H1; Apply Rlt_monotony_contra with (INR (fact (plus (mult (S (S O)) n) (S O)))).
-Apply lt_INR_0; Apply neq_O_lt.
-Assert H2 := (fact_neq_0 (plus (mult (2) n) (1))).
-Red; Intro; Elim H2; Symmetry; Assumption.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with (INR (fact (plus (mult (S (S O)) (S n)) (S O)))).
-Apply lt_INR_0; Apply neq_O_lt.
-Assert H2 := (fact_neq_0 (plus (mult (2) (S n)) (1))).
-Red; Intro; Elim H2; Symmetry; Assumption.
-Rewrite (Rmult_sym (INR (fact (plus (mult (S (S O)) (S n)) (S O))))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Do 2 Rewrite Rmult_1r; Apply Rle_lt_trans with ``(INR (fact (plus (mult (S (S O)) n) (S O))))*4``.
-Apply Rle_monotony.
-Replace R0 with (INR O); [Idtac | Reflexivity]; Apply le_INR; Apply le_O_n.
-Simpl; Rewrite Rmult_1r; Replace ``4`` with ``(Rsqr 2)``; [Idtac | SqRing]; Replace ``a*a`` with (Rsqr a); [Idtac | Reflexivity]; Apply Rsqr_incr_1.
-Apply Rle_trans with ``PI/2``; [Assumption | Unfold Rdiv; Apply Rle_monotony_contra with ``2``; [ Sup0 | Rewrite <- Rmult_assoc;  Rewrite Rinv_r_simpl_m; [Replace ``2*2`` with ``4``; [Apply PI_4 | Ring] | DiscrR]]].
-Left; Assumption.
-Left; Sup0.
-Rewrite H1; Replace (plus (plus (mult (S (S O)) n) (S O)) (S (S O))) with (S (S (plus (mult (S (S O)) n) (S O)))).
-Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR.
-Repeat Rewrite <- Rmult_assoc.
-Rewrite <- (Rmult_sym (INR (fact (plus (mult (S (S O)) n) (S O))))).
-Rewrite Rmult_assoc.
-Apply Rlt_monotony.
-Apply lt_INR_0; Apply neq_O_lt.
-Assert H2 := (fact_neq_0 (plus (mult (2) n) (1))).
-Red; Intro; Elim H2; Symmetry; Assumption.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Pose x := (INR n); Unfold INR.
-Replace ``(2*x+1+1+1)*(2*x+1+1)`` with ``4*x*x+10*x+6``; [Idtac | Ring].
-Apply Rlt_anti_compatibility with ``-4``; Rewrite Rplus_Ropp_l; Replace ``-4+(4*x*x+10*x+6)`` with ``(4*x*x+10*x)+2``; [Idtac | Ring].
-Apply ge0_plus_gt0_is_gt0.
-Cut ``0<=x``.
-Intro; Apply ge0_plus_ge0_is_ge0; Repeat Apply Rmult_le_pos; Assumption Orelse Left; Sup.
-Unfold x; Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Sup0.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 3 Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Qed.
-
-Lemma SIN : (a:R) ``0<=a`` -> ``a<=PI`` -> ``(sin_lb a)<=(sin a)<=(sin_ub a)``.
-Intros; Unfold sin_lb sin_ub; Apply (sin_bound a (S O) H H0).
-Qed.
-
-Lemma COS : (a:R) ``-PI/2<=a`` -> ``a<=PI/2`` -> ``(cos_lb a)<=(cos a)<=(cos_ub a)``.
-Intros; Unfold cos_lb cos_ub; Apply (cos_bound a (S O) H H0).
-Qed.
-
-(**********)
-Lemma _PI2_RLT_0 : ``-(PI/2)<0``.
-Rewrite <- Ropp_O; Apply Rlt_Ropp1; Apply PI2_RGT_0.
-Qed.
-
-Lemma PI4_RLT_PI2 : ``PI/4<PI/2``.
-Unfold Rdiv; Apply Rlt_monotony.
-Apply PI_RGT_0.
-Apply Rinv_lt.
-Apply Rmult_lt_pos; Sup0.
-Pattern 1 ``2``; Rewrite <- Rplus_Or.
-Replace ``4`` with ``2+2``; [Apply Rlt_compatibility; Sup0 | Ring].
-Qed.
-
-Lemma PI2_Rlt_PI : ``PI/2<PI``.
-Unfold Rdiv; Pattern 2 PI; Rewrite <- Rmult_1r.
-Apply Rlt_monotony.
-Apply PI_RGT_0.
-Pattern 3 R1; Rewrite <- Rinv_R1; Apply Rinv_lt.
-Rewrite Rmult_1l; Sup0.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
-Qed.
-
-(********************************************)
-(* Increasing and decreasing of COS and SIN *)
-(********************************************)
-Theorem sin_gt_0 : (x:R) ``0<x`` -> ``x<PI`` -> ``0<(sin x)``.
-Intros; Elim (SIN x (Rlt_le R0 x H) (Rlt_le x PI H0)); Intros H1 _; Case (total_order x ``PI/2``); Intro H2.
-Apply Rlt_le_trans with (sin_lb x).
-Apply sin_lb_gt_0; [Assumption | Left; Assumption].
-Assumption.
-Elim H2; Intro H3.
-Rewrite H3; Rewrite sin_PI2; Apply Rlt_R0_R1.
-Rewrite <- sin_PI_x; Generalize (Rgt_Ropp x ``PI/2`` H3); Intro H4; Generalize (Rlt_compatibility PI (Ropp x) (Ropp ``PI/2``) H4).
-Replace ``PI+(-x)`` with ``PI-x``.
-Replace ``PI+ -(PI/2)`` with ``PI/2``.
-Intro H5; Generalize (Rlt_Ropp x PI H0); Intro H6; Change ``-PI < -x`` in H6; Generalize (Rlt_compatibility PI (Ropp PI) (Ropp x) H6).
-Rewrite Rplus_Ropp_r.
-Replace ``PI+ -x`` with ``PI-x``.
-Intro H7; Elim (SIN ``PI-x`` (Rlt_le R0 ``PI-x`` H7) (Rlt_le ``PI-x`` PI (Rlt_trans ``PI-x`` ``PI/2`` ``PI`` H5 PI2_Rlt_PI))); Intros H8 _; Generalize (sin_lb_gt_0 ``PI-x`` H7 (Rlt_le ``PI-x`` ``PI/2`` H5)); Intro H9; Apply (Rlt_le_trans ``0`` ``(sin_lb (PI-x))`` ``(sin (PI-x))`` H9 H8).
-Reflexivity.
-Pattern 2 PI; Rewrite double_var; Ring.
-Reflexivity.
-Qed.
-
-Theorem cos_gt_0 : (x:R) ``-(PI/2)<x`` -> ``x<PI/2`` -> ``0<(cos x)``.
-Intros; Rewrite cos_sin; Generalize (Rlt_compatibility ``PI/2`` ``-(PI/2)`` x H).
-Rewrite Rplus_Ropp_r; Intro H1; Generalize (Rlt_compatibility ``PI/2`` x ``PI/2`` H0); Rewrite <- double_var; Intro H2; Apply (sin_gt_0 ``PI/2+x`` H1 H2).
-Qed.
-
-Lemma sin_ge_0 : (x:R) ``0<=x`` -> ``x<=PI`` -> ``0<=(sin x)``.
-Intros x H1 H2; Elim H1; Intro H3; [ Elim H2; Intro H4; [ Left ; Apply (sin_gt_0 x H3 H4) | Rewrite H4; Right; Symmetry; Apply sin_PI ] | Rewrite <- H3; Right; Symmetry; Apply sin_0].
-Qed.
-
-Lemma cos_ge_0 : (x:R) ``-(PI/2)<=x`` -> ``x<=PI/2`` -> ``0<=(cos x)``.
-Intros x H1 H2; Elim H1; Intro H3; [ Elim H2; Intro H4; [ Left ; Apply (cos_gt_0 x H3 H4) | Rewrite H4; Right; Symmetry; Apply cos_PI2 ] | Rewrite <- H3; Rewrite cos_neg; Right; Symmetry; Apply cos_PI2 ].
-Qed.
-
-Lemma sin_le_0 : (x:R) ``PI<=x`` -> ``x<=2*PI`` -> ``(sin x)<=0``.
-Intros x H1 H2; Apply Rle_sym2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (sin x)); Apply Rle_Ropp; Rewrite <- neg_sin; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``; [Rewrite -> (sin_period (Rminus x PI) (S O)); Apply sin_ge_0; [Replace ``x-PI`` with ``x+(-PI)``; [Rewrite Rplus_sym; Replace ``0`` with ``(-PI)+PI``; [Apply Rle_compatibility; Assumption | Ring] | Ring] | Replace ``x-PI`` with ``x+(-PI)``; Rewrite Rplus_sym; [Pattern 2 PI; Replace ``PI`` with ``(-PI)+2*PI``; [Apply Rle_compatibility; Assumption | Ring] | Ring]] |Unfold INR; Ring].
-Qed.
-
-Lemma cos_le_0 : (x:R) ``PI/2<=x``->``x<=3*(PI/2)``->``(cos x)<=0``.
-Intros x H1 H2; Apply Rle_sym2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (cos x)); Apply Rle_Ropp; Rewrite <- neg_cos; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``.
-Rewrite cos_period; Apply cos_ge_0.
-Replace ``-(PI/2)`` with ``-PI+(PI/2)``.
-Unfold Rminus; Rewrite (Rplus_sym x); Apply Rle_compatibility; Assumption.
-Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring.
-Unfold Rminus; Rewrite Rplus_sym; Replace ``PI/2`` with ``(-PI)+3*(PI/2)``.
-Apply Rle_compatibility; Assumption.
-Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. 
-Unfold INR; Ring.
-Qed.
-
-Lemma sin_lt_0 : (x:R) ``PI<x`` -> ``x<2*PI`` -> ``(sin x)<0``.
-Intros x H1 H2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (sin x)); Apply Rlt_Ropp; Rewrite <- neg_sin; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``; [Rewrite -> (sin_period (Rminus x PI) (S O)); Apply sin_gt_0; [Replace ``x-PI`` with ``x+(-PI)``; [Rewrite Rplus_sym; Replace ``0`` with ``(-PI)+PI``; [Apply Rlt_compatibility; Assumption | Ring] | Ring] | Replace ``x-PI`` with ``x+(-PI)``; Rewrite Rplus_sym; [Pattern 2 PI; Replace ``PI`` with ``(-PI)+2*PI``; [Apply Rlt_compatibility; Assumption | Ring] | Ring]] |Unfold INR; Ring].
-Qed.
-
-Lemma sin_lt_0_var : (x:R) ``-PI<x`` -> ``x<0`` -> ``(sin x)<0``.
-Intros; Generalize (Rlt_compatibility ``2*PI`` ``-PI`` x H); Replace ``2*PI+(-PI)`` with ``PI``; [Intro H1; Rewrite Rplus_sym in H1; Generalize (Rlt_compatibility ``2*PI`` x ``0`` H0); Intro H2; Rewrite (Rplus_sym ``2*PI``) in H2; Rewrite <- (Rplus_sym R0) in H2; Rewrite Rplus_Ol in H2; Rewrite <- (sin_period x (1)); Unfold INR; Replace ``2*1*PI`` with ``2*PI``; [Apply (sin_lt_0 ``x+2*PI`` H1 H2) | Ring] | Ring].
-Qed.
-
-Lemma cos_lt_0 : (x:R) ``PI/2<x`` -> ``x<3*(PI/2)``-> ``(cos x)<0``.
-Intros x H1 H2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (cos x)); Apply Rlt_Ropp; Rewrite <- neg_cos; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``.
-Rewrite cos_period; Apply cos_gt_0.
-Replace ``-(PI/2)`` with ``-PI+(PI/2)``.
-Unfold Rminus; Rewrite (Rplus_sym x); Apply Rlt_compatibility; Assumption.
-Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. 
-Unfold Rminus; Rewrite Rplus_sym; Replace ``PI/2`` with ``(-PI)+3*(PI/2)``.
-Apply Rlt_compatibility; Assumption.
-Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. 
-Unfold INR; Ring.
-Qed.
-
-Lemma tan_gt_0 : (x:R) ``0<x`` -> ``x<PI/2`` -> ``0<(tan x)``.
-Intros x H1 H2; Unfold tan; Generalize _PI2_RLT_0; Generalize (Rlt_trans R0 x ``PI/2`` H1 H2); Intros; Generalize (Rlt_trans ``-(PI/2)`` R0 x H0 H1); Intro H5; Generalize (Rlt_trans x ``PI/2`` PI H2 PI2_Rlt_PI); Intro H7; Unfold Rdiv;  Apply Rmult_lt_pos.
-Apply sin_gt_0; Assumption.
-Apply Rlt_Rinv; Apply cos_gt_0; Assumption.
-Qed.
-
-Lemma tan_lt_0 : (x:R) ``-(PI/2)<x``->``x<0``->``(tan x)<0``.
-Intros x H1 H2; Unfold tan; Generalize (cos_gt_0 x H1 (Rlt_trans x ``0`` ``PI/2`` H2 PI2_RGT_0)); Intro H3; Rewrite <- Ropp_O; Replace ``(sin x)/(cos x)`` with ``- ((-(sin x))/(cos x))``.
-Rewrite <- sin_neg; Apply Rgt_Ropp; Change ``0<(sin (-x))/(cos x)``; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply sin_gt_0.
-Rewrite <- Ropp_O; Apply Rgt_Ropp; Assumption.
-Apply Rlt_trans with ``PI/2``.
-Rewrite <- (Ropp_Ropp ``PI/2``); Apply Rgt_Ropp; Assumption.
-Apply PI2_Rlt_PI.
-Apply Rlt_Rinv; Assumption.
-Unfold Rdiv; Ring.
-Qed.
-
-Lemma cos_ge_0_3PI2 : (x:R) ``3*(PI/2)<=x``->``x<=2*PI``->``0<=(cos x)``.
-Intros; Rewrite <- cos_neg; Rewrite <- (cos_period ``-x`` (1)); Unfold INR; Replace ``-x+2*1*PI`` with ``2*PI-x``.
-Generalize (Rle_Ropp x ``2*PI`` H0); Intro H1; Generalize (Rle_sym2 ``-(2*PI)`` ``-x`` H1); Clear H1; Intro H1; Generalize (Rle_compatibility ``2*PI`` ``-(2*PI)`` ``-x`` H1).
-Rewrite Rplus_Ropp_r. 
-Intro H2; Generalize (Rle_Ropp ``3*(PI/2)`` x H); Intro H3; Generalize (Rle_sym2 ``-x`` ``-(3*(PI/2))`` H3); Clear H3; Intro H3;  Generalize (Rle_compatibility ``2*PI`` ``-x`` ``-(3*(PI/2))`` H3).
-Replace ``2*PI+ -(3*PI/2)`` with ``PI/2``.
-Intro H4; Apply (cos_ge_0 ``2*PI-x`` (Rlt_le ``-(PI/2)`` ``2*PI-x`` (Rlt_le_trans ``-(PI/2)`` ``0`` ``2*PI-x`` _PI2_RLT_0 H2)) H4).
-Rewrite double; Pattern 2 3 PI; Rewrite double_var; Ring.
-Ring.
-Qed.
-
-Lemma form1 : (p,q:R) ``(cos p)+(cos q)==2*(cos ((p-q)/2))*(cos ((p+q)/2))``.
-Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
-Rewrite <- (cos_neg q); Replace``-q`` with ``(p-q)/2-(p+q)/2``.
-Rewrite cos_plus; Rewrite cos_minus; Ring.
-Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
-Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
-Qed.
-
-Lemma form2 : (p,q:R) ``(cos p)-(cos q)==-2*(sin ((p-q)/2))*(sin ((p+q)/2))``.
-Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
-Rewrite <- (cos_neg q); Replace``-q`` with ``(p-q)/2-(p+q)/2``.
-Rewrite cos_plus; Rewrite cos_minus; Ring.
-Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
-Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
-Qed.
-
-Lemma form3 : (p,q:R) ``(sin p)+(sin q)==2*(cos ((p-q)/2))*(sin ((p+q)/2))``.
-Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
-Pattern 3 q; Replace ``q`` with ``(p+q)/2-(p-q)/2``.
-Rewrite sin_plus; Rewrite sin_minus; Ring.
-Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
-Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
-Qed.
-
-Lemma form4 : (p,q:R) ``(sin p)-(sin q)==2*(cos ((p+q)/2))*(sin ((p-q)/2))``.
-Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
-Pattern 3 q; Replace ``q`` with ``(p+q)/2-(p-q)/2``.
-Rewrite sin_plus; Rewrite sin_minus; Ring.
-Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
-Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
-
-Qed.
-
-Lemma sin_increasing_0 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``(sin x)<(sin y)``->``x<y``.
-Intros; Cut ``(sin ((x-y)/2))<0``.
-Intro H4; Case (total_order ``(x-y)/2`` ``0``); Intro H5.
-Assert Hyp : ``0<2``.
-Sup0.
-Generalize (Rlt_monotony ``2`` ``(x-y)/2`` ``0`` Hyp H5).
-Unfold Rdiv.
-Rewrite <- Rmult_assoc.
-Rewrite Rinv_r_simpl_m.
-Rewrite Rmult_Or.
-Clear H5; Intro H5; Apply Rminus_lt; Assumption.
-DiscrR.
-Elim H5; Intro H6.
-Rewrite H6 in H4; Rewrite sin_0 in H4; Elim (Rlt_antirefl ``0`` H4).
-Change ``0<(x-y)/2`` in H6; Generalize (Rle_Ropp ``-(PI/2)`` y H1).
-Rewrite Ropp_Ropp.
-Intro H7; Generalize (Rle_sym2 ``-y`` ``PI/2`` H7); Clear H7; Intro H7; Generalize (Rplus_le x ``PI/2`` ``-y`` ``PI/2`` H0 H7).
-Rewrite <- double_var.
-Intro H8.
-Assert Hyp : ``0<2``.
-Sup0.
-Generalize (Rle_monotony ``(Rinv 2)`` ``x-y`` PI (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H8).
-Repeat Rewrite (Rmult_sym ``/2``). 
-Intro H9; Generalize (sin_gt_0 ``(x-y)/2`` H6 (Rle_lt_trans ``(x-y)/2`` ``PI/2`` PI H9 PI2_Rlt_PI)); Intro H10; Elim (Rlt_antirefl ``(sin ((x-y)/2))`` (Rlt_trans ``(sin ((x-y)/2))`` ``0`` ``(sin ((x-y)/2))`` H4 H10)).
-Generalize (Rlt_minus (sin x) (sin y) H3); Clear H3; Intro H3; Rewrite form4 in H3; Generalize (Rplus_le x ``PI/2`` y ``PI/2`` H0 H2).
-Rewrite <- double_var.
-Assert Hyp : ``0<2``.
-Sup0.
-Intro H4; Generalize (Rle_monotony ``(Rinv 2)`` ``x+y`` PI (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H4).
-Repeat Rewrite (Rmult_sym ``/2``). 
-Clear H4; Intro H4; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` y H H1); Replace ``-(PI/2)+(-(PI/2))`` with ``-PI``.
-Intro H5; Generalize (Rle_monotony ``(Rinv 2)`` ``-PI`` ``x+y`` (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H5).
-Replace ``/2*(x+y)`` with ``(x+y)/2``.
-Replace ``/2*(-PI)`` with ``-(PI/2)``.
-Clear H5; Intro H5; Elim H4; Intro H40.
-Elim H5; Intro H50.
-Generalize (cos_gt_0 ``(x+y)/2`` H50 H40); Intro H6; Generalize (Rlt_monotony ``2`` ``0`` ``(cos ((x+y)/2))`` Hyp H6).
-Rewrite Rmult_Or. 
-Clear H6; Intro H6; Case (case_Rabsolu ``(sin ((x-y)/2))``); Intro H7.
-Assumption.
-Generalize (Rle_sym2 ``0`` ``(sin ((x-y)/2))`` H7); Clear H7; Intro H7; Generalize (Rmult_le_pos ``2*(cos ((x+y)/2))`` ``(sin ((x-y)/2))`` (Rlt_le ``0`` ``2*(cos ((x+y)/2))`` H6) H7); Intro H8; Generalize (Rle_lt_trans ``0`` ``2*(cos ((x+y)/2))*(sin ((x-y)/2))`` ``0`` H8 H3); Intro H9; Elim (Rlt_antirefl ``0`` H9).
-Rewrite <- H50 in H3; Rewrite cos_neg in H3; Rewrite cos_PI2 in H3; Rewrite Rmult_Or in H3; Rewrite Rmult_Ol in H3; Elim (Rlt_antirefl ``0`` H3).
-Unfold Rdiv in H3.
-Rewrite H40 in H3; Assert H50 := cos_PI2; Unfold Rdiv in H50; Rewrite H50 in H3; Rewrite Rmult_Or in H3; Rewrite Rmult_Ol in H3; Elim (Rlt_antirefl ``0`` H3).
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Apply Rmult_sym.
-Unfold Rdiv; Apply Rmult_sym.
-Pattern 1 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Reflexivity.
-Qed.
-
-Lemma sin_increasing_1 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``x<y``->``(sin x)<(sin y)``.
-Intros; Generalize (Rlt_compatibility ``x`` ``x`` ``y`` H3); Intro H4; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` x H H); Replace ``-(PI/2)+ (-(PI/2))`` with ``-PI``.
-Assert Hyp : ``0<2``.
-Sup0.
-Intro H5; Generalize (Rle_lt_trans ``-PI`` ``x+x`` ``x+y`` H5 H4); Intro H6; Generalize (Rlt_monotony ``(Rinv 2)`` ``-PI`` ``x+y`` (Rlt_Rinv ``2`` Hyp) H6); Replace ``/2*(-PI)`` with ``-(PI/2)``.
-Replace ``/2*(x+y)`` with ``(x+y)/2``.
-Clear H4 H5 H6; Intro H4; Generalize (Rlt_compatibility ``y`` ``x`` ``y`` H3); Intro H5; Rewrite Rplus_sym in H5; Generalize (Rplus_le y ``PI/2`` y ``PI/2`` H2 H2).
-Rewrite <- double_var.
-Intro H6; Generalize (Rlt_le_trans ``x+y`` ``y+y`` PI H5 H6); Intro H7; Generalize (Rlt_monotony ``(Rinv 2)``  ``x+y`` PI (Rlt_Rinv ``2`` Hyp) H7); Replace ``/2*PI`` with ``PI/2``.
-Replace ``/2*(x+y)`` with ``(x+y)/2``.
-Clear H5 H6 H7; Intro H5; Generalize (Rle_Ropp ``-(PI/2)`` y H1); Rewrite Ropp_Ropp; Clear H1; Intro H1; Generalize (Rle_sym2 ``-y`` ``PI/2`` H1); Clear H1; Intro H1; Generalize (Rle_Ropp y ``PI/2`` H2); Clear H2; Intro H2; Generalize (Rle_sym2 ``-(PI/2)`` ``-y`` H2); Clear H2; Intro H2; Generalize (Rlt_compatibility ``-y`` x y H3); Replace ``-y+x`` with ``x-y``.
-Rewrite Rplus_Ropp_l.
-Intro H6; Generalize (Rlt_monotony ``(Rinv 2)``  ``x-y`` ``0`` (Rlt_Rinv ``2`` Hyp) H6); Rewrite Rmult_Or; Replace ``/2*(x-y)`` with ``(x-y)/2``.
-Clear H6; Intro H6; Generalize (Rplus_le  ``-(PI/2)`` x ``-(PI/2)`` ``-y`` H H2); Replace ``-(PI/2)+ (-(PI/2))`` with ``-PI``.
-Replace `` x+ -y`` with ``x-y``.
-Intro H7; Generalize (Rle_monotony ``(Rinv 2)`` ``-PI`` ``x-y`` (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H7); Replace ``/2*(-PI)`` with ``-(PI/2)``.
-Replace ``/2*(x-y)`` with ``(x-y)/2``.
-Clear H7; Intro H7; Clear H H0 H1 H2; Apply Rminus_lt; Rewrite form4; Generalize (cos_gt_0 ``(x+y)/2`` H4 H5); Intro H8; Generalize (Rmult_lt_pos ``2`` ``(cos ((x+y)/2))`` Hyp H8); Clear H8; Intro H8; Cut ``-PI< -(PI/2)``.
-Intro H9; Generalize (sin_lt_0_var ``(x-y)/2`` (Rlt_le_trans ``-PI`` ``-(PI/2)`` ``(x-y)/2`` H9 H7) H6); Intro H10; Generalize (Rlt_anti_monotony ``(sin ((x-y)/2))`` ``0`` ``2*(cos ((x+y)/2))`` H10 H8); Intro H11; Rewrite Rmult_Or in H11; Rewrite Rmult_sym; Assumption.
-Apply Rlt_Ropp; Apply PI2_Rlt_PI.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rdiv; Rewrite <- Ropp_mul1; Apply Rmult_sym.
-Reflexivity.
-Pattern 1 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Reflexivity.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rminus; Apply Rplus_sym.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rdiv; Apply Rmult_sym.
-Unfold Rdiv.
-Rewrite <- Ropp_mul1.
-Apply Rmult_sym.
-Pattern 1 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Reflexivity.
-Qed.
-
-Lemma sin_decreasing_0 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``(sin x)<(sin y)`` -> ``y<x``.
-Intros; Rewrite <- (sin_PI_x x) in H3; Rewrite <- (sin_PI_x y) in H3; Generalize (Rlt_Ropp ``(sin (PI-x))`` ``(sin (PI-y))`` H3); Repeat Rewrite <- sin_neg; Generalize (Rle_compatibility ``-PI`` x ``3*(PI/2)`` H); Generalize (Rle_compatibility ``-PI`` ``PI/2`` x H0); Generalize (Rle_compatibility ``-PI`` y ``3*(PI/2)`` H1); Generalize (Rle_compatibility ``-PI`` ``PI/2`` y H2); Replace ``-PI+x`` with ``x-PI``.
-Replace ``-PI+PI/2`` with ``-(PI/2)``.
-Replace ``-PI+y`` with ``y-PI``.
-Replace ``-PI+3*(PI/2)`` with ``PI/2``.
-Replace ``-(PI-x)`` with ``x-PI``.
-Replace ``-(PI-y)`` with ``y-PI``.
-Intros; Change ``(sin (y-PI))<(sin (x-PI))`` in H8; Apply Rlt_anti_compatibility with ``-PI``; Rewrite Rplus_sym; Replace ``y+ (-PI)`` with ``y-PI``.
-Rewrite Rplus_sym; Replace ``x+ (-PI)`` with ``x-PI``.
-Apply (sin_increasing_0 ``y-PI`` ``x-PI`` H4 H5 H6 H7 H8).
-Reflexivity.
-Reflexivity.
-Unfold Rminus; Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Apply Rplus_sym.
-Unfold Rminus; Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Apply Rplus_sym.
-Pattern 2 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Ring.
-Unfold Rminus; Apply Rplus_sym.
-Pattern 2 PI; Rewrite double_var.
-Rewrite Ropp_distr1.
-Ring.
-Unfold Rminus; Apply Rplus_sym.
-Qed.
-
-Lemma sin_decreasing_1 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``x<y``  -> ``(sin y)<(sin x)``.
-Intros; Rewrite <- (sin_PI_x x); Rewrite <- (sin_PI_x y); Generalize (Rle_compatibility ``-PI`` x ``3*(PI/2)`` H); Generalize (Rle_compatibility ``-PI`` ``PI/2`` x H0); Generalize (Rle_compatibility ``-PI`` y ``3*(PI/2)`` H1); Generalize (Rle_compatibility ``-PI`` ``PI/2`` y H2); Generalize (Rlt_compatibility ``-PI`` x y H3); Replace ``-PI+PI/2`` with ``-(PI/2)``.
-Replace ``-PI+y`` with ``y-PI``.
-Replace ``-PI+3*(PI/2)`` with ``PI/2``.
-Replace ``-PI+x`` with ``x-PI``.
-Intros; Apply Ropp_Rlt; Repeat Rewrite <- sin_neg; Replace ``-(PI-x)`` with ``x-PI``.
-Replace ``-(PI-y)`` with ``y-PI``.
-Apply (sin_increasing_1 ``x-PI`` ``y-PI`` H7 H8 H5 H6 H4).
-Unfold Rminus; Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Apply Rplus_sym.
-Unfold Rminus; Rewrite Ropp_distr1.
-Rewrite Ropp_Ropp.
-Apply Rplus_sym.
-Unfold Rminus; Apply Rplus_sym.
-Pattern 2 PI; Rewrite double_var; Ring.
-Unfold Rminus; Apply Rplus_sym.
-Pattern 2 PI; Rewrite double_var; Ring.
-Qed.
-
-Lemma cos_increasing_0 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``(cos x)<(cos y)`` -> ``x<y``.
-Intros x y H1 H2 H3 H4; Rewrite <- (cos_neg x); Rewrite <- (cos_neg y); Rewrite <- (cos_period ``-x`` (1)); Rewrite <- (cos_period ``-y`` (1)); Unfold INR; Replace ``-x+2*1*PI`` with ``PI/2-(x-3*(PI/2))``.
-Replace ``-y+2*1*PI`` with ``PI/2-(y-3*(PI/2))``.
-Repeat Rewrite cos_shift; Intro H5; Generalize (Rle_compatibility ``-3*(PI/2)`` PI x H1); Generalize (Rle_compatibility ``-3*(PI/2)`` x ``2*PI`` H2); Generalize (Rle_compatibility ``-3*(PI/2)`` PI y H3); Generalize (Rle_compatibility ``-3*(PI/2)`` y ``2*PI`` H4).
-Replace ``-3*(PI/2)+y`` with ``y-3*(PI/2)``.
-Replace ``-3*(PI/2)+x`` with ``x-3*(PI/2)``.
-Replace ``-3*(PI/2)+2*PI`` with ``PI/2``.
-Replace ``-3*PI/2+PI`` with ``-(PI/2)``.
-Clear H1 H2 H3 H4; Intros H1 H2 H3 H4; Apply Rlt_anti_compatibility with ``-3*(PI/2)``; Replace ``-3*PI/2+x`` with ``x-3*(PI/2)``.
-Replace ``-3*PI/2+y`` with ``y-3*(PI/2)``.
-Apply (sin_increasing_0 ``x-3*(PI/2)`` ``y-3*(PI/2)`` H4 H3 H2 H1 H5).
-Unfold Rminus.
-Rewrite Ropp_mul1. 
-Apply Rplus_sym. 
-Unfold Rminus.
-Rewrite Ropp_mul1. 
-Apply Rplus_sym. 
-Pattern 3 PI; Rewrite double_var.
-Ring.
-Rewrite double; Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Unfold Rminus.
-Rewrite Ropp_mul1. 
-Apply Rplus_sym. 
-Unfold Rminus.
-Rewrite Ropp_mul1. 
-Apply Rplus_sym. 
-Rewrite Rmult_1r.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Rewrite Rmult_1r.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Qed.
-
-Lemma cos_increasing_1 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``x<y`` -> ``(cos x)<(cos y)``.
-Intros x y H1 H2 H3 H4 H5; Generalize (Rle_compatibility ``-3*(PI/2)`` PI x H1); Generalize (Rle_compatibility ``-3*(PI/2)`` x ``2*PI`` H2); Generalize (Rle_compatibility ``-3*(PI/2)`` PI y H3); Generalize (Rle_compatibility ``-3*(PI/2)`` y ``2*PI`` H4); Generalize (Rlt_compatibility ``-3*(PI/2)`` x y H5); Rewrite <- (cos_neg x); Rewrite <- (cos_neg y); Rewrite <- (cos_period ``-x`` (1)); Rewrite <- (cos_period ``-y`` (1)); Unfold INR; Replace ``-3*(PI/2)+x`` with ``x-3*(PI/2)``.
-Replace ``-3*(PI/2)+y`` with ``y-3*(PI/2)``.
-Replace ``-3*(PI/2)+PI`` with ``-(PI/2)``.
-Replace ``-3*(PI/2)+2*PI`` with ``PI/2``.
-Clear H1 H2 H3 H4 H5; Intros H1 H2 H3 H4 H5; Replace ``-x+2*1*PI`` with ``(PI/2)-(x-3*(PI/2))``.
-Replace ``-y+2*1*PI`` with ``(PI/2)-(y-3*(PI/2))``.
-Repeat Rewrite cos_shift; Apply (sin_increasing_1 ``x-3*(PI/2)`` ``y-3*(PI/2)`` H5 H4 H3 H2 H1).
-Rewrite Rmult_1r.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Rewrite Rmult_1r.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
-Ring.
-Pattern 3 PI; Rewrite double_var; Ring.
-Unfold Rminus.
-Rewrite <- Ropp_mul1.
-Apply Rplus_sym.
-Unfold Rminus.
-Rewrite <- Ropp_mul1.
-Apply Rplus_sym.
-Qed.
-
-Lemma cos_decreasing_0 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``(cos x)<(cos y)``->``y<x``.
-Intros; Generalize (Rlt_Ropp (cos x) (cos y) H3); Repeat Rewrite <- neg_cos; Intro H4; Change ``(cos (y+PI))<(cos (x+PI))`` in H4; Rewrite (Rplus_sym x) in H4; Rewrite (Rplus_sym y) in H4; Generalize (Rle_compatibility PI ``0`` x H); Generalize (Rle_compatibility PI x PI H0); Generalize (Rle_compatibility PI ``0`` y H1); Generalize (Rle_compatibility PI y PI H2); Rewrite Rplus_Or.
-Rewrite <- double.
-Clear H H0 H1 H2 H3; Intros; Apply Rlt_anti_compatibility with ``PI``; Apply (cos_increasing_0 ``PI+y`` ``PI+x`` H0 H H2 H1 H4).
-Qed.
-
-Lemma cos_decreasing_1 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``x<y``->``(cos y)<(cos x)``.
-Intros; Apply Ropp_Rlt; Repeat Rewrite <- neg_cos; Rewrite (Rplus_sym x); Rewrite (Rplus_sym y); Generalize (Rle_compatibility PI ``0`` x H); Generalize (Rle_compatibility PI x PI H0); Generalize (Rle_compatibility PI ``0`` y H1); Generalize (Rle_compatibility PI y PI H2); Rewrite Rplus_Or.
-Rewrite <- double.
-Generalize (Rlt_compatibility PI x y H3); Clear H H0 H1 H2 H3; Intros; Apply (cos_increasing_1 ``PI+x`` ``PI+y`` H3 H2 H1 H0 H).
-Qed.
-
-Lemma tan_diff : (x,y:R) ~``(cos x)==0``->~``(cos y)==0``->``(tan x)-(tan y)==(sin (x-y))/((cos x)*(cos y))``.
-Intros; Unfold tan;Rewrite sin_minus.
-Unfold Rdiv. 
-Unfold Rminus.
-Rewrite Rmult_Rplus_distrl.
-Rewrite Rinv_Rmult.
-Repeat Rewrite (Rmult_sym (sin x)).
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (cos y)).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Rewrite (Rmult_sym (sin x)).
-Apply Rplus_plus_r.
-Rewrite <- Ropp_mul1.
-Rewrite <- Ropp_mul3.
-Rewrite (Rmult_sym ``/(cos x)``).
-Repeat Rewrite Rmult_assoc.
-Rewrite (Rmult_sym (cos x)).
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Reflexivity.
-Assumption.
-Assumption.
-Assumption.
-Assumption.
-Qed.
-
-Lemma tan_increasing_0 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``(tan x)<(tan y)``->``x<y``.
-Intros; Generalize PI4_RLT_PI2; Intro H4; Generalize (Rlt_Ropp ``PI/4`` ``PI/2`` H4); Intro H5; Change ``-(PI/2)< -(PI/4)`` in H5; Generalize (cos_gt_0 x (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` x H5 H) (Rle_lt_trans x ``PI/4`` ``PI/2`` H0 H4)); Intro HP1; Generalize (cos_gt_0 y (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` y H5 H1) (Rle_lt_trans y ``PI/4`` ``PI/2`` H2 H4)); Intro HP2; Generalize (not_sym ``0`` (cos x) (Rlt_not_eq ``0`` (cos x) (cos_gt_0 x (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` x H5 H) (Rle_lt_trans x ``PI/4`` ``PI/2`` H0 H4)))); Intro H6; Generalize (not_sym ``0`` (cos y) (Rlt_not_eq ``0`` (cos y) (cos_gt_0 y (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` y H5 H1) (Rle_lt_trans y ``PI/4`` ``PI/2`` H2 H4)))); Intro H7; Generalize (tan_diff x y H6 H7); Intro H8; Generalize (Rlt_minus (tan x) (tan y) H3); Clear H3; Intro H3; Rewrite H8 in H3; Cut ``(sin (x-y))<0``.
-Intro H9; Generalize (Rle_Ropp ``-(PI/4)`` y H1); Rewrite Ropp_Ropp; Intro H10; Generalize (Rle_sym2 ``-y`` ``PI/4`` H10); Clear H10; Intro H10; Generalize (Rle_Ropp y ``PI/4`` H2); Intro H11; Generalize (Rle_sym2 ``-(PI/4)`` ``-y`` H11); Clear H11; Intro H11; Generalize (Rplus_le ``-(PI/4)`` x ``-(PI/4)`` ``-y`` H H11); Generalize (Rplus_le x ``PI/4`` ``-y`` ``PI/4`` H0 H10); Replace ``x+ -y`` with ``x-y``.
-Replace ``PI/4+PI/4`` with ``PI/2``.
-Replace ``-(PI/4)+ -(PI/4)`` with ``-(PI/2)``.
-Intros; Case (total_order ``0`` ``x-y``); Intro H14.
-Generalize (sin_gt_0 ``x-y`` H14 (Rle_lt_trans ``x-y`` ``PI/2`` PI H12 PI2_Rlt_PI)); Intro H15; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(sin (x-y))`` ``0`` H15 H9)).
-Elim H14; Intro H15.
-Rewrite <- H15 in H9; Rewrite -> sin_0 in H9;  Elim (Rlt_antirefl ``0`` H9). 
-Apply Rminus_lt; Assumption.
-Pattern 1 PI; Rewrite double_var.
-Unfold Rdiv.
-Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Rewrite Ropp_distr1.
-Replace ``2*2`` with ``4``.
-Reflexivity.
-Ring.
-DiscrR.
-DiscrR.
-Pattern 1 PI; Rewrite double_var.
-Unfold Rdiv.
-Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Replace ``2*2`` with ``4``.
-Reflexivity.
-Ring.
-DiscrR.
-DiscrR.
-Reflexivity.
-Case (case_Rabsolu ``(sin (x-y))``); Intro H9.
-Assumption.
-Generalize (Rle_sym2 ``0`` ``(sin (x-y))`` H9); Clear H9; Intro H9; Generalize (Rlt_Rinv (cos x) HP1); Intro H10; Generalize (Rlt_Rinv (cos y) HP2); Intro H11; Generalize (Rmult_lt_pos (Rinv (cos x)) (Rinv (cos y)) H10 H11); Replace ``/(cos x)*/(cos y)`` with ``/((cos x)*(cos y))``.
-Intro H12; Generalize (Rmult_le_pos ``(sin (x-y))`` ``/((cos x)*(cos y))`` H9 (Rlt_le ``0`` ``/((cos x)*(cos y))`` H12)); Intro H13; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``(sin (x-y))*/((cos x)*(cos y))`` ``0`` H13 H3)).
-Rewrite Rinv_Rmult.
-Reflexivity. 
-Assumption.
-Assumption.
-Qed.
-
-Lemma tan_increasing_1 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``x<y``->``(tan x)<(tan y)``.
-Intros; Apply Rminus_lt; Generalize PI4_RLT_PI2; Intro H4; Generalize (Rlt_Ropp ``PI/4`` ``PI/2`` H4); Intro H5; Change ``-(PI/2)< -(PI/4)`` in H5; Generalize (cos_gt_0 x (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` x H5 H) (Rle_lt_trans x ``PI/4`` ``PI/2`` H0 H4)); Intro HP1; Generalize (cos_gt_0 y (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` y H5 H1) (Rle_lt_trans y ``PI/4`` ``PI/2`` H2 H4)); Intro HP2; Generalize (not_sym ``0`` (cos x) (Rlt_not_eq ``0`` (cos x) (cos_gt_0 x (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` x H5 H) (Rle_lt_trans x ``PI/4`` ``PI/2`` H0 H4)))); Intro H6; Generalize (not_sym ``0`` (cos y) (Rlt_not_eq ``0`` (cos y) (cos_gt_0 y (Rlt_le_trans ``-(PI/2)`` ``-(PI/4)`` y H5 H1) (Rle_lt_trans y ``PI/4`` ``PI/2`` H2 H4)))); Intro H7; Rewrite (tan_diff x y H6 H7); Generalize (Rlt_Rinv (cos x) HP1); Intro H10; Generalize (Rlt_Rinv (cos y) HP2); Intro H11; Generalize (Rmult_lt_pos (Rinv (cos x)) (Rinv (cos y)) H10 H11); Replace ``/(cos x)*/(cos y)`` with ``/((cos x)*(cos y))``.
-Clear H10 H11; Intro H8; Generalize (Rle_Ropp y ``PI/4`` H2); Intro H11; Generalize (Rle_sym2 ``-(PI/4)`` ``-y`` H11); Clear H11; Intro H11; Generalize (Rplus_le ``-(PI/4)`` x ``-(PI/4)`` ``-y`` H H11); Replace ``x+ -y`` with ``x-y``.
-Replace ``-(PI/4)+ -(PI/4)`` with ``-(PI/2)``.
-Clear H11; Intro H9; Generalize (Rlt_minus x y H3); Clear H3; Intro H3; Clear H H0 H1 H2 H4 H5 HP1 HP2; Generalize PI2_Rlt_PI; Intro H1; Generalize (Rlt_Ropp ``PI/2`` PI H1); Clear H1; Intro H1; Generalize (sin_lt_0_var ``x-y`` (Rlt_le_trans ``-PI`` ``-(PI/2)`` ``x-y`` H1 H9) H3); Intro H2; Generalize (Rlt_anti_monotony ``(sin (x-y))`` ``0`` ``/((cos x)*(cos y))`` H2 H8); Rewrite Rmult_Or; Intro H4; Assumption.
-Pattern 1 PI; Rewrite double_var.
-Unfold Rdiv.
-Rewrite Rmult_Rplus_distrl.
-Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_Rmult.
-Replace ``2*2`` with ``4``.
-Rewrite Ropp_distr1.
-Reflexivity.
-Ring.
-DiscrR.
-DiscrR.
-Reflexivity.
-Apply Rinv_Rmult; Assumption.
-Qed.
-
-Lemma sin_incr_0 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``(sin x)<=(sin y)``->``x<=y``.
-Intros; Case (total_order (sin x) (sin y)); Intro H4; [Left; Apply (sin_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (sin_increasing_1 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (sin y) H8)]] | Elim (Rlt_antirefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5))]].
-Qed.
-
-Lemma sin_incr_1 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``x<=y``->``(sin x)<=(sin y)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (sin_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (sin x) (sin y)); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (sin_increasing_0 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-Lemma sin_decr_0 : (x,y:R) ``x<=3*(PI/2)``->``PI/2<=x``->``y<=3*(PI/2)``->``PI/2<=y``-> ``(sin x)<=(sin y)`` -> ``y<=x``.
-Intros; Case (total_order (sin x) (sin y)); Intro H4; [Left; Apply (sin_decreasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Generalize (sin_decreasing_1 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (sin y) H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5))]].
-Qed.
-
-Lemma sin_decr_1 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``x<=y``  -> ``(sin y)<=(sin x)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (sin_decreasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (sin x) (sin y)); Intro H6; [Generalize (sin_decreasing_0 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-Lemma cos_incr_0 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``(cos x)<=(cos y)`` -> ``x<=y``.
-Intros; Case (total_order (cos x) (cos y)); Intro H4; [Left; Apply (cos_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (cos_increasing_1 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (cos y) H8)]] | Elim (Rlt_antirefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5))]].
-Qed.
-
-Lemma cos_incr_1 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``x<=y`` -> ``(cos x)<=(cos y)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (cos_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (cos x) (cos y)); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (cos_increasing_0 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-Lemma cos_decr_0 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``(cos x)<=(cos y)`` -> ``y<=x``.
-Intros; Case (total_order (cos x) (cos y)); Intro H4; [Left; Apply (cos_decreasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Generalize (cos_decreasing_1 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (cos y) H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5))]].
-Qed.
-
-Lemma cos_decr_1 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``x<=y``->``(cos y)<=(cos x)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (cos_decreasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (cos x) (cos y)); Intro H6; [Generalize (cos_decreasing_0 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-Lemma tan_incr_0 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``(tan x)<=(tan y)``->``x<=y``.
-Intros; Case (total_order (tan x) (tan y)); Intro H4; [Left; Apply (tan_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (tan_increasing_1 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (tan y) H8)]] | Elim (Rlt_antirefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5))]].
-Qed.
-
-Lemma tan_incr_1 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``x<=y``->``(tan x)<=(tan y)``.
-Intros; Case (total_order x y); Intro H4; [Left; Apply (tan_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order (tan x) (tan y)); Intro H6; [Left; Assumption | Elim H6; Intro H7; [Right; Assumption | Generalize (tan_increasing_0 y x H1 H2 H H0 H7); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
-Qed.
-
-(**********)
-Lemma sin_eq_0_1 : (x:R) (EXT k:Z | x==(Rmult (IZR k) PI)) -> (sin x)==R0.
-Intros.
-Elim H; Intros.
-Apply (Zcase_sign x0).
-Intro.
-Rewrite H1 in H0.
-Simpl in H0.
-Rewrite H0; Rewrite Rmult_Ol; Apply sin_0.
-Intro.
-Cut `0<=x0`.
-Intro.
-Elim (IZN x0 H2); Intros.
-Rewrite H3 in H0.
-Rewrite <- INR_IZR_INZ in H0.
-Rewrite H0.
-Elim (even_odd_cor x1); Intros.
-Elim H4; Intro.
-Rewrite H5.
-Rewrite mult_INR.
-Simpl.
-Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
-Rewrite sin_period.
-Apply sin_0.
-Rewrite H5.
-Rewrite S_INR; Rewrite mult_INR.
-Simpl.
-Rewrite Rmult_Rplus_distrl.
-Rewrite Rmult_1l; Rewrite sin_plus.
-Rewrite sin_PI.
-Rewrite Rmult_Or.
-Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
-Rewrite sin_period.
-Rewrite sin_0; Ring.
-Apply le_IZR.
-Left; Apply IZR_lt.
-Assert H2 := Zgt_iff_lt.
-Elim (H2 x0 `0`); Intros.
-Apply H3; Assumption.
-Intro.
-Rewrite H0.
-Replace ``(sin ((IZR x0)*PI))`` with ``-(sin (-(IZR x0)*PI))``.
-Cut `0<=-x0`.
-Intro.
-Rewrite <- Ropp_Ropp_IZR.
-Elim (IZN `-x0` H2); Intros.
-Rewrite H3.
-Rewrite <- INR_IZR_INZ.
-Elim (even_odd_cor x1); Intros.
-Elim H4; Intro.
-Rewrite H5.
-Rewrite mult_INR.
-Simpl.
-Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
-Rewrite sin_period.
-Rewrite sin_0; Ring.
-Rewrite H5.
-Rewrite S_INR; Rewrite mult_INR.
-Simpl.
-Rewrite Rmult_Rplus_distrl.
-Rewrite Rmult_1l; Rewrite sin_plus.
-Rewrite sin_PI.
-Rewrite Rmult_Or.
-Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
-Rewrite sin_period.
-Rewrite sin_0; Ring.
-Apply le_IZR.
-Apply Rle_anti_compatibility with ``(IZR x0)``.
-Rewrite Rplus_Or.
-Rewrite Ropp_Ropp_IZR.
-Rewrite Rplus_Ropp_r.
-Left; Replace R0 with (IZR `0`); [Apply IZR_lt | Reflexivity].
-Assumption.
-Rewrite <- sin_neg.
-Rewrite Ropp_mul1.
-Rewrite Ropp_Ropp.
-Reflexivity.
-Qed.
-
-Lemma sin_eq_0_0 : (x:R) (sin x)==R0 -> (EXT k:Z | x==(Rmult (IZR k) PI)).
-Intros.
-Assert H0 := (euclidian_division x PI PI_neq0).
-Elim H0; Intros q H1.
-Elim H1; Intros r H2.
-Exists q.
-Cut r==R0.
-Intro.
-Elim H2; Intros H4 _; Rewrite H4; Rewrite H3.
-Apply Rplus_Or.
-Elim H2; Intros.
-Rewrite H3 in H.
-Rewrite sin_plus in H.
-Cut ``(sin ((IZR q)*PI))==0``.
-Intro.
-Rewrite H5 in H.
-Rewrite Rmult_Ol in H.
-Rewrite Rplus_Ol in H.
-Assert H6 := (without_div_Od ? ? H).
-Elim H6; Intro.
-Assert H8 := (sin2_cos2 ``(IZR q)*PI``).
-Rewrite H5 in H8; Rewrite H7 in H8.
-Rewrite Rsqr_O in H8.
-Rewrite Rplus_Or in H8.
-Elim R1_neq_R0; Symmetry; Assumption.
-Cut r==R0\/``0<r<PI``.
-Intro; Elim H8; Intro.
-Assumption.
-Elim H9; Intros.
-Assert H12 := (sin_gt_0 ? H10 H11).
-Rewrite H7 in H12; Elim (Rlt_antirefl ? H12).
-Rewrite Rabsolu_right in H4.
-Elim H4; Intros.
-Case (total_order R0 r); Intro.
-Right; Split; Assumption.
-Elim H10; Intro.
-Left; Symmetry; Assumption.
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H8 H11)).
-Apply Rle_sym1.
-Left; Apply PI_RGT_0.
-Apply sin_eq_0_1.
-Exists q; Reflexivity.
-Qed.
-
-Lemma cos_eq_0_0 : (x:R) (cos x)==R0 -> (EXT k : Z | ``x==(IZR k)*PI+PI/2``). 
-Intros x H; Rewrite -> cos_sin in H; Generalize (sin_eq_0_0 (Rplus (Rdiv PI (INR (2))) x) H); Intro H2; Elim H2; Intros x0 H3; Exists (Zminus x0 (inject_nat (S O))); Rewrite <- Z_R_minus; Ring; Rewrite Rmult_sym; Rewrite <- H3; Unfold INR.
-Rewrite (double_var ``-PI``); Unfold Rdiv; Ring.
-Qed.
-
-Lemma  cos_eq_0_1 : (x:R) (EXT k : Z | ``x==(IZR k)*PI+PI/2``) -> ``(cos x)==0``.
-Intros x H1; Rewrite cos_sin; Elim H1; Intros x0 H2; Rewrite H2; Replace ``PI/2+((IZR x0)*PI+PI/2)`` with ``(IZR x0)*PI+PI``.
-Rewrite neg_sin; Rewrite <- Ropp_O.
-Apply eq_Ropp; Apply sin_eq_0_1; Exists x0; Reflexivity.
-Pattern 2 PI; Rewrite (double_var PI); Ring.
-Qed.
-
-Lemma sin_eq_O_2PI_0 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``(sin x)==0`` -> ``x==0``\/``x==PI``\/``x==2*PI``.
-Intros; Generalize (sin_eq_0_0 x H1); Intro.
-Elim H2; Intros k0 H3.
-Case (total_order PI x); Intro.
-Rewrite H3 in H4; Rewrite H3 in H0.
-Right; Right.
-Generalize (Rlt_monotony_r ``/PI`` ``PI`` ``(IZR k0)*PI`` (Rlt_Rinv ``PI`` PI_RGT_0) H4); Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Intro; Generalize (Rle_monotony_r ``/PI`` ``(IZR k0)*PI`` ``2*PI`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv ``PI`` PI_RGT_0)) H0); Repeat Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
-Repeat Rewrite Rmult_1r; Intro; Generalize (Rlt_compatibility (IZR `-2`) ``1`` (IZR k0) H5); Rewrite <- plus_IZR.
-Replace ``(IZR (NEG (xO xH)))+1`` with ``-1``.
-Intro; Generalize (Rle_compatibility (IZR `-2`) (IZR k0) ``2`` H6); Rewrite <- plus_IZR.
-Replace ``(IZR (NEG (xO xH)))+2`` with ``0``.
-Intro; Cut ``-1 < (IZR (Zplus (NEG (xO xH)) k0)) < 1``.
-Intro; Generalize (one_IZR_lt1 (Zplus (NEG (xO xH)) k0) H9); Intro.
-Cut k0=`2`.
-Intro; Rewrite H11 in H3; Rewrite H3; Simpl.
-Reflexivity.
-Rewrite <- (Zplus_inverse_l `2`) in H10; Generalize (Zsimpl_plus_l `-2` k0 `2` H10); Intro; Assumption.
-Split.
-Assumption.
-Apply Rle_lt_trans with ``0``.
-Assumption.
-Apply Rlt_R0_R1.
-Simpl; Ring.
-Simpl; Ring.
-Apply PI_neq0.
-Apply PI_neq0.
-Elim H4; Intro.
-Right; Left.
-Symmetry; Assumption.
-Left.
-Rewrite H3 in H5; Rewrite H3 in H; Generalize (Rlt_monotony_r ``/PI``  ``(IZR k0)*PI`` PI (Rlt_Rinv ``PI`` PI_RGT_0) H5); Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Intro; Generalize (Rle_monotony_r ``/PI`` ``0`` ``(IZR k0)*PI`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv ``PI`` PI_RGT_0)) H); Repeat Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Rewrite Rmult_Ol; Intro.
-Cut ``-1 < (IZR (k0)) < 1``.
-Intro; Generalize (one_IZR_lt1 k0 H8); Intro; Rewrite H9 in H3; Rewrite H3; Simpl; Apply Rmult_Ol.
-Split.
-Apply Rlt_le_trans with ``0``.
-Rewrite <- Ropp_O; Apply Rgt_Ropp; Apply Rlt_R0_R1.
-Assumption.
-Assumption.
-Apply PI_neq0.
-Apply PI_neq0.
-Qed.
-
-Lemma sin_eq_O_2PI_1 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``x==0``\/``x==PI``\/``x==2*PI`` -> ``(sin x)==0``.
-Intros x H1 H2 H3; Elim H3; Intro H4; [ Rewrite H4; Rewrite -> sin_0; Reflexivity | Elim H4; Intro H5; [Rewrite H5; Rewrite -> sin_PI; Reflexivity | Rewrite H5; Rewrite -> sin_2PI; Reflexivity]].
-Qed.
-
-Lemma cos_eq_0_2PI_0 : (x:R) ``R0<=x`` -> ``x<=2*PI`` -> ``(cos x)==0`` -> ``x==(PI/2)``\/``x==3*(PI/2)``.
-Intros; Case (total_order x ``3*(PI/2)``); Intro.
-Rewrite cos_sin in H1.
-Cut ``0<=PI/2+x``.
-Cut ``PI/2+x<=2*PI``.
-Intros; Generalize (sin_eq_O_2PI_0 ``PI/2+x`` H4 H3 H1); Intros.
-Decompose [or] H5.
-Generalize (Rle_compatibility ``PI/2`` ``0`` x H); Rewrite Rplus_Or; Rewrite H6; Intro.
-Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``PI/2`` ``0`` PI2_RGT_0 H7)).
-Left.
-Generalize (Rplus_plus_r ``-(PI/2)`` ``PI/2+x`` PI H7).
-Replace ``-(PI/2)+(PI/2+x)`` with x.
-Replace ``-(PI/2)+PI`` with ``PI/2``.
-Intro; Assumption.
-Pattern 3 PI; Rewrite (double_var PI); Ring.
-Ring.
-Right.
-Generalize (Rplus_plus_r ``-(PI/2)`` ``PI/2+x`` ``2*PI`` H7).
-Replace ``-(PI/2)+(PI/2+x)`` with x.
-Replace ``-(PI/2)+2*PI`` with ``3*(PI/2)``.
-Intro; Assumption.
-Rewrite double; Pattern 3 4 PI; Rewrite (double_var PI); Ring.
-Ring.
-Left; Replace ``2*PI`` with ``PI/2+3*(PI/2)``.
-Apply Rlt_compatibility; Assumption.
-Rewrite (double PI); Pattern 3 4 PI; Rewrite (double_var PI); Ring.
-Apply ge0_plus_ge0_is_ge0.
-Left; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply PI_RGT_0.
-Apply Rlt_Rinv; Sup0. 
-Assumption.
-Elim H2; Intro.
-Right; Assumption.
-Generalize (cos_eq_0_0 x H1); Intro; Elim H4; Intros k0 H5.
-Rewrite H5 in H3; Rewrite H5 in H0; Generalize (Rlt_compatibility ``-(PI/2)`` ``3*PI/2`` ``(IZR k0)*PI+PI/2`` H3); Generalize (Rle_compatibility ``-(PI/2)`` ``(IZR k0)*PI+PI/2`` ``2*PI`` H0).
-Replace ``-(PI/2)+3*PI/2`` with PI.
-Replace ``-(PI/2)+((IZR k0)*PI+PI/2)`` with ``(IZR k0)*PI``.
-Replace ``-(PI/2)+2*PI`` with ``3*(PI/2)``.
-Intros; Generalize (Rlt_monotony ``/PI`` ``PI`` ``(IZR k0)*PI`` (Rlt_Rinv PI PI_RGT_0) H7); Generalize (Rle_monotony ``/PI`` ``(IZR k0)*PI`` ``3*(PI/2)`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv PI PI_RGT_0)) H6).
-Replace ``/PI*((IZR k0)*PI)`` with (IZR k0).
-Replace ``/PI*(3*PI/2)`` with ``3*/2``.
-Rewrite <- Rinv_l_sym.
-Intros; Generalize (Rlt_compatibility (IZR `-2`) ``1`` (IZR k0) H9); Rewrite <- plus_IZR.
-Replace ``(IZR (NEG (xO xH)))+1`` with ``-1``.
-Intro; Generalize (Rle_compatibility (IZR `-2`) (IZR k0) ``3*/2`` H8); Rewrite <- plus_IZR.
-Replace ``(IZR (NEG (xO xH)))+2`` with ``0``.
-Intro; Cut `` -1 < (IZR (Zplus (NEG (xO xH)) k0)) < 1``.
-Intro; Generalize (one_IZR_lt1 (Zplus (NEG (xO xH)) k0) H12); Intro.
-Cut k0=`2`.
-Intro; Rewrite H14 in H8.
-Assert Hyp : ``0<2``.
-Sup0.
-Generalize (Rle_monotony ``2`` ``(IZR (POS (xO xH)))`` ``3*/2`` (Rlt_le ``0`` ``2`` Hyp) H8); Simpl.
-Replace ``2*2`` with ``4``.
-Replace ``2*(3*/2)`` with ``3``.
-Intro; Cut ``3<4``.
-Intro; Elim (Rlt_antirefl ``3`` (Rlt_le_trans ``3`` ``4`` ``3`` H16 H15)).
-Generalize (Rlt_compatibility ``3`` ``0`` ``1`` Rlt_R0_R1); Rewrite Rplus_Or.
-Replace ``3+1`` with ``4``.
-Intro; Assumption.
-Ring.
-Symmetry; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
-DiscrR.
-Ring.
-Rewrite <- (Zplus_inverse_l `2`) in H13; Generalize (Zsimpl_plus_l `-2` k0 `2` H13); Intro; Assumption.
-Split.
-Assumption.
-Apply Rle_lt_trans with ``(IZR (NEG (xO xH)))+3*/2``.
-Assumption.
-Simpl; Replace ``-2+3*/2`` with ``-(1*/2)``.
-Apply Rlt_trans with ``0``.
-Rewrite <- Ropp_O; Apply Rlt_Ropp.
-Apply Rmult_lt_pos; [Apply Rlt_R0_R1 | Apply Rlt_Rinv; Sup0].
-Apply Rlt_R0_R1.
-Rewrite Rmult_1l; Apply r_Rmult_mult with ``2``.
-Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_Rplus_distr; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
-Ring.
-DiscrR.
-DiscrR.
-DiscrR.
-Simpl; Ring.
-Simpl; Ring.
-Apply PI_neq0.
-Unfold Rdiv; Pattern 1 ``3``; Rewrite (Rmult_sym ``3``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Apply Rmult_sym.
-Apply PI_neq0.
-Symmetry; Rewrite (Rmult_sym ``/PI``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Apply Rmult_1r.
-Apply PI_neq0.
-Rewrite double; Pattern 3 4 PI; Rewrite double_var; Ring.
-Ring.
-Pattern 1 PI; Rewrite double_var; Ring.
-Qed.
-
-Lemma  cos_eq_0_2PI_1 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``x==PI/2``\/``x==3*(PI/2)`` -> ``(cos x)==0``.
-Intros x H1 H2 H3; Elim H3; Intro H4; [ Rewrite H4; Rewrite -> cos_PI2; Reflexivity | Rewrite H4; Rewrite -> cos_3PI2; Reflexivity ].
-Qed.
diff --git a/theories7/Reals/Rtrigo_alt.v b/theories7/Reals/Rtrigo_alt.v
deleted file mode 100644
index db0e2fea..00000000
--- a/theories7/Reals/Rtrigo_alt.v
+++ /dev/null
@@ -1,294 +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: Rtrigo_alt.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo_def.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(*****************************************************************)
-(* Using series definitions of cos and sin                       *)
-(*****************************************************************)
-
-Definition sin_term [a:R] : nat->R := [i:nat] ``(pow (-1) i)*(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))``.
-
-Definition cos_term [a:R] : nat->R := [i:nat] ``(pow (-1) i)*(pow a (mult (S (S O)) i))/(INR (fact (mult (S (S O)) i)))``.
-
-Definition sin_approx [a:R;n:nat] : R := (sum_f_R0 (sin_term a) n).
-
-Definition cos_approx [a:R;n:nat] : R := (sum_f_R0 (cos_term a) n).
-
-(**********)
-Lemma PI_4 : ``PI<=4``.
-Assert H0 := (PI_ineq O).
-Elim H0; Clear H0; Intros _ H0.
-Unfold tg_alt PI_tg in H0; Simpl in H0.
-Rewrite Rinv_R1 in H0; Rewrite Rmult_1r in H0; Unfold Rdiv in H0.
-Apply Rle_monotony_contra with ``/4``.
-Apply Rlt_Rinv; Sup0.
-Rewrite <- Rinv_l_sym; [Rewrite Rmult_sym; Assumption | DiscrR].
-Qed.
-
-(**********)
-Theorem sin_bound : (a:R; n:nat) ``0 <= a``->``a <= PI``->``(sin_approx a (plus (mult (S (S O)) n) (S O))) <= (sin a)<= (sin_approx a (mult (S (S O)) (plus n (S O))))``.
-Intros; Case (Req_EM a R0); Intro Hyp_a.
-Rewrite Hyp_a; Rewrite sin_0; Split; Right; Unfold sin_approx; Apply sum_eq_R0 Orelse (Symmetry; Apply sum_eq_R0); Intros; Unfold sin_term; Rewrite pow_add; Simpl; Unfold Rdiv; Rewrite Rmult_Ol; Ring.
-Unfold sin_approx; Cut ``0<a``.
-Intro Hyp_a_pos.
-Rewrite (decomp_sum (sin_term a) (plus (mult (S (S O)) n) (S O))).
-Rewrite (decomp_sum (sin_term a) (mult (S (S O)) (plus n (S O)))).
-Replace (sin_term a O) with a.
-Cut (Rle (sum_f_R0 [i:nat](sin_term a (S i)) (pred (plus (mult (S (S O)) n) (S O)))) ``(sin a)-a``)/\(Rle ``(sin a)-a`` (sum_f_R0 [i:nat](sin_term a (S i)) (pred (mult (S (S O)) (plus n (S O)))))) -> (Rle (Rplus a (sum_f_R0 [i:nat](sin_term a (S i)) (pred (plus (mult (S (S O)) n) (S O))))) (sin a))/\(Rle (sin a) (Rplus a (sum_f_R0 [i:nat](sin_term a (S i)) (pred (mult (S (S O)) (plus n (S O))))))).
-Intro; Apply H1.
-Pose Un := [n:nat]``(pow a (plus (mult (S (S O)) (S n)) (S O)))/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))``.
-Replace (pred (plus (mult (S (S O)) n) (S O))) with (mult (S (S O)) n).
-Replace (pred (mult (S (S O)) (plus n (S O)))) with (S (mult (S (S O)) n)).
-Replace (sum_f_R0 [i:nat](sin_term a (S i)) (mult (S (S O)) n)) with ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``.
-Replace (sum_f_R0 [i:nat](sin_term a (S i)) (S (mult (S (S O)) n))) with ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``.
-Cut ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))<=a-(sin a)<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``->`` -(sum_f_R0 (tg_alt Un) (mult (S (S O)) n)) <= (sin a)-a <=  -(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``.
-Intro; Apply H2.
-Apply alternated_series_ineq.
-Unfold Un_decreasing Un; Intro; Cut (plus (mult (S (S O)) (S (S n0))) (S O))=(S (S (plus (mult (S (S O)) (S n0)) (S O)))).
-Intro; Rewrite H3.
-Replace ``(pow a (S (S (plus (mult (S (S O)) (S n0)) (S O)))))`` with ``(pow a (plus (mult (S (S O)) (S n0)) (S O)))*(a*a)``.
-Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply pow_lt; Assumption.
-Apply Rle_monotony_contra with ``(INR (fact (S (S (plus (mult (S (S O)) (S n0)) (S O))))))``.
-Rewrite <- H3; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H5 := (sym_eq ? ? ? H4); Elim (fact_neq_0 ? H5).
-Rewrite <- H3; Rewrite (Rmult_sym ``(INR (fact (plus (mult (S (S O)) (S (S n0))) (S O))))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite H3; Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Simpl; Replace ``((0+1+1)*((INR n0)+1)+(0+1)+1+1)*((0+1+1)*((INR n0)+1)+(0+1)+1)`` with ``4*(INR n0)*(INR n0)+18*(INR n0)+20``; [Idtac | Ring].
-Apply Rle_trans with ``20``.
-Apply Rle_trans with ``16``.
-Replace ``16`` with ``(Rsqr 4)``; [Idtac | SqRing].
-Replace ``a*a`` with (Rsqr a); [Idtac | Reflexivity].
-Apply Rsqr_incr_1.
-Apply Rle_trans with PI; [Assumption | Apply PI_4].
-Assumption.
-Left; Sup0.
-Rewrite <- (Rplus_Or ``16``); Replace ``20`` with ``16+4``; [Apply Rle_compatibility; Left; Sup0 | Ring].
-Rewrite <- (Rplus_sym ``20``); Pattern 1 ``20``; Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Apply ge0_plus_ge0_is_ge0.
-Repeat Apply Rmult_le_pos.
-Left; Sup0.
-Left; Sup0.
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Apply Rmult_le_pos.
-Left; Sup0.
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Assert H3 := (cv_speed_pow_fact a); Unfold Un; Unfold Un_cv in H3; Unfold R_dist in H3; Unfold Un_cv; Unfold R_dist; Intros; Elim (H3 eps H4); Intros N H5.
-Exists N; Intros; Apply H5.
-Replace (plus (mult (2) (S n0)) (1)) with (S (mult (2) (S n0))).
-Unfold ge; Apply le_trans with (mult (2) (S n0)).
-Apply le_trans with (mult (2) (S N)).
-Apply le_trans with (mult (2) N).
-Apply le_n_2n.
-Apply mult_le; Apply le_n_Sn.
-Apply mult_le; Apply le_n_S; Assumption.
-Apply le_n_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Reflexivity.
-Assert X := (exist_sin (Rsqr a)); Elim X; Intros.
-Cut ``x==(sin a)/a``.
-Intro; Rewrite H3 in p; Unfold sin_in in p; Unfold infinit_sum in p; Unfold R_dist in p; Unfold Un_cv; Unfold R_dist; Intros.
-Cut ``0<eps/(Rabsolu a)``.
-Intro; Elim (p ? H5); Intros N H6.
-Exists N; Intros.
-Replace (sum_f_R0 (tg_alt Un) n0) with (Rmult a (Rminus R1 (sum_f_R0 [i:nat]``(sin_n i)*(pow (Rsqr a) i)`` (S n0)))).
-Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Repeat Rewrite Rplus_assoc; Rewrite (Rplus_sym a); Rewrite (Rplus_sym ``-a``); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rlt_monotony_contra with ``/(Rabsolu a)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Pattern 1 ``/(Rabsolu a)``; Rewrite <- (Rabsolu_Rinv a  Hyp_a).
-Rewrite <- Rabsolu_mult; Rewrite Rmult_Rplus_distr; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1l | Assumption]; Rewrite (Rmult_sym ``/a``); Rewrite (Rmult_sym ``/(Rabsolu a)``); Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Unfold Rminus Rdiv in H6; Apply H6; Unfold ge; Apply le_trans with n0; [Exact H7 | Apply le_n_Sn].
-Rewrite (decomp_sum [i:nat]``(sin_n i)*(pow (Rsqr a) i)`` (S n0)).
-Replace (sin_n O) with R1.
-Simpl; Rewrite Rmult_1r; Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Rewrite Ropp_mul3; Rewrite <- Ropp_mul1; Rewrite scal_sum; Apply sum_eq.
-Intros; Unfold sin_n Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-(pow (-1) i)``.
-Replace ``(pow a (plus (mult (S (S O)) (S i)) (S O)))`` with ``(Rsqr a)*(pow (Rsqr a) i)*a``.
-Unfold Rdiv; Ring.
-Rewrite pow_add; Rewrite pow_Rsqr; Simpl; Ring.
-Simpl; Ring.
-Unfold sin_n; Unfold Rdiv; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
-Apply lt_O_Sn.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
-Unfold sin; Case (exist_sin (Rsqr a)).
-Intros; Cut x==x0.
-Intro; Rewrite H3; Unfold Rdiv.
-Symmetry; Apply Rinv_r_simpl_m; Assumption.
-Unfold sin_in in p; Unfold sin_in in s; EApply unicity_sum.
-Apply p.
-Apply s.
-Intros; Elim H2; Intros.
-Replace ``(sin a)-a`` with ``-(a-(sin a))``; [Idtac | Ring].
-Split; Apply Rle_Ropp1; Assumption.
-Replace ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))`` with ``-1*(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``; [Rewrite scal_sum | Ring].
-Apply sum_eq; Intros; Unfold sin_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
-Unfold Rdiv; Ring.
-Reflexivity.
-Replace ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))`` with ``-1*(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``; [Rewrite scal_sum | Ring].
-Apply sum_eq; Intros.
-Unfold sin_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
-Unfold Rdiv; Ring.
-Reflexivity.
-Replace (mult (2) (plus n (1))) with (S (S (mult (2) n))).
-Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)).
-Reflexivity.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Intro; Elim H1; Intros.
-Split.
-Apply Rle_anti_compatibility with ``-a``.
-Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-a``); Apply H2.
-Apply Rle_anti_compatibility with ``-a``.
-Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-a``); Apply H3.
-Unfold sin_term; Simpl; Unfold Rdiv; Rewrite Rinv_R1; Ring.
-Replace (mult (2) (plus n (1))) with (S (S (mult (2) n))).
-Apply lt_O_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)).
-Apply lt_O_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Inversion H; [Assumption | Elim Hyp_a; Symmetry; Assumption].
-Qed.
-
-(**********)
-Lemma cos_bound : (a:R; n:nat) `` -PI/2 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``. 
-Cut ((a:R; n:nat) ``0 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``) -> ((a:R; n:nat) `` -PI/2 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``).
-Intros H a n; Apply H.
-Intros; Unfold cos_approx.
-Rewrite (decomp_sum (cos_term a0) (plus (mult (S (S O)) n0) (S O))).
-Rewrite (decomp_sum (cos_term a0) (mult (S (S O)) (plus n0 (S O)))).
-Replace (cos_term a0 O) with R1.
-Cut (Rle (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (plus (mult (S (S O)) n0) (S O)))) ``(cos a0)-1``)/\(Rle ``(cos a0)-1`` (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (mult (S (S O)) (plus n0 (S O)))))) -> (Rle (Rplus R1 (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (plus (mult (S (S O)) n0) (S O))))) (cos a0))/\(Rle (cos a0) (Rplus R1 (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (mult (S (S O)) (plus n0 (S O))))))).
-Intro; Apply H2.
-Pose Un := [n:nat]``(pow a0 (mult (S (S O)) (S n)))/(INR (fact (mult (S (S O)) (S n))))``.
-Replace (pred (plus (mult (S (S O)) n0) (S O))) with (mult (S (S O)) n0).
-Replace (pred (mult (S (S O)) (plus n0 (S O)))) with (S (mult (S (S O)) n0)).
-Replace (sum_f_R0 [i:nat](cos_term a0 (S i)) (mult (S (S O)) n0)) with ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``.
-Replace (sum_f_R0 [i:nat](cos_term a0 (S i)) (S (mult (S (S O)) n0))) with ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``.
-Cut ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))<=1-(cos a0)<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``->`` -(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0)) <= (cos a0)-1 <=  -(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``.
-Intro; Apply H3.
-Apply alternated_series_ineq.
-Unfold Un_decreasing; Intro; Unfold Un.
-Cut (mult (S (S O)) (S (S n1)))=(S (S (mult (S (S O)) (S n1)))).
-Intro; Rewrite H4; Replace ``(pow a0 (S (S (mult (S (S O)) (S n1)))))`` with ``(pow a0 (mult (S (S O)) (S n1)))*(a0*a0)``.
-Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Apply pow_le; Assumption.
-Apply Rle_monotony_contra with ``(INR (fact (S (S (mult (S (S O)) (S n1))))))``.
-Rewrite <- H4; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H6 := (sym_eq ? ? ? H5); Elim (fact_neq_0 ? H6).
-Rewrite <- H4; Rewrite (Rmult_sym ``(INR (fact (mult (S (S O)) (S (S n1)))))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite H4; Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Do 2 Rewrite S_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Simpl; Replace ``((0+1+1)*((INR n1)+1)+1+1)*((0+1+1)*((INR n1)+1)+1)`` with ``4*(INR n1)*(INR n1)+14*(INR n1)+12``; [Idtac | Ring].
-Apply Rle_trans with ``12``.
-Apply Rle_trans with ``4``.
-Replace ``4`` with ``(Rsqr 2)``; [Idtac | SqRing].
-Replace ``a0*a0`` with (Rsqr a0); [Idtac | Reflexivity].
-Apply Rsqr_incr_1.
-Apply Rle_trans with ``PI/2``.
-Assumption.
-Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
-Sup0.
-Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
-Replace ``2*2`` with ``4``; [Apply PI_4 | Ring].
-DiscrR.
-Assumption.
-Left; Sup0.
-Pattern 1 ``4``; Rewrite <- Rplus_Or; Replace ``12`` with ``4+8``; [Apply Rle_compatibility; Left; Sup0 | Ring].
-Rewrite <- (Rplus_sym ``12``); Pattern 1 ``12``; Rewrite <- Rplus_Or; Apply Rle_compatibility.
-Apply ge0_plus_ge0_is_ge0.
-Repeat Apply Rmult_le_pos.
-Left; Sup0.
-Left; Sup0.
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Apply Rmult_le_pos.
-Left; Sup0.
-Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Assert H4 := (cv_speed_pow_fact a0); Unfold Un; Unfold Un_cv in H4; Unfold R_dist in H4; Unfold Un_cv; Unfold R_dist; Intros; Elim (H4 eps H5); Intros N H6; Exists N; Intros.
-Apply H6; Unfold ge; Apply le_trans with (mult (2) (S N)).
-Apply le_trans with (mult (2) N).
-Apply le_n_2n.
-Apply mult_le; Apply le_n_Sn.
-Apply mult_le; Apply le_n_S; Assumption.
-Assert X := (exist_cos (Rsqr a0)); Elim X; Intros.
-Cut ``x==(cos a0)``.
-Intro; Rewrite H4 in p; Unfold cos_in in p; Unfold infinit_sum in p; Unfold R_dist in p; Unfold Un_cv; Unfold R_dist; Intros.
-Elim (p ? H5); Intros N H6.
-Exists N; Intros.
-Replace (sum_f_R0 (tg_alt Un) n1) with (Rminus R1 (sum_f_R0 [i:nat]``(cos_n i)*(pow (Rsqr a0) i)`` (S n1))).
-Unfold Rminus; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Repeat Rewrite Rplus_assoc; Rewrite (Rplus_sym R1); Rewrite (Rplus_sym ``-1``); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Unfold Rminus in H6; Apply H6.
-Unfold ge; Apply le_trans with n1.
-Exact H7.
-Apply le_n_Sn.
-Rewrite (decomp_sum [i:nat]``(cos_n i)*(pow (Rsqr a0) i)`` (S n1)).
-Replace (cos_n O) with R1.
-Simpl; Rewrite Rmult_1r; Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Replace (Ropp (sum_f_R0 [i:nat]``(cos_n (S i))*((Rsqr a0)*(pow (Rsqr a0) i))`` n1)) with (Rmult ``-1`` (sum_f_R0 [i:nat]``(cos_n (S i))*((Rsqr a0)*(pow (Rsqr a0) i))`` n1)); [Idtac | Ring]; Rewrite scal_sum; Apply sum_eq; Intros; Unfold cos_n Un tg_alt.
-Replace ``(pow (-1) (S i))`` with ``-(pow (-1) i)``.
-Replace ``(pow a0 (mult (S (S O)) (S i)))`` with ``(Rsqr a0)*(pow (Rsqr a0) i)``.
-Unfold Rdiv; Ring.
-Rewrite pow_Rsqr; Reflexivity.
-Simpl; Ring.
-Unfold cos_n; Unfold Rdiv; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
-Apply lt_O_Sn.
-Unfold cos; Case (exist_cos (Rsqr a0)); Intros; Unfold cos_in in p; Unfold cos_in in c; EApply unicity_sum.
-Apply p.
-Apply c.
-Intros; Elim H3; Intros; Replace ``(cos a0)-1`` with ``-(1-(cos a0))``; [Idtac | Ring].
-Split; Apply Rle_Ropp1; Assumption.
-Replace ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))`` with ``-1*(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``; [Rewrite scal_sum | Ring].
-Apply sum_eq; Intros; Unfold cos_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
-Unfold Rdiv; Ring.
-Reflexivity.
-Replace ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))`` with ``-1*(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``; [Rewrite scal_sum | Ring]; Apply sum_eq; Intros; Unfold cos_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
-Unfold Rdiv; Ring.
-Reflexivity.
-Replace (mult (2) (plus n0 (1))) with (S (S (mult (2) n0))).
-Reflexivity.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) n0) (1)) with (S (mult (2) n0)).
-Reflexivity.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Intro; Elim H2; Intros; Split.
-Apply Rle_anti_compatibility with ``-1``.
-Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-1``); Apply H3.
-Apply Rle_anti_compatibility with ``-1``.
-Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-1``); Apply H4.
-Unfold cos_term; Simpl; Unfold Rdiv; Rewrite Rinv_R1; Ring.
-Replace (mult (2) (plus n0 (1))) with (S (S (mult (2) n0))).
-Apply lt_O_Sn.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
-Replace (plus (mult (2) n0) (1)) with (S (mult (2) n0)).
-Apply lt_O_Sn.
-Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Intros; Case (total_order_T R0 a); Intro.
-Elim s; Intro.
-Apply H; [Left; Assumption | Assumption].
-Apply H; [Right; Assumption | Assumption].
-Cut ``0< -a``.
-Intro; Cut (x:R;n:nat) (cos_approx x n)==(cos_approx ``-x`` n).
-Intro; Rewrite H3; Rewrite (H3 a (mult (S (S O)) (plus n (S O)))); Rewrite cos_sym; Apply H.
-Left; Assumption.
-Rewrite <- (Ropp_Ropp ``PI/2``); Apply Rle_Ropp1; Unfold Rdiv; Unfold Rdiv in H0; Rewrite <- Ropp_mul1; Exact H0.
-Intros; Unfold cos_approx; Apply sum_eq; Intros; Unfold cos_term; Do 2 Rewrite pow_Rsqr; Rewrite Rsqr_neg; Unfold Rdiv; Reflexivity.
-Apply Rgt_RO_Ropp; Assumption.
-Qed.
diff --git a/theories7/Reals/Rtrigo_calc.v b/theories7/Reals/Rtrigo_calc.v
deleted file mode 100644
index ab181106..00000000
--- a/theories7/Reals/Rtrigo_calc.v
+++ /dev/null
@@ -1,350 +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: Rtrigo_calc.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require R_sqrt.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Lemma tan_PI : ``(tan PI)==0``.
-Unfold tan; Rewrite sin_PI; Rewrite cos_PI; Unfold Rdiv; Apply Rmult_Ol. 
-Qed.
-
-Lemma sin_3PI2 : ``(sin (3*(PI/2)))==(-1)``.
-Replace ``3*(PI/2)`` with ``PI+(PI/2)``.
-Rewrite sin_plus; Rewrite sin_PI; Rewrite cos_PI; Rewrite sin_PI2; Ring.
-Pattern 1 PI; Rewrite (double_var PI); Ring.
-Qed.
-
-Lemma tan_2PI : ``(tan (2*PI))==0``.
-Unfold tan; Rewrite sin_2PI; Unfold Rdiv; Apply Rmult_Ol.
-Qed.
-
-Lemma sin_cos_PI4 : ``(sin (PI/4)) == (cos (PI/4))``.
-Proof with Trivial.
-Rewrite cos_sin.
-Replace ``PI/2+PI/4`` with ``-(PI/4)+PI``.
-Rewrite neg_sin; Rewrite sin_neg; Ring.
-Cut ``PI==PI/2+PI/2``; [Intro | Apply double_var].
-Pattern 2 3 PI; Rewrite H; Pattern 2 3 PI; Rewrite H.
-Assert H0 : ``2<>0``; [DiscrR | Unfold Rdiv; Rewrite Rinv_Rmult; Try Ring].
-Qed.
-
-Lemma sin_PI3_cos_PI6 : ``(sin (PI/3))==(cos (PI/6))``.
-Proof with Trivial.
-Replace ``PI/6`` with ``(PI/2)-(PI/3)``.
-Rewrite cos_shift.
-Assert H0 : ``6<>0``; [DiscrR | Idtac].
-Assert H1 : ``3<>0``; [DiscrR | Idtac].
-Assert H2 : ``2<>0``; [DiscrR | Idtac].
-Apply r_Rmult_mult with ``6``.
-Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``6``).
-Unfold Rdiv; Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite (Rmult_sym ``/3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Pattern 2 PI; Rewrite (Rmult_sym PI); Repeat Rewrite Rmult_1r; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Ring.
-Qed.
-
-Lemma sin_PI6_cos_PI3 : ``(cos (PI/3))==(sin (PI/6))``.
-Proof with Trivial.
-Replace ``PI/6`` with ``(PI/2)-(PI/3)``.
-Rewrite sin_shift.
-Assert H0 : ``6<>0``; [DiscrR | Idtac].
-Assert H1 : ``3<>0``; [DiscrR | Idtac].
-Assert H2 : ``2<>0``; [DiscrR | Idtac].
-Apply r_Rmult_mult with ``6``.
-Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``6``).
-Unfold Rdiv; Repeat Rewrite Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite (Rmult_sym ``/3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Pattern 2 PI; Rewrite (Rmult_sym PI); Repeat Rewrite Rmult_1r; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Ring.
-Qed.
-
-Lemma PI6_RGT_0 : ``0<PI/6``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0].
-Qed.
-
-Lemma PI6_RLT_PI2 : ``PI/6<PI/2``.
-Unfold Rdiv; Apply Rlt_monotony.
-Apply PI_RGT_0.
-Apply Rinv_lt; Sup.
-Qed.
-
-Lemma sin_PI6 : ``(sin (PI/6))==1/2``.
-Proof with Trivial.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Apply r_Rmult_mult with ``2*(cos (PI/6))``.
-Replace ``2*(cos (PI/6))*(sin (PI/6))`` with ``2*(sin (PI/6))*(cos (PI/6))``.
-Rewrite <- sin_2a; Replace ``2*(PI/6)`` with ``PI/3``.
-Rewrite sin_PI3_cos_PI6.
-Unfold Rdiv; Rewrite Rmult_1l; Rewrite Rmult_assoc; Pattern 2 ``2``; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite (Rmult_sym ``/2``); Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-DiscrR.
-Ring.
-Apply prod_neq_R0.
-Cut ``0<(cos (PI/6))``; [Intro H1; Auto with real | Apply cos_gt_0; [Apply (Rlt_trans ``-(PI/2)`` ``0`` ``PI/6`` _PI2_RLT_0 PI6_RGT_0) | Apply PI6_RLT_PI2]].
-Qed.
-
-Lemma sqrt2_neq_0 : ~``(sqrt 2)==0``.
-Assert Hyp:``0<2``; [Sup0 | Generalize (Rlt_le ``0`` ``2`` Hyp); Intro H1; Red; Intro H2; Generalize (sqrt_eq_0 ``2`` H1 H2); Intro H; Absurd ``2==0``; [ DiscrR | Assumption]].
-Qed.
-
-Lemma R1_sqrt2_neq_0 : ~``1/(sqrt 2)==0``.
-Generalize (Rinv_neq_R0 ``(sqrt 2)`` sqrt2_neq_0); Intro H; Generalize (prod_neq_R0 ``1`` ``(Rinv (sqrt 2))`` R1_neq_R0 H); Intro H0; Assumption.
-Qed.
-
-Lemma sqrt3_2_neq_0 : ~``2*(sqrt 3)==0``.
-Apply prod_neq_R0; [DiscrR | Assert Hyp:``0<3``; [Sup0 | Generalize (Rlt_le ``0`` ``3`` Hyp); Intro H1; Red; Intro H2; Generalize (sqrt_eq_0 ``3`` H1 H2); Intro H; Absurd ``3==0``; [ DiscrR | Assumption]]].
-Qed.
-
-Lemma Rlt_sqrt2_0 : ``0<(sqrt 2)``.
-Assert Hyp:``0<2``; [Sup0 | Generalize (sqrt_positivity ``2`` (Rlt_le ``0`` ``2`` Hyp)); Intro H1; Elim H1; Intro H2; [Assumption | Absurd ``0 == (sqrt 2)``; [Apply not_sym; Apply sqrt2_neq_0 | Assumption]]].
-Qed.
-
-Lemma Rlt_sqrt3_0 : ``0<(sqrt 3)``.
-Cut ~(O=(1)); [Intro H0; Assert Hyp:``0<2``; [Sup0 | Generalize (Rlt_le ``0`` ``2`` Hyp); Intro H1; Assert Hyp2:``0<3``; [Sup0 | Generalize (Rlt_le ``0`` ``3`` Hyp2); Intro H2; Generalize (lt_INR_0 (1) (neq_O_lt (1) H0)); Unfold INR; Intro H3; Generalize (Rlt_compatibility ``2`` ``0`` ``1`` H3); Rewrite Rplus_sym; Rewrite Rplus_Ol; Replace ``2+1`` with ``3``; [Intro H4; Generalize (sqrt_lt_1 ``2`` ``3`` H1 H2 H4); Clear H3; Intro H3; Apply (Rlt_trans ``0`` ``(sqrt 2)`` ``(sqrt 3)`` Rlt_sqrt2_0 H3) | Ring]]] | Discriminate].
-Qed.
-
-Lemma PI4_RGT_0 : ``0<PI/4``.
-Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0].
-Qed.
-
-Lemma cos_PI4 : ``(cos (PI/4))==1/(sqrt 2)``.
-Proof with Trivial.
-Apply Rsqr_inj.
-Apply cos_ge_0.
-Left; Apply (Rlt_trans ``-(PI/2)`` R0 ``PI/4`` _PI2_RLT_0 PI4_RGT_0).
-Left; Apply PI4_RLT_PI2.
-Left; Apply (Rmult_lt_pos R1 ``(Rinv (sqrt 2))``).
-Sup.
-Apply Rlt_Rinv; Apply Rlt_sqrt2_0.
-Rewrite Rsqr_div.
-Rewrite Rsqr_1; Rewrite Rsqr_sqrt.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Unfold Rsqr; Pattern 1 ``(cos (PI/4))``; Rewrite <- sin_cos_PI4; Replace ``(sin (PI/4))*(cos (PI/4))`` with ``(1/2)*(2*(sin (PI/4))*(cos (PI/4)))``.
-Rewrite <- sin_2a; Replace ``2*(PI/4)`` with ``PI/2``.
-Rewrite sin_PI2.
-Apply Rmult_1r.
-Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rinv_Rmult.
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Unfold Rdiv; Rewrite Rmult_1l; Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Left; Sup.
-Apply sqrt2_neq_0.
-Qed.
-
-Lemma sin_PI4 : ``(sin (PI/4))==1/(sqrt 2)``.
-Rewrite sin_cos_PI4; Apply cos_PI4.
-Qed.
-
-Lemma tan_PI4 : ``(tan (PI/4))==1``.
-Unfold tan; Rewrite sin_cos_PI4.
-Unfold Rdiv; Apply Rinv_r.
-Change ``(cos (PI/4))<>0``; Rewrite cos_PI4; Apply R1_sqrt2_neq_0.
-Qed.
-
-Lemma cos3PI4 : ``(cos (3*(PI/4)))==-1/(sqrt 2)``.
-Proof with Trivial.
-Replace ``3*(PI/4)`` with ``(PI/2)-(-(PI/4))``.
-Rewrite cos_shift; Rewrite sin_neg; Rewrite sin_PI4.
-Unfold Rdiv; Rewrite Ropp_mul1.
-Unfold Rminus; Rewrite Ropp_Ropp; Pattern 1 PI; Rewrite double_var; Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_Rmult; [Ring | DiscrR | DiscrR].
-Qed.
-
-Lemma sin3PI4 : ``(sin (3*(PI/4)))==1/(sqrt 2)``.
-Proof with Trivial.
-Replace ``3*(PI/4)`` with ``(PI/2)-(-(PI/4))``.
-Rewrite sin_shift; Rewrite cos_neg; Rewrite cos_PI4.
-Unfold Rminus; Rewrite Ropp_Ropp; Pattern 1 PI; Rewrite double_var; Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_Rmult; [Ring | DiscrR | DiscrR].
-Qed.
-
-Lemma cos_PI6 : ``(cos (PI/6))==(sqrt 3)/2``.
-Proof with Trivial.
-Apply Rsqr_inj.
-Apply cos_ge_0.
-Left; Apply (Rlt_trans ``-(PI/2)`` R0 ``PI/6`` _PI2_RLT_0 PI6_RGT_0).
-Left; Apply PI6_RLT_PI2.
-Left; Apply (Rmult_lt_pos ``(sqrt 3)`` ``(Rinv 2)``).
-Apply Rlt_sqrt3_0.
-Apply Rlt_Rinv; Sup0.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Assert H1 : ``4<>0``; [Apply prod_neq_R0 | Idtac].
-Rewrite Rsqr_div.
-Rewrite cos2; Unfold Rsqr; Rewrite sin_PI6; Rewrite sqrt_def.
-Unfold Rdiv; Rewrite Rmult_1l; Apply r_Rmult_mult with ``4``.
-Rewrite Rminus_distr; Rewrite (Rmult_sym ``3``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite Rmult_1r.
-Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- Rinv_r_sym.
-Ring.
-Left; Sup0.
-Qed.
-
-Lemma tan_PI6 : ``(tan (PI/6))==1/(sqrt 3)``.
-Unfold tan; Rewrite sin_PI6; Rewrite cos_PI6; Unfold Rdiv; Repeat Rewrite Rmult_1l; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Rewrite (Rmult_sym ``/2``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Apply Rmult_1r.
-DiscrR.
-DiscrR.
-Red; Intro; Assert H1 := Rlt_sqrt3_0; Rewrite H in H1; Elim (Rlt_antirefl ``0`` H1).
-Apply Rinv_neq_R0; DiscrR.
-Qed.
-
-Lemma sin_PI3 : ``(sin (PI/3))==(sqrt 3)/2``.
-Rewrite sin_PI3_cos_PI6; Apply cos_PI6.
-Qed.
-
-Lemma cos_PI3 : ``(cos (PI/3))==1/2``.
-Rewrite sin_PI6_cos_PI3; Apply sin_PI6.
-Qed.
-
-Lemma tan_PI3 : ``(tan (PI/3))==(sqrt 3)``.
-Unfold tan; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Rewrite Rmult_1l; Rewrite Rinv_Rinv.
-Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Apply Rmult_1r.
-DiscrR.
-DiscrR.
-Qed.
-
-Lemma sin_2PI3 : ``(sin (2*(PI/3)))==(sqrt 3)/2``.
-Rewrite double; Rewrite sin_plus; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Repeat Rewrite Rmult_1l; Rewrite (Rmult_sym ``/2``); Repeat Rewrite <- Rmult_assoc; Rewrite double_var; Reflexivity.
-Qed.
-
-Lemma cos_2PI3 : ``(cos (2*(PI/3)))==-1/2``.
-Proof with Trivial.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Assert H0 : ``4<>0``; [Apply prod_neq_R0 | Idtac].
-Rewrite double; Rewrite cos_plus; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Rewrite Rmult_1l; Apply r_Rmult_mult with ``4``.
-Rewrite Rminus_distr; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- (Rinv_l_sym).
-Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
-Pattern 4 ``2``; Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite Ropp_mul3; Rewrite Rmult_1r.
-Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``2``); Rewrite (Rmult_sym ``/2``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Rewrite sqrt_def.
-Ring.
-Left; Sup.
-Qed.
-
-Lemma tan_2PI3 : ``(tan (2*(PI/3)))==-(sqrt 3)``.
-Proof with Trivial.
-Assert H : ``2<>0``; [DiscrR | Idtac].
-Unfold tan; Rewrite sin_2PI3; Rewrite cos_2PI3; Unfold Rdiv; Rewrite Ropp_mul1; Rewrite Rmult_1l; Rewrite <- Ropp_Rinv.
-Rewrite Rinv_Rinv.
-Rewrite Rmult_assoc; Rewrite Ropp_mul3; Rewrite <- Rinv_l_sym.
-Ring.
-Apply Rinv_neq_R0.
-Qed.
-
-Lemma cos_5PI4 : ``(cos (5*(PI/4)))==-1/(sqrt 2)``.
-Proof with Trivial.
-Replace ``5*(PI/4)`` with ``(PI/4)+(PI)``.
-Rewrite neg_cos; Rewrite cos_PI4; Unfold Rdiv; Rewrite Ropp_mul1.
-Pattern 2 PI; Rewrite double_var; Pattern 2 3 PI; Rewrite double_var; Assert H : ``2<>0``; [DiscrR | Unfold Rdiv; Repeat Rewrite Rinv_Rmult; Try Ring].
-Qed.
-
-Lemma sin_5PI4 : ``(sin (5*(PI/4)))==-1/(sqrt 2)``.
-Proof with Trivial.
-Replace ``5*(PI/4)`` with ``(PI/4)+(PI)``.
-Rewrite neg_sin; Rewrite sin_PI4; Unfold Rdiv; Rewrite Ropp_mul1.
-Pattern 2 PI; Rewrite double_var; Pattern 2 3 PI; Rewrite double_var; Assert H : ``2<>0``; [DiscrR | Unfold Rdiv; Repeat Rewrite Rinv_Rmult; Try Ring].
-Qed.
-
-Lemma sin_cos5PI4 : ``(cos (5*(PI/4)))==(sin (5*(PI/4)))``.
-Rewrite cos_5PI4; Rewrite sin_5PI4; Reflexivity.
-Qed.
-
-Lemma Rgt_3PI2_0 : ``0<3*(PI/2)``.
-Apply Rmult_lt_pos; [Sup0 | Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0]].
-Qed.
-
-Lemma Rgt_2PI_0 : ``0<2*PI``.
-Apply Rmult_lt_pos; [Sup0 | Apply PI_RGT_0].
-Qed.
-
-Lemma Rlt_PI_3PI2 : ``PI<3*(PI/2)``.
-Generalize PI2_RGT_0; Intro H1; Generalize (Rlt_compatibility PI ``0`` ``PI/2`` H1); Replace ``PI+(PI/2)`` with ``3*(PI/2)``.
-Rewrite Rplus_Or; Intro H2; Assumption.
-Pattern 2 PI; Rewrite double_var; Ring.
-Qed. 
- 
-Lemma Rlt_3PI2_2PI : ``3*(PI/2)<2*PI``.
-Generalize PI2_RGT_0; Intro H1; Generalize (Rlt_compatibility ``3*(PI/2)`` ``0`` ``PI/2`` H1); Replace ``3*(PI/2)+(PI/2)`` with ``2*PI``.
-Rewrite Rplus_Or; Intro H2; Assumption.
-Rewrite double; Pattern 1 2 PI; Rewrite double_var; Ring.
-Qed.
-
-(***************************************************************)
-(* Radian -> Degree | Degree -> Radian                         *)
-(***************************************************************)
-
-Definition plat : R := ``180``.
-Definition toRad [x:R] : R := ``x*PI*/plat``.
-Definition toDeg [x:R] : R := ``x*plat*/PI``.
-
-Lemma rad_deg : (x:R) (toRad (toDeg x))==x.
-Intro; Unfold toRad toDeg; Replace ``x*plat*/PI*PI*/plat`` with ``x*(plat*/plat)*(PI*/PI)``; [Idtac | Ring].
-Repeat Rewrite <- Rinv_r_sym.
-Ring.
-Apply PI_neq0.
-Unfold plat; DiscrR.
-Qed.
-
-Lemma toRad_inj : (x,y:R) (toRad x)==(toRad y) -> x==y.
-Intros; Unfold toRad in H; Apply r_Rmult_mult with PI.
-Rewrite <- (Rmult_sym x); Rewrite <- (Rmult_sym y).
-Apply r_Rmult_mult with ``/plat``.
-Rewrite <- (Rmult_sym ``x*PI``); Rewrite <- (Rmult_sym ``y*PI``); Assumption.
-Apply Rinv_neq_R0; Unfold plat; DiscrR.
-Apply PI_neq0.
-Qed.
-
-Lemma deg_rad : (x:R) (toDeg (toRad x))==x.
-Intro x; Apply toRad_inj; Rewrite -> (rad_deg (toRad x)); Reflexivity.
-Qed.
-
-Definition sind [x:R] : R := (sin (toRad x)).
-Definition cosd [x:R] : R := (cos (toRad x)).
-Definition tand [x:R] : R := (tan (toRad x)).
-
-Lemma Rsqr_sin_cos_d_one : (x:R) ``(Rsqr (sind x))+(Rsqr (cosd x))==1``.
-Intro x; Unfold sind; Unfold cosd; Apply sin2_cos2.
-Qed.
-
-(***************************************************)
-(*                Other properties                 *)
-(***************************************************)
-
-Lemma sin_lb_ge_0 : (a:R) ``0<=a``->``a<=PI/2``->``0<=(sin_lb a)``.
-Intros; Case (total_order R0 a); Intro.
-Left; Apply sin_lb_gt_0; Assumption.
-Elim H1; Intro.
-Rewrite <- H2; Unfold sin_lb; Unfold sin_approx; Unfold sum_f_R0; Unfold sin_term; Repeat Rewrite pow_ne_zero.
-Unfold Rdiv; Repeat Rewrite Rmult_Ol; Repeat Rewrite Rmult_Or; Repeat Rewrite Rplus_Or; Right; Reflexivity.
-Discriminate.
-Discriminate.
-Discriminate.
-Discriminate.
-Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` a ``0`` H H2)).
-Qed.
diff --git a/theories7/Reals/Rtrigo_def.v b/theories7/Reals/Rtrigo_def.v
deleted file mode 100644
index 0897416b..00000000
--- a/theories7/Reals/Rtrigo_def.v
+++ /dev/null
@@ -1,357 +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: Rtrigo_def.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo_fun.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(*****************************)
-(* Definition of exponential *)
-(*****************************)
-Definition exp_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``/(INR (fact i))*(pow x i)`` l).
-
-Lemma exp_cof_no_R0 : (n:nat) ``/(INR (fact n))<>0``.
-Intro.
-Apply Rinv_neq_R0.
-Apply INR_fact_neq_0.
-Qed.
-
-Lemma exist_exp : (x:R)(SigT R [l:R](exp_in x l)).
-Intro; Generalize (Alembert_C3 [n:nat](Rinv (INR (fact n))) x exp_cof_no_R0 Alembert_exp).
-Unfold Pser exp_in.
-Trivial.
-Defined.
-
-Definition exp : R -> R := [x:R](projT1 ? ? (exist_exp x)).
-
-Lemma pow_i : (i:nat) (lt O i) -> (pow R0 i)==R0.
-Intros; Apply pow_ne_zero.
-Red; Intro; Rewrite H0 in H; Elim (lt_n_n ? H).
-Qed.
-
-(*i Calculus of $e^0$ *)
-Lemma exist_exp0 : (SigT R [l:R](exp_in R0 l)).
-Apply Specif.existT with R1.
-Unfold exp_in; Unfold infinit_sum; Intros.
-Exists O.
-Intros; Replace (sum_f_R0 ([i:nat]``/(INR (fact i))*(pow R0 i)``) n) with R1.
-Unfold R_dist; Replace ``1-1`` with R0; [Rewrite Rabsolu_R0; Assumption | Ring].
-Induction n.
-Simpl; Rewrite Rinv_R1; Ring.
-Rewrite tech5.
-Rewrite <- Hrecn.
-Simpl.
-Ring.
-Unfold ge; Apply le_O_n.
-Defined.
-
-Lemma exp_0 : ``(exp 0)==1``. 
-Cut (exp_in R0 (exp R0)).
-Cut (exp_in R0 R1).
-Unfold exp_in; Intros; EApply unicity_sum.
-Apply H0.
-Apply H.
-Exact (projT2 ? ? exist_exp0).
-Exact (projT2 ? ? (exist_exp R0)).
-Qed.
-
-(**************************************)
-(* Definition of hyperbolic functions *)
-(**************************************)
-Definition cosh : R->R := [x:R]``((exp x)+(exp (-x)))/2``.
-Definition sinh : R->R := [x:R]``((exp x)-(exp (-x)))/2``.
-Definition tanh : R->R := [x:R]``(sinh x)/(cosh x)``.
-
-Lemma cosh_0 : ``(cosh 0)==1``.
-Unfold cosh; Rewrite Ropp_O; Rewrite exp_0.
-Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | DiscrR].
-Qed.
-
-Lemma sinh_0 : ``(sinh 0)==0``.
-Unfold sinh; Rewrite Ropp_O; Rewrite exp_0.
-Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Apply Rmult_Ol.
-Qed.
-
-Definition cos_n [n:nat] : R := ``(pow (-1) n)/(INR (fact (mult (S (S O)) n)))``.
-
-Lemma simpl_cos_n : (n:nat) (Rdiv (cos_n (S n)) (cos_n n))==(Ropp (Rinv (INR (mult (mult (2) (S n)) (plus (mult (2) n) (1)))))). 
-Intro; Unfold cos_n; Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Replace ``(pow ( -1) n)*(pow ( -1) (S O))*/(INR (fact (mult (S (S O)) (plus n (S O)))))*(/(pow ( -1) n)*(INR (fact (mult (S (S O)) n))))`` with ``((pow ( -1) n)*/(pow ( -1) n))*/(INR (fact (mult (S (S O)) (plus n (S O)))))*(INR (fact (mult (S (S O)) n)))*(pow (-1) (S O))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Unfold pow; Rewrite Rmult_1r.
-Replace (mult (S (S O)) (plus n (S O))) with (S (S (mult (S (S O)) n))); [Idtac | Ring].
-Do 2 Rewrite fact_simpl; Do 2  Rewrite mult_INR; Repeat Rewrite Rinv_Rmult; Try (Apply not_O_INR; Discriminate).
-Rewrite <- (Rmult_sym ``-1``).
-Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r.
-Replace (S (mult (S (S O)) n)) with (plus (mult (S (S O)) n) (S O)); [Idtac | Ring].
-Rewrite mult_INR; Rewrite Rinv_Rmult.
-Ring.
-Apply not_O_INR; Discriminate.
-Replace (plus (mult (S (S O)) n) (S O)) with (S (mult (S (S O)) n)); [Apply not_O_INR; Discriminate | Ring].
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Apply pow_nonzero; DiscrR.
-Apply INR_fact_neq_0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Qed.
-
-Lemma archimed_cor1 : (eps:R) ``0<eps`` -> (EX N : nat | ``/(INR N) < eps``/\(lt O N)).
-Intros; Cut ``/eps < (IZR (up (/eps)))``.
-Intro; Cut `0<=(up (Rinv eps))`.
-Intro; Assert H2 := (IZN ? H1); Elim H2; Intros; Exists (max x (1)).
-Split.
-Cut ``0<(IZR (INZ x))``.
-Intro; Rewrite INR_IZR_INZ; Apply Rle_lt_trans with ``/(IZR (INZ x))``.
-Apply Rle_monotony_contra with (IZR (INZ x)).
-Assumption.
-Rewrite <- Rinv_r_sym; [Idtac | Red; Intro; Rewrite H5 in H4; Elim (Rlt_antirefl ? H4)].
-Apply Rle_monotony_contra with (IZR (INZ (max x (1)))).
-Apply Rlt_le_trans with (IZR (INZ x)).
-Assumption.
-Repeat Rewrite <- INR_IZR_INZ; Apply le_INR; Apply le_max_l.
-Rewrite Rmult_1r; Rewrite (Rmult_sym (IZR (INZ (max x (S O))))); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Repeat Rewrite <- INR_IZR_INZ; Apply le_INR; Apply le_max_l.
-Rewrite <- INR_IZR_INZ; Apply not_O_INR.
-Red; Intro;Assert H6 := (le_max_r x (1)); Cut (lt O (1)); [Intro | Apply lt_O_Sn]; Assert H8 := (lt_le_trans ? ? ? H7 H6); Rewrite H5 in H8; Elim (lt_n_n ? H8).
-Pattern 1 eps; Rewrite <- Rinv_Rinv.
-Apply Rinv_lt.
-Apply Rmult_lt_pos; [Apply Rlt_Rinv; Assumption | Assumption].
-Rewrite H3 in H0; Assumption.
-Red; Intro; Rewrite H5 in H; Elim (Rlt_antirefl ? H).
-Apply Rlt_trans with ``/eps``.
-Apply Rlt_Rinv; Assumption.
-Rewrite H3 in H0; Assumption.
-Apply lt_le_trans with (1); [Apply lt_O_Sn | Apply le_max_r].
-Apply le_IZR; Replace (IZR `0`) with R0; [Idtac | Reflexivity]; Left; Apply Rlt_trans with ``/eps``; [Apply Rlt_Rinv; Assumption | Assumption].
-Assert H0 := (archimed ``/eps``).
-Elim H0; Intros; Assumption.
-Qed.
-
-Lemma Alembert_cos : (Un_cv [n:nat]``(Rabsolu (cos_n (S n))/(cos_n n))`` R0).
-Unfold Un_cv; Intros.
-Assert H0 := (archimed_cor1 eps H).
-Elim H0; Intros; Exists x.
-Intros; Rewrite simpl_cos_n; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_Ropp; Rewrite Rabsolu_right.
-Rewrite mult_INR; Rewrite Rinv_Rmult.
-Cut ``/(INR (mult (S (S O)) (S n)))<1``.
-Intro; Cut ``/(INR (plus (mult (S (S O)) n) (S O)))<eps``.
-Intro; Rewrite <- (Rmult_1l eps).
-Apply Rmult_lt; Try Assumption.
-Change ``0</(INR (plus (mult (S (S O)) n) (S O)))``; Apply Rlt_Rinv; Apply lt_INR_0.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Apply Rlt_R0_R1.
-Cut (lt x (plus (mult (2) n) (1))).
-Intro; Assert H5 := (lt_INR ? ? H4).
-Apply Rlt_trans with ``/(INR x)``.
-Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply lt_INR_0.
-Elim H1; Intros; Assumption.
-Apply lt_INR_0; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
-Assumption.
-Elim H1; Intros; Assumption.
-Apply lt_le_trans with (S n).
-Unfold ge in H2; Apply le_lt_n_Sm; Assumption.
-Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Idtac | Ring].
-Apply le_n_S; Apply le_n_2n.
-Apply Rlt_monotony_contra with (INR (mult (S (S O)) (S n))).
-Apply lt_INR_0; Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Apply lt_O_Sn.
-Replace (S n) with (plus n (1)); [Idtac | Ring].
-Ring.
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace R1 with (INR (1)); [Apply lt_INR | Reflexivity].
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Apply lt_n_S; Apply lt_O_Sn.
-Replace (S n) with (plus n (1)); [Ring | Ring].
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Replace (plus (mult (S (S O)) n) (S O)) with (S (mult (2) n)); [Apply not_O_INR; Discriminate | Ring].
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Apply lt_INR_0.
-Replace (mult (mult (2) (S n)) (plus (mult (2) n) (1))) with (S (S (plus (mult (4) (mult n n)) (mult (6) n)))).
-Apply lt_O_Sn.
-Apply INR_eq.
-Repeat Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite mult_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Replace (INR O) with R0; [Ring | Reflexivity].
-Qed.
-
-Lemma cosn_no_R0 : (n:nat)``(cos_n n)<>0``.
-Intro; Unfold cos_n; Unfold Rdiv; Apply prod_neq_R0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0.
-Apply INR_fact_neq_0.
-Qed.
-
-(**********)
-Definition cos_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``(cos_n i)*(pow x i)`` l).
-
-(**********)
-Lemma exist_cos : (x:R)(SigT R [l:R](cos_in x l)).
-Intro; Generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos).
-Unfold Pser cos_in; Trivial.
-Qed.
-
-(* Definition of cosinus *)
-(*************************)
-Definition cos : R -> R := [x:R](Cases (exist_cos (Rsqr x)) of (Specif.existT a b) => a end).
-
-
-Definition sin_n [n:nat] : R := ``(pow (-1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))``.
-
-Lemma simpl_sin_n : (n:nat) (Rdiv (sin_n (S n)) (sin_n n))==(Ropp (Rinv (INR (mult (plus (mult (2) (S n)) (1)) (mult (2) (S n)))))). 
-Intro; Unfold sin_n; Replace (S n) with (plus n (1)); [Idtac | Ring].
-Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Replace ``(pow ( -1) n)*(pow ( -1) (S O))*/(INR (fact (plus (mult (S (S O)) (plus n (S O))) (S O))))*(/(pow ( -1) n)*(INR (fact (plus (mult (S (S O)) n) (S O)))))`` with ``((pow ( -1) n)*/(pow ( -1) n))*/(INR (fact (plus (mult (S (S O)) (plus n (S O))) (S O))))*(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow (-1) (S O))``; [Idtac | Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Unfold pow; Rewrite Rmult_1r; Replace (plus (mult (S (S O)) (plus n (S O))) (S O)) with (S (S (plus (mult (S (S O)) n) (S O)))).
-Do 2 Rewrite fact_simpl; Do 2  Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
-Rewrite <- (Rmult_sym ``-1``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Replace (S (plus (mult (S (S O)) n) (S O))) with (mult (S (S O)) (plus n (S O))).
-Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
-Ring.
-Apply not_O_INR; Discriminate.
-Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
-Apply not_O_INR; Discriminate.
-Apply prod_neq_R0.
-Apply not_O_INR; Discriminate.
-Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
-Apply not_O_INR; Discriminate.
-Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
-Rewrite mult_plus_distr_r; Cut (n:nat) (S n)=(plus n (1)).
-Intros; Rewrite (H (plus (mult (2) n) (1))).
-Ring.
-Intros; Ring.
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
-Cut (n:nat) (S (S n))=(plus n (2)); [Intros; Rewrite (H (plus (mult (2) n) (1))); Ring | Intros; Ring].
-Apply pow_nonzero; DiscrR.
-Apply INR_fact_neq_0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Qed.
-
-Lemma Alembert_sin : (Un_cv [n:nat]``(Rabsolu (sin_n (S n))/(sin_n n))`` R0).
-Unfold Un_cv; Intros; Assert H0 := (archimed_cor1 eps H).
-Elim H0; Intros; Exists x.
-Intros; Rewrite simpl_sin_n; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_Ropp; Rewrite Rabsolu_right.
-Rewrite mult_INR; Rewrite Rinv_Rmult.
-Cut ``/(INR (mult (S (S O)) (S n)))<1``.
-Intro; Cut ``/(INR (plus (mult (S (S O)) (S n)) (S O)))<eps``.
-Intro; Rewrite <- (Rmult_1l eps); Rewrite (Rmult_sym ``/(INR (plus (mult (S (S O)) (S n)) (S O)))``); Apply Rmult_lt; Try Assumption.
-Change ``0</(INR (plus (mult (S (S O)) (S n)) (S O)))``; Apply Rlt_Rinv; Apply lt_INR_0; Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
-Apply Rlt_R0_R1.
-Cut (lt x (plus (mult (2) (S n)) (1))).
-Intro; Assert H5 := (lt_INR ? ? H4); Apply Rlt_trans with ``/(INR x)``.
-Apply Rinv_lt.
-Apply Rmult_lt_pos.
-Apply lt_INR_0; Elim H1; Intros; Assumption.
-Apply lt_INR_0; Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
-Assumption.
-Elim H1; Intros; Assumption.
-Apply lt_le_trans with (S n).
-Unfold ge in H2; Apply le_lt_n_Sm; Assumption.
-Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Idtac | Ring].
-Apply le_S; Apply le_n_2n.
-Apply Rlt_monotony_contra with (INR (mult (S (S O)) (S n))).
-Apply lt_INR_0; Replace (mult (2) (S n)) with (S (S (mult (2) n))); [Apply lt_O_Sn | Replace (S n) with (plus n (1)); [Idtac | Ring]; Ring].
-Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Replace R1 with (INR (1)); [Apply lt_INR | Reflexivity].
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Apply lt_n_S; Apply lt_O_Sn.
-Replace (S n) with (plus n (1)); [Ring | Ring].
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Apply not_O_INR; Discriminate.
-Left; Change ``0</(INR (mult (plus (mult (S (S O)) (S n)) (S O)) (mult (S (S O)) (S n))))``; Apply Rlt_Rinv.
-Apply lt_INR_0.
-Replace (mult (plus (mult (2) (S n)) (1)) (mult (2) (S n))) with (S (S (S (S (S (S (plus (mult (4) (mult n n)) (mult (10) n)))))))).
-Apply lt_O_Sn.
-Apply INR_eq; Repeat Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite mult_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Replace (INR O) with R0; [Ring | Reflexivity].
-Qed.
-
-Lemma sin_no_R0 : (n:nat)``(sin_n n)<>0``.
-Intro; Unfold sin_n; Unfold Rdiv; Apply prod_neq_R0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Qed.
-
-(**********)
-Definition sin_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``(sin_n i)*(pow x i)`` l).
-
-(**********)
-Lemma exist_sin : (x:R)(SigT R [l:R](sin_in x l)).
-Intro; Generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin).
-Unfold Pser sin_n; Trivial.
-Qed.
-
-(***********************)
-(* Definition of sinus *)
-Definition sin : R -> R := [x:R](Cases (exist_sin (Rsqr x)) of (Specif.existT a b) => ``x*a`` end).
-
-(*********************************************)
-(*                 PROPERTIES                *)
-(*********************************************)
-
-Lemma cos_sym : (x:R) ``(cos x)==(cos (-x))``.
-Intros; Unfold cos; Replace ``(Rsqr (-x))`` with (Rsqr x).
-Reflexivity.
-Apply Rsqr_neg.
-Qed.
-
-Lemma sin_antisym : (x:R)``(sin (-x))==-(sin x)``.
-Intro; Unfold sin; Replace ``(Rsqr (-x))`` with (Rsqr x); [Idtac | Apply Rsqr_neg]. 
-Case (exist_sin (Rsqr x)); Intros; Ring.
-Qed.
-
-Lemma sin_0 : ``(sin 0)==0``.
-Unfold sin; Case (exist_sin (Rsqr R0)).
-Intros; Ring.
-Qed.
-
-Lemma exist_cos0 : (SigT R [l:R](cos_in R0 l)).
-Apply Specif.existT with R1.
-Unfold cos_in; Unfold infinit_sum; Intros; Exists O.
-Intros.
-Unfold R_dist.
-Induction n.
-Unfold cos_n; Simpl.
-Unfold Rdiv; Rewrite Rinv_R1.
-Do 2 Rewrite Rmult_1r.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Rewrite tech5.
-Replace ``(cos_n (S n))*(pow 0 (S n))`` with R0.
-Rewrite Rplus_Or.
-Apply Hrecn; Unfold ge; Apply le_O_n.
-Simpl; Ring.
-Defined.
-
-(* Calculus of (cos 0) *)
-Lemma cos_0 : ``(cos 0)==1``.
-Cut (cos_in R0 (cos R0)).
-Cut (cos_in R0 R1).
-Unfold cos_in; Intros; EApply unicity_sum.
-Apply H0.
-Apply H.
-Exact (projT2 ? ? exist_cos0).
-Assert H := (projT2 ? ? (exist_cos (Rsqr R0))); Unfold cos; Pattern 1 R0; Replace R0 with (Rsqr R0); [Exact H | Apply Rsqr_O].
-Qed.
diff --git a/theories7/Reals/Rtrigo_fun.v b/theories7/Reals/Rtrigo_fun.v
deleted file mode 100644
index bc72c0e1..00000000
--- a/theories7/Reals/Rtrigo_fun.v
+++ /dev/null
@@ -1,118 +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: Rtrigo_fun.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(*****************************************************************)
-(*           To define transcendental functions                  *)
-(*                                                               *)
-(*****************************************************************)
-(*****************************************************************)
-(*           For exponential function                            *)
-(*                                                               *)
-(*****************************************************************)
-
-(*********)
-Lemma Alembert_exp:(Un_cv
-   [n:nat](Rabsolu (Rmult (Rinv (INR (fact (S n)))) 
-         (Rinv (Rinv (INR (fact n)))))) R0).
-Unfold Un_cv;Intros;Elim (total_order_Rgt eps R1);Intro.
-Split with O;Intros;Rewrite (simpl_fact n);Unfold R_dist;
- Rewrite (minus_R0 (Rabsolu (Rinv (INR (S n)))));
- Rewrite (Rabsolu_Rabsolu (Rinv (INR (S n))));
- Cut (Rgt (Rinv (INR (S n))) R0).
-Intro; Rewrite (Rabsolu_pos_eq (Rinv (INR (S n)))).
-Cut (Rlt (Rminus (Rinv eps) R1) R0).
-Intro;Generalize (Rlt_le_trans (Rminus (Rinv eps) R1) R0 (INR n) H2 
-   (pos_INR n));Clear H2;Intro;
- Unfold Rminus in H2;Generalize (Rlt_compatibility R1 
-       (Rplus (Rinv eps) (Ropp R1)) (INR n) H2);
- Replace (Rplus R1 (Rplus (Rinv eps) (Ropp R1))) with (Rinv eps);
- [Clear H2;Intro|Ring].
-Rewrite (Rplus_sym R1 (INR n)) in H2;Rewrite <-(S_INR n) in H2;
- Generalize (Rmult_gt (Rinv (INR (S n))) eps H1 H);Intro;
- Unfold Rgt in H3;
- Generalize (Rlt_monotony (Rmult (Rinv (INR (S n))) eps) (Rinv eps)
-     (INR (S n)) H3 H2);Intro;
- Rewrite (Rmult_assoc (Rinv (INR (S n))) eps (Rinv eps)) in H4;
- Rewrite (Rinv_r eps (imp_not_Req eps R0 
-      (or_intror (Rlt eps R0) (Rgt eps R0) H))) 
-  in H4;Rewrite (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1) 
-  in H4;Rewrite (Rmult_sym (Rinv (INR (S n)))) in H4;
- Rewrite (Rmult_assoc eps (Rinv (INR (S n))) (INR (S n))) in H4;
- Rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) 
-      (sym_not_equal nat O (S n) (O_S n)))) in H4;
- Rewrite (let (H1,H2)=(Rmult_ne eps) in H1) in H4;Assumption.
-Apply Rlt_minus;Unfold Rgt in a;Rewrite <- Rinv_R1;
- Apply (Rinv_lt R1 eps);Auto;
- Rewrite (let (H1,H2)=(Rmult_ne eps) in H2);Unfold Rgt in H;Assumption.
-Unfold Rgt in H1;Apply Rlt_le;Assumption.
-Unfold Rgt;Apply Rlt_Rinv; Apply lt_INR_0;Apply lt_O_Sn.
-(**)
-Cut `0<=(up (Rminus (Rinv eps) R1))`.
-Intro;Elim (IZN (up (Rminus (Rinv eps) R1)) H0);Intros;
- Split with x;Intros;Rewrite (simpl_fact n);Unfold R_dist;
- Rewrite (minus_R0 (Rabsolu (Rinv (INR (S n)))));
- Rewrite (Rabsolu_Rabsolu (Rinv (INR (S n))));
- Cut (Rgt (Rinv (INR (S n))) R0).
-Intro; Rewrite (Rabsolu_pos_eq (Rinv (INR (S n)))).
-Cut (Rlt (Rminus (Rinv eps) R1) (INR x)).
-Intro;Generalize (Rlt_le_trans (Rminus (Rinv eps) R1) (INR x) (INR n) 
-      H4 (le_INR x n ([n,m:nat; H:(ge m n)]H x n H2)));  
- Clear H4;Intro;Unfold Rminus in H4;Generalize (Rlt_compatibility R1 
-       (Rplus (Rinv eps) (Ropp R1)) (INR n) H4);
- Replace (Rplus R1 (Rplus (Rinv eps) (Ropp R1))) with (Rinv eps);
- [Clear H4;Intro|Ring].
-Rewrite (Rplus_sym R1 (INR n)) in H4;Rewrite <-(S_INR n) in H4;
- Generalize (Rmult_gt (Rinv (INR (S n))) eps H3 H);Intro;
- Unfold Rgt in H5;
- Generalize (Rlt_monotony (Rmult (Rinv (INR (S n))) eps) (Rinv eps)
-     (INR (S n)) H5 H4);Intro;
- Rewrite (Rmult_assoc (Rinv (INR (S n))) eps (Rinv eps)) in H6;
- Rewrite (Rinv_r eps (imp_not_Req eps R0 
-      (or_intror (Rlt eps R0) (Rgt eps R0) H))) 
-  in H6;Rewrite (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1) 
-  in H6;Rewrite (Rmult_sym (Rinv (INR (S n)))) in H6;
- Rewrite (Rmult_assoc eps (Rinv (INR (S n))) (INR (S n))) in H6;
- Rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) 
-      (sym_not_equal nat O (S n) (O_S n)))) in H6;
- Rewrite (let (H1,H2)=(Rmult_ne eps) in H1) in H6;Assumption.
-Cut (IZR (up (Rminus (Rinv eps) R1)))==(IZR (INZ x));
- [Intro|Rewrite H1;Trivial].
-Elim (archimed (Rminus (Rinv eps) R1));Intros;Clear H6;
- Unfold Rgt in H5;Rewrite H4 in H5;Rewrite INR_IZR_INZ;Assumption.
-Unfold Rgt in H1;Apply Rlt_le;Assumption.
-Unfold Rgt;Apply Rlt_Rinv; Apply lt_INR_0;Apply lt_O_Sn.
-Apply (le_O_IZR (up (Rminus (Rinv eps) R1))); 
- Apply (Rle_trans R0 (Rminus (Rinv eps) R1) 
-  (IZR (up (Rminus (Rinv eps) R1)))).
-Generalize (Rgt_not_le eps R1 b);Clear b;Unfold Rle;Intro;Elim H0;
- Clear H0;Intro.
-Left;Unfold Rgt in H;
- Generalize (Rlt_monotony (Rinv eps) eps R1 (Rlt_Rinv eps H) H0);
- Rewrite (Rinv_l eps (sym_not_eqT R R0 eps
-    (imp_not_Req R0 eps (or_introl (Rlt R0 eps) (Rgt R0 eps) H))));
- Rewrite (let (H1,H2)=(Rmult_ne (Rinv eps)) in H1);Intro;
- Fold (Rgt (Rminus (Rinv eps) R1) R0);Apply Rgt_minus;Unfold Rgt;
- Assumption.
-Right;Rewrite H0;Rewrite Rinv_R1;Apply sym_eqT;Apply eq_Rminus;Auto.
-Elim (archimed (Rminus (Rinv eps) R1));Intros;Clear H1;
- Unfold Rgt in H0;Apply Rlt_le;Assumption.
-Qed.
-
-
-
-
-
-
diff --git a/theories7/Reals/Rtrigo_reg.v b/theories7/Reals/Rtrigo_reg.v
deleted file mode 100644
index 02e40caf..00000000
--- a/theories7/Reals/Rtrigo_reg.v
+++ /dev/null
@@ -1,497 +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: Rtrigo_reg.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require SeqSeries.
-Require Rtrigo.
-Require Ranalysis1.
-Require PSeries_reg.
-V7only [Import nat_scope. Import Z_scope. Import R_scope.].
-Open Local Scope nat_scope.
-Open Local Scope R_scope.
-
-Lemma CVN_R_cos : (fn:nat->R->R) (fn == [N:nat][x:R]``(pow (-1) N)/(INR (fact (mult (S (S O)) N)))*(pow x (mult (S (S O)) N))``) -> (CVN_R fn).
-Unfold CVN_R; Intros.
-Cut (r::R)<>``0``.
-Intro hyp_r; Unfold CVN_r.
-Apply Specif.existT with [n:nat]``/(INR (fact (mult (S (S O)) n)))*(pow r (mult (S (S O)) n))``.
-Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``/(INR (fact (mult (S (S O)) k)))*(pow r (mult (S (S O)) k))``) n) l)).
-Intro; Elim X; Intros.
-Apply existTT with x.
-Split.
-Apply p.
-Intros; Rewrite H; Unfold Rdiv; Do 2 Rewrite Rabsolu_mult.
-Rewrite pow_1_abs; Rewrite Rmult_1l.
-Cut ``0</(INR (fact (mult (S (S O)) n)))``.
-Intro; Rewrite (Rabsolu_right  ? (Rle_sym1 ? ? (Rlt_le ? ? H1))).
-Apply Rle_monotony.
-Left; Apply H1.
-Rewrite <- Pow_Rabsolu; Apply pow_maj_Rabs.
-Rewrite Rabsolu_Rabsolu.
-Unfold Boule in H0; Rewrite minus_R0 in H0.
-Left; Apply H0.
-Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Apply Alembert_C2.
-Intro; Apply Rabsolu_no_R0.
-Apply prod_neq_R0.
-Apply Rinv_neq_R0.
-Apply INR_fact_neq_0.
-Apply pow_nonzero; Assumption.
-Assert H0 := Alembert_cos.
-Unfold cos_n in H0; Unfold Un_cv in H0; Unfold Un_cv; Intros.
-Cut ``0<eps/(Rsqr r)``.
-Intro; Elim (H0 ? H2); Intros N0 H3.
-Exists N0; Intros.
-Unfold R_dist; Assert H5 := (H3 ? H4).
-Unfold R_dist in H5; Replace ``(Rabsolu ((Rabsolu (/(INR (fact (mult (S (S O)) (S n))))*(pow r (mult (S (S O)) (S n)))))/(Rabsolu (/(INR (fact (mult (S (S O)) n)))*(pow r (mult (S (S O)) n))))))`` with ``(Rsqr r)*(Rabsolu ((pow ( -1) (S n))/(INR (fact (mult (S (S O)) (S n))))/((pow ( -1) n)/(INR (fact (mult (S (S O)) n))))))``.
-Apply Rlt_monotony_contra with ``/(Rsqr r)``.
-Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
-Pattern 1 ``/(Rsqr r)``; Replace ``/(Rsqr r)`` with ``(Rabsolu (/(Rsqr r)))``.
-Rewrite <- Rabsolu_mult; Rewrite Rminus_distr; Rewrite Rmult_Or; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Apply H5.
-Unfold Rsqr; Apply prod_neq_R0; Assumption.
-Rewrite Rabsolu_Rinv.
-Rewrite Rabsolu_right.
-Reflexivity.
-Apply Rle_sym1; Apply pos_Rsqr.
-Unfold Rsqr; Apply prod_neq_R0; Assumption.
-Rewrite (Rmult_sym (Rsqr r)); Unfold Rdiv; Repeat Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite pow_1_abs; Rewrite Rmult_1l; Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r.
-Rewrite Rabsolu_Rinv.
-Rewrite Rabsolu_mult; Rewrite (pow_1_abs n); Rewrite Rmult_1l; Rewrite <- Rabsolu_Rinv.
-Rewrite Rinv_Rinv.
-Rewrite Rinv_Rmult.
-Rewrite Rabsolu_Rinv.
-Rewrite Rinv_Rinv.
-Rewrite (Rmult_sym ``(Rabsolu (Rabsolu (pow r (mult (S (S O)) (S n)))))``); Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite Rmult_assoc; Apply Rmult_mult_r.
-Rewrite Rabsolu_Rinv.
-Do 2 Rewrite Rabsolu_Rabsolu; Repeat Rewrite Rabsolu_right.
-Replace ``(pow r (mult (S (S O)) (S n)))`` with ``(pow r (mult (S (S O)) n))*r*r``.
-Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Unfold Rsqr; Ring.
-Apply pow_nonzero; Assumption.
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
-Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply Rabsolu_no_R0; Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply Rabsolu_no_R0; Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply INR_fact_neq_0.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply prod_neq_R0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H1.
-Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
-Assert H0 := (cond_pos r); Red; Intro; Rewrite H1 in H0; Elim (Rlt_antirefl ? H0).
-Qed.
-
-(**********)
-Lemma continuity_cos : (continuity cos).
-Pose fn := [N:nat][x:R]``(pow (-1) N)/(INR (fact (mult (S (S O)) N)))*(pow x (mult (S (S O)) N))``.
-Cut (CVN_R fn).
-Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
-Intro cv; Cut ((n:nat)(continuity (fn n))).
-Intro; Cut (x:R)(cos x)==(SFL fn cv x).
-Intro; Cut (continuity (SFL fn cv))->(continuity cos).
-Intro; Apply H1.
-Apply SFL_continuity; Assumption.
-Unfold continuity; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Elim (H1 x ? H2); Intros.
-Exists x0; Intros.
-Elim H3; Intros.
-Split.
-Apply H4.
-Intros; Rewrite (H0 x); Rewrite (H0 x1); Apply H5; Apply H6.
-Intro; Unfold cos SFL.
-Case (cv x); Case (exist_cos (Rsqr x)); Intros.
-Symmetry; EApply UL_sequence.
-Apply u.
-Unfold cos_in in c; Unfold infinit_sum in c; Unfold Un_cv; Intros.
-Elim (c ? H0); Intros N0 H1.
-Exists N0; Intros.
-Unfold R_dist in H1; Unfold R_dist SP.
-Replace (sum_f_R0 [k:nat](fn k x) n) with (sum_f_R0 [i:nat]``(cos_n i)*(pow (Rsqr x) i)`` n).
-Apply H1; Assumption.
-Apply sum_eq; Intros.
-Unfold cos_n fn; Apply Rmult_mult_r.
-Unfold Rsqr; Rewrite pow_sqr; Reflexivity.
-Intro; Unfold fn; Replace [x:R]``(pow ( -1) n)/(INR (fact (mult (S (S O)) n)))*(pow x (mult (S (S O)) n))`` with (mult_fct (fct_cte ``(pow ( -1) n)/(INR (fact (mult (S (S O)) n)))``) (pow_fct (mult (S (S O)) n))); [Idtac | Reflexivity].
-Apply continuity_mult.
-Apply derivable_continuous; Apply derivable_const.
-Apply derivable_continuous; Apply (derivable_pow (mult (2) n)).
-Apply CVN_R_CVS; Apply X.
-Apply CVN_R_cos; Unfold fn; Reflexivity.
-Qed.
-
-(**********)
-Lemma continuity_sin : (continuity sin).
-Unfold continuity; Intro.
-Assert H0 := (continuity_cos ``PI/2-x``).
-Unfold continuity_pt in H0; Unfold continue_in in H0; Unfold limit1_in in H0; Unfold limit_in in H0; Simpl in H0; Unfold R_dist in H0; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Elim (H0 ? H); Intros.
-Exists x0; Intros.
-Elim H1; Intros.
-Split.
-Assumption.
-Intros; Rewrite <- (cos_shift x); Rewrite <- (cos_shift x1); Apply H3.
-Elim H4; Intros.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Red; Intro; Unfold D_x no_cond in H5; Elim H5; Intros _ H8; Elim H8; Rewrite <- (Ropp_Ropp x); Rewrite <- (Ropp_Ropp x1); Apply eq_Ropp; Apply r_Rplus_plus with ``PI/2``; Apply H7.
-Replace ``PI/2-x1-(PI/2-x)`` with ``x-x1``; [Idtac | Ring]; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply H6.
-Qed.
-
-Lemma CVN_R_sin : (fn:nat->R->R) (fn == [N:nat][x:R]``(pow ( -1) N)/(INR (fact (plus (mult (S (S O)) N) (S O))))*(pow x (mult (S (S O)) N))``) -> (CVN_R fn).
-Unfold CVN_R; Unfold CVN_r; Intros fn H r.
-Apply Specif.existT with [n:nat]``/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow r (mult (S (S O)) n))``.
-Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow r (mult (S (S O)) k))``) n) l)).
-Intro; Elim X; Intros.
-Apply existTT with x.
-Split.
-Apply p.
-Intros; Rewrite H; Unfold Rdiv; Do 2 Rewrite Rabsolu_mult; Rewrite pow_1_abs; Rewrite Rmult_1l.
-Cut ``0</(INR (fact (plus (mult (S (S O)) n) (S O))))``.
-Intro; Rewrite (Rabsolu_right  ? (Rle_sym1 ? ? (Rlt_le ? ? H1))).
-Apply Rle_monotony.
-Left; Apply H1.
-Rewrite <- Pow_Rabsolu; Apply pow_maj_Rabs.
-Rewrite Rabsolu_Rabsolu; Unfold Boule in H0; Rewrite minus_R0 in H0; Left; Apply H0.
-Apply Rlt_Rinv; Apply INR_fact_lt_0.
-Cut (r::R)<>``0``.
-Intro; Apply Alembert_C2.
-Intro; Apply Rabsolu_no_R0.
-Apply prod_neq_R0.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply pow_nonzero; Assumption.
-Assert H1 := Alembert_sin.
-Unfold sin_n in H1; Unfold Un_cv in H1; Unfold Un_cv; Intros.
-Cut ``0<eps/(Rsqr r)``.
-Intro; Elim (H1 ? H3); Intros N0 H4.
-Exists N0; Intros.
-Unfold R_dist; Assert H6 := (H4 ? H5).
-Unfold R_dist in H5; Replace ``(Rabsolu ((Rabsolu (/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))*(pow r (mult (S (S O)) (S n)))))/(Rabsolu (/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow r (mult (S (S O)) n))))))`` with ``(Rsqr r)*(Rabsolu ((pow ( -1) (S n))/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))/((pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O)))))))``.
-Apply Rlt_monotony_contra with ``/(Rsqr r)``.
-Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
-Pattern 1 ``/(Rsqr r)``; Rewrite <- (Rabsolu_right ``/(Rsqr r)``).
-Rewrite <- Rabsolu_mult.
-Rewrite Rminus_distr.
-Rewrite Rmult_Or; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps).
-Apply H6.
-Unfold Rsqr; Apply prod_neq_R0; Assumption.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
-Unfold Rdiv; Rewrite (Rmult_sym (Rsqr r)); Repeat Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite pow_1_abs.
-Rewrite Rmult_1l.
-Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r.
-Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rinv.
-Rewrite pow_1_abs; Rewrite Rinv_R1; Rewrite Rmult_1l.
-Rewrite Rinv_Rmult.
-Rewrite <- Rabsolu_Rinv.
-Rewrite Rinv_Rinv.
-Rewrite Rabsolu_mult.
-Do 2 Rewrite Rabsolu_Rabsolu.
-Rewrite (Rmult_sym ``(Rabsolu (pow r (mult (S (S O)) (S n))))``).
-Rewrite Rmult_assoc; Apply Rmult_mult_r.
-Rewrite Rabsolu_Rinv.
-Rewrite Rabsolu_Rabsolu.
-Repeat Rewrite Rabsolu_right.
-Replace ``(pow r (mult (S (S O)) (S n)))`` with ``(pow r (mult (S (S O)) n))*r*r``.
-Do 2 Rewrite <- Rmult_assoc.
-Rewrite <- Rinv_l_sym.
-Unfold Rsqr; Ring.
-Apply pow_nonzero; Assumption.
-Replace (mult (2) (S n)) with (S (S (mult (2) n))).
-Simpl; Ring.
-Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
-Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
-Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply INR_fact_neq_0.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply Rabsolu_no_R0; Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
-Apply pow_nonzero; DiscrR.
-Apply INR_fact_neq_0.
-Apply pow_nonzero; DiscrR.
-Apply Rinv_neq_R0; Apply INR_fact_neq_0.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption].
-Assert H0 := (cond_pos r); Red; Intro; Rewrite H1 in H0; Elim (Rlt_antirefl ? H0).
-Qed.
-
-(* (sin h)/h -> 1 when h -> 0 *)
-Lemma derivable_pt_lim_sin_0 : (derivable_pt_lim sin R0 R1).
-Unfold derivable_pt_lim; Intros.
-Pose fn := [N:nat][x:R]``(pow ( -1) N)/(INR (fact (plus (mult (S (S O)) N) (S O))))*(pow x (mult (S (S O)) N))``.
-Cut (CVN_R fn).
-Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
-Intro cv.
-Pose r := (mkposreal ? Rlt_R0_R1).
-Cut (CVN_r fn r).
-Intro; Cut ((n:nat; y:R)(Boule ``0`` r y)->(continuity_pt (fn n) y)).
-Intro; Cut (Boule R0 r R0).
-Intro; Assert H2 := (SFL_continuity_pt ? cv ? X0 H0 ? H1).
-Unfold continuity_pt in H2; Unfold continue_in in H2; Unfold limit1_in in H2; Unfold limit_in in H2; Simpl in H2; Unfold R_dist in H2.
-Elim (H2 ? H); Intros alp H3.
-Elim H3; Intros.
-Exists (mkposreal ? H4).
-Simpl; Intros.
-Rewrite sin_0; Rewrite Rplus_Ol; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
-Cut ``(Rabsolu ((SFL fn cv h)-(SFL fn cv 0))) < eps``.
-Intro; Cut (SFL fn cv R0)==R1.
-Intro; Cut (SFL fn cv h)==``(sin h)/h``.
-Intro; Rewrite H9 in H8; Rewrite H10 in H8.
-Apply H8.
-Unfold SFL sin.
-Case (cv h); Intros.
-Case (exist_sin (Rsqr h)); Intros.
-Unfold Rdiv; Rewrite (Rinv_r_simpl_m h x0 H6).
-EApply UL_sequence.
-Apply u.
-Unfold sin_in in s; Unfold sin_n infinit_sum in s; Unfold SP fn Un_cv; Intros.
-Elim (s ? H10); Intros N0 H11.
-Exists N0; Intros.
-Unfold R_dist; Unfold R_dist in H11.
-Replace (sum_f_R0 [k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow h (mult (S (S O)) k))`` n) with (sum_f_R0 [i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (Rsqr h) i)`` n).
-Apply H11; Assumption.
-Apply sum_eq; Intros; Apply Rmult_mult_r; Unfold Rsqr; Rewrite pow_sqr; Reflexivity.
-Unfold SFL sin.
-Case (cv R0); Intros.
-EApply UL_sequence.
-Apply u.
-Unfold SP fn; Unfold Un_cv; Intros; Exists (S O); Intros.
-Unfold R_dist; Replace (sum_f_R0 [k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow 0 (mult (S (S O)) k))`` n) with R1.
-Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
-Rewrite decomp_sum.
-Simpl; Rewrite Rmult_1r; Unfold Rdiv; Rewrite Rinv_R1; Rewrite Rmult_1r; Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rplus_plus_r.
-Symmetry; Apply sum_eq_R0; Intros.
-Rewrite Rmult_Ol; Rewrite Rmult_Or; Reflexivity.
-Unfold ge in H10; Apply lt_le_trans with (1); [Apply lt_n_Sn | Apply H10].
-Apply H5.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply not_sym; Apply H6.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply H7.
-Unfold Boule; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_R0; Apply (cond_pos r).
-Intros; Unfold fn; Replace [x:R]``(pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow x (mult (S (S O)) n))`` with (mult_fct (fct_cte ``(pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))``) (pow_fct (mult (S (S O)) n))); [Idtac | Reflexivity].
-Apply continuity_pt_mult.
-Apply derivable_continuous_pt.
-Apply derivable_pt_const.
-Apply derivable_continuous_pt.
-Apply (derivable_pt_pow (mult (2) n) y).
-Apply (X r).
-Apply (CVN_R_CVS ? X).
-Apply CVN_R_sin; Unfold fn; Reflexivity.
-Qed.
-
-(* ((cos h)-1)/h -> 0 when h -> 0 *)
-Lemma derivable_pt_lim_cos_0 : (derivable_pt_lim cos ``0`` ``0``).
-Unfold derivable_pt_lim; Intros.
-Assert H0 := derivable_pt_lim_sin_0.
-Unfold derivable_pt_lim in H0.
-Cut ``0<eps/2``.
-Intro; Elim (H0 ? H1); Intros del H2.
-Cut (continuity_pt sin ``0``).
-Intro; Unfold continuity_pt in H3; Unfold continue_in in H3; Unfold limit1_in in H3; Unfold limit_in in H3; Simpl in H3; Unfold R_dist in H3.
-Cut ``0<eps/2``; [Intro | Assumption].
-Elim (H3 ? H4); Intros del_c H5.
-Cut ``0<(Rmin del del_c)``.
-Intro; Pose delta := (mkposreal ? H6).
-Exists delta; Intros.
-Rewrite Rplus_Ol; Replace ``((cos h)-(cos 0))`` with ``-2*(Rsqr (sin (h/2)))``.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
-Unfold Rdiv; Do 2 Rewrite Ropp_mul1.
-Rewrite Rabsolu_Ropp.
-Replace ``2*(Rsqr (sin (h*/2)))*/h`` with ``(sin (h/2))*((sin (h/2))/(h/2)-1)+(sin (h/2))``.
-Apply Rle_lt_trans with ``(Rabsolu ((sin (h/2))*((sin (h/2))/(h/2)-1)))+(Rabsolu ((sin (h/2))))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply Rle_lt_trans with ``(Rabsolu ((sin (h/2))/(h/2)-1))``.
-Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu ((sin (h/2))/(h/2)-1))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
-Apply Rabsolu_pos.
-Assert H9 := (SIN_bound ``h/2``).
-Unfold Rabsolu; Case (case_Rabsolu ``(sin (h/2))``); Intro.
-Pattern 3 R1; Rewrite <- (Ropp_Ropp ``1``).
-Apply Rle_Ropp1.
-Elim H9; Intros; Assumption.
-Elim H9; Intros; Assumption.
-Cut ``(Rabsolu (h/2))<del``.
-Intro; Cut ``h/2<>0``.
-Intro; Assert H11 := (H2 ? H10 H9). 
-Rewrite Rplus_Ol in H11; Rewrite sin_0 in H11.
-Rewrite minus_R0 in H11; Apply H11.
-Unfold Rdiv; Apply prod_neq_R0.
-Apply H7.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rlt_trans with ``del/2``.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Rewrite (Rabsolu_right ``/2``).
-Do 2 Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_le_trans with (pos delta).
-Apply H8.
-Unfold delta; Simpl; Apply Rmin_l.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Sup0.
-Rewrite <- (Rplus_Or ``del/2``); Pattern 1 del; Rewrite (double_var del); Apply Rlt_compatibility; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply (cond_pos del).
-Apply Rlt_Rinv; Sup0.
-Elim H5; Intros; Assert H11 := (H10 ``h/2``).
-Rewrite sin_0 in H11; Do 2 Rewrite minus_R0 in H11.
-Apply H11.
-Split.
-Unfold D_x no_cond; Split.
-Trivial.
-Apply not_sym; Unfold Rdiv; Apply prod_neq_R0.
-Apply H7.
-Apply Rinv_neq_R0; DiscrR.
-Apply Rlt_trans with ``del_c/2``.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Rewrite (Rabsolu_right ``/2``).
-Do 2 Rewrite <- (Rmult_sym ``/2``).
-Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_le_trans with (pos delta).
-Apply H8.
-Unfold delta; Simpl; Apply Rmin_r.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Sup0.
-Rewrite <- (Rplus_Or ``del_c/2``); Pattern 2 del_c; Rewrite (double_var del_c); Apply Rlt_compatibility.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H9.
-Apply Rlt_Rinv; Sup0.
-Rewrite Rminus_distr; Rewrite Rmult_1r; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Rewrite (Rmult_sym ``2``); Unfold Rdiv Rsqr.
-Repeat Rewrite Rmult_assoc.
-Repeat Apply Rmult_mult_r.
-Rewrite Rinv_Rmult.
-Rewrite Rinv_Rinv.
-Apply Rmult_sym.
-DiscrR.
-Apply H7.
-Apply Rinv_neq_R0; DiscrR.
-Pattern 2 h; Replace h with ``2*(h/2)``.
-Rewrite (cos_2a_sin ``h/2``).
-Rewrite cos_0; Unfold Rsqr; Ring.
-Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
-DiscrR.
-Unfold Rmin; Case (total_order_Rle del del_c); Intro.
-Apply (cond_pos del).
-Elim H5; Intros; Assumption.
-Apply continuity_sin.
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
-Qed.
-
-(**********)
-Theorem derivable_pt_lim_sin : (x:R)(derivable_pt_lim sin x (cos x)).
-Intro; Assert H0 := derivable_pt_lim_sin_0.
-Assert H := derivable_pt_lim_cos_0.
-Unfold derivable_pt_lim in H0 H.
-Unfold derivable_pt_lim; Intros.
-Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Apply H1 | Apply Rlt_Rinv; Sup0]].
-Elim (H0 ? H2); Intros alp1 H3.
-Elim (H ? H2); Intros alp2 H4.
-Pose alp := (Rmin alp1 alp2).
-Cut ``0<alp``.
-Intro; Exists (mkposreal ? H5); Intros.
-Replace ``((sin (x+h))-(sin x))/h-(cos x)`` with ``(sin x)*((cos h)-1)/h+(cos x)*((sin h)/h-1)``.
-Apply Rle_lt_trans with ``(Rabsolu ((sin x)*((cos h)-1)/h))+(Rabsolu ((cos x)*((sin h)/h-1)))``.
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Apply Rle_lt_trans with ``(Rabsolu ((cos h)-1)/h)``.
-Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu (((cos h)-1)/h))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
-Apply Rabsolu_pos.
-Assert H8 := (SIN_bound x); Elim H8; Intros.
-Unfold Rabsolu; Case (case_Rabsolu (sin x)); Intro.
-Rewrite <- (Ropp_Ropp R1).
-Apply Rle_Ropp1; Assumption.
-Assumption.
-Cut ``(Rabsolu h)<alp2``.
-Intro; Assert H9 := (H4 ? H6 H8).
-Rewrite cos_0 in H9; Rewrite Rplus_Ol in H9; Rewrite minus_R0 in H9; Apply H9.
-Apply Rlt_le_trans with alp.
-Apply H7.
-Unfold alp; Apply Rmin_r.
-Apply Rle_lt_trans with ``(Rabsolu ((sin h)/h-1))``.
-Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu ((sin h)/h-1))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
-Apply Rabsolu_pos.
-Assert H8 := (COS_bound x); Elim H8; Intros.
-Unfold Rabsolu; Case (case_Rabsolu (cos x)); Intro.
-Rewrite <- (Ropp_Ropp R1); Apply Rle_Ropp1; Assumption.
-Assumption.
-Cut ``(Rabsolu h)<alp1``.
-Intro; Assert H9 := (H3 ? H6 H8).
-Rewrite sin_0 in H9; Rewrite Rplus_Ol in H9; Rewrite minus_R0 in H9; Apply H9.
-Apply Rlt_le_trans with alp.
-Apply H7.
-Unfold alp; Apply Rmin_l.
-Rewrite sin_plus; Unfold Rminus Rdiv; Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; Repeat Rewrite Rmult_assoc; Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Rewrite (Rplus_sym ``(sin x)*( -1*/h)``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
-Rewrite Ropp_mul3; Rewrite Ropp_mul1; Rewrite Rmult_1r; Rewrite Rmult_1l; Rewrite Ropp_mul3; Rewrite <- Ropp_mul1; Apply Rplus_sym.
-Unfold alp; Unfold Rmin; Case (total_order_Rle alp1 alp2); Intro.
-Apply (cond_pos alp1).
-Apply (cond_pos alp2).
-Qed.
-
-Lemma derivable_pt_lim_cos : (x:R) (derivable_pt_lim cos x ``-(sin x)``).
-Intro; Cut (h:R)``(sin (h+PI/2))``==(cos h).
-Intro; Replace ``-(sin x)`` with (Rmult (cos ``x+PI/2``) (Rplus R1 R0)).
-Generalize (derivable_pt_lim_comp (plus_fct id (fct_cte ``PI/2``)) sin); Intros.
-Cut (derivable_pt_lim (plus_fct id (fct_cte ``PI/2``)) x ``1+0``).
-Cut (derivable_pt_lim sin (plus_fct id (fct_cte ``PI/2``) x) ``(cos (x+PI/2))``).
-Intros; Generalize (H0 ? ? ? H2 H1); Replace (comp sin (plus_fct id (fct_cte ``PI/2``))) with [x:R]``(sin (x+PI/2))``; [Idtac | Reflexivity].
-Unfold derivable_pt_lim; Intros.
-Elim (H3 eps H4); Intros.
-Exists x0.
-Intros; Rewrite <- (H ``x+h``); Rewrite <- (H x); Apply H5; Assumption.
-Apply derivable_pt_lim_sin.
-Apply derivable_pt_lim_plus.
-Apply derivable_pt_lim_id.
-Apply derivable_pt_lim_const.
-Rewrite sin_cos; Rewrite <- (Rplus_sym x); Ring.
-Intro; Rewrite cos_sin; Rewrite Rplus_sym; Reflexivity.
-Qed.
-
-Lemma derivable_pt_sin : (x:R) (derivable_pt sin x).
-Unfold derivable_pt; Intro.
-Apply Specif.existT with (cos x).
-Apply derivable_pt_lim_sin.
-Qed.
-
-Lemma derivable_pt_cos : (x:R) (derivable_pt cos x).
-Unfold derivable_pt; Intro.
-Apply Specif.existT with ``-(sin x)``.
-Apply derivable_pt_lim_cos.
-Qed.
-
-Lemma derivable_sin : (derivable sin).
-Unfold derivable; Intro; Apply derivable_pt_sin.
-Qed.
-
-Lemma derivable_cos : (derivable cos).
-Unfold derivable; Intro; Apply derivable_pt_cos.
-Qed.
-
-Lemma derive_pt_sin : (x:R) ``(derive_pt sin x (derivable_pt_sin ?))==(cos x)``.
-Intros; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_sin.
-Qed.
-
-Lemma derive_pt_cos : (x:R) ``(derive_pt cos x (derivable_pt_cos ?))==-(sin x)``.
-Intros; Apply derive_pt_eq_0.
-Apply derivable_pt_lim_cos.
-Qed.
diff --git a/theories7/Reals/SeqProp.v b/theories7/Reals/SeqProp.v
deleted file mode 100644
index b34fa339..00000000
--- a/theories7/Reals/SeqProp.v
+++ /dev/null
@@ -1,1089 +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: SeqProp.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Rseries.
-Require Classical.
-Require Max.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-Definition Un_decreasing [Un:nat->R] : Prop := (n:nat) (Rle (Un (S n)) (Un n)).
-Definition opp_seq [Un:nat->R] : nat->R := [n:nat]``-(Un n)``.
-Definition has_ub [Un:nat->R] : Prop := (bound (EUn Un)).
-Definition has_lb [Un:nat->R] : Prop := (bound (EUn (opp_seq Un))).
-
-(**********)
-Lemma growing_cv : (Un:nat->R) (Un_growing Un) -> (has_ub Un) -> (sigTT R [l:R](Un_cv Un l)).
-Unfold Un_growing Un_cv;Intros; 
- NewDestruct (complet (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]].
- Exists x;Intros eps H1.
- Unfold is_upper_bound in H2 H3.
-Assert H5:(n:nat)(Rle (Un n) x).
-  Intro n; Apply (H2 (Un n) (Un_in_EUn Un n)).
-Cut (Ex [N:nat] (Rlt (Rminus x eps) (Un N))).
-Intro H6;NewDestruct H6 as [N H6];Exists N.
-Intros n H7;Unfold R_dist;Apply (Rabsolu_def1 (Rminus (Un n) x) eps).
-Unfold Rgt in H1.
- Apply (Rle_lt_trans (Rminus (Un n) x) R0 eps
-                     (Rle_minus (Un n) x (H5 n)) H1).
-Fold Un_growing in H;Generalize (growing_prop Un n N H H7);Intro H8.
- Generalize (Rlt_le_trans (Rminus x eps) (Un N) (Un n) H6
-                          (Rle_sym2 (Un N) (Un n) H8));Intro H9;
- Generalize (Rlt_compatibility (Ropp x) (Rminus x eps) (Un n) H9);
- Unfold Rminus;Rewrite <-(Rplus_assoc (Ropp x) x (Ropp eps));
- Rewrite (Rplus_sym (Ropp x) (Un n));Fold (Rminus (Un n) x);
- Rewrite Rplus_Ropp_l;Rewrite (let (H1,H2)=(Rplus_ne (Ropp eps)) in H2);
- Trivial.
-Cut ~((N:nat)(Rle (Un N) (Rminus x eps))).
-Intro H6;Apply (not_all_not_ex nat ([N:nat](Rlt (Rminus x eps) (Un N)))).
- Intro H7; Apply H6; Intro N; Apply Rnot_lt_le; Apply H7.
-Intro H7;Generalize (Un_bound_imp Un (Rminus x eps) H7);Intro H8;
- Unfold is_upper_bound in H8;Generalize (H3 (Rminus x eps) H8);
- Apply Rlt_le_not; Apply tech_Rgt_minus; Exact H1.
-Qed.
-
-Lemma decreasing_growing : (Un:nat->R) (Un_decreasing Un) -> (Un_growing (opp_seq Un)).
-Intro.
-Unfold Un_growing opp_seq Un_decreasing.
-Intros.
-Apply Rle_Ropp1.
-Apply H.
-Qed.
-
-Lemma decreasing_cv : (Un:nat->R) (Un_decreasing Un) -> (has_lb Un) -> (sigTT R [l:R](Un_cv Un l)).
-Intros.
-Cut (sigTT R [l:R](Un_cv (opp_seq Un) l)) -> (sigTT R [l:R](Un_cv Un l)).
-Intro.
-Apply X.
-Apply growing_cv.
-Apply decreasing_growing; Assumption.
-Exact H0.
-Intro.
-Elim X; Intros.
-Apply existTT with ``-x``.
-Unfold Un_cv in p.
-Unfold R_dist in p.
-Unfold opp_seq in p.
-Unfold Un_cv.
-Unfold R_dist.
-Intros.
-Elim (p eps H1); Intros.
-Exists x0; Intros.
-Assert H4 := (H2 n H3).
-Rewrite <- Rabsolu_Ropp.
-Replace ``-((Un n)- -x)`` with ``-(Un n)-x``; [Assumption | Ring].
-Qed.
-
-(***********)
-Lemma maj_sup : (Un:nat->R) (has_ub Un) -> (sigTT R [l:R](is_lub (EUn Un) l)).
-Intros.
-Unfold has_ub in H.
-Apply complet.
-Assumption.
-Exists (Un O).
-Unfold EUn.
-Exists O; Reflexivity.
-Qed.
-
-(**********)
-Lemma min_inf : (Un:nat->R) (has_lb Un) -> (sigTT R [l:R](is_lub (EUn (opp_seq Un)) l)).
-Intros; Unfold has_lb in H.
-Apply complet.
-Assumption.
-Exists ``-(Un O)``.
-Exists O.
-Reflexivity.
-Qed.
-
-Definition majorant [Un:nat->R;pr:(has_ub Un)] : R := Cases (maj_sup Un pr) of (existTT a b) => a end.
-
-Definition minorant [Un:nat->R;pr:(has_lb Un)] : R := Cases (min_inf Un pr) of (existTT a b) => ``-a`` end.
-
-Lemma maj_ss : (Un:nat->R;k:nat) (has_ub Un) -> (has_ub [i:nat](Un (plus k i))).
-Intros.
-Unfold has_ub in H.
-Unfold bound in H.
-Elim H; Intros.
-Unfold is_upper_bound in H0.
-Unfold has_ub.
-Exists x.
-Unfold is_upper_bound.
-Intros.
-Apply H0.
-Elim H1; Intros.
-Exists (plus k x1); Assumption.
-Qed.
-
-Lemma min_ss : (Un:nat->R;k:nat) (has_lb Un) -> (has_lb [i:nat](Un (plus k i))).
-Intros.
-Unfold has_lb in H.
-Unfold bound in H.
-Elim H; Intros.
-Unfold is_upper_bound in H0.
-Unfold has_lb.
-Exists x.
-Unfold is_upper_bound.
-Intros.
-Apply H0.
-Elim H1; Intros.
-Exists (plus k x1); Assumption.
-Qed.
-
-Definition sequence_majorant [Un:nat->R;pr:(has_ub Un)] : nat -> R := [i:nat](majorant [k:nat](Un (plus i k)) (maj_ss Un i pr)).
-
-Definition sequence_minorant [Un:nat->R;pr:(has_lb Un)] : nat -> R := [i:nat](minorant [k:nat](Un (plus i k)) (min_ss Un i pr)).
-
-Lemma Wn_decreasing : (Un:nat->R;pr:(has_ub Un)) (Un_decreasing (sequence_majorant Un pr)). 
-Intros.
-Unfold Un_decreasing.
-Intro.
-Unfold sequence_majorant.
-Assert H := (maj_sup [k:nat](Un (plus (S n) k)) (maj_ss Un (S n) pr)).
-Assert H0 := (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr)).
-Elim H; Intros.
-Elim H0; Intros.
-Cut (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr)) == x; [Intro Maj1; Rewrite Maj1 | Idtac].
-Cut (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr)) == x0; [Intro Maj2; Rewrite Maj2 | Idtac].
-Unfold is_lub in p.
-Unfold is_lub in p0.
-Elim p; Intros.
-Apply H2.
-Elim p0; Intros.
-Unfold is_upper_bound.
-Intros.
-Unfold is_upper_bound in H3.
-Apply H3.
-Elim H5; Intros.
-Exists (plus (1) x2).
-Replace (plus n (plus (S O) x2)) with (plus (S n) x2).
-Assumption.
-Replace (S n) with (plus (1) n); [Ring | Ring].
-Cut (is_lub (EUn [k:nat](Un (plus n k))) (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr))).
-Intro.
-Unfold is_lub in p0; Unfold is_lub in H1.
-Elim p0; Intros; Elim H1; Intros.
-Assert H6 := (H5 x0 H2).
-Assert H7 := (H3 (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr)) H4).
-Apply Rle_antisym; Assumption.
-Unfold majorant.
-Case (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr)).
-Trivial.
-Cut (is_lub (EUn [k:nat](Un (plus (S n) k))) (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr))).
-Intro.
-Unfold is_lub in p; Unfold is_lub in H1.
-Elim p; Intros; Elim H1; Intros.
-Assert H6 := (H5 x H2).
-Assert H7 := (H3 (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr)) H4).
-Apply Rle_antisym; Assumption.
-Unfold majorant.
-Case (maj_sup [k:nat](Un (plus (S n) k)) (maj_ss Un (S n) pr)).
-Trivial.
-Qed.
-
-Lemma Vn_growing : (Un:nat->R;pr:(has_lb Un)) (Un_growing (sequence_minorant Un pr)).
-Intros.
-Unfold Un_growing.
-Intro.
-Unfold sequence_minorant.
-Assert H := (min_inf [k:nat](Un (plus (S n) k)) (min_ss Un (S n) pr)).
-Assert H0 := (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr)).
-Elim H; Intros.
-Elim H0; Intros.
-Cut (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr)) == ``-x``; [Intro Maj1; Rewrite Maj1 | Idtac].
-Cut (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr)) == ``-x0``; [Intro Maj2; Rewrite Maj2 | Idtac].
-Unfold is_lub in p.
-Unfold is_lub in p0.
-Elim p; Intros.
-Apply Rle_Ropp1.
-Apply H2.
-Elim p0; Intros.
-Unfold is_upper_bound.
-Intros.
-Unfold is_upper_bound in H3.
-Apply H3.
-Elim H5; Intros.
-Exists (plus (1) x2).
-Unfold opp_seq in H6.
-Unfold opp_seq.
-Replace (plus n (plus (S O) x2)) with (plus (S n) x2).
-Assumption.
-Replace (S n) with (plus (1) n); [Ring | Ring].
-Cut (is_lub (EUn (opp_seq [k:nat](Un (plus n k)))) (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr)))).
-Intro.
-Unfold is_lub in p0; Unfold is_lub in H1.
-Elim p0; Intros; Elim H1; Intros.
-Assert H6 := (H5 x0 H2).
-Assert H7 := (H3 (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr))) H4).
-Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr))).
-Apply eq_Ropp; Apply Rle_antisym; Assumption.
-Unfold minorant.
-Case (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr)).
-Intro; Rewrite Ropp_Ropp.
-Trivial.
-Cut (is_lub (EUn (opp_seq [k:nat](Un (plus (S n) k)))) (Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr)))).
-Intro.
-Unfold is_lub in p; Unfold is_lub in H1.
-Elim p; Intros; Elim H1; Intros.
-Assert H6 := (H5 x H2).
-Assert H7 := (H3 (Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr))) H4).
-Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr))).
-Apply eq_Ropp; Apply Rle_antisym; Assumption.
-Unfold minorant.
-Case (min_inf [k:nat](Un (plus (S n) k)) (min_ss Un (S n) pr)).
-Intro; Rewrite Ropp_Ropp.
-Trivial.
-Qed.
-
-(**********)
-Lemma Vn_Un_Wn_order : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (n:nat) ``((sequence_minorant Un pr2) n)<=(Un n)<=((sequence_majorant Un pr1) n)``. 
-Intros.
-Split.
-Unfold sequence_minorant.
-Cut (sigTT R [l:R](is_lub (EUn (opp_seq [i:nat](Un (plus n i)))) l)).
-Intro.
-Elim X; Intros.
-Replace (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2)) with ``-x``.
-Unfold is_lub in p.
-Elim p; Intros.
-Unfold is_upper_bound in H.
-Rewrite <- (Ropp_Ropp (Un n)).
-Apply Rle_Ropp1.
-Apply H.
-Exists O.
-Unfold opp_seq.
-Replace (plus n O) with n; [Reflexivity | Ring].
-Cut (is_lub (EUn (opp_seq [k:nat](Un (plus n k)))) (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2)))).
-Intro.
-Unfold is_lub in p; Unfold is_lub in H.
-Elim p; Intros; Elim H; Intros.
-Assert H4 := (H3 x H0).
-Assert H5 := (H1 (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2))) H2).
-Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2))).
-Apply eq_Ropp; Apply Rle_antisym; Assumption.
-Unfold minorant.
-Case (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr2)).
-Intro; Rewrite Ropp_Ropp.
-Trivial.
-Apply min_inf.
-Apply min_ss; Assumption.
-Unfold sequence_majorant.
-Cut (sigTT R [l:R](is_lub (EUn [i:nat](Un (plus n i))) l)).
-Intro.
-Elim X; Intros.
-Replace (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1)) with ``x``.
-Unfold is_lub in p.
-Elim p; Intros.
-Unfold is_upper_bound in H.
-Apply H.
-Exists O.
-Replace (plus n O) with n; [Reflexivity | Ring].
-Cut (is_lub (EUn [k:nat](Un (plus n k))) (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1))).
-Intro.
-Unfold is_lub in p; Unfold is_lub in H.
-Elim p; Intros; Elim H; Intros.
-Assert H4 := (H3 x H0).
-Assert H5 := (H1 (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1)) H2).
-Apply Rle_antisym; Assumption.
-Unfold majorant.
-Case (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr1)).
-Intro; Trivial.
-Apply maj_sup.
-Apply maj_ss; Assumption.
-Qed.
-
-Lemma min_maj : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (has_ub (sequence_minorant Un pr2)).
-Intros.
-Assert H := (Vn_Un_Wn_order Un pr1 pr2).
-Unfold has_ub.
-Unfold bound.
-Unfold has_ub in pr1.
-Unfold bound in pr1.
-Elim pr1; Intros.
-Exists x.
-Unfold is_upper_bound.
-Intros.
-Unfold is_upper_bound in H0.
-Elim H1; Intros.
-Rewrite H2.
-Apply Rle_trans with (Un x1).
-Assert H3 := (H x1); Elim H3; Intros; Assumption.
-Apply H0.
-Exists x1; Reflexivity.
-Qed.
-
-Lemma maj_min : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (has_lb (sequence_majorant Un pr1)). 
-Intros.
-Assert H := (Vn_Un_Wn_order Un pr1 pr2).
-Unfold has_lb.
-Unfold bound.
-Unfold has_lb in pr2.
-Unfold bound in pr2.
-Elim pr2; Intros.
-Exists x.
-Unfold is_upper_bound.
-Intros.
-Unfold is_upper_bound in H0.
-Elim H1; Intros.
-Rewrite H2.
-Apply Rle_trans with ((opp_seq Un) x1).
-Assert H3 := (H x1); Elim H3; Intros.
-Unfold opp_seq; Apply Rle_Ropp1.
-Assumption.
-Apply H0.
-Exists x1; Reflexivity.
-Qed.
-
-(**********)
-Lemma cauchy_maj : (Un:nat->R) (Cauchy_crit Un) -> (has_ub Un).
-Intros.
-Unfold has_ub.
-Apply cauchy_bound.
-Assumption.
-Qed.
-
-(**********)
-Lemma cauchy_opp : (Un:nat->R) (Cauchy_crit Un) -> (Cauchy_crit (opp_seq Un)).
-Intro.
-Unfold Cauchy_crit.
-Unfold R_dist.
-Intros.
-Elim (H eps H0); Intros.
-Exists x; Intros.
-Unfold opp_seq.
-Rewrite <- Rabsolu_Ropp.
-Replace ``-( -(Un n)- -(Un m))`` with ``(Un n)-(Un m)``; [Apply H1; Assumption | Ring].
-Qed.
-
-(**********)
-Lemma cauchy_min : (Un:nat->R) (Cauchy_crit Un) -> (has_lb Un).
-Intros.
-Unfold has_lb.
-Assert H0 := (cauchy_opp ? H).
-Apply cauchy_bound.
-Assumption.
-Qed.
-
-(**********)
-Lemma maj_cv : (Un:nat->R;pr:(Cauchy_crit Un)) (sigTT R [l:R](Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l)).
-Intros.
-Apply decreasing_cv.
-Apply Wn_decreasing.
-Apply maj_min.
-Apply cauchy_min.
-Assumption.
-Qed.
-
-(**********)
-Lemma min_cv : (Un:nat->R;pr:(Cauchy_crit Un)) (sigTT R [l:R](Un_cv (sequence_minorant Un (cauchy_min Un pr)) l)).
-Intros.
-Apply growing_cv.
-Apply Vn_growing.
-Apply min_maj.
-Apply cauchy_maj.
-Assumption.
-Qed.
-
-Lemma cond_eq : (x,y:R) ((eps:R)``0<eps``->``(Rabsolu (x-y))<eps``) -> x==y.
-Intros.
-Case (total_order_T x y); Intro.
-Elim s; Intro.
-Cut ``0<y-x``.
-Intro.
-Assert H1 := (H ``y-x`` H0).
-Rewrite <- Rabsolu_Ropp in H1.
-Cut ``-(x-y)==y-x``; [Intro; Rewrite H2 in H1 | Ring].
-Rewrite Rabsolu_right in H1.
-Elim (Rlt_antirefl ? H1).
-Left; Assumption.
-Apply Rlt_anti_compatibility with x.
-Rewrite Rplus_Or; Replace ``x+(y-x)`` with y; [Assumption | Ring].
-Assumption.
-Cut ``0<x-y``.
-Intro.
-Assert H1 := (H ``x-y`` H0).
-Rewrite Rabsolu_right in H1.
-Elim (Rlt_antirefl ? H1).
-Left; Assumption.
-Apply Rlt_anti_compatibility with y.
-Rewrite Rplus_Or; Replace ``y+(x-y)`` with x; [Assumption | Ring].
-Qed.
-
-Lemma not_Rlt : (r1,r2:R)~(``r1<r2``)->``r1>=r2``.
-Intros r1 r2 ; Generalize (total_order r1 r2) ; Unfold Rge.
-Tauto.
-Qed. 
-
-(**********)
-Lemma approx_maj : (Un:nat->R;pr:(has_ub Un)) (eps:R) ``0<eps`` -> (EX k : nat | ``(Rabsolu ((majorant Un pr)-(Un k))) < eps``).
-Intros.
-Pose P := [k:nat]``(Rabsolu ((majorant Un pr)-(Un k))) < eps``.
-Unfold P.
-Cut (EX k:nat | (P k)) -> (EX k:nat | ``(Rabsolu ((majorant Un pr)-(Un k))) < eps``).
-Intros.
-Apply H0.
-Apply not_all_not_ex.
-Red; Intro.
-2:Unfold P; Trivial.
-Unfold P in H1.
-Cut (n:nat)``(Rabsolu ((majorant Un pr)-(Un n))) >= eps``.
-Intro.
-Cut (is_lub (EUn Un) (majorant Un pr)).
-Intro.
-Unfold is_lub in H3.
-Unfold is_upper_bound in H3.
-Elim H3; Intros.
-Cut (n:nat)``eps<=(majorant Un pr)-(Un n)``.
-Intro.
-Cut (n:nat)``(Un n)<=(majorant Un pr)-eps``.
-Intro.
-Cut ((x:R)(EUn Un x)->``x <= (majorant Un pr)-eps``).
-Intro.
-Assert H9 := (H5 ``(majorant Un pr)-eps`` H8).
-Cut ``eps<=0``.
-Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H H10)).
-Apply Rle_anti_compatibility with ``(majorant Un pr)-eps``.
-Rewrite Rplus_Or.
-Replace ``(majorant Un pr)-eps+eps`` with (majorant Un pr); [Assumption | Ring].
-Intros.
-Unfold EUn in H8.
-Elim H8; Intros.
-Rewrite H9; Apply H7.
-Intro.
-Assert H7 := (H6 n).
-Apply Rle_anti_compatibility with ``eps-(Un n)``.
-Replace ``eps-(Un n)+(Un n)`` with ``eps``.
-Replace ``eps-(Un n)+((majorant Un pr)-eps)`` with ``(majorant Un pr)-(Un n)``.
-Assumption.
-Ring.
-Ring.
-Intro.
-Assert H6 := (H2 n).
-Rewrite Rabsolu_right in H6.
-Apply Rle_sym2.
-Assumption.
-Apply Rle_sym1.
-Apply Rle_anti_compatibility with (Un n).
-Rewrite Rplus_Or; Replace ``(Un n)+((majorant Un pr)-(Un n))`` with (majorant Un pr); [Apply H4 | Ring].
-Exists n; Reflexivity.
-Unfold majorant.
-Case (maj_sup Un pr).
-Trivial.
-Intro.
-Assert H2 := (H1 n).
-Apply not_Rlt; Assumption.
-Qed.
-
-(**********)
-Lemma approx_min : (Un:nat->R;pr:(has_lb Un)) (eps:R) ``0<eps`` -> (EX k :nat | ``(Rabsolu ((minorant Un pr)-(Un k))) < eps``).
-Intros.
-Pose P := [k:nat]``(Rabsolu ((minorant Un pr)-(Un k))) < eps``.
-Unfold P.
-Cut (EX k:nat | (P k)) -> (EX k:nat | ``(Rabsolu ((minorant Un pr)-(Un k))) < eps``).
-Intros.
-Apply H0.
-Apply not_all_not_ex.
-Red; Intro.
-2:Unfold P; Trivial.
-Unfold P in H1.
-Cut (n:nat)``(Rabsolu ((minorant Un pr)-(Un n))) >= eps``.
-Intro.
-Cut (is_lub (EUn (opp_seq Un)) ``-(minorant Un pr)``).
-Intro.
-Unfold is_lub in H3.
-Unfold is_upper_bound in H3.
-Elim H3; Intros.
-Cut (n:nat)``eps<=(Un n)-(minorant Un pr)``.
-Intro.
-Cut (n:nat)``((opp_seq Un) n)<=-(minorant Un pr)-eps``.
-Intro.
-Cut ((x:R)(EUn (opp_seq Un) x)->``x <= -(minorant Un pr)-eps``).
-Intro.
-Assert H9 := (H5 ``-(minorant Un pr)-eps`` H8).
-Cut ``eps<=0``.
-Intro.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H H10)).
-Apply Rle_anti_compatibility with ``-(minorant Un pr)-eps``.
-Rewrite Rplus_Or.
-Replace ``-(minorant Un pr)-eps+eps`` with ``-(minorant Un pr)``; [Assumption | Ring].
-Intros.
-Unfold EUn in H8.
-Elim H8; Intros.
-Rewrite H9; Apply H7.
-Intro.
-Assert H7 := (H6 n).
-Unfold opp_seq.
-Apply Rle_anti_compatibility with ``eps+(Un n)``.
-Replace ``eps+(Un n)+ -(Un n)`` with ``eps``.
-Replace ``eps+(Un n)+(-(minorant Un pr)-eps)`` with ``(Un n)-(minorant Un pr)``.
-Assumption.
-Ring.
-Ring.
-Intro.
-Assert H6 := (H2 n).
-Rewrite Rabsolu_left1 in H6.
-Apply Rle_sym2.
-Replace ``(Un n)-(minorant Un pr)`` with `` -((minorant Un pr)-(Un n))``; [Assumption | Ring].
-Apply Rle_anti_compatibility with ``-(minorant Un pr)``.
-Rewrite Rplus_Or; Replace ``-(minorant Un pr)+((minorant Un pr)-(Un n))`` with ``-(Un n)``.
-Apply H4.
-Exists n; Reflexivity.
-Ring.
-Unfold minorant.
-Case (min_inf Un pr).
-Intro.
-Rewrite Ropp_Ropp.
-Trivial.
-Intro.
-Assert H2 := (H1 n).
-Apply not_Rlt; Assumption.
-Qed.
-
-(* Unicity of limit for convergent sequences *) 
-Lemma UL_sequence : (Un:nat->R;l1,l2:R) (Un_cv Un l1) -> (Un_cv Un l2) -> l1==l2. 
-Intros Un l1 l2; Unfold Un_cv; Unfold R_dist; Intros. 
-Apply cond_eq. 
-Intros; Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. 
-Elim (H ``eps/2`` H2); Intros. 
-Elim (H0 ``eps/2`` H2); Intros. 
-Pose N := (max x x0). 
-Apply Rle_lt_trans with ``(Rabsolu (l1 -(Un N)))+(Rabsolu ((Un N)-l2))``. 
-Replace ``l1-l2`` with ``(l1-(Un N))+((Un N)-l2)``; [Apply Rabsolu_triang | Ring]. 
-Rewrite (double_var eps); Apply Rplus_lt. 
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H3; Unfold ge N; Apply le_max_l. 
-Apply H4; Unfold ge N; Apply le_max_r. 
-Qed.
-
-(**********) 
-Lemma CV_plus : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)+(Bn i)`` ``l1+l2``). 
-Unfold Un_cv; Unfold R_dist; Intros. 
-Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. 
-Elim (H ``eps/2`` H2); Intros. 
-Elim (H0 ``eps/2`` H2); Intros. 
-Pose N := (max x x0). 
-Exists N; Intros. 
-Replace ``(An n)+(Bn n)-(l1+l2)`` with ``((An n)-l1)+((Bn n)-l2)``; [Idtac | Ring]. 
-Apply Rle_lt_trans with ``(Rabsolu ((An n)-l1))+(Rabsolu ((Bn n)-l2))``. 
-Apply Rabsolu_triang. 
-Rewrite (double_var eps); Apply Rplus_lt. 
-Apply H3; Unfold ge; Apply le_trans with N; [Unfold N; Apply le_max_l | Assumption]. 
-Apply H4; Unfold ge; Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption]. 
-Qed.
-
-(**********) 
-Lemma cv_cvabs : (Un:nat->R;l:R) (Un_cv Un l) -> (Un_cv [i:nat](Rabsolu (Un i)) (Rabsolu l)). 
-Unfold Un_cv; Unfold R_dist; Intros. 
-Elim (H eps H0); Intros. 
-Exists x; Intros. 
-Apply Rle_lt_trans with ``(Rabsolu ((Un n)-l))``. 
-Apply Rabsolu_triang_inv2. 
-Apply H1; Assumption. 
-Qed. 
-
-(**********) 
-Lemma CV_Cauchy : (Un:nat->R) (sigTT R [l:R](Un_cv Un l)) -> (Cauchy_crit Un). 
-Intros; Elim X; Intros. 
-Unfold Cauchy_crit; Intros. 
-Unfold Un_cv in p; Unfold R_dist in p. 
-Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. 
-Elim (p ``eps/2`` H0); Intros. 
-Exists x0; Intros. 
-Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((Un n)-x))+(Rabsolu (x-(Un m)))``. 
-Replace ``(Un n)-(Un m)`` with ``((Un n)-x)+(x-(Un m))``; [Apply Rabsolu_triang | Ring]. 
-Rewrite (double_var eps); Apply Rplus_lt. 
-Apply H1; Assumption. 
-Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H1; Assumption. 
-Qed. 
-
-(**********)
-Lemma maj_by_pos : (Un:nat->R) (sigTT R [l:R](Un_cv Un l)) -> (EXT l:R | ``0<l``/\((n:nat)``(Rabsolu (Un n))<=l``)). 
-Intros; Elim X; Intros. 
-Cut (sigTT R [l:R](Un_cv [k:nat](Rabsolu (Un k)) l)). 
-Intro. 
-Assert H := (CV_Cauchy [k:nat](Rabsolu (Un k)) X0). 
-Assert H0 := (cauchy_bound [k:nat](Rabsolu (Un k)) H). 
-Elim H0; Intros. 
-Exists ``x0+1``. 
-Cut ``0<=x0``. 
-Intro. 
-Split. 
-Apply ge0_plus_gt0_is_gt0; [Assumption | Apply Rlt_R0_R1]. 
-Intros. 
-Apply Rle_trans with x0. 
-Unfold is_upper_bound in H1. 
-Apply H1. 
-Exists n; Reflexivity. 
-Pattern 1 x0; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1. 
-Apply Rle_trans with (Rabsolu (Un O)). 
-Apply Rabsolu_pos. 
-Unfold is_upper_bound in H1. 
-Apply H1. 
-Exists O; Reflexivity. 
-Apply existTT with (Rabsolu x). 
-Apply cv_cvabs; Assumption. 
-Qed. 
- 
-(**********) 
-Lemma CV_mult : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)*(Bn i)`` ``l1*l2``). 
-Intros. 
-Cut (sigTT R [l:R](Un_cv An l)). 
-Intro. 
-Assert H1 := (maj_by_pos An X). 
-Elim H1; Intros M H2. 
-Elim H2; Intros. 
-Unfold Un_cv; Unfold R_dist; Intros. 
-Cut ``0<eps/(2*M)``. 
-Intro. 
-Case (Req_EM l2 R0); Intro. 
-Unfold Un_cv in H0; Unfold R_dist in H0. 
-Elim (H0 ``eps/(2*M)`` H6); Intros. 
-Exists x; Intros. 
-Apply Rle_lt_trans with ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))+(Rabsolu ((An n)*l2-l1*l2))``. 
-Replace ``(An n)*(Bn n)-l1*l2`` with ``((An n)*(Bn n)-(An n)*l2)+((An n)*l2-l1*l2)``; [Apply Rabsolu_triang | Ring]. 
-Replace ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))`` with ``(Rabsolu (An n))*(Rabsolu ((Bn n)-l2))``. 
-Replace ``(Rabsolu ((An n)*l2-l1*l2))`` with R0. 
-Rewrite Rplus_Or. 
-Apply Rle_lt_trans with ``M*(Rabsolu ((Bn n)-l2))``. 
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu ((Bn n)-l2))``). 
-Apply Rle_monotony. 
-Apply Rabsolu_pos. 
-Apply H4. 
-Apply Rlt_monotony_contra with ``/M``. 
-Apply Rlt_Rinv; Apply H3. 
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. 
-Rewrite Rmult_1l; Rewrite (Rmult_sym ``/M``). 
-Apply Rlt_trans with  ``eps/(2*M)``. 
-Apply H8; Assumption. 
-Unfold Rdiv; Rewrite Rinv_Rmult. 
-Apply Rlt_monotony_contra with ``2``. 
-Sup0.
-Replace ``2*(eps*(/2*/M))`` with ``(2*/2)*(eps*/M)``; [Idtac | Ring]. 
-Rewrite <- Rinv_r_sym. 
-Rewrite Rmult_1l; Rewrite double. 
-Pattern 1 ``eps*/M``; Rewrite <- Rplus_Or. 
-Apply Rlt_compatibility; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption]. 
-DiscrR. 
-DiscrR. 
-Red; Intro; Rewrite H10 in H3; Elim (Rlt_antirefl ? H3). 
-Red; Intro; Rewrite H10 in H3; Elim (Rlt_antirefl ? H3). 
-Rewrite H7; Do 2 Rewrite Rmult_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Reflexivity. 
-Replace ``(An n)*(Bn n)-(An n)*l2`` with ``(An n)*((Bn n)-l2)``; [Idtac | Ring]. 
-Symmetry; Apply Rabsolu_mult. 
-Cut ``0<eps/(2*(Rabsolu l2))``. 
-Intro. 
-Unfold Un_cv in H; Unfold R_dist in H; Unfold Un_cv in H0; Unfold R_dist in H0. 
-Elim (H ``eps/(2*(Rabsolu l2))`` H8); Intros N1 H9. 
-Elim (H0 ``eps/(2*M)`` H6); Intros N2 H10. 
-Pose N := (max N1 N2). 
-Exists N; Intros. 
-Apply Rle_lt_trans with ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))+(Rabsolu ((An n)*l2-l1*l2))``. 
-Replace ``(An n)*(Bn n)-l1*l2`` with ``((An n)*(Bn n)-(An n)*l2)+((An n)*l2-l1*l2)``; [Apply Rabsolu_triang | Ring]. 
-Replace ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))`` with ``(Rabsolu (An n))*(Rabsolu ((Bn n)-l2))``. 
-Replace ``(Rabsolu ((An n)*l2-l1*l2))`` with ``(Rabsolu l2)*(Rabsolu ((An n)-l1))``. 
-Rewrite (double_var eps); Apply Rplus_lt. 
-Apply Rle_lt_trans with ``M*(Rabsolu ((Bn n)-l2))``. 
-Do 2 Rewrite <- (Rmult_sym ``(Rabsolu ((Bn n)-l2))``). 
-Apply Rle_monotony. 
-Apply Rabsolu_pos. 
-Apply H4. 
-Apply Rlt_monotony_contra with ``/M``. 
-Apply Rlt_Rinv; Apply H3. 
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. 
-Rewrite Rmult_1l; Rewrite (Rmult_sym ``/M``). 
-Apply Rlt_le_trans with  ``eps/(2*M)``. 
-Apply H10. 
-Unfold ge; Apply le_trans with N. 
-Unfold N; Apply le_max_r. 
-Assumption. 
-Unfold Rdiv; Rewrite Rinv_Rmult. 
-Right; Ring. 
-DiscrR. 
-Red; Intro; Rewrite H12 in H3; Elim (Rlt_antirefl ? H3). 
-Red; Intro; Rewrite H12 in H3; Elim (Rlt_antirefl ? H3). 
-Apply Rlt_monotony_contra with ``/(Rabsolu l2)``. 
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. 
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. 
-Rewrite Rmult_1l; Apply Rlt_le_trans with ``eps/(2*(Rabsolu l2))``. 
-Apply H9. 
-Unfold ge; Apply le_trans with N. 
-Unfold N; Apply le_max_l. 
-Assumption. 
-Unfold Rdiv; Right; Rewrite Rinv_Rmult. 
-Ring. 
-DiscrR. 
-Apply Rabsolu_no_R0; Assumption. 
-Apply Rabsolu_no_R0; Assumption. 
-Replace ``(An n)*l2-l1*l2`` with ``l2*((An n)-l1)``; [Symmetry; Apply Rabsolu_mult | Ring]. 
-Replace ``(An n)*(Bn n)-(An n)*l2`` with ``(An n)*((Bn n)-l2)``; [Symmetry; Apply Rabsolu_mult | Ring]. 
-Unfold Rdiv; Apply Rmult_lt_pos. 
-Assumption. 
-Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]. 
-Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Assumption]]. 
-Apply existTT with l1; Assumption. 
-Qed. 
-
-Lemma tech9 : (Un:nat->R) (Un_growing Un) -> ((m,n:nat)(le m n)->``(Un m)<=(Un n)``).
-Intros; Unfold Un_growing in H.
-Induction n.
-Induction m.
-Right; Reflexivity.
-Elim (le_Sn_O ? H0).
-Cut (le m n)\/m=(S n).
-Intro; Elim H1; Intro.
-Apply Rle_trans with (Un n).
-Apply Hrecn; Assumption.
-Apply H.
-Rewrite H2; Right; Reflexivity.
-Inversion H0.
-Right; Reflexivity.
-Left; Assumption.
-Qed.
-
-Lemma tech10 : (Un:nat->R;x:R) (Un_growing Un) -> (is_lub (EUn Un) x) -> (Un_cv Un x).
-Intros; Cut (bound (EUn Un)).
-Intro; Assert H2 := (Un_cv_crit ? H H1).
-Elim H2; Intros.
-Case (total_order_T x x0); Intro.
-Elim s; Intro.
-Cut (n:nat)``(Un n)<=x``.
-Intro; Unfold Un_cv in H3; Cut ``0<x0-x``.
-Intro; Elim (H3 ``x0-x`` H5); Intros.
-Cut (ge x1 x1).
-Intro; Assert H8 := (H6 x1 H7).
-Unfold R_dist in H8; Rewrite Rabsolu_left1 in H8.
-Rewrite Ropp_distr2 in H8; Unfold Rminus in H8.
-Assert H9 := (Rlt_anti_compatibility ``x0`` ? ? H8).
-Assert H10 := (Ropp_Rlt ? ? H9).
-Assert H11 := (H4 x1).
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H10 H11)).
-Apply Rle_minus; Apply Rle_trans with x.
-Apply H4.
-Left; Assumption.
-Unfold ge; Apply le_n.
-Apply Rgt_minus; Assumption.
-Intro; Unfold is_lub in H0; Unfold is_upper_bound in H0; Elim H0; Intros.
-Apply H4; Unfold EUn; Exists n; Reflexivity.
-Rewrite b; Assumption.
-Cut ((n:nat)``(Un n)<=x0``).
-Intro; Unfold is_lub in H0; Unfold is_upper_bound in H0; Elim H0; Intros.
-Cut (y:R)(EUn Un y)->``y<=x0``.
-Intro; Assert H8 := (H6 ? H7). 
-Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H8 r)).
-Unfold EUn; Intros; Elim H7; Intros.
-Rewrite H8; Apply H4.
-Intro; Case (total_order_Rle (Un n) x0); Intro.
-Assumption.
-Cut (n0:nat)(le n n0) -> ``x0<(Un n0)``. 
-Intro; Unfold Un_cv in H3; Cut ``0<(Un n)-x0``.
-Intro; Elim (H3 ``(Un n)-x0`` H5); Intros.
-Cut (ge (max n x1) x1).
-Intro; Assert H8 := (H6 (max n x1) H7).
-Unfold R_dist in H8.
-Rewrite Rabsolu_right in H8.
-Unfold Rminus in H8; Do 2 Rewrite <- (Rplus_sym ``-x0``) in H8.
-Assert H9 := (Rlt_anti_compatibility ? ? ? H8).
-Cut ``(Un n)<=(Un (max n x1))``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H10 H9)).
-Apply tech9; [Assumption | Apply le_max_l].
-Apply Rge_trans with ``(Un n)-x0``.
-Unfold Rminus; Apply Rle_sym1; Do 2 Rewrite <- (Rplus_sym ``-x0``); Apply Rle_compatibility.
-Apply tech9; [Assumption | Apply le_max_l].
-Left; Assumption.
-Unfold ge; Apply le_max_r.
-Apply Rlt_anti_compatibility with x0.
-Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym x0); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H4; Apply le_n.
-Intros; Apply Rlt_le_trans with (Un n).
-Case (total_order_Rlt_Rle x0 (Un n)); Intro.
-Assumption.
-Elim n0; Assumption.
-Apply tech9; Assumption.
-Unfold bound; Exists x; Unfold is_lub in H0; Elim H0; Intros; Assumption.
-Qed.
-
-Lemma tech13 : (An:nat->R;k:R) ``0<=k<1`` -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (EXT k0 : R | ``k<k0<1`` /\ (EX N:nat | (n:nat) (le N n)->``(Rabsolu ((An (S n))/(An n)))<k0``)).
-Intros; Exists ``k+(1-k)/2``.
-Split.
-Split.
-Pattern 1 k; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_anti_compatibility with k; Rewrite Rplus_Or; Replace ``k+(1-k)`` with R1; [Elim H; Intros; Assumption | Ring].
-Apply Rlt_Rinv; Sup0.
-Apply Rlt_monotony_contra with ``2``.
-Sup0.
-Unfold Rdiv; Rewrite Rmult_1r; Rewrite Rmult_Rplus_distr; Pattern 1 ``2``; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1r; Replace ``2*k+(1-k)`` with ``1+k``; [Idtac | Ring].
-Elim H; Intros.
-Apply Rlt_compatibility; Assumption.
-Unfold Un_cv in H0; Cut ``0<(1-k)/2``.
-Intro; Elim (H0 ``(1-k)/2`` H1); Intros.
-Exists x; Intros.
-Assert H4 := (H2 n H3).
-Unfold R_dist in H4; Rewrite <- Rabsolu_Rabsolu; Replace ``(Rabsolu ((An (S n))/(An n)))`` with ``((Rabsolu ((An (S n))/(An n)))-k)+k``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu ((Rabsolu ((An (S n))/(An n)))-k))+(Rabsolu k)``.
-Apply Rabsolu_triang.
-Rewrite (Rabsolu_right k).
-Apply Rlt_anti_compatibility with ``-k``; Rewrite <- (Rplus_sym k); Repeat Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Repeat Rewrite Rplus_Ol; Apply H4.
-Apply Rle_sym1; Elim H; Intros; Assumption.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_anti_compatibility with k; Rewrite Rplus_Or; Elim H; Intros; Replace ``k+(1-k)`` with R1; [Assumption | Ring].
-Apply Rlt_Rinv; Sup0.
-Qed.
-
-(**********)
-Lemma growing_ineq : (Un:nat->R;l:R) (Un_growing Un) -> (Un_cv Un l) -> ((n:nat)``(Un n)<=l``). 
-Intros; Case (total_order_T (Un n) l); Intro.
-Elim s; Intro.
-Left; Assumption.
-Right; Assumption.
-Cut ``0<(Un n)-l``.
-Intro; Unfold Un_cv in H0; Unfold R_dist in H0.
-Elim (H0 ``(Un n)-l`` H1); Intros N1 H2.
-Pose N := (max n N1).
-Cut ``(Un n)-l<=(Un N)-l``.
-Intro; Cut ``(Un N)-l<(Un n)-l``.
-Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 H4)).
-Apply Rle_lt_trans with ``(Rabsolu ((Un N)-l))``.
-Apply Rle_Rabsolu.
-Apply H2.
-Unfold ge N; Apply le_max_r.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-l``); Apply Rle_compatibility.
-Apply tech9.
-Assumption.
-Unfold N; Apply le_max_l.
-Apply Rlt_anti_compatibility with l.
-Rewrite Rplus_Or.
-Replace ``l+((Un n)-l)`` with (Un n); [Assumption | Ring].
-Qed.
-
-(* Un->l => (-Un) -> (-l) *)
-Lemma CV_opp : (An:nat->R;l:R) (Un_cv An l) -> (Un_cv (opp_seq An) ``-l``).
-Intros An l.
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H eps H0); Intros.
-Exists x; Intros.
-Unfold opp_seq; Replace ``-(An n)- (-l)`` with ``-((An n)-l)``; [Rewrite Rabsolu_Ropp | Ring].
-Apply H1; Assumption.
-Qed.
-
-(**********)
-Lemma decreasing_ineq : (Un:nat->R;l:R) (Un_decreasing Un) -> (Un_cv Un l) -> ((n:nat)``l<=(Un n)``).
-Intros.
-Assert H1 := (decreasing_growing ? H).
-Assert H2 := (CV_opp ? ? H0).
-Assert H3 := (growing_ineq ? ? H1 H2).
-Apply Ropp_Rle.
-Unfold opp_seq in H3; Apply H3.
-Qed.
-
-(**********)
-Lemma CV_minus : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)-(Bn i)`` ``l1-l2``). 
-Intros. 
-Replace [i:nat]``(An i)-(Bn i)`` with [i:nat]``(An i)+((opp_seq Bn) i)``. 
-Unfold Rminus; Apply CV_plus. 
-Assumption. 
-Apply CV_opp; Assumption. 
-Unfold Rminus opp_seq; Reflexivity. 
-Qed. 
-
-(* Un -> +oo *)
-Definition cv_infty [Un:nat->R] : Prop := (M:R)(EXT N:nat | (n:nat) (le N n) -> ``M<(Un n)``).
-
-(* Un -> +oo => /Un -> O *)
-Lemma cv_infty_cv_R0 : (Un:nat->R) ((n:nat)``(Un n)<>0``) -> (cv_infty Un) -> (Un_cv [n:nat]``/(Un n)`` R0).
-Unfold cv_infty Un_cv; Unfold R_dist; Intros.
-Elim (H0 ``/eps``); Intros N0 H2.
-Exists N0; Intros.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite (Rabsolu_Rinv ? (H n)).
-Apply Rlt_monotony_contra with (Rabsolu (Un n)).
-Apply Rabsolu_pos_lt; Apply H.
-Rewrite <- Rinv_r_sym.
-Apply Rlt_monotony_contra with ``/eps``.
-Apply Rlt_Rinv; Assumption.
-Rewrite Rmult_1r; Rewrite (Rmult_sym ``/eps``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Apply Rlt_le_trans with (Un n).
-Apply H2; Assumption.
-Apply Rle_Rabsolu.
-Red; Intro; Rewrite H4 in H1; Elim (Rlt_antirefl ? H1).
-Apply Rabsolu_no_R0; Apply H.
-Qed.
-
-(**********)
-Lemma decreasing_prop : (Un:nat->R;m,n:nat) (Un_decreasing Un) -> (le m n) -> ``(Un n)<=(Un m)``.
-Unfold Un_decreasing; Intros.
-Induction n.
-Induction m.
-Right; Reflexivity.
-Elim (le_Sn_O ? H0).
-Cut (le m n)\/m=(S n).
-Intro; Elim H1; Intro.
-Apply Rle_trans with (Un n).
-Apply H.
-Apply Hrecn; Assumption.
-Rewrite H2; Right; Reflexivity.
-Inversion H0; [Right; Reflexivity | Left; Assumption].
-Qed.
-
-(* |x|^n/n! -> 0 *)
-Lemma cv_speed_pow_fact : (x:R) (Un_cv [n:nat]``(pow x n)/(INR (fact n))`` R0).
-Intro; Cut (Un_cv [n:nat]``(pow (Rabsolu x) n)/(INR (fact n))`` R0) -> (Un_cv [n:nat]``(pow x n)/(INR (fact n))`` ``0``).
-Intro; Apply H.
-Unfold Un_cv; Unfold R_dist; Intros; Case (Req_EM x R0); Intro.
-Exists (S O); Intros.
-Rewrite H1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_R0; Rewrite pow_ne_zero; [Unfold Rdiv; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Assumption | Red; Intro; Rewrite H3 in H2; Elim (le_Sn_n ? H2)].
-Assert H2 := (Rabsolu_pos_lt x H1); Pose M := (up (Rabsolu x)); Cut `0<=M`.
-Intro; Elim (IZN M H3); Intros M_nat H4.
-Pose Un := [n:nat]``(pow (Rabsolu x) (plus M_nat n))/(INR (fact (plus M_nat n)))``.
-Cut (Un_cv Un R0); Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H5 eps H0); Intros N H6.
-Exists (plus M_nat N); Intros; Cut (EX p:nat | (ge p N)/\n=(plus M_nat p)).
-Intro; Elim H8; Intros p H9.
-Elim H9; Intros; Rewrite H11; Unfold Un in H6; Apply H6; Assumption.
-Exists (minus n M_nat).
-Split.
-Unfold ge; Apply simpl_le_plus_l with M_nat; Rewrite <- le_plus_minus.
-Assumption.
-Apply le_trans with (plus M_nat N).
-Apply le_plus_l.
-Assumption.
-Apply le_plus_minus; Apply le_trans with (plus M_nat N); [Apply le_plus_l | Assumption].
-Pose Vn := [n:nat]``(Rabsolu x)*(Un O)/(INR (S n))``.
-Cut (le (1) M_nat).
-Intro; Cut (n:nat)``0<(Un n)``.
-Intro; Cut (Un_decreasing Un).
-Intro; Cut (n:nat)``(Un (S n))<=(Vn n)``.
-Intro; Cut (Un_cv Vn R0).
-Unfold Un_cv; Unfold R_dist; Intros.
-Elim (H10 eps0 H5); Intros N1 H11.
-Exists (S N1); Intros.
-Cut (n:nat)``0<(Vn n)``.
-Intro; Apply Rle_lt_trans with ``(Rabsolu ((Vn (pred n))-0))``.
-Repeat Rewrite Rabsolu_right.
-Unfold Rminus; Rewrite Ropp_O; Do 2 Rewrite Rplus_Or; Replace n with (S (pred n)).
-Apply H9.
-Inversion H12; Simpl; Reflexivity.
-Apply Rle_sym1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Left; Apply H13.
-Apply Rle_sym1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Left; Apply H7.
-Apply H11; Unfold ge; Apply le_S_n; Replace (S (pred n)) with n; [Unfold ge in H12; Exact H12 | Inversion H12; Simpl; Reflexivity].
-Intro; Apply Rlt_le_trans with (Un (S n0)); [Apply H7 | Apply H9].
-Cut (cv_infty [n:nat](INR (S n))).
-Intro; Cut (Un_cv [n:nat]``/(INR (S n))`` R0).
-Unfold Un_cv R_dist; Intros; Unfold Vn.
-Cut ``0<eps1/((Rabsolu x)*(Un O))``.
-Intro; Elim (H11 ? H13); Intros N H14.
-Exists N; Intros; Replace ``(Rabsolu x)*(Un O)/(INR (S n))-0`` with ``((Rabsolu x)*(Un O))*(/(INR (S n))-0)``; [Idtac | Unfold Rdiv; Ring].
-Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu ((Rabsolu x)*(Un O)))``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Apply prod_neq_R0.
-Apply Rabsolu_no_R0; Assumption.
-Assert H16 := (H7 O); Red; Intro; Rewrite H17 in H16; Elim (Rlt_antirefl ? H16).
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l.
-Replace ``/(Rabsolu ((Rabsolu x)*(Un O)))*eps1`` with ``eps1/((Rabsolu x)*(Un O))``.
-Apply H14; Assumption.
-Unfold Rdiv; Rewrite (Rabsolu_right ``(Rabsolu x)*(Un O)``).
-Apply Rmult_sym.
-Apply Rle_sym1; Apply Rmult_le_pos.
-Apply Rabsolu_pos.
-Left; Apply H7.
-Apply Rabsolu_no_R0.
-Apply prod_neq_R0; [Apply Rabsolu_no_R0; Assumption | Assert H16 := (H7 O); Red; Intro; Rewrite H17 in H16; Elim (Rlt_antirefl ? H16)].
-Unfold Rdiv; Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Apply Rmult_lt_pos.
-Apply Rabsolu_pos_lt; Assumption.
-Apply H7.
-Apply (cv_infty_cv_R0 [n:nat]``(INR (S n))``).
-Intro; Apply not_O_INR; Discriminate.
-Assumption.
-Unfold cv_infty; Intro; Case (total_order_T M0 R0); Intro.
-Elim s; Intro.
-Exists O; Intros.
-Apply Rlt_trans with R0; [Assumption | Apply lt_INR_0; Apply lt_O_Sn].
-Exists O; Intros; Rewrite b; Apply lt_INR_0; Apply lt_O_Sn.
-Pose M0_z := (up M0).
-Assert H10 := (archimed M0).
-Cut `0<=M0_z`.
-Intro; Elim (IZN ? H11); Intros M0_nat H12.
-Exists M0_nat; Intros.
-Apply Rlt_le_trans with (IZR M0_z).
-Elim H10; Intros; Assumption.
-Rewrite H12; Rewrite <- INR_IZR_INZ; Apply le_INR.
-Apply le_trans with n; [Assumption | Apply le_n_Sn].
-Apply le_IZR; Left; Simpl; Unfold M0_z; Apply Rlt_trans with M0; [Assumption | Elim H10; Intros; Assumption].
-Intro; Apply Rle_trans with ``(Rabsolu x)*(Un n)*/(INR (S n))``.
-Unfold Un; Replace (plus M_nat (S n)) with (plus (plus M_nat n) (1)).
-Rewrite pow_add; Replace (pow (Rabsolu x) (S O)) with (Rabsolu x); [Idtac | Simpl; Ring].
-Unfold Rdiv; Rewrite <- (Rmult_sym (Rabsolu x)); Repeat Rewrite Rmult_assoc; Repeat Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply pow_lt; Assumption.
-Replace (plus (plus M_nat n) (S O)) with (S (plus M_nat n)).
-Rewrite fact_simpl; Rewrite mult_sym; Rewrite mult_INR; Rewrite Rinv_Rmult.
-Apply Rle_monotony.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H10 := (sym_eq ? ? ? H9); Elim (fact_neq_0 ? H10).
-Left; Apply Rinv_lt.
-Apply Rmult_lt_pos; Apply lt_INR_0; Apply lt_O_Sn.
-Apply lt_INR; Apply lt_n_S.
-Pattern 1 n; Replace n with (plus O n); [Idtac | Reflexivity].
-Apply lt_reg_r.
-Apply lt_le_trans with (S O); [Apply lt_O_Sn | Assumption].
-Apply INR_fact_neq_0.
-Apply not_O_INR; Discriminate.
-Apply INR_eq; Rewrite S_INR; Do 3 Rewrite plus_INR; Reflexivity.
-Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Unfold Vn; Rewrite Rmult_assoc; Unfold Rdiv; Rewrite (Rmult_sym (Un O)); Rewrite (Rmult_sym (Un n)).
-Repeat Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
-Apply decreasing_prop; [Assumption | Apply le_O_n].
-Unfold Un_decreasing; Intro; Unfold Un.
-Replace (plus M_nat (S n)) with (plus (plus M_nat n) (1)).
-Rewrite pow_add; Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
-Left; Apply pow_lt; Assumption.
-Replace (pow (Rabsolu x) (S O)) with (Rabsolu x); [Idtac | Simpl; Ring].
-Replace (plus (plus M_nat n) (S O)) with (S (plus M_nat n)).
-Apply Rle_monotony_contra with (INR (fact (S (plus M_nat n)))).
-Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H9 := (sym_eq ? ? ? H8); Elim (fact_neq_0 ? H9).
-Rewrite (Rmult_sym (Rabsolu x)); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l.
-Rewrite fact_simpl; Rewrite mult_INR; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1r; Apply Rle_trans with (INR M_nat).
-Left; Rewrite INR_IZR_INZ.
-Rewrite <- H4; Assert H8 := (archimed (Rabsolu x)); Elim H8; Intros; Assumption.
-Apply le_INR; Apply le_trans with (S M_nat); [Apply le_n_Sn | Apply le_n_S; Apply le_plus_l].
-Apply INR_fact_neq_0.
-Apply INR_fact_neq_0.
-Apply INR_eq; Rewrite S_INR; Do 3 Rewrite plus_INR; Reflexivity.
-Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
-Intro; Unfold Un; Unfold Rdiv; Apply Rmult_lt_pos.
-Apply pow_lt; Assumption.
-Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H8 := (sym_eq ? ? ? H7); Elim (fact_neq_0 ? H8).
-Clear Un Vn; Apply INR_le; Simpl.
-Induction M_nat.
-Assert H6 := (archimed (Rabsolu x)); Fold M in H6; Elim H6; Intros. 
-Rewrite H4 in H7; Rewrite <- INR_IZR_INZ in H7.
-Simpl in H7; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H2 H7)).
-Replace R1 with (INR (S O)); [Apply le_INR | Reflexivity]; Apply le_n_S; Apply le_O_n.
-Apply le_IZR; Simpl; Left; Apply Rlt_trans with (Rabsolu x).
-Assumption.
-Elim (archimed (Rabsolu x)); Intros; Assumption.
-Unfold Un_cv; Unfold R_dist; Intros; Elim (H eps H0); Intros.
-Exists x0; Intros; Apply Rle_lt_trans with ``(Rabsolu ((pow (Rabsolu x) n)/(INR (fact n))-0))``.
-Unfold Rminus; Rewrite Ropp_O; Do 2 Rewrite Rplus_Or; Rewrite (Rabsolu_right ``(pow (Rabsolu x) n)/(INR (fact n))``).
-Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``/(INR (fact n))``).
-Rewrite Pow_Rabsolu; Right; Reflexivity.
-Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H4 := (sym_eq ? ? ? H3); Elim (fact_neq_0 ? H4).
-Apply Rle_sym1; Unfold Rdiv; Apply Rmult_le_pos.
-Case (Req_EM x R0); Intro.
-Rewrite H3; Rewrite Rabsolu_R0.
-Induction n; [Simpl; Left; Apply Rlt_R0_R1 | Simpl; Rewrite Rmult_Ol; Right; Reflexivity].
-Left; Apply pow_lt; Apply Rabsolu_pos_lt; Assumption.
-Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H4 := (sym_eq ? ? ? H3); Elim (fact_neq_0 ? H4).
-Apply H1; Assumption.
-Qed.
diff --git a/theories7/Reals/SeqSeries.v b/theories7/Reals/SeqSeries.v
deleted file mode 100644
index dd93c304..00000000
--- a/theories7/Reals/SeqSeries.v
+++ /dev/null
@@ -1,307 +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: SeqSeries.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Max.
-Require Export Rseries.
-Require Export SeqProp.
-Require Export Rcomplete.
-Require Export PartSum.
-Require Export AltSeries.
-Require Export Binomial.
-Require Export Rsigma.
-Require Export Rprod.
-Require Export Cauchy_prod.
-Require Export Alembert.
-V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
-Open Local Scope R_scope.
-
-(**********)
-Lemma sum_maj1 : (fn:nat->R->R;An:nat->R;x,l1,l2:R;N:nat) (Un_cv [n:nat](SP fn n x) l1) -> (Un_cv [n:nat](sum_f_R0 An n) l2) -> ((n:nat)``(Rabsolu (fn n x))<=(An n)``) -> ``(Rabsolu (l1-(SP fn N x)))<=l2-(sum_f_R0 An N)``.
-Intros; Cut (sigTT R [l:R](Un_cv [n:nat](sum_f_R0 [l:nat](fn (plus (S N) l) x) n) l)).
-Intro; Cut (sigTT R [l:R](Un_cv [n:nat](sum_f_R0 [l:nat](An (plus (S N) l)) n) l)).
-Intro; Elim X; Intros l1N H2.
-Elim X0; Intros l2N H3.
-Cut ``l1-(SP fn N x)==l1N``.
-Intro; Cut ``l2-(sum_f_R0 An N)==l2N``.
-Intro; Rewrite H4; Rewrite H5.
-Apply sum_cv_maj with [l:nat](An (plus (S N) l)) [l:nat][x:R](fn (plus (S N) l) x) x.
-Unfold SP; Apply H2.
-Apply H3.
-Intros; Apply H1.
-Symmetry; EApply UL_sequence.
-Apply H3.
-Unfold Un_cv in H0; Unfold Un_cv; Intros; Elim (H0 eps H5); Intros N0 H6.
-Unfold R_dist in H6; Exists N0; Intros.
-Unfold R_dist; Replace (Rminus (sum_f_R0 [l:nat](An (plus (S N) l)) n) (Rminus l2 (sum_f_R0 An N))) with (Rminus (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) l2); [Idtac | Ring].
-Replace (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) with (sum_f_R0 An (S (plus N n))).
-Apply H6; Unfold ge; Apply le_trans with n.
-Apply H7.
-Apply le_trans with (plus N n).
-Apply le_plus_r.
-Apply le_n_Sn.
-Cut (le O N).
-Cut (lt N (S (plus N n))).
-Intros; Assert H10 := (sigma_split An H9 H8).
-Unfold sigma in H10.
-Do 2 Rewrite <- minus_n_O in H10.
-Replace (sum_f_R0 An (S (plus N n))) with (sum_f_R0 [k:nat](An (plus (0) k)) (S (plus N n))).
-Replace (sum_f_R0 An N) with (sum_f_R0 [k:nat](An (plus (0) k)) N).
-Cut (minus (S (plus N n)) (S N))=n.
-Intro; Rewrite H11 in H10.
-Apply H10.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_S; Apply le_plus_l.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply le_lt_n_Sm; Apply le_plus_l.
-Apply le_O_n.
-Symmetry; EApply UL_sequence.
-Apply H2.
-Unfold Un_cv in H; Unfold Un_cv; Intros.
-Elim (H eps H4); Intros N0 H5.
-Unfold R_dist in H5; Exists N0; Intros.
-Unfold R_dist SP; Replace (Rminus (sum_f_R0 [l:nat](fn (plus (S N) l) x) n) (Rminus l1 (sum_f_R0 [k:nat](fn k x) N))) with (Rminus (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) l1); [Idtac | Ring].
-Replace (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) with (sum_f_R0 [k:nat](fn k x) (S (plus N n))).
-Unfold SP in H5; Apply H5; Unfold ge; Apply le_trans with n.
-Apply H6.
-Apply le_trans with (plus N n).
-Apply le_plus_r.
-Apply le_n_Sn.
-Cut (le O N).
-Cut (lt N (S (plus N n))).
-Intros; Assert H9 := (sigma_split [k:nat](fn k x) H8 H7).
-Unfold sigma in H9.
-Do 2 Rewrite <- minus_n_O in H9.
-Replace (sum_f_R0 [k:nat](fn k x) (S (plus N n))) with (sum_f_R0 [k:nat](fn (plus (0) k) x) (S (plus N n))).
-Replace (sum_f_R0 [k:nat](fn k x) N) with (sum_f_R0 [k:nat](fn (plus (0) k) x) N).
-Cut (minus (S (plus N n)) (S N))=n.
-Intro; Rewrite H10 in H9.
-Apply H9.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_S; Apply le_plus_l.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply le_lt_n_Sm.
-Apply le_plus_l.
-Apply le_O_n.
-Apply existTT with ``l2-(sum_f_R0 An N)``.
-Unfold Un_cv in H0; Unfold Un_cv; Intros.
-Elim (H0 eps H2); Intros N0 H3.
-Unfold R_dist in H3; Exists N0; Intros.
-Unfold R_dist; Replace (Rminus (sum_f_R0 [l:nat](An (plus (S N) l)) n) (Rminus l2 (sum_f_R0 An N))) with (Rminus (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) l2); [Idtac | Ring].
-Replace (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) with (sum_f_R0 An (S (plus N n))).
-Apply H3; Unfold ge; Apply le_trans with n.
-Apply H4.
-Apply le_trans with (plus N n).
-Apply le_plus_r.
-Apply le_n_Sn.
-Cut (le O N).
-Cut (lt N (S (plus N n))).
-Intros; Assert H7 := (sigma_split An H6 H5).
-Unfold sigma in H7.
-Do 2 Rewrite <- minus_n_O in H7.
-Replace (sum_f_R0 An (S (plus N n))) with (sum_f_R0 [k:nat](An (plus (0) k)) (S (plus N n))).
-Replace (sum_f_R0 An N) with (sum_f_R0 [k:nat](An (plus (0) k)) N).
-Cut (minus (S (plus N n)) (S N))=n.
-Intro; Rewrite H8 in H7.
-Apply H7.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_S; Apply le_plus_l.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply le_lt_n_Sm.
-Apply le_plus_l.
-Apply le_O_n.
-Apply existTT with ``l1-(SP fn N x)``.
-Unfold Un_cv in H; Unfold Un_cv; Intros.
-Elim (H eps H2); Intros N0 H3.
-Unfold R_dist in H3; Exists N0; Intros.
-Unfold R_dist SP.
-Replace (Rminus (sum_f_R0 [l:nat](fn (plus (S N) l) x) n) (Rminus l1 (sum_f_R0 [k:nat](fn k x) N))) with (Rminus (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) l1); [Idtac | Ring].
-Replace (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) with (sum_f_R0 [k:nat](fn k x) (S (plus N n))).
-Unfold SP in H3; Apply H3.
-Unfold ge; Apply le_trans with n.
-Apply H4.
-Apply le_trans with (plus N n).
-Apply le_plus_r.
-Apply le_n_Sn.
-Cut (le O N).
-Cut (lt N (S (plus N n))).
-Intros; Assert H7 := (sigma_split [k:nat](fn k x) H6 H5).
-Unfold sigma in H7.
-Do 2 Rewrite <- minus_n_O in H7.
-Replace (sum_f_R0 [k:nat](fn k x) (S (plus N n))) with (sum_f_R0 [k:nat](fn (plus (0) k) x) (S (plus N n))).
-Replace (sum_f_R0 [k:nat](fn k x) N) with (sum_f_R0 [k:nat](fn (plus (0) k) x) N).
-Cut (minus (S (plus N n)) (S N))=n.
-Intro; Rewrite H8 in H7.
-Apply H7.
-Apply INR_eq; Rewrite minus_INR.
-Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
-Apply le_n_S; Apply le_plus_l.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply sum_eq; Intros.
-Reflexivity.
-Apply le_lt_n_Sm.
-Apply le_plus_l.
-Apply le_O_n.
-Qed.
-
-(* Comparaison of convergence for series *)
-Lemma Rseries_CV_comp : (An,Bn:nat->R) ((n:nat)``0<=(An n)<=(Bn n)``) -> (sigTT ? [l:R](Un_cv [N:nat](sum_f_R0 Bn N) l)) -> (sigTT ? [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
-Intros; Apply cv_cauchy_2.
-Assert H0 := (cv_cauchy_1 ? X).
-Unfold Cauchy_crit_series; Unfold Cauchy_crit.
-Intros; Elim (H0 eps H1); Intros.
-Exists x; Intros.
-Cut (Rle (R_dist (sum_f_R0 An n) (sum_f_R0 An m)) (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m))).
-Intro; Apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)).
-Assumption.
-Apply H2; Assumption.
-Assert H5 := (lt_eq_lt_dec n m).
-Elim H5; Intro.
-Elim a; Intro.
-Rewrite (tech2 An n m); [Idtac | Assumption].
-Rewrite (tech2 Bn n m); [Idtac | Assumption].
-Unfold R_dist; Unfold Rminus; Do 2 Rewrite Ropp_distr1; Do 2 Rewrite <- Rplus_assoc; Do 2 Rewrite Rplus_Ropp_r; Do 2 Rewrite Rplus_Ol; Do 2 Rewrite Rabsolu_Ropp; Repeat Rewrite Rabsolu_right.
-Apply sum_Rle; Intros.
-Elim (H (plus (S n) n0)); Intros.
-Apply H8.
-Apply Rle_sym1; Apply cond_pos_sum; Intro.
-Elim (H (plus (S n) n0)); Intros.
-Apply Rle_trans with (An (plus (S n) n0)); Assumption.
-Apply Rle_sym1; Apply cond_pos_sum; Intro.
-Elim (H (plus (S n) n0)); Intros; Assumption.
-Rewrite b; Unfold R_dist; Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Right; Reflexivity.
-Rewrite (tech2 An m n); [Idtac | Assumption].
-Rewrite (tech2 Bn m n); [Idtac | Assumption].
-Unfold R_dist; Unfold Rminus; Do 2 Rewrite Rplus_assoc; Rewrite (Rplus_sym (sum_f_R0 An m)); Rewrite (Rplus_sym (sum_f_R0 Bn m)); Do 2 Rewrite Rplus_assoc; Do 2 Rewrite Rplus_Ropp_l; Do 2 Rewrite Rplus_Or; Repeat Rewrite Rabsolu_right.
-Apply sum_Rle; Intros.
-Elim (H (plus (S m) n0)); Intros; Apply H8.
-Apply Rle_sym1; Apply cond_pos_sum; Intro.
-Elim (H (plus (S m) n0)); Intros.
-Apply Rle_trans with (An (plus (S m) n0)); Assumption.
-Apply Rle_sym1.
-Apply cond_pos_sum; Intro.
-Elim (H (plus (S m) n0)); Intros; Assumption.
-Qed.
-
-(* Cesaro's theorem *)
-Lemma Cesaro : (An,Bn:nat->R;l:R) (Un_cv Bn l) -> ((n:nat)``0<(An n)``) -> (cv_infty [n:nat](sum_f_R0 An n)) -> (Un_cv [n:nat](Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 An n)) l).
-Proof with Trivial.
-Unfold Un_cv; Intros; Assert H3 : (n:nat)``0<(sum_f_R0 An n)``.
-Intro; Apply tech1.
-Assert H4 : (n:nat) ``(sum_f_R0 An n)<>0``.
-Intro; Red; Intro; Assert H5 := (H3 n); Rewrite H4 in H5; Elim (Rlt_antirefl ? H5).
-Assert H5 := (cv_infty_cv_R0 ? H4 H1); Assert H6 : ``0<eps/2``.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Sup.
-Elim (H ? H6); Clear H; Intros N1 H; Pose C := (Rabsolu (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` N1)); Assert H7 : (EX N:nat | (n:nat) (le N n) -> ``C/(sum_f_R0 An n)<eps/2``).
-Case (Req_EM C R0); Intro.
-Exists O; Intros.
-Rewrite H7; Unfold Rdiv; Rewrite Rmult_Ol; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Sup.
-Assert H8 : ``0<eps/(2*(Rabsolu C))``.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply Rlt_Rinv; Apply Rmult_lt_pos.
-Sup.
-Apply Rabsolu_pos_lt.
-Elim (H5 ? H8); Intros; Exists x; Intros; Assert H11 := (H9 ? H10); Unfold R_dist in H11; Unfold Rminus in H11; Rewrite Ropp_O in H11; Rewrite Rplus_Or in H11.
-Apply Rle_lt_trans with (Rabsolu ``C/(sum_f_R0 An n)``).
-Apply Rle_Rabsolu.
-Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu C)``.
-Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Replace ``/(Rabsolu C)*(eps*/2)`` with ``eps/(2*(Rabsolu C))``.
-Unfold Rdiv; Rewrite Rinv_Rmult.
-Ring.
-DiscrR.
-Apply Rabsolu_no_R0.
-Apply Rabsolu_no_R0.
-Elim H7; Clear H7; Intros N2 H7; Pose N := (max N1 N2); Exists (S N); Intros; Unfold R_dist; Replace (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 An n)) l) with (Rdiv (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` n) (sum_f_R0 An n)).
-Assert H9 : (lt N1 n).
-Apply lt_le_trans with (S N).
-Apply le_lt_n_Sm; Unfold N; Apply le_max_l.
-Rewrite (tech2 [k:nat]``(An k)*((Bn k)-l)`` ? ? H9); Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Apply Rle_lt_trans with (Rplus (Rabsolu (Rdiv (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` N1) (sum_f_R0 An n))) (Rabsolu (Rdiv (sum_f_R0 [i:nat]``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)`` (minus n (S N1))) (sum_f_R0 An n)))).
-Apply Rabsolu_triang.
-Rewrite (double_var eps); Apply Rplus_lt.
-Unfold Rdiv; Rewrite Rabsolu_mult; Fold C; Rewrite Rabsolu_right.
-Apply (H7 n); Apply le_trans with (S N).
-Apply le_trans with N; [Unfold N; Apply le_max_r | Apply le_n_Sn].
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-
-Unfold R_dist in H; Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``/(sum_f_R0 An n)``).
-Apply Rle_lt_trans with (Rmult (sum_f_R0 [i:nat](Rabsolu ``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)``) (minus n (S N1))) ``/(sum_f_R0 An n)``).
-Do 2 Rewrite <- (Rmult_sym ``/(sum_f_R0 An n)``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv.
-Apply (sum_Rabsolu [i:nat]``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)`` (minus n (S N1))).
-Apply Rle_lt_trans with (Rmult (sum_f_R0 [i:nat]``(An (plus (S N1) i))*eps/2`` (minus n (S N1))) ``/(sum_f_R0 An n)``).
-Do 2 Rewrite <- (Rmult_sym ``/(sum_f_R0 An n)``); Apply Rle_monotony.
-Left; Apply Rlt_Rinv.
-Apply sum_Rle; Intros; Rewrite Rabsolu_mult; Pattern 2 (An (plus (S N1) n0)); Rewrite <- (Rabsolu_right (An (plus (S N1) n0))).
-Apply Rle_monotony.
-Apply Rabsolu_pos.
-Left; Apply H; Unfold ge; Apply le_trans with (S N1); [Apply le_n_Sn | Apply le_plus_l].
-Apply Rle_sym1; Left.
-Rewrite <- (scal_sum [i:nat](An (plus (S N1) i)) (minus n (S N1)) ``eps/2``); Unfold Rdiv; Repeat Rewrite Rmult_assoc; Apply Rlt_monotony.
-Pattern 2 ``/2``; Rewrite <- Rmult_1r; Apply Rlt_monotony.
-Apply Rlt_Rinv; Sup.
-Rewrite Rmult_sym; Apply Rlt_monotony_contra with (sum_f_R0 An n).
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite Rmult_1r; Rewrite (tech2 An N1 n).
-Rewrite Rplus_sym; Pattern 1 (sum_f_R0 [i:nat](An (plus (S N1) i)) (minus n (S N1))); Rewrite <- Rplus_Or; Apply Rlt_compatibility.
-Apply Rle_sym1; Left; Apply Rlt_Rinv.
-Replace (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` n) with (Rplus (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 [k:nat]``(An k)*-l`` n)).
-Rewrite <- (scal_sum An n ``-l``); Field.
-Rewrite <- plus_sum; Apply sum_eq; Intros; Ring.
-Qed.
-
-Lemma Cesaro_1 : (An:nat->R;l:R) (Un_cv An l) -> (Un_cv [n:nat]``(sum_f_R0 An (pred n))/(INR n)`` l).
-Proof with Trivial.
-Intros Bn l H; Pose An := [_:nat]R1.
-Assert H0 : (n:nat) ``0<(An n)``.
-Intro; Unfold An; Apply Rlt_R0_R1.
-Assert H1 : (n:nat)``0<(sum_f_R0 An n)``.
-Intro; Apply tech1.
-Assert H2 : (cv_infty [n:nat](sum_f_R0 An n)).
-Unfold cv_infty; Intro; Case (total_order_Rle M R0); Intro.
-Exists O; Intros; Apply Rle_lt_trans with R0.
-Assert H2 : ``0<M``.
-Auto with real.
-Clear n; Pose m := (up M); Elim (archimed M); Intros; Assert H5 : `0<=m`.
-Apply le_IZR; Unfold m; Simpl; Left; Apply Rlt_trans with M.
-Elim (IZN ? H5); Intros; Exists x; Intros; Unfold An; Rewrite sum_cte; Rewrite Rmult_1l; Apply Rlt_trans with (IZR (up M)).
-Apply Rle_lt_trans with (INR x).
-Rewrite INR_IZR_INZ; Fold m; Rewrite <- H6; Right.
-Apply lt_INR; Apply le_lt_n_Sm.
-Assert H3 := (Cesaro ? ? ? H H0 H2).
-Unfold Un_cv; Unfold Un_cv in H3; Intros; Elim (H3 ? H4); Intros; Exists (S x); Intros; Unfold R_dist; Unfold R_dist in H5; Apply Rle_lt_trans with (Rabsolu (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` (pred n)) (sum_f_R0 An (pred n))) l)).
-Right; Replace ``(sum_f_R0 Bn (pred n))/(INR n)-l`` with (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` (pred n)) (sum_f_R0 An (pred n))) l).
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-l``); Apply Rplus_plus_r.
-Unfold An; Replace (sum_f_R0 [k:nat]``1*(Bn k)`` (pred n)) with (sum_f_R0 Bn (pred n)).
-Rewrite sum_cte; Rewrite Rmult_1l; Replace (S (pred n)) with n.
-Apply S_pred with O; Apply lt_le_trans with (S x).
-Apply lt_O_Sn.
-Apply sum_eq; Intros; Ring.
-Apply H5; Unfold ge; Apply le_S_n; Replace (S (pred n)) with n.
-Apply S_pred with O; Apply lt_le_trans with (S x).
-Apply lt_O_Sn.
-Qed.
diff --git a/theories7/Reals/SplitAbsolu.v b/theories7/Reals/SplitAbsolu.v
deleted file mode 100644
index 30580a0c..00000000
--- a/theories7/Reals/SplitAbsolu.v
+++ /dev/null
@@ -1,22 +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: SplitAbsolu.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $       i*)
-
-Require Rbasic_fun.
-
-Recursive Tactic Definition SplitAbs :=
-  Match Context With
-    | [ |- [(case_Rabsolu ?1)] ] -> 
-         Case (case_Rabsolu ?1); Try SplitAbs.
-
-
-Recursive Tactic Definition SplitAbsolu :=
-  Match Context With
-    | [ id:[(Rabsolu ?)] |- ? ] -> Generalize id; Clear id;Try SplitAbsolu
-    | [ |- [(Rabsolu ?1)] ] ->  Unfold Rabsolu; Try SplitAbs;Intros.
diff --git a/theories7/Reals/Sqrt_reg.v b/theories7/Reals/Sqrt_reg.v
deleted file mode 100644
index d2068e5d..00000000
--- a/theories7/Reals/Sqrt_reg.v
+++ /dev/null
@@ -1,297 +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: Sqrt_reg.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
-
-Require Rbase.
-Require Rfunctions.
-Require Ranalysis1.
-Require R_sqrt.
-V7only [Import R_scope.]. Open Local Scope R_scope.
-
-(**********)
-Lemma sqrt_var_maj : (h:R) ``(Rabsolu h) <= 1`` -> ``(Rabsolu ((sqrt (1+h))-1))<=(Rabsolu h)``.
-Intros; Cut ``0<=1+h``.
-Intro; Apply Rle_trans with ``(Rabsolu ((sqrt (Rsqr (1+h)))-1))``.
-Case (total_order_T h R0); Intro.
-Elim s; Intro.
-Repeat Rewrite Rabsolu_left.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-1``).
-Do 2 Rewrite Ropp_distr1;Rewrite Ropp_Ropp; Apply Rle_compatibility.
-Apply Rle_Ropp1; Apply sqrt_le_1.
-Apply pos_Rsqr.
-Apply H0.
-Pattern 2 ``1+h``; Rewrite <- Rmult_1r; Unfold Rsqr; Apply Rle_monotony.
-Apply H0.
-Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
-Apply Rlt_anti_compatibility with R1; Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 2 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
-Apply pos_Rsqr.
-Left; Apply Rlt_R0_R1.
-Pattern 2 R1; Rewrite <- Rsqr_1; Apply Rsqr_incrst_1.
-Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Apply H0.
-Left; Apply Rlt_R0_R1.
-Apply Rlt_anti_compatibility with R1; Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 2 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
-Apply H0.
-Left; Apply Rlt_R0_R1.
-Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Rewrite b; Rewrite Rplus_Or; Rewrite Rsqr_1; Rewrite sqrt_1; Right; Reflexivity.
-Repeat Rewrite Rabsolu_right.
-Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-1``); Apply Rle_compatibility.
-Apply sqrt_le_1.
-Apply H0.
-Apply pos_Rsqr.
-Pattern 1 ``1+h``; Rewrite <- Rmult_1r; Unfold Rsqr; Apply Rle_monotony.
-Apply H0.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
-Apply Rle_sym1; Apply Rle_anti_compatibility with R1.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 1 R1; Rewrite <- sqrt_1; Apply sqrt_le_1.
-Left; Apply Rlt_R0_R1.
-Apply pos_Rsqr.
-Pattern 1 R1; Rewrite <- Rsqr_1; Apply Rsqr_incr_1.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
-Left; Apply Rlt_R0_R1.
-Apply H0.
-Apply Rle_sym1; Left; Apply Rlt_anti_compatibility with R1.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
-Pattern 1 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
-Left; Apply Rlt_R0_R1.
-Apply H0.
-Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
-Rewrite sqrt_Rsqr.
-Replace ``(1+h)-1`` with h; [Right; Reflexivity | Ring].
-Apply H0.
-Case (total_order_T h R0); Intro.
-Elim s; Intro.
-Rewrite (Rabsolu_left h a) in H.
-Apply Rle_anti_compatibility with ``-h``.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Exact H.
-Left; Rewrite b; Rewrite Rplus_Or; Apply Rlt_R0_R1.
-Left; Apply gt0_plus_gt0_is_gt0.
-Apply Rlt_R0_R1.
-Apply r.
-Qed.
-
-(* sqrt is continuous in 1 *)
-Lemma sqrt_continuity_pt_R1 : (continuity_pt sqrt R1).
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Pose alpha := (Rmin eps R1).
-Exists alpha; Intros.
-Split.
-Unfold alpha; Unfold Rmin; Case (total_order_Rle eps R1); Intro.
-Assumption.
-Apply Rlt_R0_R1.
-Intros; Elim H0; Intros.
-Rewrite sqrt_1; Replace x with ``1+(x-1)``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu (x-1))``.
-Apply sqrt_var_maj.
-Apply Rle_trans with alpha.
-Left; Apply H2.
-Unfold alpha; Apply Rmin_r.
-Apply Rlt_le_trans with alpha; [Apply H2 | Unfold alpha; Apply Rmin_l].
-Qed.
-
-(* sqrt is continuous forall x>0 *)
-Lemma sqrt_continuity_pt : (x:R) ``0<x`` -> (continuity_pt sqrt x).
-Intros; Generalize sqrt_continuity_pt_R1.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
-Cut ``0<eps/(sqrt x)``.
-Intro; Elim (H0 ? H2); Intros alp_1 H3.
-Elim H3; Intros.
-Pose alpha := ``alp_1*x``.
-Exists (Rmin alpha x); Intros.
-Split.
-Change ``0<(Rmin alpha x)``; Unfold Rmin; Case (total_order_Rle alpha x); Intro.
-Unfold alpha; Apply Rmult_lt_pos; Assumption.
-Apply H.
-Intros; Replace x0 with ``x+(x0-x)``; [Idtac | Ring]; Replace ``(sqrt (x+(x0-x)))-(sqrt x)`` with ``(sqrt x)*((sqrt (1+(x0-x)/x))-(sqrt 1))``.
-Rewrite Rabsolu_mult; Rewrite (Rabsolu_right (sqrt x)).
-Apply Rlt_monotony_contra with ``/(sqrt x)``.
-Apply Rlt_Rinv; Apply sqrt_lt_R0; Assumption.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1l; Rewrite Rmult_sym.
-Unfold Rdiv in H5.
-Case (Req_EM x x0); Intro.
-Rewrite H7; Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rplus_Or; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
-Apply Rmult_lt_pos.
-Assumption.
-Apply Rlt_Rinv; Rewrite <- H7; Apply sqrt_lt_R0; Assumption.
-Apply H5.
-Split.
-Unfold D_x no_cond.
-Split.
-Trivial.
-Red; Intro.
-Cut ``(x0-x)*/x==0``.
-Intro.
-Elim (without_div_Od ? ? H9); Intro.
-Elim H7.
-Apply (Rminus_eq_right ? ? H10).
-Assert H11 := (without_div_Oi1 ? x H10).
-Rewrite <- Rinv_l_sym in H11.
-Elim R1_neq_R0; Exact H11.
-Red; Intro; Rewrite H12 in H; Elim (Rlt_antirefl ? H).
-Symmetry; Apply r_Rplus_plus with R1; Rewrite Rplus_Or; Unfold Rdiv in H8; Exact H8.
-Unfold Rminus; Rewrite Rplus_sym; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Elim H6; Intros.
-Unfold Rdiv; Rewrite Rabsolu_mult.
-Rewrite Rabsolu_Rinv.
-Rewrite (Rabsolu_right x).
-Rewrite Rmult_sym; Apply Rlt_monotony_contra with x.
-Apply H.
-Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
-Rewrite Rmult_1l; Rewrite Rmult_sym; Fold alpha.
-Apply Rlt_le_trans with (Rmin alpha x).
-Apply H9.
-Apply Rmin_l.
-Red; Intro; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
-Apply Rle_sym1; Left; Apply H.
-Red; Intro; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
-Assert H7 := (sqrt_lt_R0 x H).
-Red; Intro; Rewrite H8 in H7; Elim (Rlt_antirefl ? H7).
-Apply Rle_sym1; Apply sqrt_positivity.
-Left; Apply H.
-Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Ropp_mul3; Repeat Rewrite <- sqrt_times.
-Rewrite Rmult_1r; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Unfold Rdiv; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Reflexivity.
-Red; Intro; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
-Left; Apply H.
-Left; Apply Rlt_R0_R1.
-Left; Apply H.
-Elim H6; Intros.
-Case (case_Rabsolu ``x0-x``); Intro.
-Rewrite (Rabsolu_left ``x0-x`` r) in H8.
-Rewrite Rplus_sym.
-Apply Rle_anti_compatibility with ``-((x0-x)/x)``.
-Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Unfold Rdiv; Rewrite <- Ropp_mul1.
-Apply Rle_monotony_contra with x.
-Apply H.
-Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
-Rewrite Rmult_1r; Left; Apply Rlt_le_trans with (Rmin alpha x).
-Apply H8.
-Apply Rmin_r.
-Red; Intro; Rewrite H9 in H; Elim (Rlt_antirefl ? H).
-Apply ge0_plus_ge0_is_ge0.
-Left; Apply Rlt_R0_R1.
-Unfold Rdiv; Apply Rmult_le_pos.
-Apply Rle_sym2; Exact r.
-Left; Apply Rlt_Rinv; Apply H.
-Unfold Rdiv; Apply Rmult_lt_pos.
-Apply H1.
-Apply Rlt_Rinv; Apply sqrt_lt_R0; Apply H.
-Qed.
-
-(* sqrt is derivable for all x>0 *)
-Lemma derivable_pt_lim_sqrt : (x:R) ``0<x`` -> (derivable_pt_lim sqrt x ``/(2*(sqrt x))``).
-Intros; Pose g := [h:R]``(sqrt x)+(sqrt (x+h))``.
-Cut (continuity_pt g R0).
-Intro; Cut ``(g 0)<>0``.
-Intro; Assert H2 := (continuity_pt_inv g R0 H0 H1).
-Unfold derivable_pt_lim; Intros; Unfold continuity_pt in H2; Unfold continue_in in H2; Unfold limit1_in in H2; Unfold limit_in in H2; Simpl in H2; Unfold R_dist in H2.
-Elim (H2 eps H3); Intros alpha H4.
-Elim H4; Intros.
-Pose alpha1 := (Rmin alpha x).
-Cut ``0<alpha1``.
-Intro; Exists (mkposreal alpha1 H7); Intros.
-Replace ``((sqrt (x+h))-(sqrt x))/h`` with ``/((sqrt x)+(sqrt (x+h)))``.
-Unfold inv_fct g in H6; Replace ``2*(sqrt x)`` with ``(sqrt x)+(sqrt (x+0))``.
-Apply H6.
-Split.
-Unfold D_x no_cond.
-Split.
-Trivial.
-Apply not_sym; Exact H8.
-Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rlt_le_trans with alpha1.
-Exact H9.
-Unfold alpha1; Apply Rmin_l.
-Rewrite Rplus_Or; Ring.
-Cut ``0<=x+h``.
-Intro; Cut ``0<(sqrt x)+(sqrt (x+h))``.
-Intro; Apply r_Rmult_mult with ``((sqrt x)+(sqrt (x+h)))``.
-Rewrite <- Rinv_r_sym.
-Rewrite Rplus_sym; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rsqr_plus_minus; Repeat Rewrite Rsqr_sqrt.
-Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Rewrite <- Rinv_r_sym.
-Reflexivity.
-Apply H8.
-Left; Apply H.
-Assumption.
-Red; Intro; Rewrite H12 in H11; Elim (Rlt_antirefl ? H11).
-Red; Intro; Rewrite H12 in H11; Elim (Rlt_antirefl ? H11).
-Apply gt0_plus_ge0_is_gt0.
-Apply sqrt_lt_R0; Apply H.
-Apply sqrt_positivity; Apply H10.
-Case (case_Rabsolu h); Intro.
-Rewrite (Rabsolu_left h r) in H9.
-Apply Rle_anti_compatibility with ``-h``.
-Rewrite Rplus_Or; Rewrite Rplus_sym; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Left; Apply Rlt_le_trans with alpha1.
-Apply H9.
-Unfold alpha1; Apply Rmin_r.
-Apply ge0_plus_ge0_is_ge0.
-Left; Assumption.
-Apply Rle_sym2; Apply r.
-Unfold alpha1; Unfold Rmin; Case (total_order_Rle alpha x); Intro.
-Apply H5.
-Apply H.
-Unfold g; Rewrite Rplus_Or.
-Cut ``0<(sqrt x)+(sqrt x)``.
-Intro; Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
-Apply gt0_plus_gt0_is_gt0; Apply sqrt_lt_R0; Apply H.
-Replace g with (plus_fct (fct_cte (sqrt x)) (comp sqrt (plus_fct (fct_cte x) id))); [Idtac | Reflexivity].
-Apply continuity_pt_plus.
-Apply continuity_pt_const; Unfold constant fct_cte; Intro; Reflexivity.
-Apply continuity_pt_comp.
-Apply continuity_pt_plus.
-Apply continuity_pt_const; Unfold constant fct_cte; Intro; Reflexivity.
-Apply derivable_continuous_pt; Apply derivable_pt_id.
-Apply sqrt_continuity_pt.
-Unfold plus_fct fct_cte id; Rewrite Rplus_Or; Apply H.
-Qed.
-
-(**********)
-Lemma derivable_pt_sqrt : (x:R) ``0<x`` -> (derivable_pt sqrt x).
-Unfold derivable_pt; Intros.
-Apply Specif.existT with ``/(2*(sqrt x))``.
-Apply derivable_pt_lim_sqrt; Assumption.
-Qed.
-
-(**********)
-Lemma derive_pt_sqrt : (x:R;pr:``0<x``) ``(derive_pt sqrt x (derivable_pt_sqrt ? pr)) == /(2*(sqrt x))``.
-Intros.
-Apply derive_pt_eq_0.
-Apply derivable_pt_lim_sqrt; Assumption.
-Qed.
-
-(* We show that sqrt is continuous for all x>=0 *)
-(* Remark : by definition of sqrt (as extension of Rsqrt on |R), *)
-(*          we could also show that sqrt is continuous for all x *)
-Lemma continuity_pt_sqrt : (x:R) ``0<=x`` -> (continuity_pt sqrt x).
-Intros; Case (total_order R0 x); Intro.
-Apply (sqrt_continuity_pt x H0).
-Elim H0; Intro.
-Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
-Exists (Rsqr eps); Intros.
-Split.
-Change ``0<(Rsqr eps)``; Apply Rsqr_pos_lt.
-Red; Intro; Rewrite H3 in H2; Elim (Rlt_antirefl ? H2).
-Intros; Elim H3; Intros.
-Rewrite <- H1; Rewrite sqrt_0; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite <- H1 in H5; Unfold Rminus in H5; Rewrite Ropp_O in H5; Rewrite Rplus_Or in H5.
-Case (case_Rabsolu x0); Intro.
-Unfold sqrt; Case (case_Rabsolu x0); Intro.
-Rewrite Rabsolu_R0; Apply H2.
-Assert H6 := (Rle_sym2 ? ? r0); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 r)).
-Rewrite Rabsolu_right.
-Apply Rsqr_incrst_0.
-Rewrite Rsqr_sqrt.
-Rewrite (Rabsolu_right x0 r) in H5; Apply H5.
-Apply Rle_sym2; Exact r.
-Apply sqrt_positivity; Apply Rle_sym2; Exact r.
-Left; Exact H2.
-Apply Rle_sym1; Apply sqrt_positivity; Apply Rle_sym2; Exact r.
-Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H1 H)).
-Qed.
diff --git a/theories7/Relations/Newman.v b/theories7/Relations/Newman.v
deleted file mode 100755
index c53db971..00000000
--- a/theories7/Relations/Newman.v
+++ /dev/null
@@ -1,115 +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: Newman.v,v 1.1.2.1 2004/07/16 19:31:37 herbelin Exp $ i*)
-
-Require Rstar.
-
-Section Newman.
-
-Variable A: Type. 
-Variable R: A->A->Prop.
-
-Local Rstar := (Rstar A R). 
-Local Rstar_reflexive := (Rstar_reflexive A R).
-Local Rstar_transitive := (Rstar_transitive A R).
-Local Rstar_Rstar' := (Rstar_Rstar' A R).
-
-Definition coherence := [x:A][y:A] (exT2 ? (Rstar x) (Rstar y)).
-
-Theorem coherence_intro :  (x:A)(y:A)(z:A)(Rstar x z)->(Rstar y z)->(coherence x y).
-Proof [x:A][y:A][z:A][h1:(Rstar x z)][h2:(Rstar y z)]
-      (exT_intro2 A (Rstar x) (Rstar y) z h1 h2).
-  
-(** A very simple case of coherence : *)
-
-Lemma Rstar_coherence : (x:A)(y:A)(Rstar x y)->(coherence x y).
- Proof  [x:A][y:A][h:(Rstar x y)](coherence_intro x y y h (Rstar_reflexive y)).  
-  
-(** coherence is symmetric *)
-Lemma coherence_sym: (x:A)(y:A)(coherence x y)->(coherence y x).
- Proof [x:A][y:A][h:(coherence x y)]
-        (exT2_ind A (Rstar x) (Rstar y) (coherence y x)
-                 [w:A][h1:(Rstar x w)][h2:(Rstar y w)]
-                      (coherence_intro y x w h2 h1) h).
-
-Definition confluence :=
-     [x:A](y:A)(z:A)(Rstar x y)->(Rstar x z)->(coherence y z).  
-  
-Definition local_confluence :=
-     [x:A](y:A)(z:A)(R x y)->(R x z)->(coherence y z).  
-  
-Definition noetherian :=
-     (x:A)(P:A->Prop)((y:A)((z:A)(R y z)->(P z))->(P y))->(P x).  
-  
-Section Newman_section.
-
-(** The general hypotheses of the theorem *)
-
-Hypothesis Hyp1:noetherian.
-Hypothesis Hyp2:(x:A)(local_confluence x).  
-  
-(** The induction hypothesis *)
-
-Section Induct.
-  Variable    x:A.
-  Hypothesis  hyp_ind:(u:A)(R x u)->(confluence u).  
-  
-(** Confluence in [x] *)
-
-  Variables   y,z:A.  
-  Hypothesis  h1:(Rstar x y).  
-  Hypothesis  h2:(Rstar x z).  
-  
-(** particular case [x->u] and [u->*y]   *)
-Section Newman_.
-  Variable    u:A.  
-  Hypothesis  t1:(R x u).  
-  Hypothesis  t2:(Rstar u y).  
-  
-(** In the usual diagram, we assume also [x->v] and [v->*z] *)
-
-Theorem Diagram : (v:A)(u1:(R x v))(u2:(Rstar v z))(coherence y z).
-
-Proof     (* We draw the diagram ! *)
-   [v:A][u1:(R x v)][u2:(Rstar v z)]
-   (exT2_ind A (Rstar u) (Rstar v)    (* local confluence in x for u,v *)
-      (coherence y z)                (* gives w, u->*w and v->*w *)
-      ([w:A][s1:(Rstar u w)][s2:(Rstar v w)]
-   (exT2_ind A (Rstar y) (Rstar w)    (* confluence in u => coherence(y,w) *)
-      (coherence y z)                (* gives a, y->*a and z->*a *)
-      ([a:A][v1:(Rstar y a)][v2:(Rstar w a)]
-   (exT2_ind A (Rstar a) (Rstar z)    (* confluence in v => coherence(a,z) *)
-      (coherence y z)                (* gives b, a->*b and z->*b *)
-      ([b:A][w1:(Rstar a b)][w2:(Rstar z b)]
-        (coherence_intro y z b (Rstar_transitive y a b v1 w1) w2))
-      (hyp_ind v u1 a z (Rstar_transitive v w a s2 v2) u2)))
-     (hyp_ind u t1 y w t2 s1)))
-    (Hyp2 x u v t1 u1)).
-  
-Theorem caseRxy : (coherence y z).
-Proof (Rstar_Rstar' x z h2 
-      ([v:A][w:A](coherence y w))
-      (coherence_sym x y (Rstar_coherence x y h1))  (*i case x=z i*)
-      Diagram).                                     (*i case x->v->*z i*)
-End Newman_.
-
-Theorem Ind_proof : (coherence y z).
-Proof (Rstar_Rstar' x y h1 ([u:A][v:A](coherence v z))
-        (Rstar_coherence x z h2)                    (*i case x=y i*)
-        caseRxy).                                   (*i case x->u->*z i*)
-End Induct.
-
-Theorem Newman : (x:A)(confluence x).
-Proof [x:A](Hyp1 x confluence Ind_proof).  
-
-End Newman_section.
-
-
-End Newman.
-
diff --git a/theories7/Relations/Operators_Properties.v b/theories7/Relations/Operators_Properties.v
deleted file mode 100755
index 4f1818bc..00000000
--- a/theories7/Relations/Operators_Properties.v
+++ /dev/null
@@ -1,98 +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: Operators_Properties.v,v 1.1.2.1 2004/07/16 19:31:37 herbelin Exp $ i*)
-
-(****************************************************************************)
-(*                            Bruno Barras                                  *)
-(****************************************************************************)
-
-Require Relation_Definitions.
-Require Relation_Operators.
-
-
-Section Properties.
-
-  Variable A: Set.
-  Variable R: (relation A).
-
-  Local incl : (relation A)->(relation A)->Prop :=
-      [R1,R2: (relation A)] (x,y:A) (R1 x y) -> (R2 x y).
-
-Section Clos_Refl_Trans.
-
-  Lemma clos_rt_is_preorder: (preorder A (clos_refl_trans A R)).
-Apply Build_preorder.
-Exact (rt_refl A R).
-
-Exact (rt_trans A R).
-Qed.
-
-
-
-Lemma clos_rt_idempotent:
-       (incl (clos_refl_trans A (clos_refl_trans A R))
-                     (clos_refl_trans A R)).
-Red.
-NewInduction 1; Auto with sets.
-Intros.
-Apply rt_trans with y; Auto with sets.
-Qed.
-
-  Lemma  clos_refl_trans_ind_left: (A:Set)(R:A->A->Prop)(M:A)(P:A->Prop)
-           (P M)
-            ->((P0,N:A)
-                (clos_refl_trans A R M P0)->(P P0)->(R P0 N)->(P N))
-               ->(a:A)(clos_refl_trans A R M a)->(P a).
-Intros.
-Generalize H H0 .
-Clear  H H0.
-Elim H1; Intros; Auto with sets.
-Apply H2 with x; Auto with sets.
-
-Apply H3.
-Apply H0; Auto with sets.
-
-Intros.
-Apply H5 with P0; Auto with sets.
-Apply rt_trans with y; Auto with sets.
-Qed.
-
-
-End Clos_Refl_Trans.
-
-
-Section Clos_Refl_Sym_Trans.
-
-  Lemma clos_rt_clos_rst: (inclusion A (clos_refl_trans A R)
-				        (clos_refl_sym_trans A R)).
-Red.
-NewInduction 1; Auto with sets.
-Apply rst_trans with y; Auto with sets.
-Qed.
-
-  Lemma clos_rst_is_equiv: (equivalence A (clos_refl_sym_trans A R)).
-Apply Build_equivalence.
-Exact (rst_refl A R).
-
-Exact (rst_trans A R).
-
-Exact (rst_sym A R).
-Qed.
-
-  Lemma clos_rst_idempotent:
-       (incl (clos_refl_sym_trans A (clos_refl_sym_trans A R))
-                     (clos_refl_sym_trans A R)).
-Red.
-NewInduction 1; Auto with sets.
-Apply rst_trans with y; Auto with sets.
-Qed.
-
-End Clos_Refl_Sym_Trans.
-
-End Properties.
diff --git a/theories7/Relations/Relation_Definitions.v b/theories7/Relations/Relation_Definitions.v
deleted file mode 100755
index 1e38e753..00000000
--- a/theories7/Relations/Relation_Definitions.v
+++ /dev/null
@@ -1,83 +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: Relation_Definitions.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
-
-Section Relation_Definition.
-
-   Variable A: Type.
-   
-   Definition relation :=  A -> A -> Prop.
-
-   Variable R: relation.
-   
-
-Section General_Properties_of_Relations.
-
-  Definition reflexive : Prop :=  (x: A) (R x x).
-  Definition transitive : Prop :=  (x,y,z: A) (R x y) -> (R y z) -> (R x z).
-  Definition symmetric : Prop :=  (x,y: A) (R x y) -> (R y x).
-  Definition antisymmetric : Prop :=  (x,y: A) (R x y) -> (R y x) -> x=y.
-
-  (* for compatibility with Equivalence in  ../PROGRAMS/ALG/  *)
-  Definition equiv := reflexive /\ transitive /\ symmetric.
-
-End General_Properties_of_Relations.
-
-
-
-Section Sets_of_Relations.
-
-   Record preorder : Prop := {
-       preord_refl  : reflexive;
-       preord_trans : transitive }.
-
-   Record order : Prop := {
-       ord_refl    : reflexive;
-       ord_trans   : transitive;
-       ord_antisym : antisymmetric }.
-
-   Record equivalence : Prop := {
-       equiv_refl  : reflexive;
-       equiv_trans : transitive;
-       equiv_sym   : symmetric }.
-   
-   Record PER : Prop := {
-       per_sym   : symmetric;
-       per_trans : transitive }.
-
-End Sets_of_Relations.
-
-
-
-Section Relations_of_Relations.
-
-  Definition inclusion : relation -> relation -> Prop :=
-      [R1,R2: relation] (x,y:A) (R1 x y) -> (R2 x y).
-
-  Definition same_relation : relation -> relation -> Prop :=
-      [R1,R2: relation] (inclusion R1 R2) /\ (inclusion R2 R1).
-   
-  Definition commut : relation -> relation -> Prop :=
-      [R1,R2:relation] (x,y:A) (R1 y x) -> (z:A) (R2 z y)
-                          -> (EX y':A |(R2 y' x) & (R1 z y')).
-
-End Relations_of_Relations.
-
-   
-End Relation_Definition.
-
-Hints Unfold reflexive transitive antisymmetric symmetric : sets v62.
-
-Hints Resolve Build_preorder Build_order Build_equivalence 
-	Build_PER preord_refl preord_trans 
-	ord_refl ord_trans ord_antisym
-	equiv_refl equiv_trans equiv_sym
-	per_sym per_trans : sets v62.
-
-Hints Unfold inclusion same_relation commut : sets v62.
diff --git a/theories7/Relations/Relation_Operators.v b/theories7/Relations/Relation_Operators.v
deleted file mode 100755
index 14c2ae30..00000000
--- a/theories7/Relations/Relation_Operators.v
+++ /dev/null
@@ -1,157 +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: Relation_Operators.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
-
-(****************************************************************************)
-(*                      Bruno Barras, Cristina Cornes                       *)
-(*                                                                          *)
-(*  Some of these definitons were taken from :                              *)
-(*     Constructing Recursion Operators in Type Theory                      *)
-(*     L. Paulson  JSC (1986) 2, 325-355                                    *)
-(****************************************************************************)
-
-Require Relation_Definitions.
-Require PolyList.
-Require PolyListSyntax.
-
-(** Some operators to build relations *)
-
-Section Transitive_Closure.
-  Variable A: Set.
-  Variable R: (relation A).
-
-  Inductive clos_trans : A->A->Prop :=
-     t_step: (x,y:A)(R x y)->(clos_trans x y)
-   | t_trans: (x,y,z:A)(clos_trans x y)->(clos_trans y z)->(clos_trans x z).
-End Transitive_Closure.
-
-
-Section Reflexive_Transitive_Closure.
-  Variable A: Set.
-  Variable R: (relation A).
-
-  Inductive clos_refl_trans: (relation A) :=
-    rt_step: (x,y:A)(R x y)->(clos_refl_trans x y)
-  | rt_refl: (x:A)(clos_refl_trans x x)
-  | rt_trans: (x,y,z: A)(clos_refl_trans x y)->(clos_refl_trans y z)
-                      ->(clos_refl_trans x z).
-End Reflexive_Transitive_Closure.
-
-
-Section Reflexive_Symetric_Transitive_Closure.
-  Variable A: Set.
-  Variable R: (relation A).
-
-  Inductive clos_refl_sym_trans: (relation A) :=
-    rst_step: (x,y:A)(R x y)->(clos_refl_sym_trans x y)
-  | rst_refl: (x:A)(clos_refl_sym_trans x x)
-  | rst_sym: (x,y:A)(clos_refl_sym_trans x y)->(clos_refl_sym_trans y x)
-  | rst_trans: (x,y,z:A)(clos_refl_sym_trans x y)->(clos_refl_sym_trans y z)
-                      ->(clos_refl_sym_trans x z).
-End Reflexive_Symetric_Transitive_Closure.
-
-
-Section Transposee.
-  Variable A: Set.
-  Variable R: (relation A).
-
-  Definition transp := [x,y:A](R y x).
-End Transposee.
-
-
-Section Union.
-  Variable A: Set.
-  Variable R1,R2: (relation A).
-
-  Definition union := [x,y:A](R1 x y)\/(R2 x y).
-End Union.
-
-
-Section Disjoint_Union.
-Variable A,B:Set.
-Variable leA: A->A->Prop.
-Variable leB: B->B->Prop.
-
-Inductive le_AsB : A+B->A+B->Prop :=
-   le_aa: (x,y:A) (leA x y) -> (le_AsB (inl A B x) (inl A B y))
-|  le_ab: (x:A)(y:B) (le_AsB (inl A B x) (inr A B y))
-|  le_bb: (x,y:B)  (leB x y) -> (le_AsB (inr A B x) (inr A B y)).
-
-End Disjoint_Union. 
-
-
-
-Section Lexicographic_Product.
-(* Lexicographic order on dependent pairs *)
-
-Variable A:Set.
-Variable B:A->Set.
-Variable leA: A->A->Prop.
-Variable leB: (x:A)(B x)->(B x)->Prop.
-
-Inductive lexprod : (sigS A B) -> (sigS A B) ->Prop :=
-  left_lex : (x,x':A)(y:(B x)) (y':(B x')) 
-               (leA x x') ->(lexprod (existS A B x y) (existS A B x' y'))
-| right_lex : (x:A) (y,y':(B x)) 
-                (leB x y y') -> (lexprod (existS A B x y) (existS A B x y')).
-End Lexicographic_Product.
-
-
-Section Symmetric_Product.
-  Variable A:Set.
-  Variable B:Set.
-  Variable leA: A->A->Prop.
-  Variable leB: B->B->Prop.
-
-  Inductive symprod : (A*B) -> (A*B) ->Prop :=
-     left_sym : (x,x':A)(leA x x')->(y:B)(symprod (x,y) (x',y))
-  | right_sym : (y,y':B)(leB y y')->(x:A)(symprod (x,y) (x,y')).
-
-End Symmetric_Product.
-
-
-Section Swap.
-  Variable A:Set.
-  Variable R:A->A->Prop.
-
-  Inductive swapprod: (A*A)->(A*A)->Prop :=
-     sp_noswap: (x,x':A*A)(symprod A A R R x x')->(swapprod x x')
-   | sp_swap: (x,y:A)(p:A*A)(symprod A A R R (x,y) p)->(swapprod (y,x) p).
-End Swap.
-
-
-Section Lexicographic_Exponentiation.
-
-Variable A : Set.
-Variable leA : A->A->Prop.
-Local Nil := (nil A).
-Local List := (list A).
-
-Inductive Ltl : List->List->Prop :=
-  Lt_nil: (a:A)(x:List)(Ltl Nil (cons a x))
-| Lt_hd : (a,b:A) (leA a b)-> (x,y:(list A))(Ltl (cons a x) (cons b y))
-| Lt_tl : (a:A)(x,y:List)(Ltl x y) -> (Ltl (cons a x) (cons a y)).
-
-
-Inductive Desc : List->Prop :=
-   d_nil : (Desc Nil)
-|  d_one : (x:A)(Desc (cons x Nil))
-|  d_conc : (x,y:A)(l:List)(leA x y) 
-              -> (Desc l^(cons y Nil))->(Desc (l^(cons y Nil))^(cons x Nil)).
-
-Definition  Pow :Set := (sig List Desc).
-
-Definition lex_exp : Pow -> Pow ->Prop := 
-      [a,b:Pow](Ltl (proj1_sig List Desc a) (proj1_sig  List Desc b)).
-
-End Lexicographic_Exponentiation.
-
-Hints Unfold transp union : sets v62.
-Hints Resolve t_step rt_step rt_refl rst_step rst_refl : sets v62.
-Hints Immediate rst_sym : sets v62.
diff --git a/theories7/Relations/Relations.v b/theories7/Relations/Relations.v
deleted file mode 100755
index 694d0eec..00000000
--- a/theories7/Relations/Relations.v
+++ /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: Relations.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
-
-Require Export Relation_Definitions.
-Require Export Relation_Operators.
-Require Export Operators_Properties.
-
-Lemma inverse_image_of_equivalence : (A,B:Set)(f:A->B)
-  (r:(relation B))(equivalence B r)->(equivalence A [x,y:A](r (f x) (f y))).
-Intros; Split; Elim H; Red; Auto.
-Intros _ equiv_trans _ x y z H0 H1; Apply equiv_trans with (f y); Assumption.
-Qed.
-
-Lemma inverse_image_of_eq : (A,B:Set)(f:A->B)
-  (equivalence A [x,y:A](f x)=(f y)).
-Split; Red;
-[ (* reflexivity *)  Reflexivity
-| (* transitivity *) Intros; Transitivity (f y); Assumption
-| (* symmetry *) Intros; Symmetry; Assumption
-].
-Qed.
diff --git a/theories7/Relations/Rstar.v b/theories7/Relations/Rstar.v
deleted file mode 100755
index 3747b45e..00000000
--- a/theories7/Relations/Rstar.v
+++ /dev/null
@@ -1,78 +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: Rstar.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
-
-(** Properties of a binary relation [R] on type [A] *)
-
-Section Rstar.
-
-Variable A : Type.  
-Variable R : A->A->Prop.  
-
-(** Definition of the reflexive-transitive closure [R*] of [R] *)
-(** Smallest reflexive [P] containing [R o P] *)
-
-Definition Rstar  := [x,y:A](P:A->A->Prop)
-   ((u:A)(P u u))->((u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)) -> (P x y).  
-
-Theorem Rstar_reflexive:  (x:A)(Rstar x x).
- Proof [x:A][P:A->A->Prop]
-       [h1:(u:A)(P u u)][h2:(u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)]
-       (h1 x).  
-  
-Theorem Rstar_R: (x:A)(y:A)(z:A)(R x y)->(Rstar y z)->(Rstar x z).
- Proof [x:A][y:A][z:A][t1:(R x y)][t2:(Rstar y z)]
-       [P:A->A->Prop]
-       [h1:(u:A)(P u u)][h2:(u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)]
-       (h2 x y z t1 (t2 P h1 h2)).  
-  
-(** We conclude with transitivity of [Rstar] : *)
-
-Theorem  Rstar_transitive:  (x:A)(y:A)(z:A)(Rstar x y)->(Rstar y z)->(Rstar x z).
- Proof  [x:A][y:A][z:A][h:(Rstar x y)]
-        (h ([u:A][v:A](Rstar v z)->(Rstar u z))
-           ([u:A][t:(Rstar u z)]t)
-           ([u:A][v:A][w:A][t1:(R u v)][t2:(Rstar w z)->(Rstar v z)]
-            [t3:(Rstar w z)](Rstar_R u v z t1 (t2 t3)))).  
-
-(** Another characterization of [R*] *)
-(** Smallest reflexive [P] containing [R o R*] *)
-
-Definition Rstar' := [x:A][y:A](P:A->A->Prop)
-    ((P x x))->((u:A)(R x u)->(Rstar u y)->(P x y)) -> (P x y).  
-
-Theorem Rstar'_reflexive: (x:A)(Rstar' x x).
- Proof  [x:A][P:A->A->Prop][h:(P x x)][h':(u:A)(R x u)->(Rstar u x)->(P x x)]h.
-  
-Theorem Rstar'_R: (x:A)(y:A)(z:A)(R x z)->(Rstar z y)->(Rstar' x y).
- Proof  [x:A][y:A][z:A][t1:(R x z)][t2:(Rstar z y)]
-        [P:A->A->Prop][h1:(P x x)]
-        [h2:(u:A)(R x u)->(Rstar u y)->(P x y)](h2 z t1 t2).  
-  
-(** Equivalence of the two definitions: *)
-
-Theorem Rstar'_Rstar:  (x:A)(y:A)(Rstar' x y)->(Rstar x y).
- Proof  [x:A][y:A][h:(Rstar' x y)]
-        (h Rstar (Rstar_reflexive x) ([u:A](Rstar_R x u y))).  
-  
-Theorem Rstar_Rstar':  (x:A)(y:A)(Rstar x y)->(Rstar' x y).
- Proof  [x:A][y:A][h:(Rstar x y)](h Rstar' ([u:A](Rstar'_reflexive u))
-         ([u:A][v:A][w:A][h1:(R u v)][h2:(Rstar' v w)]
-          (Rstar'_R u w v h1 (Rstar'_Rstar v w h2)))).  
-
-
-(** Property of Commutativity of two relations *)
-
-Definition commut := [A:Set][R1,R2:A->A->Prop]
-                       (x,y:A)(R1 y x)->(z:A)(R2 z y)
-                        ->(EX y':A |(R2 y' x) & (R1 z y')).
-
-
-End Rstar.
-
diff --git a/theories7/Setoids/Setoid.v b/theories7/Setoids/Setoid.v
deleted file mode 100644
index f8176f60..00000000
--- a/theories7/Setoids/Setoid.v
+++ /dev/null
@@ -1,73 +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: Setoid.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $: i*)
-
-Section Setoid.
-
-Variable A : Type.
-Variable Aeq : A -> A -> Prop.
-
-Record Setoid_Theory : Prop :=
-{ Seq_refl : (x:A) (Aeq x x);
-  Seq_sym : (x,y:A) (Aeq x y) -> (Aeq y x);
-  Seq_trans : (x,y,z:A) (Aeq x y) -> (Aeq y z) -> (Aeq x z)
-}.
-
-End Setoid.
-
-Definition Prop_S : (Setoid_Theory Prop iff).
-Split; [Exact iff_refl | Exact iff_sym | Exact iff_trans].
-Qed.
-
-Add Setoid Prop iff Prop_S.
-
-Hint prop_set : setoid := Resolve (Seq_refl Prop iff Prop_S).
-Hint prop_set : setoid := Resolve (Seq_sym Prop iff Prop_S).
-Hint prop_set : setoid := Resolve (Seq_trans Prop iff Prop_S).
-
-Add Morphism or : or_ext.
-Intros.
-Inversion H1.
-Left.
-Inversion H.
-Apply (H3 H2).
-
-Right.
-Inversion H0.
-Apply (H3 H2).
-Qed.
-
-Add Morphism and : and_ext.
-Intros.
-Inversion H1.
-Split.
-Inversion H.
-Apply (H4 H2).
-
-Inversion H0.
-Apply (H4 H3).
-Qed.
-
-Add Morphism not : not_ext.
-Red ; Intros.
-Apply H0.
-Inversion H.
-Apply (H3 H1).
-Qed.
-
-Definition fleche [A,B:Prop] := A -> B.
-
-Add Morphism fleche : fleche_ext.
-Unfold fleche.
-Intros.
-Inversion H0.
-Inversion H.
-Apply (H3 (H1 (H6 H2))).
-Qed.
-
diff --git a/theories7/Sets/Classical_sets.v b/theories7/Sets/Classical_sets.v
deleted file mode 100755
index a6928ffd..00000000
--- a/theories7/Sets/Classical_sets.v
+++ /dev/null
@@ -1,133 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Classical_sets.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
-
-Require Export Ensembles.
-Require Export Constructive_sets.
-Require Export Classical_Type.
-
-(* Hints Unfold  not . *)
-
-Section Ensembles_classical.
-Variable U: Type.
-
-Lemma not_included_empty_Inhabited: 
-  (A: (Ensemble  U)) ~ (Included U A (Empty_set U)) -> (Inhabited U A).
-Proof.
-Intros A NI.
-Elim (not_all_ex_not U [x:U]~(In U A x)).
-Intros x H; Apply Inhabited_intro with x.
-Apply NNPP; Auto with sets.
-Red; Intro.
-Apply NI; Red.
-Intros x H'; Elim (H x); Trivial with sets.
-Qed.
-Hints Resolve not_included_empty_Inhabited.
-
-Lemma not_empty_Inhabited: 
-  (A: (Ensemble  U)) ~ A == (Empty_set U) -> (Inhabited U A).
-Proof.
-Intros; Apply not_included_empty_Inhabited.
-Red; Auto with sets.
-Qed.
-
-Lemma Inhabited_Setminus :
-(X, Y: (Ensemble U)) (Included U X Y) -> ~ (Included U Y X) ->
-       (Inhabited U (Setminus U Y X)).
-Proof.
-Intros X Y I NI. 
-Elim (not_all_ex_not U [x:U](In U Y x)->(In U X x) NI).
-Intros x YX.
-Apply Inhabited_intro with x.
-Apply Setminus_intro.
-Apply not_imply_elim with (In U X x); Trivial with sets.
-Auto with sets.
-Qed.
-Hints Resolve Inhabited_Setminus.
-
-Lemma Strict_super_set_contains_new_element:
-  (X, Y: (Ensemble U)) (Included U X Y) -> ~ X == Y ->
-   (Inhabited U (Setminus U Y X)).
-Proof.
-Auto 7 with sets.
-Qed.
-Hints Resolve Strict_super_set_contains_new_element.
-
-Lemma Subtract_intro:
-  (A: (Ensemble U)) (x, y: U) (In U A y) -> ~ x == y ->
-   (In U (Subtract U A x) y).
-Proof.
-Unfold 1 Subtract; Auto with sets.
-Qed.
-Hints Resolve Subtract_intro.
-
-Lemma Subtract_inv:
-  (A: (Ensemble U)) (x, y: U) (In U (Subtract U A x) y) ->
-   (In U A y) /\ ~ x == y.
-Proof.
-Intros A x y H'; Elim H'; Auto with sets.
-Qed.
-
-Lemma Included_Strict_Included:
-  (X, Y: (Ensemble U)) (Included U X Y) -> (Strict_Included U X Y) \/ X == Y.
-Proof.
-Intros X Y H'; Try Assumption.
-Elim (classic X == Y); Auto with sets.
-Qed.
-
-Lemma Strict_Included_inv:
-  (X, Y: (Ensemble U)) (Strict_Included U X Y) ->
-   (Included U X Y) /\ (Inhabited U (Setminus U Y X)).
-Proof.
-Intros X Y H'; Red in H'.
-Split; [Tauto | Idtac].
-Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
-Apply Strict_super_set_contains_new_element; Auto with sets.
-Qed.
-
-Lemma not_SIncl_empty: 
-    (X: (Ensemble U)) ~ (Strict_Included U X (Empty_set U)).
-Proof.
-Intro X; Red; Intro H'; Try Exact H'.
-LApply (Strict_Included_inv X (Empty_set U)); Auto with sets.
-Intro H'0; Elim H'0; Intros H'1 H'2; Elim H'2; Clear H'0.
-Intros x H'0; Elim H'0.
-Intro H'3; Elim H'3.
-Qed.
-
-Lemma Complement_Complement :
-  (A: (Ensemble U)) (Complement U (Complement U A)) == A.
-Proof.
-Unfold Complement; Intros; Apply Extensionality_Ensembles; Auto with sets.
-Red; Split; Auto with sets.
-Red; Intros; Apply NNPP; Auto with sets.
-Qed.
-
-End Ensembles_classical.
-
-Hints Resolve Strict_super_set_contains_new_element Subtract_intro 
-	not_SIncl_empty : sets v62.
diff --git a/theories7/Sets/Constructive_sets.v b/theories7/Sets/Constructive_sets.v
deleted file mode 100755
index 35c88e9d..00000000
--- a/theories7/Sets/Constructive_sets.v
+++ /dev/null
@@ -1,162 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Constructive_sets.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
-
-Require Export Ensembles.
-
-Section Ensembles_facts.
-Variable U: Type.
-
-Lemma Extension: (B, C: (Ensemble U)) B == C -> (Same_set U B C).
-Proof.
-Intros B C H'; Rewrite H'; Auto with sets.
-Qed.
-
-Lemma Noone_in_empty: (x: U) ~ (In U (Empty_set U) x).
-Proof.
-Red; NewDestruct 1.
-Qed.
-Hints Resolve Noone_in_empty.
-
-Lemma Included_Empty: (A: (Ensemble U))(Included U (Empty_set U) A).
-Proof.
-Intro; Red.
-Intros x H; Elim (Noone_in_empty x); Auto with sets.
-Qed.
-Hints Resolve Included_Empty.
-
-Lemma Add_intro1:
-  (A: (Ensemble U)) (x, y: U) (In U A y) -> (In U (Add U A x) y).
-Proof.
-Unfold 1 Add; Auto with sets.
-Qed.
-Hints Resolve Add_intro1.
-
-Lemma Add_intro2: (A: (Ensemble U)) (x: U) (In U (Add U A x) x).
-Proof.
-Unfold 1 Add; Auto with sets.
-Qed.
-Hints Resolve Add_intro2.
-
-Lemma Inhabited_add: (A: (Ensemble U)) (x: U) (Inhabited U (Add U A x)).
-Proof.
-Intros A x.
-Apply Inhabited_intro with x := x; Auto with sets.
-Qed.
-Hints Resolve Inhabited_add.
-
-Lemma Inhabited_not_empty:
-  (X: (Ensemble U)) (Inhabited U X) -> ~ X == (Empty_set U).
-Proof.
-Intros X H'; Elim H'.
-Intros x H'0; Red; Intro H'1.
-Absurd (In U X x); Auto with sets.
-Rewrite H'1; Auto with sets.
-Qed.
-Hints Resolve Inhabited_not_empty.
-
-Lemma Add_not_Empty :
- (A: (Ensemble U)) (x: U) ~ (Add U A x) == (Empty_set U).
-Proof.
-Auto with sets.
-Qed.
-Hints Resolve Add_not_Empty.
-
-Lemma not_Empty_Add :
- (A: (Ensemble U)) (x: U) ~ (Empty_set U) == (Add U A x).
-Proof.
-Intros; Red; Intro H; Generalize (Add_not_Empty A x); Auto with sets.
-Qed.
-Hints Resolve not_Empty_Add.
-
-Lemma Singleton_inv: (x, y: U) (In U (Singleton U x) y) -> x == y.
-Proof.
-Intros x y H'; Elim H'; Trivial with sets.
-Qed.
-Hints Resolve Singleton_inv.
-
-Lemma Singleton_intro: (x, y: U) x == y -> (In U (Singleton U x) y).
-Proof.
-Intros x y H'; Rewrite H'; Trivial with sets.
-Qed.
-Hints Resolve Singleton_intro.
-
-Lemma Union_inv:  (B, C: (Ensemble U)) (x: U) 
-  (In U (Union U B C) x) -> (In U B x) \/ (In U C x).
-Proof.
-Intros B C x H'; Elim H'; Auto with sets.
-Qed.
-
-Lemma Add_inv:
-  (A: (Ensemble U)) (x, y: U) (In U (Add U A x) y) -> (In U A y) \/ x == y.
-Proof.
-Intros A x y H'; Elim H'; Auto with sets.
-Qed.
-
-Lemma Intersection_inv:
-  (B, C: (Ensemble U)) (x: U) (In U (Intersection U B C) x) ->
-   (In U B x) /\ (In U C x).
-Proof.
-Intros B C x H'; Elim H'; Auto with sets.
-Qed.
-Hints Resolve Intersection_inv.
-
-Lemma Couple_inv: (x, y, z: U) (In U (Couple U x y) z) -> z == x \/ z == y.
-Proof.
-Intros x y z H'; Elim H'; Auto with sets.
-Qed.
-Hints Resolve Couple_inv.
-
-Lemma Setminus_intro:
-  (A, B: (Ensemble U)) (x: U) (In U A x) -> ~ (In U B x) ->
-   (In U (Setminus U A B) x).
-Proof.
-Unfold 1 Setminus; Red; Auto with sets.
-Qed.
-Hints Resolve Setminus_intro.
- 
-Lemma Strict_Included_intro:
-  (X, Y: (Ensemble U)) (Included U X Y) /\ ~ X == Y -> 
-                       (Strict_Included U X Y).
-Proof.
-Auto with sets.
-Qed.
-Hints Resolve Strict_Included_intro.
-
-Lemma Strict_Included_strict: (X: (Ensemble U)) ~ (Strict_Included U X X).
-Proof.
-Intro X; Red; Intro H'; Elim H'.
-Intros H'0 H'1; Elim H'1; Auto with sets.
-Qed.
-Hints Resolve Strict_Included_strict.
-
-End Ensembles_facts.
-
-Hints Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2 
-	Intersection_inv Couple_inv Setminus_intro Strict_Included_intro
-	Strict_Included_strict Noone_in_empty Inhabited_not_empty
-	Add_not_Empty  not_Empty_Add Inhabited_add Included_Empty : sets v62.
diff --git a/theories7/Sets/Cpo.v b/theories7/Sets/Cpo.v
deleted file mode 100755
index 2fe46be6..00000000
--- a/theories7/Sets/Cpo.v
+++ /dev/null
@@ -1,107 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Cpo.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
-
-Require Export Ensembles.
-Require Export Relations_1.
-Require Export Partial_Order.
-
-Section Bounds.
-Variable U: Type.
-Variable D: (PO U).
-
-Local C :=  (Carrier_of U D).
-
-Local R :=  (Rel_of U D).
-
-Inductive Upper_Bound [B:(Ensemble U); x:U]: Prop :=
-      Upper_Bound_definition:
-        (In U C x) -> ((y: U) (In U B y) -> (R y x)) -> (Upper_Bound B x).
-
-Inductive Lower_Bound [B:(Ensemble U); x:U]: Prop :=
-      Lower_Bound_definition:
-        (In U C x) -> ((y: U) (In U B y) -> (R x y)) -> (Lower_Bound B x).
-
-Inductive Lub [B:(Ensemble U); x:U]: Prop :=
-      Lub_definition:
-        (Upper_Bound B x) -> ((y: U) (Upper_Bound B y) -> (R x y)) -> (Lub B x).
-
-Inductive Glb [B:(Ensemble U); x:U]: Prop :=
-      Glb_definition:
-        (Lower_Bound B x) -> ((y: U) (Lower_Bound B y) -> (R y x)) -> (Glb B x).
-
-Inductive Bottom [bot:U]: Prop :=
-      Bottom_definition:
-        (In U C bot) -> ((y: U) (In U C y) -> (R bot y)) -> (Bottom bot).
-
-Inductive Totally_ordered [B:(Ensemble U)]: Prop :=
-      Totally_ordered_definition:
-        ((Included U B C) ->
-          (x: U) (y: U) (Included U (Couple U x y) B) -> (R x y) \/ (R y x)) ->
-         (Totally_ordered B).
-
-Definition Compatible : (Relation U) :=
-   [x: U] [y: U] (In U C x) -> (In U C y) ->
-    (EXT z | (In U C z) /\ (Upper_Bound (Couple U x y) z)).
-	
-Inductive Directed [X:(Ensemble U)]: Prop :=
-      Definition_of_Directed:
-        (Included U X C) ->
-        (Inhabited U X) ->
-        ((x1: U) (x2: U) (Included U (Couple U x1 x2) X) ->
-          (EXT x3 | (In U X x3) /\ (Upper_Bound (Couple U x1 x2) x3))) ->
-         (Directed X).
-
-Inductive Complete : Prop :=
-      Definition_of_Complete:
-        ((EXT bot | (Bottom bot))) ->
-        ((X: (Ensemble U)) (Directed X) -> (EXT bsup | (Lub X bsup))) ->
-         Complete.
-
-Inductive Conditionally_complete : Prop :=
-      Definition_of_Conditionally_complete:
-        ((X: (Ensemble U))
-         (Included U X C) -> (EXT maj | (Upper_Bound X maj)) ->
-          (EXT bsup | (Lub X bsup))) -> Conditionally_complete.
-End Bounds.
-Hints Resolve Totally_ordered_definition Upper_Bound_definition 
-	Lower_Bound_definition Lub_definition Glb_definition
-	Bottom_definition Definition_of_Complete
-  	 Definition_of_Complete Definition_of_Conditionally_complete.
-
-Section Specific_orders.
-Variable U: Type.
-
-Record Cpo : Type := Definition_of_cpo {
-   PO_of_cpo: (PO U);
-   Cpo_cond: (Complete U PO_of_cpo) }.
-
-Record Chain : Type := Definition_of_chain {
-   PO_of_chain: (PO U);
-   Chain_cond: (Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)) }.
-
-End Specific_orders.
diff --git a/theories7/Sets/Ensembles.v b/theories7/Sets/Ensembles.v
deleted file mode 100755
index c3a044c0..00000000
--- a/theories7/Sets/Ensembles.v
+++ /dev/null
@@ -1,108 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Ensembles.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Section Ensembles.
-Variable U: Type.
-
-Definition Ensemble :=  U -> Prop. 
-
-Definition In : Ensemble -> U -> Prop :=  [A: Ensemble] [x: U] (A x).
-
-Definition Included : Ensemble -> Ensemble -> Prop :=
-   [B, C: Ensemble] (x: U) (In B x) -> (In C x).
-
-Inductive Empty_set : Ensemble :=
-   .
-
-Inductive Full_set : Ensemble :=
-     Full_intro: (x: U) (In Full_set x).
-
-(** NB: The following definition builds-in equality of elements in [U] as 
-   Leibniz equality. 
-
-   This may have to be changed if we replace [U] by a Setoid on [U] 
-   with its own equality [eqs], with  
-   [In_singleton: (y: U)(eqs x y) -> (In (Singleton x) y)]. *)
-
-Inductive Singleton [x:U] : Ensemble :=
-      In_singleton: (In (Singleton x) x).
-
-Inductive Union [B, C: Ensemble] : Ensemble :=
-     Union_introl: (x: U) (In B x) -> (In (Union B C) x)
-   | Union_intror: (x: U) (In C x) -> (In (Union B C) x).
-
-Definition Add : Ensemble -> U -> Ensemble :=
-   [B: Ensemble] [x: U] (Union B (Singleton x)).
-
-Inductive Intersection [B, C:Ensemble] : Ensemble :=
-      Intersection_intro:
-        (x: U) (In B x) -> (In C x) -> (In (Intersection B C) x).
-
-Inductive Couple [x,y:U] : Ensemble :=
-     Couple_l: (In (Couple x y) x)
-   | Couple_r: (In (Couple x y) y).
-
-Inductive Triple[x, y, z:U] : Ensemble :=
-    Triple_l: (In (Triple x y z) x)
-  | Triple_m: (In (Triple x y z) y)
-  | Triple_r: (In (Triple x y z) z).
-
-Definition Complement : Ensemble -> Ensemble :=
-   [A: Ensemble] [x: U] ~ (In A x).
-
-Definition Setminus : Ensemble -> Ensemble -> Ensemble :=
-   [B: Ensemble] [C: Ensemble] [x: U] (In B x) /\ ~ (In C x).
-
-Definition Subtract : Ensemble -> U -> Ensemble :=
-   [B: Ensemble] [x: U] (Setminus B (Singleton x)).
-
-Inductive Disjoint [B, C:Ensemble] : Prop :=
-      Disjoint_intro: ((x: U) ~ (In (Intersection B C) x)) -> (Disjoint B C).
-
-Inductive Inhabited [B:Ensemble] : Prop :=
-      Inhabited_intro: (x: U) (In B x) -> (Inhabited B).
-
-Definition Strict_Included : Ensemble -> Ensemble -> Prop :=
-   [B, C: Ensemble] (Included B C) /\ ~ B == C.
-
-Definition Same_set : Ensemble -> Ensemble -> Prop :=
-   [B, C: Ensemble] (Included B C) /\ (Included C B).
-
-(** Extensionality Axiom *)
-
-Axiom Extensionality_Ensembles:
-   (A,B: Ensemble) (Same_set A B) -> A == B.
-Hints Resolve Extensionality_Ensembles.
-
-End Ensembles.
-
-Hints Unfold In Included Same_set Strict_Included Add Setminus Subtract : sets v62.
-
-Hints Resolve Union_introl Union_intror Intersection_intro In_singleton Couple_l
-	Couple_r Triple_l Triple_m Triple_r Disjoint_intro 
-	Extensionality_Ensembles : sets v62.
diff --git a/theories7/Sets/Finite_sets.v b/theories7/Sets/Finite_sets.v
deleted file mode 100755
index fb53994d..00000000
--- a/theories7/Sets/Finite_sets.v
+++ /dev/null
@@ -1,74 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Finite_sets.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Ensembles.
-
-Section Ensembles_finis.
-Variable U: Type.
-
-Inductive Finite : (Ensemble U) -> Prop :=
-      Empty_is_finite: (Finite (Empty_set U))
-   |  Union_is_finite:
-      (A: (Ensemble U)) (Finite A) -> 
-      (x: U) ~ (In U A x) -> (Finite (Add U A x)).
-
-Inductive cardinal : (Ensemble U) -> nat -> Prop :=
-      card_empty: (cardinal (Empty_set U) O)
-   |  card_add:
-       (A: (Ensemble U)) (n: nat) (cardinal A n) ->
-        (x: U) ~ (In U A x) -> (cardinal (Add U A x) (S n)).
-
-End Ensembles_finis.
-
-Hints Resolve Empty_is_finite Union_is_finite : sets v62.
-Hints Resolve card_empty card_add : sets v62.
-
-Require Constructive_sets.
-
-Section Ensembles_finis_facts.
-Variable U: Type.
-
-Lemma cardinal_invert :
- (X: (Ensemble U)) (p:nat)(cardinal U X p) -> Case p of
-           X == (Empty_set U)
-   [n:nat] (EXT A | (EXT x | 
-           X == (Add U A x) /\ ~ (In U A x) /\ (cardinal U A n))) end.
-Proof.
-NewInduction 1; Simpl; Auto.
-Exists A; Exists x; Auto.
-Qed.
-
-Lemma cardinal_elim :
- (X: (Ensemble U)) (p:nat)(cardinal U X p) -> Case p of
-                              X == (Empty_set U)
-                             [n:nat](Inhabited U X) end.
-Proof.
-Intros X p C; Elim C; Simpl; Trivial with sets.
-Qed.
-
-End Ensembles_finis_facts.
diff --git a/theories7/Sets/Finite_sets_facts.v b/theories7/Sets/Finite_sets_facts.v
deleted file mode 100755
index 63d4d2ad..00000000
--- a/theories7/Sets/Finite_sets_facts.v
+++ /dev/null
@@ -1,345 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Finite_sets_facts.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Export Finite_sets.
-Require Export Constructive_sets.
-Require Export Classical_Type.
-Require Export Classical_sets.
-Require Export Powerset.
-Require Export Powerset_facts.
-Require Export Powerset_Classical_facts.
-Require Export Gt.
-Require Export Lt.
-
-Section Finite_sets_facts.
-Variable U: Type.
-
-Lemma finite_cardinal :
- (X: (Ensemble U)) (Finite U X) -> (EX n:nat |(cardinal U X n)).
-Proof.
-NewInduction 1 as [|A _ [n H]].
-Exists O; Auto with sets.
-Exists (S n); Auto with sets.
-Qed.
-
-Lemma cardinal_finite:
-  (X: (Ensemble U)) (n: nat) (cardinal U X n) -> (Finite U X).
-Proof.
-NewInduction 1; Auto with sets.
-Qed.
-
-Theorem Add_preserves_Finite:
-  (X: (Ensemble U)) (x: U) (Finite U X) -> (Finite U (Add U X x)).
-Proof.
-Intros X x H'.
-Elim (classic (In U X x)); Intro H'0; Auto with sets.
-Rewrite (Non_disjoint_union U X x); Auto with sets.
-Qed.
-Hints Resolve Add_preserves_Finite.
-
-Theorem Singleton_is_finite: (x: U) (Finite U (Singleton U x)).
-Proof.
-Intro x; Rewrite <- (Empty_set_zero U (Singleton U x)).
-Change (Finite U (Add U (Empty_set U) x)); Auto with sets.
-Qed.
-Hints Resolve Singleton_is_finite.
-
-Theorem Union_preserves_Finite:
-  (X, Y: (Ensemble U)) (Finite U X) -> (Finite U Y) -> 
-                       (Finite U (Union U X Y)).
-Proof.
-Intros X Y H'; Elim H'.
-Rewrite (Empty_set_zero U Y); Auto with sets.
-Intros A H'0 H'1 x H'2 H'3.
-Rewrite (Union_commutative U (Add U A x) Y).
-Rewrite <- (Union_add U Y A x).
-Rewrite (Union_commutative U Y A); Auto with sets.
-Qed.
-
-Lemma Finite_downward_closed:
-  (A: (Ensemble U)) (Finite U A) ->
-   (X: (Ensemble U)) (Included U X A) -> (Finite U X).
-Proof.
-Intros A H'; Elim H'; Auto with sets.
-Intros X H'0.
-Rewrite (less_than_empty U X H'0); Auto with sets.
-Intros; Elim Included_Add with U X A0 x; Auto with sets.
-NewDestruct 1 as [A' [H5 H6]].
-Rewrite H5; Auto with sets.
-Qed.
-
-Lemma Intersection_preserves_finite:
-  (A: (Ensemble U)) (Finite U A) ->
-   (X: (Ensemble U)) (Finite U (Intersection U X A)).
-Proof.
-Intros A H' X; Apply Finite_downward_closed with A; Auto with sets.
-Qed.
-
-Lemma cardinalO_empty:
-  (X: (Ensemble U)) (cardinal U X O) -> X == (Empty_set U).
-Proof.
-Intros X H; Apply (cardinal_invert U X O); Trivial with sets.
-Qed.
-Hints Resolve cardinalO_empty.
-
-Lemma inh_card_gt_O:
-  (X: (Ensemble U)) (Inhabited U X) -> (n: nat) (cardinal U X n) -> (gt n O).
-Proof.
-NewInduction 1 as [x H'].
-Intros n H'0.
-Elim (gt_O_eq n); Auto with sets.
-Intro H'1; Generalize H'; Generalize H'0.
-Rewrite <- H'1; Intro H'2.
-Rewrite (cardinalO_empty X); Auto with sets.
-Intro H'3; Elim H'3.
-Qed.
-
-Lemma card_soustr_1:
-  (X: (Ensemble U)) (n: nat) (cardinal U X n) ->
-   (x: U) (In U X x) -> (cardinal U (Subtract U X x) (pred n)).
-Proof.
-Intros X n H'; Elim H'.
-Intros x H'0; Elim H'0.
-Clear H' n X.
-Intros X n H' H'0 x H'1 x0 H'2.
-Elim (classic (In U X x0)).
-Intro H'4; Rewrite (add_soustr_xy U X x x0).
-Elim (classic x == x0).
-Intro H'5.
-Absurd (In U X x0); Auto with sets.
-Rewrite <- H'5; Auto with sets.
-Intro H'3; Try Assumption.
-Cut (S (pred n)) = (pred (S n)).
-Intro H'5; Rewrite <- H'5.
-Apply card_add; Auto with sets.
-Red; Intro H'6; Elim H'6.
-Intros H'7 H'8; Try Assumption.
-Elim H'1; Auto with sets.
-Unfold 2 pred; Symmetry.
-Apply S_pred with m := O.
-Change (gt n O).
-Apply inh_card_gt_O with X := X; Auto with sets.
-Apply Inhabited_intro with x := x0; Auto with sets.
-Red; Intro H'3.
-Apply H'1.
-Elim H'3; Auto with sets.
-Rewrite H'3; Auto with sets.
-Elim (classic x == x0).
-Intro H'3; Rewrite <- H'3.
-Cut (Subtract U (Add U X x) x) == X; Auto with sets.
-Intro H'4; Rewrite H'4; Auto with sets.
-Intros H'3 H'4; Try Assumption.
-Absurd (In U (Add U X x) x0); Auto with sets.
-Red; Intro H'5; Try Exact H'5.
-LApply (Add_inv U X x x0); Tauto.
-Qed.
-
-Lemma cardinal_is_functional:
-  (X: (Ensemble U)) (c1: nat) (cardinal U X c1) ->
-   (Y: (Ensemble U)) (c2: nat) (cardinal U Y c2) -> X == Y ->
-    c1 = c2.
-Proof.
-Intros X c1 H'; Elim H'.
-Intros Y c2 H'0; Elim H'0; Auto with sets.
-Intros A n H'1 H'2 x H'3 H'5.
-Elim (not_Empty_Add U A x); Auto with sets.
-Clear H' c1 X.
-Intros X n H' H'0 x H'1 Y c2 H'2.
-Elim H'2.
-Intro H'3.
-Elim (not_Empty_Add U X x); Auto with sets.
-Clear H'2 c2 Y.
-Intros X0 c2 H'2 H'3 x0 H'4 H'5.
-Elim (classic (In U X0 x)).
-Intro H'6; Apply f_equal with nat.
-Apply H'0 with Y := (Subtract U (Add U X0 x0) x).
-ElimType (pred (S c2)) = c2; Auto with sets.
-Apply card_soustr_1; Auto with sets.
-Rewrite <- H'5.
-Apply Sub_Add_new; Auto with sets.
-Elim (classic x == x0).
-Intros H'6 H'7; Apply f_equal with nat.
-Apply H'0 with Y := X0; Auto with sets.
-Apply Simplify_add with x := x; Auto with sets.
-Pattern 2 x; Rewrite H'6; Auto with sets.
-Intros H'6 H'7.
-Absurd (Add U X x) == (Add U X0 x0); Auto with sets.
-Clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2.
-Red; Intro H'.
-LApply (Extension U (Add U X x) (Add U X0 x0)); Auto with sets.
-Clear H'.
-Intro H'; Red in H'.
-Elim H'; Intros H'0 H'1; Red in H'0; Clear H' H'1.
-Absurd (In U (Add U X0 x0) x); Auto with sets.
-LApply (Add_inv U X0 x0 x); [ Intuition | Apply (H'0 x); Apply Add_intro2 ].
-Qed.
-
-Lemma cardinal_Empty : (m:nat)(cardinal U (Empty_set U) m) -> O = m.
-Proof.
-Intros m Cm; Generalize (cardinal_invert U (Empty_set U) m Cm).
-Elim m; Auto with sets.
-Intros; Elim H0; Intros; Elim H1; Intros; Elim H2; Intros.
-Elim (not_Empty_Add U x x0 H3).
-Qed.
-
-Lemma cardinal_unicity :
-  (X: (Ensemble U)) (n: nat) (cardinal U X n) -> 
-                    (m: nat) (cardinal U X m) -> n = m.
-Proof.
-Intros; Apply cardinal_is_functional with X X; Auto with sets.
-Qed.
-
-Lemma card_Add_gen:
-  (A: (Ensemble U))
-  (x: U) (n, n': nat) (cardinal U A n) -> (cardinal U (Add U A x) n') ->
-   (le n' (S n)).
-Proof.
-Intros A x n n' H'.
-Elim (classic (In U A x)).
-Intro H'0.
-Rewrite (Non_disjoint_union U A x H'0).
-Intro H'1; Cut n = n'.
-Intro E; Rewrite E; Auto with sets.
-Apply cardinal_unicity with A; Auto with sets.
-Intros H'0 H'1.
-Cut n'=(S n).
-Intro E; Rewrite E; Auto with sets.
-Apply cardinal_unicity with (Add U A x); Auto with sets.
-Qed.
-
-Lemma incl_st_card_lt:
-  (X: (Ensemble U)) (c1: nat) (cardinal U X c1) ->
-  (Y: (Ensemble U)) (c2: nat) (cardinal U Y c2) -> (Strict_Included U X Y) ->
-    (gt c2 c1).
-Proof.
-Intros X c1 H'; Elim H'.
-Intros Y c2 H'0; Elim H'0; Auto with sets arith.
-Intro H'1.
-Elim (Strict_Included_strict U (Empty_set U)); Auto with sets arith.
-Clear H' c1 X.
-Intros X n H' H'0 x H'1 Y c2 H'2.
-Elim H'2.
-Intro H'3; Elim (not_SIncl_empty U (Add U X x)); Auto with sets arith.
-Clear H'2 c2 Y.
-Intros X0 c2 H'2 H'3 x0 H'4 H'5; Elim (classic (In U X0 x)).
-Intro H'6; Apply gt_n_S.
-Apply H'0 with Y := (Subtract U (Add U X0 x0) x).
-ElimType (pred (S c2)) = c2; Auto with sets arith.
-Apply card_soustr_1; Auto with sets arith.
-Apply incl_st_add_soustr; Auto with sets arith.
-Elim (classic x == x0).
-Intros H'6 H'7; Apply gt_n_S.
-Apply H'0 with Y := X0; Auto with sets arith.
-Apply sincl_add_x with x := x0.
-Rewrite <- H'6; Auto with sets arith.
-Pattern 1 x0; Rewrite <- H'6; Trivial with sets arith.
-Intros H'6 H'7; Red in H'5.
-Elim H'5; Intros H'8 H'9; Try Exact H'8; Clear H'5.
-Red in H'8.
-Generalize (H'8 x).
-Intro H'5; LApply H'5; Auto with sets arith.
-Intro H; Elim Add_inv with U X0 x0 x; Auto with sets arith.
-Intro; Absurd (In U X0 x); Auto with sets arith.
-Intro; Absurd x==x0; Auto with sets arith.
-Qed.
-
-Lemma incl_card_le:
-  (X,Y: (Ensemble U)) (n,m: nat) (cardinal U X n) -> (cardinal U Y m) -> 
-  (Included U X Y) -> (le n m).
-Proof.
-Intros;
-Elim Included_Strict_Included with U X Y; Auto with sets arith; Intro.
-Cut (gt m n); Auto with sets arith.
-Apply incl_st_card_lt with X := X Y := Y; Auto with sets arith.
-Generalize H0; Rewrite <- H2; Intro.
-Cut n=m.
-Intro E; Rewrite E; Auto with sets arith.
-Apply cardinal_unicity with X; Auto with sets arith.
-Qed.
-
-Lemma G_aux:
-  (P:(Ensemble U) ->Prop)
-  ((X:(Ensemble U))
-   (Finite U X) -> ((Y:(Ensemble U)) (Strict_Included U Y X) ->(P Y)) ->(P X)) ->
-  (P (Empty_set U)).
-Proof.
-Intros P H'; Try Assumption.
-Apply H'; Auto with sets.
-Clear H'; Auto with sets.
-Intros Y H'; Try Assumption.
-Red in H'.
-Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
-LApply (less_than_empty U Y); [Intro H'3; Try Exact H'3 | Assumption].
-Elim H'1; Auto with sets.
-Qed.
-
-Hints Unfold  not.
-
-Lemma Generalized_induction_on_finite_sets:
-  (P:(Ensemble U) ->Prop)
-  ((X:(Ensemble U))
-   (Finite U X) -> ((Y:(Ensemble U)) (Strict_Included U Y X) ->(P Y)) ->(P X)) ->
-  (X:(Ensemble U)) (Finite U X) ->(P X).
-Proof.
-Intros P H'0 X H'1.
-Generalize P H'0; Clear H'0 P.
-Elim H'1.
-Intros P H'0.
-Apply G_aux; Auto with sets.
-Clear H'1 X.
-Intros A H' H'0 x H'1 P H'3.
-Cut (Y:(Ensemble U)) (Included U Y (Add U A x)) ->(P Y); Auto with sets.
-Generalize H'1.
-Apply H'0.
-Intros X K H'5 L Y H'6; Apply H'3; Auto with sets.
-Apply Finite_downward_closed with A := (Add U X x); Auto with sets.
-Intros Y0 H'7.
-Elim (Strict_inclusion_is_transitive_with_inclusion U Y0 Y (Add U X x)); Auto with sets.
-Intros H'2 H'4.
-Elim (Included_Add U Y0 X x);
- [Intro H'14 |
-   Intro H'14; Elim H'14; Intros A' E; Elim E; Intros H'15 H'16; Clear E H'14 |
-   Idtac]; Auto with sets.
-Elim (Included_Strict_Included U Y0 X); Auto with sets.
-Intro H'9; Apply H'5 with Y := Y0; Auto with sets.
-Intro H'9; Rewrite H'9.
-Apply H'3; Auto with sets.
-Intros Y1 H'8; Elim H'8.
-Intros H'10 H'11; Apply H'5 with Y := Y1; Auto with sets.
-Elim (Included_Strict_Included U A' X); Auto with sets.
-Intro H'8; Apply H'5 with Y := A'; Auto with sets.
-Rewrite <- H'15; Auto with sets.
-Intro H'8.
-Elim H'7.
-Intros H'9 H'10; Apply H'10 Orelse Elim H'10; Try Assumption.
-Generalize H'6.
-Rewrite <- H'8.
-Rewrite <- H'15; Auto with sets.
-Qed.
-
-End Finite_sets_facts.
diff --git a/theories7/Sets/Image.v b/theories7/Sets/Image.v
deleted file mode 100755
index 0794a3bb..00000000
--- a/theories7/Sets/Image.v
+++ /dev/null
@@ -1,199 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Image.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Export Finite_sets.
-Require Export Constructive_sets.
-Require Export Classical_Type.
-Require Export Classical_sets.
-Require Export Powerset.
-Require Export Powerset_facts.
-Require Export Powerset_Classical_facts.
-Require Export Gt.
-Require Export Lt.
-Require Export Le.
-Require Export Finite_sets_facts.
-
-Section Image.
-Variables U, V: Type.
-
-Inductive Im [X:(Ensemble U); f:U -> V]: (Ensemble V) :=
-      Im_intro: (x: U) (In ? X x) -> (y: V) y == (f x) -> (In ? (Im X f) y).
-
-Lemma Im_def:
-  (X: (Ensemble U)) (f: U -> V) (x: U) (In ? X x) -> (In ? (Im X f) (f x)).
-Proof.
-Intros X f x H'; Try Assumption.
-Apply Im_intro with x := x; Auto with sets.
-Qed.
-Hints Resolve Im_def.
-
-Lemma Im_add:
-  (X: (Ensemble U)) (x: U) (f: U -> V)
-      (Im (Add ? X x) f) == (Add ? (Im X f) (f x)).
-Proof.
-Intros X x f.
-Apply Extensionality_Ensembles.
-Split; Red; Intros x0 H'.
-Elim H'; Intros.
-Rewrite H0.
-Elim Add_inv with U X x x1; Auto with sets.
-NewDestruct 1; Auto with sets.
-Elim Add_inv with V (Im X f) (f x) x0; Auto with sets.
-NewDestruct 1 as [x0 H y H0].
-Rewrite H0; Auto with sets.
-NewDestruct 1; Auto with sets.
-Qed.
-
-Lemma image_empty: (f: U -> V) (Im (Empty_set U) f) == (Empty_set V).
-Proof.
-Intro f; Try Assumption.
-Apply Extensionality_Ensembles.
-Split; Auto with sets.
-Red.
-Intros x H'; Elim H'.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Qed.
-Hints Resolve image_empty.
-
-Lemma finite_image:
-  (X: (Ensemble U)) (f: U -> V) (Finite ? X) -> (Finite ? (Im X f)).
-Proof.
-Intros X f H'; Elim H'.
-Rewrite (image_empty f); Auto with sets.
-Intros A H'0 H'1 x H'2; Clear H' X.
-Rewrite (Im_add A x f); Auto with sets.
-Apply Add_preserves_Finite; Auto with sets.
-Qed.
-Hints Resolve finite_image.
-
-Lemma Im_inv:
-  (X: (Ensemble U)) (f: U -> V) (y: V) (In ? (Im X f) y) ->
-   (exT ? [x: U] (In ? X x) /\ (f x) == y).
-Proof.
-Intros X f y H'; Elim H'.
-Intros x H'0 y0 H'1; Rewrite H'1.
-Exists x; Auto with sets.
-Qed.
-
-Definition injective :=  [f: U -> V] (x, y: U) (f x) == (f y) -> x == y.
-
-Lemma not_injective_elim:
-  (f: U -> V) ~ (injective f) ->
-   (EXT x | (EXT y | (f x) == (f y) /\ ~ x == y)).
-Proof.
-Unfold injective; Intros f H.
-Cut (EXT x | ~ ((y: U) (f x) == (f y) -> x == y)).
-2: Apply not_all_ex_not with P:=[x:U](y: U) (f x) == (f y) -> x == y; 
-   Trivial with sets.
-NewDestruct 1 as [x C]; Exists x.
-Cut (EXT y | ~((f x)==(f y)->x==y)).
-2: Apply not_all_ex_not with P:=[y:U](f x)==(f y)->x==y; Trivial with sets.
-NewDestruct 1 as [y D]; Exists y.
-Apply imply_to_and; Trivial with sets.
-Qed.
-
-Lemma cardinal_Im_intro:
-  (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal ? A n) ->
-   (EX p: nat | (cardinal ? (Im A f) p)).
-Proof.
-Intros.
-Apply finite_cardinal; Apply finite_image.
-Apply cardinal_finite with n; Trivial with sets.
-Qed.
-
-Lemma In_Image_elim:
-  (A: (Ensemble U)) (f: U -> V) (injective f) ->
-   (x: U) (In ? (Im A f) (f x)) -> (In ? A x).
-Proof.
-Intros.
-Elim Im_inv with A f (f x); Trivial with sets.
-Intros z C; Elim C; Intros InAz E.
-Elim (H z x E); Trivial with sets.
-Qed.
-
-Lemma injective_preserves_cardinal:
-  (A: (Ensemble U)) (f: U -> V) (n: nat) (injective f) -> (cardinal ? A n) ->
-   (n': nat) (cardinal ? (Im A f) n') -> n' = n.
-Proof.
-NewInduction 2 as [|A n H'0 H'1 x H'2]; Auto with sets.
-Rewrite (image_empty f).
-Intros n' CE.
-Apply cardinal_unicity with V (Empty_set V); Auto with sets.
-Intro n'.
-Rewrite (Im_add A x f).
-Intro H'3.
-Elim cardinal_Im_intro with A f n; Trivial with sets.
-Intros i CI.
-LApply (H'1 i); Trivial with sets.
-Cut ~ (In ? (Im A f) (f x)).
-Intros H0 H1.
-Apply cardinal_unicity with V (Add ? (Im A f) (f x)); Trivial with sets.
-Apply card_add; Auto with sets.
-Rewrite <- H1; Trivial with sets.
-Red; Intro; Apply H'2.
-Apply In_Image_elim with f; Trivial with sets.
-Qed.
-
-Lemma cardinal_decreases:
-  (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal U A n) ->
-   (n': nat) (cardinal V (Im A f) n') -> (le n' n).
-Proof.
-NewInduction 1 as [|A n H'0 H'1 x H'2]; Auto with sets.
-Rewrite (image_empty f); Intros.
-Cut n' = O.
-Intro E; Rewrite E; Trivial with sets.
-Apply cardinal_unicity with V (Empty_set V); Auto with sets.
-Intro n'.
-Rewrite (Im_add A x f).
-Elim cardinal_Im_intro with A f n; Trivial with sets.
-Intros p C H'3.
-Apply le_trans with (S p).
-Apply card_Add_gen with V (Im A f) (f x); Trivial with sets.
-Apply le_n_S; Auto with sets.
-Qed.
-
-Theorem Pigeonhole:
-  (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal U A n) ->
-   (n': nat) (cardinal V (Im A f) n') -> (lt n' n) -> ~ (injective f).
-Proof.
-Unfold not; Intros A f n CAn n' CIfn' ltn'n I.
-Cut n' = n.
-Intro E; Generalize ltn'n; Rewrite E; Exact (lt_n_n n).
-Apply injective_preserves_cardinal with A := A f := f n := n; Trivial with sets.
-Qed.
-
-Lemma Pigeonhole_principle:
-  (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal ? A n) ->
-   (n': nat) (cardinal ? (Im A f) n') -> (lt n' n) ->
-    (EXT x | (EXT y | (f x) == (f y) /\ ~ x == y)).
-Proof.
-Intros; Apply not_injective_elim.
-Apply Pigeonhole with A n n'; Trivial with sets.
-Qed.
-End Image.
-Hints Resolve Im_def image_empty finite_image : sets v62.
diff --git a/theories7/Sets/Infinite_sets.v b/theories7/Sets/Infinite_sets.v
deleted file mode 100755
index bf423753..00000000
--- a/theories7/Sets/Infinite_sets.v
+++ /dev/null
@@ -1,232 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Infinite_sets.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Export Finite_sets.
-Require Export Constructive_sets.
-Require Export Classical_Type.
-Require Export Classical_sets.
-Require Export Powerset.
-Require Export Powerset_facts.
-Require Export Powerset_Classical_facts.
-Require Export Gt.
-Require Export Lt.
-Require Export Le.
-Require Export Finite_sets_facts.
-Require Export Image.
-
-Section Approx.
-Variable U: Type.
-
-Inductive Approximant [A, X:(Ensemble U)] : Prop :=
-  Defn_of_Approximant: (Finite U X) -> (Included U X A) -> (Approximant A X).
-End Approx.
-
-Hints Resolve Defn_of_Approximant.
-
-Section Infinite_sets.
-Variable U: Type.
-
-Lemma make_new_approximant:
-  (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) -> (Approximant U A X) ->
-   (Inhabited U (Setminus U A X)).
-Proof.
-Intros A X H' H'0.
-Elim H'0; Intros H'1 H'2.
-Apply Strict_super_set_contains_new_element; Auto with sets.
-Red; Intro H'3; Apply H'.
-Rewrite <- H'3; Auto with sets.
-Qed.
-
-Lemma approximants_grow:
-  (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
-   (n: nat) (cardinal U X n) -> (Included U X A) ->
-    (EXT Y | (cardinal U Y (S n)) /\ (Included U Y A)).
-Proof.
-Intros A X H' n H'0; Elim H'0; Auto with sets.
-Intro H'1.
-Cut (Inhabited U (Setminus U A (Empty_set U))).
-Intro H'2; Elim H'2.
-Intros x H'3.
-Exists (Add U (Empty_set U) x); Auto with sets.
-Split.
-Apply card_add; Auto with sets.
-Cut (In U A x).
-Intro H'4; Red; Auto with sets.
-Intros x0 H'5; Elim H'5; Auto with sets.
-Intros x1 H'6; Elim H'6; Auto with sets.
-Elim H'3; Auto with sets.
-Apply make_new_approximant; Auto with sets.
-Intros A0 n0 H'1 H'2 x H'3 H'5.
-LApply H'2; [Intro H'6; Elim H'6; Clear H'2 | Clear H'2]; Auto with sets.
-Intros x0 H'2; Try Assumption.
-Elim H'2; Intros H'7 H'8; Try Exact H'8; Clear H'2.
-Elim (make_new_approximant A x0); Auto with sets.
-Intros x1 H'2; Try Assumption.
-Exists (Add U x0 x1); Auto with sets.
-Split.
-Apply card_add; Auto with sets.
-Elim H'2; Auto with sets.
-Red.
-Intros x2 H'9; Elim H'9; Auto with sets.
-Intros x3 H'10; Elim H'10; Auto with sets.
-Elim H'2; Auto with sets.
-Auto with sets.
-Apply Defn_of_Approximant; Auto with sets.
-Apply cardinal_finite with n := (S n0); Auto with sets.
-Qed.
-
-Lemma approximants_grow':
-  (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
-   (n: nat) (cardinal U X n) -> (Approximant U A X) ->
-    (EXT Y | (cardinal U Y (S n)) /\ (Approximant U A Y)).
-Proof.
-Intros A X H' n H'0 H'1; Try Assumption.
-Elim H'1.
-Intros H'2 H'3.
-ElimType (EXT Y | (cardinal U Y (S n)) /\ (Included U Y A)).
-Intros x H'4; Elim H'4; Intros H'5 H'6; Try Exact H'5; Clear H'4.
-Exists x; Auto with sets.
-Split; [Auto with sets | Idtac].
-Apply Defn_of_Approximant; Auto with sets.
-Apply cardinal_finite with n := (S n); Auto with sets.
-Apply approximants_grow with X := X; Auto with sets.
-Qed.
-
-Lemma approximant_can_be_any_size:
-  (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
-   (n: nat) (EXT Y | (cardinal U Y n) /\ (Approximant U A Y)).
-Proof.
-Intros A H' H'0 n; Elim n.
-Exists (Empty_set U); Auto with sets.
-Intros n0 H'1; Elim H'1.
-Intros x H'2.
-Apply approximants_grow' with X := x; Tauto.
-Qed.
-
-Variable V: Type.
-
-Theorem Image_set_continuous:
-  (A: (Ensemble U))
-  (f: U -> V) (X: (Ensemble V)) (Finite V X) -> (Included V X (Im U V A f)) ->
-   (EX n |
-   (EXT Y | ((cardinal U Y n) /\ (Included U Y A)) /\ (Im U V Y f) == X)).
-Proof.
-Intros A f X H'; Elim H'.
-Intro H'0; Exists O.
-Exists (Empty_set U); Auto with sets.
-Intros A0 H'0 H'1 x H'2 H'3; Try Assumption.
-LApply H'1;
- [Intro H'4; Elim H'4; Intros n E; Elim E; Clear H'4 H'1 | Clear H'1]; Auto with sets.
-Intros x0 H'1; Try Assumption.
-Exists (S n); Try Assumption.
-Elim H'1; Intros H'4 H'5; Elim H'4; Intros H'6 H'7; Try Exact H'6; Clear H'4 H'1.
-Clear E.
-Generalize H'2.
-Rewrite <- H'5.
-Intro H'1; Try Assumption.
-Red in H'3.
-Generalize (H'3 x).
-Intro H'4; LApply H'4; [Intro H'8; Try Exact H'8; Clear H'4 | Clear H'4]; Auto with sets.
-Specialize 5 Im_inv with U := U V:=V X := A f := f y := x; Intro H'11; 
- LApply H'11; [Intro H'13; Elim H'11; Clear H'11 | Clear H'11]; Auto with sets.
-Intros x1 H'4; Try Assumption.
-Apply exT_intro with x := (Add U x0 x1).
-Split; [Split; [Try Assumption | Idtac] | Idtac].
-Apply card_add; Auto with sets.
-Red; Intro H'9; Try Exact H'9.
-Apply H'1.
-Elim H'4; Intros H'10 H'11; Rewrite <- H'11; Clear H'4; Auto with sets.
-Elim H'4; Intros H'9 H'10; Try Exact H'9; Clear H'4; Auto with sets.
-Red; Auto with sets.
-Intros x2 H'4; Elim H'4; Auto with sets.
-Intros x3 H'11; Elim H'11; Auto with sets.
-Elim H'4; Intros H'9 H'10; Rewrite <- H'10; Clear H'4; Auto with sets.
-Apply Im_add; Auto with sets.
-Qed.
-
-Theorem Image_set_continuous':
-  (A: (Ensemble U))
-  (f: U -> V) (X: (Ensemble V)) (Approximant V (Im U V A f) X) ->
-   (EXT Y | (Approximant U A Y) /\ (Im U V Y f) == X).
-Proof.
-Intros A f X H'; Try Assumption.
-Cut (EX n | (EXT Y |
-    ((cardinal U Y n) /\ (Included U Y A)) /\ (Im U V Y f) == X)).
-Intro H'0; Elim H'0; Intros n E; Elim E; Clear H'0.
-Intros x H'0; Try Assumption.
-Elim H'0; Intros H'1 H'2; Elim H'1; Intros H'3 H'4; Try Exact H'3;
- Clear H'1 H'0; Auto with sets.
-Exists x.
-Split; [Idtac | Try Assumption].
-Apply Defn_of_Approximant; Auto with sets.
-Apply cardinal_finite with n := n; Auto with sets.
-Apply Image_set_continuous; Auto with sets.
-Elim H'; Auto with sets.
-Elim H'; Auto with sets.
-Qed.
-
-Theorem Pigeonhole_bis:
-  (A: (Ensemble U)) (f: U -> V) ~ (Finite U A) -> (Finite V (Im U V A f)) ->
-   ~ (injective U V f).
-Proof.
-Intros A f H'0 H'1; Try Assumption.
-Elim (Image_set_continuous' A f (Im U V A f)); Auto with sets.
-Intros x H'2; Elim H'2; Intros H'3 H'4; Try Exact H'3; Clear H'2.
-Elim (make_new_approximant A x); Auto with sets.
-Intros x0 H'2; Elim H'2.
-Intros H'5 H'6.
-Elim (finite_cardinal V (Im U V A f)); Auto with sets.
-Intros n E.
-Elim (finite_cardinal U x); Auto with sets.
-Intros n0 E0.
-Apply Pigeonhole with A := (Add U x x0) n := (S n0) n' := n.
-Apply card_add; Auto with sets.
-Rewrite (Im_add U V x x0 f); Auto with sets.
-Cut (In V (Im U V x f) (f x0)).
-Intro H'8.
-Rewrite (Non_disjoint_union V (Im U V x f) (f x0)); Auto with sets.
-Rewrite H'4; Auto with sets.
-Elim (Extension V (Im U V x f) (Im U V A f)); Auto with sets.
-Apply le_lt_n_Sm.
-Apply cardinal_decreases with U := U V := V A := x f := f; Auto with sets.
-Rewrite H'4; Auto with sets.
-Elim H'3; Auto with sets.
-Qed.
-
-Theorem Pigeonhole_ter:
-  (A: (Ensemble U))
-  (f: U -> V) (n: nat) (injective U V f) -> (Finite V (Im U V A f)) ->
-   (Finite U A).
-Proof.
-Intros A f H' H'0 H'1.
-Apply NNPP.
-Red; Intro H'2.
-Elim (Pigeonhole_bis A f); Auto with sets.
-Qed.
-
-End Infinite_sets.
diff --git a/theories7/Sets/Integers.v b/theories7/Sets/Integers.v
deleted file mode 100755
index 7dee371f..00000000
--- a/theories7/Sets/Integers.v
+++ /dev/null
@@ -1,166 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Integers.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Export Finite_sets.
-Require Export Constructive_sets.
-Require Export Classical_Type.
-Require Export Classical_sets.
-Require Export Powerset.
-Require Export Powerset_facts.
-Require Export Powerset_Classical_facts.
-Require Export Gt.
-Require Export Lt.
-Require Export Le.
-Require Export Finite_sets_facts.
-Require Export Image.
-Require Export Infinite_sets.
-Require Export Compare_dec.
-Require Export Relations_1.
-Require Export Partial_Order.
-Require Export Cpo.
-
-Section Integers_sect.
-
-Inductive Integers : (Ensemble nat) :=
-      Integers_defn: (x: nat) (In nat Integers x).
-Hints Resolve Integers_defn.
-
-Lemma le_reflexive: (Reflexive nat le).
-Proof.
-Red; Auto with arith.
-Qed.
-
-Lemma le_antisym: (Antisymmetric nat le).
-Proof.
-Red; Intros x y H H';Rewrite (le_antisym x y);Auto.
-Qed.
-
-Lemma le_trans: (Transitive nat le).
-Proof.
-Red; Intros; Apply le_trans with y;Auto.
-Qed.
-Hints Resolve le_reflexive le_antisym le_trans.
-
-Lemma le_Order: (Order nat le).
-Proof.
-Auto with sets arith.
-Qed.
-Hints Resolve le_Order.
-
-Lemma triv_nat: (n: nat) (In nat Integers n).
-Proof.
-Auto with sets arith.
-Qed.
-Hints Resolve triv_nat.
-
-Definition nat_po: (PO nat).
-Apply Definition_of_PO with Carrier_of := Integers Rel_of := le; Auto with sets arith.
-Apply Inhabited_intro with x := O; Auto with sets arith.
-Defined.
-Hints Unfold nat_po.
-
-Lemma le_total_order: (Totally_ordered nat nat_po Integers).
-Proof.
-Apply Totally_ordered_definition.
-Simpl.
-Intros H' x y H'0.
-Specialize 2 le_or_lt with n := x m := y; Intro H'2; Elim H'2.
-Intro H'1; Left; Auto with sets arith.
-Intro H'1; Right.
-Cut (le y x); Auto with sets arith.
-Qed.
-Hints Resolve le_total_order.
-
-Lemma Finite_subset_has_lub:
-  (X: (Ensemble nat)) (Finite nat X) ->
-   (EXT m: nat | (Upper_Bound nat nat_po X m)).
-Proof.
-Intros X H'; Elim H'.
-Exists O.
-Apply Upper_Bound_definition; Auto with sets arith.
-Intros y H'0; Elim H'0; Auto with sets arith.
-Intros A H'0 H'1 x H'2; Try Assumption.
-Elim H'1; Intros x0 H'3; Clear H'1.
-Elim le_total_order.
-Simpl.
-Intro H'1; Try Assumption.
-LApply H'1; [Intro H'4; Idtac | Try Assumption]; Auto with sets arith.
-Generalize (H'4 x0 x).
-Clear H'4.
-Clear H'1.
-Intro H'1; LApply H'1;
- [Intro H'4; Elim H'4;
-   [Intro H'5; Try Exact H'5; Clear H'4 H'1 | Intro H'5; Clear H'4 H'1] |
-   Clear H'1].
-Exists x.
-Apply Upper_Bound_definition; Auto with sets arith; Simpl.
-Intros y H'1; Elim H'1.
-Generalize le_trans.
-Intro H'4; Red in H'4.
-Intros x1 H'6; Try Assumption.
-Apply H'4 with y := x0; Auto with sets arith.
-Elim H'3; Simpl; Auto with sets arith.
-Intros x1 H'4; Elim H'4; Auto with sets arith.
-Exists x0.
-Apply Upper_Bound_definition; Auto with sets arith; Simpl.
-Intros y H'1; Elim H'1.
-Intros x1 H'4; Try Assumption.
-Elim H'3; Simpl; Auto with sets arith.
-Intros x1 H'4; Elim H'4; Auto with sets arith.
-Red.
-Intros x1 H'1; Elim H'1; Auto with sets arith.
-Qed.
-
-Lemma Integers_has_no_ub: ~ (EXT m:nat | (Upper_Bound nat nat_po Integers m)).
-Proof.
-Red; Intro H'; Elim H'.
-Intros x H'0.
-Elim H'0; Intros H'1 H'2.
-Cut (In nat Integers (S x)).
-Intro H'3.
-Specialize 1 H'2 with y := (S x); Intro H'4; LApply H'4;
- [Intro H'5; Clear H'4 | Try Assumption; Clear H'4].
-Simpl in H'5.
-Absurd (le (S x) x); Auto with arith.
-Auto with sets arith.
-Qed.
-
-Lemma Integers_infinite: ~ (Finite nat Integers).
-Proof.
-Generalize Integers_has_no_ub.
-Intro H'; Red; Intro H'0; Try Exact H'0.
-Apply H'.
-Apply Finite_subset_has_lub; Auto with sets arith.
-Qed.
-
-End Integers_sect.
-
-
-
-
-
diff --git a/theories7/Sets/Multiset.v b/theories7/Sets/Multiset.v
deleted file mode 100755
index b5d5edf7..00000000
--- a/theories7/Sets/Multiset.v
+++ /dev/null
@@ -1,186 +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: Multiset.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-(* G. Huet 1-9-95 *)
-
-Require Permut.
-
-Set Implicit Arguments.
-
-Section multiset_defs.
-
-Variable A : Set.
-Variable eqA : A -> A -> Prop.
-Hypothesis Aeq_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
-
-Inductive multiset : Set := 
-      Bag : (A->nat) -> multiset.
-
-Definition EmptyBag := (Bag [a:A]O).
-Definition SingletonBag := [a:A]
-	(Bag [a':A]Cases (Aeq_dec a a') of
-                      (left _) => (S O) 
-	           | (right _) => O 
-                   end
-	).
-
-Definition multiplicity : multiset -> A -> nat :=
-  [m:multiset][a:A]let (f) = m in (f a).
-
-(** multiset equality *)
-Definition meq := [m1,m2:multiset]
-    (a:A)(multiplicity m1 a)=(multiplicity m2 a).
-
-Hints Unfold  meq multiplicity.
-
-Lemma meq_refl : (x:multiset)(meq x x).
-Proof.
-NewDestruct x; Auto.
-Qed.
-Hints Resolve meq_refl.
-
-Lemma meq_trans : (x,y,z:multiset)(meq x y)->(meq y z)->(meq x z).
-Proof.
-Unfold meq.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Rewrite H; Auto.
-Qed.
-
-Lemma meq_sym : (x,y:multiset)(meq x y)->(meq y x).
-Proof.
-Unfold meq.
-NewDestruct x; NewDestruct y; Auto.
-Qed.
-Hints Immediate meq_sym.
-
-(** multiset union *)
-Definition munion := [m1,m2:multiset]
-    (Bag [a:A](plus (multiplicity m1 a)(multiplicity m2 a))).
-
-Lemma munion_empty_left :
-     (x:multiset)(meq x (munion EmptyBag x)).
-Proof.
-Unfold meq; Unfold munion; Simpl; Auto.
-Qed.
-Hints Resolve munion_empty_left.
-
-Lemma munion_empty_right :
-     (x:multiset)(meq x (munion x EmptyBag)).
-Proof.
-Unfold meq; Unfold munion; Simpl; Auto.
-Qed.
-
-
-Require Plus. (* comm. and ass. of plus *)
-
-Lemma munion_comm : (x,y:multiset)(meq (munion x y) (munion y x)).
-Proof.
-Unfold meq; Unfold multiplicity; Unfold munion.
-NewDestruct x; NewDestruct y; Auto with arith.
-Qed.
-Hints Resolve munion_comm.
-
-Lemma munion_ass : 
-      (x,y,z:multiset)(meq (munion (munion x y) z) (munion x (munion y z))).
-Proof.
-Unfold meq; Unfold munion; Unfold multiplicity.
-NewDestruct x; NewDestruct y; NewDestruct z; Auto with arith.
-Qed.
-Hints Resolve munion_ass.
-
-Lemma meq_left :  (x,y,z:multiset)(meq x y)->(meq (munion x z) (munion y z)).
-Proof.
-Unfold meq; Unfold munion; Unfold multiplicity.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Elim H; Auto with arith.
-Qed.
-Hints Resolve meq_left.
-
-Lemma meq_right : (x,y,z:multiset)(meq x y)->(meq (munion z x) (munion z y)).
-Proof.
-Unfold meq; Unfold munion; Unfold multiplicity.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Elim H; Auto.
-Qed.
-Hints Resolve meq_right.
-
-
-(** Here we should make multiset an abstract datatype, by hiding [Bag],
-    [munion], [multiplicity]; all further properties are proved abstractly *)
-
-Lemma munion_rotate :
-   (x,y,z:multiset)(meq (munion x (munion y z)) (munion z (munion x y))).
-Proof.
-Intros; Apply (op_rotate multiset munion meq); Auto.
-Exact meq_trans.
-Qed.
-
-Lemma meq_congr : (x,y,z,t:multiset)(meq x y)->(meq z t)->
-                  (meq (munion x z) (munion y t)).
-Proof.
-Intros; Apply (cong_congr multiset munion meq); Auto.
-Exact meq_trans.
-Qed.
-
-Lemma munion_perm_left :
-   (x,y,z:multiset)(meq (munion x (munion y z)) (munion y (munion x z))).
-Proof.
-Intros; Apply (perm_left multiset munion meq); Auto.
-Exact meq_trans.
-Qed.
-
-Lemma multiset_twist1 : (x,y,z,t:multiset)
-   (meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z)).
-Proof.
-Intros; Apply (twist multiset munion meq); Auto.
-Exact meq_trans.
-Qed.
-
-Lemma multiset_twist2 : (x,y,z,t:multiset)
-   (meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t)).
-Proof.
-Intros; Apply meq_trans with (munion (munion x (munion y z)) t).
-Apply meq_sym; Apply munion_ass.
-Apply meq_left; Apply munion_perm_left.
-Qed.
-
-(** specific for treesort *)
-
-Lemma treesort_twist1 : (x,y,z,t,u:multiset) (meq u (munion y z)) ->
-   (meq (munion x (munion u t)) (munion (munion y (munion x t)) z)).
-Proof.
-Intros; Apply meq_trans with (munion x (munion (munion y z) t)).
-Apply meq_right; Apply meq_left; Trivial.
-Apply multiset_twist1.
-Qed.
-
-Lemma treesort_twist2 : (x,y,z,t,u:multiset) (meq u (munion y z)) ->
-   (meq (munion x (munion u t)) (munion (munion y (munion x z)) t)).
-Proof.
-Intros; Apply meq_trans with (munion x (munion (munion y z) t)).
-Apply meq_right; Apply meq_left; Trivial.
-Apply multiset_twist2.
-Qed.
-
-
-(*i theory of minter to do similarly 
-Require Min.
-(* multiset intersection *)
-Definition minter := [m1,m2:multiset]
-    (Bag [a:A](min (multiplicity m1 a)(multiplicity m2 a))).
-i*)
-
-End multiset_defs.
-
-Unset Implicit Arguments.
-
-Hints Unfold meq multiplicity : v62 datatypes.
-Hints Resolve munion_empty_right munion_comm munion_ass meq_left meq_right munion_empty_left : v62 datatypes.
-Hints Immediate meq_sym : v62 datatypes.
diff --git a/theories7/Sets/Partial_Order.v b/theories7/Sets/Partial_Order.v
deleted file mode 100755
index 759cf4e2..00000000
--- a/theories7/Sets/Partial_Order.v
+++ /dev/null
@@ -1,100 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Partial_Order.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Export Ensembles.
-Require Export Relations_1.
-
-Section Partial_orders.
-Variable U: Type.
-
-Definition Carrier :=  (Ensemble U).
-
-Definition Rel :=  (Relation U).
-
-Record PO : Type := Definition_of_PO {
-   Carrier_of: (Ensemble U);
-   Rel_of: (Relation U);
-   PO_cond1: (Inhabited U Carrier_of);
-   PO_cond2: (Order U Rel_of) }.
-Variable p: PO.
-
-Definition Strict_Rel_of : Rel :=  [x, y: U] (Rel_of p x y) /\ ~ x == y.
-
-Inductive covers [y, x:U]: Prop :=
-      Definition_of_covers:
-      (Strict_Rel_of x y) -> 
-          ~ (EXT z | (Strict_Rel_of x z) /\ (Strict_Rel_of z y)) -> 
-          (covers y x).
-
-End Partial_orders.
-
-Hints Unfold Carrier_of Rel_of  Strict_Rel_of : sets v62.
-Hints Resolve Definition_of_covers : sets v62.
-
-
-Section Partial_order_facts.
-Variable U:Type.
-Variable D:(PO U).
-
-Lemma Strict_Rel_Transitive_with_Rel:
-  (x:U) (y:U) (z:U) (Strict_Rel_of U D x y) -> (Rel_of U D y z) ->
-  (Strict_Rel_of U D x z).
-Unfold 1 Strict_Rel_of.
-Red.
-Elim D; Simpl.
-Intros C R H' H'0; Elim H'0.
-Intros H'1 H'2 H'3 x y z H'4 H'5; Split.
-Apply H'2 with y := y; Tauto.
-Red; Intro H'6.
-Elim H'4; Intros H'7 H'8; Apply H'8; Clear H'4.
-Apply H'3; Auto.
-Rewrite H'6; Tauto.
-Qed.
-
-Lemma Strict_Rel_Transitive_with_Rel_left:
-  (x:U) (y:U) (z:U) (Rel_of U D x y) -> (Strict_Rel_of U D y z) ->
-  (Strict_Rel_of U D x z).
-Unfold 1 Strict_Rel_of.
-Red.
-Elim D; Simpl.
-Intros C R H' H'0; Elim H'0.
-Intros H'1 H'2 H'3 x y z H'4 H'5; Split.
-Apply H'2 with y := y; Tauto.
-Red; Intro H'6.
-Elim H'5; Intros H'7 H'8; Apply H'8; Clear H'5.
-Apply H'3; Auto.
-Rewrite <- H'6; Auto.
-Qed.
-
-Lemma Strict_Rel_Transitive: (Transitive U (Strict_Rel_of U D)).
-Red.
-Intros x y z H' H'0.
-Apply Strict_Rel_Transitive_with_Rel with y := y; 
-  [ Intuition | Unfold Strict_Rel_of in H' H'0; Intuition ].
-Qed.
-End Partial_order_facts.
diff --git a/theories7/Sets/Permut.v b/theories7/Sets/Permut.v
deleted file mode 100755
index 2d0413a8..00000000
--- a/theories7/Sets/Permut.v
+++ /dev/null
@@ -1,91 +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: Permut.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-(* G. Huet 1-9-95 *)
-
-(** We consider a Set [U], given with a commutative-associative operator [op],
-    and a congruence [cong]; we show permutation lemmas *)
-
-Section Axiomatisation.
-
-Variable U: Set.
-
-Variable op: U -> U -> U.
-
-Variable cong : U -> U -> Prop.
-
-Hypothesis op_comm : (x,y:U)(cong (op x y) (op y x)).
-Hypothesis op_ass  : (x,y,z:U)(cong (op (op x y) z) (op x (op y z))).
-
-Hypothesis cong_left :  (x,y,z:U)(cong x y)->(cong (op x z) (op y z)).
-Hypothesis cong_right : (x,y,z:U)(cong x y)->(cong (op z x) (op z y)).
-Hypothesis cong_trans : (x,y,z:U)(cong x y)->(cong y z)->(cong x z).
-Hypothesis cong_sym : (x,y:U)(cong x y)->(cong y x).
-
-(** Remark. we do not need: [Hypothesis cong_refl : (x:U)(cong x x)]. *)
-
-Lemma cong_congr :
- (x,y,z,t:U)(cong x y)->(cong z t)->(cong (op x z) (op y t)).
-Proof.
-Intros; Apply cong_trans with (op y z).
-Apply cong_left; Trivial.
-Apply cong_right; Trivial.
-Qed.
-
-Lemma comm_right : (x,y,z:U)(cong (op x (op y z)) (op x (op z y))).
-Proof.
-Intros; Apply cong_right; Apply op_comm.
-Qed.
-
-Lemma comm_left : (x,y,z:U)(cong (op (op x y) z) (op (op y x) z)).
-Proof.
-Intros; Apply cong_left; Apply op_comm.
-Qed.
-
-Lemma perm_right : (x,y,z:U)(cong (op (op x y) z) (op (op x z) y)).
-Proof.
-Intros.
-Apply cong_trans with (op x (op y z)).
-Apply op_ass.
-Apply cong_trans with (op x (op z y)). 
-Apply cong_right; Apply op_comm.
-Apply cong_sym; Apply op_ass.
-Qed.
-
-Lemma perm_left : (x,y,z:U)(cong (op x (op y z)) (op y (op x z))).
-Proof.
-Intros.
-Apply cong_trans with (op (op x y) z).
-Apply cong_sym; Apply op_ass.
-Apply cong_trans with (op (op y x) z).
-Apply cong_left; Apply op_comm.
-Apply op_ass.
-Qed.
-
-Lemma op_rotate : (x,y,z,t:U)(cong (op x (op y z)) (op z (op x y))).
-Proof.
-Intros; Apply cong_trans with (op (op x y) z).
-Apply cong_sym; Apply op_ass.
-Apply op_comm.
-Qed.
-
-(* Needed for treesort ... *)
-Lemma twist : (x,y,z,t:U)
-   (cong (op x (op (op y z) t)) (op (op y (op x t)) z)).
-Proof.
-Intros.
-Apply cong_trans with (op x (op (op y t) z)).
-Apply cong_right; Apply perm_right.
-Apply cong_trans with (op (op x (op y t)) z).
-Apply cong_sym; Apply op_ass.
-Apply cong_left; Apply perm_left.
-Qed.
-
-End Axiomatisation.
diff --git a/theories7/Sets/Powerset.v b/theories7/Sets/Powerset.v
deleted file mode 100755
index b1fa892c..00000000
--- a/theories7/Sets/Powerset.v
+++ /dev/null
@@ -1,188 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Powerset.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Export Ensembles.
-Require Export Relations_1.
-Require Export Relations_1_facts.
-Require Export Partial_Order.
-Require Export Cpo.
-
-Section The_power_set_partial_order.
-Variable U: Type.
-
-Inductive Power_set [A:(Ensemble U)]: (Ensemble (Ensemble U)) :=
-    Definition_of_Power_set:
-     (X: (Ensemble U)) (Included U X A) -> (In (Ensemble U) (Power_set A) X).
-Hints Resolve Definition_of_Power_set.
-
-Theorem Empty_set_minimal: (X: (Ensemble U)) (Included U (Empty_set U) X).
-Intro X; Red.
-Intros x H'; Elim H'.
-Qed.
-Hints Resolve Empty_set_minimal.
-
-Theorem Power_set_Inhabited:
-  (X: (Ensemble U)) (Inhabited (Ensemble U) (Power_set X)).
-Intro X.
-Apply Inhabited_intro with (Empty_set U); Auto with sets.
-Qed.
-Hints Resolve Power_set_Inhabited.
-
-Theorem Inclusion_is_an_order: (Order (Ensemble U) (Included U)).
-Auto 6 with sets.
-Qed.
-Hints Resolve Inclusion_is_an_order.
-
-Theorem Inclusion_is_transitive: (Transitive (Ensemble U) (Included U)).
-Elim Inclusion_is_an_order; Auto with sets.
-Qed.
-Hints Resolve Inclusion_is_transitive.
-
-Definition Power_set_PO: (Ensemble U) -> (PO (Ensemble U)).
-Intro A; Try Assumption.
-Apply Definition_of_PO with (Power_set A) (Included U); Auto with sets.
-Defined.
-Hints Unfold  Power_set_PO.
-
-Theorem Strict_Rel_is_Strict_Included:
-  (same_relation
-     (Ensemble U) (Strict_Included U)
-     (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U)))).
-Auto with sets.
-Qed.
-Hints Resolve Strict_Rel_Transitive Strict_Rel_is_Strict_Included.
-
-Lemma Strict_inclusion_is_transitive_with_inclusion:
-  (x, y, z:(Ensemble U)) (Strict_Included U x y) -> (Included U y z) ->
-  (Strict_Included U x z).
-Intros x y z H' H'0; Try Assumption.
-Elim Strict_Rel_is_Strict_Included.
-Unfold contains.
-Intros H'1 H'2; Try Assumption.
-Apply H'1.
-Apply Strict_Rel_Transitive_with_Rel with y := y; Auto with sets.
-Qed.
-
-Lemma Strict_inclusion_is_transitive_with_inclusion_left:
-  (x, y, z:(Ensemble U)) (Included U x y) -> (Strict_Included U y z) ->
-  (Strict_Included U x z).
-Intros x y z H' H'0; Try Assumption.
-Elim Strict_Rel_is_Strict_Included.
-Unfold contains.
-Intros H'1 H'2; Try Assumption.
-Apply H'1.
-Apply Strict_Rel_Transitive_with_Rel_left with y := y; Auto with sets.
-Qed.
-
-Lemma Strict_inclusion_is_transitive:
-  (Transitive (Ensemble U) (Strict_Included U)).
-Apply cong_transitive_same_relation
-     with R := (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))); Auto with sets.
-Qed.
-
-Theorem Empty_set_is_Bottom:
-  (A: (Ensemble U)) (Bottom (Ensemble U) (Power_set_PO A) (Empty_set U)).
-Intro A; Apply Bottom_definition; Simpl; Auto with sets.
-Qed.
-Hints Resolve Empty_set_is_Bottom.
-
-Theorem Union_minimal:
-  (a, b, X: (Ensemble U)) (Included U a X) -> (Included U b X) ->
-   (Included U (Union U a b) X).
-Intros a b X H' H'0; Red.
-Intros x H'1; Elim H'1; Auto with sets.
-Qed.
-Hints Resolve Union_minimal.
-
-Theorem Intersection_maximal:
-  (a, b, X: (Ensemble U)) (Included U X a) -> (Included U X b) ->
-   (Included U X (Intersection U a b)).
-Auto with sets.
-Qed.
-
-Theorem Union_increases_l: (a, b: (Ensemble U)) (Included U a (Union U a b)).
-Auto with sets.
-Qed.
-
-Theorem Union_increases_r: (a, b: (Ensemble U)) (Included U b (Union U a b)).
-Auto with sets.
-Qed.
-
-Theorem Intersection_decreases_l:
-  (a, b: (Ensemble U)) (Included U (Intersection U a b) a).
-Intros a b; Red.
-Intros x H'; Elim H'; Auto with sets.
-Qed.
-
-Theorem Intersection_decreases_r:
-  (a, b: (Ensemble U)) (Included U (Intersection U a b) b).
-Intros a b; Red.
-Intros x H'; Elim H'; Auto with sets.
-Qed.
-Hints Resolve Union_increases_l Union_increases_r Intersection_decreases_l
-     Intersection_decreases_r.
-
-Theorem Union_is_Lub:
-  (A: (Ensemble U)) (a, b: (Ensemble U)) (Included U a A) -> (Included U b A) ->
-   (Lub (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b) (Union U a b)).
-Intros A a b H' H'0.
-Apply Lub_definition; Simpl.
-Apply Upper_Bound_definition; Simpl; Auto with sets.
-Intros y H'1; Elim H'1; Auto with sets.
-Intros y H'1; Elim H'1; Simpl; Auto with sets.
-Qed.
-
-Theorem Intersection_is_Glb:
-  (A: (Ensemble U)) (a, b: (Ensemble U)) (Included U a A) -> (Included U b A) ->
-   (Glb
-      (Ensemble U)
-      (Power_set_PO A)
-      (Couple (Ensemble U) a b)
-      (Intersection U a b)).
-Intros A a b H' H'0.
-Apply Glb_definition; Simpl.
-Apply Lower_Bound_definition; Simpl; Auto with sets.
-Apply Definition_of_Power_set.
-Generalize Inclusion_is_transitive; Intro IT; Red in IT; Apply IT with a; Auto with sets.
-Intros y H'1; Elim H'1; Auto with sets.
-Intros y H'1; Elim H'1; Simpl; Auto with sets.
-Qed.
-
-End The_power_set_partial_order.
-
-Hints Resolve Empty_set_minimal : sets v62.
-Hints Resolve Power_set_Inhabited : sets v62.
-Hints Resolve Inclusion_is_an_order : sets v62.
-Hints Resolve Inclusion_is_transitive : sets v62.
-Hints Resolve Union_minimal : sets v62.
-Hints Resolve Union_increases_l : sets v62.
-Hints Resolve Union_increases_r : sets v62.
-Hints Resolve Intersection_decreases_l : sets v62.
-Hints Resolve Intersection_decreases_r : sets v62.
-Hints Resolve Empty_set_is_Bottom : sets v62.
-Hints Resolve Strict_inclusion_is_transitive : sets v62.
diff --git a/theories7/Sets/Powerset_Classical_facts.v b/theories7/Sets/Powerset_Classical_facts.v
deleted file mode 100755
index 1a51c562..00000000
--- a/theories7/Sets/Powerset_Classical_facts.v
+++ /dev/null
@@ -1,338 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Powerset_Classical_facts.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Export Ensembles.
-Require Export Constructive_sets.
-Require Export Relations_1.
-Require Export Relations_1_facts.
-Require Export Partial_Order.
-Require Export Cpo.
-Require Export Powerset.
-Require Export Powerset_facts.
-Require Export Classical_Type.
-Require Export Classical_sets.
-
-Section Sets_as_an_algebra.
-
-Variable U: Type.
-
-Lemma sincl_add_x:
-  (A, B: (Ensemble U))
-  (x: U) ~ (In U A x) -> (Strict_Included U (Add U A x) (Add U B x)) ->
-                         (Strict_Included U A B).
-Proof.
-Intros A B x H' H'0; Red.
-LApply (Strict_Included_inv U (Add U A x) (Add U B x)); Auto with sets.
-Clear H'0; Intro H'0; Split.
-Apply incl_add_x with x := x; Tauto.
-Elim H'0; Intros H'1 H'2; Elim H'2; Clear H'0 H'2.
-Intros x0 H'0.
-Red; Intro H'2.
-Elim H'0; Clear H'0.
-Rewrite <- H'2; Auto with sets.
-Qed.
-
-Lemma incl_soustr_in:
-  (X: (Ensemble U)) (x: U) (In U X x) -> (Included U (Subtract U X x) X).
-Proof.
-Intros X x H'; Red.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Qed.
-Hints Resolve incl_soustr_in : sets v62.
-
-Lemma incl_soustr:
-  (X, Y: (Ensemble U)) (x: U) (Included U X Y) ->
-   (Included U (Subtract U X x) (Subtract U Y x)).
-Proof.
-Intros X Y x H'; Red.
-Intros x0 H'0; Elim H'0.
-Intros H'1 H'2.
-Apply Subtract_intro; Auto with sets.
-Qed.
-Hints Resolve incl_soustr : sets v62.
-
-
-Lemma incl_soustr_add_l:
-  (X: (Ensemble U)) (x: U) (Included U (Subtract U (Add U X x) x) X).
-Proof.
-Intros X x; Red.
-Intros x0 H'; Elim H'; Auto with sets.
-Intro H'0; Elim H'0; Auto with sets.
-Intros t H'1 H'2; Elim H'2; Auto with sets.
-Qed.
-Hints Resolve incl_soustr_add_l : sets v62.
-
-Lemma incl_soustr_add_r:
-  (X: (Ensemble U)) (x: U) ~ (In U X x) ->
-   (Included U X (Subtract U (Add U X x) x)).
-Proof.
-Intros X x H'; Red.
-Intros x0 H'0; Try Assumption.
-Apply Subtract_intro; Auto with sets.
-Red; Intro H'1; Apply H'; Rewrite H'1; Auto with sets.
-Qed.
-Hints Resolve incl_soustr_add_r : sets v62.
-
-Lemma add_soustr_2:
-  (X: (Ensemble U)) (x: U) (In U X x) ->
-   (Included U X (Add U (Subtract U X x) x)).
-Proof.
-Intros X x H'; Red.
-Intros x0 H'0; Try Assumption.
-Elim (classic x == x0); Intro K; Auto with sets.
-Elim K; Auto with sets.
-Qed.
-
-Lemma add_soustr_1:
-  (X: (Ensemble U)) (x: U) (In U X x) ->
-   (Included U (Add U (Subtract U X x) x) X).
-Proof.
-Intros X x H'; Red.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intros y H'1; Elim H'1; Auto with sets.
-Intros t H'1; Try Assumption.
-Rewrite <- (Singleton_inv U x t); Auto with sets.
-Qed.
-Hints Resolve add_soustr_1 add_soustr_2 : sets v62.
-
-Lemma add_soustr_xy:
-  (X: (Ensemble U)) (x, y: U) ~ x == y ->
-    (Subtract U (Add U X x) y) == (Add U (Subtract U X y) x).
-Proof.
-Intros X x y H'; Apply Extensionality_Ensembles.
-Split; Red.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intro H'1; Elim H'1.
-Intros u H'2 H'3; Try Assumption.
-Apply Add_intro1.
-Apply Subtract_intro; Auto with sets.
-Intros t H'2 H'3; Try Assumption.
-Elim (Singleton_inv U x t); Auto with sets.
-Intros u H'2; Try Assumption.
-Elim (Add_inv U (Subtract U X y) x u); Auto with sets.
-Intro H'0; Elim H'0; Auto with sets.
-Intro H'0; Rewrite <- H'0; Auto with sets.
-Qed.
-Hints Resolve add_soustr_xy : sets v62.
-
-Lemma incl_st_add_soustr:
-  (X, Y: (Ensemble U)) (x: U) ~ (In U X x) -> 
-   (Strict_Included U (Add U X x) Y) ->
-   (Strict_Included U X (Subtract U Y x)).
-Proof.
-Intros X Y x H' H'0; Apply sincl_add_x with x := x; Auto with sets.
-Split.
-Elim H'0.
-Intros H'1 H'2.
-Generalize (Inclusion_is_transitive U).
-Intro H'4; Red in H'4.
-Apply H'4 with y := Y; Auto with sets.
-Red in H'0.
-Elim H'0; Intros H'1 H'2; Try Exact H'1; Clear H'0. (* PB *)
-Red; Intro H'0; Apply H'2.
-Rewrite H'0; Auto 8 with sets.
-Qed.
-
-Lemma Sub_Add_new:
-  (X: (Ensemble U)) (x: U) ~ (In U X x) -> X == (Subtract U (Add U X x) x).
-Proof.
-Auto with sets.
-Qed.
-
-Lemma Simplify_add:
-  (X, X0 : (Ensemble U)) (x: U)
-  ~ (In U X x) -> ~ (In U X0 x) ->  (Add U X x) == (Add U X0 x) -> X == X0.
-Proof.
-Intros X X0 x H' H'0 H'1; Try Assumption.
-Rewrite (Sub_Add_new X x); Auto with sets.
-Rewrite (Sub_Add_new X0 x); Auto with sets.
-Rewrite H'1; Auto with sets.
-Qed.
-
-Lemma Included_Add:
-  (X, A: (Ensemble U)) (x: U) (Included U X (Add U A x)) ->
-   (Included U X A) \/
-   (EXT A' | X == (Add U A' x) /\ (Included U A' A)).
-Proof.
-Intros X A x H'0; Try Assumption.
-Elim (classic (In U X x)).
-Intro H'1; Right; Try Assumption.
-Exists (Subtract U X x).
-Split; Auto with sets.
-Red in H'0.
-Red.
-Intros x0 H'2; Try Assumption.
-LApply (Subtract_inv U X x x0); Auto with sets.
-Intro H'3; Elim H'3; Intros K K'; Clear H'3.
-LApply (H'0 x0); Auto with sets.
-Intro H'3; Try Assumption.
-LApply (Add_inv U A x x0); Auto with sets.
-Intro H'4; Elim H'4;
- [Intro H'5; Try Exact H'5; Clear H'4 | Intro H'5; Clear H'4].
-Elim K'; Auto with sets.
-Intro H'1; Left; Try Assumption.
-Red in H'0.
-Red.
-Intros x0 H'2; Try Assumption.
-LApply (H'0 x0); Auto with sets.
-Intro H'3; Try Assumption.
-LApply (Add_inv U A x x0); Auto with sets.
-Intro H'4; Elim H'4;
- [Intro H'5; Try Exact H'5; Clear H'4 | Intro H'5; Clear H'4].
-Absurd (In U X x0); Auto with sets.
-Rewrite <- H'5; Auto with sets.
-Qed.
-
-Lemma setcover_inv:
- (A: (Ensemble U))
- (x, y: (Ensemble U)) (covers (Ensemble U) (Power_set_PO U A) y x) ->
- (Strict_Included U x y) /\
- ((z: (Ensemble U)) (Included U x z) -> (Included U z y) -> x == z \/ z == y).
-Proof.
-Intros A x y H'; Elim H'.
-Unfold Strict_Rel_of; Simpl.
-Intros H'0 H'1; Split; [Auto with sets | Idtac].
-Intros z H'2 H'3; Try Assumption.
-Elim (classic  x == z); Auto with sets.
-Intro H'4; Right; Try Assumption.
-Elim (classic  z == y); Auto with sets.
-Intro H'5; Try Assumption.
-Elim H'1.
-Exists z; Auto with sets.
-Qed.
-
-Theorem Add_covers:
-  (A: (Ensemble U)) (a: (Ensemble U)) (Included U a A) ->
-   (x: U) (In U A x) -> ~ (In U a x) ->
-    (covers (Ensemble U) (Power_set_PO U A) (Add U a x) a).
-Proof.
-Intros A a H' x H'0 H'1; Try Assumption.
-Apply setcover_intro; Auto with sets.
-Red.
-Split; [Idtac | Red; Intro H'2; Try Exact H'2]; Auto with sets.
-Apply H'1.
-Rewrite H'2; Auto with sets.
-Red; Intro H'2; Elim H'2; Clear H'2.
-Intros z H'2; Elim H'2; Intros H'3 H'4; Try Exact H'3; Clear H'2.
-LApply (Strict_Included_inv U a z); Auto with sets; Clear H'3.
-Intro H'2; Elim H'2; Intros H'3 H'5; Elim H'5; Clear H'2 H'5.
-Intros x0 H'2; Elim H'2.
-Intros H'5 H'6; Try Assumption.
-Generalize H'4; Intro K.
-Red in H'4.
-Elim H'4; Intros H'8 H'9; Red in H'8; Clear H'4.
-LApply (H'8 x0); Auto with sets.
-Intro H'7; Try Assumption.
-Elim (Add_inv U a x x0); Auto with sets.
-Intro H'15.
-Cut (Included U (Add U a x) z).
-Intro H'10; Try Assumption.
-Red in K.
-Elim K; Intros H'11 H'12; Apply H'12; Clear K; Auto with sets.
-Rewrite H'15.
-Red.
-Intros x1 H'10; Elim H'10; Auto with sets.
-Intros x2 H'11; Elim H'11; Auto with sets.
-Qed.
-
-Theorem covers_Add:
-  (A: (Ensemble U))
-  (a, a': (Ensemble U))
-  (Included U a A) ->
-  (Included U a' A) -> (covers (Ensemble U) (Power_set_PO U A) a' a) ->
-   (EXT x | a' == (Add U a x) /\ ((In U A x) /\ ~ (In U a x))).
-Proof.
-Intros A a a' H' H'0 H'1; Try Assumption.
-Elim (setcover_inv A a a'); Auto with sets.
-Intros H'6 H'7.
-Clear H'1.
-Elim (Strict_Included_inv U a a'); Auto with sets.
-Intros H'5 H'8; Elim H'8.
-Intros x H'1; Elim H'1.
-Intros H'2 H'3; Try Assumption.
-Exists x.
-Split; [Try Assumption | Idtac].
-Clear H'8 H'1.
-Elim (H'7 (Add U a x)); Auto with sets.
-Intro H'1.
-Absurd a ==(Add U a x); Auto with sets.
-Red; Intro H'8; Try Exact H'8.
-Apply H'3.
-Rewrite H'8; Auto with sets.
-Auto with sets.
-Red.
-Intros x0 H'1; Elim H'1; Auto with sets.
-Intros x1 H'8; Elim H'8; Auto with sets.
-Split; [Idtac | Try Assumption].
-Red in H'0; Auto with sets.
-Qed.
-
-Theorem covers_is_Add:
-  (A: (Ensemble U))
-  (a, a': (Ensemble U)) (Included U a A) -> (Included U a' A) ->
-   (iff
-      (covers (Ensemble U) (Power_set_PO U A) a' a)
-      (EXT x | a' == (Add U a x) /\ ((In U A x) /\ ~ (In U a x)))).
-Proof.
-Intros A a a' H' H'0; Split; Intro K.
-Apply covers_Add with A := A; Auto with sets.
-Elim K.
-Intros x H'1; Elim H'1; Intros H'2 H'3; Rewrite H'2; Clear H'1.
-Apply Add_covers; Intuition.
-Qed.
-
-Theorem Singleton_atomic:
-  (x:U) (A:(Ensemble U)) (In U A x) ->
-  (covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U)).
-Intros x A H'.
-Rewrite <- (Empty_set_zero' U x).
-Apply Add_covers; Auto with sets.
-Qed.
-
-Lemma less_than_singleton:
-  (X:(Ensemble U)) (x:U) (Strict_Included U X (Singleton U x)) ->
-  X ==(Empty_set U).
-Intros X x H'; Try Assumption.
-Red in H'.
-LApply (Singleton_atomic x (Full_set U));
- [Intro H'2; Try Exact H'2 | Apply Full_intro].
-Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
-Elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x));
- [Intros H'6 H'7; Try Exact H'7 | Idtac]; Auto with sets.
-Elim (H'7 X); [Intro H'5; Try Exact H'5 | Intro H'5 | Idtac | Idtac]; Auto with sets.
-Elim H'1; Auto with sets.
-Qed.
-
-End Sets_as_an_algebra.
-
-Hints Resolve incl_soustr_in : sets v62.
-Hints Resolve incl_soustr : sets v62.
-Hints Resolve incl_soustr_add_l : sets v62.
-Hints Resolve incl_soustr_add_r : sets v62.
-Hints Resolve add_soustr_1 add_soustr_2 : sets v62.
-Hints Resolve add_soustr_xy : sets v62.
diff --git a/theories7/Sets/Powerset_facts.v b/theories7/Sets/Powerset_facts.v
deleted file mode 100755
index fbe7d93e..00000000
--- a/theories7/Sets/Powerset_facts.v
+++ /dev/null
@@ -1,276 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Powerset_facts.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Require Export Ensembles.
-Require Export Constructive_sets.
-Require Export Relations_1.
-Require Export Relations_1_facts.
-Require Export Partial_Order.
-Require Export Cpo.
-Require Export Powerset.
-
-Section Sets_as_an_algebra.
-Variable U: Type.
-Hints Unfold not.
-
-Theorem Empty_set_zero :
-  (X: (Ensemble U)) (Union U (Empty_set U) X) == X.
-Proof.
-Auto 6 with sets.
-Qed.
-Hints Resolve Empty_set_zero.
-
-Theorem Empty_set_zero' :
-  (x: U) (Add U (Empty_set U) x) == (Singleton U x).
-Proof.
-Unfold 1 Add; Auto with sets.
-Qed.
-Hints Resolve Empty_set_zero'.
-
-Lemma less_than_empty :
-  (X: (Ensemble U)) (Included U X (Empty_set U)) -> X == (Empty_set U).
-Proof.
-Auto with sets.
-Qed.
-Hints Resolve less_than_empty.
-
-Theorem Union_commutative :
-  (A,B: (Ensemble U)) (Union U A B) == (Union U B A).
-Proof.
-Auto with sets.
-Qed.
-
-Theorem Union_associative :
-  (A, B, C: (Ensemble U))
-  (Union U (Union U A B) C) == (Union U A (Union U B C)).
-Proof.
-Auto 9 with sets.
-Qed.
-Hints Resolve Union_associative.
-
-Theorem Union_idempotent : (A: (Ensemble U)) (Union U A A) == A.
-Proof.
-Auto 7 with sets.
-Qed.
-
-Lemma Union_absorbs :
-  (A, B: (Ensemble U)) (Included U B A) -> (Union U A B) == A.
-Proof.
-Auto 7 with sets.
-Qed.
-
-Theorem Couple_as_union:
-  (x, y: U) (Union U (Singleton U x) (Singleton U y)) == (Couple U x y).
-Proof.
-Intros x y; Apply Extensionality_Ensembles; Split; Red.
-Intros x0 H'; Elim H'; (Intros x1 H'0; Elim H'0; Auto with sets).
-Intros x0 H'; Elim H'; Auto with sets.
-Qed.
-
-Theorem Triple_as_union :
-  (x, y, z: U)
-  (Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z)) ==
-  (Triple U x y z).
-Proof.
-Intros x y z; Apply Extensionality_Ensembles; Split; Red.
-Intros x0 H'; Elim H'.
-Intros x1 H'0; Elim H'0; (Intros x2 H'1; Elim H'1; Auto with sets).
-Intros x1 H'0; Elim H'0; Auto with sets.
-Intros x0 H'; Elim H'; Auto with sets.
-Qed.
-
-Theorem Triple_as_Couple : (x, y: U) (Couple U x y) == (Triple U x x y).
-Proof.
-Intros x y.
-Rewrite <- (Couple_as_union x y).
-Rewrite <- (Union_idempotent (Singleton U x)).
-Apply Triple_as_union.
-Qed.
-
-Theorem Triple_as_Couple_Singleton :
-  (x, y, z: U) (Triple U x y z) == (Union U (Couple U x y) (Singleton U z)).
-Proof.
-Intros x y z.
-Rewrite <- (Triple_as_union x y z).
-Rewrite <- (Couple_as_union x y); Auto with sets.
-Qed.
-
-Theorem Intersection_commutative :
-  (A,B: (Ensemble U)) (Intersection U A B) == (Intersection U B A).
-Proof.
-Intros A B.
-Apply Extensionality_Ensembles.
-Split; Red; Intros x H'; Elim H'; Auto with sets.
-Qed.
-
-Theorem Distributivity :
-  (A, B, C: (Ensemble U))
-     (Intersection U A (Union U B C)) ==
-     (Union U (Intersection U A B) (Intersection U A C)).
-Proof.
-Intros A B C.
-Apply Extensionality_Ensembles.
-Split; Red; Intros x H'.
-Elim H'.
-Intros x0 H'0 H'1; Generalize H'0.
-Elim H'1; Auto with sets.
-Elim H'; Intros x0 H'0; Elim H'0; Auto with sets.
-Qed.
-
-Theorem Distributivity' :
-  (A, B, C: (Ensemble U))
-     (Union U A (Intersection U B C)) ==
-     (Intersection U (Union U A B) (Union U A C)).
-Proof.
-Intros A B C.
-Apply Extensionality_Ensembles.
-Split; Red; Intros x H'.
-Elim H'; Auto with sets.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Elim H'.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intros x1 H'1 H'2; Try Exact H'2.
-Generalize H'1.
-Elim H'2; Auto with sets.
-Qed.
-
-Theorem Union_add :
-  (A, B: (Ensemble U)) (x: U)
-    (Add U (Union U A B) x) == (Union U A (Add U B x)).
-Proof.
-Unfold Add; Auto with sets.
-Qed.
-Hints Resolve Union_add.
-
-Theorem Non_disjoint_union :
-  (X: (Ensemble U)) (x: U) (In U X x) -> (Add U X x) == X.
-Intros X x H'; Unfold Add.
-Apply Extensionality_Ensembles; Red.
-Split; Red; Auto with sets.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intros t H'1; Elim H'1; Auto with sets.
-Qed.
-
-Theorem Non_disjoint_union' :
-  (X: (Ensemble U)) (x: U) ~ (In U X x) -> (Subtract U X x) == X.
-Proof.
-Intros X x H'; Unfold Subtract.
-Apply Extensionality_Ensembles.
-Split; Red; Auto with sets.
-Intros x0 H'0; Elim H'0; Auto with sets.
-Intros x0 H'0; Apply Setminus_intro; Auto with sets.
-Red; Intro H'1; Elim H'1.
-LApply (Singleton_inv U x x0); Auto with sets.
-Intro H'4; Apply H'; Rewrite H'4; Auto with sets.
-Qed.
-
-Lemma singlx : (x, y: U) (In U (Add U (Empty_set U) x) y) -> x == y.
-Proof.
-Intro x; Rewrite (Empty_set_zero' x); Auto with sets.
-Qed.
-Hints Resolve singlx.
-
-Lemma incl_add :
-  (A, B: (Ensemble U)) (x: U) (Included U A B) ->
-   (Included U (Add U A x) (Add U B x)).
-Proof.
-Intros A B x H'; Red; Auto with sets.
-Intros x0 H'0.
-LApply (Add_inv U A x x0); Auto with sets.
-Intro H'1; Elim H'1;
- [Intro H'2; Clear H'1 | Intro H'2; Rewrite <- H'2; Clear H'1]; Auto with sets.
-Qed.
-Hints Resolve incl_add.
-
-Lemma incl_add_x :
-  (A, B: (Ensemble U))
-  (x: U) ~ (In U A x) -> (Included U (Add U A x) (Add U B x)) ->
-   (Included U A B).
-Proof.
-Unfold Included.
-Intros A B x H' H'0 x0 H'1.
-LApply (H'0 x0); Auto with sets.
-Intro H'2; LApply (Add_inv U B x x0); Auto with sets.
-Intro H'3; Elim H'3;
- [Intro H'4; Try Exact H'4; Clear H'3 | Intro H'4; Clear H'3].
-Absurd (In U A x0); Auto with sets.
-Rewrite <- H'4; Auto with sets.
-Qed.
-
-Lemma Add_commutative :
-  (A: (Ensemble U)) (x, y: U) (Add U (Add U A x) y) == (Add U (Add U A y) x).
-Proof.
-Intros A x y.
-Unfold Add.
-Rewrite (Union_associative A (Singleton U x) (Singleton U y)).
-Rewrite (Union_commutative (Singleton U x) (Singleton U y)).
-Rewrite <- (Union_associative A (Singleton U y) (Singleton U x)); Auto with sets.
-Qed.
-
-Lemma Add_commutative' :
-  (A: (Ensemble U)) (x, y, z: U)
-    (Add U (Add U (Add U A x) y) z) == (Add U (Add U (Add U A z) x) y).
-Proof.
-Intros A x y z.
-Rewrite (Add_commutative (Add U A x) y z).
-Rewrite (Add_commutative A x z); Auto with sets.
-Qed.
-
-Lemma Add_distributes :
-  (A, B: (Ensemble U)) (x, y: U) (Included U B A) ->
-  (Add U (Add U A x) y) == (Union U (Add U A x) (Add U B y)).
-Proof.
-Intros A B x y H'; Try Assumption.
-Rewrite <- (Union_add (Add U A x) B y).
-Unfold 4 Add.
-Rewrite (Union_commutative A (Singleton U x)).
-Rewrite Union_associative.
-Rewrite (Union_absorbs A B H').
-Rewrite (Union_commutative (Singleton U x) A).
-Auto with sets.
-Qed.
-
-Lemma setcover_intro :
-  (U: Type)
-  (A: (Ensemble U))
-  (x, y: (Ensemble U))
-  (Strict_Included U x y) ->
-  ~ (EXT z | (Strict_Included U x z) 
-              /\ (Strict_Included U z y)) ->
-   (covers (Ensemble U) (Power_set_PO U A) y x).
-Proof.
-Intros; Apply Definition_of_covers; Auto with sets.
-Qed.
-Hints Resolve setcover_intro.
-
-End Sets_as_an_algebra.
-
-Hints Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add
-	singlx incl_add : sets v62.
-
-
diff --git a/theories7/Sets/Relations_1.v b/theories7/Sets/Relations_1.v
deleted file mode 100755
index d4ed823b..00000000
--- a/theories7/Sets/Relations_1.v
+++ /dev/null
@@ -1,67 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Relations_1.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
-
-Section Relations_1.
-   Variable U: Type.
-   
-   Definition Relation :=  U -> U -> Prop.
-   Variable R: Relation.
-   
-   Definition Reflexive : Prop :=  (x: U) (R x x).
-   
-   Definition Transitive : Prop :=  (x,y,z: U) (R x y) -> (R y z) -> (R x z).
-   
-   Definition Symmetric : Prop :=  (x,y: U) (R x y) -> (R y x).
-   
-   Definition Antisymmetric : Prop :=
-      (x: U) (y: U) (R x y) -> (R y x) -> x == y.
-   
-   Definition contains : Relation -> Relation -> Prop :=
-      [R,R': Relation] (x: U) (y: U) (R' x y) -> (R x y).
-   
-   Definition same_relation : Relation -> Relation -> Prop :=
-      [R,R': Relation] (contains R R') /\ (contains R' R).
-   
-   Inductive Preorder : Prop :=
-         Definition_of_preorder: Reflexive -> Transitive -> Preorder.
-   
-   Inductive Order : Prop :=
-         Definition_of_order: Reflexive -> Transitive -> Antisymmetric -> Order.
-   
-   Inductive Equivalence : Prop :=
-         Definition_of_equivalence:
-           Reflexive -> Transitive -> Symmetric -> Equivalence.
-   
-   Inductive PER : Prop :=
-         Definition_of_PER: Symmetric -> Transitive -> PER.
-   
-End Relations_1.
-Hints Unfold Reflexive Transitive Antisymmetric Symmetric contains 
-	same_relation : sets v62.
-Hints Resolve Definition_of_preorder Definition_of_order 
-	Definition_of_equivalence Definition_of_PER : sets v62.
diff --git a/theories7/Sets/Relations_1_facts.v b/theories7/Sets/Relations_1_facts.v
deleted file mode 100755
index cf73ce8b..00000000
--- a/theories7/Sets/Relations_1_facts.v
+++ /dev/null
@@ -1,109 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Relations_1_facts.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
-
-Require Export Relations_1.
-
-Definition Complement : (U: Type) (Relation U) -> (Relation U) :=
-   [U: Type] [R: (Relation U)] [x,y: U] ~ (R x y).
-
-Theorem Rsym_imp_notRsym: (U: Type) (R: (Relation U)) (Symmetric U R) ->
-            (Symmetric U (Complement U R)).
-Proof.
-Unfold Symmetric Complement.
-Intros U R H' x y H'0; Red; Intro H'1; Apply H'0; Auto with sets.
-Qed.
-
-Theorem Equiv_from_preorder :
-  (U: Type) (R: (Relation U)) (Preorder U R) ->
-            (Equivalence U [x,y: U] (R x y) /\ (R y x)).
-Proof.
-Intros U R H'; Elim H'; Intros H'0 H'1.
-Apply Definition_of_equivalence.
-Red in H'0; Auto 10 with sets.
-2:Red; Intros x y h; Elim h; Intros H'3 H'4; Auto 10 with sets.
-Red in H'1; Red; Auto 10 with sets.
-Intros x y z h; Elim h; Intros H'3 H'4; Clear h.
-Intro h; Elim h; Intros H'5 H'6; Clear h.
-Split; Apply H'1 with y; Auto 10 with sets.
-Qed.
-Hints Resolve Equiv_from_preorder.
-
-Theorem Equiv_from_order :
-  (U: Type) (R: (Relation U)) (Order U R) ->
-            (Equivalence U [x,y: U] (R x y) /\ (R y x)).
-Proof.
-Intros U R H'; Elim H'; Auto 10 with sets.
-Qed.
-Hints Resolve Equiv_from_order.
-
-Theorem contains_is_preorder :
-  (U: Type) (Preorder (Relation U) (contains U)).
-Proof.
-Auto 10 with sets.
-Qed.
-Hints Resolve contains_is_preorder.
-
-Theorem same_relation_is_equivalence :
-  (U: Type) (Equivalence (Relation U) (same_relation U)).
-Proof.
-Unfold 1 same_relation; Auto 10 with sets.
-Qed.
-Hints Resolve same_relation_is_equivalence.
-
-Theorem cong_reflexive_same_relation:
-  (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Reflexive U R) ->
-  (Reflexive U R').
-Proof.
-Unfold same_relation; Intuition.
-Qed.
-
-Theorem cong_symmetric_same_relation:
-  (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Symmetric U R) ->
-  (Symmetric U R').
-Proof.
-  Compute;Intros;Elim H;Intros;Clear H;Apply (H3 y x (H0 x y (H2 x y H1))).
-(*Intuition.*)
-Qed.
-
-Theorem cong_antisymmetric_same_relation:
-  (U:Type) (R, R':(Relation U)) (same_relation U R R') ->
-           (Antisymmetric U R) -> (Antisymmetric U R').
-Proof.
-  Compute;Intros;Elim H;Intros;Clear H;Apply (H0 x y (H3 x y H1) (H3 y x H2)).
-(*Intuition.*)
-Qed.
-
-Theorem cong_transitive_same_relation:
-  (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Transitive U R) ->
-  (Transitive U R').
-Proof.
-Intros U R R' H' H'0; Red.
-Elim H'.
-Intros H'1 H'2 x y z H'3 H'4; Apply H'2.
-Apply H'0 with y; Auto with sets.
-Qed.
diff --git a/theories7/Sets/Relations_2.v b/theories7/Sets/Relations_2.v
deleted file mode 100755
index 92a1236e..00000000
--- a/theories7/Sets/Relations_2.v
+++ /dev/null
@@ -1,56 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Relations_2.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
-
-Require Export Relations_1.
-
-Section Relations_2.
-Variable U: Type.
-Variable R: (Relation U).
-
-Inductive Rstar : (Relation U) :=
-     Rstar_0: (x: U) (Rstar x x)
-   | Rstar_n: (x, y, z: U) (R x y) -> (Rstar y z) -> (Rstar x z).
-
-Inductive Rstar1 : (Relation U) :=
-     Rstar1_0: (x: U) (Rstar1 x x)
-   | Rstar1_1: (x: U) (y: U) (R x y) -> (Rstar1 x y)
-   | Rstar1_n: (x, y, z: U) (Rstar1 x y) -> (Rstar1 y z) -> (Rstar1 x z).
-
-Inductive Rplus : (Relation U) :=
-     Rplus_0: (x, y: U) (R x y) -> (Rplus x y)
-   | Rplus_n: (x, y, z: U) (R x y) -> (Rplus y z) -> (Rplus x z).
-
-Definition Strongly_confluent : Prop :=
-   (x, a, b: U) (R x a) -> (R x b) -> (exT U [z: U] (R a z) /\ (R b z)).
-
-End Relations_2.
-
-Hints Resolve Rstar_0 : sets v62.
-Hints Resolve Rstar1_0 : sets v62.
-Hints Resolve Rstar1_1 : sets v62.
-Hints Resolve Rplus_0 : sets v62.
diff --git a/theories7/Sets/Relations_2_facts.v b/theories7/Sets/Relations_2_facts.v
deleted file mode 100755
index b82438eb..00000000
--- a/theories7/Sets/Relations_2_facts.v
+++ /dev/null
@@ -1,151 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Relations_2_facts.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
-
-Require Export Relations_1.
-Require Export Relations_1_facts.
-Require Export Relations_2.
-
-Theorem Rstar_reflexive : 
-  (U: Type) (R: (Relation U)) (Reflexive U (Rstar U R)).
-Proof.
-Auto with sets.
-Qed.
-
-Theorem Rplus_contains_R :
-  (U: Type) (R: (Relation U)) (contains U (Rplus U R) R).
-Proof.
-Auto with sets.
-Qed.
-
-Theorem Rstar_contains_R :
-  (U: Type) (R: (Relation U)) (contains U (Rstar U R) R).
-Proof.
-Intros U R; Red; Intros x y H'; Apply Rstar_n with y; Auto with sets.
-Qed.
-
-Theorem Rstar_contains_Rplus :
-  (U: Type) (R: (Relation U)) (contains U (Rstar U R) (Rplus U R)).
-Proof.
-Intros U R; Red.
-Intros x y H'; Elim H'.
-Generalize Rstar_contains_R; Intro T; Red in T; Auto with sets.
-Intros x0 y0 z H'0 H'1 H'2; Apply Rstar_n with y0; Auto with sets.
-Qed.
-
-Theorem Rstar_transitive :
-  (U: Type) (R: (Relation U)) (Transitive U (Rstar U R)).
-Proof.
-Intros U R; Red.
-Intros x y z H'; Elim H'; Auto with sets.
-Intros x0 y0 z0 H'0 H'1 H'2 H'3; Apply Rstar_n with y0; Auto with sets.
-Qed.
-
-Theorem Rstar_cases :
-  (U: Type) (R: (Relation U)) (x, y: U) (Rstar U R x y) ->
-    x == y \/ (EXT u | (R x u) /\ (Rstar U R u y)).
-Proof.
-Intros U R x y H'; Elim H'; Auto with sets.
-Intros x0 y0 z H'0 H'1 H'2; Right; Exists y0; Auto with sets.
-Qed.
-
-Theorem Rstar_equiv_Rstar1 :
-  (U: Type) (R: (Relation U)) (same_relation U (Rstar U R) (Rstar1 U R)).
-Proof.
-Generalize Rstar_contains_R; Intro T; Red in T.
-Intros U R; Unfold same_relation contains.
-Split; Intros x y H'; Elim H'; Auto with sets.
-Generalize Rstar_transitive; Intro T1; Red in T1.
-Intros x0 y0 z H'0 H'1 H'2 H'3; Apply T1 with y0; Auto with sets.
-Intros x0 y0 z H'0 H'1 H'2; Apply Rstar1_n with y0; Auto with sets.
-Qed.
-
-Theorem Rsym_imp_Rstarsym :
-  (U: Type) (R: (Relation U)) (Symmetric U R) -> (Symmetric U (Rstar U R)).
-Proof.
-Intros U R H'; Red.
-Intros x y H'0; Elim H'0; Auto with sets.
-Intros x0 y0 z H'1 H'2 H'3.
-Generalize Rstar_transitive; Intro T1; Red in T1.
-Apply T1 with y0; Auto with sets.
-Apply Rstar_n with x0; Auto with sets.
-Qed.
-
-Theorem Sstar_contains_Rstar :
-  (U: Type) (R, S: (Relation U)) (contains U (Rstar U S) R) ->
-   (contains U (Rstar U S) (Rstar U R)).
-Proof.
-Unfold contains.
-Intros U R S H' x y H'0; Elim H'0; Auto with sets.
-Generalize Rstar_transitive; Intro T1; Red in T1.
-Intros x0 y0 z H'1 H'2 H'3; Apply T1 with y0; Auto with sets.
-Qed.
-
-Theorem star_monotone :
-  (U: Type) (R, S: (Relation U)) (contains U S R) ->
-   (contains U (Rstar U S) (Rstar U R)).
-Proof.
-Intros U R S H'.
-Apply Sstar_contains_Rstar; Auto with sets.
-Generalize (Rstar_contains_R U S); Auto with sets.
-Qed.
-
-Theorem RstarRplus_RRstar :
-  (U: Type) (R: (Relation U)) (x, y, z: U) 
-    (Rstar U R x y) -> (Rplus U R y z) ->
-    (EXT u | (R x u) /\ (Rstar U R u z)).
-Proof.
-Generalize Rstar_contains_Rplus; Intro T; Red in T.
-Generalize Rstar_transitive; Intro T1; Red in T1.
-Intros U R x y z H'; Elim H'.
-Intros x0 H'0; Elim H'0.
-Intros x1 y0 H'1; Exists y0; Auto with sets.
-Intros x1 y0 z0 H'1 H'2 H'3; Exists y0; Auto with sets.
-Intros x0 y0 z0 H'0 H'1 H'2 H'3; Exists y0.
-Split; [Try Assumption | Idtac].
-Apply T1 with z0; Auto with sets.
-Qed.
-
-Theorem Lemma1 : 
-  (U: Type) (R: (Relation U)) (Strongly_confluent U R) ->
-   (x, b: U) (Rstar U R x b) ->
-    (a: U) (R x a) -> (EXT z | (Rstar U R a z) /\ (R b z)).
-Proof.
-Intros U R H' x b H'0; Elim H'0.
-Intros x0 a H'1; Exists a; Auto with sets.
-Intros x0 y z H'1 H'2 H'3 a H'4.
-Red in H'.
-Specialize 3 H' with x := x0 a := a b := y; Intro H'7; LApply H'7;
- [Intro H'8; LApply H'8;
-   [Intro H'9; Try Exact H'9; Clear H'8 H'7 | Clear H'8 H'7] | Clear H'7]; Auto with sets.
-Elim H'9.
-Intros t H'5; Elim H'5; Intros H'6 H'7; Try Exact H'6; Clear H'5.
-Elim (H'3 t); Auto with sets.
-Intros z1 H'5; Elim H'5; Intros H'8 H'10; Try Exact H'8; Clear H'5.
-Exists z1; Split; [Idtac | Assumption].
-Apply Rstar_n with t; Auto with sets.
-Qed.
diff --git a/theories7/Sets/Relations_3.v b/theories7/Sets/Relations_3.v
deleted file mode 100755
index 092fc534..00000000
--- a/theories7/Sets/Relations_3.v
+++ /dev/null
@@ -1,63 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Relations_3.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
-
-Require Export Relations_1.
-Require Export Relations_2.
-
-Section Relations_3.
-   Variable U: Type.
-   Variable R: (Relation U).
-   
-   Definition coherent : U -> U -> Prop :=
-      [x,y: U]  (EXT z | (Rstar U R x z) /\ (Rstar U R y z)).
-   
-   Definition locally_confluent : U -> Prop :=
-      [x: U] (y,z: U) (R x y) -> (R x z) -> (coherent y z).
-   
-   Definition Locally_confluent : Prop :=  (x: U) (locally_confluent x).
-   
-   Definition confluent : U -> Prop :=
-      [x: U] (y,z: U) (Rstar U R x y) -> (Rstar U R x z) -> (coherent y z).
-   
-   Definition Confluent : Prop :=  (x: U) (confluent x).
-   
-   Inductive  noetherian : U -> Prop :=
-         definition_of_noetherian:
-           (x: U) ((y: U) (R x y) -> (noetherian y)) -> (noetherian x).
-   
-   Definition Noetherian : Prop :=  (x: U) (noetherian x).
-   
-End Relations_3.
-Hints Unfold  coherent : sets v62.
-Hints Unfold  locally_confluent : sets v62.
-Hints Unfold  confluent : sets v62.
-Hints Unfold  Confluent : sets v62.
-Hints Resolve definition_of_noetherian : sets v62.
-Hints Unfold  Noetherian : sets v62.
-
-
diff --git a/theories7/Sets/Relations_3_facts.v b/theories7/Sets/Relations_3_facts.v
deleted file mode 100755
index 822f550a..00000000
--- a/theories7/Sets/Relations_3_facts.v
+++ /dev/null
@@ -1,157 +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        *)
-(************************************************************************)
-(****************************************************************************)
-(*                                                                          *)
-(*                         Naive Set Theory in Coq                          *)
-(*                                                                          *)
-(*                     INRIA                        INRIA                   *)
-(*              Rocquencourt                        Sophia-Antipolis        *)
-(*                                                                          *)
-(*                                 Coq V6.1                                 *)
-(*									    *)
-(*			         Gilles Kahn 				    *)
-(*				 Gerard Huet				    *)
-(*									    *)
-(*									    *)
-(*                                                                          *)
-(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
-(* to the Newton Institute for providing an exceptional work environment    *)
-(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
-(****************************************************************************)
-
-(*i $Id: Relations_3_facts.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
-
-Require Export Relations_1.
-Require Export Relations_1_facts.
-Require Export Relations_2.
-Require Export Relations_2_facts.
-Require Export Relations_3.
-
-Theorem Rstar_imp_coherent :
-  (U: Type) (R: (Relation U)) (x: U) (y: U) (Rstar U R x y) ->
-   (coherent U R x y).
-Proof.
-Intros U R x y H'; Red.
-Exists y; Auto with sets.
-Qed.
-Hints Resolve Rstar_imp_coherent.
-
-Theorem coherent_symmetric :
-  (U: Type) (R: (Relation U)) (Symmetric U (coherent U R)).
-Proof.
-Unfold 1 coherent.
-Intros U R; Red.
-Intros x y H'; Elim H'.
-Intros z H'0; Exists z; Tauto.
-Qed.
-
-Theorem Strong_confluence :
-  (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> (Confluent U R).
-Proof.
-Intros U R H'; Red.
-Intro x; Red; Intros a b H'0.
-Unfold 1 coherent.
-Generalize b; Clear b.
-Elim H'0; Clear H'0.
-Intros x0 b H'1; Exists b; Auto with sets.
-Intros x0 y z H'1 H'2 H'3 b H'4.
-Generalize (Lemma1 U R); Intro h; LApply h;
-  [Intro H'0; Generalize (H'0 x0 b); Intro h0; LApply h0;
-    [Intro H'5; Generalize (H'5 y); Intro h1; LApply h1;
-      [Intro h2; Elim h2; Intros z0 h3; Elim h3; Intros H'6 H'7;
-        Clear h h0 h1 h2 h3 | Clear h h0 h1] | Clear h h0] | Clear h]; Auto with sets.
-Generalize (H'3 z0); Intro h; LApply h;
-  [Intro h0; Elim h0; Intros z1 h1; Elim h1; Intros H'8 H'9; Clear h h0 h1 |
-    Clear h]; Auto with sets.
-Exists z1; Split; Auto with sets.
-Apply Rstar_n with z0; Auto with sets.
-Qed.
-
-Theorem Strong_confluence_direct :
-  (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> (Confluent U R).
-Proof.
-Intros U R H'; Red.
-Intro x; Red; Intros a b H'0.
-Unfold 1 coherent.
-Generalize b; Clear b.
-Elim H'0; Clear H'0.
-Intros x0 b H'1; Exists b; Auto with sets.
-Intros x0 y z H'1 H'2 H'3 b H'4.
-Cut (exT U [t: U] (Rstar U R y t) /\ (R b t)).
-Intro h; Elim h; Intros t h0; Elim h0; Intros H'0 H'5; Clear h h0.
-Generalize (H'3 t); Intro h; LApply h;
-  [Intro h0; Elim h0; Intros z0 h1; Elim h1; Intros H'6 H'7; Clear h h0 h1 |
-    Clear h]; Auto with sets.
-Exists z0; Split; [Assumption | Idtac].
-Apply Rstar_n with t; Auto with sets.
-Generalize H'1; Generalize y; Clear H'1.
-Elim H'4.
-Intros x1 y0 H'0; Exists y0; Auto with sets.
-Intros x1 y0 z0 H'0 H'1 H'5 y1 H'6.
-Red in H'.
-Generalize (H' x1 y0 y1); Intro h; LApply h;
-  [Intro H'7; LApply H'7;
-    [Intro h0; Elim h0; Intros z1 h1; Elim h1; Intros H'8 H'9; Clear h H'7 h0 h1 |
-      Clear h] | Clear h]; Auto with sets.
-Generalize (H'5 z1); Intro h; LApply h;
-  [Intro h0; Elim h0; Intros t h1; Elim h1; Intros H'7 H'10; Clear h h0 h1 |
-    Clear h]; Auto with sets.
-Exists t; Split; Auto with sets.
-Apply Rstar_n with z1; Auto with sets.
-Qed.
-
-Theorem Noetherian_contains_Noetherian :
-  (U: Type) (R, R': (Relation U)) (Noetherian U R) -> (contains U R R') ->
-   (Noetherian U R').
-Proof.
-Unfold 2 Noetherian.
-Intros U R R' H' H'0 x.
-Elim (H' x); Auto with sets.
-Qed.
-
-Theorem Newman :
-  (U: Type) (R: (Relation U)) (Noetherian U R) -> (Locally_confluent U R) ->
-   (Confluent U R).
-Proof.
-Intros U R H' H'0; Red; Intro x.
-Elim (H' x); Unfold confluent.
-Intros x0 H'1 H'2 y z H'3 H'4.
-Generalize (Rstar_cases U R x0 y); Intro h; LApply h;
-  [Intro h0; Elim h0;
-    [Clear h h0; Intro h1 |
-      Intro h1; Elim h1; Intros u h2; Elim h2; Intros H'5 H'6; Clear h h0 h1 h2] |
-    Clear h]; Auto with sets.
-Elim h1; Auto with sets.
-Generalize (Rstar_cases U R x0 z); Intro h; LApply h;
-  [Intro h0; Elim h0;
-    [Clear h h0; Intro h1 |
-      Intro h1; Elim h1; Intros v h2; Elim h2; Intros H'7 H'8; Clear h h0 h1 h2] |
-    Clear h]; Auto with sets.
-Elim h1; Generalize coherent_symmetric; Intro t; Red in t; Auto with sets.
-Unfold Locally_confluent locally_confluent coherent in H'0.
-Generalize (H'0 x0 u v); Intro h; LApply h;
-  [Intro H'9; LApply H'9;
-    [Intro h0; Elim h0; Intros t h1; Elim h1; Intros H'10 H'11;
-      Clear h H'9 h0 h1 | Clear h] | Clear h]; Auto with sets.
-Clear H'0.
-Unfold 1 coherent in H'2.
-Generalize (H'2 u); Intro h; LApply h;
-  [Intro H'0; Generalize (H'0 y t); Intro h0; LApply h0;
-    [Intro H'9; LApply H'9;
-      [Intro h1; Elim h1; Intros y1 h2; Elim h2; Intros H'12 H'13;
-        Clear h h0 H'9 h1 h2 | Clear h h0] | Clear h h0] | Clear h]; Auto with sets.
-Generalize Rstar_transitive; Intro T; Red in T.
-Generalize (H'2 v); Intro h; LApply h;
-  [Intro H'9; Generalize (H'9 y1 z); Intro h0; LApply h0;
-    [Intro H'14; LApply H'14;
-      [Intro h1; Elim h1; Intros z1 h2; Elim h2; Intros H'15 H'16;
-        Clear h h0 H'14 h1 h2 | Clear h h0] | Clear h h0] | Clear h]; Auto with sets.
-Red; (Exists z1; Split); Auto with sets.
-Apply T with y1; Auto with sets.
-Apply T with t; Auto with sets.
-Qed.
diff --git a/theories7/Sets/Uniset.v b/theories7/Sets/Uniset.v
deleted file mode 100644
index 33880214..00000000
--- a/theories7/Sets/Uniset.v
+++ /dev/null
@@ -1,212 +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: Uniset.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
-
-(** Sets as characteristic functions *)
-
-(* G. Huet 1-9-95 *)
-(* Updated Papageno 12/98 *)
-
-Require Bool.
-
-Set Implicit Arguments.
-
-Section defs.
-
-Variable A : Set.
-Variable eqA : A -> A -> Prop.
-Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
-
-Inductive uniset : Set := 
-      Charac : (A->bool) -> uniset.
-
-Definition charac : uniset -> A -> bool :=
-  [s:uniset][a:A]Case s of [f:A->bool](f a) end.
-
-Definition Emptyset := (Charac [a:A]false).
-
-Definition Fullset  := (Charac [a:A]true).
-
-Definition Singleton := [a:A](Charac [a':A]
-              Case (eqA_dec a a') of 
-                   [h:(eqA a a')]  true
-                   [h: ~(eqA a a')] false end).
-
-Definition In : uniset -> A -> Prop :=
-     [s:uniset][a:A](charac s a)=true.
-Hints Unfold In.
-
-(** uniset inclusion *)
-Definition incl := [s1,s2:uniset]
-    (a:A)(leb (charac s1 a) (charac s2 a)).
-Hints Unfold incl.
-
-(** uniset equality *)
-Definition seq := [s1,s2:uniset]
-    (a:A)(charac s1 a) = (charac s2 a).
-Hints Unfold seq.
-
-Lemma leb_refl : (b:bool)(leb b b).
-Proof.
-NewDestruct b; Simpl; Auto.
-Qed.
-Hints Resolve leb_refl.
-
-Lemma incl_left : (s1,s2:uniset)(seq s1 s2)->(incl s1 s2).
-Proof.
-Unfold incl; Intros s1 s2 E a; Elim (E a); Auto.
-Qed.
-
-Lemma incl_right : (s1,s2:uniset)(seq s1 s2)->(incl s2 s1).
-Proof.
-Unfold incl; Intros s1 s2 E a; Elim (E a); Auto.
-Qed.
-
-Lemma seq_refl : (x:uniset)(seq x x).
-Proof.
-NewDestruct x; Unfold seq; Auto.
-Qed.
-Hints Resolve seq_refl.
-
-Lemma seq_trans : (x,y,z:uniset)(seq x y)->(seq y z)->(seq x z).
-Proof.
-Unfold seq.
-NewDestruct x; NewDestruct y; NewDestruct z; Simpl; Intros.
-Rewrite H; Auto.
-Qed.
-
-Lemma seq_sym : (x,y:uniset)(seq x y)->(seq y x).
-Proof.
-Unfold seq.
-NewDestruct x; NewDestruct y; Simpl; Auto.
-Qed.
-
-(** uniset union *)
-Definition union := [m1,m2:uniset]
-    (Charac [a:A](orb (charac m1 a)(charac m2 a))).
-
-Lemma union_empty_left :
-     (x:uniset)(seq x (union Emptyset x)).  
-Proof.  
-Unfold seq; Unfold union; Simpl; Auto.  
-Qed. 
-Hints Resolve union_empty_left.
-
-Lemma union_empty_right :
-     (x:uniset)(seq x (union x Emptyset)).
-Proof.
-Unfold seq; Unfold union; Simpl.
-Intros x a; Rewrite (orb_b_false (charac x a)); Auto.
-Qed.
-Hints Resolve union_empty_right.
-
-Lemma union_comm : (x,y:uniset)(seq (union x y) (union y x)).
-Proof.
-Unfold seq; Unfold charac; Unfold union.
-NewDestruct x; NewDestruct y; Auto with bool.
-Qed.
-Hints Resolve union_comm.
-
-Lemma union_ass : 
-      (x,y,z:uniset)(seq (union (union x y) z) (union x (union y z))).
-Proof.
-Unfold seq; Unfold union; Unfold charac.
-NewDestruct x; NewDestruct y; NewDestruct z; Auto with bool.
-Qed.
-Hints Resolve union_ass.
-
-Lemma seq_left :  (x,y,z:uniset)(seq x y)->(seq (union x z) (union y z)).
-Proof.
-Unfold seq; Unfold union; Unfold charac.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Elim H; Auto.
-Qed.
-Hints Resolve seq_left.
-
-Lemma seq_right : (x,y,z:uniset)(seq x y)->(seq (union z x) (union z y)).
-Proof.
-Unfold seq; Unfold union; Unfold charac.
-NewDestruct x; NewDestruct y; NewDestruct z.
-Intros; Elim H; Auto.
-Qed.
-Hints Resolve seq_right.
-
-
-(** All the proofs that follow duplicate [Multiset_of_A] *)
-
-(** Here we should make uniset an abstract datatype, by hiding [Charac],
-    [union], [charac]; all further properties are proved abstractly *)
-
-Require Permut.
-
-Lemma union_rotate :
-   (x,y,z:uniset)(seq (union x (union y z)) (union z (union x y))).
-Proof.
-Intros; Apply (op_rotate uniset union seq); Auto.
-Exact seq_trans.
-Qed.
-
-Lemma seq_congr : (x,y,z,t:uniset)(seq x y)->(seq z t)->
-                  (seq (union x z) (union y t)).
-Proof.
-Intros; Apply (cong_congr uniset union seq); Auto.
-Exact seq_trans.
-Qed.
-
-Lemma union_perm_left :
-   (x,y,z:uniset)(seq (union x (union y z)) (union y (union x z))).
-Proof.
-Intros; Apply (perm_left uniset union seq); Auto.
-Exact seq_trans.
-Qed.
-
-Lemma uniset_twist1 : (x,y,z,t:uniset)
-   (seq (union x (union (union y z) t)) (union (union y (union x t)) z)).
-Proof.
-Intros; Apply (twist uniset union seq); Auto.
-Exact seq_trans.
-Qed.
-
-Lemma uniset_twist2 : (x,y,z,t:uniset)
-   (seq (union x (union (union y z) t)) (union (union y (union x z)) t)).
-Proof.
-Intros; Apply seq_trans with (union (union x (union y z)) t).
-Apply seq_sym; Apply union_ass.
-Apply seq_left; Apply union_perm_left.
-Qed.
-
-(** specific for treesort *)
-
-Lemma treesort_twist1 : (x,y,z,t,u:uniset) (seq u (union y z)) ->
-   (seq (union x (union u t)) (union (union y (union x t)) z)).
-Proof.
-Intros; Apply seq_trans with (union x (union (union y z) t)).
-Apply seq_right; Apply seq_left; Trivial.
-Apply uniset_twist1.
-Qed.
-
-Lemma treesort_twist2 : (x,y,z,t,u:uniset) (seq u (union y z)) ->
-   (seq (union x (union u t)) (union (union y (union x z)) t)).
-Proof.
-Intros; Apply seq_trans with (union x (union (union y z) t)).
-Apply seq_right; Apply seq_left; Trivial.
-Apply uniset_twist2.
-Qed.
-
-
-(*i theory of minter to do similarly 
-Require Min.
-(* uniset intersection *)
-Definition minter := [m1,m2:uniset]
-    (Charac [a:A](andb (charac m1 a)(charac m2 a))).
-i*)
-
-End defs.
-
-Unset Implicit Arguments.
diff --git a/theories7/Sorting/Heap.v b/theories7/Sorting/Heap.v
deleted file mode 100644
index 63e7f324..00000000
--- a/theories7/Sorting/Heap.v
+++ /dev/null
@@ -1,223 +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: Heap.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
-
-(** A development of Treesort on Heap trees *)
-
-(* G. Huet 1-9-95 uses Multiset *)
-
-Require PolyList.
-Require Multiset.
-Require Permutation.
-Require Relations.
-Require Sorting.
-
-
-Section defs.
-
-Variable A : Set.
-Variable leA : (relation A).
-Variable eqA : (relation A).
-
-Local gtA := [x,y:A]~(leA x y).
-
-Hypothesis leA_dec : (x,y:A){(leA x y)}+{(leA y x)}.
-Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
-Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
-Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
-Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
-
-Hints Resolve leA_refl.
-Hints Immediate eqA_dec leA_dec leA_antisym.
-
-Local emptyBag := (EmptyBag A).
-Local singletonBag := (SingletonBag eqA_dec).
-
-Inductive Tree : Set :=
-      Tree_Leaf : Tree
-    | Tree_Node : A -> Tree -> Tree -> Tree.
-
-(** [a] is lower than a Tree [T] if [T] is a Leaf
-    or [T] is a Node holding [b>a] *)
-
-Definition leA_Tree := [a:A; t:Tree]
- Cases t of 
-   Tree_Leaf           => True
- | (Tree_Node b T1 T2) => (leA a b)
- end.
-
-Lemma leA_Tree_Leaf : (a:A)(leA_Tree a Tree_Leaf).
-Proof.
-Simpl; Auto with datatypes.
-Qed.
-
-Lemma leA_Tree_Node : (a,b:A)(G,D:Tree)(leA a b) ->
-                        (leA_Tree a (Tree_Node b G D)).
-Proof.
-Simpl; Auto with datatypes.
-Qed.
-
-Hints Resolve leA_Tree_Leaf leA_Tree_Node.
-
-
-(** The heap property *)
-
-Inductive is_heap : Tree -> Prop :=
-      nil_is_heap : (is_heap Tree_Leaf)
-    | node_is_heap : (a:A)(T1,T2:Tree)
-                     (leA_Tree a T1) ->
-                     (leA_Tree a T2) ->
-                     (is_heap T1) -> (is_heap T2) ->
-                     (is_heap (Tree_Node a T1 T2)).
-
-Hint constr_is_heap := Constructors is_heap.
-
-Lemma invert_heap : (a:A)(T1,T2:Tree)(is_heap (Tree_Node a T1 T2))->
-  (leA_Tree a T1) /\ (leA_Tree a T2) /\
-  (is_heap T1) /\ (is_heap T2).
-Proof.
-Intros; Inversion H; Auto with datatypes.
-Qed.
-
-(* This lemma ought to be generated automatically by the Inversion tools *)
-Lemma is_heap_rec : (P:Tree->Set)
-        (P Tree_Leaf)->
-         ((a:A)
-           (T1:Tree)
-            (T2:Tree)
-             (leA_Tree a T1)->
-              (leA_Tree a T2)->
-               (is_heap T1)->
-                (P T1)->(is_heap T2)->(P T2)->(P (Tree_Node a T1 T2)))
-         -> (T:Tree)(is_heap T) -> (P T).
-Proof.
-Induction T; Auto with datatypes.
-Intros a G PG D PD PN. 
-Elim (invert_heap a G D); Auto with datatypes.
-Intros H1 H2; Elim H2; Intros H3 H4; Elim H4; Intros.
-Apply H0; Auto with datatypes.
-Qed.
-
-Lemma low_trans : 
-  (T:Tree)(a,b:A)(leA a b) -> (leA_Tree b T) -> (leA_Tree a T).
-Proof.
-Induction T; Auto with datatypes.
-Intros; Simpl; Apply leA_trans with b; Auto with datatypes.
-Qed.
-
-(** contents of a tree as a multiset *)
-
-(** Nota Bene : In what follows the definition of SingletonBag
-    in not used. Actually, we could just take as postulate:
-    [Parameter SingletonBag : A->multiset].  *)
-
-Fixpoint  contents [t:Tree] : (multiset A) :=
- Cases t of
-   Tree_Leaf           => emptyBag
- | (Tree_Node a t1 t2) => (munion (contents t1) 
-                          (munion (contents t2) (singletonBag a)))
-end.
-
-
-(** equivalence of two trees is equality of corresponding multisets *)
-
-Definition equiv_Tree := [t1,t2:Tree](meq (contents t1) (contents t2)).
-
-
-(** specification of heap insertion *)
-
-Inductive insert_spec [a:A; T:Tree] : Set :=
-   insert_exist : (T1:Tree)(is_heap T1) ->
-                  (meq (contents T1) (munion (contents T) (singletonBag a))) ->
-                  ((b:A)(leA b a)->(leA_Tree b T)->(leA_Tree b T1)) ->
-                  (insert_spec a T).
-
-
-Lemma insert : (T:Tree)(is_heap T) -> (a:A)(insert_spec a T).
-Proof.
-Induction 1; Intros.
-Apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf); Auto with datatypes.
-Simpl; Unfold meq munion; Auto with datatypes.
-Elim (leA_dec a a0); Intros.
-Elim (H3 a0); Intros.
-Apply insert_exist with (Tree_Node a T2 T0); Auto with datatypes.
-Simpl; Apply treesort_twist1; Trivial with datatypes. 
-Elim (H3 a); Intros T3 HeapT3 ConT3 LeA.
-Apply insert_exist with (Tree_Node a0 T2 T3); Auto with datatypes.
-Apply node_is_heap; Auto with datatypes.
-Apply low_trans with a; Auto with datatypes.
-Apply LeA; Auto with datatypes.
-Apply low_trans with a; Auto with datatypes.
-Simpl; Apply treesort_twist2; Trivial with datatypes. 
-Qed.
-
-(** building a heap from a list *)
-
-Inductive build_heap [l:(list A)] : Set :=
-   heap_exist : (T:Tree)(is_heap T) ->
-                (meq (list_contents eqA_dec l)(contents T)) ->
-                (build_heap l).
-
-Lemma list_to_heap : (l:(list A))(build_heap l).
-Proof.
-Induction l.
-Apply (heap_exist (nil  A) Tree_Leaf); Auto with datatypes.
-Simpl; Unfold meq; Auto with datatypes.
-Induction 1.
-Intros T i m; Elim (insert T i a).
-Intros; Apply heap_exist with T1; Simpl; Auto with datatypes.
-Apply meq_trans with (munion (contents T) (singletonBag a)).
-Apply meq_trans with (munion (singletonBag a) (contents T)).
-Apply meq_right; Trivial with datatypes.
-Apply munion_comm.
-Apply meq_sym; Trivial with datatypes.
-Qed.
-
-
-(** building the sorted list *)
-
-Inductive flat_spec [T:Tree] : Set :=
- flat_exist : (l:(list A))(sort leA l) ->
-              ((a:A)(leA_Tree a T)->(lelistA leA a l)) ->
-              (meq (contents T) (list_contents eqA_dec l)) ->
-              (flat_spec T).
-
-Lemma heap_to_list : (T:Tree)(is_heap T) -> (flat_spec T).
-Proof.
-  Intros T h; Elim h; Intros.
-  Apply flat_exist with (nil A); Auto with datatypes.
-  Elim H2; Intros l1 s1 i1 m1; Elim H4; Intros l2 s2 i2 m2.
-  Elim (merge leA_dec eqA_dec s1 s2); Intros.
-  Apply flat_exist with (cons a l); Simpl; Auto with datatypes.
-  Apply meq_trans with 
-    (munion (list_contents eqA_dec l1) (munion (list_contents eqA_dec l2) 
-                                               (singletonBag a))).
-  Apply meq_congr; Auto with datatypes.
-  Apply meq_trans with 
-    (munion (singletonBag a) (munion (list_contents eqA_dec l1) 
-                                     (list_contents eqA_dec  l2))).
-  Apply munion_rotate.
-  Apply meq_right; Apply meq_sym; Trivial with datatypes.
-Qed.
-
-(** specification of treesort *)
-
-Theorem treesort : (l:(list A))
-  {m:(list A) | (sort leA m) & (permutation eqA_dec l m)}.
-Proof.
-  Intro l; Unfold permutation.
-  Elim (list_to_heap l).
-  Intros.
-  Elim (heap_to_list T); Auto with datatypes.
-  Intros.
-  Exists l0; Auto with datatypes.
-  Apply meq_trans with (contents T); Trivial with datatypes.
-Qed.
-
-End defs.
diff --git a/theories7/Sorting/Permutation.v b/theories7/Sorting/Permutation.v
deleted file mode 100644
index 46b8da00..00000000
--- a/theories7/Sorting/Permutation.v
+++ /dev/null
@@ -1,111 +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: Permutation.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
-
-Require Relations.
-Require PolyList.
-Require Multiset.
-
-Set Implicit Arguments.
-
-Section defs.
-
-Variable A : Set.
-Variable leA : (relation A).
-Variable eqA : (relation A).
-
-Local gtA := [x,y:A]~(leA x y).
-
-Hypothesis leA_dec : (x,y:A){(leA x y)}+{~(leA x y)}.
-Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
-Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
-Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
-Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
-
-Hints Resolve leA_refl : default.
-Hints Immediate eqA_dec leA_dec leA_antisym : default.
-
-Local emptyBag := (EmptyBag A).
-Local singletonBag := (SingletonBag eqA_dec).
-
-(** contents of a list *)
-
-Fixpoint list_contents [l:(list A)] : (multiset A) :=
- Cases l of
-   nil        => emptyBag
- | (cons a l) => (munion (singletonBag a) (list_contents l))
- end.
-
-Lemma list_contents_app : (l,m:(list A))
-  (meq (list_contents (app l m)) (munion (list_contents l) (list_contents m))).
-Proof.
-Induction l; Simpl; Auto with datatypes.
-Intros.
-Apply meq_trans with  
- (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); Auto with datatypes.
-Qed.
-Hints Resolve list_contents_app.
-
-Definition permutation := [l,m:(list A)](meq (list_contents l) (list_contents m)).
-
-Lemma permut_refl : (l:(list A))(permutation l l).
-Proof.
-Unfold permutation; Auto with datatypes.
-Qed.
-Hints Resolve permut_refl.
-
-Lemma permut_tran : (l,m,n:(list A))
-   (permutation l m) -> (permutation m n) -> (permutation l n).
-Proof.
-Unfold permutation; Intros.
-Apply meq_trans with (list_contents m); Auto with datatypes.
-Qed.
-
-Lemma permut_right : (l,m:(list A))
-   (permutation l m) -> (a:A)(permutation (cons a l) (cons a m)).
-Proof.
-Unfold permutation; Simpl; Auto with datatypes.
-Qed.
-Hints Resolve permut_right.
-
-Lemma permut_app : (l,l',m,m':(list A))
-   (permutation l l') -> (permutation m m') ->
-   (permutation (app l m) (app l' m')).
-Proof.
-Unfold permutation; Intros.
-Apply meq_trans with (munion (list_contents l) (list_contents m)); Auto with datatypes.
-Apply meq_trans with (munion (list_contents l') (list_contents m')); Auto with datatypes.
-Apply meq_trans with (munion (list_contents l') (list_contents m)); Auto with datatypes.
-Qed.
-Hints Resolve permut_app.
-
-Lemma permut_cons : (l,m:(list A))(permutation l m) ->
-    (a:A)(permutation (cons a l) (cons a m)).
-Proof.
-Intros l m H a.
-Change (permutation (app (cons a (nil A)) l) (app (cons a (nil A)) m)).
-Apply permut_app; Auto with datatypes.
-Qed.
-Hints Resolve permut_cons.
-
-Lemma permut_middle : (l,m:(list A))
-   (a:A)(permutation (cons a (app l m)) (app l (cons a m))).
-Proof.
-Unfold permutation.
-Induction l; Simpl; Auto with datatypes.
-Intros.
-Apply meq_trans with (munion (singletonBag a)
-          (munion (singletonBag a0) (list_contents (app l0 m)))); Auto with datatypes.
-Apply munion_perm_left; Auto with datatypes.
-Qed.
-Hints Resolve permut_middle.
-
-End defs.
-Unset Implicit Arguments.
-
diff --git a/theories7/Sorting/Sorting.v b/theories7/Sorting/Sorting.v
deleted file mode 100644
index a6e38976..00000000
--- a/theories7/Sorting/Sorting.v
+++ /dev/null
@@ -1,117 +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: Sorting.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
-
-Require PolyList.
-Require Multiset.
-Require Permutation.
-Require Relations.
-
-Set Implicit Arguments.
-
-Section defs.
-
-Variable A : Set.
-Variable leA : (relation A).
-Variable eqA : (relation A).
-
-Local gtA := [x,y:A]~(leA x y).
-
-Hypothesis leA_dec : (x,y:A){(leA x y)}+{(leA y x)}.
-Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
-Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
-Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
-Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
-
-Hints Resolve leA_refl.
-Hints Immediate eqA_dec leA_dec leA_antisym.
-
-Local emptyBag := (EmptyBag A).
-Local singletonBag := (SingletonBag eqA_dec).
-
-(** [lelistA] *)
-
-Inductive lelistA [a:A] : (list A) -> Prop :=
-      nil_leA : (lelistA a (nil A))
-    | cons_leA : (b:A)(l:(list A))(leA a b)->(lelistA a (cons b l)).
-Hint constr_lelistA := Constructors lelistA.
-
-Lemma lelistA_inv : (a,b:A)(l:(list A))
-      (lelistA a (cons b l)) -> (leA a b).
-Proof.
-  Intros; Inversion H; Trivial with datatypes.
-Qed.
-
-(** definition for a list to be sorted *)
-
-Inductive sort : (list A) -> Prop :=
-   nil_sort : (sort (nil A))
- | cons_sort : (a:A)(l:(list A))(sort l) -> (lelistA a l) -> (sort (cons a l)).
-Hint constr_sort := Constructors sort.
-
-Lemma sort_inv : (a:A)(l:(list A))(sort (cons a l))->(sort l) /\ (lelistA a l).
-Proof.
-Intros; Inversion H; Auto with datatypes.
-Qed.
-
-Lemma sort_rec : (P:(list A)->Set)
-     (P (nil A)) ->
-     ((a:A)(l:(list A))(sort l)->(P l)->(lelistA a l)->(P (cons a l))) ->
-     (y:(list A))(sort y) -> (P y).
-Proof.
-Induction y; Auto with datatypes.
-Intros; Elim (!sort_inv a l); Auto with datatypes.
-Qed.
-
-(** merging two sorted lists *)
-
-Inductive merge_lem [l1:(list A);l2:(list A)] : Set :=
-  merge_exist : (l:(list A))(sort l) ->
-    (meq (list_contents eqA_dec l)
-         (munion (list_contents eqA_dec l1) (list_contents eqA_dec l2))) ->
-    ((a:A)(lelistA a l1)->(lelistA a l2)->(lelistA a l)) ->
-    (merge_lem l1 l2).
-
-Lemma merge : (l1:(list A))(sort l1)->(l2:(list A))(sort l2)->(merge_lem l1 l2).
-Proof.
-  Induction 1; Intros.
-  Apply merge_exist with l2; Auto with datatypes.
-  Elim H3; Intros.
-  Apply merge_exist with (cons a l); Simpl; Auto with datatypes.
-  Elim (leA_dec a a0); Intros.
-
-(* 1 (leA a a0) *)
-  Cut (merge_lem l (cons a0 l0)); Auto with datatypes.
-  Intros (l3, l3sorted, l3contents, Hrec).
-  Apply merge_exist with (cons a l3); Simpl; Auto with datatypes.
-  Apply meq_trans with (munion (singletonBag a)
-	                       (munion (list_contents eqA_dec l)
-                                       (list_contents eqA_dec (cons a0 l0)))).
-  Apply meq_right; Trivial with datatypes.
-  Apply meq_sym; Apply munion_ass.
-  Intros; Apply cons_leA.
-  Apply lelistA_inv with l; Trivial with datatypes.
-
-(* 2 (leA a0 a) *)
-  Elim H5; Simpl; Intros.
-  Apply merge_exist with (cons a0 l3); Simpl; Auto with datatypes.
-  Apply meq_trans with (munion (singletonBag a0)
-                               (munion (munion (singletonBag a) 
-                                               (list_contents eqA_dec l))
-                               (list_contents eqA_dec l0))).
-  Apply meq_right; Trivial with datatypes.
-  Apply munion_perm_left.
-  Intros; Apply cons_leA; Apply lelistA_inv with l0; Trivial with datatypes.
-Qed.
-
-End defs.
-
-Unset Implicit Arguments.
-Hint constr_sort : datatypes v62 := Constructors sort.
-Hint constr_lelistA : datatypes v62 := Constructors lelistA.
diff --git a/theories7/Wellfounded/Disjoint_Union.v b/theories7/Wellfounded/Disjoint_Union.v
deleted file mode 100644
index 04930170..00000000
--- a/theories7/Wellfounded/Disjoint_Union.v
+++ /dev/null
@@ -1,56 +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: Disjoint_Union.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
-
-(** Author: Cristina Cornes
-    From : Constructing Recursion Operators in Type Theory                 
-           L. Paulson  JSC (1986) 2, 325-355 *) 
-
-Require Relation_Operators.
-
-Section Wf_Disjoint_Union.
-Variable A,B:Set.
-Variable leA: A->A->Prop.
-Variable leB: B->B->Prop.
-
-Notation Le_AsB := (le_AsB A B leA leB).
-
-Lemma acc_A_sum: (x:A)(Acc A leA x)->(Acc A+B Le_AsB (inl A B x)).
-Proof.
- NewInduction 1.
- Apply Acc_intro;Intros y H2.
- Inversion_clear H2.
- Auto with sets.
-Qed.
-
-Lemma acc_B_sum: (well_founded A leA) ->(x:B)(Acc B leB x)
-                        ->(Acc A+B Le_AsB (inr A B x)).
-Proof.
- NewInduction 2.
- Apply Acc_intro;Intros y H3.
- Inversion_clear H3;Auto with sets.
- Apply acc_A_sum;Auto with sets.
-Qed.
-
-
-Lemma wf_disjoint_sum:
- (well_founded A leA) 
-    -> (well_founded B leB) -> (well_founded A+B Le_AsB).
-Proof.
- Intros.
- Unfold well_founded .
- NewDestruct a as [a|b].
- Apply (acc_A_sum a).
- Apply (H a).
-
- Apply (acc_B_sum H b).
- Apply (H0 b).
-Qed.
-
-End Wf_Disjoint_Union.
diff --git a/theories7/Wellfounded/Inclusion.v b/theories7/Wellfounded/Inclusion.v
deleted file mode 100644
index 6a515333..00000000
--- a/theories7/Wellfounded/Inclusion.v
+++ /dev/null
@@ -1,33 +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: Inclusion.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
-
-(** Author: Bruno Barras *)
-
-Require Relation_Definitions.
-
-Section WfInclusion.
-  Variable A:Set.
-  Variable R1,R2:A->A->Prop.
-
-  Lemma Acc_incl: (inclusion A R1 R2)->(z:A)(Acc A R2 z)->(Acc A R1 z).
-  Proof.
-    NewInduction 2.
-    Apply Acc_intro;Auto with sets.
-  Qed.
-
-  Hints Resolve Acc_incl.
-
-  Theorem wf_incl: 
-         (inclusion A R1 R2)->(well_founded A R2)->(well_founded A R1).
-  Proof.
-    Unfold well_founded ;Auto with sets.
-  Qed.
-
-End WfInclusion.
diff --git a/theories7/Wellfounded/Inverse_Image.v b/theories7/Wellfounded/Inverse_Image.v
deleted file mode 100644
index 6c9c3e65..00000000
--- a/theories7/Wellfounded/Inverse_Image.v
+++ /dev/null
@@ -1,58 +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: Inverse_Image.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
-
-(** Author: Bruno Barras *)
-
-Section Inverse_Image.
-
-  Variables A,B:Set.
-  Variable R : B->B->Prop.
-  Variable f:A->B.
-
-  Local Rof : A->A->Prop := [x,y:A](R (f x) (f y)).
-
-  Remark Acc_lemma : (y:B)(Acc B R y)->(x:A)(y=(f x))->(Acc A Rof x).
-    NewInduction 1 as [y _ IHAcc]; Intros x H.
-    Apply Acc_intro; Intros y0 H1.
-    Apply (IHAcc (f y0)); Try Trivial.
-    Rewrite H; Trivial.
-  Qed.
-
-  Lemma Acc_inverse_image : (x:A)(Acc B R (f x)) -> (Acc A Rof x).
-    Intros; Apply (Acc_lemma (f x)); Trivial.
-  Qed.
-
-  Theorem wf_inverse_image: (well_founded B R)->(well_founded A Rof).
-    Red; Intros; Apply Acc_inverse_image; Auto.
-  Qed.
-
-  Variable F : A -> B -> Prop.
-  Local RoF : A -> A -> Prop := [x,y]
-    (EX b : B | (F x b) & (c:B)(F y c)->(R b c)).
-
-Lemma Acc_inverse_rel :
-   (b:B)(Acc B R b)->(x:A)(F x b)->(Acc A RoF x).
-NewInduction 1 as [x _ IHAcc]; Intros x0 H2.
-Constructor; Intros y H3.
-NewDestruct H3.
-Apply (IHAcc x1); Auto.
-Save.
-
-
-Theorem wf_inverse_rel : 
-   (well_founded B R)->(well_founded A RoF).
-    Red; Constructor; Intros.
-    Case H0; Intros.
-    Apply (Acc_inverse_rel x); Auto.
-Save.
-
-End Inverse_Image.
-
-
diff --git a/theories7/Wellfounded/Lexicographic_Exponentiation.v b/theories7/Wellfounded/Lexicographic_Exponentiation.v
deleted file mode 100644
index 17f6d650..00000000
--- a/theories7/Wellfounded/Lexicographic_Exponentiation.v
+++ /dev/null
@@ -1,386 +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: Lexicographic_Exponentiation.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
-
-(** Author: Cristina Cornes
-
-    From : Constructing Recursion Operators in Type Theory                
-           L. Paulson  JSC (1986) 2, 325-355  *)
-
-Require Eqdep.
-Require PolyList.
-Require PolyListSyntax.
-Require Relation_Operators.
-Require Transitive_Closure.
-
-Section Wf_Lexicographic_Exponentiation.
-Variable A:Set.
-Variable leA: A->A->Prop.
-
-Notation Power := (Pow A leA).
-Notation Lex_Exp := (lex_exp A leA).
-Notation ltl := (Ltl A leA).
-Notation Descl := (Desc A leA).
-
-Notation List := (list A).
-Notation Nil := (nil A).
-(* useless but symmetric *)
-Notation Cons := (cons 1!A).
-Notation "<< x , y >>" := (exist List Descl x y) (at level 0)
-  V8only (at level 0, x,y at level 100).
-
-V7only[
-Syntax constr
-  level 1:
-    List [ (list A) ] -> ["List"]
-  | Nil  [ (nil A) ] -> ["Nil"]
-  | Cons [ (cons A) ] -> ["Cons"]
-  ;
-  level 10:
-    Cons2 [ (cons A $e $l) ] -> ["Cons " $e:L " " $l:L ].
-
-Syntax constr
-  level 1:
-  pair_sig [ (exist (list A) Desc $e $d) ] -> ["<<" $e:L "," $d:L ">>"].
-].
-Hints Resolve d_one d_nil  t_step.
-
-Lemma left_prefix : (x,y,z:List)(ltl x^y z)-> (ltl x z).
-Proof.
- Induction x.
- Induction z.
- Simpl;Intros H.
- Inversion_clear H. 
- Simpl;Intros;Apply (Lt_nil A leA).
- Intros a l HInd.
- Simpl.
- Intros.
- Inversion_clear H.
- Apply (Lt_hd A leA);Auto with sets.
- Apply (Lt_tl A leA).
- Apply (HInd y y0);Auto with sets.
-Qed.
-
-
-Lemma  right_prefix : 
-  (x,y,z:List)(ltl x y^z)-> (ltl x y) \/ (EX y':List | x=(y^y') /\ (ltl y' z)).
-Proof.
- Intros x y;Generalize x.
- Elim y;Simpl.
- Right.
- Exists x0 ;Auto with sets.
- Intros.
- Inversion H0.
- Left;Apply (Lt_nil A leA).
- Left;Apply (Lt_hd A leA);Auto with sets.
- Generalize (H x1 z H3) .
- Induction 1.
- Left;Apply (Lt_tl A leA);Auto with sets.
- Induction 1.
- Induction 1;Intros.
- Rewrite -> H8.
- Right;Exists x2 ;Auto with sets.
-Qed.
-
-
-
-Lemma desc_prefix: (x:List)(a:A)(Descl x^(Cons a Nil))->(Descl x).
-Proof.
- Intros.
- Inversion H.
- Generalize (app_cons_not_nil H1); Induction 1. 
- Cut (x^(Cons a Nil))=(Cons x0 Nil); Auto with sets.
- Intro.
- Generalize (app_eq_unit H0) .
- Induction 1; Induction 1; Intros.
- Rewrite -> H4; Auto with sets.
- Discriminate H5.
- Generalize (app_inj_tail H0) .
- Induction 1; Intros.
- Rewrite <- H4; Auto with sets.
-Qed.
-
-Lemma desc_tail: (x:List)(a,b:A)
-          (Descl (Cons b (x^(Cons a Nil))))-> (clos_trans A leA a b).
-Proof.
- Intro.
- Apply rev_ind with  A:=A
-             P:=[x:List](a,b:A)
-          (Descl (Cons b (x^(Cons a Nil))))-> (clos_trans A leA a b).
- Intros.
-
- Inversion  H.
- Cut (Cons b (Cons a Nil))= ((Nil^(Cons b Nil))^ (Cons a Nil)); Auto with sets; Intro.
- Generalize H0.
- Intro.
- Generalize (app_inj_tail 2!(l^(Cons y Nil)) 3!(Nil^(Cons b Nil)) H4);
- Induction 1.
- Intros.
-
- Generalize (app_inj_tail H6); Induction 1; Intros.
- Generalize H1.
- Rewrite <- H10; Rewrite <- H7; Intro.
- Apply (t_step A leA); Auto with sets.
-
-
-
- Intros.
- Inversion H0.
- Generalize  (app_cons_not_nil H3); Intro.
- Elim H1.
-
- Generalize H0.
- Generalize (app_comm_cons (l^(Cons x0 Nil)) (Cons a Nil) b); Induction 1.
- Intro.
- Generalize (desc_prefix (Cons b (l^(Cons x0 Nil))) a H5); Intro.
- Generalize (H x0 b H6).
- Intro.
- Apply t_trans with A:=A  y:=x0; Auto with sets.
-
- Apply  t_step.
- Generalize H1.
- Rewrite -> H4; Intro.
-
- Generalize (app_inj_tail H8); Induction 1.
- Intros.
- Generalize H2; Generalize (app_comm_cons l (Cons x0 Nil) b).
- Intro.
- Generalize H10.
- Rewrite ->H12; Intro.
- Generalize (app_inj_tail H13); Induction 1.
- Intros.
- Rewrite <- H11; Rewrite <- H16; Auto with sets.
-Qed.
-
-
-Lemma dist_aux : (z:List)(Descl z)->(x,y:List)z=(x^y)->(Descl x)/\ (Descl y).
-Proof.
- Intros z D.
- Elim D.
- Intros.
- Cut (x^y)=Nil;Auto with sets; Intro.
- Generalize (app_eq_nil H0) ; Induction 1.
- Intros.
- Rewrite -> H2;Rewrite -> H3; Split;Apply d_nil.
-
- Intros.
- Cut (x0^y)=(Cons x Nil); Auto with sets.
- Intros E.
- Generalize (app_eq_unit E); Induction 1.
- Induction 1;Intros.
- Rewrite -> H2;Rewrite -> H3; Split.
- Apply d_nil.
-
- Apply d_one.
-
- Induction 1; Intros.
- Rewrite -> H2;Rewrite -> H3; Split.
- Apply d_one.
-
- Apply d_nil.
-
- Do 5 Intro.
- Intros Hind.
- Do 2 Intro.
- Generalize x0 .
- Apply rev_ind with A:=A 
-      P:=[y0:List]
-          (x0:List)
-          ((l^(Cons y Nil))^(Cons x Nil))=(x0^y0)->(Descl x0)/\(Descl y0).
-
- Intro.
- Generalize (app_nil_end x1) ; Induction 1; Induction 1.
- Split. Apply d_conc; Auto with sets.
-
- Apply d_nil.
-
- Do 3 Intro.
- Generalize x1 .
- Apply rev_ind with 
-  A:=A 
-  P:=[l0:List]
-     (x1:A)
-      (x0:List)
-       ((l^(Cons y Nil))^(Cons x Nil))=(x0^(l0^(Cons x1 Nil)))
-         ->(Descl x0)/\(Descl (l0^(Cons x1 Nil))).
-
-
- Simpl.
- Split.
- Generalize (app_inj_tail H2) ;Induction 1.
- Induction 1;Auto with sets.
-
- Apply d_one.
- Do 5 Intro.
- Generalize (app_ass x4 (l1^(Cons x2 Nil)) (Cons x3 Nil)) .
- Induction 1.
- Generalize (app_ass x4 l1 (Cons x2 Nil)) ;Induction 1.
- Intro E.
- Generalize (app_inj_tail E) .
- Induction 1;Intros.
- Generalize (app_inj_tail H6) ;Induction 1;Intros.
- Rewrite <- H7;  Rewrite <- H10; Generalize H6.
- Generalize (app_ass x4 l1 (Cons x2 Nil)); Intro E1.
- Rewrite -> E1.
- Intro.
- Generalize (Hind x4 (l1^(Cons x2 Nil))  H11) .
- Induction 1;Split.
- Auto with sets.
-
- Generalize H14.
- Rewrite <- H10; Intro.
- Apply d_conc;Auto with sets.
-Qed.
-
-
-
-Lemma dist_Desc_concat : (x,y:List)(Descl x^y)->(Descl x)/\(Descl y).
-Proof.
-  Intros.
-  Apply (dist_aux (x^y) H x y); Auto with sets.
-Qed.
-
-
-Lemma desc_end:(a,b:A)(x:List) 
-   (Descl x^(Cons a Nil)) /\ (ltl x^(Cons a Nil) (Cons b Nil))
-     -> (clos_trans A leA a b). 
-
-Proof.
- Intros a b x.
- Case x.
- Simpl.
- Induction 1.
- Intros.
- Inversion H1;Auto with sets.
- Inversion H3.
-
- Induction 1.
- Generalize (app_comm_cons l (Cons a Nil) a0).
- Intros E; Rewrite <- E; Intros.
- Generalize (desc_tail l a a0 H0); Intro.
- Inversion H1.
- Apply t_trans with y:=a0 ;Auto with sets.
-
- Inversion H4.
-Qed.
-
-
-
-
-Lemma  ltl_unit: (x:List)(a,b:A)
- (Descl (x^(Cons a Nil))) -> (ltl x^(Cons a Nil) (Cons b Nil))
-               -> (ltl x (Cons b Nil)).
-Proof.
- Intro.
- Case x.
- Intros;Apply (Lt_nil A leA).
-
- Simpl;Intros.
- Inversion_clear H0.
- Apply (Lt_hd A leA  a b);Auto with sets.
- 
- Inversion_clear H1.
-Qed.
-
-
-Lemma acc_app: 
-    (x1,x2:List)(y1:(Descl x1^x2))
-     (Acc Power Lex_Exp (exist List Descl (x1^x2)  y1))
-     ->(x:List)
-        (y:(Descl x))
-         (ltl x (x1^x2))->(Acc Power Lex_Exp (exist List Descl x y)).
-Proof.
- Intros.
- Apply (Acc_inv Power Lex_Exp (exist List Descl (x1^x2) y1)).
- Auto with sets.
-
- Unfold lex_exp ;Simpl;Auto with sets.
-Qed.
-
-
-Theorem wf_lex_exp :
-  (well_founded A leA)->(well_founded Power Lex_Exp).
-Proof.
- Unfold 2 well_founded .
- Induction a;Intros x y.
- Apply Acc_intro.
- Induction y0.
- Unfold 1 lex_exp ;Simpl.
- Apply rev_ind with A:=A P:=[x:List]
-                            (x0:List)
-                             (y:(Descl x0))
-                              (ltl x0 x)
-                               ->(Acc Power Lex_Exp (exist List Descl x0 y)) .
- Intros.
- Inversion_clear H0.
-
- Intro.
- Generalize (well_founded_ind A (clos_trans A leA) (wf_clos_trans A leA H)).
- Intros GR.
- Apply GR with P:=[x0:A]
-                  (l:List)
-                   ((x1:List)
-                     (y:(Descl x1))
-                      (ltl x1 l)
-                       ->(Acc Power Lex_Exp (exist List Descl x1 y)))
-                    ->(x1:List)
-                       (y:(Descl x1))
-                        (ltl x1 (l^(Cons x0 Nil)))
-                         ->(Acc Power Lex_Exp (exist List Descl x1 y)) .
- Intro;Intros HInd; Intros.
- Generalize (right_prefix x2 l (Cons x1 Nil) H1) .
- Induction 1.
- Intro; Apply (H0 x2 y1 H3).
-
- Induction 1.
- Intro;Induction 1.
- Clear  H4  H2.
- Intro;Generalize y1 ;Clear  y1.
- Rewrite -> H2.
- Apply rev_ind with A:=A P:=[x3:List]
-                            (y1:(Descl (l^x3)))
-                             (ltl x3 (Cons x1 Nil))
-                              ->(Acc Power Lex_Exp
-                                  (exist List Descl (l^x3) y1)) .
- Intros.
- Generalize (app_nil_end l) ;Intros Heq.
- Generalize y1 .
- Clear  y1.
- Rewrite <- Heq.
- Intro.
- Apply Acc_intro.
- Induction y2.
- Unfold 1 lex_exp .
- Simpl;Intros x4 y3. Intros.
- Apply (H0 x4 y3);Auto with sets.
-
- Intros. 
- Generalize (dist_Desc_concat l (l0^(Cons x4 Nil)) y1) .
- Induction 1.
- Intros.
- Generalize (desc_end x4 x1 l0  (conj ? ? H8 H5)) ; Intros.
- Generalize y1 .
- Rewrite <- (app_ass l l0 (Cons x4 Nil)); Intro.
- Generalize (HInd x4 H9 (l^l0)) ; Intros HInd2.
- Generalize (ltl_unit l0 x4 x1 H8 H5); Intro.
- Generalize (dist_Desc_concat (l^l0) (Cons x4 Nil) y2) .
- Induction 1;Intros.
- Generalize (H4 H12 H10); Intro.
- Generalize (Acc_inv Power Lex_Exp (exist List Descl (l^l0) H12) H14) .
- Generalize (acc_app l l0 H12 H14).
- Intros f g.
- Generalize (HInd2 f);Intro.
- Apply Acc_intro.
- Induction y3.
- Unfold 1 lex_exp ;Simpl; Intros.
- Apply H15;Auto with sets.
-Qed.
-
-
-End Wf_Lexicographic_Exponentiation.
diff --git a/theories7/Wellfounded/Lexicographic_Product.v b/theories7/Wellfounded/Lexicographic_Product.v
deleted file mode 100644
index f31d8c3f..00000000
--- a/theories7/Wellfounded/Lexicographic_Product.v
+++ /dev/null
@@ -1,191 +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: Lexicographic_Product.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-(** Authors: Bruno Barras, Cristina Cornes *)
-
-Require Eqdep.
-Require Relation_Operators.
-Require Transitive_Closure.
-
-(**  From : Constructing Recursion Operators in Type Theory            
-     L. Paulson  JSC (1986) 2, 325-355 *)
-
-Section WfLexicographic_Product.
-Variable A:Set.
-Variable B:A->Set.
-Variable leA: A->A->Prop.
-Variable leB: (x:A)(B x)->(B x)->Prop.
-
-Notation LexProd := (lexprod A B leA leB).
-
-Hints Resolve t_step Acc_clos_trans wf_clos_trans.
-
-Lemma acc_A_B_lexprod : (x:A)(Acc A leA x)
-        ->((x0:A)(clos_trans A leA x0 x)->(well_founded (B x0) (leB x0)))
-                ->(y:(B x))(Acc (B x) (leB x) y)
-                        ->(Acc (sigS A B) LexProd (existS A B x y)).
-Proof.
- NewInduction 1 as [x _ IHAcc]; Intros H2 y.
- NewInduction 1 as [x0 H IHAcc0];Intros.
- Apply Acc_intro.
- NewDestruct y as [x2 y1]; Intro H6.
- Simple Inversion H6; Intro.
- Cut (leA x2 x);Intros.
- Apply IHAcc;Auto with sets.
- Intros.
- Apply H2.
- Apply t_trans with x2 ;Auto with sets.
-
- Red in H2.
- Apply H2.
- Auto with sets.
-
- Injection H1.
- NewDestruct 2.
- Injection H3.
- NewDestruct 2;Auto with sets.
-
- Rewrite <- H1.
- Injection H3; Intros _ Hx1.
- Subst x1.
- Apply IHAcc0.
- Elim inj_pair2 with A B x y' x0; Assumption.
-Qed.
-
-Theorem wf_lexprod: 
-   (well_founded A leA) ->((x:A) (well_founded (B x) (leB x))) 
-             -> (well_founded (sigS A B) LexProd).
-Proof.
- Intros wfA wfB;Unfold well_founded .
- NewDestruct a.
- Apply acc_A_B_lexprod;Auto with sets;Intros.
- Red in wfB.
- Auto with sets.
-Qed.
-
-
-End WfLexicographic_Product.
-
-
-Section Wf_Symmetric_Product.
-  Variable A:Set.
-  Variable B:Set.
-  Variable leA: A->A->Prop.
-  Variable leB: B->B->Prop.
-
-  Notation Symprod := (symprod A B leA leB).
-
-(*i
-  Local sig_prod:=
-         [x:A*B]<{_:A&B}>Case x of [a:A][b:B](existS A [_:A]B a b) end.
-
-Lemma incl_sym_lexprod: (included (A*B) Symprod  
-            (R_o_f (A*B) {_:A&B} sig_prod (lexprod A [_:A]B leA [_:A]leB))).
-Proof.
- Red.
- Induction x.
- (Induction y1;Intros).
- Red.
- Unfold sig_prod .
- Inversion_clear H.
- (Apply left_lex;Auto with sets).
-
- (Apply right_lex;Auto with sets).
-Qed.
-i*)
-
-  Lemma Acc_symprod: (x:A)(Acc A leA x)->(y:B)(Acc B leB y)
-                        ->(Acc (A*B) Symprod (x,y)).
- Proof.
- NewInduction 1 as [x _ IHAcc]; Intros y H2.
- NewInduction H2 as [x1 H3 IHAcc1].
- Apply Acc_intro;Intros y H5.
- Inversion_clear H5;Auto with sets.
- Apply IHAcc; Auto.
- Apply Acc_intro;Trivial.
-Qed.
-
-
-Lemma wf_symprod: (well_founded A leA)->(well_founded B leB)
-                        ->(well_founded (A*B) Symprod).
-Proof.
- Red.
- NewDestruct a.
- Apply Acc_symprod;Auto with sets.
-Qed.
-
-End Wf_Symmetric_Product.
-
-
-Section Swap.
-
-  Variable A:Set.
-  Variable R:A->A->Prop.
-
-  Notation SwapProd :=(swapprod A R).
-
-
-  Lemma swap_Acc: (x,y:A)(Acc A*A SwapProd (x,y))->(Acc A*A SwapProd (y,x)).
-Proof.
- Intros.
- Inversion_clear H.
- Apply Acc_intro.
- NewDestruct y0;Intros.
- Inversion_clear H;Inversion_clear H1;Apply H0.
- Apply sp_swap.
- Apply right_sym;Auto with sets.
-
- Apply sp_swap.
- Apply left_sym;Auto with sets.
-
- Apply sp_noswap.
- Apply right_sym;Auto with sets.
-
- Apply sp_noswap.
- Apply left_sym;Auto with sets.
-Qed.
-
-
-  Lemma Acc_swapprod: (x,y:A)(Acc A R x)->(Acc A R y)
-                                ->(Acc A*A SwapProd (x,y)).
-Proof.
- NewInduction 1 as [x0 _ IHAcc0];Intros H2.
- Cut (y0:A)(R y0 x0)->(Acc ? SwapProd (y0,y)).
- Clear  IHAcc0.
- NewInduction H2 as [x1 _ IHAcc1]; Intros H4.
- Cut (y:A)(R y x1)->(Acc ? SwapProd (x0,y)).
- Clear  IHAcc1.
- Intro.
- Apply Acc_intro.
- NewDestruct y; Intro H5.
- Inversion_clear H5.
- Inversion_clear H0;Auto with sets.
-
- Apply swap_Acc.
- Inversion_clear H0;Auto with sets.
-
- Intros.
- Apply IHAcc1;Auto with sets;Intros.
- Apply Acc_inv with (y0,x1) ;Auto with sets.
- Apply sp_noswap.
- Apply right_sym;Auto with sets.
-
- Auto with sets.
-Qed.
-
-
-  Lemma wf_swapprod: (well_founded A R)->(well_founded A*A SwapProd).
-Proof.
- Red.
- NewDestruct a;Intros.
- Apply Acc_swapprod;Auto with sets.
-Qed.
-
-End Swap.
diff --git a/theories7/Wellfounded/Transitive_Closure.v b/theories7/Wellfounded/Transitive_Closure.v
deleted file mode 100644
index 4d6cbe28..00000000
--- a/theories7/Wellfounded/Transitive_Closure.v
+++ /dev/null
@@ -1,47 +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: Transitive_Closure.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-(** Author: Bruno Barras *)
-
-Require Relation_Definitions.
-Require Relation_Operators.
-
-Section Wf_Transitive_Closure.
-  Variable A: Set.
-  Variable R: (relation A).
-
-  Notation trans_clos := (clos_trans A R).
- 
-  Lemma incl_clos_trans: (inclusion A R trans_clos).
-    Red;Auto with sets.
-  Qed.
-
-  Lemma Acc_clos_trans: (x:A)(Acc A R x)->(Acc A trans_clos x).
-    NewInduction 1 as [x0 _ H1].
-    Apply Acc_intro.
-    Intros y H2.
-    NewInduction H2;Auto with sets.
-    Apply Acc_inv with y ;Auto with sets.
-  Qed.
-
-  Hints Resolve Acc_clos_trans.
-
-  Lemma Acc_inv_trans: (x,y:A)(trans_clos y x)->(Acc A R x)->(Acc A R y).
-  Proof.
-    NewInduction 1 as [|x y];Auto with sets.
-    Intro; Apply Acc_inv with y; Assumption.
-  Qed.
-
-  Theorem wf_clos_trans: (well_founded A R)  ->(well_founded A trans_clos).
-  Proof.
-    Unfold well_founded;Auto with sets.
-  Qed.
-
-End Wf_Transitive_Closure.
diff --git a/theories7/Wellfounded/Union.v b/theories7/Wellfounded/Union.v
deleted file mode 100644
index 9b31f72d..00000000
--- a/theories7/Wellfounded/Union.v
+++ /dev/null
@@ -1,74 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i $Id: Union.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-(** Author: Bruno Barras *)
-
-Require Relation_Operators.
-Require Relation_Definitions.
-Require Transitive_Closure.
-
-Section WfUnion.
-  Variable A: Set.
-  Variable R1,R2: (relation A).
-  
- Notation Union := (union A R1 R2).
-
- Hints Resolve Acc_clos_trans wf_clos_trans.
-
-Remark strip_commut: 
-      (commut A R1 R2)->(x,y:A)(clos_trans A R1 y x)->(z:A)(R2 z y)
-            ->(EX y':A | (R2 y' x) & (clos_trans A R1 z y')).
-Proof.
- NewInduction 2 as [x y|x y z H0 IH1 H1 IH2]; Intros.
- Elim H with y x z ;Auto with sets;Intros x0 H2 H3.
- Exists x0;Auto with sets.
-
- Elim IH1 with z0 ;Auto with sets;Intros.
- Elim IH2 with x0 ;Auto with sets;Intros.
- Exists x1;Auto with sets.
- Apply t_trans with x0; Auto with sets.
-Qed.
-
-
-  Lemma Acc_union:  (commut A R1 R2)->((x:A)(Acc A R2 x)->(Acc A R1 x))
-                         ->(a:A)(Acc A R2 a)->(Acc A Union a).
-Proof.
- NewInduction 3 as [x H1 H2].
- Apply Acc_intro;Intros.
- Elim H3;Intros;Auto with sets.
- Cut (clos_trans A  R1 y x);Auto with sets.
- ElimType (Acc A (clos_trans A R1) y);Intros.
- Apply Acc_intro;Intros.
- Elim H8;Intros.
- Apply H6;Auto with sets.
- Apply t_trans with x0 ;Auto with sets.
-
- Elim strip_commut with x x0 y0 ;Auto with sets;Intros.
- Apply Acc_inv_trans with x1 ;Auto with sets.
- Unfold union .
- Elim H11;Auto with sets;Intros.
- Apply t_trans with y1 ;Auto with sets.
-
- Apply (Acc_clos_trans A).
- Apply Acc_inv with x ;Auto with sets.
- Apply H0.
- Apply Acc_intro;Auto with sets.
-Qed.
-
-
-  Theorem wf_union:  (commut A R1 R2)->(well_founded A R1)->(well_founded A R2)
-                  ->(well_founded A Union).
-Proof.
- Unfold well_founded .
- Intros.
- Apply Acc_union;Auto with sets.
-Qed.
-
-End WfUnion.
diff --git a/theories7/Wellfounded/Well_Ordering.v b/theories7/Wellfounded/Well_Ordering.v
deleted file mode 100644
index 5c2b2405..00000000
--- a/theories7/Wellfounded/Well_Ordering.v
+++ /dev/null
@@ -1,72 +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: Well_Ordering.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-(** Author: Cristina Cornes.
-    From: Constructing Recursion Operators in Type Theory
-    L. Paulson  JSC (1986) 2, 325-355 *)
-
-Require Eqdep.
-
-Section WellOrdering.
-Variable A:Set.
-Variable B:A->Set. 
-
-Inductive WO : Set :=
-   sup : (a:A)(f:(B a)->WO)WO.
-
-
-Inductive le_WO  : WO->WO->Prop :=
-  le_sup : (a:A)(f:(B a)->WO)(v:(B a)) (le_WO  (f v) (sup a f)).
- 
-
-Theorem wf_WO : (well_founded WO le_WO ).
-Proof.
- Unfold well_founded ;Intro.
- Apply Acc_intro.
- Elim a.
- Intros.
- Inversion H0.
- Apply Acc_intro.
- Generalize H4 ;Generalize H1 ;Generalize f0 ;Generalize v.
- Rewrite -> H3.
- Intros.
- Apply (H v0 y0).
- Cut (eq ? f f1).
- Intros E;Rewrite -> E;Auto.
- Symmetry.
- Apply (inj_pair2 A [a0:A](B a0)->WO a0 f1 f H5).
-Qed.
-
-End WellOrdering.
-
-
-Section Characterisation_wf_relations.
-
-(** Wellfounded relations are the inverse image of wellordering types *)
-(*  in course of development                                          *)
-
-
-Variable A:Set.
-Variable leA:A->A->Prop.
-
-Definition B:= [a:A] {x:A | (leA x a)}.
-
-Definition  wof: (well_founded A leA)-> A-> (WO A B).
-Proof.
- Intros.
- Apply (well_founded_induction A leA H [a:A](WO A B));Auto.
- Intros.
- Apply (sup A B x).
- Unfold 1 B .
- NewDestruct 1 as [x0].
- Apply (H1 x0);Auto.
-Qed.
-
-End Characterisation_wf_relations.
diff --git a/theories7/Wellfounded/Wellfounded.v b/theories7/Wellfounded/Wellfounded.v
deleted file mode 100644
index d1a8dd01..00000000
--- a/theories7/Wellfounded/Wellfounded.v
+++ /dev/null
@@ -1,20 +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: Wellfounded.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-Require Export Disjoint_Union.
-Require Export Inclusion.
-Require Export Inverse_Image.
-Require Export Lexicographic_Exponentiation.
-Require Export Lexicographic_Product.
-Require Export Transitive_Closure.
-Require Export Union.
-Require Export Well_Ordering.
-
-
diff --git a/theories7/ZArith/BinInt.v b/theories7/ZArith/BinInt.v
deleted file mode 100644
index 9071896b..00000000
--- a/theories7/ZArith/BinInt.v
+++ /dev/null
@@ -1,1005 +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: BinInt.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-(***********************************************************)
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
-(***********************************************************)
-
-Require Export BinPos.
-Require Export Pnat.
-Require BinNat.
-Require Plus.
-Require Mult.
-(**********************************************************************)
-(** Binary integer numbers *)
-
-Inductive Z : Set := 
-  ZERO : Z | POS : positive -> Z | NEG : positive -> Z.
-
-(** Declare Scope Z_scope with Key Z *)
-Delimits Scope Z_scope with Z.
-
-(** Automatically open scope positive_scope for the constructors of Z *)
-Bind Scope Z_scope with Z.
-Arguments Scope POS [ positive_scope ].
-Arguments Scope NEG [ positive_scope ].
-
-(** Subtraction of positive into Z *)
-
-Definition Zdouble_plus_one [x:Z] :=
-  Cases x of 
-  | ZERO    => (POS xH)
-  | (POS p) => (POS (xI p))
-  | (NEG p) => (NEG (double_moins_un p))
-  end.
-
-Definition Zdouble_minus_one [x:Z] :=
-  Cases x of 
-  | ZERO    => (NEG xH)
-  | (NEG p) => (NEG (xI p))
-  | (POS p) => (POS (double_moins_un p))
-  end.
-
-Definition Zdouble [x:Z] :=
-  Cases x of
-  | ZERO => ZERO
-  | (POS p) => (POS (xO p))
-  | (NEG p) => (NEG (xO p))
- end.
-
-Fixpoint ZPminus [x,y:positive] : Z :=
-  Cases x y of
-  | (xI x') (xI y') => (Zdouble (ZPminus x' y'))
-  | (xI x') (xO y') => (Zdouble_plus_one (ZPminus x' y'))
-  | (xI x') xH      => (POS (xO x'))
-  | (xO x') (xI y') => (Zdouble_minus_one (ZPminus x' y'))
-  | (xO x') (xO y') => (Zdouble (ZPminus x' y'))
-  | (xO x') xH      => (POS (double_moins_un x'))
-  | xH      (xI y') => (NEG (xO y'))
-  | xH      (xO y') => (NEG (double_moins_un y'))
-  | xH      xH      => ZERO
-  end.
-
-(** Addition on integers *)
-
-Definition Zplus := [x,y:Z]
-  Cases x y of
-    ZERO      y       => y
-  | x         ZERO    => x
-  | (POS x') (POS y') => (POS (add x' y'))
-  | (POS x') (NEG y') => 
-      Cases (compare x' y' EGAL) of
-      | EGAL => ZERO
-      | INFERIEUR => (NEG (true_sub y' x'))
-      | SUPERIEUR => (POS (true_sub x' y'))
-      end
-  | (NEG x') (POS y') =>
-      Cases (compare x' y' EGAL) of
-      | EGAL => ZERO
-      | INFERIEUR => (POS (true_sub y' x'))
-      | SUPERIEUR => (NEG (true_sub x' y'))
-      end
-  | (NEG x') (NEG y') => (NEG (add x' y'))
-  end.
-
-V8Infix "+" Zplus : Z_scope.
-
-(** Opposite *)
-
-Definition Zopp := [x:Z]
- Cases x of
-      ZERO => ZERO
-    | (POS x) => (NEG x)
-    | (NEG x) => (POS x)
-    end.
-
-V8Notation "- x" := (Zopp x) : Z_scope.
-
-(** Successor on integers *)
-
-Definition Zs := [x:Z](Zplus x (POS xH)).
-
-(** Predecessor on integers *)
-
-Definition Zpred := [x:Z](Zplus x (NEG xH)).
-
-(** Subtraction on integers *)
-
-Definition Zminus := [m,n:Z](Zplus m (Zopp n)).
-
-V8Infix "-" Zminus : Z_scope.
-
-(** Multiplication on integers *)
-
-Definition Zmult := [x,y:Z]
-  Cases x y of
-  | ZERO     _        => ZERO
-  | _        ZERO     => ZERO
-  | (POS x') (POS y') => (POS (times x' y'))
-  | (POS x') (NEG y') => (NEG (times x' y'))
-  | (NEG x') (POS y') => (NEG (times x' y'))
-  | (NEG x') (NEG y') => (POS (times x' y'))
-  end.
-
-V8Infix "*" Zmult : Z_scope.
-
-(** Comparison of integers *)
-
-Definition Zcompare := [x,y:Z]
-  Cases x y of
-  | ZERO     ZERO     => EGAL
-  | ZERO     (POS y') => INFERIEUR
-  | ZERO     (NEG y') => SUPERIEUR
-  | (POS x') ZERO     => SUPERIEUR
-  | (POS x') (POS y') => (compare x' y' EGAL)
-  | (POS x') (NEG y') => SUPERIEUR
-  | (NEG x') ZERO     => INFERIEUR
-  | (NEG x') (POS y') => INFERIEUR
-  | (NEG x') (NEG y') => (Op (compare x' y' EGAL))
-  end.
-
-V8Infix "?=" Zcompare (at level 70, no associativity) : Z_scope.
-
-Tactic Definition ElimCompare com1 com2:=
-  Case (Dcompare (Zcompare com1 com2)); [ Idtac | 
-     Let x = FreshId "H" In Intro x; Case x; Clear x ].
-
-(** Sign function *)
-
-Definition Zsgn [z:Z] : Z :=
-  Cases z of 
-     ZERO   => ZERO
-  | (POS p) => (POS xH)
-  | (NEG p) => (NEG xH)
-  end.
-
-(** Direct, easier to handle variants of successor and addition *)
-
-Definition Zsucc' [x:Z] :=
-  Cases x of
-  | ZERO => (POS xH)
-  | (POS x') => (POS (add_un x'))
-  | (NEG x') => (ZPminus xH x')
-  end.
-
-Definition Zpred' [x:Z] :=
-  Cases x of
-  | ZERO => (NEG xH)
-  | (POS x') => (ZPminus x' xH)
-  | (NEG x') => (NEG (add_un x'))
-  end.
-
-Definition Zplus' := [x,y:Z]
-  Cases x y of
-    ZERO      y       => y
-  | x         ZERO    => x
-  | (POS x') (POS y') => (POS (add x' y'))
-  | (POS x') (NEG y') => (ZPminus x' y')
-  | (NEG x') (POS y') => (ZPminus y' x')
-  | (NEG x') (NEG y') => (NEG (add x' y'))
-  end.
-
-Open Local Scope Z_scope.
-
-(**********************************************************************)
-(** Inductive specification of Z *)
-
-Theorem Zind : (P:(Z ->Prop))
-  (P ZERO) -> ((x:Z)(P x) ->(P (Zsucc' x))) -> ((x:Z)(P x) ->(P (Zpred' x))) ->
-     (z:Z)(P z).
-Proof.
-Intros P H0 Hs Hp z; NewDestruct z.
-  Assumption.
-  Apply Pind with P:=[p](P (POS p)).
-    Change (P (Zsucc' ZERO)); Apply Hs; Apply H0.
-    Intro n; Exact (Hs (POS n)).
-  Apply Pind with P:=[p](P (NEG p)).
-    Change (P (Zpred' ZERO)); Apply Hp; Apply H0.
-    Intro n; Exact (Hp (NEG n)).
-Qed.
-
-(**********************************************************************)
-(** Properties of opposite on binary integer numbers *)
-
-Theorem Zopp_NEG : (x:positive) (Zopp (NEG x)) = (POS x).
-Proof.
-Reflexivity.
-Qed.
-
-(** [opp] is involutive *)
-
-Theorem Zopp_Zopp: (x:Z) (Zopp (Zopp x)) = x.
-Proof.
-Intro x; NewDestruct x; Reflexivity.
-Qed.
-
-(** Injectivity of the opposite *)
-
-Theorem Zopp_intro : (x,y:Z) (Zopp x) = (Zopp y) -> x = y.
-Proof.
-Intros x y;Case x;Case y;Simpl;Intros; [
-  Trivial | Discriminate H | Discriminate H | Discriminate H
-| Simplify_eq H; Intro E; Rewrite E; Trivial
-| Discriminate H | Discriminate H | Discriminate H
-| Simplify_eq H; Intro E; Rewrite E; Trivial ].
-Qed.
-
-(**********************************************************************)
-(* Properties of the direct definition of successor and predecessor *)
-
-Lemma Zpred'_succ' : (x:Z)(Zpred' (Zsucc' x))=x.
-Proof.
-Intro x; NewDestruct x; Simpl.
-  Reflexivity.
-NewDestruct p; Simpl; Try Rewrite double_moins_un_add_un_xI; Reflexivity.
-NewDestruct p; Simpl; Try Rewrite is_double_moins_un; Reflexivity.
-Qed.
-
-Lemma Zsucc'_discr : (x:Z)x<>(Zsucc' x).
-Proof.
-Intro x; NewDestruct x; Simpl.
-  Discriminate.
-  Injection; Apply add_un_discr.
-  NewDestruct p; Simpl.
-    Discriminate.
-    Intro H; Symmetry in H; Injection H; Apply double_moins_un_xO_discr.
-    Discriminate.
-Qed.
-
-(**********************************************************************)
-(** Other properties of binary integer numbers *)
-
-Lemma ZL0 : (S (S O))=(plus (S O) (S O)).
-Proof.
-Reflexivity.
-Qed.
-
-(**********************************************************************)
-(** Properties of the addition on integers *)
-
-(** zero is left neutral for addition *)
-
-Theorem Zero_left: (x:Z) (Zplus ZERO x) = x.
-Proof.
-Intro x; NewDestruct x; Reflexivity.
-Qed.
-
-(** zero is right neutral for addition *)
-
-Theorem Zero_right: (x:Z) (Zplus x ZERO) = x.
-Proof.
-Intro x; NewDestruct x; Reflexivity.
-Qed.
-
-(** addition is commutative *)
-
-Theorem Zplus_sym: (x,y:Z) (Zplus x y) = (Zplus y x).
-Proof.
-Intro x;NewInduction x as [|p|p];Intro y; NewDestruct y as [|q|q];Simpl;Try Reflexivity.
-  Rewrite add_sym; Reflexivity.
-  Rewrite ZC4; NewDestruct (compare q p EGAL); Reflexivity.
-  Rewrite ZC4; NewDestruct (compare q p EGAL); Reflexivity.
-  Rewrite add_sym; Reflexivity.
-Qed.
-
-(** opposite distributes over addition *)
-
-Theorem Zopp_Zplus: 
-  (x,y:Z) (Zopp (Zplus x y)) = (Zplus (Zopp x) (Zopp y)).
-Proof.
-Intro x; NewDestruct x as [|p|p]; Intro y; NewDestruct y as [|q|q]; Simpl;
-  Reflexivity Orelse NewDestruct  (compare p q EGAL); Reflexivity.
-Qed.
-
-(** opposite is inverse for addition *)
-
-Theorem Zplus_inverse_r: (x:Z) (Zplus x (Zopp x)) = ZERO.
-Proof.
-Intro x; NewDestruct x as [|p|p]; Simpl; [
-  Reflexivity
-| Rewrite (convert_compare_EGAL p); Reflexivity
-| Rewrite (convert_compare_EGAL p); Reflexivity ].
-Qed.
-
-Theorem Zplus_inverse_l: (x:Z) (Zplus (Zopp x) x) = ZERO.
-Proof.
-Intro; Rewrite Zplus_sym; Apply Zplus_inverse_r.
-Qed.
-
-Hints Local Resolve Zero_left Zero_right.
-
-(** addition is associative *)
-
-Lemma weak_assoc :
-  (x,y:positive)(z:Z) (Zplus (POS x) (Zplus (POS y) z))=
-                       (Zplus (Zplus (POS x) (POS y)) z).
-Proof.
-Intros x y z';Case z'; [
-  Auto with arith
-| Intros z;Simpl; Rewrite add_assoc;Auto with arith
-| Intros z; Simpl; ElimPcompare y z;
-  Intros E0;Rewrite E0;
-  ElimPcompare '(add x y) 'z;Intros E1;Rewrite E1; [
-    Absurd (compare (add x y) z EGAL)=EGAL; [    (* Case 1 *)
-      Rewrite convert_compare_SUPERIEUR; [
-        Discriminate
-      | Rewrite convert_add; Rewrite (compare_convert_EGAL y z E0);
-        Elim (ZL4 x);Intros k E2;Rewrite E2; Simpl; Unfold gt lt; Apply le_n_S;
-        Apply le_plus_r ]
-    | Assumption ]
-  | Absurd (compare (add x y) z EGAL)=INFERIEUR; [ (* Case 2 *)
-      Rewrite convert_compare_SUPERIEUR; [
-        Discriminate
-      | Rewrite convert_add; Rewrite (compare_convert_EGAL y z E0);
-        Elim (ZL4 x);Intros k E2;Rewrite E2; Simpl; Unfold gt lt; Apply le_n_S;
-        Apply le_plus_r]
-    | Assumption ]
-  | Rewrite (compare_convert_EGAL y z E0); (* Case 3 *)
-    Elim (sub_pos_SUPERIEUR (add x z) z);[
-      Intros t H; Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
-      Unfold true_sub; Rewrite H1; Cut x=t; [
-        Intros E;Rewrite E;Auto with arith
-      | Apply simpl_add_r with z:=z; Rewrite <- H3; Rewrite add_sym; Trivial with arith ]
-    | Pattern 1 z; Rewrite <- (compare_convert_EGAL y z E0); Assumption ]
-  | Elim (sub_pos_SUPERIEUR z y); [ (* Case 4 *)
-      Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4; Unfold 1 true_sub;
-      Rewrite H1; Cut x=k; [
-        Intros E;Rewrite E; Rewrite (convert_compare_EGAL k); Trivial with arith
-      | Apply simpl_add_r with z:=y; Rewrite (add_sym k y); Rewrite H3;
-        Apply compare_convert_EGAL; Assumption ]
-    | Apply ZC2;Assumption]
-  | Elim (sub_pos_SUPERIEUR z y); [ (* Case 5 *)
-      Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
-      Unfold 1 3 5 true_sub; Rewrite H1;
-      Cut (compare x k EGAL)=INFERIEUR; [
-        Intros E2;Rewrite E2; Elim (sub_pos_SUPERIEUR k x); [
-          Intros i H5;Elim H5;Intros H6 H7;Elim H7;Intros H8 H9;
-          Elim (sub_pos_SUPERIEUR z (add x y)); [
-            Intros j H10;Elim H10;Intros H11 H12;Elim H12;Intros H13 H14;
-            Unfold true_sub ;Rewrite H6;Rewrite H11; Cut i=j; [
-              Intros E;Rewrite E;Auto with arith
-            | Apply (simpl_add_l (add x y)); Rewrite H13; 
-              Rewrite (add_sym x y); Rewrite <- add_assoc; Rewrite H8;
-              Assumption ]
-          | Apply ZC2; Assumption]
-        | Apply ZC2;Assumption]
-      | Apply convert_compare_INFERIEUR;
-        Apply simpl_lt_plus_l with p:=(convert y);
-        Do 2 Rewrite <- convert_add; Apply compare_convert_INFERIEUR;
-        Rewrite H3; Rewrite add_sym; Assumption ]
-    | Apply ZC2; Assumption ]
-  | Elim (sub_pos_SUPERIEUR z y); [ (* Case 6 *)
-      Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
-      Elim (sub_pos_SUPERIEUR (add x y) z); [
-        Intros i H5;Elim H5;Intros H6 H7;Elim H7;Intros H8 H9;
-        Unfold true_sub; Rewrite H1;Rewrite H6;
-        Cut (compare x k EGAL)=SUPERIEUR; [
-          Intros H10;Elim (sub_pos_SUPERIEUR x k H10);
-          Intros j H11;Elim H11;Intros H12 H13;Elim H13;Intros H14 H15;
-          Rewrite H10; Rewrite H12; Cut i=j; [
-            Intros H16;Rewrite H16;Auto with arith
-          | Apply (simpl_add_l (add z k)); Rewrite <- (add_assoc z k j);
-            Rewrite H14; Rewrite (add_sym z k); Rewrite <- add_assoc;
-            Rewrite H8; Rewrite (add_sym x y); Rewrite add_assoc;
-            Rewrite (add_sym k y); Rewrite H3; Trivial with arith]
-        | Apply convert_compare_SUPERIEUR; Unfold lt gt;
-          Apply simpl_lt_plus_l with p:=(convert y);
-          Do 2 Rewrite <- convert_add; Apply compare_convert_INFERIEUR;
-          Rewrite H3; Rewrite add_sym; Apply ZC1; Assumption ]
-      | Assumption ]
-    | Apply ZC2;Assumption ]
-  | Absurd (compare (add x y) z EGAL)=EGAL; [ (* Case 7 *)
-      Rewrite convert_compare_SUPERIEUR; [
-        Discriminate
-      | Rewrite convert_add; Unfold gt;Apply lt_le_trans with m:=(convert y);[
-          Apply compare_convert_INFERIEUR; Apply ZC1; Assumption
-        | Apply le_plus_r]]
-    | Assumption ]
-  | Absurd (compare (add x y) z EGAL)=INFERIEUR; [ (* Case 8 *)
-      Rewrite convert_compare_SUPERIEUR; [
-        Discriminate
-      | Unfold gt; Apply lt_le_trans with m:=(convert y);[
-          Exact (compare_convert_SUPERIEUR y z E0)
-        | Rewrite convert_add; Apply le_plus_r]]
-    | Assumption ]
-  | Elim sub_pos_SUPERIEUR with 1:=E0;Intros k H1; (* Case 9 *)
-    Elim sub_pos_SUPERIEUR with 1:=E1; Intros i H2;Elim H1;Intros H3 H4;
-    Elim H4;Intros H5 H6; Elim H2;Intros H7 H8;Elim H8;Intros H9 H10; 
-    Unfold true_sub ;Rewrite H3;Rewrite H7; Cut (add x k)=i; [
-      Intros E;Rewrite E;Auto with arith
-    | Apply (simpl_add_l z);Rewrite (add_sym x k);
-      Rewrite add_assoc; Rewrite H5;Rewrite H9;
-      Rewrite add_sym; Trivial with arith ]]].
-Qed.
-
-Hints Local Resolve weak_assoc.
-
-Theorem Zplus_assoc :
-  (n,m,p:Z) (Zplus n (Zplus m p))= (Zplus (Zplus n m) p).
-Proof.
-Intros x y z;Case x;Case y;Case z;Auto with arith; Intros; [
-  Rewrite (Zplus_sym (NEG p0)); Rewrite weak_assoc;
-  Rewrite (Zplus_sym (Zplus (POS p1) (NEG p0))); Rewrite weak_assoc;
-  Rewrite (Zplus_sym (POS p1)); Trivial with arith
-| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; 
-  Do 2 Rewrite Zopp_NEG; Rewrite Zplus_sym; Rewrite <- weak_assoc;
-  Rewrite (Zplus_sym (Zopp (POS p1)));
-  Rewrite (Zplus_sym (Zplus (POS p0) (Zopp (POS p1))));
-  Rewrite (weak_assoc p); Rewrite weak_assoc; Rewrite (Zplus_sym (POS p0)); 
-  Trivial with arith
-| Rewrite Zplus_sym; Rewrite (Zplus_sym (POS p0) (POS p));
-  Rewrite <- weak_assoc; Rewrite Zplus_sym; Rewrite (Zplus_sym (POS p0));
-  Trivial with arith
-| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; 
-  Do 2 Rewrite Zopp_NEG; Rewrite (Zplus_sym (Zopp (POS p0)));
-  Rewrite weak_assoc; Rewrite (Zplus_sym (Zplus (POS p1) (Zopp (POS p0))));
-  Rewrite weak_assoc;Rewrite (Zplus_sym (POS p)); Trivial with arith
-| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; Do 2 Rewrite Zopp_NEG;
-  Apply weak_assoc
-| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; Do 2 Rewrite Zopp_NEG;
-   Apply weak_assoc]
-.
-Qed.
-
-V7only [Notation Zplus_assoc_l := Zplus_assoc.].
-
-Lemma Zplus_assoc_r : (n,m,p:Z)(Zplus (Zplus n m) p) =(Zplus n (Zplus m p)).
-Proof.
-Intros; Symmetry; Apply Zplus_assoc.
-Qed.
-
-(** Associativity mixed with commutativity *)
-
-Theorem Zplus_permute : (n,m,p:Z) (Zplus n (Zplus m p))=(Zplus m (Zplus n p)).
-Proof.
-Intros n m p;
-Rewrite Zplus_sym;Rewrite <- Zplus_assoc; Rewrite (Zplus_sym p n); Trivial with arith.
-Qed.
-
-(** addition simplifies *)
-
-Theorem Zsimpl_plus_l : (n,m,p:Z)(Zplus n m)=(Zplus n p)->m=p.
-Intros n m p H; Cut (Zplus (Zopp n) (Zplus n m))=(Zplus (Zopp n) (Zplus n p));[
-  Do 2 Rewrite -> Zplus_assoc; Rewrite -> (Zplus_sym (Zopp n) n);
-  Rewrite -> Zplus_inverse_r;Simpl; Trivial with arith
-| Rewrite -> H; Trivial with arith ].
-Qed.
-
-(** addition and successor permutes *)
-
-Lemma Zplus_S_n: (x,y:Z) (Zplus (Zs x) y) = (Zs (Zplus x y)).
-Proof.
-Intros x y; Unfold Zs; Rewrite (Zplus_sym (Zplus x y)); Rewrite Zplus_assoc;
-Rewrite (Zplus_sym (POS xH)); Trivial with arith.
-Qed.
-
-Lemma Zplus_n_Sm : (n,m:Z) (Zs (Zplus n m))=(Zplus n (Zs m)).
-Proof.
-Intros n m; Unfold Zs; Rewrite Zplus_assoc; Trivial with arith.
-Qed.
-
-Lemma Zplus_Snm_nSm : (n,m:Z)(Zplus (Zs n) m)=(Zplus n (Zs m)).
-Proof.
-Unfold Zs ;Intros n m; Rewrite <- Zplus_assoc; Rewrite (Zplus_sym (POS xH));
-Trivial with arith.
-Qed.
-
-(** Misc properties, usually redundant or non natural *)
-
-Lemma Zplus_n_O : (n:Z) n=(Zplus n ZERO).
-Proof.
-Symmetry; Apply Zero_right.
-Qed.
-
-Lemma Zplus_unit_left : (n,m:Z) (Zplus n ZERO)=m -> n=m.
-Proof.
-Intros n m; Rewrite Zero_right; Intro; Assumption.
-Qed.
-
-Lemma Zplus_unit_right : (n,m:Z) n=(Zplus m ZERO) -> n=m.
-Proof.
-Intros n m; Rewrite Zero_right; Intro; Assumption.
-Qed.
-
-Lemma Zplus_simpl : (x,y,z,t:Z) x=y -> z=t -> (Zplus x z)=(Zplus y t).
-Proof.
-Intros; Rewrite H; Rewrite H0; Reflexivity.
-Qed.
-
-Lemma Zplus_Zopp_expand : (x,y,z:Z)
-  (Zplus x (Zopp y))=(Zplus (Zplus x (Zopp z)) (Zplus z (Zopp y))).
-Proof.
-Intros x y z.
-Rewrite <- (Zplus_assoc x).
-Rewrite (Zplus_assoc (Zopp z)).
-Rewrite Zplus_inverse_l.
-Reflexivity.
-Qed.
-
-(**********************************************************************)
-(** Properties of successor and predecessor on binary integer numbers *)
-
-Theorem Zn_Sn : (x:Z) ~ x=(Zs x).
-Proof.
-Intros n;Cut ~ZERO=(POS xH);[
-  Unfold not ;Intros H1 H2;Apply H1;Apply (Zsimpl_plus_l n);Rewrite Zero_right;
-  Exact H2
-| Discriminate ].
-Qed.
-
-Theorem add_un_Zs : (x:positive) (POS (add_un x)) = (Zs (POS x)).
-Proof.
-Intro; Rewrite -> ZL12; Unfold Zs; Simpl; Trivial with arith.
-Qed.
-
-(** successor and predecessor are inverse functions *)
-
-Theorem Zs_pred : (n:Z) n=(Zs (Zpred n)).
-Proof.
-Intros n; Unfold Zs Zpred ;Rewrite <- Zplus_assoc; Simpl; Rewrite Zero_right;
-Trivial with arith.
-Qed. 
-
-Hints Immediate Zs_pred : zarith.
- 
-Theorem Zpred_Sn : (x:Z) x=(Zpred (Zs x)).
-Proof.
-Intros m; Unfold Zpred Zs; Rewrite <- Zplus_assoc; Simpl; 
-Rewrite Zplus_sym; Auto with arith.
-Qed.
-
-Theorem Zeq_add_S : (n,m:Z) (Zs n)=(Zs m) -> n=m.
-Proof.
-Intros n m H.
-Change (Zplus (Zplus (NEG xH) (POS xH)) n)=
-       (Zplus (Zplus (NEG xH) (POS xH)) m);
-Do 2 Rewrite <- Zplus_assoc; Do 2 Rewrite (Zplus_sym (POS xH));
-Unfold Zs in H;Rewrite H; Trivial with arith.
-Qed.
- 
-(** Misc properties, usually redundant or non natural *)
-
-Lemma Zeq_S : (n,m:Z) n=m -> (Zs n)=(Zs m).
-Proof.
-Intros n m H; Rewrite H; Reflexivity.
-Qed.
-
-Lemma Znot_eq_S : (n,m:Z) ~(n=m) -> ~((Zs n)=(Zs m)).
-Proof.
-Unfold not ;Intros n m H1 H2;Apply H1;Apply Zeq_add_S; Assumption.
-Qed.
-
-(**********************************************************************)
-(** Properties of subtraction on binary integer numbers *)
-
-Lemma Zminus_0_r : (x:Z) (Zminus x ZERO)=x.
-Proof.
-Intro; Unfold Zminus; Simpl;Rewrite Zero_right; Trivial with arith.
-Qed.
-
-Lemma Zminus_n_O : (x:Z) x=(Zminus x ZERO).
-Proof.
-Intro; Symmetry; Apply Zminus_0_r.
-Qed.
-
-Lemma Zminus_diag : (n:Z)(Zminus n n)=ZERO.
-Proof.
-Intro; Unfold Zminus; Rewrite Zplus_inverse_r; Trivial with arith.
-Qed.
-
-Lemma Zminus_n_n : (n:Z)(ZERO=(Zminus n n)).
-Proof.
-Intro; Symmetry; Apply Zminus_diag.
-Qed.
-
-Lemma Zplus_minus : (x,y,z:Z)(x=(Zplus y z))->(z=(Zminus x y)).
-Proof.
-Intros n m p H;Unfold Zminus;Apply (Zsimpl_plus_l m); 
-Rewrite (Zplus_sym m (Zplus n (Zopp m))); Rewrite <- Zplus_assoc;
-Rewrite Zplus_inverse_l; Rewrite Zero_right; Rewrite H; Trivial with arith.
-Qed.
-
-Lemma Zminus_plus : (x,y:Z)(Zminus (Zplus x y) x)=y.
-Proof.
-Intros n m;Unfold Zminus ;Rewrite -> (Zplus_sym n m);Rewrite <- Zplus_assoc;
-Rewrite -> Zplus_inverse_r; Apply Zero_right.
-Qed.
-
-Lemma Zle_plus_minus : (n,m:Z) (Zplus n (Zminus m n))=m.
-Proof.
-Unfold Zminus; Intros n m; Rewrite Zplus_permute; Rewrite Zplus_inverse_r;
-Apply Zero_right.
-Qed.
-
-Lemma Zminus_Sn_m : (n,m:Z)((Zs (Zminus n m))=(Zminus (Zs n) m)).
-Proof.
-Intros n m;Unfold Zminus Zs; Rewrite (Zplus_sym n (Zopp m));
-Rewrite <- Zplus_assoc;Apply Zplus_sym.
-Qed.
-
-Lemma Zminus_plus_simpl_l : 
-  (x,y,z:Z)(Zminus (Zplus z x) (Zplus z y))=(Zminus x y).
-Proof.
-Intros n m p;Unfold Zminus; Rewrite Zopp_Zplus; Rewrite Zplus_assoc;
-Rewrite (Zplus_sym p); Rewrite <- (Zplus_assoc n p); Rewrite Zplus_inverse_r;
-Rewrite Zero_right; Trivial with arith.
-Qed.
-
-Lemma Zminus_plus_simpl : 
-  (x,y,z:Z)((Zminus x y)=(Zminus (Zplus z x) (Zplus z y))).
-Proof.
-Intros; Symmetry; Apply Zminus_plus_simpl_l.
-Qed.
-
-Lemma Zminus_Zplus_compatible :
-  (x,y,z:Z) (Zminus (Zplus x z) (Zplus y z)) = (Zminus x y).
-Intros x y n.
-Unfold Zminus.
-Rewrite -> Zopp_Zplus.
-Rewrite -> (Zplus_sym (Zopp y) (Zopp n)).
-Rewrite -> Zplus_assoc.
-Rewrite <- (Zplus_assoc x n (Zopp n)).
-Rewrite -> (Zplus_inverse_r n).
-Rewrite <- Zplus_n_O.
-Reflexivity.
-Qed.
-
-(** Misc redundant properties *)
-
-V7only [Set Implicit Arguments.].
-
-Lemma Zeq_Zminus : (x,y:Z)x=y -> (Zminus x y)=ZERO.
-Proof.
-Intros x y H; Rewrite H; Symmetry; Apply Zminus_n_n.
-Qed.
-
-Lemma Zminus_Zeq : (x,y:Z)(Zminus x y)=ZERO -> x=y.
-Proof.
-Intros x y H; Rewrite <- (Zle_plus_minus y x); Rewrite H; Apply Zero_right.
-Qed.
-
-V7only [Unset Implicit Arguments.].
-
-(**********************************************************************)
-(** Properties of multiplication on binary integer numbers *)
-
-(** One is neutral for multiplication *)
-
-Theorem Zmult_1_n : (n:Z)(Zmult (POS xH) n)=n.
-Proof.
-Intro x; NewDestruct x; Reflexivity.
-Qed.
-V7only [Notation Zmult_one := Zmult_1_n.].
-
-Theorem Zmult_n_1 : (n:Z)(Zmult n (POS xH))=n.
-Proof.
-Intro x; NewDestruct x; Simpl; Try Rewrite times_x_1; Reflexivity.
-Qed.
-
-(** Zero property of multiplication *)
-
-Theorem Zero_mult_left: (x:Z) (Zmult ZERO x) = ZERO.
-Proof.
-Intro x; NewDestruct x; Reflexivity.
-Qed.
-
-Theorem Zero_mult_right: (x:Z) (Zmult x ZERO) = ZERO.
-Proof.
-Intro x; NewDestruct x; Reflexivity.
-Qed.
-
-Hints Local Resolve Zero_mult_left Zero_mult_right.
-
-Lemma Zmult_n_O : (n:Z) ZERO=(Zmult n ZERO).
-Proof.
-Intro x; NewDestruct x; Reflexivity.
-Qed.
-
-(** Commutativity of multiplication *)
-
-Theorem Zmult_sym : (x,y:Z) (Zmult x y) = (Zmult y x).
-Proof.
-Intros x y; NewDestruct x as [|p|p]; NewDestruct y as [|q|q]; Simpl; 
-  Try Rewrite (times_sym p q); Reflexivity.
-Qed.
-
-(** Associativity of multiplication *)
-
-Theorem Zmult_assoc :
-  (x,y,z:Z) (Zmult x (Zmult y z))= (Zmult (Zmult x y) z).
-Proof.
-Intros x y z; NewDestruct x; NewDestruct y; NewDestruct z; Simpl; 
-  Try Rewrite times_assoc; Reflexivity.
-Qed.
-V7only [Notation Zmult_assoc_l := Zmult_assoc.].
-
-Lemma Zmult_assoc_r : (n,m,p:Z)((Zmult (Zmult n m) p) = (Zmult n (Zmult m p))).
-Proof.
-Intros n m p; Rewrite Zmult_assoc; Trivial with arith.
-Qed.
-
-(** Associativity mixed with commutativity *)
-
-Theorem Zmult_permute : (n,m,p:Z)(Zmult n (Zmult m p)) = (Zmult m (Zmult n p)).
-Proof.
-Intros x y z; Rewrite -> (Zmult_assoc y x z); Rewrite -> (Zmult_sym y x).
-Apply Zmult_assoc.
-Qed.
-
-(** Z is integral *)
-
-Theorem Zmult_eq: (x,y:Z) ~(x=ZERO) -> (Zmult y x) = ZERO -> y = ZERO.
-Proof.
-Intros x y; NewDestruct x as [|p|p].
-  Intro H; Absurd ZERO=ZERO; Trivial.
-  Intros _ H; NewDestruct y as [|q|q]; Reflexivity Orelse Discriminate.
-  Intros _ H; NewDestruct y as [|q|q]; Reflexivity Orelse Discriminate.
-Qed.
-
-V7only [Set Implicit Arguments.].
-
-Theorem Zmult_zero : (x,y:Z)(Zmult x y)=ZERO -> x=ZERO \/ y=ZERO.
-Proof.
-Intros x y; NewDestruct x; NewDestruct y; Auto; Simpl; Intro H; Discriminate H.
-Qed.
-
-V7only [Unset Implicit Arguments.].
-
-Lemma Zmult_1_inversion_l : 
- (x,y:Z) (Zmult x y)=(POS xH) -> x=(POS xH) \/ x=(NEG xH).
-Proof.
-Intros x y; NewDestruct x as [|p|p]; Intro; [ Discriminate | Left | Right ];
-  (NewDestruct y as [|q|q]; Try Discriminate;
-  Simpl in H; Injection H; Clear H; Intro H;
-  Rewrite times_one_inversion_l with 1:=H; Reflexivity).
-Qed.
-
-(** Multiplication and Opposite *)
-
-Theorem Zopp_Zmult_l : (x,y:Z)(Zopp (Zmult x y)) = (Zmult (Zopp x) y).
-Proof.
-Intros x y; NewDestruct x; NewDestruct y; Reflexivity.
-Qed.
-
-Theorem Zopp_Zmult_r : (x,y:Z)(Zopp (Zmult x y)) = (Zmult x (Zopp y)).
-Intros x y; Rewrite (Zmult_sym x y); Rewrite Zopp_Zmult_l; Apply Zmult_sym.
-Qed.
-
-Lemma Zopp_Zmult: (x,y:Z) (Zmult (Zopp x) y) = (Zopp (Zmult x y)).
-Proof.
-Intros x y; Symmetry; Apply Zopp_Zmult_l.
-Qed.
-
-Theorem Zmult_Zopp_left :  (x,y:Z)(Zmult (Zopp x) y) = (Zmult x (Zopp y)).
-Intros x y; Rewrite Zopp_Zmult; Rewrite Zopp_Zmult_r; Trivial with arith.
-Qed.
-
-Theorem Zmult_Zopp_Zopp: (x,y:Z) (Zmult (Zopp x) (Zopp y)) = (Zmult x y).
-Proof.
-Intros x y; NewDestruct x; NewDestruct y; Reflexivity.
-Qed.
-
-Theorem Zopp_one : (x:Z)(Zopp x)=(Zmult x (NEG xH)).
-Intro x; NewInduction x; Intros; Rewrite Zmult_sym; Auto with arith.
-Qed.
-
-(** Distributivity of multiplication over addition *)
-
-Lemma weak_Zmult_plus_distr_r:
-  (x:positive)(y,z:Z)
-   (Zmult (POS x) (Zplus y z)) = (Zplus (Zmult (POS x) y) (Zmult (POS x) z)).
-Proof.
-Intros x y' z';Case y';Case z';Auto with arith;Intros y z;
-  (Simpl; Rewrite times_add_distr; Trivial with arith)
-Orelse
-  (Simpl; ElimPcompare z y; Intros E0;Rewrite E0; [
-    Rewrite (compare_convert_EGAL z y E0);
-    Rewrite (convert_compare_EGAL (times x y)); Trivial with arith
-  | Cut (compare (times x z) (times x y) EGAL)=INFERIEUR; [
-      Intros E;Rewrite E; Rewrite times_true_sub_distr; [
-        Trivial with arith
-      | Apply ZC2;Assumption ]
-    | Apply convert_compare_INFERIEUR;Do 2 Rewrite times_convert; 
-      Elim (ZL4 x);Intros h H1;Rewrite H1;Apply lt_mult_left;
-      Exact (compare_convert_INFERIEUR z y E0)]
-  | Cut (compare (times x z) (times x y) EGAL)=SUPERIEUR; [
-      Intros E;Rewrite E; Rewrite times_true_sub_distr; Auto with arith
-    | Apply convert_compare_SUPERIEUR; Unfold gt; Do 2 Rewrite times_convert;
-      Elim (ZL4 x);Intros h H1;Rewrite H1;Apply lt_mult_left;
-      Exact (compare_convert_SUPERIEUR z y E0) ]]).
-Qed.
-
-Theorem Zmult_plus_distr_r:
-  (x,y,z:Z) (Zmult x (Zplus y z)) = (Zplus (Zmult x y) (Zmult x z)).
-Proof.
-Intros x y z; Case x; [
-  Auto with arith
-| Intros x';Apply weak_Zmult_plus_distr_r
-| Intros p; Apply Zopp_intro; Rewrite Zopp_Zplus; 
-  Do 3 Rewrite <- Zopp_Zmult; Rewrite Zopp_NEG; 
-  Apply weak_Zmult_plus_distr_r ].
-Qed.
-
-Theorem Zmult_plus_distr_l : 
-  (n,m,p:Z)((Zmult (Zplus n m) p)=(Zplus (Zmult n p) (Zmult m p))).
-Proof.
-Intros n m p;Rewrite Zmult_sym;Rewrite Zmult_plus_distr_r; 
-Do 2 Rewrite -> (Zmult_sym p); Trivial with arith.
-Qed.
-
-(** Distributivity of multiplication over subtraction *)
-
-Lemma Zmult_Zminus_distr_l :
-  (x,y,z:Z)((Zmult (Zminus x y) z)=(Zminus (Zmult x z) (Zmult y z))).
-Proof.
-Intros x y z; Unfold Zminus.
-Rewrite <- Zopp_Zmult.
-Apply Zmult_plus_distr_l.
-Qed.
-
-V7only [Notation Zmult_minus_distr := Zmult_Zminus_distr_l.].
- 
-Lemma  Zmult_Zminus_distr_r :
-  (x,y,z:Z)(Zmult z (Zminus x y)) = (Zminus (Zmult z x) (Zmult z y)).
-Proof.
-Intros x y z; Rewrite (Zmult_sym z (Zminus x y)).
-Rewrite (Zmult_sym  z x).
-Rewrite (Zmult_sym z y).
-Apply Zmult_Zminus_distr_l.
-Qed.
-
-(** Simplification of multiplication for non-zero integers *)
-V7only [Set Implicit Arguments.].
-
-Lemma Zmult_reg_left : (x,y,z:Z) z<>ZERO -> (Zmult z x)=(Zmult z y) -> x=y.
-Proof.
-Intros x y z H H0.
-Generalize (Zeq_Zminus H0).
-Intro.
-Apply Zminus_Zeq.
-Rewrite <- Zmult_Zminus_distr_r in H1.
-Clear H0; NewDestruct (Zmult_zero H1).
-Contradiction.
-Trivial.
-Qed.
-
-Lemma Zmult_reg_right : (x,y,z:Z) z<>ZERO -> (Zmult x z)=(Zmult y z) -> x=y.
-Proof.
-Intros x y z Hz.
-Rewrite (Zmult_sym x z).
-Rewrite (Zmult_sym y z).
-Intro; Apply Zmult_reg_left with z; Assumption.
-Qed.
-V7only [Unset Implicit Arguments.].
-
-(** Addition and multiplication by 2 *)
-
-Lemma Zplus_Zmult_2 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))).
-Proof.
-Intros x; Pattern 1 2 x ; Rewrite <- (Zmult_n_1 x);
-Rewrite <- Zmult_plus_distr_r; Reflexivity.
-Qed.
-
-(** Multiplication and successor *)
-
-Lemma Zmult_succ_r : (n,m:Z) (Zmult n (Zs m))=(Zplus (Zmult n m) n).
-Proof.
-Intros n m;Unfold Zs; Rewrite Zmult_plus_distr_r;
-Rewrite (Zmult_sym n (POS xH));Rewrite Zmult_one; Trivial with arith.
-Qed.
-
-Lemma Zmult_n_Sm : (n,m:Z) (Zplus (Zmult n m) n)=(Zmult n (Zs m)).
-Proof.
-Intros; Symmetry; Apply Zmult_succ_r.
-Qed.
-
-Lemma Zmult_succ_l : (n,m:Z) (Zmult (Zs n) m)=(Zplus (Zmult n m) m).
-Proof.
-Intros n m; Unfold Zs; Rewrite Zmult_plus_distr_l; Rewrite Zmult_1_n;
-Trivial with arith.
-Qed.
-
-Lemma Zmult_Sm_n : (n,m:Z) (Zplus (Zmult n m) m)=(Zmult (Zs n) m).
-Proof.
-Intros; Symmetry; Apply Zmult_succ_l.
-Qed.
-
-(** Misc redundant properties *)
-
-Lemma Z_eq_mult:
-  (x,y:Z)  y = ZERO -> (Zmult y x) = ZERO.
-Intros x y H; Rewrite H; Auto with arith.
-Qed.
-
-(**********************************************************************)
-(** Relating binary positive numbers and binary integers *)
-
-Lemma POS_xI : (p:positive) (POS (xI p))=(Zplus (Zmult (POS (xO xH)) (POS p)) (POS xH)).
-Proof.
-Intro; Apply refl_equal.
-Qed.
-
-Lemma POS_xO : (p:positive) (POS (xO p))=(Zmult (POS (xO xH)) (POS p)).
-Proof.
-Intro; Apply refl_equal.
-Qed.
-
-Lemma NEG_xI : (p:positive) (NEG (xI p))=(Zminus (Zmult (POS (xO xH)) (NEG p)) (POS xH)).
-Proof.
-Intro; Apply refl_equal.
-Qed.
-
-Lemma NEG_xO : (p:positive) (NEG (xO p))=(Zmult (POS (xO xH)) (NEG p)).
-Proof.
-Reflexivity.
-Qed.
-
-Lemma POS_add : (p,p':positive)(POS (add p p'))=(Zplus (POS p) (POS p')).
-Proof.
-Intros p p'; NewDestruct p; NewDestruct p'; Reflexivity.
-Qed.
-
-Lemma NEG_add : (p,p':positive)(NEG (add p p'))=(Zplus (NEG p) (NEG p')).
-Proof.
-Intros p p'; NewDestruct p; NewDestruct p'; Reflexivity.
-Qed.
-
-(**********************************************************************)
-(** Order relations *)
-
-Definition Zlt := [x,y:Z](Zcompare x y) = INFERIEUR.
-Definition Zgt := [x,y:Z](Zcompare x y) = SUPERIEUR.
-Definition Zle := [x,y:Z]~(Zcompare x y) = SUPERIEUR.
-Definition Zge := [x,y:Z]~(Zcompare x y) = INFERIEUR.
-Definition Zne := [x,y:Z] ~(x=y).
-
-V8Infix "<=" Zle : Z_scope.
-V8Infix "<"  Zlt : Z_scope.
-V8Infix ">=" Zge : Z_scope.
-V8Infix ">"  Zgt : Z_scope.
-
-V8Notation "x <= y <= z" := (Zle x y)/\(Zle y z) :Z_scope.
-V8Notation "x <= y < z"  := (Zle x y)/\(Zlt y z) :Z_scope.
-V8Notation  "x < y < z"  := (Zlt x y)/\(Zlt y z) :Z_scope.
-V8Notation  "x < y <= z" := (Zlt x y)/\(Zle y z) :Z_scope.
-
-(**********************************************************************)
-(** Absolute value on integers *)
-
-Definition absolu [x:Z] : nat :=
-  Cases x of
-     ZERO   => O
-  | (POS p) => (convert p)
-  | (NEG p) => (convert p)
-  end.
-
-Definition Zabs [z:Z] : Z :=
-  Cases z of 
-     ZERO   => ZERO
-  | (POS p) => (POS p)
-  | (NEG p) => (POS p)
-  end.
-
-(**********************************************************************)
-(** From [nat] to [Z] *)
-
-Definition inject_nat := 
-  [x:nat]Cases x of
-           O => ZERO
-         | (S y) => (POS (anti_convert y))
-         end.
-
-Require BinNat.
-
-Definition entier_of_Z :=
-  [z:Z]Cases z of ZERO => Nul | (POS p) => (Pos p) | (NEG p) => (Pos p) end.
-
-Definition Z_of_entier :=
-  [x:entier]Cases x of Nul => ZERO | (Pos p) => (POS p) end.
diff --git a/theories7/ZArith/Wf_Z.v b/theories7/ZArith/Wf_Z.v
deleted file mode 100644
index e6cf4610..00000000
--- a/theories7/ZArith/Wf_Z.v
+++ /dev/null
@@ -1,194 +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: Wf_Z.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-Require BinInt.
-Require Zcompare.
-Require Zorder.
-Require Znat.
-Require Zmisc.
-Require Zsyntax.
-Require Wf_nat.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-(** Our purpose is to write an induction shema for {0,1,2,...}
-  similar to the [nat] schema (Theorem [Natlike_rec]). For that the
-  following implications will be used :
-<<
- (n:nat)(Q n)==(n:nat)(P (inject_nat n)) ===> (x:Z)`x > 0) -> (P x)
-
-       	     /\
-             ||
-             ||
-
-  (Q O) (n:nat)(Q n)->(Q (S n)) <=== (P 0) (x:Z) (P x) -> (P (Zs x))
-
-      	       	       	       	<=== (inject_nat (S n))=(Zs (inject_nat n))
-
-      	       	       	       	<=== inject_nat_complete
->>
-  Then the  diagram will be closed and the theorem proved. *)
-
-Lemma inject_nat_complete :
-  (x:Z)`0 <= x` -> (EX n:nat | x=(inject_nat n)).
-Intro x; NewDestruct x; Intros;
-[ Exists  O; Auto with arith
-| Specialize (ZL4 p); Intros Hp; Elim Hp; Intros;
-  Exists (S x); Intros; Simpl;
-  Specialize (bij1 x); Intro Hx0;
-  Rewrite <- H0 in Hx0;
-  Apply f_equal with f:=POS;
-  Apply convert_intro; Auto with arith
-| Absurd `0 <= (NEG p)`;
-  [ Unfold Zle; Simpl; Do 2 (Unfold not); Auto with arith
-  | Assumption]
-].
-Qed.
-
-Lemma ZL4_inf: (y:positive) { h:nat | (convert y)=(S h) }.
-Intro y; NewInduction y as [p H|p H1|]; [
-  Elim H; Intros x H1; Exists (plus (S x) (S x));
-  Unfold convert ;Simpl; Rewrite ZL0; Rewrite ZL2; Unfold convert in H1;
-  Rewrite H1; Auto with arith
-| Elim H1;Intros x H2; Exists (plus x (S x)); Unfold convert;
-  Simpl; Rewrite ZL0; Rewrite ZL2;Unfold convert in H2; Rewrite H2; Auto with arith
-| Exists O ;Auto with arith].
-Qed.
-
-Lemma inject_nat_complete_inf :
-  (x:Z)`0 <= x` -> { n:nat | (x=(inject_nat n)) }.
-Intro x; NewDestruct x; Intros;
-[ Exists  O; Auto with arith
-| Specialize (ZL4_inf p); Intros Hp; Elim Hp; Intros x0 H0;
-  Exists (S x0); Intros; Simpl;
-  Specialize (bij1 x0); Intro Hx0;
-  Rewrite <- H0 in Hx0;
-  Apply f_equal with f:=POS;
-  Apply convert_intro; Auto with arith
-| Absurd `0 <= (NEG p)`;
-  [ Unfold Zle; Simpl; Do 2 (Unfold not); Auto with arith
-  | Assumption]
-].
-Qed.
-
-Lemma inject_nat_prop :
-  (P:Z->Prop)((n:nat)(P (inject_nat n))) -> 
-    (x:Z) `0 <= x` -> (P x).
-Intros P H x H0.
-Specialize (inject_nat_complete x H0).
-Intros Hn; Elim Hn; Intros.
-Rewrite -> H1; Apply H.
-Qed.
-
-Lemma inject_nat_set :
-  (P:Z->Set)((n:nat)(P (inject_nat n))) -> 
-    (x:Z) `0 <= x` -> (P x).
-Intros P H x H0.
-Specialize (inject_nat_complete_inf x H0).
-Intros Hn; Elim Hn; Intros.
-Rewrite -> p; Apply H.
-Qed.
-
-Lemma natlike_ind : (P:Z->Prop) (P `0`) ->
-  ((x:Z)(`0 <= x` -> (P x) -> (P (Zs x)))) ->
-  (x:Z) `0 <= x` -> (P x).
-Intros P H H0 x H1; Apply inject_nat_prop;
-[ Induction n;
-  [ Simpl; Assumption
-  | Intros; Rewrite -> (inj_S n0);
-    Exact (H0 (inject_nat n0) (ZERO_le_inj n0) H2) ]
-| Assumption].
-Qed.
-
-Lemma natlike_rec : (P:Z->Set) (P `0`) ->
-  ((x:Z)(`0 <= x` -> (P x) -> (P (Zs x)))) ->
-  (x:Z) `0 <= x` -> (P x).
-Intros P H H0 x H1; Apply inject_nat_set;
-[ Induction n;
-  [ Simpl; Assumption
-  | Intros; Rewrite -> (inj_S n0);
-    Exact (H0 (inject_nat n0) (ZERO_le_inj n0) H2) ]
-| Assumption].
-Qed.
-
-Section Efficient_Rec. 
-
-(** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed 
-     to give a better extracted term. *)
-
-Local R := [a,b:Z]`0<=a`/\`a<b`.
-
-Local R_wf : (well_founded Z R).
-Proof.
-LetTac f := [z]Cases z of (POS p) => (convert p) | ZERO => O | (NEG _) => O end.
-Apply  well_founded_lt_compat with f.
-Unfold R f; Clear f R.
-Intros x y; Case x; Intros; Elim H; Clear H.
-Case y; Intros; Apply compare_convert_O Orelse Inversion H0.
-Case y; Intros; Apply compare_convert_INFERIEUR Orelse Inversion H0; Auto.
-Intros; Elim H; Auto.
-Qed.
-
-Lemma natlike_rec2 : (P:Z->Type)(P `0`) -> 
-        ((z:Z)`0<=z` -> (P z) -> (P (Zs z))) -> (z:Z)`0<=z` -> (P z).
-Proof.
-Intros P Ho Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
-Intro x; Case x.
-Trivial.
-Intros.
-Assert `0<=(Zpred (POS p))`.
-Apply Zlt_ZERO_pred_le_ZERO; Unfold Zlt; Simpl; Trivial.
-Rewrite Zs_pred.
-Apply Hrec.
-Auto.
-Apply X; Auto; Unfold R; Intuition; Apply Zlt_pred_n_n.
-Intros; Elim H; Simpl; Trivial.
-Qed.
-
-(** A variant of the previous using [Zpred] instead of [Zs]. *)
-
-Lemma natlike_rec3 : (P:Z->Type)(P `0`) -> 
-        ((z:Z)`0<z` -> (P (Zpred z)) -> (P z)) -> (z:Z)`0<=z` -> (P z).
-Proof.
-Intros P Ho Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
-Intro x; Case x.
-Trivial.
-Intros; Apply Hrec.
-Unfold Zlt; Trivial.
-Assert `0<=(Zpred (POS p))`.
-Apply Zlt_ZERO_pred_le_ZERO; Unfold Zlt; Simpl; Trivial.
-Apply X; Auto; Unfold R; Intuition; Apply Zlt_pred_n_n.
-Intros; Elim H; Simpl; Trivial.
-Qed.
-
-(** A more general induction principal using [Zlt]. *)
-
-Lemma Z_lt_rec : (P:Z->Type)
- ((x:Z)((y:Z)`0 <= y < x`->(P y))->(P x)) -> (x:Z)`0 <= x`->(P x).
-Proof.
-Intros P Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
-Intro x; Case x; Intros.
-Apply Hrec; Intros.
-Assert H2: `0<0`.
-  Apply Zle_lt_trans with y; Intuition.
-Inversion H2.
-Firstorder.
-Unfold Zle Zcompare in H; Elim H; Auto.
-Defined.
-
-Lemma Z_lt_induction : 
-  (P:Z->Prop)
-     ((x:Z)((y:Z)`0 <= y < x`->(P y))->(P x))
-  -> (x:Z)`0 <= x`->(P x).
-Proof.
-Exact Z_lt_rec.
-Qed.
-
-End Efficient_Rec.
diff --git a/theories7/ZArith/ZArith_base.v b/theories7/ZArith/ZArith_base.v
deleted file mode 100644
index 7f2863d6..00000000
--- a/theories7/ZArith/ZArith_base.v
+++ /dev/null
@@ -1,39 +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        *)
-(************************************************************************)
-
-(* $Id: ZArith_base.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ *)
-
-(** Library for manipulating integers based on binary encoding.
-    These are the basic modules, required by [Omega] and [Ring] for instance. 
-    The full library is [ZArith]. *)
-
-V7only [
-Require Export fast_integer.
-Require Export zarith_aux.
-].
-Require Export BinPos.
-Require Export BinNat.
-Require Export BinInt.
-Require Export Zcompare.
-Require Export Zorder.
-Require Export Zeven.
-Require Export Zmin.
-Require Export Zabs.
-Require Export Znat.
-Require Export auxiliary.
-Require Export Zsyntax.
-Require Export ZArith_dec.
-Require Export Zbool.
-Require Export Zmisc.
-Require Export Wf_Z.
-
-Hints Resolve Zle_n Zplus_sym Zplus_assoc Zmult_sym Zmult_assoc
-  Zero_left Zero_right Zmult_one Zplus_inverse_l Zplus_inverse_r 
-  Zmult_plus_distr_l Zmult_plus_distr_r : zarith.
-
-Require Export Zhints.
diff --git a/theories7/ZArith/ZArith_dec.v b/theories7/ZArith/ZArith_dec.v
deleted file mode 100644
index 985f7601..00000000
--- a/theories7/ZArith/ZArith_dec.v
+++ /dev/null
@@ -1,243 +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: ZArith_dec.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-Require Sumbool.
-
-Require BinInt.
-Require Zorder.
-Require Zcompare.
-Require Zsyntax.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-Lemma Dcompare_inf : (r:relation) {r=EGAL} + {r=INFERIEUR} + {r=SUPERIEUR}.
-Proof.
-Induction r; Auto with arith. 
-Defined.
-
-Lemma Zcompare_rec :
-  (P:Set)(x,y:Z)
-    ((Zcompare x y)=EGAL -> P) ->
-    ((Zcompare x y)=INFERIEUR -> P) ->
-    ((Zcompare x y)=SUPERIEUR -> P) ->
-    P.
-Proof.
-Intros P x y H1 H2 H3.
-Elim (Dcompare_inf (Zcompare x y)).
-Intro H. Elim H; Auto with arith. Auto with arith.
-Defined.
-
-Section decidability.
-
-Variables x,y : Z.
-
-(** Decidability of equality on binary integers *)
-
-Definition Z_eq_dec : {x=y}+{~x=y}.
-Proof.
-Apply Zcompare_rec with x:=x y:=y.
-Intro. Left. Elim (Zcompare_EGAL x y); Auto with arith.
-Intro H3. Right. Elim (Zcompare_EGAL x y). Intros H1 H2. Unfold not. Intro H4.
-  Rewrite (H2 H4) in H3. Discriminate H3.
-Intro H3. Right. Elim (Zcompare_EGAL x y). Intros H1 H2. Unfold not. Intro H4.
-  Rewrite (H2 H4) in H3. Discriminate H3.
-Defined. 
-
-(** Decidability of order on binary integers *)
-
-Definition Z_lt_dec : {(Zlt x y)}+{~(Zlt x y)}.
-Proof.
-Unfold Zlt.
-Apply Zcompare_rec with x:=x y:=y; Intro H.
-Right. Rewrite H. Discriminate.
-Left; Assumption.
-Right. Rewrite H. Discriminate.
-Defined.
-
-Definition Z_le_dec : {(Zle x y)}+{~(Zle x y)}.
-Proof.
-Unfold Zle.
-Apply Zcompare_rec with x:=x y:=y; Intro H.
-Left. Rewrite H. Discriminate.
-Left. Rewrite H. Discriminate.
-Right. Tauto.
-Defined.
-
-Definition Z_gt_dec : {(Zgt x y)}+{~(Zgt x y)}.
-Proof.
-Unfold Zgt.
-Apply Zcompare_rec with x:=x y:=y; Intro H.
-Right. Rewrite H. Discriminate.
-Right. Rewrite H. Discriminate.
-Left; Assumption.
-Defined.
-
-Definition Z_ge_dec : {(Zge x y)}+{~(Zge x y)}.
-Proof.
-Unfold Zge.
-Apply Zcompare_rec with x:=x y:=y; Intro H.
-Left. Rewrite H. Discriminate.
-Right. Tauto.
-Left. Rewrite H. Discriminate.
-Defined.
-
-Definition Z_lt_ge_dec : {`x < y`}+{`x >= y`}.
-Proof.
-Exact Z_lt_dec.
-Defined.
-
-V7only [ (* From Zextensions *) ].
-Lemma Z_lt_le_dec: {`x < y`}+{`y <= x`}.
-Proof.
-Intros.
-Elim Z_lt_ge_dec.
-Intros; Left; Assumption.
-Intros; Right; Apply Zge_le; Assumption.
-Qed.
-
-Definition Z_le_gt_dec : {`x <= y`}+{`x > y`}.
-Proof.
-Elim Z_le_dec; Auto with arith.
-Intro. Right. Apply not_Zle; Auto with arith.
-Defined.
-
-Definition Z_gt_le_dec : {`x > y`}+{`x <= y`}.
-Proof.
-Exact Z_gt_dec.
-Defined.
-
-Definition Z_ge_lt_dec : {`x >= y`}+{`x < y`}.
-Proof.
-Elim Z_ge_dec; Auto with arith.
-Intro. Right. Apply not_Zge; Auto with arith.
-Defined.
-
-Definition Z_le_lt_eq_dec : `x <= y` -> {`x < y`}+{x=y}.
-Proof.
-Intro H.
-Apply Zcompare_rec with x:=x y:=y.
-Intro. Right. Elim (Zcompare_EGAL x y); Auto with arith.
-Intro. Left. Elim (Zcompare_EGAL x y); Auto with arith.
-Intro H1. Absurd `x > y`; Auto with arith.
-Defined.
-
-End decidability.
-
-(** Cotransitivity of order on binary integers *)
-
-Lemma Zlt_cotrans:(n,m:Z)`n<m`->(p:Z){`n<p`}+{`p<m`}.
-Proof.
- Intros x y H z.
- Case (Z_lt_ge_dec x z).
- Intro.
- Left.
- Assumption.
- Intro.
- Right.
- Apply Zle_lt_trans with m:=x.
- Apply Zge_le.
- Assumption.
- Assumption.
-Defined.
-
-Lemma Zlt_cotrans_pos:(x,y:Z)`0<x+y`->{`0<x`}+{`0<y`}.
-Proof.
- Intros x y H.
- Case (Zlt_cotrans `0` `x+y` H x).
- Intro.
- Left.
- Assumption.
- Intro.
- Right.
- Apply Zsimpl_lt_plus_l with p:=`x`.
- Rewrite Zero_right.
- Assumption.
-Defined.
-
-Lemma Zlt_cotrans_neg:(x,y:Z)`x+y<0`->{`x<0`}+{`y<0`}.
-Proof.
- Intros x y H;
- Case (Zlt_cotrans `x+y` `0` H x);
- Intro Hxy;
- [ Right;
-   Apply Zsimpl_lt_plus_l with p:=`x`;
-   Rewrite Zero_right
- | Left
- ];
- Assumption.
-Defined.
-
-Lemma not_Zeq_inf:(x,y:Z)`x<>y`->{`x<y`}+{`y<x`}.
-Proof.
- Intros x y H.
- Case Z_lt_ge_dec with x y.
- Intro.
- Left.
- Assumption.
- Intro H0.
- Generalize (Zge_le ? ? H0).
- Intro.
- Case (Z_le_lt_eq_dec ? ? H1).
- Intro.
- Right.
- Assumption.
- Intro.
- Apply False_rec.
- Apply H.
- Symmetry.
- Assumption.
-Defined.
-
-Lemma Z_dec:(x,y:Z){`x<y`}+{`x>y`}+{`x=y`}.
-Proof.
- Intros x y.
- Case (Z_lt_ge_dec x y).
- Intro H.
- Left.
- Left.
- Assumption.
- Intro H.
- Generalize (Zge_le ? ? H).
- Intro H0.
- Case (Z_le_lt_eq_dec y x H0).
- Intro H1.
- Left.
- Right.
- Apply Zlt_gt.
- Assumption.
- Intro.
- Right.
- Symmetry.
- Assumption.
-Defined.
-
-
-Lemma Z_dec':(x,y:Z){`x<y`}+{`y<x`}+{`x=y`}.
-Proof.
- Intros x y.
- Case (Z_eq_dec x y);
- Intro H;
- [ Right;
-   Assumption
- | Left;
-   Apply (not_Zeq_inf ?? H)
- ].
-Defined.
-
-
-
-Definition Z_zerop : (x:Z){(`x = 0`)}+{(`x <> 0`)}.
-Proof.
-Exact [x:Z](Z_eq_dec x ZERO).
-Defined.
-
-Definition Z_notzerop := [x:Z](sumbool_not ? ? (Z_zerop x)).
-
-Definition Z_noteq_dec := [x,y:Z](sumbool_not ? ? (Z_eq_dec x y)).
diff --git a/theories7/ZArith/Zabs.v b/theories7/ZArith/Zabs.v
deleted file mode 100644
index 57778cae..00000000
--- a/theories7/ZArith/Zabs.v
+++ /dev/null
@@ -1,138 +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: Zabs.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
-
-Require Arith.
-Require BinPos.
-Require BinInt.
-Require Zorder.
-Require Zsyntax.
-Require ZArith_dec.
-
-V7only [Import nat_scope.].
-Open Local Scope Z_scope.
-
-(**********************************************************************)
-(** Properties of absolute value *)
-
-Lemma Zabs_eq : (x:Z) (Zle ZERO x) -> (Zabs x)=x.
-Intro x; NewDestruct x; Auto with arith.
-Compute; Intros; Absurd SUPERIEUR=SUPERIEUR; Trivial with arith.
-Qed.
-
-Lemma Zabs_non_eq : (x:Z) (Zle x ZERO) -> (Zabs x)=(Zopp x).
-Proof.
-Intro x; NewDestruct x; Auto with arith.
-Compute; Intros; Absurd SUPERIEUR=SUPERIEUR; Trivial with arith.
-Qed.
-
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_Zopp: (z : Z)  (Zabs (Zopp z)) = (Zabs z).
-Proof.
-Intros z; Case z; Simpl; Auto.
-Qed.
-
-(** Proving a property of the absolute value by cases *)
-
-Lemma Zabs_ind : 
-  (P:Z->Prop)(x:Z)(`x >= 0` -> (P x)) -> (`x <= 0` -> (P `-x`)) ->
-  (P `|x|`).
-Proof.
-Intros P x H H0; Elim (Z_lt_ge_dec x `0`); Intro.
-Assert `x<=0`. Apply Zlt_le_weak; Assumption.
-Rewrite Zabs_non_eq. Apply H0. Assumption. Assumption.
-Rewrite Zabs_eq. Apply H; Assumption. Apply Zge_le. Assumption.
-Save.
-
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_intro: (P : ?) (z : Z) (P (Zopp z)) -> (P z) ->  (P (Zabs z)).
-Intros P z; Case z; Simpl; Auto.
-Qed.
-
-Definition Zabs_dec : (x:Z){x=(Zabs x)}+{x=(Zopp (Zabs x))}.
-Proof.
-Intro x; NewDestruct x;Auto with arith.
-Defined.
-
-Lemma Zabs_pos : (x:Z)(Zle ZERO (Zabs x)).
-Intro x; NewDestruct x;Auto with arith; Compute; Intros H;Inversion H.
-Qed.
-
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_eq_case:
- (z1, z2 : Z) (Zabs z1) = (Zabs z2) ->  z1 = z2 \/ z1 = (Zopp z2).
-Proof.
-Intros z1 z2; Case z1; Case z2; Simpl; Auto; Try (Intros; Discriminate);
- Intros p1 p2 H1; Injection H1; (Intros H2; Rewrite H2); Auto.
-Qed.
-
-(** Triangular inequality *)
-
-Hints Local Resolve Zle_NEG_POS :zarith.
-
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_triangle:
- (z1, z2 : Z)  (Zle (Zabs (Zplus z1 z2)) (Zplus (Zabs z1) (Zabs z2))).
-Proof.
-Intros z1 z2; Case z1; Case z2; Try (Simpl; Auto with zarith; Fail).
-Intros p1 p2;
- Apply Zabs_intro
-      with P := [x : ?]  (Zle x (Zplus (Zabs (POS p2)) (Zabs (NEG p1))));
- Try Rewrite Zopp_Zplus; Auto with zarith.
-Apply Zle_plus_plus; Simpl; Auto with zarith.
-Apply Zle_plus_plus; Simpl; Auto with zarith.
-Intros p1 p2;
- Apply Zabs_intro
-      with P := [x : ?]  (Zle x (Zplus (Zabs (POS p2)) (Zabs (NEG p1))));
- Try Rewrite Zopp_Zplus; Auto with zarith.
-Apply Zle_plus_plus; Simpl; Auto with zarith.
-Apply Zle_plus_plus; Simpl; Auto with zarith.
-Qed.
-
-(** Absolute value and multiplication *)
-
-Lemma Zsgn_Zabs: (x:Z)(Zmult x (Zsgn x))=(Zabs x).
-Proof.
-Intro x; NewDestruct x; Rewrite Zmult_sym; Auto with arith.
-Qed.
-
-Lemma Zabs_Zsgn: (x:Z)(Zmult (Zabs x) (Zsgn x))=x.
-Proof.
-Intro x; NewDestruct x; Rewrite Zmult_sym; Auto with arith.
-Qed.
-
-V7only [ (* From Zdivides *) ].
-Theorem Zabs_Zmult:
- (z1, z2 : Z)  (Zabs (Zmult z1 z2)) = (Zmult (Zabs z1) (Zabs z2)).
-Proof.
-Intros z1 z2; Case z1; Case z2; Simpl; Auto.
-Qed.
-
-(** absolute value in nat is compatible with order *)
-
-Lemma absolu_lt : (x,y:Z) (Zle ZERO x)/\(Zlt x  y) -> (lt (absolu x) (absolu y)).
-Proof.
-Intros x y. Case x; Simpl. Case y; Simpl.
-
-Intro. Absurd (Zlt ZERO ZERO). Compute. Intro H0. Discriminate H0. Intuition.
-Intros. Elim (ZL4 p). Intros. Rewrite H0. Auto with arith.
-Intros. Elim (ZL4 p). Intros. Rewrite H0. Auto with arith.
-
-Case y; Simpl.
-Intros. Absurd (Zlt (POS p) ZERO). Compute. Intro H0. Discriminate H0. Intuition.
-Intros. Change (gt (convert p) (convert p0)).
-Apply compare_convert_SUPERIEUR.
-Elim H; Auto with arith. Intro. Exact (ZC2 p0 p).
-
-Intros. Absurd (Zlt (POS p0) (NEG p)).
-Compute. Intro H0. Discriminate H0. Intuition.
-
-Intros. Absurd (Zle ZERO (NEG p)). Compute. Auto with arith. Intuition.
-Qed.
diff --git a/theories7/ZArith/Zbinary.v b/theories7/ZArith/Zbinary.v
deleted file mode 100644
index c3efbe1e..00000000
--- a/theories7/ZArith/Zbinary.v
+++ /dev/null
@@ -1,425 +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: Zbinary.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
-
-(** Bit vectors interpreted as integers. 
-    Contribution by Jean Duprat (ENS Lyon). *)
-
-Require Bvector.
-Require ZArith.
-Require Export Zpower.
-Require Omega.
-
-(*
-L'évaluation des vecteurs de booléens se font à la fois en binaire et
-en complément à deux. Le nombre appartient à Z. 
-On utilise donc Omega pour faire les calculs dans Z.
-De plus, on utilise les fonctions 2^n où n est un naturel, ici la longueur.
-	two_power_nat = [n:nat](POS (shift_nat n xH))
-     		: nat->Z
-	two_power_nat_S
-	     : (n:nat)`(two_power_nat (S n)) = 2*(two_power_nat n)`
-	Z_lt_ge_dec
-	     : (x,y:Z){`x < y`}+{`x >= y`}
-*)
-
-
-Section VALUE_OF_BOOLEAN_VECTORS.
-
-(*
-Les calculs sont effectués dans la convention positive usuelle.
-Les valeurs correspondent soit à l'écriture binaire (nat), 
-soit au complément à deux (int).
-On effectue le calcul suivant le schéma de Horner.
-Le complément à deux n'a de sens que sur les vecteurs de taille 
-supérieure ou égale à un, le bit de signe étant évalué négativement.
-*)
-
-Definition bit_value [b:bool] : Z :=
-Cases b of
-	| true => `1`
-	| false => `0`
-end.
-
-Lemma binary_value  : (n:nat) (Bvector n) -> Z.
-Proof.
-	Induction n; Intros.
-	Exact `0`.
-
-	Inversion H0.
-	Exact (Zplus (bit_value a) (Zmult `2` (H H2))).
-Defined.
-
-Lemma two_compl_value : (n:nat) (Bvector (S n)) -> Z.
-Proof.
-	Induction n; Intros.
-	Inversion H.
-	Exact (Zopp (bit_value a)).
-
-	Inversion H0.
-	Exact (Zplus (bit_value a) (Zmult `2` (H H2))).
-Defined.
-
-(*
-Coq < Eval Compute in (binary_value (3) (Bcons true (2) (Bcons false (1) (Bcons true (0) Bnil)))).
-     = `5`
-     : Z
-*)
-
-(*
-Coq < Eval Compute in (two_compl_value (3) (Bcons true (3) (Bcons false (2) (Bcons true (1) (Bcons true (0) Bnil))))).
-     = `-3`
-     : Z
-*)
-
-End VALUE_OF_BOOLEAN_VECTORS.
-
-Section ENCODING_VALUE.
-
-(*
-On calcule la valeur binaire selon un schema de Horner.
-Le calcul s'arrete à la longueur du vecteur sans vérification.
-On definit une fonction Zmod2 calquee sur Zdiv2 mais donnant le quotient
-de la division z=2q+r avec 0<=r<=1.
-La valeur en complément à deux est calculée selon un schema de Horner
-avec Zmod2, le paramètre est la taille moins un.
-*)
-
-Definition Zmod2 := [z:Z] Cases z of
-  	|  ZERO => `0`
- 	| ((POS p)) => Cases p of
-      		| (xI q) => (POS q)
-    		| (xO q) => (POS q)
-    		| xH => `0`
-    		end
- 	| ((NEG p)) => Cases p of
-      		| (xI q) => `(NEG q) - 1`
-    		| (xO q) => (NEG q)
-    		| xH => `-1`
-    		end
- 	end.
-
-V7only [
-Notation double_moins_un_add_un :=
-  [p](sym_eq ? ? ? (double_moins_un_add_un_xI p)).
-].
-
-Lemma Zmod2_twice : (z:Z)
-	`z = (2*(Zmod2 z) + (bit_value (Zodd_bool z)))`.
-Proof.
-	NewDestruct z; Simpl.
-	Trivial.
-
-	NewDestruct p; Simpl; Trivial.
-
-	NewDestruct p; Simpl.
-	NewDestruct p as [p|p|]; Simpl.
-	Rewrite <- (double_moins_un_add_un_xI p); Trivial.
-
-	Trivial.
-
-	Trivial.
-
-	Trivial.
-
-	Trivial.
-Save.
-
-Lemma Z_to_binary : (n:nat) Z -> (Bvector n).
-Proof.
-	Induction n; Intros.
-	Exact Bnil.
-
-	Exact (Bcons (Zodd_bool H0) n0 (H (Zdiv2 H0))).
-Defined.
-
-(*
-Eval Compute in (Z_to_binary (5) `5`).
-     = (Vcons bool true (4)
-          (Vcons bool false (3)
-            (Vcons bool true (2)
-              (Vcons bool false (1) (Vcons bool false (0) (Vnil bool))))))
-     :  (Bvector (5))
-*)
-
-Lemma Z_to_two_compl : (n:nat) Z -> (Bvector (S n)).
-Proof.
-	Induction n; Intros.
-	Exact (Bcons (Zodd_bool H) (0) Bnil).
-
-	Exact (Bcons (Zodd_bool H0) (S n0) (H (Zmod2 H0))).
-Defined.
-
-(*
-Eval Compute in (Z_to_two_compl (3) `0`).
-     =  (Vcons bool false (3)
-          (Vcons bool false (2)
-            (Vcons bool false (1) (Vcons bool false (0) (Vnil bool)))))
-     :  (vector bool (4))
-
-Eval Compute in (Z_to_two_compl (3) `5`).
-     = (Vcons bool true (3)
-          (Vcons bool false (2)
-            (Vcons bool true (1) (Vcons bool false (0) (Vnil bool)))))
-     :  (vector bool (4))
-
-Eval Compute in (Z_to_two_compl (3) `-5`).
-     =  (Vcons bool true (3)
-          (Vcons bool true (2)
-            (Vcons bool false (1) (Vcons bool true (0) (Vnil bool)))))
-     :  (vector bool (4))
-*)	
-
-End ENCODING_VALUE.
-
-Section Z_BRIC_A_BRAC.
-
-(*
-Bibliotheque de lemmes utiles dans la section suivante.
-Utilise largement ZArith.
-Meriterait d'etre reecrite.
-*)
-
-Lemma binary_value_Sn : (n:nat) (b:bool) (bv : (Bvector n))
-	(binary_value (S n) (Vcons bool b n bv))=`(bit_value b) + 2*(binary_value n bv)`.
-Proof.
-	Intros; Auto.
-Save.
-
-Lemma Z_to_binary_Sn : (n:nat) (b:bool) (z:Z)
-	`z>=0`->
-	(Z_to_binary (S n) `(bit_value b) + 2*z`)=(Bcons b n (Z_to_binary n z)).
-Proof.
-	NewDestruct b; NewDestruct z; Simpl; Auto.
-	Intro H; Elim H; Trivial.
-Save.
-
-Lemma binary_value_pos : (n:nat) (bv:(Bvector n))
-	`(binary_value n bv) >= 0`.
-Proof.
-	NewInduction bv as [|a n v IHbv]; Simpl.
-	Omega.
-
-	NewDestruct a; NewDestruct (binary_value n v); Simpl; Auto.
-	Auto with zarith.
-Save.
-
-V7only [Notation add_un_double_moins_un_xO := is_double_moins_un.].
-
-Lemma two_compl_value_Sn : (n:nat) (bv : (Bvector (S n))) (b:bool)
-	(two_compl_value (S n) (Bcons b (S n) bv)) =
-		`(bit_value b) + 2*(two_compl_value n bv)`.
-Proof.
-	Intros; Auto.
-Save.
-
-Lemma Z_to_two_compl_Sn : (n:nat) (b:bool) (z:Z) 
-	(Z_to_two_compl (S n) `(bit_value b) + 2*z`) =
-		(Bcons b (S n) (Z_to_two_compl n z)).
-Proof.
-	NewDestruct b; NewDestruct z as [|p|p]; Auto.
-	NewDestruct p as [p|p|]; Auto.
-	NewDestruct p as [p|p|]; Simpl; Auto.
-	Intros; Rewrite (add_un_double_moins_un_xO p); Trivial.
-Save.
-
-Lemma Z_to_binary_Sn_z : (n:nat) (z:Z)
-	(Z_to_binary (S n) z)=(Bcons (Zodd_bool z) n (Z_to_binary n (Zdiv2 z))).
-Proof.
-	Intros; Auto.
-Save.
-
-Lemma Z_div2_value : (z:Z)
-	` z>=0 `->
-	 `(bit_value (Zodd_bool z))+2*(Zdiv2 z) = z`.
-Proof.
-	NewDestruct z as [|p|p]; Auto.
-	NewDestruct p; Auto.
-  Intro H; Elim H; Trivial.
-Save.
-
-Lemma Zdiv2_pos : (z:Z)
-	` z >= 0 ` ->
-	`(Zdiv2 z) >= 0 `.
-Proof.
-	NewDestruct z as [|p|p].
-	Auto.
-
-	NewDestruct p; Auto.
-	Simpl; Intros; Omega.
-
-  Intro H; Elim H; Trivial.
-
-Save.
-
-Lemma Zdiv2_two_power_nat : (z:Z) (n:nat)
-	` z >= 0 ` ->
-	` z < (two_power_nat (S n)) ` ->
-	`(Zdiv2 z) < (two_power_nat n) `.
-Proof.
-	Intros.
-	Cut (Zlt (Zmult `2` (Zdiv2 z)) (Zmult `2` (two_power_nat n))); Intros.
-	Omega.
-
-	Rewrite <- two_power_nat_S.
-	NewDestruct (Zeven_odd_dec z); Intros.
-	Rewrite <- Zeven_div2; Auto.
-
-	Generalize (Zodd_div2 z H z0); Omega.
-Save.
-
-(*
-
-Lemma Z_minus_one_or_zero : (z:Z)
-	`z >= -1` ->
-	`z < 1` ->
-	{`z=-1`} + {`z=0`}.
-Proof.
-	NewDestruct z; Auto.
-	NewDestruct p; Auto.
-	Tauto.
-
-	Tauto.
-
-	Intros.
-	Right; Omega.
-
-	NewDestruct p.
-	Tauto.
-
-	Tauto.
-
-	Intros; Left; Omega.
-Save.
-*)
-
-Lemma Z_to_two_compl_Sn_z : (n:nat) (z:Z)
-	(Z_to_two_compl (S n) z)=(Bcons (Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z))).
-Proof.
-	Intros; Auto.
-Save.
-
-Lemma Zeven_bit_value : (z:Z)
-	(Zeven z) ->
-	`(bit_value (Zodd_bool z))=0`.
-Proof.
-	NewDestruct z; Unfold bit_value; Auto.
-	NewDestruct p; Tauto Orelse (Intro H; Elim H).
- 	NewDestruct p; Tauto Orelse (Intro H; Elim H).
-Save.
-
-Lemma Zodd_bit_value : (z:Z)
-	(Zodd z) ->
-	`(bit_value (Zodd_bool z))=1`.
-Proof.
-	NewDestruct z; Unfold bit_value; Auto.
-  Intros; Elim H.
-  NewDestruct p; Tauto Orelse (Intros; Elim H).
-  NewDestruct p; Tauto Orelse (Intros; Elim H).
-Save.
-
-Lemma Zge_minus_two_power_nat_S : (n:nat) (z:Z)
-	`z >= (-(two_power_nat (S n)))`->
-	`(Zmod2 z) >= (-(two_power_nat n))`.
-Proof.
-	Intros n z; Rewrite (two_power_nat_S n).
-	Generalize (Zmod2_twice z).
-	NewDestruct (Zeven_odd_dec z) as [H|H].
-	Rewrite (Zeven_bit_value z H); Intros; Omega.
-
-        Rewrite (Zodd_bit_value z H); Intros; Omega.
-Save.
-
-Lemma Zlt_two_power_nat_S : (n:nat) (z:Z)
-	`z < (two_power_nat (S n))`->
-	`(Zmod2 z) < (two_power_nat n)`.
-Proof.
-	Intros n z; Rewrite (two_power_nat_S n).
-	Generalize (Zmod2_twice z).
-	NewDestruct (Zeven_odd_dec z) as [H|H].
-	Rewrite (Zeven_bit_value z H); Intros; Omega.
-
-	Rewrite (Zodd_bit_value z H); Intros; Omega.
-Save.
-
-End Z_BRIC_A_BRAC.
-
-Section COHERENT_VALUE.
-
-(*
-On vérifie que dans l'intervalle de définition les fonctions sont 
-réciproques l'une de l'autre.
-Elles utilisent les lemmes du bric-a-brac.
-*)
-
-Lemma binary_to_Z_to_binary : (n:nat) (bv : (Bvector n))
-	(Z_to_binary n (binary_value n bv))=bv.
-Proof.
-	NewInduction bv as [|a n bv IHbv].
-	Auto.
-
-	Rewrite binary_value_Sn.
-	Rewrite Z_to_binary_Sn.
-	Rewrite IHbv; Trivial.
-
-	Apply binary_value_pos.
-Save.
-		
-Lemma two_compl_to_Z_to_two_compl : (n:nat) (bv : (Bvector n)) (b:bool)
-	(Z_to_two_compl n (two_compl_value n (Bcons b n bv)))=
-		(Bcons b n bv).
-Proof.
-	NewInduction bv as [|a n bv IHbv]; Intro b.
-	NewDestruct b; Auto.
-
-	Rewrite two_compl_value_Sn.
-	Rewrite Z_to_two_compl_Sn.
-	Rewrite IHbv; Trivial.
-Save.
-
-Lemma Z_to_binary_to_Z : (n:nat) (z : Z)
-	`z >= 0 `->
-	`z < (two_power_nat n) `->
-	 (binary_value n (Z_to_binary n z))=z.
-Proof.
-	NewInduction n as [|n IHn].
-	Unfold two_power_nat shift_nat; Simpl; Intros; Omega.
-
-	Intros; Rewrite Z_to_binary_Sn_z.
-	Rewrite binary_value_Sn.
-	Rewrite IHn.
-	Apply Z_div2_value; Auto.
-
-	Apply Zdiv2_pos; Trivial.
-
-	Apply Zdiv2_two_power_nat; Trivial.
-Save.
-
-Lemma Z_to_two_compl_to_Z : (n:nat) (z : Z)
-	`z >= -(two_power_nat n) `->
-	`z < (two_power_nat n) `->
-	(two_compl_value n (Z_to_two_compl n  z))=z.
-Proof.
-	NewInduction n as [|n IHn].
-	Unfold two_power_nat shift_nat; Simpl; Intros.
-	Assert `z=-1`\/`z=0`. Omega.
-Intuition; Subst z; Trivial.
-
-	Intros; Rewrite Z_to_two_compl_Sn_z.
-	Rewrite two_compl_value_Sn.
-	Rewrite IHn.
-	Generalize (Zmod2_twice z); Omega.
-
-	Apply Zge_minus_two_power_nat_S; Auto.
-
-	Apply Zlt_two_power_nat_S; Auto.
-Save.
-
-End COHERENT_VALUE.
-
diff --git a/theories7/ZArith/Zbool.v b/theories7/ZArith/Zbool.v
deleted file mode 100644
index 258a485d..00000000
--- a/theories7/ZArith/Zbool.v
+++ /dev/null
@@ -1,158 +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        *)
-(************************************************************************)
-
-(* $Id: Zbool.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ *)
-
-Require BinInt.
-Require Zeven.
-Require Zorder.
-Require Zcompare.
-Require ZArith_dec.
-Require Zsyntax.
-Require Sumbool.
-
-(** The decidability of equality and order relations over
-    type [Z] give some boolean functions with the adequate specification. *)
-
-Definition Z_lt_ge_bool := [x,y:Z](bool_of_sumbool (Z_lt_ge_dec x y)).
-Definition Z_ge_lt_bool := [x,y:Z](bool_of_sumbool (Z_ge_lt_dec x y)).
-
-Definition Z_le_gt_bool := [x,y:Z](bool_of_sumbool (Z_le_gt_dec x y)).
-Definition Z_gt_le_bool := [x,y:Z](bool_of_sumbool (Z_gt_le_dec x y)).
-
-Definition Z_eq_bool := [x,y:Z](bool_of_sumbool (Z_eq_dec x y)).
-Definition Z_noteq_bool := [x,y:Z](bool_of_sumbool (Z_noteq_dec x y)).
-
-Definition Zeven_odd_bool := [x:Z](bool_of_sumbool (Zeven_odd_dec x)).
-
-(**********************************************************************)
-(** Boolean comparisons of binary integers *)
-
-Definition Zle_bool := 
-  [x,y:Z]Cases `x ?= y` of SUPERIEUR => false | _ => true end.
-Definition Zge_bool := 
-  [x,y:Z]Cases `x ?= y` of INFERIEUR => false | _ => true end.
-Definition Zlt_bool := 
-  [x,y:Z]Cases `x ?= y` of INFERIEUR => true | _ => false end.
-Definition Zgt_bool := 
-  [x,y:Z]Cases ` x ?= y` of SUPERIEUR => true | _ => false end.
-Definition Zeq_bool := 
-  [x,y:Z]Cases `x ?= y` of EGAL => true | _ => false end.
-Definition Zneq_bool := 
-  [x,y:Z]Cases `x ?= y` of EGAL => false | _ => true end.
-
-Lemma Zle_cases : (x,y:Z)if (Zle_bool x y) then `x<=y` else `x>y`.
-Proof.
-Intros x y; Unfold Zle_bool Zle Zgt.
-Case (Zcompare x y); Auto; Discriminate.
-Qed.
-
-Lemma Zlt_cases : (x,y:Z)if (Zlt_bool x y) then `x<y` else `x>=y`.
-Proof.
-Intros x y; Unfold Zlt_bool Zlt Zge.
-Case (Zcompare x y); Auto; Discriminate.
-Qed.
-
-Lemma Zge_cases : (x,y:Z)if (Zge_bool x y) then `x>=y` else `x<y`.
-Proof.
-Intros x y; Unfold Zge_bool Zge Zlt.
-Case (Zcompare x y); Auto; Discriminate.
-Qed.
-
-Lemma Zgt_cases : (x,y:Z)if (Zgt_bool x y) then `x>y` else `x<=y`.
-Proof.
-Intros x y; Unfold Zgt_bool Zgt Zle.
-Case (Zcompare x y); Auto; Discriminate.
-Qed.
-
-(** Lemmas on [Zle_bool] used in contrib/graphs *)
-
-Lemma Zle_bool_imp_le : (x,y:Z) (Zle_bool x y)=true -> (Zle x y).
-Proof.
-  Unfold Zle_bool Zle. Intros x y. Unfold not. 
-  Case (Zcompare x y); Intros; Discriminate.
-Qed.
-
-Lemma Zle_imp_le_bool : (x,y:Z) (Zle x y) -> (Zle_bool x y)=true.
-Proof.
-  Unfold Zle Zle_bool. Intros x y. Case (Zcompare x y); Trivial. Intro. Elim (H (refl_equal ? ?)).
-Qed.
-
-Lemma Zle_bool_refl : (x:Z) (Zle_bool x x)=true.
-Proof.
-  Intro. Apply Zle_imp_le_bool. Apply Zle_refl. Reflexivity.
-Qed.
-
-Lemma Zle_bool_antisym : (x,y:Z) (Zle_bool x y)=true -> (Zle_bool y x)=true -> x=y.
-Proof.
-  Intros. Apply Zle_antisym. Apply Zle_bool_imp_le. Assumption.
-  Apply Zle_bool_imp_le. Assumption.
-Qed.
-
-Lemma Zle_bool_trans : (x,y,z:Z) (Zle_bool x y)=true -> (Zle_bool y z)=true -> (Zle_bool x z)=true.
-Proof.
-  Intros x y z; Intros. Apply Zle_imp_le_bool. Apply Zle_trans with m:=y. Apply Zle_bool_imp_le. Assumption.
-  Apply Zle_bool_imp_le. Assumption.
-Qed.
-
-Definition Zle_bool_total : (x,y:Z) {(Zle_bool x y)=true}+{(Zle_bool y x)=true}.
-Proof.
-  Intros x y; Intros. Unfold Zle_bool. Cut (Zcompare x y)=SUPERIEUR<->(Zcompare y x)=INFERIEUR.
-  Case (Zcompare x y). Left . Reflexivity.
-  Left . Reflexivity.
-  Right . Rewrite (proj1 ? ? H (refl_equal ? ?)). Reflexivity.
-  Apply Zcompare_ANTISYM.
-Defined.
-
-Lemma Zle_bool_plus_mono : (x,y,z,t:Z) (Zle_bool x y)=true -> (Zle_bool z t)=true ->
-                                (Zle_bool (Zplus x z) (Zplus y t))=true.
-Proof.
-  Intros. Apply Zle_imp_le_bool. Apply Zle_plus_plus. Apply Zle_bool_imp_le. Assumption.
-  Apply Zle_bool_imp_le. Assumption.
-Qed.
-
-Lemma Zone_pos : (Zle_bool `1` `0`)=false.
-Proof.
-  Reflexivity.
-Qed.
-
-Lemma Zone_min_pos : (x:Z) (Zle_bool x `0`)=false -> (Zle_bool `1` x)=true.
-Proof.
-  Intros x; Intros. Apply Zle_imp_le_bool. Change (Zle (Zs ZERO) x). Apply Zgt_le_S. Generalize H.
-  Unfold Zle_bool Zgt. Case (Zcompare x ZERO). Intro H0. Discriminate H0.
-  Intro H0. Discriminate H0.
-  Reflexivity.
-Qed.
-
-
- Lemma Zle_is_le_bool : (x,y:Z) (Zle x y) <-> (Zle_bool x y)=true.
-  Proof.
-    Intros. Split. Intro. Apply Zle_imp_le_bool. Assumption.
-    Intro. Apply Zle_bool_imp_le. Assumption.
-  Qed.
-
-  Lemma Zge_is_le_bool : (x,y:Z) (Zge x y) <-> (Zle_bool y x)=true.
-  Proof.
-    Intros. Split. Intro. Apply Zle_imp_le_bool. Apply Zge_le. Assumption.
-    Intro. Apply Zle_ge. Apply Zle_bool_imp_le. Assumption.
-  Qed.
-
-  Lemma Zlt_is_le_bool : (x,y:Z) (Zlt x y) <-> (Zle_bool x `y-1`)=true.
-  Proof.
-    Intros x y. Split. Intro. Apply Zle_imp_le_bool. Apply Zlt_n_Sm_le. Rewrite (Zs_pred y) in H.
-    Assumption.
-    Intro. Rewrite (Zs_pred y). Apply Zle_lt_n_Sm. Apply Zle_bool_imp_le. Assumption.
-  Qed.
-
-  Lemma Zgt_is_le_bool : (x,y:Z) (Zgt x y) <-> (Zle_bool y `x-1`)=true.
-  Proof.
-    Intros x y. Apply iff_trans with `y < x`. Split. Exact (Zgt_lt x y).
-    Exact (Zlt_gt y x).
-    Exact (Zlt_is_le_bool y x).
-  Qed.
-
diff --git a/theories7/ZArith/Zcompare.v b/theories7/ZArith/Zcompare.v
deleted file mode 100644
index fd11ae9b..00000000
--- a/theories7/ZArith/Zcompare.v
+++ /dev/null
@@ -1,480 +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 $$ i*)
-
-Require Export BinPos.
-Require Export BinInt.
-Require Zsyntax.
-Require Lt.
-Require Gt.
-Require Plus.
-Require Mult.
-
-Open Local Scope Z_scope.
-
-(**********************************************************************)
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France)            *)
-(**********************************************************************)
-
-(**********************************************************************)
-(** Comparison on integers *)
-
-Lemma Zcompare_x_x : (x:Z) (Zcompare x x) = EGAL.
-Proof.
-Intro x; NewDestruct x as [|p|p]; Simpl; [ Reflexivity | Apply convert_compare_EGAL
-  | Rewrite convert_compare_EGAL; Reflexivity ].
-Qed.
-
-Lemma Zcompare_EGAL_eq : (x,y:Z) (Zcompare x y) = EGAL -> x = y.
-Proof.
-Intros x y; NewDestruct x as [|x'|x'];NewDestruct y as [|y'|y'];Simpl;Intro H; Reflexivity Orelse Try Discriminate H; [
-    Rewrite (compare_convert_EGAL x' y' H); Reflexivity
-  | Rewrite (compare_convert_EGAL x' y'); [
-      Reflexivity
-    | NewDestruct (compare x' y' EGAL);
-      Reflexivity Orelse Discriminate]].
-Qed.
-
-Lemma Zcompare_EGAL : (x,y:Z) (Zcompare x y) = EGAL <-> x = y.
-Proof.
-Intros x y;Split; Intro E; [ Apply Zcompare_EGAL_eq; Assumption
-  | Rewrite E; Apply Zcompare_x_x ].
-Qed.
-
-Lemma Zcompare_antisym :
-  (x,y:Z)(Op (Zcompare x y)) = (Zcompare y x).
-Proof.
-Intros x y; NewDestruct x; NewDestruct y; Simpl;
-  Reflexivity Orelse Discriminate H Orelse 
-  Rewrite Pcompare_antisym; Reflexivity.
-Qed.
-
-Lemma Zcompare_ANTISYM : 
-  (x,y:Z) (Zcompare x y) = SUPERIEUR <->  (Zcompare y x) = INFERIEUR.
-Proof.
-Intros x y; Split; Intro H; [ 
-  Change INFERIEUR with (Op SUPERIEUR); 
-  Rewrite <- Zcompare_antisym; Rewrite H; Reflexivity
-| Change SUPERIEUR with (Op INFERIEUR); 
-  Rewrite <- Zcompare_antisym; Rewrite H; Reflexivity ].
-Qed.
-
-(** Transitivity of comparison *)
-
-Lemma Zcompare_trans_SUPERIEUR : 
-  (x,y,z:Z) (Zcompare x y) = SUPERIEUR ->  
-            (Zcompare y z) = SUPERIEUR ->
-            (Zcompare x z) = SUPERIEUR.
-Proof.
-Intros x y z;Case x;Case y;Case z; Simpl;
-Try (Intros; Discriminate H Orelse Discriminate H0);
-Auto with arith; [
-  Intros p q r H H0;Apply convert_compare_SUPERIEUR; Unfold gt;
-  Apply lt_trans with m:=(convert q);
-  Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
-| Intros p q r; Do 3 Rewrite <- ZC4; Intros H H0;
-  Apply convert_compare_SUPERIEUR;Unfold gt;Apply lt_trans with m:=(convert q);
-  Apply compare_convert_INFERIEUR;Apply ZC1;Assumption ].
-Qed.
-
-(** Comparison and opposite *)
-
-Lemma Zcompare_Zopp :
-  (x,y:Z) (Zcompare x y) = (Zcompare (Zopp y) (Zopp x)).
-Proof.
-(Intros x y;Case x;Case y;Simpl;Auto with arith);
-Intros;Rewrite <- ZC4;Trivial with arith.
-Qed.
-
-Hints Local Resolve convert_compare_EGAL.
-
-(** Comparison first-order specification *)
-
-Lemma SUPERIEUR_POS :
-  (x,y:Z) (Zcompare x y) = SUPERIEUR ->
-  (EX h:positive |(Zplus x (Zopp y)) = (POS h)).
-Proof.
-Intros x y;Case x;Case y; [
-  Simpl; Intros H; Discriminate H
-| Simpl; Intros p H; Discriminate H
-| Intros p H; Exists p; Simpl; Auto with arith
-| Intros p H; Exists p; Simpl; Auto with arith
-| Intros q p H; Exists (true_sub p q); Unfold Zplus Zopp;
-  Unfold Zcompare in H; Rewrite H; Trivial with arith
-| Intros q p H; Exists (add p q); Simpl; Trivial with arith
-| Simpl; Intros p H; Discriminate H
-| Simpl; Intros q p H; Discriminate H
-| Unfold Zcompare; Intros q p; Rewrite <- ZC4; Intros H; Exists (true_sub q p);
-  Simpl; Rewrite (ZC1 q p H); Trivial with arith].
-Qed.
-
-(** Comparison and addition *)
-
-Lemma weaken_Zcompare_Zplus_compatible : 
-  ((n,m:Z) (p:positive) 
-    (Zcompare (Zplus (POS p) n) (Zplus (POS p) m)) = (Zcompare n m)) ->
-   (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y).
-Proof.
-Intros H x y z; NewDestruct z; [
-  Reflexivity
-| Apply H
-| Rewrite (Zcompare_Zopp x y); Rewrite Zcompare_Zopp; 
-  Do 2 Rewrite Zopp_Zplus; Rewrite Zopp_NEG; Apply H ].
-Qed.
-
-Hints Local Resolve ZC4.
-
-Lemma weak_Zcompare_Zplus_compatible : 
-  (x,y:Z) (z:positive) 
-    (Zcompare (Zplus (POS z) x) (Zplus (POS z) y)) = (Zcompare x y).
-Proof.
-Intros x y z;Case x;Case y;Simpl;Auto with arith; [
-  Intros p;Apply convert_compare_INFERIEUR; Apply ZL17
-| Intros p;ElimPcompare z p;Intros E;Rewrite E;Auto with arith;
-  Apply convert_compare_SUPERIEUR; Rewrite true_sub_convert; [ Unfold gt ;
-  Apply ZL16 | Assumption ]
-| Intros p;ElimPcompare z p;
-  Intros E;Auto with arith; Apply convert_compare_SUPERIEUR;
-  Unfold gt;Apply ZL17
-| Intros p q;
-  ElimPcompare q p;
-  Intros E;Rewrite E;[
-    Rewrite (compare_convert_EGAL q p E); Apply convert_compare_EGAL
-  | Apply convert_compare_INFERIEUR;Do 2 Rewrite convert_add;Apply lt_reg_l;
-    Apply compare_convert_INFERIEUR with 1:=E
-  | Apply convert_compare_SUPERIEUR;Unfold gt ;Do 2 Rewrite convert_add;
-    Apply lt_reg_l;Exact (compare_convert_SUPERIEUR q p E) ]
-| Intros p q; 
-  ElimPcompare z p;
-  Intros E;Rewrite E;Auto with arith;
-  Apply convert_compare_SUPERIEUR; Rewrite true_sub_convert; [
-    Unfold gt; Apply lt_trans with m:=(convert z); [Apply ZL16 | Apply ZL17]
-  | Assumption ]
-| Intros p;ElimPcompare z p;Intros E;Rewrite E;Auto with arith; Simpl;
-  Apply convert_compare_INFERIEUR;Rewrite true_sub_convert;[Apply ZL16|
-  Assumption]
-| Intros p q;
-  ElimPcompare z q;
-  Intros E;Rewrite E;Auto with arith; Simpl;Apply convert_compare_INFERIEUR;
-  Rewrite true_sub_convert;[
-    Apply lt_trans with m:=(convert z) ;[Apply ZL16|Apply ZL17]
-  | Assumption]
-| Intros p q; ElimPcompare z q; Intros E0;Rewrite E0;
-  ElimPcompare z p; Intros E1;Rewrite E1; ElimPcompare q p;
-  Intros E2;Rewrite E2;Auto with arith; [
-    Absurd (compare q p EGAL)=INFERIEUR; [
-      Rewrite <- (compare_convert_EGAL z q E0);
-      Rewrite <- (compare_convert_EGAL z p E1); 
-      Rewrite (convert_compare_EGAL z); Discriminate
-    | Assumption ]
-  | Absurd (compare q p EGAL)=SUPERIEUR; [
-      Rewrite <- (compare_convert_EGAL z q E0);
-      Rewrite <- (compare_convert_EGAL z p E1);
-      Rewrite (convert_compare_EGAL z);Discriminate
-    | Assumption]
-  | Absurd (compare z p EGAL)=INFERIEUR; [
-      Rewrite (compare_convert_EGAL z q E0); 
-      Rewrite <- (compare_convert_EGAL q p E2);
-      Rewrite (convert_compare_EGAL q);Discriminate
-    | Assumption ]
-  | Absurd (compare z p EGAL)=INFERIEUR; [
-      Rewrite (compare_convert_EGAL z q E0); Rewrite E2;Discriminate
-    | Assumption]
-  | Absurd (compare z p EGAL)=SUPERIEUR;[
-      Rewrite (compare_convert_EGAL z q E0);
-      Rewrite <- (compare_convert_EGAL q p E2);
-      Rewrite (convert_compare_EGAL q);Discriminate
-    | Assumption]
-  | Absurd (compare z p EGAL)=SUPERIEUR;[
-      Rewrite (compare_convert_EGAL z q E0);Rewrite E2;Discriminate
-    | Assumption]
-  | Absurd (compare z q EGAL)=INFERIEUR;[
-      Rewrite (compare_convert_EGAL z p E1);
-      Rewrite (compare_convert_EGAL q p E2);
-      Rewrite (convert_compare_EGAL p); Discriminate
-    | Assumption]
-  | Absurd (compare p q EGAL)=SUPERIEUR; [
-      Rewrite <- (compare_convert_EGAL z p E1);
-      Rewrite E0; Discriminate
-    | Apply ZC2;Assumption ]
-  | Simpl; Rewrite (compare_convert_EGAL q p E2);
-    Rewrite (convert_compare_EGAL (true_sub p z)); Auto with arith
-  | Simpl; Rewrite <- ZC4; Apply convert_compare_SUPERIEUR;
-    Rewrite true_sub_convert; [
-      Rewrite true_sub_convert; [
-        Unfold gt; Apply simpl_lt_plus_l with p:=(convert z);
-        Rewrite le_plus_minus_r; [
-          Rewrite le_plus_minus_r; [
-            Apply compare_convert_INFERIEUR;Assumption
-          | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
-        | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
-      | Apply ZC2;Assumption ]
-    | Apply ZC2;Assumption ]
-  | Simpl; Rewrite <- ZC4; Apply convert_compare_INFERIEUR; 
-    Rewrite true_sub_convert; [
-      Rewrite true_sub_convert; [
-        Apply simpl_lt_plus_l with p:=(convert z);
-        Rewrite le_plus_minus_r; [
-          Rewrite le_plus_minus_r; [
-            Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
-          | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
-        | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
-      | Apply ZC2;Assumption]
-    | Apply ZC2;Assumption ]
-  | Absurd (compare z q EGAL)=INFERIEUR; [
-      Rewrite (compare_convert_EGAL q p E2);Rewrite E1;Discriminate
-    | Assumption ]
-  | Absurd (compare q p EGAL)=INFERIEUR; [
-      Cut (compare q p EGAL)=SUPERIEUR; [
-        Intros E;Rewrite E;Discriminate
-      | Apply convert_compare_SUPERIEUR; Unfold gt;
-        Apply lt_trans with m:=(convert z); [
-          Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
-        | Apply compare_convert_INFERIEUR;Assumption ]]
-    | Assumption ]
-  | Absurd (compare z q EGAL)=SUPERIEUR; [
-      Rewrite (compare_convert_EGAL z p E1);
-      Rewrite (compare_convert_EGAL q p E2);
-      Rewrite (convert_compare_EGAL p); Discriminate
-    | Assumption ]
-  | Absurd (compare z q EGAL)=SUPERIEUR; [
-      Rewrite (compare_convert_EGAL z p E1);
-      Rewrite ZC1; [Discriminate | Assumption ]
-    | Assumption ]
-  | Absurd (compare z q EGAL)=SUPERIEUR; [
-      Rewrite (compare_convert_EGAL q p E2); Rewrite E1; Discriminate
-    | Assumption ]
-  | Absurd (compare q p EGAL)=SUPERIEUR; [
-      Rewrite ZC1; [ 
-        Discriminate 
-      | Apply convert_compare_SUPERIEUR; Unfold gt; 
-        Apply lt_trans with m:=(convert z); [
-          Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
-        | Apply compare_convert_INFERIEUR;Assumption ]]
-    | Assumption ]
-  | Simpl; Rewrite (compare_convert_EGAL q p E2); Apply convert_compare_EGAL
-  | Simpl; Apply convert_compare_SUPERIEUR; Unfold gt;
-    Rewrite true_sub_convert; [
-      Rewrite true_sub_convert; [
-        Apply simpl_lt_plus_l with p:=(convert p); Rewrite le_plus_minus_r; [
-          Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert q);
-          Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
-            Rewrite (plus_sym (convert q)); Apply lt_reg_l;
-            Apply compare_convert_INFERIEUR;Assumption
-          | Apply lt_le_weak; Apply compare_convert_INFERIEUR;
-            Apply ZC1;Assumption ]
-        | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1; 
-          Assumption ]
-      | Assumption ]
-    | Assumption ]
-  | Simpl; Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
-      Rewrite true_sub_convert; [
-        Apply simpl_lt_plus_l with p:=(convert q); Rewrite le_plus_minus_r; [
-          Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert p);
-          Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
-            Rewrite (plus_sym (convert p)); Apply lt_reg_l;
-            Apply compare_convert_INFERIEUR;Apply ZC1;Assumption 
-          | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1;
-            Assumption ]
-        | Apply lt_le_weak;Apply compare_convert_INFERIEUR;Apply ZC1;Assumption]
-      | Assumption]
-    | Assumption]]].
-Qed.
-
-Lemma Zcompare_Zplus_compatible : 
-   (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y).
-Proof.
-Exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible).
-Qed.
-
-Lemma Zcompare_Zplus_compatible2 :
-  (r:relation)(x,y,z,t:Z)
-    (Zcompare x y) = r -> (Zcompare z t) = r ->
-    (Zcompare (Zplus x z) (Zplus y t)) = r.
-Proof.
-Intros r x y z t; Case r; [
-  Intros H1 H2; Elim (Zcompare_EGAL x y); Elim (Zcompare_EGAL z t);
-  Intros H3 H4 H5 H6; Rewrite H3; [ 
-    Rewrite H5; [ Elim (Zcompare_EGAL (Zplus y t) (Zplus y t)); Auto with arith | Auto with arith ]
-  | Auto with arith ]
-| Intros H1 H2; Elim (Zcompare_ANTISYM (Zplus y t) (Zplus x z));
-  Intros H3 H4; Apply H3;
-  Apply Zcompare_trans_SUPERIEUR with y:=(Zplus y z) ; [
-    Rewrite Zcompare_Zplus_compatible;
-    Elim (Zcompare_ANTISYM t z); Auto with arith
-  | Do 2 Rewrite <- (Zplus_sym z); 
-    Rewrite Zcompare_Zplus_compatible;
-    Elim (Zcompare_ANTISYM y x); Auto with arith]
-| Intros H1 H2;
-  Apply Zcompare_trans_SUPERIEUR with y:=(Zplus x t) ; [
-    Rewrite Zcompare_Zplus_compatible; Assumption
-  | Do 2 Rewrite <- (Zplus_sym t);
-    Rewrite Zcompare_Zplus_compatible; Assumption]].
-Qed.
-
-Lemma Zcompare_Zs_SUPERIEUR : (x:Z)(Zcompare (Zs x) x)=SUPERIEUR.
-Proof.
-Intro x; Unfold Zs; Pattern 2 x; Rewrite <- (Zero_right x); 
-Rewrite Zcompare_Zplus_compatible;Reflexivity.
-Qed.
-
-Lemma Zcompare_et_un: 
-  (x,y:Z) (Zcompare x y)=SUPERIEUR <-> 
-    ~(Zcompare x (Zplus y (POS xH)))=INFERIEUR.
-Proof.
-Intros x y; Split; [
-  Intro H; (ElimCompare 'x '(Zplus y (POS xH)));[
-    Intro H1; Rewrite H1; Discriminate
-  | Intros H1; Elim SUPERIEUR_POS with 1:=H; Intros h H2; 
-    Absurd (gt (convert h) O) /\ (lt (convert h) (S O)); [
-      Unfold not ;Intros H3;Elim H3;Intros H4 H5; Absurd (gt (convert h) O); [
-        Unfold gt ;Apply le_not_lt; Apply le_S_n; Exact H5
-      | Assumption]
-    | Split; [
-        Elim (ZL4 h); Intros i H3;Rewrite H3; Apply gt_Sn_O
-      | Change (lt (convert h) (convert xH)); 
-        Apply compare_convert_INFERIEUR;
-        Change (Zcompare (POS h) (POS xH))=INFERIEUR;
-        Rewrite <- H2; Rewrite <- [m,n:Z](Zcompare_Zplus_compatible m n y);
-        Rewrite (Zplus_sym x);Rewrite Zplus_assoc; Rewrite Zplus_inverse_r;
-        Simpl; Exact H1 ]]
-  | Intros H1;Rewrite -> H1;Discriminate ]
-| Intros H; (ElimCompare 'x '(Zplus y (POS xH))); [
-    Intros H1;Elim (Zcompare_EGAL x (Zplus y (POS xH))); Intros H2 H3;
-    Rewrite  (H2 H1); Exact (Zcompare_Zs_SUPERIEUR y)
-  | Intros H1;Absurd (Zcompare x (Zplus y (POS xH)))=INFERIEUR;Assumption
-  | Intros H1; Apply Zcompare_trans_SUPERIEUR with y:=(Zs y); 
-      [ Exact H1 | Exact (Zcompare_Zs_SUPERIEUR y)]]].
-Qed.
-
-(** Successor and comparison *)
-
-Lemma Zcompare_n_S : (n,m:Z)(Zcompare (Zs n) (Zs m)) = (Zcompare n m).
-Proof.
-Intros n m;Unfold Zs ;Do 2 Rewrite -> [t:Z](Zplus_sym t (POS xH));
-Rewrite -> Zcompare_Zplus_compatible;Auto with arith.
-Qed.
- 
-(** Multiplication and comparison *)
-
-Lemma Zcompare_Zmult_compatible : 
-   (x:positive)(y,z:Z)
-      (Zcompare (Zmult (POS x) y) (Zmult (POS x) z)) = (Zcompare y z).
-Proof.
-Intros x; NewInduction x as [p H|p H|]; [
-  Intros y z;
-  Cut (POS (xI p))=(Zplus (Zplus (POS p) (POS p)) (POS xH)); [
-    Intros E; Rewrite E; Do 4 Rewrite Zmult_plus_distr_l; 
-    Do 2 Rewrite Zmult_one;
-    Apply Zcompare_Zplus_compatible2; [
-      Apply Zcompare_Zplus_compatible2; Apply H
-    | Trivial with arith]
-  | Simpl; Rewrite (add_x_x p); Trivial with arith]
-| Intros y z; Cut (POS (xO p))=(Zplus (POS p) (POS p)); [
-    Intros E; Rewrite E; Do 2 Rewrite Zmult_plus_distr_l;
-      Apply Zcompare_Zplus_compatible2; Apply H
-    | Simpl; Rewrite (add_x_x p); Trivial with arith]
-  | Intros y z; Do 2 Rewrite Zmult_one; Trivial with arith].
-Qed.
-
-
-(** Reverting [x ?= y] to trichotomy *)
-
-Lemma rename : (A:Set)(P:A->Prop)(x:A) ((y:A)(x=y)->(P y)) -> (P x).
-Proof.
-Auto with arith. 
-Qed.
-
-Lemma Zcompare_elim :
-  (c1,c2,c3:Prop)(x,y:Z)
-    ((x=y) -> c1) ->(`x<y` -> c2) ->(`x>y`-> c3)
-     -> Cases (Zcompare x y) of EGAL => c1 | INFERIEUR => c2 | SUPERIEUR => c3 end.
-Proof.
-Intros c1 c2 c3 x y; Intros.
-Apply rename with x:=(Zcompare x y); Intro r; Elim r;
-[ Intro; Apply H; Apply (Zcompare_EGAL_eq x y); Assumption
-| Unfold Zlt in H0; Assumption
-| Unfold Zgt in H1; Assumption ].
-Qed.
-
-Lemma Zcompare_eq_case : 
-  (c1,c2,c3:Prop)(x,y:Z) c1 -> x=y ->
-  Cases (Zcompare x y) of EGAL => c1 | INFERIEUR => c2 | SUPERIEUR => c3 end.
-Proof.
-Intros c1 c2 c3 x y; Intros.
-Rewrite H0; Rewrite (Zcompare_x_x).
-Assumption.
-Qed.
-
-(** Decompose an egality between two [?=] relations into 3 implications *)
-
-Lemma Zcompare_egal_dec :
-   (x1,y1,x2,y2:Z)
-    (`x1<y1`->`x2<y2`)
-     ->((Zcompare x1 y1)=EGAL -> (Zcompare x2 y2)=EGAL)
-        ->(`x1>y1`->`x2>y2`)->(Zcompare x1 y1)=(Zcompare x2 y2).
-Proof.
-Intros x1 y1 x2 y2.
-Unfold Zgt; Unfold Zlt;
-Case (Zcompare x1 y1); Case (Zcompare x2 y2); Auto with arith; Symmetry; Auto with arith.
-Qed.
-
-(** Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *)
-
-Lemma Zle_Zcompare :
-  (x,y:Z)`x<=y` ->
-  Cases (Zcompare x y) of EGAL => True | INFERIEUR => True | SUPERIEUR => False end.
-Proof.
-Intros x y; Unfold Zle; Elim (Zcompare x y); Auto with arith.
-Qed.
-
-Lemma Zlt_Zcompare :
-  (x,y:Z)`x<y`  ->
-  Cases (Zcompare x y) of EGAL => False | INFERIEUR => True | SUPERIEUR => False end.
-Proof.
-Intros x y; Unfold Zlt; Elim (Zcompare x y); Intros; Discriminate Orelse Trivial with arith.
-Qed.
-
-Lemma Zge_Zcompare :
-  (x,y:Z)`x>=y`->
-  Cases (Zcompare x y) of EGAL => True | INFERIEUR => False | SUPERIEUR => True end.
-Proof.
-Intros x y; Unfold Zge; Elim (Zcompare x y); Auto with arith. 
-Qed.
-
-Lemma Zgt_Zcompare :
-  (x,y:Z)`x>y` ->
-  Cases (Zcompare x y) of EGAL => False | INFERIEUR => False | SUPERIEUR => True end.
-Proof.
-Intros x y; Unfold Zgt; Elim (Zcompare x y); Intros; Discriminate Orelse Trivial with arith.
-Qed.
-
-(**********************************************************************)
-(* Other properties *)
-
-V7only [Set Implicit Arguments.].
-
-Lemma  Zcompare_Zmult_left : (x,y,z:Z)`z>0` -> `x ?= y`=`z*x ?= z*y`.
-Proof.
-Intros x y z H; NewDestruct z.
-  Discriminate H.
-  Rewrite Zcompare_Zmult_compatible; Reflexivity.
-  Discriminate H.
-Qed.
-
-Lemma Zcompare_Zmult_right : (x,y,z:Z)` z>0` -> `x ?= y`=`x*z ?= y*z`.
-Proof.
-Intros x y z H;
-Rewrite (Zmult_sym x z);
-Rewrite (Zmult_sym y z);
-Apply Zcompare_Zmult_left; Assumption.
-Qed.
-
-V7only [Unset Implicit Arguments.].
-
diff --git a/theories7/ZArith/Zcomplements.v b/theories7/ZArith/Zcomplements.v
deleted file mode 100644
index 72d837b6..00000000
--- a/theories7/ZArith/Zcomplements.v
+++ /dev/null
@@ -1,212 +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: Zcomplements.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-Require ZArithRing.
-Require ZArith_base.
-Require Omega.
-Require Wf_nat.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-V7only [Set Implicit Arguments.].
-
-(**********************************************************************)
-(** About parity *)
-
-Lemma two_or_two_plus_one : (x:Z) { y:Z | `x = 2*y`}+{ y:Z | `x = 2*y+1`}. 
-Proof.
-Intro x; NewDestruct x.
-Left ; Split with ZERO; Reflexivity.
-
-NewDestruct p.
-Right ; Split with (POS p); Reflexivity.
-
-Left ; Split with (POS p); Reflexivity.
-
-Right ; Split with ZERO; Reflexivity.
-
-NewDestruct p.
-Right ; Split with (NEG (add xH p)).
-Rewrite NEG_xI.
-Rewrite NEG_add.
-Omega.
-
-Left ; Split with (NEG p); Reflexivity.
-
-Right ; Split with `-1`; Reflexivity.
-Qed.
-
-(**********************************************************************)
-(** The biggest power of 2 that is stricly less than [a]
-
-    Easy to compute: replace all "1" of the binary representation by
-    "0", except the first "1" (or the first one :-) *)
-
-Fixpoint floor_pos [a : positive] : positive :=
-  Cases a of
-  | xH => xH
-  | (xO a') => (xO (floor_pos a'))
-  | (xI b') => (xO (floor_pos b'))
-  end.
-
-Definition floor := [a:positive](POS (floor_pos a)).
-
-Lemma floor_gt0 : (x:positive) `(floor x) > 0`.
-Proof.
-Intro.
-Compute.
-Trivial.
-Qed.
-
-Lemma floor_ok : (a:positive) 
-  `(floor a) <=  (POS a) < 2*(floor a)`. 
-Proof.
-Unfold floor.
-Intro a; NewInduction a as [p|p|].
-
-Simpl.
-Repeat Rewrite POS_xI.
-Rewrite (POS_xO (xO (floor_pos p))). 
-Rewrite (POS_xO (floor_pos p)).
-Omega.
-
-Simpl.
-Repeat Rewrite POS_xI.
-Rewrite (POS_xO (xO (floor_pos p))).
-Rewrite (POS_xO (floor_pos p)).
-Rewrite (POS_xO p).
-Omega.
-
-Simpl; Omega.
-Qed.
-
-(**********************************************************************)
-(** Two more induction principles over [Z]. *)
-
-Theorem Z_lt_abs_rec : (P: Z -> Set)
-  ((n: Z) ((m: Z) `|m|<|n|` -> (P m)) -> (P n)) -> (p: Z) (P p).
-Proof.
-Intros P HP p.
-LetTac Q:=[z]`0<=z`->(P z)*(P `-z`).
-Cut (Q `|p|`);[Intros|Apply (Z_lt_rec Q);Auto with zarith].
-Elim (Zabs_dec p);Intro eq;Rewrite eq;Elim H;Auto with zarith.
-Unfold Q;Clear Q;Intros.
-Apply pair;Apply HP.
-Rewrite Zabs_eq;Auto;Intros.
-Elim (H `|m|`);Intros;Auto with zarith.
-Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
-Rewrite Zabs_non_eq;Auto with zarith.
-Rewrite Zopp_Zopp;Intros.
-Elim (H `|m|`);Intros;Auto with zarith.
-Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
-Qed.
-
-Theorem Z_lt_abs_induction : (P: Z -> Prop)
-  ((n: Z) ((m: Z) `|m|<|n|` -> (P m)) -> (P n)) -> (p: Z) (P p).
-Proof.
-Intros P HP p.
-LetTac Q:=[z]`0<=z`->(P z) /\ (P `-z`).
-Cut (Q `|p|`);[Intros|Apply (Z_lt_induction Q);Auto with zarith].
-Elim (Zabs_dec p);Intro eq;Rewrite eq;Elim H;Auto with zarith.
-Unfold Q;Clear Q;Intros.
-Split;Apply HP.
-Rewrite Zabs_eq;Auto;Intros.
-Elim (H `|m|`);Intros;Auto with zarith.
-Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
-Rewrite Zabs_non_eq;Auto with zarith.
-Rewrite Zopp_Zopp;Intros.
-Elim (H `|m|`);Intros;Auto with zarith.
-Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
-Qed.
-V7only [Unset Implicit Arguments.].
-
-(** To do case analysis over the sign of [z] *) 
-
-Lemma Zcase_sign : (x:Z)(P:Prop)
- (`x=0` -> P) ->
- (`x>0` -> P) ->
- (`x<0` -> P) -> P.
-Proof.
-Intros x P Hzero Hpos Hneg.
-Induction x.
-Apply Hzero; Trivial.
-Apply Hpos; Apply POS_gt_ZERO.
-Apply Hneg; Apply NEG_lt_ZERO.
-Save.
-
-Lemma sqr_pos : (x:Z)`x*x >= 0`.
-Proof.
-Intro x.
-Apply (Zcase_sign x `x*x >= 0`).
-Intros H; Rewrite H; Omega.
-Intros H; Replace `0` with `0*0`.
-Apply Zge_Zmult_pos_compat; Omega.
-Omega.
-Intros H; Replace `0` with `0*0`.
-Replace `x*x` with `(-x)*(-x)`.
-Apply Zge_Zmult_pos_compat; Omega.
-Ring.
-Omega.
-Save.
-
-(**********************************************************************)
-(** A list length in Z, tail recursive.  *)
-
-Require PolyList.
-
-Fixpoint Zlength_aux [acc: Z; A:Set; l:(list A)] : Z := Cases l of 
-    nil => acc
-  | (cons _ l) => (Zlength_aux (Zs acc) A l)
-end. 
-
-Definition Zlength := (Zlength_aux 0).
-Implicits Zlength [1].
-
-Section Zlength_properties.
-
-Variable A:Set.
-
-Implicit Variable Type l:(list A).
-
-Lemma Zlength_correct : (l:(list A))(Zlength l)=(inject_nat (length l)).
-Proof.
-Assert (l:(list A))(acc:Z)(Zlength_aux acc A l)=acc+(inject_nat (length l)). 
-Induction l.
-Simpl; Auto with zarith.
-Intros; Simpl (length (cons a l0)); Rewrite inj_S.
-Simpl; Rewrite H; Auto with zarith.
-Unfold Zlength; Intros; Rewrite H; Auto.
-Qed.
-
-Lemma Zlength_nil : (Zlength 1!A (nil A))=0.
-Proof.
-Auto.
-Qed.
-
-Lemma Zlength_cons : (x:A)(l:(list A))(Zlength (cons x l))=(Zs (Zlength l)).
-Proof.
-Intros; Do 2 Rewrite Zlength_correct.
-Simpl (length (cons x l)); Rewrite inj_S; Auto.
-Qed.
-
-Lemma Zlength_nil_inv : (l:(list A))(Zlength l)=0 -> l=(nil ?).
-Proof.
-Intro l; Rewrite Zlength_correct.
-Case l; Auto.
-Intros x l'; Simpl (length (cons x l')).
-Rewrite inj_S.
-Intros; ElimType False; Generalize (ZERO_le_inj (length l')); Omega.
-Qed.
-
-End Zlength_properties.
-
-Implicits Zlength_correct [1].
-Implicits Zlength_cons [1].
-Implicits Zlength_nil_inv [1].
diff --git a/theories7/ZArith/Zdiv.v b/theories7/ZArith/Zdiv.v
deleted file mode 100644
index 84d53931..00000000
--- a/theories7/ZArith/Zdiv.v
+++ /dev/null
@@ -1,432 +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: Zdiv.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-(* Contribution by Claude Marché and Xavier Urbain *)
-
-(**
-
-Euclidean Division
-
-Defines first of function that allows Coq to normalize. 
-Then only after proves the main required property.
-
-*)
-
-Require Export ZArith_base.
-Require Zbool.
-Require Omega.
-Require ZArithRing.
-Require Zcomplements.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-(**
-
-  Euclidean division of a positive by a integer 
-  (that is supposed to be positive).
-
-  total function than returns an arbitrary value when
-  divisor is not positive
-  
-*)
-
-Fixpoint Zdiv_eucl_POS [a:positive] : Z -> Z*Z := [b:Z]
- Cases a of
- | xH => if `(Zge_bool b 2)` then `(0,1)` else `(1,0)` 
- | (xO a') => 
-    let (q,r) = (Zdiv_eucl_POS a' b) in 
-    [r':=`2*r`] if `(Zgt_bool b r')` then `(2*q,r')` else `(2*q+1,r'-b)`
- | (xI a') =>
-    let (q,r) = (Zdiv_eucl_POS a' b) in 
-    [r':=`2*r+1`] if `(Zgt_bool b r')` then `(2*q,r')` else `(2*q+1,r'-b)`
- end.
-
-
-(**
-
-  Euclidean division of integers.
- 
-  Total function than returns (0,0) when dividing by 0. 
-
-*) 
-    
-(* 
-
-  The pseudo-code is:
-  
-  if b = 0 : (0,0)
- 
-  if b <> 0 and a = 0 : (0,0)
-
-  if b > 0 and a < 0 : let (q,r) = div_eucl_pos (-a) b in 
-                       if r = 0 then (-q,0) else (-(q+1),b-r)
-
-  if b < 0 and a < 0 : let (q,r) = div_eucl (-a) (-b) in (q,-r)
-
-  if b < 0 and a > 0 : let (q,r) = div_eucl a (-b) in 
-                       if r = 0 then (-q,0) else (-(q+1),b+r)
-
-  In other word, when b is non-zero, q is chosen to be the greatest integer 
-  smaller or equal to a/b. And sgn(r)=sgn(b) and |r| < |b|.
-
-*)
-
-Definition Zdiv_eucl [a,b:Z] : Z*Z :=
-  Cases a b of
-  | ZERO _  => `(0,0)`
-  | _ ZERO  => `(0,0)`
-  | (POS a') (POS _) => (Zdiv_eucl_POS a' b)
-  | (NEG a') (POS _) => 
-      let (q,r) = (Zdiv_eucl_POS a' b) in 
-      Cases r of 
-      | ZERO => `(-q,0)`
-      | _    => `(-(q+1),b-r)`
-      end
-  | (NEG a') (NEG b') => 
-	 let (q,r) = (Zdiv_eucl_POS a' (POS b')) in `(q,-r)`
-  | (POS a') (NEG b') =>
-      let (q,r) = (Zdiv_eucl_POS a' (POS b')) in 
-      Cases r of 
-      | ZERO => `(-q,0)`
-      | _    => `(-(q+1),b+r)`
-      end
-    end.
-
-
-(** Division and modulo are projections of [Zdiv_eucl] *)
-     
-Definition Zdiv [a,b:Z] : Z := let (q,_) = (Zdiv_eucl a b) in q.
-
-Definition Zmod [a,b:Z] : Z := let (_,r) = (Zdiv_eucl a b) in r. 
-
-(* Tests:
-
-Eval Compute in `(Zdiv_eucl 7 3)`. 
-
-Eval Compute in `(Zdiv_eucl (-7) 3)`.
-
-Eval Compute in `(Zdiv_eucl 7 (-3))`.
-
-Eval Compute in `(Zdiv_eucl (-7) (-3))`.
-
-*)
-
-
-(**
-
-  Main division theorem. 
-
-  First a lemma for positive
-
-*)
-
-Lemma Z_div_mod_POS : (b:Z)`b > 0` -> (a:positive)
-  let (q,r)=(Zdiv_eucl_POS a b) in `(POS a) = b*q + r`/\`0<=r<b`.
-Proof.
-Induction a; Unfold Zdiv_eucl_POS; Fold Zdiv_eucl_POS.
-
-Intro p; Case (Zdiv_eucl_POS p b); Intros q r (H0,H1).
-Generalize (Zgt_cases b `2*r+1`).
-Case (Zgt_bool b `2*r+1`); 
-(Rewrite POS_xI; Rewrite H0; Split ; [ Ring | Omega ]).
-
-Intros p; Case (Zdiv_eucl_POS p b); Intros q r (H0,H1).
-Generalize (Zgt_cases b `2*r`).
-Case (Zgt_bool b `2*r`);
- Rewrite POS_xO; Change (POS (xO p)) with `2*(POS p)`; 
- Rewrite H0; (Split; [Ring | Omega]).
-
-Generalize (Zge_cases b `2`).
-Case (Zge_bool b `2`); (Intros; Split; [Ring | Omega ]).
-Omega.
-Qed.
-
-
-Theorem Z_div_mod : (a,b:Z)`b > 0` -> 
-  let (q,r) = (Zdiv_eucl a b) in `a = b*q + r` /\ `0<=r<b`.
-Proof.
-Intros a b; Case a; Case b; Try (Simpl; Intros; Omega).
-Unfold Zdiv_eucl; Intros; Apply Z_div_mod_POS; Trivial.
-
-Intros; Discriminate.
-
-Intros.
-Generalize (Z_div_mod_POS (POS p) H p0).
-Unfold Zdiv_eucl.
-Case (Zdiv_eucl_POS p0 (POS p)).
-Intros z z0.
-Case z0.
-
-Intros [H1 H2].
-Split; Trivial.
-Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
-
-Intros p1 [H1 H2].
-Split; Trivial.
-Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
-Generalize (POS_gt_ZERO p1); Omega.
-
-Intros p1 [H1 H2].
-Split; Trivial.
-Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
-Generalize (NEG_lt_ZERO p1); Omega.
-
-Intros; Discriminate.
-Qed.
-
-(** Existence theorems *)
-
-Theorem Zdiv_eucl_exist : (b:Z)`b > 0` -> (a:Z)
-  { qr:Z*Z | let (q,r)=qr in `a=b*q+r` /\ `0 <= r < b` }.
-Proof.
-Intros b Hb a.
-Exists (Zdiv_eucl a b).
-Exact (Z_div_mod a b Hb).
-Qed.
-
-Implicits Zdiv_eucl_exist.
-
-Theorem Zdiv_eucl_extended : (b:Z)`b <> 0` -> (a:Z)
-  { qr:Z*Z | let (q,r)=qr in `a=b*q+r` /\ `0 <= r < |b|` }.
-Proof.
-Intros b Hb a.
-Elim (Z_le_gt_dec `0` b);Intro Hb'.
-Cut `b>0`;[Intro Hb''|Omega].
-Rewrite Zabs_eq;[Apply Zdiv_eucl_exist;Assumption|Assumption].
-Cut `-b>0`;[Intro Hb''|Omega].
-Elim (Zdiv_eucl_exist Hb'' a);Intros qr.
-Elim qr;Intros q r Hqr.
-Exists (pair ? ? `-q` r).
-Elim Hqr;Intros.
-Split.
-Rewrite <- Zmult_Zopp_left;Assumption.
-Rewrite Zabs_non_eq;[Assumption|Omega].
-Qed.
-
-Implicits Zdiv_eucl_extended.
-
-(** Auxiliary lemmas about [Zdiv] and [Zmod] *)
-
-Lemma Z_div_mod_eq : (a,b:Z)`b > 0` -> `a = b * (Zdiv a b) + (Zmod a b)`.
-Proof.
-Unfold Zdiv Zmod.
-Intros a b Hb.
-Generalize (Z_div_mod a b Hb).
-Case (Zdiv_eucl); Tauto.
-Save.
-
-Lemma Z_mod_lt : (a,b:Z)`b > 0` -> `0 <= (Zmod a b) < b`.
-Proof.
-Unfold Zmod.
-Intros a b Hb.
-Generalize (Z_div_mod a b Hb).
-Case (Zdiv_eucl a b); Tauto.
-Save.
-
-Lemma Z_div_POS_ge0 : (b:Z)(a:positive)
-  let (q,_) = (Zdiv_eucl_POS a b) in `q >= 0`.
-Proof.
-Induction a; Unfold Zdiv_eucl_POS; Fold Zdiv_eucl_POS.
-Intro p; Case (Zdiv_eucl_POS p b).
-Intros; Case (Zgt_bool b `2*z0+1`); Intros; Omega.
-Intro p; Case (Zdiv_eucl_POS p b).
-Intros; Case (Zgt_bool b `2*z0`); Intros; Omega.
-Case (Zge_bool b `2`); Simpl; Omega.
-Save.
-
-Lemma Z_div_ge0 : (a,b:Z)`b > 0` -> `a >= 0` -> `(Zdiv a b) >= 0`.
-Proof.
-Intros a b Hb; Unfold Zdiv Zdiv_eucl; Case a; Simpl; Intros.
-Case b; Simpl; Trivial.
-Generalize Hb; Case b; Try Trivial.
-Auto with zarith.
-Intros p0 Hp0; Generalize (Z_div_POS_ge0 (POS p0) p).
-Case (Zdiv_eucl_POS p (POS p0)); Simpl; Tauto.
-Intros; Discriminate.
-Elim H; Trivial.
-Save.
-
-Lemma Z_div_lt : (a,b:Z)`b >= 2` -> `a > 0` -> `(Zdiv a b) < a`.
-Proof.
-Intros. Cut `b > 0`; [Intro Hb | Omega].
-Generalize (Z_div_mod a b Hb).
-Cut `a >= 0`; [Intro Ha | Omega].
-Generalize (Z_div_ge0 a b Hb Ha).
-Unfold Zdiv; Case (Zdiv_eucl a b); Intros q r H1 [H2 H3].
-Cut `a >= 2*q` -> `q < a`; [ Intro h; Apply h; Clear h | Intros; Omega ].
-Apply Zge_trans with `b*q`.
-Omega.
-Auto with zarith.
-Save.
-
-(** Syntax *)
-
-V7only[
-Grammar znatural expr2 : constr :=
-  expr_div  [ expr2($p) "/" expr2($c) ] -> [ (Zdiv $p $c) ]
-| expr_mod  [ expr2($p) "%" expr2($c) ] -> [ (Zmod $p $c) ]
-.
-
-Syntax constr
-  level 6:
-    Zdiv [ (Zdiv $n1 $n2) ]
-      -> [ [<hov 0> "`"(ZEXPR $n1):E "/" [0 0] (ZEXPR $n2):L "`"] ]
-  | Zmod [ (Zmod $n1 $n2) ]
-      -> [ [<hov 0> "`"(ZEXPR $n1):E "%" [0 0] (ZEXPR $n2):L "`"] ]
-  | Zdiv_inside
-      [ << (ZEXPR <<(Zdiv $n1 $n2)>>) >> ]
-      	 -> [ (ZEXPR $n1):E "/" [0 0] (ZEXPR $n2):L ]
-  | Zmod_inside
-      [ << (ZEXPR <<(Zmod $n1 $n2)>>) >> ]
-      	 -> [ (ZEXPR $n1):E " %" [1 0] (ZEXPR $n2):L ]
-.
-].
-
-
-Infix 3 "/" Zdiv (no associativity) : Z_scope V8only.
-Infix 3 "mod" Zmod (no associativity) : Z_scope.
-
-(** Other lemmas (now using the syntax for [Zdiv] and [Zmod]). *)
-
-Lemma Z_div_ge : (a,b,c:Z)`c > 0`->`a >= b`->`a/c >= b/c`.
-Proof.
-Intros a b c cPos aGeb.
-Generalize (Z_div_mod_eq a c cPos).
-Generalize (Z_mod_lt a c cPos).
-Generalize (Z_div_mod_eq b c cPos).
-Generalize (Z_mod_lt b c cPos).
-Intros.
-Elim (Z_ge_lt_dec `a/c` `b/c`); Trivial.
-Intro.
-Absurd `b-a >= 1`.
-Omega.
-Rewrite -> H0.
-Rewrite -> H2.
-Assert `c*(b/c)+b % c-(c*(a/c)+a % c) = c*(b/c - a/c) + b % c - a % c`.
-Ring.
-Rewrite H3.
-Assert `c*(b/c-a/c) >= c*1`.
-Apply Zge_Zmult_pos_left.
-Omega.
-Omega.
-Assert `c*1=c`.
-Ring.
-Omega.
-Save.
-
-Lemma Z_mod_plus : (a,b,c:Z)`c > 0`->`(a+b*c) % c = a % c`.
-Proof.
-Intros a b c cPos.
-Generalize (Z_div_mod_eq a c cPos).
-Generalize (Z_mod_lt a c cPos).
-Generalize (Z_div_mod_eq `a+b*c` c cPos).
-Generalize (Z_mod_lt `a+b*c` c cPos).
-Intros.
-
-Assert `(a+b*c) % c - a % c = c*(b+a/c - (a+b*c)/c)`.
-Replace `(a+b*c) % c` with `a+b*c - c*((a+b*c)/c)`.
-Replace `a % c` with `a - c*(a/c)`.
-Ring.
-Omega.
-Omega.
-LetTac q := `b+a/c-(a+b*c)/c`.
-Apply (Zcase_sign q); Intros.
-Assert `c*q=0`.
-Rewrite H4; Ring.
-Rewrite H5 in H3.
-Omega.
-
-Assert `c*q >= c`.
-Pattern 2 c; Replace c with `c*1`.
-Apply Zge_Zmult_pos_left; Omega.
-Ring.
-Omega.
-
-Assert `c*q <= -c`.
-Replace `-c` with `c*(-1)`.
-Apply Zle_Zmult_pos_left; Omega.
-Ring.
-Omega.
-Save.
-
-Lemma Z_div_plus : (a,b,c:Z)`c > 0`->`(a+b*c)/c = a/c+b`.
-Proof.
-Intros a b c cPos.
-Generalize (Z_div_mod_eq a c cPos).
-Generalize (Z_mod_lt a c cPos).
-Generalize (Z_div_mod_eq `a+b*c` c cPos).
-Generalize (Z_mod_lt `a+b*c` c cPos).
-Intros.
-Apply Zmult_reg_left with c. Omega.
-Replace `c*((a+b*c)/c)` with `a+b*c-(a+b*c) % c`.
-Rewrite (Z_mod_plus a b c cPos).
-Pattern 1 a; Rewrite H2.
-Ring.
-Pattern 1 `a+b*c`; Rewrite H0.
-Ring.
-Save.
-
-Lemma Z_div_mult : (a,b:Z)`b > 0`->`(a*b)/b = a`.
-Intros; Replace `a*b` with `0+a*b`; Auto.
-Rewrite Z_div_plus; Auto.
-Save.
-
-Lemma Z_mult_div_ge : (a,b:Z)`b>0`->`b*(a/b) <= a`.
-Proof.
-Intros a b bPos.
-Generalize (Z_div_mod_eq `a` ? bPos); Intros.
-Generalize (Z_mod_lt `a` ? bPos); Intros.
-Pattern 2 a; Rewrite H.
-Omega.
-Save.
-
-Lemma Z_mod_same : (a:Z)`a>0`->`a % a=0`.
-Proof.
-Intros a aPos.
-Generalize (Z_mod_plus `0` `1` a aPos).
-Replace `0+1*a` with `a`.
-Intros.
-Rewrite H.
-Compute.
-Trivial.
-Ring.
-Save.
-
-Lemma Z_div_same : (a:Z)`a>0`->`a/a=1`.
-Proof.
-Intros a aPos.
-Generalize (Z_div_plus `0` `1` a aPos).
-Replace `0+1*a` with `a`.
-Intros.
-Rewrite H.
-Compute.
-Trivial.
-Ring.
-Save.
-
-Lemma Z_div_exact_1 : (a,b:Z)`b>0` -> `a = b*(a/b)` -> `a%b = 0`.
-Intros a b Hb; Generalize (Z_div_mod a b Hb); Unfold Zmod Zdiv.
-Case (Zdiv_eucl a b); Intros q r; Omega.
-Save.
-
-Lemma Z_div_exact_2 : (a,b:Z)`b>0` -> `a%b = 0` -> `a = b*(a/b)`.
-Intros a b Hb; Generalize (Z_div_mod a b Hb); Unfold Zmod Zdiv.
-Case (Zdiv_eucl a b); Intros q r; Omega.
-Save.
-
-Lemma Z_mod_zero_opp : (a,b:Z)`b>0` -> `a%b = 0` -> `(-a)%b = 0`.
-Intros a b Hb.
-Intros.
-Rewrite Z_div_exact_2 with a b; Auto.
-Replace `-(b*(a/b))` with `0+(-(a/b))*b`.
-Rewrite Z_mod_plus; Auto.
-Ring.
-Save.
-
diff --git a/theories7/ZArith/Zeven.v b/theories7/ZArith/Zeven.v
deleted file mode 100644
index 04b3ec09..00000000
--- a/theories7/ZArith/Zeven.v
+++ /dev/null
@@ -1,184 +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: Zeven.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-Require BinInt.
-Require Zsyntax.
-
-(**********************************************************************)
-(** About parity: even and odd predicates on Z, division by 2 on Z *)
-
-(**********************************************************************)
-(** [Zeven], [Zodd], [Zdiv2] and their related properties *)
-
-Definition Zeven := 
-  [z:Z]Cases z of ZERO => True
-                | (POS (xO _)) => True
-		| (NEG (xO _)) => True
-		| _ => False
-               end.
-
-Definition Zodd := 
-  [z:Z]Cases z of (POS xH) => True
-                | (NEG xH) => True
-                | (POS (xI _)) => True
-		| (NEG (xI _)) => True
-		| _ => False
-               end.
-
-Definition Zeven_bool :=
-  [z:Z]Cases z of ZERO => true
-                | (POS (xO _)) => true
-		| (NEG (xO _)) => true
-		| _ => false
-               end.
-
-Definition Zodd_bool := 
-  [z:Z]Cases z of ZERO => false
-                | (POS (xO _)) => false
-		| (NEG (xO _)) => false
-		| _ => true
-               end.
-
-Definition Zeven_odd_dec : (z:Z) { (Zeven z) }+{ (Zodd z) }.
-Proof.
-  Intro z. Case z;
-  [ Left; Compute; Trivial
-  | Intro p; Case p; Intros; 
-    (Right; Compute; Exact I) Orelse (Left; Compute; Exact I)
-  | Intro p; Case p; Intros; 
-    (Right; Compute; Exact I) Orelse (Left; Compute; Exact I) ].
-Defined.
-
-Definition Zeven_dec : (z:Z) { (Zeven z) }+{ ~(Zeven z) }.
-Proof.
-  Intro z. Case z;
-  [ Left; Compute; Trivial
-  | Intro p; Case p; Intros; 
-    (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) 
-  | Intro p; Case p; Intros; 
-    (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) ].
-Defined.
-
-Definition Zodd_dec : (z:Z) { (Zodd z) }+{ ~(Zodd z) }.
-Proof.
-  Intro z. Case z;
-  [ Right; Compute; Trivial
-  | Intro p; Case p; Intros; 
-    (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) 
-  | Intro p; Case p; Intros; 
-    (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) ].
-Defined.
-
-Lemma Zeven_not_Zodd : (z:Z)(Zeven z) -> ~(Zodd z).
-Proof.
-  Intro z; NewDestruct z; [ Idtac | NewDestruct p | NewDestruct p  ]; Compute; Trivial.
-Qed.
-
-Lemma Zodd_not_Zeven : (z:Z)(Zodd z) -> ~(Zeven z).
-Proof.
-  Intro z; NewDestruct z; [ Idtac | NewDestruct p | NewDestruct p  ]; Compute; Trivial.
-Qed.
-
-Lemma Zeven_Sn : (z:Z)(Zodd z) -> (Zeven (Zs z)).
-Proof.
- Intro z; NewDestruct z; Unfold Zs; [ Idtac | NewDestruct p | NewDestruct p  ]; Simpl; Trivial. 
- Unfold double_moins_un; Case p; Simpl; Auto.
-Qed.
-
-Lemma Zodd_Sn : (z:Z)(Zeven z) -> (Zodd (Zs z)).
-Proof.
- Intro z; NewDestruct z; Unfold Zs; [ Idtac | NewDestruct p | NewDestruct p  ]; Simpl; Trivial. 
- Unfold double_moins_un; Case p; Simpl; Auto.
-Qed.
-
-Lemma Zeven_pred : (z:Z)(Zodd z) -> (Zeven (Zpred z)).
-Proof.
- Intro z; NewDestruct z; Unfold Zpred; [ Idtac | NewDestruct p | NewDestruct p  ]; Simpl; Trivial. 
- Unfold double_moins_un; Case p; Simpl; Auto.
-Qed.
-
-Lemma Zodd_pred : (z:Z)(Zeven z) -> (Zodd (Zpred z)).
-Proof.
- Intro z; NewDestruct z; Unfold Zpred; [ Idtac | NewDestruct p | NewDestruct p  ]; Simpl; Trivial. 
- Unfold double_moins_un; Case p; Simpl; Auto.
-Qed.
-
-Hints Unfold Zeven Zodd : zarith.
-
-(**********************************************************************)
-(** [Zdiv2] is defined on all [Z], but notice that for odd negative
-    integers it is not the euclidean quotient: in that case we have [n =
-    2*(n/2)-1] *)
-
-Definition Zdiv2 :=
-  [z:Z]Cases z of ZERO => ZERO
-                | (POS xH) => ZERO
-                | (POS p) => (POS (Zdiv2_pos p))
-		| (NEG xH) => ZERO
-		| (NEG p) => (NEG (Zdiv2_pos p))
-	       end.
-
-Lemma Zeven_div2 : (x:Z) (Zeven x) -> `x = 2*(Zdiv2 x)`.
-Proof.
-Intro x; NewDestruct x.
-Auto with arith.
-NewDestruct p; Auto with arith.
-Intros. Absurd (Zeven (POS (xI p))); Red; Auto with arith.
-Intros. Absurd (Zeven `1`); Red; Auto with arith.
-NewDestruct p; Auto with arith.
-Intros. Absurd (Zeven (NEG (xI p))); Red; Auto with arith.
-Intros. Absurd (Zeven `-1`); Red; Auto with arith.
-Qed.
-
-Lemma Zodd_div2 : (x:Z) `x >= 0` -> (Zodd x) -> `x = 2*(Zdiv2 x)+1`.
-Proof.
-Intro x; NewDestruct x.
-Intros. Absurd (Zodd `0`); Red; Auto with arith.
-NewDestruct p; Auto with arith.
-Intros. Absurd (Zodd (POS (xO p))); Red; Auto with arith.
-Intros. Absurd `(NEG p) >= 0`; Red; Auto with arith.
-Qed.
-
-Lemma Zodd_div2_neg : (x:Z) `x <= 0` -> (Zodd x) -> `x = 2*(Zdiv2 x)-1`.
-Proof.
-Intro x; NewDestruct x.
-Intros. Absurd (Zodd `0`); Red; Auto with arith.
-Intros. Absurd `(NEG p) >= 0`; Red; Auto with arith.
-NewDestruct p; Auto with arith.
-Intros. Absurd (Zodd (NEG (xO p))); Red; Auto with arith.
-Qed.
-
-Lemma Z_modulo_2 : (x:Z) { y:Z | `x=2*y` }+{ y:Z | `x=2*y+1` }.
-Proof.
-Intros x.
-Elim (Zeven_odd_dec x); Intro.
-Left. Split with (Zdiv2 x). Exact (Zeven_div2 x a).
-Right. Generalize b; Clear b; Case x.
-Intro b; Inversion b.
-Intro p; Split with (Zdiv2 (POS p)). Apply (Zodd_div2 (POS p)); Trivial.
-Unfold Zge Zcompare; Simpl; Discriminate.
-Intro p; Split with (Zdiv2 (Zpred (NEG p))).
-Pattern 1 (NEG p); Rewrite (Zs_pred (NEG p)).
-Pattern 1 (Zpred (NEG p)); Rewrite (Zeven_div2 (Zpred (NEG p))).
-Reflexivity.
-Apply Zeven_pred; Assumption.
-Qed.
-
-Lemma Zsplit2 :  (x:Z) { p : Z*Z | let (x1,x2)=p in (`x=x1+x2` /\ (x1=x2 \/ `x2=x1+1`)) }.
-Proof.
-Intros x.
-Elim (Z_modulo_2 x); Intros (y,Hy); Rewrite Zmult_sym in Hy; Rewrite <- Zplus_Zmult_2 in Hy.
-Exists (y,y); Split. 
-Assumption.
-Left; Reflexivity.
-Exists (y,`y+1`); Split.
-Rewrite Zplus_assoc; Assumption.
-Right; Reflexivity.
-Qed.
diff --git a/theories7/ZArith/Zhints.v b/theories7/ZArith/Zhints.v
deleted file mode 100644
index 01860d18..00000000
--- a/theories7/ZArith/Zhints.v
+++ /dev/null
@@ -1,387 +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: Zhints.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-(** This file centralizes the lemmas about [Z], classifying them
-    according to the way they can be used in automatic search  *)
-
-(*i*)
-
-(* Lemmas which clearly leads to simplification during proof search are *)
-(* declared as Hints. A definite status (Hint or not) for the other lemmas *)
-(* remains to be given *)
-
-(* Structure of the file *)
-(* - simplification lemmas (only those are declared as Hints) *)
-(* - reversible lemmas relating operators *)
-(* - useful Bottom-up lemmas              *)
-(* - irreversible lemmas with meta-variables *)
-(* - unclear or too specific lemmas       *)
-(* - lemmas to be used as rewrite rules   *)
-
-(* Lemmas involving positive and compare are not taken into account *)
-
-Require BinInt.
-Require Zorder.
-Require Zmin.
-Require Zabs.
-Require Zcompare.
-Require Znat.
-Require auxiliary.
-Require Zsyntax.
-Require Zmisc.
-Require Wf_Z.
-
-(**********************************************************************)
-(*                  Simplification lemmas                             *)
-(* No subgoal or smaller subgoals                                     *)
-
-Hints Resolve
-  (* A) Reversible simplification lemmas (no loss of information)      *)
-  (* Should clearly declared as hints                                  *)
-  
-  (* Lemmas ending by eq *)
-  Zeq_S (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *)
-  
-  (* Lemmas ending by Zgt *)
-  Zgt_n_S (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *)
-  Zgt_Sn_n (* :(n:Z)`(Zs n) > n` *)
-  POS_gt_ZERO (* :(p:positive)`(POS p) > 0` *)
-  Zgt_reg_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *)
-  Zgt_reg_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *)
-  
-  (* Lemmas ending by Zlt *)
-  Zlt_n_Sn (* :(n:Z)`n < (Zs n)` *)
-  Zlt_n_S (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *)
-  Zlt_pred_n_n (* :(n:Z)`(Zpred n) < n` *)
-  Zlt_reg_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *)
-  Zlt_reg_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *)
-  
-  (* Lemmas ending by Zle *)
-  ZERO_le_inj (* :(n:nat)`0 <= (inject_nat n)` *)
-  ZERO_le_POS (* :(p:positive)`0 <= (POS p)` *)
-  Zle_n (* :(n:Z)`n <= n` *)
-  Zle_n_Sn (* :(n:Z)`n <= (Zs n)` *)
-  Zle_n_S (* :(n,m:Z)`m <= n`->`(Zs m) <= (Zs n)` *)
-  Zle_pred_n (* :(n:Z)`(Zpred n) <= n` *)
-  Zle_min_l (* :(n,m:Z)`(Zmin n m) <= n` *)
-  Zle_min_r (* :(n,m:Z)`(Zmin n m) <= m` *)
-  Zle_reg_l (* :(n,m,p:Z)`n <= m`->`p+n <= p+m` *)
-  Zle_reg_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *)
-  Zabs_pos (* :(x:Z)`0 <= |x|` *)
-  
-  (* B) Irreversible simplification lemmas : Probably to be declared as *)
-  (* hints, when no other simplification is possible *)
-  
-  (* Lemmas ending by eq *)
-  Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *)
-  Zplus_simpl (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *)
-  
-  (* Lemmas ending by Zge *)
-  Zge_Zmult_pos_right (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *)
-  Zge_Zmult_pos_left (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *)
-  Zge_Zmult_pos_compat (* :
-    (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *)
-  
-  (* Lemmas ending by Zlt *)
-  Zgt_ZERO_mult (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *)
-  Zlt_S (* :(n,m:Z)`n < m`->`n < (Zs m)` *)
-  
-  (* Lemmas ending by Zle *)
-  Zle_ZERO_mult (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *)
-  Zle_Zmult_pos_right (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *)
-  Zle_Zmult_pos_left (* :(a,b,c:Z)`a <= b`->`0 <= c`->`c*a <= c*b` *)
-  OMEGA2 (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x+y` *)
-  Zle_le_S (* :(x,y:Z)`x <= y`->`x <= (Zs y)` *)
-  Zle_plus_plus (* :(n,m,p,q:Z)`n <= m`->`p <= q`->`n+p <= m+q` *)
-
-: zarith.
-  
-(**********************************************************************)
-(*         Reversible lemmas relating operators                       *)
-(* Probably to be declared as hints but need to define precedences    *)
-
-(* A) Conversion between comparisons/predicates and arithmetic operators
-
-(* Lemmas ending by eq *)
-Zegal_left: (x,y:Z)`x = y`->`x+(-y) = 0`
-Zabs_eq: (x:Z)`0 <= x`->`|x| = x`
-Zeven_div2: (x:Z)(Zeven x)->`x = 2*(Zdiv2 x)`
-Zodd_div2: (x:Z)`x >= 0`->(Zodd x)->`x = 2*(Zdiv2 x)+1`
-
-(* Lemmas ending by Zgt *)
-Zgt_left_rev: (x,y:Z)`x+(-y) > 0`->`x > y`
-Zgt_left_gt: (x,y:Z)`x > y`->`x+(-y) > 0`
-
-(* Lemmas ending by Zlt *)
-Zlt_left_rev: (x,y:Z)`0 < y+(-x)`->`x < y`
-Zlt_left_lt: (x,y:Z)`x < y`->`0 < y+(-x)`
-Zlt_O_minus_lt: (n,m:Z)`0 < n-m`->`m < n`
-
-(* Lemmas ending by Zle *)
-Zle_left: (x,y:Z)`x <= y`->`0 <= y+(-x)`
-Zle_left_rev: (x,y:Z)`0 <= y+(-x)`->`x <= y`
-Zlt_left: (x,y:Z)`x < y`->`0 <= y+(-1)+(-x)`
-Zge_left: (x,y:Z)`x >= y`->`0 <= x+(-y)`
-Zgt_left: (x,y:Z)`x > y`->`0 <= x+(-1)+(-y)`
-
-(* B) Conversion between nat comparisons and Z comparisons *)
-
-(* Lemmas ending by eq *)
-inj_eq: (x,y:nat)x=y->`(inject_nat x) = (inject_nat y)`
-
-(* Lemmas ending by Zge *)
-inj_ge: (x,y:nat)(ge x y)->`(inject_nat x) >= (inject_nat y)`
-
-(* Lemmas ending by Zgt *)
-inj_gt: (x,y:nat)(gt x y)->`(inject_nat x) > (inject_nat y)`
-
-(* Lemmas ending by Zlt *)
-inj_lt: (x,y:nat)(lt x y)->`(inject_nat x) < (inject_nat y)`
-
-(* Lemmas ending by Zle *)
-inj_le: (x,y:nat)(le x y)->`(inject_nat x) <= (inject_nat y)`
-
-(* C) Conversion between comparisons *)
-
-(* Lemmas ending by Zge *)
-not_Zlt: (x,y:Z)~`x < y`->`x >= y`
-Zle_ge: (m,n:Z)`m <= n`->`n >= m`
-
-(* Lemmas ending by Zgt *)
-Zle_gt_S: (n,p:Z)`n <= p`->`(Zs p) > n`
-not_Zle: (x,y:Z)~`x <= y`->`x > y`
-Zlt_gt: (m,n:Z)`m < n`->`n > m`
-Zle_S_gt: (n,m:Z)`(Zs n) <= m`->`m > n`
-
-(* Lemmas ending by Zlt *)
-not_Zge: (x,y:Z)~`x >= y`->`x < y`
-Zgt_lt: (m,n:Z)`m > n`->`n < m`
-Zle_lt_n_Sm: (n,m:Z)`n <= m`->`n < (Zs m)`
-
-(* Lemmas ending by Zle *)
-Zlt_ZERO_pred_le_ZERO: (x:Z)`0 < x`->`0 <= (Zpred x)`
-not_Zgt: (x,y:Z)~`x > y`->`x <= y`
-Zgt_le_S: (n,p:Z)`p > n`->`(Zs n) <= p`
-Zgt_S_le: (n,p:Z)`(Zs p) > n`->`n <= p`
-Zge_le: (m,n:Z)`m >= n`->`n <= m`
-Zlt_le_S: (n,p:Z)`n < p`->`(Zs n) <= p`
-Zlt_n_Sm_le: (n,m:Z)`n < (Zs m)`->`n <= m`
-Zlt_le_weak: (n,m:Z)`n < m`->`n <= m`
-Zle_refl: (n,m:Z)`n = m`->`n <= m`
-
-(* D) Irreversible simplification involving several comparaisons, *)
-(*    useful with clear precedences *)
-
-(* Lemmas ending by Zlt *)
-Zlt_le_reg :(a,b,c,d:Z)`a < b`->`c <= d`->`a+c < b+d`
-Zle_lt_reg : (a,b,c,d:Z)`a <= b`->`c < d`->`a+c < b+d`
-
-(* D) What is decreasing here ? *)
-
-(* Lemmas ending by eq *)
-Zplus_minus: (n,m,p:Z)`n = m+p`->`p = n-m`
-
-(* Lemmas ending by Zgt *)
-Zgt_pred: (n,p:Z)`p > (Zs n)`->`(Zpred p) > n`
-
-(* Lemmas ending by Zlt *)
-Zlt_pred: (n,p:Z)`(Zs n) < p`->`n < (Zpred p)`
-
-*)
-
-(**********************************************************************)
-(*                 Useful Bottom-up lemmas                            *)
-
-(* A) Bottom-up simplification: should be used 
-
-(* Lemmas ending by eq *)
-Zeq_add_S: (n,m:Z)`(Zs n) = (Zs m)`->`n = m`
-Zsimpl_plus_l: (n,m,p:Z)`n+m = n+p`->`m = p`
-Zplus_unit_left: (n,m:Z)`n+0 = m`->`n = m`
-Zplus_unit_right: (n,m:Z)`n = m+0`->`n = m`
-
-(* Lemmas ending by Zgt *)
-Zsimpl_gt_plus_l: (n,m,p:Z)`p+n > p+m`->`n > m`
-Zsimpl_gt_plus_r: (n,m,p:Z)`n+p > m+p`->`n > m`
-Zgt_S_n: (n,p:Z)`(Zs p) > (Zs n)`->`p > n`
-
-(* Lemmas ending by Zlt *)
-Zsimpl_lt_plus_l: (n,m,p:Z)`p+n < p+m`->`n < m`
-Zsimpl_lt_plus_r: (n,m,p:Z)`n+p < m+p`->`n < m`
-Zlt_S_n: (n,m:Z)`(Zs n) < (Zs m)`->`n < m`
-
-(* Lemmas ending by Zle *)
-Zsimpl_le_plus_l: (p,n,m:Z)`p+n <= p+m`->`n <= m`
-Zsimpl_le_plus_r: (p,n,m:Z)`n+p <= m+p`->`n <= m`
-Zle_S_n: (n,m:Z)`(Zs m) <= (Zs n)`->`m <= n`
-
-(* B) Bottom-up irreversible (syntactic) simplification *)
-
-(* Lemmas ending by Zle *)
-Zle_trans_S: (n,m:Z)`(Zs n) <= m`->`n <= m`
-
-(* C) Other unclearly simplifying lemmas *)
-
-(* Lemmas ending by Zeq *)
-Zmult_eq: (x,y:Z)`x <> 0`->`y*x = 0`->`y = 0`
-
-(* Lemmas ending by Zgt *)
-Zmult_gt: (x,y:Z)`x > 0`->`x*y > 0`->`y > 0`
-
-(* Lemmas ending by Zlt *)
-pZmult_lt: (x,y:Z)`x > 0`->`0 < y*x`->`0 < y`
-
-(* Lemmas ending by Zle *)
-Zmult_le: (x,y:Z)`x > 0`->`0 <= y*x`->`0 <= y`
-OMEGA1: (x,y:Z)`x = y`->`0 <= x`->`0 <= y`
-*)
-
-(**********************************************************************)
-(*           Irreversible lemmas with meta-variables                  *)
-(* To be used by EAuto                                                
-
-Hints Immediate
-(* Lemmas ending by eq *)
-Zle_antisym: (n,m:Z)`n <= m`->`m <= n`->`n = m`
-
-(* Lemmas ending by Zge *)
-Zge_trans: (n,m,p:Z)`n >= m`->`m >= p`->`n >= p`
-
-(* Lemmas ending by Zgt *)
-Zgt_trans: (n,m,p:Z)`n > m`->`m > p`->`n > p`
-Zgt_trans_S: (n,m,p:Z)`(Zs n) > m`->`m > p`->`n > p`
-Zle_gt_trans: (n,m,p:Z)`m <= n`->`m > p`->`n > p`
-Zgt_le_trans: (n,m,p:Z)`n > m`->`p <= m`->`n > p`
-
-(* Lemmas ending by Zlt *)
-Zlt_trans: (n,m,p:Z)`n < m`->`m < p`->`n < p`
-Zlt_le_trans: (n,m,p:Z)`n < m`->`m <= p`->`n < p`
-Zle_lt_trans: (n,m,p:Z)`n <= m`->`m < p`->`n < p`
-
-(* Lemmas ending by Zle *)
-Zle_trans: (n,m,p:Z)`n <= m`->`m <= p`->`n <= p`
-*)
-
-(**********************************************************************)
-(*               Unclear or too specific lemmas                       *)
-(* Not to be used ??                                                  *)
-
-(* A) Irreversible and too specific (not enough regular) 
-
-(* Lemmas ending by Zle *)
-Zle_mult: (x,y:Z)`x > 0`->`0 <= y`->`0 <= y*x`
-Zle_mult_approx: (x,y,z:Z)`x > 0`->`z > 0`->`0 <= y`->`0 <= y*x+z`
-OMEGA6: (x,y,z:Z)`0 <= x`->`y = 0`->`0 <= x+y*z`
-OMEGA7: (x,y,z,t:Z)`z > 0`->`t > 0`->`0 <= x`->`0 <= y`->`0 <= x*z+y*t`
-
-
-(* B) Expansion and too specific ? *)
-
-(* Lemmas ending by Zge *)
-Zge_mult_simpl: (a,b,c:Z)`c > 0`->`a*c >= b*c`->`a >= b`
-
-(* Lemmas ending by Zgt *)
-Zgt_mult_simpl: (a,b,c:Z)`c > 0`->`a*c > b*c`->`a > b`
-Zgt_square_simpl: (x,y:Z)`x >= 0`->`y >= 0`->`x*x > y*y`->`x > y`
-
-(* Lemmas ending by Zle *)
-Zle_mult_simpl: (a,b,c:Z)`c > 0`->`a*c <= b*c`->`a <= b`
-Zmult_le_approx: (x,y,z:Z)`x > 0`->`x > z`->`0 <= y*x+z`->`0 <= y`
-
-(* C) Reversible but too specific ? *)
-
-(* Lemmas ending by Zlt *)
-Zlt_minus: (n,m:Z)`0 < m`->`n-m < n`
-*)
-
-(**********************************************************************)
-(*               Lemmas to be used as rewrite rules                   *)
-(* but can also be used as hints                                      
-
-(* Left-to-right simplification lemmas (a symbol disappears) *)
-
-Zcompare_n_S: (n,m:Z)(Zcompare (Zs n) (Zs m))=(Zcompare n m)
-Zmin_n_n: (n:Z)`(Zmin n n) = n`
-Zmult_1_n: (n:Z)`1*n = n`
-Zmult_n_1: (n:Z)`n*1 = n`
-Zminus_plus: (n,m:Z)`n+m-n = m`
-Zle_plus_minus: (n,m:Z)`n+(m-n) = m`
-Zopp_Zopp: (x:Z)`(-(-x)) = x`
-Zero_left: (x:Z)`0+x = x`
-Zero_right: (x:Z)`x+0 = x`
-Zplus_inverse_r: (x:Z)`x+(-x) = 0`
-Zplus_inverse_l: (x:Z)`(-x)+x = 0`
-Zopp_intro: (x,y:Z)`(-x) = (-y)`->`x = y`
-Zmult_one: (x:Z)`1*x = x`
-Zero_mult_left: (x:Z)`0*x = 0`
-Zero_mult_right: (x:Z)`x*0 = 0`
-Zmult_Zopp_Zopp: (x,y:Z)`(-x)*(-y) = x*y`
-
-(* Right-to-left simplification lemmas (a symbol disappears) *)
-
-Zpred_Sn: (m:Z)`m = (Zpred (Zs m))`
-Zs_pred: (n:Z)`n = (Zs (Zpred n))`
-Zplus_n_O: (n:Z)`n = n+0`
-Zmult_n_O: (n:Z)`0 = n*0`
-Zminus_n_O: (n:Z)`n = n-0`
-Zminus_n_n: (n:Z)`0 = n-n`
-Zred_factor6: (x:Z)`x = x+0`
-Zred_factor0: (x:Z)`x = x*1`
-
-(* Unclear orientation (no symbol disappears) *)
-
-Zplus_n_Sm: (n,m:Z)`(Zs (n+m)) = n+(Zs m)`
-Zmult_n_Sm: (n,m:Z)`n*m+n = n*(Zs m)`
-Zmin_SS: (n,m:Z)`(Zs (Zmin n m)) = (Zmin (Zs n) (Zs m))`
-Zplus_assoc_l: (n,m,p:Z)`n+(m+p) = n+m+p`
-Zplus_assoc_r: (n,m,p:Z)`n+m+p = n+(m+p)`
-Zplus_permute: (n,m,p:Z)`n+(m+p) = m+(n+p)`
-Zplus_Snm_nSm: (n,m:Z)`(Zs n)+m = n+(Zs m)`
-Zminus_plus_simpl: (n,m,p:Z)`n-m = p+n-(p+m)`
-Zminus_Sn_m: (n,m:Z)`(Zs (n-m)) = (Zs n)-m`
-Zmult_plus_distr_l: (n,m,p:Z)`(n+m)*p = n*p+m*p`
-Zmult_minus_distr: (n,m,p:Z)`(n-m)*p = n*p-m*p`
-Zmult_assoc_r: (n,m,p:Z)`n*m*p = n*(m*p)`
-Zmult_assoc_l: (n,m,p:Z)`n*(m*p) = n*m*p`
-Zmult_permute: (n,m,p:Z)`n*(m*p) = m*(n*p)`
-Zmult_Sm_n: (n,m:Z)`n*m+m = (Zs n)*m`
-Zmult_Zplus_distr: (x,y,z:Z)`x*(y+z) = x*y+x*z`
-Zmult_plus_distr: (n,m,p:Z)`(n+m)*p = n*p+m*p`
-Zopp_Zplus: (x,y:Z)`(-(x+y)) = (-x)+(-y)`
-Zplus_sym: (x,y:Z)`x+y = y+x`
-Zplus_assoc: (x,y,z:Z)`x+(y+z) = x+y+z`
-Zmult_sym: (x,y:Z)`x*y = y*x`
-Zmult_assoc: (x,y,z:Z)`x*(y*z) = x*y*z`
-Zopp_Zmult: (x,y:Z)`(-x)*y = (-(x*y))`
-Zplus_S_n: (x,y:Z)`(Zs x)+y = (Zs (x+y))`
-Zopp_one: (x:Z)`(-x) = x*(-1)`
-Zopp_Zmult_r: (x,y:Z)`(-(x*y)) = x*(-y)`
-Zmult_Zopp_left: (x,y:Z)`(-x)*y = x*(-y)`
-Zopp_Zmult_l: (x,y:Z)`(-(x*y)) = (-x)*y`
-Zred_factor1: (x:Z)`x+x = x*2`
-Zred_factor2: (x,y:Z)`x+x*y = x*(1+y)`
-Zred_factor3: (x,y:Z)`x*y+x = x*(1+y)`
-Zred_factor4: (x,y,z:Z)`x*y+x*z = x*(y+z)`
-Zminus_Zplus_compatible: (x,y,n:Z)`x+n-(y+n) = x-y`
-Zmin_plus: (x,y,n:Z)`(Zmin (x+n) (y+n)) = (Zmin x y)+n`
-
-(* nat <-> Z *)
-inj_S: (y:nat)`(inject_nat (S y)) = (Zs (inject_nat y))`
-inj_plus: (x,y:nat)`(inject_nat (plus x y)) = (inject_nat x)+(inject_nat y)`
-inj_mult: (x,y:nat)`(inject_nat (mult x y)) = (inject_nat x)*(inject_nat y)`
-inj_minus1:
- (x,y:nat)(le y x)->`(inject_nat (minus x y)) = (inject_nat x)-(inject_nat y)`
-inj_minus2: (x,y:nat)(gt y x)->`(inject_nat (minus x y)) = 0`
-
-(* Too specific ? *)
-Zred_factor5: (x,y:Z)`x*0+y = y`
-*)
-
-(*i*)
diff --git a/theories7/ZArith/Zlogarithm.v b/theories7/ZArith/Zlogarithm.v
deleted file mode 100644
index dc850738..00000000
--- a/theories7/ZArith/Zlogarithm.v
+++ /dev/null
@@ -1,272 +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: Zlogarithm.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-(**********************************************************************)
-(** The integer logarithms with base 2. 
-
-    There are three logarithms,
-    depending on the rounding of the real 2-based logarithm:
-    - [Log_inf]: [y = (Log_inf x) iff 2^y <= x < 2^(y+1)]
-      i.e. [Log_inf x] is the biggest integer that is smaller than [Log x]
-    - [Log_sup]: [y = (Log_sup x) iff 2^(y-1) < x <= 2^y]
-      i.e. [Log_inf x] is the smallest integer that is bigger than [Log x]
-    - [Log_nearest]: [y= (Log_nearest x) iff 2^(y-1/2) < x <= 2^(y+1/2)]
-      i.e. [Log_nearest x] is the integer nearest from [Log x] *)
-
-Require ZArith_base.
-Require Omega.
-Require Zcomplements.
-Require Zpower.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-Section Log_pos. (* Log of positive integers *)
-
-(** First we build [log_inf] and [log_sup] *)
-
-Fixpoint log_inf [p:positive] : Z :=  
-  Cases p of
-    xH => `0`	 				(* 1 *)
-  | (xO q) => (Zs (log_inf q))		(* 2n *)
-  | (xI q) => (Zs (log_inf q))		(* 2n+1 *)
-  end.
-Fixpoint log_sup [p:positive] : Z :=
-  Cases p of
-    xH => `0`					(* 1 *)
-  | (xO n) => (Zs (log_sup n)) 		(* 2n *)
-  | (xI n) => (Zs (Zs (log_inf n)))		(* 2n+1 *)
-  end.
-
-Hints Unfold log_inf log_sup.
-
-(** Then we give the specifications of [log_inf] and [log_sup] 
-    and prove their validity *)
-
-(*i Hints Resolve ZERO_le_S : zarith. i*)
-Hints Resolve Zle_trans : zarith.
-
-Theorem log_inf_correct : (x:positive) ` 0 <= (log_inf x)` /\
-  ` (two_p (log_inf x)) <= (POS x) < (two_p (Zs (log_inf x)))`.
-Induction x; Intros; Simpl;
-[ Elim H; Intros Hp HR; Clear H; Split;
-  [ Auto with zarith
-  | Conditional (Apply Zle_le_S; Trivial) Rewrite two_p_S with x:=(Zs (log_inf p));
-    Conditional Trivial Rewrite two_p_S;
-    Conditional Trivial Rewrite two_p_S in HR;
-    Rewrite (POS_xI p); Omega ]
-| Elim H; Intros Hp HR; Clear H; Split;
-  [ Auto with zarith
-  | Conditional (Apply Zle_le_S; Trivial) Rewrite two_p_S with x:=(Zs (log_inf p));
-    Conditional Trivial Rewrite two_p_S;
-    Conditional Trivial Rewrite two_p_S in HR;
-    Rewrite (POS_xO p); Omega ]
-| Unfold two_power_pos; Unfold shift_pos; Simpl; Omega 
-].
-Qed.
-
-Definition log_inf_correct1 :=
-	[p:positive](proj1 ? ? (log_inf_correct p)).
-Definition log_inf_correct2 := 
-	[p:positive](proj2 ? ? (log_inf_correct p)).
-
-Opaque log_inf_correct1 log_inf_correct2.
-
-Hints Resolve log_inf_correct1 log_inf_correct2 : zarith.
-
-Lemma log_sup_correct1 : (p:positive)` 0 <= (log_sup p)`.
-Induction p; Intros; Simpl; Auto with zarith.
-Qed.
-
-(** For every [p], either [p] is a power of two and [(log_inf p)=(log_sup p)]
-    either [(log_sup p)=(log_inf p)+1] *)
-
-Theorem log_sup_log_inf : (p:positive)
-  IF (POS p)=(two_p (log_inf p)) 
-  then (POS p)=(two_p (log_sup p))
-  else ` (log_sup p)=(Zs (log_inf p))`.
-
-Induction p; Intros;
-[ Elim H; Right; Simpl;
-  Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
-  Rewrite POS_xI; Unfold Zs; Omega
-| Elim H; Clear H; Intro Hif;
-  [ Left; Simpl;
-    Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
-    Rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0));
-    Rewrite <- (proj1 ? ? Hif); Rewrite <- (proj2 ? ? Hif);
-    Auto
-  | Right; Simpl;
-    Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
-    Rewrite POS_xO; Unfold Zs; Omega ]
-| Left; Auto ].
-Qed.
-
-Theorem log_sup_correct2 : (x:positive)
-  ` (two_p (Zpred (log_sup x))) < (POS x) <= (two_p (log_sup x))`.
-
-Intro.
-Elim (log_sup_log_inf x).
-(* x is a power of two and [log_sup = log_inf] *)
-Intros (E1,E2); Rewrite E2.
-Split ; [ Apply two_p_pred; Apply log_sup_correct1 | Apply Zle_n ].
-Intros (E1,E2); Rewrite E2.
-Rewrite <- (Zpred_Sn (log_inf x)).
-Generalize (log_inf_correct2 x); Omega.
-Qed.
-
-Lemma log_inf_le_log_sup : 
-	(p:positive) `(log_inf p) <= (log_sup p)`.
-Induction p; Simpl; Intros; Omega.
-Qed.
-
-Lemma log_sup_le_Slog_inf : 
-	(p:positive) `(log_sup p) <= (Zs (log_inf p))`.
-Induction p; Simpl; Intros; Omega.
-Qed.
-
-(** Now it's possible to specify and build the [Log] rounded to the nearest *)
-
-Fixpoint log_near[x:positive] : Z :=
-  Cases x of 
-    xH => `0`
-  | (xO xH) => `1`
-  | (xI xH) => `2`
-  | (xO y)  => (Zs (log_near y))
-  | (xI y)  => (Zs (log_near y))
-  end.    
-
-Theorem log_near_correct1 : (p:positive)` 0 <= (log_near p)`.
-Induction p; Simpl; Intros; 
-[Elim p0; Auto with zarith | Elim p0; Auto with zarith | Trivial with zarith ].
-Intros; Apply Zle_le_S.
-Generalize H0; Elim p1; Intros; Simpl;
-    [ Assumption | Assumption | Apply ZERO_le_POS ].
-Intros; Apply Zle_le_S.
-Generalize H0; Elim p1; Intros; Simpl;
-    [ Assumption | Assumption | Apply ZERO_le_POS ].
-Qed.
-
-Theorem log_near_correct2: (p:positive)
-  (log_near p)=(log_inf p)
-\/(log_near p)=(log_sup p).
-Induction p.
-Intros p0 [Einf|Esup].
-Simpl. Rewrite Einf.
-Case p0; [Left | Left | Right]; Reflexivity.
-Simpl; Rewrite Esup.
-Elim (log_sup_log_inf p0).
-Generalize (log_inf_le_log_sup p0).
-Generalize (log_sup_le_Slog_inf p0).
-Case p0; Auto with zarith.
-Intros; Omega.
-Case p0; Intros; Auto with zarith.
-Intros p0 [Einf|Esup].
-Simpl.
-Repeat Rewrite Einf.
-Case p0; Intros; Auto with zarith.
-Simpl.
-Repeat Rewrite Esup.
-Case p0; Intros; Auto with zarith.
-Auto.
-Qed.
-
-(*i******************
-Theorem log_near_correct: (p:positive)
-  `| (two_p (log_near p)) - (POS p) | <= (POS p)-(two_p (log_inf p))`
-  /\`| (two_p (log_near p)) - (POS p) | <= (two_p (log_sup p))-(POS p)`.
-Intro.
-Induction p.
-Intros p0 [(Einf1,Einf2)|(Esup1,Esup2)].
-Unfold log_near log_inf log_sup. Fold log_near log_inf log_sup.
-Rewrite Einf1.
-Repeat Rewrite two_p_S.
-Case p0; [Left | Left | Right].
-
-Split.
-Simpl.
-Rewrite E1; Case p0; Try Reflexivity.
-Compute.
-Unfold log_near; Fold log_near.
-Unfold log_inf; Fold log_inf.
-Repeat Rewrite E1.
-Split.
-**********************************i*)
-
-End Log_pos.
-
-Section divers.
-
-(** Number of significative digits. *)
-
-Definition N_digits :=
-  [x:Z]Cases x of 
-       	  (POS p) => (log_inf p)
-        | (NEG p) => (log_inf p)
-	|  ZERO   => `0`
-       end.
-
-Lemma ZERO_le_N_digits : (x:Z) ` 0 <= (N_digits x)`.
-Induction x; Simpl;
-[ Apply Zle_n
-| Exact log_inf_correct1
-| Exact log_inf_correct1].
-Qed.
-
-Lemma log_inf_shift_nat : 
-  (n:nat)(log_inf (shift_nat n xH))=(inject_nat n).
-Induction n; Intros;
-[ Try Trivial
-| Rewrite -> inj_S; Rewrite <- H; Reflexivity].
-Qed.
-
-Lemma log_sup_shift_nat : 
-  (n:nat)(log_sup (shift_nat n xH))=(inject_nat n).
-Induction n; Intros;
-[ Try Trivial
-| Rewrite -> inj_S; Rewrite <- H; Reflexivity].
-Qed.
-
-(** [Is_power p] means that p is a power of two *)
-Fixpoint Is_power[p:positive] : Prop :=
-  Cases p of
-    xH => True
-  | (xO q) => (Is_power q)
-  | (xI q) => False
-  end.
-
-Lemma Is_power_correct :
-  (p:positive) (Is_power p) <-> (Ex [y:nat](p=(shift_nat y xH))).
-
-Split; 
-[ Elim p; 
-   [ Simpl; Tauto
-   | Simpl; Intros; Generalize (H H0); Intro H1; Elim H1; Intros y0 Hy0;
-     Exists (S y0); Rewrite Hy0; Reflexivity
-   | Intro; Exists O; Reflexivity]
-| Intros; Elim H; Intros; Rewrite -> H0; Elim x; Intros; Simpl; Trivial].
-Qed.
-
-Lemma Is_power_or : (p:positive) (Is_power p)\/~(Is_power p).
-Induction p;
-[ Intros; Right; Simpl; Tauto
-| Intros; Elim H; 
-   [ Intros; Left; Simpl; Exact H0
-   | Intros; Right; Simpl; Exact H0]
-| Left; Simpl; Trivial].
-Qed.
-
-End divers.
-
-
-
-
-
-
-
diff --git a/theories7/ZArith/Zmin.v b/theories7/ZArith/Zmin.v
deleted file mode 100644
index 753fe461..00000000
--- a/theories7/ZArith/Zmin.v
+++ /dev/null
@@ -1,102 +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: Zmin.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
-
-Require Arith.
-Require BinInt.
-Require Zcompare.
-Require Zorder.
-
-Open Local Scope Z_scope.
-
-(**********************************************************************)
-(** Minimum on binary integer numbers *)
-
-Definition Zmin := [n,m:Z]
- <Z>Cases (Zcompare n m) of
-      EGAL      => n
-    | INFERIEUR => n
-    | SUPERIEUR => m
-    end.
-
-(** Properties of minimum on binary integer numbers *)
-
-Lemma Zmin_SS : (n,m:Z)((Zs (Zmin n m))=(Zmin (Zs n) (Zs m))).
-Proof.
-Intros n m;Unfold Zmin; Rewrite (Zcompare_n_S n m);
-(ElimCompare 'n 'm);Intros E;Rewrite E;Auto with arith.
-Qed.
-
-Lemma Zle_min_l : (n,m:Z)(Zle (Zmin n m) n).
-Proof.
-Intros n m;Unfold Zmin ; (ElimCompare 'n 'm);Intros E;Rewrite -> E;
-  [ Apply Zle_n | Apply Zle_n | Apply Zlt_le_weak; Apply Zgt_lt;Exact E ].
-Qed.
-
-Lemma Zle_min_r : (n,m:Z)(Zle (Zmin n m) m).
-Proof.
-Intros n m;Unfold Zmin ; (ElimCompare 'n 'm);Intros E;Rewrite -> E;[
-  Unfold Zle ;Rewrite -> E;Discriminate
-| Unfold Zle ;Rewrite -> E;Discriminate
-| Apply Zle_n ].
-Qed.
-
-Lemma Zmin_case : (n,m:Z)(P:Z->Set)(P n)->(P m)->(P (Zmin n m)).
-Proof.
-Intros n m P H1 H2; Unfold Zmin; Case (Zcompare n m);Auto with arith.
-Qed.
-
-Lemma Zmin_or : (n,m:Z)(Zmin n m)=n \/ (Zmin n m)=m.
-Proof.
-Unfold Zmin; Intros; Elim (Zcompare n m); Auto.
-Qed.
-
-Lemma Zmin_n_n : (n:Z) (Zmin n n)=n.
-Proof.
-Unfold Zmin; Intros; Elim (Zcompare n n); Auto.
-Qed.
-
-Lemma Zmin_plus :
- (x,y,n:Z)(Zmin (Zplus x n) (Zplus y n))=(Zplus (Zmin x y) n).
-Proof.
-Intros x y n; Unfold Zmin.
-Rewrite (Zplus_sym x n);
-Rewrite (Zplus_sym y n);
-Rewrite (Zcompare_Zplus_compatible x y n).
-Case (Zcompare x y); Apply Zplus_sym.
-Qed.
-
-(**********************************************************************)
-(** Maximum of two binary integer numbers *)
-V7only [ (* From Zdivides *) ].
-
-Definition Zmax :=
-   [a, b : ?]  Cases (Zcompare a b) of INFERIEUR => b | _ => a end.
-
-(** Properties of maximum on binary integer numbers *)
-
-Tactic Definition CaseEq name :=
-Generalize (refl_equal ? name); Pattern -1 name; Case name.
-
-Theorem Zmax1: (a, b : ?)  (Zle a (Zmax a b)).
-Proof.
-Intros a b; Unfold Zmax; (CaseEq '(Zcompare a b)); Simpl; Auto with zarith.
-Unfold Zle; Intros H; Rewrite H; Red; Intros; Discriminate.
-Qed.
-
-Theorem Zmax2: (a, b : ?)  (Zle b (Zmax a b)).
-Proof.
-Intros a b; Unfold Zmax; (CaseEq '(Zcompare a b)); Simpl; Auto with zarith.
-Intros H;
- (Case (Zle_or_lt b a); Auto; Unfold Zlt; Rewrite H; Intros; Discriminate).
-Intros H;
- (Case (Zle_or_lt b a); Auto; Unfold Zlt; Rewrite H; Intros; Discriminate).
-Qed.
-
diff --git a/theories7/ZArith/Zmisc.v b/theories7/ZArith/Zmisc.v
deleted file mode 100644
index bd89ec66..00000000
--- a/theories7/ZArith/Zmisc.v
+++ /dev/null
@@ -1,188 +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: Zmisc.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-Require BinInt.
-Require Zcompare.
-Require Zorder.
-Require Zsyntax.
-Require Bool.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-(**********************************************************************)
-(** Iterators *)
-
-(** [n]th iteration of the function [f] *)
-Fixpoint iter_nat[n:nat]  : (A:Set)(f:A->A)A->A :=
-  [A:Set][f:A->A][x:A]
-    Cases n of
-      O => x
-    | (S n') => (f (iter_nat n' A f x))
-    end.
-
-Fixpoint iter_pos[n:positive] : (A:Set)(f:A->A)A->A :=
-  [A:Set][f:A->A][x:A]
-    Cases n of
-     	xH => (f x)
-      | (xO n') => (iter_pos n' A f (iter_pos n' A f x))
-      | (xI n') => (f (iter_pos n' A f (iter_pos n' A f x)))
-    end.
-
-Definition iter :=
-  [n:Z][A:Set][f:A->A][x:A]Cases n of
-    ZERO => x
-  | (POS p) => (iter_pos p A f x)
-  | (NEG p) => x
-  end.
-
-Theorem iter_nat_plus :
-  (n,m:nat)(A:Set)(f:A->A)(x:A)
-    (iter_nat (plus n m) A f x)=(iter_nat n A f (iter_nat m A f x)).
-Proof.    
-Induction n;
-[ Simpl; Auto with arith
-| Intros; Simpl; Apply f_equal with f:=f; Apply H
-].  
-Qed.
-
-Theorem iter_convert : (n:positive)(A:Set)(f:A->A)(x:A)
-  (iter_pos n A f x) = (iter_nat (convert n) A f x).
-Proof.    
-Intro n; NewInduction n as [p H|p H|];
-[ Intros; Simpl; Rewrite -> (H A f x);
-  Rewrite -> (H A f (iter_nat (convert p) A f x));
-  Rewrite -> (ZL6 p); Symmetry; Apply f_equal with f:=f;
-  Apply iter_nat_plus
-| Intros; Unfold convert; Simpl; Rewrite -> (H A f x);
-  Rewrite -> (H A f (iter_nat (convert p) A f x));
-  Rewrite -> (ZL6 p); Symmetry;
-  Apply iter_nat_plus
-| Simpl; Auto with arith
-].
-Qed.
-
-Theorem iter_pos_add :
-  (n,m:positive)(A:Set)(f:A->A)(x:A)
-    (iter_pos (add n m) A f x)=(iter_pos n A f (iter_pos m A f x)).
-Proof.    
-Intros n m; Intros.
-Rewrite -> (iter_convert m A f x).
-Rewrite -> (iter_convert n A f (iter_nat (convert m) A f x)).
-Rewrite -> (iter_convert (add n m) A f x).
-Rewrite -> (convert_add n m).
-Apply iter_nat_plus.
-Qed.
-
-(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv], 
-    then the iterates of [f] also preserve it. *)
-
-Theorem iter_nat_invariant :
-  (n:nat)(A:Set)(f:A->A)(Inv:A->Prop)
-  ((x:A)(Inv x)->(Inv (f x)))->(x:A)(Inv x)->(Inv (iter_nat n A f x)).
-Proof.    
-Induction n; Intros;
-[ Trivial with arith
-| Simpl; Apply H0 with x:=(iter_nat n0 A f x); Apply H; Trivial with arith].
-Qed.
-
-Theorem iter_pos_invariant :
-  (n:positive)(A:Set)(f:A->A)(Inv:A->Prop)
-  ((x:A)(Inv x)->(Inv (f x)))->(x:A)(Inv x)->(Inv (iter_pos n A f x)).
-Proof.    
-Intros; Rewrite iter_convert; Apply iter_nat_invariant; Trivial with arith.
-Qed.
-
-V7only [
-(* Compatibility *)
-Require Zbool.
-Require Zeven.
-Require Zabs.
-Require Zmin.
-Notation rename := rename.
-Notation POS_xI := POS_xI.
-Notation POS_xO := POS_xO.
-Notation NEG_xI := NEG_xI.
-Notation NEG_xO := NEG_xO.
-Notation POS_add := POS_add.
-Notation NEG_add := NEG_add.
-Notation Zle_cases := Zle_cases.
-Notation Zlt_cases := Zlt_cases.
-Notation Zge_cases := Zge_cases.
-Notation Zgt_cases := Zgt_cases.
-Notation POS_gt_ZERO := POS_gt_ZERO.
-Notation ZERO_le_POS := ZERO_le_POS.
-Notation Zlt_ZERO_pred_le_ZERO := Zlt_ZERO_pred_le_ZERO.
-Notation NEG_lt_ZERO := NEG_lt_ZERO.
-Notation Zeven_not_Zodd := Zeven_not_Zodd.
-Notation Zodd_not_Zeven := Zodd_not_Zeven.
-Notation Zeven_Sn := Zeven_Sn.
-Notation Zodd_Sn := Zodd_Sn.
-Notation Zeven_pred := Zeven_pred.
-Notation Zodd_pred := Zodd_pred.
-Notation Zeven_div2 := Zeven_div2.
-Notation Zodd_div2 := Zodd_div2.
-Notation Zodd_div2_neg := Zodd_div2_neg.
-Notation Z_modulo_2 := Z_modulo_2.
-Notation Zsplit2 := Zsplit2.
-Notation Zminus_Zplus_compatible := Zminus_Zplus_compatible.
-Notation Zcompare_egal_dec := Zcompare_egal_dec.
-Notation Zcompare_elim := Zcompare_elim.
-Notation Zcompare_x_x := Zcompare_x_x.
-Notation Zlt_not_eq := Zlt_not_eq.
-Notation Zcompare_eq_case := Zcompare_eq_case.
-Notation Zle_Zcompare := Zle_Zcompare.
-Notation Zlt_Zcompare := Zlt_Zcompare.
-Notation Zge_Zcompare := Zge_Zcompare.
-Notation Zgt_Zcompare := Zgt_Zcompare.
-Notation Zmin_plus := Zmin_plus.
-Notation absolu_lt := absolu_lt.
-Notation Zle_bool_imp_le := Zle_bool_imp_le.
-Notation Zle_imp_le_bool := Zle_imp_le_bool.
-Notation Zle_bool_refl := Zle_bool_refl.
-Notation Zle_bool_antisym := Zle_bool_antisym.
-Notation Zle_bool_trans := Zle_bool_trans.
-Notation Zle_bool_plus_mono := Zle_bool_plus_mono.
-Notation Zone_pos := Zone_pos.
-Notation Zone_min_pos := Zone_min_pos.
-Notation Zle_is_le_bool := Zle_is_le_bool.
-Notation Zge_is_le_bool := Zge_is_le_bool.
-Notation Zlt_is_le_bool := Zlt_is_le_bool.
-Notation Zgt_is_le_bool := Zgt_is_le_bool.
-Notation Zle_plus_swap := Zle_plus_swap.
-Notation Zge_iff_le := Zge_iff_le.
-Notation Zlt_plus_swap := Zlt_plus_swap.
-Notation Zgt_iff_lt := Zgt_iff_lt.
-Notation Zeq_plus_swap := Zeq_plus_swap.
-(* Definitions *)
-Notation entier_of_Z := entier_of_Z.
-Notation Z_of_entier := Z_of_entier.
-Notation Zle_bool := Zle_bool.
-Notation Zge_bool := Zge_bool.
-Notation Zlt_bool := Zlt_bool.
-Notation Zgt_bool := Zgt_bool.
-Notation Zeq_bool := Zeq_bool.
-Notation Zneq_bool := Zneq_bool.
-Notation Zeven := Zeven.
-Notation Zodd := Zodd.
-Notation Zeven_bool := Zeven_bool.
-Notation Zodd_bool := Zodd_bool.
-Notation Zeven_odd_dec := Zeven_odd_dec.
-Notation Zeven_dec := Zeven_dec.
-Notation Zodd_dec := Zodd_dec.
-Notation Zdiv2_pos := Zdiv2_pos.
-Notation Zdiv2 := Zdiv2.
-Notation Zle_bool_total := Zle_bool_total.
-Export Zbool.
-Export Zeven.
-Export Zabs.
-Export Zmin.
-Export Zorder.
-Export Zcompare.
-].
diff --git a/theories7/ZArith/Znat.v b/theories7/ZArith/Znat.v
deleted file mode 100644
index 99d1422f..00000000
--- a/theories7/ZArith/Znat.v
+++ /dev/null
@@ -1,138 +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: Znat.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
-
-Require Export Arith.
-Require BinPos.
-Require BinInt.
-Require Zcompare.
-Require Zorder.
-Require Decidable.
-Require Peano_dec.
-Require Export Compare_dec.
-
-Open Local Scope Z_scope.
-
-Definition neq := [x,y:nat] ~(x=y).
-
-(**********************************************************************)
-(** Properties of the injection from nat into Z *)
-
-Theorem inj_S : (y:nat) (inject_nat (S y)) = (Zs (inject_nat y)).
-Proof.
-Intro y; NewInduction y as [|n H]; [
-  Unfold Zs ; Simpl; Trivial with arith
-| Change (POS (add_un (anti_convert n)))=(Zs (inject_nat (S n)));
-  Rewrite add_un_Zs; Trivial with arith].
-Qed.
- 
-Theorem inj_plus : 
-  (x,y:nat) (inject_nat (plus x y)) = (Zplus (inject_nat x) (inject_nat y)).
-Proof.
-Intro x; NewInduction x as [|n H]; Intro y; NewDestruct y as [|m]; [
-  Simpl; Trivial with arith
-| Simpl; Trivial with arith
-| Simpl; Rewrite <- plus_n_O; Trivial with arith
-| Change (inject_nat (S (plus n (S m))))=
-                        (Zplus (inject_nat (S n)) (inject_nat (S m)));
-  Rewrite inj_S; Rewrite H; Do 2 Rewrite inj_S; Rewrite Zplus_S_n; Trivial with arith].
-Qed.
- 
-Theorem inj_mult : 
-  (x,y:nat) (inject_nat (mult x y)) = (Zmult (inject_nat x) (inject_nat y)).
-Proof.
-Intro x; NewInduction x as [|n H]; [
-  Simpl; Trivial with arith
-| Intro y; Rewrite -> inj_S; Rewrite <- Zmult_Sm_n;
-    Rewrite <- H;Rewrite <- inj_plus; Simpl; Rewrite plus_sym; Trivial with arith].
-Qed.
-
-Theorem inj_neq:
-  (x,y:nat) (neq x y) -> (Zne (inject_nat x) (inject_nat y)).
-Proof.
-Unfold neq Zne not ; Intros x y H1 H2; Apply H1; Generalize H2; 
-Case x; Case y; Intros; [
-  Auto with arith
-| Discriminate H0
-| Discriminate H0
-| Simpl in H0; Injection H0; Do 2 Rewrite <- bij1; Intros E; Rewrite E; Auto with arith].
-Qed. 
-
-Theorem inj_le:
-  (x,y:nat) (le x y) -> (Zle (inject_nat x) (inject_nat y)).
-Proof.
-Intros x y; Intros H; Elim H; [
-  Unfold Zle ; Elim (Zcompare_EGAL (inject_nat x) (inject_nat x));
-  Intros H1 H2; Rewrite H2; [ Discriminate | Trivial with arith]
-| Intros m H1 H2; Apply Zle_trans with (inject_nat m); 
-    [Assumption | Rewrite inj_S; Apply Zle_n_Sn]].
-Qed.
-
-Theorem inj_lt: (x,y:nat) (lt x y) -> (Zlt (inject_nat x) (inject_nat y)).
-Proof.
-Intros x y H; Apply Zgt_lt; Apply Zle_S_gt; Rewrite <- inj_S; Apply inj_le;
-Exact H.
-Qed.
-
-Theorem inj_gt: (x,y:nat) (gt x y) -> (Zgt (inject_nat x) (inject_nat y)).
-Proof.
-Intros x y H; Apply Zlt_gt; Apply inj_lt; Exact H.
-Qed.
-
-Theorem inj_ge: (x,y:nat) (ge x y) -> (Zge (inject_nat x) (inject_nat y)).
-Proof.
-Intros x y H; Apply Zle_ge; Apply inj_le; Apply H.
-Qed.
-
-Theorem inj_eq: (x,y:nat) x=y -> (inject_nat x) = (inject_nat y).
-Proof.
-Intros x y H; Rewrite H; Trivial with arith.
-Qed.
-
-Theorem intro_Z : 
-  (x:nat) (EX y:Z | (inject_nat x)=y /\ 
-      	  (Zle ZERO (Zplus (Zmult y (POS xH)) ZERO))).
-Proof.
-Intros x; Exists (inject_nat x); Split; [
-  Trivial with arith
-| Rewrite Zmult_sym; Rewrite Zmult_one; Rewrite Zero_right; 
-  Unfold Zle ; Elim x; Intros;Simpl; Discriminate ].
-Qed.
-
-Theorem inj_minus1 :
-  (x,y:nat) (le y x) -> 
-    (inject_nat (minus x y)) = (Zminus (inject_nat x) (inject_nat y)).
-Proof.
-Intros x y H; Apply (Zsimpl_plus_l (inject_nat y)); Unfold Zminus ;
-Rewrite Zplus_permute; Rewrite Zplus_inverse_r; Rewrite <- inj_plus;
-Rewrite <- (le_plus_minus y x H);Rewrite Zero_right; Trivial with arith.
-Qed.
- 
-Theorem inj_minus2: (x,y:nat) (gt y x) -> (inject_nat (minus x y)) = ZERO.
-Proof.
-Intros x y H; Rewrite inj_minus_aux; [ Trivial with arith | Apply gt_not_le; Assumption].
-Qed.
-
-V7only [ (* From Zdivides *) ].
-Theorem POS_inject: (x : positive) (POS x) = (inject_nat (convert x)).
-Proof.
-Intros x; Elim x; Simpl; Auto.
-Intros p H; Rewrite ZL6.
-Apply f_equal with f := POS.
-Apply convert_intro.
-Rewrite bij1; Unfold convert; Simpl.
-Rewrite ZL6; Auto.
-Intros p H; Unfold convert; Simpl.
-Rewrite ZL6; Simpl.
-Rewrite inj_plus; Repeat Rewrite <- H.
-Rewrite POS_xO; Simpl; Rewrite add_x_x; Reflexivity.
-Qed.
-
diff --git a/theories7/ZArith/Znumtheory.v b/theories7/ZArith/Znumtheory.v
deleted file mode 100644
index b8e5f300..00000000
--- a/theories7/ZArith/Znumtheory.v
+++ /dev/null
@@ -1,629 +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: Znumtheory.v,v 1.3.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
-
-Require ZArith_base.
-Require ZArithRing.
-Require Zcomplements.
-Require Zdiv.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-(** This file contains some notions of number theory upon Z numbers: 
-     - a divisibility predicate [Zdivide]
-     - a gcd predicate [gcd]
-     - Euclid algorithm [euclid]
-     - an efficient [Zgcd] function 
-     - a relatively prime predicate [rel_prime]
-     - a prime predicate [prime]
-*)
-
-(** * Divisibility *)
-
-Inductive Zdivide [a,b:Z] : Prop := 
-  Zdivide_intro : (q:Z) `b = q * a` -> (Zdivide a b).
-
-(** Syntax for divisibility *)
-
-Notation "( a | b )" := (Zdivide a b) 
- (at level 0, a,b at level 10) : Z_scope
- V8only "( a | b )" (at level 0).
-
-(** Results concerning divisibility*)
-
-Lemma Zdivide_refl : (a:Z) (a|a).
-Proof.
-Intros; Apply Zdivide_intro with `1`; Ring.
-Save.
-
-Lemma Zone_divide : (a:Z) (1|a).
-Proof.
-Intros; Apply Zdivide_intro with `a`; Ring.
-Save.
-
-Lemma Zdivide_0 : (a:Z) (a|0).
-Proof.
-Intros; Apply Zdivide_intro with `0`; Ring.
-Save.
-
-Hints Resolve Zdivide_refl Zone_divide Zdivide_0 : zarith.
-
-Lemma Zdivide_mult_left : (a,b,c:Z) (a|b) -> (`c*a`|`c*b`).
-Proof.
-Induction 1; Intros; Apply Zdivide_intro with q.
-Rewrite H0; Ring.
-Save.
-
-Lemma Zdivide_mult_right : (a,b,c:Z) (a|b) -> (`a*c`|`b*c`).
-Proof.
-Intros a b c; Rewrite (Zmult_sym a c); Rewrite (Zmult_sym b c).
-Apply Zdivide_mult_left; Trivial.
-Save.
-
-Hints Resolve Zdivide_mult_left Zdivide_mult_right : zarith.
-
-Lemma Zdivide_plus : (a,b,c:Z) (a|b) -> (a|c) -> (a|`b+c`).
-Proof.
-Induction 1; Intros q Hq; Induction 1; Intros q' Hq'.
-Apply Zdivide_intro with `q+q'`.
-Rewrite Hq; Rewrite Hq'; Ring.
-Save.
-
-Lemma Zdivide_opp : (a,b:Z) (a|b) -> (a|`-b`).
-Proof.
-Induction 1; Intros; Apply Zdivide_intro with `-q`.
-Rewrite H0; Ring.
-Save.
-
-Lemma Zdivide_opp_rev : (a,b:Z) (a|`-b`) -> (a| b).
-Proof.
-Intros; Replace b with `-(-b)`. Apply Zdivide_opp; Trivial. Ring.
-Save.
-
-Lemma Zdivide_opp_left : (a,b:Z) (a|b) -> (`-a`|b).
-Proof.
-Induction 1; Intros; Apply Zdivide_intro with `-q`.
-Rewrite H0; Ring.
-Save.
-
-Lemma Zdivide_opp_left_rev : (a,b:Z) (`-a`|b) -> (a|b).
-Proof.
-Intros; Replace a with `-(-a)`. Apply Zdivide_opp_left; Trivial. Ring.
-Save.
-
-Lemma Zdivide_minus : (a,b,c:Z) (a|b) -> (a|c) -> (a|`b-c`).
-Proof.
-Induction 1; Intros q Hq; Induction 1; Intros q' Hq'.
-Apply Zdivide_intro with `q-q'`.
-Rewrite Hq; Rewrite Hq'; Ring.
-Save.
-
-Lemma Zdivide_left : (a,b,c:Z) (a|b) -> (a|`b*c`).
-Proof.
-Induction 1; Intros q Hq; Apply Zdivide_intro with `q*c`.
-Rewrite Hq; Ring.
-Save.
-
-Lemma Zdivide_right : (a,b,c:Z) (a|c) -> (a|`b*c`).
-Proof.
-Induction 1; Intros q Hq; Apply Zdivide_intro with `q*b`.
-Rewrite Hq; Ring.
-Save.
-
-Lemma Zdivide_a_ab : (a,b:Z) (a|`a*b`).
-Proof.
-Intros; Apply Zdivide_intro with b; Ring.
-Save.
-
-Lemma Zdivide_a_ba : (a,b:Z) (a|`b*a`).
-Proof.
-Intros; Apply Zdivide_intro with b; Ring.
-Save.
-
-Hints Resolve Zdivide_plus Zdivide_opp Zdivide_opp_rev
-              Zdivide_opp_left Zdivide_opp_left_rev
-              Zdivide_minus Zdivide_left Zdivide_right
-              Zdivide_a_ab Zdivide_a_ba : zarith.
-
-(** Auxiliary result. *)
-
-Lemma Zmult_one : 
- (x,y:Z) `x>=0` -> `x*y=1` -> `x=1`.
-Proof.
-Intros x y H H0; NewDestruct (Zmult_1_inversion_l ? ? H0) as [Hpos|Hneg].
-  Assumption.
-  Rewrite Hneg in H; Simpl in H.
-  Contradiction (Zle_not_lt `0` `-1`).
-    Apply Zge_le; Assumption.
-    Apply NEG_lt_ZERO.
-Save.
-
-(** Only [1] and [-1] divide [1]. *)
-
-Lemma Zdivide_1 : (x:Z) (x|1) -> `x=1` \/ `x=-1`.
-Proof.
-Induction 1; Intros.
-Elim (Z_lt_ge_dec `0` x); [Left|Right].
-Apply Zmult_one with q; Auto with zarith; Rewrite H0; Ring.
-Assert `(-x) = 1`; Auto with zarith.
-Apply Zmult_one with (-q); Auto with zarith; Rewrite H0; Ring.
-Save.
-
-(** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *)
-
-Lemma Zdivide_antisym : (a,b:Z) (a|b) -> (b|a) -> `a=b` \/ `a=-b`.
-Proof.
-Induction 1; Intros.
-Inversion H1.
-Rewrite H0 in H2; Clear H H1.
-Case (Z_zerop a); Intro.
-Left; Rewrite H0; Rewrite e; Ring.
-Assert Hqq0: `q0*q = 1`.
-Apply Zmult_reg_left with a.
-Assumption.
-Ring.
-Pattern 2 a; Rewrite H2; Ring.
-Assert (q|1).
-Rewrite <- Hqq0; Auto with zarith.
-Elim (Zdivide_1 q H); Intros.
-Rewrite H1 in H0; Left; Omega.
-Rewrite H1 in H0; Right; Omega.
-Save.
-
-(** If [a] divides [b] and [b<>0] then [|a| <= |b|]. *)
-
-Lemma Zdivide_bounds : (a,b:Z) (a|b) -> `b<>0` -> `|a| <= |b|`.
-Proof.
-Induction 1; Intros.
-Assert `|b|=|q|*|a|`.
- Subst; Apply Zabs_Zmult.
-Rewrite H2.
-Assert H3 := (Zabs_pos q).
-Assert H4 := (Zabs_pos a).
-Assert `|q|*|a|>=1*|a|`; Auto with zarith.
-Apply Zge_Zmult_pos_compat; Auto with zarith.
-Elim (Z_lt_ge_dec `|q|` `1`); [ Intros | Auto with zarith ].
-Assert `|q|=0`.
- Omega.
-Assert `q=0`.
- Rewrite <- (Zabs_Zsgn q).
-Rewrite H5; Auto with zarith.
-Subst q; Omega.
-Save.
-
-(** * Greatest common divisor (gcd). *)
-   
-(** There is no unicity of the gcd; hence we define the predicate [gcd a b d] 
-     expressing that [d] is a gcd of [a] and [b]. 
-     (We show later that the [gcd] is actually unique if we discard its sign.) *)
-
-Inductive gcd [a,b,d:Z] : Prop :=
-  gcd_intro : 
-    (d|a) -> (d|b) -> ((x:Z) (x|a) -> (x|b) -> (x|d)) -> (gcd a b d).
-
-(** Trivial properties of [gcd] *)
-
-Lemma gcd_sym : (a,b,d:Z)(gcd a b d) -> (gcd b a d).
-Proof.
-Induction 1; Constructor; Intuition.
-Save.
-
-Lemma gcd_0 : (a:Z)(gcd a `0` a).
-Proof.
-Constructor; Auto with zarith.
-Save.
-
-Lemma gcd_minus :(a,b,d:Z)(gcd a `-b` d) -> (gcd b a d).
-Proof.
-Induction 1; Constructor; Intuition.
-Save.
-
-Lemma gcd_opp :(a,b,d:Z)(gcd a b d) -> (gcd b a `-d`).
-Proof.
-Induction 1; Constructor; Intuition.
-Save.
-
-Hints Resolve gcd_sym gcd_0 gcd_minus gcd_opp : zarith.
-
-(** * Extended Euclid algorithm. *)
-
-(** Euclid's algorithm to compute the [gcd] mainly relies on
-    the following property. *)
-
-Lemma gcd_for_euclid :
-  (a,b,d,q:Z) (gcd b `a-q*b` d) -> (gcd a b d).
-Proof.
-Induction 1; Constructor; Intuition.
-Replace a with `a-q*b+q*b`. Auto with zarith. Ring.
-Save.
-
-Lemma gcd_for_euclid2 :
-  (b,d,q,r:Z) (gcd r b d) -> (gcd b `b*q+r` d).
-Proof.
-Induction 1; Constructor; Intuition.
-Apply H2; Auto.
-Replace r with `b*q+r-b*q`. Auto with zarith. Ring.
-Save.
-
-(** We implement the extended version of Euclid's algorithm,
-    i.e. the one computing Bezout's coefficients as it computes
-    the [gcd]. We follow the algorithm given in Knuth's
-    "Art of Computer Programming", vol 2, page 325. *)
-
-Section extended_euclid_algorithm.
-
-Variable a,b : Z.
-
-(** The specification of Euclid's algorithm is the existence of
-    [u], [v] and [d] such that [ua+vb=d] and [(gcd a b d)]. *)
-
-Inductive Euclid : Set :=
-  Euclid_intro : 
-    (u,v,d:Z) `u*a+v*b=d` -> (gcd a b d) -> Euclid.
-
-(** The recursive part of Euclid's algorithm uses well-founded
-    recursion of non-negative integers. It maintains 6 integers
-    [u1,u2,u3,v1,v2,v3] such that the following invariant holds:
-    [u1*a+u2*b=u3] and [v1*a+v2*b=v3] and [gcd(u2,v3)=gcd(a,b)]. 
-    *)
-
-Lemma euclid_rec :
-  (v3:Z) `0 <= v3` -> (u1,u2,u3,v1,v2:Z) `u1*a+u2*b=u3` -> `v1*a+v2*b=v3` -> 
-  ((d:Z)(gcd u3 v3 d) -> (gcd a b d)) -> Euclid.
-Proof.
-Intros v3 Hv3; Generalize Hv3; Pattern v3.
-Apply Z_lt_rec.
-Clear v3 Hv3; Intros.
-Elim (Z_zerop x); Intro.
-Apply Euclid_intro with u:=u1 v:=u2 d:=u3.
-Assumption.
-Apply H2.
-Rewrite a0; Auto with zarith.
-LetTac q := (Zdiv u3 x).
-Assert Hq: `0 <= u3-q*x < x`.
-Replace `u3-q*x` with `u3%x`.
-Apply Z_mod_lt; Omega.
-Assert xpos : `x > 0`. Omega.
-Generalize (Z_div_mod_eq u3 x xpos). 
-Unfold q. 
-Intro eq; Pattern 2 u3; Rewrite eq; Ring.
-Apply (H `u3-q*x` Hq (proj1 ? ? Hq) v1 v2 x `u1-q*v1` `u2-q*v2`).
-Tauto.
-Replace `(u1-q*v1)*a+(u2-q*v2)*b` with `(u1*a+u2*b)-q*(v1*a+v2*b)`.
-Rewrite H0; Rewrite H1; Trivial.
-Ring.
-Intros; Apply H2.
-Apply gcd_for_euclid with q; Assumption.
-Assumption.
-Save.
-
-(** We get Euclid's algorithm by applying [euclid_rec] on
-    [1,0,a,0,1,b] when [b>=0] and [1,0,a,0,-1,-b] when [b<0]. *)
-
-Lemma euclid : Euclid.
-Proof.
-Case (Z_le_gt_dec `0` b); Intro.
-Intros; Apply euclid_rec with u1:=`1` u2:=`0` u3:=a
-                              v1:=`0` v2:=`1` v3:=b;
-Auto with zarith; Ring.
-Intros; Apply euclid_rec with u1:=`1` u2:=`0` u3:=a
-                              v1:=`0` v2:=`-1` v3:=`-b`;
-Auto with zarith; Try Ring.
-Save.
-
-End extended_euclid_algorithm.
-
-Theorem gcd_uniqueness_apart_sign :
-  (a,b,d,d':Z) (gcd a b d) -> (gcd a b d') -> `d = d'` \/ `d = -d'`.
-Proof.
-Induction 1.
-Intros H1 H2 H3; Induction 1; Intros.
-Generalize (H3 d' H4 H5); Intro Hd'd.
-Generalize (H6 d H1 H2); Intro Hdd'.
-Exact (Zdivide_antisym d d' Hdd' Hd'd).
-Save.
-
-(** * Bezout's coefficients *)
-
-Inductive Bezout [a,b,d:Z] : Prop := 
-  Bezout_intro : (u,v:Z) `u*a + v*b = d` -> (Bezout a b d).
-
-(** Existence of Bezout's coefficients for the [gcd] of [a] and [b] *)
-
-Lemma gcd_bezout : (a,b,d:Z) (gcd a b d) -> (Bezout a b d).
-Proof.
-Intros a b d Hgcd.
-Elim (euclid a b); Intros u v d0 e g.
-Generalize (gcd_uniqueness_apart_sign a b d d0 Hgcd g).
-Intro H; Elim H; Clear H; Intros.
-Apply Bezout_intro with u v.
-Rewrite H; Assumption.
-Apply Bezout_intro with `-u` `-v`.
-Rewrite H; Rewrite <- e; Ring.
-Save.
-
-(** gcd of [ca] and [cb] is [c gcd(a,b)]. *)
-
-Lemma gcd_mult : (a,b,c,d:Z) (gcd a b d) -> (gcd `c*a` `c*b` `c*d`).
-Proof.
-Intros a b c d; Induction 1; Constructor; Intuition.
-Elim (gcd_bezout a b d H); Intros.
-Elim H3; Intros.
-Elim H4; Intros.
-Apply Zdivide_intro with `u*q+v*q0`.
-Rewrite <- H5.
-Replace `c*(u*a+v*b)` with `u*(c*a)+v*(c*b)`.
-Rewrite H6; Rewrite H7; Ring.
-Ring.
-Save.
-
-(** We could obtain a [Zgcd] function via [euclid]. But we propose 
-  here a more direct version of a [Zgcd], with better extraction 
-  (no bezout coeffs). *)
-
-Definition Zgcd_pos : (a:Z)`0<=a` -> (b:Z) 
- { g:Z | `0<=a` -> (gcd a b g) /\ `g>=0` }.
-Proof.
-Intros a Ha.
-Apply (Z_lt_rec [a:Z](b:Z) { g:Z | `0<=a` -> (gcd a b g) /\`g>=0` }); Try Assumption.
-Intro x; Case x.
-Intros _ b; Exists (Zabs b).
-  Elim (Z_le_lt_eq_dec ? ? (Zabs_pos b)).
-    Intros H0; Split.
-    Apply Zabs_ind.
-    Intros; Apply gcd_sym; Apply gcd_0; Auto.
-    Intros; Apply gcd_opp; Apply gcd_0; Auto.
-    Auto with zarith.
-    
-    Intros H0;  Rewrite <- H0.
-    Rewrite <- (Zabs_Zsgn b); Rewrite <- H0; Simpl.
-    Split; [Apply gcd_0|Idtac];Auto with zarith.
-  
-Intros p Hrec b.
-Generalize (Z_div_mod b (POS p)).
-Case (Zdiv_eucl b (POS p)); Intros q r Hqr.
-Elim Hqr; Clear Hqr; Intros; Auto with zarith.
-Elim (Hrec r H0 (POS p)); Intros g Hgkl.
-Inversion_clear H0.
-Elim (Hgkl H1); Clear Hgkl; Intros H3 H4.
-Exists g; Intros.
-Split; Auto.
-Rewrite H.
-Apply gcd_for_euclid2; Auto.
-
-Intros p Hrec b.
-Exists `0`; Intros.
-Elim H; Auto.
-Defined.
-
-Definition Zgcd_spec : (a,b:Z){ g : Z | (gcd a b g) /\ `g>=0` }.
-Proof.
-Intros a; Case (Z_gt_le_dec `0` a).
-Intros; Assert `0 <= -a`.
-Omega.
-Elim (Zgcd_pos `-a` H b); Intros g Hgkl.
-Exists g.
-Intuition.
-Intros Ha b; Elim (Zgcd_pos a Ha b); Intros g; Exists g; Intuition.
-Defined.
-
-Definition Zgcd := [a,b:Z](let (g,_) = (Zgcd_spec a b) in g).
-
-Lemma Zgcd_is_pos : (a,b:Z)`(Zgcd a b) >=0`.
-Intros a b; Unfold Zgcd; Case (Zgcd_spec a b); Tauto.
-Qed.
-
-Lemma Zgcd_is_gcd : (a,b:Z)(gcd a b (Zgcd a b)).
-Intros a b; Unfold Zgcd; Case (Zgcd_spec a b); Tauto.
-Qed.
-
-(** * Relative primality *)
-
-Definition rel_prime [a,b:Z] : Prop := (gcd a b `1`).
-
-(** Bezout's theorem: [a] and [b] are relatively prime if and
-    only if there exist [u] and [v] such that [ua+vb = 1]. *)
-
-Lemma rel_prime_bezout : 
-  (a,b:Z) (rel_prime a b) -> (Bezout a b `1`).
-Proof.
-Intros a b; Exact (gcd_bezout a b `1`).
-Save.
-
-Lemma bezout_rel_prime :
-  (a,b:Z) (Bezout a b `1`) -> (rel_prime a b).
-Proof.
-Induction 1; Constructor; Auto with zarith.
-Intros. Rewrite <- H0; Auto with zarith.
-Save.
-
-(** Gauss's theorem: if [a] divides [bc] and if [a] and [b] are
-    relatively prime, then [a] divides [c]. *)
-
-Theorem Gauss : (a,b,c:Z) (a |`b*c`) -> (rel_prime a b) -> (a | c).
-Proof.
-Intros. Elim (rel_prime_bezout a b H0); Intros.
-Replace c with `c*1`; [ Idtac | Ring ].
-Rewrite <- H1.
-Replace `c*(u*a+v*b)` with `(c*u)*a + v*(b*c)`; [ EAuto with zarith | Ring ].
-Save.
-
-(** If [a] is relatively prime to [b] and [c], then it is to [bc] *)
-
-Lemma rel_prime_mult : 
-  (a,b,c:Z) (rel_prime a b) -> (rel_prime a c) -> (rel_prime a `b*c`).
-Proof.
-Intros a b c Hb Hc.
-Elim (rel_prime_bezout a b Hb); Intros.
-Elim (rel_prime_bezout a c Hc); Intros.
-Apply bezout_rel_prime.
-Apply Bezout_intro with u:=`u*u0*a+v0*c*u+u0*v*b` v:=`v*v0`.
-Rewrite <- H.
-Replace `u*a+v*b` with `(u*a+v*b) * 1`; [ Idtac | Ring ].
-Rewrite <- H0.
-Ring.
-Save.
-
-Lemma rel_prime_cross_prod :
-  (a,b,c,d:Z) (rel_prime a b) -> (rel_prime c d) -> `b>0` -> `d>0` -> 
-  `a*d = b*c` -> (a=c /\ b=d).
-Proof.
-Intros a b c d; Intros.
-Elim (Zdivide_antisym b d).
-Split; Auto with zarith.
-Rewrite H4 in H3.
-Rewrite Zmult_sym in H3.
-Apply Zmult_reg_left with d; Auto with zarith.
-Intros; Omega.
-Apply Gauss with a.
-Rewrite H3.
-Auto with zarith.
-Red; Auto with zarith.
-Apply Gauss with c.
-Rewrite Zmult_sym.
-Rewrite <- H3.
-Auto with zarith.
-Red; Auto with zarith.
-Save.
-
-(** After factorization by a gcd, the original numbers are relatively prime. *)
-
-Lemma gcd_rel_prime : 
- (a,b,g:Z)`b>0` -> `g>=0`-> (gcd a b g) -> (rel_prime `a/g` `b/g`).
-Intros a b g; Intros.
-Assert `g <> 0`.
- Intro.
- Elim H1; Intros. 
- Elim H4; Intros.
- Rewrite H2 in H6; Subst b; Omega.
-Unfold rel_prime.
-Elim (Zgcd_spec `a/g` `b/g`); Intros g' (H3,H4).
-Assert H5 := (gcd_mult ? ? g ? H3).
-Rewrite <- Z_div_exact_2 in H5; Auto with zarith.
-Rewrite <- Z_div_exact_2 in H5; Auto with zarith.
-Elim (gcd_uniqueness_apart_sign ? ? ? ? H1 H5).
-Intros; Rewrite (!Zmult_reg_left `1` g' g); Auto with zarith.
-Intros; Rewrite (!Zmult_reg_left `1` `-g'` g); Auto with zarith.
-Pattern 1 g; Rewrite H6; Ring.
-
-Elim H1; Intros.
-Elim H7; Intros.
-Rewrite H9.
-Replace `q*g` with `0+q*g`.
-Rewrite Z_mod_plus.
-Compute; Auto.
-Omega.
-Ring.
-
-Elim H1; Intros.
-Elim H6; Intros.
-Rewrite H9.
-Replace `q*g` with `0+q*g`.
-Rewrite Z_mod_plus.
-Compute; Auto.
-Omega.
-Ring.
-Save.
-
-(** * Primality *)
-
-Inductive prime [p:Z] : Prop := 
-  prime_intro : 
-   `1 < p` -> ((n:Z) `1 <= n < p` -> (rel_prime n p)) -> (prime p).
-
-(** The sole divisors of a prime number [p] are [-1], [1], [p] and [-p]. *)
-
-Lemma prime_divisors : 
-  (p:Z) (prime p) -> 
-  (a:Z) (a|p) -> `a = -1` \/ `a = 1` \/ a = p \/ `a = -p`.
-Proof.
-Induction 1; Intros.
-Assert `a = (-p)`\/`-p<a< -1`\/`a = -1`\/`a=0`\/`a = 1`\/`1<a<p`\/`a = p`.
-Assert `|a| <= |p|`. Apply Zdivide_bounds; [ Assumption | Omega ].
-Generalize H3. 
-Pattern `|a|`; Apply Zabs_ind; Pattern `|p|`; Apply Zabs_ind; Intros; Omega.
-Intuition Idtac.
-(* -p < a < -1 *)
-Absurd (rel_prime `-a` p); Intuition.
-Inversion H3.
-Assert (`-a` | `-a`); Auto with zarith.
-Assert (`-a` | p); Auto with zarith.
-Generalize (H8 `-a` H9 H10); Intuition Idtac.
-Generalize (Zdivide_1 `-a` H11); Intuition.
-(* a = 0 *)
-Inversion H2. Subst a; Omega.
-(* 1 < a < p *)
-Absurd (rel_prime a p); Intuition.
-Inversion H3.
-Assert (a | a); Auto with zarith.
-Assert (a | p); Auto with zarith.
-Generalize (H8 a H9 H10); Intuition Idtac.
-Generalize (Zdivide_1 a H11); Intuition.
-Save.
-
-(** A prime number is relatively prime with any number it does not divide *)
-
-Lemma prime_rel_prime : 
-  (p:Z) (prime p) -> (a:Z) ~ (p|a) -> (rel_prime p a).
-Proof.
-Induction 1; Intros.
-Constructor; Intuition.
-Elim (prime_divisors p H x H3); Intuition; Subst; Auto with zarith.
-Absurd (p | a); Auto with zarith.
-Absurd (p | a); Intuition.
-Save.
-
-Hints Resolve prime_rel_prime : zarith.
-
-(** [Zdivide] can be expressed using [Zmod]. *)
-
-Lemma Zmod_Zdivide : (a,b:Z) `b>0` -> `a%b = 0` -> (b|a).
-Intros a b H H0.
-Apply Zdivide_intro with `(a/b)`.
-Pattern 1 a; Rewrite (Z_div_mod_eq a b H).
-Rewrite H0; Ring.
-Save.
-
-Lemma Zdivide_Zmod : (a,b:Z) `b>0` -> (b|a) -> `a%b = 0`.
-Intros a b; Destruct 2; Intros; Subst.
-Change `q*b` with `0+q*b`.
-Rewrite Z_mod_plus; Auto.
-Save.
-
-(** [Zdivide] is hence decidable *)
-
-Lemma Zdivide_dec : (a,b:Z) { (a|b) } + { ~ (a|b) }.
-Proof.
-Intros a b; Elim (Ztrichotomy_inf a `0`).
-(* a<0 *)
-Intros H; Elim H; Intros. 
-Case (Z_eq_dec `b%(-a)` `0`).
-Left; Apply Zdivide_opp_left_rev; Apply Zmod_Zdivide; Auto with zarith.
-Intro H1; Right; Intro; Elim H1; Apply Zdivide_Zmod; Auto with zarith.
-(* a=0 *)
-Case (Z_eq_dec b `0`); Intro.
-Left; Subst; Auto with zarith.
-Right; Subst; Intro H0; Inversion H0; Omega.
-(* a>0 *)
-Intro H; Case (Z_eq_dec `b%a` `0`).
-Left; Apply Zmod_Zdivide; Auto with zarith.
-Intro H1; Right; Intro; Elim H1; Apply Zdivide_Zmod; Auto with zarith.
-Save.
-
-(** If a prime [p] divides [ab] then it divides either [a] or [b] *)
-
-Lemma prime_mult : 
-  (p:Z) (prime p) -> (a,b:Z) (p | `a*b`) -> (p | a) \/ (p | b).
-Proof.
-Intro p; Induction 1; Intros.
-Case (Zdivide_dec p a); Intuition.
-Right; Apply Gauss with a; Auto with zarith.
-Save.
-
-
diff --git a/theories7/ZArith/Zorder.v b/theories7/ZArith/Zorder.v
deleted file mode 100644
index d49a0800..00000000
--- a/theories7/ZArith/Zorder.v
+++ /dev/null
@@ -1,969 +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: Zorder.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
-
-(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
-
-Require BinPos.
-Require BinInt.
-Require Arith.
-Require Decidable.
-Require Zsyntax.
-Require Zcompare.
-
-V7only [Import nat_scope.].
-Open Local Scope Z_scope.
-
-Implicit Variable Type x,y,z:Z.
-
-(**********************************************************************)
-(** Properties of the order relations on binary integers *)
-
-(** Trichotomy *)
-
-Theorem Ztrichotomy_inf : (m,n:Z) {`m<n`} + {m=n} + {`m>n`}.
-Proof.
-Unfold Zgt Zlt; Intros m n; Assert H:=(refl_equal ? (Zcompare m n)).
-  LetTac x := (Zcompare m n) in 2 H Goal.
-  NewDestruct x; 
-    [Left; Right;Rewrite Zcompare_EGAL_eq with 1:=H 
-    | Left; Left
-    | Right ]; Reflexivity.
-Qed.
-
-Theorem Ztrichotomy : (m,n:Z) `m<n` \/ m=n \/ `m>n`.
-Proof.
-  Intros m n; NewDestruct (Ztrichotomy_inf m n) as [[Hlt|Heq]|Hgt];
-    [Left | Right; Left |Right; Right]; Assumption.
-Qed.
-
-(**********************************************************************)
-(** Decidability of equality and order on Z *)
-
-Theorem dec_eq: (x,y:Z) (decidable (x=y)).
-Proof.
-Intros x y; Unfold decidable ; Elim (Zcompare_EGAL x y);
-Intros H1 H2; Elim (Dcompare (Zcompare x y)); [
-    Tauto
-  | Intros H3; Right; Unfold not ; Intros H4;
-    Elim H3; Rewrite (H2 H4); Intros H5; Discriminate H5].
-Qed. 
-
-Theorem dec_Zne: (x,y:Z) (decidable (Zne x y)).
-Proof.
-Intros x y; Unfold decidable Zne ; Elim (Zcompare_EGAL x y).
-Intros H1 H2; Elim (Dcompare (Zcompare x y)); 
-  [ Right; Rewrite H1; Auto
-  | Left; Unfold not; Intro; Absurd (Zcompare x y)=EGAL; 
-    [ Elim H; Intros HR; Rewrite HR; Discriminate 
-    | Auto]].
-Qed.
-
-Theorem dec_Zle: (x,y:Z) (decidable `x<=y`).
-Proof.
-Intros x y; Unfold decidable Zle ; Elim (Zcompare x y); [
-    Left; Discriminate
-  | Left; Discriminate
-  | Right; Unfold not ; Intros H; Apply H; Trivial with arith].
-Qed.
-
-Theorem dec_Zgt: (x,y:Z) (decidable `x>y`).
-Proof.
-Intros x y; Unfold decidable Zgt ; Elim (Zcompare x y);
-  [ Right; Discriminate | Right; Discriminate | Auto with arith].
-Qed.
-
-Theorem dec_Zge: (x,y:Z) (decidable `x>=y`).
-Proof.
-Intros x y; Unfold decidable Zge ; Elim (Zcompare x y); [
-  Left; Discriminate
-| Right; Unfold not ; Intros H; Apply H; Trivial with arith
-| Left; Discriminate]. 
-Qed.
-
-Theorem dec_Zlt: (x,y:Z) (decidable `x<y`).
-Proof.
-Intros x y; Unfold decidable Zlt ; Elim (Zcompare x y);
-  [ Right; Discriminate | Auto with arith | Right; Discriminate].
-Qed.
-
-Theorem not_Zeq : (x,y:Z) ~ x=y -> `x<y` \/ `y<x`.
-Proof.
-Intros x y; Elim (Dcompare (Zcompare x y)); [
-  Intros H1 H2; Absurd x=y; [ Assumption | Elim (Zcompare_EGAL x y); Auto with arith]
-| Unfold Zlt ; Intros H; Elim H; Intros H1; 
-    [Auto with arith | Right; Elim (Zcompare_ANTISYM x y); Auto with arith]].
-Qed. 
-
-(** Relating strict and large orders *)
-
-Lemma Zgt_lt : (m,n:Z) `m>n` -> `n<m`.
-Proof.
-Unfold Zgt Zlt ;Intros m n H; Elim (Zcompare_ANTISYM m n); Auto with arith.
-Qed.
-
-Lemma Zlt_gt : (m,n:Z) `m<n` -> `n>m`.
-Proof.
-Unfold Zgt Zlt ;Intros m n H; Elim (Zcompare_ANTISYM n m); Auto with arith.
-Qed.
-
-Lemma Zge_le : (m,n:Z) `m>=n` -> `n<=m`.
-Proof.
-Intros m n; Change ~`m<n`-> ~`n>m`;
-Unfold not; Intros H1 H2; Apply H1; Apply Zgt_lt; Assumption.
-Qed.
-
-Lemma Zle_ge : (m,n:Z) `m<=n` -> `n>=m`.
-Proof.
-Intros m n; Change ~`m>n`-> ~`n<m`;
-Unfold not; Intros H1 H2; Apply H1; Apply Zlt_gt; Assumption.
-Qed.
-
-Lemma Zle_not_gt     : (n,m:Z)`n<=m` -> ~`n>m`.
-Proof.
-Trivial.
-Qed.
-
-Lemma Zgt_not_le     : (n,m:Z)`n>m` -> ~`n<=m`.
-Proof.
-Intros n m H1 H2; Apply H2; Assumption.
-Qed.
-
-Lemma Zle_not_lt : (n,m:Z)`n<=m` -> ~`m<n`.
-Proof.
-Intros n m H1 H2.
-Assert H3:=(Zlt_gt ? ? H2).
-Apply Zle_not_gt with n m; Assumption.
-Qed.
-
-Lemma Zlt_not_le : (n,m:Z)`n<m` -> ~`m<=n`.
-Proof.
-Intros n m H1 H2.
-Apply Zle_not_lt with m n; Assumption.
-Qed.
-
-Lemma not_Zge : (x,y:Z) ~`x>=y` -> `x<y`.
-Proof.
-Unfold Zge Zlt ; Intros x y H; Apply dec_not_not;
-  [ Exact (dec_Zlt x y) | Assumption].
-Qed.
- 
-Lemma not_Zlt : (x,y:Z) ~`x<y` -> `x>=y`.
-Proof.
-Unfold Zlt Zge; Auto with arith.
-Qed.
-
-Lemma not_Zgt : (x,y:Z)~`x>y` -> `x<=y`.
-Proof.
-Trivial.
-Qed.
-
-Lemma not_Zle : (x,y:Z) ~`x<=y` -> `x>y`.
-Proof.
-Unfold Zle Zgt ; Intros x y H; Apply dec_not_not;
-  [ Exact (dec_Zgt x y) | Assumption].
-Qed.
-
-Lemma Zge_iff_le : (x,y:Z) `x>=y` <-> `y<=x`.
-Proof.
-    Intros x y; Intros. Split. Intro. Apply Zge_le. Assumption.
-    Intro. Apply Zle_ge. Assumption.
-Qed.
-
-Lemma Zgt_iff_lt : (x,y:Z) `x>y` <-> `y<x`.
-Proof.
-    Intros x y. Split. Intro. Apply Zgt_lt. Assumption.
-    Intro. Apply Zlt_gt. Assumption.
-Qed.
- 
-(** Reflexivity *)
-
-Lemma Zle_n : (n:Z) (Zle n n).
-Proof.
-Intros n; Unfold Zle; Rewrite (Zcompare_x_x n); Discriminate.
-Qed. 
-
-Lemma Zle_refl : (n,m:Z) n=m -> `n<=m`.
-Proof.
-Intros; Rewrite H; Apply Zle_n.
-Qed.
-
-Hints Resolve Zle_n : zarith.
-
-(** Antisymmetry *)
-
-Lemma Zle_antisym : (n,m:Z)`n<=m`->`m<=n`->n=m.
-Proof.
-Intros n m H1 H2; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]. 
-  Absurd `m>n`; [ Apply Zle_not_gt | Apply Zlt_gt]; Assumption.
-  Assumption.
-  Absurd `n>m`; [ Apply Zle_not_gt | Idtac]; Assumption.
-Qed.
-
-(** Asymmetry *)
-
-Lemma Zgt_not_sym    : (n,m:Z)`n>m` -> ~`m>n`.
-Proof.
-Unfold Zgt ;Intros n m H; Elim (Zcompare_ANTISYM n m); Intros H1 H2;
-Rewrite -> H1; [ Discriminate | Assumption ].
-Qed.
-
-Lemma Zlt_not_sym : (n,m:Z)`n<m` -> ~`m<n`.
-Proof.
-Intros n m H H1;
-Assert H2:`m>n`. Apply Zlt_gt; Assumption.
-Assert H3: `n>m`. Apply Zlt_gt; Assumption.
-Apply Zgt_not_sym with m n; Assumption.
-Qed.
-
-(** Irreflexivity *)
-
-Lemma Zgt_antirefl   : (n:Z)~`n>n`.
-Proof.
-Intros n H; Apply (Zgt_not_sym n n H H).
-Qed.
-
-Lemma Zlt_n_n : (n:Z)~`n<n`.
-Proof.
-Intros n H; Apply (Zlt_not_sym n n H H).
-Qed.
-
-Lemma Zlt_not_eq : (x,y:Z)`x<y` -> ~x=y.
-Proof.
-Unfold not; Intros x y H H0.
-Rewrite H0 in H.
-Apply (Zlt_n_n ? H).
-Qed.
-
-(** Large = strict or equal *)
-
-Lemma Zlt_le_weak : (n,m:Z)`n<m`->`n<=m`.
-Proof.
-Intros n m Hlt; Apply not_Zgt; Apply Zgt_not_sym; Apply Zlt_gt; Assumption.
-Qed.
-
-Lemma Zle_lt_or_eq : (n,m:Z)`n<=m`->(`n<m` \/ n=m).
-Proof.
-Intros n m H; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]; [
-  Left; Assumption
-| Right; Assumption
-| Absurd `n>m`; [Apply Zle_not_gt|Idtac]; Assumption ].
-Qed.
-
-(** Dichotomy *)
-
-Lemma Zle_or_lt : (n,m:Z)`n<=m`\/`m<n`.
-Proof.
-Intros n m; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]; [
-  Left; Apply not_Zgt; Intro Hgt; Assert Hgt':=(Zlt_gt ? ? Hlt);
-     Apply Zgt_not_sym with m n; Assumption
-| Left; Rewrite Heq; Apply Zle_n
-| Right; Apply Zgt_lt; Assumption ].
-Qed.
-
-(** Transitivity of strict orders *)
-
-Lemma Zgt_trans      : (n,m,p:Z)`n>m`->`m>p`->`n>p`.
-Proof.
-Exact Zcompare_trans_SUPERIEUR.
-Qed.
-
-Lemma Zlt_trans : (n,m,p:Z)`n<m`->`m<p`->`n<p`.
-Proof.
-Intros n m p H1 H2; Apply Zgt_lt; Apply Zgt_trans with m:= m; 
-Apply Zlt_gt; Assumption.
-Qed.
-
-(** Mixed transitivity *)
-
-Lemma Zle_gt_trans : (n,m,p:Z)`m<=n`->`m>p`->`n>p`.
-Proof.
-Intros n m p H1 H2; NewDestruct (Zle_lt_or_eq m n H1) as [Hlt|Heq]; [
-  Apply Zgt_trans with m; [Apply Zlt_gt; Assumption | Assumption ]
-| Rewrite <- Heq; Assumption ].
-Qed.
-
-Lemma Zgt_le_trans : (n,m,p:Z)`n>m`->`p<=m`->`n>p`.
-Proof.
-Intros n m p H1 H2; NewDestruct (Zle_lt_or_eq p m H2) as [Hlt|Heq]; [
-  Apply Zgt_trans with m; [Assumption|Apply Zlt_gt; Assumption]
-| Rewrite Heq; Assumption ].
-Qed.
-
-Lemma Zlt_le_trans : (n,m,p:Z)`n<m`->`m<=p`->`n<p`.
-Intros n m p H1 H2;Apply Zgt_lt;Apply Zle_gt_trans with m:=m;
-  [ Assumption | Apply Zlt_gt;Assumption ].
-Qed.
-
-Lemma Zle_lt_trans : (n,m,p:Z)`n<=m`->`m<p`->`n<p`.
-Proof.
-Intros n m p H1 H2;Apply Zgt_lt;Apply Zgt_le_trans with m:=m; 
-  [ Apply Zlt_gt;Assumption | Assumption ].
-Qed.
-
-(** Transitivity of large orders *)
-
-Lemma Zle_trans : (n,m,p:Z)`n<=m`->`m<=p`->`n<=p`.
-Proof.
-Intros n m p H1 H2; Apply not_Zgt.
-Intro Hgt; Apply Zle_not_gt with n m. Assumption.
-Exact (Zgt_le_trans n p m Hgt H2).
-Qed.
-
-Lemma Zge_trans : (n, m, p : Z) `n>=m` -> `m>=p` -> `n>=p`.
-Proof.
-Intros n m p H1 H2.
-Apply Zle_ge.
-Apply Zle_trans with m; Apply Zge_le; Trivial.
-Qed.
-
-Hints Resolve Zle_trans : zarith.
-
-(** Compatibility of successor wrt to order *)
-
-Lemma Zle_n_S : (n,m:Z) `m<=n` -> `(Zs m)<=(Zs n)`.
-Proof.
-Unfold Zle not ;Intros m n H1 H2; Apply H1; 
-Rewrite <- (Zcompare_Zplus_compatible n m (POS xH));
-Do 2 Rewrite (Zplus_sym (POS xH)); Exact H2.
-Qed.
-
-Lemma Zgt_n_S : (n,m:Z)`m>n` -> `(Zs m)>(Zs n)`.
-Proof.
-Unfold Zgt; Intros n m H; Rewrite Zcompare_n_S; Auto with arith.
-Qed.
-
-Lemma Zlt_n_S : (n,m:Z)`n<m`->`(Zs n)<(Zs m)`.
-Proof.
-Intros n m H;Apply Zgt_lt;Apply Zgt_n_S;Apply Zlt_gt; Assumption.
-Qed.
-
-Hints Resolve Zle_n_S : zarith.
-
-(** Simplification of successor wrt to order *)
-
-Lemma Zgt_S_n        : (n,p:Z)`(Zs p)>(Zs n)`->`p>n`.
-Proof.
-Unfold Zs Zgt;Intros n p;Do 2 Rewrite -> [m:Z](Zplus_sym m (POS xH));
-Rewrite -> (Zcompare_Zplus_compatible p n (POS xH));Trivial with arith.
-Qed.
-
-Lemma Zle_S_n     : (n,m:Z) `(Zs m)<=(Zs n)` -> `m<=n`.
-Proof.
-Unfold Zle not ;Intros m n H1 H2;Apply H1;
-Unfold Zs ;Do 2 Rewrite <- (Zplus_sym (POS xH));
-Rewrite -> (Zcompare_Zplus_compatible n m (POS xH));Assumption.
-Qed.
-
-Lemma Zlt_S_n : (n,m:Z)`(Zs n)<(Zs m)`->`n<m`.
-Proof.
-Intros n m H;Apply Zgt_lt;Apply Zgt_S_n;Apply Zlt_gt; Assumption.
-Qed.
-
-(** Compatibility of addition wrt to order *)
-
-Lemma Zgt_reg_l   : (n,m,p:Z)`n>m`->`p+n>p+m`.
-Proof.
-Unfold Zgt; Intros n m p H; Rewrite (Zcompare_Zplus_compatible n m p); 
-Assumption.
-Qed.
-
-Lemma Zgt_reg_r : (n,m,p:Z)`n>m`->`n+p>m+p`.
-Proof.
-Intros n m p H; Rewrite (Zplus_sym n p); Rewrite (Zplus_sym m p); Apply Zgt_reg_l; Trivial.
-Qed.
-
-Lemma Zle_reg_l : (n,m,p:Z)`n<=m`->`p+n<=p+m`.
-Proof.
-Intros n m p; Unfold Zle not ;Intros H1 H2;Apply H1; 
-Rewrite <- (Zcompare_Zplus_compatible n m p); Assumption.
-Qed.
-
-Lemma Zle_reg_r : (n,m,p:Z) `n<=m`->`n+p<=m+p`.
-Proof.
-Intros a b c;Do 2 Rewrite [n:Z](Zplus_sym n c); Exact (Zle_reg_l a b c).
-Qed.
-
-Lemma Zlt_reg_l : (n,m,p:Z)`n<m`->`p+n<p+m`.
-Proof.
-Unfold Zlt ;Intros n m p; Rewrite Zcompare_Zplus_compatible;Trivial with arith.
-Qed.
-
-Lemma Zlt_reg_r : (n,m,p:Z)`n<m`->`n+p<m+p`.
-Proof.
-Intros n m p H; Rewrite (Zplus_sym n p); Rewrite (Zplus_sym m p); Apply Zlt_reg_l; Trivial.
-Qed.
-
-Lemma Zlt_le_reg : (a,b,c,d:Z) `a<b`->`c<=d`->`a+c<b+d`.
-Proof.
-Intros a b c d H0 H1.
-Apply Zlt_le_trans with (Zplus b c).
-Apply  Zlt_reg_r; Trivial.
-Apply  Zle_reg_l; Trivial.
-Qed.
-
-Lemma Zle_lt_reg : (a,b,c,d:Z) `a<=b`->`c<d`->`a+c<b+d`.
-Proof.
-Intros a b c d H0 H1.
-Apply Zle_lt_trans with (Zplus b c).
-Apply  Zle_reg_r; Trivial.
-Apply  Zlt_reg_l; Trivial.
-Qed.
-
-Lemma Zle_plus_plus : (n,m,p,q:Z) `n<=m`->(Zle p q)->`n+p<=m+q`.
-Proof.
-Intros n m p q; Intros H1 H2;Apply Zle_trans with m:=(Zplus n q); [
-  Apply Zle_reg_l;Assumption | Apply Zle_reg_r;Assumption ].
-Qed.
-
-V7only [Set Implicit Arguments.].
-
-Lemma Zlt_Zplus : (x1,x2,y1,y2:Z)`x1 < x2` -> `y1 < y2` -> `x1 + y1 < x2 + y2`.
-Intros; Apply Zle_lt_reg. Apply Zlt_le_weak; Assumption. Assumption.
-Qed.
-
-V7only [Unset Implicit Arguments.].
-
-(** Compatibility of addition wrt to being positive *)
-
-Lemma Zle_0_plus : (x,y:Z) `0<=x` -> `0<=y` -> `0<=x+y`.
-Proof.
-Intros x y H1 H2;Rewrite <- (Zero_left ZERO); Apply Zle_plus_plus; Assumption.
-Qed.
-
-(** Simplification of addition wrt to order *)
-
-Lemma Zsimpl_gt_plus_l : (n,m,p:Z)`p+n>p+m`->`n>m`.
-Proof.
-Unfold Zgt; Intros n m p H; 
-	Rewrite <- (Zcompare_Zplus_compatible n m p); Assumption.
-Qed.
-
-Lemma Zsimpl_gt_plus_r : (n,m,p:Z)`n+p>m+p`->`n>m`.
-Proof.
-Intros n m p H; Apply Zsimpl_gt_plus_l with p.
-Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
-Qed.
-
-Lemma Zsimpl_le_plus_l : (n,m,p:Z)`p+n<=p+m`->`n<=m`.
-Proof.
-Intros n m p; Unfold Zle not ;Intros H1 H2;Apply H1; 
-Rewrite (Zcompare_Zplus_compatible n m p); Assumption.
-Qed.
- 
-Lemma Zsimpl_le_plus_r : (n,m,p:Z)`n+p<=m+p`->`n<=m`.
-Proof.
-Intros n m p H; Apply Zsimpl_le_plus_l with p.
-Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
-Qed.
-
-Lemma Zsimpl_lt_plus_l : (n,m,p:Z)`p+n<p+m`->`n<m`.
-Proof.
-Unfold Zlt ;Intros n m p; 
-	Rewrite Zcompare_Zplus_compatible;Trivial with arith.
-Qed.
- 
-Lemma Zsimpl_lt_plus_r : (n,m,p:Z)`n+p<m+p`->`n<m`.
-Proof.
-Intros n m p H; Apply Zsimpl_lt_plus_l with p.
-Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
-Qed.
- 
-(** Special base instances of order *)
-
-Lemma Zgt_Sn_n : (n:Z)`(Zs n)>n`.
-Proof.
-Exact Zcompare_Zs_SUPERIEUR.
-Qed.
-
-Lemma Zle_Sn_n : (n:Z)~`(Zs n)<=n`.
-Proof.
-Intros n; Apply Zgt_not_le; Apply Zgt_Sn_n.
-Qed.
-
-Lemma Zlt_n_Sn : (n:Z)`n<(Zs n)`.
-Proof.
-Intro n; Apply Zgt_lt; Apply Zgt_Sn_n.
-Qed.
-
-Lemma Zlt_pred_n_n : (n:Z)`(Zpred n)<n`.
-Proof.
-Intros n; Apply Zlt_S_n; Rewrite <- Zs_pred; Apply Zlt_n_Sn.
-Qed.
-
-(** Relating strict and large order using successor or predecessor *)
-
-Lemma Zgt_le_S       : (n,p:Z)`p>n`->`(Zs n)<=p`.
-Proof.
-Unfold Zgt Zle; Intros n p H; Elim (Zcompare_et_un p n); Intros H1 H2;
-Unfold not ;Intros H3; Unfold not in H1; Apply H1; [
-  Assumption
-| Elim (Zcompare_ANTISYM (Zplus n (POS xH)) p);Intros H4 H5;Apply H4;Exact H3].
-Qed.
-
-Lemma Zle_gt_S       : (n,p:Z)`n<=p`->`(Zs p)>n`.
-Proof.
-Intros n p H; Apply Zgt_le_trans with p.
-  Apply Zgt_Sn_n.
-  Assumption.
-Qed.
-
-Lemma Zle_lt_n_Sm : (n,m:Z)`n<=m`->`n<(Zs m)`.
-Proof.
-Intros n m H; Apply Zgt_lt; Apply Zle_gt_S; Assumption.
-Qed.
-
-Lemma Zlt_le_S : (n,p:Z)`n<p`->`(Zs n)<=p`.
-Proof.
-Intros n p H; Apply Zgt_le_S; Apply Zlt_gt; Assumption.
-Qed.
-
-Lemma Zgt_S_le       : (n,p:Z)`(Zs p)>n`->`n<=p`.
-Proof.
-Intros n p H;Apply Zle_S_n; Apply Zgt_le_S; Assumption.
-Qed.
-
-Lemma Zlt_n_Sm_le : (n,m:Z)`n<(Zs m)`->`n<=m`.
-Proof.
-Intros n m H; Apply Zgt_S_le; Apply Zlt_gt; Assumption.
-Qed.
-
-Lemma Zle_S_gt : (n,m:Z) `(Zs n)<=m` -> `m>n`.
-Proof.
-Intros n m H;Apply Zle_gt_trans with m:=(Zs n);
-  [ Assumption | Apply Zgt_Sn_n ].
-Qed.
-
-(** Weakening order *)
-
-Lemma Zle_n_Sn : (n:Z)`n<=(Zs n)`.
-Proof.
-Intros n; Apply Zgt_S_le;Apply Zgt_trans with m:=(Zs n) ;Apply Zgt_Sn_n.
-Qed.
-
-Hints Resolve Zle_n_Sn : zarith.
-
-Lemma Zle_pred_n : (n:Z)`(Zpred n)<=n`.
-Proof.
-Intros n;Pattern 2 n ;Rewrite Zs_pred; Apply Zle_n_Sn.
-Qed.
-
-Lemma Zlt_S : (n,m:Z)`n<m`->`n<(Zs m)`.
-Intros n m H;Apply Zgt_lt; Apply Zgt_trans with m:=m; [
-  Apply Zgt_Sn_n
-| Apply Zlt_gt; Assumption ].
-Qed.
-
-Lemma Zle_le_S : (x,y:Z)`x<=y`->`x<=(Zs y)`.
-Proof.
-Intros x y H.
-Apply Zle_trans with y; Trivial with zarith.
-Qed.
-
-Lemma Zle_trans_S : (n,m:Z)`(Zs n)<=m`->`n<=m`.
-Proof.
-Intros n m H;Apply Zle_trans with m:=(Zs n); [ Apply Zle_n_Sn | Assumption ].
-Qed.
-
-Hints Resolve Zle_le_S : zarith.
-
-(** Relating order wrt successor and order wrt predecessor *)
-
-Lemma Zgt_pred : (n,p:Z)`p>(Zs n)`->`(Zpred p)>n`.
-Proof.
-Unfold Zgt Zs Zpred ;Intros n p H; 
-Rewrite <- [x,y:Z](Zcompare_Zplus_compatible x y (POS xH));
-Rewrite (Zplus_sym p); Rewrite Zplus_assoc; Rewrite [x:Z](Zplus_sym x n);
-Simpl; Assumption.
-Qed.
-
-Lemma Zlt_pred : (n,p:Z)`(Zs n)<p`->`n<(Zpred p)`.
-Proof.
-Intros n p H;Apply Zlt_S_n; Rewrite <- Zs_pred; Assumption.
-Qed.
-
-(** Relating strict order and large order on positive *)
-
-Lemma Zlt_ZERO_pred_le_ZERO : (n:Z) `0<n` -> `0<=(Zpred n)`.
-Intros x H.
-Rewrite (Zs_pred x) in H.
-Apply Zgt_S_le.
-Apply Zlt_gt.
-Assumption.
-Qed.
-
-V7only [Set Implicit Arguments.].
-
-Lemma Zgt0_le_pred : (y:Z) `y > 0` -> `0 <= (Zpred y)`.
-Intros; Apply Zlt_ZERO_pred_le_ZERO; Apply Zgt_lt. Assumption.
-Qed.
-
-V7only [Unset Implicit Arguments.].
-
-(** Special cases of ordered integers *)
-
-V7only [ (* Relevance confirmed from Zdivides *) ].
-Lemma Z_O_1: `0<1`.
-Proof.
-Change `0<(Zs 0)`. Apply Zlt_n_Sn.
-Qed.
-
-Lemma Zle_0_1: `0<=1`.
-Proof.
-Change `0<=(Zs 0)`. Apply Zle_n_Sn.
-Qed.
-
-V7only [ (* Relevance confirmed from Zdivides *) ].
-Lemma Zle_NEG_POS: (p,q:positive) `(NEG p)<=(POS q)`.
-Proof.
-Intros p; Red; Simpl; Red; Intros H; Discriminate.
-Qed.
-
-Lemma POS_gt_ZERO : (p:positive) `(POS p)>0`.
-Unfold Zgt; Trivial.
-Qed.
-
-  (* weaker but useful (in [Zpower] for instance) *)
-Lemma ZERO_le_POS : (p:positive) `0<=(POS p)`.
-Intro; Unfold Zle; Discriminate.
-Qed.
-
-Lemma NEG_lt_ZERO : (p:positive)`(NEG p)<0`.
-Unfold Zlt; Trivial.
-Qed.
-
-Lemma ZERO_le_inj :
-  (n:nat) `0 <= (inject_nat n)`.
-Induction n; Simpl; Intros;
-[ Apply Zle_n
-| Unfold Zle; Simpl; Discriminate].
-Qed.
-
-Hints Immediate Zle_refl : zarith.
-
-(** Transitivity using successor *)
-
-Lemma Zgt_trans_S  : (n,m,p:Z)`(Zs n)>m`->`m>p`->`n>p`.
-Proof.
-Intros n m p H1 H2;Apply Zle_gt_trans with m:=m;
-  [ Apply Zgt_S_le; Assumption | Assumption ].
-Qed.
-
-(** Derived lemma *)
-
-Lemma Zgt_S        : (n,m:Z)`(Zs n)>m`->(`n>m`\/(m=n)).
-Proof.
-Intros n m H.
-Assert Hle : `m<=n`.
-  Apply Zgt_S_le; Assumption.
-NewDestruct (Zle_lt_or_eq ? ? Hle) as [Hlt|Heq].
-  Left; Apply Zlt_gt; Assumption.  
-  Right; Assumption.
-Qed.
-
-(** Compatibility of multiplication by a positive wrt to order *)
-
-V7only [Set Implicit Arguments.].
-
-Lemma Zle_Zmult_pos_right : (a,b,c : Z) `a<=b` -> `0<=c` -> `a*c<=b*c`.
-Proof.
-Intros a b c H H0; NewDestruct c.
-  Do 2 Rewrite Zero_mult_right; Assumption.
-  Rewrite (Zmult_sym a); Rewrite (Zmult_sym b).
-    Unfold Zle; Rewrite Zcompare_Zmult_compatible; Assumption.
-  Unfold Zle in H0; Contradiction H0; Reflexivity.
-Qed.
-
-Lemma Zle_Zmult_pos_left : (a,b,c : Z) `a<=b` -> `0<=c` -> `c*a<=c*b`.
-Proof.
-Intros a b c H1 H2; Rewrite (Zmult_sym c a);Rewrite (Zmult_sym c b).
-Apply  Zle_Zmult_pos_right; Trivial.
-Qed.
-
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_compat_r : (x,y,z:Z)`0<z` -> `x < y` -> `x*z < y*z`.
-Proof.
-Intros x y z H H0; NewDestruct z.
-  Contradiction (Zlt_n_n `0`).
-  Rewrite (Zmult_sym x); Rewrite (Zmult_sym y).
-    Unfold Zlt; Rewrite Zcompare_Zmult_compatible; Assumption.
-  Discriminate H.
-Save.
-
-Lemma Zgt_Zmult_right : (x,y,z:Z)`z>0` -> `x > y` -> `x*z > y*z`.
-Proof.
-Intros x y z; Intros; Apply Zlt_gt; Apply Zmult_lt_compat_r; 
-  Apply Zgt_lt; Assumption.
-Qed.
-
-Lemma Zlt_Zmult_right : (x,y,z:Z)`z>0` -> `x < y` -> `x*z < y*z`.
-Proof.
-Intros x y z; Intros; Apply Zmult_lt_compat_r; 
-  [Apply Zgt_lt; Assumption | Assumption].
-Qed.
-
-Lemma Zle_Zmult_right : (x,y,z:Z)`z>0` -> `x <= y` -> `x*z <= y*z`.
-Proof.
-Intros x y z Hz Hxy.
-Elim (Zle_lt_or_eq x y Hxy).
-Intros; Apply Zlt_le_weak.
-Apply Zlt_Zmult_right; Trivial.
-Intros; Apply Zle_refl.
-Rewrite H; Trivial.
-Qed.
-
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_0_le_compat_r : (x,y,z:Z)`0 < z`->`x <= y`->`x*z <= y*z`.
-Proof.
-Intros x y z; Intros; Apply Zle_Zmult_right; Try Apply Zlt_gt; Assumption.
-Qed.
-
-Lemma Zlt_Zmult_left : (x,y,z:Z)`z>0` -> `x < y` -> `z*x < z*y`.
-Proof.
-Intros x y z; Intros.
-Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
-Apply Zlt_Zmult_right; Assumption.
-Qed.
-
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_compat_l : (x,y,z:Z)`0<z` -> `x < y` -> `z*x < z*y`.
-Proof.
-Intros x y z; Intros.
-Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
-Apply Zlt_Zmult_right; Try Apply Zlt_gt; Assumption.
-Save.
-
-Lemma Zgt_Zmult_left : (x,y,z:Z)`z>0` -> `x > y` -> `z*x > z*y`.
-Proof.
-Intros x y z; Intros;
-Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
-Apply Zgt_Zmult_right; Assumption.
-Qed.
-
-Lemma Zge_Zmult_pos_right : (a,b,c : Z) `a>=b` -> `c>=0` -> `a*c>=b*c`.
-Proof.
-Intros a b c H1 H2; Apply Zle_ge.
-Apply Zle_Zmult_pos_right; Apply Zge_le; Trivial.
-Qed.
-
-Lemma Zge_Zmult_pos_left : (a,b,c : Z) 	`a>=b` -> `c>=0` -> `c*a>=c*b`.
-Proof.
-Intros a b c H1 H2; Apply Zle_ge.
-Apply Zle_Zmult_pos_left; Apply Zge_le; Trivial.
-Qed.
-
-Lemma Zge_Zmult_pos_compat : 
-  (a,b,c,d : Z) `a>=c` -> `b>=d` -> `c>=0` -> `d>=0` -> `a*b>=c*d`.
-Proof.
-Intros a b c d H0 H1 H2 H3.
-Apply Zge_trans with (Zmult a d).
-Apply Zge_Zmult_pos_left; Trivial.
-Apply Zge_trans with c; Trivial. 
-Apply Zge_Zmult_pos_right; Trivial.
-Qed.
-
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_le_compat: (a, b, c, d : Z)
- `a<=c` -> `b<=d` -> `0<=a` -> `0<=b` -> `a*b<=c*d`.
-Proof.
-Intros a b c d H0 H1 H2 H3.
-Apply Zle_trans with (Zmult c b).
-Apply Zle_Zmult_pos_right; Assumption.
-Apply Zle_Zmult_pos_left.
-Assumption.
-Apply Zle_trans with a; Assumption.
-Qed.
-
-(** Simplification of multiplication by a positive wrt to being positive *)
-
-Lemma Zlt_Zmult_right2 : (x,y,z:Z)`z>0`  -> `x*z < y*z` -> `x < y`.
-Proof.
-Intros x y z; Intros; NewDestruct z.
-  Contradiction (Zgt_antirefl `0`).
-  Rewrite (Zmult_sym x) in H0; Rewrite (Zmult_sym y) in H0.
-    Unfold Zlt in H0; Rewrite Zcompare_Zmult_compatible in H0; Assumption.
-  Discriminate H.
-Qed.
-
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_reg_r : (a, b, c : Z) `0<c` -> `a*c<b*c` -> `a<b`.
-Proof.
-Intros a b c H0 H1.
-Apply Zlt_Zmult_right2 with c; Try Apply Zlt_gt; Assumption.
-Qed.
-
-Lemma Zle_mult_simpl : (a,b,c:Z)`c>0`->`a*c<=b*c`->`a<=b`.
-Proof.
-Intros x y z Hz Hxy.
-Elim (Zle_lt_or_eq `x*z` `y*z` Hxy).
-Intros; Apply Zlt_le_weak.
-Apply Zlt_Zmult_right2 with z; Trivial.
-Intros; Apply Zle_refl.
-Apply Zmult_reg_right with z.
-  Intro. Rewrite H0 in Hz. Contradiction (Zgt_antirefl `0`).
-Assumption.
-Qed.
-V7only [Notation Zle_Zmult_right2 := Zle_mult_simpl.
-(* Zle_Zmult_right2 :  (x,y,z:Z)`z>0` -> `x*z <= y*z` -> `x <= y`. *)
-].
-
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_0_le_reg_r: (x,y,z:Z)`0 <z`->`x*z <= y*z`->`x <= y`.
-Intros x y z; Intros ; Apply Zle_mult_simpl with z.
-Try Apply Zlt_gt; Assumption.
-Assumption.
-Qed.
-
-V7only [Unset Implicit Arguments.].
-
-Lemma Zge_mult_simpl : (a,b,c:Z) `c>0`->`a*c>=b*c`->`a>=b`.
-Intros a b c H1 H2; Apply Zle_ge; Apply Zle_mult_simpl with c; Trivial.
-Apply Zge_le; Trivial.
-Qed.
-
-Lemma Zgt_mult_simpl : (a,b,c:Z) `c>0`->`a*c>b*c`->`a>b`.
-Intros a b c H1 H2; Apply Zlt_gt; Apply Zlt_Zmult_right2 with c; Trivial.
-Apply Zgt_lt; Trivial.
-Qed.
-
-
-(** Compatibility of multiplication by a positive wrt to being positive *)
-
-Lemma Zle_ZERO_mult : (x,y:Z) `0<=x` -> `0<=y` -> `0<=x*y`.
-Proof.
-Intros x y; Case x.
-Intros; Rewrite Zero_mult_left; Trivial.
-Intros p H1; Unfold Zle.
-  Pattern 2 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
-  Rewrite  Zcompare_Zmult_compatible; Trivial.
-Intros p H1 H2; Absurd (Zgt ZERO (NEG p)); Trivial.
-Unfold Zgt; Simpl; Auto with zarith.
-Qed.
-
-Lemma Zgt_ZERO_mult: (a,b:Z) `a>0`->`b>0`->`a*b>0`.
-Proof.
-Intros x y; Case x.
-Intros H; Discriminate H.
-Intros p H1; Unfold Zgt; 
-Pattern 2 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
-  Rewrite  Zcompare_Zmult_compatible; Trivial.
-Intros p H; Discriminate H.
-Qed.
-
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_O_compat : (a, b : Z) `0<a` -> `0<b` -> `0<a*b`.
-Intros a b apos bpos.
-Apply Zgt_lt.
-Apply Zgt_ZERO_mult; Try Apply Zlt_gt; Assumption.
-Qed.
-
-Lemma Zle_mult: (x,y:Z) `x>0` -> `0<=y` -> `0<=(Zmult y x)`.
-Proof.
-Intros x y H1 H2; Apply Zle_ZERO_mult; Trivial.
-Apply Zlt_le_weak; Apply Zgt_lt; Trivial.
-Qed.
-
-(** Simplification of multiplication by a positive wrt to being positive *)
-
-Lemma Zmult_le: (x,y:Z) `x>0` -> `0<=(Zmult y x)` -> `0<=y`.
-Proof.
-Intros x y; Case x; [
-  Simpl; Unfold Zgt ; Simpl; Intros H; Discriminate H
-| Intros p H1; Unfold Zle; Rewrite -> Zmult_sym;
-  Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p));
-  Rewrite  Zcompare_Zmult_compatible; Auto with arith
-| Intros p; Unfold Zgt ; Simpl; Intros H; Discriminate H].
-Qed.
-
-Lemma Zmult_lt: (x,y:Z) `x>0` -> `0<y*x` -> `0<y`.
-Proof.
-Intros x y; Case x; [
-  Simpl; Unfold Zgt ; Simpl; Intros H; Discriminate H
-| Intros p H1; Unfold Zlt; Rewrite -> Zmult_sym;
-  Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p));
-  Rewrite  Zcompare_Zmult_compatible; Auto with arith
-| Intros p; Unfold Zgt ; Simpl; Intros H; Discriminate H].
-Qed.
-
-V7only [ (* Relevance confirmed from Zextensions *) ].
-Lemma Zmult_lt_0_reg_r : (x,y:Z)`0 < x`->`0 < y*x`->`0 < y`.
-Proof.
-Intros x y; Intros; EApply Zmult_lt with x ; Try Apply Zlt_gt; Assumption.
-Qed.
-
-Lemma Zmult_gt: (x,y:Z) `x>0` -> `x*y>0` -> `y>0`.
-Proof.
-Intros x y; Case x.
- Intros H; Discriminate H.
- Intros p H1; Unfold Zgt.
- Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
- Rewrite  Zcompare_Zmult_compatible; Trivial.
-Intros p H; Discriminate H.
-Qed.
-
-(** Simplification of square wrt order *)
-
-Lemma Zgt_square_simpl: (x, y : Z) `x>=0` -> `y>=0` -> `x*x>y*y` -> `x>y`.
-Proof.
-Intros x y H0 H1 H2.
-Case (dec_Zlt y x).
-Intro; Apply Zlt_gt; Trivial.
-Intros H3; Cut (Zge y x).
-Intros H.
-Elim Zgt_not_le with 1 := H2.
-Apply Zge_le.
-Apply Zge_Zmult_pos_compat; Auto.
-Apply not_Zlt; Trivial.
-Qed.
-
-Lemma Zlt_square_simpl: (x,y:Z) `0<=x` -> `0<=y` -> `y*y<x*x` -> `y<x`.
-Proof.
-Intros x y H0 H1 H2.
-Apply Zgt_lt.
-Apply Zgt_square_simpl; Try Apply Zle_ge; Try Apply Zlt_gt; Assumption.
-Qed.
-
-(** Equivalence between inequalities *)
-
-Lemma Zle_plus_swap : (x,y,z:Z) `x+z<=y` <-> `x<=y-z`.
-Proof.
-    Intros x y z; Intros. Split. Intro. Rewrite <- (Zero_right x). Rewrite <- (Zplus_inverse_r z).
-    Rewrite Zplus_assoc_l. Exact (Zle_reg_r ? ? ? H).
-    Intro. Rewrite <- (Zero_right y). Rewrite <- (Zplus_inverse_l z). Rewrite Zplus_assoc_l.
-    Apply Zle_reg_r. Assumption.
-Qed.
-
-Lemma Zlt_plus_swap : (x,y,z:Z) `x+z<y` <-> `x<y-z`.
-Proof.
-    Intros x y z; Intros. Split. Intro. Unfold Zminus. Rewrite Zplus_sym. Rewrite <- (Zero_left x).
-    Rewrite <- (Zplus_inverse_l z). Rewrite Zplus_assoc_r. Apply Zlt_reg_l. Rewrite Zplus_sym.
-    Assumption.
-    Intro. Rewrite Zplus_sym. Rewrite <- (Zero_left y). Rewrite <- (Zplus_inverse_r z).
-    Rewrite Zplus_assoc_r. Apply Zlt_reg_l. Rewrite Zplus_sym. Assumption.
-Qed.
-
-Lemma Zeq_plus_swap : (x,y,z:Z)`x+z=y` <-> `x=y-z`.
-Proof.
-Intros x y z; Intros. Split. Intro. Apply Zplus_minus. Symmetry. Rewrite Zplus_sym. 
-  Assumption.
-Intro. Rewrite H. Unfold Zminus. Rewrite Zplus_assoc_r. 
-  Rewrite Zplus_inverse_l. Apply Zero_right.
-Qed.
-
-Lemma Zlt_minus : (n,m:Z)`0<m`->`n-m<n`.
-Proof.
-Intros n m H; Apply Zsimpl_lt_plus_l with p:=m; Rewrite Zle_plus_minus;
-Pattern 1 n ;Rewrite <- (Zero_right n); Rewrite (Zplus_sym m n);
-Apply Zlt_reg_l; Assumption.
-Qed.
-
-Lemma Zlt_O_minus_lt : (n,m:Z)`0<n-m`->`m<n`.
-Proof.
-Intros n m H; Apply Zsimpl_lt_plus_l with p:=(Zopp m); Rewrite Zplus_inverse_l;
-Rewrite Zplus_sym;Exact H.
-Qed.
diff --git a/theories7/ZArith/Zpower.v b/theories7/ZArith/Zpower.v
deleted file mode 100644
index 97c2b3c9..00000000
--- a/theories7/ZArith/Zpower.v
+++ /dev/null
@@ -1,394 +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: Zpower.v,v 1.2.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
-
-Require ZArith_base.
-Require Omega.
-Require Zcomplements.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-Section section1.
-
-(** [Zpower_nat z n] is the n-th power of [z] when [n] is an unary
-    integer (type [nat]) and [z] a signed integer (type [Z]) *) 
-
-Definition Zpower_nat := 
-  [z:Z][n:nat] (iter_nat n Z ([x:Z]` z * x `) `1`).
-
-(** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for
-    [plus : nat->nat] and [Zmult : Z->Z] *)
-
-Lemma Zpower_nat_is_exp : 
-  (n,m:nat)(z:Z)
-  `(Zpower_nat z (plus n m)) = (Zpower_nat z n)*(Zpower_nat z m)`.
-
-Intros; Elim n; 
-[ Simpl; Elim (Zpower_nat z m); Auto with zarith
-| Unfold Zpower_nat; Intros;  Simpl; Rewrite H;
-  Apply Zmult_assoc].
-Qed.
-
-(** [Zpower_pos z n] is the n-th power of [z] when [n] is an binary
-    integer (type [positive]) and [z] a signed integer (type [Z]) *) 
-
-Definition Zpower_pos := 
-  [z:Z][n:positive] (iter_pos n Z ([x:Z]`z * x`) `1`).
-
-(** This theorem shows that powers of unary and binary integers
-   are the same thing, modulo the function convert : [positive -> nat] *)
-
-Theorem Zpower_pos_nat : 
-  (z:Z)(p:positive)(Zpower_pos z p) = (Zpower_nat z (convert p)).
-
-Intros; Unfold Zpower_pos; Unfold Zpower_nat; Apply iter_convert.
-Qed.
-
-(** Using the theorem [Zpower_pos_nat] and the lemma [Zpower_nat_is_exp] we
-   deduce that the function [[n:positive](Zpower_pos z n)] is a morphism
-   for [add : positive->positive] and [Zmult : Z->Z] *)
-
-Theorem Zpower_pos_is_exp : 
-  (n,m:positive)(z:Z) 
-  ` (Zpower_pos z (add n m)) = (Zpower_pos z n)*(Zpower_pos z m)`.
-
-Intros.
-Rewrite -> (Zpower_pos_nat z n).
-Rewrite -> (Zpower_pos_nat z m).
-Rewrite -> (Zpower_pos_nat z (add n m)).
-Rewrite -> (convert_add n m).
-Apply Zpower_nat_is_exp.
-Qed.
-
-Definition Zpower :=
-  [x,y:Z]Cases y of
-    (POS p) => (Zpower_pos x p)
-  | ZERO => `1`
-  | (NEG p) => `0`
-  end.
-
-V8Infix "^" Zpower : Z_scope.
-
-Hints Immediate Zpower_nat_is_exp : zarith.
-Hints Immediate Zpower_pos_is_exp : zarith.
-Hints Unfold  Zpower_pos : zarith.
-Hints Unfold  Zpower_nat : zarith.
-
-Lemma Zpower_exp : (x:Z)(n,m:Z)
-  `n >= 0` -> `m >= 0` -> `(Zpower x (n+m))=(Zpower x n)*(Zpower x m)`.
-NewDestruct n; NewDestruct m; Auto with zarith.
-Simpl; Intros; Apply Zred_factor0.
-Simpl; Auto with zarith.
-Intros; Compute in H0; Absurd INFERIEUR=INFERIEUR; Auto with zarith.
-Intros; Compute in H0; Absurd INFERIEUR=INFERIEUR; Auto with zarith.
-Qed.
-
-End section1.
-
-(* Exporting notation "^" *)
-
-V8Infix "^" Zpower : Z_scope.
-
-Hints Immediate Zpower_nat_is_exp : zarith.
-Hints Immediate Zpower_pos_is_exp : zarith.
-Hints Unfold  Zpower_pos : zarith.
-Hints Unfold  Zpower_nat : zarith.
-
-Section Powers_of_2.
-
-(** For the powers of two, that will be widely used, a more direct
-   calculus is possible. We will also prove some properties such
-   as [(x:positive) x < 2^x] that are true for all integers bigger
-   than 2 but more difficult to prove and useless. *)     
-
-(** [shift n m] computes [2^n * m], or [m] shifted by [n] positions *)
-
-Definition shift_nat := 
-  [n:nat][z:positive](iter_nat n positive xO z). 
-Definition shift_pos :=
-  [n:positive][z:positive](iter_pos n positive xO z). 
-Definition shift :=
-  [n:Z][z:positive]
-  Cases n of
-    ZERO => z
-  | (POS p) => (iter_pos p positive xO z)
-  | (NEG p) => z
-  end.
-
-Definition two_power_nat := [n:nat] (POS (shift_nat n xH)).
-Definition two_power_pos := [x:positive] (POS (shift_pos x xH)).
-
-Lemma two_power_nat_S : 
-  (n:nat)` (two_power_nat (S n)) = 2*(two_power_nat n)`.
-Intro; Simpl; Apply refl_equal.
-Qed.
-
-Lemma shift_nat_plus :
-  (n,m:nat)(x:positive)
-    (shift_nat (plus n m) x)=(shift_nat n (shift_nat m x)).
-
-Intros; Unfold shift_nat; Apply iter_nat_plus.
-Qed.
-
-Theorem shift_nat_correct :
-  (n:nat)(x:positive)(POS (shift_nat n x))=`(Zpower_nat 2 n)*(POS x)`.
-
-Unfold shift_nat; Induction n; 
-[ Simpl; Trivial with zarith
-| Intros; Replace (Zpower_nat `2` (S n0)) with `2 * (Zpower_nat 2 n0)`;
-[ Rewrite <- Zmult_assoc; Rewrite <- (H x); Simpl; Reflexivity
-| Auto with zarith ]
-].
-Qed.
-
-Theorem two_power_nat_correct :
-  (n:nat)(two_power_nat n)=(Zpower_nat `2` n).
-
-Intro n.
-Unfold two_power_nat.
-Rewrite -> (shift_nat_correct n).
-Omega.
-Qed.
-  
-(** Second we show that [two_power_pos] and [two_power_nat] are the same *)
-Lemma shift_pos_nat : (p:positive)(x:positive)
-  (shift_pos p x)=(shift_nat (convert p) x).
-
-Unfold shift_pos.
-Unfold shift_nat.
-Intros; Apply iter_convert.
-Qed.
-
-Lemma two_power_pos_nat : 
-  (p:positive) (two_power_pos p)=(two_power_nat (convert p)).
-
-Intro; Unfold two_power_pos; Unfold two_power_nat.
-Apply f_equal with f:=POS.
-Apply shift_pos_nat.
-Qed.
-
-(** Then we deduce that [two_power_pos] is also correct *)
-
-Theorem shift_pos_correct :
-  (p,x:positive) ` (POS (shift_pos p x)) = (Zpower_pos 2 p) * (POS x)`.
-
-Intros.
-Rewrite -> (shift_pos_nat p x).
-Rewrite -> (Zpower_pos_nat `2` p).
-Apply shift_nat_correct.
-Qed.
-
-Theorem two_power_pos_correct : 
-  (x:positive) (two_power_pos x)=(Zpower_pos `2` x).
-
-Intro.
-Rewrite -> two_power_pos_nat.
-Rewrite -> Zpower_pos_nat.
-Apply two_power_nat_correct.
-Qed.
-
-(** Some consequences *)
-
-Theorem two_power_pos_is_exp :
-  (x,y:positive) (two_power_pos (add x y))
-    =(Zmult (two_power_pos x) (two_power_pos y)).
-Intros.
-Rewrite -> (two_power_pos_correct (add x y)).
-Rewrite -> (two_power_pos_correct x).
-Rewrite -> (two_power_pos_correct y).
-Apply Zpower_pos_is_exp.
-Qed.
-
-(** The exponentiation [z -> 2^z] for [z] a signed integer. 
-    For convenience, we assume that [2^z = 0] for all [z < 0]
-    We could also define a inductive type [Log_result] with
-    3 contructors [ Zero | Pos positive -> | minus_infty]
-    but it's more complexe and not so useful. *)
- 
-Definition two_p :=
-  [x:Z]Cases x of
-         ZERO    => `1`
-       | (POS y) => (two_power_pos y)
-       | (NEG y) => `0`
-       end.
-
-Theorem two_p_is_exp :
-  (x,y:Z) ` 0 <= x` -> ` 0 <= y` -> 
-    ` (two_p (x+y)) = (two_p x)*(two_p y)`.
-Induction x; 
-[ Induction y; Simpl; Auto with zarith
-| Induction y; 
-  [ Unfold two_p;  Rewrite -> (Zmult_sym (two_power_pos p) `1`);
-    Rewrite -> (Zmult_one (two_power_pos p)); Auto with zarith
-  | Unfold Zplus; Unfold two_p;
-    Intros; Apply two_power_pos_is_exp
-  | Intros; Unfold Zle in H0; Unfold Zcompare in H0; 
-    Absurd SUPERIEUR=SUPERIEUR; Trivial with zarith
-  ]
-| Induction y; 
-  [ Simpl; Auto with zarith
-  | Intros; Unfold Zle in H; Unfold Zcompare in H;
-    Absurd (SUPERIEUR=SUPERIEUR); Trivial with zarith
-  | Intros; Unfold Zle in H; Unfold Zcompare in H;
-    Absurd (SUPERIEUR=SUPERIEUR); Trivial with zarith
-  ]
-].
-Qed.
-
-Lemma two_p_gt_ZERO : (x:Z) ` 0 <= x` -> ` (two_p x) > 0`.
-Induction x; Intros;
-[ Simpl; Omega
-| Simpl; Unfold two_power_pos; Apply POS_gt_ZERO
-| Absurd ` 0 <= (NEG p)`;
-  [ Simpl; Unfold Zle; Unfold Zcompare;
-    Do 2 Unfold not; Auto with zarith
-  | Assumption ]
-].
-Qed.
-
-Lemma two_p_S : (x:Z) ` 0 <= x` -> 
- `(two_p (Zs x)) = 2 * (two_p x)`.
-Intros; Unfold Zs. 
-Rewrite (two_p_is_exp x `1` H (ZERO_le_POS xH)).
-Apply Zmult_sym.
-Qed.
-
-Lemma two_p_pred : 
-  (x:Z)` 0 <= x` -> ` (two_p (Zpred x)) < (two_p x)`.
-Intros; Apply natlike_ind 
-with P:=[x:Z]` (two_p (Zpred x)) < (two_p x)`;
-[ Simpl; Unfold Zlt; Auto with zarith
-| Intros; Elim (Zle_lt_or_eq `0` x0 H0);
-  [ Intros;
-    Replace (two_p (Zpred (Zs x0)))
-    with (two_p (Zs (Zpred x0)));
-    [ Rewrite -> (two_p_S (Zpred x0));
-      [ Rewrite -> (two_p_S x0);
-      	[ Omega
-      	| Assumption]
-      | Apply Zlt_ZERO_pred_le_ZERO; Assumption]
-    | Rewrite <- (Zs_pred x0); Rewrite <- (Zpred_Sn x0); Trivial with zarith]
-  | Intro Hx0; Rewrite <- Hx0; Simpl; Unfold Zlt; Auto with zarith]
-| Assumption].
-Qed. 
-
-Lemma Zlt_lt_double : (x,y:Z) ` 0 <= x < y` -> ` x < 2*y`.
-Intros; Omega. Qed. 
-
-End Powers_of_2.
-
-Hints Resolve two_p_gt_ZERO : zarith.
-Hints Immediate two_p_pred two_p_S : zarith.
-
-Section power_div_with_rest.
-
-(** Division by a power of two.
-    To [n:Z] and [p:positive], [q],[r] are associated such that
-    [n = 2^p.q + r] and [0 <= r < 2^p] *)
-
-(** Invariant: [d*q + r = d'*q + r /\ d' = 2*d /\ 0<= r < d /\ 0 <= r' < d'] *)
-Definition Zdiv_rest_aux :=
-  [qrd:(Z*Z)*Z] 
-  let (qr,d)=qrd in let (q,r)=qr in
-  (Cases q of
-     ZERO => ` (0, r)`
-   | (POS xH) => ` (0, d + r)`
-   | (POS (xI n)) => ` ((POS n), d + r)`
-   | (POS (xO n)) => ` ((POS n), r)`
-   | (NEG xH) => ` (-1, d + r)`
-   | (NEG (xI n)) => ` ((NEG n) - 1, d + r)`
-   | (NEG (xO n)) => ` ((NEG n), r)`
-   end, ` 2*d`).
-
-Definition Zdiv_rest := 
-  [x:Z][p:positive]let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in qr.
-
-Lemma Zdiv_rest_correct1 :
-  (x:Z)(p:positive)
-  let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in d=(two_power_pos p).
-
-Intros x p; 
-Rewrite (iter_convert p ? Zdiv_rest_aux ((x,`0`),`1`));
-Rewrite (two_power_pos_nat p);
-Elim (convert p); Simpl;
-[ Trivial with zarith
-| Intro n; Rewrite (two_power_nat_S n);
-  Unfold 2 Zdiv_rest_aux;
-  Elim (iter_nat n (Z*Z)*Z Zdiv_rest_aux ((x,`0`),`1`));
-  NewDestruct a; Intros; Apply f_equal with f:=[z:Z]`2*z`; Assumption ]. 
-Qed.
-
-Lemma Zdiv_rest_correct2 :
-  (x:Z)(p:positive)
-  let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in
-  let (q,r)=qr in
-  ` x=q*d + r` /\ ` 0 <= r < d`.
-
-Intros; Apply iter_pos_invariant with
-  f:=Zdiv_rest_aux
-  Inv:=[qrd:(Z*Z)*Z]let (qr,d)=qrd in let (q,r)=qr in
-                      ` x=q*d + r` /\ ` 0 <= r < d`;
-[ Intro x0; Elim x0; Intro y0; Elim y0;
-  Intros q r d; Unfold Zdiv_rest_aux; 
-  Elim q;
-  [ Omega
-  | NewDestruct p0; 
-    [ Rewrite POS_xI; Intro; Elim H; Intros; Split; 
-      [ Rewrite H0; Rewrite Zplus_assoc;
-      	Rewrite Zmult_plus_distr_l;
-      	Rewrite Zmult_1_n; Rewrite Zmult_assoc;
-      	Rewrite (Zmult_sym (POS p0) `2`); Apply refl_equal
-      | Omega ]
-    | Rewrite POS_xO; Intro; Elim H; Intros; Split;
-      [ Rewrite H0;
-      	Rewrite Zmult_assoc; Rewrite (Zmult_sym (POS p0) `2`);
-      	Apply refl_equal  
-      | Omega ]
-    | Omega ]
-  | NewDestruct p0; 
-    [ Rewrite NEG_xI; Unfold Zminus; Intro; Elim H; Intros; Split; 
-      [ Rewrite H0; Rewrite Zplus_assoc;
-      	Apply f_equal with f:=[z:Z]`z+r`;
-      	Do 2 (Rewrite Zmult_plus_distr_l);
-       	Rewrite Zmult_assoc; 
-      	Rewrite (Zmult_sym (NEG p0) `2`);
-      	Rewrite <- Zplus_assoc;
-	Apply f_equal with f:=[z:Z]`2 * (NEG p0) * d + z`; 
-      	Omega
-      | Omega ]
-    | Rewrite NEG_xO; Unfold Zminus; Intro; Elim H; Intros; Split;
-      [ Rewrite H0;
-      	Rewrite Zmult_assoc; Rewrite (Zmult_sym (NEG p0) `2`);
-      	Apply refl_equal  
-      | Omega ]
-    | Omega ] ]
-| Omega].
-Qed.
-
-Inductive Set Zdiv_rest_proofs[x:Z; p:positive] :=
-  Zdiv_rest_proof : (q:Z)(r:Z) 
-     `x = q * (two_power_pos p) + r` 
-       -> `0 <= r`
-        -> `r < (two_power_pos p)` 
-      	 -> (Zdiv_rest_proofs x p).
-
-Lemma  Zdiv_rest_correct :
-  (x:Z)(p:positive)(Zdiv_rest_proofs x p).
-Intros x p.
-Generalize (Zdiv_rest_correct1 x p); Generalize (Zdiv_rest_correct2 x p).
-Elim  (iter_pos p (Z*Z)*Z Zdiv_rest_aux ((x,`0`),`1`)).
-Induction a.
-Intros.
-Elim H; Intros H1 H2; Clear H.
-Rewrite -> H0 in H1; Rewrite -> H0 in H2;
-Elim H2; Intros;
-Apply Zdiv_rest_proof with q:=a0 r:=b; Assumption.
-Qed.
-
-End power_div_with_rest.
diff --git a/theories7/ZArith/Zsqrt.v b/theories7/ZArith/Zsqrt.v
deleted file mode 100644
index 72a2e9cf..00000000
--- a/theories7/ZArith/Zsqrt.v
+++ /dev/null
@@ -1,136 +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        *)
-(************************************************************************)
-
-(* $Id: Zsqrt.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ *)
-
-Require Omega.
-Require Export ZArith_base.
-Require Export ZArithRing.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-(**********************************************************************)
-(** Definition and properties of square root on Z *)
-
-(** The following tactic replaces all instances of (POS (xI ...)) by
-    `2*(POS ...)+1` , but only when ... is not made only with xO, XI, or xH. *)
-Tactic Definition compute_POS :=
-  Match Context With
-  | [|- [(POS (xI ?1))]] ->
-    (Match ?1 With
-     | [[xH]] -> Fail
-     | _ -> Rewrite (POS_xI ?1))
-  | [|- [(POS (xO ?1))]] ->
-    (Match ?1 With
-     | [[xH]] -> Fail
-     | _ -> Rewrite (POS_xO ?1)).
-
-Inductive sqrt_data [n : Z] : Set :=
-  c_sqrt: (s, r :Z)`n=s*s+r`->`0<=r<=2*s`->(sqrt_data n) .
-
-Definition sqrtrempos: (p : positive)  (sqrt_data (POS p)).
-Refine (Fix sqrtrempos {
-         sqrtrempos [p : positive] : (sqrt_data (POS p)) :=
-            <[p : ?]  (sqrt_data (POS p))> Cases p of
-                xH => (c_sqrt `1` `1` `0` ? ?)
-               | (xO xH) => (c_sqrt `2` `1` `1` ? ?)
-               | (xI xH) => (c_sqrt `3` `1` `2` ? ?)
-               | (xO (xO p')) =>
-                   Cases (sqrtrempos p') of
-                     (c_sqrt s' r' Heq Hint) =>
-                       Cases (Z_le_gt_dec `4*s'+1` `4*r'`) of
-                         (left Hle) =>
-                           (c_sqrt (POS (xO (xO p'))) `2*s'+1` `4*r'-(4*s'+1)` ? ?)
-                        | (right Hgt) =>
-                            (c_sqrt (POS (xO (xO p'))) `2*s'` `4*r'` ? ?)
-                       end
-                   end
-               | (xO (xI p')) =>
-                   Cases (sqrtrempos p') of
-                     (c_sqrt s' r' Heq Hint) =>
-                       Cases
-                        (Z_le_gt_dec `4*s'+1` `4*r'+2`) of
-                         (left Hle) =>
-                           (c_sqrt 
-			     (POS (xO (xI p'))) `2*s'+1` `4*r'+2-(4*s'+1)` ? ?)
-                        | (right Hgt) =>
-                            (c_sqrt (POS (xO (xI p'))) `2*s'` `4*r'+2` ? ?)
-                       end
-                   end
-               | (xI (xO p')) =>
-                   Cases (sqrtrempos p') of
-                     (c_sqrt s' r' Heq Hint) =>
-                       Cases
-                        (Z_le_gt_dec `4*s'+1` `4*r'+1`) of
-                         (left Hle) =>
-                           (c_sqrt
-                            (POS (xI (xO p'))) `2*s'+1` `4*r'+1-(4*s'+1)` ? ?)
-                        | (right Hgt) =>
-                            (c_sqrt (POS (xI (xO p'))) `2*s'` `4*r'+1` ? ?)
-                       end
-                   end
-               | (xI (xI p')) =>
-                   Cases (sqrtrempos p') of
-                     (c_sqrt s' r' Heq Hint) =>
-                       Cases
-                        (Z_le_gt_dec `4*s'+1` `4*r'+3`) of
-                         (left Hle) =>
-                           (c_sqrt
-                            (POS (xI (xI p'))) `2*s'+1` `4*r'+3-(4*s'+1)` ? ?)
-                        | (right Hgt) =>
-                            (c_sqrt (POS (xI (xI p'))) `2*s'` `4*r'+3` ? ?)
-                       end
-                   end
-            end
-        }); Clear sqrtrempos; Repeat compute_POS;
- Try (Try Rewrite Heq; Ring; Fail); Try Omega.
-Defined.
-
-(** Define with integer input, but with a strong (readable) specification. *)
-Definition Zsqrt : (x:Z)`0<=x`->{s:Z & {r:Z | x=`s*s+r` /\ `s*s<=x<(s+1)*(s+1)`}}.
-Refine [x]
-   <[x:Z]`0<=x`->{s:Z & {r:Z | x=`s*s+r` /\ `s*s<=x<(s+1)*(s+1)`}}>Cases x of
-       (POS p) => [h]Cases (sqrtrempos p) of
-                    (c_sqrt s r Heq Hint) =>
-                  (existS ? [s:Z]{r:Z | `(POS p)=s*s+r` /\ 
-		                         `s*s<=(POS p)<(s+1)*(s+1)`}
-		   s
-                    (exist Z [r:Z]((POS p)=`s*s+r` /\ `s*s<=(POS p)<(s+1)*(s+1)`)
-                       r ?))
-                  end
-     | (NEG p) => [h](False_rec 
-		         {s:Z & {r:Z |
-			     (NEG p)=`s*s+r` /\ `s*s<=(NEG p)<(s+1)*(s+1)`}}
-                         (h (refl_equal ? SUPERIEUR)))
-     | ZERO => [h](existS ? [s:Z]{r:Z | `0=s*s+r` /\ `s*s<=0<(s+1)*(s+1)`}
-		     `0` (exist Z [r:Z](`0=0*0+r`/\`0*0<=0<(0+1)*(0+1)`)
-		     `0` ?))
-     end;Try Omega.
-Split;[Omega|Rewrite Heq;Ring `(s+1)*(s+1)`;Omega].
-Defined.
-
-(** Define a function of type Z->Z that computes the integer square root,
-    but only for positive numbers, and 0 for others. *)
-Definition Zsqrt_plain : Z->Z :=
-  [x]Cases x of
-    (POS p)=>Cases (Zsqrt (POS p) (ZERO_le_POS p)) of (existS s _) => s end
-   |(NEG p)=>`0`
-   |ZERO=>`0`
-   end.
-
-(** A basic theorem about Zsqrt_plain *)
-Theorem Zsqrt_interval :(x:Z)`0<=x`->
-  `(Zsqrt_plain x)*(Zsqrt_plain x)<= x < ((Zsqrt_plain x)+1)*((Zsqrt_plain x)+1)`.
-Intros x;Case x.
-Unfold Zsqrt_plain;Omega.
-Intros p;Unfold Zsqrt_plain;Case (Zsqrt (POS p) (ZERO_le_POS p)).
-Intros s (r,(Heq,Hint)) Hle;Assumption.
-Intros p Hle;Elim Hle;Auto.
-Qed.
-
-
diff --git a/theories7/ZArith/Zsyntax.v b/theories7/ZArith/Zsyntax.v
deleted file mode 100644
index 3c7f3a57..00000000
--- a/theories7/ZArith/Zsyntax.v
+++ /dev/null
@@ -1,278 +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: Zsyntax.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
-
-Require Export BinInt.
-
-V7only[
-
-Grammar znatural ident :=
-  nat_id [ prim:var($id) ] -> [$id]
-
-with number :=
-
-with negnumber := 
-
-with formula : constr :=
-  form_expr [ expr($p) ] -> [$p]
-(*| form_eq [ expr($p) "=" expr($c) ] -> [ (eq Z $p $c) ]*)
-| form_eq [ expr($p) "=" expr($c) ] -> [ (Coq.Init.Logic.eq ? $p $c) ]
-| form_le [ expr($p) "<=" expr($c) ] -> [ (Zle $p $c) ]
-| form_lt [ expr($p) "<" expr($c) ] -> [ (Zlt $p $c) ]
-| form_ge [ expr($p) ">=" expr($c) ] -> [ (Zge $p $c) ]
-| form_gt [ expr($p) ">" expr($c) ] -> [ (Zgt $p $c) ]
-(*| form_eq_eq [ expr($p) "=" expr($c) "=" expr($c1) ]
-              -> [ (eq Z $p $c)/\(eq Z $c $c1) ]*)
-| form_eq_eq [ expr($p) "=" expr($c) "=" expr($c1) ]
-              -> [ (Coq.Init.Logic.eq ? $p $c)/\(Coq.Init.Logic.eq ? $c $c1) ]
-| form_le_le [ expr($p) "<=" expr($c) "<=" expr($c1) ]
-              -> [ (Zle $p $c)/\(Zle $c $c1) ]
-| form_le_lt [ expr($p) "<=" expr($c) "<" expr($c1) ]
-              -> [ (Zle $p $c)/\(Zlt $c $c1) ]
-| form_lt_le [ expr($p) "<" expr($c) "<=" expr($c1) ]
-              -> [ (Zlt $p $c)/\(Zle $c $c1) ]
-| form_lt_lt [ expr($p) "<" expr($c) "<" expr($c1) ]
-              -> [ (Zlt $p $c)/\(Zlt $c $c1) ]
-(*| form_neq  [ expr($p) "<>" expr($c) ] -> [  ~(Coq.Init.Logic.eq Z $p $c) ]*)
-| form_neq  [ expr($p) "<>" expr($c) ] -> [  ~(Coq.Init.Logic.eq ? $p $c) ]
-| form_comp [ expr($p) "?=" expr($c) ] -> [ (Zcompare $p $c) ]
-
-with expr : constr :=
-  expr_plus [ expr($p) "+" expr($c) ] -> [ (Zplus $p $c) ]
-| expr_minus [ expr($p) "-" expr($c) ] -> [ (Zminus $p $c) ]
-| expr2 [ expr2($e) ] -> [$e]
-
-with expr2 : constr :=
-  expr_mult [ expr2($p) "*" expr2($c) ] -> [ (Zmult $p $c) ]
-| expr1 [ expr1($e) ] -> [$e]
-
-with expr1 : constr :=
-  expr_abs [ "|" expr($c) "|" ] -> [ (Zabs $c) ]
-| expr0 [ expr0($e) ] -> [$e]
-
-with expr0 : constr :=
-  expr_id [ constr:global($c) ] -> [ $c ]
-| expr_com [ "[" constr:constr($c) "]" ] -> [$c]
-| expr_appl [ "(" application($a) ")" ] -> [$a]
-| expr_num [ number($s) ] -> [$s ]
-| expr_negnum [ "-" negnumber($n) ] -> [ $n ]
-| expr_inv [ "-" expr0($c) ] -> [ (Zopp $c) ] 
-| expr_meta [ zmeta($m) ] -> [ $m ]
-
-with zmeta :=
-| rimpl [ "?" ] -> [ ? ]
-| rmeta0 [ "?" "0" ] -> [ ?0 ]
-| rmeta1 [ "?" "1" ] -> [ ?1 ]
-| rmeta2 [ "?" "2" ] -> [ ?2 ]
-| rmeta3 [ "?" "3" ] -> [ ?3 ]
-| rmeta4 [ "?" "4" ] -> [ ?4 ]
-| rmeta5 [ "?" "5" ] -> [ ?5 ]
-
-with application : constr :=
-  apply [ application($p) expr($c1) ] -> [ ($p $c1) ]
-| apply_inject_nat [ "inject_nat" constr:constr($c1) ] -> [ (inject_nat $c1) ]
-| pair [ expr($p) "," expr($c) ] -> [ ($p, $c) ]
-| appl0 [ expr($a) ] -> [$a]
-.
-
-Grammar constr constr0 :=
-  z_in_com [ "`" znatural:formula($c) "`" ] -> [$c].
-
-Grammar constr pattern :=
-  z_in_pattern [ "`" prim:bigint($c) "`" ] -> [ 'Z: $c ' ].   
-
-(* The symbols "`" "`" must be printed just once at the top of the expressions,
-  to avoid printings like |``x` + `y`` < `45`| 
-  for |x + y < 45|.
-  So when a Z-expression is to be printed, its sub-expresssions are
-  enclosed into an ast (ZEXPR \$subexpr), which is printed like \$subexpr
-  but without symbols "`" "`" around. 
-
-  There is just one problem: NEG and Zopp have the same printing rules.
-  If Zopp is opaque, we may not be able to solve a goal like
-  ` -5 = -5 ` by reflexivity. (In fact, this precise Goal is solved
-  by the Reflexivity tactic, but more complex problems may arise 
-
-  SOLUTION : Print (Zopp 5) for constants and -x for variables *)
-
-Syntax constr
-  level 0:
-    Zle [ (Zle $n1 $n2) ] -> 
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2) "`"]]
-  | Zlt [ (Zlt $n1 $n2) ] -> 
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2) "`" ]]
-  | Zge [ (Zge $n1 $n2) ] -> 
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] ">= " (ZEXPR $n2) "`" ]]
-  | Zgt [ (Zgt $n1 $n2) ] -> 
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "> " (ZEXPR $n2) "`" ]]
-  | Zcompare [<<(Zcompare $n1 $n2)>>] ->
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "?= " (ZEXPR $n2) "`" ]]
-  | Zeq [ (eq Z $n1 $n2) ] -> 
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "= " (ZEXPR $n2)"`"]]
-  | Zneq [ ~(eq Z $n1 $n2) ] ->
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "<> " (ZEXPR $n2) "`"]]
-  | Zle_Zle [ (Zle $n1 $n2)/\(Zle $n2 $n3) ] ->
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2)
-                                [1 0] "<= " (ZEXPR $n3) "`"]]
-  | Zle_Zlt [ (Zle $n1 $n2)/\(Zlt $n2 $n3) ] ->
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2)
-                                [1 0] "< " (ZEXPR $n3) "`"]]
-  | Zlt_Zle [ (Zlt $n1 $n2)/\(Zle $n2 $n3) ] ->
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2)
-                                [1 0] "<= " (ZEXPR $n3) "`"]]
-  | Zlt_Zlt [ (Zlt $n1 $n2)/\(Zlt $n2 $n3) ] ->
-      [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2)
-                                [1 0] "< " (ZEXPR $n3) "`"]]
-  | ZZero_v7 [ ZERO ] -> [ "`0`" ]
-  | ZPos_v7 [ (POS $r) ] -> [$r:"positive_printer":9]
-  | ZNeg_v7 [ (NEG $r) ] -> [$r:"negative_printer":9]
-  ;
-
-  level 7:
-    Zplus [ (Zplus $n1 $n2) ]
-      -> [ [<hov 0> "`" (ZEXPR $n1):E "+"  [0 0] (ZEXPR $n2):L "`"] ]
-  | Zminus [ (Zminus $n1 $n2) ]
-      -> [ [<hov 0> "`" (ZEXPR $n1):E "-" [0 0] (ZEXPR $n2):L "`"] ]
-  ;
-
-  level 6:
-    Zmult [ (Zmult $n1 $n2) ]
-      -> [ [<hov 0> "`" (ZEXPR $n1):E "*" [0 0] (ZEXPR $n2):L "`"] ]
-  ;
-
-  level 8:
-    Zopp [ (Zopp $n1) ] -> [ [<hov 0> "`" "-" (ZEXPR $n1):E "`"] ]
-  | Zopp_POS [ (Zopp (POS $r)) ] -> 
-         [ [<hov 0> "`(" "Zopp" [1 0] $r:"positive_printer_inside"  ")`"] ]
-  | Zopp_ZERO [ (Zopp ZERO) ] -> [ [<hov 0> "`(" "Zopp" [1 0] "0" ")`"] ]
-  | Zopp_NEG [ (Zopp (NEG $r)) ] ->  
-         [ [<hov 0> "`(" "Zopp" [1 0] "(" $r:"negative_printer_inside" "))`"] ]
-  ;
-
-  level 4:
-    Zabs [ (Zabs $n1) ] -> [  [<hov 0> "`|" (ZEXPR $n1):E "|`"] ]
-  ;
-
-  level 0:
-    escape_inside [ << (ZEXPR $r) >> ] -> [ "[" $r:E "]" ]
-  ;
-
-  level 4:
-    Zappl_inside [ << (ZEXPR (APPLIST $h ($LIST $t))) >> ]
-      -> [ [<hov 0> "("(ZEXPR $h):E [1 0] (ZAPPLINSIDETAIL ($LIST $t)):E ")"] ]
-  | Zappl_inject_nat [ << (ZEXPR (APPLIST <<inject_nat>> $n)) >> ]
-      -> [ [<hov 0> "(inject_nat" [1 1] $n:L ")"] ]
-  | Zappl_inside_tail [ << (ZAPPLINSIDETAIL $h ($LIST $t)) >> ]
-      -> [(ZEXPR $h):E [1 0] (ZAPPLINSIDETAIL ($LIST $t)):E] 
-  | Zappl_inside_one [ << (ZAPPLINSIDETAIL $e) >> ] ->[(ZEXPR $e):E]
-  | pair_inside [ << (ZEXPR <<(pair $s1 $s2 $z1 $z2)>>) >> ] 
-      -> [ [<hov 0> "("(ZEXPR $z1):E "," [1 0] (ZEXPR $z2):E ")"] ]
-  ;
-
- level 3:
-    var_inside [ << (ZEXPR ($VAR $i)) >> ] -> [$i]
-  | secvar_inside [ << (ZEXPR (SECVAR $i)) >> ] -> [(SECVAR $i)]
-  | const_inside [ << (ZEXPR (CONST $c)) >> ] -> [(CONST $c)]
-  | mutind_inside [ << (ZEXPR (MUTIND $i $n)) >> ] 
-      -> [(MUTIND $i $n)]
-  | mutconstruct_inside [ << (ZEXPR (MUTCONSTRUCT $c1 $c2 $c3)) >> ]
-      -> [ (MUTCONSTRUCT $c1 $c2 $c3) ]
-
-  | O_inside [ << (ZEXPR << O >>) >> ] -> [ "O" ] (* To shunt Arith printer *)
-
-  (* Added by JCF, 9/3/98; updated HH, 11/9/01 *)
-  | implicit_head_inside [ << (ZEXPR (APPLISTEXPL ($LIST $c))) >> ]
-      -> [ (APPLIST ($LIST $c)) ]
-  | implicit_arg_inside  [ << (ZEXPR (EXPL "!" $n $c)) >> ] -> [ ]
-
-  ;
-
-  level 7:
-    Zplus_inside
-      [ << (ZEXPR <<(Zplus $n1 $n2)>>) >> ]
-      	 -> [ (ZEXPR $n1):E "+" [0 0] (ZEXPR $n2):L ]
-  | Zminus_inside
-      [ << (ZEXPR <<(Zminus $n1 $n2)>>) >> ]
-      	 -> [ (ZEXPR $n1):E "-" [0 0] (ZEXPR $n2):L ]
-  ;
-
-  level 6:
-    Zmult_inside
-      [ << (ZEXPR <<(Zmult $n1 $n2)>>) >> ]
-      	 -> [ (ZEXPR $n1):E "*" [0 0] (ZEXPR $n2):L ]
-  ;
-
-  level 5:
-    Zopp_inside [ << (ZEXPR <<(Zopp $n1)>>) >> ] -> [ "(-" (ZEXPR $n1):E ")" ]
-  ;  
-
-  level 10:
-    Zopp_POS_inside [ << (ZEXPR <<(Zopp (POS $r))>>) >> ] -> 
-      	 [ [<hov 0> "Zopp" [1 0] $r:"positive_printer_inside" ] ]
-  | Zopp_ZERO_inside [ << (ZEXPR <<(Zopp ZERO)>>) >> ] -> 
-      	 [ [<hov 0> "Zopp" [1 0] "0"] ]
-  | Zopp_NEG_inside [ << (ZEXPR <<(Zopp (NEG $r))>>) >> ] ->  
-      	 [ [<hov 0> "Zopp" [1 0] $r:"negative_printer_inside" ] ]
-  ;
-
-  level 4:
-    Zabs_inside [ << (ZEXPR <<(Zabs $n1)>>) >> ] -> [ "|" (ZEXPR $n1) "|"]
-  ;
-
-  level 0:
-    ZZero_inside [ << (ZEXPR <<ZERO>>) >> ] -> ["0"]
-  | ZPos_inside [ << (ZEXPR <<(POS $p)>>) >>] -> 
-      [$p:"positive_printer_inside":9]
-  | ZNeg_inside [ << (ZEXPR <<(NEG $p)>>) >>] ->
-      [$p:"negative_printer_inside":9]
-.
-].
-
-V7only[
-(* For parsing/printing based on scopes *)
-Module Z_scope.
-
-Infix LEFTA 4 "+" Zplus : Z_scope.
-Infix LEFTA 4 "-" Zminus : Z_scope.
-Infix LEFTA 3 "*" Zmult : Z_scope.
-Notation "- x" := (Zopp x) (at level 0): Z_scope V8only.
-Infix NONA 5 "<=" Zle : Z_scope.
-Infix NONA 5 "<"  Zlt : Z_scope.
-Infix NONA 5 ">=" Zge : Z_scope.
-Infix NONA 5 ">"  Zgt  : Z_scope.
-Infix NONA 5 "?=" Zcompare : Z_scope.
-Notation "x <= y <= z" := (Zle x y)/\(Zle y z)
-  (at level 5, y at level 4):Z_scope
-  V8only (at level 70, y at next level).
-Notation "x <= y < z"  := (Zle x y)/\(Zlt y z)
-  (at level 5, y at level 4):Z_scope
-  V8only (at level 70, y at next level).
-Notation  "x < y < z"  := (Zlt x y)/\(Zlt y z)
-  (at level 5, y at level 4):Z_scope
-  V8only (at level 70, y at next level).
-Notation  "x < y <= z" := (Zlt x y)/\(Zle y z)
-  (at level 5, y at level 4):Z_scope
-  V8only (at level 70, y at next level).
-Notation  "x = y = z" := x=y/\y=z : Z_scope
-  V8only (at level 70, y at next level).
-
-(* Now a polymorphic notation
-Notation "x <> y" := ~(eq Z x y) (at level 5, no associativity) : Z_scope.
-*)
-
-(* Notation "| x |" (Zabs x) : Z_scope.(* "|" conflicts with THENS *)*)
-
-(* Overwrite the printing of "`x = y`" *)
-Syntax constr level 0:
-  Zeq [ (eq Z $n1 $n2) ] -> [[<hov 0> $n1 [1 0] "= " $n2 ]].
-
-Open Scope Z_scope.
-
-End Z_scope.
-].
diff --git a/theories7/ZArith/Zwf.v b/theories7/ZArith/Zwf.v
deleted file mode 100644
index c2e6ca2a..00000000
--- a/theories7/ZArith/Zwf.v
+++ /dev/null
@@ -1,96 +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        *)
-(************************************************************************)
-
-(* $Id: Zwf.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ *)
-
-Require ZArith_base.
-Require Export Wf_nat.
-Require Omega.
-V7only [Import Z_scope.].
-Open Local Scope Z_scope.
-
-(** Well-founded relations on Z. *)
-
-(** We define the following family of relations on [Z x Z]: 
-
-    [x (Zwf c) y]   iff   [x < y & c <= y]
- *)
-
-Definition Zwf := [c:Z][x,y:Z] `c <= y` /\ `x < y`.
-
-(** and we prove that [(Zwf c)] is well founded *)
-
-Section wf_proof.
-
-Variable c : Z.
-
-(** The proof of well-foundness is classic: we do the proof by induction
-    on a measure in nat, which is here [|x-c|] *)
-
-Local f := [z:Z](absolu (Zminus z c)).
-
-Lemma Zwf_well_founded : (well_founded Z (Zwf c)).
-Red; Intros.
-Assert (n:nat)(a:Z)(lt (f a) n)\/(`a<c`) -> (Acc Z (Zwf c) a).
-Clear a; Induction n; Intros.
-(** n= 0 *)
-Case H; Intros.
-Case (lt_n_O (f a)); Auto.
-Apply Acc_intro; Unfold Zwf; Intros.
-Assert False;Omega Orelse Contradiction.
-(** inductive case *)
-Case H0; Clear H0; Intro; Auto.
-Apply Acc_intro; Intros.
-Apply H.
-Unfold Zwf in H1.
-Case (Zle_or_lt c y); Intro; Auto with zarith.
-Left.
-Red in H0.
-Apply lt_le_trans with (f a); Auto with arith.
-Unfold f.
-Apply absolu_lt; Omega.
-Apply (H (S (f a))); Auto.
-Save.
-
-End wf_proof.
-
-Hints Resolve Zwf_well_founded : datatypes v62.
-
-
-(** We also define the other family of relations:
-
-    [x (Zwf_up c) y]   iff   [y < x <= c]
- *)
-
-Definition Zwf_up := [c:Z][x,y:Z] `y < x <= c`.
-
-(** and we prove that [(Zwf_up c)] is well founded *)
-
-Section wf_proof_up.
-
-Variable c : Z.
-
-(** The proof of well-foundness is classic: we do the proof by induction
-    on a measure in nat, which is here [|c-x|] *)
-
-Local f := [z:Z](absolu (Zminus c z)).
-
-Lemma Zwf_up_well_founded : (well_founded Z (Zwf_up c)).
-Proof.
-Apply well_founded_lt_compat with f:=f.
-Unfold Zwf_up f.
-Intros.
-Apply absolu_lt.
-Unfold Zminus. Split.
-Apply Zle_left; Intuition.
-Apply Zlt_reg_l; Unfold Zlt; Rewrite <- Zcompare_Zopp; Intuition.
-Save.
-
-End wf_proof_up.
-
-Hints Resolve Zwf_up_well_founded : datatypes v62.
diff --git a/theories7/ZArith/auxiliary.v b/theories7/ZArith/auxiliary.v
deleted file mode 100644
index 8db2c852..00000000
--- a/theories7/ZArith/auxiliary.v
+++ /dev/null
@@ -1,219 +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: auxiliary.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
-
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
-
-Require Export Arith.
-Require BinInt.
-Require Zorder.
-Require Decidable.
-Require Peano_dec.
-Require Export Compare_dec.
-
-Open Local Scope Z_scope.
-
-(**********************************************************************)
-(** Moving terms from one side to the other of an inequality *)
-
-Theorem Zne_left : (x,y:Z) (Zne x y) -> (Zne (Zplus x (Zopp y)) ZERO).
-Proof.
-Intros x y; Unfold Zne; Unfold not; Intros H1 H2; Apply H1;
-Apply Zsimpl_plus_l with (Zopp y); Rewrite Zplus_inverse_l; Rewrite Zplus_sym;
-Trivial with arith.
-Qed.
-
-Theorem Zegal_left : (x,y:Z) (x=y) -> (Zplus x (Zopp y)) = ZERO.
-Proof.
-Intros x y H;
-Apply (Zsimpl_plus_l y);Rewrite -> Zplus_permute;
-Rewrite -> Zplus_inverse_r;Do 2 Rewrite -> Zero_right;Assumption.
-Qed.
-
-Theorem Zle_left : (x,y:Z) (Zle x y) -> (Zle ZERO (Zplus y (Zopp x))).
-Proof.
-Intros x y H; Replace ZERO with (Zplus x (Zopp x)).
-Apply Zle_reg_r; Trivial.
-Apply Zplus_inverse_r.
-Qed.
-
-Theorem Zle_left_rev : (x,y:Z) (Zle ZERO (Zplus y (Zopp x))) 
-	-> (Zle x y).
-Proof.
-Intros x y H; Apply Zsimpl_le_plus_r with (Zopp x).
-Rewrite Zplus_inverse_r; Trivial.
-Qed.
-
-Theorem Zlt_left_rev : (x,y:Z) (Zlt ZERO (Zplus y (Zopp x))) 
-	-> (Zlt x y).
-Proof.
-Intros x y H; Apply Zsimpl_lt_plus_r with (Zopp x).
-Rewrite Zplus_inverse_r; Trivial.
-Qed.
-
-Theorem Zlt_left :
-  (x,y:Z) (Zlt x y) -> (Zle ZERO (Zplus (Zplus y (NEG xH)) (Zopp x))).
-Proof.
-Intros x y H; Apply Zle_left; Apply Zle_S_n; 
-Change (Zle (Zs x) (Zs (Zpred y))); Rewrite <- Zs_pred; Apply Zlt_le_S;
-Assumption.
-Qed.
-
-Theorem Zlt_left_lt :
-  (x,y:Z) (Zlt x y) -> (Zlt ZERO (Zplus y (Zopp x))).
-Proof.
-Intros x y H; Replace ZERO with (Zplus x (Zopp x)).
-Apply Zlt_reg_r; Trivial.
-Apply Zplus_inverse_r.
-Qed.
-
-Theorem Zge_left : (x,y:Z) (Zge x y) -> (Zle ZERO (Zplus x (Zopp y))).
-Proof.
-Intros x y H; Apply Zle_left; Apply Zge_le; Assumption.
-Qed.
-
-Theorem Zgt_left :
-  (x,y:Z) (Zgt x y) -> (Zle ZERO (Zplus (Zplus x (NEG xH)) (Zopp y))).
-Proof.
-Intros x y H; Apply Zlt_left; Apply Zgt_lt; Assumption.
-Qed.
-
-Theorem Zgt_left_gt :
-  (x,y:Z) (Zgt x y) -> (Zgt (Zplus x (Zopp y)) ZERO).
-Proof.
-Intros x y H; Replace ZERO with (Zplus y (Zopp y)).
-Apply Zgt_reg_r; Trivial.
-Apply Zplus_inverse_r.
-Qed.
-
-Theorem Zgt_left_rev : (x,y:Z) (Zgt (Zplus x (Zopp y)) ZERO) 
-	-> (Zgt x y).
-Proof.
-Intros x y H; Apply Zsimpl_gt_plus_r with (Zopp y).
-Rewrite Zplus_inverse_r; Trivial.
-Qed.
-
-(**********************************************************************)
-(** Factorization lemmas *)
-
-Theorem Zred_factor0 : (x:Z) x = (Zmult x (POS xH)).
-Intro x; Rewrite (Zmult_n_1 x); Reflexivity.
-Qed.
-
-Theorem Zred_factor1 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))).
-Proof.
-Exact Zplus_Zmult_2.
-Qed.
-
-Theorem Zred_factor2 :
-  (x,y:Z) (Zplus x (Zmult x y)) = (Zmult x (Zplus (POS xH) y)).
-
-Intros x y; Pattern 1 x ; Rewrite <- (Zmult_n_1 x);
-Rewrite <- Zmult_plus_distr_r; Trivial with arith.
-Qed.
-
-Theorem Zred_factor3 :
-  (x,y:Z) (Zplus (Zmult x y) x) = (Zmult x (Zplus (POS xH) y)).
-
-Intros x y; Pattern 2 x ; Rewrite <- (Zmult_n_1 x);
-Rewrite <- Zmult_plus_distr_r; Rewrite Zplus_sym; Trivial with arith.
-Qed.
-Theorem Zred_factor4 :
-  (x,y,z:Z) (Zplus (Zmult x y) (Zmult x z)) = (Zmult x (Zplus y z)).
-Intros x y z; Symmetry; Apply Zmult_plus_distr_r.
-Qed.
-
-Theorem Zred_factor5 : (x,y:Z) (Zplus (Zmult x ZERO) y) = y.
-
-Intros x y; Rewrite <- Zmult_n_O;Auto with arith.
-Qed.
-
-Theorem Zred_factor6 : (x:Z) x = (Zplus x ZERO).
-
-Intro; Rewrite Zero_right; Trivial with arith.
-Qed.
-
-Theorem Zle_mult_approx:
-  (x,y,z:Z) (Zgt x ZERO) -> (Zgt z ZERO) -> (Zle ZERO y) -> 
-    (Zle ZERO (Zplus (Zmult y x) z)).
-
-Intros x y z H1 H2 H3; Apply Zle_trans with m:=(Zmult y x) ; [
-  Apply Zle_mult; Assumption
-| Pattern 1 (Zmult y x) ; Rewrite <- Zero_right; Apply Zle_reg_l;
-  Apply Zlt_le_weak; Apply Zgt_lt; Assumption].
-Qed.
-
-Theorem Zmult_le_approx:
-  (x,y,z:Z) (Zgt x ZERO) -> (Zgt x z) -> 
-    (Zle ZERO (Zplus (Zmult y x) z)) -> (Zle ZERO y).
-
-Intros x y z H1 H2 H3; Apply Zlt_n_Sm_le; Apply Zmult_lt with x; [
-  Assumption
-  | Apply Zle_lt_trans with 1:=H3 ; Rewrite <- Zmult_Sm_n;
-    Apply Zlt_reg_l; Apply Zgt_lt; Assumption].
-
-Qed.
-
-V7only [
-(* Compatibility *)
-Require Znat.
-Require Zcompare.
-Notation neq := neq.
-Notation Zne := Zne.
-Notation OMEGA2 := Zle_0_plus.
-Notation add_un_Zs := add_un_Zs.
-Notation inj_S := inj_S.
-Notation Zplus_S_n := Zplus_S_n.
-Notation inj_plus := inj_plus.
-Notation inj_mult := inj_mult.
-Notation inj_neq := inj_neq.
-Notation inj_le := inj_le.
-Notation inj_lt := inj_lt.
-Notation inj_gt := inj_gt.
-Notation inj_ge := inj_ge.
-Notation inj_eq := inj_eq.
-Notation intro_Z := intro_Z.
-Notation inj_minus1 := inj_minus1.
-Notation inj_minus2 := inj_minus2.
-Notation dec_eq := dec_eq.
-Notation dec_Zne := dec_Zne.
-Notation dec_Zle := dec_Zle.
-Notation dec_Zgt := dec_Zgt.
-Notation dec_Zge := dec_Zge.
-Notation dec_Zlt := dec_Zlt.
-Notation dec_eq_nat := dec_eq_nat.
-Notation not_Zge := not_Zge.
-Notation not_Zlt := not_Zlt.
-Notation not_Zle := not_Zle.
-Notation not_Zgt := not_Zgt.
-Notation not_Zeq := not_Zeq.
-Notation Zopp_one := Zopp_one.
-Notation Zopp_Zmult_r := Zopp_Zmult_r.
-Notation Zmult_Zopp_left := Zmult_Zopp_left.
-Notation Zopp_Zmult_l := Zopp_Zmult_l.
-Notation Zcompare_Zplus_compatible2 := Zcompare_Zplus_compatible2.
-Notation Zcompare_Zmult_compatible := Zcompare_Zmult_compatible.
-Notation Zmult_eq := Zmult_eq.
-Notation Z_eq_mult := Z_eq_mult.
-Notation Zmult_le := Zmult_le.
-Notation Zle_ZERO_mult := Zle_ZERO_mult.
-Notation Zgt_ZERO_mult := Zgt_ZERO_mult.
-Notation Zle_mult := Zle_mult.
-Notation Zmult_lt := Zmult_lt.
-Notation Zmult_gt := Zmult_gt.
-Notation Zle_Zmult_pos_right := Zle_Zmult_pos_right.
-Notation Zle_Zmult_pos_left := Zle_Zmult_pos_left.
-Notation Zge_Zmult_pos_right := Zge_Zmult_pos_right.
-Notation Zge_Zmult_pos_left := Zge_Zmult_pos_left.
-Notation Zge_Zmult_pos_compat := Zge_Zmult_pos_compat.
-Notation Zle_mult_simpl := Zle_mult_simpl.
-Notation Zge_mult_simpl := Zge_mult_simpl.
-Notation Zgt_mult_simpl := Zgt_mult_simpl.
-Notation Zgt_square_simpl := Zgt_square_simpl.
-].
diff --git a/theories7/ZArith/fast_integer.v b/theories7/ZArith/fast_integer.v
deleted file mode 100644
index 7e3fe306..00000000
--- a/theories7/ZArith/fast_integer.v
+++ /dev/null
@@ -1,191 +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: fast_integer.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
-
-(***********************************************************)
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
-(***********************************************************)
-
-Require BinPos.
-Require BinNat.
-Require BinInt.
-Require Zcompare.
-Require Mult.
-
-V7only [
-(* Defs and ppties on positive, entier and Z, previously in fast_integer *)
-(* For v7 compatibility *)
-Notation positive := positive.
-Notation xO := xO.
-Notation xI := xI.
-Notation xH := xH.
-Notation add_un := add_un.
-Notation add := add.
-Notation convert := convert.
-Notation convert_add_un := convert_add_un.
-Notation cvt_carry := cvt_carry.
-Notation convert_add := convert_add.
-Notation positive_to_nat := positive_to_nat.
-Notation anti_convert := anti_convert.
-Notation double_moins_un := double_moins_un.
-Notation sub_un := sub_un.
-Notation positive_mask := positive_mask.
-Notation Un_suivi_de_mask := Un_suivi_de_mask.
-Notation Zero_suivi_de_mask := Zero_suivi_de_mask.
-Notation double_moins_deux := double_moins_deux.
-Notation sub_pos := sub_pos.
-Notation true_sub := true_sub.
-Notation times := times.
-Notation relation := relation.
-Notation SUPERIEUR := SUPERIEUR.
-Notation INFERIEUR := INFERIEUR.
-Notation EGAL := EGAL.
-Notation Op := Op.
-Notation compare := compare.
-Notation compare_convert1 := compare_convert1.
-Notation compare_convert_EGAL := compare_convert_EGAL.
-Notation ZLSI := ZLSI.
-Notation ZLIS := ZLIS.
-Notation ZLII := ZLII.
-Notation ZLSS := ZLSS.
-Notation Dcompare := Dcompare.
-Notation convert_compare_EGAL := convert_compare_EGAL.
-Notation ZL0 := ZL0.
-Notation ZL11 := ZL11.
-Notation xI_add_un_xO := xI_add_un_xO.
-Notation is_double_moins_un := is_double_moins_un.
-Notation double_moins_un_add_un_xI := double_moins_un_add_un_xI.
-Notation ZL1 := ZL1.
-Notation add_un_not_un := add_un_not_un.
-Notation sub_add_one := sub_add_one.
-Notation add_sub_one := add_sub_one.
-Notation add_un_inj := add_un_inj.
-Notation ZL12 := ZL12.
-Notation ZL12bis := ZL12bis.
-Notation ZL13 := ZL13.
-Notation add_sym := add_sym.
-Notation ZL14 := ZL14.
-Notation ZL14bis := ZL14bis.
-Notation ZL15 := ZL15.
-Notation add_no_neutral := add_no_neutral.
-Notation add_carry_not_add_un := add_carry_not_add_un.
-Notation add_carry_add := add_carry_add.
-Notation simpl_add_r := simpl_add_r.
-Notation simpl_add_carry_r := simpl_add_carry_r.
-Notation simpl_add_l := simpl_add_l.
-Notation simpl_add_carry_l := simpl_add_carry_l.
-Notation add_assoc := add_assoc.
-Notation add_xI_double_moins_un := add_xI_double_moins_un.
-Notation add_x_x := add_x_x.
-Notation ZS := ZS.
-Notation US := US.
-Notation USH := USH.
-Notation ZSH := ZSH.
-Notation sub_pos_x_x := sub_pos_x_x.
-Notation ZL10 := ZL10.
-Notation sub_pos_SUPERIEUR := sub_pos_SUPERIEUR.
-Notation sub_add := sub_add.
-Notation convert_add_carry := convert_add_carry.
-Notation add_verif := add_verif.
-Notation ZL2 := ZL2.
-Notation ZL6 := ZL6.
-Notation positive_to_nat_mult := positive_to_nat_mult.
-Notation times_convert := times_convert.
-Notation compare_positive_to_nat_O := compare_positive_to_nat_O.
-Notation compare_convert_O := compare_convert_O.
-Notation convert_xH := convert_xH.
-Notation convert_xO := convert_xO.
-Notation convert_xI := convert_xI.
-Notation bij1 := bij1.
-Notation ZL3 := ZL3.
-Notation ZL4 := ZL4.
-Notation ZL5 := ZL5.
-Notation bij2 := bij2.
-Notation bij3 := bij3.
-Notation ZL7 := ZL7.
-Notation ZL8 := ZL8.
-Notation compare_convert_INFERIEUR := compare_convert_INFERIEUR.
-Notation compare_convert_SUPERIEUR := compare_convert_SUPERIEUR.
-Notation convert_compare_INFERIEUR := convert_compare_INFERIEUR.
-Notation convert_compare_SUPERIEUR := convert_compare_SUPERIEUR.
-Notation ZC1 := ZC1.
-Notation ZC2 := ZC2.
-Notation ZC3 := ZC3.
-Notation ZC4 := ZC4.
-Notation true_sub_convert := true_sub_convert.
-Notation convert_intro := convert_intro.
-Notation ZL16 := ZL16.
-Notation ZL17 := ZL17.
-Notation compare_true_sub_right := compare_true_sub_right.
-Notation compare_true_sub_left := compare_true_sub_left.
-Notation times_x_ := times_x_1.
-Notation times_x_double := times_x_double.
-Notation times_x_double_plus_one := times_x_double_plus_one.
-Notation times_sym := times_sym.
-Notation times_add_distr := times_add_distr.
-Notation times_add_distr_l := times_add_distr_l.
-Notation times_assoc := times_assoc.
-Notation times_true_sub_distr := times_true_sub_distr.
-Notation times_discr_xO_xI := times_discr_xO_xI.
-Notation times_discr_xO := times_discr_xO.
-Notation simpl_times_r := simpl_times_r.
-Notation simpl_times_l := simpl_times_l.
-Notation iterate_add := iterate_add.
-Notation entier := entier.
-Notation Nul := Nul.
-Notation Pos := Pos.
-Notation Un_suivi_de := Un_suivi_de.
-Notation Zero_suivi_de := Zero_suivi_de.
-Notation times1 :=
-    [x:positive;_:positive->positive;y:positive](times x y).
-Notation times1_convert :=
-    [x,y:positive;_:positive->positive](times_convert x y).
-
-Notation Z := Z.
-Notation POS := POS.
-Notation NEG := NEG.
-Notation ZERO := ZERO.
-Notation Zero_left := Zero_left.
-Notation Zopp_Zopp := Zopp_Zopp.
-Notation Zero_right := Zero_right.
-Notation Zplus_inverse_r := Zplus_inverse_r.
-Notation Zopp_Zplus := Zopp_Zplus.
-Notation Zplus_sym := Zplus_sym.
-Notation Zplus_inverse_l := Zplus_inverse_l.
-Notation Zopp_intro := Zopp_intro.
-Notation Zopp_NEG := Zopp_NEG.
-Notation weak_assoc := weak_assoc.
-Notation Zplus_assoc := Zplus_assoc.
-Notation Zplus_simpl := Zplus_simpl.
-Notation Zmult_sym := Zmult_sym.
-Notation Zmult_assoc := Zmult_assoc.
-Notation Zmult_one := Zmult_one.
-Notation lt_mult_left := lt_mult_left. (* Mult*)
-Notation Zero_mult_left := Zero_mult_left.
-Notation Zero_mult_right := Zero_mult_right.
-Notation Zopp_Zmult := Zopp_Zmult.
-Notation Zmult_Zopp_Zopp := Zmult_Zopp_Zopp.
-Notation weak_Zmult_plus_distr_r := weak_Zmult_plus_distr_r.
-Notation Zmult_plus_distr_r := Zmult_plus_distr_r.
-Notation Zcompare_EGAL := Zcompare_EGAL.
-Notation Zcompare_ANTISYM := Zcompare_ANTISYM.
-Notation le_minus := le_minus.
-Notation Zcompare_Zopp := Zcompare_Zopp.
-Notation weaken_Zcompare_Zplus_compatible := weaken_Zcompare_Zplus_compatible.
-Notation weak_Zcompare_Zplus_compatible := weak_Zcompare_Zplus_compatible.
-Notation Zcompare_Zplus_compatible := Zcompare_Zplus_compatible.
-Notation Zcompare_trans_SUPERIEUR := Zcompare_trans_SUPERIEUR.
-Notation SUPERIEUR_POS := SUPERIEUR_POS.
-Export Datatypes.
-Export BinPos.
-Export BinNat.
-Export BinInt.
-Export Zcompare.
-Export Mult.
-].
diff --git a/theories7/ZArith/zarith_aux.v b/theories7/ZArith/zarith_aux.v
deleted file mode 100644
index cd67d46b..00000000
--- a/theories7/ZArith/zarith_aux.v
+++ /dev/null
@@ -1,163 +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: zarith_aux.v,v 1.2.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
-
-Require Export BinInt.
-Require Export Zcompare.
-Require Export Zorder.
-Require Export Zmin.
-Require Export Zabs.
-
-V7only [
-Notation Zlt := Zlt.
-Notation Zgt := Zgt.
-Notation Zle := Zle.
-Notation Zge := Zge.
-Notation Zsgn := Zsgn.
-Notation absolu := absolu.
-Notation Zabs := Zabs.
-Notation Zabs_eq := Zabs_eq.
-Notation Zabs_non_eq := Zabs_non_eq.
-Notation Zabs_dec := Zabs_dec.
-Notation Zabs_pos := Zabs_pos.
-Notation Zsgn_Zabs := Zsgn_Zabs.
-Notation Zabs_Zsgn := Zabs_Zsgn.
-Notation inject_nat := inject_nat.
-Notation Zs := Zs.
-Notation Zpred := Zpred.
-Notation Zgt_Sn_n := Zgt_Sn_n.
-Notation Zle_gt_trans := Zle_gt_trans.
-Notation Zgt_le_trans := Zgt_le_trans.
-Notation Zle_S_gt := Zle_S_gt.
-Notation Zcompare_n_S := Zcompare_n_S.
-Notation Zgt_n_S := Zgt_n_S.
-Notation Zle_not_gt := Zle_not_gt.
-Notation Zgt_antirefl := Zgt_antirefl.
-Notation Zgt_not_sym := Zgt_not_sym.
-Notation Zgt_not_le := Zgt_not_le.
-Notation Zgt_trans := Zgt_trans.
-Notation Zle_gt_S := Zle_gt_S.
-Notation Zgt_pred := Zgt_pred.       
-Notation Zsimpl_gt_plus_l := Zsimpl_gt_plus_l. 
-Notation Zsimpl_gt_plus_r := Zsimpl_gt_plus_r.
-Notation Zgt_reg_l := Zgt_reg_l.      
-Notation Zgt_reg_r := Zgt_reg_r.
-Notation Zcompare_et_un := Zcompare_et_un.
-Notation Zgt_S_n := Zgt_S_n.
-Notation Zle_S_n := Zle_S_n.
-Notation Zgt_le_S := Zgt_le_S.
-Notation Zgt_S_le := Zgt_S_le.
-Notation Zgt_S := Zgt_S.
-Notation Zgt_trans_S := Zgt_trans_S.
-Notation Zeq_S := Zeq_S.
-Notation Zpred_Sn := Zpred_Sn.
-Notation Zeq_add_S := Zeq_add_S.
-Notation Znot_eq_S := Znot_eq_S.
-Notation Zsimpl_plus_l := Zsimpl_plus_l.
-Notation Zn_Sn := Zn_Sn.
-Notation Zplus_n_O := Zplus_n_O.
-Notation Zplus_unit_left := Zplus_unit_left.
-Notation Zplus_unit_right := Zplus_unit_right.
-Notation Zplus_n_Sm := Zplus_n_Sm.
-Notation Zmult_n_O := Zmult_n_O.
-Notation Zmult_n_Sm := Zmult_n_Sm.
-Notation Zle_n := Zle_n.
-Notation Zle_refl := Zle_refl.
-Notation Zle_trans := Zle_trans.
-Notation Zle_n_Sn := Zle_n_Sn.
-Notation Zle_n_S := Zle_n_S.
-Notation Zs_pred := Zs_pred. (* BinInt *)
-Notation Zle_pred_n := Zle_pred_n.
-Notation Zle_trans_S := Zle_trans_S.
-Notation Zle_Sn_n := Zle_Sn_n.
-Notation Zle_antisym := Zle_antisym.
-Notation Zgt_lt := Zgt_lt.
-Notation Zlt_gt := Zlt_gt.
-Notation Zge_le := Zge_le.
-Notation Zle_ge := Zle_ge.
-Notation Zge_trans := Zge_trans.
-Notation Zlt_n_Sn := Zlt_n_Sn.
-Notation Zlt_S := Zlt_S.
-Notation Zlt_n_S := Zlt_n_S.
-Notation Zlt_S_n := Zlt_S_n.
-Notation Zlt_n_n := Zlt_n_n.
-Notation Zlt_pred := Zlt_pred.
-Notation Zlt_pred_n_n := Zlt_pred_n_n.
-Notation Zlt_le_S := Zlt_le_S.
-Notation Zlt_n_Sm_le := Zlt_n_Sm_le.
-Notation Zle_lt_n_Sm := Zle_lt_n_Sm.
-Notation Zlt_le_weak := Zlt_le_weak.
-Notation Zlt_trans := Zlt_trans.
-Notation Zlt_le_trans := Zlt_le_trans.
-Notation Zle_lt_trans := Zle_lt_trans.
-Notation Zle_lt_or_eq := Zle_lt_or_eq.
-Notation Zle_or_lt := Zle_or_lt.
-Notation Zle_not_lt := Zle_not_lt.
-Notation Zlt_not_le := Zlt_not_le.
-Notation Zlt_not_sym := Zlt_not_sym.
-Notation Zle_le_S := Zle_le_S.
-Notation Zmin := Zmin.
-Notation Zmin_SS := Zmin_SS.
-Notation Zle_min_l := Zle_min_l.
-Notation Zle_min_r := Zle_min_r.
-Notation Zmin_case := Zmin_case.
-Notation Zmin_or := Zmin_or.
-Notation Zmin_n_n := Zmin_n_n.
-Notation Zplus_assoc_l := Zplus_assoc_l.
-Notation Zplus_assoc_r := Zplus_assoc_r.
-Notation Zplus_permute := Zplus_permute.
-Notation Zsimpl_le_plus_l := Zsimpl_le_plus_l.
-Notation "'Zsimpl_le_plus_l' c" := [a,b:Z](Zsimpl_le_plus_l a b c)
-  (at level 10, c at next level).
-Notation "'Zsimpl_le_plus_l' c a" := [b:Z](Zsimpl_le_plus_l a b c)
-  (at level 10, a, c at next level).
-Notation "'Zsimpl_le_plus_l' c a b" := (Zsimpl_le_plus_l a b c)
-  (at level 10, a, b, c at next level).
-Notation Zsimpl_le_plus_r := Zsimpl_le_plus_r.
-Notation "'Zsimpl_le_plus_r' c" := [a,b:Z](Zsimpl_le_plus_r a b c)
-  (at level 10, c at next level).
-Notation "'Zsimpl_le_plus_r' c a" := [b:Z](Zsimpl_le_plus_r a b c)
-  (at level 10, a, c at next level).
-Notation "'Zsimpl_le_plus_r' c a b" := (Zsimpl_le_plus_r a b c)
-  (at level 10, a, b, c at next level).
-Notation Zle_reg_l := Zle_reg_l.
-Notation Zle_reg_r := Zle_reg_r.
-Notation Zle_plus_plus := Zle_plus_plus.
-Notation Zplus_Snm_nSm := Zplus_Snm_nSm.
-Notation Zsimpl_lt_plus_l := Zsimpl_lt_plus_l. 
-Notation Zsimpl_lt_plus_r := Zsimpl_lt_plus_r.
-Notation Zlt_reg_l := Zlt_reg_l.
-Notation Zlt_reg_r := Zlt_reg_r.
-Notation Zlt_le_reg := Zlt_le_reg.
-Notation Zle_lt_reg := Zle_lt_reg.
-Notation Zminus := Zminus.
-Notation Zminus_plus_simpl := Zminus_plus_simpl.
-Notation Zminus_n_O := Zminus_n_O.
-Notation Zminus_n_n := Zminus_n_n.
-Notation Zplus_minus := Zplus_minus.
-Notation Zminus_plus := Zminus_plus.
-Notation Zle_plus_minus := Zle_plus_minus.
-Notation Zminus_Sn_m := Zminus_Sn_m.
-Notation Zlt_minus := Zlt_minus.
-Notation Zlt_O_minus_lt := Zlt_O_minus_lt.
-Notation Zmult_plus_distr_l := Zmult_plus_distr_l.
-Notation Zmult_plus_distr := BinInt.Zmult_plus_distr_l.
-Notation Zmult_minus_distr := Zmult_minus_distr.
-Notation Zmult_assoc_r := Zmult_assoc_r.
-Notation Zmult_assoc_l := Zmult_assoc_l.
-Notation Zmult_permute := Zmult_permute.
-Notation Zmult_1_n := Zmult_1_n.
-Notation Zmult_n_1 := Zmult_n_1.
-Notation Zmult_Sm_n := Zmult_Sm_n.
-Notation Zmult_Zplus_distr := Zmult_plus_distr_r.
-Export BinInt.
-Export Zorder.
-Export Zmin.
-Export Zabs.
-Export Zcompare.
-].
diff --git a/tools/check-v8 b/tools/check-v8
deleted file mode 100755
index 9dfa0be3..00000000
--- a/tools/check-v8
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/bin/sh
-
-echo ------------------ Producing v8 files -------------------------
-if [ -e v8 ]; then rm -r v8; fi
-if [ -e /tmp/v8.$$ ]; then rm -r /tmp/v8.$$; fi
-cp -pr . /tmp/v8.$$
-mv /tmp/v8.$$ v8
-cd v8
-rm description
-make clean
-make COQFLAGS='-translate -q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML)' || \
- { echo ---- Failed to translate; exit 1; }
-echo ------------------ Upgrading v8 files -------------------------
-v8files=`find . -name \*.v8`
-for i in $v8files; do
-  j=`dirname $i`/`basename $i .v8`.v
-  echo Upgrading $i
-  mv -u -f $i $j
-done
-echo ------------------ Recompiling v8 files -----------------------
-make clean
-make || { echo ---- Failed to recompile; exit 1; }
-make clean # to save disk space
-echo ------------------ Translation completed ----------------------
diff --git a/tools/coq-tex.ml4 b/tools/coq-tex.ml4
index 6987d78b..7565c22e 100644
--- a/tools/coq-tex.ml4
+++ b/tools/coq-tex.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coq-tex.ml4,v 1.5.2.1 2004/07/16 19:31:45 herbelin Exp $ *)
+(* $Id: coq-tex.ml4 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 (* coq-tex
  * JCF, 16/1/98
diff --git a/tools/coq_makefile.ml4 b/tools/coq_makefile.ml4
index 02607f14..cc3e9515 100644
--- a/tools/coq_makefile.ml4
+++ b/tools/coq_makefile.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coq_makefile.ml4,v 1.16.2.4 2005/01/12 16:00:19 sacerdot Exp $ *)
+(* $Id: coq_makefile.ml4 7994 2006-02-06 08:48:37Z herbelin $ *)
 
 (* créer un Makefile pour un développement Coq automatiquement *)
 
@@ -79,9 +79,9 @@ coq_makefile [subdirectory] .... [file.v] ... [file.ml] ... [-custom
 [--help]: equivalent to [-h]\n";
   exit 1
 
-let standard sds =
+let standard sds sps =
   print "byte:\n";
-  print "\t$(MAKE) all \"OPT=-byte\"\n\n";
+  print "\t$(MAKE) all \"OPT=\"\n\n";
   print "opt:\n";
   if !opt = "" then print "\t@echo \"WARNING: opt is disabled\"\n";
   print "\t$(MAKE) all \"OPT="; print !opt; print "\"\n\n";
@@ -118,6 +118,9 @@ let standard sds =
   print "\trm -f *.cmo *.cmi *.cmx *.o $(VOFILES) $(VIFILES) $(GFILES) *~\n";
   print "\trm -f all.ps all-gal.ps $(HTMLFILES) $(GHTMLFILES)\n";
   List.iter
+    (fun (file,_,_) -> print "\t- rm -f "; print file; print "\n")
+    sps;
+  List.iter
     (fun x -> print "\t(cd "; print x; print " ; $(MAKE) clean)\n")
     sds;
   print "\n";
@@ -224,17 +227,16 @@ let include_dirs l =
   print "OCAMLLIBS="; print_list "\\\n  " i_ocaml; print "\n";
   print "COQLIBS=";   print_list "\\\n  " i_coq; print "\n\n"
 
-let special l =
+let rec special = function
+  | [] -> []
+  | Special (file,deps,com) :: r -> (file,deps,com) :: (special r)
+  | _ :: r -> special r
+
+let custom sps =
   let pr_sp (file,dependencies,com) =
     print file; print ": "; print dependencies; print "\n";
     print "\t"; print com; print "\n\n"
   in
-  let rec sp_aux = function
-    | [] -> []
-    | Special (file,deps,com) :: r -> (file,deps,com) :: (sp_aux r)
-    | _ :: r -> sp_aux r
-  in
-  let sps = sp_aux l in
   if sps <> [] then section "Custom targets.";
   List.iter pr_sp sps
 
@@ -434,10 +436,11 @@ let do_makefile args =
   variables l;
   include_dirs l;
   all_target l;
-  special l;
+  let sps = special  l in
+  custom sps;
   let sds = subdirs l in
   implicit ();
-  standard sds;
+  standard sds sps;
   (* TEST directories_deps l; *)
   warning ();
   if not (!output_channel == stdout) then close_out !output_channel;
diff --git a/tools/coqdep.ml b/tools/coqdep.ml
index ab7cef92..eb740712 100755..100644
--- a/tools/coqdep.ml
+++ b/tools/coqdep.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqdep.ml,v 1.15.2.1 2004/07/16 19:31:46 herbelin Exp $ *)
+(* $Id: coqdep.ml 8642 2006-03-17 10:09:02Z notin $ *)
 
 open Printf
 open Coqdep_lexer
@@ -523,6 +523,7 @@ let coqdep () =
   List.iter 
     (fun (s,_) -> add_coqlib_directory s)
     (all_subdirs (!coqlib/"contrib") "Coq");
+  add_coqlib_directory (!coqlib/"user-contrib");
   mliKnown := !mliKnown @ (List.map (fun (f,_,d) -> (f,d)) !mliAccu);
   mlKnown  := !mlKnown @ (List.map (fun (f,_,d) -> (f,d)) !mlAccu);
   warning_mult ".mli" !mliKnown;
diff --git a/tools/coqdep_lexer.mll b/tools/coqdep_lexer.mll
index 4f5f172f..f7f37086 100755
--- a/tools/coqdep_lexer.mll
+++ b/tools/coqdep_lexer.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coqdep_lexer.mll,v 1.6.6.1 2004/07/16 19:31:46 herbelin Exp $ i*)
+(*i $Id: coqdep_lexer.mll 5920 2004-07-16 20:01:26Z herbelin $ i*)
   
 {
 
diff --git a/tools/coqdoc/alpha.ml b/tools/coqdoc/alpha.ml
index 2418b6e1..b1a46bae 100644
--- a/tools/coqdoc/alpha.ml
+++ b/tools/coqdoc/alpha.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: alpha.ml,v 1.1.2.1 2004/07/16 19:31:46 herbelin Exp $ i*)
+(*i $Id: alpha.ml 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 let norm_char c = match Char.uppercase c with
   | '\192'..'\198' -> 'A'
diff --git a/tools/coqdoc/alpha.mli b/tools/coqdoc/alpha.mli
index 46409c9a..d3c26537 100644
--- a/tools/coqdoc/alpha.mli
+++ b/tools/coqdoc/alpha.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: alpha.mli,v 1.1.2.1 2004/07/16 19:31:46 herbelin Exp $ i*)
+(*i $Id: alpha.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Alphabetic order. *)
 
diff --git a/tools/coqdoc/cdglobals.ml b/tools/coqdoc/cdglobals.ml
new file mode 100644
index 00000000..b5a4cb22
--- /dev/null
+++ b/tools/coqdoc/cdglobals.ml
@@ -0,0 +1,72 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+
+
+(*s Output options *)
+
+type target_language = LaTeX | HTML | TeXmacs
+
+let target_language = ref HTML
+
+type output_t =
+  | StdOut
+  | MultFiles
+  | File of string
+
+let output_dir = ref ""
+
+let out_to = ref MultFiles
+
+let out_channel = ref stdout
+
+let open_out_file f =
+  let f = if !output_dir <> "" then Filename.concat !output_dir f else f in
+    out_channel := open_out f
+
+let close_out_file () = close_out !out_channel
+
+
+let header_trailer = ref true
+let quiet = ref false
+let light = ref false
+let gallina = ref false
+let short = ref false
+let index = ref true
+let multi_index = ref false
+let toc = ref false
+let page_title = ref ""
+let title = ref ""
+let externals = ref true
+let coqlib = ref "http://coq.inria.fr/library/"
+let raw_comments = ref false
+
+let charset = ref "iso-8859-1"
+let inputenc = ref ""
+let latin1 = ref false
+let utf8 = ref false
+
+let set_latin1 () =
+  charset := "iso-8859-1";
+  inputenc := "latin1";
+  latin1 := true
+
+let set_utf8 () =
+  charset := "utf-8";
+  inputenc := "utf8";
+  utf8 := true
+
+(* Parsing options *)
+
+type coq_module = string
+
+type file =
+  | Vernac_file of string * coq_module
+  | Latex_file of string
+      
+
diff --git a/tools/coqdoc/coqdoc.css b/tools/coqdoc/coqdoc.css
new file mode 100644
index 00000000..b59438e5
--- /dev/null
+++ b/tools/coqdoc/coqdoc.css
@@ -0,0 +1,59 @@
+body { padding: 0px 0px;
+       margin: 0px 0px; 
+       background-color: white }
+
+#page { display: block;
+        padding: 0px;
+        margin: 0px;
+        padding-bottom: 10px; }
+
+#header { display: block;
+          position: relative;
+          padding: 0;
+          margin: 0;
+          vertical-align: middle;
+          border-bottom-style: solid;
+          border-width: thin }
+
+#header h1 { padding: 0; 
+             margin: 0;}
+
+
+/* Contenu */
+
+#main{ display: block;
+       padding: 10px;
+       overflow: hidden;
+       font-size: 10pt }
+
+#main  a.idref:visited {color : #416DFF; text-decoration : none; }
+#main  a.idref:link {color : #416DFF; text-decoration : none; }
+#main  a.idref:hover {color : Red; text-decoration : underline; }
+#main  a.idref:active {color : Red; text-decoration : underline; }
+
+#main .keyword { font-weight : bold; 
+                 color : Red }
+
+#main .section { font-size : 20pt }
+
+#main code { font-family: monospace; 
+             font-size: 8pt; 
+             line-height: 50% }
+
+#main .doc { margin: 0px;
+             padding: 10px;
+             font-family: sans-serif;
+             font-size: 11pt;
+             font-weight:bold;
+             background-color:#66ff66 }
+
+#main .doc code { font-family: monospace; 
+                  font-size: 10pt} 
+
+/* Pied de page */
+
+#footer { font-size: 8pt;
+          font-family: sans-serif; }
+
+#footer a:visited { color: blue; }
+
diff --git a/tools/coqdoc/coqdoc.sty b/tools/coqdoc/coqdoc.sty
index 68b9ab26..597152f5 100644
--- a/tools/coqdoc/coqdoc.sty
+++ b/tools/coqdoc/coqdoc.sty
@@ -9,13 +9,13 @@
 \ProvidesPackage{coqdoc}[2002/02/11]
 
 % Headings
-
 \usepackage{fancyhdr}
 \newcommand{\coqdocleftpageheader}{\thepage\ -- \today}
 \newcommand{\coqdocrightpageheader}{\today\ -- \thepage}
 \pagestyle{fancyplain}
 
 %BEGIN LATEX
+\headsep 8mm
 \renewcommand{\plainheadrulewidth}{0.4pt}
 \renewcommand{\plainfootrulewidth}{0pt}
 \lhead[\coqdocleftpageheader]{\leftmark}
@@ -50,7 +50,8 @@
 %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]{\section*{Module #1}\markboth{Module #1}{}
+}
 
 %HEVEA\newcommand{\lnot}{\coqwkw{not}}
 %HEVEA\newcommand{\lor}{\coqwkw{or}}
diff --git a/tools/coqdoc/index.mli b/tools/coqdoc/index.mli
index 60c21387..4b53d6ff 100644
--- a/tools/coqdoc/index.mli
+++ b/tools/coqdoc/index.mli
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: index.mli,v 1.1.2.1 2004/07/16 19:31:46 herbelin Exp $ i*)
+(*i $Id: index.mli 8617 2006-03-08 10:47:12Z notin $ i*)
 
-type coq_module = string
+open Cdglobals
 
 type loc = int
 
diff --git a/tools/coqdoc/index.mll b/tools/coqdoc/index.mll
index 875a2337..ec89da2f 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,v 1.2.2.2 2004/08/03 17:31:04 herbelin Exp $ i*)
+(*i $Id: index.mll 8617 2006-03-08 10:47:12Z notin $ i*)
 
 {
 
@@ -14,7 +14,7 @@ open Filename
 open Lexing 
 open Printf
 
-type coq_module = string
+open Cdglobals
 
 type loc = int
 
diff --git a/tools/coqdoc/main.ml b/tools/coqdoc/main.ml
index 66d2a993..177fc2bc 100644
--- a/tools/coqdoc/main.ml
+++ b/tools/coqdoc/main.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: main.ml,v 1.4.2.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: main.ml 8669 2006-03-28 17:34:15Z notin $ i*)
 
 (* Modified by Lionel Elie Mamane <lionel@mamane.lu> on 9 & 10 Mar 2004:
  *  - handling of absolute filenames (function coq_module)
@@ -18,6 +18,7 @@
  * It may be removed or abbreviated as far as I am concerned.
  *)
 
+open Cdglobals
 open Filename
 open Printf
 open Output
@@ -33,6 +34,7 @@ let usage () =
   prerr_endline "  --texmacs           produce a TeXmacs document";
   prerr_endline "  --dvi               output the DVI";
   prerr_endline "  --ps                output the PostScript";
+  prerr_endline "  --stdout            write output to stdout";
   prerr_endline "  -o <file>           write output in file <file>";
   prerr_endline "  -d <dir>            output files into directory <dir>";
   prerr_endline "  -g                  (gallina) skip proofs";
@@ -58,8 +60,6 @@ let usage () =
   prerr_endline "  --charset <string>  set HTML charset";
   prerr_endline "  --inputenc <string> set LaTeX input encoding";
   prerr_endline "";
-  prerr_endline 
-    "On-line documentation at http://www.lri.fr/~filliatr/coqdoc/\n";
   exit 1
 
 (*s \textbf{Banner.} Always printed. Notice that it is printed on error
@@ -71,7 +71,11 @@ let banner () =
   eprintf "This is coqdoc version %s, compiled on %s\n"
     Coq_config.version Coq_config.compile_date;
   flush stderr
-    
+
+let target_full_name f = 
+  match !target_language with
+    | HTML -> f ^ ".html"
+    | _ -> f ^ ".tex"
 
 (*s \textbf{Separation of files.} Files given on the command line are
     separated according to their type, which is determined by their
@@ -232,8 +236,10 @@ let parse () =
 	multi_index := true; parse_rec rem
     | ("-toc" | "--toc" | "--table-of-contents") :: rem ->
 	toc := true; parse_rec rem
+    | ("-stdout" | "--stdout") :: rem ->
+	out_to := StdOut; parse_rec rem
     | ("-o" | "--output") :: f :: rem ->
-	output_file := f; parse_rec rem
+	out_to := File f; parse_rec rem
     | ("-o" | "--output") :: [] -> 
 	usage ()
     | ("-d" | "--directory") :: dir :: rem ->
@@ -251,30 +257,29 @@ let parse () =
     | ("-t" | "-title" | "--title") :: [] ->
 	usage ()
     | ("-latex" | "--latex") :: rem ->
-	Output.target_language := LaTeX; parse_rec rem
+	Cdglobals.target_language := LaTeX; parse_rec rem
     | ("-dvi" | "--dvi") :: rem ->
-	Output.target_language := LaTeX; dvi := true; parse_rec rem
+	Cdglobals.target_language := LaTeX; dvi := true; parse_rec rem
     | ("-ps" | "--ps") :: rem ->
-	Output.target_language := LaTeX; ps := true; parse_rec rem
+	Cdglobals.target_language := LaTeX; ps := true; parse_rec rem
     | ("-html" | "--html") :: rem ->
-	Output.target_language := HTML; parse_rec rem
+	Cdglobals.target_language := HTML; parse_rec rem
     | ("-texmacs" | "--texmacs") :: rem ->
-	Output.target_language := TeXmacs; parse_rec rem
-
+	Cdglobals.target_language := TeXmacs; parse_rec rem
     | ("-charset" | "--charset") :: s :: rem ->
-	Output.charset := s; parse_rec rem
+	Cdglobals.charset := s; parse_rec rem
     | ("-charset" | "--charset") :: [] ->
 	usage ()
     | ("-inputenc" | "--inputenc") :: s :: rem ->
-	Output.inputenc := s; parse_rec rem
+	Cdglobals.inputenc := s; parse_rec rem
     | ("-inputenc" | "--inputenc") :: [] ->
 	usage ()
     | ("-raw-comments" | "--raw-comments") :: rem ->
-	Output.raw_comments := true; parse_rec rem
+	Cdglobals.raw_comments := true; parse_rec rem
     | ("-latin1" | "--latin1") :: rem ->
-	Output.set_latin1 (); parse_rec rem
+	Cdglobals.set_latin1 (); parse_rec rem
     | ("-utf8" | "--utf8") :: rem ->
-	Output.set_utf8 (); parse_rec rem
+	Cdglobals.set_utf8 (); parse_rec rem
 
     | ("-q" | "-quiet" | "--quiet") :: rem ->
 	quiet := true; parse_rec rem
@@ -298,7 +303,6 @@ let parse () =
 	parse_rec rem
     | ("-files" | "--files") :: [] ->
 	usage ()
-
     | "-R" :: path :: log :: rem -> 
 	add_path path log; parse_rec rem
     | "-R" :: ([] | [_]) ->
@@ -308,12 +312,11 @@ let parse () =
     | ("-glob-from" | "--glob-from") :: [] ->
 	usage ()
     | ("--no-externals" | "-no-externals" | "-noexternals") :: rem ->
-	Output.externals := false; parse_rec rem
+	Cdglobals.externals := false; parse_rec rem
     | ("--coqlib" | "-coqlib") :: u :: rem ->
-	Output.coqlib := u; parse_rec rem
+	Cdglobals.coqlib := u; parse_rec rem
     | ("--coqlib" | "-coqlib") :: [] ->
 	usage ()
-
     | f :: rem -> 
 	add_file (what_file f); parse_rec rem
   in 
@@ -360,52 +363,128 @@ let copy src dst =
   with End_of_file ->
     close_in cin; close_out cout
 
+
+(*s Functions for generating output files *)
+
+let gen_one_file l =
+  let file = function
+    | Vernac_file (f,m) -> 
+	set_module m; coq_file f m
+    | Latex_file _ -> ()
+  in
+    if (!header_trailer) then header ();
+    if !toc then make_toc ();
+    List.iter file l;
+    if !index then make_index();
+    if (!header_trailer) then trailer ()
+      
+let gen_mult_files l =
+  let file = function
+    | Vernac_file (f,m) -> 
+	set_module m;
+	let hf = target_full_name m in
+	  open_out_file hf;
+	  if (!header_trailer) then header (); 
+	  if !toc then make_toc ();
+	  coq_file f m; 
+	  if (!header_trailer) then trailer ();
+	  close_out_file()
+    | Latex_file _ -> ()
+  in
+    List.iter file l;
+    if (!index && !target_language=HTML) then begin
+      if (!multi_index) then make_multi_index (); 
+      open_out_file "index.html"; 
+      page_title := (if !title <> "" then !title else "Index");
+      if (!header_trailer) then header (); 
+      make_index (); 
+      if (!header_trailer) then trailer ();
+      close_out_file()
+    end;
+    if (!toc && !target_language=HTML) then begin
+      open_out_file "toc.html"; 
+      page_title := (if !title <> "" then !title else "Table of contents");
+      if (!header_trailer) then header ();
+      if !title <> "" then printf "<h1>%s</h1>\n" !title;
+      make_toc (); 
+      if (!header_trailer) then trailer ();
+      close_out_file()
+    end 
+      (* Rq: pour latex et texmacs, une toc ou un index séparé n'a pas de sens... *)
+
+
+let index_module = function
+  | Vernac_file (_,m) -> Index.add_module m
+  | Latex_file _ -> ()
+
+let produce_document l =
+  List.iter index_module l;
+  (if !target_language=HTML then
+    let src = (Filename.concat Coq_config.coqlib "/tools/coqdoc/coqdoc.css") in
+    let dst = if !output_dir <> "" then Filename.concat !output_dir "coqdoc.css" else "coqdoc.css" in
+      copy src dst);
+  (if !target_language=LaTeX then
+    let src = (Filename.concat Coq_config.coqlib "/tools/coqdoc/coqdoc.sty") in
+    let dst = if !output_dir <> "" then 
+      Filename.concat !output_dir "coqdoc.sty" 
+    else "coqdoc.sty" in
+      copy src dst);
+  match !out_to with
+    | StdOut -> 
+	Cdglobals.out_channel := stdout;
+	gen_one_file l
+    | File f ->
+	open_out_file f;
+	gen_one_file l;
+	close_out_file()
+    | MultFiles ->
+	gen_mult_files l
+
 let produce_output fl =
   if not (!dvi || !ps) then begin
-    if !output_file <> "" then set_out_file !output_file;
     produce_document fl
   end else begin
     let texfile = temp_file "coqdoc" ".tex" in
     let basefile = chop_suffix texfile ".tex" in
-    set_out_file texfile;
-    produce_document fl;
-    let command = 
-      let file = basename texfile in
-      let file = 
-	if !quiet then sprintf "'\\nonstopmode\\input{%s}'" file else file 
-      in
-      sprintf "(latex %s && latex %s) 1>&2 %s" file file
-	(if !quiet then "> /dev/null" else "")
-    in
-    let res = locally (dirname texfile) Sys.command command in
-    if res <> 0 then begin
-      eprintf "Couldn't run LaTeX successfully\n"; 
-      clean_and_exit basefile res
-    end;
-    let dvifile = basefile ^ ".dvi" in
-    if !dvi then begin
-      if !output_file <> "" then 
-	(* we cannot use Sys.rename accross file systems *)
-	copy dvifile !output_file 
-      else 
-	cat dvifile
-    end;
-    if !ps then begin
-      let psfile = 
-	if !output_file <> "" then !output_file else basefile ^ ".ps" 
-      in
+      open_out_file texfile;
+      produce_document fl;
       let command = 
-	sprintf "dvips %s -o %s %s" dvifile psfile 
-	  (if !quiet then "> /dev/null 2>&1" else "")
+	let file = basename texfile in
+	let file = 
+	  if !quiet then sprintf "'\\nonstopmode\\input{%s}'" file else file 
+	in
+	  sprintf "(latex %s && latex %s) 1>&2 %s" file file
+	    (if !quiet then "> /dev/null" else "")
       in
-      let res = Sys.command command in
-      if res <> 0 then begin
-	eprintf "Couldn't run dvips successfully\n"; 
-	clean_and_exit basefile res
-      end;
-      if !output_file = "" then cat psfile
-    end;
-    clean_temp_files basefile
+      let res = locally (dirname texfile) Sys.command command in
+	if res <> 0 then begin
+	  eprintf "Couldn't run LaTeX successfully\n"; 
+	  clean_and_exit basefile res
+	end;
+	let dvifile = basefile ^ ".dvi" in
+	  if !dvi then begin
+	    if !output_file <> "" then 
+	      (* we cannot use Sys.rename accross file systems *)
+	      copy dvifile !output_file 
+	    else 
+	      cat dvifile
+	  end;
+	  if !ps then begin
+	    let psfile = 
+	      if !output_file <> "" then !output_file else basefile ^ ".ps" 
+	    in
+	    let command = 
+	      sprintf "dvips %s -o %s %s" dvifile psfile 
+		(if !quiet then "> /dev/null 2>&1" else "")
+	    in
+	    let res = Sys.command command in
+	      if res <> 0 then begin
+		eprintf "Couldn't run dvips successfully\n"; 
+		clean_and_exit basefile res
+	      end;
+	      if !output_file = "" then cat psfile
+	  end;
+	  clean_temp_files basefile
   end
 
 
@@ -415,6 +494,6 @@ let produce_output fl =
 let main () =
   let files = parse () in
   if not !quiet then banner ();
-  if List.length files > 0 then produce_output files
+  if files <> [] then produce_output files
 
 let _ = Printexc.catch main ()
diff --git a/tools/coqdoc/output.ml b/tools/coqdoc/output.ml
index c10f3683..4c4cf5ec 100644
--- a/tools/coqdoc/output.ml
+++ b/tools/coqdoc/output.ml
@@ -6,30 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: output.ml,v 1.7.2.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: output.ml 8669 2006-03-28 17:34:15Z notin $ i*)
 
+open Cdglobals
 open Index
 
-(*s Target language *)
-
-type target_language = LaTeX | HTML | TeXmacs
-
-let target_language = ref HTML
-
 (*s Low level output *)
 
-let out_channel = ref stdout
-let output_is_file = ref false
-let output_dir = ref ""
-
-let set_out_file f = 
-  let f = if !output_dir <> "" then Filename.concat !output_dir f else f in
-  out_channel := open_out f;
-  output_is_file := true
-
-let close () =
-  if !output_is_file then close_out !out_channel
-
 let output_char c = Pervasives.output_char !out_channel c
 
 let output_string s = Pervasives.output_string !out_channel s
@@ -38,43 +21,6 @@ let printf s = Printf.fprintf !out_channel s
 
 let sprintf = Printf.sprintf
 
-let dump_file f =
-  let ch = open_in f in
-  try
-    while true do
-      Pervasives.output_char !out_channel (input_char ch)
-    done
-  with End_of_file -> close_in ch
-
-(*s Options *)
-
-let header_trailer = ref true
-let quiet = ref false
-let light = ref false
-let short = ref false
-let index = ref true
-let multi_index = ref false
-let toc = ref false
-let page_title = ref ""
-let title = ref ""
-let externals = ref true
-let coqlib = ref "http://coq.inria.fr/library/"
-let raw_comments = ref false
-
-let charset = ref ""
-let inputenc = ref ""
-let latin1 = ref false
-let utf8 = ref false
-
-let set_latin1 () =
-  charset := "iso-8859-1";
-  inputenc := "latin1";
-  latin1 := true
-
-let set_utf8 () =
-  charset := "utf-8";
-  inputenc := "utf8";
-  utf8 := true
 
 (*s Coq keywords *)
 
@@ -85,9 +31,9 @@ let build_table l =
 
 let is_keyword = 
   build_table
-    [ "Add"; "AddPath"; "Axiom"; "Chapter"; "CoFixpoint";
+    [ "AddPath"; "Axiom"; "Chapter"; "CoFixpoint";
       "CoInductive"; "Defined"; "Definition"; 
-      "End"; "Export"; "Fact"; "Fix"; "Fixpoint"; "Global"; "Grammar"; "Hint";
+      "End"; "Export"; "Fact"; "Fix"; "Fixpoint"; "Global"; "Grammar"; "Goal"; "Hint";
       "Hypothesis"; "Hypotheses"; 
       "Immediate"; "Implicit"; "Import"; "Inductive"; 
       "Infix"; "Lemma"; "Let"; "Load"; "Local"; "Ltac"; 
@@ -145,6 +91,7 @@ let _ = List.iter
 	    "|-",  "\\ensuremath{\\vdash}";
 	    "forall", "\\ensuremath{\\forall}";
 	    "exists", "\\ensuremath{\\exists}";
+	    (* "fun", "\\ensuremath{\\lambda}" ? *)
 	  ]
 
 (*s Table of contents *)
@@ -308,6 +255,8 @@ module Latex = struct
 
   let end_inline_coq () = ()
 
+  let make_multi_index () = ()
+
   let make_index () = ()
 
   let make_toc () = printf "\\tableofcontents\n"
@@ -321,29 +270,31 @@ module Html = struct
 
   let header () =
     if !header_trailer then begin
+      printf "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n";
+      printf "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n";
       printf "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n<head>\n";
-      if !charset != "" then 
-	printf "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" !charset;
-      printf "<link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">";
+      printf "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\"/>\n" !charset;
+      printf "<link href=\"coqdoc.css\" rel=\"stylesheet\" type=\"text/css\"/>\n";
       printf "<title>%s</title>\n</head>\n\n" !page_title;
-      printf "<body>\n\n"
+      printf "<body>\n\n<div id=\"page\">\n\n<div id=\"header\">\n</div>\n\n";
+      printf "<div id=\"main\">\n\n"
     end
 
-  let self = "http://www.lri.fr/~filliatr/coqdoc/"
+  let self = "http://coq.inria.fr"
 
   let trailer () =
     if !index && !current_module <> "Index" then 
-      printf "<hr/><a href=\"index.html\">Index</a>";
+      printf "</div>\n\n<div id=\"footer\">\n<hr/><a href=\"index.html\">Index</a>";
     if !header_trailer then begin
       printf "<hr/><font size=\"-1\">This page has been generated by ";
       printf "<a href=\"%s\">coqdoc</a></font>\n" self;
-      printf "</body>\n</html>"
+      printf "</div>\n\n</div>\n\n</body>\n</html>"
     end
 
   let start_module () = 
     if not !short then begin
       (* add_toc_entry (Toc_library !current_module); *)
-      printf "<h1>Library %s</h1>\n\n" !current_module
+      printf "<h1 class=\"libtitle\">Library %s</h1>\n\n" !current_module
     end
 
   let indentation n = for i = 1 to n do printf "&nbsp;" done
@@ -373,7 +324,7 @@ module Html = struct
   let stop_verbatim () = printf "</pre>\n"
 
   let module_ref m s = 
-    printf "<a href=\"%s.html\">" m; raw_ident s; printf "</a>"
+    printf "<a class=\"modref\" href=\"%s.html\">" m; raw_ident s; printf "</a>"
     (*i
     match find_module m with
     | Local ->
@@ -387,18 +338,18 @@ module Html = struct
 
   let ident_ref m s = match find_module m with
     | Local ->
-	printf "<a href=\"%s.html#%s\">" m s; raw_ident s; printf "</a>"
+	printf "<a class=\"idref\" href=\"%s.html#%s\">" m s; raw_ident s; printf "</a>"
     | Coqlib when !externals ->
 	let m = Filename.concat !coqlib m in
-	printf "<a href=\"%s.html#%s\">" m s; raw_ident s; printf "</a>"
+	printf "<a class=\"idref\" href=\"%s.html#%s\">" m s; raw_ident s; printf "</a>"
     | Coqlib | Unknown ->
 	raw_ident s
 
   let ident s loc = 
     if is_keyword s then begin
-      printf "<code class=\"keyword\">"; 
+      printf "<span class=\"keyword\">"; 
       raw_ident s; 
-      printf "</code>"
+      printf "</span>"
     end else 
       try
 	(match Index.find !current_module loc with
@@ -447,11 +398,11 @@ module Html = struct
 
   let start_doc () = 
     if not !raw_comments then
-      printf "\n<table width=\"100%%\"><tr class=\"doc\"><td>\n"
+      printf "\n<div class=\"doc\">\n"
 
   let end_doc () =
     stop_item (); 
-    if not !raw_comments then printf "\n</td></tr></table>\n"
+    if not !raw_comments then printf "\n</div>\n"
 
   let start_code () = end_doc (); start_coq ()
 
@@ -470,7 +421,7 @@ module Html = struct
     stop_item ();
     printf "<a name=\"%s\"></a><h%d>" lab lev;
     f ();
-    printf "</h%d>\n" lev
+    printf "</h%d class=\"section\">\n" lev
 
   let rule () = printf "<hr/>\n"
 
@@ -502,20 +453,8 @@ module Html = struct
 		
   let all_letters i = List.iter (letter_index false i.idx_name) i.idx_entries
 
-  let separate_index navig i =
-    let idx = i.idx_name in
-    let one_letter ((c,l) as cl) =
-      set_out_file (sprintf "index_%s_%c.html" idx c);
-      header ();
-      navig ();
-      printf "<hr/>";
-      letter_index true idx cl;
-      if List.length l > 30 then begin printf "<hr/>"; navig () end;
-      trailer ();
-      close ()
-    in
-    List.iter one_letter i.idx_entries
-
+  (* Construction d'une liste des index (1 index global, puis 1
+     index par catégorie) *)
   let format_global_index =
     Index.map 
       (fun s (m,t) -> 
@@ -523,7 +462,7 @@ module Html = struct
 	   "[library]", m ^ ".html"
 	 else
 	   sprintf "[%s, in <a href=\"%s.html\">%s</a>]" (entry_type t) m m ,
-	   sprintf "%s.html#%s" m s)
+	 sprintf "%s.html#%s" m s)
 
   let format_bytype_index = function
     | Library, idx ->
@@ -532,9 +471,10 @@ module Html = struct
 	Index.map 
 	  (fun s m -> 
 	     let text = sprintf "[in <a href=\"%s.html\">%s</a>]" m m in
-	     (text, sprintf "%s.html#%s" m s)) idx
+	       (text, sprintf "%s.html#%s" m s)) idx
 
-  let navig_one_index i =
+  (* Impression de la table d'index *)
+  let print_index_table_item i =
     printf "<tr>\n<td>%s Index</td>\n" (String.capitalize i.idx_name);
     List.iter 
       (fun (c,l) -> 
@@ -544,52 +484,58 @@ module Html = struct
 	   printf "<td>%c</td>\n" c)
       i.idx_entries;
     let n = i.idx_size in
-    printf "<td>(%d %s)</td>\n" n (if n > 1 then "entries" else "entry");
-    printf "</tr>\n"
+      printf "<td>(%d %s)</td>\n" n (if n > 1 then "entries" else "entry");
+      printf "</tr>\n"
 
-  let navig_index il = 
+  let print_index_table idxl = 
     printf "<table>\n";
-    List.iter navig_one_index il;
+    List.iter print_index_table_item idxl;
     printf "</table>\n"
-
+	
+  let make_one_multi_index prt_tbl i =
+    (* Attn: make_one_multi_index créé un nouveau fichier... *)
+    let idx = i.idx_name in
+    let one_letter ((c,l) as cl) =
+      open_out_file (sprintf "index_%s_%c.html" idx c);
+      if (!header_trailer) then header ();
+      prt_tbl (); printf "<hr/>";
+      letter_index true idx cl;
+      if List.length l > 30 then begin printf "<hr/>"; prt_tbl () end;
+      if (!header_trailer) then trailer ();
+      close_out_file ()
+    in
+      List.iter one_letter i.idx_entries
+
+  let make_multi_index () = 
+    let all_index = 
+      let glob,bt = Index.all_entries () in
+	(format_global_index glob) ::
+	  (List.map format_bytype_index bt) in
+    let print_table () = print_index_table all_index in
+      List.iter (make_one_multi_index print_table) all_index
+	
   let make_index () =
-    if !index then begin
-      let idxl = 
-	let glob,bt = Index.all_entries () in
-	format_global_index glob ::
-	List.map format_bytype_index bt 
-      in
-      let navig () = navig_index idxl in 
-      set_out_file "index.html";
+    let all_index = 
+      let glob,bt = Index.all_entries () in
+	(format_global_index glob) ::
+	  (List.map format_bytype_index bt) in
+    let print_table () = print_index_table all_index in
+    let print_one_index i =
+      if i.idx_size > 0 then begin
+	printf "<hr/>\n<h1>%s Index</h1>\n" (String.capitalize i.idx_name);
+	all_letters i
+      end
+    in
       current_module := "Index";
-      page_title := (if !title <> "" then !title else "Index");
-      header ();
       if !title <> "" then printf "<h1>%s</h1>\n" !title;
-      navig ();
-      if !multi_index then begin
-	trailer (); 
-	close ();
-	List.iter (separate_index navig) idxl;
-      end else begin
-	let one_index i =
-	  if i.idx_size > 0 then begin
-	    printf "<hr/>\n<h1>%s Index</h1>\n" (String.capitalize i.idx_name);
-	    all_letters i
-	  end
-	in
-	List.iter one_index idxl;
-	printf "<hr/>";
-	navig ();
-	trailer ();
-	close ()
-      end;
-    end
-
+      print_table ();
+      if not (!multi_index) then 
+	begin
+	  List.iter print_one_index all_index;
+	  printf "<hr/>"; print_table ()
+	end
+	    
   let make_toc () = 
-    set_out_file "toc.html";
-    page_title := (if !title <> "" then !title else "Table of contents");
-    header ();
-    if !title <> "" then printf "<h1>%s</h1>\n" !title;
     let make_toc_entry = function
       | Toc_library m -> 
 	  stop_item ();
@@ -600,9 +546,6 @@ module Html = struct
     in
     Queue.iter make_toc_entry toc_q;
     stop_item ();
-    if !index then printf "<a href=\"index.html\"><h2>Index</h2></a>";
-    trailer ();
-    close ()
 
 end
 
@@ -740,6 +683,8 @@ module TeXmacs = struct
 
   let end_inline_coq () = printf "]>"
 
+  let make_multi_index () = ()
+
   let make_index () = ()
 
   let make_toc () = ()
@@ -808,5 +753,6 @@ let verbatim_char =
   select output_char Html.char TeXmacs.char
 let hard_verbatim_char = output_char
 
+let make_multi_index = select Latex.make_multi_index Html.make_multi_index TeXmacs.make_multi_index
 let make_index = select Latex.make_index Html.make_index TeXmacs.make_index
 let make_toc = select Latex.make_toc Html.make_toc TeXmacs.make_toc
diff --git a/tools/coqdoc/output.mli b/tools/coqdoc/output.mli
index 2195fa53..87b311f3 100644
--- a/tools/coqdoc/output.mli
+++ b/tools/coqdoc/output.mli
@@ -6,35 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: output.mli,v 1.3.2.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: output.mli 8669 2006-03-28 17:34:15Z notin $ i*)
 
+open Cdglobals
 open Index
 
-type target_language = LaTeX | HTML | TeXmacs
-
-val target_language : target_language ref
-
-val set_out_file : string -> unit
-val output_dir : string ref
-val close : unit -> unit
-
-val quiet : bool ref
-val short : bool ref
-val light : bool ref
-val header_trailer : bool ref
-val index : bool ref
-val multi_index : bool ref
-val toc : bool ref
-val title : string ref
-val externals : bool ref
-val coqlib : string ref
-val raw_comments : bool ref
-
-val charset : string ref
-val inputenc : string ref
-val set_latin1 : unit -> unit
-val set_utf8 : unit -> unit
-
 val add_printing_token : string -> string option * string option -> unit
 val remove_printing_token : string -> unit
 
@@ -45,8 +21,6 @@ val trailer : unit -> unit
 
 val push_in_preamble : string -> unit
 
-val dump_file : string -> unit
-
 val start_module : unit -> unit
 
 val start_doc : unit -> unit
@@ -88,5 +62,6 @@ val stop_latex_math : unit -> unit
 val start_verbatim : unit -> unit
 val stop_verbatim : unit -> unit
 
+val make_multi_index : unit -> unit
 val make_index : unit -> unit
 val make_toc : unit -> unit
diff --git a/tools/coqdoc/pretty.mli b/tools/coqdoc/pretty.mli
index 07808fe9..dda0439e 100644
--- a/tools/coqdoc/pretty.mli
+++ b/tools/coqdoc/pretty.mli
@@ -6,14 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pretty.mli,v 1.1.2.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: pretty.mli 8617 2006-03-08 10:47:12Z notin $ i*)
 
 open Index
 
-type file =
-  | Vernac_file of string * coq_module
-  | Latex_file of string
-
-val gallina : bool ref
-
-val produce_document : file list -> unit
+val coq_file : string -> Cdglobals.coq_module -> unit
diff --git a/tools/coqdoc/pretty.mll b/tools/coqdoc/pretty.mll
index 541939b5..ad9057ad 100644
--- a/tools/coqdoc/pretty.mll
+++ b/tools/coqdoc/pretty.mll
@@ -6,12 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pretty.mll,v 1.7.2.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: pretty.mll 8666 2006-03-27 17:02:49Z notin $ i*)
 
 (*s Utility functions for the scanners *)
 
 {
 
+  open Cdglobals
   open Printf
   open Index
   open Lexing 
@@ -56,39 +57,8 @@
 
   let backtrack lexbuf = lexbuf.lex_curr_pos <- lexbuf.lex_start_pos
 
-  (* Gallina (skipping proofs). This is a three states automaton. *)   
-
-  let gallina = ref false
-
-  type gallina_state = Nothing | AfterDot | Proof
-
-  let gstate = ref AfterDot
-
-  let is_proof = 
-    let t = Hashtbl.create 13 in
-    List.iter (fun s -> Hashtbl.add t s true)
-      [ "Theorem"; "Lemma"; "Fact"; "Remark"; "Goal"; "Let";
-	"Correctness"; "Definition"; "Morphism" ];
-    fun s -> try Hashtbl.find t s with Not_found -> false
-
-  let gallina_id id = 
-    if !gstate = AfterDot then
-      if is_proof id then gstate := Proof else 
-	if id <> "Add" then gstate := Nothing
-
-  let gallina_symbol s = 
-    if !gstate = AfterDot || (!gstate = Proof && s = ":=") then 
-      gstate := Nothing
-
   let is_space = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false
 
-  let gallina_char c = 
-    if c = '.' then
-      (let skip = !gstate = Proof in gstate := AfterDot; skip)
-    else
-      (if !gstate = AfterDot && not (is_space c) then gstate := Nothing;
-       false)
-
   (* saving/restoring the PP state *)
 
   type state = {
@@ -121,8 +91,7 @@
 
   let reset () =
     formatted := false;
-    brackets := 0;
-    gstate := AfterDot
+    brackets := 0
 
   (* erasing of Section/End *)
 
@@ -216,6 +185,100 @@ let symbolchar_no_brackets =
 let symbolchar = symbolchar_no_brackets | '[' | ']'
 let token = symbolchar+ | '[' [^ '[' ']' ':']* ']'
 
+
+let thm_token = 
+  "Theorem" 
+  | "Lemma" 
+  | "Fact" 
+  | "Remark" 
+  | "Corollary" 
+  | "Proposition" 
+  | "Property"
+  | "Goal"
+
+let def_token = 
+  "Definition" 
+  | "Let" 
+  | "SubClass" 
+  | "Example"
+  | "Local" 
+  | "Fixpoint" 
+  | "CoFixpoint" 
+  | "Record" 
+  | "Structure" 
+  | "Scheme"
+  | "Inductive"
+  | "CoInductive"
+
+let decl_token = 
+  "Hypothesis" 
+  | "Hypotheses" 
+  | "Parameter" 
+  | "Axiom" 's'? 
+  | "Conjecture"
+
+let gallina_ext =
+  "Module" 
+  | "Declare"
+  | "Transparent"
+  | "Opaque"
+  | "Canonical"
+  | "Coercion"
+  | "Identity"
+  | "Implicit"
+  | "Notation"
+  | "Infix"
+  | "Tactic" space+ "Notation"
+  | "Reserved" space+ "Notation"
+
+let commands = 
+  "Pwd"
+  | "Cd"
+  | "Drop"
+  | "ProtectedLoop"
+  | "Quit"
+  | "Load"
+  | "Add"
+  | "Remove" space+ "Loadpath"
+  | "Print"
+  | "Inspect"
+  | "About"
+  | "Search"
+  | "Eval"
+  | "Reset"
+  | "Check"
+  | "Type"
+
+let extraction = 
+  "Extraction"
+  | "Recursive" space+ "Extraction" 
+  | "Extract"
+
+let gallina_kw = thm_token | def_token | decl_token | gallina_ext | commands | extraction
+
+let gallina_kw_to_hide =
+  "Implicit"
+  | "Ltac"
+  | "Require"
+  | "Import"
+  | "Export"
+  | "Load" 
+  | "Hint"
+  | "Open"
+  | "Close"
+  | "Delimit"
+  | "Transparent"
+  | "Opaque"
+  | ("Declare" space+ ("Morphism" | "Step") )
+  | "Section"
+  | "Chapter"
+  | "Variable" 's'?
+  | ("Hypothesis" | "Hypotheses")
+  | "End"
+  | ("Set" | "Unset") space+ "Printing" space+ "Coercions"
+  | "Declare" space+ ("Left" | "Right") space+ "Step" 
+
+
 (* tokens with balanced brackets *)
 let token_brackets =
   ( symbolchar_no_brackets+ ('[' symbolchar_no_brackets* ']')* 
@@ -235,32 +298,18 @@ let begin_verb = "(*" space* "begin" space+ "verb" space* "*)"
 let end_verb = "(*" space* "end" space+ "verb" space* "*)"
 *)
 
-let coq_command_to_hide =
-  "Implicit" space |
-  "Ltac" space | 
-  "Require" space | 
-  "Load" space |
-  "Hint" space |
-  "Transparent" space |
-  "Opaque" space |
-  ("Declare" space+ ("Morphism" | "Step") space) |
-  "Section" space | 
-  "Variable" 's'? space | 
-  ("Hypothesis" | "Hypotheses") space | 
-  "End" space |
-  ("Set" | "Unset") space+ "Printing" space+ "Coercions" space |
-  "Declare" space+ ("Left" | "Right") space+ "Step" space
+
 
 (*s Scanning Coq, at beginning of line *)
 
 rule coq_bol = parse
-  | '\n'+
+  | space* '\n'+
       { empty_line_of_code (); coq_bol lexbuf }
   | space* "(**" space_nl
       { end_coq (); start_doc (); 
 	let eol = doc_bol lexbuf in
-	end_doc (); start_coq (); 
-	if eol then coq_bol lexbuf else coq lexbuf }
+	  end_doc (); start_coq (); 
+	  if eol then coq_bol lexbuf else coq lexbuf }
   | space* "Comments" space_nl
       { end_coq (); start_doc (); comments lexbuf; end_doc (); 
 	start_coq (); coq lexbuf }
@@ -270,28 +319,40 @@ rule coq_bol = parse
       { begin_show (); coq_bol lexbuf }
   | space* end_show
       { end_show (); coq_bol lexbuf }
-  | space* coq_command_to_hide
+  | space* gallina_kw_to_hide
       { let s = lexeme lexbuf in
-	if !light && section_or_end s then begin 
-	  skip_to_dot lexbuf; 
-	  coq_bol lexbuf 
-	end else begin
-	  indentation (count_spaces s); 
-	  backtrack lexbuf; 
-	  coq lexbuf 
-	end }
+	  if !light && section_or_end s then begin 
+	    skip_to_dot lexbuf; 
+	    coq_bol lexbuf 
+	  end else begin
+	    let s = lexeme lexbuf in 
+	    let nbsp = count_spaces s in
+	      indentation nbsp; 
+	      let s = String.sub s nbsp (String.length s - nbsp) in
+		ident s (lexeme_start lexbuf + nbsp); 
+		let eol= body lexbuf in 
+		  if eol then coq_bol lexbuf else coq lexbuf
+	  end }
+  | space* gallina_kw
+      { let s = lexeme lexbuf in 
+	let nbsp = count_spaces s in
+	  indentation nbsp;
+	  let s = String.sub s nbsp (String.length s - nbsp)  in
+	    ident s (lexeme_start lexbuf + nbsp); 
+	    let eol= body lexbuf in
+	      if eol then coq_bol lexbuf else coq lexbuf }
   | space* "(**" space+ "printing" space+ (identifier | token) space+
       { let tok = lexeme lexbuf in
 	let s = printing_token lexbuf in
-	add_printing_token tok s;
-	coq_bol lexbuf }
+	  add_printing_token tok s;
+	  coq_bol lexbuf }
   | space* "(**" space+ "printing" space+
       { eprintf "warning: bad 'printing' command at character %d\n" 
 	  (lexeme_start lexbuf); flush stderr;
 	ignore (comment lexbuf);
 	coq_bol lexbuf }
   | space* "(**" space+ "remove" space+ "printing" space+ 
-    (identifier | token) space* "*)"
+      (identifier | token) space* "*)"
       { remove_printing_token (lexeme lexbuf);
 	coq_bol lexbuf }
   | space* "(**" space+ "remove" space+ "printing" space+
@@ -301,68 +362,77 @@ rule coq_bol = parse
 	coq_bol lexbuf }
   | space* "(*"
       { let eol = comment lexbuf in
-	if eol then coq_bol lexbuf else coq lexbuf }
-  | space+
-      { indentation (count_spaces (lexeme lexbuf)); coq lexbuf }
+	  if eol then coq_bol lexbuf else coq lexbuf }
   | eof 
       { () }
-  | _ 
-      { backtrack lexbuf; indentation 0; coq lexbuf }
+  | _
+      { let eol = 
+	  if not !gallina then 
+	    begin backtrack lexbuf; indentation 0; body_bol lexbuf end 
+	  else 
+	    skip_to_dot lexbuf 
+	in
+	  if eol then coq_bol lexbuf else coq lexbuf }
 
 (*s Scanning Coq elsewhere *)
 
 and coq = parse
   | "\n" 
-      { line_break (); coq_bol lexbuf }
+      { line_break(); coq_bol lexbuf }
   | "(**" space_nl
       { end_coq (); start_doc (); 
 	let eol = doc_bol lexbuf in
-	end_doc (); start_coq (); 
-	if eol then coq_bol lexbuf else coq lexbuf }
+	  end_doc (); start_coq (); 
+	  if eol then coq_bol lexbuf else coq lexbuf }
   | "(*"
       { let eol = comment lexbuf in
-	if eol then coq_bol lexbuf else coq lexbuf }
+	  if eol then begin line_break(); coq_bol lexbuf end 
+          else coq lexbuf
+      }
   | '\n'+ space* "]]"
       { if not !formatted then begin symbol (lexeme lexbuf); coq lexbuf end }
   | eof 
       { () }
-  | token
+  | gallina_kw_to_hide
       { let s = lexeme lexbuf in
-	if !gallina then gallina_symbol s;
-	symbol s;
-	coq lexbuf }
-  | "with" space+ "Module" | "Module" space+ "Type" | "Declare" space+ "Module"
-    (* hack to avoid making Type a keyword *)
-      { let s = lexeme lexbuf in
-	if !gallina then gallina_id s;
-        ident s (lexeme_start lexbuf); coq lexbuf }
-  | "(" space* identifier space* ":=" 
-      { let id = extract_ident (lexeme lexbuf) in
-	symbol "("; ident id (lexeme_start lexbuf); symbol ":="; coq lexbuf }
-  | (identifier '.')* identifier
-      { let id = lexeme lexbuf in
-	if !gallina then gallina_id id;
-	ident id (lexeme_start lexbuf); coq lexbuf }
-  | _ 
-      { let c = lexeme_char lexbuf 0 in 
-	char c;
-	if !gallina && gallina_char c then skip_proof lexbuf;
-	coq lexbuf }
-
+	  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 }
+  | space+ { char ' '; coq lexbuf }
+  | eof 
+      { () }
+  | _ { let eol = 
+	  if not !gallina then 
+	    begin backtrack lexbuf; indentation 0; body lexbuf end 
+	  else 
+	    skip_to_dot lexbuf 
+	in 
+	  if eol then coq_bol lexbuf else coq lexbuf}
+      
 (*s Scanning documentation, at beginning of line *)
-
+      
 and doc_bol = parse
   | space* "\n" '\n'*
       { paragraph (); doc_bol lexbuf }
   | space* section [^')'] ([^'\n' '*'] | '*' [^'\n'')'])*
-      { let lev, s = sec_title (lexeme lexbuf) in 
-	section lev (fun () -> ignore (doc (from_string s))); 
-	doc lexbuf }
-  | space* '-'+
-      { let n = count_dashes (lexeme lexbuf) in
-	if n >= 4 then rule () else item n;
-	doc lexbuf }
-  | "<<" space*
+{ let lev, s = sec_title (lexeme lexbuf) in 
+    section lev (fun () -> ignore (doc (from_string s))); 
+    doc lexbuf }
+| space* '-'+
+     { let n = count_dashes (lexeme lexbuf) in
+	 if n >= 4 then rule () else item n;
+	 doc lexbuf }
+| "<<" space*
       { start_verbatim (); verbatim lexbuf; doc_bol lexbuf }
   | eof 
       { false }
@@ -481,22 +551,33 @@ and comment = parse
   | eof  { false }
   | _    { comment lexbuf }
 
-(*s Skip proofs *)
-
-and skip_proof = parse
-  | "(*" { ignore (comment lexbuf); skip_proof lexbuf }
-  | "Save" | "Qed" | "Defined"
-  | "Abort" | "Proof" | "Admitted" { skip_to_dot lexbuf }
-  | "Proof" space* '.' { skip_proof lexbuf }
-  | identifier { skip_proof lexbuf } (* to avoid keywords within idents *)
-  | eof { () }
-  | _ { skip_proof lexbuf }
-
 and skip_to_dot = parse
-  | eof | '.' { if !gallina then gstate := AfterDot }
+  | '.' space* '\n' { true }
+  | eof | '.' space+ { false}
   | "(*" { ignore (comment lexbuf); skip_to_dot lexbuf }
   | _ { skip_to_dot lexbuf }
 
+and body_bol = parse
+  | space+
+      { indentation (count_spaces (lexeme lexbuf)); body lexbuf }
+  | _ { backtrack lexbuf; body lexbuf }
+
+and body = parse
+  | '\n' {line_break(); body_bol lexbuf}
+  | eof { false }
+  | '.' space* '\n' | '.' space* eof { char '.'; line_break(); true }      
+  | '.' space+ { char '.'; char ' '; false }
+  | "(*" { let eol = comment lexbuf in 
+	     if eol then body_bol lexbuf else body lexbuf }
+  | identifier 
+      { let s = lexeme lexbuf in 
+	  ident s (lexeme_start lexbuf); body lexbuf }
+  | token
+      { let s = lexeme lexbuf in
+	  symbol s; body lexbuf }
+  | _ { let c = lexeme_char lexbuf 0 in 
+	  char c; body lexbuf }
+
 and skip_hide = parse
   | eof | end_hide { () }
   | _ { skip_hide lexbuf }
@@ -515,10 +596,6 @@ and printing_token = parse
 
 {
 
-  type file =
-    | Vernac_file of string * coq_module
-    | Latex_file of string
-
   let coq_file f m =
     reset ();
     Index.scan_file f m;
@@ -528,59 +605,5 @@ and printing_token = parse
     start_coq (); coq_bol lb; end_coq ();
     close_in c
 
-  (* LaTeX document *)
-
-  let latex_document l = 
-    let file = function
-      | Vernac_file (f,m) -> set_module m; coq_file f m
-      | Latex_file f -> dump_file f
-    in
-    header ();
-    if !toc then make_toc ();
-    List.iter file l;
-    trailer ();
-    close ()
-
-  (* HTML document *)      
-
-  let html_document l =
-    let file = function
-      | Vernac_file (f,m) -> 
-	  set_module m;
-	  let hf = m ^ ".html" in
-	  set_out_file hf;
-	  header ();
-	  coq_file f m;
-	  trailer ();
-	  close ()
-      | Latex_file _ -> ()
-    in
-    List.iter file l;
-    make_index ();
-    if !toc then make_toc ()
-
-  (* TeXmacs document *)
-
-  let texmacs_document l = 
-    let file = function
-      | Vernac_file (f,m) -> set_module m; coq_file f m
-      | Latex_file f -> dump_file f
-    in
-    header ();
-    List.iter file l;
-    trailer ();
-    close ()
-
-  let index_module = function
-    | Vernac_file (_,m) -> Index.add_module m
-    | Latex_file _ -> ()
-
-  let produce_document l =
-    List.iter index_module l;
-    (match !target_language with
-       | LaTeX -> latex_document 
-       | HTML -> html_document
-       | TeXmacs -> texmacs_document) l
-
 }
 
diff --git a/tools/coqwc.mll b/tools/coqwc.mll
index 08bf2bcc..26b64095 100644
--- a/tools/coqwc.mll
+++ b/tools/coqwc.mll
@@ -9,7 +9,7 @@
 (* coqwc - counts the lines of spec, proof and comments in Coq sources
  * Copyright (C) 2003 Jean-Christophe Filliâtre *)
 
-(*i $Id: coqwc.mll,v 1.2.2.1 2004/07/16 19:31:46 herbelin Exp $ i*)
+(*i $Id: coqwc.mll 7095 2005-05-31 15:05:23Z filliatr $ i*)
 
 (*s {\bf coqwc.} Counts the lines of spec, proof and comments in a Coq source. 
     It assumes the files to be lexically well-formed. *)
@@ -99,7 +99,7 @@ let dot = '.' (' ' | '\t' | '\n' | '\r' | eof)
 let proof_start =   
   "Theorem" | "Lemma" | "Fact" | "Remark" | "Goal" | "Correctness"
 let proof_end =
-  ("Save" | "Qed" | "Defined" | "Abort") [^'.']* '.'
+  ("Save" | "Qed" | "Defined" | "Abort" | "Admitted") [^'.']* '.'
 
 (*s [spec] scans the specification. *)
 
diff --git a/tools/gallina.ml b/tools/gallina.ml
index c997820c..a2c05c6d 100644
--- a/tools/gallina.ml
+++ b/tools/gallina.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: gallina.ml,v 1.2.16.1 2004/07/16 19:31:46 herbelin Exp $ *)
+(* $Id: gallina.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Gallina_lexer
 
diff --git a/tools/gallina_lexer.mll b/tools/gallina_lexer.mll
index ce9fb950..0b769dbd 100644
--- a/tools/gallina_lexer.mll
+++ b/tools/gallina_lexer.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: gallina_lexer.mll,v 1.5.6.1 2004/07/16 19:31:46 herbelin Exp $ *)
+(* $Id: gallina_lexer.mll 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 {
  open Lexing
diff --git a/tools/restore-v7 b/tools/restore-v7
deleted file mode 100755
index ab884587..00000000
--- a/tools/restore-v7
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/bin/sh
-
-echo Restoring v7 files from directory v7
-v7files=`find v7 -name \*.v`
-for i in $v7files; do
-  j=`echo $i | sed -e "s@^v7/@@"`
-  echo Restoring $i from v7
-  cp -f $i $j
-done
diff --git a/tools/translate-v8 b/tools/translate-v8
deleted file mode 100755
index 7d71bea9..00000000
--- a/tools/translate-v8
+++ /dev/null
@@ -1,41 +0,0 @@
-#!/bin/sh
-
-if [ -e v7 ]; then
-  echo "Warning: v7 directory found, the files are maybe already translated";
-  sleep 5;
-fi
-echo --------- Producing v8 files in the translation directory -------------
-if [ -e v8 ]; then rm -r v8; fi
-if [ -e /tmp/v7.$$ ]; then rm -r /tmp/v7.$$; fi
-cp -pr . /tmp/v7.$$
-cp -pr /tmp/v7.$$ v8
-cd v8
-rm description toto
-make clean
-make COQFLAGS='-translate -q $(OPT) $(COQLIBS) $(OTHERFLAGS) $(COQ_XML)' || \
- { echo ---- Failed to translate; exit 1; }
-echo --------- Upgrading files in the translation directory ----------------
-v8files=`find . -name \*.v8`
-for i in $v8files; do
-  j=`dirname $i`/`basename $i .v8`.v
-  echo Upgrading $j in the translation directory
-  mv -u -f $i $j
-done
-echo --------- Recompiling v8 files in the translation directory -----------
-make clean
-make || { echo ---- Failed to recompile; exit 1; }
-echo --------- Saving v7 files in directory v7 -----------------------------
-/bin/rm -r ../v7
-mv /tmp/v7.$$ ../v7
-echo Saving v7 files done
-echo --------- Upgrading files in current directory ------------------------
-vfiles=`find . -name \*.v`
-cd ..
-for i in $vfiles; do
-  echo Upgrading $i in current directory
-  mv -u -f v8/$i $i
-done
-echo --------- Translation completed ---------------------------------------
-echo Old files are in directory '"v7"'
-echo New files are in current directory
-echo You can now remove the translation directory '"v8"'
diff --git a/tools/translate_V6-3-1_to_V7-0 b/tools/translate_V6-3-1_to_V7-0
deleted file mode 100755
index 10e7f140..00000000
--- a/tools/translate_V6-3-1_to_V7-0
+++ /dev/null
@@ -1,27 +0,0 @@
-#! /bin/sh
-
-echo "This shell script performs the following transformations:"
-echo "- Insertion of a space after a dot not followed by a separator"
-echo "- Insertion of a space between consecutive ~ and < and between"
-echo "  consecutive | and < assumed to be part of distinct tokens"
-echo "- Various renamings of commands as described in document Changes.ps"
-
-for i in $*
-  do sed -e "s/\.\([A-Z]\)/\. \1/g" -e "s/AddPath/Add LoadPath/g" \
-    -e "s/~</~ </g" -e "s/|</| </g" \
-    -e "s/AddPath/Add LoadPath/g" -e "s/DelPath/Remove LoadPath/g" \
-    -e "s/AddRecPath/Add Rec LoadPath/g" \
-    -e "s/Implicit  *Arguments  *On/Set Implicit Arguments/g" \
-    -e "s/Implicit *Arguments *Off/Unset Implicit Arguments/g" \
-    -e "s/Begin *Silent/Set Silent/g" -e "s/End *Silent/Unset Silent/g" \
-    -e "s/Print *Path/Print Coercion Paths/g" \
-    $i > $i.tmp$$
-  if diff $i.tmp$$ $i > /dev/null
-    then
-      rm $i.tmp$$
-    else
-      echo Le fichier $i a été modifié
-      mv $i.tmp$$ $i
-  fi
-  done
-echo
diff --git a/tools/upgrade-v8 b/tools/upgrade-v8
deleted file mode 100755
index 36d0bf8c..00000000
--- a/tools/upgrade-v8
+++ /dev/null
@@ -1,22 +0,0 @@
-#!/bin/sh
-
-mv v7 v7.bak
-
-echo ---------------- Saving v7 files into directory v7 ------------------
-vfiles=`find . -name \*.v`
-for i in $vfiles; do
-  if expr $i : 'v7\.bak/.*\.v' > /dev/null ; then continue ; fi
-  if expr $i : 'v7/.*\.v' > /dev/null ; then continue ; fi
-  echo Saving $i into v7/$i
-  j=v7/$i
-  mkdir -p `dirname $j`
-  mv -u -f $i $j
-done
-
-echo ---------------- Upgrading files with v8 syntax ---------------------
-v8files=`find . -name \*.v8`
-for i in $v8files; do
-  j=`dirname $i`/`basename $i .v8`.v
-  echo Upgrading $i
-  mv -u -f $i $j
-done
diff --git a/toplevel/cerrors.ml b/toplevel/cerrors.ml
index 21098a57..ab9c4c63 100644
--- a/toplevel/cerrors.ml
+++ b/toplevel/cerrors.ml
@@ -6,14 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: cerrors.ml,v 1.12.2.2 2004/07/16 20:48:17 herbelin Exp $ *)
+(* $Id: cerrors.ml 8003 2006-02-07 22:11:50Z herbelin $ *)
 
 open Pp
 open Util
-open Ast
 open Indtypes
 open Type_errors
 open Pretype_errors
+open Indrec
 open Lexer
 
 let print_loc loc =
@@ -47,8 +47,6 @@ let rec explain_exn_default = function
       hov 0 (str "Out of memory")
   | Stack_overflow -> 
       hov 0 (str "Stack overflow")
-  | Ast.No_match s -> 
-      hov 0 (str "Anomaly: Ast matching error: " ++ str s ++ report ())
   | Anomaly (s,pps) -> 
       hov 1 (str "Anomaly: " ++ where s ++ pps ++ report ())
   | Match_failure(filename,pos1,pos2) ->
@@ -76,9 +74,13 @@ let rec explain_exn_default = function
       hov 0 (str "Error:" ++ spc () ++ Himsg.explain_pretype_error ctx te)
   | InductiveError e -> 
       hov 0 (str "Error:" ++ spc () ++ Himsg.explain_inductive_error e)
+  | RecursionSchemeError e -> 
+      hov 0 (str "Error:" ++ spc () ++ Himsg.explain_recursion_scheme_error e)
   | Cases.PatternMatchingError (env,e) -> 
       hov 0
 	(str "Error:" ++ spc () ++ Himsg.explain_pattern_matching_error env e)
+  | Tacred.ReductionTacticError e -> 
+      hov 0 (str "Error:" ++ spc () ++ Himsg.explain_reduction_tactic_error e)
   | Logic.RefinerError e -> 
       hov 0 (str "Error:" ++ spc () ++ Himsg.explain_refiner_error e)
   | Nametab.GlobalizationError q ->
@@ -90,8 +92,7 @@ let rec explain_exn_default = function
       hov 0 (str "Error:" ++ spc () ++
 	       str "No constant of this name:" ++ spc () ++ Libnames.pr_qualid q)
   | Refiner.FailError (i,s) ->
-      let s = if s="" then "" else " \""^s^"\"" in
-      hov 0 (str "Error: Tactic failure" ++ str s ++
+      hov 0 (str "Error: Tactic failure" ++ s ++
              if i=0 then mt () else str " (level " ++ int i ++ str").")
   | Stdpp.Exc_located (loc,exc) ->
       hov 0 ((if loc = dummy_loc then (mt ())
diff --git a/toplevel/cerrors.mli b/toplevel/cerrors.mli
index 09d79cec..1236ecf5 100644
--- a/toplevel/cerrors.mli
+++ b/toplevel/cerrors.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: cerrors.mli,v 1.2.6.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: cerrors.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Pp
diff --git a/toplevel/class.ml b/toplevel/class.ml
index f5493929..5f385934 100644
--- a/toplevel/class.ml
+++ b/toplevel/class.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: class.ml,v 1.44.2.3 2004/11/26 18:06:54 herbelin Exp $ *)
+(* $Id: class.ml 7941 2006-01-28 23:07:59Z herbelin $ *)
 
 open Util
 open Pp
@@ -92,42 +92,16 @@ let explain_coercion_error g = function
 
 (* Verifications pour l'ajout d'une classe *)
 
-let rec arity_sort (ctx,a) = match kind_of_term a with
-  | Sort (Prop _ | Type _) -> List.length ctx
-  | _ -> raise Not_found
-
 let check_reference_arity ref =
-  let t = Global.type_of_global ref in
-  try arity_sort (Reductionops.splay_prod (Global.env()) Evd.empty t)
-  with Not_found -> raise (CoercionError (NotAClass ref))
+  if not (Reductionops.is_arity (Global.env()) Evd.empty (Global.type_of_global ref)) then
+    raise (CoercionError (NotAClass ref))
 
 let check_arity = function
-  | CL_FUN | CL_SORT -> 0
+  | CL_FUN | CL_SORT -> ()
   | CL_CONST sp -> check_reference_arity (ConstRef sp)
   | CL_SECVAR sp -> check_reference_arity (VarRef sp)
   | CL_IND sp  -> check_reference_arity (IndRef sp)
 
-(* try_add_class : cl_typ -> strength option -> bool -> unit *)
-
-let strength_of_cl = function 
-  | CL_CONST kn -> constant_strength (sp_of_global (ConstRef kn))
-  | CL_SECVAR sp -> variable_strength sp
-  | _ -> Global
-
-let try_add_class cl streopt fail_if_exists =
-  if not (class_exists cl) then
-    let p = check_arity cl in
-    let stre' = strength_of_cl cl in 
-    let stre = match streopt with
-      | Some stre -> strength_min (stre,stre')
-      | None -> stre'
-    in
-    declare_class (cl,stre,p)
-  else
-    if fail_if_exists then errorlabstrm "try_add_new_class" 
-      (pr_class cl ++ str " is already a class")
-
-
 (* Coercions *)
 
 (* check that the computed target is the provided one *)
@@ -148,18 +122,18 @@ let uniform_cond nargs lt =
 let id_of_cl  = function
   | CL_FUN -> id_of_string "FUNCLASS"
   | CL_SORT -> id_of_string "SORTCLASS"
-  | CL_CONST kn -> id_of_label (label kn)
+  | CL_CONST kn -> id_of_label (con_label kn)
   | CL_IND ind ->
       let (_,mip) = Global.lookup_inductive ind in
       mip.mind_typename
   | CL_SECVAR id -> id
 
-let class_of_ref = function
+let class_of_global = function
   | ConstRef sp -> CL_CONST sp
   | IndRef sp -> CL_IND sp
   | VarRef id -> CL_SECVAR id
   | ConstructRef _ as c -> 
-      errorlabstrm "class_of_ref"
+      errorlabstrm "class_of_global"
 	(str "Constructors, such as " ++ Printer.pr_global c ++ 
 	   str " cannot be used as class")
 
@@ -204,14 +178,19 @@ let get_target t ind =
 let prods_of t = 
   let rec aux acc d = match kind_of_term d with
     | Prod (_,c1,c2) -> aux (c1::acc) c2
-    | Cast (c,_) -> aux acc c
+    | Cast (c,_,_) -> aux acc c
     | _ -> (d,acc)
   in 
   aux [] t
 
+let strength_of_cl = function 
+  | CL_CONST kn -> constant_strength (sp_of_global (ConstRef kn))
+  | CL_SECVAR sp -> variable_strength sp
+  | _ -> Global
+
 let get_strength stre ref cls clt =
-  let stres = (snd (class_info cls)).cl_strength in
-  let stret = (snd (class_info clt)).cl_strength in
+  let stres = strength_of_cl cls in
+  let stret = strength_of_cl clt in
   let stref = strength_of_global ref in
 (* 01/00: Supprimé la prise en compte de la force des variables locales. Sens ?
   let streunif = stre_unif_cond (s_vardep,f_vardep) in
@@ -265,10 +244,11 @@ let build_id_coercion idf_opt source =
   in
   let constr_entry = (* Cast is necessary to express [val_f] is identity *)
     DefinitionEntry
-      { const_entry_body = mkCast (val_f, typ_f);
+      { const_entry_body = mkCast (val_f, DEFAULTcast, typ_f);
 	const_entry_type = Some typ_f;
-        const_entry_opaque = false } in
-  let (_,kn) = declare_constant idf (constr_entry,Decl_kinds.IsDefinition) in
+        const_entry_opaque = false;
+	const_entry_boxed = Options.boxed_definitions()} in
+  let kn = declare_constant idf (constr_entry,IsDefinition IdentityCoercion) in
   ConstRef kn
 
 let check_source = function
@@ -288,11 +268,9 @@ lorque source est None alors target est None aussi.
 
 let add_new_coercion_core coef stre source target isid =
   check_source source;
-  let env = Global.env () in
-  let v = constr_of_reference coef in
-  let vj = Retyping.get_judgment_of env Evd.empty v in
+  let t = Global.type_of_global coef in
   if coercion_exists coef then raise (CoercionError AlreadyExists);
-  let tg,lp = prods_of (vj.uj_type) in
+  let tg,lp = prods_of t in
   let llp = List.length lp in
   if llp = 0 then raise (CoercionError NotAFunction);
   let (cls,lvs,ind) =
@@ -311,10 +289,10 @@ let add_new_coercion_core coef stre source target isid =
       raise (CoercionError NoTarget)
   in
   check_target clt target;
-  try_add_class cls None false;
-  try_add_class clt None false;
+  check_arity cls;
+  check_arity clt;
   let stre' = get_strength stre coef cls clt in
-  declare_coercion coef vj stre' isid cls clt (List.length lvs)
+  declare_coercion coef stre' isid cls clt (List.length lvs)
 
 let try_add_new_coercion_core ref b c d e =
   try add_new_coercion_core ref b c d e
@@ -345,114 +323,5 @@ let add_coercion_hook stre ref =
     ^ " is now a coercion")
 
 let add_subclass_hook stre ref =
-  let cl = class_of_ref ref in
+  let cl = class_of_global ref in
   try_add_new_coercion_subclass cl stre
-
-(* try_add_new_class : global_reference -> strength -> unit *)
-
-let class_of_global = function
-  | VarRef sp -> CL_SECVAR sp
-  | ConstRef sp -> CL_CONST sp
-  | IndRef sp -> CL_IND sp
-  | ConstructRef _ as ref -> raise (CoercionError (NotAClass ref))
-
-let try_add_new_class ref stre =
-  try try_add_class (class_of_global ref) (Some stre) true
-  with CoercionError e ->
-    errorlabstrm "try_add_new_class" (explain_coercion_error ref e)
-
-(* fonctions pour le discharge: encore un peu sale mais ça s'améliore *)
-
-type coercion_entry = 
-    global_reference * strength * bool * cl_typ * cl_typ * int
-
-let add_new_coercion (ref,stre,isid,cls,clt,n) =
-  (* Un peu lourd, tout cela pour trouver l'instance *)
-  let env = Global.env () in
-  let v = constr_of_reference ref in
-  let vj = Retyping.get_judgment_of env Evd.empty v in
-  declare_coercion ref vj stre isid cls clt n
-
-let count_extra_abstractions hyps ids_to_discard =
-  let _,n =
-    List.fold_left
-      (fun (hyps,n as sofar) id -> 
-	 match hyps with
-	   | (hyp,None,_)::rest when id = hyp ->(rest, n+1)
-	   | _ -> sofar)
-      (hyps,0) ids_to_discard
-  in n
-
-let defined_in_sec kn olddir = 
-  let _,dir,_ = repr_kn kn in
-    dir = olddir
-
-(* This moves the global path one step below *)
-let process_global olddir = function
-  | VarRef _ ->
-      anomaly "process_global only processes global surviving the section"
-  | ConstRef kn as x ->
-      if defined_in_sec kn olddir then
-        let newkn = Lib.make_kn (id_of_label (label kn)) in
-        ConstRef newkn
-      else x
-  | IndRef (kn,i) as x -> 
-      if defined_in_sec kn olddir then
-        let newkn = Lib.make_kn (id_of_label (label kn)) in
-        IndRef (newkn,i)
-      else x
-  | ConstructRef ((kn,i),j) as x -> 
-      if defined_in_sec kn olddir then
-        let newkn = Lib.make_kn (id_of_label (label kn)) in
-        ConstructRef ((newkn,i),j)
-      else x
-
-let process_class olddir ids_to_discard x =
-  let (cl,{cl_strength=stre; cl_param=p}) = x in
-(*  let env = Global.env () in*)
-  match cl with 
-    | CL_SECVAR _ -> x
-    | CL_CONST kn -> 
-       if defined_in_sec kn olddir then
-         let newkn = Lib.make_kn (id_of_label (label kn)) in
-	 let hyps = (Global.lookup_constant kn).const_hyps in
-	 let n = count_extra_abstractions hyps ids_to_discard in
-           (CL_CONST newkn,{cl_strength=stre;cl_param=p+n})
-       else 
-	 x
-    | CL_IND (kn,i) ->
-	if defined_in_sec kn olddir then
-          let newkn = Lib.make_kn (id_of_label (label kn)) in
-	  let hyps = (Global.lookup_mind kn).mind_hyps in
-	  let n = count_extra_abstractions hyps ids_to_discard in
-          (CL_IND (newkn,i),{cl_strength=stre;cl_param=p+n})
-        else 
-	  x
-    | _ -> anomaly "process_class" 
-
-let process_cl sec_sp cl =
-  match cl with
-    | CL_SECVAR id -> cl
-    | CL_CONST kn ->
-	if defined_in_sec kn sec_sp then
-          let newkn = Lib.make_kn (id_of_label (label kn)) in
-          CL_CONST newkn
-        else 
-	  cl
-    | CL_IND (kn,i) ->
-	if defined_in_sec kn sec_sp then
-          let newkn = Lib.make_kn (id_of_label (label kn)) in
-          CL_IND (newkn,i)
-        else 
-	  cl
-    | _ -> cl
-
-let process_coercion olddir ids_to_discard (coe,coeinfo,cls,clt) =
-  let hyps = context_of_global_reference coe in
-  let nargs = count_extra_abstractions hyps ids_to_discard in
-  (process_global olddir coe,
-   coercion_strength coeinfo,
-   coercion_identity coeinfo,
-   process_cl olddir cls,
-   process_cl olddir clt,
-   nargs + coercion_params coeinfo)
diff --git a/toplevel/class.mli b/toplevel/class.mli
index b0350985..7717d754 100644
--- a/toplevel/class.mli
+++ b/toplevel/class.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: class.mli,v 1.17.6.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: class.mli 6748 2005-02-18 22:17:50Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -50,19 +50,4 @@ val add_coercion_hook : Tacexpr.declaration_hook
 
 val add_subclass_hook : Tacexpr.declaration_hook
 
-(* [try_add_new_class ref] declares [ref] as a new class; usually,
-   this is done implicitely by [try_add_new_coercion]'s functions *)
-val try_add_new_class : global_reference -> strength -> unit
-
-(*s This is used for the discharge *)
-type coercion_entry
-
-val add_new_coercion : coercion_entry -> unit
-
-val process_class :
-  dir_path -> identifier list -> 
-    (cl_typ * cl_info_typ) -> (cl_typ * cl_info_typ)
-val process_coercion :
-  dir_path -> identifier list -> coercion -> coercion_entry
-
-val class_of_ref : global_reference -> cl_typ
+val class_of_global : global_reference -> cl_typ
diff --git a/toplevel/command.ml b/toplevel/command.ml
index 10d6a620..7ff1b1b5 100644
--- a/toplevel/command.ml
+++ b/toplevel/command.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: command.ml,v 1.116.2.4 2005/11/29 21:40:53 letouzey Exp $ *)
+(* $Id: command.ml 8689 2006-04-07 20:20:16Z herbelin $ *)
 
 open Pp
 open Util
@@ -18,7 +18,7 @@ open Entries
 open Inductive
 open Environ
 open Reduction
-open Tacred
+open Redexpr
 open Declare
 open Nametab
 open Names
@@ -37,31 +37,45 @@ open Indtypes
 open Vernacexpr
 open Decl_kinds
 open Pretyping
-open Symbols
+open Notation
 
 let mkLambdaCit = List.fold_right (fun (x,a) b -> mkLambdaC(x,a,b))
 let mkProdCit = List.fold_right (fun (x,a) b -> mkProdC(x,a,b))
 
-let rec abstract_rawconstr c = function
+let rec abstract_constr_expr c = function
   | [] -> c
-  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,abstract_rawconstr c bl)
+  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,abstract_constr_expr c bl)
   | LocalRawAssum (idl,t)::bl ->
       List.fold_right (fun x b -> mkLambdaC([x],t,b)) idl
-        (abstract_rawconstr c bl)
+        (abstract_constr_expr c bl)
 
-let rec generalize_rawconstr c = function
+let rec generalize_constr_expr c = function
   | [] -> c
-  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,generalize_rawconstr c bl)
+  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,generalize_constr_expr c bl)
   | LocalRawAssum (idl,t)::bl ->
       List.fold_right (fun x b -> mkProdC([x],t,b)) idl
-        (generalize_rawconstr c bl)
+        (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
+      | Lambda (x,t,c) ->
+	  mkLambda (x,t,under_binders (push_rel (x,None,t) env) f (n-1) c)
+      | LetIn (x,b,t,c) ->
+	  mkLetIn (x,b,t,under_binders (push_rel (x,Some b,t) env) f (n-1) c)
+      | _ -> assert false
 
 let rec destSubCast c = match kind_of_term c with
   | Lambda (x,t,c) -> 
       let (b,u) = destSubCast c in mkLambda (x,t,b), mkProd (x,t,u)
   | LetIn (x,b,t,c) ->
       let (d,u) = destSubCast c in mkLetIn (x,b,t,d), mkLetIn (x,b,t,u)
-  | Cast (b,u) -> (b,u)
+  | Cast (b,_, u) -> (b,u)
   | _ -> assert false
 
 let rec adjust_conclusion a cs = function
@@ -84,63 +98,51 @@ let rec adjust_conclusion a cs = function
 let definition_message id =
   if_verbose message ((string_of_id id) ^ " is defined")
 
-let constant_entry_of_com (bl,com,comtypopt,opacity) =
+let constant_entry_of_com (bl,com,comtypopt,opacity,boxed) =
   let sigma = Evd.empty in
   let env = Global.env() in
   match comtypopt with
       None -> 
-	let b = abstract_rawconstr com bl in
-	let j = judgment_of_rawconstr sigma env b in
+	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 (Evarutil.refresh_universes j.uj_type);
-          const_entry_opaque = opacity }
+	  const_entry_type = Some (refresh_universes j.uj_type);
+          const_entry_opaque = opacity;
+	  const_entry_boxed = boxed }
     | Some comtyp ->
 	(* We use a cast to avoid troubles with evars in comtyp *)
 	(* that can only be resolved knowing com *)
-	let b = abstract_rawconstr (mkCastC (com,comtyp)) bl in
+	let b = abstract_constr_expr (mkCastC (com,DEFAULTcast,comtyp)) bl in
 	let (body,typ) = destSubCast (interp_constr sigma env b) in
 	{ const_entry_body = body;
 	  const_entry_type = Some typ;
-          const_entry_opaque = opacity }
-
-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
-      | Lambda (x,t,c) ->
-        mkLambda (x,t,under_binders (push_rel (x,None,t) env) f (n-1) c)
-      | LetIn (x,b,t,c) ->
-        mkLetIn (x,b,t,under_binders (push_rel (x,Some b,t) env) f (n-1) c)
-      | _ -> assert false
+          const_entry_opaque = opacity;
+	  const_entry_boxed = boxed }
 
 let red_constant_entry bl ce = function
   | None -> ce
   | Some red ->
       let body = ce.const_entry_body in
       { ce with const_entry_body = 
-      under_binders (Global.env()) (reduction_of_redexp red)
-        (length_of_raw_binders bl)
-        body }
+	under_binders (Global.env()) (fst (reduction_of_red_expr red))
+	  (length_of_raw_binders bl)
+	  body }
 
 let declare_global_definition ident ce local =
-  let (_,kn) = declare_constant ident (DefinitionEntry ce,IsDefinition) in
-  if local = Local then
+  let kn = declare_constant ident (DefinitionEntry ce,IsDefinition Definition) in
+  if local = Local && Options.is_verbose() then
     msg_warning (pr_id ident ++ str" is declared as a global definition");
   definition_message ident;
   ConstRef kn
 
-let declare_definition ident (local,_) bl red_option c typopt hook =
-  let ce = constant_entry_of_com (bl,c,typopt,false) in
+let declare_definition ident (local,boxed,dok) bl red_option c typopt hook =
+  let ce = constant_entry_of_com (bl,c,typopt,false,boxed) in
   let ce' = red_constant_entry bl ce red_option in
   let r = match local with
     | Local when Lib.sections_are_opened () ->
         let c =
           SectionLocalDef(ce'.const_entry_body,ce'.const_entry_type,false) in
-        let _ = declare_variable ident (Lib.cwd(), c, IsDefinition) in
+        let _ = declare_variable ident (Lib.cwd(),c,IsDefinition Definition) in
         definition_message ident;
         if Pfedit.refining () then 
           msgerrnl (str"Warning: Local definition " ++ pr_id ident ++ 
@@ -152,7 +154,6 @@ let declare_definition ident (local,_) bl red_option c typopt hook =
 
 let syntax_definition ident c local onlyparse =
   let c = snd (interp_aconstr [] [] c) in
-  let onlyparse = !Options.v7_only or onlyparse in
   Syntax_def.declare_syntactic_definition local ident onlyparse c
 
 (* 2| Variable/Hypothesis/Parameter/Axiom declarations *)
@@ -163,7 +164,7 @@ let assumption_message id =
 let declare_one_assumption is_coe (local,kind) c (_,ident) =
   let r = match local with
     | Local when Lib.sections_are_opened () ->
-        let r = 
+        let _ = 
           declare_variable ident 
             (Lib.cwd(), SectionLocalAssum c, IsAssumption kind) in
         assumption_message ident;
@@ -172,7 +173,7 @@ let declare_one_assumption is_coe (local,kind) c (_,ident) =
           str" is not visible from current goals");
         VarRef ident
     | (Global|Local) ->
-        let (_,kn) =
+        let kn =
           declare_constant ident (ParameterEntry c, IsAssumption kind) in
         assumption_message ident;
         if local=Local & Options.is_verbose () then
@@ -182,9 +183,13 @@ let declare_one_assumption is_coe (local,kind) c (_,ident) =
   if is_coe then Class.try_add_new_coercion r local
 
 let declare_assumption idl is_coe k bl c =
-  let c = generalize_rawconstr c bl in
-  let c = interp_type Evd.empty (Global.env()) c in
-  List.iter (declare_one_assumption is_coe k c) idl
+  if not (Pfedit.refining ()) then 
+    let c = generalize_constr_expr c bl in
+    let c = interp_type Evd.empty (Global.env()) c in
+      List.iter (declare_one_assumption is_coe k c) idl
+  else
+    errorlabstrm "Command.Assumption"
+	(str "Cannot declare an assumption while in proof editing mode.")
 
 (* 3a| Elimination schemes for mutual inductive definitions *)
 
@@ -203,16 +208,17 @@ let declare_one_elimination ind =
       (DefinitionEntry
         { const_entry_body = c;
           const_entry_type = t;
-          const_entry_opaque = false }, 
-       Decl_kinds.IsDefinition) in
+          const_entry_opaque = false;
+	  const_entry_boxed = Options.boxed_definitions() }, 
+       Decl_kinds.IsDefinition Definition) in
     definition_message id;
     kn
   in
   let env = Global.env () in
   let sigma = Evd.empty in
   let elim_scheme = Indrec.build_indrec env sigma ind in
-  let npars = mip.mind_nparams in
-  let make_elim s = Indrec.instanciate_indrec_scheme s npars elim_scheme in
+  let npars = mib.mind_nparams_rec in
+  let make_elim s = Indrec.instantiate_indrec_scheme s npars elim_scheme in
   let kelim = mip.mind_kelim in
   (* in case the inductive has a type elimination, generates only one
      induction scheme, the other ones share the same code with the
@@ -220,10 +226,10 @@ 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 (snd cte) and t = constant_type (Global.env()) (snd cte) in
+    let c = mkConst cte and t = constant_type (Global.env()) cte in
     List.iter (fun (sort,suff) -> 
       let (t',c') = 
-	Indrec.instanciate_type_indrec_scheme (new_sort_in_family sort)
+	Indrec.instantiate_type_indrec_scheme (new_sort_in_family sort)
 	  npars c t in
       let _ = declare (mindstr^suff) c' (Some t') in ())
       non_type_eliminations
@@ -270,27 +276,9 @@ let interp_mutual lparams lnamearconstrs finite =
       [] lnamearconstrs in
   if not (list_distinct allnames) then
     error "Two inductive objects have the same name";
-  let nparams = local_binders_length lparams
-  and sigma = Evd.empty 
-  and env0 = Global.env() in
-  let env_params, params =
-    List.fold_left
-      (fun (env, params) d -> match d with
-	| LocalRawAssum ([_,na],(CHole _ as t)) ->
-	    let t = interp_binder sigma env na t in
-	    let d = (na,None,t) in
-	    (push_rel d env, d::params)
-	| LocalRawAssum (nal,t) ->
-	    let t = interp_type sigma 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 = judgment_of_rawconstr sigma env c in
-	    let d = (na, Some c.uj_val, c.uj_type) in
-	    (push_rel d env,d::params))
-      (env0,[]) lparams
-  in
+  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) ->
@@ -304,8 +292,6 @@ let interp_mutual lparams lnamearconstrs finite =
   let paramassums = 
     List.fold_right (fun d l -> match d with
 	(id,LocalAssum _) -> id::l | (_,LocalDef _) -> l) params' [] in
-  let indnames =
-    List.map (fun (id,_,_,_)-> id) lnamearconstrs @ paramassums in
   let nparamassums = List.length paramassums in
   let (ind_env,ind_impls,arityl) =
     List.fold_left
@@ -316,7 +302,7 @@ let interp_mutual lparams lnamearconstrs finite =
 	 let argsc = compute_arguments_scope fullarity in
 	 let ind_impls' = 
 	   if Impargs.is_implicit_args() then
-	     let impl = Impargs.compute_implicits false env_params fullarity in
+	     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
@@ -337,8 +323,9 @@ let interp_mutual lparams lnamearconstrs finite =
   let fs = States.freeze() in
   (* Declare the notations for the inductive types pushed in local context*)
   try
-  List.iter (fun (df,c,scope) -> (* No scope for tmp notation *)
-    Metasyntax.add_notation_interpretation df ind_impls c None) notations;
+  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 = 
@@ -358,21 +345,20 @@ let interp_mutual lparams lnamearconstrs finite =
          (* Interpret the constructor types *)
          let constrs =
 	   List.map 
-	     (interp_type_with_implicits sigma ind_env_params
-	       (paramassums,ind_impls))
+	     (interp_type sigma ind_env_params ~impls:(paramassums,ind_impls))
 	     bodies
 	 in
 
          (* Build the inductive entry *)
-	 { mind_entry_params = params';
-	   mind_entry_typename = name;
+	 { 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_record = false; 
+  notations, { mind_entry_params = params';
+	       mind_entry_record = false; 
 	       mind_entry_finite = finite; 
 	       mind_entry_inds = mispecvec }
   with e -> States.unfreeze fs; raise e
@@ -388,6 +374,7 @@ let declare_mutual_with_eliminations isrecord mie =
 (* 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') ->
@@ -422,7 +409,7 @@ let extract_coe_la_lc = function
 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 kn = declare_mutual_with_eliminations false mie 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;
@@ -465,7 +452,8 @@ let collect_non_rec env =
   in 
   searchrec [] 
 
-let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list)  =
+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()
@@ -474,11 +462,11 @@ let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list)  =
   let (rec_sign,rec_impls,arityl) = 
     List.fold_left 
       (fun (env,impls,arl) ((recname,_,bl,arityc,_),_) -> 
-        let arityc = generalize_rawconstr arityc bl in
+        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 false env0 arity
+	  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))
@@ -494,13 +482,15 @@ let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list)  =
     let fs = States.freeze() in
     let def = 
       try
-	List.iter (fun (df,c,scope) -> (* No scope for tmp notation *)
-	 Metasyntax.add_notation_interpretation df rec_impls c None) notations;
+	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_rawconstr def bl in
-            interp_casted_constr_with_implicits 
-	      sigma rec_sign rec_impls 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
@@ -514,11 +504,12 @@ let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list)  =
   let recdecls = (Array.map (fun id -> Name id) namerec, arrec, recvec) in
   let rec declare i fi =
     let ce = 
-      { const_entry_body = mkFix ((nvrec,i),recdecls);
+      { const_entry_body = mkFix ((Array.map fst nvrec,i),recdecls); (* ignore rec order *)
         const_entry_type = Some arrec.(i);
-        const_entry_opaque = false } in
-    let (_,kn) = declare_constant fi (DefinitionEntry ce, IsDefinition) in
-    (ConstRef kn)
+        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
@@ -530,8 +521,11 @@ let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list)  =
       (fun subst (f,def,t) ->
 	 let ce = { const_entry_body = replace_vars subst def;
 		    const_entry_type = Some t;
-                    const_entry_opaque = false } in
-	 let _ = declare_constant f (DefinitionEntry ce, IsDefinition) in
+                    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))
@@ -540,7 +534,7 @@ let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list)  =
   List.iter (fun (df,c,scope) ->
     Metasyntax.add_notation_interpretation df [] c scope) notations
 
-let build_corecursive lnameardef = 
+let build_corecursive lnameardef boxed = 
   let lrecnames = List.map (fun (f,_,_,_) -> f) lnameardef
   and sigma = Evd.empty
   and env0 = Global.env() in
@@ -549,11 +543,10 @@ let build_corecursive lnameardef =
     try 
       List.fold_left 
         (fun (env,arl) (recname,bl,arityc,_) -> 
-           let arityc = generalize_rawconstr arityc bl in
-           let arj = type_judgment_of_rawconstr Evd.empty env0 arityc in
-	   let arity = arj.utj_val in
+           let arityc = generalize_constr_expr arityc bl in
+           let arity = interp_type Evd.empty env0 arityc in
            let _ = declare_variable recname
-	     (Lib.cwd(),SectionLocalAssum arj.utj_val,IsAssumption Definitional) in
+	     (Lib.cwd(),SectionLocalAssum arity,IsAssumption Definitional) in
            (Environ.push_named (recname,None,arity) env, (arity::arl)))
         (env0,[]) lnameardef
     with e -> 
@@ -562,10 +555,10 @@ let build_corecursive lnameardef =
   let recdef =
     try 
       List.map (fun (_,bl,arityc,def) ->
-        let arityc = generalize_rawconstr arityc bl in
-        let def = abstract_rawconstr def bl in
+        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)
+        interp_casted_constr sigma rec_sign def arity)
         lnameardef
     with e -> 
       States.unfreeze fs; raise e 
@@ -580,10 +573,11 @@ let build_corecursive lnameardef =
     let ce = 
       { const_entry_body = mkCoFix (i, recdecls);
         const_entry_type = Some (arrec.(i));
-        const_entry_opaque = false } 
+        const_entry_opaque = false;
+        const_entry_boxed = boxed } 
     in
-    let _,kn = declare_constant fi (DefinitionEntry ce, IsDefinition) in
-    (ConstRef kn)
+    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);
@@ -593,8 +587,10 @@ let build_corecursive lnameardef =
       (fun subst (f,def,t) ->
 	 let ce = { const_entry_body = replace_vars subst def;
 		    const_entry_type = Some t;
-                    const_entry_opaque = false } in
-	 let _ = declare_constant f (DefinitionEntry ce,IsDefinition) in
+                    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))
@@ -616,11 +612,12 @@ let build_scheme lnamedepindsort =
   let listdecl = Indrec.build_mutual_indrec env0 sigma lrecspec in 
   let rec declare decl fi lrecref =
     let decltype = Retyping.get_type_of env0 Evd.empty decl in
-    let decltype = Evarutil.refresh_universes decltype in
+    let decltype = refresh_universes decltype in
     let ce = { const_entry_body = decl;
                const_entry_type = Some decltype;
-               const_entry_opaque = false } in
-    let _,kn = declare_constant fi (DefinitionEntry ce, IsDefinition) in
+               const_entry_opaque = false;
+	       const_entry_boxed = Options.boxed_definitions() } in
+    let kn = declare_constant fi (DefinitionEntry ce, IsDefinition Scheme) in
     ConstRef kn :: lrecref
   in 
   let lrecref = List.fold_right2 declare listdecl lrecnames [] in
@@ -643,29 +640,30 @@ let start_proof_com sopt kind (bl,t) hook =
  	  (Pfedit.get_all_proof_names ())
   in
   let env = Global.env () in
-  let c = interp_type Evd.empty env (generalize_rawconstr t bl) in
+  let c = interp_type Evd.empty env (generalize_constr_expr t bl) in
   let _ = Typeops.infer_type env c in
   start_proof id kind c hook
 
-let save id const kind hook =
+let save id const (locality,kind) hook =
   let {const_entry_body = pft;
        const_entry_type = tpo;
        const_entry_opaque = opacity } = const in
-  let l,r = match kind with
-    | IsLocal when Lib.sections_are_opened () ->
+  let l,r = match locality with
+    | Local when Lib.sections_are_opened () ->
+        let k = logical_kind_of_goal_kind kind in
 	let c = SectionLocalDef (pft, tpo, opacity) in
-	let _ = declare_variable id (Lib.cwd(), c, IsDefinition) in
+	let _ = declare_variable id (Lib.cwd(), c, k) in
 	(Local, VarRef id)
-    | IsLocal ->
-        let k = IsDefinition in
-        let _,kn = declare_constant id (DefinitionEntry const, k) in
+    | Local ->
+        let k = logical_kind_of_goal_kind kind in
+        let kn = declare_constant id (DefinitionEntry const, k) in
 	(Global, ConstRef kn)
-    | IsGlobal k ->
-        let k = theorem_kind_of_goal_kind k in
-        let _,kn = declare_constant id (DefinitionEntry const, k) in
+    | Global ->
+        let k = logical_kind_of_goal_kind kind in
+        let kn = declare_constant id (DefinitionEntry const, k) in
 	(Global, ConstRef kn) in
-  hook l r;
   Pfedit.delete_current_proof ();
+  hook l r;
   definition_message id
 
 let save_named opacity =
@@ -691,7 +689,7 @@ let save_anonymous_with_strength kind opacity save_ident =
   let const = { const with const_entry_opaque = opacity } in
   check_anonymity id save_ident;
   (* we consider that non opaque behaves as local for discharge *)
-  save save_ident const (IsGlobal (Proof kind)) hook
+  save save_ident const (Global, Proof kind) hook
 
 let admit () =
   let (id,k,typ,hook) = Pfedit.current_proof_statement () in
@@ -699,9 +697,10 @@ let admit () =
   if k <> IsGlobal (Proof Conjecture) then
     error "Only statements declared as conjecture can be admitted";
 *)
-  let (_,kn) = declare_constant id (ParameterEntry typ, IsConjecture) in
-  hook Global (ConstRef kn);
+  let kn =
+    declare_constant id (ParameterEntry typ, IsAssumption Conjectural) in
   Pfedit.delete_current_proof ();
+  hook Global (ConstRef kn);
   assumption_message id
 
 let get_current_context () =
diff --git a/toplevel/command.mli b/toplevel/command.mli
index 7997288c..c93f69be 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,v 1.38.2.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: command.mli 7682 2005-12-21 15:06:11Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -22,6 +22,7 @@ open Vernacexpr
 open Rawterm
 open Topconstr
 open Decl_kinds
+open Redexpr
 (*i*)
 
 (*s Declaration functions. The following functions take ASTs,
@@ -30,7 +31,7 @@ open Decl_kinds
    defined object *)
 
 val declare_definition : identifier -> definition_kind ->
-  local_binder list -> Tacred.red_expr option -> constr_expr ->
+  local_binder list -> red_expr option -> constr_expr ->
     constr_expr option -> declaration_hook -> unit
 
 val syntax_definition : identifier -> constr_expr -> bool -> bool -> unit
@@ -43,13 +44,13 @@ val build_mutual : inductive_expr list -> bool -> unit
 val declare_mutual_with_eliminations :
   bool -> Entries.mutual_inductive_entry -> mutual_inductive
 
-val build_recursive : (fixpoint_expr * decl_notation) list -> unit
+val build_recursive : (fixpoint_expr * decl_notation) list -> bool -> unit
 
-val build_corecursive : cofixpoint_expr list -> unit
+val build_corecursive : cofixpoint_expr list -> bool -> unit
 
 val build_scheme : (identifier located * bool * reference * rawsort) list -> unit
 
-val generalize_rawconstr : constr_expr -> local_binder list -> constr_expr
+val generalize_constr_expr : constr_expr -> local_binder list -> constr_expr
 
 val start_proof : identifier -> goal_kind -> constr ->
   declaration_hook -> unit
@@ -83,3 +84,5 @@ val admit : unit -> unit
    and the current global env *)
 
 val get_current_context : unit -> Evd.evar_map * Environ.env
+
+
diff --git a/toplevel/coqinit.ml b/toplevel/coqinit.ml
index 4ba8f6c2..44b2e231 100644
--- a/toplevel/coqinit.ml
+++ b/toplevel/coqinit.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqinit.ml,v 1.30.2.4 2006/01/11 23:18:06 barras Exp $ *)
+(* $Id: coqinit.ml 7732 2005-12-26 13:51:24Z herbelin $ *)
 
 open Pp
 open System
@@ -73,23 +73,19 @@ let init_load_path () =
   (* developper specific directories to open *)
   let dev = if Coq_config.local then [ "dev" ] else [] in
   let coqlib =
-    if !Options.boot then Coq_config.coqtop
-      (* variable COQLIB overrides the default library *)
-    else getenv_else "COQLIB" Coq_config.coqlib in
-  let coqlib = canonical_path_name coqlib in
+    (* variable COQLIB overrides the default library *)
+    getenv_else "COQLIB"
+      (if Coq_config.local || !Options.boot then Coq_config.coqtop
+       else Coq_config.coqlib) in
   (* first user-contrib *)
   let user_contrib = coqlib/"user-contrib" in
   if Sys.file_exists user_contrib then 
-    Mltop.add_path user_contrib Nameops.default_root_prefix;
+    Mltop.add_rec_path user_contrib Nameops.default_root_prefix;
   (* then standard library *)
-  let vdirs = 
-    if !Options.v7 then [ "theories7"; "contrib7" ]
-    else [ "theories"; "contrib" ] in
-  let dirs = 
-    (if !Options.v7 then "states7" else "states") :: dev @ vdirs in
+  let vdirs = [ "theories"; "contrib" ] in
+  let dirs = "states" :: dev @ vdirs in
   List.iter (fun s -> coq_add_rec_path (coqlib/s)) dirs;
   let camlp4 = getenv_else "CAMLP4LIB" Coq_config.camlp4lib in
-  let camlp4 = canonical_path_name camlp4 in
   add_ml_include camlp4;
   (* then current directory *)
   Mltop.add_path "." Nameops.default_root_prefix;
diff --git a/toplevel/coqinit.mli b/toplevel/coqinit.mli
index e029d8ac..d7856170 100644
--- a/toplevel/coqinit.mli
+++ b/toplevel/coqinit.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coqinit.mli,v 1.7.16.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: coqinit.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Initialization. *)
 
diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml
index af787460..c3f79e0a 100644
--- a/toplevel/coqtop.ml
+++ b/toplevel/coqtop.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqtop.ml,v 1.72.2.5 2005/11/23 14:46:09 barras Exp $ *)
+(* $Id: coqtop.ml 7740 2005-12-26 20:07:21Z herbelin $ *)
 
 open Pp
 open Util
@@ -29,9 +29,8 @@ let get_version_date () =
   with _ -> Coq_config.date
 
 let print_header () =
-  Printf.printf "Welcome to Coq %s%s (%s)\n"
+  Printf.printf "Welcome to Coq %s (%s)\n" 
     Coq_config.version 
-    (if !Options.v7 then " (V7 syntax)" else "")
     (get_version_date ());
   flush stdout
 
@@ -50,8 +49,10 @@ let engage () =
   
 let set_batch_mode () = batch_mode := true
 
-let toplevel_name = ref (make_dirpath [id_of_string "Top"])
-let set_toplevel_name dir = toplevel_name := dir
+let toplevel_default_name = make_dirpath [id_of_string "Top"]
+let toplevel_name = ref (Some toplevel_default_name)
+let set_toplevel_name dir = toplevel_name := Some dir
+let unset_toplevel_name () = toplevel_name := None
 
 let remove_top_ml () = Mltop.remove ()
 
@@ -91,12 +92,13 @@ let load_vernacular () =
 let load_vernacular_obj = ref ([] : string list)
 let add_vernac_obj s = load_vernacular_obj := s :: !load_vernacular_obj
 let load_vernac_obj () = 
-  List.iter Library.read_library_from_file (List.rev !load_vernacular_obj)
+  List.iter (fun f -> Library.require_library_from_file None f None)
+    (List.rev !load_vernacular_obj)
 
 let require_list = ref ([] : string list)
 let add_require s = require_list := s :: !require_list
 let require () =
-  List.iter (fun s -> Library.require_library_from_file None None s false)
+  List.iter (fun s -> Library.require_library_from_file None s (Some false))
     (List.rev !require_list)
 
 let compile_list = ref ([] : (bool * string) list)
@@ -128,7 +130,6 @@ let re_exec is_ide =
   let s = !re_exec_version in
   let is_native = (Mltop.get()) = Mltop.Native in
   let prog = Sys.argv.(0) in
-  let coq = Filename.basename prog in
   if (is_native && s = "byte") || ((not is_native) && s = "opt")
   then begin
     let s = if s = "" then if is_native then "opt" else "byte" else s in
@@ -142,6 +143,17 @@ let re_exec is_ide =
     Unix.handle_unix_error (Unix.execvp newprog) Sys.argv
   end
 
+(*s options for the virtual machine *)
+
+let boxed_val = ref false
+let boxed_def = ref false
+let use_vm = ref false
+
+let set_vm_opt () =
+  Vm.set_transp_values (not !boxed_val);
+  Options.set_boxed_definitions !boxed_def;
+  Vconv.set_use_vm !use_vm
+
 (*s Parsing of the command line.
     We no longer use [Arg.parse], in order to use share [Usage.print_usage]
     between coqtop and coqc. *)
@@ -162,7 +174,7 @@ let parse_args is_ide =
     | [] -> ()
 
     | "-impredicative-set" :: rem -> 
-        set_engagement Environ.ImpredicativeSet; parse rem
+        set_engagement Declarations.ImpredicativeSet; parse rem
 
     | ("-I"|"-include") :: d :: rem -> set_default_include d; parse rem
     | ("-I"|"-include") :: []       -> usage ()
@@ -173,6 +185,7 @@ let parse_args is_ide =
     | "-top" :: d :: rem -> set_toplevel_name (dirpath_of_string d); parse rem
     | "-top" :: [] -> usage ()
 
+    | "-notop" :: rem -> unset_toplevel_name (); parse rem
     | "-q" :: rem -> no_load_rc (); parse rem
 
     | "-opt" :: rem -> set_opt(); parse rem
@@ -228,6 +241,7 @@ let parse_args is_ide =
 
     | "-debug" :: rem -> set_debug (); parse rem
 
+    | "-vm" :: rem -> use_vm := true; parse rem
     | "-emacs" :: rem -> Options.print_emacs := true; parse rem
 	  
     | "-where" :: _ -> print_endline Coq_config.coqlib; exit 0
@@ -253,12 +267,10 @@ let parse_args is_ide =
     | "-xml" :: rem -> Options.xml_export := true; parse rem
 
     (* Scanned in Options! *)
-    | "-v7" :: rem -> (* Options.v7 := true; *) parse rem
-    | "-v8" :: rem -> (* Options.v7 := false; *) parse rem
+    | "-v7" :: rem -> error "This version of Coq does not support v7 syntax"
+    | "-v8" :: rem -> parse rem
 
-    (* Translator options *)
-    | "-strict-implicit" :: rem -> 
-	Options.translate_strict_impargs := false; parse rem
+    | "-no-hash-consing" :: rem -> Options.hash_cons_proofs := false; parse rem
 
     | s :: rem -> 
 	if is_ide then begin
@@ -294,9 +306,10 @@ let init is_ide =
       if_verbose print_header ();
       init_load_path ();
       inputstate ();
+      set_vm_opt ();
       engage ();
-      if not !batch_mode && Global.env_is_empty() then
-        Declaremods.start_library !toplevel_name;
+      if (not !batch_mode|| !compile_list=[]) && Global.env_is_empty() then
+        option_iter Declaremods.start_library !toplevel_name;
       init_library_roots ();
       load_vernac_obj ();
       require ();
diff --git a/toplevel/coqtop.mli b/toplevel/coqtop.mli
index ef8b4b37..b5a1106c 100644
--- a/toplevel/coqtop.mli
+++ b/toplevel/coqtop.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coqtop.mli,v 1.5.4.1 2004/07/16 19:31:47 herbelin Exp $ i*)
+(*i $Id: coqtop.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* The Coq main module. The following function [start] will parse the
    command line, print the banner, initialize the load path, load the input 
diff --git a/toplevel/discharge.ml b/toplevel/discharge.ml
index 281ff1b6..6c543079 100644
--- a/toplevel/discharge.ml
+++ b/toplevel/discharge.ml
@@ -6,325 +6,83 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: discharge.ml,v 1.81.2.2 2005/11/29 21:40:53 letouzey Exp $ *)
+(* $Id: discharge.ml 7493 2005-11-02 22:12:16Z mohring $ *)
 
-open Pp
-open Util
 open Names
-open Nameops
+open Util
 open Sign
 open Term
-open Declarations
 open Entries
-open Inductive
-open Instantiate
-open Reduction
+open Declarations
 open Cooking
-open Typeops
-open Libnames
-open Libobject
-open Lib
-open Nametab
-open Declare
-open Impargs
-open Classops
-open Class
-open Recordops
-open Library
-open Indtypes
-open Nametab
-open Decl_kinds
 
-let recalc_sp dir sp =
-  let (_,spid) = repr_path sp in Libnames.make_path dir spid
+(********************************)
+(* Discharging mutual inductive *)
 
-let recalc_kn dir kn = 
-  let (mp,_,l) = Names.repr_kn kn in
-    Names.make_kn mp dir l
+let detype_param = function
+  | (Name id,None,p) -> id, Entries.LocalAssum p
+  | (Name id,Some p,_) -> id, Entries.LocalDef p
+  | (Anonymous,_,_) -> anomaly"Unnamed inductive local variable"
 
-let rec find_var id = function
-  | [] -> false
-  | (x,b,_)::l -> if x = id then b=None else find_var id l
+(* Replace
 
-let build_abstract_list sec_sp hyps ids_to_discard =
-  let l1,l2 =
-   List.split
-    (List.fold_left
-      (fun vars id ->
-        if find_var id hyps then (mkVar id, Libnames.make_path sec_sp id)::vars
-        else vars)
-      [] ids_to_discard) in
-  Array.of_list l1, l2
+     Var(y1)..Var(yq):C1..Cq |- Ij:Bj
+     Var(y1)..Var(yq):C1..Cq; I1..Ip:B1..Bp |- ci : Ti
 
-(* Discharge of inductives is done here (while discharge of constants 
-   is done by the kernel for efficiency). *)
+   by
 
-let abstract_inductive sec_sp ids_to_abs hyps inds =
-  let abstract_one_assum id t inds =
-    let ntyp = List.length inds in 
-    let new_refs =
-      list_tabulate (fun k -> applist(mkRel (k+2),[mkRel 1])) ntyp in
-    let inds' =
-      List.map
-      	(function (np,tname,arity,cnames,lc) -> 
-	   let arity' = mkNamedProd id t arity in
-	   let lc' =
-	     List.map (fun b -> mkNamedProd id t (substl new_refs b)) lc
-	   in
-           (np,tname,arity',cnames,lc'))
-      	inds
-    in 
-    inds' in
-  let abstract_one_def id c inds =
-    List.map
-      (function (np,tname,arity,cnames,lc) -> 
-	 let arity' = replace_vars [id, c] arity in
-	 let lc' = List.map (replace_vars [id, c]) lc in
-         (np,tname,arity',cnames,lc'))
-      inds in
-  let abstract_once ((hyps,inds,vars) as sofar) id =
-    match hyps with
-      | (hyp,None,t as d)::rest when id = hyp ->
-	  let inds' = abstract_one_assum hyp t inds in 
-	  (rest, inds', (mkVar id, Libnames.make_path sec_sp id)::vars)
-      | (hyp,Some b,t as d)::rest when id = hyp ->
-	  let inds' = abstract_one_def hyp b inds in 
-	  (rest, inds', vars)
-      | _ -> sofar in
-  let (_,inds',vars) =
-    List.fold_left abstract_once (hyps,inds,[]) ids_to_abs in
-  let inds'' =
-    List.map 
-      (fun (nparams,a,arity,c,lc) ->
-	 let nparams' = nparams + (List.length vars) in
-	 let params, short_arity = decompose_prod_n_assum nparams' arity in
-	 let shortlc =
-	   List.map (fun c -> snd (decompose_prod_n_assum nparams' c))lc in
-	 let params' =
-	   List.map 
-	     (function
-		| (Name id,None,p) -> id, Entries.LocalAssum p
-		| (Name id,Some p,_) -> id, Entries.LocalDef p
-		| (Anonymous,_,_) -> anomaly"Unnamed inductive local variable")
-	     params in
-	 { mind_entry_params = params';
-	   mind_entry_typename = a;
-	   mind_entry_arity = short_arity;
-	   mind_entry_consnames = c;
-	   mind_entry_lc = shortlc })
-      inds' in
-  let l1,l2 = List.split vars in
-   (inds'', Array.of_list l1, l2)
+     |- Ij: (y1..yq:C1..Cq)Bj
+     I1..Ip:(B1 y1..yq)..(Bp y1..yq) |- ci : (y1..yq:C1..Cq)Ti[Ij:=(Ij y1..yq)]
+*)
 
-let process_inductive sec_sp osecsp nsecsp oldenv (ids_to_discard,modlist) mib =
-  assert (Array.length mib.mind_packets > 0);
-  let record = mib.mind_record in 
-  let finite = mib.mind_finite in
+let abstract_inductive hyps nparams inds =
+  let ntyp = List.length inds in 
+  let nhyp = named_context_length hyps in
+  let args = instance_from_named_context (List.rev hyps) in
+  let subs = list_tabulate (fun k -> lift nhyp (mkApp(mkRel (k+1),args))) ntyp in
+  let inds' =
+    List.map
+      (function (tname,arity,cnames,lc) -> 
+	let lc' = List.map (substl subs) lc in
+	let lc'' = List.map (fun b -> Termops.it_mkNamedProd_wo_LetIn b hyps) lc' in
+	let arity' = Termops.it_mkNamedProd_wo_LetIn arity hyps in
+        (tname,arity',cnames,lc''))
+      	inds in
+  let nparams' = nparams + Array.length args in
+(* To be sure to be the same as before, should probably be moved to process_inductive *) 
+  let params' = let (_,arity,_,_) = List.hd inds' in 
+		let (params,_) = decompose_prod_n_assum nparams' arity in
+		  List.map detype_param params
+  in
+  let ind'' = 
+  List.map 
+    (fun (a,arity,c,lc) ->
+      let _, short_arity = decompose_prod_n_assum nparams' arity in
+      let shortlc =
+	List.map (fun c -> snd (decompose_prod_n_assum nparams' c)) lc in
+      { mind_entry_typename = a;
+	mind_entry_arity = short_arity;
+	mind_entry_consnames = c;
+	mind_entry_lc = shortlc })
+    inds'
+  in (params',ind'')
+
+
+let process_inductive sechyps modlist mib =
+  let nparams = mib.mind_nparams in
   let inds = 
     array_map_to_list
       (fun mip ->
-	 let nparams = mip.mind_nparams in
-	 let arity = expmod_type modlist mip.mind_user_arity in
-	 let lc = Array.map (expmod_type modlist) mip.mind_user_lc in
-	 (nparams,
-	  mip.mind_typename,
+	 let arity = expmod_constr modlist mip.mind_user_arity in
+	 let lc = Array.map (expmod_constr modlist) mip.mind_user_lc in
+	 (mip.mind_typename,
 	  arity,
 	  Array.to_list mip.mind_consnames,
 	  Array.to_list lc))
-      mib.mind_packets
-  in
-  let hyps = mib.mind_hyps in
-  let hyps' =
-    Sign.fold_named_context
-      (fun (x,b,t) sgn ->
-        Sign.add_named_decl
-          (x, option_app (expmod_constr modlist) b,expmod_constr modlist t)
-          sgn)
-      mib.mind_hyps ~init:empty_named_context in
-  let (inds',abs_vars,discharged_hyps ) =
-   abstract_inductive sec_sp ids_to_discard hyps' inds in
-  let lmodif_one_mind i = 
-    let nbc = Array.length mib.mind_packets.(i).mind_consnames in 
-    (((osecsp,i), DO_ABSTRACT ((nsecsp,i),abs_vars)),
-     list_tabulate
-       (function j -> 
-	  let j' = j + 1 in
-	  (((osecsp,i),j'), DO_ABSTRACT (((nsecsp,i),j'),abs_vars)))
-      nbc)
-  in
-  let indmodifs,cstrmodifs =
-    List.split (list_tabulate lmodif_one_mind mib.mind_ntypes) in 
-  ({ mind_entry_record = record;
-     mind_entry_finite = finite;
-     mind_entry_inds = inds' },
-   indmodifs,
-   List.flatten cstrmodifs,
-   discharged_hyps)
-
-(* Discharge messages. *)
-
-let constant_message id =
-  Options.if_verbose ppnl (pr_id id ++ str " is discharged.")
-
-let inductive_message inds =
-  Options.if_verbose 
-    ppnl
-      (hov 0 
-	 (match inds with
-	    | [] -> assert false
-	    | [ind] ->
-		(pr_id ind.mind_entry_typename ++ str " is discharged.")
-	    | l ->
-		(prlist_with_sep pr_coma 
-		     (fun ind -> pr_id ind.mind_entry_typename) l ++
-		   spc () ++ str "are discharged.")))
-
-(* Discharge operations for the various objects of the environment. *)
-
-type opacity = bool
-
-type discharge_operation = 
-  | Variable of identifier * section_variable_entry * local_kind * 
-      implicits_flags * Dischargedhypsmap.discharged_hyps
-  | Constant of identifier * recipe * global_kind * constant * 
-      implicits_flags * Dischargedhypsmap.discharged_hyps
-  | Inductive of mutual_inductive_entry * implicits_flags *
-      Dischargedhypsmap.discharged_hyps
-  | Class of cl_typ * cl_info_typ
-  | Struc of inductive * (unit -> struc_typ)
-  | Objdef of constant
-  | Coercion of coercion_entry
-  | Require of library_reference
-  | Constraints of Univ.constraints
-
-(* Main function to traverse the library segment and compute the various
-   discharge operations. *)
-
-let process_object oldenv olddir full_olddir newdir  
-(* {dir -> newdir} {sec_sp -> full_olddir, olddir} *)
-  (ops,ids_to_discard,(constl,indl,cstrl as work_alist)) ((sp,kn),lobj) =
-  let tag = object_tag lobj in 
-  match tag with
-    | "VARIABLE" ->
-	let ((id,c,t),cst) = get_variable_with_constraints (basename sp) in
-	(* VARIABLE means local (entry Variable/Hypothesis/Local and are *)
-	(* always discharged *)
-	(Constraints cst :: ops, id :: ids_to_discard, work_alist)
-
-    | "CONSTANT" ->
-	(* CONSTANT means never discharge (though visibility may vary) *)
- 	let kind = constant_kind sp in
-	let kn = Nametab.locate_constant (qualid_of_sp sp) in
-	let lab = label kn in
-	let cb = Environ.lookup_constant kn oldenv in
-	let imp = is_implicit_constant kn in
-	let newkn = recalc_kn newdir kn in
-	let abs_vars,discharged_hyps0 =
-         build_abstract_list full_olddir cb.const_hyps ids_to_discard in
-        (* let's add the new discharged hypothesis to those already discharged*)
-        let discharged_hyps =
-         discharged_hyps0 @ Dischargedhypsmap.get_discharged_hyps sp in
-        let mods = [ (kn, DO_ABSTRACT(newkn,abs_vars)) ]
-	in
-	let r = { d_from = cb;
-	          d_modlist = work_alist;
-	          d_abstract = ids_to_discard } in
-	let op = Constant (id_of_label lab,r,kind,newkn,imp,discharged_hyps) in
-        (op :: ops, ids_to_discard, (mods@constl, indl, cstrl))
-  
-    | "INDUCTIVE" ->
-	let kn = Nametab.locate_mind (qualid_of_sp sp) in
-	let mib = Environ.lookup_mind kn oldenv in
-	let newkn = recalc_kn newdir kn in
-	let imp = is_implicit_inductive_definition kn in
-(*	let imp = is_implicit_args (* CHANGE *) in*)
-	let (mie,indmods,cstrmods,discharged_hyps0) = 
-	  process_inductive full_olddir kn newkn oldenv (ids_to_discard,work_alist) mib in
-        (* let's add the new discharged hypothesis to those already discharged*)
-        let discharged_hyps =
-         discharged_hyps0 @ Dischargedhypsmap.get_discharged_hyps sp in
-	((Inductive(mie,imp,discharged_hyps)) :: ops, ids_to_discard,
-	 (constl,indmods@indl,cstrmods@cstrl))
-
-    | "CLASS" -> 
-	let ((cl,clinfo) as x) = outClass lobj in
-	if clinfo.cl_strength = Local then 
-	  (ops,ids_to_discard,work_alist)
-	else
-	  let (y1,y2) = process_class olddir ids_to_discard x in
-          ((Class (y1,y2))::ops, ids_to_discard, work_alist)
-	  
-    | "COERCION" -> 
-	let (_,coeinfo,_,_ as x) = outCoercion lobj in
-	if coercion_strength coeinfo = Local then
-	  (ops,ids_to_discard,work_alist)
-        else
-	  let y = process_coercion olddir ids_to_discard x in
-          ((Coercion y)::ops, ids_to_discard, work_alist)
-                    
-    | "STRUCTURE" ->
-	let ((kn,i),info) = outStruc lobj in
-	let newkn = recalc_kn newdir kn in
-	let strobj () =
-	  let mib = Environ.lookup_mind newkn (Global.env ()) in
-	  { s_CONST = info.s_CONST;
-	    s_PARAM = mib.mind_packets.(0).mind_nparams;
-	    s_PROJ = List.map (option_app (fun kn -> recalc_kn newdir kn)) info.s_PROJ } in
-	((Struc ((newkn,i),strobj))::ops, ids_to_discard, work_alist)
-
-    | "OBJDEF1" -> 
-	let kn = outObjDef1 lobj in
-	let new_kn = recalc_kn newdir kn in
-        ((Objdef new_kn)::ops, ids_to_discard, work_alist)
-
-    | "REQUIRE" -> 
-	let c = out_require lobj in
-	((Require c)::ops, ids_to_discard, work_alist)
-
-    | _ -> (ops,ids_to_discard,work_alist)
-
-let process_item oldenv olddir full_olddir newdir acc = function
-  | (sp,Leaf lobj) -> 
-      process_object oldenv olddir full_olddir newdir  acc (sp,lobj)
-  | (_,_) -> acc
-
-let process_operation = function
-  | Variable (id,expmod_a,stre,imp,discharged_hyps) ->
-      (* Warning:parentheses needed to get a side-effect from with_implicits *)
-      with_implicits imp (redeclare_variable id discharged_hyps)
-        (Lib.cwd(),expmod_a,stre)
-  | Constant (id,r,stre,kn,imp,discharged_hyps) ->
-      with_implicits imp (redeclare_constant id discharged_hyps) (r,stre);
-      constant_message id
-  | Inductive (mie,imp,discharged_hyps) ->
-      let _ = with_implicits imp (redeclare_inductive discharged_hyps) mie in
-      inductive_message mie.mind_entry_inds
-  | Class (y1,y2) ->
-      Lib.add_anonymous_leaf (inClass (y1,y2))
-  | Struc (newsp,strobj) ->
-      Lib.add_anonymous_leaf (inStruc (newsp,strobj ()))
-  | Objdef newsp ->
-      begin try Recordobj.objdef_declare (ConstRef newsp) with _ -> () end
-  | Coercion y -> add_new_coercion y
-  | Require y -> reload_library y
-  | Constraints y -> Global.add_constraints y
-
-let catch_not_found f x =
-  try f x
-  with Not_found ->
-    error ("Something is missing; perhaps a reference to a"^
-    " module required inside the section")
-
-let close_section _ s = 
-  let oldenv = Global.env() in
-  let prefix,decls,fs = close_section false s in
-  let full_olddir, (_,olddir) = prefix in
-  let newdir = fst (split_dirpath olddir) in
-  let (ops,ids,_) = 
-    List.fold_left 
-      (process_item oldenv olddir full_olddir newdir) ([],[],([],[],[])) decls 
-  in
-  let ids = last_section_hyps olddir in
-  Summary.section_unfreeze_summaries fs;
-  catch_not_found (List.iter process_operation) (List.rev ops);
-  Nametab.push_dir (Until 1) full_olddir (DirClosedSection full_olddir)
+      mib.mind_packets in
+  let sechyps' = map_named_context (expmod_constr modlist) sechyps in
+  let (params',inds') = abstract_inductive sechyps' nparams inds in
+  { mind_entry_record = mib.mind_record;
+    mind_entry_finite = mib.mind_finite;
+    mind_entry_params = params';
+    mind_entry_inds = inds' }
diff --git a/toplevel/discharge.mli b/toplevel/discharge.mli
index c80b93ce..dcf88f31 100644
--- a/toplevel/discharge.mli
+++ b/toplevel/discharge.mli
@@ -6,13 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: discharge.mli,v 1.6.16.1 2004/07/16 19:31:48 herbelin Exp $ i*)
+(*i $Id: discharge.mli 6748 2005-02-18 22:17:50Z herbelin $ i*)
 
-open Names
+open Sign
+open Cooking
+open Declarations
+open Entries
 
-(* This module implements the discharge mechanism. It provides a function to
-   close the last opened section. That function calls [Lib.close_section] and
-   then re-introduce all the discharged versions of the objects that were
-   defined in the section. *)
-
-val close_section : bool -> identifier -> unit
+val process_inductive : 
+  named_context -> work_list -> mutual_inductive_body -> mutual_inductive_entry
diff --git a/toplevel/fhimsg.ml b/toplevel/fhimsg.ml
index b5185cd3..4ef5d5fd 100644
--- a/toplevel/fhimsg.ml
+++ b/toplevel/fhimsg.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: fhimsg.ml,v 1.19.2.1 2004/07/16 19:31:48 herbelin Exp $ *)
+(* $Id: fhimsg.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
 
 open Pp
 open Util
@@ -231,7 +231,7 @@ let explain_ill_formed_rec_body k ctx err names i vdefs =
   | RecCallInCasePred c ->
       (str "Not allowed recursive call in the type of cases in")
   | NotGuardedForm c ->
-      str "Sub-expression " ++ prterm_env ctx c ++ spc() ++
+      str "Sub-expression " ++ pr_lconstr_env ctx c ++ spc() ++
       str "not in guarded form (should be a constructor, Cases or CoFix)"
 in
   let pvd = P.pr_term k ctx vdefs.(i) in
@@ -278,14 +278,7 @@ let explain_ml_case k ctx mes c ct br brt =
   hov 0 (str "In ML case expression on " ++ pc ++ ws 1 ++ cut () ++
            str "of type" ++  ws 1 ++ pct ++ ws 1 ++ cut () ++ 
            str "which is an inductive predicate." ++ fnl () ++ expln)
-(*
-let explain_cant_find_case_type loc k ctx c =
-  let pe = P.pr_term k ctx c in
-  Ast.user_err_loc
-    (loc,"pretype",
-     hov 3 (str "Cannot infer type of whole Case expression on" ++ 
-	     ws 1 ++ pe))
-*)
+
 let explain_type_error k ctx = function
   | UnboundRel n -> 
       explain_unbound_rel k ctx n
diff --git a/toplevel/fhimsg.mli b/toplevel/fhimsg.mli
index 10175e2a..1ab786d1 100644
--- a/toplevel/fhimsg.mli
+++ b/toplevel/fhimsg.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: fhimsg.mli,v 1.8.16.1 2004/07/16 19:31:48 herbelin Exp $ i*)
+(*i $Id: fhimsg.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Pp
diff --git a/toplevel/himsg.ml b/toplevel/himsg.ml
index beb80d03..3fe51b5a 100644
--- a/toplevel/himsg.ml
+++ b/toplevel/himsg.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: himsg.ml,v 1.86.2.4 2004/12/03 18:45:53 herbelin Exp $ *)
+(* $Id: himsg.ml 8005 2006-02-07 22:50:35Z herbelin $ *)
 
 open Pp
 open Util
@@ -21,18 +21,20 @@ open Sign
 open Environ
 open Pretype_errors
 open Type_errors
+open Indrec
 open Reduction
 open Cases
 open Logic
 open Printer
-open Ast
 open Rawterm
+open Evd
 
-let quote s = if !Options.v7 then s else h 0 (str "\"" ++ s ++ str "\"")
+let quote s = h 0 (str "\"" ++ s ++ str "\"")
 
-let prterm c = quote (prterm c)
-let prterm_env e c = quote (prterm_env e c)
-let prjudge_env e c = let v,t = prjudge_env e c in (quote v,quote t)
+let pr_lconstr c = quote (pr_lconstr c)
+let pr_lconstr_env e c = quote (pr_lconstr_env e c)
+let pr_lconstr_env_at_top e c = quote (pr_lconstr_env_at_top e c)
+let pr_ljudge_env e c = let v,t = pr_ljudge_env e c in (quote v,quote t)
 
 let nth i =
   let many = match i mod 10 with 1 -> "st" | 2 -> "nd" | _ -> "th" in
@@ -56,20 +58,20 @@ let explain_unbound_var ctx v =
 
 let explain_not_type ctx j =
   let pe = pr_ne_context_of (str"In environment") ctx in
-  let pc,pt = prjudge_env ctx j in
+  let pc,pt = pr_ljudge_env ctx j in
   pe ++ str "the term" ++ brk(1,1) ++ pc ++ spc () ++
   str"has type" ++ spc () ++ pt ++ spc () ++ 
   str"which should be Set, Prop or Type."
 
 let explain_bad_assumption ctx j =
   let pe = pr_ne_context_of (str"In environment") ctx in
-  let pc,pt = prjudge_env ctx j in
+  let pc,pt = pr_ljudge_env ctx j in
   pe ++ str "cannot declare a variable or hypothesis over the term" ++
   brk(1,1) ++ pc ++ spc () ++ str"of type" ++ spc () ++ pt ++ spc () ++
   str "because this term is not a type."
 
 let explain_reference_variables c =
-  let pc = prterm c in
+  let pc = pr_lconstr c in
   str "the constant" ++ spc () ++ pc ++ spc () ++ 
   str "refers to variables which are not in the context"
 
@@ -82,12 +84,11 @@ let rec pr_disjunction pr = function
 let explain_elim_arity ctx ind aritylst c pj okinds = 
   let ctx = make_all_name_different ctx in
   let pi = pr_inductive ctx ind in
-  let pc = prterm_env ctx c in
-  let ppt = prterm_env ctx pj.uj_type in
+  let pc = pr_lconstr_env ctx c in
   let msg = match okinds with
   | Some(kp,ki,explanation) ->
-      let pki = prterm_env ctx ki in
-      let pkp = prterm_env ctx kp in
+      let pki = pr_lconstr_env ctx ki in
+      let pkp = pr_lconstr_env ctx kp in
       let explanation =	match explanation with
 	| NonInformativeToInformative ->
           "proofs can be eliminated only to build proofs"
@@ -106,29 +107,19 @@ let explain_elim_arity ctx ind aritylst c pj okinds =
   hov 0 (
   str "Incorrect elimination of" ++ spc() ++ pc ++ spc () ++
   str "in the inductive type " ++ spc() ++ quote pi ++ 
-  (if !Options.v7 then 
-    let pp = prterm_env ctx pj.uj_val in
-    let ppar = pr_disjunction (prterm_env ctx) aritylst in
-    let ppt = prterm_env ctx pj.uj_type in
-    fnl () ++
-    str "The elimination predicate"  ++ brk(1,1) ++ pp ++ spc () ++
-    str "has arity" ++ brk(1,1) ++ ppt ++ fnl () ++
-    str "It should be " ++ brk(1,1)  ++ ppar
-  else
-    let sorts = List.map (fun x -> mkSort (new_sort_in_family x))
+  (let sorts = List.map (fun x -> mkSort (new_sort_in_family x))
       (list_uniquize (List.map (fun ar ->
       family_of_sort (destSort (snd (decompose_prod_assum ar)))) aritylst)) in
-    let ppar = pr_disjunction (prterm_env ctx) sorts in
-    let ppt = prterm_env ctx (snd (decompose_prod_assum pj.uj_type)) in
+    let ppar = pr_disjunction (pr_lconstr_env ctx) sorts in
+    let ppt = pr_lconstr_env ctx (snd (decompose_prod_assum pj.uj_type)) in
     str "," ++ spc() ++ str "the return type has sort" ++ spc() ++ ppt ++ 
     spc () ++ str "while it should be " ++ ppar))
   ++ fnl () ++ msg
-    
-    
+
 let explain_case_not_inductive ctx cj =
   let ctx = make_all_name_different ctx in
-  let pc = prterm_env ctx cj.uj_val in
-  let pct = prterm_env ctx cj.uj_type in
+  let pc = pr_lconstr_env ctx cj.uj_val in
+  let pct = pr_lconstr_env ctx cj.uj_type in
     match kind_of_term cj.uj_type with
       | Evar _ -> 
 	  str "Cannot infer a type for this expression"
@@ -139,26 +130,30 @@ let explain_case_not_inductive ctx cj =
 
 let explain_number_branches ctx cj expn =
   let ctx = make_all_name_different ctx in
-  let pc = prterm_env ctx cj.uj_val in
-  let pct = prterm_env ctx cj.uj_type in
+  let pc = pr_lconstr_env ctx cj.uj_val in
+  let pct = pr_lconstr_env ctx cj.uj_type in
   str "Matching on term" ++ brk(1,1) ++ pc ++ spc ()  ++
   str "of type" ++ brk(1,1) ++ pct ++ spc () ++
   str "expects " ++  int expn ++ str " branches"
 
+let ordinal n =
+  let s = match n mod 10 with 1 -> "st" | 2 -> "nd" | 3 -> "rd" | _ -> "th" in
+  string_of_int n ^ s
+
 let explain_ill_formed_branch ctx c i actty expty =
   let ctx = make_all_name_different ctx in
-  let pc = prterm_env ctx c in
-  let pa = prterm_env ctx actty in
-  let pe = prterm_env ctx expty in
+  let pc = pr_lconstr_env ctx c in
+  let pa = pr_lconstr_env ctx actty in
+  let pe = pr_lconstr_env ctx expty in
   str "In pattern-matching on term" ++ brk(1,1) ++ pc ++
-  spc () ++ str "the branch "  ++ int (i+1) ++
-  str " has type" ++ brk(1,1) ++ pa  ++ spc () ++ 
+  spc () ++ str "the " ++ str (ordinal (i+1)) ++ str " branch has type" ++
+  brk(1,1) ++ pa ++ spc () ++ 
   str "which should be" ++ brk(1,1) ++ pe
 
 let explain_generalization ctx (name,var) j =
   let pe = pr_ne_context_of (str "In environment") ctx in
-  let pv = prtype_env ctx var in
-  let (pc,pt) = prjudge_env (push_rel_assum (name,var) ctx) j in
+  let pv = pr_ltype_env ctx var in
+  let (pc,pt) = pr_ljudge_env (push_rel_assum (name,var) ctx) j in
   str"Illegal generalization: " ++ pe ++
   str"Cannot generalize" ++ brk(1,1) ++ pv ++ spc () ++
   str"over" ++ brk(1,1) ++ pc ++ str"," ++ spc () ++ 
@@ -167,17 +162,18 @@ let explain_generalization ctx (name,var) j =
 
 let explain_actual_type ctx j pt =
   let pe = pr_ne_context_of (str "In environment") ctx in
-  let (pc,pct) = prjudge_env ctx j in
-  let pt = prterm_env ctx pt in
+  let (pc,pct) = pr_ljudge_env ctx j in
+  let pt = pr_lconstr_env ctx pt in
   pe ++
   str "The term" ++ brk(1,1) ++ pc ++ spc ()  ++
   str "has type"  ++ brk(1,1) ++ pct ++ brk(1,1) ++ 
   str "while it is expected to have type" ++ brk(1,1) ++ pt
 
 let explain_cant_apply_bad_type ctx (n,exptyp,actualtyp) rator randl =
+  let ctx = make_all_name_different ctx in
   let randl = Array.to_list randl in
 (*  let pe = pr_ne_context_of (str"in environment") ctx in*)
-  let pr,prt = prjudge_env ctx rator in
+  let pr,prt = pr_ljudge_env ctx rator in
   let term_string1,term_string2 =
     if List.length randl > 1 then
       str "terms", (str"The "++nth n++str" term")
@@ -185,7 +181,7 @@ let explain_cant_apply_bad_type ctx (n,exptyp,actualtyp) rator randl =
       str "term", str "This term" in
   let appl = prlist_with_sep pr_fnl 
 	       (fun c ->
-		  let pc,pct = prjudge_env ctx c in
+		  let pc,pct = pr_ljudge_env ctx c in
 		  hov 2 (pc ++ spc () ++ str": "  ++ pct)) randl
   in
   str"Illegal application (Type Error): " ++ (* pe ++ *) fnl () ++
@@ -193,19 +189,20 @@ let explain_cant_apply_bad_type ctx (n,exptyp,actualtyp) rator randl =
   str"of type" ++ brk(1,1) ++ prt ++ spc ()  ++
   str"cannot be applied to the " ++ term_string1 ++ fnl () ++ 
   str" " ++ v 0 appl ++ fnl () ++ term_string2 ++ str" has type" ++
-  brk(1,1) ++ prterm_env ctx actualtyp ++ spc () ++
-  str"which should be coercible to" ++ brk(1,1) ++ prterm_env ctx exptyp
+  brk(1,1) ++ pr_lconstr_env ctx actualtyp ++ spc () ++
+  str"which should be coercible to" ++ brk(1,1) ++ pr_lconstr_env ctx exptyp
 
 let explain_cant_apply_not_functional ctx rator randl =
+  let ctx = make_all_name_different ctx in
   let randl = Array.to_list randl in
 (*  let pe = pr_ne_context_of (str"in environment") ctx in*)
-  let pr = prterm_env ctx rator.uj_val in
-  let prt = prterm_env ctx rator.uj_type in
+  let pr = pr_lconstr_env ctx rator.uj_val in
+  let prt = pr_lconstr_env ctx rator.uj_type in
   let term_string = if List.length randl > 1 then "terms" else "term" in
   let appl = prlist_with_sep pr_fnl 
 	       (fun c ->
-		  let pc = prterm_env ctx c.uj_val in
-		  let pct = prterm_env ctx c.uj_type in
+		  let pc = pr_lconstr_env ctx c.uj_val in
+		  let pct = pr_lconstr_env ctx c.uj_type in
 		  hov 2 (pc ++ spc () ++ str": "  ++ pct)) randl
   in
   str"Illegal application (Non-functional construction): " ++ 
@@ -216,14 +213,14 @@ let explain_cant_apply_not_functional ctx rator randl =
   str" " ++ v 0 appl
 
 let explain_unexpected_type ctx actual_type expected_type =
-  let pract = prterm_env ctx actual_type in
-  let prexp = prterm_env ctx expected_type in
+  let pract = pr_lconstr_env ctx actual_type in
+  let prexp = pr_lconstr_env ctx expected_type in
   str"This type is" ++ spc () ++ pract ++ spc () ++ 
   str "but is expected to be" ++
   spc () ++ prexp
 
 let explain_not_product ctx c =
-  let pr = prterm_env ctx c in
+  let pr = pr_lconstr_env ctx c in
   str"The type of this term is a product," ++ spc () ++
   str"but it is casted with type" ++
   brk(1,1) ++ pr
@@ -241,8 +238,9 @@ let explain_ill_formed_rec_body ctx err names i =
   (* Fixpoint guard errors *)
   | NotEnoughAbstractionInFixBody ->
       str "Not enough abstractions in the definition"
-  | RecursionNotOnInductiveType ->
-      str "Recursive definition on a non inductive type"
+  | RecursionNotOnInductiveType c ->
+      str "Recursive definition on" ++ spc() ++ pr_lconstr_env ctx c ++ spc() ++
+      str "which should be an inductive type"
   | RecursionOnIllegalTerm(j,arg,le,lt) ->
       let called =
         match names.(j) with
@@ -262,7 +260,7 @@ let explain_ill_formed_rec_body ctx err names i =
               prlist_with_sep pr_spc (pr_db ctx) lt in
       str "Recursive call to " ++ called ++ spc() ++
       str "has principal argument equal to" ++ spc() ++
-      prterm_env ctx arg ++ fnl() ++ str "instead of " ++ vars
+      pr_lconstr_env ctx arg ++ fnl() ++ str "instead of " ++ vars
 
   | NotEnoughArgumentsForFixCall j ->
       let called =
@@ -273,31 +271,31 @@ let explain_ill_formed_rec_body ctx err names i =
 
   (* CoFixpoint guard errors *)
   | CodomainNotInductiveType c ->
-      str "the codomain is" ++ spc () ++ prterm_env ctx c ++ spc () ++
+      str "the codomain is" ++ spc () ++ pr_lconstr_env ctx c ++ spc () ++
       str "which should be a coinductive type"
   | NestedRecursiveOccurrences ->
       str "nested recursive occurrences"
   | UnguardedRecursiveCall c ->
-      str "unguarded recursive call in" ++ spc() ++ prterm_env ctx c
+      str "unguarded recursive call in" ++ spc() ++ pr_lconstr_env ctx c
   | RecCallInTypeOfAbstraction c ->
       str "recursive call forbidden in the domain of an abstraction:" ++
-      spc() ++ prterm_env ctx c
+      spc() ++ pr_lconstr_env ctx c
   | RecCallInNonRecArgOfConstructor c ->
       str "recursive call on a non-recursive argument of constructor" ++
-      spc() ++ prterm_env ctx c
+      spc() ++ pr_lconstr_env ctx c
   | RecCallInTypeOfDef c ->
       str "recursive call forbidden in the type of a recursive definition" ++
-      spc() ++ prterm_env ctx c
+      spc() ++ pr_lconstr_env ctx c
   | RecCallInCaseFun c ->
-      str "recursive call in a branch of" ++ spc() ++ prterm_env ctx c
+      str "recursive call in a branch of" ++ spc() ++ pr_lconstr_env ctx c
   | RecCallInCaseArg c -> 
       str "recursive call in the argument of cases in" ++ spc() ++
-      prterm_env ctx c
+      pr_lconstr_env ctx c
   | RecCallInCasePred c ->
       str "recursive call in the type of cases in" ++  spc() ++
-      prterm_env ctx c
+      pr_lconstr_env ctx c
   | NotGuardedForm c ->
-      str "sub-expression " ++ prterm_env ctx c ++ spc() ++
+      str "sub-expression " ++ pr_lconstr_env ctx c ++ spc() ++
       str "not in guarded form" ++ spc()++
       str"(should be a constructor, an abstraction, a match, a cofix or a recursive call)"
   in
@@ -307,8 +305,8 @@ let explain_ill_formed_rec_body ctx err names i =
 
 let explain_ill_typed_rec_body ctx i names vdefj vargs =
   let ctx = make_all_name_different ctx in
-  let pvd,pvdt = prjudge_env ctx (vdefj.(i)) in
-  let pv = prterm_env ctx vargs.(i) in
+  let pvd,pvdt = pr_ljudge_env ctx (vdefj.(i)) in
+  let pv = pr_lconstr_env ctx vargs.(i) in
   str"The "  ++
   (if Array.length vdefj = 1 then mt () else int (i+1) ++ str "-th") ++
   str"recursive definition"  ++ spc () ++ pvd ++ spc () ++
@@ -317,19 +315,19 @@ let explain_ill_typed_rec_body ctx i names vdefj vargs =
 (*
 let explain_not_inductive ctx c =
   let ctx = make_all_name_different ctx in
-  let pc = prterm_env ctx c in
+  let pc = pr_lconstr_env ctx c in
   str"The term" ++ brk(1,1) ++ pc ++ spc () ++
   str "is not an inductive definition"
 *)
 let explain_cant_find_case_type ctx c =
   let ctx = make_all_name_different ctx in
-  let pe = prterm_env ctx c in
+  let pe = pr_lconstr_env ctx c in
   hov 3 (str "Cannot infer type of pattern-matching on" ++ ws 1 ++ pe)
 
 let explain_occur_check ctx ev rhs =
   let ctx = make_all_name_different ctx in
   let id = Evd.string_of_existential ev in
-  let pt = prterm_env ctx rhs in
+  let pt = pr_lconstr_env ctx rhs in
   str"Occur check failed: tried to define " ++ str id ++
   str" with term" ++ brk(1,1) ++ pt
 
@@ -342,14 +340,10 @@ let explain_hole_kind env = function
   | BinderType Anonymous ->
       str "a type for this anonymous binder"
   | ImplicitArg (c,(n,ido)) ->
-      if !Options.v7 then
-	str "the " ++ pr_ord n ++
-	str " implicit argument of " ++ Nametab.pr_global_env Idset.empty c
-      else
-	let id = out_some ido in
-	str "an instance for the implicit parameter " ++
-	pr_id id ++ spc () ++ str "of" ++
-	spc () ++ Nametab.pr_global_env Idset.empty c
+      let id = out_some ido in
+      str "an instance for the implicit parameter " ++
+      pr_id id ++ spc () ++ str "of" ++
+      spc () ++ Nametab.pr_global_env Idset.empty c
   | InternalHole ->
       str "a term for an internal placeholder"
   | TomatchTypeParameter (tyi,n) ->
@@ -361,7 +355,7 @@ let explain_not_clean ctx ev t k =
   let ctx = make_all_name_different ctx in
   let c = mkRel (Intset.choose (free_rels t)) in
   let id = Evd.string_of_existential ev in
-  let var = prterm_env ctx c in
+  let var = pr_lconstr_env ctx c in
   str"Tried to define " ++ explain_hole_kind ctx k ++
   str" (" ++ str id ++ str ")" ++ spc() ++
   str"with a term using variable " ++ var ++ spc () ++
@@ -377,18 +371,36 @@ let explain_var_not_found ctx id =
   spc ()  ++ str "in the current" ++ spc ()  ++ str "environment"
 
 let explain_wrong_case_info ctx ind ci =
-  let ctx = make_all_name_different ctx in
-  let pi = prterm (mkInd ind) in
+  let pi = pr_lconstr (mkInd ind) in
   if ci.ci_ind = ind then
     str"Pattern-matching expression on an object of inductive" ++ spc () ++ pi ++
     spc () ++ str"has invalid information"
   else
-    let pc = prterm (mkInd ci.ci_ind) in
+    let pc = pr_lconstr (mkInd ci.ci_ind) in
     str"A term of inductive type" ++ spc () ++ pi ++ spc () ++
     str"was given to a pattern-matching expression on the inductive type" ++
     spc () ++ pc
        
 
+let explain_cannot_unify m n =
+  let pm = pr_lconstr m in 
+  let pn = pr_lconstr n in
+  str"Impossible to unify" ++ brk(1,1)  ++ pm ++ spc ()  ++
+  str"with" ++ brk(1,1)  ++ pn
+
+let explain_refiner_cannot_generalize ty =
+  str "Cannot find a well-typed generalisation of the goal with type : " ++ 
+  pr_lconstr ty
+
+let explain_no_occurrence_found c =
+  str "Found no subterm matching " ++ pr_lconstr c ++ str " in the current goal"
+
+let explain_cannot_unify_binding_type m n =
+  let pm = pr_lconstr m in 
+  let pn = pr_lconstr n in
+  str "This binding has type" ++ brk(1,1) ++ pm ++ spc () ++ 
+  str "which should be unifiable with" ++ brk(1,1) ++ pn
+
 let explain_type_error ctx err =
   let ctx = make_all_name_different ctx in
   match err with
@@ -445,93 +457,74 @@ let explain_pretype_error ctx err =
       explain_unexpected_type ctx actual expected
   | NotProduct c ->
       explain_not_product ctx c
+  | CannotUnify (m,n) -> explain_cannot_unify m n
+  | CannotGeneralize ty -> explain_refiner_cannot_generalize ty
+  | NoOccurrenceFound c -> explain_no_occurrence_found c
+  | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type m n
 
 (* Refiner errors *)
 
 let explain_refiner_bad_type arg ty conclty =
   str"refiner was given an argument" ++ brk(1,1) ++ 
-  prterm arg ++ spc () ++
-  str"of type" ++ brk(1,1) ++ prterm ty ++ spc () ++
-  str"instead of" ++ brk(1,1) ++ prterm conclty
+  pr_lconstr arg ++ spc () ++
+  str"of type" ++ brk(1,1) ++ pr_lconstr ty ++ spc () ++
+  str"instead of" ++ brk(1,1) ++ pr_lconstr conclty
 
 let explain_refiner_occur_meta t =
-  str"cannot refine with term" ++ brk(1,1) ++ prterm t ++
+  str"cannot refine with term" ++ brk(1,1) ++ pr_lconstr t ++
   spc () ++ str"because there are metavariables, and it is" ++
   spc () ++ str"neither an application nor a Case"
 
 let explain_refiner_occur_meta_goal t =
-  str"generated subgoal" ++ brk(1,1) ++ prterm t ++
+  str"generated subgoal" ++ brk(1,1) ++ pr_lconstr t ++
   spc () ++ str"has metavariables in it"
 
-let explain_refiner_cannot_applt t harg =
+let explain_refiner_cannot_apply t harg =
   str"in refiner, a term of type " ++ brk(1,1) ++
-  prterm t ++ spc () ++ str"could not be applied to" ++ brk(1,1) ++
-  prterm harg
-
-let explain_cannot_unify m n =
-  let pm = prterm m in 
-  let pn = prterm n in
-  str"Impossible to unify" ++ brk(1,1)  ++ pm ++ spc ()  ++
-  str"with" ++ brk(1,1)  ++ pn
-
-let explain_cannot_unify_binding_type m n =
-  let pm = prterm m in 
-  let pn = prterm n in
-  str "This binding has type" ++ brk(1,1) ++ pm ++ spc () ++ 
-  str "which should be unifiable with" ++ brk(1,1) ++ pn
-
-let explain_refiner_cannot_generalize ty =
-  str "Cannot find a well-typed generalisation of the goal with type : " ++ 
-  prterm ty
+  pr_lconstr t ++ spc () ++ str"could not be applied to" ++ brk(1,1) ++
+  pr_lconstr harg
 
 let explain_refiner_not_well_typed c =
-  str"The term "  ++ prterm c  ++ str" is not well-typed"
+  str"The term "  ++ pr_lconstr c  ++ str" is not well-typed"
 
 let explain_intro_needs_product () =
   str "Introduction tactics needs products"
 
 let explain_does_not_occur_in c hyp =
-  str "The term" ++ spc () ++ prterm c ++ spc () ++ str "does not occur in" ++ 
+  str "The term" ++ spc () ++ pr_lconstr c ++ spc () ++ str "does not occur in" ++ 
   spc () ++ pr_id hyp
 
 let explain_non_linear_proof c =
-  str "cannot refine with term" ++ brk(1,1) ++ prterm c ++
+  str "cannot refine with term" ++ brk(1,1) ++ pr_lconstr c ++
   spc () ++ str"because a metavariable has several occurrences"
 
-let explain_no_occurrence_found c =
-  str "Found no subterm matching " ++ prterm c ++ str " in the current goal"
-
 let explain_refiner_error = function
   | BadType (arg,ty,conclty) -> explain_refiner_bad_type arg ty conclty
   | OccurMeta t -> explain_refiner_occur_meta t
   | OccurMetaGoal t -> explain_refiner_occur_meta_goal t
-  | CannotApply (t,harg) -> explain_refiner_cannot_applt t harg
-  | CannotUnify (m,n) -> explain_cannot_unify m n
-  | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type m n
-  | CannotGeneralize ty -> explain_refiner_cannot_generalize ty
+  | CannotApply (t,harg) -> explain_refiner_cannot_apply t harg
   | NotWellTyped c -> explain_refiner_not_well_typed c
   | IntroNeedsProduct -> explain_intro_needs_product ()
   | DoesNotOccurIn (c,hyp) -> explain_does_not_occur_in c hyp
   | NonLinearProof c -> explain_non_linear_proof c
-  | NoOccurrenceFound c -> explain_no_occurrence_found c
 
 (* Inductive errors *)
 
 let error_non_strictly_positive env c v  =
-  let pc = prterm_env env c in
-  let pv = prterm_env env v in
+  let pc = pr_lconstr_env env c in
+  let pv = pr_lconstr_env env v in
   str "Non strictly positive occurrence of " ++ pv ++ str " in" ++
   brk(1,1) ++ pc
 
 let error_ill_formed_inductive env c v =
-  let pc = prterm_env env c in
-  let pv = prterm_env env v in
+  let pc = pr_lconstr_env env c in
+  let pv = pr_lconstr_env env v in
   str "Not enough arguments applied to the " ++ pv ++
   str " in" ++ brk(1,1) ++ pc
 
 let error_ill_formed_constructor env c v =
-  let pc = prterm_env env c in
-  let pv = prterm_env env v in
+  let pc = pr_lconstr_env env c in
+  let pv = pr_lconstr_env env v in
   str "The conclusion of" ++ brk(1,1) ++ pc ++ brk(1,1) ++ 
   str "is not valid;" ++ brk(1,1) ++ str "it must be built from " ++ pv
 
@@ -544,9 +537,9 @@ let str_of_nth n =
      | _ -> "th")
 
 let error_bad_ind_parameters env c n v1 v2  =
-  let pc = prterm_env_at_top env c in
-  let pv1 = prterm_env env v1 in
-  let pv2 = prterm_env env v2 in
+  let pc = pr_lconstr_env_at_top env c in
+  let pv1 = pr_lconstr_env env v1 in
+  let pv2 = pr_lconstr_env env v2 in
   str ("The "^(str_of_nth n)^" argument of ") ++ pv2 ++ brk(1,1) ++
   str "must be " ++ pv1 ++ str " in" ++ brk(1,1) ++ pc
 
@@ -583,10 +576,11 @@ let error_bad_induction dep indid kind =
   str "is not allowed"
 
 let error_not_mutual_in_scheme () =
- str "Induction schemes is concerned only with mutually inductive types"
+ str "Induction schemes are concerned only with distinct mutually inductive types"
+
+(* Inductive constructions errors *)
 
 let explain_inductive_error = function
-  (* These are errors related to inductive constructions *)
   | NonPos (env,c,v) -> error_non_strictly_positive env c v
   | NotEnoughArgs (env,c,v) -> error_ill_formed_inductive env c v
   | NotConstructor (env,c,v) -> error_ill_formed_constructor env c v
@@ -596,7 +590,10 @@ let explain_inductive_error = function
   | SameNamesOverlap idl -> error_same_names_overlap idl
   | NotAnArity id -> error_not_an_arity id
   | BadEntry -> error_bad_entry ()
-  (* These are errors related to recursors *)
+
+(* Recursion schemes errors *)
+
+let explain_recursion_scheme_error = function
   | NotAllowedCaseAnalysis (dep,k,i) ->
       error_not_allowed_case_analysis dep k i
   | BadInduction (dep,indid,kind) -> error_bad_induction dep indid kind
@@ -606,7 +603,7 @@ let explain_inductive_error = function
 
 let explain_bad_pattern ctx cstr ty = 
   let ctx = make_all_name_different ctx in
-  let pt = prterm_env ctx ty in
+  let pt = pr_lconstr_env ctx ty in
   let pc = pr_constructor ctx cstr in
   str "Found the constructor " ++ pc ++ brk(1,1) ++ 
   str "while matching a term of type " ++ pt ++ brk(1,1) ++ 
@@ -620,31 +617,38 @@ let explain_bad_constructor ctx cstr ind =
   str "while a constructor of "  ++ pi ++ brk(1,1)  ++
   str "is expected"
 
-let explain_wrong_numarg_of_constructor ctx cstr n =
-  let pc = pr_constructor ctx cstr in
-  str "The constructor " ++ pc ++ str " expects "  ++
-  (if n = 0 then str "no argument." else if n = 1 then str "1 argument."
-   else (int n  ++ str " arguments."))
+let decline_string n s =
+  if n = 0 then "no "^s
+  else if n = 1 then "1 "^s
+  else (string_of_int n^" "^s^"s")
+
+let explain_wrong_numarg_constructor ctx cstr n =
+  str "The constructor " ++ pr_constructor ctx cstr ++ 
+  str " expects "  ++ str (decline_string n "argument")
+
+let explain_wrong_numarg_inductive ctx ind n =
+  str "The inductive type " ++ pr_inductive ctx ind ++ 
+  str " expects "  ++ str (decline_string n "argument")
 
 let explain_wrong_predicate_arity ctx pred nondep_arity dep_arity=
   let ctx = make_all_name_different ctx in
-  let pp = prterm_env ctx pred in
+  let pp = pr_lconstr_env ctx pred in
   str "The elimination predicate " ++ spc () ++ pp ++ fnl () ++
   str "should be of arity"  ++ spc () ++
-  prterm_env ctx nondep_arity  ++ spc () ++ 
+  pr_lconstr_env ctx nondep_arity  ++ spc () ++ 
   str "(for non dependent case) or"  ++
-  spc () ++ prterm_env ctx dep_arity  ++ spc () ++ str "(for dependent case)."
+  spc () ++ pr_lconstr_env ctx dep_arity  ++ spc () ++ str "(for dependent case)."
 
 let explain_needs_inversion ctx x t =
   let ctx = make_all_name_different ctx in
-  let px = prterm_env ctx x in
-  let pt = prterm_env ctx t in
+  let px = pr_lconstr_env ctx x in
+  let pt = pr_lconstr_env ctx t in
   str "Sorry, I need inversion to compile pattern matching of term " ++
   px  ++ str " of type: " ++ pt
 
 let explain_unused_clause env pats =
-  let s = if List.length pats > 1 then "s" else "" in
 (* Without localisation
+  let s = if List.length pats > 1 then "s" else "" in
   (str ("Unused clause with pattern"^s) ++ spc () ++
     hov 0 (prlist_with_sep pr_spc pr_cases_pattern pats) ++ str ")")
 *)
@@ -659,7 +663,7 @@ let explain_cannot_infer_predicate ctx typs =
   let ctx = make_all_name_different ctx in
   let pr_branch (cstr,typ) =
     let cstr,_ = decompose_app cstr in
-    str "For " ++ prterm_env ctx cstr ++ str " : " ++ prterm_env ctx typ
+    str "For " ++ pr_lconstr_env ctx cstr ++ str " : " ++ pr_lconstr_env ctx typ
   in
   str "Unable to unify the types found in the branches:" ++
   spc () ++ hov 0 (prlist_with_sep pr_fnl pr_branch (Array.to_list typs))
@@ -670,7 +674,9 @@ let explain_pattern_matching_error env = function
   | BadConstructor (c,ind) ->
       explain_bad_constructor env c ind
   | WrongNumargConstructor (c,n) ->
-      explain_wrong_numarg_of_constructor env c n
+      explain_wrong_numarg_constructor env c n
+  | WrongNumargInductive (c,n) ->
+      explain_wrong_numarg_inductive env c n
   | WrongPredicateArity (pred,n,dep) ->
       explain_wrong_predicate_arity env pred n dep
   | NeedsInversion (x,t) ->
@@ -681,3 +687,9 @@ let explain_pattern_matching_error env = function
       explain_non_exhaustive env tms
   | CannotInferPredicate typs ->
       explain_cannot_infer_predicate env typs
+
+let explain_reduction_tactic_error = function
+  | Tacred.InvalidAbstraction (env,c,(env',e)) ->
+      str "The abstracted term" ++ spc() ++ pr_lconstr_env_at_top env c ++ 
+      spc() ++ str "is not well typed." ++ fnl () ++
+      explain_type_error env' e
diff --git a/toplevel/himsg.mli b/toplevel/himsg.mli
index 3e7ba575..92fcafb7 100644
--- a/toplevel/himsg.mli
+++ b/toplevel/himsg.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: himsg.mli,v 1.13.14.1 2004/07/16 19:31:49 herbelin Exp $ i*)
+(*i $Id: himsg.mli 8003 2006-02-07 22:11:50Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -15,6 +15,7 @@ open Indtypes
 open Environ
 open Type_errors
 open Pretype_errors
+open Indrec
 open Cases
 open Logic
 (*i*)
@@ -27,7 +28,12 @@ val explain_pretype_error : env -> pretype_error -> std_ppcmds
 
 val explain_inductive_error : inductive_error -> std_ppcmds
 
+val explain_recursion_scheme_error : recursion_scheme_error -> std_ppcmds
+
 val explain_refiner_error : refiner_error -> std_ppcmds
 
 val explain_pattern_matching_error :
   env -> pattern_matching_error -> std_ppcmds
+
+val explain_reduction_tactic_error :
+  Tacred.reduction_tactic_error -> std_ppcmds
diff --git a/toplevel/line_oriented_parser.ml b/toplevel/line_oriented_parser.ml
index 81221196..77f5198a 100644
--- a/toplevel/line_oriented_parser.ml
+++ b/toplevel/line_oriented_parser.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: line_oriented_parser.ml,v 1.2.16.1 2004/07/16 19:31:49 herbelin Exp $ *)
+(* $Id: line_oriented_parser.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 let line_oriented_channel_to_option stop_string input_channel =
   let count = ref 0 in
diff --git a/toplevel/line_oriented_parser.mli b/toplevel/line_oriented_parser.mli
index 13af0e06..f37472c0 100644
--- a/toplevel/line_oriented_parser.mli
+++ b/toplevel/line_oriented_parser.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: line_oriented_parser.mli,v 1.3.16.1 2004/07/16 19:31:49 herbelin Exp $ i*)
+(*i $Id: line_oriented_parser.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 val line_oriented_channel_to_option: string -> in_channel -> int -> char option
 
diff --git a/toplevel/metasyntax.ml b/toplevel/metasyntax.ml
index 4c554209..92ce6e36 100644
--- a/toplevel/metasyntax.ml
+++ b/toplevel/metasyntax.ml
@@ -6,120 +6,27 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: metasyntax.ml,v 1.105.2.12 2006/01/04 20:31:16 herbelin Exp $ *)
+(* $Id: metasyntax.ml 7822 2006-01-08 17:14:56Z herbelin $ *)
 
 open Pp
 open Util
 open Names
 open Topconstr
-open Coqast
-open Ast
 open Ppextend
 open Extend
-open Esyntax
 open Libobject
-open Library
 open Summary
 open Constrintern
 open Vernacexpr
 open Pcoq
 open Rawterm
 open Libnames
-
-let interp_global_rawconstr_with_vars vars c =
-  interp_rawconstr_gen false Evd.empty (Global.env()) false (vars,[]) c
-
-(**********************************************************************)
-(* Parsing via ast (used in Zsyntax) *)
-
-(* This updates default parsers for Grammar actions and Syntax *)
-(* patterns by inserting globalization *)
-(* Done here to get parsing/g_*.ml4 non dependent from kernel *)
-let constr_to_ast a =
-  Termast.ast_of_rawconstr (interp_rawconstr Evd.empty (Global.env()) a)
-
-(* This installs default quotations parsers to escape the ast parser *)
-(* "constr" is used by default in quotations found in the ast parser *) 
-let constr_parser_with_glob = Pcoq.map_entry constr_to_ast Constr.constr
-
-let _ = define_ast_quotation true "constr" constr_parser_with_glob
+open Lexer
+open Egrammar
+open Notation
 
 (**********************************************************************)
-(* Globalisation for constr_expr *)
-
-let globalize_ref vars ref =
-  match Constrintern.interp_reference (vars,[]) ref with
-  | RRef (loc,VarRef a) -> Ident (loc,a)
-  | RRef (loc,a) -> Qualid (loc,qualid_of_sp (Nametab.sp_of_global a))
-  | RVar (loc,x) -> Ident (loc,x)
-  | _ -> anomaly "globalize_ref: not a reference"
-
-let globalize_ref_term vars ref =
-  match Constrintern.interp_reference (vars,[]) ref with
-  | RRef (loc,VarRef a) -> CRef (Ident (loc,a))
-  | RRef (loc,a) -> CRef (Qualid (loc,qualid_of_sp (Nametab.sp_of_global a)))
-  | RVar (loc,x) -> CRef (Ident (loc,x))
-  | c -> Constrextern.extern_rawconstr Idset.empty c 
-
-let rec globalize_constr_expr vars = function
-  | CRef ref -> globalize_ref_term vars ref
-  | CAppExpl (_,(p,ref),l) ->
-      let f = 
-	map_constr_expr_with_binders globalize_constr_expr
-	  (fun x e -> e) vars
-      in
-      CAppExpl (dummy_loc,(p,globalize_ref vars ref), List.map f l)
-  | c ->
-      map_constr_expr_with_binders globalize_constr_expr (fun id e -> id::e)
-        vars c
-
-let without_translation f x =
-  let old = Options.do_translate () in
-  let oldv7 = !Options.v7 in
-  Options.make_translate false;
-  try let r = f x in Options.make_translate old; Options.v7:=oldv7; r
-  with e -> Options.make_translate old; Options.v7:=oldv7; raise e
-
-let _ = set_constr_globalizer
-  (fun vars e -> for_grammar (without_translation (globalize_constr_expr vars)) e)
-
-(**********************************************************************)
-(** For old ast printer *)
-
-(* Pretty-printer state summary *)
-let _ = 
-  declare_summary "syntax"
-    { freeze_function = Esyntax.freeze;
-      unfreeze_function = Esyntax.unfreeze;
-      init_function = Esyntax.init;
-      survive_module = false;
-      survive_section = false }
-
-(* Pretty-printing objects = syntax_entry *)
-let cache_syntax (_,ppobj) = Esyntax.add_ppobject ppobj
-
-let subst_syntax (_,subst,ppobj) = 
-  Extend.subst_syntax_command Ast.subst_astpat subst ppobj
-
-let (inPPSyntax,outPPSyntax) =
-  declare_object {(default_object "PPSYNTAX") with
-       open_function = (fun i o -> if i=1 then cache_syntax o);
-       cache_function = cache_syntax;
-       subst_function = subst_syntax;
-       classify_function = (fun (_,o) -> Substitute o);       
-       export_function = (fun x -> Some x) }
-
-(* Syntax extension functions (registered in the environnement) *)
-
-(* Checking the pretty-printing rules against free meta-variables.
- * Note that object are checked before they are added in the environment.
- * Syntax objects in compiled modules are not re-checked. *)
-
-let add_syntax_obj whatfor sel =
-(*  if not !Options.v7_only then*)
-  Lib.add_anonymous_leaf (inPPSyntax (interp_syntax_entry whatfor sel))
-
-(* Tokens *)
+(* Tokens                                                             *)
 
 let cache_token (_,s) = Pcoq.lexer.Token.using ("", s)
 
@@ -134,69 +41,40 @@ let (inToken, outToken) =
 let add_token_obj s = Lib.add_anonymous_leaf (inToken s)
 
 (**********************************************************************)
-(* Grammars (especially Tactic Notation) *)
+(* Tactic Notation                                                    *)
 
 let make_terminal_status = function
   | VTerm s -> Some s
   | VNonTerm _ -> None
 
-let qualified_nterm current_univ = function
-  | NtQual (univ, en) -> (univ, en)
-  | NtShort en -> (current_univ, en)
-
-let rec make_tags = function
-  | VTerm s :: l -> make_tags l
+let rec make_tags lev = function
+  | VTerm s :: l -> make_tags lev l
   | VNonTerm (loc, nt, po) :: l ->
-      let (u,nt) = qualified_nterm "tactic" nt in
-      let (etyp, _) = Egrammar.interp_entry_name u nt in
-      etyp :: make_tags l
+      let (etyp, _) = Egrammar.interp_entry_name lev "tactic" nt in
+      etyp :: make_tags lev l
   | [] -> []
 
-let declare_pprule = function
-  (* Pretty-printing rules only for Grammar (Tactic Notation) *)
-  | Egrammar.TacticGrammar (_,pp) ->
-      let f (s,t,p) =
-        Pptactic.declare_extra_tactic_pprule true s (t,p);
-        Pptactic.declare_extra_tactic_pprule false s (t,p) in
-      List.iter f pp
-  | _ -> ()
+let cache_tactic_notation (_,(pa,pp)) =
+  Egrammar.extend_grammar (Egrammar.TacticGrammar pa);
+  Pptactic.declare_extra_tactic_pprule pp
 
-let cache_grammar (_,a) =
-  Egrammar.extend_grammar a;
-  declare_pprule a
+let subst_tactic_parule subst (key,n,p,(d,tac)) =
+  (key,n,p,(d,Tacinterp.subst_tactic subst tac))
 
-let subst_grammar (_,subst,a) =
-  Egrammar.subst_all_grammar_command subst a
+let subst_tactic_notation (_,subst,(pa,pp)) =
+  (subst_tactic_parule subst pa,pp)
 
-let (inGrammar, outGrammar) =
-  declare_object {(default_object "GRAMMAR") with
-       open_function = (fun i o -> if i=1 then cache_grammar o);
-       cache_function = cache_grammar;
-       subst_function = subst_grammar;
+let (inTacticGrammar, outTacticGrammar) =
+  declare_object {(default_object "TacticGrammar") with
+       open_function = (fun i o -> if i=1 then cache_tactic_notation o);
+       cache_function = cache_tactic_notation;
+       subst_function = subst_tactic_notation;
        classify_function = (fun (_,o) -> Substitute o);
        export_function = (fun x -> Some x)}
 
-(**********************************************************************)
-(* V7 Grammar                                                         *)
-
-open Genarg
-
-let check_entry_type (u,n) =
-  if u = "tactic" or u = "vernac" then error "tactic and vernac not supported";
-  match entry_type (get_univ u) n with
-    | None -> Pcoq.create_entry_if_new (get_univ u) n ConstrArgType
-    | Some (ConstrArgType | IdentArgType | RefArgType) -> ()
-    | _ -> error "Cannot arbitrarily extend non constr/ident/ref entries"
-
-let add_grammar_obj univ entryl =
-  let u = create_univ_if_new univ in
-  let g = interp_grammar_command univ check_entry_type entryl in
-  Lib.add_anonymous_leaf (inGrammar (Egrammar.Grammar g))
-
-(**********************************************************************)
-(* V8 Grammar *)
-
-(* Tactic notations *)
+let cons_production_parameter l = function
+  | VTerm _ -> l
+  | VNonTerm (_,_,ido) -> option_cons ido l
 
 let rec tactic_notation_key = function
   | VTerm id :: _ -> id
@@ -207,41 +85,49 @@ let rec next_key_away key t =
   if Pptactic.exists_extra_tactic_pprule key t then next_key_away (key^"'") t
   else key
 
-let locate_tactic_body dir (s,(s',prods as x),e) =
-  let tags = make_tags prods in
-  let s = if s="" then next_key_away (tactic_notation_key prods) tags else s in
-  (s,x,(dir,e)),(s,tags,(s',List.map make_terminal_status prods))
-
-let add_tactic_grammar g =
-  let dir = Lib.cwd () in
-  let pa,pp = List.split (List.map (locate_tactic_body dir) g) in
-  Lib.add_anonymous_leaf (inGrammar (Egrammar.TacticGrammar (pa,pp)))
-
-(* Printing grammar entries *)
+let add_tactic_notation (n,prods,e) =
+  let tags = make_tags n prods in
+  let key = next_key_away (tactic_notation_key prods) tags in
+  let pprule = (key,tags,(n,List.map make_terminal_status prods)) in
+  let ids = List.fold_left cons_production_parameter [] prods in
+  let tac = Tacinterp.glob_tactic_env ids (Global.env()) e in
+  let parule = (key,n,prods,(Lib.cwd(),tac)) in
+  Lib.add_anonymous_leaf (inTacticGrammar (parule,pprule))
 
-let print_grammar univ entry =
-  if !Options.v7 then
-    let u = get_univ univ in
-    let typ = explicitize_entry (fst u) entry in
-    let te,_,_ = get_constr_entry false typ in
-    Gram.Entry.print te
-  else
-    match entry with
-      | "constr" | "operconstr" | "binder_constr" ->
-	  msgnl (str "Entry constr is");
-	  Gram.Entry.print Pcoq.Constr.constr;
-	  msgnl (str "and lconstr is");
-	  Gram.Entry.print Pcoq.Constr.lconstr;
-	  msgnl (str "where binder_constr is");
-	  Gram.Entry.print Pcoq.Constr.binder_constr;
-	  msgnl (str "and operconstr is");
-	  Gram.Entry.print Pcoq.Constr.operconstr;
-      | "pattern" ->
-	  Gram.Entry.print Pcoq.Constr.pattern
-      | "tactic" -> 
-	  Gram.Entry.print Pcoq.Tactic.simple_tactic
-      | _ -> error "Unknown or unprintable grammar entry"
+(**********************************************************************)
+(* Printing grammar entries                                           *)
+
+let print_grammar univ = function
+  | "constr" | "operconstr" | "binder_constr" ->
+      msgnl (str "Entry constr is");
+      Gram.Entry.print Pcoq.Constr.constr;
+      msgnl (str "and lconstr is");
+      Gram.Entry.print Pcoq.Constr.lconstr;
+      msgnl (str "where binder_constr is");
+      Gram.Entry.print Pcoq.Constr.binder_constr;
+      msgnl (str "and operconstr is");
+      Gram.Entry.print Pcoq.Constr.operconstr;
+  | "pattern" ->
+      Gram.Entry.print Pcoq.Constr.pattern
+  | "tactic" -> 
+      msgnl (str "Entry tactic_expr is");
+      Gram.Entry.print Pcoq.Tactic.tactic_expr;
+      msgnl (str "Entry simple_tactic is");
+      Gram.Entry.print Pcoq.Tactic.simple_tactic;
+  | "vernac" -> 
+      msgnl (str "Entry vernac is");
+      Gram.Entry.print Pcoq.Vernac_.vernac;
+      msgnl (str "Entry command is");
+      Gram.Entry.print Pcoq.Vernac_.command;
+      msgnl (str "Entry syntax is");
+      Gram.Entry.print Pcoq.Vernac_.syntax;
+      msgnl (str "Entry gallina is");
+      Gram.Entry.print Pcoq.Vernac_.gallina;
+      msgnl (str "Entry gallina_ext is");
+      Gram.Entry.print Pcoq.Vernac_.gallina_ext;
+  | _ -> error "Unknown or unprintable grammar entry"
 
+(**********************************************************************)
 (* Parse a format (every terminal starting with a letter or a single
    quote (except a single quote alone) must be quoted) *)
 
@@ -342,12 +228,12 @@ let parse_format (loc,str) =
     Stdpp.raise_with_loc loc e
 
 (***********************)
-(* Analysing notations *)
-
-open Symbols
+(* Analyzing notations *)
 
 type symbol_token = WhiteSpace of int | String of string
 
+(* Decompose the notation string into tokens *)
+
 let split_notation_string str =
   let push_token beg i l =
     if beg = i then l else
@@ -376,6 +262,43 @@ let split_notation_string str =
   in
   loop 0 0
 
+(* Interpret notations with a recursive component *)
+
+let rec find_pattern xl = function
+  | Break n as x :: l, Break n' :: l' when n=n' -> 
+      find_pattern (x::xl) (l,l')
+  | Terminal s as x :: l, Terminal s' :: l' when s = s' -> 
+      find_pattern (x::xl) (l,l')
+  | [NonTerminal x], NonTerminal x' :: l' ->
+      (x,x',xl),l'
+  | [NonTerminal _], Terminal s :: _ | Terminal s :: _, _ ->
+      error ("The token "^s^" occurs on one side of \"..\" but not on the other side")
+  | [NonTerminal _], Break s :: _ | Break s :: _, _ ->
+      error ("A break occurs on one side of \"..\" but not on the other side")
+  | ((SProdList _ | NonTerminal _) :: _ | []), _ -> 
+      error ("The special symbol \"..\" must occur in a configuration of the form\n\"x symbs .. symbs y\"")
+
+let rec interp_list_parser hd = function
+  | [] -> [], List.rev hd
+  | NonTerminal id :: tl when id = ldots_var ->
+      let ((x,y,sl),tl') = find_pattern [] (hd,tl) in
+      let yl,tl'' = interp_list_parser [] tl' in
+      (* We remember the second copy of each recursive part variable to *)
+      (* remove it afterwards *)
+      y::yl, SProdList (x,sl) :: tl''
+  | (Terminal _ | Break _) as s :: tl ->
+      if hd = [] then 
+        let yl,tl' = interp_list_parser [] tl in
+        yl, s :: tl'
+      else
+        interp_list_parser (s::hd) tl
+  | NonTerminal _ as x :: tl ->
+      let yl,tl' = interp_list_parser [x] tl in
+      yl, List.rev_append hd tl'
+  | SProdList _ :: _ -> anomaly "Unexpected SProdList in interp_list_parser"
+
+(* Find non-terminal tokens of notation *)
+
 let unquote_notation_token s =
   let n = String.length s in
   if n > 2 & s.[0] = '\'' & s.[n-1] = '\'' then String.sub s 1 (n-2) else s
@@ -410,38 +333,12 @@ let rec raw_analyse_notation_tokens = function
       let (vars,l) = raw_analyse_notation_tokens sl in
       (vars, Break n :: l)
 
-let rec find_pattern xl = function
-  | Break n as x :: l, Break n' :: l' when n=n' -> 
-      find_pattern (x::xl) (l,l')
-  | Terminal s as x :: l, Terminal s' :: l' when s = s' -> 
-      find_pattern (x::xl) (l,l')
-  | [NonTerminal x], NonTerminal x' :: l' ->
-      (x,x',xl),l'
-  | [NonTerminal _], Terminal s :: _ | Terminal s :: _, _ ->
-      error ("The token "^s^" occurs on one side of \"..\" but not on the other side")
-  | [NonTerminal _], Break s :: _ | Break s :: _, _ ->
-      error ("A break occurs on one side of \"..\" but not on the other side")
-  | ((SProdList _ | NonTerminal _) :: _ | []), _ -> 
-      error ("The special symbol \"..\" must occur in a configuration of the form\n\"x symbs .. symbs y\"")
-
-let rec interp_list_parser hd = function
-  | [] -> [], List.rev hd
-  | NonTerminal id :: tl when id = ldots_var ->
-      let ((x,y,sl),tl') = find_pattern [] (hd,tl) in
-      let yl,tl'' = interp_list_parser [] tl' in
-      (* We remember the second copy of each recursive part variable to *)
-      (* remove it afterwards *)
-      y::yl, SProdList (x,sl) :: tl''
-  | (Terminal _ | Break _) as s :: tl ->
-      if hd = [] then 
-        let yl,tl' = interp_list_parser [] tl in
-        yl, s :: tl'
-      else
-        interp_list_parser (s::hd) tl
-  | NonTerminal _ as x :: tl ->
-      let yl,tl' = interp_list_parser [x] tl in
-      yl, List.rev_append hd tl'
-  | SProdList _ :: _ -> anomaly "Unexpected SProdList in interp_list_parser"
+let is_numeral symbs = 
+  match List.filter (function Break _ -> false | _ -> true) symbs with
+  | ([Terminal "-"; Terminal x] | [Terminal x]) ->
+      (try let _ = Bigint.of_string x in true with _ -> false)
+  | _ ->
+      false
 
 let analyse_notation_tokens l =
   let vars,l = raw_analyse_notation_tokens l in
@@ -450,7 +347,8 @@ let analyse_notation_tokens l =
 
 let remove_vars = List.fold_right List.remove_assoc
  
-(* Build the syntax and grammar rules *)
+(**********************************************************************)
+(* Build pretty-printing rules                                        *)
 
 type printing_precedence = int * parenRelation
 type parsing_precedence = int option
@@ -460,15 +358,10 @@ let prec_assoc = function
   | Gramext.LeftA -> (E,L)
   | Gramext.NonA -> (L,L)
 
-(* For old ast printer *)
-let meta_pattern m = Pmeta(m,Tany)
-
-type white_status = Juxtapose | Separate of int | NextIsTerminal
-
 let precedence_of_entry_type from = function
   | ETConstr (NumLevel n,BorderProd (_,None)) -> n, Prec n
-  | ETConstr (NumLevel n,BorderProd (left,Some a)) ->
-      n, let (lp,rp) = prec_assoc a in if left then lp else rp
+  | ETConstr (NumLevel n,BorderProd (b,Some a)) ->
+      n, let (lp,rp) = prec_assoc a in if b=Left then lp else rp
   | ETConstr (NumLevel n,InternalProd) -> n, Prec n
   | ETConstr (NextLevel,_) -> from, L
   | ETOther ("constr","annot") -> 10, Prec 10
@@ -506,57 +399,15 @@ 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] = '~')
 
-type previous_prod_status = NoBreak | CanBreak
-
 let rec is_non_terminal = function
   | NonTerminal _ | SProdList _ -> true
   | _ -> false
 
-let add_break n l = UNP_BRK (n,1) :: l
-
-(* For old ast printer *)
-let make_hunks_ast symbols etyps from =
-  let rec make ws = function
-    | NonTerminal m :: prods ->
-	let _,lp = precedence_of_entry_type from (List.assoc m etyps) in
-	let u = PH (meta_pattern (string_of_id m), None, lp) in
-	if prods <> [] && is_non_terminal (List.hd prods) then
-	  u :: add_break 1 (make CanBreak prods)
-	else
-	  u :: make CanBreak prods
-
-    | Terminal s :: prods when List.exists is_non_terminal prods ->
-	let protect =
-	  is_letter s.[0] ||
-	  (is_non_terminal (List.hd prods) &&
-	    (is_letter (s.[String.length s -1])) ||
-	    (is_digit (s.[String.length s -1]))) in
-	if is_comma s || is_right_bracket s then
-	  RO s :: add_break 0 (make NoBreak prods)
-	else if (is_operator s || is_left_bracket s) && ws = CanBreak then
-	  add_break (if protect then 1 else 0)
-	    (RO (if protect then s^" " else s) :: make CanBreak prods)
-	else
-          if protect then
-            (if ws = CanBreak then add_break 1 else (fun x -> x))
-	    (RO (s^" ") :: make CanBreak prods)
-          else
-	    RO s :: make CanBreak prods
-
-    | Terminal s :: prods ->
-	RO s :: make NoBreak prods
-
-    | Break n :: prods ->
-	add_break n (make NoBreak prods)
-
-    | SProdList _ :: _ ->
-        anomaly "Recursive notations not supported in old syntax"
-
-    | [] -> []
+let add_break n l = UnpCut (PpBrk(n,0)) :: l
 
-  in make NoBreak symbols
+(* Heuristics for building default printing rules *)
 
-let add_break n l = UnpCut (PpBrk(n,0)) :: l
+type previous_prod_status = NoBreak | CanBreak
 
 let make_hunks etyps symbols from =
   let vars,typs = List.split etyps in
@@ -621,6 +472,8 @@ let make_hunks etyps symbols from =
 
   in make NoBreak symbols
 
+(* Build default printing rules from explicit format *)
+
 let error_format () = error "The format does not match the notation"
 
 let rec split_format_at_ldots hd = function
@@ -656,12 +509,12 @@ let read_recursive_format sl fmt =
   let slfmt, fmt = get_head fmt in
   slfmt, get_tail (slfmt, fmt)
 
-let hunks_of_format (from,(vars,typs) as vt) symfmt = 
+let hunks_of_format (from,(vars,typs)) symfmt = 
   let rec aux = function
   | symbs, (UnpTerminal s' as u) :: fmt
       when s' = String.make (String.length s') ' ' ->
       let symbs, l = aux (symbs,fmt) in symbs, u :: l
-  | Terminal s :: symbs, (UnpTerminal s' as u) :: fmt
+  | Terminal s :: symbs, (UnpTerminal s') :: fmt
       when s = unquote_notation_token s' ->
       let symbs, l = aux (symbs,fmt) in symbs, UnpTerminal s :: l
   | NonTerminal s :: symbs, UnpTerminal s' :: fmt when s = id_of_string s' ->
@@ -689,36 +542,31 @@ let hunks_of_format (from,(vars,typs) as vt) symfmt =
   | [], l -> l
   | _ -> error_format ()
 
-let string_of_prec (n,p) =
-  (string_of_int n)^(match p with E -> "E" | L -> "L" | _ -> "")
+(**********************************************************************)
+(* Build parsing rules                                                *)
 
 let assoc_of_type n (_,typ) = precedence_of_entry_type n typ
 
-let string_of_assoc = function
-  | Some(Gramext.RightA) -> "RIGHTA"
-  | Some(Gramext.LeftA) | None -> "LEFTA"
-  | Some(Gramext.NonA) -> "NONA"
-
 let is_not_small_constr = function
     ETConstr _ -> true
   | ETOther("constr","binder_constr") -> true
   | _ -> false
 
-let rec define_keywords = function
+let rec define_keywords_aux = function
     NonTerm(_,Some(_,e)) as n1 :: Term("IDENT",k) :: l
-     when not !Options.v7 && is_not_small_constr e ->
+      when is_not_small_constr e ->
       prerr_endline ("Defining '"^k^"' as keyword");
       Lexer.add_token("",k);
-      n1 :: Term("",k) :: define_keywords l
-  | n :: l -> n :: define_keywords l
+      n1 :: Term("",k) :: define_keywords_aux l
+  | n :: l -> n :: define_keywords_aux l
   | [] -> []
 
 let define_keywords = function
-    Term("IDENT",k)::l when not !Options.v7 ->
+    Term("IDENT",k)::l ->
       prerr_endline ("Defining '"^k^"' as keyword");
       Lexer.add_token("",k);
-      Term("",k) :: define_keywords l
-  | l -> define_keywords l
+      Term("",k) :: define_keywords_aux l
+  | l -> define_keywords_aux l
 
 let make_production etyps symbols =
   let prod =
@@ -728,12 +576,12 @@ let make_production etyps symbols =
 	    let typ = List.assoc m etyps in
 	    NonTerm (typ, Some (m,typ)) :: l
         | Terminal s ->
-	    Term (Extend.terminal s) :: l
+	    Term (terminal s) :: l
         | Break _ ->
             l
         | SProdList (x,sl) ->
             let sl = List.flatten
-              (List.map (function Terminal s -> [Extend.terminal s] 
+              (List.map (function Terminal s -> [terminal s] 
                 | Break _ -> []
                 | _ -> anomaly "Found a non terminal token in recursive notation separator") sl) in
 	    let y = match List.assoc x etyps with
@@ -766,44 +614,8 @@ let recompute_assoc typs =
     | _, Some Gramext.RightA -> Some Gramext.RightA
     | _ -> None
 
-let make_grammar_rule n typs symbols ntn perm =
-  let assoc = recompute_assoc typs in
-  let prod = make_production typs symbols in
-  (n,assoc,ntn,prod, perm)
-
-(* For old ast printer *)
-let metas_of sl =
-  List.fold_right
-    (fun it metatl -> match it with
-      | NonTerminal m -> m::metatl
-      | _ -> metatl)
-    sl []
-
-(* For old ast printer *)
-let make_pattern symbols ast =
-  let env = List.map (fun m -> (string_of_id m,ETast)) (metas_of symbols) in
-  fst (to_pat env ast)
-
-(* For old ast printer *)
-let make_syntax_rule n name symbols typs ast ntn sc =
-  [{syn_id = name;
-    syn_prec = n;
-    syn_astpat = make_pattern symbols ast;
-    syn_hunks =
-      [UNP_SYMBOLIC(sc,ntn,UNP_BOX (PpHOVB 1,make_hunks_ast symbols typs n))]}]
-
-let make_pp_rule (n,typs,symbols,fmt) =
-  match fmt with
-    | None -> [UnpBox (PpHOVB 0, make_hunks typs symbols n)]
-    | Some fmt -> 
-	[UnpBox (PpHOVB 0, 
-	 hunks_of_format (n,List.split typs) (symbols,parse_format fmt))]
-
 (**************************************************************************)
-(* Syntax extenstion: common parsing/printing rules and no interpretation *)
-
-(* v7 and translator : prec is for v7 (None if V8Notation), prec8 is for v8 *)
-(* v8 : prec is for v8, prec8 is the same *)
+(* Registration of syntax extensions (parsing/printing, no interpretation)*)
 
 let pr_arg_level from = function
   | (n,L) when n=from -> str "at next level"
@@ -813,66 +625,38 @@ let pr_arg_level from = function
   | (n,_) -> str "Unknown level"
 
 let pr_level ntn (from,args) =
-  let lopen = ntn.[0] = '_' and ropen = ntn.[String.length ntn - 1] = '_' in
-(*
-  let ppassoc, args = match args with
-    | [] -> mt (), []
-    | (nl,lpr)::l when nl=from & fst (list_last l)=from ->
-	let (_,rpr),l = list_sep_last l in
-	match lpr, snd (list_last l) with
-	  | L,E -> Gramext.RightA, l
-	  | E,L -> Gramext.LeftA, l
-	  | L,L -> Gramext.NoneA, l
-	  | _ -> args
-*)
   str "at level " ++ int from ++ spc () ++ str "with arguments" ++ spc() ++
   prlist_with_sep pr_coma (pr_arg_level from) args
 
-(* In v8: prec = Some prec8 is for both parsing and printing *)
-(* In v7 and translator: 
-     prec is for parsing (None if V8Notation), 
-     prec8 for v8 printing (v7 printing is via ast) *)
-let cache_syntax_extension (_,(_,((prec,prec8),ntn,gr,se))) =
+let error_incompatible_level ntn oldprec prec =
+  errorlabstrm ""
+    (str ("Notation "^ntn^" is already defined") ++ spc() ++ 
+    pr_level ntn oldprec ++ 
+    spc() ++ str "while it is now required to be" ++ spc() ++ 
+    pr_level ntn prec)
+
+let cache_one_syntax_extension (prec,ntn,gr,pp) =
   try 
-    let oldprec, oldprec8 = Symbols.level_of_notation ntn in
-    if prec8 <> oldprec8 & (Options.do_translate () or not !Options.v7) then
-      errorlabstrm ""
-	(str ((if Options.do_translate () then "For new syntax, notation "
-	else "Notation ")
-	^ntn^" is already defined") ++ spc() ++ pr_level ntn oldprec8 ++ 
-	spc() ++ str "while it is now required to be" ++ spc() ++ 
-	pr_level ntn prec8)
-    else
-      (* Inconsistent v8 notations but not while translating; forget... *)
-      ();
-    (* V8 notations are consistent (from both translator or v8) *)
-    if prec <> None & !Options.v7 then begin
-      (* Update the V7 parsing rule *)
-      if oldprec <> None & out_some oldprec <> out_some prec then
-	(* None of them is V8Notation and they are different: warn *)
-	Options.if_verbose
-	  warning ("Notation "^ntn^
-	  " was already assigned a different level or sublevels");
-      if oldprec = None or out_some oldprec <> out_some prec then
-        Egrammar.extend_grammar (Egrammar.Notation (out_some prec,out_some gr))
-    end
+    let oldprec = Notation.level_of_notation ntn in
+    if prec <> oldprec then error_incompatible_level ntn oldprec prec
   with Not_found ->
     (* Reserve the notation level *)
-    Symbols.declare_notation_level ntn (prec,prec8);
+    Notation.declare_notation_level ntn prec;
     (* Declare the parsing rule *)
-    option_iter (fun gr -> 
-      Egrammar.extend_grammar (Egrammar.Notation (out_some prec,gr))) gr;
+    Egrammar.extend_grammar (Egrammar.Notation (prec,gr));
     (* Declare the printing rule *)
-    Symbols.declare_notation_printing_rule ntn (se,fst prec8)
+    Notation.declare_notation_printing_rule ntn (pp,fst prec)
+
+let cache_syntax_extension (_,(_,sy_rules)) =
+  List.iter cache_one_syntax_extension sy_rules
 
-let subst_notation_grammar subst x = x
+let subst_parsing_rule subst x = x
 
 let subst_printing_rule subst x = x
 
-let subst_syntax_extension (_,subst,(local,(prec,ntn,gr,se))) =
-  (local,(prec,ntn,
-   option_app (subst_notation_grammar subst) gr,
-   subst_printing_rule subst se))
+let subst_syntax_extension (_,subst,(local,sy)) =
+  (local, List.map (fun (prec,ntn,gr,pp) ->
+     (prec,ntn, subst_parsing_rule subst gr, subst_printing_rule subst pp)) sy)
 
 let classify_syntax_definition (_,(local,_ as o)) =
   if local then Dispose else Substitute o
@@ -888,6 +672,11 @@ let (inSyntaxExtension, outSyntaxExtension) =
        classify_function = classify_syntax_definition;
        export_function = export_syntax_definition}
 
+(**************************************************************************)
+(* Precedences                                                            *)
+
+(* Interpreting user-provided modifiers *)
+
 let interp_modifiers modl =
   let onlyparsing = ref false in
   let rec interp assoc level etyps format = function
@@ -896,23 +685,22 @@ let interp_modifiers modl =
     | SetEntryType (s,typ) :: l ->
 	let id = id_of_string s in
 	if List.mem_assoc id etyps then
-	  error (s^" is already assigned to an entry or constr level")
-	else interp assoc level ((id,typ)::etyps) format l
+	  error (s^" is already assigned to an entry or constr level");
+	interp assoc level ((id,typ)::etyps) format l
     | SetItemLevel ([],n) :: l ->
 	interp assoc level etyps format l
     | SetItemLevel (s::idl,n) :: l ->
 	let id = id_of_string s in
 	if List.mem_assoc id etyps then
-	  error (s^" is already assigned to an entry or constr level")
-	else
-	  let typ = ETConstr (n,()) in
-	  interp assoc level ((id,typ)::etyps) format (SetItemLevel (idl,n)::l)
+	  error (s^" is already assigned to an entry or constr level");
+	let typ = ETConstr (n,()) in
+	interp assoc level ((id,typ)::etyps) format (SetItemLevel (idl,n)::l)
     | SetLevel n :: l ->
-	if level <> None then error "A level is given more than once"
-	else interp assoc (Some n) etyps format l
+	if level <> None then error "A level is given more than once";
+	interp assoc (Some n) etyps format l
     | SetAssoc a :: l ->
-	if assoc <> None then error "An associativity is given more than once"
-	else interp (Some a) level etyps format l
+	if assoc <> None then error "An associativity is given more than once";
+	interp (Some a) level etyps format l
     | SetOnlyParsing :: l ->
 	onlyparsing := true;
 	interp assoc level etyps format l
@@ -921,21 +709,15 @@ let interp_modifiers modl =
 	interp assoc level etyps (Some s) l
   in interp None None [] None modl
 
-let merge_modifiers a n l =
-  (match a with None -> [] | Some a -> [SetAssoc a]) @
-  (match n with None -> [] | Some n -> [SetLevel n]) @ l
-
-let interp_infix_modifiers modl =
-  let (assoc,level,t,b,fmt) = interp_modifiers modl in
+let check_infix_modifiers modifiers =
+  let (assoc,level,t,b,fmt) = interp_modifiers modifiers in
   if t <> [] then
-    error "explicit entry level or type unexpected in infix notation";
-  (assoc,level,b,fmt)
+    error "explicit entry level or type unexpected in infix notation"
+
+let no_syntax_modifiers modifiers = 
+  modifiers = [] or modifiers = [SetOnlyParsing]
 
-(* 2nd list of types has priority *)
-let rec merge_entry_types etyps' = function
-  | [] -> etyps'
-  | (x,_ as e)::etyps ->
-      e :: merge_entry_types (List.remove_assoc x etyps') etyps
+(* Compute precedences from modifiers (or find default ones) *)
 
 let set_entry_type etyps (x,typ) =
   let typ = try 
@@ -948,7 +730,7 @@ let set_entry_type etyps (x,typ) =
     with Not_found -> ETConstr typ
   in (x,typ)
 
-let check_rule_reversibility l = 
+let check_rule_productivity l = 
   if List.for_all (function NonTerminal _ -> true | _ -> false) l then
     error "A notation must include at least one symbol"
 
@@ -956,17 +738,6 @@ let is_not_printable = function
   | AVar _ -> warning "This notation won't be used for printing as it is bound to a \nsingle variable"; true
   | _ -> false
 
-let find_precedence_v7 lev etyps symbols =
-  (match symbols with
-    | NonTerminal x :: _ ->
-	(try match List.assoc x etyps with
-	  | ETConstr _ ->
-	      error "The level of the leftmost non-terminal cannot be changed"
-	  | _ -> ()
-	with Not_found -> ())
-    | _ -> ());
-  if lev = None then 1 else out_some lev
-
 let find_precedence lev etyps symbols =
   match symbols with
   | NonTerminal x :: _ ->
@@ -1000,7 +771,7 @@ let find_precedence lev etyps symbols =
       out_some lev
 
 let check_curly_brackets_notation_exists () =
-  try let _ = Symbols.level_of_notation "{ _ }" in ()
+  try let _ = Notation.level_of_notation "{ _ }" in ()
   with Not_found -> 
     error "Notations involving patterns of the form \"{ _ }\" are treated \n\
 specially and require that the notation \"{ _ }\" is already reserved"
@@ -1028,95 +799,59 @@ let remove_curly_brackets l =
   | x :: l -> x :: aux false l
   in aux true l
 
-let compute_syntax_data forv7 (df,modifiers) =
+let compute_syntax_data (df,modifiers) =
   let (assoc,n,etyps,onlyparse,fmt) = interp_modifiers modifiers in
   (* Notation defaults to NONA *)
   let assoc = match assoc with None -> Some Gramext.NonA | a -> a in
   let toks = split_notation_string df in
   let (recvars,vars,symbols) = analyse_notation_tokens toks in
   let ntn_for_interp = make_notation_key symbols in
-  let symbols = remove_curly_brackets symbols in
-  let notation = make_notation_key symbols in
-  check_rule_reversibility symbols;
-  let n =
-    if !Options.v7 then find_precedence_v7 n etyps symbols
-    else find_precedence n etyps symbols in
-  let innerlevel = NumLevel (if forv7 then 10 else 200) in
+  let symbols' = remove_curly_brackets symbols in
+  let need_squash = (symbols <> symbols') in
+  let ntn_for_grammar = make_notation_key symbols' in
+  check_rule_productivity symbols';
+  let n = find_precedence n etyps symbols' in
+  let innerlevel = NumLevel 200 in
   let typs =
     find_symbols
-      (NumLevel n,BorderProd(true,assoc))
+      (NumLevel n,BorderProd(Left,assoc))
       (innerlevel,InternalProd)
-      (NumLevel n,BorderProd(false,assoc))
-      symbols in
+      (NumLevel n,BorderProd(Right,assoc))
+      symbols' in
   (* To globalize... *)
   let typs = List.map (set_entry_type etyps) typs in
-  let ppdata = (n,typs,symbols,fmt) in
   let prec = (n,List.map (assoc_of_type n) typs) in
-  ((onlyparse,recvars,vars,
-    ntn_for_interp,notation),prec,ppdata,(Lib.library_dp(),df))
-
-(* Uninterpreted (reserved) notations *)
-let add_syntax_extension local mv mv8 =
-  (* from v7: 
-       if mv8 <> None: tells the translator how to print in v8
-       if mv <> None: tells how to parse and, how to print in v7
-       mv = None = mv8 does not occur   
-     from v8 (mv8 is always None and mv is always Some)
-       mv tells how to parse and print in v8
-  *)
-  let data8 = option_app (compute_syntax_data false) mv8 in
-  let data = option_app (compute_syntax_data !Options.v7) mv in
-  let prec,gram_rule = match data with
-  | None -> None, None (* Case of V8Notation from v7 *)
-  | Some ((_,_,_,_,notation),prec,(n,typs,symbols,_),_) -> 
-      Some prec, Some (make_grammar_rule n typs symbols notation None) in
-  match data, data8 with
-  | None, None -> (* Nothing to do: V8Notation while not translating *) () 
-  | _, Some d | Some d, None ->
-    let ((_,_,_,_,ntn),ppprec,ppdata,_) = d in (* tells how to print *)
-    let ntn' = match data with Some ((_,_,_,_,ntn),_,_,_) -> ntn | _ -> ntn in
-    let pp_rule = make_pp_rule ppdata in
-    Lib.add_anonymous_leaf
-      (inSyntaxExtension (local,((prec,ppprec),ntn',gram_rule,pp_rule)))
+  let sy_data = (ntn_for_grammar,prec,need_squash,(n,typs,symbols',fmt)) in
+  let df' = (Lib.library_dp(),df) in
+  let i_data = (onlyparse,recvars,vars,(ntn_for_interp,df')) in
+  (i_data,sy_data)
 
 (**********************************************************************)
-(* Distfix, Infix, Symbols *)
-
-(* A notation comes with a grammar rule, a pretty-printing rule, an
-   identifiying pattern called notation and an associated scope *)
-let load_notation _ (_,(_,_,ntn,scope,pat,onlyparse,_,_)) =
-  option_iter Symbols.declare_scope scope
-
-let open_notation i (_,(_,oldse,ntn,scope,pat,onlyparse,pp8only,df)) =
-  if i=1 then begin
-    let b,oldpp8only = Symbols.exists_notation_in_scope scope ntn pat in
-    (* Declare the old printer rule and its interpretation *)
-    if (not b or oldpp8only) & oldse <> None then
-      Esyntax.add_ppobject {sc_univ="constr";sc_entries=out_some oldse};
+(* Registration of notations interpretation                            *)
+
+let load_notation _ (_,(_,scope,pat,onlyparse,_)) =
+  option_iter Notation.declare_scope scope
+
+let open_notation i (_,(_,scope,pat,onlyparse,(ntn,df))) =
+  if i=1 & not (Notation.exists_notation_in_scope scope ntn pat) then begin
     (* Declare the interpretation *)
-    if not b then
-      Symbols.declare_notation_interpretation ntn scope pat df pp8only;
-    if oldpp8only & not pp8only then
-      Options.silently 
-	(Symbols.declare_notation_interpretation ntn scope pat df) pp8only;
-    if not b & not onlyparse then
-      Symbols.declare_uninterpretation (NotationRule (scope,ntn)) pat
+    Notation.declare_notation_interpretation ntn scope pat df;
+    (* Declare the uninterpretation *)
+    if not onlyparse then
+      Notation.declare_uninterpretation (NotationRule (scope,ntn)) pat
   end
 
 let cache_notation o =
   load_notation 1 o;
   open_notation 1 o
 
-let subst_notation (_,subst,(lc,oldse,ntn,scope,(metas,pat),b,b',df)) =
-  (lc,option_app
-    (list_smartmap (Extend.subst_syntax_entry Ast.subst_astpat subst)) oldse,
-   ntn,scope,
-   (metas,subst_aconstr subst pat), b, b', df)
+let subst_notation (_,subst,(lc,scope,(metas,pat),b,ndf)) =
+  (lc,scope,(metas,subst_aconstr subst (List.map fst metas) pat),b,ndf)
 
-let classify_notation (_,(local,_,_,_,_,_,_,_ as o)) =
+let classify_notation (_,(local,_,_,_,_ as o)) =
   if local then Dispose else Substitute o
 
-let export_notation (local,_,_,_,_,_,_,_ as o) =
+let export_notation (local,_,_,_,_ as o) =
   if local then None else Some o
 
 let (inNotation, outNotation) =
@@ -1128,37 +863,8 @@ let (inNotation, outNotation) =
        classify_function = classify_notation;
        export_function = export_notation}
 
-(* For old ast printer *)
-let rec reify_meta_ast vars = function
-  | Smetalam (loc,s,body) -> Smetalam (loc,s,reify_meta_ast vars body)
-(*  | Node(loc,"META",[Num (_,n)]) -> Nmeta (loc,create_meta n)*)
-  | Node(loc,"ISEVAR",[]) -> Nmeta (loc,"$_")
-  | Node(loc,op,args) -> Node (loc,op, List.map (reify_meta_ast vars) args)
-  | Slam(loc,Some id,body) when List.mem id vars ->
-      Smetalam (loc,string_of_id id,reify_meta_ast vars body)
-  | Slam(loc,na,body) -> Slam(loc,na,reify_meta_ast vars body)
-  | Nvar (loc,id) when List.mem id vars -> Nmeta (loc,string_of_id id)
-  | Nmeta _ | Id _ | Nvar _ | Str _ | Num _ | Path _ as a -> a
-  | Dynamic _ as a -> (* Hum... what to do here *) a
-
-(* For old ast syntax *)
-let make_old_pp_rule n symbols typs r ntn scope vars =
-  let ast = Termast.ast_of_rawconstr r in
-  let ast = reify_meta_ast vars ast in
-  let scope_name = match scope with Some s -> s | None -> "core_scope" in
-  let rule_name = ntn^"_"^scope_name^"_notation" in
-  make_syntax_rule n rule_name symbols typs ast ntn scope
-
-(* maps positions in v8-notation into positions in v7-notation (used
-   for parsing).
-   For instance  Notation "x < y < z" := .. V8only "y < z < x"
-   yields [1; 2; 0] (y is the second arg in v7; z is 3rd; x is fst) *)
-let mk_permut vars7 vars8 =
-  if vars7=vars8 then None else
-    Some
-      (List.fold_right
-        (fun v8 subs -> list_index v8 vars7 - 1 :: subs)
-        vars8 [])
+(**********************************************************************)
+(* Recovering existing syntax                                         *)
 
 let contract_notation ntn =
   if ntn = "{ _ }" then ntn else
@@ -1173,304 +879,120 @@ let contract_notation ntn =
     else ntn in
   aux ntn 0
 
-let add_notation_in_scope local df c mods omodv8 scope =
-  let ((onlyparse,recs,vars,intnot,notation),prec,(n,typs,symbols,_ as ppdata),df')=
-    compute_syntax_data !Options.v7 (df,mods) in
-  (* Declare the parsing and printing rules if not already done *)
-    (* For both v7 and translate: parsing is as described for v7 in v7 file *)
-    (* For v8: parsing is as described in v8 file *)
-    (* For v7: printing is by the old printer - see below *)
-    (* For translate: printing is as described for v8 in v7 file *)
-    (* For v8: printing is as described in v8 file *)
-    (* In short: parsing does not depend on omodv8 *)
-    (* Printing depends on mv8 if defined, otherwise of mods (scaled by 10) *)
-    (* if in v7, or of mods without scaling if in v8 *)
-  let intnot,ntn,pprecvars,ppvars,ppprec,pp_rule =
-    match omodv8 with
-    | Some mv8 ->
-        let (_,recs8,vars8,intnot8,ntn8),p,d,_ = compute_syntax_data false mv8 in
-        intnot8,ntn8,recs8,vars8,p,make_pp_rule d
-    | None when not !Options.v7 -> 
-        intnot,notation,recs,vars,prec,make_pp_rule ppdata
-    | None ->
-	(* means the rule already exists: recover it *)
-        (* occurs only with V8only flag alone *)
-	try 
-          let ntn = contract_notation notation in
-	  let _, oldprec8 = Symbols.level_of_notation ntn in
-	  let rule,_ = Symbols.find_notation_printing_rule ntn in
-	  notation,ntn,recs,vars,oldprec8,rule
-	with Not_found -> error "No known parsing rule for this notation in V8"
-  in
-  let permut = mk_permut vars ppvars in
-  let gram_rule = make_grammar_rule n typs symbols ntn permut in
-  Lib.add_anonymous_leaf
-    (inSyntaxExtension
-      (local,((Some prec,ppprec),ntn,Some gram_rule,pp_rule)));
-
-  (* Declare interpretation *)
-  let (acvars,ac) = interp_aconstr [] ppvars c in
-  let a = (remove_vars pprecvars acvars,ac) (* For recursive parts *) in
-  let old_pp_rule =
-    (* Used only by v7; disable if contains a recursive pattern *)
-    if onlyparse or pprecvars <> [] or not (!Options.v7) then None
-    else
-      let r = interp_global_rawconstr_with_vars vars c in
-      Some (make_old_pp_rule n symbols typs r intnot scope vars) in
-  let onlyparse = onlyparse or !Options.v7_only or is_not_printable ac in
-  Lib.add_anonymous_leaf
-    (inNotation(local,old_pp_rule,intnot,scope,a,onlyparse,false,df'))
-
-let level_rule (n,p) = if p = E then n else max (n-1) 0
+exception NoSyntaxRule
 
-let recover_syntax ntn = 
+let recover_syntax ntn =
   try 
-    match Symbols.level_of_notation ntn with
-      | (Some prec,_ as pprec) -> 
-	  let rule,_ = Symbols.find_notation_printing_rule ntn in
-	  let gr = Egrammar.recover_notation_grammar ntn prec in
-	  Some (pprec,ntn,Some gr,rule)
-      | None,_ -> None
-  with Not_found -> None
+    let prec = Notation.level_of_notation ntn in
+    let pprule,_ = Notation.find_notation_printing_rule ntn in
+    let gr = Egrammar.recover_notation_grammar ntn prec in
+    (prec,ntn,gr,pprule)
+  with Not_found ->
+    raise NoSyntaxRule
+
+let recover_squash_syntax () = recover_syntax "{ _ }"
 
 let recover_notation_syntax rawntn =
   let ntn = contract_notation rawntn in
-  match recover_syntax ntn with
-    | None -> None
-    | Some gr -> Some (gr,if ntn=rawntn then None else recover_syntax "{ _ }")
-
-let set_data_for_v7_pp recs a vars =
-  if not !Options.v7 then None else
-    if recs=[] then Some (a,vars)
-    else (warning "No recursive notation in v7 syntax";None)
-
-let build_old_pp_rule notation scope symbs (r,vars) =
-  let prec = 
-    try
-      let a,_ = Symbols.level_of_notation (contract_notation notation) in
-      if a = None then raise Not_found else out_some a
-    with Not_found ->
-      error "Parsing rule for this notation has to be previously declared" in
-  let typs = List.map2 
-    (fun id n -> 
-      id,ETConstr (NumLevel (level_rule n),InternalProd)) vars (snd prec) in
-  make_old_pp_rule (fst prec) symbs typs r notation scope vars
-
-let add_notation_interpretation_core local symbs for_old df a scope onlyparse 
-  onlypp gram_data =
-  let notation = make_notation_key symbs in
-  let old_pp_rule = 
-    if !Options.v7 then 
-      option_app (build_old_pp_rule notation scope symbs) for_old
-    else None in
-  option_iter
-    (fun (x,y) ->
-      Lib.add_anonymous_leaf (inSyntaxExtension (local,x));
-      option_iter
-	(fun z -> Lib.add_anonymous_leaf (inSyntaxExtension (local,z))) y)
-    gram_data;
-  Lib.add_anonymous_leaf
-    (inNotation(local,old_pp_rule,notation,scope,a,onlyparse,onlypp,
-     (Lib.library_dp(),df)))
+  let sy_rule = recover_syntax ntn in
+  let need_squash = ntn<>rawntn in
+  if need_squash then [sy_rule; recover_squash_syntax ()] else [sy_rule]
 
-let add_notation_interpretation df names c sc =
+(**********************************************************************)
+(* Main entry point for building parsing and printing rules           *)
+ 
+let make_pa_rule (n,typs,symbols,_) ntn =
+  let assoc = recompute_assoc typs in
+  let prod = make_production typs symbols in
+  (n,assoc,ntn,prod)
+
+let make_pp_rule (n,typs,symbols,fmt) =
+  match fmt with
+  | None -> [UnpBox (PpHOVB 0, make_hunks typs symbols n)]
+  | Some fmt -> hunks_of_format (n,List.split typs) (symbols,parse_format fmt)
+
+let make_syntax_rules (ntn,prec,need_squash,sy_data) =
+  let pa_rule = make_pa_rule sy_data ntn in
+  let pp_rule = make_pp_rule sy_data in
+  let sy_rule = (prec,ntn,pa_rule,pp_rule) in
+  (* By construction, the rule for "{ _ }" is declared, but we need to
+     redeclare it because the file where it is declared needs not be open
+     when the current file opens (especially in presence of -nois) *)
+  if need_squash then [sy_rule; recover_squash_syntax ()] else [sy_rule]
+
+(**********************************************************************)
+(* Main functions about notations                                     *)
+
+let add_notation_in_scope local df c mods scope =
+  let (i_data,sy_data) = compute_syntax_data (df,mods) in
+  (* Declare the parsing and printing rules *)
+  let sy_rules = make_syntax_rules sy_data in
+  Lib.add_anonymous_leaf (inSyntaxExtension(local,sy_rules));
+  (* Declare interpretation *)
+  let (onlyparse,recvars,vars,df') = i_data in
+  let (acvars,ac) = interp_aconstr [] vars c in
+  let a = (remove_vars recvars acvars,ac) (* For recursive parts *) in
+  let onlyparse = onlyparse or is_not_printable ac in
+  Lib.add_anonymous_leaf (inNotation(local,scope,a,onlyparse,df'))
+
+let add_notation_interpretation_core local df names c scope onlyparse =
   let (recs,vars,symbs) = analyse_notation_tokens (split_notation_string df) in
-  let gram_data = recover_notation_syntax (make_notation_key symbs) in
-  if gram_data = None then
-    error "Parsing rule for this notation has to be previously declared";
+  (* Redeclare pa/pp rules *)
+  if not (is_numeral symbs) then begin
+    let sy_rules = recover_notation_syntax (make_notation_key symbs) in
+    Lib.add_anonymous_leaf (inSyntaxExtension (local,sy_rules))
+  end;
+  (* Declare interpretation *)
+  let df' = (make_notation_key symbs,(Lib.library_dp(),df)) in
   let (acvars,ac) = interp_aconstr names vars c in
   let a = (remove_vars recs acvars,ac) (* For recursive parts *) in
-  let a_for_old = interp_rawconstr_with_implicits Evd.empty (Global.env()) vars names c in
-  let for_oldpp = set_data_for_v7_pp recs a_for_old vars in
-  let onlyparse = is_not_printable ac in
-  add_notation_interpretation_core false symbs for_oldpp df a sc onlyparse 
-    false gram_data
-
-let add_notation_in_scope_v8only local df c mv8 scope =
-  let (_,recs,vars,intnot,notation),prec,ppdata,df' = compute_syntax_data false (df,mv8) in
-  let pp_rule = make_pp_rule ppdata in
-  Lib.add_anonymous_leaf
-    (inSyntaxExtension(local,((None,prec),notation,None,pp_rule)));
-  (* Declare the interpretation *)
-  let (acvars,ac) = interp_aconstr [] vars c in
-  let a = (remove_vars recs acvars,ac) (* For recursive parts *) in
-  let onlyparse = is_not_printable ac in
-  Lib.add_anonymous_leaf
-    (inNotation(local,None,intnot,scope,a,onlyparse,true,df'))
+  let onlyparse = onlyparse or is_not_printable ac in
+  Lib.add_anonymous_leaf (inNotation(local,scope,a,onlyparse,df'))
 
-let add_notation_v8only local c (df,modifiers) sc =
-  let toks = split_notation_string df in
-  match toks with 
-    | [String x] when (modifiers = [] or modifiers = [SetOnlyParsing]) ->
-	(* This is a ident to be declared as a rule *)
-        add_notation_in_scope_v8only local df c (SetLevel 0::modifiers) sc
-    | _ ->
-	let (assoc,lev,typs,onlyparse,fmt) = interp_modifiers modifiers	in
-	match lev with
-	  | None->
-	      if modifiers <> [] & modifiers <> [SetOnlyParsing] then
-		error "Parsing rule for this notation includes no level"
-	      else
-	        (* Declare only interpretation *)
-		let (recs,vars,symbs) = analyse_notation_tokens toks in
-                let (acvars,ac) = interp_aconstr [] vars c in
-		let onlyparse = modifiers = [SetOnlyParsing] 
-                  or is_not_printable ac in
-                let a = (remove_vars recs acvars,ac) in
-		add_notation_interpretation_core local symbs None df a sc 
-		  onlyparse true None
-	  | Some n ->
-	    (* Declare both syntax and interpretation *)
-	      let mods =
-		if List.for_all (function SetAssoc _ -> false | _ -> true)
-		  modifiers 
-		then SetAssoc Gramext.NonA :: modifiers else modifiers in
-	      add_notation_in_scope_v8only local df c mods sc
-
-let is_quoted_ident x =
-  let x' = unquote_notation_token x in
-  x <> x' & try Lexer.check_ident x'; true with _ -> false
-
-(* v7: dfmod=None; mv8=Some: add only v8 printing rule *)
-(*     dfmod=Some: add v7 parsing rule; mv8=Some: add v8 printing rule *)
-(*     dfmod=Some; mv8=None: same v7-parsing and v8-printing rules *)
-(* v8: dfmod=Some; mv8=None: same v8 parsing and printing rules *)
-let add_notation local c dfmod mv8 sc =
-  match dfmod with
-  | None -> add_notation_v8only local c (out_some mv8) sc
-  | Some (df,modifiers) ->
-  let toks = split_notation_string df in
-  match toks with 
-    | [String x] when (modifiers = [] or modifiers = [SetOnlyParsing]) ->
-	(* This is a ident to be declared as a rule *)
-        add_notation_in_scope local df c (SetLevel 0::modifiers) mv8 sc
-    | _ ->
-	let (assoc,lev,typs,onlyparse,fmt) = interp_modifiers modifiers	in
-	match lev with
-	  | None->
-	      if modifiers <> [] & modifiers <> [SetOnlyParsing] then
-		error "Parsing rule for this notation includes no level"
-	      else
-	        (* Declare only interpretation *)
-		let (recs,vars,symbs) = analyse_notation_tokens toks in
-                let gram_data =
-		  recover_notation_syntax (make_notation_key symbs) in
-		if gram_data <> None then
-                  let (acvars,ac) = interp_aconstr [] vars c in
-                  let a = (remove_vars recs acvars,ac) in
-		  let onlyparse = modifiers = [SetOnlyParsing] 
-                    or is_not_printable ac in
-		  let a_for_old = interp_global_rawconstr_with_vars vars c in
-                  let for_old = set_data_for_v7_pp recs a_for_old vars in
-		  add_notation_interpretation_core local symbs for_old df a
-		    sc onlyparse false gram_data
-                else
-                  add_notation_in_scope local df c modifiers mv8 sc
-	  | Some n ->
-	    (* Declare both syntax and interpretation *)
-	    let assoc = match assoc with None -> Some Gramext.NonA | a -> a in
-            add_notation_in_scope local df c modifiers mv8 sc
-
-(* TODO add boxes information in the expression *)
+(* Notations without interpretation (Reserved Notation) *)
+
+let add_syntax_extension local mv =
+  let (_,sy_data) = compute_syntax_data mv in
+  let sy_rules = make_syntax_rules sy_data in
+  Lib.add_anonymous_leaf (inSyntaxExtension(local,sy_rules))
+
+(* Notations with only interpretation *)
+
+let add_notation_interpretation df names c sc =
+  try add_notation_interpretation_core false df names c sc false
+  with NoSyntaxRule ->
+    error "Parsing rule for this notation has to be previously declared"
+
+(* Main entry point *)
+
+let add_notation local c (df,modifiers) sc =
+  if no_syntax_modifiers modifiers then
+    (* No syntax data: try to rely on a previously declared rule *)
+    let onlyparse = modifiers=[SetOnlyParsing] in
+    try add_notation_interpretation_core local df [] c sc onlyparse
+    with NoSyntaxRule ->
+      (* Try to determine a default syntax rule *)
+      add_notation_in_scope local df c modifiers sc
+  else
+    (* Declare both syntax and interpretation *)
+    add_notation_in_scope local df c modifiers sc
+
+(* Infix notations *)
 
 let inject_var x = CRef (Ident (dummy_loc, id_of_string x))
 
-let rec rename x vars n = function
-  | [] ->
-      (vars,[])
-  | String "_"::l ->
-      let (vars,l) = rename x vars (n+1) l in
-      let xn = x^(string_of_int n) in
-      ((inject_var xn)::vars,xn::l)
-  | String y::l ->
-      let (vars,l) = rename x vars n l in (vars,(quote_notation_token y)::l)
-  | WhiteSpace _::l ->
-      rename x vars n l
-
-let translate_distfix assoc df r = 
-  let (vars,l) = rename "x" [] 1 (split_notation_string df) in
-  let df = String.concat " " l in
-  let a = mkAppC (mkRefC r, vars) in
-  let assoc = match assoc with None -> Gramext.LeftA | Some a -> a in
-  (assoc,df,a)
-
-let add_distfix local assoc n df r sc =
-  (* "x" cannot clash since r is globalized (included section vars) *)
-  let (vars,l) = rename "x" [] 1 (split_notation_string df) in
-  let df = String.concat " " l in
-  let a = mkAppC (mkRefC r, vars) in
-  let assoc = match assoc with None -> Gramext.LeftA | Some a -> a in
-  add_notation_in_scope local df a [SetAssoc assoc;SetLevel n] None sc
-
-let make_infix_data n assoc modl mv8 =
-  (* Infix defaults to LEFTA in V7 (cf doc) *)
-  let mv = match n with None when !Options.v7 -> SetLevel 1 :: modl | _ -> modl in
-  let mv = match assoc with None when !Options.v7 -> SetAssoc Gramext.LeftA :: mv | _ -> mv in
-  let mv8 = match mv8 with
-      None -> None
-    | Some(s8,mv8) ->
-	if List.for_all (function SetLevel _ -> false | _ -> true) mv8 then
-	  error "Needs a level"
-	else Some (("x "^quote_notation_token s8^" y"),mv8) in
-  mv,mv8
-
-let add_infix local (inf,modl) pr mv8 sc =
-  if inf="" (* Code for V8Infix only *) then
-    let (p8,mv8) = out_some mv8 in
-    let (a8,n8,onlyparse,fmt) = interp_infix_modifiers mv8 in
-    let metas = [inject_var "x"; inject_var "y"] in
-    let a = mkAppC (mkRefC pr,metas) in
-    let df = "x "^(quote_notation_token p8)^" y" in
-    let toks = split_notation_string df in
-    if a8=None & n8=None & fmt=None then
-      (* Declare only interpretation *)
-      let (recs,vars,symbs) = analyse_notation_tokens toks in
-      let (acvars,ac) = interp_aconstr [] vars a in
-      let a' = (remove_vars recs acvars,ac) in
-      let a_for_old = interp_global_rawconstr_with_vars vars a in
-      add_notation_interpretation_core local symbs None df a' sc 
-	onlyparse true None
-    else
-      if n8 = None then error "Needs a level" else
-      let mv8 = match a8 with None -> SetAssoc Gramext.NonA :: mv8 |_ -> mv8 in
-      add_notation_in_scope_v8only local df a mv8 sc
-  else begin
-  let (assoc,n,onlyparse,fmt) = interp_infix_modifiers modl in
+let add_infix local (inf,modifiers) pr sc =
+  check_infix_modifiers modifiers;
   (* check the precedence *)
-  if !Options.v7 & (n<> None & (out_some n < 1 or out_some n > 10)) then
-    errorlabstrm "Metasyntax.infix_grammar_entry"
-      (str"Precedence must be between 1 and 10.");
-  (*
-  if (assoc<>None) & (n<6 or n>9) then
-    errorlabstrm "Vernacentries.infix_grammar_entry"
-      (str"Associativity Precedence must be 6,7,8 or 9.");
-  *)
   let metas = [inject_var "x"; inject_var "y"] in
-  let a = mkAppC (mkRefC pr,metas) in
+  let c = mkAppC (mkRefC pr,metas) in
   let df = "x "^(quote_notation_token inf)^" y" in
-  let toks = split_notation_string df in
-  if not !Options.v7 & n=None & assoc=None then
-    (* En v8, une notation sans information de parsing signifie *)
-    (* de ne déclarer que l'interprétation *)
-    (* Declare only interpretation *)
-    let (recs,vars,symbs) = analyse_notation_tokens toks in
-    let gram_data = recover_notation_syntax (make_notation_key symbs) in
-    if gram_data <> None then 
-      let (acvars,ac) = interp_aconstr [] vars a in
-      let a' = (remove_vars recs acvars,ac) in
-      let a_for_old = interp_global_rawconstr_with_vars vars a in
-      let for_old = set_data_for_v7_pp recs a_for_old vars in
-      add_notation_interpretation_core local symbs for_old df a' sc 
-        onlyparse false gram_data
-    else
-      let mv,mv8 = make_infix_data n assoc modl mv8 in
-      add_notation_in_scope local df a mv mv8 sc
-  else
-    let mv,mv8 = make_infix_data n assoc modl mv8 in
-    add_notation_in_scope local df a mv mv8 sc
-  end
+  add_notation local c (df,modifiers) sc
+
+(**********************************************************************)
+(* Miscellaneous                                                      *)
 
-let standardise_locatable_notation ntn =
+let standardize_locatable_notation ntn =
   let unquote = function
     | String s -> [unquote_notation_token s]
     | _ -> [] in
@@ -1480,17 +1002,19 @@ let standardise_locatable_notation ntn =
   else
     unquote_notation_token ntn
 
-(* Delimiters and classes bound to scopes *)
+(**********************************************************************)
+(* Delimiters and classes bound to scopes                             *)
+
 type scope_command = ScopeDelim of string | ScopeClasses of Classops.cl_typ
 
 let load_scope_command _ (_,(scope,dlm)) =
-  Symbols.declare_scope scope
+  Notation.declare_scope scope
 
 let open_scope_command i (_,(scope,o)) =
   if i=1 then
     match o with
-    | ScopeDelim dlm -> Symbols.declare_delimiters scope dlm
-    | ScopeClasses cl -> Symbols.declare_class_scope scope cl
+    | ScopeDelim dlm -> Notation.declare_delimiters scope dlm
+    | ScopeClasses cl -> Notation.declare_class_scope scope cl
 
 let cache_scope_command o =
   load_scope_command 1 o;
diff --git a/toplevel/metasyntax.mli b/toplevel/metasyntax.mli
index be90cd7a..71522567 100644
--- a/toplevel/metasyntax.mli
+++ b/toplevel/metasyntax.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: metasyntax.mli,v 1.26.2.1 2004/07/16 19:31:49 herbelin Exp $ i*)
+(*i $Id: metasyntax.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -15,49 +15,44 @@ open Ppextend
 open Extend
 open Tacexpr
 open Vernacexpr
-open Symbols
+open Notation
 open Topconstr
 (*i*)
 
-(* Adding grammar and pretty-printing objects in the environment *)
+val add_token_obj : string -> unit
 
-val add_syntax_obj : string -> raw_syntax_entry list -> unit
+(* Adding a tactic notation in the environment *)
 
-val add_grammar_obj : string -> raw_grammar_entry list -> unit
-val add_token_obj : string -> unit
-val add_tactic_grammar :
-  (string * (string * grammar_production list) * raw_tactic_expr) list -> unit
+val add_tactic_notation : 
+  int * grammar_production list * raw_tactic_expr -> unit
+
+(* Adding a (constr) notation in the environment*)
 
 val add_infix : locality_flag -> (string * syntax_modifier list) ->
-  reference -> (string * syntax_modifier list) option ->
-    scope_name option -> unit
-val add_distfix : locality_flag ->
-  grammar_associativity -> precedence -> string -> reference
-    -> scope_name option -> unit
-val translate_distfix : grammar_associativity -> string -> reference ->
-  Gramext.g_assoc * string * constr_expr
+  reference -> scope_name option -> unit
+
+val add_notation : locality_flag -> constr_expr ->
+  (string * syntax_modifier list) -> scope_name option -> unit
+
+(* Declaring delimiter keys and default scopes *)
 
 val add_delimiters : scope_name -> string -> unit
 val add_class_scope : scope_name -> Classops.cl_typ -> unit
 
-val add_notation : locality_flag -> constr_expr
-  -> (string * syntax_modifier list) option
-  -> (string * syntax_modifier list) option
-      -> scope_name option -> unit
+(* Add only the interpretation of a notation that already has pa/pp rules *)
 
-val add_notation_interpretation : string -> Constrintern.implicits_env
-  -> constr_expr -> scope_name option -> unit
+val add_notation_interpretation : string -> Constrintern.implicits_env ->
+  constr_expr -> scope_name option -> unit
 
-val add_syntax_extension : locality_flag
-  -> (string * syntax_modifier list) option
-  -> (string * syntax_modifier list) option -> unit
+(* Add only the parsing/printing rule of a notation *)
 
-val print_grammar : string -> string -> unit
+val add_syntax_extension : 
+  locality_flag -> (string * syntax_modifier list) -> unit
 
-val merge_modifiers : Gramext.g_assoc option -> int option -> 
-  syntax_modifier list -> syntax_modifier list
+(* Print the Camlp4 state of a grammar *)
+
+val print_grammar : string -> string -> unit
 
-val interp_infix_modifiers : syntax_modifier list ->
-  Gramext.g_assoc option * precedence option * bool * string located option
+(* Removes quotes in a notation *)
 
-val standardise_locatable_notation : string -> string
+val standardize_locatable_notation : string -> string
diff --git a/toplevel/minicoq.ml b/toplevel/minicoq.ml
index dcf3e307..490765a4 100644
--- a/toplevel/minicoq.ml
+++ b/toplevel/minicoq.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: minicoq.ml,v 1.28.14.1 2004/07/16 19:31:49 herbelin Exp $ *)
+(* $Id: minicoq.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Util
diff --git a/toplevel/mltop.ml4 b/toplevel/mltop.ml4
index 4da23d42..a3b7fc14 100644
--- a/toplevel/mltop.ml4
+++ b/toplevel/mltop.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: mltop.ml4,v 1.29.2.3 2004/07/17 13:00:15 herbelin Exp $ *)
+(* $Id: mltop.ml4 6692 2005-02-06 13:03:51Z herbelin $ *)
 
 open Util
 open Pp
@@ -109,7 +109,7 @@ let dir_ml_load s =
 	    [Filename.dirname gname]
 	with | Dynlink.Error a ->
           errorlabstrm "Mltop.load_object" [< str (Dynlink.error_message a) >]
-      else () 
+      else ()
     | Native ->
 	errorlabstrm "Mltop.no_load_object"
           [< str"Loading of ML object file forbidden in a native Coq" >]
@@ -137,7 +137,7 @@ let add_path ~unix_path:dir ~coq_root:coq_dirpath =
   if exists_dir dir then
     begin
       add_ml_dir dir;
-      Library.add_load_path_entry (dir,coq_dirpath)
+      Library.add_load_path (dir,coq_dirpath)
     end
   else
     msg_warning [< str ("Cannot open " ^ dir) >]
@@ -160,7 +160,7 @@ let add_rec_path ~unix_path:dir ~coq_root:coq_dirpath =
     let dirs = map_succeed convert_dirs dirs in
     begin
       List.iter (fun lpe -> add_ml_dir (fst lpe)) dirs;
-      List.iter Library.add_load_path_entry dirs
+      List.iter Library.add_load_path dirs
     end
   else
     msg_warning [< str ("Cannot open " ^ dir) >]
diff --git a/toplevel/mltop.mli b/toplevel/mltop.mli
index 6ba8cd76..b869f70b 100644
--- a/toplevel/mltop.mli
+++ b/toplevel/mltop.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: mltop.mli,v 1.8.14.1 2004/07/16 19:31:49 herbelin Exp $ i*)
+(*i $Id: mltop.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* If there is a toplevel under Coq, it is described by the following 
    record. *)
diff --git a/toplevel/protectedtoplevel.ml b/toplevel/protectedtoplevel.ml
index c748a12d..a9ff3326 100644
--- a/toplevel/protectedtoplevel.ml
+++ b/toplevel/protectedtoplevel.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: protectedtoplevel.ml,v 1.9.10.1 2004/07/16 19:31:49 herbelin Exp $ *)
+(* $Id: protectedtoplevel.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 open Pp
 open Line_oriented_parser
diff --git a/toplevel/protectedtoplevel.mli b/toplevel/protectedtoplevel.mli
index b31afbf6..1d4ba9fc 100644
--- a/toplevel/protectedtoplevel.mli
+++ b/toplevel/protectedtoplevel.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: protectedtoplevel.mli,v 1.5.16.1 2004/07/16 19:31:49 herbelin Exp $ i*)
+(*i $Id: protectedtoplevel.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Pp
diff --git a/toplevel/record.ml b/toplevel/record.ml
index 3a10c7e5..b24e85da 100644
--- a/toplevel/record.ml
+++ b/toplevel/record.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: record.ml,v 1.52.2.2 2005/11/29 21:40:53 letouzey Exp $ *)
+(* $Id: record.ml 7941 2006-01-28 23:07:59Z herbelin $ *)
 
 open Pp
 open Util
@@ -20,7 +20,6 @@ open Declarations
 open Entries
 open Declare
 open Nametab
-open Coqast
 open Constrintern
 open Command
 open Inductive
@@ -37,31 +36,14 @@ let interp_decl sigma env = function
   | Vernacexpr.DefExpr((_,id),c,t) ->
       let c = match t with
 	| None -> c
-	| Some t -> mkCastC (c,t)
+	| Some t -> mkCastC (c,DEFAULTcast,t)
       in
-      let j = judgment_of_rawconstr Evd.empty env c in
+      let j = interp_constr_judgment Evd.empty env c in
       (id,Some j.uj_val, j.uj_type)
 
 let typecheck_params_and_fields ps fs =
   let env0 = Global.env () in
-  let env1,newps =
-    List.fold_left
-      (fun (env,newps) d -> match d with
-	| LocalRawAssum ([_,na],(CHole _ as t)) ->
-	    let t = interp_binder Evd.empty env na t in
-	    let d = (na,None,t) in
-	    (push_rel d env, d::newps)
-	| LocalRawAssum (nal,t) ->
-	    let t = interp_type Evd.empty 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@newps)
-	| LocalRawDef ((_,na),c) ->
-	    let c = judgment_of_rawconstr Evd.empty env c in
-	    let d = (na, Some c.uj_val, c.uj_type) in
-	    (push_rel d env, d::newps))
-      (env0,[]) ps
-  in
+  let env1,newps = interp_context Evd.empty env0 ps in
   let env2,newfs =
     List.fold_left
       (fun (env,newfs) d ->
@@ -146,19 +128,20 @@ let subst_projection fid l c =
 let declare_projections indsp coers fields =
   let env = Global.env() in
   let (mib,mip) = Global.lookup_inductive indsp in
-  let paramdecls = mip.mind_params_ctxt in
+  let paramdecls = mib.mind_params_ctxt in
   let r = mkInd indsp in
   let rp = applist (r, extended_rel_list 0 paramdecls) in
   let paramargs = extended_rel_list 1 paramdecls in (*def in [[params;x:rp]]*)
   let x = Termops.named_hd (Global.env()) r Anonymous in
   let lifted_fields = lift_rel_context 1 fields in
-  let (_,sp_projs,_) =
+  let (_,kinds,sp_projs,_) =
     List.fold_left2
-      (fun (nfi,sp_projs,subst) coe (fi,optci,ti) ->
-	match fi with
-	| Anonymous ->
-	    (nfi-1, None::sp_projs,NoProjection fi::subst)
-	| Name fid ->
+      (fun (nfi,kinds,sp_projs,subst) coe (fi,optci,ti) ->
+	let (sp_projs,subst) =
+	  match fi with
+	  | Anonymous ->
+	      (None::sp_projs,NoProjection fi::subst)
+	  | Name fid ->
             try
               let ccl = subst_projection fid subst ti in
 	      let body = match optci with
@@ -176,32 +159,34 @@ let declare_projections indsp coers fields =
 	        it_mkLambda_or_LetIn (mkLambda (x,rp,body)) paramdecls in
               let projtyp =
                 it_mkProd_or_LetIn (mkProd (x,rp,ccl)) paramdecls in
-	      let (sp,kn) =
+	      let kn =
 	        try
 		  let cie = {
 		    const_entry_body = proj;
                     const_entry_type = Some projtyp;
-                    const_entry_opaque = false } in
-		  let k = (DefinitionEntry cie,IsDefinition) in
-		  let sp = declare_internal_constant fid k in
+                    const_entry_opaque = false;
+		    const_entry_boxed = Options.boxed_definitions() } in
+		  let k = (DefinitionEntry cie,IsDefinition StructureComponent) in
+		  let kn = declare_internal_constant fid k in
 		  Options.if_verbose message (string_of_id fid ^" is defined");
-		  sp
+		  kn
                 with Type_errors.TypeError (ctx,te) ->
                   raise (NotDefinable (BadTypedProj (fid,ctx,te))) in
 	      let refi = ConstRef kn in
 	      let constr_fi = mkConst kn in
 	      if coe then begin
-	        let cl = Class.class_of_ref (IndRef indsp) in
+	        let cl = Class.class_of_global (IndRef indsp) in
 	        Class.try_add_new_coercion_with_source refi Global cl
 	      end;
 	      let proj_args = (*Rel 1 refers to "x"*) paramargs@[mkRel 1] in
 	      let constr_fip = applist (constr_fi,proj_args) in
-	      (nfi-1, (Some kn)::sp_projs, Projection constr_fip::subst)
+	      (Some kn::sp_projs, Projection constr_fip::subst)
             with NotDefinable why ->
 	      warning_or_error coe indsp why;
-	      (nfi-1, None::sp_projs,NoProjection fi::subst))
-      (List.length fields,[],[]) coers (List.rev fields)
-  in sp_projs
+	      (None::sp_projs,NoProjection fi::subst) in
+      (nfi-1,(optci=None)::kinds,sp_projs,subst))
+      (List.length fields,[],[],[]) coers (List.rev fields)
+  in (kinds,sp_projs)
 
 (* [fs] corresponds to fields and [ps] to parameters; [coers] is a boolean 
    list telling if the corresponding fields must me declared as coercion *)
@@ -220,18 +205,18 @@ let definition_structure ((is_coe,(_,idstruc)),ps,cfs,idbuild,s) =
   let ind = applist (mkRel (1+List.length params+List.length fields), args) in
   let type_constructor = it_mkProd_or_LetIn ind fields in
   let mie_ind =
-    { mind_entry_params = List.map degenerate_decl params;
-      mind_entry_typename = idstruc;
+    { mind_entry_typename = idstruc;
       mind_entry_arity = mkSort s;
       mind_entry_consnames = [idbuild];
       mind_entry_lc = [type_constructor] } in
   let mie =
-    { mind_entry_record = true;
+    { mind_entry_params = List.map degenerate_decl params;
+      mind_entry_record = true;
       mind_entry_finite = true;
       mind_entry_inds = [mie_ind] } in
   let sp = declare_mutual_with_eliminations true mie in
   let rsp = (sp,0) in (* This is ind path of idstruc *)
-  let sp_projs = declare_projections rsp coers fields in
+  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.add_new_struc (rsp,idbuild,nparams,List.rev sp_projs)
+  Recordops.declare_structure(rsp,idbuild,nparams,List.rev kinds,List.rev sp_projs)
diff --git a/toplevel/record.mli b/toplevel/record.mli
index 8eff2ed5..66282c20 100644
--- a/toplevel/record.mli
+++ b/toplevel/record.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: record.mli,v 1.16.2.1 2004/07/16 19:31:49 herbelin Exp $ i*)
+(*i $Id: record.mli 6743 2005-02-18 22:14:08Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -21,7 +21,7 @@ open Topconstr
    [coers]; it returns the absolute names of projections *)
 
 val declare_projections :
-  inductive -> bool list -> rel_context -> constant option list
+  inductive -> bool list -> rel_context -> bool list * constant option list
 
 val definition_structure :
   lident with_coercion * local_binder list *
diff --git a/toplevel/recordobj.ml b/toplevel/recordobj.ml
deleted file mode 100755
index d2a1e36e..00000000
--- a/toplevel/recordobj.ml
+++ /dev/null
@@ -1,77 +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        *)
-(************************************************************************)
-
-(* $Id: recordobj.ml,v 1.12.2.1 2004/07/16 19:31:49 herbelin Exp $ *)
-
-open Util
-open Pp
-open Names
-open Libnames
-open Nameops
-open Term
-open Instantiate
-open Lib
-open Declare
-open Recordops
-open Classops
-open Nametab
-
-(*****  object definition ******)
- 
-let typ_lams_of t = 
-  let rec aux acc c = match kind_of_term c with
-    | Lambda (x,c1,c2) -> aux (c1::acc) c2
-    | Cast (c,_) -> aux acc c
-    | t -> acc,t
-  in aux [] t
-
-let objdef_err ref =
-  errorlabstrm "object_declare"
-    (pr_id (id_of_global ref) ++
-       str" is not a structure object")
-
-let objdef_declare ref =
-  let sp = match ref with ConstRef sp -> sp | _ -> objdef_err ref in
-  let env = Global.env () in
-  let v = constr_of_reference ref in
-  let vc = match Environ.constant_opt_value env sp with
-    | Some vc -> vc
-    | None -> objdef_err ref in
-  let lt,t = decompose_lam vc in
-  let lt = List.rev (List.map snd lt) in
-  let f,args = match kind_of_term t with
-    | App (f,args) -> f,args 
-    | _ -> objdef_err ref in
-  let { s_PARAM = p; s_PROJ = lpj } = 
-    try (find_structure
-	   (match kind_of_term f with
-              | Construct (indsp,1) -> indsp
-	      | _ -> objdef_err ref))
-    with Not_found -> objdef_err ref in
-  let params, projs =
-    try list_chop p (Array.to_list args)
-    with _ -> objdef_err ref in
-  let lps = 
-    try List.combine lpj projs 
-    with _ -> objdef_err ref in
-  let comp =
-    List.fold_left
-      (fun l (spopt,t) -> (* comp=components *)
-	 match spopt with
-	   | None -> l
-           | Some proji_sp ->
-	       let c, args = decompose_app t in
-	       try (ConstRef proji_sp, reference_of_constr c, args) :: l
-               with Not_found -> l)
-      [] lps in
-  add_anonymous_leaf (inObjDef1 sp);
-  List.iter
-    (fun (refi,c,argj) -> add_new_objdef ((refi,c),v,lt,params,argj))
-    comp
-
-let add_object_hook _ = objdef_declare
diff --git a/toplevel/recordobj.mli b/toplevel/recordobj.mli
deleted file mode 100755
index 91550c34..00000000
--- a/toplevel/recordobj.mli
+++ /dev/null
@@ -1,12 +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: recordobj.mli,v 1.7.6.2 2005/01/21 17:18:33 herbelin Exp $ i*)
-
-val objdef_declare : Libnames.global_reference -> unit
-val add_object_hook : Tacexpr.declaration_hook
diff --git a/toplevel/searchisos.mli b/toplevel/searchisos.mli
index f1ad7d5a..184725b2 100644
--- a/toplevel/searchisos.mli
+++ b/toplevel/searchisos.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: searchisos.mli,v 1.3.16.1 2004/07/16 19:31:49 herbelin Exp $ i*)
+(*i $Id: searchisos.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 val search_in_lib : bool ref
 val type_search : Term.constr -> unit
diff --git a/toplevel/toplevel.ml b/toplevel/toplevel.ml
index 7fa80bcb..a5c2564c 100644
--- a/toplevel/toplevel.ml
+++ b/toplevel/toplevel.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: toplevel.ml,v 1.22.2.2 2004/07/16 20:48:17 herbelin Exp $ *)
+(* $Id: toplevel.ml 6947 2005-04-20 16:18:41Z coq $ *)
 
 open Pp
 open Util
@@ -182,11 +182,44 @@ let make_prompt () =
   with _ -> 
     "Coq < "
 
+(*let build_pending_list l = 
+  let pl = ref ">" in
+  let l' = ref l in
+  let res = 
+    while List.length !l' > 1 do 
+      pl := !pl ^ "|" Names.string_of_id x;
+      l':=List.tl !l'
+    done in
+  let last = try List.hd !l' with _ ->   in
+  "<"^l'
+*)    
+
+(* the coq prompt added to the default one when in emacs mode
+   The prompt contains the current state label [n] (for global
+   backtracking) and the current proof state [p] (for proof
+   backtracking) plus the list of open (nested) proofs (for proof
+   aborting when backtracking). It looks like:
+   
+   "n |lem1|lem2|lem3| p < "
+*)
+let make_emacs_prompt() =
+  let statnum = string_of_int (Lib.current_command_label ()) in
+  let endchar = String.make 1 (Char.chr 249) in
+  let dpth = Pfedit.current_proof_depth() in
+  let pending = Pfedit.get_all_proof_names() in
+  let pendingprompt = 
+    List.fold_left 
+      (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 ^ " < " ^ endchar
+
 (* 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())^(emacs_str (String.make 1 (Char.chr 249)))
+  let pr() = 
+    make_prompt() ^ Printer.emacs_str (make_emacs_prompt())
   in
   { prompt = pr;
     str = "";
@@ -197,7 +230,7 @@ let top_buffer =
 
 let set_prompt prompt =
   top_buffer.prompt
-  <- (fun () -> (prompt ()) ^ (emacs_str (String.make 1 (Char.chr 249))))
+  <- (fun () -> (prompt ())^(Printer.emacs_str (String.make 1 (Char.chr 249))))
 
 (* Removes and prints the location of the error. The following exceptions
    need not be located. *)
diff --git a/toplevel/toplevel.mli b/toplevel/toplevel.mli
index 1b6b48d4..f4d2e28a 100644
--- a/toplevel/toplevel.mli
+++ b/toplevel/toplevel.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: toplevel.mli,v 1.6.10.1 2004/07/16 19:31:50 herbelin Exp $ i*)
+(*i $Id: toplevel.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Pp
diff --git a/toplevel/usage.ml b/toplevel/usage.ml
index b00cfffc..354aff0b 100644
--- a/toplevel/usage.ml
+++ b/toplevel/usage.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: usage.ml,v 1.15.2.2 2004/09/03 14:35:26 herbelin Exp $ *)
+(* $Id: usage.ml 6053 2004-09-03 14:33:35Z herbelin $ *)
 
 let version () =
   Printf.printf "The Coq Proof Assistant, version %s (%s)\n"
diff --git a/toplevel/usage.mli b/toplevel/usage.mli
index 16929d68..97814fd2 100644
--- a/toplevel/usage.mli
+++ b/toplevel/usage.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: usage.mli,v 1.5.16.1 2004/07/16 19:31:50 herbelin Exp $ i*)
+(*i $Id: usage.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*s Prints the version number on the standard output and exits (with 0). *)
 
diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml
index a5716619..64d77b74 100644
--- a/toplevel/vernac.ml
+++ b/toplevel/vernac.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: vernac.ml,v 1.59.2.3 2004/07/16 20:48:17 herbelin Exp $ *)
+(* $Id: vernac.ml 7744 2005-12-27 09:16:06Z herbelin $ *)
 
 (* Parsing of vernacular. *)
 
@@ -15,10 +15,9 @@ open Lexer
 open Util
 open Options
 open System
-open Coqast
 open Vernacexpr
 open Vernacinterp
-open Ppvernacnew
+open Ppvernac
 
 (* The functions in this module may raise (unexplainable!) exceptions.
    Use the module Coqtoplevel, which catches these exceptions
@@ -57,7 +56,7 @@ let real_error = function
    the file we parse seems a bit risky to me.  B.B.  *)
 
 let open_file_twice_if verbosely fname =
-  let _,longfname = find_file_in_path (Library.get_load_path ()) fname in
+  let _,longfname = find_file_in_path (Library.get_load_paths ()) fname in
   let in_chan = open_in longfname in
   let verb_ch = if verbosely then Some (open_in longfname) else None in
   let po = Pcoq.Gram.parsable (Stream.of_channel in_chan) in
@@ -95,62 +94,18 @@ let parse_phrase (po, verbch) =
 
 let just_parsing = ref false
 let chan_translate = ref stdout
-let last_char = ref '\000'
 
-(* postprocessor to avoid lexical icompatibilities between V7 and V8.
-   Ex: auto.(* comment *)  or  simpl.auto
- *)
 let set_formatter_translator() =
   let ch = !chan_translate in
-  let out s b e =
-    let n = e-b in
-    if n > 0 then begin
-      (match !last_char with
-          '.' -> 
-            (match s.[b] with
-                '('|'a'..'z'|'A'..'Z' -> output ch " " 0 1 
-              | _ -> ())
-        | _ -> ());
-      last_char := s.[e-1]
-    end;
-    output ch s b e
-  in
+  let out s b e = output ch s b e in
   Format.set_formatter_output_functions out (fun () -> flush ch);
   Format.set_max_boxes max_int
 
-let pre_printing = function
-  | VernacSolve (i,tac,deftac) when Options.do_translate () ->
-      (try
-        let (_,env) = Pfedit.get_goal_context i in
-        let t = Options.with_option Options.translate_syntax
-	  (Tacinterp.glob_tactic_env [] env) tac in
-        let pfts = Pfedit.get_pftreestate () in
-        let gls = fst (Refiner.frontier (Tacmach.proof_of_pftreestate pfts)) in
-        Some (env,t,Pfedit.focus(),List.length gls)
-      with UserError _|Stdpp.Exc_located _ -> None)
-  | _ -> None
-
-let post_printing loc (env,t,f,n) = function
-  | VernacSolve (i,_,deftac) ->
-      let loc = unloc loc in
-      set_formatter_translator();
-      let pp = Ppvernacnew.pr_vernac_solve (i,env,t,deftac) ++ sep_end () in
-      (if !translate_file then begin
-	msg (hov 0 (comment (fst loc) ++ pp ++ comment (snd loc - 1)));
-      end
-      else
-	msgnl (hov 4 (str"New Syntax:" ++ fnl() ++ pp)));
-      Format.set_formatter_out_channel stdout
-  | _ -> ()
-
 let pr_new_syntax loc ocom =
   let loc = unloc loc in
   if !translate_file then set_formatter_translator();
   let fs = States.freeze () in
   let com = match ocom with
-    | Some (VernacV7only _) ->
-        Options.v7_only := true;
-        mt()
     | Some VernacNop -> mt()
     | Some com -> pr_vernac com
     | None -> mt() in
@@ -159,8 +114,6 @@ let pr_new_syntax loc ocom =
   else
     msgnl (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com)));
   States.unfreeze fs;
-  Constrintern.set_temporary_implicits_in [];
-  Constrextern.set_temporary_implicits_out [];
   Format.set_formatter_out_channel stdout
 
 let rec vernac_com interpfun (loc,com) =
@@ -174,7 +127,7 @@ let rec vernac_com interpfun (loc,com) =
         (* coqdoc state *)
         let cds = Constrintern.coqdoc_freeze() in
         if !Options.translate_file then begin
-          let _,f = find_file_in_path (Library.get_load_path ())
+          let _,f = find_file_in_path (Library.get_load_paths ())
             (make_suffix fname ".v") in
           chan_translate := open_out (f^"8");
           Pp.comments := []
@@ -203,39 +156,14 @@ let rec vernac_com interpfun (loc,com) =
         msgnl (str"Finished transaction in " ++
                  System.fmt_time_difference tstart tend)
 
-    (* To be interpreted in v7 or translator input only *)
-    | VernacV7only v ->
-        Options.v7_only := true;
-        if !Options.v7 || Options.do_translate() then interp v;
-        Options.v7_only := false
-
-    (* To be interpreted in translator output only *)
-    | VernacV8only v -> 
-        if not !Options.v7 && not (do_translate()) then
-          interp v
-
     | v -> if not !just_parsing then interpfun v
 
   in 
   try
-    Options.v7_only := false;
-    if do_translate () then
-      match pre_printing com with
-          None ->
-            pr_new_syntax loc (Some com);
-            interp com
-        | Some state ->
-            (try
-              interp com;
-              post_printing loc state com
-            with e ->
-              post_printing loc state com;
-              raise e)
-    else
-      interp com
+    if do_translate () then pr_new_syntax loc (Some com);
+    interp com
   with e -> 
     Format.set_formatter_out_channel stdout;
-    Options.v7_only := false;
     raise (DuringCommandInterp (loc, e))
 
 and vernac interpfun input =
diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli
index d8f4b247..4f95376f 100644
--- a/toplevel/vernac.mli
+++ b/toplevel/vernac.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: vernac.mli,v 1.10.2.1 2004/07/16 19:31:50 herbelin Exp $ i*)
+(*i $Id: vernac.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (* Parsing of vernacular. *)
 
diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml
index 1c6ad9a6..7394bd8f 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,v 1.195.2.1 2004/07/16 19:31:50 herbelin Exp $ i*)
+(*i $Id: vernacentries.ml 8700 2006-04-11 23:14:15Z courtieu $ i*)
 
 (* Concrete syntax of the mathematical vernacular MV V2.6 *)
 
@@ -23,6 +23,7 @@ open Proof_trees
 open Constrintern
 open Prettyp
 open Printer
+open Tactic_printer
 open Tacinterp
 open Command
 open Goptions
@@ -32,6 +33,7 @@ open Vernacexpr
 open Decl_kinds
 open Topconstr
 open Pretyping
+open Redexpr
 
 (* Pcoq hooks *)
 
@@ -55,14 +57,13 @@ let set_pcoq_hook f = pcoq := Some f
 let cl_of_qualid = function
   | FunClass -> Classops.CL_FUN
   | SortClass -> Classops.CL_SORT
-  | RefClass r -> Class.class_of_ref (Nametab.global r)
+  | RefClass r -> Class.class_of_global (Nametab.global r)
 
 (*******************)
 (* "Show" commands *)
 
 let show_proof () =
   let pts = get_pftreestate () in
-  let pf = proof_of_pftreestate pts in
   let cursor = cursor_of_pftreestate pts in
   let evc = evc_of_pftreestate pts in
   let (pfterm,meta_types) = extract_open_pftreestate pts in
@@ -70,41 +71,41 @@ let show_proof () =
     prlist_with_sep pr_spc pr_int (List.rev cursor) ++ fnl () ++
     str"Subgoals" ++ fnl () ++
     prlist (fun (mv,ty) -> Nameops.pr_meta mv ++ str" -> " ++ 
-      prtype ty ++ fnl ())
+      pr_ltype ty ++ fnl ())
       meta_types
-    ++ str"Proof: " ++ prterm (Evarutil.nf_evar evc pfterm))
+    ++ str"Proof: " ++ pr_lconstr (Evarutil.nf_evar evc pfterm))
 
 let show_node () =
   let pts = get_pftreestate () in
   let pf = proof_of_pftreestate pts
   and cursor = cursor_of_pftreestate pts in
   msgnl (prlist_with_sep pr_spc pr_int (List.rev cursor) ++ fnl () ++
-         prgl (goal_of_proof pf) ++ fnl () ++
+         pr_goal (goal_of_proof pf) ++ fnl () ++
          (match pf.Proof_type.ref with
             | None -> (str"BY <rule>")
             | Some(r,spfl) ->
-		(str"BY " ++ Refiner.pr_rule r ++ fnl () ++
+		(str"BY " ++ pr_rule r ++ fnl () ++
 		 str"  " ++
-		   hov 0 (prlist_with_sep pr_fnl prgl
+		   hov 0 (prlist_with_sep pr_fnl pr_goal
 			    (List.map goal_of_proof spfl)))))
     
 let show_script () =
   let pts = get_pftreestate () in
   let pf = proof_of_pftreestate pts
   and evc = evc_of_pftreestate pts in
-  msgnl (Refiner.print_treescript true evc (Global.named_context()) pf)
+  msgnl (print_treescript true evc (Global.named_context()) pf)
 
 let show_top_evars () =
   let pfts = get_pftreestate () in 
   let gls = top_goal_of_pftreestate pfts in 
   let sigma = project gls in 
-  msg (pr_evars_int 1 (Evd.non_instantiated sigma))
+  msg (pr_evars_int 1 (Evarutil.non_instantiated sigma))
 
 let show_prooftree () =
   let pts = get_pftreestate () in
   let pf = proof_of_pftreestate pts
   and evc = evc_of_pftreestate pts in
-  msg (Refiner.print_proof evc (Global.named_context()) pf)
+  msg (print_proof evc (Global.named_context()) pf)
 
 let print_subgoals () = if_verbose (fun () -> msg (pr_open_subgoals ())) ()
 
@@ -112,7 +113,7 @@ let print_subgoals () = if_verbose (fun () -> msg (pr_open_subgoals ())) ()
 
 let fresh_id_of_name avoid gl = function
     Anonymous -> Tactics.fresh_id avoid (id_of_string "H") gl
-  | Name id   -> id
+  | Name id   -> Tactics.fresh_id avoid id gl
 
 let rec do_renum avoid gl = function
     [] -> mt ()
@@ -121,27 +122,83 @@ let rec do_renum avoid gl = function
       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 (strip_outer_cast (pf_concl gl)) 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 (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 "" 
+  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 id_of_name = function 
+  | Names.Anonymous -> id_of_string "x" 
+  | Names.Name x -> x
+
+
+(* Building of match expression *)
+(* From ide/coq.ml *)
+let make_cases s = 
+  let qualified_name = Libnames.qualid_of_string s in
+  let glob_ref = Nametab.locate qualified_name in
+  match glob_ref with
+    | Libnames.IndRef i -> 
+	let {Declarations.mind_nparams = np}
+	    , {Declarations.mind_consnames = carr ; Declarations.mind_nf_lc = tarr } 
+	      = Global.lookup_inductive i in
+	Util.array_fold_right2 
+	  (fun n t l ->  
+	     let (al,_) = Term.decompose_prod t in
+	     let al,_ = Util.list_chop (List.length al - np) al in
+	     let rec rename avoid = function 
+	       | [] -> []
+	       | (n,_)::l -> 
+		   let n' = Termops.next_global_ident_away true (id_of_name n) avoid in
+		   string_of_id n' :: rename (n'::avoid) l in
+	     let al' = rename [] (List.rev al) in
+	     (string_of_id n :: al') :: l)
+	  carr tarr []
+    | _ -> raise Not_found
+
+
+let show_match id = 
+  try
+    let s = string_of_id (snd id) in
+    let patterns = make_cases s in
+    let cases = 
+      List.fold_left 
+	(fun acc x -> 
+	  match x with
+	    | [] -> assert false
+	    | [x] -> "| "^ x  ^ " => \n" ^ acc
+	    | x::l -> 
+		"| (" ^ List.fold_left (fun acc s ->  acc ^ " " ^ s) x l ^ ")" 
+		^ " => \n" ^ acc)
+	"end" patterns in
+    msg (str ("match # with\n" ^ cases))
+  with Not_found -> error "Unknown inductive type"
 
-(********************)
 (* "Print" commands *)
 
 let print_path_entry (s,l) =
   (str s ++ str " " ++ tbrk (0,2) ++ str (string_of_dirpath l))
 
 let print_loadpath () =
-  let l = Library.get_full_load_path () in
+  let l = Library.get_full_load_paths () in
   msgnl (Pp.t (str "Physical path:                                 " ++
 		 tab () ++ str "Logical Path:" ++ fnl () ++ 
 		 prlist_with_sep pr_fnl print_path_entry l))
@@ -190,8 +247,7 @@ let dump_universes s =
 
 let locate_file f =
   try
-    let _,file =
-      System.where_in_path (Library.get_load_path()) f in
+    let _,file = System.where_in_path (Library.get_load_paths ()) f in
     msgnl (str file)
   with Not_found -> 
     msgnl (hov 0 (str"Can't find file" ++ spc () ++ str f ++ spc () ++
@@ -219,13 +275,22 @@ let print_located_library r =
   try msg_found_library (Library.locate_qualified_library qid)
   with e -> msg_notfound_library loc qid e
 
+let print_located_module r = 
+  let (loc,qid) = qualid_of_reference r in
+  let msg =
+    try 
+      let dir = Nametab.full_name_module qid in
+      str "Module " ++ pr_dirpath dir
+    with Not_found ->
+      (if fst (repr_qualid qid) = empty_dirpath then
+	str "No module is referred to by basename "
+      else 
+	str "No module is referred to by name ") ++ pr_qualid qid
+  in msgnl msg  
+
 (**********)
 (* Syntax *)
 
-let vernac_syntax = Metasyntax.add_syntax_obj
-
-let vernac_grammar = Metasyntax.add_grammar_obj
-
 let vernac_syntax_extension = Metasyntax.add_syntax_extension
 
 let vernac_delimiters = Metasyntax.add_delimiters
@@ -233,15 +298,13 @@ let vernac_delimiters = Metasyntax.add_delimiters
 let vernac_bind_scope sc cll = 
   List.iter (fun cl -> Metasyntax.add_class_scope sc (cl_of_qualid cl)) cll
 
-let vernac_open_close_scope = Symbols.open_close_scope
+let vernac_open_close_scope = Notation.open_close_scope
 
 let vernac_arguments_scope qid scl =
-  Symbols.declare_arguments_scope (global qid) scl
+  Notation.declare_arguments_scope (global qid) scl
 
 let vernac_infix = Metasyntax.add_infix
 
-let vernac_distfix = Metasyntax.add_distfix
-
 let vernac_notation = Metasyntax.add_notation
 
 (***********)
@@ -252,7 +315,7 @@ let start_proof_and_print idopt k t hook =
   print_subgoals ();
   if !pcoq <> None then (out_some !pcoq).start_proof ()
 
-let vernac_definition (local,_ as k) id def hook =
+let vernac_definition (local,_,_ as k) id def hook =
   match def with
   | ProveBody (bl,t) ->   (* local binders, typ *)
       if Lib.is_modtype () then
@@ -260,8 +323,7 @@ let vernac_definition (local,_ as k) id def hook =
 	  (str "Proof editing mode not supported in module types")
       else
 	let hook _ _ = () in
-        let kind = if local=Local then IsLocal else IsGlobal DefinitionBody in
-	  start_proof_and_print (Some id) kind (bl,t) hook
+	start_proof_and_print (Some id) (local,DefinitionBody Definition) (bl,t) hook
   | DefineBody (bl,red_option,c,typ_opt) ->
       let red_option = match red_option with
         | None -> None
@@ -278,7 +340,7 @@ let vernac_start_proof kind sopt (bl,t) lettop hook =
   if Lib.is_modtype () then
     errorlabstrm "Vernacentries.StartProof"
       (str "Proof editing mode not supported in module types");
-  start_proof_and_print sopt (IsGlobal (Proof kind)) (bl,t) hook
+  start_proof_and_print sopt (Global, Proof kind) (bl,t) hook
 
 let vernac_end_proof = function
   | Admitted -> admit ()
@@ -293,9 +355,15 @@ let vernac_end_proof = function
      the theories [??] *)
 
 let vernac_exact_proof c =
-  by (Tactics.exact_proof c); 
-  save_named true
-
+  let pfs = top_of_tree (get_pftreestate()) in
+  let pf = proof_of_pftreestate pfs in
+    if (is_leaf_proof pf) then begin
+      by (Tactics.exact_proof c);
+      save_named true end
+    else
+      errorlabstrm "Vernacentries.ExactProof"
+	(str "Command 'Proof ...' can only be used at the beginning of the proof")
+  	
 let vernac_assumption kind l =
   List.iter (fun (is_coe,(idl,c)) -> declare_assumption idl is_coe kind [] c) l
 
@@ -310,107 +378,70 @@ let vernac_scheme = build_scheme
 (**********************)
 (* Modules            *)
 
-let vernac_declare_module id binders_ast mty_ast_o mexpr_ast_o = 
+let vernac_import export refl =
+  let import ref = Library.import_module export (qualid_of_reference ref) in
+  List.iter import refl;
+  Lib.add_frozen_state ()
+
+let vernac_declare_module export id binders_ast mty_ast_o = 
   (* We check the state of the system (in section, in module type)
      and what module information is supplied *)
   if Lib.sections_are_opened () then
     error "Modules and Module Types are not allowed inside sections";
-
-  if not (Lib.is_modtype ()) then
-    error "Declare Module allowed in module types only";
-
-  let constrain_mty = match mty_ast_o with
-      Some (_,true) -> true
-    | _ -> false
-  in
-
-  match mty_ast_o, constrain_mty, mexpr_ast_o with
-    | _, false, None ->  (* no ident, no/soft type *)
-	Declaremods.start_module Modintern.interp_modtype
-	  id binders_ast mty_ast_o;
-	if_verbose message 
-	  ("Interactive Declaration of Module "^ string_of_id id ^" started")
-	  
-    | Some _, true, None           (* no ident, hard type *)
-    | _, false, Some (CMEident _) ->  (* ident, no/soft type *)
-	Declaremods.declare_module 
-	  Modintern.interp_modtype Modintern.interp_modexpr
-	  id binders_ast mty_ast_o mexpr_ast_o;
-	if_verbose message 
-	  ("Module "^ string_of_id id ^" is declared")
-
-    | _, true, Some (CMEident _) -> (* ident, hard type *)
-	error "You cannot declare an equality and a type in module declaration"
-
-    | _, _, Some _ ->    (* not ident *)
-	error "Only simple modules allowed in module declarations"
-
-    | None,true,None -> assert false  (* 1st None ==> false *)
-
-let vernac_define_module id binders_ast mty_ast_o mexpr_ast_o = 
+  let binders_ast = List.map
+   (fun (export,idl,ty) ->
+     if export <> None then
+      error ("Arguments of a functor declaration cannot be exported. " ^
+       "Remove the \"Export\" and \"Import\" keywords from every functor " ^
+       "argument.")
+     else (idl,ty)) binders_ast in
+  Declaremods.declare_module 
+    Modintern.interp_modtype Modintern.interp_modexpr
+     id binders_ast (Some mty_ast_o) None;
+  if_verbose message ("Module "^ string_of_id id ^" is declared");
+  option_iter (fun export -> vernac_import export [Ident (dummy_loc,id)]) export
+
+let vernac_define_module export id binders_ast mty_ast_o mexpr_ast_o = 
   (* We check the state of the system (in section, in module type)
      and what module information is supplied *)
   if Lib.sections_are_opened () then
     error "Modules and Module Types are not allowed inside sections";
- 
-  if Lib.is_modtype () then
-    error "Module definitions not allowed in module types. Use Declare Module instead";
-
   match mexpr_ast_o with
     | None ->
-	Declaremods.start_module Modintern.interp_modtype
+       let binders_ast,argsexport =
+        List.fold_right
+         (fun (export,idl,ty) (args,argsexport) ->
+           (idl,ty)::args, List.map (fun (_,i) -> export,i) idl) binders_ast
+             ([],[]) in
+	Declaremods.start_module Modintern.interp_modtype export
 	  id binders_ast mty_ast_o;
 	if_verbose message 
-	  ("Interactive Module "^ string_of_id id ^" started")
-	  
+	  ("Interactive Module "^ string_of_id id ^" started") ;
+        List.iter
+         (fun (export,id) ->
+           option_iter
+            (fun export -> vernac_import export [Ident (dummy_loc,id)]) export
+         ) argsexport
     | Some _ ->
+       let binders_ast = List.map
+        (fun (export,idl,ty) ->
+          if export <> None then
+           error ("Arguments of a functor definition can be imported only if" ^
+                  " the definition is interactive. Remove the \"Export\" and " ^
+                  "\"Import\" keywords from every functor argument.")
+          else (idl,ty)) binders_ast in
 	Declaremods.declare_module 
 	  Modintern.interp_modtype Modintern.interp_modexpr
 	  id binders_ast mty_ast_o mexpr_ast_o;
 	if_verbose message 
-	  ("Module "^ string_of_id id ^" is defined")
-
-(* let vernac_declare_module id binders_ast mty_ast_o mexpr_ast_o =  *)
-(*   (\* We check the state of the system (in section, in module type) *)
-(*      and what module information is supplied *\) *)
-(*   if Lib.sections_are_opened () then *)
-(*     error "Modules and Module Types are not allowed inside sections"; *)
- 
-(*   let constrain_mty = match mty_ast_o with *)
-(*       Some (_,true) -> true *)
-(*     | _ -> false *)
-(*   in *)
-
-(*   match Lib.is_modtype (), mty_ast_o, constrain_mty, mexpr_ast_o with *)
-(*     | _, None, _, None  *)
-(*     | true, Some _, false, None *)
-(*     | false, _, _, None -> *)
-(* 	Declaremods.start_module Modintern.interp_modtype *)
-(* 	  id binders_ast mty_ast_o; *)
-(* 	if_verbose message  *)
-(* 	  ("Interactive Module "^ string_of_id id ^" started") *)
-	  
-(*     | true, Some _, true, None *)
-(*     | true, _, false, Some (CMEident _) *)
-(*     | false, _, _, Some _ -> *)
-(* 	Declaremods.declare_module  *)
-(* 	  Modintern.interp_modtype Modintern.interp_modexpr *)
-(* 	  id binders_ast mty_ast_o mexpr_ast_o; *)
-(* 	if_verbose message  *)
-(* 	  ("Module "^ string_of_id id ^" is defined") *)
-
-(*     | true, _, _, _ -> *)
-(* 	error "Module definition not allowed in a Module Type" *)
-
-let vernac_end_module id =
-  Declaremods.end_module id;
-  if_verbose message 
-    (if Lib.is_modtype () then 
-       "Module "^ string_of_id id ^" is declared"
-     else
-       "Module "^ string_of_id id ^" is defined")
+	  ("Module "^ string_of_id id ^" is defined");
+        option_iter (fun export -> vernac_import export [Ident (dummy_loc,id)])
+         export
 
-  
+let vernac_end_module export id =
+  Declaremods.end_module id;
+  if_verbose message ("Module "^ string_of_id id ^" is defined") ;
+  option_iter (fun export -> vernac_import export [Ident (dummy_loc,id)]) export
 
 
 let vernac_declare_module_type id binders_ast mty_ast_o =
@@ -419,11 +450,28 @@ let vernac_declare_module_type id binders_ast mty_ast_o =
   
   match mty_ast_o with
     | None ->
+       let binders_ast,argsexport =
+        List.fold_right
+         (fun (export,idl,ty) (args,argsexport) ->
+           (idl,ty)::args, List.map (fun (_,i) -> export,i) idl) binders_ast
+             ([],[]) in
 	Declaremods.start_modtype Modintern.interp_modtype id binders_ast;
 	if_verbose message 
-	  ("Interactive Module Type "^ string_of_id id ^" started")
+	  ("Interactive Module Type "^ string_of_id id ^" started");
+        List.iter
+         (fun (export,id) ->
+           option_iter
+            (fun export -> vernac_import export [Ident (dummy_loc,id)]) export
+         ) argsexport
 	  
     | Some base_mty ->
+       let binders_ast = List.map
+        (fun (export,idl,ty) ->
+          if export <> None then
+           error ("Arguments of a functor definition can be imported only if" ^
+                  " the definition is interactive. Remove the \"Export\" " ^
+                  "and \"Import\" keywords from every functor argument.")
+          else (idl,ty)) binders_ast in
 	Declaremods.declare_modtype Modintern.interp_modtype 
 	  id binders_ast base_mty;
 	if_verbose message 
@@ -455,86 +503,26 @@ let vernac_record struc binders sort nameopt cfs =
 
   (* Sections *)
 
-let vernac_begin_section id = let _ = Lib.open_section id in ()
-
-let vernac_end_section id =
-  Discharge.close_section (is_verbose ()) id
-
+let vernac_begin_section = Lib.open_section
+let vernac_end_section = Lib.close_section
 
 let vernac_end_segment id =
   check_no_pending_proofs ();
-  try
-    match Lib.what_is_opened () with
-      | _,Lib.OpenedModule _ -> vernac_end_module id
-      | _,Lib.OpenedModtype _ -> vernac_end_modtype id
-      | _,Lib.OpenedSection _ -> vernac_end_section id
-      | _ -> anomaly "No more opened things"
-  with
-      Not_found -> error "There is nothing to end."
-
-let is_obsolete_module (_,qid) =
-  match repr_qualid qid with
-  | dir, id when dir = empty_dirpath ->
-      (match string_of_id id with
-	| ("Refine" | "Inv" | "Equality" | "EAuto" | "AutoRewrite"
-	  | "EqDecide" | "Xml" |  "Extraction" | "Tauto" | "Setoid_replace"
-          | "Elimdep" 
-	  | "DatatypesSyntax" | "LogicSyntax" | "Logic_TypeSyntax"
-	  | "SpecifSyntax" | "PeanoSyntax" | "TypeSyntax" | "PolyListSyntax")
-	  -> true
-	| _ -> false)
-  | _ -> false
-
-let test_renamed_module (_,qid) =
-  match repr_qualid qid with
-  | dir, id when dir = empty_dirpath ->
-      (match string_of_id id with
-	| "List" -> warning "List has been renamed into MonoList"
-        | "PolyList" -> warning "PolyList has been renamed into List and old List into MonoList"
-        | _ -> ())
-  | _ -> ()
-
+  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
-  try
-    match import with
-      | None -> List.iter Library.read_library qidl
-      | Some b -> Library.require_library None qidl b
-  with e ->
-  (* Compatibility message *)
-    let qidl' = List.filter is_obsolete_module qidl in
-    if qidl' = qidl then
-      List.iter
-	(fun (_,qid) ->
-	  warning ("Module "^(string_of_qualid qid)^
-	  " is now built-in and shouldn't be required")) qidl
-    else
-      (if not !Options.v7 then List.iter test_renamed_module qidl;
-       raise e)
-      
-let vernac_import export refl =
-  let import_one ref = 
-    let qid = qualid_of_reference ref in
-      Library.import_library export qid
-  in
-    List.iter import_one refl;
-    Lib.add_frozen_state ()
-
-(*  else
-    let import (loc,qid) = 
-      try
-	let mp = Nametab.locate_module qid in
-	  Declaremods.import_module mp
-      with Not_found ->
-	user_err_loc
-        (loc,"vernac_import",
-	 str ((string_of_qualid qid)^" is not a module"))
-    in
-      List.iter import qidl;
-*)
+  Library.require_library qidl import
 
 let vernac_canonical locqid =
-  Recordobj.objdef_declare (Nametab.global locqid)
+  Recordops.declare_canonical_structure (Nametab.global locqid)
 
 let locate_reference ref =
   let (loc,qid) = qualid_of_reference ref in
@@ -591,18 +579,14 @@ let vernac_solve_existential = instantiate_nth_evar_com
 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)
-(* TO DO verifier s'il faut pas mettre exist s | TacId s ici*)
- 
-   
+  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*)
+	
 (*****************************)
 (* Auxiliary file management *)
 
 let vernac_require_from export spec filename =
-  match export with
-      Some exp ->
-        Library.require_library_from_file spec None filename exp
-    | None -> Library.read_library_from_file filename
+  Library.require_library_from_file None filename export
 
 let vernac_add_loadpath isrec pdir ldiropt =
   let alias = match ldiropt with
@@ -610,7 +594,7 @@ let vernac_add_loadpath isrec pdir ldiropt =
     | Some ldir -> ldir in
   (if isrec then Mltop.add_rec_path else Mltop.add_path) pdir alias
 
-let vernac_remove_loadpath = Library.remove_path
+let vernac_remove_loadpath = Library.remove_load_path
 
   (* Coq syntax for ML or system commands *)
 
@@ -651,7 +635,9 @@ let vernac_reset_initial () = abort_refine Lib.reset_initial ()
 
 let vernac_back n = Lib.back n
 
+let vernac_backto n = Lib.reset_label n
 
+(* see also [vernac_backtrack] which combines undoing and resetting *)
 (************)
 (* Commands *)
 
@@ -667,7 +653,7 @@ let vernac_declare_implicits locqid = function
 
 let vernac_reserve idl c =
   let t = Constrintern.interp_type Evd.empty (Global.env()) c in
-  let t = Detyping.detype (false,Global.env()) [] [] t in
+  let t = Detyping.detype false [] [] t in
   List.iter (fun id -> Reserve.declare_reserved_type id t) idl
 
 let make_silent_if_not_pcoq b =
@@ -691,13 +677,11 @@ let _ =
       optread  = Impargs.is_implicit_args;
       optwrite = Impargs.make_implicit_args }
 
-let impargs = if !Options.v7 then "Implicits" else "Implicit"
-
 let _ =
   declare_bool_option 
-    { optsync  = false; (* synchronisation is in Impargs *)
+    { optsync  = true;
       optname  = "strict implicit arguments";
-      optkey   = (SecondaryTable ("Strict",impargs));
+      optkey   = (SecondaryTable ("Strict","Implicit"));
       optread  = Impargs.is_strict_implicit_args;
       optwrite = Impargs.make_strict_implicit_args }
 
@@ -705,7 +689,7 @@ let _ =
   declare_bool_option 
     { optsync  = true;
       optname  = "contextual implicit arguments";
-      optkey   = (SecondaryTable ("Contextual",impargs));
+      optkey   = (SecondaryTable ("Contextual","Implicit"));
       optread  = Impargs.is_contextual_implicit_args;
       optwrite = Impargs.make_contextual_implicit_args }
 
@@ -721,7 +705,7 @@ let _ =
   declare_bool_option 
     { optsync  = true;
       optname  = "implicit arguments printing";
-      optkey   = (SecondaryTable ("Printing",impargs));
+      optkey   = (SecondaryTable ("Printing","Implicit"));
       optread  = (fun () -> !Constrextern.print_implicits);
       optwrite = (fun b ->  Constrextern.print_implicits := b) }
 
@@ -737,7 +721,7 @@ let _ =
   declare_bool_option 
     { optsync  = true;
       optname  = "notations printing";
-      optkey   = (SecondaryTable ("Printing",if !Options.v7 then "Symbols" else "Notations"));
+      optkey   = (SecondaryTable ("Printing","Notations"));
       optread  = (fun () -> not !Constrextern.print_no_symbol);
       optwrite = (fun b ->  Constrextern.print_no_symbol := not b) }
 
@@ -750,6 +734,30 @@ let _ =
       optwrite = (fun b -> Options.raw_print := b) }
 
 let _ =
+  declare_bool_option 
+    { optsync  = true;
+      optname  = "use of virtual machine inside the kernel";
+      optkey   = (SecondaryTable ("Virtual","Machine"));
+      optread  = (fun () -> Vconv.use_vm ());
+      optwrite = (fun b -> Vconv.set_use_vm b) }
+
+let _ =
+  declare_bool_option 
+    { optsync  = true;
+      optname  = "use of boxed definitions";
+      optkey   = (SecondaryTable ("Boxed","Definitions"));
+      optread  = Options.boxed_definitions;
+      optwrite = (fun b -> Options.set_boxed_definitions b) } 
+
+let _ =
+  declare_bool_option 
+    { optsync  = true;
+      optname  = "use of boxed values";
+      optkey   = (SecondaryTable ("Boxed","Values"));
+      optread  = (fun _ -> not (Vm.transp_values ()));
+      optwrite = (fun b -> Vm.set_transp_values (not b)) } 
+
+let _ =
   declare_int_option
     { optsync=false;
       optkey=PrimaryTable("Undo");
@@ -784,11 +792,11 @@ let _ =
 let vernac_set_opacity opaq locqid =
   match Nametab.global locqid with
     | ConstRef sp ->
-	if opaq then Tacred.set_opaque_const sp
-	else Tacred.set_transparent_const sp
+	if opaq then set_opaque_const sp
+	else set_transparent_const sp
     | VarRef id ->
-	if opaq then Tacred.set_opaque_var id
-	else Tacred.set_transparent_var id
+	if opaq then set_opaque_var id
+	else set_transparent_var id
     | _ -> error "cannot set an inductive type or a constructor as transparent"
 
 let vernac_set_option key = function
@@ -843,7 +851,7 @@ let vernac_check_may_eval redexp glopt rc =
 	if !pcoq <> None then (out_some !pcoq).print_check j
 	else msg (print_judgment env j)
     | Some r ->
-	let redfun = Tacred.reduction_of_redexp (interp_redexp env evmap r) in
+	let redfun = fst (reduction_of_red_expr (interp_redexp env evmap r)) in
 	if !pcoq <> None
 	then (out_some !pcoq).print_eval (redfun env evmap) env rc j
 	else msg (print_eval redfun env j)
@@ -859,7 +867,6 @@ let vernac_global_check c =
 
 let vernac_print = function
   | PrintTables -> print_tables ()
-  | PrintLocalContext -> msg (print_local_context ())
   | PrintFullContext -> msg (print_full_context_typ ())
   | PrintSectionContext qid -> msg (print_sec_context_typ qid)
   | PrintInspect n -> msg (inspect n)
@@ -876,21 +883,25 @@ let vernac_print = function
   | PrintOpaqueName qid -> msg (print_opaque_name qid)
   | PrintGraph -> ppnl (Prettyp.print_graph())
   | PrintClasses -> ppnl (Prettyp.print_classes())
+  | PrintLtac qid -> ppnl (Tacinterp.print_ltac (snd (qualid_of_reference qid)))
   | PrintCoercions -> ppnl (Prettyp.print_coercions())
   | PrintCoercionPaths (cls,clt) ->
       ppnl (Prettyp.print_path_between (cl_of_qualid cls) (cl_of_qualid clt))
+  | PrintCanonicalConversions -> ppnl (Prettyp.print_canonical_projections ())
   | PrintUniverses None -> pp (Univ.pr_universes (Global.universes ()))
   | PrintUniverses (Some s) -> dump_universes s
   | PrintHint qid -> Auto.print_hint_ref (Nametab.global qid)
   | PrintHintGoal -> Auto.print_applicable_hint ()
   | PrintHintDbName s -> Auto.print_hint_db_by_name s
+  | PrintRewriteHintDbName s -> Autorewrite.print_rewrite_hintdb s
   | PrintHintDb -> Auto.print_searchtable ()
+  | PrintSetoids -> Setoid_replace.print_setoids()
   | PrintScopes ->
-      pp (Symbols.pr_scopes (Constrextern.without_symbols pr_rawterm))
+      pp (Notation.pr_scopes (Constrextern.without_symbols pr_lrawconstr))
   | PrintScope s ->
-      pp (Symbols.pr_scope (Constrextern.without_symbols pr_rawterm) s)
+      pp (Notation.pr_scope (Constrextern.without_symbols pr_lrawconstr) s)
   | PrintVisibility s ->
-      pp (Symbols.pr_visibility (Constrextern.without_symbols pr_rawterm) s)
+      pp (Notation.pr_visibility (Constrextern.without_symbols pr_lrawconstr) s)
   | PrintAbout qid -> msgnl (print_about qid)
   | PrintImplicit qid -> msg (print_impargs qid)
 
@@ -929,10 +940,11 @@ let vernac_search s r =
 let vernac_locate = function
   | LocateTerm qid -> msgnl (print_located_qualid qid)
   | LocateLibrary qid -> print_located_library qid
+  | LocateModule qid -> print_located_module qid
   | LocateFile f -> locate_file f
   | LocateNotation ntn ->
-      ppnl (Symbols.locate_notation (Constrextern.without_symbols pr_rawterm)
-	(Metasyntax.standardise_locatable_notation ntn))
+      ppnl (Notation.locate_notation (Constrextern.without_symbols pr_lrawconstr)
+	(Metasyntax.standardize_locatable_notation ntn))
 
 (********************)
 (* Proof management *)
@@ -942,7 +954,7 @@ let vernac_goal = function
   | Some c ->
       if not (refining()) then begin
         let unnamed_kind = Lemma (* Arbitrary *) in
-        start_proof_com None (IsGlobal (Proof unnamed_kind)) c (fun _ _ ->());
+        start_proof_com None (Global, Proof unnamed_kind) c (fun _ _ ->());
 	print_subgoals ()
       end else 
 	error "repeated Goal not permitted in refining mode"
@@ -979,6 +991,17 @@ let vernac_undo n =
   undo n;
   print_subgoals ()
 
+(* backtrack with [naborts] abort, then undo_todepth to [pnum], then
+   back-to state number [snum]. This allows to backtrack proofs and
+   state with one command (easier for proofgeneral). *)
+let vernac_backtrack snum pnum naborts =
+  for i = 1 to naborts do vernac_abort None done;
+  undo_todepth pnum;
+  vernac_backto snum;
+  (* 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 ()
@@ -1005,10 +1028,10 @@ let apply_subproof f occ =
   f evc (Global.named_context()) pf
 
 let explain_proof occ =
-  msg (apply_subproof (Refiner.print_treescript true) occ)
+  msg (apply_subproof (print_treescript true) occ)
 
 let explain_tree occ =
-  msg (apply_subproof Refiner.print_proof occ)
+  msg (apply_subproof print_proof occ)
 
 let vernac_show = function
   | ShowGoal nopt ->
@@ -1028,17 +1051,17 @@ let vernac_show = function
   | ShowProofNames ->
       msgnl (prlist_with_sep pr_spc pr_id (Pfedit.get_all_proof_names()))
   | ShowIntros all -> show_intro all
+  | ShowMatch id -> show_match id
   | 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 
-  and cursor = cursor_of_pftreestate pts in
+  let pf = proof_of_pftreestate pts in
   let (pfterm,_) = extract_open_pftreestate pts in
   let message = 
     try 
-      Inductiveops.control_only_guard (Evarutil.evar_env (goal_of_proof pf))
+      Inductiveops.control_only_guard (Evd.evar_env (goal_of_proof pf))
 	pfterm; 
       (str "The condition holds up to here")
     with UserError(_,s) -> 
@@ -1049,100 +1072,19 @@ let vernac_check_guard () =
 let vernac_debug b =
   set_debug (if b then Tactic_debug.DebugOn 0 else Tactic_debug.DebugOff)
 
-
-(**************************)
-(* Not supported commands *)
-(***
-let _ =
-  add "ResetSection"
-    (function 
-       | [VARG_IDENTIFIER id] ->
-	   (fun () -> reset_section (string_of_id id))
-       | _ -> bad_vernac_args "ResetSection")
-
-(* Modules *)
-
-let _ =
-  vinterp_add "BeginModule"
-    (function 
-       | [VARG_IDENTIFIER id] ->
-	   let s = string_of_id id in
-	   let lpe,_ = System.find_file_in_path (Library.get_load_path ()) (s^".v") in
-	   let dir = extend_dirpath (Library.find_logical_path lpe) id in
-	   fun () ->
-	     Lib.start_module dir
-       | _ -> bad_vernac_args "BeginModule")
-
-let _ =
-  vinterp_add "WriteModule"
-    (function 
-       | [VARG_IDENTIFIER id] ->
-	   let mid = Lib.end_module id in
-	   fun () -> let m = string_of_id id in Library.save_module_to mid m
-       | [VARG_IDENTIFIER id; VARG_STRING f] ->
-	   let mid = Lib.end_module id in
-	   fun () -> Library.save_module_to mid f
-       | _ -> bad_vernac_args "WriteModule")
-
-let _ =
-  vinterp_add "CLASS"
-    (function 
-       | [VARG_STRING kind; VARG_QUALID qid] -> 
-	   let stre = 
-	     if kind = "LOCAL" then 
-	       make_strength_0()
-             else 
-	       Nametab.NeverDischarge 
-	   in
-	   fun () -> 
-	     let ref = Nametab.global (dummy_loc, qid) in
-	     Class.try_add_new_class ref stre;
-             if_verbose message
-               ((string_of_qualid qid) ^ " is now a class")
-       | _ -> bad_vernac_args "CLASS")
-
-(* Meta-syntax commands *)
-let _ =
-  add "TOKEN"
-    (function
-       | [VARG_STRING s] -> (fun () -> Metasyntax.add_token_obj s)
-       | _ -> bad_vernac_args "TOKEN")
-***)
-
-(* Search commands *)
-
-(***
-let _ =
-  add "Searchisos"
-  (function
-     | [VARG_CONSTR com] -> 
-	 (fun () ->
-	    let env = Global.env() in
-	    let c = constr_of_com Evd.empty env com in
-	    let cc = nf_betaiota env Evd.empty c in
-            Searchisos.type_search cc)
-     | _ -> bad_vernac_args "Searchisos")
-***)
-
 let interp c = match c with
   (* Control (done in vernac) *)
   | (VernacTime _ | VernacVar _ | VernacList _ | VernacLoad _) -> assert false
-  | (VernacV7only _ | VernacV8only _) -> assert false
 
   (* Syntax *)
-  | VernacSyntax (whatfor,sel) -> vernac_syntax whatfor sel
-  | VernacTacticGrammar al -> Metasyntax.add_tactic_grammar al
-  | VernacGrammar (univ,al) -> vernac_grammar univ al
-  | VernacSyntaxExtension (lcl,sl,l8) -> vernac_syntax_extension lcl sl l8
+  | VernacTacticNotation (n,r,e) -> Metasyntax.add_tactic_notation (n,r,e)
+  | VernacSyntaxExtension (lcl,sl) -> vernac_syntax_extension lcl sl
   | VernacDelimiters (sc,lr) -> vernac_delimiters sc lr
   | VernacBindScope (sc,rl) -> vernac_bind_scope sc rl
   | VernacOpenCloseScope sc -> vernac_open_close_scope sc
   | VernacArgumentsScope (qid,scl) -> vernac_arguments_scope qid scl
-  | VernacInfix (local,mv,qid,mv8,sc) -> vernac_infix local mv qid mv8 sc
-  | VernacDistfix (local,assoc,n,inf,qid,sc) -> 
-      vernac_distfix local assoc n inf qid sc
-  | VernacNotation (local,c,infpl,mv8,sc) ->
-      vernac_notation local c infpl mv8 sc
+  | VernacInfix (local,mv,qid,sc) -> vernac_infix local mv qid sc
+  | VernacNotation (local,c,infpl,sc) -> vernac_notation local c infpl sc
 
   (* Gallina *)
   | VernacDefinition (k,(_,id),d,f) -> vernac_definition k id d f
@@ -1152,15 +1094,15 @@ let interp c = match c with
   | VernacExactProof c -> vernac_exact_proof c
   | VernacAssumption (stre,l) -> vernac_assumption stre l
   | VernacInductive (finite,l) -> vernac_inductive finite l
-  | VernacFixpoint l -> vernac_fixpoint l
-  | VernacCoFixpoint l -> vernac_cofixpoint l
+  | VernacFixpoint (l,b) -> vernac_fixpoint l b
+  | VernacCoFixpoint (l,b) -> vernac_cofixpoint l b
   | VernacScheme l -> vernac_scheme l
 
   (* Modules *)
-  | VernacDeclareModule ((_,id),bl,mtyo,mexpro) -> 
-      vernac_declare_module id bl mtyo mexpro
-  | VernacDefineModule ((_,id),bl,mtyo,mexpro) -> 
-      vernac_define_module id bl mtyo mexpro
+  | VernacDeclareModule (export,(_,id),bl,mtyo) -> 
+      vernac_declare_module export id bl mtyo
+  | VernacDefineModule (export,(_,id),bl,mtyo,mexpro) -> 
+      vernac_define_module export id bl mtyo mexpro
   | VernacDeclareModuleType ((_,id),bl,mtyo) -> 
       vernac_declare_module_type id bl mtyo
 
@@ -1196,6 +1138,7 @@ let interp c = match c with
   | VernacResetName id -> vernac_reset_name id
   | VernacResetInitial -> vernac_reset_initial ()
   | VernacBack n -> vernac_back n
+  | VernacBackTo n -> vernac_backto n
 
   (* Commands *)
   | VernacDeclareTacticDefinition (x,l) -> vernac_declare_tactic_definition x l
@@ -1226,6 +1169,7 @@ let interp c = match c with
   | VernacSuspend -> vernac_suspend ()
   | VernacResume id -> vernac_resume id
   | VernacUndo n -> vernac_undo n
+  | VernacBacktrack (snum,pnum,naborts) -> vernac_backtrack snum pnum naborts
   | VernacFocus n -> vernac_focus n
   | VernacUnfocus -> vernac_unfocus ()
   | VernacGo g -> vernac_go g
diff --git a/toplevel/vernacentries.mli b/toplevel/vernacentries.mli
index 89e0d708..a2bcd990 100644
--- a/toplevel/vernacentries.mli
+++ b/toplevel/vernacentries.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: vernacentries.mli,v 1.16.2.2 2005/01/21 16:41:52 herbelin Exp $ i*)
+(*i $Id: vernacentries.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
 
 (*i*)
 open Names
diff --git a/toplevel/vernacexpr.ml b/toplevel/vernacexpr.ml
index 382434dc..a00901a4 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,v 1.55.2.2 2005/01/21 17:14:10 herbelin Exp $ i*)
+(*i $Id: vernacexpr.ml 7936 2006-01-28 18:36:54Z herbelin $ i*)
 
 open Util
 open Names
@@ -34,7 +34,6 @@ type class_rawexpr = FunClass | SortClass | RefClass of reference
   
 type printable =
   | PrintTables
-  | PrintLocalContext
   | PrintFullContext
   | PrintSectionContext of reference
   | PrintInspect of int
@@ -49,13 +48,17 @@ type printable =
   | PrintOpaqueName of reference
   | PrintGraph
   | PrintClasses
+  | PrintLtac of reference
   | PrintCoercions
   | PrintCoercionPaths of class_rawexpr * class_rawexpr
+  | PrintCanonicalConversions
   | PrintUniverses of string option
   | PrintHint of reference
   | PrintHintGoal
   | PrintHintDbName of string
+  | PrintRewriteHintDbName of string
   | PrintHintDb
+  | PrintSetoids
   | PrintScopes
   | PrintScope of string
   | PrintVisibility of string option
@@ -75,6 +78,7 @@ type searchable =
 type locatable =
   | LocateTerm of reference
   | LocateLibrary of reference
+  | LocateModule of reference
   | LocateFile of string
   | LocateNotation of notation
 
@@ -94,6 +98,7 @@ type showable =
   | ShowTree
   | ShowProofNames
   | ShowIntros of bool
+  | ShowMatch of lident
   | ExplainProof of int list
   | ExplainTree of int list
 
@@ -103,11 +108,11 @@ type comment =
   | CommentInt of int
 
 type hints =
-  | HintsResolve of (identifier option * constr_expr) list
-  | HintsImmediate of (identifier option * constr_expr) list
-  | HintsUnfold of (identifier option * reference) list
-  | HintsConstructors of identifier option * reference list
-  | HintsExtern of identifier option * int * constr_expr * raw_tactic_expr
+  | HintsResolve of constr_expr list
+  | HintsImmediate of constr_expr list
+  | HintsUnfold of reference list
+  | HintsConstructors of reference list
+  | HintsExtern of int * constr_expr * raw_tactic_expr
   | HintsDestruct of identifier *
       int * (bool,unit) location * constr_expr * raw_tactic_expr
 
@@ -152,7 +157,11 @@ type local_decl_expr =
   | AssumExpr of lname * constr_expr
   | DefExpr of lname * constr_expr * constr_expr option
 
-type module_binder = lident list * module_type_ast
+type module_binder = bool option * lident list * module_type_ast
+
+type grammar_production =
+  | VTerm of string
+  | VNonTerm of loc * string * Names.identifier option
 
 type proof_end =
   | Admitted
@@ -166,25 +175,17 @@ type vernac_expr =
   | VernacVar of lident
 
   (* Syntax *) 
-  | VernacGrammar of lstring * raw_grammar_entry list
-  | VernacTacticGrammar of
-      (lstring * (lstring * grammar_production list) * raw_tactic_expr) list
-  | VernacSyntax of lstring * raw_syntax_entry list
-  | VernacSyntaxExtension of locality_flag *
-      (lstring * syntax_modifier list) option 
-      * (lstring * syntax_modifier list) option
-  | VernacDistfix of locality_flag *
-      grammar_associativity * precedence * lstring * lreference *
-      scope_name option
+  | VernacTacticNotation of int * grammar_production list * raw_tactic_expr
+  | VernacSyntaxExtension of locality_flag * (lstring * syntax_modifier list)
   | VernacOpenCloseScope of (locality_flag * bool * scope_name)
   | VernacDelimiters of scope_name * lstring
   | VernacBindScope of scope_name * class_rawexpr list
   | VernacArgumentsScope of lreference * scope_name option list
   | VernacInfix of locality_flag * (lstring * syntax_modifier list) *
-      lreference * (lstring * syntax_modifier list) option * scope_name option
+      lreference * scope_name option
   | VernacNotation of
-      locality_flag * constr_expr * (lstring * syntax_modifier list) option *
-      (lstring * syntax_modifier list) option * scope_name option
+      locality_flag * constr_expr * (lstring * syntax_modifier list) *
+      scope_name option
 
   (* Gallina *)
   | VernacDefinition of definition_kind * lident * definition_expr * 
@@ -195,8 +196,8 @@ type vernac_expr =
   | VernacExactProof of constr_expr
   | VernacAssumption of assumption_kind * simple_binder with_coercion list
   | VernacInductive of inductive_flag * inductive_expr list
-  | VernacFixpoint of (fixpoint_expr * decl_notation) list
-  | VernacCoFixpoint of cofixpoint_expr list
+  | VernacFixpoint of (fixpoint_expr * decl_notation) list * bool
+  | VernacCoFixpoint of cofixpoint_expr list * bool
   | VernacScheme of (lident * bool * lreference * sort_expr) list
 
   (* Gallina extensions *)
@@ -214,9 +215,9 @@ type vernac_expr =
       class_rawexpr * class_rawexpr
 
   (* Modules and Module Types *)
-  | VernacDeclareModule of lident * 
-      module_binder list * (module_type_ast * bool) option * module_ast option
-  | VernacDefineModule of lident * 
+  | VernacDeclareModule of bool option * lident * 
+      module_binder list * (module_type_ast * bool)
+  | VernacDefineModule of bool option * lident * 
       module_binder list * (module_type_ast * bool) option * module_ast option
   | VernacDeclareModuleType of lident * 
       module_binder list * module_type_ast option
@@ -241,6 +242,7 @@ type vernac_expr =
   | VernacResetName of lident
   | VernacResetInitial
   | VernacBack of int
+  | VernacBackTo of int
 
   (* Commands *)
   | VernacDeclareTacticDefinition of
@@ -273,6 +275,7 @@ type vernac_expr =
   | VernacSuspend
   | VernacResume of lident option
   | VernacUndo of int
+  | VernacBacktrack of int*int*int
   | VernacFocus of int option
   | VernacUnfocus
   | VernacGo of goable
@@ -283,10 +286,6 @@ type vernac_expr =
   (* Toplevel control *)
   | VernacToplevelControl of exn
 
-  (* For translation from V7 to V8 syntax *)
-  | VernacV8only of vernac_expr
-  | VernacV7only of vernac_expr
-
   (* For extension *)
   | VernacExtend of string * raw_generic_argument list
 
diff --git a/toplevel/vernacinterp.ml b/toplevel/vernacinterp.ml
index c7846d71..98584bac 100644
--- a/toplevel/vernacinterp.ml
+++ b/toplevel/vernacinterp.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: vernacinterp.ml,v 1.17.8.1 2004/07/16 19:31:50 herbelin Exp $ *)
+(* $Id: vernacinterp.ml 7732 2005-12-26 13:51:24Z herbelin $ *)
 
 open Pp
 open Util
@@ -15,10 +15,7 @@ open Libnames
 open Himsg
 open Proof_type
 open Tacinterp
-open Coqast
 open Vernacexpr
-open Ast
-open Extend
 
 let disable_drop e =
   if e <> Drop then e
diff --git a/toplevel/vernacinterp.mli b/toplevel/vernacinterp.mli
index 86b80935..e0c34dc9 100644
--- a/toplevel/vernacinterp.mli
+++ b/toplevel/vernacinterp.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: vernacinterp.mli,v 1.11.10.1 2004/07/16 19:31:50 herbelin Exp $ i*)
+(*i $Id: vernacinterp.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
 
 (*i*)
 open Tacexpr
diff --git a/toplevel/whelp.ml4 b/toplevel/whelp.ml4
new file mode 100644
index 00000000..042ee5c8
--- /dev/null
+++ b/toplevel/whelp.ml4
@@ -0,0 +1,209 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole 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 camlp4deps: "parsing/grammar.cma" i*)
+
+(* $Id: whelp.ml4 7837 2006-01-11 09:47:32Z herbelin $ *)
+
+open Options
+open Pp
+open Util
+open System
+open Names
+open Term
+open Environ
+open Rawterm
+open Libnames
+open Nametab
+open Termops
+open Detyping
+open Constrintern
+open Dischargedhypsmap
+open Command
+open Pfedit
+open Refiner
+open Tacmach
+
+(* Coq interface to the Whelp query engine developed at 
+   the University of Bologna *)
+
+let make_whelp_request req c =
+  "http://mowgli.cs.unibo.it/forward/58080/apply?xmluri=http%3A%2F%2Fmowgli.cs.unibo.it%3A58081%2Fgetempty&param.profile=firewall&profile=firewall&param.keys=d_c%2CC1%2CHC2%2CL&param.embedkeys=d_c%2CTC1%2CHC2%2CL&param.thkeys=T1%2CT2%2CL%2CE&param.prooftreekeys=HAT%2CG%2CHAO%2CL&param.media-type=text%2Fhtml&param.thmedia-type=&prooftreemedia-type=&param.doctype-public=&param.encoding=&param.thencoding=&param.prooftreeencoding=&advanced=no&keys=S%2CT1%2CT2%2CL%2CRT%2CE&param.expression=" ^ c ^ "&param.action=" ^ req
+
+let b = Buffer.create 16
+
+let url_char c =
+  if 'A' <= c & c <= 'Z' or 'a' <= c & c <= 'z' or 
+     '0' <= c & c <= '9' or c ='.'
+  then Buffer.add_char b c
+  else Buffer.add_string b (Printf.sprintf "%%%2X" (Char.code c))
+
+let url_string s = String.iter url_char s
+
+let rec url_list_with_sep sep f = function
+  | [] -> ()
+  | [a] -> f a
+  | a::l -> f a; url_string sep; url_list_with_sep sep f l 
+
+let url_id id = url_string (string_of_id id)
+
+let uri_of_dirpath dir =
+  url_string "cic:/"; url_list_with_sep "/" url_id (List.rev dir)
+
+let error_whelp_unknown_reference ref =
+  let qid = Nametab.shortest_qualid_of_global Idset.empty ref in
+  error ("Definitions of the current session not supported in Whelp: " ^ string_of_qualid qid)
+
+let uri_of_repr_kn ref (mp,dir,l) = 
+  match mp with
+    | MPfile sl ->
+        uri_of_dirpath (id_of_label l :: repr_dirpath dir @ repr_dirpath sl)
+    | _ ->
+        error_whelp_unknown_reference ref
+
+let url_paren f l = url_char '('; f l; url_char ')'
+let url_bracket f l = url_char '['; f l; url_char ']'
+
+let whelp_of_rawsort = function
+  | RProp Null -> "Prop"
+  | RProp Pos -> "Set"
+  | RType _ -> "Type"
+
+let uri_int n = Buffer.add_string b (string_of_int n)
+
+let uri_of_ind_pointer l =
+  url_string ".ind#xpointer"; url_paren (url_list_with_sep "/" uri_int) l
+
+let uri_of_global ref =
+  match ref with
+  | VarRef id -> error ("Unknown Whelp reference: "^(string_of_id id))
+  | ConstRef cst ->
+      uri_of_repr_kn ref (repr_con cst); url_string ".con"
+  | IndRef (kn,i) -> 
+      uri_of_repr_kn ref (repr_kn kn); uri_of_ind_pointer [1;i+1]
+  | ConstructRef ((kn,i),j) ->
+      uri_of_repr_kn ref (repr_kn kn); uri_of_ind_pointer [1;i+1;j]
+
+let whelm_special = id_of_string "WHELM_ANON_VAR"
+
+let url_of_name = function
+  | Name id -> url_id id
+  | Anonymous -> url_id whelm_special (* No anon id in Whelp *)
+
+let uri_of_binding f (id,c) = url_id id; url_string "\\Assign "; f c
+
+let uri_params f = function
+  | [] -> ()
+  | l -> url_string "\\subst"; 
+         url_bracket (url_list_with_sep ";" (uri_of_binding f)) l
+
+let get_discharged_hyp_names sp = List.map basename (get_discharged_hyps sp)
+
+let section_parameters = function
+  | RRef (_,(ConstructRef ((induri,_),_) | IndRef (induri,_))) ->
+      get_discharged_hyp_names (sp_of_global (IndRef(induri,0)))
+  | RRef (_,(ConstRef cst as ref)) ->
+      get_discharged_hyp_names (sp_of_global ref)
+  | _ -> []
+
+let merge vl al =
+  let rec aux acc = function
+  | ([],l) | (_,([] as l)) -> List.rev acc, l
+  | (v::vl,a::al) -> aux ((v,a)::acc) (vl,al)
+  in aux [] (vl,al)
+
+let rec uri_of_constr c =
+  match c with
+  | RVar (_,id) -> url_id id
+  | RRef (_,ref) ->  uri_of_global ref
+  | RHole _ | REvar _ -> url_string "?"
+  | RSort (_,s) -> url_string (whelp_of_rawsort s)
+  | _ -> url_paren (fun () -> match c with
+  | RApp (_,f,args) ->
+      let inst,rest = merge (section_parameters f) args in
+      uri_of_constr f; url_char ' '; uri_params uri_of_constr inst; 
+      url_list_with_sep " " uri_of_constr rest
+  | RLambda (_,na,ty,c) ->
+      url_string "\\lambda "; url_of_name na; url_string ":";
+      uri_of_constr ty; url_string "."; uri_of_constr c
+  | RProd (_,Anonymous,ty,c) ->
+      uri_of_constr ty; url_string "\\to "; uri_of_constr c
+  | RProd (_,Name id,ty,c) ->
+      url_string "\\forall "; url_id id; url_string ":";
+      uri_of_constr ty; url_string "."; uri_of_constr c
+  | RLetIn (_,na,b,c) ->
+      url_string "let "; url_of_name na; url_string "\\def ";
+      uri_of_constr b; url_string " in "; uri_of_constr c
+  | RCast (_,c,_,t) ->
+      uri_of_constr c; url_string ":"; uri_of_constr t
+  | RRec _ | RIf _ | RLetTuple _ | RCases _ ->
+      error "Whelp does not support pattern-matching and (co-)fixpoint"
+  | RVar _ | RRef _ | RHole _ | REvar _ | RSort _ ->
+      anomaly "Written w/o parenthesis"
+  | RPatVar _ | RDynamic _ -> 
+      anomaly "Found constructors not supported in constr") ()
+
+let make_string f x = Buffer.reset b; f x; Buffer.contents b
+
+let send_whelp req s =
+  let url = make_whelp_request req s in
+  let command = (fst browser_cmd_fmt) ^ url ^ (snd browser_cmd_fmt) in
+  let _ = run_command (fun x -> x) print_string command in ()
+
+let whelp_constr req c =
+  let c = detype false [whelm_special] [] c in
+  send_whelp req (make_string uri_of_constr c)
+
+let whelp_constr_expr req c =
+  let (sigma,env)= get_current_context () in
+  let _,c = interp_open_constr sigma env c in
+  whelp_constr req c
+
+let whelp_locate s =
+  send_whelp "locate" s
+
+let whelp_elim ind = 
+  send_whelp "elim" (make_string uri_of_global (IndRef ind))
+
+let locate_inductive r =
+  let (loc,qid) = qualid_of_reference r in
+  try match Syntax_def.locate_global qid with
+    | IndRef ind -> ind
+    | _ -> user_err_loc (loc,"",str "Inductive type expected")
+  with Not_found -> error_global_not_found_loc loc qid
+
+let on_goal f =
+  let gls = nth_goal_of_pftreestate 1 (get_pftreestate ()) in
+  f (it_mkNamedProd_or_LetIn (pf_concl gls) (pf_hyps gls))
+
+type whelp_request =
+  | Locate of string
+  | Elim of inductive
+  | Constr of string * constr
+
+let whelp = function
+  | Locate s -> whelp_locate s
+  | Elim ind -> whelp_elim ind
+  | Constr (s,c) -> whelp_constr s c
+
+VERNAC ARGUMENT EXTEND whelp_constr_request
+| [ "Match" ] -> [ "match" ]
+| [ "Instance" ] -> [ "instance" ]
+END
+
+VERNAC COMMAND EXTEND Whelp
+| [ "Whelp" "Locate" string(s) ] -> [ whelp_locate s ] 
+| [ "Whelp" "Locate" preident(s) ] -> [ whelp_locate s ] 
+| [ "Whelp" "Elim" global(r) ] -> [ whelp_elim (locate_inductive r) ] 
+| [ "Whelp" whelp_constr_request(req) constr(c) ] -> [ whelp_constr_expr req c]
+END
+
+VERNAC COMMAND EXTEND WhelpHint
+| [ "Whelp" "Hint" constr(c) ] -> [ whelp_constr_expr "hint" c ] 
+| [ "Whelp" "Hint" ] -> [ on_goal (whelp_constr "hint") ] 
+END
diff --git a/theories7/Reals/SplitRmult.v b/toplevel/whelp.mli
index 392675c3..f3f7408a 100644
--- a/theories7/Reals/SplitRmult.v
+++ b/toplevel/whelp.mli
@@ -6,14 +6,19 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: SplitRmult.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+(*i $Id: whelp.mli 7837 2006-01-11 09:47:32Z herbelin $ i*)
 
-(*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*)
+(* Coq interface to the Whelp query engine developed at 
+   the University of Bologna *)
 
+open Names
+open Term
+open Topconstr
+open Environ
 
-Require Rbase.
-
-Recursive Tactic Definition SplitRmult :=
-  Match Context With
-  | [ |- ~(Rmult ?1 ?2)==R0 ] -> Apply mult_non_zero; Split;Try SplitRmult.
+type whelp_request =
+  | Locate of string
+  | Elim of inductive
+  | Constr of string * constr
 
+val whelp : whelp_request -> unit
diff --git a/translate/ppconstrnew.ml b/translate/ppconstrnew.ml
deleted file mode 100644
index 381ac2c3..00000000
--- a/translate/ppconstrnew.ml
+++ /dev/null
@@ -1,965 +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        *)
-(************************************************************************)
-
-(* $Id: ppconstrnew.ml,v 1.62.2.6 2005/03/08 10:13:45 herbelin Exp $ *)      
-
-(*i*)
-open Ast
-open Util
-open Pp
-open Nametab
-open Names
-open Nameops
-open Libnames
-open Coqast
-open Ppextend
-open Topconstr
-open Term
-open Pattern
-(*i*)
-
-let pr_id id = Nameops.pr_id (Constrextern.v7_to_v8_id id)
-
-let sep_p = fun _ -> str"."
-let sep_v = fun _ -> str"," ++ spc()
-let sep_pp = fun _ -> str":"
-let sep_bar = fun _ -> spc() ++ str"| "
-let pr_tight_coma () = str "," ++ cut ()
-
-let latom = 0
-let lannot = 100
-let lprod = 200
-let llambda = 200
-let lif = 200
-let lletin = 200
-let lfix = 200
-let larrow = 90
-let lcast = 100
-let larg = 9
-let lapp = 10
-let lposint = 0
-let lnegint = 35 (* must be consistent with Notation "- x" *)
-let ltop = (200,E)
-let lproj = 1
-let lsimple = (1,E)
-
-let prec_less child (parent,assoc) =
-  if parent < 0 && child = lprod then true
-  else
-    let parent = abs parent in
-    match assoc with
-      | E -> (<=) child parent
-      | L -> (<) child parent
-      | Prec n -> child<=n
-      | Any -> true
-
-let env_assoc_value v env =
-  try List.nth env (v-1)
-  with Not_found -> anomaly ("Inconsistent environment for pretty-print rule")
-
-let decode_constrlist_value = function
-  | CAppExpl (_,_,l) -> l
-  | CApp (_,_,l) -> List.map fst l
-  | _ -> anomaly "Ill-formed list argument of notation"
-
-let decode_patlist_value = function
-  | CPatCstr (_,_,l) -> l
-  | _ -> anomaly "Ill-formed list argument of notation"
-
-open Symbols
-
-let rec print_hunk n decode pr env = function
-  | UnpMetaVar (e,prec) -> pr (n,prec) (env_assoc_value e env)
-  | UnpListMetaVar (e,prec,sl) -> 
-      prlist_with_sep (fun () -> prlist (print_hunk n decode pr env) sl)
-      (pr (n,prec)) (decode (env_assoc_value e env))
-  | UnpTerminal s -> str s
-  | UnpBox (b,sub) -> ppcmd_of_box b (prlist (print_hunk n decode pr env) sub)
-  | UnpCut cut -> ppcmd_of_cut cut
-
-let pr_notation_gen decode pr s env =
-  let unpl, level = find_notation_printing_rule s in
-  prlist (print_hunk level decode pr env) unpl, level
-
-let pr_notation = pr_notation_gen decode_constrlist_value
-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
-    comment b ++ pr x ++ comment e
-  else pr x
-
-let pr_com_at n =
-  if Options.do_translate() && n <> 0 then comment n 
-  else mt()
-
-let pr_with_comments loc pp = pr_located (fun x -> x) (loc,pp)
-
-let pr_sep_com sep f c = pr_with_comments (constr_loc c) (sep() ++ f c)
-
-open Rawterm
-
-let pr_opt pr = function
-  | None -> mt ()
-  | Some x -> spc() ++ pr x
-
-let pr_optc pr = function
-  | None -> mt ()
-  | Some x -> pr_sep_com spc pr x
-
-let pr_universe = Univ.pr_uni
-
-let pr_sort = function
-  | RProp Term.Null -> str "Prop"
-  | RProp Term.Pos -> str "Set"
-  | RType u -> str "Type" ++ pr_opt pr_universe u
-
-let pr_expl_args pr (a,expl) =
-  match expl with
-  | None -> pr (lapp,L) a
-  | Some (_,ExplByPos n) ->
-      anomaly("Explicitation by position not implemented")
-  | Some (_,ExplByName id) -> 
-      str "(" ++ pr_id id ++ str ":=" ++ pr ltop a ++ str ")"
-
-let pr_opt_type pr = function
-  | CHole _ -> mt ()
-  | t -> cut () ++ str ":" ++ pr t
-
-let pr_opt_type_spc pr = function
-  | CHole _ -> mt ()
-  | t ->  str " :" ++ pr_sep_com (fun()->brk(1,2)) (pr ltop) t
-
-let pr_name = function
-  | Anonymous -> str"_"
-  | Name id -> pr_id id
-
-let pr_lident (b,_ as loc,id) =
-  if loc <> dummy_loc then
-    let (b,_) = unloc loc in
-    pr_located pr_id (make_loc (b,b+String.length(string_of_id id)),id)
-  else pr_id id
-
-let pr_lname = function
-    (loc,Name id) -> pr_lident (loc,id)
-  | lna -> pr_located pr_name lna
-
-let pr_or_var pr = function
-  | Genarg.ArgArg x -> pr x
-  | Genarg.ArgVar (loc,s) -> pr_lident (loc,s)
-
-let las = lapp
-
-let rec pr_patt sep inh p =
-  let (strm,prec) = match p with
-  | CPatAlias (_,p,id) ->
-      pr_patt mt (las,E) p ++ str " as " ++ pr_id id, las
-  | CPatCstr (_,c,[]) -> pr_reference c, latom
-  | CPatCstr (_,c,args) ->
-      pr_reference c ++ prlist (pr_patt spc (lapp,L)) args, lapp
-  | CPatAtom (_,None) -> str "_", latom
-  | CPatAtom (_,Some r) -> pr_reference r, latom
-  | CPatNotation (_,"( _ )",[p]) ->
-      pr_patt (fun()->str"(") (max_int,E) p ++ str")", latom
-  | CPatNotation (_,s,env) -> pr_patnotation (pr_patt mt) s env
-  | CPatNumeral (_,i) -> Bignat.pr_bigint i, latom
-  | CPatDelimiters (_,k,p) -> pr_delimiters k (pr_patt mt lsimple p), 1
-  in
-  let loc = cases_pattern_loc p in
-  pr_with_comments loc
-    (sep() ++ if prec_less prec inh then strm else surround strm)
-
-let pr_patt = pr_patt mt
-
-
-let pr_eqn pr (loc,pl,rhs) =
-  spc() ++ hov 4
-    (pr_with_comments loc
-      (str "| " ++
-      hov 0 (prlist_with_sep sep_v (pr_patt ltop) pl ++ str " =>") ++
-      pr_sep_com spc (pr ltop) rhs))
-
-let begin_of_binder = function
-    LocalRawDef((loc,_),_) -> fst (unloc loc)
-  | LocalRawAssum((loc,_)::_,_) -> fst (unloc loc)
-  | _ -> assert false
-
-let begin_of_binders = function
-  | b::_ -> begin_of_binder b
-  | _ -> 0
-
-let pr_binder many pr (nal,t) =
-  match t with
-  | CHole _ -> prlist_with_sep spc pr_lname nal
-  | _ ->
-    let s = prlist_with_sep spc pr_lname nal ++ str" : " ++ pr t in
-    hov 1 (if many then surround s else s)
-
-let pr_binder_among_many pr_c = function
-  | LocalRawAssum (nal,t) ->
-      pr_binder true pr_c (nal,t)
-  | LocalRawDef (na,c) ->
-      let c,topt = match c with
-        | CCast(_,c,t) -> c, t
-        | _ -> c, CHole dummy_loc in
-      hov 1 (surround
-        (pr_lname na ++ pr_opt_type pr_c topt ++
-         str":=" ++ cut() ++ pr_c c))
-
-let pr_undelimited_binders pr_c =
-  prlist_with_sep spc (pr_binder_among_many pr_c)
-
-let pr_delimited_binders kw pr_c bl =
-  let n = begin_of_binders bl in
-  match bl with
-  | [LocalRawAssum (nal,t)] ->
-      pr_com_at n ++ kw() ++ pr_binder false pr_c (nal,t)
-  | LocalRawAssum _ :: _ as bdl ->
-      pr_com_at n ++ kw() ++ pr_undelimited_binders pr_c bdl
-  | _ -> assert false
-
-let pr_let_binder pr x a =
-  hov 0 (hov 0 (pr_name x ++ brk(0,1) ++ str ":=") ++
-         pr_sep_com (fun () -> brk(0,1)) (pr ltop) a)
-
-let rec extract_prod_binders = function
-(*  | CLetIn (loc,na,b,c) as x ->
-      let bl,c = extract_prod_binders c in
-      if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
-  | CProdN (loc,[],c) ->
-      extract_prod_binders c
-  | CProdN (loc,(nal,t)::bl,c) ->
-      let bl,c = extract_prod_binders (CProdN(loc,bl,c)) in
-      LocalRawAssum (nal,t) :: bl, c
-  | c -> [], c
-
-let rec extract_lam_binders = function
-(*  | CLetIn (loc,na,b,c) as x ->
-      let bl,c = extract_lam_binders c in
-      if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
-  | CLambdaN (loc,[],c) ->
-      extract_lam_binders c
-  | CLambdaN (loc,(nal,t)::bl,c) ->
-      let bl,c = extract_lam_binders (CLambdaN(loc,bl,c)) in
-      LocalRawAssum (nal,t) :: bl, c
-  | c -> [], c
-    
-let pr_global vars ref =
-  (* pr_global_env vars ref *)
-  let s = string_of_qualid (Constrextern.shortest_qualid_of_v7_global vars ref) in
-  (str s)
-
-let split_lambda = function
-  | CLambdaN (loc,[[na],t],c) -> (na,t,c)
-  | CLambdaN (loc,([na],t)::bl,c) -> (na,t,CLambdaN(loc,bl,c))
-  | CLambdaN (loc,(na::nal,t)::bl,c) -> (na,t,CLambdaN(loc,(nal,t)::bl,c))
-  | _ -> anomaly "ill-formed fixpoint body"
-
-let rename na na' t c =
-  match (na,na') with
-    | (_,Name id), (_,Name id') -> (na',t,replace_vars_constr_expr [id,id'] c)
-    | (_,Name id), (_,Anonymous) -> (na,t,c)
-    | _ -> (na',t,c)
-  
-let split_product na' = function
-  | CArrow (loc,t,c) -> (na',t,c)
-  | CProdN (loc,[[na],t],c) -> rename na na' t c
-  | CProdN (loc,([na],t)::bl,c) -> rename na na' t (CProdN(loc,bl,c))
-  | CProdN (loc,(na::nal,t)::bl,c) ->
-      rename na na' t (CProdN(loc,(nal,t)::bl,c))
-  | _ -> anomaly "ill-formed fixpoint body"
-
-let merge_binders (na1,ty1) cofun (na2,ty2) codom =
-  let na =
-    match snd na1, snd na2 with
-        Anonymous, Name id ->
-          if occur_var_constr_expr id cofun then
-            failwith "avoid capture"
-          else na2
-      | Name id, Anonymous ->
-          if occur_var_constr_expr id codom then
-            failwith "avoid capture"
-          else na1
-      | Anonymous, Anonymous -> na1
-      | Name id1, Name id2 ->
-          if id1 <> id2 then failwith "not same name" else na1 in
-  let ty =
-    match ty1, ty2 with
-        CHole _, _ -> ty2
-      | _, CHole _ -> ty1
-      | _ ->
-          Constrextern.check_same_type ty1 ty2;
-          ty2 in
-  (LocalRawAssum ([na],ty), codom)
-            
-let rec strip_domain bvar cofun c =
-  match c with
-    | CArrow(loc,a,b) ->
-        merge_binders bvar cofun ((dummy_loc,Anonymous),a) b
-    | CProdN(loc,[([na],ty)],c') ->
-        merge_binders bvar cofun (na,ty) c'
-    | CProdN(loc,([na],ty)::bl,c') ->
-        merge_binders bvar cofun (na,ty) (CProdN(loc,bl,c'))
-    | CProdN(loc,(na::nal,ty)::bl,c') ->
-        merge_binders bvar cofun (na,ty) (CProdN(loc,(nal,ty)::bl,c'))
-    | _ -> failwith "not a product"
-
-(* Note: binder sharing is lost *)
-let rec strip_domains (nal,ty) cofun c =
-  match nal with
-      [] -> assert false
-    | [na] ->
-        let bnd, c' = strip_domain (na,ty) cofun c in
-        ([bnd],None,c')
-    | na::nal ->
-        let f = CLambdaN(dummy_loc,[(nal,ty)],cofun) in
-        let bnd, c1 = strip_domain (na,ty) f c in
-        (try
-          let bl, rest, c2 = strip_domains (nal,ty) cofun c1 in
-          (bnd::bl, rest, c2)
-        with Failure _ -> ([bnd],Some (nal,ty), c1))
-
-(* Re-share binders *)
-let rec factorize_binders = function
-  | ([] | [_] as l) -> l
-  | LocalRawAssum (nal,ty) as d :: (LocalRawAssum (nal',ty')::l as l') ->
-      (try
-	let _ = Constrextern.check_same_type ty ty' in
-	factorize_binders (LocalRawAssum (nal@nal',ty)::l)
-      with _ ->
-	d :: factorize_binders l')
-  | d :: l -> d :: factorize_binders l
-
-(* Extract lambdas when a type constraint occurs *)
-let rec extract_def_binders c ty =
-  match c with
-    | CLambdaN(loc,bvar::lams,b) ->
-        (try
-          let f = CLambdaN(loc,lams,b) in
-          let bvar', rest, ty' = strip_domains bvar f ty in
-          let c' =
-            match rest, lams with
-                None,[] -> b
-              | None, _ -> f
-              | Some bvar,_ -> CLambdaN(loc,bvar::lams,b) in
-          let (bl,c2,ty2) = extract_def_binders c' ty' in
-          (factorize_binders (bvar'@bl), c2, ty2)
-        with Failure _ ->
-          ([],c,ty))
-    | _ -> ([],c,ty)
-
-let rec split_fix n typ def =
-  if n = 0 then ([],typ,def)
-  else
-    let (na,_,def) = split_lambda def in
-    let (na,t,typ) = split_product na typ in
-    let (bl,typ,def) = split_fix (n-1) typ def in
-    (LocalRawAssum ([na],t)::bl,typ,def)
-
-let pr_recursive_decl pr pr_dangling dangling_with_for id bl annot t c =
-  let pr_body =
-    if dangling_with_for then pr_dangling else pr in
-  pr_id id ++ str" " ++
-  hov 0 (pr_undelimited_binders (pr ltop) bl ++ annot) ++
-  pr_opt_type_spc pr t ++ str " :=" ++
-  pr_sep_com (fun () -> brk(1,2)) (pr_body ltop) c
-
-let pr_fixdecl pr prd dangling_with_for (id,n,bl,t,c) =
-  let annot =
-    let ids = names_of_local_assums bl in
-    if List.length ids > 1 then 
-      spc() ++ str "{struct " ++ pr_name (snd (List.nth ids n)) ++ str"}"
-    else mt() in
-  pr_recursive_decl pr prd dangling_with_for id bl annot t c
-
-let pr_cofixdecl pr prd dangling_with_for (id,bl,t,c) =
-  pr_recursive_decl pr prd dangling_with_for id bl (mt()) t c
-
-let pr_recursive pr_decl id = function
-  | [] -> anomaly "(co)fixpoint with no definition"
-  | [d1] -> pr_decl false d1
-  | dl ->
-      prlist_with_sep (fun () -> fnl() ++ str "with ")
-        (pr_decl true) dl ++
-      fnl() ++ str "for " ++ pr_id id
-
-let pr_arg pr x = spc () ++ pr x
-
-let is_var id = function
-  | CRef (Ident (_,id')) when id=id' -> true
-  | _ -> false
-
-let tm_clash = function
-  | (CRef (Ident (_,id)), Some (CApp (_,_,nal))) 
-      when List.exists (function CRef (Ident (_,id')),_ -> id=id' | _ -> false)
-	nal
-      -> Some id
-  | (CRef (Ident (_,id)), Some (CAppExpl (_,_,nal))) 
-      when List.exists (function CRef (Ident (_,id')) -> id=id' | _ -> false)
-	nal
-      -> Some id
-  | _ -> None
-
-let pr_case_item pr (tm,(na,indnalopt)) =
-  hov 0 (pr (lcast,E) tm ++
-(*
-  (match na with
-    | Name id when not (is_var id tm) -> spc () ++ str "as " ++  pr_id id
-    | Anonymous when tm_clash (tm,indnalopt) <> None ->
-	(* hide [tm] name to avoid conflicts *)
-	spc () ++ str "as _" (* ++ pr_id (out_some (tm_clash (tm,indnalopt)))*)
-    | _ -> mt ()) ++
-*)
-  (match na with (* Decision of printing "_" or not moved to constrextern.ml *)
-    | Some na -> spc () ++ str "as " ++  pr_name na
-    | None -> mt ()) ++
-  (match indnalopt with
-    | None -> mt ()
-(*
-    | Some (_,ind,nal) ->
-        spc () ++ str "in " ++ 
-        hov 0 (pr_reference ind ++ prlist (pr_arg pr_name) nal))
-*)
-    | Some t -> spc () ++ str "in " ++ pr lsimple t))
-
-let pr_case_type pr po =
-  match po with
-    | None | Some (CHole _) -> mt()
-    | Some p ->
-        spc() ++ hov 2 (str "return" ++ pr_sep_com spc (pr lsimple) p)
-
-let pr_return_type pr po = pr_case_type pr po
-
-let pr_simple_return_type pr na po =
-  (match na with
-    | Some (Name id) ->
-        spc () ++ str "as " ++  pr_id id
-    | _ -> mt ()) ++
-  pr_case_type pr po
-
-let pr_proj pr pr_app a f l =
-  hov 0 (pr lsimple a ++ cut() ++ str ".(" ++ pr_app pr f l ++ str ")")
-
-let pr_appexpl pr f l =
-      hov 2 (
-	str "@" ++ pr_reference f ++
-	prlist (pr_sep_com spc (pr (lapp,L))) l)
-
-let pr_app pr a l =
-  hov 2 (
-    pr (lapp,L) a  ++ 
-    prlist (fun a -> spc () ++ pr_expl_args pr a) l)
-
-let rec pr sep inherited a =
-  let (strm,prec) = match a with
-  | CRef r -> pr_reference r, latom
-  | CFix (_,id,fix) ->
-      hov 0 (str"fix " ++
-             pr_recursive
-               (pr_fixdecl (pr mt) (pr_dangling_with_for mt)) (snd id) fix),
-      lfix
-  | CCoFix (_,id,cofix) ->
-      hov 0 (str "cofix " ++
-             pr_recursive
-              (pr_cofixdecl (pr mt) (pr_dangling_with_for mt)) (snd id) cofix),
-      lfix
-  | CArrow (_,a,b) ->
-      hov 0 (pr mt (larrow,L) a ++ str " ->" ++
-             pr (fun () ->brk(1,0)) (-larrow,E) b),
-      larrow
-  | CProdN _ ->
-      let (bl,a) = extract_prod_binders a in
-      hov 0 (
-	hov 2 (pr_delimited_binders (fun () -> str"forall" ++ spc())
-                 (pr mt ltop) bl) ++
-        str "," ++ pr spc ltop a),
-      lprod
-  | CLambdaN _ ->
-      let (bl,a) = extract_lam_binders a in
-      hov 0 (
-        hov 2 (pr_delimited_binders (fun () -> str"fun" ++ spc())
-                 (pr mt ltop) bl) ++
-
-        str " =>" ++ pr spc ltop a),
-      llambda
-  | CLetIn (_,(_,Name x),(CFix(_,(_,x'),[_])|CCoFix(_,(_,x'),[_]) as fx), b)
-      when x=x' ->
-      hv 0 (
-        hov 2 (str "let " ++ pr mt ltop fx ++ str " in") ++
-        pr spc ltop b),
-      lletin
-  | CLetIn (_,x,a,b) ->
-      hv 0 (
-        hov 2 (str "let " ++ pr_lname x ++ str " :=" ++
-               pr spc ltop a ++ str " in") ++
-        pr spc ltop b),
-      lletin
-  | CAppExpl (_,(Some i,f),l) ->
-      let l1,l2 = list_chop i l in
-      let c,l1 = list_sep_last l1 in
-      let p = pr_proj (pr mt) pr_appexpl c f l1 in
-      if l2<>[] then
-	p ++ prlist (pr spc (lapp,L)) l2, lapp
-      else
-	p, lproj
-  | CAppExpl (_,(None,Ident (_,var)),[t])
-  | CApp (_,(_,CRef(Ident(_,var))),[t,None])
-        when var = Topconstr.ldots_var ->
-      hov 0 (str ".." ++ pr spc (latom,E) t ++ spc () ++ str ".."), larg
-  | CAppExpl (_,(None,f),l) -> pr_appexpl (pr mt) f l, lapp
-  | CApp (_,(Some i,f),l) ->
-      let l1,l2 = list_chop i l in
-      let c,l1 = list_sep_last l1 in
-      assert (snd c = None);
-      let p = pr_proj (pr mt) pr_app (fst c) f l1 in
-      if l2<>[] then 
-	p ++ prlist (fun a -> spc () ++ pr_expl_args (pr mt) a) l2, lapp
-      else
-	p, lproj
-  | CApp (_,(None,a),l) -> pr_app (pr mt) a l, lapp
-  | CCases (_,(po,rtntypopt),c,eqns) ->
-      v 0
-        (hv 0 (str "match" ++ brk (1,2) ++
-	  hov 0 (
-	    prlist_with_sep sep_v
-              (pr_case_item (pr_dangling_with_for mt)) c
-            ++ pr_case_type (pr_dangling_with_for mt) rtntypopt) ++
-	spc () ++ str "with") ++
-        prlist (pr_eqn (pr mt)) eqns ++ spc() ++ str "end"),
-      latom
-  | CLetTuple (_,nal,(na,po),c,b) ->
-      hv 0 (
-        str "let " ++
-	hov 0 (str "(" ++
-               prlist_with_sep sep_v pr_name nal ++
-               str ")" ++
-	       pr_simple_return_type (pr mt) na po ++ str " :=" ++
-               pr spc ltop c ++ str " in") ++
-        pr spc ltop b),
-      lletin
-  | CIf (_,c,(na,po),b1,b2) ->
-      (* On force les parenthèses autour d'un "if" sous-terme (même si le
-	 parsing est lui plus tolérant) *)
-      hv 0 (
-	hov 1 (str "if " ++ pr mt ltop c ++ pr_simple_return_type (pr mt) na po) ++
-	spc () ++
-	hov 0 (str "then" ++ pr (fun () -> brk (1,1)) ltop b1) ++ spc () ++
-	hov 0 (str "else" ++ pr (fun () -> brk (1,1)) ltop b2)),
-      lif
-     
-  | COrderedCase (_,st,po,c,[b1;b2]) when st = IfStyle ->
-      (* On force les parenthèses autour d'un "if" sous-terme (même si le
-	 parsing est lui plus tolérant) *)
-      hv 0 (
-	hov 1 (str "if " ++ pr mt ltop c ++
-                 pr_return_type (pr mt) po) ++ spc () ++
-	hov 0 (str "then" ++ pr (fun () -> brk (1,1)) ltop b1) ++ spc () ++
-	hov 0 (str "else" ++ pr (fun () -> brk (1,1)) ltop b2)),
-      lif
-  | COrderedCase (_,st,po,c,[CLambdaN(_,[nal,_],b)]) when st = LetStyle ->
-      hv 0 (
-        str "let " ++
-	hov 0 (str "(" ++
-               prlist_with_sep sep_v (fun (_,n) -> pr_name n) nal ++
-               str ")" ++
-	       pr_return_type (pr mt) po ++ str " :=" ++
-               pr spc ltop c ++ str " in") ++
-        pr spc ltop b),
-      lletin
-
-  | COrderedCase (_,style,po,c,bl) ->
-      hv 0 (
-	str (if style=MatchStyle then "old_match " else "match ") ++ 
-	pr mt ltop c ++
-	pr_return_type (pr_dangling_with_for mt) po ++
-	str " with" ++ brk (1,0) ++
-	hov 0 (prlist
-          (fun b -> str "| ??? =>" ++ pr spc ltop b ++ fnl ()) bl) ++
-        str "end"),
-      latom
-  | CHole _ -> str "_", latom
-  | CEvar (_,n) -> str (Evd.string_of_existential n), latom
-  | CPatVar (_,(_,p)) -> str "?" ++ pr_patvar p, latom
-  | CSort (_,s) -> pr_sort s, latom
-  | CCast (_,a,b) ->
-      hv 0 (pr mt (lcast,L) a ++ cut () ++ str ":" ++ pr mt (-lcast,E) b),
-      lcast
-  | CNotation (_,"( _ )",[t]) ->
-      pr (fun()->str"(") (max_int,L) t ++ str")", latom
-  | CNotation (_,s,env) -> pr_notation (pr mt) s env
-  | CNumeral (_,(Bignat.POS _ as p)) -> Bignat.pr_bigint p, lposint
-  | CNumeral (_,(Bignat.NEG _ as p)) -> Bignat.pr_bigint p, lnegint
-  | CDelimiters (_,sc,a) -> pr_delimiters sc (pr mt lsimple a), 1
-  | CDynamic _ -> str "<dynamic>", latom
-  in
-  let loc = constr_loc a in
-  pr_with_comments loc
-    (sep() ++ if prec_less prec inherited then strm else surround strm)
-
-and pr_dangling_with_for sep inherited a =
-  match a with
-  | (CFix (_,_,[_])|CCoFix(_,_,[_])) -> pr sep (latom,E) a
-  | _ -> pr sep inherited a
-
-let pr = pr mt
-
-let rec abstract_constr_expr c = function
-  | [] -> c
-  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,abstract_constr_expr c bl)
-  | LocalRawAssum (idl,t)::bl ->
-      List.fold_right (fun x b -> mkLambdaC([x],t,b)) idl
-      (abstract_constr_expr c bl)
-      
-let rec prod_constr_expr c = function
-  | [] -> c
-  | LocalRawDef (x,b)::bl -> mkLetInC(x,b,prod_constr_expr c bl)
-  | LocalRawAssum (idl,t)::bl ->
-      List.fold_right (fun x b -> mkProdC([x],t,b)) idl
-      (prod_constr_expr c bl)
-
-let rec strip_context n iscast t =
-  if n = 0 then
-    [], if iscast then match t with CCast (_,c,_) -> c | _ -> t else t
-  else match t with
-    | CLambdaN (loc,(nal,t)::bll,c) ->
-	let n' = List.length nal in
-	if n' > n then
-	  let nal1,nal2 = list_chop n nal in
-	  [LocalRawAssum (nal1,t)], CLambdaN (loc,(nal2,t)::bll,c)
-	else
-	let bl', c = strip_context (n-n') iscast
-	  (if bll=[] then c else CLambdaN (loc,bll,c)) in
-	LocalRawAssum (nal,t) :: bl', c 
-    | CProdN (loc,(nal,t)::bll,c) ->
-	let n' = List.length nal in
-	if n' > n then
-	  let nal1,nal2 = list_chop n nal in
-	  [LocalRawAssum (nal1,t)], CProdN (loc,(nal2,t)::bll,c)
-	else
-	let bl', c = strip_context (n-n') iscast
-	  (if bll=[] then c else CProdN (loc,bll,c)) in
-	LocalRawAssum (nal,t) :: bl', c 
-    | CArrow (loc,t,c) ->
-	let bl', c = strip_context (n-1) iscast c in
-	LocalRawAssum ([loc,Anonymous],t) :: bl', c 
-    | CCast (_,c,_) -> strip_context n false c
-    | CLetIn (_,na,b,c) -> 
-	let bl', c = strip_context (n-1) iscast c in
-	LocalRawDef (na,b) :: bl', c
-    | _ -> anomaly "ppconstrnew: strip_context"
-
-let transf istype env iscast bl c =
-  let c' =
-    if istype then prod_constr_expr c bl
-    else abstract_constr_expr c bl in
-  if Options.do_translate() then
-    let r = 
-      Constrintern.for_grammar
-        (Constrintern.interp_rawconstr_gen istype Evd.empty env false ([],[]))
-	c' in
-    begin try
-      (* Try to infer old case and type annotations *)
-      let _ = Pretyping.understand_gen_tcc Evd.empty env [] None r in 
-      (*msgerrnl (str "Typage OK");*) ()
-    with e -> (*msgerrnl (str "Warning: can't type")*) () end;
-    let c =
-      (if istype then Constrextern.extern_rawtype
-      else Constrextern.extern_rawconstr)
-      (Termops.vars_of_env env) r in
-    let n = local_binders_length bl in
-    strip_context n iscast c
-  else bl, c
-
-let pr_constr_env env c = pr lsimple (snd (transf false env false [] c))
-let pr_lconstr_env env c = pr ltop (snd (transf false env false [] c))
-let pr_constr c = pr_constr_env (Global.env()) c
-let pr_lconstr c = pr_lconstr_env (Global.env()) c
-
-let pr_binders = pr_undelimited_binders (pr ltop)
-
-let is_Eval_key c =
-  Options.do_translate () &
-  (let f id = let s = string_of_id id in s = "Eval" in
-  let g = function
-    | Ident(_,id) -> f id
-    | Qualid (_,qid) -> let d,id = repr_qualid qid in d = empty_dirpath & f id
-  in
-  match c with
-    | CRef ref | CApp (_,(_,CRef ref),_) when g ref -> true
-    | _ -> false)
-
-let pr_protect_eval c =
-  if is_Eval_key c then h 0 (str "(" ++ pr ltop c ++ str ")") else pr ltop c
-
-let pr_lconstr_env_n env iscast bl c =
-  let bl, c = transf false env iscast bl c in
-  bl, pr_protect_eval c
-let pr_type_env_n env bl c = pr ltop (snd (transf true env false bl c))
-let pr_type c = pr ltop (snd (transf true (Global.env()) false [] c))
-
-let transf_pattern env c =
-  if Options.do_translate() then
-    Constrextern.extern_rawconstr (Termops.vars_of_env env)
-      (Constrintern.for_grammar
-	(Constrintern.interp_rawconstr_gen false Evd.empty env true ([],[]))
-	c)
-  else c
-
-let pr_pattern c = pr lsimple (transf_pattern (Global.env()) c)
-
-let pr_rawconstr_env env c =
-  pr_constr (Constrextern.extern_rawconstr (Termops.vars_of_env env) c)
-let pr_lrawconstr_env env c =
-  pr_lconstr (Constrextern.extern_rawconstr (Termops.vars_of_env env) c)
-
-let pr_cases_pattern = pr_patt ltop
-
-let pr_pattern_occ prc = function
-    ([],c) -> prc c
-  | (nl,c) -> hov 1 (prc c ++ spc() ++ str"at " ++
-                     hov 0 (prlist_with_sep spc int nl))
-
-let pr_unfold_occ pr_ref = function
-    ([],qid) -> pr_ref qid
-  | (nl,qid) -> hov 1 (pr_ref qid ++ spc() ++ str"at " ++
-                       hov 0 (prlist_with_sep spc int nl))
-
-let pr_qualid qid = str (string_of_qualid qid)
-
-open Rawterm
-
-let pr_arg pr x = spc () ++ pr x
-
-let pr_red_flag pr r =
-  (if r.rBeta then pr_arg str "beta" else mt ()) ++
-  (if r.rIota then pr_arg str "iota" else mt ()) ++
-  (if r.rZeta then pr_arg str "zeta" else mt ()) ++
-  (if r.rConst = [] then
-     if r.rDelta then pr_arg str "delta"
-     else mt ()
-   else
-     pr_arg str "delta " ++ (if r.rDelta then str "-" else mt ()) ++
-     hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]"))
-
-open Genarg
-
-let pr_metaid id = str"?" ++ pr_id id
-
-let pr_red_expr (pr_constr,pr_lconstr,pr_ref) = function
-  | Red false -> str "red"
-  | Hnf -> str "hnf"
-  | Simpl o -> str "simpl" ++ pr_opt (pr_pattern_occ pr_constr) o  
-  | Cbv f ->
-      if f = {rBeta=true;rIota=true;rZeta=true;rDelta=true;rConst=[]} then
-	str "compute"
-      else
-	hov 1 (str "cbv" ++ pr_red_flag pr_ref f)
-  | Lazy f -> 
-      hov 1 (str "lazy" ++ pr_red_flag pr_ref f)
-  | Unfold l ->
-      hov 1 (str "unfold" ++ spc() ++
-             prlist_with_sep pr_coma (pr_unfold_occ pr_ref) l)
-  | Fold l -> hov 1 (str "fold" ++ prlist (pr_arg pr_constr) l)
-  | Pattern l ->
-      hov 1 (str "pattern" ++
-        pr_arg (prlist_with_sep pr_coma (pr_pattern_occ pr_constr)) l)
-        
-  | Red true -> error "Shouldn't be accessible from user"
-  | ExtraRedExpr s -> str s
-
-let rec pr_may_eval test prc prlc pr2 = function
-  | ConstrEval (r,c) ->
-      hov 0
-        (str "eval" ++ brk (1,1) ++
-         pr_red_expr (prc,prlc,pr2) r ++
-	 str " in" ++ spc() ++ prc c)
-  | ConstrContext ((_,id),c) ->
-      hov 0
-	(str "context " ++ pr_id id ++ spc () ++
-	 str "[" ++ prlc c ++ str "]")
-  | ConstrTypeOf c -> hov 1 (str "type of" ++ spc() ++ prc c)
-  | ConstrTerm c when test c -> h 0 (str "(" ++ prc c ++ str ")")
-  | ConstrTerm c -> prc c
-
-let pr_may_eval a = pr_may_eval (fun _ -> false) a
-
-let pr_rawconstr_env_no_translate env c =
-  pr lsimple (Constrextern.extern_rawconstr (Termops.vars_of_env env) c)
-let pr_lrawconstr_env_no_translate env c =
-  pr ltop (Constrextern.extern_rawconstr (Termops.vars_of_env env) c)
-
-(* Printing reference with translation *)
-
-let pr_reference r =
-  let loc = loc_of_reference r in
-  try match Nametab.extended_locate (snd (qualid_of_reference r)) with
-    | TrueGlobal ref ->
-        pr_with_comments loc
-	  (pr_reference (Constrextern.extern_reference loc Idset.empty ref))
-    | SyntacticDef kn ->
-	let is_coq_root d =
-	  let d = repr_dirpath d in
-	  d <> [] & string_of_id (list_last d) = "Coq" in
-        let dir,id = repr_path (sp_of_syntactic_definition kn) in
-	let r =
-          if (is_coq_root (Lib.library_dp()) or is_coq_root dir) then
-	    (match Syntax_def.search_syntactic_definition loc kn with
-	      | RRef (_,ref) ->
-		  Constrextern.extern_reference dummy_loc Idset.empty ref
-              | _ -> r)
-          else r
-	in pr_with_comments loc (pr_reference r)
-  with Not_found ->
-    error_global_not_found (snd (qualid_of_reference r))
-
-(** constr printers *)
-
-let pr_term_env env  c = pr lsimple (Constrextern.extern_constr false env c)
-let pr_lterm_env env c = pr ltop    (Constrextern.extern_constr false env c)
-let pr_term  c = pr_term_env  (Global.env()) c
-let pr_lterm c = pr_lterm_env (Global.env()) c
-
-let pr_constr_pattern_env env c =
-  pr lsimple (Constrextern.extern_pattern env Termops.empty_names_context c)
-
-let pr_constr_pattern t =
-  pr lsimple
-    (Constrextern.extern_pattern (Global.env()) Termops.empty_names_context t)
-
-
-(************************************************************************)
-(* Automatic standardisation of names in Arith and ZArith by translator *)
-(* Very not robust *)
-
-let is_to_rename dir id =
-  let dirs = List.map string_of_id (repr_dirpath dir) in
-  match List.rev dirs with
-  | "Coq"::"Arith"::"Between"::_ -> false
-  | "Coq"::"ZArith"::
-    ("Wf_Z"|"Zpower"|"Zlogarithm"|"Zbinary"|"Zdiv"|"Znumtheory")::_ -> false
-  | "Coq"::("Arith"|"NArith"|"ZArith")::_ -> true
-  | "Coq"::"Init"::"Peano"::_ -> true
-  | "Coq"::"Init"::"Logic"::_ when string_of_id id = "iff_trans" -> true
-  | "Coq"::"Reals"::"RIneq"::_ -> true
-  | _ -> false
-
-let is_ref_to_rename ref =
-  let sp = sp_of_global ref in
-  is_to_rename (dirpath sp) (basename sp)
-
-let get_name (ln,lp,lz,ll,lr,lr') id refbase n =
-  let id' = string_of_id n in
-  (match id' with
-    | "nat" -> (id_of_string (List.hd ln),(List.tl ln,lp,lz,ll,lr,lr'))
-    | "positive" -> (id_of_string (List.hd lp),(ln,List.tl lp,lz,ll,lr,lr'))
-    | "Z" -> (id_of_string (List.hd lz),(ln,lp,List.tl lz,ll,lr,lr'))
-    | "Prop" when List.mem (string_of_id id) ["a";"b";"c"] -> 
-	(* pour iff_trans *)
-	(id_of_string (List.hd ll),(ln,lp,lz,List.tl ll,lr,lr'))
-    | "R" when (* Noms r,r1,r2 *)
-	refbase = "Rle_refl" or
-	refbase = "Rlt_monotony_contra" or 
-	refbase = "Rmult_le_reg_l" or 
-	refbase = "Rle_monotony_contra" or 
-	refbase = "Rge_monotony" ->
-	(id_of_string (List.hd lr')),(ln,lp,lz,ll,lr,List.tl lr')
-    | "R" when (* Noms r1,r2,r3,r4 *)
-	List.mem (string_of_id id)
-	  ["x";"y";"x'";"y'";"z";"t";"n";"m";"a";"b";"c";"p";"q"] 
-	& refbase <> "sum_inequa_Rle_lt"
-	-> 
-	(id_of_string (List.hd lr),(ln,lp,lz,ll,List.tl lr,lr'))
-    | _ -> id,(ln,lp,lz,ll,lr,lr'))
-
-let get_name_constr names id refbase t = match kind_of_term t with
-  | Ind ind ->
-      let n = basename (sp_of_global (IndRef ind)) in
-      get_name names id refbase n
-  | Const sp ->
-      let n = basename (sp_of_global (ConstRef sp)) in
-      get_name names id refbase n
-  | Sort _ -> get_name names id refbase (id_of_string "Prop")
-  | _ -> id,names
-
-let names = 
-  (["n";"m";"p";"q"],["p";"q";"r";"s"],["n";"m";"p";"q"],["A";"B";"C"],
-   ["r1";"r2";"r3";"r4"],["r";"r1";"r2"])
-
-let znames refbase t =
-  let rec aux c names = match kind_of_term c with
-    | Prod (Name id as na,t,c) ->
-	let (id,names) = get_name_constr names id refbase t in
-	(na,id) :: aux c names
-    | Prod (Anonymous,t,c) ->
-	(Anonymous,id_of_string "ZZ") :: aux c names
-    | _ -> []
-  in aux t names
-
-let get_name_raw names id refbase t = match t with
-  | CRef(Ident (_,n)) -> get_name names id refbase n
-  | CSort _ -> get_name names id refbase (id_of_string "Prop")
-  | _ -> id,names
-
-let rename_bound_variables id0 t =
-  if is_to_rename (Lib.library_dp()) id0 then
-  let refbase = string_of_id id0 in
-  let rec aux c names subst = match c with
-    | CProdN (loc,bl,c) ->
-	let rec aux2 names subst = function
-	  | (nal,t)::bl ->
-	      let rec aux3 names subst = function
-		| (loc,Name id)::nal ->
-		    let (id',names) = get_name_raw names id refbase t in
-		    let (nal,names,subst) = aux3 names ((id,id')::subst) nal in
-		    (loc,Name id')::nal, names, subst
-		| x::nal -> 
-		    let (nal,names,subst) = aux3 names subst nal in
-		    x::nal,names,subst
-		| [] -> [],names,subst in
-	      let t = replace_vars_constr_expr subst t in
-	      let nal,names,subst = aux3 names subst nal in
-	      let bl,names,subst = aux2 names subst bl in
-	      (nal,t)::bl, names, subst
-	  | [] -> [],names,subst in
-	let bl,names,subst = aux2 names subst bl in
-	CProdN (loc,bl,aux c names subst)
-    | CArrow (loc,t,u) ->
-	let u = aux u names subst in
-	CArrow (loc,replace_vars_constr_expr subst t,u)
-    | _ -> replace_vars_constr_expr subst c
-  in aux t names []
-  else t
-
-let translate_binding kn n ebl =
-  let t = Retyping.get_type_of (Global.env()) Evd.empty (mkConst kn) in
-  let subst= znames (string_of_id (basename (sp_of_global (ConstRef kn)))) t in
-  try
-    let _,subst' = list_chop n subst in
-    List.map (function
-      | (x,NamedHyp id,c) -> (x,NamedHyp (List.assoc (Name id) subst'),c)
-      |  x -> x) ebl
-  with _ -> ebl
-
-let translate_with_bindings c bl =
-  match bl with
-  | ExplicitBindings l ->
-      let l = match c with
-	| RRef (_,(ConstRef kn as ref)) when is_ref_to_rename ref -> 
-	    translate_binding kn 0 l
-	| RApp (_,RRef (_,(ConstRef kn as ref)),args) when is_ref_to_rename ref
-	    -> translate_binding kn (List.length args) l
-	| _ ->
-	    l
-      in ExplicitBindings l
-    | x -> x
diff --git a/translate/ppconstrnew.mli b/translate/ppconstrnew.mli
deleted file mode 100644
index 4a488499..00000000
--- a/translate/ppconstrnew.mli
+++ /dev/null
@@ -1,100 +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: ppconstrnew.mli,v 1.16.2.2 2005/01/21 17:17:20 herbelin Exp $ i*)
-
-open Pp
-open Environ
-open Term
-open Libnames
-open Pcoq
-open Rawterm
-open Extend
-open Coqast
-open Topconstr
-open Names
-open Util
-open Genarg
-
-val extract_lam_binders :
-  constr_expr -> local_binder list * constr_expr
-val extract_prod_binders :
-  constr_expr -> local_binder list * constr_expr
-val extract_def_binders :
-  constr_expr -> constr_expr ->
-  local_binder list * constr_expr * constr_expr
-val split_fix :
-  int -> constr_expr -> constr_expr -> 
-  local_binder list *  constr_expr * constr_expr
-val pr_binders : local_binder list -> std_ppcmds
-
-val prec_less : int -> int * Ppextend.parenRelation -> bool
- 
-val pr_global : Idset.t -> global_reference -> std_ppcmds
- 
-val pr_tight_coma : unit -> std_ppcmds
-val pr_located :
-  ('a -> std_ppcmds) -> 'a located -> std_ppcmds
-val pr_lident : identifier located -> std_ppcmds
-val pr_lname : name located -> std_ppcmds
-
-val pr_with_comments : loc -> std_ppcmds -> std_ppcmds
-val pr_com_at : int -> std_ppcmds
-val pr_sep_com :
-  (unit -> std_ppcmds) ->
-  (constr_expr -> std_ppcmds) ->
-  constr_expr -> std_ppcmds
-val pr_opt : ('a -> std_ppcmds) -> 'a option -> std_ppcmds
-val pr_id : identifier -> std_ppcmds
-val pr_name : name -> std_ppcmds
-val pr_qualid : qualid -> std_ppcmds
-val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
-val pr_metaid : identifier -> std_ppcmds
-val pr_red_expr :
-  ('a -> std_ppcmds) * ('a -> std_ppcmds) *  ('b -> std_ppcmds) ->
-    ('a,'b) red_expr_gen -> std_ppcmds
-
-val pr_sort : rawsort -> std_ppcmds
-val pr_pattern : Tacexpr.pattern_expr -> std_ppcmds
-val pr_constr : constr_expr -> std_ppcmds
-val pr_lconstr : constr_expr -> std_ppcmds
-val pr_constr_env : env -> constr_expr -> std_ppcmds
-val pr_lconstr_env : env -> constr_expr -> std_ppcmds
-val pr_lconstr_env_n : env -> bool -> local_binder list -> constr_expr -> 
-  local_binder list * std_ppcmds
-val pr_type_env_n : env -> local_binder list -> constr_expr -> std_ppcmds
-val pr_type : constr_expr -> std_ppcmds
-val pr_cases_pattern : cases_pattern_expr -> std_ppcmds
-val pr_may_eval :
-  ('a -> std_ppcmds) -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) -> ('a,'b) may_eval
-    -> std_ppcmds
-val abstract_constr_expr : constr_expr -> local_binder list -> constr_expr
-val prod_constr_expr : constr_expr -> local_binder list -> constr_expr
-
-
-val pr_rawconstr_env : env -> rawconstr -> std_ppcmds
-val pr_lrawconstr_env : env -> rawconstr -> std_ppcmds
-
-val pr_rawconstr_env_no_translate : env -> rawconstr -> std_ppcmds
-val pr_lrawconstr_env_no_translate : env -> rawconstr -> std_ppcmds
-
-val pr_reference : reference -> std_ppcmds
-
-(** constr printers *)
-
-val pr_term_env : env -> constr -> std_ppcmds
-val pr_lterm_env : env -> constr -> std_ppcmds
-val pr_term : constr -> std_ppcmds
-val pr_lterm : constr -> std_ppcmds
-
-val pr_constr_pattern_env : env -> Pattern.constr_pattern -> std_ppcmds
-val pr_constr_pattern : Pattern.constr_pattern -> std_ppcmds
-
-(* To translate names in ZArith *)
-val translate_with_bindings : rawconstr -> 'a bindings -> 'a bindings
-val rename_bound_variables : identifier -> constr_expr -> constr_expr
diff --git a/translate/pptacticnew.ml b/translate/pptacticnew.ml
deleted file mode 100644
index 7da30c4e..00000000
--- a/translate/pptacticnew.ml
+++ /dev/null
@@ -1,905 +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        *)
-(************************************************************************)
-
-(* $Id: pptacticnew.ml,v 1.57.2.3 2005/05/15 12:47:03 herbelin Exp $ *)
-
-open Pp
-open Names
-open Nameops
-open Environ
-open Util
-open Extend
-open Ppextend
-open Ppconstrnew
-open Tacexpr
-open Rawterm
-open Topconstr
-open Genarg
-open Libnames
-open Pptactic
-
-let sep_v = fun _ -> str"," ++ spc()
-
-let strip_prod_binders_expr n ty =
-  let rec strip_ty acc n ty =
-    match ty with
-        Topconstr.CProdN(_,bll,a) ->
-          let nb =
-            List.fold_left (fun i (nal,_) -> i + List.length nal) 0 bll in
-          if nb >= n then (List.rev (bll@acc), a)
-          else strip_ty (bll@acc) (n-nb) a
-      | Topconstr.CArrow(_,a,b) ->
-          if n=1 then
-            (List.rev (([(dummy_loc,Anonymous)],a)::acc), b)
-          else strip_ty (([(dummy_loc,Anonymous)],a)::acc) (n-1) b
-      | _ -> error "Cannot translate fix tactic: not enough products" in
-  strip_ty [] n ty
-
-
-(* In v8 syntax only double quote char is escaped by repeating it *)
-let rec escape_string_v8 s =
-  let rec escape_at s i =
-    if i<0 then s
-    else if s.[i] == '"' then
-      let s' = String.sub s 0 i^"\""^String.sub s i (String.length s - i) in
-      escape_at s' (i-1)
-    else escape_at s (i-1) in
-  escape_at s (String.length s - 1)
-
-let qstringnew s = str ("\""^escape_string_v8 s^"\"")
-let qsnew = qstringnew
-
-let translate_v7_ltac = function
-  | "DiscrR" -> "discrR"
-  | "Sup0" -> "prove_sup0"
-  | "SupOmega" -> "omega_sup"
-  | "Sup" -> "prove_sup"
-  | "RCompute" -> "Rcompute"
-  | "IntroHypG" -> "intro_hyp_glob"
-  | "IntroHypL" -> "intro_hyp_pt"
-  | "IsDiff_pt" -> "is_diff_pt"
-  | "IsDiff_glob" -> "is_diff_glob"
-  | "IsCont_pt" -> "is_cont_pt"
-  | "IsCont_glob" -> "is_cont_glob"
-  | "RewTerm" -> "rew_term"
-  | "ConsProof" -> "deriv_proof"
-  | "SimplifyDerive" -> "simplify_derive"
-  | "Reg" -> "reg" (* ??? *)
-  | "SplitAbs" -> "split_case_Rabs"
-  | "SplitAbsolu" -> "split_Rabs"
-  | "SplitRmult" -> "split_Rmult"
-  | "CaseEqk" -> "case_eq"
-  | "SqRing" -> "ring_Rsqr"
-  | "TailSimpl" -> "tail_simpl"
-  | "CoInduction" -> "coinduction"
-  | "ElimCompare" -> "elim_compare"
-  | "CCsolve" -> "CCsolve"  (* ?? *)
-  | "ArrayAccess" -> "array_access"
-  | "MemAssoc" -> "mem_assoc"
-  | "SeekVarAux" -> "seek_var_aux"
-  | "SeekVar" -> "seek_var"
-  | "NumberAux" -> "number_aux"
-  | "Number" -> "number"
-  | "BuildVarList" -> "build_varlist"
-  | "Assoc" -> "assoc"
-  | "Remove" -> "remove"
-  | "Union" -> "union"
-  | "RawGiveMult" -> "raw_give_mult"
-  | "GiveMult" -> "give_mult"
-  | "ApplyAssoc" -> "apply_assoc"
-  | "ApplyDistrib" -> "apply_distrib"
-  | "GrepMult" -> "grep_mult"
-  | "WeakReduce" -> "weak_reduce"
-  | "Multiply" -> "multiply"
-  | "ApplyMultiply" -> "apply_multiply"
-  | "ApplyInverse" -> "apply_inverse"
-  | "StrongFail" -> "strong_fail"
-  | "InverseTestAux" -> "inverse_test_aux"
-  | "InverseTest" -> "inverse_test"
-  | "ApplySimplif" -> "apply_simplif"
-  | "Unfolds" -> "unfolds"
-  | "Reduce" -> "reduce"
-  | "Field_Gen_Aux" -> "field_gen_aux"
-  | "Field_Gen" -> "field_gen"
-  | "EvalWeakReduce" -> "eval_weak_reduce"
-  | "Field_Term" -> "field_term"
-  | "Fourier" -> "fourier" (* ou Fourier ?? *)
-  | "FourierEq" -> "fourier_eq"
-  | "S_to_plus" -> "rewrite_S_to_plus_term"
-  | "S_to_plus_eq" -> "rewrite_S_to_plus"
-  | "NatRing" -> "ring_nat"
-  | "Solve1" -> "solve1"
-  | "Solve2" -> "solve2"
-  | "Elim_eq_term" -> "elim_eq_term"
-  | "Elim_eq_Z" -> "elim_eq_Z"
-  | "Elim_eq_pos" -> "elim_eq_pos"
-  | "Elim_Zcompare" -> "elim_Zcompare"
-  | "ProveStable" -> "prove_stable"
-  | "interp_A" -> "interp_A"
-  | "InitExp" -> "init_exp"
-  | "SimplInv" -> "simpl_inv"
-  | "Map" -> "map_tactic"
-  | "BuildMonomAux" -> "build_monom_aux"
-  | "BuildMonom" -> "build_monom"
-  | "SimplMonomAux" -> "simpl_monom_aux"
-  | "SimplMonom" -> "simpl_monom"
-  | "SimplAllMonoms" -> "simpl_all_monomials"
-  | "AssocDistrib" -> "assoc_distrib"
-  | "NowShow" -> "now_show"
-  | ("subst"|"simpl"|"elim"|"destruct"|"apply"|"intro" (* ... *)) as x ->
-      let x' = x^"_" in
-      msgerrnl
-      (str ("Warning: '"^
-         x^"' is now a primitive tactic; it has been translated to '"^x'^"'"));
-      x'
-  | x -> x
-
-let id_of_ltac_v7_id id = 
-  id_of_string (translate_v7_ltac (string_of_id id))
-
-let pr_ltac_or_var pr = function
-  | ArgArg x -> pr x
-  | ArgVar (loc,id) ->
-      pr_with_comments loc (pr_id (id_of_ltac_v7_id id))
-
-let pr_arg pr x = spc () ++ pr x
-
-let pr_ltac_constant sp =
-  (* Source de bug: le nom le plus court n'est pas forcement correct 
-     apres renommage *)
-  let qid = Nametab.shortest_qualid_of_tactic sp in
-  let dir,id = repr_qualid qid in
-  pr_qualid (make_qualid dir (id_of_ltac_v7_id id))
-
-let pr_evaluable_reference_env env = function 
-  | EvalVarRef id -> pr_id (Constrextern.v7_to_v8_id id)
-  | EvalConstRef sp -> pr_global (Termops.vars_of_env env) (Libnames.ConstRef sp)
-
-let pr_inductive vars ind = pr_global vars (Libnames.IndRef ind)
-
-let pr_quantified_hypothesis = function
-  | AnonHyp n -> int n
-  | NamedHyp id -> pr_id id 
-
-let pr_quantified_hypothesis_arg h = spc () ++ pr_quantified_hypothesis h
-
-(*
-let pr_binding prc = function
-  | NamedHyp id, c -> hov 1 (pr_id id ++ str " := " ++ cut () ++ prc c)
-  | AnonHyp n, c -> hov 1 (int n ++ str " := " ++ cut () ++ prc c)
-*)
-
-let pr_esubst prc l =
-  let pr_qhyp = function
-      (_,AnonHyp n,c) -> str "(" ++ int n ++ str" := " ++ prc c ++ str ")"
-    | (_,NamedHyp id,c) ->
-        str "(" ++ pr_id id ++ str" := " ++ prc c ++ str ")"
-  in
-  prlist_with_sep spc pr_qhyp l
-
-let pr_bindings_gen for_ex prlc prc = function
-  | ImplicitBindings l ->
-      spc () ++
-      hv 2 ((if for_ex then mt() else str "with" ++ spc ()) ++
-            prlist_with_sep spc prc l)
-  | ExplicitBindings l ->
-      spc () ++
-      hv 2 ((if for_ex then mt() else str "with" ++ spc ()) ++
-            pr_esubst prlc l)
-  | NoBindings -> mt ()
-
-let pr_bindings prlc prc = pr_bindings_gen false prlc prc
-
-let pr_with_bindings prlc prc (c,bl) =
-  if Options.do_translate () then
-    (* translator calls pr_with_bindings on rawconstr: we cast it! *)
-    let bl' = translate_with_bindings (fst (Obj.magic c) : rawconstr) bl in
-    hov 1 (prc c ++ pr_bindings prlc prc bl')
-  else
-    hov 1 (prc c ++ pr_bindings prlc prc bl)
-
-let pr_with_constr prc = function
-  | None -> mt ()
-  | Some c -> spc () ++ hov 1 (str "with" ++ spc () ++ prc c)
-
-(* Translator copy of pr_intro_pattern based on a translating "pr_id" *)
-let rec pr_intro_pattern = function
-  | IntroOrAndPattern pll -> pr_case_intro_pattern pll
-  | IntroWildcard -> str "_"
-  | IntroIdentifier id -> pr_id id
-and pr_case_intro_pattern = function
-  | [_::_ as pl] ->
-      str "(" ++ hov 0 (prlist_with_sep pr_coma pr_intro_pattern pl) ++ str ")"
-  | pll ->
-      str "[" ++
-      hv 0 (prlist_with_sep pr_bar 
-        (fun l -> hov 0 (prlist_with_sep spc pr_intro_pattern l)) pll)
-      ++ str "]"
-
-let pr_with_names = function
-  | None -> mt ()
-  | Some ipat -> spc () ++ hov 1 (str "as" ++ spc () ++ pr_intro_pattern ipat)
-
-let pr_occs pp = function
-    [] -> pp
-  | nl -> hov 1 (pp ++ spc() ++ str"at " ++
-                 hov 0 (prlist_with_sep spc int nl))
-
-let pr_hyp_location pr_id = function
-  | id, occs, InHyp -> spc () ++ pr_occs (pr_id id) occs
-  | id, occs, InHypTypeOnly ->
-      spc () ++ pr_occs (str "(type of " ++ pr_id id ++ str ")") occs
-  | id, occs, InHypValueOnly ->
-      spc () ++ pr_occs (str "(value of " ++ pr_id id ++ str ")") occs
-
-let pr_hyp_location pr_id (id,occs,(hl,hl')) =
-  if !hl' <> None then pr_hyp_location pr_id (id,occs,out_some !hl')
-  else
-    (if hl = InHyp && Options.do_translate () then 
-      msgerrnl (h 0 (str "Translator warning: Unable to detect if " ++ pr_id id ++ spc () ++ str "denotes a local definition"));
-    pr_hyp_location pr_id (id,occs,hl))
-
-let pr_in pp = spc () ++ hov 0 (str "in" ++ pp)
-
-let pr_simple_clause pr_id = function
-  | [] -> mt ()
-  | l -> pr_in (spc () ++ prlist_with_sep spc pr_id l)
-
-let pr_clauses pr_id = function
-    { onhyps=None; onconcl=true; concl_occs=nl } ->
-      pr_in (pr_occs (str " *") nl)
-  | { onhyps=None; onconcl=false } -> pr_in (str " * |-")
-  | { onhyps=Some l; onconcl=true; concl_occs=nl } -> 
-      pr_in (prlist_with_sep (fun () -> str",") (pr_hyp_location pr_id) l
-             ++ pr_occs (str" |- *") nl)
-  | { onhyps=Some l; onconcl=false } ->
-      pr_in (prlist_with_sep (fun()->str",") (pr_hyp_location pr_id) l)
-
-let pr_clause_pattern pr_id = function
-  | (None, []) -> mt ()
-  | (glopt,l) ->
-      str " in" ++
-      prlist
-        (fun (id,nl) -> prlist (pr_arg int) nl 
-	  ++ spc () ++ pr_id id) l ++
-        pr_opt (fun nl -> prlist_with_sep spc int nl ++ str " Goal") glopt
-
-let pr_induction_arg prc = function
-  | ElimOnConstr c -> prc c
-  | ElimOnIdent (loc,id) -> pr_with_comments loc (pr_id id)
-  | ElimOnAnonHyp n -> int n
-
-let pr_induction_kind = function
-  | SimpleInversion -> str "simple inversion"
-  | FullInversion -> str "inversion"
-  | FullInversionClear -> str "inversion_clear"
-
-let pr_match_pattern pr_pat = function
-  | Term a -> pr_pat a
-  | Subterm (None,a) -> str "context [" ++ pr_pat a ++ str "]"
-  | Subterm (Some id,a) ->
-      str "context " ++ pr_id id ++ str "[" ++ pr_pat a ++ str "]"
-
-let pr_match_hyps pr_pat = function
-  | Hyp (nal,mp) -> pr_lname nal ++ str ":" ++ pr_match_pattern pr_pat mp
-
-let pr_match_rule m pr pr_pat = function
-  | Pat ([],mp,t) when m ->
-      pr_match_pattern pr_pat mp ++
-      spc () ++ str "=>" ++ brk (1,4) ++ pr t
-  | Pat (rl,mp,t) ->
-      prlist_with_sep (fun () -> str",") (pr_match_hyps pr_pat) rl ++
-      spc () ++ str "|-" ++ spc () ++ pr_match_pattern pr_pat mp ++ spc () ++
-      str "=>" ++ brk (1,4) ++ pr t
-  | All t -> str "_" ++ spc () ++ str "=>" ++ brk (1,4) ++ pr t
-
-let pr_funvar = function
-  | None -> spc () ++ str "_"
-  | Some id -> spc () ++ pr_id id
-
-let pr_let_clause k pr = function
-  | (id,None,t) ->
-      hov 0 (str k ++ pr_lident id ++ str " :=" ++ brk (1,1) ++
-             pr (TacArg t))
-  | (id,Some c,t) ->
-      hv 0 (str k ++ pr_lident id ++ str" :" ++ brk(1,2) ++
-      pr c ++
-      str " :=" ++ brk (1,1) ++ pr (TacArg t))
-
-let pr_let_clauses pr = function
-  | hd::tl ->
-      hv 0
-        (pr_let_clause "let " pr hd ++
-         prlist (fun t -> spc () ++ pr_let_clause "with " pr t) tl)
-  | [] -> anomaly "LetIn must declare at least one binding"
-
-let pr_rec_clause pr (id,(l,t)) =
-  hov 0
-    (pr_lident id ++ prlist pr_funvar l ++ str " :=") ++ spc () ++ pr t
-
-let pr_rec_clauses pr l = 
-  prlist_with_sep (fun () -> fnl () ++ str "with ") (pr_rec_clause pr) l
-
-let pr_seq_body pr tl =
-  hv 0 (str "[ " ++
-        prlist_with_sep (fun () -> spc () ++ str "| ") pr tl ++
-        str " ]")
-
-let pr_as_names_force force ids (pp,ids') =
-  pr_with_names 
-    (if (!pp or force) & List.exists ((<>) (ref [])) ids'
-    then Some (IntroOrAndPattern (List.map (fun x -> !x) ids'))
-    else ids)
-
-let duplicate force nodup ids pr = function
-  | [] -> pr (pr_as_names_force force ids (ref false,[]))
-  | x::l when List.for_all (fun y -> snd x=snd y) l ->
-      pr (pr_as_names_force force ids x)
-  | l ->
-     if List.exists (fun (b,ids) -> !b) l & (force or
-	 List.exists (fun (_,ids) -> ids <> (snd (List.hd l))) (List.tl l))
-      then 
-        if nodup then begin
-          msgerrnl
-            (h 0 (str "Translator warning: Unable to enforce v7 names while translating Induction/NewDestruct/NewInduction. Names in the different branches are") ++ brk (0,0) ++
-            hov 0 (prlist_with_sep spc
-              (fun id -> hov 0 (pr_as_names_force true ids id))
-              (List.rev l)));
-          pr (pr_as_names_force force ids (ref false,[]))
-        end
-        else
-          pr_seq_body (fun x -> pr (pr_as_names_force force ids x)) (List.rev l)
-      else pr (pr_as_names_force force ids (ref false,[]))
-
-let pr_hintbases = function
-  | None -> spc () ++ str "with *"
-  | Some [] -> mt ()
-  | Some l ->
-      spc () ++ hov 2 (str "with" ++ prlist (fun s -> spc () ++ str s) l)
-
-let pr_autoarg_adding = function
-  | [] -> mt ()
-  | l ->
-      spc () ++ str "adding [" ++
-        hv 0 (prlist_with_sep spc pr_reference l) ++ str "]"
-
-let pr_autoarg_destructing = function
-  | true -> spc () ++ str "destructing"
-  | false -> mt ()
-
-let pr_autoarg_usingTDB = function
-  | true -> spc () ++ str "using tdb"
-  | false -> mt ()
-
-let rec pr_tacarg_using_rule pr_gen = function
-  | Egrammar.TacTerm s :: l, al -> spc () ++ str s ++ pr_tacarg_using_rule pr_gen (l,al)
-  | Egrammar.TacNonTerm _ :: l, a :: al -> pr_gen a ++ pr_tacarg_using_rule pr_gen (l,al)
-  | [], [] -> mt ()
-  | _ -> failwith "Inconsistent arguments of extended tactic"
-
-let pr_then () = str ";"
-
-
-open Closure
-
-let make_pr_tac (pr_tac,pr_tac0,pr_constr,pr_lconstr,pr_pat,pr_cst,pr_ind,pr_ref,pr_ident,pr_extend,strip_prod_binders) =
-
-let pr_bindings env = pr_bindings (pr_lconstr env) (pr_constr env) in
-let pr_ex_bindings env = pr_bindings_gen true (pr_lconstr env) (pr_constr env) in
-let pr_with_bindings env = pr_with_bindings (pr_lconstr env) (pr_constr env) in
-let pr_eliminator env cb = str "using" ++ pr_arg (pr_with_bindings env) cb in
-let pr_constrarg env c = spc () ++ pr_constr env c in
-let pr_lconstrarg env c = spc () ++ pr_lconstr env c in
-
-let pr_intarg n = spc () ++ int n in
-
-let pr_binder_fix env (nal,t) =
-(*  match t with
-  | CHole _ -> spc() ++ prlist_with_sep spc (pr_lname) nal
-  | _ ->*)
-    let s =
-      prlist_with_sep spc (pr_lname) nal ++ str ":" ++
-      pr_lconstr env t in
-    spc() ++ hov 1 (str"(" ++ s ++ str")") in
-
-let pr_fix_tac env (id,n,c) =
-  let rec set_nth_name avoid n = function
-      (nal,ty)::bll ->
-        if n <= List.length nal then
-          match list_chop (n-1) nal with
-              _, (_,Name id) :: _ -> id, (nal,ty)::bll
-            | bef, (loc,Anonymous) :: aft ->
-                let id = next_ident_away_from (id_of_string"y") avoid in
-                id, ((bef@(loc,Name id)::aft, ty)::bll)
-            | _ -> assert false
-        else
-          let (id,bll') = set_nth_name avoid (n-List.length nal) bll in
-          (id,(nal,ty)::bll')
-    | [] -> assert false in
-  let (bll,ty) = strip_prod_binders n c in
-  let names =
-    List.fold_left
-      (fun ln (nal,_) -> List.fold_left
-          (fun ln na -> match na with (_,Name id) -> id::ln | _ -> ln)
-          ln nal)
-      [] bll in
-  let idarg,bll = set_nth_name names n bll in
-  let annot =
-    if List.length names = 1 then mt()
-    else spc() ++ str"{struct " ++ pr_id idarg ++ str"}" in
-  hov 1 (str"(" ++ pr_id id ++ 
-        prlist (pr_binder_fix env) bll ++ annot ++ str" :" ++
-        pr_lconstrarg env ty ++ str")") in
-(*  spc() ++
-  hov 0 (pr_id id ++ pr_intarg n ++ str":" ++ pr_constrarg
-    env c)
-*)
-let pr_cofix_tac env (id,c) =
-  hov 1 (str"(" ++ pr_id id ++ str" :" ++ pr_lconstrarg env c ++ str")") in
-
-
-  (* Printing tactics as arguments *)
-let rec pr_atom0 env = function
-  | TacIntroPattern [] -> str "intros"
-  | TacIntroMove (None,None) -> str "intro"
-  | TacAssumption -> str "assumption"
-  | TacAnyConstructor None -> str "constructor"
-  | TacTrivial (Some []) -> str "trivial"
-  | TacAuto (None,Some []) -> str "auto"
-(*  | TacAutoTDB None -> str "autotdb"
-  | TacDestructConcl -> str "dconcl"*)
-  | TacReflexivity -> str "reflexivity"
-  | t -> str "(" ++ pr_atom1 env t ++ str ")"
-
-  (* Main tactic printer *)
-and pr_atom1 env = function
-  | TacAutoTDB _ | TacDestructHyp _ | TacDestructConcl
-  | TacSuperAuto _ | TacExtend (_,
-    ("GTauto"|"GIntuition"|"TSimplif"|
-     "LinearIntuition"),_) ->
-      errorlabstrm "Obsolete V8" (str "Tactic is not ported to V8.0")
-  | TacExtend (loc,s,l) ->
-      pr_with_comments loc
-        (pr_extend (pr_constr env) (pr_lconstr env) (pr_tac env) s l)
-  | TacAlias (loc,s,l,_) ->
-      pr_with_comments loc
-        (pr_extend (pr_constr env) (pr_lconstr env) (pr_tac env) s
-          (List.map snd l))
-
-  (* Basic tactics *)
-  | TacIntroPattern [] as t -> pr_atom0 env t
-  | TacIntroPattern (_::_ as p) -> 
-      hov 1 (str "intros" ++ spc () ++ prlist_with_sep spc pr_intro_pattern p)
-  | TacIntrosUntil h ->
-      hv 1 (str "intros until" ++ pr_arg pr_quantified_hypothesis h)
-  | TacIntroMove (None,None) as t -> pr_atom0 env t
-  | TacIntroMove (Some id1,None) -> str "intro " ++ pr_id id1
-  | TacIntroMove (ido1,Some id2) ->
-      hov 1
-      (str "intro" ++ pr_opt pr_id ido1 ++ spc () ++ str "after " ++
-       pr_lident id2)
-  | TacAssumption as t -> pr_atom0 env t
-  | TacExact c -> hov 1 (str "exact" ++ pr_constrarg env c)
-  | TacApply cb -> hov 1 (str "apply" ++ spc () ++ pr_with_bindings env cb)
-  | TacElim (cb,cbo) ->
-      hov 1 (str "elim" ++ pr_arg (pr_with_bindings env) cb ++ 
-        pr_opt (pr_eliminator env) cbo)
-  | TacElimType c -> hov 1 (str "elimtype" ++ pr_constrarg env c)
-  | TacCase cb -> hov 1 (str "case" ++ spc () ++ pr_with_bindings env cb)
-  | TacCaseType c -> hov 1 (str "casetype" ++ pr_constrarg env c)
-  | TacFix (ido,n) -> hov 1 (str "fix" ++ pr_opt pr_id ido ++ pr_intarg n)
-  | TacMutualFix (id,n,l) ->
-      hov 1 (str "fix" ++ spc () ++ pr_id id ++ pr_intarg n ++ spc() ++
-             str"with " ++ prlist_with_sep spc (pr_fix_tac env) l)
-  | TacCofix ido -> hov 1 (str "cofix" ++ pr_opt pr_id ido)
-  | TacMutualCofix (id,l) ->
-      hov 1 (str "cofix" ++ spc () ++ pr_id id ++ spc() ++
-             str"with " ++ prlist_with_sep spc (pr_cofix_tac env) l)
-  | TacCut c -> hov 1 (str "cut" ++ pr_constrarg env c)
-  | TacTrueCut (Anonymous,c) -> 
-      hov 1 (str "assert" ++ pr_constrarg env c)
-  | TacTrueCut (Name id,c) -> 
-      hov 1 (str "assert" ++ spc () ++
-             hov 1 (str"(" ++ pr_id id ++ str " :" ++
-                    pr_lconstrarg env c ++ str")"))
-  | TacForward (false,na,c) ->
-      hov 1 (str "assert" ++ spc () ++
-             hov 1 (str"(" ++ pr_name na ++ str " :=" ++
-                    pr_lconstrarg env c ++ str")"))
-  | TacForward (true,Anonymous,c) ->
-      if Options.do_translate () then
-        (* Pose was buggy and was wrongly substituted in conclusion in v7 *)
-        hov 1 (str "set" ++ pr_constrarg env c)
-      else
-        hov 1 (str "pose" ++ pr_constrarg env c)
-  | TacForward (true,Name id,c) ->
-      if Options.do_translate () then
-      hov 1 (str "set" ++ spc() ++
-             hov 1 (str"(" ++ pr_id id ++ str " :=" ++
-                    pr_lconstrarg env c ++ str")"))
-      else
-      hov 1 (str "pose" ++ spc() ++
-             hov 1 (str"(" ++ pr_id id ++ str " :=" ++
-                    pr_lconstrarg env c ++ str")"))
-  | TacGeneralize l ->
-      hov 1 (str "generalize" ++ spc () ++
-             prlist_with_sep spc (pr_constr env) l)
-  | TacGeneralizeDep c ->
-      hov 1 (str "generalize" ++ spc () ++ str "dependent" ++
-             pr_constrarg env c)
-  | TacLetTac (Anonymous,c,cl) ->
-      hov 1 (str "set" ++ pr_constrarg env c) ++ pr_clauses pr_ident cl
-  | TacLetTac (Name id,c,cl) ->
-      hov 1 (str "set" ++ spc () ++
-             hov 1 (str"(" ++ pr_id id ++ str " :=" ++
-                    pr_lconstrarg env c ++ str")") ++
-             pr_clauses pr_ident cl)
-  | TacInstantiate (n,c,cls) ->
-      hov 1 (str "instantiate" ++ spc() ++
-             hov 1 (str"(" ++ pr_arg int n ++ str" :=" ++
-                    pr_lconstrarg env c ++ str ")" ++ 
-		    pr_clauses pr_ident cls))
-  (* Derived basic tactics *)
-  | TacSimpleInduction (h,l) ->
-      if List.exists (fun (pp,_) -> !pp) !l then
-        duplicate true true None (fun pnames -> 
-          hov 1 (str "induction" ++ pr_arg pr_quantified_hypothesis h ++
-          pnames)) !l
-      else
-      hov 1 (str "simple induction" ++ pr_arg pr_quantified_hypothesis h)
-  | TacNewInduction (h,e,(ids,l)) ->
-      duplicate false true ids (fun pnames ->
-      hov 1 (str "induction" ++ spc () ++
-             pr_induction_arg (pr_constr env) h ++ pnames ++
-             pr_opt (pr_eliminator env) e)) !l
-  | TacSimpleDestruct h ->
-      hov 1 (str "simple destruct" ++ pr_arg pr_quantified_hypothesis h)
-  | TacNewDestruct (h,e,(ids,l)) ->
-      duplicate false true ids (fun pnames ->
-      hov 1 (str "destruct" ++ spc () ++
-             pr_induction_arg (pr_constr env) h ++ pnames ++
-             pr_opt (pr_eliminator env) e)) !l
-  | TacDoubleInduction (h1,h2) ->
-      hov 1
-        (str "double induction" ++  
-         pr_arg pr_quantified_hypothesis h1 ++
- 	 pr_arg pr_quantified_hypothesis h2)
-  | TacDecomposeAnd c ->
-      hov 1 (str "decompose record" ++ pr_constrarg env c)
-  | TacDecomposeOr c ->
-      hov 1 (str "decompose sum" ++ pr_constrarg env c)
-  | TacDecompose (l,c) ->
-      let vars = Termops.vars_of_env env in
-      hov 1 (str "decompose" ++ spc () ++
-        hov 0 (str "[" ++ prlist_with_sep spc (pr_ind vars) l
-	  ++ str "]" ++ pr_constrarg env c))
-  | TacSpecialize (n,c) ->
-      hov 1 (str "specialize" ++ spc () ++ pr_opt int n ++ pr_with_bindings env c)
-  | TacLApply c -> 
-      hov 1 (str "lapply" ++ pr_constrarg env c)
-
-  (* Automation tactics *)
-  | TacTrivial (Some []) as x -> pr_atom0 env x
-  | TacTrivial db -> hov 0 (str "trivial" ++ pr_hintbases db)
-  | TacAuto (None,Some []) as x -> pr_atom0 env x
-  | TacAuto (n,db) ->
-      hov 0 (str "auto" ++ pr_opt (pr_or_var int) n ++ pr_hintbases db)
-(*  | TacAutoTDB None as x -> pr_atom0 env x
-  | TacAutoTDB (Some n) -> hov 0 (str "autotdb" ++ spc () ++ int n)
-  | TacDestructHyp (true,id) ->
-      hov 0 (str "cdhyp" ++ spc () ++ pr_lident id)
-  | TacDestructHyp (false,id) ->
-      hov 0 (str "dhyp" ++ spc () ++ pr_lident id)
-  | TacDestructConcl as x -> pr_atom0 env x
-  | TacSuperAuto (n,l,b1,b2) ->
-      hov 1 (str "superauto" ++ pr_opt int n ++ pr_autoarg_adding l ++ 
-             pr_autoarg_destructing b1 ++ pr_autoarg_usingTDB b2)*)
-  | TacDAuto (n,p) ->
-      hov 1 (str "auto" ++ pr_opt (pr_or_var int) n ++ str "decomp" ++ 
-      pr_opt int p)
-
-  (* Context management *)
-  | TacClear l ->
-      hov 1 (str "clear" ++ spc () ++ prlist_with_sep spc pr_ident l)
-  | TacClearBody l ->
-      hov 1 (str "clearbody" ++ spc () ++ prlist_with_sep spc pr_ident l)
-  | TacMove (b,id1,id2) ->
-      (* Rem: only b = true is available for users *)
-      assert b;
-      hov 1
-        (str "move" ++ brk (1,1) ++ pr_ident id1 ++ spc () ++ 
-	 str "after" ++ brk (1,1) ++ pr_ident id2)
-  | TacRename (id1,id2) ->
-      hov 1
-        (str "rename" ++ brk (1,1) ++ pr_ident id1 ++ spc () ++ 
-	 str "into" ++ brk (1,1) ++ pr_ident id2)
-
-  (* Constructors *)
-  | TacLeft l -> hov 1 (str "left" ++ pr_bindings env l)
-  | TacRight l -> hov 1 (str "right" ++ pr_bindings env l)
-  | TacSplit (false,l) -> hov 1 (str "split" ++ pr_bindings env l)
-  | TacSplit (true,l) -> hov 1 (str "exists" ++ pr_ex_bindings env l)
-  | TacAnyConstructor (Some t) ->
-      hov 1 (str "constructor" ++ pr_arg (pr_tac0 env) t)
-  | TacAnyConstructor None as t -> pr_atom0 env t
-  | TacConstructor (n,l) ->
-      hov 1 (str "constructor" ++ pr_or_metaid pr_intarg n ++
-             pr_bindings env l)
-
-  (* Conversion *)  
-  | TacReduce (r,h) ->
-      hov 1 (pr_red_expr (pr_constr env,pr_lconstr env,pr_cst env) r ++
-             pr_clauses pr_ident h)
-  | TacChange (occ,c,h) ->
-      hov 1 (str "change" ++ brk (1,1) ++
-      (match occ with
-          None -> mt()
-        | Some([],c1) ->
-            hov 1 (pr_constr env c1 ++ spc() ++ str "with ")
-        | Some(ocl,c1) ->
-            hov 1 (pr_constr env c1 ++ spc() ++
-	           str "at " ++ prlist_with_sep spc int ocl) ++ spc() ++
-	           str "with ") ++
-      pr_constr env c ++ pr_clauses pr_ident h)
-
-  (* Equivalence relations *)
-  | TacReflexivity as x -> pr_atom0 env x
-  | TacSymmetry cls -> str "symmetry " ++ pr_clauses pr_ident cls
-  | TacTransitivity c -> str "transitivity" ++ pr_constrarg env c
-
-  (* Equality and inversion *)
-  | TacInversion (DepInversion (k,c,ids),hyp) ->
-      hov 1 (str "dependent " ++ pr_induction_kind k ++ spc () ++
-      pr_quantified_hypothesis hyp ++
-      pr_with_names ids ++ pr_with_constr (pr_constr env) c)
-  | TacInversion (NonDepInversion (k,cl,ids),hyp) ->
-      hov 1 (pr_induction_kind k ++ spc () ++
-      pr_quantified_hypothesis hyp ++
-      pr_with_names ids ++ pr_simple_clause pr_ident cl)
-  | TacInversion (InversionUsing (c,cl),hyp) ->
-      hov 1 (str "inversion" ++ spc() ++ pr_quantified_hypothesis hyp ++ 
-      spc () ++ str "using" ++ spc () ++ pr_constr env c ++ 
-      pr_simple_clause pr_ident cl)
-
-in
-
-let ltop = (5,E) in
-let lseq = 5 in
-let ltactical = 3 in
-let lorelse = 2 in
-let llet = 1 in
-let lfun = 1 in
-let labstract = 3 in
-let lmatch = 1 in
-let latom = 0 in
-let lcall = 1 in
-let leval = 1 in
-let ltatom = 1 in
-
-let rec pr_tac env inherited tac =
-  let (strm,prec) = match tac with
-  | TacAbstract (t,None) ->
-      str "abstract " ++ pr_tac env (labstract,L) t, labstract
-  | TacAbstract (t,Some s) -> 
-      hov 0
-       (str "abstract (" ++ pr_tac env (labstract,L) t ++ str")" ++ spc () ++
-        str "using " ++ pr_id s),
-      labstract
-  | TacLetRecIn (l,t) -> 
-      hv 0
-        (str "let rec " ++ pr_rec_clauses (pr_tac env ltop) l ++ str " in" ++
-         fnl () ++ pr_tac env (llet,E) t),
-      llet
-  | TacLetIn (llc,u) ->
-      v 0
-       (hv 0 (pr_let_clauses (pr_tac env ltop) llc
-       ++ str " in") ++
-       fnl () ++ pr_tac env (llet,E) u),
-      llet
-  | TacMatch (t,lrul) ->
-      hov 0 (str "match " ++ pr_tac env ltop t ++ str " with"
-        ++ prlist
-	  (fun r -> fnl () ++ str "| " ++
-            pr_match_rule true (pr_tac env ltop) pr_pat r)
-	lrul
-        ++ fnl() ++ str "end"),
-      lmatch
-  | TacMatchContext (lr,lrul) ->
-      hov 0 (
-	str (if lr then "match reverse goal with" else "match goal with")
-	++ prlist
-	  (fun r -> fnl () ++ str "| " ++
-            pr_match_rule false (pr_tac env ltop) pr_pat r)
-	lrul
-        ++ fnl() ++ str "end"),
-      lmatch
-  | TacFun (lvar,body) ->
-      hov 2 (str "fun" ++
-        prlist pr_funvar lvar ++ str " =>" ++ spc () ++
-        pr_tac env (lfun,E) body),
-      lfun
-  | TacThens (t,tl) -> 
-      hov 1 (pr_tac env (lseq,E) t ++ pr_then () ++ spc () ++
-             pr_seq_body (pr_tac env ltop) tl),
-      lseq
-  | TacThen (t1,t2) ->
-      let pp2 =
-        (* Hook for translation names in induction/destruct *)
-        match t2 with
-          | TacAtom (_,TacSimpleInduction (h,l)) ->
-              if List.exists (fun (pp,ids) -> !pp) !l then
-                duplicate true false None (fun pnames ->
-                  hov 1 
-                  (str "induction" ++ pr_arg pr_quantified_hypothesis h ++
-                  pnames)) !l
-              else
-                hov 1
-                  (str "simple induction" ++ pr_arg pr_quantified_hypothesis h)
-          | TacAtom (_,TacNewInduction (h,e,(ids,l))) ->
-              duplicate false false ids (fun pnames -> 
-                hov 1 (str "induction" ++ spc () ++
-                pr_induction_arg (pr_constr env) h ++ pnames ++
-                pr_opt (pr_eliminator env) e)) !l
-          | TacAtom (_,TacNewDestruct (h,e,(ids,l))) ->
-              duplicate false false ids (fun pnames ->
-                hov 1 (str "destruct" ++ spc () ++
-                pr_induction_arg (pr_constr env) h ++ pnames ++
-                pr_opt (pr_eliminator env) e)) !l
-              (* end hook *)
-          | _ -> pr_tac env (lseq,L) t2 in
-      hov 1 (pr_tac env (lseq,E) t1 ++ pr_then () ++ spc () ++ pp2),
-      lseq
-  | TacTry t ->
-      hov 1 (str "try" ++ spc () ++ pr_tac env (ltactical,E) t),
-      ltactical
-  | TacDo (n,t) ->
-      hov 1 (str "do " ++ pr_or_var int n ++ spc () ++ pr_tac env (ltactical,E) t),
-      ltactical
-  | TacRepeat t ->
-      hov 1 (str "repeat" ++ spc () ++ pr_tac env (ltactical,E) t),
-      ltactical
-  | TacProgress t ->
-      hov 1 (str "progress" ++ spc () ++ pr_tac env (ltactical,E) t),
-      ltactical
-  | TacInfo t ->
-      hov 1 (str "info" ++ spc () ++ pr_tac env (ltactical,E) t),
-      ltactical
-  | TacOrelse (t1,t2) ->
-      hov 1 (pr_tac env (lorelse,L) t1 ++ str " ||" ++ brk (1,1) ++
-             pr_tac env (lorelse,E) t2),
-      lorelse
-  | TacFail (ArgArg 0,"") -> str "fail", latom
-  | TacFail (n,s) -> 
-      str "fail" ++ (if n=ArgArg 0 then mt () else pr_arg (pr_or_var int) n) ++
-      (if s="" then mt() else qsnew s), latom
-  | TacFirst tl ->
-      str "first" ++ spc () ++ pr_seq_body (pr_tac env ltop) tl, llet
-  | TacSolve tl ->
-      str "solve" ++ spc () ++ pr_seq_body (pr_tac env ltop) tl, llet
-  | TacId "" -> str "idtac", latom
-  | TacId s -> str "idtac" ++ (qsnew s), latom
-  | TacAtom (loc,t) ->
-      pr_with_comments loc (hov 1 (pr_atom1 env t)), ltatom
-  | TacArg(Tacexp e) -> pr_tac0 env e, latom
-  | TacArg(ConstrMayEval (ConstrTerm c)) ->
-      str "constr:" ++ pr_constr env c, latom
-  | TacArg(ConstrMayEval c) ->
-      pr_may_eval (pr_constr env) (pr_lconstr env) (pr_cst env) c, leval
-  | TacArg(TacFreshId sopt) -> str "fresh" ++ pr_opt qsnew sopt, latom
-  | TacArg(Integer n) -> int n, latom
-  | TacArg(TacCall(loc,f,l)) ->
-      pr_with_comments loc
-        (hov 1 (pr_ref f ++ spc () ++
-         prlist_with_sep spc (pr_tacarg env) l)),
-      lcall
-  | TacArg a -> pr_tacarg env a, latom
-  in
-  if prec_less prec inherited then strm
-  else str"(" ++ strm ++ str")"
-
-and pr_tacarg env = function
-  | TacDynamic (loc,t) ->
-      pr_with_comments loc (str ("<dynamic ["^(Dyn.tag t)^"]>"))
-  | MetaIdArg (loc,s) -> pr_with_comments loc (str ("$" ^ s))
-  | IntroPattern ipat -> str "ipattern:" ++ pr_intro_pattern ipat
-  | TacVoid -> str "()"
-  | Reference r -> pr_ref r
-  | ConstrMayEval c ->
-      pr_may_eval (pr_constr env) (pr_lconstr env) (pr_cst env) c
-  | TacFreshId sopt -> str "fresh" ++ pr_opt qsnew sopt
-  | (TacCall _|Tacexp _|Integer _) as a ->
-      str "ltac:" ++ pr_tac env (latom,E) (TacArg a)
-
-in ((fun env -> pr_tac env ltop),
-    (fun env -> pr_tac env (latom,E)),
-    pr_match_rule)
-
-let pi1 (a,_,_) = a
-let pi2 (_,a,_) = a
-let pi3 (_,_,a) = a
-
-let strip_prod_binders_rawterm n (ty,_) =
-  let rec strip_ty acc n ty =
-    if n=0 then (List.rev acc, (ty,None)) else
-      match ty with
-          Rawterm.RProd(loc,na,a,b) ->
-            strip_ty (([dummy_loc,na],(a,None))::acc) (n-1) b
-        | _ -> error "Cannot translate fix tactic: not enough products" in
-  strip_ty [] n ty
-
-let strip_prod_binders_constr n ty =
-  let rec strip_ty acc n ty =
-    if n=0 then (List.rev acc, ty) else
-      match Term.kind_of_term ty with
-          Term.Prod(na,a,b) ->
-            strip_ty (([dummy_loc,na],a)::acc) (n-1) b
-        | _ -> error "Cannot translate fix tactic: not enough products" in
-  strip_ty [] n ty
-
-
-let rec raw_printers =
-    (pr_raw_tactic, 
-     pr_raw_tactic0,
-     Ppconstrnew.pr_constr_env,
-     Ppconstrnew.pr_lconstr_env,
-     Ppconstrnew.pr_pattern,
-     (fun _ -> pr_reference),
-     (fun _ -> pr_reference),
-     pr_reference,
-     pr_or_metaid pr_lident,
-     Pptactic.pr_raw_extend,
-     strip_prod_binders_expr)
-
-and pr_raw_tactic env (t:raw_tactic_expr) =
-  pi1 (make_pr_tac raw_printers) env t
-
-and pr_raw_tactic0 env t =
-  pi2 (make_pr_tac raw_printers) env t
-
-and pr_raw_match_rule env t =
-  pi3 (make_pr_tac raw_printers) env t
-
-let pr_and_constr_expr pr (c,_) = pr c
-
-
-let rec glob_printers =
-    (pr_glob_tactic, 
-     pr_glob_tactic0,
-     (fun env -> pr_and_constr_expr (Ppconstrnew.pr_rawconstr_env_no_translate env)),
-     (fun env -> pr_and_constr_expr (Ppconstrnew.pr_lrawconstr_env_no_translate env)),
-     (fun c -> Ppconstrnew.pr_constr_pattern_env (Global.env()) c),
-     (fun env -> pr_or_var (pr_and_short_name (pr_evaluable_reference_env env))),
-     (fun vars -> pr_or_var (pr_inductive vars)),
-     pr_ltac_or_var (pr_located pr_ltac_constant),
-     pr_lident,
-     Pptactic.pr_glob_extend,
-     strip_prod_binders_rawterm)
-
-and pr_glob_tactic env (t:glob_tactic_expr) =
-  pi1 (make_pr_tac glob_printers) env t
-
-and pr_glob_tactic0 env t =
-  pi2 (make_pr_tac glob_printers) env t
-
-and pr_glob_match_rule env t =
-  pi3 (make_pr_tac glob_printers) env t
-
-let (pr_tactic,_,_) =
-  make_pr_tac
-    (pr_glob_tactic,
-     pr_glob_tactic0,
-     pr_term_env,
-     pr_lterm_env,
-     Ppconstrnew.pr_constr_pattern,
-     pr_evaluable_reference_env,
-     pr_inductive,
-     pr_ltac_constant,
-     pr_id,
-     Pptactic.pr_extend,
-     strip_prod_binders_constr)
-